src/HOL/Tools/Sledgehammer/sledgehammer.ML
changeset 38455 131f7c46cf2c
parent 38290 581a402a80f0
child 38515 32391240695f
equal deleted inserted replaced
38454:9043eefe8d71 38455:131f7c46cf2c
   204     (conjecture_shape, thm_names)
   204     (conjecture_shape, thm_names)
   205 
   205 
   206 
   206 
   207 (* generic TPTP-based provers *)
   207 (* generic TPTP-based provers *)
   208 
   208 
   209 fun prover_fun name
   209 fun prover_fun atp_name
   210         {exec, required_execs, arguments, proof_delims, known_failures,
   210         {exec, required_execs, arguments, proof_delims, known_failures,
   211          max_new_relevant_facts_per_iter, prefers_theory_relevant,
   211          max_new_relevant_facts_per_iter, prefers_theory_relevant,
   212          explicit_forall}
   212          explicit_forall}
   213         ({debug, overlord, full_types, explicit_apply, relevance_threshold,
   213         ({debug, verbose, overlord, full_types, explicit_apply,
   214           relevance_convergence, theory_relevant, defs_relevant, isar_proof,
   214           relevance_threshold, relevance_convergence, theory_relevant,
   215           isar_shrink_factor, timeout, ...} : params)
   215           defs_relevant, isar_proof, isar_shrink_factor, timeout, ...} : params)
   216         minimize_command
   216         minimize_command
   217         ({subgoal, goal, relevance_override, axioms} : problem) =
   217         ({subgoal, goal, relevance_override, axioms} : problem) =
   218   let
   218   let
   219     val (ctxt, (_, th)) = goal;
   219     val (ctxt, (_, th)) = goal;
   220     val thy = ProofContext.theory_of ctxt
   220     val thy = ProofContext.theory_of ctxt
   221     val (params, hyp_ts, concl_t) = strip_subgoal th subgoal
   221     val (params, hyp_ts, concl_t) = strip_subgoal th subgoal
       
   222 
       
   223     fun print s = (priority s; if debug then tracing s else ())
       
   224     fun print_v f = () |> verbose ? print o f
       
   225     fun print_d f = () |> debug ? print o f
       
   226 
   222     val the_axioms =
   227     val the_axioms =
   223       case axioms of
   228       case axioms of
   224         SOME axioms => axioms
   229         SOME axioms => axioms
   225       | NONE => relevant_facts full_types relevance_threshold
   230       | NONE =>
   226                     relevance_convergence defs_relevant
   231         (print_d (fn () => "Selecting relevant facts for " ^ quote atp_name ^
   227                     max_new_relevant_facts_per_iter
   232                            ".");
   228                     (the_default prefers_theory_relevant theory_relevant)
   233          relevant_facts full_types relevance_threshold relevance_convergence
   229                     relevance_override goal hyp_ts concl_t
   234                         defs_relevant max_new_relevant_facts_per_iter
       
   235                         (the_default prefers_theory_relevant theory_relevant)
       
   236                         relevance_override goal hyp_ts concl_t
       
   237          |> tap ((fn n => print_v (fn () =>
       
   238                       "Selected " ^ string_of_int n ^ " fact" ^ plural_s n ^
       
   239                       " for " ^ quote atp_name ^ ".")) o length))
   230 
   240 
   231     (* path to unique problem file *)
   241     (* path to unique problem file *)
   232     val the_dest_dir = if overlord then getenv "ISABELLE_HOME_USER"
   242     val the_dest_dir = if overlord then getenv "ISABELLE_HOME_USER"
   233                        else Config.get ctxt dest_dir;
   243                        else Config.get ctxt dest_dir;
   234     val the_problem_prefix = Config.get ctxt problem_prefix;
   244     val the_problem_prefix = Config.get ctxt problem_prefix;
   235     fun prob_pathname nr =
   245     fun prob_pathname nr =
   236       let
   246       let
   237         val probfile =
   247         val probfile =
   238           Path.basic ((if overlord then "prob_" ^ name
   248           Path.basic ((if overlord then "prob_" ^ atp_name
   239                        else the_problem_prefix ^ serial_string ())
   249                        else the_problem_prefix ^ serial_string ())
   240                       ^ "_" ^ string_of_int nr)
   250                       ^ "_" ^ string_of_int nr)
   241       in
   251       in
   242         if the_dest_dir = "" then File.tmp_path probfile
   252         if the_dest_dir = "" then File.tmp_path probfile
   243         else if File.exists (Path.explode the_dest_dir)
   253         else if File.exists (Path.explode the_dest_dir)
   288                        else rpair 0)
   298                        else rpair 0)
   289                 val (proof, outcome) =
   299                 val (proof, outcome) =
   290                   extract_proof_and_outcome complete res_code proof_delims
   300                   extract_proof_and_outcome complete res_code proof_delims
   291                                             known_failures output
   301                                             known_failures output
   292               in (output, msecs, proof, outcome) end
   302               in (output, msecs, proof, outcome) end
       
   303             val _ = print_d (fn () => "Preparing problem for " ^
       
   304                                       quote atp_name ^ "...")
   293             val readable_names = debug andalso overlord
   305             val readable_names = debug andalso overlord
   294             val (problem, pool, conjecture_offset, axiom_names) =
   306             val (problem, pool, conjecture_offset, axiom_names) =
   295               prepare_problem ctxt readable_names explicit_forall full_types
   307               prepare_problem ctxt readable_names explicit_forall full_types
   296                               explicit_apply hyp_ts concl_t the_axioms
   308                               explicit_apply hyp_ts concl_t the_axioms
   297             val _ = File.write_list probfile (strings_for_tptp_problem problem)
   309             val _ = File.write_list probfile (strings_for_tptp_problem problem)
   298             val conjecture_shape =
   310             val conjecture_shape =
   299               conjecture_offset + 1 upto conjecture_offset + length hyp_ts + 1
   311               conjecture_offset + 1 upto conjecture_offset + length hyp_ts + 1
   300               |> map single
   312               |> map single
       
   313             val _ = print_d (fn () => "Running " ^ quote atp_name ^ "...")
   301             val result =
   314             val result =
   302               do_run false
   315               do_run false
   303               |> (fn (_, msecs0, _, SOME _) =>
   316               |> (fn (_, msecs0, _, SOME _) =>
   304                      do_run true
   317                      do_run true
   305                      |> (fn (output, msecs, proof, outcome) =>
   318                      |> (fn (output, msecs, proof, outcome) =>
   341   end
   354   end
   342 
   355 
   343 fun get_prover_fun thy name = prover_fun name (get_prover thy name)
   356 fun get_prover_fun thy name = prover_fun name (get_prover thy name)
   344 
   357 
   345 fun start_prover_thread (params as {verbose, full_types, timeout, ...}) i n
   358 fun start_prover_thread (params as {verbose, full_types, timeout, ...}) i n
   346                         relevance_override minimize_command proof_state name =
   359                         relevance_override minimize_command proof_state
       
   360                         atp_name =
   347   let
   361   let
   348     val thy = Proof.theory_of proof_state
   362     val thy = Proof.theory_of proof_state
   349     val birth_time = Time.now ()
   363     val birth_time = Time.now ()
   350     val death_time = Time.+ (birth_time, timeout)
   364     val death_time = Time.+ (birth_time, timeout)
   351     val prover = get_prover_fun thy name
   365     val prover = get_prover_fun thy atp_name
   352     val {context = ctxt, facts, goal} = Proof.goal proof_state;
   366     val {context = ctxt, facts, goal} = Proof.goal proof_state;
   353     val desc =
   367     val desc =
   354       "ATP " ^ quote name ^ " for subgoal " ^ string_of_int i ^ ":\n" ^
   368       "ATP " ^ quote atp_name ^ " for subgoal " ^ string_of_int i ^ ":\n" ^
   355       Syntax.string_of_term ctxt (Thm.term_of (Thm.cprem_of goal i));
   369       Syntax.string_of_term ctxt (Thm.term_of (Thm.cprem_of goal i));
   356   in
   370   in
   357     Async_Manager.launch das_Tool verbose birth_time death_time desc
   371     Async_Manager.launch das_Tool verbose birth_time death_time desc
   358         (fn () =>
   372         (fn () =>
   359             let
   373             let
   360               val problem =
   374               val problem =
   361                 {subgoal = i, goal = (ctxt, (facts, goal)),
   375                 {subgoal = i, goal = (ctxt, (facts, goal)),
   362                  relevance_override = relevance_override, axioms = NONE}
   376                  relevance_override = relevance_override, axioms = NONE}
   363             in
   377             in
   364               prover params (minimize_command name) problem |> #message
   378               prover params (minimize_command atp_name) problem |> #message
   365               handle ERROR message => "Error: " ^ message ^ "\n"
   379               handle ERROR message => "Error: " ^ message ^ "\n"
   366                    | exn => "Internal error: \n" ^ ML_Compiler.exn_message exn ^
   380                    | exn => "Internal error: \n" ^ ML_Compiler.exn_message exn ^
   367                             "\n"
   381                             "\n"
   368             end)
   382             end)
   369   end
   383   end