4 |
4 |
5 chapter \<open>Experimental commands \<^text>\<open>sketch\<close> and \<^text>\<open>explore\<close>\<close> |
5 chapter \<open>Experimental commands \<^text>\<open>sketch\<close> and \<^text>\<open>explore\<close>\<close> |
6 |
6 |
7 theory Sketch_and_Explore |
7 theory Sketch_and_Explore |
8 imports Main \<comment> \<open>TODO: generalize existing sledgehammer functions to Pure\<close> |
8 imports Main \<comment> \<open>TODO: generalize existing sledgehammer functions to Pure\<close> |
9 keywords "sketch" "explore" :: diag |
9 keywords "sketch" "nxsketch" "explore" :: diag |
10 begin |
10 begin |
11 |
11 |
12 ML \<open> |
12 ML \<open> |
13 fun split_clause t = |
13 fun split_clause t = |
14 let |
14 let |
61 [prefix ^ " " ^ (if is_none if_s then "" else "using that ") ^ "sorry"]); |
61 [prefix ^ " " ^ (if is_none if_s then "" else "using that ") ^ "sorry"]); |
62 in |
62 in |
63 s |
63 s |
64 end; |
64 end; |
65 |
65 |
66 fun print_sketch ctxt method_text clauses = |
66 fun print_nonext_sketch ctxt method_text clauses = |
67 "proof" ^ method_text :: map (print_isar_skeleton ctxt 2 "show") clauses @ ["qed"]; |
67 "proof" ^ method_text :: map (print_isar_skeleton ctxt 2 "show") clauses @ ["qed"]; |
|
68 |
|
69 fun print_next_skeleton ctxt indent keyword stmt = |
|
70 let |
|
71 val ((fixes, assms, concl), ctxt') = eigen_context_for_statement stmt ctxt; |
|
72 val prefix = replicate_string indent " "; |
|
73 val prefix_sep = "\n" ^ prefix ^ " and "; |
|
74 val show_s = prefix ^ keyword ^ " " ^ print_term ctxt' concl; |
|
75 val assumes_s = if null assms then NONE |
|
76 else SOME (prefix ^ " assume " ^ space_implode prefix_sep |
|
77 (map (print_term ctxt') assms)); |
|
78 val fixes_s = if null fixes then NONE |
|
79 else SOME (prefix ^ "fix " ^ space_implode prefix_sep |
|
80 (map (fn (v, T) => v ^ " :: " ^ print_typ ctxt T) fixes)); |
|
81 val s = cat_lines (map_filter I [fixes_s, assumes_s] @ [show_s] @ [prefix ^ " sorry"]); |
|
82 in |
|
83 s |
|
84 end; |
|
85 |
|
86 fun print_next_sketch ctxt method_text clauses = |
|
87 "proof" ^ method_text :: separate "next" (map (print_next_skeleton ctxt 2 "show") clauses) @ ["qed"]; |
|
88 |
|
89 fun print_sketch ctxt method_text [cl] = print_next_sketch ctxt method_text [cl] |
|
90 | print_sketch ctxt method_text clauses = print_nonext_sketch ctxt method_text clauses; |
68 |
91 |
69 fun print_exploration ctxt method_text [clause] = |
92 fun print_exploration ctxt method_text [clause] = |
70 ["proof -", print_isar_skeleton ctxt 2 "have" clause, |
93 ["proof -", print_isar_skeleton ctxt 2 "have" clause, |
71 " then show ?thesis", " by" ^ method_text, "qed"] |
94 " then show ?thesis", " by" ^ method_text, "qed"] |
72 | print_exploration ctxt method_text (clause :: clauses) = |
95 | print_exploration ctxt method_text (clause :: clauses) = |
108 (state |> tap (fn _ => Output.information message)) |
131 (state |> tap (fn _ => Output.information message)) |
109 end |
132 end |
110 |
133 |
111 val sketch = print_proof_text_from_state print_sketch; |
134 val sketch = print_proof_text_from_state print_sketch; |
112 |
135 |
|
136 val next_sketch = print_proof_text_from_state print_next_sketch; |
|
137 |
113 fun explore method_ref = print_proof_text_from_state print_exploration (SOME method_ref); |
138 fun explore method_ref = print_proof_text_from_state print_exploration (SOME method_ref); |
114 |
139 |
115 fun sketch_cmd some_method_text = |
140 fun sketch_cmd some_method_text = |
116 Toplevel.keep_proof (K () o sketch some_method_text o Toplevel.proof_of) |
141 Toplevel.keep_proof (K () o sketch some_method_text o Toplevel.proof_of) |
|
142 |
|
143 fun next_sketch_cmd some_method_text = |
|
144 Toplevel.keep_proof (K () o next_sketch some_method_text o Toplevel.proof_of) |
117 |
145 |
118 fun explore_cmd method_text = |
146 fun explore_cmd method_text = |
119 Toplevel.keep_proof (K () o explore method_text o Toplevel.proof_of) |
147 Toplevel.keep_proof (K () o explore method_text o Toplevel.proof_of) |
120 |
148 |
121 val _ = |
149 val _ = |
122 Outer_Syntax.command \<^command_keyword>\<open>sketch\<close> |
150 Outer_Syntax.command \<^command_keyword>\<open>sketch\<close> |
123 "print sketch of Isar proof text after method application" |
151 "print sketch of Isar proof text after method application" |
124 (Scan.option (Scan.trace Method.parse) >> sketch_cmd); |
152 (Scan.option (Scan.trace Method.parse) >> sketch_cmd); |
125 |
153 |
126 val _ = |
154 val _ = |
|
155 Outer_Syntax.command \<^command_keyword>\<open>nxsketch\<close> |
|
156 "print sketch of Isar proof text after method application" |
|
157 (Scan.option (Scan.trace Method.parse) >> next_sketch_cmd); |
|
158 |
|
159 val _ = |
127 Outer_Syntax.command \<^command_keyword>\<open>explore\<close> |
160 Outer_Syntax.command \<^command_keyword>\<open>explore\<close> |
128 "explore proof obligations after method application as Isar proof text" |
161 "explore proof obligations after method application as Isar proof text" |
129 (Scan.trace Method.parse >> explore_cmd); |
162 (Scan.trace Method.parse >> explore_cmd); |
130 \<close> |
163 \<close> |
131 |
164 |