# HG changeset patch # User berghofe # Date 1142441973 -3600 # Node ID 3d10de7a8ca7aa6baa5b0a449c89fcc6d969ac4e # Parent b85e16bd70d0e0f24bbc74007bd90c29bbf2e1a5 add_inst_arity_i renamed to prove_arity. diff -r b85e16bd70d0 -r 3d10de7a8ca7 src/HOL/Nominal/nominal_atoms.ML --- a/src/HOL/Nominal/nominal_atoms.ML Wed Mar 15 16:18:12 2006 +0100 +++ b/src/HOL/Nominal/nominal_atoms.ML Wed Mar 15 17:59:33 2006 +0100 @@ -401,7 +401,7 @@ in thy' - |> AxClass.add_inst_arity_i (qu_name,[],[cls_name]) + |> AxClass.prove_arity (qu_name,[],[cls_name]) (if ak_name = ak_name' then proof1 else proof2) end) ak_names thy) ak_names thy12c; @@ -435,15 +435,15 @@ val pt_thm_set = pt_inst RS pt_set_inst in thy - |> AxClass.add_inst_arity_i ("fun",[[cls_name],[cls_name]],[cls_name]) (pt_proof pt_thm_fun) - |> AxClass.add_inst_arity_i ("nominal.noption",[[cls_name]],[cls_name]) (pt_proof pt_thm_noptn) - |> AxClass.add_inst_arity_i ("Datatype.option",[[cls_name]],[cls_name]) (pt_proof pt_thm_optn) - |> AxClass.add_inst_arity_i ("List.list",[[cls_name]],[cls_name]) (pt_proof pt_thm_list) - |> AxClass.add_inst_arity_i ("*",[[cls_name],[cls_name]],[cls_name]) (pt_proof pt_thm_prod) - |> AxClass.add_inst_arity_i ("nominal.nprod",[[cls_name],[cls_name]],[cls_name]) + |> AxClass.prove_arity ("fun",[[cls_name],[cls_name]],[cls_name]) (pt_proof pt_thm_fun) + |> AxClass.prove_arity ("nominal.noption",[[cls_name]],[cls_name]) (pt_proof pt_thm_noptn) + |> AxClass.prove_arity ("Datatype.option",[[cls_name]],[cls_name]) (pt_proof pt_thm_optn) + |> AxClass.prove_arity ("List.list",[[cls_name]],[cls_name]) (pt_proof pt_thm_list) + |> AxClass.prove_arity ("*",[[cls_name],[cls_name]],[cls_name]) (pt_proof pt_thm_prod) + |> AxClass.prove_arity ("nominal.nprod",[[cls_name],[cls_name]],[cls_name]) (pt_proof pt_thm_nprod) - |> AxClass.add_inst_arity_i ("Product_Type.unit",[],[cls_name]) (pt_proof pt_thm_unit) - |> AxClass.add_inst_arity_i ("set",[[cls_name]],[cls_name]) (pt_proof pt_thm_set) + |> AxClass.prove_arity ("Product_Type.unit",[],[cls_name]) (pt_proof pt_thm_unit) + |> AxClass.prove_arity ("set",[[cls_name]],[cls_name]) (pt_proof pt_thm_set) end) ak_names thy13; (*<<<<<<< fs_ class instances >>>>>>>*) @@ -476,7 +476,7 @@ val simp_s = HOL_basic_ss addsimps [dj_inst RS dj_supp, Finites.emptyI]; in EVERY [ClassPackage.intro_classes_tac [], asm_simp_tac simp_s 1] end) in - AxClass.add_inst_arity_i (qu_name,[],[qu_class]) proof thy' + AxClass.prove_arity (qu_name,[],[qu_class]) proof thy' end) ak_names thy) ak_names thy18; (* shows that *) @@ -500,12 +500,12 @@ val fs_thm_optn = fs_inst RS fs_option_inst; in thy - |> AxClass.add_inst_arity_i ("Product_Type.unit",[],[cls_name]) (fs_proof fs_thm_unit) - |> AxClass.add_inst_arity_i ("*",[[cls_name],[cls_name]],[cls_name]) (fs_proof fs_thm_prod) - |> AxClass.add_inst_arity_i ("nominal.nprod",[[cls_name],[cls_name]],[cls_name]) + |> AxClass.prove_arity ("Product_Type.unit",[],[cls_name]) (fs_proof fs_thm_unit) + |> AxClass.prove_arity ("*",[[cls_name],[cls_name]],[cls_name]) (fs_proof fs_thm_prod) + |> AxClass.prove_arity ("nominal.nprod",[[cls_name],[cls_name]],[cls_name]) (fs_proof fs_thm_nprod) - |> AxClass.add_inst_arity_i ("List.list",[[cls_name]],[cls_name]) (fs_proof fs_thm_list) - |> AxClass.add_inst_arity_i ("Datatype.option",[[cls_name]],[cls_name]) (fs_proof fs_thm_optn) + |> AxClass.prove_arity ("List.list",[[cls_name]],[cls_name]) (fs_proof fs_thm_list) + |> AxClass.prove_arity ("Datatype.option",[[cls_name]],[cls_name]) (fs_proof fs_thm_optn) end) ak_names thy20; (*<<<<<<< cp__ class instances >>>>>>>*) @@ -551,7 +551,7 @@ EVERY [ClassPackage.intro_classes_tac [], simp_tac simp_s 1] end)) in - AxClass.add_inst_arity_i (name,[],[cls_name]) proof thy'' + AxClass.prove_arity (name,[],[cls_name]) proof thy'' end) ak_names thy') ak_names thy) ak_names thy24; (* shows that *) @@ -580,12 +580,12 @@ val cp_thm_noptn = cp_inst RS cp_noption_inst; in thy' - |> AxClass.add_inst_arity_i ("Product_Type.unit",[],[cls_name]) (cp_proof cp_thm_unit) - |> AxClass.add_inst_arity_i ("*",[[cls_name],[cls_name]],[cls_name]) (cp_proof cp_thm_prod) - |> AxClass.add_inst_arity_i ("List.list",[[cls_name]],[cls_name]) (cp_proof cp_thm_list) - |> AxClass.add_inst_arity_i ("fun",[[cls_name],[cls_name]],[cls_name]) (cp_proof cp_thm_fun) - |> AxClass.add_inst_arity_i ("Datatype.option",[[cls_name]],[cls_name]) (cp_proof cp_thm_optn) - |> AxClass.add_inst_arity_i ("nominal.noption",[[cls_name]],[cls_name]) (cp_proof cp_thm_noptn) + |> AxClass.prove_arity ("Product_Type.unit",[],[cls_name]) (cp_proof cp_thm_unit) + |> AxClass.prove_arity ("*",[[cls_name],[cls_name]],[cls_name]) (cp_proof cp_thm_prod) + |> AxClass.prove_arity ("List.list",[[cls_name]],[cls_name]) (cp_proof cp_thm_list) + |> AxClass.prove_arity ("fun",[[cls_name],[cls_name]],[cls_name]) (cp_proof cp_thm_fun) + |> AxClass.prove_arity ("Datatype.option",[[cls_name]],[cls_name]) (cp_proof cp_thm_optn) + |> AxClass.prove_arity ("nominal.noption",[[cls_name]],[cls_name]) (cp_proof cp_thm_noptn) end) ak_names thy) ak_names thy25; (* show that discrete nominal types are permutation types, finitely *) @@ -601,7 +601,7 @@ val simp_s = HOL_basic_ss addsimps [defn]; val proof = EVERY [ClassPackage.intro_classes_tac [], REPEAT (asm_simp_tac simp_s 1)]; in - AxClass.add_inst_arity_i (discrete_ty,[],[qu_class]) proof thy + AxClass.prove_arity (discrete_ty,[],[qu_class]) proof thy end) ak_names; fun discrete_fs_inst discrete_ty defn = @@ -612,7 +612,7 @@ val simp_s = HOL_ss addsimps [supp_def,Collect_const,Finites.emptyI,defn]; val proof = EVERY [ClassPackage.intro_classes_tac [], asm_simp_tac simp_s 1]; in - AxClass.add_inst_arity_i (discrete_ty,[],[qu_class]) proof thy + AxClass.prove_arity (discrete_ty,[],[qu_class]) proof thy end) ak_names; fun discrete_cp_inst discrete_ty defn = @@ -623,7 +623,7 @@ val simp_s = HOL_ss addsimps [defn]; val proof = EVERY [ClassPackage.intro_classes_tac [], asm_simp_tac simp_s 1]; in - AxClass.add_inst_arity_i (discrete_ty,[],[qu_class]) proof thy + AxClass.prove_arity (discrete_ty,[],[qu_class]) proof thy end) ak_names)) ak_names; in diff -r b85e16bd70d0 -r 3d10de7a8ca7 src/HOL/Nominal/nominal_package.ML --- a/src/HOL/Nominal/nominal_package.ML Wed Mar 15 16:18:12 2006 +0100 +++ b/src/HOL/Nominal/nominal_package.ML Wed Mar 15 17:59:33 2006 +0100 @@ -411,7 +411,7 @@ (fn _ => EVERY [indtac induction perm_indnames 1, ALLGOALS (asm_full_simp_tac simps)]))) in - foldl (fn ((s, tvs), thy) => AxClass.add_inst_arity_i + foldl (fn ((s, tvs), thy) => AxClass.prove_arity (s, replicate (length tvs) (cp_class :: classes), [cp_class]) (ClassPackage.intro_classes_tac [] THEN ALLGOALS (resolve_tac thms)) thy) thy (full_new_type_names' ~~ tyvars) @@ -420,7 +420,7 @@ val (perm_thmss,thy3) = thy2 |> fold (fn name1 => fold (composition_instance name1) atoms) atoms |> curry (Library.foldr (fn ((i, (tyname, args, _)), thy) => - AxClass.add_inst_arity_i (tyname, replicate (length args) classes, classes) + AxClass.prove_arity (tyname, replicate (length args) classes, classes) (ClassPackage.intro_classes_tac [] THEN REPEAT (EVERY [resolve_tac perm_empty_thms 1, resolve_tac perm_append_thms 1, @@ -585,7 +585,7 @@ fun pt_instance ((class, atom), perm_closed_thms) = fold (fn (((({Abs_inverse, Rep_inverse, Rep, ...}, perm_def), name), tvs), perm_closed) => fn thy => - AxClass.add_inst_arity_i + AxClass.prove_arity (Sign.intern_type thy name, replicate (length tvs) (classes @ cp_classes), [class]) (EVERY [ClassPackage.intro_classes_tac [], @@ -609,7 +609,7 @@ val cp1' = PureThy.get_thm thy (Name (name ^ "_inst")) RS cp1 in fold (fn ((((({Abs_inverse, Rep_inverse, Rep, ...}, perm_def), name), tvs), perm_closed1), perm_closed2) => fn thy => - AxClass.add_inst_arity_i + AxClass.prove_arity (Sign.intern_type thy name, replicate (length tvs) (classes @ cp_classes), [class]) (EVERY [ClassPackage.intro_classes_tac [], @@ -1086,7 +1086,7 @@ DatatypeAux.store_thmss_atts "fresh" new_type_names simp_atts fresh_thms ||> fold (fn (atom, ths) => fn thy => let val class = Sign.intern_class thy ("fs_" ^ Sign.base_name atom) - in fold (fn T => AxClass.add_inst_arity_i + in fold (fn T => AxClass.prove_arity (fst (dest_Type T), replicate (length sorts) [class], [class]) (ClassPackage.intro_classes_tac [] THEN resolve_tac ths 1)) newTs thy