don't generate any type class axioms for free types for monomorphic encodings
authorblanchet
Wed, 04 Jul 2012 13:08:44 +0200
changeset 49200086d9bb80d46
parent 49199 7c48419c89c5
child 49201 10c1f8e190ed
don't generate any type class axioms for free types for monomorphic encodings
src/HOL/Tools/ATP/atp_problem_generate.ML
     1.1 --- a/src/HOL/Tools/ATP/atp_problem_generate.ML	Wed Jul 04 13:08:44 2012 +0200
     1.2 +++ b/src/HOL/Tools/ATP/atp_problem_generate.ML	Wed Jul 04 13:08:44 2012 +0200
     1.3 @@ -2184,19 +2184,24 @@
     1.4             |> bound_tvars type_enc true atomic_types, NONE, [])
     1.5  
     1.6  fun lines_for_free_types type_enc (facts : ifact list) =
     1.7 -  let
     1.8 -    fun line j (cl, T) =
     1.9 -      if polymorphism_of_type_enc type_enc = Type_Class_Polymorphic then
    1.10 -        Class_Memb (class_memb_prefix ^ string_of_int j, [],
    1.11 -                    native_ho_type_from_typ type_enc false 0 T,
    1.12 -                    `make_class cl)
    1.13 -      else
    1.14 -        Formula (tfree_clause_prefix ^ string_of_int j, Hypothesis,
    1.15 -                 class_atom type_enc (cl, T), NONE, [])
    1.16 -    val membs =
    1.17 -      fold (union (op =)) (map #atomic_types facts) []
    1.18 -      |> class_membs_for_types type_enc add_sorts_on_tfree
    1.19 -  in map2 line (0 upto length membs - 1) membs end
    1.20 +  if is_type_enc_polymorphic type_enc then
    1.21 +    let
    1.22 +      val type_classes =
    1.23 +        (polymorphism_of_type_enc type_enc = Type_Class_Polymorphic)
    1.24 +      fun line j (cl, T) =
    1.25 +        if type_classes then
    1.26 +          Class_Memb (class_memb_prefix ^ string_of_int j, [],
    1.27 +                      native_ho_type_from_typ type_enc false 0 T,
    1.28 +                      `make_class cl)
    1.29 +        else
    1.30 +          Formula (tfree_clause_prefix ^ string_of_int j, Hypothesis,
    1.31 +                   class_atom type_enc (cl, T), NONE, [])
    1.32 +      val membs =
    1.33 +        fold (union (op =)) (map #atomic_types facts) []
    1.34 +        |> class_membs_for_types type_enc add_sorts_on_tfree
    1.35 +    in map2 line (0 upto length membs - 1) membs end
    1.36 +  else
    1.37 +    []
    1.38  
    1.39  (** Symbol declarations **)
    1.40