diff --git a/src/HOL/Tools/ATP/atp_problem.ML b/src/HOL/Tools/ATP/atp_problem.ML --- a/src/HOL/Tools/ATP/atp_problem.ML +++ b/src/HOL/Tools/ATP/atp_problem.ML @@ -1,1051 +1,1053 @@ (* Title: HOL/Tools/ATP/atp_problem.ML Author: Jia Meng, Cambridge University Computer Laboratory and NICTA Author: Jasmin Blanchette, TU Muenchen Author: Martin Desharnais, MPI-INF Saarbruecken Abstract representation of ATP problems and TPTP syntax. *) signature ATP_PROBLEM = sig datatype ('a, 'b) atp_term = ATerm of ('a * 'b list) * ('a, 'b) atp_term list | AAbs of (('a * 'b) * ('a, 'b) atp_term) * ('a, 'b) atp_term list datatype atp_quantifier = AForall | AExists datatype atp_connective = ANot | AAnd | AOr | AImplies | AIff datatype ('a, 'b, 'c, 'd) atp_formula = ATyQuant of atp_quantifier * ('b * 'd list) list * ('a, 'b, 'c, 'd) atp_formula | AQuant of atp_quantifier * ('a * 'b option) list * ('a, 'b, 'c, 'd) atp_formula | AConn of atp_connective * ('a, 'b, 'c, 'd) atp_formula list | AAtom of 'c datatype 'a atp_type = AType of ('a * 'a list) * 'a atp_type list | AFun of 'a atp_type * 'a atp_type | APi of 'a list * 'a atp_type type term_order = {is_lpo : bool, gen_weights : bool, gen_prec : bool, gen_simp : bool} type syntax = {with_ite : bool, with_let : bool} datatype fool = Without_FOOL | With_FOOL of syntax datatype polymorphism = Monomorphic | Polymorphic datatype thf_flavor = THF_Lambda_Free | THF_Without_Choice | THF_With_Choice datatype atp_format = CNF | CNF_UEQ | FOF | TFF of polymorphism * fool | THF of polymorphism * syntax * thf_flavor | DFG of polymorphism datatype atp_formula_role = Axiom | Definition | Lemma | Hypothesis | Conjecture | Negated_Conjecture | Plain | Type_Role | Unknown datatype 'a atp_problem_line = Class_Decl of string * 'a * 'a list | Type_Decl of string * 'a * int | Sym_Decl of string * 'a * 'a atp_type | Datatype_Decl of string * ('a * 'a list) list * 'a atp_type * ('a, 'a atp_type) atp_term list * bool | Class_Memb of string * ('a * 'a list) list * 'a atp_type * 'a | Formula of (string * string) * atp_formula_role * ('a, 'a atp_type, ('a, 'a atp_type) atp_term, 'a) atp_formula * (string, string atp_type) atp_term option * (string, string atp_type) atp_term list type 'a atp_problem = (string * 'a atp_problem_line list) list val tptp_cnf : string val tptp_fof : string + val tptp_tcf : string val tptp_tff : string val tptp_thf : string val tptp_has_type : string val tptp_type_of_types : string val tptp_bool_type : string val tptp_individual_type : string val tptp_fun_type : string val tptp_product_type : string val tptp_forall : string val tptp_ho_forall : string val tptp_pi_binder : string val tptp_exists : string val tptp_ho_exists : string val tptp_choice : string val tptp_ho_choice : string val tptp_hilbert_choice : string val tptp_hilbert_the : string val tptp_not : string val tptp_and : string val tptp_not_and : string val tptp_or : string val tptp_not_or : string val tptp_implies : string val tptp_if : string val tptp_iff : string val tptp_not_iff : string val tptp_ite : string val tptp_let : string val tptp_app : string val tptp_not_infix : string val tptp_equal : string val tptp_not_equal : string val tptp_old_equal : string val tptp_false : string val tptp_true : string val tptp_lambda : string val tptp_empty_list : string type tptp_builtin_desc = {arity : int, is_predicate : bool} val tptp_builtins : tptp_builtin_desc Symtab.table val dfg_individual_type : string val isabelle_info_prefix : string val isabelle_info : bool -> string -> int -> (string, 'a) atp_term list val extract_isabelle_status : (string, 'a) atp_term list -> string option val extract_isabelle_rank : (string, 'a) atp_term list -> int val inductionN : string val introN : string val inductiveN : string val elimN : string val simpN : string val non_rec_defN : string val rec_defN : string val rankN : string val minimum_rank : int val default_rank : int val default_term_order_weight : int val is_tptp_equal : string -> bool val is_built_in_tptp_symbol : string -> bool val is_tptp_variable : string -> bool val is_tptp_user_symbol : string -> bool val bool_atype : (string * string) atp_type val individual_atype : (string * string) atp_type val mk_anot : ('a, 'b, 'c, 'd) atp_formula -> ('a, 'b, 'c, 'd) atp_formula val mk_aconn : atp_connective -> ('a, 'b, 'c, 'd) atp_formula -> ('a, 'b, 'c, 'd) atp_formula -> ('a, 'b, 'c, 'd) atp_formula val mk_app : (string, 'a) atp_term -> (string, 'a) atp_term -> (string, 'a) atp_term val mk_apps : (string, 'a) atp_term -> (string, 'a) atp_term list -> (string, 'a) atp_term val mk_simple_aterm: 'a -> ('a, 'b) atp_term val aconn_fold : bool option -> (bool option -> 'a -> 'b -> 'b) -> atp_connective * 'a list -> 'b -> 'b val aconn_map : bool option -> (bool option -> 'a -> ('b, 'c, 'd, 'e) atp_formula) -> atp_connective * 'a list -> ('b, 'c, 'd, 'e) atp_formula val formula_fold : bool option -> (bool option -> 'c -> 'e -> 'e) -> ('a, 'b, 'c, 'd) atp_formula -> 'e -> 'e val formula_map : ('c -> 'e) -> ('a, 'b, 'c, 'd) atp_formula -> ('a, 'b, 'e, 'd) atp_formula val strip_atype : 'a atp_type -> 'a list * ('a atp_type list * 'a atp_type) val is_format_higher_order : atp_format -> bool val tptp_string_of_format : atp_format -> string val tptp_string_of_role : atp_formula_role -> string val tptp_string_of_line : atp_format -> string atp_problem_line -> string val lines_of_atp_problem : atp_format -> (unit -> (string * int) list) -> string atp_problem -> string list val ensure_cnf_problem : (string * string) atp_problem -> (string * string) atp_problem val filter_cnf_ueq_problem : (string * string) atp_problem -> (string * string) atp_problem val declared_in_atp_problem : 'a atp_problem -> ('a list * 'a list) * 'a list val nice_atp_problem : bool -> atp_format -> ('a * (string * string) atp_problem_line list) list -> ('a * string atp_problem_line list) list * (string Symtab.table * string Symtab.table) option end; structure ATP_Problem : ATP_PROBLEM = struct open ATP_Util val parens = enclose "(" ")" (** ATP problem **) datatype ('a, 'b) atp_term = ATerm of ('a * 'b list) * ('a, 'b) atp_term list | AAbs of (('a * 'b) * ('a, 'b) atp_term) * ('a, 'b) atp_term list datatype atp_quantifier = AForall | AExists datatype atp_connective = ANot | AAnd | AOr | AImplies | AIff datatype ('a, 'b, 'c, 'd) atp_formula = ATyQuant of atp_quantifier * ('b * 'd list) list * ('a, 'b, 'c, 'd) atp_formula | AQuant of atp_quantifier * ('a * 'b option) list * ('a, 'b, 'c, 'd) atp_formula | AConn of atp_connective * ('a, 'b, 'c, 'd) atp_formula list | AAtom of 'c datatype 'a atp_type = AType of ('a * 'a list) * 'a atp_type list | AFun of 'a atp_type * 'a atp_type | APi of 'a list * 'a atp_type type term_order = {is_lpo : bool, gen_weights : bool, gen_prec : bool, gen_simp : bool} type syntax = {with_ite : bool, with_let : bool} datatype fool = Without_FOOL | With_FOOL of syntax datatype polymorphism = Monomorphic | Polymorphic datatype thf_flavor = THF_Lambda_Free | THF_Without_Choice | THF_With_Choice datatype atp_format = CNF | CNF_UEQ | FOF | TFF of polymorphism * fool | THF of polymorphism * syntax * thf_flavor | DFG of polymorphism datatype atp_formula_role = Axiom | Definition | Lemma | Hypothesis | Conjecture | Negated_Conjecture | Plain | Type_Role | Unknown datatype 'a atp_problem_line = Class_Decl of string * 'a * 'a list | Type_Decl of string * 'a * int | Sym_Decl of string * 'a * 'a atp_type | Datatype_Decl of string * ('a * 'a list) list * 'a atp_type * ('a, 'a atp_type) atp_term list * bool | Class_Memb of string * ('a * 'a list) list * 'a atp_type * 'a | Formula of (string * string) * atp_formula_role * ('a, 'a atp_type, ('a, 'a atp_type) atp_term, 'a) atp_formula * (string, string atp_type) atp_term option * (string, string atp_type) atp_term list type 'a atp_problem = (string * 'a atp_problem_line list) list (* official TPTP syntax *) val tptp_cnf = "cnf" val tptp_fof = "fof" +val tptp_tcf = "tcf" (* sometimes appears in E's output *) val tptp_tff = "tff" val tptp_thf = "thf" val tptp_has_type = ":" val tptp_type_of_types = "$tType" val tptp_bool_type = "$o" val tptp_individual_type = "$i" val tptp_fun_type = ">" val tptp_product_type = "*" val tptp_forall = "!" val tptp_ho_forall = "!!" val tptp_pi_binder = "!>" val tptp_exists = "?" val tptp_ho_exists = "??" val tptp_choice = "@+" val tptp_ho_choice = "@@+" val tptp_not = "~" val tptp_and = "&" val tptp_not_and = "~&" val tptp_or = "|" val tptp_not_or = "~|" val tptp_implies = "=>" val tptp_if = "<=" val tptp_iff = "<=>" val tptp_not_iff = "<~>" val tptp_ite = "$ite" val tptp_let = "$let" val tptp_app = "@" val tptp_hilbert_choice = "@+" val tptp_hilbert_the = "@-" val tptp_not_infix = "!" val tptp_equal = "=" val tptp_not_equal = tptp_not_infix ^ tptp_equal val tptp_old_equal = "equal" val tptp_false = "$false" val tptp_true = "$true" val tptp_lambda = "^" val tptp_empty_list = "[]" (* A predicate has return type $o (i.e. bool) *) type tptp_builtin_desc = {arity : int, is_predicate : bool} val tptp_builtins = let fun make_builtin arity is_predicate name = (name, {arity = arity, is_predicate = is_predicate}) in map (make_builtin 0 true) [tptp_false, tptp_true] @ map (make_builtin 1 true) [tptp_not, tptp_ho_forall, tptp_ho_exists] @ map (make_builtin 2 true) [tptp_and, tptp_or, tptp_implies, tptp_if, tptp_iff, tptp_not_iff, tptp_equal, tptp_old_equal] @ map (make_builtin 2 false) [tptp_let] @ map (make_builtin 3 false) [tptp_ite] |> Symtab.make end val dfg_individual_type = "iii" (* cannot clash *) val isabelle_info_prefix = "isabelle_" val inductionN = "induction" val introN = "intro" val inductiveN = "inductive" val elimN = "elim" val simpN = "simp" val non_rec_defN = "non_rec_def" val rec_defN = "rec_def" val rankN = "rank" val minimum_rank = 0 val default_rank = 1000 val default_term_order_weight = 1 fun isabelle_info generate_info status rank = if generate_info then [] |> rank <> default_rank ? cons (ATerm ((isabelle_info_prefix ^ rankN, []), [ATerm ((string_of_int rank, []), [])])) |> status <> "" ? cons (ATerm ((isabelle_info_prefix ^ status, []), [])) else [] fun extract_isabelle_status (ATerm ((s, []), []) :: _) = try (unprefix isabelle_info_prefix) s | extract_isabelle_status _ = NONE fun extract_isabelle_rank (tms as _ :: _) = (case List.last tms of ATerm ((_, []), [ATerm ((rank, []), [])]) => the (Int.fromString rank) | _ => default_rank) | extract_isabelle_rank _ = default_rank fun is_tptp_equal s = (s = tptp_equal orelse s = tptp_old_equal) fun is_built_in_tptp_symbol s = s = tptp_old_equal orelse not (Char.isAlpha (String.sub (s, 0))) fun is_tptp_variable s = s <> "" andalso Char.isUpper (String.sub (s, 0)) val is_tptp_user_symbol = not o (is_tptp_variable orf is_built_in_tptp_symbol) val bool_atype = AType ((`I tptp_bool_type, []), []) val individual_atype = AType ((`I tptp_individual_type, []), []) fun raw_polarities_of_conn ANot = (SOME false, NONE) | raw_polarities_of_conn AAnd = (SOME true, SOME true) | raw_polarities_of_conn AOr = (SOME true, SOME true) | raw_polarities_of_conn AImplies = (SOME false, SOME true) | raw_polarities_of_conn AIff = (NONE, NONE) fun polarities_of_conn NONE = K (NONE, NONE) | polarities_of_conn (SOME pos) = raw_polarities_of_conn #> not pos ? apply2 (Option.map not) fun mk_anot (AConn (ANot, [phi])) = phi | mk_anot phi = AConn (ANot, [phi]) fun mk_aconn c phi1 phi2 = AConn (c, [phi1, phi2]) fun mk_app t u = ATerm ((tptp_app, []), [t, u]) fun mk_apps f xs = fold (fn x => fn f => mk_app f x) xs f fun mk_simple_aterm p = ATerm ((p, []), []) fun aconn_fold pos f (ANot, [phi]) = f (Option.map not pos) phi | aconn_fold pos f (AImplies, [phi1, phi2]) = f (Option.map not pos) phi1 #> f pos phi2 | aconn_fold pos f (AAnd, phis) = fold (f pos) phis | aconn_fold pos f (AOr, phis) = fold (f pos) phis | aconn_fold _ f (_, phis) = fold (f NONE) phis fun aconn_map pos f (ANot, [phi]) = AConn (ANot, [f (Option.map not pos) phi]) | aconn_map pos f (AImplies, [phi1, phi2]) = AConn (AImplies, [f (Option.map not pos) phi1, f pos phi2]) | aconn_map pos f (AAnd, phis) = AConn (AAnd, map (f pos) phis) | aconn_map pos f (AOr, phis) = AConn (AOr, map (f pos) phis) | aconn_map _ f (c, phis) = AConn (c, map (f NONE) phis) fun formula_fold pos f = let fun fld pos (AQuant (_, _, phi)) = fld pos phi | fld pos (ATyQuant (_, _, phi)) = fld pos phi | fld pos (AConn conn) = aconn_fold pos fld conn | fld pos (AAtom tm) = f pos tm in fld pos end fun formula_map f (AQuant (q, xs, phi)) = AQuant (q, xs, formula_map f phi) | formula_map f (ATyQuant (q, xs, phi)) = ATyQuant (q, xs, formula_map f phi) | formula_map f (AConn (c, phis)) = AConn (c, map (formula_map f) phis) | formula_map f (AAtom tm) = AAtom (f tm) fun strip_api (APi (tys, ty)) = strip_api ty |>> append tys | strip_api ty = ([], ty) fun strip_afun (AFun (ty1, ty2)) = strip_afun ty2 |>> cons ty1 | strip_afun ty = ([], ty) fun strip_atype ty = ty |> strip_api ||> strip_afun fun is_function_atype ty = snd (snd (strip_atype ty)) <> AType ((tptp_bool_type, []), []) fun is_predicate_atype ty = not (is_function_atype ty) fun is_nontrivial_predicate_atype (AType _) = false | is_nontrivial_predicate_atype ty = is_predicate_atype ty fun is_format_higher_order (THF _) = true | is_format_higher_order _ = false fun is_format_higher_order_with_choice (THF (_, _, THF_With_Choice)) = true | is_format_higher_order_with_choice _ = false fun is_format_typed (TFF _) = true | is_format_typed (THF _) = true | is_format_typed (DFG _) = true | is_format_typed _ = false fun is_format_with_fool (THF _) = true | is_format_with_fool (TFF (_, With_FOOL _)) = true | is_format_with_fool _ = false fun tptp_string_of_role Axiom = "axiom" | tptp_string_of_role Definition = "definition" | tptp_string_of_role Lemma = "lemma" | tptp_string_of_role Hypothesis = "hypothesis" | tptp_string_of_role Conjecture = "conjecture" | tptp_string_of_role Negated_Conjecture = "negated_conjecture" | tptp_string_of_role Plain = "plain" | tptp_string_of_role Type_Role = "type" | tptp_string_of_role Unknown = "unknown" fun tptp_string_of_app _ func [] = func | tptp_string_of_app format func args = if is_format_higher_order format then "(" ^ space_implode (" " ^ tptp_app ^ " ") (func :: args) ^ ")" else func ^ "(" ^ commas args ^ ")" fun uncurry_type (APi (tys, ty)) = APi (tys, uncurry_type ty) | uncurry_type (ty as AFun (ty1 as AType _, ty2)) = (case uncurry_type ty2 of AFun (ty' as AType ((s, _), tys), ty) => AFun (AType ((tptp_product_type, []), ty1 :: (if s = tptp_product_type then tys else [ty'])), ty) | _ => ty) | uncurry_type (ty as AType _) = ty | uncurry_type _ = raise Fail "unexpected higher-order type in first-order format" val suffix_type_of_types = suffix (" " ^ tptp_has_type ^ " " ^ tptp_type_of_types) fun str_of_type format ty = let val dfg = (case format of DFG _ => true | _ => false) fun str _ (AType ((s, _), [])) = if dfg andalso s = tptp_individual_type then dfg_individual_type else s | str rhs (AType ((s, _), tys)) = if s = tptp_fun_type then let val [ty1, ty2] = tys in str rhs (AFun (ty1, ty2)) end else let val ss = tys |> map (str false) in if s = tptp_product_type then ss |> space_implode (if dfg then ", " else " " ^ tptp_product_type ^ " ") |> (not dfg andalso length ss > 1) ? parens else tptp_string_of_app format s ss end | str rhs (AFun (ty1, ty2)) = (str false ty1 |> dfg ? parens) ^ " " ^ (if dfg then "" else tptp_fun_type ^ " ") ^ str true ty2 |> not rhs ? parens | str _ (APi (ss, ty)) = if dfg then "[" ^ commas ss ^ "], " ^ str true ty else tptp_pi_binder ^ "[" ^ commas (map suffix_type_of_types ss) ^ "]: " ^ str false ty in str true ty end fun string_of_type (format as THF _) ty = str_of_type format ty | string_of_type format ty = str_of_type format (uncurry_type ty) fun tptp_string_of_quantifier AForall = tptp_forall | tptp_string_of_quantifier AExists = tptp_exists fun tptp_string_of_connective ANot = tptp_not | tptp_string_of_connective AAnd = tptp_and | tptp_string_of_connective AOr = tptp_or | tptp_string_of_connective AImplies = tptp_implies | tptp_string_of_connective AIff = tptp_iff fun string_of_bound_var format (s, ty) = s ^ (if is_format_typed format then " " ^ tptp_has_type ^ " " ^ (ty |> the_default (AType ((tptp_individual_type, []), [])) |> string_of_type format) else "") fun tptp_string_of_term _ (ATerm ((s, []), [])) = s |> Symtab.defined tptp_builtins s ? parens | tptp_string_of_term format (ATerm ((s, tys), ts)) = let val of_type = string_of_type format val of_term = tptp_string_of_term format fun app0 f types args = tptp_string_of_app format (f |> Symtab.defined tptp_builtins f ? parens) (map (of_type #> is_format_higher_order format ? parens) types @ map of_term args) fun app () = app0 s tys ts in if s = tptp_empty_list then (* used for lists in the optional "source" field of a derivation *) "[" ^ commas (map of_term ts) ^ "]" else if is_tptp_equal s then space_implode (" " ^ tptp_equal ^ " ") (map of_term ts) |> (is_format_higher_order format orelse is_format_with_fool format) ? parens else if s = tptp_ho_forall orelse s = tptp_ho_exists then (case ts of [AAbs (((s', ty), tm), [])] => (* Use syntactic sugar "!" and "?" instead of "!!" and "??" whenever possible, to work around LEO-II, Leo-III, and Satallax parser limitation. *) tptp_string_of_formula format (AQuant (if s = tptp_ho_forall then AForall else AExists, [(s', SOME ty)], AAtom tm)) | _ => app ()) else if s = tptp_let then (case ts of t1 :: AAbs (((s', ty), tm), []) :: ts => let val declaration = s' ^ " : " ^ of_type ty val definition = s' ^ " := " ^ of_term t1 val usage = of_term tm in if ts = [] orelse is_format_higher_order format then app0 (s ^ "(" ^ declaration ^ ", " ^ definition ^ ", " ^ usage ^ ")") [] ts else error (tptp_let ^ " is special syntax and more than two arguments is only \ \supported in higher order") end | _ => error (tptp_let ^ " is special syntax and must have at least two arguments")) else if s = tptp_ite then (case ts of t1 :: t2 :: t3 :: ts => if ts = [] orelse is_format_higher_order format then app0 (s ^ "(" ^ of_term t1 ^ ", " ^ of_term t2 ^ ", " ^ of_term t3 ^ ")") [] ts else error (tptp_ite ^ " is special syntax and more than three arguments is only supported \ \in higher order") | _ => error (tptp_ite ^ " is special syntax and must have at least three arguments")) else if s = tptp_choice then (case ts of (AAbs (((s', ty), tm), args) :: ts) => (* There is code in "ATP_Problem_Generate" to ensure that "Eps" is always applied to an abstraction. *) if ts = [] orelse is_format_higher_order_with_choice format then let val declaration = s' ^ " : " ^ of_type ty in app0 ("(" ^ tptp_choice ^ "[" ^ declaration ^ "]: " ^ of_term tm ^ ")") [] (args @ ts) end else error (tptp_choice ^ " is only supported in higher order") | _ => error (tptp_choice ^ " must be followed by a lambda abstraction")) else (case (Symtab.lookup tptp_builtins s, ts) of (SOME {arity = 1, is_predicate = true}, [t]) => (* generate e.g. "~ t" instead of "~ @ t". *) s ^ " " ^ (of_term t |> parens) |> parens | (SOME {arity = 2, is_predicate = true}, [t1, t2]) => (* generate e.g. "t1 & t2" instead of "& @ t1 @ t2". *) (of_term t1 |> parens) ^ " " ^ s ^ " " ^ (of_term t2 |> parens) |> parens | _ => app ()) end | tptp_string_of_term (format as THF _) (AAbs (((s, ty), tm), args)) = tptp_string_of_app format ("(^[" ^ s ^ " : " ^ string_of_type format ty ^ "]: " ^ tptp_string_of_term format tm ^ ")") (map (tptp_string_of_term format) args) | tptp_string_of_term _ _ = raise Fail "unexpected term in first-order format" and tptp_string_of_formula format (ATyQuant (q, xs, phi)) = tptp_string_of_quantifier q ^ "[" ^ commas (map (suffix_type_of_types o string_of_type format o fst) xs) ^ "]: " ^ tptp_string_of_formula format phi |> parens | tptp_string_of_formula format (AQuant (q, xs, phi)) = tptp_string_of_quantifier q ^ "[" ^ commas (map (string_of_bound_var format) xs) ^ "]: " ^ tptp_string_of_formula format phi |> parens | tptp_string_of_formula format (AConn (ANot, [AAtom (ATerm (("=" (* tptp_equal *), []), ts))])) = space_implode (" " ^ tptp_not_equal ^ " ") (map (tptp_string_of_term format) ts) |> is_format_higher_order format ? parens | tptp_string_of_formula format (AConn (ANot, [AAtom (ATerm (("equal" (* tptp_old_equal *), []), ts))])) = space_implode (" " ^ tptp_not_equal ^ " ") (map (tptp_string_of_term format) ts) |> is_format_higher_order format ? parens | tptp_string_of_formula format (AConn (c, [phi])) = tptp_string_of_connective c ^ " " ^ (tptp_string_of_formula format phi |> parens) |> parens | tptp_string_of_formula format (AConn (c, phis)) = space_implode (" " ^ tptp_string_of_connective c ^ " ") (map (tptp_string_of_formula format) phis) |> parens | tptp_string_of_formula format (AAtom tm) = tptp_string_of_term format tm fun tptp_string_of_format CNF = tptp_cnf | tptp_string_of_format CNF_UEQ = tptp_cnf | tptp_string_of_format FOF = tptp_fof | tptp_string_of_format (TFF _) = tptp_tff | tptp_string_of_format (THF _) = tptp_thf | tptp_string_of_format (DFG _) = raise Fail "non-TPTP format" val atype_of_types = AType ((tptp_type_of_types, []), []) fun nary_type_decl_type n = funpow n (curry AFun atype_of_types) atype_of_types fun maybe_alt "" = "" | maybe_alt s = " % " ^ s fun tptp_string_of_line format (Type_Decl (ident, ty, ary)) = tptp_string_of_line format (Sym_Decl (ident, ty, nary_type_decl_type ary)) | tptp_string_of_line format (Sym_Decl (ident, sym, ty)) = tptp_string_of_format format ^ "(" ^ ident ^ ", type,\n " ^ sym ^ " : " ^ string_of_type format ty ^ ").\n" | tptp_string_of_line format (Formula ((ident, alt), kind, phi, source, info)) = tptp_string_of_format format ^ "(" ^ ident ^ ", " ^ tptp_string_of_role kind ^ "," ^ "\n (" ^ tptp_string_of_formula format phi ^ ")" ^ (case source of SOME tm => ", " ^ tptp_string_of_term FOF tm | NONE => if null info then "" else ", []") ^ (case info of [] => "" | tms => ", [" ^ commas (map (tptp_string_of_term FOF) tms) ^ "]") ^ ")." ^ maybe_alt alt ^ "\n" fun tptp_lines format = maps (fn (_, []) => [] | (heading, lines) => "\n% " ^ heading ^ " (" ^ string_of_int (length lines) ^ ")\n" :: map (tptp_string_of_line format) lines) fun arity_of_type (APi (tys, ty)) = arity_of_type ty |>> Integer.add (length tys) | arity_of_type (AFun (_, ty)) = arity_of_type ty ||> Integer.add 1 | arity_of_type _ = (0, 0) fun string_of_arity (0, n) = string_of_int n | string_of_arity (m, n) = string_of_int m ^ "+" ^ string_of_int n val dfg_class_inter = space_implode " & " fun dfg_string_of_term (ATerm ((s, tys), tms)) = s ^ (if null tys then "" else "<" ^ commas (map (string_of_type (DFG Polymorphic)) tys) ^ ">") ^ (if null tms then "" else "(" ^ commas (map dfg_string_of_term tms) ^ ")") | dfg_string_of_term _ = raise Fail "unexpected atom in first-order format" fun dfg_string_of_formula poly gen_simp info = let val str_of_typ = string_of_type (DFG poly) fun str_of_bound_typ (ty, []) = str_of_typ ty | str_of_bound_typ (ty, cls) = str_of_typ ty ^ " : " ^ dfg_class_inter cls fun suffix_tag top_level s = if top_level then (case extract_isabelle_status info of SOME s' => if s' = non_rec_defN then s ^ ":lt" else if (s' = simpN orelse s' = rec_defN) andalso gen_simp then s ^ ":lr" else s | NONE => s) else s fun str_of_atom top_level (ATerm ((s, tys), tms)) = let val s' = if is_tptp_equal s then "equal" |> suffix_tag top_level else if s = tptp_true then "true" else if s = tptp_false then "false" else s in dfg_string_of_term (ATerm ((s', tys), tms)) end | str_of_atom _ _ = raise Fail "unexpected atom in first-order format" fun str_of_quant AForall = "forall" | str_of_quant AExists = "exists" fun str_of_conn _ ANot = "not" | str_of_conn _ AAnd = "and" | str_of_conn _ AOr = "or" | str_of_conn _ AImplies = "implies" | str_of_conn top_level AIff = "equiv" |> suffix_tag top_level fun str_of_formula top_level (ATyQuant (q, xs, phi)) = str_of_quant q ^ "_sorts([" ^ commas (map str_of_bound_typ xs) ^ "], " ^ str_of_formula top_level phi ^ ")" | str_of_formula top_level (AQuant (q, xs, phi)) = str_of_quant q ^ "([" ^ commas (map (string_of_bound_var (DFG poly)) xs) ^ "], " ^ str_of_formula top_level phi ^ ")" | str_of_formula top_level (AConn (c, phis)) = str_of_conn top_level c ^ "(" ^ commas (map (str_of_formula false) phis) ^ ")" | str_of_formula top_level (AAtom tm) = str_of_atom top_level tm in str_of_formula true end fun maybe_enclose bef aft "" = "% " ^ bef ^ aft | maybe_enclose bef aft s = bef ^ s ^ aft fun dfg_lines poly ord_info problem = let (* hardcoded settings *) val is_lpo = false val gen_weights = true val gen_prec = true val gen_simp = false val typ = string_of_type (DFG poly) val term = dfg_string_of_term fun spair (s, s') = "(" ^ s ^ ", " ^ s' ^ ")" fun tm_ary sym ty = spair (sym, string_of_arity (arity_of_type ty)) fun ty_ary 0 ty = ty | ty_ary n ty = "(" ^ ty ^ ", " ^ string_of_int n ^ ")" fun fun_typ sym ty = "function(" ^ sym ^ ", " ^ typ ty ^ ")." fun pred_typ sym ty = let val (ty_vars, (tys, _)) = strip_atype ty |>> (fn [] => [] | xs => ["[" ^ commas xs ^ "]"]) in "predicate(" ^ commas (sym :: ty_vars @ map typ tys) ^ ")." end fun bound_tvar (ty, []) = ty | bound_tvar (ty, cls) = ty ^ " : " ^ dfg_class_inter cls fun binder_typ xs ty = (if null xs then "" else "[" ^ commas (map bound_tvar xs) ^ "], ") ^ typ ty fun sort_decl xs ty cl = "sort(" ^ binder_typ xs ty ^ ", " ^ cl ^ ")." fun datatype_decl xs ty tms exhaust = "datatype(" ^ commas (binder_typ xs ty :: map term tms @ (if exhaust then [] else ["..."])) ^ ")." fun subclass_of sub super = "subclass(" ^ sub ^ ", " ^ super ^ ")." fun formula pred (Formula ((ident, alt), kind, phi, _, info)) = if pred kind then let val rank = extract_isabelle_rank info in "formula(" ^ dfg_string_of_formula poly gen_simp info phi ^ ", " ^ ident ^ (if rank = default_rank then "" else ", " ^ string_of_int rank) ^ ")." ^ maybe_alt alt |> SOME end else NONE | formula _ _ = NONE fun filt f = problem |> map (map_filter f o snd) |> filter_out null val func_aries = filt (fn Sym_Decl (_, sym, ty) => if is_function_atype ty then SOME (tm_ary sym ty) else NONE | _ => NONE) |> flat |> commas |> maybe_enclose "functions [" "]." val pred_aries = filt (fn Sym_Decl (_, sym, ty) => if is_predicate_atype ty then SOME (tm_ary sym ty) else NONE | _ => NONE) |> flat |> commas |> maybe_enclose "predicates [" "]." val sorts = filt (try (fn Type_Decl (_, ty, ary) => ty_ary ary ty)) @ [[ty_ary 0 dfg_individual_type]] |> flat |> commas |> maybe_enclose "sorts [" "]." val classes = filt (try (fn Class_Decl (_, cl, _) => cl)) |> flat |> commas |> maybe_enclose "classes [" "]." val ord_info = if gen_weights orelse gen_prec then ord_info () else [] val do_term_order_weights = (if gen_weights then ord_info else []) |> map (spair o apsnd string_of_int) |> commas |> maybe_enclose "weights [" "]." val syms = [func_aries, pred_aries, do_term_order_weights, sorts, classes] val func_decls = filt (fn Sym_Decl (_, sym, ty) => if is_function_atype ty then SOME (fun_typ sym ty) else NONE | _ => NONE) |> flat val pred_decls = filt (fn Sym_Decl (_, sym, ty) => if is_nontrivial_predicate_atype ty then SOME (pred_typ sym ty) else NONE | _ => NONE) |> flat val datatype_decls = filt (try (fn Datatype_Decl (_, xs, ty, tms, exhaust) => datatype_decl xs ty tms exhaust)) |> flat val sort_decls = filt (try (fn Class_Memb (_, xs, ty, cl) => sort_decl xs ty cl)) |> flat val subclass_decls = filt (try (fn Class_Decl (_, sub, supers) => map (subclass_of sub) supers)) |> flat |> flat val decls = func_decls @ pred_decls @ datatype_decls @ sort_decls @ subclass_decls val axioms = filt (formula (curry (op <>) Conjecture)) |> separate [""] |> flat val conjs = filt (formula (curry (op =) Conjecture)) |> separate [""] |> flat val settings = (if is_lpo then ["set_flag(Ordering, 1)."] else []) @ (if gen_prec then [ord_info |> map fst |> rev |> commas |> maybe_enclose "set_precedence(" ")."] else []) fun list_of _ [] = [] | list_of heading ss = "list_of_" ^ heading ^ ".\n" :: map (suffix "\n") ss @ ["end_of_list.\n\n"] in "\nbegin_problem(isabelle).\n\n" :: list_of "descriptions" ["name({**}).", "author({**}).", "status(unknown).", "description({**})."] @ list_of "symbols" syms @ list_of "declarations" decls @ list_of "formulae(axioms)" axioms @ list_of "formulae(conjectures)" conjs @ list_of "settings(SPASS)" settings @ ["end_problem.\n"] end fun lines_of_atp_problem format ord_info problem = "% This file was generated by Isabelle (most likely Sledgehammer)\n\ \% " ^ timestamp () ^ "\n" :: (case format of DFG poly => dfg_lines poly ord_info | _ => tptp_lines format) problem (** CNF (Metis) and CNF UEQ (Waldmeister) **) fun is_line_negated (Formula (_, _, AConn (ANot, _), _, _)) = true | is_line_negated _ = false fun is_line_cnf_ueq (Formula (_, _, AAtom (ATerm (((s, _), _), _)), _, _)) = is_tptp_equal s | is_line_cnf_ueq _ = false fun open_conjecture_term (ATerm (((s, s'), tys), tms)) = ATerm ((if is_tptp_variable s then (s |> Name.desymbolize (SOME false), s') else (s, s'), tys), tms |> map open_conjecture_term) | open_conjecture_term _ = raise Fail "unexpected higher-order term" fun open_formula conj = let (* We are conveniently assuming that all bound variable names are distinct, which should be the case for the formulas we generate. *) fun opn (pos as SOME true) (AQuant (AForall, _, phi)) = opn pos phi | opn (pos as SOME false) (AQuant (AExists, _, phi)) = opn pos phi | opn pos (AConn (ANot, [phi])) = mk_anot (opn (Option.map not pos) phi) | opn pos (AConn (c, [phi1, phi2])) = let val (pos1, pos2) = polarities_of_conn pos c in AConn (c, [opn pos1 phi1, opn pos2 phi2]) end | opn _ (AAtom t) = AAtom (t |> conj ? open_conjecture_term) | opn _ phi = phi in opn (SOME (not conj)) end fun open_formula_line (Formula (ident, kind, phi, source, info)) = Formula (ident, kind, open_formula (kind = Conjecture) phi, source, info) | open_formula_line line = line fun negate_conjecture_line (Formula (ident, Conjecture, phi, source, info)) = Formula (ident, Hypothesis, mk_anot phi, source, info) | negate_conjecture_line line = line exception CLAUSIFY of unit (* This "clausification" only expands syntactic sugar, such as "phi => psi" to "~ phi | psi" and "phi <=> psi" to "~ phi | psi" and "~ psi | phi". We don't attempt to distribute conjunctions over disjunctions. *) fun clausify_formula pos (phi as AAtom _) = [phi |> not pos ? mk_anot] | clausify_formula pos (AConn (ANot, [phi])) = clausify_formula (not pos) phi | clausify_formula true (AConn (AOr, [phi1, phi2])) = (phi1, phi2) |> apply2 (clausify_formula true) |> uncurry (map_product (mk_aconn AOr)) | clausify_formula false (AConn (AAnd, [phi1, phi2])) = (phi1, phi2) |> apply2 (clausify_formula false) |> uncurry (map_product (mk_aconn AOr)) | clausify_formula true (AConn (AImplies, [phi1, phi2])) = clausify_formula true (AConn (AOr, [mk_anot phi1, phi2])) | clausify_formula true (AConn (AIff, phis)) = clausify_formula true (AConn (AImplies, phis)) @ clausify_formula true (AConn (AImplies, rev phis)) | clausify_formula _ _ = raise CLAUSIFY () fun clausify_formula_line (Formula ((ident, alt), kind, phi, source, info)) = let val (n, phis) = phi |> try (clausify_formula true) |> these |> `length in map2 (fn phi => fn j => Formula ((ident ^ replicate_string (j - 1) "x", alt), kind, phi, source, info)) phis (1 upto n) end | clausify_formula_line _ = [] fun ensure_cnf_line line = line |> open_formula_line |> negate_conjecture_line |> clausify_formula_line fun ensure_cnf_problem problem = problem |> map (apsnd (maps ensure_cnf_line)) fun filter_cnf_ueq_problem problem = problem |> map (apsnd (map open_formula_line #> filter is_line_cnf_ueq #> map negate_conjecture_line)) |> (fn problem => let val lines = problem |> maps snd val conjs = lines |> filter is_line_negated in if length conjs = 1 andalso conjs <> lines then problem else [] end) (** Symbol declarations **) fun add_declared_in_line (Class_Decl (_, cl, _)) = apfst (apfst (cons cl)) | add_declared_in_line (Type_Decl (_, ty, _)) = apfst (apsnd (cons ty)) | add_declared_in_line (Sym_Decl (_, sym, _)) = apsnd (cons sym) | add_declared_in_line _ = I fun declared_in_atp_problem problem = fold (fold add_declared_in_line o snd) problem (([], []), []) (** Nice names **) val no_qualifiers = let fun skip [] = [] | skip (#"." :: cs) = skip cs | skip (c :: cs) = if Char.isAlphaNum c then skip cs else c :: keep cs and keep [] = [] | keep (#"." :: cs) = skip cs | keep (c :: cs) = c :: keep cs in String.explode #> rev #> keep #> rev #> String.implode end (* Long names can slow down the ATPs. *) val max_readable_name_size = 20 (* "equal" is reserved by some ATPs. "op" is also reserved, to avoid the unreadable "op_1", "op_2", etc., in the problem files. "eq" is reserved to ensure that "HOL.eq" is correctly mapped to equality (not clear whether this is still necessary). *) val reserved_nice_names = [tptp_old_equal, "op", "eq"] (* hack to get the same hashing across Mirabelle runs (see "mirabelle.pl") *) fun cleanup_mirabelle_name s = let val mirabelle_infix = "_Mirabelle_" val random_suffix_len = 10 val (s1, s2) = Substring.position mirabelle_infix (Substring.full s) in if Substring.isEmpty s2 then s else Substring.string s1 ^ Substring.string (Substring.triml (size mirabelle_infix + random_suffix_len) s2) end fun readable_name protect full_name s = (if s = full_name then s else s |> no_qualifiers |> unquote_tvar |> Name.desymbolize (SOME (Char.isUpper (String.sub (full_name, 0)))) |> (fn s => if size s > max_readable_name_size then String.substring (s, 0, max_readable_name_size div 2 - 4) ^ string_of_int (hash_string (cleanup_mirabelle_name full_name)) ^ String.extract (s, size s - max_readable_name_size div 2 + 4, NONE) else s) |> (fn s => if member (op =) reserved_nice_names s then full_name else s)) |> protect fun nice_name _ (full_name, _) NONE = (full_name, NONE) | nice_name protect (full_name, desired_name) (SOME the_pool) = if is_built_in_tptp_symbol full_name then (full_name, SOME the_pool) else (case Symtab.lookup (fst the_pool) full_name of SOME nice_name => (nice_name, SOME the_pool) | NONE => let val nice_prefix = readable_name protect full_name desired_name fun add j = let val nice_name = nice_prefix ^ (if j = 1 then "" else string_of_int j) in (case Symtab.lookup (snd the_pool) nice_name of SOME full_name' => if full_name = full_name' then (nice_name, the_pool) else add (j + 1) | NONE => (nice_name, (Symtab.update_new (full_name, nice_name) (fst the_pool), Symtab.update_new (nice_name, full_name) (snd the_pool)))) end in add 1 |> apsnd SOME end) fun avoid_clash_with_dfg_keywords s = let val n = String.size s in if n < 2 orelse (n = 2 andalso String.sub (s, 0) = String.sub (s, 1)) orelse String.isSubstring "_" s then s else if is_tptp_variable s then s ^ "_" else String.substring (s, 0, n - 1) ^ String.str (Char.toUpper (String.sub (s, n - 1))) end fun nice_atp_problem readable_names format problem = let val empty_pool = if readable_names then SOME (Symtab.empty, Symtab.empty) else NONE val avoid_clash = (case format of DFG _ => avoid_clash_with_dfg_keywords | _ => I) val nice_name = nice_name avoid_clash fun nice_bound_tvars xs = fold_map (nice_name o fst) xs ##>> fold_map (fold_map nice_name o snd) xs #>> op ~~ fun nice_type (AType ((name, clss), tys)) = nice_name name ##>> fold_map nice_name clss ##>> fold_map nice_type tys #>> AType | nice_type (AFun (ty1, ty2)) = nice_type ty1 ##>> nice_type ty2 #>> AFun | nice_type (APi (names, ty)) = fold_map nice_name names ##>> nice_type ty #>> APi fun nice_term (ATerm ((name, tys), ts)) = nice_name name ##>> fold_map nice_type tys ##>> fold_map nice_term ts #>> ATerm | nice_term (AAbs (((name, ty), tm), args)) = nice_name name ##>> nice_type ty ##>> nice_term tm ##>> fold_map nice_term args #>> AAbs fun nice_formula (ATyQuant (q, xs, phi)) = fold_map (nice_type o fst) xs ##>> fold_map (fold_map nice_name o snd) xs ##>> nice_formula phi #>> (fn ((tys, cls), phi) => ATyQuant (q, tys ~~ cls, phi)) | nice_formula (AQuant (q, xs, phi)) = fold_map (nice_name o fst) xs ##>> fold_map (fn (_, NONE) => pair NONE | (_, SOME ty) => nice_type ty #>> SOME) xs ##>> nice_formula phi #>> (fn ((ss, ts), phi) => AQuant (q, ss ~~ ts, phi)) | nice_formula (AConn (c, phis)) = fold_map nice_formula phis #>> curry AConn c | nice_formula (AAtom tm) = nice_term tm #>> AAtom fun nice_line (Class_Decl (ident, cl, cls)) = nice_name cl ##>> fold_map nice_name cls #>> (fn (cl, cls) => Class_Decl (ident, cl, cls)) | nice_line (Type_Decl (ident, ty, ary)) = nice_name ty #>> (fn ty => Type_Decl (ident, ty, ary)) | nice_line (Sym_Decl (ident, sym, ty)) = nice_name sym ##>> nice_type ty #>> (fn (sym, ty) => Sym_Decl (ident, sym, ty)) | nice_line (Datatype_Decl (ident, xs, ty, tms, exhaust)) = nice_bound_tvars xs ##>> nice_type ty ##>> fold_map nice_term tms #>> (fn ((xs, ty), tms) => Datatype_Decl (ident, xs, ty, tms, exhaust)) | nice_line (Class_Memb (ident, xs, ty, cl)) = nice_bound_tvars xs ##>> nice_type ty ##>> nice_name cl #>> (fn ((xs, ty), cl) => Class_Memb (ident, xs, ty, cl)) | nice_line (Formula (ident, kind, phi, source, info)) = nice_formula phi #>> (fn phi => Formula (ident, kind, phi, source, info)) fun nice_problem problem = fold_map (fn (heading, lines) => fold_map nice_line lines #>> pair heading) problem in nice_problem problem empty_pool end end; diff --git a/src/HOL/Tools/ATP/atp_proof.ML b/src/HOL/Tools/ATP/atp_proof.ML --- a/src/HOL/Tools/ATP/atp_proof.ML +++ b/src/HOL/Tools/ATP/atp_proof.ML @@ -1,783 +1,784 @@ (* Title: HOL/Tools/ATP/atp_proof.ML Author: Lawrence C. Paulson, Cambridge University Computer Laboratory Author: Claire Quigley, Cambridge University Computer Laboratory Author: Jasmin Blanchette, TU Muenchen Author: Mathias Fleury, ENS Rennes Abstract representation of ATP proofs and TSTP/SPASS syntax. *) signature ATP_PROOF = sig type 'a atp_type = 'a ATP_Problem.atp_type type ('a, 'b) atp_term = ('a, 'b) ATP_Problem.atp_term type atp_formula_role = ATP_Problem.atp_formula_role type ('a, 'b, 'c, 'd) atp_formula = ('a, 'b, 'c, 'd) ATP_Problem.atp_formula type 'a atp_problem = 'a ATP_Problem.atp_problem exception UNRECOGNIZED_ATP_PROOF of unit datatype atp_failure = MaybeUnprovable | Unprovable | GaveUp | ProofMissing | ProofIncomplete | ProofUnparsable | TimedOut | Inappropriate | OutOfResources | MalformedInput | MalformedOutput | Interrupted | Crashed | InternalError | UnknownError of string type atp_step_name = string * string list type ('a, 'b) atp_step = atp_step_name * atp_formula_role * 'a * 'b * atp_step_name list type 'a atp_proof = (('a, 'a, ('a, 'a atp_type) atp_term, 'a) atp_formula, string) atp_step list val agsyholN : string val alt_ergoN : string val cvc4N : string val eN : string val iproverN : string val leo2N : string val leo3N : string val satallaxN : string val spassN : string val vampireN : string val veritN : string val waldmeisterN : string val z3N : string val zipperpositionN : string val remote_prefix : string val dummy_fofN : string val dummy_tfxN : string val dummy_thfN : string val agsyhol_core_rule : string val spass_input_rule : string val spass_pre_skolemize_rule : string val spass_skolemize_rule : string val zipperposition_define_rule : string val short_output : bool -> string -> string val string_of_atp_failure : atp_failure -> string val extract_important_message : string -> string val extract_known_atp_failure : (atp_failure * string) list -> string -> atp_failure option val extract_tstplike_proof_and_outcome : bool -> (string * string) list -> (atp_failure * string) list -> string -> string * atp_failure option val is_same_atp_step : atp_step_name -> atp_step_name -> bool val scan_general_id : string list -> string * string list val parse_fol_formula : string list -> (string, string atp_type, (string, string atp_type) atp_term, string) atp_formula * string list val clean_up_atp_proof_dependencies : string atp_proof -> string atp_proof val map_term_names_in_atp_proof : (string -> string) -> string atp_proof -> string atp_proof val nasty_atp_proof : string Symtab.table -> string atp_proof -> string atp_proof val skip_term : string list -> string * string list val parse_hol_formula : string list -> ('a, 'b, (string, string ATP_Problem.atp_type) ATP_Problem.atp_term, 'c) ATP_Problem.atp_formula * string list val dummy_atype : string ATP_Problem.atp_type val role_of_tptp_string : string -> ATP_Problem.atp_formula_role val parse_line : bool -> string -> ('a * string ATP_Problem.atp_problem_line list) list -> string list -> ((string * string list) * ATP_Problem.atp_formula_role * (string, 'b, (string, string ATP_Problem.atp_type) ATP_Problem.atp_term, 'c) ATP_Problem.atp_formula * string * (string * 'd list) list) list * string list val core_inference : 'a -> 'b -> ('b * 'b list) * ATP_Problem.atp_formula_role * ('c, 'd, (string, 'e) ATP_Problem.atp_term, 'f) ATP_Problem.atp_formula * 'a * 'g list val vampire_step_name_ord : (string * 'a) ord val core_of_agsyhol_proof : string -> string list option val string_of_atp_step : ('a -> string) -> ('b -> string) -> ('a, 'b) atp_step -> string val atp_proof_of_tstplike_proof : bool -> string -> string atp_problem -> string -> string atp_proof val atp_abduce_candidates_of_output : string -> string atp_problem -> string -> (string, string, (string, string atp_type) atp_term, string) atp_formula list end; structure ATP_Proof : ATP_PROOF = struct open ATP_Util open ATP_Problem val agsyholN = "agsyhol" val alt_ergoN = "alt_ergo" val cvc4N = "cvc4" val eN = "e" val iproverN = "iprover" val leo2N = "leo2" val leo3N = "leo3" val satallaxN = "satallax" val spassN = "spass" val vampireN = "vampire" val veritN = "verit" val waldmeisterN = "waldmeister" val z3N = "z3" val zipperpositionN = "zipperposition" val remote_prefix = "remote_" val dummy_fofN = "dummy_fof" val dummy_tfxN = "dummy_tfx" val dummy_thfN = "dummy_thf" val agsyhol_core_rule = "__agsyhol_core" (* arbitrary *) val spass_input_rule = "Inp" val spass_pre_skolemize_rule = "__Sko0" (* arbitrary *) val spass_skolemize_rule = "__Sko" (* arbitrary *) val zipperposition_define_rule = "define" (* arbitrary *) exception UNRECOGNIZED_ATP_PROOF of unit datatype atp_failure = MaybeUnprovable | Unprovable | GaveUp | ProofMissing | ProofIncomplete | ProofUnparsable | TimedOut | Inappropriate | OutOfResources | MalformedInput | MalformedOutput | Interrupted | Crashed | InternalError | UnknownError of string fun short_output verbose output = if verbose then if output = "" then "No details available" else elide_string 1000 output else "" fun string_of_atp_failure MaybeUnprovable = "Problem maybe unprovable" | string_of_atp_failure Unprovable = "Unprovable problem" | string_of_atp_failure GaveUp = "Gave up" | string_of_atp_failure ProofMissing = "Proof missing" | string_of_atp_failure ProofIncomplete = "Proof incomplete" | string_of_atp_failure ProofUnparsable = "Proof unparsable" | string_of_atp_failure TimedOut = "Timed out" | string_of_atp_failure Inappropriate = "Problem outside the prover's scope" | string_of_atp_failure OutOfResources = "Out of resources" | string_of_atp_failure MalformedInput = "Malformed problem" | string_of_atp_failure MalformedOutput = "Malformed output" | string_of_atp_failure Interrupted = "Interrupted" | string_of_atp_failure Crashed = "Crashed" | string_of_atp_failure InternalError = "Internal prover error" | string_of_atp_failure (UnknownError s) = "Prover error" ^ (if s = "" then " (pass the \"verbose\" option for details)" else ":\n" ^ s) fun extract_delimited (begin_delim, end_delim) output = (case first_field begin_delim output of SOME (_, tail) => (case first_field "\n" tail of SOME (_, tail') => if end_delim = "" then tail' else (case first_field end_delim tail' of SOME (body, _) => body | NONE => "") | NONE => "") | NONE => "") val tstp_important_message_delims = ("% SZS start RequiredInformation", "% SZS end RequiredInformation") fun extract_important_message output = (case extract_delimited tstp_important_message_delims output of "" => "" | s => s |> space_explode "\n" |> filter_out (curry (op =) "") |> map (perhaps (try (unprefix "%"))) |> map (perhaps (try (unprefix " "))) |> space_implode "\n " |> quote) (* Splits by the first possible of a list of delimiters. *) fun extract_tstplike_proof delims output = (case apply2 (find_first (fn s => String.isSubstring s output)) (ListPair.unzip delims) of (SOME begin_delim, SOME end_delim) => extract_delimited (begin_delim, end_delim) output | _ => "") fun extract_known_atp_failure known_failures output = known_failures |> find_first (fn (_, pattern) => String.isSubstring pattern output) |> Option.map fst fun extract_tstplike_proof_and_outcome verbose proof_delims known_failures output = let val known_atp_failure = extract_known_atp_failure known_failures output val tstplike_proof = extract_tstplike_proof proof_delims output in (case (tstplike_proof, known_atp_failure) of (_, SOME ProofIncomplete) => ("", NONE) | (_, SOME ProofUnparsable) => ("", NONE) | ("", SOME ProofMissing) => ("", NONE) | ("", NONE) => ("", SOME (UnknownError (short_output verbose output))) | res as ("", _) => res | (tstplike_proof, _) => (tstplike_proof, NONE)) end type atp_step_name = string * string list fun is_same_atp_step (s1, _) (s2, _) = s1 = s2 val vampire_fact_prefix = "f" fun vampire_step_name_ord p = let val q = apply2 fst p in (* The "unprefix" part is to cope with Vampire's output, which puts facts with names of the form "fN" where N is an integer in reverse order. *) (case apply2 (Int.fromString o perhaps (try (unprefix vampire_fact_prefix))) q of (SOME i, SOME j) => int_ord (i, j) | (SOME _, NONE) => LESS | (NONE, SOME _) => GREATER | (NONE, NONE) => string_ord q) end type ('a, 'b) atp_step = atp_step_name * atp_formula_role * 'a * 'b * atp_step_name list type 'a atp_proof = (('a, 'a, ('a, 'a atp_type) atp_term, 'a) atp_formula, string) atp_step list (**** PARSING OF TSTP FORMAT ****) (* Strings enclosed in single quotes (e.g., file names), identifiers possibly starting with "$" and possibly with "!" in them. *) val scan_general_id = $$ "'" |-- Scan.repeat (~$$ "'") --| $$ "'" >> implode || (Scan.repeat ($$ "$") -- Scan.many1 Symbol.is_letdig >> (op ^ o apply2 implode)) -- Scan.optional (Scan.repeat ($$ "!") -- Scan.many1 Symbol.is_letdig >> (op ^ o apply2 implode)) "" >> op ^ fun skip_term x = let fun skip _ accum [] = (accum, []) | skip n accum (ss as s :: ss') = if (s = "," orelse s = ".") andalso n = 0 then (accum, ss) else if member (op =) [")", "]"] s then if n = 0 then (accum, ss) else skip (n - 1) (s :: accum) ss' else if member (op =) ["(", "["] s then skip (n + 1) (s :: accum) ss' else skip n (s :: accum) ss' in (skip 0 [] #>> (rev #> implode)) x end and skip_terms x = (skip_term ::: Scan.repeat ($$ "," |-- skip_term)) x datatype source = File_Source of string * string option | Inference_Source of string * string list | Introduced_Source of string | Define_Source val dummy_phi = AAtom (ATerm (("", []), [])) val dummy_atype = AType (("", []), []) (* "skip_term" is there to cope with Waldmeister nonsense such as "theory(equality)". *) fun parse_dependency x = (parse_inference_source >> snd || scan_general_id --| skip_term >> single) x and parse_dependencies x = (Scan.repeats (Scan.option ($$ ",") |-- parse_dependency) >> (filter_out (curry (op =) "theory"))) x and parse_file_source x = (Scan.this_string "file" |-- $$ "(" |-- scan_general_id -- Scan.option ($$ "," |-- scan_general_id --| Scan.option ($$ "," |-- $$ "[" -- Scan.option scan_general_id --| $$ "]")) --| $$ ")") x and parse_inference_source x = (Scan.this_string "inference" |-- $$ "(" |-- scan_general_id --| skip_term --| $$ "," --| skip_term --| $$ "," --| $$ "[" -- parse_dependencies --| $$ "]" --| $$ ")") x and parse_introduced_source x = (Scan.this_string "introduced" |-- $$ "(" |-- scan_general_id --| Scan.option ($$ "," |-- skip_term) --| $$ ")") x and parse_define_source x = (Scan.this_string "define" |-- $$ "(" |-- skip_term --| $$ ")") x and parse_source x = (parse_file_source >> File_Source >> SOME || parse_inference_source >> Inference_Source >> SOME || parse_introduced_source >> Introduced_Source >> SOME || parse_define_source >> K Define_Source >> SOME || scan_general_id >> (fn s => SOME (Inference_Source ("", [s]))) (* for E *) || skip_term >> K NONE) x fun list_app (f, args) = fold (fn arg => fn f => ATerm ((tptp_app, []), [f, arg])) args f fun parse_class x = scan_general_id x and parse_classes x = (parse_class ::: Scan.repeat ($$ "&" |-- parse_class)) x fun parse_type x = (($$ "(" |-- parse_type --| $$ ")" || Scan.this_string tptp_pi_binder |-- $$ "[" |-- skip_terms --| $$ "]" --| $$ ":" -- parse_type >> (fn (_, ty) => ty (* currently ignoring type constructor declarations anyway *)) || (scan_general_id -- Scan.optional ($$ "{" |-- parse_classes --| $$ "}") []) -- Scan.optional ($$ "(" |-- parse_types --| $$ ")") [] >> AType) -- Scan.option (($$ tptp_app || $$ tptp_fun_type || $$ tptp_product_type) -- parse_type) >> (fn (a, NONE) => a | (a, SOME (bin_op, b)) => if bin_op = tptp_app then (case a of AType (s_clss, tys) => AType (s_clss, tys @ [b]) | _ => raise UNRECOGNIZED_ATP_PROOF ()) else if bin_op = tptp_fun_type then AFun (a, b) else if bin_op = tptp_product_type then AType ((tptp_product_type, []), [a, b]) else raise Fail "impossible case")) x and parse_types x = (parse_type ::: Scan.repeat ($$ "," |-- parse_type)) x (* We currently half ignore types. *) fun parse_fol_optional_type_signature x = (Scan.option ($$ tptp_has_type |-- parse_type) >> (fn some as SOME (AType ((s, []), [])) => if s = dfg_individual_type then NONE else some | res => res)) x and parse_fol_arg x = ($$ "(" |-- parse_fol_term --| $$ ")" --| parse_fol_optional_type_signature || scan_general_id -- parse_fol_optional_type_signature -- Scan.optional ($$ "<" |-- parse_types --| $$ ">") [] -- Scan.optional ($$ "(" |-- parse_fol_terms --| $$ ")") [] >> (fn (((s, ty_opt), tyargs), args) => if is_tptp_variable s andalso null tyargs andalso null args andalso is_some ty_opt then ATerm ((s, the_list ty_opt), []) else ATerm ((s, tyargs), args))) x and parse_fol_term x = (parse_fol_arg -- Scan.repeat ($$ tptp_app |-- parse_fol_arg) --| parse_fol_optional_type_signature >> list_app) x and parse_fol_terms x = (parse_fol_term ::: Scan.repeat ($$ "," |-- parse_fol_term)) x fun parse_fol_atom x = (parse_fol_term -- Scan.option (Scan.option ($$ tptp_not_infix) --| $$ tptp_equal -- parse_fol_term) >> (fn (u1, NONE) => AAtom u1 | (u1, SOME (neg, u2)) => AAtom (ATerm (("equal", []), [u1, u2])) |> is_some neg ? mk_anot)) x (* TPTP formulas are fully parenthesized, so we don't need to worry about operator precedence. *) fun parse_fol_literal x = ((Scan.repeat ($$ tptp_not) >> length) -- ($$ "(" |-- parse_fol_formula --| $$ ")" || parse_fol_quantified_formula || parse_fol_atom) >> (fn (n, phi) => phi |> n mod 2 = 1 ? mk_anot)) x and parse_fol_formula x = (parse_fol_literal -- Scan.option ((Scan.this_string tptp_implies || Scan.this_string tptp_iff || Scan.this_string tptp_not_iff || Scan.this_string tptp_if || $$ tptp_or || $$ tptp_and) -- parse_fol_formula) >> (fn (phi1, NONE) => phi1 | (phi1, SOME (c, phi2)) => if c = tptp_implies then mk_aconn AImplies phi1 phi2 else if c = tptp_iff then mk_aconn AIff phi1 phi2 else if c = tptp_not_iff then mk_anot (mk_aconn AIff phi1 phi2) else if c = tptp_if then mk_aconn AImplies phi2 phi1 else if c = tptp_or then mk_aconn AOr phi1 phi2 else if c = tptp_and then mk_aconn AAnd phi1 phi2 else raise Fail ("impossible connective " ^ quote c))) x and parse_fol_quantified_formula x = (($$ tptp_forall >> K AForall || $$ tptp_exists >> K AExists) --| $$ "[" -- parse_fol_terms --| $$ "]" --| $$ ":" -- parse_fol_literal >> (fn ((q, ts), phi) => AQuant (q, map (fn ATerm ((s, _), _) => (s, NONE)) ts, phi))) x val parse_tstp_extra_arguments = Scan.optional ($$ "," |-- parse_source --| Scan.option ($$ "," |-- skip_term)) NONE val waldmeister_conjecture_name = "conjecture_1" fun is_same_term subst tm1 tm2 = let fun do_term_pair (AAbs (((var1, typ1), body1), args1)) (AAbs (((var2, typ2), body2), args2)) (SOME subst) = if typ1 <> typ2 andalso length args1 = length args2 then NONE else let val ls = length subst in SOME ((var1, var2) :: subst) |> do_term_pair body1 body2 |> (fn SOME subst => SOME (nth_drop (length subst - ls - 1) subst) | NONE => NONE) |> (if length args1 = length args2 then fold2 do_term_pair args1 args2 else K NONE) end | do_term_pair (ATerm ((s1, _), args1)) (ATerm ((s2, _), args2)) (SOME subst) = (case apply2 is_tptp_variable (s1, s2) of (true, true) => (case AList.lookup (op =) subst s1 of SOME s2' => if s2' = s2 then SOME subst else NONE | NONE => if null (AList.find (op =) subst s2) then SOME ((s1, s2) :: subst) else NONE) | (false, false) => if s1 = s2 then SOME subst else NONE | _ => NONE) |> (if length args1 = length args2 then fold2 do_term_pair args1 args2 else K NONE) | do_term_pair _ _ _ = NONE in SOME subst |> do_term_pair tm1 tm2 |> is_some end fun is_same_formula comm subst (AQuant (q1, xs1, phi1)) (AQuant (q2, xs2, phi2)) = q1 = q2 andalso length xs1 = length xs2 andalso is_same_formula comm ((map fst xs1 ~~ map fst xs2) @ subst) phi1 phi2 | is_same_formula comm subst (AConn (c1, phis1)) (AConn (c2, phis2)) = c1 = c2 andalso length phis1 = length phis2 andalso forall (uncurry (is_same_formula comm subst)) (phis1 ~~ phis2) | is_same_formula comm subst (AAtom (tm1 as ATerm (("equal", tys), [tm11, tm12]))) (AAtom tm2) = is_same_term subst tm1 tm2 orelse (comm andalso is_same_term subst (ATerm (("equal", tys), [tm12, tm11])) tm2) | is_same_formula _ subst (AAtom tm1) (AAtom tm2) = is_same_term subst tm1 tm2 | is_same_formula _ _ _ _ = false fun matching_formula_line_identifier phi (Formula ((ident, _), _, phi', _, _)) = if is_same_formula true [] phi phi' then SOME (ident, phi') else NONE | matching_formula_line_identifier _ _ = NONE fun find_formula_in_problem phi = maps snd #> map_filter (matching_formula_line_identifier phi) #> try (single o hd) #> the_default [] fun commute_eq (AAtom (ATerm ((s, tys), tms))) = AAtom (ATerm ((s, tys), rev tms)) | commute_eq _ = raise Fail "expected equation" fun role_of_tptp_string "axiom" = Axiom | role_of_tptp_string "definition" = Definition | role_of_tptp_string "lemma" = Lemma | role_of_tptp_string "hypothesis" = Hypothesis | role_of_tptp_string "conjecture" = Conjecture | role_of_tptp_string "negated_conjecture" = Negated_Conjecture | role_of_tptp_string "plain" = Plain | role_of_tptp_string "type" = Type_Role | role_of_tptp_string _ = Unknown fun parse_one_in_list xs = foldl1 (op ||) (map Scan.this_string xs) val tptp_literal_binary_ops = [tptp_equal, tptp_not_equal] val tptp_nonliteral_binary_ops = [tptp_and, tptp_or, tptp_implies, tptp_iff, tptp_if, tptp_not_and, tptp_not_or, tptp_not_iff] fun parse_literal_binary_op x = (parse_one_in_list tptp_literal_binary_ops >> (fn c => if c = tptp_equal then "equal" else c)) x fun parse_nonliteral_binary_op x = (parse_one_in_list tptp_nonliteral_binary_ops >> (fn c => if c = tptp_equal then "equal" else c)) x val parse_fol_quantifier = parse_one_in_list [tptp_forall, tptp_exists, tptp_lambda, tptp_hilbert_choice, tptp_hilbert_the] val parse_hol_quantifier = parse_one_in_list [tptp_ho_forall, tptp_ho_exists, tptp_hilbert_choice, tptp_hilbert_the] fun mk_ho_of_fo_quant q = if q = tptp_forall then tptp_ho_forall else if q = tptp_exists then tptp_ho_exists else if q = tptp_hilbert_choice then tptp_hilbert_choice else if q = tptp_hilbert_the then tptp_hilbert_the else raise Fail ("unrecognized quantification: " ^ q) fun remove_hol_app (ATerm ((s, ty), args)) = if s = tptp_app then (case args of ATerm (f, xs) :: ys => remove_hol_app (ATerm (f, xs @ ys)) | AAbs ((var, phi), xs) :: ys => remove_hol_app (AAbs ((var, phi), xs @ ys))) else ATerm ((s, ty), map remove_hol_app args) | remove_hol_app (AAbs ((var, phi), args)) = AAbs ((var, remove_hol_app phi), map remove_hol_app args) fun parse_hol_typed_var x = (Scan.repeat (scan_general_id -- Scan.option ($$ tptp_has_type |-- parse_type) --| Scan.option (Scan.this_string ",")) || $$ "(" |-- parse_hol_typed_var --| $$ ")") x fun parse_simple_hol_term x = (parse_fol_quantifier -- ($$ "[" |-- parse_hol_typed_var --| $$ "]" --| $$ ":") -- parse_hol_term >> (fn ((q, ys), t) => fold_rev (fn (var, ty) => fn r => AAbs (((var, the_default dummy_atype ty), r), []) |> (if tptp_lambda <> q then mk_app (q |> mk_ho_of_fo_quant |> mk_simple_aterm) else I)) ys t) || Scan.this_string tptp_not |-- parse_hol_term >> mk_app (mk_simple_aterm tptp_not) || scan_general_id -- Scan.option ($$ tptp_has_type |-- parse_type) >> (fn (var, typ_opt) => ATerm ((var, the_list typ_opt), [])) || parse_hol_quantifier >> mk_simple_aterm || $$ "(" |-- parse_hol_term --| $$ ")" || parse_literal_binary_op >> mk_simple_aterm || parse_nonliteral_binary_op >> mk_simple_aterm) x and parse_applied_hol_term x = (parse_simple_hol_term -- Scan.repeat (Scan.this_string tptp_app |-- parse_simple_hol_term) >> (fn (t1, tis) => fold (fn ti => fn left => mk_app left ti) tis t1)) x and parse_literal_hol_term x = (parse_applied_hol_term -- Scan.repeat (parse_literal_binary_op -- parse_applied_hol_term) >> (fn (t1, c_ti_s) => fold (fn (c, ti) => fn left => mk_apps (mk_simple_aterm c) [left, ti]) c_ti_s t1)) x and parse_hol_term x = (parse_literal_hol_term -- Scan.repeat (parse_nonliteral_binary_op -- parse_literal_hol_term) >> (fn (t1, c_ti_s) => fold (fn (c, ti) => fn left => mk_apps (mk_simple_aterm c) [left, ti]) c_ti_s t1)) x fun parse_hol_formula x = (parse_hol_term #>> remove_hol_app #>> AAtom) x fun parse_tstp_hol_line full problem = (Scan.this_string tptp_thf -- $$ "(") |-- scan_general_id --| $$ "," -- Symbol.scan_ascii_id --| $$ "," -- (if full then parse_hol_formula || skip_term >> K dummy_phi else skip_term >> K dummy_phi) -- parse_tstp_extra_arguments --| $$ ")" --| $$ "." >> (fn (((num, role0), phi), src) => let val role = role_of_tptp_string role0 val (name, phi, role', rule, deps) = (case src of SOME (File_Source (_, SOME s)) => if role = Definition then ((num, map fst (find_formula_in_problem phi problem)), phi, role, "", []) else ((num, [s]), phi, role, "", []) | SOME (Inference_Source (rule, deps)) => ((num, []), phi, role, rule, deps) | SOME (Introduced_Source rule) => ((num, []), phi, Definition, rule, []) | SOME Define_Source => ((num, []), phi, Definition, zipperposition_define_rule, []) | _ => ((num, [num]), phi, role, "", [])) in [(name, role', phi, rule, map (rpair []) deps)] end) fun parse_tstp_fol_line full problem = - ((Scan.this_string tptp_cnf || Scan.this_string tptp_fof || Scan.this_string tptp_tff) -- $$ "(") + ((Scan.this_string tptp_cnf || Scan.this_string tptp_fof || Scan.this_string tptp_tcf + || Scan.this_string tptp_tff) -- $$ "(") |-- scan_general_id --| $$ "," -- Symbol.scan_ascii_id --| $$ "," -- (if full then parse_fol_formula || skip_term >> K dummy_phi else skip_term >> K dummy_phi) -- parse_tstp_extra_arguments --| $$ ")" --| $$ "." >> (fn (((num, role0), phi), src) => let val role = role_of_tptp_string role0 val ((name, phi), role', rule, deps) = (* Waldmeister isn't exactly helping. *) (case src of SOME (File_Source (_, SOME s)) => (if s = waldmeister_conjecture_name then (case find_formula_in_problem (mk_anot phi) problem of (* Waldmeister hack: Get the original orientation of the equation to avoid confusing Isar. *) [(s, phi')] => ((num, [s]), phi |> not (is_same_formula false [] (mk_anot phi) phi') ? commute_eq) | _ => ((num, []), phi)) else ((num, [s]), phi), role, "", []) | SOME (File_Source _) => (((num, map fst (find_formula_in_problem phi problem)), phi), role, "", []) | SOME (Inference_Source (rule, deps)) => (((num, []), phi), role, rule, deps) | SOME (Introduced_Source rule) => (((num, []), phi), Definition, rule, []) | SOME Define_Source => (((num, []), phi), Definition, zipperposition_define_rule, []) | _ => (((num, [num]), phi), role, "", [])) fun mk_step () = (name, role', phi, rule, map (rpair []) deps) in [(case role' of Definition => (case phi of AAtom (ATerm (("equal", _), _)) => (* Vampire's equality proxy axiom *) (name, Definition, phi, rule, map (rpair []) deps) | _ => mk_step ()) | _ => mk_step ())] end) fun parse_tstp_line full problem = parse_tstp_fol_line full problem || parse_tstp_hol_line full problem (**** PARSING OF SPASS OUTPUT ****) (* SPASS returns clause references of the form "x.y". We ignore "y". *) val parse_dot_name = scan_general_id --| $$ "." --| scan_general_id val parse_spass_annotations = Scan.optional ($$ ":" |-- Scan.repeat (parse_dot_name --| Scan.option ($$ ","))) [] (* We ignore the stars and the pluses that follow literals. *) fun parse_decorated_atom x = (parse_fol_atom --| Scan.repeat ($$ "*" || $$ "+" || $$ " ")) x fun mk_horn ([], []) = AAtom (ATerm (("c_False", []), [])) | mk_horn (neg_lits, pos_lits) = foldr1 (uncurry (mk_aconn AOr)) (map mk_anot neg_lits @ pos_lits) fun parse_horn_clause x = (Scan.repeat parse_decorated_atom --| $$ "|" --| $$ "|" -- Scan.repeat parse_decorated_atom --| $$ "-" --| $$ ">" -- Scan.repeat parse_decorated_atom >> (mk_horn o apfst (op @))) x val parse_spass_debug = Scan.option ($$ "(" |-- Scan.repeat (scan_general_id --| Scan.option ($$ ",")) --| $$ ")") (* Syntax: [0:] || -> . derived from formulae * *) fun parse_spass_line x = (parse_spass_debug |-- scan_general_id --| $$ "[" --| Scan.many1 Symbol.is_digit --| $$ ":" -- Symbol.scan_ascii_id -- parse_spass_annotations --| $$ "]" -- parse_horn_clause --| $$ "." -- Scan.option (Scan.this_string "derived from formulae " |-- Scan.repeat (scan_general_id --| Scan.option ($$ " "))) >> (fn ((((num, rule), deps), u), names) => [((num, these names), Unknown, u, rule, map (rpair []) deps)])) x fun core_inference inf fact = ((fact, [fact]), Unknown, dummy_phi, inf, []) fun parse_line full local_name problem = (* Satallax is handled separately, in "atp_satallax.ML". *) if local_name = spassN then parse_spass_line else parse_tstp_line full problem fun core_of_agsyhol_proof s = (case split_lines s of "The transformed problem consists of the following conjectures:" :: conj :: _ :: proof_term :: _ => SOME (unprefix " " conj :: find_enclosed "<<" ">>" proof_term) | _ => NONE) fun clean_up_dependencies _ [] = [] | clean_up_dependencies seen ((name, role, u, rule, deps) :: steps) = (name, role, u, rule, map_filter (fn dep => find_first (is_same_atp_step dep) seen) deps) :: clean_up_dependencies (name :: seen) steps fun clean_up_atp_proof_dependencies proof = clean_up_dependencies [] proof fun map_term_names_in_atp_proof f = let fun map_type (AType ((s, clss), tys)) = AType ((f s, map f clss), map map_type tys) | map_type (AFun (ty, ty')) = AFun (map_type ty, map_type ty') | map_type (APi (ss, ty)) = APi (map f ss, map_type ty) fun map_term (ATerm ((s, tys), ts)) = ATerm ((f s, map map_type tys), map map_term ts) | map_term (AAbs (((s, ty), tm), args)) = AAbs (((f s, map_type ty), map_term tm), map map_term args) fun map_formula (AQuant (q, xs, phi)) = AQuant (q, map (apfst f) xs, map_formula phi) | map_formula (AConn (c, phis)) = AConn (c, map map_formula phis) | map_formula (AAtom t) = AAtom (map_term t) fun map_step (name, role, phi, rule, deps) = (name, role, map_formula phi, rule, deps) in map map_step end fun nasty_name pool s = Symtab.lookup pool s |> the_default s fun nasty_atp_proof pool = not (Symtab.is_empty pool) ? map_term_names_in_atp_proof (nasty_name pool) fun string_of_list f xs = enclose "[" "]" (commas (map f xs)) fun string_of_atp_step_name (s, ss) = "(" ^ s ^ ", " ^ string_of_list I ss ^ ")" fun string_of_atp_step f g (name, role, x, y, names) = let val name' = string_of_atp_step_name name val role' = ATP_Problem.tptp_string_of_role role val x' = f x val y' = g y val names' = string_of_list string_of_atp_step_name names in "(" ^ name' ^ ", " ^ role' ^ ", " ^ x' ^ ", " ^ y' ^ ", " ^ names' ^ ")" end fun parse_proof full local_name problem = strip_spaces_except_between_idents #> raw_explode #> Scan.error (!! (fn _ => raise UNRECOGNIZED_ATP_PROOF ()) (Scan.finite Symbol.stopper (Scan.repeats1 (parse_line full local_name problem)))) #> (fn (proof, ss) => if null ss then proof else raise UNRECOGNIZED_ATP_PROOF ()) fun atp_proof_of_tstplike_proof _ _ _ "" = [] | atp_proof_of_tstplike_proof full local_prover problem tstp = (case core_of_agsyhol_proof tstp of SOME facts => facts |> map (core_inference agsyhol_core_rule) | NONE => tstp |> parse_proof full local_prover problem |> local_prover = vampireN ? perhaps (try (sort (vampire_step_name_ord o apply2 #1)))) val e_symbol_prefixes = ["esk", "epred"] fun exists_name_in_term pred = let fun ex_name (ATerm ((s, _), tms)) = pred s orelse exists ex_name tms | ex_name (AAbs ((_, tm), tms)) = exists ex_name (tm :: tms) in ex_name end fun exists_name_in_formula pred phi = formula_fold NONE (fn _ => fn tm => fn ex => ex orelse exists_name_in_term pred tm) phi false fun exists_symbol_in_formula prefixes = exists_name_in_formula (fn s => exists (fn prefix => String.isPrefix prefix s) prefixes) fun atp_abduce_candidates_of_output local_prover problem output = let (* Truncate too large output to avoid memory issues. *) val max_size = 1000000 val output = if String.size output > max_size then String.substring (output, 0, max_size) else output fun fold_extract accum [] = accum | fold_extract accum (line :: lines) = if String.isSubstring "# info" line andalso String.isSubstring "negated_conjecture" line then if String.isSubstring ", 0, 0," line then (* This pattern occurs in the "info()" comment of an E clause that directly emerges from the conjecture. We don't want to tell the user that they can prove "P" by assuming "P". *) fold_extract accum lines else let val clean_line = (case space_explode "#" line of [] => "" | before_hash :: _ => before_hash) in (case try (parse_proof true local_prover problem) clean_line of SOME [(_, _, phi, _, _)] => if local_prover = eN andalso exists_symbol_in_formula e_symbol_prefixes phi then fold_extract accum lines else fold_extract (phi :: accum) lines | _ => fold_extract accum lines) end else fold_extract accum lines in fold_extract [] (split_lines output) end end;