7 |
7 |
8 signature CODE_PREPROC = |
8 signature CODE_PREPROC = |
9 sig |
9 sig |
10 val map_pre: (simpset -> simpset) -> theory -> theory |
10 val map_pre: (simpset -> simpset) -> theory -> theory |
11 val map_post: (simpset -> simpset) -> theory -> theory |
11 val map_post: (simpset -> simpset) -> theory -> theory |
12 val add_inline: thm -> theory -> theory |
12 val add_unfold: thm -> theory -> theory |
13 val add_functrans: string * (theory -> (thm * bool) list -> (thm * bool) list option) -> theory -> theory |
13 val add_functrans: string * (theory -> (thm * bool) list -> (thm * bool) list option) -> theory -> theory |
14 val del_functrans: string -> theory -> theory |
14 val del_functrans: string -> theory -> theory |
15 val simple_functrans: (theory -> thm list -> thm list option) |
15 val simple_functrans: (theory -> thm list -> thm list option) |
16 -> theory -> (thm * bool) list -> (thm * bool) list option |
16 -> theory -> (thm * bool) list -> (thm * bool) list option |
17 val print_codeproc: theory -> unit |
17 val print_codeproc: theory -> unit |
75 fun map_data f thy = |
75 fun map_data f thy = |
76 thy |
76 thy |
77 |> Code.purge_data |
77 |> Code.purge_data |
78 |> (Code_Preproc_Data.map o map_thmproc) f; |
78 |> (Code_Preproc_Data.map o map_thmproc) f; |
79 |
79 |
80 val map_pre = map_data o apfst o apfst; |
80 val map_pre_post = map_data o apfst; |
81 val map_post = map_data o apfst o apsnd; |
81 val map_pre = map_pre_post o apfst; |
82 |
82 val map_post = map_pre_post o apsnd; |
83 val add_inline = map_pre o MetaSimplifier.add_simp; |
83 |
84 val del_inline = map_pre o MetaSimplifier.del_simp; |
84 val add_unfold = map_pre o MetaSimplifier.add_simp; |
|
85 val del_unfold = map_pre o MetaSimplifier.del_simp; |
85 val add_post = map_post o MetaSimplifier.add_simp; |
86 val add_post = map_post o MetaSimplifier.add_simp; |
86 val del_post = map_post o MetaSimplifier.del_simp; |
87 val del_post = map_post o MetaSimplifier.del_simp; |
87 |
88 |
|
89 fun add_unfold_post raw_thm thy = |
|
90 let |
|
91 val thm = LocalDefs.meta_rewrite_rule (ProofContext.init thy) raw_thm; |
|
92 val thm_sym = Thm.symmetric thm; |
|
93 in |
|
94 thy |> map_pre_post (fn (pre, post) => |
|
95 (pre |> MetaSimplifier.add_simp thm, post |> MetaSimplifier.del_simp thm_sym)) |
|
96 end; |
|
97 |
88 fun add_functrans (name, f) = (map_data o apsnd) |
98 fun add_functrans (name, f) = (map_data o apsnd) |
89 (AList.update (op =) (name, (serial (), f))); |
99 (AList.update (op =) (name, (serial (), f))); |
90 |
100 |
91 fun del_functrans name = (map_data o apsnd) |
101 fun del_functrans name = (map_data o apsnd) |
92 (delete_force "function transformer" name); |
102 (delete_force "function transformer" name); |
524 (** setup **) |
534 (** setup **) |
525 |
535 |
526 val setup = |
536 val setup = |
527 let |
537 let |
528 fun mk_attribute f = Thm.declaration_attribute (fn thm => Context.mapping (f thm) I); |
538 fun mk_attribute f = Thm.declaration_attribute (fn thm => Context.mapping (f thm) I); |
529 fun add_del_attribute_parser (add, del) = |
539 fun add_del_attribute_parser add del = |
530 Attrib.add_del (mk_attribute add) (mk_attribute del); |
540 Attrib.add_del (mk_attribute add) (mk_attribute del); |
531 in |
541 fun both f g thm = f thm #> g thm; |
532 Attrib.setup @{binding code_inline} (add_del_attribute_parser (add_inline, del_inline)) |
542 in |
|
543 Attrib.setup @{binding code_unfold} (add_del_attribute_parser |
|
544 (both Codegen.add_unfold add_unfold) (both Codegen.del_unfold del_unfold)) |
|
545 "preprocessing equations for code generators" |
|
546 #> Attrib.setup @{binding code_inline} (add_del_attribute_parser add_unfold del_unfold) |
533 "preprocessing equations for code generator" |
547 "preprocessing equations for code generator" |
534 #> Attrib.setup @{binding code_post} (add_del_attribute_parser (add_post, del_post)) |
548 #> Attrib.setup @{binding code_post} (add_del_attribute_parser add_post del_post) |
535 "postprocessing equations for code generator" |
549 "postprocessing equations for code generator" |
536 #> Attrib.setup @{binding code_unfold} (Scan.succeed (mk_attribute |
550 #> Attrib.setup @{binding code_unfold_post} (Scan.succeed (mk_attribute add_unfold_post)) |
537 (fn thm => Codegen.add_unfold thm #> add_inline thm))) |
551 "pre- and postprocessing equations for code generator" |
538 "preprocessing equations for code generators" |
|
539 end; |
552 end; |
540 |
553 |
541 val _ = |
554 val _ = |
542 OuterSyntax.improper_command "print_codeproc" "print code preprocessor setup" |
555 OuterSyntax.improper_command "print_codeproc" "print code preprocessor setup" |
543 OuterKeyword.diag (Scan.succeed |
556 OuterKeyword.diag (Scan.succeed |