src/Tools/Code/code_target.ML
changeset 41940 a3b68a7a0e15
parent 41939 eb9fb5a4d27f
child 42359 6ca5407863ed
equal deleted inserted replaced
41939:eb9fb5a4d27f 41940:a3b68a7a0e15
    33     -> string * string
    33     -> string * string
    34 
    34 
    35   type serializer
    35   type serializer
    36   type literals = Code_Printer.literals
    36   type literals = Code_Printer.literals
    37   val add_target: string * { serializer: serializer, literals: literals,
    37   val add_target: string * { serializer: serializer, literals: literals,
    38     check: { env_var: string, make_destination: Path.T -> Path.T,
    38     check: { env_var: string, make_destination: Path.T -> Path.T, make_command: string -> string } }
    39       make_command: string -> string -> string } } -> theory -> theory
    39     -> theory -> theory
    40   val extend_target: string *
    40   val extend_target: string *
    41       (string * (Code_Thingol.naming -> Code_Thingol.program -> Code_Thingol.program))
    41       (string * (Code_Thingol.naming -> Code_Thingol.program -> Code_Thingol.program))
    42     -> theory -> theory
    42     -> theory -> theory
    43   val assert_target: theory -> string -> string
    43   val assert_target: theory -> string -> string
    44   val the_literals: theory -> string -> literals
    44   val the_literals: theory -> string -> literals
   127   -> serialization;
   127   -> serialization;
   128 
   128 
   129 datatype description = Fundamental of { serializer: serializer,
   129 datatype description = Fundamental of { serializer: serializer,
   130       literals: literals,
   130       literals: literals,
   131       check: { env_var: string, make_destination: Path.T -> Path.T,
   131       check: { env_var: string, make_destination: Path.T -> Path.T,
   132         make_command: string -> string -> string } }
   132         make_command: string -> string } }
   133   | Extension of string *
   133   | Extension of string *
   134       (Code_Thingol.naming -> Code_Thingol.program -> Code_Thingol.program);
   134       (Code_Thingol.naming -> Code_Thingol.program -> Code_Thingol.program);
   135 
   135 
   136 datatype target = Target of {
   136 datatype target = Target of {
   137   serial: serial,
   137   serial: serial,
   390 fun check_code_for thy target strict args naming program names_cs =
   390 fun check_code_for thy target strict args naming program names_cs =
   391   let
   391   let
   392     val module_name = "Code";
   392     val module_name = "Code";
   393     val { env_var, make_destination, make_command } =
   393     val { env_var, make_destination, make_command } =
   394       (#check o the_fundamental thy) target;
   394       (#check o the_fundamental thy) target;
   395     val env_param = getenv env_var;
       
   396     fun ext_check p =
   395     fun ext_check p =
   397       let 
   396       let 
   398         val destination = make_destination p;
   397         val destination = make_destination p;
   399         val _ = export (SOME destination) (invoke_serializer thy target (SOME 80)
   398         val _ = export (SOME destination) (invoke_serializer thy target (SOME 80)
   400           module_name args naming program names_cs);
   399           module_name args naming program names_cs);
   401         val cmd = make_command env_param module_name;
   400         val cmd = make_command module_name;
   402       in if bash ("cd " ^ File.shell_path p ^ " && " ^ cmd ^ " 2>&1") <> 0
   401       in if bash ("cd " ^ File.shell_path p ^ " && " ^ cmd ^ " 2>&1") <> 0
   403         then error ("Code check failed for " ^ target ^ ": " ^ cmd)
   402         then error ("Code check failed for " ^ target ^ ": " ^ cmd)
   404         else ()
   403         else ()
   405       end;
   404       end;
   406   in if env_param = ""
   405   in if getenv env_var = ""
   407     then if strict
   406     then if strict
   408       then error (env_var ^ " not set; cannot check code for " ^ target)
   407       then error (env_var ^ " not set; cannot check code for " ^ target)
   409       else warning (env_var ^ " not set; skipped checking code for " ^ target)
   408       else warning (env_var ^ " not set; skipped checking code for " ^ target)
   410     else Isabelle_System.with_tmp_dir "Code_Test" ext_check
   409     else Isabelle_System.with_tmp_dir "Code_Test" ext_check
   411   end;
   410   end;