src/Tools/Code/code_target.ML
changeset 37819 000049335247
parent 37814 120c6e2d7474
child 37821 3cbb22cec751
equal deleted inserted replaced
37818:dd65033fed78 37819:000049335247
    33   val file: Path.T -> serialization -> unit
    33   val file: Path.T -> serialization -> unit
    34   val string: string list -> serialization -> string
    34   val string: string list -> serialization -> string
    35   val code_of: theory -> string -> int option -> string
    35   val code_of: theory -> string -> int option -> string
    36     -> string list -> (Code_Thingol.naming -> string list) -> string
    36     -> string list -> (Code_Thingol.naming -> string list) -> string
    37   val external_check: theory -> string -> string
    37   val external_check: theory -> string -> string
    38     -> (Path.T -> Path.T) -> (string -> Path.T -> string -> string) -> Path.T -> unit
    38     -> (Path.T -> Path.T) -> (string -> Path.T -> string -> string) -> unit
    39   val set_default_code_width: int -> theory -> theory
    39   val set_default_code_width: int -> theory -> theory
    40   val shell_command: string (*theory name*) -> string (*export_code expr*) -> unit
    40   val shell_command: string (*theory name*) -> string (*export_code expr*) -> unit
    41 
    41 
    42   val allow_abort: string -> theory -> theory
    42   val allow_abort: string -> theory -> theory
    43   type tyco_syntax = Code_Printer.tyco_syntax
    43   type tyco_syntax = Code_Printer.tyco_syntax
   350     val names3 = transitivly_non_empty_funs thy naming program;
   350     val names3 = transitivly_non_empty_funs thy naming program;
   351     val cs3 = map_filter (fn (c, name) =>
   351     val cs3 = map_filter (fn (c, name) =>
   352       if member (op =) names3 name then SOME c else NONE) (cs2 ~~ names2);
   352       if member (op =) names3 name then SOME c else NONE) (cs2 ~~ names2);
   353   in union (op =) cs3 cs1 end;
   353   in union (op =) cs3 cs1 end;
   354 
   354 
   355 fun external_check thy target env_var make_destination make_command p =
   355 fun external_check thy target env_var make_destination make_command =
   356   let
   356   let
   357     val env_param = getenv env_var;
   357     val env_param = getenv env_var;
   358     fun ext_check env_param =
   358     fun ext_check env_param p =
   359       let 
   359       let 
   360         val module_name = "Code_Test";
   360         val module_name = "Code_Test";
   361         val (cs, (naming, program)) =
   361         val (cs, (naming, program)) =
   362           Code_Thingol.consts_program thy false (read_const_exprs thy ["*"]);
   362           Code_Thingol.consts_program thy false (read_const_exprs thy ["*"]);
   363         val destination = make_destination p;
   363         val destination = make_destination p;
   368         then error ("Code check failed for " ^ target ^ ": " ^ cmd)
   368         then error ("Code check failed for " ^ target ^ ": " ^ cmd)
   369         else ()
   369         else ()
   370       end;
   370       end;
   371   in if env_param = ""
   371   in if env_param = ""
   372     then warning (env_var ^ " not set; skipped code check for " ^ target)
   372     then warning (env_var ^ " not set; skipped code check for " ^ target)
   373     else ext_check env_param
   373     else Cache_IO.with_tmp_dir "Code_Test" (ext_check env_param)
   374   end;
   374   end;
   375 
   375 
   376 fun export_code thy cs seris =
   376 fun export_code thy cs seris =
   377   let
   377   let
   378     val (cs', (naming, program)) = Code_Thingol.consts_program thy false cs;
   378     val (cs', (naming, program)) = Code_Thingol.consts_program thy false cs;