diff --git a/build_system/clerk_driver.ml b/build_system/clerk_driver.ml index cf70c164..d3496094 100644 --- a/build_system/clerk_driver.ml +++ b/build_system/clerk_driver.ml @@ -228,7 +228,7 @@ let add_reset_rules_aux Var "tested_file"; Var "extra_flags"; Lit "--unstyled"; - Lit "--output=/dev/stdout"; + Lit "--output=-"; Lit redirect; Var "expected_output"; Lit "2>&1"; diff --git a/compiler/driver.ml b/compiler/driver.ml index 87bbf1b9..d1226db5 100644 --- a/compiler/driver.ml +++ b/compiler/driver.ml @@ -81,6 +81,21 @@ let driver source_file (options : Cli.options) : int = Surface.Parser_driver.parse_top_level_file source_file language in let prgm = Surface.Fill_positions.fill_pos_with_legislative_info prgm in + let get_output ?ext () = + match options.output_file, ext with + | Some "-", _ | None, None -> None, fun f -> f stdout + | Some f, _ -> Some f, File.with_out_channel f + | None, Some ext -> + let src = + match source_file with FileName f -> f | Contents _ -> "a" + in + let f = Filename.remove_extension src ^ ext in + Some f, File.with_out_channel f + in + let get_output_format ?ext () = + let f, with_ = get_output ?ext () in + f, fun f -> with_ (fun oc -> File.with_formatter_of_out_channel oc f) + in (match backend with | `Makefile -> let backend_extensions_list = [".tex"] in @@ -91,40 +106,26 @@ let driver source_file (options : Cli.options) : int = Errors.raise_error "The Makefile backend does not work if the input is not a file" in - let output_file = - match options.output_file with - | Some f -> f - | None -> Filename.remove_extension source_file ^ ".d" - in - Cli.debug_print "Writing list of dependencies to %s..." output_file; - File.with_out_channel output_file @@ fun oc -> + let output_file, with_output = get_output ~ext:".d" () in + Cli.debug_print "Writing list of dependencies to %s..." + (Option.value ~default:"stdout" output_file); + with_output @@ fun oc -> Printf.fprintf oc "%s:\\\n%s\n%s:" (String.concat "\\\n" - (output_file + (Option.value ~default:"stdout" output_file :: List.map (fun ext -> Filename.remove_extension source_file ^ ext) backend_extensions_list)) (String.concat "\\\n" prgm.program_source_files) (String.concat "\\\n" prgm.program_source_files) | (`Latex | `Html) as backend -> - let source_file = - match source_file with - | FileName f -> f - | Contents _ -> - Errors.raise_error - "The literate programming backends do not work if the input is not \ - a file" - in Cli.debug_print "Weaving literate program into %s" (match backend with `Latex -> "LaTeX" | `Html -> "HTML"); - let output_file = - match options.output_file with - | Some f -> f - | None -> ( - Filename.remove_extension source_file - ^ match backend with `Latex -> ".tex" | `Html -> ".html") + let output_file, with_output = + get_output_format () + ~ext:(match backend with `Latex -> ".tex" | `Html -> ".html") in - File.with_formatter_of_file output_file (fun fmt -> + with_output (fun fmt -> let weave_output = match backend with | `Latex -> @@ -134,7 +135,8 @@ let driver source_file (options : Cli.options) : int = Literate.Html.ast_to_html language ~print_only_law:options.print_only_law in - Cli.debug_print "Writing to %s" output_file; + Cli.debug_print "Writing to %s" + (Option.value ~default:"stdout" output_file); if options.wrap_weaved_output then match backend with | `Latex -> @@ -170,7 +172,8 @@ let driver source_file (options : Cli.options) : int = let prgm = Desugared.Desugared_to_scope.translate_program prgm in match backend with | `Scopelang -> - File.with_formatter_of_opt_file options.output_file @@ fun fmt -> + let _output_file, with_output = get_output_format () in + with_output @@ fun fmt -> if Option.is_some options.ex_scope then Format.fprintf fmt "%a\n" (Scopelang.Print.format_scope ~debug:options.debug) @@ -198,7 +201,8 @@ let driver source_file (options : Cli.options) : int = in match backend with | `Dcalc -> - File.with_formatter_of_opt_file options.output_file @@ fun fmt -> + let _output_file, with_output = get_output_format () in + with_output @@ fun fmt -> if Option.is_some options.ex_scope then Format.fprintf fmt "%a\n" (Dcalc.Print.format_scope ~debug:options.debug prgm.decl_ctx) @@ -289,7 +293,8 @@ let driver source_file (options : Cli.options) : int = in match backend with | `Lcalc -> - File.with_formatter_of_opt_file options.output_file @@ fun fmt -> + let _output_file, with_output = get_output_format () in + with_output @@ fun fmt -> if Option.is_some options.ex_scope then Format.fprintf fmt "%a\n" (Lcalc.Print.format_scope ~debug:options.debug prgm.decl_ctx) @@ -315,38 +320,29 @@ let driver source_file (options : Cli.options) : int = i + 1) prgm.scopes) | (`OCaml | `Python | `Scalc | `Plugin _) as backend -> ( - let source_file = - match source_file with - | FileName f -> f - | Contents _ -> - Errors.raise_error - "This backend does not work if the input is not a file" - in - let new_output_file (extension : string) : string = - match options.output_file with - | Some f -> f - | None -> Filename.remove_extension source_file ^ extension - in match backend with | `OCaml -> - let output_file = new_output_file ".ml" in - File.with_out_channel output_file @@ fun oc -> - let fmt = Format.formatter_of_out_channel oc in + let output_file, with_output = + get_output_format ~ext:".ml" () + in + with_output @@ fun fmt -> Cli.debug_print "Compiling program into OCaml..."; - Cli.debug_print "Writing to %s..." output_file; + Cli.debug_print "Writing to %s..." + (Option.value ~default:"stdout" output_file); Lcalc.To_ocaml.format_program fmt prgm type_ordering | `Plugin (Plugin.Lcalc p) -> - let output_file = new_output_file p.Plugin.extension in + let output_file, _ = get_output ~ext:p.Plugin.extension () in Cli.debug_print "Compiling program through backend \"%s\"..." p.Plugin.name; - Cli.debug_print "Writing to %s..." output_file; + Cli.debug_print "Writing to %s..." + (Option.value ~default:"stdout" output_file); p.Plugin.apply output_file prgm type_ordering | (`Python | `Scalc | `Plugin (Plugin.Scalc _)) as backend -> ( let prgm = Scalc.Compile_from_lambda.translate_program prgm in match backend with | `Scalc -> - File.with_formatter_of_opt_file options.output_file - @@ fun fmt -> + let _output_file, with_output = get_output_format () in + with_output @@ fun fmt -> if Option.is_some options.ex_scope then Format.fprintf fmt "%a\n" (Scalc.Print.format_scope ~debug:options.debug @@ -363,18 +359,21 @@ let driver source_file (options : Cli.options) : int = (Scalc.Print.format_scope prgm.decl_ctx) fmt scope)) prgm.scopes | `Python -> - let output_file = new_output_file ".py" in + let output_file, with_output = + get_output_format ~ext:".py" () + in Cli.debug_print "Compiling program into Python..."; - Cli.debug_print "Writing to %s..." output_file; - File.with_out_channel output_file @@ fun oc -> - let fmt = Format.formatter_of_out_channel oc in + Cli.debug_print "Writing to %s..." + (Option.value ~default:"stdout" output_file); + with_output @@ fun fmt -> Scalc.To_python.format_program fmt prgm type_ordering | `Plugin (Plugin.Lcalc _) -> assert false | `Plugin (Plugin.Scalc p) -> - let output_file = new_output_file p.Plugin.extension in + let output_file, _ = get_output ~ext:p.Plugin.extension () in Cli.debug_print "Compiling program through backend \"%s\"..." p.Plugin.name; - Cli.debug_print "Writing to %s..." output_file; + Cli.debug_print "Writing to %s..." + (Option.value ~default:"stdout" output_file); p.Plugin.apply output_file prgm type_ordering))))))); 0 with diff --git a/compiler/plugin.ml b/compiler/plugin.ml index a43f8487..482f6936 100644 --- a/compiler/plugin.ml +++ b/compiler/plugin.ml @@ -17,7 +17,7 @@ type 'ast gen = { name : string; extension : string; - apply : string -> 'ast -> Scopelang.Dependency.TVertex.t list -> unit; + apply : string option -> 'ast -> Scopelang.Dependency.TVertex.t list -> unit; } type t = Lcalc of Lcalc.Ast.program gen | Scalc of Scalc.Ast.program gen diff --git a/compiler/plugin.mli b/compiler/plugin.mli index 2e39d712..59ec7bed 100644 --- a/compiler/plugin.mli +++ b/compiler/plugin.mli @@ -19,7 +19,7 @@ type 'ast gen = { name : string; extension : string; - apply : string -> 'ast -> Scopelang.Dependency.TVertex.t list -> unit; + apply : string option -> 'ast -> Scopelang.Dependency.TVertex.t list -> unit; } type t = Lcalc of Lcalc.Ast.program gen | Scalc of Scalc.Ast.program gen @@ -39,13 +39,19 @@ module PluginAPI : sig val register_lcalc : name:string -> extension:string -> - (string -> Lcalc.Ast.program -> Scopelang.Dependency.TVertex.t list -> unit) -> + (string option -> + Lcalc.Ast.program -> + Scopelang.Dependency.TVertex.t list -> + unit) -> unit val register_scalc : name:string -> extension:string -> - (string -> Scalc.Ast.program -> Scopelang.Dependency.TVertex.t list -> unit) -> + (string option -> + Scalc.Ast.program -> + Scopelang.Dependency.TVertex.t list -> + unit) -> unit end diff --git a/compiler/plugins/jsoo.ml b/compiler/plugins/jsoo.ml index 40349eb6..ef4aea12 100644 --- a/compiler/plugins/jsoo.ml +++ b/compiler/plugins/jsoo.ml @@ -50,27 +50,29 @@ let with_temp_file pfx sfx f = let apply output_file prgm type_ordering = with_temp_file "catala_jsoo_" ".ml" @@ fun ml_file -> - with_open_out ml_file (fun oc -> - Lcalc.To_ocaml.format_program - (Format.formatter_of_out_channel oc) - prgm type_ordering; - with_temp_file "catala_jsoo_" ".byte" @@ fun bytecode_file -> - if - Sys.command - (Printf.sprintf - "ocamlfind ocamlc -package catala.runtime -linkpkg %S -o %S" - ml_file bytecode_file) - <> 0 - then failwith "ocaml err"; - Utils.Cli.debug_print "OCaml compil ok"; - if - Sys.command - (Printf.sprintf - "js_of_ocaml +zarith_stubs_js/biginteger.js \ - +zarith_stubs_js/runtime.js %S -o %S" - bytecode_file output_file) - <> 0 - then failwith "jsoo err"; - Utils.Cli.debug_print "Jsoo compil ok, output in %s" output_file) + Utils.File.with_formatter_of_opt_file output_file @@ fun fmt -> + Lcalc.To_ocaml.format_program fmt prgm type_ordering; + with_temp_file "catala_jsoo_" ".byte" @@ fun bytecode_file -> + if + Sys.command + (Printf.sprintf + "ocamlfind ocamlc -package catala.runtime -linkpkg %S -o %S" ml_file + bytecode_file) + <> 0 + then failwith "ocaml err"; + Utils.Cli.debug_print "OCaml compil ok"; + let out_arg = + match output_file with Some f -> Printf.sprintf "%S" f | None -> "-" + in + if + Sys.command + (Printf.sprintf + "js_of_ocaml +zarith_stubs_js/biginteger.js \ + +zarith_stubs_js/runtime.js %S -o %s" + bytecode_file out_arg) + <> 0 + then failwith "jsoo err"; + Utils.Cli.debug_print "Jsoo compil ok, output in %s" + (Option.value ~default:"stdout" output_file) let () = Driver.Plugin.register_lcalc ~name ~extension apply diff --git a/compiler/plugins/python.ml b/compiler/plugins/python.ml index 1a7d9efe..9cb7ed06 100644 --- a/compiler/plugins/python.ml +++ b/compiler/plugins/python.ml @@ -24,9 +24,7 @@ let name = "python-plugin" let extension = ".py" let apply output_file prgm type_ordering = - let oc = open_out output_file in - let fmt = Format.formatter_of_out_channel oc in - Scalc.To_python.format_program fmt prgm type_ordering; - close_out oc + Utils.File.with_formatter_of_opt_file output_file @@ fun fmt -> + Scalc.To_python.format_program fmt prgm type_ordering let () = Driver.Plugin.register_scalc ~name ~extension apply diff --git a/compiler/utils/cli.ml b/compiler/utils/cli.ml index b68f32ea..9f52873a 100644 --- a/compiler/utils/cli.ml +++ b/compiler/utils/cli.ml @@ -196,7 +196,7 @@ let output = ~doc: "$(i, OUTPUT) is the file that will contain the output of the \ compiler. Defaults to $(i,FILE).$(i,EXT) where $(i,EXT) depends on \ - the chosen backend.") + the chosen backend. Use $(b,-o -) for stdout.") type options = { debug : bool;