part 2: fix #3142

Author: bobzhang

jscomp/all.depend

@@ -172,7 +172,8 @@ common/bs_warnings.cmi :
 common/lam_methname.cmi :
 common/ml_binary.cmi :
 syntax/bs_syntaxerr.cmx : syntax/bs_syntaxerr.cmi
-syntax/ast_compatible.cmx : ext/ext_list.cmx syntax/ast_compatible.cmi
+syntax/ast_compatible.cmx : ext/ext_pervasives.cmx ext/ext_list.cmx \
+    syntax/ast_compatible.cmi
 syntax/ast_utf8_string.cmx : ext/ext_utf8.cmx ext/ext_char.cmx \
     syntax/ast_utf8_string.cmi
 syntax/ast_utf8_string_interp.cmx : ext/ext_utf8.cmx ext/ext_string.cmx \
@@ -213,9 +214,9 @@ syntax/ast_attributes.cmx : ext/ext_string.cmx ext/ext_list.cmx \
     syntax/bs_syntaxerr.cmx syntax/bs_ast_invariant.cmx \
     syntax/ast_payload.cmx syntax/ast_compatible.cmx \
     syntax/ast_attributes.cmi
-syntax/ast_polyvar.cmx : syntax/external_arg_spec.cmx ext/ext_pervasives.cmx \
-    ext/ext_list.cmx syntax/bs_syntaxerr.cmx syntax/ast_attributes.cmx \
-    syntax/ast_polyvar.cmi
+syntax/ast_polyvar.cmx : syntax/external_arg_spec.cmx ext/ext_list.cmx \
+    syntax/bs_syntaxerr.cmx syntax/ast_compatible.cmx \
+    syntax/ast_attributes.cmx syntax/ast_polyvar.cmi
 syntax/external_ffi_types.cmx : syntax/external_arg_spec.cmx \
     ext/ext_string.cmx ext/ext_pervasives.cmx common/bs_version.cmx \
     syntax/external_ffi_types.cmi
@@ -242,7 +243,7 @@ syntax/ast_derive_projector.cmx : ext/ext_string.cmx ext/ext_list.cmx \
 syntax/ast_derive_js_mapper.cmx : ext/ext_list.cmx syntax/ast_polyvar.cmx \
     syntax/ast_literal.cmx syntax/ast_derive_util.cmx syntax/ast_derive.cmx \
     syntax/ast_core_type.cmx syntax/ast_compatible.cmx syntax/ast_comb.cmx \
-    syntax/ast_derive_js_mapper.cmi
+    syntax/ast_attributes.cmx syntax/ast_derive_js_mapper.cmi
 syntax/ast_util.cmx : ext/literals.cmx syntax/external_process.cmx \
     ext/ext_string.cmx ext/ext_list.cmx syntax/bs_syntaxerr.cmx \
     syntax/bs_ast_mapper.cmx syntax/ast_payload.cmx syntax/ast_pat.cmx \

jscomp/bin/all_ounit_tests.ml

@@ -3798,10 +3798,6 @@ val dash_nostdlib : string
 
 val reactjs_jsx_ppx_2_exe : string 
 val reactjs_jsx_ppx_3_exe : string 
-val unescaped_j_delimiter : string 
-
-
-val unescaped_js_delimiter : string 
 
 val native : string
 val bytecode : string
@@ -3932,8 +3928,6 @@ let dash_nostdlib = "-nostdlib"
 
 let reactjs_jsx_ppx_2_exe = "reactjs_jsx_ppx_2.exe"
 let reactjs_jsx_ppx_3_exe  = "reactjs_jsx_ppx_3.exe"
-let unescaped_j_delimiter = "j"
-let unescaped_js_delimiter = "js"
 
 let native = "native"
 let bytecode = "bytecode"
@@ -14609,6 +14603,7 @@ module Ast_compatible : sig
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 
+type poly_var_label = string 
 type arg_label = string 
 type label = 
   | Nolabel
@@ -14769,7 +14764,8 @@ type object_field =
 val object_field : string ->  attributes -> core_type -> object_field  
 
 
-  
+val hash_label : poly_var_label -> int 
+val label_of_name : poly_var_label -> string 
 end = struct
 #1 "ast_compatible.ml"
 (* Copyright (C) 2018 Authors of BuckleScript
@@ -14802,6 +14798,7 @@ open Parsetree
 let default_loc = Location.none
 
 
+type poly_var_label = string 
 type arg_label = string
 type label = 
   | Nolabel
@@ -15022,6 +15019,12 @@ type object_field =
 
 let object_field   l attrs ty = 
  (l,attrs,ty)  
+
+
+
+let hash_label : poly_var_label -> int = Ext_pervasives.hash_variant 
+external label_of_name : poly_var_label -> string = "%identity"
+
 end
 module Bs_loc : sig 
 #1 "bs_loc.mli"
@@ -15187,6 +15190,10 @@ val transform :
 val is_unicode_string :   
   string -> 
   bool
+
+val is_unescaped :   
+  string -> 
+  bool
 end = struct
 #1 "ast_utf8_string_interp.ml"
 (* Copyright (C) 2015-2016 Bloomberg Finance L.P.
@@ -15576,6 +15583,8 @@ let to_string_ident : Longident.t =
 
 
 let escaped_j_delimiter =  "*j" (* not user level syntax allowed *)
+let unescaped_j_delimiter = "j"
+let unescaped_js_delimiter = "js"
 
 let escaped = Some escaped_j_delimiter 
 
@@ -15648,19 +15657,23 @@ let transform_interp loc s =
 
 
 let transform (e : Parsetree.expression) s delim : Parsetree.expression = 
-    if Ext_string.equal delim Literals.unescaped_js_delimiter then
+    if Ext_string.equal delim unescaped_js_delimiter then
         let js_str = Ast_utf8_string.transform e.pexp_loc s in
         { e with pexp_desc =
                        Pexp_constant (
 
             Const_string 
 
                          (js_str, escaped))}
-    else if Ext_string.equal delim Literals.unescaped_j_delimiter then
+    else if Ext_string.equal delim unescaped_j_delimiter then
             transform_interp e.pexp_loc s
     else e
 
 let is_unicode_string opt = Ext_string.equal opt escaped_j_delimiter    
+
+let is_unescaped s = 
+  Ext_string.equal s unescaped_j_delimiter
+  || Ext_string.equal s unescaped_js_delimiter
 end
 module Ounit_unicode_tests
 = struct

jscomp/syntax/ast_attributes.ml

@@ -199,7 +199,7 @@ let iter_process_derive_type attrs =
   it is worse in bs.uncurry since it will introduce
   inconsistency in arity
  *)  
-let iter_process_bs_string_int_unwrap_uncurry attrs =
+let iter_process_bs_string_int_unwrap_uncurry (attrs : Parsetree.attributes) =
   let st = ref `Nothing in 
   let assign v (({loc;_}, _ ) as attr : attr) = 
     if !st = `Nothing then 
@@ -208,8 +208,7 @@ let iter_process_bs_string_int_unwrap_uncurry attrs =
       st := v ;
     end  
     else Bs_syntaxerr.err loc Conflict_attributes  in 
-  List.iter
-    (fun (({txt ; loc}, (payload : _ ) ) as attr : attr)  ->
+  Ext_list.iter attrs (fun (({txt ; loc}, (payload : _ ) ) as attr)  ->
       match  txt with
       | "bs.string"
         -> assign `String attr
@@ -223,8 +222,8 @@ let iter_process_bs_string_int_unwrap_uncurry attrs =
         ->
         assign (`Uncurry (Ast_payload.is_single_int payload)) attr
       | _ -> ()
-    ) attrs;
-    !st 
+    ) ;
+  !st 
 
 
 let iter_process_bs_string_as  (attrs : t) : string option =
@@ -248,6 +247,27 @@ let iter_process_bs_string_as  (attrs : t) : string option =
     ) ;
   !st
 
+let iter_process_bs_string_as_ast  (attrs : t) : Parsetree.expression option =
+  let st = ref None in
+  Ext_list.iter attrs
+    (fun
+      (({txt ; loc}, payload ) as attr )  ->
+      match  txt with
+      | "bs.as"
+        ->
+        if !st = None then
+          match Ast_payload.is_single_string_as_ast payload with
+          | None ->
+            Bs_syntaxerr.err loc Expect_string_literal
+          | Some _ as v ->            
+            Bs_ast_invariant.mark_used_bs_attribute attr ;
+            st:=  v
+        else
+          Bs_syntaxerr.err loc Duplicated_bs_as
+      | _  -> ()
+    ) ;
+  !st  
+
 let has_bs_optional  (attrs : t) : bool =
   Ext_list.exists attrs (fun
       (({txt ; }, _ ) as attr)  ->

jscomp/syntax/ast_attributes.mli

@@ -62,6 +62,10 @@ val iter_process_bs_string_int_unwrap_uncurry :
 val iter_process_bs_string_as :
   t -> string option
 
+val iter_process_bs_string_as_ast :   
+  t -> 
+  Parsetree.expression option
+  
 val has_bs_optional :
   t -> bool 
 

jscomp/syntax/ast_compatible.ml

@@ -28,6 +28,8 @@ open Parsetree
 let default_loc = Location.none
 
 #if OCAML_VERSION =~ ">4.03.0" then 
+type poly_var_label = Asttypes.label Asttypes.loc
+
 type arg_label = Asttypes.arg_label = 
   | Nolabel
   | Labelled of string
@@ -37,6 +39,7 @@ let is_arg_label_simple (s : arg_label) = s = (Nolabel : arg_label)
 type label = arg_label 
 external convert : arg_label -> label = "%identity"
 #else 
+type poly_var_label = string 
 type arg_label = string
 type label = 
   | Nolabel
@@ -323,4 +326,13 @@ type object_field =
 let object_field   l attrs ty = 
 #if OCAML_VERSION =~ ">4.03.0" then
   Parsetree.Otag 
-#end (l,attrs,ty)  
+#end (l,attrs,ty)  
+
+
+#if OCAML_VERSION =~ ">4.03.0" then 
+let hash_label (x : poly_var_label) : int = Ext_pervasives.hash_variant x.txt
+let label_of_name (x : poly_var_label) : string = x.txt
+#else
+let hash_label : poly_var_label -> int = Ext_pervasives.hash_variant 
+external label_of_name : poly_var_label -> string = "%identity"
+#end

jscomp/syntax/ast_compatible.mli

@@ -23,10 +23,12 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 #if OCAML_VERSION =~ ">4.3.0" then 
+type poly_var_label = Asttypes.label Asttypes.loc
 type arg_label = Asttypes.arg_label
 type label = arg_label
 external convert: arg_label -> label = "%identity"
 #else
+type poly_var_label = string 
 type arg_label = string 
 type label = 
   | Nolabel
@@ -190,4 +192,5 @@ val object_field : Asttypes.label Asttypes.loc ->  attributes -> core_type -> ob
 val object_field : string ->  attributes -> core_type -> object_field  
 #end  
 
-  
+val hash_label : poly_var_label -> int 
+val label_of_name : poly_var_label -> string 

jscomp/syntax/ast_derive_js_mapper.ml

@@ -242,64 +242,70 @@ let init () =
                  if createType then eraseTypeStr:: newTypeStr :: rest else rest 
                | Ptype_abstract -> 
                  (match Ast_polyvar.is_enum_polyvar tdcl with 
-                  | Some row_fields -> 
-                    let attr = 
-                      Ast_polyvar.map_row_fields_into_strings loc row_fields 
-                    in 
+                  | Some row_fields ->               
                     let expConstantArray =   
                       Exp.ident {loc; txt = Longident.Lident constantArray} in 
-                    begin match attr with 
-                      | NullString result -> 
-                        let result_len = List.length result in 
-                        let exp_len = Ast_compatible.const_exp_int result_len in 
-                        let v = [
-                          eraseTypeStr;
-                          Ast_comb.single_non_rec_value 
-                            {loc; txt = constantArray}
-                            (Exp.array
-                               (Ext_list.map (List.sort (fun (a,_) (b,_) -> compare (a:int) b) result)
-                                  (fun (i,str) -> 
-                                     Exp.tuple 
-                                       [
-                                         Ast_compatible.const_exp_int i;
-                                         Ast_compatible.const_exp_string str
-                                       ]
-                                  ) ));
-                          (
-                            toJsBody
-                              (coerceResultToNewType 
-                                 (search
-                                    exp_len
-                                    exp_param
-                                    expConstantArray 
-                                 ))
-                          );
-                          Ast_comb.single_non_rec_value
-                            patFromJs
-                            (Ast_compatible.fun_
-                               (Pat.var pat_param)
-                               (if createType then 
-                                  revSearchAssert
-                                    exp_len
-                                    expConstantArray
-                                    (exp_param +: newType)
-                                  +>
-                                  core_type
-                                else 
-                                  revSearch                                      
-                                    exp_len
-                                    expConstantArray
-                                    exp_param                                      
-                                  +>
-                                  Ast_core_type.lift_option_type core_type
-                               )
+                    let result :  _ list = 
+                      Ext_list.map row_fields (fun tag -> 
+                          match tag with 
+                          | Rtag (label, attrs, _, []) -> 
+                            (Ast_compatible.hash_label label,
+                             match Ast_attributes.iter_process_bs_string_as_ast attrs with 
+                             | Some name -> 
+                               name
+                             | None -> 
+                                Ast_compatible.const_exp_string(Ast_compatible.label_of_name label)
                             )
-                        ] in 
-                        if createType then 
-                          newTypeStr :: v 
-                        else v 
-                      | _ -> assert false 
-                    end 
+                          | _ -> assert false (* checked by [is_enum_polyvar] *)
+                        ) in 
+                    let result_len = List.length result in 
+                    let exp_len = Ast_compatible.const_exp_int result_len in 
+                    let v = [
+                      eraseTypeStr;
+                      Ast_comb.single_non_rec_value 
+                        {loc; txt = constantArray}
+                        (Exp.array
+                           (Ext_list.map (List.sort (fun (a,_) (b,_) -> compare (a:int) b) result)
+                              (fun (i,str) -> 
+                                 Exp.tuple 
+                                   [
+                                     Ast_compatible.const_exp_int i;
+                                      str
+                                   ]
+                              ) ));
+                      (
+                        toJsBody
+                          (coerceResultToNewType 
+                             (search
+                                exp_len
+                                exp_param
+                                expConstantArray 
+                             ))
+                      );
+                      Ast_comb.single_non_rec_value
+                        patFromJs
+                        (Ast_compatible.fun_
+                           (Pat.var pat_param)
+                           (if createType then 
+                              revSearchAssert
+                                exp_len
+                                expConstantArray
+                                (exp_param +: newType)
+                              +>
+                              core_type
+                            else 
+                              revSearch                                      
+                                exp_len
+                                expConstantArray
+                                exp_param                                      
+                              +>
+                              Ast_core_type.lift_option_type core_type
+                           )
+                        )
+                    ] in 
+                    if createType then 
+                      newTypeStr :: v 
+                    else v 
                   | None -> 
                     U.notApplicable 
                       tdcl.Parsetree.ptype_loc