src/Tools/Code/code_preproc.ML
changeset 32072 d4bff63bcbf1
parent 31998 2c7a24f74db9
child 32091 30e2ffbba718
child 32123 8bac9ee4b28d
equal deleted inserted replaced
32071:b4a48533ce0c 32072:d4bff63bcbf1
     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