src/HOL/Tools/Nitpick/nitpick_hol.ML
changeset 33547 cba22e2999d5
parent 33224 f93390060bbe
child 33548 107f3df799f6
     1.1 --- a/src/HOL/Tools/Nitpick/nitpick_hol.ML	Tue Oct 27 15:55:36 2009 +0100
     1.2 +++ b/src/HOL/Tools/Nitpick/nitpick_hol.ML	Tue Oct 27 16:52:06 2009 +0100
     1.3 @@ -125,7 +125,7 @@
     1.4    val is_inductive_pred : extended_context -> styp -> bool
     1.5    val is_constr_pattern_lhs : theory -> term -> bool
     1.6    val is_constr_pattern_formula : theory -> term -> bool
     1.7 -  val coalesce_type_vars_in_terms : term list -> term list
     1.8 +  val merge_type_vars_in_terms : term list -> term list
     1.9    val ground_types_in_type : extended_context -> typ -> typ list
    1.10    val ground_types_in_terms : extended_context -> term list -> typ list
    1.11    val format_type : int list -> int list -> typ -> typ
    1.12 @@ -1016,24 +1016,6 @@
    1.13        | do_eq _ = false
    1.14    in do_eq end
    1.15  
    1.16 -(* This table is not pretty. A better approach would be to avoid expanding the
    1.17 -   operators to their low-level definitions, but this would require dealing with
    1.18 -   overloading. *)
    1.19 -val built_in_built_in_defs =
    1.20 -  [@{thm div_int_inst.div_int}, @{thm div_int_inst.mod_int},
    1.21 -   @{thm div_nat_inst.div_nat}, @{thm div_nat_inst.mod_nat},
    1.22 -   @{thm lower_semilattice_fun_inst.inf_fun}, @{thm minus_fun_inst.minus_fun},
    1.23 -   @{thm minus_int_inst.minus_int}, @{thm minus_nat_inst.minus_nat},
    1.24 -   @{thm one_int_inst.one_int}, @{thm one_nat_inst.one_nat},
    1.25 -   @{thm ord_fun_inst.less_eq_fun}, @{thm ord_int_inst.less_eq_int},
    1.26 -   @{thm ord_int_inst.less_int}, @{thm ord_nat_inst.less_eq_nat},
    1.27 -   @{thm ord_nat_inst.less_nat}, @{thm plus_int_inst.plus_int},
    1.28 -   @{thm plus_nat_inst.plus_nat}, @{thm times_int_inst.times_int},
    1.29 -   @{thm times_nat_inst.times_nat}, @{thm uminus_int_inst.uminus_int},
    1.30 -   @{thm upper_semilattice_fun_inst.sup_fun}, @{thm zero_int_inst.zero_int},
    1.31 -   @{thm zero_nat_inst.zero_nat}]
    1.32 -  |> map prop_of
    1.33 -
    1.34  (* theory -> term list * term list * term list *)
    1.35  fun all_axioms_of thy =
    1.36    let
    1.37 @@ -1054,8 +1036,7 @@
    1.38      val (built_in_nondefs, user_nondefs) =
    1.39        List.partition (is_typedef_axiom thy false) user_nondefs
    1.40        |>> append built_in_nondefs
    1.41 -    val defs = built_in_built_in_defs @
    1.42 -               (thy |> PureThy.all_thms_of
    1.43 +    val defs = (thy |> PureThy.all_thms_of
    1.44                      |> filter (equal Thm.definitionK o Thm.get_kind o snd)
    1.45                      |> map (prop_of o snd) |> filter is_plain_definition) @
    1.46                 user_defs @ built_in_defs
    1.47 @@ -1309,10 +1290,6 @@
    1.48      |> fold_rev (curry absdummy) (func_Ts @ [dataT])
    1.49    end
    1.50  
    1.51 -val redefined_in_Nitpick_thy =
    1.52 -  [@{const_name option_case}, @{const_name nat_case}, @{const_name list_case},
    1.53 -   @{const_name list_size}]
    1.54 -
    1.55  (* theory -> string -> typ -> typ -> term -> term *)
    1.56  fun optimized_record_get thy s rec_T res_T t =
    1.57    let val constr_x = the_single (datatype_constrs thy rec_T) in
    1.58 @@ -1382,7 +1359,6 @@
    1.59    (is_real_equational_fun ext_ctxt orf is_real_inductive_pred ext_ctxt
    1.60     orf (String.isPrefix ubfp_prefix orf String.isPrefix lbfp_prefix) o fst)
    1.61    andf (not o has_trivial_definition thy def_table)
    1.62 -  andf (not o member (op =) redefined_in_Nitpick_thy o fst)
    1.63  
    1.64  (* term * term -> term *)
    1.65  fun s_betapply (Const (@{const_name If}, _) $ @{const True} $ t, _) = t
    1.66 @@ -1879,9 +1855,7 @@
    1.67  (* extended_context -> styp -> term list *)
    1.68  fun raw_equational_fun_axioms (ext_ctxt as {thy, fast_descrs, simp_table,
    1.69                                              psimp_table, ...}) (x as (s, _)) =
    1.70 -  if s mem redefined_in_Nitpick_thy then
    1.71 -    []
    1.72 -  else case def_props_for_const thy fast_descrs (!simp_table) x of
    1.73 +  case def_props_for_const thy fast_descrs (!simp_table) x of
    1.74      [] => (case def_props_for_const thy fast_descrs psimp_table x of
    1.75               [] => [inductive_pred_axiom ext_ctxt x]
    1.76             | psimps => psimps)
    1.77 @@ -1890,7 +1864,7 @@
    1.78  val equational_fun_axioms = map extensionalize oo raw_equational_fun_axioms
    1.79  
    1.80  (* term list -> term list *)
    1.81 -fun coalesce_type_vars_in_terms ts =
    1.82 +fun merge_type_vars_in_terms ts =
    1.83    let
    1.84      (* typ -> (sort * string) list -> (sort * string) list *)
    1.85      fun add_type (TFree (s, S)) table =