Merge pull request #3145 from BuckleScript/fix_3142

[Part one] fix #3142 and clean up attributes handling

Author: bobzhang

jscomp/common/ext_log.ml

@@ -54,11 +54,14 @@ let iwarn b str f  =
     Format.ifprintf Format.err_formatter ("WARN: %s " ^^ f) str 
 
 (* TODO: add {[@.]} later for all *)
-let dwarn str f  = 
+let dwarn ?(__POS__: (string * int * int * int) option) f  = 
   if Js_config.is_same_file () then   
-    Format.fprintf Format.err_formatter ("WARN: %s " ^^ f ^^ "@.") str  
+    match __POS__ with 
+    | None -> Format.fprintf Format.err_formatter ("WARN: " ^^ f ^^ "@.")
+    | Some (file,line,_,_) -> 
+      Format.fprintf Format.err_formatter ("WARN: %s,%d " ^^ f ^^ "@.") file line  
   else 
-    Format.ifprintf Format.err_formatter ("WARN: %s " ^^ f ^^ "@.") str  
+    Format.ifprintf Format.err_formatter ("WARN: " ^^ f ^^ "@.") 
 
 let info str f  =
   Format.fprintf Format.err_formatter ("INFO: %s " ^^ f) str  

jscomp/common/ext_log.mli

@@ -46,6 +46,10 @@ val err : string -> 'a logging
 val ierr : bool -> string -> 'a logging 
 val warn : string -> 'a logging
 val iwarn : bool -> string -> 'a logging 
-val dwarn : string -> 'a logging 
+
+val dwarn : 
+  ?__POS__:(string * int * int *int) ->
+  'a logging 
+  
 val info : string -> 'a logging
 val iinfo : bool -> string -> 'a logging

jscomp/core/js_implementation.ml

@@ -79,20 +79,23 @@ let after_parsing_sig ppf sourcefile outputprefix ast  =
       end
     end
 let interface ppf sourcefile outputprefix =
+  Js_config.set_current_file sourcefile ; 
   Compmisc.init_path false;
   Ocaml_parse.parse_interface ppf sourcefile
   |> print_if ppf Clflags.dump_parsetree Printast.interface
   |> print_if ppf Clflags.dump_source Pprintast.signature 
   |> after_parsing_sig ppf sourcefile outputprefix 
 
 let interface_mliast ppf sourcefile outputprefix  = 
+  Js_config.set_current_file sourcefile ; 
   Compmisc.init_path false;
   Binary_ast.read_ast Mli sourcefile 
   |> print_if ppf Clflags.dump_parsetree Printast.interface
   |> print_if ppf Clflags.dump_source Pprintast.signature 
   |> after_parsing_sig ppf sourcefile outputprefix 
 
 let after_parsing_impl ppf sourcefile outputprefix ast =
+  
   if !Js_config.binary_ast then
     Binary_ast.write_ast ~fname:sourcefile 
       Ml ~output:(outputprefix ^ Literals.suffix_mlast)
@@ -156,13 +159,15 @@ let after_parsing_impl ppf sourcefile outputprefix ast =
     end
 let implementation ppf sourcefile outputprefix =
   Compmisc.init_path false;
+  Js_config.set_current_file sourcefile ; 
   Ocaml_parse.parse_implementation ppf sourcefile
   |> print_if ppf Clflags.dump_parsetree Printast.implementation
   |> print_if ppf Clflags.dump_source Pprintast.structure
   |> after_parsing_impl ppf sourcefile outputprefix 
 
 let implementation_mlast ppf sourcefile outputprefix = 
   Compmisc.init_path false;
+  Js_config.set_current_file sourcefile ; 
   Binary_ast.read_ast Ml sourcefile
   |> print_if ppf Clflags.dump_parsetree Printast.implementation
   |> print_if ppf Clflags.dump_source Pprintast.structure

jscomp/core/js_pass_debug.ml

@@ -39,7 +39,7 @@ let dump name (prog : J.program) =
       then 
         begin
           incr log_counter ; 
-          Ext_log.dwarn __LOC__ "\n@[[TIME:]%s: %f@]@." name (Sys.time () *. 1000.);          
+          Ext_log.dwarn ~__POS__ "\n@[[TIME:]%s: %f@]@." name (Sys.time () *. 1000.);          
           Ext_pervasives.with_file_as_chan       
             (Ext_path.chop_extension ~loc:__LOC__ (Js_config.get_current_file()) ^
              (Printf.sprintf ".%02d.%s.jsx"  !log_counter name)

jscomp/core/lam_compile_const.ml

@@ -84,7 +84,7 @@ and translate (x : Lam_constant.t ) : J.expression =
     E.str  i 
   | Const_unicode i -> 
     E.unicode i 
-    (* E.str i ~delimiter:Literals.escaped_j_delimiter *)   
+
 
   | Const_pointer (c,pointer_info) ->     
     E.int ?comment:(Lam_compile_util.comment_of_pointer_info pointer_info)

jscomp/core/lam_compile_main.ml

@@ -135,17 +135,17 @@ let compile  ~filename (output_prefix : string) env _sigs
   let () = 
 #if BS_DEBUG then     
     export_idents |> List.iter 
-      (fun (id : Ident.t) -> Ext_log.dwarn __LOC__ "export: %s/%d"  id.name id.stamp) ;
+      (fun (id : Ident.t) -> Ext_log.dwarn ~__POS__ "export: %s/%d"  id.name id.stamp) ;
 #end      
     Lam_compile_env.reset () ;
   in 
   let lam, may_required_modules = Lam_convert.convert export_ident_sets lam in 
   let _d  = fun s lam -> 
     let result = Lam_util.dump env s lam  in
 #if BS_DEBUG then 
-    Ext_log.dwarn __LOC__ "START CHECKING PASS %s@." s;
+    Ext_log.dwarn ~__POS__ "START CHECKING PASS %s@." s;
     ignore @@ Lam_check.check (Js_config.get_current_file ()) lam;
-    Ext_log.dwarn __LOC__ "FINISH CHECKING PASS %s@." s;
+    Ext_log.dwarn ~__POS__ "FINISH CHECKING PASS %s@." s;
 #end
     result 
   in
@@ -200,7 +200,7 @@ let compile  ~filename (output_prefix : string) env _sigs
 #if BS_DEBUG then    
     |> (fun lam -> 
        let () = 
-        Ext_log.dwarn __LOC__ "Before coercion: %a@." Lam_stats.print meta in 
+        Ext_log.dwarn ~__POS__ "Before coercion: %a@." Lam_stats.print meta in 
       Lam_check.check (Js_config.get_current_file ()) lam
     ) 
 #end    
@@ -212,7 +212,7 @@ let compile  ~filename (output_prefix : string) env _sigs
 
 #if BS_DEBUG then   
   let () =
-    Ext_log.dwarn __LOC__ "After coercion: %a@." Lam_stats.print meta ;
+    Ext_log.dwarn ~__POS__ "After coercion: %a@." Lam_stats.print meta ;
     if Js_config.is_same_file () then
       let f =
         Ext_path.chop_extension ~loc:__LOC__ filename ^ ".lambda" in
@@ -224,15 +224,15 @@ let compile  ~filename (output_prefix : string) env _sigs
 #end  
   let maybe_pure = no_side_effects groups in
 #if BS_DEBUG then 
-  let () = Ext_log.dwarn __LOC__ "\n@[[TIME:]Pre-compile: %f@]@."  (Sys.time () *. 1000.) in      
+  let () = Ext_log.dwarn ~__POS__ "\n@[[TIME:]Pre-compile: %f@]@."  (Sys.time () *. 1000.) in      
 #end  
   let body  =     
     Ext_list.map groups (fun group -> compile_group meta group)
     |> Js_output.concat
     |> Js_output.output_as_block
   in
 #if BS_DEBUG then 
-  let () = Ext_log.dwarn __LOC__ "\n@[[TIME:]Post-compile: %f@]@."  (Sys.time () *. 1000.) in      
+  let () = Ext_log.dwarn ~__POS__ "\n@[[TIME:]Post-compile: %f@]@."  (Sys.time () *. 1000.) in      
 #end    
   (* The file is not big at all compared with [cmo] *)
   (* Ext_marshal.to_file (Ext_path.chop_extension filename ^ ".mj")  js; *)
@@ -295,7 +295,6 @@ let lambda_as_module
     (filename : string) 
     (output_prefix : string)
     (lam : Lambda.lambda) = 
-  Js_config.set_current_file filename ;   
   let lambda_output = 
     compile ~filename output_prefix finalenv current_signature lam in
   let basename =  

jscomp/core/lam_pass_lets_dce.ml

@@ -261,6 +261,6 @@ let apply_lets  occ lambda =
 let simplify_lets  (lam : Lam.t) = 
   let occ =  Lam_pass_count.collect_occurs  lam in 
 #if BS_DEBUG then 
-  Ext_log.dwarn "OCCTBL" "@[%a@]@." Lam_pass_count.pp_occ_tbl occ ;
+  Ext_log.dwarn ~__POS__ "@[%a@]@." Lam_pass_count.pp_occ_tbl occ ;
 #end
   apply_lets  occ   lam

jscomp/core/lam_stats_export.ml

@@ -86,7 +86,7 @@ let values_of_export
                    Ident_map.is_empty free_variables
                then 
                  begin
-                   Ext_log.dwarn __LOC__ "%s recorded for inlining @." x.name ;
+                   Ext_log.dwarn ~__POS__ "%s recorded for inlining @." x.name ;
                    Some lambda
                  end
                else None

jscomp/core/lam_util.ml

@@ -233,7 +233,7 @@ let dump env ext  lam =
       (* ATTENTION: easy to introduce a bug during refactoring when forgeting `begin` `end`*)
       begin 
         incr log_counter;
-        Ext_log.dwarn __LOC__ "\n@[[TIME:]%s: %f@]@." ext (Sys.time () *. 1000.);
+        Ext_log.dwarn ~__POS__ "\n@[[TIME:]%s: %f@]@." ext (Sys.time () *. 1000.);
         Lam_print.seriaize env 
           (Ext_path.chop_extension 
              ~loc:__LOC__ 

jscomp/syntax/ast_attributes.ml

@@ -226,54 +226,26 @@ let iter_process_bs_string_int_unwrap_uncurry attrs =
     ) attrs;
     !st 
 
-(* let process_bs_string_int_unwrap_uncurry attrs =
-  List.fold_left
-    (fun (st,attrs)
-      (({txt ; loc}, (payload : _ ) ) as attr : attr)  ->
-      match  txt, st  with
-      | "bs.string", (`Nothing | `String)
-        -> `String, attrs
-      | "bs.int", (`Nothing | `Int)
-        ->  `Int, attrs
-      | "bs.ignore", (`Nothing | `Ignore)
-        -> `Ignore, attrs
-      | "bs.unwrap", (`Nothing | `Unwrap)
-        -> `Unwrap, attrs
-      | "bs.uncurry", `Nothing
-        ->
-        `Uncurry (Ast_payload.is_single_int payload), attrs
-      (* Don't allow duplicated [bs.uncurry] since
-         it may introduce inconsistency in arity
-      *)
-      | "bs.int", _
-      | "bs.string", _
-      | "bs.ignore", _
-      | "bs.unwrap", _
-        ->
-        Bs_syntaxerr.err loc Conflict_attributes
-      | _ , _ -> st, (attr :: attrs )
-    ) (`Nothing, []) attrs *)
-
 
 let iter_process_bs_string_as  (attrs : t) : string option =
   let st = ref None in
-  List.iter
+  Ext_list.iter attrs
     (fun
-      (({txt ; loc}, payload ) as attr : attr)  ->
+      (({txt ; loc}, payload ) as attr )  ->
       match  txt with
       | "bs.as"
         ->
         if !st = None then
           match Ast_payload.is_single_string payload with
           | None ->
             Bs_syntaxerr.err loc Expect_string_literal
-          | Some  (v,_dec) ->
+          | Some  (v,_dec) ->            
             Bs_ast_invariant.mark_used_bs_attribute attr ;
             st:= Some v
         else
           Bs_syntaxerr.err loc Duplicated_bs_as
       | _  -> ()
-    ) attrs;
+    ) ;
   !st
 
 let has_bs_optional  (attrs : t) : bool =

jscomp/syntax/ast_derive_js_mapper.ml

@@ -206,24 +206,22 @@ let init () =
                           (PStr
                              [Str.eval  
                                 (Exp.record
-                                   (List.map 
-                                      (fun ({pld_name = {loc; txt } } : Parsetree.label_declaration) -> 
+                                   (Ext_list.map label_declarations
+                                      (fun {pld_name = {loc; txt } }  -> 
                                          let label = 
                                            {Asttypes.loc; txt = Longident.Lident txt } in 
-                                         label,Exp.field exp_param label
-                                      ) label_declarations) None)]))) in 
+                                         label,Exp.field exp_param label) ) None)]))) in 
                  let toJs = 
                    toJsBody exp
                  in 
                  let obj_exp = 
                    Exp.record
-                     (List.map 
-                        (fun ({pld_name = {loc; txt } } : Parsetree.label_declaration) -> 
+                     (Ext_list.map label_declarations
+                        (fun {pld_name = {loc; txt } } -> 
                            let label = 
                              {Asttypes.loc; txt = Longident.Lident txt } in 
                            label,
-                           js_field exp_param  label
-                        ) label_declarations) None in 
+                           js_field exp_param  label) ) None in 
                  let fromJs = 
                    Ast_comb.single_non_rec_value patFromJs
                      (Ast_compatible.fun_ (Pat.var pat_param)
@@ -259,13 +257,14 @@ let init () =
                           Ast_comb.single_non_rec_value 
                             {loc; txt = constantArray}
                             (Exp.array
-                               (List.map (fun (i,str) -> 
-                                    Exp.tuple 
-                                      [
-                                        Ast_compatible.const_exp_int i;
-                                        Ast_compatible.const_exp_string str
-                                      ]
-                                  ) (List.sort (fun (a,_) (b,_) -> compare (a:int) b) result)));
+                               (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 
@@ -320,7 +319,6 @@ let init () =
                        Ast_comb.single_non_rec_value 
                          {loc; txt = constantArray}
                          (Ast_compatible.const_exp_int_list_as_array xs)
-                         (* (Exp.array (List.map (fun i -> Ast_compatible.const_exp_int i) xs )) *)
                        ;
                        toJsBody                        
                          (
@@ -433,10 +431,9 @@ let init () =
                   let objType flag =                     
                     Ast_comb.to_js_type loc @@  
                     Ast_compatible.object_
-                      (List.map 
-                         (fun ({pld_name = {loc; txt }; pld_type } : Parsetree.label_declaration) -> 
-                            txt, [], pld_type
-                         ) label_declarations) 
+                      (Ext_list.map label_declarations
+                         (fun {pld_name = {loc; txt }; pld_type } -> 
+                            txt, [], pld_type)) 
                       flag in                   
                   newTypeStr +? 
                   [
@@ -476,7 +473,7 @@ let init () =
                       else Ast_literal.type_int() in 
                     let ty2 = 
                       if createType then core_type
-                      else Ast_core_type.lift_option_type core_type in 
+                      else Ast_core_type.lift_option_type core_type (*-FIXME**) in 
                     newTypeStr +? 
                     [
                       toJsType ty1;

jscomp/syntax/ast_polyvar.ml

@@ -97,7 +97,7 @@ let map_row_fields_into_strings ptyp_loc
     Ext_list.fold_right row_fields (`Nothing, []) (fun tag (nullary, acc) -> 
          match nullary, tag with 
          | (`Nothing | `Null), 
-           Parsetree.Rtag (label, attrs, true,  [])
+           Rtag (label, attrs, true,  [])
            -> 
            begin match Ast_attributes.iter_process_bs_string_as attrs with 
              | Some name -> 
@@ -106,7 +106,7 @@ let map_row_fields_into_strings ptyp_loc
              | None -> 
                `Null, ((hash_label label, label_of_name label) :: acc )
            end
-         | (`Nothing | `NonNull), Parsetree.Rtag(label, attrs, false, ([ _ ])) 
+         | (`Nothing | `NonNull), Rtag(label, attrs, false, ([ _ ])) 
            -> 
            begin match Ast_attributes.iter_process_bs_string_as attrs with 
              | Some name ->