src/HOL/Tools/ATP/atp_translate.ML
changeset 44405 6fe1a89bb69a
parent 44404 3111af540141
child 44406 392c69bdb170
     1.1 --- a/src/HOL/Tools/ATP/atp_translate.ML	Mon Aug 22 15:02:45 2011 +0200
     1.2 +++ b/src/HOL/Tools/ATP/atp_translate.ML	Mon Aug 22 15:02:45 2011 +0200
     1.3 @@ -1446,10 +1446,10 @@
     1.4      fun var s = ATerm (`I s, [])
     1.5      (* Reconstruction in Metis is strangely dependent on these names. *)
     1.6      fun tag tm = ATerm (type_tag, [var "T", tm])
     1.7 -    val tagged_a = tag (var "A")
     1.8 +    val tagged_var = tag (var "A")
     1.9    in
    1.10      Formula (type_tag_idempotence_helper_name, Axiom,
    1.11 -             eq_formula type_enc [] false (tag tagged_a) tagged_a,
    1.12 +             eq_formula type_enc [] false (tag tagged_var) tagged_var,
    1.13               isabelle_info simpN, NONE)
    1.14    end
    1.15  
    1.16 @@ -1602,10 +1602,10 @@
    1.17    | should_guard_var_in_formula pos phi _ name =
    1.18      formula_fold pos (is_var_positively_naked_in_term name) phi false
    1.19  
    1.20 -fun should_generate_tag_equation _ _ _ (SOME true) _ = false
    1.21 -  | should_generate_tag_equation ctxt mono (Tags (_, level, Nonuniform)) _ T =
    1.22 +fun should_generate_tag_bound_decl _ _ _ (SOME true) _ = false
    1.23 +  | should_generate_tag_bound_decl ctxt mono (Tags (_, level, Nonuniform)) _ T =
    1.24      should_encode_type ctxt mono level T
    1.25 -  | should_generate_tag_equation _ _ _ _ _ = false
    1.26 +  | should_generate_tag_bound_decl _ _ _ _ _ = false
    1.27  
    1.28  fun mk_aterm format type_enc name T_args args =
    1.29    ATerm (name, map_filter (ho_term_for_type_arg format type_enc) T_args @ args)
    1.30 @@ -1663,8 +1663,12 @@
    1.31          IVar (name, T)
    1.32          |> type_guard_iterm ctxt format type_enc T
    1.33          |> do_term pos |> AAtom |> SOME
    1.34 -      else if should_generate_tag_equation ctxt mono type_enc universal T then
    1.35 -        NONE (*###*)
    1.36 +      else if should_generate_tag_bound_decl ctxt mono type_enc universal T then
    1.37 +        let
    1.38 +          val var = ATerm (name, [])
    1.39 +          val tagged_var =
    1.40 +            ATerm (type_tag, [ho_term_from_typ format type_enc T, var])
    1.41 +        in SOME (AAtom (ATerm (`I tptp_equal, [tagged_var, var]))) end
    1.42        else
    1.43          NONE
    1.44      fun do_formula pos (AQuant (q, xs, phi)) =
    1.45 @@ -1955,7 +1959,7 @@
    1.46               isabelle_info introN, NONE)
    1.47    end
    1.48  
    1.49 -fun formula_lines_for_lightweight_tags_sym_decl ctxt format conj_sym_kind mono
    1.50 +fun formula_lines_for_nonuniform_tags_sym_decl ctxt format conj_sym_kind mono
    1.51          type_enc n s (j, (s', T_args, T, pred_sym, ary, in_conj)) =
    1.52    let
    1.53      val ident_base =
    1.54 @@ -2033,7 +2037,7 @@
    1.55       | Nonuniform =>
    1.56         let val n = length decls in
    1.57           (0 upto n - 1 ~~ decls)
    1.58 -         |> maps (formula_lines_for_lightweight_tags_sym_decl ctxt format
    1.59 +         |> maps (formula_lines_for_nonuniform_tags_sym_decl ctxt format
    1.60                        conj_sym_kind mono type_enc n s)
    1.61         end)
    1.62