apply bs.config twice

-- when parsing
-- when parsing is done

Author: bobzhang

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/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
@@ -357,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