blanchet@36375: (* Title: HOL/Tools/Sledgehammer/sledgehammer_isar.ML blanchet@35866: Author: Jasmin Blanchette, TU Muenchen blanchet@35866: blanchet@35866: Adds "sledgehammer" and related commands to Isabelle/Isar's outer syntax. blanchet@35866: *) blanchet@35866: blanchet@35961: signature SLEDGEHAMMER_ISAR = blanchet@35961: sig blanchet@41335: type params = Sledgehammer_Provers.params blanchet@35961: blanchet@43861: val sledgehammerN : string blanchet@39564: val auto : bool Unsynchronized.ref blanchet@40240: val provers : string Unsynchronized.ref blanchet@39564: val timeout : int Unsynchronized.ref blanchet@40250: val default_params : Proof.context -> (string * string) list -> params blanchet@39564: val setup : theory -> theory blanchet@35961: end; blanchet@35961: blanchet@35969: structure Sledgehammer_Isar : SLEDGEHAMMER_ISAR = blanchet@35866: struct blanchet@35866: blanchet@45652: open ATP_Util blanchet@38262: open ATP_Systems blanchet@43926: open ATP_Translate blanchet@46390: open ATP_Reconstruct blanchet@35969: open Sledgehammer_Util blanchet@45319: open Sledgehammer_Filter blanchet@41335: open Sledgehammer_Provers blanchet@39232: open Sledgehammer_Minimize blanchet@41335: open Sledgehammer_Run blanchet@35866: blanchet@43861: val sledgehammerN = "sledgehammer" blanchet@43861: val sledgehammer_paramsN = "sledgehammer_params" blanchet@43861: blanchet@43861: val runN = "run" blanchet@43861: val minN = "min" blanchet@43861: val messagesN = "messages" blanchet@43861: val supported_proversN = "supported_provers" blanchet@43861: val running_proversN = "running_provers" blanchet@43861: val kill_proversN = "kill_provers" blanchet@43861: val refresh_tptpN = "refresh_tptp" blanchet@43861: blanchet@39564: val auto = Unsynchronized.ref false blanchet@39564: blanchet@39564: val _ = blanchet@39564: ProofGeneralPgip.add_preference Preferences.category_tracing blanchet@39564: (Preferences.bool_pref auto "auto-sledgehammer" blanchet@39573: "Run Sledgehammer automatically.") blanchet@39564: blanchet@36394: (** Sledgehammer commands **) blanchet@36394: blanchet@39564: fun add_relevance_override ns : relevance_override = blanchet@35964: {add = ns, del = [], only = false} blanchet@39564: fun del_relevance_override ns : relevance_override = blanchet@35964: {add = [], del = ns, only = false} blanchet@35964: fun only_relevance_override ns : relevance_override = blanchet@35964: {add = ns, del = [], only = true} blanchet@36003: fun merge_relevance_override_pairwise (r1 : relevance_override) blanchet@36003: (r2 : relevance_override) = blanchet@35964: {add = #add r1 @ #add r2, del = #del r1 @ #del r2, blanchet@36183: only = #only r1 andalso #only r2} blanchet@36188: fun merge_relevance_overrides rs = blanchet@36188: fold merge_relevance_override_pairwise rs (only_relevance_override []) blanchet@35963: blanchet@36371: (*** parameters ***) blanchet@36371: blanchet@40240: val provers = Unsynchronized.ref "" blanchet@39581: val timeout = Unsynchronized.ref 30 blanchet@36371: blanchet@36371: val _ = blanchet@36371: ProofGeneralPgip.add_preference Preferences.category_proof blanchet@40240: (Preferences.string_pref provers blanchet@40240: "Sledgehammer: Provers" blanchet@36371: "Default automatic provers (separated by whitespace)") blanchet@36371: blanchet@36371: val _ = blanchet@36371: ProofGeneralPgip.add_preference Preferences.category_proof blanchet@36371: (Preferences.int_pref timeout blanchet@36373: "Sledgehammer: Time Limit" blanchet@36371: "ATPs will be interrupted after this time (in seconds)") blanchet@36371: blanchet@35961: type raw_param = string * string list blanchet@35866: blanchet@35961: val default_default_params = blanchet@41456: [("debug", "false"), blanchet@35961: ("verbose", "false"), blanchet@36141: ("overlord", "false"), blanchet@41456: ("blocking", "false"), blanchet@44493: ("type_enc", "smart"), blanchet@47129: ("strict", "false"), blanchet@46385: ("lam_trans", "smart"), blanchet@43051: ("relevance_thresholds", "0.45 0.85"), blanchet@43051: ("max_relevant", "smart"), blanchet@43654: ("max_mono_iters", "3"), blanchet@44218: ("max_new_mono_instances", "200"), blanchet@35961: ("isar_proof", "false"), blanchet@43314: ("isar_shrink_factor", "1"), blanchet@46577: ("slice", "true"), blanchet@46578: ("minimize", "smart"), blanchet@47125: ("preplay_timeout", "3")] blanchet@35866: blanchet@36138: val alias_params = blanchet@44219: [("prover", "provers")] blanchet@36138: val negated_alias_params = blanchet@41456: [("no_debug", "debug"), blanchet@35961: ("quiet", "verbose"), blanchet@36141: ("no_overlord", "overlord"), blanchet@41456: ("non_blocking", "blocking"), blanchet@47129: ("non_strict", "strict"), blanchet@43314: ("no_isar_proof", "isar_proof"), blanchet@46578: ("dont_slice", "slice"), blanchet@46578: ("dont_minimize", "minimize")] blanchet@35866: blanchet@36281: val params_for_minimize = blanchet@47129: ["debug", "verbose", "overlord", "type_enc", "strict", "lam_trans", blanchet@46385: "max_mono_iters", "max_new_mono_instances", "isar_proof", blanchet@46385: "isar_shrink_factor", "timeout", "preplay_timeout"] blanchet@36281: blanchet@44431: val property_dependent_params = ["provers", "timeout"] blanchet@35866: blanchet@35961: fun is_known_raw_param s = blanchet@35961: AList.defined (op =) default_default_params s orelse blanchet@36138: AList.defined (op =) alias_params s orelse blanchet@36138: AList.defined (op =) negated_alias_params s orelse blanchet@39229: member (op =) property_dependent_params s orelse s = "expect" blanchet@35866: blanchet@41504: fun is_prover_list ctxt s = blanchet@41504: case space_explode " " s of blanchet@42591: ss as _ :: _ => forall (is_prover_supported ctxt) ss blanchet@41504: | _ => false blanchet@41504: blanchet@36138: fun unalias_raw_param (name, value) = blanchet@36138: case AList.lookup (op =) alias_params name of blanchet@36138: SOME name' => (name', value) blanchet@36138: | NONE => blanchet@36138: case AList.lookup (op =) negated_alias_params name of blanchet@36138: SOME name' => (name', case value of blanchet@36138: ["false"] => ["true"] blanchet@36138: | ["true"] => ["false"] blanchet@36138: | [] => ["false"] blanchet@36138: | _ => value) blanchet@36138: | NONE => (name, value) blanchet@35961: blanchet@47129: val any_type_enc = type_enc_from_string Strict "erased" blanchet@46385: blanchet@46385: (* "provers =", "type_enc =", and "lam_trans" can be omitted. For the last two, blanchet@46385: this is a secret feature. *) blanchet@45591: fun normalize_raw_param ctxt = blanchet@45591: unalias_raw_param blanchet@45591: #> (fn (name, value) => blanchet@45591: if is_known_raw_param name then blanchet@45591: (name, value) blanchet@45591: else if is_prover_list ctxt name andalso null value then blanchet@45591: ("provers", [name]) blanchet@47129: else if can (type_enc_from_string Strict) name andalso null value then blanchet@45591: ("type_enc", [name]) blanchet@46385: else if can (trans_lams_from_string ctxt any_type_enc) name andalso blanchet@46385: null value then blanchet@46385: ("lam_trans", [name]) blanchet@45591: else blanchet@45591: error ("Unknown parameter: " ^ quote name ^ ".")) blanchet@45591: blanchet@45591: blanchet@45653: (* Ensures that type encodings such as "mono_simple?" and "poly_guards!!" are blanchet@45653: read correctly. *) blanchet@45652: val implode_param = strip_spaces_except_between_idents o space_implode " " blanchet@43850: wenzelm@41720: structure Data = Theory_Data wenzelm@41720: ( blanchet@35961: type T = raw_param list blanchet@35961: val empty = default_default_params |> map (apsnd single) blanchet@35961: val extend = I wenzelm@41720: fun merge data : T = AList.merge (op =) (K true) data wenzelm@41720: ) blanchet@35961: blanchet@42591: fun remotify_prover_if_supported_and_not_already_remote ctxt name = blanchet@40253: if String.isPrefix remote_prefix name then blanchet@40253: SOME name blanchet@40253: else blanchet@40253: let val remote_name = remote_prefix ^ name in blanchet@42591: if is_prover_supported ctxt remote_name then SOME remote_name else NONE blanchet@40253: end blanchet@40253: blanchet@40253: fun remotify_prover_if_not_installed ctxt name = blanchet@42591: if is_prover_supported ctxt name andalso is_prover_installed ctxt name then blanchet@41189: SOME name blanchet@41189: else blanchet@42591: remotify_prover_if_supported_and_not_already_remote ctxt name blanchet@40253: blanchet@43850: fun avoid_too_many_threads _ _ [] = [] blanchet@43850: | avoid_too_many_threads _ (0, 0) _ = [] blanchet@43850: | avoid_too_many_threads ctxt (0, max_remote) provers = blanchet@43850: provers blanchet@43850: |> map_filter (remotify_prover_if_supported_and_not_already_remote ctxt) blanchet@43850: |> take max_remote blanchet@43850: | avoid_too_many_threads _ (max_local, 0) provers = blanchet@43850: provers blanchet@43850: |> filter_out (String.isPrefix remote_prefix) blanchet@43850: |> take max_local blanchet@43850: | avoid_too_many_threads ctxt max_local_and_remote (prover :: provers) = blanchet@43850: let blanchet@43850: val max_local_and_remote = blanchet@43850: max_local_and_remote blanchet@43850: |> (if String.isPrefix remote_prefix prover then apsnd else apfst) blanchet@43850: (Integer.add ~1) blanchet@43850: in prover :: avoid_too_many_threads ctxt max_local_and_remote provers end blanchet@40240: blanchet@43850: val max_default_remote_threads = 4 blanchet@43558: blanchet@40240: (* The first ATP of the list is used by Auto Sledgehammer. Because of the low blanchet@40240: timeout, it makes sense to put SPASS first. *) blanchet@40250: fun default_provers_param_value ctxt = blanchet@45929: [spassN, eN, vampireN, SMT_Solver.solver_name_of ctxt, e_sineN, waldmeisterN] blanchet@41189: |> map_filter (remotify_prover_if_not_installed ctxt) blanchet@43850: |> avoid_too_many_threads ctxt (Multithreading.max_threads_value (), blanchet@43850: max_default_remote_threads) blanchet@43647: |> implode_param blanchet@40240: blanchet@45591: fun set_default_raw_param param thy = blanchet@45591: let val ctxt = Proof_Context.init_global thy in blanchet@45591: thy |> Data.map (AList.update (op =) (normalize_raw_param ctxt param)) blanchet@45591: end blanchet@40250: fun default_raw_params ctxt = wenzelm@43232: let val thy = Proof_Context.theory_of ctxt in blanchet@40250: Data.get thy blanchet@40250: |> fold (AList.default (op =)) blanchet@40250: [("provers", [case !provers of blanchet@40250: "" => default_provers_param_value ctxt blanchet@40250: | s => s]), blanchet@40250: ("timeout", let val timeout = !timeout in blanchet@40250: [if timeout <= 0 then "none" blanchet@40582: else string_of_int timeout] blanchet@40250: end)] blanchet@40250: end blanchet@35961: blanchet@35961: val infinity_time_in_secs = 60 * 60 * 24 * 365 blanchet@35961: val the_timeout = the_default (Time.fromSeconds infinity_time_in_secs) blanchet@35961: blanchet@43862: fun extract_params mode default_params override_params = blanchet@35961: let blanchet@35961: val raw_params = rev override_params @ rev default_params blanchet@43647: val lookup = Option.map implode_param o AList.lookup (op =) raw_params blanchet@35961: val lookup_string = the_default "" o lookup blanchet@35961: fun general_lookup_bool option default_value name = blanchet@35961: case lookup name of blanchet@35968: SOME s => parse_bool_option option name s blanchet@35961: | NONE => default_value blanchet@35961: val lookup_bool = the o general_lookup_bool false (SOME false) blanchet@35961: fun lookup_time name = blanchet@39564: case lookup name of blanchet@39564: SOME s => parse_time_option name s blanchet@39564: | NONE => NONE blanchet@35964: fun lookup_int name = blanchet@35961: case lookup name of blanchet@35964: NONE => 0 blanchet@35964: | SOME s => case Int.fromString s of blanchet@35964: SOME n => n blanchet@35964: | NONE => error ("Parameter " ^ quote name ^ blanchet@35964: " must be assigned an integer value.") blanchet@40584: fun lookup_real_pair name = blanchet@38984: case lookup name of blanchet@40584: NONE => (0.0, 0.0) blanchet@40584: | SOME s => case s |> space_explode " " |> map Real.fromString of blanchet@40584: [SOME r1, SOME r2] => (r1, r2) blanchet@38984: | _ => error ("Parameter " ^ quote name ^ blanchet@40584: "must be assigned a pair of floating-point \ blanchet@40584: \values (e.g., \"0.6 0.95\")") blanchet@43905: fun lookup_option lookup' name = blanchet@38812: case lookup name of blanchet@38812: SOME "smart" => NONE blanchet@43905: | _ => SOME (lookup' name) blanchet@43862: val debug = mode <> Auto_Try andalso lookup_bool "debug" blanchet@43862: val verbose = debug orelse (mode <> Auto_Try andalso lookup_bool "verbose") blanchet@36141: val overlord = lookup_bool "overlord" blanchet@43836: val blocking = blanchet@43862: Isabelle_Process.is_active () orelse mode <> Normal orelse debug orelse blanchet@43836: lookup_bool "blocking" blanchet@40240: val provers = lookup_string "provers" |> space_explode " " blanchet@43862: |> mode = Auto_Try ? single o hd blanchet@44493: val type_enc = blanchet@43862: if mode = Auto_Try then blanchet@44431: NONE blanchet@44493: else case lookup_string "type_enc" of blanchet@44431: "smart" => NONE blanchet@47129: | s => (type_enc_from_string Strict s; SOME s) blanchet@47129: val strict = mode = Auto_Try orelse lookup_bool "strict" blanchet@46391: val lam_trans = lookup_option lookup_string "lam_trans" blanchet@43051: val relevance_thresholds = lookup_real_pair "relevance_thresholds" blanchet@43905: val max_relevant = lookup_option lookup_int "max_relevant" blanchet@43589: val max_mono_iters = lookup_int "max_mono_iters" blanchet@43605: val max_new_mono_instances = lookup_int "max_new_mono_instances" blanchet@35961: val isar_proof = lookup_bool "isar_proof" blanchet@36916: val isar_shrink_factor = Int.max (1, lookup_int "isar_shrink_factor") blanchet@46577: val slice = mode <> Auto_Try andalso lookup_bool "slice" blanchet@46578: val minimize = blanchet@46578: if mode = Auto_Try then NONE else lookup_option lookup_bool "minimize" blanchet@43862: val timeout = blanchet@43862: (if mode = Auto_Try then NONE else lookup_time "timeout") |> the_timeout blanchet@43856: val preplay_timeout = blanchet@43862: if mode = Auto_Try then Time.zeroTime blanchet@43856: else lookup_time "preplay_timeout" |> the_timeout blanchet@39229: val expect = lookup_string "expect" blanchet@35961: in blanchet@41456: {debug = debug, verbose = verbose, overlord = overlord, blocking = blocking, blanchet@47129: provers = provers, type_enc = type_enc, strict = strict, blanchet@46385: lam_trans = lam_trans, relevance_thresholds = relevance_thresholds, blanchet@43589: max_relevant = max_relevant, max_mono_iters = max_mono_iters, blanchet@46385: max_new_mono_instances = max_new_mono_instances, isar_proof = isar_proof, blanchet@46578: isar_shrink_factor = isar_shrink_factor, slice = slice, blanchet@46578: minimize = minimize, timeout = timeout, preplay_timeout = preplay_timeout, blanchet@46578: expect = expect} blanchet@35961: end blanchet@35961: blanchet@45591: fun get_params mode = extract_params mode o default_raw_params blanchet@43862: fun default_params thy = get_params Normal thy o map (apsnd single) blanchet@35866: blanchet@36373: (* Sledgehammer the given subgoal *) blanchet@36373: blanchet@46390: val default_minimize_prover = metisN blanchet@43892: blanchet@45591: fun is_raw_param_relevant_for_minimize (name, _) = blanchet@45591: member (op =) params_for_minimize name blanchet@36281: fun string_for_raw_param (key, values) = blanchet@43647: key ^ (case implode_param values of "" => "" | value => " = " ^ value) blanchet@36281: blanchet@46391: fun minimize_command override_params i more_override_params prover_name blanchet@46391: fact_names = blanchet@43898: let blanchet@43898: val params = blanchet@46391: (override_params blanchet@46391: |> filter_out (AList.defined (op =) more_override_params o fst)) @ blanchet@46391: more_override_params blanchet@43898: |> filter is_raw_param_relevant_for_minimize blanchet@43898: |> map string_for_raw_param blanchet@43898: |> (if prover_name = default_minimize_prover then I else cons prover_name) blanchet@43898: |> space_implode ", " blanchet@43898: in blanchet@43898: sledgehammerN ^ " " ^ minN ^ blanchet@43898: (if params = "" then "" else enclose " [" "]" params) ^ blanchet@43898: " (" ^ space_implode " " fact_names ^ ")" ^ blanchet@43898: (if i = 1 then "" else " " ^ string_of_int i) blanchet@43898: end blanchet@36281: blanchet@35964: fun hammer_away override_params subcommand opt_i relevance_override state = blanchet@35961: let blanchet@40250: val ctxt = Proof.context_of state blanchet@45591: val override_params = override_params |> map (normalize_raw_param ctxt) blanchet@35963: in blanchet@35963: if subcommand = runN then blanchet@36281: let val i = the_default 1 opt_i in blanchet@43862: run_sledgehammer (get_params Normal ctxt override_params) Normal i blanchet@39564: relevance_override (minimize_command override_params i) blanchet@39564: state blanchet@39564: |> K () blanchet@36281: end blanchet@43849: else if subcommand = minN then blanchet@43892: run_minimize (get_params Minimize ctxt blanchet@43892: (("provers", [default_minimize_prover]) :: blanchet@43892: override_params)) blanchet@43862: (the_default 1 opt_i) (#add relevance_override) state blanchet@35963: else if subcommand = messagesN then blanchet@35963: messages opt_i blanchet@42591: else if subcommand = supported_proversN then blanchet@42591: supported_provers ctxt blanchet@40240: else if subcommand = running_proversN then blanchet@40240: running_provers () blanchet@40240: else if subcommand = kill_proversN then blanchet@40240: kill_provers () blanchet@35963: else if subcommand = refresh_tptpN then blanchet@35963: refresh_systems_on_tptp () blanchet@35963: else blanchet@35963: error ("Unknown subcommand: " ^ quote subcommand ^ ".") blanchet@35963: end blanchet@35961: blanchet@35964: fun sledgehammer_trans (((subcommand, params), relevance_override), opt_i) = blanchet@35964: Toplevel.keep (hammer_away params subcommand opt_i relevance_override blanchet@35964: o Toplevel.proof_of) blanchet@35961: blanchet@43647: fun string_for_raw_param (name, value) = name ^ " = " ^ implode_param value blanchet@35961: blanchet@35963: fun sledgehammer_params_trans params = blanchet@35961: Toplevel.theory blanchet@35963: (fold set_default_raw_param params blanchet@39564: #> tap (fn thy => wenzelm@43232: let val ctxt = Proof_Context.init_global thy in blanchet@40250: writeln ("Default parameters for Sledgehammer:\n" ^ blanchet@40250: (case default_raw_params ctxt |> rev of blanchet@40250: [] => "none" blanchet@40250: | params => blanchet@45591: params |> map string_for_raw_param blanchet@41504: |> sort_strings |> cat_lines)) blanchet@40250: end)) blanchet@35961: blanchet@45639: val parse_query_bang = Parse.$$$ "?" || Parse.$$$ "!" || Parse.$$$ "!!" blanchet@43647: val parse_key = blanchet@45639: Scan.repeat1 (Parse.typ_group || parse_query_bang) >> implode_param blanchet@43452: val parse_value = blanchet@45639: Scan.repeat1 (Parse.xname || Parse.float_number || parse_query_bang) wenzelm@36970: val parse_param = parse_key -- Scan.optional (Parse.$$$ "=" |-- parse_value) [] wenzelm@36970: val parse_params = Scan.optional (Args.bracks (Parse.list parse_param)) [] blanchet@35963: val parse_fact_refs = blanchet@39240: Scan.repeat1 (Scan.unless (Parse.name -- Args.colon) Parse_Spec.xthm) blanchet@35964: val parse_relevance_chunk = blanchet@39564: (Args.add |-- Args.colon |-- parse_fact_refs >> add_relevance_override) blanchet@39564: || (Args.del |-- Args.colon |-- parse_fact_refs >> del_relevance_override) blanchet@36188: || (parse_fact_refs >> only_relevance_override) blanchet@35964: val parse_relevance_override = blanchet@36188: Scan.optional (Args.parens (Scan.repeat parse_relevance_chunk blanchet@36188: >> merge_relevance_overrides)) blanchet@39564: no_relevance_override blanchet@35961: val parse_sledgehammer_command = blanchet@37374: (Scan.optional Parse.short_ident runN -- parse_params blanchet@37374: -- parse_relevance_override -- Scan.option Parse.nat) #>> sledgehammer_trans blanchet@35961: val parse_sledgehammer_params_command = blanchet@35961: parse_params #>> sledgehammer_params_trans blanchet@35961: blanchet@35961: val _ = wenzelm@36970: Outer_Syntax.improper_command sledgehammerN wenzelm@36970: "search for first-order proof using automatic theorem provers" Keyword.diag blanchet@36394: parse_sledgehammer_command blanchet@35961: val _ = wenzelm@36970: Outer_Syntax.command sledgehammer_paramsN wenzelm@36970: "set and display the default parameters for Sledgehammer" Keyword.thy_decl blanchet@36394: parse_sledgehammer_params_command blanchet@36394: blanchet@43861: fun try_sledgehammer auto state = blanchet@43861: let blanchet@43861: val ctxt = Proof.context_of state blanchet@43862: val mode = if auto then Auto_Try else Try blanchet@43861: val i = 1 blanchet@43861: in blanchet@43862: run_sledgehammer (get_params mode ctxt []) mode i no_relevance_override blanchet@43861: (minimize_command [] i) state blanchet@41175: end blanchet@39564: blanchet@43865: val setup = Try.register_tool (sledgehammerN, (40, auto, try_sledgehammer)) blanchet@39564: blanchet@35866: end;