# HG changeset patch # User berghofe # Date 906819185 -7200 # Node ID 7de426cf179c9f13432ac509bb77d6d5894ce55d # Parent ddaa1c133c5ac8788b47e9bd5e44193d8074647f Package now chooses type variable names more carefully to avoid clashes with user-supplied type variable names. diff -r ddaa1c133c5a -r 7de426cf179c src/HOL/Tools/datatype_abs_proofs.ML --- a/src/HOL/Tools/datatype_abs_proofs.ML Fri Sep 25 16:21:56 1998 +0200 +++ b/src/HOL/Tools/datatype_abs_proofs.ML Sat Sep 26 16:13:05 1998 +0200 @@ -103,6 +103,7 @@ val descr' = flat descr; val recTs = get_rec_types descr' sorts; + val used = foldr add_typ_tfree_names (recTs, []); val newTs = take (length (hd descr), recTs); val induct_Ps = map head_of (dest_conj (HOLogic.dest_Trueprop (concl_of induct))); @@ -113,8 +114,8 @@ (map ((curry (op ^) (big_rec_name' ^ "_")) o string_of_int) (1 upto (length descr')))); - val rec_result_Ts = map (fn (i, _) => - TFree ("'t" ^ (string_of_int (i + 1)), HOLogic.termS)) descr'; + val rec_result_Ts = map TFree (variantlist (replicate (length descr') "'t", used) ~~ + replicate (length descr') HOLogic.termS); val reccomb_fn_Ts = flat (map (fn (i, (_, _, constrs)) => map (fn (_, cargs) => @@ -280,14 +281,15 @@ val descr' = flat descr; val recTs = get_rec_types descr' sorts; + val used = foldr add_typ_tfree_names (recTs, []); val newTs = take (length (hd descr), recTs); + val T' = TFree (variant used "'t", HOLogic.termS); val case_dummy_fns = map (fn (_, (_, _, constrs)) => map (fn (_, cargs) => let val Ts = map (typ_of_dtyp descr' sorts) cargs; - val free = TFree ("'t", HOLogic.termS); - val Ts' = replicate (length (filter is_rec_type cargs)) free - in Const ("arbitrary", Ts @ Ts' ---> free) + val Ts' = replicate (length (filter is_rec_type cargs)) T' + in Const ("arbitrary", Ts @ Ts' ---> T') end) constrs) descr'; val case_names = map (fn s => @@ -298,8 +300,6 @@ val (case_defs, thy2) = foldl (fn ((defs, thy), ((((i, (_, _, constrs)), T), name), recname)) => let - val T' = TFree ("'t", HOLogic.termS); - val (fns1, fns2) = ListPair.unzip (map (fn ((_, cargs), j) => let val Ts = map (typ_of_dtyp descr' sorts) cargs; diff -r ddaa1c133c5a -r 7de426cf179c src/HOL/Tools/datatype_package.ML --- a/src/HOL/Tools/datatype_package.ML Fri Sep 25 16:21:56 1998 +0200 +++ b/src/HOL/Tools/datatype_package.ML Sat Sep 26 16:13:05 1998 +0200 @@ -252,6 +252,7 @@ let val descr' = flat descr; val recTs = get_rec_types descr' sorts; + val used = foldr add_typ_tfree_names (recTs, []); val newTs = take (length (hd descr), recTs); val _ = writeln ("Adding axioms for datatype(s) " ^ commas new_type_names); @@ -265,8 +266,8 @@ (cname, map (typ_of_dtyp descr' sorts) cargs ---> T, mx)) (constrs ~~ constr_syntax')) ((hd descr) ~~ newTs ~~ constr_syntax); - val rec_result_Ts = map (fn (i, _) => - TFree ("'t" ^ (string_of_int (i + 1)), HOLogic.termS)) descr'; + val rec_result_Ts = map TFree (variantlist (replicate (length descr') "'t", used) ~~ + replicate (length descr') HOLogic.termS); val reccomb_fn_Ts = flat (map (fn (i, (_, _, constrs)) => map (fn (_, cargs) => @@ -287,7 +288,7 @@ map (fn i => big_size_name ^ "_" ^ string_of_int i) (1 upto length (flat (tl descr))); - val freeT = TFree ("'t", HOLogic.termS); + val freeT = TFree (variant used "'t", HOLogic.termS); val case_fn_Ts = map (fn (i, (_, _, constrs)) => map (fn (_, cargs) => let val Ts = map (typ_of_dtyp descr' sorts) cargs @@ -349,7 +350,6 @@ (**** introduction of axioms ****) val (thy3, inject) = thy2 |> - Theory.add_path (space_implode "_" new_type_names) |> PureThy.add_axioms_i [(("induct", DatatypeProp.make_ind descr sorts), [])] |> add_and_get_axiomss "inject" new_type_names (DatatypeProp.make_injs descr sorts); diff -r ddaa1c133c5a -r 7de426cf179c src/HOL/Tools/datatype_prop.ML --- a/src/HOL/Tools/datatype_prop.ML Fri Sep 25 16:21:56 1998 +0200 +++ b/src/HOL/Tools/datatype_prop.ML Sat Sep 26 16:13:05 1998 +0200 @@ -166,9 +166,10 @@ val descr' = flat descr; val recTs = get_rec_types descr' sorts; + val used = foldr add_typ_tfree_names (recTs, []); - val rec_result_Ts = map (fn (i, _) => - TFree ("'t" ^ (string_of_int (i + 1)), HOLogic.termS)) descr'; + val rec_result_Ts = map TFree (variantlist (replicate (length descr') "'t", used) ~~ + replicate (length descr') HOLogic.termS); val reccomb_fn_Ts = flat (map (fn (i, (_, _, constrs)) => map (fn (_, cargs) => @@ -218,8 +219,9 @@ let val descr' = flat descr; val recTs = get_rec_types descr' sorts; + val used = foldr add_typ_tfree_names (recTs, []); val newTs = take (length (hd descr), recTs); - val T' = TFree ("'t", HOLogic.termS); + val T' = TFree (variant used "'t", HOLogic.termS); val case_fn_Ts = map (fn (i, (_, _, constrs)) => map (fn (_, cargs) => @@ -325,8 +327,9 @@ let val descr' = flat descr; val recTs = get_rec_types descr' sorts; + val used' = foldr add_typ_tfree_names (recTs, []); val newTs = take (length (hd descr), recTs); - val T' = TFree ("'t", HOLogic.termS); + val T' = TFree (variant used' "'t", HOLogic.termS); val P = Free ("P", T' --> HOLogic.boolT); fun make_split (((_, (_, _, constrs)), T), comb_t) =