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; |