Merge pull request #4472 from BuckleScript/pluggable_parser

make parser pluggable

Author: bobzhang

jscomp/core/js_implementation.ml

@@ -101,9 +101,9 @@ let after_parsing_sig ppf  outputprefix ast  =
 
 
 
-let interface ppf fname outputprefix =
+let interface ~parser ppf fname outputprefix =
   Compmisc.init_path false;
-  Pparse_driver.parse_interface  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
@@ -200,9 +200,9 @@ let after_parsing_impl ppf  outputprefix (ast : Parsetree.structure) =
       end;
       process_with_gentype (outputprefix ^ ".cmt")        
     end
-let implementation ppf fname outputprefix =
+let implementation ~parser ppf fname outputprefix  =
   Compmisc.init_path false;  
-  Pparse_driver.parse_implementation  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

jscomp/core/js_implementation.mli

@@ -35,7 +35,12 @@
     given [filename] and [outputprefix], 
     it will be useful if we don't care about bytecode output(generating js only).
  *)
-val interface : Format.formatter -> string -> string -> unit
+val interface : 
+  parser:(string -> Parsetree.signature) ->
+  Format.formatter -> 
+  string -> 
+  string -> 
+  unit
 
 val interface_mliast : Format.formatter -> string -> string  -> unit
 
@@ -51,7 +56,12 @@ val interface_mliast : Format.formatter -> string -> string  -> unit
     Used in eval
 *)
 
-val implementation : Format.formatter -> string -> string -> unit
+val implementation : 
+  parser:(string -> Parsetree.structure) ->
+  Format.formatter -> 
+  string -> 
+  string -> 
+  unit
 (** [implementation ppf sourcefile outprefix] compiles to JS directly *) 
 
 val implementation_mlast : Format.formatter -> string -> string -> unit

jscomp/core/pparse_driver.ml

@@ -22,9 +22,8 @@ let preprocess sourcefile =
 
 
 let remove_preprocessed inputfile =
-  match !Clflags.preprocessor with
-    None -> ()
-  | Some _ -> Misc.remove_file inputfile
+  if !Clflags.preprocessor <> None then  
+    Misc.remove_file inputfile
 
 
 
@@ -33,12 +32,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
@@ -53,10 +52,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
@@ -73,12 +68,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
@@ -88,9 +83,8 @@ 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

jscomp/core/pparse_driver.mli

@@ -1,11 +1,8 @@
 
 
-val parse_implementation:
-  Format.formatter ->
+val parse_implementation:  
   string -> Parsetree.structure
 
 
 val parse_interface:   
-  Format.formatter ->
-
   string -> Parsetree.signature

jscomp/main/js_main.ml

@@ -12,22 +12,45 @@
 
 
 let process_interface_file ppf name =
-  Js_implementation.interface ppf name (Compenv.output_prefix name)
+  Js_implementation.interface ppf name 
+  ~parser:Pparse_driver.parse_interface
+  (Compenv.output_prefix name)
 let process_implementation_file ppf name =
-  Js_implementation.implementation ppf name (Compenv.output_prefix name)
+  Js_implementation.implementation ppf name 
+  ~parser:Pparse_driver.parse_implementation
+  (Compenv.output_prefix name)
 
 
 let setup_reason_context () = 
   Js_config.is_reason := true;
-  Clflags.preprocessor := None ; 
-  (* FIX #3988 - Don't run pp-flags on Reason files to make napkin easier*)
   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
@@ -78,16 +101,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 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 ppf  tmpfile opref ;
-    Ast_reason_pp.clean tmpfile
+    handle_reason Mli sourcefile ppf opref 
   | Reiast 
     -> 
     setup_reason_context ();
@@ -97,9 +113,13 @@ let process_file ppf sourcefile =
     setup_reason_context ();
     Js_implementation.implementation_mlast ppf sourcefile opref
   | Ml ->
-    Js_implementation.implementation ppf sourcefile opref 
+    Js_implementation.implementation 
+    ~parser:Pparse_driver.parse_implementation
+    ppf sourcefile opref 
   | Mli  ->   
-    Js_implementation.interface ppf sourcefile opref   
+    Js_implementation.interface 
+    ~parser:Pparse_driver.parse_interface
+    ppf sourcefile opref   
   | Mliast 
     -> Js_implementation.interface_mliast ppf sourcefile opref 
   | Mlast