src/HOL/Tools/Metis/metis_translate.ML
changeset 43295 30aaab778416
parent 43268 c0eaa8b9bff5
child 43304 6901ebafbb8d
equal deleted inserted replaced
43294:0271fda2a83a 43295:30aaab778416
   143                   |> Metis_Thm.axiom, isa)
   143                   |> Metis_Thm.axiom, isa)
   144     in
   144     in
   145       if ident = type_tag_idempotence_helper_name orelse
   145       if ident = type_tag_idempotence_helper_name orelse
   146          String.isPrefix lightweight_tags_sym_formula_prefix ident then
   146          String.isPrefix lightweight_tags_sym_formula_prefix ident then
   147         Isa_Reflexive_or_Trivial |> some
   147         Isa_Reflexive_or_Trivial |> some
       
   148       else if String.isPrefix conjecture_prefix ident then
       
   149         NONE
   148       else if String.isPrefix helper_prefix ident then
   150       else if String.isPrefix helper_prefix ident then
   149         case (String.isSuffix typed_helper_suffix ident,
   151         case (String.isSuffix typed_helper_suffix ident,
   150               space_explode "_" ident) of
   152               space_explode "_" ident) of
   151           (needs_fairly_sound, _ :: const :: j :: _) =>
   153           (needs_fairly_sound, _ :: const :: j :: _) =>
   152           nth ((const, needs_fairly_sound)
   154           nth ((const, needs_fairly_sound)
   153                |> AList.lookup (op =) helper_table |> the)
   155                |> AList.lookup (op =) helper_table |> the)
   154               (the (Int.fromString j) - 1)
   156               (the (Int.fromString j) - 1)
   155           |> prepare_helper
   157           |> prepare_helper
   156           |> Isa_Raw |> some
   158           |> Isa_Raw |> some
   157         | _ => raise Fail ("malformed helper identifier " ^ quote ident)
   159         | _ => raise Fail ("malformed helper identifier " ^ quote ident)
   158       else case try (unprefix conjecture_prefix) ident of
   160       else case try (unprefix fact_prefix) ident of
   159         SOME s =>
   161         SOME s =>
   160         let val j = the (Int.fromString s) in
   162         let
   161           if j = length clauses then NONE
   163           val j = s |> space_explode "_" |> List.last |> Int.fromString |> the
   162           else Meson.make_meta_clause (nth clauses j) |> Isa_Raw |> some
   164         in Meson.make_meta_clause (snd (nth clauses j)) |> Isa_Raw |> some end
   163         end
       
   164       | NONE => TrueI |> Isa_Raw |> some
   165       | NONE => TrueI |> Isa_Raw |> some
   165     end
   166     end
   166   | metis_axiom_from_atp _ _ = raise Fail "not CNF -- expected formula"
   167   | metis_axiom_from_atp _ _ = raise Fail "not CNF -- expected formula"
   167 
   168 
   168 (* Function to generate metis clauses, including comb and type clauses *)
   169 (* Function to generate metis clauses, including comb and type clauses *)
   169 fun prepare_metis_problem ctxt type_sys conj_clauses fact_clauses =
   170 fun prepare_metis_problem ctxt type_sys conj_clauses fact_clauses =
   170   let
   171   let
   171     val type_sys = type_sys_from_string type_sys
   172     val type_sys = type_sys_from_string type_sys
       
   173     val (conj_clauses, fact_clauses) =
       
   174       if polymorphism_of_type_sys type_sys = Polymorphic then
       
   175         (conj_clauses, fact_clauses)
       
   176       else
       
   177         conj_clauses @ fact_clauses
       
   178         |> map (pair 0)
       
   179         |> rpair ctxt
       
   180         |-> Monomorph.monomorph atp_schematic_consts_of
       
   181         |> fst |> chop (length conj_clauses)
       
   182         |> pairself (maps (map (zero_var_indexes o snd)))
       
   183     val num_conjs = length conj_clauses
   172     val clauses =
   184     val clauses =
   173       conj_clauses @ fact_clauses
   185       map2 (fn j => pair (Int.toString j, Local))
   174       |> (if polymorphism_of_type_sys type_sys = Polymorphic then
   186            (0 upto num_conjs - 1) conj_clauses @
   175             I
   187       (* "General" below isn't quite correct; the fact could be local. *)
   176           else
   188       map2 (fn j => pair (Int.toString (num_conjs + j), General))
   177             map (pair 0)
   189            (0 upto length fact_clauses - 1) fact_clauses
   178             #> rpair ctxt
       
   179             #-> Monomorph.monomorph atp_schematic_consts_of
       
   180             #> fst #> maps (map (zero_var_indexes o snd)))
       
   181     val (old_skolems, props) =
   190     val (old_skolems, props) =
   182       fold_rev (fn clause => fn (old_skolems, props) =>
   191       fold_rev (fn (name, th) => fn (old_skolems, props) =>
   183                    clause |> prop_of |> Logic.strip_imp_concl
   192                    th |> prop_of |> Logic.strip_imp_concl
   184                           |> conceal_old_skolem_terms (length clauses)
   193                       |> conceal_old_skolem_terms (length clauses) old_skolems
   185                                                       old_skolems
   194                       ||> (fn prop => (name, prop) :: props))
   186                           ||> (fn prop => prop :: props))
   195                clauses ([], [])
   187            clauses ([], [])
   196     (*
   188 (*
   197     val _ =
   189 val _ = tracing ("PROPS:\n" ^ cat_lines (map (Syntax.string_of_term ctxt) props))
   198       tracing ("PROPS:\n" ^ cat_lines (map (Syntax.string_of_term ctxt) props))
   190 *)
   199     *)
   191     val (atp_problem, _, _, _, _, _, sym_tab) =
   200     val (atp_problem, _, _, _, _, _, sym_tab) =
   192       prepare_atp_problem ctxt CNF Hypothesis Axiom type_sys false false props
   201       prepare_atp_problem ctxt CNF Hypothesis Axiom type_sys false false []
   193                           @{prop False} []
   202                           @{prop False} props
   194 (*
   203     (*
   195 val _ = tracing ("ATP PROBLEM: " ^ cat_lines (tptp_lines_for_atp_problem CNF atp_problem))
   204     val _ = tracing ("ATP PROBLEM: " ^
   196 *)
   205                      cat_lines (tptp_lines_for_atp_problem CNF atp_problem))
       
   206     *)
   197     (* "rev" is for compatibility *)
   207     (* "rev" is for compatibility *)
   198     val axioms =
   208     val axioms =
   199       atp_problem |> maps (map_filter (metis_axiom_from_atp clauses) o snd)
   209       atp_problem |> maps (map_filter (metis_axiom_from_atp clauses) o snd)
   200                   |> rev
   210                   |> rev
   201   in (sym_tab, axioms, old_skolems) end
   211   in (sym_tab, axioms, old_skolems) end