author | wenzelm |
Thu, 18 Jan 2018 21:41:30 +0100 | |
changeset 67463 | a5ca98950a91 |
parent 67386 | 998e01d6f8fd |
child 67469 | 008725a1ed52 |
permissions | -rw-r--r-- |
48985 | 1 |
(* Title: Doc/more_antiquote.ML |
28440 | 2 |
Author: Florian Haftmann, TU Muenchen |
3 |
||
63026 | 4 |
More antiquotations (partly depending on Isabelle/HOL). |
28440 | 5 |
*) |
6 |
||
56061 | 7 |
structure More_Antiquote : sig end = |
28440 | 8 |
struct |
9 |
||
63026 | 10 |
(* class specifications *) |
11 |
||
12 |
val _ = |
|
67463 | 13 |
Theory.setup (Thy_Output.antiquotation @{binding class_spec} (Scan.lift Args.name) |
14 |
(fn ctxt => fn s => |
|
15 |
let |
|
16 |
val thy = Proof_Context.theory_of ctxt; |
|
17 |
val class = Sign.intern_class thy s; |
|
18 |
in Class.pretty_specification thy class end)); |
|
63026 | 19 |
|
63554 | 20 |
|
29397 | 21 |
(* code theorem antiquotation *) |
22 |
||
23 |
fun no_vars ctxt thm = |
|
24 |
let |
|
25 |
val ctxt' = Variable.set_body false ctxt; |
|
31794
71af1fd6a5e4
renamed Variable.import_thms to Variable.import (back again cf. ed7aa5a350ef -- Alice is no longer supported);
wenzelm
parents:
31156
diff
changeset
|
26 |
val ((_, [thm]), _) = Variable.import true [thm] ctxt'; |
29397 | 27 |
in thm end; |
28 |
||
56061 | 29 |
val _ = |
67463 | 30 |
Theory.setup (Thy_Output.antiquotation_pretty @{binding code_thms} Args.term |
31 |
(fn ctxt => fn raw_const => |
|
32 |
let |
|
33 |
val thy = Proof_Context.theory_of ctxt; |
|
34 |
val const = Code.check_const thy raw_const; |
|
35 |
val { eqngr, ... } = Code_Preproc.obtain true { ctxt = ctxt, consts = [const], terms = [] }; |
|
36 |
fun holize thm = @{thm meta_eq_to_obj_eq} OF [thm]; |
|
37 |
val thms = Code_Preproc.cert eqngr const |
|
38 |
|> Code.equations_of_cert thy |
|
39 |
|> snd |
|
40 |
|> these |
|
41 |
|> map_filter (fn (_, (some_thm, proper)) => if proper then some_thm else NONE) |
|
42 |
|> map (holize o no_vars ctxt o Axclass.overload ctxt); |
|
43 |
in map (Thy_Output.pretty_thm ctxt) thms end)); |
|
29397 | 44 |
|
45 |
end; |