diff --git a/ROOT b/ROOT index 9c8afabd..946356ed 100644 --- a/ROOT +++ b/ROOT @@ -41,7 +41,9 @@ session Binders in "thys" = Prelim + session Operations in "operations" = Untyped_Lambda_Calculus + theories Binder_Inductive - Fixpoint + Least_Fixpoint + Least_Fixpoint2 + Greatest_Fixpoint Recursor VVSubst TVSubst diff --git a/Tools/binder_induction.ML b/Tools/binder_induction.ML index 23615231..329707ca 100644 --- a/Tools/binder_induction.ML +++ b/Tools/binder_induction.ML @@ -78,7 +78,7 @@ fun extract_vars ctxt var t = | NONE => (case BNF_Def.bnf_of ctxt name of SOME bnf => BNF_Def.sets_of_bnf bnf | NONE => (case MRBNF_FP_Def_Sugar.fp_result_of ctxt name of - SOME sugar => #FVars (hd (filter ( + SOME sugar => #FVarss (hd (filter ( fn quot => fst (dest_Type (#T quot)) = name ) (#quotient_fps sugar))) | NONE => [] diff --git a/Tools/binder_inductive.ML b/Tools/binder_inductive.ML index bb2c50ed..af85c04e 100644 --- a/Tools/binder_inductive.ML +++ b/Tools/binder_inductive.ML @@ -13,14 +13,9 @@ fun long_name ctxt name = Const (s, _) => s | _ => error ("Undeclared constant: " ^ quote name) -datatype ('a, 'b) either = Inl of 'a | Inr of 'b - fun collapse (Inl x) = x | collapse (Inr x) = x -fun mk_insert x S = - Const (@{const_name Set.insert}, fastype_of x --> fastype_of S --> fastype_of S) $ x $ S; - fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = let val binds = the_default [] binds_opt; @@ -154,7 +149,7 @@ fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = val mapx = case mr_bnf of Inl mrbnf => MRBNF_Def.map_of_mrbnf mrbnf | Inr (Inl bnf) => BNF_Def.map_of_bnf bnf - | Inr (Inr sugar) => #rename (hd (filter (fn quot => + | Inr (Inr sugar) => #permute (hd (filter (fn quot => fst (dest_Type (#T quot)) = name ) (#quotient_fps sugar))) val Ts = fst (split_last (Term.binder_types (fastype_of mapx))); @@ -434,7 +429,7 @@ fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = fun map_id0_of_mr_bnf (Inl mrbnf) = [MRBNF_Def.map_id0_of_mrbnf mrbnf] | map_id0_of_mr_bnf (Inr (Inl bnf)) = [BNF_Def.map_id0_of_bnf bnf] - | map_id0_of_mr_bnf (Inr (Inr sugar)) = map #rename_id0 (#quotient_fps sugar) + | map_id0_of_mr_bnf (Inr (Inr sugar)) = map #permute_id0 (#quotient_fps sugar) fun prove_missing goals specified thms tac = fst (@{fold_map 4} ( fn true => (fn _ => fn _ => fn _ => fn acc => (hd acc, tl acc)) @@ -446,7 +441,7 @@ fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = fun map_comp_of_mr_bnf (Inl mrbnf) = [MRBNF_Def.map_comp_of_mrbnf mrbnf, MRBNF_Def.map_comp0_of_mrbnf mrbnf RS sym] | map_comp_of_mr_bnf (Inr (Inl bnf)) = [BNF_Def.map_comp_of_bnf bnf, BNF_Def.map_comp0_of_bnf bnf RS sym] | map_comp_of_mr_bnf (Inr (Inr sugar)) = maps (fn quot => - [#rename_comp quot, #rename_comp0 quot] + [#permute_comp quot, #permute_comp0 quot] ) (#quotient_fps sugar) val perm_id0s = prove_missing perm_id0_goals perms_specified perm_id0s (fn ctxt => fn mr_bnfs => K (EVERY1 [ @@ -460,7 +455,7 @@ fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = fun set_map_of_mr_bnf (Inl mrbnf) = MRBNF_Def.set_map_of_mrbnf mrbnf | set_map_of_mr_bnf (Inr (Inl bnf)) = BNF_Def.set_map_of_bnf bnf - | set_map_of_mr_bnf (Inr (Inr sugar)) = maps #FVars_renames (#quotient_fps sugar) + | set_map_of_mr_bnf (Inr (Inr sugar)) = maps #FVars_permutes (#quotient_fps sugar) val supp_seminats = prove_missing supp_seminat_goals one_specified supp_seminats (fn ctxt => fn mr_bnfs => K (EVERY1 [ K (Local_Defs.unfold0_tac ctxt ( @@ -470,7 +465,7 @@ fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = rtac ctxt @{thm subset_refl} ])); - fun map_cong_id_of_mr_bnf (Inr (Inr sugar)) = map (#rename_cong_id o #inner) (#quotient_fps sugar) + fun map_cong_id_of_mr_bnf (Inr (Inr sugar)) = map (#permute_cong_id o #inner) (#quotient_fps sugar) | map_cong_id_of_mr_bnf x = let val thm1 = case x of diff --git a/Tools/mrbnf_def.ML b/Tools/mrbnf_def.ML index 3f8628b2..540c8e73 100644 --- a/Tools/mrbnf_def.ML +++ b/Tools/mrbnf_def.ML @@ -1307,9 +1307,12 @@ datatype inline_policy = Dont_Inline | Hardly_Inline | Smart_Inline | Do_Inline; datatype fact_policy = Dont_Note | Note_Some | Note_All; val mrbnf_internals = Attrib.setup_config_bool @{binding mrbnf_internals} (K false); +val mrbnf_notes = Attrib.setup_config_bool @{binding mrbnf_notes} (K true); val mrbnf_timing = Attrib.setup_config_bool @{binding mrbnf_timing} (K false); -fun user_policy policy ctxt = if Config.get ctxt mrbnf_internals then Note_All else policy; +fun user_policy policy ctxt = if Config.get ctxt mrbnf_notes then + (if Config.get ctxt mrbnf_internals then Note_All else policy) + else Dont_Note; val smart_max_inline_term_size = 25; (*FUDGE*) @@ -2269,6 +2272,14 @@ fun prepare_def const_policy mk_fact_policy internal qualify prep_typ prep_term |> Thm.close_derivation \<^here> end; + val lthy = Local_Theory.background_theory (fn thy => + let + val lthy = Named_Target.init [] (hd coclass) thy; + val lthy = snd (Local_Theory.notes (map (fn (thmN, thm) => ((Binding.name thmN, []), [([thm], [])])) [ + ("large", covar_large) + ]) lthy) handle ERROR _ => lthy; + in Local_Theory.exit_global lthy end + ) lthy; val lthy = Local_Theory.background_theory (fn thy => let val lthy = Named_Target.init [] (hd class) thy; diff --git a/Tools/mrbnf_fp.ML b/Tools/mrbnf_fp.ML index a2f55f70..9700dcef 100644 --- a/Tools/mrbnf_fp.ML +++ b/Tools/mrbnf_fp.ML @@ -1,2375 +1,2513 @@ signature MRBNF_FP = sig - val construct_binder_fp: BNF_Util.fp_kind -> ((string * MRBNF_Def.mrbnf) * int) list -> - int list list -> local_theory -> MRBNF_FP_Def_Sugar.fp_result * local_theory + val construct_binder_fp: + BNF_Util.fp_kind -> + ((string * MRBNF_Def.mrbnf) * int) list -> (* ((name of type, pre_mrbnf), number of rec vars) + The pre_mrbnf needs to have the variables in order: + - m free positions + - x passive free positions + - y passive live positions + - z passive bound positions + - m' bound positions (where m' \ m) + - m'' bound free positions + - n recursive live positions + *) + (int list * int list) list list -> (* one list (length m) per variable kind containing a list of bound positions + for that variable kind containing + - `fst`: a list of indices of bound-free positions this position is bound in + - `snd`: a list of indices of recursive live positions that this positionis bound in + *) + local_theory -> MRBNF_FP_Def_Sugar.fp_result * local_theory end; structure MRBNF_FP : MRBNF_FP = struct open MRBNF_Util -open MRBNF_Def -open MRBNF_Fp_Tactics -open MRBNF_FP_Def_Sugar - -val mk_TN = prefix "raw_"; -val mk_ctorN = suffix "_ctor" o prefix "raw_"; -val mk_renameN = prefix "rename_"; -fun mk_freeN i = prefix "free_" o suffix (nonzero_string_of_int i); -fun mk_set_levelN i = prefix ("set" ^ nonzero_string_of_int i ^ "_") o suffix "_level" o - foldr1 (fn (s1, s2) => s1 ^ "_" ^ s2); -fun mk_FVarsN i = prefix "FVars_" o suffix (nonzero_string_of_int i); -val mk_alphaN = prefix "alpha_"; -val mk_avoidN = prefix "avoid_"; -val mk_cctorN = suffix "_ctor"; -val mk_rrenameN = prefix "rrename_"; -fun mk_FFVarsN i = prefix "FFVars_" o suffix (nonzero_string_of_int i); -val mk_aavoidN = prefix "aavoid_"; -val mk_subshapeN = prefix "subshape_" oo prefix o suffix "_"; -val mk_alpha'N = prefix "alpha'_"; - -val mk_minus = HOLogic.mk_binop @{const_name minus} |> curry; - -val mk_inter = HOLogic.mk_binop @{const_name inf}; - -fun mk_equivp t = Const (@{const_name equivp}, mk_predT [fastype_of t]) $ t; - -fun mk_Sigma (A, B) = - let - val AT = fastype_of A; - val BT = fastype_of B; - val ABT = mk_relT (HOLogic.dest_setT AT, HOLogic.dest_setT (range_type BT)); - in Const (@{const_name Sigma}, AT --> BT --> ABT) $ A $ B end; - -fun mk_Sigma_prod (A, B) = - let - val T = fastype_of A |> HOLogic.dest_setT; - in mk_Sigma (A, absdummy T B) end; -fun fold_case_prod vs t = - let - fun fold_case_prod' [] t = t - | fold_case_prod' [v] t = absfree v t - | fold_case_prod' [v1, v2] t = absfree v2 t |> absfree v1 |> HOLogic.mk_case_prod - | fold_case_prod' (v :: vs) t = absfree v (fold_case_prod' vs t) |> HOLogic.mk_case_prod; - in - fold_case_prod' (map dest_Free vs) t - end; - -fun mk_bound t = t - |> fastype_of - |> HOLogic.dest_setT - |> HOLogic.mk_UNIV - |> mk_card_of - |> mk_ordLess (mk_card_of t); - -fun mk_sumN_balanced ts i = BNF_FP_Util.mk_sumprod_balanced - (BNF_FP_Util.mk_sumTN_balanced (map fastype_of ts)) (length ts) i [nth ts (i-1)]; - -val mk_case_sumN_balanced = Balanced_Tree.make BNF_FP_Util.mk_case_sum; - -fun primrec int fixes specs lthy: (term list * thm list * thm list list) * local_theory = - let - val ((_, (terms, defs, (_, simpss))), lthy) = - BNF_LFP_Rec_Sugar.primrec_simple int fixes specs lthy; - in - ((terms, defs, simpss), lthy) - end; +infix 0 RSS +fun op RSS (thms, thm) = map (fn x => x RS thm) thms; -fun primcorec int fixes specs lthy: (term list * thm list * thm list list) * local_theory = - let - val decl = fixes |> Free o apfst Binding.name_of o fst o hd; - val specs' = map (pair (Binding.empty, [])) specs; - in - BNF_GFP_Rec_Sugar.primcorec_ursive int true [] fixes specs' (replicate (length specs) NONE) lthy - |> (fn (goalss, after_qed, lthy) => lthy - |> after_qed (map (fn [] => [] | _ => error "\"auto\" failed") goalss)) - |> `(fn lthy: local_theory => Spec_Rules.retrieve lthy decl - |> hd - |> (fn spec => (#terms spec, [], map single (#rules spec)))) - end; - -fun define_raw_terms co names mrbnfs ks binding_relation lthy = +fun define_fp_consts fp_kind mrbnf_ks (binding_relation : (int list * int list) list list) lthy = let - (* Get mrbnf info *) - val (frees, free_sortss) = map_split - (`length o map (dest_TVar #> snd) o frees_of_mrbnf) mrbnfs; - val (bounds, bound_sortss) = map_split - (`length o map (dest_TVar #> snd) o bounds_of_mrbnf) mrbnfs; - val lives = map (length o lives_of_mrbnf) mrbnfs; - val Fs = map (fst o dest_Type o T_of_mrbnf) mrbnfs; - - (* Error checking *) - fun all_equal [] _ = raise List.Empty - | all_equal (x :: xs) msg = if List.all (curry op = x) xs then x else error msg; - val free = all_equal frees "Number of free types must be equal"; - val bound = all_equal bounds "Number of bound types must be equal"; - val live = all_equal lives "Number of live types must be equal"; - val _ = if length ks = 1 orelse List.all (curry op < 0) ks then - if length ks > 1 orelse (hd ks >= 0) then () else - error "All ks must not be negative" else - error "All ks must be at least one"; - val k_sum = foldr1 op+ ks; - val _ = if live >= k_sum then () else - error "Sum of ks must not exceed number of live types"; - val bound_bounds = (length o filter I oo map o List.exists) - (fn i => 0 <= i andalso i <= k_sum-1) binding_relation; - val _ = if bound_bounds >= 1 then () else - error "Need at least one binding"; - val _ = if bound_bounds <= free then () else - error "Not enough free types"; - val _ = if bound_bounds <= bound then () else - error "Not enough bound types"; - val sort : sort = distinct op = (if co - then maps coclass_of_mrbnf mrbnfs - else all_equal (transpose free_sortss @ transpose bound_sortss) - "Sorts of free and bound types must be equal" |> flat); - val f_sorts = replicate free sort; - val b_sorts = replicate (bound-bound_bounds) sort; - - (* Make names and construct groups *) - val bs = map (Binding.name o mk_TN) names; - val TNs = map (Local_Theory.full_name lthy) bs; - val ctorNs = map mk_ctorN names; - val frees_lives = mk_TFrees' f_sorts lthy ||>> mk_TFrees (live - k_sum) |>> op @ - ||> fst o mk_TFrees' b_sorts |> op @; - fun mk_T_group TN k = Type (TN, frees_lives) |> replicate k; - val T_groups = frees_lives @ take bound_bounds frees_lives @ - List.concat (map2 mk_T_group TNs ks); - val T_Ts = map (`dest_TFree #>> snd #> swap #> pair NONE) frees_lives; - - (* Build spec *) - fun mk_T_spec b = ((T_Ts, b), NoSyn); - fun mk_ctor_spec F ctorN = (((Binding.empty, Binding.name ctorN), - single (Binding.empty, Type (F, T_groups))), NoSyn); - fun mk_T_specs F b ctorN = (((mk_T_spec b, mk_ctor_spec F ctorN |> single), - (Binding.empty, Binding.empty, Binding.empty)), []); - val T_specs = @{map 3} mk_T_specs Fs bs ctorNs; - - (* Define co-datatype *) - val lthy = (if co - then BNF_FP_Def_Sugar.co_datatypes Greatest_FP BNF_GFP.construct_gfp - else BNF_FP_Def_Sugar.co_datatypes Least_FP BNF_LFP.construct_lfp) - ((K false, false), T_specs) lthy; - val T_sugars = map (the o BNF_FP_Def_Sugar.fp_sugar_of lthy) TNs; - in - (free, bound, frees_lives |> map (snd o dest_TFree), T_sugars, lthy) - end; - -val (add_prems, mk_prem_terms) = - let - fun test_TEqu (T1 : typ, T2 : typ) = if T1 = T2 then (T1, T2) else error "Types must be equal"; - - fun mk_small_support t = t - |> mk_supp - |> mk_bound - |> HOLogic.mk_Trueprop; - val mk_small_support_imp = mk_small_support #> curry Logic.mk_implies; - - fun mk_bij t = t - |> fastype_of - |> dest_funT - |> test_TEqu - |> apply2 HOLogic.mk_UNIV - |-> BNF_LFP_Util.mk_bij_betw t - |> HOLogic.mk_Trueprop; - val mk_bij_imp = mk_bij #> curry Logic.mk_implies; - in - (fold_rev (fn t => mk_bij_imp t o mk_small_support_imp t), - maps (fn t => [mk_bij t, mk_small_support t])) - end; - -fun construct_binder_fp fp mrbnf_ks binding_relation lthy = - let - (* Error checking *) - val co = if fp = Greatest_FP then true else if fp = Least_FP then false else - error "Invalid fixpoint"; - val _ = if length mrbnf_ks > 0 then () else error "Need at least one mrbnf"; - val ((names, mrbnfs), ks) = split_list mrbnf_ks |>> split_list; - - (* Define raw datatype *) - val (free, bound, sorts, T_sugars, lthy) = - define_raw_terms co names mrbnfs ks binding_relation lthy; - val n = length ks; - val mutual = n > 1; - val rec_live = foldr1 op+ ks; - val k_ranges = let fun mk_range k = map (pair k) (1 upto k) in maps mk_range ks end; - - (* Normalise binding relation *) - val binding_relation = - let - fun in_range i = 0 <= i andalso i <= rec_live - 1; - fun remove_duplicates [] = [] - | remove_duplicates (x::xs) = case remove_duplicates xs of - [] => [x] - | (x'::xs) => if x = x' then x::xs else x::x'::xs; - in - map (remove_duplicates o sort int_ord o filter in_range) binding_relation - |> filter (not o null) - end; - val fbound = length binding_relation; - val passive = length sorts - fbound; - val pfree = free - fbound; - val pbound = bound - fbound; - val plive = passive - pfree - pbound; - val num_bindings = map length binding_relation |> foldr1 op+; - - val binding_matrix = map (fn b_rels => replicate rec_live false - |> fold (fn i => nth_map i (K true)) b_rels) binding_relation; - val binding_matrixt = transpose binding_matrix; - val all_bindings = map (List.all I) binding_matrixt; - val no_bindings = map (List.all not) binding_matrixt; - fun map_binding_vector b_vec = @{map 3} (fn b => if b then K I else K) b_vec; - fun map_binding_matrix xss yss = @{map 3} map_binding_vector binding_matrix xss yss; - - (* Helper functions *) - fun subst_terms Ts terms = - let - fun subst_term Ts t = Term.subst_TVars ((Term.add_tvar_names t [] |> rev) ~~ Ts) t; - in - terms |> map (subst_term Ts) - end; - fun subst_typs Ts types = - let - fun subst_typ Ts T = Term.typ_subst_TVars ((Term.add_tvar_namesT T [] |> rev) ~~ Ts) T; - in - map (subst_typ Ts) types - end; - fun mk_inv_assms [] = [] - | mk_inv_assms (bij::supp::assms) = (@{thm bij_imp_bij_inv} OF [bij]) :: - (@{thm supp_inv_bound} OF [bij, supp]) :: mk_inv_assms assms - | mk_inv_assms _ = raise Match; - val (id_prems, id_prems2, bij_id_prems, bij_prems, refl_prems) = - let - val ids = replicate fbound @{thms _} @ replicate pfree @{thms supp_id_bound} @ - replicate pbound @{thms bij_id supp_id_bound} @ replicate (2*fbound) @{thms _} |> flat; - val bij_ids = replicate (2*fbound) @{thms _} @ replicate (pfree+pbound) - @{thms bij_id supp_id_bound} @ replicate (2*fbound) @{thms _} |> flat; - fun refls rs = replicate fbound @{thm _} @ replicate pfree (@{thm refl} RS rs) @ - replicate plive @{thm _} @ replicate pbound (@{thm refl} RS rs); - fun OF_prems prems thm = thm OF prems; - fun refl_prems n thm = OF_prems (replicate n @{thm _} @ refls thm); - in - (OF_prems ids, OF_prems (ids @ ids), OF_prems (ids @ bij_ids), OF_prems bij_ids, refl_prems) - end; - fun unfold_id lthy = unfold_thms lthy @{thms id_o o_id inv_id}; - - (* Functions for sets and set_transfers *) - val mk_rel_funD_settss = (fn sett => (rel_funD OF [sett OF (replicate fbound - @{thm supp_id_bound})]) |> Drule.rotate_prems ~1) |> map o map; - fun split_setss setss = map (chop fbound ##> drop passive ##>> chop fbound) setss - |> split_list |>> split_list; - fun split_setss_transp setss = transpose setss |> chop fbound ||> drop passive - ||>> chop fbound; - - (* Make free types *) - val (As, paramT) = lthy - |> mk_TFrees' sorts - ||> the_single o fst o mk_TFrees 1; - val fAs = take fbound As; - val CAs = subst_typs As (map #T T_sugars); - val ctorsAs = maps (#ctrs o #ctr_sugar o #fp_ctr_sugar) T_sugars |> subst_terms As; - val un_ctorsAs = if co - then maps (the_single o #selss o #ctr_sugar o #fp_ctr_sugar) T_sugars |> subst_terms As - else ctorsAs; - fun mk_casexsAs T = map (#casex o #ctr_sugar o #fp_ctr_sugar) T_sugars |> subst_terms (As @ [T]); - - (* Make frees *) - val (((((((((((ffs, fgs), xs), xs'), ys), ys'), zs), fsets), rho), param), varsOfs), - frees_lthy) = lthy - |> mk_Frees "f" (map2 (curry op -->) fAs fAs) - ||>> mk_Frees "g" (map2 (curry op -->) fAs fAs) - ||>> mk_Frees "x" (map (domain_type o fastype_of) ctorsAs) - ||>> mk_Frees "x'" (map (domain_type o fastype_of) ctorsAs) - ||>> mk_Frees "y" CAs - ||>> mk_Frees "y'" CAs - ||>> mk_Frees "z" fAs - ||>> mk_Frees "A" (take fbound As |> map HOLogic.mk_setT) - ||>> yield_singleton (mk_Frees "\") paramT - ||>> yield_singleton (mk_Frees "Param") (HOLogic.mk_setT paramT) - ||>> mk_Frees "varsOf" (take fbound As |> map (fn A => paramT --> HOLogic.mk_setT A)); - val ffs_ids = ffs @ map HOLogic.id_const (drop fbound As); - val fids = map HOLogic.id_const fAs; - - (* Make mrbnf terms *) - fun mk_rec_lives xs = map2 replicate ks xs |> flat; - fun dest_rec_lives xs = unflat (map (fn k => replicate k []) ks) xs; - fun mk_mrbnf_terms mk_Ts' As Bs CAs CBs of_mrbnf repl app_Us map_fun Ts = - let - val (Fs', TAs') = chop fbound As; - val ((pFs', pTAs'), pBs') = chop pfree TAs' ||>> chop plive; - val pTBs' = drop (fbound+pfree) Bs |> take plive; - val CAs' = mk_rec_lives CAs; - val CBs' = mk_rec_lives CBs; - fun mk_mrbnf_id_map Fs Ts mrbnf = app_Us (pTBs' @ CBs' |> repl, of_mrbnf - (deads_of_mrbnf mrbnf |> repl) (pTAs' @ CAs' |> repl)) (pBs' @ Fs' |> repl) - (Fs' @ pFs' |> repl) mrbnf - |> map_fun (Term.subst_atomic_types ((Fs' ~~ Fs) @ (mk_Ts' (TAs', pTBs') ~~ Ts))); - in - map (chop fbound Ts |-> mk_mrbnf_id_map) mrbnfs - end; - fun mk_mrbnf_id_terms of_mrbnf = mk_mrbnf_terms fst As As CAs CAs of_mrbnf; - val mrbnf_maps_AsAs = mk_mrbnf_id_terms mk_map_of_mrbnf I op |> I As; - val mrbnf_rels_AsAs = mk_mrbnf_id_terms mk_mr_rel_of_mrbnf I op |> I As; - val mrbnf_setss_As = mk_mrbnf_id_terms mk_sets_of_mrbnf (2*fbound + passive + rec_live - |> replicate) snd map As; - val ((free_setss_Ast, bound_setss_Ast), _) = split_setss_transp mrbnf_setss_As; - val ((_, bound_setss_As), rec_setss_As) = split_setss mrbnf_setss_As; - fun comb_mrbnf_term non_recs recs mrbnf_term = list_comb (mrbnf_term, - non_recs @ take fbound non_recs @ mk_rec_lives recs); - - (* Define rename primrec *) - val ((renamesAs, _ (*renames*), _ (*rename_defs*), rename_simps), lthy) = - let - (* Make names and types *) - val renameNs = map mk_renameN names; - val rename_bs = map Binding.name renameNs; - val renamesAs = map (fn CA => take fbound (map2 (curry op -->) As As) ---> (CA --> CA)) CAs; - - (* Make terms for primrec definition *) - val recs = map2 (list_comb o rpair ffs o Free oo pair) renameNs renamesAs; - fun mk_def_terms rename_t mrbnf_map_AsAs x ctorAs = (rename_t $ (ctorAs $ x), ctorAs $ - (comb_mrbnf_term ffs_ids (map HOLogic.id_const CAs) mrbnf_map_AsAs $ - (comb_mrbnf_term (map HOLogic.id_const As) recs mrbnf_map_AsAs $ x))) |> mk_Trueprop_eq - |> fold_rev Logic.all (ffs @ [x]); - fun mk_codef_terms rename_t mrbnf_map_AsAs y ctorAs un_ctorAs = - (rename_t $ y, ctorAs $ - (comb_mrbnf_term (map HOLogic.id_const As) recs mrbnf_map_AsAs $ (comb_mrbnf_term - ffs_ids (map HOLogic.id_const CAs) mrbnf_map_AsAs $ (un_ctorAs $ y)))) - |> mk_Trueprop_eq |> fold_rev Logic.all (ffs @ [y]); - val def_terms = if co - then @{map 5} mk_codef_terms recs mrbnf_maps_AsAs ys ctorsAs un_ctorsAs - else @{map 4} mk_def_terms recs mrbnf_maps_AsAs xs ctorsAs; - - (* Define primrec and export terms and theorems *) - val ((terms, defs, simpss), (new_lthy, old_lthy)) = lthy - |> snd o Local_Theory.begin_nested - |> (if co then primcorec else primrec) false - (rename_bs ~~ renamesAs |> map (rpair NoSyn)) def_terms - ||> `Local_Theory.end_nested; - val phi = Proof_Context.export_morphism old_lthy new_lthy; - val (termsAs, terms) = map_split (Morphism.term phi #> `dest_Const #>> fst) terms - |>> map2 (Const oo rpair) renamesAs; - val (defs, simps) = apply2 (Morphism.fact phi) (defs, flat simpss); - in - ((termsAs, terms, defs, simps), new_lthy) - end; - - val ((mr_rel_refl_ids, mr_rel_refl_strong_ids, mr_rel_mono_strong_ids)) = - let - fun map_fun map of_mrbnf mrbnf = - map (unfold_thms lthy [mr_rel_id_of_mrbnf mrbnf]) (of_mrbnf mrbnf); - fun subs_rel of_mrbnf = map (map_fun I of_mrbnf) mrbnfs; - in - @{apply 3} subs_rel (rel_refl_of_mrbnf, rel_refl_strong_of_mrbnf, rel_mono_strong_of_mrbnf) - end; - val natLeq_bounds = map natLeq_bound_of_mrbnf mrbnfs; - val Un_bounds = map Un_bound_of_mrbnf mrbnfs; - val UNION_bounds = map UNION_bound_of_mrbnf mrbnfs; - val set_boundss = map (fn mrbnf => set_bd_of_mrbnf mrbnf |> map - (fn set_bd => @{thm ordLess_ordLeq_trans} OF [set_bd, var_large_of_mrbnf mrbnf])) mrbnfs; - val var_infinites = map (unfold_thms lthy @{thms cinfinite_def Field_card_of} - o UNIV_cinfinite_of_mrbnf) mrbnfs; - val settss = map (map id_prems o mr_set_transfer_of_mrbnf) mrbnfs; - val ((free_settss, bound_settss), rec_settss) = split_setss_transp (mk_rel_funD_settss settss); - - val supp_comp_bounds = map supp_comp_bound_of_mrbnf mrbnfs; - val map_comps = map (unfold_id lthy o id_prems2 o map_comp_of_mrbnf) mrbnfs; - val map_congs = map (unfold_id lthy o id_prems2 o map_cong_of_mrbnf) mrbnfs; - val set_maps = map (map id_prems o set_map_of_mrbnf) mrbnfs; - val set_map = flat set_maps; - val mr_rel_monos = map (id_prems o mr_rel_mono_of_mrbnf) mrbnfs; - val mr_rel_eqs = map mr_rel_eq_of_mrbnf mrbnfs; - val mr_rel_maps = map (nth_map 2 (unfold_id lthy o bij_id_prems) o - nth_map 1 (unfold_id lthy o id_prems2) o nth_map 0 (unfold_id lthy o id_prems2) o - mr_rel_map_of_mrbnf) mrbnfs; - val mr_rel_mono_strong0s = map (refl_prems (6*fbound+1) ballI o unfold_id lthy o id_prems2 o - mr_rel_mono_strong0_of_mrbnf) mrbnfs; - val mr_le_rel_OOs = map (unfold_id lthy o id_prems2 o mr_le_rel_OO_of_mrbnf) mrbnfs; - val mr_rel_flips = map (unfold_id lthy o bij_prems o mr_rel_flip_of_mrbnf) mrbnfs; - - val prem_terms_ffs = mk_prem_terms ffs; - val prem_terms_ffs_fgs = prem_terms_ffs @ mk_prem_terms fgs; - val prem_terms_fsets = map (HOLogic.mk_Trueprop o mk_bound) fsets; - fun prove lthy frees prems goal tac = Goal.prove_sorry lthy (map (fst o dest_Free) frees) - prems goal (fn {context = ctxt, prems = assms} => tac ctxt assms) - |> Thm.close_derivation \<^here>; - fun prove_no_prems lthy frees goal tac = Goal.prove_sorry lthy (map (fst o dest_Free) frees) [] - goal (fn {context = ctxt, prems = _} => tac ctxt) - |> Thm.close_derivation \<^here>; - - val mk_conjs = foldr1 HOLogic.mk_conj; - val (split_conjs, split_Nconjs) = - let - fun split_conjs 1 thm = [thm] - | split_conjs n thm = (conjunct1 OF [thm]) :: split_conjs (n-1) (conjunct2 OF [thm]); - in (split_conjs n, (fn n => if n < 1 then single else split_conjs n)) end; - - fun mk_induct_inst lthy thm eqs ys = thm_instantiate_terms lthy - (map2 (absfree o dest_Free) ys eqs @ ys |> map SOME) thm; - fun mk_coinduct_inst frees_lthy Ts lthy thm eqs ys = - let - val (ls, rs) = frees_lthy - |> mk_Frees "l" Ts - ||> fst o mk_Frees "r" Ts; - fun mk_rel l r y lhs rhs = HOLogic.mk_conj (HOLogic.mk_eq (l, lhs), HOLogic.mk_eq (r, rhs)) - |> list_exists_free [y] |> fold_rev (absfree o dest_Free) [l, r]; - val (lhss, rhss) = map_split HOLogic.dest_eq eqs; - val rels = @{map 5} mk_rel ls rs ys lhss rhss; - val insts = map2 (fn lhs => fn rhs => [lhs, rhs]) lhss rhss |> flat; - in - meta_mp OF [@{thm _} ,thm_instantiate_terms lthy (rels @ insts |> map SOME) thm] - end; - val raw_common_co_induct = hd T_sugars |> the o #fp_co_induct_sugar |> hd o #common_co_inducts - |> (if co then unfold_thms lthy (map mr_rel_id_of_mrbnf mrbnfs) else I); - fun mk_common_co_induct_inst frees_lthy Ts lthy = if co - then mk_coinduct_inst frees_lthy Ts lthy raw_common_co_induct - else mk_induct_inst lthy raw_common_co_induct; - val raw_injects = maps (#injects o #ctr_sugar o #fp_ctr_sugar) T_sugars; - val raw_splits = map (#split o #ctr_sugar o #fp_ctr_sugar) T_sugars; - val raw_exhausts = map (#exhaust o #ctr_sugar o #fp_ctr_sugar) T_sugars; - val raw_nchotomys = map (#nchotomy o #ctr_sugar o #fp_ctr_sugar) T_sugars; - val raw_sels = if co - then maps (the_single o #sel_thmss o #ctr_sugar o #fp_ctr_sugar) T_sugars - else replicate n @{thm _}; - val raw_collapses = if co - then maps (#collapses o #ctr_sugar o #fp_ctr_sugar) T_sugars - else replicate n @{thm _}; - - fun mk_rename_simp rename_t mrbnf_map_AsAs x y ctorAs un_ctorAs map_comp rename_simp raw_sel - raw_collapse = - let - val recs = map (list_comb o rpair ffs) renamesAs; - val rename_sel = if co - then - let - val sel_goal = (un_ctorAs $ (list_comb (rename_t, ffs) $ y), - (comb_mrbnf_term ffs_ids recs mrbnf_map_AsAs $ (un_ctorAs $ y))) |> mk_Trueprop_eq; - in - mk_rename_sel_tac map_comp rename_simp raw_sel - |> prove lthy (ffs @ [y]) prem_terms_ffs sel_goal - |> SOME - end - else NONE; - val rename_sel' = case rename_sel of SOME thm => [thm] | _ => []; - - val goal = (list_comb (rename_t, ffs) $ (ctorAs $ x), ctorAs $ - (comb_mrbnf_term ffs_ids recs mrbnf_map_AsAs $ x)) |> mk_Trueprop_eq; - in - (rename_sel, mk_rename_simps_tac co map_comp rename_simp rename_sel' raw_sel raw_collapse - |> prove lthy (ffs @ [x]) prem_terms_ffs goal) - end; - val (rename_sels, rename_simps) = - @{map 10} mk_rename_simp renamesAs mrbnf_maps_AsAs xs ys ctorsAs un_ctorsAs map_comps - rename_simps raw_sels raw_collapses |> split_list |>> map_filter I; - - val rename_ids = - let - fun mk_eq rename_t y = HOLogic.mk_eq (list_comb (rename_t, fids) $ y, y); - val eqs = map2 mk_eq renamesAs ys; - val common_co_induct_inst = mk_common_co_induct_inst frees_lthy CAs lthy eqs ys; - val goal = mk_conjs eqs |> HOLogic.mk_Trueprop; - - fun mk_map_cong_thm mrbnf = trans OF [map_cong_of_mrbnf mrbnf, map_id0_of_mrbnf mrbnf - RS fun_cong] RS @{thm trans[OF _ id_apply]}; - val map_cong_thms = map mk_map_cong_thm mrbnfs; - in - mk_rename_ids_tac co common_co_induct_inst rename_simps raw_injects map_cong_thms - rename_sels (flat mr_rel_maps) mr_rel_refl_ids - |> prove_no_prems lthy ys goal - |> split_conjs - end; - val rename_id0s = map (fn thm => @{thm meta_eq_to_obj_eq} OF [ - Local_Defs.unfold0 lthy @{thms id_def[symmetric]} (Local_Defs.abs_def_rule lthy thm) - ]) rename_ids - - val rename_comps = - let - fun mk_eq rename_t y = HOLogic.mk_eq - (list_comb (rename_t, map2 (curry HOLogic.mk_comp) fgs ffs) $ y, - list_comb (rename_t, fgs) $ (list_comb (rename_t, ffs) $ y)); - val eqs = map2 mk_eq renamesAs ys; - val common_co_induct_inst = mk_common_co_induct_inst frees_lthy CAs lthy eqs ys; - val goal = mk_conjs eqs |> HOLogic.mk_Trueprop; - in - mk_rename_comps_tac co common_co_induct_inst raw_injects rename_simps supp_comp_bounds - map_comps map_congs rename_sels (flat mr_rel_maps) mr_rel_refl_ids - |> prove lthy (ffs @ fgs @ ys) prem_terms_ffs_fgs goal - |> split_conjs - |> map (fn thm => thm RS sym) - end; - fun mk_rename_comp0s lthy = map2 (fn thm => fn rename_t => - let - val goal = mk_Trueprop_eq ( - HOLogic.mk_comp (Term.list_comb (rename_t, fgs), Term.list_comb (rename_t, ffs)), - Term.list_comb (rename_t, map2 (curry HOLogic.mk_comp) fgs ffs) - ); - in prove lthy (ffs @ fgs) prem_terms_ffs_fgs goal (fn ctxt => fn prems => - EVERY1 [ - K (Ctr_Sugar_Tactics.unfold_thms_tac ctxt @{thms comp_def}), - rtac ctxt ext, - rtac ctxt trans, - rtac ctxt (thm OF prems), - K (Ctr_Sugar_Tactics.unfold_thms_tac ctxt @{thms comp_def}), - rtac ctxt refl - ] - ) end - ); - val rename_comp0s = mk_rename_comp0s lthy rename_comps renamesAs; - - fun mk_rename_bij lthy rename_t rename_comp0 rename_id0 = - let val goal = HOLogic.mk_Trueprop (mk_bij (Term.list_comb (rename_t, ffs))); - in prove lthy ffs prem_terms_ffs goal (mk_rename_bij_tac rename_comp0 rename_id0) end; - val rename_bijs = @{map 3} (mk_rename_bij lthy) renamesAs rename_comp0s rename_id0s; - - fun mk_rename_inv_simp lthy rename_t rename_comp0 rename_id0 = - let val goal = mk_Trueprop_eq ( - mk_inv (Term.list_comb (rename_t, ffs)), - Term.list_comb (rename_t, map mk_inv ffs) - ) in prove lthy ffs prem_terms_ffs goal (mk_rename_inv_simp_tac rename_comp0 rename_id0) end; - val rename_inv_simps = @{map 3} (mk_rename_inv_simp lthy) renamesAs rename_comp0s rename_id0s; + val co = (fp_kind = BNF_Util.Greatest_FP); + val mrbnfs = map (snd o fst) mrbnf_ks; + val (bound_freesss, binding_relation) = split_list (map split_list binding_relation); + val rec_vars = map snd mrbnf_ks; + val nrecs = fold (curry (op+)) rec_vars 0; + val nbfrees = map (fn xs => length (fold (union (op=)) xs [])) bound_freesss; + val nbfree = fold (curry (op+)) nbfrees 0; + val free = MRBNF_Def.free_of_mrbnf (hd mrbnfs) - nbfree; + val nvars = length binding_relation; + val T_names = map (fst o fst) mrbnf_ks; + (* TODO: error handling *) + + val npre_args = MRBNF_Def.live_of_mrbnf (hd mrbnfs) + MRBNF_Def.free_of_mrbnf (hd mrbnfs) + MRBNF_Def.bound_of_mrbnf (hd mrbnfs); + val sort = foldl1 (Sign.inter_sort (Proof_Context.theory_of lthy)) (map MRBNF_Def.class_of_mrbnf mrbnfs) + val (tvars as ((((frees, pfrees), plives), pbounds), deadss), _) = lthy + |> mk_TFrees' (replicate nvars sort) + ||>> mk_TFrees' (replicate (free - nvars) sort) + ||>> mk_TFrees (MRBNF_Def.live_of_mrbnf (hd mrbnfs) - nrecs) + ||>> mk_TFrees' (replicate (MRBNF_Def.bound_of_mrbnf (hd mrbnfs) - length (flat binding_relation)) sort) + ||>> fold_map (mk_TFrees' o map Type.sort_of_atyp o MRBNF_Def.deads_of_mrbnf) mrbnfs; + val passives = pfrees @ plives @ pbounds; + val npassive = length passives; + val bounds = flat (map2 (fn xs => replicate (length xs)) binding_relation frees); + + val bfreess = map2 replicate nbfrees frees; + val bfrees = flat bfreess; + + fun replicate_rec xs = flat (map2 (fn (_, k) => replicate k) mrbnf_ks xs); + val mk_recs = replicate_rec o map (fn n => Type (n, frees @ passives)); + + val (raw_Ts, lthy) = + let + val T_long_names = map (fn ((n, _), _) => Local_Theory.full_name lthy (Binding.name (prefix "raw_" n))) mrbnf_ks; + val args = map (fn T => (T, Type.sort_of_atyp T)) (frees @ passives); + val T_specs = map (fn ((n, mrbnf), _) => (((( + (map (pair NONE) args, Binding.name ("raw_" ^ n)), NoSyn), + [(((Binding.empty, Binding.name ("raw_" ^ n ^ "_ctor")), + [(Binding.empty, Type (fst (dest_Type (MRBNF_Def.T_of_mrbnf mrbnf)), + frees @ passives @ bounds @ bfrees @ mk_recs T_long_names + ))]), NoSyn) + ]), + (Binding.empty, Binding.empty, Binding.empty)), [] + )) mrbnf_ks; + val lthy = BNF_FP_Def_Sugar.co_datatypes fp_kind (if co + then BNF_GFP.construct_gfp else BNF_LFP.construct_lfp + ) ((K false, false), T_specs) lthy; + val T_sugars = map (the o BNF_FP_Def_Sugar.fp_sugar_of lthy) T_long_names; + in (map (fn sugar => + let + val subst = (snd (dest_Type (#T sugar)) ~~ (frees @ passives)); + val tsubst = Term.typ_subst_atomic subst; + val subst = Term.subst_atomic_types subst; + val ctr_sugar = #ctr_sugar (#fp_ctr_sugar sugar); + in { + T = tsubst (#T sugar), + ctor = subst (hd (#ctrs ctr_sugar)), + induct = hd (#common_co_inducts (the (#fp_co_induct_sugar sugar))), + inject = hd (#injects ctr_sugar), + exhaust = #exhaust ctr_sugar + } end + ) T_sugars, lthy) end; + + val rec_boundsss = map (fn rels => map (fn i => + @{map_filter 2} (fn j => fn rel => + if member (op=) rel i then SOME j else NONE + ) (0 upto length rels - 1) rels + ) (0 upto nrecs - 1)) binding_relation; + + val (vars as (((((((fs, hss), raw_xs), raw_ys), aa), As), raw_zs), raw_zs'), _) = lthy + |> mk_Frees "f" (map (fn a => a --> a) frees) + ||>> mk_Freess "h" (@{map 3} (fn a => fn rels => map_filter (fn xs => + let val n = length xs + in if n > 0 andalso n < length rels then SOME (a --> a) else NONE end + )) frees binding_relation rec_boundsss) + ||>> mk_Frees "x" (map (fst o dest_funT o fastype_of o #ctor) raw_Ts) + ||>> mk_Frees "y" (map (fst o dest_funT o fastype_of o #ctor) raw_Ts) + ||>> mk_Frees "a" frees + ||>> mk_Frees "A" (map HOLogic.mk_setT frees) + ||>> mk_Frees "z" (map #T raw_Ts) + ||>> mk_Frees "z'" (map #T raw_Ts); + val bfree_fss = map2 replicate nbfrees fs; + val bfree_fs = flat bfree_fss; + val bound_fs = flat (map2 (fn xs => replicate (length xs)) binding_relation fs); + val names = map (fst o dest_Free); + + val f_prems = maps (fn f => map HOLogic.mk_Trueprop [mk_bij f, mk_supp_bound f]) fs; + + val bound_ids = map HOLogic.id_const (pbounds @ bounds); + val free_ids = map HOLogic.id_const (frees @ pfrees @ bfrees); + val plive_ids = map HOLogic.id_const plives; - (* Define inductive predicate free *) - fun mk_inductive i A z b_vec free_sets bound_sets lthy = - let - val i = if fbound > 1 then i else 0; - val bs = map (Binding.concealed o Binding.name o mk_freeN i) names; - val Ts = map (fn CA => A --> CA --> HOLogic.boolT) CAs; - val inductive_flags = {quiet_mode = true, verbose = false, alt_name = Binding.empty, - coind = false, no_elim = false, no_ind = false, skip_mono = false}; - val free_ts = map2 (Free oo pair o Binding.name_of) bs Ts; - - fun mk_terms ys x ctor free_t free_set bound_set rec_sets = - let - val concl = free_t $ z $ (ctor $ x); - val t_free = [HOLogic.mk_mem (z, free_set $ x), concl]; - val add_non_mem = HOLogic.mk_mem (z, bound_set $ x) |> HOLogic.mk_not |> curry op ::; - val concls = mk_rec_lives free_ts |> map2 (fn y => fn t => [t $ z $ y, concl]) ys - |> swap o `(map add_non_mem) |-> map_binding_vector b_vec; - val rec_ts = @{map 3} (fn t => t $ x |> rpair #> HOLogic.mk_mem #> curry op ::) - rec_sets ys concls; - in - t_free :: rec_ts |> map (foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop) - end; - val terms = @{map 6} (mk_rec_lives ys |> mk_terms) xs ctorsAs free_ts free_sets - bound_sets rec_setss_As |> flat; - - val (invar_result_raw, (new_lthy, lthy)) = lthy - |> Local_Theory.begin_nested |> snd - |> Inductive.add_inductive inductive_flags (map2 (rpair NoSyn oo pair) bs Ts) [] - (map (pair Binding.empty_atts) terms) [] - ||> `Local_Theory.end_nested; - - val phi = Proof_Context.export_morphism lthy new_lthy; - val invar_result = Inductive.transform_result phi invar_result_raw; - fun subst_free Ts free = Term.subst_TVars - ((Term.add_tvar_namesT (fastype_of free |> range_type) [] |> rev) ~~ Ts) free; - val frees_freesAs = map (`(subst_free As) o Morphism.term phi) free_ts |> split_list; - in - ((invar_result, frees_freesAs), new_lthy) - end; - val ((frees_invar_results, (freessAs, _ (*freess*))), lthy) = - @{fold_map 6} mk_inductive (1 upto fbound) (take fbound As) zs binding_matrix - free_setss_Ast bound_setss_Ast lthy |>> apsnd split_list o split_list; + val (_, lthy) = Local_Theory.begin_nested lthy; + val (permute_raws, lthy) = + let + val (permute_raws, _) = @{fold_map 2} (fn raw => fn name => apfst hd o + mk_Frees ("permute_raw_" ^ name) [map (fn a => a --> a) frees ---> #T raw --> #T raw] + ) raw_Ts T_names lthy; + + val rec_ts = replicate_rec (map (fn perm => Term.list_comb (perm, fs)) permute_raws); + val eqs = @{map 5} (fn mrbnf => fn perm => fn raw => fn x => fn deads => + fold_rev Logic.all (fs @ [x]) (mk_Trueprop_eq ( + Term.list_comb (perm, fs) $ (#ctor raw $ x), + #ctor raw $ (MRBNF_Def.mk_map_comb_of_mrbnf deads + (plive_ids @ map HOLogic.id_const (replicate_rec (map #T raw_Ts))) + (map HOLogic.id_const pbounds @ bound_fs) (fs @ map HOLogic.id_const pfrees @ bfree_fs) mrbnf $ + (MRBNF_Def.mk_map_comb_of_mrbnf deads (plive_ids @ rec_ts) bound_ids free_ids mrbnf $ x) + ))) + ) mrbnfs permute_raws raw_Ts raw_xs deadss; + + val ((_, (permute_raws, _, (_, simps))), lthy) = BNF_LFP_Rec_Sugar.primrec_simple false + (map (fn T => (apfst Binding.name (dest_Free T), NoSyn)) permute_raws) eqs lthy; + + val simp_goals = @{map 5} (fn mrbnf => fn perm => fn raw => fn x => fn deads => mk_Trueprop_eq ( + Term.list_comb (perm, fs) $ (#ctor raw $ x), + #ctor raw $ (MRBNF_Def.mk_map_comb_of_mrbnf deads (plive_ids @ rec_ts) + (map HOLogic.id_const pbounds @ bound_fs) (fs @ map HOLogic.id_const pfrees @ bfree_fs) mrbnf $ x) + )) mrbnfs permute_raws raw_Ts raw_xs deadss; + + val simps = @{map 4} (fn goal => fn simp => fn mrbnf => fn x => Goal.prove_sorry lthy (names (fs @ [x])) f_prems goal (fn {context=ctxt, prems} => EVERY1 [ + rtac ctxt trans, + resolve_tac ctxt simp, + EqSubst.eqsubst_tac ctxt [0] [MRBNF_Def.map_comp_of_mrbnf mrbnf], + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ prems), + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id}), + rtac ctxt refl + ])) simp_goals simps mrbnfs raw_xs; + in (permute_raws ~~ simps, lthy) end + + val setss = map (fn mrbnf => + let val subst = Term.subst_atomic_types (snd (dest_Type (MRBNF_Def.T_of_mrbnf mrbnf)) ~~ + (frees @ passives @ bounds @ bfrees @ replicate_rec (map #T raw_Ts))); + in map subst (MRBNF_Def.sets_of_mrbnf mrbnf) end + ) mrbnfs; + val rec_setss = map (drop (npre_args - nrecs)) setss; + val free_setss = map (take nvars) setss; + val (bound_setsss, rest) = split_list (map (fold_map (chop o length) binding_relation o drop (nvars + npassive)) setss); - (* Define FVars *) - fun define_FVars i z frees lthy = - let - val i = if fbound > 1 then i else 0; - val (s, T) = dest_Free z; - fun mk_rhs y free = HOLogic.mk_Collect (s, T, free $ z $ y) |> (absfree o dest_Free) y; - in - @{fold_map 2} new_definition (map (Binding.name o mk_FVarsN i) names) - (map2 mk_rhs ys frees) lthy - end; - val ((FVars_termss, FVars_defss), lthy) = @{fold_map 3} define_FVars (1 upto fbound) zs freessAs - lthy |>> split_list o map (split_list o map (fn x => (#2 x, #3 x))); - val FVarsssAs = map (subst_terms As) FVars_termss; - - fun mk_free_FVars z y freeAs FVarsAs FVars_def = - (fn ctxt => unfold_tac ctxt [FVars_def, mem_Collect_eq]) |> prove_no_prems lthy [z, y] - (mk_Trueprop_eq (freeAs $ z $ y, HOLogic.mk_mem (z, FVarsAs $ y))); - val free_FVarsss = @{map 4} (fn z => @{map 4} (mk_free_FVars z) ys) zs freessAs FVarsssAs - FVars_defss; - - val (FVars_inducts, (_, FVars_intross, FVars_elimss)) = @{apply 3} - (flat free_FVarsss |> unfold_thms lthy |> map |> map) - ([map #induct frees_invar_results], map #intrs frees_invar_results, - map #elims frees_invar_results) |> `(the_single o #1); - - fun mk_FVars_ctor FVars_ts b_vec FVars_intros x ctor FVars_t rec_sets free_set bound_set - FVars_elim = - let - fun add_Diff t = mk_minus t (bound_set $ x); - fun mk_UN set (y, t) = t $ y |> (absfree o dest_Free) y |> mk_UNION (set $ x); - val UNs = ys ~~ FVars_ts |> mk_rec_lives |> map2 mk_UN rec_sets - |> swap o `(map add_Diff) |-> map_binding_vector b_vec; - val goal = (FVars_t $ (ctor $ x), foldl1 mk_union (free_set $ x :: UNs)) |> mk_Trueprop_eq; - in - mk_FVars_ctorss_Tac raw_injects FVars_intros FVars_elim - |> prove_no_prems lthy [x] goal - end; - val FVars_ctorss = @{map 6} (fn FVars_ts => fn b_rels => fn FVars_intros => @{map 7} - (mk_FVars_ctor FVars_ts b_rels FVars_intros) xs ctorsAs FVars_ts rec_setss_As) - FVarsssAs binding_matrix FVars_intross free_setss_Ast bound_setss_Ast FVars_elimss; + val bfree_setsss = map (fst o fold_map chop nbfrees) rest; - fun mk_FVars_rename_les z f FVars_ts FVars_induct FVars_intros = - let - val prems = map2 (HOLogic.mk_mem o pair z o op $ oo pair) FVars_ts ys; - val concls = @{map 3} (HOLogic.mk_mem o pair (f $ z) o op $ oo rpair o op $ oo pair o - list_comb o rpair ffs) renamesAs ys FVars_ts; - val goal = map2 (curry HOLogic.mk_imp) prems concls |> mk_conjs |> HOLogic.mk_Trueprop; - in - mk_FVars_rename_les_tac mutual FVars_induct FVars_intros rename_simps set_map - |> prove lthy (ffs @ ys @ [z]) prem_terms_ffs goal - |> split_conjs - end; - val FVars_rename_less = @{map 5} mk_FVars_rename_les zs ffs FVarsssAs FVars_inducts - FVars_intross; + val bfree_boundsss = map2 (fn n => fn bound_freess => + map (fn i => map_filter I ( + map_index (fn (j, ks) => if member (op=) ks i then SOME j else NONE) bound_freess + )) (0 upto n - 1) + ) nbfrees bound_freesss; - fun mk_FVars_rename f y rename_recAs rename_comp rename_id FVars_t FVars_rename_le = + val (is_freess, lthy) = let - val goal = (FVars_t $ (list_comb(rename_recAs, ffs) $ y), mk_image f $ (FVars_t $ y)) - |> mk_Trueprop_eq; - fun mk_FVars_rename_le_alt assms = FVars_rename_le RS mp OF mk_inv_assms assms; - in - mk_FVars_rename_tac rename_comp rename_id FVars_rename_le mk_FVars_rename_le_alt - |> prove lthy (ffs @ [y]) prem_terms_ffs goal - end; - val FVars_renamess = @{map 3} - (fn f => @{map 6} (mk_FVars_rename f) ys renamesAs rename_comps rename_ids) - ffs FVarsssAs FVars_rename_less; - - fun mk_card_of_FVars_bounds rec_set_boundss free_set_bounds free_sets i A z FVarssAs - FVars_induct lthy = if co - then let - val tT = BNF_FP_Util.mk_sumTN_balanced CAs; - val (nat, t) = frees_lthy - |> yield_singleton (mk_Frees "n") HOLogic.natT - ||> fst o yield_singleton (mk_Frees "t") tT; - - val (set_levelAs, _ (*set_level_def*), set_level_simps, lthy) = - let - (* Make names and types *) - val i = if fbound > 1 then i else 0; - val set_levelN = mk_set_levelN i names; - val set_level_b = Binding.name set_levelN; - val set_levelAs = HOLogic.natT --> tT --> HOLogic.mk_setT A; - - (* Make terms for primrec definition *) - val set_level_t = Free (set_levelN, set_levelAs); - val zero_term = (set_level_t $ HOLogic.zero $ t, Const (@{const_name bot}, - HOLogic.mk_setT A)) |> mk_Trueprop_eq |> Logic.all t; - - val casexs = mk_casexsAs (HOLogic.mk_setT A); - fun mk_union_term x (y, i) set = mk_UNION (set $ x) - (set_level_t $ nat $ mk_sumN_balanced ys i |> absfree (dest_Free y)); - fun mk_case_term x y casex fset sets = casex $ (fset $ x :: - map2 (mk_union_term x) (ys ~~ (1 upto n) |> mk_rec_lives) sets |> foldl1 mk_union - |> absfree (dest_Free x)) $ y |> absfree (dest_Free y); - val suc_term = mk_Trueprop_eq (set_level_t $ HOLogic.mk_Suc nat $ t, - (@{map 5} mk_case_term xs ys casexs free_sets rec_setss_As - |> mk_case_sumN_balanced) $ t) |> fold_rev Logic.all [nat, t]; - - (* Define primrec and export terms and theorems *) - val ((terms, defs, simpss), (new_lthy, old_lthy)) = lthy - |> snd o Local_Theory.begin_nested - |> primrec false [((set_level_b, set_levelAs), NoSyn)] [zero_term, suc_term] - ||> `Local_Theory.end_nested; - val phi = Proof_Context.export_morphism old_lthy new_lthy; - val termAs = the_single terms |> Morphism.term phi |> dest_Const |> fst - |> (Const oo rpair) set_levelAs; - val (def, simps) = apply2 (Morphism.fact phi) (defs, flat simpss) |>> the_single; - in - (termAs, def, simps, new_lthy) - end; + val flags = { quiet_mode = true, verbose = false, alt_name = Binding.empty, coind = false, no_elim = false, no_ind = false, skip_mono = false }; + val (is_freess, _) = @{fold_map 2} (fn name => fn raw => mk_Frees ("is_free_raw_" ^ name) + (map (fn a => a --> #T raw --> @{typ bool}) frees) + ) T_names raw_Ts lthy; - fun mk_bound t = mk_ordLess (mk_card_of t) (bd_of_mrbnf (hd mrbnfs)); - val ifcos = map bd_infinite_regular_card_order_of_mrbnf mrbnfs; + in @{fold_map 7} (fn is_frees => fn a => fn rels => fn free_sets => fn bound_setss => fn bfree_setss => fn bfree_boundss => + let + val mem = HOLogic.mk_Trueprop o HOLogic.mk_mem; - val set_level_bound = + val intross = @{map 7} (fn free_set => fn bound_sets => fn bfree_sets => fn raw => fn rec_sets => fn is_free => fn x => let - val goal = set_levelAs $ nat $ t |> mk_bound; - val nat_induct = thm_instantiate_terms lthy [list_all_free [t] goal - |> absfree (dest_Free nat) |> SOME] @{thm nat.induct} RS spec; + fun mk_not_bound bset = HOLogic.mk_Trueprop (HOLogic.mk_not (HOLogic.mk_mem (a, bset))); + val concl = HOLogic.mk_Trueprop (is_free $ a $ (#ctor raw $ x)); in - mk_set_level_bound_tac nat_induct set_level_simps raw_splits ifcos Un_bounds UNION_bounds - free_set_bounds (flat rec_set_boundss) - |> prove_no_prems lthy [nat, t] (HOLogic.mk_Trueprop goal) - end; + [Logic.mk_implies (mem (a, free_set $ x), concl)] + @ map2 (fn bfree_bounds => fn bfree_set => Logic.mk_implies ( + mem (a, bfree_set $ x), Logic.mk_implies ( + mk_not_bound (foldl1 mk_Un (map (fn i => nth bound_sets i $ x) bfree_bounds)), + concl + )) + ) bfree_boundss bfree_sets + @ @{map 4} (fn i => fn set => fn z => fn is_free => + let val bnd = map_filter I (map2 (fn rel => fn bset => + if member (op=) rel i then SOME (bset $ x) else NONE + ) rels bound_sets) + in Logic.mk_implies (mem (z, set $ x), Logic.mk_implies ( + HOLogic.mk_Trueprop (is_free $ a $ z), + case bnd of + [] => concl + | _ => Logic.mk_implies (mk_not_bound (foldl1 mk_Un bnd), concl) + )) end + ) (0 upto nrecs - 1) rec_sets (replicate_rec raw_zs) (replicate_rec is_frees) + end + ) free_sets bound_setss bfree_setss raw_Ts rec_setss is_frees raw_xs; - val FVars_overapproxs = - let - fun mk_eq FVars_t y i = HOLogic.mk_imp (HOLogic.mk_mem (z, FVars_t $ y), - HOLogic.mk_mem (z, mk_UNION (HOLogic.mk_UNIV HOLogic.natT) - (set_levelAs $ nat $ mk_sumN_balanced ys i |> absfree (dest_Free nat)))); - val goal = @{map 3} mk_eq FVarssAs ys (1 upto n) |> mk_conjs |> HOLogic.mk_Trueprop; - in - mk_FVars_overapprox_tac mutual FVars_induct set_level_simps raw_injects raw_splits - |> prove_no_prems lthy (ys @ [z]) goal - |> split_conjs - |> map (fn thm => thm RS mp) - end; - - val suc_ifcos = map (fn mrbnf => - let val ifco = bd_infinite_regular_card_order_of_mrbnf mrbnf; - in @{thm infinite_regular_card_order_card_suc} OF [ - @{thm infinite_regular_card_order.card_order} OF [ifco], - @{thm infinite_regular_card_order.Cinfinite} OF [ifco] - ] end - ) mrbnfs; - val UNION_bounds = map (fn ifco => @{thm regularCard_UNION_bound} OF [ - @{thm infinite_regular_card_order.Cinfinite} OF [ifco], - @{thm infinite_regular_card_order.regularCard} OF [ifco] - ]) suc_ifcos; - fun mk_card_of_FVars_bound FVars_t y FVars_overapprox UNION_bound card_order natLeq_bound = - let - fun mk_bound t = mk_ordLess (mk_card_of t) (mk_card_suc (bd_of_mrbnf (hd mrbnfs))); - val goal = FVars_t $ y |> mk_bound |> HOLogic.mk_Trueprop; - val set_level_bound' = @{thm ordLess_transitive} OF [ - set_level_bound, - @{thm card_suc_greater} OF [card_order] - ]; - val UNION_bound = thm_instantiate_terms lthy [SOME @{term "UNIV::nat set"}] - UNION_bound OF [@{thm _}, set_level_bound']; - in - mk_co_card_of_FVars_bounds_tac FVars_overapprox UNION_bound natLeq_bound - |> prove_no_prems lthy [y] goal - end; - in - @{map 6} mk_card_of_FVars_bound FVarssAs ys FVars_overapproxs UNION_bounds - (map bd_card_order_of_mrbnf mrbnfs) mrbnfs - |> rpair lthy + in Inductive.add_inductive flags + (map (fn T => (apfst Binding.name (dest_Free T), NoSyn)) is_frees) [] + (map (pair Binding.empty_atts) (flat intross)) [] end - else let - (* TODO: fix for mutual recursion, also do in co branch *) - fun mk_bound t = mk_ordLess (mk_card_of t) (bd_of_mrbnf (hd mrbnfs)); - val eqs = map2 (mk_bound o op $ oo pair) FVarssAs ys; - val common_co_induct_inst = mk_common_co_induct_inst frees_lthy CAs lthy eqs ys; - val goal = mk_conjs eqs |> HOLogic.mk_Trueprop; - val Un_bounds = map (fn mrbnf => @{thm infinite_regular_card_order_Un} OF [bd_infinite_regular_card_order_of_mrbnf mrbnf]) mrbnfs; - val UNION_bounds = map (fn mrbnf => - let val ifco = bd_infinite_regular_card_order_of_mrbnf mrbnf; - in @{thm regularCard_UNION_bound} OF [ - @{thm infinite_regular_card_order.Cinfinite} OF [ifco], - @{thm infinite_regular_card_order.regularCard} OF [ifco] - ] end - ) mrbnfs; - val intross = [Un_bounds, UNION_bounds, free_set_bounds] @ rec_set_boundss - |> transpose; - in - mk_card_of_FVars_bounds_tac common_co_induct_inst (flat FVars_ctorss) intross - |> prove_no_prems lthy ys goal - |> split_conjs - |> rpair lthy - end; - val (card_of_FVars_boundss', lthy) = - let - val set_boundss = map (set_bd_of_mrbnf) mrbnfs; - val (free_sboundss, rec_sboundss) = split_setss_transp set_boundss |>> fst; - in - @{fold_map 7} (mk_card_of_FVars_bounds rec_sboundss) free_sboundss free_setss_Ast - (1 upto fbound) (take fbound As) zs FVarsssAs FVars_inducts lthy - |> apfst transpose - end; - val card_of_FVars_boundss = map2 (fn mrbnf => - let - val card_order = bd_card_order_of_mrbnf mrbnf; - val ordIso = @{thm cardSuc_ordIso_card_suc} OF [card_order] RS @{thm ordIso_symmetric} - val covar_large = @{thm ordIso_ordLeq_trans} OF [ordIso, #covar_large (class_thms_of_mrbnf mrbnf)] - in map (fn thm => - @{thm ordLess_ordLeq_trans} OF [thm, if co then covar_large else var_large_of_mrbnf mrbnf] - ) end - ) mrbnfs card_of_FVars_boundss'; + ) (transpose is_freess) aa binding_relation (transpose free_setss) (transpose bound_setsss) (transpose bfree_setsss) bfree_boundsss lthy end; - (* Define alpha relation *) - val (alphas_invar_result, (alphasAs, _ (*alphas*)), FVarsBssAs, lthy) = - let - val bs = map (Binding.name o mk_alphaN) names; - val Ts = map (fn CA => CA --> CA --> HOLogic.boolT) CAs; - val inductive_flags = {quiet_mode = true, verbose = false, alt_name = Binding.empty, - coind = true, no_elim = false, no_ind = false, skip_mono = false}; - val alpha_ts = map2 (Free oo pair o Binding.name_of) bs Ts; + val mk_def_public = mk_def_t true Binding.empty I + val mk_defs_public = mk_defs_t true Binding.empty I + val (FVars_rawss, lthy) = @{fold_map 3} (fn name => fn preds => fn z => mk_defs_public ("FVars_raw_" ^ name) 1 + (map2 (fn a => fn pred => + Term.absfree (dest_Free z) (HOLogic.mk_Collect (fst (dest_Free a), snd (dest_Free a), pred $ Bound 0 $ z)) + ) aa preds) + ) T_names (transpose (map #preds is_freess)) raw_zs lthy; - fun mk_term x x' ctor alpha_t bound_sets rec_sets mrbnf_rel_AsAs = - let - val FVarsBs = - let - fun mk_zips FVars_ts = map (op $ o rpair x) rec_sets ~~ mk_rec_lives FVars_ts; - fun mk_bound_minus bound_set t = mk_minus t (bound_set $ x); - fun mk_UNION_term bound_set FVars_ts b_rels = map (nth (mk_zips FVars_ts) - #-> mk_UNION) b_rels |> map (mk_bound_minus bound_set) - |> foldl1 mk_union; - in - @{map 3} mk_UNION_term bound_sets FVarsssAs binding_relation - end; - val prems1 = map2 mk_id_on FVarsBs ffs; - - val recs_consts = ys ~~ ys' ~~ renamesAs ~~ alpha_ts |> mk_rec_lives; - val rename_args = apply2 (replicate rec_live |> map) (fids, ffs) - |-> transpose oo map_binding_matrix - |> map2 (fn b => if b then K NONE else SOME) no_bindings; - fun mk_rec_rel (_, alpha_t) NONE = alpha_t - | mk_rec_rel (((y, y'), rename_t), alpha_t) (SOME fs) = alpha_t $ (list_comb - (rename_t, fs) $ y) $ y' |> fold_rev (absfree o dest_Free) [y, y']; - val ideqs = map2 I (replicate free HOLogic.id_const @ replicate plive HOLogic.eq_const @ - replicate pbound HOLogic.id_const) As; - val prem0 = list_comb (mrbnf_rel_AsAs, ideqs @ ffs @ - map2 mk_rec_rel recs_consts rename_args) $ x $ x'; - val concl = alpha_t $ (ctor $ x) $ (ctor $ x'); - in - foldr1 Logic.mk_implies (prems1 @ [prem0, concl] |> map HOLogic.mk_Trueprop) - |> add_prems ffs |> rpair FVarsBs - end; - val (terms, FVarsBss) = @{map 7} mk_term xs xs' ctorsAs alpha_ts bound_setss_As - rec_setss_As mrbnf_rels_AsAs |> split_list; - - val monos = map (fn mr_rel_mono => mr_rel_mono OF replicate fbound - @{thm supp_id_bound}) mr_rel_monos @ @{thms conj_context_mono}; - - val (invar_result_raw, (new_lthy, lthy)) = lthy - |> Local_Theory.begin_nested |> snd - |> Inductive.add_inductive inductive_flags (map2 (rpair NoSyn oo pair) bs Ts) [] - (map (pair Binding.empty_atts) terms) monos - ||> `Local_Theory.end_nested; - - val phi = Proof_Context.export_morphism lthy new_lthy; - val invar_result = Inductive.transform_result phi invar_result_raw; - val frees_freesAs = map (Morphism.term phi) alpha_ts |> `(subst_terms As); - in - (invar_result, frees_freesAs, FVarsBss, new_lthy) - end; - - val alpha_coinduct = #induct alphas_invar_result; - val alpha_intros = #intrs alphas_invar_result; - val alpha_elims = #elims alphas_invar_result; - val T_cases = map (the o Induct.lookup_casesT lthy o fst o dest_Type) CAs; - val alpha_intros_id = map (fn thm => thm OF (replicate fbound @{thms bij_id supp_id_bound} - |> flat)) alpha_intros; - - val alpha_refls = - let - fun mk_eq y y' alpha_t = HOLogic.mk_imp (HOLogic.mk_eq (y, y'), alpha_t $ y $ y') - |> list_all_free [y, y']; - val eqs = @{map 3} mk_eq ys ys' alphasAs; - val goal = mk_conjs eqs |> HOLogic.mk_Trueprop; - - fun mk_case thm ct = infer_instantiate' lthy [SOME ct] thm; - val mk_cases = map mk_case T_cases; - in - mk_alpha_refls_tac mutual alpha_coinduct mk_cases raw_injects rename_ids - mr_rel_refl_strong_ids alpha_intros - |> prove_no_prems lthy (ys @ ys') goal - |> split_conjs - |> map (fn thm => thm RS @{thm spec2} RS mp OF [refl]) - end; + val nbounds = map length (hd bound_setsss); + val rec_bound_fss = @{map 4} (fn nbound => fn f => fn rec_boundss => fst o fold_map (fn rec_bounds => fn hs => + if length rec_bounds = 0 then (NONE, hs) + else if length rec_bounds = nbound then (SOME f, hs) else (SOME (hd hs), tl hs) + ) rec_boundss) nbounds fs rec_boundsss hss; - val alpha_bijs = + val live_Ts = plives @ replicate_rec (map #T raw_Ts); + val (alphas, lthy) = let - val ((fs', ls), rs) = frees_lthy - |> mk_Frees "f'" (map2 (curry op -->) As As |> take fbound) - ||>> mk_Frees "l" CAs - ||> fst o mk_Frees "r" CAs; + val alphas = map2 (fn name => fn raw => Free ("alpha_" ^ name, #T raw --> #T raw --> @{typ bool})) T_names raw_Ts; - fun mk_eq l r y y' alpha_t rename_t FVars_ts = - let - fun mk_rename_eq fs y lhs = HOLogic.mk_eq (lhs, list_comb (rename_t, fs) $ y); - val rename_eqs = [alpha_t $ y $ y', mk_rename_eq ffs y l, mk_rename_eq fs' y' r]; - - fun mk_ball_eq FVars_t f f' z = HOLogic.mk_eq (f $ z, f' $ z) |> absfree (dest_Free z) - |> mk_Ball (FVars_t $ y); - val ball_eqs = @{map 4} mk_ball_eq FVars_ts ffs fs' zs; - - val prem_terms = map HOLogic.dest_Trueprop (prem_terms_ffs @ mk_prem_terms fs'); - val prem = rename_eqs @ ball_eqs @ prem_terms |> mk_conjs - |> list_exists_free ([y, y'] @ ffs @ fs'); - val concl = alpha_t $ l $ r; - in - HOLogic.mk_imp (prem, concl) |> list_all_free [l, r] - end; - val eqs = @{map 7} mk_eq ls rs ys ys' alphasAs renamesAs (transpose FVarsssAs); - val goal = mk_conjs eqs |> HOLogic.mk_Trueprop; - - fun mk_exIss rename_comps fs fs' = + val intros = @{map 9} (fn x => fn y => fn alpha => fn bsetss => fn bfsetss => fn rec_sets => fn deads => fn mrbnf => fn raw => let - val exI_ts1 = apply2 (replicate rec_live |> map) (fs, fs') - |-> transpose oo map_binding_matrix; - val exI_ts2 = replicate rec_live fs'; - val exI_ts = exI_ts1 ~~ exI_ts2; - val map_fun = (fn t => infer_instantiate' lthy [NONE, SOME t] exI) |> map |> apply2; - in - mk_rec_lives rename_comps ~~ map map_fun exI_ts - end; - - fun after_qed thm = - let - fun OF_exI thm = thm OF @{thms exI}; - fun OF_conj_rotated thm = thm OF @{thms conjI[rotated]}; - fun OF_conjI_folded n thm = if n <= 0 then thm else thm OF [mk_conjIN n]; - in - ((thm RS @{thm spec2} RS mp) - |> funpow (2*(fbound+1)) OF_exI - OF @{thms conjI[rotated]} - OF @{thms conjI[OF refl]} - OF @{thms conjI[OF refl]}) - |> funpow fbound OF_conj_rotated - |> OF_conjI_folded (4*fbound) - end; - in - mk_alpha_bij_tac mutual fbound num_bindings alpha_coinduct alpha_elims rename_simps - (flat FVars_renamess) rename_comps raw_injects mk_exIss (flat FVars_ctorss) - supp_comp_bounds mr_rel_maps set_maps mr_rel_mono_strong0s - |> prove_no_prems lthy (ys @ ys') goal - |> split_conjs - |> map after_qed + val id_on_prems = @{map 6} (fn f => fn bsets => fn bfsets => fn bfree_boundss => fn rec_boundss => fn FVars_raws => mk_id_on (foldl1 mk_Un ( + map2 (fn bfset => fn bfree_bounds => + mk_minus (bfset $ x, foldl1 mk_Un (map (fn i => nth bsets i $ x) bfree_bounds)) + ) bfsets bfree_boundss + @ @{map_filter 3} (fn rec_set => fn rec_bounds => fn FVars_raw => + if length rec_bounds = length bsets then + SOME (mk_minus (mk_UNION (rec_set $ x) (fst FVars_raw), foldl1 mk_Un (map (fn s => s $ x) bsets))) + else NONE + ) rec_sets rec_boundss (replicate_rec FVars_raws) + )) f) fs bsetss bfsetss bfree_boundsss rec_boundsss (transpose FVars_rawss); + + val h_prems = flat (flat (@{map 5} (fn f => fn bsets => fn rec_boundss => fn FVars_raws => fn hs => + fst (@{fold_map 3} (fn rec_bounds => fn rec_set => fn FVars_raw => fn hs => + let val n = length rec_bounds + in if n > 0 andalso n < length bsets then + let + val h = hd hs; + val bset = foldl1 mk_Un (map (fn i => nth bsets i $ x) rec_bounds); + in (map HOLogic.mk_Trueprop [ + mk_bij h, + mk_supp_bound h, + mk_id_on (mk_minus (mk_UNION (rec_set $ x) (fst FVars_raw), bset)) h, + mk_eq_on bset h f + ], tl hs) end + else ([], hs) end + ) rec_boundss rec_sets (replicate_rec FVars_raws) hs)) fs bsetss rec_boundsss (transpose FVars_rawss) hss)); + + val mr_rel_prem = Term.list_comb ( + MRBNF_Def.mk_mr_rel_of_mrbnf deads live_Ts live_Ts bounds (frees @ pfrees @ bfrees) mrbnf, + map HOLogic.id_const (frees @ pfrees) @ map HOLogic.eq_const plives @ bound_fs @ bfree_fs + @ @{map 4} (fn rec_fs => fn alpha => fn permute => fn raw => + if null (map_filter I rec_fs) then alpha else Term.abs ("x", #T raw) (alpha $ ( + Term.list_comb (fst permute, map2 (fn f => + (fn SOME h => h | NONE => HOLogic.id_const (fst (dest_funT (fastype_of f)))) + ) fs rec_fs) $ Bound 0 + )) + ) (transpose rec_bound_fss) (replicate_rec alphas) (replicate_rec permute_raws) (replicate_rec raw_Ts) + ) $ x $ y; + in fold_rev (curry Logic.mk_implies) (f_prems @ map HOLogic.mk_Trueprop id_on_prems @ h_prems @ [HOLogic.mk_Trueprop mr_rel_prem]) ( + HOLogic.mk_Trueprop (alpha $ (#ctor raw $ x) $ (#ctor raw $ y)) + ) end + ) raw_xs raw_ys alphas bound_setsss bfree_setsss rec_setss deadss mrbnfs raw_Ts; + + val flags = { quiet_mode = true, verbose = false, alt_name = Binding.empty, coind = true, no_elim = false, no_ind = false, skip_mono = false }; + val monos = @{thm conj_context_mono} :: map (fn mrbnf => + MRBNF_Def.mr_rel_mono_of_mrbnf mrbnf OF ( + replicate (nvars + length pfrees) @{thm supp_id_bound} @ flat (replicate (length pbounds) @{thms bij_id supp_id_bound}) + ) + ) mrbnfs; + in Inductive.add_inductive flags + (map (fn T => (apfst Binding.name (dest_Free T), NoSyn)) alphas) [] + (map (pair Binding.empty_atts) intros) monos lthy end; - fun mk_alpha_bij_eq alpha_t rename_t y y' alpha_bij rename_comp rename_id = - let - val rename_t_ffs = list_comb (rename_t, ffs); - val goal = (alpha_t $ (rename_t_ffs $ y) $ (rename_t_ffs $ y'), alpha_t $ y $ y') - |> mk_Trueprop_eq; - fun mk_alpha_bij_alt assms = (alpha_bij OF (assms @ assms)) |> Drule.rotate_prems ~1; - fun mk_alpha_bij_alts assms = apply2 mk_alpha_bij_alt (mk_inv_assms assms, assms); - in - mk_alpha_bij_eq_tac rename_comp rename_id mk_alpha_bij_alts - |> prove lthy (ffs @ [y, y']) prem_terms_ffs goal - end; - val alpha_bij_eqs = @{map 7} mk_alpha_bij_eq alphasAs renamesAs ys ys' alpha_bijs rename_comps - rename_ids; - - fun mk_alpha_bij_eq_inv alpha_t rename_t y y' rename_comp rename_id alpha_bij_eq = - let - val goal = mk_Trueprop_eq (alpha_t $ (list_comb (rename_t, ffs) $ y) $ y', - alpha_t $ y $ (list_comb (rename_t, map mk_inv ffs) $ y')); - fun mk_unfolds [] = [rename_id] - | mk_unfolds (bij::assms) = (@{thm inv_o_simp2} OF [bij]) :: mk_unfolds (drop 1 assms); - val t_insts = map mk_inv ffs @ ffs @ [y'] |> map SOME; - fun mk_rename_comp_alt assms = thm_instantiate_terms lthy t_insts rename_comp - |> unfold_thms lthy (mk_unfolds assms) RS sym; - in - mk_alpha_bij_eq_inv_tac mk_rename_comp_alt alpha_bij_eq - |> prove lthy (ffs @ [y, y']) prem_terms_ffs goal - end; - val alpha_bij_eq_invs = @{map 7} mk_alpha_bij_eq_inv alphasAs renamesAs ys ys' rename_comps - rename_ids alpha_bij_eqs; - - fun mk_alpha_FVars_les reverse z FVars_ts FVars_induct set_transfers = - let - fun mk_eq y y' alpha_t FVars_t = HOLogic.mk_imp (HOLogic.mk_mem (z, FVars_t $ y), - HOLogic.mk_imp (list_comb (alpha_t, if reverse then [y', y] else [y, y']), - HOLogic.mk_mem (z, FVars_t $ y')) |> list_all_free [y']); - val eqs = @{map 4} mk_eq ys ys' alphasAs FVars_ts; - val goal = mk_conjs eqs |> HOLogic.mk_Trueprop; - in - mk_alpha_FVars_les_tac mutual reverse false (rec_live+1) (mk_rec_lives (map (rpair NONE) alpha_bij_eq_invs)) - FVars_induct alpha_elims raw_injects (flat FVars_renamess) (flat FVars_ctorss) - set_transfers [] - |> prove_no_prems lthy (ys @ [z]) goal - |> split_conjs - |> map (fn thm => thm RS mp RS spec RS mp) - end; - val alpha_FVars_less = - let - fun zip_opt (xs, NONE) = map (rpair NONE) xs - | zip_opt (xs, SOME ys) = xs ~~ map SOME ys; - fun add_bound_sett rec_settss free_setts bound_setts b_vec = - map (rpair NONE) rec_settss |> swap o `(SOME bound_setts |> map o apsnd o K) - |-> map_binding_vector b_vec |> map zip_opt - |> (map2 (curry op:: o rpair NONE) free_setts) o transpose; - val set_transferss = @{map 3} (add_bound_sett rec_settss) free_settss bound_settss - binding_matrix; - in - apply2 (fn reverse => @{map 4} (mk_alpha_FVars_les reverse) zs FVarsssAs - FVars_inducts set_transferss) (false, true) |-> map2 (curry op ~~) - end; - - fun mk_alpha_FVars y y' alpha_t FVars_t (alpha_FVars_le_left, alpha_FVars_le_right) = - let - val goal = Logic.mk_implies (alpha_t $ y $ y' |> HOLogic.mk_Trueprop, - mk_Trueprop_eq (FVars_t $ y, FVars_t $ y')); - in - mk_alpha_FVars_tac alpha_FVars_le_left alpha_FVars_le_right - |> prove_no_prems lthy [y, y'] goal - end; - val alpha_FVarsss = map2 (@{map 5} mk_alpha_FVars ys ys' alphasAs) FVarsssAs alpha_FVars_less; - - val alpha_syms = - let - fun mk_eq y y' alpha_t = HOLogic.mk_imp (alpha_t $ y' $ y, alpha_t $ y $ y') - |> list_all_free [y, y']; - val eqs = @{map 3} mk_eq ys ys' alphasAs; - val goal = mk_conjs eqs |> HOLogic.mk_Trueprop; - - fun mk_b_setts rec_setts = (nth rec_setts |> map o map) binding_relation; - val settsss = map op~~ (transpose bound_settss ~~ (transpose rec_settss |> map mk_b_setts)); - in - mk_alpha_sym_tac mutual fbound alpha_coinduct alpha_elims (flat FVars_renamess) - alpha_FVarsss alpha_bij_eq_invs mr_rel_flips mr_rel_mono_strong0s settsss - |> prove_no_prems lthy (ys @ ys') goal - |> split_conjs - |> map (fn thm => thm RS spec RS spec RS mp) - end; - - val alpha_transs = - let - val ss = mk_Frees "s" CAs frees_lthy |> fst; - fun mk_eq y y' s alpha_t = (HOLogic.mk_conj (alpha_t $ y $ s, alpha_t $ s $ y') - |> list_exists_free [s], alpha_t $ y $ y') |> HOLogic.mk_imp |> list_all_free [y, y']; - val eqs = @{map 4} mk_eq ys ys' ss alphasAs; - val goal = mk_conjs eqs |> HOLogic.mk_Trueprop; - - val supp_comp_bounds = map supp_comp_bound_of_mrbnf mrbnfs; - fun mk_b_setts rec_setts = (nth rec_setts |> map o map) binding_relation; - val settsss = map op~~ (transpose bound_settss ~~ (transpose rec_settss |> map mk_b_setts)); - - val supp_ids = replicate fbound @{thm supp_id_bound}; - fun mk_mr_rel_mono_alt mr_rel_mono mr_le_rel_OO = unfold_thms lthy @{thms id_o} - (Drule.rotate_prems ~1 (mr_rel_mono RS @{thm predicate2D}) OF [mr_le_rel_OO RS - @{thm predicate2D}] OF (supp_ids @ replicate (2*fbound) @{thm _} @ supp_ids)) - |> Drule.rotate_prems (4*fbound) OF @{thms relcomppI}; - val mr_rel_mono_alts = map2 mk_mr_rel_mono_alt - (map (id_prems o mr_rel_mono_of_mrbnf) mrbnfs) - (map (unfold_id lthy o id_prems2 o mr_le_rel_OO_of_mrbnf) mrbnfs); - - fun is_unique [] = [] - | is_unique (x::xs) = (exists (curry op = x) xs, x) :: is_unique xs; - fun is_unique_grouped [] xs = is_unique xs - | is_unique_grouped (k::ks) xs = chop k xs |>> is_unique ||> is_unique_grouped ks |> op @; - fun filter_unique xs = filter_like (is_unique_grouped ks (transpose binding_matrix) - |> map fst |> filter_like no_bindings not) not xs; - - fun mk_alpha_bij alpha_bij = Drule.rotate_prems ~1 alpha_bij; - fun mk_rename_comp (rename_comp, prems) = unfold_thms lthy @{thms id_o} (rename_comp RS sym - OF (replicate fbound prems |> flat)); - val (alpha_bijs, rename_comps) = mk_rec_lives alpha_bijs ~~ (mk_rec_lives rename_comps ~~ - (apply2 (replicate fbound o replicate rec_live) (@{thms bij_id supp_id_bound}, - @{thms _ _}) |-> map flat o transpose oo map_binding_matrix)) - |> filter_like no_bindings not |> split_list - ||> map mk_rename_comp o filter_unique |>> map mk_alpha_bij; - in - mk_alpha_trans_tac mutual fbound supp_comp_bounds alpha_coinduct alpha_elims raw_injects - rename_comps alpha_bijs mr_rel_mono_alts (flat FVars_renamess) alpha_FVarsss settsss - |> prove_no_prems lthy (ys @ ys') goal - |> split_conjs - |> map (fn thm => thm RS spec RS spec RS mp OF [exI] OF [conjI]) - end; - - val card_of_FVarsB_boundss = - let - fun mk_b_bounds set_bounds b_rels card_of_FVars_bounds = - (set_bounds ~~ mk_rec_lives card_of_FVars_bounds |> map o nth) b_rels |> split_list; - fun mk_UNION_bound UNION_bound set_bound card_of_FVars_bound = @{thm ordLeq_ordLess_trans} - OF [@{thm card_of_diff}, UNION_bound OF [set_bound, card_of_FVars_bound]]; - fun Un_bound_OF Un_bound = foldl1 (fn (thm1, thm2) => Un_bound OF [thm1, thm2]); - fun mk_card_of_FVarsB_bound Un_bound UNION_bound b_rel_bounds set_bounds = b_rel_bounds - |-> mk_b_bounds set_bounds |-> map2 (mk_UNION_bound UNION_bound) |> Un_bound_OF Un_bound; - fun mk_card_of_FVarsB_bounds Un_bound UNION_bound = map2 (mk_card_of_FVarsB_bound Un_bound - UNION_bound) (binding_relation ~~ transpose card_of_FVars_boundss); - val rec_set_boundsss = map (replicate fbound o take rec_live o drop (2*fbound+passive)) - set_boundss; - in - @{map 3} mk_card_of_FVarsB_bounds Un_bounds UNION_bounds rec_set_boundsss - end; - - fun refresh_set FVarsBs x mrbnf_map_AsAs bound_sets mrbnf_set_bounds mrbnf_var_infinite Un_bound - card_of_FVarsB_bounds set_map = - let - val recs_consts = renamesAs ~~ map HOLogic.id_const CAs |> mk_rec_lives; - val rename_args = apply2 (replicate rec_live |> map) (fids, ffs) - |-> transpose oo map_binding_matrix - |> map2 (fn b => if b then K NONE else SOME) no_bindings; - fun mk_rec_rel (_, id) NONE = id - | mk_rec_rel (rename_t, _) (SOME fs) = list_comb (rename_t, fs); - val map_t = list_comb (mrbnf_map_AsAs, map HOLogic.id_const As @ ffs @ - map2 mk_rec_rel recs_consts rename_args) $ x; - - fun mk_int_empty set_t fset = HOLogic.mk_eq (mk_inter (set_t $ map_t, fset), - Const (@{const_name bot}, fastype_of fset)); - - val concls1 = map2 mk_id_on FVarsBs ffs; - val concls2 = map2 mk_int_empty bound_sets fsets; - val goal = map HOLogic.dest_Trueprop prem_terms_ffs @ concls1 @ concls2 |> mk_conjs - |> list_exists_free ffs |> HOLogic.mk_Trueprop; - - fun mk_insert_thms terms = thm_instantiate_terms lthy (map SOME terms) - @{thm card_of_ordLeq[THEN iffD2, OF ordLess_imp_ordLeq, of "set \ fset" - "UNIV - (set \ FVarsB \ fset)" for set fset FVarsB]}; - val insert_thms = map mk_insert_thms - (transpose [map (fn thm => thm $ x) bound_sets, fsets, FVarsBs]); - fun mk_exI_thms terms = thm_instantiate_terms lthy (NONE :: map SOME terms) - @{thm exI[of _ "extU (set \ fset) (u ` (set \ fset)) u" for set fset u]}; - val exI_thms = map mk_exI_thms (transpose [map (fn thm => thm $ x) bound_sets, fsets]); - fun mk_extU_thms terms = thm_instantiate_terms lthy (NONE :: map SOME terms) - @{thm extU[of u "set \ fset" "u ` (set \ fset)" for set fset u]}; - val extU_thms = map mk_extU_thms (transpose [map (fn thm => thm $ x) bound_sets, fsets]); - in - mk_refresh_set_tac fbound mrbnf_var_infinite Un_bound insert_thms mrbnf_set_bounds - card_of_FVarsB_bounds exI_thms extU_thms set_map - |> prove lthy (fsets @ [x]) prem_terms_fsets goal - end; - val refresh_sets = - let - fun take_bounds xss = map (take fbound o drop (fbound+passive)) xss; - in - @{map 9} refresh_set FVarsBssAs xs mrbnf_maps_AsAs bound_setss_As (take_bounds set_boundss) - var_infinites Un_bounds card_of_FVarsB_boundss set_maps - end; - - fun mk_avoid_term x x' alpha_t ctor bound_sets = - let - fun mk_eq set_t fset = HOLogic.mk_eq (mk_inter (set_t $ x', fset), - Const (@{const_name bot}, fastype_of fset)); - in - map2 mk_eq bound_sets fsets @ [alpha_t $ (ctor $ x) $ (ctor $ x')] |> mk_conjs - end; - - fun mk_refresh bound_sets x x' alpha_t ctor refresh_set mrbnf_map_AsAs alpha_intro rel_map - rel_refl_id = - let - val goal = mk_avoid_term x x' alpha_t ctor bound_sets |> list_exists_free [x'] - |> HOLogic.mk_Trueprop; - - fun mk_exI cfs = - let - fun mk_rename_t b rename_t CA fs = if b then HOLogic.id_const CA else - list_comb (rename_t, fs); - val fs = map Thm.term_of cfs; - val ids = map (HOLogic.id_const o domain_type o fastype_of) fs; - val rename_args = apply2 (replicate rec_live |> map) (ids, fs) - |-> transpose oo map_binding_matrix - |> @{map 4} mk_rename_t no_bindings (mk_rec_lives renamesAs) (mk_rec_lives CAs); - val t = list_comb (mrbnf_map_AsAs, map HOLogic.id_const As @ fs @ rename_args) $ x; - in - thm_instantiate_terms lthy [NONE, SOME t] @{thm exI} - end; - fun mk_refresh_set assms = thm_instantiate_terms lthy [SOME x] (refresh_set OF assms); - in - mk_refresh_tac alpha_intro alpha_refls rel_map rel_refl_id mk_refresh_set mk_exI - |> prove lthy (x :: fsets) prem_terms_fsets goal - end; - val refreshs = @{map 10} mk_refresh bound_setss_As xs xs' alphasAs ctorsAs refresh_sets - mrbnf_maps_AsAs alpha_intros mr_rel_maps mr_rel_refl_ids; - - (* Define avoid *) - val ((avoid_terms, avoid_defs), lthy) = - let - fun mk_rhs x x' alpha_t ctor bound_sets = - let - val (x'T, x'Free) = dest_Free x' |> `snd; - in - mk_avoid_term x x' alpha_t ctor bound_sets |> absfree x'Free |> - (fn t => HOLogic.choice_const x'T $ t) |> fold_rev (absfree o dest_Free) (x :: fsets) - end; - in - @{fold_map 2} new_definition (map (Binding.name o mk_avoidN) names) - (@{map 5} mk_rhs xs xs' alphasAs ctorsAs bound_setss_As) lthy - |>> split_list o map (fn x => (#2 x, #3 x)) - end; - val avoidsAs = subst_terms As avoid_terms; - - fun mk_avoid bound_sets x alpha_t avoid_t ctor refresh = split_Nconjs (fbound+1) - let - val goal = mk_avoid_term x (list_comb (avoid_t $ x, fsets)) alpha_t ctor bound_sets - |> HOLogic.mk_Trueprop; - in - mk_avoid_tac avoid_defs refresh - |> prove lthy (x :: fsets) prem_terms_fsets goal - end; - val (avoid_freshss, alpha_avoids) = - @{map 6} mk_avoid bound_setss_As xs alphasAs avoidsAs ctorsAs refreshs - |> map_split (chop fbound ##> hd); - - (* Define quotient type *) - fun define_TT name CA alpha_t = - let - val rhs = HOLogic.mk_case_prod alpha_t - |> (fn t => HOLogic.Collect_const (fastype_of t |> domain_type) $ t) - |> BNF_GFP_Util.mk_quotient (HOLogic.mk_UNIV CA); - in - new_typedef (Binding.name name) rhs - (fn ctxt => EVERY1 [rtac ctxt exI, rtac ctxt @{thm proj_preserves}, rtac ctxt UNIV_I]) - end; - val ((TT_names, TT_infos), lthy) = @{fold_map 3} define_TT names CAs alphasAs lthy - |>> split_list; - - val TT_type_definitions = map (#type_definition o snd) TT_infos; - - val CBs = map (fn s => Type (s, As)) TT_names; - - val (TT_Abss, TT_Reps) = - let - fun mk_abs_and_rep CA CB info = - (Const (#Abs_name info, CA --> CB), Const (#Rep_name info, CB --> CA)); - in - @{map 3} (mk_abs_and_rep o HOLogic.mk_setT) CAs CBs (map fst TT_infos) |> split_list - end; - val TT_abss = - let - fun mk_TT_abs alpha_t Abs_t CA CB = Const (@{const_name quot_type.abs}, - fastype_of alpha_t --> fastype_of Abs_t --> CA --> CB) $ alpha_t $ Abs_t; - in - @{map 4} mk_TT_abs alphasAs TT_Abss CAs CBs - end; - val TT_reps = - let - fun mk_TT_rep Rep_t CA CB = Const (@{const_name quot_type.rep}, - fastype_of Rep_t --> CB --> CA) $ Rep_t; - in - @{map 3} mk_TT_rep TT_Reps CAs CBs - end; - - val mrbnf_maps_AsBs = mk_mrbnf_terms fst As As CAs CBs mk_map_of_mrbnf I op |> I As; - val mrbnf_maps_BsAs = mk_mrbnf_terms fst As As CBs CAs mk_map_of_mrbnf I op |> I As; - val mrbnf_maps_BsBs = mk_mrbnf_terms fst As As CBs CBs mk_map_of_mrbnf I op |> I As; - val mrbnf_rels_BsBs = mk_mrbnf_terms fst As As CBs CBs mk_mr_rel_of_mrbnf I op |> I As; - val mrbnf_setss_Bs = mk_mrbnf_terms fst As As CBs CBs mk_sets_of_mrbnf - (2*fbound + passive + rec_live |> replicate) snd map As; - val ((free_setss_Bst, bound_setss_Bst), _) = split_setss_transp mrbnf_setss_Bs; - val ((free_setss_Bs, bound_setss_Bs), rec_setss_Bs) = split_setss mrbnf_setss_Bs; - - val ((((ws, ws'), vs), vs'), frees_lthy) = - let - fun mrbnf_rep_T mrbnf_rep_map_As = strip_typeN (2*fbound + passive + rec_live) - (fastype_of mrbnf_rep_map_As) |> domain_type o snd; - val mrbnf_rep_Ts = map mrbnf_rep_T mrbnf_maps_BsAs - in - mk_Frees "w" CBs frees_lthy - ||>> mk_Frees "w'" CBs - ||>> mk_Frees "v" mrbnf_rep_Ts - ||>> mk_Frees "v'" mrbnf_rep_Ts - end; - - fun mk_equivp_alpha alpha_t alpha_refl alpha_sym alpha_trans = - let - val goal = mk_equivp alpha_t |> HOLogic.mk_Trueprop; - in - mk_alpha_equivp_tac alpha_refl alpha_sym alpha_trans - |> prove_no_prems lthy [] goal - end; - val equivp_alphas = @{map 4} mk_equivp_alpha alphasAs alpha_refls alpha_syms alpha_transs; - - fun mk_TT_Quotient TT_type_definition equivp_alpha = @{thm Quotient3_to_Quotient_equivp} OF - [@{thm quot_type.Quotient} OF [@{thm type_definition_quot_type} OF - [TT_type_definition, equivp_alpha]], @{thm reflexive}, equivp_alpha]; - val TT_Quotients = map2 mk_TT_Quotient TT_type_definitions equivp_alphas; - - val Quotient_abs_reps = map (fn thm => @{thm Quotient_abs_rep} OF [thm]) TT_Quotients; - val Quotient_rep_abss = map2 (fn thm1 => fn thm2 => @{thm Quotient_rep_abs} OF [thm1, thm2]) - TT_Quotients alpha_refls; - val alpha_quotient_syms = map2 (op OF o apsnd single |> curry) alpha_syms Quotient_rep_abss; - val Quotient_total_abs_eq_iffs = map2 (fn thm1 => fn thm2 => @{thm Quotient_total_abs_eq_iff} - OF [thm1, @{thm reflpI} OF [thm2]]) TT_Quotients alpha_refls; - - (* Define quotient ctor *) - val ((cctor_terms, cctor_defs), lthy) = - let - fun mk_rhs v TT_abs ctor mrbnf_rec_map_As = TT_abs $ (ctor $ (comb_mrbnf_term - (map HOLogic.id_const As) TT_reps mrbnf_rec_map_As $ v)) |> absfree (dest_Free v); - in - @{fold_map 2} new_definition (map (Binding.name o mk_cctorN) names) - (@{map 4} mk_rhs vs TT_abss ctorsAs mrbnf_maps_BsAs) lthy - |>> split_list o map (fn x => (#2 x, #3 x)) - end; - val cctorsAs = subst_terms As cctor_terms; - - fun mk_TT_abs_ctor x TT_abs ctor cctor mrbnf_abs_map_As cctor_def map_comp mr_rel_map - TT_Quotient alpha_intro rel_refl_id = - let - val goal = mk_Trueprop_eq (TT_abs $ (ctor $ x), cctor $ (comb_mrbnf_term - (map HOLogic.id_const As) TT_abss mrbnf_abs_map_As $ x)); - in - mk_TT_abs_ctor_tac cctor_def map_comp TT_Quotient rename_ids mr_rel_map alpha_quotient_syms - alpha_intro rel_refl_id - |> prove_no_prems lthy [x] goal - end; - val TT_abs_ctors = @{map 11} mk_TT_abs_ctor xs TT_abss ctorsAs cctorsAs mrbnf_maps_AsBs - cctor_defs map_comps mr_rel_maps TT_Quotients alpha_intros_id mr_rel_refl_ids; - - fun mk_TT_nchotomy v w cctor TT_rep mrbnf_abs_map_As raw_exhaust cctor_def map_comp mr_rel_map - TT_Quotient alpha_intro rel_refl_id = - let - val goal = HOLogic.mk_eq (w, cctor $ v) |> list_exists_free [v] |> HOLogic.mk_Trueprop; - - val rep_exhaust = thm_instantiate_terms lthy [SOME (TT_rep $ w)] raw_exhaust; - fun mk_exI ct = thm_instantiate_terms lthy [NONE, SOME (comb_mrbnf_term - (map HOLogic.id_const As) TT_abss mrbnf_abs_map_As $ (Thm.term_of ct))] exI; - in - mk_TT_nchotomy_tac rep_exhaust cctor_def map_comp TT_Quotient rename_ids mr_rel_map - alpha_quotient_syms alpha_intro rel_refl_id mk_exI - |> prove_no_prems lthy [w] goal - end; - val TT_nchotomys = @{map 12} mk_TT_nchotomy vs ws cctorsAs TT_reps mrbnf_maps_AsBs - raw_exhausts cctor_defs map_comps mr_rel_maps TT_Quotients alpha_intros_id mr_rel_refl_ids; - - (* Define quotient rename *) - val ((rrename_terms, rrename_defs), lthy) = - let - fun mk_rhs w TT_abs TT_rep rename_t = TT_abs $ (list_comb(rename_t, ffs) $ (TT_rep $ w)) - |> fold_rev absfree (map dest_Free (ffs @ [w])); - in - @{fold_map 2} new_definition (map (Binding.name o mk_rrenameN) names) - (@{map 4} mk_rhs ws TT_abss TT_reps renamesAs) lthy - |>> split_list o map (fn x => (#2 x, #3 x)) - end; - val rrenamesAs = subst_terms As rrename_terms; - - fun mk_rrename_cctor rrename_t mrbnf_map_BsBs v cctor map_comp cctor_def mr_rel_map TT_Quotient - rel_refl_id alpha_intro alpha_trans alpha_bij_eq Quotient_rep_abs = - let - val recs = map (list_comb o rpair ffs) rrenamesAs; - val goal = (list_comb (rrename_t, ffs) $ (cctor $ v), cctor $ - (comb_mrbnf_term ffs_ids recs mrbnf_map_BsBs $ v)) |> mk_Trueprop_eq; - val alpha_trans = alpha_trans OF [alpha_bij_eq RS (iffD2 OF [@{thm _}, Quotient_rep_abs])]; - in - mk_rrename_cctor_tac rrename_defs cctor_def map_comp mr_rel_map rename_simps rename_ids - TT_Quotient rel_refl_id alpha_intro alpha_trans alpha_quotient_syms - |> prove lthy (ffs @ [v]) prem_terms_ffs goal - end; - val rrename_cctors = @{map 13} mk_rrename_cctor rrenamesAs mrbnf_maps_BsBs vs cctorsAs - map_comps cctor_defs mr_rel_maps TT_Quotients mr_rel_refl_ids alpha_intros_id alpha_transs - alpha_bij_eqs Quotient_rep_abss; - - (* Define quotient FVars *) - fun define_FFVars i FVars_ts lthy = - let - val i = if fbound > 1 then i else 0; - fun mk_rhs w TT_rep FVars_t = FVars_t $ (TT_rep $ w) |> absfree (dest_Free w); - in - @{fold_map 2} new_definition (map (Binding.name o mk_FFVarsN i) names) - (@{map 3} mk_rhs ws TT_reps FVars_ts) lthy - end; - val ((FFVars_termss, FFVars_defss), lthy) = @{fold_map 2} define_FFVars (1 upto fbound) FVarsssAs - lthy |>> split_list o map (split_list o map (fn x => (#2 x, #3 x))); - val FFVarsssAs = map (subst_terms As) FFVars_termss; + val (lthy, old_lthy) = `Local_Theory.end_nested lthy; + val phi = Proof_Context.export_morphism old_lthy lthy; - fun mk_card_of_FFVars_bound w FFVars_t FFVars_def card_of_FVars_bound = - let - (* TODO: fix for mutual recursion *) - fun mk_bound t = mk_ordLess (mk_card_of t) ( - (if co then mk_card_suc else I) (bd_of_mrbnf (hd mrbnfs)) - ); - val goal = FFVars_t $ w |> mk_bound |> HOLogic.mk_Trueprop; - in - (fn ctxt => unfold_tac ctxt [FFVars_def] THEN HEADGOAL (rtac ctxt card_of_FVars_bound)) - |> prove_no_prems lthy [w] goal + val tyenv = Sign.typ_match (Proof_Context.theory_of lthy) + (fastype_of (Morphism.term phi (hd (#preds (hd is_freess)))), fastype_of (hd (#preds (hd is_freess)))) + Vartab.empty; + + fun morph (t, thm) = (Envir.subst_term (tyenv, Vartab.empty) (Morphism.term phi t), Morphism.thm phi thm); + fun morph_result phi tyenv (res: Inductive.result) = { + elims = Morphism.fact phi (#elims res), + induct = Morphism.thm phi (#induct res), + intrs = Morphism.fact phi (#intrs res), + preds = map (Envir.subst_term (tyenv, Vartab.empty) o Morphism.term phi) (#preds res) + }; + + val permute_raws = map morph permute_raws; + val is_freess = map (morph_result phi tyenv) is_freess; + val FVars_rawss = map (map morph) FVars_rawss; + val alphas = morph_result phi tyenv alphas; + + val (quots, lthy) = @{fold_map 3} (fn name => fn alpha => fn raw => + let val rel = HOLogic.mk_case_prod alpha + in apfst snd o new_typedef (Binding.name name) (BNF_GFP_Util.mk_quotient (HOLogic.mk_UNIV (#T raw)) ( + HOLogic.Collect_const (domain_type (fastype_of rel)) $ rel + )) (fn ctxt => EVERY1 (map (rtac ctxt) @{thms exI quotientI UNIV_I})) end + ) T_names (#preds alphas) raw_Ts lthy; + val Ts = map (#abs_type o fst) quots; + + val TT_abss = @{map 3} (fn (quot, _) => fn alpha => fn raw => Const (@{const_name quot_type.abs}, + fastype_of alpha --> (#rep_type quot --> #abs_type quot) --> #T raw --> #abs_type quot + ) $ alpha $ Const (#Abs_name quot, #rep_type quot --> #abs_type quot)) quots (#preds alphas) raw_Ts; + + val TT_reps = map (fn (quot, _) => Const (@{const_name quot_type.rep}, + (#abs_type quot --> #rep_type quot) --> #abs_type quot --> HOLogic.dest_setT (#rep_type quot) + ) $ Const (#Rep_name quot, #abs_type quot --> #rep_type quot)) quots; + + val pre_Ts = map2 (fn deads => + MRBNF_Def.mk_T_of_mrbnf deads (plives @ replicate_rec Ts) (pbounds @ bounds) (frees @ pfrees @ bfrees) + ) deadss mrbnfs; + + val (vars' as ((xs, ts), zs), _) = lthy + |> mk_Frees "x" pre_Ts + ||>> mk_Frees "t" Ts + ||>> mk_Frees "z" Ts; + + val lthy = snd (Local_Theory.begin_nested lthy); + + val rep_maps = map2 (fn deads => + MRBNF_Def.mk_map_comb_of_mrbnf deads (plive_ids @ replicate_rec TT_reps) bound_ids free_ids + ) deadss mrbnfs; + + val (ctors, lthy) = @{fold_map 5} (fn name => fn TT_abs => fn raw => fn rep_map => fn x => + mk_def_public (name ^ "_ctor") 1 (Term.absfree (dest_Free x) (TT_abs $ (#ctor raw $ (rep_map $ x)))) + ) T_names TT_abss raw_Ts rep_maps xs lthy; + + val (permutes, lthy) = @{fold_map 5} (fn name => fn TT_abs => fn TT_rep => fn permute_raw => fn t => + mk_def_public ("permute_" ^ name) (nvars + 1) (fold_rev Term.absfree (map dest_Free fs) (Term.absfree (dest_Free t) ( + TT_abs $ (Term.list_comb (fst permute_raw, fs) $ (TT_rep $ t)) + ))) + ) T_names TT_abss TT_reps permute_raws ts lthy; + + val (FVarsss, lthy) = @{fold_map 4} (fn name => fn TT_rep => fn t => mk_defs_public ("FVars_" ^ name) 1 o + map (fn FVars => Term.absfree (dest_Free t) (fst FVars $ (TT_rep $ t))) + ) T_names TT_reps ts FVars_rawss lthy; + + val rec_setsss = map (fst o fold_map chop rec_vars) rec_setss; + + val (subshapes_opt, lthy) = if nrecs = 0 then (NONE, lthy) else + let + val subshapess = map2 (fn T => fn name => map2 (fn inner_T => fn inner_name => Free ( + "subshape_" ^ inner_name ^ "_" ^ name, + #T inner_T --> #T T --> @{typ bool} + )) raw_Ts T_names) raw_Ts T_names; + + val flags = { quiet_mode = true, verbose = false, alt_name = Binding.empty, coind = false, no_elim = false, no_ind = false, skip_mono = false }; + val intros = @{map 4} (fn raw => fn x => @{map 6} (fn permute => fn alpha => fn z => fn z' => fn rec_sets => fn subshape => + fold_rev (curry Logic.mk_implies) (f_prems @ map HOLogic.mk_Trueprop [ + alpha $ (Term.list_comb (fst permute, fs) $ z) $ z', + HOLogic.mk_mem (z', foldl1 mk_Un (map (fn s => s $ x) rec_sets)) + ]) (HOLogic.mk_Trueprop (subshape $ z $ (#ctor raw $ x))) + ) permute_raws (#preds alphas) raw_zs raw_zs') raw_Ts raw_xs rec_setsss subshapess; + in apfst SOME (Inductive.add_inductive flags + (map (fn T => (apfst Binding.name (dest_Free T), NoSyn)) (flat subshapess)) [] + (map (pair Binding.empty_atts) (flat intros)) [] lthy) end; - val card_of_FFVars_boundss' = transpose (@{map 3} (@{map 4} mk_card_of_FFVars_bound ws) FFVarsssAs - FFVars_defss (transpose card_of_FVars_boundss')); - val card_of_FFVars_boundss = map2 (fn mrbnf => - let - val card_order = bd_card_order_of_mrbnf mrbnf; - val ordIso = @{thm cardSuc_ordIso_card_suc} OF [card_order] RS @{thm ordIso_symmetric} - val covar_large = @{thm ordIso_ordLeq_trans} OF [ordIso, #covar_large (class_thms_of_mrbnf mrbnf)] - in map (fn thm => - @{thm ordLess_ordLeq_trans} OF [thm, if co then covar_large else var_large_of_mrbnf mrbnf] - ) end - ) mrbnfs card_of_FFVars_boundss'; - - fun mk_FFVars_cctor FFVars_ts b_vec v cctor FFVars_t Quotient_rep_abs rec_sets free_set - bound_set alpha_FVars = - let - fun add_Diff t = mk_minus t (bound_set $ v); - fun mk_UN set (w, t) = t $ w |> (absfree o dest_Free) w |> mk_UNION (set $ v); - val UNs = ws ~~ FFVars_ts |> mk_rec_lives |> map2 mk_UN rec_sets - |> swap o `(map add_Diff) |-> map_binding_vector b_vec; - val goal = (FFVars_t $ (cctor $ v), foldl1 mk_union (free_set $ v :: UNs)) |> mk_Trueprop_eq; - in - mk_FFVars_cctor_tac alpha_FVars Quotient_rep_abs (flat FFVars_defss) cctor_defs - (flat FVars_ctorss) set_map - |> prove_no_prems lthy [v] goal - end; - val FFVars_cctorss = @{map 5} (fn FFVars_ts => fn b_rels => @{map 8} - (mk_FFVars_cctor FFVars_ts b_rels) vs cctorsAs FFVars_ts Quotient_rep_abss rec_setss_Bs) - FFVarsssAs binding_matrix free_setss_Bst bound_setss_Bst alpha_FVarsss; + fun mk_noclashs FVarsss = @{fold_map 5} (fn name => fn x => fn fsets => fn bsetss => fn rec_sets => + mk_def_public ("noclash_" ^ name) 1 (Term.absfree (dest_Free x) (foldr1 HOLogic.mk_conj ( + @{map 4} (fn fset => fn bsets => fn rels => fn FVarss => + mk_int_empty (foldl1 mk_Un (map (fn s => s $ x) bsets), foldl1 mk_Un ( + fset $ x :: @{map_filter 3} (fn i => fn set => fn FVars => + if member (op=) (flat rels) i then NONE else SOME (mk_UNION (set $ x) (fst FVars)) + ) (0 upto nrecs - 1) rec_sets (replicate_rec FVarss) + )) + ) fsets bsetss binding_relation (transpose FVarsss) + ))) + ); - fun mk_FFVars_intros_elims_induct A z b_vec free_sets bound_sets FFVars_ts FVars_intros - alpha_FVarss FFVars_defs FVars_induct = + val (raw_noclashs, lthy) = mk_noclashs FVars_rawss (map (fn s => "raw_" ^ s) T_names) raw_xs free_setss bound_setsss rec_setss lthy; + val (noclashs, lthy) = let - val PTs = map (fn CB => A --> CB --> HOLogic.boolT) CBs; - val ((Ps, zs'), elim_P) = `(fst o mk_Frees "P" PTs) frees_lthy - ||>> mk_Frees "z'" (replicate n A) - ||> fst o yield_singleton (mk_Frees "P") HOLogic.boolT; - val FVars_abs_reps = map2 (fn thm1 => fn thm2 => thm1 OF [thm2]) alpha_FVarss - Quotient_rep_abss; - - fun mk_intros_elim ws v cctor FFVars_t free_set bound_set rec_sets w' P FVars_intros - FVars_abs_rep cctor_def TT_nchotomy = - let - val intro_concl = HOLogic.mk_mem (z, FFVars_t $ (cctor $ v)); - val elim_prem = HOLogic.mk_mem (z, FFVars_t $ w') |> HOLogic.mk_Trueprop; - val elim_concl = HOLogic.mk_eq (w', cctor $ v); - val elim_varss = [v] :: map (fn w => [w, v]) ws; - val induct_concls = [] :: (mk_rec_lives Ps |> map2 (fn w => fn P => [P $ z $ w]) ws); - val induct_concl = P $ z $ (cctor $ v); - val induct_varss = map (fn varss => varss @ [z]) elim_varss; - - val add_non_mem = HOLogic.mk_mem (z, bound_set $ v) |> HOLogic.mk_not |> curry op ::; - val concls = mk_rec_lives FFVars_ts - |> map2 (fn w => fn t => [HOLogic.mk_mem (z, t $ w)]) ws - |> swap o `(map add_non_mem) |-> map_binding_vector b_vec; - val rec_ts = [HOLogic.mk_mem (z, free_set $ v)] :: @{map 3} - (fn t => t $ v |> rpair #> HOLogic.mk_mem #> curry op ::) rec_sets ws concls; - - val intro_goals = map (fn ts => ts @ [intro_concl]) rec_ts - |> map (foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop); - val intro_tacs = map (mk_FFVars_intro_tac FFVars_defs cctor_def FVars_abs_rep set_map) - FVars_intros; - val intros = @{map 3} (prove_no_prems lthy) induct_varss intro_goals intro_tacs; - - val elim_goal = elim_prem :: (map (foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop o - (fn ts => ts @ [elim_P]) o curry op :: elim_concl) rec_ts - |> map2 (fold_rev Logic.all) elim_varss) @ [HOLogic.mk_Trueprop elim_P] - |> foldr1 Logic.mk_implies; - val TT_nchotomy_inst = thm_instantiate_terms lthy [SOME w'] TT_nchotomy; - val elim = mk_FFVars_elim_tac TT_nchotomy_inst (flat FFVars_cctorss) - |> prove_no_prems lthy [w', z, elim_P] elim_goal; - - val induct_prems = rec_ts - |> map2 (fn ts2 => fn ts1 => ts1 @ ts2 @ [induct_concl]) induct_concls - |> map (foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop) - |> map2 (fold_rev Logic.all) induct_varss; - in - ((intros, elim), induct_prems) - end; - val (intro_elims, induct_prems) = @{map 12} (mk_rec_lives ws |> mk_intros_elim) vs cctorsAs - FFVars_ts free_sets bound_sets rec_setss_Bs ws' Ps (chop_groups (rec_live+1) FVars_intros) - FVars_abs_reps cctor_defs TT_nchotomys |> split_list ||> flat |>> apfst flat o split_list; - - fun mk_imp FFVars_t z' w P = HOLogic.mk_imp (HOLogic.mk_mem (z', FFVars_t $ w), P $ z' $ w); - val imps = @{map 4} mk_imp FFVars_ts zs' ws Ps; - val induct_goal = mk_conjs imps |> HOLogic.mk_Trueprop; - - val conj_imps = let val dummies = Term.dummy_pattern HOLogic.boolT |> replicate n; - in map2 (fn i => fn t => nth_map i (K t) dummies |> mk_conjs) (0 upto n-1) imps end; - fun mk_induct_inst TT_Quotient alpha_refl conj_imp w = (@{thm Quotient_total_abs_induct} OF - [TT_Quotient, @{thm reflpI} OF [alpha_refl]]) - |> thm_instantiate_dummy_terms lthy [SOME (absfree (dest_Free w) conj_imp), SOME w]; - val induct_insts = @{map 4} mk_induct_inst TT_Quotients alpha_refls conj_imps ws; - in - (intro_elims, - mk_FFVars_induct_tac mutual induct_insts FFVars_defs cctor_defs FVars_abs_reps - FVars_induct TT_abs_ctors set_map - |> prove lthy (zs' @ ws @ Ps) induct_prems induct_goal - |> (if mutual then I else (fn thm => Drule.rotate_prems ~1 (thm RS mp)))) - end; - val ((FFVars_intross, FFVars_elimss), FFVars_inducts) = @{map 10} mk_FFVars_intros_elims_induct - (take fbound As) zs binding_matrix free_setss_Bst bound_setss_Bst FFVarsssAs FVars_intross - alpha_FVarsss FFVars_defss FVars_inducts |> split_list |>> split_list; + fun subst' inst (T as Type (n, Ts)) = + (case AList.lookup (op=) inst T of + SOME T' => T' + | NONE => Type (n, map (subst' inst) Ts)) + | subst' inst T = the_default T (AList.lookup (op=) inst T) - fun mk_TT_inject0 v v' cctor mrbnf_map_BsBs bound_sets rec_sets mr_rel_eq mr_rel_map cctor_def - abs_eq_iff alpha_elim set_map mr_rel_mono_strong0 alpha_intro = - let - val FFVarsBs = - let - fun mk_zips FFVars_ts = map (op $ o rpair v) rec_sets ~~ mk_rec_lives FFVars_ts; - fun mk_bound_minus bound_set t = mk_minus t (bound_set $ v); - fun mk_UNION_term bound_set FFVars_ts b_rels = map (nth (mk_zips FFVars_ts) - #-> mk_UNION) b_rels |> map (mk_bound_minus bound_set) - |> foldl1 mk_union; - in - @{map 3} mk_UNION_term bound_sets FFVarsssAs binding_relation - end; - val prems1 = map2 mk_id_on FFVarsBs ffs; - - val rrename_consts = rrenamesAs ~~ map HOLogic.id_const CBs |> mk_rec_lives; - val rrename_args = apply2 (replicate rec_live |> map) (fids, ffs) - |-> transpose oo map_binding_matrix - |> map2 (fn b => if b then K NONE else SOME) no_bindings; - fun mk_rec_rel (_, id) NONE = id - | mk_rec_rel (rrename_t, _) (SOME fs) = list_comb (rrename_t, fs); - val prem0 = HOLogic.mk_eq (list_comb (mrbnf_map_BsBs, map HOLogic.id_const As @ ffs @ - map2 mk_rec_rel rrename_consts rrename_args) $ v, v'); - - val goal = mk_Trueprop_eq (HOLogic.mk_eq (cctor $ v, cctor $ v'), - map HOLogic.dest_Trueprop prem_terms_ffs @ prems1 @ [prem0] |> mk_conjs - |> list_exists_free ffs); - val rotated_mr_rel_mono_strong0 = Drule.rotate_prems (6*fbound) mr_rel_mono_strong0; - val Quotient_rel_reps = map (fn thm => @{thm Quotient_rel_rep} OF [thm] RS iffD1) - TT_Quotients; - val alpha_sym_transs = map2 (fn thm1 => fn thm2 => thm1 OF [Drule.rotate_prems 1 thm2]) - alpha_syms alpha_transs; - in - mk_TT_inject0_tac fbound alpha_intro mr_rel_eq cctor_def abs_eq_iff mr_rel_map alpha_elim - (flat FFVars_defss |> map (fn thm => thm RS @{thm symmetric})) set_map rrename_defs - Quotient_rep_abss Quotient_rel_reps rotated_mr_rel_mono_strong0 alpha_syms - alpha_sym_transs alpha_quotient_syms alpha_refls - |> prove_no_prems lthy [v, v'] goal - end; - val TT_injects0 = @{map 14} mk_TT_inject0 vs vs' cctorsAs mrbnf_maps_BsBs bound_setss_Bs - rec_setss_Bs mr_rel_eqs mr_rel_maps cctor_defs Quotient_total_abs_eq_iffs alpha_elims set_maps - mr_rel_mono_strong0s alpha_intros; + val subst = Term.map_types (subst' (map #T raw_Ts ~~ Ts)) + in mk_noclashs FVarsss T_names xs (map (map subst) free_setss) (map (map (map subst)) bound_setsss) (map (map subst) rec_setss) lthy end - (* Define quotient avoid *) - val ((aavoid_terms, aavoid_defs), lthy) = - let - fun mk_rhs v avoid_t mrbnf_map_AsBs mrbnf_map_BsAs = - let - val ids = map HOLogic.id_const As; - val abs_map = comb_mrbnf_term ids TT_abss mrbnf_map_AsBs; - val rep_map = comb_mrbnf_term ids TT_reps mrbnf_map_BsAs; - in - abs_map $ (list_comb (avoid_t $ (rep_map $ v), fsets)) - |> fold_rev (absfree o dest_Free) (v :: fsets) - end; - in - @{fold_map 2} new_definition (map (Binding.name o mk_aavoidN) names) - (@{map 4} mk_rhs vs avoidsAs mrbnf_maps_AsBs mrbnf_maps_BsAs) lthy - |>> split_list o map (fn x => (#2 x, #3 x)) - end; - val aavoidsAs = subst_terms As aavoid_terms; + val (lthy, old_lthy) = `Local_Theory.end_nested lthy; + val phi = Proof_Context.export_morphism old_lthy lthy; - fun mk_aavoid_term f v v' cctor bound_sets = - let - fun mk_eq set_t fset = HOLogic.mk_eq (mk_inter (set_t $ v, fset), - Const (@{const_name bot}, fastype_of fset)); - in - map2 mk_eq bound_sets fsets @ [HOLogic.mk_eq (cctor $ v, v')] |> mk_conjs o f - end; + val tyenv = Sign.typ_match (Proof_Context.theory_of lthy) + (fastype_of (Morphism.term phi (fst (hd noclashs))), fastype_of (fst (hd noclashs))) + Vartab.empty; - fun mk_aavoid v aavoid_t cctor bound_sets aavoid_def cctor_def avoid_freshs map_comp set_map - mr_rel_map rel_refl_id TT_Quotient alpha_trans alpha_intro_id alpha_sym alpha_avoid = - let - val goal = mk_aavoid_term I (list_comb (aavoid_t $ v, fsets)) (cctor $ v) cctor bound_sets - |> HOLogic.mk_Trueprop; - in - mk_aavoid_tac aavoid_def cctor_def map_comp TT_Quotient set_map mr_rel_map rename_ids - alpha_sym rel_refl_id avoid_freshs Quotient_rep_abss alpha_trans alpha_intro_id - alpha_avoid - |> prove lthy (v :: fsets) prem_terms_fsets goal - |> split_Nconjs (fbound+1) - end; - val (aavoid_freshss, alpha_aavoids) = - @{map 16} mk_aavoid vs aavoidsAs cctorsAs bound_setss_Bs aavoid_defs cctor_defs - avoid_freshss map_comps set_maps mr_rel_maps mr_rel_refl_ids TT_Quotients alpha_transs - alpha_intros_id alpha_syms alpha_avoids - |> map_split (chop fbound ##> hd); + fun morph (t, thm) = (Envir.subst_term (tyenv, Vartab.empty) (Morphism.term phi t), Morphism.thm phi thm); - fun mk_TT_fresh_cases v w cctor bound_sets TT_nchotomy alpha_aavoid aavoid_freshs = - let - val mk_sym_term = swap o chop fbound #>> HOLogic.mk_eq o swap o HOLogic.dest_eq o the_single - #> op ::; - val goal = mk_aavoid_term mk_sym_term v w cctor bound_sets |> list_exists_free [v] - |> HOLogic.mk_Trueprop; - val insert_nchotomy = thm_instantiate_terms lthy [SOME w] TT_nchotomy; - in - mk_TT_fresh_cases_tac insert_nchotomy alpha_aavoid aavoid_freshs - |> prove lthy (w :: fsets) prem_terms_fsets goal - |> `(fn thm => unfold_thms lthy @{thms conj_imp_eq_imp_imp} (thm RS exE)) - end; - val (TT_fresh_cases, TT_fresh_nchotomys) = @{map 7} mk_TT_fresh_cases vs ws cctorsAs - bound_setss_Bs TT_nchotomys alpha_aavoids aavoid_freshss |> split_list; + in ((tvars, vars, vars'), (bounds, bfrees, bound_fs, bfree_fs), bfree_boundsss, + permute_raws, is_freess, FVars_rawss, alphas, quots, raw_Ts, + TT_abss, TT_reps, map morph ctors, map morph permutes, map (map morph) FVarsss, + Option.map (morph_result phi tyenv) subshapes_opt, map morph raw_noclashs, map morph noclashs, lthy) end - val (_, lthy) = Local_Theory.begin_nested lthy; - fun mk_noclashs FVarsss = @{fold_map 5} (fn x => fn T => fn fsets => fn bsets => fn rec_sets => fn lthy => - let - val name = "noclash_" ^ short_type_name (fst (dest_Type T)); - val UNss = map (fn FVars => map2 (fn A => mk_UNION (A $ x)) rec_sets (flat (map2 replicate ks FVars))) FVarsss; - val mk_free_UNss = map (fn UNs => fn rel => map_filter (fn (i, t) => if member (op=) rel i then NONE else SOME t) ((0 upto length rec_sets - 1) ~~ UNs)) UNss; - val rhss = @{map 4} (fn fset => fn bset => fn rel => fn mk_free_UNs => - mk_int_empty (bset $ x, foldl1 mk_Un (fset $ x :: mk_free_UNs rel)) - ) fsets bsets binding_relation mk_free_UNss; - val rhs = Term.absfree (dest_Free x) (foldr1 HOLogic.mk_conj rhss); - in mk_def_t true Binding.empty I name 1 rhs lthy end +fun construct_binder_fp fp_kind mrbnf_ks binding_relation lthy = + let + val ((((((frees, pfrees), plives), pbounds), deadss), (((((((fs, hss), raw_xs), raw_ys), aa), As), raw_zs), raw_zs'), ((xs, ts), zs)), + (bounds, bfrees, bound_fs, bfree_fs), bfree_boundsss, + permute_raws, is_freess, FVars_rawss, alphas, quots, raw_Ts, + TT_abss, TT_reps, ctors, permutes, FVarsss, subshapes_opt, raw_noclashs, noclashs, + lthy) = define_fp_consts fp_kind mrbnf_ks binding_relation lthy; + + val n = length mrbnf_ks; + val nvars = length frees; + val rec_vars = map snd mrbnf_ks; + val nrecs = foldr1 (op+) rec_vars; + val names = map (fst o dest_Free); + val mrbnfs = map (snd o fst) mrbnf_ks; + val passives = pfrees @ plives @ pbounds; + val npassive = length passives; + + val (bound_freesss, binding_relation) = split_list (map split_list binding_relation); + + val split_conj = split_conj n; + val raw_induct = infer_instantiate' lthy (replicate n NONE @ map (SOME o Thm.cterm_of lthy) raw_zs) (#induct (hd raw_Ts)); + + val permute_raw_ids = + let + val goal = foldr1 HOLogic.mk_conj (map2 (fn z => fn permute => HOLogic.mk_eq ( + Term.list_comb (fst permute, map HOLogic.id_const frees) $ z, z + )) raw_zs permute_raws); + in split_conj (Goal.prove_sorry lthy (names raw_zs) [] (HOLogic.mk_Trueprop goal) (fn {context=ctxt, ...} => EVERY1 [ + rtac ctxt raw_induct, + EVERY' (@{map 3} (fn permute => fn mrbnf => fn raw => EVERY' [ + rtac ctxt trans, + rtac ctxt (snd permute), + REPEAT_DETERM o resolve_tac ctxt @{thms bij_id supp_id_bound}, + rtac ctxt trans, + rtac ctxt (mk_arg_cong lthy 1 (#ctor raw)), + rtac ctxt @{thm trans[rotated]}, + rtac ctxt (MRBNF_Def.map_id_of_mrbnf mrbnf), + rtac ctxt (MRBNF_Def.map_cong0_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt @{thms bij_id supp_id_bound}, + REPEAT_DETERM o (resolve_tac ctxt @{thms refl trans[OF _ id_apply[symmetric]]} ORELSE' Goal.assume_rule_tac ctxt) + ]) permute_raws mrbnfs raw_Ts) + ])) end; + + val permute_raw_id0s = map (fn thm => + Local_Defs.unfold0 lthy @{thms id_def[symmetric]} (Local_Defs.abs_def_rule lthy thm) RS @{thm meta_eq_to_obj_eq} + ) permute_raw_ids; + + val (gs, _) = lthy + |> mk_Frees "g" (map fastype_of fs); + + val mk_f_prems = maps (fn f => map HOLogic.mk_Trueprop [mk_bij f, mk_supp_bound f]); + val f_prems = mk_f_prems fs; + val g_prems = mk_f_prems gs; + + val infinite_UNIV = @{thm cinfinite_imp_infinite} OF [MRBNF_Def.UNIV_cinfinite_of_mrbnf (hd mrbnfs)]; + + val permute_raw_comps = + let + val goal = foldr1 HOLogic.mk_conj (map2 (fn permute => fn z => HOLogic.mk_eq ( + Term.list_comb (fst permute, gs) $ (Term.list_comb (fst permute, fs) $ z), + Term.list_comb (fst permute, map2 (curry HOLogic.mk_comp) gs fs) $ z + )) permute_raws raw_zs); + in split_conj (Goal.prove_sorry lthy (names (fs @ gs @ raw_zs)) (f_prems @ g_prems) (HOLogic.mk_Trueprop goal) (fn {context=ctxt, prems} => EVERY1 [ + rtac ctxt raw_induct, + EVERY' (map2 (fn permute => fn mrbnf => EVERY' [ + EqSubst.eqsubst_tac ctxt [0] [snd permute], + REPEAT_DETERM o resolve_tac ctxt prems, + EqSubst.eqsubst_tac ctxt [0] [snd permute], + REPEAT_DETERM o resolve_tac ctxt prems, + EqSubst.eqsubst_tac ctxt [0] [MRBNF_Def.map_comp_of_mrbnf mrbnf], + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id}), + REPEAT_DETERM o resolve_tac ctxt (@{thms bij_id supp_id_bound} @ prems), + EqSubst.eqsubst_tac ctxt [0] [snd permute], + REPEAT_DETERM o resolve_tac ctxt (@{thms bij_comp supp_comp_bound} @ [infinite_UNIV] @ prems), + rtac ctxt (arg_cong OF [MRBNF_Def.map_cong0_of_mrbnf mrbnf]), + REPEAT_DETERM o resolve_tac ctxt (@{thms bij_comp supp_comp_bound supp_id_bound bij_id} @ [infinite_UNIV] @ prems), + REPEAT_DETERM o (resolve_tac ctxt @{thms refl trans[OF comp_apply]} ORELSE' Goal.assume_rule_tac ctxt) + ]) permute_raws mrbnfs) + ])) end; + + val permute_raw_comp0s = map2 (fn thm => fn permute => + let val goal = mk_Trueprop_eq ( + HOLogic.mk_comp (Term.list_comb (fst permute, gs), Term.list_comb (fst permute, fs)), + Term.list_comb (fst permute, map2 (curry HOLogic.mk_comp) gs fs) + ) in Goal.prove_sorry lthy (names (fs @ gs)) (f_prems @ g_prems) goal (fn {context=ctxt, prems} => EVERY1 [ + rtac ctxt ext, + rtac ctxt @{thm trans[OF comp_apply]}, + rtac ctxt (thm OF prems) + ]) end + ) permute_raw_comps permute_raws; + + fun replicate_rec xs = flat (map2 replicate rec_vars xs); + + val nargs = MRBNF_Def.free_of_mrbnf (hd mrbnfs) + MRBNF_Def.bound_of_mrbnf (hd mrbnfs) + MRBNF_Def.live_of_mrbnf (hd mrbnfs); + fun mk_setss rec_Ts = map2 (fn deads => MRBNF_Def.mk_sets_of_mrbnf (replicate nargs deads) + (replicate nargs (plives @ replicate_rec rec_Ts)) (replicate nargs (pbounds @ bounds)) + (replicate nargs (frees @ pfrees @ bfrees)) + ) deadss mrbnfs; + val split_setss = @{split_list 4} o map (fn sets => + let + val (fsets, rest) = chop nvars sets; + val (bound_sets, rest) = chop (length bounds) (drop npassive rest); + val bound_setss = fst (fold_map (chop o length) binding_relation bound_sets); + val (bfree_sets, rec_sets) = chop (length bfrees) rest; + val bfree_setss = fst (fold_map (chop o length) bfree_boundsss bfree_sets); + in (fsets, bound_setss, bfree_setss, rec_sets) end ); - val (noclashs, lthy) = mk_noclashs FVarsssAs xs CAs (transpose free_setss_Ast) (transpose bound_setss_Ast) rec_setss_As lthy; - val (nnoclashs, lthy) = mk_noclashs FFVarsssAs vs CBs (transpose free_setss_Bst) (transpose bound_setss_Bst) rec_setss_Bs lthy; - val (lthy, old_lthy) = `Local_Theory.end_nested lthy; - val phi = Proof_Context.export_morphism old_lthy lthy; - val (noclashs, nnoclashs) = - let - val tyenv = Sign.typ_match (Proof_Context.theory_of lthy) ( - fastype_of (Morphism.term phi (fst (hd noclashs))), fastype_of (fst (hd noclashs)) - ) Vartab.empty; - val morph = map (map_prod - (Envir.subst_term (tyenv, Vartab.empty) o Morphism.term phi) - (Morphism.thm phi) - ); - in (morph noclashs, morph nnoclashs) end; + val raw_setss = mk_setss (map #T raw_Ts); + val (raw_fsetss, raw_bound_setsss, raw_bfree_setsss, raw_rec_setss) = split_setss raw_setss; + val num_bfreess = map (map length) raw_bfree_setsss; + + val rec_boundsss = map (fn rels => map (fn i => + @{map_filter 2} (fn j => fn rel => + if member (op=) rel i then SOME j else NONE + ) (0 upto length rels - 1) rels + ) (0 upto nrecs - 1)) binding_relation; + + fun nonempty f xs = case xs of [] => I | _ => f xs + + fun mk_FVars_intro_goalsss rec_setss ctors xs zs fsetss bound_setsss bfree_setsss FVarsss = @{map 7} (fn rec_sets => fn ctor => fn x => + @{map 8} (fn a => fn bfree_boundss => fn rec_boundss => fn FVarss => fn fset => fn bsets => fn bfsets => fn FVars => + let + val mem = HOLogic.mk_Trueprop o HOLogic.mk_mem + val not_mem = HOLogic.mk_Trueprop o HOLogic.mk_not o HOLogic.mk_mem + val concl = mem (a, fst FVars $ (ctor $ x)); + in Logic.mk_implies (mem (a, fset $ x), concl) + :: map2 (fn bfset => fn bfree_bounds => fold_rev (curry Logic.mk_implies) [ + mem (a, bfset $ x), not_mem (a, foldl1 mk_Un (map (fn i => nth bsets i $ x) bfree_bounds)) + ] concl) bfsets bfree_boundss + @ @{map 4} (fn rec_set => fn FVars => fn rec_bounds => fn z => + fold_rev (curry Logic.mk_implies) (mem (z, rec_set $ x) :: mem (a, fst FVars $ z) :: + nonempty (fn xs => cons (not_mem (a, foldl1 mk_Un (map (fn i => nth bsets i $ x) xs)))) rec_bounds [] + ) concl + ) rec_sets (replicate_rec FVarss) rec_boundss (replicate_rec zs) end + ) aa bfree_boundsss rec_boundsss (transpose FVarsss) + ) rec_setss ctors xs fsetss bound_setsss bfree_setsss FVarsss; + + val FVars_raw_introsss = map (map (map (fn goal => + Goal.prove_sorry lthy (map fst (rev (Term.add_frees goal []))) [] goal (fn {context=ctxt, ...} => EVERY1 [ + K (Local_Defs.unfold0_tac ctxt (@{thm mem_Collect_eq} :: maps (map snd) FVars_rawss)), + eresolve_tac ctxt (maps #intrs is_freess), + REPEAT_DETERM o assume_tac ctxt + ]) + ))) (mk_FVars_intro_goalsss raw_rec_setss (map #ctor raw_Ts) raw_xs raw_zs raw_fsetss raw_bound_setsss raw_bfree_setsss FVars_rawss); + + fun mk_FVars_ctor_goalss rec_setss ctors xs fsetss bound_setsss bfree_setsss FVarsss = + @{map 7} (fn rec_sets => fn ctor => fn x => + @{map 7} (fn bfree_boundss => fn rec_boundss => fn FVarss => fn fset => fn bsets => fn bfsets => fn FVars => + mk_Trueprop_eq (fst FVars $ (ctor $ x), foldl1 mk_Un (fset $ x :: + map2 (fn bfset => fn bfree_bounds => + mk_minus (bfset $ x, foldl1 mk_Un (map (fn i => nth bsets i $ x) bfree_bounds)) + ) bfsets bfree_boundss + @ @{map 3} (fn rec_set => fn FVars => fn rec_bounds => + nonempty (fn xs => fn t => mk_minus (t, foldl1 mk_Un (map (fn i => nth bsets i $ x) xs))) rec_bounds + (mk_UNION (rec_set $ x) (fst FVars)) + ) rec_sets (replicate_rec FVarss) rec_boundss + )) + ) bfree_boundsss rec_boundsss (transpose FVarsss) + ) rec_setss ctors xs fsetss bound_setsss bfree_setsss FVarsss; + + val FVars_raw_ctorss = @{map 4} (fn raw => fn x => + @{map 4} (fn FVarss => fn is_frees => fn bfsets => fn goal => + let val m = 1 + nrecs + length bfsets; + in Goal.prove_sorry lthy (names [x]) [] goal (fn {context=ctxt, ...} => EVERY1 [ + K (Local_Defs.unfold_tac ctxt (map snd FVarss)), + rtac ctxt @{thm subset_antisym}, + rtac ctxt subsetI, + etac ctxt CollectE, + eresolve_tac ctxt (#elims is_frees), + EVERY' (map (fn i => EVERY' [ + dtac ctxt (iffD1 OF [#inject raw]), + hyp_subst_tac ctxt, + rtac ctxt (BNF_Util.mk_UnIN m i), + TRY o EVERY' [ + rtac ctxt @{thm DiffI[rotated]}, + assume_tac ctxt + ], + TRY o EVERY' [ + rtac ctxt @{thm UN_I}, + assume_tac ctxt, + rtac ctxt CollectI + ], + assume_tac ctxt + ]) (1 upto m)), + rtac ctxt subsetI, + REPEAT_DETERM o etac ctxt UnE, + REPEAT_DETERM o EVERY' [ + rtac ctxt CollectI, + TRY o etac ctxt @{thm DiffE}, + TRY o (etac ctxt @{thm UN_E} THEN' etac ctxt CollectE), + eresolve_tac ctxt (#intrs is_frees), + REPEAT_DETERM o assume_tac ctxt + ] + ]) end + ) (transpose FVars_rawss) is_freess + ) raw_Ts raw_xs raw_bfree_setsss (mk_FVars_ctor_goalss raw_rec_setss (map #ctor raw_Ts) raw_xs raw_fsetss raw_bound_setsss raw_bfree_setsss FVars_rawss); - val nnoclash_noclashs = @{map 5} (fn nnoclash => fn noclash => fn v => fn map_t => fn mrbnf => + val FVars_permute_raw_leqss = transpose (@{map 6} (fn FVarss => fn is_frees => fn a => fn f => fn bfsets => fn FVars_ctors => let - val ids = map HOLogic.id_const As; - val goal = mk_Trueprop_eq ( - fst nnoclash $ v, - fst noclash $ (Term.list_comb (map_t, ids @ take fbound ids @ flat (map2 replicate ks TT_reps)) $ v) + val goal = HOLogic.mk_Trueprop ( + foldr1 HOLogic.mk_conj (@{map 4} (fn FVars => fn is_free => fn permute => fn z => + HOLogic.mk_imp (is_free $ a $ z, + HOLogic.mk_mem (f $ a, fst FVars $ (Term.list_comb (fst permute, fs) $ z)) + )) FVarss (#preds is_frees) permute_raws raw_zs) ); - in Goal.prove_sorry lthy [fst (dest_Free v)] [] goal (fn {context=ctxt, ...} => EVERY1 [ - K (Local_Defs.unfold0_tac ctxt (map snd noclashs @ map snd nnoclashs)), + val m = 1 + nrecs + length bfsets; + in split_conj (Goal.prove_sorry lthy (names (fs @ [a] @ raw_zs)) f_prems goal (fn {context=ctxt, prems} => EVERY1 [ + if n > 1 then rtac ctxt (infer_instantiate' ctxt ( + replicate n NONE @ maps (fn z => map (SOME o Thm.cterm_of ctxt) [a, z]) raw_zs + ) (#induct is_frees)) + else rtac ctxt impI THEN' etac ctxt (#induct is_frees), + REPEAT_DETERM o EVERY' (map (fn i => SELECT_GOAL (EVERY1 [ + SELECT_GOAL (Local_Defs.unfold0_tac ctxt (FVars_ctors @ map (fn (_, thm) => thm OF prems) permute_raws)), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (maps MRBNF_Def.set_map_of_mrbnf mrbnfs), + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ prems) + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_comp}), + rtac ctxt (BNF_Util.mk_UnIN m i), + TRY o rtac ctxt @{thm DiffI}, + rtac ctxt imageI ORELSE' EVERY' [ + rtac ctxt @{thm UN_I}, + assume_tac ctxt, + EqSubst.eqsubst_tac ctxt [0] @{thms comp_apply} + ], + assume_tac ctxt, + IF_UNSOLVED o EVERY' [ + K (Local_Defs.unfold0_tac ctxt @{thms image_Un[symmetric]}), + rtac ctxt @{thm iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]]}, + resolve_tac ctxt prems, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms Un_iff de_Morgan_disj}), + REPEAT_DETERM o (rtac ctxt conjI THEN' assume_tac ctxt), + assume_tac ctxt + ] + ])) (1 upto m)) + ])) RSS mp end + ) (transpose FVars_rawss) is_freess aa fs (hd raw_bfree_setsss) (transpose FVars_raw_ctorss)); + + val FVars_permute_raws = @{map 4} (fn z => fn permute => + @{map 3} (fn f => fn thm => fn FVars => Goal.prove_sorry lthy (names (fs @ [z])) f_prems (mk_Trueprop_eq ( + fst FVars $ (Term.list_comb (fst permute, fs) $ z), + mk_image f $ (fst FVars $ z) + )) (fn {context=ctxt, prems} => EVERY1 [ + rtac ctxt @{thm subset_antisym}, + rtac ctxt subsetI, + EqSubst.eqsubst_asm_tac ctxt [0] [snd FVars], + dtac ctxt @{thm iffD1[OF mem_Collect_eq]}, + dtac ctxt (Drule.rotate_prems ~1 thm), + K (prefer_tac (2 * nvars + 1)), + EqSubst.eqsubst_asm_tac ctxt [0] permute_raw_comps, + K (prefer_tac (4 * nvars + 1)), REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), - REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id} + EqSubst.eqsubst_asm_tac ctxt [0] @{thms inv_o_simp1}, + resolve_tac ctxt prems ], - K (Local_Defs.unfold0_tac ctxt (@{thms image_id image_comp[unfolded comp_def]} @ flat FFVars_defss)), - rtac ctxt refl - ]) end - ) nnoclashs noclashs vs mrbnf_maps_BsAs mrbnfs; - - val (TT_existential_co_induct, TT_fresh_co_induct_param, TT_fresh_induct_param_no_clash_opt, - subshapess_opt, - TT_subshape_induct_opt, wf_subshape_opt, subshape_rel_opt, set_subshape_imagesss_opt, set_subshapesss_opt, - TT_fresh_co_induct, TT_plain_co_induct, lthy) = if co - then let - (* Define coinductive predicate alpha' *) - val (alpha's_invar_result, (alpha'sAs, _ (*alpha's*)), lthy) = - let - val bs = map (Binding.name o mk_alpha'N) names; - val Ts = map (fn CA => CA --> CA --> HOLogic.boolT) CAs; - val inductive_flags = {quiet_mode = true, verbose = false, alt_name = Binding.empty, - coind = true, no_elim = false, no_ind = false, skip_mono = false}; - val alpha'_ts = map2 (Free oo pair o Binding.name_of) bs Ts; - - fun mk_term x x' ctor alpha'_t bound_sets rec_sets mrbnf_rel_AsAs = - let - fun mk_FVarsBs x = - let - fun mk_zips FVars_ts = map (op $ o rpair x) rec_sets ~~ mk_rec_lives FVars_ts; - fun mk_bound_minus bound_set t = mk_minus t (bound_set $ x); - fun mk_UNION_term bound_set FVars_ts b_rels = map (nth (mk_zips FVars_ts) - #-> mk_UNION) b_rels |> map (mk_bound_minus bound_set) - |> foldl1 mk_union; - in - @{map 3} mk_UNION_term bound_sets FVarsssAs binding_relation - end; - val prems1 = map2 mk_id_on (mk_FVarsBs x) ffs; - val prems2 = map2 mk_id_on (mk_FVarsBs x') fgs; - - val recs_consts = ys ~~ ys' ~~ renamesAs ~~ alpha'_ts |> mk_rec_lives; - val rename_args = apply2 (replicate rec_live |> map) (fids ~~ fids, ffs ~~ fgs) - |-> transpose oo map_binding_matrix - |> map2 (fn b => if b then K NONE else SOME) no_bindings - |> map (Option.map split_list); - fun mk_rec_rel (_, alpha'_t) NONE = alpha'_t - | mk_rec_rel (((y, y'), rename_t), alpha'_t) (SOME (fs, gs)) = alpha'_t $ - (list_comb (rename_t, fs) $ y) $ (list_comb (rename_t, gs) $ y') - |> fold_rev (absfree o dest_Free) [y, y']; - val ideqs = map2 I (replicate free HOLogic.id_const @ - replicate plive HOLogic.eq_const @ replicate pbound HOLogic.id_const) As; - val prem0 = list_comb (mrbnf_rel_AsAs, ideqs @ - map2 (mk_inv #> curry HOLogic.mk_comp) fgs ffs @ - map2 mk_rec_rel recs_consts rename_args) $ x $ x'; - val concl = alpha'_t $ (ctor $ x) $ (ctor $ x'); - in - map HOLogic.mk_Trueprop prems1 @ [foldr1 Logic.mk_implies - (prems2 @ [prem0, concl] |> map HOLogic.mk_Trueprop) |> add_prems fgs] - |> foldr1 Logic.mk_implies |> add_prems ffs - end; - val terms = @{map 7} mk_term xs xs' ctorsAs alpha'_ts bound_setss_As rec_setss_As - mrbnf_rels_AsAs; - - fun mk_mono mr_rel_mono supp_comp_bound = mr_rel_mono OF replicate fbound - @{thm supp_id_bound} @ (replicate fbound [@{thm bij_comp[OF _ bij_imp_bij_inv]}, - supp_comp_bound OF [@{thm _}, @{thm supp_inv_bound}]] |> flat); - val monos = map2 mk_mono mr_rel_monos supp_comp_bounds @ @{thms conj_context_mono}; - - val (invar_result_raw, (new_lthy, lthy)) = lthy - |> Local_Theory.begin_nested |> snd - |> Inductive.add_inductive inductive_flags (map2 (rpair NoSyn oo pair) bs Ts) [] - (map (pair Binding.empty_atts) terms) monos - ||> `Local_Theory.end_nested; - - val phi = Proof_Context.export_morphism lthy new_lthy; - val invar_result = Inductive.transform_result phi invar_result_raw; - val frees_freesAs = map (Morphism.term phi) alpha'_ts |> `(subst_terms As); - in - (invar_result, frees_freesAs, new_lthy) - end; + K (Local_Defs.unfold0_tac ctxt permute_raw_ids), + etac ctxt @{thm iffD2[OF image_in_bij_eq, rotated]}, + REPEAT_DETERM o resolve_tac ctxt (@{thms bij_imp_bij_inv supp_inv_bound} @ prems), + rtac ctxt subsetI, + etac ctxt imageE, + hyp_subst_tac ctxt, + EqSubst.eqsubst_asm_tac ctxt [0] [snd FVars], + dtac ctxt @{thm iffD1[OF mem_Collect_eq]}, + etac ctxt (thm OF prems) + ])) fs + ) raw_zs permute_raws FVars_permute_raw_leqss FVars_rawss; + + val Un_bound = @{thm infinite_regular_card_order_Un} OF [ + MRBNF_Def.bd_infinite_regular_card_order_of_mrbnf (hd mrbnfs) + ]; + val UN_bound = @{thm regularCard_UNION_bound} OF [ + MRBNF_Def.bd_Cinfinite_of_mrbnf (hd mrbnfs), + MRBNF_Def.bd_regularCard_of_mrbnf (hd mrbnfs) + ]; + + val FVars_raw_bds = transpose (map (fn FVarss => split_conj ( + Goal.prove_sorry lthy (names raw_zs) [] (HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj (map2 (fn FVars => fn z => + mk_ordLess (mk_card_of (fst FVars $ z)) (MRBNF_Def.bd_of_mrbnf (hd mrbnfs)) + ) FVarss raw_zs))) (fn {context=ctxt, ...} => EVERY1 [ + rtac ctxt raw_induct, + K (Local_Defs.unfold0_tac ctxt (flat FVars_raw_ctorss)), + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt (@{thm ordLeq_ordLess_trans[OF card_of_diff]} :: [Un_bound, UN_bound] + @ maps MRBNF_Def.set_bd_of_mrbnf mrbnfs + ), + Goal.assume_rule_tac ctxt + ] + ]) + )) (transpose FVars_rawss)); + + val FVars_raw_bd_UNIVs = map (map (fn thm => @{thm ordLess_ordLeq_trans} OF [thm, + @{thm ordIso_ordLeq_trans} OF [ + @{thm ordIso_symmetric[OF card_of_Field_ordIso]} OF [MRBNF_Def.bd_Card_order_of_mrbnf (hd mrbnfs)], + #var_large (MRBNF_Def.class_thms_of_mrbnf (hd mrbnfs)) + ] + ])) FVars_raw_bds; + + val alpha_refls = split_conj (Goal.prove_sorry lthy [] [] (HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj ( + @{map 3} (fn z => fn z' => fn alpha => fold_rev (mk_all o dest_Free) [z, z'] ( + HOLogic.mk_imp (HOLogic.mk_eq (z, z'), alpha $ z $ z') + )) raw_zs raw_zs' (#preds alphas) + ))) (fn {context=ctxt, ...} => EVERY1 [ + if n > 1 then rtac ctxt (#induct alphas) + else REPEAT_DETERM o resolve_tac ctxt [allI, impI] THEN' etac ctxt (#induct alphas), + hyp_subst_tac ctxt, + K (Local_Defs.unfold0_tac ctxt @{thms triv_forall_equality}), + EVERY' (map2 (fn raw => fn mrbnf => EVERY' [ + Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => + rtac ctxt (infer_instantiate' ctxt [SOME (snd (hd params))] (#exhaust raw)) 1 + ) ctxt, + hyp_subst_tac ctxt, + REPEAT_DETERM o rtac ctxt exI, + REPEAT_DETERM o EVERY' [ + rtac ctxt conjI, + resolve_tac ctxt @{thms refl supp_id_bound bij_id id_on_id eq_on_refl} + ], + K (Local_Defs.unfold0_tac ctxt ( + (MRBNF_Def.mr_rel_id_of_mrbnf mrbnf RS sym) :: permute_raw_ids + )), + rtac ctxt (MRBNF_Def.rel_refl_strong_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt @{thms refl disjI1} + ]) raw_Ts mrbnfs) + ])) RSS spec RSS spec RSS @{thm mp[OF _ refl]}; - val alpha'_coinduct = #induct alpha's_invar_result; - val alpha'_elims = #elims alpha's_invar_result; + val alpha_bijs = + let + val ((xx, yy), _) = lthy + |> mk_Frees "x" (map #T raw_Ts) + ||>> mk_Frees "y" (map #T raw_Ts); + + val eq_on_premss = map2 (fn x => @{map 3} (fn f => fn g => fn FVars => + mk_eq_on (fst FVars $ x) f g + ) fs gs) xx FVars_rawss; + + val thms = split_conj (Goal.prove_sorry lthy [] [] (HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj ( + @{map 7} (fn z => fn z' => fn x => fn y => fn permute => fn alpha => fn eq_on_prems => mk_all (dest_Free z) (mk_all (dest_Free z') ( + HOLogic.mk_imp ( + fold_rev (mk_ex o dest_Free) ([x, y] @ fs @ gs) (foldr1 HOLogic.mk_conj ( + map HOLogic.dest_Trueprop (f_prems @ g_prems) @ [ + HOLogic.mk_eq (z, Term.list_comb (fst permute, fs) $ x), + HOLogic.mk_eq (z', Term.list_comb (fst permute, gs) $ y) + ] @ eq_on_prems @ [alpha $ x $ y] + )), + alpha $ z $ z' + ) + ))) raw_zs raw_zs' xx yy permute_raws (#preds alphas) eq_on_premss + ))) (fn {context=ctxt, ...} => EVERY1 [ + if n > 1 then rtac ctxt (#induct alphas) + else REPEAT_DETERM o resolve_tac ctxt [allI, impI] THEN' etac ctxt (#induct alphas), + EVERY' (map2 (fn mrbnf => fn FVars_intross => EVERY' [ + REPEAT_DETERM o eresolve_tac ctxt [exE, conjE], + eresolve_tac ctxt (#elims alphas), + hyp_subst_tac ctxt, + K (Local_Defs.unfold0_tac ctxt @{thms triv_forall_equality}), + Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => + let val ((((fs, gs), hs), fs'), _) = map (Thm.term_of o snd) params + |> chop nvars + ||>> chop nvars + ||>> chop nvars + ||>> chop (length (flat hss)) o drop 1; + val fss' = fst (fold_map (chop o length) hss fs'); + in EVERY1 [ + EVERY' (@{map 3} (fn f => fn g => fn h => rtac ctxt (infer_instantiate' ctxt [NONE, + SOME (Thm.cterm_of ctxt (foldl1 HOLogic.mk_comp [g, h, mk_inv f])) + ] exI)) fs gs hs), + rtac ctxt exI, + EVERY' (flat (@{map 3} (fn f => fn g => map (fn f' => rtac ctxt (infer_instantiate' ctxt [NONE, + SOME (Thm.cterm_of ctxt (foldl1 HOLogic.mk_comp [g, f', mk_inv f])) + ] exI))) fs gs fss')), + rtac ctxt exI, + REPEAT_DETERM o EVERY' [ + rtac ctxt conjI, + resolve_tac ctxt (map snd permute_raws), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt) + ], + REPEAT_DETERM o EVERY' [ + rtac ctxt conjI, + REPEAT_DETERM1 o FIRST' [ + resolve_tac ctxt (@{thms bij_comp supp_comp_bound bij_imp_bij_inv supp_inv_bound} @ [infinite_UNIV]), + assume_tac ctxt + ] + ], + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt) + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_comp[unfolded comp_def]}), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (flat FVars_permute_raws), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt) + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_UN[symmetric] image_Un[symmetric]}), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] @{thms image_set_diff[OF bij_is_inj, symmetric]}, + assume_tac ctxt + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_Un[symmetric]}), + EVERY' (map (fn g => REPEAT_DETERM o EVERY' [ + rtac ctxt conjI, + rtac ctxt @{thm id_onI}, + etac ctxt imageE, + hyp_subst_tac ctxt, + rtac ctxt @{thm trans[OF comp_apply]}, + rtac ctxt @{thm trans[OF arg_cong[OF inv_simp1]]}, + assume_tac ctxt, + rtac ctxt @{thm trans[OF comp_apply]}, + rtac ctxt trans, + rtac ctxt (mk_arg_cong lthy 1 g), + etac ctxt @{thm id_onD}, + assume_tac ctxt, + rtac ctxt sym, + etac ctxt @{thm eq_onD}, + REPEAT_DETERM o etac ctxt UnE, + REPEAT_DETERM o EVERY' [ + etac ctxt @{thm DiffE}, + TRY o etac ctxt @{thm UN_E}, + eresolve_tac ctxt (flat FVars_intross), + REPEAT_DETERM o assume_tac ctxt + ], + REPEAT_DETERM o (EVERY' [ + rtac ctxt conjI, + REPEAT_DETERM1 o FIRST' [ + resolve_tac ctxt (infinite_UNIV :: @{thms bij_comp supp_comp_bound bij_imp_bij_inv supp_inv_bound}), + assume_tac ctxt + ] + ] ORELSE' EVERY' [ + rtac ctxt conjI, + rtac ctxt @{thm eq_on_comp2[OF eq_on_refl]}, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms image_comp inv_o_simp1 image_id}), + rtac ctxt @{thm eq_on_comp2[OF _ eq_on_refl]}, + assume_tac ctxt + ]) + ]) gs), + rtac ctxt (iffD2 OF [hd (MRBNF_Def.mr_rel_map_of_mrbnf mrbnf)]), + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt (infinite_UNIV :: @{thms supp_id_bound bij_id bij_comp bij_imp_bij_inv supp_inv_bound supp_comp_bound}), + assume_tac ctxt + ], + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id Grp_UNIV_id eq_OO}), + rtac ctxt (iffD2 OF [nth (MRBNF_Def.mr_rel_map_of_mrbnf mrbnf) 2]), + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt (infinite_UNIV :: @{thms supp_id_bound bij_id bij_comp bij_imp_bij_inv supp_inv_bound supp_comp_bound}), + assume_tac ctxt + ], + K (Local_Defs.unfold0_tac ctxt @{thms comp_assoc inv_id id_o o_id Grp_UNIV_id conversep_eq OO_eq relcompp_conversep_Grp Grp_OO}), + REPEAT_DETERM o (EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1} THEN' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id comp_assoc[symmetric]}), + REPEAT_DETERM o (EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1} THEN' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id}), + etac ctxt (Drule.rotate_prems (~nargs - 1) (MRBNF_Def.mr_rel_mono_strong0_of_mrbnf mrbnf)), + REPEAT_DETERM o EVERY' [ + rtac ctxt ballI, + rtac ctxt @{thm trans[OF id_apply]}, + rtac ctxt sym, + rtac ctxt @{thm trans[OF comp_apply]}, + rtac ctxt @{thm inv_f_eq[OF bij_is_inj]}, + assume_tac ctxt, + rtac ctxt sym, + etac ctxt @{thm eq_onD}, + eresolve_tac ctxt (flat FVars_intross) + ], + REPEAT_DETERM o FIRST' [ + rtac ctxt ballI THEN' rtac ctxt refl, + rtac ctxt ballI THEN' rtac ctxt ballI THEN' rtac ctxt impI THEN' assume_tac ctxt + ], + EVERY' (map (fn rec_boundss => EVERY' [ + rtac ctxt ballI, + rtac ctxt ballI, + rtac ctxt impI, + rtac ctxt disjI1, + rtac ctxt exI, + rtac ctxt exI, + EVERY' (@{map 3} (fn f => fn g => fn rec_bounds => rtac ctxt ( + infer_instantiate' ctxt [NONE, SOME (Thm.cterm_of ctxt (if null rec_bounds then f else g))] exI + )) (fs @ gs) (gs @ gs) (rec_boundss @ rec_boundss)), + REPEAT_DETERM o (rtac ctxt conjI THEN' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt @{thms conj_assoc[symmetric]}), + etac ctxt @{thm conjI[rotated]}, + K (Local_Defs.unfold0_tac ctxt @{thms conj_assoc}), + rtac ctxt conjI, + rtac ctxt refl ORELSE' EVERY' [ + rtac ctxt trans, + resolve_tac ctxt permute_raw_comps, + REPEAT_DETERM o FIRST' [ + assume_tac ctxt, + resolve_tac ctxt (infinite_UNIV :: @{thms supp_id_bound bij_id bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound}) + ], + K (Local_Defs.unfold0_tac ctxt @{thms comp_assoc}), + REPEAT_DETERM o (EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1} THEN' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id comp_assoc[symmetric]}), + rtac ctxt sym, + rtac ctxt trans, + resolve_tac ctxt permute_raw_comps, + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_id_bound bij_id}), + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id}), + rtac ctxt refl + ], + rtac ctxt conjI, + rtac ctxt refl, + REPEAT_DETERM o EVERY' [ + TRY o rtac ctxt conjI, + rtac ctxt @{thm eq_on_refl} ORELSE' EVERY' [ + etac ctxt @{thm eq_on_mono[rotated]}, + rtac ctxt subsetI, + eresolve_tac ctxt (flat FVars_intross), + TRY o EVERY' [ + EqSubst.eqsubst_asm_tac ctxt [0] (flat FVars_permute_raws), + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms bij_id supp_id_bound}), + K (Local_Defs.unfold0_tac ctxt @{thms image_id}) + ], + assume_tac ctxt + ] + ] + ]) (transpose rec_boundsss)), + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt (infinite_UNIV :: @{thms supp_id_bound bij_id supp_comp_bound supp_inv_bound}), + assume_tac ctxt + ] + ] end + ) ctxt + ]) mrbnfs FVars_raw_introsss) + ])); + + in @{map 6} (fn thm => fn x => fn y => fn eq_on_prems => fn alpha => fn permute => Goal.prove_sorry lthy (names (fs @ gs @ [x, y])) + (f_prems @ g_prems @ map HOLogic.mk_Trueprop eq_on_prems) (Logic.mk_implies (apply2 HOLogic.mk_Trueprop ( + alpha $ x $ y, alpha $ (Term.list_comb (fst permute, fs) $ x) $ (Term.list_comb (fst permute, gs) $ y) + ))) (fn {context=ctxt, prems} => EVERY1 [ + rtac ctxt (thm RS spec RS spec RS mp), + REPEAT_DETERM o rtac ctxt exI, + REPEAT_DETERM o rtac ctxt @{thm conjI[rotated]}, + assume_tac ctxt, + REPEAT_DETERM o resolve_tac ctxt (refl :: prems) + ]) + ) thms xx yy eq_on_premss (#preds alphas) permute_raws end; + + val alpha_bij_eqs = @{map 5} (fn alpha => fn z => fn z' => fn permute => fn thm => + Goal.prove_sorry lthy (names (fs @ [z, z'])) f_prems (mk_Trueprop_eq ( + alpha $ (Term.list_comb (fst permute, fs) $ z) $ (Term.list_comb (fst permute, fs) $ z'), + alpha $ z $ z' + )) (fn {context=ctxt, prems} => EVERY1 [ + rtac ctxt @{thm iffI[rotated]}, + etac ctxt (thm OF (prems @ prems @ replicate nvars @{thm eq_on_refl})), + dtac ctxt (Drule.rotate_prems ~1 thm), + K (prefer_tac (5 * nvars + 1)), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_asm_tac ctxt [0] permute_raw_comps, + K (prefer_tac (4 * nvars + 1)), + REPEAT_DETERM o (EqSubst.eqsubst_asm_tac ctxt [0] @{thms inv_o_simp1} THEN' resolve_tac ctxt prems) + ], + K (Local_Defs.unfold0_tac ctxt permute_raw_ids), + assume_tac ctxt, + REPEAT_DETERM o resolve_tac ctxt (@{thms bij_imp_bij_inv supp_inv_bound} @ prems), + REPEAT_DETERM o rtac ctxt @{thm eq_on_refl} + ]) + ) (#preds alphas) raw_zs raw_zs' permute_raws alpha_bijs; + + val alpha_bij_eq_invs = @{map 5} (fn alpha => fn z => fn z' => fn permute => fn thm => + Goal.prove_sorry lthy (names (fs @ [z, z'])) f_prems (mk_Trueprop_eq ( + alpha $ (Term.list_comb (fst permute, fs) $ z) $ z', + alpha $ z $ (Term.list_comb (fst permute, map mk_inv fs) $ z') + )) (fn {context=ctxt, prems} => EVERY1 [ + rtac ctxt trans, + rtac ctxt (thm RS sym), + K (prefer_tac (2 * nvars + 1)), + EqSubst.eqsubst_tac ctxt [0] permute_raw_comps, + K (prefer_tac (4 * nvars + 1)), + REPEAT_DETERM o (EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1} THEN' resolve_tac ctxt prems), + K (Local_Defs.unfold0_tac ctxt permute_raw_ids), + rtac ctxt refl, + REPEAT_DETERM o resolve_tac ctxt (@{thms bij_imp_bij_inv supp_inv_bound} @ prems) + ]) + ) (#preds alphas) raw_zs raw_zs' permute_raws alpha_bij_eqs; + + fun id_on_tac ctxt = EVERY' [ + etac ctxt @{thm id_on_antimono}, + rtac ctxt subsetI, + rotate_tac ~1, + etac ctxt @{thm contrapos_pp}, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms Un_iff de_Morgan_disj}), + REPEAT_DETERM o etac ctxt conjE, + assume_tac ctxt + ]; + + val mr_set_transfer_livess = map (fn mrbnf => cond_keep (MRBNF_Def.mr_set_transfer_of_mrbnf mrbnf) + (map (curry (op=) MRBNF_Def.Live_Var) (MRBNF_Def.var_types_of_mrbnf mrbnf)) + ) mrbnfs; - val alpha'_bij_eq_invs = - let - fun mk_eq alpha'_t rename_t y y' = HOLogic.mk_imp - (alpha'_t $ (list_comb (rename_t, ffs) $ y) $ y', - alpha'_t $ y $ (list_comb (rename_t, map mk_inv ffs) $ y')); - val goal = @{map 4} mk_eq alpha'sAs renamesAs ys ys' |> mk_conjs - |> HOLogic.mk_Trueprop; - - fun mk_rel alpha'_t rename_t y y' = alpha'_t $ (list_comb (rename_t, ffs) $ y) $ - (list_comb (rename_t, ffs) $ y') |> SOME o fold_rev (absfree o dest_Free) [y, y']; - val alpha'_coinduct_inst = (thm_instantiate_terms lthy - (@{map 4} mk_rel alpha'sAs renamesAs ys ys') alpha'_coinduct) - |> (if mutual then (fn thm => meta_mp OF [@{thm _}, thm]) else I); - val imp_forward = if mutual then @{thm _} else (thm_instantiate_fixed_terms lthy - [hd alpha'sAs $ (list_comb (hd renamesAs, ffs) $ hd ys) $ - (list_comb (hd renamesAs, ffs) $ hd ys') |> SOME, hd alpha'sAs $ (hd ys) $ - (hd ys') |> SOME] [hd ys, hd ys'] @{thm imp_forward}) - |> Drule.rearrange_prems [2,1,0]; - - fun mk_exI f g = thm_instantiate_terms lthy [NONE, - SOME (HOLogic.mk_comp (mk_inv f, HOLogic.mk_comp (g, f)))] exI; - fun mk_exIs fs gs = map (map2 mk_exI ffs) [fs, gs] |> flat; - in - mk_alpha'_bij_eq_invs_tac fbound alpha'_coinduct_inst raw_injects mk_exIs mutual - imp_forward supp_comp_bounds rename_simps (flat FVars_renamess) rename_comps - alpha'_elims raw_nchotomys mr_rel_maps set_maps mr_rel_mono_strong0s rename_ids - |> prove lthy (ffs @ ys @ ys') prem_terms_ffs goal - |> split_conjs - |> map (fn thm => thm RS mp) - end; - - fun mk_alpha'_bij_eq_inv' y y' alpha'_t rename_t alpha'_bij_eq_inv rename_id - rename_comp = - let - val rename = list_comb (rename_t, ffs) $ y'; - val inv_rename = list_comb (rename_t, map mk_inv ffs); - val goal = [alpha'_t $ y $ rename, alpha'_t $ (inv_rename $ y) $ y'] - |> map HOLogic.mk_Trueprop |> foldr1 Logic.mk_implies; - - val arg_cong_inst = thm_instantiate_terms lthy [SOME y', SOME (inv_rename $ rename), - SOME (alpha'_t $ (inv_rename $ y) $ y' |> absfree (dest_Free y'))] @{thm arg_cong} - RS iffD2 OF [@{thm _}, alpha'_bij_eq_inv]; - in - mk_alpha'_bij_eq_inv'_tac arg_cong_inst rename_id rename_comp - |> prove lthy (ffs @ [y, y']) prem_terms_ffs goal - end; - val alpha'_bij_eq_inv's = @{map 7} mk_alpha'_bij_eq_inv' ys ys' alpha'sAs renamesAs - alpha'_bij_eq_invs rename_ids rename_comps; + val do_eq_onss = map (fn rec_boundss => + let val all_bound_idxs = distinct (op=) (flat rec_boundss); + in map (fn xs => not (null xs orelse xs = all_bound_idxs)) rec_boundss end + ) rec_boundsss; - fun mk_alpha'_FVars_les z FVars_ts FVars_induct set_transfers = - let - fun mk_eq y y' alpha'_t FVars_t = HOLogic.mk_imp (HOLogic.mk_mem (z, FVars_t $ y), - HOLogic.mk_imp (alpha'_t $ y $ y', HOLogic.mk_mem (z, FVars_t $ y')) - |> list_all_free [y']); - val eqs = @{map 4} mk_eq ys ys' alpha'sAs FVars_ts; - val goal = mk_conjs eqs |> HOLogic.mk_Trueprop; - in - mk_alpha_FVars_les_tac mutual false true (rec_live+1) (mk_rec_lives (alpha'_bij_eq_invs ~~ map SOME rename_comps)) - FVars_induct alpha'_elims raw_injects (flat FVars_renamess) (flat FVars_ctorss) - set_transfers supp_comp_bounds - |> prove_no_prems lthy (ys @ [z]) goal - |> split_conjs - |> map (fn thm => Drule.rotate_prems 1 (thm RS mp RS spec RS mp)) - end; - val alpha'_FVars_less = - let - fun zip_opt (xs, NONE) = map (rpair NONE) xs - | zip_opt (xs, SOME ys) = xs ~~ map SOME ys; - fun add_bound_sett rec_settss free_setts bound_setts b_vec = - map (rpair NONE) rec_settss |> swap o `(SOME bound_setts |> map o apsnd o K) - |-> map_binding_vector b_vec |> map zip_opt - |> (map2 (curry op:: o rpair NONE) free_setts) o transpose; - val set_transferss = @{map 3} (add_bound_sett rec_settss) free_settss bound_settss - binding_matrix; - in - @{map 4} mk_alpha'_FVars_les zs FVarsssAs FVars_inducts set_transferss - end; + val alpha_FVars_leqss = apply2 transpose (split_list (@{map 6} (fn a => fn is_frees => fn FVarss => fn num_bfrees => fn rec_boundss => fn do_eq_ons => + let + fun mk_goal flipped = HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj ( + @{map 5} (fn z => fn z' => fn alpha => fn is_free => fn FVars => HOLogic.mk_imp ( + is_free $ a $ z, mk_all (dest_Free z') (HOLogic.mk_imp ( + if flipped then alpha $ z' $ z else alpha $ z $ z', + HOLogic.mk_mem (a, fst FVars $ z') + )) + )) raw_zs raw_zs' (#preds alphas) (#preds is_frees) FVarss + )); - val alpha_imp_alpha's = + fun mk_idxs [] = [] + | mk_idxs (Inl r :: xss) = r :: mk_idxs xss + | mk_idxs (Inr xs :: xss) = let - fun mk_eq alpha_t alpha'_t y y' = HOLogic.mk_imp (alpha_t $ y $ y', alpha'_t $ y $ y') - |> list_all_free [y, y']; - val goal = @{map 4} mk_eq alphasAs alpha'sAs ys ys' |> HOLogic.mk_Trueprop o mk_conjs; - in - mk_alpha_imp_alpha's_tac mutual fbound alpha'_coinduct raw_injects rename_ids - alpha_elims mr_rel_mono_strong0s - |> prove_no_prems lthy [] goal - |> split_conjs - |> map (fn thm => thm RS @{thm spec2}) - end; - - val alpha'_imp_alphas = - let - fun mk_eq alpha_t alpha'_t y y' = HOLogic.mk_imp (alpha'_t $ y $ y', alpha_t $ y $ y') - |> list_all_free [y, y']; - val goal = @{map 4} mk_eq alphasAs alpha'sAs ys ys' |> HOLogic.mk_Trueprop o mk_conjs; + val max = 1 + length (filter (fn Inl _ => false | Inr ys => xs = ys) xss); + val xss' = fst (fold_map (fn y => fn m => case y of + Inl r => (Inl r, m) + | Inr ys => if xs = ys then (Inl (m, max), m + 1) else (Inr ys, m) + ) xss 2); + in (1, max) :: mk_idxs xss' end - val settss = map2 (curry op ::) (transpose bound_settss |> flat) (map_product - (fn xs => fn bs => filter_like bs I xs) (transpose rec_settss) binding_matrix); + val rec_idxs = mk_idxs (map Inr rec_boundss); - fun mk_arg_cong z h f g = - thm_instantiate_fixed_terms lthy [SOME (mk_inv f $ (g $ z)), SOME z, SOME - (HOLogic.mk_eq (h $ z, z) |> absfree (dest_Free z))] [z, h] arg_cong RS iffD2; - val mk_arg_congs = @{map 4} mk_arg_cong zs fgs; - in - mk_alpha'_imp_alphas_tac fbound alpha_coinduct supp_comp_bounds mk_arg_congs mutual - (flat FVars_renamess) alpha'_bij_eq_invs alpha'_bij_eq_inv's - (flat alpha'_FVars_less) rename_comps raw_injects alpha'_elims - mr_rel_mono_strong0s settss - |> prove_no_prems lthy [] goal - |> split_conjs - |> map (fn thm => thm RS @{thm spec2}) - end; - - val alpha_alpha's = map2 - (fn thm1 => fn thm2 => @{thm iff_conv_conj_imp[THEN iffD2, OF conjI]} OF [thm1, thm2]) - alpha_imp_alpha's alpha'_imp_alphas; - - val ((Rs, Ss), frees_lthy) = frees_lthy - |> mk_Frees "R" (map (fn CB => CB --> CB --> paramT --> HOLogic.boolT) CBs) - ||>> mk_Frees "S" (map (fn CB => CB --> CB --> HOLogic.boolT) CBs); - - val TT_existential_coinduct = - let - fun mk_eq w w' S = HOLogic.mk_imp (S $ w $ w', HOLogic.mk_eq (w, w')) - |> list_all_free [w, w']; - val goal = @{map 3} mk_eq ws ws' Ss |> mk_conjs |> HOLogic.mk_Trueprop; - - fun mk_rel S w w' = HOLogic.mk_disj (S $ w $ w', HOLogic.mk_eq (w, w')) - |> fold_rev (absfree o dest_Free) [w, w']; - val rels = @{map 3} mk_rel Ss ws ws'; - val ideqs = map2 I (replicate free HOLogic.id_const @ replicate plive HOLogic.eq_const - @ replicate pbound HOLogic.id_const) As; - val (us, us') = frees_lthy - |> mk_Frees "u" (map fastype_of vs) - ||> fst o mk_Frees "u'" (map fastype_of vs'); - - fun mk_hyp mrbnf_rel_BsBs u u' v v' S cctor = [S $ (cctor $ v) $ (cctor $ v'), - [HOLogic.mk_eq (cctor $ u, cctor $ v), HOLogic.mk_eq (cctor $ u', cctor $ v'), - comb_mrbnf_term ideqs rels mrbnf_rel_BsBs $ u $ u'] - |> mk_conjs |> list_exists_free [u, u']] |> map HOLogic.mk_Trueprop - |> foldr1 Logic.mk_implies |> fold_rev Logic.all [v, v']; - val hyps = @{map 7} mk_hyp mrbnf_rels_BsBs us us' vs vs' Ss cctorsAs; - - fun mk_rep_eq y y' S TT_abs alpha_t = HOLogic.mk_imp - (S $ (TT_abs $ y) $ (TT_abs $ y'), alpha_t $ y $ y') |> list_all_free [y, y']; - val rep_meta_mp = thm_instantiate_terms lthy [@{map 5} mk_rep_eq ys ys' Ss - TT_abss alphasAs |> mk_conjs |> HOLogic.mk_Trueprop |> SOME] meta_mp; - - fun mk_abs_rel y y' S TT_abs alpha_t = HOLogic.mk_disj - (S $ (TT_abs $ y) $ (TT_abs $ y'), alpha_t $ y $ y') - |> fold_rev (absfree o dest_Free) [y, y']; - val abs_rels = @{map 5} mk_abs_rel ys ys' Ss TT_abss alphasAs; - fun mk_abs_meta_mp mrbnf_map_BsAs mrbnf_rel_AsAs mrbnf_rel_BsBs v v' = - thm_instantiate_fixed_terms lthy - ([comb_mrbnf_term ideqs rels mrbnf_rel_BsBs $ v $ v', - comb_mrbnf_term ideqs abs_rels mrbnf_rel_AsAs $ - (comb_mrbnf_term (map HOLogic.id_const As) TT_reps mrbnf_map_BsAs $ v) $ - (comb_mrbnf_term (map HOLogic.id_const As) TT_reps mrbnf_map_BsAs $ v')] - |> map (SOME o HOLogic.mk_Trueprop)) [v, v'] meta_mp |> Drule.rotate_prems ~1; - val abs_meta_mps = @{map 5} mk_abs_meta_mp mrbnf_maps_BsAs mrbnf_rels_AsAs - mrbnf_rels_BsBs vs vs'; - - fun mk_allE TT_rep w = thm_instantiate_fixed_terms lthy [NONE, SOME (TT_rep $ w)] [w] - allE; - val allE_insts = map2 mk_allE TT_reps ws; - in - mk_TT_existential_coinduct_tac fbound (plive + rec_live) raw_injects rep_meta_mp - Quotient_abs_reps alpha_refls Quotient_total_abs_eq_iffs supp_comp_bounds allE_insts - alpha_alpha's alpha'_coinduct raw_nchotomys TT_abs_ctors cctor_defs alpha_syms - alpha_elims abs_meta_mps mr_rel_maps mr_rel_mono_strong_ids mr_rel_mono_strong0s - mr_le_rel_OOs mr_rel_flips mutual - |> prove lthy Ss hyps goal - end; - - val TT_fresh_coinduct_param = - let - val bex_rho_param = absfree (dest_Free rho) #> mk_Bex param; - fun mk_bex_Rww' R w w' = R $ w $ w' $ rho |> bex_rho_param; - fun mk_eq w w' R = HOLogic.mk_imp (mk_bex_Rww' R w w', HOLogic.mk_eq (w, w')) - |> list_all_free [w, w']; - val goal = @{map 3} mk_eq ws ws' Rs |> mk_conjs |> HOLogic.mk_Trueprop; - - val params = map (fn varsOf => [HOLogic.mk_mem (rho, param), varsOf $ rho |> mk_bound] - |> map HOLogic.mk_Trueprop |> foldr1 Logic.mk_implies |> Logic.all rho) varsOfs; - fun mk_not_varsOf z set varsOf v = [HOLogic.mk_mem (z, set $ v), - HOLogic.mk_mem (z, varsOf $ rho) |> HOLogic.mk_not] |> map HOLogic.mk_Trueprop - |> foldr1 Logic.mk_implies |> Logic.all z; - fun mk_not_varsOfs v v' sets = @{map 3} (fn z => fn set => fn varsOf => - map (mk_not_varsOf z set varsOf) [v, v']) zs sets varsOfs |> flat; - - fun mk_rel R w w' = HOLogic.mk_disj (mk_bex_Rww' R w w', HOLogic.mk_eq (w, w')) - |> fold_rev (absfree o dest_Free) [w, w']; - val rels = @{map 3} mk_rel Rs ws ws'; - val ideqs = map2 I (replicate free HOLogic.id_const @ replicate plive HOLogic.eq_const - @ replicate pbound HOLogic.id_const) As; - - fun mk_hyp mrbnf_rel_BsBs v v' R cctor sets = [R $ (cctor $ v) $ (cctor $ v') $ rho - |> HOLogic.mk_Trueprop] @ mk_not_varsOfs v v' sets @ - ([HOLogic.mk_mem (rho, param), comb_mrbnf_term ideqs rels mrbnf_rel_BsBs $ v $ v'] - |> map HOLogic.mk_Trueprop) |> foldr1 Logic.mk_implies - |> fold_rev Logic.all [v, v', rho]; - val hyps = @{map 6} mk_hyp mrbnf_rels_BsBs vs vs' Rs cctorsAs bound_setss_Bs; - in - mk_TT_fresh_coinduct_param_tac fbound TT_existential_coinduct TT_fresh_cases - |> prove lthy (param :: varsOfs @ Rs) (params @ hyps) goal - end; - - val TT_fresh_coinduct = thm_instantiate_fixed_terms lthy (HOLogic.mk_UNIV paramT :: - map (absfree (dest_Free rho)) fsets @ @{map 3} (fn S => fn w => fn w' => S $ w $ w' - |> fold_rev (absfree o dest_Free) [w, w', rho]) Ss ws ws' |> map SOME) (fsets @ Ss) - TT_fresh_coinduct_param |> full_simplify lthy; - - val TT_plain_coinduct = (TT_fresh_coinduct OF - (replicate fbound @{thm supp_id_bound[unfolded supp_id]})) |> full_simplify lthy; - - fun after_qed thm = if mutual then thm else - Drule.rotate_prems ~1 (thm RS @{thm spec2} RS mp); - in - (after_qed TT_existential_coinduct, after_qed TT_fresh_coinduct_param, NONE, NONE, NONE, - NONE, NONE, NONE, NONE, after_qed TT_fresh_coinduct, after_qed TT_plain_coinduct, lthy) - end - else let - (* Define inductive predicate subshape *) - fun define_subshape name2 CA2 ctor x name1 CA1 alpha_t rename_t y y' sets lthy = - let - val b = mk_subshapeN name1 name2 |> Binding.name; - val T = CA1 --> CA2 --> HOLogic.boolT; - val inductive_flags = {quiet_mode = true, verbose = false, alt_name = Binding.empty, - coind = false, no_elim = false, no_ind = false, skip_mono = false}; - val subshape_t = Free (Binding.name_of b, T); - - val concl = subshape_t $ y $ (ctor $ x); - val prem1 = alpha_t $ (list_comb (rename_t, ffs) $ y) $ y'; - val prem2 = HOLogic.mk_mem (y', if length sets = 0 - then Const (@{const_name bot}, fastype_of y' |> HOLogic.mk_setT) - else map (fn t => t $ x) sets |> foldl1 mk_union); - val term = prem_terms_ffs @ map HOLogic.mk_Trueprop [prem1, prem2, concl] - |> foldr1 Logic.mk_implies; - - val (invar_result_raw, (new_lthy, lthy)) = lthy - |> Local_Theory.begin_nested |> snd - |> Inductive.add_inductive inductive_flags [((b, T), NoSyn)] [] - (map (pair Binding.empty_atts) [term]) [] - ||> `Local_Theory.end_nested; - - val phi = Proof_Context.export_morphism lthy new_lthy; - val invar_result = Inductive.transform_result phi invar_result_raw; - val subshape_subshapeAs = Morphism.term phi subshape_t - |> `(subst_terms As |> singleton); - in - ((invar_result, subshape_subshapeAs), new_lthy) - end; - fun define_subshapes name2 CA2 ctor x = apfst (split_list ##> split_list) oo - @{fold_map 7} (define_subshape name2 CA2 ctor x) names CAs alphasAs renamesAs ys ys'; - val ((subshape_invar_resultss, (subshapessAs, _ (*subshapess*))), lthy) = - @{fold_map 5} define_subshapes names CAs ctorsAs xs (map dest_rec_lives rec_setss_As) - lthy |>> apsnd split_list o split_list; - - val subshape_elimss = (the_single o #elims |> map o map) subshape_invar_resultss; - val subshape_intross = (the_single o #intrs |> map o map) subshape_invar_resultss; - - val subshape_induct_raw = - let - val Ps = mk_Frees "P" (map (fn T => T --> HOLogic.boolT) CAs) frees_lthy |> fst; - fun mk_hyp_prem y y' P subshape_t = (subshape_t $ y' $ y, P $ y') - |> apply2 HOLogic.mk_Trueprop |> Logic.mk_implies |> Logic.all y'; - fun mk_hyp P y subshape_ts = @{map 3} (mk_hyp_prem y) ys' Ps subshape_ts @ - [P $ y |> HOLogic.mk_Trueprop] |> foldr1 Logic.mk_implies |> Logic.all y; - val hyps = @{map 3} mk_hyp Ps ys subshapessAs; - - fun mk_eq P y y' alpha_t rename_t = map HOLogic.dest_Trueprop prem_terms_ffs @ - [alpha_t $ (list_comb (rename_t, ffs) $ y) $ y', P $ y'] |> foldr1 HOLogic.mk_imp - |> list_all_free (ffs @ [y']); - val eqs = @{map 5} mk_eq Ps ys ys' alphasAs renamesAs; - val common_co_induct_inst = mk_common_co_induct_inst frees_lthy CAs lthy eqs ys; - val goal = mk_conjs eqs |> HOLogic.mk_Trueprop; - - fun mk_prem ctxt fs hs g_opts prem = thm_instantiate_terms lthy (NONE :: @{map 3} - (fn f => fn g_opt => fn h => HOLogic.mk_comp (mk_inv h, case g_opt of NONE => f - | SOME g => HOLogic.mk_comp (g, f)) |> SOME) fs g_opts hs) - (Object_Logic.rulify ctxt prem); - fun mk_prems i ctxt fs gs hs prems = map2 (mk_prem ctxt fs hs) - (apply2 (replicate rec_live |> map) (replicate fbound NONE, map SOME gs) - |-> transpose oo map_binding_matrix) prems |> dest_rec_lives - |> (fn xs => nth xs i); - val mk_prem_funs = map mk_prems (0 upto n-1); - - fun mk_rename_comp fs gs rename_comp = thm_instantiate_terms lthy (map SOME (fs @ gs)) - (rename_comp RS sym) |> unfold_thms lthy @{thms id_o}; - fun map_all_no_binding xs = all_bindings ~~ no_bindings ~~ xs |> dest_rec_lives - |> (map o map) (fn ((b1, b2), x) => if b1 orelse b2 then [] else [x]); - fun mk_rename_comps i fs gs = map2 (mk_rename_comp fs) (apply2 (replicate rec_live - |> map) (map (HOLogic.id_const o domain_type o fastype_of) gs, gs) - |-> transpose oo map_binding_matrix) (mk_rec_lives rename_comps) - |> map_all_no_binding |> (fn xs => nth xs i); - val mk_rename_comp_funs = map mk_rename_comps (0 upto n-1); - - fun mk_sett sett = Drule.rotate_prems ~1 (sett RS rel_funD); - val settsss = map (dest_rec_lives o map mk_sett o take rec_live o drop - (2*fbound+passive)) settss; - - fun mk_alpha_bij_eq_inv alpha_bij_eq_inv = alpha_bij_eq_inv OF (replicate fbound - @{thms bij_imp_bij_inv supp_inv_bound} |> flat); - val alpha_bij_eq_invs = map mk_alpha_bij_eq_inv alpha_bij_eq_invs; - in - mk_subshape_induct_raw_tac fbound rec_live rename_simps raw_injects rename_comps - alpha_bij_eq_invs alpha_transs alpha_syms mk_prem_funs mk_rename_comp_funs - common_co_induct_inst mr_rel_maps supp_comp_bounds alpha_elims subshape_elimss - settsss - |> prove lthy (Ps @ ys) hyps goal - end; - - val subshape_induct = - let - val Ps = mk_Frees "P" (map (fn T => T --> HOLogic.boolT) CAs) frees_lthy |> fst; - fun mk_hyp_prem y y' P subshape_t = (subshape_t $ y' $ y, P $ y') - |> apply2 HOLogic.mk_Trueprop |> Logic.mk_implies |> Logic.all y'; - fun mk_hyp P y subshape_ts = @{map 3} (mk_hyp_prem y) ys' Ps subshape_ts @ - [P $ y |> HOLogic.mk_Trueprop] |> foldr1 Logic.mk_implies |> Logic.all y; - val hyps = @{map 3} mk_hyp Ps ys subshapessAs; - - val goal = map2 (curry op $) Ps ys |> HOLogic.mk_Trueprop o mk_conjs; - val subshape_induct_raw_inst = thm_instantiate_terms lthy (map SOME Ps) - subshape_induct_raw; - val meta_spec_ys = map (fn y => thm_instantiate_terms lthy [NONE, SOME y] meta_spec) - ys; - val spec_ys = map (fn y => thm_instantiate_terms lthy [NONE, SOME y] spec) ys; - in - mk_subshape_induct_tac n subshape_induct_raw_inst meta_spec_ys spec_ys rename_ids - alpha_refls - |> prove lthy (Ps @ ys) hyps goal - end; - - val sumT = foldr1 BNF_Util.mk_sumT CAs - val subshape_rel = HOLogic.Collect_const (HOLogic.mk_prodT (sumT, sumT)) $ HOLogic.mk_case_prod (Term.abs ("t", sumT) (Term.abs ("t'", sumT) ( - BNF_FP_Util.mk_case_sumN (map2 (fn CA1 => fn subshapes => Term.abs ("x", CA1) ( - BNF_FP_Util.mk_case_sumN (map2 (fn CA2 => fn subshape => Term.abs ("y", CA2) ( - subshape $ Bound 1 $ Bound 0 - )) CAs subshapes) $ Bound 1 - )) CAs (transpose subshapessAs)) $ Bound 1 - ))); - val wf_subshape = - let - val wf = Const (@{const_name wf_on}, HOLogic.mk_setT sumT --> HOLogic.mk_setT (HOLogic.mk_prodT (sumT, sumT)) --> @{typ bool}) $ HOLogic.mk_UNIV sumT - val goal = HOLogic.mk_Trueprop (wf $ subshape_rel) - fun sumE_tac ctxt = Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => - rtac ctxt (infer_instantiate' ctxt [SOME (snd (snd (split_last params)))] ( - BNF_GFP_Util.mk_sumEN n - )) 1 - ) ctxt THEN_ALL_NEW hyp_subst_tac ctxt; - in Goal.prove_sorry lthy [] [] goal (fn {context=ctxt, ...} => EVERY1 [ - K (Local_Defs.unfold0_tac ctxt @{thms wf_def prod_in_Collect_iff prod.case}), + fun mk_thm flipped = Goal.prove_sorry lthy (names (a :: raw_zs)) [] (mk_goal flipped) (fn {context=ctxt, ...} => EVERY1 [ + let + val Ps = HOLogic.dest_Trueprop (mk_goal flipped) + |> HOLogic.dest_conj + |> map2 (fn z => Term.absfree (dest_Free a) o Term.absfree (dest_Free z) o snd o HOLogic.dest_imp) raw_zs; + val induct = infer_instantiate' ctxt ( + (if n > 1 then [] else [NONE, NONE]) @ map (SOME o Thm.cterm_of ctxt) Ps + ) (#induct is_frees); + in DETERM o (if n > 1 then rtac ctxt induct else rtac ctxt impI THEN' etac ctxt induct) end, + EVERY' (@{map 5} (fn alpha_elim => fn raw => fn mrbnf => fn mr_set_transfer_lives => fn num_bfree => EVERY' [ + REPEAT_DETERM o EVERY' [ REPEAT_DETERM o resolve_tac ctxt [allI, impI], - sumE_tac ctxt, - K (ALLGOALS (fn i => Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => - let - val P = Thm.term_of (snd (hd params)); - val subshape_induct' = infer_instantiate' lthy (map2 (fn x => fn inj => SOME (Thm.cterm_of lthy ( - Term.absfree (dest_Free x) (P $ inj) - ))) ys (mk_sum_ctors ys)) subshape_induct; - in rtac ctxt (BNF_FP_Rec_Sugar_Util.mk_conjunctN n i OF [subshape_induct']) 1 end - ) ctxt i)), - REPEAT_DETERM o EVERY' [ - etac ctxt allE, - etac ctxt impE, - K (prefer_tac 2), + etac ctxt alpha_elim, + dtac ctxt (iffD1 OF [#inject raw]), + hyp_subst_tac ctxt, + TRY o EVERY' [ + dtac ctxt @{thm DiffI[rotated]}, assume_tac ctxt, - rtac ctxt allI, - rtac ctxt impI, - sumE_tac ctxt, - K (Local_Defs.unfold0_tac ctxt @{thms sum.case}), - REPEAT_DETERM o Goal.assume_rule_tac ctxt + etac ctxt @{thm thin_rl}, + rotate_tac ~1, + dtac ctxt @{thm iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]}, + K (prefer_tac 2), + dtac ctxt @{thm iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]}, + K (prefer_tac 2), + if flipped then rotate_tac ~1 else K all_tac + ], + if flipped then K all_tac else EVERY' [ + dtac ctxt (Drule.rotate_prems ~1 (iffD2 OF [MRBNF_Def.mr_rel_flip_of_mrbnf mrbnf])), + REPEAT_DETERM o (resolve_tac ctxt @{thms bij_id supp_id_bound} ORELSE' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt @{thms inv_id}), + rotate_tac ~2 + ], + dtac ctxt @{thm iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]}, + TRY o rtac ctxt @{thm arg_cong2[of _ _ _ _ minus]}, + REPEAT_DETERM o EVERY' [ + TRY o rtac ctxt @{thm arg_cong[of _ _ "(`) _"]}, + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf)), + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt @{thms bij_id supp_id_bound bij_imp_bij_inv supp_inv_bound}, + assume_tac ctxt + ] + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_comp}), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_asm_tac ctxt [0] @{thms inv_o_simp1 inv_o_simp2}, + assume_tac ctxt + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_id}), + TRY o etac ctxt @{thm DiffE}, + eresolve_tac ctxt (flat (flat FVars_raw_introsss)), + TRY o EVERY' [ + REPEAT_DETERM o (rtac ctxt @{thm bij_imp_bij_inv} ORELSE' assume_tac ctxt), + if not flipped then K all_tac else EVERY' [ + rtac ctxt @{thm id_on_inv}, + assume_tac ctxt, + rtac ctxt @{thm arg_cong2[OF _ refl, of _ _ id_on, THEN iffD2]}, + rtac ctxt trans, + rtac ctxt @{thm arg_cong2[of _ _ _ _ minus]}, + REPEAT_DETERM o rtac ctxt @{thm arg_cong2[of _ _ _ _ "(\)"]}, + REPEAT_DETERM o EVERY' [ + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf)), + REPEAT_DETERM o (resolve_tac ctxt @{thms bij_id supp_id_bound} ORELSE' assume_tac ctxt) + ], + rtac ctxt @{thm image_set_diff[symmetric, OF bij_is_inj]}, + assume_tac ctxt, + rtac ctxt @{thm id_on_image_same} + ], + TRY o id_on_tac ctxt ] - ]) end; - - fun mk_set_subshape_images subshape_ts set_ts CA ctor_t x subshape_intros = - let - fun mk_set_subshape_image (n, i) CA set_t rename_t subshape_t = - let - val (t, _) = apfst hd (mk_Frees "t" [CA] lthy); - val goal = Logic.mk_implies ( - HOLogic.mk_Trueprop (HOLogic.mk_mem (t, - mk_image (Term.list_comb (rename_t, ffs)) $ (set_t $ x) - )), - HOLogic.mk_Trueprop (subshape_t $ t $ (ctor_t $ x)) - ); - in prove lthy (ffs @ [t, x]) (prem_terms_ffs) goal ( - mk_set_subshape_image_tac i n subshape_intros alpha_refls rename_ids rename_comps - ) end; - in @{map 5} (@{map 5} mk_set_subshape_image) (map (fn n => map (pair n) (1 upto n)) ks) (map2 replicate ks CAs) - (fst (fold_map (fn k => fn set_ts => (take k set_ts, drop k set_ts)) ks set_ts)) - (map2 replicate ks renamesAs) (map2 replicate ks subshape_ts) end; - val set_subshape_imagesss = @{map 6} mk_set_subshape_images subshapessAs rec_setss_As CAs ctorsAs xs - subshape_intross; - val set_subshapesss = map (map (map (fn thm => - Local_Defs.unfold0 lthy (@{thm image_id}::rename_id0s) (thm OF ( - maps (K @{thms bij_id supp_id_bound}) ffs - )) - ))) set_subshape_imagesss; - - fun mk_alpha_subshape supp_comp_bound alpha_t alpha_elim CA1 CA2 alpha_trans rename_comp - mk_subshape_intros mk_alpha_bij_eqs subshape_t subshape_elim setts = - let - val (ys, y3) = mk_Frees "y" (replicate 2 CA1) lthy - ||> fst o yield_singleton (mk_Frees "y") CA2; - val (y1, y2) = `hd ys ||> hd o tl; - val goal = [alpha_t $ y1 $ y2, subshape_t $ y3 $ y1, subshape_t $ y3 $ y2] - |> foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop; - in - mk_alpha_subshape_tac fbound supp_comp_bound alpha_trans rename_comp - mk_subshape_intros mk_alpha_bij_eqs setts alpha_elim subshape_elim raw_injects - |> prove_no_prems lthy (ys @ [y3]) goal - end; - fun mk_alpha_subshapes supp_comp_bound alpha_t alpha_elim CA subshape_intros = - let - fun mk_subshape_intro gs (k, i) f_opts subhsape_intro = thm_instantiate_terms lthy - (map2 (fn f_opt => fn g => SOME (case f_opt of NONE => g | SOME f => - HOLogic.mk_comp (f, g))) f_opts gs) subhsape_intro OF - (replicate (2*fbound+1) @{thm _} @ [mk_UnIN k i]); - fun mk_subshape_intros i fs gs = @{map 3} (mk_subshape_intro gs) k_ranges - (apply2 (replicate rec_live |> map) (replicate fbound NONE, map SOME fs) - |-> transpose oo map_binding_matrix) (mk_rec_lives subshape_intros) - |> dest_rec_lives |> (fn xs => nth xs i); - val mk_subshape_intro_funs = map mk_subshape_intros (0 upto n-1); - - fun mk_alpha_bij_eq alpha_bij_eq = Option.map (fn fs => Drule.rotate_prems ~1 - (iffD2 OF [thm_instantiate_terms lthy (map SOME fs) alpha_bij_eq])); - fun some_bindings xs = map2 (fn b => if b then K NONE else SOME) no_bindings xs; - fun mk_alpha_bij_eqs i fs = map2 mk_alpha_bij_eq (mk_rec_lives alpha_bij_eqs) (apply2 - (replicate rec_live |> map) (map (HOLogic.id_const o domain_type o fastype_of) fs, - fs) |-> transpose oo map_binding_matrix |> some_bindings) |> dest_rec_lives - |> (fn xs => nth xs i); - val mk_alpha_bij_eq_funs = map mk_alpha_bij_eqs (0 upto n-1); - - val alpha_transs = map (Drule.rotate_prems 1) alpha_transs; - in - @{map 8} (mk_alpha_subshape supp_comp_bound alpha_t alpha_elim CA) CAs alpha_transs - rename_comps mk_subshape_intro_funs mk_alpha_bij_eq_funs - end; - val alpha_subshapess = - let - fun mk_sett sett = Drule.rotate_prems ~1 (sett RS rel_funD); - val settsss = map (dest_rec_lives o map mk_sett o take rec_live o drop - (2*fbound+passive)) settss; - in - @{map 8} mk_alpha_subshapes supp_comp_bounds alphasAs alpha_elims CAs subshape_intross - subshapessAs subshape_elimss settsss - end; - - val (Ps, frees_lthy) = mk_Frees "P" (map (fn CB => CB --> paramT --> HOLogic.boolT) CBs) - frees_lthy; + ], + EVERY' (map2 (fn (i, max) => fn do_eq_on => EVERY' [ + REPEAT_DETERM o resolve_tac ctxt [allI, impI], + etac ctxt alpha_elim, + dtac ctxt (iffD1 OF [#inject raw]), + hyp_subst_tac ctxt, + forward_tac ctxt (map (fn thm => Drule.rotate_prems ~1 ( + Drule.rotate_prems ~1 (thm RS @{thm rel_funD}) RS (if flipped then @{thm rel_setD2} else @{thm rel_setD1}) + )) mr_set_transfer_lives), + assume_tac ctxt, + REPEAT_DETERM o (resolve_tac ctxt @{thms bij_id supp_id_bound} ORELSE' assume_tac ctxt), + etac ctxt bexE, + if flipped then K all_tac else TRY o EVERY' [ + dresolve_tac ctxt (map (fn thm => Drule.rotate_prems ~1 (iffD1 OF [thm])) alpha_bij_eq_invs), + REPEAT_DETERM o (resolve_tac ctxt @{thms bij_id supp_id_bound} ORELSE' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt @{thms inv_id}) + ], + etac ctxt allE, + etac ctxt impE, + assume_tac ctxt, + TRY o EVERY' [ + EqSubst.eqsubst_asm_tac ctxt [0] (flat FVars_permute_raws), + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt @{thms supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound}, + assume_tac ctxt + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_id}), + TRY o EVERY' [ + if not flipped then K all_tac else EVERY' [ + etac ctxt imageE, + hyp_subst_tac ctxt + ], + forward_tac ctxt @{thms arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]}, + if flipped then K all_tac else EVERY' [ + dtac ctxt (Drule.rotate_prems ~1 (iffD2 OF [MRBNF_Def.mr_rel_flip_of_mrbnf mrbnf])), + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt (infinite_UNIV :: @{thms bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound}), + assume_tac ctxt + ] + ], + REPEAT_DETERM o rtac ctxt @{thm arg_cong2[of _ _ _ _ "(\)"]}, + REPEAT_DETERM o EVERY' [ + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf)), + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt (infinite_UNIV :: @{thms bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound}), + assume_tac ctxt + ] + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_Un[symmetric]}), + rotate_tac ~1, + if not do_eq_on then K all_tac else EVERY' [ + dtac ctxt @{thm arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]}, + rtac ctxt trans, + rtac ctxt @{thm arg_cong2[OF refl, of _ _ "(`)"]}, + K (prefer_tac 2), + if flipped then EVERY' [ + etac ctxt @{thm eq_on_image[symmetric]}, + rtac ctxt refl + ] else EVERY' [ + rtac ctxt trans, + etac ctxt @{thm eq_on_inv2[THEN eq_on_image, symmetric, rotated -1]}, + REPEAT_DETERM o assume_tac ctxt, + rtac ctxt @{thm arg_cong2[OF refl, of _ _ "(`)"]}, + rtac ctxt sym, + REPEAT_DETERM o EVERY' [ + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf)), + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt (infinite_UNIV :: @{thms bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound}), + assume_tac ctxt + ] + ] + ], + rotate_tac ~1 + ], + if flipped then EVERY' [ + EqSubst.eqsubst_asm_tac ctxt [0] @{thms inj_image_mem_iff[OF bij_is_inj]}, + assume_tac ctxt, + rtac ctxt @{thm arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]}, + etac ctxt @{thm id_onD}, + rtac ctxt (BNF_Util.mk_UnIN (max + num_bfree) (i + num_bfree)) + ] else EVERY' [ + EqSubst.eqsubst_asm_tac ctxt [0] @{thms image_in_bij_eq}, + REPEAT_DETERM o (resolve_tac ctxt @{thms bij_comp bij_imp_bij_inv} ORELSE' assume_tac ctxt), + EqSubst.eqsubst_asm_tac ctxt [0] @{thms inv_inv_eq}, + REPEAT_DETERM o (resolve_tac ctxt @{thms bij_comp bij_imp_bij_inv} ORELSE' assume_tac ctxt), + etac ctxt imageE, + hyp_subst_tac ctxt, + K (Local_Defs.unfold0_tac ctxt @{thms inv_simp1 inv_simp2}), + rtac ctxt @{thm arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]}, + rtac ctxt @{thm id_on_inv[THEN id_onD, rotated]}, + assume_tac ctxt, + rtac ctxt (BNF_Util.mk_UnIN (max + num_bfree) (i + num_bfree)), + rtac ctxt @{thm iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]}, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms id_on_Un}), + REPEAT_DETERM o etac ctxt conjE, + etac ctxt @{thm id_on_image[symmetric]}, + rtac ctxt @{thm iffD2[OF image_in_bij_eq]}, + assume_tac ctxt + ], + rtac ctxt @{thm DiffI[rotated]}, + assume_tac ctxt, + rtac ctxt @{thm UN_I}, + assume_tac ctxt, + if flipped then assume_tac ctxt else EVERY' [ + SELECT_GOAL (Local_Defs.unfold0_tac ctxt (@{thm mem_Collect_eq} :: maps (map snd) FVars_rawss)), + assume_tac ctxt, + assume_tac ctxt + ] + ] + ], + eresolve_tac ctxt (flat (flat FVars_raw_introsss)), + REPEAT_DETERM o assume_tac ctxt + ]) rec_idxs do_eq_ons) + ]) (#elims alphas) raw_Ts mrbnfs mr_set_transfer_livess num_bfrees) + ]); + val thms1 = map (fn thm => thm RS mp RS spec RS mp) (split_conj (mk_thm false)); + val thms2 = map (fn thm => thm RS mp RS spec RS mp) (split_conj (mk_thm true)); + in (thms1, thms2) end + ) aa is_freess (transpose FVars_rawss) (transpose num_bfreess) rec_boundsss do_eq_onss)); + + val alpha_FVarss = @{map 6} (fn alpha => fn z => fn z' => @{map 3} (fn FVars => fn thm1 => fn thm2 => + Goal.prove_sorry lthy (names [z, z']) [] (Logic.mk_implies ( + HOLogic.mk_Trueprop (alpha $ z $ z'), mk_Trueprop_eq (fst FVars $ z, fst FVars $ z') + )) (fn {context=ctxt, ...} => EVERY1 [ + rtac ctxt @{thm subset_antisym}, + rtac ctxt @{thm subsetI}, + etac ctxt (Drule.rotate_prems ~1 thm1), + SELECT_GOAL (Local_Defs.unfold0_tac ctxt (snd FVars :: @{thms mem_Collect_eq})), + assume_tac ctxt, + rtac ctxt @{thm subsetI}, + etac ctxt (Drule.rotate_prems ~1 thm2), + SELECT_GOAL (Local_Defs.unfold0_tac ctxt (snd FVars :: @{thms mem_Collect_eq})), + assume_tac ctxt + ])) + ) (#preds alphas) raw_zs raw_zs' FVars_rawss (fst alpha_FVars_leqss) (snd alpha_FVars_leqss); + + val live = MRBNF_Def.live_of_mrbnf (hd mrbnfs); + + fun id_on_bound_free_tac ctxt mrbnf = EVERY' [ + rtac ctxt trans, + rtac ctxt @{thm arg_cong2[of _ _ _ _ minus, rotated]}, + REPEAT_DETERM o rtac ctxt @{thm arg_cong2[of _ _ _ _ "(\)"]}, + REPEAT_DETERM1 o EVERY' [ + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf)), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt) + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_Un[symmetric]}), + rtac ctxt trans, + rtac ctxt @{thm image_set_diff[OF bij_is_inj, symmetric]}, + assume_tac ctxt, + rtac ctxt @{thm id_on_image}, + id_on_tac ctxt + ]; + + fun id_on_rec_bound_tac ctxt mrbnf = EVERY' [ + rtac ctxt trans, + rtac ctxt @{thm id_on_image[symmetric]}, + K (prefer_tac 2), + rtac ctxt trans, + rtac ctxt @{thm image_set_diff[OF bij_is_inj]}, + K (prefer_tac 2), + rtac ctxt @{thm arg_cong2[of _ _ _ _ minus, rotated]}, + rtac ctxt @{thm trans[rotated]}, + K (Local_Defs.unfold0_tac ctxt @{thms image_Un}), + REPEAT_DETERM o rtac ctxt @{thm arg_cong2[of _ _ _ _ "(\)"]}, + REPEAT_DETERM o EVERY' [ + rtac ctxt sym, + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf)), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt) + ], + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms image_Un[symmetric]}), + etac ctxt @{thm eq_on_image} ORELSE' rtac ctxt refl, + rtac ctxt trans, + rtac ctxt @{thm image_UN}, + rtac ctxt @{thm rel_set_UN_D}, + eresolve_tac ctxt (map (fn thm => Drule.rotate_prems ~1 (rel_funD OF [thm]) OF [ + Drule.rotate_prems (~live - 1) (MRBNF_Def.mr_rel_mono_strong_of_mrbnf mrbnf) + ]) (MRBNF_Def.mr_set_transfer_of_mrbnf mrbnf)), + REPEAT_DETERM o EVERY' [ + rtac ctxt ballI, + rtac ctxt ballI, + rtac ctxt @{thm imp_refl} ORELSE' EVERY' [ + rtac ctxt impI, + rtac ctxt @{thm trans[rotated]}, + eresolve_tac ctxt (flat alpha_FVarss), + rtac ctxt sym, + resolve_tac ctxt (flat FVars_permute_raws), + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_id_bound bij_id}) + ] + ], + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt (infinite_UNIV :: @{thms supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound bij_comp supp_comp_bound})), + TRY o id_on_tac ctxt + ]; + + val alpha_syms = split_conj (Goal.prove_sorry lthy [] [] (HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj ( + @{map 3} (fn z => fn z' => fn alpha => fold_rev (mk_all o dest_Free) [z, z'] (HOLogic.mk_imp ( + alpha $ z' $ z, alpha $ z $ z' + ))) raw_zs raw_zs' (#preds alphas) + ))) (fn {context=ctxt, ...} => EVERY1 [ + if n > 1 then rtac ctxt (#induct alphas) + else REPEAT_DETERM o resolve_tac ctxt [allI, impI] THEN' etac ctxt (#induct alphas), + EVERY' (@{map 2} (fn alpha_elim => fn mrbnf => EVERY' [ + etac ctxt alpha_elim, + hyp_subst_tac ctxt, + REPEAT_DETERM o rtac ctxt exI, + REPEAT_DETERM o (rtac ctxt conjI THEN' rtac ctxt refl), + REPEAT_DETERM o rtac ctxt @{thm conjI[rotated]}, + rtac ctxt (Drule.rotate_prems ~1 (iffD1 OF [MRBNF_Def.mr_rel_flip_of_mrbnf mrbnf])), + K (Local_Defs.unfold0_tac ctxt @{thms inv_id conversep_eq}), + etac ctxt (Drule.rotate_prems (~nargs - 1) (MRBNF_Def.mr_rel_mono_strong0_of_mrbnf mrbnf)), + REPEAT_DETERM o (rtac ctxt ballI THEN' rtac ctxt refl), + REPEAT_DETERM o EVERY' [ + rtac ctxt ballI, + rtac ctxt ballI, + rtac ctxt @{thm imp_refl} + ], + REPEAT_DETERM o EVERY' [ + rtac ctxt ballI, + rtac ctxt @{thm inv_inv_eq[THEN fun_cong, symmetric]}, + assume_tac ctxt + ], + REPEAT_DETERM o EVERY' [ + rtac ctxt ballI, + rtac ctxt ballI, + rtac ctxt impI, + rtac ctxt @{thm conversepI}, + rtac ctxt disjI1, + assume_tac ctxt ORELSE' EVERY' [ + dresolve_tac ctxt (map (fn thm => Drule.rotate_prems ~1 (iffD1 OF [thm])) alpha_bij_eq_invs), + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_id_bound bij_id}), + K (Local_Defs.unfold0_tac ctxt @{thms inv_id}), + TRY o assume_tac ctxt, + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_id_bound bij_id}) + ] + ], + K (Local_Defs.unfold0_tac ctxt @{thms inv_inv_eq}), + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound}), + REPEAT_DETERM o EVERY' [ + TRY o EVERY' [ + rtac ctxt @{thm iffD2[OF arg_cong[of _ _ eq_on, THEN fun_cong, THEN fun_cong]]}, + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf)), + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_id_bound bij_id}), + rtac ctxt @{thm eq_on_inv2}, + REPEAT_DETERM o assume_tac ctxt + ], + rtac ctxt @{thm id_on_inv}, + assume_tac ctxt, + rtac ctxt @{thm id_on_antimono}, + assume_tac ctxt, + rtac ctxt equalityD1, + REPEAT_DETERM o rtac ctxt @{thm arg_cong2[of _ _ _ _ "(\)"]}, + REPEAT_DETERM o id_on_bound_free_tac ctxt mrbnf, + REPEAT_DETERM o (rtac ctxt sym THEN' id_on_rec_bound_tac ctxt mrbnf) + ], + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_inv_bound bij_imp_bij_inv} ORELSE' assume_tac ctxt) + ]) (#elims alphas) mrbnfs) + ])) RSS spec RSS spec RSS mp; - val TT_existential_induct = - let - val ball_rho_param = absfree (dest_Free rho) #> mk_Ball param; - fun mk_ball_Pw P w = P $ w $ rho |> ball_rho_param; - fun mk_prem_imp v' (w, P) set = (HOLogic.mk_mem (w, set $ v'), mk_ball_Pw P w) - |> HOLogic.mk_imp |> list_all_free [w]; - fun mk_prem v v' sets cctor P = apply2 HOLogic.mk_Trueprop (HOLogic.mk_mem (rho, - param), HOLogic.mk_conj (HOLogic.mk_eq (cctor $ v', cctor $ v), - HOLogic.mk_imp (map2 (mk_prem_imp v') (ws ~~ Ps |> mk_rec_lives) sets |> mk_conjs, - P $ (cctor $ v') $ rho)) - |> list_exists_free [v']) |> Logic.mk_implies |> fold_rev Logic.all [v, rho]; - - val prems = @{map 5} mk_prem vs vs' rec_setss_Bs cctorsAs Ps; - val goal = map2 (op $ o rpair rho oo curry op $) Ps ws |> mk_conjs |> ball_rho_param - |> HOLogic.mk_Trueprop; - - val Pws = map2 mk_ball_Pw Ps ws; - val conj_Pws = let val dummies = Term.dummy_pattern HOLogic.boolT |> replicate n; - in map2 (fn i => fn t => nth_map i (K t) dummies |> mk_conjs) (0 upto n-1) Pws end; - fun mk_arg_cong t w = thm_instantiate_dummy_terms lthy [NONE, NONE, - absfree (dest_Free w) t |> SOME] arg_cong RS iffD1; - val conj_arg_congs = map2 mk_arg_cong conj_Pws ws ~~ TT_Quotients; - val arg_congs = map2 mk_arg_cong Pws ws |> mk_rec_lives; - - val subshape_induct_inst = thm_instantiate_terms lthy ((map2 (curry op $) TT_abss ys - |> map2 mk_ball_Pw Ps |> map2 (absfree o dest_Free) ys) @ map2 (curry op $) - TT_reps ws |> map SOME) subshape_induct; - fun mk_exE mrbnf_map_AsBs assm rho x = exE OF [thm_instantiate_terms lthy (map SOME - [rho, comb_mrbnf_term (map HOLogic.id_const As) TT_abss mrbnf_map_AsBs $ x]) assm]; - val mk_exE_funs = map mk_exE mrbnf_maps_AsBs; - - val alpha_subshapess = map2 (fn thm => mk_rec_lives o map (op OF o rpair [thm])) - alpha_syms alpha_subshapess; - fun mk_alpha_trans mrbnf_map_AsAs alpha_trans alpha_sym alpha_intro_id x = - thm_instantiate_terms lthy [comb_mrbnf_term (map HOLogic.id_const As) - (map2 (curry HOLogic.mk_comp) TT_reps TT_abss) mrbnf_map_AsAs $ x |> SOME] - (Drule.rotate_prems 1 alpha_trans OF [@{thm _}, alpha_sym OF [alpha_intro_id]]); - val mk_alpha_trans_funs = @{map 4} mk_alpha_trans mrbnf_maps_AsAs alpha_transs - alpha_syms alpha_intros_id; - - fun mk_subshape_intro_id (k, i) subhsape_intro = (subhsape_intro OF replicate fbound - @{thms bij_id supp_id_bound} |> flat) |> Drule.rotate_prems ~1 OF [mk_UnIN k i]; - val subshape_intross_id = map (map2 mk_subshape_intro_id k_ranges o mk_rec_lives) - subshape_intross; - in - mk_TT_existential_induct_tac rename_ids Quotient_rep_abss subshape_induct_inst - conj_arg_congs arg_congs (mk_rec_lives TT_Quotients) (mk_rec_lives alpha_refls) - raw_exhausts TT_abs_ctors mk_exE_funs cctor_defs map_comps mr_rel_maps set_maps - Quotient_total_abs_eq_iffs mr_rel_refl_ids alpha_subshapess mk_alpha_trans_funs - subshape_intross_id - |> prove lthy (param :: Ps @ ws) prems goal - end; - - val TT_fresh_induct_param = + val alpha_transs = + let + val ((xx, yy), _) = lthy + |> mk_Frees "x" (map #T raw_Ts) + ||>> mk_Frees "y" (map #T raw_Ts); + + val thms = split_conj (Goal.prove_sorry lthy [] [] (HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj ( + @{map 4} (fn alpha => fn x => fn y => fn z => fold_rev (mk_all o dest_Free) [x, z] (HOLogic.mk_imp ( + mk_ex (dest_Free y) (HOLogic.mk_conj (alpha $ x $ y, alpha $ y $ z)), + alpha $ x $ z + ))) (#preds alphas) xx yy raw_zs + ))) (fn {context=ctxt, ...} => EVERY1 [ + if n > 1 then rtac ctxt (#induct alphas) + else REPEAT_DETERM o resolve_tac ctxt [allI, impI] THEN' etac ctxt (#induct alphas), + EVERY' (@{map 3} (fn alpha_elim => fn mrbnf => fn raw => EVERY' [ + etac ctxt exE, + etac ctxt conjE, + REPEAT_DETERM o etac ctxt alpha_elim, + hyp_subst_tac ctxt, + dtac ctxt (iffD1 OF [#inject raw]), + hyp_subst_tac ctxt, + forward_tac ctxt [Drule.rotate_prems ~1 ( + MRBNF_Def.mr_rel_OO_of_mrbnf mrbnf RS fun_cong RS fun_cong RS iffD2 + ) OF @{thms relcomppI}], + assume_tac ctxt, + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id eq_OO triv_forall_equality}), + Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => + let + fun is_funT T = case try Term.dest_funT T of NONE => false | _ => true + val funs = filter (is_funT o fastype_of o Thm.term_of o snd) params; + val (gs, hss) = funs + |> map (Thm.term_of o snd) + |> fst o fold_map (fn hs => chop (length hs + 1)) (hss @ hss) + |> map (fn x::xs => (x, xs)) + |> split_list; + val (gs, gs') = chop (length gs div 2) gs + val (hss, hss') = chop (length hss div 2) hss + fun comp_tac g g' = rtac ctxt (infer_instantiate' ctxt [NONE, SOME ( + Thm.cterm_of ctxt (HOLogic.mk_comp (g', g)) + )] exI); + in EVERY1 [ + EVERY' (map2 comp_tac gs gs'), + rtac ctxt exI, + EVERY' (map2 comp_tac (flat hss) (flat hss')), + rtac ctxt exI, + REPEAT_DETERM o (rtac ctxt conjI THEN' rtac ctxt refl), + REPEAT_DETERM o rtac ctxt @{thm conjI[rotated]}, + etac ctxt (Drule.rotate_prems (~live - 1) (MRBNF_Def.mr_rel_mono_strong_of_mrbnf mrbnf)), + REPEAT_DETERM o EVERY' [ + rtac ctxt ballI, + rtac ctxt ballI, + rtac ctxt impI, + assume_tac ctxt ORELSE' EVERY' [ + rtac ctxt disjI1, + etac ctxt @{thm relcomppE}, + EVERY' [ + rtac ctxt exI, + rtac ctxt conjI, + assume_tac ctxt, + assume_tac ctxt + ] ORELSE' EVERY' [ + REPEAT_DETERM o EqSubst.eqsubst_tac ctxt [0] @{thms id_hid_o_hid}, + K (Local_Defs.unfold0_tac ctxt @{thms hidden_id_def}), + EqSubst.eqsubst_tac ctxt [0] (permute_raw_comps RSS sym), + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_id_bound bij_id}), + EqSubst.eqsubst_tac ctxt [0] alpha_bij_eq_invs, + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_id_bound bij_id}), + rtac ctxt exI, + rtac ctxt @{thm conjI[rotated]}, + assume_tac ctxt, + EqSubst.eqsubst_tac ctxt [0] permute_raw_comps, + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_inv_bound bij_imp_bij_inv supp_id_bound bij_id}), + REPEAT_DETERM o (EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1} THEN' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt (@{thms inv_id id_o} @ permute_raw_ids)), + assume_tac ctxt + ] + ] + ], + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt (infinite_UNIV :: @{thms supp_id_bound bij_id bij_comp supp_comp_bound}), + assume_tac ctxt + ], + REPEAT_DETERM o EVERY' [ + TRY o EVERY' [ + rtac ctxt @{thm eq_on_comp2}, + assume_tac ctxt, + rtac ctxt @{thm iffD2[OF arg_cong3[OF _ refl refl, of _ _ eq_on]]}, + rtac ctxt sym, + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf)), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt) + ], + rtac ctxt @{thm id_on_comp}, + etac ctxt @{thm id_on_antimono}, + rtac ctxt equalityD1, + REPEAT_DETERM o rtac ctxt @{thm arg_cong2[of _ _ _ _ "(\)"]}, + REPEAT_DETERM o (rtac ctxt sym THEN' id_on_bound_free_tac ctxt mrbnf), + REPEAT_DETERM o (id_on_rec_bound_tac ctxt mrbnf THEN' TRY o assume_tac ctxt) + ], + REPEAT_DETERM o (resolve_tac ctxt (infinite_UNIV :: @{thms supp_comp_bound bij_comp}) ORELSE' assume_tac ctxt) + ] end + ) ctxt + ]) (#elims alphas) mrbnfs raw_Ts) + ])); + in map (fn thm => Local_Defs.unfold0 lthy @{thms HOL.imp_ex HOL.imp_conjL} thm RS spec RS spec RS spec RS mp RS mp) thms end; + + val A_prems = map (fn A => HOLogic.mk_Trueprop ( + mk_ordLess (mk_card_of A) (mk_card_of (HOLogic.mk_UNIV (HOLogic.dest_setT (fastype_of A)))) + )) As; + + val nbfrees = map (fn xs => length (fold (union (op=)) xs [])) bound_freesss; + val raw_refreshs = @{map 9} (fn alpha => fn alpha_intro => fn raw => fn mrbnf => fn deads => fn bound_setss => fn bfree_setss => fn rec_sets => fn x => + let + val goal = HOLogic.mk_Trueprop (mk_ex ("y", fastype_of x) (fold_rev (curry HOLogic.mk_conj) + (map2 (fn A => fn bsets => mk_int_empty (foldl1 mk_Un (map (fn s => s $ Bound 0) bsets), A)) As bound_setss) + (alpha $ (#ctor raw $ x) $ (#ctor raw $ Bound 0)) + )); + in Goal.prove_sorry lthy (names (As @ [x])) A_prems goal (fn {context=ctxt, prems} => + let + val thms = @{map 5} (fn A => fn bsets => fn bfree_sets => fn rec_boundss => fn FVarss => let - fun mk_prem1 varsOf = [HOLogic.mk_mem (rho, param), varsOf $ rho |> mk_bound] - |> foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop |> Logic.all rho; - - fun mk_prem_imp v (w, P) set = - [HOLogic.mk_mem (w, set $ v), HOLogic.mk_mem (rho, param), P $ w $ rho] - |> foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop |> fold_rev Logic.all [w, rho]; - fun mk_varsOf_imp v z set varsOf = - [HOLogic.mk_mem (z, set $ v), HOLogic.mk_mem (z, varsOf $ rho) |> HOLogic.mk_not] - |> foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop |> Logic.all z; - fun mk_prem2 v bsets sets cctor P = map2 (mk_prem_imp v) (ws ~~ Ps |> mk_rec_lives) - sets @ @{map 3} (mk_varsOf_imp v) zs bsets varsOfs @ map HOLogic.mk_Trueprop - [HOLogic.mk_mem (rho, param), P $ (cctor $ v) $ rho] - |> foldr1 Logic.mk_implies |> fold_rev Logic.all [v, rho]; - - val ball_rho_param = absfree (dest_Free rho) #> mk_Ball param; - val prems = map mk_prem1 varsOfs @ - @{map 5} mk_prem2 vs bound_setss_Bs rec_setss_Bs cctorsAs Ps; - val goal = map2 (op $ o rpair rho oo curry op $) Ps ws |> mk_conjs |> ball_rho_param - |> HOLogic.mk_Trueprop; - - val aavoid_freshss = (map o map) - (fn thm => Drule.rotate_prems ~1 (@{thm Int_emptyD} OF [thm])) aavoid_freshss; - fun mk_exI aavoid_t x rho = thm_instantiate_terms lthy - [NONE, list_comb (aavoid_t $ x, map (op $ o rpair rho) varsOfs) |> SOME] exI; - val mk_exI_funs = map mk_exI aavoidsAs; - in - mk_TT_fresh_induct_param_tac TT_existential_induct mk_exI_funs alpha_aavoids - aavoid_freshss - |> prove lthy (param :: Ps @ ws @ varsOfs) prems goal - end; - - val TT_fresh_induct_param_no_clash = + val bset = foldl1 mk_Un (map (fn bset => bset $ x) bsets); + val rec_sets' = @{map_filter 3} (fn rec_bounds => fn set => fn FVars => + if null rec_bounds then NONE else SOME (mk_UNION (set $ x) (fst FVars)) + ) rec_boundss rec_sets (replicate_rec FVarss); + val rec_set = mk_minus (foldl1 mk_Un (map (fn s => s $ x) bfree_sets @ rec_sets'), bset) + in infer_instantiate' ctxt (map (SOME o Thm.cterm_of ctxt) [ + bset, mk_Un (mk_Un (A, bset), rec_set), rec_set + ]) @{thm eextend_fresh} end + ) As bound_setss bfree_setss rec_boundsss (transpose FVars_rawss); + in EVERY1 [ + EVERY' (map (fn thm => EVERY' [ + rtac ctxt (exE OF [thm]), + REPEAT_DETERM o resolve_tac ctxt (infinite_UNIV :: + @{thms ordLeq_ordLess_trans[OF card_of_diff]} + @ (MRBNF_Def.set_bd_of_mrbnf mrbnf RSS @{thm ordLess_ordLeq_trans}) + @ [MRBNF_Def.Un_bound_of_mrbnf mrbnf, MRBNF_Def.UNION_bound_of_mrbnf mrbnf] + @ [MRBNF_Def.var_large_of_mrbnf mrbnf] @ prems + @ flat FVars_raw_bd_UNIVs + ), + rtac ctxt @{thm Un_upper2}, + rtac ctxt @{thm Diff_disjoint}, + REPEAT_DETERM o etac ctxt conjE, + K (Local_Defs.unfold0_tac ctxt @{thms Un_Diff}) + ]) thms), + Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => let - fun mk_prem1 varsOf = [HOLogic.mk_mem (rho, param), varsOf $ rho |> mk_bound] - |> foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop |> Logic.all rho; - - fun mk_varsOf_imp v z set varsOf = - [HOLogic.mk_mem (z, set $ v), HOLogic.mk_mem (z, varsOf $ rho) |> HOLogic.mk_not] - |> foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop |> Logic.all z; - fun mk_free_set_imp z v bset fset = [HOLogic.mk_mem (z, bset $ v), - HOLogic.mk_mem (z, fset $ v) |> HOLogic.mk_not] - |> foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop |> Logic.all z; - fun mk_non_clash_imp z v bset (w, FFVars_t) set = [HOLogic.mk_mem (z, bset $ v), - HOLogic.mk_mem (w, set $ v), HOLogic.mk_mem (z, FFVars_t $ w) |> HOLogic.mk_not] - |> foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop |> fold_rev Logic.all [z, w]; - fun mk_imps v sets z fset bset bvec FFVars_ts varsOf = [mk_varsOf_imp v z bset varsOf, - mk_free_set_imp z v bset fset] @ (map2 (mk_non_clash_imp z v bset) - (ws ~~ FFVars_ts |> mk_rec_lives) sets |> filter_like bvec not); - - fun mk_prem_imp v (w, P) set = - [HOLogic.mk_mem (w, set $ v), HOLogic.mk_mem (rho, param), P $ w $ rho] - |> foldr1 Logic.mk_implies o map HOLogic.mk_Trueprop |> fold_rev Logic.all [w, rho]; - fun mk_prem2 v noclash fsets bsets sets cctor P = map2 (mk_prem_imp v) - (ws ~~ Ps |> mk_rec_lives) sets @ flat (@{map 6} (mk_imps v sets) zs fsets bsets - binding_matrix FFVarsssAs varsOfs) @ map HOLogic.mk_Trueprop - [fst noclash $ v, HOLogic.mk_mem (rho, param), P $ (cctor $ v) $ rho] - |> foldr1 Logic.mk_implies |> fold_rev Logic.all [v, rho]; - - val ball_rho_param = absfree (dest_Free rho) #> mk_Ball param; - val prems = map mk_prem1 varsOfs @ - @{map 7} mk_prem2 vs nnoclashs free_setss_Bs bound_setss_Bs rec_setss_Bs cctorsAs Ps; - val goal = map2 (op $ o rpair rho oo curry op $) Ps ws |> mk_conjs |> ball_rho_param - |> HOLogic.mk_Trueprop; - - val Sprod_t = foldr1 mk_Sigma_prod (param :: map HOLogic.mk_UNIV CBs); - fun mk_union_t varsOf FFVars_ts = varsOf $ rho :: map2 (curry op $) FFVars_ts ws - |> foldl1 mk_union |> fold_case_prod (rho :: ws); - val union_ts = map2 mk_union_t varsOfs FFVarsssAs; - fun mk_imp_t w w' P = HOLogic.mk_imp (HOLogic.mk_eq (w, w'), P $ w' $ rho) - |> fold_case_prod (rho :: ws) |> absfree (dest_Free w'); - val imp_ts = @{map 3} mk_imp_t ws ws' Ps; - val meta_mp_inst = meta_mp OF [@{thm _}, thm_instantiate_terms lthy - (Sprod_t :: union_ts @ imp_ts @ ws |> map SOME) TT_fresh_induct_param]; - - val UNIV_Is = map (fn w => thm_instantiate_terms lthy [SOME w] UNIV_I) (rev ws); - in - mk_TT_fresh_induct_param_no_clash_tac fbound n nnoclashs meta_mp_inst UNIV_Is - (flat card_of_FFVars_boundss) Un_bounds (flat FFVars_cctorss) - |> prove lthy (param :: Ps @ ws @ varsOfs) prems goal - end; + val thmss = @{map 4} (fn (_, g) => fn bsets => fn rec_boundss => fn FVarss => + @{map_filter 3} (fn rec_bounds => fn rec_set => fn FVars => if null rec_bounds orelse rec_bounds = (0 upto length bsets - 1) then NONE else + SOME (infer_instantiate' ctxt (SOME g :: map (SOME o Thm.cterm_of ctxt) [ + mk_UNION (rec_set $ x) (fst FVars), foldl1 mk_Un (map (fn s => s $ x) bsets), + foldl1 mk_Un (map (fn i => nth bsets i $ x) rec_bounds) + ]) @{thm extend_id_on}) + ) rec_boundss rec_sets (replicate_rec FVarss) + ) params bound_setss rec_boundsss (transpose FVars_rawss); + in EVERY1 [ + EVERY' (map (fn thm => EVERY' [ + rtac ctxt (exE OF [thm]), + REPEAT_DETERM o assume_tac ctxt, + id_on_tac ctxt, + assume_tac ctxt, + etac ctxt @{thm Int_subset_empty2}, + rtac ctxt @{thm subset_trans[rotated]}, + rtac ctxt @{thm Un_upper1}, + rtac ctxt @{thm Un_upper2}, + rtac ctxt @{thm subsetI}, + rotate_tac ~1, + etac ctxt @{thm contrapos_pp}, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms Un_iff de_Morgan_disj}), + REPEAT_DETERM o etac ctxt conjE, + assume_tac ctxt, + REPEAT_DETERM o etac ctxt conjE + ]) (flat thmss)), + Subgoal.FOCUS_PARAMS (fn {context=ctxt, params=hs, ...} => + let + val gs = map (Thm.term_of o snd) params; + val hss = fst (fold_map (chop o length) hss (map (Thm.term_of o snd) hs)); + val nbounds = map length (hd raw_bound_setsss); + val rec_bound_fss = @{map 4} (fn nbound => fn f => fn rec_boundss => fst o fold_map (fn rec_bounds => fn hs => + if length rec_bounds = 0 then (NONE, hs) + else if length rec_bounds = nbound then (SOME f, hs) else (SOME (hd hs), tl hs) + ) rec_boundss) nbounds gs rec_boundsss hss; + + val rec_ts = map2 (fn (permute, _) => fn rec_bound_fs => + if forall (fn NONE => true | _ => false) rec_bound_fs then + HOLogic.id_const (Term.body_type (fastype_of permute)) + else Term.list_comb (permute, map2 (fn g => + fn NONE => HOLogic.id_const (fst (Term.dest_funT (fastype_of g))) + | SOME f => f + ) gs rec_bound_fs) + ) (replicate_rec permute_raws) (transpose rec_bound_fss); + val bfree_fs = flat (map2 replicate nbfrees gs); + + val map_t = MRBNF_Def.mk_map_comb_of_mrbnf deads + (map HOLogic.id_const plives @ rec_ts) + (map HOLogic.id_const pbounds @ flat (map2 (fn bounds => replicate (length bounds)) (hd raw_bound_setsss) gs)) + (map (HOLogic.id_const o fst o Term.dest_funT o fastype_of) fs @ map HOLogic.id_const pfrees @ bfree_fs) + mrbnf $ x; + in EVERY1 [ + rtac ctxt (infer_instantiate' ctxt [NONE, SOME (Thm.cterm_of ctxt map_t)] exI), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_id_bound bij_id}) + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_Un[symmetric]}), + REPEAT_DETERM o EVERY' [ + rtac ctxt conjI, + etac ctxt @{thm Int_subset_empty2}, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms Un_assoc}), + rtac ctxt @{thm Un_upper1} + ], + rtac ctxt (Drule.rotate_prems ~1 alpha_intro), + rtac ctxt (Drule.rotate_prems ~1 (iffD2 OF [nth (MRBNF_Def.mr_rel_map_of_mrbnf mrbnf) 2])), + K (Local_Defs.unfold0_tac ctxt @{thms inv_id id_o Grp_UNIV_id conversep_eq OO_eq}), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1}, + assume_tac ctxt + ], + K (Local_Defs.unfold0_tac ctxt [ + @{thm relcompp_conversep_Grp}, MRBNF_Def.mr_rel_id_of_mrbnf mrbnf RS sym + ]), + rtac ctxt (MRBNF_Def.rel_refl_strong_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt (refl :: alpha_refls), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt), + TRY o id_on_tac ctxt, + REPEAT_DETERM o assume_tac ctxt + ] end + ) ctxt + ] end + ) ctxt + ] end + ) end + ) (#preds alphas) (#intrs alphas) raw_Ts mrbnfs deadss raw_bound_setsss raw_bfree_setsss raw_rec_setss raw_xs; + + val quot_argTss = map2 (fn raw => fn quot => [ + #T raw --> #T raw --> @{typ bool}, + #T raw --> #abs_type (fst quot), + #abs_type (fst quot) --> #T raw + ]) raw_Ts quots; + val Quotient3s = @{map 6} (fn alpha => fn TT_abs => fn TT_rep => fn raw => fn quot => fn arg_Ts => + Goal.prove_sorry lthy [] [] (HOLogic.mk_Trueprop ( + Const (@{const_name Quotient3}, arg_Ts ---> @{typ bool}) $ alpha $ TT_abs $ TT_rep + )) (fn {context=ctxt, ...} => EVERY1 [ + rtac ctxt @{thm quot_type.Quotient}, + rtac ctxt @{thm type_definition_quot_type}, + rtac ctxt (#type_definition (snd quot)), + rtac ctxt @{thm equivpI}, + rtac ctxt @{thm reflpI}, + resolve_tac ctxt alpha_refls, + rtac ctxt @{thm sympI}, + eresolve_tac ctxt alpha_syms, + rtac ctxt @{thm transpI}, + eresolve_tac ctxt alpha_transs, + assume_tac ctxt + ]) + ) (#preds alphas) TT_abss TT_reps raw_Ts quots quot_argTss; + + val TT_Quotients = @{map 8} (fn z => fn alpha => fn TT_abs => fn TT_rep => fn raw => fn quot => fn Quotient3 => fn arg_Ts => + Goal.prove_sorry lthy [] [] (HOLogic.mk_Trueprop (Const (@{const_name Quotient}, + arg_Ts ---> (#T raw --> #abs_type (fst quot) --> @{typ bool}) --> @{typ bool} + ) $ alpha $ TT_abs $ TT_rep $ (Term.absfree (dest_Free z) ( + HOLogic.eq_const (#abs_type (fst quot)) $ (TT_abs $ z) + )))) (fn {context=ctxt, ...} => EVERY1 [ + rtac ctxt @{thm QuotientI}, + rtac ctxt (@{thm Quotient3_abs_rep} OF [Quotient3]), + resolve_tac ctxt alpha_refls, + rtac ctxt (@{thm Quotient3_rel[symmetric]} OF [Quotient3]), + REPEAT_DETERM o rtac ctxt ext, + rtac ctxt iffI, + rtac ctxt conjI, + resolve_tac ctxt alpha_refls, + assume_tac ctxt, + etac ctxt conjE, + assume_tac ctxt + ]) + ) raw_zs (#preds alphas) TT_abss TT_reps raw_Ts quots Quotient3s quot_argTss; + + val TT_total_abs_eq_iffs = map2 (fn thm => fn alpha_refl => + thm RS @{thm Quotient_total_abs_eq_iff} OF [@{thm reflpI} OF [alpha_refl]] + ) TT_Quotients alpha_refls; + val TT_rep_abss = map2 (fn thm => fn alpha_refl => + thm RS @{thm Quotient_rep_abs} OF [alpha_refl] + ) TT_Quotients alpha_refls + val TT_abs_reps = TT_Quotients RSS @{thm Quotient_abs_rep}; + val TT_rep_abs_syms = map2 (curry (op RS)) TT_rep_abss alpha_syms; + + val map_id_abss = map2 (fn deads => MRBNF_Def.mk_map_comb_of_mrbnf deads + (map HOLogic.id_const plives @ replicate_rec TT_abss) + (map HOLogic.id_const (pbounds @ bounds)) + (map HOLogic.id_const (frees @ pfrees @ bfrees)) + ) deadss mrbnfs; + val TT_abs_ctors = @{map 8} (fn raw => fn x => fn TT_abs => fn ctor => fn mrbnf => fn deads => fn TT_total_abs_eq_iff => fn map_abs => + let val goal = mk_Trueprop_eq (TT_abs $ (#ctor raw $ x), fst ctor $ (map_abs $ x)); + in Goal.prove_sorry lthy (names [x]) [] goal (fn {context=ctxt, ...} => EVERY1 [ + K (Local_Defs.unfold0_tac ctxt [snd ctor]), + rtac ctxt (iffD2 OF [TT_total_abs_eq_iff]), + EqSubst.eqsubst_tac ctxt [0] [MRBNF_Def.map_comp_of_mrbnf mrbnf], + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id}, + K (Local_Defs.unfold0_tac ctxt @{thms id_o}), + resolve_tac ctxt (#intrs alphas), + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id id_on_id eq_on_refl}, + K (Local_Defs.unfold0_tac ctxt ((MRBNF_Def.mr_rel_id_of_mrbnf mrbnf RS sym) :: permute_raw_ids)), + rtac ctxt (iffD2 OF [nth (MRBNF_Def.rel_map_of_mrbnf mrbnf) 1]), + K (Local_Defs.unfold0_tac ctxt @{thms comp_def id_apply}), + rtac ctxt (MRBNF_Def.rel_refl_strong_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt (refl :: TT_rep_abs_syms) + ]) end + ) raw_Ts raw_xs TT_abss ctors mrbnfs deadss TT_total_abs_eq_iffs map_id_abss; - val TT_fresh_induct = - let - val Qs = mk_Frees "Q" (map (fn CB => CB --> HOLogic.boolT) CBs) frees_lthy |> fst; - val ts = HOLogic.mk_UNIV paramT :: map (dest_Free rho |> absfree) fsets @ - map2 (fn w => fold_rev (absfree o dest_Free) [w, rho] o op $ o rpair w) ws Qs - |> map SOME; - in - thm_instantiate_fixed_terms lthy ts (fsets @ Qs) TT_fresh_induct_param_no_clash - |> full_simplify lthy - end; - val TT_plain_induct = (TT_fresh_induct OF - (replicate fbound @{thm supp_id_bound[unfolded supp_id]})) |> full_simplify lthy; - in - (TT_existential_induct, TT_fresh_induct_param, SOME TT_fresh_induct_param_no_clash, - SOME subshapessAs, SOME subshape_induct, SOME wf_subshape, SOME subshape_rel, - SOME set_subshape_imagesss, SOME set_subshapesss, - TT_fresh_induct, TT_plain_induct, lthy) - end; - - fun mk_rrename_ids rrename_t w rrename_def rename_id Quotient_abs_rep = - let - val goal = mk_Trueprop_eq (list_comb (rrename_t, fids) $ w, w); - in - mk_rrename_id_tac rrename_def rename_id Quotient_abs_rep - |> prove_no_prems lthy ws goal - end; - val rrename_ids = @{map 5} mk_rrename_ids rrenamesAs ws rrename_defs rename_ids - Quotient_abs_reps; - val rrename_id0s = map (fn thm => @{thm meta_eq_to_obj_eq} OF [ - Local_Defs.unfold0 lthy @{thms id_def[symmetric]} (Local_Defs.abs_def_rule lthy thm) - ]) rrename_ids; - - fun mk_rrename_comps rrename_t w rrename_def Quotient_total_abs_eq_iff alpha_refl alpha_sym alpha_trans - alpha_bij_eq alpha_quotient_sym rename_comp = + val permute_simps = @{map 7} (fn permute => fn ctor => fn x => fn mrbnf => fn deads => fn TT_total_abs_eq_iff => fn alpha_bij_eq_inv => let + val map_t = MRBNF_Def.mk_map_comb_of_mrbnf deads + (map HOLogic.id_const plives @ map (fn (p, _) => Term.list_comb (p, fs)) (replicate_rec permutes)) + (map HOLogic.id_const pbounds @ flat (map2 (fn bsets => replicate (length bsets)) (hd raw_bound_setsss) fs)) + (fs @ map HOLogic.id_const pfrees @ bfree_fs) mrbnf $ x val goal = mk_Trueprop_eq ( - list_comb (rrename_t, fgs) $ (list_comb (rrename_t, ffs) $ w), - list_comb (rrename_t, map2 (curry HOLogic.mk_comp) fgs ffs) $ w + Term.list_comb (fst permute, fs) $ (fst ctor $ x), + fst ctor $ map_t ); - in - prove lthy (ffs @ fgs @ [w]) prem_terms_ffs_fgs goal ( - mk_rrename_comp_tac rrename_def Quotient_total_abs_eq_iff alpha_refl alpha_sym alpha_trans - alpha_bij_eq alpha_quotient_sym rename_comp - ) - end; - val rrename_comps = @{map 10} mk_rrename_comps rrenamesAs ws rrename_defs Quotient_total_abs_eq_iffs - alpha_refls alpha_syms alpha_transs alpha_bij_eqs alpha_quotient_syms rename_comps; - val rrename_comp0s = mk_rename_comp0s lthy rrename_comps rrenamesAs; - - fun mk_rrename_cong_id w rrename_t FFVars_ts FFVars_defs rrename_def Quotient_abs_rep - Quotient_total_abs_eq_iff alpha_bij rename_id alpha_refl = - let - fun mk_eq f z FFVars_t = Logic.mk_implies (HOLogic.mk_mem (z, FFVars_t $ w) - |> HOLogic.mk_Trueprop, mk_Trueprop_eq (f $ z, z)) |> Logic.all z; - val goal = @{map 3} mk_eq ffs zs FFVars_ts @ [mk_Trueprop_eq - (list_comb (rrename_t, ffs) $ w, w)] |> foldr1 Logic.mk_implies; - val alpha_bij = unfold_thms lthy [rename_id, id_apply] (alpha_bij OF - replicate (2*fbound) @{thm _} @ (replicate fbound @{thms bij_id supp_id_bound} |> flat)); - in - mk_rrename_cong_id_tac FFVars_defs rrename_def Quotient_abs_rep Quotient_total_abs_eq_iff - alpha_bij alpha_refl - |> prove lthy (ffs @ ws) prem_terms_ffs goal - end; - val rrename_cong_ids = @{map 10} mk_rrename_cong_id ws rrenamesAs (transpose FFVarsssAs) - (transpose FFVars_defss) rrename_defs Quotient_abs_reps Quotient_total_abs_eq_iffs alpha_bijs - rename_ids alpha_refls; - - val rrename_bijs = @{map 3} (mk_rename_bij lthy) rrenamesAs rrename_comp0s rrename_id0s; - val rrename_inv_simps = @{map 3} (mk_rename_inv_simp lthy) rrenamesAs rrename_comp0s rrename_id0s; + in Goal.prove_sorry lthy (names (fs @ [x])) f_prems goal (fn {context=ctxt, prems} => EVERY1 [ + K (Local_Defs.unfold_tac ctxt (snd ctor :: map snd permutes)), + EqSubst.eqsubst_tac ctxt [0] [MRBNF_Def.map_comp_of_mrbnf mrbnf], + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ prems), + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id}), + K (Local_Defs.unfold0_tac ctxt @{thms comp_def}), + rtac ctxt (iffD2 OF [TT_total_abs_eq_iff]), + rtac ctxt (alpha_bij_eq_inv OF prems RS iffD2), + EqSubst.eqsubst_tac ctxt [0] (map snd permute_raws), + REPEAT_DETERM o resolve_tac ctxt (@{thms bij_imp_bij_inv supp_inv_bound} @ prems), + EqSubst.eqsubst_tac ctxt [0] [MRBNF_Def.map_comp_of_mrbnf mrbnf], + REPEAT_DETERM o resolve_tac ctxt (@{thms bij_imp_bij_inv supp_inv_bound supp_id_bound bij_id} @ prems), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1}, + resolve_tac ctxt prems + ], + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id}), + resolve_tac ctxt alpha_transs, + resolve_tac ctxt TT_rep_abss, + K (Local_Defs.unfold0_tac ctxt @{thms comp_def}), + resolve_tac ctxt (#intrs alphas), + REPEAT_DETERM o resolve_tac ctxt @{thms bij_id supp_id_bound id_on_id eq_on_refl}, + K (Local_Defs.unfold0_tac ctxt ((MRBNF_Def.mr_rel_id_of_mrbnf mrbnf RS sym) :: + MRBNF_Def.rel_map_of_mrbnf mrbnf @ permute_raw_ids) + ), + rtac ctxt (MRBNF_Def.rel_refl_strong_of_mrbnf mrbnf), + REPEAT_DETERM o rtac ctxt refl, + REPEAT_DETERM o EVERY' [ + resolve_tac ctxt (alpha_bij_eq_invs RSS iffD1), + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ prems), + resolve_tac ctxt TT_rep_abs_syms + ] + ]) end + ) permutes ctors xs mrbnfs deadss TT_total_abs_eq_iffs alpha_bij_eq_invs; + + val permute_id0s = map2 (fn permute => fn quot => + Goal.prove_sorry lthy [] [] (mk_Trueprop_eq ( + Term.list_comb (fst permute, map (HOLogic.id_const o fst o Term.dest_funT o fastype_of) fs), + HOLogic.id_const (#abs_type (fst quot)) + )) (fn {context=ctxt, ...} => EVERY [ + Local_Defs.unfold_tac ctxt (snd permute :: permute_raw_ids @ TT_abs_reps), + Local_Defs.unfold_tac ctxt @{thms id_def[symmetric]}, + HEADGOAL (rtac ctxt refl) + ]) + ) permutes quots; + + val permute_ids = map (fn thm => trans OF [fun_cong OF [thm], @{thm id_apply}]) permute_id0s; + + val permute_comp0s = @{map 4} (fn permute => fn permute_raw_comp => fn TT_total_abs_eq_iff => fn alpha_bij_eq => + Goal.prove_sorry lthy (names (fs @ gs)) (f_prems @ g_prems) (mk_Trueprop_eq ( + HOLogic.mk_comp (Term.list_comb (fst permute, gs), Term.list_comb (fst permute, fs)), + Term.list_comb (fst permute, map2 (curry HOLogic.mk_comp) gs fs) + )) (fn {context=ctxt, prems} => EVERY1 [ + rtac ctxt ext, + rtac ctxt @{thm trans[OF comp_apply]}, + K (Local_Defs.unfold_tac ctxt [snd permute]), + EqSubst.eqsubst_tac ctxt [0] [permute_raw_comp RS sym], + REPEAT_DETERM o resolve_tac ctxt prems, + rtac ctxt (iffD2 OF [TT_total_abs_eq_iff]), + rtac ctxt (iffD2 OF [alpha_bij_eq]), + REPEAT_DETERM o resolve_tac ctxt prems, + resolve_tac ctxt TT_rep_abss + ]) + ) permutes permute_raw_comps TT_total_abs_eq_iffs alpha_bij_eqs; + + val permute_comps = map (fn thm => @{thm trans[OF comp_apply[symmetric]]} OF [fun_cong OF [thm]]) permute_comp0s; + + val permute_bijs = map (fn permute => Goal.prove_sorry lthy (names fs) f_prems (HOLogic.mk_Trueprop ( + mk_bij (Term.list_comb (fst permute, fs)) + )) (fn {context=ctxt, prems} => EVERY1 [ + rtac ctxt @{thm iffD2[OF bij_iff]}, + rtac ctxt exI, + rtac ctxt conjI, + rtac ctxt trans, + resolve_tac ctxt permute_comp0s, + K (prefer_tac (4 * nvars + 1)), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1}, + resolve_tac ctxt prems + ], + resolve_tac ctxt permute_id0s, + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_inv_bound bij_imp_bij_inv} @ prems), + rtac ctxt trans, + resolve_tac ctxt permute_comp0s, + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_inv_bound bij_imp_bij_inv} @ prems), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp2}, + resolve_tac ctxt prems + ], + resolve_tac ctxt permute_id0s + ])) permutes; + + val permute_inv_simps = map (fn permute => Goal.prove_sorry lthy (names fs) f_prems (mk_Trueprop_eq ( + mk_inv (Term.list_comb (fst permute, fs)), + Term.list_comb (fst permute, map mk_inv fs) + )) (fn {context=ctxt, prems} => REPEAT_DETERM (EVERY1 [ + TRY o rtac ctxt @{thm inv_unique_comp}, + rtac ctxt trans, + resolve_tac ctxt permute_comp0s, + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_inv_bound bij_imp_bij_inv} @ prems), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1 inv_o_simp2}, + resolve_tac ctxt prems + ], + resolve_tac ctxt permute_id0s + ]))) permutes; + + fun mk_bd_thms f_bd raw_thms = map2 (fn z => map_index (fn (i, FVars) => Goal.prove_sorry lthy (names [z]) [] (HOLogic.mk_Trueprop ( + mk_ordLess (mk_card_of (fst FVars $ z)) (f_bd i) + )) (fn {context=ctxt, ...} => + Local_Defs.unfold0_tac ctxt [snd FVars] THEN HEADGOAL (resolve_tac ctxt raw_thms) + ))) zs FVarsss; + + val FVars_bds = mk_bd_thms (K (MRBNF_Def.bd_of_mrbnf (hd mrbnfs))) (flat FVars_raw_bds); + val FVars_bd_UNIVs = mk_bd_thms (fn i => + mk_card_of (HOLogic.mk_UNIV (fst (Term.dest_funT (fastype_of (nth fs i))))) + ) (flat FVars_raw_bd_UNIVs); + + val FVars_permutess = @{map 5} (fn z => fn permute => @{map 4} (fn f => fn FVars => fn alpha_FVars => fn FVars_permute_raw => + Goal.prove_sorry lthy (names (fs @ [z])) f_prems (mk_Trueprop_eq ( + fst FVars $ (Term.list_comb (fst permute, fs) $ z), + mk_image f $ (fst FVars $ z) + )) (fn {context=ctxt, prems} => EVERY1 [ + K (Local_Defs.unfold_tac ctxt [snd permute, snd FVars]), + rtac ctxt trans, + rtac ctxt alpha_FVars, + resolve_tac ctxt TT_rep_abss, + rtac ctxt (FVars_permute_raw OF prems) + ]) + ) fs) zs permutes FVarsss alpha_FVarss FVars_permute_raws; + + val setss = mk_setss (map (#abs_type o fst) quots); + val (fsetss, bound_setsss, bfree_setsss, rec_setss) = split_setss setss; + + val FVars_ctorss = @{map 6} (fn x => fn ctor => fn mrbnf => @{map 3} (fn alpha_FVars => fn FVars_ctor => fn goal => + Goal.prove_sorry lthy (names [x]) [] goal (fn {context=ctxt, ...} => EVERY1 [ + K (Local_Defs.unfold_tac ctxt (snd ctor :: maps (map snd) FVarsss)), + rtac ctxt trans, + rtac ctxt alpha_FVars, + resolve_tac ctxt TT_rep_abss, + rtac ctxt trans, + rtac ctxt FVars_ctor, + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id} + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_id image_comp[unfolded comp_def]}), + rtac ctxt refl + ]) + )) xs ctors mrbnfs alpha_FVarss FVars_raw_ctorss + (mk_FVars_ctor_goalss rec_setss (map fst ctors) xs fsetss bound_setsss bfree_setsss FVarsss) + + val FVars_introsss = @{map 3} (fn mrbnf => map2 (map2 (fn intro => fn goal => + Goal.prove_sorry lthy (map fst (Term.add_frees goal [])) [] goal (fn {context=ctxt, ...} => EVERY1 [ + K (Local_Defs.unfold0_tac ctxt (map snd (ctors @ flat FVarsss) + @ flat (map2 (fn TT_rep_abs => map (fn thm => thm OF [TT_rep_abs])) TT_rep_abss alpha_FVarss) + )), + dtac ctxt @{thm iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]}, + K (prefer_tac 2), + eresolve_tac ctxt [Drule.rotate_prems 1 intro, intro], + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id} + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_id}), + TRY o assume_tac ctxt, + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id} + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_id}), + TRY o etac ctxt imageI, + rtac ctxt refl + ]) + ))) mrbnfs FVars_raw_introsss (mk_FVars_intro_goalsss rec_setss (map fst ctors) xs zs fsetss bound_setsss bfree_setsss FVarsss); + + val (ys, _) = lthy + |> mk_Frees "y" (map fastype_of xs); + + val TT_inject0s = @{map 9} (fn x => fn y => fn bsetss => fn bfsetss => fn rec_sets => fn deads => fn mrbnf => fn ctor => fn raw => + let + val id_on_prems = @{map 6} (fn f => fn bsets => fn bfsets => fn bfree_boundss => fn rec_boundss => fn FVars_raws => mk_id_on (foldl1 mk_Un ( + map2 (fn bfset => fn bfree_bounds => + mk_minus (bfset $ x, foldl1 mk_Un (map (fn i => nth bsets i $ x) bfree_bounds)) + ) bfsets bfree_boundss + @ @{map_filter 3} (fn rec_set => fn rec_bounds => fn FVars => + if length rec_bounds = length bsets then + SOME (mk_minus (mk_UNION (rec_set $ x) (fst FVars), foldl1 mk_Un (map (fn s => s $ x) bsets))) + else NONE + ) rec_sets rec_boundss (replicate_rec FVars_raws) + )) f) fs bsetss bfsetss bfree_boundsss rec_boundsss (transpose FVarsss); + + val h_prems = flat (flat (@{map 5} (fn f => fn bsets => fn rec_boundss => fn FVars => fn hs => + fst (@{fold_map 3} (fn rec_bounds => fn rec_set => fn FVars_raw => fn hs => + let val n = length rec_bounds + in if n > 0 andalso n < length bsets then + let + val h = hd hs; + val bset = foldl1 mk_Un (map (fn i => nth bsets i $ x) rec_bounds); + in ([ + mk_bij h, + mk_supp_bound h, + mk_id_on (mk_minus (mk_UNION (rec_set $ x) (fst FVars_raw), bset)) h, + mk_eq_on bset h f + ], tl hs) end + else ([], hs) end + ) rec_boundss rec_sets (replicate_rec FVars) hs)) fs bsetss rec_boundsss (transpose FVarsss) hss)); + + (* TODO: remove code duplication *) + val nbounds = map length (hd raw_bound_setsss); + val rec_bound_fss = @{map 4} (fn nbound => fn f => fn rec_boundss => fst o fold_map (fn rec_bounds => fn hs => + if length rec_bounds = 0 then (NONE, hs) + else if length rec_bounds = nbound then (SOME f, hs) else (SOME (hd hs), tl hs) + ) rec_boundss) nbounds fs rec_boundsss hss; + + val rec_ts = map2 (fn (permute, _) => fn rec_bound_fs => + if forall (fn NONE => true | _ => false) rec_bound_fs then + HOLogic.id_const (Term.body_type (fastype_of permute)) + else Term.list_comb (permute, map2 (fn g => + fn NONE => HOLogic.id_const (fst (Term.dest_funT (fastype_of g))) + | SOME f => f + ) fs rec_bound_fs) + ) (replicate_rec permutes) (transpose rec_bound_fss); + val bfree_fs = flat (map2 replicate nbfrees fs); + + val map_t = MRBNF_Def.mk_map_comb_of_mrbnf deads + (map HOLogic.id_const plives @ rec_ts) + (map HOLogic.id_const pbounds @ flat (map2 (fn bounds => replicate (length bounds)) (hd raw_bound_setsss) fs)) + (map (HOLogic.id_const o fst o Term.dest_funT o fastype_of) fs @ map HOLogic.id_const pfrees @ bfree_fs) + mrbnf $ x; + + val rhs = fold_rev (mk_ex o dest_Free) (fs @ flat hss) (fold_rev (curry HOLogic.mk_conj) + (map HOLogic.dest_Trueprop f_prems @ id_on_prems @ h_prems) + (HOLogic.mk_eq (map_t, y)) + ); + val goal = mk_Trueprop_eq (HOLogic.mk_eq (fst ctor $ x, fst ctor $ y), rhs); + in Goal.prove_sorry lthy (names [x, y]) [] goal (fn {context=ctxt, ...} => EVERY1 [ + K (Local_Defs.unfold_tac ctxt (snd ctor :: map snd permutes)), + rtac ctxt trans, + resolve_tac ctxt TT_total_abs_eq_iffs, + rtac ctxt iffI, + eresolve_tac ctxt (#elims alphas), + REPEAT_DETERM o dtac ctxt (#inject raw RS iffD1), + hyp_subst_tac ctxt, + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_asm_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id} + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_id}), + dtac ctxt (Drule.rotate_prems ~1 (iffD1 OF [hd (MRBNF_Def.mr_rel_map_of_mrbnf mrbnf)])), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id Grp_UNIV_id eq_OO}), + dtac ctxt (Drule.rotate_prems ~1 (iffD1 OF [nth (MRBNF_Def.mr_rel_map_of_mrbnf mrbnf) 2])), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt @{thms inv_id id_o o_id Grp_UNIV_id conversep_eq eq_OO relcompp_conversep_Grp}), + K (Local_Defs.unfold0_tac ctxt (@{thms Grp_OO image_comp[unfolded comp_def]} @ maps (map (Thm.symmetric o snd)) FVarsss)), + REPEAT_DETERM o rtac ctxt exI, + REPEAT_DETERM o rtac ctxt @{thm conjI[rotated]}, + rtac ctxt (MRBNF_Def.mr_rel_eq_of_mrbnf mrbnf RS fun_cong RS fun_cong RS iffD1), + rtac ctxt (Drule.rotate_prems ~1 (iffD2 OF [hd (MRBNF_Def.mr_rel_map_of_mrbnf mrbnf)])), + K (Local_Defs.unfold_tac ctxt @{thms id_o o_id Grp_UNIV_id eq_OO Grp_OO}), + etac ctxt (Drule.rotate_prems (~1 - live) (MRBNF_Def.mr_rel_mono_strong_of_mrbnf mrbnf)), + REPEAT_DETERM o EVERY' [ + rtac ctxt ballI, + rtac ctxt ballI, + rtac ctxt @{thm imp_refl} ORELSE' EVERY' [ + rtac ctxt impI, + dresolve_tac ctxt (TT_total_abs_eq_iffs RSS iffD2), + K (Local_Defs.unfold0_tac ctxt TT_abs_reps), + assume_tac ctxt + ] + ], + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt), + REPEAT_DETERM o eresolve_tac ctxt [exE, conjE], + hyp_subst_tac_thin true ctxt, + EqSubst.eqsubst_tac ctxt [0] [MRBNF_Def.map_comp_of_mrbnf mrbnf], + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id}), + K (Local_Defs.unfold0_tac ctxt @{thms comp_def}), + resolve_tac ctxt (map (Drule.rotate_prems ~1) (#intrs alphas)), + rtac ctxt (Drule.rotate_prems ~1 (iffD2 OF [hd (MRBNF_Def.mr_rel_map_of_mrbnf mrbnf)])), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt @{thms id_o o_id Grp_UNIV_id eq_OO}), + rtac ctxt (Drule.rotate_prems ~1 (iffD2 OF [nth (MRBNF_Def.mr_rel_map_of_mrbnf mrbnf) 2])), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt), + K (Local_Defs.unfold0_tac ctxt @{thms inv_id id_o o_id Grp_UNIV_id conversep_eq eq_OO}), + K (Local_Defs.unfold0_tac ctxt @{thms relcompp_conversep_Grp Grp_OO}), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1}, + assume_tac ctxt + ], + rtac ctxt (iffD1 OF [MRBNF_Def.mr_rel_id_of_mrbnf mrbnf RS fun_cong RS fun_cong]), + rtac ctxt (MRBNF_Def.rel_refl_strong_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt (refl :: alpha_refls @ TT_rep_abs_syms), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt), + REPEAT_DETERM o EVERY' [ + REPEAT_DETERM1 o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id} + ], + K (Local_Defs.unfold_tac ctxt (@{thms image_id image_comp[unfolded comp_def]} @ maps (map snd) FVarsss)), + REPEAT_DETERM1 o assume_tac ctxt + ] + ]) end + ) xs ys bound_setsss bfree_setsss rec_setss deadss mrbnfs ctors raw_Ts; - fun mk_FFVars_rrename f w rrename_t rrename_def alpha_sym alpha_quotient_sym FVars_rename FFVars_t FFVars_def alpha_FVars = + val fresh_cases = @{map 13} (fn mrbnf => fn ctor => fn x => fn z => fn bsetss => fn raw => fn rep => fn abs => + fn raw_refresh => fn noclash => fn FVarss => fn map_abs => fn alpha_FVars => let - val goal = mk_Trueprop_eq ( - FFVars_t $ (list_comb (rrename_t, ffs) $ w), mk_image f $ (FFVars_t $ w) + val P = Free ("P", @{typ bool}); + val IH = Logic.all x (fold_rev (curry Logic.mk_implies) ( + mk_Trueprop_eq (z, fst ctor $ x) + :: map2 (fn A => fn bsets => + HOLogic.mk_Trueprop (mk_int_empty (foldl1 mk_Un (map (fn s => s $ x) bsets), A)) + ) As bsetss) (Logic.mk_implies (apply2 HOLogic.mk_Trueprop (fst noclash $ x, P))) ); - in - prove lthy (ffs @ [w]) prem_terms_ffs goal (fn ctxt => fn prems => - Ctr_Sugar_Tactics.unfold_thms_tac ctxt [rrename_def, FFVars_def] THEN - EVERY1 [ + in Goal.prove_sorry lthy (names (As @ [z, P])) (A_prems @ [IH]) (HOLogic.mk_Trueprop P) (fn {context=ctxt, prems} => + let val (prems, IH) = split_last prems + in EVERY1 [ + rtac ctxt (infer_instantiate' ctxt [SOME (Thm.cterm_of ctxt (rep $ z))] (#exhaust raw)), + Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => + rtac ctxt (exE OF [infer_instantiate' ctxt (map2 (fn A => fn FVars => + SOME (Thm.cterm_of ctxt (mk_Un (A, fst FVars $ z))) + ) As FVarss @ [SOME (snd (hd params))]) raw_refresh]) 1 + ) ctxt, + REPEAT_DETERM o resolve_tac ctxt (prems @ flat FVars_bd_UNIVs @ [MRBNF_Def.Un_bound_of_mrbnf mrbnf]), + REPEAT_DETERM o etac ctxt conjE, + Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => + rtac ctxt (infer_instantiate' ctxt [SOME (Thm.cterm_of ctxt ( + map_abs $ (Thm.term_of (snd (snd (split_last params)))) + ))] IH) 1 + ) ctxt, + dtac ctxt (mk_arg_cong lthy 1 abs), + K (Local_Defs.unfold0_tac ctxt (snd ctor :: TT_abs_reps)), + hyp_subst_tac_thin true ctxt, + EqSubst.eqsubst_tac ctxt [0] [MRBNF_Def.map_comp_of_mrbnf mrbnf], + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id}, + K (Local_Defs.unfold0_tac ctxt (@{thms id_o o_id} @ TT_total_abs_eq_iffs)), + eresolve_tac ctxt alpha_transs, + resolve_tac ctxt (#intrs alphas), + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id id_on_id eq_on_refl}, + K (Local_Defs.unfold0_tac ctxt (@{thms comp_def} @ permute_raw_ids @ [MRBNF_Def.mr_rel_id_of_mrbnf mrbnf RS sym])), + rtac ctxt (nth (MRBNF_Def.rel_map_of_mrbnf mrbnf) 1 RS iffD2), + rtac ctxt (MRBNF_Def.rel_refl_strong_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt (@{thms id_apply[symmetric]} @ TT_rep_abs_syms), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id}, + K (Local_Defs.unfold0_tac ctxt @{thms image_id}), + etac ctxt @{thm Int_subset_empty2}, + rtac ctxt @{thm Un_upper1} + ], + K (Local_Defs.unfold0_tac ctxt [snd noclash]), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id} + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_id image_comp[unfolded comp_def]}), + REPEAT_DETERM o EVERY' [ + TRY o rtac ctxt conjI, + etac ctxt @{thm Int_subset_empty2}, + rtac ctxt @{thm subset_trans[rotated]}, + rtac ctxt @{thm Un_upper2}, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt (maps (map snd) FVarsss)), + rtac ctxt @{thm iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]}, rtac ctxt trans, - rtac ctxt alpha_FVars, - rtac ctxt alpha_sym, - rtac ctxt alpha_quotient_sym, - rtac ctxt FVars_rename, - REPEAT_DETERM o resolve_tac ctxt prems + etac ctxt @{thm arg_cong}, + eresolve_tac ctxt alpha_FVars, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt ( + flat FVars_raw_ctorss @ flat (map2 (fn rep_abs => map (fn thm => thm OF [rep_abs])) TT_rep_abss alpha_FVarss) + )), + rtac ctxt subsetI, + REPEAT_DETERM o etac ctxt UnE, + REPEAT_DETERM o EVERY' [ + rotate_tac ~1, + etac ctxt @{thm contrapos_pp}, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms Un_iff de_Morgan_disj}), + REPEAT_DETERM o etac ctxt conjE, + assume_tac ctxt + ] ] - ) - end; - val FFVars_rrenamess = @{map 5} (fn f => @{map 9} (mk_FFVars_rrename f) ws rrenamesAs rrename_defs alpha_syms alpha_quotient_syms) - ffs FVars_renamess FFVarsssAs FFVars_defss alpha_FVarsss - - val cctor_eq_intro_rrenames = map (fn thm => (thm RS iffD2) - |> funpow fbound (fn thm => thm OF [exI]) OF [mk_conjIN (3*fbound + 1)]) TT_injects0; - - fun mk_noclash_rename renames FVars_renames = @{map 4} (fn mrbnf => fn map_t => fn noclash => fn x => + ] end + ) end + ) mrbnfs ctors xs zs bound_setsss raw_Ts TT_reps TT_abss raw_refreshs noclashs FVarsss map_id_abss alpha_FVarss; + + val (raw_ws, _) = lthy + |> mk_Frees "w" (map fastype_of raw_zs); + + val subshapess_opt = Option.map (fn subshapes => fst (fold_map chop (replicate n n) (#preds subshapes))) subshapes_opt; + val alpha_subshapess_opt = if nrecs = 0 then NONE else + let + val goal = HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj (@{map 4} (fn alpha => fn z => fn z' => fn subshapes => + mk_all (dest_Free z) (HOLogic.mk_imp ( + alpha $ z $ z', + foldr1 HOLogic.mk_conj (map2 (fn w => fn subshape => mk_all (dest_Free w) (HOLogic.mk_imp ( + subshape $ w $ z, subshape $ w $ z' + ))) raw_ws subshapes) + )) + ) (#preds alphas) raw_zs raw_zs' (the subshapess_opt))); + in SOME (map split_conj (split_conj (Goal.prove_sorry lthy (names raw_zs') [] goal (fn {context=ctxt, ...} => EVERY1 [ + DETERM o rtac ctxt (infer_instantiate' ctxt (replicate n NONE @ map (SOME o Thm.cterm_of ctxt) raw_zs') (#induct (hd raw_Ts))), + EVERY' (map2 (fn mrbnf => fn raw => Subgoal.FOCUS_PREMS (fn {context=ctxt, prems=IHs, ...} => EVERY1 [ + rtac ctxt allI, + rtac ctxt impI, + REPEAT_DETERM o EVERY' [ + TRY o rtac ctxt conjI, + rtac ctxt allI, + rtac ctxt impI, + eresolve_tac ctxt (#elims alphas), + eresolve_tac ctxt (#elims (the subshapes_opt)), + dtac ctxt (#inject raw RS iffD1), + rotate_tac ~1, + dtac ctxt sym, + hyp_subst_tac ctxt, + dtac ctxt (#inject raw RS iffD1), + hyp_subst_tac ctxt, + REPEAT_DETERM o etac ctxt UnE, + REPEAT_DETERM o EVERY' [ + dresolve_tac ctxt (map (Drule.rotate_prems ~1) (drop (nargs - nrecs) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf))), + K (prefer_tac (MRBNF_Def.free_of_mrbnf mrbnf + 2 * MRBNF_Def.bound_of_mrbnf mrbnf + 1)), + assume_tac ctxt, + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt), + etac ctxt bexE, + forward_tac ctxt IHs, + etac ctxt allE, + etac ctxt impE, + assume_tac ctxt, + resolve_tac ctxt (map (Drule.rotate_prems ~1) (#intrs (the subshapes_opt))), + rotate_tac ~3, + etac ctxt @{thm contrapos_pp}, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms Un_iff de_Morgan_disj}), + REPEAT_DETERM o etac ctxt conjE, + assume_tac ctxt, + K (prefer_tac (2 * nvars + 1)), + resolve_tac ctxt (map (Drule.rotate_prems 1) alpha_transs), + assume_tac ctxt, + (REPEAT_DETERM1 o assume_tac ctxt) ORELSE' EVERY' [ + resolve_tac ctxt (map (Drule.rotate_prems 1) alpha_transs), + resolve_tac ctxt (map (fn thm => Drule.rotate_prems ~1 (thm RS iffD2)) alpha_bij_eqs), + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_id_bound bij_id}), + resolve_tac ctxt (map (fn alpha => infer_instantiate' ctxt [SOME (Thm.cterm_of ctxt alpha)] @{thm rel_refl_eq}) (#preds alphas)), + resolve_tac ctxt alpha_refls, + rtac ctxt sym, + resolve_tac ctxt permute_raw_comps, + REPEAT_DETERM o FIRST' [ + assume_tac ctxt, + resolve_tac ctxt (infinite_UNIV :: @{thms supp_id_bound bij_id bij_comp supp_comp_bound}) + ] + ] + ] + ] + ]) ctxt) mrbnfs raw_Ts) + ])) RSS spec RSS mp) |> map (fn thms => thms RSS spec RSS mp)) end; + + val (Ps, _) = lthy + |> mk_Frees "P" (map (fn raw => #T raw --> @{typ bool}) raw_Ts); + + val (conj_spec, conj_mp) = mk_conj_thms n lthy; + fun apply_n thm n = fold (K (fn t => thm OF [t])) (0 upto n - 1); + + val subshape_induct_opt = if nrecs = 0 then NONE else + let + val IHs = @{map 3} (fn z => fn P => fn subshapes => Logic.all z (fold_rev (curry Logic.mk_implies) ( + @{map 3} (fn subshape => fn P => fn z' => Logic.all z' (Logic.mk_implies ( + HOLogic.mk_Trueprop (subshape $ z' $ z), HOLogic.mk_Trueprop (P $ z') + ))) subshapes Ps raw_zs' + ) (HOLogic.mk_Trueprop (P $ z)))) raw_zs Ps (the subshapess_opt); + val goal = foldr1 HOLogic.mk_conj (@{map 5} (fn z => fn z' => fn permute => fn alpha => fn P => + fold_rev (mk_all o dest_Free) (fs @ [z']) (fold_rev (curry HOLogic.mk_imp o HOLogic.dest_Trueprop) f_prems ( + HOLogic.mk_imp (alpha $ (Term.list_comb (fst permute, fs) $ z) $ z', P $ z') + )) + ) raw_zs raw_zs' permute_raws (#preds alphas) Ps); + in SOME (Goal.prove_sorry lthy (names (Ps @ raw_zs)) IHs (HOLogic.mk_Trueprop goal) (fn {context=ctxt, prems} => EVERY1 [ + DETERM o rtac ctxt (infer_instantiate' ctxt (replicate n NONE @ map (SOME o Thm.cterm_of ctxt) raw_zs) (#induct (hd raw_Ts))), + EVERY' (@{map 3} (fn mrbnf => fn alpha_subshapes => fn raw => Subgoal.FOCUS_PREMS (fn {context=ctxt, prems=IHs, ...} => EVERY1 [ + REPEAT_DETERM o resolve_tac ctxt [allI, impI], + resolve_tac ctxt prems, + REPEAT_DETERM o EVERY' [ + dresolve_tac ctxt (map (Drule.rotate_prems ~1) alpha_subshapes), + eresolve_tac ctxt alpha_syms, + rotate_tac ~2, + etac ctxt @{thm thin_rl}, + EqSubst.eqsubst_asm_tac ctxt [0] (map snd permute_raws), + REPEAT_DETERM o assume_tac ctxt, + eresolve_tac ctxt (#elims (the subshapes_opt)), + dtac ctxt (#inject raw RS iffD1), + hyp_subst_tac ctxt, + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_asm_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms supp_id_bound bij_id}) + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_Un[symmetric]}), + etac ctxt imageE, + hyp_subst_tac ctxt, + dresolve_tac ctxt (map (fn thm => Drule.rotate_prems ~1 (thm RS iffD1)) alpha_bij_eq_invs), + REPEAT_DETERM o assume_tac ctxt, + EqSubst.eqsubst_asm_tac ctxt [0] permute_raw_comps, + REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms bij_imp_bij_inv supp_inv_bound}), + REPEAT_DETERM o etac ctxt UnE, + REPEAT_DETERM o EVERY' [ + dresolve_tac ctxt IHs, + REPEAT_DETERM o etac ctxt allE, + REPEAT_DETERM o (etac ctxt impE THEN' K (prefer_tac 2)), + assume_tac ctxt, + eresolve_tac ctxt alpha_syms, + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt (infinite_UNIV :: @{thms bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp}), + assume_tac ctxt + ] + ] + ] + ]) ctxt) mrbnfs (the alpha_subshapess_opt) raw_Ts) + ]) + |> apply_n conj_spec (nvars + 1) + |> apply_n (conj_mp OF (@{thm _} :: replicate n @{thm bij_id}) RS ( + conj_mp OF (@{thm _} :: replicate n @{thm supp_id_bound}) + )) nvars + |> Local_Defs.unfold0 lthy permute_raw_ids + |> apply_n (conj_mp OF (@{thm _} :: alpha_refls)) 1 + ) end; + + val Ts = map #T raw_Ts; + val sumT = foldr1 BNF_Util.mk_sumT Ts; + val subshape_rel_opt = Option.map (fn subshapess => HOLogic.Collect_const (HOLogic.mk_prodT (sumT, sumT)) $ + HOLogic.mk_case_prod (Term.abs ("t", sumT) (Term.abs ("t'", sumT) ( + BNF_FP_Util.mk_case_sumN (map2 (fn T1 => fn subshapes => Term.abs ("x", T1) ( + BNF_FP_Util.mk_case_sumN (map2 (fn T2 => fn subshape => Term.abs ("y", T2) ( + subshape $ Bound 1 $ Bound 0 + )) Ts subshapes) $ Bound 1 + )) Ts (transpose subshapess)) $ Bound 1 + )))) subshapess_opt; + + val wf_subshape_opt = if nrecs = 0 then NONE else + let + val wf = Const (@{const_name wf_on}, HOLogic.mk_setT sumT --> HOLogic.mk_setT (HOLogic.mk_prodT (sumT, sumT)) --> @{typ bool}) $ HOLogic.mk_UNIV sumT; + fun sumE_tac ctxt = Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => + rtac ctxt (infer_instantiate' ctxt [SOME (snd (snd (split_last params)))] ( + BNF_GFP_Util.mk_sumEN n + )) 1 + ) ctxt THEN_ALL_NEW hyp_subst_tac ctxt; + in SOME (Goal.prove_sorry lthy [] [] (HOLogic.mk_Trueprop (wf $ the subshape_rel_opt)) (fn {context=ctxt, ...} => EVERY1 [ + rtac ctxt @{thm wfUNIVI}, + K (Local_Defs.unfold_tac ctxt @{thms prod_in_Collect_iff prod.case}), + sumE_tac ctxt, + K (ALLGOALS (fn i => Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => + let + val P = Thm.term_of (snd (hd params)); + val subshape_induct' = infer_instantiate' lthy (map2 (fn x => fn inj => SOME (Thm.cterm_of lthy ( + Term.absfree (dest_Free x) (P $ inj) + ))) raw_zs (mk_sum_ctors raw_zs)) (the subshape_induct_opt); + in rtac ctxt (BNF_FP_Rec_Sugar_Util.mk_conjunctN n i OF [subshape_induct']) 1 end + ) ctxt i)), + REPEAT_DETERM o EVERY' [ + etac ctxt allE, + etac ctxt impE, + K (prefer_tac 2), + assume_tac ctxt, + rtac ctxt allI, + rtac ctxt impI, + sumE_tac ctxt, + K (Local_Defs.unfold0_tac ctxt @{thms sum.case}), + REPEAT_DETERM o Goal.assume_rule_tac ctxt + ] + ])) end; + + val set_subshape_permutess_opt = if nrecs = 0 then NONE else SOME ( + @{map 4} (fn raw => fn x => fn shapes => @{map 4} (fn z => fn subshape => fn permute => fn rec_set => + Goal.prove_sorry lthy (names (fs @ [x, z])) f_prems (Logic.mk_implies (apply2 HOLogic.mk_Trueprop ( + HOLogic.mk_mem (z, rec_set $ x), subshape $ (Term.list_comb (fst permute, fs) $ z) $ (#ctor raw $ x) + ))) (fn {context=ctxt, prems} => EVERY1 [ + resolve_tac ctxt (map (Drule.rotate_prems ~2) (#intrs (the subshapes_opt))), + EqSubst.eqsubst_tac ctxt [0] permute_raw_comps, + K (prefer_tac (4 * nvars + 1)), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1}, + resolve_tac ctxt prems + ], + K (Local_Defs.unfold0_tac ctxt permute_raw_ids), + resolve_tac ctxt alpha_refls, + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_inv_bound bij_imp_bij_inv} @ prems), + etac ctxt @{thm contrapos_pp}, + K (Local_Defs.unfold0_tac ctxt @{thms Un_iff de_Morgan_disj}), + REPEAT_DETERM o etac ctxt conjE, + assume_tac ctxt, + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_inv_bound bij_imp_bij_inv} @ prems) + ]) + ) (replicate_rec raw_zs) (replicate_rec shapes) (replicate_rec permute_raws)) raw_Ts raw_xs (the subshapess_opt) raw_rec_setss); + + val set_subshapess_opt = Option.map (map (map (fn thm => Local_Defs.unfold0 lthy permute_raw_ids ( + thm OF (flat (replicate nvars @{thms bij_id supp_id_bound})) + )))) set_subshape_permutess_opt; + + val permute_abss = @{map 6} (fn z => fn permute => fn permute_raw => fn abs => fn abs_eq_iff => fn alpha_bij_eq => + Goal.prove_sorry lthy (names (fs @ [z])) f_prems (mk_Trueprop_eq ( + Term.list_comb (fst permute, fs) $ (abs $ z), + abs $ (Term.list_comb (fst permute_raw, fs) $ z) + )) (fn {context=ctxt, prems} => EVERY1 [ + K (Local_Defs.unfold0_tac ctxt [snd permute]), + rtac ctxt (abs_eq_iff RS iffD2), + rtac ctxt (alpha_bij_eq RS iffD2 OF prems), + resolve_tac ctxt TT_rep_abss + ]) + ) raw_zs permutes permute_raws TT_abss TT_total_abs_eq_iffs alpha_bij_eqs; + + val (pT, lthy') = fold Variable.declare_typ (map TFree (Term.add_tfreesT (#T (hd raw_Ts)) [])) lthy + |> apfst hd o mk_TFrees 1; + val ((((Param, rho), Ps), Ks), _) = lthy' + |> apfst hd o mk_Frees "Param" [HOLogic.mk_setT pT] + ||>> apfst hd o mk_Frees "\" [pT] + ||>> mk_Frees "P" (map (fn quot => #abs_type (fst quot) --> pT --> @{typ bool}) quots) + ||>> mk_Frees "K" (map (fn a => pT --> HOLogic.mk_setT (fastype_of a)) aa); + val mk_Ball_Param = mk_Ball Param o Term.absfree (dest_Free rho); + + val existential_induct_opt = if nrecs = 0 then NONE else + let + val IHs = @{map 5} (fn x => fn y => fn rec_sets => fn ctor => fn P => Logic.all x (Logic.all rho ( + Logic.mk_implies (HOLogic.mk_Trueprop (HOLogic.mk_mem (rho, Param)), HOLogic.mk_Trueprop (mk_ex (dest_Free y) ( + HOLogic.mk_conj (HOLogic.mk_eq (fst ctor $ y, fst ctor $ x), HOLogic.mk_imp ( + foldr1 HOLogic.mk_conj (@{map 3} (fn rec_set => fn P => fn z => mk_all (dest_Free z) (HOLogic.mk_imp ( + HOLogic.mk_mem (z, rec_set $ y), mk_Ball_Param (P $ z $ rho) + ))) rec_sets (replicate_rec Ps) (replicate_rec zs)), + P $ (fst ctor $ y) $ rho + )) + ))) + ))) xs ys rec_setss ctors Ps; + val goal = HOLogic.mk_Trueprop (mk_Ball_Param (foldr1 HOLogic.mk_conj (map2 (fn P => fn z => P $ z $ rho) Ps zs))); + in SOME (Goal.prove_sorry lthy (names (Param :: Ps @ zs)) IHs goal (fn {context=ctxt, prems=IHs} => EVERY1 [ + K (Local_Defs.unfold0_tac ctxt @{thms ball_conj_distrib}), + rtac ctxt (Local_Defs.unfold0 ctxt TT_abs_reps ( + infer_instantiate' ctxt (map (SOME o Thm.cterm_of ctxt) (@{map 3} (fn z => fn abs => fn P => + Term.absfree (dest_Free z) (mk_Ball_Param (P $ (abs $ z) $ rho)) + ) raw_zs TT_abss Ps @ map2 (curry (op$)) TT_reps zs)) (the subshape_induct_opt) + )), + EVERY' (@{map 5} (fn mrbnf => fn raw => fn P => fn abs_eq_iff => fn IH => EVERY' [ + rtac ctxt ballI, + Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => + rtac ctxt (infer_instantiate' ctxt [SOME (snd (hd params))] (#exhaust raw)) 1 + ) ctxt, + hyp_subst_tac ctxt, + rtac ctxt (iffD2 OF [mk_arg_cong lthy 2 P OF @{thms _ refl}]), + rtac ctxt (abs_eq_iff RS iffD2), + resolve_tac ctxt (#intrs alphas), + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id id_on_id eq_on_refl}, + K (Local_Defs.unfold0_tac ctxt ((MRBNF_Def.mr_rel_id_of_mrbnf mrbnf RS sym) :: permute_raw_ids)), + rtac ctxt (nth (MRBNF_Def.rel_map_of_mrbnf mrbnf) 1 RS iffD2), + rtac ctxt (MRBNF_Def.rel_refl_strong_of_mrbnf mrbnf), + REPEAT_DETERM o rtac ctxt refl, + EVERY' (@{map 4} (fn rep => fn abs => fn TT_rep_abs => fn m => REPEAT_DETERM_N m o EVERY' [ + resolve_tac ctxt alpha_syms, + Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => + rtac ctxt (Local_Defs.unfold ctxt [ + infer_instantiate' ctxt (map (SOME o Thm.cterm_of ctxt) [rep, abs]) @{thm comp_apply[symmetric]} + ] (infer_instantiate' ctxt [SOME (snd (snd (split_last params)))] TT_rep_abs)) 1 + ) ctxt + ]) TT_reps TT_abss TT_rep_abss rec_vars), + K (Local_Defs.unfold0_tac ctxt @{thms id_hid_o_hid id_def[symmetric]}), + K (Local_Defs.unfold0_tac ctxt @{thms hidden_id_def}), + EqSubst.eqsubst_tac ctxt [0] [MRBNF_Def.map_comp_of_mrbnf mrbnf RS sym], + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id}, + K (Local_Defs.unfold0_tac ctxt (map (Thm.symmetric o snd) ctors)), + dtac ctxt IH, + etac ctxt exE, + etac ctxt conjE, + dtac ctxt sym, + rtac ctxt (iffD2 OF [mk_arg_cong lthy 2 P OF @{thms _ refl}]), + assume_tac ctxt, + etac ctxt mp, + REPEAT_DETERM o EVERY' [ + TRY o rtac ctxt conjI, + rtac ctxt allI, + rtac ctxt impI, + dresolve_tac ctxt (TT_inject0s RSS iffD1), + REPEAT_DETERM o eresolve_tac ctxt [exE, conjE], + hyp_subst_tac ctxt, + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_asm_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt) + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_id}), + K (Local_Defs.unfold0_tac ctxt @{thms image_comp[unfolded comp_def]}), + etac ctxt imageE, + hyp_subst_tac ctxt, + TRY o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] permute_abss, + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt) + ], + EVERY' [ + dresolve_tac ctxt (flat (the set_subshapess_opt)), + Goal.assume_rule_tac ctxt + ] ORELSE' EVERY' [ + dresolve_tac ctxt (maps (map (Drule.rotate_prems ~1)) (the set_subshape_permutess_opt)), + K (prefer_tac (2 * nvars + 1)), + Goal.assume_rule_tac ctxt, + REPEAT_DETERM o (resolve_tac ctxt @{thms supp_id_bound bij_id} ORELSE' assume_tac ctxt) + ] + ] + ]) mrbnfs raw_Ts Ps TT_total_abs_eq_iffs IHs) + ])) end + + val fresh_induct_param_opt = if nrecs = 0 then NONE else + let + val bound_prems = map2 (fn a => fn K => Logic.all rho (Logic.mk_implies (apply2 HOLogic.mk_Trueprop ( + HOLogic.mk_mem (rho, Param), mk_ordLess (mk_card_of (K $ rho)) (mk_card_of (HOLogic.mk_UNIV (fastype_of a))) + )))) aa Ks; + val IHs = @{map 6} (fn x => fn ctor => fn P => fn rec_sets => fn bsetss => fn noclash => Logic.all x (Logic.all rho ( + fold_rev (curry Logic.mk_implies) (@{map 3} (fn rec_set => fn P => fn z => Logic.all z (Logic.all rho ( + Logic.mk_implies (HOLogic.mk_Trueprop (HOLogic.mk_mem (z, rec_set $ x)), Logic.mk_implies ( + apply2 HOLogic.mk_Trueprop (HOLogic.mk_mem (rho, Param), P $ z $ rho) + )) + ))) rec_sets (replicate_rec Ps) (replicate_rec zs) @ map2 (fn K => fn bsets => HOLogic.mk_Trueprop ( + mk_int_empty (foldl1 mk_Un (map (fn s => s $ x) bsets), K $ rho) + )) Ks bsetss) (Logic.mk_implies (HOLogic.mk_Trueprop (fst noclash $ x), + Logic.mk_implies (apply2 HOLogic.mk_Trueprop (HOLogic.mk_mem (rho, Param), P $ (fst ctor $ x) $ rho)) + )) + ))) xs ctors Ps rec_setss bound_setsss noclashs; + val goal = HOLogic.mk_Trueprop (mk_Ball_Param (foldr1 HOLogic.mk_conj (map2 (fn P => fn z => P $ z $ rho) Ps zs))); + in SOME (Goal.prove_sorry lthy (names (Param :: Ks @ Ps @ zs)) (bound_prems @ IHs) goal (fn {context=ctxt, prems} => EVERY1 [ + rtac ctxt (the existential_induct_opt), + EVERY' (@{map 2} (fn ctor => fn fresh_case => EVERY' [ + Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => + let val [x, rho] = map (Thm.term_of o snd) params; + in rtac ctxt (infer_instantiate' ctxt (map (SOME o Thm.cterm_of ctxt) ( + map (fn K => K $ rho) Ks @ [fst ctor $ x] + )) fresh_case) 1 end + ) ctxt, + REPEAT_DETERM o eresolve_tac ctxt prems, + rtac ctxt exI, + rtac ctxt conjI, + etac ctxt sym, + rtac ctxt impI, + REPEAT_DETERM o etac ctxt conjE, + resolve_tac ctxt prems, + EVERY' (map (fn i => EVERY' [ + rotate_tac i, + etac ctxt allE, + etac ctxt impE, + assume_tac ctxt, + etac ctxt ballE, + assume_tac ctxt, + rotate_tac ~1, + etac ctxt @{thm contrapos_np}, + assume_tac ctxt + ]) (~nrecs - 2 upto ~3)), + REPEAT_DETERM o assume_tac ctxt + ]) ctors fresh_cases) + ])) end + + val fresh_induct_opt = Option.map (fn fresh_induct_param => + let + val (Ps, _) = lthy + |> mk_Frees "P" (map (fn quot => #abs_type (fst quot) --> @{typ bool}) quots); + val bound_prems = map (fn A => HOLogic.mk_Trueprop ( + mk_ordLess (mk_card_of A) (mk_card_of (HOLogic.mk_UNIV (HOLogic.dest_setT (fastype_of A)))) + )) As; + val IHs = @{map 6} (fn x => fn ctor => fn P => fn rec_sets => fn bsetss => fn noclash => Logic.all x ( + fold_rev (curry Logic.mk_implies) (@{map 3} (fn rec_set => fn P => fn z => Logic.all z ( + Logic.mk_implies ( + HOLogic.mk_Trueprop (HOLogic.mk_mem (z, rec_set $ x)), + HOLogic.mk_Trueprop (P $ z) + ) + )) rec_sets (replicate_rec Ps) (replicate_rec zs) @ map2 (fn A => fn bsets => HOLogic.mk_Trueprop ( + mk_int_empty (foldl1 mk_Un (map (fn s => s $ x) bsets), A) + )) As bsetss) (Logic.mk_implies ( + HOLogic.mk_Trueprop (fst noclash $ x), + HOLogic.mk_Trueprop (P $ (fst ctor $ x)) + )) + )) xs ctors Ps rec_setss bound_setsss noclashs; + val goal = HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj (map2 (fn P => fn z => P $ z) Ps zs)); + in Goal.prove_sorry lthy (names (As @ Ps @ zs)) (bound_prems @ IHs) goal (fn {context=ctxt, prems} => EVERY1 [ + rtac ctxt (Local_Defs.unfold0 ctxt @{thms ball_UNIV} ( + infer_instantiate' ctxt (map (SOME o Thm.cterm_of ctxt) ( + [HOLogic.mk_UNIV (fastype_of rho)] + @ map (Term.absfree (dest_Free rho)) As + @ map2 (fn P => fn z => fold_rev (Term.absfree o dest_Free) [z, rho] (P $ z)) Ps zs + )) fresh_induct_param + ) RS spec), + REPEAT_DETERM o resolve_tac ctxt (take nvars prems), + REPEAT_DETERM o EVERY' [ + resolve_tac ctxt prems, + REPEAT_DETERM1 o Goal.assume_rule_tac ctxt, + REPEAT_DETERM o assume_tac ctxt + ] + ]) end) fresh_induct_param_opt; + + val permute_congs = @{map 5} (fn permute => fn z => fn FVarss => fn alpha_bij => fn abs_eq_iff => + let val goal = fold_rev (curry Logic.mk_implies) ( + @{map 4} (fn f => fn g => fn FVars => fn a => Logic.all a (Logic.mk_implies ( + HOLogic.mk_Trueprop (HOLogic.mk_mem (a, fst FVars $ z)), mk_Trueprop_eq (f $ a, g $ a) + ))) fs gs FVarss aa + ) (mk_Trueprop_eq (Term.list_comb (fst permute, fs) $ z, Term.list_comb (fst permute, gs) $ z)); + in Goal.prove_sorry lthy (names (fs @ gs @ [z])) (f_prems @ g_prems) goal (fn {context=ctxt, prems} => EVERY1 [ + K (Local_Defs.unfold_tac ctxt (@{thms atomize_all atomize_imp eq_on_def[symmetric]} @ map snd (permute :: FVarss))), + REPEAT_DETERM o rtac ctxt impI, + rtac ctxt (abs_eq_iff RS iffD2), + rtac ctxt (alpha_bij OF prems), + REPEAT_DETERM o assume_tac ctxt, + resolve_tac ctxt alpha_refls + ]) end + ) permutes zs FVarsss alpha_bijs TT_total_abs_eq_iffs; + + val permute_cong_ids = map (fn thm => Local_Defs.unfold0 lthy (@{thm id_apply} :: permute_ids) (thm OF ( + replicate (2 * nvars) @{thm _} @ flat (replicate nvars @{thms bij_id supp_id_bound}) + ))) permute_congs; + + val nnoclash_noclashs = @{map 5} (fn x => fn mrbnf => fn deads => fn noclash => fn noclash_raw => Goal.prove_sorry lthy (names [x]) [] (mk_Trueprop_eq ( + fst noclash $ x, fst noclash_raw $ (MRBNF_Def.mk_map_comb_of_mrbnf deads (map HOLogic.id_const plives @ replicate_rec TT_reps) + (map HOLogic.id_const (pbounds @ bounds)) (map HOLogic.id_const (frees @ pfrees @ bfrees)) mrbnf $ x) + )) (fn {context=ctxt, ...} => EVERY1 [ + K (Local_Defs.unfold0_tac ctxt [snd noclash, snd noclash_raw]), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id} + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_id}), + K (Local_Defs.unfold0_tac ctxt (@{thms image_comp[unfolded comp_def]} @ maps (map (Thm.symmetric o snd)) FVarsss)), + rtac ctxt refl + ])) xs mrbnfs deadss noclashs raw_noclashs; + + val noclash_permutes = @{map 5} (fn permute => fn mrbnf => fn noclash => fn x => fn deads => let val goal = mk_Trueprop_eq ( - fst noclash $ (comb_mrbnf_term ffs_ids (map (fn t => Term.list_comb (t, ffs)) renames) map_t $ x), + fst noclash $ (MRBNF_Def.mk_map_comb_of_mrbnf deads + (map HOLogic.id_const plives @ replicate_rec (map (fn permute => Term.list_comb (fst permute, fs)) permutes)) + (map HOLogic.id_const pbounds @ bound_fs) + (fs @ map HOLogic.id_const pfrees @ bfree_fs) mrbnf $ x), fst noclash $ x ); - in Goal.prove_sorry lthy (map (fst o dest_Free) (ffs @ [x])) prem_terms_ffs goal (fn {context=ctxt, prems} => EVERY1 [ + in Goal.prove_sorry lthy (names (fs @ [x])) f_prems goal (fn {context=ctxt, prems} => EVERY1 [ K (Local_Defs.unfold0_tac ctxt [snd noclash]), REPEAT_DETERM o EVERY' [ EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), @@ -2377,7 +2515,7 @@ fun construct_binder_fp fp mrbnf_ks binding_relation lthy = ], K (Local_Defs.unfold0_tac ctxt @{thms image_comp[unfolded comp_def]}), REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] FVars_renames, + EqSubst.eqsubst_tac ctxt [0] (flat FVars_permutess), REPEAT_DETERM o resolve_tac ctxt prems ], K (Local_Defs.unfold0_tac ctxt @{thms image_Un[symmetric] image_UN[symmetric]}), @@ -2388,197 +2526,111 @@ fun construct_binder_fp fp mrbnf_ks binding_relation lthy = K (Local_Defs.unfold0_tac ctxt @{thms image_is_empty}), rtac ctxt refl ]) end - ) mrbnfs; - val noclash_renames = mk_noclash_rename renamesAs (flat FVars_renamess) mrbnf_maps_AsAs noclashs xs; - val nnoclash_rrenames = mk_noclash_rename rrenamesAs (flat FFVars_rrenamess) mrbnf_maps_BsBs nnoclashs vs; - - (* TODO: use giant map instead of x times (nth ... i) *) - val (raw_ress, quot_ress) = split_list (map (fn i => - let - fun nth_opt xs_opt i = Option.mapPartial (fn xs => try (nth xs) i) xs_opt - val raw_fp_res = { - T = nth CAs i, - ctor = nth ctorsAs i, - rename = nth renamesAs i, - FVars = nth (transpose FVarsssAs) i, - noclash = nth noclashs i, - - inject = nth raw_injects i, - noclash_rename = nth noclash_renames i, - rename_id0 = nth rename_id0s i, - rename_id = nth rename_ids i, - rename_comp0 = nth rename_comp0s i, - rename_comp = nth rename_comps i, - rename_bij = nth rename_bijs i, - rename_inv_simp = nth rename_inv_simps i, - FVars_ctors = nth (transpose FVars_ctorss) i, - FVars_renames = nth (transpose FVars_renamess) i, - FVars_intross = FVars_intross, - card_of_FVars_bounds = nth card_of_FVars_boundss' i, - card_of_FVars_bound_UNIVs = nth card_of_FVars_boundss i, - inner = { - alpha = nth alphasAs i, - subshape_rel = subshape_rel_opt, - - exhaust = nth raw_exhausts i, - rename_simp = nth rename_simps i, - - alpha_refl = nth alpha_refls i, - alpha_sym = nth alpha_syms i, - alpha_trans = nth alpha_transs i, - alpha_bij = nth alpha_bijs i, - alpha_bij_eq = nth alpha_bij_eqs i, - alpha_FVarss = nth (transpose alpha_FVarsss) i, - alpha_intro = nth alpha_intros i, - alpha_elim = nth alpha_elims i, - - subshapes = nth_opt subshapess_opt i, - wf_subshape = wf_subshape_opt, (* TODO: do not duplicate this *) - set_subshapess = nth_opt set_subshapesss_opt i, - set_subshape_imagess = nth_opt set_subshape_imagesss_opt i, - subshape_induct = TT_subshape_induct_opt - } - } : raw_result fp_result_T; - val quotient_fp_res = { - T = nth CBs i, - ctor = nth cctorsAs i, - rename = nth rrenamesAs i, - FVars = nth (transpose FFVarsssAs) i, - noclash = nth nnoclashs i, - - inject = nth TT_injects0 i, - noclash_rename = nth nnoclash_rrenames i, - rename_id0 = nth rrename_id0s i, - rename_id = nth rrename_ids i, - rename_comp0 = nth rrename_comp0s i, - rename_comp = nth rrename_comps i, - rename_bij = nth rrename_bijs i, - rename_inv_simp = nth rrename_inv_simps i, - FVars_ctors = nth (transpose FFVars_cctorss) i, - FVars_renames = nth (transpose FFVars_rrenamess) i, - FVars_intross = FFVars_intross, - card_of_FVars_bounds = nth card_of_FFVars_boundss' i, - card_of_FVars_bound_UNIVs = nth card_of_FFVars_boundss i, - inner = { - abs = nth TT_abss i, - rep = nth TT_reps i, - - ctor_def = nth cctor_defs i, - rename_def = nth rrename_defs i, - FVars_defs = nth (transpose FFVars_defss) i, - - nnoclash_noclash = nth nnoclash_noclashs i, - alpha_quotient_sym = nth alpha_quotient_syms i, - total_abs_eq_iff = nth Quotient_total_abs_eq_iffs i, - abs_rep = nth Quotient_abs_reps i, - rep_abs = nth Quotient_rep_abss i, - abs_ctor = nth TT_abs_ctors i, - - rename_ctor = nth rrename_cctors i, - rename_cong_id = nth rrename_cong_ids i, - fresh_co_induct_param = TT_fresh_co_induct_param, - fresh_co_induct = TT_fresh_co_induct, - fresh_induct_param_no_clash = TT_fresh_induct_param_no_clash_opt - } - } : quotient_result fp_result_T; - in (raw_fp_res, quotient_fp_res) end - ) (0 upto n - 1)); - - val res = { - fp = fp, + ) permutes mrbnfs noclashs xs deadss; + + val raw_results = map (fn i => + let val raw = nth raw_Ts i; + in { + T = #T raw, + ctor = #ctor raw, + permute = fst (nth permute_raws i), + FVarss = map fst (nth FVars_rawss i), + noclash = nth raw_noclashs i, + inject = #inject raw, + permute_ctor = snd (nth permute_raws i), + permute_id0 = nth permute_raw_id0s i, + permute_id = nth permute_raw_ids i, + permute_comp0 = nth permute_raw_comp0s i, + permute_comp = nth permute_raw_comps i, + FVars_ctors = nth FVars_raw_ctorss i, + FVars_permutes = nth FVars_permute_raws i, + FVars_intross = nth FVars_raw_introsss i, + card_of_FVars_bounds = nth FVars_raw_bds i, + card_of_FVars_bound_UNIVs = nth FVars_raw_bd_UNIVs i, + inner = { + alpha = nth (#preds alphas) i, + exhaust = #exhaust raw, + alpha_refl = nth alpha_refls i, + alpha_sym = nth alpha_syms i, + alpha_trans = nth alpha_transs i, + alpha_bij = nth alpha_bijs i, + alpha_bij_eq = nth alpha_bij_eqs i, + alpha_bij_eq_inv = nth alpha_bij_eq_invs i, + alpha_FVarss = nth alpha_FVarss i, + alpha_intro = nth (#intrs alphas) i, + alpha_elim = nth (#elims alphas) i + } + } : MRBNF_FP_Def_Sugar.raw_result MRBNF_FP_Def_Sugar.fp_result_T end + ) (0 upto n - 1); + + val quotient_results = map (fn i => + let val quot = nth quots i; + in { + T = #abs_type (fst quot), + ctor = fst (nth ctors i), + permute = fst (nth permutes i), + FVarss = map fst (nth FVarsss i), + noclash = nth noclashs i, + inject = nth TT_inject0s i, + permute_ctor = nth permute_simps i, + permute_id0 = nth permute_id0s i, + permute_id = nth permute_ids i, + permute_comp0 = nth permute_comp0s i, + permute_comp = nth permute_comps i, + FVars_ctors = nth FVars_ctorss i, + FVars_permutes = nth FVars_permutess i, + FVars_intross = nth FVars_introsss i, + card_of_FVars_bounds = nth FVars_bds i, + card_of_FVars_bound_UNIVs = nth FVars_bd_UNIVs i, + inner = { + abs = nth TT_abss i, + rep = nth TT_reps i, + fresh_cases = nth fresh_cases i, + ctor_def = snd (nth ctors i), + permute_def = snd (nth permutes i), + FVars_defs = map snd (nth FVarsss i), + noclash_permute = nth noclash_permutes i, + nnoclash_noclash = nth nnoclash_noclashs i, + total_abs_eq_iff = nth TT_total_abs_eq_iffs i, + abs_rep = nth TT_abs_reps i, + rep_abs = nth TT_rep_abss i, + rep_abs_sym = nth TT_rep_abs_syms i, + abs_ctor = nth TT_abs_ctors i, + permute_cong = nth permute_congs i, + permute_cong_id = nth permute_cong_ids i, + permute_bij = nth permute_bijs i, + permute_inv_simp = nth permute_inv_simps i + } + } : MRBNF_FP_Def_Sugar.quotient_result MRBNF_FP_Def_Sugar.fp_result_T end + ) (0 upto n - 1); + + val least_fp_thms_opt = if nrecs = 0 then NONE else SOME ({ + subshape_rel = the subshape_rel_opt, + subshapess = the subshapess_opt, + wf_subshape = the wf_subshape_opt, + set_subshapess = the set_subshapess_opt, + set_subshape_permutess = the set_subshape_permutess_opt, + subshape_induct = the subshape_induct_opt, + existential_induct = the existential_induct_opt, + fresh_induct_param = the fresh_induct_param_opt, + fresh_induct = the fresh_induct_opt + } : MRBNF_FP_Def_Sugar.least_fp_thms); + + val fp_result = { + fp = fp_kind, binding_relation = binding_relation, - rec_vars = ks, - raw_fps = raw_ress, - quotient_fps = quot_ress, + rec_vars = rec_vars, + bfree_vars = map (fn bfree => find_index (curry (op=) bfree) frees) bfrees, + raw_fps = raw_results, + quotient_fps = quotient_results, + fp_thms = least_fp_thms_opt, pre_mrbnfs = mrbnfs - } : fp_result; - - val lthy = register_fp_results [res] lthy - - val notes = - [("rename_simps", rename_simps), - ("rename_id0s", rename_id0s), - ("rename_ids", rename_ids), - ("rename_comp0s", rename_comp0s), - ("rename_comps", rename_comps), - ("rename_bijs", rename_bijs), - ("rename_inv_simps", rename_inv_simps), - ("FVars_ctors", flat FVars_ctorss), - ("FVars_rename_less", flat FVars_rename_less), - ("FVars_renames", flat FVars_renamess), - ("card_of_FVars_bounds", flat card_of_FVars_boundss), - ("alpha_refls", alpha_refls), - ("alpha_bijs", alpha_bijs), - ("alpha_bij_eqs", alpha_bij_eqs), - ("alpha_bij_eq_invs", alpha_bij_eq_invs), - ("alpha_FVarss", flat alpha_FVarsss), - ("alpha_syms", alpha_syms), - ("alpha_transs", alpha_transs), - ("alpha_elims", alpha_elims), - ("card_of_FVarsB_bounds", flat card_of_FVarsB_boundss), - ("refresh_sets", refresh_sets), - ("refreshs", refreshs), - ("avoid_freshs", flat avoid_freshss), - ("alpha_avoids", alpha_avoids), - ("equivp_alphas", equivp_alphas), - ("nnoclash_noclashs", nnoclash_noclashs), - ("nnoclash_rrenames", nnoclash_rrenames), - ("noclash_renames", noclash_renames), - ("TT_Quotients", TT_Quotients), - ("TT_alpha_quotient_syms", alpha_quotient_syms), - ("TT_Quotient_total_abs_eq_iffs", Quotient_total_abs_eq_iffs), - ("TT_Quotient_abs_reps", Quotient_abs_reps), - ("TT_Quotient_rep_abss", Quotient_rep_abss), - ("TT_abs_ctors", TT_abs_ctors), - ("TT_nchotomys", TT_nchotomys), - ("rrename_cctors", rrename_cctors), - ("card_of_FFVars_bounds", flat card_of_FFVars_boundss), - ("FFVars_bd", flat card_of_FFVars_boundss'), - ("FFVars_cctors", flat FFVars_cctorss), - ("FFVars_intros", flat FFVars_intross), - ("FVars_intros", flat FVars_intross), - ("FFVars_elims", flat FFVars_elimss), - ("FFVars_inducts", FFVars_inducts), - ("FFVars_rrenames", flat FFVars_rrenamess), - ("TT_injects0", TT_injects0), - ("aavoid_freshs", flat aavoid_freshss), - ("alpha_aavoids", alpha_aavoids), - ("TT_fresh_nchotomys", TT_fresh_nchotomys), - ("TT_fresh_cases", TT_fresh_cases), - ("TT_existential_co_induct", [TT_existential_co_induct]), - ("TT_fresh_co_induct_param", [TT_fresh_co_induct_param]), - ("TT_fresh_co_induct", [TT_fresh_co_induct]), - ("TT_plain_co_induct", [TT_plain_co_induct]), - ("rrename_id0s", rrename_id0s), - ("rrename_ids", rrename_ids), - ("rrename_bijs", rrename_bijs), - ("rrename_inv_simps", rrename_inv_simps), - ("rrename_comps", rrename_comps), - ("rrename_comp0s", rrename_comp0s), - ("rrename_cong_ids", rrename_cong_ids), - ("cctor_eq_intro_rrenames", cctor_eq_intro_rrenames) - ] @ (the_default [] ( - Option.map (single o pair "TT_fresh_induct_param_no_clash" o single) - TT_fresh_induct_param_no_clash_opt - )) @ (the_default [] ( - Option.map (single o pair "TT_subshape_induct" o single) - TT_subshape_induct_opt - )) @ (the_default [] ( - Option.map (single o pair "wf_subshape" o single) - wf_subshape_opt - )) @ (the_default [] ( - Option.map (single o pair "set_subshape_images" o flat o flat) - set_subshape_imagesss_opt - )) @ (the_default [] ( - Option.map (single o pair "set_subshapes" o flat o flat) - set_subshapesss_opt - )) |> (map (fn (thmN, thms) => - ((Binding.qualify true (hd names) (Binding.name thmN), []), [(thms, [])]) - )); - - val (noted, lthy') = Local_Theory.notes notes lthy - in - (res, lthy') - end; + } : MRBNF_FP_Def_Sugar.fp_result; -end; + val lthy = MRBNF_FP_Def_Sugar.register_fp_results [fp_result] lthy; + + val lthy = MRBNF_FP_Def_Sugar.note_fp_result fp_result lthy; + + in (fp_result, lthy) end + +end \ No newline at end of file diff --git a/Tools/mrbnf_fp_def_sugar.ML b/Tools/mrbnf_fp_def_sugar.ML index e8ae2268..badb1e9f 100644 --- a/Tools/mrbnf_fp_def_sugar.ML +++ b/Tools/mrbnf_fp_def_sugar.ML @@ -3,21 +3,19 @@ sig type 'a fp_result_T = { T: typ, ctor: term, - rename: term, - FVars: term list, + permute: term, + FVarss: term list, noclash: term * thm, inner: 'a, inject: thm, - noclash_rename: thm, - rename_id0: thm, - rename_id: thm, - rename_comp0: thm, - rename_comp: thm, - rename_bij: thm, - rename_inv_simp: thm, + permute_ctor: thm, + permute_id0: thm, + permute_id: thm, + permute_comp0: thm, + permute_comp: thm, FVars_ctors: thm list, - FVars_renames: thm list, + FVars_permutes: thm list, FVars_intross: thm list list, card_of_FVars_bounds: thm list, card_of_FVars_bound_UNIVs: thm list @@ -25,25 +23,17 @@ sig type raw_result = { alpha: term, - subshape_rel: term option, - exhaust: thm, - rename_simp: thm, alpha_refl: thm, alpha_sym: thm, alpha_trans: thm, alpha_bij: thm, alpha_bij_eq: thm, + alpha_bij_eq_inv: thm, alpha_FVarss: thm list, alpha_intro: thm, - alpha_elim: thm, - - subshapes: term list option, - wf_subshape: thm option, - set_subshapess: thm list list option, - set_subshape_imagess: thm list list option, - subshape_induct: thm option + alpha_elim: thm }; type quotient_result = { @@ -51,29 +41,44 @@ sig rep: term, ctor_def: thm, - rename_def: thm, + permute_def: thm, FVars_defs: thm list, + fresh_cases: thm, + noclash_permute: thm, nnoclash_noclash: thm, - alpha_quotient_sym: thm, total_abs_eq_iff: thm, abs_rep: thm, rep_abs: thm, + rep_abs_sym: thm, abs_ctor: thm, - rename_ctor: thm, - rename_cong_id: thm, - fresh_co_induct_param: thm, - fresh_co_induct: thm, - fresh_induct_param_no_clash: thm option + permute_cong: thm, + permute_cong_id: thm, + permute_bij: thm, + permute_inv_simp: thm + }; + + type least_fp_thms = { + subshape_rel: term, + subshapess: term list list, + wf_subshape: thm, + set_subshapess: thm list list, + set_subshape_permutess: thm list list, + subshape_induct: thm, + existential_induct: thm, + fresh_induct_param: thm, + fresh_induct: thm }; type fp_result = { fp: BNF_Util.fp_kind, - binding_relation: int list list, + binding_relation: int list list list, rec_vars: int list, + bfree_vars: int list, raw_fps: raw_result fp_result_T list, quotient_fps: quotient_result fp_result_T list, + fp_thms: least_fp_thms option, pre_mrbnfs: MRBNF_Def.mrbnf list }; @@ -86,6 +91,7 @@ sig val fp_result_of: Proof.context -> string -> fp_result option val register_fp_results: fp_result list -> local_theory -> local_theory + val note_fp_result: fp_result -> local_theory -> local_theory end; @@ -95,45 +101,41 @@ struct type 'a fp_result_T = { T: typ, ctor: term, - rename: term, - FVars: term list, + permute: term, + FVarss: term list, noclash: term * thm, inner: 'a, inject: thm, - noclash_rename: thm, - rename_id0: thm, - rename_id: thm, - rename_comp0: thm, - rename_comp: thm, - rename_bij: thm, - rename_inv_simp: thm, + permute_ctor: thm, + permute_id0: thm, + permute_id: thm, + permute_comp0: thm, + permute_comp: thm, FVars_ctors: thm list, - FVars_renames: thm list, + FVars_permutes: thm list, FVars_intross: thm list list, card_of_FVars_bounds: thm list, card_of_FVars_bound_UNIVs: thm list }; -fun morph_fp_result_T morph phi { T, ctor, rename, FVars, inner, inject, rename_id0, rename_id, - rename_comp0, rename_comp, rename_bij, rename_inv_simp, FVars_ctors, FVars_renames, card_of_FVars_bounds, - card_of_FVars_bound_UNIVs, FVars_intross, noclash, noclash_rename } = { +fun morph_fp_result_T morph phi { T, ctor, permute, FVarss, noclash, inner, inject, permute_ctor, + permute_id0, permute_id, permute_comp0, permute_comp, FVars_ctors, FVars_permutes, FVars_intross, + card_of_FVars_bounds, card_of_FVars_bound_UNIVs } = { T = Morphism.typ phi T, ctor = Morphism.term phi ctor, - rename = Morphism.term phi rename, - FVars = map (Morphism.term phi) FVars, + permute = Morphism.term phi permute, + FVarss = map (Morphism.term phi) FVarss, noclash = BNF_Util.map_prod (Morphism.term phi) (Morphism.thm phi) noclash, inner = morph phi inner, inject = Morphism.thm phi inject, - noclash_rename = Morphism.thm phi noclash_rename, - rename_id0 = Morphism.thm phi rename_id0, - rename_id = Morphism.thm phi rename_id, - rename_comp0 = Morphism.thm phi rename_comp0, - rename_comp = Morphism.thm phi rename_comp, - rename_bij = Morphism.thm phi rename_bij, - rename_inv_simp = Morphism.thm phi rename_inv_simp, + permute_ctor = Morphism.thm phi permute_ctor, + permute_id0 = Morphism.thm phi permute_id0, + permute_id = Morphism.thm phi permute_id, + permute_comp0 = Morphism.thm phi permute_comp0, + permute_comp = Morphism.thm phi permute_comp, FVars_ctors = map (Morphism.thm phi) FVars_ctors, - FVars_renames = map (Morphism.thm phi) FVars_renames, + FVars_permutes = map (Morphism.thm phi) FVars_permutes, FVars_intross = map (map (Morphism.thm phi)) FVars_intross, card_of_FVars_bounds = map (Morphism.thm phi) card_of_FVars_bounds, card_of_FVars_bound_UNIVs = map (Morphism.thm phi) card_of_FVars_bound_UNIVs @@ -141,47 +143,32 @@ fun morph_fp_result_T morph phi { T, ctor, rename, FVars, inner, inject, rename_ type raw_result = { alpha: term, - subshape_rel: term option, - exhaust: thm, - rename_simp: thm, alpha_refl: thm, alpha_sym: thm, alpha_trans: thm, alpha_bij: thm, alpha_bij_eq: thm, + alpha_bij_eq_inv: thm, alpha_FVarss: thm list, alpha_intro: thm, - alpha_elim: thm, - - subshapes: term list option, - wf_subshape: thm option, - set_subshapess: thm list list option, - set_subshape_imagess: thm list list option, - subshape_induct: thm option + alpha_elim: thm }; -fun morph_raw_result phi { alpha, alpha_refl, alpha_sym, alpha_trans, alpha_bij, alpha_bij_eq, - alpha_FVarss, subshapes, wf_subshape, set_subshapess, set_subshape_imagess, subshape_induct, - alpha_intro, exhaust, rename_simp, alpha_elim, subshape_rel } = { +fun morph_raw_result phi { alpha, exhaust, alpha_refl, alpha_sym, alpha_trans, alpha_bij, + alpha_bij_eq, alpha_bij_eq_inv, alpha_FVarss, alpha_intro, alpha_elim } = { alpha = Morphism.term phi alpha, - subshape_rel = Option.map (Morphism.term phi) subshape_rel, exhaust = Morphism.thm phi exhaust, - rename_simp = Morphism.thm phi rename_simp, alpha_refl = Morphism.thm phi alpha_refl, alpha_sym = Morphism.thm phi alpha_sym, alpha_trans = Morphism.thm phi alpha_trans, alpha_bij = Morphism.thm phi alpha_bij, alpha_bij_eq = Morphism.thm phi alpha_bij_eq, + alpha_bij_eq_inv = Morphism.thm phi alpha_bij_eq_inv, alpha_FVarss = map (Morphism.thm phi) alpha_FVarss, alpha_intro = Morphism.thm phi alpha_intro, - alpha_elim = Morphism.thm phi alpha_elim, - subshapes = Option.map (map (Morphism.term phi)) subshapes, - wf_subshape = Option.map (Morphism.thm phi) wf_subshape, - set_subshapess = Option.map (map (map (Morphism.thm phi))) set_subshapess, - set_subshape_imagess = Option.map (map (map (Morphism.thm phi))) set_subshape_imagess, - subshape_induct = Option.map (Morphism.thm phi) subshape_induct + alpha_elim = Morphism.thm phi alpha_elim } : raw_result; type quotient_result = { @@ -189,57 +176,87 @@ type quotient_result = { rep: term, ctor_def: thm, - rename_def: thm, + permute_def: thm, FVars_defs: thm list, + fresh_cases: thm, nnoclash_noclash: thm, - alpha_quotient_sym: thm, + noclash_permute: thm, total_abs_eq_iff: thm, abs_rep: thm, rep_abs: thm, + rep_abs_sym: thm, abs_ctor: thm, - rename_ctor: thm, - rename_cong_id: thm, - fresh_co_induct_param: thm, - fresh_co_induct: thm, - fresh_induct_param_no_clash: thm option + permute_cong: thm, + permute_cong_id: thm, + permute_bij: thm, + permute_inv_simp: thm }; -fun morph_quotient_result phi { abs, rep, alpha_quotient_sym, total_abs_eq_iff, abs_rep, rep_abs, -abs_ctor, rename_def, FVars_defs, ctor_def, rename_ctor, fresh_co_induct, rename_cong_id, -fresh_co_induct_param, nnoclash_noclash, fresh_induct_param_no_clash } = { +fun morph_quotient_result phi { abs, rep, ctor_def, permute_def, FVars_defs, nnoclash_noclash, + total_abs_eq_iff, abs_rep, rep_abs, rep_abs_sym, abs_ctor, permute_cong, permute_cong_id, + permute_bij, permute_inv_simp, noclash_permute, fresh_cases } = { abs = Morphism.term phi abs, rep = Morphism.term phi rep, ctor_def = Morphism.thm phi ctor_def, - rename_def = Morphism.thm phi rename_def, + permute_def = Morphism.thm phi permute_def, FVars_defs = map (Morphism.thm phi) FVars_defs, + fresh_cases = Morphism.thm phi fresh_cases, + noclash_permute = Morphism.thm phi noclash_permute, nnoclash_noclash = Morphism.thm phi nnoclash_noclash, - alpha_quotient_sym = Morphism.thm phi alpha_quotient_sym, total_abs_eq_iff = Morphism.thm phi total_abs_eq_iff, abs_rep = Morphism.thm phi abs_rep, rep_abs = Morphism.thm phi rep_abs, + rep_abs_sym = Morphism.thm phi rep_abs_sym, abs_ctor = Morphism.thm phi abs_ctor, - rename_ctor = Morphism.thm phi rename_ctor, - rename_cong_id = Morphism.thm phi rename_cong_id, - fresh_co_induct_param = Morphism.thm phi fresh_co_induct_param, - fresh_co_induct = Morphism.thm phi fresh_co_induct, - fresh_induct_param_no_clash = Option.map (Morphism.thm phi) fresh_induct_param_no_clash + permute_cong = Morphism.thm phi permute_cong, + permute_cong_id = Morphism.thm phi permute_cong_id, + permute_bij = Morphism.thm phi permute_bij, + permute_inv_simp = Morphism.thm phi permute_inv_simp } : quotient_result; +type least_fp_thms = { + subshape_rel: term, + subshapess: term list list, + wf_subshape: thm, + set_subshapess: thm list list, + set_subshape_permutess: thm list list, + subshape_induct: thm, + existential_induct: thm, + fresh_induct_param: thm, + fresh_induct: thm +}; + +fun morph_least_fp_thms phi ({ subshape_rel, subshapess, wf_subshape, set_subshapess, + set_subshape_permutess, subshape_induct, existential_induct, fresh_induct_param, fresh_induct }) = { + subshape_rel = Morphism.term phi subshape_rel, + subshapess = map (map (Morphism.term phi)) subshapess, + wf_subshape = Morphism.thm phi wf_subshape, + set_subshapess = map (map (Morphism.thm phi)) set_subshapess, + set_subshape_permutess = map (map (Morphism.thm phi)) set_subshape_permutess, + subshape_induct = Morphism.thm phi subshape_induct, + existential_induct = Morphism.thm phi existential_induct, + fresh_induct_param = Morphism.thm phi fresh_induct_param, + fresh_induct = Morphism.thm phi fresh_induct +} : least_fp_thms; + type fp_result = { fp: BNF_Util.fp_kind, - binding_relation: int list list, + binding_relation: int list list list, rec_vars: int list, + bfree_vars: int list, raw_fps: raw_result fp_result_T list, quotient_fps: quotient_result fp_result_T list, + fp_thms: least_fp_thms option, pre_mrbnfs: MRBNF_Def.mrbnf list }; -fun morph_fp_result phi ({ fp, binding_relation, rec_vars, raw_fps, quotient_fps, pre_mrbnfs }) = { - fp = fp, binding_relation = binding_relation, rec_vars = rec_vars, +fun morph_fp_result phi ({ fp, binding_relation, rec_vars, bfree_vars, raw_fps, quotient_fps, fp_thms, pre_mrbnfs }) = { + fp = fp, binding_relation = binding_relation, rec_vars = rec_vars, bfree_vars = bfree_vars, raw_fps = map (morph_fp_result_T morph_raw_result phi) raw_fps, quotient_fps = map (morph_fp_result_T morph_quotient_result phi) quotient_fps, + fp_thms = Option.map (morph_least_fp_thms phi) fp_thms, pre_mrbnfs = map (MRBNF_Def.morph_mrbnf phi) pre_mrbnfs } : fp_result; @@ -268,4 +285,59 @@ fun fp_result_of_generic context = val fp_result_of = fp_result_of_generic o Context.Proof; +fun note_fp_result (fp_res : fp_result) lthy = + let + fun note_internals (quot : quotient_result fp_result_T) = [ + ("permute_ctor", [#permute_ctor quot]), + ("FVars_ctor", #FVars_ctors quot), + ("FVars_intros", flat (#FVars_intross quot)), + ("FVars_bd", #card_of_FVars_bounds quot), + ("FVars_bd_UNIVs", #card_of_FVars_bound_UNIVs quot), + ("nnoclash_noclash", [#nnoclash_noclash (#inner quot)]), + ("total_abs_eq_iff", [#total_abs_eq_iff (#inner quot)]), + ("TT_fresh_cases", [#fresh_cases (#inner quot)]), + ("abs_rep", [#abs_rep (#inner quot)]), + ("rep_abs", [#rep_abs (#inner quot)]), + ("rep_abs_sym", [#rep_abs_sym (#inner quot)]), + ("abs_ctor", [#abs_ctor (#inner quot)]), + ("TT_inject0", [#inject quot]) + ]; + + fun note_always (quot : quotient_result fp_result_T) = [ + ("noclash_permute", [#noclash_permute (#inner quot)]), + ("permute_id0", [#permute_id0 quot]), + ("permute_id", [#permute_id quot]), + ("permute_comp0", [#permute_comp0 quot]), + ("permute_comp", [#permute_comp quot]), + ("FVars_permute", #FVars_permutes quot), + ("permute_cong", [#permute_cong (#inner quot)]), + ("permute_cong_id", [#permute_cong_id (#inner quot)]), + ("permute_bij", [#permute_bij (#inner quot)]), + ("permute_inv_simp", [#permute_inv_simp (#inner quot)]) + ]; + + fun note_quot (quot : quotient_result fp_result_T) = + (if Config.get lthy MRBNF_Def.mrbnf_internals then + note_internals quot + @ the_default [] (Option.map (fn fp_thms => [ + ("wf_subshape", [#wf_subshape fp_thms]), + ("set_subshapes", flat (#set_subshapess fp_thms)), + ("set_subshape_permutes", flat (#set_subshape_permutess fp_thms)), + ("subshape_induct", [#subshape_induct fp_thms]), + ("existential_induct", [#existential_induct fp_thms]), + ("fresh_induct_param", [#fresh_induct_param fp_thms]), + ("TT_fresh_induct", [#fresh_induct fp_thms]) + ]) (#fp_thms fp_res)) + else []) + @ note_always quot; + + val notes = maps (fn quot => map (fn (thmN, thms) => + ((Binding.qualify true (MRBNF_Util.short_type_name (fst (dest_Type (#T quot)))) (Binding.name thmN), []), + [(thms, [])] + ) + ) (note_quot quot)) (#quotient_fps fp_res); + + val (_, lthy) = Local_Theory.notes notes lthy; + in lthy end; + end; \ No newline at end of file diff --git a/Tools/mrbnf_fp_tactics.ML b/Tools/mrbnf_fp_tactics.ML deleted file mode 100644 index efd62937..00000000 --- a/Tools/mrbnf_fp_tactics.ML +++ /dev/null @@ -1,1321 +0,0 @@ -signature MRBNF_FP_TACTICS = -sig - val mk_rename_sel_tac: thm -> thm -> thm -> Proof.context -> thm list -> tactic - val mk_rename_simps_tac: bool -> thm -> thm -> thm list -> thm -> thm -> Proof.context -> - thm list -> tactic - val mk_rename_ids_tac: bool -> thm -> thm list -> thm list -> thm list -> thm list -> thm list -> - thm list -> Proof.context -> tactic - val mk_rename_comps_tac: bool -> thm -> thm list -> thm list -> thm list -> thm list -> - thm list -> thm list -> thm list -> thm list -> Proof.context -> thm list -> tactic - val mk_rename_bij_tac: thm -> thm -> Proof.context -> thm list -> tactic - val mk_rename_inv_simp_tac: thm -> thm -> Proof.context -> thm list -> tactic - - val mk_FVars_ctorss_Tac: thm list -> thm list -> thm -> Proof.context -> tactic - val mk_FVars_rename_les_tac: bool -> thm -> thm list -> thm list -> thm list -> Proof.context -> - thm list -> tactic - val mk_FVars_rename_tac: thm -> thm -> thm -> (thm list -> thm) -> Proof.context -> - thm list -> tactic - val mk_set_level_bound_tac: thm -> thm list -> thm list -> thm list -> thm list -> thm list -> thm list -> - thm list -> Proof.context -> tactic - val mk_FVars_overapprox_tac: bool -> thm -> thm list -> thm list -> thm list -> Proof.context -> - tactic - val mk_co_card_of_FVars_bounds_tac: thm -> thm -> MRBNF_Def.mrbnf -> Proof.context -> tactic - val mk_card_of_FVars_bounds_tac: thm -> thm list -> thm list list -> Proof.context -> tactic - - val mk_alpha_refls_tac: bool -> thm -> (cterm -> thm) list -> thm list -> thm list -> thm list -> - thm list -> Proof.context -> tactic - val mk_alpha_bij_tac: bool -> int -> int -> thm -> thm list -> thm list -> thm list -> thm list -> - thm list -> (thm list -> cterm list -> cterm list -> (thm * (thm list * thm list)) list) -> - thm list -> thm list -> thm list list -> thm list list -> thm list -> Proof.context -> tactic - val mk_alpha_bij_eq_tac: thm -> thm -> (thm list -> thm * thm) -> Proof.context -> - thm list -> tactic - val mk_alpha_bij_eq_inv_tac: (thm list -> thm) -> thm -> Proof.context -> thm list -> tactic - - val mk_alpha_FVars_les_tac: bool -> bool -> bool -> int -> (thm * thm option) list -> thm -> thm list -> thm list -> - thm list -> thm list -> (thm * thm option) list list -> thm list -> Proof.context -> tactic - val mk_alpha_FVars_tac: thm -> thm -> Proof.context -> tactic - val mk_alpha_sym_tac: bool -> int -> thm -> thm list -> thm list -> thm list list -> thm list -> - thm list -> thm list -> (thm * thm list) list list -> Proof.context -> tactic - val mk_alpha_trans_tac: bool -> int -> thm list -> thm -> thm list -> thm list -> thm list -> - thm list -> thm list -> thm list -> thm list list -> (thm * thm list) list list -> - Proof.context -> tactic - - val mk_refresh_set_tac: int -> thm -> thm -> thm list -> thm list -> thm list -> thm list -> - thm list -> thm list -> Proof.context -> thm list -> tactic - val mk_refresh_tac: thm -> thm list -> thm list -> thm -> (thm list -> thm) -> - (cterm list -> thm) -> Proof.context -> thm list -> tactic - val mk_avoid_tac: thm list -> thm -> Proof.context -> thm list -> tactic - val mk_supp_asSS_bound_tac: thm -> Proof.context -> tactic - - val mk_alpha_equivp_tac: thm -> thm -> thm -> Proof.context -> tactic - val mk_TT_abs_ctor_tac: thm -> thm -> thm -> thm list -> thm list -> thm list -> thm -> thm -> - Proof.context -> tactic - val mk_TT_nchotomy_tac: thm -> thm -> thm -> thm -> thm list -> thm list -> thm list -> thm -> - thm -> (cterm -> thm) -> Proof.context -> tactic - val mk_rrename_cctor_tac: thm list -> thm -> thm -> thm list -> thm list -> thm list -> thm -> - thm -> thm -> thm -> thm list -> Proof.context -> thm list -> tactic - - val mk_FFVars_cctor_tac: thm -> thm -> thm list -> thm list -> thm list -> thm list -> - Proof.context -> tactic - val mk_FFVars_intro_tac: thm list -> thm -> thm -> thm list -> thm -> Proof.context -> tactic - val mk_FFVars_elim_tac: thm -> thm list -> Proof.context -> tactic - val mk_FFVars_induct_tac: bool -> thm list -> thm list -> thm list -> thm list -> thm -> - thm list -> thm list -> Proof.context -> thm list -> tactic - - val mk_TT_inject0_tac: int -> thm -> thm -> thm -> thm -> thm list -> thm -> thm list -> - thm list -> thm list -> thm list -> thm list -> thm -> thm list -> thm list -> thm list -> - thm list -> Proof.context -> tactic - val mk_aavoid_tac: thm -> thm -> thm -> thm -> thm list -> thm list -> thm list -> thm -> thm -> - thm list -> thm list -> thm -> thm -> thm -> Proof.context -> thm list -> tactic - val mk_TT_fresh_cases_tac: thm -> thm -> thm list -> Proof.context -> thm list -> tactic - - val mk_subshape_induct_raw_tac: int -> int -> thm list -> thm list -> thm list -> thm list -> - thm list -> thm list -> (Proof.context -> term list -> term list -> term list -> thm list -> - thm list) list -> (term list -> term list -> thm list list) list -> thm -> thm list list -> - thm list -> thm list -> thm list list -> thm list list list -> Proof.context -> thm list -> - tactic - val mk_subshape_induct_tac: int -> thm -> thm list -> thm list -> thm list -> thm list -> - Proof.context -> thm list -> tactic - val mk_alpha_subshape_tac: int -> thm -> thm -> thm -> (term list -> term list -> thm list) -> - (term list -> thm option list) -> thm list -> thm -> thm -> thm list -> Proof.context -> tactic - val mk_set_subshape_image_tac: int -> int -> thm list -> thm list -> thm list -> thm list -> Proof.context -> thm list -> tactic - - val mk_TT_existential_induct_tac: thm list -> thm list -> thm -> (thm * thm) list -> thm list -> - thm list -> thm list -> thm list -> thm list -> (thm -> term -> term -> thm) list -> thm list -> - thm list -> thm list list -> thm list list -> thm list -> thm list -> thm list list -> - (term -> thm) list -> thm list list -> Proof.context -> thm list -> tactic - val mk_TT_fresh_induct_param_tac: thm -> (term -> term -> thm) list -> thm list -> - thm list list -> Proof.context -> thm list -> tactic - val mk_TT_fresh_induct_param_no_clash_tac: int -> int -> (term * thm) list -> thm -> thm list -> thm list -> - thm list -> thm list -> Proof.context -> thm list -> tactic - - val mk_alpha'_bij_eq_invs_tac: int -> thm -> thm list -> (term list -> term list -> thm list) -> - bool -> thm -> thm list -> thm list -> thm list -> thm list -> thm list -> thm list -> - thm list list -> thm list list -> thm list -> thm list -> Proof.context -> thm list -> tactic - val mk_alpha'_bij_eq_inv'_tac: thm -> thm -> thm -> Proof.context -> thm list -> tactic - val mk_alpha_imp_alpha's_tac: bool -> int -> thm -> thm list -> thm list -> thm list -> - thm list -> Proof.context -> tactic - val mk_alpha'_imp_alphas_tac: int -> thm -> thm list -> (term list -> term list -> thm list) -> - bool -> thm list -> thm list -> thm list -> thm list -> thm list -> thm list -> thm list -> - thm list -> thm list list -> Proof.context -> tactic - - val mk_TT_existential_coinduct_tac: int -> int -> thm list -> thm -> thm list -> thm list -> - thm list -> thm list -> thm list -> thm list -> thm -> thm list -> thm list -> thm list -> - thm list -> thm list -> thm list -> thm list list -> thm list -> thm list -> thm list -> - thm list -> bool -> Proof.context -> thm list -> tactic - val mk_TT_fresh_coinduct_param_tac: int -> thm -> thm list -> Proof.context -> thm list -> tactic - - val mk_rrename_id_tac: thm -> thm -> thm -> Proof.context -> tactic - val mk_rrename_comp_tac: thm -> thm -> thm -> thm -> thm -> thm -> thm -> thm -> Proof.context -> - thm list -> tactic - val mk_rrename_cong_id_tac: thm list -> thm -> thm -> thm -> thm -> thm -> Proof.context -> - thm list -> tactic -end; - -structure MRBNF_Fp_Tactics : MRBNF_FP_TACTICS = -struct - -open MRBNF_Util -open BNF_Tactics - -fun mk_rename_sel_tac map_comp rename_simp raw_sel ctxt assms = simp_only ctxt - (assms @ [map_comp, rename_simp, raw_sel] @ @{thms supp_id_bound bij_id id_o o_id}) - |> HEADGOAL; - -fun mk_rename_simps_tac co map_comp rename_simp rename_sel raw_sel raw_collapse ctxt assms = - (if co then simp_only_plus ctxt - (assms @ rename_sel @ [raw_sel]) [rtac ctxt (trans OF [raw_collapse RS sym])] - else REPEAT_DETERM o simp_only_tac ctxt - (assms @ [map_comp, rename_simp] @ @{thms supp_id_bound bij_id id_o o_id})) - |> HEADGOAL; - -fun mk_rename_ids_tac co common_co_induct_inst rename_simps raw_injects map_cong_thms rename_sels - mr_rel_maps rel_refl_ids ctxt = - if co - then EVERY1 [rtac ctxt common_co_induct_inst, REPEAT_DETERM o etac ctxt conjE, - REPEAT_DETERM o (dtac ctxt @{thm mp[OF _ exI]} THEN' rtac ctxt @{thm conjI[OF refl refl]}), - REPEAT_DETERM o rtac ctxt @{thm conjI[rotated]} THEN_ALL_NEW assume_tac ctxt, - asm_simp_only_plus ctxt (rename_sels @ raw_injects @ mr_rel_maps @ @{thms bij_id id_apply - supp_id_bound id_o relcompp_apply Grp_def simp_thms UNIV_I}) - [resolve_tac ctxt (rel_refl_ids @ @{thms exI[of "\x. _ x \ _ x = _ x", OF conjI[OF _ refl]]}), - etac ctxt exE]] - else EVERY1 [rtac ctxt common_co_induct_inst, simp_only_plus ctxt - (rename_simps @ raw_injects @ @{thms bij_id id_def[symmetric] id_apply supp_id_bound}) - [resolve_tac ctxt map_cong_thms, Goal.assume_rule_tac ctxt]]; - -fun mk_rename_comps_tac co common_co_induct_inst raw_injects rename_simps supp_comp_bounds map_comps - map_congs rename_sels mr_rel_maps rel_refl_ids ctxt assms = - if co - then EVERY1 [rtac ctxt common_co_induct_inst, REPEAT_DETERM o etac ctxt conjE, - REPEAT_DETERM o (dtac ctxt @{thm mp[OF _ exI]} THEN' rtac ctxt @{thm conjI[OF refl refl]}), - REPEAT_DETERM o rtac ctxt @{thm conjI[rotated]} THEN_ALL_NEW assume_tac ctxt, - asm_simp_only_plus ctxt (assms @ raw_injects @ rename_sels @ mr_rel_maps @ @{thms bij_id - id_apply supp_id_bound id_o relcompp_apply Grp_def simp_thms UNIV_I o_id bij_comp - bij_imp_bij_inv supp_inv_bound conversep_iff o_assoc inv_o_simp1 - rewriteR_comp_comp[OF inv_o_simp1]} @ supp_comp_bounds) - [resolve_tac ctxt (rel_refl_ids @ @{thms exI[of "\x. _ x \ _ x = _ x", OF conjI[OF _ refl]]}), - etac ctxt exE]] - else EVERY1 [rtac ctxt common_co_induct_inst, simp_only_plus ctxt - (assms @ raw_injects @ rename_simps @ map_comps @ - @{thms bij_comp o_apply o_def[of v u,symmetric] id_apply id_o} @ supp_comp_bounds) - [resolve_tac ctxt map_congs, Goal.assume_rule_tac ctxt]]; - -fun split_prems [] = [] - | split_prems (x::y::xs) = (x, y)::split_prems xs - -fun mk_rename_bij_tac rename_comp0 rename_id0 ctxt prems = - EVERY1 [ - rtac ctxt @{thm iffD2[OF Prelim.bij_iff]}, - rtac ctxt exI, - rtac ctxt conjI, - rtac ctxt trans, - rtac ctxt rename_comp0, - REPEAT_DETERM o match_tac ctxt prems, - REPEAT_DETERM o EVERY' (map (fn (bij, supp) => EVERY' [ - rtac ctxt @{thm bij_imp_bij_inv}, - rtac ctxt bij, - rtac ctxt @{thm supp_inv_bound}, - rtac ctxt bij, - rtac ctxt supp - ]) (split_prems prems)), - Method.insert_tac ctxt prems, - K (unfold_thms_tac ctxt @{thms inv_o_simp1}), - rtac ctxt rename_id0, - rtac ctxt trans, - rtac ctxt rename_comp0, - REPEAT_DETERM o resolve_tac ctxt (@{thms supp_inv_bound bij_imp_bij_inv} @ prems), - Method.insert_tac ctxt prems, - K (unfold_thms_tac ctxt @{thms inv_o_simp2}), - rtac ctxt rename_id0 - ]; - -fun mk_rename_inv_simp_tac rename_comp0 rename_id0 ctxt prems = - EVERY1 [ - rtac ctxt @{thm inv_unique_comp}, - rtac ctxt trans, - rtac ctxt rename_comp0, - REPEAT_DETERM o resolve_tac ctxt (@{thms bij_imp_bij_inv supp_inv_bound} @ prems), - Method.insert_tac ctxt prems, - K (unfold_thms_tac ctxt @{thms inv_o_simp2}), - rtac ctxt rename_id0, - rtac ctxt trans, - rtac ctxt rename_comp0, - REPEAT_DETERM o resolve_tac ctxt (@{thms bij_imp_bij_inv supp_inv_bound} @ prems), - Method.insert_tac ctxt prems, - K (unfold_thms_tac ctxt @{thms inv_o_simp1}), - rtac ctxt rename_id0 - ]; - -fun mk_FVars_ctorss_Tac raw_injects FVars_intros FVars_elim ctxt = - EVERY1 [rtac ctxt @{thm subset_antisym}, rtac ctxt subsetI, REPEAT_DETERM o rtac ctxt @{thm UnCI}, - etac ctxt FVars_elim THEN_ALL_NEW ([unfold_tac ctxt raw_injects |> K, hyp_subst_tac ctxt, - TRY o assume_tac ctxt] |> EVERY'), - REPEAT_DETERM o ([etac ctxt notE, TRY o rtac ctxt @{thm DiffI}, rtac ctxt @{thm UN_I}, - REPEAT_DETERM1 o assume_tac ctxt] |> EVERY'), rtac ctxt subsetI, - REPEAT_DETERM o etac ctxt UnE, REPEAT_DETERM o ([TRY o etac ctxt @{thm DiffE}, - TRY o etac ctxt @{thm UN_E}, resolve_tac ctxt FVars_intros, REPEAT_DETERM1 o assume_tac ctxt] - |> EVERY')]; - -fun mk_FVars_rename_les_tac mutual FVars_induct FVars_intros rename_simps set_maps ctxt assms = - (if mutual then [rtac ctxt FVars_induct] else [rtac ctxt impI, etac ctxt FVars_induct]) @ - [map (op OF o rpair assms) rename_simps |> K o unfold_tac ctxt, - map (rtac ctxt) FVars_intros |> RANGE, simp_only_plus ctxt - (assms @ set_maps @ @{thms bij_implies_inject}) [hyp_subst_tac ctxt, - resolve_tac ctxt [imageI, notI], eresolve_tac ctxt [imageE, notE]]] |> EVERY1; - -fun mk_FVars_rename_tac rename_comp rename_id FVars_rename_le mk_FVars_rename_le_alt ctxt assms = - EVERY1 [rtac ctxt @{thm set_eqI}, rtac ctxt iffI, dtac ctxt (mk_FVars_rename_le_alt assms) - THEN_ALL_NEW simp_only_plus ctxt ([rename_comp, rename_id] @ assms @ - @{thms supp_inv_bound bij_imp_bij_inv inv_o_simp1 simp_thms inv_simp2}) - [etac ctxt @{thm image_eqI[rotated]}], etac ctxt imageE, - dtac ctxt (FVars_rename_le RS mp OF assms), hyp_subst_tac ctxt, assume_tac ctxt]; - -fun mk_set_level_bound_tac nat_induct set_level_simps raw_splits ifcos Un_bounds UNION_bounds - free_set_bounds rec_set_boundss ctxt = - let - val Cinfinites = map (fn thm => @{thm infinite_regular_card_order.Cinfinite} OF [thm]) ifcos - val Un_bounds = map (fn ifco => @{thm infinite_regular_card_order_Un} OF [ifco]) ifcos; - val UNION_bounds = map (fn ifco => - @{thm regularCard_UNION_bound} OF [ - @{thm infinite_regular_card_order.Cinfinite} OF [ifco], - @{thm infinite_regular_card_order.regularCard} OF [ifco] - ]) ifcos; - in EVERY1 [ - rtac ctxt nat_induct, - asm_simp_only_plus ctxt (set_level_simps @ @{thms simp_thms}) [ - split_tac ctxt (raw_splits @ @{thms sum.split}), - resolve_tac ctxt (@{thms Cinfinite_gt_empty} @ Cinfinites - @ @{thms conjI allI impI} - @ Un_bounds @ UNION_bounds @ free_set_bounds @ rec_set_boundss - ) - ] - ] end; - -fun mk_FVars_overapprox_tac mutual FVars_induct set_level_simps raw_injects raw_splits ctxt = - (if mutual then [rtac ctxt FVars_induct] else [rtac ctxt impI, etac ctxt FVars_induct]) @ - [simp_only_plus ctxt - (set_level_simps @ raw_injects @ @{thms UN_iff bex_UNIV sum.inject Inl_Inr_False Inr_Inl_False}) - [split_tac ctxt (raw_splits @ @{thms sum.split}), resolve_tac ctxt [conjI, allI, impI], - eresolve_tac ctxt [exE, conjE], hyp_subst_tac ctxt, - EVERY' [REPEAT o resolve_tac ctxt [UnI1, UnI2], - TRY o (rtac ctxt @{thm UN_I} THEN' assume_tac ctxt), assume_tac ctxt], - rtac ctxt @{thm exI[of _ "Suc _"]}]] |> EVERY1; - -fun mk_co_card_of_FVars_bounds_tac FVars_overapprox UNION_bound mrbnf ctxt = - EVERY1 [ - rtac ctxt (@{thm ordLeq_ordLess_trans} OF [ - @{thm card_of_mono1} OF [subsetI OF [FVars_overapprox]] - ]), - assume_tac ctxt, - rtac ctxt UNION_bound, - rtac ctxt @{thm ordLess_Field[of natLeq, unfolded Field_natLeq]}, - rtac ctxt @{thm natLeq_ordLess_cinfinite}, - rtac ctxt (MRBNF_Def.bd_Cinfinite_of_mrbnf mrbnf), - rtac ctxt (MRBNF_Def.bd_card_order_of_mrbnf mrbnf) - ]; - -fun mk_card_of_FVars_bounds_tac common_co_induct_inst FVars_ctors intross ctxt = - [rtac ctxt common_co_induct_inst] @ map (fn intros => - simp_only_subgoal ctxt FVars_ctors - [resolve_tac ctxt (intros @ @{thms ordLeq_ordLess_trans[OF card_of_diff]}), - Goal.assume_rule_tac ctxt]) - intross |> EVERY1; - -fun mk_alpha_refls_tac mutual alpha_coinduct mk_cases raw_injects rename_ids - mrbnf_rel_refl_strong_ids alpha_intros ctxt = - let - fun subgoal_tac mk_case focus = rtac (#context focus) (#params focus |> hd |> snd |> mk_case) - |> HEADGOAL; - fun mk_subgoal_tac ctxt mk_case = Subgoal.FOCUS_PARAMS (subgoal_tac mk_case) ctxt; - in - (if mutual then [rtac ctxt alpha_coinduct] else [rtac ctxt allI, rtac ctxt allI, rtac ctxt impI, - etac ctxt alpha_coinduct, simp_only ctxt @{thms triv_forall_equality}]) @ - [map (mk_subgoal_tac ctxt) mk_cases |> RANGE, simp_only_plus ctxt - (raw_injects @ rename_ids @ @{thms supp_id_bound bij_id ex_simps simp_thms id_on_id}) - [resolve_tac ctxt (mrbnf_rel_refl_strong_ids @ alpha_intros @ @{thms exI[of _ id] conjI}), - hyp_subst_tac ctxt]] |> EVERY1 - end; - -fun mk_alpha_bij_tac mutual fbound num_bindings alpha_coinduct alpha_elims rename_simps - FVars_renames rename_comps raw_injects mk_exIss FVars_ctors supp_comp_bounds mr_rel_maps set_maps - mr_rel_mono_strong0s ctxt = - let - fun main_simp_tac bij_imp_injects supp_comp_bound mr_rel_map set_map mr_rel_mono_strong0 ctxt = - asm_simp_only_all_new ctxt (supp_comp_bound :: rename_simps @ mr_rel_map @ FVars_ctors @ - FVars_renames @ set_map @ rename_comps @ raw_injects @ bij_imp_injects @ - @{thms supp_inv_bound bij_comp bij_imp_bij_inv - supp_id_bound bij_id o_assoc o_id id_o inv_o_simp1 - id_on_def o_apply image_iff inv_simp1 bex_triv_one_point2 - Ball_def Un_iff Diff_iff UN_iff id_apply bij_inv_rev vimage2p_Grp[symmetric] vimage2p_def - rewriteR_comp_comp[OF inv_o_simp1] imp_conjL[symmetric] simp_thms ex_simps}) - [eresolve_tac ctxt (Drule.rotate_prems (6*fbound) mr_rel_mono_strong0 :: - @{thms disjE conjE bexE}), resolve_tac ctxt @{thms conjI allI impI disjCI}]; - - fun solve_tac ctxt = asm_simp_only_plus ctxt - @{thms simp_thms Bex_def imp_disjL all_conj_distrib} - [etac ctxt conjE, EVERY' [etac ctxt allE, etac ctxt impE, rtac ctxt conjI, - rtac ctxt exI, rtac ctxt conjI, assume_tac ctxt, assume_tac ctxt, assume_tac ctxt], - EVERY' [etac ctxt allE, etac ctxt impE, rtac ctxt exI, rtac ctxt conjI, - assume_tac ctxt, assume_tac ctxt]] |> SELECT_GOAL o HEADGOAL; - - fun simplify_tac rename_comp ctxt = asm_simp_only_plus ctxt (rename_comp :: - FVars_renames @ @{thms image_id mem_Collect_eq Bex_def o_assoc[symmetric] - inv_o_simp1 o_id supp_id_bound bij_id id_apply}) - [resolve_tac ctxt @{thms conjI impI allI}, etac ctxt exE]; - - fun subgoal_solve_tac ctxt (rename_comp, thmss) = - let - fun repeat_alt tac1 tac2 = tac1 THEN' REPEAT_DETERM o (tac2 THEN' tac1); - val (tac1, tac2) = apply2 (EVERY' o map (rtac ctxt)) thmss; - val tac3 = repeat_alt (simplify_tac rename_comp ctxt) (solve_tac ctxt); - in - [rtac ctxt exI, rtac ctxt exI, etac ctxt conjI, tac1, - rtac ctxt @{thm conjI[rotated]}, tac2, tac3] |> SELECT_GOAL o EVERY1 - end; - - fun mk_exIs fs fs' gs = - let - fun mk_exI f f' g = infer_instantiate' ctxt [NONE, SOME f', SOME g, SOME f] - @{thm exI[of _ "f' o g o inv f" for f' g f]}; - in - @{map 3} mk_exI fs fs' gs - end; - - fun main_subgoal_tac supp_comp_bound mr_rel_map set_map mr_rel_mono_strong0 focus = - let - val ctxt = #context focus; - val ((fs, fs'), gs) = #params focus |> map snd |> drop 4 |> chop fbound - ||>> chop fbound ||> take fbound; - val tac1 = mk_exIs fs fs' gs |> map (rtac ctxt) |> EVERY'; - val bij_imp_injects = map - (fn f => infer_instantiate' ctxt [SOME f] @{thm bij_implies_inject}) fs; - val tac2 = main_simp_tac bij_imp_injects supp_comp_bound mr_rel_map set_map - mr_rel_mono_strong0 ctxt; - val tac3 = replicate num_bindings (solve_tac ctxt) |> EVERY'; - val tac4 = map (subgoal_solve_tac ctxt) (mk_exIss rename_comps fs fs') |> EVERY'; - in - EVERY1 [tac1, tac2, tac3, tac4] - end; - val main_subgoal_tacs = @{map 4} main_subgoal_tac supp_comp_bounds mr_rel_maps set_maps - mr_rel_mono_strong0s |> map (fn tac => Subgoal.FOCUS_PARAMS tac ctxt); - in - (if mutual then [rtac ctxt alpha_coinduct THEN_ALL_NEW - (REPEAT_DETERM o (eresolve_tac ctxt @{thms exE conjE} ORELSE' hyp_subst_tac ctxt))] else - [rtac ctxt allI, rtac ctxt allI, rtac ctxt impI, etac ctxt alpha_coinduct THEN_ALL_NEW - (simp_only ctxt @{thms triv_forall_equality} THEN' REPEAT_DETERM o - (eresolve_tac ctxt @{thms exE conjE} ORELSE' hyp_subst_tac ctxt))]) @ - [map (etac ctxt) alpha_elims |> RANGE, RANGE main_subgoal_tacs] |> EVERY1 - end; - -fun mk_alpha_bij_eq_tac rename_comp rename_id mk_alpha_bij_alts ctxt assms = - let - val (alpha_bij_inv, alpha_bij) = mk_alpha_bij_alts assms; - in - EVERY1 [rtac ctxt iffI, dtac ctxt alpha_bij_inv THEN_ALL_NEW - (simp_only_plus ctxt (assms @ [rename_comp, rename_id] @ - @{thms supp_inv_bound bij_imp_bij_inv inv_o_simp1}) [rtac ctxt ballI]), - etac ctxt alpha_bij THEN_ALL_NEW (simp_only_tac ctxt @{thms refl ball_triv simp_thms})] - end; - -fun mk_alpha_bij_eq_inv_tac mk_rename_comp_alt alpha_bij_eq ctxt assms = - EVERY1 [EqSubst.eqsubst_tac ctxt [0] [mk_rename_comp_alt assms], REPEAT_DETERM o - simp_only_tac ctxt (alpha_bij_eq :: assms @ @{thms bij_imp_bij_inv supp_inv_bound})]; - -fun mk_alpha_FVars_les_tac mutual reverse prime num_unions alpha_bij_eq_invs FVars_induct alpha_elims - raw_injects FVars_renames FVars_ctors set_transfers supp_comp_bounds ctxt = - let - val in_cong2 = @{thm arg_cong2[of _ _ _ _ "(\)"]} - - fun id_on_tac reverse ctxt = EVERY' [ - etac ctxt @{thm id_onD}, - REPEAT_DETERM o (EVERY' [ - TRY o rtac ctxt @{thm UnI1}, - rtac ctxt @{thm DiffI}, - rtac ctxt @{thm UN_I}, - assume_tac ctxt, - assume_tac ctxt, - if not reverse then assume_tac ctxt else EVERY' [ - rtac ctxt @{thm iffD2[OF arg_cong[of _ _ Not]]}, - rtac ctxt @{thm inj_image_mem_iff[OF bij_is_inj, symmetric]}, - K (prefer_tac 2), - rtac ctxt @{thm iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]}, - rtac ctxt sym, - assume_tac ctxt, - assume_tac ctxt, - assume_tac ctxt - ] - ] ORELSE' rtac ctxt @{thm UnI2}) - ]; - - fun subgoal_solve_tac alpha_bij_eq_inv i (set_transfer, set_transfer_opt) = - let - val UnI = BNF_Util.mk_UnIN num_unions i; - val set_transfer_tac = EVERY' [ - REPEAT_DETERM o FIRST' [ - resolve_tac ctxt (@{thms bij_comp bij_imp_bij_inv supp_inv_bound} @ supp_comp_bounds), - assume_tac ctxt - ], - SELECT_GOAL (unfold_thms_tac ctxt @{thms Grp_def image_id}) - ]; - in SELECT_GOAL (EVERY1 [ - rtac ctxt UnI, - case set_transfer_opt of - NONE => K all_tac - | SOME set_transfer => EVERY' [ - forward_tac ctxt [set_transfer], - set_transfer_tac - ], - dtac ctxt set_transfer, - set_transfer_tac, - TRY o dtac ctxt conjunct1, - EVERY' [ - resolve_tac ctxt [iffD2 OF [in_cong2 OF [refl]], iffD1 OF [in_cong2 OF [refl]]], - assume_tac ctxt, - assume_tac ctxt - ] ORELSE' EVERY' [ - dtac ctxt (if reverse then @{thm rel_setD2} else @{thm rel_setD1}), - assume_tac ctxt, - etac ctxt bexE, - if reverse then K all_tac else TRY o EVERY' [ - dresolve_tac ctxt (map (fn (thm1, thm2) => Drule.rotate_prems ~1 (case thm2 of - SOME _ => thm1 - | NONE => iffD1 OF [thm1] - )) alpha_bij_eq_inv), - REPEAT_DETERM o (resolve_tac ctxt @{thms bij_id supp_id_bound} ORELSE' assume_tac ctxt), - TRY o EVERY' [ - EqSubst.eqsubst_asm_tac ctxt [0] (map_filter snd alpha_bij_eq_inv), - REPEAT_DETERM o FIRST' [ - resolve_tac ctxt @{thms bij_id supp_id_bound bij_imp_bij_inv supp_inv_bound}, - assume_tac ctxt - ] - ] - ], - etac ctxt allE, - etac ctxt impE, - assume_tac ctxt, - TRY o EVERY' [ - EqSubst.eqsubst_asm_tac ctxt [0] FVars_renames, - REPEAT_DETERM o FIRST' [ - resolve_tac ctxt (@{thms supp_inv_bound bij_imp_bij_inv bij_id supp_id_bound bij_comp} @ supp_comp_bounds), - assume_tac ctxt - ], - K (unfold_thms_tac ctxt @{thms inv_id image_id}) - ], - EVERY' [ - rtac ctxt @{thm UN_I}, - assume_tac ctxt, - assume_tac ctxt - ] ORELSE' EVERY' [ - if reverse then - etac ctxt imageE THEN' hyp_subst_tac ctxt - else EVERY' [ - EqSubst.eqsubst_asm_tac ctxt [0] @{thms image_in_bij_eq}, - REPEAT_DETERM o (resolve_tac ctxt @{thms bij_comp bij_imp_bij_inv} ORELSE' assume_tac ctxt), - TRY o EVERY' [ - EqSubst.eqsubst_asm_tac ctxt [0] @{thms o_inv_distrib}, - REPEAT_DETERM o (resolve_tac ctxt @{thms bij_comp bij_imp_bij_inv} ORELSE' assume_tac ctxt) - ], - K (unfold_thms_tac ctxt @{thms inv_inv_eq}) - ], - if prime then EVERY' [ - rtac ctxt @{thm iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]}, - rtac ctxt @{thm id_on_image[symmetric]}, - assume_tac ctxt, - rtac ctxt @{thm iffD2[OF image_in_bij_eq]}, - assume_tac ctxt - ] else K all_tac, - rtac ctxt @{thm DiffI}, - rtac ctxt @{thm UN_I}, - assume_tac ctxt, - rtac ctxt @{thm subst[rotated, of "\x. x \ _"]}, - assume_tac ctxt, - if reverse then rtac ctxt sym else K all_tac, - TRY o EVERY' [ - rtac ctxt @{thm trans[OF comp_apply]}, - rtac ctxt @{thm arg_cong[of _ _ "inv _"]} - ], - id_on_tac reverse ctxt, - if reverse then K all_tac else EVERY' [ - rtac ctxt @{thm iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]}, - assume_tac ctxt - ], - if prime then EVERY' [ - K (unfold_thms_tac ctxt @{thms image_comp[symmetric]}), - rtac ctxt @{thm iffD2[OF arg_cong[of _ _ Not]]}, - rtac ctxt @{thm inj_image_mem_iff[OF bij_is_inj]}, - rtac ctxt @{thm bij_imp_bij_inv}, - assume_tac ctxt - ] else K all_tac, - rtac ctxt @{thm iffD2[OF arg_cong2[OF _ refl, of _ _ "(\)"]]}, - if reverse then K all_tac else EVERY' [ - K (prefer_tac 2), - rtac ctxt @{thm not_imageI}, - assume_tac ctxt, - assume_tac ctxt, - rtac ctxt sym - ], - id_on_tac reverse ctxt, - if not reverse then K all_tac else EVERY' [ - rtac ctxt @{thm iffD2[OF arg_cong[of _ _ Not]]}, - rtac ctxt @{thm inj_image_mem_iff[OF bij_is_inj, symmetric]}, - K (prefer_tac 2), - rtac ctxt @{thm iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]}, - rtac ctxt sym, - assume_tac ctxt, - assume_tac ctxt, - assume_tac ctxt - ] - ] - ] - ]) end; - in - EVERY1 [ - (if mutual then rtac ctxt FVars_induct else rtac ctxt impI THEN' etac ctxt FVars_induct) - THEN_ALL_NEW EVERY' [ - rtac ctxt allI, - rtac ctxt impI, - eresolve_tac ctxt alpha_elims, - dresolve_tac ctxt (map (fn thm => iffD1 OF [thm]) raw_injects), - hyp_subst_tac ctxt - ], - K (unfold_thms_tac ctxt FVars_ctors), - RANGE (maps (@{map 3} subgoal_solve_tac ([] :: map single alpha_bij_eq_invs) (1 upto num_unions)) set_transfers) - ] - end; - -fun mk_alpha_FVars_tac alpha_FVars_le_left alpha_FVars_le_right ctxt = - EVERY1 [rtac ctxt @{thm set_eqI}, rtac ctxt iffI, etac ctxt alpha_FVars_le_left, assume_tac ctxt, - etac ctxt alpha_FVars_le_right, assume_tac ctxt]; - -local - -fun fbound_var_tacs ctxt FVars_renames alpha_FVarsss settss = - let - fun mk_fbound_var_tac ctxt (bound_sett, b_setts) alpha_FVarss = - let - fun mk_b_tac thm = EVERY' - [forward_tac ctxt [thm] THEN_ALL_NEW simp_only_tac ctxt FVars_renames, - dtac ctxt @{thm rel_set_mono[OF predicate2I, THEN predicate2D, rotated -1]}, - eresolve_tac ctxt alpha_FVarss, dtac ctxt @{thm rel_set_UN_D[symmetric]}]; - val b_tac = map mk_b_tac b_setts |> EVERY'; - in - [rtac ctxt conjI, forward_tac ctxt [bound_sett] THEN_ALL_NEW simp_only_tac ctxt - @{thms Grp_def}, dtac ctxt conjunct1, b_tac, asm_simp_only ctxt (FVars_renames @ - @{thms image_UN[symmetric] bij_id supp_id_bound image_id id_apply id_on_comp - image_set_diff[symmetric] bij_is_inj id_on_image id_on_Un id_on_inv})] |> EVERY' - end; - in - map2 (mk_fbound_var_tac ctxt) settss alpha_FVarsss |> EVERY' - end; - -in - -fun mk_alpha_sym_tac mutual fbound alpha_coinduct alpha_elims FVars_renames alpha_FVarsss - alpha_bij_eq_invs mr_rel_flips mr_rel_mono_strong0s settsss ctxt = - let - fun mk_exI ct = infer_instantiate' ctxt [NONE, SOME ct] @{thm exI[of _ "inv f" for f]}; - fun subgoal_tac focus = - let - val ctxt = #context focus; - val fs = #params focus |> map snd |> drop 2 |> take fbound; - in - REPEAT_DETERM o FIRST' [resolve_tac ctxt (map mk_exI fs @ @{thms exI}), - rtac ctxt conjI THEN' rtac ctxt refl] |> HEADGOAL - end; - - fun mk_mrbnf_tac mr_rel_flip mr_rel_mono_strong0 settss = - EVERY' [Subgoal.FOCUS_PARAMS subgoal_tac ctxt, 2*fbound+1 |> rtac ctxt o mk_conjIN, - REPEAT_DETERM_N fbound o EVERY' [etac ctxt @{thm bij_imp_bij_inv}, - rtac ctxt @{thm supp_inv_bound} THEN_ALL_NEW assume_tac ctxt], - fbound_var_tacs ctxt FVars_renames alpha_FVarsss settss, rtac ctxt (mr_rel_flip RS iffD1), - asm_simp_only_plus ctxt (alpha_bij_eq_invs @ - @{thms supp_inv_bound bij_imp_bij_inv id_on_inv inv_id bij_id supp_id_bound inv_inv_eq - conversep_eq conversep_iff simp_thms}) [resolve_tac ctxt @{thms ballI impI}, - Drule.rotate_prems (6*fbound) mr_rel_mono_strong0 |> etac ctxt] - |> REPEAT_DETERM_N (4*fbound+1) oo SELECT_GOAL o HEADGOAL]; - in - (if mutual then [] else [rtac ctxt allI, rtac ctxt allI, rtac ctxt impI]) @ - [(if mutual then rtac else etac) ctxt alpha_coinduct THEN_ALL_NEW - ((if mutual then [] else [simp_only ctxt @{thms triv_forall_equality}]) @ - [eresolve_tac ctxt alpha_elims, hyp_subst_tac ctxt] |> EVERY'), - @{map 3} mk_mrbnf_tac mr_rel_flips mr_rel_mono_strong0s settsss |> EVERY'] |> EVERY1 - end; - -fun mk_alpha_trans_tac mutual fbound supp_comp_bounds alpha_coinduct alpha_elims raw_injects - rename_comps alpha_bijs mr_rel_mono_alts FVars_renames alpha_FVarsss settsss ctxt = - let - fun mk_exI thm cts = infer_instantiate' ctxt (NONE :: cts) thm; - fun subgoal_tac focus = - let - val ctxt = #context focus; - val (((fs, x), gs), z) = #params focus |> map (SOME o snd) |> drop 3 |> chop fbound - ||>> chop 1 ||> drop 1 ||>> chop fbound ||> drop 1 ||> take 1; - val args1 = transpose [gs, fs]; - val args2 = [x, z]; - val exIs = map (mk_exI @{thm exI[of _ "g o f" for g f]}) args1 @ map (mk_exI exI) args2; - in - map (rtac ctxt) exIs |> EVERY1 - end; - - fun mk_mrbnf_tac ctxt supp_comp_bound mr_rel_mono_alt settss = - EVERY' [Subgoal.FOCUS_PARAMS subgoal_tac ctxt, asm_simp_only ctxt (supp_comp_bound :: - raw_injects @ @{thms bij_comp simp_thms}), hyp_subst_tac ctxt, - fbound_var_tacs ctxt FVars_renames alpha_FVarsss settss, etac ctxt mr_rel_mono_alt THEN' - assume_tac ctxt THEN_ALL_NEW asm_simp_only_plus ctxt (supp_comp_bound :: - @{thms supp_id_bound bij_id bij_comp eq_OO relcompp_apply simp_thms} @ rename_comps) - [resolve_tac ctxt @{thms predicate2I disjCI}, eresolve_tac ctxt @{thms exE conjE}], - EVERY' (map (fn thm => EVERY' [rtac ctxt exI, etac ctxt @{thm conjI[rotated]}, etac ctxt thm - THEN_ALL_NEW simp_only_tac ctxt @{thms supp_id_bound bij_id refl ball_triv simp_thms}]) - alpha_bijs)]; - in - (if mutual then [] else [rtac ctxt allI, rtac ctxt allI, rtac ctxt impI]) @ - [(if mutual then rtac else etac) ctxt alpha_coinduct THEN_ALL_NEW ((if mutual then K all_tac - else simp_only ctxt @{thms triv_forall_equality}) THEN' REPEAT_DETERM o eresolve_tac ctxt - (@{thms exE conjE} @ alpha_elims) THEN' hyp_subst_tac ctxt), @{map 3} (mk_mrbnf_tac ctxt) - supp_comp_bounds mr_rel_mono_alts settsss |> EVERY'] |> EVERY1 - end; - -end; - -fun mk_refresh_set_tac fbound mrbnf_var_infinite Un_bound insert_thms mrbnf_set_bounds - card_of_FVarsB_bounds exI_thms extU_thms set_map ctxt assms = - let - fun insert_tac insert_thm set_bound card_of_FVarsB_bound assm = - EVERY' [Method.insert_tac ctxt [insert_thm], dtac ctxt meta_mp, - rtac ctxt @{thm ordLess_ordIso_trans}, rtac ctxt @{thm ordLeq_ordLess_trans[OF - card_of_mono1[OF Int_lower1]]}, rtac ctxt set_bound, rtac ctxt @{thm ordIso_symmetric}, - rtac ctxt (@{thm card_of_Un_diff_infinite} OF [mrbnf_var_infinite]), - rtac ctxt (Un_bound OF [Un_bound OF [set_bound, card_of_FVarsB_bound], assm])]; - - fun mk_insert_extU_tac ctxt extU = EVERY' - [Method.insert_tac ctxt [extU], dtac ctxt meta_mp, etac ctxt @{thm inj_on_imp_bij_betw}, - dtac ctxt meta_mp, rtac ctxt @{thm set_eqI}, rtac ctxt @{thm iffI[rotated]}, - etac ctxt @{thm emptyE}, rtac ctxt @{thm Int_mono[OF subset_refl, THEN subset_trans, - THEN subsetD, rotated -1]}, assume_tac ctxt, assume_tac ctxt, rtac ctxt equalityD1, - simp_only_tac ctxt @{thms Compl_eq_Diff_UNIV[symmetric] disjoint_eq_subset_Compl Compl_Int - Diff_Un double_complement subset_trans[OF Int_mono[OF subset_refl Un_upper2] Int_lower2]}]; - - fun mk_exI_thm ct thm = infer_instantiate' ctxt [NONE, SOME ct] thm; - fun mk_extU_thm ct thm = infer_instantiate' ctxt [SOME ct] thm; - fun subgoal_tac focus = - let - val ctxt = #context focus; - val fs = #params focus |> map snd; - val exIs = map2 mk_exI_thm fs exI_thms; - val extUs = map2 mk_extU_thm fs extU_thms; - in - map (rtac ctxt) exIs @ map (mk_insert_extU_tac ctxt) extUs |> EVERY1 - end; - - fun simplify_tac1 set_bound = - EVERY' [rtac ctxt conjI, assume_tac ctxt, rtac ctxt @{thm context_conjI}, - etac ctxt @{thm ordLeq_ordLess_trans[OF card_of_mono1]}, rtac ctxt Un_bound, - rtac ctxt @{thm ordLeq_ordLess_trans[OF card_of_mono1[OF Int_lower1]]}, rtac ctxt set_bound, - rtac ctxt @{thm ordLeq_ordLess_trans[OF card_of_image]}, rtac ctxt - @{thm ordLeq_ordLess_trans[OF card_of_mono1[OF Int_lower1]]}, rtac ctxt set_bound]; - - val simplify_tac2 = EVERY' [rtac ctxt conjI, etac ctxt @{thm id_on_antimono}, etac ctxt - @{thm subset_trans[OF Int_mono[OF subset_refl, THEN subset_trans[rotated], OF Compl_anti_mono] - Compl_Un[THEN equalityD2]]}, simp_only_tac ctxt @{thms Compl_eq_Diff_UNIV[symmetric] - double_complement Compl_Int Un_Int_distrib}, simp_only_tac ctxt @{thms Int_Un_distrib - Int_Un_distrib2 Diff_eq Compl_disjoint Compl_disjoint2 Un_empty_left Un_empty_right trans[OF - Int_assoc[symmetric] box_equals[OF Int_left_absorb Int_commute Int_commute]] - Un_assoc[symmetric]}, REPEAT_DETERM o (rtac ctxt @{thm Un_subset_iff[THEN iffD2]} THEN' - rtac ctxt conjI), REPEAT_DETERM o (rtac ctxt @{thm Un_upper2} ORELSE' rtac ctxt - @{thm subset_trans[OF _ Un_upper1]})]; - in - EVERY1 [@{map 4} insert_tac insert_thms mrbnf_set_bounds card_of_FVarsB_bounds assms |> EVERY', - REPEAT_DETERM o eresolve_tac ctxt @{thms exE conjE}, Subgoal.FOCUS_PARAMS subgoal_tac ctxt, - REPEAT_DETERM o etac ctxt conjE, map simplify_tac1 mrbnf_set_bounds |> EVERY', - REPEAT_DETERM_N fbound o simplify_tac2, asm_simp_only_all_new ctxt - (set_map @ @{thms supp_id_bound Int_iff}) [resolve_tac ctxt - @{thms conjI set_eqI iffI[rotated]}, eresolve_tac ctxt @{thms emptyE imageE conjE}], - asm_simp_only_plus ctxt @{thms extU_def Compl_eq_Diff_UNIV[symmetric] if_True if_False} - [Splitter.split_asm_tac ctxt @{thms if_split_asm}, resolve_tac ctxt @{thms conjI impI}, - EVERY' [dtac ctxt subsetD, assume_tac ctxt, etac ctxt @{thm ComplE}, etac ctxt notE, - rtac ctxt UnI2, rtac ctxt IntD2, assume_tac ctxt], - EVERY' [dtac ctxt @{thm subsetD[OF _ imageI]}, assume_tac ctxt, etac ctxt @{thm ComplE}, - etac ctxt notE, rtac ctxt UnI2, assume_tac ctxt], - EVERY' [dtac ctxt subsetD, assume_tac ctxt, etac ctxt @{thm ComplE}, etac ctxt notE, - rtac ctxt UnI1, rtac ctxt UnI1, assume_tac ctxt], - EVERY' [etac ctxt notE, rtac ctxt IntI, assume_tac ctxt, assume_tac ctxt]]] - end; - -fun mk_refresh_tac alpha_intro alpha_refls rel_map rel_refl_id mk_refresh_set mk_exI ctxt assms = - let - fun mk_alpha_intro fs = infer_instantiate' ctxt (map SOME fs) alpha_intro; - fun subgoal_tac focus = - let - val ctxt = #context focus; - val fs = #params focus |> map snd; - in - EVERY1 [rtac ctxt (mk_exI fs), REPEAT_DETERM o etac ctxt conjI, - rtac ctxt (mk_alpha_intro fs) THEN_ALL_NEW TRY o assume_tac ctxt] - end; - in - EVERY1 [Method.insert_tac ctxt [mk_refresh_set assms], - REPEAT_DETERM o eresolve_tac ctxt @{thms exE conjE}, Subgoal.FOCUS_PARAMS subgoal_tac ctxt, - rtac ctxt (nth rel_map 2 RS iffD2) THEN_ALL_NEW simp_only_tac ctxt - @{thms bij_id supp_id_bound}, asm_simp_only_tac ctxt - @{thms bij_id supp_id_bound relcompp_conversep_Grp id_apply inv_o_simp1}, - rtac ctxt rel_refl_id THEN_ALL_NEW simp_only_tac ctxt alpha_refls] - end; - -fun mk_avoid_tac avoid_defs refresh ctxt assms = - EVERY1 [unfold_tac ctxt avoid_defs |> K, rtac ctxt (@{thm someI_ex} OF [refresh OF assms])]; - -fun mk_supp_asSS_bound_tac asSS_def ctxt = - EVERY1 [unfold_tac ctxt [asSS_def] |> K, rtac ctxt - @{thm if_splits(1)[of "\f. |supp f| HEADGOAL; - -fun mk_TT_abs_ctor_tac cctor_def map_comp TT_Quotient rename_ids mr_rel_map alpha_quotient_syms - alpha_intro rel_refl_id ctxt = simp_only_plus ctxt ([cctor_def, map_comp, - @{thm Quotient_rep_abs} OF [TT_Quotient]] @ rename_ids @ mr_rel_map @ alpha_quotient_syms @ - @{thms supp_id_bound bij_id id_o o_id inv_id id_on_id eq_OO relcompp.simps ex_simps simp_thms - conversep_iff Grp_def id_apply UNIV_I o_apply}) - [resolve_tac ctxt [@{thm Quotient_rel_abs} OF [TT_Quotient], - alpha_intro, rel_refl_id, @{thm exI[of "\x. _ x \ x = _", OF conjI[OF _ refl]]}]] |> HEADGOAL; - -fun mk_TT_nchotomy_tac rep_exhaust cctor_def map_comp TT_Quotient rename_ids mr_rel_map - alpha_quotient_syms alpha_intro rel_refl_id mk_exI ctxt = - let - fun subgoal_tac focus = - let - val ctxt = #context focus; - val exI_inst = #params focus |> snd o hd |> mk_exI; - in - rtac ctxt exI_inst |> HEADGOAL - end; - in - EVERY1 [rtac ctxt rep_exhaust, Subgoal.FOCUS_PARAMS subgoal_tac ctxt, - rtac ctxt (trans OF [@{thm Quotient_abs_rep} OF [TT_Quotient] RS sym]), - asm_simp_only_plus ctxt ([cctor_def, map_comp] @ rename_ids @ mr_rel_map @ alpha_quotient_syms - @ @{thms supp_id_bound bij_id id_o o_id inv_id id_on_id relcompp.simps ex_simps simp_thms - conversep_iff Grp_def id_apply UNIV_I o_apply}) - [resolve_tac ctxt [@{thm Quotient_rel_abs} OF [TT_Quotient], - alpha_intro, rel_refl_id, @{thm exI[of "\x. _ x \ x = _", OF conjI[OF _ refl]]}]]] - end; - -fun mk_rrename_cctor_tac rrename_defs cctor_def map_comp mr_rel_map rename_simps rename_ids - TT_Quotient rel_refl_id alpha_intro alpha_trans alpha_quotient_syms ctxt assms = - simp_only_plus ctxt (rrename_defs @ [cctor_def, map_comp] @ mr_rel_map @ assms @ rename_simps @ - rename_ids @ @{thms supp_id_bound bij_id id_o o_id inv_id id_on_id inv_o_simp1 - relcompp.simps ex_simps simp_thms conversep_iff Grp_def id_apply UNIV_I o_apply - bij_imp_bij_inv supp_inv_bound}) - [resolve_tac ctxt ([@{thm Quotient_rel_abs} OF [TT_Quotient], rel_refl_id, - @{thm exI[of "\x. _ x \ x = _", OF conjI[OF _ refl]]}, alpha_intro, alpha_trans] @ - alpha_quotient_syms)] |> HEADGOAL; - -fun mk_FFVars_cctor_tac alpha_FVars rep_abs FFVars_defs cctor_defs FVars_ctors set_map ctxt = - simp_only_tac ctxt ([alpha_FVars OF [rep_abs]] @ FFVars_defs @ cctor_defs @ FVars_ctors @ - set_map @ @{thms supp_id_bound bij_id image_id id_apply UN_simps}) |> HEADGOAL; - -fun mk_FFVars_intro_tac FFVars_defs cctor_def FVars_abs_rep set_map FVars_intro ctxt = - unfold_tac ctxt (FFVars_defs @ [cctor_def, FVars_abs_rep]) THEN EVERY1 - [rtac ctxt FVars_intro THEN_ALL_NEW TRY o assume_tac ctxt, simp_only_plus ctxt - (set_map @ @{thms simp_thms supp_id_bound bij_id image_id id_apply UN_simps}) - [rtac ctxt imageI]]; - -fun mk_FFVars_elim_tac TT_nchotomy_inst FFVars_cctors ctxt = - rtac ctxt (exE OF [TT_nchotomy_inst]) THEN' asm_simp_only_plus ctxt - (FFVars_cctors @ @{thms Un_iff UN_iff Diff_iff simp_thms}) - [eresolve_tac ctxt @{thms disjE conjE bexE}, EVERY' [dtac ctxt @{thm meta_spec2}, - dtac ctxt meta_mp, rtac ctxt refl, dtac ctxt meta_mp, assume_tac ctxt]] |> HEADGOAL; - -fun mk_FFVars_induct_tac mutual induct_insts FFVars_defs cctor_defs FVars_abs_reps FVars_induct - TT_abs_ctors set_map ctxt assms = EVERY1 (map (rtac ctxt) induct_insts @ - [unfold_tac ctxt (FFVars_defs @ cctor_defs @ FVars_abs_reps) |> K, - if mutual then K all_tac else rtac ctxt impI, (if mutual then rtac else etac) - ctxt FVars_induct THEN_ALL_NEW simp_only_tac ctxt TT_abs_ctors, - RANGE (map (fn assm => rtac ctxt assm THEN_ALL_NEW TRY o assume_tac ctxt) assms), - simp_only_plus ctxt (set_map @ FFVars_defs @ FVars_abs_reps @ - @{thms supp_id_bound bij_id image_id id_apply simp_thms}) [rtac ctxt imageI]]); - -fun mk_TT_inject0_tac fbound alpha_intro mr_rel_eq cctor_def abs_eq_iff mr_rel_map alpha_elim - FFVars_defs set_map rrename_defs Quotient_rep_abss Quotient_rel_reps rotated_mr_rel_mono_strong0 - alpha_syms alpha_sym_transs alpha_sym_rep_abss alpha_refls ctxt = - let - fun mk_exIs fs = map (fn f => infer_instantiate' ctxt [NONE, SOME f] exI) fs; - fun subgoal_tac1 focus = - let - val ctxt = #context focus; - in - #params focus |> take fbound |> map snd |> mk_exIs |> map (rtac ctxt) |> EVERY1 - end; - - fun mk_alpha_intro fs = infer_instantiate' ctxt (map SOME fs) alpha_intro; - fun subgoal_tac2 focus = - let - val ctxt = #context focus; - in - #params focus |> take fbound |> map snd |> mk_alpha_intro |> rtac ctxt |> HEADGOAL - end; - - fun simp_only_tac' ctxt f thms = BNF_Util.ss_only thms ctxt |> full_simp_tac o f; - in - EVERY1 [simp_only_tac' ctxt (Simplifier.add_cong @{thm conj_cong}) - ([mr_rel_eq RS sym, cctor_def, abs_eq_iff] @ mr_rel_map @ @{thms bij_id supp_id_bound id_o - o_id o_apply Grp_def id_apply UNIV_I simp_thms OO_eq id_on_def map_fun_def}), - safe_tac ctxt |> K, etac ctxt alpha_elim, safe_tac ctxt |> K, - Subgoal.FOCUS_PARAMS subgoal_tac1 ctxt, asm_simp_only_plus ctxt - (FFVars_defs @ mr_rel_map @ set_map @ rrename_defs @ Quotient_rep_abss @ - @{thms supp_id_bound bij_id UN_simps id_o o_id inv_id image_id id_apply id_on_def - simp_thms ball_triv Grp_def relcompp_apply UNIV_I conversep_iff}) - [resolve_tac ctxt (@{thms conjI allI impI ballI} @ Quotient_rel_reps), - EVERY' [dtac ctxt spec, etac ctxt mp, assume_tac ctxt], - eresolve_tac ctxt (rotated_mr_rel_mono_strong0 :: @{thms exE conjE} @ alpha_syms @ - alpha_sym_transs)] |> SELECT_GOAL o HEADGOAL, - Subgoal.FOCUS_PARAMS subgoal_tac2 ctxt, asm_simp_only_plus ctxt - (FFVars_defs @ mr_rel_map @ set_map @ rrename_defs @ alpha_sym_rep_abss @ - @{thms supp_id_bound bij_id UN_simps id_o o_id inv_id image_id id_apply id_on_def - simp_thms ball_triv Grp_def relcompp_apply UNIV_I conversep_iff}) - [resolve_tac ctxt (@{thms conjI allI impI ballI} @ alpha_refls), - EVERY' [rtac ctxt exI, rtac ctxt @{thm conjI[rotated]}, rtac ctxt refl], - etac ctxt rotated_mr_rel_mono_strong0]] - end; - -fun mk_aavoid_tac aavoid_def cctor_def map_comp TT_Quotient set_map mr_rel_map rename_ids alpha_sym - rel_refl_id avoid_freshs Quotient_rep_abss alpha_trans alpha_intro_id alpha_avoid ctxt assms = - simp_only_plus ctxt ([aavoid_def, cctor_def, map_comp] @ map (fn thm => thm OF assms) avoid_freshs - @ set_map @ mr_rel_map @ rename_ids @ @{thms supp_id_bound bij_id image_id id_apply id_o - id_on_id Grp_def relcompp_apply simp_thms UNIV_I o_apply}) - [resolve_tac ctxt ([rel_refl_id, @{thm Quotient_rel_abs} OF [TT_Quotient]] @ Quotient_rep_abss @ - [alpha_trans OF [alpha_intro_id, alpha_sym OF [alpha_avoid OF assms]]])] |> HEADGOAL; - -fun mk_TT_fresh_cases_tac insert_nchotomy alpha_aavoid aavoid_freshs ctxt assms = - EVERY1 [Method.insert_tac ctxt [insert_nchotomy], etac ctxt exE, hyp_subst_tac_thin true ctxt, - rtac ctxt exI, rtac ctxt conjI, rtac ctxt (sym OF [alpha_aavoid OF assms]), - simp_only_tac ctxt (map (fn thm => thm OF assms) aavoid_freshs)]; - -fun mk_subshape_induct_raw_tac fbound rec_live rename_simps raw_injects rename_comps - alpha_bij_eq_invs alpha_transs alpha_syms mk_prem_funs mk_rename_comp_funs common_co_induct_inst - mr_rel_maps supp_comp_bounds alpha_elims subshape_elimss settsss ctxt assms = - let - fun mk_solve_tac ctxt supp_comp_bound rename_comp alpha_bij_eq_inv alpha_trans alpha_sym sett - prem rename_comps = - EVERY1 [dtac ctxt sett THEN_ALL_NEW asm_simp_only_tac ctxt [@{thm bij_comp}, supp_comp_bound], - REPEAT_DETERM o (dtac ctxt @{thm rel_setD2} THEN' assume_tac ctxt), - REPEAT_DETERM o eresolve_tac ctxt @{thms bexE relcomppE GrpE}, hyp_subst_tac_thin true ctxt, - etac ctxt prem, asm_simp_only_plus ctxt ([supp_comp_bound, rename_comp RS sym, - alpha_bij_eq_inv] @ rename_comps @ @{thms bij_comp bij_imp_bij_inv supp_inv_bound - supp_id_bound bij_id inv_inv_eq}) - [eresolve_tac ctxt [alpha_trans, alpha_sym]]] |> SELECT_GOAL; - - fun subgoal_tac supp_comp_bound rename_comp alpha_bij_eq_inv alpha_trans alpha_sym setts - mk_prems mk_rename_comps focus = - let - val ctxt = #context focus; - val ((fs, gs), hs) = #params focus |> map (Thm.term_of o snd) |> drop 1 |> chop fbound - ||> drop 2 ||>> chop fbound ||> drop 2 ||> take fbound; - val (prems, assms) = #prems focus |> chop rec_live |>> mk_prems ctxt fs gs hs; - val rename_comps = mk_rename_comps fs gs; - val solve_tac = @{map 3} (mk_solve_tac ctxt supp_comp_bound rename_comp alpha_bij_eq_inv - alpha_trans alpha_sym) setts prems rename_comps |> EVERY'; - in - EVERY1 [Method.insert_tac ctxt assms, REPEAT_DETERM o etac ctxt UnE, solve_tac] - end; - - fun mk_sub_tac mr_rel_map supp_comp_bound alpha_elim subshape_elim alpha_bij_eq_inv rename_comp - setts alpha_trans alpha_sym mk_prem mk_rename_comp = - EVERY' [asm_simp_only_plus ctxt (supp_comp_bound :: rename_simps @ mr_rel_map @ - @{thms True_implies_equals bij_comp supp_id_bound bij_id id_o}) - [etac ctxt alpha_elim, simp_only ctxt raw_injects THEN' dtac ctxt sym], - etac ctxt subshape_elim THEN_ALL_NEW simp_only_tac ctxt raw_injects THEN_ALL_NEW - hyp_subst_tac_thin true ctxt, Subgoal.FOCUS_PREMS (subgoal_tac supp_comp_bound rename_comp - alpha_bij_eq_inv alpha_trans alpha_sym setts mk_prem mk_rename_comp) ctxt]; - - fun mk_main_tac assm mr_rel_map supp_comp_bound alpha_elim subshape_elims settss = - EVERY' [REPEAT_DETERM o resolve_tac ctxt [allI, impI], rtac ctxt assm, - @{map 8} (mk_sub_tac mr_rel_map supp_comp_bound alpha_elim) subshape_elims alpha_bij_eq_invs - rename_comps settss alpha_transs alpha_syms mk_prem_funs mk_rename_comp_funs |> EVERY']; - in - EVERY1 [rtac ctxt common_co_induct_inst, @{map 6} mk_main_tac assms mr_rel_maps supp_comp_bounds - alpha_elims subshape_elimss settsss |> EVERY'] - end; - -fun mk_subshape_induct_tac n subshape_induct_raw_inst meta_spec_ys spec_ys rename_ids alpha_refls - ctxt assms = EVERY1 [Method.insert_tac ctxt [subshape_induct_raw_inst], - map (fn thm => dtac ctxt thm) meta_spec_ys |> EVERY', REPEAT_DETERM_N n o (dtac ctxt meta_mp - THEN_ALL_NEW TRY o (resolve_tac ctxt assms THEN_ALL_NEW Goal.assume_rule_tac ctxt)), - REPEAT_DETERM o etac ctxt conjE, REPEAT_DETERM o dtac ctxt @{thm spec[of _ id]}, - map (fn thm => dtac ctxt thm) spec_ys |> EVERY', simp_only_tac ctxt (rename_ids @ alpha_refls @ - @{thms bij_id supp_id_bound simp_thms})]; - -fun mk_alpha_subshape_tac fbound supp_comp_bound alpha_trans rename_comp mk_subshape_intros - mk_alpha_bij_eqs setts alpha_elim subshape_elim raw_injects ctxt = - let - fun solve_tac ctxt sett subshape_intro alpha_bij_eq_opt = - EVERY' [dtac ctxt sett THEN_ALL_NEW simp_only_tac ctxt @{thms supp_id_bound}, - dtac ctxt @{thm rel_setD1} THEN' assume_tac ctxt, - REPEAT_DETERM o eresolve_tac ctxt @{thms bexE conjE}, rtac ctxt subshape_intro - THEN_ALL_NEW asm_simp_only_tac ctxt [supp_comp_bound, @{thm bij_comp}], - etac ctxt alpha_trans, case alpha_bij_eq_opt of NONE => assume_tac ctxt - | SOME alpha_bij_eq => dtac ctxt alpha_bij_eq THEN_ALL_NEW asm_simp_only_tac ctxt - (rename_comp :: @{thms bij_id supp_id_bound id_o})]; - - fun subgoal_tac focus = - let - val ctxt = #context focus; - val (fs, gs) = #params focus |> map (Thm.term_of o snd) |> chop fbound ||> drop 2 - ||> take fbound; - val subshape_intros = mk_subshape_intros fs gs; - val alpha_bij_eqs = mk_alpha_bij_eqs fs; - val solve_tacs = @{map 3} (solve_tac ctxt) setts subshape_intros alpha_bij_eqs |> EVERY'; - in - EVERY1 [REPEAT_DETERM o etac ctxt UnE, solve_tacs] - end; - in - EVERY1 [etac ctxt alpha_elim, etac ctxt subshape_elim, hyp_subst_tac_thin true ctxt, - unfold_tac ctxt raw_injects |> K, hyp_subst_tac_thin true ctxt, - Subgoal.FOCUS_PARAMS subgoal_tac ctxt] - end; - -fun mk_set_subshape_image_tac i n subshape_intros alpha_refls rename_ids rename_comps ctxt prems = - EVERY1 [ - etac ctxt imageE, - hyp_subst_tac ctxt, - resolve_tac ctxt subshape_intros, - K (prefer_tac (length prems + 2)), - rtac ctxt (BNF_Util.mk_UnIN n i), - assume_tac ctxt, - K (prefer_tac (length prems + 1)), - EqSubst.eqsubst_tac ctxt [0] rename_comps, - K (prefer_tac (length prems * 2 + 1)), - REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp1}, - resolve_tac ctxt prems - ], - EqSubst.eqsubst_tac ctxt [0] rename_ids, - resolve_tac ctxt alpha_refls, - REPEAT_DETERM o resolve_tac ctxt (@{thms bij_imp_bij_inv supp_inv_bound} @ prems) - ]; - -fun mk_TT_existential_induct_tac rename_ids Quotient_rep_abss subshape_induct_inst conj_arg_congs - arg_congs TT_Quotients alpha_refls raw_exhausts TT_abs_ctors mk_exE_funs cctor_defs map_comps - mr_rel_maps set_maps Quotient_total_abs_eq_iffs rel_refl_ids alpha_subshapess mk_alpha_trans_funs - subshape_intross_id ctxt assms = - let - fun mk_exhaust exhaust t = infer_instantiate' ctxt [SOME t] exhaust; - fun exhaust_subgoal_tac exhaust focus = - let - val ctxt = #context focus; - in - #params focus |> snd o hd |> mk_exhaust exhaust |> rtac ctxt |> HEADGOAL - end; - - fun solve_tac ctxt cctor_def map_comp mr_rel_map set_map abs_eq_iff rel_refl_id alpha_trans - TT_Quotient alpha_refl alpha_subshape arg_cong subshape_intro = - EVERY' [TRY o rtac ctxt conjI, REPEAT_DETERM o resolve_tac ctxt [allI, impI], - rtac ctxt arg_cong, rtac ctxt (@{thm Quotient_abs_rep} OF [TT_Quotient]), - dtac ctxt meta_spec, etac ctxt meta_mp, simp_only_plus ctxt - ([cctor_def, map_comp, abs_eq_iff] @ mr_rel_map @ set_map @ rename_ids @ - Quotient_rep_abss @ @{thms supp_id_bound bij_id id_o id_on_id relcompp_apply Grp_def - id_apply simp_thms UNIV_I o_apply}) [resolve_tac ctxt [rel_refl_id, alpha_refl], - eresolve_tac ctxt [exE, conjE, alpha_subshape, imageI], dtac ctxt alpha_trans, - rtac ctxt subshape_intro]]; - - fun subgoal_tac TT_abs_ctor mk_exE cctor_def map_comp mr_rel_map set_map abs_eq_iff rel_refl_id - alpha_subshapes mk_alpha_trans subshape_intros focus = - let - val ctxt = #context focus; - val (rho, x) = #params focus |> drop 1 |> map (Thm.term_of o snd) |> chop 1 |> apply2 hd; - val exE = mk_exE rho x; - val alpha_trans = mk_alpha_trans x; - val solve_tacs = @{map 5} (solve_tac ctxt cctor_def map_comp mr_rel_map set_map abs_eq_iff - rel_refl_id alpha_trans) TT_Quotients alpha_refls alpha_subshapes arg_congs - subshape_intros |> EVERY'; - in - unfold_tac ctxt [TT_abs_ctor] THEN EVERY1 [rtac ctxt exE, assume_tac ctxt, etac ctxt conjE, - eresolve_tac ctxt [Thm.permute_prems 1 1 @{thm impE}], asm_simp_only ctxt [], - dtac ctxt sym, solve_tacs] - end; - in - unfold_tac ctxt @{thms ball_conj_distrib} THEN EVERY1 [map (fn (arg_cong, TT_Quotient) => - rtac ctxt arg_cong THEN' rtac ctxt (@{thm Quotient_abs_rep} OF [TT_Quotient])) - conj_arg_congs |> EVERY', rtac ctxt subshape_induct_inst, map (fn thm => EVERY' - [rtac ctxt ballI, Subgoal.FOCUS_PARAMS (exhaust_subgoal_tac thm) ctxt, - hyp_subst_tac_thin true ctxt]) raw_exhausts |> RANGE, - @{map 11} subgoal_tac TT_abs_ctors (map2 I mk_exE_funs assms) cctor_defs map_comps mr_rel_maps - set_maps Quotient_total_abs_eq_iffs rel_refl_ids alpha_subshapess mk_alpha_trans_funs - subshape_intross_id |> EVERY' o map (fn f => Subgoal.FOCUS_PARAMS f ctxt)] - end; - -fun mk_TT_fresh_induct_param_tac TT_existential_induct mk_exI_funs alpha_aavoids aavoid_freshss - ctxt assms = - let - fun subgoal_tac mk_exI alpha_aavoid aavoid_freshs focus = - let - val ctxt = #context focus; - val (x, rho) = #params focus |> map (Thm.term_of o snd) |> chop 1 |> apply2 hd; - val exI_inst = mk_exI x rho; - in - REPEAT_DETERM o FIRST' [resolve_tac ctxt ([exI_inst, alpha_aavoid] @ assms @ - @{thms conjI[rotated] impI}), asm_simp_only ctxt @{thms Un_iff de_Morgan_disj simp_thms}, - etac ctxt conjE, EVERY' [dtac ctxt spec, dtac ctxt mp, assume_tac ctxt, etac ctxt bspec, - assume_tac ctxt], dresolve_tac ctxt aavoid_freshs] |> HEADGOAL - end; - in - EVERY1 [rtac ctxt TT_existential_induct, @{map 3} subgoal_tac mk_exI_funs alpha_aavoids - aavoid_freshss |> EVERY' o map (fn f => Subgoal.FOCUS_PARAMS f ctxt)] - end; - -fun mk_TT_fresh_induct_param_no_clash_tac fbound n noclashs meta_mp_inst UNIV_Is card_of_FFVars_bounds - Un_bounds FFVars_cctors ctxt assms = - EVERY1 [ - rtac ctxt meta_mp_inst, - rtac ctxt ballI, - dtac ctxt bspec, - etac ctxt @{thm SigmaI}, - REPEAT_DETERM o rtac ctxt @{thm SigmaI[rotated]}, - EVERY' (map (rtac ctxt) UNIV_Is), - asm_simp_only_tac ctxt @{thms prod.case}, - REPEAT_DETERM_N fbound o (SELECT_GOAL (HEADGOAL (simp_only_plus ctxt @{thms prod.case} [ - hyp_subst_tac_thin true ctxt, - etac ctxt @{thm SigmaE}, - resolve_tac ctxt (Un_bounds @ take fbound assms @ card_of_FFVars_bounds) - ]))), - REPEAT_DETERM_N n o EVERY' [ - REPEAT_DETERM o FIRST' [ - etac ctxt @{thm SigmaE}, - hyp_subst_tac ctxt, - simp_only ctxt @{thms prod.case}, - rtac ctxt impI, - eresolve_tac ctxt (map (Drule.rotate_prems ~1) (drop fbound assms)) - ], - REPEAT_DETERM o EVERY' [ - dtac ctxt @{thm meta_spec2}, - dtac ctxt meta_mp, - assume_tac ctxt, - dtac ctxt meta_mp, - etac ctxt @{thm SigmaI}, - REPEAT_DETERM o rtac ctxt @{thm SigmaI[rotated]}, - REPEAT_DETERM o rtac ctxt UNIV_I, - simp_only_tac ctxt @{thms prod.case}, - etac ctxt mp, - rtac ctxt refl - ], - asm_simp_only_plus ctxt (FFVars_cctors @ map snd noclashs - @ @{thms Int_Un_distrib disjoint_iff Un_empty Un_iff UN_iff de_Morgan_disj simp_thms bex_simps Ball_def} - ) [ - rtac ctxt conjI, - rtac ctxt allI THEN' rtac ctxt impI, - EVERY' [ - dtac ctxt meta_spec, - dtac ctxt meta_mp, - assume_tac ctxt - ] - ] - ] - ]; - -fun mk_alpha'_bij_eq_invs_tac fbound alpha'_coinduct_inst raw_injects mk_exIs mutual imp_forward - supp_comp_bounds rename_simps FVars_renames rename_comps alpha'_elims raw_nchotomys mr_rel_maps - set_maps mr_rel_mono_strong0s rename_ids ctxt assms = - let - fun mk_allE t = thm_instantiate_terms ctxt [NONE, SOME t] allE; - fun subgoal_tac raw_nchotomy focus = - let - val ctxt = #context focus; - val ((ts, fs), gs) = #params focus |> map (Thm.term_of o snd) |> chop 1 ||>> chop 1 - |>> apply2 hd ||>> chop fbound ||> drop 1 ||> take fbound; - val (allE1, allE2) = apply2 mk_allE ts; - val exIs = mk_exIs fs gs; - in - EVERY1 [Method.insert_tac ctxt [raw_nchotomy], etac ctxt allE1, etac ctxt exE, - asm_simp_only_tac ctxt (raw_injects @ @{thms simp_thms ex_simps}), - map (rtac ctxt) exIs |> EVERY', Method.insert_tac ctxt [raw_nchotomy], - etac ctxt allE2, etac ctxt exE] - end; - - fun sub_tac alpha'_elim raw_nchotomy mr_rel_map set_map mr_rel_mono_strong0 = - EVERY' [etac ctxt alpha'_elim, Subgoal.FOCUS_PARAMS (subgoal_tac raw_nchotomy) ctxt, - asm_simp_only_plus ctxt (mr_rel_map @ set_map @ supp_comp_bounds @ rename_simps @ assms @ - raw_injects @ FVars_renames @ rename_comps @ @{thms supp_id_bound bij_id supp_inv_bound - bij_comp bij_imp_bij_inv id_on_def simp_thms id_o o_id inv_simp1 o_apply - bij_implies_inject id_apply Grp_def relcompp_apply conversep_iff - rewriteR_comp_comp[OF inv_o_simp2] inv_o_simp2 o_inv_distrib o_assoc}) - [hyp_subst_tac_thin true ctxt, resolve_tac ctxt [conjI, impI, allI, imageI, notI, ballI], - eresolve_tac ctxt @{thms UnE DiffE UN_E imageE exE conjE}, - EVERY' [etac ctxt @{thm trans[OF spec[of "\x. _ x \ _ x = x", THEN mp, - THEN arg_cong[of _ _ "inv _"]] inv_simp1]}, REPEAT o resolve_tac ctxt [UnI1, UnI2], - rtac ctxt @{thm DiffI}, rtac ctxt @{thm UN_I}, rtac ctxt imageI, assume_tac ctxt], - etac ctxt (Drule.rotate_prems (6*fbound) mr_rel_mono_strong0)]] - |> SELECT_GOAL o HEADGOAL; - in - (if mutual then [rtac ctxt alpha'_coinduct_inst, simp_only_plus ctxt - (rename_comps @ rename_ids @ assms @ @{thms supp_inv_bound bij_imp_bij_inv inv_o_simp2}) - [resolve_tac ctxt [conjI, impI], etac ctxt conjE, - EVERY' [etac ctxt allE, etac ctxt allE, etac ctxt mp]] |> SELECT_GOAL o HEADGOAL] else - [rtac ctxt imp_forward, assume_tac ctxt, simp_only ctxt (rename_comps @ rename_ids @ assms @ - @{thms supp_inv_bound bij_imp_bij_inv inv_o_simp2}) |> SELECT_GOAL o HEADGOAL, - rtac ctxt impI, etac ctxt alpha'_coinduct_inst]) @ - [@{map 5} sub_tac alpha'_elims raw_nchotomys mr_rel_maps set_maps mr_rel_mono_strong0s - |> EVERY'] |> EVERY1 - end; - -fun mk_alpha'_bij_eq_inv'_tac arg_cong_inst rename_id rename_comp ctxt assms = - EVERY1 [rtac ctxt arg_cong_inst, REPEAT_DETERM o simp_only_tac ctxt ([rename_id, rename_comp] @ - assms @ @{thms inv_o_simp1 inv_o_simp2 supp_inv_bound bij_imp_bij_inv})]; - -fun mk_alpha_imp_alpha's_tac mutual fbound alpha'_coinduct raw_injects rename_ids alpha_elims - mr_rel_mono_strong0s ctxt = - let - fun mk_exI t = infer_instantiate' ctxt [NONE, SOME t] exI; - fun subgoal_tac mr_rel_mono_strong0 focus = - let - val ctxt = #context focus; - val exIs = #params focus |> map snd |> drop 2 |> take fbound |> map mk_exI; - in - map (rtac ctxt) exIs @ [asm_simp_only_plus ctxt (raw_injects @ rename_ids @ - @{thms ex_simps simp_thms id_on_id supp_id_bound bij_id inv_id id_o}) - [resolve_tac ctxt [conjI, ballI, impI, @{thm exI[of _ id]}], - etac ctxt (Drule.rotate_prems (6*fbound) mr_rel_mono_strong0)]] |> EVERY1 - end; - in - (if mutual then [rtac ctxt alpha'_coinduct] else [rtac ctxt allI, rtac ctxt allI, rtac ctxt impI, - etac ctxt alpha'_coinduct, simp_only ctxt @{thms triv_forall_equality}]) @ - [map (etac ctxt) alpha_elims |> RANGE, map (fn thm => Subgoal.FOCUS_PARAMS (subgoal_tac thm) - ctxt) mr_rel_mono_strong0s |> EVERY'] |> EVERY1 - end; - -fun mk_alpha'_imp_alphas_tac fbound alpha_coinduct supp_comp_bounds mk_arg_congs mutual - FVars_renames alpha'_bij_eq_invs alpha'_bij_eq_inv's alpha'_FVars_les rename_comps raw_injects - alpha'_elims mr_rel_mono_strong0s settss ctxt = - let - fun mk_exI f g = thm_instantiate_terms ctxt [NONE, SOME (HOLogic.mk_comp (mk_inv g, f))] exI; - fun subgoal_tac focus = - let - val ctxt = #context focus; - val exIs = #params focus |> map (Thm.term_of o snd) |> chop fbound ||> drop 1 - ||> take fbound |-> map2 mk_exI; - in - map (rtac ctxt) exIs |> EVERY1 - end; - - fun apply_setts ctxt setts = - let - val n = length setts - 1; - val tacs1 = replicate n (forward_tac ctxt o single) @ [dtac ctxt] - |> map2 (curry op |>) setts; - val tacs2 = asm_simp_only_tac ctxt (supp_comp_bounds @ - @{thms Grp_def supp_id_bound bij_id bij_comp bij_imp_bij_inv supp_inv_bound}) :: - replicate n (asm_simp_only_tac ctxt (supp_comp_bounds @ - @{thms rel_set_def supp_id_bound bij_id bij_comp bij_imp_bij_inv supp_inv_bound})); - val tacs3 = replicate (n+1) (dtac ctxt conjunct1); - in - @{map 3} (fn tac1 => fn tac2 => fn tac3 => tac1 THEN_ALL_NEW tac2 THEN' tac3) tacs1 tacs2 - tacs3 |> EVERY' - end; - - fun subgoal_solve_tac focus = - let - val ctxt = #context focus; - val arg_cong_insts = #params focus |> map (Thm.term_of o snd) |> chop fbound ||> drop 1 - ||> take fbound |-> mk_arg_congs; - in - asm_simp_only_plus ctxt (supp_comp_bounds @ FVars_renames @ - @{thms supp_inv_bound bij_comp bij_imp_bij_inv supp_id_bound simp_thms bij_id id_on_def - o_apply bij_imp_inv' inv_simp1 inv_simp2}) - [resolve_tac ctxt [conjI, impI, allI, ballI], - eresolve_tac ctxt @{thms conjE bexE imageE UnE DiffE UN_E}, - EVERY' [dtac ctxt bspec, assume_tac ctxt, etac ctxt bexE, - dresolve_tac ctxt (map (Drule.rotate_prems ~1) alpha'_bij_eq_invs) - THEN_ALL_NEW asm_simp_only_tac ctxt (rename_comps @ - @{thms supp_inv_bound bij_imp_bij_inv id_o o_id inv_id supp_id_bound bij_id}), - dresolve_tac ctxt alpha'_FVars_les, assume_tac ctxt], - resolve_tac ctxt arg_cong_insts THEN_ALL_NEW simp_only_plus ctxt - @{thms Un_iff Diff_iff Union_iff bex_simps imp_disjL all_conj_distrib} - [etac ctxt conjE, resolve_tac ctxt [conjI, ballI, notI], - EVERY' [eresolve_tac ctxt @{thms spec[of "\x. _ x \ _ x = x", THEN mp] - trans[OF spec[of "\x. _ x \ _ x = x", THEN mp, symmetric] inv_simp2, - of f "inv f x" f x for f x, THEN trans]}, - rtac ctxt conjI, rtac ctxt bexI, assume_tac ctxt, assume_tac ctxt]]] |> HEADGOAL - end; - in - (if mutual then [rtac ctxt alpha_coinduct] else [rtac ctxt allI, rtac ctxt allI, rtac ctxt impI, - etac ctxt alpha_coinduct, simp_only ctxt @{thms triv_forall_equality}]) @ - [map2 (fn thm1 => fn thm2 => EVERY' [etac ctxt thm1, - hyp_subst_tac_thin true ctxt, simp_only_tac ctxt @{thms triv_forall_equality}, - Subgoal.FOCUS_PARAMS subgoal_tac ctxt, asm_simp_only_tac ctxt (raw_injects @ supp_comp_bounds - @ @{thms ex_simps simp_thms supp_id_bound bij_id bij_comp bij_imp_bij_inv supp_inv_bound}), - rtac ctxt (mk_conjIN (fbound+1) |> Drule.rotate_prems ~1), - etac ctxt (Drule.rotate_prems (6*fbound) thm2) THEN_ALL_NEW asm_simp_only_plus ctxt - (supp_comp_bounds @ rename_comps @ @{thms id_apply simp_thms bij_comp supp_id_bound bij_id - supp_inv_bound bij_imp_bij_inv inv_id o_id id_o}) - [resolve_tac ctxt [ballI, impI], - dresolve_tac ctxt (map (Drule.rotate_prems ~1) alpha'_bij_eq_inv's)]]) - alpha'_elims mr_rel_mono_strong0s |> RANGE, map (apply_setts ctxt) settss |> RANGE, - REPEAT_DETERM o Subgoal.FOCUS_PARAMS subgoal_solve_tac ctxt] |> EVERY1 - end; - -fun mk_TT_existential_coinduct_tac fbound live raw_injects rep_meta_mp Quotient_abs_reps alpha_refls - Quotient_total_abs_eq_iffs supp_comp_bounds allE_insts alpha_alpha's alpha'_coinduct raw_nchotomys - TT_abs_ctors cctor_defs alpha_syms alpha_elims abs_meta_mps mr_rel_maps rel_mono_strong_ids - mr_rel_mono_strong0s mr_le_rel_OOs mr_rel_flips mutual ctxt assms = - let - fun mk_allE y = infer_instantiate' ctxt [NONE, SOME y] allE; - fun subgoal_tac1 raw_nchotomy focus = - let - val ctxt = #context focus; - val allE_insts = #params focus |> map (mk_allE o snd); - in - map (fn thm => EVERY' [Method.insert_tac ctxt [raw_nchotomy], etac ctxt thm, etac ctxt exE]) - allE_insts |> EVERY1 - end; - - fun mk_exI f = infer_instantiate' ctxt [NONE, SOME f] exI; - fun subgoal_tac2 focus = - let - val ctxt = #context focus; - val exI_insts = #params focus |> map snd |> drop 2 |> chop fbound ||> drop 1 ||> take fbound - |> op @ |> map mk_exI; - in - map (fn thm => rtac ctxt thm THEN_ALL_NEW simp_only_plus ctxt [] [rtac ctxt conjI]) - exI_insts |> EVERY1 - end; - - fun subgoal_solve_tac assm raw_nchotomy TT_abs_ctor cctor_def Quotient_total_abs_eq_iff - alpha_sym alpha_elim abs_meta_mp mr_rel_map rel_mono_strong_id mr_rel_mono_strong mr_le_rel_OO - mr_rel_flip = - EVERY' [Subgoal.FOCUS_PARAMS (subgoal_tac1 raw_nchotomy) ctxt, hyp_subst_tac_thin true ctxt, - simp_only_tac ctxt [TT_abs_ctor], dtac ctxt assm, - REPEAT_DETERM o eresolve_tac ctxt [exE, conjE], simp_only_tac ctxt [TT_abs_ctor RS sym], - simp_only_tac ctxt [cctor_def, Quotient_total_abs_eq_iff], dtac ctxt alpha_sym, - dtac ctxt alpha_sym, etac ctxt alpha_elim, etac ctxt alpha_elim, simp_only_plus ctxt - (raw_injects @ @{thms triv_forall_equality simp_thms ex_simps}) - [hyp_subst_tac_thin true ctxt], Subgoal.FOCUS_PARAMS subgoal_tac2 ctxt, - dtac ctxt abs_meta_mp, simp_only_tac ctxt (mr_rel_map @ @{thms supp_id_bound bij_id id_o - o_id Grp_def UNIV_I simp_thms conversep_def inv_id id_apply}), - etac ctxt rel_mono_strong_id THEN_ALL_NEW TRY o hyp_subst_tac_thin true ctxt, - asm_simp_only_plus ctxt (Quotient_abs_reps @ @{thms relcompp_apply simp_thms}) - [etac ctxt disjE, - EVERY' [rtac ctxt exI, resolve_tac ctxt @{thms conjI conjI[rotated]}, rtac ctxt refl], - rtac ctxt disjCI THEN' assume_tac ctxt, - EVERY' [rtac ctxt disjCI, etac ctxt notE, resolve_tac ctxt alpha_refls]] - |> SELECT_GOAL o HEADGOAL #> REPEAT_DETERM_N live, - etac ctxt ((Drule.rotate_prems (6*fbound) mr_rel_mono_strong OF [mr_le_rel_OO RS - @{thm predicate2D}]) |> Drule.rotate_prems (6*fbound) OF @{thms relcomppI}), - etac ctxt (Drule.rotate_prems (6*fbound) (mr_le_rel_OO RS @{thm predicate2D}) OF - @{thms relcomppI}), - etac ctxt (Drule.rotate_prems (4*fbound) (mr_rel_flip RS iffD2)), - asm_simp_only_plus ctxt - (map (fn thm => thm RS sym) Quotient_total_abs_eq_iffs @ supp_comp_bounds @ - @{thms relcompp_apply conversep_iff eq_OO OO_eq conversep_eq o_id supp_id_bound bij_comp - bij_id inv_id bij_imp_bij_inv supp_inv_bound}) - [rtac ctxt ballI THEN' rtac ctxt refl, - EVERY' [rtac ctxt ballI, rtac ctxt ballI, rtac ctxt @{thm imp_refl}], - EVERY' [rtac ctxt ballI, rtac ctxt ballI, rtac ctxt impI, - REPEAT_DETERM o eresolve_tac ctxt [exE, conjE], rtac ctxt disjCI, etac ctxt disjE, - asm_simp_only ctxt [], etac ctxt notE, asm_simp_only ctxt []]]]; - in - [rtac ctxt rep_meta_mp, simp_only_plus ctxt - (Quotient_abs_reps @ map (fn thm => thm RS sym) Quotient_total_abs_eq_iffs) - [resolve_tac ctxt [allI, conjI], eresolve_tac ctxt (conjE :: allE_insts)] - |> SELECT_GOAL o HEADGOAL, unfold_tac ctxt alpha_alpha's |> K] @ - (if mutual then [rtac ctxt alpha'_coinduct] else [rtac ctxt allI, rtac ctxt allI, - rtac ctxt impI, etac ctxt alpha'_coinduct, simp_only ctxt @{thms triv_forall_equality}]) @ - [unfold_tac ctxt (map (fn thm => thm RS sym) alpha_alpha's) |> K, - @{map 13} subgoal_solve_tac assms raw_nchotomys TT_abs_ctors cctor_defs - Quotient_total_abs_eq_iffs alpha_syms alpha_elims abs_meta_mps mr_rel_maps - rel_mono_strong_ids mr_rel_mono_strong0s mr_le_rel_OOs mr_rel_flips |> RANGE] |> EVERY1 - end; - -fun mk_TT_fresh_coinduct_param_tac fbound TT_existential_coinduct TT_fresh_cases ctxt assms = - EVERY1 [rtac ctxt TT_existential_coinduct THEN_ALL_NEW REPEAT_DETERM o etac ctxt bexE, - map (fn thm => REPEAT_DETERM_N 2 o EVERY' (rtac ctxt (thm OF take fbound assms) :: - replicate fbound (assume_tac ctxt)) THEN' REPEAT_DETERM o (resolve_tac ctxt [exI, conjI] - ORELSE' etac ctxt sym)) TT_fresh_cases |> RANGE, - asm_simp_only_plus ctxt [] [resolve_tac ctxt (drop fbound assms) THEN' assume_tac ctxt, - EVERY' [dtac ctxt @{thm Int_emptyD}, assume_tac ctxt, assume_tac ctxt]]]; - -fun mk_rrename_id_tac rrename_def rename_id Quotient_abs_rep ctxt = - simp_only ctxt [rrename_def, rename_id, Quotient_abs_rep] |> HEADGOAL; - -fun mk_rrename_comp_tac rrename_def Quotient_total_abs_eq_iff alpha_refl alpha_sym alpha_trans alpha_bij_eq - alpha_quotient_sym rename_comp ctxt prems = - unfold_thms_tac ctxt [rrename_def] THEN - EVERY1 [ - rtac ctxt (iffD2 OF [Quotient_total_abs_eq_iff]), - rtac ctxt alpha_trans, - rtac ctxt (iffD2 OF [alpha_bij_eq]), - REPEAT_DETERM o resolve_tac ctxt prems, - rtac ctxt alpha_sym, - rtac ctxt alpha_quotient_sym, - K (unfold_thms_tac ctxt [rename_comp OF prems]), - rtac ctxt alpha_refl - ]; - -fun mk_rrename_cong_id_tac FFVars_defs rrename_def Quotient_abs_rep Quotient_total_abs_eq_iff - alpha_bij alpha_refl ctxt assms = - EVERY1 [simp_only_tac ctxt (rrename_def :: FFVars_defs), - rtac ctxt (@{thm arg_cong[of _ _ "\x. _ = x"]} OF [Quotient_abs_rep] RS iffD1), - simp_only_tac ctxt [Quotient_total_abs_eq_iff], rtac ctxt alpha_bij, - simp_only_plus ctxt assms [resolve_tac ctxt [ballI, alpha_refl], Goal.assume_rule_tac ctxt]]; - -end; diff --git a/Tools/mrbnf_recursor.ML b/Tools/mrbnf_recursor.ML index 280cc7a6..894fe9a0 100644 --- a/Tools/mrbnf_recursor.ML +++ b/Tools/mrbnf_recursor.ML @@ -49,11 +49,11 @@ sig Uctor: term, validity: { pred: term, - valid_rrename: 'a, + valid_permute: 'a, valid_Uctor: 'a } option, axioms: { - rrename_Uctor: 'a, + permute_Uctor: 'a, FVars_subsets: 'a list } }; @@ -140,11 +140,11 @@ type 'a quotient_model = { Uctor: term, validity: { pred: term, - valid_rrename: 'a, + valid_permute: 'a, valid_Uctor: 'a } option, axioms: { - rrename_Uctor: 'a, + permute_Uctor: 'a, FVars_subsets: 'a list } }; @@ -189,43 +189,43 @@ fun mk_quotient_model quot substitution qmodel = let fun mk_subst f = if null substitution then I else f substitution; val subst = mk_subst Term.subst_atomic_types; - val Ts = fst (split_last (binder_types (fastype_of (#rename quot)))); + val Ts = fst (split_last (binder_types (fastype_of (#permute quot)))); in { U = mk_subst Term.typ_subst_atomic (#T quot), binding = #binding qmodel, - UFVarss = map (Term.abs ("t", #T quot) o subst) (#FVars quot), + UFVarss = map (Term.abs ("t", #T quot) o subst) (#FVarss quot), Umap = fold_rev Term.abs (map (pair "f") Ts) ( - Term.abs ("t", #T quot) (Term.list_comb (subst (#rename quot), map Bound (length Ts downto 1))) + Term.abs ("t", #T quot) (Term.list_comb (subst (#permute quot), map Bound (length Ts downto 1))) ), Uctor = #Uctor qmodel, validity = Option.map (fn v => { pred = #pred v, - valid_Umap = #valid_rrename v, + valid_Umap = #valid_permute v, valid_Uctor = #valid_Uctor v }) (#validity qmodel), axioms = { - Umap_id0 = fn ctxt => rtac ctxt (#rename_id quot) 1, + Umap_id0 = fn ctxt => rtac ctxt (#permute_id quot) 1, Umap_comp0 = fn ctxt => EVERY1 [ rtac ctxt sym, rtac ctxt trans, rtac ctxt @{thm comp_apply}, - rtac ctxt (#rename_comp quot), + rtac ctxt (#permute_comp quot), REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt card_thms) ], Umap_cong_id = fn ctxt => EVERY1 [ - rtac ctxt (#rename_cong_id (#inner quot)), + rtac ctxt (#permute_cong_id (#inner quot)), REPEAT_DETERM o FIRST' [ assume_tac ctxt, Goal.assume_rule_tac ctxt, resolve_tac ctxt card_thms ] ], - Umap_Uctor = #rrename_Uctor (#axioms qmodel), + Umap_Uctor = #permute_Uctor (#axioms qmodel), UFVars_subsets = #FVars_subsets (#axioms qmodel) } } : (Proof.context -> tactic) model end; -fun mk_termlike_goals vars min_bound quotient_opt T mapx FVars pred_opt lthy = +fun mk_termlike_goals vars min_bound (quotient_opt : MRBNF_FP_Def_Sugar.quotient_result MRBNF_FP_Def_Sugar.fp_result_T option) T mapx FVars pred_opt lthy = let val n = length vars; @@ -269,7 +269,7 @@ fun mk_termlike_goals vars min_bound quotient_opt T mapx FVars pred_opt lthy = val FVars = nth FVars i; in fold_rev Logic.all (d::t @ fs) (addPred (add_f_prems min_bound fs (mk_Trueprop_eq ( - Term.list_comb (FVars, map (fn t => Term.list_comb (#rename (the quotient_opt), fs @ [t])) t @ [Term.list_comb (mapx, fs @ t) $ d]), + Term.list_comb (FVars, map (fn t => Term.list_comb (#permute (the quotient_opt), fs @ [t])) t @ [Term.list_comb (mapx, fs @ t) $ d]), mk_image (nth fs i) $ Term.list_comb (FVars, t @ [d]) )))) end @@ -301,7 +301,7 @@ fun mk_UPred params valids rec_vars deads plives As bounds frees mrbnf y = ) $ y; in SOME pre_pred end -fun prove_model_axioms qualify fp_res params (models : (Proof.context -> tactic) model list) vars (pfrees, pbounds, plives) lthy = +fun prove_model_axioms qualify (fp_res : MRBNF_FP_Def_Sugar.fp_result) params (models : (Proof.context -> tactic) model list) vars (pfrees, pbounds, plives) lthy = let val ptacs = #axioms params; val b = Binding.conglomerate (map #binding models); @@ -436,7 +436,9 @@ fun prove_model_axioms qualify fp_res params (models : (Proof.context -> tactic) ) models (#quotient_fps fp_res); val As = flat (map2 replicate (#rec_vars fp_res) prod_PUs); - val frees = vars @ pfrees; + val bfrees = map (nth vars) (#bfree_vars fp_res); + val bfree_fs = map (nth fs) (#bfree_vars fp_res); + val frees = vars @ pfrees @ bfrees; val bounds = pbounds @ vars; val ((((y, pus), u), t), _) = lthy @@ -454,7 +456,7 @@ fun prove_model_axioms qualify fp_res params (models : (Proof.context -> tactic) val mapF = MRBNF_Def.mk_map_of_mrbnf deads (plives @ As) (plives @ As') bounds frees mrbnf; val fsts = map BNF_Util.fst_const As; val gs = MRBNF_Def.interlace (map HOLogic.id_const plives @ fsts) - (map HOLogic.id_const (pbounds @ vars)) (map HOLogic.id_const (vars @ pfrees)) + (map HOLogic.id_const bounds) (map HOLogic.id_const frees) (MRBNF_Def.var_types_of_mrbnf mrbnf); in Term.list_comb (mapF, gs) end; @@ -470,7 +472,7 @@ fun prove_model_axioms qualify fp_res params (models : (Proof.context -> tactic) NONE => I | SOME v => fn t => BNF_FP_Util.mk_If (#pred v $ Bound 0) t (BNF_GFP_Util.mk_undefined (fastype_of t)); val pair_maps = @{map 3} (fn pu => fn model => fn quot => HOLogic.mk_case_prod (Term.abs ("t", #T quot) ( Term.abs ("pu", snd (dest_Free pu)) (HOLogic.mk_prod ( - Term.list_comb (#rename quot, fs @ [Bound 1]), + Term.list_comb (#permute quot, fs @ [Bound 1]), Term.abs ("p", #P params) (valid_If ( Term.list_comb (#Umap model, fs @ [Bound 2]) $ ( Bound 1 $ (Term.list_comb (fst Pmap, map mk_inv fs) $ Bound 0) @@ -479,7 +481,7 @@ fun prove_model_axioms qualify fp_res params (models : (Proof.context -> tactic) )))) pus (flat (map2 replicate (#rec_vars fp_res) models)) (flat (map2 replicate (#rec_vars fp_res) (#quotient_fps fp_res))); val mapF = Term.list_comb ( MRBNF_Def.mk_map_of_mrbnf deads (plives @ As) (plives @ As) bounds frees mrbnf, - MRBNF_Def.interlace (map HOLogic.id_const plives @ pair_maps) (map HOLogic.id_const pbounds @ fs) (fs @ map HOLogic.id_const pfrees) (MRBNF_Def.var_types_of_mrbnf mrbnf) + MRBNF_Def.interlace (map HOLogic.id_const plives @ pair_maps) (map HOLogic.id_const pbounds @ fs) (fs @ map HOLogic.id_const pfrees @ bfree_fs) (MRBNF_Def.var_types_of_mrbnf mrbnf) ); in fold_rev Logic.all (fs @ [y, p]) (addUPred (add_f_prems (#min_bound params) fs (mk_Trueprop_eq ( @@ -506,12 +508,12 @@ fun prove_model_axioms qualify fp_res params (models : (Proof.context -> tactic) val recSetss = fst (fold_map chop (#rec_vars fp_res) ( drop (length plives) (map_filter (fn (MRBNF_Def.Live_Var, x) => SOME (x $ y) | _ => NONE) mrbnf_sets) )); - val recSets_Uns = map (foldr1 mk_Un) recSetss; + val recSets_Uns = map (try (foldr1 mk_Un)) recSetss; in fold_rev Logic.all [y, p] (addUPred (fold_rev (curry Logic.mk_implies) ( mk_Trueprop_eq ( mk_Int (topBind i $ y, HOLogic.mk_binop @{const_name sup} (nth (map fst PFVarss) i $ p, A)), Const (@{const_name bot}, HOLogic.mk_setT (nth vars i)) - ) :: @{map 4} (fn recSets_Un => fn prod_PU => fn model => fn quotient_fp => + ) :: @{map_filter 4} (fn prod_PU => fn model => fn quotient_fp => Option.map (fn recSets_Un => let val (t_T, pu_T) = HOLogic.dest_prodT prod_PU; val pu = Free ("pu", pu_T); @@ -520,13 +522,13 @@ fun prove_model_axioms qualify fp_res params (models : (Proof.context -> tactic) HOLogic.mk_Trueprop (HOLogic.mk_mem (HOLogic.mk_tuple [t, pu], recSets_Un)) $ HOLogic.mk_Trueprop (mk_leq (Term.list_comb (nth (#UFVarss model) i, [t, pu $ p])) - (mk_Un (mk_Un (nth (#FVars quotient_fp) i $ t, nth (map fst PFVarss) i $ p), A)) + (mk_Un (mk_Un (nth (#FVarss quotient_fp) i $ t, nth (map fst PFVarss) i $ p), A)) ) )) end - ) recSets_Uns prod_PUs models (#quotient_fps fp_res)) + )) prod_PUs models (#quotient_fps fp_res) recSets_Uns) (HOLogic.mk_Trueprop (mk_leq (Term.list_comb (nth (#UFVarss model) i, [#ctor quotient_fp $ (mapF_ap $ y), #Uctor model $ y $ p])) - (mk_Un (mk_Un (nth (#FVars quotient_fp) i $ (#ctor quotient_fp $ (mapF_ap $ y)), nth (map fst PFVarss) i $ p), A)) + (mk_Un (mk_Un (nth (#FVarss quotient_fp) i $ (#ctor quotient_fp $ (mapF_ap $ y)), nth (map fst PFVarss) i $ p), A)) )))) end; in @@ -596,7 +598,7 @@ fun mk_names _ [] = [] | mk_names s [_] = [s] | mk_names s xs = map (fn i => s ^ string_of_int i) (1 upto length xs) -fun define_recursor_consts qualify fp_res params (models : thm model list) vars (pfrees, pbounds, plives) lthy = +fun define_recursor_consts qualify (fp_res : MRBNF_FP_Def_Sugar.fp_result) params (models : thm model list) vars (pfrees, pbounds, plives) lthy = let val nvars = length vars; @@ -635,11 +637,12 @@ fun define_recursor_consts qualify fp_res params (models : thm model list) vars mk_int_empty (mk_image pick_t $ (bset $ Bound 1), Un_t) ] )))) end - ) vars (#FVars raw) (#PFVarss params) (#avoiding_sets params) bsets; + ) vars (#FVarss raw) (#PFVarss params) (#avoiding_sets params) bsets; in mk_defs_t false (#binding model) qualify name 0 rhss lthy end ) models (#raw_fps fp_res) (#pre_mrbnfs fp_res) (mk_names "suitable" models) lthy; val suitables = flat suitabless; + val bfrees = map (nth vars) (#bfree_vars fp_res); val ((((fs, p), pickss), xs), names_lthy) = lthy |> mk_Frees "f" (map (fn v => v --> v) vars) ||>> apfst hd o mk_Frees "p" [#P params] @@ -679,6 +682,7 @@ fun define_recursor_consts qualify fp_res params (models : thm model list) vars | T => HOLogic.id_const T ) (snd (dest_Type A'_T)); in Term.list_comb (mapx, gs) end; + val ((((Umap', UFVars's), PUmap), Uctor'), lthy) = lthy |> def "Umap'" (nvars + 1) (fold_rev Term.absfree (map dest_Free fs) (Term.abs ("t", #T raw) ( Term.list_comb (#Umap model, fs @ [abs $ Bound 0]) @@ -694,9 +698,9 @@ fun define_recursor_consts qualify fp_res params (models : thm model list) vars ) models (#raw_fps fp_res) (#quotient_fps fp_res) (#pre_mrbnfs fp_res) lthy; val b = Binding.conglomerate (map #binding models); - fun interlace lives bounds frees = MRBNF_Def.interlace + fun interlace lives bounds frees bfrees = MRBNF_Def.interlace (map HOLogic.id_const plives @ lives) (map HOLogic.id_const pbounds @ bounds) - (frees @ map HOLogic.id_const pfrees); + (frees @ map HOLogic.id_const pfrees @ bfrees); val map_ts = @{map 3} (fn mrbnf => fn raw => fn model_const => let @@ -738,18 +742,20 @@ fun define_recursor_consts qualify fp_res params (models : thm model list) vars val map_ts = @{map 4} (fn mrbnf => fn x => fn picks => fn (map_t1, map_t2) => let val var_types = MRBNF_Def.var_types_of_mrbnf mrbnf; - val rename_ts = map2 (fn i => fn raw => if member (op=) (flat (#binding_relation fp_res)) i then - let val to_rename = @{map 3} (fn is => fn pick => fn var => if member (op=) is i then pick $ x $ p else HOLogic.id_const var) (#binding_relation fp_res) picks vars; + (* TODO: Fix for multiple bounds *) + val rename_ts = map2 (fn i => fn raw => if member (op=) (flat (map hd (#binding_relation fp_res))) i then + let val to_rename = @{map 3} (fn is => fn pick => fn var => if member (op=) (hd is) i then pick $ x $ p else HOLogic.id_const var) (#binding_relation fp_res) picks vars; in if forall (fn Const (@{const_name id}, _) => true | _ => false) to_rename then HOLogic.id_const (#T raw) else - Term.list_comb (#rename raw, to_rename) + Term.list_comb (#permute raw, to_rename) end else HOLogic.id_const (#T raw) ) (0 upto foldr1 (op+) (#rec_vars fp_res) - 1) (replicate_rec (#raw_fps fp_res)); + val picks = map (fn pick => pick $ x $ p) picks; in Term.list_comb (map_t1, - interlace (flat (map2 replicate (#rec_vars fp_res) rec_ts)) ids ids var_types + interlace (flat (map2 replicate (#rec_vars fp_res) rec_ts)) ids ids (map HOLogic.id_const bfrees) var_types ) $ (Term.list_comb (map_t2, - interlace rename_ts (map (fn pick => pick $ x $ p) picks) ids var_types + interlace rename_ts picks ids (map (nth picks) (#bfree_vars fp_res)) var_types ) $ x) end ) (#pre_mrbnfs fp_res) xs pickss map_ts; @@ -783,8 +789,7 @@ fun define_recursor_consts qualify fp_res params (models : thm model list) vars ) Ts); val funs = map2 (fn snds => fn T => foldl1 HOLogic.mk_comp (fst_const T :: rev snds)) sndss Ts'; val map_sum = foldr1 (uncurry mk_map_sum) funs; - val subshape_rel = the (#subshape_rel (#inner (hd (#raw_fps fp_res)))); - in mk_inv_image subshape_rel map_sum end; + in mk_inv_image (#subshape_rel (the (#fp_thms fp_res))) map_sum end; val pick_prems = maps ((fn suitable_def => let @@ -796,11 +801,14 @@ fun define_recursor_consts qualify fp_res params (models : thm model list) vars in [conj RS conjunct1, conj RS conjunct2 RS conjunct1] end ) o snd) suitables; - val (info, lthy) = Function.prove_termination NONE (mk_f_termination_tac mk_relation - (the (#wf_subshape (#inner (hd (#raw_fps fp_res))))) - (maps (flat o the o #set_subshape_imagess o #inner) (#raw_fps fp_res)) - (maps (flat o the o #set_subshapess o #inner) (#raw_fps fp_res)) - (maps set_map_of_mrbnf (#pre_mrbnfs fp_res)) pick_prems lthy + val (info, lthy) = Function.prove_termination NONE (the_default + (Function_Common.termination_prover_tac true lthy) + (Option.map (fn fp_thms => mk_f_termination_tac mk_relation + (#wf_subshape fp_thms) + (flat (#set_subshape_permutess fp_thms)) + (flat (#set_subshapess fp_thms)) + (maps set_map_of_mrbnf (#pre_mrbnfs fp_res)) pick_prems lthy + ) (#fp_thms fp_res)) ) lthy; val f_simps = @{map 5} (fn lhs => fn map_t => fn model_const => fn x => fn mrbnf => @@ -856,6 +864,8 @@ fun define_recursor_consts qualify fp_res params (models : thm model list) vars val n = length suitables + nvars + 2; val Pmap = Term.list_comb (#Pmap params, map mk_inv fs) $ p; + val bfree_fs = map (nth fs) (#bfree_vars fp_res); + val (XXls, lthy) = mk_defs_t false b qualify "XXl" n (@{map 4} (fn mrbnf => fn (map_t1, _) => fn picks => fn x => let @@ -863,14 +873,15 @@ fun define_recursor_consts qualify fp_res params (models : thm model list) vars val pick_ts' = map2 (fn f => fn pick_t => HOLogic.mk_comp (f, pick_t)) fs pick_ts; val recs = @{map 4} (fn i => fn raw => fn (f_t, _) => fn model_const => let + (* TODO: fix for multiple bounds *) val t = Free ("t", #T raw); - val rename_t = Term.list_comb (#rename raw, @{map 3} (fn rel => fn pick_t => fn f => - if member (op=) rel i then pick_t else f + val rename_t = Term.list_comb (#permute raw, @{map 3} (fn rel => fn pick_t => fn f => + if member (op=) (hd rel) i then pick_t else f ) (#binding_relation fp_res) pick_ts' fs) $ t; - val binds = member (op=) (flat (#binding_relation fp_res)) i; + val binds = member (op=) (maps hd (#binding_relation fp_res)) i; val inner_t = if binds then - Term.list_comb (#rename raw, map2 (fn rel => fn pick_t => - if member (op=) rel i then pick_t else HOLogic.id_const (Term.body_type (fastype_of pick_t)) + Term.list_comb (#permute raw, map2 (fn rel => fn pick_t => + if member (op=) (hd rel) i then pick_t else HOLogic.id_const (Term.body_type (fastype_of pick_t)) ) (#binding_relation fp_res) pick_ts) $ t else t; val PU_t = Term.list_comb (fst (#PUmap' model_const), fs) @@ -878,31 +889,32 @@ fun define_recursor_consts qualify fp_res params (models : thm model list) vars in Term.absfree (dest_Free t) (HOLogic.mk_prod (rename_t, valid_If PU_t)) end ) (0 upto nrecs - 1) (replicate_rec (#raw_fps fp_res)) (replicate_rec rec_fs) (replicate_rec model_consts); in fold_rev Term.absfree (map dest_Free (flat pickss @ fs @ [p, x])) ( - Term.list_comb (map_t1, interlace recs pick_ts' fs (MRBNF_Def.var_types_of_mrbnf mrbnf)) $ x + Term.list_comb (map_t1, interlace recs pick_ts' fs (map (nth pick_ts') (#bfree_vars fp_res)) (MRBNF_Def.var_types_of_mrbnf mrbnf)) $ x ) end ) (#pre_mrbnfs fp_res) map_ts pickss xs) lthy; - val rename_ts = map (fn raw => Term.list_comb (#rename raw, fs)) (#raw_fps fp_res); + val rename_ts = map (fn raw => Term.list_comb (#permute raw, fs)) (#raw_fps fp_res); val (XXrs, lthy) = mk_defs_t false b qualify "XXr" n (@{map 4} (fn mrbnf => fn (map_t1, map_t2) => fn picks => fn x => let val var_types = MRBNF_Def.var_types_of_mrbnf mrbnf; val inner_map = Term.list_comb (map_t2, interlace ( flat (map2 replicate (#rec_vars fp_res) rename_ts) - ) fs fs var_types) $ x; + ) fs fs bfree_fs var_types) $ x; val pick_ts = map2 (fn pick => fn f => HOLogic.mk_comp (pick $ inner_map $ p, f)) picks fs; val recs = @{map 3} (fn i => fn raw => fn (f_t, _) => let + (* TODO: fix for multiple bounds *) val t = Free ("t", #T raw); - val rename_t = Term.list_comb (#rename raw, @{map 3} (fn rel => fn pick_t => fn f => - if member (op=) rel i then pick_t else f + val rename_t = Term.list_comb (#permute raw, @{map 3} (fn rel => fn pick_t => fn f => + if member (op=) (hd rel) i then pick_t else f ) (#binding_relation fp_res) pick_ts fs) $ t; in Term.absfree (dest_Free t) (HOLogic.mk_prod ( rename_t, valid_If (Term.list_comb (f_t, flat pickss) $ rename_t) )) end ) (0 upto nrecs - 1) (replicate_rec (#raw_fps fp_res)) (replicate_rec rec_fs); in fold_rev Term.absfree (map dest_Free (flat pickss @ fs @ [p, x])) ( - Term.list_comb (map_t1, interlace recs pick_ts fs var_types) $ x + Term.list_comb (map_t1, interlace recs pick_ts fs (map (nth pick_ts) (#bfree_vars fp_res)) var_types) $ x ) end ) (#pre_mrbnfs fp_res) map_ts pickss xs) lthy; @@ -1007,19 +1019,24 @@ fun create_binding_recursor qualify fp_res params models lthy = val rec_idxss = map (fn (a, _, _) => 0 upto length a - 1) pre_setss; fun replicate_rec xs = flat (map2 replicate (#rec_vars fp_res) xs) - val FVars_UNss = @{map 3} (fn (lsets, bsets, _) => fn x => fn idxs => - @{map 3} (fn bset => fn rel => fn FVarss => @{map 3} (fn lset => fn i => fn FVars => - let val UN = mk_UNION (lset $ x) FVars; - in if member (op=) rel i then mk_minus (UN, bset $ x) else UN end - ) lsets idxs (replicate_rec FVarss)) bsets (#binding_relation fp_res) (transpose (map #FVars (#raw_fps fp_res))) + (* TODO: fix for multiple bounds *) + val FVars_UNss = @{map 3} (fn (lsets, bsets, fsets) => fn x => fn idxs => + @{map 4} (fn j => fn bset => fn rel => fn FVarss => ( + if member (op=) (#bfree_vars fp_res) j then [mk_minus (nth fsets (j + nvars) $ x, bset $ x)] else [], + @{map 3} (fn lset => fn i => fn FVars => + let val UN = mk_UNION (lset $ x) FVars; + in if member (op=) (hd rel) i then mk_minus (UN, bset $ x) else UN end + ) lsets idxs (replicate_rec FVarss) + )) (0 upto nvars - 1) bsets (#binding_relation fp_res) (transpose (map #FVarss (#raw_fps fp_res))) ) pre_setss xs rec_idxss; val addPred = addPred (Option.map #pred (#validity params)) p; val names = map (fst o dest_Free); - val pick_id_onss = @{map 5} (fn x => fn raw => @{map 4} (fn rel => fn FVars_UNs => fn suitable => fn pick => + (* TODO: fix for multiple bounds *) + val pick_id_onss = @{map 5} (fn x => fn raw => @{map 5} (fn i => fn rel => fn (bfree_sets, FVars_UNs) => fn suitable => fn pick => let - val A = foldl1 mk_Un (map (nth FVars_UNs) rel); + val A = foldl1 mk_Un (bfree_sets @ map (nth FVars_UNs) rel); val goal = Logic.mk_implies ( HOLogic.mk_Trueprop (fst suitable $ pick), addPred (HOLogic.mk_Trueprop (mk_id_on A (pick $ x $ p))) @@ -1031,9 +1048,10 @@ fun create_binding_recursor qualify fp_res params models lthy = REPEAT_DETERM o etac ctxt conjE, REPEAT_DETERM o (rtac ctxt conjI ORELSE' etac ctxt @{thm imsupp_id_on}) ]) end - ) (#binding_relation fp_res)) xs (#raw_fps fp_res) FVars_UNss suitabless pickss; + ) (0 upto nvars - 1) (map hd (#binding_relation fp_res))) xs (#raw_fps fp_res) FVars_UNss suitabless pickss; - val pick_id_onsss' = @{map 5} (fn x => @{map 5} (fn rel => fn FVars_UNs => fn suitable => fn pick => fn pick_id_on => + (* TODO: fix for multiple bounds *) + val pick_id_onsss' = @{map 5} (fn x => @{map 6} (fn i => fn rel => fn (bfree_sets, FVars_UNs) => fn suitable => fn pick => fn pick_id_on => map (fn A => let val goal = Logic.mk_implies ( HOLogic.mk_Trueprop (fst suitable $ pick), @@ -1045,8 +1063,8 @@ fun create_binding_recursor qualify fp_res params models lthy = REPEAT_DETERM o etac ctxt conjE, TRY o assume_tac ctxt ]) end - ) (map (nth FVars_UNs) rel) - ) (#binding_relation fp_res)) xs FVars_UNss suitabless pickss pick_id_onss; + ) (bfree_sets @ map (nth FVars_UNs) rel) + ) (0 upto nvars - 1) (map hd (#binding_relation fp_res))) xs FVars_UNss suitabless pickss pick_id_onss; val f_prems = mk_f_prems (#min_bound params) fs; val g_prems = mk_f_prems (#min_bound params) gs; @@ -1063,18 +1081,20 @@ fun create_binding_recursor qualify fp_res params models lthy = val plive_ids = map HOLogic.id_const plives; val pbound_ids = map HOLogic.id_const pbounds; val pfree_ids = map HOLogic.id_const pfrees; - fun mk_map_comb_of_mrbnf deads lives bounds frees = + val bfree_fs = map (nth fs) (#bfree_vars fp_res); + fun mk_map_comb_of_mrbnf deads lives bounds frees bfrees = MRBNF_Def.mk_map_comb_of_mrbnf deads (plive_ids @ lives) - (pbound_ids @ bounds) (frees @ pfree_ids); + (pbound_ids @ bounds) (frees @ pfree_ids @ bfrees); val map_rename_ts = @{map 3} (fn x => fn mrbnf => fn deads => mk_map_comb_of_mrbnf deads - (replicate_rec (map (fn raw => Term.list_comb (#rename raw, fs)) (#raw_fps fp_res))) - fs fs mrbnf $ x + (replicate_rec (map (fn raw => Term.list_comb (#permute raw, fs)) (#raw_fps fp_res))) + fs fs bfree_fs mrbnf $ x ) xs (#pre_mrbnfs fp_res) deadss; - val pick_id_on_imagess = @{map 7} (fn x => fn map_t => fn mrbnf => @{map 6} (fn rel => fn f => fn pick_id_on => fn FVars_UNs => fn suitable => fn pick => + (* TODO: fix for multiple bounds *) + val pick_id_on_imagess = @{map 7} (fn x => fn map_t => fn mrbnf => @{map 6} (fn rel => fn f => fn pick_id_on => fn (bfree_sets, FVars_UNs) => fn suitable => fn pick => let - val A = foldl1 mk_Un (map (nth FVars_UNs) rel); + val A = foldl1 mk_Un (bfree_sets @ map (nth FVars_UNs) rel); val goal = Logic.mk_implies ( HOLogic.mk_Trueprop (fst suitable $ pick), addPred (HOLogic.mk_Trueprop (mk_id_on (mk_image f $ A) (pick $ map_t $ p))) @@ -1087,20 +1107,21 @@ fun create_binding_recursor qualify fp_res params models lthy = EqSubst.eqsubst_tac ctxt [0] ( @{thms image_comp[unfolded comp_def] image_set_diff[OF bij_is_inj, symmetric] image_UN[symmetric] image_Un[symmetric]} @ MRBNF_Def.set_map_of_mrbnf mrbnf - @ maps #FVars_renames (#raw_fps fp_res) + @ maps #FVars_permutes (#raw_fps fp_res) ), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ prems @ card_thms) ], rtac ctxt refl ]) end - ) (#binding_relation fp_res) fs) xs map_rename_ts (#pre_mrbnfs fp_res) pick_id_onss FVars_UNss suitabless pickss; + ) (map hd (#binding_relation fp_res)) fs) xs map_rename_ts (#pre_mrbnfs fp_res) pick_id_onss FVars_UNss suitabless pickss; - val pick_id_on_image'sss = @{map 6} (fn x => fn map_t => @{map 6} (fn rel => fn f => fn FVars_UNs => fn suitable => fn pick => fn pick_id_on_image => - map (fn i => + (* TODO: fix for multiple bounds *) + val pick_id_on_image'sss = @{map 6} (fn x => fn map_t => @{map 6} (fn rel => fn f => fn (bfree_sets, FVars_UNs) => fn suitable => fn pick => fn pick_id_on_image => + map (fn UN => let val goal = Logic.mk_implies ( HOLogic.mk_Trueprop (fst suitable $ pick), - addPred (HOLogic.mk_Trueprop (mk_id_on (mk_image f $ nth FVars_UNs i) (pick $ map_t $ p))) + addPred (HOLogic.mk_Trueprop (mk_id_on (mk_image f $ UN) (pick $ map_t $ p))) ); in Goal.prove_sorry lthy (names (fs @ [pick, x, p])) f_prems goal (fn {context=ctxt, prems} => EVERY1 [ dtac ctxt (pick_id_on_image OF prems), @@ -1109,18 +1130,21 @@ fun create_binding_recursor qualify fp_res params models lthy = REPEAT_DETERM o etac ctxt conjE, TRY o assume_tac ctxt ]) end - ) rel - ) (#binding_relation fp_res) fs) xs map_rename_ts FVars_UNss suitabless pickss pick_id_on_imagess; + ) (bfree_sets @ map (nth FVars_UNs) rel) + ) (map hd (#binding_relation fp_res)) fs) xs map_rename_ts FVars_UNss suitabless pickss pick_id_on_imagess; + + val bfrees = map (nth vars) (#bfree_vars fp_res); + val bfree_ids = map HOLogic.id_const bfrees; val prod_PU_Ts = map2 (fn raw => fn model => HOLogic.mk_prodT (#T raw, #P params --> #U model)) (#raw_fps fp_res) models; val quot_PU_Ts = map2 (fn quot => fn model => HOLogic.mk_prodT (#T quot, #P params --> #U model)) (#quotient_fps fp_res) models; val map_id_fsts = map2 (fn deads => - mk_map_comb_of_mrbnf deads (replicate_rec (map fst_const prod_PU_Ts)) ids ids + mk_map_comb_of_mrbnf deads (replicate_rec (map fst_const prod_PU_Ts)) ids ids bfree_ids ) deadss (#pre_mrbnfs fp_res); val quot_map_id_fsts = map2 (fn deads => mk_map_comb_of_mrbnf deads (replicate_rec (map2 (fn quot => fn model => fst_const (HOLogic.mk_prodT (#T quot, #P params --> #U model)) - ) (#quotient_fps fp_res) models)) ids ids + ) (#quotient_fps fp_res) models)) ids ids bfree_ids ) deadss (#pre_mrbnfs fp_res); val valid_If = case #validity params of NONE => I | SOME v => fn t => Term.abs ("p", #P params) (BNF_FP_Util.mk_If (#pred v $ Bound 0) (Term.incr_boundvars 1 t $ Bound 0) (BNF_GFP_Util.mk_undefined (fastype_of (t $ Bound 0)))) @@ -1140,10 +1164,10 @@ fun create_binding_recursor qualify fp_res params models lthy = val Umap'_Uctor's = @{map 10} (fn y => fn mrbnf => fn Umap' => fn Uctor' => fn raw => fn quot => fn map_id_fst => fn deads => fn model => fn valid_prems => let val live_ts = @{map 3} (fn raw => fn PUmap' => fn PU_T => HOLogic.mk_case_prod (Term.abs ("t", #T raw) (Term.abs ("pu", snd (HOLogic.dest_prodT PU_T)) (HOLogic.mk_prod ( - Term.list_comb (#rename raw, fs) $ Bound 1, + Term.list_comb (#permute raw, fs) $ Bound 1, valid_If (Term.list_comb (fst PUmap', fs) $ Bound 1 $ Bound 0) ))))) (#raw_fps fp_res) PUmap's prod_PU_Ts; - val map_t = mk_map_comb_of_mrbnf deads (replicate_rec live_ts) fs fs mrbnf; + val map_t = mk_map_comb_of_mrbnf deads (replicate_rec live_ts) fs fs bfree_fs mrbnf; val goal = mk_Trueprop_eq ( Term.list_comb (fst Umap', fs) $ (#ctor raw $ (map_id_fst $ y)) $ (fst Uctor' $ y $ p), fst Uctor' $ (map_t $ y) $ (Term.list_comb (#Pmap params, fs) $ p) @@ -1181,11 +1205,11 @@ fun create_binding_recursor qualify fp_res params models lthy = REPEAT_DETERM o (rtac ctxt refl ORELSE' EVERY' [ rtac ctxt @{thm iffD2[OF prod.inject]}, rtac ctxt conjI, - SELECT_GOAL (unfold_thms_tac ctxt (map (#rename_def o #inner) (#quotient_fps fp_res))), + SELECT_GOAL (unfold_thms_tac ctxt (map (#permute_def o #inner) (#quotient_fps fp_res))), resolve_tac ctxt (map (fn quot => iffD2 OF [#total_abs_eq_iff (#inner quot)]) (#quotient_fps fp_res)), resolve_tac ctxt (map (fn raw => iffD2 OF [#alpha_bij_eq (#inner raw)]) (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (prems @ card_thms), - resolve_tac ctxt (map (fn quot => #alpha_quotient_sym (#inner quot)) (#quotient_fps fp_res)), + resolve_tac ctxt (map (fn quot => #rep_abs_sym (#inner quot)) (#quotient_fps fp_res)), rtac ctxt refl ]) ] @@ -1193,23 +1217,21 @@ fun create_binding_recursor qualify fp_res params models lthy = ) ys (#pre_mrbnfs fp_res) Umap's Uctor's (#raw_fps fp_res) (#quotient_fps fp_res) map_id_fsts deadss models valid_y_premss; val FVars_def2ss = map2 (fn quot => map2 (fn FVars_def => fn thm => - Local_Defs.unfold0 lthy [ - @{thm fun_cong[OF meta_eq_to_obj_eq, symmetric]} OF [FVars_def] - ] (thm OF [#alpha_quotient_sym (#inner quot)]) + Local_Defs.unfold0 lthy [Thm.symmetric FVars_def] (thm OF [#rep_abs_sym (#inner quot)]) ) (#FVars_defs (#inner quot)) o #alpha_FVarss o #inner) (#quotient_fps fp_res) (#raw_fps fp_res); val FVars_def2s = flat FVars_def2ss; fun mk_subset_premsss fps UFVarsss = @{map 2} (fn y => fn (lsets, _, _) => @{map 4} (fn PFVars => fn avoiding_set => - @{map 5} (fn raw => fn model => fn lsets => fn UFVars' => fn FVars => + @{map_filter 5} (fn raw => fn model => fn lsets => fn UFVars' => fn FVars => if lsets = [] then NONE else let val (t, pu) = apply2 Free (("t", #T raw), ("pu", #P params --> #U model)); - in fold_rev Logic.all [t, pu, p] (addPred (Logic.mk_implies ( + in SOME (fold_rev Logic.all [t, pu, p] (addPred (Logic.mk_implies ( HOLogic.mk_Trueprop (HOLogic.mk_mem (HOLogic.mk_prod (t, pu), foldl1 mk_Un (map (fn s => s $ y) lsets))), HOLogic.mk_Trueprop (mk_leq (UFVars' $ t $ (pu $ p)) (mk_Un (mk_Un (FVars $ t, PFVars $ p), avoiding_set))) - ))) end + )))) end ) fps models (fst (fold_map chop (#rec_vars fp_res) lsets)) - ) (#PFVarss params) (#avoiding_sets params) (transpose UFVarsss) (transpose (map #FVars fps)) + ) (#PFVarss params) (#avoiding_sets params) (transpose UFVarsss) (transpose (map #FVarss fps)) ); val subset_premsss = mk_subset_premsss (#raw_fps fp_res) (map (map fst) UFVars'ss) ys PU_setss; @@ -1263,7 +1285,7 @@ fun create_binding_recursor qualify fp_res params models lthy = Goal.assume_rule_tac ctxt ] ]) end - ) (#FVars raw) bsets (#PFVarss params) (#avoiding_sets params) (transpose UFVars'ss) + ) (#FVarss raw) bsets (#PFVarss params) (#avoiding_sets params) (transpose UFVars'ss) ) ys map_id_fsts (#quotient_fps fp_res) (#pre_mrbnfs fp_res) (#raw_fps fp_res) PU_setss models Uctor's valid_y_premss UFVars'ss subset_premsss; val Pmap_imsupp_empty = @@ -1279,7 +1301,7 @@ fun create_binding_recursor qualify fp_res params models lthy = HOLogic.mk_Trueprop (mk_int_empty ( mk_imsupp f, mk_Un (mk_Un (FVars $ (#ctor fp $ (map_t $ v)), PFVars $ p), avoiding_set) )) - ) (#FVars fp) (#PFVarss params) (#avoiding_sets params); + ) (#FVarss fp) (#PFVarss params) (#avoiding_sets params); fun mk_int_empty_prems v = map2 (fn f => fn bset => HOLogic.mk_Trueprop ( mk_int_empty (mk_image f $ (bset $ v), bset $ v) )); @@ -1289,13 +1311,13 @@ fun create_binding_recursor qualify fp_res params models lthy = val int_empty_prems = mk_int_empty_prems v fs bsets; val live_ts = @{map 3} (fn quot => fn model => fn PUmap => HOLogic.mk_case_prod (Term.abs ("t", #T quot) (Term.abs ("pu", #P params --> #U model) ( HOLogic.mk_prod ( - Term.list_comb (#rename quot, fs) $ Bound 1, + Term.list_comb (#permute quot, fs) $ Bound 1, valid_If (Term.list_comb (fst PUmap, fs) $ Bound 1 $ Bound 0) ) )))) (#quotient_fps fp_res) models PUmaps; val concl = mk_Trueprop_eq ( #Uctor model $ v $ p, - #Uctor model $ (mk_map_comb_of_mrbnf deads (replicate_rec live_ts) fs fs mrbnf $ v) $ p + #Uctor model $ (mk_map_comb_of_mrbnf deads (replicate_rec live_ts) fs fs bfree_fs mrbnf $ v) $ p ); val goal = fold_rev (curry Logic.mk_implies) (flat subset_premss @ imsupp_prems @ int_empty_prems) concl; in Goal.prove_sorry lthy (names (fs @ [v, p])) (valid_prems @ f_prems) goal (fn {context=ctxt, prems} => EVERY1 [ @@ -1347,15 +1369,15 @@ fun create_binding_recursor qualify fp_res params models lthy = val live_ts = @{map 3} (fn fp => fn PUmap => fn model => HOLogic.mk_case_prod ( Term.abs ("t", #T fp) (Term.abs ("pu", #P params --> #U model) (HOLogic.mk_case_prod ( Term.abs ("t'", #T fp) (Term.abs ("pu'", #P params --> #U model) (HOLogic.mk_conj ( - mk_rel fp (Term.list_comb (#rename fp, fs) $ Bound 3, Term.list_comb (#rename fp, gs) $ Bound 1), + mk_rel fp (Term.list_comb (#permute fp, fs) $ Bound 3, Term.list_comb (#permute fp, gs) $ Bound 1), valid_imp (Term.list_comb (fst PUmap, fs) $ Bound 4 $ Bound 3, Term.list_comb (fst PUmap, gs) $ Bound 2 $ Bound 1) ))) ))) )) fps PUmaps models; in HOLogic.mk_Trueprop (Term.list_comb ( - MRBNF_Def.mk_mr_rel_of_mrbnf deads live_Ts live_Ts (pbounds @ vars) (vars @ pfrees) mrbnf, - MRBNF_Def.interlace (map HOLogic.eq_const plives @ replicate_rec live_ts) (pbound_ids @ comps) (comps @ pfree_ids) (MRBNF_Def.var_types_of_mrbnf mrbnf) + MRBNF_Def.mk_mr_rel_of_mrbnf deads live_Ts live_Ts (pbounds @ vars) (vars @ pfrees @ bfrees) mrbnf, + MRBNF_Def.interlace (map HOLogic.eq_const plives @ replicate_rec live_ts) (pbound_ids @ comps) (comps @ pfree_ids @ map (nth comps) (#bfree_vars fp_res)) (MRBNF_Def.var_types_of_mrbnf mrbnf) ) $ y $ y') end; @@ -1459,7 +1481,7 @@ fun create_binding_recursor qualify fp_res params models lthy = rtac ctxt (#rep_abs (#inner quot)), rtac ctxt (#alpha_intro (#inner raw)), REPEAT_DETERM o resolve_tac ctxt @{thms bij_id supp_id_bound id_on_id}, - K (unfold_thms_tac ctxt (map #rename_id (#raw_fps fp_res))), + K (unfold_thms_tac ctxt (map #permute_id (#raw_fps fp_res))), EqSubst.eqsubst_tac ctxt [2] [MRBNF_Def.map_comp_of_mrbnf mrbnf], REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id}, K (unfold_thms_tac ctxt @{thms fst_comp_map_prod[symmetric]}), @@ -1491,7 +1513,7 @@ fun create_binding_recursor qualify fp_res params models lthy = REPEAT_DETERM o EVERY' [ REPEAT_DETERM o resolve_tac ctxt [ballI, impI], assume_tac ctxt ORELSE' EVERY' [ - SELECT_GOAL (unfold_thms_tac ctxt (@{thms case_prod_beta fst_map_prod snd_map_prod} @ map (#rename_def o #inner) (#quotient_fps fp_res))), + SELECT_GOAL (unfold_thms_tac ctxt (@{thms case_prod_beta fst_map_prod snd_map_prod} @ map (#permute_def o #inner) (#quotient_fps fp_res))), etac ctxt conjE, rtac ctxt conjI, resolve_tac ctxt (map (fn quot => iffD2 OF [#total_abs_eq_iff (#inner quot)]) (#quotient_fps fp_res)), @@ -1560,17 +1582,18 @@ fun create_binding_recursor qualify fp_res params models lthy = val pick_ts = map (fn s => s $ x $ p) picks; val live_ts = @{map 3} (fn i => fn raw => fn f => let + (* TODO: fix for multiple bounds *) val t = Free ("t", #T raw); - val rename_t = if not (member (op=) (flat (#binding_relation fp_res)) i) then t else - Term.list_comb (#rename raw, @{map 3} (fn rel => fn pick_t => fn v => - if member (op=) rel i then pick_t else HOLogic.id_const v + val rename_t = if not (member (op=) (maps hd (#binding_relation fp_res)) i) then t else + Term.list_comb (#permute raw, @{map 3} (fn rel => fn pick_t => fn v => + if member (op=) (hd rel) i then pick_t else HOLogic.id_const v ) (#binding_relation fp_res) pick_ts vars) $ t; in Term.absfree (dest_Free t) (HOLogic.mk_prod ( rename_t, valid_If (Term.list_comb (fst f, flat pickss) $ rename_t) )) end ) (0 upto rec_n - 1) (replicate_rec (#raw_fps fp_res)) (replicate_rec rec_fs); val map_t2 = mk_map_comb_of_mrbnf deads live_ts - pick_ts (map HOLogic.id_const vars) mrbnf; + pick_ts (map HOLogic.id_const vars) (map (nth pick_ts) (#bfree_vars fp_res)) mrbnf; val goal = fold_rev (curry Logic.mk_implies) suitable_prems (addPred (HOLogic.mk_Trueprop ( #alpha (#inner raw) $ (#ctor raw $ x) $ (#ctor raw $ (map_t $ (map_t2 $ x))) ))); @@ -1646,7 +1669,7 @@ fun create_binding_recursor qualify fp_res params models lthy = ], K (unfold_thms_tac ctxt @{thms image_comp[unfolded comp_def]}), REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (maps #FVars_renames (#raw_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (maps #FVars_permutes (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id supp_comp_bound bij_comp} @ [infinite_UNIV] @ prems @ pick_prems @ card_thms) ], K (unfold_thms_tac ctxt @{thms image_comp[symmetric] image_UN[symmetric]}), @@ -1699,16 +1722,16 @@ fun create_binding_recursor qualify fp_res params models lthy = ]) ] end ) end - ) (#FVars raw) bsets (#PFVarss params) (#avoiding_sets params) + ) (#FVarss raw) bsets (#PFVarss params) (#avoiding_sets params) ) xs (#raw_fps fp_res) (#pre_mrbnfs fp_res) XXls map_id_fsts PU_setss; val nrecs = foldr1 (op+) (#rec_vars fp_res); val int_empty_XXrss = @{map 6} (fn x => fn raw => fn mrbnf => fn XXr => fn map_t => fn (_, bsets, _) => - @{map 5} (fn FVars => fn bset => fn PFVars => fn avoiding_set => fn rel => + @{map 6} (fn i => fn FVars => fn bset => fn PFVars => fn avoiding_set => fn rel => let val goal = mk_int_empty_goal x bset XXr FVars (#ctor raw) map_t PFVars avoiding_set; - val n = 1 + nrecs + length rel; - val nrec_bd = length (distinct (op=) (flat (#binding_relation fp_res))); + val n = 1 + nrecs + length rel + (if member (op=) (#bfree_vars fp_res) i then 1 else 0); + val nrec_bd = length (distinct (op=) (flat (map hd (#binding_relation fp_res)))); in Goal.prove_sorry lthy (names (flat pickss @ fs @ [p, x])) (validP_prems @ suitable_prems @ f_prems) goal (fn {context=ctxt, prems} => let val (validP_prems, prems') = chop (length validP_prems) prems; @@ -1723,13 +1746,13 @@ fun create_binding_recursor qualify fp_res params models lthy = REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id supp_comp_bound bij_comp} @ [infinite_UNIV] @ prems @ pick_prems @ card_thms), K (unfold_thms_tac ctxt @{thms id_o o_id comp_def[of fst] fst_conv id_def[symmetric]}), K (unfold_thms_tac ctxt (#FVars_ctors raw)), - REPEAT_DETERM_N n o EVERY' [ + REPEAT_DETERM o EVERY' [ EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id supp_comp_bound bij_comp} @ [infinite_UNIV] @ prems @ pick_prems @ card_thms) ], K (unfold_thms_tac ctxt @{thms image_comp[unfolded comp_def]}), - REPEAT_DETERM_N nrecs o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (maps #FVars_renames (#raw_fps fp_res)), + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] (maps #FVars_permutes (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id supp_comp_bound bij_comp} @ [infinite_UNIV] @ prems @ pick_prems @ card_thms) ], K (unfold_thms_tac ctxt @{thms image_UN[symmetric]}), @@ -1738,7 +1761,7 @@ fun create_binding_recursor qualify fp_res params models lthy = REPEAT_DETERM o resolve_tac ctxt (@{thms bij_comp supp_comp_bound} @ [infinite_UNIV] @ prems @ pick_prems @ card_thms) ], K (unfold_thms_tac ctxt @{thms image_comp[symmetric]}), - REPEAT_DETERM_N nrec_bd o EVERY' [ + REPEAT_DETERM o EVERY' [ EqSubst.eqsubst_tac ctxt [0] (flat (map2 (flat oo map2 (fn pick => map (fn thm => infer_instantiate' ctxt (replicate nvars NONE @ [SOME (Thm.cterm_of ctxt pick)]) (@{thm id_on_image} OF [thm]) ))) pickss pick_id_on_image'sss)), @@ -1747,9 +1770,9 @@ fun create_binding_recursor qualify fp_res params models lthy = K (unfold_thms_tac ctxt (@{thms image_Un[symmetric]} @ map (fn thm => thm RS sym) (#FVars_ctors raw))), EqSubst.eqsubst_tac ctxt [0] (map (fn thm => thm RS sym) (MRBNF_Def.set_map_of_mrbnf mrbnf)), K (prefer_tac (2 * MRBNF_Def.bound_of_mrbnf mrbnf + MRBNF_Def.free_of_mrbnf mrbnf + 1)), - EqSubst.eqsubst_tac ctxt [0] (map (fn thm => thm RS sym) (#FVars_renames raw)), + EqSubst.eqsubst_tac ctxt [0] (map (fn thm => thm RS sym) (#FVars_permutes raw)), K (prefer_tac (2 * nvars + 1)), - EqSubst.eqsubst_tac ctxt [0] [#rename_simp (#inner raw)], + EqSubst.eqsubst_tac ctxt [0] [#permute_ctor raw], K (prefer_tac (2 * nvars + 1)), Method.insert_tac ctxt (take m prems'), K (unfold_thms_tac ctxt (maps (map snd) suitabless)), @@ -1758,7 +1781,7 @@ fun create_binding_recursor qualify fp_res params models lthy = REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ prems @ card_thms) ] end ) end - ) (#FVars raw) bsets (#PFVarss params) (#avoiding_sets params) (#binding_relation fp_res) + ) (0 upto nvars - 1) (#FVarss raw) bsets (#PFVarss params) (#avoiding_sets params) (#binding_relation fp_res) ) xs (#raw_fps fp_res) (#pre_mrbnfs fp_res) XXrs map_id_fsts PU_setss; val UFVars'_alphass = @{map 6} (fn raw => fn quot => fn model => fn t => fn t' => map2 (fn UFVars => fn UFVars' => @@ -1784,7 +1807,7 @@ fun create_binding_recursor qualify fp_res params models lthy = ) rec_fs models ts)); val thm = Goal.prove_sorry lthy (names (flat pickss @ ts)) suitable_prems goal (fn {context=ctxt, prems=suitable_prems} => EVERY1 [ rtac ctxt (infer_instantiate' ctxt (replicate n NONE @ map (SOME o Thm.cterm_of ctxt) ts) ( - the (#subshape_induct (#inner (hd (#raw_fps fp_res)))) + #subshape_induct (the (#fp_thms fp_res)) )), EVERY' (@{map 5} (fn raw => fn rec_f => fn Uctor' => fn model => fn mrbnf => EVERY' [ rtac ctxt @{thm pred_funI}, @@ -1812,12 +1835,7 @@ fun create_binding_recursor qualify fp_res params models lthy = @ prems @ mk_pick_prems [] suitable_prems @ @{thms supp_id_bound bij_id} ), - eresolve_tac ctxt ( - flat (the (#set_subshapess (#inner raw))) - @ map (fn thm => Drule.rotate_prems ~1 thm OF @{thms imageI}) ( - flat (the (#set_subshape_imagess (#inner raw))) - ) - ) + eresolve_tac ctxt (flat (#set_subshapess (the (#fp_thms fp_res)) @ (#set_subshape_permutess (the (#fp_thms fp_res))))) ] ]) ctxt ] @@ -1834,7 +1852,7 @@ fun create_binding_recursor qualify fp_res params models lthy = mk_leq (fst UFVars' $ t $ (Term.list_comb (fst rec_f, flat pickss) $ t $ p)) (mk_Un (mk_Un (FVars $ t, PFVars $ p), avoiding_set)) - ) (#FVars raw) (#PFVarss params) (#avoiding_sets params) + ) (#FVarss raw) (#PFVarss params) (#avoiding_sets params) ) (#raw_fps fp_res) rec_fs ts UFVars'ss; val goals = map (foldr1 HOLogic.mk_conj) goalss; val goal = HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj goals); @@ -1849,21 +1867,19 @@ fun create_binding_recursor qualify fp_res params models lthy = SOME _ => Drule.rotate_prems (~n) (conj_mp OF [thm]) | NONE => thm val result = Goal.prove_sorry lthy (names (flat pickss @ ts @ [p])) (validP_prems @ suitable_prems) goal (fn {context=ctxt, prems} => - let - val (validP_prems, suitable_prems) = chop (length validP_prems) prems; - val pick_prems = mk_pick_prems validP_prems suitable_prems + let val (validP_prems, suitable_prems) = chop (length validP_prems) prems; in EVERY1 [ - rtac ctxt (mp (conj_spec OF [infer_instantiate' ctxt (map (SOME o Thm.cterm_of ctxt) insts) - (the (#subshape_induct (#inner (hd (#raw_fps fp_res))))) - ])), + the_default (Method.insert_tac ctxt validP_prems) (Option.map (fn fp_thms => + rtac ctxt (mp (conj_spec OF [infer_instantiate' ctxt (map (SOME o Thm.cterm_of ctxt) insts) (#subshape_induct fp_thms)])) + ) (#fp_thms fp_res)), REPEAT_DETERM o resolve_tac ctxt validP_prems, - EVERY' (@{map 4} (fn raw => fn mrbnf => fn alpha_ctor_pick => fn rec_f => EVERY' [ - rtac ctxt allI, + EVERY' (@{map 5} (fn raw => fn mrbnf => fn alpha_ctor_pick => fn rec_f => fn t => EVERY' [ + TRY o rtac ctxt allI, TRY o rtac ctxt impI, Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => - rtac ctxt (infer_instantiate' ctxt [SOME (snd (hd params))] (#exhaust (#inner raw))) 1 + rtac ctxt (infer_instantiate' ctxt [SOME (the_default (Thm.cterm_of ctxt t) (try (snd o hd) params))] (#exhaust (#inner raw))) 1 ) ctxt, - hyp_subst_tac ctxt, + hyp_subst_tac_thin true ctxt, Subgoal.FOCUS_PREMS (fn {context=ctxt, prems, ...} => let val (validP_prems, prems') = case #validity params of @@ -1908,7 +1924,7 @@ fun create_binding_recursor qualify fp_res params models lthy = rtac ctxt conjI, assume_tac ctxt, assume_tac ctxt, - REPEAT_DETERM o EVERY' [ + the_default (K all_tac) (Option.map (fn fp_thms => REPEAT_DETERM o EVERY' [ REPEAT_DETERM1 o EVERY' [ EqSubst.eqsubst_asm_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ pick_prems @ card_thms) @@ -1924,23 +1940,20 @@ fun create_binding_recursor qualify fp_res params models lthy = assume_tac ctxt ], resolve_tac ctxt IHs, - eresolve_tac ctxt ( - maps (map (fn thm => Drule.rotate_prems ~1 thm OF @{thms imageI})) (the (#set_subshape_imagess (#inner raw))) - @ flat (the (#set_subshapess (#inner raw))) - ), + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (flat (#set_subshape_permutess fp_thms)) @ flat (#set_subshapess fp_thms)), REPEAT_DETERM o (resolve_tac ctxt (@{thms supp_id_bound bij_id} @ pick_prems @ card_thms) ORELSE' assume_tac ctxt) ] - ] + ]) (#fp_thms fp_res)) ]) end ) ctxt - ]) (#raw_fps fp_res) (#pre_mrbnfs fp_res) alpha_ctor_picks rec_fs) + ]) (#raw_fps fp_res) (#pre_mrbnfs fp_res) alpha_ctor_picks rec_fs ts) ] end ); in map (split_conj nvars) (split_conj n result) end; fun map2_prod f (a, b) (c, d) = (f a c, f b d); - val (XXl_UFVars'sss, XXr_UFVars'sss) = map2_prod (fn left => - @{map 5} (fn x => fn raw => fn mrbnf => fn (lsets, _, _) => fn XX => + val (XXl_UFVars'sss, XXr_UFVars'sss) = map2_prod (fn left => fn XXs => Option.map (fn fp_thms => + @{map 6} (fn x => fn raw => fn mrbnf => fn subshapes => fn (lsets, _, _) => fn XX => @{map 9} (fn t => fn pu => fn lsets => fn subshape => fn raw' => fn rec_f' => fn PUmap' => @{map 5} (fn FVars => fn PFVars => fn avoiding_set => fn UFVars' => fn f_UFVars' => let @@ -1949,7 +1962,7 @@ fun create_binding_recursor qualify fp_res params models lthy = Logic.all y (Logic.all p (addPred (Logic.mk_implies ( HOLogic.mk_Trueprop (subshape $ y $ (#ctor raw $ x)), mk_Trueprop_eq ( - Term.list_comb (fst rec_f', flat pickss) $ (Term.list_comb (#rename raw', fs) $ y) $ p, + Term.list_comb (fst rec_f', flat pickss) $ (Term.list_comb (#permute raw', fs) $ y) $ p, Term.list_comb (fst PUmap', fs) $ y $ (Term.list_comb (fst rec_f', flat pickss) $ y) $ p ) )))) @@ -1994,13 +2007,10 @@ fun create_binding_recursor qualify fp_res params models lthy = if not left then K all_tac else EVERY' [ EqSubst.eqsubst_tac ctxt [0] [hd IHs RS sym], TRY o resolve_tac ctxt valid_prems, - eresolve_tac ctxt ( - maps (map (fn thm => Drule.rotate_prems ~1 thm OF @{thms imageI})) (the (#set_subshape_imagess (#inner raw))) - @ flat (the (#set_subshapess (#inner raw))) - ), + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (flat (#set_subshape_permutess (the (#fp_thms fp_res)))) @ flat (#set_subshapess (the (#fp_thms fp_res)))), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ pick_prems @ valid_prems @ card_thms), TRY o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] [#rename_comp raw'], + EqSubst.eqsubst_tac ctxt [0] [#permute_comp raw'], REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems @ pick_prems @ valid_prems @ card_thms), K (unfold_thms_tac ctxt @{thms id_o o_id}) ] @@ -2014,22 +2024,25 @@ fun create_binding_recursor qualify fp_res params models lthy = ] ] end ) end - ) (#FVars raw') (#PFVarss params) (#avoiding_sets params) - ) ts pus (fst (fold_map chop (#rec_vars fp_res) lsets)) (the (#subshapes (#inner raw))) (#raw_fps fp_res) rec_fs PUmap's UFVars'ss f_UFVars'ss - ) xs (#raw_fps fp_res) (#pre_mrbnfs fp_res) PU_setss - ) (true, false) (XXls, XXrs); + ) (#FVarss raw') (#PFVarss params) (#avoiding_sets params) + ) ts pus (fst (fold_map chop (#rec_vars fp_res) lsets)) subshapes (#raw_fps fp_res) rec_fs PUmap's UFVars'ss f_UFVars'ss + ) xs (#raw_fps fp_res) (#pre_mrbnfs fp_res) (#subshapess (the (#fp_thms fp_res))) PU_setss XXs + ) (#fp_thms fp_res)) (true, false) (XXls, XXrs); val nrecs = foldr1 (op+) (#rec_vars fp_res); val (imsupp_id_on_XXlss, imsupp_id_on_XXrss) = apply2 ( @{map 9} (fn i => fn x => fn raw => fn mrbnf => fn map_t => fn (lsets, bsets, fsets) => fn pick_id_onss' => fn pick_id_on_imagess' => fn XX => - @{map 8} (fn FVars => fn f => fn PFVars => fn avoiding_set => fn FVars_transps => fn bset => fn fset => fn rel => + @{map 9} (fn j => fn FVars => fn f => fn PFVars => fn avoiding_set => fn FVars_transps => fn bset => fn fset => fn rel => let + (* TODO: fix for multiple bounds *) val w = Free ("w", fastype_of f); val XX_t = Term.list_comb (fst XX, flat pickss @ fs) $ p $ x; - val As = fset $ x :: map2 (fn i => fn FVars => - let val A = mk_UNION (nth lsets i $ x) FVars; - in if member (op=) rel i then mk_minus (A, bset $ x) else A end - ) (0 upto nrecs - 1) (replicate_rec FVars_transps) + val As = fset $ x :: + @{map_filter 2} (fn i => fn fset => if i = j then SOME (mk_minus (fset $ x, bset $ x)) else NONE) (#bfree_vars fp_res) (drop nvars fsets) + @ map2 (fn i => fn FVars => + let val A = mk_UNION (nth lsets i $ x) FVars; + in if member (op=) (hd rel) i then mk_minus (A, bset $ x) else A end + ) (0 upto nrecs - 1) (replicate_rec FVars_transps); val goal = Logic.mk_implies ( HOLogic.mk_Trueprop (mk_int_empty (mk_imsupp w, mk_Un (mk_Un (FVars $ (#ctor raw $ (map_t $ XX_t)), PFVars $ p), avoiding_set) @@ -2043,9 +2056,8 @@ fun create_binding_recursor qualify fp_res params models lthy = val ((valid_prems, suitable_prems), f_prems) = prems |> chop (length validP_prems) ||>> chop m; + val suitable_premss = fst (fold_map (K (chop nvars)) (1 upto n) suitable_prems); val pick_prems = mk_pick_prems [] suitable_prems; - val (y, y') = map_prod (fn xs => fold (curry op+) xs 0) hd (chop (i - 1) (#rec_vars fp_res)); - val suitable_prems' = take y' (drop y suitable_prems); val valid_prems = @{thms supp_inv_bound bij_imp_bij_inv} @ f_prems @ valid_prems @ the_default [] (Option.map (single o #valid_Pmap) (#validity params)); @@ -2060,7 +2072,7 @@ fun create_binding_recursor qualify fp_res params models lthy = ], K (unfold_thms_tac ctxt @{thms Int_Un_distrib Un_empty image_comp[unfolded comp_def]}), REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_asm_tac ctxt [0] (maps #FVars_renames (#raw_fps fp_res)), + EqSubst.eqsubst_asm_tac ctxt [0] (maps #FVars_permutes (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id bij_comp supp_comp_bound} @ [infinite_UNIV] @ pick_prems @ valid_prems @ card_thms) ], K (unfold_thms_tac ctxt @{thms image_UN[symmetric]}), @@ -2072,8 +2084,8 @@ fun create_binding_recursor qualify fp_res params models lthy = REPEAT_DETERM o EVERY' [ EqSubst.eqsubst_asm_tac ctxt [0] ( @{thms image_comp[symmetric]} - @ flat (map2 (fn p => map (fn thm => @{thm id_on_image} OF [thm OF [p]])) suitable_prems' pick_id_onss') - @ flat (map2 (fn p => map (fn thm => @{thm id_on_image} OF [thm OF (f_prems @ [p])])) suitable_prems' pick_id_on_imagess') + @ flat (map2 (fn p => map (fn thm => @{thm id_on_image} OF [thm OF [p]])) (nth suitable_premss (i - 1)) pick_id_onss') + @ flat (map2 (fn p => map (fn thm => @{thm id_on_image} OF [thm OF (f_prems @ [p])])) (nth suitable_premss (i - 1)) pick_id_on_imagess') ), REPEAT_DETERM o resolve_tac ctxt valid_prems ], @@ -2083,7 +2095,7 @@ fun create_binding_recursor qualify fp_res params models lthy = ] ] end ) end - ) (#FVars raw) fs (#PFVarss params) (#avoiding_sets params) (transpose (map #FVars (#raw_fps fp_res))) bsets fsets (#binding_relation fp_res) + ) (0 upto nvars - 1) (#FVarss raw) fs (#PFVarss params) (#avoiding_sets params) (transpose (map #FVarss (#raw_fps fp_res))) bsets (take nvars fsets) (#binding_relation fp_res) ) (1 upto length xs) xs (#raw_fps fp_res) (#pre_mrbnfs fp_res) map_id_fsts pre_setss pick_id_onsss' pick_id_on_image'sss ) (XXls, XXrs); @@ -2212,7 +2224,7 @@ fun create_binding_recursor qualify fp_res params models lthy = val alpha_prems = map2 (curry op$) (map2 ((curry op$) o #alpha o #inner) (#raw_fps fp_res) ts) ts'; val goals = @{map 5} (fn f => fn raw => fn PUmap' => fn t => fn t' => HOLogic.mk_conj ( HOLogic.mk_eq ( - Term.list_comb (fst f, flat pickss) $ (Term.list_comb (#rename raw, fs) $ t) $ p, + Term.list_comb (fst f, flat pickss) $ (Term.list_comb (#permute raw, fs) $ t) $ p, Term.list_comb (fst PUmap', fs) $ t $ (Term.list_comb (fst f, flat pickss) $ t) $ p ), HOLogic.mk_eq ( Term.list_comb (fst f, flat pickss) $ t $ p, @@ -2240,27 +2252,28 @@ fun create_binding_recursor qualify fp_res params models lthy = fun apply_n thm n = fold (K (fn t => thm OF [t])) (0 upto n - 1); val spec_n = 2 * m + nvars + 2; val mp_n = 2 * m + 3 * nvars + 1 + length validP_prems; - val r = length (#raw_fps fp_res); - val induct = the (#subshape_induct (#inner (hd (#raw_fps fp_res)))) + val induct = Option.map (fn fp_thms => #subshape_induct fp_thms |> infer_instantiate' ctxt (map (SOME o Thm.cterm_of ctxt) insts) |> apply_n conj_spec spec_n - |> apply_n conj_mp mp_n; + |> apply_n conj_mp mp_n + ) (#fp_thms fp_res); in EVERY1 [ - rtac ctxt induct, - REPEAT_DETERM_N r o defer_tac, + the_default (Method.insert_tac ctxt prems) (Option.map (rtac ctxt) induct), + REPEAT_DETERM_N n o defer_tac, REPEAT_DETERM o resolve_tac ctxt prems, - EVERY' (@{map 24} (fn i => fn y => fn map_id_fst => fn raw => fn mrbnf => fn rec_f => fn (_, PU_bsets, _) => fn (_, bsets, _) => + EVERY' (@{map 22} (fn i => fn y => fn map_id_fst => fn raw => fn mrbnf => fn rec_f => fn (_, PU_bsets, _) => fn (_, bsets, _) => fn XXl => fn XXr => fn deads => fn PUmap'_alpha => fn alpha_ctor_pick => fn int_empty_XXls => - fn int_empty_XXrs => fn Uctor'_cong => fn XXl_UFVars'ss => fn XXr_UFVars'ss => fn Uctor' => + fn int_empty_XXrs => fn Uctor'_cong => fn Uctor' => fn imsupp_id_on_XXls => fn imsupp_id_on_XXrs => fn PUmap' => fn pick_id_on'ss => fn pick_id_on_image'ss => EVERY' [ REPEAT_DETERM o resolve_tac ctxt [allI, impI], etac ctxt (#alpha_elim (#inner raw)), - hyp_subst_tac ctxt, + hyp_subst_tac_thin true ctxt, K (unfold_thms_tac ctxt @{thms triv_forall_equality}), Subgoal.FOCUS (fn {context=ctxt, prems, params=ps, ...} => let + val n' = length (filter (fn n => n > 0) (#rec_vars fp_res)); val ((((((((IHs, valid_prems), suitable_prems), suitable'_prems), f_prems), imsupp_prems), h_prems), h_id_ons), mr_rel_prem) = prems - |> chop r + |> chop n' ||>> chop (length validP_prems) ||>> chop m ||>> chop m @@ -2269,7 +2282,7 @@ fun create_binding_recursor qualify fp_res params models lthy = ||>> chop (2 * nvars) ||>> apsnd hd o chop nvars; val IHs = map (apply_n mp mp_n o apply_n spec spec_n) IHs; - fun chop_rec xs = fst (fold_map (K (chop nvars)) (1 upto r) xs) + fun chop_rec xs = fst (fold_map (K (chop nvars)) (1 upto n) xs) val valid_Pmap_opt = Option.map (fn v => #valid_Pmap v OF (valid_prems @ maps (fn ps => [ @@ -2282,12 +2295,15 @@ fun create_binding_recursor qualify fp_res params models lthy = val pick_prems = mk_pick_prems valid_prems suitable_prems @ the_default [] (Option.map (fn xs => mk_pick_prems [xs] suitable_prems) valid_Pmap_opt); val pick'_prems = mk_pick_prems valid_prems suitable'_prems @ the_default [] (Option.map (fn xs => mk_pick_prems [xs] suitable'_prems) valid_Pmap_opt); - val ((((((p, fs), picks), pick's), hs), x), x') = map (Thm.term_of o snd) ps - |> apfst hd o chop 1 - ||>> chop nvars - ||>> chop m - ||>> chop m - ||>> chop nvars + val ((((p, fs), picks), pick's), rest) = case #fp_thms fp_res of + NONE => ((((p, fs), flat pickss), flat pick'ss), map (Thm.term_of o snd) ps) + | _ => map (Thm.term_of o snd) ps + |> apfst hd o chop 1 + ||>> chop nvars + ||>> chop m + ||>> chop m; + val ((hs, x), x') = rest + |> chop nvars ||>> apply2 hd o chop 1; val pickss = chop_rec picks; val suitable_premss = chop_rec suitable_prems; @@ -2295,8 +2311,8 @@ fun create_binding_recursor qualify fp_res params models lthy = val exists_bij_betw's = @{map 3} (fn bset => fn pick => fn f => let - val rename_ts = map (fn raw => Term.list_comb (#rename raw, fs)) (#raw_fps fp_res); - val map_t = mk_map_comb_of_mrbnf deads (replicate_rec rename_ts) fs fs mrbnf $ x + val rename_ts = map (fn raw => Term.list_comb (#permute raw, fs)) (#raw_fps fp_res); + val map_t = mk_map_comb_of_mrbnf deads (replicate_rec rename_ts) fs fs (map (nth fs) (#bfree_vars fp_res)) mrbnf $ x val R = HOLogic.mk_comp (pick $ map_t $ p, f); val L = HOLogic.mk_comp (f, pick $ x $ (Term.list_comb (#Pmap params, map mk_inv fs) $ p)); val XXl_t = Term.list_comb (fst XXl, picks @ fs) $ p @@ -2314,7 +2330,7 @@ fun create_binding_recursor qualify fp_res params models lthy = PFVars $ p ), avoiding_set)) ))] thm) - ]) exists_bij_betw's (#FVars raw) (#PFVarss params) (#avoiding_sets params); + ]) exists_bij_betw's (#FVarss raw) (#PFVarss params) (#avoiding_sets params); fun bound_tac ctxt = EVERY' [ rtac ctxt Un_bound, @@ -2335,7 +2351,7 @@ fun create_binding_recursor qualify fp_res params models lthy = val pre_n = MRBNF_Def.live_of_mrbnf mrbnf + MRBNF_Def.free_of_mrbnf mrbnf + MRBNF_Def.bound_of_mrbnf mrbnf; in EVERY1 [ rtac ctxt conjI, - EqSubst.eqsubst_tac ctxt [0] [#rename_simp (#inner raw)], + EqSubst.eqsubst_tac ctxt [0] [#permute_ctor raw], REPEAT_DETERM o resolve_tac ctxt (prems @ card_thms), rtac ctxt trans, rtac ctxt (snd rec_f OF (suitable_prems @ valid_prems)), @@ -2343,7 +2359,7 @@ fun create_binding_recursor qualify fp_res params models lthy = REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems @ pick_prems @ card_thms), K (unfold_thms_tac ctxt @{thms id_o o_id comp_def[of "\t. (_ t, _ t)"]}), REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (map #rename_comp (#raw_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (map #permute_comp (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems @ pick_prems @ card_thms) ], K (unfold_thms_tac ctxt (Thm.symmetric (snd XXr) :: @{thms id_o o_id})), @@ -2385,7 +2401,7 @@ fun create_binding_recursor qualify fp_res params models lthy = REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems @ pick_prems @ card_thms), K (unfold_thms_tac ctxt @{thms id_o o_id comp_pair prod.case}), REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (map #rename_comp (#raw_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (map #permute_comp (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems @ pick_prems @ card_thms) ], K (unfold_thms_tac ctxt @{thms id_o o_id}), @@ -2408,7 +2424,7 @@ fun create_binding_recursor qualify fp_res params models lthy = @{thms supp_id_bound bij_id bij_comp supp_comp_bound} @ f_prems @ pick_prems @ [infinite_UNIV] @ card_thms ), - rtac ctxt refl + REPEAT_DETERM o rtac ctxt refl ], K (unfold_thms_tac ctxt [Thm.symmetric (snd XXl)]), EVERY' (map (fn thm => EVERY' [ @@ -2435,22 +2451,25 @@ fun create_binding_recursor qualify fp_res params models lthy = defer_tac, REPEAT_DETERM o resolve_tac ctxt (valid_prems @ the_default [] valid_XXls @ the_default [] valid_XXrs @ f_prems @ suitable_prems), REPEAT_DETERM o eresolve_tac ctxt @{thms eq_bij_betw_refl_prems}, - REPEAT_DETERM o EVERY' [ + the_default (REPEAT_DETERM o EVERY' [ + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms eq_bij_betw_refl_def}), + REPEAT_DETERM1 o etac ctxt conjE, + assume_tac ctxt + ]) (Option.map (fn _ => REPEAT_DETERM o EVERY' [ eresolve_tac ctxt (maps (map (fn thm => Drule.rotate_prems ~1 (thm OF (replicate (2 * length validP_prems) @{thm _} @ suitable_prems @ f_prems)) - )) XXl_UFVars'ss), + )) (nth (the XXl_UFVars'sss) (i - 1))), TRY o (assume_tac ctxt THEN' resolve_tac ctxt valid_prems), eresolve_tac ctxt (map (fn IH => IH RS conjunct1) IHs), TRY o assume_tac ctxt, REPEAT_DETERM o resolve_tac ctxt (map (#alpha_refl o #inner) (#raw_fps fp_res) @ prems) - ], - REPEAT_DETERM o FIRST' [ + ] THEN' REPEAT_DETERM o FIRST' [ eresolve_tac ctxt (maps (map (fn thm => thm OF (replicate (2 * length validP_prems) @{thm _} @ suitable_prems @ f_prems) - )) XXr_UFVars'ss), + )) (nth (the XXr_UFVars'sss) (i - 1))), assume_tac ctxt, resolve_tac ctxt valid_prems - ], + ]) (#fp_thms fp_res)), defer_tac, (* mr_rel_goal *) REPEAT_DETERM o EqSubst.eqsubst_tac ctxt [0] [snd XXl, snd XXr], @@ -2500,7 +2519,7 @@ fun create_binding_recursor qualify fp_res params models lthy = assume_tac ctxt ], (* comp = id for bound position *) - EVERY' [ + let val bound_tac = EVERY' [ SELECT_GOAL (unfold_thms_tac ctxt @{thms eq_bij_betw_refl_def}), REPEAT_DETERM o etac ctxt conjE, rtac ctxt @{thm inv_id_middle2}, @@ -2511,10 +2530,58 @@ fun create_binding_recursor qualify fp_res params models lthy = rtac ctxt sym, etac ctxt @{thm eq_onD}, assume_tac ctxt - ] + ] in bound_tac ORELSE' + (* comp = id for bound free position *) + EVERY' [ + rtac ctxt @{thm case_split[of "_ \ _"]}, + bound_tac, + dtac ctxt @{thm DiffI}, + assume_tac ctxt, + rtac ctxt @{thm inv_id_middle2}, + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt (@{thms bij_comp} @ f_prems @ pick_prems), + eresolve_tac ctxt @{thms eq_bij_betw_refl_prems}, + assume_tac ctxt + ], + rtac ctxt sym, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms comp_assoc[symmetric]}), + rtac ctxt @{thm trans[OF comp_apply]}, + rtac ctxt trans, + rtac ctxt @{thm arg_cong[of _ _ "_ \ _"]}, + resolve_tac ctxt (flat (map2 (fn p => map (fn thm => + @{thm id_onD} OF [thm OF (p::valid_Pmap)] + )) (nth suitable_premss (i - 1)) pick_id_on'ss)), + assume_tac ctxt, + rotate_tac ~1, + rtac ctxt @{thm trans[OF comp_apply]}, + rtac ctxt trans, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms eq_bij_betw_refl_def}), + REPEAT_DETERM o etac ctxt conjE, + REPEAT_DETERM o dresolve_tac ctxt (map (fn thm => + thm OF (valid_prems @ suitable_prems @ f_prems) + ) (imsupp_id_on_XXls @ imsupp_id_on_XXrs)), + REPEAT_DETERM o etac ctxt conjE, + eresolve_tac ctxt (map (fn f => infer_instantiate' ctxt [NONE, NONE, SOME (Thm.cterm_of lthy f)] + @{thm id_onD[rotated, OF imageI]} + ) fs), + assume_tac ctxt, + rtac ctxt sym, + rtac ctxt @{thm comp_middle}, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms eq_bij_betw_refl_def}), + REPEAT_DETERM o etac ctxt conjE, + REPEAT_DETERM o dresolve_tac ctxt (map (fn thm => + thm OF (valid_prems @ suitable_prems @ f_prems) + ) (imsupp_id_on_XXls @ imsupp_id_on_XXrs)), + REPEAT_DETERM o etac ctxt conjE, + etac ctxt @{thm id_onD[rotated, OF imageI]}, + assume_tac ctxt, + eresolve_tac ctxt (flat (map2 (fn p => map (fn thm => + @{thm id_onD} OF [thm OF (f_prems @ [p] @ valid_prems), imageI] + )) (nth suitable_premss (i - 1)) pick_id_on_image'ss)) + ] end ], rtac ctxt (MRBNF_Def.rel_refl_strong_of_mrbnf mrbnf), - REPEAT_DETERM o (rtac ctxt refl ORELSE' EVERY' [ + REPEAT_DETERM o (rtac ctxt refl ORELSE' (the_default (K no_tac) (Option.map (fn fp_thms => EVERY' [ rtac ctxt @{thm relcomppI}, rtac ctxt @{thm iffD2[OF fun_cong[OF fun_cong[OF Grp_UNIV_def]]]}, rtac ctxt refl, @@ -2526,8 +2593,8 @@ fun create_binding_recursor qualify fp_res params models lthy = resolve_tac ctxt (map (#alpha_bij o #inner) (#raw_fps fp_res)), REPEAT_DETERM o (eresolve_tac ctxt @{thms eq_bij_betw_refl_prems} ORELSE' resolve_tac ctxt card_thms), REPEAT_DETERM1 o EVERY' [ - rtac ctxt ballI, - EqSubst.eqsubst_asm_tac ctxt [0] (maps #FVars_renames (#raw_fps fp_res)), + rtac ctxt @{thm eq_onI}, + EqSubst.eqsubst_asm_tac ctxt [0] (maps #FVars_permutes (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (f_prems @ card_thms), etac ctxt imageE, hyp_subst_tac ctxt, @@ -2552,7 +2619,7 @@ fun create_binding_recursor qualify fp_res params models lthy = (* recursive binding set *) EVERY' [ REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (map #rename_comp (#raw_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (map #permute_comp (#raw_fps fp_res)), REPEAT_DETERM o FIRST' [ resolve_tac ctxt (@{thms bij_comp supp_comp_bound} @ [infinite_UNIV] @ f_prems @ pick_prems), eresolve_tac ctxt @{thms eq_bij_betw_refl_prems}, @@ -2569,7 +2636,7 @@ fun create_binding_recursor qualify fp_res params models lthy = REPEAT_DETERM1 o FIRST' [ (* nonbinding_case *) EVERY' [ - rtac ctxt ballI, + rtac ctxt @{thm eq_onI}, REPEAT_DETERM o EqSubst.eqsubst_tac ctxt [0] @{thms comp_def}, SELECT_GOAL (unfold_thms_tac ctxt @{thms eq_bij_betw_refl_def}), REPEAT_DETERM o etac ctxt conjE, @@ -2591,7 +2658,7 @@ fun create_binding_recursor qualify fp_res params models lthy = ], (* binding_case *) EVERY' [ - rtac ctxt ballI, + rtac ctxt @{thm eq_onI}, rtac ctxt @{thm case_split[of "_ \ _"]}, SELECT_GOAL (unfold_thms_tac ctxt @{thms eq_bij_betw_refl_def}), REPEAT_DETERM o etac ctxt conjE, @@ -2646,10 +2713,7 @@ fun create_binding_recursor qualify fp_res params models lthy = resolve_tac ctxt PUmap'_congs, rtac ctxt refl, resolve_tac ctxt (map (fn thm => thm RS conjunct1 RS sym) IHs), - eresolve_tac ctxt (maps (fn raw => - flat (the (#set_subshapess (#inner raw))) - @ maps (map (fn thm => Drule.rotate_prems ~1 thm OF [imageI])) (the (#set_subshape_imagess (#inner raw))) - ) (#raw_fps fp_res)), + eresolve_tac ctxt (flat (#set_subshapess fp_thms) @ map (Drule.rotate_prems ~1) (flat (#set_subshape_permutess fp_thms))), REPEAT_DETERM o FIRST' [ eresolve_tac ctxt (@{thms eq_bij_betw_refl_prems} @ the_default [] (Option.map (single o #valid_Pmap) (#validity params))), resolve_tac ctxt (@{thms supp_id_bound bij_id supp_inv_bound bij_imp_bij_inv} @@ -2657,16 +2721,14 @@ fun create_binding_recursor qualify fp_res params models lthy = ) ], TRY o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (map #rename_comp (#raw_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (map #permute_comp (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems @ pick_prems @ card_thms), K (unfold_thms_tac ctxt @{thms id_o o_id}) ], REPEAT_DETERM o EVERY' [ rtac ctxt trans, resolve_tac ctxt (map (fn thm => thm RS conjunct1 RS sym) IHs), - eresolve_tac ctxt (maps (fn raw => maps (map (fn thm => - Drule.rotate_prems ~1 thm OF [imageI]) - ) (the (#set_subshape_imagess (#inner raw)))) (#raw_fps fp_res)), + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (flat (#set_subshape_permutess fp_thms))), REPEAT_DETERM o FIRST' [ assume_tac ctxt, resolve_tac ctxt (@{thms bij_comp supp_comp_bound} @ [infinite_UNIV] @ suitable_prems @ suitable'_prems @ f_prems @ pick_prems @ card_thms) @@ -2686,12 +2748,10 @@ fun create_binding_recursor qualify fp_res params models lthy = ] ], resolve_tac ctxt (map (fn thm => thm RS conjunct2) IHs), - EqSubst.eqsubst_tac ctxt [0] (map #rename_comp (#raw_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (map #permute_comp (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_comp_bound bij_comp} @ [infinite_UNIV] @ f_prems @ pick_prems @ card_thms), REPEAT_DETERM o (eresolve_tac ctxt @{thms eq_bij_betw_refl_prems} ORELSE' resolve_tac ctxt card_thms), - eresolve_tac ctxt (maps (fn raw => maps (map (fn thm => - Drule.rotate_prems ~1 thm OF [imageI])) (the (#set_subshape_imagess (#inner raw))) - ) (#raw_fps fp_res)), + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (flat (#set_subshape_permutess fp_thms))), REPEAT_DETERM o FIRST' [ resolve_tac ctxt (@{thms supp_id_bound bij_id bij_comp supp_comp_bound imsupp_id_empty} @ [infinite_UNIV] @ f_prems @ pick_prems @ suitable_prems), eresolve_tac ctxt @{thms eq_bij_betw_refl_prems}, @@ -2700,7 +2760,7 @@ fun create_binding_recursor qualify fp_res params models lthy = ], TRY o EVERY' [ REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (map #rename_comp (#raw_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (map #permute_comp (#raw_fps fp_res)), REPEAT_DETERM o FIRST' [ resolve_tac ctxt (@{thms bij_comp supp_comp_bound} @ [infinite_UNIV] @ f_prems @ pick_prems), eresolve_tac ctxt @{thms eq_bij_betw_refl_prems}, @@ -2709,7 +2769,8 @@ fun create_binding_recursor qualify fp_res params models lthy = ], assume_tac ctxt ] - ]), + ]) (#fp_thms fp_res)))), + (* f picks t = f picks' t' *) K (unfold_thms_tac ctxt [snd rec_f OF (suitable_prems @ valid_prems), snd rec_f OF (suitable'_prems @ valid_prems)]), Subgoal.FOCUS_PARAMS (fn {context=ctxt, ...} => let @@ -2720,19 +2781,20 @@ fun create_binding_recursor qualify fp_res params models lthy = val cbset = SOME (Thm.cterm_of ctxt bset); fun mk_map_t xx picks = let + (* TODO: fix for multiple bounds *) val pickss = chop_rec picks; val pick_ts = map (fn pick => pick $ xx $ p) (nth pickss (i - 1)); val live_ts = @{map 4} (fn i => fn raw => fn t => fn rec_f => - let val rename_t = if not (member (op=) (flat (#binding_relation fp_res)) i) then t else - Term.list_comb (#rename raw, @{map 3} (fn rel => fn pick_t => fn var => - if member (op=) rel i then pick_t else HOLogic.id_const var + let val rename_t = if not (member (op=) (maps hd (#binding_relation fp_res)) i) then t else + Term.list_comb (#permute raw, @{map 3} (fn rel => fn pick_t => fn var => + if member (op=) (hd rel) i then pick_t else HOLogic.id_const var ) (#binding_relation fp_res) pick_ts vars) $ t in Term.absfree (dest_Free t) (HOLogic.mk_prod (rename_t, valid_If (Term.list_comb (fst rec_f, picks) $ rename_t) )) end ) (0 upto nrecs - 1) (replicate_rec (#raw_fps fp_res)) (replicate_rec ts) (replicate_rec rec_fs); in Term.absfree (dest_Free x) (map_id_fst $ ( - mk_map_comb_of_mrbnf deads live_ts pick_ts (map HOLogic.id_const vars) mrbnf $ x + mk_map_comb_of_mrbnf deads live_ts pick_ts (map HOLogic.id_const vars) (map (nth pick_ts) (#bfree_vars fp_res)) mrbnf $ x )) end; val pick'_map_t = Thm.cterm_of ctxt (mk_map_t x' pick's); val pick_map_t = Thm.cterm_of ctxt (mk_map_t x picks); @@ -2745,13 +2807,12 @@ fun create_binding_recursor qualify fp_res params models lthy = ]) ( @{thm exists_bij_betw_def} OF ([Cinfinite_card] @ @{thms _} @ [pick_bij, pick'_bij, h_bij]) )) end - ) bsets (nth pick_bijss (i - 1)) (nth pick'_bijss (i - 1)) (every_other h_prems) (#FVars raw) (#PFVarss params) (#avoiding_sets params); + ) bsets (nth pick_bijss (i - 1)) (nth pick'_bijss (i - 1)) (every_other h_prems) (#FVarss raw) (#PFVarss params) (#avoiding_sets params); val mr_rel_sets' = map_filter ( fn (_, MRBNF_Def.Live_Var) => NONE | (thm, _) => SOME (Drule.rotate_prems ~1 thm) ) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf ~~ MRBNF_Def.var_types_of_mrbnf mrbnf); val mr_rel_sets = map (fn thm => Local_Defs.unfold0 ctxt @{thms image_id} (thm OF [mr_rel_prem])) mr_rel_sets'; - in EVERY1 [ EVERY' (map (fn thm => EVERY' [ rtac ctxt (exE OF [thm]), @@ -2780,7 +2841,7 @@ fun create_binding_recursor qualify fp_res params models lthy = ]) [suitable'_prems, suitable_prems]) ]) exists_bij_betw2s), REPEAT_DETERM o etac ctxt exE, - rtac ctxt (Drule.rotate_prems (4 * nvars + 2 * m + length validP_prems + (case valid_XXls of NONE => 0 | _ => 2)) Uctor'_cong), + rtac ctxt (Drule.rotate_prems (4 * nvars + 2 * nvars * n' + length validP_prems + (case valid_XXls of NONE => 0 | _ => 2)) Uctor'_cong), REPEAT_DETERM_N (2 * nvars) o EVERY' [ SELECT_GOAL (unfold_thms_tac ctxt @{thms eq_bij_betw_def}), REPEAT_DETERM o etac ctxt conjE, @@ -2900,8 +2961,7 @@ fun create_binding_recursor qualify fp_res params models lthy = assume_tac ctxt ], (* comp = id for bound position *) - EVERY' [ - rtac ctxt ballI, + let val bound_tac = EVERY' [ SELECT_GOAL (unfold_thms_tac ctxt @{thms comp_assoc[symmetric]}), EqSubst.eqsubst_tac ctxt [0] @{thms o_inv_distrib[symmetric]}, eresolve_tac ctxt @{thms eq_bij_betw_prems}, @@ -2921,9 +2981,91 @@ fun create_binding_recursor qualify fp_res params models lthy = assume_tac ctxt, SELECT_GOAL (unfold_thms_tac ctxt @{thms comp_def}), rtac ctxt refl - ], - (* rec sets *) + ] in (rtac ctxt ballI THEN' bound_tac) ORELSE' + (* comp = id for bound free position *) EVERY' [ + rtac ctxt @{thm ballI}, + rtac ctxt @{thm case_split[of "_ \ _"]}, + bound_tac, + dtac ctxt @{thm DiffI}, + assume_tac ctxt, + rtac ctxt trans, + resolve_tac ctxt (map (fn thm => thm RS @{thm id_onD}) h_id_ons), + rotate_tac ~1, + etac ctxt @{thm contrapos_pp}, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms Un_iff de_Morgan_disj}), + REPEAT_DETERM o etac ctxt conjE, + assume_tac ctxt, + rtac ctxt sym, + rtac ctxt @{thm trans[OF comp_apply]}, + rtac ctxt @{thm iffD2[OF bij_imp_inv']}, + resolve_tac ctxt pick'_prems, + rtac ctxt trans, + resolve_tac ctxt (flat (map2 (fn p => map (fn thm => + @{thm id_onD} OF [thm OF (p::valid_prems)] + )) (nth suitable'_premss (i - 1)) pick_id_on'ss)), + rtac ctxt @{thm iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]}, + rtac ctxt @{thm arg_cong2[of _ _ _ _ minus]}, + REPEAT_DETERM o EVERY' [ + resolve_tac ctxt (map_filter (fn (_, MRBNF_Def.Live_Var) => NONE + | (thm, _) => SOME (Drule.rotate_prems ~1 thm OF [mr_rel_prem]) + ) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf ~~ MRBNF_Def.var_types_of_mrbnf mrbnf)), + REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ h_prems) + ], + EqSubst.eqsubst_tac ctxt [0] @{thms image_set_diff[symmetric, OF bij_is_inj]}, + resolve_tac ctxt h_prems, + EqSubst.eqsubst_tac ctxt [0] @{thms id_on_image}, + resolve_tac ctxt (map (fn thm => thm RS @{thm id_on_antimono}) h_id_ons), + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms Un_assoc}), + resolve_tac ctxt @{thms subset_refl Un_upper1}, + assume_tac ctxt, + rtac ctxt sym, + rtac ctxt @{thm trans[OF comp_apply]}, + rtac ctxt trans, + rtac ctxt @{thm arg_cong[of _ _ "_ \ _"]}, + resolve_tac ctxt (flat (map2 (fn p => map (fn thm => + @{thm id_onD} OF [thm OF (p::valid_prems)] + )) (nth suitable_premss (i - 1)) pick_id_on'ss)), + assume_tac ctxt, + rtac ctxt @{thm trans[OF comp_apply]}, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms eq_bij_betw_def}), + REPEAT_DETERM o etac ctxt conjE, + REPEAT_DETERM1 o EVERY' [ + EqSubst.eqsubst_asm_tac ctxt [0] (maps (#alpha_FVarss o #inner) (#raw_fps fp_res)), + resolve_tac ctxt (map (#alpha_sym o #inner) (#raw_fps fp_res)), + resolve_tac ctxt (maps (fn thm => [thm OF (suitable_prems @ valid_prems), thm OF (suitable'_prems @ valid_prems)]) alpha_ctor_picks) + ], + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_asm_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt (@{thms supp_id_bound bij_id} @ pick_prems @ pick'_prems), + assume_tac ctxt, + resolve_tac ctxt card_thms + ] + ], + K (Local_Defs.unfold0_tac ctxt @{thms image_id}), + rtac ctxt trans, + rtac ctxt @{thm arg_cong[of _ _ "inv _"]}, + etac ctxt @{thm imsupp_id_on[THEN id_onD]}, + REPEAT_DETERM o rtac ctxt @{thm UnI1}, + etac ctxt @{thm DiffE}, + eresolve_tac ctxt (flat (#FVars_intross raw)), + assume_tac ctxt, + etac ctxt @{thm imsupp_id_on[THEN id_on_inv[rotated, THEN id_onD]]}, + assume_tac ctxt, + REPEAT_DETERM o rtac ctxt @{thm UnI1}, + rtac ctxt @{thm iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]}, + resolve_tac ctxt (#alpha_FVarss (#inner raw)), + rtac ctxt (#alpha_sym (#inner raw)), + rtac ctxt (Drule.rotate_prems ~1 (#alpha_intro (#inner raw))), + rtac ctxt mr_rel_prem, + REPEAT_DETERM o resolve_tac ctxt (h_prems @ h_id_ons), + etac ctxt @{thm DiffE}, + eresolve_tac ctxt (flat (#FVars_intross raw)), + assume_tac ctxt + ] end, + (* rec sets *) + the_default (K no_tac) (Option.map (fn fp_thms => EVERY' [ REPEAT_DETERM o resolve_tac ctxt [ballI, impI], rtac ctxt @{thm relcomppI}, SELECT_GOAL (unfold_thms_tac ctxt @{thms Grp_UNIV_def}), @@ -2937,7 +3079,7 @@ fun create_binding_recursor qualify fp_res params models lthy = assume_tac ctxt ORELSE' resolve_tac ctxt (map (#alpha_refl o #inner) (#raw_fps fp_res)), REPEAT_DETERM o (eresolve_tac ctxt @{thms eq_bij_betw_prems} ORELSE' resolve_tac ctxt card_thms), REPEAT_DETERM1 o EVERY' [ - rtac ctxt ballI, + rtac ctxt @{thm eq_onI}, SELECT_GOAL (unfold_thms_tac ctxt (@{thms eq_bij_betw_def} @ flat (map2 (fn alpha_pick => fn raw => maps (fn alpha_FVars => [ alpha_FVars OF [alpha_pick OF (suitable_prems @ valid_prems)] RS sym, alpha_FVars OF [alpha_pick OF (suitable'_prems @ valid_prems)] RS sym @@ -2965,7 +3107,7 @@ fun create_binding_recursor qualify fp_res params models lthy = (* binding rec set *) EVERY' [ REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (map #rename_comp (#raw_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (map #permute_comp (#raw_fps fp_res)), REPEAT_DETERM o FIRST' [ resolve_tac ctxt (@{thms supp_id_bound bij_id} @ pick_prems @ pick'_prems), eresolve_tac ctxt @{thms eq_bij_betw_prems}, @@ -2977,7 +3119,7 @@ fun create_binding_recursor qualify fp_res params models lthy = resolve_tac ctxt (map (Drule.rotate_prems (~1 - nvars) o #alpha_bij o #inner) (#raw_fps fp_res)), REPEAT_DETERM o FIRST' [ EVERY' [ - rtac ctxt ballI, + rtac ctxt @{thm eq_onI}, SELECT_GOAL (unfold_thms_tac ctxt @{thms eq_bij_betw_def}), REPEAT_DETERM o etac ctxt conjE, REPEAT_DETERM1 o EVERY' [ @@ -3000,7 +3142,7 @@ fun create_binding_recursor qualify fp_res params models lthy = assume_tac ctxt ], EVERY' [ - rtac ctxt ballI, + rtac ctxt @{thm eq_onI}, rtac ctxt sym, rtac ctxt @{thm case_split[of "_ \ _"]}, SELECT_GOAL (unfold_thms_tac ctxt @{thms eq_bij_betw_def}), @@ -3021,7 +3163,7 @@ fun create_binding_recursor qualify fp_res params models lthy = assume_tac ctxt, dresolve_tac ctxt (map (fn thm => Drule.rotate_prems ~1 (thm RS sym RS @{thm iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]]}) OF @{thms imageI} - ) (maps #FVars_renames (#raw_fps fp_res))), + ) (maps #FVars_permutes (#raw_fps fp_res))), K (prefer_tac (2 * nvars + 1)), dresolve_tac ctxt (map (fn thm => Drule.rotate_prems 1 ( thm RS @{thm iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]]} @@ -3041,7 +3183,7 @@ fun create_binding_recursor qualify fp_res params models lthy = dtac ctxt @{thm DiffI[rotated]}, eresolve_tac ctxt (maps (map (fn t => Drule.rotate_prems 1 (infer_instantiate' ctxt [NONE, NONE, NONE, SOME (Thm.cterm_of ctxt t)] @{thm UN_I}) - ) o #FVars) (#raw_fps fp_res)), + ) o #FVarss) (#raw_fps fp_res)), assume_tac ctxt, rotate_tac ~1, eresolve_tac ctxt (flat (map2 (fn p => map (fn thm => @@ -3095,10 +3237,10 @@ fun create_binding_recursor qualify fp_res params models lthy = ) (#raw_fps fp_res)), rtac ctxt trans, resolve_tac ctxt (map (fn raw => - mk_arg_cong lthy (nvars + 1) (#rename raw) + mk_arg_cong lthy (nvars + 1) (#permute raw) ) (#raw_fps fp_res)), K (prefer_tac (nvars + 2)), - resolve_tac ctxt (map (fn raw => #rename_comp raw RS sym) (#raw_fps fp_res)), + resolve_tac ctxt (map (fn raw => #permute_comp raw RS sym) (#raw_fps fp_res)), REPEAT_DETERM_N nvars o EVERY' [ K (prefer_tac (4 * nvars + 1)), resolve_tac ctxt @{thms refl o_id[symmetric]} @@ -3127,10 +3269,7 @@ fun create_binding_recursor qualify fp_res params models lthy = ] ORELSE' rtac ctxt ext, rtac ctxt trans, resolve_tac ctxt (map (fn IH => IH RS conjunct1 RS sym) IHs), - eresolve_tac ctxt (maps (fn raw => - flat (the (#set_subshapess (#inner raw))) - @ maps (map (fn thm => Drule.rotate_prems ~1 thm OF [imageI])) (the (#set_subshape_imagess (#inner raw))) - ) (#raw_fps fp_res)), + eresolve_tac ctxt (flat (#set_subshapess fp_thms) @ map (Drule.rotate_prems ~1) (flat (#set_subshape_permutess fp_thms))), REPEAT_DETERM o FIRST' [ resolve_tac ctxt (@{thms supp_id_bound bij_id} @ pick_prems @ suitable_prems), eresolve_tac ctxt @{thms eq_bij_betw_prems}, @@ -3144,7 +3283,7 @@ fun create_binding_recursor qualify fp_res params models lthy = ], TRY o EVERY' [ resolve_tac ctxt (map (#alpha_refl o #inner) (#raw_fps fp_res)), - EqSubst.eqsubst_tac ctxt [0] (map #rename_comp (#raw_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (map #permute_comp (#raw_fps fp_res)), REPEAT_DETERM o FIRST' [ resolve_tac ctxt (@{thms supp_id_bound bij_id} @ pick_prems), eresolve_tac ctxt @{thms eq_bij_betw_prems}, @@ -3153,10 +3292,7 @@ fun create_binding_recursor qualify fp_res params models lthy = ], rtac ctxt trans, resolve_tac ctxt (map (fn thm => thm RS conjunct2) IHs), - eresolve_tac ctxt (maps (fn raw => - flat (the (#set_subshapess (#inner raw))) - @ maps (map (fn thm => Drule.rotate_prems ~1 thm OF [imageI])) (the (#set_subshape_imagess (#inner raw))) - ) (#raw_fps fp_res)), + eresolve_tac ctxt (flat (#set_subshapess fp_thms) @ map (Drule.rotate_prems ~1) (flat (#set_subshape_permutess fp_thms))), REPEAT_DETERM o FIRST' [ eresolve_tac ctxt @{thms eq_bij_betw_prems}, assume_tac ctxt, @@ -3167,9 +3303,7 @@ fun create_binding_recursor qualify fp_res params models lthy = K (prefer_tac (3 * nvars + 2)), rtac ctxt trans, resolve_tac ctxt (map (fn thm => thm RS conjunct1) IHs), - eresolve_tac ctxt (maps (fn raw => - maps (map (fn thm => Drule.rotate_prems ~1 thm OF [imageI])) (the (#set_subshape_imagess (#inner raw))) - ) (#raw_fps fp_res)), + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (flat (#set_subshape_permutess fp_thms))), K (prefer_tac (5 * nvars + 2 * m + 2 + length validP_prems)), rtac ctxt @{thm trans[rotated]}, resolve_tac ctxt (map (fn thm => fun_cong OF [fun_cong OF [thm]]) PUmap'_alphas), @@ -3179,7 +3313,7 @@ fun create_binding_recursor qualify fp_res params models lthy = ], assume_tac ctxt, resolve_tac ctxt PUmap'_congs, - resolve_tac ctxt (maps (fn raw => [#rename_comp raw RS sym, #rename_id raw]) (#raw_fps fp_res)), + resolve_tac ctxt (maps (fn raw => [#permute_comp raw RS sym, #permute_id raw]) (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ h_prems @ pick'_prems @ card_thms), TRY o EVERY' [ EqSubst.eqsubst_tac ctxt [0] @{thms if_P}, @@ -3190,16 +3324,14 @@ fun create_binding_recursor qualify fp_res params models lthy = ] ], resolve_tac ctxt (map (fn thm => thm RS conjunct2) IHs), - eresolve_tac ctxt (maps (fn raw => - maps (map (fn thm => Drule.rotate_prems ~1 thm OF [imageI])) (the (#set_subshape_imagess (#inner raw))) - ) (#raw_fps fp_res)), + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (flat (#set_subshape_permutess fp_thms))), REPEAT_DETERM o FIRST' [ eresolve_tac ctxt (@{thms eq_bij_betw_prems} @ the_default [] (Option.map (single o #valid_Pmap) (#validity params))), resolve_tac ctxt (@{thms supp_id_bound bij_id bij_comp supp_comp_bound bij_imp_bij_inv supp_inv_bound} @ [infinite_UNIV] @ pick'_prems @ h_prems @ card_thms) ], REPEAT_DETERM o resolve_tac ctxt suitable'_prems, REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left] cmin_greater card_of_Card_order}), - EqSubst.eqsubst_tac ctxt [0] (maps (fn raw => [#rename_comp raw RS sym, #rename_id raw]) (#raw_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (maps (fn raw => [#permute_comp raw RS sym, #permute_id raw]) (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ h_prems @ pick'_prems @ card_thms), TRY o EVERY' [ resolve_tac ctxt (map (fn raw => iffD2 OF [#alpha_bij_eq (#inner raw)]) (#raw_fps fp_res)), @@ -3216,8 +3348,8 @@ fun create_binding_recursor qualify fp_res params models lthy = ], resolve_tac ctxt (map (#alpha_refl o #inner) (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left] cmin_greater card_of_Card_order}, - EqSubst.eqsubst_tac ctxt [0] (map #rename_id (#raw_fps fp_res)) ORELSE' EVERY' [ - EqSubst.eqsubst_asm_tac ctxt [0] (map #rename_comp (#raw_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (map #permute_id (#raw_fps fp_res)) ORELSE' EVERY' [ + EqSubst.eqsubst_asm_tac ctxt [0] (map #permute_comp (#raw_fps fp_res)), REPEAT_DETERM o FIRST' [ resolve_tac ctxt (@{thms supp_id_bound bij_id supp_comp_bound bij_comp} @ [infinite_UNIV] @ h_prems @ pick_prems @ pick'_prems), eresolve_tac ctxt @{thms eq_bij_betw_prems}, @@ -3229,7 +3361,7 @@ fun create_binding_recursor qualify fp_res params models lthy = assume_tac ctxt, K (unfold_thms_tac ctxt @{thms comp_assoc}), TRY o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (map (fn raw => #rename_comp raw RS sym) (#raw_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (map (fn raw => #permute_comp raw RS sym) (#raw_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ h_prems @ pick'_prems @ card_thms) ], REPEAT_DETERM o EVERY' [ @@ -3242,15 +3374,15 @@ fun create_binding_recursor qualify fp_res params models lthy = ], resolve_tac ctxt (map (#alpha_sym o #inner) (#raw_fps fp_res)), assume_tac ctxt - ] + ]) (#fp_thms fp_res)) ] ] end ) ctxt ] end ) ctxt - ]) (1 upto r) ys map_id_fsts (#raw_fps fp_res) (#pre_mrbnfs fp_res) rec_fs PU_setss pre_setss XXls XXrs deadss - PUmap'_alphas alpha_ctor_picks int_empty_XXlss int_empty_XXrss Uctor'_congs XXl_UFVars'sss - XXr_UFVars'sss Uctor's imsupp_id_on_XXlss imsupp_id_on_XXrss PUmap's pick_id_onsss' pick_id_on_image'sss) + ]) (1 upto n) ys map_id_fsts (#raw_fps fp_res) (#pre_mrbnfs fp_res) rec_fs PU_setss pre_setss XXls XXrs deadss + PUmap'_alphas alpha_ctor_picks int_empty_XXlss int_empty_XXrss Uctor'_congs + Uctor's imsupp_id_on_XXlss imsupp_id_on_XXrss PUmap's pick_id_onsss' pick_id_on_image'sss) ] end ) end; @@ -3330,7 +3462,7 @@ fun create_binding_recursor qualify fp_res params models lthy = )) ts f0s; val goal = mk_Trueprop_eq ( fst f0 $ (#ctor raw $ x) $ p, - fst Uctor' $ (mk_map_comb_of_mrbnf deads (replicate_rec live_ts) ids ids mrbnf $ x) $ p + fst Uctor' $ (mk_map_comb_of_mrbnf deads (replicate_rec live_ts) ids ids bfree_ids mrbnf $ x) $ p ); in Goal.prove_sorry lthy (names [x, p]) (validP_prems @ int_empties @ [noclash]) goal (fn {context=ctxt, prems} => let @@ -3388,7 +3520,7 @@ fun create_binding_recursor qualify fp_res params models lthy = rtac ctxt (infer_instantiate' ctxt [NONE, NONE, SOME (Thm.cterm_of ctxt (fst Uctor'))] @{thm arg_cong2[OF _ refl]}), rtac ctxt (MRBNF_Def.map_cong_of_mrbnf mrbnf), REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id refl}, - K (unfold_thms_tac ctxt (@{thms prod.inject} @ map #rename_id (#raw_fps fp_res))), + K (unfold_thms_tac ctxt (@{thms prod.inject} @ map #permute_id (#raw_fps fp_res))), REPEAT_DETERM o EVERY' [ rtac ctxt @{thm conjI[OF refl]}, rtac ctxt ext, @@ -3451,7 +3583,7 @@ fun create_binding_recursor qualify fp_res params models lthy = )) (map2 (fn t => fn quot => Free (fst (dest_Free t), #T quot)) ts (#quotient_fps fp_res)) ff0s; val goal = mk_Trueprop_eq ( fst ff0 $ (#ctor quot $ x) $ p, - Uctor $ (mk_map_comb_of_mrbnf deads (replicate_rec live_ts) ids ids mrbnf $ x) $ p + Uctor $ (mk_map_comb_of_mrbnf deads (replicate_rec live_ts) ids ids bfree_ids mrbnf $ x) $ p ); in Goal.prove_sorry lthy (names [x, p]) (validP_prems @ int_empties @ [noclash]) goal (fn {context=ctxt, prems} => EVERY1 [ Method.insert_tac ctxt prems, @@ -3485,13 +3617,13 @@ fun create_binding_recursor qualify fp_res params models lthy = mk_int_empty (mk_imsupp f, avoiding_set) )) fs (#avoiding_sets params); val goal = mk_Trueprop_eq ( - fst ff0 $ (Term.list_comb (#rename quot, fs) $ t) $ p, + fst ff0 $ (Term.list_comb (#permute quot, fs) $ t) $ p, Term.list_comb (#Umap model, fs) $ t $ (fst ff0 $ t $ ( Term.list_comb (#Pmap params, map mk_inv fs) $ p )) ); in Goal.prove_sorry lthy (names (fs @ [t, p])) (validP_prems @ f_prems @ imsupp_prems) goal (fn {context=ctxt, prems} => EVERY1 [ - K (unfold_thms_tac ctxt [snd ff0, #rename_def (#inner quot)]), + K (unfold_thms_tac ctxt [snd ff0, #permute_def (#inner quot)]), rtac ctxt trans, rtac ctxt f0_alpha, TRY o resolve_tac ctxt prems, diff --git a/Tools/mrbnf_recursor_tactics.ML b/Tools/mrbnf_recursor_tactics.ML index c371b9f4..07ce97de 100644 --- a/Tools/mrbnf_recursor_tactics.ML +++ b/Tools/mrbnf_recursor_tactics.ML @@ -56,6 +56,7 @@ fun mk_f_termination_tac mk_relation wf_subshape set_subshape_images set_subshap resolve_tac ctxt @{thms bij_id supp_id_bound cmin1 cmin2 card_of_Card_order ordLess_ordLeq_trans} ], K (unfold_thms_tac ctxt @{thms image_id}), + TRY o (etac ctxt imageE THEN' hyp_subst_tac ctxt), eresolve_tac ctxt (map (Drule.rotate_prems ~1) set_subshape_images @ set_subshapes), REPEAT_DETERM o FIRST' [ assume_tac ctxt, diff --git a/Tools/mrbnf_sugar.ML b/Tools/mrbnf_sugar.ML index 7958910a..bf89f7dd 100644 --- a/Tools/mrbnf_sugar.ML +++ b/Tools/mrbnf_sugar.ML @@ -5,7 +5,7 @@ type spec = { fp_b: binding, vars: ((string * sort) * MRBNF_Def.var_type) list, rec_vars: int, - binding_rel: int list list, + binding_rel: (int list * int list) list, ctors: ((string * mixfix) * typ list) list, map_b: binding, tvsubst_b: binding @@ -19,7 +19,7 @@ type binder_sugar = { bsetss: term option list list, bset_bounds: thm list, mrbnf: MRBNF_Def.mrbnf, - strong_induct: thm, + strong_induct: thm option, distinct: thm list, ctors: (term * thm) list }; @@ -47,7 +47,7 @@ type spec = { fp_b: binding, vars: ((string * sort) * MRBNF_Def.var_type) list, rec_vars: int, - binding_rel: int list list, + binding_rel: (int list * int list) list, ctors: ((string * mixfix) * typ list) list, map_b: binding, tvsubst_b: binding @@ -61,7 +61,7 @@ type binder_sugar = { bsetss: term option list list, bset_bounds: thm list, mrbnf: MRBNF_Def.mrbnf, - strong_induct: thm, + strong_induct: thm option, distinct: thm list, ctors: (term * thm) list }; @@ -75,7 +75,7 @@ fun morph_binder_sugar phi { map_simps, permute_simps, set_simpss, subst_simps, bsetss = map (map (Option.map (Morphism.term phi))) bsetss, bset_bounds = map (Morphism.thm phi) bset_bounds, mrbnf = MRBNF_Def.morph_mrbnf phi mrbnf, - strong_induct = Morphism.thm phi strong_induct, + strong_induct = Option.map (Morphism.thm phi) strong_induct, distinct = map (Morphism.thm phi) distinct, ctors = map (map_prod (Morphism.term phi) (Morphism.thm phi)) ctors } : binder_sugar; @@ -122,9 +122,12 @@ fun create_binder_type (fp : MRBNF_Util.fp_kind) (spec : spec) lthy = val pre_name = name ^ "_pre" (* ^ name *); val ((mrbnf, tys), (accum, lthy)) = MRBNF_Comp.mrbnf_of_typ true MRBNF_Def.Smart_Inline (Binding.prefix_name pre_name) flatten_tyargs Xs [] (#vars spec) fp_pre_T ((MRBNF_Comp.empty_comp_cache, MRBNF_Comp.empty_unfolds), lthy); + val (_, _, (mrbnfs, (accum, lthy))) = MRBNF_Comp.normalize_mrbnfs (K I) [] [map dest_TFree (snd tys)] + [] (#vars spec) (K (map fst (#vars spec))) NONE [mrbnf] (accum, lthy); + val mrbnf = hd mrbnfs; val ((mrbnf, (Ds, absinfo)), lthy) = MRBNF_Comp.seal_mrbnf I (snd accum) (Binding.name pre_name) true (fst tys) [] mrbnf lthy; val (bnf, lthy) = MRBNF_Def.register_mrbnf_as_bnf mrbnf lthy - val (res, lthy) = MRBNF_FP.construct_binder_fp fp [((name, mrbnf), #rec_vars spec)] (#binding_rel spec) lthy; + val (res, lthy) = MRBNF_FP.construct_binder_fp fp [((name, mrbnf), #rec_vars spec)] (map single (#binding_rel spec)) lthy; in ((res, fp_pre_T, mrbnf, absinfo), lthy) end fun create_binder_datatype (spec : spec) lthy = @@ -133,6 +136,7 @@ fun create_binder_datatype (spec : spec) lthy = val ([(rec_mrbnf, vvsubst_res)], lthy) = MRBNF_VVSubst.mrbnf_of_quotient_fixpoint [#map_b spec] I res lthy; val lthy = MRBNF_Def.register_mrbnf_raw (fst (dest_Type (#T (hd (#quotient_fps res))))) rec_mrbnf lthy; + val nrecs = fold (curry (op+)) (#rec_vars res) 0; val quotient_ctor = #ctor (hd (#quotient_fps res)); val replace = map (TFree o fst) (#vars spec) ~~ snd (dest_Type (domain_type (fastype_of quotient_ctor))); val pre_repT = Term.typ_subst_atomic replace fp_pre_T; @@ -200,7 +204,7 @@ fun create_binder_datatype (spec : spec) lthy = val pre_mrbnf = hd (#pre_mrbnfs res); val info = hd (Typedef.get_info lthy (fst (dest_Type (MRBNF_Def.T_of_mrbnf pre_mrbnf)))); - val strong_induct = + val strong_induct_opt = Option.map (fn fp_thms => let val (P, names_lthy) = names_lthy |> apfst hd o mk_Frees "P" [qT --> b --> @{typ bool}]; @@ -266,7 +270,7 @@ fun create_binder_datatype (spec : spec) lthy = val goal = HOLogic.mk_Trueprop (mk_all (dest_Free rho) (P $ t $ rho)); val thm = infer_instantiate' lthy ( [NONE] @ map (SOME o Thm.cterm_of lthy) (Ks @ [P, t]) - ) (#fresh_co_induct_param (#inner quotient)); + ) (#fresh_induct_param fp_thms); val absumprodE = BNF_FP_Util.mk_absumprodE (#type_definition (snd info)) (map (length o snd) (#ctors spec)) in Goal.prove_sorry lthy (names ([P, t] @ Ks)) (bound_prems @ rules) goal (fn {context=ctxt, prems} => EVERY1 [ @@ -278,7 +282,7 @@ fun create_binder_datatype (spec : spec) lthy = ) ctxt THEN_ALL_NEW hyp_subst_tac ctxt, K (Local_Defs.unfold0_tac ctxt ( @{thms sum.set_map prod.set_map UN_empty2 Un_empty_left Un_empty_right comp_def - UN_singleton sum_set_simps prod_set_simps UN_single UN_empty + UN_singleton sum_set_simps prod_set_simps UN_single UN_empty disjoint_single } @ map (Thm.symmetric o snd) ctors @ MRBNF_Def.set_defs_of_mrbnf pre_mrbnf @ [#Abs_inverse (snd info) OF @{thms UNIV_I}] @@ -292,8 +296,9 @@ fun create_binder_datatype (spec : spec) lthy = rtac ctxt thm, REPEAT_DETERM o FIRST' (map (fn IH => SELECT_GOAL (EVERY1 [ REPEAT_DETERM o rtac ctxt allI, - TRY o rtac ctxt @{thm disjointI}, + TRY o rtac ctxt @{thm Int_subset_empty1}, rtac ctxt IH, + TRY o rtac ctxt subsetI, K (Local_Defs.unfold0_tac ctxt @{thms Un_iff singleton_iff HOL.simp_thms(6,29,30)}), REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms UNIV_I UN_I singletonI TrueI}), IF_UNSOLVED o EVERY' [ @@ -306,9 +311,10 @@ fun create_binder_datatype (spec : spec) lthy = IF_UNSOLVED o K no_tac ])) prems) ]) ctxt) (drop n prems)) - ]) |> Rule_Cases.name (bound_names @ ctor_names) end; + ]) |> Rule_Cases.name (bound_names @ ctor_names) end + ) (#fp_thms res); - val fresh_induct = + val fresh_induct_opt = Option.map (fn strong_induct => let val ((As, P), names_lthy') = names_lthy |> mk_Frees "A" (map (range_type o fastype_of) Ks) @@ -319,12 +325,13 @@ fun create_binder_datatype (spec : spec) lthy = val thm' = Local_Defs.unfold0 lthy @{thms HOL.simp_thms(35) triv_forall_equality} ( infer_instantiate' lthy (map (SOME o Thm.cterm_of lthy) (Ks' @ [P', t])) strong_induct ); - in Morphism.thm phi thm' |> Rule_Cases.name (bound_names @ ctor_names) end; + in Morphism.thm phi thm' |> Rule_Cases.name (bound_names @ ctor_names) end + ) strong_induct_opt; - val induct = Local_Defs.unfold0 lthy + val induct_opt = Option.map (fn fresh_induct => Local_Defs.unfold0 lthy @{thms notin_empty_eq_True Int_empty_right HOL.simp_thms(6) HOL.True_implies_equals} ( fold (K (fn thm => thm OF @{thms emp_bound})) (1 upto length vars) fresh_induct - ) |> Rule_Cases.name ctor_names; + ) |> Rule_Cases.name ctor_names) fresh_induct_opt; fun get_index x ys = let @@ -332,7 +339,12 @@ fun create_binder_datatype (spec : spec) lthy = | go (y::ys) n = if x = y then SOME n else go ys (n + 1) in go ys 0 end; val bounds = map_filter (fn (x, MRBNF_Def.Bound_Var) => SOME (TFree x) | _ => NONE) (#vars spec); - val frees = map_filter (fn (x, MRBNF_Def.Free_Var) => SOME (TFree x) | _ => NONE) (#vars spec); + fun take_while _ [] = [] + | take_while f (x :: xs) = if f x then x :: take_while f xs else [] + val frees = map (TFree o fst) (take_while (curry (op=) MRBNF_Def.Free_Var o snd) (#vars spec)); + val bfrees = map (TFree o fst) ( + take (length (#bfree_vars res)) (drop (length (#vars spec) - length (#bfree_vars res) - nrecs) (#vars spec)) + ); (* TODO: Use mrbnf sets here (only relevant for passive variables) *) val (bset_optss, set_simpss) = split_list (map (fn FVars => @@ -342,8 +354,9 @@ fun create_binder_datatype (spec : spec) lthy = ) vars); val free = get_var frees; val bound = get_var bounds; + val bfree_opt = try get_var bfrees; val rec_bounds = map (nth rec_vars) (the_default [] ( - Option.mapPartial (try (nth (#binding_rel spec))) (get_index bound bounds) + Option.mapPartial (try (snd o nth (#binding_rel spec))) (get_index bound bounds) )); in split_list (map2 (fn (ctor, _) => fn (_, tys) => let @@ -351,11 +364,22 @@ fun create_binder_datatype (spec : spec) lthy = |> mk_Frees "x" tys; fun get_set vars = map ( - fn (t as Free _) => if fastype_of t = free then mk_singleton t else FVars $ t + fn (t as Free _) => if fastype_of t = free then mk_singleton t else + (case bfree_opt of + SOME a => (if fastype_of t = a then mk_singleton t else FVars $ t) + | NONE => FVars $ t) | t => if member (op=) rec_vars (HOLogic.dest_setT (fastype_of t)) then mk_UNION t FVars else t ) (flat (map_filter I (map2 (fn T => fn x => get_sets T vars x) tys xs))); - val sets = get_set (free::subtract (op=) rec_bounds rec_vars) - val brec_sets = get_set rec_bounds + + val sets = get_set (free::subtract (op=) rec_bounds rec_vars); + fun incorporate xs = case xs of [] => I | (x::_) => cons (fold_rev mk_insert xs (mk_bot (fastype_of x))); + val (xtra, sets) = fold_rev ( + fn Const (@{const_name insert}, _) $ t $ Const (@{const_name bot}, _) => (fn (xs, acc) => (t::xs, acc)) + | t => fn (xs, acc) => ([], incorporate xs (t::acc)) + ) sets ([], []); + val sets = incorporate xtra sets; + + val brec_sets = get_set (the_default [] (Option.map single bfree_opt) @ rec_bounds) val bsets = map (fn (t as Free _) => mk_singleton t | t => t) ( flat (map_filter I (map2 (fn T => fn x => get_sets T [bound] x) tys xs)) ); @@ -380,7 +404,7 @@ fun create_binder_datatype (spec : spec) lthy = | _ => foldl1 MRBNF_Util.mk_Un sets )); val thms = @{thms sum.set_map prod.set_map comp_def UN_empty UN_empty2 Un_empty_left Un_empty_right - UN_singleton UN_single sum_set_simps prod_set_simps Diff_empty UN_Un + UN_singleton UN_single sum_set_simps prod_set_simps Diff_empty UN_Un Un_assoc[symmetric] insert_is_Un[of _ "{_}"] }; in (bset_opt, Goal.prove_sorry lthy (names xs) [] goal (fn {context=ctxt, ...} => EVERY1 [ K (Local_Defs.unfold0_tac ctxt ( @@ -406,7 +430,7 @@ fun create_binder_datatype (spec : spec) lthy = ] ])) end ) ctors (#ctors spec)) - end) (#FVars quotient)); + end) (#FVarss quotient)); val ctors_tys = ctors ~~ map snd (#ctors spec); val distinct = flat (flat (map_index (fn (i, ((ctor, ctor_def), tys1)) => map_index (fn (j, ((ctor2, ctor2_def), tys2)) => @@ -530,7 +554,7 @@ fun create_binder_datatype (spec : spec) lthy = else Term.list_comb (inner_map, gs) end | NONE => HOLogic.id_const T) | mk_map (T as TFree _) = - (if member (op=) (frees @ extra_apply_args) T then + (if member (op=) (frees @ bfrees @ extra_apply_args) T then case List.find (fn Free (_, T') => domain_type T' = Term.typ_subst_atomic replace T) fs of SOME t => t | NONE => HOLogic.id_const T @@ -600,8 +624,8 @@ fun create_binder_datatype (spec : spec) lthy = val collect_sets = map (fn s => case s of [] => NONE | xs => SOME (Term.subst_atomic_types replace (foldl1 MRBNF_Util.mk_Un xs))) val bound_sets' = collect_sets bound_sets; - val free_rec_vars = subtract (op=) (map (nth rec_vars) (flat (#binding_rel spec))) rec_vars; - val free_sets = collect_sets (mk_sets frees free_rec_vars (SOME (#FVars quotient))); + val free_rec_vars = subtract (op=) (map (nth rec_vars) (flat (map snd (#binding_rel spec)))) rec_vars; + val free_sets = collect_sets (mk_sets frees free_rec_vars (SOME (#FVarss quotient))); val noclash_prems = if do_noclash then map_filter (Option.map HOLogic.mk_Trueprop) (map2 (fn a => fn b => case (a, b) of @@ -658,9 +682,9 @@ fun create_binder_datatype (spec : spec) lthy = val (fs, _) = lthy |> mk_Frees "f" (map (fn a => a --> a) vars); val Ts' = snd (dest_Type qT); - val mapx = Term.subst_atomic_types (Ts' ~~ vars) (#rename quotient); + val mapx = Term.subst_atomic_types (Ts' ~~ vars) (#permute quotient); fun tac ctxt prems = EVERY1 [ - rtac ctxt (trans OF [#rename_ctor (#inner quotient)]), + rtac ctxt (trans OF [#permute_ctor quotient]), K (Local_Defs.unfold0_tac ctxt (thms @ MRBNF_Def.set_defs_of_mrbnf pre_mrbnf @ [ MRBNF_Def.map_def_of_mrbnf pre_mrbnf, #Abs_inverse (snd info) OF @{thms UNIV_I} @@ -748,7 +772,7 @@ fun create_binder_datatype (spec : spec) lthy = map_simps = map_simps, set_simpss = set_simpss, permute_simps = permute_simps, - strong_induct = strong_induct, + strong_induct = strong_induct_opt, subst_simps = Option.map snd tvsubst_opt, bsetss = bset_optss, bset_bounds = [], @@ -759,11 +783,14 @@ fun create_binder_datatype (spec : spec) lthy = val lthy = register_binder_sugar (fst (dest_Type qT)) sugar lthy; + val note_inducts = Option.map (fn strong_induct => [ + ("strong_induct", [strong_induct], []), + ("fresh_induct", [the fresh_induct_opt], []), + ("induct", [the induct_opt], [induct_attrib]) + ]) strong_induct_opt; val notes = - ([("strong_induct", [strong_induct], []), - ("fresh_induct", [fresh_induct], []), - ("induct", [induct], [induct_attrib]), - ("set", flat set_simpss, simp), + (the_default [] note_inducts + @ [("set", flat set_simpss, simp), ("map", map_simps, simp), ("permute", permute_simps, simp), ("distinct", distinct, simp) diff --git a/Tools/mrbnf_tvsubst.ML b/Tools/mrbnf_tvsubst.ML index c6b6c692..7f3a7601 100644 --- a/Tools/mrbnf_tvsubst.ML +++ b/Tools/mrbnf_tvsubst.ML @@ -19,7 +19,8 @@ sig VVrs: (term * thm) list, isVVrs: thm list, tvsubst_VVrs: thm list, - tvsubst_cctor_not_isVVr: thm + tvsubst_cctor_not_isVVr: thm, + tvsubst_permute: thm }; val create_tvsubst_of_mrbnf: (binding -> binding) -> MRBNF_FP_Def_Sugar.fp_result @@ -54,7 +55,8 @@ type tvsubst_result = { VVrs: (term * thm) list, isVVrs: thm list, tvsubst_VVrs: thm list, - tvsubst_cctor_not_isVVr: thm + tvsubst_cctor_not_isVVr: thm, + tvsubst_permute: thm }; val names = map (fst o dest_Free); @@ -76,7 +78,7 @@ fun prove_model_axioms qualify res (models : (Proof.context -> tactic) tvsubst_m val mrbnfs = #pre_mrbnfs res; val nvars = length (#binding_relation res); - val pfree = MRBNF_Def.free_of_mrbnf (hd mrbnfs) - nvars; + val pfree = MRBNF_Def.free_of_mrbnf (hd mrbnfs) - nvars - length (#bfree_vars res); val plive = MRBNF_Def.live_of_mrbnf (hd mrbnfs) - foldl1 (op+) (#rec_vars res); val pbound = MRBNF_Def.bound_of_mrbnf (hd mrbnfs) - nvars; @@ -90,12 +92,13 @@ fun prove_model_axioms qualify res (models : (Proof.context -> tactic) tvsubst_m val set' = Term.subst_atomic_types (old_vars ~~ args) set; val vars = rev (fold (Term.add_tfreesT) args []); - val (((((frees, pfrees), plives), pbounds), bounds), rec_vars) = args + val ((((((frees, pfrees), plives), pbounds), bounds), bfrees), rec_vars) = args |> chop nvars ||>> chop pfree ||>> chop plive ||>> chop pbound - ||>> chop nvars; + ||>> chop nvars + ||>> chop (length (#bfree_vars res)); val names_lthy = fold (Variable.declare_constraints o Logic.mk_type o TFree) vars lthy; val ((((a, b), x), Bs), names_lthy) = names_lthy @@ -104,14 +107,15 @@ fun prove_model_axioms qualify res (models : (Proof.context -> tactic) tvsubst_m ||>> apfst hd o mk_Frees "x" [preT] ||>> mk_TFrees (length rec_vars); - val fTs = map (fn a => a --> a) (frees @ bounds) @ map2 (curry op-->) rec_vars Bs; + val fTs = map (fn a => a --> a) (frees @ bounds @ bfrees) @ map2 (curry op-->) rec_vars Bs; - val ((free_fs, bound_fs), live_fs) = names_lthy + val (((free_fs, bound_fs), bfree_fs), live_fs) = names_lthy |> mk_Frees "f" fTs |> fst |> chop nvars - ||>> chop nvars; - val fs = free_fs @ bound_fs @ live_fs; + ||>> chop nvars + ||>> chop (length (#bfree_vars res)); + val fs = free_fs @ bound_fs @ bfree_fs @ live_fs; val lthy = snd (Local_Theory.begin_nested lthy); val (raw_eta, lthy) = mk_def_t false (#binding model) qualify (the eta_name) 0 eta lthy @@ -139,13 +143,15 @@ fun prove_model_axioms qualify res (models : (Proof.context -> tactic) tvsubst_m ))) (fn {context, ...} => unfold_thms_tac context [snd eta] THEN #eta_compl_free tacs context); - val f_prems = map mk_supp_bound free_fs @ maps (fn f => [mk_bij f, mk_supp_bound f]) bound_fs; + val f_prems = map mk_supp_bound free_fs + @ maps (fn f => [mk_bij f, mk_supp_bound f]) bound_fs + @ map mk_supp_bound bfree_fs; val eta' = let val (n, T) = dest_Const (fst eta); val (n2, _) = dest_Type (range_type T); - val Ts' = frees @ pfrees @ plives @ pbounds @ bounds @ Bs; + val Ts' = frees @ pfrees @ plives @ pbounds @ bounds @ bfrees @ Bs; in Const (n, domain_type T --> Type (n2, Ts')) end; val eta_natural = Goal.prove_sorry lthy (names fs) [] (fold_rev (curry Logic.mk_implies o HOLogic.mk_Trueprop) f_prems (mk_Trueprop_eq ( @@ -153,7 +159,7 @@ fun prove_model_axioms qualify res (models : (Proof.context -> tactic) tvsubst_m MRBNF_Def.mk_map_comb_of_mrbnf (MRBNF_Def.deads_of_mrbnf mrbnf) (map HOLogic.id_const plives @ live_fs) (map HOLogic.id_const pbounds @ bound_fs) - (free_fs @ map HOLogic.id_const pfrees) mrbnf, + (free_fs @ map HOLogic.id_const pfrees @ bfree_fs) mrbnf, fst eta ), HOLogic.mk_comp (eta', nth free_fs i) @@ -200,7 +206,7 @@ fun prove_model_axioms qualify res (models : (Proof.context -> tactic) tvsubst_m } : thm tvsubst_model) models etass, lthy ) end; -fun define_tvsubst_consts qualify fp_res (vars, pfrees, plives, pbounds) (models : thm tvsubst_model list) lthy = +fun define_tvsubst_consts qualify (fp_res : MRBNF_FP_Def_Sugar.fp_result) (vars, pfrees, plives, pbounds) (models : thm tvsubst_model list) lthy = let val nvars = length vars; val mk_def_t = MRBNF_Util.mk_def_t false (Binding.conglomerate (map #binding models)) qualify; @@ -233,19 +239,19 @@ fun define_tvsubst_consts qualify fp_res (vars, pfrees, plives, pbounds) (models |> apfst hd o mk_Frees "f" [aT --> qT] ||>> apfst hd o mk_Frees "t" [qT]; - val (SSupp, lthy) = mk_def_public ("SSupp" ^ the suffix ^ "_" ^ Binding.name_of (#binding model)) + val (SSupp, lthy) = mk_def_public ("SSupp" ^ the suffix ^ "_" ^ short_type_name (fst (dest_Type qT))) 1 (Term.absfree (dest_Free h) (HOLogic.mk_Collect ("a", aT, HOLogic.mk_not (HOLogic.mk_eq ( h $ Bound 0, fst VVr $ Bound 0 ))) )) lthy; val (IImsupps, lthy) = @{fold_map 2} (fn FVars => fn s => - mk_def_public ("IImsupp" ^ the suffix ^ s ^ "_" ^ Binding.name_of (#binding model)) 1 (Term.absfree (dest_Free h) ( + mk_def_public ("IImsupp" ^ the suffix ^ s ^ "_" ^ short_type_name (fst (dest_Type qT))) 1 (Term.absfree (dest_Free h) ( let val UN = mk_UNION (fst SSupp $ h) (HOLogic.mk_comp (FVars, h)); in if fastype_of (fst SSupp $ h) = range_type (fastype_of FVars) then mk_Un (fst SSupp $ h, UN) else UN end - ))) (#FVars quot) (if nvars = 1 then [""] else map (fn i => "_" ^ string_of_int i) (1 upto nvars)) lthy; + ))) (#FVarss quot) (if nvars = 1 then [""] else map (fn i => "_" ^ string_of_int i) (1 upto nvars)) lthy; val (isVVr, lthy) = mk_def_t ("isVVr" ^ the suffix) 1 (Term.absfree (dest_Free t) ( HOLogic.mk_exists ("a", aT, HOLogic.mk_eq (t, fst VVr $ Bound 0)) @@ -264,7 +270,7 @@ fun define_tvsubst_consts qualify fp_res (vars, pfrees, plives, pbounds) (models fold_rev Term.absfree (map dest_Free fs) ( Term.absfree (dest_Free h) (HOLogic.mk_comp ( HOLogic.mk_comp ( - Term.list_comb (#rename quot, fs), + Term.list_comb (#permute quot, fs), h ), mk_inv (nth fs i) @@ -290,16 +296,17 @@ fun define_tvsubst_consts qualify fp_res (vars, pfrees, plives, pbounds) (models val P_T = HOLogic.mk_tupleT (flat P_Tss); val (pss, _) = lthy |> mk_Freess "p" P_Tss; + val bfrees = map (nth vars) (#bfree_vars fp_res); val (Uctors, lthy) = @{fold_map 5} (fn ps => fn defs => fn mrbnf => fn quot => fn model => fn lthy => let val ctor = #ctor quot; val (name, (args, rec_args)) = dest_Type (fst (dest_funT (fastype_of ctor))) - |> apsnd (chop (nvars * 2 + length pfrees + length plives + length pbounds)); + |> apsnd (chop (nvars * 2 + length pfrees + length plives + length pbounds + length (#bfree_vars fp_res))); val rec_args' = map (fn T => HOLogic.mk_prodT (T, P_T --> T)) rec_args; val args = args @ rec_args'; - val free_ids = map HOLogic.id_const (vars @ pfrees); + val free_ids = map HOLogic.id_const (vars @ pfrees @ bfrees); val bound_ids = map HOLogic.id_const (pbounds @ vars); val deads = MRBNF_Def.deads_of_mrbnf mrbnf; @@ -444,18 +451,18 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = val f_prems = maps (fn f => map HOLogic.mk_Trueprop [mk_bij f, mk_supp_bound f]) fs; val f_prems' = maps (fn f => map HOLogic.mk_Trueprop [mk_bij f, mk_supp_bound' f]) fs; - val rrename_VVrss = map2 (fn quot => map_index (fn (i, opt) => Option.map (fn def => + val permute_VVrss = map2 (fn quot => map_index (fn (i, opt) => Option.map (fn def => let val a = Free ("a", #aT def); val VVr = fst (#VVr def) val goal = mk_Trueprop_eq ( - Term.list_comb (#rename quot, fs) $ (VVr $ a), + Term.list_comb (#permute quot, fs) $ (VVr $ a), VVr $ (nth fs i $ a) ); in Goal.prove_sorry lthy (names (fs @ [a])) f_prems goal (fn {context=ctxt, prems} => EVERY1 [ K (unfold_thms_tac ctxt [snd (#VVr def), @{thm comp_def}]), rtac ctxt trans, - rtac ctxt (#rename_ctor (#inner quot)), + rtac ctxt (#permute_ctor quot), REPEAT_DETERM o resolve_tac ctxt (prems @ @{thms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order}), rtac ctxt (infer_instantiate' ctxt [NONE, NONE, SOME (Thm.cterm_of ctxt (#ctor quot))] arg_cong), rtac ctxt (Local_Defs.unfold0 ctxt @{thms comp_def} (fun_cong OF [#eta_natural (#axioms def)])), @@ -476,7 +483,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = val Un_bound = @{thm Un_Cinfinite_ordLess} OF [@{thm _}, @{thm _}, Cinfinite_card]; val UNION_bound = @{thm regularCard_UNION_bound} OF [Cinfinite_card, regularCard_card]; - val SSupp_compss = @{map 3} (fn quotient => @{map 3} (fn f => fn rrename_VVr => Option.map (fn def => + val SSupp_compss = @{map 3} (fn quotient => @{map 3} (fn f => fn permute_VVr => Option.map (fn def => let val g = Free ("g", #aT def --> #T quotient); val goal = HOLogic.mk_Trueprop (mk_leq @@ -511,7 +518,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = val SSupp_comp_rename_subset = Goal.prove_sorry lthy (names (fs @ [g])) f_prems (HOLogic.mk_Trueprop (mk_leq - (fst (#SSupp def) $ HOLogic.mk_comp (Term.list_comb (#rename quotient, fs), g)) + (fst (#SSupp def) $ HOLogic.mk_comp (Term.list_comb (#permute quotient, fs), g)) (mk_Un (fst (#SSupp def) $ g, mk_supp f)) )) (fn {context=ctxt, prems} => EVERY1 [ rtac ctxt subsetI, @@ -521,9 +528,9 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = in rtac ctxt (infer_instantiate' ctxt [SOME (Thm.cterm_of ctxt (HOLogic.mk_eq (g $ x, fst (#VVr def) $ x)))] @{thm case_split}) 1 end ) ctxt, dtac ctxt @{thm iffD1[OF arg_cong2[OF _ refl, of _ _ "(\)"], rotated]}, - rtac ctxt (mk_arg_cong lthy 1 (Term.list_comb (#rename quotient, fs))), + rtac ctxt (mk_arg_cong lthy 1 (Term.list_comb (#permute quotient, fs))), assume_tac ctxt, - K (unfold_thms_tac ctxt [the rrename_VVr OF prems]), + K (unfold_thms_tac ctxt [the permute_VVr OF prems]), rtac ctxt disjI2, etac ctxt @{thm contrapos_nn}, rtac ctxt (mk_arg_cong lthy 1 (fst (#VVr def))), @@ -535,7 +542,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = val SSupp_comp_rename_bound = Goal.prove_sorry lthy (names (fs @ [g])) ( [HOLogic.mk_Trueprop (#mk_SSupp_bound def g)] @ f_prems' ) (HOLogic.mk_Trueprop (#mk_SSupp_bound def (HOLogic.mk_comp ( - Term.list_comb (#rename quotient, fs), g + Term.list_comb (#permute quotient, fs), g )))) (fn {context=ctxt, prems} => EVERY1 [ rtac ctxt @{thm ordLeq_ordLess_trans[OF card_of_mono1]}, rtac ctxt SSupp_comp_rename_subset, @@ -547,7 +554,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = SSupp_comp_rename_subset = SSupp_comp_rename_subset, SSupp_comp_rename_bound = SSupp_comp_rename_bound } end - )) fs) (#quotient_fps fp_res) rrename_VVrss defss; + )) fs) (#quotient_fps fp_res) permute_VVrss defss; val g_prems' = maps (fn g => map HOLogic.mk_Trueprop [mk_bij g, mk_supp_bound' g]) gs; @@ -560,7 +567,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = in Goal.prove_sorry lthy (names (fs @ gs)) (g_prems' @ f_prems') goal (fn {context=ctxt, prems} => EVERY1 [ K (unfold_thms_tac ctxt [snd (#compSS def)]), REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (@{thms o_inv_distrib} @ [#rename_comp0 quotient RS sym]), + EqSubst.eqsubst_tac ctxt [0] (@{thms o_inv_distrib} @ [#permute_comp0 quotient RS sym]), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ prems @ @{thms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order}) ], K (unfold_thms_tac ctxt @{thms id_o o_id}), @@ -579,7 +586,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = ); in Goal.prove_sorry lthy [] [] goal (fn {context=ctxt, ...} => unfold_thms_tac ctxt (@{thms inv_id id_o o_id id_def[symmetric]} - @ [snd (#compSS def), #rename_id0 quotient] + @ [snd (#compSS def), #permute_id0 quotient] ) THEN rtac ctxt refl 1 ) end ))) (#quotient_fps fp_res) defss; @@ -620,7 +627,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = val h = Free ("h", #SSfun def); val goal = mk_Trueprop_eq ( fst (#SSupp def) $ (HOLogic.mk_comp ( - HOLogic.mk_comp (Term.list_comb (#rename quotient, fs), h), + HOLogic.mk_comp (Term.list_comb (#permute quotient, fs), h), mk_inv f )), mk_image f $ (fst (#SSupp def) $ h) @@ -648,7 +655,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = dtac ctxt sym, etac ctxt @{thm subst}, rtac ctxt trans, - rtac ctxt (#rename_ctor (#inner quotient)), + rtac ctxt (#permute_ctor quotient), REPEAT_DETERM o resolve_tac ctxt prems, EqSubst.eqsubst_tac ctxt [0] eta_naturals, REPEAT_DETERM o resolve_tac ctxt prems, @@ -661,17 +668,17 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = EqSubst.eqsubst_tac ctxt [0] @{thms inv_simp1}, resolve_tac ctxt prems, etac ctxt @{thm contrapos_nn}, - dtac ctxt (mk_arg_cong lthy 1 (Term.list_comb (#rename quotient, map mk_inv fs))), - EqSubst.eqsubst_asm_tac ctxt [0] [#rename_comp quotient], + dtac ctxt (mk_arg_cong lthy 1 (Term.list_comb (#permute quotient, map mk_inv fs))), + EqSubst.eqsubst_asm_tac ctxt [0] [#permute_comp quotient], REPEAT_DETERM o resolve_tac ctxt (@{thms supp_inv_bound bij_imp_bij_inv} @ prems), REPEAT_DETERM o EVERY' [ EqSubst.eqsubst_asm_tac ctxt [0] @{thms inv_o_simp1}, resolve_tac ctxt prems ], - K (unfold_thms_tac ctxt [#rename_id quotient]), + K (unfold_thms_tac ctxt [#permute_id quotient]), etac ctxt trans, rtac ctxt trans, - rtac ctxt (#rename_ctor (#inner quotient)), + rtac ctxt (#permute_ctor quotient), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_inv_bound bij_imp_bij_inv} @ prems), EqSubst.eqsubst_tac ctxt [0] eta_naturals, REPEAT_DETERM o resolve_tac ctxt (@{thms supp_inv_bound bij_imp_bij_inv} @ prems), @@ -707,14 +714,14 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = ]) end )) fs (0 upto nvars - 1)) (#quotient_fps fp_res) defss; - val IImsupp_imsupp_rrename_commutess = @{map 4} (fn quotient => @{map 4} (fn i => fn rrename_VVr => fn IImsupp_VVr => Option.map (fn def => + val IImsupp_imsupp_permute_commutess = @{map 4} (fn quotient => @{map 4} (fn i => fn permute_VVr => fn IImsupp_VVr => Option.map (fn def => let val g = Free ("g", #aT def --> #T quotient); val int_empties = map2 (fn f => fn IImsupp => HOLogic.mk_Trueprop (mk_int_empty (mk_imsupp f, fst IImsupp $ g)) ) fs (#IImsupps def); val goal = mk_Trueprop_eq ( - HOLogic.mk_comp (Term.list_comb (#rename quotient, fs), g), + HOLogic.mk_comp (Term.list_comb (#permute quotient, fs), g), HOLogic.mk_comp (g, nth fs i) ); in Goal.prove_sorry lthy (names (fs @ [g])) (f_prems @ int_empties) goal (fn {context=ctxt, prems} => EVERY1 [ @@ -730,10 +737,10 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = ] end ) ctxt, rtac ctxt trans, - rtac ctxt (mk_arg_cong lthy 1 (Term.list_comb (#rename quotient, fs))), + rtac ctxt (mk_arg_cong lthy 1 (Term.list_comb (#permute quotient, fs))), assume_tac ctxt, rtac ctxt trans, - rtac ctxt (the rrename_VVr), + rtac ctxt (the permute_VVr), REPEAT_DETERM o resolve_tac ctxt prems, rtac ctxt trans, rtac ctxt (mk_arg_cong lthy 1 (fst (#VVr def))), @@ -744,7 +751,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = assume_tac ctxt, assume_tac ctxt, rtac ctxt trans, - rtac ctxt (#rename_cong_id (#inner quotient)), + rtac ctxt (#permute_cong_id (#inner quotient)), REPEAT_DETERM o resolve_tac ctxt (prems @ @{thms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order}), REPEAT_DETERM o EVERY' [ rtac ctxt @{thm id_onD[rotated]}, @@ -765,13 +772,13 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = rtac ctxt sym, assume_tac ctxt, rtac ctxt trans, - rtac ctxt (mk_arg_cong lthy 1 (Term.list_comb (#rename quotient, fs))), + rtac ctxt (mk_arg_cong lthy 1 (Term.list_comb (#permute quotient, fs))), defer_tac, rtac ctxt trans, K (prefer_tac 3), etac ctxt (the IImsupp_VVr), resolve_tac ctxt prems, - rtac ctxt (the rrename_VVr), + rtac ctxt (the permute_VVr), REPEAT_DETERM o resolve_tac ctxt prems, rtac ctxt sym, rtac ctxt (the IImsupp_VVr), @@ -780,9 +787,9 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = assume_tac ctxt, resolve_tac ctxt prems ]) end - )) (0 upto nvars - 1)) (#quotient_fps fp_res) rrename_VVrss IImsupp_VVrss defss; + )) (0 upto nvars - 1)) (#quotient_fps fp_res) permute_VVrss IImsupp_VVrss defss; - val compSS_cong_idss = map2 (map2 (fn rrename_commute => Option.map (fn def => + val compSS_cong_idss = map2 (map2 (fn permute_commute => Option.map (fn def => let val h = Free ("h", #SSfun def); val IImsupp_prems = map2 (fn IImsupp => fn f => @@ -795,7 +802,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = val goal = mk_Trueprop_eq (Term.list_comb (fst (#compSS def), fs) $ h, h); in Goal.prove_sorry lthy (names (fs @ [h])) (f_prems @ IImsupp_prems) goal (fn {context=ctxt, prems} => EVERY1 [ K (unfold_thms_tac ctxt [snd (#compSS def)]), - EqSubst.eqsubst_tac ctxt [0] [the rrename_commute], + EqSubst.eqsubst_tac ctxt [0] [the permute_commute], REPEAT_DETERM o resolve_tac ctxt prems, REPEAT_DETERM o EVERY' [ rtac ctxt @{thm trans[OF Int_commute]}, @@ -820,7 +827,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = K (unfold_thms_tac ctxt @{thms id_o o_id}), rtac ctxt refl ]) end - ))) IImsupp_imsupp_rrename_commutess defss; + ))) IImsupp_imsupp_permute_commutess defss; val asVVr_VVrss = map2 (map2 (fn VVr_inj => Option.map (fn def => let val a = Free ("a", #aT def) @@ -839,33 +846,33 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = ]) end ))) VVr_injss defss; - val isVVr_renamess = @{map 3} (fn quotient => map2 (fn rrename_VVr => Option.map (fn def => + val isVVr_renamess = @{map 3} (fn quotient => map2 (fn permute_VVr => Option.map (fn def => let val x = Free ("x", #T quotient); val goal = mk_Trueprop_eq ( - fst (#isVVr def) $ (Term.list_comb (#rename quotient, fs) $ x), + fst (#isVVr def) $ (Term.list_comb (#permute quotient, fs) $ x), fst (#isVVr def) $ x ); in Goal.prove_sorry lthy (names (fs @ [x])) f_prems goal (fn {context=ctxt, prems} => EVERY1 [ K (unfold_thms_tac ctxt [snd (#isVVr def)]), rtac ctxt iffI, etac ctxt exE, - dtac ctxt (mk_arg_cong lthy 1 (Term.list_comb (#rename quotient, map mk_inv fs))), + dtac ctxt (mk_arg_cong lthy 1 (Term.list_comb (#permute quotient, map mk_inv fs))), REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_asm_tac ctxt [0] [@{thm inv_o_simp1}, #rename_comp quotient, the rrename_VVr], + EqSubst.eqsubst_asm_tac ctxt [0] [@{thm inv_o_simp1}, #permute_comp quotient, the permute_VVr], REPEAT_DETERM o resolve_tac ctxt (@{thms supp_inv_bound bij_imp_bij_inv} @ prems @ @{thms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order}) ], - K (unfold_thms_tac ctxt [#rename_id quotient]), + K (unfold_thms_tac ctxt [#permute_id quotient]), rtac ctxt exI, assume_tac ctxt, etac ctxt exE, hyp_subst_tac ctxt, - EqSubst.eqsubst_tac ctxt [0] [the rrename_VVr], + EqSubst.eqsubst_tac ctxt [0] [the permute_VVr], REPEAT_DETERM o resolve_tac ctxt prems, rtac ctxt exI, rtac ctxt refl ]) end - ))) (#quotient_fps fp_res) rrename_VVrss defss; + ))) (#quotient_fps fp_res) permute_VVrss defss; val valid_Pmap = let @@ -919,7 +926,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = SELECT_GOAL (unfold_thms_tac ctxt (maps (map snd o #IImsupps) some_defs)), K (unfold_thms_tac ctxt @{thms image_comp[symmetric]}), EqSubst.eqsubst_tac ctxt [0] @{thms image_comp[unfolded comp_def]}, - EqSubst.eqsubst_tac ctxt [0] (maps #FVars_renames (#quotient_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (maps #FVars_permutes (#quotient_fps fp_res)), REPEAT_DETERM o FIRST' [ assume_tac ctxt, resolve_tac ctxt @{thms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order} @@ -959,7 +966,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = REPEAT_DETERM o assume_tac ctxt ]; - fun mk_rrename_Uctor_tac mrbnf quotient ctxt = EVERY1 [ + fun mk_permute_Uctor_tac mrbnf quotient ctxt = EVERY1 [ K (unfold_thms_tac ctxt (map snd Uctors)), REPEAT_DETERM o EVERY' [ EqSubst.eqsubst_tac ctxt [0] [MRBNF_Def.map_comp_of_mrbnf mrbnf], @@ -982,7 +989,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = ] ], REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] ((#rename_ctor (#inner quotient) RS sym) :: maps (map_filter I) isVVr_renamess), + EqSubst.eqsubst_tac ctxt [0] ((#permute_ctor quotient RS sym) :: maps (map_filter I) isVVr_renamess), REPEAT_DETERM o FIRST' [ assume_tac ctxt, resolve_tac ctxt @{thms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order} @@ -1001,7 +1008,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = @ maps (map_filter I) asVVr_VVrss @ [snd Pmap] )), - EqSubst.eqsubst_tac ctxt [0] (maps (map_filter I) rrename_VVrss), + EqSubst.eqsubst_tac ctxt [0] (maps (map_filter I) permute_VVrss), REPEAT_DETERM o FIRST' [ assume_tac ctxt, resolve_tac ctxt @{thms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order} @@ -1014,7 +1021,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = rtac ctxt refl ], rtac ctxt trans, - rtac ctxt (#rename_ctor (#inner quotient)), + rtac ctxt (#permute_ctor quotient), REPEAT_DETERM o FIRST' [ assume_tac ctxt, resolve_tac ctxt @{thms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order} @@ -1091,7 +1098,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = ], K (unfold_thms_tac ctxt @{thms image_id image_comp comp_def}), REPEAT_DETERM o rtac ctxt @{thm Un_mono'}, - rtac ctxt @{thm Un_upper1}, + REPEAT_DETERM o rtac ctxt @{thm Un_upper1}, REPEAT_DETERM o EVERY' [ TRY o EVERY' [ rtac ctxt @{thm iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]}, @@ -1139,8 +1146,8 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = Uctor = fst Uctor, validity = NONE, axioms = { - rrename_Uctor = mk_rrename_Uctor_tac mrbnf quotient, - FVars_subsets = map2 (mk_FVars_subset_tac mrbnf quotient defs n) (#FVars quotient) (0 upto nvars - 1) + permute_Uctor = mk_permute_Uctor_tac mrbnf quotient, + FVars_subsets = map2 (mk_FVars_subset_tac mrbnf quotient defs n) (#FVarss quotient) (0 upto nvars - 1) } } : (Proof.context -> tactic) MRBNF_Recursor.model, n + length (map_filter I defs)) ) (#quotient_fps fp_res) (#pre_mrbnfs fp_res) models Uctors defss 0); @@ -1154,7 +1161,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = (fold_rev Term.absfree (map dest_Free ps) (Term.abs ("t", #T quotient) ( #rec_fun res $ Bound 0 $ HOLogic.mk_tuple ps) )) - ) rec_ress models (#quotient_fps fp_res) lthy; + ) rec_ress models (#quotient_fps fp_res) lthy;; val (lthy, old_lthy) = `Local_Theory.end_nested lthy; val phi = Proof_Context.export_morphism old_lthy lthy; @@ -1195,9 +1202,10 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = (replicate n live_args) (replicate n bound_args) (replicate n free_args) mrbnf; val sets = take nvars sets @ drop (nvars + npassive) sets; val var_types = replicate nvars MRBNF_Def.Free_Var @ replicate nvars MRBNF_Def.Bound_Var + @ replicate (length (#bfree_vars fp_res)) MRBNF_Def.Free_Var @ replicate (foldr1 (op+) (#rec_vars fp_res)) MRBNF_Def.Live_Var; - val sets' = filter (fn (var, set) => var <> MRBNF_Def.Free_Var orelse - #aT def <> HOLogic.dest_setT (range_type (fastype_of set))) (var_types ~~ sets); + val (xs1, xs2) = chop nvars (var_types ~~ sets); + val sets' = filter (fn (_, set) => #aT def <> HOLogic.dest_setT (range_type (fastype_of set))) xs1 @ xs2; val a = Free ("a", #aT def); val eta_natural' = Local_Defs.unfold0 lthy @{thms comp_def} (fun_cong OF [#eta_natural (#axioms def)]); in map (fn (ty, set) => @@ -1264,19 +1272,20 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = @ #FVars_ctors quotient @ [snd (#VVr def)] @ flat (maps (map_filter I) eta_set_emptiess) ) THEN resolve_tac ctxt [refl, #eta_free (#axioms def)] 1 ) end - ) (#FVars quotient)))) (#quotient_fps fp_res) defss; + ) (#FVarss quotient)))) (#quotient_fps fp_res) defss; + val bfrees = map (nth vars) (#bfree_vars fp_res); val some_hs = flat some_hss; val f'_prems = map2 (fn h => fn def => HOLogic.mk_Trueprop (#mk_SSupp_bound def h)) some_hs some_defs; val setss = map (fn mrbnf => MRBNF_Def.mk_sets_of_mrbnf (replicate n (MRBNF_Def.deads_of_mrbnf mrbnf)) (replicate n (plives @ flat (map2 replicate (#rec_vars fp_res) (map #T (#quotient_fps fp_res))))) - (replicate n (pbounds @ vars)) (replicate n (vars @ pfrees)) mrbnf + (replicate n (pbounds @ vars)) (replicate n (vars @ pfrees @ bfrees)) mrbnf ) mrbnfs; val preTs = map (fn mrbnf => MRBNF_Def.mk_T_of_mrbnf (MRBNF_Def.deads_of_mrbnf mrbnf) (plives @ flat (map2 replicate (#rec_vars fp_res) (map #T (#quotient_fps fp_res)))) - (pbounds @ vars) (vars @ pfrees) mrbnf + (pbounds @ vars) (vars @ pfrees @ bfrees) mrbnf ) mrbnfs; val tvsubst_VVrss = @{map 10} (fn mrbnf => fn model => fn rec_res => fn tvsubst => fn quotient => fn defs => fn hs => fn eta_set_empties => fn asVVr_VVrs => fn sets => @@ -1347,7 +1356,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = val ids = map HOLogic.id_const; val map_t = MRBNF_Def.mk_map_comb_of_mrbnf (MRBNF_Def.deads_of_mrbnf mrbnf) (ids plives @ flat (map2 replicate (#rec_vars fp_res) tvsubst_ts)) - (ids (pbounds @ vars)) (ids (vars @ pfrees)) mrbnf; + (ids (pbounds @ vars)) (ids (vars @ pfrees @ bfrees)) mrbnf; val goal = mk_Trueprop_eq (nth tvsubst_ts i $ (#ctor quotient $ x), #ctor quotient $ (map_t $ x)); in Goal.prove_sorry lthy (names (some_hs @ [x])) prems goal (fn {context=ctxt, prems} => EVERY1 [ K (unfold_thms_tac ctxt (map snd tvsubsts)), @@ -1419,7 +1428,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = rtac ctxt CollectI, assume_tac ctxt ]) end - ) (#FVars quotient) (#IImsupps def)))) (#quotient_fps fp_res) defss; + ) (#FVarss quotient) (#IImsupps def)))) (#quotient_fps fp_res) defss; val IImsupp_Diffss = @{map 4} (fn quotient => fn in_IImsuppss => fn hs => @{map 5} (fn FVars => fn f => fn i => fn in_IImsupps => Option.map (fn def => @@ -1474,7 +1483,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = assume_tac ctxt, assume_tac ctxt ]) end - )) (#FVars quotient) hs (0 upto nvars - 1) in_IImsuppss + )) (#FVarss quotient) hs (0 upto nvars - 1) in_IImsuppss ) (#quotient_fps fp_res) in_IImsuppsss hss defss; val IImsupp_naturalsss = @{map 3} (fn quotient => @{map 3} (fn f => fn SSupp_natural => Option.map (fn def => map2 (fn f' => fn IImsupp => @@ -1482,7 +1491,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = val g = Free ("g", #aT def --> #T quotient); val goal = mk_Trueprop_eq ( fst IImsupp $ HOLogic.mk_comp ( - HOLogic.mk_comp (Term.list_comb (#rename quotient, fs), g), + HOLogic.mk_comp (Term.list_comb (#permute quotient, fs), g), mk_inv f ), mk_image f' $ (fst IImsupp $ g) @@ -1496,7 +1505,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = resolve_tac ctxt prems, K (Local_Defs.unfold0_tac ctxt @{thms o_id}), K (Local_Defs.unfold0_tac ctxt @{thms comp_def}), - EqSubst.eqsubst_tac ctxt [0] (maps #FVars_renames (#quotient_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (maps #FVars_permutes (#quotient_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (refl :: prems) ]) end ) fs (#IImsupps def))) fs) (#quotient_fps fp_res) SSupp_naturalss defss; @@ -1505,19 +1514,19 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = if Thm.nprems_of st = 1 andalso i = 1 then tac st else (PRIMITIVE (Goal.restrict i n) THEN tac THEN PRIMITIVE (Goal.unrestrict i)) st; - val tvsubst_rrenames = + val tvsubst_permutes = let val (ts, _) = lthy |> mk_Frees "t" (map #T (#quotient_fps fp_res)); fun mk_goals comb = @{map 3} (fn quotient => fn tvsubst => fn t => let val hs' = map_filter I (flat (map2 (fn quotient => map2 (fn f => Option.map (fn h => HOLogic.mk_comp ( - HOLogic.mk_comp (Term.list_comb (#rename quotient, fs), h), + HOLogic.mk_comp (Term.list_comb (#permute quotient, fs), h), mk_inv f ))) fs) (#quotient_fps fp_res) hss)); in HOLogic.mk_eq ( - comb (Term.list_comb (#rename quotient, fs)) (Term.list_comb (fst tvsubst, some_hs)) t, - comb (Term.list_comb (fst tvsubst, hs')) (Term.list_comb (#rename quotient, fs)) t + comb (Term.list_comb (#permute quotient, fs)) (Term.list_comb (fst tvsubst, some_hs)) t, + comb (Term.list_comb (fst tvsubst, hs')) (Term.list_comb (#permute quotient, fs)) t ) end ) (#quotient_fps fp_res) tvsubsts ts; val As = map (fn i => @@ -1534,7 +1543,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = in EVERY1 [ DETERM o rtac ctxt (infer_instantiate' ctxt ( map (SOME o Thm.cterm_of ctxt) As @ replicate (length mrbnfs) NONE @ map (SOME o Thm.cterm_of ctxt) ts - ) (#fresh_co_induct (#inner (hd (#quotient_fps fp_res))))), + ) (#fresh_induct (the (#fp_thms fp_res)))), SELECT_GOALS (length As) (EVERY1 [ K (Local_Defs.unfold0_tac ctxt (@{thm comp_def} :: maps (map snd o #IImsupps) some_defs)), REPEAT_DETERM o resolve_tac ctxt ( @@ -1550,17 +1559,17 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = let val n = length (map_filter I defs); in Subgoal.FOCUS_PREMS (fn {context=ctxt, prems=IHs, ...} => EVERY1 [ REPEAT_DETERM_N n o rtac ctxt @{thm case_split[rotated]}, - EqSubst.eqsubst_tac ctxt [0] [#rename_ctor (#inner quotient) OF f_prems], + EqSubst.eqsubst_tac ctxt [0] [#permute_ctor quotient OF f_prems], EqSubst.eqsubst_tac ctxt [0] [Drule.rotate_prems (~1 - n) tvsubst_not_isVVr], resolve_tac ctxt IHs, REPEAT_DETERM o assume_tac ctxt, REPEAT_DETERM o resolve_tac ctxt f'_prems, - REPEAT_DETERM o (rtac ctxt @{thm disjointI} THEN' eresolve_tac ctxt IHs), + REPEAT_DETERM o resolve_tac ctxt IHs, EqSubst.eqsubst_tac ctxt [0] [Drule.rotate_prems (~1 - n) tvsubst_not_isVVr], - rtac ctxt (iffD2 OF [#noclash_rename quotient OF f_prems]), + rtac ctxt (iffD2 OF [#noclash_permute (#inner quotient) OF f_prems]), resolve_tac ctxt IHs, REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] [#rename_ctor (#inner quotient) RS sym OF f_prems], + EqSubst.eqsubst_tac ctxt [0] [#permute_ctor quotient RS sym OF f_prems], EqSubst.eqsubst_tac ctxt [0] (map_filter (Option.map (fn thm => thm OF f_prems)) isVVr_renames), assume_tac ctxt ], @@ -1578,10 +1587,9 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = rtac ctxt @{thm trans[OF image_Int[OF bij_is_inj, symmetric]]}, resolve_tac ctxt f_prems, rtac ctxt @{thm iffD2[OF image_is_empty]}, - rtac ctxt @{thm disjointI}, - eresolve_tac ctxt IHs + resolve_tac ctxt IHs ], - rtac ctxt (trans OF [#rename_ctor (#inner quotient) OF f_prems]), + rtac ctxt (trans OF [#permute_ctor quotient OF f_prems]), rtac ctxt (mk_arg_cong lthy 1 (#ctor quotient)), rtac ctxt (trans OF [MRBNF_Def.map_comp_of_mrbnf mrbnf]), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems), @@ -1617,7 +1625,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = rtac ctxt refl ])) (rev defs)) ]) ctxt end - ) mrbnfs (#quotient_fps fp_res) defss tvsubst_not_isVVrs isVVr_renamess rrename_VVrss tvsubst_VVrss) + ) mrbnfs (#quotient_fps fp_res) defss tvsubst_not_isVVrs isVVr_renamess permute_VVrss tvsubst_VVrss) ] end )); @@ -1637,7 +1645,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = FVars $ (Term.list_comb (fst tvsubst, some_fs') $ t), foldl1 mk_Un (map_filter I (map2 (fn FVars' => Option.map (fn f => mk_UNION (FVars' $ t) (Term.abs ("a", HOLogic.dest_setT (range_type (fastype_of FVars'))) ( FVars $ (f $ Bound 0) - )))) (#FVars quotient) fs')) + )))) (#FVarss quotient) fs')) ); in Goal.prove_sorry lthy (names (some_fs' @ [t])) f'_prems goal (fn {context=ctxt, prems} => EVERY1 [ rtac ctxt (infer_instantiate' ctxt (map (SOME o Thm.cterm_of ctxt) (map_filter I (map2 (fn i => Option.map (fn _ => @@ -1715,21 +1723,22 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = Goal.assume_rule_tac ctxt ]) ]) end - )) (#FVars quotient) (0 upto nvars - 1) fs' tvsubst_VVrs FVars_VVrs not_isVVr_frees IImsupp_Diffs defs;*) + )) (#FVarss quotient) (0 upto nvars - 1) fs' tvsubst_VVrs FVars_VVrs not_isVVr_frees IImsupp_Diffs defs;*) val VVrss' = map (map_filter (Option.map ((fn (VVr, VVr_def) => (VVr, @{thm eq_reflection} OF [mk_unabs_def 1 ( @{thm meta_eq_to_obj_eq} OF [Local_Defs.unfold0 lthy (@{thms comp_def} @ eta_defs) VVr_def] )])) o #VVr))) defss; - val results = @{map 5} (fn tvsubst => fn defs => fn tvsubst_VVrs => fn tvsubst_not_isVVr => fn VVrs' => { + val results = @{map 6} (fn tvsubst => fn defs => fn tvsubst_VVrs => fn tvsubst_not_isVVr => fn VVrs' => fn tvsubst_permute => { tvsubst = fst tvsubst, SSupps = map_filter (Option.map (fst o #SSupp)) defs, IImsuppss = map_filter (Option.map (map fst o #IImsupps)) defs, VVrs = VVrs', isVVrs = map_filter (Option.map (snd o #isVVr)) defs, tvsubst_VVrs = map_filter I tvsubst_VVrs, - tvsubst_cctor_not_isVVr = tvsubst_not_isVVr - }: tvsubst_result) tvsubsts defss tvsubst_VVrss tvsubst_not_isVVrs VVrss'; + tvsubst_cctor_not_isVVr = tvsubst_not_isVVr, + tvsubst_permute = tvsubst_permute + }: tvsubst_result) tvsubsts defss tvsubst_VVrss tvsubst_not_isVVrs VVrss' tvsubst_permutes; (* TODO: Remove *) val notes = @@ -1737,7 +1746,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = ("SSupp_VVr_bound", maps (map_filter I) SSupp_VVr_boundss), ("in_IImsupp", flat (maps (map_filter I) in_IImsuppsss)), ("is_VVr_rrename", maps (map_filter I) isVVr_renamess), - ("rrename_VVr", maps (map_filter I) rrename_VVrss), + ("rrename_VVr", maps (map_filter I) permute_VVrss), ("SSupp_natural", maps (map_filter I) SSupp_naturalss), ("SSupp_comp_rename_bound", maps (map_filter (Option.map #SSupp_comp_rename_bound)) SSupp_compss), ("SSupp_comp_bound", maps (map_filter (Option.map #SSupp_comp_bound)) SSupp_compss), @@ -1745,7 +1754,7 @@ fun create_tvsubst_of_mrbnf qualify fp_res models lthy = ("FVars_VVr", flat (maps (map_filter I) FVars_VVrss)), ("tvsubst_VVr", maps (map_filter I) tvsubst_VVrss), ("tvsubst_cctor_not_isVVr", tvsubst_not_isVVrs), - ("rrename_tvsubst", tvsubst_rrenames), + ("tvsubst_permutes", tvsubst_permutes), ("not_isVVr_free", maps (map_filter I) not_isVVr_freess), ("IImsupp_Diff", maps (map_filter I) IImsupp_Diffss), ("IImsupp_natural", flat (maps (map_filter I) IImsupp_naturalsss)) diff --git a/Tools/mrbnf_util.ML b/Tools/mrbnf_util.ML index a1dcf1b1..4491a491 100644 --- a/Tools/mrbnf_util.ML +++ b/Tools/mrbnf_util.ML @@ -2,6 +2,8 @@ signature MRBNF_UTIL = sig include BNF_UTIL + datatype ('a, 'b) either = Inl of 'a | Inr of 'b + val filter_like: 'a list -> ('a -> bool) -> 'b list -> 'b list val cond_keep: 'a list -> bool list -> 'a list val cond_interlace: 'a list -> 'a list -> bool list -> 'a list @@ -18,12 +20,17 @@ sig val mk_Int: term * term -> term val mk_infinite_regular_card_order: term -> term val mk_id_on: term -> term -> term + val mk_eq_on: term -> term -> term ->term val mk_card_suc: term -> term val mk_cmin: term * term -> term val mk_singleton: term -> term val mk_bot: typ -> term val mk_int_empty: term * term -> term; val mk_sum_ctors: term list -> term list; + val mk_minus: term * term -> term; + val mk_all: string * typ -> term -> term; + val mk_ex: string * typ -> term -> term; + val mk_insert: term -> term -> term; val strip_ex: term -> (string * typ) list * term @@ -67,11 +74,20 @@ struct open BNF_Util +datatype ('a, 'b) either = Inl of 'a | Inr of 'b + fun strip_ex (Const (@{const_name Ex}, _) $ Abs (x, T, t)) = apfst (cons (x, T)) (strip_ex t) | strip_ex t = ([], t) fun swap (a, b) = (b, a) +val mk_minus = HOLogic.mk_binop @{const_name minus}; +fun mk_all (x, T) t = HOLogic.mk_all (x, T, t); +fun mk_ex (x, T) t = HOLogic.mk_exists (x, T, t); + +fun mk_insert x S = + Const (@{const_name Set.insert}, fastype_of x --> fastype_of S --> fastype_of S) $ x $ S; + fun mk_def_t_syn syn public b qualify name n rhs lthy = let val b' = qualify (Binding.name name); @@ -223,6 +239,10 @@ val mk_Int = HOLogic.mk_binop @{const_name inf}; fun mk_id_on t1 t2 = let val (T, ST) = fastype_of t1 |> `HOLogic.dest_setT; in Const (@{const_name id_on}, ST --> (T --> T) --> HOLogic.boolT) $ t1 $ t2 end; +fun mk_eq_on A f1 f2 = + let val fT = fastype_of f1 + in Const (@{const_name eq_on}, fastype_of A --> fT --> fT --> @{typ bool}) $ A $ f1 $ f2 end + fun mk_bij t = t |> fastype_of |> dest_funT @@ -305,4 +325,26 @@ fun mk_card_suc r = let val T = fst (BNF_Util.dest_relT (fastype_of r)); in Const (\<^const_name>\card_suc\, BNF_Util.mk_relT (T, T) --> BNF_Util.mk_relT (mk_sucT T, mk_sucT T)) $ r end; +local + +val parameter = Parse.position Parse.nat >> (fn (n, pos) => + if n > 1 then n else error ("Bad parameter: " ^ string_of_int n ^ Position.here pos)); + +fun indices n = map string_of_int (1 upto n); +fun cons n = implode (map (fn a => " (x" ^ a ^ " :: xs" ^ a ^ ")") (indices n)); +fun vars x n = implode (map (fn a => " " ^ x ^ a) (indices n)); + +in + +val _ = Theory.setup + (ML_Antiquotation.value \<^binding>\map_filter\ + (Scan.lift parameter >> (fn n => + "fn f =>\n\ + \ let\n\ + \ fun map_filter _" ^ replicate_string n " []" ^ " = []\n\ + \ | map_filter f" ^ cons n ^ " = let val ys = map_filter f" ^ vars "xs" n ^ " in the_default ys (Option.map (fn y => y::ys) (f" ^ vars "x" n ^ ")) end\n\ + \ | map_filter _" ^ replicate_string n " _" ^ " = raise ListPair.UnequalLengths\n" ^ + " in map_filter f end"))) +end; + end; diff --git a/Tools/mrbnf_vvsubst.ML b/Tools/mrbnf_vvsubst.ML index d5e0b7ed..3b9dc002 100644 --- a/Tools/mrbnf_vvsubst.ML +++ b/Tools/mrbnf_vvsubst.ML @@ -2,7 +2,7 @@ signature MRBNF_VVSUBST = sig type vvsubst_result = { vvsubst_ctor: thm, - vvsubst_rrename: thm + vvsubst_permute: thm }; val mrbnf_of_quotient_fixpoint: binding list -> (binding -> binding) -> MRBNF_FP_Def_Sugar.fp_result @@ -16,11 +16,10 @@ open BNF_Tactics open BNF_Util open MRBNF_Util open MRBNF_Def -open MRBNF_Recursor type vvsubst_result = { vvsubst_ctor: thm, - vvsubst_rrename: thm + vvsubst_permute: thm }; fun mk_supp_bound f = mk_ordLess (mk_card_of (mk_supp f)) @@ -33,6 +32,7 @@ fun define_vvsubst_consts qualify names (fp_res : MRBNF_FP_Def_Sugar.fp_result) val (_, lthy) = Local_Theory.begin_nested old_lthy; val mrbnfs = #pre_mrbnfs fp_res; + val bfrees = map (nth vars) (#bfree_vars fp_res) val frees = vars @ pfrees; val bounds = pbounds @ vars; @@ -60,7 +60,7 @@ fun define_vvsubst_consts qualify names (fp_res : MRBNF_FP_Def_Sugar.fp_result) let val deads = MRBNF_Def.deads_of_mrbnf mrbnf; val prod_Ts = map2 (fn T => fn T' => HOLogic.mk_prodT (T, P --> T')) Ts Ts'; - val pre_T = mk_T_of_mrbnf deads (plives @ replicate_rec prod_Ts) bounds frees mrbnf; + val pre_T = mk_T_of_mrbnf deads (plives @ replicate_rec prod_Ts) bounds (frees @ bfrees) mrbnf; val rec_ts = map2 (fn T' => fn prod_T => HOLogic.mk_comp ( Term.abs ("R", P --> T') (Bound 0 $ Bound (length ps + 1)), @@ -71,7 +71,7 @@ fun define_vvsubst_consts qualify names (fp_res : MRBNF_FP_Def_Sugar.fp_result) Term.subst_atomic_types (plives ~~ plives') (#ctor quot) $ (mk_map_comb_of_mrbnf deads (live_ps @ replicate_rec rec_ts) (bound_ps @ map HOLogic.id_const vars) - free_ps mrbnf + (free_ps @ map (nth free_ps) (#bfree_vars fp_res)) mrbnf $ Bound (length ps + 1)) ) $ Bound 0)); in mk_def_hidden ("Uctor" ^ string_of_int i) 2 rhs lthy end @@ -84,11 +84,12 @@ fun define_vvsubst_consts qualify names (fp_res : MRBNF_FP_Def_Sugar.fp_result) val mrbnf_setss = @{map 3} (fn m => fn deads => MRBNF_Def.mk_sets_of_mrbnf (replicate m deads) (replicate m (plives @ replicate_rec (map #T (#raw_fps fp_res)))) - (replicate m bounds) (replicate m frees) + (replicate m bounds) (replicate m (frees @ bfrees)) ) ms deadss mrbnfs; - val ((pre_psets, bsetss), rec_setss) = drop nvars (transpose mrbnf_setss) + val (((pre_psets, bsetss), bfree_setss), rec_setss) = drop nvars (transpose mrbnf_setss) |> chop npassive - ||>> apply2 transpose o chop nvars; + ||>> apfst transpose o chop nvars + ||>> apply2 transpose o chop (length (#bfree_vars fp_res)); val (raw_psetss, lthy) = let @@ -117,10 +118,10 @@ fun define_vvsubst_consts qualify names (fp_res : MRBNF_FP_Def_Sugar.fp_result) ]) lthy ); val (info, lthy) = Function.prove_termination NONE (let val ctxt = lthy in EVERY1 [ - Function_Relation.relation_tac ctxt (K (the (#subshape_rel (#inner (hd (#raw_fps fp_res)))))), - rtac ctxt (the (#wf_subshape (#inner (hd (#raw_fps fp_res))))), + Function_Relation.relation_tac ctxt (K (#subshape_rel (the (#fp_thms fp_res)))), + rtac ctxt (#wf_subshape (the (#fp_thms fp_res))), K (unfold_thms_tac ctxt @{thms mem_Collect_eq prod.case sum.case}), - REPEAT_DETERM o eresolve_tac ctxt (maps (flat o the o #set_subshapess o #inner) (#raw_fps fp_res)) + REPEAT_DETERM o eresolve_tac ctxt (flat (#set_subshapess (the (#fp_thms fp_res)))) ] end) lthy; in (map2 (fn a => fn b => (a, b)) sets (the (#simps info)), lthy) end ) (transpose setss) pre_psets lthy; @@ -148,44 +149,51 @@ fun define_vvsubst_consts qualify names (fp_res : MRBNF_FP_Def_Sugar.fp_result) val mrbnf_setss = @{map 3} (fn m => fn deads => MRBNF_Def.mk_sets_of_mrbnf (replicate m deads) (replicate m (plives @ replicate_rec (map #T (#quotient_fps fp_res)))) - (replicate m bounds) (replicate m frees) + (replicate m bounds) (replicate m (frees @ bfrees)) ) ms deadss mrbnfs; - val ((pre_psets, bsetss), rec_setss) = drop nvars (transpose mrbnf_setss) + val (((pre_psets, bsetss), bfree_setss), rec_setss) = drop nvars (transpose mrbnf_setss) |> chop npassive - ||>> apply2 transpose o chop nvars; + ||>> apfst transpose o chop nvars + ||>> apply2 transpose o chop (length (#bfree_vars fp_res)); val rels = map (fn quot => Free ("rel_" ^ short_type_name (fst (dest_Type (#T quot))), fold_rev (curry (op-->)) (map2 (fn a => fn b => a --> b --> @{typ bool}) plives plives') (#T quot --> subst (#T quot) --> @{typ bool}) )) (#quotient_fps fp_res); - val f_premss = @{map 3} (fn rec_sets => fn x => - flat o @{map 4} (fn FVarss => fn f => fn rel => fn bset => + val f_premss = @{map 4} (fn rec_sets => fn x => fn bfree_sets => + flat o @{map 5} (fn i => fn FVarss => fn f => fn rel => fn bset => let - val recs = map (fn i => HOLogic.mk_binop @{const_name minus} ( + (* TODO: fix with multiple bounds *) + val bfree_idx = find_index (curry (op=) i) (#bfree_vars fp_res); + val bfrees = if bfree_idx > ~1 then [ + HOLogic.mk_binop @{const_name minus} (nth bfree_sets bfree_idx $ x, bset $ x) + ] else []; + val recs = bfrees @ map (fn i => HOLogic.mk_binop @{const_name minus} ( mk_UNION (nth rec_sets i $ x) (nth (replicate_rec FVarss) i), bset $ x - )) rel; + )) (hd rel); in [mk_bij f, mk_supp_bound f, mk_id_on (foldl1 mk_Un recs) f] end - ) (transpose (map #FVars (#quotient_fps fp_res))) fs (#binding_relation fp_res) - ) rec_setss qxs bsetss; + ) (0 upto nvars - 1) (transpose (map #FVarss (#quotient_fps fp_res))) fs (#binding_relation fp_res) + ) rec_setss qxs bfree_setss bsetss; val rel_prems = @{map 5} (fn deads => fn mrbnf => fn rec_sets => fn x => fn y => let val rel = Term.list_comb ( - MRBNF_Def.mk_rel_of_mrbnf deads (plives @ replicate_rec Ts) (plives' @ replicate_rec (map subst Ts)) bounds frees mrbnf, + MRBNF_Def.mk_rel_of_mrbnf deads (plives @ replicate_rec Ts) (plives' @ replicate_rec (map subst Ts)) bounds (frees @ bfrees) mrbnf, Rs @ replicate_rec (map (fn rel => Term.list_comb (rel, Rs)) rels) ); + (* TODO: fix for multiple bounds *) val live_ts = @{map 3} (fn i => fn T => fn raw => - if member (op=) (flat (#binding_relation fp_res)) i then - Term.list_comb (#rename raw, @{map 3} (fn f => fn T => fn rel => - if member (op=) rel i then f else HOLogic.id_const T + if member (op=) (maps hd (#binding_relation fp_res)) i then + Term.list_comb (#permute raw, @{map 3} (fn f => fn T => fn rel => + if member (op=) (hd rel) i then f else HOLogic.id_const T ) fs vars (#binding_relation fp_res)) else HOLogic.id_const T ) (0 upto length rec_sets - 1) (replicate_rec Ts) (replicate_rec (#quotient_fps fp_res)); val map_t = MRBNF_Def.mk_map_comb_of_mrbnf deads (map HOLogic.id_const plives @ live_ts) (map HOLogic.id_const pbounds @ fs) - (map HOLogic.id_const frees) mrbnf; + (map HOLogic.id_const frees @ map (nth fs) (#bfree_vars fp_res)) mrbnf; in rel $ (map_t $ x) $ y end ) deadss mrbnfs rec_setss qxs ys; val subst' = Term.subst_atomic_types (plives ~~ plives') @@ -228,12 +236,13 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga val nvars = length (#binding_relation fp_result); val (vars, passives) = chop nvars new_vars; val ((pfrees, plives), pbounds) = passives - |> chop (MRBNF_Def.free_of_mrbnf (hd mrbnfs) - nvars) + |> chop (MRBNF_Def.free_of_mrbnf (hd mrbnfs) - length (#bfree_vars fp_result) - nvars) ||>> chop (MRBNF_Def.live_of_mrbnf (hd mrbnfs) - foldr1 (op+) (#rec_vars fp_result)); val ((plives', plives''), _) = names_lthy |> mk_TFrees (length plives) ||>> mk_TFrees (length plives); val passives = (plives, plives', pbounds, pfrees); + val bfrees = map (nth vars) (#bfree_vars fp_result); val fp_res = MRBNF_FP_Def_Sugar.substitute_vars (old_vars ~~ new_vars) fp_result; val names = map (short_type_name o fst o dest_Type o #T) (#quotient_fps fp_result); @@ -271,7 +280,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga ||>> mk_Frees "S" (map2 (fn a => fn b => a --> b --> @{typ bool}) plives' plives'') ||>> yield_singleton (mk_Frees "p") P ||>> mk_Frees "p" P_Ts - ||>> mk_Frees "y" (@{map 3} (fn deads => fn prod_T => mk_T_of_mrbnf deads (plives @ replicate (live - length plives) prod_T) bounds frees) deadss prod_Ts mrbnfs) + ||>> mk_Frees "y" (@{map 3} (fn deads => fn prod_T => mk_T_of_mrbnf deads (plives @ replicate (live - length plives) prod_T) bounds (frees @ bfrees)) deadss prod_Ts mrbnfs) ||>> mk_Frees "rx" (map #T (#raw_fps fp_res)) ||>> mk_Frees "rx'" (map #T (#raw_fps fp_res)) ||>> mk_Frees "x" (map (domain_type o fastype_of o #ctor) (#quotient_fps fp_res)) @@ -377,11 +386,11 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga } : (Proof.context -> tactic) MRBNF_Recursor.parameter; val model_tacss = @{map 3} (fn quot => fn Uctor => fn mrbnf => { - rrename_Uctor = fn ctxt => EVERY1 [ + permute_Uctor = fn ctxt => EVERY1 [ K (unfold_thms_tac ctxt (@{thms case_prod_beta fst_conv snd_conv} @ [snd Uctor])), REPEAT_DETERM o etac ctxt conjE, rtac ctxt trans, - rtac ctxt (#rename_ctor (#inner quot)), + rtac ctxt (#permute_ctor quot), REPEAT_DETERM o assume_tac ctxt, K (unfold_thms_tac ctxt @{thms compSS_def}), REPEAT_DETERM o EVERY' [ @@ -422,15 +431,15 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga ], K (unfold_thms_tac ctxt @{thms image_id image_comp comp_def}), REPEAT_DETERM o rtac ctxt @{thm Un_mono'}, - REPEAT_DETERM o FIRST' [ - rtac ctxt @{thm iffD1[OF arg_cong2[OF refl Un_commute, of "(\)"] image_imsupp_subset]}, + REPEAT_DETERM o EVERY' [ + TRY o EVERY' [ + rtac ctxt @{thm iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]}, + rtac ctxt @{thm Diff_Un_disjunct}, + resolve_tac ctxt prems, + rtac ctxt @{thm Diff_mono[OF _ subset_refl]} + ], + rtac ctxt @{thm iffD1[OF arg_cong2[OF refl Un_commute, of "(\)"] image_imsupp_subset]} ORELSE' EVERY' [ - TRY o EVERY' [ - rtac ctxt @{thm iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]}, - rtac ctxt @{thm Diff_Un_disjunct}, - resolve_tac ctxt prems, - rtac ctxt @{thm Diff_mono[OF _ subset_refl]} - ], rtac ctxt @{thm iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]}, rtac ctxt @{thm UN_extend_simps(2)}, rtac ctxt @{thm subset_If}, @@ -458,8 +467,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga } : (Proof.context -> tactic) MRBNF_Recursor.model ) vvsubst_bs (#quotient_fps fp_res) Uctors model_tacss; - val (ress, lthy) = create_binding_recursor qualify fp_result parameters models lthy; - val lthy = Config.put Goal.quick_and_dirty false lthy; + val (ress, lthy) = MRBNF_Recursor.create_binding_recursor qualify fp_result parameters models lthy; val (_, lthy) = Local_Theory.begin_nested lthy; @@ -470,6 +478,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga ))) ) ress vvsubst_bs (#quotient_fps fp_res) lthy; + val (lthy, old_lthy) = `Local_Theory.end_nested lthy; val phi = Proof_Context.export_morphism old_lthy lthy; @@ -546,20 +555,20 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga let val fs' = take nvars fs; val goalss = @{map 3} (fn raw => fn x => map (fn pset => HOLogic.mk_eq ( - fst pset $ (Term.list_comb (#rename raw, fs') $ x), fst pset $ x + fst pset $ (Term.list_comb (#permute raw, fs') $ x), fst pset $ x ))) (#raw_fps fp_res) raw_xs raw_psetss; val goal = HOLogic.mk_Trueprop ( foldr1 HOLogic.mk_conj (map (foldr1 HOLogic.mk_conj) goalss) ); val thm = Goal.prove_sorry lthy (names (fs' @ raw_xs)) fs'_prems goal (fn {context=ctxt, prems} => EVERY1 [ - rtac ctxt (the (#subshape_induct (#inner (hd (#raw_fps fp_res))))), + rtac ctxt (#subshape_induct (the (#fp_thms fp_res))), EVERY' (@{map 3} (fn raw => fn psets => fn mrbnf => EVERY' [ Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => rtac ctxt (infer_instantiate' ctxt [SOME (snd (hd params))] (#exhaust (#inner raw))) 1 ) ctxt, hyp_subst_tac ctxt, - REPEAT_DETERM o EqSubst.eqsubst_tac ctxt [0] [#rename_simp (#inner raw) OF prems], + REPEAT_DETERM o EqSubst.eqsubst_tac ctxt [0] [#permute_ctor raw OF prems], K (unfold_thms_tac ctxt (map snd psets)), REPEAT_DETERM o EVERY' [ EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), @@ -573,7 +582,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga rtac ctxt refl, REPEAT_DETERM o EVERY' [ rtac ctxt @{thm UN_cong}, - dresolve_tac ctxt (flat (the (#set_subshapess (#inner raw)))), + dresolve_tac ctxt (flat (#set_subshapess (the (#fp_thms fp_res)))), dresolve_tac ctxt prems, REPEAT_DETERM o etac ctxt conjE, assume_tac ctxt @@ -612,7 +621,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga val (plive_thms, rec_thms) = MRBNF_Def.mr_set_transfer_of_mrbnf mrbnf |> drop (length frees) |> chop (length plives) - |> apsnd (drop (length pbounds + nvars)); + |> apsnd (drop (length pbounds + nvars + length bfrees)); in map (fn thm => Drule.rotate_prems ~1 ( thm RS @{thm rel_funD} RS @{thm iffD1[OF fun_cong[OF fun_cong[OF rel_set_eq]]]} RS sym )) plive_thms @@ -622,7 +631,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga ) mrbnfs; val thm = Goal.prove_sorry lthy (names (raw_xs @ raw_xs')) [] goal (fn {context=ctxt, ...} => EVERY1 [ - rtac ctxt (conj_spec OF [infer_instantiate' ctxt (map SOME insts) (the (#subshape_induct (#inner (hd (#raw_fps fp_res)))))]), + rtac ctxt (conj_spec OF [infer_instantiate' ctxt (map SOME insts) (#subshape_induct (the (#fp_thms fp_res)))]), EVERY' (@{map 4} (fn raw => fn psets => fn mr_rel_sets => fn mr_set_transfers => EVERY' [ rtac ctxt allI, rtac ctxt impI, @@ -646,7 +655,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ prems), FIRST' [ EVERY' [ - dresolve_tac ctxt (flat (the (#set_subshapess (#inner raw)))), + dresolve_tac ctxt (flat (#set_subshapess (the (#fp_thms fp_res)))), dresolve_tac ctxt prems, etac ctxt allE, etac ctxt impE, @@ -655,8 +664,8 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga assume_tac ctxt ], EVERY' [ - dresolve_tac ctxt (map (fn thm => Drule.rotate_prems ~1 thm OF @{thms imageI}) ( - flat (the (#set_subshape_imagess (#inner raw))) + dresolve_tac ctxt (map (Drule.rotate_prems ~1) ( + flat (#set_subshape_permutess (the (#fp_thms fp_res))) )), K (prefer_tac (2 * nvars + 1)), dresolve_tac ctxt prems, @@ -684,11 +693,12 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga val mrbnf_setss = map2 (fn deads => MRBNF_Def.mk_sets_of_mrbnf (replicate total_vars deads) (replicate total_vars (plives @ replicate_rec (map #T (#quotient_fps fp_res)))) - (replicate total_vars bounds) (replicate total_vars frees) + (replicate total_vars bounds) (replicate total_vars (frees @ bfrees)) ) deadss mrbnfs; - val ((pre_psetss, bsetss), rec_setss) = drop nvars (transpose mrbnf_setss) + val (((pre_psetss, bsetss), bfree_setss), rec_setss) = drop nvars (transpose mrbnf_setss) |> chop npassive - ||>> apply2 transpose o chop nvars; + ||>> apfst transpose o chop nvars + ||>> apply2 transpose o chop (length (#bfree_vars fp_res)); val pset_simpss = if length (hd raw_psetss) = 0 then replicate m [] else @{map 8} (fn quot => fn mrbnf => fn x => fn rec_sets => @@ -770,7 +780,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga vvsubst_t $ (#ctor quot $ x), subst (#ctor quot) $ (MRBNF_Def.mk_map_comb_of_mrbnf deads (plive_fs @ replicate_rec (map (fn t => Term.list_comb (fst t, fs)) vvsubsts)) - (pbound_fs @ map HOLogic.id_const vars) free_fs mrbnf + (pbound_fs @ map HOLogic.id_const vars) (free_fs @ map (nth free_fs) (#bfree_vars fp_res)) mrbnf $ x ) ); @@ -784,47 +794,52 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id} @ prems), K (unfold_thms_tac ctxt @{thms id_o o_id}), K (unfold_thms_tac ctxt @{thms comp_def snd_conv prod.case}), - rtac ctxt @{thm mp[unfolded atomize_imp[symmetric]]}, - REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] @{thms if_P}, - assume_tac ctxt - ], - rtac ctxt refl, - REPEAT_DETERM o resolve_tac ctxt (conjI :: prems) + rtac ctxt refl ORELSE' EVERY' [ + rtac ctxt @{thm mp[unfolded atomize_imp[symmetric]]}, + REPEAT_DETERM o EVERY' [ + EqSubst.eqsubst_tac ctxt [0] @{thms if_P}, + assume_tac ctxt + ], + rtac ctxt refl, + REPEAT_DETERM o resolve_tac ctxt (conjI :: prems) + ] ]) end ) vvsubsts (#quotient_fps fp_res) bsetss mrbnfs xs deadss ress Uctors; - fun Int_empty_tac ctxt = EVERY' [ - rtac ctxt @{thm iffD2[OF disjoint_iff]}, - rtac ctxt allI, - rtac ctxt impI, - Goal.assume_rule_tac ctxt - ]; - - val vvsubst_rrenames = + val vvsubst_permutes = let val goals = @{map 3} (fn vvsubst => fn quot => fn t => HOLogic.mk_eq ( Term.list_comb (Term.subst_atomic_types (plives' ~~ plives) (fst vvsubst), var_fs @ map HOLogic.id_const (pfrees @ plives @ pbounds)) $ t, - Term.list_comb (#rename quot, var_fs) $ t + Term.list_comb (#permute quot, var_fs) $ t )) vvsubsts (#quotient_fps fp_res) ts; val goal = HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj goals); val goals = map (mk_Trueprop_eq o apply2 (fst o Term.dest_comb) o HOLogic.dest_eq) goals; val thm = Goal.prove_sorry lthy (names (var_fs @ ts)) fs'_prems goal (fn {context=ctxt, prems} => EVERY1 [ - rtac ctxt (Drule.rotate_prems nvars ( + the_default (K all_tac) (Option.map (fn fp_thms => DETERM o rtac ctxt (Drule.rotate_prems nvars ( infer_instantiate' ctxt (replicate (nvars + m) NONE @ map (SOME o Thm.cterm_of ctxt) ts) ( - #fresh_co_induct (#inner (hd (#quotient_fps fp_res))) + #fresh_induct fp_thms ) - )), + ))) (#fp_thms fp_res)), EVERY' (@{map 3} (fn vvsubst_cctor => fn quot => fn mrbnf => EVERY' [ + case #fp_thms fp_res of + SOME _ => K all_tac + | NONE => EVERY' [ + TRY o rtac ctxt conjI, + rtac ctxt (Drule.rotate_prems nvars ( + infer_instantiate' ctxt (replicate nvars NONE @ map (SOME o Thm.cterm_of ctxt) ts) ( + #fresh_cases (#inner quot) + ) + )), + hyp_subst_tac_thin true ctxt + ], rtac ctxt trans, rtac ctxt vvsubst_cctor, REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound} @ prems), - REPEAT_DETERM o Int_empty_tac ctxt, - assume_tac ctxt, + REPEAT_DETERM o assume_tac ctxt, rtac ctxt sym, rtac ctxt trans, - rtac ctxt (#rename_ctor (#inner quot)), + rtac ctxt (#permute_ctor quot), REPEAT_DETERM o resolve_tac ctxt prems, rtac ctxt sym, rtac ctxt (arg_cong OF [MRBNF_Def.map_cong_of_mrbnf mrbnf]), @@ -838,7 +853,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga rtac ctxt sym, etac ctxt @{thm id_onD[OF imsupp_id_on, rotated]}, rtac ctxt @{thm trans[OF Int_commute]}, - Int_empty_tac ctxt + assume_tac ctxt ] ] ]) vvsubst_cctors (#quotient_fps fp_res) mrbnfs), @@ -867,7 +882,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga HOLogic.mk_Trueprop (Term.list_comb ( MRBNF_Def.mk_rel_of_mrbnf deads (plives @ replicate_rec qTs) (plives' @ replicate_rec (map (Term.typ_subst_atomic substitution) qTs)) - bounds frees mrbnf, + bounds (frees @ bfrees) mrbnf, Rs @ replicate_rec (map (fn r => Term.list_comb (r, Rs)) (#preds info)) ) $ x $ x'), HOLogic.mk_Trueprop P @@ -890,18 +905,19 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga rtac ctxt (iffD2 OF [#inject quot]), REPEAT_DETERM o resolve_tac ctxt @{thms exI conjI[rotated]}, rtac ctxt refl, + K (Local_Defs.unfold0_tac ctxt @{thms Un_Diff}), REPEAT_DETERM o assume_tac ctxt ]) end ) (#quotient_fps fp_res) mrbnfs deadss ts ts' xs xs' (#preds info) (#elims info) ) rels_opt; fun apply_n thm n = fold (K (fn t => thm OF [t])) (0 upto n - 1); - val rel_rrenames_opt = Option.map (fn info => + val rel_permutes_opt = Option.map (fn info => let val goals = @{map 4} (fn rel => fn quot => fn t => fn t' => let val rel_t = Term.list_comb (rel, Rs); - val rename_t = Term.list_comb (#rename quot, fs'); + val rename_t = Term.list_comb (#permute quot, fs'); in HOLogic.mk_imp ( rel_t $ (rename_t $ t) $ (subst rename_t $ t'), rel_t $ t $ t' @@ -918,24 +934,24 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga etac ctxt plain_cases, EVERY' (map (fn f => EVERY' [ dtac ctxt (infer_instantiate' ctxt [NONE, NONE, SOME ( - Thm.cterm_of ctxt (Term.list_comb (f (#rename quot), map mk_inv fs')) + Thm.cterm_of ctxt (Term.list_comb (f (#permute quot), map mk_inv fs')) )] arg_cong), REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_asm_tac ctxt [0] [#rename_comp quot, @{thm inv_o_simp1}], + EqSubst.eqsubst_asm_tac ctxt [0] [#permute_comp quot, @{thm inv_o_simp1}], REPEAT_DETERM o resolve_tac ctxt (@{thms bij_id supp_id_bound bij_imp_bij_inv supp_inv_bound} @ prems) ] ]) [I, subst]), - K (unfold_thms_tac ctxt [#rename_id quot]), + K (unfold_thms_tac ctxt [#permute_id quot]), hyp_subst_tac ctxt, REPEAT_DETERM o rtac ctxt exI, REPEAT_DETERM o (rtac ctxt conjI THEN' rtac ctxt refl), REPEAT_DETERM o EVERY' [ rtac ctxt conjI, - rtac ctxt (#rename_ctor (#inner quot)), + rtac ctxt (#permute_ctor quot), REPEAT_DETERM o resolve_tac ctxt (@{thms bij_imp_bij_inv supp_inv_bound} @ prems) ], REPEAT_DETERM o resolve_tac ctxt @{thms conjI supp_id_bound bij_id id_on_id}, - K (unfold_thms_tac ctxt (map #rename_id0 (#quotient_fps fp_res) @ [MRBNF_Def.map_id_of_mrbnf mrbnf, MRBNF_Def.mr_rel_id_of_mrbnf mrbnf])), + K (unfold_thms_tac ctxt (map #permute_id0 (#quotient_fps fp_res) @ [MRBNF_Def.map_id_of_mrbnf mrbnf, MRBNF_Def.mr_rel_id_of_mrbnf mrbnf])), rtac ctxt (iffD2 OF [hd (MRBNF_Def.mr_rel_map_of_mrbnf mrbnf)]), REPEAT_DETERM o resolve_tac ctxt (@{thms bij_imp_bij_inv supp_inv_bound bij_id supp_id_bound} @ prems), K (unfold_thms_tac ctxt @{thms id_o o_id Grp_UNIV_id eq_OO}), @@ -957,10 +973,10 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga hyp_subst_tac ctxt, rtac ctxt disjI1, REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (@{thms inv_o_simp2} @ map #rename_comp (#quotient_fps fp_res)), + EqSubst.eqsubst_tac ctxt [0] (@{thms inv_o_simp2} @ map #permute_comp (#quotient_fps fp_res)), REPEAT_DETERM o resolve_tac ctxt (@{thms supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound} @ prems) ], - K (unfold_thms_tac ctxt (map #rename_id (#quotient_fps fp_res))), + K (unfold_thms_tac ctxt (map #permute_id (#quotient_fps fp_res))), assume_tac ctxt ] ] @@ -979,13 +995,13 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga etac ctxt thm, REPEAT_DETERM o resolve_tac ctxt prems, rtac ctxt thm, - EqSubst.eqsubst_tac ctxt [0] [#rename_comp quot], + EqSubst.eqsubst_tac ctxt [0] [#permute_comp quot], K (prefer_tac (4 * nvars + 1)), REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_tac ctxt [0] (@{thms inv_o_simp1} @ [#rename_comp quot]), + EqSubst.eqsubst_tac ctxt [0] (@{thms inv_o_simp1} @ [#permute_comp quot]), REPEAT_DETERM o resolve_tac ctxt (@{thms bij_imp_bij_inv supp_inv_bound bij_id supp_id_bound} @ prems) ], - K (unfold_thms_tac ctxt [#rename_id quot]), + K (unfold_thms_tac ctxt [#permute_id quot]), assume_tac ctxt, REPEAT_DETERM o resolve_tac ctxt (@{thms bij_imp_bij_inv supp_inv_bound bij_id supp_id_bound} @ prems) ]) end @@ -999,23 +1015,23 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga fold_rev mk_all (map dest_Free (t' :: fs')) ( fold_rev (curry HOLogic.mk_imp o HOLogic.dest_Trueprop) fs'_prems ( HOLogic.mk_imp ( - Term.list_comb (rel, Rs) $ (Term.list_comb (#rename quot, fs') $ t) $ t', + Term.list_comb (rel, Rs) $ (Term.list_comb (#permute quot, fs') $ t) $ t', foldr1 HOLogic.mk_conj (map2 (fn FVars => fn f => HOLogic.mk_eq (mk_image f $ (FVars $ t), subst FVars $ t') - ) (#FVars quot) fs') + ) (#FVarss quot) fs') ) ) ) ) (#preds info) (#quotient_fps fp_res) ts ts' )); val thm = Goal.prove_sorry lthy (names (Rs @ ts)) [] goal (fn {context=ctxt, ...} => EVERY1 [ - rtac ctxt (#fresh_co_induct (#inner (hd (#quotient_fps fp_res)))), + DETERM o rtac ctxt (#fresh_induct (the (#fp_thms fp_res))), REPEAT_DETERM o rtac ctxt @{thm emp_bound}, EVERY' (@{map 3} (fn mrbnf => fn quot => fn elim => EVERY' [ Subgoal.FOCUS_PREMS (fn {context=ctxt, prems, ...} => EVERY1 [ REPEAT_DETERM o resolve_tac ctxt [allI, impI], etac ctxt elim, - EqSubst.eqsubst_asm_tac ctxt [0] [#rename_ctor (#inner quot)], + EqSubst.eqsubst_asm_tac ctxt [0] [#permute_ctor quot], REPEAT_DETERM o assume_tac ctxt, dtac ctxt (iffD1 OF [#inject quot]), REPEAT_DETERM o eresolve_tac ctxt [exE, conjE], @@ -1026,7 +1042,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga ], K (unfold_thms_tac ctxt @{thms id_o o_id image_comp[unfolded comp_def]}), REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_asm_tac ctxt [0] (maps (fn quot => #rename_comp0 quot :: #FVars_renames quot) (#quotient_fps fp_res)), + EqSubst.eqsubst_asm_tac ctxt [0] (maps (fn quot => #permute_comp0 quot :: #FVars_permutes quot) (#quotient_fps fp_res)), REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms bij_id supp_id_bound}) ], K (unfold_thms_tac ctxt @{thms id_o o_id image_UN[symmetric] image_set_diff[OF bij_is_inj, symmetric] id_on_Un}), @@ -1048,6 +1064,30 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga assume_tac ctxt, resolve_tac ctxt (infinite_UNIV :: @{thms bij_id supp_id_bound bij_comp supp_comp_bound}) ], + TRY o EVERY' [ + rtac ctxt trans, + rtac ctxt @{thm id_on_image[symmetric]}, + assume_tac ctxt, + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms image_comp}), + rtac ctxt trans, + rtac ctxt @{thm image_set_diff[OF bij_is_inj]}, + rtac ctxt @{thm bij_comp}, + assume_tac ctxt, + assume_tac ctxt, + rtac ctxt @{thm arg_cong2[of _ _ _ _ minus, rotated]}, + rtac ctxt sym, + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf)), + REPEAT_DETERM o FIRST' [ + assume_tac ctxt, + resolve_tac ctxt (infinite_UNIV :: @{thms bij_id supp_id_bound bij_comp supp_comp_bound}) + ], + rtac ctxt sym, + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf)), + REPEAT_DETERM o FIRST' [ + assume_tac ctxt, + resolve_tac ctxt (infinite_UNIV :: @{thms bij_id supp_id_bound bij_comp supp_comp_bound}) + ] + ], REPEAT_DETERM o EVERY' [ TRY o EVERY' [ rtac ctxt trans, @@ -1087,21 +1127,13 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga ]) ctxt ]) mrbnfs (#quotient_fps fp_res) (the rel_plain_cases_opt)) ]); - in @{map 5} (fn rel => fn quot => fn t => fn t' => fn thm => map (fn FVars => - let val goal = Logic.mk_implies ( - HOLogic.mk_Trueprop (Term.list_comb (rel, Rs) $ t $ t'), - mk_Trueprop_eq (FVars $ t, subst FVars $ t') - ) in Goal.prove_sorry lthy (names (Rs @ [t, t'])) [] goal (fn {context=ctxt, ...} => EVERY1 [ - Method.insert_tac ctxt [thm], - REPEAT_DETERM o (dtac ctxt meta_spec ORELSE' etac ctxt allE), - REPEAT_DETERM o (etac ctxt impE THEN' resolve_tac ctxt @{thms bij_id supp_id_bound}), - K (unfold_thms_tac ctxt (@{thms image_id} @ [#rename_id quot])), - etac ctxt impE, - assume_tac ctxt, - REPEAT_DETERM o etac ctxt conjE, - assume_tac ctxt - ]) end - ) (#FVars quot)) (#preds info) (#quotient_fps fp_res) ts ts' (split_conj m thm) end + in map ( + apply_n spec (nvars + 1) + #> apply_n mp (2 * nvars + 1) + #> (fn thm => thm OF (flat (replicate nvars @{thms bij_id supp_id_bound}))) + #> Local_Defs.unfold0 lthy (@{thms image_id} @ map #permute_id (#quotient_fps fp_res)) + #> split_conj nvars + ) (split_conj (length mrbnfs) thm) end ) rels_opt; val set_mapss = @@ -1110,23 +1142,33 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga map2 (fn set => fn f => HOLogic.mk_eq ( subst set $ (Term.list_comb (fst vvsubst, fs) $ t), mk_image f $ (set $ t) - )) (#FVars quot @ map fst psets) fs + )) (#FVarss quot @ map fst psets) fs ) vvsubsts (#quotient_fps fp_res) ts psetss; val goal = HOLogic.mk_Trueprop ( foldr1 HOLogic.mk_conj (map (foldr1 HOLogic.mk_conj) goalss) ); val thm = Goal.prove_sorry lthy (names (fs @ ts)) f_prems goal (fn {context=ctxt, prems=f_prems} => EVERY1 [ - rtac ctxt (Drule.rotate_prems nvars ( + the_default (K all_tac) (Option.map (fn fp_thms => DETERM o rtac ctxt (Drule.rotate_prems nvars ( infer_instantiate' ctxt (replicate (nvars + m) NONE @ map (SOME o Thm.cterm_of ctxt) ts) ( - #fresh_co_induct (#inner (hd (#quotient_fps fp_res))) + #fresh_induct fp_thms ) - )), + ))) (#fp_thms fp_res)), EVERY' (@{map 4} (fn mrbnf => fn quot => fn vvsubst_cctor => fn set_simps => EVERY' [ + case #fp_thms fp_res of + SOME _ => K all_tac + | NONE => EVERY' [ + TRY o rtac ctxt conjI, + rtac ctxt (Drule.rotate_prems nvars ( + infer_instantiate' ctxt (replicate nvars NONE @ map (SOME o Thm.cterm_of ctxt) ts) ( + #fresh_cases (#inner quot) + ) + )), + hyp_subst_tac_thin true ctxt + ], REPEAT_DETERM o EVERY' [ EqSubst.eqsubst_tac ctxt [0] [vvsubst_cctor], REPEAT_DETERM o resolve_tac ctxt f_prems, - REPEAT_DETERM o Int_empty_tac ctxt, - assume_tac ctxt + REPEAT_DETERM1 o assume_tac ctxt ], Subgoal.FOCUS_PREMS (fn {context=ctxt, prems, ...} => REPEAT_DETERM (EVERY1 [ TRY o rtac ctxt conjI, @@ -1138,6 +1180,11 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga SELECT_GOAL (unfold_thms_tac ctxt @{thms image_comp[unfolded comp_def] image_id}), REPEAT_DETERM o rtac ctxt @{thm arg_cong2[of _ _ _ _ "(\)"]}, rtac ctxt refl, + TRY o EVERY' [ + rtac ctxt @{thm trans[OF Diff_image_not_in_imsupp]}, + resolve_tac ctxt prems, + rtac ctxt refl + ], REPEAT_DETERM o EVERY' [ TRY o EVERY' [ rtac ctxt @{thm trans[OF _ Diff_image_not_in_imsupp]}, @@ -1148,7 +1195,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga dresolve_tac ctxt prems, REPEAT_DETERM o etac ctxt conjE, assume_tac ctxt, - TRY o eresolve_tac ctxt prems + TRY o resolve_tac ctxt prems ] ])) ctxt ]) mrbnfs (#quotient_fps fp_res) vvsubst_cctors pset_simpss), @@ -1175,17 +1222,30 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga HOLogic.mk_eq (apply2 (fn x => x $ t) (HOLogic.dest_eq goal)) ) goals ts)); val thm = Goal.prove_sorry lthy (names (fs @ gs @ ts)) (f_prems @ g_prems) goal (fn {context=ctxt, prems} => EVERY1 [ - rtac ctxt (Drule.rotate_prems nvars (infer_instantiate' ctxt ( - replicate (nvars + m) NONE @ map (SOME o Thm.cterm_of ctxt) ts - ) (#fresh_co_induct (#inner (hd (#quotient_fps fp_res)))))), + the_default (K all_tac) (Option.map (fn fp_thms => DETERM o rtac ctxt (Drule.rotate_prems nvars ( + infer_instantiate' ctxt (replicate (nvars + m) NONE @ map (SOME o Thm.cterm_of ctxt) ts) ( + #fresh_induct fp_thms + ) + ))) (#fp_thms fp_res)), EVERY' (@{map 3} (fn quot => fn mrbnf => fn vvsubst_cctor => EVERY' [ + case #fp_thms fp_res of + SOME _ => K all_tac + | NONE => EVERY' [ + TRY o rtac ctxt conjI, + rtac ctxt (Drule.rotate_prems nvars ( + infer_instantiate' ctxt (replicate nvars NONE @ map (SOME o Thm.cterm_of ctxt) ts) ( + #fresh_cases (#inner quot) + ) + )), + hyp_subst_tac_thin true ctxt + ], rtac ctxt trans, rtac ctxt vvsubst_cctor, REPEAT_DETERM o resolve_tac ctxt (@{thms supp_comp_bound bij_comp} @ [infinite_UNIV] @ prems), REPEAT_DETERM o EVERY' [ rtac ctxt @{thm Int_subset_empty2[rotated]}, rtac ctxt @{thm imsupp_o}, - Int_empty_tac ctxt + assume_tac ctxt ], assume_tac ctxt, rtac ctxt sym, @@ -1195,7 +1255,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga REPEAT_DETERM o EVERY' [ rtac ctxt @{thm Int_subset_empty2[rotated]}, rtac ctxt @{thm Un_upper2}, - Int_empty_tac ctxt + assume_tac ctxt ], assume_tac ctxt, rtac ctxt trans, @@ -1207,7 +1267,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga K (unfold_thms_tac ctxt @{thms image_id}), rtac ctxt @{thm Int_subset_empty2[rotated]}, rtac ctxt @{thm Un_upper1}, - Int_empty_tac ctxt + assume_tac ctxt ], EqSubst.eqsubst_tac ctxt [0] [snd (#noclash quot)], REPEAT_DETERM o EVERY' [ @@ -1225,7 +1285,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga rtac ctxt @{thm trans[OF Int_commute]}, rtac ctxt @{thm Int_subset_empty2[rotated]}, rtac ctxt @{thm Un_upper2}, - Int_empty_tac ctxt + assume_tac ctxt ], K (unfold_thms_tac ctxt [Thm.symmetric (snd (#noclash quot))]), assume_tac ctxt, @@ -1262,18 +1322,32 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga HOLogic.mk_mem (a, set $ t), HOLogic.mk_eq (f $ a, g $ a) )) end - ) (#FVars quot @ map fst psets) fs gs) (HOLogic.mk_eq ( + ) (#FVarss quot @ map fst psets) fs gs) (HOLogic.mk_eq ( Term.list_comb (fst vvsubst, fs) $ t, Term.list_comb (fst vvsubst, gs) $ t )) )) (#quotient_fps fp_res) psetss vvsubsts ts; val goal = HOLogic.mk_Trueprop (foldr1 HOLogic.mk_conj goals); val thm = Goal.prove_sorry lthy (names (fs @ gs @ ts)) (f_prems @ g_prems) goal (fn {context=ctxt, prems=f_prems} => EVERY1 [ - rtac ctxt (Drule.rotate_prems nvars (infer_instantiate' ctxt ( - replicate nvars NONE @ map (SOME o Thm.cterm_of ctxt) ( + the_default (K all_tac) (Option.map (fn fp_thms => DETERM o rtac ctxt (Drule.rotate_prems nvars ( + infer_instantiate' ctxt (replicate nvars NONE @ map (SOME o Thm.cterm_of ctxt) ( map2 (fn t => Term.absfree (dest_Free t)) ts goals - )) (#fresh_co_induct (#inner (hd (#quotient_fps fp_res)))))), + )) ( + #fresh_induct fp_thms + ) + ))) (#fp_thms fp_res)), EVERY' (@{map 4} (fn quot => fn mrbnf => fn vvsubst_cctor => fn pset_intross => EVERY' [ + case #fp_thms fp_res of + SOME _ => K all_tac + | NONE => EVERY' [ + TRY o rtac ctxt conjI, + rtac ctxt (Drule.rotate_prems nvars ( + infer_instantiate' ctxt (replicate nvars NONE @ map (SOME o Thm.cterm_of ctxt) ts) ( + #fresh_cases (#inner quot) + ) + )), + hyp_subst_tac_thin true ctxt + ], REPEAT_DETERM o rtac ctxt impI, EVERY' (map (fn thm => EVERY' [ rtac ctxt trans, @@ -1282,7 +1356,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga REPEAT_DETERM o EVERY' [ rtac ctxt @{thm Int_subset_empty2[rotated]}, rtac ctxt thm, - Int_empty_tac ctxt + assume_tac ctxt ], assume_tac ctxt, rtac ctxt sym @@ -1296,21 +1370,39 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga eresolve_tac ctxt (flat (#FVars_intross quot @ pset_intross)) ], REPEAT_DETERM o rtac ctxt refl, + TRY o EVERY' [ + rtac ctxt @{thm case_split[of "_ \ _", rotated]}, + dtac ctxt @{thm DiffI}, + assume_tac ctxt, + K (prefer_tac 2), + dresolve_tac ctxt (map (fn thm => thm RS @{thm disjoint_iff[THEN iffD1]} RS spec RS mp) (take nvars (drop nrecs prems))), + SELECT_GOAL (Local_Defs.unfold0_tac ctxt @{thms Un_iff de_Morgan_disj}), + REPEAT_DETERM o etac ctxt conjE, + rtac ctxt trans, + etac ctxt @{thm not_in_imsupp_same}, + rtac ctxt sym, + etac ctxt @{thm not_in_imsupp_same}, + resolve_tac ctxt prems, + etac ctxt @{thm DiffE}, + eresolve_tac ctxt (flat (#FVars_intross quot)), + assume_tac ctxt + ], REPEAT_DETERM o EVERY' [ forward_tac ctxt prems, REPEAT_DETERM_N (nvars + npassive) o FIRST' [ - EVERY' [ + SELECT_GOAL (EVERY1 [ resolve_tac ctxt prems, eresolve_tac ctxt (flat (#FVars_intross quot @ pset_intross)), - assume_tac ctxt - ], + assume_tac ctxt, + IF_UNSOLVED o K no_tac + ]), EVERY' [ rtac ctxt @{thm case_split[of "_ \ _", rotated]}, resolve_tac ctxt prems, eresolve_tac ctxt (flat (#FVars_intross quot @ pset_intross)), assume_tac ctxt, assume_tac ctxt, - dresolve_tac ctxt (drop nrecs prems), + dresolve_tac ctxt (map (fn thm => thm RS @{thm disjoint_iff[THEN iffD1]} RS spec RS mp) (take nvars (drop nrecs prems))), SELECT_GOAL (unfold_thms_tac ctxt @{thms Un_iff de_Morgan_disj}), etac ctxt conjE, rtac ctxt trans, @@ -1333,7 +1425,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga val set_bdss = if length (hd raw_psetss) = 0 then replicate m [] else let - val bd = MRBNF_Def.mk_bd_of_mrbnf (hd deadss) bounds frees (hd mrbnfs); + val bd = MRBNF_Def.mk_bd_of_mrbnf (hd deadss) bounds (frees @ bfrees) (hd mrbnfs); val goals = map2 (fn t => foldr1 HOLogic.mk_conj o map (fn set => mk_ordLess (mk_card_of (fst set $ t)) bd )) ts psetss; @@ -1341,7 +1433,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga val thm = Goal.prove_sorry lthy (names ts) [] goal (fn {context=ctxt, ...} => EVERY1 [ rtac ctxt (infer_instantiate' ctxt (replicate nvars NONE @ map (SOME o Thm.cterm_of ctxt) ( map2 (fn t => Term.absfree (dest_Free t)) ts goals @ ts - )) (#fresh_co_induct (#inner (hd (#quotient_fps fp_res))))), + )) (#fresh_induct (the (#fp_thms fp_res)))), REPEAT_DETERM o rtac ctxt @{thm emp_bound}, EVERY' (map2 (fn mrbnf => fn pset_simps => Subgoal.FOCUS_PREMS (fn {context=ctxt, prems, ...} => REPEAT_DETERM (EVERY1 [ SELECT_GOAL (unfold_thms_tac ctxt pset_simps), @@ -1384,7 +1476,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga ) R's Rs Ss), fold_rev mk_exists (map dest_Free ([t'] @ fs' @ [x'])) ( foldr1 HOLogic.mk_conj (maps (fn f => [mk_bij f, mk_supp_bound f]) fs' @ [ - HOLogic.mk_eq (t, Term.list_comb (#rename quot, fs') $ x'), + HOLogic.mk_eq (t, Term.list_comb (#permute quot, fs') $ x'), Term.list_comb (rel, Rs) $ t $ t', Term.list_comb (subst' rel, Ss) $ t' $ t'' ]) @@ -1407,14 +1499,14 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga Subgoal.FOCUS_PARAMS (fn {context=ctxt, params, ...} => let val fs = map (mk_inv o Thm.term_of o snd) (take nvars params); - val rename_t = Term.list_comb (#rename quot, fs); + val rename_t = Term.list_comb (#permute quot, fs); in dtac ctxt (infer_instantiate' ctxt [NONE, NONE, SOME (Thm.cterm_of ctxt rename_t)] arg_cong) 1 end ) ctxt, REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_asm_tac ctxt [0] [#rename_comp quot, @{thm inv_o_simp1}, #rename_ctor (#inner quot)], + EqSubst.eqsubst_asm_tac ctxt [0] [#permute_comp quot, @{thm inv_o_simp1}, #permute_ctor quot], REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms bij_imp_bij_inv supp_inv_bound}) ], - K (unfold_thms_tac ctxt [#rename_id quot]), + K (unfold_thms_tac ctxt [#permute_id quot]), hyp_subst_tac ctxt, dtac ctxt (iffD1 OF [#inject quot]), REPEAT_DETERM o eresolve_tac ctxt [conjE, exE], @@ -1432,12 +1524,12 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga rtac ctxt conjI, REPEAT_DETERM o (TRY o rtac ctxt conjI THEN' rtac ctxt refl), rtac ctxt conjI, - EqSubst.eqsubst_tac ctxt [0] [#rename_ctor (#inner quot) RS sym], + EqSubst.eqsubst_tac ctxt [0] [#permute_ctor quot RS sym], REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms bij_imp_bij_inv supp_inv_bound}), rtac ctxt trans, - rtac ctxt (#rename_comp quot), + rtac ctxt (#permute_comp quot), REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms bij_imp_bij_inv supp_inv_bound}), - rtac ctxt (#rename_cong_id (#inner quot)), + rtac ctxt (#permute_cong_id (#inner quot)), REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt (infinite_UNIV :: @{thms bij_comp supp_comp_bound bij_imp_bij_inv supp_inv_bound})), REPEAT_DETERM o EVERY' [ EqSubst.eqsubst_tac ctxt [0] @{thms inv_o_simp2}, @@ -1464,16 +1556,27 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga REPEAT_DETERM o rtac ctxt @{thm conjI[rotated]}, assume_tac ctxt, assume_tac ctxt ORELSE' EVERY' [ - resolve_tac ctxt (map (fn thm => iffD2 OF [thm]) (the rel_rrenames_opt)), + resolve_tac ctxt (map (fn thm => iffD2 OF [thm]) (the rel_permutes_opt)), REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms bij_id supp_id_bound}) ], - resolve_tac ctxt (refl :: map (fn quot => #rename_id quot RS sym) (#quotient_fps fp_res)), + resolve_tac ctxt (refl :: map (fn quot => #permute_id quot RS sym) (#quotient_fps fp_res)), REPEAT_DETERM o (assume_tac ctxt ORELSE' resolve_tac ctxt @{thms bij_id supp_id_bound}) ], REPEAT_DETERM o EVERY' [ etac ctxt @{thm id_on_antimono}, rtac ctxt @{thm equalityD1}, REPEAT_DETERM o rtac ctxt @{thm arg_cong2[of _ _ _ _ "(\)"]}, + TRY o EVERY' [ + rtac ctxt sym, + rtac ctxt trans, + rtac ctxt @{thm arg_cong2[of _ _ _ _ minus, rotated]}, + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf)), + REPEAT_DETERM1 o resolve_tac ctxt @{thms supp_id_bound bij_id}, + eresolve_tac ctxt (map (Drule.rotate_prems ~1) (MRBNF_Def.mr_rel_set_of_mrbnf mrbnf)), + REPEAT_DETERM1 o resolve_tac ctxt @{thms supp_id_bound bij_id}, + K (Local_Defs.unfold0_tac ctxt @{thms image_id}), + rtac ctxt refl + ], REPEAT_DETERM o EVERY' [ rtac ctxt @{thm arg_cong2[of _ _ _ _ minus, rotated]}, rtac ctxt trans, @@ -1508,7 +1611,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga etac ctxt mp, REPEAT_DETERM o resolve_tac ctxt ( @{thms conjI refl exI bij_id supp_id_bound} - @ map (fn quot => #rename_id quot RS sym) (#quotient_fps fp_res) + @ map (fn quot => #permute_id quot RS sym) (#quotient_fps fp_res) ), assume_tac ctxt, assume_tac ctxt @@ -1555,11 +1658,11 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga ))) ))) goals ts ts' @ ts - )) (the (#fresh_induct_param_no_clash (#inner (hd (#quotient_fps fp_res))))); + )) (#fresh_induct_param (the (#fp_thms fp_res))); val induct = Drule.rotate_prems ~3 (apply_n conj_spec (nvars + 1) (induct RS bspec) RS conj_mp); val in_rel1 = Goal.prove_sorry lthy (names (Rs @ free_fs @ pbound_fs @ ts @ ts')) f_prems goal (fn {context=ctxt, prems=f_prems} => EVERY1 [ - rtac ctxt induct, + DETERM o rtac ctxt induct, K (rtac ctxt refl 2), K (rtac ctxt refl 2), K (unfold_thms_tac ctxt @{thms prod.case mem_Collect_eq fst_conv snd_conv}), @@ -1580,8 +1683,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga rtac ctxt impI, EqSubst.eqsubst_asm_tac ctxt [0] [vvsubst_cctor], REPEAT_DETERM o (resolve_tac ctxt f_prems ORELSE' assume_tac ctxt), - REPEAT_DETERM o Int_empty_tac ctxt, - assume_tac ctxt, + REPEAT_DETERM o assume_tac ctxt, eresolve_tac ctxt (the rel_plain_cases_opt), dtac ctxt (iffD1 OF [#inject quot]), REPEAT_DETERM o eresolve_tac ctxt [exE, conjE], @@ -1601,12 +1703,12 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga K (unfold_thms_tac ctxt (@{thms image_UN[symmetric]} @ [MRBNF_Def.mr_rel_id_of_mrbnf mrbnf])), dtac ctxt (Drule.rotate_prems ~1 (iffD1 OF [hd (MRBNF_Def.mr_rel_map_of_mrbnf mrbnf)])), REPEAT_DETERM o FIRST' [ - resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems), + resolve_tac ctxt (infinite_UNIV :: @{thms supp_id_bound bij_id supp_comp_bound} @ f_prems), assume_tac ctxt ], K (unfold_thms_tac ctxt @{thms id_o o_id Grp_UNIV_id eq_OO}), REPEAT_DETERM o EVERY' [ - EqSubst.eqsubst_asm_tac ctxt [0] (map (fn thm => thm RS sym) (vvsubst_rrenames @ vvsubst_comp0s)), + EqSubst.eqsubst_asm_tac ctxt [0] (map (fn thm => thm RS sym) (vvsubst_permutes @ vvsubst_comp0s)), REPEAT_DETERM o FIRST' [ resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems), assume_tac ctxt @@ -1648,10 +1750,10 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga assume_tac ctxt ] ]) (0 upto nrecs - 1)), - REPEAT_DETERM o (resolve_tac ctxt f_prems ORELSE' assume_tac ctxt), + REPEAT_DETERM o (resolve_tac ctxt (infinite_UNIV :: @{thms supp_comp_bound} @ f_prems) ORELSE' assume_tac ctxt), REPEAT_DETERM_N nrecs o etac ctxt @{thm thin_rl}, dtac ctxt (Drule.rotate_prems ~1 (iffD1 OF [MRBNF_Def.mr_in_rel_of_mrbnf mrbnf])), - REPEAT_DETERM o (resolve_tac ctxt f_prems ORELSE' assume_tac ctxt), + REPEAT_DETERM o (resolve_tac ctxt (infinite_UNIV :: @{thms supp_comp_bound} @ f_prems) ORELSE' assume_tac ctxt), REPEAT_DETERM o eresolve_tac ctxt [exE, conjE], hyp_subst_tac ctxt, REPEAT_DETERM o EVERY' [ @@ -1669,15 +1771,16 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga val (T_n, (Ts, _)) = apsnd (chop (total_vars - nrecs)) (dest_Type pre_T); val pre_T = Type (T_n, Ts @ replicate_rec (map fastype_of zs)); val ctor = Const (n, pre_T --> T); + (* TODO: fix for multiple bounds *) val recs = map2 (fn i => fn pick => Term.list_comb (fst pick, Rs @ @{map 3} (fn rel => fn f => fn g => - if member (op=) rel i then + if member (op=) (hd rel) i then HOLogic.mk_comp (g, f) else f ) (#binding_relation fp_res) fs' gs @ pfree_fs @ pbound_fs)) (0 upto nrecs - 1) (replicate_rec (the picks_opt)); in ctor $ (MRBNF_Def.mk_map_comb_of_mrbnf deads (map2 (curry (HOLogic.id_const o HOLogic.mk_prodT)) plives plives' @ recs) - (map HOLogic.id_const bounds) (map HOLogic.id_const frees) mrbnf + (map HOLogic.id_const bounds) (map HOLogic.id_const (frees @ bfrees)) mrbnf $ z ) end ))] exI) 1 @@ -1736,7 +1839,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga EqSubst.eqsubst_tac ctxt [0] (MRBNF_Def.set_map_of_mrbnf mrbnf), REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id}, K (unfold_thms_tac ctxt @{thms image_id}), - Int_empty_tac ctxt + assume_tac ctxt ], assume_tac ctxt, EqSubst.eqsubst_tac ctxt [0] [MRBNF_Def.map_comp_of_mrbnf mrbnf], @@ -1760,6 +1863,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga K (unfold_thms_tac ctxt @{thms image_id}), etac ctxt @{thm id_on_antimono}, REPEAT_DETERM o rtac ctxt @{thm Un_mono}, + TRY o rtac ctxt @{thm subset_refl}, REPEAT_DETERM o EVERY' [ rtac ctxt @{thm Diff_mono[OF _ subset_refl]}, SELECT_GOAL (unfold_thms_tac ctxt @{thms image_comp comp_def}), @@ -1796,7 +1900,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga SELECT_GOAL (unfold_thms_tac ctxt @{thms id_o o_id comp_assoc[symmetric]}), REPEAT_DETERM o EVERY' [ EqSubst.eqsubst_tac ctxt [0] (map (fn thm => thm RS sym) ( - vvsubst_rrenames @ vvsubst_comp0s + vvsubst_permutes @ vvsubst_comp0s )), REPEAT_DETERM o FIRST' [ resolve_tac ctxt (@{thms supp_id_bound bij_id} @ f_prems), @@ -1805,7 +1909,10 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga ], K (unfold_thms_tac ctxt @{thms id_o o_id}), rtac ctxt (MRBNF_Def.map_cong0_of_mrbnf mrbnf), - REPEAT_DETERM o (resolve_tac ctxt (refl :: f_prems) ORELSE' assume_tac ctxt), + REPEAT_DETERM o FIRST' [ + resolve_tac ctxt (refl :: infinite_UNIV :: @{thms supp_comp_bound} @ f_prems), + assume_tac ctxt + ], REPEAT_DETERM o EVERY' [ rtac ctxt @{thm trans[OF comp_apply]}, rotate_tac ~1, @@ -1856,7 +1963,6 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga ] ]) (#quotient_fps fp_res) mrbnfs vvsubst_cctors deadss pset_simpss) ]); - val lthy = Config.put Goal.quick_and_dirty false lthy; val goals' = @{map 4} (fn psets => fn vvsubst => fn rel => fn z => HOLogic.mk_imp ( foldr1 HOLogic.mk_conj (@{map 5} (fn set => fn R => fn T => fn x => fn y => @@ -1876,7 +1982,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga val induct = infer_instantiate' lthy (map (SOME o Thm.cterm_of lthy) ( map mk_imsupp fs' @ map2 (fn z => Term.absfree (dest_Free z)) zs goals' @ zs - )) (#fresh_co_induct (#inner (hd (#quotient_fps fp_res)))); + )) (#fresh_induct (the (#fp_thms fp_res))); val in_rel2 = Goal.prove_sorry lthy (names (Rs @ free_fs @ pbound_fs @ zs)) f_prems goal (fn {context=ctxt, prems=f_prems} => EVERY1 [ rtac ctxt induct, @@ -1885,8 +1991,10 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga let val map_comp_split = MRBNF_Def.map_comp_of_mrbnf mrbnf OF ( f_prems @ flat (replicate (MRBNF_Def.bound_of_mrbnf mrbnf) @{thms bij_id supp_id_bound}) + @ map (nth f_prems) (#bfree_vars fp_res) @ replicate (length frees) @{thm supp_id_bound} @ flat (replicate (MRBNF_Def.bound_of_mrbnf mrbnf) @{thms bij_id supp_id_bound}) + @ replicate (length bfrees) @{thm supp_id_bound} ); val map_comp_split = infer_instantiate' ctxt ( replicate (length plives + nrecs) NONE @ map (SOME o Thm.cterm_of ctxt) ( @@ -1899,12 +2007,11 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga REPEAT_DETERM o EVERY' [ EqSubst.eqsubst_tac ctxt [0] [vvsubst_cctor], REPEAT_DETERM o resolve_tac ctxt f_prems, - REPEAT_DETERM o Int_empty_tac ctxt, - assume_tac ctxt + REPEAT_DETERM o assume_tac ctxt ], rtac ctxt rel_intro, REPEAT_DETERM o resolve_tac ctxt @{thms bij_id supp_id_bound id_on_id}, - K (unfold_thms_tac ctxt (map #rename_id0 (#quotient_fps fp_res) @ [MRBNF_Def.map_id_of_mrbnf mrbnf])), + K (unfold_thms_tac ctxt (map #permute_id0 (#quotient_fps fp_res) @ [MRBNF_Def.map_id_of_mrbnf mrbnf])), EqSubst.eqsubst_tac ctxt [0] [map_comp_split], EqSubst.eqsubst_tac ctxt [2] [map_comp_split], rotate_tac ~1, @@ -1945,7 +2052,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga in apply2 (map (fn thm => thm RS mp) o split_conj m) (in_rel1, in_rel2) end ) rels_opt; - val vvsubst_id0s = @{map 3} (fn vvsubst => fn quot => fn vvsubst_rrename => + val vvsubst_id0s = @{map 3} (fn vvsubst => fn quot => fn vvsubst_permute => let val goal = mk_Trueprop_eq (Term.list_comb ( Term.subst_atomic_types (plives' ~~ plives) (fst vvsubst), @@ -1953,13 +2060,13 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga ), HOLogic.id_const (#T quot)); in Goal.prove_sorry lthy [] [] goal (fn {context=ctxt, ...} => EVERY1 [ rtac ctxt trans, - rtac ctxt vvsubst_rrename, + rtac ctxt vvsubst_permute, REPEAT_DETERM o resolve_tac ctxt @{thms supp_id_bound bij_id}, - rtac ctxt (#rename_id0 quot) + rtac ctxt (#permute_id0 quot) ]) end - ) vvsubsts (#quotient_fps fp_res) vvsubst_rrenames; + ) vvsubsts (#quotient_fps fp_res) vvsubst_permutes; - val tacss = @{map 8} (fn vvsubst_rrename => fn quot => fn vvsubst_comp0 => fn vvsubst_cong => + val tacss = @{map 8} (fn vvsubst_permute => fn quot => fn vvsubst_comp0 => fn vvsubst_cong => fn set_maps => fn set_bds => fn mrbnf => fn vvsubst_id0 => { map_id0 = fn ctxt => rtac ctxt vvsubst_id0 1, map_comp0 = fn ctxt => EVERY1 [ @@ -2009,14 +2116,14 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga @{thms UnE UN_E} @ MRBNF_Def.wit_thms_of_mrbnf mrbnf ) ] - }) vvsubst_rrenames (#quotient_fps fp_res) vvsubst_comp0s vvsubst_congs set_mapss set_bdss mrbnfs vvsubst_id0s; + }) vvsubst_permutes (#quotient_fps fp_res) vvsubst_comp0s vvsubst_congs set_mapss set_bdss mrbnfs vvsubst_id0s; val witss = @{map 3} (fn mrbnf => fn quot => fn deads => let val nwits = nwits_of_mrbnf mrbnf; in map (fn (_, t) => #ctor quot $ t) ( mk_wits_of_mrbnf (replicate nwits deads) (replicate nwits (plives @ replicate_rec (map #T (#quotient_fps fp_res)))) - (replicate nwits bounds) (replicate nwits frees) mrbnf + (replicate nwits bounds) (replicate nwits (frees @ bfrees)) mrbnf ) end ) mrbnfs (#quotient_fps fp_res) deadss; @@ -2034,7 +2141,7 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga val ((pfree_sets, plive_sets), pbound_sets) = map fst psets |> chop (length pfrees) ||>> chop (length plives); - val sets = map (pair MRBNF_Def.Free_Var) (#FVars quot @ pfree_sets) + val sets = map (pair MRBNF_Def.Free_Var) (#FVarss quot @ pfree_sets) @ map (pair MRBNF_Def.Live_Var) plive_sets @ map (pair MRBNF_Def.Bound_Var) pbound_sets; val b = Binding.name (short_type_name (fst (dest_Type (#T quot)))); @@ -2042,27 +2149,27 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga class_thms Binding.empty Binding.empty Binding.empty [] (((((((b, #T quot), fst vvsubst), sets), bd_of_mrbnf mrbnf), wits), rel_opt), NONE) end - ) (0 upto m - 1) vvsubsts (#quotient_fps fp_res) psetss mrbnfs deadss tacss witss (Config.put Goal.quick_and_dirty false lthy); + ) (0 upto m - 1) vvsubsts (#quotient_fps fp_res) psetss mrbnfs deadss tacss witss lthy; val lthy = fold (fn (mrbnf, quot) => MRBNF_Def.register_mrbnf_raw (fst (dest_Type (#T quot))) mrbnf) (xs ~~ #quotient_fps fp_res) lthy; - val (notess, lthy) = @{fold_map 4} (fn quot => fn vvsubst_cctor => fn vvsubst_rrename => fn pset_simps => fn lthy => + val (notess, lthy) = @{fold_map 4} (fn quot => fn vvsubst_cctor => fn vvsubst_permute => fn pset_simps => fn lthy => let val vname = short_type_name (fst (dest_Type (#T quot))); val notes = [(vname ^ "_cctor", [vvsubst_cctor]), - (vname ^ "_vvsubst_rrename", [vvsubst_rrename]), + (vname ^ "_vvsubst_permute", [vvsubst_permute]), (vname ^ "_set_simps", pset_simps) ] |> (map (fn (thmN, thms) => ((Binding.name thmN, []), [(thms, [])]) )); in Local_Theory.notes notes lthy end - ) (#quotient_fps fp_res) vvsubst_cctors vvsubst_rrenames pset_simpss lthy; + ) (#quotient_fps fp_res) vvsubst_cctors vvsubst_permutes pset_simpss lthy; val ress = map2 (fn t1 => fn t2 => { vvsubst_ctor = t1, - vvsubst_rrename = t2 - }) vvsubst_cctors vvsubst_rrenames; + vvsubst_permute = t2 + }) vvsubst_cctors vvsubst_permutes; in ((xs ~~ ress), lthy) end; diff --git a/Tools/parser.ML b/Tools/parser.ML index af05552c..1fe4647a 100644 --- a/Tools/parser.ML +++ b/Tools/parser.ML @@ -64,9 +64,9 @@ fun create_ctor_spec T_names ((((sel, name), xs), mixfix), binds) (lthy, params) val names = maps (find_names o YXML.content_of o snd o snd) xs; fun mk_typedecl name = Typedecl.basic_typedecl {final = true} (Binding.name name, 0, NoSyn) - val (fake_names, lthy) = fold_map mk_typedecl names lthy; + val (fake_names, names_lthy) = fold_map mk_typedecl names lthy; - val (sels, Ts) = split_list (map (apsnd (Syntax.read_typ lthy) o snd) xs); + val (sels, Ts) = split_list (map (apsnd (Syntax.read_typ names_lthy) o snd) xs); fun fold_map_typ f (Type (n, Ts)) x = let val (Ts', x') = fold_map (fold_map_typ f) Ts x @@ -94,6 +94,7 @@ fun create_ctor_spec T_names ((((sel, name), xs), mixfix), binds) (lthy, params) |> Symtab.map_entry "free" (cons T) |> Symtab.map_entry "pfree" rm |> Symtab.map_entry "plive" rm + |> Symtab.map_entry "bfree" rm , lthy)) end | n => (nth (the (Symtab.lookup params "bound")) n, acc) else (orig_T, acc) @@ -109,7 +110,14 @@ fun create_ctor_spec T_names ((((sel, name), xs), mixfix), binds) (lthy, params) let val (T', lthy) = apfst hd (BNF_Util.mk_TFrees 1 lthy); in (T', (Symtab.map_entry "brec" (cons T') params, lthy)) end | x::_ => (x, acc)) - | _ => error "can only bind in recursive subterms" + | _ => (if Term.is_TFree T then (case find_index (curry (op=) T) (the (Symtab.lookup params "bfree_var")) of + ~1 => let val (T', lthy) = apfst hd (BNF_Util.mk_TFrees 1 lthy); + in (T', (params + |> Symtab.map_entry "bfree_var" (cons T) + |> Symtab.map_entry "bfree" (cons T') + , lthy)) end + | n => (nth (the (Symtab.lookup params "bfree")) n, (params, lthy)) + ) else error "can only bind in recursive subterms or type variables") else (T, acc) end | _ => (T, acc) @@ -137,7 +145,7 @@ fun create_binder_spec T_names ((((params, b), mixfix), ctors), (vvsubst_b, tvsu in resort_tfree_or_tvar @{sort type} (TFree (s, Typedecl.read_constraint lthy sort)) end; (* This should be just a record, but the lack of record update syntax in ML makes that way too painful *) - val params' = Symtab.make [("pfree", []), ("pbound", []), ("plive", []), ("dead", []), ("free", []), ("bound", []), ("rec", []), ("brec", [])]; + val params' = Symtab.make [("pfree", []), ("pbound", []), ("plive", []), ("dead", []), ("free", []), ("bound", []), ("bfree", []), ("bfree_var", []), ("rec", []), ("brec", [])]; val Ts = map (map_prod I prepare_type_arg) params; val lthy = fold (Variable.declare_typ o snd) Ts lthy; @@ -152,12 +160,14 @@ fun create_binder_spec T_names ((((params, b), mixfix), ctors), (vvsubst_b, tvsu val brecs = flat "brec" MRBNF_Def.Live_Var val recs = flat "rec" MRBNF_Def.Live_Var val bounds = flat "bound" MRBNF_Def.Bound_Var; + val bfrees = flat "bfree" MRBNF_Def.Free_Var; + val frees = flat "free" MRBNF_Def.Free_Var; val vars = - flat "free" MRBNF_Def.Free_Var + frees @ flat "pfree" MRBNF_Def.Free_Var @ flat "plive" MRBNF_Def.Live_Var @ flat "pbound" MRBNF_Def.Bound_Var - @ bounds @ brecs @ recs; + @ bounds @ bfrees @ brecs @ recs; fun with_def bnd def = if Binding.is_empty bnd then Binding.suffix_name ("_" ^ Binding.name_of b) def @@ -167,7 +177,12 @@ fun create_binder_spec T_names ((((params, b), mixfix), ctors), (vvsubst_b, tvsu fp_b = b, ctors = ctors, vars = vars, - binding_rel = map (K (0 upto length brecs - 1)) bounds, + binding_rel = map (fn T => + let + val i = find_index (curry (op=) (TFree (fst T))) (rev (the (Symtab.lookup params "bfree_var"))); + val bfree = if i = ~1 then [] else [find_index (curry (op=) T) frees] + in (bfree, (0 upto length brecs - 1)) end + ) frees, rec_vars = length brecs + length recs, map_b = with_def vvsubst_b @{binding vvsubst}, tvsubst_b = with_def tvsubst_b @{binding tvsubst} diff --git a/operations/BMV_Composition.thy b/operations/BMV_Composition.thy new file mode 100644 index 00000000..cc619f93 --- /dev/null +++ b/operations/BMV_Composition.thy @@ -0,0 +1,15 @@ +theory BMV_Composition + imports "Binders.MRBNF_Recursor" +begin + +binder_datatype 'a type = Var 'a | App "'a type" "'a type list" | Forall x::'a t::"'a type" binds x in t + +abbreviation "bd_type \ natLeq" + +abbreviation "sb_type \ tvsubst_type" + + +(* Comp *) +type_synonym 'a T = "'a + 'a type" + +end \ No newline at end of file diff --git a/operations/Binder_Inductive.thy b/operations/Binder_Inductive.thy index 1e95c9a0..11b55249 100644 --- a/operations/Binder_Inductive.thy +++ b/operations/Binder_Inductive.thy @@ -14,7 +14,7 @@ print_theorems lemma perm_id0s: "rrename id = id" "rrename id = id" - by (rule term.rrename_id0s)+ + by (rule term.permute_id0)+ lemma perm_comps: fixes \ :: "var \ var" @@ -22,7 +22,7 @@ lemma perm_comps: shows "rrename \ (rrename \' x1) = rrename (\ \ \') x1" "rrename \ (rrename \' x2) = rrename (\ \ \') x2" - by (rule term.rrename_comps assms)+ + by (rule term.permute_comp assms)+ lemma perm_supports: fixes \ :: "var \ var" @@ -30,7 +30,7 @@ lemma perm_supports: shows "(\a. a \ FFVars x1 \ \ a = a) \ rrename \ x1 = x1" "(\a. a \ FFVars x2 \ \ a = a) \ rrename \ x2 = x2" - by (rule term.rrename_cong_ids[OF assms], assumption)+ + by (rule term.permute_cong_id[OF assms], assumption)+ lemma supp_smalls: fixes x1 x2::"trm" @@ -45,7 +45,7 @@ lemma supp_seminat: shows "FFVars (rrename \ x1) \ \ ` FFVars x1" "FFVars (rrename \ x2) \ \ ` FFVars x2" - using term.FFVars_rrenames assms by blast+ + using term.FVars_permute assms by blast+ text \This is automatically derived from @{thm step_def} and the binder annotations\ thm step_def @@ -60,7 +60,7 @@ lemma G_equiv: shows "G R B x1 x2 \ G (\x1 x2. R (rrename (inv \) x1) (rrename (inv \) x2)) (\ ` B) (rrename \ x1) (rrename \ x2)" using assms apply - unfolding G_def - by (elim disj_forward) (auto simp: term.rrename_comps rrename_tvsubst_comp) + by (elim disj_forward) (auto simp: term.permute_comp rrename_tvsubst_comp) abbreviation "supp_T x1 x2 \ FFVars x1 \ FFVars x2" diff --git a/operations/Fixpoint.thy b/operations/Composition.thy similarity index 87% rename from operations/Fixpoint.thy rename to operations/Composition.thy index 9bd61623..0c3da647 100644 --- a/operations/Fixpoint.thy +++ b/operations/Composition.thy @@ -1,7 +1,9 @@ -theory Fixpoint - imports "Binders.MRBNF_FP" +theory Composition + imports "Binders.MRBNF_Composition" begin +declare [[mrbnf_internals]] + (* TODO: Show proofs as apply script *) ML \ val ctor_T1_Ts = [ @@ -9,6 +11,7 @@ val ctor_T1_Ts = [ [@{typ unit}], [@{typ 'tyvar}], [@{typ 'rec}, @{typ 'rec2}], + [@{typ 'bvar}, @{typ "('bfree \ unit) list"}], [@{typ 'bvar}, @{typ 'brec}], [@{typ 'btyvar}, @{typ 'brec}], [@{typ 'a}] @@ -38,7 +41,7 @@ declare [[mrbnf_internals]] local_setup \fn lthy => let val Xs = map dest_TFree [@{typ 'a}, @{typ 'b}] - val resBs = map dest_TFree [@{typ 'var}, @{typ 'tyvar}, @{typ 'bvar}, @{typ 'btyvar}, @{typ 'rec}, @{typ 'brec}, @{typ 'rec2}, @{typ 'brec2}] + val resBs = map dest_TFree [@{typ 'var}, @{typ 'tyvar}, @{typ 'bvar}, @{typ 'btyvar}, @{typ 'bfree}, @{typ 'rec}, @{typ 'brec}, @{typ 'rec2}, @{typ 'brec2}] fun flatten_tyargs Ass = subtract (op =) Xs (filter (fn T => exists (fn Ts => member (op =) Ts T) Ass) resBs) @ Xs; val qualify1 = Binding.prefix_name (name1 ^ "_pre_") @@ -49,14 +52,14 @@ let val ((mrbnf1, tys1), (accum, lthy)) = MRBNF_Comp.mrbnf_of_typ true MRBNF_Def.Smart_Inline qualify1 flatten_tyargs Xs [] [(dest_TFree @{typ 'var}, MRBNF_Def.Free_Var), (dest_TFree @{typ 'bvar}, MRBNF_Def.Bound_Var), (dest_TFree @{typ 'tyvar}, MRBNF_Def.Free_Var), (dest_TFree @{typ 'btyvar}, MRBNF_Def.Bound_Var), - (dest_TFree @{typ 'a}, MRBNF_Def.Free_Var) + (dest_TFree @{typ 'a}, MRBNF_Def.Free_Var), (dest_TFree @{typ 'bfree}, MRBNF_Def.Free_Var) ] T1 (accum, lthy) val _ = @{print} "comp1" val ((mrbnf2, tys2), (accum, lthy)) = MRBNF_Comp.mrbnf_of_typ true MRBNF_Def.Smart_Inline qualify2 flatten_tyargs Xs [] [(dest_TFree @{typ 'var}, MRBNF_Def.Free_Var), (dest_TFree @{typ 'bvar}, MRBNF_Def.Bound_Var), (dest_TFree @{typ 'tyvar}, MRBNF_Def.Free_Var), (dest_TFree @{typ 'btyvar}, MRBNF_Def.Bound_Var), - (dest_TFree @{typ 'a}, MRBNF_Def.Free_Var) + (dest_TFree @{typ 'a}, MRBNF_Def.Free_Var), (dest_TFree @{typ 'bfree}, MRBNF_Def.Free_Var) ] T2 (accum, lthy); val _ = @{print} "comp2" @@ -78,19 +81,13 @@ let val (bnf1, lthy) = MRBNF_Def.register_mrbnf_as_bnf mrbnf1 lthy val (bnf2, lthy) = MRBNF_Def.register_mrbnf_as_bnf mrbnf2 lthy val _ = @{print} "register" - - (* Step 4: Create fixpoint of pre-MRBNF *) - val (res, lthy) = MRBNF_FP.construct_binder_fp MRBNF_Util.Least_FP [ - ((name1, mrbnf1), 2), ((name2, mrbnf2), 2) - ] rel lthy; - val _ = @{print} "fixpoint" in lthy end \ print_theorems +print_mrbnfs declare [[quick_and_dirty=false]] -thm noclash_T1_def lemmas infinite_UNIV = cinfinite_imp_infinite[OF T1_pre.UNIV_cinfinite] end \ No newline at end of file diff --git a/operations/Greatest_Fixpoint.thy b/operations/Greatest_Fixpoint.thy new file mode 100644 index 00000000..20aef0fa --- /dev/null +++ b/operations/Greatest_Fixpoint.thy @@ -0,0 +1,2446 @@ +theory Greatest_Fixpoint + imports "Binders.MRBNF_Composition" "Binders.MRBNF_FP" +begin + +declare [[mrbnf_internals]] + +(* +binder_codatatype 'a term = +Var 'a +| App "'a term" "'a term" +| Lam2 x::'a t::"'a term" x2::'a t2::"'a term" binds x in t, binds x2 in t t2 +*) + +ML \ + val ctor_T1_Ts = [ + [@{typ 'var}], + [@{typ 'rec}, @{typ 'rec}], + [@{typ 'b1}, @{typ "'brec1"}, @{typ 'b2}, @{typ "'brec2"}] + ] + \ + +ML \ + val T1 = BNF_FP_Util.mk_sumprodT_balanced ctor_T1_Ts + val name1 = "term"; + val rel = [[([], [0]), ([], [0, 1])]]; + Multithreading.parallel_proofs := 4 + \ + +declare [[quick_and_dirty]] +declare [[ML_print_depth=1000]] +declare [[mrbnf_internals]] +local_setup \fn lthy => + let + val Xs = map dest_TFree [] + val resBs = map dest_TFree [@{typ 'var}, @{typ 'b1}, @{typ 'b2}, @{typ 'brec1}, @{typ 'brec2}, @{typ 'rec}] + + fun flatten_tyargs Ass = subtract (op =) Xs (filter (fn T => exists (fn Ts => member (op =) Ts T) Ass) resBs) @ Xs; + val qualify1 = Binding.prefix_name (name1 ^ "_pre_") + val accum = (MRBNF_Comp.empty_comp_cache, MRBNF_Comp.empty_unfolds) + + (* Step 1: Create pre-MRBNF *) + val ((mrbnf1, tys1), (accum, lthy)) = MRBNF_Comp.mrbnf_of_typ true MRBNF_Def.Smart_Inline qualify1 flatten_tyargs Xs [] + [(dest_TFree @{typ 'var}, MRBNF_Def.Free_Var), (dest_TFree @{typ 'b1}, MRBNF_Def.Bound_Var), + (dest_TFree @{typ 'b2}, MRBNF_Def.Bound_Var)] T1 + (accum, lthy) + val _ = @{print} "comp" + + (* Step 2: Seal the pre-MRBNF with a typedef *) + val ((mrbnf1, (Ds, info)), lthy) = MRBNF_Comp.seal_mrbnf I (snd accum) (Binding.name (name1 ^ "_pre")) true (fst tys1) [] mrbnf1 lthy + val _ = @{print} "seal" + + (* Step 3: Register the pre-MRBNF as a BNF in its live variables *) + val (bnf1, lthy) = MRBNF_Def.register_mrbnf_as_bnf mrbnf1 lthy + val _ = @{print} "register" + in lthy end + \ +print_theorems +print_mrbnfs + +declare [[quick_and_dirty=false]] + +lemmas infinite_UNIV = cinfinite_imp_infinite[OF term_pre.UNIV_cinfinite] + +(********************** BINDER FIXPOINT CONSTRUCTION **************************************) + +typ "('a, 'b1, 'b2, 'brec1, 'brec2, 'rec) term_pre" + +codatatype ('a::var_term_pre) raw_term = raw_term_ctor "('a, 'a, 'a, 'a raw_term, 'a raw_term, 'a raw_term) term_pre" + +(* this definition is specific for codatatypes *) +primcorec permute_raw_term :: "('a::var_term_pre \ 'a) \ 'a raw_term \ 'a raw_term" where + "permute_raw_term f x = raw_term_ctor (map_term_pre id id id (permute_raw_term f) (permute_raw_term f) (permute_raw_term f) ( + map_term_pre f f f id id id (un_raw_term_ctor x) + ))" + +(* this lemma is specific to codatatype *) +lemma permute_raw_sels: + fixes f::"'a::var_term_pre \ 'a" + assumes "bij f" "|supp f| 'a" + assumes "bij f" "|supp f| 'a raw_term \ bool" where + "a \ set1_term_pre x \ free_raw_term a (raw_term_ctor x)" +| "z \ set4_term_pre x \ free_raw_term a z \ a \ set2_term_pre x \ set3_term_pre x \ free_raw_term a (raw_term_ctor x)" +| "z \ set5_term_pre x \ free_raw_term a z \ a \ set3_term_pre x \ free_raw_term a (raw_term_ctor x)" +| "z \ set6_term_pre x \ free_raw_term a z \ free_raw_term a (raw_term_ctor x)" + +definition FVars_raw_term :: "'a::var_term_pre raw_term \ 'a set" where + "FVars_raw_term x \ { a. free_raw_term a x }" + +(* this definition is specific to codatatypes *) +primrec set_term_level :: "nat \ 'a::var_term_pre raw_term \ 'a set" where + "set_term_level 0 t = {}" +| "set_term_level (Suc n) t = (case t of raw_term_ctor x \ +set1_term_pre x \ (\y\set4_term_pre x. set_term_level n y) \ (\y\set5_term_pre x. set_term_level n y) \ (\y\set6_term_pre x. set_term_level n y))" + +coinductive alpha_term :: "'a::var_term_pre raw_term \ 'a raw_term \ bool" where + "\ bij g ; |supp g| (FVars_raw_term ` set4_term_pre x) - (set2_term_pre x \ set3_term_pre x)) g ; + bij f2 ; |supp f2| (FVars_raw_term ` set5_term_pre x) - set3_term_pre x) f2 ; + eq_on (set3_term_pre x) f2 g ; + mr_rel_term_pre id g g (\x. alpha_term (permute_raw_term g x)) (\x. alpha_term (permute_raw_term f2 x)) alpha_term x y + \ \ alpha_term (raw_term_ctor x) (raw_term_ctor y)" + monos conj_context_mono term_pre.mr_rel_mono[OF supp_id_bound] + +(* this definition is specific to codatatypes *) +coinductive alpha_term' :: "'a::var_term_pre raw_term \ 'a raw_term \ bool" where + "\ bij g ; |supp g| (FVars_raw_term ` set4_term_pre x) - (set2_term_pre x \ set3_term_pre x)) g ; + bij f2 ; |supp f2| (FVars_raw_term ` set5_term_pre x) - set3_term_pre x) f2 ; + eq_on (set3_term_pre x) f2 g ; + bij g' ; |supp g'| (FVars_raw_term ` set4_term_pre y) - (set2_term_pre y \ set3_term_pre y)) g' ; + bij f2' ; |supp f2'| (FVars_raw_term ` set5_term_pre y) - set3_term_pre y) f2' ; + eq_on (set3_term_pre y) f2' g' ; + mr_rel_term_pre id (inv g' \ g) (inv g' \ g) (\x y. alpha_term' (permute_raw_term g x) (permute_raw_term g' y)) + (\x y. alpha_term' (permute_raw_term f2 x) (permute_raw_term f2' y)) alpha_term' x y + \ \ alpha_term' (raw_term_ctor x) (raw_term_ctor y)" + monos conj_context_mono term_pre.mr_rel_mono[OF supp_id_bound] bij_comp bij_imp_bij_inv supp_comp_bound[OF _ _ infinite_UNIV] supp_inv_bound + +type_synonym 'a raw_term_pre = "('a, 'a, 'a, 'a raw_term, 'a raw_term, 'a raw_term) term_pre" + +definition avoid_raw_term :: "'a::var_term_pre raw_term_pre \ 'a set \ 'a raw_term_pre" where + "avoid_raw_term x A \ SOME y. (set2_term_pre y \ set3_term_pre y) \ A = {} \ alpha_term (raw_term_ctor x) (raw_term_ctor y)" + +typedef ('a::var_term_pre) "term" = "(UNIV::'a raw_term set) // { (x, y). alpha_term x y }" + apply (rule exI) + apply (rule quotientI) + apply (rule UNIV_I) + done + +abbreviation "TT_abs \ quot_type.abs alpha_term Abs_term" +abbreviation "TT_rep \ quot_type.rep Rep_term" + +type_synonym 'a term_pre' = "('a, 'a, 'a, 'a term, 'a term, 'a term) term_pre" + +(* this definition is specific to codatatypes *) +definition un_term_ctor :: "'a::var_term_pre term \ 'a term_pre'" where + "un_term_ctor x \ map_term_pre id id id TT_abs TT_abs TT_abs (un_raw_term_ctor (TT_rep x))" + +definition term_ctor :: "'a::var_term_pre term_pre' \ 'a term" where + "term_ctor x \ TT_abs (raw_term_ctor (map_term_pre id id id TT_rep TT_rep TT_rep x))" + +definition permute_term :: "('a::var_term_pre \ 'a) \ 'a term \ 'a term" where + "permute_term f x \ TT_abs (permute_raw_term f (TT_rep x))" + +definition FVars_term :: "'a::var_term_pre term \ 'a set" where + "FVars_term x \ FVars_raw_term (TT_rep x)" + +definition avoid_term :: "'a::var_term_pre term_pre' \ 'a set \ 'a term_pre'" where + "avoid_term x A \ map_term_pre id id id TT_abs TT_abs TT_abs ( +avoid_raw_term (map_term_pre id id id TT_rep TT_rep TT_rep x) A)" + +definition noclash_raw_term :: "'a::var_term_pre raw_term_pre \ bool" where + "noclash_raw_term x \ (set2_term_pre x \ set3_term_pre x) \ (set1_term_pre x \ \(FVars_raw_term ` set6_term_pre x)) = {}" + +definition noclash_term :: "'a::var_term_pre term_pre' \ bool" where + "noclash_term x \ (set2_term_pre x \ set3_term_pre x) \ (set1_term_pre x \ \(FVars_term ` set6_term_pre x)) = {}" + +(****************** PROOFS ******************) + +(* this lemma is specific to codatatypes *) +lemma raw_term_coinduct: + fixes lhs rhs::"'a::var_term_pre raw_term \ 'a raw_term" + assumes + "\z. rel_term_pre (\l r. \z. l = lhs z \ r = rhs z) (\l r. \z. l = lhs z \ r = rhs z) (\l r. \z. l = lhs z \ r = rhs z) +(un_raw_term_ctor (lhs z)) (un_raw_term_ctor (rhs z))" + shows "lhs x = rhs x" + apply (rule raw_term.coinduct[of "\l r. \z. l = lhs z \ r = rhs z"]) + apply (rule exI conjI refl)+ + apply (erule exE) + apply (erule conjE) + apply hypsubst + apply (rule assms) + done + +(* this proof is specific to codatatypes *) +lemma permute_raw_ids: "permute_raw_term id x = x" + apply (rule raw_term_coinduct[of _ _ x]) + apply (subst permute_raw_sels) + apply (rule supp_id_bound bij_id)+ + apply (rule iffD2[OF term_pre.rel_map(1)]) + apply (rule term_pre.rel_refl_strong) + apply (rule exI conjI refl)+ + done + +lemmas permute_raw_id0s = permute_raw_ids[abs_def, unfolded id_def[symmetric], THEN meta_eq_to_obj_eq] + +(* this proof is specific to codatatypes *) +lemma permute_raw_comps: + fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + assumes f_prems: "bij f" "|supp f| g) x" + apply (rule raw_term_coinduct[of _ _ x]) + apply (subst permute_raw_sels term_pre.map_comp, (rule assms supp_comp_bound bij_comp infinite_UNIV)+)+ + apply (unfold term_pre.mr_rel_id) + apply (rule term_pre.mr_rel_map(1)[THEN iffD2]) + apply (rule supp_id_bound bij_id supp_comp_bound bij_comp infinite_UNIV assms)+ + apply (unfold id_o o_id Grp_OO) + apply (rule term_pre.mr_rel_map(3)[THEN iffD2]) + apply (rule supp_id_bound bij_id supp_comp_bound bij_comp infinite_UNIV assms)+ + apply (subst inv_o_simp1, (rule bij_comp assms)+)+ + apply (unfold term_pre.mr_rel_id[symmetric] relcompp_conversep_Grp comp_def) + apply (rule term_pre.rel_refl_strong) + apply (rule exI conjI refl)+ + done + +lemma permute_raw_comp0s: + fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + assumes f_prems: "bij f" "|supp f| permute_raw_term g = permute_raw_term (f \ g)" + apply (rule ext) + apply (rule trans[OF comp_apply]) + apply (rule permute_raw_comps) + apply (rule assms)+ + done + +lemma FVars_raw_intros: + "a \ set1_term_pre x \ a \ FVars_raw_term (raw_term_ctor x)" + "z \ set4_term_pre x \ a \ FVars_raw_term z \ a \ set2_term_pre x \ set3_term_pre x \ a \ FVars_raw_term (raw_term_ctor x)" + "z \ set5_term_pre x \ a \ FVars_raw_term z \ a \ set3_term_pre x \ a \ FVars_raw_term (raw_term_ctor x)" + "z \ set6_term_pre x \ a \ FVars_raw_term z \ a \ FVars_raw_term (raw_term_ctor x)" + apply (unfold FVars_raw_term_def mem_Collect_eq) + apply (erule free_raw_term.intros | assumption)+ + done + +lemma FVars_raw_ctors: + "FVars_raw_term (raw_term_ctor x) = set1_term_pre x \ (\(FVars_raw_term ` set4_term_pre x) - (set2_term_pre x \ set3_term_pre x)) + \ (\(FVars_raw_term ` set5_term_pre x) - set3_term_pre x) \ \(FVars_raw_term ` set6_term_pre x)" + apply (rule subset_antisym) + apply (unfold FVars_raw_term_def)[1] + apply (rule subsetI) + apply (unfold mem_Collect_eq) + apply (erule free_raw_term.cases) + (* REPEAT_DETERM *) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 1] 1\) + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 2] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply (unfold mem_Collect_eq) + apply assumption+ + (* repeated *) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 3] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply (unfold mem_Collect_eq) + apply assumption+ + (* repeated *) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 4] 1\) + apply (rule UN_I) + apply (unfold mem_Collect_eq) + apply assumption+ + (* END REPEAT_DETERM *) + apply (rule subsetI) + apply (erule UnE)+ + apply (((erule DiffE UN_E)+)?, erule FVars_raw_intros, (assumption+)?)+ + done + +lemma FVars_raw_permute_leq: + fixes f::"'a::var_term_pre \ 'a" + assumes f_prems: "bij f" "|supp f| f a \ FVars_raw_term (permute_raw_term f x)" + apply (erule free_raw_term.induct[of _ x]) + (* REPEAT_DETERM *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst term_pre.set_map, (rule assms supp_id_bound bij_id)+)+ + apply (unfold image_comp[unfolded comp_def]) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 1] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst term_pre.set_map, (rule assms supp_id_bound bij_id)+)+ + apply (unfold image_comp[unfolded comp_def]) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 2] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption)) + apply assumption + apply (unfold image_Un[symmetric])[1] + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst term_pre.set_map, (rule assms supp_id_bound bij_id)+)+ + apply (unfold image_comp[unfolded comp_def]) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 3] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption)) + apply assumption + apply ((unfold image_Un[symmetric])[1])? + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst term_pre.set_map, (rule assms supp_id_bound bij_id)+)+ + apply (unfold image_comp[unfolded comp_def]) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 4] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption)) + apply assumption + apply ((unfold image_Un[symmetric])[1])? + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* END REPEAT_DETERM *) + done + +lemma FVars_raw_permutes: + fixes f::"'a::var_term_pre \ 'a" + assumes f_prems: "bij f" "|supp f| n. \x. |set_term_level n x| z \ (\n. set_term_level n x)" + apply (erule free_raw_term.induct) + apply (erule UN_E)? + apply (rule UN_I) + apply (rule UNIV_I) + apply (subst set_term_level.simps(2)) + apply (unfold raw_term.case) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 1] 1\) + apply assumption + (* repeated *) + apply (erule UN_E)? + apply (rule UN_I) + apply (rule UNIV_I) + apply (subst set_term_level.simps(2)) + apply (unfold raw_term.case) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 2] 1\) + apply (rule UN_I) + apply assumption + apply assumption + (* repeated *) + apply (erule UN_E)? + apply (rule UN_I) + apply (rule UNIV_I) + apply (subst set_term_level.simps(2)) + apply (unfold raw_term.case) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 3] 1\) + apply (rule UN_I) + apply assumption + apply assumption + (* repeated *) + apply (erule UN_E)? + apply (rule UN_I) + apply (rule UNIV_I) + apply (subst set_term_level.simps(2)) + apply (unfold raw_term.case) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 4] 1\) + apply (rule UN_I) + apply assumption + apply assumption + done + +(* this proof is specific to codatatypes *) +lemma FVars_raw_bds: "|FVars_raw_term x| (x::'a raw_term) y. x = y \ alpha_term x y" + apply (rule allI impI)+ + apply (erule alpha_term.coinduct) + apply hypsubst_thin + apply (unfold triv_forall_equality) + subgoal for x + apply (rule raw_term.exhaust[of x]) + apply hypsubst_thin + apply (rule exI)+ + apply (rule conjI, rule refl supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (unfold term_pre.mr_rel_id[symmetric] permute_raw_ids) + apply (rule term_pre.rel_refl_strong) + apply (rule disjI1 refl)+ + done + done + + show ?thesis by (rule x[THEN spec, THEN spec, THEN mp[OF _ refl]]) +qed + +lemma alpha_bijs: + fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + assumes f_prems: "bij f" "|supp f| alpha_term x y \ alpha_term (permute_raw_term f x) (permute_raw_term g y)" +proof - + have x: "\(x::'a raw_term) y. (\x' y' f g. bij f \ |supp f| bij g \ |supp g| x = permute_raw_term f x' \ y = permute_raw_term g y' \ eq_on (FVars_raw_term x') f g \ alpha_term x' y') + \ alpha_term x y" + apply (rule allI impI)+ + apply (erule alpha_term.coinduct) + apply (erule exE conjE)+ + apply (erule alpha_term.cases) + apply hypsubst + apply (unfold triv_forall_equality) + subgoal for f g \ x f2 y + apply (rule exI[of _ "g \ \ \ inv f"]) + apply (rule exI) + apply (rule exI[of _ "g \ f2 \ inv f"]) + apply (rule exI)+ + apply (rule conjI, rule permute_raw_simps, (rule supp_id_bound bij_id | assumption)+)+ + apply (rule conjI, (rule bij_comp supp_comp_bound bij_imp_bij_inv supp_inv_bound infinite_UNIV | assumption)+)+ + + apply (subst term_pre.set_map, assumption+)+ + apply (unfold image_Un[symmetric] image_comp[unfolded comp_def]) + apply (subst FVars_raw_permutes, assumption+)+ + apply (unfold image_UN[symmetric]) + apply (subst image_set_diff[OF bij_is_inj, symmetric], assumption+)+ + + apply (rule conjI) + apply (rule id_onI) + apply (erule imageE) + apply hypsubst + apply (rule trans[OF comp_apply]) + apply (rule trans[OF arg_cong[OF inv_simp1]]) + apply assumption + apply (rule trans[OF comp_apply]) + apply (rule trans[OF arg_cong[of _ _ g]]) + apply (erule id_onD) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply (erule DiffE) + apply (erule UN_E) + apply (erule FVars_raw_intros) + apply assumption+ + + apply (rule conjI, (rule bij_comp supp_comp_bound bij_imp_bij_inv supp_inv_bound infinite_UNIV | assumption)+)+ + + apply (rule conjI) + apply (rule id_onI) + apply (erule imageE) + apply hypsubst + apply (rule trans[OF comp_apply]) + apply (rule trans[OF arg_cong[OF inv_simp1]]) + apply assumption + apply (rule trans[OF comp_apply]) + apply (rule trans[OF arg_cong[of _ _ g]]) + apply (erule id_onD) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply (erule DiffE) + apply (erule UN_E) + apply (erule FVars_raw_intros) + apply assumption+ + + apply (rule conjI) + apply (rule eq_on_comp1) + apply (rule eq_on_refl) + apply (unfold image_comp inv_o_simp1 image_id)[1] + apply (rule eq_on_comp1) + apply assumption + apply (rule eq_on_refl) + + apply (rule iffD2[OF term_pre.mr_rel_map(1)]) + apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ + apply (unfold id_o o_id) + apply (rule iffD2[OF term_pre.mr_rel_map(3)]) + apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ + apply (unfold comp_assoc inv_id id_o o_id Grp_UNIV_id conversep_eq OO_eq relcompp_conversep_Grp Grp_OO) + apply (subst inv_o_simp1, assumption)+ + apply (unfold id_o o_id comp_assoc[symmetric]) + apply (subst inv_o_simp1, assumption)+ + apply (unfold id_o o_id) + apply (erule term_pre.mr_rel_mono_strong0[rotated -7]) + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule trans) + apply (rule id_apply) + apply (rule sym) + apply (rule trans[OF comp_apply]) + apply (rule inv_f_eq[OF bij_is_inj]) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply (erule FVars_raw_intros) + (* END REPEAT_DETERM *) + apply (rule ballI, rule refl)+ + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply assumption + apply (rule eq_on_refl) + apply (rule refl) + apply (rule trans) + apply (rule permute_raw_comps) + apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ + apply (unfold comp_assoc) + apply (subst inv_o_simp1, assumption) + apply (unfold o_id) + apply (rule trans) + apply (rule permute_raw_comps[symmetric]) + apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ + apply (rule refl) + apply assumption+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply assumption + apply (rule eq_on_refl) + apply (rule refl) + apply (rule trans) + apply (rule permute_raw_comps) + apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ + apply (unfold comp_assoc) + apply (subst inv_o_simp1, assumption) + apply (unfold o_id) + apply (rule trans) + apply (rule permute_raw_comps[symmetric]) + apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ + apply (rule refl) + apply assumption+ + (* repeated, rec free case *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply assumption + apply (erule eq_on_mono[rotated -1]) + apply (rule subsetI) + apply (erule FVars_raw_intros) + apply assumption + apply (rule refl)+ + apply assumption+ + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id supp_comp_bound bij_comp infinite_UNIV supp_inv_bound bij_imp_bij_inv | assumption)+ + done + done + + show "eq_on (FVars_raw_term x) f g \ alpha_term x y \ alpha_term (permute_raw_term f x) (permute_raw_term g y)" + apply (rule x[THEN spec, THEN spec, THEN mp]) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply assumption+ + apply (rule refl)+ + apply (rule assms)+ + done +qed + +lemma alpha_bij_eqs: + fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + assumes f_prems: "bij f" "|supp f| 'a" and g::"'a \ 'a" + assumes f_prems: "bij f" "|supp f| (\y. alpha_term x y \ a \ FVars_raw_term y)" + "free_raw_term a x \ (\y. alpha_term y x \ a \ FVars_raw_term y)" + apply (erule free_raw_term.induct) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule sym) + apply (erule term_pre.mr_rel_set[OF supp_id_bound, unfolded image_id, rotated -1]) + apply assumption+ + apply (erule FVars_raw_intros) + + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_rel_set(4-6)[rotated -1]) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1]) + apply assumption+ + apply (erule allE) + apply (erule impE) + apply assumption + apply (subst (asm) FVars_raw_permutes) + apply (rule bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (rotate_tac -1) + apply (drule imageI) + apply (subst (asm) image_f_inv_f[OF bij_is_surj]) + apply assumption + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF _ refl, of _ _ "(\)"], rotated -1]) + apply (erule id_onD) + apply (erule DiffI[rotated]) + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + apply (erule FVars_raw_intros) + apply assumption + apply (rule arg_cong2[OF refl, of _ _ "(\)", THEN iffD2]) + apply (rule arg_cong2[of _ _ _ _ "(\)"])+ + apply (erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound | assumption)+)+ + apply (unfold image_Un[symmetric] image_in_bij_eq) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2, rotated]) + apply assumption + apply (erule id_on_inv[THEN id_onD, rotated]) + apply (erule DiffI[rotated]) + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + apply assumption + + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_rel_set(4-6)[rotated -1]) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1]) + apply assumption+ + apply (erule allE) + apply (erule impE) + apply assumption + apply (subst (asm) FVars_raw_permutes) + apply (rule bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (rotate_tac -1) + apply (drule imageI) + apply (subst (asm) image_f_inv_f[OF bij_is_surj]) + apply assumption + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF _ refl, of _ _ "(\)"], rotated -1]) + apply (erule id_onD) + apply (erule DiffI[rotated]) + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + apply (erule FVars_raw_intros) + apply assumption + apply (rule arg_cong2[OF refl, of _ _ "(\)", THEN iffD2]) + apply (rule trans) + apply (erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound | assumption)+)+ + apply (erule eq_on_sym[THEN eq_on_image]) + apply (unfold image_Un[symmetric] image_in_bij_eq) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2, rotated]) + apply assumption + apply (erule id_on_inv[THEN id_onD, rotated]) + apply (erule DiffI[rotated]) + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + apply assumption + + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_rel_set(4-6)[rotated -1]) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule FVars_raw_intros) + apply assumption + +(* second goal, similar tactic *) + apply (erule free_raw_term.induct) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + (* apply (rule sym) *) + apply (erule term_pre.mr_rel_set[OF supp_id_bound, unfolded image_id, rotated -1]) + apply assumption+ + apply (erule FVars_raw_intros) + +(* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_set_transfer(4-6)[THEN rel_funD, THEN rel_setD2, rotated -1]) (* changed *) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound | assumption)+ + apply (erule bexE) + (* apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1]) +apply assumption+ *) + apply (erule allE) + apply (erule impE) + apply assumption + apply (subst (asm) FVars_raw_permutes) + apply (rule bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (erule imageE) + apply hypsubst + apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ "(\)"]]) + apply (erule id_onD) + apply (rule DiffI) + apply (rule UN_I) + apply assumption + apply assumption + apply (subst inj_image_mem_iff[OF bij_is_inj, symmetric]) + prefer 2 + apply (erule arg_cong2[OF refl, of _ _ "(\)", THEN iffD2, rotated]) + apply (unfold image_Un)[1] + apply (rule arg_cong2[of _ _ _ _ "(\)"])+ + apply (rule sym, erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound | assumption)+)+ + apply (erule FVars_raw_intros) + apply assumption + apply (subst inj_image_mem_iff[OF bij_is_inj, symmetric]) + prefer 2 + apply (erule arg_cong2[OF refl, of _ _ "(\)", THEN iffD2, rotated]) + apply (unfold image_Un)[1] + apply (rule arg_cong2[of _ _ _ _ "(\)"])+ + apply (rule sym, erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound | assumption)+)+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_set_transfer(4-6)[THEN rel_funD, THEN rel_setD2, rotated -1]) (* changed *) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound | assumption)+ + apply (erule bexE) + (* apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1]) +apply assumption+ *) + apply (erule allE) + apply (erule impE) + apply assumption + apply (subst (asm) FVars_raw_permutes) + apply (rule bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (erule imageE) + apply hypsubst + apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ "(\)"]]) + apply (erule id_onD) + apply (rule DiffI) + apply (rule UN_I) + apply assumption + apply assumption + apply (subst inj_image_mem_iff[OF bij_is_inj, symmetric]) + prefer 2 + apply (erule arg_cong2[OF refl, of _ _ "(\)", THEN iffD2, rotated]) + apply (rule trans) + apply (erule eq_on_image) + apply (rule sym, erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound | assumption)+)+ + apply (erule FVars_raw_intros) + apply assumption + apply (subst inj_image_mem_iff[OF bij_is_inj, symmetric]) + prefer 2 + apply (erule arg_cong2[OF refl, of _ _ "(\)", THEN iffD2, rotated]) + apply (rule trans) + apply (erule eq_on_image) + apply (rule sym, erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound | assumption)+)+ + (* repeated, rec free case *) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_set_transfer(4-6)[THEN rel_funD, THEN rel_setD2, rotated -1]) (* changed *) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule FVars_raw_intros) + apply assumption + done + +lemma alpha_FVars: "alpha_term x y \ FVars_raw_term x = FVars_raw_term y" + apply (rule subset_antisym) + apply (rule subsetI) + apply (subst (asm) FVars_raw_term_def) + apply (drule mem_Collect_eq[THEN iffD1]) + apply (erule alpha_FVars_leqs[THEN spec, THEN mp, rotated]) + apply assumption + apply (rule subsetI) + apply (erule alpha_FVars_leqs[THEN spec, THEN mp, rotated]) + apply (unfold FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + done + +lemma alpha_syms: + fixes x::"'a::var_term_pre raw_term" + shows "alpha_term x y \ alpha_term y x" + apply (erule alpha_term.coinduct) + apply (erule alpha_term.cases) + apply hypsubst + + apply (unfold triv_forall_equality) + apply (rule exI)+ + apply (rule conjI, rule refl)+ + apply (rule conjI[rotated])+ + apply (rule iffD1[OF term_pre.mr_rel_flip, rotated -1]) + apply (unfold inv_id) + apply (erule term_pre.mr_rel_mono_strong0[rotated -7]) + apply (rule ballI, rule refl)+ + apply (rule ballI, rule inv_inv_eq[THEN fun_cong, symmetric], assumption)+ + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (assumption | (erule alpha_bij_eq_invs[THEN iffD1, rotated -1], assumption+)) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (assumption | (erule alpha_bij_eq_invs[THEN iffD1, rotated -1], assumption+)) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (assumption | (erule alpha_bij_eq_invs[THEN iffD1, rotated -1], assumption+)) + (* END REPEAT_DETERM *) + apply (unfold inv_inv_eq) + apply (assumption | rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound)+ + + apply (rule iffD2[OF arg_cong[of _ _ eq_on, THEN fun_cong, THEN fun_cong]]) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound | assumption)+ + apply (rule eq_on_inv2) + apply assumption+ + + apply (rule id_on_inv) + apply assumption+ + apply (rule id_on_antimono) + apply assumption + apply (rule equalityD1) + apply (rule trans) + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule trans) + apply (erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id | assumption)+)+ + apply (rule sym) + apply (erule eq_on_image) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj, symmetric]) + apply assumption + apply (erule id_on_image) + apply (unfold image_UN)[1] + apply (rule sym) + apply (rule rel_set_UN_D) + apply (erule term_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF term_pre.mr_rel_mono_strong[rotated -4]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule imp_refl)+ + (* ORELSE *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (drule alpha_FVars) + apply (erule trans[rotated]) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply assumption+ + (* ORELSE *) + apply (rule ballI, rule ballI, rule imp_refl)+ + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id supp_inv_bound bij_imp_bij_inv | assumption)+ + + apply (rule id_on_inv) + apply assumption+ + apply (rule id_on_antimono) + apply assumption + apply (rule equalityD1) + apply (rule trans) + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule arg_cong2[of _ _ _ _ "(\)"]) + apply (erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id | assumption)+)+ + prefer 2 + apply (unfold image_Un[symmetric])[1] + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj, symmetric]) + apply assumption + apply (erule id_on_image) + apply (unfold image_UN)[1] + apply (rule sym) + apply (rule rel_set_UN_D) + apply (erule term_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF term_pre.mr_rel_mono_strong[rotated -4]]) + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (drule alpha_FVars) + apply (erule trans[rotated]) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply assumption+ + (* ORELSE *) + apply (rule ballI, rule ballI, rule imp_refl)+ + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id supp_inv_bound bij_imp_bij_inv | assumption)+ + done + +lemma alpha_trans: "alpha_term x y \ alpha_term y z \ alpha_term x z" +proof - + have x: "(\y. alpha_term x y \ alpha_term y z) \ alpha_term x z" + apply (erule alpha_term.coinduct) + apply (erule exE conjE alpha_term.cases)+ + apply hypsubst + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_rel_OO[THEN fun_cong, THEN fun_cong, THEN iffD2, rotated -1, OF relcomppI]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id) + + apply (unfold triv_forall_equality) + subgoal for g x f2 g' y f2' z + apply (rule exI[of _ "g' \ g"]) + apply (rule exI) + apply (rule exI[of _ "f2' \ f2"]) + apply (rule exI) + apply (rule conjI, rule refl)+ + apply (rule conjI, (rule bij_comp supp_comp_bound infinite_UNIV | assumption)+)+ + + apply (rule conjI) + apply (rule id_on_comp[rotated]) + apply assumption + apply (erule id_on_antimono) + apply (rule equalityD2) + apply (rule trans) + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule arg_cong2[of _ _ _ _ "(\)"]) + apply (erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id | assumption)+)+ + prefer 2 + apply (unfold image_Un[symmetric]) + apply (rule trans) + apply (rule image_set_diff[symmetric, OF bij_is_inj]) + apply assumption + apply (erule id_on_image) + apply (unfold image_UN) + apply (rule sym) + apply (rule rel_set_UN_D) + apply (erule term_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF term_pre.mr_rel_mono_strong[rotated -4]]) + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (drule alpha_FVars) + apply (erule trans[rotated]) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply assumption+ + (* ORELSE *) + apply (rule ballI, rule ballI, rule imp_refl)+ + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id | assumption)+ + + apply (rule conjI, (rule bij_comp supp_comp_bound infinite_UNIV | assumption)+)+ + + apply (rule conjI) + apply (rule id_on_comp[rotated]) + apply assumption + apply (erule id_on_antimono) + apply (rule equalityD2) + apply (rule trans) + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule trans) + apply (erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id | assumption)+)+ + apply (rule sym) + apply (erule eq_on_image) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[symmetric, OF bij_is_inj]) + apply assumption + apply (erule id_on_image) + apply (unfold image_UN) + apply (rule sym) + apply (rule rel_set_UN_D) + apply (erule term_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF term_pre.mr_rel_mono_strong[rotated -4]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule imp_refl)+ + (* ORELSE *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (drule alpha_FVars) + apply (erule trans[rotated]) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply assumption+ + (* ORELSE *) + apply (rule ballI, rule ballI, rule imp_refl)+ + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id | assumption)+ + + apply (rule conjI) + apply (rule eq_on_comp1) + apply assumption + apply (erule eq_on_mono[rotated]) + apply (rule equalityD1) + apply (rule trans) + apply (erule eq_on_image) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound | assumption)+)+ + + apply (erule term_pre.mr_rel_mono_strong[rotated -4]) + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply (rule exI) + apply (rule conjI[rotated]) + apply assumption + apply (subst permute_raw_comps[symmetric]) + apply assumption+ + apply (rule iffD2[OF alpha_bij_eqs]) + apply assumption+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply (rule exI) + apply (rule conjI[rotated]) + apply assumption + apply (subst permute_raw_comps[symmetric]) + apply assumption+ + apply (rule iffD2[OF alpha_bij_eqs]) + apply assumption+ + (* repeated, free rec case *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (erule relcomppE) + apply (rule disjI1) + apply (rule exI) + apply (rule conjI) + apply assumption+ + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_comp supp_comp_bound infinite_UNIV | assumption)+ + done + done + + show "alpha_term x y \ alpha_term y z \ alpha_term x z" + apply (rule x) + apply (rule exI) + apply (rule conjI) + apply assumption+ + done +qed + +lemma raw_refreshs: + fixes x::"('a::covar_term_pre, 'a, 'a, 'a raw_term, 'a raw_term, 'a raw_term) term_pre" + assumes "|A| y. (set2_term_pre y \ set3_term_pre y) \ A = {} \ alpha_term (raw_term_ctor x) (raw_term_ctor y)" + + apply (rule exE[OF eextend_fresh[of "set2_term_pre x \ set3_term_pre x" + "(A \ (set2_term_pre x \ set3_term_pre x)) \ ((\(FVars_raw_term ` set4_term_pre x) \ \(FVars_raw_term ` set5_term_pre x)) - (set2_term_pre x \ set3_term_pre x))" + "(\(FVars_raw_term ` set4_term_pre x) \ \(FVars_raw_term ` set5_term_pre x)) - (set2_term_pre x \ set3_term_pre x)" + ]]) + apply (rule var_term_pre_class.Un_bound term_pre.set_bd_UNIV assms ordLeq_ordLess_trans[OF card_of_diff] + term_pre.set_bd[THEN ordLess_ordLeq_trans] var_term_pre_class.UN_bound var_term_pre_class.large FVars_raw_bd_UNIVs infinite_UNIV + )+ + apply (rule Un_upper2) + apply (rule Diff_disjoint) + apply (erule conjE)+ + apply (unfold Un_Diff) + + subgoal for g + apply (rule exE[OF extend_id_on[of g "\ (FVars_raw_term ` set5_term_pre x)" "set2_term_pre x \ set3_term_pre x" "set3_term_pre x"]]) + apply assumption+ + apply (erule id_on_antimono) + apply (rule Un_upper2) + apply assumption + apply (erule Int_subset_empty2) + apply (rule subset_trans[rotated]) + apply (rule Un_upper1) + apply (rule Un_upper2) + + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + apply (erule conjE)+ + + subgoal for f2 + apply (rule exI[of _ "map_term_pre id g g (permute_raw_term g) (permute_raw_term f2) id x"]) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_Un[symmetric]) + apply (rule conjI) + apply (erule Int_subset_empty2) + apply (unfold Un_assoc)[1] + apply (rule Un_upper1) + apply (rule alpha_term.intros[rotated -1]) + apply (rule iffD2[OF term_pre.mr_rel_map(3), rotated -1]) + apply (unfold inv_id id_o Grp_UNIV_id conversep_eq OO_eq) + apply (subst inv_o_simp1, assumption)+ + apply (unfold term_pre.mr_rel_id[symmetric] relcompp_conversep_Grp) + apply (rule term_pre.rel_refl_strong) + apply (rule alpha_refls)+ + apply (rule supp_id_bound bij_id | assumption)+ + + apply (erule id_on_antimono) + apply (rule Un_upper1) + apply assumption+ + done + done + done + +lemma avoid_raw_freshs: + fixes x::"'a::covar_term_pre raw_term_pre" + assumes "|A| A = {}" "set3_term_pre (avoid_raw_term x A) \ A = {}" + apply (unfold avoid_raw_term_def) + (* REPEAT_DETERM *) + apply (rule someI2_ex) + apply (rule raw_refreshs[OF assms]) + apply (unfold Int_Un_distrib2 Un_empty)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rule someI2_ex) + apply (rule raw_refreshs[OF assms]) + apply (unfold Int_Un_distrib2 Un_empty)[1] + apply (erule conjE)+ + apply assumption + (* END REPEAT_DETERM *) + done + +lemma TT_Quotients: "Quotient alpha_term TT_abs TT_rep (\x. (=) (TT_abs x))" + apply (subgoal_tac "Quotient3 alpha_term TT_abs TT_rep") + prefer 2 + apply (rule quot_type.Quotient) + apply (rule type_definition_quot_type) + apply (rule type_definition_term) + apply (rule equivpI) + apply (rule reflpI) + apply (rule alpha_refls) + apply (rule sympI) + apply (erule alpha_syms) + apply (rule transpI) + apply (erule alpha_trans) + apply assumption + apply (rule QuotientI) + apply (erule Quotient3_abs_rep) + apply (rule alpha_refls) + apply (erule Quotient3_rel[symmetric]) + apply (rule ext)+ + apply (rule iffI) + apply (rule conjI) + apply (rule alpha_refls) + apply assumption + apply (erule conjE) + apply assumption + done + +lemmas TT_total_abs_eq_iffs = TT_Quotients[THEN Quotient_total_abs_eq_iff, OF reflpI[OF alpha_refls]] +lemmas TT_rep_abs = TT_Quotients[THEN Quotient_rep_abs, OF alpha_refls] +lemmas TT_abs_rep = TT_Quotients[THEN Quotient_abs_rep] + +lemmas TT_rep_abs_syms = alpha_syms[OF TT_rep_abs] + +lemma TT_abs_ctors: "TT_abs (raw_term_ctor x) = term_ctor (map_term_pre id id id TT_abs TT_abs TT_abs x)" + apply (unfold term_ctor_def) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_term.intros) + apply (rule supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (unfold permute_raw_ids term_pre.mr_rel_id[symmetric]) + apply (subst term_pre.map_comp) + apply (rule supp_id_bound bij_id)+ + apply (unfold id_o o_id) + apply (rule iffD2[OF term_pre.rel_map(2)]) + apply (unfold comp_def) + apply (rule term_pre.rel_refl_strong) + apply (rule TT_rep_abs_syms)+ + done + +lemma permute_simps: + fixes f::"'a::var_term_pre \ 'a" + assumes "bij f" "|supp f| 'a" + assumes "bij f" "|supp f| f) x" + apply (unfold permute_term_def) + apply (subst permute_raw_comps[symmetric]) + apply (rule assms)+ + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) + apply (rule assms)+ + apply (rule TT_rep_abs) + done + +lemma permute_comp0s: + fixes f::"'a::var_term_pre \ 'a" + assumes "bij f" "|supp f| permute_term f = permute_term (g \ f)" + apply (rule ext) + apply (rule trans[OF comp_apply]) + apply (rule permute_comps[OF assms]) + done + +lemma permute_bijs: + fixes f::"'a::var_term_pre \ 'a" + assumes "bij f" "|supp f| 'a" + assumes "bij f" "|supp f| 'a" + assumes "bij f" "|supp f| (\(FVars_term ` set4_term_pre x) - (set2_term_pre x \ set3_term_pre x)) +\ (\(FVars_term ` set5_term_pre x) - set3_term_pre x) \ \(FVars_term ` set6_term_pre x)" + apply (unfold FVars_term_def term_ctor_def) + apply (rule trans) + apply (rule alpha_FVars) + apply (rule TT_rep_abs) + apply (rule trans) + apply (rule FVars_raw_ctors) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id image_comp[unfolded comp_def]) + apply (rule refl) + done + +lemma FVars_intros: + "a \ set1_term_pre x \ a \ FVars_term (term_ctor x)" + "z \ set4_term_pre x \ a \ FVars_term z \ a \ set2_term_pre x \ set3_term_pre x \ a \ FVars_term (term_ctor x)" + "z \ set5_term_pre x \ a \ FVars_term z \ a \ set3_term_pre x \ a \ FVars_term (term_ctor x)" + "z \ set6_term_pre x \ a \ FVars_term z \ a \ FVars_term (term_ctor x)" + apply (unfold FVars_term_def term_ctor_def alpha_FVars[OF TT_rep_abs]) + (* for thm in FVars_intros *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(1)[rotated]) + apply (subst term_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(2)[rotated]) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id)? + apply assumption? + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(3)[rotated]) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id)? + apply assumption? + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(4)[rotated]) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id)? + apply assumption? + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* END REPEAT_DETERM *) + done + +lemma TT_inject0s: + "(term_ctor x = term_ctor y) \ (\(g::'a::var_term_pre \ 'a) f2. +bij g \ |supp g| +id_on (\(FVars_term ` set4_term_pre x) - (set2_term_pre x \ set3_term_pre x)) g \ +bij f2 \ |supp f2| id_on (\(FVars_term ` set5_term_pre x) - set3_term_pre x) f2 \ +eq_on (set3_term_pre x) f2 g \ +map_term_pre id g g (permute_term g) (permute_term f2) id x = y)" + apply (unfold term_ctor_def permute_term_def) + apply (rule trans) + apply (rule TT_total_abs_eq_iffs) + apply (rule iffI) + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject])+ + apply hypsubst + apply (subst (asm) term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id image_comp[unfolded comp_def]) + apply (drule iffD1[OF term_pre.mr_rel_map(1), rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id) + apply (drule iffD1[OF term_pre.mr_rel_map(3), rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold inv_id id_o o_id relcompp_conversep_Grp) + apply (unfold Grp_OO FVars_term_def[symmetric]) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply (rule term_pre.mr_rel_eq[THEN fun_cong, THEN fun_cong, THEN iffD1]) + apply (rule iffD2[OF term_pre.mr_rel_map(1), rotated -1]) + apply (unfold id_o o_id Grp_OO) + apply (erule term_pre.mr_rel_mono_strong[rotated -4]) + (* REPEAT_DETERM *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply assumption + (* repeated *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply assumption + (* repeated *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply hypsubst + apply (rule id_apply) + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id | assumption)+ + + apply (erule exE conjE)+ + apply hypsubst_thin + apply (subst term_pre.map_comp) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id) + apply (unfold comp_def) + apply (rule alpha_term.intros[rotated -1]) + apply (rule iffD2[OF term_pre.mr_rel_map(1), rotated -1]) + apply (unfold id_o o_id Grp_UNIV_id eq_OO) + apply (rule iffD2[OF term_pre.mr_rel_map(3), rotated -1]) + apply (unfold inv_id id_o o_id Grp_UNIV_id conversep_eq eq_OO) + apply (unfold relcompp_conversep_Grp Grp_OO) + apply (subst inv_o_simp1, assumption)+ + apply (rule iffD1[OF term_pre.mr_rel_id[THEN fun_cong, THEN fun_cong]]) + apply (rule term_pre.rel_refl_strong) + apply (rule alpha_refls TT_rep_abs_syms)+ + apply (rule supp_id_bound bij_id | assumption)+ + (* REPEAT_DETERM *) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id FVars_term_def image_comp[unfolded comp_def]) + apply assumption+ + (* repeated *) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id FVars_term_def image_comp[unfolded comp_def]) + apply assumption+ + (* repeated *) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id FVars_term_def image_comp[unfolded comp_def]) + apply assumption+ + (* END REPEAT_DETERM *) + done + +lemma avoid_freshs: + fixes x::"'a::covar_term_pre term_pre'" + assumes "|A| A = {}" "set3_term_pre (avoid_term x A) \ A = {}" + apply (unfold avoid_term_def) + (* REPEAT_DETERM *) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id) + apply (rule avoid_raw_freshs[OF assms]) + (* repeated *) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id) + apply (rule avoid_raw_freshs[OF assms]) + (* END REPEAT_DETERM *) + done + +lemma alpha_avoids: + fixes x::"'a::covar_term_pre term_pre'" + assumes "|A| (x::'a term_pre'). y = term_ctor x \ set2_term_pre x \ A = {} \ set3_term_pre x \ A = {} \ P" + shows P + apply (rule raw_term.exhaust[of "TT_rep y"]) + apply (rule assms) + defer + apply (rule avoid_freshs[OF assms(1)])+ + apply (rule trans[rotated]) + apply (rule sym) + apply (rule alpha_avoids[OF assms(1)]) + apply (unfold term_ctor_def) + apply (rule TT_Quotients[THEN Quotient_rel_abs2]) + apply (rule arg_cong2[OF _ refl, of _ _ alpha_term, THEN iffD2]) + apply assumption + apply (rule alpha_term.intros) + apply (rule supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (subst term_pre.map_comp) + apply (rule supp_id_bound bij_id)+ + apply (unfold id_o o_id) + apply (rule iffD2[OF term_pre.mr_rel_map(3), rotated -1]) + apply (unfold inv_id id_o o_id Grp_OO relcompp_conversep_Grp) + apply (unfold comp_def term_pre.mr_rel_id[symmetric] permute_raw_ids) + apply (rule term_pre.rel_refl_strong) + apply (rule TT_rep_abs_syms)+ + apply (rule supp_id_bound bij_id)+ + done + +lemma permute_abs: + fixes f::"'a::var_term_pre \ 'a" + assumes "bij f" "|supp f| 'a" + assumes "bij f" "|supp f| a. a \ FVars_term x \ f a = g a) \ permute_term f x = permute_term g x" + apply (unfold permute_term_def atomize_all atomize_imp eq_on_def[symmetric] FVars_term_def) + apply (rule impI) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bijs) + apply (rule assms)+ + apply assumption+ + apply (rule alpha_refls) + done + +lemmas permute_cong_ids = permute_congs[OF _ _ bij_id supp_id_bound, unfolded permute_ids, unfolded id_def] + +lemma nnoclash_noclashs: + "noclash_term x = noclash_raw_term (map_term_pre id id id TT_rep TT_rep TT_rep x)" + apply (unfold noclash_term_def noclash_raw_term_def) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id image_comp[unfolded comp_def] FVars_term_def[symmetric]) + apply (rule refl) + done + +(* the rest of the file is specific to codatatypes *) +lemma alpha_imp_alpha': "alpha_term x y \ alpha_term' x y" + apply (erule alpha_term'.coinduct) + apply (erule alpha_term.cases) + apply hypsubst + apply (rule exI)+ + apply (rule conjI, rule refl)+ + apply (rule conjI[rotated])+ + apply (erule term_pre.mr_rel_mono_strong0[rotated -7]) + apply (rule ballI, rule refl) + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule sym) + apply (rule trans[OF comp_apply]) + apply (rule trans[OF inv_id[THEN fun_cong] id_apply]) + (* repeated *) + apply (rule ballI) + apply (rule sym) + apply (rule trans[OF comp_apply]) + apply (rule trans[OF inv_id[THEN fun_cong] id_apply]) + (* END REPEAT_DETERM *) + apply (unfold permute_raw_ids) + (* REPEAT_DETERM *) + apply ((rule ballI impI)+, erule disjI1) + apply (rule ballI impI)+ + apply (rule disjI1) + apply (rule alpha_trans) + apply assumption + apply (subst permute_raw_ids) + apply (rule alpha_refls) + apply ((rule ballI impI)+, erule disjI1) + (* END REPEAT_DETERM *) + apply (unfold inv_id id_o o_id) + apply (rule supp_id_bound eq_on_refl id_on_id bij_id | assumption)+ + done + +lemma alpha'_bij_eqs: + fixes f::"'a::var_term_pre \ 'a" + assumes "bij f" "|supp f| alpha_term' x y" + apply (erule alpha_term'.coinduct) + apply (erule alpha_term'.cases) + subgoal for x1 x2 g x f2 g' y f2' + apply (rule raw_term.exhaust[of x1]) + apply (rule raw_term.exhaust[of x2]) + apply hypsubst_thin + apply (subst (asm) permute_raw_simps, (rule assms)+)+ + apply (drule iffD1[OF raw_term.inject])+ + apply hypsubst_thin + apply (subst (asm) term_pre.set_map, (rule assms)+)+ + apply (unfold image_comp[unfolded comp_def]) + apply (subst (asm) FVars_raw_permutes, (rule assms)+)+ + apply (unfold image_UN[symmetric] image_Un[symmetric]) + apply (subst (asm) image_set_diff[symmetric, OF bij_is_inj], rule assms)+ + apply (drule iffD1[OF term_pre.mr_rel_map(1)[rotated -1], rotated -1]) + apply (rule assms supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (unfold id_o o_id Grp_OO) + apply (drule iffD1[OF term_pre.mr_rel_map(3)[rotated -1], rotated -1]) + apply (rule assms supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (unfold relcompp_conversep_Grp) + apply (subst (asm) inv_o_simp1, rule assms)+ + apply (rule exI[of _ "inv f \ g \ f"]) + apply (rule exI) + apply (rule exI[of _ "inv f \ f2 \ f"]) + apply (rule exI[of _ "inv f \ g' \ f"]) + apply (rule exI) + apply (rule exI[of _ "inv f \ f2' \ f"]) + apply (rule conjI, rule refl)+ + + apply (rule conjI assms bij_comp bij_imp_bij_inv supp_inv_bound supp_comp_bound infinite_UNIV | assumption)+ + apply (rule id_on_inv_f_f) + apply (rule assms) + apply assumption + + apply (rule conjI assms bij_comp bij_imp_bij_inv supp_inv_bound supp_comp_bound infinite_UNIV id_on_inv_f_f eq_on_inv_f_f | assumption)+ + + apply (subst o_inv_distrib inv_inv_eq, (rule assms bij_imp_bij_inv bij_comp | assumption)+)+ + apply (unfold comp_assoc) + + apply (erule term_pre.mr_rel_mono_strong0[rotated -7]) + apply (rule ballI, rule refl)+ + + apply (rule ballI) + apply (rule trans[OF comp_apply]) + apply (rule sym[OF trans[OF comp_apply]]) + apply (rule arg_cong[of "(_ \ _) _"]) + apply (rule trans[OF comp_apply]) + apply (rule sym[OF trans[OF comp_apply]]) + apply (rule arg_cong[of "(_ \ _) _"]) + apply (rule sym) + apply (unfold comp_assoc[symmetric])[1] + apply (subst inv_o_simp2) + apply (rule assms) + apply (unfold id_o o_id) + apply (rule refl) + + + apply (rule ballI) + apply (rule trans[OF comp_apply]) + apply (rule sym[OF trans[OF comp_apply]]) + apply (rule arg_cong[of "(_ \ _) _"]) + apply (rule trans[OF comp_apply]) + apply (rule sym[OF trans[OF comp_apply]]) + apply (rule arg_cong[of "(_ \ _) _"]) + apply (rule sym) + apply (unfold comp_assoc[symmetric]) + apply (subst inv_o_simp2) + apply (rule assms) + apply (unfold id_o o_id) + apply (rule refl) + + apply (rule ballI impI disjI1)+ + apply (subst permute_raw_comps, (rule assms bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (subst (asm) permute_raw_comps, (rule assms bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold comp_assoc[symmetric])[1] + apply (subst inv_o_simp2, rule assms)+ + apply (unfold id_o) + apply assumption + apply (rule ballI impI disjI1)+ + apply (subst permute_raw_comps, (rule assms bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (subst (asm) permute_raw_comps, (rule assms bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold comp_assoc[symmetric])[1] + apply (subst inv_o_simp2, rule assms)+ + apply (unfold id_o) + apply assumption + + apply (rule ballI impI disjI1)+ + apply assumption + + apply (rule supp_id_bound assms bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + + done + done + +lemma alpha'_bij_eq_invs: + fixes f::"'a::var_term_pre \ 'a" + assumes "bij f" "|supp f| FVars_raw_term x \ \y. alpha_term' x y \ a \ FVars_raw_term y" + apply (subst (asm) FVars_raw_term_def) + apply (drule iffD1[OF mem_Collect_eq]) + apply (erule free_raw_term.induct) + apply (rule allI impI)+ + apply (erule alpha_term'.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) + apply (rule sym) + apply (erule term_pre.mr_rel_set[OF supp_id_bound, rotated -1, unfolded image_id]) + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (erule FVars_raw_intros) + +(* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_term'.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_rel_set(4-6)[rotated -1]) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (erule bexE) + apply (drule alpha'_bij_eq_invs[THEN iffD1, rotated -1]) + apply assumption+ + apply (erule allE) + apply (erule impE) + apply assumption + apply (subst (asm) FVars_raw_permutes, (rule bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp) + + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule term_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (rule arg_cong2[of _ _ _ _ "(\)"])+ + apply (erule term_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric]) + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (subst (asm) comp_apply)+ + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + + apply (rule trans[OF comp_apply]) + apply (rule trans) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold comp_def FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + apply assumption + apply (erule id_onD) + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply assumption + apply (erule FVars_raw_intros) + apply assumption + apply assumption +(* repeated *) + apply (rule allI impI)+ + apply (erule alpha_term'.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_rel_set(4-6)[rotated -1]) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (erule bexE) + apply (drule alpha'_bij_eq_invs[THEN iffD1, rotated -1]) + apply assumption+ + apply (erule allE) + apply (erule impE) + apply assumption + apply (subst (asm) FVars_raw_permutes, (rule bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp) + + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (frule term_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (subst (asm) o_inv_distrib inv_inv_eq, (rule bij_imp_bij_inv | assumption)+)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (rule trans) + apply (erule term_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+) + apply (rule eq_on_between[THEN eq_on_image[symmetric], rotated -3]) + apply assumption + apply assumption + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+) + + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) o_inv_distrib inv_inv_eq, (rule bij_comp bij_imp_bij_inv | assumption)+)+ + apply (erule imageE) + apply hypsubst + apply (subst (asm) comp_apply)+ + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + + apply (rule trans[OF comp_apply]) + apply (rule trans) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold comp_def FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + apply assumption + apply (erule id_onD) + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply assumption + apply (erule FVars_raw_intros) + apply assumption + apply assumption +(* repeated, free rec case *) + apply (rule allI impI)+ + apply (erule alpha_term'.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_rel_set(4-6)[rotated -1]) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule FVars_raw_intros) + apply assumption + done + +lemma alpha'_imp_alpha: "alpha_term' x y \ alpha_term x y" + apply (erule alpha_term.coinduct) + apply (erule alpha_term'.cases) + apply hypsubst + apply (rule exI)+ + apply (rule conjI, rule refl)+ + apply (rule conjI[rotated])+ + apply (erule term_pre.mr_rel_mono_strong[rotated -4]) +(* REPEAT_DETERM *) + apply (rule ballI impI disjI1)+ + apply (rule alpha'_bij_eq_invs[THEN iffD2, rotated -1]) + apply (drule alpha'_bij_eq_invs[THEN iffD1, rotated -1]) + apply assumption+ + apply (subst (asm) permute_raw_comps) + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (rule arg_cong2[OF refl, of _ _ alpha_term', THEN iffD2, rotated]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ permute_raw_term]) + apply (rule trans) + apply (rule o_inv_distrib) + prefer 3 + apply (rule arg_cong2[OF refl, of _ _ "(\)"]) + apply (rule inv_inv_eq) + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + (* repeated *) + apply (rule ballI impI disjI1)+ + apply (rule alpha'_bij_eq_invs[THEN iffD2, rotated -1]) + apply (drule alpha'_bij_eq_invs[THEN iffD1, rotated -1]) + apply assumption+ + apply (subst (asm) permute_raw_comps) + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (rule arg_cong2[OF refl, of _ _ alpha_term', THEN iffD2, rotated]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ permute_raw_term]) + apply (rule trans) + apply (rule o_inv_distrib) + prefer 3 + apply (rule arg_cong2[OF refl, of _ _ "(\)"]) + apply (rule inv_inv_eq) + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + (* repeated *) + apply (rule ballI impI disjI1)+ + apply assumption + + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (rule eq_on_comp2) + apply assumption + apply (rule arg_cong[of _ _ eq_on, THEN fun_cong, THEN fun_cong, THEN iffD2]) + apply (rule iffD1[OF inj_image_eq_iff[OF bij_is_inj], rotated]) + apply (unfold image_comp)[1] + apply (rule trans) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (rule iffD1[OF inj_image_eq_iff[OF bij_is_inj], rotated]) + apply (rule sym) + apply (rule image_f_inv_f[OF bij_is_surj]) + apply assumption + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (rule eq_on_inv2[rotated -1]) + apply assumption+ + apply (rule id_on_comp[rotated]) + apply assumption + apply (rule id_on_inv) + apply assumption + apply (rule id_on_antimono) + apply assumption + apply (rule subsetI) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (erule id_on_image[symmetric]) + apply (subst image_set_diff[OF bij_is_inj], assumption) + apply (subst (asm) image_set_diff[OF bij_is_inj], assumption) + apply (erule Diff_mono[THEN subsetD, rotated -1]) + prefer 2 + apply (rule equalityD1) + apply (rule trans) + apply (erule eq_on_image) + apply (rule sym) + apply (rule trans) + apply (erule eq_on_image) + apply (rule iffD2[OF image_inv_iff, rotated]) + apply (unfold image_comp) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (unfold image_UN) + apply (rule subsetI) + apply (erule UN_E) + apply (drule term_pre.mr_rel_set(4-6)[rotated -1]) + prefer 6 + apply assumption + apply (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply (erule bexE) + apply (rule UN_I) + apply assumption + apply (drule alpha'_FVars_leq[THEN spec, THEN mp, rotated]) + apply (rule arg_cong2[OF refl, of _ _ "(\)", THEN iffD2]) + apply (rule FVars_raw_permutes) + apply assumption+ + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + + apply (rule supp_comp_bound supp_inv_bound infinite_UNIV bij_comp bij_imp_bij_inv | assumption)+ + + apply (rule id_on_comp[rotated]) + apply assumption + apply (rule id_on_inv) + apply assumption + apply (rule id_on_antimono) + apply assumption + apply (rule arg_cong2[of _ _ _ _ "(\)", THEN iffD2]) + apply (rule id_on_image[symmetric]) + apply assumption + apply (rule id_on_image[symmetric]) + apply assumption + apply (subst image_set_diff[OF bij_is_inj], assumption)+ + apply (rule Diff_mono) + apply (unfold image_UN) + apply (rule subsetI) + apply (erule UN_E) + apply (drule term_pre.mr_rel_set(4-6)[rotated -1]) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound supp_comp_bound supp_inv_bound infinite_UNIV bij_comp bij_imp_bij_inv | assumption)+ + apply (erule bexE) + apply (rule UN_I) + apply assumption + apply (drule alpha'_FVars_leq[THEN spec, THEN mp, rotated]) + apply (rule arg_cong2[OF refl, of _ _ "(\)", THEN iffD2]) + apply (rule FVars_raw_permutes) + apply assumption+ + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (rule subsetI) + apply (erule imageE) + apply hypsubst + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) + apply (rule arg_cong2[of _ _ _ _ "(\)"])+ + apply (erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric] comp_def)[1] + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp2) + apply (rule imageI) + apply assumption + + apply (rule supp_inv_bound supp_comp_bound infinite_UNIV bij_comp bij_imp_bij_inv | assumption)+ + done + +lemma alpha'_eq_alpha: "alpha_term' x y = alpha_term x y" + apply (rule iffI) + apply (erule alpha'_imp_alpha) + apply (erule alpha_imp_alpha') + done + +lemma existential_coinduct: + fixes x y::"'a::covar_term_pre term" + shows "R x y \ (\x y. R (term_ctor x) (term_ctor y) \ \z w. + term_ctor z = term_ctor x \ term_ctor w = term_ctor y \ + mr_rel_term_pre id id id (\x y. R x y \ x = y) (\x y. R x y \ x = y) (\x y. R x y \ x = y) z w) + \ x = y" + apply (rule fresh_cases[OF emp_bound, of x]) + apply (rule fresh_cases[OF emp_bound, of y]) + apply hypsubst_thin + apply (erule thin_rl[of "_ = _"])+ + apply (erule mp[rotated]) + subgoal premises prems for x y + apply (rule impI) + apply (subst term_ctor_def)+ + apply (rule iffD2[OF TT_total_abs_eq_iffs]) + apply (rule alpha'_eq_alpha[THEN iffD1]) + apply (rule alpha_term'.coinduct[of "\x y. \x' y'. x = raw_term_ctor x' \ y = raw_term_ctor y' \ R (term_ctor (map_term_pre id id id TT_abs TT_abs TT_abs x')) (term_ctor (map_term_pre id id id TT_abs TT_abs TT_abs y'))"]) + apply (rule allI impI)+ + apply (erule conjE) + apply (drule iffD1[OF raw_term.inject])+ + apply hypsubst + apply (subst term_pre.map_comp, (rule supp_id_bound bij_id)+)+ + apply (unfold id_o o_id) + apply (erule arg_cong2[of _ _ _ _ R, THEN iffD2, rotated -1]) + (* REPEAT DETERM *) + apply (rule arg_cong[of _ _ term_ctor]) + apply (rule trans[rotated]) + apply (rule term_pre.map_ident) + apply (unfold comp_def)[1] + apply (rule term_pre.map_cong0) + apply (unfold id_def[symmetric]) + apply (rule supp_id_bound bij_id)+ + apply (rule id_apply TT_abs_rep)+ + (* repeated *) + apply (rule arg_cong[of _ _ term_ctor]) + apply (rule trans[rotated]) + apply (rule term_pre.map_ident) + apply (unfold comp_def)[1] + apply (rule term_pre.map_cong0) + apply (unfold id_def[symmetric]) + apply (rule supp_id_bound bij_id)+ + apply (rule id_apply TT_abs_rep)+ + (* END REPEAT_DETERM *) + apply (erule thin_rl) + + subgoal for x1 x2 + apply (rule raw_term.exhaust[of x1]) + apply (rule raw_term.exhaust[of x2]) + apply hypsubst_thin + apply (erule allE)+ + apply (erule impE) + apply (rule conjI) + apply (rule refl)+ + + apply (drule prems) + apply (erule exE conjE)+ + apply (drule sym) + apply (drule sym) + apply (drule iffD1[OF TT_inject0s]) + apply (erule exE conjE)+ + apply (drule iffD1[OF TT_inject0s]) + apply (erule exE conjE)+ + apply hypsubst + + apply (subst (asm) term_pre.map_comp term_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold id_o o_id image_id image_comp[unfolded comp_def]) + apply (drule term_pre.mr_rel_map(1)[THEN iffD1, rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id Grp_OO) + apply (drule term_pre.mr_rel_map(3)[THEN iffD1, rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold inv_id id_o relcompp_conversep_Grp) + + apply (rule exI)+ + apply (rule conjI, rule refl)+ + apply (rule conjI[rotated])+ + apply (erule term_pre.mr_rel_mono_strong[rotated -4]) + +(* REPEAT_DETERM *) + apply (rule ballI impI)+ + apply (erule disj_forward) + apply (rule allI impI)+ + apply (erule conjE) + apply (unfold comp_def)[1] + apply (subst (asm) permute_abs, assumption+)+ + apply (drule iffD1[OF arg_cong2[of _ _ _ _ R], rotated -1]) + apply (erule arg_cong) + apply (rotate_tac -1) + apply (erule arg_cong) + apply (unfold term_ctor_def)[1] + apply (subst term_pre.map_comp, (rule supp_id_bound bij_id)+)+ + apply (unfold id_o o_id) + + apply (rule iffD2[OF arg_cong2[of _ _ _ _ R]]) + (* REPEAT_DETERM *) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_term.intros) + apply (rule supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (unfold comp_def)[1] + apply (rule iffD2[OF term_pre.mr_rel_map(1)]) + apply (rule supp_id_bound bij_id)+ + apply (unfold Grp_OO id_o o_id term_pre.mr_rel_id[symmetric] permute_raw_ids) + apply (rule term_pre.rel_refl_strong) + apply (rule TT_rep_abs)+ + (* repeated *) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_term.intros) + apply (rule supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (unfold comp_def)[1] + apply (rule iffD2[OF term_pre.mr_rel_map(1)]) + apply (rule supp_id_bound bij_id)+ + apply (unfold Grp_OO id_o o_id term_pre.mr_rel_id[symmetric] permute_raw_ids) + apply (rule term_pre.rel_refl_strong) + apply (rule TT_rep_abs)+ + (* END REPEAT_DETERM *) + apply assumption + apply (rule iffD2[OF alpha'_eq_alpha]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) + apply assumption+ + apply (rule TT_rep_abs_syms) + apply (rule alpha_trans) + apply (unfold comp_def permute_term_def TT_total_abs_eq_iffs)[1] + apply assumption + apply (rule alpha_bij_eqs[THEN iffD2]) + apply assumption+ + apply (rule TT_rep_abs) + (* repeated *) + apply (rule ballI impI)+ + apply (erule disj_forward) + apply (rule allI impI)+ + apply (erule conjE) + apply (unfold comp_def)[1] + apply (subst (asm) permute_abs, assumption+)+ + apply (drule iffD1[OF arg_cong2[of _ _ _ _ R], rotated -1]) + apply (erule arg_cong) + apply (rotate_tac -1) + apply (erule arg_cong) + apply (unfold term_ctor_def)[1] + apply (subst term_pre.map_comp, (rule supp_id_bound bij_id)+)+ + apply (unfold id_o o_id) + + apply (rule iffD2[OF arg_cong2[of _ _ _ _ R]]) + (* REPEAT_DETERM *) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_term.intros) + apply (rule supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (unfold comp_def)[1] + apply (rule iffD2[OF term_pre.mr_rel_map(1)]) + apply (rule supp_id_bound bij_id)+ + apply (unfold Grp_OO id_o o_id term_pre.mr_rel_id[symmetric] permute_raw_ids) + apply (rule term_pre.rel_refl_strong) + apply (rule TT_rep_abs)+ + (* repeated *) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_term.intros) + apply (rule supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (unfold comp_def)[1] + apply (rule iffD2[OF term_pre.mr_rel_map(1)]) + apply (rule supp_id_bound bij_id)+ + apply (unfold Grp_OO id_o o_id term_pre.mr_rel_id[symmetric] permute_raw_ids) + apply (rule term_pre.rel_refl_strong) + apply (rule TT_rep_abs)+ + (* END REPEAT_DETERM *) + apply assumption + apply (rule iffD2[OF alpha'_eq_alpha]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) + apply assumption+ + apply (rule TT_rep_abs_syms) + apply (rule alpha_trans) + apply (unfold comp_def permute_term_def TT_total_abs_eq_iffs)[1] + apply assumption + apply (rule alpha_bij_eqs[THEN iffD2]) + apply assumption+ + apply (rule TT_rep_abs) + (* repeated, rec free case *) + apply (rule ballI impI)+ + apply (erule disj_forward) + apply (rule allI impI)+ + apply (erule conjE) + apply (drule iffD1[OF arg_cong2[of _ _ _ _ R], rotated -1]) + apply (erule arg_cong) + apply (rotate_tac -1) + apply (erule arg_cong) + apply (unfold term_ctor_def)[1] + apply (subst term_pre.map_comp, (rule supp_id_bound bij_id)+)+ + apply (unfold id_o o_id) + + apply (rule iffD2[OF arg_cong2[of _ _ _ _ R]]) + (* REPEAT_DETERM *) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_term.intros) + apply (rule supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (unfold comp_def)[1] + apply (rule iffD2[OF term_pre.mr_rel_map(1)]) + apply (rule supp_id_bound bij_id)+ + apply (unfold Grp_OO id_o o_id term_pre.mr_rel_id[symmetric] permute_raw_ids) + apply (rule term_pre.rel_refl_strong) + apply (rule TT_rep_abs)+ + (* repeated *) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_term.intros) + apply (rule supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (unfold comp_def)[1] + apply (rule iffD2[OF term_pre.mr_rel_map(1)]) + apply (rule supp_id_bound bij_id)+ + apply (unfold Grp_OO id_o o_id term_pre.mr_rel_id[symmetric] permute_raw_ids) + apply (rule term_pre.rel_refl_strong) + apply (rule TT_rep_abs)+ + (* END REPEAT_DETERM *) + apply assumption + apply (rule iffD2[OF alpha'_eq_alpha]) + apply (unfold comp_def permute_term_def TT_total_abs_eq_iffs)[1] + apply assumption + (* END REPEAT_DETERM *) + + apply (rule supp_id_bound bij_id bij_comp bij_imp_bij_inv supp_inv_bound supp_comp_bound infinite_UNIV | assumption)+ + (* REPEAT_DETERM *) + apply (erule id_on_antimono) + apply (rule Diff_mono[OF _ subset_refl]) + apply (rule UN_mono[OF subset_refl]) + apply (unfold FVars_term_def)[1] + apply (rule equalityD2) + apply (rule alpha_FVars) + apply (rule TT_rep_abs) + apply assumption+ + (* repeated *) + apply (erule id_on_antimono) + apply (rule Diff_mono[OF _ subset_refl]) + apply (rule UN_mono[OF subset_refl]) + apply (unfold FVars_term_def)[1] + apply (rule equalityD2) + apply (rule alpha_FVars) + apply (rule TT_rep_abs) + apply assumption+ + (* repeated *) + apply (erule id_on_antimono) + apply (rule Diff_mono[OF _ subset_refl]) + apply (rule UN_mono[OF subset_refl]) + apply (unfold FVars_term_def)[1] + apply (rule equalityD2) + apply (rule alpha_FVars) + apply (rule TT_rep_abs) + apply assumption+ + (* repeated *) + apply (erule id_on_antimono) + apply (rule Diff_mono[OF _ subset_refl]) + apply (rule UN_mono[OF subset_refl]) + apply (unfold FVars_term_def)[1] + apply (rule equalityD2) + apply (rule alpha_FVars) + apply (rule TT_rep_abs) + apply assumption+ + (* END REPEAT_DETERM *) + done + done + done + +lemma fresh_coinduct_param: + fixes K::"'p \ 'a::covar_term_pre set" + assumes rel: "\\\Param. R x y \" + and bound: "\\. \ \ Param \ |K \| x y \. R (term_ctor x) (term_ctor y) \ \ + set2_term_pre x \ K \ = {} \ + set3_term_pre x \ K \ = {} \ + set2_term_pre y \ K \ = {} \ + set3_term_pre y \ K \ = {} \ + \ \ Param \ mr_rel_term_pre id id id (\x y. (\\\Param. R x y \) \ x = y) (\x y. (\\\Param. R x y \) \ x = y) (\x y. (\\\Param. R x y \) \ x = y) x y" + shows "x = y" + apply (rule existential_coinduct[of "\x y. \\\Param. R x y \" x y, OF rel]) + apply (erule bexE) + subgoal for x y \ + apply (rule fresh_cases[of _ "term_ctor x", rotated]) + apply (rule fresh_cases[of _ "term_ctor y", rotated]) + apply (rule exI)+ + apply (rule conjI, erule sym)+ + apply (rule IH) + apply (rule arg_cong3[OF _ _ refl, of _ _ _ _ R, THEN iffD2]) + apply (erule sym)+ + apply assumption+ + apply (rule bound) + apply assumption + apply (rule bound) + apply assumption + done + done + +end \ No newline at end of file diff --git a/operations/Least_Fixpoint.thy b/operations/Least_Fixpoint.thy new file mode 100644 index 00000000..16cf610d --- /dev/null +++ b/operations/Least_Fixpoint.thy @@ -0,0 +1,6880 @@ +theory Least_Fixpoint + imports "./Composition" "Binders.MRBNF_FP" +begin + +typ "('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k) T1_pre" +typ "('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k) T2_pre" +(* +'a, 'b free +'c passive free +'d passive live +'e, 'f bound +'g bound free +'h, 'i, 'j, 'k live + *) + +(************* DEFINITIONS *****************) + +datatype ('a::"{var_T1_pre,var_T2_pre}", 'b::"{var_T1_pre,var_T2_pre}", 'c::"{var_T1_pre,var_T2_pre}", 'd) raw_T1 = + raw_T1_ctor "('a, 'b, 'c, 'd, 'a, 'b, 'a, + ('a, 'b, 'c, 'd) raw_T1, ('a, 'b, 'c, 'd) raw_T1, + ('a, 'b, 'c, 'd) raw_T2, ('a, 'b, 'c, 'd) raw_T2 + ) T1_pre" + and ('a, 'b, 'c, 'd) raw_T2 = + raw_T2_ctor "('a, 'b, 'c, 'd, 'a, 'b, 'a, + ('a, 'b, 'c, 'd) raw_T1, ('a, 'b, 'c, 'd) raw_T1, + ('a, 'b, 'c, 'd) raw_T2, ('a, 'b, 'c, 'd) raw_T2 + ) T2_pre" + +primrec permute_raw_T1 :: "('a::{var_T1_pre,var_T2_pre} \ 'a) \ ('b::{var_T1_pre,var_T2_pre} \ 'b) + \ ('a, 'b, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 \ ('a, 'b, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and permute_raw_T2 :: "('a::{var_T1_pre,var_T2_pre} \ 'a) \ ('b::{var_T1_pre,var_T2_pre} \ 'b) + \ ('a, 'b, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2 \ ('a, 'b, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" where + "permute_raw_T1 f1 f2 (raw_T1_ctor x) = raw_T1_ctor (map_T1_pre f1 f2 id id f1 f2 f1 id id id id ( + map_T1_pre id id id id id id id (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x +))" +| "permute_raw_T2 f1 f2 (raw_T2_ctor x) = raw_T2_ctor (map_T2_pre f1 f2 id id f1 f2 f1 id id id id ( + map_T2_pre id id id id id id id (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x +))" + (* we have to define the permute function with two maps because +we need to separate recursion from other actions for primrec *) + +(* we can derive the desired simplification rule using composition of map *) +lemma permute_raw_simps: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + assumes "bij f1" "|supp f1| ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 \ bool" + and free1_raw_T2 :: "'a \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2 \ bool" + where + "a \ set1_T1_pre x \ free1_raw_T1 a (raw_T1_ctor x)" + | "a \ set7_T1_pre x \ a \ set5_T1_pre x \ free1_raw_T1 a (raw_T1_ctor x)" + | "z \ set8_T1_pre x \ free1_raw_T1 a z \ free1_raw_T1 a (raw_T1_ctor x)" + | "z \ set9_T1_pre x \ free1_raw_T1 a z \ a \ set5_T1_pre x \ free1_raw_T1 a (raw_T1_ctor x)" + | "z \ set10_T1_pre x \ free1_raw_T2 a z \ free1_raw_T1 a (raw_T1_ctor x)" + | "z \ set11_T1_pre x \ free1_raw_T2 a z \ a \ set5_T1_pre x \ free1_raw_T1 a (raw_T1_ctor x)" + | "a \ set1_T2_pre x2 \ free1_raw_T2 a (raw_T2_ctor x2)" + | "a \ set7_T2_pre x2 \ a \ set5_T2_pre x2 \ free1_raw_T2 a (raw_T2_ctor x2)" + | "z \ set8_T2_pre x2 \ free1_raw_T1 a z \ free1_raw_T2 a (raw_T2_ctor x2)" + | "z \ set9_T2_pre x2 \ free1_raw_T1 a z \ a \ set5_T2_pre x2 \ free1_raw_T2 a (raw_T2_ctor x2)" + | "z \ set10_T2_pre x2 \ free1_raw_T2 a z \ free1_raw_T2 a (raw_T2_ctor x2)" + | "z \ set11_T2_pre x2 \ free1_raw_T2 a z \ a \ set5_T2_pre x2 \ free1_raw_T2 a (raw_T2_ctor x2)" + +inductive + free2_raw_T1 :: "'b \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 \ bool" + and free2_raw_T2 :: "'b \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2 \ bool" + where + "a \ set2_T1_pre x \ free2_raw_T1 a (raw_T1_ctor x)" + | "z \ set8_T1_pre x \ free2_raw_T1 a z \ free2_raw_T1 a (raw_T1_ctor x)" + | "z \ set9_T1_pre x \ free2_raw_T1 a z \ a \ set6_T1_pre x \ free2_raw_T1 a (raw_T1_ctor x)" + | "z \ set10_T1_pre x \ free2_raw_T2 a z \ free2_raw_T1 a (raw_T1_ctor x)" + | "z \ set11_T1_pre x \ free2_raw_T2 a z \ free2_raw_T1 a (raw_T1_ctor x)" + | "a \ set2_T2_pre x2 \ free2_raw_T2 a (raw_T2_ctor x2)" + | "z \ set8_T2_pre x2 \ free2_raw_T1 a z \ free2_raw_T2 a (raw_T2_ctor x2)" + | "z \ set9_T2_pre x2 \ free2_raw_T1 a z \ a \ set6_T2_pre x2 \ free2_raw_T2 a (raw_T2_ctor x2)" + | "z \ set10_T2_pre x2 \ free2_raw_T2 a z \ free2_raw_T2 a (raw_T2_ctor x2)" + | "z \ set11_T2_pre x2 \ free2_raw_T2 a z \ free2_raw_T2 a (raw_T2_ctor x2)" + +definition FVars_raw_T11 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 \ 'a set" + where "FVars_raw_T11 x \ { a. free1_raw_T1 a x }" +definition FVars_raw_T12 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 \ 'b set" + where "FVars_raw_T12 x \ { a. free2_raw_T1 a x }" +definition FVars_raw_T21 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2 \ 'a set" + where "FVars_raw_T21 x \ { a. free1_raw_T2 a x }" +definition FVars_raw_T22 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2 \ 'b set" + where "FVars_raw_T22 x \ { a. free2_raw_T2 a x }" + +lemmas FVars_raw_defs = FVars_raw_T11_def FVars_raw_T12_def FVars_raw_T21_def FVars_raw_T22_def + +coinductive alpha_T1 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 \ ('a, 'b, 'c, 'd) raw_T1 \ bool" +and alpha_T2 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2 \ ('a, 'b, 'c, 'd) raw_T2 \ bool" +where + "\ bij f1 ; |supp f1| (\(FVars_raw_T11 ` set9_T1_pre x) - set5_T1_pre x) \ (\(FVars_raw_T21 ` set11_T1_pre x) - set5_T1_pre x)) f1 ; + id_on (\(FVars_raw_T12 ` set9_T1_pre x) - set6_T1_pre x) f2 ; + mr_rel_T1_pre id id id (=) f1 f2 f1 alpha_T1 (\x. alpha_T1 (permute_raw_T1 f1 f2 x)) alpha_T2 (\x. alpha_T2 (permute_raw_T2 f1 id x)) x y +\ \ alpha_T1 (raw_T1_ctor x) (raw_T1_ctor y)" +| "\ bij f1 ; |supp f1| (\(FVars_raw_T11 ` set9_T2_pre x) - set5_T2_pre x) \ (\(FVars_raw_T21 ` set11_T2_pre x) - set5_T2_pre x)) f1 ; + id_on (\(FVars_raw_T12 ` set9_T2_pre x) - set6_T2_pre x) f2 ; + mr_rel_T2_pre id id id (=) f1 f2 f1 alpha_T1 (\x. alpha_T1 (permute_raw_T1 f1 f2 x)) alpha_T2 (\x. alpha_T2 (permute_raw_T2 f1 id x)) x y +\ \ alpha_T2 (raw_T2_ctor x) (raw_T2_ctor y)" + monos + conj_context_mono + T1_pre.mr_rel_mono[OF supp_id_bound supp_id_bound supp_id_bound] + T2_pre.mr_rel_mono[OF supp_id_bound supp_id_bound supp_id_bound] + +type_synonym ('a, 'b, 'c, 'd) raw_T1' = "('a, 'b, 'c, 'd, 'a, 'b, 'a, ('a, 'b, 'c, 'd) raw_T1, ('a, 'b, 'c, 'd) raw_T1, ('a, 'b, 'c, 'd) raw_T2, ('a, 'b, 'c, 'd) raw_T2) T1_pre" +type_synonym ('a, 'b, 'c, 'd) raw_T2' = "('a, 'b, 'c, 'd, 'a, 'b, 'a, ('a, 'b, 'c, 'd) raw_T1, ('a, 'b, 'c, 'd) raw_T1, ('a, 'b, 'c, 'd) raw_T2, ('a, 'b, 'c, 'd) raw_T2) T2_pre" + +typedef ('a::"{var_T1_pre,var_T2_pre}", 'b::"{var_T1_pre,var_T2_pre}", 'c::"{var_T1_pre,var_T2_pre}", 'd) T1 = "(UNIV :: ('a, 'b, 'c, 'd) raw_T1 set) // {(x, y). alpha_T1 x y}" + apply (rule exI) + apply (rule quotientI) + apply (rule UNIV_I) + done + +typedef ('a::"{var_T1_pre,var_T2_pre}", 'b::"{var_T1_pre,var_T2_pre}", 'c::"{var_T1_pre,var_T2_pre}", 'd) T2 = "(UNIV :: ('a, 'b, 'c, 'd) raw_T2 set) // {(x, y). alpha_T2 x y}" + apply (rule exI) + apply (rule quotientI) + apply (rule UNIV_I) + done + +abbreviation "TT1_abs \ quot_type.abs alpha_T1 Abs_T1" +abbreviation "TT1_rep \ quot_type.rep Rep_T1" + +abbreviation "TT2_abs \ quot_type.abs alpha_T2 Abs_T2" +abbreviation "TT2_rep \ quot_type.rep Rep_T2" + +type_synonym ('a, 'b, 'c, 'd) T1' = "('a, 'b, 'c, 'd, 'a, 'b, 'a, ('a, 'b, 'c, 'd) T1, ('a, 'b, 'c, 'd) T1, ('a, 'b, 'c, 'd) T2, ('a, 'b, 'c, 'd) T2) T1_pre" +type_synonym ('a, 'b, 'c, 'd) T2' = "('a, 'b, 'c, 'd, 'a, 'b, 'a, ('a, 'b, 'c, 'd) T1, ('a, 'b, 'c, 'd) T1, ('a, 'b, 'c, 'd) T2, ('a, 'b, 'c, 'd) T2) T2_pre" + +definition T1_ctor :: "('a, 'b, 'c, 'd) T1' \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1" + where "T1_ctor x \ TT1_abs (raw_T1_ctor (map_T1_pre id id id id id id id TT1_rep TT1_rep TT2_rep TT2_rep x))" +definition T2_ctor :: "('a, 'b, 'c, 'd) T2' \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2" + where "T2_ctor x \ TT2_abs (raw_T2_ctor (map_T2_pre id id id id id id id TT1_rep TT1_rep TT2_rep TT2_rep x))" + +definition permute_T1 :: "('a \ 'a) \ ('b \ 'b) \ ('a, 'b, 'c, 'd) T1 \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1" + where "permute_T1 f1 f2 x \ TT1_abs (permute_raw_T1 f1 f2 (TT1_rep x))" +definition permute_T2 :: "('a \ 'a) \ ('b \ 'b) \ ('a, 'b, 'c, 'd) T2 \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2" + where "permute_T2 f1 f2 x \ TT2_abs (permute_raw_T2 f1 f2 (TT2_rep x))" + +definition FVars_T11 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1 \ 'a set" + where "FVars_T11 x \ FVars_raw_T11 (TT1_rep x)" +definition FVars_T12 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1 \ 'b set" + where "FVars_T12 x \ FVars_raw_T12 (TT1_rep x)" +definition FVars_T21 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2 \ 'a set" + where "FVars_T21 x \ FVars_raw_T21 (TT2_rep x)" +definition FVars_T22 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2 \ 'b set" + where "FVars_T22 x \ FVars_raw_T22 (TT2_rep x)" + +lemmas FVars_defs = FVars_T11_def FVars_T12_def FVars_T21_def FVars_T22_def + +inductive subshape_T1_T1 :: "('a, 'b, 'c, 'd) raw_T1 \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 \ bool" + and subshape_T2_T1 :: "('a, 'b, 'c, 'd) raw_T2 \ ('a, 'b, 'c, 'd) raw_T1 \ bool" + and subshape_T1_T2 :: "('a, 'b, 'c, 'd) raw_T1 \ ('a, 'b, 'c, 'd) raw_T2 \ bool" + and subshape_T2_T2 :: "('a, 'b, 'c, 'd) raw_T2 \ ('a, 'b, 'c, 'd) raw_T2 \ bool" + where + "\ bij f1 ; |supp f1| set8_T1_pre x \ set9_T1_pre x \ \ subshape_T1_T1 y (raw_T1_ctor x)" +| "\ bij f1 ; |supp f1| set10_T1_pre x \ set11_T1_pre x \ \ subshape_T2_T1 y (raw_T1_ctor x)" +| "\ bij f1 ; |supp f1| set8_T2_pre x \ set9_T2_pre x \ \ subshape_T1_T2 y (raw_T2_ctor x)" +| "\ bij f1 ; |supp f1| set10_T2_pre x \ set11_T2_pre x \ \ subshape_T2_T2 y (raw_T2_ctor x)" + +lemmas subshape_intros = subshape_T1_T1_subshape_T2_T1_subshape_T1_T2_subshape_T2_T2.intros +lemmas subshape_elims = subshape_T1_T1.cases subshape_T2_T1.cases subshape_T1_T2.cases subshape_T2_T2.cases + +definition noclash_raw_T1 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1' \ bool" + where "noclash_raw_T1 x \ set5_T1_pre x \ (set1_T1_pre x \ \(FVars_raw_T11 ` set8_T1_pre x) \ \(FVars_raw_T21 ` set10_T1_pre x)) = {} + \ set6_T1_pre x \ (set2_T1_pre x \ \(FVars_raw_T12 ` set8_T1_pre x) \ \(FVars_raw_T22 ` set10_T1_pre x) \ \(FVars_raw_T22 ` set11_T1_pre x)) = {}" +definition noclash_raw_T2 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2' \ bool" + where "noclash_raw_T2 x \ set5_T2_pre x \ (set1_T2_pre x \ \(FVars_raw_T11 ` set8_T2_pre x) \ \(FVars_raw_T21 ` set10_T2_pre x)) = {} + \ set6_T2_pre x \ (set2_T2_pre x \ \(FVars_raw_T12 ` set8_T2_pre x) \ \(FVars_raw_T22 ` set10_T2_pre x) \ \(FVars_raw_T22 ` set11_T2_pre x)) = {}" + +definition noclash_T1 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1' \ bool" + where "noclash_T1 x \ set5_T1_pre x \ (set1_T1_pre x \ \(FVars_T11 ` set8_T1_pre x) \ \(FVars_T21 ` set10_T1_pre x)) = {} + \ set6_T1_pre x \ (set2_T1_pre x \ \(FVars_T12 ` set8_T1_pre x) \ \(FVars_T22 ` set10_T1_pre x) \ \(FVars_T22 ` set11_T1_pre x)) = {}" +definition noclash_T2 :: "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2' \ bool" + where "noclash_T2 x \ set5_T2_pre x \ (set1_T2_pre x \ \(FVars_T11 ` set8_T2_pre x) \ \(FVars_T21 ` set10_T2_pre x)) = {} + \ set6_T2_pre x \ (set2_T2_pre x \ \(FVars_T12 ` set8_T2_pre x) \ \(FVars_T22 ` set10_T2_pre x) \ \(FVars_T22 ` set11_T2_pre x)) = {}" + +(************* PROOFS *****************) + +lemma permute_raw_ids: + fixes x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + shows "permute_raw_T1 id id x = x" (is ?P1) + "permute_raw_T2 id id x2 = x2" (is ?P2) +proof - + have x: "?P1 \ ?P2" + apply (rule raw_T1_raw_T2.induct[of _ _ x x2]) + (* REPEAT_DETERM *) + apply (rule trans) + apply (rule permute_raw_simps) + apply (rule bij_id supp_id_bound)+ + apply (rule trans) + apply (rule arg_cong[of _ _ raw_T1_ctor]) + apply (rule trans[rotated]) + apply (rule T1_pre.map_id) + apply (rule T1_pre.map_cong) + apply (rule bij_id supp_id_bound)+ + apply (rule refl trans[OF _ id_apply[symmetric]] | assumption)+ + (* repeated *) + apply (rule trans) + apply (rule permute_raw_simps) + apply (rule bij_id supp_id_bound)+ + apply (rule trans) + apply (rule arg_cong[of _ _ raw_T2_ctor]) + apply (rule trans[rotated]) + apply (rule T2_pre.map_id) + apply (rule T2_pre.map_cong) + apply (rule bij_id supp_id_bound)+ + apply (rule refl trans[OF _ id_apply[symmetric]] | assumption)+ + done + show ?P1 by (rule conjunct1[OF x]) + show ?P2 by (rule conjunct2[OF x]) +qed + +lemmas permute_raw_id0s = permute_raw_ids[abs_def, unfolded id_def[symmetric], THEN meta_eq_to_obj_eq] + +lemma permute_raw_comps: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and g1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and g2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + assumes "bij f1" "|supp f1| f1) (g2 \ f2) x" (is ?P1) + "permute_raw_T2 g1 g2 (permute_raw_T2 f1 f2 x2) = permute_raw_T2 (g1 \ f1) (g2 \ f2) x2" (is ?P2) +proof - + have x: "?P1 \ ?P2" + apply (rule raw_T1_raw_T2.induct[of _ _ x x2]) + (* REPEAT_DETERM *) + apply (subst permute_raw_simps) + apply (rule assms)+ + apply (subst permute_raw_simps) + apply (rule assms)+ + apply (subst T1_pre.map_comp) + apply (rule assms supp_id_bound bij_id)+ + apply (unfold id_o o_id) + apply (subst permute_raw_simps) + apply (rule bij_comp supp_comp_bound infinite_UNIV assms)+ + apply (rule arg_cong[OF T1_pre.map_cong]) + apply (rule bij_comp supp_comp_bound infinite_UNIV assms supp_id_bound bij_id)+ + apply (rule refl trans[OF comp_apply] | assumption)+ + (* repeated *) + apply (subst permute_raw_simps) + apply (rule assms)+ + apply (subst permute_raw_simps) + apply (rule assms)+ + apply (subst T2_pre.map_comp) + apply (rule assms supp_id_bound bij_id)+ + apply (unfold id_o o_id) + apply (subst permute_raw_simps) + apply (rule bij_comp supp_comp_bound infinite_UNIV assms)+ + apply (rule arg_cong[OF T2_pre.map_cong]) + apply (rule bij_comp supp_comp_bound infinite_UNIV assms supp_id_bound bij_id)+ + apply (rule refl trans[OF comp_apply] | assumption)+ + done + + show ?P1 by (rule conjunct1[OF x]) + show ?P2 by (rule conjunct2[OF x]) +qed + +lemma permute_raw_comp0s: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and g1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and g2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + assumes "bij f1" "|supp f1| permute_raw_T1 f1 f2 = permute_raw_T1 (g1 \ f1) (g2 \ f2)" + "permute_raw_T2 g1 g2 \ permute_raw_T2 f1 f2 = permute_raw_T2 (g1 \ f1) (g2 \ f2)" + apply (rule ext) + apply (rule trans[OF comp_apply]) + apply (rule permute_raw_comps) + apply (rule assms)+ + (* repeated *) + apply (rule ext) + apply (rule trans[OF comp_apply]) + apply (rule permute_raw_comps) + apply (rule assms)+ + done + +lemma FVars_raw_intros: + "a \ set1_T1_pre x \ a \ FVars_raw_T11 (raw_T1_ctor x)" + "a \ set7_T1_pre x \ a \ set5_T1_pre x \ a \ FVars_raw_T11 (raw_T1_ctor x)" + "z \ set8_T1_pre x \ a \ FVars_raw_T11 z \ a \ FVars_raw_T11 (raw_T1_ctor x)" + "z \ set9_T1_pre x \ a \ FVars_raw_T11 z \ a \ set5_T1_pre x \ a \ FVars_raw_T11 (raw_T1_ctor x)" + "z2 \ set10_T1_pre x \ a \ FVars_raw_T21 z2 \ a \ FVars_raw_T11 (raw_T1_ctor x)" + "z2 \ set11_T1_pre x \ a \ FVars_raw_T21 z2 \ a \ set5_T1_pre x \ a \ FVars_raw_T11 (raw_T1_ctor x)" + "a \ set1_T2_pre x2 \ a \ FVars_raw_T21 (raw_T2_ctor x2)" + "a \ set7_T2_pre x2 \ a \ set5_T2_pre x2 \ a \ FVars_raw_T21 (raw_T2_ctor x2)" + "z \ set8_T2_pre x2 \ a \ FVars_raw_T11 z \ a \ FVars_raw_T21 (raw_T2_ctor x2)" + "z \ set9_T2_pre x2 \ a \ FVars_raw_T11 z \ a \ set5_T2_pre x2 \ a \ FVars_raw_T21 (raw_T2_ctor x2)" + "z2 \ set10_T2_pre x2 \ a \ FVars_raw_T21 z2 \ a \ FVars_raw_T21 (raw_T2_ctor x2)" + "z2 \ set11_T2_pre x2 \ a \ FVars_raw_T21 z2 \ a \ set5_T2_pre x2 \ a \ FVars_raw_T21 (raw_T2_ctor x2)" + "b \ set2_T1_pre x \ b \ FVars_raw_T12 (raw_T1_ctor x)" + "z \ set8_T1_pre x \ b \ FVars_raw_T12 z \ b \ FVars_raw_T12 (raw_T1_ctor x)" + "z \ set9_T1_pre x \ b \ FVars_raw_T12 z \ b \ set6_T1_pre x \ b \ FVars_raw_T12 (raw_T1_ctor x)" + "z2 \ set10_T1_pre x \ b \ FVars_raw_T22 z2 \ b \ FVars_raw_T12 (raw_T1_ctor x)" + "z2 \ set11_T1_pre x \ b \ FVars_raw_T22 z2 \ b \ FVars_raw_T12 (raw_T1_ctor x)" + "b \ set2_T2_pre x2 \ b \ FVars_raw_T22 (raw_T2_ctor x2)" + "z \ set8_T2_pre x2 \ b \ FVars_raw_T12 z \ b \ FVars_raw_T22 (raw_T2_ctor x2)" + "z \ set9_T2_pre x2 \ b \ FVars_raw_T12 z \ b \ set6_T2_pre x2 \ b \ FVars_raw_T22 (raw_T2_ctor x2)" + "z2 \ set10_T2_pre x2 \ b \ FVars_raw_T22 z2 \ b \ FVars_raw_T22 (raw_T2_ctor x2)" + "z2 \ set11_T2_pre x2 \ b \ FVars_raw_T22 z2 \ b \ FVars_raw_T22 (raw_T2_ctor x2)" + apply (unfold FVars_raw_defs mem_Collect_eq Un_iff de_Morgan_disj) + apply (erule free1_raw_T1_free1_raw_T2.intros free2_raw_T1_free2_raw_T2.intros, (assumption+)?)+ + done + +lemma FVars_raw_ctors: + "FVars_raw_T11 (raw_T1_ctor x) = set1_T1_pre x \ (set7_T1_pre x - set5_T1_pre x) \ \(FVars_raw_T11 ` set8_T1_pre x) + \ (\(FVars_raw_T11 ` set9_T1_pre x) - set5_T1_pre x) \ \(FVars_raw_T21 ` set10_T1_pre x) + \ (\(FVars_raw_T21 ` set11_T1_pre x) - set5_T1_pre x)" + "FVars_raw_T12 (raw_T1_ctor x) = set2_T1_pre x \ \(FVars_raw_T12 ` set8_T1_pre x) + \ (\(FVars_raw_T12 ` set9_T1_pre x) - set6_T1_pre x) \ \(FVars_raw_T22 ` set10_T1_pre x) + \ (\(FVars_raw_T22 ` set11_T1_pre x))" + "FVars_raw_T21 (raw_T2_ctor x2) = set1_T2_pre x2 \ (set7_T2_pre x2 - set5_T2_pre x2) \ \(FVars_raw_T11 ` set8_T2_pre x2) + \ (\(FVars_raw_T11 ` set9_T2_pre x2) - set5_T2_pre x2) \ \(FVars_raw_T21 ` set10_T2_pre x2) + \ (\(FVars_raw_T21 ` set11_T2_pre x2) - set5_T2_pre x2)" + "FVars_raw_T22 (raw_T2_ctor x2) = set2_T2_pre x2 \ \(FVars_raw_T12 ` set8_T2_pre x2) + \ (\(FVars_raw_T12 ` set9_T2_pre x2) - set6_T2_pre x2) \ \(FVars_raw_T22 ` set10_T2_pre x2) + \ (\(FVars_raw_T22 ` set11_T2_pre x2))" + apply (unfold FVars_raw_defs) + (* goal 1 *) + apply (rule subset_antisym) + apply (rule subsetI) + apply (erule CollectE) + apply (erule free1_raw_T1.cases) + (* REPEAT_DETERM *) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 1] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 2] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 3] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 4] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 5] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 6] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* END REPEAT_DETERM *) + apply (rule subsetI) + apply (erule UnE)+ + (* REPEAT_DETERM *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE)? + apply (erule free1_raw_T1_free1_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE)? + apply (erule free1_raw_T1_free1_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE)? + apply (erule free1_raw_T1_free1_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free1_raw_T1_free1_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free1_raw_T1_free1_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free1_raw_T1_free1_raw_T2.intros) + apply (assumption+)? + (* END REPEAT_DETERM *) + (* next goal, same tactic *) + apply (rule subset_antisym) + apply (rule subsetI) + apply (erule CollectE) + apply (erule free2_raw_T1.cases) + (* REPEAT_DETERM *) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 1] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 2] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 3] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 4] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 5] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* END REPEAT_DETERM *) + apply (rule subsetI) + apply (erule UnE)+ + (* REPEAT_DETERM *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE)? + apply (erule free2_raw_T1_free2_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free2_raw_T1_free2_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free2_raw_T1_free2_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free2_raw_T1_free2_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free2_raw_T1_free2_raw_T2.intros) + apply (assumption+)? + (* END REPEAT_DETERM *) + (* next goal, same tactic *) + apply (rule subset_antisym) + apply (rule subsetI) + apply (erule CollectE) + apply (erule free1_raw_T2.cases) + (* REPEAT_DETERM *) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 1] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 2] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 3] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 4] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 5] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 6] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* END REPEAT_DETERM *) + apply (rule subsetI) + apply (erule UnE)+ + (* REPEAT_DETERM *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE)? + apply (erule free1_raw_T1_free1_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE)? + apply (erule free1_raw_T1_free1_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE)? + apply (erule free1_raw_T1_free1_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free1_raw_T1_free1_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free1_raw_T1_free1_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free1_raw_T1_free1_raw_T2.intros) + apply (assumption+)? + (* END REPEAT_DETERM *) + (* next goal, same tactic *) + apply (rule subset_antisym) + apply (rule subsetI) + apply (erule CollectE) + apply (erule free2_raw_T2.cases) + (* REPEAT_DETERM *) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 1] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 2] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 3] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 4] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 5] 1\) + apply (rule DiffI[rotated], assumption)? + apply (rule UN_I, assumption, rule CollectI)? + apply assumption + (* END REPEAT_DETERM *) + apply (rule subsetI) + apply (erule UnE)+ + (* REPEAT_DETERM *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE)? + apply (erule free2_raw_T1_free2_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free2_raw_T1_free2_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free2_raw_T1_free2_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free2_raw_T1_free2_raw_T2.intros) + apply (assumption+)? + (* repeated *) + apply (rule CollectI) + apply (erule DiffE)? + apply (erule UN_E, erule CollectE) + apply (erule free2_raw_T1_free2_raw_T2.intros) + apply (assumption+)? + (* END REPEAT_DETERM *) + done + +lemma FVars_raw_permute_leq: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + assumes "bij f1" "|supp f1| f1 z \ FVars_raw_T11 (permute_raw_T1 f1 f2 x)" (is "_ \ ?P11") + "free2_raw_T1 z2 x \ f2 z2 \ FVars_raw_T12 (permute_raw_T1 f1 f2 x)" (is "_ \ ?P12") + "free1_raw_T2 z x2 \ f1 z \ FVars_raw_T21 (permute_raw_T2 f1 f2 x2)" (is "_ \ ?P21") + "free2_raw_T2 z2 x2 \ f2 z2 \ FVars_raw_T22 (permute_raw_T2 f1 f2 x2)" (is "_ \ ?P22") +proof - + have x1: "(free1_raw_T1 z x \ ?P11) \ (free1_raw_T2 z x2 \ ?P21)" + apply (rule free1_raw_T1_free1_raw_T2.induct[of _ _ _ x _ x2]) + (* REPEAT_DETERM *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 1] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 2] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 3] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 4] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 5] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 6] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated, but starting from 1 again *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 1] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 2] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 3] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 4] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 5] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 6 6] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + done + + have x2: "(free2_raw_T1 z2 x \ ?P12) \ (free2_raw_T2 z2 x2 \ ?P22)" + apply (rule free2_raw_T1_free2_raw_T2.induct[of _ _ _ x _ x2]) + (* REPEAT_DETERM *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 1] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 2] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 3] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 4] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 5] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated, but starting from 1 again *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 1] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 2] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 3] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 4] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst T1_pre.set_map T2_pre.set_map, (rule supp_id_bound bij_id assms)+)+ + apply (unfold image_comp) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 5 5] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption, subst comp_apply)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + done + + show + "free1_raw_T1 z x \ ?P11" + "free2_raw_T1 z2 x \ ?P12" + "free1_raw_T2 z x2 \ ?P21" + "free2_raw_T2 z2 x2 \ ?P22" + apply (erule mp[OF conjunct1[OF x1]]) + apply (erule mp[OF conjunct1[OF x2]]) + apply (erule mp[OF conjunct2[OF x1]]) + apply (erule mp[OF conjunct2[OF x2]]) + done +qed + +lemma FVars_raw_permutes: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + assumes "bij f1" "|supp f1| ?P21" + apply (rule raw_T1_raw_T2.induct[of _ _ x x2]) + apply (unfold FVars_raw_ctors) + apply (rule Un_bound T1_pre.set_bd T2_pre.set_bd UN_bound + ordLeq_ordLess_trans[OF card_of_diff] | assumption)+ + done + have x2: "?P12 \ ?P22" + apply (rule raw_T1_raw_T2.induct[of _ _ x x2]) + apply (unfold FVars_raw_ctors) + apply (rule Un_bound T1_pre.set_bd T2_pre.set_bd UN_bound + ordLeq_ordLess_trans[OF card_of_diff] | assumption)+ + done + show ?P11 by (rule conjunct1[OF x1]) + show ?P12 by (rule conjunct1[OF x2]) + show ?P21 by (rule conjunct2[OF x1]) + show ?P22 by (rule conjunct2[OF x2]) +qed + +lemmas FVars_raw_bd_UNIVs = FVars_raw_bds[THEN ordLess_ordLeq_trans, OF var_T1_pre_class.large] + +lemma alpha_refls: + fixes x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + shows "alpha_T1 x x" "alpha_T2 x2 x2" +proof - + have x: "(\(x::('a, 'b, 'c, 'd) raw_T1) y. x = y \ alpha_T1 x y) \ (\(x::('a, 'b, 'c, 'd) raw_T2) y. x = y \ alpha_T2 x y)" + apply (rule alpha_T1_alpha_T2.coinduct) + (* REPEAT_DETERM *) + apply hypsubst_thin + apply (unfold triv_forall_equality) + subgoal for x + apply (rule raw_T1.exhaust[of x]) + apply hypsubst_thin + apply (rule exI)+ + apply (rule conjI, rule refl supp_id_bound bij_id id_on_id)+ + apply (unfold mr_rel_T1_pre_def T1_pre.map_id permute_raw_ids) + apply (rule T1_pre.rel_refl_strong) + apply (rule refl disjI1)+ + done + (* repeated *) + subgoal for x y + apply (rule raw_T2.exhaust[of x]) + apply (rule raw_T2.exhaust[of y]) + apply hypsubst_thin + apply (rule exI)+ + apply (rule conjI, rule refl supp_id_bound bij_id id_on_id)+ + apply (unfold mr_rel_T2_pre_def T2_pre.map_id permute_raw_ids) + apply (rule T2_pre.rel_refl_strong) + apply (rule refl disjI1)+ + done + done + + show "alpha_T1 x x" by (rule conjunct1[OF x, THEN spec, THEN spec, THEN mp[OF _ refl]]) + show "alpha_T2 x2 x2" by (rule conjunct2[OF x, THEN spec, THEN spec, THEN mp[OF _ refl]]) +qed + +lemma alpha_bijs: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and g1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and g2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + assumes f_prems: "bij f1" "|supp f1| eq_on (FVars_raw_T12 x) f2 g2 \ alpha_T1 x y \ alpha_T1 (permute_raw_T1 f1 f2 x) (permute_raw_T1 g1 g2 y)" + "eq_on (FVars_raw_T21 x2) f1 g1 \ eq_on (FVars_raw_T22 x2) f2 g2 \ alpha_T2 x2 y2 \ alpha_T2 (permute_raw_T2 f1 f2 x2) (permute_raw_T2 g1 g2 y2)" +proof - + have x: "(\(x::('a, 'b, 'c, 'd) raw_T1) y. (\x' y' f1 f2 g1 g2. + bij f1 \ |supp f1| bij f2 \ |supp f2| bij g1 \ |supp g1| bij g2 \ |supp g2| x = permute_raw_T1 f1 f2 x' \ y = permute_raw_T1 g1 g2 y' \ eq_on (FVars_raw_T11 x') f1 g1 \ eq_on (FVars_raw_T12 x') f2 g2 \ alpha_T1 x' y') \ alpha_T1 x y + ) \ (\(x2::('a, 'b, 'c, 'd) raw_T2) y2. (\x2' y2' f1 f2 g1 g2. + bij f1 \ |supp f1| bij f2 \ |supp f2| bij g1 \ |supp g1| bij g2 \ |supp g2| x2 = permute_raw_T2 f1 f2 x2' \ y2 = permute_raw_T2 g1 g2 y2' \ eq_on (FVars_raw_T21 x2') f1 g1 \ eq_on (FVars_raw_T22 x2') f2 g2 \ alpha_T2 x2' y2') \ alpha_T2 x2 y2)" + apply (rule alpha_T1_alpha_T2.coinduct) + apply (erule exE conjE)+ + apply (erule alpha_T1.cases) + apply hypsubst + apply (unfold triv_forall_equality) + subgoal for f1 f2 g1 g2 \1 \2 x y + apply (rule exI[of _ "g1 \ \1 \ inv f1"]) + apply (rule exI[of _ "g2 \ \2 \ inv f2"]) + apply (rule exI)+ + apply (rule conjI, rule permute_raw_simps, (rule supp_id_bound bij_id | assumption)+)+ + apply (rule conjI, (rule bij_comp supp_comp_bound bij_imp_bij_inv supp_inv_bound infinite_UNIV | assumption)+)+ + + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_comp[unfolded comp_def]) + apply (subst FVars_raw_permutes, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_UN[symmetric]) + apply (subst image_set_diff[OF bij_is_inj, symmetric], assumption)+ + + apply (unfold image_Un[symmetric]) + (* REPEAT_DETERM *) + apply (rule conjI) + apply (rule id_onI) + apply (erule imageE) + apply hypsubst + apply (rule trans) + apply (rule comp_apply) + apply (subst inv_simp1) + apply assumption + apply (rule trans) + apply (rule comp_apply) + apply (rule trans) + apply (rule arg_cong[of _ _ g1]) + apply (erule id_onD) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply ((erule UnE)+)? + (* REPEAT_DETERM *) + apply (erule DiffE) + apply (erule UN_E)? + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (erule DiffE) + apply (erule UN_E)? + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (erule DiffE) + apply (erule UN_E)? + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + (* repeated *) + apply (rule conjI) + apply (rule id_onI) + apply (erule imageE) + apply hypsubst + apply (rule trans) + apply (rule comp_apply) + apply (subst inv_simp1) + apply assumption + apply (rule trans) + apply (rule comp_apply) + apply (rule trans) + apply (rule arg_cong[of _ _ g2]) + apply (erule id_onD) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply ((erule UnE)+)? + (* REPEAT_DETERM *) + apply (erule DiffE) + apply (erule UN_E)? + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + + apply (rule iffD2[OF T1_pre.mr_rel_map(1)]) + apply (rule supp_id_bound bij_id bij_comp bij_imp_bij_inv supp_inv_bound supp_comp_bound infinite_UNIV | assumption)+ + apply (unfold id_o o_id Grp_UNIV_id eq_OO) + apply (rule iffD2[OF T1_pre.mr_rel_map(3)]) + apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (unfold comp_assoc inv_id id_o o_id Grp_UNIV_id conversep_eq OO_eq relcompp_conversep_Grp Grp_OO) + apply (subst inv_o_simp1, assumption)+ + apply (unfold id_o o_id comp_assoc[symmetric]) + apply (subst inv_o_simp1, assumption)+ + apply (unfold id_o o_id) + + apply (erule T1_pre.mr_rel_mono_strong0[rotated -12]) + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule trans) + apply (rule id_apply) + apply (rule sym) + apply (rule trans[OF comp_apply]) + apply (rule inv_f_eq[OF bij_is_inj]) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply (erule FVars_raw_intros) + (* repeated *) + apply (rule ballI) + apply (rule trans) + apply (rule id_apply) + apply (rule sym) + apply (rule trans[OF comp_apply]) + apply (rule inv_f_eq[OF bij_is_inj]) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply (erule FVars_raw_intros) + (* END REPEAT_DETERM *) + apply ((rule ballI, rule refl) | (rule ballI, rule ballI, rule impI, assumption))+ + (* REPEAT_DETERM free ORELSE bound *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI) + apply (rule exI) + apply (rule exI[of _ f1]) + apply (rule exI[of _ f2]) + apply (rule exI[of _ g1]) + apply (rule exI[of _ g2]) + apply (rule conjI, assumption+)+ + apply (unfold conj_assoc[symmetric]) + apply (erule conjI[rotated]) + apply (unfold conj_assoc) + apply (rule conjI) + apply (rule refl) + apply (rule conjI) + apply (rule refl) + apply (rule conjI) + (* REPEAT_DETERM *) + apply (erule eq_on_mono[rotated]) + apply (rule subsetI) + apply (erule FVars_raw_intros) + apply assumption + (* repeated *) + apply (erule eq_on_mono[rotated]) + apply (rule subsetI) + apply (erule FVars_raw_intros) + apply assumption + (* END REPEAT_DETERM *) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI) + apply (rule exI) + apply (rule exI[of _ g1]) + apply (rule exI[of _ g2]) + apply (rule exI[of _ g1]) + apply (rule exI[of _ g2]) + apply (rule conjI, assumption+)+ + apply (unfold conj_assoc[symmetric]) + apply (erule conjI[rotated]) + apply (unfold conj_assoc) + apply (rule conjI) + apply (rule trans) + apply (rule permute_raw_comps) + apply (assumption | rule bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV)+ + apply (unfold comp_assoc) + apply (subst inv_o_simp1, assumption)+ + apply (unfold comp_assoc[symmetric] id_o o_id) + apply (rule sym) + apply (rule permute_raw_comps) + apply assumption+ + apply (rule conjI) + apply (rule refl) + apply (rule conjI) + apply (rule eq_on_refl)+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI) + apply (rule exI) + apply (rule exI[of _ f1]) + apply (rule exI[of _ f2]) + apply (rule exI[of _ g1]) + apply (rule exI[of _ g2]) + apply (rule conjI, assumption+)+ + apply (unfold conj_assoc[symmetric]) + apply (rule conjI[rotated]) + apply assumption + apply (unfold conj_assoc) + apply (rule conjI) + apply (rule refl) + apply (rule conjI) + apply (rule refl) + apply (rule conjI) + (* REPEAT_DETERM *) + apply (erule eq_on_mono[rotated]) + apply (rule subsetI) + apply (erule FVars_raw_intros) + apply assumption + (* repeated *) + apply (erule eq_on_mono[rotated]) + apply (rule subsetI) + apply (erule FVars_raw_intros) + apply assumption + (* END REPEAT_DETERM *) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI) + apply (rule exI) + apply (rule exI[of _ g1]) + apply (rule exI[of _ f2]) + apply (rule exI[of _ g1]) + apply (rule exI[of _ g2]) + apply (rule conjI, assumption+)+ + apply (unfold conj_assoc[symmetric]) + apply (rule conjI[rotated]) + apply assumption + apply (unfold conj_assoc) + apply (rule conjI) + apply (rule trans) + apply (rule permute_raw_comps) + apply (assumption | rule bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV supp_id_bound bij_id)+ + apply (unfold comp_assoc) + apply (subst inv_o_simp1, assumption)+ + apply (unfold comp_assoc[symmetric] id_o o_id) + apply (rule sym) + apply (rule trans) + apply (rule permute_raw_comps) + apply (assumption | rule supp_id_bound bij_id)+ + apply (unfold id_o o_id) + apply (rule refl) + apply (rule conjI) + apply (rule refl) + apply (rule conjI) + apply (rule eq_on_refl) + apply (erule eq_on_mono[rotated]) + apply (rule subsetI) + apply (erule FVars_raw_intros) + apply (subst (asm) FVars_raw_permutes) + apply (assumption | rule bij_id supp_id_bound)+ + apply (unfold image_id) + apply assumption + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + done + (* second type, same tactic *) + + apply (erule exE conjE)+ + apply (erule alpha_T2.cases) + apply hypsubst + apply (unfold triv_forall_equality) + subgoal for f1 f2 g1 g2 \1 \2 x y + apply (rule exI[of _ "g1 \ \1 \ inv f1"]) + apply (rule exI[of _ "g2 \ \2 \ inv f2"]) + apply (rule exI)+ + apply (rule conjI, rule permute_raw_simps, (rule supp_id_bound bij_id | assumption)+)+ + apply (rule conjI, (rule bij_comp supp_comp_bound f_prems bij_imp_bij_inv supp_inv_bound infinite_UNIV | assumption)+)+ + + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_comp[unfolded comp_def]) + apply (subst FVars_raw_permutes, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_UN[symmetric]) + apply (subst image_set_diff[OF bij_is_inj, symmetric], assumption)+ + + apply (rule conjI[rotated])+ + apply (rule iffD2[OF T2_pre.mr_rel_map(1)]) + apply (rule f_prems supp_id_bound bij_id bij_comp bij_imp_bij_inv supp_inv_bound supp_comp_bound infinite_UNIV | assumption)+ + apply (unfold id_o o_id Grp_UNIV_id eq_OO) + apply (rule iffD2[OF T2_pre.mr_rel_map(3)]) + apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (unfold comp_assoc inv_id id_o o_id Grp_UNIV_id conversep_eq OO_eq relcompp_conversep_Grp Grp_OO) + apply (subst inv_o_simp1, assumption)+ + apply (unfold id_o o_id comp_assoc[symmetric]) + apply (subst inv_o_simp1, assumption)+ + apply (unfold id_o o_id) + + apply (erule T2_pre.mr_rel_mono_strong0[rotated -12]) + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule trans) + apply (rule id_apply) + apply (rule sym) + apply (rule trans[OF comp_apply]) + apply (rule inv_f_eq[OF bij_is_inj]) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply (erule FVars_raw_intros) + (* repeated *) + apply (rule ballI) + apply (rule trans) + apply (rule id_apply) + apply (rule sym) + apply (rule trans[OF comp_apply]) + apply (rule inv_f_eq[OF bij_is_inj]) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply (erule FVars_raw_intros) + (* END REPEAT_DETERM *) + apply ((rule ballI, rule refl) | (rule ballI, rule ballI, rule impI, assumption))+ + (* REPEAT_DETERM free ORELSE bound *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI) + apply (rule exI) + apply (rule exI[of _ f1]) + apply (rule exI[of _ f2]) + apply (rule exI[of _ g1]) + apply (rule exI[of _ g2]) + apply (rule conjI, assumption+)+ + apply (unfold conj_assoc[symmetric]) + apply (rule conjI[rotated]) + apply assumption + apply (unfold conj_assoc) + apply (rule conjI) + apply (rule refl) + apply (rule conjI) + apply (rule refl) + apply (rule conjI) + (* REPEAT_DETERM *) + apply (erule eq_on_mono[rotated]) + apply (rule subsetI) + apply (erule FVars_raw_intros) + apply assumption + (* repeated *) + apply (erule eq_on_mono[rotated]) + apply (rule subsetI) + apply (erule FVars_raw_intros) + apply assumption + (* END REPEAT_DETERM *) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI) + apply (rule exI) + apply (rule exI[of _ g1]) + apply (rule exI[of _ g2]) + apply (rule exI[of _ g1]) + apply (rule exI[of _ g2]) + apply (rule conjI, assumption+)+ + apply (unfold conj_assoc[symmetric]) + apply (rule conjI[rotated]) + apply assumption + apply (unfold conj_assoc) + apply (rule conjI) + apply (rule trans) + apply (rule permute_raw_comps) + apply (assumption | rule bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV)+ + apply (unfold comp_assoc) + apply (subst inv_o_simp1, assumption)+ + apply (unfold comp_assoc[symmetric] id_o o_id) + apply (rule sym) + apply (rule permute_raw_comps) + apply assumption+ + apply (rule conjI) + apply (rule refl) + apply (rule conjI) + apply (rule eq_on_refl)+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI) + apply (rule exI) + apply (rule exI[of _ f1]) + apply (rule exI[of _ f2]) + apply (rule exI[of _ g1]) + apply (rule exI[of _ g2]) + apply (rule conjI, assumption+)+ + apply (unfold conj_assoc[symmetric]) + apply (rule conjI[rotated]) + apply assumption + apply (unfold conj_assoc) + apply (rule conjI) + apply (rule refl) + apply (rule conjI) + apply (rule refl) + apply (rule conjI) + (* REPEAT_DETERM *) + apply (erule eq_on_mono[rotated]) + apply (rule subsetI) + apply (erule FVars_raw_intros) + apply assumption + (* repeated *) + apply (erule eq_on_mono[rotated]) + apply (rule subsetI) + apply (erule FVars_raw_intros) + apply assumption + (* END REPEAT_DETERM *) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI) + apply (rule exI) + apply (rule exI[of _ g1]) + apply (rule exI[of _ f2]) + apply (rule exI[of _ g1]) + apply (rule exI[of _ g2]) + apply (rule conjI, assumption+)+ + apply (unfold conj_assoc[symmetric]) + apply (rule conjI[rotated]) + apply assumption + apply (unfold conj_assoc) + apply (rule conjI) + apply (rule trans) + apply (rule permute_raw_comps) + apply (assumption | rule bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV supp_id_bound bij_id)+ + apply (unfold comp_assoc) + apply (subst inv_o_simp1, assumption)+ + apply (unfold comp_assoc[symmetric] id_o o_id) + apply (rule sym) + apply (rule trans) + apply (rule permute_raw_comps) + apply (assumption | rule supp_id_bound bij_id)+ + apply (unfold id_o o_id) + apply (rule refl) + apply (rule conjI) + apply (rule refl) + apply (rule conjI) + apply (rule eq_on_refl) + apply (erule eq_on_mono[rotated]) + apply (rule subsetI) + apply (erule FVars_raw_intros) + apply (subst (asm) FVars_raw_permutes) + apply (assumption | rule bij_id supp_id_bound)+ + apply (unfold image_id) + apply assumption + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + (* REPEAT_DETERM *) + apply ((unfold image_Un[symmetric])?)[1] + apply (rule id_onI) + apply (erule imageE) + apply hypsubst + apply (rule trans) + apply (rule comp_apply) + apply (subst inv_simp1) + apply assumption + apply (rule trans) + apply (rule comp_apply) + apply (rule trans) + apply (rule arg_cong[of _ _ g2]) + apply (erule id_onD) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply ((erule UnE)+)? + (* REPEAT_DETERM *) + apply (erule DiffE) + apply (erule UN_E) + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + (* repeated *) + apply (unfold image_Un[symmetric])[1] + apply (rule id_onI) + apply (erule imageE) + apply hypsubst + apply (rule trans) + apply (rule comp_apply) + apply (subst inv_simp1) + apply assumption + apply (rule trans) + apply (rule comp_apply) + apply (rule trans) + apply (rule arg_cong[of _ _ g1]) + apply (erule id_onD) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply (erule UnE)+ + (* REPEAT_DETERM *) + apply (erule DiffE) + apply (erule UN_E)? + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (erule DiffE) + apply (erule UN_E)? + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (erule DiffE) + apply (erule UN_E)? + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + done + done + + show + "eq_on (FVars_raw_T11 x) f1 g1 \ eq_on (FVars_raw_T12 x) f2 g2 \ alpha_T1 x y \ alpha_T1 (permute_raw_T1 f1 f2 x) (permute_raw_T1 g1 g2 y)" + "eq_on (FVars_raw_T21 x2) f1 g1 \ eq_on (FVars_raw_T22 x2) f2 g2 \ alpha_T2 x2 y2 \ alpha_T2 (permute_raw_T2 f1 f2 x2) (permute_raw_T2 g1 g2 y2)" + apply (rule conjunct1[OF x, THEN spec, THEN spec, THEN mp]) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply assumption+ + apply (rule refl)+ + apply (rule assms)+ + (* repeated *) + apply (rule conjunct2[OF x, THEN spec, THEN spec, THEN mp]) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply assumption+ + apply (rule refl)+ + apply (rule assms)+ + done +qed + +lemma alpha_bij_eqs: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + assumes "bij f1" "|supp f1| 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + assumes "bij f1" "|supp f1| (\y. alpha_T1 x y \ a \ FVars_raw_T11 y)) \ (free1_raw_T2 a x2 \ (\y2. alpha_T2 x2 y2 \ a \ FVars_raw_T21 y2))" + "(free2_raw_T1 a2 x \ (\y. alpha_T1 x y \ a2 \ FVars_raw_T12 y)) \ (free2_raw_T2 a2 x2 \ (\y2. alpha_T2 x2 y2 \ a2 \ FVars_raw_T22 y2))" + apply (rule free1_raw_T1_free1_raw_T2.induct) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + (* TRY EVERY + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + END TRY *) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound | assumption)+ + apply (unfold inv_id) + apply (rotate_tac -2) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule T1_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp2, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY + apply assumption + apply assumption + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + END TRY *) + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + (* TRY EVERY *) + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + (* END TRY *) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound | assumption)+ + apply (unfold inv_id) + apply (rotate_tac -2) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule T1_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp2, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY *) + apply assumption + apply assumption + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END TRY *) + (* END REPEAT_DETERM *) + + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T1_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T1_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T1_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T1_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 3] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + (* second type, same tactic *) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + (* TRY EVERY + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + END TRY *) + apply (drule T2_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound | assumption)+ + apply (unfold inv_id) + apply (rotate_tac -2) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule T2_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp2, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY + apply assumption + apply assumption + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + END TRY *) + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + (* TRY EVERY *) + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + (* END TRY *) + apply (drule T2_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound | assumption)+ + apply (unfold inv_id) + apply (rotate_tac -2) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule T2_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp2, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY *) + apply assumption + apply assumption + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END TRY *) + (* END REPEAT_DETERM *) + + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T1_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T2_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T2_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T1_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T2_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T2_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 3] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + + (* second goal, same proof again *) + apply (rule free2_raw_T1_free2_raw_T2.induct) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + (* TRY EVERY + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + END TRY *) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound | assumption)+ + apply (unfold inv_id) + apply (rotate_tac -2) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule T1_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp2, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY + apply assumption + apply assumption + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + END TRY *) + (* END REPEAT_DETERM *) + + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T1_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T1_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 1 1] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T1_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (unfold image_id) + (* TRY EVERY + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T1_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 3] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + END TRY *) + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + (* second type, same tactic *) (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + (* TRY EVERY + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + END TRY *) + apply (drule T2_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound | assumption)+ + apply (unfold inv_id) + apply (rotate_tac -2) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule T2_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp2, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY + apply assumption + apply assumption + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + END TRY *) + (* END REPEAT_DETERM *) + + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T1_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T2_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T2_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 1 1] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T1_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T1_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (unfold image_id) + (* TRY EVERY + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule T2_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule T2_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 3] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (unfold id_on_Un)[1] + apply (erule conjE)+ + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply assumption + END TRY *) + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + done + +lemma alpha_FVars_leqs2: + fixes x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" +shows + "(free1_raw_T1 a x \ (\y. alpha_T1 y x \ a \ FVars_raw_T11 y)) \ (free1_raw_T2 a x2 \ (\y2. alpha_T2 y2 x2 \ a \ FVars_raw_T21 y2))" + "(free2_raw_T1 a2 x \ (\y. alpha_T1 y x \ a2 \ FVars_raw_T12 y)) \ (free2_raw_T2 a2 x2 \ (\y2. alpha_T2 y2 x2 \ a2 \ FVars_raw_T22 y2))" + apply (rule free1_raw_T1_free1_raw_T2.induct) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + (* TRY EVERY + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + END TRY *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule T1_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp2, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY + apply assumption + apply assumption + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + END TRY *) + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + (* TRY EVERY *) + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + apply (rotate_tac -1) + (* END TRY *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule T1_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp1, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY *) + apply (rule bij_imp_bij_inv | assumption)+ + apply (rule id_on_inv) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ id_on, THEN iffD2]) + apply (rule trans) + apply (rule arg_cong2[of _ _ _ _ minus]) + apply (erule T1_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id | assumption)+)+ + apply (rule image_set_diff[symmetric, OF bij_is_inj]) + apply assumption + apply (rule id_on_image_same) + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END TRY *) + (* END REPEAT_DETERM *) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rotate_tac -1) + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule bij_id supp_id_bound | assumption)+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 3] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + (* second type, same tactic *) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + (* TRY EVERY + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + END TRY *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule T2_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp2, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY + apply assumption + apply assumption + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + END TRY *) + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + (* TRY EVERY *) + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + apply (rotate_tac -1) + (* END TRY *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule T2_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp1, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY *) + apply (rule bij_imp_bij_inv | assumption)+ + apply (rule id_on_inv) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ id_on, THEN iffD2]) + apply (rule trans) + apply (rule arg_cong2[of _ _ _ _ minus]) + apply (erule T2_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id | assumption)+)+ + apply (rule image_set_diff[symmetric, OF bij_is_inj]) + apply assumption + apply (rule id_on_image_same) + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END TRY *) + (* END REPEAT_DETERM *) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule bij_id supp_id_bound | assumption)+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 3] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + (* second goal, same tactic *) + apply (rule free2_raw_T1_free2_raw_T2.induct) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + (* TRY EVERY + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + END TRY *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule T1_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp2, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY + apply assumption + apply assumption + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + END TRY *) + (* END REPEAT_DETERM *) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 1 1] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule bij_id supp_id_bound | assumption)+ + apply (unfold image_id)? + (* TRY EVERY + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 3] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + (* second type, same tactic *) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + (* TRY EVERY + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + END TRY *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule T2_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp2, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY + apply assumption + apply assumption + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + END TRY *) + (* END REPEAT_DETERM *) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 1 1] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply assumption+ + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule bij_id supp_id_bound | assumption)+ + apply (unfold image_id)? + (* TRY EVERY + apply (erule imageE) + apply hypsubst + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 3 3] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply assumption+ + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + done + +lemma alpha_FVars: + fixes x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + shows + "alpha_T1 x y \ FVars_raw_T11 x = FVars_raw_T11 y" + "alpha_T1 x y \ FVars_raw_T12 x = FVars_raw_T12 y" + "alpha_T2 x2 y2 \ FVars_raw_T21 x2 = FVars_raw_T21 y2" + "alpha_T2 x2 y2 \ FVars_raw_T22 x2 = FVars_raw_T22 y2" + (* REPEAT_DETERM *) + apply (rule subset_antisym) + apply (rule subsetI) + apply (erule alpha_FVars_leqs1[THEN conjunct1, THEN mp, THEN spec, THEN mp, rotated -1] + alpha_FVars_leqs1[THEN conjunct2, THEN mp, THEN spec, THEN mp, rotated -1]) + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply (rule subsetI) + apply (erule alpha_FVars_leqs2[THEN conjunct1, THEN mp, THEN spec, THEN mp, rotated -1] + alpha_FVars_leqs2[THEN conjunct2, THEN mp, THEN spec, THEN mp, rotated -1]) + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + (* repeated *) + apply (rule subset_antisym) + apply (rule subsetI) + apply (erule alpha_FVars_leqs1[THEN conjunct1, THEN mp, THEN spec, THEN mp, rotated -1] + alpha_FVars_leqs1[THEN conjunct2, THEN mp, THEN spec, THEN mp, rotated -1]) + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply (rule subsetI) + apply (erule alpha_FVars_leqs2[THEN conjunct1, THEN mp, THEN spec, THEN mp, rotated -1] + alpha_FVars_leqs2[THEN conjunct2, THEN mp, THEN spec, THEN mp, rotated -1]) + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + (* repeated *) + apply (rule subset_antisym) + apply (rule subsetI) + apply (erule alpha_FVars_leqs1[THEN conjunct1, THEN mp, THEN spec, THEN mp, rotated -1] + alpha_FVars_leqs1[THEN conjunct2, THEN mp, THEN spec, THEN mp, rotated -1]) + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply (rule subsetI) + apply (erule alpha_FVars_leqs2[THEN conjunct1, THEN mp, THEN spec, THEN mp, rotated -1] + alpha_FVars_leqs2[THEN conjunct2, THEN mp, THEN spec, THEN mp, rotated -1]) + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + (* repeated *) + apply (rule subset_antisym) + apply (rule subsetI) + apply (erule alpha_FVars_leqs1[THEN conjunct1, THEN mp, THEN spec, THEN mp, rotated -1] + alpha_FVars_leqs1[THEN conjunct2, THEN mp, THEN spec, THEN mp, rotated -1]) + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + apply (rule subsetI) + apply (erule alpha_FVars_leqs2[THEN conjunct1, THEN mp, THEN spec, THEN mp, rotated -1] + alpha_FVars_leqs2[THEN conjunct2, THEN mp, THEN spec, THEN mp, rotated -1]) + apply (unfold FVars_raw_defs mem_Collect_eq)[1] + apply assumption + (* END REPEAT_DETERM *) + done + +lemma alpha_syms: + fixes x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + shows + "alpha_T1 x y \ alpha_T1 y x" + "alpha_T2 x2 y2 \ alpha_T2 y2 x2" +proof - + have x: "(\(x::('a, 'b, 'c, 'd) raw_T1) y. alpha_T1 y x \ alpha_T1 x y) \ (\(x::('a, 'b, 'c, 'd) raw_T2) y. alpha_T2 y x \ alpha_T2 x y)" + apply (rule alpha_T1_alpha_T2.coinduct) + apply (erule alpha_T1.cases) + apply hypsubst + apply (rule exI)+ + apply (rule conjI, rule refl)+ + apply (rule conjI[rotated])+ + apply (rule iffD1[OF T1_pre.mr_rel_flip, rotated -1]) + apply (unfold inv_id conversep_eq) + apply (erule T1_pre.mr_rel_mono_strong0[rotated -12]) + apply (rule ballI, rule refl)+ + apply (rule ballI, rule ballI, rule impI, assumption)+ + apply (rule ballI, rule inv_inv_eq[THEN fun_cong, symmetric], assumption)+ + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (assumption | (erule alpha_bij_eq_invs[THEN iffD1, rotated -1], assumption+)) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (assumption | (erule alpha_bij_eq_invs[THEN iffD1, rotated -1], assumption+)) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (assumption | (erule alpha_bij_eq_invs[THEN iffD1, rotated -1], assumption+)) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1]) + apply (assumption | rule supp_id_bound bij_id)+ + apply (unfold inv_id) + apply assumption + apply (assumption | rule supp_id_bound bij_id)+ + (* END REPEAT_DETERM *) + apply (unfold inv_inv_eq) + apply (assumption | rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound)+ + (* REPEAT_DETERM *) + apply (rule id_on_inv) + apply assumption + apply (rule id_on_antimono) + apply assumption + apply (rule equalityD1) + apply (rule sym) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule T1_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF T1_pre.mr_rel_mono_strong[rotated -6]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* ORELSE *) + apply (rule ballI impI)+ + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* END REPEAT_DETERM *) + apply (assumption | rule supp_id_bound bij_id)+ + (* repeated *) + apply (rule id_on_inv) + apply assumption + apply (rule id_on_antimono) + apply assumption + apply (rule equalityD1) + apply (rule arg_cong2[of _ _ _ _ "(\)"])+ + (* REPEAT_DETERM *) + apply (rule trans) + apply (rule arg_cong2[of _ _ _ _ minus]) + apply (erule T1_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id | assumption)+)+ + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj, symmetric]) + apply assumption + apply (rule id_on_image) + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END REPEAT_DETERM *) + (* REPEAT_DETERM *) + apply (rule sym) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule T1_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF T1_pre.mr_rel_mono_strong[rotated -6]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* ORELSE *) + apply (rule ballI impI)+ + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* END REPEAT_DETERM *) + apply (assumption | rule supp_id_bound bij_id)+ + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rule sym) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule T1_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF T1_pre.mr_rel_mono_strong[rotated -6]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* ORELSE *) + apply (rule ballI impI)+ + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + (* END REPEAT_DETERM *) + apply ((assumption | rule supp_id_bound bij_id)+)? + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END REPEAT_DETERM *) + (* END REPEAT_DETERM *) + apply (rule supp_inv_bound bij_imp_bij_inv | assumption)+ + +(* second goal, same tactic *) + apply (erule alpha_T2.cases) + apply hypsubst + apply (rule exI)+ + apply (rule conjI, rule refl)+ + apply (rule conjI[rotated])+ + apply (rule iffD1[OF T2_pre.mr_rel_flip, rotated -1]) + apply (unfold inv_id conversep_eq) + apply (erule T2_pre.mr_rel_mono_strong0[rotated -12]) + apply (rule ballI, rule refl)+ + apply (rule ballI, rule ballI, rule impI, assumption)+ + apply (rule ballI, rule inv_inv_eq[THEN fun_cong, symmetric], assumption)+ + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (assumption | (erule alpha_bij_eq_invs[THEN iffD1, rotated -1], assumption+)) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (assumption | (erule alpha_bij_eq_invs[THEN iffD1, rotated -1], assumption+)) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (assumption | (erule alpha_bij_eq_invs[THEN iffD1, rotated -1], assumption+)) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1]) + apply (assumption | rule supp_id_bound bij_id)+ + apply (unfold inv_id) + apply assumption + apply (assumption | rule supp_id_bound bij_id)+ + (* END REPEAT_DETERM *) + apply (unfold inv_inv_eq) + apply (assumption | rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound)+ + (* REPEAT_DETERM *) + apply (rule id_on_inv) + apply assumption + apply (rule id_on_antimono) + apply assumption + apply (rule equalityD1) + apply (rule sym) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule T2_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF T2_pre.mr_rel_mono_strong[rotated -6]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* ORELSE *) + apply (rule ballI impI)+ + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* END REPEAT_DETERM *) + apply (assumption | rule supp_id_bound bij_id)+ + (* repeated *) + apply (rule id_on_inv) + apply assumption + apply (rule id_on_antimono) + apply assumption + apply (rule equalityD1) + apply (rule arg_cong2[of _ _ _ _ "(\)"])+ + (* REPEAT_DETERM *) + apply (rule trans) + apply (rule arg_cong2[of _ _ _ _ minus]) + apply (erule T2_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id | assumption)+)+ + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj, symmetric]) + apply assumption + apply (rule id_on_image) + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END REPEAT_DETERM *) + (* REPEAT_DETERM *) + apply (rule sym) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule T2_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF T2_pre.mr_rel_mono_strong[rotated -6]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* ORELSE *) + apply (rule ballI impI)+ + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* END REPEAT_DETERM *) + apply (assumption | rule supp_id_bound bij_id)+ + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rule sym) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule T2_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF T2_pre.mr_rel_mono_strong[rotated -6]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* ORELSE *) + apply (rule ballI impI)+ + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + (* END REPEAT_DETERM *) + apply ((assumption | rule supp_id_bound bij_id)+)? + apply (erule id_on_antimono) + apply (rule Un_upper1 Un_upper2 subset_refl)+ + (* END REPEAT_DETERM *) + (* END REPEAT_DETERM *) + apply (rule supp_inv_bound bij_imp_bij_inv | assumption)+ + done + + show "alpha_T1 x y \ alpha_T1 y x" "alpha_T2 x2 y2 \ alpha_T2 y2 x2" + apply (erule conjunct1[OF x, THEN spec, THEN spec, THEN mp]) + apply (erule conjunct2[OF x, THEN spec, THEN spec, THEN mp]) + done +qed + + +lemma alpha_trans: + fixes x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + shows + "alpha_T1 x y \ alpha_T1 y z \ alpha_T1 x z" + "alpha_T2 x2 y2 \ alpha_T2 y2 z2 \ alpha_T2 x2 z2" +proof - + have x: "(\(x::('a, 'b, 'c, 'd) raw_T1) z. (\y. alpha_T1 x y \ alpha_T1 y z) \ alpha_T1 x z) + \ (\(x::('a, 'b, 'c, 'd) raw_T2) z. (\y. alpha_T2 x y \ alpha_T2 y z) \ alpha_T2 x z)" + apply (rule alpha_T1_alpha_T2.coinduct) + apply (erule exE) + apply (erule conjE) + apply (erule alpha_T1.cases)+ + apply hypsubst + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (frule T1_pre.mr_rel_OO[THEN fun_cong, THEN fun_cong, THEN iffD2, rotated -1, OF relcomppI]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id eq_OO) + apply (rule exI)+ + apply (rule conjI, rule refl)+ + apply (rule conjI[rotated])+ + apply (erule T1_pre.mr_rel_mono_strong[rotated -6]) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply (rule exI) + apply (rule conjI) + apply assumption+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply (subst permute_raw_comps[symmetric]) + apply assumption+ + apply (subst alpha_bij_eq_invs) + apply assumption+ + apply (rule exI) + apply (rule conjI[rotated]) + apply assumption + apply (subst permute_raw_comps) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ + apply (subst inv_o_simp1, assumption)+ + apply (unfold permute_raw_ids) + apply assumption + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply (rule exI) + apply (rule conjI) + apply assumption+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply (subst id_hid_o_hid)+ + apply (unfold hidden_id_def) + apply (subst permute_raw_comps[symmetric]) + apply (assumption | rule supp_id_bound bij_id)+ + apply (subst alpha_bij_eq_invs) + apply (assumption | rule bij_id supp_id_bound)+ + apply (rule exI) + apply (rule conjI[rotated]) + apply assumption + apply (subst permute_raw_comps) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_id_bound bij_id)+ + apply (subst inv_o_simp1, assumption)+ + apply (unfold permute_raw_ids inv_id id_o) + apply assumption + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV | assumption)+ + (* REPEAT_DETERM *) + apply (rule id_on_comp) + apply (erule id_on_antimono) (* reuses tactic from alpha_sym *) + apply (rule equalityD1) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule T1_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF T1_pre.mr_rel_mono_strong[rotated -6]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* ORELSE *) + apply (rule ballI impI)+ + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* END REPEAT_DETERM *) + apply (assumption | rule supp_id_bound bij_id)+ + (* repeated *) + apply (rule id_on_comp) + apply (erule id_on_antimono) (* reuses tactic from alpha_sym *) + apply (rule equalityD1) + apply (rule arg_cong2[of _ _ _ _ "(\)"])+ + (* REPEAT_DETERM *) + apply (rule sym) + apply (rule trans) + apply (rule arg_cong2[of _ _ _ _ minus]) + apply (erule T1_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id | assumption)+)+ + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj, symmetric]) + apply assumption + apply (rule id_on_image) + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END REPEAT_DETERM *) + (* REPEAT_DETERM *) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule T1_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF T1_pre.mr_rel_mono_strong[rotated -6]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* ORELSE *) + apply (rule ballI impI)+ + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* END REPEAT_DETERM *) + apply (assumption | rule supp_id_bound bij_id)+ + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (*repeated *) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule T1_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF T1_pre.mr_rel_mono_strong[rotated -6]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* ORELSE *) + apply (rule ballI impI)+ + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + (* END REPEAT_DETERM *) + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + apply assumption + (* END REPEAT_DETERM *) + apply (rule supp_comp_bound bij_comp infinite_UNIV | assumption)+ + +(* second goal, same tactic *) + apply (erule exE) + apply (erule conjE) + apply (erule alpha_T2.cases)+ + apply hypsubst + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (frule T2_pre.mr_rel_OO[THEN fun_cong, THEN fun_cong, THEN iffD2, rotated -1, OF relcomppI]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id eq_OO) + apply (rule exI)+ + apply (rule conjI, rule refl)+ + apply (rule conjI[rotated])+ + apply (erule T2_pre.mr_rel_mono_strong[rotated -6]) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply (rule exI) + apply (rule conjI) + apply assumption+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply (subst permute_raw_comps[symmetric]) + apply assumption+ + apply (subst alpha_bij_eq_invs) + apply assumption+ + apply (rule exI) + apply (rule conjI[rotated]) + apply assumption + apply (subst permute_raw_comps) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ + apply (subst inv_o_simp1, assumption)+ + apply (unfold permute_raw_ids) + apply assumption + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply (rule exI) + apply (rule conjI) + apply assumption+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply (subst id_hid_o_hid)+ + apply (unfold hidden_id_def) + apply (subst permute_raw_comps[symmetric]) + apply (assumption | rule supp_id_bound bij_id)+ + apply (subst alpha_bij_eq_invs) + apply (assumption | rule bij_id supp_id_bound)+ + apply (rule exI) + apply (rule conjI[rotated]) + apply assumption + apply (subst permute_raw_comps) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_id_bound bij_id)+ + apply (subst inv_o_simp1, assumption)+ + apply (unfold permute_raw_ids inv_id id_o) + apply assumption + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV | assumption)+ + (* REPEAT_DETERM *) + apply (rule id_on_comp) + apply (erule id_on_antimono) (* reuses tactic from alpha_sym *) + apply (rule equalityD1) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule T2_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF T2_pre.mr_rel_mono_strong[rotated -6]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* ORELSE *) + apply (rule ballI impI)+ + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* END REPEAT_DETERM *) + apply (assumption | rule supp_id_bound bij_id)+ + (* repeated *) + apply (rule id_on_comp) + apply (erule id_on_antimono) (* reuses tactic from alpha_sym *) + apply (rule equalityD1) + apply (rule arg_cong2[of _ _ _ _ "(\)"])+ + (* REPEAT_DETERM *) + apply (rule sym) + apply (rule trans) + apply (rule arg_cong2[of _ _ _ _ minus]) + apply (erule T2_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id | assumption)+)+ + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj, symmetric]) + apply assumption + apply (rule id_on_image) + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END REPEAT_DETERM *) + (* REPEAT_DETERM *) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule T2_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF T2_pre.mr_rel_mono_strong[rotated -6]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* ORELSE *) + apply (rule ballI impI)+ + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* END REPEAT_DETERM *) + apply (assumption | rule supp_id_bound bij_id)+ + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (*repeated *) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule T2_pre.mr_set_transfer[THEN rel_funD, rotated -1, OF T2_pre.mr_rel_mono_strong[rotated -6]]) + (* REPEAT_DETERM *) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* ORELSE *) + apply (rule ballI impI)+ + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + (* END REPEAT_DETERM *) + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + apply assumption + (* END REPEAT_DETERM *) + apply (rule supp_comp_bound bij_comp infinite_UNIV | assumption)+ + done + + show "alpha_T1 x y \ alpha_T1 y z \ alpha_T1 x z" "alpha_T2 x2 y2 \ alpha_T2 y2 z2 \ alpha_T2 x2 z2" + apply (rule conjunct1[OF x, THEN spec, THEN spec, THEN mp]) + apply (rule exI) + apply (rule conjI) + apply assumption+ + apply (rule conjunct2[OF x, THEN spec, THEN spec, THEN mp]) + apply (rule exI) + apply (rule conjI) + apply assumption+ + done +qed + +lemma raw_refreshs: + fixes x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1'" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2'" + assumes "|A| y. set5_T1_pre y \ A = {} \ set6_T1_pre y \ B = {} \ alpha_T1 (raw_T1_ctor x) (raw_T1_ctor y)" + "\y. set5_T2_pre y \ A = {} \ set6_T2_pre y \ B = {} \ alpha_T2 (raw_T2_ctor x2) (raw_T2_ctor y)" + apply (rule exE[OF eextend_fresh[of "set5_T1_pre x" "A \ ((set7_T1_pre x - set5_T1_pre x) \ (\(FVars_raw_T11 ` set9_T1_pre x) - set5_T1_pre x) \ (\(FVars_raw_T21 ` set11_T1_pre x) - set5_T1_pre x))" "(set7_T1_pre x - set5_T1_pre x) \ (\(FVars_raw_T11 ` set9_T1_pre x) - set5_T1_pre x) \ (\(FVars_raw_T21 ` set11_T1_pre x) - set5_T1_pre x)"]]) + apply (rule T1_pre.set_bd_UNIV) + apply (rule var_T1_pre_class.Un_bound) + apply (rule assms) + (* REPEAT_DETERM *) + apply (rule var_T1_pre_class.Un_bound)+ + apply (rule ordLeq_ordLess_trans[OF card_of_diff]) + apply (rule var_T1_pre_class.UN_bound)? + apply (rule ordLess_ordLeq_trans) + apply (rule T1_pre.set_bd) + apply (rule var_T1_pre_class.large) + apply (rule FVars_raw_bd_UNIVs)? + (* repeated *) + apply (rule ordLeq_ordLess_trans[OF card_of_diff]) + apply (rule var_T1_pre_class.UN_bound) + apply (rule ordLess_ordLeq_trans) + apply (rule T1_pre.set_bd) + apply (rule var_T1_pre_class.large) + apply (rule FVars_raw_bd_UNIVs) + (* repeated *) + apply (rule ordLeq_ordLess_trans[OF card_of_diff]) + apply (rule var_T1_pre_class.UN_bound)? + apply (rule ordLess_ordLeq_trans) + apply (rule T1_pre.set_bd) + apply (rule var_T1_pre_class.large) + apply (rule FVars_raw_bd_UNIVs)? + (* repeated *) + (* END REPEAT_DETERM *) + apply (rule infinite_UNIV) + apply (unfold Un_assoc) + apply (rule Un_upper2) + apply (unfold Un_Diff[symmetric])? + apply (rule Diff_disjoint) + apply (erule conjE)+ + (* repeated *) + apply (rule exE[OF eextend_fresh[of "set6_T1_pre x" "B \ (\(FVars_raw_T12 ` set9_T1_pre x) - set6_T1_pre x)" "(\(FVars_raw_T12 ` set9_T1_pre x) - set6_T1_pre x)"]]) + apply (rule T1_pre.set_bd_UNIV) + apply (rule var_T1_pre_class.Un_bound) + apply (rule assms) + (* REPEAT_DETERM *) + apply (rule var_T1_pre_class.Un_bound)? + apply (rule ordLeq_ordLess_trans[OF card_of_diff]) + apply (rule var_T1_pre_class.UN_bound) + apply (rule ordLess_ordLeq_trans) + apply (rule T1_pre.set_bd) + apply (rule var_T1_pre_class.large) + apply (rule FVars_raw_bd_UNIVs) + (* END REPEAT_DETERM *) + apply (rule infinite_UNIV) + apply (rule Un_upper2) + apply (unfold Un_Diff[symmetric])? + apply (rule Diff_disjoint) + apply (erule conjE)+ + + subgoal for f1 f2 + apply (rule exI[of _ "map_T1_pre id id id id f1 f2 f1 id (permute_raw_T1 f1 f2) id (permute_raw_T2 f1 id) x"]) + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + (* REPEAT_DETERM *) + apply (rule conjI) + apply (erule Int_subset_empty2) + apply (rule Un_upper1) + (* repeated *) + apply (rule conjI) + apply (erule Int_subset_empty2) + apply (rule Un_upper1) + (* END REPEAT_DETERM *) + apply (rule alpha_T1_alpha_T2.intros[rotated -1]) + apply (rule iffD2[OF T1_pre.mr_rel_map(3), rotated -1]) + apply (unfold inv_id id_o o_id eq_OO conversep_eq relcompp_conversep_Grp) + apply (subst inv_o_simp1, assumption)+ + apply (subst id_apply)+ + apply (rule iffD1[OF T1_pre.mr_rel_id[THEN fun_cong, THEN fun_cong]]) + apply (rule T1_pre.rel_refl_strong) + apply (rule refl alpha_refls)+ + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold Un_Diff Un_assoc) + apply assumption+ + done + +(* second goal, same tactic *) + apply (rule exE[OF eextend_fresh[of "set5_T2_pre x2" "A \ ((set7_T2_pre x2 - set5_T2_pre x2) \ (\(FVars_raw_T11 ` set9_T2_pre x2) - set5_T2_pre x2) \ (\(FVars_raw_T21 ` set11_T2_pre x2) - set5_T2_pre x2))" "(set7_T2_pre x2 - set5_T2_pre x2) \ (\(FVars_raw_T11 ` set9_T2_pre x2) - set5_T2_pre x2) \ (\(FVars_raw_T21 ` set11_T2_pre x2) - set5_T2_pre x2)"]]) + apply (rule T2_pre.set_bd_UNIV) + apply (rule var_T1_pre_class.Un_bound) + apply (rule assms) + apply (rule var_T1_pre_class.Un_bound)+ + (* REPEAT_DETERM *) + apply (rule ordLeq_ordLess_trans[OF card_of_diff]) + apply (rule var_T1_pre_class.UN_bound)? + apply (rule ordLess_ordLeq_trans) + apply (rule T2_pre.set_bd) + apply (rule var_T1_pre_class.large) + apply (rule FVars_raw_bd_UNIVs)? + (* repeated *) + apply (rule ordLeq_ordLess_trans[OF card_of_diff]) + apply (rule var_T1_pre_class.UN_bound)? + apply (rule ordLess_ordLeq_trans) + apply (rule T2_pre.set_bd) + apply (rule var_T1_pre_class.large) + apply (rule FVars_raw_bd_UNIVs)? + (* repeated *) + apply (rule ordLeq_ordLess_trans[OF card_of_diff]) + apply (rule var_T1_pre_class.UN_bound) + apply (rule ordLess_ordLeq_trans) + apply (rule T2_pre.set_bd) + apply (rule var_T1_pre_class.large) + apply (rule FVars_raw_bd_UNIVs) + (* END REPEAT_DETERM *) + apply (rule infinite_UNIV) + apply (rule Un_upper2) + apply (unfold Un_Diff[symmetric])? + apply (rule Diff_disjoint) + apply (erule conjE)+ + (* repeated *) + apply (rule exE[OF eextend_fresh[of "set6_T2_pre x2" "B \ (\(FVars_raw_T12 ` set9_T2_pre x2) - set6_T2_pre x2)" "(\(FVars_raw_T12 ` set9_T2_pre x2) - set6_T2_pre x2)"]]) + apply (rule T2_pre.set_bd_UNIV) + apply (rule var_T1_pre_class.Un_bound) + apply (rule assms) + (* REPEAT_DETERM *) + apply (rule var_T1_pre_class.Un_bound)? + apply (rule ordLeq_ordLess_trans[OF card_of_diff]) + apply (rule var_T1_pre_class.UN_bound) + apply (rule ordLess_ordLeq_trans) + apply (rule T2_pre.set_bd) + apply (rule var_T1_pre_class.large) + apply (rule FVars_raw_bd_UNIVs) + (* END REPEAT_DETERM *) + apply (rule infinite_UNIV) + apply (rule Un_upper2) + apply (unfold Un_Diff[symmetric])? + apply (rule Diff_disjoint) + apply (erule conjE)+ + + subgoal for f1 f2 + apply (rule exI[of _ "map_T2_pre id id id id f1 f2 f1 id (permute_raw_T1 f1 f2) id (permute_raw_T2 f1 id) x2"]) + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + (* REPEAT_DETERM *) + apply (rule conjI) + apply (erule Int_subset_empty2) + apply (rule Un_upper1) + (* repeated *) + apply (rule conjI) + apply (erule Int_subset_empty2) + apply (rule Un_upper1) + (* END REPEAT_DETERM *) + apply (rule alpha_T1_alpha_T2.intros[rotated -1]) + apply (rule iffD2[OF T2_pre.mr_rel_map(3), rotated -1]) + apply (unfold inv_id id_o o_id eq_OO conversep_eq relcompp_conversep_Grp) + apply (subst inv_o_simp1, assumption)+ + apply (subst id_apply)+ + apply (rule iffD1[OF T2_pre.mr_rel_id[THEN fun_cong, THEN fun_cong]]) + apply (rule T2_pre.rel_refl_strong) + apply (rule refl alpha_refls)+ + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold Un_Diff) + apply assumption+ + done + done + +lemma TT_Quotients: + "Quotient alpha_T1 TT1_abs TT1_rep (\x. (=) (TT1_abs x))" + "Quotient alpha_T2 TT2_abs TT2_rep (\x. (=) (TT2_abs x))" + apply (subgoal_tac "Quotient3 alpha_T1 TT1_abs TT1_rep") + prefer 2 + apply (rule quot_type.Quotient) + apply (rule type_definition_quot_type) + apply (rule type_definition_T1) + apply (rule equivpI) + apply (rule reflpI) + apply (rule alpha_refls) + apply (rule sympI) + apply (erule alpha_syms) + apply (rule transpI) + apply (erule alpha_trans) + apply assumption + apply (rule QuotientI) + apply (erule Quotient3_abs_rep) + apply (rule alpha_refls) + apply (erule Quotient3_rel[symmetric]) + apply (rule ext)+ + apply (rule iffI) + apply (rule conjI) + apply (rule alpha_refls) + apply assumption + apply (erule conjE) + apply assumption + (* second goal, same tactic *) + apply (subgoal_tac "Quotient3 alpha_T2 TT2_abs TT2_rep") + prefer 2 + apply (rule quot_type.Quotient) + apply (rule type_definition_quot_type) + apply (rule type_definition_T2) + apply (rule equivpI) + apply (rule reflpI) + apply (rule alpha_refls) + apply (rule sympI) + apply (erule alpha_syms) + apply (rule transpI) + apply (erule alpha_trans) + apply assumption + apply (rule QuotientI) + apply (erule Quotient3_abs_rep) + apply (rule alpha_refls) + apply (erule Quotient3_rel[symmetric]) + apply (rule ext)+ + apply (rule iffI) + apply (rule conjI) + apply (rule alpha_refls) + apply assumption + apply (erule conjE) + apply assumption + done + +lemmas TT_total_abs_eq_iffs = TT_Quotients(1)[THEN Quotient_total_abs_eq_iff, OF reflpI[OF alpha_refls(1)]] + TT_Quotients(2)[THEN Quotient_total_abs_eq_iff, OF reflpI[OF alpha_refls(2)]] +lemmas TT_rep_abs = TT_Quotients(1)[THEN Quotient_rep_abs, OF alpha_refls(1)] TT_Quotients(2)[THEN Quotient_rep_abs, OF alpha_refls(2)] +lemmas TT_abs_rep = TT_Quotients[THEN Quotient_abs_rep] + +lemmas TT_rep_abs_syms = alpha_syms(1)[OF TT_rep_abs(1)] alpha_syms(2)[OF TT_rep_abs(2)] + +lemma TT_abs_ctors: + "TT1_abs (raw_T1_ctor x) = T1_ctor (map_T1_pre id id id id id id id TT1_abs TT1_abs TT2_abs TT2_abs x)" + "TT2_abs (raw_T2_ctor x2) = T2_ctor (map_T2_pre id id id id id id id TT1_abs TT1_abs TT2_abs TT2_abs x2)" + apply (unfold T1_ctor_def T2_ctor_def) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_T1_alpha_T2.intros) + apply (rule supp_id_bound bij_id id_on_id)+ + apply (unfold permute_raw_ids) + apply (subst T1_pre.map_comp) + apply (rule supp_id_bound bij_id)+ + apply (unfold id_o o_id) + apply (rule iffD2[OF T1_pre.mr_rel_map(3)]) + apply (rule supp_id_bound bij_id)+ + apply (unfold inv_id id_o o_id Grp_UNIV_id eq_OO conversep_eq relcompp_conversep_Grp) + apply (rule iffD1[OF T1_pre.mr_rel_id[THEN fun_cong, THEN fun_cong]]) + apply (unfold comp_def) + apply (rule T1_pre.rel_refl_strong) + apply (rule refl)+ + apply (rule alpha_syms, rule TT_rep_abs)+ + (* second goal, same tactic *) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_T1_alpha_T2.intros) + apply (rule supp_id_bound bij_id id_on_id)+ + apply (unfold permute_raw_ids) + apply (subst T2_pre.map_comp) + apply (rule supp_id_bound bij_id)+ + apply (unfold id_o o_id) + apply (rule iffD2[OF T2_pre.mr_rel_map(3)]) + apply (rule supp_id_bound bij_id)+ + apply (unfold inv_id id_o o_id Grp_UNIV_id eq_OO conversep_eq relcompp_conversep_Grp) + apply (rule iffD1[OF T2_pre.mr_rel_id[THEN fun_cong, THEN fun_cong]]) + apply (unfold comp_def) + apply (rule T2_pre.rel_refl_strong) + apply (rule refl)+ + apply (rule alpha_syms, rule TT_rep_abs)+ + done + +lemma permute_simps: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + assumes "bij f1" "|supp f1| 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and g1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and g2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + assumes "bij f1" "|supp f1| permute_T1 f1 f2 = permute_T1 (g1 \ f1) (g2 \ f2)" + "permute_T2 g1 g2 \ permute_T2 f1 f2 = permute_T2 (g1 \ f1) (g2 \ f2)" + apply (rule ext) + apply (rule trans[OF comp_apply]) + apply (unfold permute_T1_def permute_T2_def) + apply (subst permute_raw_comps[symmetric]) + apply (rule assms)+ + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) + apply (rule assms)+ + apply (rule TT_rep_abs) + (* second goal, same tactic *) + apply (rule ext) + apply (rule trans[OF comp_apply]) + apply (unfold permute_T1_def permute_T2_def)? + apply (subst permute_raw_comps[symmetric]) + apply (rule assms)+ + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) + apply (rule assms)+ + apply (rule TT_rep_abs) + done + +lemmas permute_comps = + trans[OF comp_apply[symmetric] fun_cong[OF permute_comp0s(1)]] + trans[OF comp_apply[symmetric] fun_cong[OF permute_comp0s(2)]] + +lemma permute_bijs: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + assumes "bij f1" "|supp f1| 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + assumes "bij f1" "|supp f1| 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2" + assumes "bij f1" "|supp f1| (set7_T1_pre x - set5_T1_pre x) \ \(FVars_T11 ` set8_T1_pre x) + \ (\(FVars_T11 ` set9_T1_pre x) - set5_T1_pre x) \ \(FVars_T21 ` set10_T1_pre x) + \ (\(FVars_T21 ` set11_T1_pre x) - set5_T1_pre x)" + "FVars_T12 (T1_ctor x) = set2_T1_pre x \ \(FVars_T12 ` set8_T1_pre x) + \ (\(FVars_T12 ` set9_T1_pre x) - set6_T1_pre x) \ \(FVars_T22 ` set10_T1_pre x) + \ (\(FVars_T22 ` set11_T1_pre x))" + "FVars_T21 (T2_ctor x2) = set1_T2_pre x2 \ (set7_T2_pre x2 - set5_T2_pre x2) \ \(FVars_T11 ` set8_T2_pre x2) + \ (\(FVars_T11 ` set9_T2_pre x2) - set5_T2_pre x2) \ \(FVars_T21 ` set10_T2_pre x2) + \ (\(FVars_T21 ` set11_T2_pre x2) - set5_T2_pre x2)" + "FVars_T22 (T2_ctor x2) = set2_T2_pre x2 \ \(FVars_T12 ` set8_T2_pre x2) + \ (\(FVars_T12 ` set9_T2_pre x2) - set6_T2_pre x2) \ \(FVars_T22 ` set10_T2_pre x2) + \ (\(FVars_T22 ` set11_T2_pre x2))" + apply (unfold FVars_defs T1_ctor_def T2_ctor_def) + (* REPEAT_DETERM *) + apply (rule trans) + apply (rule alpha_FVars) + apply (rule TT_rep_abs) + apply (unfold FVars_raw_ctors) + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id image_comp[unfolded comp_def]) + apply (rule refl) + (* repeated *) + apply (rule trans) + apply (rule alpha_FVars) + apply (rule TT_rep_abs) + apply (unfold FVars_raw_ctors) + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id image_comp[unfolded comp_def]) + apply (rule refl) + (* repeated *) + apply (rule trans) + apply (rule alpha_FVars) + apply (rule TT_rep_abs) + apply (unfold FVars_raw_ctors) + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id image_comp[unfolded comp_def]) + apply (rule refl) + (* repeated *) + apply (rule trans) + apply (rule alpha_FVars) + apply (rule TT_rep_abs) + apply (unfold FVars_raw_ctors) + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id image_comp[unfolded comp_def]) + apply (rule refl) + (* END REPEAT_DETERM *) + done + +lemma FVars_intros: + "a \ set1_T1_pre x \ a \ FVars_T11 (T1_ctor x)" + "a \ set7_T1_pre x \ a \ set5_T1_pre x \ a \ FVars_T11 (T1_ctor x)" + "z \ set8_T1_pre x \ a \ FVars_T11 z \ a \ FVars_T11 (T1_ctor x)" + "z \ set9_T1_pre x \ a \ FVars_T11 z \ a \ set5_T1_pre x \ a \ FVars_T11 (T1_ctor x)" + "z2 \ set10_T1_pre x \ a \ FVars_T21 z2 \ a \ FVars_T11 (T1_ctor x)" + "z2 \ set11_T1_pre x \ a \ FVars_T21 z2 \ a \ set5_T1_pre x \ a \ FVars_T11 (T1_ctor x)" + "a \ set1_T2_pre x2 \ a \ FVars_T21 (T2_ctor x2)" + "a \ set7_T2_pre x2 \ a \ set5_T2_pre x2 \ a \ FVars_T21 (T2_ctor x2)" + "z \ set8_T2_pre x2 \ a \ FVars_T11 z \ a \ FVars_T21 (T2_ctor x2)" + "z \ set9_T2_pre x2 \ a \ FVars_T11 z \ a \ set5_T2_pre x2 \ a \ FVars_T21 (T2_ctor x2)" + "z2 \ set10_T2_pre x2 \ a \ FVars_T21 z2 \ a \ FVars_T21 (T2_ctor x2)" + "z2 \ set11_T2_pre x2 \ a \ FVars_T21 z2 \ a \ set5_T2_pre x2 \ a \ FVars_T21 (T2_ctor x2)" + "b \ set2_T1_pre x \ b \ FVars_T12 (T1_ctor x)" + "z \ set8_T1_pre x \ b \ FVars_T12 z \ b \ FVars_T12 (T1_ctor x)" + "z \ set9_T1_pre x \ b \ FVars_T12 z \ b \ set6_T1_pre x \ b \ FVars_T12 (T1_ctor x)" + "z2 \ set10_T1_pre x \ b \ FVars_T22 z2 \ b \ FVars_T12 (T1_ctor x)" + "z2 \ set11_T1_pre x \ b \ FVars_T22 z2 \ b \ FVars_T12 (T1_ctor x)" + "b \ set2_T2_pre x2 \ b \ FVars_T22 (T2_ctor x2)" + "z \ set8_T2_pre x2 \ b \ FVars_T12 z \ b \ FVars_T22 (T2_ctor x2)" + "z \ set9_T2_pre x2 \ b \ FVars_T12 z \ b \ set6_T2_pre x2 \ b \ FVars_T22 (T2_ctor x2)" + "z2 \ set10_T2_pre x2 \ b \ FVars_T22 z2 \ b \ FVars_T22 (T2_ctor x2)" + "z2 \ set11_T2_pre x2 \ b \ FVars_T22 z2 \ b \ FVars_T22 (T2_ctor x2)" + apply (unfold FVars_defs T1_ctor_def T2_ctor_def alpha_FVars(1,2)[OF TT_rep_abs(1)] alpha_FVars(3,4)[OF TT_rep_abs(2)]) + (* for thm in FVars_intros *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(1)[rotated]) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(2)[rotated]) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (unfold image_id)? + apply (rule refl)+ + (* orelse *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(3)[rotated]) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(4)[rotated]) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(5)[rotated]) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(6)[rotated]) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(7)[rotated]) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(8)[rotated]) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (unfold image_id)? + apply (rule refl)+ + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(9)[rotated]) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(10)[rotated]) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(11)[rotated]) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(12)[rotated]) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(13)[rotated]) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(14)[rotated]) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(15)[rotated]) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(16)[rotated]) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(17)[rotated]) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(18)[rotated]) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(19)[rotated]) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(20)[rotated]) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(21)[rotated]) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(22)[rotated]) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* END REPEAT for *) + done + +lemma TT_inject0s: + "(T1_ctor x = T1_ctor y) = (\(f1::('a::{var_T1_pre, var_T2_pre} \ 'a)) (f2::('b::{var_T1_pre, var_T2_pre} \ 'b)). + bij f1 \ |supp f1| bij f2 \ |supp f2| id_on ((set7_T1_pre x - set5_T1_pre x) \ (\(FVars_T11 ` set9_T1_pre x) - set5_T1_pre x) \ (\(FVars_T21 ` set11_T1_pre x) - set5_T1_pre x)) f1 + \ id_on (\(FVars_T12 ` set9_T1_pre x) - set6_T1_pre x) f2 + \ map_T1_pre id id id id f1 f2 f1 id (permute_T1 f1 f2) id (permute_T2 f1 id) x = y)" + "(T2_ctor x2 = T2_ctor y2) = (\(f1::('a::{var_T1_pre, var_T2_pre} \ 'a)) (f2::('b::{var_T1_pre, var_T2_pre} \ 'b)). + bij f1 \ |supp f1| bij f2 \ |supp f2| id_on ((set7_T2_pre x2 - set5_T2_pre x2) \ (\(FVars_T11 ` set9_T2_pre x2) - set5_T2_pre x2) \ (\(FVars_T21 ` set11_T2_pre x2) - set5_T2_pre x2)) f1 + \ id_on (\(FVars_T12 ` set9_T2_pre x2) - set6_T2_pre x2) f2 + \ map_T2_pre id id id id f1 f2 f1 id (permute_T1 f1 f2) id (permute_T2 f1 id) x2 = y2)" + apply (unfold T1_ctor_def T2_ctor_def permute_T1_def permute_T2_def) + apply (rule trans) + apply (rule TT_total_abs_eq_iffs) + apply (rule iffI) + apply (erule alpha_T1.cases) + apply (drule iffD1[OF raw_T1.inject])+ + apply hypsubst + apply (subst (asm) T1_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id) + apply (drule iffD1[OF T1_pre.mr_rel_map(1), rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id Grp_UNIV_id eq_OO) + apply (drule iffD1[OF T1_pre.mr_rel_map(3), rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold inv_id id_o o_id Grp_UNIV_id conversep_eq eq_OO relcompp_conversep_Grp) + apply (unfold Grp_OO image_comp[unfolded comp_def] FVars_defs[symmetric]) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply (rule T1_pre.mr_rel_eq[THEN fun_cong, THEN fun_cong, THEN iffD1]) + apply (rule iffD2[OF T1_pre.mr_rel_map(1), rotated -1]) + apply (unfold id_o o_id Grp_UNIV_id eq_OO Grp_OO) + apply (erule T1_pre.mr_rel_mono_strong[rotated -6]) + apply (rule ballI, rule ballI, rule imp_refl)+ + (* REPEAT_DETERM *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply assumption + (* repeated *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply assumption + (* repeated *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply assumption + (* repeated *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply assumption + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule exE conjE)+ + apply hypsubst_thin + apply (subst T1_pre.map_comp) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id) + apply (unfold comp_def) + apply (rule alpha_T1_alpha_T2.intros[rotated -1]) + apply (rule iffD2[OF T1_pre.mr_rel_map(1), rotated -1]) + apply (unfold id_o o_id Grp_UNIV_id eq_OO) + apply (rule iffD2[OF T1_pre.mr_rel_map(3), rotated -1]) + apply (unfold inv_id id_o o_id Grp_UNIV_id conversep_eq eq_OO) + apply (unfold relcompp_conversep_Grp Grp_OO) + apply (subst inv_o_simp1, assumption)+ + apply (rule iffD1[OF T1_pre.mr_rel_id[THEN fun_cong, THEN fun_cong]]) + apply (rule T1_pre.rel_refl_strong) + apply (rule refl alpha_refls | (rule alpha_syms, rule TT_rep_abs))+ + apply (rule supp_id_bound bij_id | assumption)+ + (* REPEAT_DETERM *) + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id FVars_defs image_comp[unfolded comp_def])[1] + apply assumption + (* repeated *) + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id FVars_defs image_comp[unfolded comp_def])[1] + apply assumption + (* END REPEAT_DETERM *) + +(* second goal, same tactic *) + apply (rule trans) + apply (rule TT_total_abs_eq_iffs) + apply (rule iffI) + apply (erule alpha_T2.cases) + apply (drule iffD1[OF raw_T2.inject])+ + apply hypsubst + apply (subst (asm) T2_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id) + apply (drule iffD1[OF T2_pre.mr_rel_map(1), rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id Grp_UNIV_id eq_OO) + apply (drule iffD1[OF T2_pre.mr_rel_map(3), rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold inv_id id_o o_id Grp_UNIV_id conversep_eq eq_OO relcompp_conversep_Grp) + apply (unfold Grp_OO image_comp[unfolded comp_def] FVars_defs[symmetric]) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply (rule T2_pre.mr_rel_eq[THEN fun_cong, THEN fun_cong, THEN iffD1]) + apply (rule iffD2[OF T2_pre.mr_rel_map(1), rotated -1]) + apply (unfold id_o o_id Grp_UNIV_id eq_OO Grp_OO) + apply (erule T2_pre.mr_rel_mono_strong[rotated -6]) + apply (rule ballI, rule ballI, rule impI, assumption)+ + (* REPEAT_DETERM *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply assumption + (* repeated *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply hypsubst + apply (rule refl) + (* repeated *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply assumption + (* repeated *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply hypsubst + apply (rule refl) + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule exE conjE)+ + apply hypsubst_thin + apply (subst T2_pre.map_comp) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id) + apply (unfold comp_def) + apply (rule alpha_T1_alpha_T2.intros[rotated -1]) + apply (rule iffD2[OF T2_pre.mr_rel_map(1), rotated -1]) + apply (unfold id_o o_id Grp_UNIV_id eq_OO) + apply (rule iffD2[OF T2_pre.mr_rel_map(3), rotated -1]) + apply (unfold inv_id id_o o_id Grp_UNIV_id conversep_eq eq_OO) + apply (unfold relcompp_conversep_Grp Grp_OO) + apply (subst inv_o_simp1, assumption)+ + apply (rule iffD1[OF T2_pre.mr_rel_id[THEN fun_cong, THEN fun_cong]]) + apply (rule T2_pre.rel_refl_strong) + apply (rule refl alpha_refls | (rule alpha_syms, rule TT_rep_abs))+ + apply (rule supp_id_bound bij_id | assumption)+ + (* REPEAT_DETERM *) + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id FVars_defs image_comp[unfolded comp_def])[1] + apply assumption + (* repeated *) + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id FVars_defs image_comp[unfolded comp_def])[1] + apply assumption + (* END REPEAT_DETERM *) + done + +lemma fresh_cases_T1: + fixes y::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1" + assumes "|A| (x::('a, 'b, 'c, 'd) T1'). y = T1_ctor x \ set5_T1_pre x \ A = {} \ set6_T1_pre x \ B = {} \ noclash_T1 x \ P" + shows "P" + apply (rule raw_T1.exhaust[of "TT1_rep y"]) + subgoal for x + apply (rule exE[OF raw_refreshs(1)[of "A \ FVars_T11 y" "B \ FVars_T12 y" x]]) + apply (rule assms(1-2) T1_pre.Un_bound FVars_bd_UNIVs)+ + apply (erule conjE)+ + subgoal for x' + apply (rule assms(3)[of "map_T1_pre id id id id id id id TT1_abs TT1_abs TT2_abs TT2_abs x'"]) + apply (drule arg_cong[of _ _ TT1_abs]) + apply (unfold TT_abs_rep) + apply hypsubst_thin + apply (unfold T1_ctor_def) + apply (subst T1_pre.map_comp) + apply (rule supp_id_bound bij_id)+ + apply (unfold id_o o_id TT_total_abs_eq_iffs) + apply (erule alpha_trans) + apply (rule alpha_T1_alpha_T2.intros) + apply (rule supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (unfold permute_raw_ids T1_pre.mr_rel_id[symmetric]) + apply (rule iffD2[OF T1_pre.rel_map(2)]) + apply (unfold comp_def) + apply (rule T1_pre.rel_refl_strong) + apply (rule id_apply[symmetric] TT_rep_abs_syms)+ + (* REPEAT_DETERM *) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id) + apply (erule Int_subset_empty2) + apply (rule Un_upper1) + (* repeated *) + apply (subst T1_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id) + apply (erule Int_subset_empty2) + apply (rule Un_upper1) + (* END REPEAT_DETERM *) + apply (unfold noclash_T1_def) + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id image_comp[unfolded comp_def]) + (* REPEAT_DETERM *) + apply (rule conjI)? + apply (erule Int_subset_empty2) + apply (rule subset_trans[rotated]) + apply (rule Un_upper2) + apply (unfold FVars_defs)[1] + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (rule trans) + apply (erule arg_cong) + apply (erule alpha_FVars) + apply (unfold FVars_raw_ctors alpha_FVars(1-2)[OF TT_rep_abs(1)] alpha_FVars(3-4)[OF TT_rep_abs(2)]) + apply (rule subsetI) + apply (erule UnE)+ + (* REPEAT_DETERM *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END REPEAT_DETERM *) + (* repeated *) + apply (rule conjI)? + apply (erule Int_subset_empty2) + apply (rule subset_trans[rotated]) + apply (rule Un_upper2) + apply (unfold FVars_defs)[1] + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (rule trans) + apply (erule arg_cong) + apply (rule alpha_FVars) + apply assumption + apply (unfold FVars_raw_ctors alpha_FVars(1-2)[OF TT_rep_abs(1)] alpha_FVars(3-4)[OF TT_rep_abs(2)]) + apply (rule subsetI) + apply (erule UnE)+ + (* REPEAT_DETERM *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END REPEAT_DETERM *) + done + done + done + +lemma fresh_cases_T2: + fixes x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2'" + assumes "|A| (x::('a, 'b, 'c, 'd) T2'). y = T2_ctor x \ set5_T2_pre x \ A = {} \ set6_T2_pre x \ B = {} \ noclash_T2 x \ P" + shows "P" + apply (rule raw_T2.exhaust[of "TT2_rep y"]) + subgoal for x + apply (rule exE[OF raw_refreshs(2)[of "A \ FVars_T21 y" "B \ FVars_T22 y" x]]) + apply (rule assms(1-2) T1_pre.Un_bound FVars_bd_UNIVs)+ + apply (erule conjE)+ + subgoal for x' + apply (rule assms(3)[of "map_T2_pre id id id id id id id TT1_abs TT1_abs TT2_abs TT2_abs x'"]) + defer + (* REPEAT_DETERM *) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id) + apply (erule Int_subset_empty2) + apply (rule Un_upper1) + (* repeated *) + apply (subst T2_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id) + apply (erule Int_subset_empty2) + apply (rule Un_upper1) + (* END REPEAT_DETERM *) + apply (unfold noclash_T2_def) + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id image_comp[unfolded comp_def]) + (* REPEAT_DETERM *) + apply (rule conjI)? + apply (erule Int_subset_empty2) + apply (rule subset_trans[rotated]) + apply (rule Un_upper2) + apply (unfold FVars_defs)[1] + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (rule trans) + apply (erule arg_cong) + apply (rule alpha_FVars) + apply assumption + apply (unfold FVars_raw_ctors alpha_FVars(1-2)[OF TT_rep_abs(1)] alpha_FVars(3-4)[OF TT_rep_abs(2)]) + apply (rule subsetI) + apply (erule UnE)+ + (* REPEAT_DETERM *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END REPEAT_DETERM *) + (* repeated *) + apply (rule conjI)? + apply (erule Int_subset_empty2) + apply (rule subset_trans[rotated]) + apply (rule Un_upper2) + apply (unfold FVars_defs)[1] + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (rule trans) + apply (erule arg_cong) + apply (rule alpha_FVars) + apply assumption + apply (unfold FVars_raw_ctors alpha_FVars(1-2)[OF TT_rep_abs(1)] alpha_FVars(3-4)[OF TT_rep_abs(2)]) + apply (rule subsetI) + apply (erule UnE)+ + (* REPEAT_DETERM *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + (* END REPEAT_DETERM *) + apply (drule arg_cong[of _ _ TT2_abs]) + apply (unfold TT_abs_rep) + apply hypsubst + apply (unfold T2_ctor_def) + apply (subst T2_pre.map_comp) + apply (rule supp_id_bound bij_id)+ + apply (unfold id_o o_id TT_total_abs_eq_iffs) + apply (erule alpha_trans) + apply (rule alpha_T1_alpha_T2.intros) + apply (rule supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (unfold permute_raw_ids T2_pre.mr_rel_id[symmetric]) + apply (rule iffD2[OF T2_pre.rel_map(2)]) + apply (unfold comp_def) + apply (rule T2_pre.rel_refl_strong) + apply (rule id_apply[symmetric] TT_rep_abs_syms)+ + done + done + done +lemmas fresh_cases = fresh_cases_T1 fresh_cases_T2 + +lemma alpha_subshapess: + fixes x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + shows + "alpha_T1 x y \ subshape_T1_T1 z x \ subshape_T1_T1 z y" + "alpha_T1 x y \ subshape_T2_T1 z2 x \ subshape_T2_T1 z2 y" + "alpha_T2 x2 y2 \ subshape_T1_T2 z x2 \ subshape_T1_T2 z y2" + "alpha_T2 x2 y2 \ subshape_T2_T2 z2 x2 \ subshape_T2_T2 z2 y2" +proof - + have x: "(\x. alpha_T1 x y \ (\z. subshape_T1_T1 z x \ subshape_T1_T1 z y) \ (\z. subshape_T2_T1 z x \ subshape_T2_T1 z y)) + \ (\x. alpha_T2 x y2 \ (\z. subshape_T1_T2 z x \ subshape_T1_T2 z y2) \ (\z. subshape_T2_T2 z x \ subshape_T2_T2 z y2))" + apply (rule raw_T1_raw_T2.induct[of _ _ y y2]) + subgoal premises IHs for x + apply (rule allI) + apply (rule impI) + apply (rule conjI) + (* REPEAT_DETERM *) + apply (rule allI) + apply (rule impI) + apply (erule alpha_T1.cases) + apply (erule subshape_elims) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (erule UnE) + (* REPEAT_DETERM *) + apply (drule T1_pre.mr_rel_set(8-11)[rotated -1]) + prefer 9 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (frule IHs) + apply (erule allE) + apply (erule impE) + apply assumption + apply (rule subshape_intros[rotated -1]) + apply (erule UnI1 UnI2 | rule UnI2)+ + prefer 5 (* 2 * nvars + 1 *) + apply (rule alpha_trans[rotated]) + apply assumption + apply assumption + apply (erule UnI1 | rule UnI2 | assumption)+ + (* ORELSE *) + apply (drule T1_pre.mr_rel_set(8-11)[rotated -1]) + prefer 9 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (frule IHs) + apply (erule allE) + apply (erule impE) + apply assumption + apply (rule subshape_intros[rotated -1]) + apply (erule UnI1 UnI2 | rule UnI2)+ + prefer 5 (* 2 * nvars + 1 *) + apply (rule alpha_trans[rotated]) + apply assumption + apply (rule alpha_trans[rotated]) + apply (rule alpha_bij_eqs[THEN iffD2, rotated -1]) + apply assumption+ + apply (subst permute_raw_comps) + apply assumption+ + apply (rule alpha_refls) + apply (rule bij_comp supp_comp_bound infinite_UNIV | assumption)+ + (* END REPEAT_DETERM *) + (* repeated *) + apply (rule allI) + apply (rule impI) + apply (erule alpha_T1.cases) + apply (erule subshape_elims) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (erule UnE) + (* REPEAT_DETERM *) + apply (drule T1_pre.mr_rel_set(8-11)[rotated -1]) + prefer 9 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (frule IHs) + apply (erule allE) + apply (erule impE) + apply assumption + apply (rule subshape_intros[rotated -1]) + apply (erule UnI1 UnI2 | rule UnI2)+ + prefer 5 (* 2 * nvars + 1 *) + apply (rule alpha_trans[rotated]) + apply assumption + apply assumption + apply (erule UnI1 | rule UnI2 | assumption)+ + (* ORELSE *) + apply (drule T1_pre.mr_rel_set(8-11)[rotated -1]) + prefer 9 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (frule IHs) + apply (erule allE) + apply (erule impE) + apply assumption + apply (rule subshape_intros[rotated -1]) + apply (erule UnI1 UnI2 | rule UnI2)+ + prefer 5 (* 2 * nvars + 1 *) + apply (rule alpha_trans[rotated]) + apply assumption + apply (rule alpha_trans[rotated]) + apply (rule alpha_bij_eqs[THEN iffD2, rotated -1]) + apply (assumption | rule supp_id_bound bij_id)+ + apply (subst permute_raw_comps) + apply (assumption | rule supp_id_bound bij_id)+ + apply (unfold id_o o_id) + apply (rule alpha_refls) + apply (rule bij_comp supp_comp_bound infinite_UNIV | assumption)+ + (* END REPEAT_DETERM *) + done + (* second goal, same tactic *) + subgoal premises IHs for x + apply (rule allI) + apply (rule impI) + apply (rule conjI) + (* REPEAT_DETERM *) + apply (rule allI) + apply (rule impI) + apply (erule alpha_T2.cases) + apply (erule subshape_elims) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (erule UnE) + (* REPEAT_DETERM *) + apply (drule T2_pre.mr_rel_set(8-11)[rotated -1]) + prefer 9 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (frule IHs) + apply (erule allE) + apply (erule impE) + apply assumption + apply (rule subshape_intros[rotated -1]) + apply (erule UnI1 UnI2 | rule UnI2)+ + prefer 5 (* 2 * nvars + 1 *) + apply (rule alpha_trans[rotated]) + apply assumption + apply assumption + apply (erule UnI1 | rule UnI2 | assumption)+ + (* ORELSE *) + apply (drule T2_pre.mr_rel_set(8-11)[rotated -1]) + prefer 9 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (frule IHs) + apply (erule allE) + apply (erule impE) + apply assumption + apply (rule subshape_intros[rotated -1]) + apply (erule UnI1 UnI2 | rule UnI2)+ + prefer 5 (* 2 * nvars + 1 *) + apply (rule alpha_trans[rotated]) + apply assumption + apply (rule alpha_trans[rotated]) + apply (rule alpha_bij_eqs[THEN iffD2, rotated -1]) + apply assumption+ + apply (subst permute_raw_comps) + apply assumption+ + apply (rule alpha_refls) + apply (rule bij_comp supp_comp_bound infinite_UNIV | assumption)+ + (* END REPEAT_DETERM *) + (* repeated *) + apply (rule allI) + apply (rule impI) + apply (erule alpha_T2.cases) + apply (erule subshape_elims) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (erule UnE) + (* REPEAT_DETERM *) + apply (drule T2_pre.mr_rel_set(8-11)[rotated -1]) + prefer 9 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (frule IHs) + apply (erule allE) + apply (erule impE) + apply assumption + apply (rule subshape_intros[rotated -1]) + apply (erule UnI1 UnI2 | rule UnI2)+ + prefer 5 (* 2 * nvars + 1 *) + apply (rule alpha_trans[rotated]) + apply assumption + apply assumption + apply (erule UnI1 | rule UnI2 | assumption)+ + (* ORELSE *) + apply (drule T2_pre.mr_rel_set(8-11)[rotated -1]) + prefer 9 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (frule IHs) + apply (erule allE) + apply (erule impE) + apply assumption + apply (rule subshape_intros[rotated -1]) + apply (erule UnI1 UnI2 | rule UnI2)+ + prefer 5 (* 2 * nvars + 1 *) + apply (rule alpha_trans[rotated]) + apply assumption + apply (rule alpha_trans[rotated]) + apply (rule alpha_bij_eqs[THEN iffD2, rotated -1]) + apply (assumption | rule supp_id_bound bij_id)+ + apply (subst permute_raw_comps) + apply (assumption | rule supp_id_bound bij_id)+ + apply (unfold id_o o_id) + apply (rule alpha_refls) + apply (rule bij_comp supp_comp_bound infinite_UNIV | assumption)+ + (* END REPEAT_DETERM *) + done + done + + show "alpha_T1 x y \ subshape_T1_T1 z x \ subshape_T1_T1 z y" "alpha_T1 x y \ subshape_T2_T1 z2 x \ subshape_T2_T1 z2 y" + "alpha_T2 x2 y2 \ subshape_T1_T2 z x2 \ subshape_T1_T2 z y2" "alpha_T2 x2 y2 \ subshape_T2_T2 z2 x2 \ subshape_T2_T2 z2 y2" + (* REPEAT_DETERM *) + apply (drule conjunct1[OF x, THEN spec, THEN mp]) + apply (erule conjE)+ + apply (unfold atomize_all[symmetric] atomize_imp[symmetric]) + apply assumption + (* repeated *) + apply (drule conjunct1[OF x, THEN spec, THEN mp]) + apply (erule conjE)+ + apply (unfold atomize_all[symmetric] atomize_imp[symmetric]) + apply assumption + (* repeated *) + apply (drule conjunct2[OF x, THEN spec, THEN mp]) + apply (erule conjE)+ + apply (unfold atomize_all[symmetric] atomize_imp[symmetric]) + apply assumption + (* repeated *) + apply (drule conjunct2[OF x, THEN spec, THEN mp]) + apply (erule conjE)+ + apply (unfold atomize_all[symmetric] atomize_imp[symmetric]) + apply assumption + done +qed + +lemma subshape_induct_raw: + fixes x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + assumes "\x. (\y. subshape_T1_T1 y x \ P1 y) \ (\y. subshape_T2_T1 y x \ P2 y) \ P1 x" + "\x. (\y. subshape_T1_T2 y x \ P1 y) \ (\y. subshape_T2_T2 y x \ P2 y) \ P2 x" + shows "(\f1 f2 y. bij f1 \ |supp f1| bij f2 \ |supp f2| alpha_T1 (permute_raw_T1 f1 f2 x) y \ P1 y) + \ (\f1 f2 y. bij f1 \ |supp f1| bij f2 \ |supp f2| alpha_T2 (permute_raw_T2 f1 f2 x2) y \ P2 y)" + apply (rule raw_T1_raw_T2.induct) + subgoal premises IHs for x + apply (rule allI impI)+ + apply (rule assms) + (* REPEAT_DETERM *) + apply (drule alpha_subshapess[rotated -1]) + apply (erule alpha_syms) + apply (rotate_tac -2) + apply (erule thin_rl) + apply (subst (asm) permute_raw_simps) + apply assumption+ + apply (erule subshape_elims) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (subst (asm) T1_pre.set_map, (assumption | rule supp_id_bound bij_id)+)+ + apply (unfold image_Un[symmetric]) + apply (erule imageE) + apply hypsubst + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1]) + apply assumption+ + apply (subst (asm) permute_raw_comps) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnE) + (* REPEAT_DETERM *) + apply (drule IHs) + apply (erule allE)+ + (* REPEAT_DETERM *) + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + (* END REPEAT_DETERM *) + apply assumption + apply (erule alpha_syms) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + (* repeated *) + apply (drule IHs) + apply (erule allE)+ + (* REPEAT_DETERM *) + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + (* END REPEAT_DETERM *) + apply assumption + apply (erule alpha_syms) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + (* END REPEAT_DETERM *) + (* repeated *) + apply (drule alpha_subshapess[rotated -1]) + apply (erule alpha_syms) + apply (rotate_tac -2) + apply (erule thin_rl) + apply (subst (asm) permute_raw_simps) + apply assumption+ + apply (erule subshape_elims) + apply (drule iffD1[OF raw_T1.inject]) + apply hypsubst + apply (subst (asm) T1_pre.set_map, (assumption | rule supp_id_bound bij_id)+)+ + apply (unfold image_Un[symmetric]) + apply (erule imageE) + apply hypsubst + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1]) + apply assumption+ + apply (subst (asm) permute_raw_comps) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnE) + (* REPEAT_DETERM *) + apply (drule IHs) + apply (erule allE)+ + (* REPEAT_DETERM *) + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + (* END REPEAT_DETERM *) + apply assumption + apply (erule alpha_syms) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + (* repeated *) + apply (drule IHs) + apply (erule allE)+ + (* REPEAT_DETERM *) + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + (* END REPEAT_DETERM *) + apply assumption + apply (erule alpha_syms) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + (* END REPEAT_DETERM *) + (* END REPEAT_DETERM *) + done + (* second goal, same tactic *) + subgoal premises IHs for x + apply (rule allI impI)+ + apply (rule assms) + (* REPEAT_DETERM *) + apply (drule alpha_subshapess[rotated -1]) + apply (erule alpha_syms) + apply (rotate_tac -2) + apply (erule thin_rl) + apply (subst (asm) permute_raw_simps) + apply assumption+ + apply (erule subshape_elims) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (subst (asm) T2_pre.set_map, (assumption | rule supp_id_bound bij_id)+)+ + apply (unfold image_Un[symmetric]) + apply (erule imageE) + apply hypsubst + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1]) + apply assumption+ + apply (subst (asm) permute_raw_comps) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnE) + (* REPEAT_DETERM *) + apply (drule IHs) + apply (erule allE)+ + (* REPEAT_DETERM *) + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + (* END REPEAT_DETERM *) + apply assumption + apply (erule alpha_syms) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + (* repeated *) + apply (drule IHs) + apply (erule allE)+ + (* REPEAT_DETERM *) + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + (* END REPEAT_DETERM *) + apply assumption + apply (erule alpha_syms) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + (* END REPEAT_DETERM *) + (* repeated *) + apply (drule alpha_subshapess[rotated -1]) + apply (erule alpha_syms) + apply (rotate_tac -2) + apply (erule thin_rl) + apply (subst (asm) permute_raw_simps) + apply assumption+ + apply (erule subshape_elims) + apply (drule iffD1[OF raw_T2.inject]) + apply hypsubst + apply (subst (asm) T2_pre.set_map, (assumption | rule supp_id_bound bij_id)+)+ + apply (unfold image_Un[symmetric]) + apply (erule imageE) + apply hypsubst + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1]) + apply assumption+ + apply (subst (asm) permute_raw_comps) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnE) + (* REPEAT_DETERM *) + apply (drule IHs) + apply (erule allE)+ + (* REPEAT_DETERM *) + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + (* END REPEAT_DETERM *) + apply assumption + apply (erule alpha_syms) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + (* repeated *) + apply (drule IHs) + apply (erule allE)+ + (* REPEAT_DETERM *) + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + (* END REPEAT_DETERM *) + apply assumption + apply (erule alpha_syms) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + (* END REPEAT_DETERM *) + (* END REPEAT_DETERM *) + done + done + +lemma subshape_induct: + fixes x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2" + assumes "\x. (\y. subshape_T1_T1 y x \ P1 y) \ (\y. subshape_T2_T1 y x \ P2 y) \ P1 x" + "\x. (\y. subshape_T1_T2 y x \ P1 y) \ (\y. subshape_T2_T2 y x \ P2 y) \ P2 x" + shows "P1 x \ P2 x2" + apply (rule conjE[OF subshape_induct_raw[of P1 P2]]) + apply (rule assms, assumption+)+ + apply (erule allE impE | rule bij_id supp_id_bound alpha_refls)+ + apply (unfold permute_raw_ids) + apply ((rule conjI)?, assumption)+ + done + +lemma wf_subshape: "wf {(x, y). case x of + Inl t1 \ (case y of Inl t1' \ subshape_T1_T1 t1 t1' | Inr t2 \ subshape_T1_T2 t1 t2) + | Inr t2 \ (case y of Inl t1 \ subshape_T2_T1 t2 t1 | Inr t2' \ subshape_T2_T2 t2 t2') + }" + apply (rule wfUNIVI) + apply (unfold prod_in_Collect_iff prod.case) + subgoal for P x + apply (rule sumE[of x]; hypsubst_thin) + (* REPEAT_DETERM *) + apply (rule conjunct1[OF subshape_induct[of "\x. P (Inl x)" "\y. P (Inr y)"]]) + (* REPEAT_DETERM *) + apply (erule allE) + apply (erule impE) + prefer 2 + apply assumption + apply (rule allI) + apply (rule impI) + subgoal for z x y + apply (rule sumE[of y]; hypsubst_thin) + apply (unfold sum.case) + apply assumption+ + done + (* repeated *) + apply (erule allE) + apply (erule impE) + prefer 2 + apply assumption + apply (rule allI) + apply (rule impI) + subgoal for z x y + apply (rule sumE[of y]; hypsubst_thin) + apply (unfold sum.case) + apply assumption+ + done + (* END REPEAT_DETERM *) + (* repeated *) + apply (rule conjunct2[OF subshape_induct[of "\x. P (Inl x)" "\y. P (Inr y)"]]) + (* REPEAT_DETERM *) + apply (erule allE) + apply (erule impE) + prefer 2 + apply assumption + apply (rule allI) + apply (rule impI) + subgoal for z x y + apply (rule sumE[of y]; hypsubst_thin) + apply (unfold sum.case) + apply assumption+ + done + (* repeated *) + apply (erule allE) + apply (erule impE) + prefer 2 + apply assumption + apply (rule allI) + apply (rule impI) + subgoal for z x y + apply (rule sumE[of y]; hypsubst_thin) + apply (unfold sum.case) + apply assumption+ + done + (* END REPEAT_DETERM *) + (* END REPEAT_DETERM *) + done + done + +lemma set_subshape_permutess: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + assumes "bij f1" "|supp f1| set8_T1_pre x \ subshape_T1_T1 (permute_raw_T1 f1 f2 z) (raw_T1_ctor x)" + "z \ set9_T1_pre x \ subshape_T1_T1 (permute_raw_T1 f1 f2 z) (raw_T1_ctor x)" + "z2 \ set10_T1_pre x \ subshape_T2_T1 (permute_raw_T2 f1 f2 z2) (raw_T1_ctor x)" + "z2 \ set11_T1_pre x \ subshape_T2_T1 (permute_raw_T2 f1 f2 z2) (raw_T1_ctor x)" + "z \ set8_T2_pre x2 \ subshape_T1_T2 (permute_raw_T1 f1 f2 z) (raw_T2_ctor x2)" + "z \ set9_T2_pre x2 \ subshape_T1_T2 (permute_raw_T1 f1 f2 z) (raw_T2_ctor x2)" + "z2 \ set10_T2_pre x2 \ subshape_T2_T2 (permute_raw_T2 f1 f2 z2) (raw_T2_ctor x2)" + "z2 \ set11_T2_pre x2 \ subshape_T2_T2 (permute_raw_T2 f1 f2 z2) (raw_T2_ctor x2)" + (* REPEAT_DETERM *) + apply (rule subshape_intros[rotated -2]) + apply (subst permute_raw_comps) + prefer 9 (* 4 * nvars + 1 *) + apply (subst inv_o_simp1, rule assms)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnI1 UnI2 | rule UnI2)+ + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + (* repeated *) + apply (rule subshape_intros[rotated -2]) + apply (subst permute_raw_comps) + prefer 9 (* 4 * nvars + 1 *) + apply (subst inv_o_simp1, rule assms)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnI1 UnI2 | rule UnI2)+ + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + (* repeated *) + apply (rule subshape_intros[rotated -2]) + apply (subst permute_raw_comps) + prefer 9 (* 4 * nvars + 1 *) + apply (subst inv_o_simp1, rule assms)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnI1 UnI2 | rule UnI2)+ + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + (* repeated *) + apply (rule subshape_intros[rotated -2]) + apply (subst permute_raw_comps) + prefer 9 (* 4 * nvars + 1 *) + apply (subst inv_o_simp1, rule assms)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnI1 UnI2 | rule UnI2)+ + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + (* repeated *) + apply (rule subshape_intros[rotated -2]) + apply (subst permute_raw_comps) + prefer 9 (* 4 * nvars + 1 *) + apply (subst inv_o_simp1, rule assms)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnI1 UnI2 | rule UnI2)+ + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + (* repeated *) + apply (rule subshape_intros[rotated -2]) + apply (subst permute_raw_comps) + prefer 9 (* 4 * nvars + 1 *) + apply (subst inv_o_simp1, rule assms)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnI1 UnI2 | rule UnI2)+ + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + (* repeated *) + apply (rule subshape_intros[rotated -2]) + apply (subst permute_raw_comps) + prefer 9 (* 4 * nvars + 1 *) + apply (subst inv_o_simp1, rule assms)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnI1 UnI2 | rule UnI2)+ + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + (* repeated *) + apply (rule subshape_intros[rotated -2]) + apply (subst permute_raw_comps) + prefer 9 (* 4 * nvars + 1 *) + apply (subst inv_o_simp1, rule assms)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnI1 UnI2 | rule UnI2)+ + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + (* END REPEAT_DETERM *) + done + +lemmas set_subshapess = set_subshape_permutess[OF bij_id supp_id_bound bij_id supp_id_bound, unfolded permute_raw_ids] + +lemma permute_abs: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + assumes "bij f1" "|supp f1| x \. \ \ Param \ \y. T1_ctor y = T1_ctor x \ + ((\z. z \ set8_T1_pre y \ (\\\Param. P1 z \)) \ (\z. z \ set9_T1_pre y \ (\\\Param. P1 z \)) + \ (\z. z \ set10_T1_pre y \ (\\\Param. P2 z \)) \ (\z. z \ set11_T1_pre y \ (\\\Param. P2 z \)) + \ P1 (T1_ctor y) \)" + "\x \. \ \ Param \ \y. T2_ctor y = T2_ctor x \ + ((\z. z \ set8_T2_pre y \ (\\\Param. P1 z \)) \ (\z. z \ set9_T2_pre y \ (\\\Param. P1 z \)) + \ (\z. z \ set10_T2_pre y \ (\\\Param. P2 z \)) \ (\z. z \ set11_T2_pre y \ (\\\Param. P2 z \)) + \ P2 (T2_ctor y) \)" + shows "\\\Param. P1 z \ \ P2 z2 \" + apply (unfold ball_conj_distrib) + apply (rule subshape_induct[of "\x. \\\Param. P1 (TT1_abs x) \" "\x. \\\Param. P2 (TT2_abs x) \" "TT1_rep z" "TT2_rep z2", unfolded TT_abs_rep]) + apply (rule ballI) + subgoal for x \ + apply (rule raw_T1.exhaust[of x]) + apply hypsubst_thin + apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ P1]]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_T1_alpha_T2.intros) + apply (rule supp_id_bound bij_id id_on_id)+ + apply (unfold permute_raw_ids T1_pre.mr_rel_id[symmetric]) + apply (rule iffD2[OF T1_pre.rel_map(2)]) + apply (rule T1_pre.rel_refl_strong) + apply (rule refl)+ + apply (rule alpha_syms, rule TT_rep_abs[unfolded comp_apply[symmetric, of TT1_rep TT1_abs] comp_apply[symmetric, of TT2_rep TT2_abs]])+ + apply (unfold id_hid_o_hid id_def[symmetric]) + apply (unfold hidden_id_def) + apply (subst T1_pre.map_comp[symmetric]) + apply (rule supp_id_bound bij_id)+ + apply (unfold T1_ctor_def[symmetric]) + apply (drule IHs(1)) + apply (erule exE) + apply (erule conjE) + apply (drule sym) + apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ P1]]) + apply assumption + apply (erule mp) + (* REPEAT_DETERM *) + apply (rule conjI)? + apply (rule allI) + apply (rule impI) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply hypsubst + apply (subst (asm) T1_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_id) + apply (unfold image_comp[unfolded comp_def])? + apply (erule imageE) + apply hypsubst + apply (subst permute_abs, (rule supp_id_bound bij_id | assumption)+)? + apply (drule set_subshapess, assumption) (* ORELSE + apply (drule set_subshape_permutess[rotated -1]) + prefer 5 (* 2 * nvars + 1 *) + apply (assumption | rule supp_id_bound bij_id)+ *) + (* repeated *) + apply (rule conjI)? + apply (rule allI) + apply (rule impI) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply hypsubst + apply (subst (asm) T1_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_id) + apply (unfold image_comp[unfolded comp_def])? + apply (erule imageE) + apply hypsubst + apply (subst permute_abs, (rule supp_id_bound bij_id | assumption)+)? + (* apply (drule set_subshapess, assumption) ORELSE *) + apply (drule set_subshape_permutess[rotated -1]) + prefer 5 (* 2 * nvars + 1 *) + apply (assumption | rule supp_id_bound bij_id)+ + (* END ORELSE *) + (* repeated *) + apply (rule conjI)? + apply (rule allI) + apply (rule impI) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply hypsubst + apply (subst (asm) T1_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_id) + apply (unfold image_comp[unfolded comp_def])? + apply (erule imageE) + apply hypsubst + apply (subst permute_abs, (rule supp_id_bound bij_id | assumption)+)? + apply (drule set_subshapess, assumption) (* ORELSE + apply (drule set_subshape_permutess[rotated -1]) + prefer 5 (* 2 * nvars + 1 *) + apply (assumption | rule supp_id_bound bij_id)+ *) + (* repeated *) + apply (rule conjI)? + apply (rule allI) + apply (rule impI) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply hypsubst + apply (subst (asm) T1_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_id) + apply (unfold image_comp[unfolded comp_def])? + apply (erule imageE) + apply hypsubst + apply (subst permute_abs, (rule supp_id_bound bij_id | assumption)+)? + (* apply (drule set_subshapess, assumption) ORELSE *) + apply (drule set_subshape_permutess[rotated -1]) + prefer 5 (* 2 * nvars + 1 *) + apply (assumption | rule supp_id_bound bij_id)+ + (* END ORELSE *) + done + (* second goal, same tactic *) + apply (rule ballI) + subgoal for x \ + apply (rule raw_T2.exhaust[of x]) + apply hypsubst_thin + apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ P2]]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_T1_alpha_T2.intros) + apply (rule supp_id_bound bij_id id_on_id)+ + apply (unfold permute_raw_ids) + apply (rule iffD2[OF T2_pre.mr_rel_map(3)]) + apply (rule supp_id_bound bij_id)+ + apply (unfold inv_id id_o o_id eq_OO) + apply (unfold relcompp_conversep_Grp) + apply (rule iffD1[OF T2_pre.mr_rel_id[THEN fun_cong, THEN fun_cong]]) + apply (rule T2_pre.rel_refl_strong) + apply (subst Grp_UNIV_id, unfold conversep_eq, rule refl)+ + apply (rule alpha_syms, rule TT_rep_abs[unfolded comp_apply[symmetric, of TT1_rep TT1_abs] comp_apply[symmetric, of TT2_rep TT2_abs]])+ + apply (unfold id_hid_o_hid) + apply (unfold hidden_id_def) + apply (subst T2_pre.map_comp[symmetric]) + apply (rule supp_id_bound bij_id)+ + apply (unfold T2_ctor_def[symmetric]) + apply (drule IHs(2)) + apply (erule exE) + apply (erule conjE) + apply (drule sym) + apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ P2]]) + apply assumption + apply (erule mp) + (* REPEAT_DETERM *) + apply (rule conjI)? + apply (rule allI) + apply (rule impI) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply hypsubst + apply (subst (asm) T2_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_id) + apply (unfold image_comp[unfolded comp_def])? + apply (erule imageE) + apply hypsubst + apply (subst permute_abs, (rule supp_id_bound bij_id | assumption)+)? + apply (drule set_subshapess, assumption) (* ORELSE + apply (drule set_subshape_permutess[rotated -1]) + prefer 5 (* 2 * nvars + 1 *) + apply (assumption | rule supp_id_bound bij_id)+ *) + (* repeated *) + apply (rule conjI)? + apply (rule allI) + apply (rule impI) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply hypsubst + apply (subst (asm) T2_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_id) + apply (unfold image_comp[unfolded comp_def])? + apply (erule imageE) + apply hypsubst + apply (subst permute_abs, (rule supp_id_bound bij_id | assumption)+)? + (* apply (drule set_subshapess, assumption) ORELSE *) + apply (drule set_subshape_permutess[rotated -1]) + prefer 5 (* 2 * nvars + 1 *) + apply (assumption | rule supp_id_bound bij_id)+ + (* END ORELSE *) + (* repeated *) + apply (rule conjI)? + apply (rule allI) + apply (rule impI) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply hypsubst + apply (subst (asm) T2_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_id) + apply (unfold image_comp[unfolded comp_def])? + apply (erule imageE) + apply hypsubst + apply (subst permute_abs, (rule supp_id_bound bij_id | assumption)+)? + apply (drule set_subshapess, assumption) (* ORELSE + apply (drule set_subshape_permutess[rotated -1]) + prefer 5 (* 2 * nvars + 1 *) + apply (assumption | rule supp_id_bound bij_id)+ *) + (* repeated *) + apply (rule conjI)? + apply (rule allI) + apply (rule impI) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply hypsubst + apply (subst (asm) T2_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_id) + apply (unfold image_comp[unfolded comp_def])? + apply (erule imageE) + apply hypsubst + apply (subst permute_abs, (rule supp_id_bound bij_id | assumption)+)? + (* apply (drule set_subshapess, assumption) ORELSE *) + apply (drule set_subshape_permutess[rotated -1]) + prefer 5 (* 2 * nvars + 1 *) + apply (assumption | rule supp_id_bound bij_id)+ + (* END ORELSE *) + done + done + +lemma fresh_induct_param: + fixes K1::"'p \ 'a::{var_T1_pre, var_T2_pre} set" + and K2::"'p \ 'b::{var_T1_pre, var_T2_pre} set" + assumes "\\. \ \ Param \ |K1 \| \. \ \ Param \ |K2 \| x \. + (\z \. z \ set8_T1_pre x \ \ \ Param \ P1 z \) \ + (\z \. z \ set9_T1_pre x \ \ \ Param \ P1 z \) \ + (\z \. z \ set10_T1_pre x \ \ \ Param \ P2 z \) \ + (\z \. z \ set11_T1_pre x \ \ \ Param \ P2 z \) \ + set5_T1_pre x \ K1 \ = {} \ + set6_T1_pre x \ K2 \ = {} \ + noclash_T1 x \ + \ \ Param \ P1 (T1_ctor x) \" + "\x \. + (\z \. z \ set8_T2_pre x \ \ \ Param \ P1 z \) \ + (\z \. z \ set9_T2_pre x \ \ \ Param \ P1 z \) \ + (\z \. z \ set10_T2_pre x \ \ \ Param \ P2 z \) \ + (\z \. z \ set11_T2_pre x \ \ \ Param \ P2 z \) \ + set5_T2_pre x \ K1 \ = {} \ + set6_T2_pre x \ K2 \ = {} \ + noclash_T2 x \ + \ \ Param \ P2 (T2_ctor x) \" +shows "\\\Param. P1 z \ \ P2 z2 \" + apply (rule existential_induct) + subgoal for x \ + apply (rule fresh_cases(1)[of "K1 \" "K2 \" "T1_ctor x"]) + apply (erule assms)+ + apply (rule exI) + apply (rule conjI) + apply (erule sym) + apply (rule impI) + apply (erule conjE)+ + apply (rule IHs) + (* for i in [~rec_vars - 2 ..~3] *) + apply (rotate_tac -6) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule ballE) + apply assumption + apply (rotate_tac -1) + apply (erule contrapos_np) + apply assumption + (* repeated *) + apply (rotate_tac -5) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule ballE) + apply assumption + apply (rotate_tac -1) + apply (erule contrapos_np) + apply assumption + (* repeated *) + apply (rotate_tac -4) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule ballE) + apply assumption + apply (rotate_tac -1) + apply (erule contrapos_np) + apply assumption + (* repeated *) + apply (rotate_tac -3) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule ballE) + apply assumption + apply (rotate_tac -1) + apply (erule contrapos_np) + apply assumption + (* END for *) + apply assumption+ + done + (* second goal, same tactic *) + subgoal for x \ + apply (rule fresh_cases(2)[of "K1 \" "K2 \" "T2_ctor x"]) + apply (erule assms)+ + apply (rule exI) + apply (rule conjI) + apply (erule sym) + apply (rule impI) + apply (erule conjE)+ + apply (rule IHs) + (* for i in [~rec_vars - 2 ..~3] *) + apply (rotate_tac -6) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule ballE) + apply assumption + apply (rotate_tac -1) + apply (erule contrapos_np) + apply assumption + (* repeated *) + apply (rotate_tac -5) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule ballE) + apply assumption + apply (rotate_tac -1) + apply (erule contrapos_np) + apply assumption + (* repeated *) + apply (rotate_tac -4) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule ballE) + apply assumption + apply (rotate_tac -1) + apply (erule contrapos_np) + apply assumption + (* repeated *) + apply (rotate_tac -3) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule ballE) + apply assumption + apply (rotate_tac -1) + apply (erule contrapos_np) + apply assumption + (* END for *) + apply assumption+ + done + done + +lemma fresh_induct: + assumes "|A1::'a::{var_T1_pre, var_T2_pre} set| x. + (\z. z \ set8_T1_pre x \ P1 z) \ + (\z. z \ set9_T1_pre x \ P1 z) \ + (\z. z \ set10_T1_pre x \ P2 z) \ + (\z. z \ set11_T1_pre x \ P2 z) \ + set5_T1_pre x \ A1 = {} \ + set6_T1_pre x \ A2 = {} \ + noclash_T1 x \ + P1 (T1_ctor x)" + "\x. + (\z. z \ set8_T2_pre x \ P1 z) \ + (\z. z \ set9_T2_pre x \ P1 z) \ + (\z. z \ set10_T2_pre x \ P2 z) \ + (\z. z \ set11_T2_pre x \ P2 z) \ + set5_T2_pre x \ A1 = {} \ + set6_T2_pre x \ A2 = {} \ + noclash_T2 x \ + P2 (T2_ctor x)" + shows "P1 z \ P2 z2" + apply (rule fresh_induct_param[of UNIV "\_. A1" "\_. A2" "\x _. P1 x" "\x _. P2 x", unfolded ball_UNIV, THEN spec]) + apply (rule assms)+ + apply assumption+ + apply (rule assms) + apply assumption+ + done + +lemma permute_congs: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and g1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and g2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + and x::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1" + and x2::"('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2" + assumes "bij f1" "|supp f1| a. a \ FVars_T11 x \ f1 a = g1 a) \ (\a. a \ FVars_T12 x \ f2 a = g2 a) \ permute_T1 f1 f2 x = permute_T1 g1 g2 x" + "(\a. a \ FVars_T21 x2 \ f1 a = g1 a) \ (\a. a \ FVars_T22 x2 \ f2 a = g2 a) \ permute_T2 f1 f2 x2 = permute_T2 g1 g2 x2" + apply (unfold atomize_all atomize_imp eq_on_def[symmetric] permute_T1_def permute_T2_def FVars_defs) + apply (rule impI)+ + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bijs) + apply (rule assms)+ + apply assumption+ + apply (rule alpha_refls) + (* second goal, same tactic *) + apply (rule impI)+ + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bijs) + apply (rule assms)+ + apply assumption+ + apply (rule alpha_refls) + done + +lemmas permute_cong_ids = permute_congs[OF _ _ _ _ bij_id supp_id_bound bij_id supp_id_bound, unfolded permute_ids id_apply] + +lemma nnoclash_noclashs: + "noclash_T1 x = noclash_raw_T1 (map_T1_pre id id id id id id id TT1_rep TT1_rep TT2_rep TT2_rep x)" + "noclash_T2 x2 = noclash_raw_T2 (map_T2_pre id id id id id id id TT1_rep TT1_rep TT2_rep TT2_rep x2)" + apply (unfold noclash_T1_def noclash_T2_def noclash_raw_T1_def noclash_raw_T2_def) + apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id) + apply (unfold image_comp[unfolded comp_def] FVars_defs[symmetric]) + apply (rule refl) + (* second goal, same tactic *) + apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id) + apply (unfold image_comp[unfolded comp_def] FVars_defs[symmetric]) + apply (rule refl) + done + +lemma noclash_permutes: + fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + assumes "bij f1" "|supp f1| +val fp_res = { fp = BNF_Util.Least_FP, + binding_relation = [[[1, 3]], [[1]]], + rec_vars = [2, 2], + bfree_vars = [0], + fp_thms = SOME { + subshape_rel = @{term "{(x, y). case x of + Inl t1 \ (case y of Inl t1' \ subshape_T1_T1 t1 t1' | Inr t2 \ subshape_T1_T2 t1 t2) + | Inr t2 \ (case y of Inl t1 \ subshape_T2_T1 t2 t1 | Inr t2' \ subshape_T2_T2 t2 t2') + } :: ((('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 + _) \ _) set"}, + subshapess = [ + [ @{term "subshape_T1_T1 :: _ => ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 \ _"}, + @{term "subshape_T2_T1 :: _ => ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 \ _"} + ], + [ @{term "subshape_T1_T2 :: _ => ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2 \ _"}, + @{term "subshape_T2_T2 :: _ => ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2 \ _"} + ] + ], + wf_subshape = @{thm wf_subshape}, + set_subshapess = [@{thms set_subshapess(1-4)}, @{thms set_subshapess(5-8)}], + set_subshape_permutess = [@{thms set_subshape_permutess(1-4)}, @{thms set_subshape_permutess(5-8)}], + subshape_induct = @{thm subshape_induct}, + existential_induct = @{thm existential_induct}, + fresh_induct_param = @{thm fresh_induct_param}, + fresh_induct = @{thm fresh_induct} + }, + quotient_fps = [ + { T = @{typ "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1"}, + ctor = @{term "T1_ctor :: _ \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1"}, + permute = @{term "permute_T1 :: _ => _ => _ => ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1"}, + FVarss = [ + @{term "FVars_T11 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1 \ _"}, + @{term "FVars_T12 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1 \ _"} + ], + noclash = ( + @{term "noclash_T1 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1' \ _"}, + @{thm noclash_T1_def} + ), + inject = @{thm TT_inject0s(1)}, + permute_ctor = @{thm permute_simps(1)}, + permute_id0 = @{thm permute_id0s(1)}, + permute_id = @{thm permute_ids(1)}, + permute_comp0 = @{thm permute_comp0s(1)}, + permute_comp = @{thm permute_comps(1)}, + FVars_ctors = @{thms FVars_ctors(1-2)}, + FVars_permutes = @{thms FVars_permutes(1-2)}, + FVars_intross = [@{thms FVars_intros(1-6)}, @{thms FVars_intros(13-17)}], + card_of_FVars_bounds = @{thms FVars_bds(1-2)}, + card_of_FVars_bound_UNIVs = @{thms FVars_bd_UNIVs(1-2)}, + inner = { + abs = @{term "TT1_abs :: _ \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1"}, + rep = @{term "TT1_rep :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T1 \ _"}, + permute_def = @{thm permute_T1_def}, + ctor_def = @{thm T1_ctor_def}, + FVars_defs = @{thms FVars_defs(1-2)}, + fresh_cases = @{thm fresh_cases(1)}, + noclash_permute = @{thm noclash_permutes(1)}, + nnoclash_noclash = @{thm nnoclash_noclashs(1)}, + total_abs_eq_iff = @{thm TT_total_abs_eq_iffs(1)}, + abs_rep = @{thm TT_abs_rep(1)}, + rep_abs = @{thm TT_rep_abs(1)}, + rep_abs_sym = @{thm TT_rep_abs_syms(1)}, + abs_ctor = @{thm TT_abs_ctors(1)}, + permute_cong = @{thm permute_congs(1)}, + permute_cong_id = @{thm permute_cong_ids(1)}, + permute_bij = @{thm permute_bijs(1)}, + permute_inv_simp = @{thm permute_inv_simps(1)} + } + }, + { T = @{typ "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2"}, + ctor = @{term "T2_ctor :: _ \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2"}, + permute = @{term "permute_T2 :: _ => _ => _ => ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2"}, + FVarss = [ + @{term "FVars_T21 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2 \ _"}, + @{term "FVars_T22 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2 \ _"} + ], + noclash = ( + @{term "noclash_T2 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2' \ _"}, + @{thm noclash_T2_def} + ), + inject = @{thm TT_inject0s(2)}, + permute_ctor = @{thm permute_simps(2)}, + permute_id0 = @{thm permute_id0s(2)}, + permute_id = @{thm permute_ids(2)}, + permute_comp0 = @{thm permute_comp0s(2)}, + permute_comp = @{thm permute_comps(2)}, + FVars_ctors = @{thms FVars_ctors(3-4)}, + FVars_permutes = @{thms FVars_permutes(3-4)}, + FVars_intross = [@{thms FVars_intros(7-12)}, @{thms FVars_intros(18-22)}], + card_of_FVars_bounds = @{thms FVars_bds(3-4)}, + card_of_FVars_bound_UNIVs = @{thms FVars_bd_UNIVs(3-4)}, + inner = { + abs = @{term "TT2_abs :: _ \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2"}, + rep = @{term "TT2_rep :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) T2 \ _"}, + ctor_def = @{thm T2_ctor_def}, + permute_def = @{thm permute_T2_def}, + FVars_defs = @{thms FVars_defs(3-4)}, + fresh_cases = @{thm fresh_cases(2)}, + noclash_permute = @{thm noclash_permutes(2)}, + nnoclash_noclash = @{thm nnoclash_noclashs(2)}, + total_abs_eq_iff = @{thm TT_total_abs_eq_iffs(2)}, + abs_rep = @{thm TT_abs_rep(2)}, + rep_abs = @{thm TT_rep_abs(2)}, + rep_abs_sym = @{thm TT_rep_abs_syms(2)}, + abs_ctor = @{thm TT_abs_ctors(2)}, + permute_cong = @{thm permute_congs(2)}, + permute_cong_id = @{thm permute_cong_ids(2)}, + permute_bij = @{thm permute_bijs(2)}, + permute_inv_simp = @{thm permute_inv_simps(2)} + } + } + ], + raw_fps = [ + { T = @{typ "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1"}, + ctor = @{term "raw_T1_ctor :: _ \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1"}, + permute = @{term "permute_raw_T1 :: _ => _ => _ => ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1"}, + FVarss = [ + @{term "FVars_raw_T11 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 \ _"}, + @{term "FVars_raw_T12 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 \ _"} + ], + noclash = ( + @{term "noclash_raw_T1 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1' \ _"}, + @{thm noclash_raw_T1_def} + ), + inject = @{thm raw_T1.inject}, + permute_ctor = @{thm permute_raw_simps(1)}, + permute_id0 = @{thm permute_raw_id0s(1)}, + permute_id = @{thm permute_raw_ids(1)}, + permute_comp0 = @{thm permute_raw_comp0s(1)}, + permute_comp = @{thm permute_raw_comps(1)}, + FVars_ctors = @{thms FVars_raw_ctors(1-2)}, + FVars_permutes = @{thms FVars_raw_permutes(1-2)}, + FVars_intross = [@{thms FVars_raw_intros(1-6)}, @{thms FVars_raw_intros(13-17)}], + card_of_FVars_bounds = @{thms FVars_raw_bds(1-2)}, + card_of_FVars_bound_UNIVs = @{thms FVars_raw_bd_UNIVs(1-2)}, + inner = { + alpha = @{term "alpha_T1 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T1 \ _ \ _"}, + exhaust = @{thm raw_T1.exhaust}, + alpha_refl = @{thm alpha_refls(1)}, + alpha_sym = @{thm alpha_syms(1)}, + alpha_trans = @{thm alpha_trans(1)}, + alpha_bij = @{thm alpha_bijs(1)}, + alpha_bij_eq = @{thm alpha_bij_eqs(1)}, + alpha_bij_eq_inv = @{thm alpha_bij_eq_invs(1)}, + alpha_FVarss = @{thms alpha_FVars(1-2)}, + alpha_intro = @{thm alpha_T1_alpha_T2.intros(1)}, + alpha_elim = @{thm alpha_T1.cases} + } + }, + { T = @{typ "('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2"}, + ctor = @{term "raw_T2_ctor :: _ \ ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2"}, + permute = @{term "permute_raw_T2 :: _ => _ => _ => ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2"}, + FVarss = [ + @{term "FVars_raw_T21 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2 \ _"}, + @{term "FVars_raw_T22 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2 \ _"} + ], + noclash = ( + @{term "noclash_raw_T2 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2' \ _"}, + @{thm noclash_raw_T2_def} + ), + inject = @{thm raw_T2.inject}, + permute_ctor = @{thm permute_raw_simps(2)}, + permute_id0 = @{thm permute_raw_id0s(2)}, + permute_id = @{thm permute_raw_ids(2)}, + permute_comp0 = @{thm permute_raw_comp0s(2)}, + permute_comp = @{thm permute_raw_comps(2)}, + FVars_ctors = @{thms FVars_raw_ctors(3-4)}, + FVars_permutes = @{thms FVars_raw_permutes(3-4)}, + FVars_intross = [@{thms FVars_raw_intros(7-12)}, @{thms FVars_raw_intros(18-22)}], + card_of_FVars_bounds = @{thms FVars_raw_bds(3-4)}, + card_of_FVars_bound_UNIVs = @{thms FVars_raw_bd_UNIVs(3-4)}, + inner = { + alpha = @{term "alpha_T2 :: ('a::{var_T1_pre,var_T2_pre}, 'b::{var_T1_pre,var_T2_pre}, 'c::{var_T1_pre,var_T2_pre}, 'd) raw_T2 \ _ \ _"}, + exhaust = @{thm raw_T2.exhaust}, + alpha_refl = @{thm alpha_refls(2)}, + alpha_sym = @{thm alpha_syms(2)}, + alpha_trans = @{thm alpha_trans(2)}, + alpha_bij = @{thm alpha_bijs(2)}, + alpha_bij_eq = @{thm alpha_bij_eqs(2)}, + alpha_bij_eq_inv = @{thm alpha_bij_eq_invs(2)}, + alpha_FVarss = @{thms alpha_FVars(3-4)}, + alpha_intro = @{thm alpha_T1_alpha_T2.intros(2)}, + alpha_elim = @{thm alpha_T2.cases} + } + } ], + pre_mrbnfs = map (the o MRBNF_Def.mrbnf_of @{context}) ["Composition.T1_pre", "Composition.T2_pre"] +} : MRBNF_FP_Def_Sugar.fp_result +\ + +local_setup \MRBNF_FP_Def_Sugar.register_fp_results [fp_res]\ + +(* Test of automation, disgarding result *) +ML_file \../Tools/mrbnf_fp.ML\ +local_setup \fn lthy => +let + val (fp_res, _) = MRBNF_FP.construct_binder_fp BNF_Util.Least_FP + [(("TT1", hd (#pre_mrbnfs fp_res)), 2), (("TT2", nth (#pre_mrbnfs fp_res) 1), 2)] + [[([0], [1, 3])], [([], [1])]] + lthy + val _ = @{print} fp_res +in lthy end +\ + +end \ No newline at end of file diff --git a/operations/Least_Fixpoint2.thy b/operations/Least_Fixpoint2.thy index ffbefab0..41dc2e0f 100644 --- a/operations/Least_Fixpoint2.thy +++ b/operations/Least_Fixpoint2.thy @@ -61,7 +61,6 @@ declare [[quick_and_dirty=false]] lemmas infinite_UNIV = cinfinite_imp_infinite[OF term_pre.UNIV_cinfinite] - (********************** BINDER FIXPOINT CONSTRUCTION **************************************) typ "('a, 'b1, 'b2, 'brec1, 'brec2, 'rec) term_pre" @@ -73,7 +72,7 @@ primrec permute_raw_term :: "('a::var_term_pre \ 'a) \ ' map_term_pre id id id (permute_raw_term f) (permute_raw_term f) (permute_raw_term f) x ))" -lemma permute_raw_simp: +lemma permute_raw_simps: fixes f::"'a::var_term_pre \ 'a" assumes "bij f" "|supp f| 'a set" wh definition "suppGr f \ {(x, f x) | x. f x \ x}" coinductive alpha_term :: "'a::var_term_pre raw_term \ 'a raw_term \ bool" where - "\ bij g ; |supp g| suppGr f2 \ suppGr g ; - bij f1 ; |supp f1| (FVars_raw_term ` set4_term_pre x) - (set2_term_pre x \ set3_term_pre x)) f1 ; + "\ bij g ; |supp g| (FVars_raw_term ` set4_term_pre x) - (set2_term_pre x \ set3_term_pre x)) g ; bij f2 ; |supp f2| (FVars_raw_term ` set5_term_pre x) - set3_term_pre x) f2 ; - mr_rel_term_pre id g g (\x. alpha_term (permute_raw_term f1 x)) (\x. alpha_term (permute_raw_term f2 x)) alpha_term x y + eq_on (set3_term_pre x) f2 g ; + mr_rel_term_pre id g g (\x. alpha_term (permute_raw_term g x)) (\x. alpha_term (permute_raw_term f2 x)) alpha_term x y \ \ alpha_term (raw_term_ctor x) (raw_term_ctor y)" monos conj_context_mono term_pre.mr_rel_mono[OF supp_id_bound] +type_synonym 'a raw_term_pre = "('a, 'a, 'a, 'a raw_term, 'a raw_term, 'a raw_term) term_pre" + +definition avoid_raw_term :: "'a::var_term_pre raw_term_pre \ 'a set \ 'a raw_term_pre" where + "avoid_raw_term x A \ SOME y. (set2_term_pre y \ set3_term_pre y) \ A = {} \ alpha_term (raw_term_ctor x) (raw_term_ctor y)" + +typedef ('a::var_term_pre) "term" = "(UNIV::'a raw_term set) // { (x, y). alpha_term x y }" + apply (rule exI) + apply (rule quotientI) + apply (rule UNIV_I) + done + +abbreviation "TT_abs \ quot_type.abs alpha_term Abs_term" +abbreviation "TT_rep \ quot_type.rep Rep_term" + +type_synonym 'a term_pre' = "('a, 'a, 'a, 'a term, 'a term, 'a term) term_pre" + +definition term_ctor :: "'a::var_term_pre term_pre' \ 'a term" where + "term_ctor x \ TT_abs (raw_term_ctor (map_term_pre id id id TT_rep TT_rep TT_rep x))" + +definition permute_term :: "('a::var_term_pre \ 'a) \ 'a term \ 'a term" where + "permute_term f x \ TT_abs (permute_raw_term f (TT_rep x))" + +definition FVars_term :: "'a::var_term_pre term \ 'a set" where + "FVars_term x \ FVars_raw_term (TT_rep x)" + +definition avoid_term :: "'a::var_term_pre term_pre' \ 'a set \ 'a term_pre'" where + "avoid_term x A \ map_term_pre id id id TT_abs TT_abs TT_abs ( + avoid_raw_term (map_term_pre id id id TT_rep TT_rep TT_rep x) A)" + +inductive subshape_term_term :: "'a::var_term_pre raw_term \ 'a raw_term \ bool" where + "\ bij f ; |supp f| set4_term_pre x \ set5_term_pre x \ set6_term_pre x \ \ subshape_term_term y (raw_term_ctor x)" + +definition noclash_raw_term :: "'a::var_term_pre raw_term_pre \ bool" where + "noclash_raw_term x \ (set2_term_pre x \ set3_term_pre x) \ (set1_term_pre x \ \(FVars_raw_term ` set6_term_pre x)) = {}" + +definition noclash_term :: "'a::var_term_pre term_pre' \ bool" where + "noclash_term x \ (set2_term_pre x \ set3_term_pre x) \ (set1_term_pre x \ \(FVars_term ` set6_term_pre x)) = {}" + (****************** PROOFS ******************) -lemma permute_raw_id: "permute_raw_term id x = x" +lemma permute_raw_ids: "permute_raw_term id x = x" apply (rule raw_term.induct[of _ x]) apply (rule trans) - apply (rule permute_raw_simp) + apply (rule permute_raw_simps) apply (rule bij_id supp_id_bound)+ apply (rule trans) apply (rule arg_cong[of _ _ raw_term_ctor]) @@ -120,19 +159,32 @@ lemma permute_raw_id: "permute_raw_term id x = x" apply (rule refl trans[OF _ id_apply[symmetric]] | assumption)+ done +lemmas permute_raw_id0s = permute_raw_ids[abs_def, unfolded id_def[symmetric], THEN meta_eq_to_obj_eq] + lemma permute_raw_comps: fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" assumes f_prems: "bij f" "|supp f| g) x" - sorry + apply (rule raw_term.induct[of _ x]) + apply (subst permute_raw_simps, (rule assms bij_comp supp_comp_bound infinite_UNIV)+)+ + apply (subst term_pre.map_comp) + apply (rule assms)+ + apply (rule arg_cong[OF term_pre.map_cong]) + apply (rule assms bij_comp supp_comp_bound infinite_UNIV refl)+ + apply (rule trans[OF comp_apply], assumption)+ + done -lemma permute_raw_congs: +lemma permute_raw_comp0s: fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" assumes f_prems: "bij f" "|supp f| a. a \ FVars_raw_term x \ f a = g a) \ permute_raw_term f x = permute_raw_term g x" - sorry + shows "permute_raw_term f \ permute_raw_term g = permute_raw_term (f \ g)" + apply (rule ext) + apply (rule trans[OF comp_apply]) + apply (rule permute_raw_comps) + apply (rule assms)+ + done lemma FVars_raw_intros: "a \ set1_term_pre x \ a \ FVars_raw_term (raw_term_ctor x)" @@ -143,7 +195,132 @@ lemma FVars_raw_intros: apply (erule free_raw_term.intros | assumption)+ done -lemma alpha_refl: +lemma FVars_raw_ctors: + "FVars_raw_term (raw_term_ctor x) = set1_term_pre x \ (\(FVars_raw_term ` set4_term_pre x) - (set2_term_pre x \ set3_term_pre x)) + \ (\(FVars_raw_term ` set5_term_pre x) - set3_term_pre x) \ \(FVars_raw_term ` set6_term_pre x)" + apply (rule subset_antisym) + apply (unfold FVars_raw_term_def)[1] + apply (rule subsetI) + apply (unfold mem_Collect_eq) + apply (erule free_raw_term.cases) + (* REPEAT_DETERM *) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 1] 1\) + apply assumption + (* repeated *) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 2] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply (unfold mem_Collect_eq) + apply assumption+ + (* repeated *) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 3] 1\) + apply (rule DiffI) + apply (rule UN_I) + apply (unfold mem_Collect_eq) + apply assumption+ + (* repeated *) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst_thin + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 4] 1\) + apply (rule UN_I) + apply (unfold mem_Collect_eq) + apply assumption+ + (* END REPEAT_DETERM *) + apply (rule subsetI) + apply (erule UnE)+ + apply (((erule DiffE UN_E)+)?, erule FVars_raw_intros, (assumption+)?)+ + done + +lemma FVars_raw_permute_leq: + fixes f::"'a::var_term_pre \ 'a" + assumes f_prems: "bij f" "|supp f| f a \ FVars_raw_term (permute_raw_term f x)" + apply (erule free_raw_term.induct[of _ x]) + (* REPEAT_DETERM *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst term_pre.set_map, (rule assms supp_id_bound bij_id)+)+ + apply (unfold image_comp[unfolded comp_def]) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 1] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption)) + apply assumption + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst term_pre.set_map, (rule assms supp_id_bound bij_id)+)+ + apply (unfold image_comp[unfolded comp_def]) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 2] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption)) + apply assumption + apply (unfold image_Un[symmetric])[1] + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst term_pre.set_map, (rule assms supp_id_bound bij_id)+)+ + apply (unfold image_comp[unfolded comp_def]) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 3] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption)) + apply assumption + apply ((unfold image_Un[symmetric])[1])? + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* repeated *) + apply (unfold permute_raw_simps[OF assms] FVars_raw_ctors)[1] + apply (subst term_pre.set_map, (rule assms supp_id_bound bij_id)+)+ + apply (unfold image_comp[unfolded comp_def]) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 4 4] 1\) + apply (rule DiffI)? + apply (rule imageI | (rule UN_I, assumption)) + apply assumption + apply ((unfold image_Un[symmetric])[1])? + apply (rule iffD2[OF arg_cong[OF inj_image_mem_iff[OF bij_is_inj]]], rule assms, assumption)? + (* END REPEAT_DETERM *) + done + +lemma FVars_raw_permutes: + fixes f::"'a::var_term_pre \ 'a" + assumes f_prems: "bij f" "|supp f| bij g \ suppGr f \ suppGr g \ suppGr (inv f) \ suppGr (inv g)" - unfolding suppGr_def using bij_imp_inv[of f] bij_imp_inv[of g] - apply auto - subgoal - proof - - fix x :: 'a - assume a1: "bij f" - assume a2: "bij g" - assume a3: "{(x, f x) |x. f x \ x} \ {(x, g x) |x. g x \ x}" - assume "\a. (inv f a = a) = (f a = a)" - assume a4: "f x \ x" - have "\a f. (\aa. (\ab. (aa::'a) = ab \ f ab \ (a::'a)) \ f aa = a) \ \ bij f" - by (metis (no_types) bij_pointE) - then obtain aa :: "'a \ ('a \ 'a) \ 'a" and aaa :: "'a \ ('a \ 'a) \ 'a" where - f5: "\a f. (\ab. aa a f = ab \ f ab \ a) \ f (aa a f) = a \ \ bij f" - by moura - then have "\a. (aa x f, x) = (a, g a) \ g a \ a" - using a4 a3 a1 by (smt (z3) mem_Collect_eq subset_iff) - then show "inv f x = inv g x" - using f5 a2 a1 by (metis (no_types) Pair_inject inv_simp1) - qed - by blast - -lemma suppGr_comp: - assumes "bij h1" "bij g" "bij f" "suppGr f \ suppGr g" - shows "suppGr (h1 \ f) \ suppGr (h1 \ g)" -proof - - { fix x - assume a: "h1 (f x) \ x" - have "h1 (g x) = h1 (f x)" - proof (cases "f x = x") - case False - then show ?thesis using a assms(4) unfolding suppGr_def by auto - next - case True - then show ?thesis sorry - qed - } - then show ?thesis unfolding suppGr_def by auto -qed - -lemma alpha_bij: - fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" and f2'::"'a \ 'a" - assumes f_prems: "bij h1" "|supp h1| alpha_term x y \ alpha_term (permute_raw_term h1 x) (permute_raw_term h2 y)" +lemma alpha_bijs: + fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + assumes f_prems: "bij f" "|supp f| alpha_term x y \ alpha_term (permute_raw_term f x) (permute_raw_term g y)" proof - have x: "\(x::'a raw_term) y. (\x' y' f g. bij f \ |supp f| bij g \ |supp g| x = permute_raw_term f x' \ y = permute_raw_term g y' \ eq_on (FVars_raw_term x') f g \ alpha_term x' y') @@ -227,90 +358,1915 @@ proof - apply (erule alpha_term.cases) apply hypsubst apply (unfold triv_forall_equality) - subgoal for h1 h2 g f1 f2 x y + subgoal for f g \ x f2 y + apply (rule exI[of _ "g \ \ \ inv f"]) + apply (rule exI) + apply (rule exI[of _ "g \ f2 \ inv f"]) + apply (rule exI) + apply (rule conjI, rule permute_raw_simps, (rule supp_id_bound bij_id | assumption)+)+ + apply (rule conjI, (rule bij_comp supp_comp_bound bij_imp_bij_inv supp_inv_bound infinite_UNIV | assumption)+)+ - thm ex_avoiding_bij[of f1 "\ (FVars_raw_term ` set5_term_pre x) - set3_term_pre x" "set3_term_pre x"] + apply (subst term_pre.set_map, assumption+)+ + apply (unfold image_Un[symmetric] image_comp[unfolded comp_def]) + apply (subst FVars_raw_permutes, assumption+)+ + apply (unfold image_UN[symmetric]) + apply (subst image_set_diff[OF bij_is_inj, symmetric], assumption+)+ + + apply (rule conjI) + apply (rule id_onI) + apply (erule imageE) + apply hypsubst + apply (rule trans[OF comp_apply]) + apply (rule trans[OF arg_cong[OF inv_simp1]]) + apply assumption + apply (rule trans[OF comp_apply]) + apply (rule trans[OF arg_cong[of _ _ g]]) + apply (erule id_onD) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply (erule DiffE) + apply (erule UN_E) + apply (erule FVars_raw_intros) + apply assumption+ - apply (subgoal_tac "bij f2'") - apply (subgoal_tac "|supp (f2'::'a \ 'a)| (FVars_raw_term ` set5_term_pre x)) f2' f2") - apply (rule exI[of _ "h2 \ g \ inv h1"]) - apply (rule exI[of _ "h2 \ f1' \ inv h1"]) - apply (rule exI[of _ "h2 \ f2' \ inv h1"]) - apply (rule exI)+ - apply (rule conjI, rule permute_raw_simp, (rule supp_id_bound bij_id | assumption)+)+ apply (rule conjI, (rule bij_comp supp_comp_bound bij_imp_bij_inv supp_inv_bound infinite_UNIV | assumption)+)+ - apply (rule conjI[rotated])+ - apply (rule iffD2[OF term_pre.mr_rel_map(1)]) - apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ - apply (unfold id_o o_id) - apply (rule iffD2[OF term_pre.mr_rel_map(3)]) - apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ - apply (unfold comp_assoc inv_id id_o o_id Grp_UNIV_id conversep_eq OO_eq relcompp_conversep_Grp Grp_OO) - apply (subst inv_o_simp1, assumption)+ - apply (unfold id_o o_id comp_assoc[symmetric]) - apply (subst inv_o_simp1, assumption)+ - apply (unfold id_o o_id) - apply (erule term_pre.mr_rel_mono_strong0[rotated -7]) + apply (rule conjI) + apply (rule id_onI) + apply (erule imageE) + apply hypsubst + apply (rule trans[OF comp_apply]) + apply (rule trans[OF arg_cong[OF inv_simp1]]) + apply assumption + apply (rule trans[OF comp_apply]) + apply (rule trans[OF arg_cong[of _ _ g]]) + apply (erule id_onD) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply (erule DiffE) + apply (erule UN_E) + apply (erule FVars_raw_intros) + apply assumption+ + + apply (rule conjI) + apply (rule eq_on_comp2) + apply (rule eq_on_refl) + apply (unfold image_comp inv_o_simp1 image_id)[1] + apply (rule eq_on_comp2) + apply assumption + apply (rule eq_on_refl) + + apply (rule iffD2[OF term_pre.mr_rel_map(1)]) + apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ + apply (unfold id_o o_id) + apply (rule iffD2[OF term_pre.mr_rel_map(3)]) + apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ + apply (unfold comp_assoc inv_id id_o o_id Grp_UNIV_id conversep_eq OO_eq relcompp_conversep_Grp Grp_OO) + apply (subst inv_o_simp1, assumption)+ + apply (unfold id_o o_id comp_assoc[symmetric]) + apply (subst inv_o_simp1, assumption)+ + apply (unfold id_o o_id) + apply (erule term_pre.mr_rel_mono_strong0[rotated -7]) (* REPEAT_DETERM *) - apply (rule ballI) - apply (rule trans) - apply (rule id_apply) - apply (rule sym) - apply (rule trans[OF comp_apply]) - apply (rule inv_f_eq[OF bij_is_inj]) - apply assumption - apply (rule sym) - apply (erule eq_onD) - apply (erule FVars_raw_intros) + apply (rule ballI) + apply (rule trans) + apply (rule id_apply) + apply (rule sym) + apply (rule trans[OF comp_apply]) + apply (rule inv_f_eq[OF bij_is_inj]) + apply assumption + apply (rule sym) + apply (erule eq_onD) + apply (erule FVars_raw_intros) (* END REPEAT_DETERM *) - apply (rule ballI, rule refl)+ - prefer 2 - (* REPEAT_DETERM *) - apply (rule ballI) - apply (rule ballI) - apply (rule impI) - apply (rule disjI1) - apply (rule exI) - apply (rule exI) - apply (rule exI[of _ h2]) - apply (rule exI[of _ h2]) - apply (rule conjI, assumption)+ - apply (rule conjI[rotated])+ - apply assumption - apply (rule eq_on_refl) - apply (rule refl) - apply (rule trans) - apply (rule permute_raw_comps) - apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ - apply (unfold comp_assoc) - apply (subst inv_o_simp1, assumption) - apply (unfold o_id) - apply (rule trans) - apply (rule permute_raw_comps[symmetric]) + apply (rule ballI, rule refl)+ + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply assumption + apply (rule eq_on_refl) + apply (rule refl) + apply (rule trans) + apply (rule permute_raw_comps) + apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ + apply (unfold comp_assoc) + apply (subst inv_o_simp1, assumption) + apply (unfold o_id) + apply (rule trans) + apply (rule permute_raw_comps[symmetric]) + apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ + apply (rule refl) + apply assumption+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply assumption + apply (rule eq_on_refl) + apply (rule refl) + apply (rule trans) + apply (rule permute_raw_comps) + apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ + apply (unfold comp_assoc) + apply (subst inv_o_simp1, assumption) + apply (unfold o_id) + apply (rule trans) + apply (rule permute_raw_comps[symmetric]) apply (assumption | rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV bij_imp_bij_inv supp_inv_bound)+ - apply (rule arg_cong[of _ _ "permute_raw_term h2"]) - apply (rule permute_raw_congs) - apply assumption+ - apply (erule eq_onD) - apply (rule UN_I) - apply assumption+ + apply (rule refl) + apply assumption+ + (* repeated, rec free case *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply assumption + apply (erule eq_on_mono[rotated -1]) + apply (rule subsetI) + apply (erule FVars_raw_intros) + apply assumption + apply (rule refl)+ + apply assumption+ + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id supp_comp_bound bij_comp infinite_UNIV supp_inv_bound bij_imp_bij_inv | assumption)+ + done + done + + show "eq_on (FVars_raw_term x) f g \ alpha_term x y \ alpha_term (permute_raw_term f x) (permute_raw_term g y)" + apply (rule x[THEN spec, THEN spec, THEN mp]) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply assumption+ + apply (rule refl)+ + apply (rule assms)+ + done +qed + +lemma alpha_bij_eqs: + fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + assumes f_prems: "bij f" "|supp f| 'a" and g::"'a \ 'a" + assumes f_prems: "bij f" "|supp f| (\y. alpha_term x y \ a \ FVars_raw_term y)" + "free_raw_term a x \ (\y. alpha_term y x \ a \ FVars_raw_term y)" + apply (erule free_raw_term.induct) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + (* TRY EVERY + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + END TRY *) + apply (drule term_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound | assumption)+ + apply (unfold inv_id) + apply (rotate_tac -2) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp2, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY + apply assumption + apply assumption + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + END TRY *) + (* END REPEAT_DETERM *) + + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_set_transfer(4-6)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule term_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule term_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + (* if not is all bounds EVERY + apply (drule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (rule trans) + apply (rule arg_cong2[OF refl, of _ _ "(`)"]) + prefer 2 + apply (rule trans) + apply (erule eq_on_inv2[THEN eq_on_image, symmetric, rotated -1]) + apply assumption+ + apply (rule arg_cong2[OF refl, of _ _ "(`)"]) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (rotate_tac -1) + END if *) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 1 1] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply ((unfold id_on_Un)[1])? + apply ((erule conjE)+)? + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + apply assumption + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_set_transfer(4-6)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule term_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule term_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + (* if not is all bounds EVERY *) + apply (drule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (rule trans) + apply (rule arg_cong2[OF refl, of _ _ "(`)"]) + prefer 2 + apply (rule trans) + apply (erule eq_on_inv2[THEN eq_on_image, symmetric, rotated -1]) + apply assumption+ + apply (rule arg_cong2[OF refl, of _ _ "(`)"]) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (rotate_tac -1) + (* END EVERY *) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2)? + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 1 1] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply ((unfold id_on_Un)[1])? + apply ((erule conjE)+)? + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + apply assumption + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_set_transfer(4-6)[THEN rel_funD, rotated -1, THEN rel_setD1, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule term_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule term_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2)? + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 1 1] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply ((unfold id_on_Un)[1])? + apply ((erule conjE)+)? + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + apply assumption + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + +(* second goal, similar tactic *) + apply (erule free_raw_term.induct) + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + (* TRY EVERY + apply (drule DiffI[rotated]) + apply assumption + apply (erule thin_rl) + apply (rotate_tac -1) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF id_on_image[symmetric]], rotated -1]) + prefer 2 + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)", OF image_set_diff[OF bij_is_inj]], rotated -1]) + prefer 2 + END TRY *) + (*apply (drule term_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound | assumption)+ + apply (unfold inv_id) + apply (rotate_tac -2)*) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + apply (rule arg_cong2[of _ _ _ _ minus])? + apply ((rule arg_cong[of _ _ "(`) _"])?, erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (unfold image_comp)? + apply ((subst (asm) inv_o_simp2, assumption)+)? + apply (unfold image_id) + apply (erule DiffE)? + apply (erule FVars_raw_intros) + (* TRY EVERY + apply assumption + apply assumption + apply (erule id_on_antimono) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + END TRY *) + (* END REPEAT_DETERM *) + + (* REPEAT_DETERM *) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_set_transfer(4-6)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + (*apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)?*) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + (* new *) + apply (erule imageE) + apply hypsubst + (* end new *) + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + (*apply (drule term_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+*) + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule term_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + (* if not is all bounds EVERY + apply (drule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (rule trans) + apply (rule arg_cong2[OF refl, of _ _ "(`)"]) + prefer 2 + apply (rule trans) + apply (erule eq_on_inv2[THEN eq_on_image, symmetric, rotated -1]) + apply assumption+ + apply (rule arg_cong2[OF refl, of _ _ "(`)"]) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + apply (rotate_tac -1) + END if *) + (* if flipped *) + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 1 1] 1\) + (* else + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 1 1] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply ((unfold id_on_Un)[1])? + apply ((erule conjE)+)? + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + *) + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + (* if flipped *) + apply assumption + (* else + apply (unfold FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + apply assumption*) + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_set_transfer(4-6)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + (*apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)?*) + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY *) + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + (* new *) + apply (erule imageE) + apply hypsubst + (* end new *) + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + (*apply (drule term_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+*) + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule term_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + (* if not is all bounds EVERY *) + apply (drule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (rule trans) + apply (rule arg_cong2[OF refl, of _ _ "(`)"]) + prefer 2 + (* if flipped *) + apply (erule eq_on_image[symmetric]) + apply (rule refl) + (* else + apply (rule trans) + apply (erule eq_on_inv2[THEN eq_on_image, symmetric, rotated -1]) + apply assumption+ + apply (rule arg_cong2[OF refl, of _ _ "(`)"]) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+)+ + *) + apply (rotate_tac -1) + (*END if *) + (* if flipped *) + apply (subst (asm) inj_image_mem_iff[OF bij_is_inj]) + apply assumption + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (erule id_onD) + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 1 1] 1\) + (* else + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2) + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 1 1] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply ((unfold id_on_Un)[1])? + apply ((erule conjE)+)? + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + *) + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + (* if flipped *) + apply assumption + (* else + apply (unfold FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + apply assumption*) + (* END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* repeated *) + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_set_transfer(4-6)[THEN rel_funD, rotated -1, THEN rel_setD2, rotated -1]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1], (rule supp_id_bound bij_id | assumption)+)? + apply (unfold inv_id)? + apply (erule allE) + apply (erule impE) + apply assumption + (* TRY EVERY + apply (subst (asm) FVars_raw_permutes) + apply (rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound | assumption)+ + apply (frule arg_cong2[OF refl, of _ _ "(\)", THEN iffD1, rotated -1]) + apply (drule term_pre.mr_rel_flip[THEN iffD2, rotated -1]) + apply (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+ + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + apply (erule term_pre.mr_rel_set[rotated -1], (rule bij_id supp_id_bound bij_comp bij_imp_bij_inv supp_comp_bound supp_inv_bound infinite_UNIV | assumption)+)+ + apply (unfold image_Un[symmetric])? + apply (rotate_tac -1) + apply (subst (asm) image_in_bij_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (subst (asm) inv_inv_eq) + apply (rule bij_comp bij_imp_bij_inv | assumption)+ + apply (erule imageE) + apply hypsubst + apply (unfold inv_simp1 inv_simp2)? + apply (rule arg_cong2[OF _ refl, of _ _ "(\)", THEN iffD2]) + apply (rule id_on_inv[THEN id_onD, rotated]) + apply assumption + apply (tactic \resolve_tac @{context} [BNF_Util.mk_UnIN 1 1] 1\) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply ((unfold id_on_Un)[1])? + apply ((erule conjE)+)? + apply (erule id_on_image[symmetric]) + apply (rule iffD2[OF image_in_bij_eq]) + apply assumption + apply (rule DiffI[rotated]) + apply assumption + apply (rule UN_I) + apply assumption + apply (unfold FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + apply assumption + END TRY *) + apply (erule FVars_raw_intros) + apply assumption+ + (* END REPEAT_DETERM *) + done + +lemma alpha_FVars: "alpha_term x y \ FVars_raw_term x = FVars_raw_term y" + apply (rule subset_antisym) + apply (rule subsetI) + apply (subst (asm) FVars_raw_term_def) + apply (drule mem_Collect_eq[THEN iffD1]) + apply (erule alpha_FVars_leqs[THEN spec, THEN mp, rotated]) + apply assumption + apply (rule subsetI) + apply (erule alpha_FVars_leqs[THEN spec, THEN mp, rotated]) + apply (unfold FVars_raw_term_def mem_Collect_eq)[1] + apply assumption + done + +lemma alpha_syms: + fixes x::"'a::var_term_pre raw_term" + shows "alpha_term x y \ alpha_term y x" +apply (erule alpha_term.coinduct) + apply (erule alpha_term.cases) + apply hypsubst + apply (rule exI)+ + apply (rule conjI, rule refl)+ + apply (rule conjI[rotated])+ + apply (rule iffD1[OF term_pre.mr_rel_flip, rotated -1]) + apply (unfold inv_id) + apply (erule term_pre.mr_rel_mono_strong0[rotated -7]) + apply (rule ballI, rule refl)+ + apply (rule ballI, rule inv_inv_eq[THEN fun_cong, symmetric], assumption)+ +(* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (assumption | (erule alpha_bij_eq_invs[THEN iffD1, rotated -1], assumption+)) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (assumption | (erule alpha_bij_eq_invs[THEN iffD1, rotated -1], assumption+)) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule conversepI) + apply (rule disjI1) + apply (assumption | (erule alpha_bij_eq_invs[THEN iffD1, rotated -1], assumption+)) + (* END REPEAT_DETERM *) + apply (unfold inv_inv_eq) + apply (assumption | rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound)+ + + (* REPEAT_DETERM *) + (* TRY *) + apply (rule iffD2[OF arg_cong[of _ _ eq_on, THEN fun_cong, THEN fun_cong]]) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound | assumption)+ + apply (rule eq_on_inv2) + apply assumption+ + (* END TRY *) + + apply (rule id_on_inv) + apply assumption + apply (rule id_on_antimono) + apply assumption + apply (rule equalityD1) + + apply (rule sym) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule trans[rotated]) + apply (unfold image_Un)? + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + (* REPEAT_DETERM *) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + (* END REPEAT_DETERM *) + apply (unfold image_Un[symmetric])? + apply (erule eq_on_image)? + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule term_pre.mr_set_transfer[THEN rel_funD, rotated -1, + OF term_pre.mr_rel_mono_strong[rotated -4]]) + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule imp_refl) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + (* apply (rule imp_refl) ORELSE *) + apply (rule impI) + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply assumption+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule imp_refl) + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id supp_inv_bound bij_imp_bij_inv | assumption)+ + (* repeated *) + (* TRY + apply (rule iffD2[OF arg_cong[of _ _ eq_on, THEN fun_cong, THEN fun_cong]]) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound | assumption)+ + apply (rule eq_on_inv2) + apply assumption+ + END TRY *) + + apply (rule id_on_inv) + apply assumption + apply (rule id_on_antimono) + apply assumption + apply (rule equalityD1) + + apply (rule sym) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule trans[rotated]) + apply (unfold image_Un)? + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + (* REPEAT_DETERM *) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + (* repeated *) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + (* END REPEAT_DETERM *) + apply (unfold image_Un[symmetric])[1] + apply (erule eq_on_image | rule refl) + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule term_pre.mr_set_transfer[THEN rel_funD, rotated -1, + OF term_pre.mr_rel_mono_strong[rotated -4]]) + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + (* apply (rule imp_refl) ORELSE *) + apply (rule impI) + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply assumption+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule imp_refl) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule imp_refl) + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id supp_inv_bound bij_imp_bij_inv | assumption)+ + (* END REPEAT_DETERM *) + done + +lemma alpha_trans: "alpha_term x y \ alpha_term y z \ alpha_term x z" +proof - + have x: "(\y. alpha_term x y \ alpha_term y z) \ alpha_term x z" + apply (erule alpha_term.coinduct) + apply (erule exE conjE alpha_term.cases)+ + apply hypsubst + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (frule term_pre.mr_rel_OO[THEN fun_cong, THEN fun_cong, THEN iffD2, rotated -1, OF relcomppI]) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id triv_forall_equality) + subgoal for g x f2 g' y f2' z + apply (rule exI[of _ "g' \ g"]) + apply (rule exI) + apply (rule exI[of _ "f2' \ f2"]) + apply (rule exI) + apply (rule conjI, rule refl)+ + apply (rule conjI[rotated])+ + apply (erule term_pre.mr_rel_mono_strong[rotated -4]) + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply ((subst id_hid_o_hid)+)? + apply (unfold hidden_id_def)? + apply (subst permute_raw_comps[symmetric]) + apply (assumption | rule supp_id_bound bij_id)+ + apply (subst alpha_bij_eq_invs) + apply (assumption | rule supp_id_bound bij_id)+ + apply (rule exI) + apply (rule conjI[rotated]) + apply assumption + apply (subst permute_raw_comps) + apply (assumption | rule supp_id_bound bij_id supp_inv_bound bij_imp_bij_inv)+ + apply (subst inv_o_simp1, assumption)+ + apply (unfold inv_id id_o permute_raw_ids) + apply assumption + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply ((subst id_hid_o_hid)+)? + apply (unfold hidden_id_def)? + apply (subst permute_raw_comps[symmetric]) + apply (assumption | rule supp_id_bound bij_id)+ + apply (subst alpha_bij_eq_invs) + apply (assumption | rule supp_id_bound bij_id)+ + apply (rule exI) + apply (rule conjI[rotated]) + apply assumption + apply (subst permute_raw_comps) + apply (assumption | rule supp_id_bound bij_id supp_inv_bound bij_imp_bij_inv)+ + apply (subst inv_o_simp1, assumption)+ + apply (unfold inv_id id_o permute_raw_ids) + apply assumption + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule disjI1) + apply (erule relcomppE) + apply (rule exI) + apply (rule conjI) + apply assumption + apply assumption + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV | assumption)+ + (* REPEAT_DETERM *) + (* TRY *) + apply (rule eq_on_comp2) + apply assumption + apply (rule iffD2[OF arg_cong3[OF _ refl refl, of _ _ eq_on]]) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + (* END TRY *) + apply (rule id_on_comp) + apply (erule id_on_antimono) + apply (rule equalityD1) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule trans[rotated]) + apply (unfold image_Un)? + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + (* REPEAT_DETERM *) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + (* END REPEAT_DETERM *) + apply (unfold image_Un[symmetric])? + apply (erule eq_on_image | rule refl) + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule term_pre.mr_set_transfer[THEN rel_funD, rotated -1, + OF term_pre.mr_rel_mono_strong[rotated -4]]) + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule imp_refl) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule imp_refl) + (* END REPEAT_DETERM *) + apply (assumption | rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + (* repeated *) + (* TRY + apply (rule eq_on_comp2) + apply assumption + apply (rule iffD2[OF arg_cong3[OF _ refl refl, of _ _ eq_on]]) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + END TRY *) + + apply (rule id_on_comp) + apply (erule id_on_antimono) + apply (rule equalityD1) + apply (rule trans) + apply (rule id_on_image[symmetric]) + prefer 2 + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + prefer 2 + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule trans[rotated]) + apply (unfold image_Un)? + apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + (* REPEAT_DETERM *) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + (* repeated *) + apply (rule sym) + apply (erule term_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + (* END REPEAT_DETERM *) + apply (unfold image_Un[symmetric])? + apply (erule eq_on_image | rule refl) + apply (rule trans) + apply (rule image_UN) + apply (rule rel_set_UN_D) + apply (erule term_pre.mr_set_transfer[THEN rel_funD, rotated -1, + OF term_pre.mr_rel_mono_strong[rotated -4]]) + (* REPEAT_DETERM *) + apply (rule ballI) + apply (rule ballI) + apply (rule impI) + apply (rule trans[rotated]) + apply (erule alpha_FVars) + apply (rule sym) + apply (rule FVars_raw_permutes) + apply (assumption | rule supp_id_bound bij_id)+ + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule imp_refl) + (* repeated *) + apply (rule ballI) + apply (rule ballI) + apply (rule imp_refl) + (* END REPEAT_DETERM *) + apply (assumption | rule supp_id_bound bij_id bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + done + done + + show "alpha_term x y \ alpha_term y z \ alpha_term x z" + apply (rule x) + apply (rule exI) + apply (rule conjI) + apply assumption+ + done qed +lemma raw_refreshs: + fixes x::"('a::var_term_pre, 'a, 'a, 'a raw_term, 'a raw_term, 'a raw_term) term_pre" + assumes "|A| y. (set2_term_pre y \ set3_term_pre y) \ A = {} \ alpha_term (raw_term_ctor x) (raw_term_ctor y)" + + apply (rule exE[OF eextend_fresh[of "set2_term_pre x \ set3_term_pre x" + "(A \ (set2_term_pre x \ set3_term_pre x)) \ ((\(FVars_raw_term ` set4_term_pre x) \ \(FVars_raw_term ` set5_term_pre x)) - (set2_term_pre x \ set3_term_pre x))" + "(\(FVars_raw_term ` set4_term_pre x) \ \(FVars_raw_term ` set5_term_pre x)) - (set2_term_pre x \ set3_term_pre x)" + ]]) + apply (rule var_term_pre_class.Un_bound term_pre.set_bd_UNIV assms ordLeq_ordLess_trans[OF card_of_diff] + term_pre.set_bd[THEN ordLess_ordLeq_trans] var_term_pre_class.UN_bound var_term_pre_class.large FVars_raw_bd_UNIVs infinite_UNIV + )+ + apply (rule Un_upper2) + apply (rule Diff_disjoint) + apply (erule conjE)+ + apply (unfold Un_Diff) + + subgoal for g + apply (rule exE[OF extend_id_on[of g "\ (FVars_raw_term ` set5_term_pre x)" "set2_term_pre x \ set3_term_pre x" "set3_term_pre x"]]) + apply assumption+ + apply (erule id_on_antimono) + apply (rule Un_upper2) + apply assumption + apply (erule Int_subset_empty2) + apply (rule subset_trans[rotated]) + apply (rule Un_upper1) + apply (rule Un_upper2) + + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + apply (erule conjE)+ + + subgoal for f2 + apply (rule exI[of _ "map_term_pre id g g (permute_raw_term g) (permute_raw_term f2) id x"]) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_Un[symmetric]) + apply (rule conjI) + apply (erule Int_subset_empty2) + apply (unfold Un_assoc)[1] + apply (rule Un_upper1) + apply (rule alpha_term.intros[rotated -1]) + apply (rule iffD2[OF term_pre.mr_rel_map(3), rotated -1]) + apply (unfold inv_id id_o Grp_UNIV_id conversep_eq OO_eq) + apply (subst inv_o_simp1, assumption)+ + apply (unfold term_pre.mr_rel_id[symmetric] relcompp_conversep_Grp) + apply (rule term_pre.rel_refl_strong) + apply (rule alpha_refls)+ + apply (rule supp_id_bound bij_id | assumption)+ + + apply (erule id_on_antimono) + apply (rule Un_upper1) + apply assumption+ + done + done + done + +lemma avoid_raw_freshs: + fixes x::"'a::var_term_pre raw_term_pre" + assumes "|A| A = {}" "set3_term_pre (avoid_raw_term x A) \ A = {}" + apply (unfold avoid_raw_term_def) + (* REPEAT_DETERM *) + apply (rule someI2_ex) + apply (rule raw_refreshs[OF assms]) + apply (unfold Int_Un_distrib2 Un_empty)[1] + apply (erule conjE)+ + apply assumption + (* repeated *) + apply (rule someI2_ex) + apply (rule raw_refreshs[OF assms]) + apply (unfold Int_Un_distrib2 Un_empty)[1] + apply (erule conjE)+ + apply assumption + (* END REPEAT_DETERM *) + done + +lemma TT_Quotients: "Quotient alpha_term TT_abs TT_rep (\x. (=) (TT_abs x))" + apply (subgoal_tac "Quotient3 alpha_term TT_abs TT_rep") + prefer 2 + apply (rule quot_type.Quotient) + apply (rule type_definition_quot_type) + apply (rule type_definition_term) + apply (rule equivpI) + apply (rule reflpI) + apply (rule alpha_refls) + apply (rule sympI) + apply (erule alpha_syms) + apply (rule transpI) + apply (erule alpha_trans) + apply assumption + apply (rule QuotientI) + apply (erule Quotient3_abs_rep) + apply (rule alpha_refls) + apply (erule Quotient3_rel[symmetric]) + apply (rule ext)+ + apply (rule iffI) + apply (rule conjI) + apply (rule alpha_refls) + apply assumption + apply (erule conjE) + apply assumption + done + +lemmas TT_total_abs_eq_iffs = TT_Quotients[THEN Quotient_total_abs_eq_iff, OF reflpI[OF alpha_refls]] +lemmas TT_rep_abs = TT_Quotients[THEN Quotient_rep_abs, OF alpha_refls] +lemmas TT_abs_rep = TT_Quotients[THEN Quotient_abs_rep] + +lemmas TT_rep_abs_syms = alpha_syms[OF TT_rep_abs] + +lemma TT_abs_ctors: "TT_abs (raw_term_ctor x) = term_ctor (map_term_pre id id id TT_abs TT_abs TT_abs x)" + apply (unfold term_ctor_def) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (subst term_pre.map_comp) + apply (rule supp_id_bound bij_id)+ + apply (unfold id_o o_id) + apply (rule alpha_term.intros) + apply (rule supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (unfold permute_raw_ids term_pre.mr_rel_id[symmetric]) + apply (rule iffD2[OF term_pre.rel_map(2)]) + apply (unfold comp_def) + apply (rule term_pre.rel_refl_strong) + apply (rule TT_rep_abs_syms)+ + done + +lemma permute_simps: + fixes f::"'a::var_term_pre \ 'a" + assumes "bij f" "|supp f| 'a" + assumes "bij f" "|supp f| permute_term f = permute_term (g \ f)" + apply (rule ext) + apply (rule trans[OF comp_apply]) + apply (unfold permute_term_def) + apply (subst permute_raw_comps[symmetric]) + apply (rule assms)+ + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) + apply (rule assms)+ + apply (rule TT_rep_abs) + done +lemmas permute_comps = trans[OF comp_apply[symmetric] fun_cong[OF permute_comp0s]] +lemma permute_bijs: + fixes f::"'a::var_term_pre \ 'a" + assumes "bij f" "|supp f| 'a" + assumes "bij f" "|supp f| 'a" + assumes "bij f" "|supp f| (\(FVars_term ` set4_term_pre x) - (set2_term_pre x \ set3_term_pre x)) + \ (\(FVars_term ` set5_term_pre x) - set3_term_pre x) \ \(FVars_term ` set6_term_pre x)" + apply (unfold FVars_term_def term_ctor_def) + apply (rule trans) + apply (rule alpha_FVars) + apply (rule TT_rep_abs) + apply (rule trans) + apply (rule FVars_raw_ctors) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id image_comp[unfolded comp_def]) + apply (rule refl) + done +lemma FVars_intros: + "a \ set1_term_pre x \ a \ FVars_term (term_ctor x)" + "z \ set4_term_pre x \ a \ FVars_term z \ a \ set2_term_pre x \ set3_term_pre x \ a \ FVars_term (term_ctor x)" + "z \ set5_term_pre x \ a \ FVars_term z \ a \ set3_term_pre x \ a \ FVars_term (term_ctor x)" + "z \ set6_term_pre x \ a \ FVars_term z \ a \ FVars_term (term_ctor x)" + apply (unfold FVars_term_def term_ctor_def alpha_FVars[OF TT_rep_abs]) + (* for thm in FVars_intros *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(1)[rotated]) + apply (subst term_pre.set_map) + apply (rule supp_id_bound bij_id)+ + apply (unfold image_id)? + apply assumption? + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(2)[rotated]) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id)? + apply assumption? + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(3)[rotated]) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id)? + apply assumption? + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* repeated *) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated -1]) + prefer 2 + apply (erule FVars_raw_intros(4)[rotated]) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id)? + apply assumption? + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)? + apply (erule imageI)? + apply (rule refl) + (* END REPEAT_DETERM *) + done + +lemma TT_inject0s: + "(term_ctor x = term_ctor y) \ (\(g::'a::var_term_pre \ 'a) f2. + bij g \ |supp g| + id_on (\(FVars_term ` set4_term_pre x) - (set2_term_pre x \ set3_term_pre x)) g \ + bij f2 \ |supp f2| id_on (\(FVars_term ` set5_term_pre x) - set3_term_pre x) f2 \ + eq_on (set3_term_pre x) f2 g \ + map_term_pre id g g (permute_term g) (permute_term f2) id x = y)" + apply (unfold term_ctor_def permute_term_def) + apply (rule trans) + apply (rule TT_total_abs_eq_iffs) + apply (rule iffI) + apply (erule alpha_term.cases) + apply (drule iffD1[OF raw_term.inject])+ + apply hypsubst + apply (subst (asm) term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id image_comp[unfolded comp_def]) + apply (drule iffD1[OF term_pre.mr_rel_map(1), rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id) + apply (drule iffD1[OF term_pre.mr_rel_map(3), rotated -1]) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold inv_id id_o o_id relcompp_conversep_Grp) + apply (unfold Grp_OO FVars_term_def[symmetric]) + apply (rule exI)+ + apply (rule conjI[rotated])+ + apply (rule term_pre.mr_rel_eq[THEN fun_cong, THEN fun_cong, THEN iffD1]) + apply (rule iffD2[OF term_pre.mr_rel_map(1), rotated -1]) + apply (unfold id_o o_id Grp_OO) + apply (erule term_pre.mr_rel_mono_strong[rotated -4]) + (* REPEAT_DETERM *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply assumption + (* repeated *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply assumption + (* repeated *) + apply (rule ballI impI)+ + apply (drule TT_total_abs_eq_iffs[THEN iffD2]) + apply (unfold TT_abs_rep) + apply hypsubst + apply (rule id_apply) + (* END REPEAT_DETERM *) + apply (rule supp_id_bound bij_id | assumption)+ + + apply (erule exE conjE)+ + apply hypsubst_thin + apply (subst term_pre.map_comp) + apply (rule supp_id_bound bij_id | assumption)+ + apply (unfold id_o o_id) + apply (unfold comp_def) + apply (rule alpha_term.intros[rotated -1]) + apply (rule iffD2[OF term_pre.mr_rel_map(1), rotated -1]) + apply (unfold id_o o_id Grp_UNIV_id eq_OO) + apply (rule iffD2[OF term_pre.mr_rel_map(3), rotated -1]) + apply (unfold inv_id id_o o_id Grp_UNIV_id conversep_eq eq_OO) + apply (unfold relcompp_conversep_Grp Grp_OO) + apply (subst inv_o_simp1, assumption)+ + apply (rule iffD1[OF term_pre.mr_rel_id[THEN fun_cong, THEN fun_cong]]) + apply (rule term_pre.rel_refl_strong) + apply (rule alpha_refls TT_rep_abs_syms)+ + apply (rule supp_id_bound bij_id | assumption)+ + (* REPEAT_DETERM *) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id FVars_term_def image_comp[unfolded comp_def]) + apply assumption+ + (* repeated *) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id FVars_term_def image_comp[unfolded comp_def]) + apply assumption+ + (* repeated *) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id FVars_term_def image_comp[unfolded comp_def]) + apply assumption+ + (* END REPEAT_DETERM *) + done + +lemma avoid_freshs: + fixes x::"'a::var_term_pre term_pre'" + assumes "|A| A = {}" "set3_term_pre (avoid_term x A) \ A = {}" + apply (unfold avoid_term_def) + (* REPEAT_DETERM *) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id) + apply (rule avoid_raw_freshs[OF assms]) + (* repeated *) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id) + apply (rule avoid_raw_freshs[OF assms]) + (* END REPEAT_DETERM *) + done + +lemma alpha_avoids: + fixes x::"'a::var_term_pre term_pre'" + assumes "|A| (x::'a term_pre'). y = term_ctor x \ set2_term_pre x \ A = {} \ set3_term_pre x \ A = {} \ P" +shows P + apply (rule raw_term.exhaust[of "TT_rep y"]) + apply (rule assms) + defer + apply (rule avoid_freshs[OF assms(1)])+ + apply (rule trans[rotated]) + apply (rule sym) + apply (rule alpha_avoids[OF assms(1)]) + apply (unfold term_ctor_def) + apply (rule TT_Quotients[THEN Quotient_rel_abs2]) + apply (rule arg_cong2[OF _ refl, of _ _ alpha_term, THEN iffD2]) + apply assumption + apply (rule alpha_term.intros) + apply (rule supp_id_bound bij_id id_on_id eq_on_refl)+ + apply (subst term_pre.map_comp) + apply (rule supp_id_bound bij_id)+ + apply (unfold id_o o_id) + apply (rule iffD2[OF term_pre.mr_rel_map(3), rotated -1]) + apply (unfold inv_id id_o o_id Grp_OO relcompp_conversep_Grp) + apply (unfold comp_def term_pre.mr_rel_id[symmetric] permute_raw_ids) + apply (rule term_pre.rel_refl_strong) + apply (rule TT_rep_abs_syms)+ + apply (rule supp_id_bound bij_id)+ + done + +lemma alpha_subshapess: "alpha_term x y \ subshape_term_term z x \ subshape_term_term z y" +proof - + have x: "(\x. alpha_term x y \ (\z. subshape_term_term z x \ subshape_term_term z y))" + apply (rule raw_term.induct[of _ y]) + subgoal premises IHs for x + apply (rule allI impI)+ + apply (erule alpha_term.cases) + apply (erule subshape_term_term.cases) + apply hypsubst + apply (drule iffD1[OF raw_term.inject])+ + apply hypsubst + apply (erule UnE)+ + (* REPEAT_DETERM *) + apply (drule term_pre.mr_rel_set(4-6)[rotated -1]) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (frule IHs) + apply (erule allE) + apply (erule impE) + apply assumption + apply (rule subshape_term_term.intros[rotated -1]) + apply (tactic \eresolve_tac @{context} [BNF_Util.mk_UnIN 3 1] 1\) + prefer 3 (* 2 * nvars + 1 *) + apply (rule alpha_trans[rotated]) + apply assumption + apply (rule alpha_trans[rotated]) + apply (rule alpha_bij_eqs[THEN iffD2, rotated -1]) + apply assumption+ + apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ alpha_term], rotated]) + apply (rule alpha_refls) + apply (rule sym) + apply (rule permute_raw_comps) + apply assumption+ + apply (rule bij_comp supp_comp_bound infinite_UNIV | assumption)+ + (* repeated *) + apply (drule term_pre.mr_rel_set(4-6)[rotated -1]) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (frule IHs) + apply (erule allE) + apply (erule impE) + apply assumption + apply (rule subshape_term_term.intros[rotated -1]) + apply (tactic \eresolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + prefer 3 (* 2 * nvars + 1 *) + apply (rule alpha_trans[rotated]) + apply assumption + apply (rule alpha_trans[rotated]) + apply (rule alpha_bij_eqs[THEN iffD2, rotated -1]) + apply assumption+ + apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ alpha_term], rotated]) + apply (rule alpha_refls) + apply (rule sym) + apply (rule permute_raw_comps) + apply assumption+ + apply (rule bij_comp supp_comp_bound infinite_UNIV | assumption)+ + (* repeated *) + apply (drule term_pre.mr_rel_set(4-6)[rotated -1]) + prefer 6 (* free + 2 * bound + 1 *) + apply assumption + apply (rule supp_id_bound bij_id | assumption)+ + apply (erule bexE) + apply (frule IHs) + apply (erule allE) + apply (erule impE) + apply assumption + apply (rule subshape_term_term.intros[rotated -1]) + apply (tactic \eresolve_tac @{context} [BNF_Util.mk_UnIN 3 3] 1\) + prefer 3 (* 2 * nvars + 1 *) + apply (rule alpha_trans[rotated]) + apply assumption+ + (* END REPEAT_DETERM *) + done + done + + show "alpha_term x y \ subshape_term_term z x \ subshape_term_term z y" + apply (erule x[THEN spec, THEN mp, THEN spec, THEN mp]) + apply assumption + done +qed + +lemma subshape_induct_raw: + fixes x::"'a::var_term_pre raw_term" + assumes "\x. (\y. subshape_term_term y x \ P y) \ P x" + shows "\f y. bij f \ |supp f| alpha_term (permute_raw_term f x) y \ P y" + apply (rule raw_term.induct[of _ x]) + subgoal premises IHs for x + apply (rule allI impI)+ + apply (rule assms) + (* REPEAT_DETERM *) + apply (drule alpha_subshapess[rotated -1]) + apply (erule alpha_syms) + apply (rotate_tac -2) + apply (erule thin_rl) + apply (subst (asm) permute_raw_simps) + apply assumption+ + apply (erule subshape_term_term.cases) + apply (drule iffD1[OF raw_term.inject]) + apply hypsubst + apply (subst (asm) term_pre.set_map, (assumption | rule supp_id_bound bij_id)+)+ + apply (unfold image_Un[symmetric]) + apply (erule imageE) + apply hypsubst + apply (drule alpha_bij_eq_invs[THEN iffD1, rotated -1]) + apply assumption+ + apply (subst (asm) permute_raw_comps) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ + apply (erule UnE)+ + (* REPEAT_DETERM *) + apply (drule IHs) + apply (erule allE)+ + (* REPEAT_DETERM *) + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + (* END REPEAT_DETERM *) + apply assumption + apply (erule alpha_syms) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + (* repeated *) + apply (drule IHs) + apply (erule allE)+ + (* REPEAT_DETERM *) + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + (* END REPEAT_DETERM *) + apply assumption + apply (erule alpha_syms) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + (* repeated *) + apply (drule IHs) + apply (erule allE)+ + (* REPEAT_DETERM *) + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + apply (erule impE) prefer 2 + (* END REPEAT_DETERM *) + apply assumption + apply (erule alpha_syms) + apply (assumption | rule bij_imp_bij_inv supp_inv_bound supp_comp_bound bij_comp infinite_UNIV)+ + (* END REPEAT_DETERM *) + done + done + +lemma subshape_induct: + fixes x::"'a::var_term_pre raw_term" + assumes "\x. (\y. subshape_term_term y x \ P y) \ P x" + shows "P x" + apply (rule subshape_induct_raw[THEN spec, THEN spec, THEN mp, THEN mp, THEN mp]) + apply (rule assms) + apply assumption + apply (rule bij_id supp_id_bound)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + done + +lemma wf_subshape: "wf {(x, y). subshape_term_term x y }" + apply (rule wfUNIVI) + apply (unfold prod_in_Collect_iff prod.case) + apply (rule subshape_induct) + apply (erule allE) + apply (erule impE) + apply (rule allI) + apply (rule impI) + apply assumption + apply assumption + done + +lemma set_subshapess: + "z \ set4_term_pre x \ subshape_term_term z (raw_term_ctor x)" + "z \ set5_term_pre x \ subshape_term_term z (raw_term_ctor x)" + "z \ set6_term_pre x \ subshape_term_term z (raw_term_ctor x)" + (* REPEAT_DETERM *) + apply (rule subshape_term_term.intros) + apply (rule supp_id_bound bij_id)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (tactic \eresolve_tac @{context} [BNF_Util.mk_UnIN 3 1] 1\) + (* repeated *) + apply (rule subshape_term_term.intros) + apply (rule supp_id_bound bij_id)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (tactic \eresolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + (* repeated *) + apply (rule subshape_term_term.intros) + apply (rule supp_id_bound bij_id)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (tactic \eresolve_tac @{context} [BNF_Util.mk_UnIN 3 3] 1\) + (* END REPEAT_DETERM *) + done + +lemma set_subshape_permutess: + fixes f::"'a::var_term_pre \ 'a" + assumes "bij f" "|supp f| set4_term_pre x \ subshape_term_term (permute_raw_term f z) (raw_term_ctor x)" + "z \ set5_term_pre x \ subshape_term_term (permute_raw_term f z) (raw_term_ctor x)" + "z \ set6_term_pre x \ subshape_term_term (permute_raw_term f z) (raw_term_ctor x)" + (* REPEAT_DETERM *) + apply (rule subshape_term_term.intros[rotated -2]) + apply (subst permute_raw_comps) + prefer 5 (* 4 * nvars + 1 *) + apply (subst inv_o_simp1, rule assms)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + apply (tactic \eresolve_tac @{context} [BNF_Util.mk_UnIN 3 1] 1\) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + (* repeated *) + apply (rule subshape_term_term.intros[rotated -2]) + apply (subst permute_raw_comps) + prefer 5 (* 4 * nvars + 1 *) + apply (subst inv_o_simp1, rule assms)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + apply (tactic \eresolve_tac @{context} [BNF_Util.mk_UnIN 3 2] 1\) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + (* repeated *) + apply (rule subshape_term_term.intros[rotated -2]) + apply (subst permute_raw_comps) + prefer 5 (* 4 * nvars + 1 *) + apply (subst inv_o_simp1, rule assms)+ + apply (unfold permute_raw_ids) + apply (rule alpha_refls) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + apply (tactic \eresolve_tac @{context} [BNF_Util.mk_UnIN 3 3] 1\) + apply (rule assms bij_imp_bij_inv supp_inv_bound)+ + (* END REPEAT_DETERM *) + done + +lemma permute_abs: + fixes f::"'a::var_term_pre \ 'a" + assumes "bij f" "|supp f| 'a" + assumes "bij f" "|supp f| a. a \ FVars_term x \ f a = g a) \ permute_term f x = permute_term g x" + apply (unfold permute_term_def atomize_all atomize_imp eq_on_def[symmetric] FVars_term_def) + apply (rule impI) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bijs) + apply (rule assms)+ + apply assumption+ + apply (rule alpha_refls) + done + +lemmas permute_cong_ids = permute_congs[OF _ _ bij_id supp_id_bound, unfolded permute_ids, unfolded id_def] + +lemma existential_induct: + assumes IHs: "\x \. \ \ Param \ \y. term_ctor y = term_ctor x \ + ((\z. z \ set4_term_pre y \ (\\\Param. P z \)) \ + (\z. z \ set5_term_pre y \ (\\\Param. P z \)) \ + (\z. z \ set6_term_pre y \ (\\\Param. P z \)) \ P (term_ctor y) \)" + shows "\\\Param. P z \" + apply (unfold ball_conj_distrib)? + apply (rule subshape_induct[of "\x. \\\Param. P (TT_abs x) \" "TT_rep z", unfolded TT_abs_rep]) + apply (rule ballI) + subgoal for x \ + apply (rule raw_term.exhaust[of x]) + apply hypsubst_thin + apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ P]]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_term.intros) + apply (rule bij_id supp_id_bound id_on_id eq_on_refl)+ + apply (unfold permute_raw_ids) + apply (rule iffD2[OF term_pre.mr_rel_map(3)]) + apply (rule supp_id_bound bij_id)+ + apply (unfold inv_id id_o o_id relcompp_conversep_Grp term_pre.mr_rel_id[symmetric]) + apply (rule term_pre.rel_refl_strong) + apply (rule TT_rep_abs_syms[unfolded comp_apply[symmetric, of TT_rep TT_abs]])+ + apply (unfold id_hid_o_hid) + apply (unfold hidden_id_def) + apply (subst term_pre.map_comp[symmetric]) + apply (rule supp_id_bound bij_id)+ + apply (unfold term_ctor_def[symmetric]) + apply (drule IHs) + apply (erule exE) + apply (erule conjE) + apply (drule sym) + apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ P]]) + apply assumption + apply (erule mp) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply hypsubst + apply (subst (asm) term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (subst term_pre.set_map, (rule supp_id_bound bij_id | assumption)+)+ + apply (unfold image_comp[unfolded comp_def] image_id) + (* REPEAT_DETERM *) + apply (rule conjI)? + apply (rule allI) + apply (rule impI) + apply (erule imageE) + apply hypsubst + apply (subst permute_abs, (rule supp_id_bound bij_id | assumption)+)? + apply (drule set_subshapess set_subshape_permutess[rotated -1], assumption) + apply assumption+ + (* repeated *) + apply (rule conjI)? + apply (rule allI) + apply (rule impI) + apply (erule imageE) + apply hypsubst + apply (subst permute_abs, (rule supp_id_bound bij_id | assumption)+)? + apply (drule set_subshape_permutess[rotated -1]) + prefer 3 (* 2 * nvars + 1 *) + apply assumption+ + (* repeated *) + apply (rule conjI)? + apply (rule allI) + apply (rule impI) + apply (erule imageE) + apply hypsubst + apply (subst permute_abs, (rule supp_id_bound bij_id | assumption)+)? + apply (unfold id_def)[1] + apply (drule set_subshapess, assumption) + (* END REPEAT_DETERM *) + done + done + +lemma fresh_induct_param: + fixes K::"'p \ 'a::var_term_pre set" + assumes "\\. \ \ Param \ |K \| x \. + (\z \. z \ set4_term_pre x \ \ \ Param \ P z \) \ + (\z \. z \ set5_term_pre x \ \ \ Param \ P z \) \ + (\z \. z \ set6_term_pre x \ \ \ Param \ P z \) \ + set2_term_pre x \ K \ = {} \ set3_term_pre x \ K \ = {} \ + \ \ Param \ P (term_ctor x) \" +shows "\\\Param. P z \" + apply (rule existential_induct[of _ P z]) + subgoal for x \ + apply (rule fresh_cases[of "K \" "term_ctor x"]) + apply (erule assms) + apply (rule exI) + apply (rule conjI) + apply (erule sym) + apply (rule impI) + apply (erule conjE)+ + apply (rule IHs) + (* for i in [~rec_vars - 2 .. ~3] *) + apply (rotate_tac -5) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule ballE) + apply assumption + apply (rotate_tac -1) + apply (erule contrapos_np) + apply assumption + (* repeated *) + apply (rotate_tac -4) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule ballE) + apply assumption + apply (rotate_tac -1) + apply (erule contrapos_np) + apply assumption + (* repeated *) + apply (rotate_tac -3) + apply (erule allE) + apply (erule impE) + apply assumption + apply (erule ballE) + apply assumption + apply (rotate_tac -1) + apply (erule contrapos_np) + apply assumption + (* END REPEAT_DETERM *) + apply assumption+ + done + done + +lemma nnoclash_noclashs: + "noclash_term x = noclash_raw_term (map_term_pre id id id TT_rep TT_rep TT_rep x)" + apply (unfold noclash_term_def noclash_raw_term_def) + apply (subst term_pre.set_map, (rule supp_id_bound bij_id)+)+ + apply (unfold image_id image_comp[unfolded comp_def] FVars_term_def[symmetric]) + apply (rule refl) + done - \ No newline at end of file +end \ No newline at end of file diff --git a/operations/Recursor.thy b/operations/Recursor.thy index d3711e7d..a8ddc127 100644 --- a/operations/Recursor.thy +++ b/operations/Recursor.thy @@ -1,5 +1,5 @@ theory Recursor - imports "./Fixpoint" + imports "./Least_Fixpoint" begin typedecl ('var, 'tyvar, 'a, 'b) U1 @@ -21,13 +21,13 @@ consts U1FVars_2 :: "('var, 'tyvar, 'a, 'b) T1 \ ('var::{var_T1_pre, consts U2FVars_1 :: "('var, 'tyvar, 'a, 'b) T2 \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a, 'b) U2 \ 'var set" consts U2FVars_2 :: "('var, 'tyvar, 'a, 'b) T2 \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a, 'b) U2 \ 'tyvar set" -consts U1ctor :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a, 'b, 'var, 'tyvar, +consts U1ctor :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a, 'b, 'var, 'tyvar, 'var, ('var, 'tyvar, 'a, 'b) T1 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1), ('var, 'tyvar, 'a, 'b) T1 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1), ('var, 'tyvar, 'a, 'b) T2 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U2), ('var, 'tyvar, 'a, 'b) T2 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U2) ) T1_pre \ ('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1" -consts U2ctor :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a, 'b, 'var, 'tyvar, +consts U2ctor :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a, 'b, 'var, 'tyvar, 'var, ('var, 'tyvar, 'a, 'b) T1 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1), ('var, 'tyvar, 'a, 'b) T1 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1), ('var, 'tyvar, 'a, 'b) T2 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U2), @@ -69,24 +69,24 @@ axiomatization where and U1map_Uctor: "validP p \ pred_T1_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y \ bij f1 \ |supp (f1::'var::{var_T1_pre,var_T2_pre} \ 'var)| bij f2 \ |supp (f2::'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar)| - U1map f1 f2 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) (U1ctor y p) -= U1ctor (map_T1_pre f1 f2 id id f1 f2 - (\(t, pu). (rrename_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + U1map f1 f2 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) (U1ctor y p) += U1ctor (map_T1_pre f1 f2 id id f1 f2 f1 + (\(t, pu). (permute_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) y) (Pmap f1 f2 p)" and U1FVars_subset_1: "validP p \ pred_T1_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y \ - set5_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T1_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_1 t (pu p) \ FFVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_1 t (pu p) \ FFVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - U1FVars_1 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) (U1ctor y p) \ FFVars_T11 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1" + set5_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T1_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_1 t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_1 t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ + U1FVars_1 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) (U1ctor y p) \ FVars_T11 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1" and U1FVars_subset_2: "validP p \ - pred_T1_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y \set6_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T1_pre) \ (PFVars_2 p \ avoiding_set2) = {} \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_2 t (pu p) \ FFVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_2 t (pu p) \ FFVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - U1FVars_2 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) (U1ctor y p) \ FFVars_T12 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2" + pred_T1_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y \set6_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T1_pre) \ (PFVars_2 p \ avoiding_set2) = {} \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_2 t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_2 t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ + U1FVars_2 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) (U1ctor y p) \ FVars_T12 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2" (* closure of validU1 under Umap and Uctor *) and validU1_Umap: "validU1 u1 \ bij f1 \ |supp (f1::'var::{var_T1_pre,var_T2_pre} \ 'var)| bij f2 \ |supp (f2::'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar)| validU1 (U1map f1 f2 (t1::('var, 'tyvar, 'a, 'b) T1) u1)" @@ -103,23 +103,23 @@ axiomatization where and U2map_Uctor: "validP p \ pred_T2_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y2 \ bij f1 \ |supp (f1::'var \ 'var)| bij f2 \ |supp (f2::'tyvar \ 'tyvar)| - U2map f1 f2 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y2)) (U2ctor y2 p) -= U2ctor (map_T2_pre f1 f2 id id f1 f2 - (\(t, pu). (rrename_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + U2map f1 f2 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y2)) (U2ctor y2 p) += U2ctor (map_T2_pre f1 f2 id id f1 f2 f1 + (\(t, pu). (permute_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) y2) (Pmap f1 f2 p)" and U2FVars_subset_1: "validP p \ - pred_T2_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y2 \set5_T2_pre (y2::(_, _, 'a, 'b, _, _, _, _, _, _) T2_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y2 \ set8_T2_pre y2 \ U1FVars_1 t (pu p) \ FFVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y2 \ set10_T2_pre y2 \ U2FVars_1 t (pu p) \ FFVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - U2FVars_1 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y2)) (U2ctor y2 p) \ FFVars_T21 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y2)) \ PFVars_1 p \ avoiding_set1" + pred_T2_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y2 \set5_T2_pre (y2::(_, _, 'a, 'b, _, _, _, _, _, _, _) T2_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y2 \ set9_T2_pre y2 \ U1FVars_1 t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y2 \ set11_T2_pre y2 \ U2FVars_1 t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ + U2FVars_1 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y2)) (U2ctor y2 p) \ FVars_T21 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y2)) \ PFVars_1 p \ avoiding_set1" and U2FVars_subset_2: "validP p \ pred_T2_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y2 \set6_T2_pre y2 \ (PFVars_2 p \ avoiding_set2) = {} \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y2 \ set8_T2_pre y2 \ U1FVars_2 t (pu p) \ FFVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y2 \ set10_T2_pre y2 \ U2FVars_2 t (pu p) \ FFVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - U2FVars_2 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y2)) (U2ctor y2 p) \ FFVars_T22 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y2)) \ PFVars_2 p \ avoiding_set2" + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y2 \ set9_T2_pre y2 \ U1FVars_2 t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y2 \ set11_T2_pre y2 \ U2FVars_2 t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ + U2FVars_2 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y2)) (U2ctor y2 p) \ FVars_T22 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y2)) \ PFVars_2 p \ avoiding_set2" (* closure of validU2 under Umap and Uctor *) and validU2_Umap: "validU2 u2 \ bij f1 \ |supp (f1::'var::{var_T1_pre,var_T2_pre} \ 'var)| bij f2 \ |supp (f2::'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar)| validU2 (U2map f1 f2 (t2::('var, 'tyvar, 'a, 'b) T2) u2)" @@ -134,34 +134,34 @@ lemmas U2FVars_subsets = U2FVars_subset_1 U2FVars_subset_2 (* DEFINITIONS *) (**********************************************************************) -type_synonym ('var, 'tyvar, 'a, 'b) pre_T1 = "('var, 'tyvar, 'a, 'b, 'var, 'tyvar, +type_synonym ('var, 'tyvar, 'a, 'b) pre_T1 = "('var, 'tyvar, 'a, 'b, 'var, 'tyvar, 'var, ('var, 'tyvar, 'a, 'b) raw_T1, ('var, 'tyvar, 'a, 'b) raw_T1, ('var, 'tyvar, 'a, 'b) raw_T2, ('var, 'tyvar, 'a, 'b) raw_T2 ) T1_pre" -type_synonym ('var, 'tyvar, 'a, 'b) pre_T2 = "('var, 'tyvar, 'a, 'b, 'var, 'tyvar, +type_synonym ('var, 'tyvar, 'a, 'b) pre_T2 = "('var, 'tyvar, 'a, 'b, 'var, 'tyvar, 'var, ('var, 'tyvar, 'a, 'b) raw_T1, ('var, 'tyvar, 'a, 'b) raw_T1, ('var, 'tyvar, 'a, 'b) raw_T2, ('var, 'tyvar, 'a, 'b) raw_T2 ) T2_pre" definition suitable11 :: "(('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) pre_T1 \ ('var, 'tyvar) P \ 'var \ 'var) \ bool" where "suitable11 \ \pick. \x p. validP p \ bij (pick x p) \ |supp (pick x p)| imsupp (pick x p) \ ((FVars_T11 (raw_T1_ctor x) \ PFVars_1 p \ avoiding_set1) - set5_T1_pre x) = {} - \ (pick x p) ` set5_T1_pre x \ (FVars_T11 (raw_T1_ctor x) \ PFVars_1 p \ avoiding_set1) = {}" + \ imsupp (pick x p) \ ((FVars_raw_T11 (raw_T1_ctor x) \ PFVars_1 p \ avoiding_set1) - set5_T1_pre x) = {} + \ (pick x p) ` set5_T1_pre x \ (FVars_raw_T11 (raw_T1_ctor x) \ PFVars_1 p \ avoiding_set1) = {}" definition suitable12 :: "(('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) pre_T1 \ ('var, 'tyvar) P \ 'tyvar \ 'tyvar) \ bool" where "suitable12 \ \pick. \x p. validP p \ bij (pick x p) \ |supp (pick x p)| imsupp (pick x p) \ ((FVars_T12 (raw_T1_ctor x) \ PFVars_2 p \ avoiding_set2) - set6_T1_pre x) = {} - \ (pick x p) ` set6_T1_pre x \ (FVars_T12 (raw_T1_ctor x) \ PFVars_2 p \ avoiding_set2) = {}" + \ imsupp (pick x p) \ ((FVars_raw_T12 (raw_T1_ctor x) \ PFVars_2 p \ avoiding_set2) - set6_T1_pre x) = {} + \ (pick x p) ` set6_T1_pre x \ (FVars_raw_T12 (raw_T1_ctor x) \ PFVars_2 p \ avoiding_set2) = {}" definition suitable21 :: "(('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) pre_T2 \ ('var, 'tyvar) P \ 'var \ 'var) \ bool" where "suitable21 \ \pick. \x p. validP p \ bij (pick x p) \ |supp (pick x p)| imsupp (pick x p) \ ((FVars_T21 (raw_T2_ctor x) \ PFVars_1 p \ avoiding_set1) - set5_T2_pre x) = {} - \ (pick x p) ` set5_T2_pre x \ (FVars_T21 (raw_T2_ctor x) \ PFVars_1 p \ avoiding_set1) = {}" + \ imsupp (pick x p) \ ((FVars_raw_T21 (raw_T2_ctor x) \ PFVars_1 p \ avoiding_set1) - set5_T2_pre x) = {} + \ (pick x p) ` set5_T2_pre x \ (FVars_raw_T21 (raw_T2_ctor x) \ PFVars_1 p \ avoiding_set1) = {}" definition suitable22 :: "(('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) pre_T2 \ ('var, 'tyvar) P \ 'tyvar \ 'tyvar) \ bool" where "suitable22 \ \pick. \x p. validP p \ bij (pick x p) \ |supp (pick x p)| imsupp (pick x p) \ ((FVars_T22 (raw_T2_ctor x) \ PFVars_2 p \ avoiding_set2) - set6_T2_pre x) = {} - \ (pick x p) ` set6_T2_pre x \ (FVars_T22 (raw_T2_ctor x) \ PFVars_2 p \ avoiding_set2) = {}" + \ imsupp (pick x p) \ ((FVars_raw_T22 (raw_T2_ctor x) \ PFVars_2 p \ avoiding_set2) - set6_T2_pre x) = {} + \ (pick x p) ` set6_T2_pre x \ (FVars_raw_T22 (raw_T2_ctor x) \ PFVars_2 p \ avoiding_set2) = {}" lemmas suitable_defs = suitable11_def suitable12_def suitable21_def suitable22_def @@ -192,9 +192,9 @@ definition PU2map' :: "('var \ 'var) \ ('tyvar \ \pu p. U2map' f1 f2 t (pu (Pmap (inv f1) (inv f2) p))" definition U1ctor' :: "_ \ _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U1" where - "U1ctor' y \ U1ctor (map_T1_pre id id id id id id (map_prod abs_T1 id) (map_prod abs_T1 id) (map_prod abs_T2 id) (map_prod abs_T2 id) y)" + "U1ctor' y \ U1ctor (map_T1_pre id id id id id id id (map_prod abs_T1 id) (map_prod abs_T1 id) (map_prod abs_T2 id) (map_prod abs_T2 id) y)" definition U2ctor' :: "_ \ _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U2" where - "U2ctor' y \ U2ctor (map_T2_pre id id id id id id (map_prod abs_T1 id) (map_prod abs_T1 id) (map_prod abs_T2 id) (map_prod abs_T2 id) y)" + "U2ctor' y \ U2ctor (map_T2_pre id id id id id id id (map_prod abs_T1 id) (map_prod abs_T1 id) (map_prod abs_T2 id) (map_prod abs_T2 id) y)" lemma suitable_bij: "suitable11 pick1 \ validP p \ bij (pick1 x p)" @@ -217,19 +217,19 @@ lemma suitable_supp_bound: function f_T1 :: "_ \ _ \ _ \ _ \ _ \ _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U1" and f_T2 :: "_ \ _ \ _ \ _ \ _ \ _ \ ('var, 'tyvar, 'a, 'b) U2" where "f_T1 pick1 pick2 pick3 pick4 (raw_T1_ctor x) p = (if suitable11 pick1 \ suitable12 pick2 \ suitable21 pick3 \ suitable22 pick4 \ validP p then - U1ctor' (map_T1_pre id id id id id id + U1ctor' (map_T1_pre id id id id id id id (\t. (t, \p. if validP p then f_T1 pick1 pick2 pick3 pick4 t p else undefined)) (\t. (t, \p. if validP p then f_T1 pick1 pick2 pick3 pick4 t p else undefined)) (\t. (t, \p. if validP p then f_T2 pick1 pick2 pick3 pick4 t p else undefined)) (\t. (t, \p. if validP p then f_T2 pick1 pick2 pick3 pick4 t p else undefined)) ( - map_T1_pre id id id id (pick1 x p) (pick2 x p) id - (rename_T1 (pick1 x p) (pick2 x p)) id (rename_T2 (pick1 x p) id) x + map_T1_pre id id id id (pick1 x p) (pick2 x p) (pick1 x p) id + (permute_raw_T1 (pick1 x p) (pick2 x p)) id (permute_raw_T2 (pick1 x p) id) x )) p else undefined)" | "f_T2 pick1 pick2 pick3 pick4 (raw_T2_ctor x) p = (if suitable11 pick1 \ suitable12 pick2 \ suitable21 pick3 \ suitable22 pick4 \ validP p then - U2ctor' (map_T2_pre id id id id id id + U2ctor' (map_T2_pre id id id id id id id (\t. (t, \p. if validP p then f_T1 pick1 pick2 pick3 pick4 t p else undefined)) (\t. (t, \p. if validP p then f_T1 pick1 pick2 pick3 pick4 t p else undefined)) (\t. (t, \p. if validP p then f_T2 pick1 pick2 pick3 pick4 t p else undefined)) (\t. (t, \p. if validP p then f_T2 pick1 pick2 pick3 pick4 t p else undefined)) ( - map_T2_pre id id id id (pick3 x p) (pick4 x p) id - (rename_T1 (pick3 x p) (pick4 x p)) id (rename_T2 (pick3 x p) id) x + map_T2_pre id id id id (pick3 x p) (pick4 x p) (pick3 x p) id + (permute_raw_T1 (pick3 x p) (pick4 x p)) id (permute_raw_T2 (pick3 x p) id) x )) p else undefined)" apply pat_completeness @@ -250,7 +250,7 @@ termination | Inr t2 \ (case y of Inl t1 \ subshape_T2_T1 t2 t1 | Inr t2' \ subshape_T2_T2 t2 t2') } (map_sum (fst \ snd \ snd \ snd \ snd) (fst \ snd \ snd \ snd \ snd))") apply (rule wf_inv_image) - apply (rule T1.wf_subshape) + apply (rule wf_subshape) (* ALLGOALS *) subgoal @@ -259,9 +259,11 @@ termination apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T1_pre.set_map T2_pre.set_map) apply (rule supp_id_bound bij_id | erule suitable_bij suitable_supp_bound | assumption)+ + apply (unfold image_id)? + apply (erule imageE, hypsubst)? apply ( - (unfold image_id, erule T1.set_subshapes) - | (erule T1.set_subshape_images[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) + erule set_subshapess + | (erule set_subshape_permutess[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) done (* copied from above *) @@ -271,9 +273,11 @@ termination apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T1_pre.set_map T2_pre.set_map) apply (rule supp_id_bound bij_id | erule suitable_bij suitable_supp_bound | assumption)+ + apply (unfold image_id)? + apply (erule imageE, hypsubst)? apply ( - (unfold image_id, erule T1.set_subshapes) - | (erule T1.set_subshape_images[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) + erule set_subshapess + | (erule set_subshape_permutess[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) done subgoal apply (unfold in_inv_image map_sum.simps comp_def snd_conv fst_conv mem_Collect_eq prod.case sum.case) @@ -281,9 +285,11 @@ termination apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T1_pre.set_map T2_pre.set_map) apply (rule supp_id_bound bij_id | erule suitable_bij suitable_supp_bound | assumption)+ + apply (unfold image_id)? + apply (erule imageE, hypsubst)? apply ( - (unfold image_id, erule T1.set_subshapes) - | (erule T1.set_subshape_images[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) + erule set_subshapess + | (erule set_subshape_permutess[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) done subgoal apply (unfold in_inv_image map_sum.simps comp_def snd_conv fst_conv mem_Collect_eq prod.case sum.case) @@ -291,9 +297,11 @@ termination apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T1_pre.set_map T2_pre.set_map) apply (rule supp_id_bound bij_id | erule suitable_bij suitable_supp_bound | assumption)+ + apply (unfold image_id)? + apply (erule imageE, hypsubst)? apply ( - (unfold image_id, erule T1.set_subshapes) - | (erule T1.set_subshape_images[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) + erule set_subshapess + | (erule set_subshape_permutess[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) done subgoal apply (unfold in_inv_image map_sum.simps comp_def snd_conv fst_conv mem_Collect_eq prod.case sum.case) @@ -301,9 +309,11 @@ termination apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T1_pre.set_map T2_pre.set_map) apply (rule supp_id_bound bij_id | erule suitable_bij suitable_supp_bound | assumption)+ + apply (unfold image_id)? + apply (erule imageE, hypsubst)? apply ( - (unfold image_id, erule T1.set_subshapes) - | (erule T1.set_subshape_images[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) + erule set_subshapess + | (erule set_subshape_permutess[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) done subgoal apply (unfold in_inv_image map_sum.simps comp_def snd_conv fst_conv mem_Collect_eq prod.case sum.case) @@ -311,9 +321,11 @@ termination apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T1_pre.set_map T2_pre.set_map) apply (rule supp_id_bound bij_id | erule suitable_bij suitable_supp_bound | assumption)+ + apply (unfold image_id)? + apply (erule imageE, hypsubst)? apply ( - (unfold image_id, erule T1.set_subshapes) - | (erule T1.set_subshape_images[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) + erule set_subshapess + | (erule set_subshape_permutess[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) done subgoal apply (unfold in_inv_image map_sum.simps comp_def snd_conv fst_conv mem_Collect_eq prod.case sum.case) @@ -321,9 +333,11 @@ termination apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T1_pre.set_map T2_pre.set_map) apply (rule supp_id_bound bij_id | erule suitable_bij suitable_supp_bound | assumption)+ + apply (unfold image_id)? + apply (erule imageE, hypsubst)? apply ( - (unfold image_id, erule T1.set_subshapes) - | (erule T1.set_subshape_images[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) + erule set_subshapess + | (erule set_subshape_permutess[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) done subgoal apply (unfold in_inv_image map_sum.simps comp_def snd_conv fst_conv mem_Collect_eq prod.case sum.case) @@ -331,20 +345,22 @@ termination apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T1_pre.set_map T2_pre.set_map) apply (rule supp_id_bound bij_id | erule suitable_bij suitable_supp_bound | assumption)+ + apply (unfold image_id)? + apply (erule imageE, hypsubst)? apply ( - (unfold image_id, erule T1.set_subshapes) - | (erule T1.set_subshape_images[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) + erule set_subshapess + | (erule set_subshape_permutess[rotated -1], (rule bij_id supp_id_bound | erule suitable_bij suitable_supp_bound | assumption)+)) done done print_theorems lemma f_T1_simp: "suitable11 pick1 \ suitable12 pick2 \ suitable21 pick3 \ suitable22 pick4 \ validP p \ f_T1 pick1 pick2 pick3 pick4 (raw_T1_ctor x) p = - U1ctor' (map_T1_pre id id id id (pick1 x p) (pick2 x p) + U1ctor' (map_T1_pre id id id id (pick1 x p) (pick2 x p) (pick1 x p) (\t. (t, \p. if validP p then f_T1 pick1 pick2 pick3 pick4 t p else undefined)) - (\t. (rename_T1 (pick1 x p) (pick2 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (rename_T1 (pick1 x p) (pick2 x p) t) p' else undefined)) + (\t. (permute_raw_T1 (pick1 x p) (pick2 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 (pick1 x p) (pick2 x p) t) p' else undefined)) (\t. (t, \p. if validP p then f_T2 pick1 pick2 pick3 pick4 t p else undefined)) - (\t. (rename_T2 (pick1 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (rename_T2 (pick1 x p) id t) p' else undefined)) + (\t. (permute_raw_T2 (pick1 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 (pick1 x p) id t) p' else undefined)) x) p" apply (rule trans) apply (rule f_T1.simps) @@ -359,11 +375,11 @@ lemma f_T1_simp: "suitable11 pick1 \ suitable12 pick2 \ suitable12 pick2 \ suitable21 pick3 \ suitable22 pick4 \ validP p \ f_T2 pick1 pick2 pick3 pick4 (raw_T2_ctor x) p = - U2ctor' (map_T2_pre id id id id (pick3 x p) (pick4 x p) + U2ctor' (map_T2_pre id id id id (pick3 x p) (pick4 x p) (pick3 x p) (\t. (t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T1 (pick3 x p) (pick4 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (rename_T1 (pick3 x p) (pick4 x p) t) p' else undefined)) + (\t. (permute_raw_T1 (pick3 x p) (pick4 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 (pick3 x p) (pick4 x p) t) p' else undefined)) (\t. (t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T2 (pick3 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (rename_T2 (pick3 x p) id t) p' else undefined)) + (\t. (permute_raw_T2 (pick3 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 (pick3 x p) id t) p' else undefined)) x) p" apply (rule trans) apply (rule f_T2.simps) @@ -393,34 +409,34 @@ definition "ff0_T2 t \ f0_T2 (rep_T2 t)" definition XXl1 where "XXl1 pick1 pick2 pick3 pick4 f1 f2 p x \ - map_T1_pre f1 f2 id id (f1 \ pick1 x (Pmap (inv f1) (inv f2) p)) (f2 \ pick2 x (Pmap (inv f1) (inv f2) p)) - (\t. (rename_T1 f1 f2 t, \p. if validP p then PU1map' f1 f2 t (f_T1 pick1 pick2 pick3 pick4 t) p else undefined)) - (\t. (rename_T1 (f1 \ pick1 x (Pmap (inv f1) (inv f2) p)) (f2 \ pick2 x (Pmap (inv f1) (inv f2) p)) t, \p'. if validP p' then PU1map' f1 f2 - (rename_T1 (pick1 x (Pmap (inv f1) (inv f2) p)) (pick2 x (Pmap (inv f1) (inv f2) p)) t) - (f_T1 pick1 pick2 pick3 pick4 (rename_T1 (pick1 x (Pmap (inv f1) (inv f2) p)) (pick2 x (Pmap (inv f1) (inv f2) p)) t)) p' + map_T1_pre f1 f2 id id (f1 \ pick1 x (Pmap (inv f1) (inv f2) p)) (f2 \ pick2 x (Pmap (inv f1) (inv f2) p)) (f1 \ pick1 x (Pmap (inv f1) (inv f2) p)) + (\t. (permute_raw_T1 f1 f2 t, \p. if validP p then PU1map' f1 f2 t (f_T1 pick1 pick2 pick3 pick4 t) p else undefined)) + (\t. (permute_raw_T1 (f1 \ pick1 x (Pmap (inv f1) (inv f2) p)) (f2 \ pick2 x (Pmap (inv f1) (inv f2) p)) t, \p'. if validP p' then PU1map' f1 f2 + (permute_raw_T1 (pick1 x (Pmap (inv f1) (inv f2) p)) (pick2 x (Pmap (inv f1) (inv f2) p)) t) + (f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 (pick1 x (Pmap (inv f1) (inv f2) p)) (pick2 x (Pmap (inv f1) (inv f2) p)) t)) p' else undefined )) - (\t. (rename_T2 f1 f2 t, \p. if validP p then PU2map' f1 f2 t (f_T2 pick1 pick2 pick3 pick4 t) p else undefined)) - (\t. (rename_T2 (f1 \ pick1 x (Pmap (inv f1) (inv f2) p)) f2 t, \p'. if validP p' then PU2map' f1 f2 - (rename_T2 (pick1 x (Pmap (inv f1) (inv f2) p)) id t) - (f_T2 pick1 pick2 pick3 pick4 (rename_T2 (pick1 x (Pmap (inv f1) (inv f2) p)) id t)) p' + (\t. (permute_raw_T2 f1 f2 t, \p. if validP p then PU2map' f1 f2 t (f_T2 pick1 pick2 pick3 pick4 t) p else undefined)) + (\t. (permute_raw_T2 (f1 \ pick1 x (Pmap (inv f1) (inv f2) p)) f2 t, \p'. if validP p' then PU2map' f1 f2 + (permute_raw_T2 (pick1 x (Pmap (inv f1) (inv f2) p)) id t) + (f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 (pick1 x (Pmap (inv f1) (inv f2) p)) id t)) p' else undefined )) x " definition XXl2 where "XXl2 pick1 pick2 pick3 pick4 f1 f2 p x \ - map_T2_pre f1 f2 id id (f1 \ pick3 x (Pmap (inv f1) (inv f2) p)) (f2 \ pick4 x (Pmap (inv f1) (inv f2) p)) - (\t. (rename_T1 f1 f2 t, \p. if validP p then PU1map' f1 f2 t (f_T1 pick1 pick2 pick3 pick4 t) p else undefined)) - (\t. (rename_T1 (f1 \ pick3 x (Pmap (inv f1) (inv f2) p)) (f2 \ pick4 x (Pmap (inv f1) (inv f2) p)) t, \p'. if validP p' then PU1map' f1 f2 - (rename_T1 (pick3 x (Pmap (inv f1) (inv f2) p)) (pick4 x (Pmap (inv f1) (inv f2) p)) t) - (f_T1 pick1 pick2 pick3 pick4 (rename_T1 (pick3 x (Pmap (inv f1) (inv f2) p)) (pick4 x (Pmap (inv f1) (inv f2) p)) t)) p' + map_T2_pre f1 f2 id id (f1 \ pick3 x (Pmap (inv f1) (inv f2) p)) (f2 \ pick4 x (Pmap (inv f1) (inv f2) p)) (f1 \ pick3 x (Pmap (inv f1) (inv f2) p)) + (\t. (permute_raw_T1 f1 f2 t, \p. if validP p then PU1map' f1 f2 t (f_T1 pick1 pick2 pick3 pick4 t) p else undefined)) + (\t. (permute_raw_T1 (f1 \ pick3 x (Pmap (inv f1) (inv f2) p)) (f2 \ pick4 x (Pmap (inv f1) (inv f2) p)) t, \p'. if validP p' then PU1map' f1 f2 + (permute_raw_T1 (pick3 x (Pmap (inv f1) (inv f2) p)) (pick4 x (Pmap (inv f1) (inv f2) p)) t) + (f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 (pick3 x (Pmap (inv f1) (inv f2) p)) (pick4 x (Pmap (inv f1) (inv f2) p)) t)) p' else undefined )) - (\t. (rename_T2 f1 f2 t, \p. if validP p then PU2map' f1 f2 t (f_T2 pick1 pick2 pick3 pick4 t) p else undefined)) - (\t. (rename_T2 (f1 \ pick3 x (Pmap (inv f1) (inv f2) p)) f2 t, \p'. if validP p' then PU2map' f1 f2 - (rename_T2 (pick3 x (Pmap (inv f1) (inv f2) p)) id t) - (f_T2 pick1 pick2 pick3 pick4 (rename_T2 (pick3 x (Pmap (inv f1) (inv f2) p)) id t)) p' + (\t. (permute_raw_T2 f1 f2 t, \p. if validP p then PU2map' f1 f2 t (f_T2 pick1 pick2 pick3 pick4 t) p else undefined)) + (\t. (permute_raw_T2 (f1 \ pick3 x (Pmap (inv f1) (inv f2) p)) f2 t, \p'. if validP p' then PU2map' f1 f2 + (permute_raw_T2 (pick3 x (Pmap (inv f1) (inv f2) p)) id t) + (f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 (pick3 x (Pmap (inv f1) (inv f2) p)) id t)) p' else undefined )) x @@ -429,23 +445,24 @@ definition XXl2 where definition XXr1 where "XXr1 pick1 pick2 pick3 pick4 f1 f2 p x \ map_T1_pre f1 f2 id id - (pick1 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f1) - (pick2 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f2) - (\t. (rename_T1 f1 f2 t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (rename_T1 f1 f2 t) p' else undefined)) - (\t. (rename_T1 - (pick1 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f1) - (pick2 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f2) - t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (rename_T1 - (pick1 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f1) - (pick2 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f2) + (pick1 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1) + (pick2 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f2) + (pick1 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1) + (\t. (permute_raw_T1 f1 f2 t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 f1 f2 t) p' else undefined)) + (\t. (permute_raw_T1 + (pick1 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1) + (pick2 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f2) + t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 + (pick1 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1) + (pick2 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f2) t) p' else undefined )) - (\t. (rename_T2 f1 f2 t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (rename_T2 f1 f2 t) p' else undefined)) - (\t. (rename_T2 - (pick1 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f1) + (\t. (permute_raw_T2 f1 f2 t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 f1 f2 t) p' else undefined)) + (\t. (permute_raw_T2 + (pick1 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1) f2 - t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (rename_T2 - (pick1 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f1) + t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 + (pick1 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1) f2 t) p' else undefined )) @@ -454,23 +471,24 @@ definition XXr1 where definition XXr2 where "XXr2 pick1 pick2 pick3 pick4 f1 f2 p x \ map_T2_pre f1 f2 id id - (pick3 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f1) - (pick4 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f2) - (\t. (rename_T1 f1 f2 t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (rename_T1 f1 f2 t) p' else undefined)) - (\t. (rename_T1 - (pick3 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f1) - (pick4 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f2) - t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (rename_T1 - (pick3 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f1) - (pick4 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f2) + (pick3 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1) + (pick4 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f2) + (pick3 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1) + (\t. (permute_raw_T1 f1 f2 t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 f1 f2 t) p' else undefined)) + (\t. (permute_raw_T1 + (pick3 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1) + (pick4 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f2) + t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 + (pick3 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1) + (pick4 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f2) t) p' else undefined )) - (\t. (rename_T2 f1 f2 t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (rename_T2 f1 f2 t) p' else undefined)) - (\t. (rename_T2 - (pick3 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f1) + (\t. (permute_raw_T2 f1 f2 t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 f1 f2 t) p' else undefined)) + (\t. (permute_raw_T2 + (pick3 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1) f2 - t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (rename_T2 - (pick3 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ f1) + t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 + (pick3 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1) f2 t) p' else undefined )) @@ -483,11 +501,11 @@ definition XXr2 where thm imsupp_id_on thm imsupp_def supp_def lemma pick_id_ons: - "suitable11 pick1 \ validP p \ id_on ((\(FVars_T11 ` set8_T1_pre x) - set5_T1_pre x) \ (\(FVars_T21 ` set10_T1_pre x) - set5_T1_pre x)) (pick1 x p)" - "suitable12 pick2 \ validP p \ id_on (\(FVars_T12 ` set8_T1_pre x) - set6_T1_pre x) (pick2 x p)" - "suitable21 pick3 \ validP p \ id_on ((\(FVars_T11 ` set8_T2_pre y) - set5_T2_pre y) \ (\(FVars_T21 ` set10_T2_pre y) - set5_T2_pre y)) (pick3 y p)" - "suitable22 pick4 \ validP p \ id_on (\(FVars_T12 ` set8_T2_pre y) - set6_T2_pre y) (pick4 y p)" - apply (unfold suitable_defs Int_Un_distrib Un_empty Un_Diff Diff_idemp T1.FVars_ctors id_on_Un) + "suitable11 pick1 \ validP p \ id_on ((set7_T1_pre x - set5_T1_pre x) \ (\(FVars_raw_T11 ` set9_T1_pre x) - set5_T1_pre x) \ (\(FVars_raw_T21 ` set11_T1_pre x) - set5_T1_pre x)) (pick1 x p)" + "suitable12 pick2 \ validP p \ id_on (\(FVars_raw_T12 ` set9_T1_pre x) - set6_T1_pre x) (pick2 x p)" + "suitable21 pick3 \ validP p \ id_on ((set7_T2_pre y - set5_T2_pre y) \ (\(FVars_raw_T11 ` set9_T2_pre y) - set5_T2_pre y) \ (\(FVars_raw_T21 ` set11_T2_pre y) - set5_T2_pre y)) (pick3 y p)" + "suitable22 pick4 \ validP p \ id_on (\(FVars_raw_T12 ` set9_T2_pre y) - set6_T2_pre y) (pick4 y p)" + apply (unfold suitable_defs Int_Un_distrib Un_empty Un_Diff Diff_idemp FVars_raw_ctors id_on_Un) (* ALLGOALS *) apply (erule allE)+ apply (erule impE) @@ -518,15 +536,23 @@ lemma pick_id_ons: apply assumption apply (erule conjE)+ apply (rule conjI | erule imsupp_id_on)+ + (* copied from above*) + apply (erule allE)+ + apply (erule impE) + apply assumption + apply (erule conjE)+ + apply (rule conjI | erule imsupp_id_on)+ done lemma pick_id_ons': - "suitable11 pick1 \ validP p \ id_on (\(FVars_T11 ` set8_T1_pre x) - set5_T1_pre x) (pick1 x p)" - "suitable11 pick1 \ validP p \ id_on (\(FVars_T21 ` set10_T1_pre x) - set5_T1_pre x) (pick1 x p)" - "suitable12 pick2 \ validP p \ id_on (\(FVars_T12 ` set8_T1_pre x) - set6_T1_pre x) (pick2 x p)" - "suitable21 pick3 \ validP p \ id_on (\(FVars_T11 ` set8_T2_pre y) - set5_T2_pre y) (pick3 y p)" - "suitable21 pick3 \ validP p \ id_on (\(FVars_T21 ` set10_T2_pre y) - set5_T2_pre y) (pick3 y p)" - "suitable22 pick4 \ validP p \ id_on (\(FVars_T12 ` set8_T2_pre y) - set6_T2_pre y) (pick4 y p)" + "suitable11 pick1 \ validP p \ id_on (set7_T1_pre x - set5_T1_pre x) (pick1 x p)" + "suitable11 pick1 \ validP p \ id_on (\(FVars_raw_T11 ` set9_T1_pre x) - set5_T1_pre x) (pick1 x p)" + "suitable11 pick1 \ validP p \ id_on (\(FVars_raw_T21 ` set11_T1_pre x) - set5_T1_pre x) (pick1 x p)" + "suitable12 pick2 \ validP p \ id_on (\(FVars_raw_T12 ` set9_T1_pre x) - set6_T1_pre x) (pick2 x p)" + "suitable21 pick3 \ validP p \ id_on (set7_T2_pre y - set5_T2_pre y) (pick3 y p)" + "suitable21 pick3 \ validP p \ id_on (\(FVars_raw_T11 ` set9_T2_pre y) - set5_T2_pre y) (pick3 y p)" + "suitable21 pick3 \ validP p \ id_on (\(FVars_raw_T21 ` set11_T2_pre y) - set5_T2_pre y) (pick3 y p)" + "suitable22 pick4 \ validP p \ id_on (\(FVars_raw_T12 ` set9_T2_pre y) - set6_T2_pre y) (pick4 y p)" apply - apply (drule pick_id_ons[unfolded id_on_Un], assumption, ((erule conjE)+)?, assumption)+ done @@ -535,16 +561,16 @@ lemma pick_id_on_images: fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" assumes "bij f1" "|supp f1| validP p \ id_on (f1 ` ((\(FVars_T11 ` set8_T1_pre x) - set5_T1_pre x) \ (\(FVars_T21 ` set10_T1_pre x) - set5_T1_pre x))) (pick1 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p)" - "suitable12 pick2 \ validP p \ id_on (f2 ` (\(FVars_T12 ` set8_T1_pre x) - set6_T1_pre x)) (pick2 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p)" - "suitable21 pick3 \ validP p \ id_on (f1 ` ((\(FVars_T11 ` set8_T2_pre y) - set5_T2_pre y) \ (\(FVars_T21 ` set10_T2_pre y) - set5_T2_pre y))) (pick3 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) y) p)" - "suitable22 pick4 \ validP p \ id_on (f2 ` (\(FVars_T12 ` set8_T2_pre y) - set6_T2_pre y)) (pick4 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) y) p)" + "suitable11 pick1 \ validP p \ id_on (f1 ` ((set7_T1_pre x - set5_T1_pre x) \ (\(FVars_raw_T11 ` set9_T1_pre x) - set5_T1_pre x) \ (\(FVars_raw_T21 ` set11_T1_pre x) - set5_T1_pre x))) (pick1 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p)" + "suitable12 pick2 \ validP p \ id_on (f2 ` (\(FVars_raw_T12 ` set9_T1_pre x) - set6_T1_pre x)) (pick2 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p)" + "suitable21 pick3 \ validP p \ id_on (f1 ` ((set7_T2_pre y - set5_T2_pre y) \ (\(FVars_raw_T11 ` set9_T2_pre y) - set5_T2_pre y) \ (\(FVars_raw_T21 ` set11_T2_pre y) - set5_T2_pre y))) (pick3 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) y) p)" + "suitable22 pick4 \ validP p \ id_on (f2 ` (\(FVars_raw_T12 ` set9_T2_pre y) - set6_T2_pre y)) (pick4 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) y) p)" apply - (* EVERY' (map ... pick_id_ons) *) apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ id_on], rotated]) apply (erule pick_id_ons) apply assumption - apply (subst T1_pre.set_map T2_pre.set_map T1.FVars_renames image_set_diff[OF bij_is_inj, symmetric] image_comp[unfolded comp_def] image_UN[symmetric] image_Un[symmetric], + apply (subst T1_pre.set_map T2_pre.set_map FVars_raw_permutes image_set_diff[OF bij_is_inj, symmetric] image_comp[unfolded comp_def] image_UN[symmetric] image_Un[symmetric], ((rule supp_id_bound bij_id assms)+)? )+ apply (rule refl) @@ -552,7 +578,7 @@ lemma pick_id_on_images: apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ id_on], rotated]) apply (erule pick_id_ons) apply assumption - apply (subst T1_pre.set_map T2_pre.set_map T1.FVars_renames image_set_diff[OF bij_is_inj, symmetric] image_comp[unfolded comp_def] image_UN[symmetric] image_Un[symmetric], + apply (subst T1_pre.set_map T2_pre.set_map FVars_raw_permutes image_set_diff[OF bij_is_inj, symmetric] image_comp[unfolded comp_def] image_UN[symmetric] image_Un[symmetric], ((rule supp_id_bound bij_id assms)+)? )+ apply (rule refl) @@ -560,7 +586,7 @@ lemma pick_id_on_images: apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ id_on], rotated]) apply (erule pick_id_ons) apply assumption - apply (subst T1_pre.set_map T2_pre.set_map T1.FVars_renames image_set_diff[OF bij_is_inj, symmetric] image_comp[unfolded comp_def] image_UN[symmetric] image_Un[symmetric], + apply (subst T1_pre.set_map T2_pre.set_map FVars_raw_permutes image_set_diff[OF bij_is_inj, symmetric] image_comp[unfolded comp_def] image_UN[symmetric] image_Un[symmetric], ((rule supp_id_bound bij_id assms)+)? )+ apply (rule refl) @@ -568,7 +594,7 @@ lemma pick_id_on_images: apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ id_on], rotated]) apply (erule pick_id_ons) apply assumption - apply (subst T1_pre.set_map T2_pre.set_map T1.FVars_renames image_set_diff[OF bij_is_inj, symmetric] image_comp[unfolded comp_def] image_UN[symmetric] image_Un[symmetric], + apply (subst T1_pre.set_map T2_pre.set_map FVars_raw_permutes image_set_diff[OF bij_is_inj, symmetric] image_comp[unfolded comp_def] image_UN[symmetric] image_Un[symmetric], ((rule supp_id_bound bij_id assms)+)? )+ apply (rule refl) @@ -578,12 +604,14 @@ lemma pick_id_on_images': fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" assumes "bij f1" "|supp f1| validP p \ id_on (f1 ` (\(FVars_T11 ` set8_T1_pre x) - set5_T1_pre x)) (pick1 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p)" - "suitable11 pick1 \ validP p \ id_on (f1 ` (\(FVars_T21 ` set10_T1_pre x) - set5_T1_pre x)) (pick1 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p)" - "suitable12 pick2 \ validP p \ id_on (f2 ` (\(FVars_T12 ` set8_T1_pre x) - set6_T1_pre x)) (pick2 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p)" - "suitable21 pick3 \ validP p \ id_on (f1 ` (\(FVars_T11 ` set8_T2_pre y) - set5_T2_pre y)) (pick3 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) y) p)" - "suitable21 pick3 \ validP p \ id_on (f1 ` (\(FVars_T21 ` set10_T2_pre y) - set5_T2_pre y)) (pick3 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) y) p)" - "suitable22 pick4 \ validP p \ id_on (f2 ` (\(FVars_T12 ` set8_T2_pre y) - set6_T2_pre y)) (pick4 (map_T2_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) y) p)" + "suitable11 pick1 \ validP p \ id_on (f1 ` (set7_T1_pre x - set5_T1_pre x)) (pick1 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p)" + "suitable11 pick1 \ validP p \ id_on (f1 ` (\(FVars_raw_T11 ` set9_T1_pre x) - set5_T1_pre x)) (pick1 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p)" + "suitable11 pick1 \ validP p \ id_on (f1 ` (\(FVars_raw_T21 ` set11_T1_pre x) - set5_T1_pre x)) (pick1 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p)" + "suitable12 pick2 \ validP p \ id_on (f2 ` (\(FVars_raw_T12 ` set9_T1_pre x) - set6_T1_pre x)) (pick2 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p)" + "suitable21 pick3 \ validP p \ id_on (f1 ` (set7_T2_pre y - set5_T2_pre y)) (pick3 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) y) p)" + "suitable21 pick3 \ validP p \ id_on (f1 ` (\(FVars_raw_T11 ` set9_T2_pre y) - set5_T2_pre y)) (pick3 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) y) p)" + "suitable21 pick3 \ validP p \ id_on (f1 ` (\(FVars_raw_T21 ` set11_T2_pre y) - set5_T2_pre y)) (pick3 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) y) p)" + "suitable22 pick4 \ validP p \ id_on (f2 ` (\(FVars_raw_T12 ` set9_T2_pre y) - set6_T2_pre y)) (pick4 (map_T2_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) y) p)" apply - apply (drule pick_id_on_images[OF assms, unfolded image_Un id_on_Un], assumption, ((erule conjE)+)?, assumption)+ done @@ -592,14 +620,14 @@ lemma pick_id_on_images': lemma U1map'_U1ctor': "validP p \ pred_T1_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y \ bij f1 \ |supp (f1::'var::{var_T1_pre,var_T2_pre} \ 'var)| bij f2 \ |supp (f2::'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar)| - U1map' f1 f2 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) (U1ctor' y p) -= U1ctor' (map_T1_pre f1 f2 id id f1 f2 - (\(t, pu). (rename_T1 f1 f2 t, \p. if validP p then PU1map' f1 f2 t pu p else undefined)) - (\(t, pu). (rename_T1 f1 f2 t, \p. if validP p then PU1map' f1 f2 t pu p else undefined)) - (\(t, pu). (rename_T2 f1 f2 t, \p. if validP p then PU2map' f1 f2 t pu p else undefined)) - (\(t, pu). (rename_T2 f1 f2 t, \p. if validP p then PU2map' f1 f2 t pu p else undefined)) + U1map' f1 f2 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) (U1ctor' y p) += U1ctor' (map_T1_pre f1 f2 id id f1 f2 f1 + (\(t, pu). (permute_raw_T1 f1 f2 t, \p. if validP p then PU1map' f1 f2 t pu p else undefined)) + (\(t, pu). (permute_raw_T1 f1 f2 t, \p. if validP p then PU1map' f1 f2 t pu p else undefined)) + (\(t, pu). (permute_raw_T2 f1 f2 t, \p. if validP p then PU2map' f1 f2 t pu p else undefined)) + (\(t, pu). (permute_raw_T2 f1 f2 t, \p. if validP p then PU2map' f1 f2 t pu p else undefined)) y) (Pmap f1 f2 p)" - apply (unfold U1map'_def U2map'_def U1ctor'_def U2ctor'_def PU1map'_def PU2map'_def T1.TT_abs_ctors) + apply (unfold U1map'_def U2map'_def U1ctor'_def U2ctor'_def PU1map'_def PU2map'_def TT_abs_ctors) apply (subst T1_pre.map_comp T2_pre.map_comp, (rule supp_id_bound bij_id)+) apply (unfold fst_comp_map_prod) apply (subst T1_pre.map_comp[symmetric] T2_pre.map_comp[symmetric], (rule supp_id_bound bij_id)+) @@ -625,50 +653,50 @@ lemma U1map'_U1ctor': "validP p \ (* ALLGOALS (refl ORELSE ...) *) apply (rule refl)+ apply (rule iffD2[OF prod.inject]) apply (rule conjI) - apply (unfold rrename_T1_def rrename_T2_def)[1] - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (unfold permute_T1_def permute_T2_def)[1] + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule supp_id_bound bij_id | assumption)+ - apply (rule T1.TT_alpha_quotient_syms) + apply (rule TT_rep_abs_syms) apply (rule refl) (* copied from above *) apply (rule iffD2[OF prod.inject]) apply (rule conjI) - apply (unfold rrename_T1_def rrename_T2_def)[1] - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (unfold permute_T1_def permute_T2_def)[1] + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule supp_id_bound bij_id | assumption)+ - apply (rule T1.TT_alpha_quotient_syms) + apply (rule TT_rep_abs_syms) apply (rule refl) apply (rule iffD2[OF prod.inject]) apply (rule conjI) - apply (unfold rrename_T1_def rrename_T2_def)[1] - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (unfold permute_T1_def permute_T2_def)[1] + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule supp_id_bound bij_id | assumption)+ - apply (rule T1.TT_alpha_quotient_syms) + apply (rule TT_rep_abs_syms) apply (rule refl) apply (rule iffD2[OF prod.inject]) apply (rule conjI) - apply (unfold rrename_T1_def rrename_T2_def)[1] - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (unfold permute_T1_def permute_T2_def)[1] + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule supp_id_bound bij_id | assumption)+ - apply (rule T1.TT_alpha_quotient_syms) + apply (rule TT_rep_abs_syms) apply (rule refl) done lemma U2map'_Uctor': "validP p \ pred_T2_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y2 \ bij f1 \ |supp (f1::'var::{var_T1_pre,var_T2_pre} \ 'var)| bij f2 \ |supp (f2::'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar)| - U2map' f1 f2 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst y2)) (U2ctor' y2 p) -= U2ctor' (map_T2_pre f1 f2 id id f1 f2 - (\(t, pu). (rename_T1 f1 f2 t, \p. if validP p then PU1map' f1 f2 t pu p else undefined)) - (\(t, pu). (rename_T1 f1 f2 t, \p. if validP p then PU1map' f1 f2 t pu p else undefined)) - (\(t, pu). (rename_T2 f1 f2 t, \p. if validP p then PU2map' f1 f2 t pu p else undefined)) - (\(t, pu). (rename_T2 f1 f2 t, \p. if validP p then PU2map' f1 f2 t pu p else undefined)) + U2map' f1 f2 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y2)) (U2ctor' y2 p) += U2ctor' (map_T2_pre f1 f2 id id f1 f2 f1 + (\(t, pu). (permute_raw_T1 f1 f2 t, \p. if validP p then PU1map' f1 f2 t pu p else undefined)) + (\(t, pu). (permute_raw_T1 f1 f2 t, \p. if validP p then PU1map' f1 f2 t pu p else undefined)) + (\(t, pu). (permute_raw_T2 f1 f2 t, \p. if validP p then PU2map' f1 f2 t pu p else undefined)) + (\(t, pu). (permute_raw_T2 f1 f2 t, \p. if validP p then PU2map' f1 f2 t pu p else undefined)) y2) (Pmap f1 f2 p)" (* same tactic as above *) - apply (unfold U1map'_def U2map'_def U1ctor'_def U2ctor'_def PU1map'_def PU2map'_def T1.TT_abs_ctors) + apply (unfold U1map'_def U2map'_def U1ctor'_def U2ctor'_def PU1map'_def PU2map'_def TT_abs_ctors) apply (subst T1_pre.map_comp T2_pre.map_comp, (rule supp_id_bound bij_id)+) apply (unfold fst_comp_map_prod) apply (subst T1_pre.map_comp[symmetric] T2_pre.map_comp[symmetric], (rule supp_id_bound bij_id)+) @@ -694,63 +722,59 @@ lemma U2map'_Uctor': "validP p \ apply (rule refl)+ apply (rule iffD2[OF prod.inject]) apply (rule conjI) - apply (unfold rrename_T1_def rrename_T2_def)[1] - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (unfold permute_T1_def permute_T2_def)[1] + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule supp_id_bound bij_id | assumption)+ - apply (rule T1.TT_alpha_quotient_syms) + apply (rule TT_rep_abs_syms) apply (rule refl) apply (rule iffD2[OF prod.inject]) apply (rule conjI) - apply (unfold rrename_T1_def rrename_T2_def)[1] - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (unfold permute_T1_def permute_T2_def)[1] + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule supp_id_bound bij_id | assumption)+ - apply (rule T1.TT_alpha_quotient_syms) + apply (rule TT_rep_abs_syms) apply (rule refl) apply (rule iffD2[OF prod.inject]) apply (rule conjI) - apply (unfold rrename_T1_def rrename_T2_def)[1] - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (unfold permute_T1_def permute_T2_def)[1] + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule supp_id_bound bij_id | assumption)+ - apply (rule T1.TT_alpha_quotient_syms) + apply (rule TT_rep_abs_syms) apply (rule refl) apply (rule iffD2[OF prod.inject]) apply (rule conjI) - apply (unfold rrename_T1_def rrename_T2_def)[1] - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (unfold permute_T1_def permute_T2_def)[1] + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule supp_id_bound bij_id | assumption)+ - apply (rule T1.TT_alpha_quotient_syms) + apply (rule TT_rep_abs_syms) apply (rule refl) done -lemmas FVars_def2s = T1.alpha_FVarss(1)[OF T1.TT_alpha_quotient_syms(1), - unfolded fun_cong[OF meta_eq_to_obj_eq[OF FFVars_T11_def], symmetric] - ] T1.alpha_FVarss(2)[OF T1.TT_alpha_quotient_syms(2), - unfolded fun_cong[OF meta_eq_to_obj_eq[OF FFVars_T21_def], symmetric] - ] T1.alpha_FVarss(3)[OF T1.TT_alpha_quotient_syms(1), - unfolded fun_cong[OF meta_eq_to_obj_eq[OF FFVars_T12_def], symmetric] - ] T1.alpha_FVarss(4)[OF T1.TT_alpha_quotient_syms(2), - unfolded fun_cong[OF meta_eq_to_obj_eq[OF FFVars_T22_def], symmetric] - ] +lemmas FVars_def2s = + alpha_FVars(1)[OF TT_rep_abs_syms(1), unfolded FVars_T11_def[symmetric]] + alpha_FVars(2)[OF TT_rep_abs_syms(1), unfolded FVars_T12_def[symmetric]] + alpha_FVars(3)[OF TT_rep_abs_syms(2), unfolded FVars_T21_def[symmetric]] + alpha_FVars(4)[OF TT_rep_abs_syms(2), unfolded FVars_T22_def[symmetric]] lemma U1FVars'_subsets: "validP p \ pred_T1_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y \ - set5_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T1_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_1' t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_1' t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - U1FVars_1' (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) (U1ctor' y p) \ FVars_T11 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1" + set5_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T1_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_1' t (pu p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_1' t (pu p) \ FVars_raw_T21 t \ PFVars_1 p \ avoiding_set1) \ + U1FVars_1' (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) (U1ctor' y p) \ FVars_raw_T11 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1" "validP p \ pred_T1_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y \ - set6_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T1_pre) \ (PFVars_2 p \ avoiding_set2) = {} \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_2' t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_2' t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - U1FVars_2' (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) (U1ctor' y p) \ FVars_T12 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2" + set6_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T1_pre) \ (PFVars_2 p \ avoiding_set2) = {} \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_2' t (pu p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_2' t (pu p) \ FVars_raw_T22 t \ PFVars_2 p \ avoiding_set2) \ + U1FVars_2' (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) (U1ctor' y p) \ FVars_raw_T12 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2" apply - subgoal - apply (unfold U1FVars_1'_def U1FVars_2'_def U2FVars_1'_def U2FVars_2'_def U1ctor'_def U2ctor'_def FVars_def2s T1.TT_abs_ctors) + apply (unfold U1FVars_1'_def U1FVars_2'_def U2FVars_1'_def U2FVars_2'_def U1ctor'_def U2ctor'_def FVars_def2s TT_abs_ctors) apply (subst T1_pre.map_comp T2_pre.map_comp, (rule supp_id_bound bij_id)+)+ apply (unfold fst_comp_map_prod) apply (subst T1_pre.map_comp[symmetric] T2_pre.map_comp[symmetric], (rule supp_id_bound bij_id)+)+ @@ -785,7 +809,7 @@ lemma U1FVars'_subsets: "validP p \ (* copied from above *) subgoal - apply (unfold U1FVars_1'_def U1FVars_2'_def U2FVars_1'_def U2FVars_2'_def U1ctor'_def U2ctor'_def FVars_def2s T1.TT_abs_ctors) + apply (unfold U1FVars_1'_def U1FVars_2'_def U2FVars_1'_def U2FVars_2'_def U1ctor'_def U2ctor'_def FVars_def2s TT_abs_ctors) apply (subst T1_pre.map_comp T2_pre.map_comp, (rule supp_id_bound bij_id)+)+ apply (unfold fst_comp_map_prod) apply (subst T1_pre.map_comp[symmetric] T2_pre.map_comp[symmetric], (rule supp_id_bound bij_id)+)+ @@ -821,20 +845,20 @@ lemma U1FVars'_subsets: "validP p \ lemma U2FVars'_subsets: "validP p \ pred_T2_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y2 \ - set5_T2_pre (y2::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T2_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y2 \ set8_T2_pre y2 \ U1FVars_1' t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y2 \ set10_T2_pre y2 \ U2FVars_1' t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - U2FVars_1' (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst y2)) (U2ctor' y2 p) \ FVars_T21 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst y2)) \ PFVars_1 p \ avoiding_set1" + set5_T2_pre (y2::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T2_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y2 \ set9_T2_pre y2 \ U1FVars_1' t (pu p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y2 \ set11_T2_pre y2 \ U2FVars_1' t (pu p) \ FVars_raw_T21 t \ PFVars_1 p \ avoiding_set1) \ + U2FVars_1' (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y2)) (U2ctor' y2 p) \ FVars_raw_T21 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y2)) \ PFVars_1 p \ avoiding_set1" "validP p \ pred_T2_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y2 \ set6_T2_pre y2 \ (PFVars_2 p \ avoiding_set2) = {} \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y2 \ set8_T2_pre y2 \ U1FVars_2' t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y2 \ set10_T2_pre y2 \ U2FVars_2' t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - U2FVars_2' (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst y2)) (U2ctor' y2 p) \ FVars_T22 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst y2)) \ PFVars_2 p \ avoiding_set2" + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y2 \ set9_T2_pre y2 \ U1FVars_2' t (pu p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y2 \ set11_T2_pre y2 \ U2FVars_2' t (pu p) \ FVars_raw_T22 t \ PFVars_2 p \ avoiding_set2) \ + U2FVars_2' (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y2)) (U2ctor' y2 p) \ FVars_raw_T22 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y2)) \ PFVars_2 p \ avoiding_set2" (* same tactic as above *) apply - subgoal - apply (unfold U1FVars_1'_def U1FVars_2'_def U2FVars_1'_def U2FVars_2'_def U1ctor'_def U2ctor'_def FVars_def2s T1.TT_abs_ctors) + apply (unfold U1FVars_1'_def U1FVars_2'_def U2FVars_1'_def U2FVars_2'_def U1ctor'_def U2ctor'_def FVars_def2s TT_abs_ctors) apply (subst T1_pre.map_comp T2_pre.map_comp, (rule supp_id_bound bij_id)+)+ apply (unfold fst_comp_map_prod) apply (subst T1_pre.map_comp[symmetric] T2_pre.map_comp[symmetric], (rule supp_id_bound bij_id)+)+ @@ -869,7 +893,7 @@ lemma U2FVars'_subsets: "validP p \ (* copied from above *) subgoal - apply (unfold U1FVars_1'_def U1FVars_2'_def U2FVars_1'_def U2FVars_2'_def U1ctor'_def U2ctor'_def FVars_def2s T1.TT_abs_ctors) + apply (unfold U1FVars_1'_def U1FVars_2'_def U2FVars_1'_def U2FVars_2'_def U1ctor'_def U2ctor'_def FVars_def2s TT_abs_ctors) apply (subst T1_pre.map_comp T2_pre.map_comp, (rule supp_id_bound bij_id)+)+ apply (unfold fst_comp_map_prod) apply (subst T1_pre.map_comp[symmetric] T2_pre.map_comp[symmetric], (rule supp_id_bound bij_id)+)+ @@ -917,18 +941,18 @@ lemma U1ctor_rename: assumes "validP p" "pred_T1_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y" "bij f1" "|supp f1| t pu p. validP p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_1 t (pu p) \ FFVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_1 t (pu p) \ FFVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_2 t (pu p) \ FFVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_2 t (pu p) \ FFVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - imsupp f1 \ (FFVars_T11 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1) = {} \ - imsupp f2 \ (FFVars_T12 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2) = {} \ + "(\t pu p. validP p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_1 t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_1 t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_2 t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_2 t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ + imsupp f1 \ (FVars_T11 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1) = {} \ + imsupp f2 \ (FVars_T12 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2) = {} \ f1 ` set5_T1_pre y \ set5_T1_pre y = {} \ f2 ` set6_T1_pre y \ set6_T1_pre y = {} \ - U1ctor y p = U1ctor (map_T1_pre f1 f2 id id f1 f2 - (\(t, pu). (rrename_T1 f1 f2 t, \p. if validP p then PU1map f1 f2 t pu p else undefined)) - (\(t, pu). (rrename_T1 f1 f2 t, \p. if validP p then PU1map f1 f2 t pu p else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if validP p then PU2map f1 f2 t pu p else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if validP p then PU2map f1 f2 t pu p else undefined)) + U1ctor y p = U1ctor (map_T1_pre f1 f2 id id f1 f2 f1 + (\(t, pu). (permute_T1 f1 f2 t, \p. if validP p then PU1map f1 f2 t pu p else undefined)) + (\(t, pu). (permute_T1 f1 f2 t, \p. if validP p then PU1map f1 f2 t pu p else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if validP p then PU2map f1 f2 t pu p else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if validP p then PU2map f1 f2 t pu p else undefined)) y) p" apply (rule sym) apply (rule trans) @@ -966,18 +990,18 @@ lemma U2ctor_rename: assumes "validP p" "pred_T2_pre (\_. True) (pred_fun validP validU1 \ snd) (pred_fun validP validU1 \ snd) (pred_fun validP validU2 \ snd) (pred_fun validP validU2 \ snd) y" "bij f1" "|supp f1| t pu p. validP p \ (t, pu) \ set7_T2_pre y \ set8_T2_pre y \ U1FVars_1 t (pu p) \ FFVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y \ set10_T2_pre y \ U2FVars_1 t (pu p) \ FFVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y \ set8_T2_pre y \ U1FVars_2 t (pu p) \ FFVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y \ set10_T2_pre y \ U2FVars_2 t (pu p) \ FFVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - imsupp f1 \ (FFVars_T21 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1) = {} \ - imsupp f2 \ (FFVars_T22 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2) = {} \ + "(\t pu p. validP p \ (t, pu) \ set8_T2_pre y \ set9_T2_pre y \ U1FVars_1 t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y \ set11_T2_pre y \ U2FVars_1 t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y \ set9_T2_pre y \ U1FVars_2 t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y \ set11_T2_pre y \ U2FVars_2 t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ + imsupp f1 \ (FVars_T21 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1) = {} \ + imsupp f2 \ (FVars_T22 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2) = {} \ f1 ` set5_T2_pre y \ set5_T2_pre y = {} \ f2 ` set6_T2_pre y \ set6_T2_pre y = {} \ - U2ctor y p = U2ctor (map_T2_pre f1 f2 id id f1 f2 - (\(t, pu). (rrename_T1 f1 f2 t, \p. if validP p then PU1map f1 f2 t pu p else undefined)) - (\(t, pu). (rrename_T1 f1 f2 t, \p. if validP p then PU1map f1 f2 t pu p else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if validP p then PU2map f1 f2 t pu p else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if validP p then PU2map f1 f2 t pu p else undefined)) + U2ctor y p = U2ctor (map_T2_pre f1 f2 id id f1 f2 f1 + (\(t, pu). (permute_T1 f1 f2 t, \p. if validP p then PU1map f1 f2 t pu p else undefined)) + (\(t, pu). (permute_T1 f1 f2 t, \p. if validP p then PU1map f1 f2 t pu p else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if validP p then PU2map f1 f2 t pu p else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if validP p then PU2map f1 f2 t pu p else undefined)) y) p" (* same tactic as above *) apply (rule sym) @@ -1020,28 +1044,28 @@ lemma U1ctor_cong: "bij f1" "|supp f1| t pu p. validP p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_1 t (pu p) \ FFVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_1 t (pu p) \ FFVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_2 t (pu p) \ FFVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_2 t (pu p) \ FFVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y' \ set8_T1_pre y' \ U1FVars_1 t (pu p) \ FFVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y' \ set10_T1_pre y' \ U2FVars_1 t (pu p) \ FFVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y' \ set8_T1_pre y' \ U1FVars_2 t (pu p) \ FFVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y' \ set10_T1_pre y' \ U2FVars_2 t (pu p) \ FFVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - imsupp f1 \ (FFVars_T11 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1) = {} \ - imsupp f2 \ (FFVars_T12 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2) = {} \ - imsupp g1 \ (FFVars_T11 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y')) \ PFVars_1 p \ avoiding_set1) = {} \ - imsupp g2 \ (FFVars_T12 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y')) \ PFVars_2 p \ avoiding_set2) = {} \ + "(\t pu p. validP p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_1 t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_1 t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_2 t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_2 t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y' \ set9_T1_pre y' \ U1FVars_1 t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y' \ set11_T1_pre y' \ U2FVars_1 t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y' \ set9_T1_pre y' \ U1FVars_2 t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y' \ set11_T1_pre y' \ U2FVars_2 t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ + imsupp f1 \ (FVars_T11 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1) = {} \ + imsupp f2 \ (FVars_T12 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2) = {} \ + imsupp g1 \ (FVars_T11 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y')) \ PFVars_1 p \ avoiding_set1) = {} \ + imsupp g2 \ (FVars_T12 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y')) \ PFVars_2 p \ avoiding_set2) = {} \ f1 ` set5_T1_pre y \ set5_T1_pre y = {} \ f2 ` set6_T1_pre y \ set6_T1_pre y = {} \ g1 ` set5_T1_pre y' \ set5_T1_pre y' = {} \ g2 ` set6_T1_pre y' \ set6_T1_pre y' = {} \ - mr_rel_T1_pre (inv g1 \ f1) (inv g2 \ f2) id (=) (inv g1 \ f1) (inv g2 \ f2) - (\(t, pu) (t', pu'). rrename_T1 f1 f2 t = rrename_T1 g1 g2 t' \ + mr_rel_T1_pre (inv g1 \ f1) (inv g2 \ f2) id (=) (inv g1 \ f1) (inv g2 \ f2) (inv g1 \ f1) + (\(t, pu) (t', pu'). permute_T1 f1 f2 t = permute_T1 g1 g2 t' \ (\p. validP p \ PU1map f1 f2 t pu p = PU1map g1 g2 t' pu' p)) - (\(t, pu) (t', pu'). rrename_T1 f1 f2 t = rrename_T1 g1 g2 t' \ + (\(t, pu) (t', pu'). permute_T1 f1 f2 t = permute_T1 g1 g2 t' \ (\p. validP p \ PU1map f1 f2 t pu p = PU1map g1 g2 t' pu' p)) - (\(t, pu) (t', pu'). rrename_T2 f1 f2 t = rrename_T2 g1 g2 t' \ + (\(t, pu) (t', pu'). permute_T2 f1 f2 t = permute_T2 g1 g2 t' \ (\p. validP p \ PU2map f1 f2 t pu p = PU2map g1 g2 t' pu' p)) - (\(t, pu) (t', pu'). rrename_T2 f1 f2 t = rrename_T2 g1 g2 t' \ + (\(t, pu) (t', pu'). permute_T2 f1 f2 t = permute_T2 g1 g2 t' \ (\p. validP p \ PU2map f1 f2 t pu p = PU2map g1 g2 t' pu' p)) y y' \ U1ctor y p = U1ctor y' p" apply (rule trans) @@ -1142,28 +1166,28 @@ lemma U2ctor_cong: "bij f1" "|supp f1| t pu p. validP p \ (t, pu) \ set7_T2_pre y \ set8_T2_pre y \ U1FVars_1 t (pu p) \ FFVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y \ set10_T2_pre y \ U2FVars_1 t (pu p) \ FFVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y \ set8_T2_pre y \ U1FVars_2 t (pu p) \ FFVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y \ set10_T2_pre y \ U2FVars_2 t (pu p) \ FFVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y' \ set8_T2_pre y' \ U1FVars_1 t (pu p) \ FFVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y' \ set10_T2_pre y' \ U2FVars_1 t (pu p) \ FFVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y' \ set8_T2_pre y' \ U1FVars_2 t (pu p) \ FFVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y' \ set10_T2_pre y' \ U2FVars_2 t (pu p) \ FFVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - imsupp f1 \ (FFVars_T21 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1) = {} \ - imsupp f2 \ (FFVars_T22 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2) = {} \ - imsupp g1 \ (FFVars_T21 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y')) \ PFVars_1 p \ avoiding_set1) = {} \ - imsupp g2 \ (FFVars_T22 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y')) \ PFVars_2 p \ avoiding_set2) = {} \ + "(\t pu p. validP p \ (t, pu) \ set8_T2_pre y \ set9_T2_pre y \ U1FVars_1 t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y \ set11_T2_pre y \ U2FVars_1 t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y \ set9_T2_pre y \ U1FVars_2 t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y \ set11_T2_pre y \ U2FVars_2 t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y' \ set9_T2_pre y' \ U1FVars_1 t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y' \ set11_T2_pre y' \ U2FVars_1 t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y' \ set9_T2_pre y' \ U1FVars_2 t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y' \ set11_T2_pre y' \ U2FVars_2 t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ + imsupp f1 \ (FVars_T21 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1) = {} \ + imsupp f2 \ (FVars_T22 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2) = {} \ + imsupp g1 \ (FVars_T21 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y')) \ PFVars_1 p \ avoiding_set1) = {} \ + imsupp g2 \ (FVars_T22 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y')) \ PFVars_2 p \ avoiding_set2) = {} \ f1 ` set5_T2_pre y \ set5_T2_pre y = {} \ f2 ` set6_T2_pre y \ set6_T2_pre y = {} \ g1 ` set5_T2_pre y' \ set5_T2_pre y' = {} \ g2 ` set6_T2_pre y' \ set6_T2_pre y' = {} \ - mr_rel_T2_pre (inv g1 \ f1) (inv g2 \ f2) id (=) (inv g1 \ f1) (inv g2 \ f2) - (\(t, pu) (t', pu'). rrename_T1 f1 f2 t = rrename_T1 g1 g2 t' \ + mr_rel_T2_pre (inv g1 \ f1) (inv g2 \ f2) id (=) (inv g1 \ f1) (inv g2 \ f2) (inv g1 \ f1) + (\(t, pu) (t', pu'). permute_T1 f1 f2 t = permute_T1 g1 g2 t' \ (\p. validP p \ PU1map f1 f2 t pu p = PU1map g1 g2 t' pu' p)) - (\(t, pu) (t', pu'). rrename_T1 f1 f2 t = rrename_T1 g1 g2 t' \ + (\(t, pu) (t', pu'). permute_T1 f1 f2 t = permute_T1 g1 g2 t' \ (\p. validP p \ PU1map f1 f2 t pu p = PU1map g1 g2 t' pu' p)) - (\(t, pu) (t', pu'). rrename_T2 f1 f2 t = rrename_T2 g1 g2 t' \ + (\(t, pu) (t', pu'). permute_T2 f1 f2 t = permute_T2 g1 g2 t' \ (\p. validP p \ PU2map f1 f2 t pu p = PU2map g1 g2 t' pu' p)) - (\(t, pu) (t', pu'). rrename_T2 f1 f2 t = rrename_T2 g1 g2 t' \ + (\(t, pu) (t', pu'). permute_T2 f1 f2 t = permute_T2 g1 g2 t' \ (\p. validP p \ PU2map f1 f2 t pu p = PU2map g1 g2 t' pu' p)) y y' \ U2ctor y p = U2ctor y' p" (* same tactic as above *) @@ -1257,8 +1281,8 @@ lemma U2ctor_cong: apply (rule refl) done -lemmas T1_pre_set_map_ids = T1_pre.set_map[OF supp_id_bound supp_id_bound supp_id_bound bij_id supp_id_bound bij_id supp_id_bound, unfolded image_id] -lemmas T2_pre_set_map_ids = T2_pre.set_map[OF supp_id_bound supp_id_bound supp_id_bound bij_id supp_id_bound bij_id supp_id_bound, unfolded image_id] +lemmas T1_pre_set_map_ids = T1_pre.set_map[OF supp_id_bound supp_id_bound supp_id_bound bij_id supp_id_bound bij_id supp_id_bound supp_id_bound, unfolded image_id] +lemmas T2_pre_set_map_ids = T2_pre.set_map[OF supp_id_bound supp_id_bound supp_id_bound bij_id supp_id_bound bij_id supp_id_bound supp_id_bound, unfolded image_id] lemma U1ctor'_cong: fixes f1 g1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2 g2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" @@ -1268,28 +1292,28 @@ lemma U1ctor'_cong: and f_prems: "bij f1" "|supp f1| t pu p. validP p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_1' t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_1' t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_2' t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_2' t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y' \ set8_T1_pre y' \ U1FVars_1' t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y' \ set10_T1_pre y' \ U2FVars_1' t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y' \ set8_T1_pre y' \ U1FVars_2' t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y' \ set10_T1_pre y' \ U2FVars_2' t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - imsupp f1 \ (FVars_T11 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1) = {} \ - imsupp f2 \ (FVars_T12 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2) = {} \ - imsupp g1 \ (FVars_T11 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst y')) \ PFVars_1 p \ avoiding_set1) = {} \ - imsupp g2 \ (FVars_T12 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst y')) \ PFVars_2 p \ avoiding_set2) = {} \ + "(\t pu p. validP p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_1' t (pu p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_1' t (pu p) \ FVars_raw_T21 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_2' t (pu p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_2' t (pu p) \ FVars_raw_T22 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y' \ set9_T1_pre y' \ U1FVars_1' t (pu p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y' \ set11_T1_pre y' \ U2FVars_1' t (pu p) \ FVars_raw_T21 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y' \ set9_T1_pre y' \ U1FVars_2' t (pu p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y' \ set11_T1_pre y' \ U2FVars_2' t (pu p) \ FVars_raw_T22 t \ PFVars_2 p \ avoiding_set2) \ + imsupp f1 \ (FVars_raw_T11 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1) = {} \ + imsupp f2 \ (FVars_raw_T12 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2) = {} \ + imsupp g1 \ (FVars_raw_T11 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y')) \ PFVars_1 p \ avoiding_set1) = {} \ + imsupp g2 \ (FVars_raw_T12 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y')) \ PFVars_2 p \ avoiding_set2) = {} \ f1 ` set5_T1_pre y \ set5_T1_pre y = {} \ f2 ` set6_T1_pre y \ set6_T1_pre y = {} \ g1 ` set5_T1_pre y' \ set5_T1_pre y' = {} \ g2 ` set6_T1_pre y' \ set6_T1_pre y' = {} \ - mr_rel_T1_pre (inv g1 \ f1) (inv g2 \ f2) id (=) (inv g1 \ f1) (inv g2 \ f2) - (\(t, pu) (t', pu'). alpha_T1 (rename_T1 f1 f2 t) (rename_T1 g1 g2 t') \ + mr_rel_T1_pre (inv g1 \ f1) (inv g2 \ f2) id (=) (inv g1 \ f1) (inv g2 \ f2) (inv g1 \ f1) + (\(t, pu) (t', pu'). alpha_T1 (permute_raw_T1 f1 f2 t) (permute_raw_T1 g1 g2 t') \ (\p. validP p \ PU1map' f1 f2 t pu p = PU1map' g1 g2 t' pu' p)) - (\(t, pu) (t', pu'). alpha_T1 (rename_T1 f1 f2 t) (rename_T1 g1 g2 t') \ + (\(t, pu) (t', pu'). alpha_T1 (permute_raw_T1 f1 f2 t) (permute_raw_T1 g1 g2 t') \ (\p. validP p \ PU1map' f1 f2 t pu p = PU1map' g1 g2 t' pu' p)) - (\(t, pu) (t', pu'). alpha_T2 (rename_T2 f1 f2 t) (rename_T2 g1 g2 t') \ + (\(t, pu) (t', pu'). alpha_T2 (permute_raw_T2 f1 f2 t) (permute_raw_T2 g1 g2 t') \ (\p. validP p \ PU2map' f1 f2 t pu p = PU2map' g1 g2 t' pu' p)) - (\(t, pu) (t', pu'). alpha_T2 (rename_T2 f1 f2 t) (rename_T2 g1 g2 t') \ + (\(t, pu) (t', pu'). alpha_T2 (permute_raw_T2 f1 f2 t) (permute_raw_T2 g1 g2 t') \ (\p. validP p \ PU2map' f1 f2 t pu p = PU2map' g1 g2 t' pu' p)) y y' \ U1ctor' y p = U1ctor' y' p" apply (unfold U1ctor'_def U2ctor'_def) @@ -1353,10 +1377,10 @@ lemma U1ctor'_cong: (* REPEAT_DETERM *) subgoal apply (erule trans[OF arg_cong2[OF refl arg_cong2[OF arg_cong2[OF _ refl, of _ _ "(\)"] refl, of _ _ "(\)"], of _ _ "(\)"], rotated]) - apply (unfold FFVars_T11_def FFVars_T12_def FFVars_T21_def FFVars_T22_def T1_ctor_def T2_ctor_def)[1] - apply (rule T1.alpha_FVarss) - apply (rule T1.alpha_transs) - apply (rule T1.TT_Quotient_rep_abss) + apply (unfold FVars_T11_def FVars_T12_def FVars_T21_def FVars_T22_def T1_ctor_def T2_ctor_def)[1] + apply (rule alpha_FVars) + apply (rule alpha_trans) + apply (rule TT_rep_abs) apply (rule alpha_T1_alpha_T2.intros) apply (rule bij_id supp_id_bound id_on_id)+ apply (subst (2) T1_pre.map_comp T2_pre.map_comp) @@ -1369,19 +1393,19 @@ lemma U1ctor'_cong: apply (unfold id_o o_id) apply (rule iffD2[OF T1_pre.mr_rel_map(1)] iffD2[OF T2_pre.mr_rel_map(1)]) apply (rule supp_id_bound bij_id)+ - apply (unfold id_o o_id Grp_UNIV_id OO_eq T1.rename_ids) + apply (unfold id_o o_id Grp_UNIV_id OO_eq permute_raw_ids) apply (unfold mr_rel_T1_pre_def mr_rel_T2_pre_def T1_pre.map_id T2_pre.map_id)[1] apply (rule T1_pre.rel_refl_strong T2_pre.rel_refl_strong) apply (unfold Grp_OO comp_def) - apply (rule refl T1.TT_Quotient_rep_abss)+ + apply (rule refl TT_rep_abs)+ done (* copied from above *) subgoal apply (erule trans[OF arg_cong2[OF refl arg_cong2[OF arg_cong2[OF _ refl, of _ _ "(\)"] refl, of _ _ "(\)"], of _ _ "(\)"], rotated]) - apply (unfold FFVars_T11_def FFVars_T12_def FFVars_T21_def FFVars_T22_def T1_ctor_def T2_ctor_def)[1] - apply (rule T1.alpha_FVarss) - apply (rule T1.alpha_transs) - apply (rule T1.TT_Quotient_rep_abss) + apply (unfold FVars_T11_def FVars_T12_def FVars_T21_def FVars_T22_def T1_ctor_def T2_ctor_def)[1] + apply (rule alpha_FVars) + apply (rule alpha_trans) + apply (rule TT_rep_abs) apply (rule alpha_T1_alpha_T2.intros) apply (rule bij_id supp_id_bound id_on_id)+ apply (subst (2) T1_pre.map_comp T2_pre.map_comp) @@ -1394,18 +1418,18 @@ lemma U1ctor'_cong: apply (unfold id_o o_id) apply (rule iffD2[OF T1_pre.mr_rel_map(1)] iffD2[OF T2_pre.mr_rel_map(1)]) apply (rule supp_id_bound bij_id)+ - apply (unfold id_o o_id Grp_UNIV_id OO_eq T1.rename_ids) + apply (unfold id_o o_id Grp_UNIV_id OO_eq permute_raw_ids) apply (unfold mr_rel_T1_pre_def mr_rel_T2_pre_def T1_pre.map_id T2_pre.map_id)[1] apply (rule T1_pre.rel_refl_strong T2_pre.rel_refl_strong) apply (unfold Grp_OO comp_def) - apply (rule refl T1.TT_Quotient_rep_abss)+ + apply (rule refl TT_rep_abs)+ done subgoal apply (erule trans[OF arg_cong2[OF refl arg_cong2[OF arg_cong2[OF _ refl, of _ _ "(\)"] refl, of _ _ "(\)"], of _ _ "(\)"], rotated]) - apply (unfold FFVars_T11_def FFVars_T12_def FFVars_T21_def FFVars_T22_def T1_ctor_def T2_ctor_def)[1] - apply (rule T1.alpha_FVarss) - apply (rule T1.alpha_transs) - apply (rule T1.TT_Quotient_rep_abss) + apply (unfold FVars_T11_def FVars_T12_def FVars_T21_def FVars_T22_def T1_ctor_def T2_ctor_def)[1] + apply (rule alpha_FVars) + apply (rule alpha_trans) + apply (rule TT_rep_abs) apply (rule alpha_T1_alpha_T2.intros) apply (rule bij_id supp_id_bound id_on_id)+ apply (subst (2) T1_pre.map_comp T2_pre.map_comp) @@ -1418,18 +1442,18 @@ lemma U1ctor'_cong: apply (unfold id_o o_id) apply (rule iffD2[OF T1_pre.mr_rel_map(1)] iffD2[OF T2_pre.mr_rel_map(1)]) apply (rule supp_id_bound bij_id)+ - apply (unfold id_o o_id Grp_UNIV_id OO_eq T1.rename_ids) + apply (unfold id_o o_id Grp_UNIV_id OO_eq permute_raw_ids) apply (unfold mr_rel_T1_pre_def mr_rel_T2_pre_def T1_pre.map_id T2_pre.map_id)[1] apply (rule T1_pre.rel_refl_strong T2_pre.rel_refl_strong) apply (unfold Grp_OO comp_def) - apply (rule refl T1.TT_Quotient_rep_abss)+ + apply (rule refl TT_rep_abs)+ done subgoal apply (erule trans[OF arg_cong2[OF refl arg_cong2[OF arg_cong2[OF _ refl, of _ _ "(\)"] refl, of _ _ "(\)"], of _ _ "(\)"], rotated]) - apply (unfold FFVars_T11_def FFVars_T12_def FFVars_T21_def FFVars_T22_def T1_ctor_def T2_ctor_def)[1] - apply (rule T1.alpha_FVarss) - apply (rule T1.alpha_transs) - apply (rule T1.TT_Quotient_rep_abss) + apply (unfold FVars_T11_def FVars_T12_def FVars_T21_def FVars_T22_def T1_ctor_def T2_ctor_def)[1] + apply (rule alpha_FVars) + apply (rule alpha_trans) + apply (rule TT_rep_abs) apply (rule alpha_T1_alpha_T2.intros) apply (rule bij_id supp_id_bound id_on_id)+ apply (subst (2) T1_pre.map_comp T2_pre.map_comp) @@ -1442,11 +1466,11 @@ lemma U1ctor'_cong: apply (unfold id_o o_id) apply (rule iffD2[OF T1_pre.mr_rel_map(1)] iffD2[OF T2_pre.mr_rel_map(1)]) apply (rule supp_id_bound bij_id)+ - apply (unfold id_o o_id Grp_UNIV_id OO_eq T1.rename_ids) + apply (unfold id_o o_id Grp_UNIV_id OO_eq permute_raw_ids) apply (unfold mr_rel_T1_pre_def mr_rel_T2_pre_def T1_pre.map_id T2_pre.map_id)[1] apply (rule T1_pre.rel_refl_strong T2_pre.rel_refl_strong) apply (unfold Grp_OO comp_def) - apply (rule refl T1.TT_Quotient_rep_abss)+ + apply (rule refl TT_rep_abs)+ done (* END REPEAT_DETERM *) apply assumption+ @@ -1467,22 +1491,22 @@ lemma U1ctor'_cong: (* default_case *) subgoal apply (rule ballI impI)+ - apply (unfold case_prod_beta fst_map_prod snd_map_prod rrename_T1_def rrename_T2_def)[1] + apply (unfold case_prod_beta fst_map_prod snd_map_prod permute_T1_def permute_T2_def)[1] apply (erule conjE) apply (rule conjI) - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) (* REPEAT_DETERM *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* copied from above *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* END REPEAT_DETERM *) apply assumption apply (unfold PU1map_def PU2map_def PU1map'_def PU2map'_def U1map'_def U2map'_def id_def) @@ -1491,22 +1515,22 @@ lemma U1ctor'_cong: (* copied from above *) subgoal apply (rule ballI impI)+ - apply (unfold case_prod_beta fst_map_prod snd_map_prod rrename_T1_def rrename_T2_def)[1] + apply (unfold case_prod_beta fst_map_prod snd_map_prod permute_T1_def permute_T2_def)[1] apply (erule conjE) apply (rule conjI) - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) (* REPEAT_DETERM *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* copied from above *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* END REPEAT_DETERM *) apply assumption apply (unfold PU1map_def PU2map_def PU1map'_def PU2map'_def U1map'_def U2map'_def id_def) @@ -1514,22 +1538,22 @@ lemma U1ctor'_cong: done subgoal apply (rule ballI impI)+ - apply (unfold case_prod_beta fst_map_prod snd_map_prod rrename_T1_def rrename_T2_def)[1] + apply (unfold case_prod_beta fst_map_prod snd_map_prod permute_T1_def permute_T2_def)[1] apply (erule conjE) apply (rule conjI) - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) (* REPEAT_DETERM *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* copied from above *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* END REPEAT_DETERM *) apply assumption apply (unfold PU1map_def PU2map_def PU1map'_def PU2map'_def U1map'_def U2map'_def id_def) @@ -1537,22 +1561,22 @@ lemma U1ctor'_cong: done subgoal apply (rule ballI impI)+ - apply (unfold case_prod_beta fst_map_prod snd_map_prod rrename_T1_def rrename_T2_def)[1] + apply (unfold case_prod_beta fst_map_prod snd_map_prod permute_T1_def permute_T2_def)[1] apply (erule conjE) apply (rule conjI) - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) (* REPEAT_DETERM *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* copied from above *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* END REPEAT_DETERM *) apply assumption apply (unfold PU1map_def PU2map_def PU1map'_def PU2map'_def U1map'_def U2map'_def id_def) @@ -1568,28 +1592,28 @@ lemma U2ctor'_cong: and f_prems: "bij f1" "|supp f1| t pu p. validP p \ (t, pu) \ set7_T2_pre y \ set8_T2_pre y \ U1FVars_1' t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y \ set10_T2_pre y \ U2FVars_1' t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y \ set8_T2_pre y \ U1FVars_2' t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y \ set10_T2_pre y \ U2FVars_2' t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y' \ set8_T2_pre y' \ U1FVars_1' t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y' \ set10_T2_pre y' \ U2FVars_1' t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y' \ set8_T2_pre y' \ U1FVars_2' t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y' \ set10_T2_pre y' \ U2FVars_2' t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - imsupp f1 \ (FVars_T21 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1) = {} \ - imsupp f2 \ (FVars_T22 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2) = {} \ - imsupp g1 \ (FVars_T21 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst y')) \ PFVars_1 p \ avoiding_set1) = {} \ - imsupp g2 \ (FVars_T22 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst y')) \ PFVars_2 p \ avoiding_set2) = {} \ + "(\t pu p. validP p \ (t, pu) \ set8_T2_pre y \ set9_T2_pre y \ U1FVars_1' t (pu p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y \ set11_T2_pre y \ U2FVars_1' t (pu p) \ FVars_raw_T21 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y \ set9_T2_pre y \ U1FVars_2' t (pu p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y \ set11_T2_pre y \ U2FVars_2' t (pu p) \ FVars_raw_T22 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y' \ set9_T2_pre y' \ U1FVars_1' t (pu p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y' \ set11_T2_pre y' \ U2FVars_1' t (pu p) \ FVars_raw_T21 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y' \ set9_T2_pre y' \ U1FVars_2' t (pu p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y' \ set11_T2_pre y' \ U2FVars_2' t (pu p) \ FVars_raw_T22 t \ PFVars_2 p \ avoiding_set2) \ + imsupp f1 \ (FVars_raw_T21 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1) = {} \ + imsupp f2 \ (FVars_raw_T22 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2) = {} \ + imsupp g1 \ (FVars_raw_T21 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y')) \ PFVars_1 p \ avoiding_set1) = {} \ + imsupp g2 \ (FVars_raw_T22 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y')) \ PFVars_2 p \ avoiding_set2) = {} \ f1 ` set5_T2_pre y \ set5_T2_pre y = {} \ f2 ` set6_T2_pre y \ set6_T2_pre y = {} \ g1 ` set5_T2_pre y' \ set5_T2_pre y' = {} \ g2 ` set6_T2_pre y' \ set6_T2_pre y' = {} \ - mr_rel_T2_pre (inv g1 \ f1) (inv g2 \ f2) id (=) (inv g1 \ f1) (inv g2 \ f2) - (\(t, pu) (t', pu'). alpha_T1 (rename_T1 f1 f2 t) (rename_T1 g1 g2 t') \ + mr_rel_T2_pre (inv g1 \ f1) (inv g2 \ f2) id (=) (inv g1 \ f1) (inv g2 \ f2) (inv g1 \ f1) + (\(t, pu) (t', pu'). alpha_T1 (permute_raw_T1 f1 f2 t) (permute_raw_T1 g1 g2 t') \ (\p. validP p \ PU1map' f1 f2 t pu p = PU1map' g1 g2 t' pu' p)) - (\(t, pu) (t', pu'). alpha_T1 (rename_T1 f1 f2 t) (rename_T1 g1 g2 t') \ + (\(t, pu) (t', pu'). alpha_T1 (permute_raw_T1 f1 f2 t) (permute_raw_T1 g1 g2 t') \ (\p. validP p \ PU1map' f1 f2 t pu p = PU1map' g1 g2 t' pu' p)) - (\(t, pu) (t', pu'). alpha_T2 (rename_T2 f1 f2 t) (rename_T2 g1 g2 t') \ + (\(t, pu) (t', pu'). alpha_T2 (permute_raw_T2 f1 f2 t) (permute_raw_T2 g1 g2 t') \ (\p. validP p \ PU2map' f1 f2 t pu p = PU2map' g1 g2 t' pu' p)) - (\(t, pu) (t', pu'). alpha_T2 (rename_T2 f1 f2 t) (rename_T2 g1 g2 t') \ + (\(t, pu) (t', pu'). alpha_T2 (permute_raw_T2 f1 f2 t) (permute_raw_T2 g1 g2 t') \ (\p. validP p \ PU2map' f1 f2 t pu p = PU2map' g1 g2 t' pu' p)) y y' \ U2ctor' y p = U2ctor' y' p" apply (unfold U1ctor'_def U2ctor'_def) @@ -1653,10 +1677,10 @@ lemma U2ctor'_cong: (* REPEAT_DETERM *) subgoal apply (erule trans[OF arg_cong2[OF refl arg_cong2[OF arg_cong2[OF _ refl, of _ _ "(\)"] refl, of _ _ "(\)"], of _ _ "(\)"], rotated]) - apply (unfold FFVars_T11_def FFVars_T12_def FFVars_T21_def FFVars_T22_def T1_ctor_def T2_ctor_def)[1] - apply (rule T1.alpha_FVarss) - apply (rule T1.alpha_transs) - apply (rule T1.TT_Quotient_rep_abss) + apply (unfold FVars_T11_def FVars_T12_def FVars_T21_def FVars_T22_def T1_ctor_def T2_ctor_def)[1] + apply (rule alpha_FVars) + apply (rule alpha_trans) + apply (rule TT_rep_abs) apply (rule alpha_T1_alpha_T2.intros) apply (rule bij_id supp_id_bound id_on_id)+ apply (subst (2) T1_pre.map_comp T2_pre.map_comp) @@ -1669,19 +1693,19 @@ lemma U2ctor'_cong: apply (unfold id_o o_id) apply (rule iffD2[OF T1_pre.mr_rel_map(1)] iffD2[OF T2_pre.mr_rel_map(1)]) apply (rule supp_id_bound bij_id)+ - apply (unfold id_o o_id Grp_UNIV_id OO_eq T1.rename_ids) + apply (unfold id_o o_id Grp_UNIV_id OO_eq permute_raw_ids) apply (unfold mr_rel_T1_pre_def mr_rel_T2_pre_def T1_pre.map_id T2_pre.map_id)[1] apply (rule T1_pre.rel_refl_strong T2_pre.rel_refl_strong) apply (unfold Grp_OO comp_def) - apply (rule refl T1.TT_Quotient_rep_abss)+ + apply (rule refl TT_rep_abs)+ done (* copied from above *) subgoal apply (erule trans[OF arg_cong2[OF refl arg_cong2[OF arg_cong2[OF _ refl, of _ _ "(\)"] refl, of _ _ "(\)"], of _ _ "(\)"], rotated]) - apply (unfold FFVars_T11_def FFVars_T12_def FFVars_T21_def FFVars_T22_def T1_ctor_def T2_ctor_def)[1] - apply (rule T1.alpha_FVarss) - apply (rule T1.alpha_transs) - apply (rule T1.TT_Quotient_rep_abss) + apply (unfold FVars_T11_def FVars_T12_def FVars_T21_def FVars_T22_def T1_ctor_def T2_ctor_def)[1] + apply (rule alpha_FVars) + apply (rule alpha_trans) + apply (rule TT_rep_abs) apply (rule alpha_T1_alpha_T2.intros) apply (rule bij_id supp_id_bound id_on_id)+ apply (subst (2) T1_pre.map_comp T2_pre.map_comp) @@ -1694,18 +1718,18 @@ lemma U2ctor'_cong: apply (unfold id_o o_id) apply (rule iffD2[OF T1_pre.mr_rel_map(1)] iffD2[OF T2_pre.mr_rel_map(1)]) apply (rule supp_id_bound bij_id)+ - apply (unfold id_o o_id Grp_UNIV_id OO_eq T1.rename_ids) + apply (unfold id_o o_id Grp_UNIV_id OO_eq permute_raw_ids) apply (unfold mr_rel_T1_pre_def mr_rel_T2_pre_def T1_pre.map_id T2_pre.map_id)[1] apply (rule T1_pre.rel_refl_strong T2_pre.rel_refl_strong) apply (unfold Grp_OO comp_def) - apply (rule refl T1.TT_Quotient_rep_abss)+ + apply (rule refl TT_rep_abs)+ done subgoal apply (erule trans[OF arg_cong2[OF refl arg_cong2[OF arg_cong2[OF _ refl, of _ _ "(\)"] refl, of _ _ "(\)"], of _ _ "(\)"], rotated]) - apply (unfold FFVars_T11_def FFVars_T12_def FFVars_T21_def FFVars_T22_def T1_ctor_def T2_ctor_def)[1] - apply (rule T1.alpha_FVarss) - apply (rule T1.alpha_transs) - apply (rule T1.TT_Quotient_rep_abss) + apply (unfold FVars_T11_def FVars_T12_def FVars_T21_def FVars_T22_def T1_ctor_def T2_ctor_def)[1] + apply (rule alpha_FVars) + apply (rule alpha_trans) + apply (rule TT_rep_abs) apply (rule alpha_T1_alpha_T2.intros) apply (rule bij_id supp_id_bound id_on_id)+ apply (subst (2) T1_pre.map_comp T2_pre.map_comp) @@ -1718,18 +1742,18 @@ lemma U2ctor'_cong: apply (unfold id_o o_id) apply (rule iffD2[OF T1_pre.mr_rel_map(1)] iffD2[OF T2_pre.mr_rel_map(1)]) apply (rule supp_id_bound bij_id)+ - apply (unfold id_o o_id Grp_UNIV_id OO_eq T1.rename_ids) + apply (unfold id_o o_id Grp_UNIV_id OO_eq permute_raw_ids) apply (unfold mr_rel_T1_pre_def mr_rel_T2_pre_def T1_pre.map_id T2_pre.map_id)[1] apply (rule T1_pre.rel_refl_strong T2_pre.rel_refl_strong) apply (unfold Grp_OO comp_def) - apply (rule refl T1.TT_Quotient_rep_abss)+ + apply (rule refl TT_rep_abs)+ done subgoal apply (erule trans[OF arg_cong2[OF refl arg_cong2[OF arg_cong2[OF _ refl, of _ _ "(\)"] refl, of _ _ "(\)"], of _ _ "(\)"], rotated]) - apply (unfold FFVars_T11_def FFVars_T12_def FFVars_T21_def FFVars_T22_def T1_ctor_def T2_ctor_def)[1] - apply (rule T1.alpha_FVarss) - apply (rule T1.alpha_transs) - apply (rule T1.TT_Quotient_rep_abss) + apply (unfold FVars_T11_def FVars_T12_def FVars_T21_def FVars_T22_def T1_ctor_def T2_ctor_def)[1] + apply (rule alpha_FVars) + apply (rule alpha_trans) + apply (rule TT_rep_abs) apply (rule alpha_T1_alpha_T2.intros) apply (rule bij_id supp_id_bound id_on_id)+ apply (subst (2) T1_pre.map_comp T2_pre.map_comp) @@ -1742,11 +1766,11 @@ lemma U2ctor'_cong: apply (unfold id_o o_id) apply (rule iffD2[OF T1_pre.mr_rel_map(1)] iffD2[OF T2_pre.mr_rel_map(1)]) apply (rule supp_id_bound bij_id)+ - apply (unfold id_o o_id Grp_UNIV_id OO_eq T1.rename_ids) + apply (unfold id_o o_id Grp_UNIV_id OO_eq permute_raw_ids) apply (unfold mr_rel_T1_pre_def mr_rel_T2_pre_def T1_pre.map_id T2_pre.map_id)[1] apply (rule T1_pre.rel_refl_strong T2_pre.rel_refl_strong) apply (unfold Grp_OO comp_def) - apply (rule refl T1.TT_Quotient_rep_abss)+ + apply (rule refl TT_rep_abs)+ done (* END REPEAT_DETERM *) apply assumption+ @@ -1767,22 +1791,22 @@ lemma U2ctor'_cong: (* default_case *) subgoal apply (rule ballI impI)+ - apply (unfold case_prod_beta fst_map_prod snd_map_prod rrename_T1_def rrename_T2_def)[1] + apply (unfold case_prod_beta fst_map_prod snd_map_prod permute_T1_def permute_T2_def)[1] apply (erule conjE) apply (rule conjI) - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) (* REPEAT_DETERM *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* copied from above *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* END REPEAT_DETERM *) apply assumption apply (unfold PU1map_def PU2map_def PU1map'_def PU2map'_def U1map'_def U2map'_def id_def) @@ -1791,22 +1815,22 @@ lemma U2ctor'_cong: (* copied from above *) subgoal apply (rule ballI impI)+ - apply (unfold case_prod_beta fst_map_prod snd_map_prod rrename_T1_def rrename_T2_def)[1] + apply (unfold case_prod_beta fst_map_prod snd_map_prod permute_T1_def permute_T2_def)[1] apply (erule conjE) apply (rule conjI) - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) (* REPEAT_DETERM *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* copied from above *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* END REPEAT_DETERM *) apply assumption apply (unfold PU1map_def PU2map_def PU1map'_def PU2map'_def U1map'_def U2map'_def id_def) @@ -1814,22 +1838,22 @@ lemma U2ctor'_cong: done subgoal apply (rule ballI impI)+ - apply (unfold case_prod_beta fst_map_prod snd_map_prod rrename_T1_def rrename_T2_def)[1] + apply (unfold case_prod_beta fst_map_prod snd_map_prod permute_T1_def permute_T2_def)[1] apply (erule conjE) apply (rule conjI) - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) (* REPEAT_DETERM *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* copied from above *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* END REPEAT_DETERM *) apply assumption apply (unfold PU1map_def PU2map_def PU1map'_def PU2map'_def U1map'_def U2map'_def id_def) @@ -1837,22 +1861,22 @@ lemma U2ctor'_cong: done subgoal apply (rule ballI impI)+ - apply (unfold case_prod_beta fst_map_prod snd_map_prod rrename_T1_def rrename_T2_def)[1] + apply (unfold case_prod_beta fst_map_prod snd_map_prod permute_T1_def permute_T2_def)[1] apply (erule conjE) apply (rule conjI) - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) (* REPEAT_DETERM *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* copied from above *) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_trans) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule assms)+ - apply (rule T1.TT_Quotient_rep_abss) - apply (rule T1.alpha_syms) + apply (rule TT_rep_abs) + apply (rule alpha_syms) (* END REPEAT_DETERM *) apply assumption apply (unfold PU1map_def PU2map_def PU1map'_def PU2map'_def U1map'_def U2map'_def id_def) @@ -1863,14 +1887,14 @@ lemma U2ctor'_cong: lemma U1map'_alpha: "alpha_T1 t t' \ U1map' f1 f2 t = U1map' f1 f2 t'" apply (unfold U1map'_def U2map'_def) apply (rule arg_cong3[OF refl refl, of _ _ U1map] arg_cong3[OF refl refl, of _ _ U2map]) (* mk_arg_cong (nvars + 1) *) - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) apply assumption done lemma U2map'_alpha: "alpha_T2 t t' \ U2map' f1 f2 t = U2map' f1 f2 t'" (* same tactic as above *) apply (unfold U1map'_def U2map'_def) apply (rule arg_cong3[OF refl refl, of _ _ U1map] arg_cong3[OF refl refl, of _ _ U2map]) (* mk_arg_cong (nvars + 1) *) - apply (rule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2]) + apply (rule TT_total_abs_eq_iffs[THEN iffD2]) apply assumption done @@ -1893,12 +1917,12 @@ lemma PU2map'_alpha: "alpha_T2 t t' \ PU2map' f1 f2 t = PU2map' lemma alpha_ctor_picks1: "suitable11 pick1 \ suitable12 pick2 \ suitable21 pick3 \ suitable22 pick4 \ validP p \ alpha_T1 (raw_T1_ctor x) (raw_T1_ctor ( - map_T1_pre id id id id id id fst fst fst fst ( - map_T1_pre id id id id (pick1 x p) (pick2 x p) + map_T1_pre id id id id id id id fst fst fst fst ( + map_T1_pre id id id id (pick1 x p) (pick2 x p) (pick1 x p) (\t. (t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T1 (pick1 x p) (pick2 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (rename_T1 (pick1 x p) (pick2 x p) t) p' else undefined)) + (\t. (permute_raw_T1 (pick1 x p) (pick2 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 (pick1 x p) (pick2 x p) t) p' else undefined)) (\t. (t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T2 (pick1 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (rename_T2 (pick1 x p) id t) p' else undefined)) + (\t. (permute_raw_T2 (pick1 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 (pick1 x p) id t) p' else undefined)) x ) ))" @@ -1912,19 +1936,19 @@ lemma alpha_ctor_picks1: apply (unfold relcompp_conversep_Grp) apply (unfold mr_rel_T1_pre_def T1_pre.map_id mr_rel_T2_pre_def T2_pre.map_id) apply (rule T1_pre.rel_refl_strong T2_pre.rel_refl_strong) - apply (rule refl T1.alpha_refls)+ + apply (rule refl alpha_refls)+ apply (rule supp_id_bound bij_id | erule suitable_bij suitable_supp_bound | assumption)+ apply (erule pick_id_ons, assumption)+ done lemma alpha_ctor_picks2: "suitable11 pick1 \ suitable12 pick2 \ suitable21 pick3 \ suitable22 pick4 \ validP p \ alpha_T2 (raw_T2_ctor x) (raw_T2_ctor ( - map_T2_pre id id id id id id fst fst fst fst ( - map_T2_pre id id id id (pick3 x p) (pick4 x p) + map_T2_pre id id id id id id id fst fst fst fst ( + map_T2_pre id id id id (pick3 x p) (pick4 x p) (pick3 x p) (\t. (t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T1 (pick3 x p) (pick4 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (rename_T1 (pick3 x p) (pick4 x p) t) p' else undefined)) + (\t. (permute_raw_T1 (pick3 x p) (pick4 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 (pick3 x p) (pick4 x p) t) p' else undefined)) (\t. (t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T2 (pick3 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (rename_T2 (pick3 x p) id t) p' else undefined)) + (\t. (permute_raw_T2 (pick3 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 (pick3 x p) id t) p' else undefined)) x ) ))" @@ -1939,7 +1963,7 @@ lemma alpha_ctor_picks2: apply (unfold relcompp_conversep_Grp) apply (unfold mr_rel_T1_pre_def T1_pre.map_id mr_rel_T2_pre_def T2_pre.map_id) apply (rule T1_pre.rel_refl_strong T2_pre.rel_refl_strong) - apply (rule refl T1.alpha_refls)+ + apply (rule refl alpha_refls)+ apply (rule supp_id_bound bij_id | erule suitable_bij suitable_supp_bound | assumption)+ apply (erule pick_id_ons, assumption)+ done @@ -1961,10 +1985,10 @@ lemma int_empties1: and f_prems: "bij f1" "|supp f1| avoiding_set1 = {}" "imsupp f2 \ avoiding_set2 = {}" shows "set5_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T11 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T11 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {}" "set6_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T12 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T12 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {}" proof - have x: "validP (Pmap (inv f1) (inv f2) p)" @@ -1973,9 +1997,9 @@ proof - note pick_prems = mk_pick_prems[OF suitable_prems x] show "set5_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T11 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = + (FVars_raw_T11 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {}" "set6_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T12 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = + (FVars_raw_T12 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {}" apply (unfold XXl1_def XXr1_def) subgoal @@ -1983,10 +2007,10 @@ proof - apply (subst T1_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ apply (unfold id_o o_id comp_def[of fst] fst_conv) - apply (unfold T1.FVars_ctors) + apply (unfold FVars_raw_ctors) apply (subst T1_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[unfolded comp_def]) - apply (subst T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[symmetric] image_UN[symmetric]) apply (subst image_set_diff[OF bij_is_inj, symmetric], rule f_prems)+ apply (unfold image_Un[symmetric]) @@ -2020,7 +2044,7 @@ proof - apply (rule iffD2[OF image_is_empty]) apply (insert suitable_prems) apply (subst image_set_diff[OF bij_is_inj, symmetric], rule pick_prems)+ - apply (unfold suitable_defs Int_Un_distrib Un_empty T1.FVars_ctors) + apply (unfold suitable_defs Int_Un_distrib Un_empty FVars_raw_ctors) apply (erule allE impE[OF _ x] conjE)+ apply (rule conjI)+ apply assumption+ (* assumption ORELSE ... *) @@ -2034,6 +2058,12 @@ proof - apply assumption apply (rule iffD2[OF image_is_empty]) apply (rule Diff_disjoint) + (* repeated *) + apply assumption + apply (rule trans[OF image_Int[OF bij_is_inj, symmetric]]) + apply assumption + apply (rule iffD2[OF image_is_empty]) + apply (rule Diff_disjoint) done subgoal @@ -2041,10 +2071,10 @@ proof - apply (subst T1_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ apply (unfold id_o o_id comp_def[of fst] fst_conv) - apply (unfold T1.FVars_ctors) + apply (unfold FVars_raw_ctors) apply (subst T1_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[unfolded comp_def]) - apply (subst T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[symmetric] image_UN[symmetric]) apply (subst image_set_diff[OF bij_is_inj, symmetric], rule f_prems)+ apply (unfold image_Un[symmetric]) @@ -2078,7 +2108,7 @@ proof - apply (unfold image_is_empty) apply (insert suitable_prems) apply (subst image_set_diff[OF bij_is_inj, symmetric], rule pick_prems)+ - apply (unfold suitable_defs Int_Un_distrib Un_empty T1.FVars_ctors) + apply (unfold suitable_defs Int_Un_distrib Un_empty FVars_raw_ctors) apply (erule allE impE[OF _ x] conjE)+ apply (rule conjI)+ apply assumption+ @@ -2091,12 +2121,6 @@ proof - done qed -ML \ -val fp_res = the (MRBNF_FP_Def_Sugar.fp_result_of @{context} "Fixpoint.T1") -val quotient = hd (#quotient_fps fp_res) -val raw = hd (#raw_fps fp_res) -\ - lemma int_empties2: fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" assumes valid: "validP p" @@ -2104,19 +2128,19 @@ lemma int_empties2: and f_prems: "bij f1" "|supp f1| avoiding_set1 = {}" "imsupp f2 \ avoiding_set2 = {}" shows "set5_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T11 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T11 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {}" "set6_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T12 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T12 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {}" proof - note pick_prems = mk_pick_prems[OF suitable_prems valid] show "set5_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T11 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T11 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {}" "set6_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T12 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T12 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {}" apply (unfold XXr1_def) @@ -2125,22 +2149,24 @@ proof - apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ apply (subst T1_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ - apply (unfold id_o o_id comp_def[of fst] fst_conv T1.FVars_ctors) + apply (unfold id_o o_id comp_def[of fst] fst_conv FVars_raw_ctors) apply (subst T1_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[unfolded comp_def]) - apply (subst T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) apply (subst image_set_diff[OF bij_is_inj, symmetric], (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[symmetric]) - apply (subst id_on_image[OF conjunct1[OF pick_id_on_images(1)[unfolded image_Un id_on_Un]]] id_on_image[OF conjunct2[OF pick_id_on_images(1)[unfolded image_Un id_on_Un]]] + apply (subst id_on_image[OF conjunct1[OF conjunct1[OF pick_id_on_images(1)[unfolded image_Un id_on_Un]]]] + id_on_image[OF conjunct2[OF conjunct1[OF pick_id_on_images(1)[unfolded image_Un id_on_Un]]]] + id_on_image[OF conjunct2[OF pick_id_on_images(1)[unfolded image_Un id_on_Un]]] id_on_image[OF pick_id_on_images(2)] id_on_image[OF pick_id_on_images(2)] , (rule f_prems suitable_prems valid)+)+ - apply (unfold image_Un[symmetric] T1.FVars_ctors[symmetric]) + apply (unfold image_Un[symmetric] FVars_raw_ctors[symmetric]) apply (subst T1_pre.set_map[symmetric]) - prefer 8 - apply (subst T1.FVars_renames[symmetric]) + prefer 9 (* free + 2 * bound + 1 *) + apply (subst FVars_raw_permutes[symmetric]) prefer 5 - apply (tactic \EqSubst.eqsubst_tac @{context} [0] [#rename_simp (#inner raw)] 1\) + apply (subst permute_raw_simps) prefer 5 apply (insert suitable_prems)[1] apply (unfold suitable_defs) @@ -2155,22 +2181,24 @@ proof - apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ apply (subst T1_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ - apply (unfold id_o o_id comp_def[of fst] fst_conv T1.FVars_ctors) + apply (unfold id_o o_id comp_def[of fst] fst_conv FVars_raw_ctors) apply (subst T1_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[unfolded comp_def]) - apply (subst T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) apply (subst image_set_diff[OF bij_is_inj, symmetric], (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[symmetric]) - apply (subst id_on_image[OF conjunct1[OF pick_id_on_images(1)[unfolded image_Un id_on_Un]]] id_on_image[OF conjunct2[OF pick_id_on_images(1)[unfolded image_Un id_on_Un]]] + apply (subst id_on_image[OF conjunct1[OF conjunct1[OF pick_id_on_images(1)[unfolded image_Un id_on_Un]]]] + id_on_image[OF conjunct2[OF conjunct1[OF pick_id_on_images(1)[unfolded image_Un id_on_Un]]]] + id_on_image[OF conjunct2[OF pick_id_on_images(1)[unfolded image_Un id_on_Un]]] id_on_image[OF pick_id_on_images(2)] id_on_image[OF pick_id_on_images(2)] , (rule f_prems suitable_prems valid)+)+ - apply (unfold image_Un[symmetric] T1.FVars_ctors[symmetric]) + apply (unfold image_Un[symmetric] FVars_raw_ctors[symmetric]) apply (subst T1_pre.set_map[symmetric]) - prefer 8 - apply (subst T1.FVars_renames[symmetric]) + prefer 9 + apply (subst FVars_raw_permutes[symmetric]) prefer 5 - apply (tactic \EqSubst.eqsubst_tac @{context} [0] [#rename_simp (#inner raw)] 1\) + apply (subst permute_raw_simps) prefer 5 apply (insert suitable_prems)[1] apply (unfold suitable_defs) @@ -2188,10 +2216,10 @@ lemma int_empties3: and f_prems: "bij f1" "|supp f1| avoiding_set1 = {}" "imsupp f2 \ avoiding_set2 = {}" shows "set5_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T21 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T21 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {}" "set6_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T22 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T22 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {}" proof - have x: "validP (Pmap (inv f1) (inv f2) p)" @@ -2200,10 +2228,10 @@ proof - note pick_prems = mk_pick_prems[OF suitable_prems x] show "set5_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T21 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T21 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {}" "set6_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T22 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T22 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {}" apply (unfold XXl2_def XXr2_def) subgoal @@ -2211,10 +2239,10 @@ proof - apply (subst T2_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ apply (unfold id_o o_id comp_def[of fst] fst_conv) - apply (unfold T1.FVars_ctors) + apply (unfold FVars_raw_ctors) apply (subst T2_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[unfolded comp_def]) - apply (subst T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[symmetric] image_UN[symmetric]) apply (subst image_set_diff[OF bij_is_inj, symmetric], rule f_prems)+ apply (unfold image_Un[symmetric]) @@ -2248,7 +2276,7 @@ proof - apply (rule iffD2[OF image_is_empty]) apply (insert suitable_prems) apply (subst image_set_diff[OF bij_is_inj, symmetric], rule pick_prems)+ - apply (unfold suitable_defs Int_Un_distrib Un_empty T1.FVars_ctors) + apply (unfold suitable_defs Int_Un_distrib Un_empty FVars_raw_ctors) apply (erule allE impE[OF _ x] conjE)+ apply (rule conjI)+ apply assumption+ (* assumption ORELSE ... *) @@ -2262,6 +2290,12 @@ proof - apply assumption apply (rule iffD2[OF image_is_empty]) apply (rule Diff_disjoint) + (* repeated *) + apply assumption + apply (rule trans[OF image_Int[OF bij_is_inj, symmetric]]) + apply assumption + apply (rule iffD2[OF image_is_empty]) + apply (rule Diff_disjoint) done subgoal @@ -2269,10 +2303,10 @@ proof - apply (subst T2_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ apply (unfold id_o o_id comp_def[of fst] fst_conv) - apply (unfold T1.FVars_ctors) + apply (unfold FVars_raw_ctors) apply (subst T2_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[unfolded comp_def]) - apply (subst T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[symmetric] image_UN[symmetric]) apply (subst image_set_diff[OF bij_is_inj, symmetric], rule f_prems)+ apply (unfold image_Un[symmetric]) @@ -2306,7 +2340,7 @@ proof - apply (unfold image_is_empty) apply (insert suitable_prems) apply (subst image_set_diff[OF bij_is_inj, symmetric], rule pick_prems)+ - apply (unfold suitable_defs Int_Un_distrib Un_empty T1.FVars_ctors) + apply (unfold suitable_defs Int_Un_distrib Un_empty FVars_raw_ctors) apply (erule allE impE[OF _ x] conjE)+ apply (rule conjI)+ apply assumption+ @@ -2326,19 +2360,19 @@ lemma int_empties4: and f_prems: "bij f1" "|supp f1| avoiding_set1 = {}" "imsupp f2 \ avoiding_set2 = {}" shows "set5_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T21 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T21 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {}" "set6_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T22 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T22 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {}" proof - note pick_prems = mk_pick_prems[OF suitable_prems valid] show "set5_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T21 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T21 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {}" "set6_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x) \ - (FVars_T22 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x))) + (FVars_raw_T22 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {}" apply (unfold XXr2_def) @@ -2347,22 +2381,24 @@ proof - apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ apply (subst T2_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ - apply (unfold id_o o_id comp_def[of fst] fst_conv T1.FVars_ctors) + apply (unfold id_o o_id comp_def[of fst] fst_conv FVars_raw_ctors) apply (subst T2_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[unfolded comp_def]) - apply (subst T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) apply (subst image_set_diff[OF bij_is_inj, symmetric], (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[symmetric]) - apply (subst id_on_image[OF conjunct1[OF pick_id_on_images(3)[unfolded image_Un id_on_Un]]] id_on_image[OF conjunct2[OF pick_id_on_images(3)[unfolded image_Un id_on_Un]]] + apply (subst id_on_image[OF conjunct1[OF conjunct1[OF pick_id_on_images(3)[unfolded image_Un id_on_Un]]]] + id_on_image[OF conjunct2[OF conjunct1[OF pick_id_on_images(3)[unfolded image_Un id_on_Un]]]] + id_on_image[OF conjunct2[OF pick_id_on_images(3)[unfolded image_Un id_on_Un]]] id_on_image[OF pick_id_on_images(4)] id_on_image[OF pick_id_on_images(4)] , (rule f_prems suitable_prems valid)+)+ - apply (unfold image_Un[symmetric] T1.FVars_ctors[symmetric]) + apply (unfold image_Un[symmetric] FVars_raw_ctors[symmetric]) apply (subst T2_pre.set_map[symmetric]) - prefer 8 - apply (subst T1.FVars_renames[symmetric]) + prefer 9 + apply (subst FVars_raw_permutes[symmetric]) prefer 5 - apply (subst T1.rename_simps) + apply (subst permute_raw_simps) prefer 5 apply (insert suitable_prems)[1] apply (unfold suitable_defs) @@ -2377,22 +2413,24 @@ proof - apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ apply (subst T2_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ - apply (unfold id_o o_id comp_def[of fst] fst_conv T1.FVars_ctors) + apply (unfold id_o o_id comp_def[of fst] fst_conv FVars_raw_ctors) apply (subst T2_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[unfolded comp_def]) - apply (subst T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) apply (subst image_set_diff[OF bij_is_inj, symmetric], (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_comp[symmetric]) - apply (subst id_on_image[OF conjunct1[OF pick_id_on_images(3)[unfolded image_Un id_on_Un]]] id_on_image[OF conjunct2[OF pick_id_on_images(3)[unfolded image_Un id_on_Un]]] + apply (subst id_on_image[OF conjunct1[OF conjunct1[OF pick_id_on_images(3)[unfolded image_Un id_on_Un]]]] + id_on_image[OF conjunct2[OF conjunct1[OF pick_id_on_images(3)[unfolded image_Un id_on_Un]]]] + id_on_image[OF conjunct2[OF pick_id_on_images(3)[unfolded image_Un id_on_Un]]] id_on_image[OF pick_id_on_images(4)] id_on_image[OF pick_id_on_images(4)] , (rule f_prems suitable_prems valid)+)+ - apply (unfold image_Un[symmetric] T1.FVars_ctors[symmetric]) + apply (unfold image_Un[symmetric] FVars_raw_ctors[symmetric]) apply (subst T2_pre.set_map[symmetric]) - prefer 8 - apply (subst T1.FVars_renames[symmetric]) + prefer 9 + apply (subst FVars_raw_permutes[symmetric]) prefer 5 - apply (subst T1.rename_simps) + apply (subst permute_raw_simps) prefer 5 apply (insert suitable_prems)[1] apply (unfold suitable_defs) @@ -2408,14 +2446,14 @@ lemma U1FVars'_alpha: "alpha_T1 t1 t1' \ U1FVars_2' t1 = U1FVars_2' t1'" apply (unfold U1FVars_1'_def U1FVars_2'_def) apply (rule arg_cong[of _ _ U1FVars_1] arg_cong[of _ _ U1FVars_2], - erule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2])+ + erule TT_total_abs_eq_iffs[THEN iffD2])+ done lemma U2FVars'_alpha: "alpha_T2 t2 t2' \ U2FVars_1' t2 = U2FVars_1' t2'" "alpha_T2 t2 t2' \ U2FVars_2' t2 = U2FVars_2' t2'" apply (unfold U2FVars_1'_def U2FVars_2'_def) apply (rule arg_cong[of _ _ U2FVars_1] arg_cong[of _ _ U2FVars_2], - erule T1.TT_Quotient_total_abs_eq_iffs[THEN iffD2])+ + erule TT_total_abs_eq_iffs[THEN iffD2])+ done lemma conj_spec: "(\x. P x) \ (\x. Q x) \ P x1 \ Q x2" @@ -2436,7 +2474,7 @@ lemma valid_f: "pred_fun validP validU2 (f_T2 pick1 pick2 pick3 pick4 t2)" proof - have x: "pred_fun validP validU1 (f_T1 pick1 pick2 pick3 pick4 t1) \ pred_fun validP validU2 (f_T2 pick1 pick2 pick3 pick4 t2)" - apply (rule T1.TT_subshape_induct[of _ _ t1 t2]) + apply (rule subshape_induct[of _ _ t1 t2]) subgoal for y apply (rule pred_funI) apply (rule raw_T1.exhaust[of y]) @@ -2455,7 +2493,7 @@ proof - apply (rule T1_pre.pred_mono_strong0) apply (rule iffD2[OF fun_cong[OF T1_pre.pred_True] TrueI]) apply (rule ballI impI TrueI iffD2[OF comp_apply] pred_fun_If prems mk_pick_prems[OF suitable_prems] supp_id_bound bij_id - | erule T1.set_subshapes T1.set_subshape_images[rotated -1, OF imageI] + | erule set_subshapess set_subshape_permutess[rotated -1] )+ done apply assumption @@ -2478,7 +2516,7 @@ proof - apply (rule T2_pre.pred_mono_strong0) apply (rule iffD2[OF fun_cong[OF T2_pre.pred_True] TrueI]) apply (rule ballI impI TrueI iffD2[OF comp_apply] pred_fun_If prems mk_pick_prems[OF suitable_prems] supp_id_bound bij_id - | erule T1.set_subshapes T1.set_subshape_images[rotated -1, OF imageI] + | erule set_subshapess set_subshape_permutess[rotated -1] )+ done apply assumption @@ -2501,21 +2539,21 @@ lemma f_UFVars': assumes "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" shows - "U1FVars_1' t1 (f_T1 pick1 pick2 pick3 pick4 t1 p) \ FVars_T11 t1 \ PFVars_1 p \ avoiding_set1" - "U1FVars_2' t1 (f_T1 pick1 pick2 pick3 pick4 t1 p) \ FVars_T12 t1 \ PFVars_2 p \ avoiding_set2" - "U2FVars_1' t2 (f_T2 pick1 pick2 pick3 pick4 t2 p) \ FVars_T21 t2 \ PFVars_1 p \ avoiding_set1" - "U2FVars_2' t2 (f_T2 pick1 pick2 pick3 pick4 t2 p) \ FVars_T22 t2 \ PFVars_2 p \ avoiding_set2" + "U1FVars_1' t1 (f_T1 pick1 pick2 pick3 pick4 t1 p) \ FVars_raw_T11 t1 \ PFVars_1 p \ avoiding_set1" + "U1FVars_2' t1 (f_T1 pick1 pick2 pick3 pick4 t1 p) \ FVars_raw_T12 t1 \ PFVars_2 p \ avoiding_set2" + "U2FVars_1' t2 (f_T2 pick1 pick2 pick3 pick4 t2 p) \ FVars_raw_T21 t2 \ PFVars_1 p \ avoiding_set1" + "U2FVars_2' t2 (f_T2 pick1 pick2 pick3 pick4 t2 p) \ FVars_raw_T22 t2 \ PFVars_2 p \ avoiding_set2" proof - note pick_prems = mk_pick_prems[OF suitable_prems] - have "(U1FVars_1' t1 (f_T1 pick1 pick2 pick3 pick4 t1 p) \ FVars_T11 t1 \ PFVars_1 p \ avoiding_set1 - \ U1FVars_2' t1 (f_T1 pick1 pick2 pick3 pick4 t1 p) \ FVars_T12 t1 \ PFVars_2 p \ avoiding_set2) - \ (U2FVars_1' t2 (f_T2 pick1 pick2 pick3 pick4 t2 p) \ FVars_T21 t2 \ PFVars_1 p \ avoiding_set1 - \ U2FVars_2' t2 (f_T2 pick1 pick2 pick3 pick4 t2 p) \ FVars_T22 t2 \ PFVars_2 p \ avoiding_set2)" - apply (rule conj_mp[OF conj_spec[OF T1.TT_subshape_induct[of - "\t. \p. validP p \ (U1FVars_1' t (f_T1 pick1 pick2 pick3 pick4 t p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1 - \ U1FVars_2' t (f_T1 pick1 pick2 pick3 pick4 t p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2)" - "\t. \p. validP p \ (U2FVars_1' t (f_T2 pick1 pick2 pick3 pick4 t p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1 - \ U2FVars_2' t (f_T2 pick1 pick2 pick3 pick4 t p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2)" + have "(U1FVars_1' t1 (f_T1 pick1 pick2 pick3 pick4 t1 p) \ FVars_raw_T11 t1 \ PFVars_1 p \ avoiding_set1 + \ U1FVars_2' t1 (f_T1 pick1 pick2 pick3 pick4 t1 p) \ FVars_raw_T12 t1 \ PFVars_2 p \ avoiding_set2) + \ (U2FVars_1' t2 (f_T2 pick1 pick2 pick3 pick4 t2 p) \ FVars_raw_T21 t2 \ PFVars_1 p \ avoiding_set1 + \ U2FVars_2' t2 (f_T2 pick1 pick2 pick3 pick4 t2 p) \ FVars_raw_T22 t2 \ PFVars_2 p \ avoiding_set2)" + apply (rule conj_mp[OF conj_spec[OF subshape_induct[of + "\t. \p. validP p \ (U1FVars_1' t (f_T1 pick1 pick2 pick3 pick4 t p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1 + \ U1FVars_2' t (f_T1 pick1 pick2 pick3 pick4 t p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2)" + "\t. \p. validP p \ (U2FVars_1' t (f_T2 pick1 pick2 pick3 pick4 t p) \ FVars_raw_T21 t \ PFVars_1 p \ avoiding_set1 + \ U2FVars_2' t (f_T2 pick1 pick2 pick3 pick4 t p) \ FVars_raw_T22 t \ PFVars_2 p \ avoiding_set2)" ]], rotated -2]) apply (rule assms)+ apply (rule allI impI)+ @@ -2525,7 +2563,7 @@ proof - subgoal premises prems apply (rule conjI) subgoal - apply (subst T1.alpha_FVarss) + apply (subst alpha_FVars) apply (rule alpha_ctor_picks[OF suitable_prems]) apply (rule prems) apply (subst U1FVars'_alpha U2FVars'_alpha) @@ -2557,7 +2595,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct1]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply assumption (* copied from above *) apply (erule imageE) @@ -2567,7 +2605,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct1]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply (rule pick_prems bij_id supp_id_bound prems)+ apply assumption (* end REPEAT_DETERM *) @@ -2581,7 +2619,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct1]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply assumption (* copied from above *) apply (erule imageE) @@ -2591,13 +2629,13 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct1]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply (rule pick_prems bij_id supp_id_bound prems)+ apply assumption (* end REPEAT_DETERM *) done subgoal (* copied from above, incremented suitable_prems index, and used conjunct2 with prems *) - apply (subst T1.alpha_FVarss) + apply (subst alpha_FVars) apply (rule alpha_ctor_picks[OF suitable_prems]) apply (rule prems) apply (subst U1FVars'_alpha U2FVars'_alpha) @@ -2630,7 +2668,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply assumption (* copied from above *) apply (erule imageE) @@ -2640,7 +2678,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply (rule pick_prems bij_id supp_id_bound prems)+ apply assumption (* end REPEAT_DETERM *) @@ -2654,7 +2692,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply assumption (* copied from above *) apply (erule imageE) @@ -2664,7 +2702,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply (rule pick_prems bij_id supp_id_bound prems)+ apply assumption (* end REPEAT_DETERM *) @@ -2679,7 +2717,7 @@ proof - subgoal premises prems for x apply (rule conjI) subgoal - apply (subst T1.alpha_FVarss) + apply (subst alpha_FVars) apply (rule alpha_ctor_picks[OF suitable_prems]) apply (rule prems) apply (subst U1FVars'_alpha U2FVars'_alpha) @@ -2712,7 +2750,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct1]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply assumption (* copied from above *) apply (erule imageE) @@ -2722,7 +2760,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct1]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply (rule pick_prems bij_id supp_id_bound prems)+ apply assumption (* end REPEAT_DETERM *) @@ -2736,7 +2774,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct1]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply assumption (* copied from above *) apply (erule imageE) @@ -2746,13 +2784,13 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct1]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply (rule pick_prems bij_id supp_id_bound prems)+ apply assumption (* end REPEAT_DETERM *) done subgoal (* copied from above, incremented suitable_prems index, and used conjunct2 with prems *) - apply (subst T1.alpha_FVarss) + apply (subst alpha_FVars) apply (rule alpha_ctor_picks[OF suitable_prems]) apply (rule prems) apply (subst U1FVars'_alpha U2FVars'_alpha) @@ -2785,7 +2823,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply assumption (* copied from above *) apply (erule imageE) @@ -2795,7 +2833,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply (rule pick_prems bij_id supp_id_bound prems)+ apply assumption (* end REPEAT_DETERM *) @@ -2809,7 +2847,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply assumption (* copied from above *) apply (erule imageE) @@ -2819,7 +2857,7 @@ proof - apply (subst if_P) apply assumption apply (rule prems(1,2)[THEN spec, THEN mp, THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply (rule pick_prems bij_id supp_id_bound prems)+ apply assumption (* end REPEAT_DETERM *) @@ -2828,10 +2866,10 @@ proof - done done then show - "U1FVars_1' t1 (f_T1 pick1 pick2 pick3 pick4 t1 p) \ FVars_T11 t1 \ PFVars_1 p \ avoiding_set1" - "U1FVars_2' t1 (f_T1 pick1 pick2 pick3 pick4 t1 p) \ FVars_T12 t1 \ PFVars_2 p \ avoiding_set2" - "U2FVars_1' t2 (f_T2 pick1 pick2 pick3 pick4 t2 p) \ FVars_T21 t2 \ PFVars_1 p \ avoiding_set1" - "U2FVars_2' t2 (f_T2 pick1 pick2 pick3 pick4 t2 p) \ FVars_T22 t2 \ PFVars_2 p \ avoiding_set2" + "U1FVars_1' t1 (f_T1 pick1 pick2 pick3 pick4 t1 p) \ FVars_raw_T11 t1 \ PFVars_1 p \ avoiding_set1" + "U1FVars_2' t1 (f_T1 pick1 pick2 pick3 pick4 t1 p) \ FVars_raw_T12 t1 \ PFVars_2 p \ avoiding_set2" + "U2FVars_1' t2 (f_T2 pick1 pick2 pick3 pick4 t2 p) \ FVars_raw_T21 t2 \ PFVars_1 p \ avoiding_set1" + "U2FVars_2' t2 (f_T2 pick1 pick2 pick3 pick4 t2 p) \ FVars_raw_T22 t2 \ PFVars_2 p \ avoiding_set2" apply - apply ((erule conjE)+, assumption)+ done @@ -2842,11 +2880,11 @@ lemma XXl_U1FVars': assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| y p. validP p \ subshape_T1_T1 y (raw_T1_ctor x) \ f_T1 pick1 pick2 pick3 pick4 (rename_T1 f1 f2 y) p = PU1map' f1 f2 y (f_T1 pick1 pick2 pick3 pick4 y) p" - shows "(t, pu) \ set7_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set8_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U1FVars_1' t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1" - "(t, pu) \ set7_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set8_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U1FVars_2' t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2" + and IH: "\y p. validP p \ subshape_T1_T1 y (raw_T1_ctor x) \ f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 f1 f2 y) p = PU1map' f1 f2 y (f_T1 pick1 pick2 pick3 pick4 y) p" + shows "(t, pu) \ set8_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set9_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U1FVars_1' t (pu p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1" + "(t, pu) \ set8_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set9_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U1FVars_2' t (pu p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2" proof - have x: "validP (Pmap (inv f1) (inv f2) p')" apply (rule valid_Pmap valid bij_imp_bij_inv supp_inv_bound f_prems)+ @@ -2854,10 +2892,10 @@ proof - note pick_prems = mk_pick_prems[OF suitable_prems] - show "(t, pu) \ set7_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set8_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U1FVars_1' t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1" - "(t, pu) \ set7_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set8_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U1FVars_2' t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2" + show "(t, pu) \ set8_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set9_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U1FVars_1' t (pu p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1" + "(t, pu) \ set8_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set9_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U1FVars_2' t (pu p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2" apply (unfold XXl1_def) apply (subst (asm) T1_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems x)+)+ apply (erule UnE) @@ -2868,9 +2906,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id | (insert suitable_prems)[1], erule suitable_bij suitable_supp_bound)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -2883,9 +2921,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems x)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id pick_prems x)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -2902,9 +2940,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems x)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id | (insert suitable_prems)[1], erule suitable_bij suitable_supp_bound)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -2917,9 +2955,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems x)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id pick_prems x)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -2933,11 +2971,11 @@ lemma XXl_U1FVars'_2: assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| y p. validP p \ subshape_T1_T2 y (raw_T2_ctor x) \ f_T1 pick1 pick2 pick3 pick4 (rename_T1 f1 f2 y) p = PU1map' f1 f2 y (f_T1 pick1 pick2 pick3 pick4 y) p" - shows "(t, pu) \ set7_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set8_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U1FVars_1' t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1" - "(t, pu) \ set7_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set8_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U1FVars_2' t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2" + and IH: "\y p. validP p \ subshape_T1_T2 y (raw_T2_ctor x) \ f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 f1 f2 y) p = PU1map' f1 f2 y (f_T1 pick1 pick2 pick3 pick4 y) p" + shows "(t, pu) \ set8_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set9_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U1FVars_1' t (pu p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1" + "(t, pu) \ set8_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set9_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U1FVars_2' t (pu p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2" proof - have x: "validP (Pmap (inv f1) (inv f2) p')" apply (rule valid_Pmap valid bij_imp_bij_inv supp_inv_bound f_prems)+ @@ -2945,10 +2983,10 @@ proof - note pick_prems = mk_pick_prems[OF suitable_prems] - show "(t, pu) \ set7_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set8_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U1FVars_1' t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1" - "(t, pu) \ set7_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set8_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U1FVars_2' t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2" + show "(t, pu) \ set8_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set9_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U1FVars_1' t (pu p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1" + "(t, pu) \ set8_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set9_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U1FVars_2' t (pu p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2" apply (unfold XXl2_def) apply (subst (asm) T2_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems x)+)+ apply (erule UnE) @@ -2959,9 +2997,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id | (insert suitable_prems)[1], erule suitable_bij suitable_supp_bound)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -2974,9 +3012,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems x)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id pick_prems x)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -2993,9 +3031,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems x)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id | (insert suitable_prems)[1], erule suitable_bij suitable_supp_bound)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -3008,9 +3046,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems x)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id pick_prems x)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -3024,11 +3062,11 @@ lemma XXl_U2FVars': assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| y p. validP p \ subshape_T2_T1 y (raw_T1_ctor x) \ f_T2 pick1 pick2 pick3 pick4 (rename_T2 f1 f2 y) p = PU2map' f1 f2 y (f_T2 pick1 pick2 pick3 pick4 y) p" - shows "(t2, pu2) \ set9_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set10_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U2FVars_1' t2 (pu2 p) \ FVars_T21 t2 \ PFVars_1 p \ avoiding_set1" - "(t2, pu2) \ set9_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set10_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U2FVars_2' t2 (pu2 p) \ FVars_T22 t2 \ PFVars_2 p \ avoiding_set2" + and IH: "\y p. validP p \ subshape_T2_T1 y (raw_T1_ctor x) \ f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 f1 f2 y) p = PU2map' f1 f2 y (f_T2 pick1 pick2 pick3 pick4 y) p" + shows "(t2, pu2) \ set10_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set11_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U2FVars_1' t2 (pu2 p) \ FVars_raw_T21 t2 \ PFVars_1 p \ avoiding_set1" + "(t2, pu2) \ set10_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set11_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U2FVars_2' t2 (pu2 p) \ FVars_raw_T22 t2 \ PFVars_2 p \ avoiding_set2" proof - have x: "validP (Pmap (inv f1) (inv f2) p')" apply (rule valid_Pmap valid bij_imp_bij_inv supp_inv_bound f_prems)+ @@ -3036,10 +3074,10 @@ proof - note pick_prems = mk_pick_prems[OF suitable_prems] - show "(t2, pu2) \ set9_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set10_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U2FVars_1' t2 (pu2 p) \ FVars_T21 t2 \ PFVars_1 p \ avoiding_set1" - "(t2, pu2) \ set9_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set10_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U2FVars_2' t2 (pu2 p) \ FVars_T22 t2 \ PFVars_2 p \ avoiding_set2" + show "(t2, pu2) \ set10_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set11_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U2FVars_1' t2 (pu2 p) \ FVars_raw_T21 t2 \ PFVars_1 p \ avoiding_set1" + "(t2, pu2) \ set10_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set11_T1_pre (XXl1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U2FVars_2' t2 (pu2 p) \ FVars_raw_T22 t2 \ PFVars_2 p \ avoiding_set2" apply (unfold XXl1_def) apply (subst (asm) T1_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems x)+)+ apply (erule UnE) @@ -3050,9 +3088,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id | (insert suitable_prems)[1], erule suitable_bij suitable_supp_bound)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -3065,9 +3103,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems x)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id pick_prems x)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -3084,9 +3122,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems x)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id | (insert suitable_prems)[1], erule suitable_bij suitable_supp_bound)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -3099,9 +3137,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems x)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id pick_prems x)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -3115,11 +3153,11 @@ lemma XXl_U2FVars'_2: assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| y p. validP p \ subshape_T2_T2 y (raw_T2_ctor x) \ f_T2 pick1 pick2 pick3 pick4 (rename_T2 f1 f2 y) p = PU2map' f1 f2 y (f_T2 pick1 pick2 pick3 pick4 y) p" - shows "(t2, pu2) \ set9_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set10_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U2FVars_1' t2 (pu2 p) \ FVars_T21 t2 \ PFVars_1 p \ avoiding_set1" - "(t2, pu2) \ set9_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set10_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U2FVars_2' t2 (pu2 p) \ FVars_T22 t2 \ PFVars_2 p \ avoiding_set2" + and IH: "\y p. validP p \ subshape_T2_T2 y (raw_T2_ctor x) \ f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 f1 f2 y) p = PU2map' f1 f2 y (f_T2 pick1 pick2 pick3 pick4 y) p" + shows "(t2, pu2) \ set10_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set11_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U2FVars_1' t2 (pu2 p) \ FVars_raw_T21 t2 \ PFVars_1 p \ avoiding_set1" + "(t2, pu2) \ set10_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set11_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U2FVars_2' t2 (pu2 p) \ FVars_raw_T22 t2 \ PFVars_2 p \ avoiding_set2" (* same tactic as above *) proof - have x: "validP (Pmap (inv f1) (inv f2) p')" @@ -3128,10 +3166,10 @@ proof - note pick_prems = mk_pick_prems[OF suitable_prems] - show "(t2, pu2) \ set9_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set10_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U2FVars_1' t2 (pu2 p) \ FVars_T21 t2 \ PFVars_1 p \ avoiding_set1" - "(t2, pu2) \ set9_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set10_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U2FVars_2' t2 (pu2 p) \ FVars_T22 t2 \ PFVars_2 p \ avoiding_set2" + show "(t2, pu2) \ set10_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set11_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U2FVars_1' t2 (pu2 p) \ FVars_raw_T21 t2 \ PFVars_1 p \ avoiding_set1" + "(t2, pu2) \ set10_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set11_T2_pre (XXl2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U2FVars_2' t2 (pu2 p) \ FVars_raw_T22 t2 \ PFVars_2 p \ avoiding_set2" apply (unfold XXl2_def) apply (subst (asm) T2_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems x)+)+ apply (erule UnE) @@ -3142,9 +3180,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id | (insert suitable_prems)[1], erule suitable_bij suitable_supp_bound)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -3157,9 +3195,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems x)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id pick_prems x)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -3176,9 +3214,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems x)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id | (insert suitable_prems)[1], erule suitable_bij suitable_supp_bound)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -3191,9 +3229,9 @@ proof - apply hypsubst_thin apply (subst IH[symmetric]) apply (rule valid) - apply (erule T1.set_subshape_images[rotated -1, OF imageI] T1.set_subshapes) + apply (erule set_subshape_permutess[rotated -1] set_subshapess) apply ((rule supp_id_bound bij_id pick_prems x)+)? - apply (subst T1.rename_comps)? + apply (subst permute_raw_comps)? apply ((rule f_prems supp_id_bound bij_id pick_prems x)+)? apply (unfold id_o o_id)? apply (subst if_P) @@ -3207,10 +3245,10 @@ lemma XXr_U1FVars': assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| set7_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set8_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U1FVars_1' t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1" - "(t, pu) \ set7_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set8_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U1FVars_2' t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2" + shows "(t, pu) \ set8_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set9_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U1FVars_1' t (pu p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1" + "(t, pu) \ set8_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set9_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U1FVars_2' t (pu p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2" supply pick_prems = mk_pick_prems[OF suitable_prems valid(2)] apply (unfold XXr1_def) apply (subst (asm) T1_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ @@ -3258,10 +3296,10 @@ lemma XXr_U1FVars'_2: assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| set7_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set8_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U1FVars_1' t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1" - "(t, pu) \ set7_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set8_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U1FVars_2' t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2" + shows "(t, pu) \ set8_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set9_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U1FVars_1' t (pu p) \ FVars_raw_T11 t \ PFVars_1 p \ avoiding_set1" + "(t, pu) \ set8_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set9_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U1FVars_2' t (pu p) \ FVars_raw_T12 t \ PFVars_2 p \ avoiding_set2" supply pick_prems = mk_pick_prems[OF suitable_prems valid(2)] apply (unfold XXr2_def) apply (subst (asm) T2_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ @@ -3309,10 +3347,10 @@ lemma XXr_U2FVars': assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| set9_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set10_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U2FVars_1' t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1" - "(t, pu) \ set9_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set10_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U2FVars_2' t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2" + shows "(t, pu) \ set10_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set11_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U2FVars_1' t (pu p) \ FVars_raw_T21 t \ PFVars_1 p \ avoiding_set1" + "(t, pu) \ set10_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set11_T1_pre (XXr1 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U2FVars_2' t (pu p) \ FVars_raw_T22 t \ PFVars_2 p \ avoiding_set2" (* same tactic as above *) supply pick_prems = mk_pick_prems[OF suitable_prems valid(2)] apply (unfold XXr1_def) @@ -3361,10 +3399,10 @@ lemma XXr_U2FVars'_2: assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| set9_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set10_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U2FVars_1' t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1" - "(t, pu) \ set9_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set10_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ - U2FVars_2' t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2" + shows "(t, pu) \ set10_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set11_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U2FVars_1' t (pu p) \ FVars_raw_T21 t \ PFVars_1 p \ avoiding_set1" + "(t, pu) \ set10_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ set11_T2_pre (XXr2 pick1 pick2 pick3 pick4 f1 f2 p' x) \ + U2FVars_2' t (pu p) \ FVars_raw_T22 t \ PFVars_2 p \ avoiding_set2" (* same tactic as above *) supply pick_prems = mk_pick_prems[OF suitable_prems valid(2)] apply (unfold XXr2_def) @@ -3414,10 +3452,10 @@ lemma imsupp_id_on_XXl1: and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| - (FVars_T11 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ + (FVars_raw_T11 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {} \ - id_on (f1 ` set1_T1_pre x) w \ id_on (f1 ` \(FVars_T11 ` set7_T1_pre x)) w \ id_on (f1 ` (\(FVars_T11 ` set8_T1_pre x) - set5_T1_pre x)) w - \ id_on (f1 ` \(FVars_T21 ` set9_T1_pre x)) w \ id_on (f1 ` (\(FVars_T21 ` set10_T1_pre x) - set5_T1_pre x)) w" + id_on (f1 ` set1_T1_pre x) w \ id_on (f1 ` (set7_T1_pre x - set5_T1_pre x)) w \ id_on (f1 ` \(FVars_raw_T11 ` set8_T1_pre x)) w \ id_on (f1 ` (\(FVars_raw_T11 ` set9_T1_pre x) - set5_T1_pre x)) w + \ id_on (f1 ` \(FVars_raw_T21 ` set10_T1_pre x)) w \ id_on (f1 ` (\(FVars_raw_T21 ` set11_T1_pre x) - set5_T1_pre x)) w" proof - have x: "validP (Pmap (inv f1) (inv f2) p)" apply (rule valid_Pmap valid bij_imp_bij_inv supp_inv_bound f_prems)+ @@ -3425,26 +3463,37 @@ proof - note pick_prems = mk_pick_prems[OF suitable_prems x] show "imsupp w \ - (FVars_T11 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ + (FVars_raw_T11 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {} \ - id_on (f1 ` set1_T1_pre x) w \ id_on (f1 ` \(FVars_T11 ` set7_T1_pre x)) w \ id_on (f1 ` (\(FVars_T11 ` set8_T1_pre x) - set5_T1_pre x)) w - \ id_on (f1 ` \(FVars_T21 ` set9_T1_pre x)) w \ id_on (f1 ` (\(FVars_T21 ` set10_T1_pre x) - set5_T1_pre x)) w" + id_on (f1 ` set1_T1_pre x) w \ id_on (f1 ` (set7_T1_pre x - set5_T1_pre x)) w \ id_on (f1 ` \(FVars_raw_T11 ` set8_T1_pre x)) w \ id_on (f1 ` (\(FVars_raw_T11 ` set9_T1_pre x) - set5_T1_pre x)) w + \ id_on (f1 ` \(FVars_raw_T21 ` set10_T1_pre x)) w \ id_on (f1 ` (\(FVars_raw_T21 ` set11_T1_pre x) - set5_T1_pre x)) w" apply (unfold XXl1_def XXl2_def) apply (subst (asm) T1_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ - apply (unfold id_o o_id comp_def[of fst] fst_conv T1.FVars_ctors) + apply (unfold id_o o_id comp_def[of fst] fst_conv FVars_raw_ctors) apply (subst (asm) T1_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold Int_Un_distrib Un_empty image_comp[unfolded comp_def]) - apply (subst (asm) T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst (asm) FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) apply (subst (asm) image_set_diff[OF bij_is_inj, symmetric], (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (erule conjE)+ apply (unfold image_comp[symmetric] - id_on_image[OF conjunct1[OF pick_id_ons(1)[OF suitable_prems(1) x, unfolded id_on_Un]]] - id_on_image[OF conjunct2[OF pick_id_ons(1)[OF suitable_prems(1) x, unfolded id_on_Un]]] - id_on_image[OF conjunct1[OF pick_id_on_images(1)[OF f_prems suitable_prems(1), unfolded image_Un id_on_Un]]] - id_on_image[OF conjunct2[OF pick_id_on_images(1)[OF f_prems suitable_prems(1), unfolded image_Un id_on_Un]]] - ) + id_on_image[OF pick_id_ons'(1)[OF suitable_prems(1) x]] + id_on_image[OF pick_id_ons'(2)[OF suitable_prems(1) x]] + id_on_image[OF pick_id_ons'(3)[OF suitable_prems(1) x]] + id_on_image[OF pick_id_ons'(4)[OF suitable_prems(2) x]] + id_on_image[OF pick_id_ons'(5)[OF suitable_prems(3) x]] + id_on_image[OF pick_id_ons'(6)[OF suitable_prems(3) x]] + id_on_image[OF pick_id_ons'(7)[OF suitable_prems(3) x]] + id_on_image[OF pick_id_ons'(8)[OF suitable_prems(4) x]] + id_on_image[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) x]] + id_on_image[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) x]] + id_on_image[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) x]] + id_on_image[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) x]] + id_on_image[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) x]] + id_on_image[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) x]] + id_on_image[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) x]] + id_on_image[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) x]]) apply ((rule conjI)?, erule imsupp_id_on)+ done qed @@ -3455,10 +3504,10 @@ lemma imsupp_id_on_XXl2: and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| - (FVars_T12 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ + (FVars_raw_T12 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {} \ - id_on (f2 ` set2_T1_pre x) w \ id_on (f2 ` \(FVars_T12 ` set7_T1_pre x)) w \ id_on (f2 ` (\(FVars_T12 ` set8_T1_pre x) - set6_T1_pre x)) w - \ id_on (f2 ` \(FVars_T22 ` set9_T1_pre x)) w \ id_on (f2 ` \(FVars_T22 ` set10_T1_pre x)) w" + id_on (f2 ` set2_T1_pre x) w \ id_on (f2 ` \(FVars_raw_T12 ` set8_T1_pre x)) w \ id_on (f2 ` (\(FVars_raw_T12 ` set9_T1_pre x) - set6_T1_pre x)) w + \ id_on (f2 ` \(FVars_raw_T22 ` set10_T1_pre x)) w \ id_on (f2 ` \(FVars_raw_T22 ` set11_T1_pre x)) w" proof - have x: "validP (Pmap (inv f1) (inv f2) p)" apply (rule valid_Pmap valid bij_imp_bij_inv supp_inv_bound f_prems)+ @@ -3466,28 +3515,37 @@ proof - note pick_prems = mk_pick_prems[OF suitable_prems x] show "imsupp w \ - (FVars_T12 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ + (FVars_raw_T12 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXl1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {} \ - id_on (f2 ` set2_T1_pre x) w \ id_on (f2 ` \(FVars_T12 ` set7_T1_pre x)) w \ id_on (f2 ` (\(FVars_T12 ` set8_T1_pre x) - set6_T1_pre x)) w - \ id_on (f2 ` \(FVars_T22 ` set9_T1_pre x)) w \ id_on (f2 ` \(FVars_T22 ` set10_T1_pre x)) w" + id_on (f2 ` set2_T1_pre x) w \ id_on (f2 ` \(FVars_raw_T12 ` set8_T1_pre x)) w \ id_on (f2 ` (\(FVars_raw_T12 ` set9_T1_pre x) - set6_T1_pre x)) w + \ id_on (f2 ` \(FVars_raw_T22 ` set10_T1_pre x)) w \ id_on (f2 ` \(FVars_raw_T22 ` set11_T1_pre x)) w" apply (unfold XXl1_def XXl2_def) apply (subst (asm) T1_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ - apply (unfold id_o o_id comp_def[of fst] fst_conv T1.FVars_ctors) + apply (unfold id_o o_id comp_def[of fst] fst_conv FVars_raw_ctors) apply (subst (asm) T1_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold Int_Un_distrib Un_empty image_comp[unfolded comp_def]) - apply (subst (asm) T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst (asm) FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) apply (subst (asm) image_set_diff[OF bij_is_inj, symmetric], (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (erule conjE)+ apply (unfold image_comp[symmetric] - id_on_image[OF conjunct1[OF pick_id_ons(1)[OF suitable_prems(1) x, unfolded id_on_Un]]] - id_on_image[OF conjunct2[OF pick_id_ons(1)[OF suitable_prems(1) x, unfolded id_on_Un]]] - id_on_image[OF conjunct1[OF pick_id_on_images(1)[OF f_prems suitable_prems(1) x, unfolded image_Un id_on_Un]]] - id_on_image[OF conjunct2[OF pick_id_on_images(1)[OF f_prems suitable_prems(1) x, unfolded image_Un id_on_Un]]] - id_on_image[OF pick_id_ons(2)[OF suitable_prems(2) x]] - id_on_image[OF pick_id_on_images(2)[OF f_prems suitable_prems(2) x]] - ) + id_on_image[OF pick_id_ons'(1)[OF suitable_prems(1) x]] + id_on_image[OF pick_id_ons'(2)[OF suitable_prems(1) x]] + id_on_image[OF pick_id_ons'(3)[OF suitable_prems(1) x]] + id_on_image[OF pick_id_ons'(4)[OF suitable_prems(2) x]] + id_on_image[OF pick_id_ons'(5)[OF suitable_prems(3) x]] + id_on_image[OF pick_id_ons'(6)[OF suitable_prems(3) x]] + id_on_image[OF pick_id_ons'(7)[OF suitable_prems(3) x]] + id_on_image[OF pick_id_ons'(8)[OF suitable_prems(4) x]] + id_on_image[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) x]] + id_on_image[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) x]] + id_on_image[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) x]] + id_on_image[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) x]] + id_on_image[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) x]] + id_on_image[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) x]] + id_on_image[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) x]] + id_on_image[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) x]]) apply ((rule conjI)?, erule imsupp_id_on)+ done qed @@ -3498,10 +3556,10 @@ lemma imsupp_id_on_XXl3: and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| - (FVars_T21 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ + (FVars_raw_T21 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {} \ - id_on (f1 ` set1_T2_pre x) w \ id_on (f1 ` \(FVars_T11 ` set7_T2_pre x)) w \ id_on (f1 ` (\(FVars_T11 ` set8_T2_pre x) - set5_T2_pre x)) w - \ id_on (f1 ` \(FVars_T21 ` set9_T2_pre x)) w \ id_on (f1 ` (\(FVars_T21 ` set10_T2_pre x) - set5_T2_pre x)) w" + id_on (f1 ` set1_T2_pre x) w \ id_on (f1 ` (set7_T2_pre x - set5_T2_pre x)) w \ id_on (f1 ` \(FVars_raw_T11 ` set8_T2_pre x)) w \ id_on (f1 ` (\(FVars_raw_T11 ` set9_T2_pre x) - set5_T2_pre x)) w + \ id_on (f1 ` \(FVars_raw_T21 ` set10_T2_pre x)) w \ id_on (f1 ` (\(FVars_raw_T21 ` set11_T2_pre x) - set5_T2_pre x)) w" proof - have x: "validP (Pmap (inv f1) (inv f2) p)" apply (rule valid_Pmap valid bij_imp_bij_inv supp_inv_bound f_prems)+ @@ -3510,33 +3568,37 @@ proof - note pick_prems = mk_pick_prems[OF suitable_prems x] show "imsupp w \ - (FVars_T21 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ + (FVars_raw_T21 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {} \ - id_on (f1 ` set1_T2_pre x) w \ id_on (f1 ` \(FVars_T11 ` set7_T2_pre x)) w \ id_on (f1 ` (\(FVars_T11 ` set8_T2_pre x) - set5_T2_pre x)) w - \ id_on (f1 ` \(FVars_T21 ` set9_T2_pre x)) w \ id_on (f1 ` (\(FVars_T21 ` set10_T2_pre x) - set5_T2_pre x)) w" + id_on (f1 ` set1_T2_pre x) w \ id_on (f1 ` (set7_T2_pre x - set5_T2_pre x)) w \ id_on (f1 ` \(FVars_raw_T11 ` set8_T2_pre x)) w \ id_on (f1 ` (\(FVars_raw_T11 ` set9_T2_pre x) - set5_T2_pre x)) w + \ id_on (f1 ` \(FVars_raw_T21 ` set10_T2_pre x)) w \ id_on (f1 ` (\(FVars_raw_T21 ` set11_T2_pre x) - set5_T2_pre x)) w" apply (unfold XXl1_def XXl2_def) apply (subst (asm) T2_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ - apply (unfold id_o o_id comp_def[of fst] fst_conv T1.FVars_ctors) + apply (unfold id_o o_id comp_def[of fst] fst_conv FVars_raw_ctors) apply (subst (asm) T2_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold Int_Un_distrib Un_empty image_comp[unfolded comp_def]) - apply (subst (asm) T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst (asm) FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) apply (subst (asm) image_set_diff[OF bij_is_inj, symmetric], (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (erule conjE)+ - - apply (unfold image_comp[symmetric] id_on_image[OF pick_id_ons'(1)[OF suitable_prems(1) x]] + apply (unfold image_comp[symmetric] + id_on_image[OF pick_id_ons'(1)[OF suitable_prems(1) x]] id_on_image[OF pick_id_ons'(2)[OF suitable_prems(1) x]] - id_on_image[OF pick_id_ons'(3)[OF suitable_prems(2) x]] - id_on_image[OF pick_id_ons'(4)[OF suitable_prems(3) x]] + id_on_image[OF pick_id_ons'(3)[OF suitable_prems(1) x]] + id_on_image[OF pick_id_ons'(4)[OF suitable_prems(2) x]] id_on_image[OF pick_id_ons'(5)[OF suitable_prems(3) x]] - id_on_image[OF pick_id_ons'(6)[OF suitable_prems(4) x]] + id_on_image[OF pick_id_ons'(6)[OF suitable_prems(3) x]] + id_on_image[OF pick_id_ons'(7)[OF suitable_prems(3) x]] + id_on_image[OF pick_id_ons'(8)[OF suitable_prems(4) x]] id_on_image[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) x]] id_on_image[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) x]] - id_on_image[OF pick_id_on_images'(3)[OF f_prems suitable_prems(2) x]] - id_on_image[OF pick_id_on_images'(4)[OF f_prems suitable_prems(3) x]] + id_on_image[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) x]] + id_on_image[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) x]] id_on_image[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) x]] - id_on_image[OF pick_id_on_images'(6)[OF f_prems suitable_prems(4) x]]) + id_on_image[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) x]] + id_on_image[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) x]] + id_on_image[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) x]]) apply ((rule conjI)?, erule imsupp_id_on)+ done qed @@ -3547,10 +3609,10 @@ lemma imsupp_id_on_XXl4: and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| - (FVars_T22 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ + (FVars_raw_T22 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {} \ - id_on (f2 ` set2_T2_pre x) w \ id_on (f2 ` \(FVars_T12 ` set7_T2_pre x)) w \ id_on (f2 ` (\(FVars_T12 ` set8_T2_pre x) - set6_T2_pre x)) w - \ id_on (f2 ` \(FVars_T22 ` set9_T2_pre x)) w \ id_on (f2 ` \(FVars_T22 ` set10_T2_pre x)) w" + id_on (f2 ` set2_T2_pre x) w \ id_on (f2 ` \(FVars_raw_T12 ` set8_T2_pre x)) w \ id_on (f2 ` (\(FVars_raw_T12 ` set9_T2_pre x) - set6_T2_pre x)) w + \ id_on (f2 ` \(FVars_raw_T22 ` set10_T2_pre x)) w \ id_on (f2 ` \(FVars_raw_T22 ` set11_T2_pre x)) w" proof - have x: "validP (Pmap (inv f1) (inv f2) p)" apply (rule valid_Pmap valid bij_imp_bij_inv supp_inv_bound f_prems)+ @@ -3559,33 +3621,38 @@ proof - note pick_prems = mk_pick_prems[OF suitable_prems x] show "imsupp w \ - (FVars_T22 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ + (FVars_raw_T22 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXl2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {} \ - id_on (f2 ` set2_T2_pre x) w \ id_on (f2 ` \(FVars_T12 ` set7_T2_pre x)) w \ id_on (f2 ` (\(FVars_T12 ` set8_T2_pre x) - set6_T2_pre x)) w - \ id_on (f2 ` \(FVars_T22 ` set9_T2_pre x)) w \ id_on (f2 ` \(FVars_T22 ` set10_T2_pre x)) w" + id_on (f2 ` set2_T2_pre x) w \ id_on (f2 ` \(FVars_raw_T12 ` set8_T2_pre x)) w \ id_on (f2 ` (\(FVars_raw_T12 ` set9_T2_pre x) - set6_T2_pre x)) w + \ id_on (f2 ` \(FVars_raw_T22 ` set10_T2_pre x)) w \ id_on (f2 ` \(FVars_raw_T22 ` set11_T2_pre x)) w" apply (unfold XXl1_def XXl2_def) apply (subst (asm) T2_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ - apply (unfold id_o o_id comp_def[of fst] fst_conv T1.FVars_ctors) + apply (unfold id_o o_id comp_def[of fst] fst_conv FVars_raw_ctors) apply (subst (asm) T2_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold Int_Un_distrib Un_empty image_comp[unfolded comp_def]) - apply (subst (asm) T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst (asm) FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) apply (subst (asm) image_set_diff[OF bij_is_inj, symmetric], (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (erule conjE)+ - apply (unfold image_comp[symmetric] id_on_image[OF pick_id_ons'(1)[OF suitable_prems(1) x]] + apply (unfold image_comp[symmetric] + id_on_image[OF pick_id_ons'(1)[OF suitable_prems(1) x]] id_on_image[OF pick_id_ons'(2)[OF suitable_prems(1) x]] - id_on_image[OF pick_id_ons'(3)[OF suitable_prems(2) x]] - id_on_image[OF pick_id_ons'(4)[OF suitable_prems(3) x]] + id_on_image[OF pick_id_ons'(3)[OF suitable_prems(1) x]] + id_on_image[OF pick_id_ons'(4)[OF suitable_prems(2) x]] id_on_image[OF pick_id_ons'(5)[OF suitable_prems(3) x]] - id_on_image[OF pick_id_ons'(6)[OF suitable_prems(4) x]] + id_on_image[OF pick_id_ons'(6)[OF suitable_prems(3) x]] + id_on_image[OF pick_id_ons'(7)[OF suitable_prems(3) x]] + id_on_image[OF pick_id_ons'(8)[OF suitable_prems(4) x]] id_on_image[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) x]] id_on_image[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) x]] - id_on_image[OF pick_id_on_images'(3)[OF f_prems suitable_prems(2) x]] - id_on_image[OF pick_id_on_images'(4)[OF f_prems suitable_prems(3) x]] + id_on_image[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) x]] + id_on_image[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) x]] id_on_image[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) x]] - id_on_image[OF pick_id_on_images'(6)[OF f_prems suitable_prems(4) x]]) + id_on_image[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) x]] + id_on_image[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) x]] + id_on_image[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) x]]) apply ((rule conjI)?, erule imsupp_id_on)+ done qed @@ -3596,28 +3663,39 @@ lemma imsupp_id_on_XXr1: and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| - (FVars_T11 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ + (FVars_raw_T11 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {} \ - id_on (f1 ` set1_T1_pre x) w \ id_on (f1 ` \(FVars_T11 ` set7_T1_pre x)) w \ id_on (f1 ` (\(FVars_T11 ` set8_T1_pre x) - set5_T1_pre x)) w - \ id_on (f1 ` \(FVars_T21 ` set9_T1_pre x)) w \ id_on (f1 ` (\(FVars_T21 ` set10_T1_pre x) - set5_T1_pre x)) w" + id_on (f1 ` set1_T1_pre x) w \ id_on (f1 ` (set7_T1_pre x - set5_T1_pre x)) w \ id_on (f1 ` \(FVars_raw_T11 ` set8_T1_pre x)) w \ id_on (f1 ` (\(FVars_raw_T11 ` set9_T1_pre x) - set5_T1_pre x)) w + \ id_on (f1 ` \(FVars_raw_T21 ` set10_T1_pre x)) w \ id_on (f1 ` (\(FVars_raw_T21 ` set11_T1_pre x) - set5_T1_pre x)) w" (* same tactic as above *) supply pick_prems = mk_pick_prems[OF suitable_prems valid] apply (unfold XXr1_def XXr2_def) apply (subst (asm) T1_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ - apply (unfold id_o o_id comp_def[of fst] fst_conv T1.FVars_ctors) + apply (unfold id_o o_id comp_def[of fst] fst_conv FVars_raw_ctors) apply (subst (asm) T1_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold Int_Un_distrib Un_empty image_comp[unfolded comp_def]) - apply (subst (asm) T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst (asm) FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) apply (subst (asm) image_set_diff[OF bij_is_inj, symmetric], (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (erule conjE)+ apply (unfold image_comp[symmetric] - id_on_image[OF conjunct1[OF pick_id_ons(1)[OF suitable_prems(1) valid, unfolded id_on_Un]]] - id_on_image[OF conjunct2[OF pick_id_ons(1)[OF suitable_prems(1) valid, unfolded id_on_Un]]] - id_on_image[OF conjunct1[OF pick_id_on_images(1)[OF f_prems suitable_prems(1) valid, unfolded image_Un id_on_Un]]] - id_on_image[OF conjunct2[OF pick_id_on_images(1)[OF f_prems suitable_prems(1) valid, unfolded image_Un id_on_Un]]] - ) + id_on_image[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] + id_on_image[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] + id_on_image[OF pick_id_ons'(3)[OF suitable_prems(1) valid]] + id_on_image[OF pick_id_ons'(4)[OF suitable_prems(2) valid]] + id_on_image[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] + id_on_image[OF pick_id_ons'(6)[OF suitable_prems(3) valid]] + id_on_image[OF pick_id_ons'(7)[OF suitable_prems(3) valid]] + id_on_image[OF pick_id_ons'(8)[OF suitable_prems(4) valid]] + id_on_image[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) valid]] + id_on_image[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) valid]] + id_on_image[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) valid]] + id_on_image[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) valid]] + id_on_image[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) valid]] + id_on_image[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) valid]] + id_on_image[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) valid]] + id_on_image[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) valid]]) apply ((rule conjI)?, erule imsupp_id_on)+ done @@ -3627,30 +3705,39 @@ lemma imsupp_id_on_XXr2: and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| - (FVars_T12 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ + (FVars_raw_T12 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst (XXr1 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {} \ - id_on (f2 ` set2_T1_pre x) w \ id_on (f2 ` \(FVars_T12 ` set7_T1_pre x)) w \ id_on (f2 ` (\(FVars_T12 ` set8_T1_pre x) - set6_T1_pre x)) w - \ id_on (f2 ` \(FVars_T22 ` set9_T1_pre x)) w \ id_on (f2 ` \(FVars_T22 ` set10_T1_pre x)) w" + id_on (f2 ` set2_T1_pre x) w \ id_on (f2 ` \(FVars_raw_T12 ` set8_T1_pre x)) w \ id_on (f2 ` (\(FVars_raw_T12 ` set9_T1_pre x) - set6_T1_pre x)) w + \ id_on (f2 ` \(FVars_raw_T22 ` set10_T1_pre x)) w \ id_on (f2 ` \(FVars_raw_T22 ` set11_T1_pre x)) w" (* same tactic as above *) supply pick_prems = mk_pick_prems[OF suitable_prems valid] apply (unfold XXr1_def XXr2_def) apply (subst (asm) T1_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ - apply (unfold id_o o_id comp_def[of fst] fst_conv T1.FVars_ctors) + apply (unfold id_o o_id comp_def[of fst] fst_conv FVars_raw_ctors) apply (subst (asm) T1_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold Int_Un_distrib Un_empty image_comp[unfolded comp_def]) - apply (subst (asm) T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst (asm) FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) apply (subst (asm) image_set_diff[OF bij_is_inj, symmetric], (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (erule conjE)+ apply (unfold image_comp[symmetric] - id_on_image[OF conjunct1[OF pick_id_ons(1)[OF suitable_prems(1) valid, unfolded id_on_Un]]] - id_on_image[OF conjunct2[OF pick_id_ons(1)[OF suitable_prems(1) valid, unfolded id_on_Un]]] - id_on_image[OF conjunct1[OF pick_id_on_images(1)[OF f_prems suitable_prems(1) valid, unfolded image_Un id_on_Un]]] - id_on_image[OF conjunct2[OF pick_id_on_images(1)[OF f_prems suitable_prems(1) valid, unfolded image_Un id_on_Un]]] - id_on_image[OF pick_id_ons(2)[OF suitable_prems(2) valid]] - id_on_image[OF pick_id_on_images(2)[OF f_prems suitable_prems(2) valid]] - ) + id_on_image[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] + id_on_image[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] + id_on_image[OF pick_id_ons'(3)[OF suitable_prems(1) valid]] + id_on_image[OF pick_id_ons'(4)[OF suitable_prems(2) valid]] + id_on_image[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] + id_on_image[OF pick_id_ons'(6)[OF suitable_prems(3) valid]] + id_on_image[OF pick_id_ons'(7)[OF suitable_prems(3) valid]] + id_on_image[OF pick_id_ons'(8)[OF suitable_prems(4) valid]] + id_on_image[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) valid]] + id_on_image[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) valid]] + id_on_image[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) valid]] + id_on_image[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) valid]] + id_on_image[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) valid]] + id_on_image[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) valid]] + id_on_image[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) valid]] + id_on_image[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) valid]]) apply ((rule conjI)?, erule imsupp_id_on)+ done @@ -3660,34 +3747,39 @@ lemma imsupp_id_on_XXr3: and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| - (FVars_T21 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ + (FVars_raw_T21 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_1 p \ avoiding_set1) = {} \ - id_on (f1 ` set1_T2_pre x) w \ id_on (f1 ` \(FVars_T11 ` set7_T2_pre x)) w \ id_on (f1 ` (\(FVars_T11 ` set8_T2_pre x) - set5_T2_pre x)) w - \ id_on (f1 ` \(FVars_T21 ` set9_T2_pre x)) w \ id_on (f1 ` (\(FVars_T21 ` set10_T2_pre x) - set5_T2_pre x)) w" + id_on (f1 ` set1_T2_pre x) w \ id_on (f1 ` (set7_T2_pre x - set5_T2_pre x)) w \ id_on (f1 ` \(FVars_raw_T11 ` set8_T2_pre x)) w \ id_on (f1 ` (\(FVars_raw_T11 ` set9_T2_pre x) - set5_T2_pre x)) w + \ id_on (f1 ` \(FVars_raw_T21 ` set10_T2_pre x)) w \ id_on (f1 ` (\(FVars_raw_T21 ` set11_T2_pre x) - set5_T2_pre x)) w" (* same tactic as above *) supply pick_prems = mk_pick_prems[OF suitable_prems valid] apply (unfold XXr1_def XXr2_def) apply (subst (asm) T2_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ - apply (unfold id_o o_id comp_def[of fst] fst_conv T1.FVars_ctors) + apply (unfold id_o o_id comp_def[of fst] fst_conv FVars_raw_ctors) apply (subst (asm) T2_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold Int_Un_distrib Un_empty image_comp[unfolded comp_def]) - apply (subst (asm) T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst (asm) FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) apply (subst (asm) image_set_diff[OF bij_is_inj, symmetric], (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (erule conjE)+ - apply (unfold image_comp[symmetric] id_on_image[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] + apply (unfold image_comp[symmetric] + id_on_image[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] id_on_image[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] - id_on_image[OF pick_id_ons'(3)[OF suitable_prems(2) valid]] - id_on_image[OF pick_id_ons'(4)[OF suitable_prems(3) valid]] + id_on_image[OF pick_id_ons'(3)[OF suitable_prems(1) valid]] + id_on_image[OF pick_id_ons'(4)[OF suitable_prems(2) valid]] id_on_image[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] - id_on_image[OF pick_id_ons'(6)[OF suitable_prems(4) valid]] + id_on_image[OF pick_id_ons'(6)[OF suitable_prems(3) valid]] + id_on_image[OF pick_id_ons'(7)[OF suitable_prems(3) valid]] + id_on_image[OF pick_id_ons'(8)[OF suitable_prems(4) valid]] id_on_image[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) valid]] id_on_image[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) valid]] - id_on_image[OF pick_id_on_images'(3)[OF f_prems suitable_prems(2) valid]] - id_on_image[OF pick_id_on_images'(4)[OF f_prems suitable_prems(3) valid]] + id_on_image[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) valid]] + id_on_image[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) valid]] id_on_image[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) valid]] - id_on_image[OF pick_id_on_images'(6)[OF f_prems suitable_prems(4) valid]]) + id_on_image[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) valid]] + id_on_image[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) valid]] + id_on_image[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) valid]]) apply ((rule conjI)?, erule imsupp_id_on)+ done @@ -3697,34 +3789,39 @@ lemma imsupp_id_on_XXr4: and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| - (FVars_T22 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ + (FVars_raw_T22 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst (XXr2 pick1 pick2 pick3 pick4 f1 f2 p x))) \ PFVars_2 p \ avoiding_set2) = {} \ - id_on (f2 ` set2_T2_pre x) w \ id_on (f2 ` \(FVars_T12 ` set7_T2_pre x)) w \ id_on (f2 ` (\(FVars_T12 ` set8_T2_pre x) - set6_T2_pre x)) w - \ id_on (f2 ` \(FVars_T22 ` set9_T2_pre x)) w \ id_on (f2 ` \(FVars_T22 ` set10_T2_pre x)) w" + id_on (f2 ` set2_T2_pre x) w \ id_on (f2 ` \(FVars_raw_T12 ` set8_T2_pre x)) w \ id_on (f2 ` (\(FVars_raw_T12 ` set9_T2_pre x) - set6_T2_pre x)) w + \ id_on (f2 ` \(FVars_raw_T22 ` set10_T2_pre x)) w \ id_on (f2 ` \(FVars_raw_T22 ` set11_T2_pre x)) w" (* same tactic as above *) supply pick_prems = mk_pick_prems[OF suitable_prems valid] apply (unfold XXr1_def XXr2_def) apply (subst (asm) T2_pre.map_comp) apply (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+ - apply (unfold id_o o_id comp_def[of fst] fst_conv T1.FVars_ctors) + apply (unfold id_o o_id comp_def[of fst] fst_conv FVars_raw_ctors) apply (subst (asm) T2_pre.set_map, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold Int_Un_distrib Un_empty image_comp[unfolded comp_def]) - apply (subst (asm) T1.FVars_renames, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ + apply (subst (asm) FVars_raw_permutes, (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) apply (subst (asm) image_set_diff[OF bij_is_inj, symmetric], (rule f_prems supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick_prems)+)+ apply (erule conjE)+ - apply (unfold image_comp[symmetric] id_on_image[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] + apply (unfold image_comp[symmetric] + id_on_image[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] id_on_image[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] - id_on_image[OF pick_id_ons'(3)[OF suitable_prems(2) valid]] - id_on_image[OF pick_id_ons'(4)[OF suitable_prems(3) valid]] + id_on_image[OF pick_id_ons'(3)[OF suitable_prems(1) valid]] + id_on_image[OF pick_id_ons'(4)[OF suitable_prems(2) valid]] id_on_image[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] - id_on_image[OF pick_id_ons'(6)[OF suitable_prems(4) valid]] + id_on_image[OF pick_id_ons'(6)[OF suitable_prems(3) valid]] + id_on_image[OF pick_id_ons'(7)[OF suitable_prems(3) valid]] + id_on_image[OF pick_id_ons'(8)[OF suitable_prems(4) valid]] id_on_image[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) valid]] id_on_image[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) valid]] - id_on_image[OF pick_id_on_images'(3)[OF f_prems suitable_prems(2) valid]] - id_on_image[OF pick_id_on_images'(4)[OF f_prems suitable_prems(3) valid]] + id_on_image[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) valid]] + id_on_image[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) valid]] id_on_image[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) valid]] - id_on_image[OF pick_id_on_images'(6)[OF f_prems suitable_prems(4) valid]]) + id_on_image[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) valid]] + id_on_image[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) valid]] + id_on_image[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) valid]]) apply ((rule conjI)?, erule imsupp_id_on)+ done @@ -3904,21 +4001,21 @@ lemma f_swap_alpha: and f_prems: "bij f1" "|supp f1| avoiding_set1 = {}" "imsupp f2 \ avoiding_set2 = {}" and alpha_prems: "alpha_T1 t1 t1'" "alpha_T2 t2 t2'" - shows "(f_T1 pick1 pick2 pick3 pick4 (rename_T1 f1 f2 t1) p = PU1map' f1 f2 t1 (f_T1 pick1 pick2 pick3 pick4 t1) p \ f_T1 pick1 pick2 pick3 pick4 t1 p = f_T1 pick1' pick2' pick3' pick4' t1' p) - \ (f_T2 pick1 pick2 pick3 pick4 (rename_T2 f1 f2 t2) p = PU2map' f1 f2 t2 (f_T2 pick1 pick2 pick3 pick4 t2) p \ f_T2 pick1 pick2 pick3 pick4 t2 p = f_T2 pick1' pick2' pick3' pick4' t2' p) + shows "(f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 f1 f2 t1) p = PU1map' f1 f2 t1 (f_T1 pick1 pick2 pick3 pick4 t1) p \ f_T1 pick1 pick2 pick3 pick4 t1 p = f_T1 pick1' pick2' pick3' pick4' t1' p) + \ (f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 f1 f2 t2) p = PU2map' f1 f2 t2 (f_T2 pick1 pick2 pick3 pick4 t2) p \ f_T2 pick1 pick2 pick3 pick4 t2 p = f_T2 pick1' pick2' pick3' pick4' t2' p) " - apply (rule conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF T1.TT_subshape_induct[of " + apply (rule conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_mp[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF conj_spec[OF subshape_induct[of " \t. \p t' f1 f2 pick1 pick2 pick3 pick4 pick1' pick2' pick3' pick4'. validP p \ suitable11 pick1 \ suitable12 pick2 \ suitable21 pick3 \ suitable22 pick4 \ suitable11 pick1' \ suitable12 pick2' \ suitable21 pick3' \ suitable22 pick4' \ bij f1 \ |supp f1| bij f2 \ |supp f2| imsupp f1 \ avoiding_set1 = {} \ imsupp f2 \ avoiding_set2 = {} \ alpha_T1 t t' \ - f_T1 pick1 pick2 pick3 pick4 (rename_T1 f1 f2 t) p = PU1map' f1 f2 t (f_T1 pick1 pick2 pick3 pick4 t) p \ f_T1 pick1 pick2 pick3 pick4 t p = f_T1 pick1' pick2' pick3' pick4' t' p + f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 f1 f2 t) p = PU1map' f1 f2 t (f_T1 pick1 pick2 pick3 pick4 t) p \ f_T1 pick1 pick2 pick3 pick4 t p = f_T1 pick1' pick2' pick3' pick4' t' p " "\t. \p t' f1 f2 pick1 pick2 pick3 pick4 pick1' pick2' pick3' pick4'. validP p \ suitable11 pick1 \ suitable12 pick2 \ suitable21 pick3 \ suitable22 pick4 \ suitable11 pick1' \ suitable12 pick2' \ suitable21 pick3' \ suitable22 pick4' \ bij f1 \ |supp f1| bij f2 \ |supp f2| imsupp f1 \ avoiding_set1 = {} \ imsupp f2 \ avoiding_set2 = {} \ alpha_T2 t t' \ - f_T2 pick1 pick2 pick3 pick4 (rename_T2 f1 f2 t) p = PU2map' f1 f2 t (f_T2 pick1 pick2 pick3 pick4 t) p \ f_T2 pick1 pick2 pick3 pick4 t p = f_T2 pick1' pick2' pick3' pick4' t' p + f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 f1 f2 t) p = PU2map' f1 f2 t (f_T2 pick1 pick2 pick3 pick4 t) p \ f_T2 pick1 pick2 pick3 pick4 t p = f_T2 pick1' pick2' pick3' pick4' t' p " ]]]]]]]]]]]]]]]]]]]]]]]]]]]]]) defer defer @@ -3944,21 +4041,21 @@ lemma f_swap_alpha: mp[OF mp[OF mp[OF mp[OF mp[OF mp[OF mp[OF mp[OF mp[OF mp[OF mp[OF mp[OF mp[OF mp[OF mp[OF mp[OF spec[OF spec[OF spec[OF spec[OF spec[OF spec[OF spec[OF spec[OF spec[OF spec[OF spec[OF spec[OF prems(2)]]]]]]]]]]]]]]]]]]]]]]]]]]]] note exists_bij_betw's = exists_bij_betw_refl_def[ OF conjI[OF T1_pre.UNIV_cinfinite card_of_Card_order], - of "pick1 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ + of "pick1 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f1" "f1 \ pick1 x (Pmap (inv f1) (inv f2) p)" set5_T1_pre "XXl1 pick1 pick2 pick3 pick4 f1 f2 p" x _ _ "XXr1 pick1 pick2 pick3 pick4 f1 f2 p" ] exists_bij_betw_refl_def[ OF conjI[OF T1_pre.UNIV_cinfinite card_of_Card_order], - of "pick2 (map_T1_pre f1 f2 id id f1 f2 (rename_T1 f1 f2) (rename_T1 f1 f2) (rename_T2 f1 f2) (rename_T2 f1 f2) x) p \ + of "pick2 (map_T1_pre f1 f2 id id f1 f2 f1 (permute_raw_T1 f1 f2) (permute_raw_T1 f1 f2) (permute_raw_T2 f1 f2) (permute_raw_T2 f1 f2) x) p \ f2" "(f2 \ pick2 x (Pmap (inv f1) (inv f2) p))" set6_T1_pre "XXl1 pick1 pick2 pick3 pick4 f1 f2 p" x _ _ "XXr1 pick1 pick2 pick3 pick4 f1 f2 p" ] note exists_bij_betws = exE[OF exists_bij_betw's(1)[ - of "\x. FVars_T11 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst x)) \ PFVars_1 p \ avoiding_set1" + of "\x. FVars_raw_T11 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst x)) \ PFVars_1 p \ avoiding_set1" ]] exE[OF exists_bij_betw's(2)[ - of "\x. FVars_T12 (raw_T1_ctor (map_T1_pre id id id id id id fst fst fst fst x)) \ PFVars_2 p \ avoiding_set2" + of "\x. FVars_raw_T12 (raw_T1_ctor (map_T1_pre id id id id id id id fst fst fst fst x)) \ PFVars_2 p \ avoiding_set2" ]] have x: "validP (Pmap (inv f1) (inv f2) p)" @@ -3970,14 +4067,14 @@ lemma f_swap_alpha: show ?thesis apply (rule conjI) - apply (subst T1.rename_simps) + apply (subst permute_raw_simps) apply (rule f_prems)+ apply (rule trans) apply (rule f_T1_simp[OF suitable_prems valid]) apply (subst T1_pre.map_comp) apply (rule f_prems supp_id_bound bij_id pick_prems)+ apply (unfold id_o o_id comp_def[of "\t. (_ t, _ t)"]) - apply (subst T1.rename_comps, (rule f_prems supp_id_bound bij_id pick_prems)+)+ + apply (subst permute_raw_comps, (rule f_prems supp_id_bound bij_id pick_prems)+)+ apply (unfold id_o o_id) apply (unfold XXr1_def[symmetric]) apply (rule sym) @@ -4005,7 +4102,7 @@ lemma f_swap_alpha: apply (rule supp_id_bound bij_id f_prems pick_prems)+ apply (unfold id_o o_id) apply (unfold comp_pair prod.case) - apply (subst T1.rename_comps, (rule supp_id_bound bij_id f_prems pick_prems)+)+ + apply (subst permute_raw_comps, (rule supp_id_bound bij_id f_prems pick_prems)+)+ apply (unfold id_o o_id) apply (rule trans) apply (rule arg_cong2[OF _ refl, of _ _ U1ctor']) @@ -4054,7 +4151,7 @@ lemma f_swap_alpha: apply (rule refl) (* END REPEAT_DETERM *) apply (rule f_prems supp_id_bound bij_comp pick_prems supp_comp_bound infinite_UNIV)+ - apply (rule refl) + apply (rule refl)+ apply (unfold XXl1_def[symmetric]) (* EVERY' (map ... exists_bij_betws) *) apply (rule exists_bij_betws(1)) @@ -4066,7 +4163,7 @@ lemma f_swap_alpha: apply (rule T1_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) @@ -4083,7 +4180,7 @@ lemma f_swap_alpha: apply (rule T1_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) @@ -4105,7 +4202,7 @@ lemma f_swap_alpha: apply (rule T1_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) @@ -4122,7 +4219,7 @@ lemma f_swap_alpha: apply (rule T1_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) @@ -4149,7 +4246,7 @@ lemma f_swap_alpha: apply (rule valid) apply (erule IHs[THEN conjunct1]) apply assumption - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems T1.alpha_refls)+ + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems alpha_refls)+ (* copied from above *) apply (erule XXl_U1FVars'[OF _ _ suitable_prems f_prems, rotated -1] XXl_U2FVars'[OF _ _ suitable_prems f_prems, rotated -1] @@ -4158,7 +4255,7 @@ lemma f_swap_alpha: apply (rule valid) apply (erule IHs[THEN conjunct1]) apply assumption - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems T1.alpha_refls)+ + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems alpha_refls)+ (* copied from above *) apply (erule XXl_U1FVars'[OF _ _ suitable_prems f_prems, rotated -1] XXl_U2FVars'[OF _ _ suitable_prems f_prems, rotated -1] @@ -4167,7 +4264,7 @@ lemma f_swap_alpha: apply (rule valid) apply (erule IHs[THEN conjunct1]) apply assumption - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems T1.alpha_refls)+ + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems alpha_refls)+ (* copied from above *) apply (erule XXl_U1FVars'[OF _ _ suitable_prems f_prems, rotated -1] XXl_U2FVars'[OF _ _ suitable_prems f_prems, rotated -1] @@ -4176,7 +4273,7 @@ lemma f_swap_alpha: apply (rule valid) apply (erule IHs[THEN conjunct1]) apply assumption - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems T1.alpha_refls)+ + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems alpha_refls)+ (* END REPEAT_DETERM *) apply (erule XXr_U1FVars'[OF _ _ suitable_prems f_prems, rotated 2] XXr_U2FVars'[OF _ _ suitable_prems f_prems, rotated 2] | assumption | rule valid)+ defer @@ -4249,6 +4346,55 @@ lemma f_swap_alpha: apply (erule eq_onD) apply assumption (* orelse *) + apply (rule case_split[of "_ \ _"]) + (* 1. comp = id for bound *) + apply (unfold eq_bij_betw_refl_def)[1] + apply (erule conjE)+ + apply (rule inv_id_middle2) + apply (rule bij_comp f_prems pick_prems | assumption)+ + apply (rule sym) + apply (erule eq_onD) + apply assumption + (* 2. comp = id for free *) + apply (drule DiffI) + apply assumption + apply (rule inv_id_middle2) + apply (rule bij_comp f_prems pick_prems | erule eq_bij_betw_refl_prems | assumption)+ + apply (rule sym) + apply (unfold comp_assoc[symmetric])[1] + apply (rule trans) + apply (rule comp_apply) + apply (rule trans) + apply (rule arg_cong[of _ _ "_ \ _"]) + apply (rule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) x]] + id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) x]]) + apply assumption + apply (rotate_tac -1) + apply (rule trans[OF comp_apply]) + apply (rule trans) + apply (unfold eq_bij_betw_refl_def)[1] + apply (erule conjE)+ + apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ + apply (erule conjE)+ + apply (erule id_onD[rotated, OF imageI, of _ _ f1]) + apply assumption + apply (rule sym) + apply (rule comp_middle) + apply (unfold eq_bij_betw_refl_def)[1] + apply (erule conjE)+ + apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ + apply (erule conjE)+ + apply (erule id_onD[rotated, OF imageI]) + apply assumption + apply (erule id_onD[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) valid] imageI] + id_onD[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) valid] imageI] + id_onD[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) valid] imageI] + id_onD[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) valid] imageI] + id_onD[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) valid] imageI]) + (* orelse *) apply (rule refl)+ (* end REPEAT_DETERM *) apply (rule T1_pre.rel_refl_strong) @@ -4261,48 +4407,46 @@ lemma f_swap_alpha: apply (unfold prod.case) apply (rule context_conjI) (* alpha_bij_tac *) - apply (rule T1.alpha_bijs) + apply (rule alpha_bijs) apply (erule eq_bij_betw_refl_prems)+ (* repeat twice *) - apply (rule ballI) - apply (unfold T1.FVars_renames[OF f_prems])[1] - apply (erule imageE) - apply hypsubst + apply (unfold FVars_raw_permutes[OF f_prems])[1] apply (unfold eq_bij_betw_refl_def)[1] apply (erule conjE)+ apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ apply (erule conjE)+ + apply (rule eq_onI) apply (drule UN_I) - apply assumption + apply (rotate_tac -1) + apply assumption + apply (unfold image_UN[symmetric]) apply (rotate_tac -1) apply (rule trans) - apply (drule id_onD[rotated, OF imageI]) - apply assumption - apply assumption + apply (erule id_onD[rotated]) + apply assumption apply (rule sym) - apply (erule id_onD[rotated, OF imageI]) + apply (erule id_onD[rotated]) apply assumption (* copied from above *) - apply (rule ballI) - apply (unfold T1.FVars_renames[OF f_prems])[1] - apply (erule imageE) - apply hypsubst - apply (unfold eq_bij_betw_refl_def)[1] - apply (erule conjE)+ - apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ - apply (erule conjE)+ - apply (drule UN_I) + apply (unfold FVars_raw_permutes[OF f_prems])[1] + apply (unfold eq_bij_betw_refl_def)[1] + apply (erule conjE)+ + apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ + apply (erule conjE)+ + apply (rule eq_onI) + apply (drule UN_I) + apply (rotate_tac -1) apply assumption - apply (rotate_tac -1) - apply (rule trans) - apply (drule id_onD[rotated, OF imageI]) - apply assumption + apply (unfold image_UN[symmetric]) + apply (rotate_tac -1) + apply (rule trans) + apply (erule id_onD[rotated]) + apply assumption + apply (rule sym) + apply (erule id_onD[rotated]) apply assumption - apply (rule sym) - apply (erule id_onD[rotated, OF imageI]) - apply assumption (* end repeat twice *) - apply (rule T1.alpha_refls) + apply (rule alpha_refls) (* end alpha_bij_tac *) apply (rule allI) apply (rule impI) @@ -4314,13 +4458,13 @@ lemma f_swap_alpha: apply (rule PUmap'_cong) apply (rule refl) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_refl_prems)+ - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems T1.alpha_refls)+ + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems alpha_refls)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -4329,7 +4473,7 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule sym) apply (rule trans) apply (rule valid_PUmap'_If) @@ -4337,7 +4481,7 @@ lemma f_swap_alpha: apply (erule eq_bij_betw_refl_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -4346,15 +4490,15 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule IHs[THEN conjunct2]) - apply (subst T1.rename_comps) + apply (subst permute_raw_comps) apply (rule f_prems)+ apply (erule eq_bij_betw_refl_prems)+ - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_comp supp_comp_bound infinite_UNIV f_prems | erule eq_bij_betw_refl_prems | assumption)+ apply (rule bij_id supp_id_bound suitable_prems trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left])+ - apply (rule T1.alpha_syms) + apply (rule alpha_syms) apply assumption (* orelse recursive binding set *) @@ -4362,13 +4506,13 @@ lemma f_swap_alpha: apply (unfold Grp_UNIV_def)[1] apply (rule refl) apply (unfold prod.case) - apply (subst T1.rename_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ + apply (subst permute_raw_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ apply (rule context_conjI) (* binding alpha_bij_tac *) - apply (rule T1.alpha_bijs) + apply (rule alpha_bijs) apply (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+ (* repeat nvars *) - apply (rule ballI) + apply (rule eq_onI) apply (rule case_split[of "_ \ _"]) apply (unfold eq_bij_betw_refl_def)[1] apply (erule conjE)+ @@ -4383,9 +4527,9 @@ lemma f_swap_alpha: apply (rule comp_apply) apply (rule trans) apply (rule arg_cong[of _ _ "_ \ _"]) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) x]] - id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) x]] - id_onD[OF pick_id_ons'(3)[OF suitable_prems(2) x]]) + apply (erule id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) x]] + id_onD[OF pick_id_ons'(3)[OF suitable_prems(1) x]] + id_onD[OF pick_id_ons'(4)[OF suitable_prems(2) x]]) apply (rotate_tac -1) apply (rule trans[OF comp_apply]) apply (rule trans) @@ -4393,7 +4537,7 @@ lemma f_swap_alpha: apply (erule conjE)+ apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ apply (erule conjE)+ - apply (erule id_onD[rotated, OF imageI, of _ _ f2]) + apply (erule id_onD[rotated, OF imageI, of _ _ f1]) apply assumption apply (rule sym) apply (rule comp_middle) @@ -4405,12 +4549,14 @@ lemma f_swap_alpha: apply assumption apply (erule id_onD[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) valid] imageI] id_onD[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) valid] imageI] - id_onD[OF pick_id_on_images'(3)[OF f_prems suitable_prems(2) valid] imageI] - id_onD[OF pick_id_on_images'(4)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) valid] imageI] + id_onD[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) valid] imageI] id_onD[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) valid] imageI] - id_onD[OF pick_id_on_images'(6)[OF f_prems suitable_prems(4) valid] imageI]) - (* copied from above, with f1 instead of f2 in id_onD *) - apply (rule ballI) + id_onD[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) valid] imageI]) + (* copied from above, with f2 instead of f1 in id_onD *) + apply (rule eq_onI) apply (rule case_split[of "_ \ _"]) apply (unfold eq_bij_betw_refl_def)[1] apply (erule conjE)+ @@ -4428,10 +4574,12 @@ lemma f_swap_alpha: apply (rule arg_cong[of _ _ "_ \ _"]) apply (erule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) x]] id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) x]] - id_onD[OF pick_id_ons'(3)[OF suitable_prems(2) x]] - id_onD[OF pick_id_ons'(4)[OF suitable_prems(3) x]] + id_onD[OF pick_id_ons'(3)[OF suitable_prems(1) x]] + id_onD[OF pick_id_ons'(4)[OF suitable_prems(2) x]] id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) x]] - id_onD[OF pick_id_ons'(6)[OF suitable_prems(4) x]]) + id_onD[OF pick_id_ons'(6)[OF suitable_prems(3) x]] + id_onD[OF pick_id_ons'(7)[OF suitable_prems(3) x]] + id_onD[OF pick_id_ons'(8)[OF suitable_prems(4) x]]) apply (rule trans[OF comp_apply]) apply (rule trans) apply (unfold eq_bij_betw_refl_def)[1] @@ -4439,7 +4587,7 @@ lemma f_swap_alpha: apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ apply (erule conjE)+ apply (rotate_tac -1) - apply (erule id_onD[rotated, OF imageI, of _ _ f1]) + apply (erule id_onD[rotated, OF imageI, of _ _ f2]) apply assumption apply (rule sym) apply (rule comp_middle) @@ -4451,12 +4599,14 @@ lemma f_swap_alpha: apply assumption apply (erule id_onD[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) valid] imageI] id_onD[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) valid] imageI] - id_onD[OF pick_id_on_images'(3)[OF f_prems suitable_prems(2) valid] imageI] - id_onD[OF pick_id_on_images'(4)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) valid] imageI] + id_onD[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) valid] imageI] id_onD[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) valid] imageI] - id_onD[OF pick_id_on_images'(6)[OF f_prems suitable_prems(4) valid] imageI]) + id_onD[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) valid] imageI]) (* end repeat nvars *) - apply (rule T1.alpha_refls) + apply (rule alpha_refls) (* end binding alpha_bij_tac *) apply (rule allI) apply (rule impI) @@ -4468,13 +4618,13 @@ lemma f_swap_alpha: apply (rule PUmap'_cong) apply (rule refl) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshapes T1.set_subshape_images[rotated -1, OF imageI]) - apply (rule bij_imp_bij_inv supp_inv_bound suitable_prems suitable'_prems f_prems imsupp_prems pick_prems T1.alpha_refls valid_Pmap | assumption | erule eq_bij_betw_refl_prems)+ - apply (subst T1.rename_comps) + apply (erule set_subshapess set_subshape_permutess[rotated -1]) + apply (rule bij_imp_bij_inv supp_inv_bound suitable_prems suitable'_prems f_prems imsupp_prems pick_prems alpha_refls valid_Pmap | assumption | erule eq_bij_betw_refl_prems)+ + apply (subst permute_raw_comps) apply (rule pick_prems f_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems bij_comp pick_prems supp_comp_bound infinite_UNIV | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -4483,7 +4633,7 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule sym) apply (rule trans) apply (rule valid_PUmap'_If) @@ -4491,7 +4641,7 @@ lemma f_swap_alpha: apply (erule eq_bij_betw_refl_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems bij_comp supp_comp_bound pick_prems infinite_UNIV | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -4500,16 +4650,16 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule IHs[THEN conjunct2]) - apply (subst T1.rename_comps) + apply (subst permute_raw_comps) apply (rule f_prems pick_prems bij_comp supp_comp_bound infinite_UNIV)+ apply (erule eq_bij_betw_refl_prems)+ - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_comp supp_comp_bound infinite_UNIV f_prems pick_prems | erule eq_bij_betw_refl_prems | assumption)+ apply (rule bij_id supp_id_bound suitable_prems imsupp_id_empty)+ - apply (rule T1.alpha_syms) - apply (subst T1.rename_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ + apply (rule alpha_syms) + apply (subst permute_raw_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ apply assumption (* orelse nonbinding recursive set, again *) @@ -4519,48 +4669,46 @@ lemma f_swap_alpha: apply (unfold prod.case) apply (rule context_conjI) (* alpha_bij_tac *) - apply (rule T1.alpha_bijs) - apply (erule eq_bij_betw_refl_prems)+ + apply (rule alpha_bijs) + apply (erule eq_bij_betw_refl_prems)+ (* repeat twice *) - apply (rule ballI) - apply (unfold T1.FVars_renames[OF f_prems])[1] - apply (erule imageE) - apply hypsubst - apply (unfold eq_bij_betw_refl_def)[1] - apply (erule conjE)+ - apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ - apply (erule conjE)+ - apply (drule UN_I) - apply assumption - apply (rotate_tac -1) - apply (rule trans) - apply (drule id_onD[rotated, OF imageI]) + apply (unfold FVars_raw_permutes[OF f_prems])[1] + apply (unfold eq_bij_betw_refl_def)[1] + apply (erule conjE)+ + apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ + apply (erule conjE)+ + apply (rule eq_onI) + apply (drule UN_I) + apply (rotate_tac -1) + apply assumption + apply (unfold image_UN[symmetric]) + apply (rotate_tac -1) + apply (rule trans) + apply (erule id_onD[rotated]) + apply assumption + apply (rule sym) + apply (erule id_onD[rotated]) apply assumption - apply assumption - apply (rule sym) - apply (erule id_onD[rotated, OF imageI]) - apply assumption (* copied from above *) - apply (rule ballI) - apply (unfold T1.FVars_renames[OF f_prems])[1] - apply (erule imageE) - apply hypsubst - apply (unfold eq_bij_betw_refl_def)[1] - apply (erule conjE)+ - apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ - apply (erule conjE)+ - apply (drule UN_I) - apply assumption - apply (rotate_tac -1) - apply (rule trans) - apply (drule id_onD[rotated, OF imageI]) - apply assumption - apply assumption - apply (rule sym) - apply (erule id_onD[rotated, OF imageI]) - apply assumption + apply (unfold FVars_raw_permutes[OF f_prems])[1] + apply (unfold eq_bij_betw_refl_def)[1] + apply (erule conjE)+ + apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ + apply (erule conjE)+ + apply (rule eq_onI) + apply (drule UN_I) + apply (rotate_tac -1) + apply assumption + apply (unfold image_UN[symmetric]) + apply (rotate_tac -1) + apply (rule trans) + apply (erule id_onD[rotated]) + apply assumption + apply (rule sym) + apply (erule id_onD[rotated]) + apply assumption (* end repeat twice *) - apply (rule T1.alpha_refls) + apply (rule alpha_refls) (* end alpha_bij_tac *) apply (rule allI) apply (rule impI) @@ -4572,13 +4720,13 @@ lemma f_swap_alpha: apply (rule PUmap'_cong) apply (rule refl) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_refl_prems)+ - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems T1.alpha_refls)+ + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems alpha_refls)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -4587,7 +4735,7 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule sym) apply (rule trans) apply (rule valid_PUmap'_If) @@ -4595,7 +4743,7 @@ lemma f_swap_alpha: apply (erule eq_bij_betw_refl_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -4604,15 +4752,15 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule IHs[THEN conjunct2]) - apply (subst T1.rename_comps) + apply (subst permute_raw_comps) apply (rule f_prems)+ apply (erule eq_bij_betw_refl_prems)+ - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_comp supp_comp_bound infinite_UNIV f_prems | erule eq_bij_betw_refl_prems)+ apply (rule bij_id supp_id_bound suitable_prems imsupp_id_empty | assumption)+ - apply (rule T1.alpha_syms) + apply (rule alpha_syms) apply assumption (* orelse binding recursive set, again *) @@ -4620,30 +4768,14 @@ lemma f_swap_alpha: apply (unfold Grp_UNIV_def)[1] apply (rule refl) apply (unfold prod.case) - apply (subst T1.rename_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ + apply (subst permute_raw_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ apply (rule context_conjI) (* binding alpha_bij_tac *) - apply (rule T1.alpha_bijs) + apply (rule alpha_bijs) apply (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+ -(* nonbinding recursive occurence *) - apply (rule ballI) - apply (subst comp_def)+ - apply (unfold eq_bij_betw_refl_def)[1] - apply (erule conjE)+ - apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ - apply (erule conjE)+ - apply (drule UN_I) - apply assumption - apply (rotate_tac -1) - apply (rule trans) - apply (erule id_onD[rotated, OF imageI, of _ _ f2]) - apply assumption - apply (rule sym) - apply (erule id_onD[rotated, OF imageI]) - apply assumption (* copied from above, binding case *) - apply (rule ballI) + apply (rule eq_onI) apply (rule case_split[of "_ \ _"]) apply (unfold eq_bij_betw_refl_def)[1] apply (erule conjE)+ @@ -4661,10 +4793,12 @@ lemma f_swap_alpha: apply (rule arg_cong[of _ _ "_ \ _"]) apply (erule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) x]] id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) x]] - id_onD[OF pick_id_ons'(3)[OF suitable_prems(2) x]] - id_onD[OF pick_id_ons'(4)[OF suitable_prems(3) x]] + id_onD[OF pick_id_ons'(3)[OF suitable_prems(1) x]] + id_onD[OF pick_id_ons'(4)[OF suitable_prems(2) x]] id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) x]] - id_onD[OF pick_id_ons'(6)[OF suitable_prems(4) x]]) + id_onD[OF pick_id_ons'(6)[OF suitable_prems(3) x]] + id_onD[OF pick_id_ons'(7)[OF suitable_prems(3) x]] + id_onD[OF pick_id_ons'(8)[OF suitable_prems(4) x]]) apply (rule trans[OF comp_apply]) apply (rule trans) apply (unfold eq_bij_betw_refl_def)[1] @@ -4684,12 +4818,31 @@ lemma f_swap_alpha: apply assumption apply (erule id_onD[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) valid] imageI] id_onD[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) valid] imageI] - id_onD[OF pick_id_on_images'(3)[OF f_prems suitable_prems(2) valid] imageI] - id_onD[OF pick_id_on_images'(4)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) valid] imageI] + id_onD[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) valid] imageI] id_onD[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) valid] imageI] - id_onD[OF pick_id_on_images'(6)[OF f_prems suitable_prems(4) valid] imageI]) + id_onD[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) valid] imageI]) + (* nonbinding recursive occurence *) + apply (rule eq_onI) + apply (subst comp_def)+ + apply (unfold eq_bij_betw_refl_def)[1] + apply (erule conjE)+ + apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ + apply (erule conjE)+ + apply (drule UN_I) + apply assumption + apply (rotate_tac -1) + apply (rule trans) + apply (drule id_onD[rotated, OF imageI, of _ _ f2]) + apply assumption + apply assumption + apply (rule sym) + apply (erule id_onD[rotated, OF imageI]) + apply assumption (* end repeat twice *) - apply (rule T1.alpha_refls) + apply (rule alpha_refls) (* end binding alpha_bij_tac *) apply (rule allI) apply (rule impI) @@ -4701,17 +4854,17 @@ lemma f_swap_alpha: apply (rule PUmap'_cong) apply (rule refl) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshapes T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshapess set_subshape_permutess[rotated -1]) apply (rule bij_id supp_id_bound pick_prems)+ apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_refl_prems)+ - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems pick_prems bij_id supp_id_bound T1.alpha_refls)+ - apply (subst T1.rename_comps) + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems pick_prems bij_id supp_id_bound alpha_refls)+ + apply (subst permute_raw_comps) apply (rule pick_prems f_prems bij_id supp_id_bound)+ apply (unfold id_o o_id) apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems bij_comp pick_prems supp_comp_bound infinite_UNIV | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -4720,7 +4873,7 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule sym) apply (rule trans) apply (rule valid_PUmap'_If) @@ -4728,7 +4881,7 @@ lemma f_swap_alpha: apply (erule eq_bij_betw_refl_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems bij_comp supp_comp_bound pick_prems infinite_UNIV | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -4737,16 +4890,16 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule IHs[THEN conjunct2]) - apply (subst T1.rename_comps) + apply (subst permute_raw_comps) apply (rule f_prems pick_prems bij_comp supp_comp_bound infinite_UNIV)+ apply (erule eq_bij_betw_refl_prems)+ - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_comp supp_comp_bound infinite_UNIV f_prems pick_prems | erule eq_bij_betw_refl_prems | assumption)+ apply (rule supp_id_bound bij_id suitable_prems imsupp_id_empty)+ - apply (rule T1.alpha_syms) - apply (subst T1.rename_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ + apply (rule alpha_syms) + apply (subst permute_raw_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ apply assumption (**********************************************************************************************) (* f picks t = f picks' t' *) @@ -4756,37 +4909,37 @@ lemma f_swap_alpha: proof - note exists_bij_betw2s = exists_bij_betw_def[OF _ _ pick_prems(1) pick'_prems(1) h_prems(1), of _ set5_T1_pre _ _ set5_T1_pre - "\x. map_T1_pre id id id id id id fst fst fst fst ( - map_T1_pre id id id id (pick1' x' p) (pick2' x' p) + "\x. map_T1_pre id id id id id id id fst fst fst fst ( + map_T1_pre id id id id (pick1' x' p) (pick2' x' p) (pick1' x' p) (\t. (t, \p'. if validP p' then f_T1 pick1' pick2' pick3' pick4' t p' else undefined)) - (\t. (rename_T1 (pick1' x' p) (pick2' x' p) t, \p'. if validP p' then f_T1 pick1' pick2' pick3' pick4' (rename_T1 (pick1' x' p) (pick2' x' p) t) p' else undefined)) + (\t. (permute_raw_T1 (pick1' x' p) (pick2' x' p) t, \p'. if validP p' then f_T1 pick1' pick2' pick3' pick4' (permute_raw_T1 (pick1' x' p) (pick2' x' p) t) p' else undefined)) (\t. (t, \p'. if validP p' then f_T2 pick1' pick2' pick3' pick4' t p' else undefined)) - (\t. (rename_T2 (pick1' x' p) id t, \p'. if validP p' then f_T2 pick1' pick2' pick3' pick4' (rename_T2 (pick1' x' p) id t) p' else undefined)) + (\t. (permute_raw_T2 (pick1' x' p) id t, \p'. if validP p' then f_T2 pick1' pick2' pick3' pick4' (permute_raw_T2 (pick1' x' p) id t) p' else undefined)) x)" - "\x. FVars_T11 (raw_T1_ctor x) \ PFVars_1 p \ avoiding_set1" - _ "\x'. map_T1_pre id id id id id id fst fst fst fst ( - map_T1_pre id id id id (pick1 x p) (pick2 x p) + "\x. FVars_raw_T11 (raw_T1_ctor x) \ PFVars_1 p \ avoiding_set1" + _ "\x'. map_T1_pre id id id id id id id fst fst fst fst ( + map_T1_pre id id id id (pick1 x p) (pick2 x p) (pick1 x p) (\t. (t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T1 (pick1 x p) (pick2 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (rename_T1 (pick1 x p) (pick2 x p) t) p' else undefined)) + (\t. (permute_raw_T1 (pick1 x p) (pick2 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 (pick1 x p) (pick2 x p) t) p' else undefined)) (\t. (t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T2 (pick1 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (rename_T2 (pick1 x p) id t) p' else undefined)) + (\t. (permute_raw_T2 (pick1 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 (pick1 x p) id t) p' else undefined)) x')" ] exists_bij_betw_def[OF _ _ pick_prems(3) pick'_prems(3) h_prems(3), of _ set6_T1_pre _ _ set6_T1_pre - "\x. map_T1_pre id id id id id id fst fst fst fst ( - map_T1_pre id id id id (pick1' x' p) (pick2' x' p) + "\x. map_T1_pre id id id id id id id fst fst fst fst ( + map_T1_pre id id id id (pick1' x' p) (pick2' x' p) (pick1' x' p) (\t. (t, \p'. if validP p' then f_T1 pick1' pick2' pick3' pick4' t p' else undefined)) - (\t. (rename_T1 (pick1' x' p) (pick2' x' p) t, \p'. if validP p' then f_T1 pick1' pick2' pick3' pick4' (rename_T1 (pick1' x' p) (pick2' x' p) t) p' else undefined)) + (\t. (permute_raw_T1 (pick1' x' p) (pick2' x' p) t, \p'. if validP p' then f_T1 pick1' pick2' pick3' pick4' (permute_raw_T1 (pick1' x' p) (pick2' x' p) t) p' else undefined)) (\t. (t, \p'. if validP p' then f_T2 pick1' pick2' pick3' pick4' t p' else undefined)) - (\t. (rename_T2 (pick1' x' p) id t, \p'. if validP p' then f_T2 pick1' pick2' pick3' pick4' (rename_T2 (pick1' x' p) id t) p' else undefined)) + (\t. (permute_raw_T2 (pick1' x' p) id t, \p'. if validP p' then f_T2 pick1' pick2' pick3' pick4' (permute_raw_T2 (pick1' x' p) id t) p' else undefined)) x)" - "\x. FVars_T12 (raw_T1_ctor x) \ PFVars_2 p \ avoiding_set2" - _ "\x'. map_T1_pre id id id id id id fst fst fst fst ( - map_T1_pre id id id id (pick1 x p) (pick2 x p) + "\x. FVars_raw_T12 (raw_T1_ctor x) \ PFVars_2 p \ avoiding_set2" + _ "\x'. map_T1_pre id id id id id id id fst fst fst fst ( + map_T1_pre id id id id (pick1 x p) (pick2 x p) (pick1 x p) (\t. (t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T1 (pick1 x p) (pick2 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (rename_T1 (pick1 x p) (pick2 x p) t) p' else undefined)) + (\t. (permute_raw_T1 (pick1 x p) (pick2 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 (pick1 x p) (pick2 x p) t) p' else undefined)) (\t. (t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T2 (pick1 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (rename_T2 (pick1 x p) id t) p' else undefined)) + (\t. (permute_raw_T2 (pick1 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 (pick1 x p) id t) p' else undefined)) x')" ] show ?thesis @@ -4803,13 +4956,13 @@ lemma f_swap_alpha: apply (rule T1_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) (* end bound_tac *) - apply (subst T1.alpha_FVarss) - apply (rule T1.alpha_syms) + apply (subst alpha_FVars) + apply (rule alpha_syms) apply (rule alpha_ctor_picks[OF suitable'_prems valid]) apply (subst T1_pre.map_comp) apply (rule supp_id_bound pick'_prems bij_id)+ @@ -4831,13 +4984,13 @@ lemma f_swap_alpha: apply (rule T1_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) (* end bound_tac *) - apply (subst T1.alpha_FVarss) - apply (rule T1.alpha_syms) + apply (subst alpha_FVars) + apply (rule alpha_syms) apply (rule alpha_ctor_picks[OF suitable_prems valid]) apply (subst T1_pre.map_comp) apply (rule supp_id_bound pick_prems bij_id)+ @@ -4869,13 +5022,13 @@ lemma f_swap_alpha: apply (rule T1_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) (* end bound_tac *) - apply (subst T1.alpha_FVarss) - apply (rule T1.alpha_syms) + apply (subst alpha_FVars) + apply (rule alpha_syms) apply (rule alpha_ctor_picks[OF suitable'_prems valid]) apply (subst T1_pre.map_comp) apply (rule supp_id_bound pick'_prems bij_id)+ @@ -4897,13 +5050,13 @@ lemma f_swap_alpha: apply (rule T1_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) (* end bound_tac *) - apply (subst T1.alpha_FVarss) - apply (rule T1.alpha_syms) + apply (subst alpha_FVars) + apply (rule alpha_syms) apply (rule alpha_ctor_picks[OF suitable_prems valid]) apply (subst T1_pre.map_comp) apply (rule supp_id_bound pick_prems bij_id)+ @@ -5155,7 +5308,7 @@ lemma f_swap_alpha: apply (unfold id_o o_id inv_id Grp_UNIV_id OO_eq conversep_eq) apply (unfold relcompp_conversep_Grp) apply (rule T1_pre.mr_rel_mono_strong0) - prefer 15 (* 2 * (free + 2 * bound) + 1) *) + prefer 17 (* 2 * (free + 2 * bound) + 1) *) apply (rule prems) apply (rule supp_id_bound bij_id h_prems supp_comp_bound supp_inv_bound infinite_UNIV bij_comp bij_imp_bij_inv pick_prems pick'_prems | erule eq_bij_betw_prems)+ (* REPEAT FIRST' *) @@ -5169,23 +5322,23 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ - apply (unfold T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + apply (unfold alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] )[1] apply (rule trans) apply (rule arg_cong[of _ _ "inv _"]) apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply (erule id_onD[OF id_on_inv, rotated]) apply (rule UnI1) apply (rule UnI1) apply (subst (asm) T1_pre.mr_rel_set(1-2,5-6)[rotated -1, OF mr_rel_prem, unfolded image_id, symmetric]) apply (rule supp_id_bound bij_id h_prems)+ - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption (* copied from above *) apply (rule ballI) @@ -5197,23 +5350,23 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ - apply (unfold T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + apply (unfold alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] )[1] apply (rule trans) apply (rule arg_cong[of _ _ "inv _"]) apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply (erule id_onD[OF id_on_inv, rotated]) apply (rule UnI1) apply (rule UnI1) apply (subst (asm) T1_pre.mr_rel_set(1-2,5-6)[rotated -1, OF mr_rel_prem, unfolded image_id, symmetric]) apply (rule supp_id_bound bij_id h_prems)+ - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption (* orelse *) apply (rule ballI) @@ -5259,6 +5412,93 @@ lemma f_swap_alpha: apply assumption apply (unfold comp_def)[1] apply (rule refl) + (* orelse bound free set *) + apply (rule ballI) + apply (rule case_split[of "_ \ _"]) + apply (unfold comp_assoc[symmetric])[1] + apply (subst o_inv_distrib[symmetric]) + apply (erule eq_bij_betw_prems) + apply (rule pick'_prems) + apply (unfold comp_assoc)[1] + apply (rule sym) + apply (rule trans) + apply (rule comp_apply) + apply (rule iffD2[OF bij_imp_inv']) + apply (rule bij_comp pick'_prems | erule eq_bij_betw_prems)+ + apply (rule trans[rotated]) + apply (unfold eq_bij_betw_def)[1] + apply (erule conjE eq_onD)+ + apply assumption + apply (unfold comp_def)[1] + apply (rule refl) + apply (drule DiffI) + apply assumption + apply (rule trans) + apply (rule h_id_ons[THEN id_onD]) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + apply (rule sym) + apply (rule trans) + apply (rule comp_apply) + apply (rule iffD2[OF bij_imp_inv']) + apply (rule pick'_prems) + apply (rule trans) + apply (rule id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]]) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (rule arg_cong2[of _ _ _ _ minus]) + apply (rule T1_pre.mr_rel_set(1-3,5-7)[rotated -1, OF mr_rel_prem], (rule supp_id_bound bij_id h_prems)+)+ + apply (subst image_set_diff[symmetric, OF bij_is_inj]) + apply (rule h_prems) + apply (subst id_on_image) + apply (rule h_id_ons[THEN id_on_antimono]) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + apply assumption + apply (rule sym) + apply (rule trans[OF comp_apply]) + apply (rule trans) + apply (rule arg_cong[of _ _ "_ \ _"]) + apply (rule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]]) + apply assumption + apply (rule trans) + apply (rule comp_apply) + apply (unfold eq_bij_betw_def)[1] + apply (erule conjE)+ + apply (unfold alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + )[1] + apply (subst (asm) T1_pre.set_map, (rule supp_id_bound bij_id pick_prems pick'_prems | assumption)+)+ + apply (unfold image_id) + apply (rule trans) + apply (rule arg_cong[of _ _ "inv _"]) + apply (erule imsupp_id_on[THEN id_onD]) + apply (rule UnI1)+ + apply (erule DiffE) + apply (erule FVars_raw_intros) + apply assumption + apply (erule imsupp_id_on[THEN id_on_inv[rotated, THEN id_onD]]) + apply assumption + apply (rule UnI1)+ + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (rule alpha_FVars) + apply (rule alpha_syms) + apply (rule alpha_T1_alpha_T2.intros[rotated -1]) + apply (rule mr_rel_prem) + apply (rule h_prems h_id_ons)+ + apply (erule DiffE) + apply (erule FVars_raw_intros) + apply assumption (* orelse nonbinding rec set *) apply (rule ballI impI)+ apply (rule relcomppI) @@ -5267,15 +5507,15 @@ lemma f_swap_alpha: apply (unfold prod.case) apply (rule context_conjI) (* alpha_bij_tac *) - apply (rule T1.alpha_bijs[rotated -1]) - apply (assumption | rule T1.alpha_refls) + apply (rule alpha_bijs[rotated -1]) + apply (assumption | rule alpha_refls) apply (erule eq_bij_betw_prems)+ (* REPEAT_DETERM *) - apply (rule ballI) - apply (unfold eq_bij_betw_def T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + apply (rule eq_onI) + apply (unfold eq_bij_betw_def alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] )[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -5283,24 +5523,24 @@ lemma f_swap_alpha: apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption apply (rule sym) apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply assumption apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply assumption (* copied from above *) - apply (rule ballI) - apply (unfold eq_bij_betw_def T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + apply (rule eq_onI) + apply (unfold eq_bij_betw_def alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] )[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -5308,17 +5548,17 @@ lemma f_swap_alpha: apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption apply (rule sym) apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply assumption apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply assumption (* end alpha_bij_tac *) apply (rule allI) @@ -5331,7 +5571,7 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply assumption apply (rule suitable_prems)+ apply assumption+ @@ -5341,10 +5581,10 @@ lemma f_swap_alpha: apply (unfold Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule trans) apply (rule IHs[THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (erule eq_bij_betw_prems)+ apply assumption apply ((rule suitable_prems)+)[4] @@ -5352,29 +5592,29 @@ lemma f_swap_alpha: prefer 8 (* 3*nvars + 2 *) apply (rule trans) apply (rule IHs[THEN conjunct1]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) prefer 21 (* 5 * nvars + 2 * m + 3 *) apply (rule trans[rotated]) apply (rule fun_cong[OF fun_cong[OF PU1map'_alpha]]) - apply (rule T1.alpha_bij_eqs[THEN iffD2])? + apply (rule alpha_bij_eqs[THEN iffD2])? apply ((rule pick'_prems)+)? apply assumption apply (rule PUmap'_cong) - apply (rule T1.rename_comps[symmetric] T1.rename_ids) + apply (rule permute_raw_comps[symmetric] permute_raw_ids) apply ((rule h_prems pick'_prems)+)? apply (subst if_P) apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+ apply (rule IHs[THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick'_prems h_prems)+ apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+ apply (rule suitable'_prems)+ apply (rule supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left])+ - apply (subst T1.rename_comps[symmetric] T1.rename_ids) + apply (subst permute_raw_comps[symmetric] permute_raw_ids) apply ((rule h_prems pick'_prems)+)? - apply (rule T1.alpha_bij_eqs[THEN iffD2])? + apply (rule alpha_bij_eqs[THEN iffD2])? apply ((rule pick'_prems)+)? apply assumption apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick'_prems h_prems)+ @@ -5387,16 +5627,16 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left])+ - apply (subst (asm) T1.rename_comps | subst T1.rename_ids) + apply (subst (asm) permute_raw_comps | subst permute_raw_ids) apply ((rule pick_prems | erule eq_bij_betw_prems)+)? - apply (rule T1.alpha_transs) + apply (rule alpha_trans) apply assumption - apply (subst T1.rename_comps[symmetric])? + apply (subst permute_raw_comps[symmetric])? apply ((rule h_prems pick'_prems)+)? - apply (rule T1.alpha_bij_eqs[THEN iffD2], (erule eq_bij_betw_prems | rule h_prems pick'_prems)+)+ - apply (rule T1.alpha_syms) + apply (rule alpha_bij_eqs[THEN iffD2], (erule eq_bij_betw_prems | rule h_prems pick'_prems)+)+ + apply (rule alpha_syms) apply assumption (* orelse binding rec set *) @@ -5405,11 +5645,11 @@ lemma f_swap_alpha: apply (rule refl) apply (unfold prod.case) apply (rule context_conjI) - apply (subst T1.rename_comps, (rule pick_prems pick'_prems | erule eq_bij_betw_prems)+)+ - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bijs[rotated -3]) (* -1 - nvars *) + apply (subst permute_raw_comps, (rule pick_prems pick'_prems | erule eq_bij_betw_prems)+)+ + apply (rule alpha_trans) + apply (rule alpha_bijs[rotated -3]) (* -1 - nvars *) (* REPEAT_DETERM *) - apply (rule ballI) + apply (rule eq_onI) apply (rule sym) apply (rule case_split[of "_ \ _"]) apply (unfold eq_bij_betw_def)[1] @@ -5428,8 +5668,8 @@ lemma f_swap_alpha: apply (rule id_on_comp3) apply (erule id_onD[rotated]) apply assumption - apply (drule T1.FVars_renames[symmetric, OF h_prems, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], OF imageI]) - apply (drule T1.alpha_FVarss[THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated]) + apply (drule FVars_raw_permutes[symmetric, OF h_prems, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], OF imageI]) + apply (drule alpha_FVars[THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated]) apply assumption apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T1_pre.mr_rel_set(5,6)[rotated -1, OF iffD2[OF T1_pre.mr_rel_flip mr_rel_prem]]) @@ -5444,13 +5684,16 @@ lemma f_swap_alpha: apply (rule UN_I) prefer 3 apply (rotate_tac -1) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] - id_onD[OF pick_id_ons'(2)[OF suitable'_prems(1) valid]] - id_onD[OF pick_id_ons'(3)[OF suitable'_prems(2) valid]] - id_onD[OF pick_id_ons'(4)[OF suitable'_prems(3) valid]] - id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]] - id_onD[OF pick_id_ons'(6)[OF suitable'_prems(4) valid]] - ) + apply (erule + id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(2)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(3)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(4)[OF suitable'_prems(2) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(6)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(7)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(8)[OF suitable'_prems(4) valid]] + ) apply assumption apply assumption apply (rule h_prems) @@ -5462,21 +5705,25 @@ lemma f_swap_alpha: apply (rule UnI1) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) - apply (rule T1.alpha_transs[rotated]) + apply (rule alpha_FVars) + apply (rule alpha_trans[rotated]) apply (rule alpha_ctor_picks[OF suitable'_prems valid]) apply (rule alpha_T1_alpha_T2.intros[rotated -1]) apply (rule mr_rel_prem h_prems h_id_ons)+ - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption+ apply (rule sym) apply (rule id_on_comp2) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] - id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] - id_onD[OF pick_id_ons'(3)[OF suitable_prems(2) valid]] - id_onD[OF pick_id_ons'(4)[OF suitable_prems(3) valid]] - id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] - id_onD[OF pick_id_ons'(6)[OF suitable_prems(4) valid]]) + apply (erule + id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(3)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(4)[OF suitable_prems(2) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(6)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(7)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(8)[OF suitable_prems(4) valid]] + ) apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -5485,12 +5732,12 @@ lemma f_swap_alpha: apply (rule UnI1) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_ctor_picks[OF suitable_prems valid]) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption+ (* copied from above *) - apply (rule ballI) + apply (rule eq_onI) apply (rule sym) apply (rule case_split[of "_ \ _"]) apply (unfold eq_bij_betw_def)[1] @@ -5509,8 +5756,8 @@ lemma f_swap_alpha: apply (rule id_on_comp3) apply (erule id_onD[rotated]) apply assumption - apply (drule T1.FVars_renames[symmetric, OF h_prems, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], OF imageI]) - apply (drule T1.alpha_FVarss[THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated]) + apply (drule FVars_raw_permutes[symmetric, OF h_prems, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], OF imageI]) + apply (drule alpha_FVars[THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated]) apply assumption apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T1_pre.mr_rel_set(5,6)[rotated -1, OF iffD2[OF T1_pre.mr_rel_flip mr_rel_prem]]) @@ -5525,13 +5772,16 @@ lemma f_swap_alpha: apply (rule UN_I) prefer 3 apply (rotate_tac -1) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] - id_onD[OF pick_id_ons'(2)[OF suitable'_prems(1) valid]] - id_onD[OF pick_id_ons'(3)[OF suitable'_prems(2) valid]] - id_onD[OF pick_id_ons'(4)[OF suitable'_prems(3) valid]] - id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]] - id_onD[OF pick_id_ons'(6)[OF suitable'_prems(4) valid]] - ) + apply (erule + id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(2)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(3)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(4)[OF suitable'_prems(2) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(6)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(7)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(8)[OF suitable'_prems(4) valid]] + ) apply assumption apply assumption apply (unfold eq_bij_betw_def)[1] @@ -5542,23 +5792,27 @@ lemma f_swap_alpha: apply (rule UnI1) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_ctor_picks[OF suitable'_prems valid]) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_T1_alpha_T2.intros[rotated -1]) apply (rule mr_rel_prem h_prems h_id_ons)+ - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption+ apply (rule sym) apply (rule id_on_comp2) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] - id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] - id_onD[OF pick_id_ons'(3)[OF suitable_prems(2) valid]] - id_onD[OF pick_id_ons'(4)[OF suitable_prems(3) valid]] - id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] - id_onD[OF pick_id_ons'(6)[OF suitable_prems(4) valid]]) + apply (erule + id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(3)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(4)[OF suitable_prems(2) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(6)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(7)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(8)[OF suitable_prems(4) valid]] + ) apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -5567,16 +5821,16 @@ lemma f_swap_alpha: apply (rule UnI1) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_ctor_picks[OF suitable_prems valid]) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption+ (* end repeat *) - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule bij_comp pick_prems pick'_prems supp_comp_bound infinite_UNIV h_prems | erule eq_bij_betw_prems)+ - apply (subst T1.rename_comps[symmetric]) + apply (subst permute_raw_comps[symmetric]) apply (rule h_prems bij_comp pick'_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems)+ - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule h_prems bij_comp pick'_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems)+ apply assumption (* PUmap' ... (f ...) = PUmap' ... (f ...) *) @@ -5588,7 +5842,7 @@ lemma f_swap_alpha: apply (erule eq_bij_betw_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule pick_prems suitable_prems | erule eq_bij_betw_prems | assumption)+ apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ @@ -5596,41 +5850,41 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) - apply (subst T1.rename_comps) + apply (rule alpha_refls) + apply (subst permute_raw_comps) apply (rule pick_prems | erule eq_bij_betw_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_comp pick_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems | assumption)+ apply ((rule suitable_prems)+)[4] apply (rule suitable'_prems)+ prefer 8 apply (rule trans) apply (rule IHs[THEN conjunct1]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) prefer 21 (* 5 * nvars + 2 * m + 3 *) apply (rule trans[rotated]) apply (rule fun_cong[OF fun_cong[OF PU1map'_alpha]]) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule pick'_prems)+ apply assumption apply (rule PUmap'_cong) - apply (rule T1.rename_comps[symmetric]) + apply (rule permute_raw_comps[symmetric]) apply (rule h_prems pick'_prems)+ apply (subst if_P) apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+ apply (rule IHs[THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_comp supp_comp_bound infinite_UNIV pick'_prems h_prems)+ apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+ apply (rule suitable'_prems)+ apply (rule supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left])+ - apply (subst T1.rename_comps[symmetric]) + apply (subst permute_raw_comps[symmetric]) apply (rule h_prems pick'_prems)+ - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule pick'_prems)+ apply assumption apply (rule bij_comp supp_comp_bound infinite_UNIV pick'_prems h_prems)+ @@ -5643,16 +5897,16 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left])+ - apply (subst (asm) T1.rename_comps) + apply (subst (asm) permute_raw_comps) apply (rule pick_prems | erule eq_bij_betw_prems)+ - apply (rule T1.alpha_transs) + apply (rule alpha_trans) apply assumption - apply (subst T1.rename_comps[symmetric]) + apply (subst permute_raw_comps[symmetric]) apply (rule h_prems pick'_prems)+ - apply (rule T1.alpha_bij_eqs[THEN iffD2], (erule eq_bij_betw_prems | rule h_prems pick'_prems)+)+ - apply (rule T1.alpha_syms) + apply (rule alpha_bij_eqs[THEN iffD2], (erule eq_bij_betw_prems | rule h_prems pick'_prems)+)+ + apply (rule alpha_syms) apply assumption (* orelse nonbinding rec set, again *) @@ -5663,15 +5917,15 @@ lemma f_swap_alpha: apply (unfold prod.case) apply (rule context_conjI) (* alpha_bij_tac *) - apply (rule T1.alpha_bijs[rotated -1]) - apply (assumption | rule T1.alpha_refls) + apply (rule alpha_bijs[rotated -1]) + apply (assumption | rule alpha_refls) apply (erule eq_bij_betw_prems)+ (* REPEAT_DETERM *) - apply (rule ballI) - apply (unfold eq_bij_betw_def T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + apply (rule eq_onI) + apply (unfold eq_bij_betw_def alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] )[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -5679,24 +5933,24 @@ lemma f_swap_alpha: apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption apply (rule sym) apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply assumption apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply assumption (* copied from above *) - apply (rule ballI) - apply (unfold eq_bij_betw_def T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + apply (rule eq_onI) + apply (unfold eq_bij_betw_def alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] )[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -5704,17 +5958,17 @@ lemma f_swap_alpha: apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption apply (rule sym) apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply assumption apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply assumption (* end alpha_bij_tac *) apply (rule allI) @@ -5727,7 +5981,7 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply assumption apply (rule suitable_prems)+ apply assumption+ @@ -5737,14 +5991,14 @@ lemma f_swap_alpha: apply (unfold Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule trans) apply (rule IHs[THEN conjunct2, OF _ _ suitable_prems suitable'_prems]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) prefer 13 (* 5*nvars + 3 *) apply (rule trans) apply (rule IHs[THEN conjunct1, OF _ _ suitable'_prems suitable'_prems]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply assumption prefer 8 apply (rule trans) @@ -5756,7 +6010,7 @@ lemma f_swap_alpha: apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+ apply (rule IHs[THEN conjunct2, OF _ _ suitable'_prems suitable'_prems]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply (erule valid_Pmap; (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+) apply (rule supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left])+ apply assumption @@ -5764,11 +6018,11 @@ lemma f_swap_alpha: apply (((unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1], (erule conjE)+, assumption)+)[2] apply assumption apply (rule supp_id_bound bij_id imsupp_id_empty | erule eq_bij_betw_prems | assumption)+ - apply (rule T1.alpha_transs) + apply (rule alpha_trans) apply assumption - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (erule eq_bij_betw_prems)+ - apply (rule T1.alpha_syms) + apply (rule alpha_syms) apply assumption (* orelse binding rec set, again *) @@ -5776,39 +6030,13 @@ lemma f_swap_alpha: apply (unfold Grp_UNIV_def)[1] apply (rule refl) apply (unfold prod.case) - apply (subst T1.rename_comps, (rule pick_prems pick'_prems bij_id supp_id_bound | erule eq_bij_betw_prems)+)+ + apply (subst permute_raw_comps, (rule pick_prems pick'_prems bij_id supp_id_bound | erule eq_bij_betw_prems)+)+ apply (unfold id_o o_id) apply (rule context_conjI) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bijs[rotated -3]) (* -1 - nvars *) + apply (rule alpha_trans) + apply (rule alpha_bijs[rotated -3]) (* -1 - nvars *) (* REPEAT_DETERM *) - apply (rule ballI) - apply (unfold eq_bij_betw_def)[1] - apply (erule conjE)+ - apply (subst (asm) - T1.alpha_FVarss(1)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric])+ - apply (drule imsupp_id_on)+ - apply (erule id_on_eq) - prefer 2 - apply (rule arg_cong2[OF _ refl, of _ _ "(\)"])+ - apply (rule T1.alpha_FVarss) - apply (rule alpha_T1_alpha_T2.intros[rotated -1]) - apply (rule mr_rel_prem) - apply (rule h_prems h_id_ons)+ - apply assumption - apply (rule UnI1) - apply (rule UnI1) - apply (erule T1.FVars_intros) - apply assumption - (* orelse *) - apply (rule ballI) + apply (rule eq_onI) apply (rule sym) apply (rule case_split[of "_ \ _"]) apply (unfold eq_bij_betw_def)[1] @@ -5827,9 +6055,9 @@ lemma f_swap_alpha: apply (rule id_on_comp3) apply (erule id_onD[rotated]) apply assumption - apply (drule T1.FVars_renames[symmetric, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated -1, OF imageI]) + apply (drule FVars_raw_permutes[symmetric, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated -1, OF imageI]) prefer 5 (* 2*nvars + 1 *) - apply (drule T1.alpha_FVarss[THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated]) + apply (drule alpha_FVars[THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated]) apply assumption apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T1_pre.mr_rel_set(5,6)[rotated -1, OF iffD2[OF T1_pre.mr_rel_flip mr_rel_prem]]) @@ -5841,17 +6069,20 @@ lemma f_swap_alpha: apply (rule h_prems) apply (unfold image_id) apply (drule DiffI[rotated]) - apply (erule UN_I[of _ _ _ FVars_T11, rotated] UN_I[of _ _ _ FVars_T12, rotated] - UN_I[of _ _ _ FVars_T21, rotated] UN_I[of _ _ _ FVars_T22, rotated]) + apply (erule UN_I[of _ _ _ FVars_raw_T11, rotated] UN_I[of _ _ _ FVars_raw_T12, rotated] + UN_I[of _ _ _ FVars_raw_T21, rotated] UN_I[of _ _ _ FVars_raw_T22, rotated]) apply assumption apply (rotate_tac -1) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] - id_onD[OF pick_id_ons'(2)[OF suitable'_prems(1) valid]] - id_onD[OF pick_id_ons'(3)[OF suitable'_prems(2) valid]] - id_onD[OF pick_id_ons'(4)[OF suitable'_prems(3) valid]] - id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]] - id_onD[OF pick_id_ons'(6)[OF suitable'_prems(4) valid]] - ) + apply (erule + id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(2)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(3)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(4)[OF suitable'_prems(2) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(6)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(7)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(8)[OF suitable'_prems(4) valid]] + ) apply (rule h_prems bij_id supp_id_bound)+ apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ @@ -5861,21 +6092,25 @@ lemma f_swap_alpha: apply (rule UnI1) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) - apply (rule T1.alpha_transs[rotated]) + apply (rule alpha_FVars) + apply (rule alpha_trans[rotated]) apply (rule alpha_ctor_picks[OF suitable'_prems valid]) apply (rule alpha_T1_alpha_T2.intros[rotated -1]) apply (rule mr_rel_prem h_prems h_id_ons)+ - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption+ apply (rule sym) apply (rule id_on_comp2) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] - id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] - id_onD[OF pick_id_ons'(3)[OF suitable_prems(2) valid]] - id_onD[OF pick_id_ons'(4)[OF suitable_prems(3) valid]] - id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] - id_onD[OF pick_id_ons'(6)[OF suitable_prems(4) valid]]) + apply (erule + id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(3)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(4)[OF suitable_prems(2) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(6)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(7)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(8)[OF suitable_prems(4) valid]] + ) apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -5884,24 +6119,51 @@ lemma f_swap_alpha: apply (rule UnI1) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_ctor_picks[OF suitable_prems valid]) - apply (erule T1.FVars_intros) - apply assumption+ - apply (rule T1.alpha_refls) + apply (erule FVars_raw_intros) + apply assumption+ + (* orelse *) + apply (rule eq_onI) + apply (unfold eq_bij_betw_def)[1] + apply (erule conjE)+ + apply (subst (asm) + alpha_FVars(1)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(3)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(1)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + alpha_FVars(4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric])+ + apply (drule imsupp_id_on)+ + apply (erule id_on_eq) + prefer 2 + apply (rule arg_cong2[OF _ refl, of _ _ "(\)"])+ + apply (rule alpha_FVars) + apply (rule alpha_T1_alpha_T2.intros[rotated -1]) thm mr_rel_prem + supply [[unify_trace_failure]] apply (rule mr_rel_prem) + apply (rule h_prems h_id_ons)+ + apply assumption + apply (rule UnI1) + apply (rule UnI1) + apply (erule FVars_raw_intros) + apply assumption + (* END *) + apply (rule alpha_refls) apply (rule bij_comp pick_prems pick'_prems supp_comp_bound infinite_UNIV h_prems | erule eq_bij_betw_prems)+ apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ alpha_T2]]) apply (rule trans) - apply (rule arg_cong3[of _ _ _ _ _ _ rename_T2]) + apply (rule arg_cong3[of _ _ _ _ _ _ permute_raw_T2]) prefer 4 (* nvars + 2 *) - apply (rule T1.rename_comps[symmetric]) + apply (rule permute_raw_comps[symmetric]) prefer 9 (* 4*nvars + 1*) apply (rule refl o_id[symmetric]) prefer 9 (* 4*nvars + 1 *) apply (rule refl o_id[symmetric]) apply (rule bij_id supp_id_bound h_prems bij_comp pick'_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems)+ apply (rule refl) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule h_prems bij_comp pick'_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems)+ apply assumption (* PUmap' ... (f ...) = PUmap' ... (f ...) *) @@ -5913,7 +6175,7 @@ lemma f_swap_alpha: apply (erule eq_bij_betw_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_id supp_id_bound pick_prems suitable_prems | erule eq_bij_betw_prems | assumption)+ apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ @@ -5921,41 +6183,41 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) - apply (subst T1.rename_comps) + apply (rule alpha_refls) + apply (subst permute_raw_comps) apply (rule bij_id supp_id_bound pick_prems | erule eq_bij_betw_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_id supp_id_bound bij_comp pick_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems | assumption)+ apply ((rule suitable_prems)+)[4] apply (rule suitable'_prems)+ prefer 8 (* 3*nvars + 2 *) apply (rule trans) apply (rule IHs[THEN conjunct1]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) prefer 21 (* 5 * nvars + 2 * m + 3 *) apply (rule trans[rotated]) apply (rule PU2map'_alpha[THEN fun_cong, THEN fun_cong]) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule supp_id_bound bij_id pick'_prems)+ apply assumption apply (rule PUmap'_cong) - apply (rule T1.rename_comps[symmetric] T1.rename_ids) + apply (rule permute_raw_comps[symmetric] permute_raw_ids) apply (rule supp_id_bound bij_id h_prems pick'_prems)+ apply (subst if_P) apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+ apply (rule IHs[THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick'_prems h_prems)+ apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+ apply (rule suitable'_prems)+ apply (rule supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left])+ - apply (subst T1.rename_comps[symmetric] T1.rename_ids) + apply (subst permute_raw_comps[symmetric] permute_raw_ids) apply (rule supp_id_bound bij_id h_prems pick'_prems)+ - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule supp_id_bound bij_id pick'_prems)+ apply assumption apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick'_prems h_prems | assumption)+ @@ -5967,20 +6229,20 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left])+ - apply (subst T1.rename_comps) + apply (subst permute_raw_comps) apply (rule supp_id_bound bij_id supp_comp_bound bij_comp h_prems pick'_prems infinite_UNIV | erule eq_bij_betw_prems)+ - apply (rule T1.alpha_transs) + apply (rule alpha_trans) apply (unfold id_o o_id)[1] apply assumption apply (unfold comp_assoc[symmetric]) - apply (subst T1.rename_comps[symmetric]) + apply (subst permute_raw_comps[symmetric]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV h_prems pick'_prems | erule eq_bij_betw_prems)+ apply (unfold id_o o_id) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV pick'_prems | erule eq_bij_betw_prems)+ - apply (rule T1.alpha_syms) + apply (rule alpha_syms) apply assumption done qed @@ -6021,11 +6283,11 @@ lemma f_swap_alpha: _ _ "XXr2 pick1 pick2 pick3 pick4 f1 f2 p" ] note exists_bij_betws = exE[OF exists_bij_betw's(1)[ - of _ _ "\x. FVars_T21 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst x)) \ PFVars_1 p \ avoiding_set1" + of _ _ "\x. FVars_raw_T21 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst x)) \ PFVars_1 p \ avoiding_set1" "set5_T2_pre x", rotated 3 ]] exE[OF exists_bij_betw's(2)[ - of _ _ "\x. FVars_T22 (raw_T2_ctor (map_T2_pre id id id id id id fst fst fst fst x)) \ PFVars_2 p \ avoiding_set2" + of _ _ "\x. FVars_raw_T22 (raw_T2_ctor (map_T2_pre id id id id id id id fst fst fst fst x)) \ PFVars_2 p \ avoiding_set2" "set6_T2_pre x", rotated 3 ]] @@ -6038,7 +6300,7 @@ lemma f_swap_alpha: apply (rule conjI) apply (rule trans) (* mk_arg_cong npicks + 2 *) apply (rule arg_cong2[OF _ refl, of _ _ "f_T2 _ _ _ _"]) - apply (rule T1.rename_simps) + apply (rule permute_raw_simps) apply (rule f_prems)+ apply (rule trans) apply (rule f_T2_simp[OF suitable_prems valid] f_T1_simp[OF suitable_prems valid]) @@ -6046,7 +6308,7 @@ lemma f_swap_alpha: apply (subst T1_pre.map_comp T2_pre.map_comp) apply (rule f_prems supp_id_bound bij_id pick_prems)+ apply (unfold id_o o_id comp_def[of "\t. (_ t, _ t)"]) - apply (subst T1.rename_comps, (rule f_prems supp_id_bound bij_id pick_prems)+)+ + apply (subst permute_raw_comps, (rule f_prems supp_id_bound bij_id pick_prems)+)+ apply (unfold id_o o_id) apply (unfold XXr2_def[symmetric]) apply (rule refl) @@ -6078,7 +6340,7 @@ lemma f_swap_alpha: apply (rule supp_id_bound bij_id f_prems pick_prems)+ apply (unfold id_o o_id) apply (unfold comp_pair prod.case) - apply (subst T1.rename_comps, (rule supp_id_bound bij_id f_prems pick_prems)+)+ + apply (subst permute_raw_comps, (rule supp_id_bound bij_id f_prems pick_prems)+)+ apply (unfold id_o o_id) apply (rule trans) apply (rule arg_cong2[OF _ refl, of _ _ U2ctor']) @@ -6127,7 +6389,7 @@ lemma f_swap_alpha: apply (rule refl) (* END REPEAT_DETERM *) apply (rule f_prems supp_id_bound bij_comp pick_prems supp_comp_bound infinite_UNIV)+ - apply (rule refl) + apply (rule refl)+ apply (unfold XXl2_def[symmetric]) (* EVERY' (map ... exists_bij_betws) *) apply (rule exists_bij_betws(1)) @@ -6137,7 +6399,7 @@ lemma f_swap_alpha: apply (rule T2_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) @@ -6154,7 +6416,7 @@ lemma f_swap_alpha: apply (rule T2_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) @@ -6177,7 +6439,7 @@ lemma f_swap_alpha: apply (rule T2_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) @@ -6195,7 +6457,7 @@ lemma f_swap_alpha: apply (rule T2_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) @@ -6225,7 +6487,7 @@ lemma f_swap_alpha: apply (rule valid) apply (erule IHs[THEN conjunct1]) apply assumption - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems T1.alpha_refls)+ + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems alpha_refls)+ (* copied from above *) apply (erule XXl_U1FVars'_2[OF _ _ suitable_prems f_prems, rotated -1] XXl_U2FVars'_2[OF _ _ suitable_prems f_prems, rotated -1] @@ -6234,7 +6496,7 @@ lemma f_swap_alpha: apply (rule valid) apply (erule IHs[THEN conjunct1]) apply assumption - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems T1.alpha_refls)+ + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems alpha_refls)+ (* copied from above *) apply (erule XXl_U1FVars'_2[OF _ _ suitable_prems f_prems, rotated -1] XXl_U2FVars'_2[OF _ _ suitable_prems f_prems, rotated -1] @@ -6243,7 +6505,7 @@ lemma f_swap_alpha: apply (rule valid) apply (erule IHs[THEN conjunct1]) apply assumption - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems T1.alpha_refls)+ + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems alpha_refls)+ (* copied from above *) apply (erule XXl_U1FVars'_2[OF _ _ suitable_prems f_prems, rotated -1] XXl_U2FVars'_2[OF _ _ suitable_prems f_prems, rotated -1] @@ -6252,7 +6514,7 @@ lemma f_swap_alpha: apply (rule valid) apply (erule IHs[THEN conjunct1]) apply assumption - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems T1.alpha_refls)+ + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems alpha_refls)+ (* END REPEAT_DETERM *) apply (erule XXr_U1FVars'_2[OF _ _ suitable_prems f_prems] XXr_U2FVars'_2[OF _ _ suitable_prems f_prems] | assumption | rule valid)+ defer @@ -6324,6 +6586,55 @@ lemma f_swap_alpha: apply (rule sym) apply (erule eq_onD) apply assumption + (* orelse *) + apply (rule case_split[of "_ \ _"]) + (* 1. comp = id for bound *) + apply (unfold eq_bij_betw_refl_def)[1] + apply (erule conjE)+ + apply (rule inv_id_middle2) + apply (rule bij_comp f_prems pick_prems | assumption)+ + apply (rule sym) + apply (erule eq_onD) + apply assumption + (* 2. comp = id for free *) + apply (drule DiffI) + apply assumption + apply (rule inv_id_middle2) + apply (rule bij_comp f_prems pick_prems | erule eq_bij_betw_refl_prems | assumption)+ + apply (rule sym) + apply (unfold comp_assoc[symmetric])[1] + apply (rule trans) + apply (rule comp_apply) + apply (rule trans) + apply (rule arg_cong[of _ _ "_ \ _"]) + apply (rule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) x]] + id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) x]]) + apply assumption + apply (rotate_tac -1) + apply (rule trans[OF comp_apply]) + apply (rule trans) + apply (unfold eq_bij_betw_refl_def)[1] + apply (erule conjE)+ + apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ + apply (erule conjE)+ + apply (erule id_onD[rotated, OF imageI, of _ _ f1]) + apply assumption + apply (rule sym) + apply (rule comp_middle) + apply (unfold eq_bij_betw_refl_def)[1] + apply (erule conjE)+ + apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ + apply (erule conjE)+ + apply (erule id_onD[rotated, OF imageI]) + apply assumption + apply (erule id_onD[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) valid] imageI] + id_onD[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) valid] imageI] + id_onD[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) valid] imageI] + id_onD[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) valid] imageI] + id_onD[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) valid] imageI]) (* orelse *) apply (rule refl)+ (* end REPEAT_DETERM *) @@ -6337,11 +6648,11 @@ lemma f_swap_alpha: apply (unfold prod.case) apply (rule context_conjI) (* alpha_bij_tac *) - apply (rule T1.alpha_bijs) + apply (rule alpha_bijs) apply (erule eq_bij_betw_refl_prems)+ (* repeat twice *) - apply (rule ballI) - apply (unfold T1.FVars_renames[OF f_prems])[1] + apply (rule eq_onI) + apply (unfold FVars_raw_permutes[OF f_prems])[1] apply (erule imageE) apply hypsubst apply (unfold eq_bij_betw_refl_def)[1] @@ -6359,8 +6670,8 @@ lemma f_swap_alpha: apply (erule id_onD[rotated, OF imageI]) apply assumption (* copied from above *) - apply (rule ballI) - apply (unfold T1.FVars_renames[OF f_prems])[1] + apply (rule eq_onI) + apply (unfold FVars_raw_permutes[OF f_prems])[1] apply (erule imageE) apply hypsubst apply (unfold eq_bij_betw_refl_def)[1] @@ -6378,7 +6689,7 @@ lemma f_swap_alpha: apply (erule id_onD[rotated, OF imageI]) apply assumption (* end repeat twice *) - apply (rule T1.alpha_refls) + apply (rule alpha_refls) (* end alpha_bij_tac *) apply (rule allI) apply (rule impI) @@ -6390,13 +6701,13 @@ lemma f_swap_alpha: apply (rule PUmap'_cong) apply (rule refl) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_refl_prems)+ - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems T1.alpha_refls)+ + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems alpha_refls)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -6405,7 +6716,7 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule sym) apply (rule trans) apply (rule valid_PUmap'_If) @@ -6413,7 +6724,7 @@ lemma f_swap_alpha: apply (erule eq_bij_betw_refl_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -6422,16 +6733,16 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule IHs[THEN conjunct2]) - apply (subst T1.rename_comps) + apply (subst permute_raw_comps) apply (rule f_prems)+ apply (erule eq_bij_betw_refl_prems)+ - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_comp supp_comp_bound infinite_UNIV f_prems | erule eq_bij_betw_refl_prems)+ apply assumption apply (rule bij_id supp_id_bound suitable_prems imsupp_id_empty)+ - apply (rule T1.alpha_syms) + apply (rule alpha_syms) apply assumption (* orelse recursive binding set *) @@ -6439,13 +6750,13 @@ lemma f_swap_alpha: apply (unfold Grp_UNIV_def)[1] apply (rule refl) apply (unfold prod.case) - apply (subst T1.rename_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ + apply (subst permute_raw_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ apply (rule context_conjI) (* binding alpha_bij_tac *) - apply (rule T1.alpha_bijs) + apply (rule alpha_bijs) apply (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+ (* repeat twice *) - apply (rule ballI) + apply (rule eq_onI) apply (rule case_split[of "_ \ _"]) apply (unfold eq_bij_betw_refl_def)[1] apply (erule conjE)+ @@ -6456,12 +6767,18 @@ lemma f_swap_alpha: apply (rule comp_apply) apply (rule trans) apply (rule arg_cong[of _ _ "_ \ _"]) + apply (drule DiffI[rotated]) + apply (rule UN_I) + apply assumption + apply assumption apply (rule id_onD[OF pick_id_ons(2)[OF suitable_prems(2) x]] id_onD[OF pick_id_ons(1)[OF suitable_prems(1) x]] id_onD[OF pick_id_ons(3)[OF suitable_prems(3) x]] id_onD[OF pick_id_ons(4)[OF suitable_prems(4) x]]) - apply (rule DiffI) - apply (rule UN_I) - apply assumption+ + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption apply (drule DiffI[rotated]) apply (rule UN_I) apply assumption @@ -6474,7 +6791,7 @@ lemma f_swap_alpha: apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ apply (erule conjE)+ apply (rotate_tac -1) - apply (erule id_onD[rotated, OF imageI, of _ _ f2]) + apply (erule id_onD[rotated, OF imageI, of _ _ f1]) apply assumption apply (rule sym) apply (rule comp_middle) @@ -6490,9 +6807,12 @@ lemma f_swap_alpha: id_onD[OF pick_id_on_images(4)[rotated -2, OF suitable_prems(4) valid]]) apply (rule f_prems)+ apply (rule imageI) - apply assumption + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption (* copied from above *) - apply (rule ballI) + apply (rule eq_onI) apply (rule case_split[of "_ \ _"]) apply (unfold eq_bij_betw_refl_def)[1] apply (erule conjE)+ @@ -6510,10 +6830,12 @@ lemma f_swap_alpha: apply (rule arg_cong[of _ _ "_ \ _"]) apply (erule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) x]] id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) x]] - id_onD[OF pick_id_ons'(3)[OF suitable_prems(2) x]] - id_onD[OF pick_id_ons'(4)[OF suitable_prems(3) x]] + id_onD[OF pick_id_ons'(3)[OF suitable_prems(1) x]] + id_onD[OF pick_id_ons'(4)[OF suitable_prems(2) x]] id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) x]] - id_onD[OF pick_id_ons'(6)[OF suitable_prems(4) x]]) + id_onD[OF pick_id_ons'(6)[OF suitable_prems(3) x]] + id_onD[OF pick_id_ons'(7)[OF suitable_prems(3) x]] + id_onD[OF pick_id_ons'(8)[OF suitable_prems(4) x]]) apply (rule trans[OF comp_apply]) apply (rule trans) apply (unfold eq_bij_betw_refl_def)[1] @@ -6521,7 +6843,7 @@ lemma f_swap_alpha: apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ apply (erule conjE)+ apply (rotate_tac -1) - apply (erule id_onD[rotated, OF imageI, of _ _ f1]) + apply (erule id_onD[rotated, OF imageI, of _ _ f2]) apply assumption apply (rule sym) apply (rule comp_middle) @@ -6533,12 +6855,14 @@ lemma f_swap_alpha: apply assumption apply (erule id_onD[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) valid] imageI] id_onD[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) valid] imageI] - id_onD[OF pick_id_on_images'(3)[OF f_prems suitable_prems(2) valid] imageI] - id_onD[OF pick_id_on_images'(4)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) valid] imageI] + id_onD[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) valid] imageI] id_onD[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) valid] imageI] - id_onD[OF pick_id_on_images'(6)[OF f_prems suitable_prems(4) valid] imageI]) + id_onD[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) valid] imageI]) (* end repeat twice *) - apply (rule T1.alpha_refls) + apply (rule alpha_refls) (* end binding alpha_bij_tac *) apply (rule allI) apply (rule impI) @@ -6550,13 +6874,13 @@ lemma f_swap_alpha: apply (rule PUmap'_cong) apply (rule refl) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshapes T1.set_subshape_images[rotated -1, OF imageI]) - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems pick_prems T1.alpha_refls bij_imp_bij_inv supp_inv_bound | erule valid_Pmap eq_bij_betw_refl_prems)+ - apply (subst T1.rename_comps) + apply (erule set_subshapess set_subshape_permutess[rotated -1]) + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems pick_prems alpha_refls bij_imp_bij_inv supp_inv_bound | erule valid_Pmap eq_bij_betw_refl_prems)+ + apply (subst permute_raw_comps) apply (rule pick_prems f_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems bij_comp pick_prems supp_comp_bound infinite_UNIV | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -6565,7 +6889,7 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule sym) apply (rule trans) apply (rule valid_PUmap'_If) @@ -6573,7 +6897,7 @@ lemma f_swap_alpha: apply (erule eq_bij_betw_refl_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems bij_comp supp_comp_bound pick_prems infinite_UNIV | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -6582,17 +6906,17 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule IHs[THEN conjunct2]) - apply (subst T1.rename_comps) + apply (subst permute_raw_comps) apply (rule f_prems pick_prems bij_comp supp_comp_bound infinite_UNIV)+ apply (erule eq_bij_betw_refl_prems)+ - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_comp supp_comp_bound infinite_UNIV f_prems pick_prems | erule eq_bij_betw_refl_prems)+ apply assumption apply (rule bij_id supp_id_bound suitable_prems imsupp_id_empty)+ - apply (rule T1.alpha_syms) - apply (subst T1.rename_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ + apply (rule alpha_syms) + apply (subst permute_raw_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ apply assumption (* orelse nonbinding recursive set, again *) @@ -6602,11 +6926,11 @@ lemma f_swap_alpha: apply (unfold prod.case) apply (rule context_conjI) (* alpha_bij_tac *) - apply (rule T1.alpha_bijs) + apply (rule alpha_bijs) apply (erule eq_bij_betw_refl_prems)+ (* repeat twice *) - apply (rule ballI) - apply (unfold T1.FVars_renames[OF f_prems])[1] + apply (rule eq_onI) + apply (unfold FVars_raw_permutes[OF f_prems])[1] apply (erule imageE) apply hypsubst apply (unfold eq_bij_betw_refl_def)[1] @@ -6624,8 +6948,8 @@ lemma f_swap_alpha: apply (erule id_onD[rotated, OF imageI]) apply assumption (* copied from above *) - apply (rule ballI) - apply (unfold T1.FVars_renames[OF f_prems])[1] + apply (rule eq_onI) + apply (unfold FVars_raw_permutes[OF f_prems])[1] apply (erule imageE) apply hypsubst apply (unfold eq_bij_betw_refl_def)[1] @@ -6643,7 +6967,7 @@ lemma f_swap_alpha: apply (erule id_onD[rotated, OF imageI]) apply assumption (* end repeat twice *) - apply (rule T1.alpha_refls) + apply (rule alpha_refls) (* end alpha_bij_tac *) apply (rule allI) apply (rule impI) @@ -6655,13 +6979,13 @@ lemma f_swap_alpha: apply (rule PUmap'_cong) apply (rule refl) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_refl_prems)+ - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems T1.alpha_refls)+ + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems alpha_refls)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -6670,7 +6994,7 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule sym) apply (rule trans) apply (rule valid_PUmap'_If) @@ -6678,7 +7002,7 @@ lemma f_swap_alpha: apply (erule eq_bij_betw_refl_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -6687,16 +7011,16 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule IHs[THEN conjunct2]) - apply (subst T1.rename_comps) + apply (subst permute_raw_comps) apply (rule f_prems)+ apply (erule eq_bij_betw_refl_prems)+ - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_comp supp_comp_bound infinite_UNIV f_prems | erule eq_bij_betw_refl_prems)+ apply assumption apply (rule bij_id supp_id_bound suitable_prems imsupp_id_empty)+ - apply (rule T1.alpha_syms) + apply (rule alpha_syms) apply assumption (* orelse binding recursive set, again *) @@ -6704,30 +7028,14 @@ lemma f_swap_alpha: apply (unfold Grp_UNIV_def)[1] apply (rule refl) apply (unfold prod.case) - apply (subst T1.rename_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ + apply (subst permute_raw_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ apply (rule context_conjI) (* binding alpha_bij_tac *) - apply (rule T1.alpha_bijs) + apply (rule alpha_bijs) apply (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+ -(* nonbinding recursive occurence *) - apply (rule ballI) - apply (subst comp_def)+ - apply (unfold eq_bij_betw_refl_def)[1] - apply (erule conjE)+ - apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ - apply (erule conjE)+ - apply (drule UN_I) - apply assumption - apply (rotate_tac -1) - apply (rule trans) - apply (erule id_onD[rotated, OF imageI, of _ _ f2]) - apply assumption - apply (rule sym) - apply (erule id_onD[rotated, OF imageI]) - apply assumption (* copied from above, binding case *) - apply (rule ballI) + apply (rule eq_onI) apply (rule case_split[of "_ \ _"]) apply (unfold eq_bij_betw_refl_def)[1] apply (erule conjE)+ @@ -6745,10 +7053,12 @@ lemma f_swap_alpha: apply (rule arg_cong[of _ _ "_ \ _"]) apply (erule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) x]] id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) x]] - id_onD[OF pick_id_ons'(3)[OF suitable_prems(2) x]] - id_onD[OF pick_id_ons'(4)[OF suitable_prems(3) x]] + id_onD[OF pick_id_ons'(3)[OF suitable_prems(1) x]] + id_onD[OF pick_id_ons'(4)[OF suitable_prems(2) x]] id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) x]] - id_onD[OF pick_id_ons'(6)[OF suitable_prems(4) x]]) + id_onD[OF pick_id_ons'(6)[OF suitable_prems(3) x]] + id_onD[OF pick_id_ons'(7)[OF suitable_prems(3) x]] + id_onD[OF pick_id_ons'(8)[OF suitable_prems(4) x]]) apply (rule trans[OF comp_apply]) apply (rule trans) apply (unfold eq_bij_betw_refl_def)[1] @@ -6768,12 +7078,30 @@ lemma f_swap_alpha: apply assumption apply (erule id_onD[OF pick_id_on_images'(1)[OF f_prems suitable_prems(1) valid] imageI] id_onD[OF pick_id_on_images'(2)[OF f_prems suitable_prems(1) valid] imageI] - id_onD[OF pick_id_on_images'(3)[OF f_prems suitable_prems(2) valid] imageI] - id_onD[OF pick_id_on_images'(4)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(3)[OF f_prems suitable_prems(1) valid] imageI] + id_onD[OF pick_id_on_images'(4)[OF f_prems suitable_prems(2) valid] imageI] id_onD[OF pick_id_on_images'(5)[OF f_prems suitable_prems(3) valid] imageI] - id_onD[OF pick_id_on_images'(6)[OF f_prems suitable_prems(4) valid] imageI]) + id_onD[OF pick_id_on_images'(6)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(7)[OF f_prems suitable_prems(3) valid] imageI] + id_onD[OF pick_id_on_images'(8)[OF f_prems suitable_prems(4) valid] imageI]) + (* nonbinding recursive occurence *) + apply (rule eq_onI) + apply (subst comp_def)+ + apply (unfold eq_bij_betw_refl_def)[1] + apply (erule conjE)+ + apply (drule imsupp_id_on_XX[OF valid suitable_prems f_prems])+ + apply (erule conjE)+ + apply (drule UN_I) + apply assumption + apply (rotate_tac -1) + apply (rule trans) + apply (erule id_onD[rotated, OF imageI, of _ _ f2]) + apply assumption + apply (rule sym) + apply (erule id_onD[rotated, OF imageI]) + apply assumption (* end repeat twice *) - apply (rule T1.alpha_refls) + apply (rule alpha_refls) (* end binding alpha_bij_tac *) apply (rule allI) apply (rule impI) @@ -6785,14 +7113,14 @@ lemma f_swap_alpha: apply (rule PUmap'_cong) apply (rule refl) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshapes T1.set_subshape_images[rotated -1, OF imageI]) - apply (rule suitable_prems suitable'_prems f_prems imsupp_prems pick_prems bij_id supp_id_bound T1.alpha_refls bij_imp_bij_inv supp_inv_bound | erule valid_Pmap eq_bij_betw_refl_prems)+ - apply (subst T1.rename_comps) + apply (erule set_subshapess set_subshape_permutess[rotated -1]) + apply (rule suitable_prems suitable'_prems f_prems imsupp_prems pick_prems bij_id supp_id_bound alpha_refls bij_imp_bij_inv supp_inv_bound | erule valid_Pmap eq_bij_betw_refl_prems)+ + apply (subst permute_raw_comps) apply (rule pick_prems f_prems bij_id supp_id_bound)+ apply (unfold id_o o_id) apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems bij_comp pick_prems supp_comp_bound infinite_UNIV | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -6801,7 +7129,7 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule sym) apply (rule trans) apply (rule valid_PUmap'_If) @@ -6809,7 +7137,7 @@ lemma f_swap_alpha: apply (erule eq_bij_betw_refl_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule suitable_prems suitable'_prems f_prems bij_comp supp_comp_bound pick_prems infinite_UNIV | assumption)+ apply (erule eq_bij_betw_refl_prems)+ apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] @@ -6818,17 +7146,17 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_refl_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule IHs[THEN conjunct2]) - apply (subst T1.rename_comps) + apply (subst permute_raw_comps) apply (rule f_prems pick_prems bij_comp supp_comp_bound infinite_UNIV)+ apply (erule eq_bij_betw_refl_prems)+ - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_comp supp_comp_bound infinite_UNIV f_prems pick_prems | erule eq_bij_betw_refl_prems)+ apply assumption apply (rule supp_id_bound bij_id suitable_prems imsupp_id_empty)+ - apply (rule T1.alpha_syms) - apply (subst T1.rename_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ + apply (rule alpha_syms) + apply (subst permute_raw_comps, (rule bij_comp supp_comp_bound infinite_UNIV pick_prems f_prems | erule eq_bij_betw_refl_prems)+)+ apply assumption (**********************************************************************************************) (* f picks t = f picks' t' *) @@ -6838,37 +7166,37 @@ lemma f_swap_alpha: proof - note exists_bij_betw2s = exists_bij_betw_def[OF _ _ pick_prems(5) pick'_prems(5) h_prems(1), of _ set5_T2_pre _ _ set5_T2_pre - "\x. map_T2_pre id id id id id id fst fst fst fst ( - map_T2_pre id id id id (pick3' x' p) (pick4' x' p) + "\x. map_T2_pre id id id id id id id fst fst fst fst ( + map_T2_pre id id id id (pick3' x' p) (pick4' x' p) (pick3' x' p) (\t. (t, \p'. if validP p' then f_T1 pick1' pick2' pick3' pick4' t p' else undefined)) - (\t. (rename_T1 (pick3' x' p) (pick4' x' p) t, \p'. if validP p' then f_T1 pick1' pick2' pick3' pick4' (rename_T1 (pick3' x' p) (pick4' x' p) t) p' else undefined)) + (\t. (permute_raw_T1 (pick3' x' p) (pick4' x' p) t, \p'. if validP p' then f_T1 pick1' pick2' pick3' pick4' (permute_raw_T1 (pick3' x' p) (pick4' x' p) t) p' else undefined)) (\t. (t, \p'. if validP p' then f_T2 pick1' pick2' pick3' pick4' t p' else undefined)) - (\t. (rename_T2 (pick3' x' p) id t, \p'. if validP p' then f_T2 pick1' pick2' pick3' pick4' (rename_T2 (pick3' x' p) id t) p' else undefined)) + (\t. (permute_raw_T2 (pick3' x' p) id t, \p'. if validP p' then f_T2 pick1' pick2' pick3' pick4' (permute_raw_T2 (pick3' x' p) id t) p' else undefined)) x)" - "\x. FVars_T21 (raw_T2_ctor x) \ PFVars_1 p \ avoiding_set1" - _ "\x'. map_T2_pre id id id id id id fst fst fst fst ( - map_T2_pre id id id id (pick3 x p) (pick4 x p) + "\x. FVars_raw_T21 (raw_T2_ctor x) \ PFVars_1 p \ avoiding_set1" + _ "\x'. map_T2_pre id id id id id id id fst fst fst fst ( + map_T2_pre id id id id (pick3 x p) (pick4 x p) (pick3 x p) (\t. (t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T1 (pick3 x p) (pick4 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (rename_T1 (pick3 x p) (pick4 x p) t) p' else undefined)) + (\t. (permute_raw_T1 (pick3 x p) (pick4 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 (pick3 x p) (pick4 x p) t) p' else undefined)) (\t. (t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T2 (pick3 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (rename_T2 (pick3 x p) id t) p' else undefined)) + (\t. (permute_raw_T2 (pick3 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 (pick3 x p) id t) p' else undefined)) x')" ] exists_bij_betw_def[OF _ _ pick_prems(7) pick'_prems(7) h_prems(3), of _ set6_T2_pre _ _ set6_T2_pre - "\x. map_T2_pre id id id id id id fst fst fst fst ( - map_T2_pre id id id id (pick3' x' p) (pick4' x' p) + "\x. map_T2_pre id id id id id id id fst fst fst fst ( + map_T2_pre id id id id (pick3' x' p) (pick4' x' p) (pick3' x' p) (\t. (t, \p'. if validP p' then f_T1 pick1' pick2' pick3' pick4' t p' else undefined)) - (\t. (rename_T1 (pick3' x' p) (pick4' x' p) t, \p'. if validP p' then f_T1 pick1' pick2' pick3' pick4' (rename_T1 (pick3' x' p) (pick4' x' p) t) p' else undefined)) + (\t. (permute_raw_T1 (pick3' x' p) (pick4' x' p) t, \p'. if validP p' then f_T1 pick1' pick2' pick3' pick4' (permute_raw_T1 (pick3' x' p) (pick4' x' p) t) p' else undefined)) (\t. (t, \p'. if validP p' then f_T2 pick1' pick2' pick3' pick4' t p' else undefined)) - (\t. (rename_T2 (pick3' x' p) id t, \p'. if validP p' then f_T2 pick1' pick2' pick3' pick4' (rename_T2 (pick3' x' p) id t) p' else undefined)) + (\t. (permute_raw_T2 (pick3' x' p) id t, \p'. if validP p' then f_T2 pick1' pick2' pick3' pick4' (permute_raw_T2 (pick3' x' p) id t) p' else undefined)) x)" - "\x. FVars_T22 (raw_T2_ctor x) \ PFVars_2 p \ avoiding_set2" - _ "\x'. map_T2_pre id id id id id id fst fst fst fst ( - map_T2_pre id id id id (pick3 x p) (pick4 x p) + "\x. FVars_raw_T22 (raw_T2_ctor x) \ PFVars_2 p \ avoiding_set2" + _ "\x'. map_T2_pre id id id id id id id fst fst fst fst ( + map_T2_pre id id id id (pick3 x p) (pick4 x p) (pick3 x p) (\t. (t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T1 (pick3 x p) (pick4 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (rename_T1 (pick3 x p) (pick4 x p) t) p' else undefined)) + (\t. (permute_raw_T1 (pick3 x p) (pick4 x p) t, \p'. if validP p' then f_T1 pick1 pick2 pick3 pick4 (permute_raw_T1 (pick3 x p) (pick4 x p) t) p' else undefined)) (\t. (t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 t p' else undefined)) - (\t. (rename_T2 (pick3 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (rename_T2 (pick3 x p) id t) p' else undefined)) + (\t. (permute_raw_T2 (pick3 x p) id t, \p'. if validP p' then f_T2 pick1 pick2 pick3 pick4 (permute_raw_T2 (pick3 x p) id t) p' else undefined)) x')" ] show ?thesis @@ -6885,13 +7213,13 @@ lemma f_swap_alpha: apply (rule T2_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) (* end bound_tac *) - apply (subst T1.alpha_FVarss) - apply (rule T1.alpha_syms) + apply (subst alpha_FVars) + apply (rule alpha_syms) apply (rule alpha_ctor_picks[OF suitable'_prems valid]) apply (subst T2_pre.map_comp) apply (rule supp_id_bound pick'_prems bij_id)+ @@ -6913,13 +7241,13 @@ lemma f_swap_alpha: apply (rule T2_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) (* end bound_tac *) - apply (subst T1.alpha_FVarss) - apply (rule T1.alpha_syms) + apply (subst alpha_FVars) + apply (rule alpha_syms) apply (rule alpha_ctor_picks[OF suitable_prems valid]) apply (subst T2_pre.map_comp) apply (rule supp_id_bound pick_prems bij_id)+ @@ -6951,13 +7279,13 @@ lemma f_swap_alpha: apply (rule T2_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) (* end bound_tac *) - apply (subst T1.alpha_FVarss) - apply (rule T1.alpha_syms) + apply (subst alpha_FVars) + apply (rule alpha_syms) apply (rule alpha_ctor_picks[OF suitable'_prems valid]) apply (subst T2_pre.map_comp) apply (rule supp_id_bound pick'_prems bij_id)+ @@ -6979,13 +7307,13 @@ lemma f_swap_alpha: apply (rule T2_pre.set_bd_UNIV) apply (rule T1_pre.Un_bound) apply (rule T1_pre.Un_bound) - apply (rule T1.card_of_FVars_bounds) + apply (rule FVars_raw_bd_UNIVs) apply (rule small_PFVars_1 small_PFVars_2) apply (rule valid) apply (rule small_avoiding_set1 small_avoiding_set2) (* end bound_tac *) - apply (subst T1.alpha_FVarss) - apply (rule T1.alpha_syms) + apply (subst alpha_FVars) + apply (rule alpha_syms) apply (rule alpha_ctor_picks[OF suitable_prems valid]) apply (subst T2_pre.map_comp) apply (rule supp_id_bound pick_prems bij_id)+ @@ -7236,7 +7564,7 @@ lemma f_swap_alpha: apply (rule supp_id_bound bij_id pick_prems pick'_prems supp_comp_bound supp_inv_bound infinite_UNIV bij_comp bij_imp_bij_inv | erule eq_bij_betw_prems)+ apply (unfold id_o o_id inv_id Grp_UNIV_id OO_eq conversep_eq) apply (rule T2_pre.mr_rel_mono_strong0) - prefer 15 (* 2 * (free + 2 * bound) + 1) *) + prefer 17 (* 2 * (free + 2 * bound) + 1) *) apply (rule prems) apply (rule supp_id_bound bij_id h_prems supp_comp_bound supp_inv_bound infinite_UNIV bij_comp bij_imp_bij_inv pick_prems pick'_prems | erule eq_bij_betw_prems)+ (* REPEAT FIRST' *) @@ -7250,23 +7578,23 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ - apply (unfold T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + apply (unfold alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] )[1] apply (rule trans) apply (rule arg_cong[of _ _ "inv _"]) apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply (erule id_onD[OF id_on_inv, rotated]) apply (rule UnI1) apply (rule UnI1) apply (subst (asm) T2_pre.mr_rel_set(1-2,5-6)[rotated -1, OF mr_rel_prem, unfolded image_id, symmetric]) apply (rule supp_id_bound bij_id h_prems)+ - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption (* copied from above *) apply (rule ballI) @@ -7278,23 +7606,23 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ - apply (unfold T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + apply (unfold alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] )[1] apply (rule trans) apply (rule arg_cong[of _ _ "inv _"]) apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply (erule id_onD[OF id_on_inv, rotated]) apply (rule UnI1) apply (rule UnI1) apply (subst (asm) T2_pre.mr_rel_set(1-2,5-6)[rotated -1, OF mr_rel_prem, unfolded image_id, symmetric]) apply (rule supp_id_bound bij_id h_prems)+ - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption (* orelse *) apply (rule ballI) @@ -7340,6 +7668,93 @@ lemma f_swap_alpha: apply assumption apply (unfold comp_def)[1] apply (rule refl) + (* orelse bound free set *) + apply (rule ballI) + apply (rule case_split[of "_ \ _"]) + apply (unfold comp_assoc[symmetric])[1] + apply (subst o_inv_distrib[symmetric]) + apply (erule eq_bij_betw_prems) + apply (rule pick'_prems) + apply (unfold comp_assoc)[1] + apply (rule sym) + apply (rule trans) + apply (rule comp_apply) + apply (rule iffD2[OF bij_imp_inv']) + apply (rule bij_comp pick'_prems | erule eq_bij_betw_prems)+ + apply (rule trans[rotated]) + apply (unfold eq_bij_betw_def)[1] + apply (erule conjE eq_onD)+ + apply assumption + apply (unfold comp_def)[1] + apply (rule refl) + apply (drule DiffI) + apply assumption + apply (rule trans) + apply (rule h_id_ons[THEN id_onD]) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + apply (rule sym) + apply (rule trans) + apply (rule comp_apply) + apply (rule iffD2[OF bij_imp_inv']) + apply (rule pick'_prems) + apply (rule trans) + apply (rule id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]]) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (rule arg_cong2[of _ _ _ _ minus]) + apply (rule T2_pre.mr_rel_set(1-3,5-7)[rotated -1, OF mr_rel_prem], (rule supp_id_bound bij_id h_prems)+)+ + apply (subst image_set_diff[symmetric, OF bij_is_inj]) + apply (rule h_prems) + apply (subst id_on_image) + apply (rule h_id_ons[THEN id_on_antimono]) + apply (rule subsetI) + apply (rotate_tac -1) + apply (erule contrapos_pp) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply assumption + apply assumption + apply (rule sym) + apply (rule trans[OF comp_apply]) + apply (rule trans) + apply (rule arg_cong[of _ _ "_ \ _"]) + apply (rule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]]) + apply assumption + apply (rule trans) + apply (rule comp_apply) + apply (unfold eq_bij_betw_def)[1] + apply (erule conjE)+ + apply (unfold alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + )[1] + apply (subst (asm) T2_pre.set_map, (rule supp_id_bound bij_id pick_prems pick'_prems | assumption)+)+ + apply (unfold image_id) + apply (rule trans) + apply (rule arg_cong[of _ _ "inv _"]) + apply (erule imsupp_id_on[THEN id_onD]) + apply (rule UnI1)+ + apply (erule DiffE) + apply (erule FVars_raw_intros) + apply assumption + apply (erule imsupp_id_on[THEN id_on_inv[rotated, THEN id_onD]]) + apply assumption + apply (rule UnI1)+ + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (rule alpha_FVars) + apply (rule alpha_syms) + apply (rule alpha_T1_alpha_T2.intros[rotated -1]) + apply (rule mr_rel_prem) + apply (rule h_prems h_id_ons)+ + apply (erule DiffE) + apply (erule FVars_raw_intros) + apply assumption (* orelse nonbinding rec set *) apply (rule ballI impI)+ apply (rule relcomppI) @@ -7352,15 +7767,15 @@ lemma f_swap_alpha: apply (unfold prod.case) apply (rule context_conjI) (* alpha_bij_tac *) - apply (rule T1.alpha_bijs[rotated -1]) - apply (assumption | rule T1.alpha_refls) + apply (rule alpha_bijs[rotated -1]) + apply (assumption | rule alpha_refls) apply (erule eq_bij_betw_prems)+ (* REPEAT_DETERM *) - apply (rule ballI) - apply (unfold eq_bij_betw_def T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + apply (rule eq_onI) + apply (unfold eq_bij_betw_def alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] )[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -7368,24 +7783,24 @@ lemma f_swap_alpha: apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption apply (rule sym) apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply assumption apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply assumption (* copied from above *) - apply (rule ballI) - apply (unfold eq_bij_betw_def T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + apply (rule eq_onI) + apply (unfold eq_bij_betw_def alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] )[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -7393,17 +7808,17 @@ lemma f_swap_alpha: apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption apply (rule sym) apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply assumption apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply assumption (* end alpha_bij_tac *) apply (rule allI) @@ -7416,7 +7831,7 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply assumption apply (rule suitable_prems)+ apply assumption+ @@ -7426,14 +7841,14 @@ lemma f_swap_alpha: apply (unfold Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule trans) apply (rule IHs[THEN conjunct2, OF _ _ suitable_prems suitable'_prems]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) prefer 13 (* 5*nvars + 3 *) apply (rule trans) apply (rule IHs[THEN conjunct1, OF _ _ suitable'_prems suitable'_prems]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply assumption prefer 8 apply (rule trans) @@ -7445,7 +7860,7 @@ lemma f_swap_alpha: apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+ apply (rule IHs[THEN conjunct2, OF _ _ suitable'_prems suitable'_prems]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply (erule valid_Pmap; (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+) apply (rule supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left])+ apply assumption @@ -7453,11 +7868,11 @@ lemma f_swap_alpha: apply (((unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1], (erule conjE)+, assumption)+)[2] apply assumption apply (rule bij_id supp_id_bound imsupp_id_empty | erule eq_bij_betw_prems | assumption)+ - apply (rule T1.alpha_transs) + apply (rule alpha_trans) apply assumption - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (erule eq_bij_betw_prems)+ - apply (rule T1.alpha_syms) + apply (rule alpha_syms) apply assumption (* orelse binding rec set *) @@ -7469,11 +7884,11 @@ lemma f_swap_alpha: apply (rule refl) apply (unfold prod.case) apply (rule context_conjI) - apply (subst T1.rename_comps, (rule pick_prems pick'_prems | erule eq_bij_betw_prems)+)+ - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bijs[rotated -3]) (* -1 - nvars *) + apply (subst permute_raw_comps, (rule pick_prems pick'_prems | erule eq_bij_betw_prems)+)+ + apply (rule alpha_trans) + apply (rule alpha_bijs[rotated -3]) (* -1 - nvars *) (* REPEAT_DETERM *) - apply (rule ballI) + apply (rule eq_onI) apply (rule sym) apply (rule case_split[of "_ \ _"]) apply (unfold eq_bij_betw_def)[1] @@ -7492,8 +7907,8 @@ lemma f_swap_alpha: apply (rule id_on_comp3) apply (erule id_onD[rotated]) apply assumption - apply (drule T1.FVars_renames[symmetric, OF h_prems, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], OF imageI]) - apply (drule T1.alpha_FVarss[THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated]) + apply (drule FVars_raw_permutes[symmetric, OF h_prems, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], OF imageI]) + apply (drule alpha_FVars[THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated]) apply assumption apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T2_pre.mr_rel_set(5,6)[rotated -1, OF iffD2[OF T2_pre.mr_rel_flip mr_rel_prem]]) @@ -7508,13 +7923,16 @@ lemma f_swap_alpha: apply (rule UN_I) prefer 3 apply (rotate_tac -1) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] - id_onD[OF pick_id_ons'(2)[OF suitable'_prems(1) valid]] - id_onD[OF pick_id_ons'(3)[OF suitable'_prems(2) valid]] - id_onD[OF pick_id_ons'(4)[OF suitable'_prems(3) valid]] - id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]] - id_onD[OF pick_id_ons'(6)[OF suitable'_prems(4) valid]] - ) + apply (erule + id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(2)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(3)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(4)[OF suitable'_prems(2) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(6)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(7)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(8)[OF suitable'_prems(4) valid]] + ) apply assumption apply assumption apply (rule h_prems) @@ -7526,23 +7944,27 @@ lemma f_swap_alpha: apply (rule UnI1) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_ctor_picks[OF suitable'_prems valid]) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_T1_alpha_T2.intros[rotated -1]) apply (rule mr_rel_prem h_prems h_id_ons)+ - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption+ apply (rule sym) apply (rule id_on_comp2) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] - id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] - id_onD[OF pick_id_ons'(3)[OF suitable_prems(2) valid]] - id_onD[OF pick_id_ons'(4)[OF suitable_prems(3) valid]] - id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] - id_onD[OF pick_id_ons'(6)[OF suitable_prems(4) valid]]) + apply (erule + id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(3)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(4)[OF suitable_prems(2) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(6)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(7)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(8)[OF suitable_prems(4) valid]] + ) apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -7551,12 +7973,12 @@ lemma f_swap_alpha: apply (rule UnI1) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_ctor_picks[OF suitable_prems valid]) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption+ (* copied from above *) - apply (rule ballI) + apply (rule eq_onI) apply (rule sym) apply (rule case_split[of "_ \ _"]) apply (unfold eq_bij_betw_def)[1] @@ -7575,8 +7997,8 @@ lemma f_swap_alpha: apply (rule id_on_comp3) apply (erule id_onD[rotated]) apply assumption - apply (drule T1.FVars_renames[symmetric, OF h_prems, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], OF imageI]) - apply (drule T1.alpha_FVarss[THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated]) + apply (drule FVars_raw_permutes[symmetric, OF h_prems, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], OF imageI]) + apply (drule alpha_FVars[THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated]) apply assumption apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T2_pre.mr_rel_set(5,6)[rotated -1, OF iffD2[OF T2_pre.mr_rel_flip mr_rel_prem]]) @@ -7591,13 +8013,16 @@ lemma f_swap_alpha: apply (rule UN_I) prefer 3 apply (rotate_tac -1) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] - id_onD[OF pick_id_ons'(2)[OF suitable'_prems(1) valid]] - id_onD[OF pick_id_ons'(3)[OF suitable'_prems(2) valid]] - id_onD[OF pick_id_ons'(4)[OF suitable'_prems(3) valid]] - id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]] - id_onD[OF pick_id_ons'(6)[OF suitable'_prems(4) valid]] - ) + apply (erule + id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(2)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(3)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(4)[OF suitable'_prems(2) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(6)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(7)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(8)[OF suitable'_prems(4) valid]] + ) apply assumption apply assumption apply (unfold eq_bij_betw_def)[1] @@ -7608,23 +8033,27 @@ lemma f_swap_alpha: apply (rule UnI1) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_ctor_picks[OF suitable'_prems valid]) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_T1_alpha_T2.intros[rotated -1]) apply (rule mr_rel_prem h_prems h_id_ons)+ - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption+ apply (rule sym) apply (rule id_on_comp2) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] - id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] - id_onD[OF pick_id_ons'(3)[OF suitable_prems(2) valid]] - id_onD[OF pick_id_ons'(4)[OF suitable_prems(3) valid]] - id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] - id_onD[OF pick_id_ons'(6)[OF suitable_prems(4) valid]]) + apply (erule + id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(3)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(4)[OF suitable_prems(2) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(6)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(7)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(8)[OF suitable_prems(4) valid]] + ) apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -7633,17 +8062,17 @@ lemma f_swap_alpha: apply (rule UnI1) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_ctor_picks[OF suitable_prems valid]) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption+ (* end repeat *) - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule bij_comp pick_prems pick'_prems supp_comp_bound infinite_UNIV h_prems | erule eq_bij_betw_prems)+ apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ alpha_T1]]) - apply (rule T1.rename_comps[symmetric]) + apply (rule permute_raw_comps[symmetric]) apply (rule h_prems bij_comp pick'_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems)+ - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule h_prems bij_comp pick'_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems)+ apply assumption (* PUmap' ... (f ...) = PUmap' ... (f ...) *) @@ -7655,7 +8084,7 @@ lemma f_swap_alpha: apply (erule eq_bij_betw_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule pick_prems suitable_prems | erule eq_bij_betw_prems | assumption)+ apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ @@ -7663,30 +8092,30 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) - apply (subst T1.rename_comps) + apply (rule alpha_refls) + apply (subst permute_raw_comps) apply (rule pick_prems | erule eq_bij_betw_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_comp pick_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems)+ apply assumption apply ((rule suitable_prems)+)[4] apply (rule suitable'_prems)+ prefer 7 (* 3*nvars + 1 *) - apply (subst (asm) T1.rename_comps, (rule pick_prems pick'_prems | erule eq_bij_betw_prems)+)+ - apply (rule T1.alpha_transs) + apply (subst (asm) permute_raw_comps, (rule pick_prems pick'_prems | erule eq_bij_betw_prems)+)+ + apply (rule alpha_trans) apply assumption - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule bij_comp pick_prems pick'_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems)+ - apply (rule T1.alpha_syms) + apply (rule alpha_syms) apply assumption prefer 7 (* 7*nvars + 1 *) - apply (subst T1.rename_comps[symmetric], (rule pick_prems pick'_prems | erule eq_bij_betw_prems)+)+ + apply (subst permute_raw_comps[symmetric], (rule pick_prems pick'_prems | erule eq_bij_betw_prems)+)+ apply (rule trans) apply (rule IHs[THEN conjunct1]) - apply (subst T1.rename_comps, (rule pick_prems pick'_prems h_prems)+)+ - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (subst permute_raw_comps, (rule pick_prems pick'_prems h_prems)+)+ + apply (erule set_subshape_permutess[rotated -1]) apply (rule h_prems suitable'_prems bij_comp pick_prems pick'_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems | assumption)+ apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ @@ -7694,10 +8123,10 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule trans) apply (rule fun_cong[OF fun_cong[OF PU1map'_alpha]]) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule pick'_prems)+ apply assumption apply (rule PUmap'_cong) @@ -7706,10 +8135,10 @@ lemma f_swap_alpha: apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+ apply (rule IHs[THEN conjunct2]) - apply (subst T1.rename_comps, (rule pick_prems pick'_prems h_prems)+)+ - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (subst permute_raw_comps, (rule pick_prems pick'_prems h_prems)+)+ + apply (erule set_subshape_permutess[rotated -1]) apply (rule supp_id_bound bij_id h_prems suitable'_prems bij_comp pick_prems pick'_prems supp_comp_bound infinite_UNIV trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left] bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems valid_Pmap)+ - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule pick'_prems)+ apply assumption apply (rule supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left])+ @@ -7726,15 +8155,15 @@ lemma f_swap_alpha: apply (unfold prod.case) apply (rule context_conjI) (* alpha_bij_tac *) - apply (rule T1.alpha_bijs[rotated -1]) - apply (assumption | rule T1.alpha_refls) + apply (rule alpha_bijs[rotated -1]) + apply (assumption | rule alpha_refls) apply (erule eq_bij_betw_prems)+ (* REPEAT_DETERM *) - apply (rule ballI) - apply (unfold eq_bij_betw_def T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + apply (rule eq_onI) + apply (unfold eq_bij_betw_def alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] )[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -7742,24 +8171,24 @@ lemma f_swap_alpha: apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption apply (rule sym) apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply assumption apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply assumption (* copied from above *) - apply (rule ballI) - apply (unfold eq_bij_betw_def T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1,3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + apply (rule eq_onI) + apply (unfold eq_bij_betw_def alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(1,2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(3,4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] )[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -7767,17 +8196,17 @@ lemma f_swap_alpha: apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption apply (rule sym) apply (erule id_onD) apply (rule UnI1) apply (rule UnI1) - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply assumption apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply assumption (* end alpha_bij_tac *) apply (rule allI) @@ -7790,7 +8219,7 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply assumption apply (rule suitable_prems)+ apply assumption+ @@ -7800,14 +8229,14 @@ lemma f_swap_alpha: apply (unfold Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule trans) apply (rule IHs[THEN conjunct2, OF _ _ suitable_prems suitable'_prems]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) prefer 13 (* 5*nvars + 3 *) apply (rule trans) apply (rule IHs[THEN conjunct1, OF _ _ suitable'_prems suitable'_prems]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply assumption prefer 8 apply (rule trans) @@ -7819,7 +8248,7 @@ lemma f_swap_alpha: apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+ apply (rule IHs[THEN conjunct2, OF _ _ suitable'_prems suitable'_prems]) - apply (erule T1.set_subshapes) + apply (erule set_subshapess) apply (erule valid_Pmap; (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+) apply (rule supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left])+ apply assumption @@ -7827,11 +8256,11 @@ lemma f_swap_alpha: apply (((unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1], (erule conjE)+, assumption)+)[2] apply assumption apply (rule bij_id supp_id_bound imsupp_id_empty | erule eq_bij_betw_prems | assumption)+ - apply (rule T1.alpha_transs) + apply (rule alpha_trans) apply assumption - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (erule eq_bij_betw_prems)+ - apply (rule T1.alpha_syms) + apply (rule alpha_syms) apply assumption (* orelse binding rec set, again *) @@ -7842,39 +8271,13 @@ lemma f_swap_alpha: apply (unfold Grp_UNIV_def conversep_def)[1] apply (rule refl) apply (unfold prod.case) - apply (subst T1.rename_comps, (rule pick_prems pick'_prems bij_id supp_id_bound | erule eq_bij_betw_prems)+)+ + apply (subst permute_raw_comps, (rule pick_prems pick'_prems bij_id supp_id_bound | erule eq_bij_betw_prems)+)+ apply (unfold id_o o_id) apply (rule context_conjI) - apply (rule T1.alpha_transs) - apply (rule T1.alpha_bijs[rotated -3]) (* -1 - nvars *) + apply (rule alpha_trans) + apply (rule alpha_bijs[rotated -3]) (* -1 - nvars *) (* REPEAT_DETERM *) - apply (rule ballI) - apply (unfold eq_bij_betw_def)[1] - apply (erule conjE)+ - apply (subst (asm) - T1.alpha_FVarss(1)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(2)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(3)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] - T1.alpha_FVarss(1)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(2)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(3)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] - T1.alpha_FVarss(4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric])+ - apply (drule imsupp_id_on)+ - apply (erule id_on_eq) - prefer 2 - apply (rule arg_cong2[OF _ refl, of _ _ "(\)"])+ - apply (rule T1.alpha_FVarss) - apply (rule alpha_T1_alpha_T2.intros[rotated -1]) - apply (rule mr_rel_prem) - apply (rule h_prems h_id_ons)+ - apply assumption - apply (rule UnI1) - apply (rule UnI1) - apply (erule T1.FVars_intros) - apply assumption - (* orelse *) - apply (rule ballI) + apply (rule eq_onI) apply (rule sym) apply (rule case_split[of "_ \ _"]) apply (unfold eq_bij_betw_def)[1] @@ -7893,10 +8296,10 @@ lemma f_swap_alpha: apply (rule id_on_comp3) apply (erule id_onD[rotated]) apply assumption - thm T1.FVars_renames[symmetric, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated -1, OF imageI] (*, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], OF imageI]*) - apply (drule T1.FVars_renames[symmetric, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated -1, OF imageI]) + thm FVars_raw_permutes[symmetric, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated -1, OF imageI] (*, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], OF imageI]*) + apply (drule FVars_raw_permutes[symmetric, THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated -1, OF imageI]) prefer 5 (* 2*nvars + 1 *) - apply (drule T1.alpha_FVarss[THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated]) + apply (drule alpha_FVars[THEN iffD1[OF arg_cong2[OF refl, of _ _ "(\)"]], rotated]) apply assumption apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule T2_pre.mr_rel_set(5,6)[rotated -1, OF iffD2[OF T2_pre.mr_rel_flip mr_rel_prem]]) @@ -7908,17 +8311,20 @@ lemma f_swap_alpha: apply (rule h_prems) apply (unfold image_id) apply (drule DiffI[rotated]) - apply (erule UN_I[of _ _ _ FVars_T11, rotated] UN_I[of _ _ _ FVars_T12, rotated] - UN_I[of _ _ _ FVars_T21, rotated] UN_I[of _ _ _ FVars_T22, rotated]) + apply (erule UN_I[of _ _ _ FVars_raw_T11, rotated] UN_I[of _ _ _ FVars_raw_T12, rotated] + UN_I[of _ _ _ FVars_raw_T21, rotated] UN_I[of _ _ _ FVars_raw_T22, rotated]) apply assumption apply (rotate_tac -1) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] - id_onD[OF pick_id_ons'(2)[OF suitable'_prems(1) valid]] - id_onD[OF pick_id_ons'(3)[OF suitable'_prems(2) valid]] - id_onD[OF pick_id_ons'(4)[OF suitable'_prems(3) valid]] - id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]] - id_onD[OF pick_id_ons'(6)[OF suitable'_prems(4) valid]] - ) + apply (erule + id_onD[OF pick_id_ons'(1)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(2)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(3)[OF suitable'_prems(1) valid]] + id_onD[OF pick_id_ons'(4)[OF suitable'_prems(2) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(6)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(7)[OF suitable'_prems(3) valid]] + id_onD[OF pick_id_ons'(8)[OF suitable'_prems(4) valid]] + ) apply (rule h_prems bij_id supp_id_bound)+ apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ @@ -7928,23 +8334,27 @@ lemma f_swap_alpha: apply (rule UnI1) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_ctor_picks[OF suitable'_prems valid]) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_T1_alpha_T2.intros[rotated -1]) apply (rule mr_rel_prem h_prems h_id_ons)+ - apply (erule T1.FVars_intros) + apply (erule FVars_raw_intros) apply assumption+ apply (rule sym) apply (rule id_on_comp2) - apply (erule id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] - id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] - id_onD[OF pick_id_ons'(3)[OF suitable_prems(2) valid]] - id_onD[OF pick_id_ons'(4)[OF suitable_prems(3) valid]] - id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] - id_onD[OF pick_id_ons'(6)[OF suitable_prems(4) valid]]) + apply (erule + id_onD[OF pick_id_ons'(1)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(2)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(3)[OF suitable_prems(1) valid]] + id_onD[OF pick_id_ons'(4)[OF suitable_prems(2) valid]] + id_onD[OF pick_id_ons'(5)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(6)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(7)[OF suitable_prems(3) valid]] + id_onD[OF pick_id_ons'(8)[OF suitable_prems(4) valid]] + ) apply (unfold eq_bij_betw_def)[1] apply (erule conjE)+ apply (drule imsupp_id_on)+ @@ -7953,24 +8363,51 @@ lemma f_swap_alpha: apply (rule UnI1) apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) apply (rule sym) - apply (rule T1.alpha_FVarss) + apply (rule alpha_FVars) apply (rule alpha_ctor_picks[OF suitable_prems valid]) - apply (erule T1.FVars_intros) - apply assumption+ - apply (rule T1.alpha_refls) + apply (erule FVars_raw_intros) + apply assumption+ + (* orelse *) + apply (rule eq_onI) + apply (unfold eq_bij_betw_def)[1] + apply (erule conjE)+ + apply (subst (asm) + alpha_FVars(1)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(2)[OF alpha_ctor_picks(1)[OF suitable_prems valid], symmetric] + alpha_FVars(3)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(4)[OF alpha_ctor_picks(2)[OF suitable_prems valid], symmetric] + alpha_FVars(1)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(2)[OF alpha_ctor_picks(1)[OF suitable'_prems valid], symmetric] + alpha_FVars(3)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric] + alpha_FVars(4)[OF alpha_ctor_picks(2)[OF suitable'_prems valid], symmetric])+ + apply (drule imsupp_id_on)+ + apply (erule id_on_eq) + prefer 2 + apply (rule arg_cong2[OF _ refl, of _ _ "(\)"])+ + apply (rule alpha_FVars) + apply (rule alpha_T1_alpha_T2.intros[rotated -1]) + apply (rule mr_rel_prem) + apply (rule h_prems h_id_ons)+ + apply assumption + apply (rule UnI1) + apply (rule UnI1) + apply (erule FVars_raw_intros) + apply assumption + (* END *) + apply (rule alpha_refls) apply (rule bij_comp pick_prems pick'_prems supp_comp_bound infinite_UNIV h_prems | erule eq_bij_betw_prems)+ apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ alpha_T2]]) apply (rule trans) - apply (rule arg_cong3[of _ _ _ _ _ _ rename_T2]) + apply (rule arg_cong3[of _ _ _ _ _ _ permute_raw_T2]) prefer 4 (* 2*nvars + 2 *) - apply (rule T1.rename_comps[symmetric]) + apply (rule permute_raw_comps[symmetric]) prefer 9 (* 4*nvars + 1*) apply (rule refl) prefer 9 (* 4*nvars + 1 *) (* refl orelse *) apply (rule o_id[symmetric]) apply (rule bij_id supp_id_bound h_prems bij_comp pick'_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems)+ apply (rule refl) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule h_prems bij_comp pick'_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems)+ apply assumption (* PUmap' ... (f ...) = PUmap' ... (f ...) *) @@ -7982,7 +8419,7 @@ lemma f_swap_alpha: apply (erule eq_bij_betw_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct1, symmetric]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_id supp_id_bound pick_prems suitable_prems | erule eq_bij_betw_prems | assumption)+ apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ @@ -7990,31 +8427,31 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) - apply (subst T1.rename_comps) + apply (rule alpha_refls) + apply (subst permute_raw_comps) apply (rule bij_id supp_id_bound pick_prems | erule eq_bij_betw_prems)+ apply (rule trans) apply (rule IHs[THEN conjunct2]) - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_id supp_id_bound bij_comp pick_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems)+ apply assumption apply ((rule suitable_prems)+)[4] apply (rule suitable'_prems)+ prefer 7 (* 3*nvars + 1 *) - apply ((subst (asm) T1.rename_comps, (rule pick_prems pick'_prems | erule eq_bij_betw_prems)+)+)? - apply (rule T1.alpha_transs) + apply ((subst (asm) permute_raw_comps, (rule pick_prems pick'_prems | erule eq_bij_betw_prems)+)+)? + apply (rule alpha_trans) apply (unfold id_o o_id)[1] apply assumption - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule bij_comp pick_prems pick'_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems)+ - apply (rule T1.alpha_syms) + apply (rule alpha_syms) apply assumption prefer 7 (* 7*nvars + 1 *) - apply (subst T1.rename_comps[symmetric] T1.rename_comps[symmetric, OF _ _ bij_id supp_id_bound, unfolded o_id], (rule pick_prems pick'_prems | erule eq_bij_betw_prems)+)+ + apply (subst permute_raw_comps[symmetric] permute_raw_comps[symmetric, OF _ _ bij_id supp_id_bound, unfolded o_id], (rule pick_prems pick'_prems | erule eq_bij_betw_prems)+)+ apply (rule trans) apply (rule IHs[THEN conjunct1]) - apply (subst T1.rename_comps, (rule bij_id supp_id_bound pick_prems pick'_prems h_prems)+)+ - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (subst permute_raw_comps, (rule bij_id supp_id_bound pick_prems pick'_prems h_prems)+)+ + apply (erule set_subshape_permutess[rotated -1]) apply (rule bij_id supp_id_bound h_prems suitable'_prems bij_comp pick_prems pick'_prems supp_comp_bound infinite_UNIV | erule eq_bij_betw_prems | assumption)+ apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ @@ -8022,10 +8459,10 @@ lemma f_swap_alpha: apply (unfold eq_bij_betw_def Int_Un_distrib Un_empty)[1] apply (erule conjE)+ apply assumption - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule trans) apply (rule fun_cong[OF fun_cong[OF PU2map'_alpha]]) - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule bij_id supp_id_bound pick'_prems)+ apply assumption apply (rule PUmap'_cong) @@ -8034,10 +8471,10 @@ lemma f_swap_alpha: apply (erule valid_Pmap) apply (rule bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems)+ apply (rule IHs[THEN conjunct2]) - apply (subst T1.rename_comps, (rule bij_id supp_id_bound pick_prems pick'_prems h_prems)+)+ - apply (erule T1.set_subshape_images[rotated -1, OF imageI]) + apply (subst permute_raw_comps, (rule bij_id supp_id_bound pick_prems pick'_prems h_prems)+)+ + apply (erule set_subshape_permutess[rotated -1]) apply (rule supp_id_bound bij_id h_prems suitable'_prems bij_comp pick_prems pick'_prems supp_comp_bound infinite_UNIV trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left] bij_imp_bij_inv supp_inv_bound | erule eq_bij_betw_prems valid_Pmap)+ - apply (rule T1.alpha_bij_eqs[THEN iffD2]) + apply (rule alpha_bij_eqs[THEN iffD2]) apply (rule supp_id_bound bij_id pick'_prems)+ apply assumption apply (rule supp_id_bound bij_id trans[OF arg_cong2[OF imsupp_id refl, of "(\)"] Int_empty_left])+ @@ -8062,7 +8499,7 @@ lemma exists_suitables: apply (rule ordLeq_refl) apply (rule card_of_Card_order) apply (rule T1_pre.Un_bound T1_pre.set_bd_UNIV ordLeq_ordLess_trans[OF card_of_diff] - T1.card_of_FVars_bounds small_PFVars_1 small_PFVars_2 small_avoiding_set1 small_avoiding_set2 + FVars_raw_bd_UNIVs small_PFVars_1 small_PFVars_2 small_avoiding_set1 small_avoiding_set2 | assumption)+ (* copied from above *) apply (rule choice allI)+ @@ -8073,7 +8510,7 @@ lemma exists_suitables: apply (rule ordLeq_refl) apply (rule card_of_Card_order) apply (rule T1_pre.Un_bound T1_pre.set_bd_UNIV ordLeq_ordLess_trans[OF card_of_diff] - T1.card_of_FVars_bounds small_PFVars_1 small_PFVars_2 small_avoiding_set1 small_avoiding_set2 + FVars_raw_bd_UNIVs small_PFVars_1 small_PFVars_2 small_avoiding_set1 small_avoiding_set2 | assumption)+ apply (rule choice allI)+ apply (rule exists_suitable_aux) @@ -8083,7 +8520,7 @@ lemma exists_suitables: apply (rule ordLeq_refl) apply (rule card_of_Card_order) apply (rule T2_pre.Un_bound T2_pre.set_bd_UNIV ordLeq_ordLess_trans[OF card_of_diff] - T1.card_of_FVars_bounds small_PFVars_1 small_PFVars_2 small_avoiding_set1 small_avoiding_set2 + FVars_raw_bd_UNIVs small_PFVars_1 small_PFVars_2 small_avoiding_set1 small_avoiding_set2 | assumption)+ apply (rule choice allI)+ apply (rule exists_suitable_aux) @@ -8093,7 +8530,7 @@ lemma exists_suitables: apply (rule ordLeq_refl) apply (rule card_of_Card_order) apply (rule T1_pre.Un_bound T2_pre.set_bd_UNIV ordLeq_ordLess_trans[OF card_of_diff] - T1.card_of_FVars_bounds small_PFVars_1 small_PFVars_2 small_avoiding_set1 small_avoiding_set2 + FVars_raw_bd_UNIVs small_PFVars_1 small_PFVars_2 small_avoiding_set1 small_avoiding_set2 | assumption)+ done @@ -8120,13 +8557,13 @@ lemma f_alphas: apply (rule assms bij_id supp_id_bound)+ apply (unfold imsupp_id) apply (rule Int_empty_left)+ - apply (assumption | rule T1.alpha_refls)+ + apply (assumption | rule alpha_refls)+ (* copied *) apply (rule f_swap_alpha[THEN conjunct1, THEN conjunct2] f_swap_alpha[THEN conjunct2, THEN conjunct2]) apply (rule assms bij_id supp_id_bound)+ apply (unfold imsupp_id) apply (rule Int_empty_left)+ - apply (assumption | rule T1.alpha_refls)+ + apply (assumption | rule alpha_refls)+ done lemma f0_alphas: @@ -8149,7 +8586,7 @@ lemma f0_T1_ctor: and int_empty: "set5_T1_pre x \ (PFVars_1 p \ avoiding_set1) = {}" "set6_T1_pre x \ (PFVars_2 p \ avoiding_set2) = {}" and noclash: "noclash_raw_T1 x" shows - "f0_T1 (raw_T1_ctor x) p = U1ctor' (map_T1_pre id id id id id id (\t. (t, \p. if validP p then f0_T1 t p else undefined)) (\t. (t, \p. if validP p then f0_T1 t p else undefined)) (\t. (t, \p. if validP p then f0_T2 t p else undefined)) (\t. (t, \p. if validP p then f0_T2 t p else undefined)) x) p" + "f0_T1 (raw_T1_ctor x) p = U1ctor' (map_T1_pre id id id id id id id (\t. (t, \p. if validP p then f0_T1 t p else undefined)) (\t. (t, \p. if validP p then f0_T1 t p else undefined)) (\t. (t, \p. if validP p then f0_T2 t p else undefined)) (\t. (t, \p. if validP p then f0_T2 t p else undefined)) x) p" proof - let ?pick1_1 = "\x' p'. if (x', p') = (x, p) then id else pick1_0 x' p'" let ?pick2_1 = "\x' p'. if (x', p') = (x, p) then id else pick2_0 x' p'" @@ -8172,7 +8609,7 @@ proof - apply (rule trans) apply (unfold Un_assoc)[1] apply (rule Int_Un_distrib) - apply (unfold Un_empty T1.FVars_ctors)[1] + apply (unfold Un_empty FVars_raw_ctors)[1] apply (rule conjI) apply (insert noclash)[1] apply (unfold Int_Un_distrib Un_empty noclash_raw_T1_def)[1] @@ -8196,7 +8633,7 @@ proof - apply (rule trans) apply (unfold Un_assoc)[1] apply (rule Int_Un_distrib) - apply (unfold Un_empty T1.FVars_ctors)[1] + apply (unfold Un_empty FVars_raw_ctors)[1] apply (rule conjI) apply (insert noclash)[1] apply (unfold Int_Un_distrib Un_empty noclash_raw_T1_def)[1] @@ -8210,7 +8647,7 @@ proof - apply (unfold f0_T1_def)[1] apply (rule f_alphas) apply (rule valid suitable_pick1s suitable_pick0s)+ - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule trans) apply (rule f_T1_simp) apply (rule valid suitable_pick1s suitable_pick0s)+ @@ -8218,7 +8655,7 @@ proof - apply (rule arg_cong2[OF _ refl, of _ _ U1ctor']) apply (rule T1_pre.map_cong) apply (rule supp_id_bound bij_id refl)+ - apply (unfold prod.inject T1.rename_ids) + apply (unfold prod.inject permute_raw_ids) (* REPEAT_DETERM *) apply (rule conjI[OF refl]) apply (rule ext) @@ -8234,7 +8671,7 @@ proof - apply (rule f_alphas) apply assumption apply (rule suitable_pick0s suitable_pick1s[unfolded prod.inject])+ - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (unfold f0_T1_def)[1] apply (rule refl) apply (unfold if_not_P)[1] @@ -8254,7 +8691,7 @@ proof - apply (rule f_alphas) apply assumption apply (rule suitable_pick0s suitable_pick1s[unfolded prod.inject])+ - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (unfold f0_T1_def)[1] apply (rule refl) apply (unfold if_not_P)[1] @@ -8274,7 +8711,7 @@ proof - apply (rule f_alphas) apply assumption apply (rule suitable_pick0s suitable_pick1s[unfolded prod.inject])+ - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (unfold f0_T2_def)[1] apply (rule refl) apply (unfold if_not_P)[1] @@ -8294,7 +8731,7 @@ proof - apply (rule f_alphas) apply assumption apply (rule suitable_pick0s suitable_pick1s[unfolded prod.inject])+ - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (unfold f0_T2_def)[1] apply (rule refl) apply (unfold if_not_P)[1] @@ -8307,7 +8744,7 @@ lemma f0_T2_ctor: and int_empty: "set5_T2_pre x \ (PFVars_1 p \ avoiding_set1) = {}" "set6_T2_pre x \ (PFVars_2 p \ avoiding_set2) = {}" and noclash: "noclash_raw_T2 x" shows - "f0_T2 (raw_T2_ctor x) p = U2ctor' (map_T2_pre id id id id id id (\t. (t, \p. if validP p then f0_T1 t p else undefined)) (\t. (t, \p. if validP p then f0_T1 t p else undefined)) (\t. (t, \p. if validP p then f0_T2 t p else undefined)) (\t. (t, \p. if validP p then f0_T2 t p else undefined)) x) p" + "f0_T2 (raw_T2_ctor x) p = U2ctor' (map_T2_pre id id id id id id id (\t. (t, \p. if validP p then f0_T1 t p else undefined)) (\t. (t, \p. if validP p then f0_T1 t p else undefined)) (\t. (t, \p. if validP p then f0_T2 t p else undefined)) (\t. (t, \p. if validP p then f0_T2 t p else undefined)) x) p" proof - let ?pick3_1 = "\x' p'. if (x', p') = (x, p) then id else pick3_0 x' p'" let ?pick4_1 = "\x' p'. if (x', p') = (x, p) then id else pick4_0 x' p'" @@ -8330,7 +8767,7 @@ proof - apply (rule trans) apply (unfold Un_assoc)[1] apply (rule Int_Un_distrib) - apply (unfold Un_empty T1.FVars_ctors)[1] + apply (unfold Un_empty FVars_raw_ctors)[1] apply (rule conjI) apply (insert noclash)[1] apply (unfold Int_Un_distrib Un_empty noclash_raw_T2_def)[1] @@ -8354,7 +8791,7 @@ proof - apply (rule trans) apply (unfold Un_assoc)[1] apply (rule Int_Un_distrib) - apply (unfold Un_empty T1.FVars_ctors)[1] + apply (unfold Un_empty FVars_raw_ctors)[1] apply (rule conjI) apply (insert noclash)[1] apply (unfold Int_Un_distrib Un_empty noclash_raw_T2_def)[1] @@ -8368,7 +8805,7 @@ proof - apply (unfold f0_T2_def)[1] apply (rule f_alphas) apply (rule valid suitable_pick1s suitable_pick0s)+ - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (rule trans) apply (rule f_T2_simp) apply (rule valid suitable_pick1s suitable_pick0s)+ @@ -8376,7 +8813,7 @@ proof - apply (rule arg_cong2[OF _ refl, of _ _ U2ctor']) apply (rule T2_pre.map_cong) apply (rule supp_id_bound bij_id refl)+ - apply (unfold prod.inject T1.rename_ids) + apply (unfold prod.inject permute_raw_ids) (* REPEAT_DETERM *) apply (rule conjI[OF refl]) apply (rule ext) @@ -8392,7 +8829,7 @@ proof - apply (rule f_alphas) apply assumption apply (rule suitable_pick0s suitable_pick1s[unfolded prod.inject])+ - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (unfold f0_T1_def)[1] apply (rule refl) apply (unfold if_not_P)[1] @@ -8412,7 +8849,7 @@ proof - apply (rule f_alphas) apply assumption apply (rule suitable_pick0s suitable_pick1s[unfolded prod.inject])+ - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (unfold f0_T1_def)[1] apply (rule refl) apply (unfold if_not_P)[1] @@ -8432,7 +8869,7 @@ proof - apply (rule f_alphas) apply assumption apply (rule suitable_pick0s suitable_pick1s[unfolded prod.inject])+ - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (unfold f0_T2_def)[1] apply (rule refl) apply (unfold if_not_P)[1] @@ -8452,7 +8889,7 @@ proof - apply (rule f_alphas) apply assumption apply (rule suitable_pick0s suitable_pick1s[unfolded prod.inject])+ - apply (rule T1.alpha_refls) + apply (rule alpha_refls) apply (unfold f0_T2_def)[1] apply (rule refl) apply (unfold if_not_P)[1] @@ -8460,8 +8897,8 @@ proof - done qed -lemmas f0_swaps = conjunct1[OF f_swap_alpha[rotated -2, OF T1.alpha_refls _ suitable_pick0s suitable_pick0s], unfolded f0_T1_def[symmetric], THEN conjunct1] - conjunct2[OF f_swap_alpha[rotated -2, OF T1.alpha_refls _ suitable_pick0s suitable_pick0s], unfolded f0_T2_def[symmetric], THEN conjunct1] +lemmas f0_swaps = conjunct1[OF f_swap_alpha[rotated -2, OF alpha_refls _ suitable_pick0s suitable_pick0s], unfolded f0_T1_def[symmetric], THEN conjunct1] + conjunct2[OF f_swap_alpha[rotated -2, OF alpha_refls _ suitable_pick0s suitable_pick0s], unfolded f0_T2_def[symmetric], THEN conjunct1] (**********************************************) (*********** Final result lemmas **************) @@ -8476,19 +8913,19 @@ lemma ff0_valid: lemma ff0_cctors: "validP p \ set5_T1_pre x \ (PFVars_1 p \ avoiding_set1) = {} \ set6_T1_pre x \ (PFVars_2 p \ avoiding_set2) = {} \ noclash_T1 x \ - ff0_T1 (T1_ctor x) p = U1ctor (map_T1_pre id id id id id id (\t. (t, \p'. if validP p' then ff0_T1 t p' else undefined)) (\t. (t, \p'. if validP p' then ff0_T1 t p' else undefined)) (\t. (t, \p'. if validP p' then ff0_T2 t p' else undefined)) (\t. (t, \p'. if validP p' then ff0_T2 t p' else undefined)) x) p" + ff0_T1 (T1_ctor x) p = U1ctor (map_T1_pre id id id id id id id (\t. (t, \p'. if validP p' then ff0_T1 t p' else undefined)) (\t. (t, \p'. if validP p' then ff0_T1 t p' else undefined)) (\t. (t, \p'. if validP p' then ff0_T2 t p' else undefined)) (\t. (t, \p'. if validP p' then ff0_T2 t p' else undefined)) x) p" "validP p \ set5_T2_pre y \ (PFVars_1 p \ avoiding_set1) = {} \ set6_T2_pre y \ (PFVars_2 p \ avoiding_set2) = {} \ noclash_T2 y \ - ff0_T2 (T2_ctor y) p = U2ctor (map_T2_pre id id id id id id (\t. (t, \p'. if validP p' then ff0_T1 t p' else undefined)) (\t. (t, \p'. if validP p' then ff0_T1 t p' else undefined)) (\t. (t, \p'. if validP p' then ff0_T2 t p' else undefined)) (\t. (t, \p'. if validP p' then ff0_T2 t p' else undefined)) y) p" + ff0_T2 (T2_ctor y) p = U2ctor (map_T2_pre id id id id id id id (\t. (t, \p'. if validP p' then ff0_T1 t p' else undefined)) (\t. (t, \p'. if validP p' then ff0_T1 t p' else undefined)) (\t. (t, \p'. if validP p' then ff0_T2 t p' else undefined)) (\t. (t, \p'. if validP p' then ff0_T2 t p' else undefined)) y) p" apply (unfold ff0_T1_def ff0_T2_def T1_ctor_def T2_ctor_def) apply (rule trans) apply (rule f0_alphas) apply assumption - apply (rule T1.TT_Quotient_rep_abss) + apply (rule TT_rep_abs) apply (rule trans) apply (rule f0_T1_ctor) apply (unfold T1_pre_set_map_ids T2_pre_set_map_ids) apply assumption+ - apply (rule T1.nnoclash_noclashs[THEN iffD1]) + apply (rule nnoclash_noclashs[THEN iffD1]) apply assumption apply (unfold U1ctor'_def)[1] apply (subst T1_pre.map_comp) @@ -8498,18 +8935,18 @@ lemma ff0_cctors: apply (subst T1_pre.map_comp) apply (rule supp_id_bound bij_id)+ apply (unfold comp_def map_prod_simp id_def) - apply (unfold id_def[symmetric] T1.TT_Quotient_abs_reps) + apply (unfold id_def[symmetric] TT_abs_rep) apply (rule refl) (* copied from above *) apply (rule trans) apply (rule f0_alphas) apply assumption - apply (rule T1.TT_Quotient_rep_abss) + apply (rule TT_rep_abs) apply (rule trans) apply (rule f0_T2_ctor) apply (unfold T1_pre_set_map_ids T2_pre_set_map_ids) apply assumption+ - apply (rule T1.nnoclash_noclashs[THEN iffD1]) + apply (rule nnoclash_noclashs[THEN iffD1]) apply assumption apply (unfold U2ctor'_def)[1] apply (subst T2_pre.map_comp) @@ -8519,7 +8956,7 @@ lemma ff0_cctors: apply (subst T2_pre.map_comp) apply (rule supp_id_bound bij_id)+ apply (unfold comp_def map_prod_simp id_def) - apply (unfold id_def[symmetric] T1.TT_Quotient_abs_reps) + apply (unfold id_def[symmetric] TT_abs_rep) apply (rule refl) done @@ -8529,33 +8966,33 @@ lemma ff0_swaps: and f_prems: "bij f1" "|supp f1| avoiding_set1 = {}" "imsupp f2 \ avoiding_set2 = {}" shows - "ff0_T1 (rrename_T1 f1 f2 t1) p = U1map f1 f2 t1 (ff0_T1 t1 (Pmap (inv f1) (inv f2) p))" - "ff0_T2 (rrename_T2 f1 f2 t2) p = U2map f1 f2 t2 (ff0_T2 t2 (Pmap (inv f1) (inv f2) p))" - apply (unfold ff0_T1_def ff0_T2_def rrename_T1_def rrename_T2_def) + "ff0_T1 (permute_T1 f1 f2 t1) p = U1map f1 f2 t1 (ff0_T1 t1 (Pmap (inv f1) (inv f2) p))" + "ff0_T2 (permute_T2 f1 f2 t2) p = U2map f1 f2 t2 (ff0_T2 t2 (Pmap (inv f1) (inv f2) p))" + apply (unfold ff0_T1_def ff0_T2_def permute_T1_def permute_T2_def) apply (rule trans) apply (rule f0_alphas) apply (rule valid) - apply (rule T1.TT_Quotient_rep_abss) + apply (rule TT_rep_abs) apply (rule trans) apply (rule f0_swaps) apply (rule assms)+ - apply (unfold PU1map'_def U1map'_def T1.TT_Quotient_abs_reps)[1] + apply (unfold PU1map'_def U1map'_def TT_abs_rep)[1] apply (rule refl) (* copied from above *) apply (rule trans) apply (rule f0_alphas) apply (rule valid) - apply (rule T1.TT_Quotient_rep_abss) + apply (rule TT_rep_abs) apply (rule trans) apply (rule f0_swaps) apply (rule assms)+ - apply (unfold PU2map'_def U2map'_def T1.TT_Quotient_abs_reps)[1] + apply (unfold PU2map'_def U2map'_def TT_abs_rep)[1] apply (rule refl) done -lemmas ff0_UFVarss = f0_UFVars'(1)[of _ "rep_T1 _", unfolded U1FVars_1'_def T1.TT_Quotient_abs_reps ff0_T1_def[symmetric] FVars_def2s] - f0_UFVars'(2)[of _ "rep_T1 _", unfolded U1FVars_2'_def T1.TT_Quotient_abs_reps ff0_T1_def[symmetric] FVars_def2s] - f0_UFVars'(3)[of _ "rep_T2 _", unfolded U2FVars_1'_def T1.TT_Quotient_abs_reps ff0_T2_def[symmetric] FVars_def2s] - f0_UFVars'(4)[of _ "rep_T2 _", unfolded U2FVars_2'_def T1.TT_Quotient_abs_reps ff0_T2_def[symmetric] FVars_def2s] +lemmas ff0_UFVarss = f0_UFVars'(1)[of _ "rep_T1 _", unfolded U1FVars_1'_def TT_abs_rep ff0_T1_def[symmetric] FVars_def2s] + f0_UFVars'(2)[of _ "rep_T1 _", unfolded U1FVars_2'_def TT_abs_rep ff0_T1_def[symmetric] FVars_def2s] + f0_UFVars'(3)[of _ "rep_T2 _", unfolded U2FVars_1'_def TT_abs_rep ff0_T2_def[symmetric] FVars_def2s] + f0_UFVars'(4)[of _ "rep_T2 _", unfolded U2FVars_2'_def TT_abs_rep ff0_T2_def[symmetric] FVars_def2s] end \ No newline at end of file diff --git a/operations/Sugar.thy b/operations/Sugar.thy index 8138568c..8824bd54 100644 --- a/operations/Sugar.thy +++ b/operations/Sugar.thy @@ -1,11 +1,13 @@ theory Sugar - imports Fixpoint + imports Least_Fixpoint begin ML \ -val res = the (MRBNF_FP_Def_Sugar.fp_result_of @{context} "Fixpoint.T1") +val res = the (MRBNF_FP_Def_Sugar.fp_result_of @{context} "Least_Fixpoint.T1") \ +ML_file \../Tools/mrbnf_recursor_tactics.ML\ +ML_file \../Tools/mrbnf_recursor.ML\ ML_file \../Tools/mrbnf_vvsubst.ML\ local_setup \fn lthy => @@ -15,6 +17,7 @@ let val lthy = @{fold 2} (fn (mrbnf, _) => fn quot => MRBNF_Def.register_mrbnf_raw (fst (dest_Type (#T quot))) mrbnf ) ress (#quotient_fps res) lthy; + val _ = @{print} ress in lthy end \ print_theorems @@ -23,13 +26,15 @@ print_mrbnfs class var = var_T1_pre + var_T2_pre definition Var_T1 :: "'var \ ('var::var, 'tyvar::var, 'a::var, 'b) T1" where - "Var_T1 x \ T1_ctor (Abs_T1_pre (Inl (Inl x)))" + "Var_T1 x \ T1_ctor (Abs_T1_pre (Inl (Inl (Inl x))))" definition Arrow_T1 :: "('var::var, 'tyvar::var, 'a::var, 'b) T1" where - "Arrow_T1 \ T1_ctor (Abs_T1_pre (Inl (Inr (Inl ()))))" + "Arrow_T1 \ T1_ctor (Abs_T1_pre (Inl (Inl (Inr ()))))" definition TyVar_T1 :: "'tyvar \ ('var::var, 'tyvar::var, 'a::var, 'b) T1" where - "TyVar_T1 a \ T1_ctor (Abs_T1_pre (Inl (Inr (Inr a))))" + "TyVar_T1 a \ T1_ctor (Abs_T1_pre (Inl (Inr (Inl a))))" definition App_T1 :: "('var::var, 'tyvar::var, 'a::var, 'b) T1 \ ('var, 'tyvar, 'a, 'b) T2 \ ('var, 'tyvar, 'a, 'b) T1" where - "App_T1 t1 t2 \ T1_ctor (Abs_T1_pre (Inr (Inl (Inl (t1, t2)))))" + "App_T1 t1 t2 \ T1_ctor (Abs_T1_pre (Inl (Inr (Inr (t1, t2)))))" +definition BFree_T1 :: "'var \ ('var \ unit) list \ ('var::var, 'tyvar::var, 'a::var, 'b) T1" where + "BFree_T1 a ts \ T1_ctor (Abs_T1_pre (Inr (Inl (Inl (a, ts)))))" definition Lam_T1 :: "'var \ ('var::var, 'tyvar::var, 'a::var, 'b) T1 \ ('var, 'tyvar, 'a, 'b) T1" where "Lam_T1 x t \ T1_ctor (Abs_T1_pre (Inr (Inl (Inr (x, t)))))" definition TyLam_T1 :: "'tyvar \ ('var, 'tyvar, 'a, 'b) T1 \ ('var::var, 'tyvar::var, 'a::var, 'b) T1" where @@ -50,11 +55,11 @@ definition TyLam_T2 :: "'tyvar \ ('var, 'tyvar, 'a, 'b) T2 \ ('var, 'tyvar, 'a, 'b) T1 \ ('var::var, 'tyvar::var, 'a::var, 'b) T2" where "Ext_T2 b t \ T2_ctor (Abs_T2_pre (Inr (Inr (Inr (b, t)))))" -lemmas T1_ctors_defs = Var_T1_def Arrow_T1_def TyVar_T1_def App_T1_def Lam_T1_def TyLam_T1_def Ext_T1_def +lemmas T1_ctors_defs = Var_T1_def Arrow_T1_def TyVar_T1_def App_T1_def BFree_T1_def Lam_T1_def TyLam_T1_def Ext_T1_def lemmas T2_ctors_defs = Var_T2_def TyVar_T2_def App_T2_def Lam_T2_def TyLam_T2_def Ext_T2_def -lemmas T1_pre_set_defs = set1_T1_pre_def set2_T1_pre_def set3_T1_pre_def set4_T1_pre_def set5_T1_pre_def set6_T1_pre_def set7_T1_pre_def set8_T1_pre_def set9_T1_pre_def set10_T1_pre_def -lemmas T2_pre_set_defs = set1_T2_pre_def set2_T2_pre_def set3_T2_pre_def set4_T2_pre_def set5_T2_pre_def set6_T2_pre_def set7_T2_pre_def set8_T2_pre_def set9_T2_pre_def set10_T2_pre_def +lemmas T1_pre_set_defs = set1_T1_pre_def set2_T1_pre_def set3_T1_pre_def set4_T1_pre_def set5_T1_pre_def set6_T1_pre_def set7_T1_pre_def set8_T1_pre_def set9_T1_pre_def set10_T1_pre_def set11_T1_pre_def +lemmas T2_pre_set_defs = set1_T2_pre_def set2_T2_pre_def set3_T2_pre_def set4_T2_pre_def set5_T2_pre_def set6_T2_pre_def set7_T2_pre_def set8_T2_pre_def set9_T2_pre_def set10_T2_pre_def set11_T2_pre_def lemma T1_T2_strong_induct: fixes t1::"('var::var, 'tyvar::var, 'a::var, 'b) T1" and t2::"('var::var, 'tyvar::var, 'a::var, 'b) T2" @@ -66,6 +71,7 @@ lemma T1_T2_strong_induct: "\\. P Arrow_T1 \" "\a \. P (TyVar_T1 a) \" "\t1 t2 \. \\. P t1 \ \ \\. P2 t2 \ \ P (App_T1 t1 t2) \" + "\a xs \. P (BFree_T1 a xs) \" "\x t \. x \ K1 \ \ \\. P t \ \ P (Lam_T1 x t) \" "\a t \. a \ K2 \ \ \\. P t \ \ P (TyLam_T1 a t) \" "\a \. P (Ext_T1 a) \" @@ -78,7 +84,7 @@ lemma T1_T2_strong_induct: "\b t \. \\. P t \ \ P2 (Ext_T2 b t) \" shows "\\. P t1 \ \ P2 t2 \" apply (unfold ball_UNIV[symmetric]) - apply (rule T1.TT_fresh_co_induct_param[of _ K1 K2 P P2 t1 t2]) + apply (rule fresh_induct_param[of _ K1 K2 P P2 t1 t2]) apply (rule assms(1,2)[THEN spec])+ subgoal for v1 \ apply (tactic \resolve_tac @{context} [infer_instantiate' @{context} [SOME @{cterm v1}] ( @@ -126,7 +132,6 @@ lemma T1_T2_strong_induct: apply (rule IHs(4)) (* REPEAT_DETERM *) apply (rule allI) - apply (rule disjointI)? subgoal premises prems apply (rule prems(1)) (* nonbinding occurence of T1 *) apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? @@ -151,17 +156,21 @@ lemma T1_T2_strong_induct: apply (subst (asm) list.set_map, ((rule supp_id_bound bij_id)+)?)? (* For nested BNFs *) apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? apply (rule IHs(5)) + (* repeated *) + apply (subst unit_eq)? + apply (unfold sum.set_map prod.set_map UN_empty2 Un_empty_left Un_empty_right comp_def + UN_singleton sum_set_simps prod_set_simps UN_single UN_empty + T1_ctors_defs[symmetric] Abs_T1_pre_inverse[OF UNIV_I] + T1_pre_set_defs + )[1] + apply (subst (asm) list.set_map, ((rule supp_id_bound bij_id)+)?)? (* For nested BNFs *) + apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right disjoint_single)? + apply (rule IHs(6)) (* REPEAT_DETERM *) - apply (rule allI)? - apply (rule disjointI)? - subgoal premises prems - apply (rule prems(5)) (* bound var of type 'var *) - apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? - apply (rule singletonI UNIV_I UN_I)+ - done + apply (rule allI)? + apply assumption (* repeated *) apply (rule allI)? - apply (rule disjointI)? subgoal premises prems apply (rule prems(2)) (* binding occurence of T1 *) apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? @@ -176,16 +185,11 @@ lemma T1_T2_strong_induct: T1_pre_set_defs )[1] apply (subst (asm) list.set_map, ((rule supp_id_bound bij_id)+)?)? (* For nested BNFs *) - apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? - apply (rule IHs(6)) + apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right disjoint_single)? + apply (rule IHs(7)) (* REPEAT_DETERM *) apply (rule allI)? - apply (rule disjointI)? - subgoal premises prems - apply (rule prems(6)) (* bound var of type 'tyvar *) - apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? - apply (rule singletonI UNIV_I UN_I)+ - done + apply assumption (* repeated *) apply (rule allI)? apply (rule disjointI)? @@ -204,7 +208,7 @@ lemma T1_T2_strong_induct: )[1] apply (subst (asm) list.set_map, ((rule supp_id_bound bij_id)+)?)? (* For nested BNFs *) apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? - apply (rule IHs(7)) + apply (rule IHs(8)) (* END REPEAT_DETERM *) done @@ -221,7 +225,7 @@ lemma T1_T2_strong_induct: )[1] apply (subst (asm) list.set_map, ((rule supp_id_bound bij_id)+)?)? (* For nested BNFs *) apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? - apply (rule IHs(8)) + apply (rule IHs(9)) (* repeated *) apply (subst unit_eq)? apply (unfold sum.set_map prod.set_map UN_empty2 Un_empty_left Un_empty_right comp_def @@ -231,7 +235,7 @@ lemma T1_T2_strong_induct: )[1] apply (subst (asm) list.set_map, ((rule supp_id_bound bij_id)+)?)? (* For nested BNFs *) apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? - apply (rule IHs(9)) + apply (rule IHs(10)) (* repeated *) apply (subst unit_eq)? apply (unfold sum.set_map prod.set_map UN_empty2 Un_empty_left Un_empty_right comp_def @@ -241,11 +245,10 @@ lemma T1_T2_strong_induct: )[1] apply (subst (asm) list.set_map, ((rule supp_id_bound bij_id)+)?)? (* For nested BNFs *) apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? - apply (rule IHs(10)) + apply (rule IHs(11)) (* repeated *) (* REPEAT_DETERM *) apply (rule allI) - apply (rule disjointI)? subgoal premises prems apply (rule prems(1)) (* nonbinding occurence of T1 *) apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? @@ -253,7 +256,6 @@ lemma T1_T2_strong_induct: done (* repeated *) apply (rule allI) - apply (rule disjointI)? subgoal premises prems apply (rule prems(3)) (* nonbinding occurence of T2 *) apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? @@ -268,19 +270,12 @@ lemma T1_T2_strong_induct: T2_pre_set_defs )[1] apply (subst (asm) list.set_map, ((rule supp_id_bound bij_id)+)?)? (* For nested BNFs *) - apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? - apply (rule IHs(11)) + apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right disjoint_single)? + apply (rule IHs(12)) (* REPEAT_DETERM *) - apply (rule allI)? - apply (rule disjointI)? - subgoal premises prems - apply (rule prems(5)) (* bound var of type 'var *) - apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? - apply (rule singletonI UNIV_I UN_I)+ - done + apply assumption (* repeated *) apply (rule allI)? - apply (rule disjointI)? subgoal premises prems apply (rule prems(2)) (* binding occurence of T1 *) apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? @@ -295,16 +290,10 @@ lemma T1_T2_strong_induct: T2_pre_set_defs )[1] apply (subst (asm) list.set_map, ((rule supp_id_bound bij_id)+)?)? (* For nested BNFs *) - apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? - apply (rule IHs(12)) + apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right disjoint_single)? + apply (rule IHs(13)) (* REPEAT_DETERM *) - apply (rule allI)? - apply (rule disjointI)? - subgoal premises prems - apply (rule prems(6)) (* bound var of type 'tyvar *) - apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? - apply (rule singletonI UNIV_I UN_I)+ - done + apply assumption (* repeated *) apply (rule allI)? apply (rule disjointI)? @@ -323,7 +312,7 @@ lemma T1_T2_strong_induct: )[1] apply (subst (asm) list.set_map, ((rule supp_id_bound bij_id)+)?)? (* For nested BNFs *) apply (unfold UN_empty UN_empty2 Un_empty_left Un_empty_right)? - apply (rule IHs(13)) + apply (rule IHs(14)) (* REPEAT_DETERM *) apply (rule allI)? apply (rule disjointI)? @@ -345,21 +334,22 @@ lemmas set_simp_thms = sum.set_map prod.set_map comp_def UN_empty UN_empty2 Un_e UN_singleton UN_single sum_set_simps prod_set_simps Diff_empty UN_Un empty_Diff lemma set_T1_simps[simp]: - "FFVars_T11 (Var_T1 x) = {x}" - "FFVars_T11 Arrow_T1 = {}" - "FFVars_T11 (TyVar_T1 a) = {}" - "FFVars_T11 (App_T1 t1 t2) = FFVars_T11 t1 \ FFVars_T21 t2" - "FFVars_T11 (Lam_T1 x t) = FFVars_T11 t - {x}" - "FFVars_T11 (TyLam_T1 a t) = FFVars_T11 t" - "FFVars_T11 (Ext_T1 a) = {}" - - "FFVars_T12 (Var_T1 x) = {}" - "FFVars_T12 Arrow_T1 = {}" - "FFVars_T12 (TyVar_T1 a) = {a}" - "FFVars_T12 (App_T1 t1 t2) = FFVars_T12 t1 \ FFVars_T22 t2" - "FFVars_T12 (Lam_T1 x t) = FFVars_T12 t" - "FFVars_T12 (TyLam_T1 a t) = FFVars_T12 t - {a}" - "FFVars_T12 (Ext_T1 a) = {}" + "FVars_T11 (Var_T1 x) = {x}" + "FVars_T11 Arrow_T1 = {}" + "FVars_T11 (TyVar_T1 a) = {}" + "FVars_T11 (App_T1 t1 t2) = FVars_T11 t1 \ FVars_T21 t2" + "FVars_T11 (BFree_T1 x ts) = fst ` set ts - {x}" + "FVars_T11 (Lam_T1 x t) = FVars_T11 t - {x}" + "FVars_T11 (TyLam_T1 a t) = FVars_T11 t" + "FVars_T11 (Ext_T1 a) = {}" + + "FVars_T12 (Var_T1 x) = {}" + "FVars_T12 Arrow_T1 = {}" + "FVars_T12 (TyVar_T1 a) = {a}" + "FVars_T12 (App_T1 t1 t2) = FVars_T12 t1 \ FVars_T22 t2" + "FVars_T12 (Lam_T1 x t) = FVars_T12 t" + "FVars_T12 (TyLam_T1 a t) = FVars_T12 t - {a}" + "FVars_T12 (Ext_T1 a) = {}" "set3_T1 (Var_T1 x) = {}" "set3_T1 Arrow_T1 = {}" @@ -376,27 +366,28 @@ lemma set_T1_simps[simp]: "set4_T1 (Lam_T1 x t) = set4_T1 t" "set4_T1 (TyLam_T1 a t) = set4_T1 t" "set4_T1 (Ext_T1 a) = {}" - apply (unfold set_simp_thms T1_ctors_defs T1.FFVars_cctors + apply (unfold set_simp_thms T1_ctors_defs FVars_ctors T1_pre_set_defs Abs_T1_pre_inverse[OF UNIV_I] - T1_set_simps + T1_set_simps list.set_map ) - apply (rule refl)+ + apply (rule refl + | (unfold prod_sets_simps)[1])+ done lemma set_T2_simps[simp]: - "FFVars_T21 (Var_T2 x) = {x}" - "FFVars_T21 (TyVar_T2 a) = {}" - "FFVars_T21 (App_T2 t1 t2) = FFVars_T11 t1 \ FFVars_T21 t2" - "FFVars_T21 (Lam_T2 x ts) = \(FFVars_T11 ` set ts)- {x}" - "FFVars_T21 (TyLam_T2 a t) = FFVars_T21 t" - "FFVars_T21 (Ext_T2 b t1) = FFVars_T11 t1" - - "FFVars_T22 (Var_T2 x) = {}" - "FFVars_T22 (TyVar_T2 a) = {a}" - "FFVars_T22 (App_T2 t1 t2) = FFVars_T12 t1 \ FFVars_T22 t2" - "FFVars_T22 (Lam_T2 x ts) = \(FFVars_T12 ` set ts)" - "FFVars_T22 (TyLam_T2 a t) = FFVars_T22 t" - "FFVars_T22 (Ext_T2 b t1) = FFVars_T12 t1" + "FVars_T21 (Var_T2 x) = {x}" + "FVars_T21 (TyVar_T2 a) = {}" + "FVars_T21 (App_T2 t1 t2) = FVars_T11 t1 \ FVars_T21 t2" + "FVars_T21 (Lam_T2 x ts) = \(FVars_T11 ` set ts)- {x}" + "FVars_T21 (TyLam_T2 a t) = FVars_T21 t" + "FVars_T21 (Ext_T2 b t1) = FVars_T11 t1" + + "FVars_T22 (Var_T2 x) = {}" + "FVars_T22 (TyVar_T2 a) = {a}" + "FVars_T22 (App_T2 t1 t2) = FVars_T12 t1 \ FVars_T22 t2" + "FVars_T22 (Lam_T2 x ts) = \(FVars_T12 ` set ts)" + "FVars_T22 (TyLam_T2 a t) = FVars_T22 t" + "FVars_T22 (Ext_T2 b t1) = FVars_T12 t1" "set3_T2 (Var_T2 x) = {}" "set3_T2 (TyVar_T2 a) = {}" @@ -411,7 +402,7 @@ lemma set_T2_simps[simp]: "set4_T2 (Lam_T2 x ts) = \(set4_T1 ` set ts)" "set4_T2 (TyLam_T2 a t) = set4_T2 t" "set4_T2 (Ext_T2 b t1) = {b} \ set4_T1 t1" -apply (unfold set_simp_thms T2_ctors_defs T1.FFVars_cctors +apply (unfold set_simp_thms T2_ctors_defs FVars_ctors T2_pre_set_defs Abs_T2_pre_inverse[OF UNIV_I] T2_set_simps ) @@ -422,6 +413,7 @@ lemma T1_distinct[simp]: "Var_T1 x \ Arrow_T1" "Var_T1 x \ TyVar_T1 a" "Var_T1 x \ App_T1 t1 t2" + "Var_T1 x \ BFree_T1 x xs" "Var_T1 x \ Lam_T1 a1 t" "Var_T1 x \ TyLam_T1 a2 t1" "Var_T1 x \ Ext_T1 a3" @@ -429,6 +421,7 @@ lemma T1_distinct[simp]: "Arrow_T1 \ Var_T1 x" "Arrow_T1 \ TyVar_T1 a" "Arrow_T1 \ App_T1 t1 t2" + "Arrow_T1 \ BFree_T1 x xs" "Arrow_T1 \ Lam_T1 a1 t" "Arrow_T1 \ TyLam_T1 a2 t1" "Arrow_T1 \ Ext_T1 a3" @@ -436,21 +429,32 @@ lemma T1_distinct[simp]: "TyVar_T1 a \ Var_T1 x" "TyVar_T1 a \ Arrow_T1" "TyVar_T1 a \ App_T1 t1 t2" + "TyVar_T1 a \ BFree_T1 x xs" "TyVar_T1 a \ Lam_T1 a1 t" "TyVar_T1 a \ TyLam_T1 a2 t1" "TyVar_T1 a \ Ext_T1 a3" "App_T1 t1 t2 \ Var_T1 x" "App_T1 t1 t2 \ Arrow_T1" + "App_T1 t1 t2 \ BFree_T1 x xs" "App_T1 t1 t2 \ TyVar_T1 a" "App_T1 t1 t2 \ Lam_T1 a1 t" "App_T1 t1 t2 \ TyLam_T1 a2 t1" "App_T1 t1 t2 \ Ext_T1 a3" + "BFree_T1 x xs \ Var_T1 x" + "BFree_T1 x xs \ Arrow_T1" + "BFree_T1 x xs \ App_T1 t1 t2" + "BFree_T1 x xs \ TyVar_T1 a" + "BFree_T1 x xs \ Lam_T1 a1 t" + "BFree_T1 x xs \ TyLam_T1 a2 t1" + "BFree_T1 x xs \ Ext_T1 a3" + "Lam_T1 a1 t \ Var_T1 x" "Lam_T1 a1 t \ Arrow_T1" "Lam_T1 a1 t \ TyVar_T1 a" "Lam_T1 a1 t \ App_T1 t1 t2" + "Lam_T1 a1 t \ BFree_T1 x xs" "Lam_T1 a1 t \ TyLam_T1 a2 t1" "Lam_T1 a1 t \ Ext_T1 a3" @@ -458,6 +462,7 @@ lemma T1_distinct[simp]: "TyLam_T1 a2 t1 \ Arrow_T1" "TyLam_T1 a2 t1 \ TyVar_T1 a" "TyLam_T1 a2 t1 \ App_T1 t1 t2" + "TyLam_T1 a2 t1 \ BFree_T1 x xs" "TyLam_T1 a2 t1 \ Lam_T1 a1 t" "TyLam_T1 a2 t1 \ Ext_T1 a3" @@ -465,10 +470,11 @@ lemma T1_distinct[simp]: "Ext_T1 a3 \ Arrow_T1" "Ext_T1 a3 \ TyVar_T1 a" "Ext_T1 a3 \ App_T1 t1 t2" + "Ext_T1 a3 \ BFree_T1 x xs" "Ext_T1 a3 \ Lam_T1 a1 t" "Ext_T1 a3 \ TyLam_T1 a2 t1" apply (unfold comp_def map_sum.simps map_prod_simp sum.inject - T1_ctors_defs T1.TT_injects0 map_T1_pre_def + T1_ctors_defs TT_inject0s map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I] ) apply (rule notI, (erule exE conjE sum.distinct[THEN notE])+)+ @@ -511,17 +517,17 @@ lemma T2_distinct[simp]: "Ext_T2 a3 t5 \ Lam_T2 x1 t3" "Ext_T2 a3 t5 \ TyLam_T2 a2 t4" apply (unfold comp_def map_sum.simps map_prod_simp sum.inject - T2_ctors_defs T1.TT_injects0 map_T2_pre_def + T2_ctors_defs TT_inject0s map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] Abs_T2_pre_inject[OF UNIV_I UNIV_I] ) apply (rule notI, (erule exE conjE sum.distinct[THEN notE])+)+ done -abbreviation eta11 :: "'a \ ('a::var, 'b::var, 'c::var, 'd, 'e::var, 'f::var, 'g, 'h, 'i, 'j) T1_pre" where - "eta11 x \ Abs_T1_pre (Inl (Inl x))" -abbreviation eta12 :: "'b \ ('a::var, 'b::var, 'c::var, 'd, 'e::var, 'f::var, 'g, 'h, 'i, 'j) T1_pre" where - "eta12 x \ Abs_T1_pre (Inl (Inr (Inr x)))" -abbreviation eta21 :: "'a \ ('a::var, 'b::var, 'c::var, 'd, 'e::var, 'f::var, 'g, 'h, 'i, 'j) T2_pre" where +abbreviation eta11 :: "'a \ ('a::var, 'b::var, 'c::var, 'd, 'e::var, 'f::var, 'g::var, 'h, 'i, 'j, 'k) T1_pre" where + "eta11 x \ Abs_T1_pre (Inl (Inl (Inl x)))" +abbreviation eta12 :: "'b \ ('a::var, 'b::var, 'c::var, 'd, 'e::var, 'f::var, 'g::var, 'h, 'i, 'j, 'k) T1_pre" where + "eta12 x \ Abs_T1_pre (Inl (Inr (Inl x)))" +abbreviation eta21 :: "'a \ ('a::var, 'b::var, 'c::var, 'd, 'e::var, 'f::var, 'g::var, 'h, 'i, 'j, 'k) T2_pre" where "eta21 x \ Abs_T2_pre (Inl (Inl x))" lemma eta_frees: @@ -592,12 +598,14 @@ lemma eta_compl_frees: lemma eta_naturals: fixes f1::"('x1::var \ 'x1)" and f2::"('x2::var \ 'x2)" and f3::"('x3::var \ 'x3)" and f4::"('x4::var \ 'x4)" + and f5::"('x5::var \ 'x5)" assumes "|supp f1| eta11 = eta11 \ f1" - "map_T1_pre f1 f2 id id f3 f4 f5 f6 f7 f8 \ eta12 = eta12 \ f2" - "map_T2_pre f1 f2 id id f3 f4 f5 f6 f7 f8 \ eta21 = eta21 \ f1" + "map_T1_pre f1 f2 id id f3 f4 f5 f6 f7 f8 f9 \ eta11 = eta11 \ f1" + "map_T1_pre f1 f2 id id f3 f4 f5 f6 f7 f8 f9 \ eta12 = eta12 \ f2" + "map_T2_pre f1 f2 id id f3 f4 f5 f6 f7 f8 f9 \ eta21 = eta21 \ f1" apply (unfold comp_def map_sum.simps Abs_T1_pre_inverse[OF UNIV_I] map_T1_pre_def map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] ) @@ -640,9 +648,607 @@ ML_file \../Tools/mrbnf_tvsubst.ML\ local_setup \fn lthy => let - val (res', lthy) = MRBNF_TVSubst.create_tvsubst_of_mrbnf I res [T1_model, T2_model] lthy + val (res', lthy) = MRBNF_TVSubst.create_tvsubst_of_mrbnf I res [T1_model, T2_model] lthy; + + val notes = [ + ("VVr_defs", maps (map snd o #VVrs) res'), + ("tvsubst_VVrs", maps #tvsubst_VVrs res'), + ("tvsubst_not_is_VVr", map #tvsubst_cctor_not_isVVr res'), + ("isVVrs", maps #isVVrs res') + ] |> (map (fn (thmN, thms) => + ((Binding.name thmN, []), [(thms, [])]) + )); + + val (noted, lthy) = Local_Theory.notes notes lthy val _ = @{print} res' in lthy end\ print_theorems +lemmas prod_sum_simps = prod.set_map sum.set_map prod_set_simps sum_set_simps UN_empty UN_empty2 + Un_empty_left Un_empty_right UN_singleton comp_def map_sum.simps map_prod_simp UN_single +lemmas map_id0_nesting = list.map_id0 prod.map_id0 +lemmas set_map_nesting = list.set_map prod.set_map + +lemma map_simps[simp]: + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" and f3::"'c::var \ 'c" and f4::"'d \ 'e" + assumes "|supp f1| imsupp f1 \ vvsubst_T1 f1 f2 f3 f4 (BFree_T1 a xs) = BFree_T1 a (map (map_prod f1 id) xs)" + "a \ imsupp f1 \ vvsubst_T1 f1 f2 f3 f4 (Lam_T1 a x1) = Lam_T1 a (vvsubst_T1 f1 f2 f3 f4 x1)" + "b \ imsupp f2 \ vvsubst_T1 f1 f2 f3 f4 (TyLam_T1 b x1) = TyLam_T1 b (vvsubst_T1 f1 f2 f3 f4 x1)" + "vvsubst_T1 f1 f2 f3 f4 (Ext_T1 c) = Ext_T1 (f3 c)" + + "vvsubst_T2 f1 f2 f3 f4 (Var_T2 a) = Var_T2 (f1 a)" + "vvsubst_T2 f1 f2 f3 f4 (TyVar_T2 b) = TyVar_T2 (f2 b)" + "vvsubst_T2 f1 f2 f3 f4 (App_T2 x1 x2) = App_T2 (vvsubst_T1 f1 f2 f3 f4 x1) (vvsubst_T2 f1 f2 f3 f4 x2)" + "a \ imsupp f1 \ vvsubst_T2 f1 f2 f3 f4 (Lam_T2 a xs2) = Lam_T2 a (map (vvsubst_T1 f1 f2 f3 f4) xs2)" + "b \ imsupp f2 \ b \ FVars_T22 x2 \ vvsubst_T2 f1 f2 f3 f4 (TyLam_T2 b x2) = TyLam_T2 b (vvsubst_T2 f1 f2 f3 f4 x2)" + "vvsubst_T2 f1 f2 f3 f4 (Ext_T2 d x1) = Ext_T2 (f4 d) (vvsubst_T1 f1 f2 f3 f4 x1)" + apply (unfold T1_ctors_defs T2_ctors_defs) + + apply (rule trans[OF T1_cctor]) + apply (unfold prod_sum_simps T1_pre_set_defs map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated *) + apply (rule trans[OF T1_cctor]) + apply (unfold prod_sum_simps T1_pre_set_defs map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated *) + apply (rule trans[OF T1_cctor]) + apply (unfold prod_sum_simps T1_pre_set_defs map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated *) + apply (rule trans[OF T1_cctor]) + apply (unfold prod_sum_simps T1_pre_set_defs map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated *) + apply (rule trans[OF T1_cctor]) + apply (unfold prod_sum_simps T1_pre_set_defs map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | assumption | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated *) + apply (rule trans[OF T1_cctor]) + apply (unfold prod_sum_simps T1_pre_set_defs map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | assumption | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated *) + apply (rule trans[OF T1_cctor]) + apply (unfold prod_sum_simps T1_pre_set_defs map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | assumption | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated *) + apply (rule trans[OF T1_cctor]) + apply (unfold prod_sum_simps T1_pre_set_defs map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | assumption | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated for second type *) + apply (rule trans[OF T2_cctor]) + apply (unfold prod_sum_simps T2_pre_set_defs map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] noclash_T2_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | assumption | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated *) + apply (rule trans[OF T2_cctor]) + apply (unfold prod_sum_simps T2_pre_set_defs map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] noclash_T2_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | assumption | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated *) + apply (rule trans[OF T2_cctor]) + apply (unfold prod_sum_simps T2_pre_set_defs map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] noclash_T2_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | assumption | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated *) + apply (rule trans[OF T2_cctor]) + apply (unfold prod_sum_simps T2_pre_set_defs map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] noclash_T2_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | assumption | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated *) + apply (rule trans[OF T2_cctor]) + apply (unfold prod_sum_simps T2_pre_set_defs map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] noclash_T2_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | assumption | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + (* repeated *) + apply (rule trans[OF T2_cctor]) + apply (unfold prod_sum_simps T2_pre_set_defs map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] noclash_T2_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] + supp_id_bound bij_id conjI iffD2[OF arg_cong[OF singleton_iff, of Not]] + assms | assumption | (subst set_map_nesting, (unfold prod_sum_simps)?))+ + apply (unfold map_id0_nesting)? + apply ((unfold id_def)[1])? + apply (rule refl) + done + +lemma permute_simps[simp]: + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" + assumes "bij f1" "|supp f1| ('a, 'b::var, 'c::var, 'd) T1" and h2::"'b \ ('a, 'b, 'c, 'd) T1" + and h3::"'a \ ('a, 'b, 'c, 'd) T2" + assumes "|SSupp11_T1 h1| IImsupp11_1_T1 h1 \ IImsupp12_1_T1 h2 \ IImsupp2_1_T2 h3 \ tvsubst_T1 h1 h2 h3 (BFree_T1 a xs) = BFree_T1 a xs" + "a \ IImsupp11_1_T1 h1 \ IImsupp12_1_T1 h2 \ IImsupp2_1_T2 h3 \ tvsubst_T1 h1 h2 h3 (Lam_T1 a x1) = Lam_T1 a (tvsubst_T1 h1 h2 h3 x1)" + "b \ IImsupp11_2_T1 h1 \ IImsupp12_2_T1 h2 \ IImsupp2_2_T2 h3 \ tvsubst_T1 h1 h2 h3 (TyLam_T1 b x1) = TyLam_T1 b (tvsubst_T1 h1 h2 h3 x1)" + "tvsubst_T1 h1 h2 h3 (Ext_T1 c) = Ext_T1 c" + + "tvsubst_T2 h1 h2 h3 (Var_T2 a) = h3 a" + "tvsubst_T2 h1 h2 h3 (TyVar_T2 b) = TyVar_T2 b" + "tvsubst_T2 h1 h2 h3 (App_T2 x1 x2) = App_T2 (tvsubst_T1 h1 h2 h3 x1) (tvsubst_T2 h1 h2 h3 x2)" + "a \ IImsupp11_1_T1 h1 \ IImsupp12_1_T1 h2 \ IImsupp2_1_T2 h3 \ tvsubst_T2 h1 h2 h3 (Lam_T2 a xs2) = Lam_T2 a (map (tvsubst_T1 h1 h2 h3) xs2)" + "b \ IImsupp11_2_T1 h1 \ IImsupp12_2_T1 h2 \ IImsupp2_2_T2 h3 \ b \ FVars_T22 x2 \ tvsubst_T2 h1 h2 h3 (TyLam_T2 b x2) = TyLam_T2 b (tvsubst_T2 h1 h2 h3 x2)" + "tvsubst_T2 h1 h2 h3 (Ext_T2 d x1) = Ext_T2 d (tvsubst_T1 h1 h2 h3 x1)" + apply (unfold T1_ctors_defs T2_ctors_defs) + + subgoal + apply (unfold VVr_defs[symmetric]) + (* EVERY *) + apply (rule tvsubst_VVrs) + apply (rule assms)+ + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric])? + (* ORELSE *) + apply (rule trans) + apply (rule tvsubst_not_is_VVr) + apply (rule assms)+ + apply (unfold prod_sum_simps T1_pre_set_defs isVVrs VVr_defs Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] iffD2[OF notin_empty_eq_True TrueI] conjI assms)+ + (* REPEAT_DETERM *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* repeated *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* END REPEAT_DETERM *) + apply (unfold map_id0_nesting)? + apply (unfold id_def)? + apply (rule refl) + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric]) + (* EVERY *) + apply (rule tvsubst_VVrs) + apply (rule assms)+ + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric])? + (* ORELSE *) + apply (rule trans) + apply (rule tvsubst_not_is_VVr) + apply (rule assms)+ + apply (unfold prod_sum_simps T1_pre_set_defs isVVrs VVr_defs Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] iffD2[OF notin_empty_eq_True TrueI] conjI assms)+ + (* REPEAT_DETERM *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* repeated *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* END REPEAT_DETERM *) + apply (unfold map_id0_nesting)? + apply (unfold id_def)? + apply (rule refl) + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric])? + (* ORELSE *) + apply (rule trans) + apply (rule tvsubst_not_is_VVr) + apply (rule assms)+ + apply (unfold prod_sum_simps T1_pre_set_defs isVVrs VVr_defs Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] iffD2[OF notin_empty_eq_True TrueI] conjI assms + | assumption)+ + (* REPEAT_DETERM *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* repeated *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* END REPEAT_DETERM *) + apply (unfold map_id0_nesting)? + apply (unfold id_def)? + apply (rule refl) + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric])? + (* ORELSE *) + apply (rule trans) + apply (rule tvsubst_not_is_VVr) + apply (rule assms)+ + apply (unfold prod_sum_simps T1_pre_set_defs isVVrs VVr_defs Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] iffD2[OF notin_empty_eq_True TrueI] conjI assms + | assumption)+ + (* REPEAT_DETERM *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* repeated *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* END REPEAT_DETERM *) + apply (unfold map_id0_nesting)? + apply (unfold id_def)? + apply (rule refl) + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric])? + (* ORELSE *) + apply (rule trans) + apply (rule tvsubst_not_is_VVr) + apply (rule assms)+ + apply (unfold prod_sum_simps T1_pre_set_defs isVVrs VVr_defs Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] iffD2[OF notin_empty_eq_True TrueI] conjI assms + | assumption)+ + (* REPEAT_DETERM *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* repeated *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* END REPEAT_DETERM *) + apply (unfold map_id0_nesting)? + apply (unfold id_def)? + apply (rule refl) + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric])? + (* ORELSE *) + apply (rule trans) + apply (rule tvsubst_not_is_VVr) + apply (rule assms)+ + apply (unfold prod_sum_simps T1_pre_set_defs isVVrs VVr_defs Abs_T1_pre_inverse[OF UNIV_I] noclash_T1_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] iffD2[OF notin_empty_eq_True TrueI] conjI assms + | assumption)+ + (* REPEAT_DETERM *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* repeated *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T1_pre_def Abs_T1_pre_inverse[OF UNIV_I] Abs_T1_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* END REPEAT_DETERM *) + apply (unfold map_id0_nesting)? + apply (unfold id_def)? + apply (rule refl) + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric]) + (* EVERY *) + apply (rule tvsubst_VVrs) + apply (rule assms)+ + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric])? + (* ORELSE *) + apply (rule trans) + apply (rule tvsubst_not_is_VVr) + apply (rule assms)+ + apply (unfold prod_sum_simps T2_pre_set_defs isVVrs VVr_defs Abs_T2_pre_inverse[OF UNIV_I] noclash_T2_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] iffD2[OF notin_empty_eq_True TrueI] conjI assms + | assumption)+ + (* REPEAT_DETERM *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] Abs_T2_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* END REPEAT_DETERM *) + apply (unfold map_id0_nesting)? + apply (unfold id_def)? + apply (rule refl) + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric])? + (* ORELSE *) + apply (rule trans) + apply (rule tvsubst_not_is_VVr) + apply (rule assms)+ + apply (unfold prod_sum_simps T2_pre_set_defs isVVrs VVr_defs Abs_T2_pre_inverse[OF UNIV_I] noclash_T2_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] iffD2[OF notin_empty_eq_True TrueI] conjI assms + | assumption)+ + (* REPEAT_DETERM *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] Abs_T2_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* END REPEAT_DETERM *) + apply (unfold map_id0_nesting)? + apply (unfold id_def)? + apply (rule refl) + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric])? + (* ORELSE *) + apply (rule trans) + apply (rule tvsubst_not_is_VVr) + apply (rule assms)+ + apply (unfold prod_sum_simps T2_pre_set_defs isVVrs VVr_defs Abs_T2_pre_inverse[OF UNIV_I] noclash_T2_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] iffD2[OF notin_empty_eq_True TrueI] conjI assms + | assumption)+ + (* REPEAT_DETERM *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] Abs_T2_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* END REPEAT_DETERM *) + apply (unfold map_id0_nesting)? + apply (unfold id_def)? + apply (rule refl) + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric])? + (* ORELSE *) + apply (rule trans) + apply (rule tvsubst_not_is_VVr) + apply (rule assms)+ + apply (unfold prod_sum_simps T2_pre_set_defs isVVrs VVr_defs Abs_T2_pre_inverse[OF UNIV_I] noclash_T2_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] iffD2[OF notin_empty_eq_True TrueI] conjI assms + | assumption)+ + (* REPEAT_DETERM *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] Abs_T2_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* END REPEAT_DETERM *) + apply (unfold map_id0_nesting)? + apply (unfold id_def)? + apply (rule refl) + done + (* repeated *) + subgoal + apply (unfold VVr_defs[symmetric])? + (* ORELSE *) + apply (rule trans) + apply (rule tvsubst_not_is_VVr) + apply (rule assms)+ + apply (unfold prod_sum_simps T2_pre_set_defs isVVrs VVr_defs Abs_T2_pre_inverse[OF UNIV_I] noclash_T2_def) + apply (rule Int_empty_left Int_empty_right iffD2[OF disjoint_single] iffD2[OF notin_empty_eq_True TrueI] conjI assms + | assumption)+ + (* REPEAT_DETERM *) + apply (rule notI) + apply (erule exE) + apply (drule TT_inject0s[THEN iffD1]) + apply (erule exE conjE)+ + apply (unfold comp_def map_sum.simps map_prod_simp sum.inject map_T2_pre_def Abs_T2_pre_inverse[OF UNIV_I] Abs_T2_pre_inject[OF UNIV_I UNIV_I]) + apply (erule sum.distinct[THEN notE]) + (* END REPEAT_DETERM *) + apply (unfold map_id0_nesting)? + apply (unfold id_def)? + apply (rule refl) + done + done + end \ No newline at end of file diff --git a/operations/TVSubst.thy b/operations/TVSubst.thy index 9708bbfa..4fee9938 100644 --- a/operations/TVSubst.thy +++ b/operations/TVSubst.thy @@ -1,33 +1,36 @@ theory TVSubst - imports "./Fixpoint" + imports "./Least_Fixpoint" begin (* Free variable injections *) -consts eta11 :: "'var \ ('var, 'tyvar, 'a, 'b, 'bvar, 'btyvar, 'rec1, 'brec1, 'rec2, 'brec2) T1_pre" -consts eta12 :: "'tyvar \ ('var, 'tyvar, 'a, 'b, 'bvar, 'btyvar, 'rec1, 'brec1, 'rec2, 'brec2) T1_pre" -consts eta21 :: "'var \ ('var, 'tyvar, 'a, 'b, 'bvar, 'btyvar, 'rec1, 'brec1, 'rec2, 'brec2) T2_pre" +consts eta11 :: "'var \ ('var, 'tyvar, 'a, 'b, 'bvar, 'btyvar, 'var, 'rec1, 'brec1, 'rec2, 'brec2) T1_pre" +consts eta12 :: "'tyvar \ ('var, 'tyvar, 'a, 'b, 'bvar, 'btyvar, 'var, 'rec1, 'brec1, 'rec2, 'brec2) T1_pre" +consts eta21 :: "'var \ ('var, 'tyvar, 'a, 'b, 'bvar, 'btyvar, 'var, 'rec1, 'brec1, 'rec2, 'brec2) T2_pre" axiomatization where eta_free11: "set1_T1_pre (eta11 a) = {a::'var::{var_T1_pre, var_T2_pre}}" and eta_inj11: "eta11 a = eta11 a' \ a = a'" -and eta_compl_free11: "x \ range eta11 \ set1_T1_pre (x::('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'bvar::{var_T1_pre, var_T2_pre}, 'btyvar::{var_T1_pre, var_T2_pre}, 'rec1, 'brec1, 'rec2, 'brec2) T1_pre) = {}" +and eta_compl_free11: "x \ range eta11 \ set1_T1_pre (x::('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'bvar::{var_T1_pre, var_T2_pre}, 'btyvar::{var_T1_pre, var_T2_pre}, 'var, 'rec1, 'brec1, 'rec2, 'brec2) T1_pre) = {}" and eta_natural11: "|supp (f1::'x1::{var_T1_pre, var_T2_pre} \ 'x1)| |supp (f2::'x2::{var_T1_pre, var_T2_pre} \ 'x2)| bij f3 \ |supp (f3::'x3::{var_T1_pre, var_T2_pre} \ 'x3)| bij f4 \ |supp (f4::'x4::{var_T1_pre, var_T2_pre} \ 'x4)| map_T1_pre f1 f2 id id f3 f4 f5 f6 f7 f8 \ eta11 = eta11 \ f1" + \ |supp (f5::'x1::{var_T1_pre,var_T2_pre} \ 'x1)| map_T1_pre f1 f2 id id f3 f4 f5 f6 f7 f8 f9 \ eta11 = eta11 \ f1" and eta_free12: "set2_T1_pre (eta12 b) = {b::'tyvar::{var_T1_pre, var_T2_pre}}" and eta_inj12: "eta12 b = eta12 b' \ b = b'" -and eta_compl_free12: "x \ range eta12 \ set2_T1_pre (x::('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'bvar::{var_T1_pre, var_T2_pre}, 'btyvar::{var_T1_pre, var_T2_pre}, 'rec1, 'brec1, 'rec2, 'brec2) T1_pre) = {}" +and eta_compl_free12: "x \ range eta12 \ set2_T1_pre (x::('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'bvar::{var_T1_pre, var_T2_pre}, 'btyvar::{var_T1_pre, var_T2_pre}, 'var, 'rec1, 'brec1, 'rec2, 'brec2) T1_pre) = {}" and eta_natural12: "|supp (f1::'x1::{var_T1_pre, var_T2_pre} \ 'x1)| |supp (f2::'x2::{var_T1_pre, var_T2_pre} \ 'x2)| bij f3 \ |supp (f3::'x3::{var_T1_pre, var_T2_pre} \ 'x3)| bij f4 \ |supp (f4::'x4::{var_T1_pre, var_T2_pre} \ 'x4)| map_T1_pre f1 f2 id id f3 f4 f5 f6 f7 f8 \ eta12 = eta12 \ f2" + \ |supp (f5::'x1::{var_T1_pre,var_T2_pre} \ 'x1)| map_T1_pre f1 f2 id id f3 f4 f5 f6 f7 f8 f9 \ eta12 = eta12 \ f2" and eta_free21: "set1_T2_pre (eta21 c) = {c::'var::{var_T1_pre, var_T2_pre}}" and eta_inj21: "eta21 c = eta21 c' \ c = c'" -and eta_compl_free21: "y \ range eta21 \ set1_T2_pre (y::('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'bvar::{var_T1_pre, var_T2_pre}, 'btyvar::{var_T1_pre, var_T2_pre}, 'rec1, 'brec1, 'rec2, 'brec2) T2_pre) = {}" +and eta_compl_free21: "y \ range eta21 \ set1_T2_pre (y::('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'bvar::{var_T1_pre, var_T2_pre}, 'btyvar::{var_T1_pre, var_T2_pre}, 'var, 'rec1, 'brec1, 'rec2, 'brec2) T2_pre) = {}" and eta_natural21: "|supp (f1::'x1::{var_T1_pre, var_T2_pre} \ 'x1)| |supp (f2::'x2::{var_T1_pre, var_T2_pre} \ 'x2)| bij f3 \ |supp (f3::'x3::{var_T1_pre, var_T2_pre} \ 'x3)| bij f4 \ |supp (f4::'x4::{var_T1_pre, var_T2_pre} \ 'x4)| map_T2_pre f1 f2 id id f3 f4 f5 f6 f7 f8 \ eta21 = eta21 \ f1" + \ |supp (f5::'x1::{var_T1_pre,var_T2_pre} \ 'x1)| map_T2_pre f1 f2 id id f3 f4 f5 f6 f7 f8 f9 \ eta21 = eta21 \ f1" definition VVr11 :: "'var \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T1" where "VVr11 \ T1_ctor \ eta11" definition VVr12 :: "'tyvar \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T1" where "VVr12 \ T1_ctor \ eta12" @@ -42,17 +45,17 @@ definition SSupp21 :: "('var \ ('var::{var_T1_pre, var_T2_pre}, 'tyv "SSupp21 f \ { x. f x \ VVr21 x }" definition IImsupp11_1 :: "('var \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T1) \ 'var set" where - "IImsupp11_1 f \ SSupp11 f \ \((FFVars_T11 \ f) ` SSupp11 f)" + "IImsupp11_1 f \ SSupp11 f \ \((FVars_T11 \ f) ` SSupp11 f)" definition IImsupp11_2 :: "('var \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T1) \ 'tyvar set" where - "IImsupp11_2 f \ \((FFVars_T12 \ f) ` SSupp11 f)" + "IImsupp11_2 f \ \((FVars_T12 \ f) ` SSupp11 f)" definition IImsupp12_1 :: "('tyvar \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T1) \ 'var set" where - "IImsupp12_1 f \ \((FFVars_T11 \ f) ` SSupp12 f)" + "IImsupp12_1 f \ \((FVars_T11 \ f) ` SSupp12 f)" definition IImsupp12_2 :: "('tyvar \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T1) \ 'tyvar set" where - "IImsupp12_2 f \ SSupp12 f \ \((FFVars_T12 \ f) ` SSupp12 f)" + "IImsupp12_2 f \ SSupp12 f \ \((FVars_T12 \ f) ` SSupp12 f)" definition IImsupp21_1 :: "('var \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T2) \ 'var set" where - "IImsupp21_1 f \ SSupp21 f \ \((FFVars_T21 \ f) ` SSupp21 f)" + "IImsupp21_1 f \ SSupp21 f \ \((FVars_T21 \ f) ` SSupp21 f)" definition IImsupp21_2 :: "('var \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T2) \ 'tyvar set" where - "IImsupp21_2 f \ \((FFVars_T22 \ f) ` SSupp21 f)" + "IImsupp21_2 f \ \((FVars_T22 \ f) ` SSupp21 f)" lemmas IImsupp_defs = IImsupp11_1_def IImsupp11_2_def IImsupp12_1_def IImsupp12_2_def IImsupp21_1_def IImsupp21_2_def definition isVVr11 :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T1 \ bool" where @@ -74,30 +77,30 @@ type_synonym ('var, 'tyvar, 'a, 'b) SSfun12 = "'tyvar \ ('var, 'tyva type_synonym ('var, 'tyvar, 'a, 'b) SSfun21 = "'var \ ('var, 'tyvar, 'a, 'b) T2" definition compSS11 :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var, 'tyvar, 'a, 'b) SSfun11 \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) SSfun11" where - "compSS11 f1 f2 h \ rrename_T1 f1 f2 \ h \ inv f1" + "compSS11 f1 f2 h \ permute_T1 f1 f2 \ h \ inv f1" definition compSS12 :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var, 'tyvar, 'a, 'b) SSfun12 \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) SSfun12" where - "compSS12 f1 f2 h \ rrename_T1 f1 f2 \ h \ inv f2" + "compSS12 f1 f2 h \ permute_T1 f1 f2 \ h \ inv f2" definition compSS21 :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var, 'tyvar, 'a, 'b) SSfun21 \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) SSfun21" where - "compSS21 f1 f2 h \ rrename_T2 f1 f2 \ h \ inv f1" + "compSS21 f1 f2 h \ permute_T2 f1 f2 \ h \ inv f1" lemmas compSS_defs = compSS11_def compSS12_def compSS21_def type_synonym ('var, 'tyvar, 'a, 'b) P = "('var, 'tyvar, 'a, 'b) SSfun11 \ ('var, 'tyvar, 'a, 'b) SSfun12 \ ('var, 'tyvar, 'a, 'b) SSfun21" type_synonym ('var, 'tyvar, 'a, 'b) U1 = "('var, 'tyvar, 'a, 'b) T1" type_synonym ('var, 'tyvar, 'a, 'b) U2 = "('var, 'tyvar, 'a, 'b) T2" -definition U1ctor :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'var, 'tyvar, ('var, 'tyvar, 'a, 'b) T1 \ (('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U1), ('var, 'tyvar, 'a, 'b) T1 \ (('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U1), +definition U1ctor :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'var, 'tyvar, 'var, ('var, 'tyvar, 'a, 'b) T1 \ (('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U1), ('var, 'tyvar, 'a, 'b) T1 \ (('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U1), ('var, 'tyvar, 'a, 'b) T2 \ (('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U2), ('var, 'tyvar, 'a, 'b) T2 \ (('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U2)) T1_pre \ ('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U1" where - "U1ctor y p \ case p of (f1, f2, f3) \ if isVVr11 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) then - f1 (asVVr11 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y))) else ( - if isVVr12 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) then - f2 (asVVr12 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y))) else ( - T1_ctor (map_T1_pre id id id id id id ((\R. R (f1, f2, f3)) \ snd) ((\R. R (f1, f2, f3)) \ snd) ((\R. R (f1, f2, f3)) \ snd) ((\R. R (f1, f2, f3)) \ snd) y) + "U1ctor y p \ case p of (f1, f2, f3) \ if isVVr11 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) then + f1 (asVVr11 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y))) else ( + if isVVr12 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) then + f2 (asVVr12 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y))) else ( + T1_ctor (map_T1_pre id id id id id id id ((\R. R (f1, f2, f3)) \ snd) ((\R. R (f1, f2, f3)) \ snd) ((\R. R (f1, f2, f3)) \ snd) ((\R. R (f1, f2, f3)) \ snd) y) ))" -definition U2ctor :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'var, 'tyvar, ('var, 'tyvar, 'a, 'b) T1 \ (('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U1), ('var, 'tyvar, 'a, 'b) T1 \ (('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U1), +definition U2ctor :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'var, 'tyvar, 'var, ('var, 'tyvar, 'a, 'b) T1 \ (('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U1), ('var, 'tyvar, 'a, 'b) T1 \ (('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U1), ('var, 'tyvar, 'a, 'b) T2 \ (('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U2), ('var, 'tyvar, 'a, 'b) T2 \ (('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U2)) T2_pre \ ('var, 'tyvar, 'a, 'b) P \ ('var, 'tyvar, 'a, 'b) U2" where - "U2ctor y p \ case p of (f1, f2, f3) \ if isVVr21 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) then - f3 (asVVr21 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y))) else ( - T2_ctor (map_T2_pre id id id id id id ((\R. R (f1, f2, f3)) \ snd) ((\R. R (f1, f2, f3)) \ snd) ((\R. R (f1, f2, f3)) \ snd) ((\R. R (f1, f2, f3)) \ snd) y) + "U2ctor y p \ case p of (f1, f2, f3) \ if isVVr21 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) then + f3 (asVVr21 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y))) else ( + T2_ctor (map_T2_pre id id id id id id id ((\R. R (f1, f2, f3)) \ snd) ((\R. R (f1, f2, f3)) \ snd) ((\R. R (f1, f2, f3)) \ snd) ((\R. R (f1, f2, f3)) \ snd) y) )" definition PFVars_1 :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) P \ 'var set" where @@ -111,13 +114,13 @@ definition Pmap :: "('var \ 'var) \ ('tyvar \ {}" definition avoiding_set2 :: "'tyvar::{var_T1_pre,var_T2_pre} set" where "avoiding_set2 \ {}" -abbreviation "U1FVars_1 \ \(_::('var, 'tyvar, 'a, 'b) T1) (x::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T1). FFVars_T11 x" -abbreviation "U1FVars_2 \ \(_::('var, 'tyvar, 'a, 'b) T1) (x::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T1). FFVars_T12 x" -abbreviation "U2FVars_1 \ \(_::('var, 'tyvar, 'a, 'b) T2) (x::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T2). FFVars_T21 x" -abbreviation "U2FVars_2 \ \(_::('var, 'tyvar, 'a, 'b) T2) (x::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T2). FFVars_T22 x" +abbreviation "U1FVars_1 \ \(_::('var, 'tyvar, 'a, 'b) T1) (x::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T1). FVars_T11 x" +abbreviation "U1FVars_2 \ \(_::('var, 'tyvar, 'a, 'b) T1) (x::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T1). FVars_T12 x" +abbreviation "U2FVars_1 \ \(_::('var, 'tyvar, 'a, 'b) T2) (x::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T2). FVars_T21 x" +abbreviation "U2FVars_2 \ \(_::('var, 'tyvar, 'a, 'b) T2) (x::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T2). FVars_T22 x" -abbreviation "U1map \ \f1 f2 (_::('var, 'tyvar, 'a, 'b) T1) (x::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T1). rrename_T1 f1 f2 x" -abbreviation "U2map \ \f1 f2 (_::('var, 'tyvar, 'a, 'b) T2) (x::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T2). rrename_T2 f1 f2 x" +abbreviation "U1map \ \f1 f2 (_::('var, 'tyvar, 'a, 'b) T1) (x::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T1). permute_T1 f1 f2 x" +abbreviation "U2map \ \f1 f2 (_::('var, 'tyvar, 'a, 'b) T2) (x::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T2). permute_T2 f1 f2 x" definition valid_P :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) P \ bool" where "valid_P p \ case p of (f1, f2, f3) \ @@ -166,7 +169,7 @@ lemma VVr_injs: (* EVERY' (map ... VVr_defs eta_injs eta_naturals) *) apply (unfold VVr11_def comp_def) apply (rule eta_inj11) - apply (drule T1.TT_injects0[THEN iffD1]) + apply (drule TT_inject0s[THEN iffD1]) apply (erule exE conjE)+ apply (drule trans[rotated]) apply (rule sym) @@ -178,7 +181,7 @@ lemma VVr_injs: (* copied from above *) apply (unfold VVr12_def comp_def) apply (rule eta_inj12) - apply (drule T1.TT_injects0[THEN iffD1]) + apply (drule TT_inject0s[THEN iffD1]) apply (erule exE conjE)+ apply (drule trans[rotated]) apply (rule sym) @@ -190,7 +193,7 @@ lemma VVr_injs: (* copied from above *) apply (unfold VVr21_def comp_def) apply (rule eta_inj21) - apply (drule T1.TT_injects0[THEN iffD1]) + apply (drule TT_inject0s[THEN iffD1]) apply (erule exE conjE)+ apply (drule trans[rotated]) apply (rule sym) @@ -201,32 +204,32 @@ lemma VVr_injs: apply assumption done -lemma rrename_VVrs: +lemma permute_VVrs: fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| g) \ SSupp11 g \ supp f1" - "SSupp12 (rrename_T1 f1 f2 \ h) \ SSupp12 h \ supp f2" - "SSupp21 (rrename_T2 f1 f2 \ g2) \ SSupp21 g2 \ supp f1" + "SSupp11 (permute_T1 f1 f2 \ g) \ SSupp11 g \ supp f1" + "SSupp12 (permute_T1 f1 f2 \ h) \ SSupp12 h \ supp f2" + "SSupp21 (permute_T2 f1 f2 \ g2) \ SSupp21 g2 \ supp f1" apply (rule subsetI) apply (unfold SSupp11_def mem_Collect_eq Un_iff comp_def)[1] apply (rule case_split[rotated]) apply (erule disjI1) apply (drule iffD1[OF arg_cong2[OF _ refl, of _ _ "(\)"], rotated]) - apply (rule arg_cong[of _ _ "rrename_T1 f1 f2"]) + apply (rule arg_cong[of _ _ "permute_T1 f1 f2"]) apply assumption - apply (unfold rrename_VVrs[OF assms]) + apply (unfold permute_VVrs[OF assms]) apply (rule disjI2) apply (erule contrapos_np) apply (rule arg_cong[of _ _ VVr11]) @@ -314,9 +317,9 @@ lemma SSupp_rename_subsets: apply (rule case_split[rotated]) apply (erule disjI1) apply (drule iffD1[OF arg_cong2[OF _ refl, of _ _ "(\)"], rotated]) - apply (rule arg_cong[of _ _ "rrename_T1 f1 f2"]) + apply (rule arg_cong[of _ _ "permute_T1 f1 f2"]) apply assumption - apply (unfold rrename_VVrs[OF assms]) + apply (unfold permute_VVrs[OF assms]) apply (rule disjI2) apply (erule contrapos_np) apply (rule arg_cong[of _ _ VVr12]) @@ -327,9 +330,9 @@ lemma SSupp_rename_subsets: apply (rule case_split[rotated]) apply (erule disjI1) apply (drule iffD1[OF arg_cong2[OF _ refl, of _ _ "(\)"], rotated]) - apply (rule arg_cong[of _ _ "rrename_T2 f1 f2"]) + apply (rule arg_cong[of _ _ "permute_T2 f1 f2"]) apply assumption - apply (unfold rrename_VVrs[OF assms]) + apply (unfold permute_VVrs[OF assms]) apply (rule disjI2) apply (erule contrapos_np) apply (rule arg_cong[of _ _ VVr21]) @@ -339,9 +342,9 @@ lemma SSupp_rename_subsets: lemma SSupp_rename_bounds: fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| |SSupp11 (rrename_T1 f1 f2 \ g)| |SSupp12 (rrename_T1 f1 f2 \ h)| |SSupp21 (rrename_T2 f1 f2 \ g2)| |SSupp11 (permute_T1 f1 f2 \ g)| |SSupp12 (permute_T1 f1 f2 \ h)| |SSupp21 (permute_T2 f1 f2 \ g2)| 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| y \ inv f1) = f1 ` SSupp11 y" - "SSupp12 (rrename_T1 f1 f2 \ y2 \ inv f2) = f2 ` SSupp12 y2" - "SSupp21 (rrename_T2 f1 f2 \ y3 \ inv f1) = f1 ` SSupp21 y3" + "SSupp11 (permute_T1 f1 f2 \ y \ inv f1) = f1 ` SSupp11 y" + "SSupp12 (permute_T1 f1 f2 \ y2 \ inv f2) = f2 ` SSupp12 y2" + "SSupp21 (permute_T2 f1 f2 \ y3 \ inv f1) = f1 ` SSupp21 y3" subgoal apply (unfold SSupp11_def) apply (rule iffD2[OF set_eq_iff]) @@ -459,7 +462,7 @@ lemma SSupp_natural: apply (drule sym) apply (erule subst) apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (rule assms)+ apply (subst fun_cong[OF eta_natural11, unfolded comp_def]) apply (rule assms)+ @@ -472,14 +475,14 @@ lemma SSupp_natural: apply (subst inv_simp1) apply (rule f_prems) apply (erule contrapos_nn) - apply (drule arg_cong[of _ _ "rrename_T1 (inv f1) (inv f2)"]) - apply (subst (asm) T1.rrename_comps) + apply (drule arg_cong[of _ _ "permute_T1 (inv f1) (inv f2)"]) + apply (subst (asm) permute_comps) apply (rule assms supp_inv_bound bij_imp_bij_inv)+ apply (subst (asm) inv_o_simp1, rule assms)+ - apply (unfold T1.rrename_ids) + apply (unfold permute_ids) apply (erule trans) apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (rule supp_inv_bound bij_imp_bij_inv assms)+ apply (subst fun_cong[OF eta_natural11, unfolded comp_def]) apply (rule supp_inv_bound bij_imp_bij_inv assms)+ @@ -507,7 +510,7 @@ lemma SSupp_natural: apply (drule sym) apply (erule subst) apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (rule assms)+ apply (subst fun_cong[OF eta_natural12, unfolded comp_def]) apply (rule assms)+ @@ -520,14 +523,14 @@ lemma SSupp_natural: apply (subst inv_simp1) apply (rule f_prems) apply (erule contrapos_nn) - apply (drule arg_cong[of _ _ "rrename_T1 (inv f1) (inv f2)"]) - apply (subst (asm) T1.rrename_comps) + apply (drule arg_cong[of _ _ "permute_T1 (inv f1) (inv f2)"]) + apply (subst (asm) permute_comps) apply (rule assms supp_inv_bound bij_imp_bij_inv)+ apply (subst (asm) inv_o_simp1, rule assms)+ - apply (unfold T1.rrename_ids) + apply (unfold permute_ids) apply (erule trans) apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (rule supp_inv_bound bij_imp_bij_inv assms)+ apply (subst fun_cong[OF eta_natural12, unfolded comp_def]) apply (rule supp_inv_bound bij_imp_bij_inv assms)+ @@ -553,10 +556,10 @@ lemma SSupp_natural: apply (rule refl) apply (drule notnotD) apply (rule trans) - apply (rule arg_cong[of _ _ "rrename_T2 f1 f2"]) + apply (rule arg_cong[of _ _ "permute_T2 f1 f2"]) apply assumption apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (rule assms)+ apply (subst fun_cong[OF eta_natural21, unfolded comp_def]) apply (rule assms)+ @@ -569,14 +572,14 @@ lemma SSupp_natural: apply (subst inv_simp1) apply (rule f_prems) apply (erule contrapos_nn) - apply (drule arg_cong[of _ _ "rrename_T2 (inv f1) (inv f2)"]) - apply (subst (asm) T1.rrename_comps) + apply (drule arg_cong[of _ _ "permute_T2 (inv f1) (inv f2)"]) + apply (subst (asm) permute_comps) apply (rule assms supp_inv_bound bij_imp_bij_inv)+ apply (subst (asm) inv_o_simp1, rule assms)+ - apply (unfold T1.rrename_ids) + apply (unfold permute_ids) apply (erule trans) apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (rule supp_inv_bound bij_imp_bij_inv assms)+ apply (subst fun_cong[OF eta_natural21, unfolded comp_def]) apply (rule supp_inv_bound bij_imp_bij_inv assms)+ @@ -625,12 +628,12 @@ lemma IImsupp_VVrs: done done -lemma IImsupp_rrename_commute: +lemma IImsupp_permute_commute: fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| IImsupp11_1 y = {} \ imsupp f2 \ IImsupp11_2 y = {} \ rrename_T1 f1 f2 \ y = y \ f1" - "imsupp f1 \ IImsupp12_1 y2 = {} \ imsupp f2 \ IImsupp12_2 y2 = {} \ rrename_T1 f1 f2 \ y2 = y2 \ f2" - "imsupp f1 \ IImsupp21_1 y3 = {} \ imsupp f2 \ IImsupp21_2 y3 = {} \ rrename_T2 f1 f2 \ y3 = y3 \ f1" + shows "imsupp f1 \ IImsupp11_1 y = {} \ imsupp f2 \ IImsupp11_2 y = {} \ permute_T1 f1 f2 \ y = y \ f1" + "imsupp f1 \ IImsupp12_1 y2 = {} \ imsupp f2 \ IImsupp12_2 y2 = {} \ permute_T1 f1 f2 \ y2 = y2 \ f2" + "imsupp f1 \ IImsupp21_1 y3 = {} \ imsupp f2 \ IImsupp21_2 y3 = {} \ permute_T2 f1 f2 \ y3 = y3 \ f1" subgoal apply (rule ext) apply (unfold comp_def) @@ -638,10 +641,10 @@ lemma IImsupp_rrename_commute: apply (rule case_split[of "f1 a = a"]) apply (rule case_split[of "y a = VVr11 a"]) apply (rule trans) - apply (rule arg_cong[of _ _ "rrename_T1 f1 f2"]) + apply (rule arg_cong[of _ _ "permute_T1 f1 f2"]) apply assumption apply (rule trans) - apply (rule rrename_VVrs) + apply (rule permute_VVrs) apply (rule f_prems)+ apply (rule trans) apply (rule arg_cong[of _ _ VVr11]) @@ -653,7 +656,7 @@ lemma IImsupp_rrename_commute: apply assumption apply (rule trans) - apply (rule T1.rrename_cong_ids) + apply (rule permute_cong_ids) apply (rule f_prems)+ (* REPEAT_DETERM *) apply (rule id_onD[rotated]) @@ -688,13 +691,13 @@ lemma IImsupp_rrename_commute: apply assumption apply (rule trans) - apply (rule arg_cong[of _ _ "rrename_T1 f1 f2"]) + apply (rule arg_cong[of _ _ "permute_T1 f1 f2"]) defer apply (rule trans) prefer 3 apply (erule IImsupp_VVrs) apply assumption - apply (rule rrename_VVrs) + apply (rule permute_VVrs) apply (rule f_prems)+ apply (rule sym) apply (rule IImsupp_VVrs) @@ -711,10 +714,10 @@ lemma IImsupp_rrename_commute: apply (rule case_split[of "f2 a = a"]) apply (rule case_split[of "y2 a = VVr12 a"]) apply (rule trans) - apply (rule arg_cong[of _ _ "rrename_T1 f1 f2"]) + apply (rule arg_cong[of _ _ "permute_T1 f1 f2"]) apply assumption apply (rule trans) - apply (rule rrename_VVrs) + apply (rule permute_VVrs) apply (rule f_prems)+ apply (rule trans) apply (rule arg_cong[of _ _ VVr12]) @@ -726,7 +729,7 @@ lemma IImsupp_rrename_commute: apply assumption apply (rule trans) - apply (rule T1.rrename_cong_ids) + apply (rule permute_cong_ids) apply (rule f_prems)+ (* REPET_DETERM *) apply (rule id_onD[rotated]) @@ -762,13 +765,13 @@ lemma IImsupp_rrename_commute: apply assumption apply (rule trans) - apply (rule arg_cong[of _ _ "rrename_T1 f1 f2"]) + apply (rule arg_cong[of _ _ "permute_T1 f1 f2"]) defer apply (rule trans) prefer 3 apply (erule IImsupp_VVrs) apply assumption - apply (rule rrename_VVrs) + apply (rule permute_VVrs) apply (rule f_prems)+ apply (rule sym) apply (rule IImsupp_VVrs) @@ -785,10 +788,10 @@ lemma IImsupp_rrename_commute: apply (rule case_split[of "f1 a = a"]) apply (rule case_split[of "y3 a = VVr21 a"]) apply (rule trans) - apply (rule arg_cong[of _ _ "rrename_T2 f1 f2"]) + apply (rule arg_cong[of _ _ "permute_T2 f1 f2"]) apply assumption apply (rule trans) - apply (rule rrename_VVrs) + apply (rule permute_VVrs) apply (rule f_prems)+ apply (rule trans) apply (rule arg_cong[of _ _ VVr21]) @@ -800,7 +803,7 @@ lemma IImsupp_rrename_commute: apply assumption apply (rule trans) - apply (rule T1.rrename_cong_ids) + apply (rule permute_cong_ids) apply (rule f_prems)+ (* REPET_DETERM *) apply (rule id_onD[rotated]) @@ -836,13 +839,13 @@ lemma IImsupp_rrename_commute: apply assumption apply (rule trans) - apply (rule arg_cong[of _ _ "rrename_T2 f1 f2"]) + apply (rule arg_cong[of _ _ "permute_T2 f1 f2"]) defer apply (rule trans) prefer 3 apply (erule IImsupp_VVrs) apply assumption - apply (rule rrename_VVrs) + apply (rule permute_VVrs) apply (rule f_prems)+ apply (rule sym) apply (rule IImsupp_VVrs) @@ -865,7 +868,7 @@ lemma compSS_cong_ids: subgoal apply (unfold compSS11_def) subgoal premises prems - apply (subst IImsupp_rrename_commute) + apply (subst IImsupp_permute_commute) apply (rule f_prems)+ (* REPEAT_DETERM *) apply (rule trans[OF Int_commute]) @@ -911,7 +914,7 @@ lemma compSS_cong_ids: subgoal apply (unfold compSS12_def) subgoal premises prems - apply (subst IImsupp_rrename_commute) + apply (subst IImsupp_permute_commute) apply (rule f_prems)+ (* REPEAT_DETERM *) apply (rule trans[OF Int_commute]) @@ -958,7 +961,7 @@ lemma compSS_cong_ids: subgoal apply (unfold compSS21_def) subgoal premises prems - apply (subst IImsupp_rrename_commute) + apply (subst IImsupp_permute_commute) apply (rule f_prems)+ (* REPEAT_DETERM *) apply (rule trans[OF Int_commute]) @@ -1048,24 +1051,24 @@ lemma isVVr_renames: fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{ apply (rule iffI) apply (erule exE) apply hypsubst_thin - apply (subst rrename_VVrs) + apply (subst permute_VVrs) apply (rule assms)+ apply (rule exI) apply (rule refl) apply (erule exE) - apply (drule arg_cong[of _ _ "rrename_T1 (inv f1) (inv f2)"]) - apply (subst (asm) T1.rrename_comps) + apply (drule arg_cong[of _ _ "permute_T1 (inv f1) (inv f2)"]) + apply (subst (asm) permute_comps) apply (rule assms supp_inv_bound bij_imp_bij_inv)+ apply (subst (asm) inv_o_simp1, rule assms)+ - apply (unfold T1.rrename_ids) - apply (subst (asm) rrename_VVrs) + apply (unfold permute_ids) + apply (subst (asm) permute_VVrs) apply (rule supp_inv_bound bij_imp_bij_inv assms)+ apply hypsubst_thin apply (rule exI) @@ -1095,17 +1098,17 @@ fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{ apply (rule iffI) apply (erule exE) apply hypsubst_thin - apply (subst rrename_VVrs) + apply (subst permute_VVrs) apply (rule assms)+ apply (rule exI) apply (rule refl) apply (erule exE) - apply (drule arg_cong[of _ _ "rrename_T2 (inv f1) (inv f2)"]) - apply (subst (asm) T1.rrename_comps) + apply (drule arg_cong[of _ _ "permute_T2 (inv f1) (inv f2)"]) + apply (subst (asm) permute_comps) apply (rule assms supp_inv_bound bij_imp_bij_inv)+ apply (subst (asm) inv_o_simp1, rule assms)+ - apply (unfold T1.rrename_ids) - apply (subst (asm) rrename_VVrs) + apply (unfold permute_ids) + apply (subst (asm) permute_VVrs) apply (rule supp_inv_bound bij_imp_bij_inv assms)+ apply hypsubst_thin apply (rule exI) @@ -1138,7 +1141,7 @@ lemma PFVars_Pmaps: apply (unfold IImsupp11_1_def) apply (unfold image_comp[symmetric]) apply (subst image_comp[unfolded comp_def]) - apply (subst T1.FFVars_rrenames) + apply (subst FVars_permutes) apply (rule assms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+ apply (unfold image_UN[symmetric]) apply (subst SSupp_natural, (rule assms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ @@ -1151,7 +1154,7 @@ lemma PFVars_Pmaps: apply (unfold IImsupp12_1_def) apply (unfold image_comp[symmetric]) apply (subst image_comp[unfolded comp_def]) - apply (subst T1.FFVars_rrenames) + apply (subst FVars_permutes) apply (rule assms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+ apply (unfold image_UN[symmetric]) apply (subst SSupp_natural, (rule assms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ @@ -1164,7 +1167,7 @@ lemma PFVars_Pmaps: apply (unfold IImsupp21_1_def) apply (unfold image_comp[symmetric]) apply (subst image_comp[unfolded comp_def]) - apply (subst T1.FFVars_rrenames) + apply (subst FVars_permutes) apply (rule assms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+ apply (unfold image_UN[symmetric]) apply (subst SSupp_natural, (rule assms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ @@ -1183,7 +1186,7 @@ lemma PFVars_Pmaps: apply (unfold IImsupp11_2_def) apply (unfold image_comp[symmetric]) apply (subst image_comp[unfolded comp_def]) - apply (subst T1.FFVars_rrenames) + apply (subst FVars_permutes) apply (rule assms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+ apply (unfold image_UN[symmetric]) apply (subst SSupp_natural, (rule assms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ @@ -1196,7 +1199,7 @@ lemma PFVars_Pmaps: apply (unfold IImsupp12_2_def) apply (unfold image_comp[symmetric]) apply (subst image_comp[unfolded comp_def]) - apply (subst T1.FFVars_rrenames) + apply (subst FVars_permutes) apply (rule assms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+ apply (unfold image_UN[symmetric]) apply (subst SSupp_natural, (rule assms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ @@ -1209,7 +1212,7 @@ lemma PFVars_Pmaps: apply (unfold IImsupp21_2_def) apply (unfold image_comp[symmetric]) apply (subst image_comp[unfolded comp_def]) - apply (subst T1.FFVars_rrenames) + apply (subst FVars_permutes) apply (rule assms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+ apply (unfold image_UN[symmetric]) apply (subst SSupp_natural, (rule assms ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ @@ -1240,13 +1243,13 @@ lemma small_PFVarss: subgoal apply (unfold PFVars_1_def case_prod_beta IImsupp11_1_def IImsupp12_1_def IImsupp21_1_def comp_def valid_P_def) apply (erule conjE)+ - apply (assumption | rule Un_bound UNION_bound T1.card_of_FFVars_bounds cmin_greater card_of_Card_order)+ + apply (assumption | rule Un_bound UNION_bound FVars_bd_UNIVs cmin_greater card_of_Card_order)+ done (* copied from above *) subgoal apply (unfold PFVars_2_def case_prod_beta IImsupp11_2_def IImsupp12_2_def IImsupp21_2_def comp_def valid_P_def) apply (erule conjE)+ - apply (assumption | rule Un_bound UNION_bound T1.card_of_FFVars_bounds cmin_greater card_of_Card_order)+ + apply (assumption | rule Un_bound UNION_bound FVars_bd_UNIVs cmin_greater card_of_Card_order)+ done done @@ -1257,10 +1260,10 @@ lemma small_avoiding_sets: apply (rule cmin_greater card_of_Card_order emp_bound)+ done -lemma U1FVars_subset_1: "valid_P p \ set5_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T1_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ - (\t pu p. valid_P p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_1 t (pu p) \ FFVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. valid_P p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_1 t (pu p) \ FFVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - U1FVars_1 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) (U1ctor y p) \ FFVars_T11 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1" +lemma U1FVars_subset_1: "valid_P p \ set5_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T1_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ + (\t pu p. valid_P p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_1 t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. valid_P p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_1 t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ + U1FVars_1 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) (U1ctor y p) \ FVars_T11 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1" apply (unfold avoiding_set1_def Un_empty_right case_prod_beta) subgoal premises prems apply (unfold U1ctor_def case_prod_beta) @@ -1275,7 +1278,7 @@ lemma U1FVars_subset_1: "valid_P p \ set5_T1_pre (y::(_, _, 'a:: apply (unfold asVVr_VVrs) apply (rule case_split[of "_ = _"]) apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ "(\)"]]) - apply (rule arg_cong[of _ _ FFVars_T11]) + apply (rule arg_cong[of _ _ FVars_T11]) apply assumption apply (rule Un_upper1) apply (rule subsetI) @@ -1300,7 +1303,7 @@ lemma U1FVars_subset_1: "valid_P p \ set5_T1_pre (y::(_, _, 'a:: apply (unfold asVVr_VVrs) apply (rule case_split[of "_ = _"]) apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ "(\)"]]) - apply (rule arg_cong[of _ _ FFVars_T11]) + apply (rule arg_cong[of _ _ FVars_T11]) prefer 2 apply (rule Un_upper1) apply assumption @@ -1316,11 +1319,11 @@ lemma U1FVars_subset_1: "valid_P p \ set5_T1_pre (y::(_, _, 'a:: apply assumption apply (unfold if_not_P) (* END REPEAT_DETERM *) - apply (unfold T1.FFVars_cctors) + apply (unfold FVars_ctors) apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)+ apply (unfold image_id image_comp comp_def) apply (rule Un_mono')+ - apply (rule Un_upper1) + apply (rule Un_upper1)+ (* REPEAT_DETERM *) apply (unfold UN_extend_simps(2)) apply (rule subset_If) @@ -1369,10 +1372,10 @@ lemma U1FVars_subset_1: "valid_P p \ set5_T1_pre (y::(_, _, 'a:: done done -lemma U1FVars_subset_2: "valid_P p \ set6_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T1_pre) \ (PFVars_2 p \ avoiding_set2) = {} \ - (\t pu p. valid_P p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_2 t (pu p) \ FFVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. valid_P p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_2 t (pu p) \ FFVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - U1FVars_2 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) (U1ctor y p) \ FFVars_T12 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2" +lemma U1FVars_subset_2: "valid_P p \ set6_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T1_pre) \ (PFVars_2 p \ avoiding_set2) = {} \ + (\t pu p. valid_P p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_2 t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. valid_P p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_2 t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ + U1FVars_2 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) (U1ctor y p) \ FVars_T12 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2" apply (unfold avoiding_set2_def Un_empty_right) subgoal premises prems apply (unfold U1ctor_def case_prod_beta) @@ -1386,7 +1389,7 @@ lemma U1FVars_subset_2: "valid_P p \ set6_T1_pre (y::(_, _, 'a:: apply (unfold asVVr_VVrs) apply (rule case_split[of "_ = _"]) apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ "(\)"]]) - apply (rule arg_cong[of _ _ FFVars_T12]) + apply (rule arg_cong[of _ _ FVars_T12]) prefer 2 apply (rule Un_upper1) apply assumption @@ -1411,7 +1414,7 @@ lemma U1FVars_subset_2: "valid_P p \ set6_T1_pre (y::(_, _, 'a:: apply (unfold asVVr_VVrs) apply (rule case_split[of "_ = _"]) apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ "(\)"]]) - apply (rule arg_cong[of _ _ FFVars_T12]) + apply (rule arg_cong[of _ _ FVars_T12]) prefer 2 apply (rule Un_upper1) apply assumption @@ -1426,7 +1429,7 @@ lemma U1FVars_subset_2: "valid_P p \ set6_T1_pre (y::(_, _, 'a:: apply (rule iffD2[OF arg_cong2[OF refl comp_apply, of "(\)"]]) apply assumption apply (unfold if_not_P) - apply (unfold T1.FFVars_cctors) + apply (unfold FVars_ctors) apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)+ apply (unfold image_id image_comp comp_def) apply (rule Un_mono')+ @@ -1472,10 +1475,10 @@ lemma U1FVars_subset_2: "valid_P p \ set6_T1_pre (y::(_, _, 'a:: done done -lemma U2FVars_subset_1: "valid_P p \ set5_T2_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T2_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ - (\t pu p. valid_P p \ (t, pu) \ set7_T2_pre y \ set8_T2_pre y \ U1FVars_1 t (pu p) \ FFVars_T11 t \ PFVars_1 p \ avoiding_set1) \ - (\t pu p. valid_P p \ (t, pu) \ set9_T2_pre y \ set10_T2_pre y \ U2FVars_1 t (pu p) \ FFVars_T21 t \ PFVars_1 p \ avoiding_set1) \ - U2FVars_1 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) (U2ctor y p) \ FFVars_T21 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1" +lemma U2FVars_subset_1: "valid_P p \ set5_T2_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T2_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ + (\t pu p. valid_P p \ (t, pu) \ set8_T2_pre y \ set9_T2_pre y \ U1FVars_1 t (pu p) \ FVars_T11 t \ PFVars_1 p \ avoiding_set1) \ + (\t pu p. valid_P p \ (t, pu) \ set10_T2_pre y \ set11_T2_pre y \ U2FVars_1 t (pu p) \ FVars_T21 t \ PFVars_1 p \ avoiding_set1) \ + U2FVars_1 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) (U2ctor y p) \ FVars_T21 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) \ PFVars_1 p \ avoiding_set1" apply (unfold avoiding_set1_def Un_empty_right) subgoal premises prems apply (unfold U2ctor_def case_prod_beta) @@ -1489,7 +1492,7 @@ lemma U2FVars_subset_1: "valid_P p \ set5_T2_pre (y::(_, _, 'a:: apply (unfold asVVr_VVrs) apply (rule case_split[of "_ = _"]) apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ "(\)"]]) - apply (rule arg_cong[of _ _ FFVars_T21]) + apply (rule arg_cong[of _ _ FVars_T21]) prefer 2 apply (rule Un_upper1) apply assumption @@ -1504,11 +1507,11 @@ lemma U2FVars_subset_1: "valid_P p \ set5_T2_pre (y::(_, _, 'a:: apply (rule iffD2[OF arg_cong2[OF refl comp_apply, of "(\)"]]) apply assumption apply (unfold if_not_P) - apply (unfold T1.FFVars_cctors) + apply (unfold FVars_ctors) apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)+ apply (unfold image_id image_comp comp_def) apply (rule Un_mono')+ - apply (rule Un_upper1) + apply (rule Un_upper1)+ apply (unfold UN_extend_simps(2)) apply (rule subset_If) apply (unfold UN_empty')[1] @@ -1555,10 +1558,10 @@ lemma U2FVars_subset_1: "valid_P p \ set5_T2_pre (y::(_, _, 'a:: done done -lemma U2FVars_subset_2: "valid_P p \ set6_T2_pre (y::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T2_pre) \ (PFVars_2 p \ avoiding_set2) = {} \ - (\t pu p. valid_P p \ (t, pu) \ set7_T2_pre y \ set8_T2_pre y \ U1FVars_2 t (pu p) \ FFVars_T12 t \ PFVars_2 p \ avoiding_set2) \ - (\t pu p. valid_P p \ (t, pu) \ set9_T2_pre y \ set10_T2_pre y \ U2FVars_2 t (pu p) \ FFVars_T22 t \ PFVars_2 p \ avoiding_set2) \ - U2FVars_2 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) (U2ctor y p) \ FFVars_T22 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2" +lemma U2FVars_subset_2: "valid_P p \ set6_T2_pre (y::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T2_pre) \ (PFVars_2 p \ avoiding_set2) = {} \ + (\t pu p. valid_P p \ (t, pu) \ set8_T2_pre y \ set9_T2_pre y \ U1FVars_2 t (pu p) \ FVars_T12 t \ PFVars_2 p \ avoiding_set2) \ + (\t pu p. valid_P p \ (t, pu) \ set10_T2_pre y \ set11_T2_pre y \ U2FVars_2 t (pu p) \ FVars_T22 t \ PFVars_2 p \ avoiding_set2) \ + U2FVars_2 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) (U2ctor y p) \ FVars_T22 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) \ PFVars_2 p \ avoiding_set2" apply (unfold avoiding_set2_def Un_empty_right) subgoal premises prems apply (unfold U2ctor_def case_prod_beta) @@ -1572,7 +1575,7 @@ lemma U2FVars_subset_2: "valid_P p \ set6_T2_pre (y::('var::{var apply (unfold asVVr_VVrs) apply (rule case_split[of "_ = _"]) apply (rule iffD2[OF arg_cong2[OF _ refl, of _ _ "(\)"]]) - apply (rule arg_cong[of _ _ FFVars_T22]) + apply (rule arg_cong[of _ _ FVars_T22]) prefer 2 apply (rule Un_upper1) apply assumption @@ -1587,7 +1590,7 @@ lemma U2FVars_subset_2: "valid_P p \ set6_T2_pre (y::('var::{var apply (rule iffD2[OF arg_cong2[OF refl comp_apply, of "(\)"]]) apply assumption apply (unfold if_not_P) - apply (unfold T1.FFVars_cctors) + apply (unfold FVars_ctors) apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)+ apply (unfold image_id image_comp comp_def) apply (rule Un_mono')+ @@ -1634,18 +1637,18 @@ lemma U2FVars_subset_2: "valid_P p \ set6_T2_pre (y::('var::{var done lemma U1map_Uctor: "valid_P p \ bij f1 \ |supp (f1::'var::{var_T1_pre,var_T2_pre} \ 'var)| bij f2 \ |supp (f2::'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar)| - U1map f1 f2 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) (U1ctor y p) -= U1ctor (map_T1_pre f1 f2 id id f1 f2 - (\(t, pu). (rrename_T1 f1 f2 t, \p. if valid_P p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T1 f1 f2 t, \p. if valid_P p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if valid_P p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if valid_P p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + U1map f1 f2 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) (U1ctor y p) += U1ctor (map_T1_pre f1 f2 id id f1 f2 f1 + (\(t, pu). (permute_T1 f1 f2 t, \p. if valid_P p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T1 f1 f2 t, \p. if valid_P p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if valid_P p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if valid_P p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) y) (Pmap f1 f2 p)" apply (unfold U1ctor_def) apply (subst T1_pre.map_comp, (assumption | rule supp_id_bound bij_id ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ apply (unfold id_o_commute[of f1] id_o_commute[of f2] fst_o_f comp_assoc comp_def[of snd] snd_conv case_prod_beta prod.collapse) apply (subst T1_pre.map_comp[symmetric], (rule supp_id_bound bij_id | assumption | rule ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ - apply (subst T1.rrename_cctors[symmetric] isVVr_renames[symmetric], (assumption | rule ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ + apply (subst permute_simps[symmetric] isVVr_renames[symmetric], (assumption | rule ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ (* REPEAT_DETERM *) apply (rule case_split) apply (subst if_P) @@ -1656,7 +1659,7 @@ lemma U1map_Uctor: "valid_P p \ bij f1 \ |supp ( apply (drule sym) apply (erule subst) apply (unfold Pmap_def case_prod_beta fst_conv snd_conv asVVr_VVrs)[1] - apply (subst rrename_VVrs) + apply (subst permute_VVrs) apply (assumption | rule ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+ apply (unfold asVVr_VVrs compSS_defs comp_def)[1] apply (subst inv_simp1) @@ -1672,7 +1675,7 @@ lemma U1map_Uctor: "valid_P p \ bij f1 \ |supp ( apply (drule sym) apply (erule subst) apply (unfold Pmap_def case_prod_beta fst_conv snd_conv asVVr_VVrs)[1] - apply (subst rrename_VVrs) + apply (subst permute_VVrs) apply (assumption | rule ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+ apply (unfold asVVr_VVrs compSS_defs comp_def)[1] apply (subst inv_simp1) @@ -1680,7 +1683,7 @@ lemma U1map_Uctor: "valid_P p \ bij f1 \ |supp ( apply (rule refl) (* END REPEAT_DETERM *) apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (assumption | rule ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+ apply (subst T1_pre.map_comp, (assumption | rule supp_id_bound bij_id ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ apply (unfold id_o o_id) @@ -1695,18 +1698,18 @@ lemma U1map_Uctor: "valid_P p \ bij f1 \ |supp ( done lemma U2map_Uctor: "valid_P p \ bij f1 \ |supp (f1::'var::{var_T1_pre,var_T2_pre} \ 'var)| bij f2 \ |supp (f2::'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar)| - U2map f1 f2 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) (U2ctor y p) -= U2ctor (map_T2_pre f1 f2 id id f1 f2 - (\(t, pu). (rrename_T1 f1 f2 t, \p. if valid_P p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T1 f1 f2 t, \p. if valid_P p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if valid_P p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if valid_P p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + U2map f1 f2 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) (U2ctor y p) += U2ctor (map_T2_pre f1 f2 id id f1 f2 f1 + (\(t, pu). (permute_T1 f1 f2 t, \p. if valid_P p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T1 f1 f2 t, \p. if valid_P p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if valid_P p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if valid_P p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) y) (Pmap f1 f2 p)" apply (unfold U2ctor_def) apply (subst T2_pre.map_comp, (assumption | rule supp_id_bound bij_id ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ apply (unfold id_o_commute[of f1] id_o_commute[of f2] fst_o_f comp_assoc comp_def[of snd] snd_conv case_prod_beta prod.collapse) apply (subst T2_pre.map_comp[symmetric], (rule supp_id_bound bij_id | assumption | rule ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ - apply (subst T1.rrename_cctors[symmetric] isVVr_renames[symmetric], (assumption | rule ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ + apply (subst permute_simps[symmetric] isVVr_renames[symmetric], (assumption | rule ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ (* REPEAT_DETERM *) apply (rule case_split) apply (subst if_P) @@ -1717,7 +1720,7 @@ lemma U2map_Uctor: "valid_P p \ bij f1 \ |supp ( apply (drule sym) apply (erule subst) apply (unfold Pmap_def case_prod_beta fst_conv snd_conv asVVr_VVrs)[1] - apply (subst rrename_VVrs) + apply (subst permute_VVrs) apply (assumption | rule ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+ apply (unfold asVVr_VVrs compSS_defs comp_def)[1] apply (subst inv_simp1) @@ -1725,7 +1728,7 @@ lemma U2map_Uctor: "valid_P p \ bij f1 \ |supp ( apply (rule refl) (* END REPEAT_DETERM *) apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (assumption | rule ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+ apply (subst T2_pre.map_comp, (assumption | rule supp_id_bound bij_id ordLess_ordLeq_trans cmin1 cmin2 card_of_Card_order)+)+ apply (unfold id_o o_id) @@ -1805,11 +1808,11 @@ val T1_model = { axioms = { Umap_id0 = fn ctxt => EVERY1 [ resolve_tac ctxt [trans], - resolve_tac ctxt @{thms T1.rrename_id0s[THEN fun_cong]}, + resolve_tac ctxt @{thms permute_id0s[THEN fun_cong]}, resolve_tac ctxt @{thms id_apply} ], - Umap_comp0 = fn ctxt => resolve_tac ctxt @{thms T1.rrename_comp0s[symmetric, THEN fun_cong]} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE resolve_tac ctxt card_thms 1), - Umap_cong_id = fn ctxt => resolve_tac ctxt @{thms T1.rrename_cong_ids} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE Goal.assume_rule_tac ctxt 1 ORELSE resolve_tac ctxt card_thms 1), + Umap_comp0 = fn ctxt => resolve_tac ctxt @{thms permute_comp0s[symmetric, THEN fun_cong]} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE resolve_tac ctxt card_thms 1), + Umap_cong_id = fn ctxt => resolve_tac ctxt @{thms permute_cong_ids} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE Goal.assume_rule_tac ctxt 1 ORELSE resolve_tac ctxt card_thms 1), Umap_Uctor = fn ctxt => resolve_tac ctxt @{thms U1map_Uctor} 1 THEN REPEAT_DETERM (assume_tac ctxt 1), UFVars_subsets = replicate nvars (fn ctxt => resolve_tac ctxt @{thms U1FVars_subset_1 U1FVars_subset_2} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE Goal.assume_rule_tac ctxt 1)) } @@ -1828,19 +1831,22 @@ val T2_model = { axioms = { Umap_id0 = fn ctxt => EVERY1 [ resolve_tac ctxt [trans], - resolve_tac ctxt @{thms T1.rrename_id0s[THEN fun_cong]}, + resolve_tac ctxt @{thms permute_id0s[THEN fun_cong]}, resolve_tac ctxt @{thms id_apply} ], - Umap_comp0 = fn ctxt => resolve_tac ctxt @{thms T1.rrename_comp0s[symmetric, THEN fun_cong]} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE resolve_tac ctxt card_thms 1), - Umap_cong_id = fn ctxt => resolve_tac ctxt @{thms T1.rrename_cong_ids} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE Goal.assume_rule_tac ctxt 1 ORELSE resolve_tac ctxt card_thms 1), + Umap_comp0 = fn ctxt => resolve_tac ctxt @{thms permute_comp0s[symmetric, THEN fun_cong]} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE resolve_tac ctxt card_thms 1), + Umap_cong_id = fn ctxt => resolve_tac ctxt @{thms permute_cong_ids} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE Goal.assume_rule_tac ctxt 1 ORELSE resolve_tac ctxt card_thms 1), Umap_Uctor = fn ctxt => resolve_tac ctxt @{thms U2map_Uctor} 1 THEN REPEAT_DETERM (assume_tac ctxt 1), UFVars_subsets = replicate nvars (fn ctxt => resolve_tac ctxt @{thms U2FVars_subset_1 U2FVars_subset_2} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE Goal.assume_rule_tac ctxt 1)) } }; -val fp_res = the (MRBNF_FP_Def_Sugar.fp_result_of @{context} "Fixpoint.T1") +val fp_res = the (MRBNF_FP_Def_Sugar.fp_result_of @{context} "Least_Fixpoint.T1") \ +ML_file \../Tools/mrbnf_recursor_tactics.ML\ +ML_file \../Tools/mrbnf_recursor.ML\ + declare [[quick_and_dirty]] local_setup \fn lthy => let @@ -1863,8 +1869,8 @@ definition tvsubst_T1 :: "('var \ ('var::{var_T1_pre, var_T2_pre}, ' definition tvsubst_T2 :: "('var \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T1) \ ('tyvar \ ('var, 'tyvar, 'a, 'b) T1) \ ('var \ ('var, 'tyvar, 'a, 'b) T2) \ ('var, 'tyvar, 'a, 'b) T2 \ ('var, 'tyvar, 'a, 'b) T2" where "tvsubst_T2 f1 f2 f3 t \ ff02_tvsubst_T1_vvsubst_T2 t (f1, f2, f3)" -type_synonym ('var, 'tyvar, 'a, 'b) U1_pre = "('var, 'tyvar, 'a, 'b, 'var, 'tyvar, ('var, 'tyvar, 'a, 'b) U1, ('var, 'tyvar, 'a, 'b) U1, ('var, 'tyvar, 'a, 'b) U2, ('var, 'tyvar, 'a, 'b) U2) T1_pre" -type_synonym ('var, 'tyvar, 'a, 'b) U2_pre = "('var, 'tyvar, 'a, 'b, 'var, 'tyvar, ('var, 'tyvar, 'a, 'b) U1, ('var, 'tyvar, 'a, 'b) U1, ('var, 'tyvar, 'a, 'b) U2, ('var, 'tyvar, 'a, 'b) U2) T2_pre" +type_synonym ('var, 'tyvar, 'a, 'b) U1_pre = "('var, 'tyvar, 'a, 'b, 'var, 'tyvar, 'var, ('var, 'tyvar, 'a, 'b) U1, ('var, 'tyvar, 'a, 'b) U1, ('var, 'tyvar, 'a, 'b) U2, ('var, 'tyvar, 'a, 'b) U2) T1_pre" +type_synonym ('var, 'tyvar, 'a, 'b) U2_pre = "('var, 'tyvar, 'a, 'b, 'var, 'tyvar, 'var, ('var, 'tyvar, 'a, 'b) U1, ('var, 'tyvar, 'a, 'b) U1, ('var, 'tyvar, 'a, 'b) U2, ('var, 'tyvar, 'a, 'b) U2) T2_pre" lemmas eta_natural' = eta_natural11[THEN fun_cong, unfolded comp_def] @@ -1880,6 +1886,7 @@ lemma eta_set_empties: "set8_T1_pre (eta11 a :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" "set9_T1_pre (eta11 a :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" "set10_T1_pre (eta11 a :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" + "set11_T1_pre (eta11 a :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" "set1_T1_pre (eta12 b :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" "set5_T1_pre (eta12 b :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" "set6_T1_pre (eta12 b :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" @@ -1887,6 +1894,7 @@ lemma eta_set_empties: "set8_T1_pre (eta12 b :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" "set9_T1_pre (eta12 b :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" "set10_T1_pre (eta12 b :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" + "set11_T1_pre (eta12 b :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" "set2_T2_pre (eta21 a :: ('var, 'tyvar, 'a, 'b) U2_pre) = {}" "set5_T2_pre (eta21 a :: ('var, 'tyvar, 'a, 'b) U2_pre) = {}" "set6_T2_pre (eta21 a :: ('var, 'tyvar, 'a, 'b) U2_pre) = {}" @@ -1894,6 +1902,7 @@ lemma eta_set_empties: "set8_T2_pre (eta21 a :: ('var, 'tyvar, 'a, 'b) U2_pre) = {}" "set9_T2_pre (eta21 a :: ('var, 'tyvar, 'a, 'b) U2_pre) = {}" "set10_T2_pre (eta21 a :: ('var, 'tyvar, 'a, 'b) U2_pre) = {}" + "set11_T2_pre (eta21 a :: ('var, 'tyvar, 'a, 'b) U2_pre) = {}" apply - subgoal apply (rule iffD2[OF set_eq_iff]) @@ -1907,7 +1916,7 @@ lemma eta_set_empties: apply (rule arg_cong[of _ _ set2_T1_pre]) prefer 2 apply (subst (asm) T1_pre.set_map) - prefer 8 (* free + 2 * bound + 1 *) + prefer 9 (* free + 2 * bound + 1 *) apply (erule swap_fresh) apply assumption apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ @@ -1932,7 +1941,7 @@ lemma eta_set_empties: apply (rule arg_cong[of _ _ set5_T1_pre]) prefer 2 apply (subst (asm) T1_pre.set_map) - prefer 8 (* free + 2 * bound + 1 *) + prefer 9 (* free + 2 * bound + 1 *) apply (erule swap_fresh) apply assumption apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ @@ -1957,7 +1966,32 @@ lemma eta_set_empties: apply (rule arg_cong[of _ _ set6_T1_pre]) prefer 2 apply (subst (asm) T1_pre.set_map) - prefer 8 (* free + 2 * bound + 1 *) + prefer 9 (* free + 2 * bound + 1 *) + apply (erule swap_fresh) + apply assumption + apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ + apply (rule sym) + apply (rule trans) + apply (rule eta_natural') + apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ + apply (unfold id_def) + apply (rule refl) + apply (erule FalseE) + done + (* copied from above *) + subgoal + apply (rule iffD2[OF set_eq_iff]) + apply (rule allI) + apply (unfold empty_iff) + apply (rule iffI) + (* case 1: ty \ Live *) + apply (rule exE[OF exists_fresh, of "set7_T1_pre (eta11 a)"]) + apply (rule T1_pre.set_bd_UNIV) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) + apply (rule arg_cong[of _ _ set7_T1_pre]) + prefer 2 + apply (subst (asm) T1_pre.set_map) + prefer 9 (* free + 2 * bound + 1 *) apply (erule swap_fresh) apply assumption apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ @@ -2096,7 +2130,7 @@ lemma eta_set_empties: apply (rule arg_cong[of _ _ set1_T1_pre]) prefer 2 apply (subst (asm) T1_pre.set_map) - prefer 8 (* free + 2 * bound + 1 *) + prefer 9 (* free + 2 * bound + 1 *) apply (erule swap_fresh) apply assumption apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ @@ -2120,7 +2154,7 @@ lemma eta_set_empties: apply (rule arg_cong[of _ _ set5_T1_pre]) prefer 2 apply (subst (asm) T1_pre.set_map) - prefer 8 (* free + 2 * bound + 1 *) + prefer 9 (* free + 2 * bound + 1 *) apply (erule swap_fresh) apply assumption apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ @@ -2144,7 +2178,31 @@ lemma eta_set_empties: apply (rule arg_cong[of _ _ set6_T1_pre]) prefer 2 apply (subst (asm) T1_pre.set_map) - prefer 8 (* free + 2 * bound + 1 *) + prefer 9 (* free + 2 * bound + 1 *) + apply (erule swap_fresh) + apply assumption + apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ + apply (rule sym) + apply (rule trans) + apply (rule eta_natural') + apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ + apply (unfold id_def) + apply (rule refl) + apply (erule FalseE) + done + subgoal + apply (rule iffD2[OF set_eq_iff]) + apply (rule allI) + apply (unfold empty_iff) + apply (rule iffI) + (* case 1: ty \ Live *) + apply (rule exE[OF exists_fresh, of "set7_T1_pre (eta12 b)"]) + apply (rule T1_pre.set_bd_UNIV) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) + apply (rule arg_cong[of _ _ set7_T1_pre]) + prefer 2 + apply (subst (asm) T1_pre.set_map) + prefer 9 (* free + 2 * bound + 1 *) apply (erule swap_fresh) apply assumption apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ @@ -2284,7 +2342,7 @@ lemma eta_set_empties: apply (rule arg_cong[of _ _ set2_T2_pre]) prefer 2 apply (subst (asm) T2_pre.set_map) - prefer 8 (* free + 2 * bound + 1 *) + prefer 9 (* free + 2 * bound + 1 *) apply (erule swap_fresh) apply assumption apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ @@ -2308,7 +2366,7 @@ lemma eta_set_empties: apply (rule arg_cong[of _ _ set5_T2_pre]) prefer 2 apply (subst (asm) T2_pre.set_map) - prefer 8 (* free + 2 * bound + 1 *) + prefer 9 (* free + 2 * bound + 1 *) apply (erule swap_fresh) apply assumption apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ @@ -2332,7 +2390,31 @@ lemma eta_set_empties: apply (rule arg_cong[of _ _ set6_T2_pre]) prefer 2 apply (subst (asm) T2_pre.set_map) - prefer 8 (* free + 2 * bound + 1 *) + prefer 9 (* free + 2 * bound + 1 *) + apply (erule swap_fresh) + apply assumption + apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ + apply (rule sym) + apply (rule trans) + apply (rule eta_natural') + apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ + apply (unfold id_def) + apply (rule refl) + apply (erule FalseE) + done + subgoal + apply (rule iffD2[OF set_eq_iff]) + apply (rule allI) + apply (unfold empty_iff) + apply (rule iffI) + (* case 1: ty \ Live *) + apply (rule exE[OF exists_fresh, of "set7_T2_pre (eta21 a)"]) + apply (rule T2_pre.set_bd_UNIV) + apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) + apply (rule arg_cong[of _ _ set7_T2_pre]) + prefer 2 + apply (subst (asm) T2_pre.set_map) + prefer 9 (* free + 2 * bound + 1 *) apply (erule swap_fresh) apply assumption apply (rule supp_id_bound bij_id supp_swap_bound bij_swap infinite_UNIV)+ @@ -2463,13 +2545,13 @@ lemma eta_set_empties: done lemma FVars_VVrs: - "FFVars_T11 (VVr11 a) = {a}" - "FFVars_T12 (VVr11 a) = {}" - "FFVars_T11 (VVr12 b) = {}" - "FFVars_T12 (VVr12 b) = {b}" - "FFVars_T21 (VVr21 a) = {a}" - "FFVars_T22 (VVr21 a) = {}" - apply (unfold VVr_defs comp_def T1.FFVars_cctors Un_empty_right Un_empty_left UN_empty empty_Diff eta_set_empties) + "FVars_T11 (VVr11 a) = {a}" + "FVars_T12 (VVr11 a) = {}" + "FVars_T11 (VVr12 b) = {}" + "FVars_T12 (VVr12 b) = {b}" + "FVars_T21 (VVr21 a) = {a}" + "FVars_T22 (VVr21 a) = {}" + apply (unfold VVr_defs comp_def FVars_ctors Un_empty_right Un_empty_left UN_empty empty_Diff eta_set_empties) apply (rule refl eta_free11 eta_free12 eta_free21)+ done @@ -2518,7 +2600,7 @@ lemma tvsubst_VVrs: (* REPEAT_DETERM 1 *) apply (rule trans) apply (rule if_not_P) - apply (unfold isVVr11_def VVr11_def comp_def T1.TT_injects0)[1] + apply (unfold isVVr11_def VVr11_def comp_def TT_inject0s)[1] apply (rule iffD2[OF not_ex]) apply (rule allI) apply (rule notI) @@ -2570,7 +2652,7 @@ lemma tvsubst_T1_not_is_VVr: and noclash: "noclash_T1 x" and VVr_prems: "\isVVr11 (T1_ctor x)" "\isVVr12 (T1_ctor x)" shows - "tvsubst_T1 f1 f2 f3 (T1_ctor x) = T1_ctor (map_T1_pre id id id id id id (tvsubst_T1 f1 f2 f3) (tvsubst_T1 f1 f2 f3) (tvsubst_T2 f1 f2 f3) (tvsubst_T2 f1 f2 f3) x)" + "tvsubst_T1 f1 f2 f3 (T1_ctor x) = T1_ctor (map_T1_pre id id id id id id id (tvsubst_T1 f1 f2 f3) (tvsubst_T1 f1 f2 f3) (tvsubst_T2 f1 f2 f3) (tvsubst_T2 f1 f2 f3) x)" apply (unfold tvsubst_T1_def tvsubst_T2_def) apply (rule trans) apply (rule T1.rec_Uctors) @@ -2593,7 +2675,7 @@ lemma tvsubst_T2_not_is_VVr: and noclash: "noclash_T2 x" and VVr_prems: "\isVVr21 (T2_ctor x)" shows - "tvsubst_T2 f1 f2 f3 (T2_ctor x) = T2_ctor (map_T2_pre id id id id id id (tvsubst_T1 f1 f2 f3) (tvsubst_T1 f1 f2 f3) (tvsubst_T2 f1 f2 f3) (tvsubst_T2 f1 f2 f3) x)" + "tvsubst_T2 f1 f2 f3 (T2_ctor x) = T2_ctor (map_T2_pre id id id id id id id (tvsubst_T1 f1 f2 f3) (tvsubst_T1 f1 f2 f3) (tvsubst_T2 f1 f2 f3) (tvsubst_T2 f1 f2 f3) x)" apply (unfold tvsubst_T1_def tvsubst_T2_def) apply (rule trans) apply (rule T1.rec_Uctors) @@ -2644,12 +2726,12 @@ lemma not_isVVr_frees: done lemma in_IImsupps: - "f1 a \ VVr11 a \ z \ FFVars_T11 (f1 a) \ z \ IImsupp11_1 f1" - "f2 b \ VVr12 b \ z \ FFVars_T11 (f2 b) \ z \ IImsupp12_1 f2" - "f3 a \ VVr21 a \ z \ FFVars_T21 (f3 a) \ z \ IImsupp21_1 f3" - "f1 a \ VVr11 a \ z2 \ FFVars_T12 (f1 a) \ z2 \ IImsupp11_2 f1" - "f2 b \ VVr12 b \ z2 \ FFVars_T12 (f2 b) \ z2 \ IImsupp12_2 f2" - "f3 a \ VVr21 a \ z2 \ FFVars_T22 (f3 a) \ z2 \ IImsupp21_2 f3" + "f1 a \ VVr11 a \ z \ FVars_T11 (f1 a) \ z \ IImsupp11_1 f1" + "f2 b \ VVr12 b \ z \ FVars_T11 (f2 b) \ z \ IImsupp12_1 f2" + "f3 a \ VVr21 a \ z \ FVars_T21 (f3 a) \ z \ IImsupp21_1 f3" + "f1 a \ VVr11 a \ z2 \ FVars_T12 (f1 a) \ z2 \ IImsupp11_2 f1" + "f2 b \ VVr12 b \ z2 \ FVars_T12 (f2 b) \ z2 \ IImsupp12_2 f2" + "f3 a \ VVr21 a \ z2 \ FVars_T22 (f3 a) \ z2 \ IImsupp21_2 f3" subgoal apply (unfold comp_def SSupp11_def IImsupp11_1_def) apply (rule UnI2)? @@ -2707,9 +2789,9 @@ lemma in_IImsupps: done lemma IImsupp_Diffs: - "B \ IImsupp11_1 f1 = {} \ (\a\(A - B). FFVars_T11 (f1 a)) = (\a\A. FFVars_T11 (f1 a)) - B" - "B2 \ IImsupp12_2 f2 = {} \ (\a\(A2 - B2). FFVars_T12 (f2 a)) = (\a\A2. FFVars_T12 (f2 a)) - B2" - "B \ IImsupp21_1 f3 = {} \ (\a\(A - B). FFVars_T21 (f3 a)) = (\a\A. FFVars_T21 (f3 a)) - B" + "B \ IImsupp11_1 f1 = {} \ (\a\(A - B). FVars_T11 (f1 a)) = (\a\A. FVars_T11 (f1 a)) - B" + "B2 \ IImsupp12_2 f2 = {} \ (\a\(A2 - B2). FVars_T12 (f2 a)) = (\a\A2. FVars_T12 (f2 a)) - B2" + "B \ IImsupp21_1 f3 = {} \ (\a\(A - B). FVars_T21 (f3 a)) = (\a\A. FVars_T21 (f3 a)) - B" subgoal apply (rule iffD2[OF set_eq_iff]) apply (rule allI) @@ -2723,7 +2805,7 @@ lemma IImsupp_Diffs: (* apply (rotate_tac -2) *) apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule trans) - apply (rule arg_cong[of _ _ FFVars_T11]) + apply (rule arg_cong[of _ _ FVars_T11]) apply assumption apply (rule FVars_VVrs(1)) apply (drule singletonD) @@ -2750,7 +2832,7 @@ lemma IImsupp_Diffs: apply (rotate_tac -2) apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule trans) - apply (rule arg_cong[of _ _ FFVars_T11]) + apply (rule arg_cong[of _ _ FVars_T11]) apply assumption apply (rule FVars_VVrs(1)) apply (drule singletonD) @@ -2787,7 +2869,7 @@ lemma IImsupp_Diffs: (* apply (rotate_tac -2) *) apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule trans) - apply (rule arg_cong[of _ _ FFVars_T12]) + apply (rule arg_cong[of _ _ FVars_T12]) apply assumption prefer 2 apply (drule singletonD) @@ -2816,7 +2898,7 @@ lemma IImsupp_Diffs: apply (rotate_tac -2) apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule trans) - apply (rule arg_cong[of _ _ FFVars_T12]) + apply (rule arg_cong[of _ _ FVars_T12]) apply assumption apply (rule FVars_VVrs(4)) apply (drule singletonD) @@ -2853,7 +2935,7 @@ lemma IImsupp_Diffs: (* apply (rotate_tac -2) *) apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule trans) - apply (rule arg_cong[of _ _ FFVars_T21]) + apply (rule arg_cong[of _ _ FVars_T21]) apply assumption prefer 2 apply (drule singletonD) @@ -2882,7 +2964,7 @@ lemma IImsupp_Diffs: apply (rotate_tac -2) apply (drule iffD1[OF arg_cong2[OF refl, of _ _ "(\)"], rotated]) apply (rule trans) - apply (rule arg_cong[of _ _ FFVars_T21]) + apply (rule arg_cong[of _ _ FVars_T21]) apply assumption apply (rule FVars_VVrs(5)) apply (drule singletonD) @@ -2912,12 +2994,12 @@ lemma IImsupp_naturals: fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" assumes "bij f1" "|supp f1| g \ inv f1) = f1 ` IImsupp11_1 g" - "IImsupp11_2 (rrename_T1 f1 f2 \ g \ inv f1) = f2 ` IImsupp11_2 g" - "IImsupp12_1 (rrename_T1 f1 f2 \ g2 \ inv f2) = f1 ` IImsupp12_1 g2" - "IImsupp12_2 (rrename_T1 f1 f2 \ g2 \ inv f2) = f2 ` IImsupp12_2 g2" - "IImsupp21_1 (rrename_T2 f1 f2 \ g3 \ inv f1) = f1 ` IImsupp21_1 g3" - "IImsupp21_2 (rrename_T2 f1 f2 \ g3 \ inv f1) = f2 ` IImsupp21_2 g3" + "IImsupp11_1 (permute_T1 f1 f2 \ g \ inv f1) = f1 ` IImsupp11_1 g" + "IImsupp11_2 (permute_T1 f1 f2 \ g \ inv f1) = f2 ` IImsupp11_2 g" + "IImsupp12_1 (permute_T1 f1 f2 \ g2 \ inv f2) = f1 ` IImsupp12_1 g2" + "IImsupp12_2 (permute_T1 f1 f2 \ g2 \ inv f2) = f2 ` IImsupp12_2 g2" + "IImsupp21_1 (permute_T2 f1 f2 \ g3 \ inv f1) = f1 ` IImsupp21_1 g3" + "IImsupp21_2 (permute_T2 f1 f2 \ g3 \ inv f1) = f2 ` IImsupp21_2 g3" apply (unfold IImsupp11_1_def image_Un image_UN) apply (rule arg_cong2[of _ _ _ _ "(\)"])? apply (rule SSupp_natural[OF assms])? @@ -2926,7 +3008,7 @@ lemma IImsupp_naturals: apply (subst inv_o_simp1, rule assms) apply (unfold o_id) apply (unfold comp_def)[1] - apply (subst T1.FFVars_rrenames, (rule assms)+) + apply (subst FVars_permutes, (rule assms)+) apply (rule refl) (* next goal, same tactic *) apply (unfold IImsupp11_2_def image_Un image_UN) @@ -2937,7 +3019,7 @@ lemma IImsupp_naturals: apply (subst inv_o_simp1, rule assms) apply (unfold o_id) apply (unfold comp_def)[1] - apply (subst T1.FFVars_rrenames, (rule assms)+) + apply (subst FVars_permutes, (rule assms)+) apply (rule refl) (* next goal, same tactic *) apply (unfold IImsupp12_1_def image_Un image_UN) @@ -2948,7 +3030,7 @@ lemma IImsupp_naturals: apply (subst inv_o_simp1, rule assms) apply (unfold o_id) apply (unfold comp_def)[1] - apply (subst T1.FFVars_rrenames, (rule assms)+) + apply (subst FVars_permutes, (rule assms)+) apply (rule refl) (* next goal, same tactic *) apply (unfold IImsupp12_2_def image_Un image_UN) @@ -2959,7 +3041,7 @@ lemma IImsupp_naturals: apply (subst inv_o_simp1, rule assms) apply (unfold o_id) apply (unfold comp_def)[1] - apply (subst T1.FFVars_rrenames, (rule assms)+) + apply (subst FVars_permutes, (rule assms)+) apply (rule refl) (* next goal, same tactic *) apply (unfold IImsupp21_1_def image_Un image_UN) @@ -2970,7 +3052,7 @@ lemma IImsupp_naturals: apply (subst inv_o_simp1, rule assms) apply (unfold o_id) apply (unfold comp_def)[1] - apply (subst T1.FFVars_rrenames, (rule assms)+) + apply (subst FVars_permutes, (rule assms)+) apply (rule refl) (* next goal, same tactic *) apply (unfold IImsupp21_2_def image_Un image_UN) @@ -2981,47 +3063,47 @@ lemma IImsupp_naturals: apply (subst inv_o_simp1, rule assms) apply (unfold o_id) apply (unfold comp_def)[1] - apply (subst T1.FFVars_rrenames, (rule assms)+) + apply (subst FVars_permutes, (rule assms)+) apply (rule refl) done -lemma tvsubst_rrenames: +lemma tvsubst_permutes: fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| tvsubst_T1 g11 g12 g21 = tvsubst_T1 (rrename_T1 f1 f2 \ g11 \ inv f1) (rrename_T1 f1 f2 \ g12 \ inv f2) (rrename_T2 f1 f2 \ g21 \ inv f1) \ rrename_T1 f1 f2" - "rrename_T2 f1 f2 \ tvsubst_T2 g11 g12 g21 = tvsubst_T2 (rrename_T1 f1 f2 \ g11 \ inv f1) (rrename_T1 f1 f2 \ g12 \ inv f2) (rrename_T2 f1 f2 \ g21 \ inv f1) \ rrename_T2 f1 f2" + "permute_T1 f1 f2 \ tvsubst_T1 g11 g12 g21 = tvsubst_T1 (permute_T1 f1 f2 \ g11 \ inv f1) (permute_T1 f1 f2 \ g12 \ inv f2) (permute_T2 f1 f2 \ g21 \ inv f1) \ permute_T1 f1 f2" + "permute_T2 f1 f2 \ tvsubst_T2 g11 g12 g21 = tvsubst_T2 (permute_T1 f1 f2 \ g11 \ inv f1) (permute_T1 f1 f2 \ g12 \ inv f2) (permute_T2 f1 f2 \ g21 \ inv f1) \ permute_T2 f1 f2" proof - have x: "\t1 t2. - rrename_T1 f1 f2 (tvsubst_T1 g11 g12 g21 t1) = tvsubst_T1 (rrename_T1 f1 f2 \ g11 \ inv f1) (rrename_T1 f1 f2 \ g12 \ inv f2) (rrename_T2 f1 f2 \ g21 \ inv f1) (rrename_T1 f1 f2 t1) - \ rrename_T2 f1 f2 (tvsubst_T2 g11 g12 g21 t2) = tvsubst_T2 (rrename_T1 f1 f2 \ g11 \ inv f1) (rrename_T1 f1 f2 \ g12 \ inv f2) (rrename_T2 f1 f2 \ g21 \ inv f1) (rrename_T2 f1 f2 t2)" + permute_T1 f1 f2 (tvsubst_T1 g11 g12 g21 t1) = tvsubst_T1 (permute_T1 f1 f2 \ g11 \ inv f1) (permute_T1 f1 f2 \ g12 \ inv f2) (permute_T2 f1 f2 \ g21 \ inv f1) (permute_T1 f1 f2 t1) + \ permute_T2 f1 f2 (tvsubst_T2 g11 g12 g21 t2) = tvsubst_T2 (permute_T1 f1 f2 \ g11 \ inv f1) (permute_T1 f1 f2 \ g12 \ inv f2) (permute_T2 f1 f2 \ g21 \ inv f1) (permute_T2 f1 f2 t2)" subgoal for t1 t2 - apply (rule T1.TT_fresh_co_induct[of "IImsupp11_1 g11 \ IImsupp12_1 g12 \ IImsupp21_1 g21" "IImsupp11_2 g11 \ IImsupp12_2 g12 \ IImsupp21_2 g21" _ _ t1 t2]) + apply (rule fresh_induct[of "IImsupp11_1 g11 \ IImsupp12_1 g12 \ IImsupp21_1 g21" "IImsupp11_2 g11 \ IImsupp12_2 g12 \ IImsupp21_2 g21" _ _ t1 t2]) apply (unfold IImsupp_defs comp_def)[2] apply (rule var_T1_pre_class.Un_bound var_T1_pre_class.UN_bound infinite_UNIV g_prems[THEN ordLess_ordLeq_trans] - T1.card_of_FFVars_bounds cmin1 cmin2 card_of_Card_order)+ + FVars_bd_UNIVs cmin1 cmin2 card_of_Card_order)+ subgoal premises IHs for v (* EVERY for VVrs of T1 *) apply (rule case_split[rotated]) apply (rule case_split[rotated]) (* END EVERY *) - apply (subst T1.rrename_cctors, (rule f_prems)+) + apply (subst permute_simps, (rule f_prems)+) apply (subst tvsubst_T1_not_is_VVr[rotated -3]) apply (rule IHs) apply assumption+ apply (rule g_prems)+ - apply (rule disjointI, erule IHs)+ + apply (rule IHs)+ apply (subst tvsubst_T1_not_is_VVr[rotated -3]) - apply (rule T1.nnoclash_rrenames[THEN iffD2]) + apply (rule noclash_permutes[THEN iffD2]) apply (rule f_prems)+ apply (rule IHs) (* REPEAT_DETERM *) - apply (subst T1.rrename_cctors[symmetric, OF f_prems]) + apply (subst permute_simps[symmetric, OF f_prems]) apply (subst isVVr_renames[OF f_prems, symmetric]) apply assumption (* repeated *) - apply (subst T1.rrename_cctors[symmetric, OF f_prems]) + apply (subst permute_simps[symmetric, OF f_prems]) apply (subst isVVr_renames[OF f_prems, symmetric]) apply assumption (* END REPEAT_DETERM *) @@ -3044,26 +3126,24 @@ proof - apply (rule trans[OF image_Int[OF bij_is_inj, symmetric]]) apply (rule f_prems) apply (rule iffD2[OF image_is_empty]) - apply (rule disjointI) - apply (erule IHs) + apply (rule IHs) (* repeated *) apply (subst T1_pre.set_map IImsupp_naturals, (rule f_prems supp_id_bound bij_id)+)+ apply (unfold image_Un[symmetric]) apply (rule trans[OF image_Int[OF bij_is_inj, symmetric]]) apply (rule f_prems) apply (rule iffD2[OF image_is_empty]) - apply (rule disjointI) - apply (erule IHs) + apply (rule IHs) (* END REPEAT_DETERM *) apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (rule f_prems)+ apply (rule arg_cong[of _ _ T1_ctor]) apply (rule trans[OF T1_pre.map_comp]) - apply (rule supp_id_bound bij_id f_prems)+ + apply (rule supp_id_bound bij_id f_prems)+ apply (rule sym) apply (rule trans[OF T1_pre.map_comp]) - apply (rule supp_id_bound bij_id f_prems)+ + apply (rule supp_id_bound bij_id f_prems)+ apply (unfold id_o o_id) apply (rule T1_pre.map_cong0) apply (rule supp_id_bound bij_id f_prems refl)+ @@ -3093,7 +3173,7 @@ proof - apply (unfold isVVr12_def)[1] apply (erule exE) apply (erule subst[OF sym]) - apply (subst rrename_VVrs[OF f_prems]) + apply (subst permute_VVrs[OF f_prems]) apply (subst tvsubst_VVrs[OF g_prems]) apply (subst tvsubst_VVrs) (* REPEAT_DETERM *) @@ -3117,7 +3197,7 @@ proof - apply (unfold isVVr11_def)[1] apply (erule exE) apply (erule subst[OF sym]) - apply (subst rrename_VVrs[OF f_prems]) + apply (subst permute_VVrs[OF f_prems]) apply (subst tvsubst_VVrs[OF g_prems]) apply (subst tvsubst_VVrs) (* REPEAT_DETERM *) @@ -3143,18 +3223,18 @@ proof - (* EVERY for VVrs of T1 *) apply (rule case_split[rotated]) (* END EVERY *) - apply (subst T1.rrename_cctors, (rule f_prems)+) + apply (subst permute_simps, (rule f_prems)+) apply (subst tvsubst_T2_not_is_VVr[rotated -2]) apply (rule IHs) apply assumption+ apply (rule g_prems)+ - apply (rule disjointI, erule IHs)+ + apply (rule IHs)+ apply (subst tvsubst_T2_not_is_VVr[rotated -2]) - apply (rule T1.nnoclash_rrenames[THEN iffD2]) + apply (rule noclash_permutes[THEN iffD2]) apply (rule f_prems)+ apply (rule IHs) (* REPEAT_DETERM *) - apply (subst T1.rrename_cctors[symmetric, OF f_prems]) + apply (subst permute_simps[symmetric, OF f_prems]) apply (subst isVVr_renames[OF f_prems, symmetric]) apply assumption (* END REPEAT_DETERM *) @@ -3177,26 +3257,24 @@ proof - apply (rule trans[OF image_Int[OF bij_is_inj, symmetric]]) apply (rule f_prems) apply (rule iffD2[OF image_is_empty]) - apply (rule disjointI) - apply (erule IHs) + apply (rule IHs) (* repeated *) apply (subst T2_pre.set_map IImsupp_naturals, (rule f_prems supp_id_bound bij_id)+)+ apply (unfold image_Un[symmetric]) apply (rule trans[OF image_Int[OF bij_is_inj, symmetric]]) apply (rule f_prems) apply (rule iffD2[OF image_is_empty]) - apply (rule disjointI) - apply (erule IHs) + apply (rule IHs) (* END REPEAT_DETERM *) apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (rule f_prems)+ apply (rule arg_cong[of _ _ T2_ctor]) apply (rule trans[OF T2_pre.map_comp]) - apply (rule supp_id_bound bij_id f_prems)+ + apply (rule supp_id_bound bij_id f_prems)+ apply (rule sym) apply (rule trans[OF T2_pre.map_comp]) - apply (rule supp_id_bound bij_id f_prems)+ + apply (rule supp_id_bound bij_id f_prems)+ apply (unfold id_o o_id) apply (rule T2_pre.map_cong0) apply (rule supp_id_bound bij_id f_prems refl)+ @@ -3226,7 +3304,7 @@ proof - apply (unfold isVVr21_def)[1] apply (erule exE) apply (erule subst[OF sym]) - apply (subst rrename_VVrs[OF f_prems]) + apply (subst permute_VVrs[OF f_prems]) apply (subst tvsubst_VVrs[OF g_prems]) apply (subst tvsubst_VVrs) (* REPEAT_DETERM *) @@ -3251,19 +3329,19 @@ proof - done show - "rrename_T1 f1 f2 \ tvsubst_T1 g11 g12 g21 = tvsubst_T1 (rrename_T1 f1 f2 \ g11 \ inv f1) (rrename_T1 f1 f2 \ g12 \ inv f2) (rrename_T2 f1 f2 \ g21 \ inv f1) \ rrename_T1 f1 f2" - "rrename_T2 f1 f2 \ tvsubst_T2 g11 g12 g21 = tvsubst_T2 (rrename_T1 f1 f2 \ g11 \ inv f1) (rrename_T1 f1 f2 \ g12 \ inv f2) (rrename_T2 f1 f2 \ g21 \ inv f1) \ rrename_T2 f1 f2" + "permute_T1 f1 f2 \ tvsubst_T1 g11 g12 g21 = tvsubst_T1 (permute_T1 f1 f2 \ g11 \ inv f1) (permute_T1 f1 f2 \ g12 \ inv f2) (permute_T2 f1 f2 \ g21 \ inv f1) \ permute_T1 f1 f2" + "permute_T2 f1 f2 \ tvsubst_T2 g11 g12 g21 = tvsubst_T2 (permute_T1 f1 f2 \ g11 \ inv f1) (permute_T1 f1 f2 \ g12 \ inv f2) (permute_T2 f1 f2 \ g21 \ inv f1) \ permute_T2 f1 f2" apply (rule ext) apply (rule trans[OF comp_apply]) apply (rule sym) apply (rule trans[OF comp_apply]) apply (rule conjunct1[OF x, THEN sym]) - (* repeated *) + (* repeated *) apply (rule ext) - apply (rule trans[OF comp_apply]) - apply (rule sym) - apply (rule trans[OF comp_apply]) - apply (rule conjunct2[OF x, THEN sym]) + apply (rule trans[OF comp_apply]) + apply (rule sym) + apply (rule trans[OF comp_apply]) + apply (rule conjunct2[OF x, THEN sym]) done qed diff --git a/operations/VVSubst.thy b/operations/VVSubst.thy index 277be175..c9f53c1e 100644 --- a/operations/VVSubst.thy +++ b/operations/VVSubst.thy @@ -1,5 +1,5 @@ theory VVSubst - imports "./Fixpoint" + imports "./Least_Fixpoint" begin (********************************) @@ -18,14 +18,14 @@ abbreviation validP :: "('var, 'tyvar, 'a, 'b, 'c) P \ bool" where |supp f1| |supp f2| |supp f3| ('var, 'tyvar, 'a, 'b, 'c) P \ ('var, 'tyvar, 'a, 'c) U1" where +definition U1ctor :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'var, 'tyvar, 'var, ('var, 'tyvar, 'a, 'b, 'c) rec_T1, ('var, 'tyvar, 'a, 'b, 'c) rec_T1, ('var, 'tyvar, 'a, 'b, 'c) rec_T2, ('var, 'tyvar, 'a, 'b, 'c) rec_T2) T1_pre \ ('var, 'tyvar, 'a, 'b, 'c) P \ ('var, 'tyvar, 'a, 'c) U1" where "U1ctor x p \ case p of (f1, f2, f3, f4) \ - T1_ctor (map_T1_pre f1 f2 f3 f4 id id + T1_ctor (map_T1_pre f1 f2 f3 f4 id id f1 ((\R. R p) \ snd) ((\R. R p) \ snd) ((\R. R p) \ snd) ((\R. R p) \ snd) x )" -definition U2ctor :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'var, 'tyvar, ('var, 'tyvar, 'a, 'b, 'c) rec_T1, ('var, 'tyvar, 'a, 'b, 'c) rec_T1, ('var, 'tyvar, 'a, 'b, 'c) rec_T2, ('var, 'tyvar, 'a, 'b, 'c) rec_T2) T2_pre \ ('var, 'tyvar, 'a, 'b, 'c) P \ ('var, 'tyvar, 'a, 'c) U2" where +definition U2ctor :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'var, 'tyvar, 'var, ('var, 'tyvar, 'a, 'b, 'c) rec_T1, ('var, 'tyvar, 'a, 'b, 'c) rec_T1, ('var, 'tyvar, 'a, 'b, 'c) rec_T2, ('var, 'tyvar, 'a, 'b, 'c) rec_T2) T2_pre \ ('var, 'tyvar, 'a, 'b, 'c) P \ ('var, 'tyvar, 'a, 'c) U2" where "U2ctor x p \ case p of (f1, f2, f3, f4) \ - T2_ctor (map_T2_pre f1 f2 f3 f4 id id + T2_ctor (map_T2_pre f1 f2 f3 f4 id id f1 ((\R. R p) \ snd) ((\R. R p) \ snd) ((\R. R p) \ snd) ((\R. R p) \ snd) x )" @@ -38,23 +38,23 @@ abbreviation Pmap :: "('var \ 'var) \ ('tyvar \ case p of (f1, f2, f3, f4) \ (compSS g1 f1, compSS g2 f2, f3, f4)" abbreviation U1map :: "('var::{var_T1_pre, var_T2_pre} \ 'var) \ ('tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar) \ ('var, 'tyvar, 'a::{var_T1_pre, var_T2_pre}, 'b) T1 \ ('var, 'tyvar, 'a, 'c) U1 \ ('var, 'tyvar, 'a, 'c) U1" where - "U1map f1 f2 t \ \u. rrename_T1 f1 f2 u" + "U1map f1 f2 t \ \u. permute_T1 f1 f2 u" abbreviation U2map :: "('var::{var_T1_pre, var_T2_pre} \ 'var) \ ('tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar) \ ('var, 'tyvar, 'a::{var_T1_pre, var_T2_pre}, 'b) T2 \ ('var, 'tyvar, 'a, 'c) U2 \ ('var, 'tyvar, 'a, 'c) U2" where - "U2map f1 f2 t \ \u. rrename_T2 f1 f2 u" + "U2map f1 f2 t \ \u. permute_T2 f1 f2 u" abbreviation U1FVars_1 :: "('var, 'tyvar, 'a, 'b) T1 \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'c) U1 \ 'var set" where - "U1FVars_1 t u \ FFVars_T11 u" + "U1FVars_1 t u \ FVars_T11 u" abbreviation U1FVars_2 :: "('var, 'tyvar, 'a, 'b) T1 \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'c) U1 \ 'tyvar set" where - "U1FVars_2 t u \ FFVars_T12 u" + "U1FVars_2 t u \ FVars_T12 u" abbreviation U2FVars_1 :: "('var, 'tyvar, 'a, 'b) T2 \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'c) U2 \ 'var set" where - "U2FVars_1 t u \ FFVars_T21 u" + "U2FVars_1 t u \ FVars_T21 u" abbreviation U2FVars_2 :: "('var, 'tyvar, 'a, 'b) T2 \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'c) U2 \ 'tyvar set" where - "U2FVars_2 t u \ FFVars_T22 u" + "U2FVars_2 t u \ FVars_T22 u" function set3_raw_T1 :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) raw_T1 \ 'a set" and set3_raw_T2 :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) raw_T2 \ 'a set" where - "set3_raw_T1 (raw_T1_ctor x) = set3_T1_pre x \ \(set3_raw_T1 ` set7_T1_pre x) \ \(set3_raw_T1 ` set8_T1_pre x) \ \(set3_raw_T2 ` set9_T1_pre x) \ \(set3_raw_T2 ` set10_T1_pre x)" -| "set3_raw_T2 (raw_T2_ctor x) = set3_T2_pre x \ \(set3_raw_T1 ` set7_T2_pre x) \ \(set3_raw_T1 ` set8_T2_pre x) \ \(set3_raw_T2 ` set9_T2_pre x) \ \(set3_raw_T2 ` set10_T2_pre x)" + "set3_raw_T1 (raw_T1_ctor x) = set3_T1_pre x \ \(set3_raw_T1 ` set8_T1_pre x) \ \(set3_raw_T1 ` set9_T1_pre x) \ \(set3_raw_T2 ` set10_T1_pre x) \ \(set3_raw_T2 ` set11_T1_pre x)" +| "set3_raw_T2 (raw_T2_ctor x) = set3_T2_pre x \ \(set3_raw_T1 ` set8_T2_pre x) \ \(set3_raw_T1 ` set9_T2_pre x) \ \(set3_raw_T2 ` set10_T2_pre x) \ \(set3_raw_T2 ` set11_T2_pre x)" apply pat_completeness apply (unfold sum.inject raw_T1.inject raw_T2.inject sum.distinct) apply ((hypsubst, rule refl) | erule sum.distinct[THEN notE])+ @@ -64,14 +64,14 @@ termination Inl t1 \ (case y of Inl t1' \ subshape_T1_T1 t1 t1' | Inr t2 \ subshape_T1_T2 t1 t2) | Inr t2 \ (case y of Inl t1 \ subshape_T2_T1 t2 t1 | Inr t2' \ subshape_T2_T2 t2 t2') }") - apply (rule T1.wf_subshape) + apply (rule wf_subshape) apply (unfold mem_Collect_eq prod.case sum.case) - apply (erule T1.set_subshapes)+ + apply (erule set_subshapess)+ done function set4_raw_T1 :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) raw_T1 \ 'b set" and set4_raw_T2 :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) raw_T2 \ 'b set" where - "set4_raw_T1 (raw_T1_ctor x) = set4_T1_pre x \ \(set4_raw_T1 ` set7_T1_pre x) \ \(set4_raw_T1 ` set8_T1_pre x) \ \(set4_raw_T2 ` set9_T1_pre x) \ \(set4_raw_T2 ` set10_T1_pre x)" -| "set4_raw_T2 (raw_T2_ctor x) = set4_T2_pre x \ \(set4_raw_T1 ` set7_T2_pre x) \ \(set4_raw_T1 ` set8_T2_pre x) \ \(set4_raw_T2 ` set9_T2_pre x) \ \(set4_raw_T2 ` set10_T2_pre x)" + "set4_raw_T1 (raw_T1_ctor x) = set4_T1_pre x \ \(set4_raw_T1 ` set8_T1_pre x) \ \(set4_raw_T1 ` set9_T1_pre x) \ \(set4_raw_T2 ` set10_T1_pre x) \ \(set4_raw_T2 ` set11_T1_pre x)" +| "set4_raw_T2 (raw_T2_ctor x) = set4_T2_pre x \ \(set4_raw_T1 ` set8_T2_pre x) \ \(set4_raw_T1 ` set9_T2_pre x) \ \(set4_raw_T2 ` set10_T2_pre x) \ \(set4_raw_T2 ` set11_T2_pre x)" apply pat_completeness apply (unfold sum.inject raw_T1.inject raw_T2.inject) apply ((hypsubst, rule refl) | erule sum.distinct[THEN notE])+ @@ -81,9 +81,9 @@ termination Inl t1 \ (case y of Inl t1' \ subshape_T1_T1 t1 t1' | Inr t2 \ subshape_T1_T2 t1 t2) | Inr t2 \ (case y of Inl t1 \ subshape_T2_T1 t2 t1 | Inr t2' \ subshape_T2_T2 t2 t2') }") - apply (rule T1.wf_subshape) + apply (rule wf_subshape) apply (unfold mem_Collect_eq prod.case sum.case) - apply (erule T1.set_subshapes)+ + apply (erule set_subshapess)+ done definition "set3_T1 x \ set3_raw_T1 (quot_type.rep Rep_T1 x)" @@ -94,13 +94,13 @@ definition "set4_T2 x \ set4_raw_T2 (quot_type.rep Rep_T2 x)" coinductive rel_T1 :: "('b \ 'c \ bool) \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T1 \ ('var, 'tyvar, 'a, 'c) T1 \ bool" and rel_T2 :: "('b \ 'c \ bool) \ ('var, 'tyvar, 'a, 'b) T2 \ ('var, 'tyvar, 'a, 'c) T2 \ bool" where - "\ bij f1 ; |supp f1| (FFVars_T11 ` set8_T1_pre x) - set5_T1_pre x) \ (\(FFVars_T21 ` set10_T1_pre x) - set5_T1_pre x)) f1 ; - bij f2 ; |supp f2| (FFVars_T12 ` set8_T1_pre x) - set6_T1_pre x) f2 ; - rel_T1_pre R (rel_T1 R) (rel_T1 R) (rel_T2 R) (rel_T2 R) (map_T1_pre id id id id f1 f2 id (rrename_T1 f1 f2) id (rrename_T2 f1 id) x) y \ + "\ bij f1 ; |supp f1| \(FVars_T11 ` set9_T1_pre x) \ \(FVars_T21 ` set11_T1_pre x)) - set5_T1_pre x) f1 ; + bij f2 ; |supp f2| (FVars_T12 ` set9_T1_pre x) - set6_T1_pre x) f2 ; + rel_T1_pre R (rel_T1 R) (rel_T1 R) (rel_T2 R) (rel_T2 R) (map_T1_pre id id id id f1 f2 f1 id (permute_T1 f1 f2) id (permute_T2 f1 id) x) y \ \ rel_T1 R (T1_ctor x) (T1_ctor y)" -| "\ bij f1 ; |supp f1| (FFVars_T11 ` set8_T2_pre x2) - set5_T2_pre x2) \ (\(FFVars_T21 ` set10_T2_pre x2) - set5_T2_pre x2)) f1 ; - bij f2 ; |supp f2| (FFVars_T12 ` set8_T2_pre x2) - set6_T2_pre x2) f2 ; - rel_T2_pre R (rel_T1 R) (rel_T1 R) (rel_T2 R) (rel_T2 R) (map_T2_pre id id id id f1 f2 id (rrename_T1 f1 f2) id (rrename_T2 f1 id) x2) y2 \ +| "\ bij f1 ; |supp f1| \(FVars_T11 ` set9_T2_pre x2) \ \(FVars_T21 ` set11_T2_pre x2)) - set5_T2_pre x2) f1 ; + bij f2 ; |supp f2| (FVars_T12 ` set9_T2_pre x2) - set6_T2_pre x2) f2 ; + rel_T2_pre R (rel_T1 R) (rel_T1 R) (rel_T2 R) (rel_T2 R) (map_T2_pre id id id id f1 f2 f1 id (permute_T1 f1 f2) id (permute_T2 f1 id) x2) y2 \ \ rel_T2 R (T2_ctor x2) (T2_ctor y2)" (********************************) @@ -158,17 +158,17 @@ lemma small_PFVars: lemma U1map_Uctor: fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" assumes "bij f1" "|supp f1| U1map f1 f2 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst t)) (U1ctor y p) = - U1ctor (map_T1_pre f1 f2 id id f1 f2 - (\(t, pu). (rrename_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + shows "validP p \ U1map f1 f2 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst t)) (U1ctor y p) = + U1ctor (map_T1_pre f1 f2 id id f1 f2 f1 + (\(t, pu). (permute_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) y) (Pmap f1 f2 p)" apply (unfold U1ctor_def case_prod_beta fst_conv snd_conv) apply (erule conjE)+ apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (rule assms)+ apply (subst T1_pre.map_comp) apply (rule bij_id supp_id_bound assms | assumption)+ @@ -231,17 +231,17 @@ lemma U1map_Uctor: lemma U2map_Uctor: fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" assumes "bij f1" "|supp f1| U2map f1 f2 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst t)) (U2ctor y p) = - U2ctor (map_T2_pre f1 f2 id id f1 f2 - (\(t, pu). (rrename_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) - (\(t, pu). (rrename_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + shows "validP p \ U2map f1 f2 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst t)) (U2ctor y p) = + U2ctor (map_T2_pre f1 f2 id id f1 f2 f1 + (\(t, pu). (permute_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T1 f1 f2 t, \p. if validP p then U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) + (\(t, pu). (permute_T2 f1 f2 t, \p. if validP p then U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p)) else undefined)) y) (Pmap f1 f2 p)" apply (unfold U2ctor_def case_prod_beta fst_conv snd_conv) apply (erule conjE)+ apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (rule assms)+ apply (subst T2_pre.map_comp) apply (rule bij_id supp_id_bound assms | assumption)+ @@ -303,22 +303,35 @@ lemma U2map_Uctor: done lemma U1FVars_subsets: - "validP p \ set5_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T1_pre) \ (PFVars_1 p \ {}) = {} \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_1 t (pu p) \ FFVars_T11 t \ PFVars_1 p \ {}) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_1 t (pu p) \ FFVars_T21 t \ PFVars_1 p \ {}) \ - U1FVars_1 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) (U1ctor y p) \ FFVars_T11 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_1 p \ {}" - "validP p \ set6_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T1_pre) \ (PFVars_2 p \ {}) = {} \ - (\t pu p. validP p \ (t, pu) \ set7_T1_pre y \ set8_T1_pre y \ U1FVars_2 t (pu p) \ FFVars_T12 t \ PFVars_2 p \ {}) \ - (\t pu p. validP p \ (t, pu) \ set9_T1_pre y \ set10_T1_pre y \ U2FVars_2 t (pu p) \ FFVars_T22 t \ PFVars_2 p \ {}) \ - U1FVars_2 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) (U1ctor y p) \ FFVars_T12 (T1_ctor (map_T1_pre id id id id id id fst fst fst fst y)) \ PFVars_2 p \ {}" - apply (unfold case_prod_beta U1ctor_def Un_empty_right T1.FFVars_cctors) + "validP p \ set5_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T1_pre) \ (PFVars_1 p \ {}) = {} \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_1 t (pu p) \ FVars_T11 t \ PFVars_1 p \ {}) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_1 t (pu p) \ FVars_T21 t \ PFVars_1 p \ {}) \ + U1FVars_1 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) (U1ctor y p) \ FVars_T11 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_1 p \ {}" + "validP p \ set6_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T1_pre) \ (PFVars_2 p \ {}) = {} \ + (\t pu p. validP p \ (t, pu) \ set8_T1_pre y \ set9_T1_pre y \ U1FVars_2 t (pu p) \ FVars_T12 t \ PFVars_2 p \ {}) \ + (\t pu p. validP p \ (t, pu) \ set10_T1_pre y \ set11_T1_pre y \ U2FVars_2 t (pu p) \ FVars_T22 t \ PFVars_2 p \ {}) \ + U1FVars_2 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) (U1ctor y p) \ FVars_T12 (T1_ctor (map_T1_pre id id id id id id id fst fst fst fst y)) \ PFVars_2 p \ {}" + apply (unfold case_prod_beta U1ctor_def Un_empty_right FVars_ctors) apply (erule conjE)+ subgoal premises prems apply (subst T1_pre.set_map, (rule bij_id supp_id_bound prems)+)+ apply (unfold image_id image_comp comp_def) apply (rule Un_mono')+ (* REPEAT_DETERM FIRST' *) - apply (rule iffD1[OF arg_cong2[OF refl Un_commute, of "(\)"] image_imsupp_subset]) + (* TRY + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (rule Diff_Un_disjunct) + apply (rule prems) + apply (rule Diff_mono[OF _ subset_refl]) + *) + apply (rule iffD1[OF arg_cong2[OF refl Un_commute, of "(\)"] image_imsupp_subset]) + (* repeated *) + (* TRY *) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (rule Diff_Un_disjunct) + apply (rule prems) + apply (rule Diff_mono[OF _ subset_refl]) + apply (rule iffD1[OF arg_cong2[OF refl Un_commute, of "(\)"] image_imsupp_subset]) (* orelse *) (* TRY apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) @@ -467,21 +480,34 @@ lemma U1FVars_subsets: done lemma U2FVars_subsets: - "validP p \ set5_T2_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T2_pre) \ (PFVars_1 p \ {}) = {} \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y \ set8_T2_pre y \ U1FVars_1 t (pu p) \ FFVars_T11 t \ PFVars_1 p \ {}) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y \ set10_T2_pre y \ U2FVars_1 t (pu p) \ FFVars_T21 t \ PFVars_1 p \ {}) \ - U2FVars_1 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) (U2ctor y p) \ FFVars_T21 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) \ PFVars_1 p \ {}" - "validP p \ set6_T2_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _) T2_pre) \ (PFVars_2 p \ {}) = {} \ - (\t pu p. validP p \ (t, pu) \ set7_T2_pre y \ set8_T2_pre y \ U1FVars_2 t (pu p) \ FFVars_T12 t \ PFVars_2 p \ {}) \ - (\t pu p. validP p \ (t, pu) \ set9_T2_pre y \ set10_T2_pre y \ U2FVars_2 t (pu p) \ FFVars_T22 t \ PFVars_2 p \ {}) \ - U2FVars_2 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) (U2ctor y p) \ FFVars_T22 (T2_ctor (map_T2_pre id id id id id id fst fst fst fst y)) \ PFVars_2 p \ {}" - apply (unfold case_prod_beta U2ctor_def Un_empty_right T1.FFVars_cctors) + "validP p \ set5_T2_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T2_pre) \ (PFVars_1 p \ {}) = {} \ + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y \ set9_T2_pre y \ U1FVars_1 t (pu p) \ FVars_T11 t \ PFVars_1 p \ {}) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y \ set11_T2_pre y \ U2FVars_1 t (pu p) \ FVars_T21 t \ PFVars_1 p \ {}) \ + U2FVars_1 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) (U2ctor y p) \ FVars_T21 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) \ PFVars_1 p \ {}" + "validP p \ set6_T2_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T2_pre) \ (PFVars_2 p \ {}) = {} \ + (\t pu p. validP p \ (t, pu) \ set8_T2_pre y \ set9_T2_pre y \ U1FVars_2 t (pu p) \ FVars_T12 t \ PFVars_2 p \ {}) \ + (\t pu p. validP p \ (t, pu) \ set10_T2_pre y \ set11_T2_pre y \ U2FVars_2 t (pu p) \ FVars_T22 t \ PFVars_2 p \ {}) \ + U2FVars_2 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) (U2ctor y p) \ FVars_T22 (T2_ctor (map_T2_pre id id id id id id id fst fst fst fst y)) \ PFVars_2 p \ {}" + apply (unfold case_prod_beta U2ctor_def Un_empty_right FVars_ctors) apply (erule conjE)+ subgoal premises prems apply (subst T2_pre.set_map, (rule bij_id supp_id_bound prems)+)+ apply (unfold image_id image_comp comp_def) apply (rule Un_mono')+ (* REPEAT_DETERM FIRST' *) + (* TRY + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (rule Diff_Un_disjunct) + apply (rule prems) + apply (rule Diff_mono[OF _ subset_refl]) + *) + apply (rule iffD1[OF arg_cong2[OF refl Un_commute, of "(\)"] image_imsupp_subset]) + (* repeated *) + (* TRY *) + apply (rule iffD2[OF arg_cong2[OF refl, of _ _ "(\)"]]) + apply (rule Diff_Un_disjunct) + apply (rule prems) + apply (rule Diff_mono[OF _ subset_refl]) apply (rule iffD1[OF arg_cong2[OF refl Un_commute, of "(\)"] image_imsupp_subset]) (* orelse *) (* TRY @@ -691,11 +717,11 @@ val T1_model = { axioms = { Umap_id0 = fn ctxt => EVERY1 [ resolve_tac ctxt [trans], - resolve_tac ctxt @{thms T1.rrename_id0s[THEN fun_cong]}, + resolve_tac ctxt @{thms permute_id0s[THEN fun_cong]}, resolve_tac ctxt @{thms id_apply} ], - Umap_comp0 = fn ctxt => resolve_tac ctxt @{thms T1.rrename_comp0s[symmetric, THEN fun_cong]} 1 THEN REPEAT_DETERM (assume_tac ctxt 1), - Umap_cong_id = fn ctxt => resolve_tac ctxt @{thms T1.rrename_cong_ids} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE Goal.assume_rule_tac ctxt 1), + Umap_comp0 = fn ctxt => resolve_tac ctxt @{thms permute_comp0s[symmetric, THEN fun_cong]} 1 THEN REPEAT_DETERM (assume_tac ctxt 1), + Umap_cong_id = fn ctxt => resolve_tac ctxt @{thms permute_cong_ids} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE Goal.assume_rule_tac ctxt 1), Umap_Uctor = fn ctxt => EVERY1 [ K (Local_Defs.unfold0_tac ctxt @{thms if_True}), resolve_tac ctxt @{thms U1map_Uctor}, @@ -725,17 +751,24 @@ val T2_model = { axioms = { Umap_id0 = fn ctxt => EVERY1 [ resolve_tac ctxt [trans], - resolve_tac ctxt @{thms T1.rrename_id0s[THEN fun_cong]}, + resolve_tac ctxt @{thms permute_id0s[THEN fun_cong]}, resolve_tac ctxt @{thms id_apply} ], - Umap_comp0 = fn ctxt => resolve_tac ctxt @{thms T1.rrename_comp0s[symmetric, THEN fun_cong]} 1 THEN REPEAT_DETERM (assume_tac ctxt 1), - Umap_cong_id = fn ctxt => resolve_tac ctxt @{thms T1.rrename_cong_ids} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE Goal.assume_rule_tac ctxt 1), + Umap_comp0 = fn ctxt => resolve_tac ctxt @{thms permute_comp0s[symmetric, THEN fun_cong]} 1 THEN REPEAT_DETERM (assume_tac ctxt 1), + Umap_cong_id = fn ctxt => resolve_tac ctxt @{thms permute_cong_ids} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE Goal.assume_rule_tac ctxt 1), Umap_Uctor = fn ctxt => resolve_tac ctxt @{thms U2map_Uctor} 1 THEN REPEAT_DETERM (assume_tac ctxt 1), UFVars_subsets = replicate nvars (fn ctxt => resolve_tac ctxt @{thms U2FVars_subsets} 1 THEN REPEAT_DETERM (assume_tac ctxt 1 ORELSE Goal.assume_rule_tac ctxt 1)) } }; -val fp_res = the (MRBNF_FP_Def_Sugar.fp_result_of @{context} "Fixpoint.T1") +val fp_res = the (MRBNF_FP_Def_Sugar.fp_result_of @{context} "Least_Fixpoint.T1") +\ + +ML_file \../Tools/mrbnf_recursor_tactics.ML\ +ML_file \../Tools/mrbnf_recursor.ML\ + +ML \ +Multithreading.parallel_proofs := 0 \ local_setup \fn lthy => @@ -778,15 +811,15 @@ lemma set3_raw_rename: and x::"('var, 'tyvar, 'a::{var_T1_pre,var_T2_pre}, 'b) raw_T1" and y::"('var, 'tyvar, 'a::{var_T1_pre,var_T2_pre}, 'b) raw_T2" assumes "bij f1" "|supp f1| set3_raw_T2 (rename_T2 f1 f2 y) = set3_raw_T2 y" - apply (rule T1.TT_subshape_induct) + have x: "set3_raw_T1 (permute_raw_T1 f1 f2 x) = set3_raw_T1 x \ set3_raw_T2 (permute_raw_T2 f1 f2 y) = set3_raw_T2 y" + apply (rule subshape_induct) subgoal for y apply (rule raw_T1.exhaust[of y]) apply hypsubst_thin - apply (subst T1.rename_simps) + apply (subst permute_raw_simps) apply (rule assms)+ apply (unfold set3_raw_T1.simps) apply (subst T1_pre.set_map, (rule assms supp_id_bound bij_id)+)+ @@ -796,19 +829,19 @@ proof - apply (rule refl) (* REPEAT_DETERM *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* copied from above *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* copied from above *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* copied from above *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* END REPEAT_DETERM *) done @@ -816,7 +849,7 @@ proof - subgoal for y apply (rule raw_T2.exhaust[of y]) apply hypsubst_thin - apply (subst T1.rename_simps) + apply (subst permute_raw_simps) apply (rule assms)+ apply (unfold set3_raw_T2.simps) apply (subst T2_pre.set_map, (rule assms supp_id_bound bij_id)+)+ @@ -826,28 +859,28 @@ proof - apply (rule refl) (* REPEAT_DETERM *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* copied from above *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* copied from above *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* copied from above *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption done done - show "set3_raw_T1 (rename_T1 f1 f2 x) = set3_raw_T1 x" + show "set3_raw_T1 (permute_raw_T1 f1 f2 x) = set3_raw_T1 x" apply (insert x) apply (erule conjE)+ apply assumption done - show "set3_raw_T2 (rename_T2 f1 f2 y) = set3_raw_T2 y" + show "set3_raw_T2 (permute_raw_T2 f1 f2 y) = set3_raw_T2 y" apply (insert x) apply (erule conjE)+ apply assumption @@ -859,15 +892,15 @@ lemma set4_raw_rename: and x::"('var, 'tyvar, 'a::{var_T1_pre,var_T2_pre}, 'b) raw_T1" and y::"('var, 'tyvar, 'a::{var_T1_pre,var_T2_pre}, 'b) raw_T2" assumes "bij f1" "|supp f1| set4_raw_T2 (rename_T2 f1 f2 y) = set4_raw_T2 y" - apply (rule T1.TT_subshape_induct) + have x: "set4_raw_T1 (permute_raw_T1 f1 f2 x) = set4_raw_T1 x \ set4_raw_T2 (permute_raw_T2 f1 f2 y) = set4_raw_T2 y" + apply (rule subshape_induct) subgoal for y apply (rule raw_T1.exhaust[of y]) apply hypsubst_thin - apply (subst T1.rename_simps) + apply (subst permute_raw_simps) apply (rule assms)+ apply (unfold set4_raw_T1.simps) apply (subst T1_pre.set_map, (rule assms supp_id_bound bij_id)+)+ @@ -877,19 +910,19 @@ proof - apply (rule refl) (* REPEAT_DETERM *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* copied from above *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* copied from above *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* copied from above *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* END REPEAT_DETERM *) done @@ -897,7 +930,7 @@ proof - subgoal for y apply (rule raw_T2.exhaust[of y]) apply hypsubst_thin - apply (subst T1.rename_simps) + apply (subst permute_raw_simps) apply (rule assms)+ apply (unfold set4_raw_T2.simps) apply (subst T2_pre.set_map, (rule assms supp_id_bound bij_id)+)+ @@ -907,28 +940,28 @@ proof - apply (rule refl) (* REPEAT_DETERM *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* copied from above *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* copied from above *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* copied from above *) apply (rule UN_cong) - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption done done - show "set4_raw_T1 (rename_T1 f1 f2 x) = set4_raw_T1 x" + show "set4_raw_T1 (permute_raw_T1 f1 f2 x) = set4_raw_T1 x" apply (insert x) apply (erule conjE)+ apply assumption done - show "set4_raw_T2 (rename_T2 f1 f2 y) = set4_raw_T2 y" + show "set4_raw_T2 (permute_raw_T2 f1 f2 y) = set4_raw_T2 y" apply (insert x) apply (erule conjE)+ apply assumption @@ -942,7 +975,7 @@ lemma set3_raw_alpha: "alpha_T2 x2 y2 \ set3_raw_T2 x2 = set3_raw_T2 y2" proof - have x: "(alpha_T1 x y \ set3_raw_T1 x = set3_raw_T1 y) \ (alpha_T2 x2 y2 \ set3_raw_T2 x2 = set3_raw_T2 y2)" - apply (rule conj_spec[OF T1.TT_subshape_induct[of "\x. \y. alpha_T1 x y \ set3_raw_T1 x = set3_raw_T1 y" + apply (rule conj_spec[OF subshape_induct[of "\x. \y. alpha_T1 x y \ set3_raw_T1 x = set3_raw_T1 y" "\x. \y. alpha_T2 x y \ set3_raw_T2 x = set3_raw_T2 y"]]) apply (rule allI) apply (rule impI) @@ -956,52 +989,52 @@ proof - apply (rule supp_id_bound bij_id | assumption)+ apply (rule image_id) (* REPEAT_DETERM *) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* ORELSE *) - (* apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + (* apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set3_raw_rename[symmetric]) prefer 5 (* 2 * nvars + 1 *) apply (assumption | rule supp_id_bound bij_id)+ *) (* repeated *) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - (* apply (drule T1.set_subshapes) + (* apply (drule set_subshapess) apply assumption *) (* ORELSE *) - apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set3_raw_rename[symmetric]) prefer 5 (* 2 * nvars + 1 *) apply (assumption | rule supp_id_bound bij_id)+ (* repeated *) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* ORELSE *) - (* apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + (* apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set3_raw_rename[symmetric]) prefer 5 (* 2 * nvars + 1 *) apply (assumption | rule supp_id_bound bij_id)+ *) (* repeated *) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - (* apply (drule T1.set_subshapes) + (* apply (drule set_subshapess) apply assumption *) (* ORELSE *) - apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set3_raw_rename[symmetric]) @@ -1020,26 +1053,26 @@ proof - apply (rule supp_id_bound bij_id | assumption)+ apply (rule image_id) (* REPEAT_DETERM *) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* ORELSE *) - (* apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + (* apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set3_raw_rename[symmetric]) prefer 5 (* 2 * nvars + 1 *) apply (assumption | rule supp_id_bound bij_id)+ *) (* repeated *) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - (* apply (drule T1.set_subshapes) + (* apply (drule set_subshapess) apply assumption *) (* ORELSE *) - apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set3_raw_rename[symmetric]) @@ -1047,13 +1080,13 @@ proof - apply (assumption | rule supp_id_bound bij_id)+ (* repeated *) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* ORELSE *) - (* apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + (* apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set3_raw_rename[symmetric]) @@ -1061,13 +1094,13 @@ proof - apply (assumption | rule supp_id_bound bij_id)+ *) (* repeated *) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - (* apply (drule T1.set_subshapes) + (* apply (drule set_subshapess) apply assumption *) (* ORELSE *) - apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set3_raw_rename[symmetric]) @@ -1096,7 +1129,7 @@ lemma set4_raw_alpha: "alpha_T2 x2 y2 \ set4_raw_T2 x2 = set4_raw_T2 y2" proof - have x: "(alpha_T1 x y \ set4_raw_T1 x = set4_raw_T1 y) \ (alpha_T2 x2 y2 \ set4_raw_T2 x2 = set4_raw_T2 y2)" - apply (rule conj_spec[OF T1.TT_subshape_induct[of "\x. \y. alpha_T1 x y \ set4_raw_T1 x = set4_raw_T1 y" + apply (rule conj_spec[OF subshape_induct[of "\x. \y. alpha_T1 x y \ set4_raw_T1 x = set4_raw_T1 y" "\x. \y. alpha_T2 x y \ set4_raw_T2 x = set4_raw_T2 y"]]) apply (rule allI) apply (rule impI) @@ -1106,56 +1139,56 @@ proof - apply (rule arg_cong2[of _ _ _ _ "(\)"])+ apply (rule sym) apply (rule trans) - apply (erule T1_pre.mr_rel_set[rotated -1] T1_pre.mr_set_transfer(4, 7-10)[THEN rel_funD, THEN iffD1[OF fun_cong[OF fun_cong[OF rel_set_eq]]], THEN sym, rotated -1]) + apply (erule T1_pre.mr_rel_set[rotated -1] T1_pre.mr_set_transfer(4, 8-11)[THEN rel_funD, THEN iffD1[OF fun_cong[OF fun_cong[OF rel_set_eq]]], THEN sym, rotated -1]) apply (rule supp_id_bound bij_id | assumption)+ apply (rule image_id refl) (* REPEAT_DETERM *) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* ORELSE *) - (* apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + (* apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set3_raw_rename[symmetric]) prefer 5 (* 2 * nvars + 1 *) apply (assumption | rule supp_id_bound bij_id)+ *) (* repeated *) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - (* apply (drule T1.set_subshapes) + (* apply (drule set_subshapess) apply assumption *) (* ORELSE *) - apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set4_raw_rename[symmetric]) prefer 5 (* 2 * nvars + 1 *) apply (assumption | rule supp_id_bound bij_id)+ (* repeated *) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* ORELSE *) - (* apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + (* apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set3_raw_rename[symmetric]) prefer 5 (* 2 * nvars + 1 *) apply (assumption | rule supp_id_bound bij_id)+ *) (* repeated *) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - (* apply (drule T1.set_subshapes) + (* apply (drule set_subshapess) apply assumption *) (* ORELSE *) - apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set4_raw_rename[symmetric]) @@ -1170,30 +1203,30 @@ proof - apply (rule arg_cong2[of _ _ _ _ "(\)"])+ apply (rule sym) apply (rule trans) - apply (erule T2_pre.mr_rel_set[rotated -1] T2_pre.mr_set_transfer(4, 7-10)[THEN rel_funD, THEN iffD1[OF fun_cong[OF fun_cong[OF rel_set_eq]]], THEN sym, rotated -1]) + apply (erule T2_pre.mr_rel_set[rotated -1] T2_pre.mr_set_transfer(4, 8-11)[THEN rel_funD, THEN iffD1[OF fun_cong[OF fun_cong[OF rel_set_eq]]], THEN sym, rotated -1]) apply (rule supp_id_bound bij_id | assumption)+ apply (rule image_id refl) (* REPEAT_DETERM *) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* ORELSE *) - (* apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + (* apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set3_raw_rename[symmetric]) prefer 5 (* 2 * nvars + 1 *) apply (assumption | rule supp_id_bound bij_id)+ *) (* repeated *) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - (* apply (drule T1.set_subshapes) + (* apply (drule set_subshapess) apply assumption *) (* ORELSE *) - apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set4_raw_rename[symmetric]) @@ -1201,13 +1234,13 @@ proof - apply (assumption | rule supp_id_bound bij_id)+ (* repeated *) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - apply (drule T1.set_subshapes) + apply (drule set_subshapess) apply assumption (* ORELSE *) - (* apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + (* apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set3_raw_rename[symmetric]) @@ -1215,13 +1248,13 @@ proof - apply (assumption | rule supp_id_bound bij_id)+ *) (* repeated *) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated], THEN rel_set_UN_D]) apply (rule supp_id_bound bij_id | assumption)+ apply (unfold atomize_all[symmetric] atomize_imp[symmetric])[1] - (* apply (drule T1.set_subshapes) + (* apply (drule set_subshapess) apply assumption *) (* ORELSE *) - apply (drule T1.set_subshape_images[rotated -1, OF imageI]) + apply (drule set_subshape_permutess[rotated -1]) prefer 5 apply (rule trans) apply (rule set4_raw_rename[symmetric]) @@ -1243,44 +1276,44 @@ proof - done qed -lemma set3_T1_simp: "set3_T1 (T1_ctor x) = set3_T1_pre x \ \(set3_T1 ` set7_T1_pre x) \ \(set3_T1 ` set8_T1_pre x) \ \(set3_T2 ` set9_T1_pre x) \ \(set3_T2 ` set10_T1_pre x)" +lemma set3_T1_simp: "set3_T1 (T1_ctor x) = set3_T1_pre x \ \(set3_T1 ` set8_T1_pre x) \ \(set3_T1 ` set9_T1_pre x) \ \(set3_T2 ` set10_T1_pre x) \ \(set3_T2 ` set11_T1_pre x)" apply (unfold set3_T1_def set3_T2_def T1_ctor_def) apply (rule trans) apply (rule set3_raw_alpha) - apply (rule T1.TT_Quotient_rep_abss) + apply (rule TT_rep_abs) apply (rule trans) apply (rule set3_raw_T1.simps) apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)+ apply (unfold image_id image_comp[unfolded comp_def]) apply (rule refl) done -lemma set3_T2_simp: "set3_T2 (T2_ctor x) = set3_T2_pre x \ \(set3_T1 ` set7_T2_pre x) \ \(set3_T1 ` set8_T2_pre x) \ \(set3_T2 ` set9_T2_pre x) \ \(set3_T2 ` set10_T2_pre x)" +lemma set3_T2_simp: "set3_T2 (T2_ctor x) = set3_T2_pre x \ \(set3_T1 ` set8_T2_pre x) \ \(set3_T1 ` set9_T2_pre x) \ \(set3_T2 ` set10_T2_pre x) \ \(set3_T2 ` set11_T2_pre x)" apply (unfold set3_T1_def set3_T2_def T2_ctor_def) apply (rule trans) apply (rule set3_raw_alpha) - apply (rule T1.TT_Quotient_rep_abss) + apply (rule TT_rep_abs) apply (rule trans) apply (rule set3_raw_T2.simps) apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)+ apply (unfold image_id image_comp[unfolded comp_def]) apply (rule refl) done -lemma set4_T1_simp: "set4_T1 (T1_ctor x) = set4_T1_pre x \ \(set4_T1 ` set7_T1_pre x) \ \(set4_T1 ` set8_T1_pre x) \ \(set4_T2 ` set9_T1_pre x) \ \(set4_T2 ` set10_T1_pre x)" +lemma set4_T1_simp: "set4_T1 (T1_ctor x) = set4_T1_pre x \ \(set4_T1 ` set8_T1_pre x) \ \(set4_T1 ` set9_T1_pre x) \ \(set4_T2 ` set10_T1_pre x) \ \(set4_T2 ` set11_T1_pre x)" apply (unfold set4_T1_def set4_T2_def T1_ctor_def) apply (rule trans) apply (rule set4_raw_alpha) - apply (rule T1.TT_Quotient_rep_abss) + apply (rule TT_rep_abs) apply (rule trans) apply (rule set4_raw_T1.simps) apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)+ apply (unfold image_id image_comp[unfolded comp_def]) apply (rule refl) done -lemma set4_T2_simp: "set4_T2 (T2_ctor x) = set4_T2_pre x \ \(set4_T1 ` set7_T2_pre x) \ \(set4_T1 ` set8_T2_pre x) \ \(set4_T2 ` set9_T2_pre x) \ \(set4_T2 ` set10_T2_pre x)" +lemma set4_T2_simp: "set4_T2 (T2_ctor x) = set4_T2_pre x \ \(set4_T1 ` set8_T2_pre x) \ \(set4_T1 ` set9_T2_pre x) \ \(set4_T2 ` set10_T2_pre x) \ \(set4_T2 ` set11_T2_pre x)" apply (unfold set4_T1_def set4_T2_def T2_ctor_def) apply (rule trans) apply (rule set4_raw_alpha) - apply (rule T1.TT_Quotient_rep_abss) + apply (rule TT_rep_abs) apply (rule trans) apply (rule set4_raw_T2.simps) apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)+ @@ -1290,10 +1323,10 @@ lemma set4_T2_simp: "set4_T2 (T2_ctor x) = set4_T2_pre x \ \(set4_ lemma set3_T1_intros: "a \ set3_T1_pre x \ a \ set3_T1 (T1_ctor x)" - "y \ set7_T1_pre x \ a \ set3_T1 y \ a \ set3_T1 (T1_ctor x)" "y \ set8_T1_pre x \ a \ set3_T1 y \ a \ set3_T1 (T1_ctor x)" - "y2 \ set9_T1_pre x \ a \ set3_T2 y2 \ a \ set3_T1 (T1_ctor x)" + "y \ set9_T1_pre x \ a \ set3_T1 y \ a \ set3_T1 (T1_ctor x)" "y2 \ set10_T1_pre x \ a \ set3_T2 y2 \ a \ set3_T1 (T1_ctor x)" + "y2 \ set11_T1_pre x \ a \ set3_T2 y2 \ a \ set3_T1 (T1_ctor x)" apply - apply (unfold set3_T1_simp) apply (erule contrapos_pp) @@ -1331,10 +1364,10 @@ lemma set3_T1_intros: done lemma set3_T2_intros: "a \ set3_T2_pre x \ a \ set3_T2 (T2_ctor x)" - "y \ set7_T2_pre x \ a \ set3_T1 y \ a \ set3_T2 (T2_ctor x)" "y \ set8_T2_pre x \ a \ set3_T1 y \ a \ set3_T2 (T2_ctor x)" - "y2 \ set9_T2_pre x \ a \ set3_T2 y2 \ a \ set3_T2 (T2_ctor x)" + "y \ set9_T2_pre x \ a \ set3_T1 y \ a \ set3_T2 (T2_ctor x)" "y2 \ set10_T2_pre x \ a \ set3_T2 y2 \ a \ set3_T2 (T2_ctor x)" + "y2 \ set11_T2_pre x \ a \ set3_T2 y2 \ a \ set3_T2 (T2_ctor x)" apply - apply (unfold set3_T2_simp) apply (erule contrapos_pp) @@ -1372,10 +1405,10 @@ lemma set3_T2_intros: done lemma set4_T1_intros: "a \ set4_T1_pre x \ a \ set4_T1 (T1_ctor x)" - "y \ set7_T1_pre x \ a \ set4_T1 y \ a \ set4_T1 (T1_ctor x)" "y \ set8_T1_pre x \ a \ set4_T1 y \ a \ set4_T1 (T1_ctor x)" - "y2 \ set9_T1_pre x \ a \ set4_T2 y2 \ a \ set4_T1 (T1_ctor x)" + "y \ set9_T1_pre x \ a \ set4_T1 y \ a \ set4_T1 (T1_ctor x)" "y2 \ set10_T1_pre x \ a \ set4_T2 y2 \ a \ set4_T1 (T1_ctor x)" + "y2 \ set11_T1_pre x \ a \ set4_T2 y2 \ a \ set4_T1 (T1_ctor x)" apply - apply (unfold set4_T1_simp) apply (erule contrapos_pp) @@ -1413,10 +1446,10 @@ lemma set4_T1_intros: done lemma set4_T2_intros: "a \ set4_T2_pre x \ a \ set4_T2 (T2_ctor x)" - "y \ set7_T2_pre x \ a \ set4_T1 y \ a \ set4_T2 (T2_ctor x)" "y \ set8_T2_pre x \ a \ set4_T1 y \ a \ set4_T2 (T2_ctor x)" - "y2 \ set9_T2_pre x \ a \ set4_T2 y2 \ a \ set4_T2 (T2_ctor x)" + "y \ set9_T2_pre x \ a \ set4_T1 y \ a \ set4_T2 (T2_ctor x)" "y2 \ set10_T2_pre x \ a \ set4_T2 y2 \ a \ set4_T2 (T2_ctor x)" + "y2 \ set11_T2_pre x \ a \ set4_T2 y2 \ a \ set4_T2 (T2_ctor x)" apply - apply (unfold set4_T2_simp) apply (erule contrapos_pp) @@ -1458,7 +1491,7 @@ lemma vvsubst_cctor_1: assumes f_prems: "|supp f1| set5_T1_pre x = {}" "imsupp f2 \ set6_T1_pre x = {}" and noclash_prems: "noclash_T1 x" - shows "vvsubst_T1 f1 f2 f3 f4 (T1_ctor x) = T1_ctor (map_T1_pre f1 f2 f3 f4 id id (vvsubst_T1 f1 f2 f3 f4) (vvsubst_T1 f1 f2 f3 f4) (vvsubst_T2 f1 f2 f3 f4) (vvsubst_T2 f1 f2 f3 f4) x)" + shows "vvsubst_T1 f1 f2 f3 f4 (T1_ctor x) = T1_ctor (map_T1_pre f1 f2 f3 f4 id id f1 (vvsubst_T1 f1 f2 f3 f4) (vvsubst_T1 f1 f2 f3 f4) (vvsubst_T2 f1 f2 f3 f4) (vvsubst_T2 f1 f2 f3 f4) x)" apply (unfold vvsubst_T1_def vvsubst_T2_def) apply (rule trans) apply (rule T1.rec_Uctors) @@ -1481,7 +1514,7 @@ lemma vvsubst_cctor_2: assumes f_prems: "|supp f1| set5_T2_pre x = {}" "imsupp f2 \ set6_T2_pre x = {}" and noclash_prems: "noclash_T2 x" - shows "vvsubst_T2 f1 f2 f3 f4 (T2_ctor x) = T2_ctor (map_T2_pre f1 f2 f3 f4 id id (vvsubst_T1 f1 f2 f3 f4) (vvsubst_T1 f1 f2 f3 f4) (vvsubst_T2 f1 f2 f3 f4) (vvsubst_T2 f1 f2 f3 f4) x)" + shows "vvsubst_T2 f1 f2 f3 f4 (T2_ctor x) = T2_ctor (map_T2_pre f1 f2 f3 f4 id id f1 (vvsubst_T1 f1 f2 f3 f4) (vvsubst_T1 f1 f2 f3 f4) (vvsubst_T2 f1 f2 f3 f4) (vvsubst_T2 f1 f2 f3 f4) x)" (* same tactic as above *) apply (unfold vvsubst_T1_def vvsubst_T2_def) apply (rule trans) @@ -1500,16 +1533,16 @@ lemma vvsubst_cctor_2: apply (rule conjI f_prems)+ done -lemma vvsubst_rrenames: +lemma vvsubst_permutes: fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| 'a) (id::'b \ 'b) = rrename_T1 f1 f2" - "vvsubst_T2 f1 f2 (id::'a::{var_T1_pre,var_T2_pre} \ 'a) (id::'b \ 'b) = rrename_T2 f1 f2" + "vvsubst_T1 f1 f2 (id::'a::{var_T1_pre,var_T2_pre} \ 'a) (id::'b \ 'b) = permute_T1 f1 f2" + "vvsubst_T2 f1 f2 (id::'a::{var_T1_pre,var_T2_pre} \ 'a) (id::'b \ 'b) = permute_T2 f1 f2" proof - - have x: "\(x::('var, 'tyvar, 'a, 'b) T1) (y::('var, 'tyvar, 'a, 'b) T2). vvsubst_T1 f1 f2 id id x = rrename_T1 f1 f2 x \ vvsubst_T2 f1 f2 id id y = rrename_T2 f1 f2 y" - subgoal for x y - apply (rule T1.TT_fresh_co_induct[of _ _ _ _ x y]) + have x: "\(x::('var, 'tyvar, 'a, 'b) T1) (y::('var, 'tyvar, 'a, 'b) T2). vvsubst_T1 f1 f2 id id x = permute_T1 f1 f2 x \ vvsubst_T2 f1 f2 id id y = permute_T2 f1 f2 y" + subgoal for x y + apply (rule fresh_induct[of _ _ _ _ x y]) (* REPEAT_DETERM *) apply (rule iffD2[OF imsupp_supp_bound]) apply (rule infinite_UNIV) @@ -1523,73 +1556,35 @@ proof - apply (rule trans) apply (rule vvsubst_cctor_1 vvsubst_cctor_2) apply (rule f_prems supp_id_bound bij_id)+ - (* REPEAT_DETERM *) - (* Int_empty_tac *) - apply (subst Int_commute) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END Int_empty_tac *) - (* Int_empty_tac repeated *) - apply (subst Int_commute) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END Int_empty_tac repeated *) - (* END REPEAT_DETERM *) + apply (subst Int_commute, assumption)+ apply assumption apply (rule sym) apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (rule f_prems)+ apply (rule arg_cong[OF T1_pre.map_cong]) apply (rule f_prems supp_id_bound bij_id refl)+ (* REPEAT_DETERM *) apply (rule trans[OF _ id_apply[symmetric]]) apply (erule id_onD[OF imsupp_id_on, rotated]) - (* Int_empty_tac *) - apply (subst Int_commute) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END Int_empty_tac *) + apply (subst Int_commute, assumption) (* copied from above *) apply (rule trans[OF _ id_apply[symmetric]]) apply (erule id_onD[OF imsupp_id_on, rotated]) - (* Int_empty_tac *) - apply (subst Int_commute) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END Int_empty_tac *) + apply (subst Int_commute, assumption) (* ORELSE *) + apply (rule refl)+ + (* ORELSE *) apply (rule sym, assumption)+ (* SUBGOAL 2, same tactic as above *) apply (rule trans) apply (rule vvsubst_cctor_1 vvsubst_cctor_2) apply (rule f_prems supp_id_bound bij_id)+ - (* Int_empty_tac *) - apply (subst Int_commute) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END Int_empty_tac *) - (* Int_empty_tac *) - apply (subst Int_commute) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END Int_empty_tac *) + apply (subst Int_commute, assumption)+ apply assumption apply (rule sym) apply (rule trans) - apply (rule T1.rrename_cctors) + apply (rule permute_simps) apply (rule f_prems)+ apply (rule arg_cong[of _ _ T2_ctor]) apply (rule T2_pre.map_cong) @@ -1597,33 +1592,23 @@ proof - (* REPEAT_DETERM *) apply (rule trans[OF _ id_apply[symmetric]]) apply (erule id_onD[OF imsupp_id_on, rotated]) - (* Int_empty_tac *) - apply (subst Int_commute) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END Int_empty_tac *) - (* copied from above *) - apply (rule trans[OF _ id_apply[symmetric]]) - apply (erule id_onD[OF imsupp_id_on, rotated]) - (* Int_empty_tac *) - apply (subst Int_commute) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END Int_empty_tac *) + apply (subst Int_commute, assumption) + (* repeated *) + apply (rule trans[OF _ id_apply[symmetric]]) + apply (erule id_onD[OF imsupp_id_on, rotated]) + apply (subst Int_commute, assumption) + (* END REPEAT_DETERM *) + apply (rule refl)+ (* ORELSE *) apply (rule sym, assumption)+ done done - show "vvsubst_T1 f1 f2 (id::'a::{var_T1_pre,var_T2_pre} \ 'a) (id::'b \ 'b) = rrename_T1 f1 f2" + show "vvsubst_T1 f1 f2 (id::'a::{var_T1_pre,var_T2_pre} \ 'a) (id::'b \ 'b) = permute_T1 f1 f2" apply (rule ext) apply (rule conjunct1[OF x]) done - show "vvsubst_T2 f1 f2 (id::'a::{var_T1_pre,var_T2_pre} \ 'a) (id::'b \ 'b) = rrename_T2 f1 f2" + show "vvsubst_T2 f1 f2 (id::'a::{var_T1_pre,var_T2_pre} \ 'a) (id::'b \ 'b) = permute_T2 f1 f2" apply (rule ext) apply (rule conjunct2[OF x]) done @@ -1643,9 +1628,10 @@ lemma rel_plain_cases: apply (drule meta_mp) apply assumption apply assumption - apply (rule T1.TT_injects0[THEN iffD2]) + apply (rule TT_inject0s[THEN iffD2]) apply (rule exI conjI[rotated])+ - apply (rule refl) + apply (rule refl) + apply (unfold Un_Diff) apply assumption+ done @@ -1661,44 +1647,45 @@ lemma rel_plain_cases: apply (drule meta_mp) apply assumption apply assumption - apply (rule T1.TT_injects0[THEN iffD2]) + apply (rule TT_inject0s[THEN iffD2]) apply (rule exI conjI[rotated])+ apply (rule refl) + apply (unfold Un_Diff) apply assumption+ done done -lemma rel_imp_rrename: +lemma rel_imp_permute: fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" and x::"('var, 'tyvar, 'a::{var_T1_pre,var_T2_pre}, 'b) T1" and x2::"('var, 'tyvar, 'a, 'b) T2" assumes "bij f1" "|supp f1| rel_T1 R x y" - "rel_T2 R (rrename_T2 f1 f2 x2) (rrename_T2 f1 f2 y2) \ rel_T2 R x2 y2" + shows "rel_T1 R (permute_T1 f1 f2 x) (permute_T1 f1 f2 y) \ rel_T1 R x y" + "rel_T2 R (permute_T2 f1 f2 x2) (permute_T2 f1 f2 y2) \ rel_T2 R x2 y2" proof - - have x: "(\(R::'b \ 'c \ bool) (x::('var, 'tyvar, 'a, 'b) T1) y. rel_T1 R (rrename_T1 f1 f2 x) (rrename_T1 f1 f2 y) \ rel_T1 R x y) - \ (\(R::'b \ 'c \ bool) (x::('var, 'tyvar, 'a, 'b) T2) y. rel_T2 R (rrename_T2 f1 f2 x) (rrename_T2 f1 f2 y) \ rel_T2 R x y)" + have x: "(\(R::'b \ 'c \ bool) (x::('var, 'tyvar, 'a, 'b) T1) y. rel_T1 R (permute_T1 f1 f2 x) (permute_T1 f1 f2 y) \ rel_T1 R x y) + \ (\(R::'b \ 'c \ bool) (x::('var, 'tyvar, 'a, 'b) T2) y. rel_T2 R (permute_T2 f1 f2 x) (permute_T2 f1 f2 y) \ rel_T2 R x y)" apply (rule rel_T1_rel_T2.coinduct) apply (erule rel_plain_cases) (* REPEAT twice *) - apply (drule arg_cong[of _ _ "rrename_T1 (inv f1) (inv f2)"]) - apply (subst (asm) T1.rrename_comps inv_o_simp1, (rule assms bij_imp_bij_inv supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (drule arg_cong[of _ _ "permute_T1 (inv f1) (inv f2)"]) + apply (subst (asm) permute_comps inv_o_simp1, (rule assms bij_imp_bij_inv supp_inv_bound)+)+ + apply (unfold permute_ids) (* repeated *) - apply (drule arg_cong[of _ _ "rrename_T1 (inv f1) (inv f2)"]) - apply (subst (asm) T1.rrename_comps inv_o_simp1, (rule assms bij_imp_bij_inv supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (drule arg_cong[of _ _ "permute_T1 (inv f1) (inv f2)"]) + apply (subst (asm) permute_comps inv_o_simp1, (rule assms bij_imp_bij_inv supp_inv_bound)+)+ + apply (unfold permute_ids) (* END REPEAT twice *) apply hypsubst apply (rule exI)+ apply (rule conjI, rule refl)+ - apply (rule conjI, rule T1.rrename_cctors, (rule assms bij_imp_bij_inv supp_inv_bound)+)+ + apply (rule conjI, rule permute_simps, (rule assms bij_imp_bij_inv supp_inv_bound)+)+ apply (rule conjI bij_id supp_id_bound id_on_id)+ - apply (unfold T1.rrename_id0s T1_pre.map_id T1_pre.mr_rel_id) + apply (unfold permute_id0s T1_pre.map_id T1_pre.mr_rel_id) apply (rule iffD2[OF T1_pre.mr_rel_map(1)]) apply (rule supp_inv_bound assms supp_id_bound bij_imp_bij_inv bij_id)+ apply (unfold id_o o_id Grp_UNIV_id eq_OO) - apply (erule T1_pre.mr_rel_map(2)[rotated -1, THEN T1_pre.mr_rel_mono_strong0[rotated -11]]) + apply (erule T1_pre.mr_rel_map(2)[rotated -1, THEN T1_pre.mr_rel_mono_strong0[rotated -12]]) apply (rule supp_id_bound bij_id supp_inv_bound assms bij_imp_bij_inv)+ apply (unfold id_o o_id Grp_UNIV_id eq_OO OO_eq) apply ((rule ballI)+, (rule impI)?, (rule refl | assumption))+ @@ -1709,8 +1696,8 @@ proof - apply (unfold Grp_UNIV_def)[1] apply hypsubst apply (rule disjI1) - apply (subst T1.rrename_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (subst permute_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ + apply (unfold permute_ids) apply assumption (* repeated *) apply (rule ballI impI)+ @@ -1719,8 +1706,8 @@ proof - apply (unfold Grp_UNIV_def)[1] apply hypsubst apply (rule disjI1) - apply (subst T1.rrename_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (subst permute_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ + apply (unfold permute_ids) apply assumption (* repeated *) apply (rule ballI impI)+ @@ -1729,8 +1716,8 @@ proof - apply (unfold Grp_UNIV_def)[1] apply hypsubst apply (rule disjI1) - apply (subst T1.rrename_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (subst permute_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ + apply (unfold permute_ids) apply assumption (* repeated *) apply (rule ballI impI)+ @@ -1739,32 +1726,32 @@ proof - apply (unfold Grp_UNIV_def)[1] apply hypsubst apply (rule disjI1) - apply (subst T1.rrename_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (subst permute_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ + apply (unfold permute_ids) apply assumption (* END REPEAT_DETERM *) apply (rule supp_inv_bound assms supp_id_bound bij_imp_bij_inv)+ (* second type, same tactic *) apply (erule rel_plain_cases) (* REPEAT twice *) - apply (drule arg_cong[of _ _ "rrename_T2 (inv f1) (inv f2)"]) - apply (subst (asm) T1.rrename_comps inv_o_simp1, (rule assms bij_imp_bij_inv supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (drule arg_cong[of _ _ "permute_T2 (inv f1) (inv f2)"]) + apply (subst (asm) permute_comps inv_o_simp1, (rule assms bij_imp_bij_inv supp_inv_bound)+)+ + apply (unfold permute_ids) (* repeated *) - apply (drule arg_cong[of _ _ "rrename_T2 (inv f1) (inv f2)"]) - apply (subst (asm) T1.rrename_comps inv_o_simp1, (rule assms bij_imp_bij_inv supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (drule arg_cong[of _ _ "permute_T2 (inv f1) (inv f2)"]) + apply (subst (asm) permute_comps inv_o_simp1, (rule assms bij_imp_bij_inv supp_inv_bound)+)+ + apply (unfold permute_ids) (* END REPEAT twice *) apply hypsubst apply (rule exI)+ apply (rule conjI, rule refl)+ - apply (rule conjI, rule T1.rrename_cctors, (rule assms bij_imp_bij_inv supp_inv_bound)+)+ + apply (rule conjI, rule permute_simps, (rule assms bij_imp_bij_inv supp_inv_bound)+)+ apply (rule conjI bij_id supp_id_bound id_on_id)+ - apply (unfold T1.rrename_id0s T2_pre.map_id T2_pre.mr_rel_id) + apply (unfold permute_id0s T2_pre.map_id T2_pre.mr_rel_id) apply (rule iffD2[OF T2_pre.mr_rel_map(1)]) apply (rule supp_inv_bound assms supp_id_bound bij_imp_bij_inv bij_id)+ apply (unfold id_o o_id Grp_UNIV_id eq_OO) - apply (erule T2_pre.mr_rel_map(2)[rotated -1, THEN T2_pre.mr_rel_mono_strong0[rotated -11]]) + apply (erule T2_pre.mr_rel_map(2)[rotated -1, THEN T2_pre.mr_rel_mono_strong0[rotated -12]]) apply (rule supp_id_bound bij_id supp_inv_bound assms bij_imp_bij_inv)+ apply (unfold id_o o_id Grp_UNIV_id eq_OO OO_eq) apply ((rule ballI)+, (rule impI)?, (rule refl | assumption))+ @@ -1775,8 +1762,8 @@ proof - apply (unfold Grp_UNIV_def)[1] apply hypsubst apply (rule disjI1) - apply (subst T1.rrename_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (subst permute_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ + apply (unfold permute_ids) apply assumption (* repeated *) apply (rule ballI impI)+ @@ -1785,8 +1772,8 @@ proof - apply (unfold Grp_UNIV_def)[1] apply hypsubst apply (rule disjI1) - apply (subst T1.rrename_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (subst permute_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ + apply (unfold permute_ids) apply assumption (* repeated *) apply (rule ballI impI)+ @@ -1795,8 +1782,8 @@ proof - apply (unfold Grp_UNIV_def)[1] apply hypsubst apply (rule disjI1) - apply (subst T1.rrename_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (subst permute_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ + apply (unfold permute_ids) apply assumption (* repeated *) apply (rule ballI impI)+ @@ -1805,20 +1792,20 @@ proof - apply (unfold Grp_UNIV_def)[1] apply hypsubst apply (rule disjI1) - apply (subst T1.rrename_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (subst permute_comps inv_o_simp2, (rule bij_imp_bij_inv assms supp_inv_bound)+)+ + apply (unfold permute_ids) apply assumption (* END REPEAT_DETERM *) apply (rule supp_inv_bound assms supp_id_bound bij_imp_bij_inv)+ done - show "rel_T1 R (rrename_T1 f1 f2 x) (rrename_T1 f1 f2 y) \ rel_T1 R x y" + show "rel_T1 R (permute_T1 f1 f2 x) (permute_T1 f1 f2 y) \ rel_T1 R x y" apply (erule mp[rotated]) apply (insert x) apply (erule conjE allE)+ apply assumption done - show "rel_T2 R (rrename_T2 f1 f2 x2) (rrename_T2 f1 f2 y2) \ rel_T2 R x2 y2" + show "rel_T2 R (permute_T2 f1 f2 x2) (permute_T2 f1 f2 y2) \ rel_T2 R x2 y2" apply (erule mp[rotated]) apply (insert x) apply (erule conjE allE)+ @@ -1826,34 +1813,34 @@ proof - done qed -lemma rel_rrename: +lemma rel_permute: fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" and x::"('var, 'tyvar, 'a::{var_T1_pre,var_T2_pre}, 'b) T1" and x2::"('var, 'tyvar, 'a, 'b) T2" assumes "bij f1" "|supp f1| FFVars_T11 x = FFVars_T11 y" - "rel_T1 R x y \ FFVars_T12 x = FFVars_T12 y" - "rel_T2 R x2 y2 \ FFVars_T21 x2 = FFVars_T21 y2" - "rel_T2 R x2 y2 \ FFVars_T22 x2 = FFVars_T22 y2" + "rel_T1 R x y \ FVars_T11 x = FVars_T11 y" + "rel_T1 R x y \ FVars_T12 x = FVars_T12 y" + "rel_T2 R x2 y2 \ FVars_T21 x2 = FVars_T21 y2" + "rel_T2 R x2 y2 \ FVars_T22 x2 = FVars_T22 y2" proof - have x: "(\y f1 f2. bij f1 \ |supp f1| bij f2 \ |supp f2| rel_T1 R (rrename_T1 f1 f2 x) y \ f1 ` FFVars_T11 x = FFVars_T11 y \ f2 ` FFVars_T12 x = FFVars_T12 y) + \ rel_T1 R (permute_T1 f1 f2 x) y \ f1 ` FVars_T11 x = FVars_T11 y \ f2 ` FVars_T12 x = FVars_T12 y) \ (\y2 f1 f2. bij f1 \ |supp f1| bij f2 \ |supp f2| rel_T2 R (rrename_T2 f1 f2 x2) y2 \ f1 ` FFVars_T21 x2 = FFVars_T21 y2 \ f2 ` FFVars_T22 x2 = FFVars_T22 y2)" - apply (rule T1.TT_plain_co_induct) + \ rel_T2 R (permute_T2 f1 f2 x2) y2 \ f1 ` FVars_T21 x2 = FVars_T21 y2 \ f2 ` FVars_T22 x2 = FVars_T22 y2)" + apply (rule fresh_induct[of "{}" "{}"]) + apply (rule emp_bound)+ apply (rule allI impI)+ apply (erule rel_plain_cases) - apply (subst (asm) T1.rrename_cctors) + apply (subst (asm) permute_simps) apply assumption+ - apply (drule T1.TT_injects0[THEN iffD1]) + apply (drule TT_inject0s[THEN iffD1]) apply (erule exE conjE)+ apply hypsubst apply (subst (asm) T1_pre.map_comp T1_pre.set_map, (assumption | rule supp_id_bound bij_id)+)+ apply (unfold id_o o_id image_comp[unfolded comp_def])[1] - apply (subst (asm) T1.rrename_comp0s T1.FFVars_rrenames, (assumption | rule supp_id_bound bij_id)+)+ + apply (subst (asm) permute_comp0s FVars_permutes, (assumption | rule supp_id_bound bij_id)+)+ apply (unfold image_UN[symmetric] image_set_diff[OF bij_is_inj, symmetric] id_on_Un)[1] apply (erule conjE)+ apply (unfold T1_pre.mr_rel_id)[1] @@ -1896,11 +1884,40 @@ proof - apply (rule impI) (* REPEAT_DETERM *) apply (rule conjI)? - apply (unfold T1.FFVars_cctors image_Un)[1] + apply (unfold FVars_ctors image_Un)[1] apply (rule arg_cong2[of _ _ _ _ "(\)"])+ + (* TRY EVERY + apply (rule trans) + apply (rule id_on_image[symmetric]) + apply (rule prems) + apply (unfold image_comp)[1] + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + apply (rule bij_comp prems)+ + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ + *) apply (rule sym) apply (erule T1_pre.mr_rel_set[rotated -1]) - apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ + apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ + (* TRY EVERY *) + apply (rule trans) + apply (rule id_on_image[symmetric]) + apply (rule prems) + apply (unfold image_comp)[1] + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + apply (rule bij_comp prems)+ + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ + (* END TRY *) + apply (rule sym) + apply (erule T1_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ (* REPEAT_DETERM *) (* TRY EVERY apply (rule trans) @@ -1917,7 +1934,7 @@ proof - END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -1948,7 +1965,7 @@ proof - (* END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -1980,7 +1997,7 @@ proof - END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2011,7 +2028,7 @@ proof - (* END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2029,7 +2046,7 @@ proof - (* repeated (outer) *) (* REPEAT_DETERM *) apply (rule conjI)? - apply (unfold T1.FFVars_cctors image_Un)[1] + apply (unfold FVars_ctors image_Un)[1] apply (rule arg_cong2[of _ _ _ _ "(\)"])+ apply (rule sym) apply (erule T1_pre.mr_rel_set[rotated -1]) @@ -2050,7 +2067,7 @@ proof - END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2081,7 +2098,7 @@ proof - (* END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2113,7 +2130,7 @@ proof - END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2144,7 +2161,7 @@ proof - END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2163,14 +2180,14 @@ proof - (* second type, same tactic *) apply (rule allI impI)+ apply (erule rel_plain_cases) - apply (subst (asm) T1.rrename_cctors) + apply (subst (asm) permute_simps) apply assumption+ - apply (drule T1.TT_injects0[THEN iffD1]) + apply (drule TT_inject0s[THEN iffD1]) apply (erule exE conjE)+ apply hypsubst apply (subst (asm) T2_pre.map_comp T2_pre.set_map, (assumption | rule supp_id_bound bij_id)+)+ apply (unfold id_o o_id image_comp[unfolded comp_def])[1] - apply (subst (asm) T1.rrename_comp0s T1.FFVars_rrenames, (assumption | rule supp_id_bound bij_id)+)+ + apply (subst (asm) permute_comp0s FVars_permutes, (assumption | rule supp_id_bound bij_id)+)+ apply (unfold image_UN[symmetric] image_set_diff[OF bij_is_inj, symmetric] id_on_Un)[1] apply (erule conjE)+ apply (unfold T2_pre.mr_rel_id)[1] @@ -2183,8 +2200,37 @@ proof - apply (rule impI) (* REPEAT_DETERM *) apply (rule conjI)? - apply (unfold T1.FFVars_cctors image_Un)[1] + apply (unfold FVars_ctors image_Un)[1] apply (rule arg_cong2[of _ _ _ _ "(\)"])+ + (* TRY EVERY + apply (rule trans) + apply (rule id_on_image[symmetric]) + apply (rule prems) + apply (unfold image_comp)[1] + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + apply (rule bij_comp prems)+ + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ + END TRY EVERY *) + apply (rule sym) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ + (* TRY EVERY *) + apply (rule trans) + apply (rule id_on_image[symmetric]) + apply (rule prems) + apply (unfold image_comp)[1] + apply (rule trans) + apply (rule image_set_diff[OF bij_is_inj]) + apply (rule bij_comp prems)+ + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (rule sym) + apply (erule T2_pre.mr_rel_set[rotated -1]) + apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ + (* END TRY EVERY *) apply (rule sym) apply (erule T2_pre.mr_rel_set[rotated -1]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ @@ -2204,7 +2250,7 @@ proof - END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2235,7 +2281,7 @@ proof - (* END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2267,7 +2313,7 @@ proof - END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2298,7 +2344,7 @@ proof - (* END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2316,7 +2362,7 @@ proof - (* repeated (outer) *) (* REPEAT_DETERM *) apply (rule conjI)? - apply (unfold T1.FFVars_cctors image_Un)[1] + apply (unfold FVars_ctors image_Un)[1] apply (rule arg_cong2[of _ _ _ _ "(\)"])+ apply (rule sym) apply (erule T2_pre.mr_rel_set[rotated -1]) @@ -2337,7 +2383,7 @@ proof - END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2368,7 +2414,7 @@ proof - (* END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2400,7 +2446,7 @@ proof - END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2431,7 +2477,7 @@ proof - END TRY EVERY *) apply (unfold image_UN)[1] apply (rule rel_set_UN_D) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV prems)+ apply (drule iffD1[OF Grp_OO]) apply (drule prems) @@ -2449,38 +2495,38 @@ proof - done done show - "rel_T1 R x y \ FFVars_T11 x = FFVars_T11 y" - "rel_T1 R x y \ FFVars_T12 x = FFVars_T12 y" - "rel_T2 R x2 y2 \ FFVars_T21 x2 = FFVars_T21 y2" - "rel_T2 R x2 y2 \ FFVars_T22 x2 = FFVars_T22 y2" + "rel_T1 R x y \ FVars_T11 x = FVars_T11 y" + "rel_T1 R x y \ FVars_T12 x = FVars_T12 y" + "rel_T2 R x2 y2 \ FVars_T21 x2 = FVars_T21 y2" + "rel_T2 R x2 y2 \ FVars_T22 x2 = FVars_T22 y2" apply - (* REPEAT_DETERM *) apply (insert x)[1] apply (erule conjE)+ apply (erule allE)+ apply (erule impE, rule bij_id supp_id_bound)+ - apply (unfold image_id T1.rrename_ids) + apply (unfold image_id permute_ids) apply (((erule impE, assumption) | (erule conjE)+ | assumption | erule thin_rl)+)[1] (* repeated *) apply (insert x)[1] apply (erule conjE)+ apply (erule allE)+ apply (erule impE, rule bij_id supp_id_bound)+ - apply (unfold image_id T1.rrename_ids) + apply (unfold image_id permute_ids) apply (((erule impE, assumption) | (erule conjE)+ | assumption | erule thin_rl)+)[1] (* repeated *) apply (insert x)[1] apply (erule conjE)+ apply (erule allE)+ apply (erule impE, rule bij_id supp_id_bound)+ - apply (unfold image_id T1.rrename_ids) + apply (unfold image_id permute_ids) apply (((erule impE, assumption) | (erule conjE)+ | assumption | erule thin_rl)+)[1] (* repeated *) apply (insert x)[1] apply (erule conjE)+ apply (erule allE)+ apply (erule impE, rule bij_id supp_id_bound)+ - apply (unfold image_id T1.rrename_ids) + apply (unfold image_id permute_ids) apply (((erule impE, assumption) | (erule conjE)+ | assumption | erule thin_rl)+)[1] done qed @@ -2489,37 +2535,34 @@ qed (*********** MRBNF Axiom Proofs ************) (* required for other proofs, ie needed as `thm` *) -lemma FFVars_vvsubstss: +lemma FVars_vvsubstss: fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" and f3::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f4::"'b \ 'c" assumes f_prems: "|supp f1| (FFVars_T12 (vvsubst_T1 f1 f2 f3 f4 x) = f2 ` FFVars_T12 x)) - \ ((FFVars_T21 (vvsubst_T2 f1 f2 f3 f4 y) = f1 ` FFVars_T21 y) \ (FFVars_T22 (vvsubst_T2 f1 f2 f3 f4 y) = f2 ` FFVars_T22 y))" - apply (rule T1.TT_fresh_co_induct[of _ _ _ _ x y, rotated 2]) + have x: "((FVars_T11 (vvsubst_T1 f1 f2 f3 f4 x) = f1 ` FVars_T11 x) \ (FVars_T12 (vvsubst_T1 f1 f2 f3 f4 x) = f2 ` FVars_T12 x)) + \ ((FVars_T21 (vvsubst_T2 f1 f2 f3 f4 y) = f1 ` FVars_T21 y) \ (FVars_T22 (vvsubst_T2 f1 f2 f3 f4 y) = f2 ` FVars_T22 y))" + apply (rule fresh_induct[of _ _ _ _ x y, rotated 2]) apply (rule conjI) apply (subst vvsubst_cctor_1) apply (rule f_prems)+ - (* REPEAT_DETERM *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption - apply (unfold T1.FFVars_cctors image_Un image_UN) + apply (unfold FVars_ctors image_Un image_UN) apply (subst T1_pre.set_map, (rule f_prems supp_id_bound bij_id)+)+ apply (rule arg_cong2[of _ _ _ _ "(\)"])+ - apply (rule refl) + apply (rule refl) + + (* TRY EVERY *) + apply (unfold image_id) + apply (rule trans[OF Diff_image_not_in_imsupp]) + apply assumption + apply (rule refl) + (* END TRY *) apply (unfold image_comp[unfolded comp_def] image_id) apply (rule UN_cong) apply (rule conjunct1) @@ -2551,20 +2594,10 @@ proof - (* second function *) apply (subst vvsubst_cctor_1) apply (rule f_prems)+ - (* REPEAT_DETERM *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption - apply (unfold T1.FFVars_cctors image_Un image_UN) + apply (unfold FVars_ctors image_Un image_UN) apply (subst T1_pre.set_map, (rule f_prems supp_id_bound bij_id)+)+ apply (rule arg_cong2[of _ _ _ _ "(\)"])+ apply (rule refl) @@ -2601,23 +2634,21 @@ proof - apply (rule conjI) apply (subst vvsubst_cctor_2) apply (rule f_prems)+ - (* REPEAT_DETERM *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption - apply (unfold T1.FFVars_cctors image_Un image_UN) + apply (unfold FVars_ctors image_Un image_UN) apply (subst T2_pre.set_map, (rule f_prems supp_id_bound bij_id)+)+ apply (rule arg_cong2[of _ _ _ _ "(\)"])+ - apply (rule refl)+ + apply (rule refl)+ + + (* TRY EVERY *) + apply (unfold image_id) + apply (rule trans[OF _ Diff_image_not_in_imsupp]) + apply (rule refl) + apply assumption + (* END TRY *) + apply (unfold image_comp[unfolded comp_def] image_id) apply (rule UN_cong) apply (rule conjunct1) @@ -2649,20 +2680,10 @@ proof - (* second function *) apply (subst vvsubst_cctor_2) apply (rule f_prems)+ - (* REPEAT_DETERM *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption - apply (unfold T1.FFVars_cctors image_Un image_UN) + apply (unfold FVars_ctors image_Un image_UN) apply (subst T2_pre.set_map, (rule f_prems supp_id_bound bij_id)+)+ apply (rule arg_cong2[of _ _ _ _ "(\)"])+ apply (rule refl)+ @@ -2697,22 +2718,22 @@ proof - apply (rule iffD2[OF imsupp_supp_bound] infinite_UNIV f_prems)+ done - show "FFVars_T11 (vvsubst_T1 f1 f2 f3 f4 x) = f1 ` FFVars_T11 x" + show "FVars_T11 (vvsubst_T1 f1 f2 f3 f4 x) = f1 ` FVars_T11 x" apply (insert x) apply (erule conjE)+ apply assumption done - show "FFVars_T12 (vvsubst_T1 f1 f2 f3 f4 x) = f2 ` FFVars_T12 x" + show "FVars_T12 (vvsubst_T1 f1 f2 f3 f4 x) = f2 ` FVars_T12 x" apply (insert x) apply (erule conjE)+ apply assumption done - show "FFVars_T21 (vvsubst_T2 f1 f2 f3 f4 y) = f1 ` FFVars_T21 y" + show "FVars_T21 (vvsubst_T2 f1 f2 f3 f4 y) = f1 ` FVars_T21 y" apply (insert x) apply (erule conjE)+ apply assumption done - show "FFVars_T22 (vvsubst_T2 f1 f2 f3 f4 y) = f2 ` FFVars_T22 y" + show "FVars_T22 (vvsubst_T2 f1 f2 f3 f4 y) = f2 ` FVars_T22 y" apply (insert x) apply (erule conjE)+ apply assumption @@ -2726,7 +2747,7 @@ lemma set3_map: "set3_T2 (vvsubst_T2 f1 f2 f3 f4 y) = f3 ` set3_T2 y" proof - have x: "set3_T1 (vvsubst_T1 f1 f2 f3 f4 x) = f3 ` set3_T1 x \ set3_T2 (vvsubst_T2 f1 f2 f3 f4 y) = f3 ` set3_T2 y" - apply (rule T1.TT_fresh_co_induct) + apply (rule fresh_induct) (* REPEAT_DETERM *) apply (rule iffD2[OF imsupp_supp_bound]) apply (rule infinite_UNIV) @@ -2738,19 +2759,7 @@ proof - (* END REPEAT_DETERM *) apply (subst vvsubst_cctor_1) apply (rule f_prems)+ - (* REPEAT_DETERM *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption apply (unfold set3_T1_simp) apply (subst T1_pre.set_map, (rule f_prems supp_id_bound bij_id)+)+ @@ -2761,19 +2770,7 @@ proof - (* second type *) apply (subst vvsubst_cctor_2) apply (rule f_prems)+ - (* REPEAT_DETERM *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption apply (unfold set3_T2_simp) apply (subst T2_pre.set_map, (rule f_prems supp_id_bound bij_id)+)+ @@ -2803,7 +2800,7 @@ lemma set4_map: "set4_T2 (vvsubst_T2 f1 f2 f3 f4 y) = f4 ` set4_T2 y" proof - have x: "set4_T1 (vvsubst_T1 f1 f2 f3 f4 x) = f4 ` set4_T1 x \ set4_T2 (vvsubst_T2 f1 f2 f3 f4 y) = f4 ` set4_T2 y" - apply (rule T1.TT_fresh_co_induct) + apply (rule fresh_induct) (* REPEAT_DETERM *) apply (rule iffD2[OF imsupp_supp_bound]) apply (rule infinite_UNIV) @@ -2815,19 +2812,7 @@ proof - (* END REPEAT_DETERM *) apply (subst vvsubst_cctor_1) apply (rule f_prems)+ - (* REPEAT_DETERM *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption apply (unfold set4_T1_simp) apply (subst T1_pre.set_map, (rule f_prems supp_id_bound bij_id)+)+ @@ -2838,19 +2823,7 @@ proof - (* second type *) apply (subst vvsubst_cctor_2) apply (rule f_prems)+ - (* REPEAT_DETERM *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption apply (unfold set4_T2_simp) apply (subst T2_pre.set_map, (rule f_prems supp_id_bound bij_id)+)+ @@ -2883,7 +2856,7 @@ proof - have x: "\t1 t2. (vvsubst_T1 (g1 \ f1) (g2 \ f2) (g3 \ f3) (g4 \ f4) t1 = vvsubst_T1 g1 g2 g3 g4 (vvsubst_T1 f1 f2 f3 f4 t1)) \ (vvsubst_T2 (g1 \ f1) (g2 \ f2) (g3 \ f3) (g4 \ f4) t2 = vvsubst_T2 g1 g2 g3 g4 (vvsubst_T2 f1 f2 f3 f4 t2))" subgoal for t1 t2 - apply (rule T1.TT_fresh_co_induct[of _ _ _ _ t1 t2, rotated 2]) + apply (rule fresh_induct[of _ _ _ _ t1 t2, rotated 2]) apply (rule trans) apply (rule vvsubst_cctor_1) apply (rule supp_comp_bound f_prems g_prems infinite_UNIV)+ @@ -2891,15 +2864,11 @@ proof - apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule imsupp_o) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule imsupp_o) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) apply assumption @@ -2911,15 +2880,11 @@ proof - apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper2) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper2) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) @@ -2935,8 +2900,6 @@ proof - apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper1) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (subst T1_pre.set_map) @@ -2945,31 +2908,25 @@ proof - apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper1) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) apply (subst noclash_T1_def) apply (subst T1_pre.set_map, (rule f_prems supp_id_bound bij_id)+)+ apply (unfold image_id image_comp[unfolded comp_def]) - apply (subst FFVars_vvsubstss, (rule f_prems)+)+ + apply (subst FVars_vvsubstss, (rule f_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) (* REPEAT_DETERM *) apply (subst Int_image_imsupp) apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper2) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (subst Int_image_imsupp) apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper2) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) apply (unfold noclash_T1_def[symmetric]) @@ -2995,15 +2952,11 @@ proof - apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule imsupp_o) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule imsupp_o) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) apply assumption @@ -3015,15 +2968,11 @@ proof - apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper2) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper2) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) @@ -3039,8 +2988,6 @@ proof - apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper1) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (subst T2_pre.set_map) @@ -3049,31 +2996,25 @@ proof - apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper1) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) apply (subst noclash_T2_def) apply (subst T2_pre.set_map, (rule f_prems supp_id_bound bij_id)+)+ apply (unfold image_id image_comp[unfolded comp_def]) - apply (subst FFVars_vvsubstss, (rule f_prems)+)+ + apply (subst FVars_vvsubstss, (rule f_prems)+)+ apply (unfold image_UN[symmetric] image_Un[symmetric]) (* REPEAT_DETERM *) apply (subst Int_image_imsupp) apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper2) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (subst Int_image_imsupp) apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper2) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) apply (unfold noclash_T2_def[symmetric]) @@ -3121,7 +3062,8 @@ lemma set_bd: "|set4_T2 y| |set4_T1 x| ( |set3_T2 y| |set4_T2 y| a. a \ FFVars_T11 x \ f1 a = g1 a) \ (\a. a \ FFVars_T12 x \ f2 a = g2 a) \ (\a. a \ set3_T1 x \ f3 a = g3 a) \ (\a. a \ set4_T1 x \ f4 a = g4 a) \ vvsubst_T1 f1 f2 f3 f4 x = vvsubst_T1 g1 g2 g3 g4 x" - "(\a. a \ FFVars_T21 y \ f1 a = g1 a) \ (\a. a \ FFVars_T22 y \ f2 a = g2 a) \ (\a. a \ set3_T2 y \ f3 a = g3 a) \ (\a. a \ set4_T2 y \ f4 a = g4 a) \ vvsubst_T2 f1 f2 f3 f4 y = vvsubst_T2 g1 g2 g3 g4 y" + "(\a. a \ FVars_T11 x \ f1 a = g1 a) \ (\a. a \ FVars_T12 x \ f2 a = g2 a) \ (\a. a \ set3_T1 x \ f3 a = g3 a) \ (\a. a \ set4_T1 x \ f4 a = g4 a) \ vvsubst_T1 f1 f2 f3 f4 x = vvsubst_T1 g1 g2 g3 g4 x" + "(\a. a \ FVars_T21 y \ f1 a = g1 a) \ (\a. a \ FVars_T22 y \ f2 a = g2 a) \ (\a. a \ set3_T2 y \ f3 a = g3 a) \ (\a. a \ set4_T2 y \ f4 a = g4 a) \ vvsubst_T2 f1 f2 f3 f4 y = vvsubst_T2 g1 g2 g3 g4 y" proof - - have x: "((\a. a \ FFVars_T11 x \ f1 a = g1 a) \ - (\a. a \ FFVars_T12 x \ f2 a = g2 a) \ (\a. a \ set3_T1 x \ f3 a = g3 a) \ (\a. a \ set4_T1 x \ f4 a = g4 a) \ vvsubst_T1 f1 f2 f3 f4 x = vvsubst_T1 g1 g2 g3 g4 x) - \ ((\a. a \ FFVars_T21 y \ f1 a = g1 a) \ - (\a. a \ FFVars_T22 y \ f2 a = g2 a) \ (\a. a \ set3_T2 y \ f3 a = g3 a) \ (\a. a \ set4_T2 y \ f4 a = g4 a) \ vvsubst_T2 f1 f2 f3 f4 y = vvsubst_T2 g1 g2 g3 g4 y)" - apply (rule T1.TT_fresh_co_induct[of _ _ _ _ x y, rotated 2]) + have x: "((\a. a \ FVars_T11 x \ f1 a = g1 a) \ + (\a. a \ FVars_T12 x \ f2 a = g2 a) \ (\a. a \ set3_T1 x \ f3 a = g3 a) \ (\a. a \ set4_T1 x \ f4 a = g4 a) \ vvsubst_T1 f1 f2 f3 f4 x = vvsubst_T1 g1 g2 g3 g4 x) + \ ((\a. a \ FVars_T21 y \ f1 a = g1 a) \ + (\a. a \ FVars_T22 y \ f2 a = g2 a) \ (\a. a \ set3_T2 y \ f3 a = g3 a) \ (\a. a \ set4_T2 y \ f4 a = g4 a) \ vvsubst_T2 f1 f2 f3 f4 y = vvsubst_T2 g1 g2 g3 g4 y)" + apply (rule fresh_induct[of _ _ _ _ x y, rotated 2]) apply (rule allI impI)+ apply (rule trans) apply (rule vvsubst_cctor_1) @@ -3171,15 +3113,11 @@ proof - apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper1) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper1) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) apply assumption @@ -3192,15 +3130,11 @@ proof - apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper2) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper2) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) apply assumption @@ -3211,7 +3145,7 @@ proof - subgoal premises prems apply (rule T1_pre.map_cong0) apply (rule f_prems g_prems supp_id_bound bij_id)+ - apply (rule prems, erule T1.FFVars_intros)+ + apply (rule prems, erule FVars_intros)+ apply (rule prems) apply (unfold set3_T1_simp)[1] apply (rule UnI1)+ @@ -3220,14 +3154,30 @@ proof - apply (unfold set4_T1_simp)[1] apply (rule UnI1)+ apply assumption - apply (rule refl)+ + apply (rule refl)+ + + apply (rule case_split[of "_ \ _", rotated]) + apply (drule DiffI) + apply assumption + prefer 2 + apply (drule prems(5-6)[THEN disjoint_iff[THEN iffD1], THEN spec, THEN mp]) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply (rule trans) + apply (erule not_in_imsupp_same) + apply (rule sym) + apply (erule not_in_imsupp_same) + apply (rule prems) + apply (erule DiffE) + apply (erule FVars_intros) + apply assumption apply (frule prems) apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply (rule prems) apply (erule set3_T1_intros) @@ -3239,10 +3189,10 @@ proof - apply (frule prems) apply (rule case_split[of "_ \ _", rotated]) apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply assumption - apply (drule prems(5-10)) + apply (drule prems(5-6)[THEN disjoint_iff[THEN iffD1], THEN spec, THEN mp]) apply (unfold Un_iff de_Morgan_disj)[1] apply (erule conjE) apply (rule trans) @@ -3252,10 +3202,10 @@ proof - apply (rule case_split[of "_ \ _", rotated]) apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply assumption - apply (drule prems(5-10)) + apply (drule prems(5-6)[THEN disjoint_iff[THEN iffD1], THEN spec, THEN mp]) apply (unfold Un_iff de_Morgan_disj)[1] apply (erule conjE) apply (rule trans) @@ -3274,10 +3224,10 @@ proof - apply (frule prems) apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply (rule prems) apply (erule set3_T1_intros) @@ -3290,10 +3240,10 @@ proof - apply (frule prems) apply (rule case_split[of "_ \ _", rotated]) apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply assumption - apply (drule prems(5-10)) + apply (drule prems(5-6)[THEN disjoint_iff[THEN iffD1], THEN spec, THEN mp]) apply (unfold Un_iff de_Morgan_disj)[1] apply (erule conjE) apply (rule trans) @@ -3302,7 +3252,7 @@ proof - apply (erule not_in_imsupp_same) apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply (rule prems) apply (erule set3_T1_intros) @@ -3321,15 +3271,11 @@ proof - apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper1) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper1) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) apply assumption @@ -3342,15 +3288,11 @@ proof - apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper2) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (rule trans[OF Int_commute]) apply (rule Int_subset_empty2[rotated]) apply (rule Un_upper2) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) apply assumption @@ -3360,7 +3302,7 @@ proof - subgoal premises prems apply (rule T2_pre.map_cong0) apply (rule f_prems g_prems supp_id_bound bij_id)+ - apply (rule prems, erule T1.FFVars_intros)+ + apply (rule prems, erule FVars_intros)+ apply (rule prems) apply (unfold set3_T2_simp)[1] apply (rule UnI1)+ @@ -3369,14 +3311,30 @@ proof - apply (unfold set4_T2_simp)[1] apply (rule UnI1)+ apply assumption - apply (rule refl)+ + apply (rule refl)+ + + apply (rule case_split[of "_ \ _", rotated]) + apply (drule DiffI) + apply assumption + prefer 2 + apply (drule prems(5-6)[THEN disjoint_iff[THEN iffD1], THEN spec, THEN mp]) + apply (unfold Un_iff de_Morgan_disj)[1] + apply (erule conjE)+ + apply (rule trans) + apply (erule not_in_imsupp_same) + apply (rule sym) + apply (erule not_in_imsupp_same) + apply (rule prems) + apply (erule DiffE) + apply (erule FVars_intros) + apply assumption apply (frule prems) apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply (rule prems) apply (erule set3_T2_intros) @@ -3389,10 +3347,10 @@ proof - apply (frule prems) apply (rule case_split[of "_ \ _", rotated]) apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply assumption - apply (drule prems(5-10)) + apply (drule prems(5-6)[THEN disjoint_iff[THEN iffD1], THEN spec, THEN mp]) apply (unfold Un_iff de_Morgan_disj)[1] apply (erule conjE) apply (rule trans) @@ -3402,10 +3360,10 @@ proof - apply (rule case_split[of "_ \ _", rotated]) apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply assumption - apply (drule prems(5-10)) + apply (drule prems(5-6)[THEN disjoint_iff[THEN iffD1], THEN spec, THEN mp]) apply (unfold Un_iff de_Morgan_disj)[1] apply (erule conjE) apply (rule trans) @@ -3424,10 +3382,10 @@ proof - apply (frule prems) apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply (rule prems) apply (erule set3_T2_intros) @@ -3440,10 +3398,10 @@ proof - apply (frule prems) apply (rule case_split[of "_ \ _", rotated]) apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply assumption - apply (drule prems(5-10)) + apply (drule prems(5-6)[THEN disjoint_iff[THEN iffD1], THEN spec, THEN mp]) apply (unfold Un_iff de_Morgan_disj)[1] apply (erule conjE) apply (rule trans) @@ -3452,7 +3410,7 @@ proof - apply (erule not_in_imsupp_same) apply (rule prems) - apply (erule T1.FFVars_intros) + apply (erule FVars_intros) apply assumption apply (rule prems) apply (erule set3_T2_intros) @@ -3466,8 +3424,8 @@ proof - apply (rule T1_pre.Un_bound iffD2[OF imsupp_supp_bound] infinite_UNIV f_prems g_prems)+ done - show "(\a. a \ FFVars_T11 x \ f1 a = g1 a) \ - (\a. a \ FFVars_T12 x \ f2 a = g2 a) \ (\a. a \ set3_T1 x \ f3 a = g3 a) \ (\a. a \ set4_T1 x \ f4 a = g4 a) \ vvsubst_T1 f1 f2 f3 f4 x = vvsubst_T1 g1 g2 g3 g4 x" + show "(\a. a \ FVars_T11 x \ f1 a = g1 a) \ + (\a. a \ FVars_T12 x \ f2 a = g2 a) \ (\a. a \ set3_T1 x \ f3 a = g3 a) \ (\a. a \ set4_T1 x \ f4 a = g4 a) \ vvsubst_T1 f1 f2 f3 f4 x = vvsubst_T1 g1 g2 g3 g4 x" apply (insert x) apply (erule conjE)+ apply (unfold imp_conjL[symmetric]) @@ -3486,7 +3444,7 @@ proof - apply assumption done - show "(\a. a \ FFVars_T21 y \ f1 a = g1 a) \ (\a. a \ FFVars_T22 y \ f2 a = g2 a) \ + show "(\a. a \ FVars_T21 y \ f1 a = g1 a) \ (\a. a \ FVars_T22 y \ f2 a = g2 a) \ (\a. a \ set3_T2 y \ f3 a = g3 a) \ (\a. a \ set4_T2 y \ f4 a = g4 a) \ vvsubst_T2 f1 f2 f3 f4 y = vvsubst_T2 g1 g2 g3 g4 y" apply (insert x) apply (erule conjE)+ @@ -3512,10 +3470,10 @@ lemma rel_OO_mono: "(rel_T2 R :: ('var, 'tyvar, 'a, 'b) T2 \ _) OO rel_T2 S \ rel_T2 (R OO S)" proof - have x: "(\R' (x::('var, 'tyvar, 'a, 'b) T1) z. R' = R OO S \ (\y f1 f2 x'. bij f1 \ |supp f1| bij f2 \ |supp f2| x = rrename_T1 f1 f2 x' \ rel_T1 R x y \ rel_T1 S y z) \ + \ bij f2 \ |supp f2| x = permute_T1 f1 f2 x' \ rel_T1 R x y \ rel_T1 S y z) \ rel_T1 R' x z) \ (\R' (x::('var, 'tyvar, 'a, 'b) T2) z. R' = R OO S \ (\y f1 f2 x'. bij f1 \ |supp f1| bij f2 \ |supp f2| x = rrename_T2 f1 f2 x' \ rel_T2 R x y \ rel_T2 S y z) \ + \ bij f2 \ |supp f2| x = permute_T2 f1 f2 x' \ rel_T2 R x y \ rel_T2 S y z) \ rel_T2 R' x z)" apply (rule rel_T1_rel_T2.coinduct) apply (erule conjE exE)+ @@ -3524,11 +3482,11 @@ proof - apply hypsubst apply (unfold triv_forall_equality) subgoal for f1 f2 x'2 x' y' y'2 z' - apply (drule arg_cong[of _ _ "rrename_T1 (inv f1) (inv f2)"]) - apply (subst (asm) T1.rrename_comps inv_o_simp1 T1.rrename_cctors, (assumption | rule bij_imp_bij_inv supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (drule arg_cong[of _ _ "permute_T1 (inv f1) (inv f2)"]) + apply (subst (asm) permute_comps inv_o_simp1 permute_simps, (assumption | rule bij_imp_bij_inv supp_inv_bound)+)+ + apply (unfold permute_ids) apply hypsubst_thin - apply (drule T1.TT_injects0[THEN iffD1]) + apply (drule TT_inject0s[THEN iffD1]) apply (erule conjE exE)+ apply hypsubst_thin apply (unfold T1_pre.mr_rel_id) @@ -3542,21 +3500,21 @@ proof - apply (rule conjI) apply (rule refl) apply (rule conjI) - apply (subst T1.rrename_cctors[symmetric]) + apply (subst permute_simps[symmetric]) apply (rule bij_imp_bij_inv supp_inv_bound | assumption)+ apply (rule trans) - apply (rule T1.rrename_comps) + apply (rule permute_comps) apply (rule bij_imp_bij_inv supp_inv_bound | assumption)+ - apply (rule T1.rrename_cong_ids) + apply (rule permute_cong_ids) apply (rule bij_comp supp_comp_bound bij_imp_bij_inv supp_inv_bound infinite_UNIV | assumption)+ apply (subst inv_o_simp2, assumption, rule id_apply)+ apply (rule conjI) apply (rule refl) apply (rule conjI[rotated])+ apply (rule iffD2[OF T1_pre.mr_rel_map(1)]) - prefer 15 (* (free + 2 * bound) * 2 + 1 *) + prefer 17 (* (free + 2 * bound) * 2 + 1 *) apply (unfold id_o o_id Grp_UNIV_id eq_OO)[1] - apply (erule T1_pre.mr_rel_mono_strong0[rotated -11]) + apply (erule T1_pre.mr_rel_mono_strong0[rotated -12]) apply (rule ballI refl impI | assumption)+ (* REPEAT_DETERM *) @@ -3570,8 +3528,8 @@ proof - apply (rule exI)+ apply (rule conjI[rotated])+ apply assumption - apply (assumption | (rule rel_rrename[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) - apply (rule refl T1.rrename_ids[symmetric]) + apply (assumption | (rule rel_permute[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) + apply (rule refl permute_ids[symmetric]) apply (rule supp_id_bound bij_id | assumption)+ (* repeated *) apply ((rule ballI impI)+)? @@ -3584,8 +3542,8 @@ proof - apply (rule exI)+ apply (rule conjI[rotated])+ apply assumption - apply (assumption | (rule rel_rrename[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) - apply (rule refl T1.rrename_ids[symmetric]) + apply (assumption | (rule rel_permute[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) + apply (rule refl permute_ids[symmetric]) apply (rule supp_id_bound bij_id | assumption)+ (* repeated *) apply ((rule ballI impI)+)? @@ -3598,8 +3556,8 @@ proof - apply (rule exI)+ apply (rule conjI[rotated])+ apply assumption - apply (assumption | (rule rel_rrename[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) - apply (rule refl T1.rrename_ids[symmetric]) + apply (assumption | (rule rel_permute[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) + apply (rule refl permute_ids[symmetric]) apply (rule supp_id_bound bij_id | assumption)+ (* repeated *) apply ((rule ballI impI)+)? @@ -3612,8 +3570,8 @@ proof - apply (rule exI)+ apply (rule conjI[rotated])+ apply assumption - apply (assumption | (rule rel_rrename[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) - apply (rule refl T1.rrename_ids[symmetric]) + apply (assumption | (rule rel_permute[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) + apply (rule refl permute_ids[symmetric]) apply (rule supp_id_bound bij_id | assumption)+ (* END REPEAT_DETERM *) (* REPEAT_DETERM *) @@ -3628,15 +3586,24 @@ proof - apply (erule T1_pre.mr_rel_set[rotated -1]) apply (rule supp_id_bound bij_id)+ apply (rule rel_set_UN_D) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id)+ apply (erule rel_FFVars) (* END REPEAT_DETERM *) apply assumption+ (* repeated *) + apply (unfold Un_Diff)[1] apply (erule id_on_antimono) apply (rule equalityD1) apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + (* TRY EVERY *) + apply (rule sym) + apply (rule trans) + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (erule T1_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id)+)+ + apply (unfold image_id) + apply (rule refl) + (* END TRY *) (* REPEAT_DETERM *) apply (rule arg_cong2[of _ _ _ _ minus, rotated]) apply (rule trans) @@ -3645,7 +3612,7 @@ proof - apply (erule T1_pre.mr_rel_set[rotated -1]) apply (rule supp_id_bound bij_id)+ apply (rule rel_set_UN_D) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id)+ apply (erule rel_FFVars) (* repeated *) @@ -3656,7 +3623,7 @@ proof - apply (erule T1_pre.mr_rel_set[rotated -1]) apply (rule supp_id_bound bij_id)+ apply (rule rel_set_UN_D) - apply (erule T1_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T1_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id)+ apply (erule rel_FFVars) (* END REPEAT_DETERM *) @@ -3669,11 +3636,11 @@ proof - apply hypsubst apply (unfold triv_forall_equality) subgoal for f1 f2 x'2 x' y' y'2 z' - apply (drule arg_cong[of _ _ "rrename_T2 (inv f1) (inv f2)"]) - apply (subst (asm) T1.rrename_comps inv_o_simp1 T1.rrename_cctors, (assumption | rule bij_imp_bij_inv supp_inv_bound)+)+ - apply (unfold T1.rrename_ids) + apply (drule arg_cong[of _ _ "permute_T2 (inv f1) (inv f2)"]) + apply (subst (asm) permute_comps inv_o_simp1 permute_simps, (assumption | rule bij_imp_bij_inv supp_inv_bound)+)+ + apply (unfold permute_ids) apply hypsubst_thin - apply (drule T1.TT_injects0[THEN iffD1]) + apply (drule TT_inject0s[THEN iffD1]) apply (erule conjE exE)+ apply hypsubst_thin apply (unfold T2_pre.mr_rel_id) @@ -3687,21 +3654,21 @@ proof - apply (rule conjI) apply (rule refl) apply (rule conjI) - apply (subst T1.rrename_cctors[symmetric]) + apply (subst permute_simps[symmetric]) apply (rule bij_imp_bij_inv supp_inv_bound | assumption)+ apply (rule trans) - apply (rule T1.rrename_comps) + apply (rule permute_comps) apply (rule bij_imp_bij_inv supp_inv_bound | assumption)+ - apply (rule T1.rrename_cong_ids) + apply (rule permute_cong_ids) apply (rule bij_comp supp_comp_bound bij_imp_bij_inv supp_inv_bound infinite_UNIV | assumption)+ apply (subst inv_o_simp2, assumption, rule id_apply)+ apply (rule conjI) apply (rule refl) apply (rule conjI[rotated])+ apply (rule iffD2[OF T2_pre.mr_rel_map(1)]) - prefer 15 (* 7 * nvars + 1 *) + prefer 17 (* 7 * nvars + 1 *) apply (unfold id_o o_id Grp_UNIV_id eq_OO)[1] - apply (erule T2_pre.mr_rel_mono_strong0[rotated -11]) + apply (erule T2_pre.mr_rel_mono_strong0[rotated -12]) apply (rule ballI refl impI | assumption)+ (* REPEAT_DETERM *) @@ -3715,8 +3682,8 @@ proof - apply (rule exI)+ apply (rule conjI[rotated])+ apply assumption - apply (assumption | (rule rel_rrename[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) - apply (rule refl T1.rrename_ids[symmetric]) + apply (assumption | (rule rel_permute[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) + apply (rule refl permute_ids[symmetric]) apply (rule supp_id_bound bij_id | assumption)+ (* repeated *) apply ((rule ballI impI)+)? @@ -3729,8 +3696,8 @@ proof - apply (rule exI)+ apply (rule conjI[rotated])+ apply assumption - apply (assumption | (rule rel_rrename[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) - apply (rule refl T1.rrename_ids[symmetric]) + apply (assumption | (rule rel_permute[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) + apply (rule refl permute_ids[symmetric]) apply (rule supp_id_bound bij_id | assumption)+ (* repeated *) apply ((rule ballI impI)+)? @@ -3743,8 +3710,8 @@ proof - apply (rule exI)+ apply (rule conjI[rotated])+ apply assumption - apply (assumption | (rule rel_rrename[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) - apply (rule refl T1.rrename_ids[symmetric]) + apply (assumption | (rule rel_permute[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) + apply (rule refl permute_ids[symmetric]) apply (rule supp_id_bound bij_id | assumption)+ (* repeated *) apply ((rule ballI impI)+)? @@ -3757,8 +3724,8 @@ proof - apply (rule exI)+ apply (rule conjI[rotated])+ apply assumption - apply (assumption | (rule rel_rrename[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) - apply (rule refl T1.rrename_ids[symmetric]) + apply (assumption | (rule rel_permute[THEN iffD2], (assumption | rule bij_id supp_id_bound)+)) + apply (rule refl permute_ids[symmetric]) apply (rule supp_id_bound bij_id | assumption)+ (* END REPEAT_DETERM *) (* REPEAT_DETERM *) @@ -3773,15 +3740,24 @@ proof - apply (erule T2_pre.mr_rel_set[rotated -1]) apply (rule supp_id_bound bij_id)+ apply (rule rel_set_UN_D) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id)+ apply (erule rel_FFVars) (* END REPEAT_DETERM *) apply assumption+ (* repeated *) + apply (unfold Un_Diff)[1] apply (erule id_on_antimono) apply (rule equalityD1) apply ((rule arg_cong2[of _ _ _ _ "(\)"])+)? + (* TRY EVERY *) + apply (rule sym) + apply (rule trans) + apply (rule arg_cong2[of _ _ _ _ minus, rotated]) + apply (erule T2_pre.mr_rel_set[rotated -1], (rule supp_id_bound bij_id)+)+ + apply (unfold image_id) + apply (rule refl) + (* END TRY *) (* REPEAT_DETERM *) apply (rule arg_cong2[of _ _ _ _ minus, rotated]) apply (rule trans) @@ -3790,7 +3766,7 @@ proof - apply (erule T2_pre.mr_rel_set[rotated -1]) apply (rule supp_id_bound bij_id)+ apply (rule rel_set_UN_D) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id)+ apply (erule rel_FFVars) (* repeated *) @@ -3801,7 +3777,7 @@ proof - apply (erule T2_pre.mr_rel_set[rotated -1]) apply (rule supp_id_bound bij_id)+ apply (rule rel_set_UN_D) - apply (erule T2_pre.mr_set_transfer(7-10)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) + apply (erule T2_pre.mr_set_transfer(8-11)[THEN rel_funD, rotated -1, THEN rel_set_mono_strong[rotated -1]]) apply (rule supp_id_bound bij_id)+ apply (erule rel_FFVars) (* END REPEAT_DETERM *) @@ -3820,7 +3796,7 @@ proof - apply (erule mp) apply (rule conjI) apply (rule refl) - apply (rule exI conjI bij_id supp_id_bound T1.rrename_ids[symmetric] | assumption)+ + apply (rule exI conjI bij_id supp_id_bound permute_ids[symmetric] | assumption)+ done subgoal apply (rule predicate2I) @@ -3830,7 +3806,7 @@ proof - apply (erule mp) apply (rule conjI) apply (rule refl) - apply (rule exI conjI bij_id supp_id_bound T1.rrename_ids[symmetric] | assumption)+ + apply (rule exI conjI bij_id supp_id_bound permute_ids[symmetric] | assumption)+ done done qed @@ -3846,7 +3822,7 @@ proof - (\z. set4_T1 z \ {(x, y). R x y} \ vvsubst_T1 id id id fst z = x \ vvsubst_T1 f1 f2 f3 snd z = y)) \ (rel_T2 R (vvsubst_T2 f1 f2 f3 id x2) y2 \ (\z. set4_T2 z \ {(x, y). R x y} \ vvsubst_T2 id id id fst z = x2 \ vvsubst_T2 f1 f2 f3 snd z = y2))" - apply (rule T1.TT_fresh_induct_param_no_clash[of + apply (rule fresh_induct_param[of "{ (p::('var \ 'var)\('tyvar \ 'tyvar)). |supp (fst p)| |supp (snd p)| (f1, f2). imsupp f1" "\(f1, f2). imsupp f2" "\x \. \f1 f2 y. \ = (f1, f2) \ rel_T1 R (vvsubst_T1 f1 f2 f3 id x) y \ (\z. set4_T1 z \ {(x, y). R x y} \ vvsubst_T1 id id id fst z = x \ vvsubst_T1 f1 f2 f3 snd z = y)" @@ -3878,32 +3854,22 @@ proof - apply (rule impI) apply (subst (asm) vvsubst_cctor_1) apply (rule assms | assumption)+ - (* REPEAT_DETERM (bound tac ) *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption apply (erule rel_plain_cases) - apply (drule T1.TT_injects0[THEN iffD1]) + apply (drule TT_inject0s[THEN iffD1]) apply (erule exE conjE)+ apply hypsubst apply (subst (asm) T1_pre.map_comp T1_pre.set_map, (rule assms bij_id supp_id_bound | assumption)+)+ apply (unfold id_o o_id image_id image_comp[unfolded comp_def]) - apply (subst (asm) FFVars_vvsubstss, (rule assms | assumption)+)+ + apply (subst (asm) FVars_vvsubstss, (rule assms | assumption)+)+ apply (unfold image_UN[symmetric] T1_pre.mr_rel_id) apply (drule iffD1[OF T1_pre.mr_rel_map(1), rotated -1]) - apply (rule assms supp_id_bound bij_id | assumption)+ + apply (rule assms supp_id_bound bij_id bij_comp supp_comp_bound infinite_UNIV | assumption)+ apply (unfold id_o o_id Grp_UNIV_id eq_OO) - apply (subst (asm) vvsubst_rrenames[symmetric] vvsubst_comp0s[symmetric], (assumption | rule supp_id_bound bij_id assms)+)+ + apply (subst (asm) vvsubst_permutes[symmetric] vvsubst_comp0s[symmetric], (assumption | rule supp_id_bound bij_id assms)+)+ apply (unfold id_o o_id) - apply (drule T1_pre.mr_rel_mono_strong0[rotated -11]) + apply (drule T1_pre.mr_rel_mono_strong0[rotated -12]) apply (rule ballI, rule refl)+ (* REPEAT_DETERM *) apply (rule ballI)+ @@ -3998,7 +3964,7 @@ proof - apply (unfold fst_conv snd_conv) apply (rule conjI supp_comp_bound infinite_UNIV | assumption)+ (* END REPEAT_DETERM *) - apply (rule assms | assumption)+ + apply (rule assms supp_comp_bound bij_comp infinite_UNIV | assumption)+ (* REPEAT_DETERM_N nrecs *) apply (erule thin_rl) apply (erule thin_rl) @@ -4006,13 +3972,13 @@ proof - apply (erule thin_rl) (* END REPEAT_DETERM_N *) apply (drule iffD1[OF T1_pre.mr_in_rel, rotated -1]) - apply (rule assms | assumption)+ + apply (rule assms supp_comp_bound bij_comp infinite_UNIV | assumption)+ apply (erule exE conjE)+ apply hypsubst apply (subst (asm) T1_pre.set_map, (rule bij_id supp_id_bound)+)+ apply (unfold triv_forall_equality image_id) subgoal for f1 f2 g1 g2 z - apply (rule exI[of _ "T1_ctor (map_T1_pre id id id id id id (pick1 R f1 f2 f3) (pick1 R (g1 \ f1) (g2 \ f2) f3) (pick2 R f1 f2 f3) (pick2 R (g1 \ f1) f2 f3) z)"]) + apply (rule exI[of _ "T1_ctor (map_T1_pre id id id id id id id (pick1 R f1 f2 f3) (pick1 R (g1 \ f1) (g2 \ f2) f3) (pick2 R f1 f2 f3) (pick2 R (g1 \ f1) f2 f3) z)"]) apply (rule conjI) apply (unfold set4_T1_simp) apply (subst T1_pre.set_map, (rule supp_id_bound bij_id)+)+ @@ -4136,23 +4102,19 @@ proof - apply (rule supp_id_bound bij_id)+ apply (unfold image_id) apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (subst T1_pre.set_map) apply (rule supp_id_bound bij_id)+ apply (unfold image_id) apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) apply assumption apply (subst T1_pre.map_comp) apply (rule bij_id supp_id_bound assms | assumption)+ apply (unfold id_o o_id) - apply (rule T1.TT_injects0[THEN iffD2]) + apply (rule TT_inject0s[THEN iffD2]) apply (rule exI)+ apply (rule conjI, assumption)+ (* REPEAT_DETERM *) @@ -4161,10 +4123,11 @@ proof - apply (unfold image_id) apply (erule id_on_antimono) apply (rule Un_mono)+ + apply (rule subset_refl)? (* REPEAT_DETERM *) apply (rule Diff_mono[OF _ subset_refl]) apply (unfold image_comp comp_def)[1] - apply (subst FFVars_vvsubstss) + apply (subst FVars_vvsubstss) apply (rule assms | assumption)+ apply (unfold image_UN[symmetric]) apply (rule image_mono) @@ -4181,13 +4144,13 @@ proof - apply (rotate_tac -2) apply (rule trans[rotated]) apply (erule arg_cong) - apply (subst FFVars_vvsubstss) + apply (subst FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id[symmetric]) (* repeated *) apply (rule Diff_mono[OF _ subset_refl]) - apply (unfold image_comp comp_assoc[symmetric] comp_def[of FFVars_T11] comp_def[of FFVars_T21])[1] - apply (subst FFVars_vvsubstss) + apply (unfold image_comp comp_assoc[symmetric] comp_def[of FVars_T11] comp_def[of FVars_T21])[1] + apply (subst FVars_vvsubstss) apply (rule assms | assumption)+ apply (subst comp_def) apply (unfold image_UN[symmetric]) @@ -4205,7 +4168,7 @@ proof - apply (rotate_tac -2) apply (rule trans[rotated]) apply (erule arg_cong) - apply (subst FFVars_vvsubstss) + apply (subst FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id[symmetric]) (* END REPEAT_DETERM *) @@ -4218,8 +4181,8 @@ proof - apply ((rule Un_mono)+)? (* REPEAT_DETERM *) apply (rule Diff_mono[OF _ subset_refl]) - apply (unfold image_comp comp_assoc[symmetric] comp_def[of FFVars_T11] comp_def[of FFVars_T21] comp_def[of FFVars_T12] comp_def[of FFVars_T22])[1] - apply (subst FFVars_vvsubstss) + apply (unfold image_comp comp_assoc[symmetric] comp_def[of FVars_T11] comp_def[of FVars_T21] comp_def[of FVars_T12] comp_def[of FVars_T22])[1] + apply (subst FVars_vvsubstss) apply (rule assms | assumption)+ apply (subst comp_def) apply (unfold image_UN[symmetric]) @@ -4237,7 +4200,7 @@ proof - apply (rotate_tac -2) apply (rule trans[rotated]) apply (erule arg_cong) - apply (subst FFVars_vvsubstss) + apply (subst FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id[symmetric]) (* END REPEAT_DETERM *) @@ -4245,10 +4208,10 @@ proof - apply (rule T1_pre.map_comp) apply (rule assms bij_id supp_id_bound | assumption)+ apply (unfold id_o o_id comp_assoc[symmetric])[1] - apply (subst vvsubst_rrenames[symmetric] vvsubst_comp0s[symmetric], (assumption | rule assms bij_id supp_id_bound)+)+ + apply (subst vvsubst_permutes[symmetric] vvsubst_comp0s[symmetric], (assumption | rule assms bij_id supp_id_bound)+)+ apply (unfold id_o o_id) apply (rule T1_pre.map_cong0) - apply (rule assms refl | assumption)+ + apply (rule assms refl supp_comp_bound bij_comp infinite_UNIV | assumption)+ (* REPEAT_DETERM *) apply (rule trans[OF comp_apply]) @@ -4325,7 +4288,7 @@ proof - apply (erule arg_cong) apply (rule sym) apply (rule trans) - apply (rule FFVars_vvsubstss) + apply (rule FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id) (* repeated *) @@ -4349,7 +4312,7 @@ proof - apply (erule arg_cong) apply (rule sym) apply (rule trans) - apply (rule FFVars_vvsubstss) + apply (rule FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id) (* END REPEAT_DETERM *) @@ -4376,7 +4339,7 @@ proof - apply (erule arg_cong) apply (rule sym) apply (rule trans) - apply (rule FFVars_vvsubstss) + apply (rule FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id) (* repeated *) @@ -4401,7 +4364,7 @@ proof - apply (erule arg_cong) apply (rule sym) apply (rule trans) - apply (rule FFVars_vvsubstss) + apply (rule FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id) (* repeated *) @@ -4425,7 +4388,7 @@ proof - apply (erule arg_cong) apply (rule sym) apply (rule trans) - apply (rule FFVars_vvsubstss) + apply (rule FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id) (* END REPEAT_DETERM *) @@ -4440,32 +4403,22 @@ proof - apply (rule impI) apply (subst (asm) vvsubst_cctor_2) apply (rule assms | assumption)+ - (* REPEAT_DETERM (bound tac ) *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption apply (erule rel_plain_cases) - apply (drule T1.TT_injects0[THEN iffD1]) + apply (drule TT_inject0s[THEN iffD1]) apply (erule exE conjE)+ apply hypsubst apply (subst (asm) T2_pre.map_comp T2_pre.set_map, (rule assms bij_id supp_id_bound | assumption)+)+ apply (unfold id_o o_id image_id image_comp[unfolded comp_def]) - apply (subst (asm) FFVars_vvsubstss, (rule assms | assumption)+)+ + apply (subst (asm) FVars_vvsubstss, (rule assms | assumption)+)+ apply (unfold image_UN[symmetric] T2_pre.mr_rel_id) apply (drule iffD1[OF T2_pre.mr_rel_map(1), rotated -1]) - apply (rule assms supp_id_bound bij_id | assumption)+ + apply (rule assms supp_id_bound bij_id supp_comp_bound infinite_UNIV | assumption)+ apply (unfold id_o o_id Grp_UNIV_id eq_OO) - apply (subst (asm) vvsubst_rrenames[symmetric] vvsubst_comp0s[symmetric], (assumption | rule supp_id_bound bij_id assms)+)+ + apply (subst (asm) vvsubst_permutes[symmetric] vvsubst_comp0s[symmetric], (assumption | rule supp_id_bound bij_id assms)+)+ apply (unfold id_o o_id) - apply (drule T2_pre.mr_rel_mono_strong0[rotated -11]) + apply (drule T2_pre.mr_rel_mono_strong0[rotated -12]) apply (rule ballI, rule refl)+ (* REPEAT_DETERM *) apply (rule ballI)+ @@ -4560,7 +4513,7 @@ proof - apply (unfold fst_conv snd_conv) apply (rule conjI supp_comp_bound infinite_UNIV | assumption)+ (* END REPEAT_DETERM *) - apply (rule assms | assumption)+ + apply (rule assms supp_comp_bound infinite_UNIV | assumption)+ (* REPEAT_DETERM_N nrecs *) apply (erule thin_rl) apply (erule thin_rl) @@ -4568,13 +4521,13 @@ proof - apply (erule thin_rl) (* END REPEAT_DETERM_N *) apply (drule iffD1[OF T2_pre.mr_in_rel, rotated -1]) - apply (rule assms | assumption)+ + apply (rule assms supp_comp_bound infinite_UNIV | assumption)+ apply (erule exE conjE)+ apply hypsubst apply (subst (asm) T2_pre.set_map, (rule bij_id supp_id_bound)+)+ apply (unfold triv_forall_equality image_id) subgoal for f1 f2 g1 g2 z - apply (rule exI[of _ "T2_ctor (map_T2_pre id id id id id id (pick1 R f1 f2 f3) (pick1 R (g1 \ f1) (g2 \ f2) f3) (pick2 R f1 f2 f3) (pick2 R (g1 \ f1) f2 f3) z)"]) + apply (rule exI[of _ "T2_ctor (map_T2_pre id id id id id id id (pick1 R f1 f2 f3) (pick1 R (g1 \ f1) (g2 \ f2) f3) (pick2 R f1 f2 f3) (pick2 R (g1 \ f1) f2 f3) z)"]) apply (rule conjI) apply (unfold set4_T2_simp) apply (subst T2_pre.set_map, (rule supp_id_bound bij_id)+)+ @@ -4698,23 +4651,19 @@ proof - apply (rule supp_id_bound bij_id)+ apply (unfold image_id) apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* repeated *) apply (subst T2_pre.set_map) apply (rule supp_id_bound bij_id)+ apply (unfold image_id) apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI impI)+ apply assumption (* END REPEAT_DETERM *) apply assumption apply (subst T2_pre.map_comp) apply (rule bij_id supp_id_bound assms | assumption)+ apply (unfold id_o o_id) - apply (rule T1.TT_injects0[THEN iffD2]) + apply (rule TT_inject0s[THEN iffD2]) apply (rule exI)+ apply (rule conjI, assumption)+ (* REPEAT_DETERM *) @@ -4723,10 +4672,11 @@ proof - apply (unfold image_id) apply (erule id_on_antimono) apply (rule Un_mono)+ + apply (rule subset_refl)? (* REPEAT_DETERM *) apply (rule Diff_mono[OF _ subset_refl]) apply (unfold image_comp comp_def)[1] - apply (subst FFVars_vvsubstss) + apply (subst FVars_vvsubstss) apply (rule assms | assumption)+ apply (unfold image_UN[symmetric]) apply (rule image_mono) @@ -4743,13 +4693,13 @@ proof - apply (rotate_tac -2) apply (rule trans[rotated]) apply (erule arg_cong) - apply (subst FFVars_vvsubstss) + apply (subst FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id[symmetric]) (* repeated *) apply (rule Diff_mono[OF _ subset_refl]) - apply (unfold image_comp comp_assoc[symmetric] comp_def[of FFVars_T11] comp_def[of FFVars_T21])[1] - apply (subst FFVars_vvsubstss) + apply (unfold image_comp comp_assoc[symmetric] comp_def[of FVars_T11] comp_def[of FVars_T21])[1] + apply (subst FVars_vvsubstss) apply (rule assms | assumption)+ apply (subst comp_def) apply (unfold image_UN[symmetric]) @@ -4767,7 +4717,7 @@ proof - apply (rotate_tac -2) apply (rule trans[rotated]) apply (erule arg_cong) - apply (subst FFVars_vvsubstss) + apply (subst FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id[symmetric]) (* END REPEAT_DETERM *) @@ -4780,8 +4730,8 @@ proof - apply ((rule Un_mono)+)? (* REPEAT_DETERM *) apply (rule Diff_mono[OF _ subset_refl]) - apply (unfold image_comp comp_assoc[symmetric] comp_def[of FFVars_T11] comp_def[of FFVars_T21] comp_def[of FFVars_T12] comp_def[of FFVars_T22])[1] - apply (subst FFVars_vvsubstss) + apply (unfold image_comp comp_assoc[symmetric] comp_def[of FVars_T11] comp_def[of FVars_T21] comp_def[of FVars_T12] comp_def[of FVars_T22])[1] + apply (subst FVars_vvsubstss) apply (rule assms | assumption)+ apply (subst comp_def) apply (unfold image_UN[symmetric]) @@ -4799,7 +4749,7 @@ proof - apply (rotate_tac -2) apply (rule trans[rotated]) apply (erule arg_cong) - apply (subst FFVars_vvsubstss) + apply (subst FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id[symmetric]) (* END REPEAT_DETERM *) @@ -4807,10 +4757,10 @@ proof - apply (rule T2_pre.map_comp) apply (rule assms bij_id supp_id_bound | assumption)+ apply (unfold id_o o_id comp_assoc[symmetric])[1] - apply (subst vvsubst_rrenames[symmetric] vvsubst_comp0s[symmetric], (assumption | rule assms bij_id supp_id_bound)+)+ + apply (subst vvsubst_permutes[symmetric] vvsubst_comp0s[symmetric], (assumption | rule assms bij_id supp_id_bound)+)+ apply (unfold id_o o_id) apply (rule T2_pre.map_cong0) - apply (rule assms refl | assumption)+ + apply (rule assms refl supp_comp_bound infinite_UNIV | assumption)+ (* REPEAT_DETERM *) apply (rule trans[OF comp_apply]) @@ -4887,7 +4837,7 @@ proof - apply (erule arg_cong) apply (rule sym) apply (rule trans) - apply (rule FFVars_vvsubstss) + apply (rule FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id) (* repeated *) @@ -4911,7 +4861,7 @@ proof - apply (erule arg_cong) apply (rule sym) apply (rule trans) - apply (rule FFVars_vvsubstss) + apply (rule FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id) (* END REPEAT_DETERM *) @@ -4938,7 +4888,7 @@ proof - apply (erule arg_cong) apply (rule sym) apply (rule trans) - apply (rule FFVars_vvsubstss) + apply (rule FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id) (* repeated *) @@ -4963,7 +4913,7 @@ proof - apply (erule arg_cong) apply (rule sym) apply (rule trans) - apply (rule FFVars_vvsubstss) + apply (rule FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id) (* repeated *) @@ -4987,7 +4937,7 @@ proof - apply (erule arg_cong) apply (rule sym) apply (rule trans) - apply (rule FFVars_vvsubstss) + apply (rule FVars_vvsubstss) apply (rule supp_id_bound bij_id)+ apply (rule image_id) (* END REPEAT_DETERM *) @@ -5022,52 +4972,28 @@ proof - have x: "\z z2. (set4_T1 z \ {(x, y). R x y} \ rel_T1 R (vvsubst_T1 f1 f2 f3 fst z) (vvsubst_T1 f1 f2 f3 snd z)) \ (set4_T2 z2 \ {(x, y). R x y} \ rel_T2 R (vvsubst_T2 f1 f2 f3 fst z2) (vvsubst_T2 f1 f2 f3 snd z2))" subgoal for z z2 - apply (rule T1.TT_fresh_co_induct[of "imsupp f1" "imsupp f2" _ _ z z2]) + apply (rule fresh_induct[of "imsupp f1" "imsupp f2" _ _ z z2]) apply (rule iffD2[OF imsupp_supp_bound] infinite_UNIV assms)+ apply (rule impI) (* REPEAT twice *) apply (subst vvsubst_cctor_1) apply (rule assms)+ - (* REPEAT_DETERM *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption (* repeated *) apply (subst vvsubst_cctor_1) apply (rule assms)+ - (* REPEAT_DETERM *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption (* END REPEAT twice *) apply (rule rel_T1_rel_T2.intros) apply (rule bij_id supp_id_bound id_on_id)+ - apply (unfold T1.rrename_id0s T1_pre.map_id) - apply (subst T1_pre.map_comp[OF assms, of id id id id id id id _ _ _ _ _ id id id id id, unfolded id_o o_id, symmetric]) - apply (rule supp_id_bound bij_id)+ - apply (subst (2) T1_pre.map_comp[OF assms, of id id id id id id id _ _ _ _ _ id id id id id, unfolded id_o o_id, symmetric]) - apply (rule supp_id_bound bij_id)+ + apply (unfold permute_id0s T1_pre.map_id) + apply (subst T1_pre.map_comp[OF assms, of id id _ id id id id id id _ _ _ _ _ id id id id id, unfolded id_o o_id, symmetric]) + apply (rule supp_id_bound bij_id assms)+ + apply (subst (2) T1_pre.map_comp[OF assms, of id id _ id id id id id id _ _ _ _ _ id id id id id, unfolded id_o o_id, symmetric]) + apply (rule supp_id_bound bij_id assms)+ apply (rotate_tac -1) apply (erule mp[rotated]) subgoal premises prems for v @@ -5127,46 +5053,22 @@ proof - (* REPEAT twice *) apply (subst vvsubst_cctor_2) apply (rule assms)+ - (* REPEAT_DETERM *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption (* repeated *) apply (subst vvsubst_cctor_2) apply (rule assms)+ - (* REPEAT_DETERM *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* repeated *) - apply (rule trans[OF Int_commute]) - apply (rule iffD2[OF disjoint_iff]) - apply (rule allI) - apply (rule impI) - apply assumption - (* END REPEAT_DETERM *) + apply (rule trans[OF Int_commute], assumption)+ apply assumption (* END REPEAT twice *) apply (rule rel_T1_rel_T2.intros) apply (rule bij_id supp_id_bound id_on_id)+ - apply (unfold T1.rrename_id0s T2_pre.map_id) - apply (subst T2_pre.map_comp[OF assms, of id id id id id id id _ _ _ _ _ id id id id id, unfolded id_o o_id, symmetric]) - apply (rule supp_id_bound bij_id)+ - apply (subst (2) T2_pre.map_comp[OF assms, of id id id id id id id _ _ _ _ _ id id id id id, unfolded id_o o_id, symmetric]) - apply (rule supp_id_bound bij_id)+ + apply (unfold permute_id0s T2_pre.map_id) + apply (subst T2_pre.map_comp[OF assms, of id id _ id id id id id id _ _ _ _ _ id id id id id, unfolded id_o o_id, symmetric]) + apply (rule supp_id_bound bij_id assms)+ + apply (subst (2) T2_pre.map_comp[OF assms, of id id _ id id id id id id _ _ _ _ _ id id id id id, unfolded id_o o_id, symmetric]) + apply (rule supp_id_bound bij_id assms)+ apply (rotate_tac -1) apply (erule mp[rotated]) subgoal premises prems for v @@ -5271,15 +5173,13 @@ subclass (in var_T1) var_T1_pre done subclass (in var_T1) var_T2_pre apply standard - apply (rule large) - apply (rule regular) done mrbnf "('var, 'tyvar, 'a, 'b) T1" map: vvsubst_T1 sets: - free: FFVars_T11 - free: FFVars_T12 + free: FVars_T11 + free: FVars_T12 free: set3_T1 live: set4_T1 bd: natLeq @@ -5288,15 +5188,15 @@ mrbnf "('var, 'tyvar, 'a, 'b) T1" var_class: var_T1 subgoal apply (rule trans) - apply (rule vvsubst_rrenames) + apply (rule vvsubst_permutes) apply (rule supp_id_bound bij_id)+ - apply (rule T1.rrename_id0s) + apply (rule permute_id0s) done apply (rule vvsubst_comp0s; assumption) apply (rule vvsubst_cong; assumption) - apply (rule ext, (unfold comp_def)[1], rule FFVars_vvsubstss set3_map set4_map; assumption)+ + apply (rule ext, (unfold comp_def)[1], rule FVars_vvsubstss set3_map set4_map; assumption)+ apply (rule infinite_regular_card_order_natLeq) - apply (rule T1.FFVars_bd)+ + apply (rule FVars_bds)+ apply (rule set_bd)+ apply (rule rel_OO_mono) apply (rule iffI) @@ -5311,8 +5211,8 @@ mrbnf "('var, 'tyvar, 'a, 'b) T1" mrbnf "('var, 'tyvar, 'a, 'b) T2" map: vvsubst_T2 sets: - free: FFVars_T21 - free: FFVars_T22 + free: FVars_T21 + free: FVars_T22 free: set3_T2 live: set4_T2 bd: natLeq @@ -5321,15 +5221,15 @@ mrbnf "('var, 'tyvar, 'a, 'b) T2" var_class: var_T1 subgoal apply (rule trans) - apply (rule vvsubst_rrenames) + apply (rule vvsubst_permutes) apply (rule supp_id_bound bij_id)+ - apply (rule T1.rrename_id0s) + apply (rule permute_id0s) done apply (rule vvsubst_comp0s; assumption) apply (rule vvsubst_cong; assumption) - apply (rule ext, (unfold comp_def)[1], rule FFVars_vvsubstss set3_map set4_map; assumption)+ + apply (rule ext, (unfold comp_def)[1], rule FVars_vvsubstss set3_map set4_map; assumption)+ apply (rule infinite_regular_card_order_natLeq) - apply (rule T1.FFVars_bd)+ + apply (rule FVars_bds)+ apply (rule set_bd)+ apply (rule rel_OO_mono) apply (rule iffI) diff --git a/thys/Infinitary_FOL/InfFOL.thy b/thys/Infinitary_FOL/InfFOL.thy index c992c12b..5550ad1e 100644 --- a/thys/Infinitary_FOL/InfFOL.thy +++ b/thys/Infinitary_FOL/InfFOL.thy @@ -199,7 +199,7 @@ apply (rule k1_Cinfinite) apply (rule kregular) done -lemma rrename_Bot_simp[simp]: "bij (f::'a::var_ifol'_pre \ 'a) \ |supp f| rrename_ifol' f \ = \" +lemma rrename_Bot_simp[simp]: "bij (f::'a::var_ifol'_pre \ 'a) \ |supp f| permute_ifol' f \ = \" unfolding Bot_def ifol'.permute map_set\<^sub>k\<^sub>1_def map_fun_def comp_def Abs_set\<^sub>k\<^sub>1_inverse[OF UNIV_I] unfolding id_def map_bset_bempty by (rule refl) @@ -226,49 +226,49 @@ lemma small_set\<^sub>k\<^sub>2[simp]: "small (set\<^sub>k\<^sub>2 (V :: k set\< apply (rule ordLess_ordLeq_trans[OF set\<^sub>k\<^sub>2.set_bd]) using var_set\<^sub>k\<^sub>2_class.large by force -lemma in_k_equiv': "bij \ \ f \\<^sub>k \ \ rrename_ifol' \ f \\<^sub>k map_set\<^sub>k (rrename_ifol' \) \" +lemma in_k_equiv': "bij \ \ f \\<^sub>k \ \ permute_ifol' \ f \\<^sub>k map_set\<^sub>k (permute_ifol' \) \" unfolding kmember_def map_fun_def id_o o_id map_set\<^sub>k_def unfolding comp_def Abs_set\<^sub>k_inverse[OF UNIV_I] apply transfer apply transfer by blast -lemma in_k_equiv: "isPerm \ \ rrename_ifol' \ f \\<^sub>k map_set\<^sub>k (rrename_ifol' \) \ = f \\<^sub>k \" +lemma in_k_equiv: "isPerm \ \ permute_ifol' \ f \\<^sub>k map_set\<^sub>k (permute_ifol' \) \ = f \\<^sub>k \" unfolding isPerm_def apply (erule conjE) apply (rule iffI) apply (drule in_k_equiv'[rotated]) apply (rule bij_imp_bij_inv) apply assumption - apply (subst (asm) ifol'.rrename_comps) + apply (subst (asm) ifol'.permute_comp) apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ apply (subst (asm) set\<^sub>k.map_comp) - apply (subst (asm) ifol'.rrename_comp0s) + apply (subst (asm) ifol'.permute_comp0) apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ apply (subst (asm) inv_o_simp1, assumption)+ - apply (unfold ifol'.rrename_id0s set\<^sub>k.map_id) + apply (unfold ifol'.permute_id0 set\<^sub>k.map_id) apply (unfold id_def)[1] apply assumption apply (erule in_k_equiv'[rotated]) apply assumption done -lemma in_k1_equiv': "bij \ \ f \\<^sub>k\<^sub>1 F \ rrename_ifol' \ f \\<^sub>k\<^sub>1 map_set\<^sub>k\<^sub>1 (rrename_ifol' \) F" +lemma in_k1_equiv': "bij \ \ f \\<^sub>k\<^sub>1 F \ permute_ifol' \ f \\<^sub>k\<^sub>1 map_set\<^sub>k\<^sub>1 (permute_ifol' \) F" apply (unfold k1member_def map_fun_def comp_def id_def map_set\<^sub>k\<^sub>1_def Abs_set\<^sub>k\<^sub>1_inverse[OF UNIV_I]) apply transfer apply transfer by blast -lemma in_k1_equiv: "isPerm \ \ rrename_ifol' \ f \\<^sub>k\<^sub>1 map_set\<^sub>k\<^sub>1 (rrename_ifol' \) \ = f \\<^sub>k\<^sub>1 \" +lemma in_k1_equiv: "isPerm \ \ permute_ifol' \ f \\<^sub>k\<^sub>1 map_set\<^sub>k\<^sub>1 (permute_ifol' \) \ = f \\<^sub>k\<^sub>1 \" unfolding isPerm_def apply (erule conjE) apply (rule iffI) apply (drule in_k1_equiv'[rotated]) apply (rule bij_imp_bij_inv) apply assumption - apply (subst (asm) ifol'.rrename_comps) + apply (subst (asm) ifol'.permute_comp) apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ apply (subst (asm) set\<^sub>k\<^sub>1.map_comp) - apply (subst (asm) ifol'.rrename_comp0s) + apply (subst (asm) ifol'.permute_comp0) apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ apply (subst (asm) inv_o_simp1, assumption)+ - apply (unfold ifol'.rrename_id0s set\<^sub>k\<^sub>1.map_id) + apply (unfold ifol'.permute_id0 set\<^sub>k\<^sub>1.map_id) apply (unfold id_def)[1] apply assumption apply (erule in_k1_equiv'[rotated]) @@ -336,46 +336,46 @@ inductive deduct :: "ifol set\<^sub>k \ ifol \ bool" (in | ConjE: "\ \ \ Conj F ; f \\<^sub>k\<^sub>1 F \ \ \ \ f" | NegI: "\,f \ \ \ \ \ Neg f" | NegE: "\ \ \ Neg f ; \ \ f \ \ \ \ \" -| AllI: "\ \ \ f ; set\<^sub>k\<^sub>2 V \ \(FFVars_ifol' ` set\<^sub>k \) = {} \ \ \ \ All V f" +| AllI: "\ \ \ f ; set\<^sub>k\<^sub>2 V \ \(FVars_ifol' ` set\<^sub>k \) = {} \ \ \ \ All V f" | AllE: "\ \ \ All V f ; supp \ \ set\<^sub>k\<^sub>2 V \ \ \ \ f\\\" binder_inductive deduct subgoal for R B \ x1 x2 unfolding induct_rulify_fallback split_beta apply (elim disj_forward exE) - apply (auto simp: ifol'.rrename_comps in_k_equiv in_k_equiv' isPerm_def ifol'.rrename_ids supp_inv_bound) + apply (auto simp: ifol'.permute_comp in_k_equiv in_k_equiv' isPerm_def ifol'.permute_id supp_inv_bound) apply (rule exI) apply (rule conjI) apply (rule refl) apply (rule allI impI)+ apply (unfold set\<^sub>k.map_comp) - apply (subst ifol'.rrename_comp0s) + apply (subst ifol'.permute_comp0) apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ apply (subst inv_o_simp1, assumption) - apply (unfold ifol'.rrename_id0s set\<^sub>k.map_id) + apply (unfold ifol'.permute_id0 set\<^sub>k.map_id) apply (rotate_tac -1) apply (drule iffD2[OF in_k1_equiv, of "inv \", rotated]) apply (unfold isPerm_def) apply (assumption | rule conjI bij_imp_bij_inv supp_inv_bound)+ apply (subst (asm) set\<^sub>k\<^sub>1.map_comp) - apply (subst (asm) ifol'.rrename_comp0s) + apply (subst (asm) ifol'.permute_comp0) apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ apply (subst (asm) inv_o_simp1, assumption) - apply (unfold ifol'.rrename_id0s set\<^sub>k\<^sub>1.map_id) + apply (unfold ifol'.permute_id0 set\<^sub>k\<^sub>1.map_id) apply (erule allE) apply (erule impE) apply assumption+ - apply (subst ifol'.rrename_comp0s) + apply (subst ifol'.permute_comp0) apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ apply (subst inv_o_simp1, assumption) - apply (unfold ifol'.rrename_id0s set\<^sub>k.map_id) - apply (metis bij_imp_bij_inv ifol'.rrename_comps ifol'.rrename_ids ifol'.permute(3) in_k1_equiv' inv_o_simp1 supp_inv_bound) - apply (metis ifol'.rrename_bijs ifol'.rrename_inv_simps inv_o_simp1 inv_simp1 set\<^sub>k.map_id) - apply (metis ifol'.rrename_bijs ifol'.rrename_inv_simps inv_o_simp1 inv_simp1 set\<^sub>k.map_id) + apply (unfold ifol'.permute_id0 set\<^sub>k.map_id) + apply (metis bij_imp_bij_inv ifol'.permute_comp ifol'.permute_id ifol'.permute(3) in_k1_equiv' inv_o_simp1 supp_inv_bound) + apply (metis ifol'.permute_bij ifol'.permute_inv_simp inv_o_simp1 inv_simp1 set\<^sub>k.map_id) + apply (metis ifol'.permute_bij ifol'.permute_inv_simp inv_o_simp1 inv_simp1 set\<^sub>k.map_id) subgoal for f V - apply (rule exI[of _ "rrename_ifol' \ f"]) + apply (rule exI[of _ "permute_ifol' \ f"]) apply (rule exI[of _ "map_set\<^sub>k\<^sub>2 \ V"]) - by (smt (verit, ccfv_threshold) bij_imp_bij_inv ifol'.rrename_comp0s ifol'.rrename_id0s ifol'.rrename_ids ifol'.set_map0 ifol'_vvsubst_rrename image_Int_empty image_Union image_comp inv_o_simp1 pointfree_idE set\<^sub>k.map_ident_strong set\<^sub>k.set_map set\<^sub>k\<^sub>2.set_map supp_inv_bound) + by (smt (verit, ccfv_threshold) bij_imp_bij_inv ifol'.permute_comp0 ifol'.permute_id0 ifol'.permute_id ifol'.set_map0 ifol'_vvsubst_permute image_Int_empty image_Union image_comp inv_o_simp1 pointfree_idE set\<^sub>k.map_ident_strong set\<^sub>k.set_map set\<^sub>k\<^sub>2.set_map supp_inv_bound) subgoal for V f \ apply (rule exI[of _ "map_set\<^sub>k\<^sub>2 \ V"]) apply (unfold set\<^sub>k\<^sub>2.set_map) @@ -384,11 +384,11 @@ binder_inductive deduct apply (unfold set\<^sub>k\<^sub>2.map_comp) apply (subst inv_o_simp1, assumption) apply (unfold set\<^sub>k\<^sub>2.map_id) - apply (rule exI[of _ "rrename_ifol' \ f"]) - apply (subst ifol'.rrename_comps) + apply (rule exI[of _ "permute_ifol' \ f"]) + apply (subst ifol'.permute_comp) apply (assumption | rule bij_imp_bij_inv supp_inv_bound)+ apply (subst inv_o_simp1, assumption) - apply (unfold ifol'.rrename_ids) + apply (unfold ifol'.permute_id) apply (rule exI[of _ "\ \ \ \ inv \"]) apply (subgoal_tac "|supp \| k.map_ident_strong) + apply (metis ifol'.permute_bij ifol'.permute_inv_simp inv_simp1 set\<^sub>k.map_ident_strong) apply (erule image_mono) done done @@ -421,18 +421,18 @@ binder_inductive deduct apply (elim exE conjE) apply simp subgoal for \ f V - apply (rule exE[OF refresh[of V "\(FFVars_ifol' ` set\<^sub>k \) \ FFVars_ifol' (All V f)", unfolded ifol'.set + apply (rule exE[OF refresh[of V "\(FVars_ifol' ` set\<^sub>k \) \ FVars_ifol' (All V f)", unfolded ifol'.set Un_Diff Diff_idemp ]]) apply blast apply (metis (no_types, lifting) ifol'.set(4) ifol'.set_bd_UNIV set\<^sub>k.set_bd var_ifol'_pre_class.UN_bound var_ifol'_pre_class.Un_bound) apply (erule exE conjE)+ subgoal for g VV - apply (rule exI[of _ "map_set\<^sub>k (rrename_ifol' g) \"]) + apply (rule exI[of _ "map_set\<^sub>k (permute_ifol' g) \"]) apply (rule exI[of _ "g ` set\<^sub>k\<^sub>2 V"]) apply (rule conjI[rotated]) apply (metis set\<^sub>k\<^sub>2.set_map) - apply (rule exI[of _ "rrename_ifol' g f"]) + apply (rule exI[of _ "permute_ifol' g f"]) apply (rule exI[of _ VV]) apply (rule conjI) apply (drule arg_cong[of _ _ set\<^sub>k\<^sub>2]) @@ -446,7 +446,7 @@ binder_inductive deduct apply (rule trans) apply (rule id_apply) apply (rule sym) - apply (rule ifol'.rrename_cong_ids) + apply (rule ifol'.permute_cong_id) apply assumption+ apply (erule id_onD) apply (rule UnI1) @@ -459,7 +459,7 @@ binder_inductive deduct apply assumption apply (rule conjI | assumption)+ - apply (unfold set\<^sub>k.set_map image_comp[unfolded comp_def] ifol'.FFVars_rrenames + apply (unfold set\<^sub>k.set_map image_comp[unfolded comp_def] ifol'.FVars_permute image_UN[symmetric] )[1] apply hypsubst @@ -471,7 +471,7 @@ binder_inductive deduct apply assumption apply (subst All_def)+ - apply (unfold ifol'.TT_injects0) + apply (unfold ifol'.TT_inject0) apply (rule exI[of _ g]) apply (rule conjI, assumption)+ apply (rule conjI) @@ -498,7 +498,7 @@ binder_inductive deduct subgoal premises prems for V f \ proof - define X where "X \ set\<^sub>k\<^sub>2 V" - let ?O = "\ (FFVars_ifol' ` set\<^sub>k \) \ \ ` FFVars_ifol' f \ imsupp \ \ X \ (FFVars_ifol' f - set\<^sub>k\<^sub>2 V)" + let ?O = "\ (FVars_ifol' ` set\<^sub>k \) \ \ ` FVars_ifol' f \ imsupp \ \ X \ (FVars_ifol' f - set\<^sub>k\<^sub>2 V)" have osmall: "|?O| k.set_bd var_ifol'_pre_class.UN_bound) @@ -541,7 +541,7 @@ binder_inductive deduct moreover have "supp \ \ X \ W'" using \(2) unfolding id_on_def by (meson UnI1 UnI2 \_def not_in_supp_alt subsetI) ultimately have \_small: "|supp \| ' where "\' \ \x. if x \ \ ` FFVars_ifol' f then (\ \ \) x else x" + define \' where "\' \ \x. if x \ \ ` FVars_ifol' f then (\ \ \) x else x" have "supp \' \ supp (\ \ \)" unfolding \'_def supp_def by auto then have \'_small: "|supp \'| _small card_of_subset_bound ifol'_pre.supp_comp_bound prems(3) small_def small_set\<^sub>k\<^sub>2) @@ -553,11 +553,11 @@ binder_inductive deduct apply (rule conjI) apply (rule exI[of _ "map_set\<^sub>k\<^sub>2 \ V"]) apply (rule conjI[rotated])+ - apply (rule exI[of _ "rrename_ifol' \ f"]) + apply (rule exI[of _ "permute_ifol' \ f"]) apply (rule exI[of _ \']) apply (rule conjI) - apply (subst ifol'_vvsubst_rrename[symmetric]) + apply (subst ifol'_vvsubst_permute[symmetric]) apply (rule \_bij) apply (rule \_small) apply (subst ifol'.map_comp) @@ -578,7 +578,7 @@ binder_inductive deduct prefer 2 apply assumption apply (rule sym) - apply (unfold All_def ifol'.TT_injects0)[1] + apply (unfold All_def ifol'.TT_inject0)[1] apply (unfold set3_ifol'_pre_def comp_def Abs_ifol'_pre_inverse[OF UNIV_I] map_sum.simps map_prod_simp sum_set_simps prod_set_simps Un_empty cSup_singleton Un_empty_left Un_empty_right Union_empty UN_single set2_ifol'_pre_def set\<^sub>k\<^sub>2.set_map @@ -593,7 +593,7 @@ binder_inductive deduct apply (rule refl) apply (unfold set\<^sub>k\<^sub>2.set_map) - apply (subgoal_tac "supp (\ \ \) \ \ ` FFVars_ifol' f \ \ ` set\<^sub>k\<^sub>2 V") + apply (subgoal_tac "supp (\ \ \) \ \ ` FVars_ifol' f \ \ ` set\<^sub>k\<^sub>2 V") apply (smt (verit, best) IntI \'_def not_in_supp_alt subset_iff) apply (unfold supp_def imsupp_def) using X_def \_def apply auto[1] diff --git a/thys/Infinitary_Lambda_Calculus/ILC.thy b/thys/Infinitary_Lambda_Calculus/ILC.thy index f00b686c..f94be214 100644 --- a/thys/Infinitary_Lambda_Calculus/ILC.thy +++ b/thys/Infinitary_Lambda_Calculus/ILC.thy @@ -53,10 +53,11 @@ for vvsubst: ivvsubst tvsubst: itvsubst +declare [[show_consts]] lemma ex_inj_infinite_regular_var_iterm_pre: "\f :: 'a :: countable \ 'b :: var_iterm_pre. inj f" unfolding card_of_ordLeq[of UNIV UNIV, simplified] - apply (rule ordLeq_transitive[OF _ large]) + apply (rule ordLeq_transitive[OF _ var_iterm_pre_class.large]) apply (rule ordLeq_transitive[OF countable_card_le_natLeq[THEN iffD1]]) apply simp apply (rule natLeq_ordLeq_cinfinite) @@ -149,13 +150,13 @@ abbreviation "VVr \ tvVVr_itvsubst" lemmas VVr_def = tvVVr_itvsubst_def abbreviation "isVVr \ tvisVVr_itvsubst" lemmas isVVr_def = tvisVVr_itvsubst_def -abbreviation "IImsupp \ IImsupp_itvsubst" -lemmas IImsupp_def = IImsupp_itvsubst_def -abbreviation "SSupp \ SSupp_itvsubst" -lemmas SSupp_def = SSupp_itvsubst_def -abbreviation "FFVars \ FFVars_iterm" +abbreviation "IImsupp \ IImsupp_iterm" +lemmas IImsupp_def = IImsupp_iterm_def +abbreviation "SSupp \ SSupp_iterm" +lemmas SSupp_def = SSupp_iterm_def +abbreviation "FFVars \ FVars_iterm" -abbreviation "irrename \ rrename_iterm" +abbreviation "irrename \ permute_iterm" (* *) lemma FFVars_itvsubst[simp]: @@ -163,7 +164,7 @@ lemma FFVars_itvsubst[simp]: shows "FFVars (itvsubst \ t) = (\ {FFVars (\ x) | x . x \ FFVars t})" apply (binder_induction t avoiding: "IImsupp \" rule: iterm.strong_induct) apply (rule iterm.fresh_induct[of "IImsupp \"]) - apply (auto simp: IImsupp_def assms intro!: Un_bound UN_bound iterm.card_of_FFVars_bounds) + apply (auto simp: IImsupp_def assms intro!: Un_bound UN_bound iterm.set_bd_UNIV) using iterm.FVars_VVr apply (fastforce simp add: SSupp_def) using iterm.FVars_VVr apply (auto simp add: SSupp_def Int_Un_distrib) apply (smt (verit) disjoint_insert(1) empty_iff insertE insert_absorb iterm.FVars_VVr mem_Collect_eq) @@ -173,8 +174,8 @@ lemma FFVars_itvsubst[simp]: (* Enabling some simplification rules: *) lemmas iterm.tvsubst_VVr[simp] lemmas iterm.FVars_VVr[simp] -iterm.rrename_ids[simp] iterm.rrename_cong_ids[simp] -iterm.FFVars_rrenames[simp] +iterm.permute_id[simp] iterm.permute_cong_id[simp] +iterm.FVars_permute[simp] lemma singl_bound: "|{a}| \. A" "\t \. P t", rule_format, no_vars] - -lemma irrename_cong: -assumes f: "bij f" "|supp f| z. (z::ivar) \ FFVars P \ f z = g z)" -shows "irrename f P = irrename g P" -using eq proof (binder_induction P avoiding: "supp f" "supp g" rule: iterm.strong_induct) - case (iApp x1 x2) - then show ?case using f g by simp (metis stream.map_cong0) -next - case (iLam x1 x2) - thm iterm.subst - then show ?case using f g apply simp - by (metis iLam.hyps(4) iterm.permute(3) iterm.map_cong0 iterm_vvsubst_rrename) -qed (auto simp: f g) - lemma itvsubst_cong: assumes f: "|SSupp f| z. (z::ivar) \ FFVars P \ f z = g z)" @@ -270,7 +252,7 @@ proposition iApp_inject[simp]: "(iApp a b = iApp c d) = (a = c \ b = d)" proof assume "iApp a b = iApp c d" then show "a = c \ b = d" - unfolding iApp_def fun_eq_iff iterm.TT_injects0 + unfolding iApp_def fun_eq_iff iterm.TT_inject0 map_iterm_pre_def comp_def Abs_iterm_pre_inverse[OF UNIV_I] map_sum_def sum.case prod.map_id Abs_iterm_pre_inject[OF UNIV_I UNIV_I] by auto @@ -280,7 +262,7 @@ proposition iVar_inject[simp]: "(iVar a = iVar b) = (a = b)" apply (rule iffI[rotated]) apply (rule arg_cong[of _ _ iVar]) apply assumption - unfolding iVar_def iterm.TT_injects0 map_iterm_pre_def comp_def map_sum_def sum.case Abs_iterm_pre_inverse[OF UNIV_I] + unfolding iVar_def iterm.TT_inject0 map_iterm_pre_def comp_def map_sum_def sum.case Abs_iterm_pre_inverse[OF UNIV_I] id_def Abs_iterm_pre_inject[OF UNIV_I UNIV_I] sum.inject apply (erule exE conjE)+ apply assumption @@ -289,14 +271,14 @@ proposition iVar_inject[simp]: "(iVar a = iVar b) = (a = b)" lemma iLam_inject: "(iLam xs e = iLam xs' e') = (\f. bij f \ |supp (f::ivar \ ivar)| id_on (FFVars (iLam xs e)) f \ dsmap f xs = xs' \ irrename f e = e')" unfolding iterm.set - unfolding iLam_def iterm.TT_injects0 map_iterm_pre_def comp_def Abs_iterm_pre_inverse[OF UNIV_I] + unfolding iLam_def iterm.TT_inject0 map_iterm_pre_def comp_def Abs_iterm_pre_inverse[OF UNIV_I] map_sum_def sum.case map_prod_def prod.case id_def Abs_iterm_pre_inject[OF UNIV_I UNIV_I] sum.inject prod.inject set3_iterm_pre_def sum_set_simps Union_empty Un_empty_left prod_set_simps cSup_singleton set2_iterm_pre_def Un_empty_right UN_single by auto lemma iLam_same_inject[simp]: "iLam (xs::ivar dstream) e = iLam xs e' \ e = e'" unfolding iLam_inject apply safe -apply(rule iterm.rrename_cong_ids[symmetric]) +apply(rule iterm.permute_cong_id[symmetric]) unfolding id_on_def by auto (metis bij_betw_def bij_imp_bij_betw dsnth_dsmap dtheN) lemma bij_map_term_pre: "bij f \ |supp (f::ivar \ ivar)| bij (map_iterm_pre (id::ivar \ivar) f (irrename f) id)" @@ -309,12 +291,12 @@ lemma bij_map_term_pre: "bij f \ |supp (f::ivar \ iv apply (rule trans) apply (rule iterm_pre.map_comp0[symmetric]) apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp1 iterm.rrename_comp0s iterm.rrename_id0s + unfolding id_o inv_o_simp1 iterm.permute_comp0 iterm.permute_id0 apply (rule iterm_pre.map_id0) apply (rule trans) apply (rule iterm_pre.map_comp0[symmetric]) apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp2 iterm.rrename_comp0s iterm.rrename_id0s + unfolding id_o inv_o_simp2 iterm.permute_comp0 iterm.permute_id0 apply (rule iterm_pre.map_id0) done @@ -331,13 +313,13 @@ lemma map_term_pre_inv_simp: "bij f \ |supp (f::ivar \ \xs' e'. iterm_ctor v = iLam xs' e' \ dsset xs' \ set2_iterm_pre v \ e' \ set3_iterm_pre v" - unfolding iLam_def iterm.TT_injects0 + unfolding iLam_def iterm.TT_inject0 apply (erule exE) apply (erule conjE)+ subgoal for f @@ -350,7 +332,7 @@ apply (drule iffD2[OF bij_imp_inv', rotated, of "map_iterm_pre id f (irrename f) apply (rule exI[of _ "id"]) apply (rule conjI bij_id supp_id_bound id_on_id)+ apply (drule sym) - unfolding iterm.rrename_id0s iterm_pre.map_id map_term_pre_inv_simp + unfolding iterm.permute_id0 iterm_pre.map_id map_term_pre_inv_simp unfolding map_iterm_pre_def comp_def Abs_iterm_pre_inverse[OF UNIV_I] map_sum_def sum.case map_prod_def prod.case id_def apply assumption @@ -358,18 +340,16 @@ apply (drule iffD2[OF bij_imp_inv', rotated, of "map_iterm_pre id f (irrename f) unfolding set2_iterm_pre_def set3_iterm_pre_def comp_def Abs_iterm_pre_inverse[OF UNIV_I] sum_set_simps map_sum_def sum.case Union_empty Un_empty_left map_prod_def prod.case prod_set_simps ccpo_Sup_singleton Un_empty_right id_on_def image_single[symmetric] - unfolding iterm.FFVars_rrenames[OF bij_imp_bij_inv supp_inv_bound] + unfolding iterm.FVars_permute[OF bij_imp_bij_inv supp_inv_bound] unfolding image_single image_set_diff[OF bij_is_inj[OF bij_imp_bij_inv], symmetric] - image_in_bij_eq[OF bij_imp_bij_inv] inv_inv_eq image_in_bij_eq[OF iterm.rrename_bijs[OF bij_imp_bij_inv supp_inv_bound]] - iterm.rrename_inv_simps[OF bij_imp_bij_inv supp_inv_bound] inv_simp2 - unfolding iterm.rrename_comps[OF bij_imp_bij_inv supp_inv_bound] inv_o_simp2 iterm.rrename_ids + image_in_bij_eq[OF bij_imp_bij_inv] inv_inv_eq image_in_bij_eq[OF iterm.permute_bij[OF bij_imp_bij_inv supp_inv_bound]] + iterm.permute_inv_simp[OF bij_imp_bij_inv supp_inv_bound] inv_simp2 + unfolding iterm.permute_comp[OF bij_imp_bij_inv supp_inv_bound] inv_o_simp2 iterm.permute_id apply (rule conjI bij_imp_bij_inv supp_inv_bound singletonI | assumption)+ by auto . lemma iLam_avoid: "|A::ivar set| \xs' e'. iLam xs e = iLam xs' e' \ dsset xs' \ A = {}" - apply (drule iterm.TT_fresh_nchotomys[of _ "iLam xs e"]) - apply (erule exE) - apply (erule conjE) + apply (erule iterm.TT_fresh_cases[of _ "iLam xs e"]) apply (drule sym) apply (frule iLam_set3) apply (erule exE conjE)+ @@ -378,7 +358,7 @@ lemma iLam_avoid: "|A::ivar set| \ apply (rule trans) apply (rule sym) apply assumption - apply (rotate_tac 2) + apply (rotate_tac 3) apply assumption apply (drule iffD1[OF disjoint_iff]) by auto @@ -386,7 +366,7 @@ lemma iLam_avoid: "|A::ivar set| \ lemma iLam_irrename: "bij (\::ivar\ivar) \ |supp \| (\a'. a' \ FFVars e - dsset (as::ivar dstream) \ \ a' = a') \ iLam as e = iLam (dsmap \ as) (irrename \ e)" -by (metis iterm.permute(3) iterm.rrename_cong_ids iterm.set(3)) +by (metis iterm.permute(3) iterm.permute_cong_id iterm.set(3)) (* Bound properties (needed as auxiliaries): *) @@ -482,7 +462,7 @@ using SSupp_upd_iVar_bound . lemma IImsupp_irrename_update_su: assumes s[simp]: "bij (\::ivar\ivar)" "|supp \| \ iVar(x := e)) \ - imsupp \ \ {x} \ FFVars_iterm e" + imsupp \ \ {x} \ FVars_iterm e" unfolding IImsupp_def SSupp_def imsupp_def supp_def by (auto split: if_splits) lemma IImsupp_irrename_update_bound: @@ -538,7 +518,7 @@ proof- subgoal by simp subgoal by simp (metis (mono_tags, lifting) comp_apply stream.map_comp stream.map_cong) subgoal for xs t apply simp apply(subgoal_tac "dsset xs \ IImsupp (\a. irrename \ (\ a)) = {}") - subgoal by simp (metis Int_Un_emptyI1 Int_Un_emptyI2 assms(2) b iterm.map(3) iterm.subst(3) iterm_vvsubst_rrename s(2)) + subgoal by simp (metis Int_Un_emptyI1 Int_Un_emptyI2 assms(2) b iterm.map(3) iterm.subst(3) iterm_vvsubst_permute s(2)) subgoal using IImsupp_irrename_su' b s(1) by blast . . qed @@ -617,11 +597,11 @@ lemma usub_swap_disj: assumes "{u,v} \ {x,y} = {}" shows "usub (swap t u v) x y = swap (usub t x y) u v" proof- - note iterm_vvsubst_rrename[simp del] + note iterm_vvsubst_permute[simp del] show ?thesis using assms - apply(subst iterm_vvsubst_rrename[symmetric]) apply auto + apply(subst iterm_vvsubst_permute[symmetric]) apply auto apply(subst iterm.map_comp) apply auto - apply(subst iterm_vvsubst_rrename[symmetric]) apply auto + apply(subst iterm_vvsubst_permute[symmetric]) apply auto apply(subst iterm.map_comp) apply auto apply(rule iterm.map_cong0) using iterm_pre.supp_comp_bound by auto @@ -630,7 +610,7 @@ qed lemma irrename_o_swap: "irrename (id(y::ivar := yy, yy := y) o id(x := xx, xx := x)) t = swap (swap t x xx) y yy" -apply(subst iterm.rrename_comps[symmetric]) +apply(subst iterm.permute_comp[symmetric]) by auto (* *) @@ -641,10 +621,10 @@ lemma swap_simps[simp]: "swap (iVar z) (y::ivar) x = iVar (sw z y x)" unfolding sw_def by simp_all (metis eq_id_iff fun_upd_apply) lemma FFVars_swap[simp]: "FFVars (swap t y x) = (\u. sw u x y) ` (FFVars t)" -apply(subst iterm.FFVars_rrenames) by (auto simp: sw_def) +apply(subst iterm.FVars_permute) by (auto simp: sw_def) lemma FFVars_swap'[simp]: "{x::ivar,y} \ FFVars t = {} \ swap t x y = t" -apply(rule iterm.rrename_cong_ids) by auto +apply(rule iterm.permute_cong_id) by auto (* *) @@ -793,9 +773,9 @@ lemma usub_refresh: assumes "xx \ FFVars t \ xx = x" shows "usub t u x = usub (swap t x xx) u xx" proof- - note iterm_vvsubst_rrename[simp del] + note iterm_vvsubst_permute[simp del] show ?thesis using assms - apply(subst iterm_vvsubst_rrename[symmetric]) apply simp + apply(subst iterm_vvsubst_permute[symmetric]) apply simp subgoal by auto subgoal apply(subst iterm.map_comp) subgoal by auto @@ -807,11 +787,11 @@ qed lemma swap_commute: "{y,yy} \ {x,xx} = {} \ swap (swap t y yy) x xx = swap (swap t x xx) y yy" -apply(subst iterm.rrename_comps) +apply(subst iterm.permute_comp) apply auto -apply(subst iterm.rrename_comps) +apply(subst iterm.permute_comp) apply auto -apply(rule irrename_cong) +apply(rule iterm.permute_cong) by (auto simp: iterm_pre.supp_comp_bound) @@ -917,7 +897,7 @@ proof apply (meson bij_betw_def bij_imp_bij_betw) apply (meson bij_betw_def bij_imp_bij_betw) by (smt (verit) Un_iff bf bij_betw_apply disjoint_iff_not_equal) - subgoal apply(rule irrename_cong) + subgoal apply(rule iterm.permute_cong) apply blast apply (metis supp_def) apply meson @@ -1083,10 +1063,10 @@ proof- by (smt (verit) Int_emptyD ds dsmap.rep_eq dsnth_dsmap dsset.rep_eq dtheN g(6) o_apply) have 0: "irrename g e = irrename g' e'" - unfolding e' apply(subst iterm.rrename_comps) + unfolding e' apply(subst iterm.permute_comp) subgoal using h g' g by auto subgoal using h g' g by auto subgoal using h g' g by auto subgoal using h g' g by auto - subgoal apply(rule irrename_cong) + subgoal apply(rule iterm.permute_cong) subgoal using h g' g by auto subgoal using h g' g by auto subgoal using h g' g by auto subgoal using h g' g dstream.supp_comp_bound by blast subgoal for z apply auto using hid g(3,4,5) g'(3,4,5) unfolding id_on_def apply auto @@ -1114,7 +1094,7 @@ proof- next case (iLam xs t) then show ?case using iiLam - by simp (metis bij_o iterm.rrename_comps iterm_pre.supp_comp_bound) + by simp (metis bij_o iterm.permute_comp iterm_pre.supp_comp_bound) qed thus ?thesis apply(elim allE[of _ id]) by auto qed @@ -1391,7 +1371,7 @@ next have t1': "t1' = irrename (inv f1' o f1) t" using f1f1' by (metis (mono_tags, lifting) bij_imp_bij_inv f1(1,2) f1'(1,2) - inv_o_simp1 supp_inv_bound iterm.rrename_comps iterm.rrename_ids) + inv_o_simp1 supp_inv_bound iterm.permute_comp iterm.permute_id) have fvb1': "FVarsB b1' \ FFVars t1'" using iLam2[OF if1', unfolded t1'[symmetric], OF 1(1)] . @@ -1413,7 +1393,7 @@ next have t2': "t2' = irrename (inv f2' o f2) t" using f2f2' by (metis (mono_tags, lifting) bij_imp_bij_inv f2(1,2) f2'(1,2) - inv_o_simp1 iterm.rrename_comps iterm.rrename_ids supp_inv_bound) + inv_o_simp1 iterm.permute_comp iterm.permute_id supp_inv_bound) have fvb2': "FVarsB b2' \ FFVars t2'" using iLam2[OF if2', unfolded t2'[symmetric], OF 2(1)] . @@ -1473,7 +1453,7 @@ next have rew2: "irrename ff2' (irrename (inv f2' \ f2) t) = irrename f1 t" by (smt (verit, best) bij_betw_comp_iff bij_is_inj f1(1) f1(2) f2'(1) f2'(2) f2(1) f2(2) f2f2' - ff2'_def if2(2) iterm.rrename_comps iterm.supp_comp_bound o_inv_o_cancel t2') + ff2'_def if2(2) iterm.permute_comp iterm.supp_comp_bound o_inv_o_cancel t2') show "b1 = b2" unfolding 1(3) 2(3) apply(rule iLamB_inject_strong'_rev[OF b12', of zs f1' _ ff2']) diff --git a/thys/Infinitary_Lambda_Calculus/ILC_Beta.thy b/thys/Infinitary_Lambda_Calculus/ILC_Beta.thy index 0bc49596..8c0c7bda 100644 --- a/thys/Infinitary_Lambda_Calculus/ILC_Beta.thy +++ b/thys/Infinitary_Lambda_Calculus/ILC_Beta.thy @@ -13,7 +13,7 @@ abbreviation Tsupp :: "itrm \ itrm \ ivar set" where lemma small_Tsupp: "small (Tsupp t1 t2)" unfolding small_def - by (auto intro!: var_iterm_pre_class.Un_bound iterm.card_of_FFVars_bounds) + by (auto intro!: var_iterm_pre_class.Un_bound iterm.set_bd_UNIV) lemma Tvars_dsset: "(Tsupp t1 t2 - dsset xs) \ dsset xs = {}" "|Tsupp t1 t2 - dsset xs| xs"]) apply(rule exI[of _ "irrename \ e1"]) apply(rule exI[of _ "smap (irrename \) es2"]) - apply (simp add: iterm.rrename_comps) apply(subst irrename_itvsubst_comp) apply auto + apply (simp add: iterm.permute_comp) apply(subst irrename_itvsubst_comp) apply auto apply(subst imkSubst_smap_irrename_inv) unfolding isPerm_def apply auto apply(subst irrename_eq_itvsubst_iVar'[of _ e1]) unfolding isPerm_def apply auto apply(subst itvsubst_comp) @@ -47,19 +47,19 @@ binder_inductive istep subgoal for e1 e1' es2 apply(rule exI[of _ "irrename \ e1"]) apply(rule exI[of _ "irrename \ e1'"]) apply(rule exI[of _ "smap (irrename \) es2"]) - by (simp add: iterm.rrename_comps) + by (simp add: iterm.permute_comp) (* *) subgoal for es2 i e2' e1 apply(rule exI[of _ "smap (irrename \) es2"]) apply(rule exI[of _ i]) apply(rule exI[of _ "irrename \ e2'"]) apply(rule exI[of _ "irrename \ e1"]) - apply (simp add: iterm.rrename_comps) . + apply (simp add: iterm.permute_comp) . (* *) subgoal for e e' xs apply(rule exI[of _ "irrename \ e"]) apply(rule exI[of _ "irrename \ e'"]) apply(rule exI[of _ "dsmap \ xs"]) - by (simp add: iterm.rrename_comps) . + by (simp add: iterm.permute_comp) . subgoal premises prems for R B x1 x2 using prems(2-) apply safe subgoal for xs e1 es2 diff --git a/thys/Infinitary_Lambda_Calculus/ILC_Head_Reduction.thy b/thys/Infinitary_Lambda_Calculus/ILC_Head_Reduction.thy index c487cb56..2f96363f 100644 --- a/thys/Infinitary_Lambda_Calculus/ILC_Head_Reduction.thy +++ b/thys/Infinitary_Lambda_Calculus/ILC_Head_Reduction.thy @@ -12,7 +12,7 @@ unfolding hred_def apply(elim exE) subgoal for xs e1 es2 apply(rule exI[of _ "dsmap \ xs"]) apply(rule exI[of _ "irrename \ e1"]) apply(rule exI[of _ "smap (irrename \) es2"]) - apply (simp add: iterm.rrename_comps) apply(subst irrename_itvsubst_comp) apply auto + apply (simp add: iterm.permute_comp) apply(subst irrename_itvsubst_comp) apply auto apply(subst imkSubst_smap_irrename_inv) unfolding isPerm_def apply auto apply(subst irrename_eq_itvsubst_iVar'[of _ e1]) unfolding isPerm_def apply auto apply(subst itvsubst_comp) diff --git a/thys/Infinitary_Lambda_Calculus/ILC_Renaming_Equivalence.thy b/thys/Infinitary_Lambda_Calculus/ILC_Renaming_Equivalence.thy index 70365c57..47380667 100644 --- a/thys/Infinitary_Lambda_Calculus/ILC_Renaming_Equivalence.thy +++ b/thys/Infinitary_Lambda_Calculus/ILC_Renaming_Equivalence.thy @@ -61,9 +61,9 @@ interpretation CComponents where Tperm = Tperm and Tsupp = Tsupp and Bperm = Bperm and Bsupp = Bsupp and bnd = bnd and bsmall = bsmall apply standard unfolding isPerm_def Tperm_def -using iterm.card_of_FFVars_bounds -apply (auto simp: iterm.rrename_id0s map_prod.comp -iterm.rrename_comp0s infinite_UNIV bsmall_def intro!: ext small_Un split: option.splits) +using iterm.set_bd_UNIV +apply (auto simp: iterm.permute_id0 map_prod.comp +iterm.permute_comp0 infinite_UNIV bsmall_def intro!: ext small_Un split: option.splits) apply (simp add: iterm.set_bd_UNIV small_def) apply (simp add: iterm.set_bd_UNIV small_def) apply (simp add: comp_def dstream.map_comp) @@ -116,15 +116,15 @@ unfolding G_def apply(elim disjE) apply(rule exI[of _ "irrename \ e"]) apply(rule exI[of _ "irrename \ e'"]) apply(cases t) unfolding isPerm_def small_def Tperm_def presBnd_def - apply (simp add: iterm.rrename_comps) by (metis option.simps(5)) . . + apply (simp add: iterm.permute_comp) by (metis option.simps(5)) . . (* *) subgoal apply(rule disjI3_3) subgoal apply(elim exE) subgoal for e1 e1' es2 es2' apply(rule exI[of _ "irrename \ e1"]) apply(rule exI[of _ "irrename \ e1'"]) apply(rule exI[of _ "smap (irrename \) es2"]) apply(rule exI[of _ "smap (irrename \) es2'"]) apply(cases t) unfolding isPerm_def small_def Tperm_def - apply (simp add: iterm.rrename_comps) - by (metis image_in_bij_eq iterm.rrename_bijs iterm.rrename_inv_simps) . . . + apply (simp add: iterm.permute_comp) + by (metis image_in_bij_eq iterm.permute_bij iterm.permute_inv_simp) . . . diff --git a/thys/Infinitary_Lambda_Calculus/ILC_UBeta_depth.thy b/thys/Infinitary_Lambda_Calculus/ILC_UBeta_depth.thy index af400c4e..0dbbb2d6 100644 --- a/thys/Infinitary_Lambda_Calculus/ILC_UBeta_depth.thy +++ b/thys/Infinitary_Lambda_Calculus/ILC_UBeta_depth.thy @@ -94,11 +94,11 @@ interpretation CComponents where Tperm = Tperm and Tsupp = Tsupp and Bperm = Bperm and Bsupp = Bsupp and bnd = bnd and bsmall = bsmall apply standard unfolding isPerm_def Tperm_def - using iterm.card_of_FFVars_bounds dsset_card_ls + using iterm.set_bd_UNIV dsset_card_ls apply (auto simp: dstream_map_ident_strong small_def - dstream.map_comp iterm.rrename_id0s map_prod.comp iterm.rrename_comp0s infinite_UNIV fun_eq_iff stream.map_comp + dstream.map_comp iterm.permute_id0 map_prod.comp iterm.permute_comp0 infinite_UNIV fun_eq_iff stream.map_comp intro!: var_sum_class.UN_bound var_sum_class.Un_bound -stream.map_ident_strong iterm.rrename_cong_ids split: option.splits) +stream.map_ident_strong iterm.permute_cong_id split: option.splits) apply auto unfolding bsmall_def touchedSuper_def apply(frule super_dsset_singl) apply auto using super_Un_ddset_triv @@ -134,7 +134,7 @@ where lemma G_mmono: "R \ R' \ G xxs R t \ G xxs R' t" unfolding G_def by fastforce -declare iterm.rrename_id0s[simp] +declare iterm.permute_id0[simp] lemma smap2_smap: "smap2 f (smap g xs) (smap h ys) = smap2 (\x y. f (g x) (h y)) xs ys" by (simp add: smap2_alt) @@ -159,7 +159,7 @@ unfolding G_def apply(elim disjE) apply(rule exI[of _ "smap (irrename \) es"]) apply(rule exI[of _ "smap (irrename \) es'"]) apply(cases t) unfolding isPerm_def small_def Tperm_def presBnd_presSuper - apply (simp add: iterm.rrename_comps uniformS_irrename) unfolding stream_all2_iff_snth + apply (simp add: iterm.permute_comp uniformS_irrename) unfolding stream_all2_iff_snth using hred_irrename by auto . . (* *) subgoal apply(rule disjI4_2) @@ -168,7 +168,7 @@ unfolding G_def apply(elim disjE) apply(rule exI[of _ "smap (irrename \) es"]) apply(rule exI[of _ "smap (irrename \) es'"]) apply(rule exI[of _ "smap (smap (irrename \)) ess"]) apply(cases t) unfolding isPerm_def small_def Tperm_def presBnd_presSuper - apply (simp add: iterm.rrename_comp0s stream.map_comp smap2_smap uniformS_irrename + apply (simp add: iterm.permute_comp0 stream.map_comp smap2_smap uniformS_irrename uniformS_sflat irrename_reneqv) . . . (* *) subgoal apply(rule disjI4_3) @@ -178,8 +178,8 @@ unfolding G_def apply(elim disjE) apply(rule exI[of _ "smap (smap (irrename \)) ess"]) apply(rule exI[of _ "smap (smap (irrename \)) ess'"]) apply(cases t) unfolding isPerm_def small_def Tperm_def - apply (simp add: iterm.rrename_comp0s stream.map_comp smap2_smap smap_sflat) - by (metis ILC_Renaming_Equivalence.presBnd_presSuper id_apply inv_o_simp1 iterm.rrename_bijs iterm.rrename_inv_simps smap_sflat stream.map_comp stream.map_id0 uniformS_irrename) + apply (simp add: iterm.permute_comp0 stream.map_comp smap2_smap smap_sflat) + by (metis ILC_Renaming_Equivalence.presBnd_presSuper id_apply inv_o_simp1 iterm.permute_bij iterm.permute_inv_simp smap_sflat stream.map_comp stream.map_id0 uniformS_irrename) . . (* *) subgoal apply(rule disjI4_4) @@ -188,7 +188,7 @@ unfolding G_def apply(elim disjE) apply(rule exI[of _ d]) apply(rule exI[of _ "smap (irrename \) es"]) apply(rule exI[of _ "smap (irrename \) es'"]) apply(cases t) unfolding isPerm_def small_def Tperm_def - apply (simp add: iterm.rrename_comp0s stream.map_comp smap2_smap) + apply (simp add: iterm.permute_comp0 stream.map_comp smap2_smap) by (metis (no_types, lifting) comp_apply iterm.permute(3) presSuper_def stream.map_cong presBnd_presSuper) . . . diff --git a/thys/Infinitary_Lambda_Calculus/ILC_affine.thy b/thys/Infinitary_Lambda_Calculus/ILC_affine.thy index 63e3f719..f6972486 100644 --- a/thys/Infinitary_Lambda_Calculus/ILC_affine.thy +++ b/thys/Infinitary_Lambda_Calculus/ILC_affine.thy @@ -37,7 +37,7 @@ binder_inductive affine subgoal apply(elim exE) subgoal for e xs apply(rule exI[of _ "irrename \ e"]) apply(rule exI[of _ "dsmap \ xs"]) - apply (simp add: iterm.rrename_comps) + apply (simp add: iterm.permute_comp) done done done @@ -46,7 +46,7 @@ binder_inductive affine subgoal apply(elim exE) subgoal for e1 es2 apply(rule exI[of _ "irrename \ e1"]) apply(rule exI[of _ "smap (irrename \) es2"]) - apply (fastforce simp add: iterm.rrename_comps) + apply (fastforce simp add: iterm.permute_comp) done done done diff --git a/thys/Infinitary_Lambda_Calculus/ILC_good.thy b/thys/Infinitary_Lambda_Calculus/ILC_good.thy index b5d2064c..67de95a0 100644 --- a/thys/Infinitary_Lambda_Calculus/ILC_good.thy +++ b/thys/Infinitary_Lambda_Calculus/ILC_good.thy @@ -56,9 +56,9 @@ interpretation CComponents where Tperm = Tperm and Tsupp = Tsupp and Bperm = Bperm and Bsupp = Bsupp and bnd = bnd and bsmall = bsmall apply standard unfolding isPerm_def Tperm_def -using iterm.card_of_FFVars_bounds -apply (auto simp: iterm.rrename_id0s map_prod.comp -iterm.rrename_comp0s infinite_UNIV bsmall_def intro!: ext small_Un split: option.splits) +using iterm.set_bd_UNIV +apply (auto simp: iterm.permute_id0 map_prod.comp +iterm.permute_comp0 infinite_UNIV bsmall_def intro!: ext small_Un split: option.splits) apply (simp add: iterm.set_bd_UNIV small_def) apply (simp add: comp_def dstream.map_comp) apply (simp add: dstream_map_ident_strong) @@ -110,15 +110,15 @@ unfolding G_def apply(elim disjE) apply(rule exI[of _ "dsmap \ xs"]) apply(rule exI[of _ "irrename \ e"]) unfolding isPerm_def small_def Tperm_def presBnd_def - apply (simp add: iterm.rrename_comps) by (metis option.simps(5)) . . + apply (simp add: iterm.permute_comp) by (metis option.simps(5)) . . (* *) subgoal apply(rule disjI3_3) subgoal apply(elim exE) subgoal for e1 es2 apply(rule exI[of _ "irrename \ e1"]) apply(rule exI[of _ "smap (irrename \) es2"]) unfolding isPerm_def small_def Tperm_def presBnd_presSuper - apply (simp add: iterm.rrename_comps image_def) - by (metis inv_simp1 iterm.rrename_bijs iterm.rrename_inv_simps touchedSuperT_irrename) . . . + apply (simp add: iterm.permute_comp image_def) + by (metis inv_simp1 iterm.permute_bij iterm.permute_inv_simp touchedSuperT_irrename) . . . (* *) diff --git a/thys/Infinitary_Lambda_Calculus/PrettyPrinting.thy b/thys/Infinitary_Lambda_Calculus/PrettyPrinting.thy index a110ed4b..58c72568 100644 --- a/thys/Infinitary_Lambda_Calculus/PrettyPrinting.thy +++ b/thys/Infinitary_Lambda_Calculus/PrettyPrinting.thy @@ -113,7 +113,7 @@ interpretation CComponents where Tperm = Tperm and Tsupp = Tsupp and Bperm = Bperm and Bsupp = Bsupp and bnd = bnd and bsmall = bsmall apply standard unfolding isPerm_def Tperm_def apply auto - subgoal apply(rule ext) by (auto simp add: term.rrename_comps image_def) + subgoal apply(rule ext) by (auto simp add: term.permute_comp image_def) subgoal by (simp add: Un_bound finite_Vars infinite_var small_def term.set_bd_UNIV) subgoal by (simp add: rrrename_cong) subgoal apply(rule ext) using image_iff by fastforce @@ -184,14 +184,14 @@ unfolding G_def apply(drule presBnd_imp) apply(elim disjE) apply(rule exI[of _ "rrrename \ S"]) apply(cases tt) unfolding isPerm_def small_def Tperm_def by simp (metis comp_apply id_apply inv_o_simp1 rrrename_id rrrename_o - term.rrename_bijs term.rrename_inv_simps) . . + term.permute_bij term.permute_inv_simp) . . (* *) subgoal apply(rule disjI3_3) subgoal apply(elim exE) subgoal for y x t T apply(rule exI[of _ "\ y"]) apply(rule exI[of _ "\ x"]) apply(rule exI[of _ "rrename \ t"]) apply(rule exI[of _ "rrrename \ T"]) apply(cases tt) unfolding isPerm_def small_def Tperm_def apply simp - by (metis comp_apply id_apply imageI inv_o_simp1 not_imageI rrrename_id rrrename_o subsetD term.rrename_bijs term.rrename_inv_simps) + by (metis comp_apply id_apply imageI inv_o_simp1 not_imageI rrrename_id rrrename_o subsetD term.permute_bij term.permute_inv_simp) . . . diff --git a/thys/Infinitary_Lambda_Calculus/Super_Recursor.thy b/thys/Infinitary_Lambda_Calculus/Super_Recursor.thy index f494f019..7672292b 100644 --- a/thys/Infinitary_Lambda_Calculus/Super_Recursor.thy +++ b/thys/Infinitary_Lambda_Calculus/Super_Recursor.thy @@ -108,7 +108,7 @@ proof- next case (iLam xs t) then show ?case using iiLam - by simp (smt (verit) bij_o bsmall_supp_comp irrename_good iterm.rrename_comps iterm_pre.supp_comp_bound + by simp (smt (verit) bij_o bsmall_supp_comp irrename_good iterm.permute_comp iterm_pre.supp_comp_bound presSuper_comp presSuper_def) qed thus ?thesis apply(elim allE[of _ id]) by auto @@ -468,7 +468,7 @@ next have t1': "t1' = irrename (inv f1' o f1) t" using f1f1' by (metis (mono_tags, lifting) bij_imp_bij_inv f1(1,2) f1'(1,2) - inv_o_simp1 supp_inv_bound iterm.rrename_comps iterm.rrename_ids) + inv_o_simp1 supp_inv_bound iterm.permute_comp iterm.permute_id) have ps1: "presSuper (inv f1' \ f1)" "bsmall (supp (inv f1' \ f1))" subgoal by (simp add: f1'(1) f1'(2) f1'(3) f1(1) f1(2) f1(3) presSuper_comp presSuper_inv) @@ -500,7 +500,7 @@ next have t2': "t2' = irrename (inv f2' o f2) t" using f2f2' by (metis (mono_tags, lifting) bij_imp_bij_inv f2(1,2) f2'(1,2) - inv_o_simp1 iterm.rrename_comps iterm.rrename_ids supp_inv_bound) + inv_o_simp1 iterm.permute_comp iterm.permute_id supp_inv_bound) have ps2: "presSuper (inv f2' \ f2)" "bsmall (supp (inv f2' \ f2))" subgoal by (simp add: f2'(1-3) f2(1-3) presSuper_comp presSuper_inv) @@ -569,7 +569,7 @@ next have rew2: "irrename ff2' (irrename (inv f2' \ f2) t) = irrename f1 t" by (smt (verit, best) bij_betw_comp_iff bij_is_inj f1(1) f1(2) f2'(1) f2'(2) f2(1) f2(2) f2f2' - ff2'_def if2(2) iterm.rrename_comps iterm.supp_comp_bound o_inv_o_cancel t2') + ff2'_def if2(2) iterm.permute_comp iterm.supp_comp_bound o_inv_o_cancel t2') show "b1 = b2" unfolding 1(3) 2(3) apply(rule iLamB_inject_super_strong'_rev[OF b12', of xs1' xs2' zs f1' ff2']) diff --git a/thys/Infinitary_Lambda_Calculus/Supervariables.thy b/thys/Infinitary_Lambda_Calculus/Supervariables.thy index 06a775a3..f7d638d8 100644 --- a/thys/Infinitary_Lambda_Calculus/Supervariables.thy +++ b/thys/Infinitary_Lambda_Calculus/Supervariables.thy @@ -468,7 +468,7 @@ next subgoal using f by auto . show ?thesis using extend_super2[OF super 0] apply safe subgoal for g apply(rule exI[of _ g]) using f unfolding A eq_on_def id_on_def - by simp (metis dstream.map_cong irrename_cong) . + by simp (metis dstream.map_cong iterm.permute_cong) . qed diff --git a/thys/Infinitary_Lambda_Calculus/Translation_ILC_to_LC.thy b/thys/Infinitary_Lambda_Calculus/Translation_ILC_to_LC.thy index 8166d963..f4d7151e 100644 --- a/thys/Infinitary_Lambda_Calculus/Translation_ILC_to_LC.thy +++ b/thys/Infinitary_Lambda_Calculus/Translation_ILC_to_LC.thy @@ -96,21 +96,21 @@ lemma renB_comp: "bij \ \ |supp \| \ |supp \| bsmall (supp \) \ presSuper \ \ b \ B \ renB (\ o \) b = renB \ (renB \ b)" unfolding renB_def apply(subst restr_comp) - by (auto simp add: bij_restr card_supp_restr term.rrename_comps) + by (auto simp add: bij_restr card_supp_restr term.permute_comp) lemma renB_cong: "bij \ \ |supp \| bsmall (supp \) \ presSuper \ \ (\xs \ touchedSuper (FVarsB b). dsmap \ xs = xs) \ renB \ b = b" -unfolding renB_def FVarsB_def apply(rule term.rrename_cong_ids) +unfolding renB_def FVarsB_def apply(rule term.permute_cong_id) by (auto simp: bij_restr card_supp_restr restr_def touchedSuper_UN intro: restr_cong_id) lemma renB_FVarsB: "bij \ \ |supp \| bsmall (supp \) \ presSuper \ \ x \ FVarsB (renB \ b) \ inv \ x \ FVarsB b" unfolding renB_def FVarsB_def apply safe subgoal by simp (metis (no_types, lifting) bij_restr card_supp_restr dstream.set_map image_in_bij_eq inv_simp2 - presSuper_def restr_def superOf_subOf super_superOf term.FFVars_rrenames) + presSuper_def restr_def superOf_subOf super_superOf term.FVars_permute) subgoal by simp (metis bij_restr card_supp_restr dstream.set_map image_in_bij_eq inv_simp1 presSuper_def - restr_def superOf_subOf super_superOf term.FFVars_rrenames) . + restr_def superOf_subOf super_superOf term.FVars_permute) . lemma renB_iVarB[simp]: "bij \ \ |supp \| bsmall (supp \) \ presSuper \ \ super xs \ x \ dsset xs \ diff --git a/thys/Infinitary_Lambda_Calculus/Translation_LC_to_ILC.thy b/thys/Infinitary_Lambda_Calculus/Translation_LC_to_ILC.thy index 17803c49..f1222b0a 100644 --- a/thys/Infinitary_Lambda_Calculus/Translation_LC_to_ILC.thy +++ b/thys/Infinitary_Lambda_Calculus/Translation_LC_to_ILC.thy @@ -137,13 +137,13 @@ unfolding renB_def B_def fun_eq_iff by auto lemma renB_comp: "bij \ \ |supp \| bij \ \ |supp \| b \ B \ renB (\ o \) b = renB \ (renB \ b)" unfolding renB_def B_def fun_eq_iff -by (simp add: bij_ext card_supp_ext ext_comp iterm.rrename_comps) +by (simp add: bij_ext card_supp_ext ext_comp iterm.permute_comp) lemma renB_cong: "bij \ \ |supp \| (\x \ FVarsB b. \ x = x) \ renB \ b = b" unfolding renB_def B_def fun_eq_iff FVarsB_def apply safe -apply(rule iterm.rrename_cong_ids) +apply(rule iterm.permute_cong_id) subgoal using bij_ext by auto subgoal using card_supp_ext by auto subgoal apply(rule ext_id_cong) @@ -158,7 +158,7 @@ unfolding FVarsB_def renB_def apply (auto simp: image_def) subgoal apply(rule exI[of _ "{y. \x\touchedSuper (ILC.FFVars (b p)). y = subOf x}"]) apply auto apply(rule bexI[of _ "superOf (inv \ (subOf xs))"]) apply auto - apply(subst (asm) iterm.FFVars_rrenames) + apply(subst (asm) iterm.FVars_permute) subgoal using bij_ext by auto subgoal using card_supp_ext by auto subgoal unfolding touchedSuper_def @@ -172,7 +172,7 @@ unfolding FVarsB_def renB_def apply (auto simp: image_def) subgoal unfolding touchedSuper_def by simp (smt (verit, best) Int_emptyD bij_betw_inv_into bij_ext card_supp_ext dsmap_ext_superOf dstream.set_map ext_inv image_Int_empty inv_simp2 - iterm.FFVars_rrenames superOf_subOf) . . + iterm.FVars_permute superOf_subOf) . . lemma renB_VarB: "bij \ \ |supp \| renB \ (VarB x) = VarB (\ x)" unfolding renB_def VarB_def fun_eq_iff diff --git a/thys/MRBNF_FP.thy b/thys/MRBNF_FP.thy index b9b074c4..f04f467f 100644 --- a/thys/MRBNF_FP.thy +++ b/thys/MRBNF_FP.thy @@ -2,11 +2,6 @@ theory MRBNF_FP imports "MRBNF_Composition" begin -lemma card_of_subset_bound: "\ B \ A ; |A| \ |B| |A - B| o |UNIV::'b set|" "|U \ S::'b set| B. U \ B = {} \ B \ S = {} \ |U| =o |B|" @@ -118,10 +113,13 @@ lemmas exists_bij_betw_refl_def = exists_bij_betw_refl[unfolded eq_bij_betw_refl lemma imsupp_id_on: "imsupp u \ A = {} \ id_on A u" unfolding imsupp_def supp_def id_on_def by blast +lemma supp_id_on: "supp u \ A = {} \ id_on A u" + unfolding supp_def id_on_def by blast lemma imsupp_image_subset: "u ` A \ A = {} \ A \ imsupp u" unfolding imsupp_def supp_def by auto +lemma Int_subset_empty: "A \ B = {} \ C \ A \ D \ B \ C \ D = {}" by blast lemma Int_subset_empty1: "A \ B = {} \ C \ A \ C \ B = {}" by blast lemma Int_subset_empty2: "A \ B = {} \ C \ B \ A \ C = {}" by blast lemma exists_map_prod_id: "(a, b) \ map_prod f id ` A \ \c. (c, b) \ A \ a = f c" by auto @@ -185,7 +183,7 @@ lemma not_in_imsupp_same: "z \ imsupp f \ f z = z" unfolding imsupp_def supp_def by blast lemma not_in_imsupp_same2: "z \ imsupp f \ imsupp g \ f z = g z" using not_in_imsupp_same by (metis UnCI) -lemma Diff_image_not_in_imsupp: "(\x. x \ B \ x \ imsupp f) \ f ` A - B = f ` (A - B)" +lemma Diff_image_not_in_imsupp: "B \ imsupp f = {} \ f ` A - B = f ` (A - B)" unfolding supp_def imsupp_def by fastforce lemma ball_not_eq_imsupp: "x \ B \ x \ A \ (\x. x \ B \ x \ imsupp f) \ \xa\A. x \ f xa" unfolding imsupp_def supp_def by fastforce @@ -332,7 +330,15 @@ lemma large_imp_infinite: "natLeq \o |UNIV::'a set| \ infini lemma insert_bound: "infinite (UNIV::'a set) \ |insert x A| |A| ../Tools/mrbnf_fp_tactics.ML\ +lemma id_on_comp: "id_on A f \ id_on A g \ id_on A (f \ g)" + unfolding id_on_def by simp + +lemma id_on_image_same: "id_on A f \ id_on (f ` A) f" + unfolding id_on_def by simp + +lemma rel_refl_eq: "(\x. R x x) \ x = y \ R x y" + by auto + ML_file \../Tools/mrbnf_fp_def_sugar.ML\ ML_file \../Tools/mrbnf_fp.ML\ @@ -356,7 +362,7 @@ in fun refreshability_tac verbose supps renames instss G_thm eqvt_thm extend_thms small_thms simp_thms intro_thms elim_thms ctxt = let val n = length supps; - fun case_tac NONE _ prems ctxt = HEADGOAL (Method.insert_tac ctxt prems THEN' + fun case_tac NONE _ prems ctxt = HEADGOAL (Method.insert_tac ctxt prems THEN' K (if verbose then print_tac ctxt "pre_simple_auto" else all_tac)) THEN SOLVE (auto_tac ctxt) | case_tac (SOME insts) params prems ctxt = let @@ -402,13 +408,14 @@ val _ = extra_assms |> map (Thm.pretty_thm ctxt #> verbose ? @{print tracing}); addSIs (ex_f :: id_onI @ intro_thms) addSEs elim_thms) 0 10) THEN_ALL_NEW (SELECT_GOAL (print_tac ctxt "auto failed"))) end; - val small_ctxt = ctxt addsimps small_thms; + val small_ctxt = ctxt addsimps small_thms addIs small_thms; in HEADGOAL (rtac ctxt (fresh RS exE) THEN' SELECT_GOAL (auto_tac (small_ctxt addsimps [hd defs])) THEN' REPEAT_DETERM_N 2 o (asm_simp_tac small_ctxt) THEN' SELECT_GOAL (unfold_tac ctxt @{thms Int_Un_distrib Un_empty}) THEN' REPEAT_DETERM o etac ctxt conjE THEN' + (if verbose then K (print_tac ctxt "pre_case_inner_tac") else K all_tac) THEN' Subgoal.SUBPROOF (fn focus => case_inner_tac (#params focus) (#prems focus) (#context focus)) ctxt) end; diff --git a/thys/POPLmark/POPLmark_1A.thy b/thys/POPLmark/POPLmark_1A.thy index f7911238..a3fd59a8 100644 --- a/thys/POPLmark/POPLmark_1A.thy +++ b/thys/POPLmark/POPLmark_1A.thy @@ -92,13 +92,13 @@ lemma SA_AllE1[consumes 2, case_names SA_Trans_TVar SA_All]: shows "R \ (\X<:S\<^sub>1. S\<^sub>2) T" using assms(1,2) proof (binder_induction \ "\X<:S\<^sub>1. S\<^sub>2" T avoiding: \ "\X<:S\<^sub>1. S\<^sub>2" T rule: ty.strong_induct) case (SA_All \ T\<^sub>1 R\<^sub>1 Y R\<^sub>2 T\<^sub>2) - have 1: "\Y<:T\<^sub>1 . T\<^sub>2 = \X<:T\<^sub>1. rrename_typ (id(Y:=X,X:=Y)) T\<^sub>2" + have 1: "\Y<:T\<^sub>1 . T\<^sub>2 = \X<:T\<^sub>1. permute_typ (id(Y:=X,X:=Y)) T\<^sub>2" apply (rule Forall_swap) using SA_All(6,9) well_scoped(2) by fastforce - have fresh: "X \ FFVars_typ T\<^sub>1" + have fresh: "X \ FVars_typ T\<^sub>1" by (meson SA_All(4,9) in_mono well_scoped(1)) have same: "R\<^sub>1 = S\<^sub>1" using SA_All(8) typ_inject(3) by blast - have x: "\Y<:S\<^sub>1. R\<^sub>2 = \X<:S\<^sub>1. rrename_typ (id(Y:=X,X:=Y)) R\<^sub>2" + have x: "\Y<:S\<^sub>1. R\<^sub>2 = \X<:S\<^sub>1. permute_typ (id(Y:=X,X:=Y)) R\<^sub>2" apply (rule Forall_swap) by (metis (no_types, lifting) SA_All(8) assms(1,2) in_mono sup.bounded_iff typ.set(4) well_scoped(1)) show ?case unfolding 1 @@ -125,17 +125,17 @@ lemma SA_AllE2[consumes 2, case_names SA_Trans_TVar SA_All]: shows "R \ S (\X<:T\<^sub>1. T\<^sub>2)" using assms(1,2) proof (binder_induction \ S "\X<:T\<^sub>1. T\<^sub>2" avoiding: \ S "\X<:T\<^sub>1. T\<^sub>2" rule: ty.strong_induct) case (SA_All \ R\<^sub>1 S\<^sub>1 Y S\<^sub>2 R\<^sub>2) - have 1: "\Y<:S\<^sub>1. S\<^sub>2 = \X<:S\<^sub>1. rrename_typ (id(Y:=X,X:=Y)) S\<^sub>2" + have 1: "\Y<:S\<^sub>1. S\<^sub>2 = \X<:S\<^sub>1. permute_typ (id(Y:=X,X:=Y)) S\<^sub>2" apply (rule Forall_swap) using SA_All(6,9) well_scoped(1) by fastforce have fresh: "X \ dom \" "Y \ dom \" using SA_All(9) apply blast by (metis SA_All(6) fst_conv wf_ConsE wf_context) - have fresh2: "X \ FFVars_typ T\<^sub>1" "Y \ FFVars_typ T\<^sub>1" + have fresh2: "X \ FVars_typ T\<^sub>1" "Y \ FVars_typ T\<^sub>1" apply (metis SA_All(4,8) in_mono fresh(1) typ_inject(3) well_scoped(1)) by (metis SA_All(4,8) in_mono fresh(2) typ_inject(3) well_scoped(1)) have same: "R\<^sub>1 = T\<^sub>1" using SA_All(8) typ_inject(3) by blast - have x: "\Y<:T\<^sub>1 . R\<^sub>2 = \X<:T\<^sub>1. rrename_typ (id(Y:=X,X:=Y)) R\<^sub>2" + have x: "\Y<:T\<^sub>1 . R\<^sub>2 = \X<:T\<^sub>1. permute_typ (id(Y:=X,X:=Y)) R\<^sub>2" apply (rule Forall_swap) by (metis SA_All(8) Un_iff assms(1,2) in_mono typ.set(4) well_scoped(2)) show ?case unfolding 1 @@ -151,7 +151,7 @@ using assms(1,2) proof (binder_induction \ S "\X<:T\<^sub>1. T\<^ apply (rule arg_cong3[of _ _ _ _ _ _ extend]) using fresh apply (metis bij_swap SA_All(4) Un_iff context_map_cong_id fun_upd_apply id_apply infinite_var supp_swap_bound wf_FFVars wf_context) apply simp - using fresh2 unfolding same apply (metis bij_swap fun_upd_apply id_apply infinite_var supp_swap_bound typ.rrename_cong_ids) + using fresh2 unfolding same apply (metis bij_swap fun_upd_apply id_apply infinite_var supp_swap_bound typ.permute_cong_id) using SA_All(8) x Forall_inject_same unfolding same by simp qed (auto simp: TyVar) diff --git a/thys/POPLmark/SystemFSub.thy b/thys/POPLmark/SystemFSub.thy index 8e78562d..537c42fb 100644 --- a/thys/POPLmark/SystemFSub.thy +++ b/thys/POPLmark/SystemFSub.thy @@ -24,44 +24,13 @@ instance var :: var_typ_pre apply standard by (auto simp add: regularCard_var) declare supp_swap_bound[OF cinfinite_imp_infinite[OF typ.UNIV_cinfinite], simp] -declare typ.rrename_ids[simp] typ.rrename_id0s[simp] - -lemma rrename_typ_simps[simp]: - fixes f::"'a::var_typ_pre \ 'a" - assumes "bij f" "|supp f| x = y" "Fun T1 T2 = Fun R1 R2 \ T1 = R1 \ T2 = R2" - "Forall x T1 T2 = Forall y R1 R2 \ T1 = R1 \ (\f. bij (f::'a::var_typ_pre \ 'a) \ |supp f| id_on (FFVars_typ T2 - {x}) f \ f x = y \ rrename_typ f T2 = R2)" - apply (unfold TyVar_def Fun_def Forall_def typ.TT_injects0 + "Forall x T1 T2 = Forall y R1 R2 \ T1 = R1 \ (\f. bij (f::'a::var_typ_pre \ 'a) \ |supp f| id_on (FVars_typ T2 - {x}) f \ f x = y \ permute_typ f T2 = R2)" + apply (unfold TyVar_def Fun_def Forall_def typ.TT_inject0 set3_typ_pre_def comp_def Abs_typ_pre_inverse[OF UNIV_I] map_sum.simps sum_set_simps cSup_singleton Un_empty_left Un_empty_right Union_empty image_empty empty_Diff map_typ_pre_def prod.map_id set2_typ_pre_def prod_set_simps prod.set_map UN_single Abs_typ_pre_inject[OF UNIV_I UNIV_I] @@ -71,14 +40,14 @@ lemma typ_inject: declare typ_inject(1,2)[simp] corollary Forall_inject_same[simp]: "Forall x T1 T2 = Forall x R1 R2 \ T1 = R1 \ T2 = R2" - using typ_inject(3) typ.rrename_cong_ids + using typ_inject(3) typ.permute_cong_id by (metis (no_types, lifting) Diff_empty Diff_insert0 id_on_insert insert_Diff) lemma Forall_rrename: assumes "bij \" "|supp \| a'. a'\FFVars_typ T2 - {x::'a::var_typ_pre} \ \ a' = a') \ Forall x T1 T2 = Forall (\ x) T1 (rrename_typ \ T2)" + (\a'. a'\FVars_typ T2 - {x::'a::var_typ_pre} \ \ a' = a') \ Forall x T1 T2 = Forall (\ x) T1 (permute_typ \ T2)" apply (unfold Forall_def) - apply (unfold typ.TT_injects0) + apply (unfold typ.TT_inject0) apply (unfold set3_typ_pre_def set2_typ_pre_def comp_def Abs_typ_pre_inverse[OF UNIV_I] map_sum.simps map_prod_simp sum_set_simps prod_set_simps cSup_singleton Un_empty_left Un_empty_right Union_empty image_insert image_empty map_typ_pre_def id_def) @@ -90,7 +59,7 @@ lemma Forall_rrename: apply (rule refl) done -lemma Forall_swap: "y \ FFVars_typ T2 - {x} \ Forall (x::'a::var_typ_pre) T1 T2 = Forall y T1 (rrename_typ (id(x:=y,y:=x)) T2)" +lemma Forall_swap: "y \ FVars_typ T2 - {x} \ Forall (x::'a::var_typ_pre) T1 T2 = Forall y T1 (permute_typ (id(x:=y,y:=x)) T2)" apply (rule trans) apply (rule Forall_rrename) apply (rule bij_swap[of x y]) @@ -103,10 +72,10 @@ type_synonym type = "var typ" type_synonym \\<^sub>\ = "(var \ type) list" definition map_context :: "(var \ var) \ \\<^sub>\ \ \\<^sub>\" where - "map_context f \ map (map_prod f (rrename_typ f))" + "map_context f \ map (map_prod f (permute_typ f))" abbreviation FFVars_ctxt :: "\\<^sub>\ \ var set" where - "FFVars_ctxt xs \ \(FFVars_typ ` snd ` set xs)" + "FFVars_ctxt xs \ \(FVars_typ ` snd ` set xs)" abbreviation extend :: "\\<^sub>\ \ var \ type \ \\<^sub>\" ("_ , _ <: _" [57,75,75] 71) where "extend \ x T \ (x, T)#\" abbreviation concat :: "\\<^sub>\ \ \\<^sub>\ \ \\<^sub>\" (infixl "(,)" 71) where @@ -123,7 +92,7 @@ lemma map_context_comp0[simp]: shows "map_context f \ map_context g = map_context (f \ g)" apply (rule ext) unfolding map_context_def - using assms by (auto simp: typ.rrename_comps) + using assms by (auto simp: typ.permute_comp) lemmas map_context_comp = trans[OF comp_apply[symmetric] fun_cong[OF map_context_comp0]] declare map_context_comp[simp] lemma context_dom_set[simp]: @@ -148,7 +117,7 @@ shows "map_context f \ = \" apply (rule list.map_cong0[of _ _ id]) apply (rule trans) apply (rule prod.map_cong0[of _ _ id _ id]) - using assms by (fastforce intro!: typ.rrename_cong_ids)+ + using assms by (fastforce intro!: typ.permute_cong_id)+ notation Fun (infixr "\" 65) notation Forall ("\ _ <: _ . _" [62, 62, 62] 70) @@ -156,7 +125,7 @@ notation Forall ("\ _ <: _ . _" [62, 62, 62] 70) abbreviation in_context :: "var \ type \ \\<^sub>\ \ bool" ("_ <: _ \ _" [55,55,55] 60) where "x <: t \ \ \ (x, t) \ set \" abbreviation well_scoped :: "type \ \\<^sub>\ \ bool" ("_ closed'_in _" [55, 55] 60) where - "well_scoped S \ \ FFVars_typ S \ dom \" + "well_scoped S \ \ FVars_typ S \ dom \" inductive wf_ty :: "\\<^sub>\ \ bool" ("\ _ ok" [70] 100) where wf_Nil[intro]: "\ [] ok" @@ -169,18 +138,18 @@ print_theorems lemma in_context_eqvt: assumes "bij f" "|supp f| \ \ f x <: rrename_typ f T \ map_context f \" + shows "x <: T \ \ \ f x <: permute_typ f T \ map_context f \" using assms unfolding map_context_def by auto lemma extend_eqvt: assumes "bij f" "|supp f| ,x<:T) = map_context f \,f x <: rrename_typ f T" + shows "map_context f (\,x<:T) = map_context f \,f x <: permute_typ f T" using assms unfolding map_context_def by simp lemma closed_in_eqvt: assumes "bij f" "|supp f| \ rrename_typ f S closed_in map_context f \" - using assms by (auto simp: typ.FFVars_rrenames) + shows "S closed_in \ \ permute_typ f S closed_in map_context f \" + using assms by (auto simp: typ.FVars_permute) lemma wf_eqvt: assumes "bij f" "|supp f| ) qed simp abbreviation Tsupp :: "\\<^sub>\ \ type \ type \ var set" where - "Tsupp \ T\<^sub>1 T\<^sub>2 \ dom \ \ FFVars_ctxt \ \ FFVars_typ T\<^sub>1 \ FFVars_typ T\<^sub>2" + "Tsupp \ T\<^sub>1 T\<^sub>2 \ dom \ \ FFVars_ctxt \ \ FVars_typ T\<^sub>1 \ FVars_typ T\<^sub>2" lemma small_Tsupp: "small (Tsupp x1 x2 x3)" - by (auto simp: small_def typ.card_of_FFVars_bounds typ.Un_bound var_typ_pre_class.UN_bound set_bd_UNIV typ.set_bd) + by (auto simp: small_def typ.set_bd_UNIV typ.Un_bound var_typ_pre_class.UN_bound set_bd_UNIV typ.set_bd) lemma fresh: "\xx. xx \ Tsupp x1 x2 x3" by (metis emp_bound equals0D imageI inf.commute inf_absorb2 small_Tsupp small_def small_isPerm subsetI) @@ -224,13 +193,13 @@ proof- thus ?thesis by auto qed -lemma rrename_swap_FFvars[simp]: "x \ FFVars_typ T \ xx \ FFVars_typ T \ - rrename_typ (id(x := xx, xx := x)) T = T" -apply(rule typ.rrename_cong_ids) by auto +lemma rrename_swap_FFvars[simp]: "x \ FVars_typ T \ xx \ FVars_typ T \ + permute_typ (id(x := xx, xx := x)) T = T" +apply(rule typ.permute_cong_id) by auto lemma map_context_swap_FFVars[simp]: -"\k\set \. x \ fst k \ x \ FFVars_typ (snd k) \ - xx \ fst k \ xx \ FFVars_typ (snd k) \ +"\k\set \. x \ fst k \ x \ FVars_typ (snd k) \ + xx \ fst k \ xx \ FVars_typ (snd k) \ map_context (id(x := xx, xx := x)) \ = \" unfolding map_context_def apply(rule map_idI) by auto @@ -273,25 +242,25 @@ next declare ty.intros[intro] -lemma ty_fresh_extend: "\, x <: U \ S <: T \ x \ dom \ \ FFVars_ctxt \ \ x \ FFVars_typ U" +lemma ty_fresh_extend: "\, x <: U \ S <: T \ x \ dom \ \ FFVars_ctxt \ \ x \ FVars_typ U" by (metis (no_types, lifting) UnE fst_conv snd_conv subsetD wf_ConsE wf_FFVars wf_context) binder_inductive ty subgoal for R B \ \ T1 T2 unfolding split_beta by (elim disj_forward exE) - (auto simp add: isPerm_def supp_inv_bound map_context_def[symmetric] typ_vvsubst_rrename - typ.rrename_comps typ.FFVars_rrenames wf_eqvt extend_eqvt + (auto simp add: isPerm_def supp_inv_bound map_context_def[symmetric] typ_vvsubst_permute + typ.permute_comp typ.FVars_permute wf_eqvt extend_eqvt | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl) - | ((rule exI[of _ "rrename_typ \ _"])+, (rule conjI)?, rule in_context_eqvt))+ + | ((rule exI[of _ "permute_typ \ _"])+, (rule conjI)?, rule in_context_eqvt))+ subgoal premises prems for R B \ T1 T2 by (tactic \refreshability_tac false - [@{term "\\. dom \ \ FFVars_ctxt \"}, @{term "FFVars_typ :: type \ var set"}, @{term "FFVars_typ :: type \ var set"}] - [@{term "rrename_typ :: (var \ var) \ type \ type"}, @{term "(\f x. f x) :: (var \ var) \ var \ var"}] + [@{term "\\. dom \ \ FFVars_ctxt \"}, @{term "FVars_typ :: type \ var set"}, @{term "FVars_typ :: type \ var set"}] + [@{term "permute_typ :: (var \ var) \ type \ type"}, @{term "(\f x. f x) :: (var \ var) \ var \ var"}] [NONE, NONE, NONE, NONE, SOME [NONE, NONE, NONE, SOME 1, SOME 0, SOME 0]] @{thm prems(3)} @{thm prems(2)} @{thms prems(1)[THEN ty_fresh_extend] id_onD} - @{thms emp_bound insert_bound ID.set_bd Un_bound UN_bound typ.card_of_FFVars_bounds infinite_UNIV} - @{thms typ_inject image_iff} @{thms typ.rrename_cong_ids context_map_cong_id map_idI} + @{thms emp_bound insert_bound ID.set_bd Un_bound UN_bound typ.set_bd_UNIV infinite_UNIV} + @{thms typ_inject image_iff} @{thms typ.permute_cong_id context_map_cong_id map_idI} @{thms cong[OF cong[OF cong[OF refl[of R]] refl] refl, THEN iffD1, rotated -1] id_onD} @{context}\) done diff --git a/thys/Pi_Calculus/Commitment.thy b/thys/Pi_Calculus/Commitment.thy index 42d89a52..12ac7850 100644 --- a/thys/Pi_Calculus/Commitment.thy +++ b/thys/Pi_Calculus/Commitment.thy @@ -2,7 +2,7 @@ theory Commitment imports Pi "Prelim.Curry_LFP" "Binders.Generic_Barendregt_Enhanced_Rule_Induction" begin -local_setup \fn lthy => +(*local_setup \fn lthy => let val name1 = "commit_internal" val name2 = "commit" @@ -10,7 +10,7 @@ let val T2 = @{typ "'var * 'var * 'var term +'var * 'var * 'var term + 'var * 'bvar * 'brec + 'var term + 'var * 'bvar * 'brec"} val Xs = map dest_TFree [] val resBs = map dest_TFree [@{typ 'var}, @{typ 'bvar}, @{typ 'brec}, @{typ 'rec}] - val rel = [[0]] + val rel = [[([], [0])]] fun flatten_tyargs Ass = subtract (op =) Xs (filter (fn T => exists (fn Ts => member (op =) Ts T) Ass) resBs) @ Xs; val qualify1 = Binding.prefix_name (name1 ^ "_pre_") @@ -41,27 +41,21 @@ let ((name1, mrbnf1), 1), ((name2, mrbnf2), 1) ] rel lthy; in lthy end -\ +\*) print_theorems +binder_datatype 'var commit = + Finp 'var 'var "'var term" + | Fout 'var 'var "'var term" + | Bout 'var x::'var "(t::'var) term" binds x in t + | Tau "'var term" + | Binp 'var x::'var "(t::'var) term" binds x in t (* Monomorphization: *) type_synonym cmt = "var commit" instance var :: var_commit_pre by standard -instance var :: var_commit_internal_pre by standard - -definition Finp :: "var \ var \ trm \ cmt" where - "Finp x y t \ commit_ctor (Abs_commit_pre (Inl (x, y, t)))" -definition Fout :: "var \ var \ trm \ cmt" where - "Fout x y t \ commit_ctor (Abs_commit_pre (Inr (Inl (x, y, t))))" -definition Bout :: "var \ var \ trm \ cmt" where - "Bout x y t \ commit_ctor (Abs_commit_pre (Inr (Inr (Inl (x, y, commit_internal_ctor (Abs_commit_internal_pre t))))))" -definition Tau :: "trm \ cmt" where - "Tau t \ commit_ctor (Abs_commit_pre (Inr (Inr (Inr (Inl t)))))" -definition Binp :: "var \ var \ trm \ cmt" where - "Binp x y t \ commit_ctor (Abs_commit_pre (Inr (Inr (Inr (Inr (x, y, commit_internal_ctor (Abs_commit_internal_pre t)))))))" - -lemmas toUnfold = set1_commit_internal_pre_def + +lemmas toUnfold = UN_empty UN_empty2 UN_single Un_empty_left Un_empty_right comp_def empty_Diff map_prod_simp prod_set_simps @@ -69,233 +63,59 @@ lemmas toUnfold = set1_commit_internal_pre_def Sup_empty cSup_singleton (* *) Abs_commit_pre_inverse[OF UNIV_I] - set1_commit_pre_def set2_commit_pre_def set4_commit_pre_def set3_commit_pre_def - Abs_commit_internal_pre_inverse[OF UNIV_I] - set1_commit_internal_pre_def set2_commit_internal_pre_def - set3_commit_internal_pre_def set4_commit_internal_pre_def - -lemma FFVars_commit_simps[simp]: - "FFVars_commit (Finp x y t) = {x, y} \ FFVars t" - "FFVars_commit (Fout x y t) = {x, y} \ FFVars t" - "FFVars_commit (Binp x y t) = {x} \ (FFVars t - {y})" - "FFVars_commit (Bout x y t) = {x} \ (FFVars t - {y})" - "FFVars_commit (Tau t) = FFVars t" - apply (unfold Binp_def Bout_def Finp_def Fout_def Tau_def) - apply (unfold commit_internal.FFVars_cctors(2)) - apply (unfold toUnfold) - apply (unfold commit_internal.FFVars_cctors(1)) - apply (unfold toUnfold) - apply auto - done + set1_commit_pre_def set2_commit_pre_def lemmas commit_pre.map_id0[simp] -lemmas commit_pre_map_cong_id = commit_pre.map_cong[of _ _ "id::var\var" "id::var\var" _ _ _ id _ id, simplified] - -lemma map_commit_pre_Inl_aux: "bij f \ |supp f| - map_commit_pre (id::var\var) (f::var\var) (rrename_commit_internal f) id (Abs_commit_pre (Inl (x, y, P))) = - Abs_commit_pre (Inl (x, y, P))" -apply(rule commit_pre_map_cong_id) unfolding toUnfold by auto - -lemma map_commit_pre_Inr_Inl_aux: "bij f \ |supp f| - map_commit_pre (id::var\var) (f::var\var) (rrename_commit_internal f) id (Abs_commit_pre (Inr (Inl (x, y, P)))) = - Abs_commit_pre (Inr (Inl (x, y, P)))" -apply(rule commit_pre_map_cong_id) unfolding toUnfold by auto - -lemma map_commit_pre_Inr_Inr_Inl_aux: "bij f \ |supp f| - map_commit_pre id f (rrename_commit_internal f) id - (Abs_commit_pre (Inr (Inr (Inl (x::var, y::var, commit_internal_ctor (Abs_commit_internal_pre P)))))) = - Abs_commit_pre (Inr (Inr (Inl (x, f y, commit_internal_ctor (Abs_commit_internal_pre (rrename f P))))))" -unfolding map_commit_pre_def toUnfold apply auto -unfolding commit_internal.rrename_cctors(1) -unfolding map_commit_internal_pre_def by (simp add: toUnfold(27)) - -lemma map_commit_pre_Inr_Inr_Inr_Inl_aux: "bij f \ |supp f| - map_commit_pre (id::var\var) (f::var\var) (rrename_commit_internal f) id (Abs_commit_pre (Inr (Inr (Inr (Inl P))))) = - Abs_commit_pre (Inr (Inr (Inr (Inl P))))" -apply(rule commit_pre_map_cong_id) unfolding toUnfold by auto - -lemma map_commit_pre_Inr_Inr_Inr_Inr_aux: "bij f \ |supp f| - map_commit_pre (id::var\var) (f::var\var) (rrename_commit_internal f) id (Abs_commit_pre (Inr (Inr (Inr (Inr (x::var, y::var, commit_internal_ctor (Abs_commit_internal_pre P))))))) = - Abs_commit_pre (Inr (Inr (Inr (Inr (x, f y, commit_internal_ctor (Abs_commit_internal_pre (rrename f P)))))))" -unfolding map_commit_pre_def toUnfold apply auto -unfolding commit_internal.rrename_cctors(1) -unfolding map_commit_internal_pre_def by (simp add: toUnfold(27)) +lemmas commit_pre_map_cong_id = commit_pre.map_cong[of _ _ _ id id id, simplified] lemma Abs_commit_pre_inj[simp]: "Abs_commit_pre k = Abs_commit_pre k' \ k = k'" -by (metis toUnfold(22)) - -lemma Abs_commit_internal_pre_inj[simp]: "Abs_commit_internal_pre k = Abs_commit_internal_pre k' \ k = k'" -by (metis toUnfold(27)) + by (metis toUnfold(21)) lemma Finp_inj[simp]: "Finp x y P = Finp x' y' P' \ x = x' \ y = y' \ P = P'" -unfolding Finp_def unfolding commit_internal.TT_injects0 apply simp -unfolding toUnfold apply auto - subgoal for f apply(subst (asm) map_commit_pre_Inl_aux) by auto - subgoal for f apply(subst (asm) map_commit_pre_Inl_aux) by auto - subgoal for f apply(subst (asm) map_commit_pre_Inl_aux) by auto - subgoal apply(rule exI[of _ id]) apply(subst map_commit_pre_Inl_aux) by auto . + unfolding Finp_def commit.TT_inject0 toUnfold map_commit_pre_def by auto lemma Fout_inj[simp]: "Fout x y P = Fout x' y' P' \ x = x' \ y = y' \ P = P'" -unfolding Fout_def unfolding commit_internal.TT_injects0 apply simp -unfolding toUnfold apply auto - subgoal for f apply(subst (asm) map_commit_pre_Inr_Inl_aux) by auto - subgoal for f apply(subst (asm) map_commit_pre_Inr_Inl_aux) by auto - subgoal for f apply(subst (asm) map_commit_pre_Inr_Inl_aux) by auto - subgoal apply(rule exI[of _ id]) apply(subst map_commit_pre_Inr_Inl_aux) by auto . + unfolding Fout_def commit.TT_inject0 toUnfold map_commit_pre_def by auto lemma Bout_inj[simp]: "Bout x y P = Bout x' y' P' \ x = x' \ ((y' \ FFVars P \ y' = y) \ P' = swap P y y')" -unfolding Bout_def unfolding commit_internal.TT_injects0 apply simp -unfolding toUnfold apply auto - subgoal for f apply(subst (asm) map_commit_pre_Inr_Inr_Inl_aux) by auto - subgoal for f apply(subst (asm) map_commit_pre_Inr_Inr_Inl_aux) - unfolding id_on_def apply auto unfolding commit_internal.FFVars_cctors(1) toUnfold by auto - subgoal for f apply(subst (asm) map_commit_pre_Inr_Inr_Inl_aux) - unfolding id_on_def apply auto unfolding commit_internal.FFVars_cctors(1) toUnfold - unfolding commit_internal.TT_injects0(1) id_on_def - unfolding map_commit_internal_pre_def apply (auto simp: toUnfold id_on_def) - apply(rule rrename_cong) by auto - subgoal apply(rule exI[of _ "(id(y:=y',y':=y))"]) - apply(subst map_commit_pre_Inr_Inr_Inl_aux) apply auto - unfolding commit_internal.FFVars_cctors(1) by (auto simp: toUnfold id_on_def) + unfolding Bout_def commit.TT_inject0 toUnfold map_commit_pre_def set3_commit_pre_def apply simp + apply (rule iffI) + apply (auto simp: id_on_def)[1] + apply (rule term.permute_cong) + apply auto subgoal apply(rule exI[of _ "(id(y:=y',y':=y))"]) - apply(subst map_commit_pre_Inr_Inr_Inl_aux) by auto . + by (auto simp: id_on_def) . lemma Binp_inj[simp]: "Binp x y P = Binp x' y' P' \ x = x' \ ((y' \ FFVars P \ y' = y) \ P' = swap P y y')" -unfolding Binp_def unfolding commit_internal.TT_injects0 apply simp -unfolding toUnfold apply auto - subgoal for f apply(subst (asm) map_commit_pre_Inr_Inr_Inr_Inr_aux) by auto - subgoal for f apply(subst (asm) map_commit_pre_Inr_Inr_Inr_Inr_aux) - unfolding id_on_def apply auto unfolding commit_internal.FFVars_cctors(1) toUnfold by auto - subgoal for f apply(subst (asm) map_commit_pre_Inr_Inr_Inr_Inr_aux) - unfolding id_on_def apply auto unfolding commit_internal.FFVars_cctors(1) toUnfold - unfolding commit_internal.TT_injects0(1) id_on_def - unfolding map_commit_internal_pre_def apply (auto simp: toUnfold id_on_def) - apply(rule rrename_cong) by auto - subgoal apply(rule exI[of _ "(id(y:=y',y':=y))"]) - apply(subst map_commit_pre_Inr_Inr_Inr_Inr_aux) apply auto - unfolding commit_internal.FFVars_cctors(1) by (auto simp: toUnfold id_on_def) +unfolding Binp_def commit.TT_inject0 toUnfold map_commit_pre_def set3_commit_pre_def apply simp + apply (rule iffI) + apply (auto simp: id_on_def)[1] + apply (rule term.permute_cong) + apply auto subgoal apply(rule exI[of _ "(id(y:=y',y':=y))"]) - apply(subst map_commit_pre_Inr_Inr_Inr_Inr_aux) by auto . + by (auto simp: id_on_def) . lemma Tau_inj[simp]: "Tau P = Tau P' \ P = P'" -unfolding Tau_def unfolding commit_internal.TT_injects0 apply simp -unfolding toUnfold apply auto - subgoal for f apply(subst (asm) map_commit_pre_Inr_Inr_Inr_Inl_aux) by auto - subgoal apply(rule exI[of _ id]) apply(subst map_commit_pre_Inr_Inr_Inr_Inl_aux) by auto . - -(* *) - -lemma Finp_Fout_diff[simp]: "Finp x y P \ Fout x' y' P'" -unfolding Finp_def Fout_def -by (metis Abs_commit_pre_inj Inl_Inr_False commit_internal.TT_injects0(2) map_commit_pre_Inl_aux) - -lemmas Fout_Finp_diff[simp] = Finp_Fout_diff[symmetric] - -lemma Finp_Bout_diff[simp]: "Finp x y P \ Bout x' y' P'" -unfolding Finp_def Bout_def -by (metis Abs_commit_pre_inj Inl_Inr_False commit_internal.TT_injects0(2) map_commit_pre_Inl_aux) - -lemmas Bout_Finp_diff[simp] = Finp_Bout_diff[symmetric] - -lemma Finp_Tau_diff[simp]: "Finp x y P \ Tau P'" -unfolding Finp_def Tau_def -by (metis Abs_commit_pre_inj Inl_Inr_False commit_internal.TT_injects0(2) map_commit_pre_Inl_aux) - -lemmas Tau_Finp_diff[simp] = Finp_Tau_diff[symmetric] - -lemma Fout_Bout_diff[simp]: "Fout x y P \ Bout x' y' P'" -unfolding Fout_def Bout_def -by (metis Abs_commit_pre_inj Inl_Inr_False commit_internal.TT_injects0(2) map_commit_pre_Inr_Inl_aux sum.inject(2)) - -lemmas Bout_Fout_diff[simp] = Fout_Bout_diff[symmetric] - -lemma Fout_Tau_diff[simp]: "Fout x y P \ Tau P'" -unfolding Fout_def Tau_def -by (metis Abs_commit_pre_inj Inl_Inr_False commit_internal.TT_injects0(2) map_commit_pre_Inr_Inl_aux sum.inject(2)) - -lemmas Tau_Fout_diff[simp] = Fout_Tau_diff[symmetric] - -lemma Bout_Tau_diff[simp]: "Bout x y P \ Tau P'" -unfolding Bout_def Tau_def -by (smt (verit) Inl_Inr_False Inr_inject commit_internal.TT_injects0(2) map_commit_pre_Inr_Inr_Inl_aux toUnfold(22)) - -lemmas Tau_Bout_diff[simp] = Bout_Tau_diff[symmetric] - -lemma Binp_Bout_diff[simp]: "Binp x y P \ Bout x' y' P'" - unfolding Binp_def Bout_def - by (smt (verit) Inl_Inr_False Inr_inject commit_internal.TT_injects0(2) map_commit_pre_Inr_Inr_Inl_aux toUnfold(22)) - -lemmas Bout_Binp_diff[simp] = Binp_Bout_diff[symmetric] - -lemma Binp_Finp_diff[simp]: "Binp x y P \ Finp x' y' P'" - unfolding Binp_def Finp_def - by (metis Abs_commit_pre_inj Inl_Inr_False commit_internal.TT_injects0(2) map_commit_pre_Inl_aux) - -lemmas Finp_Binp_diff[simp] = Binp_Finp_diff[symmetric] - -lemma Binp_Fout_diff[simp]: "Binp x y P \ Fout x' y' P'" - unfolding Binp_def Fout_def - by (metis Abs_commit_pre_inj Inl_Inr_False Inr_inject commit_internal.TT_injects0(2) map_commit_pre_Inr_Inl_aux) - -lemmas Fout_Binp_diff[simp] = Binp_Fout_diff[symmetric] - -lemma Binp_Tau_diff[simp]: "Binp x y P \ Tau P'" - unfolding Binp_def Tau_def - by (metis Abs_commit_pre_inj Inr_not_Inl commit_internal.TT_injects0(2) map_commit_pre_Inr_Inr_Inr_Inl_aux old.sum.inject(2)) - -lemmas Tau_Binp_diff[simp] = Binp_Tau_diff[symmetric] +unfolding Tau_def commit.TT_inject0 toUnfold map_commit_pre_def by auto (* Supply of fresh variables *) -lemma finite_FFVars_commit: "finite (FFVars_commit C)" -unfolding ls_UNIV_iff_finite[symmetric] -by (simp add: commit_internal.card_of_FFVars_bounds(2)) +lemma finite_FVars_commit: "finite (FVars_commit (C::var commit))" + unfolding ls_UNIV_iff_finite[symmetric] + by (rule commit.FVars_bd_UNIVs) lemma exists_fresh: -"\ z. z \ set xs \ (\P \ set Cs. z \ FFVars_commit P)" +"\ z. z \ set xs \ (\P \ set (Cs::var commit list). z \ FVars_commit P)" proof- - have 0: "|set xs \ \ (FFVars_commit ` (set Cs))| \ (FVars_commit ` (set Cs))| set xs \ \ (FFVars_commit ` (set Cs))" + using finite_FVars_commit by blast + then obtain x where "x \ set xs \ \ (FVars_commit ` (set Cs))" by (meson ex_new_if_finite finite_iff_le_card_var infinite_iff_natLeq_ordLeq var_term_pre_class.large) thus ?thesis by auto qed -(* *) - -lemma rrename_commit_Finp[simp]: "bij \ \ |supp \| - rrename_commit \ (Finp a u P) = Finp (\ a) (\ u) (rrename \ P)" -unfolding Finp_def unfolding commit_internal.rrename_cctors -unfolding map_commit_pre_def unfolding toUnfold by simp - -lemma rrename_commit_Fout[simp]: "bij \ \ |supp \| - rrename_commit \ (Fout a u P) = Fout (\ a) (\ u) (rrename \ P)" -unfolding Fout_def unfolding commit_internal.rrename_cctors -unfolding map_commit_pre_def unfolding toUnfold by simp - -lemma rrename_commit_Bout[simp]: "bij \ \ |supp \| - rrename_commit \ (Bout a u P) = Bout (\ a) (\ u) (rrename \ P)" -unfolding Bout_def unfolding commit_internal.rrename_cctors -unfolding map_commit_pre_def unfolding toUnfold -unfolding commit_internal.rrename_cctors(1) -unfolding map_commit_internal_pre_def unfolding toUnfold by simp - -lemma rrename_commit_Binp[simp]: "bij \ \ |supp \| - rrename_commit \ (Binp a u P) = Binp (\ a) (\ u) (rrename \ P)" -unfolding Binp_def unfolding commit_internal.rrename_cctors -unfolding map_commit_pre_def unfolding toUnfold -unfolding commit_internal.rrename_cctors(1) -unfolding map_commit_internal_pre_def unfolding toUnfold by simp - -lemma rrename_commit_Tau[simp]: "bij \ \ |supp \| - rrename_commit \ (Tau P) = Tau (rrename \ P)" -unfolding Tau_def unfolding commit_internal.rrename_cctors -unfolding map_commit_pre_def unfolding toUnfold -unfolding commit_internal.rrename_cctors(1) -unfolding map_commit_internal_pre_def unfolding toUnfold by simp - (* Actions *) datatype (vars:'a) action = finp 'a 'a | fout 'a 'a | is_bout: bout 'a 'a | binp 'a 'a | tau @@ -349,10 +169,7 @@ local_setup \MRBNF_Sugar.register_binder_sugar "Commitment.commit" { (@{term Binp}, @{thm Binp_def}), (@{term Cmt}, @{thm refl}) ], - permute_simps = @{thms - rrename_commit_Finp rrename_commit_Fout rrename_commit_Bout - rrename_commit_Binp rrename_commit_Tau - }, + permute_simps = @{thms commit.permute}, map_simps = [], distinct = [], bsetss = [[ @@ -364,7 +181,7 @@ local_setup \MRBNF_Sugar.register_binder_sugar "Commitment.commit" { SOME @{term "\x P. bns x"} ]], bset_bounds = @{thms bns_bound}, - strong_induct = @{thm refl}, + strong_induct = NONE, mrbnf = the (MRBNF_Def.mrbnf_of @{context} "Commitment.commit_pre"), set_simpss = [], subst_simps = NONE @@ -375,9 +192,9 @@ abbreviation "swapa act x y \ map_action (id(x:=y,y:=x)) act" lemma bvars_map_action[simp]: "bvars (map_action \ act) = image \ (bvars act)" by (cases act, auto) -lemma rrename_commit_Cmt[simp]: +lemma permute_commit_Cmt[simp]: "bij \ \ |supp \| - rrename_commit \ (Cmt act P) = Cmt (map_action \ act) (rrename \ P)" + permute_commit \ (Cmt act P) = Cmt (map_action \ act) (rrename \ P)" by (cases act, auto) lemma bvars_act_bout: "bvars act = {} \ (\a b. act = bout a b) \ (\a b. act = binp a b)" diff --git a/thys/Pi_Calculus/Pi.thy b/thys/Pi_Calculus/Pi.thy index ff765d46..c7590e54 100644 --- a/thys/Pi_Calculus/Pi.thy +++ b/thys/Pi_Calculus/Pi.thy @@ -44,17 +44,17 @@ by (metis finite.emptyI finite.insertI finite_card_var imsupp_id_fun_upd imsupp_ (* Some lighter notations: *) -abbreviation "rrename \ rrename_term" -abbreviation "FFVars \ FFVars_term" +abbreviation "rrename \ permute_term" +abbreviation "FFVars \ FVars_term" (* *) (* Enabling some simplification rules: *) -lemmas term.rrename_ids[simp] term.rrename_cong_ids[simp] -term.FFVars_rrenames[simp] +lemmas term.permute_id[simp] term.permute_cong_id[simp] +term.FVars_permute[simp] -lemmas term_vvsubst_rrename[simp] +lemmas term_vvsubst_permute[simp] (* Supply of fresh variables *) @@ -75,49 +75,40 @@ proof- thus ?thesis by auto qed -lemma rrename_cong: -assumes "bij f" "|supp f| z. (z::var) \ FFVars P \ f z = g z)" -shows "rrename f P = rrename g P" -(* why term.rrename_cong_ids -and not the above more general thoerem? *) -using assms(5) apply(binder_induction P avoiding: "supp f" "supp g" rule: term.strong_induct) -using assms apply auto by (metis not_in_supp_alt)+ - (* Properties of the constructors *) proposition Sum_inject[simp]: "(Sum a b = Sum c d) = (a = c \ b = d)" -unfolding Sum_def fun_eq_iff term.TT_injects0 +unfolding Sum_def fun_eq_iff term.TT_inject0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case prod.map_id Abs_term_pre_inject[OF UNIV_I UNIV_I] by auto proposition Par_inject[simp]: "(Par a b = Par c d) = (a = c \ b = d)" -unfolding Par_def fun_eq_iff term.TT_injects0 +unfolding Par_def fun_eq_iff term.TT_inject0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case prod.map_id Abs_term_pre_inject[OF UNIV_I UNIV_I] by auto proposition Bang_inject[simp]: "(Bang a = Bang b) = (a = b)" -unfolding Bang_def fun_eq_iff term.TT_injects0 +unfolding Bang_def fun_eq_iff term.TT_inject0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case prod.map_id Abs_term_pre_inject[OF UNIV_I UNIV_I] by auto proposition Match_inject[simp]: "(Match x1 y1 a1 = Match x2 y2 a2) = (x1 = x2 \ y1 = y2 \ a1 = a2)" -unfolding Match_def fun_eq_iff term.TT_injects0 +unfolding Match_def fun_eq_iff term.TT_inject0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case prod.map_id Abs_term_pre_inject[OF UNIV_I UNIV_I] by auto proposition Out_inject[simp]: "(Out x1 y1 a1 = Out x2 y2 a2) = (x1 = x2 \ y1 = y2 \ a1 = a2)" -unfolding Out_def fun_eq_iff term.TT_injects0 +unfolding Out_def fun_eq_iff term.TT_inject0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case prod.map_id Abs_term_pre_inject[OF UNIV_I UNIV_I] by auto lemma Inp_inject: "(Inp x y e = Inp x' y' e') \ x = x' \ (\f. bij f \ |supp (f::var \ var)| id_on (FFVars_term e - {y}) f \ f y = y' \ rrename_term f e = e')" + \ id_on (FVars_term e - {y}) f \ f y = y' \ permute_term f e = e')" unfolding term.set - unfolding Inp_def term.TT_injects0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] + unfolding Inp_def term.TT_inject0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case map_prod_def prod.case id_def Abs_term_pre_inject[OF UNIV_I UNIV_I] sum.inject prod.inject set3_term_pre_def sum_set_simps Union_empty Un_empty_left prod_set_simps cSup_singleton set2_term_pre_def Un_empty_right UN_single by auto @@ -128,7 +119,7 @@ lemma Inp_inject_same[simp]: "Inp x y e = Inp x' y e' \ ((x: apply (erule exE conjE)+ apply (rule conjI) apply assumption - apply (frule term.rrename_cong_ids[of _ e]) + apply (frule term.permute_cong_id[of _ e]) apply assumption apply (rule case_split[of "_ \ _", rotated]) apply (erule id_onD) @@ -145,22 +136,22 @@ lemma Inp_inject_same[simp]: "Inp x y e = Inp x' y e' \ ((x: apply (rule exI[of _ id]) apply (rule bij_id supp_id_bound id_on_id id_apply conjI)+ apply (rule trans) - apply (rule term.rrename_ids) + apply (rule term.permute_id) apply assumption done lemma Res_inject: "(Res y e = Res y' e') \ (\f. bij f \ |supp (f::var \ var)| id_on (FFVars_term e - {y}) f \ f y = y' \ rrename_term f e = e')" + \ id_on (FVars_term e - {y}) f \ f y = y' \ permute_term f e = e')" unfolding term.set - unfolding Res_def term.TT_injects0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] + unfolding Res_def term.TT_inject0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case map_prod_def prod.case id_def Abs_term_pre_inject[OF UNIV_I UNIV_I] sum.inject prod.inject set3_term_pre_def sum_set_simps Union_empty Un_empty_left prod_set_simps cSup_singleton set2_term_pre_def Un_empty_right UN_single by auto -lemma bij_map_term_pre: "bij f \ |supp (f::var \ var)| bij (map_term_pre (id::var \var) f (rrename_term f) id)" +lemma bij_map_term_pre: "bij f \ |supp (f::var \ var)| bij (map_term_pre (id::var \var) f (permute_term f) id)" apply (rule iffD2[OF bij_iff]) - apply (rule exI[of _ "map_term_pre id (inv f) (rrename_term (inv f)) id"]) + apply (rule exI[of _ "map_term_pre id (inv f) (permute_term (inv f)) id"]) apply (frule bij_imp_bij_inv) apply (frule supp_inv_bound) apply assumption @@ -168,17 +159,17 @@ lemma bij_map_term_pre: "bij f \ |supp (f::var \ var apply (rule trans) apply (rule term_pre.map_comp0[symmetric]) apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp1 term.rrename_comp0s term.rrename_id0s + unfolding id_o inv_o_simp1 term.permute_comp0 term.permute_id0 apply (rule term_pre.map_id0) apply (rule trans) apply (rule term_pre.map_comp0[symmetric]) apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp2 term.rrename_comp0s term.rrename_id0s + unfolding id_o inv_o_simp2 term.permute_comp0 term.permute_id0 apply (rule term_pre.map_id0) done lemma map_term_pre_inv_simp: "bij f \ |supp (f::var \ var)| -inv (map_term_pre (id::_::var_term_pre \ _) f (rrename_term f) id) = map_term_pre id (inv f) (rrename_term (inv f)) id" +inv (map_term_pre (id::_::var_term_pre \ _) f (permute_term f) id) = map_term_pre id (inv f) (permute_term (inv f)) id" apply (frule bij_imp_bij_inv) apply (frule supp_inv_bound) apply assumption @@ -190,16 +181,16 @@ inv (map_term_pre (id::_::var_term_pre \ _) f (rrename_term f) id) = apply (rule trans) apply (rule term_pre.map_comp0[symmetric]) apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp1 inv_o_simp2 term.rrename_comp0s term.rrename_id0s term_pre.map_id0 + unfolding id_o inv_o_simp1 inv_o_simp2 term.permute_comp0 term.permute_id0 term_pre.map_id0 apply (rule refl)+ done lemma Abs_set3: "term_ctor v = Inp y (x::var) e \ \x' e'. term_ctor v = Inp y x' e' \ x' \ set2_term_pre v \ e' \ set3_term_pre v" - unfolding Inp_def term.TT_injects0 + unfolding Inp_def term.TT_inject0 apply (erule exE) apply (erule conjE)+ subgoal for f -apply (drule iffD2[OF bij_imp_inv', rotated, of "map_term_pre id f (rrename_term f) id"]) +apply (drule iffD2[OF bij_imp_inv', rotated, of "map_term_pre id f (permute_term f) id"]) apply (rule bij_map_term_pre) apply assumption+ apply (rule exI) @@ -208,7 +199,7 @@ apply (drule iffD2[OF bij_imp_inv', rotated, of "map_term_pre id f (rrename_term apply (rule exI[of _ "id"]) apply (rule conjI bij_id supp_id_bound id_on_id)+ apply (drule sym) - unfolding term.rrename_id0s term_pre.map_id map_term_pre_inv_simp + unfolding term.permute_id0 term_pre.map_id map_term_pre_inv_simp unfolding map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case map_prod_def prod.case id_def apply assumption @@ -216,19 +207,17 @@ apply (drule iffD2[OF bij_imp_inv', rotated, of "map_term_pre id f (rrename_term unfolding set2_term_pre_def set3_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] sum_set_simps map_sum_def sum.case Union_empty Un_empty_left map_prod_def prod.case prod_set_simps ccpo_Sup_singleton Un_empty_right id_on_def image_single[symmetric] - unfolding term.FFVars_rrenames[OF bij_imp_bij_inv supp_inv_bound] + unfolding term.FVars_permute[OF bij_imp_bij_inv supp_inv_bound] unfolding image_single image_set_diff[OF bij_is_inj[OF bij_imp_bij_inv], symmetric] - image_in_bij_eq[OF bij_imp_bij_inv] inv_inv_eq image_in_bij_eq[OF term.rrename_bijs[OF bij_imp_bij_inv supp_inv_bound]] - term.rrename_inv_simps[OF bij_imp_bij_inv supp_inv_bound] inv_simp2 - unfolding term.rrename_comps[OF bij_imp_bij_inv supp_inv_bound] inv_o_simp2 term.rrename_ids + image_in_bij_eq[OF bij_imp_bij_inv] inv_inv_eq image_in_bij_eq[OF term.permute_bij[OF bij_imp_bij_inv supp_inv_bound]] + term.permute_inv_simp[OF bij_imp_bij_inv supp_inv_bound] inv_simp2 + unfolding term.permute_comp[OF bij_imp_bij_inv supp_inv_bound] inv_o_simp2 term.permute_id apply (rule conjI bij_imp_bij_inv supp_inv_bound singletonI | assumption)+ done done lemma Abs_avoid: "|A::var set| \x' e'. Inp y x e = Inp y x' e' \ x' \ A" - apply (drule term.TT_fresh_nchotomys[of _ "Inp y x e"]) - apply (erule exE) - apply (erule conjE) + apply (erule term.TT_fresh_cases[of _ "Inp y x e"]) apply (drule sym) apply (frule Abs_set3) apply (erule exE conjE)+ @@ -237,7 +226,7 @@ lemma Abs_avoid: "|A::var set| \x' apply (rule trans) apply (rule sym) apply assumption - apply (rotate_tac 2) + apply (rotate_tac 3) apply assumption apply (drule iffD1[OF disjoint_iff]) apply (erule allE) @@ -248,7 +237,7 @@ lemma Abs_avoid: "|A::var set| \x' lemma Abs_rrename: "bij (\::var\var) \ |supp \| - (\a'. a' \ FFVars_term e - {a::var} \ \ a' = a') \ Inp b a e = Inp b (\ a) (rrename_term \ e)" + (\a'. a' \ FVars_term e - {a::var} \ \ a' = a') \ Inp b a e = Inp b (\ a) (permute_term \ e)" using Inp_inject id_on_def by blast (* Bound properties (needed as auxiliaries): *) @@ -268,11 +257,11 @@ lemma usub_swap_disj: assumes "{u,v} \ {x,y} = {}" shows "usub (swap P u v) x y = swap (usub P x y) u v" proof- - note term_vvsubst_rrename[simp del] + note term_vvsubst_permute[simp del] show ?thesis using assms - apply(subst term_vvsubst_rrename[symmetric]) apply auto + apply(subst term_vvsubst_permute[symmetric]) apply auto apply(subst term.map_comp) apply auto - apply(subst term_vvsubst_rrename[symmetric]) apply auto + apply(subst term_vvsubst_permute[symmetric]) apply auto apply(subst term.map_comp) apply auto apply(rule term.map_cong0) using term_pre.supp_comp_bound by auto @@ -281,7 +270,7 @@ qed lemma rrename_o_swap: "rrename (id(y::var := yy, yy := y) o id(x := xx, xx := x)) P = swap (swap P x xx) y yy" -apply(subst term.rrename_comps[symmetric]) +apply(subst term.permute_comp[symmetric]) by auto (* *) @@ -298,10 +287,10 @@ by (auto simp: sw_def) lemma FFVars_swap[simp]: "FFVars (swap P y x) = (\u. sw u x y) ` (FFVars P)" -apply(subst term.FFVars_rrenames) by (auto simp: sw_def) +apply(subst term.FVars_permute) by (auto simp: sw_def) lemma FFVars_swap'[simp]: "{x::var,y} \ FFVars P = {} \ swap P x y = P" -apply(rule term.rrename_cong_ids) by auto +apply(rule term.permute_cong_id) by auto (* *) @@ -309,7 +298,7 @@ lemma Inp_inject_swap: "Inp u v P = Inp u' v' P' \ u = u' \ (v' \ FFVars P \ v' = v) \ swap P v' v = P'" unfolding Inp_inject apply(rule iffI) subgoal unfolding id_on_def apply auto - apply(rule rrename_cong) by auto + apply(rule term.permute_cong) by auto subgoal apply clarsimp apply(rule exI[of _ "id(v':=v,v:=v')"]) unfolding id_on_def by auto . @@ -336,7 +325,7 @@ lemma Res_inject_swap: "Res v P = Res v' P' \ (v' \ FFVars P \ v' = v) \ swap P v' v = P'" unfolding Res_inject apply(rule iffI) subgoal unfolding id_on_def apply auto - apply(rule rrename_cong) by auto + apply(rule term.permute_cong) by auto subgoal apply clarsimp apply(rule exI[of _ "id(v':=v,v:=v')"]) unfolding id_on_def by auto . @@ -446,9 +435,9 @@ lemma usub_refresh: assumes "xx \ FFVars P \ xx = x" shows "usub P u x = usub (swap P x xx) u xx" proof- - note term_vvsubst_rrename[simp del] + note term_vvsubst_permute[simp del] show ?thesis using assms - apply(subst term_vvsubst_rrename[symmetric]) apply simp + apply(subst term_vvsubst_permute[symmetric]) apply simp subgoal by auto subgoal apply(subst term.map_comp) subgoal by auto @@ -465,11 +454,11 @@ lemma Inp_eq_usub: lemma swap_commute: "{y,yy} \ {x,xx} = {} \ swap (swap P y yy) x xx = swap (swap P x xx) y yy" -apply(subst term.rrename_comps) +apply(subst term.permute_comp) apply auto -apply(subst term.rrename_comps) +apply(subst term.permute_comp) apply auto -apply(rule rrename_cong) +apply(rule term.permute_cong) by (auto simp: term_pre.supp_comp_bound) end diff --git a/thys/Pi_Calculus/Pi_Transition_Common.thy b/thys/Pi_Calculus/Pi_Transition_Common.thy index 512f32e2..73d7337b 100644 --- a/thys/Pi_Calculus/Pi_Transition_Common.thy +++ b/thys/Pi_Calculus/Pi_Transition_Common.thy @@ -6,11 +6,11 @@ hide_const inverse_class.inverse_divide trans no_notation inverse.inverse_divide (infixl "'/" 70) abbreviation Tsupp :: "trm \ cmt \ var set" where -"Tsupp e1 e2 \ FFVars e1 \ FFVars_commit e2" +"Tsupp e1 e2 \ FFVars e1 \ FVars_commit e2" (* Supply of fresh variables: *) lemma finite_Tsupp: "finite (Tsupp e1 e2)" - by (metis FFVars_commit_simps(5) finite_FFVars_commit finite_Un) + by (metis commit.set(4) finite_FVars_commit finite_Un) lemma finite_vars: "finite (vars act)" by (cases act) auto @@ -43,7 +43,7 @@ lemma isPerm_swap: "isPerm (id(x := y, y := x))" lemma R_forw_subst: "R x y \ (\x y. R x y \ R (f x) (g y)) \ z = g y \ R (f x) z" by blast -lemma FFVars_commit_Cmt: "FFVars_commit (Cmt act P) = fvars act \ (FFVars P - bvars act)" +lemma FVars_commit_Cmt: "FVars_commit (Cmt act P) = fvars act \ (FFVars P - bvars act)" by (cases act) auto lemma empty_bvars_vars_fvars: "bvars act = {} \ vars act = fvars act" @@ -84,8 +84,8 @@ qed lemma Bout_inject: "(Bout x y t = Bout x' y' t') \ x = x' \ (\f. bij f \ |supp (f::var \ var)| id_on (FFVars_term t - {y}) f \ f y = y' \ rrename_term f t = t')" - by (auto 0 4 simp: id_on_def intro!: exI[of _ "id(y:=y', y':=y)"] rrename_cong) + \ id_on (FVars_term t - {y}) f \ f y = y' \ permute_term f t = t')" + by (auto 0 4 simp: id_on_def intro!: exI[of _ "id(y:=y', y':=y)"] term.permute_cong) declare Bout_inj[simp del] lemma ns_alt: "ns \ = bns \ \ fns \" @@ -107,7 +107,7 @@ lemma bvars_rrename_bound_action[simp]: "bvars (rrename_bound_action f \) lemma Cmt_rrename_bound_action: "bij (f :: var \ var) \ |supp f| id_on (FFVars P - bvars \) f \ Cmt \ P = Cmt (rrename_bound_action f \) (rrename f P)" by (cases \) - (force simp: Bout_inject id_on_def intro!: exI[of _ f] term.rrename_cong_ids[symmetric] rrename_cong)+ + (force simp: Bout_inject id_on_def intro!: exI[of _ f] term.permute_cong_id[symmetric] term.permute_cong)+ lemma Cmt_rrename_bound_action_Par: "bij (f :: var \ var) \ |supp f| id_on (FFVars P \ FFVars Q - bvars \) f \ Cmt \ (P \ Q) = Cmt (rrename_bound_action f \) (rrename f P \ rrename f Q)" diff --git a/thys/Pi_Calculus/Pi_Transition_Early.thy b/thys/Pi_Calculus/Pi_Transition_Early.thy index e986d1f4..438ab229 100644 --- a/thys/Pi_Calculus/Pi_Transition_Early.thy +++ b/thys/Pi_Calculus/Pi_Transition_Early.thy @@ -11,30 +11,19 @@ inductive trans :: "trm \ cmt \ bool" where | ScopeBound: "\ trans P (Bout a x P') ; y \ {a, x} ; x \ FFVars P \ {a} \ \ trans (Res y P) (Bout a x (Res y P'))" | ParLeft: "\ trans P (Cmt \ P') ; bns \ \ (FFVars P \ FFVars Q) = {} \ \ trans (P \ Q) (Cmt \ (P' \ Q))" -(* -lemma "B = bvars \' \ P = Paa \ Qaa \ Q = Cmt \' (P'a \ Qaa) \ R Paa (Cmt \' P'a) \ - bvars \' \ (FFVars Paa \ FFVars Qaa) = {} \ - \Pa \ P' Qa. - xa ` B = bvars \ \ - P = Pa \ Qa \ - Q = Cmt \ (P' \ Qa) \ - R Pa (Cmt \ P') \ bvars \ \ FFVars Pa = {} \ bvars \ \ FFVars Qa = {}" - apply (cases \'; hypsubst_thin; unfold Cmt.simps bns.simps) -*) - binder_inductive trans subgoal for R B \ x1 x2 apply simp apply (elim disj_forward) by (auto simp: isPerm_def - term.rrename_comps action.map_comp action.map_id + term.permute_comp action.map_comp action.map_id | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl) | (rule exI[of _ "map_action \ _"]) | (rule exI[of _ "rrename \ _"]) | ((rule exI[of _ "\ _"])+; auto))+ subgoal premises prems for R B P Q by (tactic \refreshability_tac false - [@{term "FFVars :: trm \ var set"}, @{term "FFVars_commit :: cmt \ var set"}] + [@{term "FFVars :: trm \ var set"}, @{term "FVars_commit :: cmt \ var set"}] [@{term "rrename :: (var \ var) \ trm \ trm"}, @{term "(\f x. f x) :: (var \ var) \ var \ var"}, @{term "rrename_bound_action :: (var \ var) \ var action \ var action"}] [SOME [NONE, SOME 1, SOME 0, NONE], @@ -45,17 +34,18 @@ binder_inductive trans SOME [SOME 0, NONE, SOME 1, SOME 0, SOME 1], SOME [NONE, SOME 2, SOME 0, SOME 0]] @{thm prems(3)} @{thm prems(2)} @{thms } - @{thms emp_bound singl_bound insert_bound card_of_minus_bound term.Un_bound term.card_of_FFVars_bounds commit_internal.card_of_FFVars_bounds infinite_UNIV bns_bound} - @{thms Res_inject Inp_inject Bout_inject FFVars_commit_Cmt ns_alt vars_alt Int_Un_distrib} - @{thms Inp_eq_usub term.rrename_cong_ids term.rrename_cong_ids[symmetric] arg_cong2[where f=Cmt, OF _ refl] arg_cong2[where f=Cmt, OF refl] + @{thms emp_bound singl_bound insert_bound card_of_minus_bound var_term_pre_class.Un_bound term.set_bd_UNIV commit.FVars_bd_UNIVs infinite_UNIV bns_bound} + @{thms Res_inject Inp_inject Bout_inject FVars_commit_Cmt ns_alt vars_alt Int_Un_distrib} + @{thms Inp_eq_usub term.permute_cong_id term.permute_cong_id[symmetric] arg_cong2[where f=Cmt, OF _ refl] arg_cong2[where f=Cmt, OF refl] action.map_ident_strong cong[OF arg_cong2[OF _ refl] refl, of _ _ Bout] Cmt_rrename_bound_action Cmt_rrename_bound_action_Par} @{thms cong[OF cong[OF refl[of R] refl], THEN iffD1, rotated -1, of _ _ "Bout _ _ _"] id_onD id_on_antimono cong[OF cong[OF refl[of R] refl], THEN iffD1, rotated -1, of _ _ "Fout _ _ _"] cong[OF cong[OF refl[of R] refl], THEN iffD1, rotated -1, of _ _ "Cmt _ _"] - cong[OF cong[OF refl[of R] term.rrename_cong_ids], THEN iffD1, rotated -1, of _ _ _ "Finp _ _ _"]} @{context}\) + cong[OF cong[OF refl[of R] term.permute_cong_id], THEN iffD1, rotated -1, of _ _ _ "Finp _ _ _"]} @{context}\) done print_theorems thm trans.strong_induct end + diff --git a/thys/Pi_Calculus/Pi_Transition_Late.thy b/thys/Pi_Calculus/Pi_Transition_Late.thy index b7ef79fe..58ff713b 100644 --- a/thys/Pi_Calculus/Pi_Transition_Late.thy +++ b/thys/Pi_Calculus/Pi_Transition_Late.thy @@ -16,13 +16,13 @@ binder_inductive trans apply simp apply (elim disj_forward) by (auto simp: isPerm_def - term.rrename_comps action.map_comp action.map_id + term.permute_comp action.map_comp action.map_id | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl) | (rule exI[of _ "map_action \ _"] exI[of _ "rrename \ _"]) | ((rule exI[of _ "\ _"])+; auto))+ subgoal premises prems for R B P Q by (tactic \refreshability_tac false - [@{term "FFVars :: trm \ var set"}, @{term "FFVars_commit :: cmt \ var set"}] + [@{term "FFVars :: trm \ var set"}, @{term "FVars_commit :: cmt \ var set"}] [@{term "rrename :: (var \ var) \ trm \ trm"}, @{term "(\f x. f x) :: (var \ var) \ var \ var"}, @{term "rrename_bound_action :: (var \ var) \ var action \ var action"}] [SOME [NONE, SOME 1, SOME 0], @@ -33,15 +33,15 @@ binder_inductive trans SOME [SOME 0, NONE, SOME 1, SOME 0, SOME 1], SOME [NONE, SOME 2, SOME 0, SOME 0]] @{thm prems(3)} @{thm prems(2)} @{thms } - @{thms emp_bound singl_bound insert_bound card_of_minus_bound term.Un_bound term.card_of_FFVars_bounds commit_internal.card_of_FFVars_bounds infinite_UNIV bns_bound} - @{thms Res_inject Inp_inject Bout_inject FFVars_commit_Cmt ns_alt vars_alt Int_Un_distrib} - @{thms Inp_eq_usub rrename_cong term.rrename_cong_ids term.rrename_cong_ids[symmetric] arg_cong2[where f=Cmt, OF _ refl] arg_cong2[where f=Cmt, OF refl] + @{thms emp_bound singl_bound insert_bound card_of_minus_bound term.Un_bound term.FVars_bd_UNIVs commit.FVars_bd_UNIVs infinite_UNIV bns_bound} + @{thms Res_inject Inp_inject Bout_inject FVars_commit_Cmt ns_alt vars_alt Int_Un_distrib} + @{thms Inp_eq_usub term.permute_cong term.permute_cong_id term.permute_cong_id[symmetric] arg_cong2[where f=Cmt, OF _ refl] arg_cong2[where f=Cmt, OF refl] action.map_ident_strong cong[OF arg_cong2[OF _ refl] refl, of _ _ Bout] Cmt_rrename_bound_action Cmt_rrename_bound_action_Par} @{thms cong[OF cong[OF refl[of R] refl], THEN iffD1, rotated -1, of _ _ "Bout _ _ _"] id_onD id_on_antimono cong[OF cong[OF refl[of R] refl], THEN iffD1, rotated -1, of _ _ "Fout _ _ _"] cong[OF cong[OF refl[of R] refl], THEN iffD1, rotated -1, of _ _ "Cmt _ _"] cong[OF cong[OF refl[of R] refl], THEN iffD1, rotated -1, of _ _ "Binp _ _ _"] - cong[OF cong[OF refl[of R] term.rrename_cong_ids], THEN iffD1, rotated -1, of _ _ _ "Finp _ _ _"]} @{context}\) + cong[OF cong[OF refl[of R] term.permute_cong_id], THEN iffD1, rotated -1, of _ _ _ "Finp _ _ _"]} @{context}\) done print_theorems diff --git a/thys/Pi_Calculus/Pi_cong.thy b/thys/Pi_Calculus/Pi_cong.thy index 9800c537..8b3581aa 100644 --- a/thys/Pi_Calculus/Pi_cong.thy +++ b/thys/Pi_Calculus/Pi_cong.thy @@ -23,7 +23,7 @@ binder_inductive cong subgoal for R B \ x1 x2 apply simp by (elim disj_forward case_prodE) - (auto simp: isPerm_def term.rrename_comps + (auto simp: isPerm_def term.permute_comp | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl) | ((rule exI[of _ "\ _"])+; auto))+ subgoal premises prems for R B P Q @@ -32,8 +32,8 @@ binder_inductive cong [@{term "rrename :: (var \ var) \ trm \ trm"}, @{term "(\f x. f x) :: (var \ var) \ var \ var"}] [NONE, NONE, NONE, NONE, SOME [SOME 1, SOME 1, SOME 0], SOME [SOME 1], NONE, SOME [SOME 1, SOME 0, SOME 0]] @{thm prems(3)} @{thm prems(2)} @{thms } - @{thms emp_bound singl_bound term.Un_bound term.card_of_FFVars_bounds infinite_UNIV} - @{thms Res_inject term.FFVars_rrenames} @{thms term.rrename_cong_ids[symmetric]} + @{thms emp_bound singl_bound term.Un_bound term.set_bd_UNIV infinite_UNIV} + @{thms Res_inject term.FVars_permute} @{thms term.permute_cong_id[symmetric]} @{thms id_onD} @{context}\) done @@ -41,7 +41,7 @@ thm cong.strong_induct thm cong.equiv lemma finite_Tsupp: "finite (Tsupp x1 x2)" - by (metis FFVars_commit_simps(5) finite_FFVars_commit finite_Un) + by (metis commit.set(4) finite_FVars_commit finite_Un) lemma exists_fresh: "\ z. z \ set xs \ (z \ Tsupp x1 x2)" @@ -65,18 +65,18 @@ binder_inductive trans subgoal for R B \ x1 x2 apply simp apply (elim disj_forward exE) - apply (auto simp: isPerm_def term.rrename_comps + apply (auto simp: isPerm_def term.permute_comp | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl) | ((rule exI[of _ "\ _"])+; auto))+ - by (metis cong.equiv bij_imp_inv' term.rrename_bijs term.rrename_inv_simps) + by (metis cong.equiv bij_imp_inv' term.permute_bij term.permute_inv_simp) subgoal premises prems for R B P Q by (tactic \refreshability_tac false [@{term "FFVars :: trm \ var set"}, @{term "FFVars :: trm \ var set"}] [@{term "rrename :: (var \ var) \ trm \ trm"}, @{term "(\f x. f x) :: (var \ var) \ var \ var"}] [SOME [NONE, NONE, NONE, SOME 1, SOME 0], NONE, SOME [SOME 0, SOME 0, SOME 1], NONE] @{thm prems(3)} @{thm prems(2)} @{thms } - @{thms emp_bound singl_bound term.Un_bound term.card_of_FFVars_bounds infinite_UNIV} - @{thms Res_inject Inp_inject term.FFVars_rrenames} @{thms Inp_eq_usub term.rrename_cong_ids[symmetric]} + @{thms emp_bound singl_bound term.Un_bound term.set_bd_UNIV infinite_UNIV} + @{thms Res_inject Inp_inject term.FVars_permute} @{thms Inp_eq_usub term.permute_cong_id[symmetric]} @{thms } @{context}\) done diff --git a/thys/Prelim/Card_Prelim.thy b/thys/Prelim/Card_Prelim.thy index 6bf224c2..e7b7c568 100644 --- a/thys/Prelim/Card_Prelim.thy +++ b/thys/Prelim/Card_Prelim.thy @@ -2,6 +2,11 @@ theory Card_Prelim imports "HOL-Cardinals.Cardinals" "HOL-Library.Countable_Set_Type" "HOL-Library.Infinite_Typeclass" begin +lemma card_of_subset_bound: "\ B \ A ; |A| \ |B| |A - B| bij_betw u A B = bij_betw (inv lemma conversep_def: "conversep r = (\ a b. r b a)" by auto - lemma bij_comp2: "bij u \ bij v \ bij (\a. v (u a))" unfolding o_def[symmetric] using bij_comp by blast @@ -63,6 +62,9 @@ lemma bij_iff1: definition id_on :: "'a set \ ('a \ 'a) \ bool" where "id_on A f \ \ a. a \ A \ f a = a" +lemma id_onI: "(\a. a \ A \ f a = a) \ id_on A f" + unfolding id_on_def by blast + lemma id_on_id[simp,intro!]: "id_on A id" unfolding id_on_def by auto @@ -71,6 +73,9 @@ lemma id_on_insert[simp]: "id_on (insert x A) f \ f x = x \< definition "eq_on A f g \ \ a. a \ A \ f a = g a" +lemma eq_onI: "(\a. a \ A \ f a = g a) \ eq_on A f g" + unfolding eq_on_def by simp + lemma eq_on_refl[simp,intro!]: "eq_on A f f" unfolding eq_on_def by auto lemma eq_on_sym: "eq_on A f g \ eq_on A g f" unfolding eq_on_def by auto @@ -81,6 +86,27 @@ lemma eq_on_mono: "A \ B \ eq_on B f g \ bij g \ eq_on A f g \ eq_on (f ` A) (inv f) (inv g)" + unfolding eq_on_def by (metis image_iff inv_simp1) + +lemma eq_on_inv2: "bij f \ bij g \ eq_on A f g \ eq_on (g ` A) (inv f) (inv g)" + unfolding eq_on_def by (metis image_iff inv_simp1) + +lemma eq_on_comp1: "eq_on A g1 g2 \ eq_on (g1 ` A) f1 f2 \ eq_on A (f1 \ g1) (f2 \ g2)" + unfolding eq_on_def by simp +lemma eq_on_comp2: "eq_on A g1 g2 \ eq_on (g2 ` A) f1 f2 \ eq_on A (f1 \ g1) (f2 \ g2)" + unfolding eq_on_def by simp + +lemma eq_on_image: "eq_on A f g \ f ` A = g ` A" + unfolding eq_on_def by auto + +lemma eq_on_between: "bij f \ bij g \ bij f2 \ bij g2 \ eq_on A f g \ + eq_on B f2 g2 \ (inv g2 \ g) ` A = B \ eq_on A (inv f2 \ f) (inv g2 \ g)" + unfolding eq_on_def by (metis bij_pointE comp_eq_dest_lhs imageI inv_simp1) + +lemma eq_on_inv_f_f: "bij f \ eq_on (f ` A) g1 g2 \ eq_on A (inv f \ g1 \ f) (inv f \ g2 \ f)" + unfolding eq_on_def by simp + (* The support of f: *) definition supp :: "('a \ 'a) => 'a set" where "supp f \ {a . f a \ a}" @@ -329,6 +355,9 @@ lemma id_on_inv: "bij f \ id_on A f \ id_on A (i lemma id_on_antimono: "id_on A f \ B \ A \ id_on B f" unfolding id_on_def by auto +lemma id_on_inv_f_f: "bij f \ id_on (f ` A) g \ id_on A (inv f \ g \ f)" + unfolding id_on_def by simp + lemma rel_set_image: "\ R f A B. rel_set R (f ` A) B = rel_set (\x. R (f x)) A B" "\ R g A B. rel_set R A (g ` B) = rel_set (\x y. R x (g y)) A B" @@ -905,38 +934,68 @@ proof- show ?thesis using 1 2 3 4 5 by blast qed -definition "suppGr f \ {(x, f x) | x. f x \ x}" +lemma extend_id_on: + assumes g: "bij g" "|supp (g::'a \ 'a)| g = id" "g ` B1 \ B1 = {}" + and B: "B2 \ B1" +shows "\f. bij f \ |supp f| eq_on B2 f g \ id_on (A - B2) f \ f \ f = id \ f ` B2 \ B2 = {}" +proof - + define f where "f \ \a. if a \ B2 then g a else (if a \ g ` B2 then inv g a else a)" + have 1: "f \ f = id" unfolding f_def comp_def id_def + apply (rule ext) + subgoal for x + apply (cases "x \ B2") + apply (cases "g x \ B2") + apply (unfold if_P if_not_P) + using g(4) apply (simp add: pointfree_idE) + apply (simp add: g(1)) + apply (cases "x \ g ` B2") + apply (unfold if_P if_not_P) + apply (simp add: g(1) image_in_bij_eq) + apply (rule refl) + done + done + then have 2: "bij f" using o_bij by blast + have 3: "|supp f| B2 = {}" unfolding f_def using g(4,5) B by auto + + show ?thesis using 1 2 3 4 5 6 by blast +qed -lemma supp_incl_suppGr: - "suppGr f \ suppGr g \ supp f \ supp g" - unfolding supp_def suppGr_def by auto +lemma inv_invol: "f \ f = id \ inv f = f" + using inv_unique_comp by blast -lemma extend_id_on': -assumes g: "bij g" "g o g = id" "id_on A g" -and A': "A \ A'" -shows "\f. bij f \ suppGr f \ suppGr g \ id_on A' f" -proof- - define f where "f \ \a. if a \ (A'-A) \ g ` (A' - A) then a else g a" - show ?thesis apply(rule exI[of _ f], intro conjI) - subgoal using g(1) unfolding bij_def inj_def f_def apply safe - subgoal by (metis (mono_tags, opaque_lifting) Un_iff comp_def g(2) id_apply image_iff) - subgoal by auto - subgoal by (smt (verit) \\y x. \\x y. g x = g y \ x = y; surj g; - (if x \ A' - A \ g ` (A' - A) then x else g x) = (if y \ A' - A \ g ` (A' - A) then y else g y)\ - \ x = y\ g(2) image_iff pointfree_idE) . - subgoal unfolding suppGr_def f_def by auto - subgoal using g(3) unfolding id_on_def f_def by auto . +lemma disjoint_invol: + fixes g::"'a \ 'a" + assumes "bij g" "|supp g| B = {}" "g ` A = B" "id_on C g" + shows "\f. bij f \ |supp f| eq_on A f g \ f \ f = id \ id_on C f" +proof - + define f where "f \ \a. if a \ A then g a else (if a \ B then inv g a else a)" + have 1: "f \ f = id" unfolding f_def comp_def id_def + apply (rule ext) + subgoal for x + apply (cases "x \ A") + using assms(1,3,4) apply auto[1] + apply (unfold if_not_P) + apply (cases "x \ B") + apply (unfold if_P if_not_P) + using assms(1,4) apply force + apply (rule refl) + done + done + then have 2: "bij f" using o_bij by blast + have 3: "|supp f| |supp (g::'a \ 'a)| - id_on (A - B1) g \ B2 \ B1 \ g \ g = id \ - \f. bij f \ |supp f| suppGr f \ suppGr g \ id_on (A - B2) f" -apply(drule extend_id_on'[of g "A - B1" "A-B2"]) - subgoal . - subgoal by (meson card_of_diff ordLeq_ordLess_trans) - subgoal by auto - subgoal apply safe subgoal for f apply(rule exI[of _ f]) - subgoal using supp_incl_suppGr[of f g] by (meson card_of_mono1 ordLeq_ordLess_trans) . . . +lemma image_inv_iff: "bij f \ (A = f ` B) = (inv f ` A = B)" + by force end \ No newline at end of file diff --git a/thys/STLC/STLC.thy b/thys/STLC/STLC.thy index bef92a5f..43f6565c 100644 --- a/thys/STLC/STLC.thy +++ b/thys/STLC/STLC.thy @@ -17,13 +17,14 @@ for print_theorems (* unary substitution *) -lemma IImsupp_tvsubst_VVr_empty: "IImsupp_tvsubst tvVVr_tvsubst = {}" - unfolding IImsupp_tvsubst_def terms.SSupp_VVr_empty UN_empty Un_empty_left +lemma IImsupp_terms_VVr_empty: "IImsupp_terms tvVVr_tvsubst = {}" + unfolding IImsupp_terms_def terms.SSupp_VVr_empty UN_empty Un_empty_left apply (rule refl) done lemma tvsubst_VVr_func: "tvsubst tvVVr_tvsubst t = t" - apply (rule terms.TT_plain_co_induct) + apply (rule terms.TT_fresh_induct) + apply (rule emp_bound) subgoal for x apply (rule case_split[of "tvisVVr_tvsubst (terms_ctor x)"]) apply (unfold tvisVVr_tvsubst_def)[1] @@ -36,14 +37,8 @@ lemma tvsubst_VVr_func: "tvsubst tvVVr_tvsubst t = t" apply (rule trans) apply (rule terms.tvsubst_cctor_not_isVVr) apply (rule terms.SSupp_VVr_bound) - unfolding IImsupp_tvsubst_VVr_empty + unfolding IImsupp_terms_VVr_empty apply (rule Int_empty_right) - unfolding noclash_terms_def Int_Un_distrib Un_empty - apply (rule conjI) - apply (rule iffD2[OF disjoint_iff], rule allI, rule impI, assumption) - apply (rule iffD2[OF disjoint_iff], rule allI, rule impI) - unfolding UN_iff Set.bex_simps - apply (rule ballI) apply assumption+ apply (rule arg_cong[of _ _ terms_ctor]) apply (rule trans) @@ -61,13 +56,13 @@ lemma singl_bound: "|{a}| 'a terms" - shows "|SSupp_tvsubst (f (a:=t))| |SSupp_tvsubst f| |SSupp_terms f| b = d)" proof assume "App a b = App c d" then show "a = c \ b = d" - unfolding App_def fun_eq_iff terms.TT_injects0 + unfolding App_def fun_eq_iff terms.TT_inject0 map_terms_pre_def comp_def Abs_terms_pre_inverse[OF UNIV_I] map_sum_def sum.case prod.map_id Abs_terms_pre_inject[OF UNIV_I UNIV_I] by blast @@ -88,24 +83,24 @@ lemma Var_inject[simp]: "(Var a = Var b) = (a = b)" apply (rule iffI[rotated]) apply (rule arg_cong[of _ _ Var]) apply assumption - unfolding Var_def terms.TT_injects0 map_terms_pre_def comp_def map_sum_def sum.case Abs_terms_pre_inverse[OF UNIV_I] + unfolding Var_def terms.TT_inject0 map_terms_pre_def comp_def map_sum_def sum.case Abs_terms_pre_inverse[OF UNIV_I] id_def Abs_terms_pre_inject[OF UNIV_I UNIV_I] sum.inject apply (erule exE conjE)+ apply assumption done lemma Abs_inject: "(Abs x \ e = Abs x' \' e') = (\f. bij f \ |supp (f::'a::var_terms_pre \ 'a)| id_on (FFVars_terms (Abs x \ e)) f \ f x = x' \ \ = \' \ rrename_terms f e = e')" + \ id_on (FVars_terms (Abs x \ e)) f \ f x = x' \ \ = \' \ permute_terms f e = e')" unfolding terms.set - unfolding Abs_def terms.TT_injects0 map_terms_pre_def comp_def Abs_terms_pre_inverse[OF UNIV_I] + unfolding Abs_def terms.TT_inject0 map_terms_pre_def comp_def Abs_terms_pre_inverse[OF UNIV_I] map_sum_def sum.case map_prod_def prod.case id_def Abs_terms_pre_inject[OF UNIV_I UNIV_I] sum.inject prod.inject set3_terms_pre_def sum_set_simps Union_empty Un_empty_left prod_set_simps cSup_singleton set2_terms_pre_def Un_empty_right UN_single apply (rule refl) done -lemma bij_map_terms_pre: "bij f \ |supp (f::'a::var_terms_pre \ 'a)| bij (map_terms_pre (id::_::var_terms_pre \ _) f (rrename_terms f) id)" +lemma bij_map_terms_pre: "bij f \ |supp (f::'a::var_terms_pre \ 'a)| bij (map_terms_pre (id::_::var_terms_pre \ _) f (permute_terms f) id)" apply (rule iffD2[OF bij_iff]) - apply (rule exI[of _ "map_terms_pre id (inv f) (rrename_terms (inv f)) id"]) + apply (rule exI[of _ "map_terms_pre id (inv f) (permute_terms (inv f)) id"]) apply (frule bij_imp_bij_inv) apply (frule supp_inv_bound) apply assumption @@ -113,16 +108,16 @@ lemma bij_map_terms_pre: "bij f \ |supp (f::'a::var_terms_pre \< apply (rule trans) apply (rule terms_pre.map_comp0[symmetric]) apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp1 terms.rrename_comp0s terms.rrename_id0s + unfolding id_o inv_o_simp1 terms.permute_comp0 terms.permute_id0 apply (rule terms_pre.map_id0) apply (rule trans) apply (rule terms_pre.map_comp0[symmetric]) apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp2 terms.rrename_comp0s terms.rrename_id0s + unfolding id_o inv_o_simp2 terms.permute_comp0 terms.permute_id0 apply (rule terms_pre.map_id0) done -lemma map_terms_pre_inv_simp: "bij f \ |supp (f::'a::var_terms_pre \ 'a)| inv (map_terms_pre (id::_::var_terms_pre \ _) f (rrename_terms f) id) = map_terms_pre id (inv f) (rrename_terms (inv f)) id" +lemma map_terms_pre_inv_simp: "bij f \ |supp (f::'a::var_terms_pre \ 'a)| inv (map_terms_pre (id::_::var_terms_pre \ _) f (permute_terms f) id) = map_terms_pre id (inv f) (permute_terms (inv f)) id" apply (frule bij_imp_bij_inv) apply (frule supp_inv_bound) apply assumption @@ -134,16 +129,16 @@ lemma map_terms_pre_inv_simp: "bij f \ |supp (f::'a::var_terms_p apply (rule trans) apply (rule terms_pre.map_comp0[symmetric]) apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp1 inv_o_simp2 terms.rrename_comp0s terms.rrename_id0s terms_pre.map_id0 + unfolding id_o inv_o_simp1 inv_o_simp2 terms.permute_comp0 terms.permute_id0 terms_pre.map_id0 apply (rule refl)+ done lemma Abs_set3: "terms_ctor v = Abs x \ e \ \x' e'. terms_ctor v = Abs x' \ e' \ x' \ set2_terms_pre v \ e' \ set3_terms_pre v" - unfolding Abs_def terms.TT_injects0 + unfolding Abs_def terms.TT_inject0 apply (erule exE) apply (erule conjE)+ subgoal for f -apply (drule iffD2[OF bij_imp_inv', rotated, of "map_terms_pre id f (rrename_terms f) id"]) +apply (drule iffD2[OF bij_imp_inv', rotated, of "map_terms_pre id f (permute_terms f) id"]) apply (rule bij_map_terms_pre) apply assumption+ apply (rule exI) @@ -152,7 +147,7 @@ apply (drule iffD2[OF bij_imp_inv', rotated, of "map_terms_pre id f (rrename_ter apply (rule exI[of _ "id"]) apply (rule conjI bij_id supp_id_bound id_on_id)+ apply (drule sym) - unfolding terms.rrename_id0s terms_pre.map_id map_terms_pre_inv_simp + unfolding terms.permute_id0 terms_pre.map_id map_terms_pre_inv_simp unfolding map_terms_pre_def comp_def Abs_terms_pre_inverse[OF UNIV_I] map_sum_def sum.case map_prod_def prod.case id_def apply assumption @@ -160,19 +155,17 @@ apply (drule iffD2[OF bij_imp_inv', rotated, of "map_terms_pre id f (rrename_ter unfolding set2_terms_pre_def set3_terms_pre_def comp_def Abs_terms_pre_inverse[OF UNIV_I] sum_set_simps map_sum_def sum.case Union_empty Un_empty_left map_prod_def prod.case prod_set_simps ccpo_Sup_singleton Un_empty_right id_on_def image_single[symmetric] - unfolding terms.FFVars_rrenames[OF bij_imp_bij_inv supp_inv_bound] + unfolding terms.FVars_permute[OF bij_imp_bij_inv supp_inv_bound] unfolding image_single image_set_diff[OF bij_is_inj[OF bij_imp_bij_inv], symmetric] - image_in_bij_eq[OF bij_imp_bij_inv] inv_inv_eq image_in_bij_eq[OF terms.rrename_bijs[OF bij_imp_bij_inv supp_inv_bound]] - terms.rrename_inv_simps[OF bij_imp_bij_inv supp_inv_bound] inv_simp2 - unfolding terms.rrename_comps[OF bij_imp_bij_inv supp_inv_bound] inv_o_simp2 terms.rrename_ids + image_in_bij_eq[OF bij_imp_bij_inv] inv_inv_eq image_in_bij_eq[OF terms.permute_bij[OF bij_imp_bij_inv supp_inv_bound]] + terms.permute_inv_simp[OF bij_imp_bij_inv supp_inv_bound] inv_simp2 + unfolding terms.permute_comp[OF bij_imp_bij_inv supp_inv_bound] inv_o_simp2 terms.permute_id apply (rule conjI bij_imp_bij_inv supp_inv_bound singletonI | assumption)+ done done lemma Abs_avoid: "|A::'a::var_terms_pre set| \x' e'. Abs x \ e = Abs x' \ e' \ x' \ A" - apply (drule terms.TT_fresh_nchotomys[of _ "Abs x \ e"]) - apply (erule exE) - apply (erule conjE) + apply (erule terms.TT_fresh_cases[of _ "Abs x \ e"]) apply (drule sym) apply (frule Abs_set3) apply (erule exE conjE)+ @@ -181,7 +174,7 @@ lemma Abs_avoid: "|A::'a::var_terms_pre set| apply (rule trans) apply (rule sym) apply assumption - apply (rotate_tac 2) + apply (rotate_tac 3) apply assumption apply (drule iffD1[OF disjoint_iff]) apply (erule allE) @@ -218,16 +211,19 @@ inductive Ty :: "('a::var_terms_pre * \) fset \ 'a terms \ map_prod f3 f4 = map_prod (f1 \ f3) (f2 \ f4)" using prod.map_comp by auto +ML \ +Multithreading.parallel_proofs := 0 +\ binder_inductive Ty subgoal for R B \ x1 x2 x3 apply (elim disj_forward) - apply (auto simp: map_prod_comp0 terms.rrename_comps[OF _ _ bij_imp_bij_inv supp_inv_bound] - terms.rrename_ids) + apply (auto simp: map_prod_comp0 terms.permute_comp[OF _ _ bij_imp_bij_inv supp_inv_bound] + terms.permute_id) apply force apply (rule exI) apply (rule conjI) apply (rule refl) - apply (simp add: terms.rrename_comps[OF _ _ bij_imp_bij_inv supp_inv_bound] terms.rrename_ids) + apply (simp add: terms.permute_comp[OF _ _ bij_imp_bij_inv supp_inv_bound] terms.permute_id) unfolding fresh_def by force subgoal for R B x1 x2 x3 apply (rule exI[of _ B]) @@ -281,7 +277,7 @@ lemma Ty_fresh_induct: assumes "|A| \\<^sub>t\<^sub>y e : \" and Ty_Var: "\x \ \. (x, \) |\| \ \ P \ (Var x) \" and Ty_App: "\\ e1 \\<^sub>1 \\<^sub>2 e2. \ \\<^sub>t\<^sub>y e1 : \\<^sub>1 \ \\<^sub>2 \ P \ e1 (\\<^sub>1 \ \\<^sub>2) \ \ \\<^sub>t\<^sub>y e2 : \\<^sub>1 \ P \ e2 \\<^sub>1 \ P \ (App e1 e2) \\<^sub>2" - and Ty_Abs: "\x \ \ e \\<^sub>2. x \ A \ fst ` fset \ \ FFVars_terms (Abs x \ e) \ x \ \ \ \,x:\ \\<^sub>t\<^sub>y e : \\<^sub>2 \ P (\,x:\) e \\<^sub>2 \ P \ (Abs x \ e) (\ \ \\<^sub>2)" + and Ty_Abs: "\x \ \ e \\<^sub>2. x \ A \ fst ` fset \ \ FVars_terms (Abs x \ e) \ x \ \ \ \,x:\ \\<^sub>t\<^sub>y e : \\<^sub>2 \ P (\,x:\) e \\<^sub>2 \ P \ (Abs x \ e) (\ \ \\<^sub>2)" shows "P \ e \" using assms(2) apply (binder_induction \ e \ avoiding: A \ e rule: Ty.strong_induct) using assms by auto @@ -311,7 +307,7 @@ lemma rename_Ty: assumes "bij f" "|supp f| \\<^sub>t\<^sub>y e : \' \ map_prod f id |`| \ \\<^sub>t\<^sub>y vvsubst f e : \'" apply (rule iffI) - apply (unfold terms_vvsubst_rrename[OF assms]) + apply (unfold terms_vvsubst_permute[OF assms]) apply (rule Ty.equiv) apply (rule assms)+ apply assumption @@ -320,8 +316,8 @@ lemma rename_Ty: apply (rule assms) apply (rule supp_inv_bound) apply (rule assms)+ - unfolding terms.rrename_comps[OF assms(1,2) bij_imp_bij_inv[OF assms(1)] supp_inv_bound[OF assms]] - terms.rrename_ids + unfolding terms.permute_comp[OF assms(1,2) bij_imp_bij_inv[OF assms(1)] supp_inv_bound[OF assms]] + terms.permute_id inv_o_simp1[OF assms(1)] terms.map_id map_prod.comp id_o map_prod.id fset.map_comp fset.map_id apply assumption done @@ -425,7 +421,7 @@ apply (rule iffD1[OF fun_cong[OF fun_cong [OF fset.rel_eq]]]) apply (rule singletonI) apply assumption apply (rule trans[rotated]) - apply (rule fun_cong[OF terms_vvsubst_rrename]) + apply (rule fun_cong[OF terms_vvsubst_permute]) apply assumption+ apply (rule terms.map_cong0) apply assumption+ @@ -452,7 +448,7 @@ apply (rule iffD1[OF fun_cong[OF fun_cong [OF fset.rel_eq]]]) lemmas Ty_AbsE' = Ty_AbsE''[unfolded prod_sets_simps] lemma context_invariance: -assumes "\ \\<^sub>t\<^sub>y e : \'" "\x\FFVars_terms e. \\. (x, \) |\| \ \ (x, \) |\| \'" +assumes "\ \\<^sub>t\<^sub>y e : \'" "\x\FVars_terms e. \\. (x, \) |\| \ \ (x, \) |\| \'" shows "\' \\<^sub>t\<^sub>y e : \'" using assms proof (binder_induction \ e \' arbitrary: \' avoiding: \' rule: Ty.strong_induct) case (Ty_Var x \ \ \') @@ -462,7 +458,7 @@ next then show ?case unfolding terms.set by (meson Ty.Ty_App UnI1 UnI2) next case (Ty_Abs x \ \ e \\<^sub>2 \') - then have "\y\FFVars_terms e. \\'. (y, \') |\| \,x:\ \ (y, \') |\| \',x:\" + then have "\y\FVars_terms e. \\'. (y, \') |\| \,x:\ \ (y, \') |\| \',x:\" by (metis DiffI terms.set(3) fimageI finsert_iff fresh_def fst_conv fsts.cases prod_set_simps(1)) moreover have "x \ \'" using Ty_Abs unfolding fresh_def by auto ultimately show ?case using Ty_Abs by (auto intro: Ty.Ty_Abs) @@ -492,7 +488,7 @@ next then show ?case unfolding terms.subst(2)[OF SSupp_upd_VVr_bound, symmetric] . next case (Abs y \\<^sub>1 e \ \) - then have 1: "y \ IImsupp_tvsubst (tvVVr_tvsubst(x:=v))" by (simp add: IImsupp_tvsubst_def SSupp_tvsubst_def) + then have 1: "y \ IImsupp_terms (tvVVr_tvsubst(x:=v))" by (simp add: IImsupp_terms_def SSupp_terms_def) have "y \ fst ` fset (\,x:\')" using Abs(1,2) unfolding fresh_def by auto then obtain \\<^sub>2 where 2: "(\,x:\'),y:\\<^sub>1 \\<^sub>t\<^sub>y e : \\<^sub>2" "\ = (\\<^sub>1 \ \\<^sub>2)" using Abs(5) Ty_AbsE' by metis moreover have "(\,x:\'),y:\\<^sub>1 = (\,y:\\<^sub>1),x:\'" by blast diff --git a/thys/Untyped_Lambda_Calculus/LC.thy b/thys/Untyped_Lambda_Calculus/LC.thy index ea7615e2..f21ab08d 100644 --- a/thys/Untyped_Lambda_Calculus/LC.thy +++ b/thys/Untyped_Lambda_Calculus/LC.thy @@ -40,20 +40,20 @@ abbreviation "VVr \ tvVVr_tvsubst" lemmas VVr_def = tvVVr_tvsubst_def abbreviation "isVVr \ tvisVVr_tvsubst" lemmas isVVr_def = tvisVVr_tvsubst_def -abbreviation "IImsupp \ IImsupp_tvsubst" -lemmas IImsupp_def = IImsupp_tvsubst_def -abbreviation "SSupp \ SSupp_tvsubst" -lemmas SSupp_def = SSupp_tvsubst_def -abbreviation "FFVars \ FFVars_term" +abbreviation "IImsupp \ IImsupp_term" +lemmas IImsupp_def = IImsupp_term_def +abbreviation "SSupp \ SSupp_term" +lemmas SSupp_def = SSupp_term_def +abbreviation "FFVars \ FVars_term" -abbreviation "rrename \ rrename_term" +abbreviation "rrename \ permute_term" (* *) lemma FFVars_tvsubst[simp]: assumes "|SSupp (\ :: var \ trm)| t) = (\ {FFVars (\ x) | x . x \ FFVars t})" apply (binder_induction t avoiding: "IImsupp \" rule: term.strong_induct) - apply (auto simp: IImsupp_def assms intro!: Un_bound UN_bound term.card_of_FFVars_bounds) + apply (auto simp: IImsupp_def assms intro!: Un_bound UN_bound term.set_bd_UNIV) using term.FVars_VVr apply (fastforce simp add: SSupp_def) using term.FVars_VVr apply (auto simp add: SSupp_def) by (smt (verit) singletonD term.FVars_VVr) @@ -64,8 +64,8 @@ by (simp add: finite_card_var fsupp_def supp_def) (* Enabling some simplification rules: *) lemmas term.tvsubst_VVr[simp] term.FVars_VVr[simp] -term.rrename_ids[simp] term.rrename_cong_ids[simp] -term.FFVars_rrenames[simp] +term.permute_id[simp] term.permute_cong_id[simp] +term.FVars_permute[simp] lemma singl_bound: "|{a}| z. (z::var) \ FFVars P \ f z = g z)" -shows "rrename f P = rrename g P" -using assms(5) apply(binder_induction P avoiding: "supp f" "supp g" rule: term.strong_induct) -using assms apply auto by (metis not_in_supp_alt)+ - lemma tvsubst_cong: assumes f: "|SSupp f| z. (z::var) \ FFVars P \ f z = g z)" @@ -139,7 +128,7 @@ shows "tvsubst f P = tvsubst g P" proof- have fg: "|IImsupp f| IImsupp g| b = d)" proof assume "App a b = App c d" then show "a = c \ b = d" - unfolding App_def fun_eq_iff term.TT_injects0 + unfolding App_def fun_eq_iff term.TT_inject0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case prod.map_id Abs_term_pre_inject[OF UNIV_I UNIV_I] by blast @@ -167,16 +156,16 @@ proposition Var_inject[simp]: "(Var a = Var b) = (a = b)" apply (rule iffI[rotated]) apply (rule arg_cong[of _ _ Var]) apply assumption - unfolding Var_def term.TT_injects0 map_term_pre_def comp_def map_sum_def sum.case Abs_term_pre_inverse[OF UNIV_I] + unfolding Var_def term.TT_inject0 map_term_pre_def comp_def map_sum_def sum.case Abs_term_pre_inverse[OF UNIV_I] id_def Abs_term_pre_inject[OF UNIV_I UNIV_I] sum.inject apply (erule exE conjE)+ apply assumption done lemma Lam_inject: "(Lam x e = Lam x' e') = (\f. bij f \ |supp (f::var \ var)| id_on (FFVars_term (Lam x e)) f \ f x = x' \ rrename f e = e')" + \ id_on (FVars_term (Lam x e)) f \ f x = x' \ rrename f e = e')" unfolding term.set - unfolding Lam_def term.TT_injects0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] + unfolding Lam_def term.TT_inject0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case map_prod_def prod.case id_def Abs_term_pre_inject[OF UNIV_I UNIV_I] sum.inject prod.inject set3_term_pre_def sum_set_simps Union_empty Un_empty_left prod_set_simps cSup_singleton set2_term_pre_def Un_empty_right UN_single @@ -185,7 +174,7 @@ lemma Lam_inject: "(Lam x e = Lam x' e') = (\f. bij f \ |supp (f::v lemma Lam_same_inject[simp]: "Lam (x::var) e = Lam x e' \ e = e'" unfolding Lam_inject apply safe -apply(rule term.rrename_cong_ids[symmetric]) +apply(rule term.permute_cong_id[symmetric]) unfolding id_on_def by auto lemma bij_map_term_pre: "bij f \ |supp (f::var \ var)| bij (map_term_pre (id::var \var) f (rrename f) id)" @@ -198,12 +187,12 @@ lemma bij_map_term_pre: "bij f \ |supp (f::var \ var apply (rule trans) apply (rule term_pre.map_comp0[symmetric]) apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp1 term.rrename_comp0s term.rrename_id0s + unfolding id_o inv_o_simp1 term.permute_comp0 term.permute_id0 apply (rule term_pre.map_id0) apply (rule trans) apply (rule term_pre.map_comp0[symmetric]) apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp2 term.rrename_comp0s term.rrename_id0s + unfolding id_o inv_o_simp2 term.permute_comp0 term.permute_id0 apply (rule term_pre.map_id0) done @@ -219,12 +208,12 @@ lemma map_term_pre_inv_simp: "bij f \ |supp (f::var \ \x' e'. term_ctor v = Lam x' e' \ x' \ set2_term_pre v \ e' \ set3_term_pre v" - unfolding Lam_def term.TT_injects0 + unfolding Lam_def term.TT_inject0 apply (erule exE) apply (erule conjE)+ subgoal for f @@ -237,7 +226,7 @@ apply (drule iffD2[OF bij_imp_inv', rotated, of "map_term_pre id f (rrename f) i apply (rule exI[of _ "id"]) apply (rule conjI bij_id supp_id_bound id_on_id)+ apply (drule sym) - unfolding term.rrename_id0s term_pre.map_id map_term_pre_inv_simp + unfolding term.permute_id0 term_pre.map_id map_term_pre_inv_simp unfolding map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case map_prod_def prod.case id_def apply assumption @@ -245,19 +234,17 @@ apply (drule iffD2[OF bij_imp_inv', rotated, of "map_term_pre id f (rrename f) i unfolding set2_term_pre_def set3_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] sum_set_simps map_sum_def sum.case Union_empty Un_empty_left map_prod_def prod.case prod_set_simps ccpo_Sup_singleton Un_empty_right id_on_def image_single[symmetric] - unfolding term.FFVars_rrenames[OF bij_imp_bij_inv supp_inv_bound] + unfolding term.FVars_permute[OF bij_imp_bij_inv supp_inv_bound] unfolding image_single image_set_diff[OF bij_is_inj[OF bij_imp_bij_inv], symmetric] - image_in_bij_eq[OF bij_imp_bij_inv] inv_inv_eq image_in_bij_eq[OF term.rrename_bijs[OF bij_imp_bij_inv supp_inv_bound]] - term.rrename_inv_simps[OF bij_imp_bij_inv supp_inv_bound] inv_simp2 - unfolding term.rrename_comps[OF bij_imp_bij_inv supp_inv_bound] inv_o_simp2 term.rrename_ids + image_in_bij_eq[OF bij_imp_bij_inv] inv_inv_eq image_in_bij_eq[OF term.permute_bij[OF bij_imp_bij_inv supp_inv_bound]] + term.permute_inv_simp[OF bij_imp_bij_inv supp_inv_bound] inv_simp2 + unfolding term.permute_comp[OF bij_imp_bij_inv supp_inv_bound] inv_o_simp2 term.permute_id apply (rule conjI bij_imp_bij_inv supp_inv_bound singletonI | assumption)+ done done lemma Lam_avoid: "|A::var set| \x' e'. Lam x e = Lam x' e' \ x' \ A" - apply (drule term.TT_fresh_nchotomys[of _ "Lam x e"]) - apply (erule exE) - apply (erule conjE) + apply (erule term.TT_fresh_cases[of _ "Lam x e"]) apply (drule sym) apply (frule Lam_set3) apply (erule exE conjE)+ @@ -266,7 +253,7 @@ lemma Lam_avoid: "|A::var set| \x' apply (rule trans) apply (rule sym) apply assumption - apply (rotate_tac 2) + apply (rotate_tac 3) apply assumption apply (drule iffD1[OF disjoint_iff]) apply (erule allE) @@ -277,8 +264,8 @@ lemma Lam_avoid: "|A::var set| \x' lemma Lam_rrename: "bij (\::var\var) \ |supp \| - (\a'. a' \FFVars_term e - {a::var} \ \ a' = a') \ Lam a e = Lam (\ a) (rrename \ e)" -by (metis term.permute(3) term.rrename_cong_ids term.set(3)) + (\a'. a' \FVars_term e - {a::var} \ \ a' = a') \ Lam a e = Lam (\ a) (rrename \ e)" +by (metis term.permute(3) term.permute_cong_id term.set(3)) (* Bound properties (needed as auxiliaries): *) @@ -379,7 +366,7 @@ using SSupp_upd_Var_bound . lemma IImsupp_rrename_update_su: assumes s[simp]: "bij (\::var\var)" "|supp \| \ Var(x := e)) \ - imsupp \ \ {x} \ FFVars_term e" + imsupp \ \ {x} \ FVars_term e" unfolding IImsupp_def SSupp_def imsupp_def supp_def by (auto split: if_splits) lemma IImsupp_rrename_update_bound: @@ -473,7 +460,7 @@ proof- note SSupp_rrename_update_bound[OF assms, unfolded comp_def, simplified, simp] note SSupp_update_rrename_bound[unfolded fun_upd_def, simplified, simp] show ?thesis - apply(induct e1 rule: term.fresh_induct[where A = "{x} \ FFVars_term e2 \ imsupp \"]) + apply(induct e1 rule: term.fresh_induct[where A = "{x} \ FVars_term e2 \ imsupp \"]) subgoal by (meson Un_bound imsupp_supp_bound infinite_var s(2) singl_bound term.set_bd_UNIV) subgoal by auto subgoal by simp @@ -486,11 +473,11 @@ qed (* Unary substitution versus swapping: *) lemma tvsubst_refresh: -assumes xx: "xx \ FFVars_term e1 - {x}" +assumes xx: "xx \ FVars_term e1 - {x}" shows "tvsubst (Var((x::var) := e2)) e1 = tvsubst (Var(xx := e2)) (rrename (id(x := xx, xx := x)) e1)" proof- show ?thesis using xx - apply(induct e1 rule: term.fresh_induct[where A = "{x,xx} \ FFVars_term e2"]) + apply(induct e1 rule: term.fresh_induct[where A = "{x,xx} \ FVars_term e2"]) subgoal by (metis insert_is_Un term.set(1) term.set(2) term.set_bd_UNIV) subgoal by simp subgoal by auto @@ -514,11 +501,10 @@ lemma usub_swap_disj: assumes "{u,v} \ {x,y} = {}" shows "usub (swap t u v) x y = swap (usub t x y) u v" proof- - note term_vvsubst_rrename[simp del] show ?thesis using assms - apply(subst term_vvsubst_rrename[symmetric]) apply auto + apply(subst term_vvsubst_permute[symmetric]) apply auto apply(subst term.map_comp) apply auto - apply(subst term_vvsubst_rrename[symmetric]) apply auto + apply(subst term_vvsubst_permute[symmetric]) apply auto apply(subst term.map_comp) apply auto apply(rule term.map_cong0) using term_pre.supp_comp_bound by auto @@ -527,7 +513,7 @@ qed lemma rrename_o_swap: "rrename (id(y::var := yy, yy := y) o id(x := xx, xx := x)) t = swap (swap t x xx) y yy" -apply(subst term.rrename_comps[symmetric]) +apply(subst term.permute_comp[symmetric]) by auto (* *) @@ -539,10 +525,10 @@ by (auto simp: sw_def) lemma FFVars_swap[simp]: "FFVars (swap t y x) = (\u. sw u x y) ` (FFVars t)" -apply(subst term.FFVars_rrenames) by (auto simp: sw_def) +apply(subst term.FVars_permute) by (auto simp: sw_def) lemma FFVars_swap'[simp]: "{x::var,y} \ FFVars t = {} \ swap t x y = t" -apply(rule term.rrename_cong_ids) by auto +apply(rule term.permute_cong_id) by auto (* *) @@ -550,7 +536,7 @@ lemma Lam_inject_swap: "Lam v t = Lam v' t' \ (v' \ FFVars t \ v' = v) \ swap t v' v = t'" unfolding Lam_inject apply(rule iffI) subgoal unfolding id_on_def apply auto - apply(rule rrename_cong) by auto + apply(rule term.permute_cong) by auto subgoal apply clarsimp apply(rule exI[of _ "id(v':=v,v:=v')"]) unfolding id_on_def by auto . @@ -618,9 +604,8 @@ lemma usub_refresh: assumes "xx \ FFVars t \ xx = x" shows "usub t u x = usub (swap t x xx) u xx" proof- - note term_vvsubst_rrename[simp del] show ?thesis using assms - apply(subst term_vvsubst_rrename[symmetric]) apply simp + apply(subst term_vvsubst_permute[symmetric]) apply simp subgoal by auto subgoal apply(subst term.map_comp) subgoal by auto @@ -632,11 +617,11 @@ qed lemma swap_commute: "{y,yy} \ {x,xx} = {} \ swap (swap t y yy) x xx = swap (swap t x xx) y yy" -apply(subst term.rrename_comps) +apply(subst term.permute_comp) apply auto -apply(subst term.rrename_comps) +apply(subst term.permute_comp) apply auto -apply(rule rrename_cong) +apply(rule term.permute_cong) by (auto simp: term_pre.supp_comp_bound) @@ -647,24 +632,24 @@ term "permutFvars (\f t. rrename t f) FFVars" lemma swappingFvars_swap_FFVars: "swappingFvars swap FFVars" unfolding swappingFvars_def apply auto - apply (metis id_swapTwice rrename_o_swap term.rrename_ids) + apply (metis id_swapTwice rrename_o_swap term.permute_id) using sw_invol2 apply metis by (metis (no_types, lifting) image_iff sw_invol2) lemma nswapping_swap: "nswapping swap" unfolding nswapping_def apply auto -apply (metis id_swapTwice rrename_o_swap term.rrename_ids) +apply (metis id_swapTwice rrename_o_swap term.permute_id) by (metis id_swapTwice2 rrename_o_swap) lemma permutFvars_rrename_FFVar: "permutFvars (\t f. rrename f (t::trm)) FFVars" unfolding permutFvars_def apply auto - apply (simp add: finite_iff_le_card_var fsupp_def supp_def term.rrename_comps) + apply (simp add: finite_iff_le_card_var fsupp_def supp_def term.permute_comp) apply (simp add: finite_iff_le_card_var fsupp_def supp_def) apply (simp add: finite_iff_le_card_var fsupp_def image_in_bij_eq supp_def) . lemma permut_rrename: "permut (\t f. rrename f (t::trm))" unfolding permut_def apply auto -by (simp add: finite_iff_le_card_var fsupp_def supp_def term.rrename_comps) +by (simp add: finite_iff_le_card_var fsupp_def supp_def term.permute_comp) lemma toSwp_rrename: "toSwp (\t f. rrename f t) = swap" by (meson toSwp_def) @@ -807,9 +792,9 @@ proof- using il unfolding Lam_inject by auto have ff': "rrename f e = rrename f' e'" - unfolding f_def f'_def ge unfolding f_def f'_def using g apply(subst term.rrename_comps) + unfolding f_def f'_def ge unfolding f_def f'_def using g apply(subst term.permute_comp) subgoal by auto subgoal by auto subgoal by auto subgoal by auto - subgoal apply(rule rrename_cong) using g + subgoal apply(rule term.permute_cong) using g subgoal by auto subgoal by auto subgoal by auto subgoal using term_pre.supp_comp_bound by auto subgoal using term_pre.supp_comp_bound z unfolding id_on_def by auto . . @@ -835,7 +820,7 @@ proof- next case (Lam x t) then show ?case using LLam - by simp (metis bij_o term.rrename_comps term_pre.supp_comp_bound) + by simp (metis bij_o term.permute_comp term_pre.supp_comp_bound) qed thus ?thesis apply(elim allE[of _ id]) by auto qed @@ -1032,7 +1017,7 @@ next have t1': "t1' = rrename (inv f1' o f1) t" using f1f1' by (metis (mono_tags, lifting) bij_imp_bij_inv f1 f1' - inv_o_simp1 supp_inv_bound term.rrename_comps term.rrename_ids) + inv_o_simp1 supp_inv_bound term.permute_comp term.permute_id) have fvb1': "FVarsB b1' \ FFVars t1'" using Lam2[OF if1', unfolded t1'[symmetric], OF 1(1)] . @@ -1051,7 +1036,7 @@ next have t2': "t2' = rrename (inv f2' o f2) t" using f2f2' by (metis (mono_tags, lifting) bij_imp_bij_inv f2 f2' - inv_o_simp1 supp_inv_bound term.rrename_comps term.rrename_ids) + inv_o_simp1 supp_inv_bound term.permute_comp term.permute_id) have fvb2': "FVarsB b2' \ FFVars t2'" using Lam2[OF if2', unfolded t2'[symmetric], OF 2(1)] . @@ -1072,7 +1057,7 @@ next using f1f1' t1' by auto have rew2: "rrename ff2' (rrename (inv f2' \ f2) t) = rrename f1 t" - by (smt (verit, del_insts) bij_betw_imp_inj_on bij_imp_bij_inv bij_o f1(1) f1(2) f2'(1) f2'(2) f2(1) f2(2) f2f2' ff2'_def o_inv_o_cancel supp_inv_bound term.rrename_comps term_pre.supp_comp_bound) + by (smt (verit, del_insts) bij_betw_imp_inj_on bij_imp_bij_inv bij_o f1(1) f1(2) f2'(1) f2'(2) f2(1) f2(2) f2f2' ff2'_def o_inv_o_cancel supp_inv_bound term.permute_comp term_pre.supp_comp_bound) show "b1 = b2" unfolding 1(3) 2(3) apply(rule LamB_inject_strong'_rev[OF b12', of z _ _ f1' ff2']) diff --git a/thys/Untyped_Lambda_Calculus/LC_Beta.thy b/thys/Untyped_Lambda_Calculus/LC_Beta.thy index 5e2ce323..d6569e61 100644 --- a/thys/Untyped_Lambda_Calculus/LC_Beta.thy +++ b/thys/Untyped_Lambda_Calculus/LC_Beta.thy @@ -4,15 +4,6 @@ theory LC_Beta imports LC "Binders.Generic_Barendregt_Enhanced_Rule_Induction" "Prelim.Curry_LFP" "Prelim.More_Stream" LC_Head_Reduction begin -(* INSTANTIATING THE ABSTRACT SETTING: *) - -(* *) - -abbreviation Tsupp where "Tsupp a b \ FFVars a \ FFVars b" -lemma fresh: "\xx. xx \ Tsupp (t1::trm) t2" - unfolding prod.collapse - by (metis (no_types, lifting) exists_var finite_iff_le_card_var term.Un_bound term.set_bd_UNIV) - inductive step :: "trm \ trm \ bool" where Beta: "step (App (Lam x e1) e2) (tvsubst (Var(x:=e2)) e1)" | AppL: "step e1 e1' \ step (App e1 e2) (App e1' e2)" @@ -22,7 +13,7 @@ inductive step :: "trm \ trm \ bool" where binder_inductive step subgoal for \ R B t \ \equivariance\ by (elim disj_forward case_prodE) - (auto simp: isPerm_def term.rrename_comps rrename_tvsubst_comp + (auto simp: isPerm_def term.permute_comp rrename_tvsubst_comp | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl) | ((rule exI[of _ "\ _"])+; auto))+ subgoal premises prems for R B t1 t2 \ \refreshability\ @@ -31,249 +22,13 @@ binder_inductive step [@{term "rrename :: (var \ var) \ trm \ trm"}, @{term "(\f x. f x) :: (var \ var) \ var \ var"}] [SOME [SOME 1, SOME 0, NONE], NONE, NONE, SOME [SOME 0, SOME 0, SOME 1]] @{thm prems(3)} @{thm prems(2)} @{thms } - @{thms emp_bound singl_bound term.Un_bound term.card_of_FFVars_bounds infinite} - @{thms Lam_inject} @{thms Lam_eq_tvsubst term.rrename_cong_ids[symmetric]} + @{thms emp_bound singl_bound term.Un_bound term.set_bd_UNIV infinite} + @{thms Lam_inject} @{thms Lam_eq_tvsubst term.permute_cong_id[symmetric]} @{thms } @{context}\) done thm step.strong_induct step.equiv -(* - apply (rule exE[OF eextend_fresh[of B "Tsupp t1 t2" "Tsupp t1 t2 - B"]]) - subgoal apply (rule cut_rl[OF _ prems(3)]) by (auto simp add: emp_bound singl_bound) - subgoal by (simp add: term.Un_bound term.card_of_FFVars_bounds) - subgoal by (simp add: infinite) - subgoal by simp - subgoal by simp - apply (erule conjE)+ - apply (rule exI, rule conjI, assumption) - apply (insert prems(3)) - apply (elim disj_forward exE) - subgoal premises prems2 for xb xaa e1a e2a - apply (rule exI[of _ "xb xaa"]) - apply (rule exI[of _ "rrename xb e1a"]) - apply (rule exI[of _ "e2a"]) - apply (auto simp: Lam_inject prems2 - intro!: id_on_antimono[OF prems2(4)] prems(2) exI[of _ xb] Lam_eq_tvsubst term.rrename_cong_ids[symmetric]) - using prems(4) - apply (auto intro!: id_on_antimono[OF prems(4)] simp: prems) -apply (auto simp: ) - done - subgoal for f e1 e1' e2 - apply (rule exI[of _ "e1"]) - apply (rule exI[of _ "e1'"]) - apply (rule exI[of _ "e2"]) - apply auto - done - subgoal for f e2 e2' e1 - apply (rule exI[of _ "e2"]) - apply (rule exI[of _ "e2'"]) - apply (rule exI[of _ "e1"]) - apply auto - done - subgoal for f e e' x - apply (rule exI[of _ "rrename f e"]) - apply (rule exI[of _ "rrename f e'"]) - apply (rule exI[of _ "f x"]) - apply (auto simp add: Lam_inject id_on_def - intro!: prems(2) exI[of _ f] Lam_eq_tvsubst term.rrename_cong_ids[symmetric]) - done - done -*) - -(* ALTERNATIVE manual instantiation without the automation provided by binder_inductive *) -(* -declare [[inductive_internal]] -inductive step :: "trm \ trm \ bool" where - Beta: "step (App (Lam x e1) e2) (tvsubst (Var(x:=e2)) e1)" binds "{x}" -| AppL: "step e1 e1' \ step (App e1 e2) (App e1' e2)" -| AppR: "step e2 e2' \ step (App e1 e2) (App e1 e2')" -| Xi: "step e e' \ step (Lam x e) (Lam x e')" binds "{x}" - -(* INSTANTIATING THE LSNominalSet LOCALE: *) - -type_synonym T = "trm \ trm" - -definition Tperm :: "(var \ var) \ T \ T" where -"Tperm f \ map_prod (rrename_term f) (rrename_term f)" - -fun Tsupp :: "T \ var set" where -"Tsupp (e1,e2) = FFVars_term e1 \ FFVars_term e2" - - -interpretation LSNominalSet where -Tperm = Tperm and Tsupp = Tsupp -apply standard unfolding isPerm_def Tperm_def - using small_Un small_def term.card_of_FFVars_bounds - apply (auto simp: term.rrename_id0s map_prod.comp term.rrename_comp0s infinite_UNIV) - using var_sum_class.Un_bound by blast - -definition G :: "var set \ (T \ bool) \ T \ bool" -where -"G \ \B R t. - (\x e1 e2. B = {x} \ fst t = App (Lam x e1) e2 \ snd t = tvsubst (Var(x := e2)) e1) - \ - (\e1 e1' e2. B = {} \ fst t = App e1 e2 \ snd t = App e1' e2 \ - R (e1,e1')) - \ - (\e1 e2 e2'. B = {} \ fst t = App e1 e2 \ snd t = App e1 e2' \ - R (e2,e2')) - \ - (\x e e'. B = {x} \ fst t = Lam x e \ snd t = Lam x e' \ R (e,e'))" - - -(* VERIFYING THE HYPOTHESES FOR BARENDREGT-ENHANCED INDUCTION: *) - -lemma G_mono: "R \ R' \ small B \ G B R t \ G B R' t" -unfolding G_def by fastforce - -(* NB: Everything is passed \-renamed as witnesses to exI *) -lemma G_equiv: "isPerm \ \ small B \ G B R t \ G (image \ B) (\t'. R (Tperm (inv \) t')) (Tperm \ t)" - unfolding G_def - by (elim disj_forward exE; cases t) - (auto simp: Tperm_def isPerm_def - term.rrename_comps rrename_tvsubst_comp - | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl) - | ((rule exI[of _ "\ _"])+; auto))+ -(* -unfolding G_def apply(elim disjE) - subgoal apply(rule disjI4_1) - subgoal apply(elim exE) subgoal for x e1 e2 - apply(rule exI[of _ "\ x"]) - apply(rule exI[of _ "rrename_term \ e1"]) - apply(rule exI[of _ "rrename_term \ e2"]) - apply(cases t) unfolding isPerm_def small_def Tperm_def - apply (simp add: term.rrename_comps) apply(subst rrename_tvsubst_comp) by auto . . - (* *) - subgoal apply(rule disjI4_2) - subgoal apply(elim exE) subgoal for e1 e1' e2 - apply(rule exI[of _ "rrename_term \ e1"]) apply(rule exI[of _ "rrename_term \ e1'"]) - apply(rule exI[of _ "rrename_term \ e2"]) - apply(cases t) unfolding isPerm_def small_def Tperm_def - by (simp add: term.rrename_comps) . . - (* *) - subgoal apply(rule disjI4_3) - subgoal apply(elim exE) subgoal for e1 e2 e2' - apply(rule exI[of _ "rrename_term \ e1"]) - apply(rule exI[of _ "rrename_term \ e2"]) apply(rule exI[of _ "rrename_term \ e2'"]) - apply(cases t) unfolding isPerm_def small_def Tperm_def - by (simp add: term.rrename_comps) . . - (* *) - subgoal apply(rule disjI4_4) - subgoal apply(elim exE) subgoal for x e e' - apply(rule exI[of _ "\ x"]) - apply(rule exI[of _ "rrename_term \ e"]) apply(rule exI[of _ "rrename_term \ e'"]) - apply(cases t) unfolding isPerm_def small_def Tperm_def - by (simp add: term.rrename_comps) . . . -*) - -lemma fresh: "\xx. xx \ Tsupp t" -by (metis Lam_avoid Tsupp.elims term.card_of_FFVars_bounds term.set(2)) - -(* NB: The entities affected by variables are passed as witnesses to exI -with x and (the fresh) xx swapped, whereas the non-affected ones are passed -as they are. -*) - -lemma G_refresh: -"(\\ t. isPerm \ \ R t \ R (Tperm \ t)) \ small B \ G B R t \ - \C. small C \ C \ Tsupp t = {} \ G C R t" - using fresh[of t] unfolding G_def Tperm_def -(**)isPerm_def conj_assoc[symmetric] - unfolding ex_push_inwards conj_disj_distribL ex_disj_distrib - by (elim disj_forward exE; simp) - ((rule exI, rule conjI[rotated], assumption) | - (((rule exI conjI)+)?, rule Lam_refresh tvsubst_refresh) | - (cases t; auto))+ -(**) -(* - apply safe - subgoal for xx x e1 e2 - apply(rule exI[of _ "{xx}"]) - apply(intro conjI) - subgoal by simp - subgoal unfolding isPerm_def small_def by auto - subgoal apply(rule disjI4_1) - apply(rule exI[of _ "xx"]) - apply(rule exI[of _ "rrename_term (id(x:=xx,xx:=x)) e1"]) - apply(rule exI[of _ "e2"]) - apply(cases t) apply simp apply(intro conjI) - subgoal apply(subst Lam_rrename[of "id(x:=xx,xx:=x)"]) by auto - subgoal apply(subst tvsubst_Var_rrename) - apply (auto split: if_splits) . . . - (* *) - subgoal for xx e1 e1' e2 - apply(rule exI[of _ "{}"]) - apply(intro conjI) - subgoal by simp - subgoal unfolding isPerm_def small_def by auto - subgoal apply(rule disjI4_2) - apply(rule exI[of _ "e1"]) - apply(rule exI[of _ "e1'"]) - apply(rule exI[of _ "e2"]) - apply(cases t) apply simp . . - (* *) - subgoal for xx e1 e2 e2' - apply(rule exI[of _ "{}"]) - apply(intro conjI) - subgoal by simp - subgoal unfolding isPerm_def small_def by auto - subgoal apply(rule disjI4_3) - apply(rule exI[of _ "e1"]) - apply(rule exI[of _ "e2"]) - apply(rule exI[of _ "e2'"]) - apply(cases t) apply simp . . - (* *) - subgoal for xx x e e' - apply(rule exI[of _ "{xx}"]) - apply(intro conjI) - subgoal by simp - subgoal unfolding isPerm_def small_def by auto - subgoal apply(rule disjI4_4) - apply(rule exI[of _ "xx"]) - apply(rule exI[of _ "rrename_term (id(x:=xx,xx:=x)) e"]) - apply(rule exI[of _ "rrename_term (id(x:=xx,xx:=x)) e'"]) - apply(cases t) apply simp apply(intro conjI) - subgoal apply(subst Lam_rrename[of "id(x:=xx,xx:=x)"]) by auto - subgoal apply(subst Lam_rrename[of "id(x:=xx,xx:=x)"]) by auto - subgoal by (metis supp_swap_bound Prelim.bij_swap isPerm_def) . . . - (* *) -*) - - -(* FINALLY, INTERPRETING THE Induct LOCALE: *) - -interpretation Step: Induct where -Tperm = Tperm and Tsupp = Tsupp and G = G -apply standard - using G_mono G_equiv G_refresh by auto - -(* *) - -lemma step_I: "step t1 t2 = Step.I (t1,t2)" -unfolding step_def Step.I_def lfp_curry2 apply(rule arg_cong2[of _ _ _ _ lfp], simp_all) -unfolding fun_eq_iff G_def apply clarify -subgoal for R tt1 tt2 apply(rule iffI) - subgoal apply(elim disjE exE) - \<^cancel>\Beta: \ - subgoal for x e1 e2 apply(rule exI[of _ "{x}"], rule conjI, simp) apply(rule disjI4_1) by auto - \<^cancel>\AppL: \ - subgoal apply(rule exI[of _ "{}"], rule conjI, simp) apply(rule disjI4_2) by auto - \<^cancel>\AppR: \ - subgoal apply(rule exI[of _ "{}"], rule conjI, simp) apply(rule disjI4_3) by auto - \<^cancel>\Xi: \ - subgoal for e e' x apply(rule exI[of _ "{x}"], rule conjI, simp) apply(rule disjI4_4) by auto . - subgoal apply(elim conjE disjE exE) - \<^cancel>\Beta: \ - subgoal apply(rule disjI4_1) by auto - \<^cancel>\AppL: \ - subgoal apply(rule disjI4_2) by auto - \<^cancel>\AppR: \ - subgoal apply(rule disjI4_3) by auto - \<^cancel>\Xi: \ - subgoal apply(rule disjI4_4) by auto . . . -*) - (* Other properties: *) (* *) diff --git a/thys/Untyped_Lambda_Calculus/LC_Beta_depth.thy b/thys/Untyped_Lambda_Calculus/LC_Beta_depth.thy index 6d6bf1c6..80a98650 100644 --- a/thys/Untyped_Lambda_Calculus/LC_Beta_depth.thy +++ b/thys/Untyped_Lambda_Calculus/LC_Beta_depth.thy @@ -3,16 +3,6 @@ theory LC_Beta_depth imports LC "Binders.Generic_Barendregt_Enhanced_Rule_Induction" "Prelim.Curry_LFP" "Prelim.More_Stream" LC_Head_Reduction begin -(* INSTANTIATING THE ABSTRACT SETTING: *) - -(* *) - -abbreviation Tsupp :: "nat \ trm \ trm \ var set" where -"Tsupp d e1 e2 \ {} \ FFVars_term e1 \ FFVars_term e2" - -lemma fresh: "\xx. xx \ Tsupp d e1 e2" -by (metis Lam_avoid term.card_of_FFVars_bounds term.set(2) Un_empty_left) - inductive stepD :: "nat \ trm \ trm \ bool" where Beta: "stepD 0 (App (Lam x e1) e2) (tvsubst (Var(x:=e2)) e1)" | AppL: "stepD d e1 e1' \ stepD (Suc d) (App e1 e2) (App e1' e2)" @@ -22,7 +12,7 @@ inductive stepD :: "nat \ trm \ trm \ bool" binder_inductive stepD subgoal for R B \ x1 x2 x3 by (elim disj_forward exE case_prodE) - (auto simp: isPerm_def term.rrename_comps rrename_tvsubst_comp + (auto simp: isPerm_def term.permute_comp rrename_tvsubst_comp | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl) | ((rule exI[of _ "\ _"])+; auto))+ subgoal premises prems for R B d t1 t2 @@ -31,8 +21,8 @@ binder_inductive stepD [@{term "rrename :: (var \ var) \ trm \ trm"}, @{term "(\f x. f x) :: (var \ var) \ var \ var"}] [SOME [SOME 1, SOME 0, NONE], NONE, NONE, SOME [NONE, SOME 0, SOME 0, SOME 1]] @{thm prems(3)} @{thm prems(2)} @{thms } - @{thms emp_bound singl_bound term.Un_bound term.card_of_FFVars_bounds infinite} - @{thms Lam_inject} @{thms Lam_eq_tvsubst term.rrename_cong_ids[symmetric]} + @{thms emp_bound singl_bound term.Un_bound term.set_bd_UNIV infinite} + @{thms Lam_inject} @{thms Lam_eq_tvsubst term.permute_cong_id[symmetric]} @{thms } @{context}\) done diff --git a/thys/Untyped_Lambda_Calculus/LC_Parallel_Beta.thy b/thys/Untyped_Lambda_Calculus/LC_Parallel_Beta.thy index 43564347..eb6e3eaa 100644 --- a/thys/Untyped_Lambda_Calculus/LC_Parallel_Beta.thy +++ b/thys/Untyped_Lambda_Calculus/LC_Parallel_Beta.thy @@ -4,11 +4,6 @@ theory LC_Parallel_Beta imports LC "Binders.Generic_Barendregt_Enhanced_Rule_Induction" "Prelim.Curry_LFP" begin -abbreviation Tsupp where "Tsupp a b \ FFVars a \ FFVars b" - -lemma fresh: "\xx. xx \ Tsupp (t1 :: trm) t2" - by (metis (no_types, lifting) exists_var finite_iff_le_card_var term.Un_bound term.set_bd_UNIV) - inductive pstep :: "trm \ trm \ bool" where Refl: "pstep e e" | App: "pstep e1 e1' \ pstep e2 e2' \ pstep (App e1 e2) (App e1' e2')" @@ -19,7 +14,7 @@ binder_inductive pstep subgoal for \ R B x1 x2 by (elim disj_forward exE) (auto simp: isPerm_def - term.rrename_comps rrename_tvsubst_comp + term.permute_comp rrename_tvsubst_comp | ((rule exI[of _ "\ _"] exI)+, (rule conjI)?, rule refl) | ((rule exI[of _ "\ _"])+; auto))+ subgoal premises prems for R B t1 t2 @@ -28,8 +23,8 @@ binder_inductive pstep [@{term "rrename :: (var \ var) \ trm \ trm"}, @{term "(\f x. f x) :: (var \ var) \ var \ var"}] [NONE, NONE, SOME [SOME 0, SOME 0, SOME 1], SOME [SOME 0, SOME 0, NONE, NONE, SOME 1]] @{thm prems(3)} @{thm prems(2)} @{thms } - @{thms emp_bound singl_bound term.Un_bound term.card_of_FFVars_bounds infinite} - @{thms Lam_inject} @{thms Lam_eq_tvsubst term.rrename_cong_ids[symmetric]} + @{thms emp_bound singl_bound term.Un_bound term.set_bd_UNIV infinite} + @{thms Lam_inject} @{thms Lam_eq_tvsubst term.permute_cong_id[symmetric]} @{thms id_on_antimono} @{context}\) done diff --git a/thys/Untyped_Lambda_Calculus/LC_Primal.thy b/thys/Untyped_Lambda_Calculus/LC_Primal.thy index db41ee24..4228723c 100644 --- a/thys/Untyped_Lambda_Calculus/LC_Primal.thy +++ b/thys/Untyped_Lambda_Calculus/LC_Primal.thy @@ -32,14 +32,14 @@ lemma finite_set_option[simp]: "finite (set_option x)" by (cases x) auto interpretation CComponents where -Tperm = rrename_term and -Tsupp = FFVars_term and +Tperm = permute_term and +Tsupp = FVars_term and Bperm = map_option and Bsupp = set_option and bnd = "pred_option prime_var" and bsmall = "\_. True" apply standard - apply (auto simp add: term.rrename_id0s term.rrename_comp0s term.set_bd_UNIV + apply (auto simp add: term.permute_id0 term.permute_comp0 term.set_bd_UNIV isPerm_def small_def card_set_var option.map_id0 option.map_comp fun_eq_iff option.set_map intro!: option.map_ident_strong finite_card_var) @@ -84,7 +84,7 @@ GG = G by (auto simp: G_def) subgoal for \ R x e unfolding presBnd_alt isPerm_def - by (auto simp: G_def term.rrename_comps) + by (auto simp: G_def term.permute_comp) subgoal by (auto simp: G_def) subgoal for x A B diff --git a/thys/Untyped_Lambda_Calculus/LC_pair.thy b/thys/Untyped_Lambda_Calculus/LC_pair.thy deleted file mode 100644 index baf92f27..00000000 --- a/thys/Untyped_Lambda_Calculus/LC_pair.thy +++ /dev/null @@ -1,1230 +0,0 @@ -theory LC_pair - imports - "HOL-Library.FSet" - "Prelim.FixedCountableVars" - "Prelim.Swapping_vs_Permutation" - "Binders.General_Customization" - "Prelim.More_List" -begin - -(* DATATYPE DECLARTION *) - -declare [[mrbnf_internals]] -binder_datatype 'a "term" = - Var 'a -| App "'a term" "'a term" -| Lam "x::'a \ y::'a" t::"'a term" binds x y in t -for - vvsubst: vvsubst - tvsubst: tvsubst - -(****************************) -(* DATATYPE-SPECIFIC CUSTOMIZATION *) - - -(* Monomorphising: *) -instance var :: var_term_pre apply standard - using Field_natLeq infinite_iff_card_of_nat infinite_var - by (auto simp add: regularCard_var) - -instance var::cinf -apply standard - subgoal apply(rule exI[of _ "inv Variable"]) - by (simp add: bij_Variable bij_is_inj) - subgoal using infinite_var . . - -type_synonym trm = "var term" - -(* Some lighter notations: *) -abbreviation "VVr \ tvVVr_tvsubst" -lemmas VVr_def = tvVVr_tvsubst_def -abbreviation "isVVr \ tvisVVr_tvsubst" -lemmas isVVr_def = tvisVVr_tvsubst_def -abbreviation "IImsupp \ IImsupp_tvsubst" -lemmas IImsupp_def = IImsupp_tvsubst_def -abbreviation "SSupp \ SSupp_tvsubst" -lemmas SSupp_def = SSupp_tvsubst_def -abbreviation "FFVars \ FFVars_term" - -abbreviation "rrename \ rrename_term" -(* *) - -lemma FFVars_tvsubst[simp]: - assumes "|SSupp (\ :: var \ trm)| t) = (\ {FFVars (\ x) | x . x \ FFVars t})" - apply (binder_induction t avoiding: "IImsupp \" rule: term.strong_induct) - apply (auto simp: IImsupp_def assms intro!: Un_bound UN_bound term.card_of_FFVars_bounds) - using term.FVars_VVr apply (fastforce simp add: SSupp_def) - using term.FVars_VVr apply (auto simp add: SSupp_def) - by (smt (verit) singletonD term.FVars_VVr) - -lemma fsupp_le[simp]: -"fsupp (\::var\var) \ |supp \| finite A" -using finite_iff_le_card_var by blast - -lemma supp_id_update_le[simp,intro]: -"|supp (id(x := y))| _term_tvsubst_def - by (rule refl) - -(* *) -(* Properties of term-for-variable substitution *) - -lemma tvsubst_VVr_func[simp]: "tvsubst VVr t = t" - apply (rule term.TT_plain_co_induct) - subgoal for x - apply (rule case_split[of "isVVr (term_ctor x)"]) - apply (unfold isVVr_def)[1] - apply (erule exE) - subgoal premises prems for a - unfolding prems - apply (rule term.tvsubst_VVr) - apply (rule term.SSupp_VVr_bound) - done - apply (rule trans) - apply (rule term.tvsubst_cctor_not_isVVr) - apply (rule term.SSupp_VVr_bound) - unfolding IImsupp_VVr_empty - apply (rule Int_empty_right) - unfolding noclash_term_def Int_Un_distrib Un_empty - apply (rule conjI) - apply (rule iffD2[OF disjoint_iff], rule allI, rule impI, assumption) - apply (rule iffD2[OF disjoint_iff], rule allI, rule impI) - unfolding UN_iff Set.bex_simps - apply (rule ballI) - apply assumption+ - apply (rule arg_cong[of _ _ term_ctor]) - apply (rule trans) - apply (rule term_pre.map_cong) - apply (rule supp_id_bound bij_id)+ - apply (assumption | rule refl)+ - unfolding id_def[symmetric] term_pre.map_id - apply (rule refl) - done - done - -proposition rrename_simps[simp]: - assumes "bij (f::var \ var)" "|supp f| z. (z::var) \ FFVars P \ f z = g z)" -shows "rrename f P = rrename g P" -using assms(5) apply(binder_induction P avoiding: "supp f" "supp g" rule: term.strong_induct) -using assms apply auto by (metis not_in_supp_alt)+ - -lemma tvsubst_cong: -assumes f: "|SSupp f| z. (z::var) \ FFVars P \ f z = g z)" -shows "tvsubst f P = tvsubst g P" -proof- - have fg: "|IImsupp f| IImsupp g| b = d)" -proof - assume "App a b = App c d" - then show "a = c \ b = d" - unfolding App_def fun_eq_iff term.TT_injects0 - map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case prod.map_id - Abs_term_pre_inject[OF UNIV_I UNIV_I] - by blast -qed simp - -proposition Var_inject[simp]: "(Var a = Var b) = (a = b)" - apply (rule iffI[rotated]) - apply (rule arg_cong[of _ _ Var]) - apply assumption - unfolding Var_def term.TT_injects0 map_term_pre_def comp_def map_sum_def sum.case Abs_term_pre_inverse[OF UNIV_I] - id_def Abs_term_pre_inject[OF UNIV_I UNIV_I] sum.inject - apply (erule exE conjE)+ - apply assumption - done - -lemma Lam_inject: "(Lam x e = Lam x' e') = (\f. bij f \ |supp (f::var \ var)| id_on (FFVars_term (Lam x e)) f \ f x = x' \ rrename f e = e')" - unfolding term.set - unfolding Lam_def term.TT_injects0 map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] - map_sum_def sum.case map_prod_def prod.case id_def Abs_term_pre_inject[OF UNIV_I UNIV_I] sum.inject prod.inject - set3_term_pre_def sum_set_simps Union_empty Un_empty_left prod_set_simps cSup_singleton set2_term_pre_def - Un_empty_right UN_single - apply (rule refl) - done - -lemma Lam_same_inject[simp]: "Lam (x::var) e = Lam x e' \ e = e'" -unfolding Lam_inject apply safe -apply(rule term.rrename_cong_ids[symmetric]) -unfolding id_on_def by auto - -lemma bij_map_term_pre: "bij f \ |supp (f::var \ var)| bij (map_term_pre (id::var \var) f (rrename f) id)" - apply (rule iffD2[OF bij_iff]) - apply (rule exI[of _ "map_term_pre id (inv f) (rrename (inv f)) id"]) - apply (frule bij_imp_bij_inv) - apply (frule supp_inv_bound) - apply assumption - apply (rule conjI) - apply (rule trans) - apply (rule term_pre.map_comp0[symmetric]) - apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp1 term.rrename_comp0s term.rrename_id0s - apply (rule term_pre.map_id0) - apply (rule trans) - apply (rule term_pre.map_comp0[symmetric]) - apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp2 term.rrename_comp0s term.rrename_id0s - apply (rule term_pre.map_id0) - done - -lemma map_term_pre_inv_simp: "bij f \ |supp (f::var \ var)| inv (map_term_pre (id::_::var_term_pre \ _) f (rrename f) id) = map_term_pre id (inv f) (rrename (inv f)) id" - apply (frule bij_imp_bij_inv) - apply (frule supp_inv_bound) - apply assumption - apply (rule inv_unique_comp) - apply (rule trans) - apply (rule term_pre.map_comp0[symmetric]) - apply (assumption | rule supp_id_bound)+ - defer - apply (rule trans) - apply (rule term_pre.map_comp0[symmetric]) - apply (assumption | rule supp_id_bound)+ - unfolding id_o inv_o_simp1 inv_o_simp2 term.rrename_comp0s term.rrename_id0s term_pre.map_id0 - apply (rule refl)+ - done - -lemma Lam_set3: "term_ctor v = Lam (x::var) e \ \x' e'. term_ctor v = Lam x' e' \ x' \ set2_term_pre v \ e' \ set3_term_pre v" - unfolding Lam_def term.TT_injects0 - apply (erule exE) - apply (erule conjE)+ - subgoal for f -apply (drule iffD2[OF bij_imp_inv', rotated, of "map_term_pre id f (rrename f) id"]) - apply (rule bij_map_term_pre) - apply assumption+ - apply (rule exI) - apply (rule exI) - apply (rule conjI) - apply (rule exI[of _ "id"]) - apply (rule conjI bij_id supp_id_bound id_on_id)+ - apply (drule sym) - unfolding term.rrename_id0s term_pre.map_id map_term_pre_inv_simp - unfolding map_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] map_sum_def sum.case - map_prod_def prod.case id_def - apply assumption - apply (raw_tactic \hyp_subst_tac @{context} 1\) -unfolding set2_term_pre_def set3_term_pre_def comp_def Abs_term_pre_inverse[OF UNIV_I] sum_set_simps - map_sum_def sum.case Union_empty Un_empty_left map_prod_def prod.case prod_set_simps - ccpo_Sup_singleton Un_empty_right id_on_def image_single[symmetric] - unfolding term.FFVars_rrenames[OF bij_imp_bij_inv supp_inv_bound] - unfolding image_single image_set_diff[OF bij_is_inj[OF bij_imp_bij_inv], symmetric] - image_in_bij_eq[OF bij_imp_bij_inv] inv_inv_eq image_in_bij_eq[OF term.rrename_bijs[OF bij_imp_bij_inv supp_inv_bound]] - term.rrename_inv_simps[OF bij_imp_bij_inv supp_inv_bound] inv_simp2 - unfolding term.rrename_comps[OF bij_imp_bij_inv supp_inv_bound] inv_o_simp2 term.rrename_ids - apply (rule conjI bij_imp_bij_inv supp_inv_bound singletonI | assumption)+ - done - done - -lemma Lam_avoid: "|A::var set| \x' e'. Lam x e = Lam x' e' \ x' \ A" - apply (drule term.TT_fresh_nchotomys[of _ "Lam x e"]) - apply (erule exE) - apply (erule conjE) - apply (drule sym) - apply (frule Lam_set3) - apply (erule exE conjE)+ - apply (rule exI)+ - apply (rule conjI) - apply (rule trans) - apply (rule sym) - apply assumption - apply (rotate_tac 2) - apply assumption - apply (drule iffD1[OF disjoint_iff]) - apply (erule allE) - apply (erule impE) - apply assumption - apply assumption - done - -lemma Lam_rrename: -"bij (\::var\var) \ |supp \| - (\a'. a' \FFVars_term e - {a::var} \ \ a' = a') \ Lam a e = Lam (\ a) (rrename \ e)" -by (metis rrename_simps(3) term.rrename_cong_ids term.set(3)) - - -(* Bound properties (needed as auxiliaries): *) - -lemma SSupp_upd_bound: - fixes f::"var \ trm" - shows "|SSupp (f (a:=t))| |SSupp f| | |IImsupp \| | ::var\trm) o \) \ IImsupp \ \ IImsupp \" -unfolding IImsupp_def SSupp_def apply auto -by (metis s singletonD term.set(1) term.subst(1)) - -lemma IImsupp_tvsubst_su': -assumes s[simp]: "|SSupp \| a. tvsubst (\::var\trm) (\ a)) \ IImsupp \ \ IImsupp \" -using IImsupp_tvsubst_su[OF assms] unfolding o_def . - -lemma IImsupp_tvsubst_bound: -assumes s: "|SSupp \| | ::var\trm) o \)| | | ::var\trm) o \)| | | a. tvsubst (\::var\trm) (\ a))| FFVars e \ {x}" -unfolding LC.IImsupp_def LC.SSupp_def by auto - -lemma IImsupp_Var': "y \ x \ y \ FFVars e \ y \ IImsupp (Var(x := e))" -using IImsupp_Var by auto - -lemma IImsupp_rrename_su: -assumes s[simp]: "bij (\::var\var)" "|supp \| ::var\var) o \) \ imsupp \ \ IImsupp \" -unfolding IImsupp_def imsupp_def supp_def SSupp_def by force - -lemma IImsupp_rrename_su': -assumes s[simp]: "bij (\::var\var)" "|supp \| a. rrename (\::var\var) (\ a)) \ imsupp \ \ IImsupp \" -using IImsupp_rrename_su[OF assms] unfolding o_def . - -lemma IImsupp_rrename_bound: -assumes s: "bij (\::var\var)" "|supp \| | ::var\var) o \)| ::var\var)" "|supp \| | ::var\var) o \)| ::var\var)" "|supp \| | a. rrename (\::var\var) (\ a))| (x::var) := rrename \ e))| ::var\var)" "|supp \| \ Var(x := e)) \ - imsupp \ \ {x} \ FFVars_term e" -unfolding IImsupp_def SSupp_def imsupp_def supp_def by (auto split: if_splits) - -lemma IImsupp_rrename_update_bound: -assumes s[simp]: "bij (\::var\var)" "|supp \| \ Var(x := e))| ::var\var)" "|supp \| \ Var(x := e))| {x,xx} \ rrename (id(x := xx, xx := x)) (Var (z::var)) = Var z" -apply(subst rrename_simps(1)) by auto -lemma rrename_swap_Var[simp]: "rrename (id(x := xx, xx := x)) (Var (z::var)) = - Var (if z = x then xx else if z = xx then x else z)" -apply(subst rrename_simps(1)) by auto - -(* Compositionality properties of renaming and term-for-variable substitution *) - -lemma tvsubst_comp: -assumes s[simp]: "|SSupp \| | ::var\trm) (tvsubst \ e) = tvsubst (tvsubst \ \ \) e" -proof- - note SSupp_tvsubst_bound'[OF s, simp] - show ?thesis - apply(induct e rule: term.fresh_induct[where A = "IImsupp \ \ IImsupp \"]) - subgoal using Un_bound[OF s] - using var_ID_class.Un_bound SSupp_IImsupp_bound s(1) s(2) by blast - subgoal by simp - subgoal by simp - subgoal for x t apply(subgoal_tac "x \ IImsupp (\a. tvsubst \ (\ a))") - subgoal by simp - subgoal using IImsupp_tvsubst_su'[OF s(1)] by blast . . -qed - -lemma rrename_tvsubst_comp: -assumes b[simp]: "bij (\::var\var)" and s[simp]: "|supp \| | (tvsubst \ e) = tvsubst (rrename \ \ \) e" -proof- - note SSupp_rrename_bound'[OF b s, simp] - show ?thesis - apply(induct e rule: term.fresh_induct[where A = "IImsupp \ \ imsupp \"]) - subgoal using s(1) s(2) Un_bound SSupp_IImsupp_bound imsupp_supp_bound infinite_var by blast - subgoal by simp - subgoal by simp - subgoal for x t apply simp apply(subgoal_tac "x \ IImsupp (\a. rrename \ (\ a))") - subgoal unfolding imsupp_def supp_def by simp - subgoal using IImsupp_rrename_su' b s(1) by blast . . -qed - - -(* Unary (term-for-var) substitution versus renaming: *) - -lemma supp_SSupp_Var_le[simp]: "SSupp (Var \ \) = supp \" -unfolding supp_def SSupp_def by simp - -lemma rrename_eq_tvsubst_Var: -assumes "bij (\::var\var)" "|supp \| = tvsubst (Var o \)" -proof - fix t - show "rrename \ t = tvsubst (Var o \) t" - proof (binder_induction t avoiding: "IImsupp (Var \ \)" rule: term.strong_induct) - case Bound - then show ?case using assms SSupp_IImsupp_bound by (metis supp_SSupp_Var_le) - next - case (Lam x1 x2) - then show ?case by (simp add: assms IImsupp_def disjoint_iff not_in_supp_alt) - qed (auto simp: assms) -qed - -lemma rrename_eq_tvsubst_Var': -"bij (\::var\var) \ |supp \| rrename \ e = tvsubst (Var o \) e" -using rrename_eq_tvsubst_Var by auto - -(* Equivariance of unary substitution: *) - -lemma tvsubst_rrename_comp[simp]: -assumes s[simp]: "bij (\::var\var)" "|supp \| \ Var(x := e2)) e1 = tvsubst (Var(\ x := rrename \ e2)) (rrename \ e1)" -proof- - note SSupp_rrename_update_bound[OF assms, unfolded comp_def, simplified, simp] - note SSupp_update_rrename_bound[unfolded fun_upd_def, simplified, simp] - show ?thesis - apply(induct e1 rule: term.fresh_induct[where A = "{x} \ FFVars_term e2 \ imsupp \"]) - subgoal by (meson Un_bound imsupp_supp_bound infinite_var s(2) singl_bound term.set_bd_UNIV) - subgoal by auto - subgoal by simp - subgoal for y t apply simp apply(subgoal_tac - "y \ IImsupp ((\a. rrename \ (if a = x then e2 else Var a))) \ - \ y \ IImsupp (\a. if a = \ x then rrename \ e2 else Var a)") - subgoal unfolding imsupp_def supp_def by simp - subgoal unfolding IImsupp_def imsupp_def SSupp_def supp_def by auto . . -qed - -(* Unary substitution versus swapping: *) -lemma tvsubst_refresh: -assumes xx: "xx \ FFVars_term e1 - {x}" -shows "tvsubst (Var((x::var) := e2)) e1 = tvsubst (Var(xx := e2)) (rrename (id(x := xx, xx := x)) e1)" -proof- - show ?thesis using xx - apply(induct e1 rule: term.fresh_induct[where A = "{x,xx} \ FFVars_term e2"]) - subgoal by (metis insert_is_Un term.set(1) term.set(2) term.set_bd_UNIV) - subgoal by simp - subgoal by auto - subgoal for y t apply simp apply(subgoal_tac - "y \ IImsupp (Var(x := e2)) \ y \ IImsupp (Var(xx := e2))") - subgoal unfolding imsupp_def supp_def by auto - subgoal unfolding IImsupp_def imsupp_def SSupp_def supp_def by auto . . -qed - -(* *) - -(* *) - -(* Swapping and unary substitution, as abbreviations: *) -abbreviation "swap t (x::var) y \ rrename (id(x:=y,y:=x)) t" -abbreviation "usub t (y::var) x \ vvsubst (id(x:=y)) t" - -(* *) - -lemma usub_swap_disj: -assumes "{u,v} \ {x,y} = {}" -shows "usub (swap t u v) x y = swap (usub t x y) u v" -proof- - note term_vvsubst_rrename[simp del] - show ?thesis using assms - apply(subst term_vvsubst_rrename[symmetric]) apply auto - apply(subst term.map_comp) apply auto - apply(subst term_vvsubst_rrename[symmetric]) apply auto - apply(subst term.map_comp) apply auto - apply(rule term.map_cong0) - using term_pre.supp_comp_bound by auto -qed - -lemma rrename_o_swap: -"rrename (id(y::var := yy, yy := y) o id(x := xx, xx := x)) t = - swap (swap t x xx) y yy" -apply(subst term.rrename_comps[symmetric]) -by auto - -(* *) - -lemma swap_simps[simp]: "swap (Var z) (y::var) x = Var (sw z y x)" -"swap (App t s) (y::var) x = App(swap t y x) (swap s y x)" -"swap (Lam v t) (y::var) x = Lam (sw v y x) (swap t y x)" -by (auto simp: sw_def) - -lemma FFVars_swap[simp]: "FFVars (swap t y x) = - (\u. sw u x y) ` (FFVars t)" -apply(subst term.FFVars_rrenames) by (auto simp: sw_def) - -lemma FFVars_swap'[simp]: "{x::var,y} \ FFVars t = {} \ swap t x y = t" -apply(rule term.rrename_cong_ids) by auto - -(* *) - -lemma Lam_inject_swap: "Lam v t = Lam v' t' \ - (v' \ FFVars t \ v' = v) \ swap t v' v = t'" -unfolding Lam_inject apply(rule iffI) - subgoal unfolding id_on_def apply auto - apply(rule rrename_cong) by auto - subgoal apply clarsimp - apply(rule exI[of _ "id(v':=v,v:=v')"]) unfolding id_on_def by auto . - -lemma Lam_inject_swap': "Lam v t = Lam v' t' \ - (\z. (z \ FFVars t \ z = v) \ (z \ FFVars t' \ z = v') \ - swap t z v = swap t' z v')" -unfolding Lam_inject_swap apply(rule iffI) - subgoal apply clarsimp apply(rule exI[of _ v']) by auto - subgoal by (smt (verit, del_insts) Lam_inject_swap) . - -lemma Lam_refresh': "v' \ FFVars t \ v' = v \ - Lam v t = Lam v' (swap t v' v)" -using Lam_inject_swap by auto - -lemma Lam_refresh: -"xx \ FFVars t \ xx = x \ Lam x t = Lam xx (swap t x xx)" -by (metis Lam_inject_swap fun_upd_twist) - -(* *) - -lemma FFVars_usub[simp]: "FFVars (usub t y x) = - (if x \ FFVars t then FFVars t - {x} \ {y} else FFVars t)" -apply(subst term.set_map) by auto - -lemma usub_simps_free[simp]: "\y x. usub (Var z) (y::var) x = Var (sb z y x)" -"\y x t s. usub (App t s) (y::var) x = App (usub t y x) (usub s y x)" -by (auto simp: sb_def) - -lemma usub_Lam[simp]: -"v \ {x,y} \ usub (Lam v t) (y::var) x = Lam v (usub t y x)" -apply(subst term.map) - subgoal by auto - subgoal by (auto simp: imsupp_def supp_def) - subgoal by auto . - -lemmas usub_simps = usub_simps_free usub_Lam - -(* *) - -lemma rrename_usub[simp]: -assumes \: "bij \" "|supp \| (usub t u (x::var)) = usub (rrename \ t) (\ u) (\ x)" -using assms -apply(binder_induction t avoiding: "supp \" u x rule: term.strong_induct) -using assms by (auto simp: sb_def) - -lemma sw_sb: -"sw (sb z u x) z1 z2 = sb (sw z z1 z2) (sw u z1 z2) (sw x z1 z2)" -unfolding sb_def sw_def by auto - - -lemma swap_usub: -"swap (usub t (u::var) x) z1 z2 = usub (swap t z1 z2) (sw u z1 z2) (sw x z1 z2)" -apply(binder_induction t avoiding: u x z1 z2 rule: term.strong_induct) - subgoal - apply(subst swap_simps) apply(subst usub_simps) by (auto simp: sb_def) - subgoal apply(subst swap_simps | subst usub_simps)+ by presburger - subgoal apply(subst swap_simps | subst usub_simps)+ - subgoal by auto - subgoal apply(subst swap_simps | subst usub_simps)+ - subgoal unfolding sw_def sb_def by auto - unfolding sw_sb by presburger . . - -lemma usub_refresh: -assumes "xx \ FFVars t \ xx = x" -shows "usub t u x = usub (swap t x xx) u xx" -proof- - note term_vvsubst_rrename[simp del] - show ?thesis using assms - apply(subst term_vvsubst_rrename[symmetric]) apply simp - subgoal by auto - subgoal apply(subst term.map_comp) - subgoal by auto - subgoal by auto - subgoal apply(rule term.map_cong0) - using term_pre.supp_comp_bound by auto . . -qed - -lemma swap_commute: -"{y,yy} \ {x,xx} = {} \ - swap (swap t y yy) x xx = swap (swap t x xx) y yy" -apply(subst term.rrename_comps) -apply auto -apply(subst term.rrename_comps) -apply auto -apply(rule rrename_cong) -by (auto simp: term_pre.supp_comp_bound) - - -(* *) - -term "swappingFvars swap FFVars" -term "permutFvars (\f t. rrename t f) FFVars" - -lemma swappingFvars_swap_FFVars: "swappingFvars swap FFVars" -unfolding swappingFvars_def apply auto - apply (metis id_swapTwice rrename_o_swap term.rrename_ids) - using sw_invol2 apply metis - by (metis (no_types, lifting) image_iff sw_invol2) - -lemma nswapping_swap: "nswapping swap" -unfolding nswapping_def apply auto -apply (metis id_swapTwice rrename_o_swap term.rrename_ids) -by (metis id_swapTwice2 rrename_o_swap) - -lemma permutFvars_rrename_FFVar: "permutFvars (\t f. rrename f (t::trm)) FFVars" -unfolding permutFvars_def apply auto - apply (simp add: finite_iff_le_card_var fsupp_def supp_def term.rrename_comps) - apply (simp add: finite_iff_le_card_var fsupp_def supp_def) - apply (simp add: finite_iff_le_card_var fsupp_def image_in_bij_eq supp_def) . - -lemma permut_rrename: "permut (\t f. rrename f (t::trm))" -unfolding permut_def apply auto -by (simp add: finite_iff_le_card_var fsupp_def supp_def term.rrename_comps) - -lemma toSwp_rrename: "toSwp (\t f. rrename f t) = swap" -by (meson toSwp_def) - -lemma fsupp_supp: "fsupp f \ |supp f| |supp f| toPerm swap t f = rrename f t" -apply(subst toSwp_rrename[symmetric]) -by (simp add: fsupp_supp permut_rrename toPerm_toSwp) - - -(* *) -(* Substitution from a sequence (here, a list) *) - -(* "making" the substitution function that maps each xs_i to es_i; only -meaningful if xs is non-repetitive *) -definition "mkSubst xs es \ \x. if distinct xs \ x \ set xs then nth es (theN xs x) else Var x" - -lemma mkSubst_nth[simp]: "distinct xs \ i < length xs \ mkSubst xs es (nth xs i) = nth es i" -unfolding mkSubst_def by auto - -lemma mkSubst_idle[simp]: "\ distinct xs \ \ x \ set xs \ mkSubst xs es x = Var x" -unfolding mkSubst_def by auto - -lemma card_set_var: "|set xs| set xs" - unfolding SSupp_def by auto (metis mkSubst_idle) - thus ?thesis by (simp add: card_of_subset_bound card_set_var) -qed - -lemma mkSubst_map_rrename: -assumes s: "bij (\::var\var)" "|supp \| xs) (map (rrename \) es2) \ \ = rrename \ \ mkSubst xs es2" -proof(rule ext) - fix x - show "(mkSubst (map \ xs) (map (rrename \) es2) \ \) x = (rrename \ \ mkSubst xs es2) x" - proof(cases "distinct xs \ x \ set xs") - case False - hence F: "\ distinct (map \ xs) \ \ \ x \ set (map \ xs)" - using s by auto - thus ?thesis using F False - unfolding o_def apply(subst mkSubst_idle) - subgoal by auto - subgoal using s by auto . - next - case True - then obtain i where i: "i < length xs" and Tr: "distinct xs" and Tri: "x = nth xs i" by (metis theN) - hence T: "distinct (map \ xs)" and Ti: "\ x = nth (map \ xs) i" - using s by auto - thus ?thesis using T Tr - unfolding o_def Ti apply(subst mkSubst_nth) - subgoal by auto - subgoal using i unfolding Tri by auto - subgoal using l i unfolding Tri by auto . - qed -qed - -lemma mkSubst_map_rrename_inv: -assumes "bij (\::var\var)" "|supp \| xs) (map (rrename \) es2) = rrename \ \ mkSubst xs es2 o inv \" -unfolding mkSubst_map_rrename[OF assms, symmetric] using assms unfolding fun_eq_iff by auto - -lemma card_SSupp_itvsubst_mkSubst_rrename_inv: -"bij (\::var\var) \ |supp \| - length es = length xs \ -|SSupp (tvsubst (rrename \ \ mkSubst xs es \ inv \) \ (Var \ \))| ::var\var) \ |supp \| - length es = length xs \ - |SSupp (rrename \ \ mkSubst xs es \ inv \)| distinct xs \ z \ set xs \ - length es = length xs \ - mkSubst (map f xs) es (f z) = mkSubst xs es z" -by (metis bij_distinct_smap distinct_Ex1 length_map mkSubst_nth nth_map) - - -(* *) - -lemma Lam_eq_tvsubst: -assumes il: "Lam (x::var) e1 = Lam x' e1'" -shows "tvsubst (Var (x:=e2)) e1 = tvsubst (Var (x':=e2)) e1'" -proof- - obtain f where f: "bij f" "|supp f| f. bij f \ |supp f| - id_on (- {x,x'}) f \ id_on (FFVars (Lam x e)) f \ - f x = x' \ rrename f e = e'" -apply(rule exI[of _ "id(x := x', x' := x)"]) -using assms unfolding Lam_inject_swap apply safe -unfolding id_on_def by auto (metis fun_upd_twist) - - -lemma Lam_inject_strong': -assumes il: "Lam (x::var) e = Lam x' e'" and z: "z \ FFVars (Lam x e) \ FFVars (Lam x' e')" -shows -"\f f'. - bij f \ |supp f| id_on (- {x,z}) f \ id_on (FFVars (Lam x e)) f \ f x = z \ - bij f' \ |supp f'| id_on (- {x',z}) f' \ id_on (FFVars (Lam x' e')) f' \ f' x' = z \ - rrename f e = rrename f' e'" -proof- - define f where "f = id(x := z, z := x)" - have f: "bij f \ |supp f| id_on (- {x,z}) f \ id_on (FFVars (Lam x e)) f \ f x = z" - using z unfolding f_def id_on_def by auto - define f' where "f' = id(x' := z, z := x')" - have f': "bij f' \ |supp f'| id_on (- {x',z}) f' \ id_on (FFVars (Lam x' e')) f' \ f' x' = z" - using z unfolding f'_def id_on_def by auto - - obtain g where g: "bij g \ |supp g| id_on (FFVars (Lam x e)) g \ g x = x'" and ge: "e' = rrename g e" - using il unfolding Lam_inject by auto - - have ff': "rrename f e = rrename f' e'" - unfolding f_def f'_def ge unfolding f_def f'_def using g apply(subst term.rrename_comps) - subgoal by auto subgoal by auto subgoal by auto subgoal by auto - subgoal apply(rule rrename_cong) using g - subgoal by auto subgoal by auto subgoal by auto - subgoal using term_pre.supp_comp_bound by auto - subgoal using term_pre.supp_comp_bound z unfolding id_on_def by auto . . - - show ?thesis - apply(rule exI[of _ f]) apply(rule exI[of _ f']) - using f f' ff' by auto -qed - -lemma trm_rrename_induct[case_names Var App Lam]: -assumes VVar: "\x. P (Var (x::var))" -and AApp: "\e1 e2. P e1 \ P e2 \ P (App e1 e2)" -and LLam: "\x e. (\f. bij f \ |supp f| P (rrename f e)) \ P (Lam x e)" -shows "P t" -proof- - have "\f. bij f \ |supp f| P (rrename f t)" - proof(induct) - case (Var x) - then show ?case using VVar by auto - next - case (App t1 t2) - then show ?case using AApp by auto - next - case (Lam x t) - then show ?case using LLam - by simp (metis bij_o term.rrename_comps term_pre.supp_comp_bound) - qed - thus ?thesis apply(elim allE[of _ id]) by auto -qed - -(* RECURSOR *) - -locale LC_Rec = -fixes B :: "'b set" -and VarB :: "var \ 'b" -and AppB :: "'b \ 'b \ 'b" -and LamB :: "var \ 'b \ 'b" -and renB :: "(var \ var) \ 'b \ 'b" -and FVarsB :: "'b \ var set" -assumes -(* closedness: *) -VarB_B[simp,intro]: "\x. VarB x \ B" -and -AppB_B[simp,intro]: "\b1 b2. {b1,b2} \ B \ AppB b1 b2 \ B" -and -LamB_B[simp,intro]: "\x b. b \ B \ LamB x b \ B" -and -renB_B[simp]: "\\ b. bij \ \ |supp \| b \ B \ renB \ b \ B" -and -(* proper axioms: *) -renB_id[simp,intro]: "\b. b \ B \ renB id b = b" -and -renB_comp[simp,intro]: "\b \ \. bij \ \ |supp \| - bij \ \ |supp \| b \ B \ renB (\ o \) b = renB \ (renB \ b)" -and -renB_cong[simp]: "\\ b. bij \ \ |supp \| - (\x \ FVarsB b. \ x = x) \ - renB \ b = b" -(* and -NB: This is redundant: -renB_FVarsB[simp]: "\\ x b. bij \ \ |supp \| - x \ FVarsB (renB \ b) \ inv \ x \ FVarsB b" -*) -and -(* *) -renB_VarB[simp]: "\\ x. bij \ \ |supp \| renB \ (VarB x) = VarB (\ x)" -and -renB_AppB[simp]: "\\ b1 b2. bij \ \ |supp \| {b1,b2} \ B \ - renB \ (AppB b1 b2) = AppB (renB \ b1) (renB \ b2)" -and -renB_LamB[simp]: "\\ x b. bij \ \ |supp \| b \ B \ - renB \ (LamB x b) = LamB (\ x) (renB \ b)" -(* *) -and -FVarsB_VarB: "\x. FVarsB (VarB x) \ {x}" -and -FVarsB_AppB: "\b1 b2. {b1,b2} \ B \ FVarsB (AppB b1 b2) \ FVarsB b1 \ FVarsB b2" -and -FVarsB_LamB: "\x b. b \ B \ FVarsB (LamB x b) \ FVarsB b - {x}" -begin - -lemma not_in_FVarsB_LamB: "b \ B \ x \ FVarsB (LamB x b)" -using FVarsB_LamB by auto - -lemma LamB_inject_strong_rev: -assumes bb': "{b,b'} \ B" and -x': "x' = x \ x' \ FVarsB b" and -f: "bij f" "|supp f| = LamB x' b'" apply(subst renB_LamB) using f r bb' by auto - finally show ?thesis . -qed - -lemma LamB_inject_strong'_rev: -assumes bb': "{b,b'} \ B" -and z: "z = x \ z \ FVarsB b" "z = x' \ z \ FVarsB b'" -and f: "bij f" "|supp f| - (\e. H e \ B) \ - (\x. H (Var x) = VarB x) \ - (\e1 e2. H (App e1 e2) = AppB (H e1) (H e2)) \ - (\x e. H (Lam x e) = LamB x (H e)) \ - (\\ e. bij \ \ |supp \| H (rrename \ e) = renB \ (H e)) \ - (\e. FVarsB (H e) \ FFVars e)" - -(* *) - -inductive R where -Var: "R (Var x) (VarB x)" -| -App: "R e1 b1 \ R e2 b2 \ R (App e1 e2) (AppB b1 b2)" -| -Lam: "R e b \ R (Lam x e) (LamB x b)" - -(* *) - -lemma R_Var_elim[simp]: "R (Var x) b \ b = VarB x" -apply safe - subgoal using R.cases by fastforce - subgoal by (auto intro: R.intros) . - -lemma R_App_elim: -assumes "R (App e1 e2) b" -shows "\b1 b2. R e1 b1 \ R e2 b2 \ b = AppB b1 b2" -by (metis App_inject R.simps assms term.distinct(1) term.distinct(4)) - -lemma R_Lam_elim: -assumes "R (Lam x e) b" -shows "\x' e' b'. R e' b' \ Lam x e = Lam x' e' \ b = LamB x' b'" -using assms by (cases rule: R.cases) auto - -lemma R_total: -"\b. R e b" -apply(induct e) by (auto intro: R.intros) - -lemma R_B: -"R e b \ b \ B" -apply(induct rule: R.induct) by auto - -lemma R_main: -"(\b b'. R e b \ R e b' \ b = b') \ - (\b. R e b \ FVarsB b \ FFVars e) \ - (\b f. R e b \ bij f \ |supp f| R (rrename f e) (renB f b))" -proof(induct e rule: trm_rrename_induct) - case (Var x) - then show ?case using FVarsB_VarB by auto -next - case (App e1 e2) - then show ?case apply safe - subgoal by (metis R_App_elim) - subgoal by simp (smt (verit, del_insts) FVarsB_AppB R_App_elim - R_B Un_iff bot.extremum insert_Diff insert_subset) - subgoal apply(drule R_App_elim) - by (smt (verit, del_insts) R.simps R_B bot.extremum insert_subset renB_AppB - rrename_simps(2)) . -next - case (Lam x t) - note Lamm = Lam[rule_format] - note Lam1 = Lamm[THEN conjunct1, rule_format] - note Lam2 = Lamm[THEN conjunct2, THEN conjunct1, rule_format] - note Lam3 = Lamm[THEN conjunct2, THEN conjunct2, rule_format, OF _ _ conjI, OF _ _ _ conjI] - note Lam33 = Lam3[of id, simplified] - - show ?case proof safe - fix b1 b2 assume RLam: "R (Lam x t) b1" "R (Lam x t) b2" - then obtain x1' t1' b1' x2' t2' b2' - where 1: "R t1' b1'" "Lam x t = Lam x1' t1'" "b1 = LamB x1' b1'" - and 2: "R t2' b2'" "Lam x t = Lam x2' t2'" "b2 = LamB x2' b2'" - using R_Lam_elim by metis - - have b12': "{b1',b2'} \ B" - using 1(1,3) 2(1,3) R_B by auto - - have "|{x,x1',x2'} \ FFVars t \ FFVars t1' \ FFVars t2'| {x,x1',x2'} \ FFVars t \ FFVars t1' \ FFVars t2'" - by (meson exists_fresh) - - obtain f1 f1' where - f1: "bij f1" "|supp f1| id_on (FFVars (Lam x t)) f1" and - f1': "bij f1'" "|supp f1'| id_on (FFVars (Lam x1' t1')) f1'" - and z1: "f1 x = z" "f1' x1' = z" - and f1f1': "rrename f1 t = rrename f1' t1'" - using z Lam_inject_strong'[OF 1(2), of z] by auto - - have if1': "bij (inv f1' o f1)" "|supp (inv f1' o f1)| FFVars t1'" - using Lam2[OF if1', unfolded t1'[symmetric], OF 1(1)] . - - obtain f2 f2' where - f2: "bij f2" "|supp f2| id_on (FFVars (Lam x t)) f2" and - f2': "bij f2'" "|supp f2'| id_on (FFVars (Lam x2' t2')) f2'" - and z2: "f2 x = z" "f2' x2' = z" - and f2f2': "rrename f2 t = rrename f2' t2'" - using z Lam_inject_strong'[OF 2(2), of z] by auto - - have if2': "bij (inv f2' o f2)" "|supp (inv f2' o f2)| FFVars t2'" - using Lam2[OF if2', unfolded t2'[symmetric], OF 2(1)] . - - define ff2' where "ff2' = f1 o (inv f2) o f2'" - - have ff2': "bij ff2'" "|supp ff2'| id_on (FFVars (Lam x2' t2')) ff2'" - unfolding ff2'_def using f1 f2 f2' - subgoal by auto - subgoal unfolding ff2'_def using f1 f2 f2' by (simp add: term_pre.supp_comp_bound) - subgoal unfolding ff2'_def using f1 f2 f2' unfolding id_on_def by simp (metis inv_simp1 z1(1) z2(1)) . - - have zz2: "ff2' x2' = z" - by (metis comp_def f2 ff2'_def inv_simp1 z1(1) z2(1) z2(2)) - - have rew1: "rrename f1' (rrename (inv f1' \ f1) t) = rrename f1 t" - using f1f1' t1' by auto - - have rew2: "rrename ff2' (rrename (inv f2' \ f2) t) = rrename f1 t" - by (smt (verit, del_insts) bij_betw_imp_inj_on bij_imp_bij_inv bij_o f1(1) f1(2) f2'(1) f2'(2) f2(1) f2(2) f2f2' ff2'_def o_inv_o_cancel supp_inv_bound term.rrename_comps term_pre.supp_comp_bound) - - show "b1 = b2" unfolding 1(3) 2(3) - apply(rule LamB_inject_strong'_rev[OF b12', of z _ _ f1' ff2']) - subgoal using z fvb1' by auto - subgoal using z fvb2' by auto - subgoal using f1' by auto subgoal using f1' by auto - subgoal using f1' by auto subgoal using z1 by auto - subgoal using ff2' by auto subgoal using ff2' by auto - subgoal using ff2' by auto subgoal using zz2 by auto - subgoal apply(rule Lam1[OF f1(1,2)]) - subgoal using Lam3[OF if1' 1(1)[unfolded t1'] f1'(1,2), unfolded rew1] . - subgoal using Lam3[OF if2' 2(1)[unfolded t2'] ff2'(1,2), unfolded rew2] . . . - (* *) - next - fix b y - assume R: "R (Lam x t) b" and yy: "y \ FVarsB b" - then obtain x' t' b' - where 0: "R t' b'" "Lam x t = Lam x' t'" "b = LamB x' b'" - using R_Lam_elim by metis - - have b': "b' \ B" - using 0(1,3) R_B by auto - - have y: "y \ x'" "y \ FVarsB b'" using b' yy unfolding 0 - using FVarsB_LamB[OF b'] by auto - - have "|{x,x'} \ FFVars t \ FFVars t'| {x,x'} \ FFVars t \ FFVars t'" - by (meson exists_fresh) - - obtain f where - f: "bij f" "|supp f| id_on (FFVars (Lam x t)) f" - and z: "f x = x'" - and t': "t' = rrename f t" - using Lam_inject_strong[OF 0(2)] by auto - - have fvb't': "FVarsB b' \ FFVars t'" - using Lam2[OF f(1,2), unfolded t'[symmetric], OF 0(1)] . - have yt': "y \ FFVars t'" using fvb't' y(2) by auto - - show "y \ FFVars (Lam x t)" using yt' y unfolding 0(2) by auto - (* *) - next - fix b and f :: "var\var" - - assume "R (Lam x t) b" and f: "bij f" "|supp f| B" - using 0(1,3) R_B by auto - - have "|{x,x'} \ FFVars t \ FFVars t'| {x,x'} \ FFVars t \ FFVars t'" - by (meson exists_fresh) - - obtain g where - g: "bij g" "|supp g| id_on (FFVars (Lam x t)) g" - and z: "g x = x'" - and t': "t' = rrename g t" - using Lam_inject_strong[OF 0(2)] by auto - - have RR: "R (Lam (f x') (rrename f t')) (LamB (f x') (renB f b'))" - apply(rule R.Lam) unfolding t' apply(rule Lam3) - subgoal by fact subgoal by fact - subgoal using 0(1) unfolding t' . - subgoal by fact subgoal by fact . - - show "R (rrename f (Lam x t)) (renB f b)" - unfolding 0 using RR apply(subst rrename_simps) - subgoal using f by auto subgoal using f by auto - subgoal apply(subst renB_LamB) - using f b' by auto . - qed -qed - -lemmas R_functional = R_main[THEN conjunct1] -lemmas R_FFVars = R_main[THEN conjunct2, THEN conjunct1] -lemmas R_subst = R_main[THEN conjunct2, THEN conjunct2] - -definition H :: "trm \ 'b" where "H t \ SOME d. R t d" - -lemma R_F: "R t (H t)" -by (simp add: R_total H_def someI_ex) - -lemma ex_morFromTrm: "\H. morFromTrm H" -apply(rule exI[of _ H]) unfolding morFromTrm_def apply(intro conjI) - subgoal using R_B R_F by auto - subgoal using R.Var R_F R_functional by blast - subgoal using R.App R_F R_functional by blast - subgoal using R.Lam R_F R_functional by blast - subgoal by (meson R_F R_functional R_subst) - subgoal by (simp add: R_F R_FFVars) . - -definition rec where "rec \ SOME H. morFromTrm H" - -lemma morFromTrm_rec: "morFromTrm rec" -by (metis ex_morFromTrm rec_def someI_ex) - -lemma rec_B[simp,intro!]: "rec e \ B" -using morFromTrm_rec unfolding morFromTrm_def by auto - -lemma rec_Var[simp]: "rec (Var x) = VarB x" -using morFromTrm_rec unfolding morFromTrm_def by auto - -lemma rec_App[simp]: "rec (App e1 e2) = AppB (rec e1) (rec e2)" -using morFromTrm_rec unfolding morFromTrm_def by auto - -lemma rec_Lam[simp]: "rec (Lam x e) = LamB x (rec e)" -using morFromTrm_rec unfolding morFromTrm_def by auto - -lemma rec_rrename: "bij \ \ |supp \| - rec (rrename \ e) = renB \ (rec e)" -using morFromTrm_rec unfolding morFromTrm_def by auto - -lemma FVarsB_rec: "FVarsB (rec e) \ FFVars e" -using morFromTrm_rec unfolding morFromTrm_def by auto - -lemma rec_unique: -assumes "\e. H e \ B" -"\x. H (Var x) = VarB x" -"\e1 e2. H (App e1 e2) = AppB (H e1) (H e2)" -"\x e. H (Lam x e) = LamB x (H e)" -shows "H = rec" -apply(rule ext) subgoal for e apply(induct e) -using assms by auto . - - -end (* context LC_Rec *) - - - - - -end