added code_unfold_post attribute
authorhaftmann
Tue, 14 Jul 2009 16:27:34 +0200
changeset 32064d4bff63bcbf1
parent 32063 b4a48533ce0c
child 32065 0a83608e21f1
added code_unfold_post attribute
src/Tools/Code/code_preproc.ML
     1.1 --- a/src/Tools/Code/code_preproc.ML	Tue Jul 14 16:27:33 2009 +0200
     1.2 +++ b/src/Tools/Code/code_preproc.ML	Tue Jul 14 16:27:34 2009 +0200
     1.3 @@ -9,7 +9,7 @@
     1.4  sig
     1.5    val map_pre: (simpset -> simpset) -> theory -> theory
     1.6    val map_post: (simpset -> simpset) -> theory -> theory
     1.7 -  val add_inline: thm -> theory -> theory
     1.8 +  val add_unfold: thm -> theory -> theory
     1.9    val add_functrans: string * (theory -> (thm * bool) list -> (thm * bool) list option) -> theory -> theory
    1.10    val del_functrans: string -> theory -> theory
    1.11    val simple_functrans: (theory -> thm list -> thm list option)
    1.12 @@ -77,14 +77,24 @@
    1.13    |> Code.purge_data
    1.14    |> (Code_Preproc_Data.map o map_thmproc) f;
    1.15  
    1.16 -val map_pre = map_data o apfst o apfst;
    1.17 -val map_post = map_data o apfst o apsnd;
    1.18 +val map_pre_post = map_data o apfst;
    1.19 +val map_pre = map_pre_post o apfst;
    1.20 +val map_post = map_pre_post o apsnd;
    1.21  
    1.22 -val add_inline = map_pre o MetaSimplifier.add_simp;
    1.23 -val del_inline = map_pre o MetaSimplifier.del_simp;
    1.24 +val add_unfold = map_pre o MetaSimplifier.add_simp;
    1.25 +val del_unfold = map_pre o MetaSimplifier.del_simp;
    1.26  val add_post = map_post o MetaSimplifier.add_simp;
    1.27  val del_post = map_post o MetaSimplifier.del_simp;
    1.28 -  
    1.29 +
    1.30 +fun add_unfold_post raw_thm thy =
    1.31 +  let
    1.32 +    val thm = LocalDefs.meta_rewrite_rule (ProofContext.init thy) raw_thm;
    1.33 +    val thm_sym = Thm.symmetric thm;
    1.34 +  in
    1.35 +    thy |> map_pre_post (fn (pre, post) =>
    1.36 +      (pre |> MetaSimplifier.add_simp thm, post |> MetaSimplifier.del_simp thm_sym))
    1.37 +  end;
    1.38 +
    1.39  fun add_functrans (name, f) = (map_data o apsnd)
    1.40    (AList.update (op =) (name, (serial (), f)));
    1.41  
    1.42 @@ -526,16 +536,19 @@
    1.43  val setup = 
    1.44    let
    1.45      fun mk_attribute f = Thm.declaration_attribute (fn thm => Context.mapping (f thm) I);
    1.46 -    fun add_del_attribute_parser (add, del) =
    1.47 +    fun add_del_attribute_parser add del =
    1.48        Attrib.add_del (mk_attribute add) (mk_attribute del);
    1.49 +    fun both f g thm = f thm #> g thm;
    1.50    in
    1.51 -    Attrib.setup @{binding code_inline} (add_del_attribute_parser (add_inline, del_inline))
    1.52 +    Attrib.setup @{binding code_unfold} (add_del_attribute_parser 
    1.53 +       (both Codegen.add_unfold add_unfold) (both Codegen.del_unfold del_unfold))
    1.54 +        "preprocessing equations for code generators"
    1.55 +    #> Attrib.setup @{binding code_inline} (add_del_attribute_parser add_unfold del_unfold)
    1.56          "preprocessing equations for code generator"
    1.57 -    #> Attrib.setup @{binding code_post} (add_del_attribute_parser (add_post, del_post))
    1.58 +    #> Attrib.setup @{binding code_post} (add_del_attribute_parser add_post del_post)
    1.59          "postprocessing equations for code generator"
    1.60 -    #> Attrib.setup @{binding code_unfold} (Scan.succeed (mk_attribute
    1.61 -       (fn thm => Codegen.add_unfold thm #> add_inline thm)))
    1.62 -        "preprocessing equations for code generators"
    1.63 +    #> Attrib.setup @{binding code_unfold_post} (Scan.succeed (mk_attribute add_unfold_post))
    1.64 +        "pre- and postprocessing equations for code generator"
    1.65    end;
    1.66  
    1.67  val _ =