lh-l4v/lib/Try_Methods.thy

121 lines
3.7 KiB
Plaintext

(*
* Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
*
* SPDX-License-Identifier: BSD-2-Clause
*)
theory Try_Methods
imports Eisbach_Tools.Eisbach_Methods
keywords "trym" :: diag
and "add_try_method" :: thy_decl
begin
text \<open>
A collection of methods that can be "tried" against subgoals (similar
to try, try0 etc). It is easy to add new methods with "add_try_method",
although the parser currently supports only single names.
Particular subgoals can be tried with "trym 1" etc. By default all
subgoals are attempted unless they are coupled to others by shared
schematic variables.
\<close>
ML \<open>
structure Try_Methods = struct
structure Methods = Theory_Data
(
type T = Symtab.set;
val empty = Symtab.empty;
val merge = Symtab.merge (K true);
);
val get_methods_global = Methods.get #> Symtab.keys
val add_method = Methods.map o Symtab.insert_set
(* borrowed from try0 implementation (of course) *)
fun parse_method_name keywords =
enclose "(" ")"
#> Token.explode keywords Position.start
#> filter Token.is_proper
#> Scan.read Token.stopper Method.parse
#> (fn SOME (Method.Source src, _) => src | _ => raise Fail "expected Source");
fun mk_method ctxt = parse_method_name (Thy_Header.get_keywords' ctxt)
#> Method.method_cmd ctxt
#> Method.Basic
fun get_methods ctxt = get_methods_global (Proof_Context.theory_of ctxt)
|> map (mk_method ctxt)
fun try_one_method m ctxt n goal
= can (Timeout.apply (Time.fromSeconds 5)
(Goal.restrict n 1 #> NO_CONTEXT_TACTIC ctxt
(Method.evaluate_runtime m ctxt [])
#> Seq.hd
)) goal
fun msg m_nm n = writeln ("method " ^ m_nm ^ " succceeded on goal " ^ string_of_int n)
fun times xs ys = maps (fn x => map (pair x) ys) xs
fun independent_subgoals goal verbose = let
fun get_vars t = Term.fold_aterms
(fn (Var v) => Termtab.insert_set (Var v) | _ => I)
t Termtab.empty
val goals = Thm.prems_of goal
val goal_vars = map get_vars goals
val count_vars = fold (fn t1 => fn t2 => Termtab.join (K (op +))
(Termtab.map (K (K 1)) t1, t2)) goal_vars Termtab.empty
val indep_vars = Termtab.forall (fst #> Termtab.lookup count_vars
#> (fn n => n = SOME 1))
val indep = (1 upto Thm.nprems_of goal) ~~ map indep_vars goal_vars
val _ = app (fst #> string_of_int
#> prefix "ignoring non-independent goal " #> warning)
(filter (fn x => verbose andalso not (snd x)) indep)
in indep |> filter snd |> map fst end
fun try_methods opt_n ctxt goal = let
val ms = get_methods_global (Proof_Context.theory_of ctxt)
~~ get_methods ctxt
val ns = case opt_n of
NONE => independent_subgoals goal true
| SOME n => [n]
fun apply ((m_nm, m), n) = if try_one_method m ctxt n goal
then (msg m_nm n; SOME (m_nm, n)) else NONE
val results = Par_List.map apply (times ms ns)
in map_filter I results end
fun try_methods_command opt_n st = let
val ctxt = #context (Proof.goal st)
|> Try0.silence_methods false
val goal = #goal (Proof.goal st)
in try_methods opt_n ctxt goal; () end
val _ = Outer_Syntax.command @{command_keyword trym}
"try methods from a library of specialised strategies"
(Scan.option Parse.int >> (fn opt_n =>
Toplevel.keep_proof (try_methods_command opt_n o Toplevel.proof_of)))
fun local_check_add_method nm ctxt =
(mk_method ctxt nm; Local_Theory.background_theory (add_method nm) ctxt)
val _ = Outer_Syntax.command @{command_keyword add_try_method}
"add a method to a library of strategies tried by trym"
(Parse.name >> (Toplevel.local_theory NONE NONE o local_check_add_method))
end
\<close>
add_try_method fastforce
add_try_method blast
add_try_method metis
method auto_metis = solves \<open>auto; metis\<close>
add_try_method auto_metis
end