304 |> fst |
304 |> fst |
305 |
305 |
306 fun backquote_term ctxt = close_form #> hackish_string_of_term ctxt #> backquote |
306 fun backquote_term ctxt = close_form #> hackish_string_of_term ctxt #> backquote |
307 fun backquote_thm ctxt = backquote_term ctxt o prop_of |
307 fun backquote_thm ctxt = backquote_term ctxt o prop_of |
308 |
308 |
|
309 (* gracefully handle huge background theories *) |
|
310 val max_simps_for_clasimpset = 10000 |
|
311 |
309 fun clasimpset_rule_table_of ctxt = |
312 fun clasimpset_rule_table_of ctxt = |
310 let |
313 let val simps = ctxt |> simpset_of |> dest_ss |> #simps in |
311 fun add stature th = |
314 if length simps >= max_simps_for_clasimpset then |
312 Termtab.update (normalize_vars (prop_of th), stature) |
315 Termtab.empty |
313 val {safeIs, (* safeEs, *) hazIs, (* hazEs, *) ...} = |
316 else |
314 ctxt |> claset_of |> Classical.rep_cs |
317 let |
315 val intros = Item_Net.content safeIs @ Item_Net.content hazIs |
318 fun add stature th = |
|
319 Termtab.update (normalize_vars (prop_of th), stature) |
|
320 val {safeIs, (* safeEs, *) hazIs, (* hazEs, *) ...} = |
|
321 ctxt |> claset_of |> Classical.rep_cs |
|
322 val intros = Item_Net.content safeIs @ Item_Net.content hazIs |
316 (* Add once it is used: |
323 (* Add once it is used: |
317 val elims = |
324 val elims = |
318 Item_Net.content safeEs @ Item_Net.content hazEs |
325 Item_Net.content safeEs @ Item_Net.content hazEs |
319 |> map Classical.classical_rule |
326 |> map Classical.classical_rule |
320 *) |
327 *) |
321 val simps = ctxt |> simpset_of |> dest_ss |> #simps |
328 val specs = ctxt |> Spec_Rules.get |
322 val specs = ctxt |> Spec_Rules.get |
329 val (rec_defs, nonrec_defs) = |
323 val (rec_defs, nonrec_defs) = |
330 specs |> filter (curry (op =) Spec_Rules.Equational o fst) |
324 specs |> filter (curry (op =) Spec_Rules.Equational o fst) |
331 |> maps (snd o snd) |
325 |> maps (snd o snd) |
332 |> filter_out (member Thm.eq_thm_prop risky_defs) |
326 |> filter_out (member Thm.eq_thm_prop risky_defs) |
333 |> List.partition (is_rec_def o prop_of) |
327 |> List.partition (is_rec_def o prop_of) |
334 val spec_intros = |
328 val spec_intros = |
335 specs |> filter (member (op =) [Spec_Rules.Inductive, |
329 specs |> filter (member (op =) [Spec_Rules.Inductive, |
336 Spec_Rules.Co_Inductive] o fst) |
330 Spec_Rules.Co_Inductive] o fst) |
337 |> maps (snd o snd) |
331 |> maps (snd o snd) |
338 in |
332 in |
339 Termtab.empty |> fold (add Simp o snd) simps |
333 Termtab.empty |> fold (add Simp o snd) simps |
340 |> fold (add Rec_Def) rec_defs |
334 |> fold (add Rec_Def) rec_defs |
341 |> fold (add Non_Rec_Def) nonrec_defs |
335 |> fold (add Non_Rec_Def) nonrec_defs |
|
336 (* Add once it is used: |
342 (* Add once it is used: |
337 |> fold (add Elim) elims |
343 |> fold (add Elim) elims |
338 *) |
344 *) |
339 |> fold (add Intro) intros |
345 |> fold (add Intro) intros |
340 |> fold (add Inductive) spec_intros |
346 |> fold (add Inductive) spec_intros |
|
347 end |
341 end |
348 end |
342 |
349 |
343 fun normalize_eq (t as @{const Trueprop} |
350 fun normalize_eq (t as @{const Trueprop} |
344 $ ((t0 as Const (@{const_name HOL.eq}, _)) $ t1 $ t2)) = |
351 $ ((t0 as Const (@{const_name HOL.eq}, _)) $ t1 $ t2)) = |
345 if Term_Ord.fast_term_ord (t1, t2) <> GREATER then t |
352 if Term_Ord.fast_term_ord (t1, t2) <> GREATER then t |