From 8da6bd70b42e70e9dc423080943fe5e21afb8a4d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Jan=20van=20Br=C3=BCgge?= Date: Tue, 26 Nov 2024 18:10:12 +0000 Subject: [PATCH] Do not create a class if the bound is natLeq --- .github/workflows/build_theories.yml | 2 +- Tools/binder_inductive.ML | 22 +- Tools/mrbnf_comp.ML | 60 +-- Tools/mrbnf_def.ML | 185 ++++---- Tools/mrbnf_vvsubst.ML | 8 +- Tools/parser.ML | 3 + operations/Greatest_Fixpoint.thy | 100 ++--- operations/Least_Fixpoint.thy | 332 +++++++------- operations/Least_Fixpoint2.thy | 90 ++-- operations/Recursor.thy | 174 ++++---- operations/Sugar.thy | 34 +- operations/TVSubst.thy | 196 ++++----- operations/VVSubst.thy | 168 ++++--- thys/Infinitary_FOL/InfFOL.thy | 11 +- thys/Infinitary_Lambda_Calculus/ILC.thy | 36 +- .../ILC_UBeta_depth.thy | 2 +- .../ILC_uniform.thy | 2 +- .../PrettyPrinting.thy | 414 ------------------ thys/MRBNF_Recursor.thy | 2 +- thys/POPLmark/Labeled_FSet.thy | 66 +-- thys/POPLmark/SystemFSub.thy | 20 +- thys/Pi_Calculus/Commitment.thy | 8 +- thys/Pi_Calculus/Pi.thy | 21 +- thys/Pi_Calculus/Pi_Transition_Common.thy | 6 +- thys/Pi_Calculus/Pi_Transition_Early.thy | 2 +- thys/Pi_Calculus/Pi_cong.thy | 3 +- thys/Prelim/Card_Prelim.thy | 50 ++- thys/Prelim/FixedCountableVars.thy | 28 +- thys/STLC/STLC.thy | 44 +- thys/Untyped_Lambda_Calculus/LC.thy | 355 ++++++++------- 30 files changed, 1006 insertions(+), 1438 deletions(-) delete mode 100644 thys/Infinitary_Lambda_Calculus/PrettyPrinting.thy diff --git a/.github/workflows/build_theories.yml b/.github/workflows/build_theories.yml index 764eb674..1a995cb5 100644 --- a/.github/workflows/build_theories.yml +++ b/.github/workflows/build_theories.yml @@ -15,7 +15,7 @@ jobs: build: runs-on: ubuntu-latest container: - image: jvanbruegge/isabelle:2024-inductive + image: jvanbruegge/isabelle:2024-bnf_lift options: "--user root" if: github.event_name != 'pull_request' || !github.event.pull_request.draft diff --git a/Tools/binder_inductive.ML b/Tools/binder_inductive.ML index af85c04e..137f144c 100644 --- a/Tools/binder_inductive.ML +++ b/Tools/binder_inductive.ML @@ -298,10 +298,6 @@ fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = (mk_image (hd gs) $ (s $ x)) )))) perms supps xs; - val inf_UNIV_goals = map (fn T => HOLogic.mk_Trueprop (HOLogic.mk_not ( - Const (@{const_name finite}, T --> @{typ bool}) $ HOLogic.mk_UNIV (HOLogic.dest_setT T) - ))) bind_Ts; - val supp_small_goals = map2 (fn x => fn (s, _) => Logic.all x (HOLogic.mk_Trueprop ( mk_ordLess (mk_card_of (s $ x)) (mk_card_of (HOLogic.mk_UNIV (HOLogic.dest_setT (hd bind_Ts)))) ))) xs supps; @@ -506,7 +502,7 @@ fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = fun lookup name = the_single (#thms (the ( Facts.lookup context facts (Facts.intern facts name) ))); - in (lookup "Un_bound", lookup "UN_bound", lookup "large") end; + in (lookup "Un_bound", lookup "UN_bound", lookup "large'") end; fun set_bd_UNIVs_of_mr_bnfs (Inr (Inr sugar)) = maps #card_of_FVars_bound_UNIVs (#quotient_fps sugar) | set_bd_UNIVs_of_mr_bnfs x = @@ -515,22 +511,18 @@ fun binder_inductive_cmd ((pred_name, binds_opt), perms_supps) no_defs_lthy = | Inr (Inl bnf) => BNF_Def.set_bd_of_bnf bnf in map (fn thm => @{thm ordLess_ordLeq_trans} OF [thm]) thms end + fun UNIV_cinfinite_of_mr_bnf (Inl mrbnf) = [MRBNF_Def.UNIV_cinfinite_of_mrbnf mrbnf] + | UNIV_cinfinite_of_mr_bnf (Inr (Inr sugar)) = [MRBNF_Def.UNIV_cinfinite_of_mrbnf (hd (#pre_mrbnfs sugar))] + | UNIV_cinfinite_of_mr_bnf _ = [] + val infinite_UNIVs = map (fn thm => @{thm cinfinite_imp_infinite} OF [thm]) (maps UNIV_cinfinite_of_mr_bnf (flat mr_bnfs)); + val supp_smalls = prove_missing supp_small_goals supps_specified supp_smalls (fn ctxt => fn mr_bnfs => K (EVERY1 [ REPEAT_DETERM o resolve_tac ctxt ( @{thms emp_bound ordLeq_refl card_of_Card_order} @ [Un_bound, UN_bound, var_large] - @ maps set_bd_UNIVs_of_mr_bnfs mr_bnfs + @ maps set_bd_UNIVs_of_mr_bnfs mr_bnfs @ infinite_UNIVs ) ])); - fun UNIV_cinfinite_of_mr_bnf (Inl mrbnf) = [MRBNF_Def.UNIV_cinfinite_of_mrbnf mrbnf] - | UNIV_cinfinite_of_mr_bnf (Inr (Inr sugar)) = [MRBNF_Def.UNIV_cinfinite_of_mrbnf (hd (#pre_mrbnfs sugar))] - | UNIV_cinfinite_of_mr_bnf _ = [] - - val infinite_UNIVs = map (fn goal => Goal.prove_sorry lthy [] [] goal (fn {context=ctxt, ...} => EVERY1 [ - rtac ctxt @{thm cinfinite_imp_infinite}, - resolve_tac ctxt (maps UNIV_cinfinite_of_mr_bnf (flat mr_bnfs)) - ])) inf_UNIV_goals; - val binder_mr_bnfs = map_filter (fn (s, _) => case MRBNF_Def.mrbnf_of lthy s of SOME mrbnf => SOME (Inl mrbnf) | NONE => (case BNF_Def.bnf_of lthy s of diff --git a/Tools/mrbnf_comp.ML b/Tools/mrbnf_comp.ML index 61f57a72..d2b4137c 100644 --- a/Tools/mrbnf_comp.ML +++ b/Tools/mrbnf_comp.ML @@ -204,9 +204,11 @@ fun clean_compose_mrbnf const_policy qualify binding outer inners (unfold_set, l in ([class], Local_Theory.exit_global lthy) end ) lthy end; - val ((class, coclass), lthy) = lthy - |> mk_class "var_" sort - ||>> mk_class "covar_" cosort; + val ((class, coclass), lthy) = case sort of + @{sort var} => ((@{sort var}, @{sort covar}), lthy) + | _ => lthy + |> mk_class "var_" sort + ||>> mk_class "covar_" cosort; val ((((((oDs, iDss), As), As'), Fs), Bs), names_lthy) = lthy |> mk_TFrees' (map Type.sort_of_atyp (deads_of_mrbnf outer)) @@ -475,7 +477,10 @@ fun clean_compose_mrbnf const_policy qualify binding outer inners (unfold_set, l wit = wit_tac }; - val class_thms = + val class_thms = case bd' of + Const (@{const_name natLeq}, _) => + ((@{sort var}, @{thm var_class.large}, @{thm var_class.regular}), (@{sort covar}, K @{thm covar_class.large})) + | _ => let val ifco = bd_infinite_regular_card_order_of_mrbnf @@ -1409,36 +1414,33 @@ fun seal_mrbnf qualify (unfold_set : unfold_set) b force_out_of_line Ds all_Ds m wit = wit_tac }; - fun mk_class prfx xs f lthy = - (Class_Declaration.class (qualify (Binding.name (prfx ^ Binding.name_of b))) [] xs [] #>> single ##> f ##> Local_Theory.exit_global |> Local_Theory.background_theory_result) lthy - val (class, lthy3) = mk_class "var_" (class_of_mrbnf mrbnf) I lthy; - - val class_thms = class_thms_of_mrbnf mrbnf; - val covar_large' = @{thm ordIso_ordLeq_trans} OF [ - @{thm cardSuc_invar_ordIso[THEN iffD2]} OF [ - @{thm infinite_regular_card_order.Card_order} OF [bd_infinite_regular_card_order], - @{thm infinite_regular_card_order.Card_order} OF [bd_infinite_regular_card_order_of_mrbnf mrbnf], - @{thm ordIso_symmetric} OF [bd_ordIso] - ], - #covar_large class_thms - ] - val (coclass, lthy) = mk_class "covar_" (coclass_of_mrbnf mrbnf) (fn ctxt => - let val subclass_tac = Locale.intro_locales_tac {strict = true, eager = true} ctxt [] - in Class_Declaration.prove_subclass subclass_tac (the_single class) ctxt end - ) lthy3; - - val class_thms = + val (class_thms, lthy) = case mrbnf_bd' of + Const (@{const_name natLeq}, _) => + (((@{sort var}, @{thm var_class.large}, @{thm var_class.regular}), (@{sort covar}, K @{thm covar_class.large})), lthy) + | _ => let + fun mk_class prfx xs f lthy = + (Class_Declaration.class (qualify (Binding.name (prfx ^ Binding.name_of b))) [] xs [] #>> single ##> f ##> Local_Theory.exit_global |> Local_Theory.background_theory_result) lthy + val (class, lthy3) = mk_class "var_" (class_of_mrbnf mrbnf) I lthy; + + val class_thms = class_thms_of_mrbnf mrbnf; + val covar_large' = @{thm ordIso_ordLeq_trans} OF [ + @{thm cardSuc_invar_ordIso[THEN iffD2]} OF [ + @{thm infinite_regular_card_order.Card_order} OF [bd_infinite_regular_card_order], + @{thm infinite_regular_card_order.Card_order} OF [bd_infinite_regular_card_order_of_mrbnf mrbnf], + @{thm ordIso_symmetric} OF [bd_ordIso] + ], + #covar_large class_thms + ] + val (coclass, lthy) = mk_class "covar_" (coclass_of_mrbnf mrbnf) (fn ctxt => + let val subclass_tac = Locale.intro_locales_tac {strict = true, eager = true} ctxt [] + in Class_Declaration.prove_subclass subclass_tac (the_single class) ctxt end + ) lthy3; val var_large' = @{thm ordIso_ordLeq_trans} OF [ @{thm card_of_cong} OF [@{thm ordIso_symmetric} OF [bd_ordIso]], #var_large class_thms ] - in - ( - (class, var_large', #var_regular class_thms), - (coclass, K covar_large') - ) - end + in (((class, var_large', #var_regular class_thms), (coclass, K covar_large')), lthy) end val (mrbnf', lthy') = mrbnf_def Hardly_Inline (user_policy Note_Some) true qualify tacs (SOME all_deads) (SOME class_thms) diff --git a/Tools/mrbnf_def.ML b/Tools/mrbnf_def.ML index 540c8e73..21d21553 100644 --- a/Tools/mrbnf_def.ML +++ b/Tools/mrbnf_def.ML @@ -1282,7 +1282,7 @@ val natLeq_boundN = "natLeq_bound"; val UNIV_cinfiniteN = "UNIV_cinfinite"; val supp_comp_boundN = "supp_comp_bound"; val Un_boundN = "Un_bound"; -val UNION_boundN = "UNION_bound"; +val UNION_boundN = "UN_bound"; val mr_rel_congN = "mr_rel_cong"; val mr_in_relN = "mr_in_rel"; val mr_le_rel_OON = "mr_le_rel_OO"; @@ -1708,7 +1708,10 @@ fun define_mrbnf_consts const_policy fact_policy internal Ds_opt classes_opt map val ((class, var_large, var_regular), (mk_covar_type_class, mk_covar_large), lthy) = case classes_opt of SOME ((class, var_large, var_regular), (coclass, mk_covar_large)) => ((class, unfold_bd_def var_large, var_regular), (K (pair coclass), fn (sort, lthy) => unfold_bd_def' lthy (mk_covar_large (sort, lthy))), lthy) - | NONE => + | NONE => case mrbnf_bd_raw of + Const (@{const_name natLeq}, _) => + ((@{sort var}, @{thm var_class.large}, @{thm var_class.regular}), (K (pair @{sort covar}), K @{thm covar_class.large}), lthy) + | _ => let val (class, lthy) = case sort_opt of SOME class => (class, lthy) @@ -2204,97 +2207,103 @@ fun prepare_def const_policy mk_fact_policy internal qualify prep_typ prep_term covar_large = covar_large }; - val UNIV_cinfinite = + val (UNIV_cinfinite, Un_bound, UNION_bound, lthy) = case class of + @{sort var} => (@{thm var_class.UNIV_cinfinite}, @{thm var_class.Un_bound}, @{thm var_class.UN_bound}, lthy) + | _ => let - val goal = TFree (Name.aT, class) - |> HOLogic.mk_UNIV - |> mk_card_of - |> mk_cinfinite - |> HOLogic.mk_Trueprop; - in - Goal.prove_sorry lthy [] [] goal (fn {context = ctxt, prems = _} => - EVERY1 [rtac ctxt @{thm cinfinite_mono}, rtac ctxt var_large, rtac ctxt conjunct1, - rtac ctxt bd_Cinfinite]) - |> Thm.close_derivation \<^here> - end; - val supp_the_inv_bound = @{thm supp_the_inv_bound_gen} OF - [conjI OF [UNIV_cinfinite, @{thm card_of_Card_order}]]; + val UNIV_cinfinite = + let + val goal = TFree (Name.aT, class) + |> HOLogic.mk_UNIV + |> mk_card_of + |> mk_cinfinite + |> HOLogic.mk_Trueprop; + in + Goal.prove_sorry lthy [] [] goal (fn {context = ctxt, prems = _} => + EVERY1 [rtac ctxt @{thm cinfinite_mono}, rtac ctxt var_large, rtac ctxt conjunct1, + rtac ctxt bd_Cinfinite]) + |> Thm.close_derivation \<^here> + end; - val Un_bound = - let - val (T, Tc) = lthy |> mk_TFrees 1 ||> fst o mk_TFrees' [class] |> apply2 hd; - val (A1, A2) = mk_Frees "A" (map HOLogic.mk_setT [T, T]) lthy |> dest_cons o fst ||> hd; - fun mk_card_bound t = Tc - |> HOLogic.mk_UNIV - |> mk_card_of - |> mk_ordLess (mk_card_of t) - |> HOLogic.mk_Trueprop; - val goal = [A1, A2, mk_union (A1, A2)] - |> map mk_card_bound - |> foldr1 Logic.mk_implies - |> fold_rev Logic.all [A1, A2]; - in - Goal.prove_sorry lthy [] [] goal (fn {context = ctxt, prems = _} => - EVERY1 [rtac ctxt @{thm card_of_Un_ordLess_infinite}, - rtac ctxt (unfold_thms ctxt @{thms cinfinite_def Field_card_of} UNIV_cinfinite), - REPEAT_DETERM_N 2 o assume_tac ctxt]) - |> Thm.close_derivation \<^here> - end; + val Un_bound = + let + val (T, Tc) = lthy |> mk_TFrees 1 ||> fst o mk_TFrees' [class] |> apply2 hd; + val (A1, A2) = mk_Frees "A" (map HOLogic.mk_setT [T, T]) lthy |> dest_cons o fst ||> hd; + fun mk_card_bound t = Tc + |> HOLogic.mk_UNIV + |> mk_card_of + |> mk_ordLess (mk_card_of t) + |> HOLogic.mk_Trueprop; + val goal = [A1, A2, mk_union (A1, A2)] + |> map mk_card_bound + |> foldr1 Logic.mk_implies + |> fold_rev Logic.all [A1, A2]; + in + Goal.prove_sorry lthy [] [] goal (fn {context = ctxt, prems = _} => + EVERY1 [rtac ctxt @{thm card_of_Un_ordLess_infinite}, + rtac ctxt (unfold_thms ctxt @{thms cinfinite_def Field_card_of} UNIV_cinfinite), + REPEAT_DETERM_N 2 o assume_tac ctxt]) + |> Thm.close_derivation \<^here> + end; - val UNION_bound = - let - val ((Ta, Tb), Tc) = lthy - |> mk_TFrees 2 - |>> apsnd hd o dest_cons - ||> hd o fst o mk_TFrees' [class]; - val ((I, A), i) = lthy - |> yield_singleton (mk_Frees "I") (HOLogic.mk_setT Ta) - ||>> yield_singleton (mk_Frees "A") (Ta --> HOLogic.mk_setT Tb) - ||> fst o yield_singleton (mk_Frees "i") Ta; - fun mk_card_bound t = Tc - |> HOLogic.mk_UNIV - |> mk_card_of - |> mk_ordLess (mk_card_of t) - |> HOLogic.mk_Trueprop; - val goal = [mk_card_bound I, - (HOLogic.mk_mem (i, I) |> HOLogic.mk_Trueprop, A $ i |> mk_card_bound) - |> Logic.mk_implies |> Logic.all i, - mk_UNION I (A $ i |> Term.absfree (dest_Free i)) |> mk_card_bound] - |> foldr1 Logic.mk_implies - |> fold_rev Logic.all [I, A]; - val bound_Card_order = thm_instantiate_terms lthy [SOME (HOLogic.mk_UNIV Tc)] - @{thm card_of_Card_order}; - in - Goal.prove_sorry lthy [] [] goal (fn {context = ctxt, prems = _} => - EVERY1 [rtac ctxt @{thm regularCard_UNION}, rtac ctxt bound_Card_order, - rtac ctxt UNIV_cinfinite, rtac ctxt var_regular, assume_tac ctxt, - Goal.assume_rule_tac ctxt]) - |> Thm.close_derivation \<^here> - end; + val UNION_bound = + let + val ((Ta, Tb), Tc) = lthy + |> mk_TFrees 2 + |>> apsnd hd o dest_cons + ||> hd o fst o mk_TFrees' [class]; + val ((I, A), i) = lthy + |> yield_singleton (mk_Frees "I") (HOLogic.mk_setT Ta) + ||>> yield_singleton (mk_Frees "A") (Ta --> HOLogic.mk_setT Tb) + ||> fst o yield_singleton (mk_Frees "i") Ta; + fun mk_card_bound t = Tc + |> HOLogic.mk_UNIV + |> mk_card_of + |> mk_ordLess (mk_card_of t) + |> HOLogic.mk_Trueprop; + val goal = [mk_card_bound I, + (HOLogic.mk_mem (i, I) |> HOLogic.mk_Trueprop, A $ i |> mk_card_bound) + |> Logic.mk_implies |> Logic.all i, + mk_UNION I (A $ i |> Term.absfree (dest_Free i)) |> mk_card_bound] + |> foldr1 Logic.mk_implies + |> fold_rev Logic.all [I, A]; + val bound_Card_order = thm_instantiate_terms lthy [SOME (HOLogic.mk_UNIV Tc)] + @{thm card_of_Card_order}; + in + Goal.prove_sorry lthy [] [] goal (fn {context = ctxt, prems = _} => + EVERY1 [rtac ctxt @{thm regularCard_UNION}, rtac ctxt bound_Card_order, + rtac ctxt UNIV_cinfinite, rtac ctxt var_regular, assume_tac ctxt, + Goal.assume_rule_tac ctxt]) + |> 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; - val lthy = snd (Local_Theory.notes (map (fn (thmN, thm) => ((Binding.name thmN, []), [([thm], [])])) [ - ("Un_bound", Un_bound), - ("UN_bound", UNION_bound), - ("cinfinite", UNIV_cinfinite) - ]) lthy) handle ERROR _ => lthy; - val lthy = snd (Local_Theory.notes (map (fn (thmN, thm) => ((Binding.name thmN, []), [([thm], [])])) [ - ("large", var_large), - ("regular", var_regular) - ]) 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 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; + val lthy = snd (Local_Theory.notes (map (fn (thmN, thm) => ((Binding.name thmN, []), [([thm], [])])) [ + ("Un_bound", Un_bound), + ("UN_bound", UNION_bound), + ("UNIV_cinfinite", UNIV_cinfinite), + ("large'", var_large) + ]) lthy) handle ERROR _ => lthy; + val lthy = snd (Local_Theory.notes (map (fn (thmN, thm) => ((Binding.name thmN, []), [([thm], [])])) [ + ("large", var_large_raw), + ("regular", var_regular) + ]) lthy) handle ERROR _ => lthy; + in Local_Theory.exit_global lthy end + ) lthy; + in (UNIV_cinfinite, Un_bound, UNION_bound, lthy) end; + val supp_the_inv_bound = @{thm supp_the_inv_bound_gen} OF + [conjI OF [UNIV_cinfinite, @{thm card_of_Card_order}]]; val supp_comp_bound = let val Tc = lthy |> fst o mk_TFrees' [class] |> the_single; diff --git a/Tools/mrbnf_vvsubst.ML b/Tools/mrbnf_vvsubst.ML index 3b9dc002..d590f84b 100644 --- a/Tools/mrbnf_vvsubst.ML +++ b/Tools/mrbnf_vvsubst.ML @@ -2157,11 +2157,11 @@ fun mrbnf_of_quotient_fixpoint vvsubst_bs qualify (fp_result : MRBNF_FP_Def_Suga let val vname = short_type_name (fst (dest_Type (#T quot))); val notes = - [(vname ^ "_cctor", [vvsubst_cctor]), - (vname ^ "_vvsubst_permute", [vvsubst_permute]), - (vname ^ "_set_simps", pset_simps) + [("vvsubst_cctor", [vvsubst_cctor]), + ("vvsubst_permute", [vvsubst_permute]), + ("set_ctor_simps", pset_simps) ] |> (map (fn (thmN, thms) => - ((Binding.name thmN, []), [(thms, [])]) + ((Binding.qualify true vname (Binding.name thmN), []), [(thms, [])]) )); in Local_Theory.notes notes lthy end ) (#quotient_fps fp_res) vvsubst_cctors vvsubst_permutes pset_simpss lthy; diff --git a/Tools/parser.ML b/Tools/parser.ML index 1fe4647a..77004b22 100644 --- a/Tools/parser.ML +++ b/Tools/parser.ML @@ -195,6 +195,9 @@ fun create_binder_specs specs lthy = Typedecl.basic_typedecl {final = true} (b, length params, Mixfix.reset_pos mixfix) val (fake_T_names, fake_lthy) = fold_map add_fake_type specs lthy; + val fake_lthy = Local_Theory.type_notation true Syntax.mode_input + [(@{typ "('a, 'b) var_selector"}, Infix (Input.string "::", 999, Position.no_range))] fake_lthy; + val (specs, fake_lthy) = fold_map (create_binder_spec fake_T_names) specs fake_lthy; in snd (MRBNF_Sugar.create_binder_datatype (hd specs) lthy) end; diff --git a/operations/Greatest_Fixpoint.thy b/operations/Greatest_Fixpoint.thy index 20aef0fa..fd7b7e14 100644 --- a/operations/Greatest_Fixpoint.thy +++ b/operations/Greatest_Fixpoint.thy @@ -65,17 +65,17 @@ lemmas infinite_UNIV = cinfinite_imp_infinite[OF term_pre.UNIV_cinfinite] 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" +codatatype ('a::var) 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 +primcorec permute_raw_term :: "('a::var \ '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" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| 'a raw_term \ bool" where +inductive free_raw_term :: "'a::var \ '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 +definition FVars_raw_term :: "'a::var 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 +primrec set_term_level :: "nat \ 'a::var 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 +coinductive alpha_term :: "'a::var 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 ; @@ -123,7 +123,7 @@ coinductive alpha_term :: "'a::var_term_pre raw_term \ 'a raw_term \ 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 +coinductive alpha_term' :: "'a::var 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 ; @@ -139,10 +139,10 @@ coinductive alpha_term' :: "'a::var_term_pre raw_term \ 'a raw_term 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 +definition avoid_raw_term :: "'a::var 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 }" +typedef ('a::var) "term" = "(UNIV::'a raw_term set) // { (x, y). alpha_term x y }" apply (rule exI) apply (rule quotientI) apply (rule UNIV_I) @@ -154,33 +154,33 @@ 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 +definition un_term_ctor :: "'a::var 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 +definition term_ctor :: "'a::var 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 +definition permute_term :: "('a::var \ '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 +definition FVars_term :: "'a::var 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 +definition avoid_term :: "'a::var 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 +definition noclash_raw_term :: "'a::var 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 +definition noclash_term :: "'a::var 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" + fixes lhs rhs::"'a::var 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))" @@ -207,7 +207,7 @@ lemmas permute_raw_id0s = permute_raw_ids[abs_def, unfolded id_def[symmetric], T (* this proof is specific to codatatypes *) lemma permute_raw_comps: - fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + fixes f::"'a::var \ 'a" and g::"'a \ 'a" assumes f_prems: "bij f" "|supp f| g) x" @@ -226,7 +226,7 @@ lemma permute_raw_comps: done lemma permute_raw_comp0s: - fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + fixes f::"'a::var \ 'a" and g::"'a \ 'a" assumes f_prems: "bij f" "|supp f| permute_raw_term g = permute_raw_term (f \ g)" @@ -288,7 +288,7 @@ lemma FVars_raw_ctors: done lemma FVars_raw_permute_leq: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ '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]) @@ -335,7 +335,7 @@ lemma FVars_raw_permute_leq: done lemma FVars_raw_permutes: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes f_prems: "bij f" "|supp f| (x::'a raw_term) y. x = y \ alpha_term x y" @@ -468,7 +468,7 @@ proof - qed lemma alpha_bijs: - fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + fixes f::"'a::var \ '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)" @@ -638,7 +638,7 @@ proof - qed lemma alpha_bij_eqs: - fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + fixes f::"'a::var \ 'a" and g::"'a \ 'a" assumes f_prems: "bij f" "|supp f| 'a" and g::"'a \ 'a" + fixes f::"'a::var \ 'a" and g::"'a \ 'a" assumes f_prems: "bij f" "|supp f| FVars_raw_term x = FVars_ra done lemma alpha_syms: - fixes x::"'a::var_term_pre raw_term" + fixes x::"'a::var raw_term" shows "alpha_term x y \ alpha_term y x" apply (erule alpha_term.coinduct) apply (erule alpha_term.cases) @@ -1184,7 +1184,7 @@ proof - qed lemma raw_refreshs: - fixes x::"('a::covar_term_pre, 'a, 'a, 'a raw_term, 'a raw_term, 'a raw_term) term_pre" + fixes x::"('a::covar, '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)" @@ -1192,8 +1192,8 @@ lemma raw_refreshs: "(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 var_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_class.UN_bound var_class.large' FVars_raw_bd_UNIVs infinite_UNIV )+ apply (rule Un_upper2) apply (rule Diff_disjoint) @@ -1244,7 +1244,7 @@ lemma raw_refreshs: done lemma avoid_raw_freshs: - fixes x::"'a::covar_term_pre raw_term_pre" + fixes x::"'a::covar raw_term_pre" assumes "|A| A = {}" "set3_term_pre (avoid_raw_term x A) \ A = {}" apply (unfold avoid_raw_term_def) @@ -1312,7 +1312,7 @@ lemma TT_abs_ctors: "TT_abs (raw_term_ctor x) = term_ctor (map_term_pre id id id done lemma permute_simps: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| f) x" apply (unfold permute_term_def) @@ -1373,7 +1373,7 @@ lemma permute_comps: done lemma permute_comp0s: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| permute_term f = permute_term (g \ f)" apply (rule ext) @@ -1382,7 +1382,7 @@ lemma permute_comp0s: done lemma permute_bijs: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| (\(g::'a::var_term_pre \ 'a) f2. + "(term_ctor x = term_ctor y) \ (\(g::'a::var \ '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 \ @@ -1582,7 +1582,7 @@ map_term_pre id g g (permute_term g) (permute_term f2) id x = y)" done lemma avoid_freshs: - fixes x::"'a::covar_term_pre term_pre'" + fixes x::"'a::covar term_pre'" assumes "|A| A = {}" "set3_term_pre (avoid_term x A) \ A = {}" apply (unfold avoid_term_def) @@ -1598,7 +1598,7 @@ lemma avoid_freshs: done lemma alpha_avoids: - fixes x::"'a::covar_term_pre term_pre'" + fixes x::"'a::covar 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 @@ -1653,7 +1653,7 @@ lemma fresh_cases: done lemma permute_abs: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| 'a" + fixes f g::"'a::var \ '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) @@ -1722,7 +1722,7 @@ lemma alpha_imp_alpha': "alpha_term x y \ alpha_term' x y" done lemma alpha'_bij_eqs: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| alpha_term' x y" apply (erule alpha_term'.coinduct) @@ -1820,7 +1820,7 @@ lemma alpha'_bij_eqs: done lemma alpha'_bij_eq_invs: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| (\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) @@ -2415,7 +2415,7 @@ lemma existential_coinduct: done lemma fresh_coinduct_param: - fixes K::"'p \ 'a::covar_term_pre set" + fixes K::"'p \ 'a::covar set" assumes rel: "\\\Param. R x y \" and bound: "\\. \ \ Param \ |K \| x y \. R (term_ctor x) (term_ctor y) \ \ diff --git a/operations/Least_Fixpoint.thy b/operations/Least_Fixpoint.thy index 16cf610d..9069ce39 100644 --- a/operations/Least_Fixpoint.thy +++ b/operations/Least_Fixpoint.thy @@ -15,7 +15,7 @@ typ "('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i, 'j, 'k) T2_pre" (************* 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 = +datatype ('a::var, 'b::var, 'c::var, '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 @@ -26,10 +26,10 @@ datatype ('a::"{var_T1_pre,var_T2_pre}", 'b::"{var_T1_pre,var_T2_pre}", 'c::"{va ('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 +primrec permute_raw_T1 :: "('a::var \ 'a) \ ('b::var \ 'b) + \ ('a, 'b, 'c::var, 'd) raw_T1 \ ('a, 'b, 'c::var, 'd) raw_T1" + and permute_raw_T2 :: "('a::var \ 'a) \ ('b::var \ 'b) + \ ('a, 'b, 'c::var, 'd) raw_T2 \ ('a, 'b, 'c::var, '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 ))" @@ -41,7 +41,7 @@ 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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ '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" + free1_raw_T1 :: "'a \ ('a::var, 'b::var, 'c::var, 'd) raw_T1 \ bool" + and free1_raw_T2 :: "'a \ ('a::var, 'b::var, 'c::var, '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)" @@ -82,8 +82,8 @@ inductive | "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" + free2_raw_T1 :: "'b \ ('a::var, 'b::var, 'c::var, 'd) raw_T1 \ bool" + and free2_raw_T2 :: "'b \ ('a::var, 'b::var, 'c::var, '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)" @@ -96,19 +96,19 @@ inductive | "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" +definition FVars_raw_T11 :: "('a::var, 'b::var, 'c::var, '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" +definition FVars_raw_T12 :: "('a::var, 'b::var, 'c::var, '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" +definition FVars_raw_T21 :: "('a::var, 'b::var, 'c::var, '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" +definition FVars_raw_T22 :: "('a::var, 'b::var, 'c::var, '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" +coinductive alpha_T1 :: "('a::var, 'b::var, 'c::var, 'd) raw_T1 \ ('a, 'b, 'c, 'd) raw_T1 \ bool" +and alpha_T2 :: "('a::var, 'b::var, 'c::var, '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 ; @@ -128,13 +128,13 @@ where 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}" +typedef ('a::"var", 'b::"var", 'c::"var", '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}" +typedef ('a::"var", 'b::"var", 'c::"var", '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) @@ -149,28 +149,28 @@ 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" +definition T1_ctor :: "('a, 'b, 'c, 'd) T1' \ ('a::var, 'b::var, 'c::var, '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" +definition T2_ctor :: "('a, 'b, 'c, 'd) T2' \ ('a::var, 'b::var, 'c::var, '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" +definition permute_T1 :: "('a \ 'a) \ ('b \ 'b) \ ('a, 'b, 'c, 'd) T1 \ ('a::var, 'b::var, 'c::var, '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" +definition permute_T2 :: "('a \ 'a) \ ('b \ 'b) \ ('a, 'b, 'c, 'd) T2 \ ('a::var, 'b::var, 'c::var, '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" +definition FVars_T11 :: "('a::var, 'b::var, 'c::var, '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" +definition FVars_T12 :: "('a::var, 'b::var, 'c::var, '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" +definition FVars_T21 :: "('a::var, 'b::var, 'c::var, '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" +definition FVars_T22 :: "('a::var, 'b::var, 'c::var, '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" +inductive subshape_T1_T1 :: "('a, 'b, 'c, 'd) raw_T1 \ ('a::var, 'b::var, 'c::var, '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" @@ -183,25 +183,25 @@ inductive subshape_T1_T1 :: "('a, 'b, 'c, 'd) raw_T1 \ ('a::{var_T1_ 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" +definition noclash_raw_T1 :: "('a::var, 'b::var, 'c::var, '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" +definition noclash_raw_T2 :: "('a::var, 'b::var, 'c::var, '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" +definition noclash_T1 :: "('a::var, 'b::var, 'c::var, '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" +definition noclash_T2 :: "('a::var, 'b::var, 'c::var, '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" + fixes x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, 'd) raw_T2" shows "permute_raw_T1 id id x = x" (is ?P1) "permute_raw_T2 id id x2 = x2" (is ?P2) proof - @@ -237,10 +237,10 @@ 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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" + and g1::"'a::var \ 'a" and g2::"'b::var \ 'b" + and x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, 'd) raw_T2" 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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" + and g1::"'a::var \ 'a" and g2::"'b::var \ '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) 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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" + and x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, 'd) raw_T2" assumes "bij f1" "|supp f1| f1 z \ FVars_raw_T11 (permute_raw_T1 f1 f2 x)" (is "_ \ ?P11") @@ -895,9 +895,9 @@ proof - 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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" + and x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, 'd) raw_T2" assumes "bij f1" "|supp f1| (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)" @@ -1054,10 +1054,10 @@ proof - 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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" + and g1::"'a::var \ 'a" and g2::"'b::var \ 'b" + and x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, 'd) raw_T2" assumes f_prems: "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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" + and x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, '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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" + and x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, '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))" @@ -2747,8 +2747,8 @@ shows 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" + fixes x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, '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))" @@ -3491,8 +3491,8 @@ shows 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" + fixes x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, '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" @@ -3550,8 +3550,8 @@ lemma alpha_FVars: 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" + fixes x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, 'd) raw_T2" shows "alpha_T1 x y \ alpha_T1 y x" "alpha_T2 x2 y2 \ alpha_T2 y2 x2" @@ -3913,8 +3913,8 @@ 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" + fixes x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, '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" @@ -4327,37 +4327,37 @@ proof - 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'" + fixes x::"('a::var, 'b::var, 'c::var, 'd) raw_T1'" + and x2::"('a::var, 'b::var, 'c::var, '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 var_class.Un_bound) apply (rule assms) (* REPEAT_DETERM *) - apply (rule var_T1_pre_class.Un_bound)+ + apply (rule var_class.Un_bound)+ apply (rule ordLeq_ordLess_trans[OF card_of_diff]) - apply (rule var_T1_pre_class.UN_bound)? + apply (rule var_class.UN_bound)? apply (rule ordLess_ordLeq_trans) apply (rule T1_pre.set_bd) - apply (rule var_T1_pre_class.large) + apply (rule var_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 var_class.UN_bound) apply (rule ordLess_ordLeq_trans) apply (rule T1_pre.set_bd) - apply (rule var_T1_pre_class.large) + apply (rule var_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 var_class.UN_bound)? apply (rule ordLess_ordLeq_trans) apply (rule T1_pre.set_bd) - apply (rule var_T1_pre_class.large) + apply (rule var_class.large') apply (rule FVars_raw_bd_UNIVs)? (* repeated *) (* END REPEAT_DETERM *) @@ -4370,15 +4370,15 @@ lemma raw_refreshs: (* 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 var_class.Un_bound) apply (rule assms) (* REPEAT_DETERM *) - apply (rule var_T1_pre_class.Un_bound)? + apply (rule var_class.Un_bound)? apply (rule ordLeq_ordLess_trans[OF card_of_diff]) - apply (rule var_T1_pre_class.UN_bound) + apply (rule var_class.UN_bound) apply (rule ordLess_ordLeq_trans) apply (rule T1_pre.set_bd) - apply (rule var_T1_pre_class.large) + apply (rule var_class.large') apply (rule FVars_raw_bd_UNIVs) (* END REPEAT_DETERM *) apply (rule infinite_UNIV) @@ -4415,29 +4415,29 @@ lemma raw_refreshs: (* 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 var_class.Un_bound) apply (rule assms) - apply (rule var_T1_pre_class.Un_bound)+ + apply (rule var_class.Un_bound)+ (* REPEAT_DETERM *) apply (rule ordLeq_ordLess_trans[OF card_of_diff]) - apply (rule var_T1_pre_class.UN_bound)? + apply (rule var_class.UN_bound)? apply (rule ordLess_ordLeq_trans) apply (rule T2_pre.set_bd) - apply (rule var_T1_pre_class.large) + apply (rule var_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 var_class.UN_bound)? apply (rule ordLess_ordLeq_trans) apply (rule T2_pre.set_bd) - apply (rule var_T1_pre_class.large) + apply (rule var_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 var_class.UN_bound) apply (rule ordLess_ordLeq_trans) apply (rule T2_pre.set_bd) - apply (rule var_T1_pre_class.large) + apply (rule var_class.large') apply (rule FVars_raw_bd_UNIVs) (* END REPEAT_DETERM *) apply (rule infinite_UNIV) @@ -4448,15 +4448,15 @@ lemma raw_refreshs: (* 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 var_class.Un_bound) apply (rule assms) (* REPEAT_DETERM *) - apply (rule var_T1_pre_class.Un_bound)? + apply (rule var_class.Un_bound)? apply (rule ordLeq_ordLess_trans[OF card_of_diff]) - apply (rule var_T1_pre_class.UN_bound) + apply (rule var_class.UN_bound) apply (rule ordLess_ordLeq_trans) apply (rule T2_pre.set_bd) - apply (rule var_T1_pre_class.large) + apply (rule var_class.large') apply (rule FVars_raw_bd_UNIVs) (* END REPEAT_DETERM *) apply (rule infinite_UNIV) @@ -4590,7 +4590,7 @@ lemma TT_abs_ctors: done lemma permute_simps: - fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ '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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" + and g1::"'a::var \ 'a" and g2::"'b::var \ 'b" assumes "bij f1" "|supp f1| 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" assumes "bij f1" "|supp f1| 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ '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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" + and x::"('a::var, 'b::var, 'c::var, 'd) T1" + and x2::"('a::var, 'b::var, 'c::var, 'd) T2" assumes "bij f1" "|supp f1| (f1::('a::{var_T1_pre, var_T2_pre} \ 'a)) (f2::('b::{var_T1_pre, var_T2_pre} \ 'b)). + "(T1_ctor x = T1_ctor y) = (\(f1::('a::var \ 'a)) (f2::('b::var \ '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)). + "(T2_ctor x2 = T2_ctor y2) = (\(f1::('a::var \ 'a)) (f2::('b::var \ '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 @@ -5347,7 +5347,7 @@ lemma TT_inject0s: 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" + fixes y::"('a::var, 'b::var, 'c::var, '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" @@ -5465,7 +5465,7 @@ lemma fresh_cases_T1: 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'" + fixes x2::"('a::var, 'b::var, 'c::var, '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" @@ -5586,8 +5586,8 @@ lemma fresh_cases_T2: 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" + fixes x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, '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" @@ -5838,8 +5838,8 @@ proof - 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" + fixes x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, '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) @@ -6043,8 +6043,8 @@ lemma subshape_induct_raw: 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" + fixes x::"('a::var, 'b::var, 'c::var, 'd) raw_T1" + and x2::"('a::var, 'b::var, 'c::var, '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" @@ -6122,7 +6122,7 @@ lemma wf_subshape: "wf {(x, y). case x of 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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" assumes "bij f1" "|supp f1| set8_T1_pre x \ subshape_T1_T1 (permute_raw_T1 f1 f2 z) (raw_T1_ctor x)" @@ -6219,7 +6219,7 @@ lemma set_subshape_permutess: 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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" assumes "bij f1" "|supp f1| 'a::{var_T1_pre, var_T2_pre} set" - and K2::"'p \ 'b::{var_T1_pre, var_T2_pre} set" + fixes K1::"'p \ 'a::var set" + and K2::"'p \ 'b::var set" assumes "\\. \ \ Param \ |K1 \| \. \ \ Param \ |K2 \| x \. @@ -6578,8 +6578,8 @@ shows "\\\Param. P1 z \ \ P2 z2 \" 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) \ @@ -6607,10 +6607,10 @@ lemma fresh_induct: 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" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" + and g1::"'a::var \ 'a" and g2::"'b::var \ 'b" + and x::"('a::var, 'b::var, 'c::var, 'd) T1" + and x2::"('a::var, 'b::var, 'c::var, 'd) T2" assumes "bij f1" "|supp f1| 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" assumes "bij f1" "|supp f1| (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"}, + } :: ((('a::var, 'b::var, 'c::var, '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_T1 :: _ => ('a::var, 'b::var, 'c::var, 'd) raw_T1 \ _"}, + @{term "subshape_T2_T1 :: _ => ('a::var, 'b::var, 'c::var, '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 \ _"} + [ @{term "subshape_T1_T2 :: _ => ('a::var, 'b::var, 'c::var, 'd) raw_T2 \ _"}, + @{term "subshape_T2_T2 :: _ => ('a::var, 'b::var, 'c::var, 'd) raw_T2 \ _"} ] ], wf_subshape = @{thm wf_subshape}, @@ -6701,15 +6701,15 @@ val fp_res = { fp = BNF_Util.Least_FP, 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"}, + { T = @{typ "('a::var, 'b::var, 'c::var, 'd) T1"}, + ctor = @{term "T1_ctor :: _ \ ('a::var, 'b::var, 'c::var, 'd) T1"}, + permute = @{term "permute_T1 :: _ => _ => _ => ('a::var, 'b::var, 'c::var, '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 \ _"} + @{term "FVars_T11 :: ('a::var, 'b::var, 'c::var, 'd) T1 \ _"}, + @{term "FVars_T12 :: ('a::var, 'b::var, 'c::var, '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' \ _"}, + @{term "noclash_T1 :: ('a::var, 'b::var, 'c::var, 'd) T1' \ _"}, @{thm noclash_T1_def} ), inject = @{thm TT_inject0s(1)}, @@ -6724,8 +6724,8 @@ val fp_res = { fp = BNF_Util.Least_FP, 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 \ _"}, + abs = @{term "TT1_abs :: _ \ ('a::var, 'b::var, 'c::var, 'd) T1"}, + rep = @{term "TT1_rep :: ('a::var, 'b::var, 'c::var, 'd) T1 \ _"}, permute_def = @{thm permute_T1_def}, ctor_def = @{thm T1_ctor_def}, FVars_defs = @{thms FVars_defs(1-2)}, @@ -6743,15 +6743,15 @@ val fp_res = { fp = BNF_Util.Least_FP, 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"}, + { T = @{typ "('a::var, 'b::var, 'c::var, 'd) T2"}, + ctor = @{term "T2_ctor :: _ \ ('a::var, 'b::var, 'c::var, 'd) T2"}, + permute = @{term "permute_T2 :: _ => _ => _ => ('a::var, 'b::var, 'c::var, '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 \ _"} + @{term "FVars_T21 :: ('a::var, 'b::var, 'c::var, 'd) T2 \ _"}, + @{term "FVars_T22 :: ('a::var, 'b::var, 'c::var, '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' \ _"}, + @{term "noclash_T2 :: ('a::var, 'b::var, 'c::var, 'd) T2' \ _"}, @{thm noclash_T2_def} ), inject = @{thm TT_inject0s(2)}, @@ -6766,8 +6766,8 @@ val fp_res = { fp = BNF_Util.Least_FP, 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 \ _"}, + abs = @{term "TT2_abs :: _ \ ('a::var, 'b::var, 'c::var, 'd) T2"}, + rep = @{term "TT2_rep :: ('a::var, 'b::var, 'c::var, 'd) T2 \ _"}, ctor_def = @{thm T2_ctor_def}, permute_def = @{thm permute_T2_def}, FVars_defs = @{thms FVars_defs(3-4)}, @@ -6787,15 +6787,15 @@ val fp_res = { fp = BNF_Util.Least_FP, } ], 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"}, + { T = @{typ "('a::var, 'b::var, 'c::var, 'd) raw_T1"}, + ctor = @{term "raw_T1_ctor :: _ \ ('a::var, 'b::var, 'c::var, 'd) raw_T1"}, + permute = @{term "permute_raw_T1 :: _ => _ => _ => ('a::var, 'b::var, 'c::var, '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 \ _"} + @{term "FVars_raw_T11 :: ('a::var, 'b::var, 'c::var, 'd) raw_T1 \ _"}, + @{term "FVars_raw_T12 :: ('a::var, 'b::var, 'c::var, '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' \ _"}, + @{term "noclash_raw_T1 :: ('a::var, 'b::var, 'c::var, 'd) raw_T1' \ _"}, @{thm noclash_raw_T1_def} ), inject = @{thm raw_T1.inject}, @@ -6810,7 +6810,7 @@ val fp_res = { fp = BNF_Util.Least_FP, 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 \ _ \ _"}, + alpha = @{term "alpha_T1 :: ('a::var, 'b::var, 'c::var, 'd) raw_T1 \ _ \ _"}, exhaust = @{thm raw_T1.exhaust}, alpha_refl = @{thm alpha_refls(1)}, alpha_sym = @{thm alpha_syms(1)}, @@ -6823,15 +6823,15 @@ val fp_res = { fp = BNF_Util.Least_FP, 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"}, + { T = @{typ "('a::var, 'b::var, 'c::var, 'd) raw_T2"}, + ctor = @{term "raw_T2_ctor :: _ \ ('a::var, 'b::var, 'c::var, 'd) raw_T2"}, + permute = @{term "permute_raw_T2 :: _ => _ => _ => ('a::var, 'b::var, 'c::var, '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 \ _"} + @{term "FVars_raw_T21 :: ('a::var, 'b::var, 'c::var, 'd) raw_T2 \ _"}, + @{term "FVars_raw_T22 :: ('a::var, 'b::var, 'c::var, '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' \ _"}, + @{term "noclash_raw_T2 :: ('a::var, 'b::var, 'c::var, 'd) raw_T2' \ _"}, @{thm noclash_raw_T2_def} ), inject = @{thm raw_T2.inject}, @@ -6846,7 +6846,7 @@ val fp_res = { fp = BNF_Util.Least_FP, 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 \ _ \ _"}, + alpha = @{term "alpha_T2 :: ('a::var, 'b::var, 'c::var, 'd) raw_T2 \ _ \ _"}, exhaust = @{thm raw_T2.exhaust}, alpha_refl = @{thm alpha_refls(2)}, alpha_sym = @{thm alpha_syms(2)}, diff --git a/operations/Least_Fixpoint2.thy b/operations/Least_Fixpoint2.thy index 41dc2e0f..275cb1f2 100644 --- a/operations/Least_Fixpoint2.thy +++ b/operations/Least_Fixpoint2.thy @@ -65,15 +65,15 @@ lemmas infinite_UNIV = cinfinite_imp_infinite[OF term_pre.UNIV_cinfinite] typ "('a, 'b1, 'b2, 'brec1, 'brec2, 'rec) term_pre" -datatype ('a::var_term_pre) raw_term = raw_term_ctor "('a, 'a, 'a, 'a raw_term, 'a raw_term, 'a raw_term) term_pre" +datatype ('a::var) raw_term = raw_term_ctor "('a, 'a, 'a, 'a raw_term, 'a raw_term, 'a raw_term) term_pre" -primrec permute_raw_term :: "('a::var_term_pre \ 'a) \ 'a raw_term \ 'a raw_term" where +primrec permute_raw_term :: "('a::var \ 'a) \ 'a raw_term \ 'a raw_term" where "permute_raw_term f (raw_term_ctor x) = raw_term_ctor (map_term_pre f f f id id id ( map_term_pre id id id (permute_raw_term f) (permute_raw_term f) (permute_raw_term f) x ))" lemma permute_raw_simps: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| 'a raw_term \ bool" where +inductive free_raw_term :: "'a::var \ '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 +definition FVars_raw_term :: "'a::var raw_term \ 'a set" where "FVars_raw_term x \ { a. free_raw_term a x }" definition "suppGr f \ {(x, f x) | x. f x \ x}" -coinductive alpha_term :: "'a::var_term_pre raw_term \ 'a raw_term \ bool" where +coinductive alpha_term :: "'a::var 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 ; @@ -106,10 +106,10 @@ 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 +definition avoid_raw_term :: "'a::var 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 }" +typedef ('a::var) "term" = "(UNIV::'a raw_term set) // { (x, y). alpha_term x y }" apply (rule exI) apply (rule quotientI) apply (rule UNIV_I) @@ -120,27 +120,27 @@ 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 +definition term_ctor :: "'a::var 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 +definition permute_term :: "('a::var \ '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 +definition FVars_term :: "'a::var 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 +definition avoid_term :: "'a::var 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 +inductive subshape_term_term :: "'a::var 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 +definition noclash_raw_term :: "'a::var 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 +definition noclash_term :: "'a::var 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 ******************) @@ -162,7 +162,7 @@ lemma permute_raw_ids: "permute_raw_term id x = x" 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" + fixes f::"'a::var \ 'a" and g::"'a \ 'a" assumes f_prems: "bij f" "|supp f| g) x" @@ -176,7 +176,7 @@ lemma permute_raw_comps: done lemma permute_raw_comp0s: - fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + fixes f::"'a::var \ 'a" and g::"'a \ 'a" assumes f_prems: "bij f" "|supp f| permute_raw_term g = permute_raw_term (f \ g)" @@ -238,7 +238,7 @@ lemma FVars_raw_ctors: done lemma FVars_raw_permute_leq: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ '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]) @@ -285,7 +285,7 @@ lemma FVars_raw_permute_leq: done lemma FVars_raw_permutes: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes f_prems: "bij f" "|supp f| (x::'a raw_term) y. x = y \ alpha_term x y" @@ -344,7 +344,7 @@ proof - qed lemma alpha_bijs: - fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + fixes f::"'a::var \ '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)" @@ -514,7 +514,7 @@ proof - qed lemma alpha_bij_eqs: - fixes f::"'a::var_term_pre \ 'a" and g::"'a \ 'a" + fixes f::"'a::var \ 'a" and g::"'a \ 'a" assumes f_prems: "bij f" "|supp f| 'a" and g::"'a \ 'a" + fixes f::"'a::var \ 'a" and g::"'a \ 'a" assumes f_prems: "bij f" "|supp f| FVars_raw_term x = FVars_ra done lemma alpha_syms: - fixes x::"'a::var_term_pre raw_term" + fixes x::"'a::var raw_term" shows "alpha_term x y \ alpha_term y x" apply (erule alpha_term.coinduct) apply (erule alpha_term.cases) @@ -1409,7 +1409,7 @@ proof - qed lemma raw_refreshs: - fixes x::"('a::var_term_pre, 'a, 'a, 'a raw_term, 'a raw_term, 'a raw_term) term_pre" + fixes x::"('a::var, '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)" @@ -1417,8 +1417,8 @@ lemma raw_refreshs: "(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 var_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_class.UN_bound var_class.large' FVars_raw_bd_UNIVs infinite_UNIV )+ apply (rule Un_upper2) apply (rule Diff_disjoint) @@ -1469,7 +1469,7 @@ lemma raw_refreshs: done lemma avoid_raw_freshs: - fixes x::"'a::var_term_pre raw_term_pre" + fixes x::"'a::var raw_term_pre" assumes "|A| A = {}" "set3_term_pre (avoid_raw_term x A) \ A = {}" apply (unfold avoid_raw_term_def) @@ -1537,7 +1537,7 @@ lemma TT_abs_ctors: "TT_abs (raw_term_ctor x) = term_ctor (map_term_pre id id id done lemma permute_simps: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| permute_term f = permute_term (g \ f)" apply (rule ext) @@ -1602,7 +1602,7 @@ lemma permute_comp0s: lemmas permute_comps = trans[OF comp_apply[symmetric] fun_cong[OF permute_comp0s]] lemma permute_bijs: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| (\(g::'a::var_term_pre \ 'a) f2. + "(term_ctor x = term_ctor y) \ (\(g::'a::var \ '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 \ @@ -1801,7 +1801,7 @@ lemma TT_inject0s: done lemma avoid_freshs: - fixes x::"'a::var_term_pre term_pre'" + fixes x::"'a::var term_pre'" assumes "|A| A = {}" "set3_term_pre (avoid_term x A) \ A = {}" apply (unfold avoid_term_def) @@ -1817,7 +1817,7 @@ lemma avoid_freshs: done lemma alpha_avoids: - fixes x::"'a::var_term_pre term_pre'" + fixes x::"'a::var 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 @@ -1957,7 +1957,7 @@ proof - qed lemma subshape_induct_raw: - fixes x::"'a::var_term_pre raw_term" + fixes x::"'a::var 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]) @@ -2021,7 +2021,7 @@ lemma subshape_induct_raw: done lemma subshape_induct: - fixes x::"'a::var_term_pre raw_term" + fixes x::"'a::var 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]) @@ -2070,7 +2070,7 @@ lemma set_subshapess: done lemma set_subshape_permutess: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| set4_term_pre x \ subshape_term_term (permute_raw_term f z) (raw_term_ctor x)" @@ -2110,7 +2110,7 @@ lemma set_subshape_permutess: done lemma permute_abs: - fixes f::"'a::var_term_pre \ 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| 'a" + fixes f g::"'a::var \ '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) @@ -2207,7 +2207,7 @@ lemma existential_induct: done lemma fresh_induct_param: - fixes K::"'p \ 'a::var_term_pre set" + fixes K::"'p \ 'a::var set" assumes "\\. \ \ Param \ |K \| x \. (\z \. z \ set4_term_pre x \ \ \ Param \ P z \) \ diff --git a/operations/Recursor.thy b/operations/Recursor.thy index a8ddc127..27eb65a6 100644 --- a/operations/Recursor.thy +++ b/operations/Recursor.thy @@ -7,27 +7,27 @@ typedecl ('var, 'tyvar, 'a, 'b) U2 typedecl ('var, 'tyvar) P -consts Pmap :: "('var::{var_T1_pre,var_T2_pre} \ 'var) \ ('tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar) \ ('var, 'tyvar) P \ ('var, 'tyvar) P" -consts PFVars_1 :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}) P \ 'var set" -consts PFVars_2 :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}) P \ 'tyvar set" -consts avoiding_set1 :: "'var::{var_T1_pre,var_T2_pre} set" -consts avoiding_set2 :: "'tyvar::{var_T1_pre,var_T2_pre} set" +consts Pmap :: "('var::var \ 'var) \ ('tyvar::var \ 'tyvar) \ ('var, 'tyvar) P \ ('var, 'tyvar) P" +consts PFVars_1 :: "('var::var, 'tyvar::var) P \ 'var set" +consts PFVars_2 :: "('var::var, 'tyvar::var) P \ 'tyvar set" +consts avoiding_set1 :: "'var::var set" +consts avoiding_set2 :: "'tyvar::var set" -consts U1map :: "('var::{var_T1_pre,var_T2_pre} \ 'var) \ ('tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar) \ ('var, 'tyvar, 'a, 'b) T1 \ ('var, 'tyvar, 'a, 'b) U1 \ ('var, 'tyvar, 'a, 'c) U1" -consts U2map :: "('var::{var_T1_pre,var_T2_pre} \ 'var) \ ('tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar) \ ('var, 'tyvar, 'a, 'b) T2 \ ('var, 'tyvar, 'a, 'b) U2 \ ('var, 'tyvar, 'a, 'c) U2" +consts U1map :: "('var::var \ 'var) \ ('tyvar::var \ 'tyvar) \ ('var, 'tyvar, 'a, 'b) T1 \ ('var, 'tyvar, 'a, 'b) U1 \ ('var, 'tyvar, 'a, 'c) U1" +consts U2map :: "('var::var \ 'var) \ ('tyvar::var \ 'tyvar) \ ('var, 'tyvar, 'a, 'b) T2 \ ('var, 'tyvar, 'a, 'b) U2 \ ('var, 'tyvar, 'a, 'c) U2" -consts U1FVars_1 :: "('var, 'tyvar, 'a, 'b) T1 \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a, 'b) U1 \ 'var set" -consts U1FVars_2 :: "('var, 'tyvar, 'a, 'b) T1 \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a, 'b) U1 \ 'tyvar set" -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 U1FVars_1 :: "('var, 'tyvar, 'a, 'b) T1 \ ('var::var, 'tyvar::var, 'a, 'b) U1 \ 'var set" +consts U1FVars_2 :: "('var, 'tyvar, 'a, 'b) T1 \ ('var::var, 'tyvar::var, 'a, 'b) U1 \ 'tyvar set" +consts U2FVars_1 :: "('var, 'tyvar, 'a, 'b) T2 \ ('var::var, 'tyvar::var, 'a, 'b) U2 \ 'var set" +consts U2FVars_2 :: "('var, 'tyvar, 'a, 'b) T2 \ ('var::var, 'tyvar::var, '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, 'var, +consts U1ctor :: "('var::var, 'tyvar::var, '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, 'var, +consts U2ctor :: "('var::var, 'tyvar::var, '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), @@ -41,34 +41,34 @@ consts validU2 :: "('var, 'tyvar, 'a, 'b) U2 \ bool" axiomatization where (* parameter axioms *) Pmap_id0: "validP d \ Pmap id id d = d" - and Pmap_comp0: "validP d \ bij f1 \ |supp (f1::'var::{var_T1_pre,var_T2_pre} \ 'var)| bij f2 \ |supp (f2::'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar)| + and Pmap_comp0: "validP d \ bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| bij g1 \ |supp (g1::'var \ 'var)| bij g2 \ |supp (g2::'tyvar \ 'tyvar)| Pmap (g1 \ f1) (g2 \ f2) d = (Pmap g1 g2 \ Pmap f1 f2) d" - and Pmap_cong_id: "validP d \ bij f1 \ |supp (f1::'var::{var_T1_pre,var_T2_pre} \ 'var)| bij f2 \ |supp (f2::'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar)| + and Pmap_cong_id: "validP d \ bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| (\a. a \ PFVars_1 d \ f1 a = a) \ (\a. a \ PFVars_2 d \ f2 a = a) \ Pmap f1 f2 d = d" - and PFVars_Pmap_1: "validP d \ bij f1 \ |supp (f1::'var::{var_T1_pre,var_T2_pre} \ 'var)| bij f2 \ |supp (f2::'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar)| + and PFVars_Pmap_1: "validP d \ bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| PFVars_1 (Pmap f1 f2 d) = f1 ` PFVars_1 d" - and PFVars_Pmap_2: "validP d \ bij f1 \ |supp (f1::'var::{var_T1_pre,var_T2_pre} \ 'var)| bij f2 \ |supp (f2::'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar)| + and PFVars_Pmap_2: "validP d \ bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| PFVars_2 (Pmap f1 f2 d) = f2 ` PFVars_2 d" and small_PFVars_1: "validP d \ |PFVars_1 d| |PFVars_2 d| bij f1 \ |supp (f1::'var::{var_T1_pre,var_T2_pre} \ 'var)| bij f2 \ |supp (f2::'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar)| + and valid_Pmap: "validP d \ bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| validP (Pmap f1 f2 d)" (* model 1 axioms *) and U1map_id0: "validU1 u1 \ U1map id id (t1::('var, 'tyvar, 'a, 'b) T1) u1 = u1" - and U1map_comp0: "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)| + and U1map_comp0: "validU1 u1 \ bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| bij g1 \ |supp (g1::'var \ 'var)| bij g2 \ |supp (g2::'tyvar \ 'tyvar)| U1map (g1 \ f1) (g2 \ f2) t1 x1 = (U1map g1 g2 t1 \ U1map f1 f2 t1) u1" - and U1map_cong_id: "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)| + and U1map_cong_id: "validU1 u1 \ bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| (\a. a \ U1FVars_1 t1 u1 \ f1 a = a) \ (\a. a \ U1FVars_2 t1 u1 \ f2 a = a) \ U1map f1 f2 t1 u1 = u1" 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)| + bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| 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)) @@ -78,17 +78,17 @@ axiomatization where 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) = {} \ + set5_T1_pre (y::(_, _, 'a::var, '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) = {} \ + 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, '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)| + and validU1_Umap: "validU1 u1 \ bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| validU1 (U1map f1 f2 (t1::('var, 'tyvar, 'a, 'b) T1) u1)" and validU1_Uctor: "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 \ validP p \ validU1 (U1ctor y p)" @@ -121,7 +121,7 @@ axiomatization where (\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)| + and validU2_Umap: "validU2 u2 \ bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| validU2 (U2map f1 f2 (t2::('var, 'tyvar, 'a, 'b) T2) u2)" and validU2_Uctor: "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 \ validP p \ validU2 (U2ctor y2 p)" @@ -143,22 +143,22 @@ type_synonym ('var, 'tyvar, 'a, 'b) pre_T2 = "('var, 'tyvar, 'a, 'b, 'var, 'tyva ('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 +definition suitable11 :: "(('var::var, 'tyvar::var, 'a::var, '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_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 +definition suitable12 :: "(('var::var, 'tyvar::var, 'a::var, '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_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 +definition suitable21 :: "(('var::var, 'tyvar::var, 'a::var, '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_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 +definition suitable22 :: "(('var::var, 'tyvar::var, 'a::var, '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_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) = {}" @@ -168,32 +168,32 @@ lemmas suitable_defs = suitable11_def suitable12_def suitable21_def suitable22_d abbreviation "abs_T1 \ quot_type.abs alpha_T1 Abs_T1" abbreviation "abs_T2 \ quot_type.abs alpha_T2 Abs_T2" -definition 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) raw_T1 \ ('var, 'tyvar, 'a, 'b) U1 \ ('var, 'tyvar, 'a, 'b) U1" where +definition U1map' :: "('var::var \ 'var) \ ('tyvar::var \ 'tyvar) \ ('var, 'tyvar, 'a::var, 'b) raw_T1 \ ('var, 'tyvar, 'a, 'b) U1 \ ('var, 'tyvar, 'a, 'b) U1" where "U1map' f1 f2 x \ U1map f1 f2 (abs_T1 x)" -definition 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) raw_T2 \ ('var, 'tyvar, 'a, 'b) U2 \ ('var, 'tyvar, 'a, 'b) U2" where +definition U2map' :: "('var::var \ 'var) \ ('tyvar::var \ 'tyvar) \ ('var, 'tyvar, 'a::var, 'b) raw_T2 \ ('var, 'tyvar, 'a, 'b) U2 \ ('var, 'tyvar, 'a, 'b) U2" where "U2map' f1 f2 x \ U2map f1 f2 (abs_T2 x)" -definition U1FVars_1' :: "('var, 'tyvar, 'a, 'b) raw_T1 \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U1 \ 'var set" where +definition U1FVars_1' :: "('var, 'tyvar, 'a, 'b) raw_T1 \ ('var::var, 'tyvar::var, 'a::var, 'b) U1 \ 'var set" where "U1FVars_1' t \ U1FVars_1 (abs_T1 t)" -definition U1FVars_2' :: "('var, 'tyvar, 'a, 'b) raw_T1 \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U1 \ 'tyvar set" where +definition U1FVars_2' :: "('var, 'tyvar, 'a, 'b) raw_T1 \ ('var::var, 'tyvar::var, 'a::var, 'b) U1 \ 'tyvar set" where "U1FVars_2' t \ U1FVars_2 (abs_T1 t)" -definition U2FVars_1' :: "('var, 'tyvar, 'a, 'b) raw_T2 \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U2 \ 'var set" where +definition U2FVars_1' :: "('var, 'tyvar, 'a, 'b) raw_T2 \ ('var::var, 'tyvar::var, 'a::var, 'b) U2 \ 'var set" where "U2FVars_1' t \ U2FVars_1 (abs_T2 t)" -definition U2FVars_2' :: "('var, 'tyvar, 'a, 'b) raw_T2 \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U2 \ 'tyvar set" where +definition U2FVars_2' :: "('var, 'tyvar, 'a, 'b) raw_T2 \ ('var::var, 'tyvar::var, 'a::var, 'b) U2 \ 'tyvar set" where "U2FVars_2' t \ U2FVars_2 (abs_T2 t)" -definition PU1map :: "('var \ 'var) \ ('tyvar \ '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, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1) \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1)" where +definition PU1map :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var::var, 'tyvar::var, 'a::var, 'b) T1 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1) \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1)" where "PU1map f1 f2 t \ \pu p. U1map f1 f2 t (pu (Pmap (inv f1) (inv f2) p))" -definition PU2map :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T2 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U2) \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U2)" where +definition PU2map :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var::var, 'tyvar::var, 'a::var, 'b) T2 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U2) \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U2)" where "PU2map f1 f2 t \ \pu p. U2map f1 f2 t (pu (Pmap (inv f1) (inv f2) p))" -definition PU1map' :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) raw_T1 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1) \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1)" where +definition PU1map' :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var::var, 'tyvar::var, 'a::var, 'b) raw_T1 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1) \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U1)" where "PU1map' f1 f2 t \ \pu p. U1map' f1 f2 t (pu (Pmap (inv f1) (inv f2) p))" -definition PU2map' :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) raw_T2 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U2) \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U2)" where +definition PU2map' :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var::var, 'tyvar::var, 'a::var, 'b) raw_T2 \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U2) \ (('var, 'tyvar) P \ ('var, 'tyvar, 'a, 'b) U2)" where "PU2map' f1 f2 t \ \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 +definition U1ctor' :: "_ \ _ \ ('var::var, 'tyvar::var, 'a::var, 'b) U1" where "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 +definition U2ctor' :: "_ \ _ \ ('var::var, 'tyvar::var, 'a::var, 'b) U2" where "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: @@ -206,7 +206,7 @@ lemma suitable_bij: done lemma suitable_supp_bound: - "suitable11 pick1 \ validP p \ |supp (pick1 x (p::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}) P))| validP p \ |supp (pick1 x (p::('var::var, 'tyvar::var) P))| validP p \ |supp (pick2 x p)| validP p \ |supp (pick3 x' p)| validP p \ |supp (pick4 x' p)| _ \ _ \ _ \ _ \ _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U1" +function f_T1 :: "_ \ _ \ _ \ _ \ _ \ _ \ ('var::var, 'tyvar::var, 'a::var, '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 id @@ -558,7 +558,7 @@ lemma pick_id_ons': done 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" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes "bij f1" "|supp f1| 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)" @@ -601,7 +601,7 @@ lemma pick_id_on_images: done 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" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes "bij f1" "|supp f1| 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)" @@ -619,7 +619,7 @@ lemma pick_id_on_images': (* lower axioms to raw type *) 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)| + bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| 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)) @@ -687,7 +687,7 @@ lemma U1map'_U1ctor': "validP p \ 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)| + bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| 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)) @@ -762,13 +762,13 @@ lemmas FVars_def2s = 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) = {} \ + set5_T1_pre (y::(_, _, 'a::var, '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) = {} \ + set6_T1_pre (y::(_, _, 'a::var, '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" @@ -845,7 +845,7 @@ 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) = {} \ + set5_T2_pre (y2::(_, _, 'a::var, '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" @@ -928,7 +928,7 @@ lemma U2FVars'_subsets: "validP p \ done lemma Pmap_imsupp_empty: - fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes "validP p" "bij f1" "|supp f1| PFVars_1 p = {}" "imsupp f2 \ PFVars_2 p = {}" shows "Pmap f1 f2 p = p" @@ -937,7 +937,7 @@ lemma Pmap_imsupp_empty: done lemma U1ctor_rename: - fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" 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| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" 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| 'var" and f2 g2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1 g1::"'var::var \ 'var" and f2 g2::"'tyvar::var \ 'tyvar" 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" "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'" @@ -1159,7 +1159,7 @@ lemma U1ctor_cong: done lemma U2ctor_cong: - fixes f1 g1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2 g2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1 g1::"'var::var \ 'var" and f2 g2::"'tyvar::var \ 'tyvar" 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" "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'" @@ -1285,7 +1285,7 @@ lemmas T1_pre_set_map_ids = T1_pre.set_map[OF supp_id_bound supp_id_bound supp_i 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" + fixes f1 g1::"'var::var \ 'var" and f2 g2::"'tyvar::var \ 'tyvar" 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" "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'" @@ -1585,7 +1585,7 @@ lemma U1ctor'_cong: done lemma U2ctor'_cong: - fixes f1 g1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2 g2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1 g1::"'var::var \ 'var" and f2 g2::"'tyvar::var \ 'tyvar" 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" "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'" @@ -1970,7 +1970,7 @@ lemma alpha_ctor_picks2: lemmas alpha_ctor_picks = alpha_ctor_picks1 alpha_ctor_picks2 lemma mk_pick_prems: - fixes pick1::"_ \ _ \ _ \ 'var::{var_T1_pre,var_T2_pre}" and pick2::"_ \ _ \ _ \ 'tyvar::{var_T1_pre,var_T2_pre}" + fixes pick1::"_ \ _ \ _ \ 'var::var" and pick2::"_ \ _ \ _ \ 'tyvar::var" assumes suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" "validP p" shows "bij (pick1 x p)" "|supp (pick1 x p)| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" "validP p'" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| )"] Int_empty_left] lemma valid_PUmap': - fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| pred_fun validP validU1 (PU1map' f1 f2 g h)" @@ -3860,7 +3860,7 @@ lemma valid_PUmap': done lemma valid_XXl1: - fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" shows "g = g' \ h (Pmap (inv f1) (inv f2) p) = h' (Pmap (inv f1) (inv f2) p) \ PU1map' f1 f2 g h p = PU1map' f1 f2 g' h' p" "g2 = g2' \ h2 (Pmap (inv f1) (inv f2) p) = h2' (Pmap (inv f1) (inv f2) p) \ PU2map' f1 f2 g2 h2 p = PU2map' f1 f2 g2' h2' p" @@ -3994,7 +3994,7 @@ lemma PUmap'_cong: done lemma f_swap_alpha: - fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and suitable_prems: "suitable11 pick1" "suitable12 pick2" "suitable21 pick3" "suitable22 pick4" and suitable'_prems: "suitable11 pick1'" "suitable12 pick2'" "suitable21 pick3'" "suitable22 pick4'" @@ -8961,7 +8961,7 @@ lemma ff0_cctors: done lemma ff0_swaps: - fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes valid: "validP p" and f_prems: "bij f1" "|supp f1| avoiding_set1 = {}" "imsupp f2 \ avoiding_set2 = {}" diff --git a/operations/Sugar.thy b/operations/Sugar.thy index 8824bd54..cc485bf6 100644 --- a/operations/Sugar.thy +++ b/operations/Sugar.thy @@ -23,8 +23,6 @@ in lthy end print_theorems 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 (Inl x))))" definition Arrow_T1 :: "('var::var, 'tyvar::var, 'a::var, 'b) T1" where @@ -368,7 +366,7 @@ lemma set_T1_simps[simp]: "set4_T1 (Ext_T1 a) = {}" apply (unfold set_simp_thms T1_ctors_defs FVars_ctors T1_pre_set_defs Abs_T1_pre_inverse[OF UNIV_I] - T1_set_simps list.set_map + T1.set_ctor_simps list.set_map ) apply (rule refl | (unfold prod_sets_simps)[1])+ @@ -404,7 +402,7 @@ lemma set_T2_simps[simp]: "set4_T2 (Ext_T2 b t1) = {b} \ set4_T1 t1" apply (unfold set_simp_thms T2_ctors_defs FVars_ctors T2_pre_set_defs Abs_T2_pre_inverse[OF UNIV_I] - T2_set_simps + T2.set_ctor_simps ) apply (rule refl)+ done @@ -690,7 +688,7 @@ lemma map_simps[simp]: "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 (rule trans[OF T1.vvsubst_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]] @@ -699,7 +697,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated *) - apply (rule trans[OF T1_cctor]) + apply (rule trans[OF T1.vvsubst_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]] @@ -708,7 +706,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated *) - apply (rule trans[OF T1_cctor]) + apply (rule trans[OF T1.vvsubst_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]] @@ -717,7 +715,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated *) - apply (rule trans[OF T1_cctor]) + apply (rule trans[OF T1.vvsubst_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]] @@ -726,7 +724,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated *) - apply (rule trans[OF T1_cctor]) + apply (rule trans[OF T1.vvsubst_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]] @@ -735,7 +733,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated *) - apply (rule trans[OF T1_cctor]) + apply (rule trans[OF T1.vvsubst_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]] @@ -744,7 +742,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated *) - apply (rule trans[OF T1_cctor]) + apply (rule trans[OF T1.vvsubst_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]] @@ -753,7 +751,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated *) - apply (rule trans[OF T1_cctor]) + apply (rule trans[OF T1.vvsubst_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]] @@ -762,7 +760,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated for second type *) - apply (rule trans[OF T2_cctor]) + apply (rule trans[OF T2.vvsubst_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]] @@ -771,7 +769,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated *) - apply (rule trans[OF T2_cctor]) + apply (rule trans[OF T2.vvsubst_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]] @@ -780,7 +778,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated *) - apply (rule trans[OF T2_cctor]) + apply (rule trans[OF T2.vvsubst_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]] @@ -789,7 +787,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated *) - apply (rule trans[OF T2_cctor]) + apply (rule trans[OF T2.vvsubst_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]] @@ -798,7 +796,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated *) - apply (rule trans[OF T2_cctor]) + apply (rule trans[OF T2.vvsubst_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]] @@ -807,7 +805,7 @@ lemma map_simps[simp]: apply ((unfold id_def)[1])? apply (rule refl) (* repeated *) - apply (rule trans[OF T2_cctor]) + apply (rule trans[OF T2.vvsubst_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]] diff --git a/operations/TVSubst.thy b/operations/TVSubst.thy index 4fee9938..c10df385 100644 --- a/operations/TVSubst.thy +++ b/operations/TVSubst.thy @@ -8,79 +8,79 @@ consts eta12 :: "'tyvar \ ('var, 'tyvar, 'a, 'b, 'bvar, 'btyvar, 'va 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}}" + eta_free11: "set1_T1_pre (eta11 a) = {a::'var::var}" 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}, '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)| |supp (f5::'x1::{var_T1_pre,var_T2_pre} \ 'x1)| range eta11 \ set1_T1_pre (x::('var::var, 'tyvar::var, 'a::var, 'b, 'bvar::var, 'btyvar::var, 'var, 'rec1, 'brec1, 'rec2, 'brec2) T1_pre) = {}" +and eta_natural11: "|supp (f1::'x1::var \ 'x1)| |supp (f2::'x2::var \ 'x2)| bij f3 \ |supp (f3::'x3::var \ 'x3)| bij f4 \ |supp (f4::'x4::var \ 'x4)| |supp (f5::'x1::var \ '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_free12: "set2_T1_pre (eta12 b) = {b::'tyvar::var}" 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}, '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)| |supp (f5::'x1::{var_T1_pre,var_T2_pre} \ 'x1)| range eta12 \ set2_T1_pre (x::('var::var, 'tyvar::var, 'a::var, 'b, 'bvar::var, 'btyvar::var, 'var, 'rec1, 'brec1, 'rec2, 'brec2) T1_pre) = {}" +and eta_natural12: "|supp (f1::'x1::var \ 'x1)| |supp (f2::'x2::var \ 'x2)| bij f3 \ |supp (f3::'x3::var \ 'x3)| bij f4 \ |supp (f4::'x4::var \ 'x4)| |supp (f5::'x1::var \ '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_free21: "set1_T2_pre (eta21 c) = {c::'var::var}" 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}, '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)| |supp (f5::'x1::{var_T1_pre,var_T2_pre} \ 'x1)| range eta21 \ set1_T2_pre (y::('var::var, 'tyvar::var, 'a::var, 'b, 'bvar::var, 'btyvar::var, 'var, 'rec1, 'brec1, 'rec2, 'brec2) T2_pre) = {}" +and eta_natural21: "|supp (f1::'x1::var \ 'x1)| |supp (f2::'x2::var \ 'x2)| bij f3 \ |supp (f3::'x3::var \ 'x3)| bij f4 \ |supp (f4::'x4::var \ 'x4)| |supp (f5::'x1::var \ '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" -definition VVr21 :: "'var \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T2" where "VVr21 \ T2_ctor \ eta21" +definition VVr11 :: "'var \ ('var::var, 'tyvar::var, 'a::var, 'b) T1" where "VVr11 \ T1_ctor \ eta11" +definition VVr12 :: "'tyvar \ ('var::var, 'tyvar::var, 'a::var, 'b) T1" where "VVr12 \ T1_ctor \ eta12" +definition VVr21 :: "'var \ ('var::var, 'tyvar::var, 'a::var, 'b) T2" where "VVr21 \ T2_ctor \ eta21" lemmas VVr_defs = VVr11_def VVr12_def VVr21_def -definition SSupp11 :: "('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 +definition SSupp11 :: "('var \ ('var::var, 'tyvar::var, 'a::var, 'b) T1) \ 'var set" where "SSupp11 f \ { x. f x \ VVr11 x }" -definition SSupp12 :: "('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 +definition SSupp12 :: "('tyvar \ ('var::var, 'tyvar::var, 'a::var, 'b) T1) \ 'tyvar set" where "SSupp12 f \ { x. f x \ VVr12 x }" -definition SSupp21 :: "('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 +definition SSupp21 :: "('var \ ('var::var, 'tyvar::var, 'a::var, 'b) T2) \ 'var set" where "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 +definition IImsupp11_1 :: "('var \ ('var::var, 'tyvar::var, 'a::var, 'b) T1) \ 'var set" where "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 +definition IImsupp11_2 :: "('var \ ('var::var, 'tyvar::var, 'a::var, 'b) T1) \ 'tyvar set" where "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 +definition IImsupp12_1 :: "('tyvar \ ('var::var, 'tyvar::var, 'a::var, 'b) T1) \ 'var set" where "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 +definition IImsupp12_2 :: "('tyvar \ ('var::var, 'tyvar::var, 'a::var, 'b) T1) \ 'tyvar set" where "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 +definition IImsupp21_1 :: "('var \ ('var::var, 'tyvar::var, 'a::var, 'b) T2) \ 'var set" where "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 +definition IImsupp21_2 :: "('var \ ('var::var, 'tyvar::var, 'a::var, 'b) T2) \ 'tyvar set" where "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 +definition isVVr11 :: "('var::var, 'tyvar::var, 'a::var, 'b) T1 \ bool" where "isVVr11 x \ \a. x = VVr11 a" -definition isVVr12 :: "('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 +definition isVVr12 :: "('var::var, 'tyvar::var, 'a::var, 'b) T1 \ bool" where "isVVr12 x \ \a. x = VVr12 a" -definition isVVr21 :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T2 \ bool" where +definition isVVr21 :: "('var::var, 'tyvar::var, 'a::var, 'b) T2 \ bool" where "isVVr21 x \ \a. x = VVr21 a" -definition asVVr11 :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T1 \ 'var" where +definition asVVr11 :: "('var::var, 'tyvar::var, 'a::var, 'b) T1 \ 'var" where "asVVr11 x \ (if isVVr11 x then SOME a. x = VVr11 a else undefined)" -definition asVVr12 :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T1 \ 'tyvar" where +definition asVVr12 :: "('var::var, 'tyvar::var, 'a::var, 'b) T1 \ 'tyvar" where "asVVr12 x \ (if isVVr12 x then SOME a. x = VVr12 a else undefined)" -definition asVVr21 :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) T2 \ 'var" where +definition asVVr21 :: "('var::var, 'tyvar::var, 'a::var, 'b) T2 \ 'var" where "asVVr21 x \ (if isVVr21 x then SOME a. x = VVr21 a else undefined)" type_synonym ('var, 'tyvar, 'a, 'b) SSfun11 = "'var \ ('var, 'tyvar, 'a, 'b) T1" type_synonym ('var, 'tyvar, 'a, 'b) SSfun12 = "'tyvar \ ('var, 'tyvar, 'a, 'b) T1" 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 +definition compSS11 :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var, 'tyvar, 'a, 'b) SSfun11 \ ('var::var, 'tyvar::var, 'a::var, 'b) SSfun11" where "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 +definition compSS12 :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var, 'tyvar, 'a, 'b) SSfun12 \ ('var::var, 'tyvar::var, 'a::var, 'b) SSfun12" where "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 +definition compSS21 :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var, 'tyvar, 'a, 'b) SSfun21 \ ('var::var, 'tyvar::var, 'a::var, 'b) SSfun21" where "compSS21 f1 f2 h \ permute_T2 f1 f2 \ h \ inv f1" lemmas compSS_defs = compSS11_def compSS12_def compSS21_def @@ -88,7 +88,7 @@ type_synonym ('var, 'tyvar, 'a, 'b) P = "('var, 'tyvar, 'a, 'b) SSfun11 \ 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, ('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, 'tyvar::var, 'a::var, '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 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 ( @@ -96,33 +96,33 @@ definition U1ctor :: "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_ 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, ('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, 'tyvar::var, 'a::var, '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 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 +definition PFVars_1 :: "('var::var, 'tyvar::var, 'a::var, 'b) P \ 'var set" where "PFVars_1 p \ case p of (f1, f2, f3) \ IImsupp11_1 f1 \ IImsupp12_1 f2 \ IImsupp21_1 f3" -definition PFVars_2 :: "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) P \ 'tyvar set" where +definition PFVars_2 :: "('var::var, 'tyvar::var, 'a::var, 'b) P \ 'tyvar set" where "PFVars_2 p \ case p of (f1, f2, f3) \ IImsupp11_2 f1 \ IImsupp12_2 f2 \ IImsupp21_2 f3" -definition Pmap :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) P \ ('var, 'tyvar, 'a, 'b) P" where +definition Pmap :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var::var, 'tyvar::var, 'a::var, 'b) P \ ('var, 'tyvar, 'a, 'b) P" where "Pmap g1 g2 p \ case p of (f1, f2, f3) \ (compSS11 g1 g2 f1, compSS12 g1 g2 f2, compSS21 g1 g2 f3)" -definition avoiding_set1 :: "'var::{var_T1_pre,var_T2_pre} set" where "avoiding_set1 \ {}" -definition avoiding_set2 :: "'tyvar::{var_T1_pre,var_T2_pre} set" where "avoiding_set2 \ {}" +definition avoiding_set1 :: "'var::var set" where "avoiding_set1 \ {}" +definition avoiding_set2 :: "'tyvar::var 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). 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 "U1FVars_1 \ \(_::('var, 'tyvar, 'a, 'b) T1) (x::('var::var, 'tyvar::var, 'a::var, 'b) T1). FVars_T11 x" +abbreviation "U1FVars_2 \ \(_::('var, 'tyvar, 'a, 'b) T1) (x::('var::var, 'tyvar::var, 'a::var, 'b) T1). FVars_T12 x" +abbreviation "U2FVars_1 \ \(_::('var, 'tyvar, 'a, 'b) T2) (x::('var::var, 'tyvar::var, 'a::var, 'b) T2). FVars_T21 x" +abbreviation "U2FVars_2 \ \(_::('var, 'tyvar, 'a, 'b) T2) (x::('var::var, 'tyvar::var, 'a::var, '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). 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" +abbreviation "U1map \ \f1 f2 (_::('var, 'tyvar, 'a, 'b) T1) (x::('var::var, 'tyvar::var, 'a::var, 'b) T1). permute_T1 f1 f2 x" +abbreviation "U2map \ \f1 f2 (_::('var, 'tyvar, 'a, 'b) T2) (x::('var::var, 'tyvar::var, 'a::var, '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 +definition valid_P :: "('var::var, 'tyvar::var, 'a::var, 'b) P \ bool" where "valid_P p \ case p of (f1, f2, f3) \ |SSupp11 f1| |SSupp12 f2| 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| |supp (f::'var \ 'var)| |SSupp11 (g \ f)| |supp (f::'var \ 'var)| |SSupp11 (g \ f)| |supp (f2::'tyvar \ 'tyvar)| |SSupp12 (g2 \ f2)| |supp f| |SSupp21 (g3 \ f)| 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| g) \ SSupp11 g \ supp f1" @@ -340,7 +340,7 @@ lemma SSupp_rename_subsets: done lemma SSupp_rename_bounds: - fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| |SSupp11 (permute_T1 f1 f2 \ g)| |SSupp12 (permute_T1 f1 f2 \ h)| 'var" and f2 g2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1 g1::"'var::var \ 'var" and f2 g2::"'tyvar::var \ 'tyvar" assumes g_prems: "bij g1" "|supp g1| 'var" and f2 g2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1 g1::"'var::var \ 'var" and f2 g2::"'tyvar::var \ 'tyvar" assumes g_prems: "bij g1" "|supp g1| 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| y \ inv f1) = f1 ` SSupp11 y" @@ -629,7 +629,7 @@ lemma IImsupp_VVrs: done lemma IImsupp_permute_commute: - fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes f_prems: "bij f1" "|supp 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" @@ -857,7 +857,7 @@ lemma IImsupp_permute_commute: done lemma compSS_cong_ids: - fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| a. a \ IImsupp11_1 h1 \ f1 a = a) \ (\a. a \ IImsupp11_2 h1 \ f2 a = a) \ compSS11 f1 f2 h1 = h1" @@ -1048,7 +1048,7 @@ lemma asVVr_VVrs: done lemma isVVr_renames: -fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" +fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{ done lemma valid_Pmap: "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)| + bij f1 \ |supp (f1::'var::var \ 'var)| + bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| valid_P (Pmap f1 f2 p)" apply (unfold valid_P_def Pmap_def case_prod_beta compSS_defs fst_conv snd_conv) apply (erule conjE)+ @@ -1129,7 +1129,7 @@ lemma valid_Pmap: "valid_P p \ (**************************************) lemma PFVars_Pmaps: - fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| a. a \ PFVars_1 p \ f1 a = a) \ (\a. a \ PFVars_2 p \ f2 a = a) \ Pmap f1 f2 p = p" apply (unfold PFVars_1_def PFVars_2_def Pmap_def case_prod_beta) @@ -1238,7 +1238,7 @@ lemma Pmap_cong_id: done lemma small_PFVarss: - "valid_P p \ |PFVars_1 (p::('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) P)| |PFVars_1 (p::('var::var, 'tyvar::var, 'a::var, 'b) P)| |PFVars_2 p| set5_T1_pre (y::(_, _, 'a::{var_T1_pre,var_T2_pre}, 'b, _, _, _, _, _, _, _) T1_pre) \ (PFVars_1 p \ avoiding_set1) = {} \ +lemma U1FVars_subset_1: "valid_P p \ set5_T1_pre (y::(_, _, 'a::var, '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" @@ -1372,7 +1372,7 @@ 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) = {} \ +lemma U1FVars_subset_2: "valid_P p \ set6_T1_pre (y::(_, _, 'a::var, '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" @@ -1475,7 +1475,7 @@ 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) = {} \ +lemma U2FVars_subset_1: "valid_P p \ set5_T2_pre (y::(_, _, 'a::var, '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" @@ -1558,7 +1558,7 @@ 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) = {} \ +lemma U2FVars_subset_2: "valid_P p \ set6_T2_pre (y::('var::var, 'tyvar::var, 'a::var, '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" @@ -1636,7 +1636,7 @@ lemma U2FVars_subset_2: "valid_P p \ set6_T2_pre (y::('var::{var done 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)| +lemma U1map_Uctor: "valid_P p \ bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| 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)) @@ -1697,7 +1697,7 @@ lemma U1map_Uctor: "valid_P p \ bij f1 \ |supp ( apply (rule refl) 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)| +lemma U2map_Uctor: "valid_P p \ bij f1 \ |supp (f1::'var::var \ 'var)| bij f2 \ |supp (f2::'tyvar::var \ 'tyvar)| 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)) @@ -1762,19 +1762,19 @@ ML \ val nvars:int = 2 val parameters = { - P = @{typ "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) P"}, - Pmap = @{term "Pmap :: _ \ _ \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) P \ _"}, + P = @{typ "('var::var, 'tyvar::var, 'a::var, 'b) P"}, + Pmap = @{term "Pmap :: _ \ _ \ ('var::var, 'tyvar::var, 'a::var, 'b) P \ _"}, PFVarss = [ - @{term "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 \ _"}, - @{term "PFVars_2 :: ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) P \ _"} + @{term "PFVars_1 :: ('var::var, 'tyvar::var, 'a::var, 'b) P \ _"}, + @{term "PFVars_2 :: ('var::var, 'tyvar::var, 'a::var, 'b) P \ _"} ], avoiding_sets = [ - @{term "avoiding_set1 :: 'var::{var_T1_pre,var_T2_pre} set"}, - @{term "avoiding_set2 :: 'tyvar::{var_T1_pre,var_T2_pre} set"} + @{term "avoiding_set1 :: 'var::var set"}, + @{term "avoiding_set2 :: 'tyvar::var set"} ], min_bound = true, validity = SOME { - pred = @{term "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 \ _"}, + pred = @{term "valid_P :: ('var::var, 'tyvar::var, 'a::var, 'b) P \ _"}, valid_Pmap = fn ctxt => HEADGOAL (resolve_tac ctxt @{thms valid_Pmap} THEN_ALL_NEW assume_tac ctxt) }, axioms = { @@ -1797,13 +1797,13 @@ val card_thms = @{thms ordLess_ordLeq_trans[of _ "cmin _ _" "|_|"] cmin1 cmin2 c ML \ val T1_model = { binding = @{binding tvsubst_T1}, - U = @{typ "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U1"}, + U = @{typ "('var::var, 'tyvar::var, 'a::var, 'b) U1"}, UFVarss = [ - @{term "U1FVars_1 :: _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U1 \ _"}, - @{term "U1FVars_2 :: _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U1 \ _"} + @{term "U1FVars_1 :: _ \ ('var::var, 'tyvar::var, 'a::var, 'b) U1 \ _"}, + @{term "U1FVars_2 :: _ \ ('var::var, 'tyvar::var, 'a::var, 'b) U1 \ _"} ], - Umap = @{term "U1map::_ \ _ \ _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U1 \ _"}, - Uctor = @{term "U1ctor::_ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) P \ _"}, + Umap = @{term "U1map::_ \ _ \ _ \ ('var::var, 'tyvar::var, 'a::var, 'b) U1 \ _"}, + Uctor = @{term "U1ctor::_ \ ('var::var, 'tyvar::var, 'a::var, 'b) P \ _"}, validity = NONE : { pred: term, valid_Umap: Proof.context -> tactic, valid_Uctor: Proof.context -> tactic } option, axioms = { Umap_id0 = fn ctxt => EVERY1 [ @@ -1820,13 +1820,13 @@ val T1_model = { val T2_model = { binding = @{binding vvsubst_T2}, - U = @{typ "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U2"}, + U = @{typ "('var::var, 'tyvar::var, 'a::var, 'b) U2"}, UFVarss = [ - @{term "U2FVars_1 :: _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U2 \ _"}, - @{term "U2FVars_2 :: _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U2 \ _"} + @{term "U2FVars_1 :: _ \ ('var::var, 'tyvar::var, 'a::var, 'b) U2 \ _"}, + @{term "U2FVars_2 :: _ \ ('var::var, 'tyvar::var, 'a::var, 'b) U2 \ _"} ], - Umap = @{term "U2map::_ \ _ \ _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) U2 \ _"}, - Uctor = @{term "U2ctor::_ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) P \ _"}, + Umap = @{term "U2map::_ \ _ \ _ \ ('var::var, 'tyvar::var, 'a::var, 'b) U2 \ _"}, + Uctor = @{term "U2ctor::_ \ ('var::var, 'tyvar::var, 'a::var, 'b) P \ _"}, validity = NONE : { pred: term, valid_Umap: Proof.context -> tactic, valid_Uctor: Proof.context -> tactic } option, axioms = { Umap_id0 = fn ctxt => EVERY1 [ @@ -1864,9 +1864,9 @@ in lthy end\ print_theorems declare [[quick_and_dirty=false]] -definition tvsubst_T1 :: "('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) T1 \ ('var, 'tyvar, 'a, 'b) T1" where +definition tvsubst_T1 :: "('var \ ('var::var, 'tyvar::var, 'a::var, 'b) T1) \ ('tyvar \ ('var, 'tyvar, 'a, 'b) T1) \ ('var \ ('var, 'tyvar, 'a, 'b) T2) \ ('var, 'tyvar, 'a, 'b) T1 \ ('var, 'tyvar, 'a, 'b) T1" where "tvsubst_T1 f1 f2 f3 t \ ff01_tvsubst_T1_vvsubst_T2 t (f1, f2, f3)" -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 +definition tvsubst_T2 :: "('var \ ('var::var, 'tyvar::var, 'a::var, '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, ('var, 'tyvar, 'a, 'b) U1, ('var, 'tyvar, 'a, 'b) U1, ('var, 'tyvar, 'a, 'b) U2, ('var, 'tyvar, 'a, 'b) U2) T1_pre" @@ -1878,8 +1878,8 @@ lemmas eta_natural' = eta_natural21[THEN fun_cong, unfolded comp_def] lemma eta_set_empties: - fixes a::"'var::{var_T1_pre, var_T2_pre}" and b::"'tyvar::{var_T1_pre, var_T2_pre}" - shows "set2_T1_pre (eta11 a :: ('var, 'tyvar, 'a::{var_T1_pre, var_T2_pre}, 'b) U1_pre) = {}" + fixes a::"'var::var" and b::"'tyvar::var" + shows "set2_T1_pre (eta11 a :: ('var, 'tyvar, 'a::var, 'b) U1_pre) = {}" "set5_T1_pre (eta11 a :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" "set6_T1_pre (eta11 a :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" "set7_T1_pre (eta11 a :: ('var, 'tyvar, 'a, 'b) U1_pre) = {}" @@ -2561,7 +2561,7 @@ lemma tvsubst_VVrs: "|SSupp12 f2| (IImsupp11_1 f1 \ IImsupp12_1 f2 \ IImsupp21_1 f3) = {}" "set6_T1_pre x \ (IImsupp11_2 f1 \ IImsupp12_2 f2 \ IImsupp21_2 f3) = {}" and noclash: "noclash_T1 x" @@ -2669,7 +2669,7 @@ shows apply (rule refl) done lemma tvsubst_T2_not_is_VVr: - fixes x::"('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b) U2_pre" + fixes x::"('var::var, 'tyvar::var, 'a::var, 'b) U2_pre" assumes f_prems: "|SSupp11 f1| (IImsupp11_1 f1 \ IImsupp12_1 f2 \ IImsupp21_1 f3) = {}" "set6_T2_pre x \ (IImsupp11_2 f1 \ IImsupp12_2 f2 \ IImsupp21_2 f3) = {}" and noclash: "noclash_T2 x" @@ -2991,7 +2991,7 @@ lemma IImsupp_Diffs: done lemma IImsupp_naturals: - fixes f1::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f2::"'b::{var_T1_pre,var_T2_pre} \ 'b" + fixes f1::"'a::var \ 'a" and f2::"'b::var \ 'b" assumes "bij f1" "|supp f1| g \ inv f1) = f1 ` IImsupp11_1 g" @@ -3068,7 +3068,7 @@ lemma IImsupp_naturals: done lemma tvsubst_permutes: - fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| 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] + apply (rule var_class.Un_bound var_class.UN_bound infinite_UNIV g_prems[THEN ordLess_ordLeq_trans] FVars_bd_UNIVs cmin1 cmin2 card_of_Card_order)+ subgoal premises IHs for v (* EVERY for VVrs of T1 *) diff --git a/operations/VVSubst.thy b/operations/VVSubst.thy index c9f53c1e..9f5ede02 100644 --- a/operations/VVSubst.thy +++ b/operations/VVSubst.thy @@ -18,12 +18,12 @@ 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, 'tyvar::var, 'a::var, '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 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, ('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, 'tyvar::var, 'a::var, '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 f1 ((\R. R p) \ snd) ((\R. R p) \ snd) ((\R. R p) \ snd) ((\R. R p) \ snd) x @@ -37,22 +37,22 @@ abbreviation PFVars_2 :: "('var, 'tyvar, 'a, 'b, 'c) P \ 'tyvar set" abbreviation Pmap :: "('var \ 'var) \ ('tyvar \ 'tyvar) \ ('var, 'tyvar, 'a, 'b, 'c) P \ ('var, 'tyvar, 'a, 'b,'c) P" where "Pmap g1 g2 p \ 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 +abbreviation U1map :: "('var::var \ 'var) \ ('tyvar::var \ 'tyvar) \ ('var, 'tyvar, 'a::var, 'b) T1 \ ('var, 'tyvar, 'a, 'c) U1 \ ('var, 'tyvar, 'a, 'c) U1" where "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 +abbreviation U2map :: "('var::var \ 'var) \ ('tyvar::var \ 'tyvar) \ ('var, 'tyvar, 'a::var, 'b) T2 \ ('var, 'tyvar, 'a, 'c) U2 \ ('var, 'tyvar, 'a, 'c) U2" where "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 +abbreviation U1FVars_1 :: "('var, 'tyvar, 'a, 'b) T1 \ ('var::var, 'tyvar::var, 'a::var, 'c) U1 \ 'var set" where "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 +abbreviation U1FVars_2 :: "('var, 'tyvar, 'a, 'b) T1 \ ('var::var, 'tyvar::var, 'a::var, 'c) U1 \ 'tyvar set" where "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 +abbreviation U2FVars_1 :: "('var, 'tyvar, 'a, 'b) T2 \ ('var::var, 'tyvar::var, 'a::var, 'c) U2 \ 'var set" where "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 +abbreviation U2FVars_2 :: "('var, 'tyvar, 'a, 'b) T2 \ ('var::var, 'tyvar::var, 'a::var, 'c) U2 \ 'tyvar set" where "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 +function set3_raw_T1 :: "('var::var, 'tyvar::var, 'a::var, 'b) raw_T1 \ 'a set" + and set3_raw_T2 :: "('var::var, 'tyvar::var, 'a::var, 'b) raw_T2 \ 'a set" where "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 @@ -68,8 +68,8 @@ termination apply (unfold mem_Collect_eq prod.case sum.case) 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 +function set4_raw_T1 :: "('var::var, 'tyvar::var, 'a::var, 'b) raw_T1 \ 'b set" + and set4_raw_T2 :: "('var::var, 'tyvar::var, 'a::var, 'b) raw_T2 \ 'b set" where "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 @@ -92,7 +92,7 @@ definition "set3_T2 x \ set3_raw_T2 (quot_type.rep Rep_T2 x)" definition "set4_T1 x \ set4_raw_T1 (quot_type.rep Rep_T1 x)" 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" +coinductive rel_T1 :: "('b \ 'c \ bool) \ ('var::var, 'tyvar::var, 'a::var, '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| \(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 ; @@ -112,7 +112,7 @@ lemma Pmap_id0: "Pmap id id = id" done lemma Pmap_comp0: - fixes f1 g1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2 g2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1 g1::"'var::var \ 'var" and f2 g2::"'tyvar::var \ 'tyvar" assumes "bij f1" "|supp f1| Pmap (g1 \ f1) (g2 \ f2) p = (Pmap g1 g2 \ Pmap f1 f2) p" @@ -123,7 +123,7 @@ lemma Pmap_comp0: apply (rule refl) done lemma Pmap_cong_id: - fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes "bij f1" "|supp f1| (\a. a \ PFVars_1 p \ f1 a = a) \ (\a. a \ PFVars_2 p \ f2 a = a) \ Pmap f1 f2 p = p" apply (unfold case_prod_beta fst_conv snd_conv) @@ -133,7 +133,7 @@ lemma Pmap_cong_id: apply (rule refl) done lemma PFVars_Pmap: - fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes "bij f1" "|supp f1| PFVars_1 (Pmap f1 f2 p) = f1 ` PFVars_1 p" @@ -146,7 +146,7 @@ lemma PFVars_Pmap: apply (rule refl) done lemma small_PFVars: - fixes p::"('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a, 'b, 'c) P" + fixes p::"('var::var, 'tyvar::var, 'a, 'b, 'c) P" shows "validP p \ |PFVars_1 p| |PFVars_2 p| 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes "bij f1" "|supp f1| 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 @@ -229,7 +229,7 @@ lemma U1map_Uctor: (* END REPEAT_DETERM *) done lemma U2map_Uctor: - fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes "bij f1" "|supp f1| 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 @@ -303,11 +303,11 @@ 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 \ {}) = {} \ + "validP p \ set5_T1_pre (y::(_, _, 'a::var, '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 \ {}) = {} \ + "validP p \ set6_T1_pre (y::(_, _, 'a::var, '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 \ {}" @@ -480,11 +480,11 @@ 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 \ {}) = {} \ + "validP p \ set5_T2_pre (y::(_, _, 'a::var, '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 \ {}) = {} \ + "validP p \ set6_T2_pre (y::(_, _, 'a::var, '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 \ {}" @@ -657,7 +657,7 @@ lemma U2FVars_subsets: done lemma valid_Pmap: - fixes f1::"'var::{var_T1_pre, var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre, var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes "bij f1" "|supp f1| validP (Pmap f1 f2 p)" apply (unfold case_prod_beta fst_conv snd_conv compSS_def) @@ -669,18 +669,18 @@ ML \ val nvars:int = 2 val parameters_struct = { - P = @{typ "('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'c) P"}, - Pmap = @{term "Pmap :: _ \ _ \ ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'c) P \ _"}, + P = @{typ "('var::var, 'tyvar::var, 'a::var, 'b, 'c) P"}, + Pmap = @{term "Pmap :: _ \ _ \ ('var::var, 'tyvar::var, 'a::var, 'b, 'c) P \ _"}, PFVarss = [ - @{term "PFVars_1 :: ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'c) P \ _"}, - @{term "PFVars_2 :: ('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'c) P \ _"} + @{term "PFVars_1 :: ('var::var, 'tyvar::var, 'a::var, 'b, 'c) P \ _"}, + @{term "PFVars_2 :: ('var::var, 'tyvar::var, 'a::var, 'b, 'c) P \ _"} ], avoiding_sets = [ - @{term "{} :: 'var::{var_T1_pre,var_T2_pre} set"}, - @{term "{} :: 'tyvar::{var_T1_pre,var_T2_pre} set"} + @{term "{} :: 'var::var set"}, + @{term "{} :: 'tyvar::var set"} ], validity = SOME { - pred = @{term "validP::('var::{var_T1_pre, var_T2_pre}, 'tyvar::{var_T1_pre, var_T2_pre}, 'a::{var_T1_pre, var_T2_pre}, 'b, 'c) P => bool"}, + pred = @{term "validP::('var::var, 'tyvar::var, 'a::var, 'b, 'c) P => bool"}, valid_Pmap = fn ctxt => resolve_tac ctxt @{thms valid_Pmap} 1 THEN REPEAT_DETERM (assume_tac ctxt 1) }, min_bound = false, @@ -702,13 +702,13 @@ val parameters_struct = { ML \ val T1_model = { binding = @{binding vvsubst_T1}, - U = @{typ "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'c) U1"}, + U = @{typ "('var::var, 'tyvar::var, 'a::var, 'c) U1"}, UFVarss = [ - @{term "U1FVars_1 :: _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'c) U1 \ _"}, - @{term "U1FVars_2 :: _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'c) U1 \ _"} + @{term "U1FVars_1 :: _ \ ('var::var, 'tyvar::var, 'a::var, 'c) U1 \ _"}, + @{term "U1FVars_2 :: _ \ ('var::var, 'tyvar::var, 'a::var, 'c) U1 \ _"} ], - Umap = @{term "U1map::_ \ _ \ _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'c) U1 \ _"}, - Uctor = @{term "U1ctor::_ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b, 'c) P \ _"}, + Umap = @{term "U1map::_ \ _ \ _ \ ('var::var, 'tyvar::var, 'a::var, 'c) U1 \ _"}, + Uctor = @{term "U1ctor::_ \ ('var::var, 'tyvar::var, 'a::var, 'b, 'c) P \ _"}, validity = NONE : { pred: term, valid_Umap: Proof.context -> tactic, @@ -736,13 +736,13 @@ val T1_model = { val T2_model = { binding = @{binding vvsubst_T2}, - U = @{typ "('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'c) U2"}, + U = @{typ "('var::var, 'tyvar::var, 'a::var, 'c) U2"}, UFVarss = [ - @{term "U2FVars_1 :: _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'c) U2 \ _"}, - @{term "U2FVars_2 :: _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'c) U2 \ _"} + @{term "U2FVars_1 :: _ \ ('var::var, 'tyvar::var, 'a::var, 'c) U2 \ _"}, + @{term "U2FVars_2 :: _ \ ('var::var, 'tyvar::var, 'a::var, 'c) U2 \ _"} ], - Umap = @{term "U2map::_ \ _ \ _ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'c) U2 \ _"}, - Uctor = @{term "U2ctor::_ \ ('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b, 'c) P \ _"}, + Umap = @{term "U2map::_ \ _ \ _ \ ('var::var, 'tyvar::var, 'a::var, 'c) U2 \ _"}, + Uctor = @{term "U2ctor::_ \ ('var::var, 'tyvar::var, 'a::var, 'b, 'c) P \ _"}, validity = NONE : { pred: term, valid_Umap: Proof.context -> tactic, @@ -786,14 +786,14 @@ let in lthy end\ print_theorems -definition vvsubst_T1 :: "('var::{var_T1_pre,var_T2_pre} \ 'var) \ ('tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar) \ ('a::{var_T1_pre,var_T2_pre} \ 'a) \ ('b \ 'c) \ ('var, 'tyvar, 'a, 'b) T1 \ ('var, 'tyvar, 'a, 'c) T1" where +definition vvsubst_T1 :: "('var::var \ 'var) \ ('tyvar::var \ 'tyvar) \ ('a::var \ 'a) \ ('b \ 'c) \ ('var, 'tyvar, 'a, 'b) T1 \ ('var, 'tyvar, 'a, 'c) T1" where "vvsubst_T1 f1 f2 f3 f4 t \ ff01_vvsubst_T1_vvsubst_T2 t (f1, f2, f3, f4)" -definition vvsubst_T2 :: "('var::{var_T1_pre,var_T2_pre} \ 'var) \ ('tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar) \ ('a::{var_T1_pre,var_T2_pre} \ 'a) \ ('b \ 'c) \ ('var, 'tyvar, 'a, 'b) T2 \ ('var, 'tyvar, 'a, 'c) T2" where +definition vvsubst_T2 :: "('var::var \ 'var) \ ('tyvar::var \ 'tyvar) \ ('a::var \ 'a) \ ('b \ 'c) \ ('var, 'tyvar, 'a, 'b) T2 \ ('var, 'tyvar, 'a, 'c) T2" where "vvsubst_T2 f1 f2 f3 f4 t \ ff02_vvsubst_T1_vvsubst_T2 t (f1, f2, f3, f4)" -definition pick1 :: "('b \ 'c \ bool) \ ('var::{var_T1_pre,var_T2_pre} \ 'var) \ ('tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar) \ ('a::{var_T1_pre,var_T2_pre} \ 'a) \ ('var, 'tyvar, 'a, 'b) T1 \ ('var, 'tyvar, 'a, 'c) T1 \ ('var, 'tyvar, 'a, 'b \ 'c) T1" where +definition pick1 :: "('b \ 'c \ bool) \ ('var::var \ 'var) \ ('tyvar::var \ 'tyvar) \ ('a::var \ 'a) \ ('var, 'tyvar, 'a, 'b) T1 \ ('var, 'tyvar, 'a, 'c) T1 \ ('var, 'tyvar, 'a, 'b \ 'c) T1" where "pick1 R f1 f2 f3 xy \ SOME z. set4_T1 z \ {(x, y). R x y} \ vvsubst_T1 id id id fst z = fst xy \ vvsubst_T1 f1 f2 f3 snd z = snd xy" -definition pick2 :: "('b \ 'c \ bool) \ ('var::{var_T1_pre,var_T2_pre} \ 'var) \ ('tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar) \ ('a::{var_T1_pre,var_T2_pre} \ 'a) \ ('var, 'tyvar, 'a, 'b) T2 \ ('var, 'tyvar, 'a, 'c) T2 \ ('var, 'tyvar, 'a, 'b \ 'c) T2" where +definition pick2 :: "('b \ 'c \ bool) \ ('var::var \ 'var) \ ('tyvar::var \ 'tyvar) \ ('a::var \ 'a) \ ('var, 'tyvar, 'a, 'b) T2 \ ('var, 'tyvar, 'a, 'c) T2 \ ('var, 'tyvar, 'a, 'b \ 'c) T2" where "pick2 R f1 f2 f3 xy \ SOME z. set4_T2 z \ {(x, y). R x y} \ vvsubst_T2 id id id fst z = fst xy \ vvsubst_T2 f1 f2 f3 snd z = snd xy" lemma conj_spec: "(\x. P x) \ (\y. Q y) \ P x \ Q y" @@ -807,9 +807,9 @@ lemma conj_mp: "(P1 \ Q1) \ (P2 \ Q2) \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" - 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" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" + and x::"('var, 'tyvar, 'a::var, 'b) raw_T1" + and y::"('var, 'tyvar, 'a::var, 'b) raw_T2" assumes "bij f1" "|supp f1| 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" - 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" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" + and x::"('var, 'tyvar, 'a::var, 'b) raw_T1" + and y::"('var, 'tyvar, 'a::var, 'b) raw_T2" assumes "bij f1" "|supp f1| set3_raw_T1 x = set3_raw_T1 y" "alpha_T2 x2 y2 \ set3_raw_T2 x2 = set3_raw_T2 y2" proof - @@ -1123,8 +1123,8 @@ proof - qed lemma set4_raw_alpha: - fixes x y::"('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) raw_T1" - and x2 y2::"('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) raw_T2" + fixes x y::"('var::var, 'tyvar::var, 'a::var, 'b) raw_T1" + and x2 y2::"('var::var, 'tyvar::var, 'a::var, 'b) raw_T2" shows "alpha_T1 x y \ set4_raw_T1 x = set4_raw_T1 y" "alpha_T2 x2 y2 \ set4_raw_T2 x2 = set4_raw_T2 y2" proof - @@ -1487,7 +1487,7 @@ lemma set4_T2_intros: done lemma vvsubst_cctor_1: - 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" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" and f3::"'a::var \ 'a" and f4::"'b \ 'c" assumes f_prems: "|supp f1| set5_T1_pre x = {}" "imsupp f2 \ set6_T1_pre x = {}" and noclash_prems: "noclash_T1 x" @@ -1510,7 +1510,7 @@ lemma vvsubst_cctor_1: done lemma vvsubst_cctor_2: - 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" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" and f3::"'a::var \ 'a" and f4::"'b \ 'c" assumes f_prems: "|supp f1| set5_T2_pre x = {}" "imsupp f2 \ set6_T2_pre x = {}" and noclash_prems: "noclash_T2 x" @@ -1534,11 +1534,11 @@ lemma vvsubst_cctor_2: done lemma vvsubst_permutes: - fixes f1::"'var::{var_T1_pre,var_T2_pre} \ 'var" and f2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" assumes f_prems: "bij f1" "|supp f1| '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" + "vvsubst_T1 f1 f2 (id::'a::var \ 'a) (id::'b \ 'b) = permute_T1 f1 f2" + "vvsubst_T2 f1 f2 (id::'a::var \ '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 = permute_T1 f1 f2 x \ vvsubst_T2 f1 f2 id id y = permute_T2 f1 f2 y" subgoal for x y @@ -1603,12 +1603,12 @@ proof - apply (rule sym, assumption)+ done done - show "vvsubst_T1 f1 f2 (id::'a::{var_T1_pre,var_T2_pre} \ 'a) (id::'b \ 'b) = permute_T1 f1 f2" + show "vvsubst_T1 f1 f2 (id::'a::var \ '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) = permute_T2 f1 f2" + show "vvsubst_T2 f1 f2 (id::'a::var \ 'a) (id::'b \ 'b) = permute_T2 f1 f2" apply (rule ext) apply (rule conjunct2[OF x]) done @@ -1656,8 +1656,8 @@ lemma rel_plain_cases: done 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" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" + and x::"('var, 'tyvar, 'a::var, 'b) T1" and x2::"('var, 'tyvar, 'a, 'b) T2" assumes "bij f1" "|supp f1| rel_T1 R x y" @@ -1814,8 +1814,8 @@ proof - qed 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" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" + and x::"('var, 'tyvar, 'a::var, 'b) T1" and x2::"('var, 'tyvar, 'a, 'b) T2" assumes "bij f1" "|supp f1| 'c \ bool" - and x::"('var::{var_T1_pre,var_T2_pre}, 'tyvar::{var_T1_pre,var_T2_pre}, 'a::{var_T1_pre,var_T2_pre}, 'b) T1" + and x::"('var::var, 'tyvar::var, 'a::var, 'b) T1" and x2::"('var, 'tyvar, 'a, 'b) T2" shows "rel_T1 R x y \ FVars_T11 x = FVars_T11 y" @@ -2536,7 +2536,7 @@ qed (* required for other proofs, ie needed as `thm` *) 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" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" and f3::"'a::var \ 'a" and f4::"'b \ 'c" assumes f_prems: "|supp f1| '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" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" and f3::"'a::var \ 'a" and f4::"'b \ 'c" assumes f_prems: "|supp f1| '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" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" and f3::"'a::var \ 'a" and f4::"'b \ 'c" assumes f_prems: "|supp f1| 'var" and f2 g2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" and f3 g3::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f4::"'b \ 'c" and g4::"'c \ 'd" + fixes f1 g1::"'var::var \ 'var" and f2 g2::"'tyvar::var \ 'tyvar" and f3 g3::"'a::var \ 'a" and f4::"'b \ 'c" and g4::"'c \ 'd" assumes f_prems: "|supp f1| f1) (g2 \ f2) (g3 \ f3) (g4 \ f4) = vvsubst_T1 g1 g2 g3 g4 \ vvsubst_T1 f1 f2 f3 f4" @@ -3056,7 +3056,7 @@ qed (* not required for other proofs, only tactic needed *) lemma set_bd: - "|set3_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)| 'var" and f2 g2::"'tyvar::{var_T1_pre,var_T2_pre} \ 'tyvar" and f3 g3::"'a::{var_T1_pre,var_T2_pre} \ 'a" and f4 g4::"'b \ 'c" + fixes f1 g1::"'var::var \ 'var" and f2 g2::"'tyvar::var \ 'tyvar" and f3 g3::"'a::var \ 'a" and f4 g4::"'b \ 'c" assumes f_prems: "|supp f1| _) OO rel_T1 S \ rel_T1 (R OO S)" + "(rel_T1 R :: ('var::var, 'tyvar::var, 'a::var, 'b) T1 \ _) OO rel_T1 S \ rel_T1 (R OO S)" "(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| _) OO rel_T1 S \ rel_T1 (R OO S)" + "(rel_T1 R :: ('var::var, 'tyvar::var, 'a::var, 'b) T1 \ _) OO rel_T1 S \ rel_T1 (R OO S)" "(rel_T2 R :: ('var, 'tyvar, 'a, 'b) T2 \ _) OO rel_T2 S \ rel_T2 (R OO S)" subgoal apply (rule predicate2I) @@ -3812,7 +3812,7 @@ proof - qed lemma in_rel1: - 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 R::"'b \ 'c \ bool" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" and f3::"'a::var \ 'a" and R::"'b \ 'c \ bool" assumes "|supp f1| \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" @@ -4963,7 +4963,7 @@ proof - qed lemma in_rel2: - 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 R::"'b \ 'c \ bool" + fixes f1::"'var::var \ 'var" and f2::"'tyvar::var \ 'tyvar" and f3::"'a::var \ 'a" and R::"'b \ 'c \ bool" assumes "|supp f1| 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_T1 R (vvsubst_T1 f1 f2 f3 id x) y" @@ -5163,18 +5163,6 @@ lemma wit_thms: apply (erule UnE UN_E T1_pre.wit T2_pre.wit)+ done -class var_T1 = - assumes large: "|Field natLeq| \o |UNIV::'a set|" and regular: "regularCard |UNIV::'a set|" - -subclass (in var_T1) var_T1_pre - apply standard - apply (rule large) - apply (rule regular) - done -subclass (in var_T1) var_T2_pre - apply standard - done - mrbnf "('var, 'tyvar, 'a, 'b) T1" map: vvsubst_T1 sets: @@ -5185,7 +5173,6 @@ mrbnf "('var, 'tyvar, 'a, 'b) T1" bd: natLeq wits: "T1_ctor (wit_T1_pre)" rel: rel_T1 - var_class: var_T1 subgoal apply (rule trans) apply (rule vvsubst_permutes) @@ -5218,7 +5205,6 @@ mrbnf "('var, 'tyvar, 'a, 'b) T2" bd: natLeq wits: "T2_ctor wit_T2_pre" rel: rel_T2 - var_class: var_T1 subgoal apply (rule trans) apply (rule vvsubst_permutes) diff --git a/thys/Infinitary_FOL/InfFOL.thy b/thys/Infinitary_FOL/InfFOL.thy index 5550ad1e..03aeb4c9 100644 --- a/thys/Infinitary_FOL/InfFOL.thy +++ b/thys/Infinitary_FOL/InfFOL.thy @@ -216,11 +216,6 @@ lift_definition k2member :: "'a \ 'a set\<^sub>k\<^sub>2 \k \ 'a \ 'a set\<^sub>k" (infixl "," 600) is "\xs x. binsert x xs" . -instantiation k :: infinite begin -instance apply standard - using cinfinite_iff_infinite var_set\<^sub>k\<^sub>2_class.cinfinite by blast -end - lemma small_set\<^sub>k\<^sub>2[simp]: "small (set\<^sub>k\<^sub>2 (V :: k set\<^sub>k\<^sub>2))" unfolding small_def apply (rule ordLess_ordLeq_trans[OF set\<^sub>k\<^sub>2.set_bd]) @@ -375,7 +370,7 @@ binder_inductive deduct subgoal for f V 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'.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) + 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) @@ -401,7 +396,7 @@ binder_inductive deduct apply (subst supp_o_bij) apply assumption apply (subst comp_apply) - apply (unfold ifol'_vvsubst_permute ifol'_vvsubst_permute[OF bij_imp_bij_inv supp_inv_bound]) + apply (unfold ifol'.vvsubst_permute ifol'.vvsubst_permute[OF bij_imp_bij_inv supp_inv_bound]) apply (subst ifol'.permute_comp) apply (rule supp_inv_bound bij_imp_bij_inv | assumption)+ apply (subst inv_o_simp1, assumption) @@ -557,7 +552,7 @@ binder_inductive deduct apply (rule exI[of _ \']) apply (rule conjI) - apply (subst ifol'_vvsubst_permute[symmetric]) + apply (subst ifol'.vvsubst_permute[symmetric]) apply (rule \_bij) apply (rule \_small) apply (subst ifol'.map_comp) diff --git a/thys/Infinitary_Lambda_Calculus/ILC.thy b/thys/Infinitary_Lambda_Calculus/ILC.thy index f94be214..89bbaf6b 100644 --- a/thys/Infinitary_Lambda_Calculus/ILC.thy +++ b/thys/Infinitary_Lambda_Calculus/ILC.thy @@ -53,7 +53,6 @@ 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] @@ -61,7 +60,7 @@ lemma ex_inj_infinite_regular_var_iterm_pre: apply (rule ordLeq_transitive[OF countable_card_le_natLeq[THEN iffD1]]) apply simp apply (rule natLeq_ordLeq_cinfinite) - apply (rule iterm_pre.bd_Cinfinite) + using cinfinite_def cinfinite_iff_infinite iterm_pre.bd_Cinfinite apply blast done definition embed :: "'a :: countable \ 'b :: var_iterm_pre" @@ -125,13 +124,14 @@ instance apply standard apply (rule ordLeq_ordIso_trans[OF _ ordIso_symmetric[OF card_ivar]]) apply (rule ordIso_ordLeq_trans[OF card_of_Field_ordIso]) - apply (tactic \resolve_tac @{context} [BNF_Def.bnf_of @{context} @{type_name stream} |> the |> BNF_Def.bd_Card_order_of_bnf] 1\) - apply (simp add: bd_stream_def card_suc_least le_card_ivar natLeq_Cinfinite natLeq_card_order) - apply (rule regularCard_ivar) - using Field_natLeq infinite_iff_card_of_nat infinite_ivar apply auto[1] - apply (rule ordIso_ordLeq_trans[OF card_of_Field_ordIso]) - apply (simp add: Card_order_card_suc natLeq_card_order) - apply (metis card_of_Card_order card_of_card_order_on card_of_nat card_suc_alt card_suc_least countable_card_ivar countable_card_le_natLeq ordIso_imp_ordLeq) + apply (rule natLeq_Card_order) + using le_card_ivar ordLess_imp_ordLeq apply blast + using regularCard_ivar apply auto[1] + apply (rule ordIso_ordLeq_trans[OF card_of_Field_ordIso]) + apply (tactic \resolve_tac @{context} [BNF_Def.bnf_of @{context} @{type_name stream} |> the |> BNF_Def.bd_Card_order_of_bnf] 1\) + apply (simp add: bd_stream_def card_suc_least le_card_ivar natLeq_Cinfinite natLeq_card_order) + apply (metis card_of_Card_order card_of_card_order_on card_suc_alt card_suc_least countable_card_ivar countable_card_of_nat ordLeq_refl) + apply (metis Field_card_of card_of_UNIV card_of_card_order_on card_of_mono2 card_suc_alt card_suc_least countable_card_ivar countable_card_of_nat) done end @@ -244,7 +244,7 @@ next case (iLam x1 x2) then show ?case using f g apply simp by (smt (verit, ccfv_threshold) IImsupp_def SSupp_def UnCI insert_absorb insert_disjoint(2) mem_Collect_eq) -qed (auto simp: IImsupp_def iterm.UNION_bound iterm.Un_bound iterm.set_bd_UNIV f g) +qed (auto simp: IImsupp_def iterm.UN_bound iterm.Un_bound iterm.set_bd_UNIV f g) (* *) @@ -393,7 +393,7 @@ by (simp add: cinfinite_imp_infinite supp_swap_bound iterm.UNIV_cinfinite) lemma SSupp_IImsupp_bound: "|SSupp \| |IImsupp \| IImsupp (\a. itvsubst \ (\ a)) = {}") @@ -518,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_permute 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 @@ -597,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_permute[simp del] + note iterm.vvsubst_permute[simp del] show ?thesis using assms - apply(subst iterm_vvsubst_permute[symmetric]) apply auto + apply(subst iterm.vvsubst_permute[symmetric]) apply auto apply(subst iterm.map_comp) apply auto - apply(subst iterm_vvsubst_permute[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 @@ -773,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_permute[simp del] + note iterm.vvsubst_permute[simp del] show ?thesis using assms - apply(subst iterm_vvsubst_permute[symmetric]) apply simp + apply(subst iterm.vvsubst_permute[symmetric]) apply simp subgoal by auto subgoal apply(subst iterm.map_comp) subgoal by auto diff --git a/thys/Infinitary_Lambda_Calculus/ILC_UBeta_depth.thy b/thys/Infinitary_Lambda_Calculus/ILC_UBeta_depth.thy index 0dbbb2d6..4bc7be40 100644 --- a/thys/Infinitary_Lambda_Calculus/ILC_UBeta_depth.thy +++ b/thys/Infinitary_Lambda_Calculus/ILC_UBeta_depth.thy @@ -97,7 +97,7 @@ apply standard unfolding isPerm_def Tperm_def using iterm.set_bd_UNIV dsset_card_ls apply (auto simp: dstream_map_ident_strong small_def 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 + intro!: iterm.UN_bound iterm.Un_bound 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 diff --git a/thys/Infinitary_Lambda_Calculus/ILC_uniform.thy b/thys/Infinitary_Lambda_Calculus/ILC_uniform.thy index 55f795e2..17013c32 100644 --- a/thys/Infinitary_Lambda_Calculus/ILC_uniform.thy +++ b/thys/Infinitary_Lambda_Calculus/ILC_uniform.thy @@ -369,7 +369,7 @@ proof- by (metis e2 iApp_inject reneqvS_def reneqv_iApp_casesL u uniformS_def3 uniformS_touchedSuper uniform_def3) have ss: "small (\ (FFVars ` (sset es2)))" - unfolding small_def apply(rule var_prod_class.UN_bound) + unfolding small_def apply(rule iterm.UN_bound) subgoal by (simp add: countable_card_ivar countable_sset) subgoal using iterm.set_bd_UNIV by blast . diff --git a/thys/Infinitary_Lambda_Calculus/PrettyPrinting.thy b/thys/Infinitary_Lambda_Calculus/PrettyPrinting.thy deleted file mode 100644 index 58c72568..00000000 --- a/thys/Infinitary_Lambda_Calculus/PrettyPrinting.thy +++ /dev/null @@ -1,414 +0,0 @@ -theory PrettyPrinting -imports "Untyped_Lambda_Calculus.LC" (*BSmall*) "Prelim.Curry_LFP" (* ILC2 *) -"Binders.Generic_Barendregt_Enhanced_Rule_Induction" -begin - -(* *) -(* raw terms: *) -datatype rtrm = VAR var | APP rtrm rtrm | LAM var rtrm - -fun Vars where -"Vars (VAR x) = {x}" -| -"Vars (APP T S) = Vars T \ Vars S" -| -"Vars (LAM x T) = {x} \ Vars T" - -lemma finite_Vars[intro]: "finite (Vars T)" -by (induct T, auto) - -fun rrrename where -"rrrename f (VAR x) = VAR (f x)" -| -"rrrename f (APP T S) = APP (rrrename f T) (rrrename f S)" -| -"rrrename f (LAM x T) = LAM (f x) (rrrename f T)" - -lemma rrrename_id[simp]: "rrrename id = id" -apply(rule ext) subgoal for T by (induct T, auto) . - -lemma rrrename_o[simp]: "rrrename (g o f) = rrrename g o rrrename f" -apply(rule ext) subgoal for T by (induct T, auto) . - -lemma rrrename_Vars[simp]: "Vars (rrrename f T) = f ` (Vars T)" -by (induct T, auto) - -lemma rrrename_cong: -"\x\Vars T. f x = x \ rrrename f T = T" -by (induct T, auto) - - -(* ASCII-only variables: *) -consts AVar :: "var set" - -axiomatization where infinite_AVar: "infinite AVar" - -term usub - -inductive ppr :: "trm \ rtrm \ bool" where - Var_VAR: "x \ AVar \ ppr (Var x) (VAR x)" -| App_APP: "ppr t T \ ppr s S \ ppr (App t s) (APP T S)" -| Lam_LAM: "y \ AVar \ y \ {x} \ FFVars t \ - ppr (usub t y x) T \ ppr (Lam x t) (LAM y T)" - - -(* INSTANTIATING THE ABSTRACT SETTING: *) - -(* PREPARING THE INSTANTIATION: *) - -type_synonym B = "(var \ var) set" - -fun Bperm :: "(var \ var) \ B \ B" where -"Bperm f = image (map_prod f f)" - -fun Bsupp :: "B \ var set" where -"Bsupp XY = image fst XY \ \\ image snd XY \" - -fun bnd :: "B \ bool" where -"bnd XY \ finite XY \ image snd XY \ AVar" - - -fun bsmall :: "var set \ bool" -where -"bsmall XY = finite XY" - -(* -lemma ppr_touchedSuperT: -"ppr e1 e2 \ touchedSuperT e1 = touchedSuperT e2 \ finite (touchedSuperT e1) \ finite (touchedSuperT e2) " -proof(induct rule: ppr.induct) - case (iVar xs x x') - then show ?case by auto -next - case (iLam xs e e') - then show ?case by auto -next - case (iApp e1 e1' es2 es2') - obtain e2 e2' where e2: "e2 \ sset es2" and e2': "e2' \ sset es2'" - using shd_sset by blast+ - hence 0: "touchedSuperT ` sset es2 = {touchedSuperT e2}" "touchedSuperT ` sset es2' = {touchedSuperT e2}" - using iApp(3) by auto - have "\ (touchedSuperT ` sset es2) = \ (touchedSuperT ` sset es2') \ - finite (\ (touchedSuperT ` sset es2)) \ finite (\ (touchedSuperT ` sset es2'))" - unfolding 0 using iApp(3) e2 e2' by auto - thus ?case using iApp by simp -qed - -lemmas ppr_touchedSuperT_eq = ppr_touchedSuperT[THEN conjunct1] -lemmas ppr_finite_touchedSuperT = ppr_touchedSuperT[THEN conjunct2] -*) - -(* INSTANTIATING THE CComponents LOCALE: *) - -type_synonym T = "trm \ rtrm" - -definition Tperm :: "(var \ var) \ T \ T" where -"Tperm f \ map_prod (rrename f) (rrrename f)" - -fun Tsupp :: "T \ var set" where -"Tsupp (e1,e2) = FFVars e1 \ Vars e2" - - - -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.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 - subgoal using finite_iff_le_card_var small_def by blast - subgoal unfolding image_def by force - (* subgoal unfolding image_def sledgehammer by force . *) sorry - subgoal unfolding image_def by (metis (mono_tags, lifting) Un_iff fst_conv mem_Collect_eq snd_conv) - subgoal - by (smt (verit, del_insts) Un_iff fst_conv fst_map_prod imageI snd_conv snd_map_prod surj_pair) . - - - -lemma presBnd_imp: "presBnd \ \ \ ` AVar \ AVar" -unfolding presBnd_def apply auto subgoal for x apply(erule allE[of _ "{(undefined,x)}"]) -apply auto - by auto . - -(* -lemma presBnd_presSuper: "presBnd = presSuper" -unfolding presBnd_def presSuper_def fun_eq_iff apply safe - subgoal for \ xs apply(erule allE[of _ "Some xs"]) by auto - subgoal for \ xs apply(erule allE[of _ "Some xs"]) by auto - subgoal for \ xxs apply(cases xxs) by auto - subgoal for \ xxs apply(cases xxs) by auto . -*) - -(* -inductive ppr :: "trm \ rtrm \ bool" where - Var_VAR: "x \ AVar \ ppr (Var x) (VAR x)" -| App_APP: "ppr t T \ ppr s S \ ppr (App t s) (APP T S)" -| Lam_LAM: "y \ {x} \ FFVars t \ Vars T \ - ppr (usub t y x) t' \ ppr (Lam x t) (LAM y T)" -*) - -definition G :: "B \ (T \ bool) \ T \ bool" -where -"G \ \B R tt. - (\x. B = {} \ fst tt = Var x \ snd tt = VAR x \ - x \ AVar) - \ - (\t T s S. B = {} \ fst tt = App t s \ snd tt = APP T S \ - R (t,T) \ R (s,S)) - \ - (\y x t T. B = {(x,y)} \ fst tt = Lam x t \ snd tt = LAM y T \ - y \ AVar \ y \ {x} \ FFVars t \ R (usub t y x,T))" - - -(* VERIFYING THE HYPOTHESES FOR BARENDREGT-ENHANCED INDUCTION: *) - -lemma G_mmono: "R \ R' \ G xxs R t \ G xxs R' t" -unfolding G_def by fastforce - -(* NB: Everything is passed \-renamed as witnesses to exI *) -lemma G_eequiv: -"isPerm \ \ presBnd \ \ G B R tt \ - G (Bperm \ B) (\tt'. R (Tperm (inv \) tt')) (Tperm \ tt)" -unfolding G_def apply(drule presBnd_imp) apply(elim disjE) - subgoal apply(rule disjI3_1) - subgoal apply(elim exE) subgoal for x - apply(rule exI[of _ "\ x"]) - apply(cases tt) unfolding isPerm_def small_def Tperm_def by auto . . - (* *) - subgoal apply(rule disjI3_2) - subgoal apply(elim exE) subgoal for t T s S - apply(rule exI[of _ "rrename \ t"]) - apply(rule exI[of _ "rrrename \ T"]) - apply(rule exI[of _ "rrename \ s"]) - 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.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.permute_bij term.permute_inv_simp) - . . . - - - -(* *) - -lemma G_bnd: "G B R tt \ bnd B" -unfolding G_def by auto - -lemma eextend_to_presBnd: -assumes "bnd B" "small A" "bsmall A" "A' \ A" "Bsupp B \ A' = {}" -shows "\\. isPerm \ \ presBnd \ \ \ ` Bsupp B \ A = {} \ id_on A' \" -sorry -(* proof(cases xxs) - case None - thus ?thesis apply(intro exI[of _ id]) unfolding isPerm_def by auto -next - case (Some xs) - hence 0: "super xs" "|A| A" - "dsset xs \ A' = {}" - using assms by (auto split: option.splits simp: small_def bsmall_def) - show ?thesis using extend_super[OF 0] apply safe - subgoal for \ apply(rule exI[of _ \]) - using Some by (auto split: option.splits simp: presBnd_presSuper isPerm_def) . -qed -*) - - -interpretation Ppr : IInduct1 -where Tperm = Tperm and Tsupp = Tsupp and Bperm = Bperm and Bsupp = Bsupp -and bnd = bnd and bsmall = bsmall and GG = G -apply standard -using G_mmono G_eequiv G_bnd eextend_to_presBnd by auto - - -(* *) - -lemma ppr_I: "ppr t1 t2 = Ppr.II (t1,t2)" -unfolding ppr_def Ppr.II_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 conjE) - \<^cancel>\Var_VAR: \ - subgoal for x apply(rule exI[of _ "{}"]) apply(rule disjI3_1) by auto - \<^cancel>\App_APP: \ - subgoal for t T s S apply(rule exI[of _ "{}"]) apply(rule disjI3_2) by auto - \<^cancel>\Lam_LAM: \ - subgoal for y x t T apply(rule exI[of _ "{(x,y)}"]) apply(rule disjI3_3) by auto . - (* *) - subgoal apply(elim disjE exE conjE) - \<^cancel>\iVar: \ - subgoal apply(rule disjI3_1) by auto - \<^cancel>\iLam: \ - subgoal apply(rule disjI3_2) by auto - \<^cancel>\iApp: \ - subgoal apply(rule disjI3_3) by auto . . . - - -lemma III_bsmall: "Ppr.II t \ bsmall (Tsupp t)" -apply(cases t) - subgoal for e1 e2 - apply auto by (simp add: finite_iff_le_card_var term.card_of_FFVars_bounds) . - -(* -lemma Tvars_dsset: "dsset xs \ (Tsupp t - dsset xs) = {}" - "|Tsupp t - dsset xs| finite (touchedSuper (Tsupp t - dsset ys))" -subgoal using Diff_disjoint . -subgoal using small_def card_of_minus_bound ssmall_Tsupp by blast -subgoal apply(subgoal_tac "bsmall (Tsupp t)") - subgoal unfolding bsmall_def - by (meson Diff_subset rev_finite_subset touchedSuper_mono) - subgoal by (metis III_bsmall) . . -*) - -lemma G_rrefresh: -"(\tt. R tt \ Ppr.II tt) \ - (\\ t. isPerm \ \ presBnd \ \ R tt \ R (Tperm \ tt)) \ - G B R tt \ - \B'. Bsupp B' \ Tsupp tt = {} \ G B' R tt" -apply(cases tt) subgoal for t T apply apply simp -apply(subgoal_tac "Ppr.II tt") defer - - -term term (* -apply (metis Ppr.GG_mmono2 Ppr.II.simps predicate1I) -subgoal premises p using p apply- -apply(frule G_bnd) -unfolding G_def Tperm_def apply safe - subgoal for xs x x' - apply(rule exI[of _ None]) - apply(intro conjI) - subgoal by simp - subgoal apply(rule disjI3_1) - apply(rule exI[of _ xs]) - apply(rule exI[of _ x]) - apply(rule exI[of _ x']) - apply(cases t) apply simp . . - (* *) - subgoal for xs e e' - apply(frule refresh_super[OF Tvars_dsset(1,2) Tvars_dsset(3)[OF p(4)]]) - apply safe - subgoal for f - apply(rule exI[of _ "Some (dsmap f xs)"]) - apply(intro conjI) - subgoal unfolding id_on_def presSuper_def by (cases t, auto) - subgoal apply(rule disjI3_2) - apply(rule exI[of _ "dsmap f xs"]) - apply(rule exI[of _ "irrename f e"]) - apply(rule exI[of _ "irrename f e'"]) - apply(cases t) unfolding presSuper_def apply simp apply(intro conjI) - subgoal apply(subst iLam_irrename[of "f"]) unfolding id_on_def by auto - subgoal apply(subst irrename_eq_itvsubst_iVar) - subgoal unfolding isPerm_def by auto - subgoal unfolding isPerm_def by auto - subgoal by (smt (verit, best) Diff_iff Un_iff iLam_irrename id_on_def - irrename_eq_itvsubst_iVar) . - subgoal unfolding id_on_def isPerm_def presBnd_def by (auto split: option.splits) . . . - (* *) - subgoal for e1 e1' es2 es2' - apply(rule exI[of _ None]) - apply(intro conjI) - subgoal by simp - subgoal apply(rule disjI3_3) - apply(rule exI[of _ "e1"]) - apply(rule exI[of _ "e1'"]) - apply(rule exI[of _ "es2"]) - apply(rule exI[of _ "es2'"]) - apply(cases t) by simp . . . - - -(* FINALLY, INTERPRETING THE IInduct LOCALE: *) - -interpretation Ppr : IInduct -where Tperm = Tperm and Tsupp = Tsupp and -Bperm = Bperm and Bsupp = Bsupp and bnd = bnd and bsmall = bsmall -and GG = G -apply standard using III_bsmall G_rrefresh by auto - -(* *) - - -(* FROM ABSTRACT BACK TO CONCRETE: *) -thm ppr.induct[no_vars] - -corollary strong_induct_ppr[consumes 2, case_names iVar iLam iApp]: -assumes par: "\p. small (Psupp p) \ bsmall (Psupp p)" -and st: "ppr t1 t2" -and iVar: "\xs x x' p. - super xs \ {x,x'} \ dsset xs \ - R p (iVar x) (iVar x')" -and iLam: "\e e' xs p. - dsset xs \ Psupp p = {} \ - super xs \ ppr e e' \ (\p'. R p' e e') \ - R p (iLam xs e) (iLam xs e')" -and iApp: "\e1 e1' es2 es2' p. - ppr e1 e1' \ (\p'. R p' e1 e1') \ - (\e e'. {e,e'} \ sset es2 \ sset es2' \ ppr e e' \ (\p'. R p' e e')) \ - R p (iApp e1 es2) (iApp e1' es2')" -shows "R p t1 t2" -unfolding ppr_I -apply(subgoal_tac "case (t1,t2) of (t1, t2) \ R p t1 t2") - subgoal by simp - subgoal using par st - unfolding bsmall_def[symmetric] apply(elim Ppr.BE_iinduct[where R = "\p (t1,t2). R p t1 t2"]) - subgoal unfolding ppr_I by simp - subgoal for p B t apply(subst (asm) G_def) - unfolding ppr_I[symmetric] apply(elim disjE exE) - subgoal using iVar by auto - subgoal using iLam by auto - subgoal using iApp by auto . . . - -corollary strong_induct_ppr''[consumes 1, case_names bsmall Bound iVar iLam iApp]: - assumes "ppr t1 t2" -and bsmall: "\(p::'a). bsmall (PFVars p)" -assumes bound: "\(p::'a). |PFVars p| xs x x' p. - super xs \ {x,x'} \ dsset xs \ - R (iVar x) (iVar x') p" -and iLam: "\e e' xs p. - dsset xs \ PFVars p = {} \ - super xs \ ppr e e' \ (\p'. R e e' p') \ - R (iLam xs e) (iLam xs e') p" -and iApp: "\e1 e1' es2 es2' p. - ppr e1 e1' \ (\p'. R e1 e1' p') \ - (\e e'. {e,e'} \ sset es2 \ sset es2' \ ppr e e') \ - (\e e'. {e,e'} \ sset es2 \ sset es2' \ \p'. R e e' p') \ - R (iApp e1 es2) (iApp e1' es2') p" -shows "\(p::'a). R t1 t2 p" -using assms strong_induct_ppr[of PFVars t1 t2 "\p t1 t2. R t1 t2 p"] unfolding small_def by auto - -(* ... and with fixed parameters: *) -corollary strong_induct_ppr'[consumes 2, case_names iVar iLam iApp]: -assumes par: "small A \ bsmall A" -and st: "ppr t1 t2" -and iVar: "\xs x x'. - super xs \ {x,x'} \ dsset xs \ - R (iVar x) (iVar x')" -and iLam: "\e e' xs. - dsset xs \ A = {} \ - super xs \ ppr e e' \ R e e' \ - R (iLam xs e) (iLam xs e')" -and iApp: "\e1 e1' es2 es2'. - ppr e1 e1' \ R e1 e1' \ - (\e e'. {e,e'} \ sset es2 \ sset es2' \ ppr e e' \ R e e') \ - R (iApp e1 es2) (iApp e1' es2')" -shows "R t1 t2" -apply(rule strong_induct_ppr[of "\_::unit. A"]) using assms by auto - -(* Also inferring equivariance from the general infrastructure: *) -corollary irrename_ppr: -assumes f: "bij f" "|supp f| ../Tools/binder_induction.ML\ end ML_file \../Tools/binder_inductive.ML\ -typedecl ('a, 'b) var_selector (infix "::" 999) +typedecl ('a, 'b) var_selector ML_file "../Tools/parser.ML" diff --git a/thys/POPLmark/Labeled_FSet.thy b/thys/POPLmark/Labeled_FSet.thy index 6e069d28..88179a30 100644 --- a/thys/POPLmark/Labeled_FSet.thy +++ b/thys/POPLmark/Labeled_FSet.thy @@ -7,22 +7,21 @@ abbreviation nonrep_fset :: "'a fset \ bool" where "nonrep_fset _ \< definition nonrep_lfset :: "('a \ 'b) fset \ bool" where "nonrep_lfset X = (nonrep_fset X \ (\x \ fset X. nonrep_pair x) \ (\x \ fset X. \y \ fset X. x \ y \ Basic_BNFs.fsts x \ Basic_BNFs.fsts y = {}))" - + lemma nonrep_lfset_alt: "nonrep_lfset X = (\a b c. (a, b) |\| X \ (a, c) |\| X \ b = c)" unfolding nonrep_lfset_def prod_set_defs by fastforce typedef ('a, 'b) G = "UNIV :: ('a \ 'b) fset set" by auto +setup_lifting type_definition_G context notes [[bnf_internals]] begin copy_bnf ('a, 'b) G end -setup_lifting type_definition_G - -lemma map_G_transfer[transfer_rule]: +(*lemma map_G_transfer[transfer_rule]: "rel_fun (=) (rel_fun (=) (rel_fun (pcr_G (=) (=)) (pcr_G (=) (=)))) (\f g. (|`|) (map_prod f g)) map_G" by (tactic \Local_Defs.unfold_tac @{context} [BNF_Def.bnf_of @{context} @{type_name G} |> the |> BNF_Def.map_def_of_bnf]\) - (simp add: rel_fun_def pcr_G_def cr_G_def prod.rel_eq fset.rel_eq relcompp_apply Abs_G_inverse) + (simp add: rel_fun_def pcr_G_def cr_G_def prod.rel_eq fset.rel_eq relcompp_apply Abs_G_inverse)*) lift_definition nonrep_G :: "('a, 'b) G \ bool" is nonrep_lfset . @@ -43,36 +42,20 @@ lemma nonrep_G_map_fst_snd_bij: apply (auto simp: nonrep_lfset_alt map_prod_def image_iff split_beta) by (metis fst_conv snd_conv)+ -class large_G = - assumes large: "|Field bd_G| \o |UNIV :: 'a set|" - and regular: "regularCard |UNIV::'a set|" - -instantiation nat :: large_G begin -instance proof -qed (auto simp: stable_nat stable_regularCard) -end - -(*instantiation prod :: (type, large_G) large_G begin -instance apply standard - apply (subst UNIV_prod, auto simp only: intro!: ordLeq_transitive[OF large card_of_Times2]) - using var_prod_class.large - -end*) - -typedef ('a, 'b) lfset = "{x :: ('a :: large_G, 'b) G . nonrep_G x}" +typedef ('a, 'b) lfset = "{x :: ('a :: var, 'b) G . nonrep_G x}" unfolding mem_Collect_eq by transfer (auto simp: nonrep_lfset_alt) -definition map_lfset :: "('a :: large_G \ 'a :: large_G) \ ('b \ 'b') \ ('a, 'b) lfset \ ('a, 'b') lfset" where +definition map_lfset :: "('a :: var \ 'a :: var) \ ('b \ 'b') \ ('a, 'b) lfset \ ('a, 'b') lfset" where "map_lfset f g = Abs_lfset o map_G f g o Rep_lfset" -definition labels :: "('a :: large_G, 'b) lfset \ 'a set" where +definition labels :: "('a :: var, 'b) lfset \ 'a set" where "labels = set1_G o Rep_lfset" -definition "values" :: "('a :: large_G, 'b) lfset \ 'b set" where +definition "values" :: "('a :: var, 'b) lfset \ 'b set" where "values = set2_G o Rep_lfset" -definition rel_lfset :: "('a :: large_G \ 'a :: large_G) \ ('b \ 'b' \ bool) \ ('a, 'b) lfset \ ('a, 'b') lfset \ bool" where +definition rel_lfset :: "('a :: var \ 'a :: var) \ ('b \ 'b' \ bool) \ ('a, 'b) lfset \ ('a, 'b') lfset \ bool" where "rel_lfset f S = BNF_Def.vimage2p Rep_lfset Rep_lfset (rel_G (Grp f) S)" theorem lfset_map_id: "map_lfset id id = id" @@ -96,7 +79,7 @@ theorem lfset_map_cong: shows "map_lfset u g p = map_lfset v h p" by (simp only: map_lfset_def o_apply labels_def values_def assms cong: G.map_cong) -theorem lfset_set_bd: "|labels p| 'b) \ ('a::large_G, 'b) lfset \ bool" (infix "\\" 50) is fmember . +lift_definition lfin :: "('a \ 'b) \ ('a::var, 'b) lfset \ bool" (infix "\\" 50) is fmember . lemma lfin_map_lfset: "(a, b) \\ map_lfset id g x \ (\c. b = g c \ (a, c) \\ x)" by transfer force @@ -266,7 +248,7 @@ lemma lfin_map_lfset: "(a, b) \\ map_lfset id g x \ lemma lfin_label_inject: "(a, b) \\ x \ (a, c) \\ x \ b = c" by transfer (auto simp: nonrep_lfset_alt) -lift_definition lfempty :: "('a::large_G, 'b) lfset" is "{||} :: ('a \ 'b) fset" +lift_definition lfempty :: "('a::var, 'b) lfset" is "{||} :: ('a \ 'b) fset" by (auto simp: nonrep_lfset_alt) lemma labels_lfempty[simp]: "labels lfempty = {}" @@ -296,15 +278,15 @@ lemma values_lfin: "c \ values x \ \l. (l, c) \\ lemma pred_lfset_lfempty[simp]: "pred_lfset P lfempty = True" unfolding lfset.pred_set by auto -lift_definition lfinsert :: "'a \ 'b \ ('a::large_G, 'b) lfset \ ('a, 'b) lfset" +lift_definition lfinsert :: "'a \ 'b \ ('a::var, 'b) lfset \ ('a, 'b) lfset" is "\a b X. if \c. b \ c \ (a, c) |\| X then X else finsert (a, b) X" by (auto simp: nonrep_lfset_alt split_beta split: if_splits) metis -lift_definition lfupdate :: "('a::large_G, 'b) lfset \ 'a \ 'b \ ('a, 'b) lfset" +lift_definition lfupdate :: "('a::var, 'b) lfset \ 'a \ 'b \ ('a, 'b) lfset" is "\X a b. finsert (a, b) (ffilter (\(a', _). a \ a') X)" by (auto simp: nonrep_lfset_alt) -lift_definition lfunion :: "('a::large_G, 'b) lfset \ ('a, 'b) lfset \ ('a, 'b) lfset" +lift_definition lfunion :: "('a::var, 'b) lfset \ ('a, 'b) lfset \ ('a, 'b) lfset" is "\X Y. funion Y (ffilter (\(a, _). a |\| fst |`| Y) X)" by (auto simp: nonrep_lfset_alt image_iff) @@ -323,10 +305,10 @@ translations subsection \Size setup\ -lift_definition size_lfset :: "('a::large_G \ nat) \ ('b \ nat) \ ('a, 'b) lfset \ nat" is +lift_definition size_lfset :: "('a::var \ nat) \ ('b \ nat) \ ('a, 'b) lfset \ nat" is "\f g. size_fset (size_prod f g)" . -instantiation lfset :: (large_G,type) size begin +instantiation lfset :: (var,type) size begin definition size_lfset where size_lfset_overloaded_def: "size_lfset = Labeled_FSet.size_lfset (\_. 0) (\_. 0)" instance .. @@ -369,7 +351,7 @@ lemma size_lfset_estimation'[termination_simp]: "x \ values X \ y \ f x \ y \ size_lfset (\_. 0) f X" by transfer (auto simp del: size_fset_simps intro!: size_fset_estimation') -lift_definition apply_lfset :: "('a::large_G, 'b \ 'c) lfset \ ('a, 'b) lfset \ ('a, 'c) lfset" +lift_definition apply_lfset :: "('a::var, 'b \ 'c) lfset \ ('a, 'b) lfset \ ('a, 'c) lfset" is "\F X. if fst |`| F |\| fst |`| X then (\(a, f). (a, f (THE b. (a, b) |\| X))) |`| F else {||}" by (force simp: nonrep_lfset_def) @@ -395,7 +377,7 @@ lemma lfin_apply_lfset: "labels F \ labels X \ lifting_update lfset.lifting lifting_forget lfset.lifting -declare fun_cong[OF lfset_size_o_map, +declare fun_cong[OF lfset_size_o_map, unfolded id_def inj_on_def, simplified, termination_simp] hide_fact (open) FSet.bex_simps FSet.ball_simps diff --git a/thys/POPLmark/SystemFSub.thy b/thys/POPLmark/SystemFSub.thy index 537c42fb..f41d5228 100644 --- a/thys/POPLmark/SystemFSub.thy +++ b/thys/POPLmark/SystemFSub.thy @@ -19,17 +19,13 @@ binder_datatype 'a "typ" = | Fun "'a typ" "'a typ" | Forall \::'a "'a typ" t::"'a typ" binds \ in t -instance var :: var_typ_pre apply standard - using Field_natLeq infinite_iff_card_of_nat infinite_var - by (auto simp add: regularCard_var) - declare supp_swap_bound[OF cinfinite_imp_infinite[OF typ.UNIV_cinfinite], simp] declare typ.permute_id[simp] typ.permute_id0[simp] lemma typ_inject: "TyVar x = TyVar y \ 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 (FVars_typ T2 - {x}) f \ f x = y \ permute_typ f T2 = R2)" + "Forall x T1 T2 = Forall y R1 R2 \ T1 = R1 \ (\f. bij (f::'a::var \ '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 @@ -45,7 +41,7 @@ corollary Forall_inject_same[simp]: "Forall x T1 T2 = Forall x R1 R2 \" "|supp \| a'. a'\FVars_typ T2 - {x::'a::var_typ_pre} \ \ a' = a') \ Forall x T1 T2 = Forall (\ x) T1 (permute_typ \ T2)" + (\a'. a'\FVars_typ T2 - {x::'a::var} \ \ a' = a') \ Forall x T1 T2 = Forall (\ x) T1 (permute_typ \ T2)" apply (unfold Forall_def) 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 @@ -59,7 +55,7 @@ lemma Forall_rrename: apply (rule refl) done -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)" +lemma Forall_swap: "y \ FVars_typ T2 - {x} \ Forall (x::'a::var) 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]) @@ -101,8 +97,8 @@ lemma context_dom_set[simp]: unfolding map_context_def by force lemma set_bd_UNIV: "|set xs| resolve_tac @{context} (BNF_Def.set_bd_of_bnf (the (BNF_Def.bnf_of @{context} @{type_name list}))) 1\) - apply (rule var_typ_pre_class.large) + apply (tactic \resolve_tac @{context} (BNF_Def.set_bd_of_bnf (the (BNF_Def.bnf_of @{context} @{type_name list}))) 1\) + apply (rule typ_pre.var_large) done lemma context_set_bd_UNIV[simp]: "|dom xs| \<^sub>\ \ type \ ty "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.set_bd_UNIV 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_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) @@ -249,7 +245,7 @@ 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_permute + (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 _ "permute_typ \ _"])+, (rule conjI)?, rule in_context_eqvt))+ @@ -259,7 +255,7 @@ binder_inductive ty [@{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.set_bd_UNIV infinite_UNIV} + @{thms emp_bound insert_bound ID.set_bd typ.Un_bound typ.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 7408489e..a4810866 100644 --- a/thys/Pi_Calculus/Commitment.thy +++ b/thys/Pi_Calculus/Commitment.thy @@ -11,7 +11,6 @@ binder_datatype 'var commit = (* Monomorphization: *) type_synonym cmt = "var commit" -instance var :: var_commit_pre by standard lemmas toUnfold = UN_empty UN_empty2 UN_single Un_empty_left Un_empty_right @@ -69,8 +68,7 @@ proof- unfolding ls_UNIV_iff_finite 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) + using MRBNF_FP.exists_fresh by blast thus ?thesis by auto qed @@ -115,8 +113,8 @@ fun ns :: "act \ var set" where abbreviation "bvars \ bns" abbreviation "fvars \ fns" -lemma bns_bound: "|bns \| | ) (auto simp: emp_bound infinite_UNIV) local_setup \MRBNF_Sugar.register_binder_sugar "Commitment.commit" { ctors = [ diff --git a/thys/Pi_Calculus/Pi.thy b/thys/Pi_Calculus/Pi.thy index c7590e54..d42601ed 100644 --- a/thys/Pi_Calculus/Pi.thy +++ b/thys/Pi_Calculus/Pi.thy @@ -25,10 +25,6 @@ for (* Monomorphising: *) -instance var :: var_term_pre apply standard - using Field_natLeq infinite_iff_card_of_nat infinite_var - by (auto simp add: regularCard_var) - type_synonym trm = "var term" lemma singl_bound: "|{a}| FVars_term" lemmas term.permute_id[simp] term.permute_cong_id[simp] term.FVars_permute[simp] -lemmas term_vvsubst_permute[simp] +lemmas term.vvsubst_permute[simp] (* Supply of fresh variables *) @@ -70,8 +66,7 @@ proof- unfolding ls_UNIV_iff_finite using finite_FFVars by blast then obtain x where "x \ set xs \ \ (FFVars ` (set Ps))" - by (meson ex_new_if_finite finite_iff_le_card_var - infinite_iff_natLeq_ordLeq var_term_pre_class.large) + by (metis UNIV_eq_I finite_iff_le_card_var large_imp_infinite term_pre.var_large) thus ?thesis by auto qed @@ -169,7 +164,7 @@ lemma bij_map_term_pre: "bij f \ |supp (f::var \ var done lemma map_term_pre_inv_simp: "bij f \ |supp (f::var \ var)| -inv (map_term_pre (id::_::var_term_pre \ _) f (permute_term f) id) = map_term_pre id (inv f) (permute_term (inv f)) id" +inv (map_term_pre (id::_::var \ _) 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 @@ -257,11 +252,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_permute[simp del] + note term.vvsubst_permute[simp del] show ?thesis using assms - apply(subst term_vvsubst_permute[symmetric]) apply auto + apply(subst term.vvsubst_permute[symmetric]) apply auto apply(subst term.map_comp) apply auto - apply(subst term_vvsubst_permute[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 @@ -435,9 +430,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_permute[simp del] + note term.vvsubst_permute[simp del] show ?thesis using assms - apply(subst term_vvsubst_permute[symmetric]) apply simp + apply(subst term.vvsubst_permute[symmetric]) apply simp subgoal by auto subgoal apply(subst term.map_comp) subgoal by auto diff --git a/thys/Pi_Calculus/Pi_Transition_Common.thy b/thys/Pi_Calculus/Pi_Transition_Common.thy index 73d7337b..ae52dbe2 100644 --- a/thys/Pi_Calculus/Pi_Transition_Common.thy +++ b/thys/Pi_Calculus/Pi_Transition_Common.thy @@ -22,8 +22,7 @@ proof- unfolding ls_UNIV_iff_finite using finite_Tsupp finite_vars by blast then obtain x where "x \ set xs \ Tsupp x1 x2 \ \ (vars ` (set as))" - by (meson ex_new_if_finite finite_iff_le_card_var - infinite_iff_natLeq_ordLeq var_term_pre_class.large) + using MRBNF_FP.exists_fresh by blast thus ?thesis by auto qed @@ -76,8 +75,7 @@ proof- unfolding ls_UNIV_iff_finite using finite_Tsupp by blast then obtain x where "x \ set xs \ Tsupp x1 x2" - by (meson ex_new_if_finite finite_iff_le_card_var - infinite_iff_natLeq_ordLeq var_term_pre_class.large) + using MRBNF_FP.exists_fresh by blast thus ?thesis by auto qed diff --git a/thys/Pi_Calculus/Pi_Transition_Early.thy b/thys/Pi_Calculus/Pi_Transition_Early.thy index 438ab229..6519bdd6 100644 --- a/thys/Pi_Calculus/Pi_Transition_Early.thy +++ b/thys/Pi_Calculus/Pi_Transition_Early.thy @@ -34,7 +34,7 @@ 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 var_term_pre_class.Un_bound term.set_bd_UNIV commit.FVars_bd_UNIVs infinite_UNIV bns_bound} + @{thms emp_bound singl_bound insert_bound card_of_minus_bound term.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} diff --git a/thys/Pi_Calculus/Pi_cong.thy b/thys/Pi_Calculus/Pi_cong.thy index 8b3581aa..5489d5a4 100644 --- a/thys/Pi_Calculus/Pi_cong.thy +++ b/thys/Pi_Calculus/Pi_cong.thy @@ -50,8 +50,7 @@ proof- unfolding ls_UNIV_iff_finite using finite_Tsupp by blast then obtain x where "x \ set xs \ Tsupp x1 x2" - by (meson ex_new_if_finite finite_iff_le_card_var - infinite_iff_natLeq_ordLeq var_term_pre_class.large) + using MRBNF_FP.exists_fresh by blast thus ?thesis by auto qed diff --git a/thys/Prelim/Card_Prelim.thy b/thys/Prelim/Card_Prelim.thy index e7b7c568..ad5f7ebd 100644 --- a/thys/Prelim/Card_Prelim.thy +++ b/thys/Prelim/Card_Prelim.thy @@ -48,14 +48,50 @@ lemma Cinfinite_card_trans: "Cinfinite r \ r \o |q| \ |A| \o natLeq" -unfolding countable_def -by (metis Field_card_of UNIV_I card_of_mono2 card_of_nat card_of_ordLeq ordLeq_ordIso_trans subsetI) -*) +class covar = + assumes large: "cardSuc natLeq \o |UNIV::'a set|" + and regular: "regularCard |UNIV::'a set|" -(* *) +class var = + assumes large: "|Field natLeq| \o |UNIV::'a set|" + and regular: "regularCard |UNIV::'a set|" + +subclass (in covar) var + apply standard + apply (metis Field_natLeq infinite_iff_card_of_nat infinite_iff_natLeq_ordLeq le_card_ivar local.large ordLeq_transitive ordLess_imp_ordLeq) + by (rule local.regular) + +subclass (in var) infinite + apply standard + using Field_natLeq infinite_iff_card_of_nat local.large by auto + +lemma (in var) UNIV_cinfinite: "cinfinite |UNIV::'a set|" + using Field_natLeq cinfinite_def infinite_iff_card_of_nat local.large by fastforce + +lemma (in var) Un_bound: "|A| |B| |A \ B| (\x. x \ A \ |f x| |\(f ` A)| o |UNIV::'a set|" + using infinite_iff_natLeq_ordLeq local.infinite_UNIV by blast + +instantiation nat::var begin + instance by standard (auto simp: stable_nat stable_regularCard) +end + +lemma list_countable: "|UNIV::('a::finite) list set| =o natLeq" + by (meson card_of_nat countableI_type countable_or_card_of infinite_UNIV_listI ordIso_transitive) + +instantiation list :: (finite) var begin +instance + apply standard + using Field_natLeq infinite_UNIV infinite_iff_card_of_nat apply auto[1] + using list_countable natLeq_Cinfinite ordIso_symmetric regularCard_natLeq regularCard_ordIso by blast +end end diff --git a/thys/Prelim/FixedCountableVars.thy b/thys/Prelim/FixedCountableVars.thy index 0eb7c385..39c233af 100644 --- a/thys/Prelim/FixedCountableVars.thy +++ b/thys/Prelim/FixedCountableVars.thy @@ -1,11 +1,11 @@ theory FixedCountableVars -imports "HOL-Cardinals.Cardinals" "HOL-Library.Infinite_Typeclass" +imports "HOL-Cardinals.Cardinals" "HOL-Library.Infinite_Typeclass" "Prelim.Card_Prelim" begin (* We take a countably infinite number of variables *) hide_type var -datatype var = Variable nat +datatype var = Variable nat lemma bij_Variable: "bij Variable" by (metis bijI' var.exhaust var.inject) @@ -13,21 +13,25 @@ by (metis bijI' var.exhaust var.inject) lemma card_var: "|UNIV::var set| =o natLeq" using bij_Variable card_of_nat card_of_ordIso ordIso_symmetric ordIso_transitive by blast -lemma infinite_var: "infinite (UNIV::var set)" +lemma infinite_var: "infinite (UNIV::var set)" using bij_Variable bij_betw_finite by blast -lemma regularCard_var: "regularCard |UNIV::var set|" +lemma regularCard_var: "regularCard |UNIV::var set|" using card_var natLeq_Cinfinite ordIso_symmetric regularCard_natLeq regularCard_ordIso by blast +instantiation var :: var begin +instance apply standard + using Field_natLeq infinite_iff_card_of_nat infinite_var regularCard_var by auto +end lemma finite_iff_le_card_var: "finite A \ |A| |A| B. B \ A = {} \ finite B \ card B = n" proof- @@ -38,20 +42,20 @@ proof- thus ?thesis using B' by auto qed -lemma finite_exists_list_var: +lemma finite_exists_list_var: assumes "finite (A::var set)" shows "\xs. set xs \ A = {} \ distinct xs \ length xs = n" by (metis assms card_set distinct_remdups finite_distinct_list finite_exists_finite_var set_remdups) -lemma exists_var: +lemma exists_var: assumes "finite (X::var set)" shows "\x. x \ X" -by (simp add: assms ex_new_if_finite infinite_var) +by (simp add: assms ex_new_if_finite infinite_var) (* *) -definition sw :: "var \ var \ var \ var" where +definition sw :: "var \ var \ var \ var" where "sw x y z \ if x = y then z else if x = z then y else x" lemma sw_eqL[simp]: "\ x y z. sw x x y = y" @@ -76,8 +80,4 @@ lemma sw_surj: "\y. x = sw y z1 z2" definition "sb a x y \ if a = y then x else a" -instantiation var :: infinite begin -instance by standard (rule infinite_var) -end - end \ No newline at end of file diff --git a/thys/STLC/STLC.thy b/thys/STLC/STLC.thy index 43f6565c..8691b603 100644 --- a/thys/STLC/STLC.thy +++ b/thys/STLC/STLC.thy @@ -51,18 +51,18 @@ lemma tvsubst_VVr_func: "tvsubst tvVVr_tvsubst t = t" done lemma finite_singleton: "finite {x}" by blast -lemma singl_bound: "|{a}| 'a terms" + fixes f::"'a::var \ 'a terms" shows "|SSupp_terms (f (a:=t))| |SSupp_terms f| e = Abs x' \' e') = (\f. bij f \ |supp (f::'a::var_terms_pre \ 'a)| e = Abs x' \' e') = (\f. bij f \ |supp (f::'a::var \ 'a)| id_on (FVars_terms (Abs x \ e)) f \ f x = x' \ \ = \' \ permute_terms f e = e')" unfolding terms.set unfolding Abs_def terms.TT_inject0 map_terms_pre_def comp_def Abs_terms_pre_inverse[OF UNIV_I] @@ -98,7 +98,7 @@ lemma Abs_inject: "(Abs x \ e = Abs x' \' e') = (\f. bij f \ |supp (f::'a::var_terms_pre \ 'a)| bij (map_terms_pre (id::_::var_terms_pre \ _) f (permute_terms f) id)" +lemma bij_map_terms_pre: "bij f \ |supp (f::'a::var \ 'a)| bij (map_terms_pre (id::_::var \ _) f (permute_terms f) id)" apply (rule iffD2[OF bij_iff]) apply (rule exI[of _ "map_terms_pre id (inv f) (permute_terms (inv f)) id"]) apply (frule bij_imp_bij_inv) @@ -117,7 +117,7 @@ lemma bij_map_terms_pre: "bij f \ |supp (f::'a::var_terms_pre \< 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 (permute_terms f) id) = map_terms_pre id (inv f) (permute_terms (inv f)) id" +lemma map_terms_pre_inv_simp: "bij f \ |supp (f::'a::var \ 'a)| inv (map_terms_pre (id::_::var \ _) 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 @@ -164,7 +164,7 @@ unfolding set2_terms_pre_def set3_terms_pre_def comp_def Abs_terms_pre_inverse[O done done -lemma Abs_avoid: "|A::'a::var_terms_pre set| \x' e'. Abs x \ e = Abs x' \ e' \ x' \ A" +lemma Abs_avoid: "|A::'a::var set| \x' e'. Abs x \ e = Abs x' \ e' \ x' \ A" apply (erule terms.TT_fresh_cases[of _ "Abs x \ e"]) apply (drule sym) apply (frule Abs_set3) @@ -190,20 +190,20 @@ lemma VVr_eq_Var: "tvVVr_tvsubst a = Var a" (* small step semantics *) no_notation Set.member ("(_/ : _)" [51, 51] 50) -definition fresh :: "'a::var_terms_pre \ ('a * 'b) fset \ bool" ("(_/ \ _)" [51, 51] 50) where +definition fresh :: "'a::var \ ('a * 'b) fset \ bool" ("(_/ \ _)" [51, 51] 50) where "fresh x \ \ x |\| fst |`| \" lemma isin_rename: "bij f \ (f x, \) |\| map_prod f id |`| \ \ (x, \) |\| \" by force -abbreviation extend :: "('a * \) fset \ 'a::var_terms_pre \ \ \ ('a * \) fset" ("(_,_:_)" [52, 52, 52] 53) where +abbreviation extend :: "('a * \) fset \ 'a::var \ \ \ ('a * \) fset" ("(_,_:_)" [52, 52, 52] 53) where "extend \ a \ \ finsert (a, \) \" -inductive Step :: "'a::var_terms_pre terms \ 'a terms \ bool" (infixr "\<^bold>\" 25) where +inductive Step :: "'a::var terms \ 'a terms \ bool" (infixr "\<^bold>\" 25) where ST_Beta: "App (Abs x \ e) e2 \<^bold>\ tvsubst (tvVVr_tvsubst(x:=e2)) e" | ST_App: "e1 \<^bold>\ e1' \ App e1 e2 \<^bold>\ App e1' e2" -inductive Ty :: "('a::var_terms_pre * \) fset \ 'a terms \ \ \ bool" ("_ \\<^sub>t\<^sub>y _ : _" [25, 25, 25] 26) where +inductive Ty :: "('a::var * \) fset \ 'a terms \ \ \ bool" ("_ \\<^sub>t\<^sub>y _ : _" [25, 25, 25] 26) where Ty_Var: "(x, \) |\| \ \ \ \\<^sub>t\<^sub>y Var x : \" | Ty_App: "\ \ \\<^sub>t\<^sub>y e1 : \\<^sub>1 \ \\<^sub>2 ; \ \\<^sub>t\<^sub>y e2 : \\<^sub>1 \ \ \ \\<^sub>t\<^sub>y App e1 e2 : \\<^sub>2" | Ty_Abs: "\ x \ \ ; \,x:\ \\<^sub>t\<^sub>y e : \\<^sub>2 \ \ \ \\<^sub>t\<^sub>y Abs x \ e : \ \ \\<^sub>2" @@ -234,7 +234,7 @@ thm Ty.strong_induct thm Ty.equiv lemma provided: - fixes f::"'a::var_terms_pre \ 'a" + fixes f::"'a::var \ 'a" assumes "bij f" "|supp f| 'a" and \::"('a \ \) fset" + fixes f::"'a::var \ 'a" and \::"('a \ \) fset" shows "bij f \ |supp f| x \ \ \ f x \ map_prod f id |`| \" apply (rule iffI) apply (rule provided) @@ -273,7 +273,7 @@ lemma provided_strong: done lemma Ty_fresh_induct: - fixes A::"'a::var_terms_pre set" and e::"'a terms" + fixes A::"'a::var set" and e::"'a terms" 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" @@ -284,7 +284,7 @@ lemma Ty_fresh_induct: (* automate with binder_inductive_cases *) lemma Ty_AbsE: - fixes e::"'a::var_terms_pre terms" and A::"'a set" + fixes e::"'a::var terms" and A::"'a set" assumes "\ \\<^sub>t\<^sub>y Abs x \\<^sub>1 e : \" "|A| y e' \' \\<^sub>2. y \ A \ Abs x \\<^sub>1 e = Abs y \' e' \ \ = (\' \ \\<^sub>2) \ y \ \ \ \,y:\' \\<^sub>t\<^sub>y e' : \\<^sub>2 \ P" shows P @@ -303,11 +303,11 @@ lemma Ty_AbsE: done lemma rename_Ty: - fixes f::"'a::var_terms_pre \ 'a" + fixes f::"'a::var \ 'a" 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_permute[OF assms]) + apply (unfold terms.vvsubst_permute[OF assms]) apply (rule Ty.equiv) apply (rule assms)+ apply assumption @@ -328,7 +328,7 @@ and "\\\<^sub>2. \ = (\\<^sub>1 \ \\<^sub>2 shows "P" apply (rule Ty_AbsE) apply (rule assms(1)) - apply (rule terms_pre.UNION_bound) + apply (rule terms_pre.UN_bound) apply (rule ordLess_ordLeq_trans) apply (rule fset.set_bd) apply (rule terms.var_large) @@ -348,7 +348,7 @@ shows "P" apply (rule singl_bound) apply (rule iffD2[OF disjoint_single]) apply (rule assms(2)) -apply (rule terms_pre.UNION_bound) +apply (rule terms_pre.UN_bound) apply (rule ordLess_ordLeq_trans) apply (rule fset.set_bd) apply (rule terms.var_large) @@ -421,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_permute]) + apply (rule fun_cong[OF terms.vvsubst_permute]) apply assumption+ apply (rule terms.map_cong0) apply assumption+ @@ -499,13 +499,13 @@ next qed theorem progress: "{||} \\<^sub>t\<^sub>y e : \ \ (\x \ e'. e = Abs x \ e') \ (\e'. e \<^bold>\ e')" -proof (induction "{||} :: ('a::var_terms_pre * \) fset" e \ rule: Ty.induct) +proof (induction "{||} :: ('a::var * \) fset" e \ rule: Ty.induct) case (Ty_App e1 \\<^sub>1 \\<^sub>2 e2) from Ty_App(2) show ?case using ST_Beta ST_App by blast qed auto theorem preservation: "\ {||} \\<^sub>t\<^sub>y e : \ ; e \<^bold>\ e' \ \ {||} \\<^sub>t\<^sub>y e' : \" -proof (induction "{||} :: ('a::var_terms_pre * \) fset" e \ arbitrary: e' rule: Ty.induct) +proof (induction "{||} :: ('a::var * \) fset" e \ arbitrary: e' rule: Ty.induct) case (Ty_App e1 \\<^sub>1 \\<^sub>2 e2) from Ty_App(5) show ?case proof cases diff --git a/thys/Untyped_Lambda_Calculus/LC.thy b/thys/Untyped_Lambda_Calculus/LC.thy index f21ab08d..068f9f60 100644 --- a/thys/Untyped_Lambda_Calculus/LC.thy +++ b/thys/Untyped_Lambda_Calculus/LC.thy @@ -17,18 +17,13 @@ binder_datatype 'a "term" = for vvsubst: vvsubst tvsubst: tvsubst +print_theorems (****************************) (* 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 +apply standard subgoal apply(rule exI[of _ "inv Variable"]) by (simp add: bij_Variable bij_is_inj) subgoal using infinite_var . . @@ -53,13 +48,13 @@ 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.set_bd_UNIV) + apply (auto simp: IImsupp_def assms intro!: term.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) -lemma fsupp_le[simp]: -"fsupp (\::var\var) \ |supp \| ::var\var) \ |supp \| z. (z::var) \ FFVars P \ f z = g z)" shows "tvsubst f P = tvsubst g P" proof- - have fg: "|IImsupp f| IImsupp g| IImsupp g| 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.permute_cong_id[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)" @@ -196,7 +189,7 @@ lemma bij_map_term_pre: "bij f \ |supp (f::var \ var 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" +lemma map_term_pre_inv_simp: "bij f \ |supp (f::var \ var)| inv (map_term_pre (id::_::var \ _) 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 @@ -291,7 +284,7 @@ by (simp add: cinfinite_imp_infinite supp_swap_bound term.UNIV_cinfinite) lemma SSupp_IImsupp_bound: "|SSupp \| |IImsupp \| | | ::var\trm) o \)| | | 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 +using IImsupp_Var by auto lemma IImsupp_rrename_su: assumes s[simp]: "bij (\::var\var)" "|supp \| IImsupp (\a. tvsubst \ (\ a))") @@ -429,11 +422,11 @@ qed (* Unary (term-for-var) substitution versus renaming: *) -lemma supp_SSupp_Var_le[simp]: "SSupp (Var \ \) = supp \" +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 \| ::var\var)" "|supp \| = tvsubst (Var o \)" proof fix t @@ -446,8 +439,8 @@ proof 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': + +lemma rrename_eq_tvsubst_Var': "bij (\::var\var) \ |supp \| rrename \ e = tvsubst (Var o \) e" using rrename_eq_tvsubst_Var by auto @@ -502,9 +495,9 @@ assumes "{u,v} \ {x,y} = {}" shows "usub (swap t u v) x y = swap (usub t x y) u v" proof- show ?thesis using assms - apply(subst term_vvsubst_permute[symmetric]) apply auto + apply(subst term.vvsubst_permute[symmetric]) apply auto apply(subst term.map_comp) apply auto - apply(subst term_vvsubst_permute[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 @@ -605,7 +598,7 @@ assumes "xx \ FFVars t \ xx = x" shows "usub t u x = usub (swap t x xx) u xx" proof- show ?thesis using assms - apply(subst term_vvsubst_permute[symmetric]) apply simp + apply(subst term.vvsubst_permute[symmetric]) apply simp subgoal by auto subgoal apply(subst term.map_comp) subgoal by auto @@ -632,8 +625,8 @@ 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.permute_id) - using sw_invol2 apply metis + 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" @@ -643,7 +636,7 @@ 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.permute_comp) + 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) . @@ -665,7 +658,7 @@ 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 +(* "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" @@ -676,7 +669,7 @@ lemma mkSubst_idle[simp]: "\ distinct xs \ \ x \ set xs \::var\var)" "|supp \| ::var\var)" "|supp \| xs) (map (rrename \) es2) \ \ = rrename \ \ mkSubst xs es2" -proof(rule ext) +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") @@ -697,7 +690,7 @@ proof(rule ext) 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) + unfolding o_def apply(subst mkSubst_idle) subgoal by auto subgoal using s by auto . next @@ -706,43 +699,43 @@ proof(rule ext) 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) + unfolding o_def Ti apply(subst mkSubst_nth) subgoal by auto - subgoal using i unfolding Tri by auto + subgoal using i unfolding Tri by auto subgoal using l i unfolding Tri by auto . qed qed -lemma mkSubst_map_rrename_inv: +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 \ +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 \ +lemma card_SSupp_mkSubst_rrename_inv: +"bij (\::var\var) \ |supp \| + length es = length xs \ |SSupp (rrename \ \ mkSubst xs es \ inv \)| distinct xs \ z \ set xs \ - length es = length xs \ +lemma mkSubst_smap: "bij f \ 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) +by (metis bij_distinct_smap distinct_Ex1 length_map mkSubst_nth nth_map) (* *) -lemma Lam_eq_tvsubst: +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| +shows "\f. bij f \ |supp f| id_on (- {x,x'}) f \ id_on (FFVars (Lam x e)) f \ - f x = x' \ rrename f e = e'" + 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) @@ -775,10 +768,10 @@ 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 \ +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)" @@ -787,15 +780,15 @@ 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 - + 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'" + have ff': "rrename f e = rrename f' e'" 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 term.permute_cong) using g - subgoal by auto subgoal by auto subgoal by auto + 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 . . @@ -806,7 +799,7 @@ 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 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- @@ -827,110 +820,110 @@ qed (* RECURSOR *) -locale LC_Rec = +locale LC_Rec = fixes B :: "'b set" -and VarB :: "var \ 'b" +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 +assumes (* closedness: *) VarB_B[simp,intro]: "\x. VarB x \ B" -and +and AppB_B[simp,intro]: "\b1 b2. {b1,b2} \ B \ AppB b1 b2 \ B" -and +and LamB_B[simp,intro]: "\x b. b \ B \ LamB x b \ B" -and +and renB_B[simp]: "\\ b. bij \ \ |supp \| b \ B \ renB \ b \ B" -and +and (* proper axioms: *) renB_id[simp,intro]: "\b. b \ B \ renB id b = b" -and -renB_comp[simp,intro]: "\b \ \. bij \ \ |supp \| +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) \ +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 \| +(* and +NB: This is redundant: +renB_FVarsB[simp]: "\\ x b. bij \ \ |supp \| x \ FVarsB (renB \ b) \ inv \ x \ FVarsB b" *) -and +and (* *) renB_VarB[simp]: "\\ x. bij \ \ |supp \| renB \ (VarB x) = VarB (\ x)" -and -renB_AppB[simp]: "\\ b1 b2. bij \ \ |supp \| {b1,b2} \ B \ +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 \ +and +renB_LamB[simp]: "\\ x b. bij \ \ |supp \| b \ B \ renB \ (LamB x b) = LamB (\ x) (renB \ b)" (* *) -and +and FVarsB_VarB: "\x. FVarsB (VarB x) \ {x}" -and +and FVarsB_AppB: "\b1 b2. {b1,b2} \ B \ FVarsB (AppB b1 b2) \ FVarsB b1 \ FVarsB b2" -and +and FVarsB_LamB: "\x b. b \ B \ FVarsB (LamB x b) \ FVarsB b - {x}" -begin +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| 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" +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)) \ +definition morFromTrm where +"morFromTrm H \ + (\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 +inductive R where Var: "R (Var x) (VarB x)" | App: "R e1 b1 \ R e2 b2 \ R (App e1 e2) (AppB b1 b2)" @@ -944,27 +937,27 @@ apply safe subgoal using R.cases by fastforce subgoal by (auto intro: R.intros) . -lemma R_App_elim: +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: +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: +lemma R_total: "\b. R e b" apply(induct e) by (auto intro: R.intros) -lemma R_B: +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) \ +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) @@ -972,12 +965,12 @@ proof(induct e rule: trm_rrename_induct) then show ?case using FVarsB_VarB by auto next case (App e1 e2) - then show ?case apply safe + then show ?case apply safe subgoal by (metis R_App_elim) - subgoal by simp (smt (verit, del_insts) FVarsB_AppB 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 + subgoal apply(drule R_App_elim) + by (smt (verit, del_insts) R.simps R_B bot.extremum insert_subset renB_AppB term.permute(2)) . next case (Lam x t) @@ -988,7 +981,7 @@ next 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" + 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'" @@ -998,44 +991,44 @@ next 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 (metis Un_insert_right singl_bound sup_bot_right term.set_bd_UNIV term.Un_bound) + then obtain z where z: + "z \ {x,x1',x2'} \ FFVars t \ FFVars t1' \ FFVars t2'" by (meson exists_fresh) - obtain f1 f1' where + obtain f1 f1' where f1: "bij f1" "|supp f1| id_on (FFVars (Lam x t)) f1" and + "id_on (- {x, z}) 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'" + 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 + obtain f2 f2' where f2: "bij f2" "|supp f2| id_on (FFVars (Lam x t)) f2" and + "id_on (- {x, z}) 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'" + 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'" @@ -1044,59 +1037,59 @@ next 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 + "id_on (- {x2', z}) 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" + + 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" + 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.permute_comp term_pre.supp_comp_bound) - - show "b1 = b2" unfolding 1(3) 2(3) + + 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 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 + 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'" + 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 + 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 (metis Un_insert_right singl_bound sup_bot_right term.set_bd_UNIV term.Un_bound) + then obtain z where z: + "z \ {x,x'} \ FFVars t \ FFVars t'" by (meson exists_fresh) - obtain f where + 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" + "id_on (- {x, x'}) 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 @@ -1108,9 +1101,9 @@ next assume "R (Lam x t) b" and f: "bij f" "|supp f| FFVars t \ FFVars t'| {x,x'} \ FFVars t \ FFVars t'" + by (metis Un_insert_right singl_bound sup_bot_right term.set_bd_UNIV term.Un_bound) + then obtain z where z: + "z \ {x,x'} \ FFVars t \ FFVars t'" by (meson exists_fresh) - obtain g where + 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" + "id_on (- {x, x'}) 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'))" @@ -1136,11 +1129,11 @@ next 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 term.permute) + show "R (rrename f (Lam x t)) (renB f b)" + unfolding 0 using RR apply(subst term.permute) subgoal using f by auto subgoal using f by auto subgoal apply(subst renB_LamB) - using f b' by auto . + using f b' by auto . qed qed @@ -1179,16 +1172,16 @@ 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 \| +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" +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"