src/HOL/Tools/ATP_Manager/atp_minimal.ML
changeset 35867 16279c4c7a33
parent 35866 513074557e06
child 35969 c9565298df9e
equal deleted inserted replaced
35866:513074557e06 35867:16279c4c7a33
     1 (*  Title:      HOL/Tools/ATP_Manager/atp_minimal.ML
     1 (*  Title:      HOL/Tools/ATP_Manager/atp_minimal.ML
     2     Author:     Philipp Meyer, TU Muenchen
     2     Author:     Philipp Meyer, TU Muenchen
     3 
     3 
     4 Minimization of theorem list for metis by using an external automated theorem prover
     4 Minimization of theorem list for Metis using automatic theorem provers.
     5 *)
     5 *)
     6 
     6 
     7 signature ATP_MINIMAL =
     7 signature ATP_MINIMAL =
     8 sig
     8 sig
       
     9   type prover = ATP_Manager.prover
       
    10   type prover_result = ATP_Manager.prover_result
     9   type 'a minimize_fun = ('a list -> bool) -> 'a list -> 'a list
    11   type 'a minimize_fun = ('a list -> bool) -> 'a list -> 'a list
       
    12 
    10   val linear_minimize : 'a minimize_fun
    13   val linear_minimize : 'a minimize_fun
    11   val binary_minimize : 'a minimize_fun
    14   val binary_minimize : 'a minimize_fun
    12   val minimize_theorems :
    15   val minimize_theorems :
    13     (string * thm list) minimize_fun -> ATP_Wrapper.prover -> string -> int
    16     (string * thm list) minimize_fun -> prover -> string -> int
    14     -> Proof.state -> (string * thm list) list
    17     -> Proof.state -> (string * thm list) list
    15     -> (string * thm list) list option * string
    18     -> (string * thm list) list option * string
    16 end;
    19 end;
    17 
    20 
    18 structure ATP_Minimal : ATP_MINIMAL =
    21 structure ATP_Minimal : ATP_MINIMAL =
    19 struct
    22 struct
    20 
    23 
    21 open Sledgehammer_Fact_Preprocessor
    24 open Sledgehammer_Fact_Preprocessor
       
    25 open ATP_Manager
    22 
    26 
    23 type 'a minimize_fun = ('a list -> bool) -> 'a list -> 'a list
    27 type 'a minimize_fun = ('a list -> bool) -> 'a list -> 'a list
    24 
    28 
    25 (* Linear minimization algorithm *)
    29 (* Linear minimization algorithm *)
    26 
    30 
    85    ("Timeout", Timeout),
    89    ("Timeout", Timeout),
    86    ("time limit exceeded", Timeout),
    90    ("time limit exceeded", Timeout),
    87    ("# Cannot determine problem status within resource limit", Timeout),
    91    ("# Cannot determine problem status within resource limit", Timeout),
    88    ("Error", Error)]
    92    ("Error", Error)]
    89 
    93 
    90 fun produce_answer (result : ATP_Wrapper.prover_result) =
    94 fun produce_answer ({success, proof, internal_thm_names, filtered_clauses, ...}
    91   let
    95                     : prover_result) =
    92     val {success, proof = result_string, internal_thm_names = thm_name_vec,
    96   if success then
    93       filtered_clauses = filtered, ...} = result
    97     (Success (Vector.foldr (op ::) [] internal_thm_names, filtered_clauses),
    94   in
    98      proof)
    95     if success then
    99   else
    96       (Success (Vector.foldr (op ::) [] thm_name_vec, filtered), result_string)
   100     let
    97     else
   101       val failure = failure_strings |> get_first (fn (s, t) =>
    98       let
   102           if String.isSubstring s proof then SOME (t, proof) else NONE)
    99         val failure = failure_strings |> get_first (fn (s, t) =>
   103     in
   100             if String.isSubstring s result_string then SOME (t, result_string) else NONE)
   104       (case failure of
   101       in
   105         SOME res => res
   102         (case failure of
   106       | NONE => (Failure, proof))
   103           SOME res => res
   107     end
   104         | NONE => (Failure, result_string))
       
   105       end
       
   106   end
       
   107 
   108 
   108 
   109 
   109 (* wrapper for calling external prover *)
   110 (* wrapper for calling external prover *)
   110 
   111 
   111 fun sh_test_thms prover time_limit subgoalno state filtered name_thms_pairs =
   112 fun sledgehammer_test_theorems prover time_limit subgoalno state filtered
       
   113                                name_thms_pairs =
   112   let
   114   let
   113     val _ = priority ("Testing " ^ string_of_int (length name_thms_pairs) ^ " theorems... ")
   115     val _ = priority ("Testing " ^ string_of_int (length name_thms_pairs) ^
       
   116                       " theorems... ")
   114     val name_thm_pairs = maps (fn (n, ths) => map (pair n) ths) name_thms_pairs
   117     val name_thm_pairs = maps (fn (n, ths) => map (pair n) ths) name_thms_pairs
   115     val axclauses = cnf_rules_pairs (Proof.theory_of state) name_thm_pairs
   118     val axclauses = cnf_rules_pairs (Proof.theory_of state) name_thm_pairs
   116     val {context = ctxt, facts, goal} = Proof.goal state
   119     val {context = ctxt, facts, goal} = Proof.goal state
   117     val problem =
   120     val problem =
   118      {with_full_types = ! ATP_Manager.full_types,
   121      {with_full_types = ! ATP_Manager.full_types,
   120       goal = (ctxt, (facts, goal)),
   123       goal = (ctxt, (facts, goal)),
   121       axiom_clauses = SOME axclauses,
   124       axiom_clauses = SOME axclauses,
   122       filtered_clauses = filtered}
   125       filtered_clauses = filtered}
   123     val (result, proof) = produce_answer (prover time_limit problem)
   126     val (result, proof) = produce_answer (prover time_limit problem)
   124     val _ = priority (string_of_result result)
   127     val _ = priority (string_of_result result)
   125   in
   128   in (result, proof) end
   126     (result, proof)
       
   127   end
       
   128 
   129 
   129 
   130 
   130 (* minimalization of thms *)
   131 (* minimalization of thms *)
   131 
   132 
   132 fun minimize_theorems gen_min prover prover_name time_limit state
   133 fun minimize_theorems gen_min prover prover_name time_limit state
   134   let
   135   let
   135     val _ =
   136     val _ =
   136       priority ("Minimize called with " ^ string_of_int (length name_thms_pairs) ^
   137       priority ("Minimize called with " ^ string_of_int (length name_thms_pairs) ^
   137         " theorems, prover: " ^ prover_name ^
   138         " theorems, prover: " ^ prover_name ^
   138         ", time limit: " ^ string_of_int time_limit ^ " seconds")
   139         ", time limit: " ^ string_of_int time_limit ^ " seconds")
   139     val test_thms_fun = sh_test_thms prover time_limit 1 state
   140     val test_thms_fun = sledgehammer_test_theorems prover time_limit 1 state
   140     fun test_thms filtered thms =
   141     fun test_thms filtered thms =
   141       case test_thms_fun filtered thms of (Success _, _) => true | _ => false
   142       case test_thms_fun filtered thms of (Success _, _) => true | _ => false
   142   in
   143   in
   143     (* try prove first to check result and get used theorems *)
   144     (* try prove first to check result and get used theorems *)
   144     (case test_thms_fun NONE name_thms_pairs of
   145     (case test_thms_fun NONE name_thms_pairs of