Merge pull request #4751 from rescript-lang/iast_ast

only .ast and .iast for binary ast extensions

Author: bobzhang

jscomp/bsb/bsb_ninja_file_groups.ml

@@ -50,30 +50,21 @@ let handle_generators oc
 
 type suffixes = {
   impl : string;
-  intf : string ; 
-  impl_ast : string;
-  intf_ast : string;  
+  intf : string   
 }
 
 let re_suffixes = {
   impl  = Literals.suffix_re;
   intf = Literals.suffix_rei;
-  impl_ast = Literals.suffix_reast;
-  intf_ast = Literals.suffix_reiast;
-
 }
 
 let ml_suffixes = {
   impl = Literals.suffix_ml;
   intf = Literals.suffix_mli;
-  impl_ast = Literals.suffix_mlast;
-  intf_ast = Literals.suffix_mliast
 }
 let res_suffixes = {
   impl = Literals.suffix_res;
   intf = Literals.suffix_resi;
-  impl_ast = Literals.suffix_resast;
-  intf_ast = Literals.suffix_resiast
 }
 let emit_module_build
     (rules : Bsb_ninja_rule.builtin)  
@@ -93,8 +84,8 @@ let emit_module_build
   let filename_sans_extension = module_info.name_sans_extension in 
   let input_impl = Bsb_config.proj_rel (filename_sans_extension ^ config.impl ) in
   let input_intf = Bsb_config.proj_rel (filename_sans_extension ^ config.intf) in
-  let output_mlast = filename_sans_extension  ^ config.impl_ast in
-  let output_mliast = filename_sans_extension  ^ config.intf_ast in
+  let output_ast = filename_sans_extension  ^ Literals.suffix_ast in
+  let output_iast = filename_sans_extension  ^ Literals.suffix_iast in
   let output_d = filename_sans_extension ^ Literals.suffix_d in
   let output_filename_sans_extension =  
       Ext_namespace_encode.make ?ns:namespace filename_sans_extension
@@ -105,18 +96,18 @@ let emit_module_build
     Bsb_package_specs.get_list_of_output_js package_specs output_filename_sans_extension in 
 
   Bsb_ninja_targets.output_build oc
-    ~outputs:[output_mlast]
+    ~outputs:[output_ast]
     ~inputs:[input_impl]
     ~rule:ast_rule;
   Bsb_ninja_targets.output_build
     oc
     ~outputs:[output_d]
-    ~inputs:(if has_intf_file then [output_mlast;output_mliast] else [output_mlast] )
+    ~inputs:(if has_intf_file then [output_ast;output_iast] else [output_ast] )
     ~rule:(if is_dev then rules.build_bin_deps_dev else rules.build_bin_deps)
   ;  
   if has_intf_file then begin           
     Bsb_ninja_targets.output_build oc
-      ~outputs:[output_mliast]
+      ~outputs:[output_iast]
       (* TODO: we can get rid of absloute path if we fixed the location to be 
           [lib/bs], better for testing?
       *)
@@ -126,7 +117,7 @@ let emit_module_build
     Bsb_ninja_targets.output_build oc
       ~outputs:[output_cmi]
       ~order_only_deps:[output_d]
-      ~inputs:[output_mliast]
+      ~inputs:[output_iast]
       ~rule:(if is_dev then rules.mi_dev else rules.mi)
     ;
   end;
@@ -143,7 +134,7 @@ let emit_module_build
     ~outputs:[output_cmj]
     ~implicit_outputs:  
       (if has_intf_file then output_js else output_cmi::output_js )
-    ~inputs:[output_mlast]
+    ~inputs:[output_ast]
     ~implicit_deps:(if has_intf_file then [output_cmi] else [] )
     ~order_only_deps:[output_d]
     ~rule

jscomp/build_tests/scoped_ppx/input.js

@@ -2,7 +2,7 @@ var cp = require("child_process");
 var assert = require('assert')
 cp.execSync(`bsb`, { cwd: __dirname, stdio: [0, 1, 2], encoding: "utf8" });
 
-var output = cp.execSync(`bsb -- -t commands src/hello.mlast`, {
+var output = cp.execSync(`bsb -- -t commands src/hello.ast`, {
   cwd: __dirname,
   encoding: "utf8"
 });

jscomp/common/ml_binary.ml

@@ -55,13 +55,3 @@ let magic_of_kind : type a . a kind -> string = function
   | Mli -> Config.ast_intf_magic_number
 
 
-let read_my_ast (type t ) (_ : t  kind) ic : t  =
-  Location.set_input_name (input_line ic);
-  input_value ic 
-
-let write_my_ast (type t) ( _ : t kind)
-    (fname : string)
-    (pt : t) oc = 
-  output_string oc fname;
-  output_char oc '\n';
-  output_value oc pt

jscomp/common/ml_binary.mli

@@ -39,14 +39,3 @@ val write_ast :
 
 val magic_of_kind : 'a kind -> string   
 
-val read_my_ast : 
-  'a kind ->
-  in_channel ->
-   'a
-
-val write_my_ast : 
-  'a kind -> 
-   string -> 
-   'a -> 
-   out_channel -> 
-   unit

jscomp/core/js_implementation.ml

@@ -62,7 +62,7 @@ let after_parsing_sig ppf  outputprefix ast  =
       Binary_ast.write_ast
         Mli
         ~sourcefile
-        ~output:(outputprefix ^ Filename.extension sourcefile ^ "ast")
+        ~output:(outputprefix ^  Literals.suffix_iast)
         (* to support relocate to another directory *)
         ast 
 
@@ -111,9 +111,9 @@ let interface ~parser ppf fname outputprefix =
   |> print_if_pipe ppf Clflags.dump_source Pprintast.signature 
   |> after_parsing_sig ppf  outputprefix 
 
-let interface_mliast ppf fname outputprefix  = 
+let interface_mliast ppf fname outputprefix  setup = 
   Res_compmisc.init_path ();
-  Binary_ast.read_ast Mli fname 
+  Binary_ast.read_ast_exn ~fname Mli  setup
   |> print_if_pipe ppf Clflags.dump_parsetree Printast.interface
   |> print_if_pipe ppf Clflags.dump_source Pprintast.signature 
   |> after_parsing_sig ppf  outputprefix 
@@ -163,7 +163,7 @@ let after_parsing_impl ppf  outputprefix (ast : Parsetree.structure) =
   if !Js_config.binary_ast then begin 
     let sourcefile = !Location.input_name in 
     Binary_ast.write_ast ~sourcefile
-      Ml ~output:(outputprefix ^ Filename.extension sourcefile ^ "ast")
+      Ml ~output:(outputprefix ^ Literals.suffix_ast)
       ast
   end ;
   if !Js_config.syntax_only then 
@@ -205,9 +205,9 @@ let implementation ~parser ppf fname outputprefix  =
   |> print_if_pipe ppf Clflags.dump_source Pprintast.structure
   |> after_parsing_impl ppf outputprefix 
 
-let implementation_mlast ppf fname outputprefix = 
+let implementation_mlast ppf fname outputprefix setup = 
   Res_compmisc.init_path ();
-  Binary_ast.read_ast Ml fname
+  Binary_ast.read_ast_exn ~fname Ml  setup
   |> print_if_pipe ppf Clflags.dump_parsetree Printast.implementation
   |> print_if_pipe ppf Clflags.dump_source Pprintast.structure
   |> after_parsing_impl ppf  outputprefix 

jscomp/core/js_implementation.mli

@@ -42,7 +42,12 @@ val interface :
   string -> 
   unit
 
-val interface_mliast : Format.formatter -> string -> string  -> unit
+val interface_mliast : 
+  Format.formatter -> 
+  string -> 
+  string  -> 
+  ([`ml | `rescript | `reason ] -> unit) ->
+  unit
 
 
 
@@ -64,6 +69,11 @@ val implementation :
   unit
 (** [implementation ppf sourcefile outprefix] compiles to JS directly *) 
 
-val implementation_mlast : Format.formatter -> string -> string -> unit
+val implementation_mlast : 
+  Format.formatter ->
+  string -> 
+  string -> 
+  ([`ml | `rescript | `reason ]  -> unit) ->
+  unit
 
 val implementation_map : Format.formatter -> string -> string -> unit

jscomp/depends/binary_ast.ml

@@ -26,27 +26,34 @@
  (** Synced up with module {!Bsb_helper_depfile_gen} *)
 module Set_string = Ast_extract.Set_string
 
+type 'a kind = 'a Ml_binary.kind =
+  | Ml : Parsetree.structure kind 
+  | Mli : Parsetree.signature kind
 
 
-let read_ast (type t ) (kind : t  Ml_binary.kind) fn : t  =
-  let ic = open_in_bin fn in
-  try
-    let dep_size = input_binary_int ic in 
-    seek_in  ic (pos_in ic + dep_size) ; 
-    let ast = Ml_binary.read_my_ast kind ic in 
-    close_in ic;
-    ast
-  with exn ->
-    close_in ic;
-    raise exn
+let read_ast_exn (type t ) ~fname (_ : t  kind) setup : t  =
+  let ic = open_in_bin fname in
+  let dep_size = input_binary_int ic in 
+  seek_in  ic (pos_in ic + dep_size) ; 
+  let sourcefile = (input_line ic) in
+  Location.set_input_name sourcefile;
+  let ast = input_value ic in
+  close_in ic;
+  begin match Ext_file_extensions.classify_input 
+                (Ext_filename.get_extension_maybe sourcefile) with 
+  | Re | Rei -> setup `reason   
+  | Res | Resi -> setup `rescript 
+  | _ -> ()
+  end;
+  ast
 
 let magic_sep_char = '\n'
 (*
    Reasons that we don't [output_value] the set:
    1. for performance , easy skipping and calcuate the length 
    2. cut dependency, otherwise its type is {!Ast_extract.Set_string.t}
 *)      
-let write_ast (type t) ~(sourcefile : string) ~output (kind : t Ml_binary.kind) ( pt : t) : unit =
+let write_ast (type t) ~(sourcefile : string) ~output (kind : t kind) ( pt : t) : unit =
   let oc = open_out_bin output in 
   let output_set = Ast_extract.read_parse_and_extract kind pt in
   let buf = Ext_buffer.create 1000 in
@@ -59,6 +66,8 @@ let write_ast (type t) ~(sourcefile : string) ~output (kind : t Ml_binary.kind)
     ) output_set ;  
   output_binary_int oc (Ext_buffer.length buf);  
   Ext_buffer.output_buffer oc buf;
-  Ml_binary.write_my_ast kind sourcefile pt oc;
+  output_string oc sourcefile;
+  output_char oc '\n';
+  output_value oc pt;
   close_out oc 
 

jscomp/depends/binary_ast.mli

@@ -23,7 +23,15 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
-val read_ast : 'a Ml_binary.kind -> string -> 'a 
+type _ kind = 
+  | Ml : Parsetree.structure kind 
+  | Mli : Parsetree.signature kind
+
+val read_ast_exn : 
+  fname:string -> 
+  'a kind ->  
+  ([`ml | `rescript | `reason ] -> unit) ->
+  'a 
 
 
 val magic_sep_char : char
@@ -43,5 +51,10 @@ val magic_sep_char : char
    Use case cat - | fan -printer -impl -
    redirect the standard input to fan
  *)
-val write_ast : sourcefile:string -> output:string -> 'a Ml_binary.kind -> 'a -> unit
+val write_ast : 
+  sourcefile:string -> 
+  output:string -> 
+  'a kind -> 
+  'a -> 
+  unit
 

jscomp/ext/ext_file_extensions.ml

@@ -0,0 +1,43 @@
+type valid_input = 
+  | Ml 
+  | Mli
+  | Re
+  | Rei
+  | Res
+  | Resi
+  | Intf_ast
+  | Impl_ast
+  | Mlmap
+  | Cmi
+  | Unknown
+
+
+(** This is per-file based, 
+    when [ocamlc] [-c -o another_dir/xx.cmi] 
+    it will return (another_dir/xx)
+*)    
+
+let classify_input ext = 
+
+  match () with 
+  | _ when ext = Literals.suffix_ml ->   
+    Ml
+  | _ when ext = Literals.suffix_re ->
+    Re
+  | _ when ext = !Config.interface_suffix ->
+    Mli  
+  | _ when ext = Literals.suffix_rei ->
+    Rei
+  | _ when ext =  Literals.suffix_ast ->
+    Impl_ast 
+  | _ when ext = Literals.suffix_iast ->
+    Intf_ast
+  | _ when ext =  Literals.suffix_mlmap ->
+    Mlmap 
+  | _ when ext =  Literals.suffix_cmi ->
+    Cmi
+  | _ when ext = Literals.suffix_res -> 
+    Res
+  | _ when ext = Literals.suffix_resi -> 
+    Resi    
+  | _ -> Unknown  

jscomp/ext/literals.ml

@@ -89,18 +89,12 @@ let suffix_re = ".re"
 let suffix_rei = ".rei"
 let suffix_res = ".res"
 let suffix_resi = ".resi"
-let suffix_resast = ".resast"
-let suffix_resiast = ".resiast"
 let suffix_mlmap = ".mlmap"
 
 let suffix_cmt = ".cmt"
 let suffix_cmti = ".cmti"
-let suffix_mlast = ".mlast"
-let suffix_mlast_simple = ".mlast_simple"
-let suffix_mliast = ".mliast"
-let suffix_reast = ".reast"
-let suffix_reiast = ".reiast"
-let suffix_mliast_simple = ".mliast_simple"
+let suffix_ast = ".ast"
+let suffix_iast = ".iast"
 let suffix_d = ".d"
 let suffix_js = ".js"
 let suffix_bs_js = ".bs.js"