fix(windows): don't write binary on stdout

jscomp/core/dune

@@ -156,23 +156,44 @@
  (action
   (with-stdout-to
    %{targets}
-   (run ./gen/gen_traversal.exe --input %{deps} --mode record-iter))))
+   (run
+    ./gen/gen_traversal.exe
+    --input
+    %{deps}
+    --output
+    %{targets}
+    --mode
+    record-iter))))
 
 (rule
  (targets js_record_map.ml)
  (deps j.mli)
  (action
   (with-stdout-to
    %{targets}
-   (run ./gen/gen_traversal.exe --input %{deps} --mode record-map))))
+   (run
+    ./gen/gen_traversal.exe
+    --input
+    %{deps}
+    --output
+    %{targets}
+    --mode
+    record-map))))
 
 (rule
  (targets js_record_fold.ml)
  (deps j.mli)
  (action
   (with-stdout-to
    %{targets}
-   (run ./gen/gen_traversal.exe --input %{deps} --mode record-fold))))
+   (run
+    ./gen/gen_traversal.exe
+    --input
+    %{deps}
+    --output
+    %{targets}
+    --mode
+    record-fold))))
 
 (rule
  (targets git_commit.ml)

jscomp/core/gen/gen_traversal.ml

@@ -1,27 +1,24 @@
 let parse fname =
-  let module In_ch = struct
-    let create ?(binary = true) file =
-      let flags = [ Open_rdonly ] in
-      let flags = if binary then Open_binary :: flags else flags in
-      open_in_gen flags 0o000 file
-
-    let with_file ?binary filename ~f =
-      let t = create ?binary filename in
-      Fun.protect ~finally:(fun () -> close_in t) (fun () -> f t)
-  end in
-  In_ch.with_file fname ~f:(fun ch ->
-      let lexbuf = Lexing.from_channel ch in
+  let t = open_in_bin fname in
+  Fun.protect
+    ~finally:(fun () -> close_in t)
+    (fun () ->
+      let lexbuf = Lexing.from_channel t in
       let ast = Parse.interface lexbuf in
       ast)
 
-let write_ast oc ~input_name ast =
-  output_string oc Config.ast_impl_magic_number;
-  output_value oc input_name;
-  output_value oc (Ppxlib_ast.Selected_ast.To_ocaml.copy_structure ast)
+let write_ast ~input_name output_name ast =
+  let oc = open_out_bin output_name in
+  Fun.protect
+    ~finally:(fun () -> close_out oc)
+    (fun () ->
+      output_string oc Config.ast_impl_magic_number;
+      output_value oc input_name;
+      output_value oc (Ppxlib_ast.Selected_ast.To_ocaml.copy_structure ast))
 
 type mode = Record_iter | Record_map | Record_fold
 
-let main mode input =
+let main mode input output =
   let ast = parse input in
   let typedefs = Node_types.get_type_defs ast in
   let new_ast =
@@ -30,8 +27,7 @@ let main mode input =
     | Record_map -> Record_map.make typedefs
     | Record_fold -> Record_fold.make typedefs
   in
-  let oc = stdout in
-  write_ast oc ~input_name:input new_ast
+  write_ast ~input_name:input output new_ast
 
 let mode =
   let open Cmdliner in
@@ -59,12 +55,16 @@ let input =
   let open Cmdliner in
   Arg.(required & opt (some string) None & info [ "input" ] ~docv:"FILE")
 
+let output =
+  let open Cmdliner in
+  Arg.(required & opt (some string) None & info [ "output" ] ~docv:"FILE")
+
 let () =
   let open Cmdliner in
   let cmd =
     let doc = "Record iter / map / fold code generator" in
     let info = Cmd.info "main" ~version:"v0.0.0" ~doc in
-    let term = Term.(const main $ mode $ input) in
+    let term = Term.(const main $ mode $ input $ output) in
     Cmd.v info term
   in
   exit (Cmd.eval cmd)

jscomp/melstd/dune

@@ -11,7 +11,7 @@
  (action
   (with-stdout-to
    %{targets}
-   (run ./gen/build_reserved.exe %{deps}))))
+   (run ./gen/build_reserved.exe %{deps} %{targets}))))
 
 (rule
  (targets hash_set_string.ml)

jscomp/melstd/gen/build_reserved.ml

@@ -227,7 +227,7 @@ let write_ast oc ast =
   output_value oc "reserved_keywords.ml";
   output_value oc (Ppxlib_ast.Selected_ast.To_ocaml.copy_structure ast)
 
-let main keyword_file =
+let main keyword_file output_name =
   let ast =
     let keywords_array =
       let ss = Reserved_words.all_from_file keyword_file in
@@ -243,7 +243,7 @@ let main keyword_file =
     in
     keywords_array :: binary_search
   in
-  let oc = stdout in
+  let oc = open_out_bin output_name in
   write_ast oc ast;
   close_out oc
 
@@ -253,4 +253,4 @@ for i = 0 to Array.length Sys.argv - 1  do
   print_endline ">"; print_string Sys.argv.(i)
 done
 ;; *)
-let () = main Sys.argv.(1)
+let () = main Sys.argv.(1) Sys.argv.(2)