snapshot

Author: bobzhang

lib/4.06.1/whole_compiler.ml

@@ -415736,7 +415736,7 @@ module Js_implementation : sig
     it will be useful if we don't care about bytecode output(generating js only).
  *)
 val interface : 
-  parser:(Format.formatter -> string -> Parsetree.signature) ->
+  parser:(string -> Parsetree.signature) ->
   Format.formatter -> 
   string -> 
   string -> 
@@ -415757,7 +415757,7 @@ val interface_mliast : Format.formatter -> string -> string  -> unit
 *)
 
 val implementation : 
-  parser:(Format.formatter -> string -> Parsetree.structure) ->
+  parser:(string -> Parsetree.structure) ->
   Format.formatter -> 
   string -> 
   string -> 
@@ -415874,7 +415874,7 @@ let after_parsing_sig ppf  outputprefix ast  =
 
 let interface ~parser ppf fname outputprefix =
   Compmisc.init_path false;
-  parser ppf fname
+  parser fname
   |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name Mli 
   |> Ppx_entry.rewrite_signature
   |> print_if_pipe ppf Clflags.dump_parsetree Printast.interface
@@ -415973,7 +415973,7 @@ let after_parsing_impl ppf  outputprefix (ast : Parsetree.structure) =
     end
 let implementation ~parser ppf fname outputprefix  =
   Compmisc.init_path false;  
-  parser ppf fname
+  parser fname
   |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name Ml  
   |> Ppx_entry.rewrite_implementation
   |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation
@@ -416531,14 +416531,11 @@ module Pparse_driver : sig
 #1 "pparse_driver.mli"
 
 
-val parse_implementation:
-  Format.formatter ->
+val parse_implementation:  
   string -> Parsetree.structure
 
 
 val parse_interface:   
-  Format.formatter ->
-
   string -> Parsetree.signature
 
 end = struct
@@ -416577,12 +416574,12 @@ let remove_preprocessed inputfile =
 
 (* Parse a file or get a dumped syntax tree from it *)
 
-let parse (type a) (kind : a Ml_binary.kind) lexbuf : a =
+let parse (type a) (kind : a Ml_binary.kind) : _ -> a =
   match kind with
-  | Ml_binary.Ml -> Parse.implementation lexbuf
-  | Ml_binary.Mli -> Parse.interface lexbuf
+  | Ml_binary.Ml -> Parse.implementation 
+  | Ml_binary.Mli -> Parse.interface 
 
-let file_aux ppf  inputfile (type a) (parse_fun  : _ -> a)
+let file_aux  inputfile (type a) (parse_fun  : _ -> a)
              (kind : a Ml_binary.kind) : a  =
   let ast_magic = Ml_binary.magic_of_kind kind in
   let ic = open_in_bin inputfile in
@@ -416597,10 +416594,6 @@ let file_aux ppf  inputfile (type a) (parse_fun  : _ -> a)
   let ast =
     try
       if is_ast_file then begin
-        if !Clflags.fast then
-          (* FIXME make this a proper warning *)
-          Format.fprintf ppf "@[Warning: %s@]@."
-            "option -unsafe used with a preprocessor returning a syntax tree";
         Location.set_input_name (input_value ic : string);
         (input_value ic : a)
       end else begin
@@ -416617,12 +416610,12 @@ let file_aux ppf  inputfile (type a) (parse_fun  : _ -> a)
 
 
 
-let parse_file (type a) (kind  : a Ml_binary.kind) (ppf : Format.formatter) (sourcefile : string) : a =
+let parse_file (type a) (kind  : a Ml_binary.kind) (sourcefile : string) : a =
   Location.set_input_name  sourcefile;
   let inputfile = preprocess sourcefile in
   let ast =
     try 
-      (file_aux ppf  inputfile (parse kind)  kind)
+      (file_aux   inputfile (parse kind)  kind)
     with exn ->
       remove_preprocessed inputfile;
       raise exn
@@ -416632,11 +416625,11 @@ let parse_file (type a) (kind  : a Ml_binary.kind) (ppf : Format.formatter) (sou
 
 
 
-let parse_implementation ppf  sourcefile =  
-  parse_file Ml ppf sourcefile
+let parse_implementation sourcefile =  
+  parse_file Ml sourcefile
 
-let parse_interface ppf  sourcefile =
-  parse_file Mli ppf sourcefile
+let parse_interface  sourcefile =
+  parse_file Mli sourcefile
 
 end
 module Ppx_apply
@@ -418961,10 +418954,31 @@ let setup_reason_context () =
   Lazy.force Super_main.setup;  
   Lazy.force Reason_outcome_printer_main.setup
 
-let reason_pp ~sourcefile  = 
+
+let handle_reason (type a) (kind : a Ml_binary.kind) sourcefile ppf opref = 
   setup_reason_context ();
-  Ast_reason_pp.pp sourcefile
+  let tmpfile =  Ast_reason_pp.pp sourcefile in   
+  (match kind with 
+   | Ml_binary.Ml -> 
+     Js_implementation.implementation
+       ~parser:(fun file_in -> 
+           let in_chan = open_in_bin file_in in 
+           let ast = Ml_binary.read_ast Ml in_chan in 
+           close_in in_chan; ast 
+         )
+       ppf  tmpfile opref    
+
+   | Ml_binary.Mli ->
+     Js_implementation.interface 
+       ~parser:(fun file_in -> 
+           let in_chan = open_in_bin file_in in 
+           let ast = Ml_binary.read_ast Mli in_chan in 
+           close_in in_chan; ast 
+         )
+       ppf  tmpfile opref ;    );
+  Ast_reason_pp.clean tmpfile 
 
+  
 type valid_input = 
   | Ml 
   | Mli
@@ -419015,28 +419029,9 @@ let process_file ppf sourcefile =
     | _ -> raise(Arg.Bad("don't know what to do with " ^ sourcefile)) in 
   let opref = Compenv.output_prefix sourcefile in 
   match input with 
-  | Re ->     
-    setup_reason_context ();
-    let tmpfile = reason_pp ~sourcefile in 
-    Js_implementation.implementation 
-      ~parser:(fun _ file_in -> 
-          let in_chan = open_in_bin file_in in   
-          let ast = Ml_binary.read_ast Ml in_chan in 
-          close_in in_chan; ast 
-        )
-      ppf tmpfile opref ;  
-    Ast_reason_pp.clean tmpfile
+  | Re -> handle_reason Ml sourcefile ppf opref     
   | Rei ->
-    setup_reason_context ();
-    let tmpfile = reason_pp ~sourcefile in 
-    Js_implementation.interface 
-      ~parser:(fun _ file_in -> 
-          let in_chan = open_in_bin file_in in 
-          let ast = Ml_binary.read_ast Mli in_chan in 
-          close_in in_chan; ast 
-        )
-      ppf  tmpfile opref ;    
-    Ast_reason_pp.clean tmpfile
+    handle_reason Mli sourcefile ppf opref 
   | Reiast 
     -> 
     setup_reason_context ();