src/HOL/Tools/try0.ML
changeset 81363 fec95447c5bd
parent 81362 f586fdabe670
child 81364 84e4388f8ab1
equal deleted inserted replaced
81362:f586fdabe670 81363:fec95447c5bd
     7 signature TRY0 =
     7 signature TRY0 =
     8 sig
     8 sig
     9   val noneN : string
     9   val noneN : string
    10   val silence_methods : bool -> Proof.context -> Proof.context
    10   val silence_methods : bool -> Proof.context -> Proof.context
    11   type result = {name: string, command: string, time: int, state: Proof.state}
    11   type result = {name: string, command: string, time: int, state: Proof.state}
    12   val try0 : Time.time option -> string list * string list * string list * string list ->
    12   val try0 : Time.time option -> (string * string list) list -> Proof.state -> result list
    13     Proof.state -> result list
       
    14 end;
    13 end;
    15 
    14 
    16 structure Try0 : TRY0 =
    15 structure Try0 : TRY0 =
    17 struct
    16 struct
    18 
    17 
    41   |> Token.explode (Thy_Header.get_keywords' ctxt) Position.start
    40   |> Token.explode (Thy_Header.get_keywords' ctxt) Position.start
    42   |> filter Token.is_proper
    41   |> filter Token.is_proper
    43   |> Scan.read Token.stopper Method.parse
    42   |> Scan.read Token.stopper Method.parse
    44   |> (fn SOME (Method.Source src, _) => src | _ => raise Fail "expected Source");
    43   |> (fn SOME (Method.Source src, _) => src | _ => raise Fail "expected Source");
    45 
    44 
    46 fun add_attr_text (NONE, _) s = s
    45 fun add_attr_text _ (NONE, _) s = s
    47   | add_attr_text (_, []) s = s
    46   | add_attr_text tagged (SOME y, x) s =
    48   | add_attr_text (SOME x, fs) s =
    47     let val fs = tagged |> filter (fn (_, xs) => member (op =) xs x) |> map fst
    49     s ^ " " ^ (if x = "" then "" else x ^ ": ") ^ implode_space fs;
    48     in if null fs then s else s ^ " " ^ (if y = "" then "" else y ^ ": ") ^ implode_space fs end
    50 
    49 
    51 fun attrs_text (sx, ix, ex, dx) (ss, is, es, ds) =
    50 fun attrs_text (sx, ix, ex, dx) tagged =
    52   "" |> fold add_attr_text [(sx, ss), (ix, is), (ex, es), (dx, ds)];
    51   "" |> fold (add_attr_text tagged) [(sx, "simp"), (ix, "intro"), (ex, "elim"), (dx, "dest")];
    53 
    52 
    54 type result = {name: string, command: string, time: int, state: Proof.state}
    53 type result = {name: string, command: string, time: int, state: Proof.state}
    55 
    54 
    56 fun apply_named_method (name, ((all_goals, run_if_auto_try), attrs)) mode timeout_opt quad st =
    55 fun apply_named_method (name, ((all_goals, run_if_auto_try), attrs)) mode timeout_opt tagged st =
    57   if mode <> Auto_Try orelse run_if_auto_try then
    56   if mode <> Auto_Try orelse run_if_auto_try then
    58     let
    57     let
    59       val attrs = attrs_text attrs quad
    58       val attrs = attrs_text attrs tagged
    60       val ctxt = Proof.context_of st
    59       val ctxt = Proof.context_of st
    61 
    60 
    62       val apply = name ^ attrs
    61       val apply = name ^ attrs
    63       |> parse_method ctxt
    62       |> parse_method ctxt
    64       |> Method.method_cmd ctxt
    63       |> Method.method_cmd ctxt
   125       |> Proof_Context.background_theory (fn thy =>
   124       |> Proof_Context.background_theory (fn thy =>
   126           thy
   125           thy
   127           |> Context_Position.set_visible_global false
   126           |> Context_Position.set_visible_global false
   128           |> Config.put_global Unify.unify_trace false));
   127           |> Config.put_global Unify.unify_trace false));
   129 
   128 
   130 fun generic_try0 mode timeout_opt quad st =
   129 fun generic_try0 mode timeout_opt tagged st =
   131   let
   130   let
   132     val st = Proof.map_contexts (silence_methods false) st;
   131     val st = Proof.map_contexts (silence_methods false) st;
   133     fun try_method method = method mode timeout_opt quad st;
   132     fun try_method method = method mode timeout_opt tagged st;
   134     fun get_message {command, time, ...} = "Found proof: " ^ Active.sendback_markup_command
   133     fun get_message {command, time, ...} = "Found proof: " ^ Active.sendback_markup_command
   135       command ^ " (" ^ time_string time ^ ")";
   134       command ^ " (" ^ time_string time ^ ")";
   136     val print_step = Option.map (tap (writeln o get_message));
   135     val print_step = Option.map (tap (writeln o get_message));
   137     val get_results =
   136     val get_results =
   138       if mode = Normal
   137       if mode = Normal
   168       end)
   167       end)
   169   end;
   168   end;
   170 
   169 
   171 fun try0 timeout_opt = snd oo generic_try0 Normal timeout_opt;
   170 fun try0 timeout_opt = snd oo generic_try0 Normal timeout_opt;
   172 
   171 
   173 fun try0_trans quad =
   172 fun try0_trans tagged =
   174   Toplevel.keep_proof
   173   Toplevel.keep_proof
   175     (ignore o generic_try0 Normal (SOME default_timeout) quad o Toplevel.proof_of);
   174     (ignore o generic_try0 Normal (SOME default_timeout) tagged o Toplevel.proof_of);
   176 
       
   177 fun merge_attrs (s1, i1, e1, d1) (s2, i2, e2, d2) = (s1 @ s2, i1 @ i2, e1 @ e2, d1 @ d2);
       
   178 
   175 
   179 fun string_of_xthm (xref, args) =
   176 fun string_of_xthm (xref, args) =
   180   Facts.string_of_ref xref ^
   177   Facts.string_of_ref xref ^
   181   implode (map (enclose "[" "]" o Pretty.unformatted_string_of o Token.pretty_src \<^context>) args);
   178   implode (map (enclose "[" "]" o Pretty.unformatted_string_of o Token.pretty_src \<^context>) args);
   182 
   179 
   183 val parse_fact_refs =
   180 val parse_fact_refs =
   184   Scan.repeat1 (Scan.unless (Parse.name -- Args.colon) (Parse.thm >> string_of_xthm));
   181   Scan.repeat1 (Scan.unless (Parse.name -- Args.colon) (Parse.thm >> string_of_xthm));
   185 
   182 
   186 val parse_attr =
   183 val parse_attr =
   187   Args.$$$ "simp" |-- Args.colon |-- parse_fact_refs >> (fn ss => (ss, [], [], []))
   184   Args.$$$ "simp" |-- Args.colon |-- parse_fact_refs >> (map (rpair ["simp"]))
   188   || Args.$$$ "intro" |-- Args.colon |-- parse_fact_refs >> (fn is => ([], is, [], []))
   185   || Args.$$$ "intro" |-- Args.colon |-- parse_fact_refs >> (map (rpair ["intro"]))
   189   || Args.$$$ "elim" |-- Args.colon |-- parse_fact_refs >> (fn es => ([], [], es, []))
   186   || Args.$$$ "elim" |-- Args.colon |-- parse_fact_refs >> (map (rpair ["elim"]))
   190   || Args.$$$ "dest" |-- Args.colon |-- parse_fact_refs >> (fn ds => ([], [], [], ds));
   187   || Args.$$$ "dest" |-- Args.colon |-- parse_fact_refs >> (map (rpair ["dest"]));
   191 
   188 
   192 fun parse_attrs x =
   189 fun parse_attrs x =
   193   (Args.parens parse_attrs
   190   (Args.parens parse_attrs
   194    || Scan.repeat parse_attr >> (fn quad => fold merge_attrs quad ([], [], [], []))) x;
   191    || Scan.repeat parse_attr >> (fn tagged => fold (curry (op @)) tagged [])) x;
   195 
   192 
   196 val _ =
   193 val _ =
   197   Outer_Syntax.command \<^command_keyword>\<open>try0\<close> "try a combination of proof methods"
   194   Outer_Syntax.command \<^command_keyword>\<open>try0\<close> "try a combination of proof methods"
   198     (Scan.optional parse_attrs ([], [], [], []) #>> try0_trans);
   195     (Scan.optional parse_attrs [] #>> try0_trans);
   199 
   196 
   200 val _ =
   197 val _ =
   201   Try.tool_setup
   198   Try.tool_setup
   202    {name = "try0", weight = 30, auto_option = \<^system_option>\<open>auto_methods\<close>,
   199    {name = "try0", weight = 30, auto_option = \<^system_option>\<open>auto_methods\<close>,
   203     body = fn auto => fst o generic_try0 (if auto then Auto_Try else Try) NONE ([], [], [], [])};
   200     body = fn auto => fst o generic_try0 (if auto then Auto_Try else Try) NONE []};
   204 
   201 
   205 end;
   202 end;