src/HOL/Library/code_test.ML
changeset 72274 a1098a183f4a
parent 72273 b8f32e830e95
child 72275 f7189b7f5567
equal deleted inserted replaced
72273:b8f32e830e95 72274:a1098a183f4a
    16   val end_markerN: string
    16   val end_markerN: string
    17   val test_terms: Proof.context -> term list -> string -> unit
    17   val test_terms: Proof.context -> term list -> string -> unit
    18   val test_targets: Proof.context -> term list -> string list -> unit
    18   val test_targets: Proof.context -> term list -> string list -> unit
    19   val test_code_cmd: string list -> string list -> Proof.context -> unit
    19   val test_code_cmd: string list -> string list -> Proof.context -> unit
    20   val eval_term: string -> Proof.context -> term -> term
    20   val eval_term: string -> Proof.context -> term -> term
    21   val evaluate:
    21   val evaluate: (string * string) option -> string ->
    22    (theory -> Path.T -> string list -> string ->
    22    (Proof.context -> Path.T -> string list -> string ->
    23      {files: (Path.T * string) list,
    23      {files: (Path.T * string) list,
    24        compile_cmd: string option,
    24        compile_cmd: string,
    25        run_cmd: string,
    25        run_cmd: string,
    26        mk_code_file: string -> Path.T}) -> (string * string) option -> string -> theory ->
    26        mk_code_file: string -> Path.T}) -> Proof.context ->
    27      (string * string) list * string -> Path.T -> string
    27      (string * string) list * string -> Path.T -> string
    28   val evaluate_in_polyml: Proof.context -> (string * string) list * string -> Path.T -> string
    28   val evaluate_in_polyml: Proof.context -> (string * string) list * string -> Path.T -> string
    29   val evaluate_in_mlton: Proof.context -> (string * string) list * string -> Path.T -> string
    29   val evaluate_in_mlton: Proof.context -> (string * string) list * string -> Path.T -> string
    30   val evaluate_in_smlnj: Proof.context -> (string * string) list * string -> Path.T -> string
    30   val evaluate_in_smlnj: Proof.context -> (string * string) list * string -> Path.T -> string
    31   val evaluate_in_ocaml: Proof.context -> (string * string) list * string -> Path.T -> string
    31   val evaluate_in_ocaml: Proof.context -> (string * string) list * string -> Path.T -> string
   162       (case get_driver thy compiler of
   162       (case get_driver thy compiler of
   163         NONE => error ("No driver for target " ^ compiler)
   163         NONE => error ("No driver for target " ^ compiler)
   164       | SOME drv => drv)
   164       | SOME drv => drv)
   165     val debug = Config.get (Proof_Context.init_global thy) overlord
   165     val debug = Config.get (Proof_Context.init_global thy) overlord
   166     val with_dir = if debug then with_overlord_dir else Isabelle_System.with_tmp_dir
   166     val with_dir = if debug then with_overlord_dir else Isabelle_System.with_tmp_dir
   167     fun evaluate result =
   167     fun eval result =
   168       with_dir "Code_Test" (driver ctxt ((apfst o map o apfst) Long_Name.implode result))
   168       with_dir "Code_Test" (driver ctxt ((apfst o map o apfst) Long_Name.implode result))
   169       |> parse_result compiler
   169       |> parse_result compiler
   170     fun evaluator program _ vs_ty deps =
   170     fun evaluator program _ vs_ty deps =
   171       Exn.interruptible_capture evaluate
   171       Exn.interruptible_capture eval
   172         (Code_Target.compilation_text ctxt target program deps true vs_ty)
   172         (Code_Target.compilation_text ctxt target program deps true vs_ty)
   173     fun postproc f = map (apsnd (Option.map (map f)))
   173     fun postproc f = map (apsnd (Option.map (map f)))
   174   in Exn.release (Code_Thingol.dynamic_value ctxt (Exn.map_res o postproc) evaluator t) end
   174   in Exn.release (Code_Thingol.dynamic_value ctxt (Exn.map_res o postproc) evaluator t) end
   175 
   175 
   176 
   176 
   275   in (case result of [(_, SOME [t])] => t | _ => error "Evaluation failed") end
   275   in (case result of [(_, SOME [t])] => t | _ => error "Evaluation failed") end
   276 
   276 
   277 
   277 
   278 (* generic driver *)
   278 (* generic driver *)
   279 
   279 
   280 fun evaluate mk_driver opt_env_var compilerN ctxt (code_files, value_name) =
   280 fun evaluate opt_env_var compilerN mk_driver (ctxt: Proof.context) (code_files, value_name) =
   281   let
   281   let
   282     val _ =
   282     val _ =
   283       (case opt_env_var of
   283       (case opt_env_var of
   284         NONE => ()
   284         NONE => ()
   285       | SOME (env_var, env_var_dest) =>
   285       | SOME (env_var, env_var_dest) =>
   289                 ("Environment variable " ^ env_var ^ " is not set. To test code generation with " ^
   289                 ("Environment variable " ^ env_var ^ " is not set. To test code generation with " ^
   290                   compilerN ^ ", set this variable to your " ^ env_var_dest ^
   290                   compilerN ^ ", set this variable to your " ^ env_var_dest ^
   291                   " in the $ISABELLE_HOME_USER/etc/settings file.")))
   291                   " in the $ISABELLE_HOME_USER/etc/settings file.")))
   292           | _ => ()))
   292           | _ => ()))
   293 
   293 
   294     fun compile NONE = ()
   294     fun compile "" = ()
   295       | compile (SOME cmd) =
   295       | compile cmd =
   296           let
   296           let
   297             val (out, ret) = Isabelle_System.bash_output cmd
   297             val (out, ret) = Isabelle_System.bash_output cmd
   298           in
   298           in
   299             if ret = 0 then ()
   299             if ret = 0 then ()
   300             else error ("Compilation with " ^ compilerN ^ " failed:\n" ^ cmd ^ "\n" ^ out)
   300             else error ("Compilation with " ^ compilerN ^ " failed:\n" ^ cmd ^ "\n" ^ out)
   321 
   321 
   322 (* driver for PolyML *)
   322 (* driver for PolyML *)
   323 
   323 
   324 val polymlN = "PolyML"
   324 val polymlN = "PolyML"
   325 
   325 
   326 fun mk_driver_polyml _ path _ value_name =
   326 val evaluate_in_polyml =
   327   let
   327   evaluate NONE polymlN
   328     val generatedN = "generated.sml"
   328     (fn _ => fn path => fn _ => fn value_name =>
   329     val driverN = "driver.sml"
   329       let
   330 
   330         val generatedN = "generated.sml"
   331     val code_path = Path.append path (Path.basic generatedN)
   331         val driverN = "driver.sml"
   332     val driver_path = Path.append path (Path.basic driverN)
   332 
   333     val driver =
   333         val code_path = Path.append path (Path.basic generatedN)
   334       "fun main prog_name = \n" ^
   334         val driver_path = Path.append path (Path.basic driverN)
   335       "  let\n" ^
   335         val driver =
   336       "    fun format_term NONE = \"\"\n" ^
   336           "fun main prog_name = \n" ^
   337       "      | format_term (SOME t) = t ();\n" ^
   337           "  let\n" ^
   338       "    fun format (true, _) = \"" ^ successN ^ "\\n\"\n" ^
   338           "    fun format_term NONE = \"\"\n" ^
   339       "      | format (false, to) = \"" ^ failureN ^ "\" ^ format_term to ^ \"\\n\";\n" ^
   339           "      | format_term (SOME t) = t ();\n" ^
   340       "    val result = " ^ value_name ^ " ();\n" ^
   340           "    fun format (true, _) = \"" ^ successN ^ "\\n\"\n" ^
   341       "    val _ = print \"" ^ start_markerN ^ "\";\n" ^
   341           "      | format (false, to) = \"" ^ failureN ^ "\" ^ format_term to ^ \"\\n\";\n" ^
   342       "    val _ = map (print o format) result;\n" ^
   342           "    val result = " ^ value_name ^ " ();\n" ^
   343       "    val _ = print \"" ^ end_markerN ^ "\";\n" ^
   343           "    val _ = print \"" ^ start_markerN ^ "\";\n" ^
   344       "  in\n" ^
   344           "    val _ = map (print o format) result;\n" ^
   345       "    ()\n" ^
   345           "    val _ = print \"" ^ end_markerN ^ "\";\n" ^
   346       "  end;\n"
   346           "  in\n" ^
   347     val cmd =
   347           "    ()\n" ^
   348       "\"$POLYML_EXE\" --use " ^ Bash.string (File.platform_path code_path) ^
   348           "  end;\n"
   349       " --use " ^ Bash.string (File.platform_path driver_path) ^
   349       in
   350       " --eval " ^ Bash.string "main ()"
   350        {files = [(driver_path, driver)],
   351   in
   351         compile_cmd = "",
   352     {files = [(driver_path, driver)], compile_cmd = NONE, run_cmd = cmd, mk_code_file = K code_path}
   352         run_cmd =
   353   end
   353           "\"$POLYML_EXE\" --use " ^ Bash.string (File.platform_path code_path) ^
   354 
   354           " --use " ^ Bash.string (File.platform_path driver_path) ^
   355 fun evaluate_in_polyml ctxt = evaluate mk_driver_polyml NONE polymlN ctxt
   355           " --eval " ^ Bash.string "main ()",
       
   356         mk_code_file = K code_path}
       
   357       end)
   356 
   358 
   357 
   359 
   358 (* driver for mlton *)
   360 (* driver for mlton *)
   359 
   361 
   360 val mltonN = "MLton"
   362 val mltonN = "MLton"
   361 val ISABELLE_MLTON = "ISABELLE_MLTON"
   363 val ISABELLE_MLTON = "ISABELLE_MLTON"
   362 
   364 
   363 fun mk_driver_mlton _ path _ value_name =
   365 val evaluate_in_mlton =
   364   let
   366   evaluate (SOME (ISABELLE_MLTON, "MLton executable")) mltonN
   365     val generatedN = "generated.sml"
   367     (fn _ => fn path => fn _ => fn value_name =>
   366     val driverN = "driver.sml"
   368       let
   367     val projectN = "test"
   369         val generatedN = "generated.sml"
   368     val ml_basisN = projectN ^ ".mlb"
   370         val driverN = "driver.sml"
   369 
   371         val projectN = "test"
   370     val code_path = Path.append path (Path.basic generatedN)
   372         val ml_basisN = projectN ^ ".mlb"
   371     val driver_path = Path.append path (Path.basic driverN)
   373 
   372     val ml_basis_path = Path.append path (Path.basic ml_basisN)
   374         val code_path = Path.append path (Path.basic generatedN)
   373     val driver =
   375         val driver_path = Path.append path (Path.basic driverN)
   374       "fun format_term NONE = \"\"\n" ^
   376         val ml_basis_path = Path.append path (Path.basic ml_basisN)
   375       "  | format_term (SOME t) = t ();\n" ^
   377         val driver =
   376       "fun format (true, _) = \"" ^ successN ^ "\\n\"\n" ^
   378           "fun format_term NONE = \"\"\n" ^
   377       "  | format (false, to) = \"" ^ failureN ^ "\" ^ format_term to ^ \"\\n\";\n" ^
   379           "  | format_term (SOME t) = t ();\n" ^
   378       "val result = " ^ value_name ^ " ();\n" ^
   380           "fun format (true, _) = \"" ^ successN ^ "\\n\"\n" ^
   379       "val _ = print \"" ^ start_markerN ^ "\";\n" ^
   381           "  | format (false, to) = \"" ^ failureN ^ "\" ^ format_term to ^ \"\\n\";\n" ^
   380       "val _ = map (print o format) result;\n" ^
   382           "val result = " ^ value_name ^ " ();\n" ^
   381       "val _ = print \"" ^ end_markerN ^ "\";\n"
   383           "val _ = print \"" ^ start_markerN ^ "\";\n" ^
   382     val ml_basis =
   384           "val _ = map (print o format) result;\n" ^
   383       "$(SML_LIB)/basis/basis.mlb\n" ^
   385           "val _ = print \"" ^ end_markerN ^ "\";\n"
   384       generatedN ^ "\n" ^
   386         val ml_basis = "$(SML_LIB)/basis/basis.mlb\n" ^ generatedN ^ "\n" ^ driverN
   385       driverN
   387       in
   386 
   388        {files = [(driver_path, driver), (ml_basis_path, ml_basis)],
   387     val compile_cmd =
   389         compile_cmd =
   388       File.bash_path (Path.variable ISABELLE_MLTON) ^
   390           File.bash_path (Path.variable ISABELLE_MLTON) ^
   389       " -default-type intinf " ^ File.bash_path ml_basis_path
   391             " -default-type intinf " ^ File.bash_path ml_basis_path,
   390     val run_cmd = File.bash_path (Path.append path (Path.basic projectN))
   392         run_cmd = File.bash_path (Path.append path (Path.basic projectN)),
   391   in
   393         mk_code_file = K code_path}
   392     {files = [(driver_path, driver), (ml_basis_path, ml_basis)],
   394       end)
   393      compile_cmd = SOME compile_cmd, run_cmd = run_cmd, mk_code_file = K code_path}
       
   394   end
       
   395 
       
   396 fun evaluate_in_mlton ctxt =
       
   397   evaluate mk_driver_mlton (SOME (ISABELLE_MLTON, "MLton executable")) mltonN ctxt
       
   398 
   395 
   399 
   396 
   400 (* driver for SML/NJ *)
   397 (* driver for SML/NJ *)
   401 
   398 
   402 val smlnjN = "SMLNJ"
   399 val smlnjN = "SMLNJ"
   403 val ISABELLE_SMLNJ = "ISABELLE_SMLNJ"
   400 val ISABELLE_SMLNJ = "ISABELLE_SMLNJ"
   404 
   401 
   405 fun mk_driver_smlnj _ path _ value_name =
   402 val evaluate_in_smlnj =
   406   let
   403   evaluate (SOME (ISABELLE_SMLNJ, "SMLNJ executable")) smlnjN
   407     val generatedN = "generated.sml"
   404     (fn _ => fn path => fn _ => fn value_name =>
   408     val driverN = "driver.sml"
   405       let
   409 
   406         val generatedN = "generated.sml"
   410     val code_path = Path.append path (Path.basic generatedN)
   407         val driverN = "driver.sml"
   411     val driver_path = Path.append path (Path.basic driverN)
   408 
   412     val driver =
   409         val code_path = Path.append path (Path.basic generatedN)
   413       "structure Test = struct\n" ^
   410         val driver_path = Path.append path (Path.basic driverN)
   414       "fun main prog_name =\n" ^
   411         val driver =
   415       "  let\n" ^
   412           "structure Test = struct\n" ^
   416       "    fun format_term NONE = \"\"\n" ^
   413           "fun main prog_name =\n" ^
   417       "      | format_term (SOME t) = t ();\n" ^
   414           "  let\n" ^
   418       "    fun format (true, _) = \"" ^ successN ^ "\\n\"\n" ^
   415           "    fun format_term NONE = \"\"\n" ^
   419       "      | format (false, to) = \"" ^ failureN ^ "\" ^ format_term to ^ \"\\n\";\n" ^
   416           "      | format_term (SOME t) = t ();\n" ^
   420       "    val result = " ^ value_name ^ " ();\n" ^
   417           "    fun format (true, _) = \"" ^ successN ^ "\\n\"\n" ^
   421       "    val _ = print \"" ^ start_markerN ^ "\";\n" ^
   418           "      | format (false, to) = \"" ^ failureN ^ "\" ^ format_term to ^ \"\\n\";\n" ^
   422       "    val _ = map (print o format) result;\n" ^
   419           "    val result = " ^ value_name ^ " ();\n" ^
   423       "    val _ = print \"" ^ end_markerN ^ "\";\n" ^
   420           "    val _ = print \"" ^ start_markerN ^ "\";\n" ^
   424       "  in\n" ^
   421           "    val _ = map (print o format) result;\n" ^
   425       "    0\n" ^
   422           "    val _ = print \"" ^ end_markerN ^ "\";\n" ^
   426       "  end;\n" ^
   423           "  in\n" ^
   427       "end;"
   424           "    0\n" ^
   428     val ml_source =
   425           "  end;\n" ^
   429       "Control.MC.matchRedundantError := false; Control.MC.matchRedundantWarn := false;" ^
   426           "end;"
   430       "use " ^ ML_Syntax.print_string (Bash.string (File.platform_path code_path)) ^
   427         val ml_source =
   431       "; use " ^ ML_Syntax.print_string (Bash.string (File.platform_path driver_path)) ^
   428           "Control.MC.matchRedundantError := false; Control.MC.matchRedundantWarn := false;" ^
   432       "; Test.main ();"
   429           "use " ^ ML_Syntax.print_string (Bash.string (File.platform_path code_path)) ^
   433     val cmd = "echo " ^ Bash.string ml_source ^ " | \"$ISABELLE_SMLNJ\""
   430           "; use " ^ ML_Syntax.print_string (Bash.string (File.platform_path driver_path)) ^
   434   in
   431           "; Test.main ();"
   435     {files = [(driver_path, driver)], compile_cmd = NONE, run_cmd = cmd, mk_code_file = K code_path}
   432         val cmd = "echo " ^ Bash.string ml_source ^ " | \"$ISABELLE_SMLNJ\""
   436   end
   433       in
   437 
   434        {files = [(driver_path, driver)],
   438 fun evaluate_in_smlnj ctxt =
   435         compile_cmd = "",
   439   evaluate mk_driver_smlnj (SOME (ISABELLE_SMLNJ, "SMLNJ executable")) smlnjN ctxt
   436         run_cmd = cmd,
       
   437         mk_code_file = K code_path}
       
   438       end)
   440 
   439 
   441 
   440 
   442 (* driver for OCaml *)
   441 (* driver for OCaml *)
   443 
   442 
   444 val ocamlN = "OCaml"
   443 val ocamlN = "OCaml"
   445 val ISABELLE_OCAMLFIND = "ISABELLE_OCAMLFIND"
   444 val ISABELLE_OCAMLFIND = "ISABELLE_OCAMLFIND"
   446 
   445 
   447 fun mk_driver_ocaml _ path _ value_name =
   446 val evaluate_in_ocaml =
   448   let
   447   evaluate (SOME (ISABELLE_OCAMLFIND, "ocamlfind executable")) ocamlN
   449     val generatedN = "generated.ml"
   448     (fn _ => fn path => fn _ => fn value_name =>
   450     val driverN = "driver.ml"
   449       let
   451 
   450         val generatedN = "generated.ml"
   452     val code_path = Path.append path (Path.basic generatedN)
   451         val driverN = "driver.ml"
   453     val driver_path = Path.append path (Path.basic driverN)
   452 
   454     val driver =
   453         val code_path = Path.append path (Path.basic generatedN)
   455       "let format_term = function\n" ^
   454         val driver_path = Path.append path (Path.basic driverN)
   456       "  | None -> \"\"\n" ^
   455         val driver =
   457       "  | Some t -> t ();;\n" ^
   456           "let format_term = function\n" ^
   458       "let format = function\n" ^
   457           "  | None -> \"\"\n" ^
   459       "  | (true, _) -> \"" ^ successN ^ "\\n\"\n" ^
   458           "  | Some t -> t ();;\n" ^
   460       "  | (false, x) -> \"" ^ failureN ^ "\" ^ format_term x ^ \"\\n\";;\n" ^
   459           "let format = function\n" ^
   461       "let result = " ^ ("Generated." ^ value_name) ^ " ();;\n" ^
   460           "  | (true, _) -> \"" ^ successN ^ "\\n\"\n" ^
   462       "let main x =\n" ^
   461           "  | (false, x) -> \"" ^ failureN ^ "\" ^ format_term x ^ \"\\n\";;\n" ^
   463       "  let _ = print_string \"" ^ start_markerN ^ "\" in\n" ^
   462           "let result = " ^ ("Generated." ^ value_name) ^ " ();;\n" ^
   464       "  let _ = List.map (fun x -> print_string (format x)) result in\n" ^
   463           "let main x =\n" ^
   465       "  print_string \"" ^ end_markerN ^ "\";;\n" ^
   464           "  let _ = print_string \"" ^ start_markerN ^ "\" in\n" ^
   466       "main ();;"
   465           "  let _ = List.map (fun x -> print_string (format x)) result in\n" ^
   467 
   466           "  print_string \"" ^ end_markerN ^ "\";;\n" ^
   468     val compiled_path = Path.append path (Path.basic "test")
   467           "main ();;"
   469     val compile_cmd =
   468 
   470       "\"$ISABELLE_OCAMLFIND\" ocamlopt -w pu -package zarith -linkpkg" ^
   469         val compiled_path = Path.append path (Path.basic "test")
   471       " -o " ^ File.bash_path compiled_path ^ " -I " ^ File.bash_path path ^ " " ^
   470       in
   472       File.bash_path code_path ^ " " ^ File.bash_path driver_path ^ " </dev/null"
   471        {files = [(driver_path, driver)],
   473 
   472         compile_cmd =
   474     val run_cmd = File.bash_path compiled_path
   473           "\"$ISABELLE_OCAMLFIND\" ocamlopt -w pu -package zarith -linkpkg" ^
   475   in
   474           " -o " ^ File.bash_path compiled_path ^ " -I " ^ File.bash_path path ^ " " ^
   476     {files = [(driver_path, driver)],
   475           File.bash_path code_path ^ " " ^ File.bash_path driver_path ^ " </dev/null",
   477      compile_cmd = SOME compile_cmd, run_cmd = run_cmd, mk_code_file = K code_path}
   476         run_cmd = File.bash_path compiled_path,
   478   end
   477         mk_code_file = K code_path}
   479 
   478       end)
   480 fun evaluate_in_ocaml ctxt =
       
   481   evaluate mk_driver_ocaml (SOME (ISABELLE_OCAMLFIND, "ocamlfind executable")) ocamlN ctxt
       
   482 
   479 
   483 
   480 
   484 (* driver for GHC *)
   481 (* driver for GHC *)
   485 
   482 
   486 val ghcN = "GHC"
   483 val ghcN = "GHC"
   487 val ISABELLE_GHC = "ISABELLE_GHC"
   484 val ISABELLE_GHC = "ISABELLE_GHC"
   488 
   485 
   489 val ghc_options = Attrib.setup_config_string \<^binding>\<open>code_test_ghc\<close> (K "")
   486 val ghc_options = Attrib.setup_config_string \<^binding>\<open>code_test_ghc\<close> (K "")
   490 
   487 
   491 fun mk_driver_ghc ctxt path modules value_name =
   488 val evaluate_in_ghc =
   492   let
   489   evaluate (SOME (ISABELLE_GHC, "GHC executable")) ghcN
   493     val driverN = "Main.hs"
   490     (fn ctxt => fn path => fn modules => fn value_name =>
   494 
   491       let
   495     fun mk_code_file name = Path.append path (Path.basic name)
   492         val driverN = "Main.hs"
   496     val driver_path = Path.append path (Path.basic driverN)
   493 
   497     val driver =
   494         fun mk_code_file name = Path.append path (Path.basic name)
   498       "module Main where {\n" ^
   495         val driver_path = Path.append path (Path.basic driverN)
   499       implode (map (fn module => "import qualified " ^ unsuffix ".hs" module ^ ";\n") modules) ^
   496         val driver =
   500       "main = do {\n" ^
   497           "module Main where {\n" ^
   501       "    let {\n" ^
   498           implode (map (fn module => "import qualified " ^ unsuffix ".hs" module ^ ";\n") modules) ^
   502       "      format_term Nothing = \"\";\n" ^
   499           "main = do {\n" ^
   503       "      format_term (Just t) = t ();\n" ^
   500           "    let {\n" ^
   504       "      format (True, _) = \"" ^ successN ^ "\\n\";\n" ^
   501           "      format_term Nothing = \"\";\n" ^
   505       "      format (False, to) = \"" ^ failureN ^ "\" ++ format_term to ++ \"\\n\";\n" ^
   502           "      format_term (Just t) = t ();\n" ^
   506       "      result = " ^ value_name ^ " ();\n" ^
   503           "      format (True, _) = \"" ^ successN ^ "\\n\";\n" ^
   507       "    };\n" ^
   504           "      format (False, to) = \"" ^ failureN ^ "\" ++ format_term to ++ \"\\n\";\n" ^
   508       "    Prelude.putStr \"" ^ start_markerN ^ "\";\n" ^
   505           "      result = " ^ value_name ^ " ();\n" ^
   509       "    Prelude.mapM_ (putStr . format) result;\n" ^
   506           "    };\n" ^
   510       "    Prelude.putStr \"" ^ end_markerN ^ "\";\n" ^
   507           "    Prelude.putStr \"" ^ start_markerN ^ "\";\n" ^
   511       "  }\n" ^
   508           "    Prelude.mapM_ (putStr . format) result;\n" ^
   512       "}\n"
   509           "    Prelude.putStr \"" ^ end_markerN ^ "\";\n" ^
   513 
   510           "  }\n" ^
   514     val compiled_path = Path.append path (Path.basic "test")
   511           "}\n"
   515     val compile_cmd =
   512 
   516       "\"$ISABELLE_GHC\" " ^ Code_Haskell.language_params ^ " " ^
   513         val compiled_path = Path.append path (Path.basic "test")
   517       Config.get ctxt ghc_options ^ " -o " ^ Bash.string (File.platform_path compiled_path) ^ " " ^
   514       in
   518       Bash.string (File.platform_path driver_path) ^ " -i" ^ Bash.string (File.platform_path path)
   515        {files = [(driver_path, driver)],
   519 
   516         compile_cmd =
   520     val run_cmd = File.bash_path compiled_path
   517           "\"$ISABELLE_GHC\" " ^ Code_Haskell.language_params ^ " " ^
   521   in
   518           Config.get ctxt ghc_options ^ " -o " ^
   522     {files = [(driver_path, driver)],
   519           Bash.string (File.platform_path compiled_path) ^ " " ^
   523      compile_cmd = SOME compile_cmd, run_cmd = run_cmd, mk_code_file = mk_code_file}
   520           Bash.string (File.platform_path driver_path) ^ " -i" ^
   524   end
   521           Bash.string (File.platform_path path),
   525 
   522         run_cmd = File.bash_path compiled_path,
   526 fun evaluate_in_ghc ctxt =
   523         mk_code_file = mk_code_file}
   527   evaluate mk_driver_ghc (SOME (ISABELLE_GHC, "GHC executable")) ghcN ctxt
   524       end)
   528 
   525 
   529 
   526 
   530 (* driver for Scala *)
   527 (* driver for Scala *)
   531 
   528 
   532 val scalaN = "Scala"
   529 val scalaN = "Scala"
   533 
   530 
   534 fun mk_driver_scala _ path _ value_name =
   531 val evaluate_in_scala = evaluate NONE scalaN
   535   let
   532   (fn _ => fn path => fn _ => fn value_name =>
   536     val generatedN = "Generated_Code"
   533     let
   537     val driverN = "Driver.scala"
   534       val generatedN = "Generated_Code"
   538 
   535       val driverN = "Driver.scala"
   539     val code_path = Path.append path (Path.basic (generatedN ^ ".scala"))
   536 
   540     val driver_path = Path.append path (Path.basic driverN)
   537       val code_path = Path.append path (Path.basic (generatedN ^ ".scala"))
   541     val driver =
   538       val driver_path = Path.append path (Path.basic driverN)
   542       "import " ^ generatedN ^ "._\n" ^
   539       val driver =
   543       "object Test {\n" ^
   540         "import " ^ generatedN ^ "._\n" ^
   544       "  def format_term(x : Option[Unit => String]) : String = x match {\n" ^
   541         "object Test {\n" ^
   545       "    case None => \"\"\n" ^
   542         "  def format_term(x : Option[Unit => String]) : String = x match {\n" ^
   546       "    case Some(x) => x(())\n" ^
   543         "    case None => \"\"\n" ^
   547       "  }\n" ^
   544         "    case Some(x) => x(())\n" ^
   548       "  def format(term : (Boolean, Option[Unit => String])) : String = term match {\n" ^
   545         "  }\n" ^
   549       "      case (true, _) => \"True\\n\"\n" ^
   546         "  def format(term : (Boolean, Option[Unit => String])) : String = term match {\n" ^
   550       "      case (false, x) => \"False\" + format_term(x) + \"\\n\"\n" ^
   547         "      case (true, _) => \"True\\n\"\n" ^
   551       "  }\n" ^
   548         "      case (false, x) => \"False\" + format_term(x) + \"\\n\"\n" ^
   552       "  def main(args:Array[String]) = {\n" ^
   549         "  }\n" ^
   553       "    val result = " ^ value_name ^ "(());\n" ^
   550         "  def main(args:Array[String]) = {\n" ^
   554       "    print(\"" ^ start_markerN ^ "\");\n" ^
   551         "    val result = " ^ value_name ^ "(());\n" ^
   555       "    result.map{test:(Boolean, Option[Unit => String]) => print(format(test))};\n" ^
   552         "    print(\"" ^ start_markerN ^ "\");\n" ^
   556       "    print(\"" ^ end_markerN ^ "\");\n" ^
   553         "    result.map{test:(Boolean, Option[Unit => String]) => print(format(test))};\n" ^
   557       "  }\n" ^
   554         "    print(\"" ^ end_markerN ^ "\");\n" ^
   558       "}\n"
   555         "  }\n" ^
   559 
   556         "}\n"
   560     val compile_cmd =
   557     in
   561       "isabelle_scala scalac $ISABELLE_SCALAC_OPTIONS -d " ^ Bash.string (File.platform_path path) ^
   558      {files = [(driver_path, driver)],
   562       " -classpath " ^ Bash.string (File.platform_path path) ^ " " ^
   559       compile_cmd =
   563       Bash.string (File.platform_path code_path) ^ " " ^
   560         "isabelle_scala scalac $ISABELLE_SCALAC_OPTIONS -d " ^ Bash.string (File.platform_path path) ^
   564       Bash.string (File.platform_path driver_path)
   561         " -classpath " ^ Bash.string (File.platform_path path) ^ " " ^
   565 
   562         Bash.string (File.platform_path code_path) ^ " " ^
   566     val run_cmd = "isabelle_scala scala -cp " ^ Bash.string (File.platform_path path) ^ " Test"
   563         Bash.string (File.platform_path driver_path),
   567   in
   564       run_cmd = "isabelle_scala scala -cp " ^ Bash.string (File.platform_path path) ^ " Test",
   568     {files = [(driver_path, driver)],
   565       mk_code_file = K code_path}
   569      compile_cmd = SOME compile_cmd, run_cmd = run_cmd, mk_code_file = K code_path}
   566     end)
   570   end
       
   571 
       
   572 fun evaluate_in_scala ctxt = evaluate mk_driver_scala NONE scalaN ctxt
       
   573 
   567 
   574 
   568 
   575 (* command setup *)
   569 (* command setup *)
   576 
   570 
   577 val _ =
   571 val _ =