Fix implementation of directives.

Author: cristianoc

CHANGELOG.md

@@ -13,7 +13,7 @@
 # 10.1.4
 
 #### :bug: Bug Fix
-- Fix implementation of directives
+- Fix implementation of directives https://github.com/rescript-lang/rescript-compiler/pull/6052
 
 # 10.1.3
 

jscomp/core/js_implementation.ml

@@ -46,7 +46,7 @@ let process_with_gentype cmt_file =
 
 let after_parsing_sig ppf outputprefix ast =
   if !Clflags.only_parse = false then (
-    Ast_config.iter_on_bs_config_sigi ast;
+    Ast_config.process_sig ast;
     if !Js_config.modules then
       output_deps_set !Location.input_name
         (Ast_extract.read_parse_and_extract Mli ast);
@@ -139,7 +139,7 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) =
   if !Clflags.only_parse = false then (
     Js_config.all_module_aliases :=
       !Clflags.assume_no_mli = Mli_non_exists && all_module_alias ast;
-    Ast_config.iter_on_bs_config_stru ast;
+    Ast_config.process_str ast;
     let ast = if !Js_config.no_export then no_export ast else ast in
     if !Js_config.modules then
       output_deps_set !Location.input_name

jscomp/frontend/ast_config.ml

@@ -38,7 +38,15 @@ let signature_config_table : action_table ref = ref Map_string.empty
 let add_signature k v =
   signature_config_table := Map_string.add !signature_config_table k v
 
-let rec iter_on_bs_config_stru (x : Parsetree.structure) =
+let process_directives str =
+  Js_config.directives := []; (* Restt: multiple calls possible e.g. with bsc from the command-line *)
+  str |> List.iter(fun (item : Parsetree.structure_item) -> match item.pstr_desc with
+  | Pstr_attribute ({ txt = "directive" },
+      PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string (d, _)) }, _) } ]) ->
+      Js_config.directives := !Js_config.directives @ [d]
+  | _ -> ())
+  
+let rec iter_on_bs_config_str (x : Parsetree.structure) =
   match x with
   | [] -> ()
   | {
@@ -51,10 +59,14 @@ let rec iter_on_bs_config_stru (x : Parsetree.structure) =
       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
+  | { pstr_desc = Pstr_attribute _ } :: rest -> iter_on_bs_config_str rest
   | _ :: _ -> ()
 
-let rec iter_on_bs_config_sigi (x : Parsetree.signature) =
+let process_str str =
+  iter_on_bs_config_str str;
+  process_directives str
+
+let rec iter_on_bs_config_sig (x : Parsetree.signature) =
   match x with
   | [] -> ()
   | {
@@ -67,5 +79,7 @@ let rec iter_on_bs_config_sigi (x : Parsetree.signature) =
       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
+  | { psig_desc = Psig_attribute _ } :: rest -> iter_on_bs_config_sig rest
   | _ :: _ -> ()
+
+let process_sig s = iter_on_bs_config_sig s

jscomp/frontend/ast_config.mli

@@ -26,6 +26,6 @@ val add_structure : string -> (Parsetree.expression option -> unit) -> unit
 
 val add_signature : string -> (Parsetree.expression option -> unit) -> unit
 
-val iter_on_bs_config_stru : Parsetree.structure -> unit
+val process_str : Parsetree.structure -> unit
 
-val iter_on_bs_config_sigi : Parsetree.signature -> unit
+val process_sig : Parsetree.signature -> unit

jscomp/frontend/ppx_entry.ml

@@ -26,7 +26,7 @@ let unsafe_mapper = Bs_builtin_ppx.mapper
 
 let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature =
   Bs_ast_invariant.iter_warnings_on_sigi ast;
-  Ast_config.iter_on_bs_config_sigi ast;
+  Ast_config.process_sig ast;
   let ast =
     match !Js_config.jsx_version with
     | None -> ast
@@ -46,7 +46,7 @@ let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature =
 
 let rewrite_implementation (ast : Parsetree.structure) : Parsetree.structure =
   Bs_ast_invariant.iter_warnings_on_stru ast;
-  Ast_config.iter_on_bs_config_stru ast;
+  Ast_config.process_str ast;
   let ast =
     match !Js_config.jsx_version with
     | None -> ast

lib/4.06.1/unstable/js_compiler.ml

@@ -265869,9 +265869,9 @@ val add_structure : string -> (Parsetree.expression option -> unit) -> unit
 
 val add_signature : string -> (Parsetree.expression option -> unit) -> unit
 
-val iter_on_bs_config_stru : Parsetree.structure -> unit
+val process_str : Parsetree.structure -> unit
 
-val iter_on_bs_config_sigi : Parsetree.signature -> unit
+val process_sig : Parsetree.signature -> unit
 
 end = struct
 #1 "ast_config.ml"
@@ -265915,7 +265915,15 @@ let signature_config_table : action_table ref = ref Map_string.empty
 let add_signature k v =
   signature_config_table := Map_string.add !signature_config_table k v
 
-let rec iter_on_bs_config_stru (x : Parsetree.structure) =
+let process_directives str =
+  Js_config.directives := []; (* Restt: multiple calls possible e.g. with bsc from the command-line *)
+  str |> List.iter(fun (item : Parsetree.structure_item) -> match item.pstr_desc with
+  | Pstr_attribute ({ txt = "directive" },
+      PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string (d, _)) }, _) } ]) ->
+      Js_config.directives := !Js_config.directives @ [d]
+  | _ -> ())
+  
+let rec iter_on_bs_config_str (x : Parsetree.structure) =
   match x with
   | [] -> ()
   | {
@@ -265928,10 +265936,14 @@ let rec iter_on_bs_config_stru (x : Parsetree.structure) =
       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
+  | { pstr_desc = Pstr_attribute _ } :: rest -> iter_on_bs_config_str rest
   | _ :: _ -> ()
 
-let rec iter_on_bs_config_sigi (x : Parsetree.signature) =
+let process_str str =
+  iter_on_bs_config_str str;
+  process_directives str
+
+let rec iter_on_bs_config_sig (x : Parsetree.signature) =
   match x with
   | [] -> ()
   | {
@@ -265944,9 +265956,10 @@ let rec iter_on_bs_config_sigi (x : Parsetree.signature) =
       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
+  | { psig_desc = Psig_attribute _ } :: rest -> iter_on_bs_config_sig rest
   | _ :: _ -> ()
 
+let process_sig s = iter_on_bs_config_sig s
 end
 module Ast_async
 = struct
@@ -276354,7 +276367,7 @@ let unsafe_mapper = Bs_builtin_ppx.mapper
 
 let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature =
   Bs_ast_invariant.iter_warnings_on_sigi ast;
-  Ast_config.iter_on_bs_config_sigi ast;
+  Ast_config.process_sig ast;
   let ast =
     match !Js_config.jsx_version with
     | None -> ast
@@ -276374,7 +276387,7 @@ let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature =
 
 let rewrite_implementation (ast : Parsetree.structure) : Parsetree.structure =
   Bs_ast_invariant.iter_warnings_on_stru ast;
-  Ast_config.iter_on_bs_config_stru ast;
+  Ast_config.process_str ast;
   let ast =
     match !Js_config.jsx_version with
     | None -> ast

lib/4.06.1/unstable/js_playground_compiler.ml

@@ -265869,9 +265869,9 @@ val add_structure : string -> (Parsetree.expression option -> unit) -> unit
 
 val add_signature : string -> (Parsetree.expression option -> unit) -> unit
 
-val iter_on_bs_config_stru : Parsetree.structure -> unit
+val process_str : Parsetree.structure -> unit
 
-val iter_on_bs_config_sigi : Parsetree.signature -> unit
+val process_sig : Parsetree.signature -> unit
 
 end = struct
 #1 "ast_config.ml"
@@ -265915,7 +265915,15 @@ let signature_config_table : action_table ref = ref Map_string.empty
 let add_signature k v =
   signature_config_table := Map_string.add !signature_config_table k v
 
-let rec iter_on_bs_config_stru (x : Parsetree.structure) =
+let process_directives str =
+  Js_config.directives := []; (* Restt: multiple calls possible e.g. with bsc from the command-line *)
+  str |> List.iter(fun (item : Parsetree.structure_item) -> match item.pstr_desc with
+  | Pstr_attribute ({ txt = "directive" },
+      PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string (d, _)) }, _) } ]) ->
+      Js_config.directives := !Js_config.directives @ [d]
+  | _ -> ())
+  
+let rec iter_on_bs_config_str (x : Parsetree.structure) =
   match x with
   | [] -> ()
   | {
@@ -265928,10 +265936,14 @@ let rec iter_on_bs_config_stru (x : Parsetree.structure) =
       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
+  | { pstr_desc = Pstr_attribute _ } :: rest -> iter_on_bs_config_str rest
   | _ :: _ -> ()
 
-let rec iter_on_bs_config_sigi (x : Parsetree.signature) =
+let process_str str =
+  iter_on_bs_config_str str;
+  process_directives str
+
+let rec iter_on_bs_config_sig (x : Parsetree.signature) =
   match x with
   | [] -> ()
   | {
@@ -265944,9 +265956,10 @@ let rec iter_on_bs_config_sigi (x : Parsetree.signature) =
       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
+  | { psig_desc = Psig_attribute _ } :: rest -> iter_on_bs_config_sig rest
   | _ :: _ -> ()
 
+let process_sig s = iter_on_bs_config_sig s
 end
 module Ast_async
 = struct
@@ -276354,7 +276367,7 @@ let unsafe_mapper = Bs_builtin_ppx.mapper
 
 let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature =
   Bs_ast_invariant.iter_warnings_on_sigi ast;
-  Ast_config.iter_on_bs_config_sigi ast;
+  Ast_config.process_sig ast;
   let ast =
     match !Js_config.jsx_version with
     | None -> ast
@@ -276374,7 +276387,7 @@ let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature =
 
 let rewrite_implementation (ast : Parsetree.structure) : Parsetree.structure =
   Bs_ast_invariant.iter_warnings_on_stru ast;
-  Ast_config.iter_on_bs_config_stru ast;
+  Ast_config.process_str ast;
   let ast =
     match !Js_config.jsx_version with
     | None -> ast

lib/4.06.1/whole_compiler.ml

@@ -180556,9 +180556,9 @@ val add_structure : string -> (Parsetree.expression option -> unit) -> unit
 
 val add_signature : string -> (Parsetree.expression option -> unit) -> unit
 
-val iter_on_bs_config_stru : Parsetree.structure -> unit
+val process_str : Parsetree.structure -> unit
 
-val iter_on_bs_config_sigi : Parsetree.signature -> unit
+val process_sig : Parsetree.signature -> unit
 
 end = struct
 #1 "ast_config.ml"
@@ -180602,7 +180602,15 @@ let signature_config_table : action_table ref = ref Map_string.empty
 let add_signature k v =
   signature_config_table := Map_string.add !signature_config_table k v
 
-let rec iter_on_bs_config_stru (x : Parsetree.structure) =
+let process_directives str =
+  Js_config.directives := []; (* Restt: multiple calls possible e.g. with bsc from the command-line *)
+  str |> List.iter(fun (item : Parsetree.structure_item) -> match item.pstr_desc with
+  | Pstr_attribute ({ txt = "directive" },
+      PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string (d, _)) }, _) } ]) ->
+      Js_config.directives := !Js_config.directives @ [d]
+  | _ -> ())
+  
+let rec iter_on_bs_config_str (x : Parsetree.structure) =
   match x with
   | [] -> ()
   | {
@@ -180615,10 +180623,14 @@ let rec iter_on_bs_config_stru (x : Parsetree.structure) =
       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
+  | { pstr_desc = Pstr_attribute _ } :: rest -> iter_on_bs_config_str rest
   | _ :: _ -> ()
 
-let rec iter_on_bs_config_sigi (x : Parsetree.signature) =
+let process_str str =
+  iter_on_bs_config_str str;
+  process_directives str
+
+let rec iter_on_bs_config_sig (x : Parsetree.signature) =
   match x with
   | [] -> ()
   | {
@@ -180631,9 +180643,10 @@ let rec iter_on_bs_config_sigi (x : Parsetree.signature) =
       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
+  | { psig_desc = Psig_attribute _ } :: rest -> iter_on_bs_config_sig rest
   | _ :: _ -> ()
 
+let process_sig s = iter_on_bs_config_sig s
 end
 module Ccomp : sig 
 #1 "ccomp.mli"
@@ -286751,7 +286764,7 @@ let unsafe_mapper = Bs_builtin_ppx.mapper
 
 let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature =
   Bs_ast_invariant.iter_warnings_on_sigi ast;
-  Ast_config.iter_on_bs_config_sigi ast;
+  Ast_config.process_sig ast;
   let ast =
     match !Js_config.jsx_version with
     | None -> ast
@@ -286771,7 +286784,7 @@ let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature =
 
 let rewrite_implementation (ast : Parsetree.structure) : Parsetree.structure =
   Bs_ast_invariant.iter_warnings_on_stru ast;
-  Ast_config.iter_on_bs_config_stru ast;
+  Ast_config.process_str ast;
   let ast =
     match !Js_config.jsx_version with
     | None -> ast
@@ -294220,7 +294233,7 @@ let process_with_gentype cmt_file =
 
 let after_parsing_sig ppf outputprefix ast =
   if !Clflags.only_parse = false then (
-    Ast_config.iter_on_bs_config_sigi ast;
+    Ast_config.process_sig ast;
     if !Js_config.modules then
       output_deps_set !Location.input_name
         (Ast_extract.read_parse_and_extract Mli ast);
@@ -294313,7 +294326,7 @@ let after_parsing_impl ppf outputprefix (ast : Parsetree.structure) =
   if !Clflags.only_parse = false then (
     Js_config.all_module_aliases :=
       !Clflags.assume_no_mli = Mli_non_exists && all_module_alias ast;
-    Ast_config.iter_on_bs_config_stru ast;
+    Ast_config.process_str ast;
     let ast = if !Js_config.no_export then no_export ast else ast in
     if !Js_config.modules then
       output_deps_set !Location.input_name