snapshot

Author: bobzhang

lib/4.06.1/whole_compiler.ml

@@ -365704,6 +365704,125 @@ let write_ast (type t) ~(sourcefile : string) ~output (kind : t Ml_binary.kind)
   close_out oc 
 
 
+end
+module Cmd_ast_exception
+= struct
+#1 "cmd_ast_exception.ml"
+type error =
+  | CannotRun of string
+  | WrongMagic of string
+
+exception Error of error
+
+
+let report_error ppf = function
+  | CannotRun cmd ->
+      Format.fprintf ppf "Error while running external preprocessor@.\
+                   Command line: %s@." cmd
+  | WrongMagic cmd ->
+      Format.fprintf ppf "External preprocessor does not produce a valid file@.\
+                   Command line: %s@." cmd
+
+let () =
+  Location.register_error_of_exn
+    (function
+      | Error err -> Some (Location.error_of_printer_file report_error err)
+      | _ -> None
+    )
+
+let cannot_run comm = 
+  raise (Error (CannotRun comm))    
+
+let wrong_magic magic = 
+    raise (Error (WrongMagic magic))  
+end
+module Cmd_ppx_apply
+= struct
+#1 "cmd_ppx_apply.ml"
+
+
+(* Note: some of the functions here should go to Ast_mapper instead,
+   which would encapsulate the "binary AST" protocol. *)
+
+let write_ast (type a) (kind : a Ml_binary.kind) fn (ast : a) =
+  let oc = open_out_bin fn in
+  output_string oc (Ml_binary.magic_of_kind kind);
+  output_value oc (!Location.input_name : string);
+  output_value oc (ast : a);
+  close_out oc
+
+let apply_rewriter kind fn_in ppx =
+  let magic = Ml_binary.magic_of_kind kind in
+  let fn_out = Filename.temp_file "camlppx" "" in
+  let comm =
+    Printf.sprintf "%s %s %s" ppx (Filename.quote fn_in) (Filename.quote fn_out)
+  in
+  let ok = Ccomp.command comm = 0 in
+  Misc.remove_file fn_in;
+  if not ok then begin
+    Misc.remove_file fn_out;
+    Cmd_ast_exception.cannot_run comm
+  end;
+  if not (Sys.file_exists fn_out) then
+    Cmd_ast_exception.cannot_run comm;
+  (* check magic before passing to the next ppx *)
+  let ic = open_in_bin fn_out in
+  let buffer =
+    try really_input_string ic (String.length magic) with End_of_file -> "" in
+  close_in ic;
+  if buffer <> magic then begin
+    Misc.remove_file fn_out;
+    Cmd_ast_exception.wrong_magic buffer;
+  end;
+  fn_out
+
+let read_ast (type a) (kind : a Ml_binary.kind) fn : a =
+  let ic = open_in_bin fn in
+  try
+    let magic = Ml_binary.magic_of_kind kind in
+    let buffer = really_input_string ic (String.length magic) in
+    assert(buffer = magic); (* already checked by apply_rewriter *)
+    Location.set_input_name @@ (input_value ic : string);
+    let ast = (input_value ic : a) in
+    close_in ic;
+    Misc.remove_file fn;
+    ast
+  with exn ->
+    close_in ic;
+    Misc.remove_file fn;
+    raise exn
+let rewrite kind ppxs ast =
+  let fn = Filename.temp_file "camlppx" "" in
+  write_ast kind fn ast;
+  let fn = List.fold_left (apply_rewriter kind) fn (List.rev ppxs) in
+  read_ast kind fn
+
+let apply_rewriters_str ?(restore = true) ~tool_name ast =
+  match !Clflags.all_ppx with
+  | [] -> ast
+  | ppxs ->
+    ast
+    |> Ast_mapper.add_ppx_context_str ~tool_name
+    |> rewrite Ml ppxs
+    |> Ast_mapper.drop_ppx_context_str ~restore
+
+let apply_rewriters_sig ?(restore = true) ~tool_name ast =
+  match !Clflags.all_ppx with
+  | [] -> ast
+  | ppxs ->
+    ast
+    |> Ast_mapper.add_ppx_context_sig ~tool_name
+    |> rewrite Mli ppxs
+    |> Ast_mapper.drop_ppx_context_sig ~restore
+
+let apply_rewriters ?restore ~tool_name
+    (type a) (kind : a Ml_binary.kind) (ast : a) : a =
+  match kind with
+  | Ml_binary.Ml ->
+    apply_rewriters_str ?restore ~tool_name ast
+  | Ml_binary.Mli ->
+    apply_rewriters_sig ?restore ~tool_name ast
+
 end
 module Compmisc : sig 
 #1 "compmisc.mli"
@@ -403482,125 +403601,6 @@ let lambda_as_module
     However, use filename instead of {!Env.current_unit} is more honest, since node-js module system is coupled with the file name 
 *)
 
-end
-module Cmd_ast_exception
-= struct
-#1 "cmd_ast_exception.ml"
-type error =
-  | CannotRun of string
-  | WrongMagic of string
-
-exception Error of error
-
-
-let report_error ppf = function
-  | CannotRun cmd ->
-      Format.fprintf ppf "Error while running external preprocessor@.\
-                   Command line: %s@." cmd
-  | WrongMagic cmd ->
-      Format.fprintf ppf "External preprocessor does not produce a valid file@.\
-                   Command line: %s@." cmd
-
-let () =
-  Location.register_error_of_exn
-    (function
-      | Error err -> Some (Location.error_of_printer_file report_error err)
-      | _ -> None
-    )
-
-let cannot_run comm = 
-  raise (Error (CannotRun comm))    
-
-let wrong_magic magic = 
-    raise (Error (WrongMagic magic))  
-end
-module Cmd_ppx_apply
-= struct
-#1 "cmd_ppx_apply.ml"
-
-
-(* Note: some of the functions here should go to Ast_mapper instead,
-   which would encapsulate the "binary AST" protocol. *)
-
-let write_ast (type a) (kind : a Ml_binary.kind) fn (ast : a) =
-  let oc = open_out_bin fn in
-  output_string oc (Ml_binary.magic_of_kind kind);
-  output_value oc (!Location.input_name : string);
-  output_value oc (ast : a);
-  close_out oc
-
-let apply_rewriter kind fn_in ppx =
-  let magic = Ml_binary.magic_of_kind kind in
-  let fn_out = Filename.temp_file "camlppx" "" in
-  let comm =
-    Printf.sprintf "%s %s %s" ppx (Filename.quote fn_in) (Filename.quote fn_out)
-  in
-  let ok = Ccomp.command comm = 0 in
-  Misc.remove_file fn_in;
-  if not ok then begin
-    Misc.remove_file fn_out;
-    Cmd_ast_exception.cannot_run comm
-  end;
-  if not (Sys.file_exists fn_out) then
-    Cmd_ast_exception.cannot_run comm;
-  (* check magic before passing to the next ppx *)
-  let ic = open_in_bin fn_out in
-  let buffer =
-    try really_input_string ic (String.length magic) with End_of_file -> "" in
-  close_in ic;
-  if buffer <> magic then begin
-    Misc.remove_file fn_out;
-    Cmd_ast_exception.wrong_magic buffer;
-  end;
-  fn_out
-
-let read_ast (type a) (kind : a Ml_binary.kind) fn : a =
-  let ic = open_in_bin fn in
-  try
-    let magic = Ml_binary.magic_of_kind kind in
-    let buffer = really_input_string ic (String.length magic) in
-    assert(buffer = magic); (* already checked by apply_rewriter *)
-    Location.set_input_name @@ (input_value ic : string);
-    let ast = (input_value ic : a) in
-    close_in ic;
-    Misc.remove_file fn;
-    ast
-  with exn ->
-    close_in ic;
-    Misc.remove_file fn;
-    raise exn
-let rewrite kind ppxs ast =
-  let fn = Filename.temp_file "camlppx" "" in
-  write_ast kind fn ast;
-  let fn = List.fold_left (apply_rewriter kind) fn (List.rev ppxs) in
-  read_ast kind fn
-
-let apply_rewriters_str ?(restore = true) ~tool_name ast =
-  match !Clflags.all_ppx with
-  | [] -> ast
-  | ppxs ->
-    ast
-    |> Ast_mapper.add_ppx_context_str ~tool_name
-    |> rewrite Ml ppxs
-    |> Ast_mapper.drop_ppx_context_str ~restore
-
-let apply_rewriters_sig ?(restore = true) ~tool_name ast =
-  match !Clflags.all_ppx with
-  | [] -> ast
-  | ppxs ->
-    ast
-    |> Ast_mapper.add_ppx_context_sig ~tool_name
-    |> rewrite Mli ppxs
-    |> Ast_mapper.drop_ppx_context_sig ~restore
-
-let apply_rewriters ?restore ~tool_name
-    (type a) (kind : a Ml_binary.kind) (ast : a) : a =
-  match kind with
-  | Ml_binary.Ml ->
-    apply_rewriters_str ?restore ~tool_name ast
-  | Ml_binary.Mli ->
-    apply_rewriters_sig ?restore ~tool_name ast
-
 end
 module Parse : sig 
 #1 "parse.mli"
@@ -403706,13 +403706,12 @@ module Pparse_driver : sig
 
 val parse_implementation:
   Format.formatter ->
-  tool_name:string ->    
   string -> Parsetree.structure
 
 
 val parse_interface:   
   Format.formatter ->
-  tool_name:string ->    
+
   string -> Parsetree.signature
 
 end = struct
@@ -403792,7 +403791,7 @@ let file_aux ppf  inputfile (type a) (parse_fun  : _ -> a)
 
 
 
-let parse_file kind ppf sourcefile =
+let parse_file (type a) (kind  : a Ml_binary.kind) (ppf : Format.formatter) (sourcefile : string) : a =
   Location.set_input_name  sourcefile;
   let inputfile = preprocess sourcefile in
   let ast =
@@ -403807,12 +403806,12 @@ let parse_file kind ppf sourcefile =
 
 
 
-let parse_implementation ppf ~tool_name sourcefile =  
-  Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name Ml  (parse_file 
+let parse_implementation ppf  sourcefile =  
+  (parse_file 
        Ml ppf sourcefile)
-let parse_interface ppf ~tool_name sourcefile =
-  Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name Mli (parse_file 
-       Mli ppf sourcefile)
+
+let parse_interface ppf  sourcefile =
+  parse_file Mli ppf sourcefile
 
 end
 module Pprintast : sig 
@@ -416077,7 +416076,8 @@ let after_parsing_sig ppf  outputprefix ast  =
 
 let interface ppf fname outputprefix =
   Compmisc.init_path false;
-  Pparse_driver.parse_interface ~tool_name:Js_config.tool_name ppf fname
+  Pparse_driver.parse_interface  ppf 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
   |> print_if_pipe ppf Clflags.dump_source Pprintast.signature 
@@ -416174,8 +416174,9 @@ let after_parsing_impl ppf  outputprefix (ast : Parsetree.structure) =
       process_with_gentype (outputprefix ^ ".cmt")        
     end
 let implementation ppf fname outputprefix =
-  Compmisc.init_path false;
-  Pparse_driver.parse_implementation ~tool_name:Js_config.tool_name ppf fname
+  Compmisc.init_path false;  
+  Pparse_driver.parse_implementation  ppf 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
   |> print_if_pipe ppf Clflags.dump_source Pprintast.structure