Merge pull request #4177 from BuckleScript/bs_config

make bs.config available in typing stage

Author: bobzhang

.gitignore

@@ -65,7 +65,7 @@ jscomp/bin/*.exe
 odoc_gen/*.cmxs
 
 # for npm publish
-./lib/*.exe
+*.exe
 !bin/bsppx
 !bin/bspack
 !/bin/bsb

lib/bsrefmt renamed to bsrefmt

@@ -5,7 +5,7 @@ var child_process = require('child_process')
 var path = require('path')
 
 // the underlying binary is called refmt
-var exe = path.join(__dirname, 'refmt.exe')
+var exe = path.join(__dirname, process.platform,'refmt.exe')
 var delegate_args = process.argv.slice(2)
 
 try {

jscomp/common/js_config.ml

@@ -111,4 +111,8 @@ let js_stdout = ref true
 
 let all_module_aliases = ref false
 
-let no_stdlib = ref false
+let no_stdlib = ref false
+
+let no_export = ref false
+
+let record_as_js_object = ref false (* otherwise has an attribute *)

jscomp/common/js_config.mli

@@ -108,4 +108,6 @@ val js_stdout : bool ref
 
 val all_module_aliases : bool ref 
 
-val no_stdlib: bool ref
+val no_stdlib: bool ref
+val no_export: bool ref
+val record_as_js_object : bool ref

jscomp/core/js_implementation.ml

@@ -50,6 +50,7 @@ let process_with_gentype filename =
       )
 
 let after_parsing_sig ppf  outputprefix ast  =
+  Ast_config.iter_on_bs_config_sigi ast;  
   if !Js_config.simple_binary_ast then begin
     let oc = open_out_bin (outputprefix ^ Literals.suffix_mliast_simple) in 
     Ml_binary.write_ast Mli !Location.input_name ast oc;
@@ -137,11 +138,26 @@ let all_module_alias (ast : Parsetree.structure)=
     | Pstr_extension _ -> false 
    )
 
-let after_parsing_impl ppf  outputprefix ast =
+let no_export (rest : Parsetree.structure) : Parsetree.structure = 
+  match rest with 
+  | head :: _ -> 
+    let loc = head.pstr_loc in     
+    Ast_helper.[Str.include_ ~loc
+                  (Incl.mk ~loc
+                     (Mod.constraint_ ~loc
+                        (Mod.structure ~loc rest  )
+                        (Mty.signature ~loc [])
+                     ))]  
+  | _ -> rest  
+
+let after_parsing_impl ppf  outputprefix (ast : Parsetree.structure) =
   Js_config.all_module_aliases := 
     !Clflags.assume_no_mli =  Mli_non_exists &&
-    all_module_alias ast 
-    ;
+    all_module_alias ast;
+  Ast_config.iter_on_bs_config_stru ast;  
+  let ast =
+    if !Js_config.no_export  then 
+      no_export ast else ast in     
   if !Js_config.simple_binary_ast then begin
     let oc = open_out_bin (outputprefix ^ Literals.suffix_mlast_simple) in 
     Ml_binary.write_ast Ml !Location.input_name  ast oc;

jscomp/syntax/ast_config.ml

@@ -0,0 +1,70 @@
+(* Copyright (C) 2020 Authors of BuckleScript
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+
+type action_table = 
+  (Parsetree.expression option -> unit) Map_string.t
+(** global configurations below *)
+let common_actions_table :
+  (string *  (Parsetree.expression option -> unit)) list =
+  [
+  ]
+
+
+let structural_config_table : action_table =
+  Map_string.of_list
+    (( "no_export" ,
+       (fun x ->
+          Js_config.no_export := (
+            match x with
+            |Some e -> Ast_payload.assert_bool_lit e
+            | None -> true)
+       ))
+     :: common_actions_table)
+
+let signature_config_table : action_table =
+  Map_string.of_list common_actions_table
+
+
+let rec iter_on_bs_config_stru (x :Parsetree.structure) =   
+  match x with 
+  | [] -> () 
+  | {pstr_desc = Pstr_attribute (({txt = "bs.config"; loc}, payload) as attr)}::_ -> 
+    Bs_ast_invariant.mark_used_bs_attribute attr;
+    Ext_list.iter (Ast_payload.ident_or_record_as_config loc payload)
+      (Ast_payload.table_dispatch structural_config_table)
+  | {pstr_desc = Pstr_attribute _} :: rest -> 
+    iter_on_bs_config_stru rest 
+  | non_attr :: _ -> ()    
+
+let rec iter_on_bs_config_sigi (x :Parsetree.signature) =   
+  match x with 
+  | [] -> () 
+  | {psig_desc = Psig_attribute (({txt = "bs.config"; loc}, payload) as attr)}::_ -> 
+    Bs_ast_invariant.mark_used_bs_attribute attr;
+    Ext_list.iter (Ast_payload.ident_or_record_as_config loc payload)
+      (Ast_payload.table_dispatch signature_config_table)
+  | {psig_desc = Psig_attribute _} :: rest -> 
+    iter_on_bs_config_sigi rest 
+  | non_attr :: _ -> ()      

jscomp/syntax/ast_config.mli

@@ -0,0 +1,34 @@
+(* Copyright (C) 2020 Authors of BuckleScript
+ *
+ * This program is free software: you can redistribute it and/or modify
+ * it under the terms of the GNU Lesser General Public License as published by
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * In addition to the permissions granted to you by the LGPL, you may combine
+ * or link a "work that uses the Library" with a publicly distributed version
+ * of this file to produce a combined library or application, then distribute
+ * that combined work under the terms of your choosing, with no requirement
+ * to comply with the obligations normally placed on you by section 4 of the
+ * LGPL version 3 (or the corresponding section of a later version of the LGPL
+ * should you choose to use a later version).
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
+
+
+
+
+val iter_on_bs_config_stru : 
+  Parsetree.structure ->  
+  unit  
+
+val iter_on_bs_config_sigi : 
+  Parsetree.signature ->  
+  unit    

jscomp/syntax/ast_payload.ml

@@ -125,9 +125,9 @@ let raw_as_string_exp_exn
     Some e 
   | _  -> None
 
-let as_core_type loc x =
+let as_core_type loc (x : t) =
   match  x with
-  | Parsetree.PTyp x -> x
+  | PTyp x -> x
   | _ -> Location.raise_errorf ~loc "except a core type"
 
 let as_ident (x : t ) =
@@ -143,10 +143,6 @@ let as_ident (x : t ) =
       }
     ] -> Some ident
   | _ -> None
-(* open Ast_helper *)
-
-(* let raw_string_payload loc (s : string) : t =
-  PStr [ Str.eval ~loc (Ast_compatible.const_exp_string ~loc s) ] *)
 
 
 type lid = string Asttypes.loc
@@ -164,7 +160,7 @@ type action =
 
 let ident_or_record_as_config     
     loc
-    (x : Parsetree.payload) 
+    (x : t) 
   : ( string Location.loc * Parsetree.expression option) list 
   = 
   match  x with 
@@ -211,7 +207,7 @@ let ident_or_record_as_config
 
 let assert_strings loc (x : t) : string list
   = 
-  let module M = struct exception Not_str end  in 
+  let exception Not_str   in 
   match x with 
   | PStr [ {pstr_desc =  
               Pstr_eval (
@@ -227,8 +223,8 @@ let assert_strings loc (x : t) : string list
               Pconst_string
                (name,_)); _} -> 
              name
-           | _ -> raise M.Not_str)
-     with M.Not_str ->
+           | _ -> raise Not_str)
+     with Not_str ->
        Location.raise_errorf ~loc "expect string tuple list"
     )
   | PStr [ {

jscomp/syntax/bs_builtin_ppx.ml

@@ -53,16 +53,12 @@
 *)
 
 
-let record_as_js_object = ref false (* otherwise has an attribute *)
-let no_export = ref false
+
 
 let () =
   Ast_derive_projector.init ();
   Ast_derive_js_mapper.init ()
 
-let reset () =
-  record_as_js_object := false ;
-  no_export  :=  false
 
 
 
@@ -74,7 +70,7 @@ let expr_mapper  (self : mapper) (e : Parsetree.expression) =
         match e.pexp_desc with
         (** Its output should not be rewritten anymore *)
         | Pexp_extension extension ->
-          Ast_exp_extension.handle_extension record_as_js_object e self extension
+          Ast_exp_extension.handle_extension Js_config.record_as_js_object e self extension
         | Pexp_constant (
             Pconst_string
             (s, (Some delim)))
@@ -140,7 +136,7 @@ let expr_mapper  (self : mapper) (e : Parsetree.expression) =
                  constraint 'b :> 'a
                ]}
             *)
-          if !record_as_js_object then
+          if !Js_config.record_as_js_object then
             (match opt_exp with
              | None ->
                { e with
@@ -180,7 +176,7 @@ let expr_mapper  (self : mapper) (e : Parsetree.expression) =
 
 
 let typ_mapper (self : mapper) (typ : Parsetree.core_type) = 
-  Ast_core_type_class_type.typ_mapper record_as_js_object self typ
+  Ast_core_type_class_type.typ_mapper Js_config.record_as_js_object self typ
 
 let class_type_mapper (self : mapper) ({pcty_attributes; pcty_loc} as ctd : Parsetree.class_type) = 
   match Ast_attributes.process_bs pcty_attributes with
@@ -283,6 +279,7 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) =
     Ast_exp_handle_external.handle_raw_structure loc payload
   | Pstr_extension (({txt = ("bs.debugger.chrome" | "debugger.chrome") ;loc}, payload),_)
     ->          
+    Location.prerr_warning loc (Preprocessor "this extension can be safely removed");
     Ast_structure.dummy_item loc
   | Pstr_type (
           _rf, 
@@ -356,73 +353,31 @@ let  unsafe_mapper : mapper =
   }
 
 
-type action_table = 
-  (Parsetree.expression option -> unit) Map_string.t
-(** global configurations below *)
-let common_actions_table :
-  (string *  (Parsetree.expression option -> unit)) list =
-  [
-  ]
 
 
-let structural_config_table : action_table =
-  Map_string.of_list
-    (( "no_export" ,
-       (fun x ->
-          no_export := (
-            match x with
-            |Some e -> Ast_payload.assert_bool_lit e
-            | None -> true)
-       ))
-     :: common_actions_table)
 
-let signature_config_table : action_table =
-  Map_string.of_list common_actions_table
 
 
 let rewrite_signature (x : Parsetree.signature) =  
   Bs_ast_invariant.iter_warnings_on_sigi x;  
-  let result = 
-    match x with
-    | {psig_desc = Psig_attribute ({txt = "ocaml.ppx.context"},_)}
-      :: {psig_desc = Psig_attribute ({txt = "bs.config"; loc}, payload); _} :: rest
-    | {psig_desc = Psig_attribute ({txt = "bs.config"; loc}, payload); _} :: rest
-      ->          
-      Ext_list.iter (Ast_payload.ident_or_record_as_config loc payload) 
-        (Ast_payload.table_dispatch signature_config_table) ;
-      unsafe_mapper.signature unsafe_mapper rest          
-    | _ ->
+  Ast_config.iter_on_bs_config_sigi x; 
+  let result =  
       unsafe_mapper.signature  unsafe_mapper x in
-  reset ();
   (* Keep this check, since the check is not inexpensive*)
   Bs_ast_invariant.emit_external_warnings_on_signature result;
   result
 
+
+
+  
+
+
 (* Note we also drop attributes like [@@@bs.deriving ] for convenience*)    
 let rewrite_implementation (x : Parsetree.structure) = 
   Bs_ast_invariant.iter_warnings_on_stru x ;   
+  Ast_config.iter_on_bs_config_stru x ; 
   let result =
-    match x with
-    | {pstr_desc = Pstr_attribute ({txt = "ocaml.ppx.context"},_)}
-      :: {pstr_desc = Pstr_attribute ({txt = "bs.config"; loc}, payload); _} :: rest
-    | {pstr_desc = Pstr_attribute ({txt = "bs.config"; loc}, payload); _} :: rest
-      ->
-      begin
-        Ext_list.iter (Ast_payload.ident_or_record_as_config loc payload)
-          (Ast_payload.table_dispatch structural_config_table) ;
-        let rest = unsafe_mapper.structure unsafe_mapper rest in
-        if !no_export then
-          Ast_helper.[Str.include_ ~loc
-             (Incl.mk ~loc
-                (Mod.constraint_ ~loc
-                   (Mod.structure ~loc rest  )
-                   (Mty.signature ~loc [])
-                ))]
-        else rest
-      end
-    | _ ->
       unsafe_mapper.structure  unsafe_mapper x  in
-  reset ();
   (* Keep this check since it is not inexpensive*)
   Bs_ast_invariant.emit_external_warnings_on_structure result;
   result

jscomp/test/build.ninja

@@ -356,7 +356,7 @@ build test/inner_call.cmi test/inner_call.cmj : cc test/inner_call.ml | test/inn
 build test/inner_define.cmj : cc_cmi test/inner_define.ml | test/inner_define.cmi $stdlib
 build test/inner_define.cmi : cc test/inner_define.mli | $stdlib
 build test/inner_unused.cmi test/inner_unused.cmj : cc test/inner_unused.ml | $stdlib
-build test/installation_test.cmi test/installation_test.cmj : cc test/installation_test.ml | test/app_root_finder.cmj test/mt.cmj $stdlib
+build test/installation_test.cmi test/installation_test.cmj : cc test/installation_test.ml | test/mt.cmj $stdlib
 build test/int32_test.cmi test/int32_test.cmj : cc test/int32_test.ml | test/ext_array_test.cmj test/mt.cmj $stdlib
 build test/int64_mul_div_test.cmi test/int64_mul_div_test.cmj : cc test/int64_mul_div_test.ml | test/mt.cmj $stdlib
 build test/int64_test.cmi test/int64_test.cmj : cc test/int64_test.ml | test/ext_array_test.cmj test/mt.cmj $stdlib