33817
|
1 |
(* Title: find_theorems.ML
|
|
2 |
Author: Timothy Bourke, NICTA
|
|
3 |
|
|
4 |
Simple find_theorems server
|
|
5 |
*)
|
|
6 |
|
|
7 |
local
|
|
8 |
val default_limit = 20;
|
|
9 |
val thy_names = sort string_ord (ThyInfo.get_names ());
|
|
10 |
|
|
11 |
val find_theorems_url = "find_theorems";
|
|
12 |
|
|
13 |
fun is_sorry thm =
|
|
14 |
Thm.proof_of thm
|
|
15 |
|> Proofterm.approximate_proof_body
|
|
16 |
|> Proofterm.all_oracles_of
|
|
17 |
|> exists (fn (x, _) => x = "Pure.skip_proof");
|
|
18 |
|
|
19 |
local open Xhtml in
|
|
20 |
fun find_theorems_form thy_name (query, limit, withdups) =
|
|
21 |
let
|
|
22 |
val query_input =
|
|
23 |
input (id "query", {
|
|
24 |
name = "query",
|
|
25 |
itype = TextInput { value = query, maxlength = NONE }});
|
|
26 |
|
|
27 |
val max_results = divele noid
|
|
28 |
[
|
|
29 |
label (noid, { for = "limit" }, "Max. results:"),
|
|
30 |
input (id "limit",
|
|
31 |
{ name = "limit",
|
|
32 |
itype = TextInput { value = SOME (Int.toString limit),
|
|
33 |
maxlength = NONE }})
|
|
34 |
];
|
|
35 |
|
|
36 |
val theories = divele noid
|
|
37 |
[
|
|
38 |
label (noid, { for = "theory" }, "Search in:"),
|
|
39 |
select (id "theory", { name = "theory", value = SOME thy_name })
|
|
40 |
thy_names
|
|
41 |
];
|
|
42 |
|
|
43 |
val with_dups = divele noid
|
|
44 |
[
|
|
45 |
label (noid, { for = "withdups" }, "Allow duplicates:"),
|
|
46 |
input (id "withdups",
|
|
47 |
{ name = "withdups",
|
|
48 |
itype = Checkbox { checked = withdups, value = SOME "true" }})
|
|
49 |
];
|
|
50 |
|
|
51 |
val help = divele (class "help")
|
|
52 |
[ a { href="/pasting_help.html", text="(pasting from proof general)" } ];
|
|
53 |
in
|
|
54 |
form (id "findtheorems", { method = "post", action = "/isabelle/find_theorems" })
|
|
55 |
[tag "fieldset" []
|
|
56 |
[tag "legend" [] [text "find_theorems"],
|
|
57 |
(add_script (OnKeyPress, "encodequery(this)")
|
|
58 |
o add_script (OnChange, "encodequery(this)")
|
|
59 |
o add_script (OnMouseUp, "encodequery(this)")) query_input,
|
|
60 |
divele (class "settings") [ max_results, theories, with_dups, help ],
|
|
61 |
divele (class "mainbuttons")
|
|
62 |
[ reset_button (id "reset"), submit_button (id "submit") ]
|
|
63 |
]
|
|
64 |
]
|
|
65 |
end;
|
|
66 |
|
|
67 |
fun html_header thy_name args =
|
|
68 |
html { lang = "en" } [
|
|
69 |
head { title = "Find Theorems: results", stylesheet_href = "/basic.css" }
|
|
70 |
[script (noid, { script_type="text/javascript",
|
|
71 |
src="/find_theorems.js" })],
|
|
72 |
add_script (OnLoad, "encodequery(document.getElementById('query'))")
|
|
73 |
(body noid [
|
|
74 |
h (noid, 1, "Theory " ^ thy_name),
|
|
75 |
find_theorems_form thy_name args,
|
|
76 |
divele noid []
|
|
77 |
])
|
|
78 |
];
|
|
79 |
|
|
80 |
fun html_error msg = p ((class "error"), msg);
|
|
81 |
|
|
82 |
val find_theorems_table =
|
|
83 |
table (class "findtheorems")
|
|
84 |
[
|
|
85 |
thead noid [tr [th (noid, "name"), th (noid, "theorem")]],
|
|
86 |
tbody noid []
|
|
87 |
];
|
|
88 |
|
|
89 |
fun show_criterion (b, c) =
|
|
90 |
let
|
|
91 |
fun prfx s = let
|
|
92 |
val (c, v) = if b then ("criterion", s) else ("ncriterion", "-" ^ s);
|
|
93 |
in span (class c, v) end;
|
|
94 |
|
|
95 |
fun prfxwith s = let
|
|
96 |
val (c, v) =
|
|
97 |
if b
|
|
98 |
then ("criterion", "with " ^ s)
|
|
99 |
else ("ncriterion", "without " ^ s);
|
|
100 |
in span (class c, v) end;
|
|
101 |
in
|
|
102 |
(case c of
|
|
103 |
Find_Theorems.Name name => prfx ("name: " ^ quote name)
|
|
104 |
| Find_Theorems.Intro => prfx "intro"
|
|
105 |
| Find_Theorems.IntroIff => prfx "introiff"
|
|
106 |
| Find_Theorems.Elim => prfx "elim"
|
|
107 |
| Find_Theorems.Dest => prfx "dest"
|
|
108 |
| Find_Theorems.Solves => prfx "solves"
|
|
109 |
| Find_Theorems.Simp pat => prfx ("simp: \"" ^ pat ^ "\"")
|
|
110 |
| Find_Theorems.Pattern pat => prfx ("\"" ^ pat ^ "\""))
|
|
111 |
end;
|
|
112 |
|
|
113 |
fun find_theorems_summary (othmslen, thmslen, query, args) =
|
|
114 |
let
|
|
115 |
val args =
|
|
116 |
(case othmslen of
|
|
117 |
NONE => args
|
|
118 |
| SOME l => Symtab.update ("limit", Int.toString l) args)
|
|
119 |
val qargs = HttpUtil.make_query_string args;
|
|
120 |
|
|
121 |
val num_found_text =
|
|
122 |
(case othmslen of
|
|
123 |
NONE => text (Int.toString thmslen)
|
|
124 |
| SOME l =>
|
|
125 |
a { href = find_theorems_url ^
|
|
126 |
(if qargs = "" then "" else "?" ^ qargs),
|
|
127 |
text = Int.toString l })
|
|
128 |
val found = [text "found ", num_found_text, text " theorems"] : tag list;
|
|
129 |
val displayed =
|
|
130 |
if is_some othmslen
|
|
131 |
then " (" ^ Int.toString thmslen ^ " displayed)"
|
|
132 |
else "";
|
|
133 |
fun show_search c = tr [ td' noid [show_criterion c] ];
|
|
134 |
in
|
|
135 |
table (class "findtheoremsquery")
|
|
136 |
(* [ tr [ th (noid, "searched for:") ] ]
|
|
137 |
@ map show_search query @ *)
|
|
138 |
[ tr [ th' noid (found @ [text (displayed ^ ":")]) ] ]
|
|
139 |
end
|
|
140 |
|
|
141 |
fun sorry_class thm = if is_sorry thm then class "sorried" else noid;
|
|
142 |
|
|
143 |
fun html_thm ctxt (n, (thmref, thm)) =
|
|
144 |
let
|
|
145 |
val string_of_thm =
|
|
146 |
Output.output o Pretty.setmp_margin_CRITICAL 100 Pretty.string_of o
|
|
147 |
setmp_CRITICAL show_question_marks false (Display.pretty_thm ctxt);
|
|
148 |
in
|
|
149 |
tag' "tr" (class ("row" ^ Int.toString (n mod 2)))
|
|
150 |
[
|
|
151 |
tag' "td" (class "name")
|
|
152 |
[span' (sorry_class thm)
|
|
153 |
[raw_text (Facts.string_of_ref thmref)]
|
|
154 |
],
|
|
155 |
tag' "td" (class "thm") [pre noid (string_of_thm thm)]
|
|
156 |
]
|
|
157 |
end;
|
|
158 |
|
|
159 |
end;
|
|
160 |
|
|
161 |
structure P = OuterParse
|
|
162 |
and K = OuterKeyword
|
|
163 |
and FT = Find_Theorems;
|
|
164 |
|
|
165 |
val criterion =
|
|
166 |
P.reserved "name" |-- P.!!! (P.$$$ ":" |-- P.xname) >> Find_Theorems.Name ||
|
|
167 |
P.reserved "intro" >> K Find_Theorems.Intro ||
|
|
168 |
P.reserved "elim" >> K Find_Theorems.Elim ||
|
|
169 |
P.reserved "dest" >> K Find_Theorems.Dest ||
|
|
170 |
P.reserved "solves" >> K Find_Theorems.Solves ||
|
|
171 |
P.reserved "simp" |-- P.!!! (P.$$$ ":" |-- P.term) >> Find_Theorems.Simp ||
|
|
172 |
P.term >> Find_Theorems.Pattern;
|
|
173 |
|
|
174 |
val parse_query =
|
|
175 |
Scan.repeat (((Scan.option P.minus >> is_none) -- criterion));
|
|
176 |
|
|
177 |
fun app_index f xs = fold_index (fn x => K (f x)) xs ();
|
|
178 |
|
|
179 |
fun find_theorems (req as ScgiReq.Req {request_method, query_string, ...},
|
|
180 |
content, send) =
|
|
181 |
let
|
|
182 |
val arg_data =
|
|
183 |
(case request_method of
|
|
184 |
ScgiReq.Get => query_string
|
|
185 |
| ScgiReq.Post =>
|
|
186 |
content
|
|
187 |
|> Byte.bytesToString
|
|
188 |
|> HttpUtil.parse_query_string
|
|
189 |
| ScgiReq.Head => raise Fail "Cannot handle Head requests.");
|
|
190 |
|
|
191 |
val args = Symtab.lookup arg_data;
|
|
192 |
|
|
193 |
val query = the_default "" (args "query");
|
|
194 |
fun get_query () =
|
|
195 |
query
|
|
196 |
|> (fn s => s ^ ";")
|
|
197 |
|> OuterSyntax.scan Position.start
|
|
198 |
|> filter OuterLex.is_proper
|
|
199 |
|> Scan.error parse_query
|
|
200 |
|> fst;
|
|
201 |
|
|
202 |
val limit =
|
|
203 |
args "limit"
|
|
204 |
|> Option.mapPartial Int.fromString
|
|
205 |
|> the_default default_limit;
|
|
206 |
val thy_name =
|
|
207 |
args "theory"
|
|
208 |
|> the_default "Main";
|
|
209 |
val with_dups = is_some (args "with_dups");
|
|
210 |
|
|
211 |
fun do_find () =
|
|
212 |
let
|
|
213 |
val ctxt = ProofContext.init (theory thy_name);
|
|
214 |
val query = get_query ();
|
|
215 |
val (othmslen, thms) = apsnd rev
|
|
216 |
(Find_Theorems.find_theorems ctxt NONE (SOME limit) with_dups query);
|
|
217 |
val thmslen = length thms;
|
|
218 |
fun thm_row args = Xhtml.write send (html_thm ctxt args);
|
|
219 |
in
|
|
220 |
Xhtml.write send
|
|
221 |
(find_theorems_summary (othmslen, thmslen, query, arg_data));
|
|
222 |
if null thms then ()
|
|
223 |
else (Xhtml.write_open send find_theorems_table;
|
|
224 |
HTML_Unicode.print_mode (app_index thm_row) thms;
|
|
225 |
Xhtml.write_close send find_theorems_table)
|
|
226 |
end;
|
|
227 |
|
|
228 |
val header = (html_header thy_name (args "query", limit, with_dups));
|
|
229 |
in
|
|
230 |
send Xhtml.doctype_xhtml1_0_strict;
|
|
231 |
Xhtml.write_open send header;
|
|
232 |
if query = "" then ()
|
|
233 |
else
|
|
234 |
do_find ()
|
|
235 |
handle
|
|
236 |
ERROR msg => Xhtml.write send (html_error msg)
|
|
237 |
| e => Xhtml.write send (html_error ("Server error: " ^ exnMessage e));
|
|
238 |
Xhtml.write_close send header
|
|
239 |
end;
|
|
240 |
in
|
|
241 |
val () = show_question_marks := false;
|
|
242 |
val () = ScgiServer.register (find_theorems_url, SOME Mime.html, find_theorems);
|
|
243 |
end;
|
|
244 |
|