Merge pull request #4300 from BuckleScript/tweak

fix #4274

Author: bobzhang

jscomp/syntax/ast_uncurry_gen.ml

@@ -62,6 +62,7 @@ let to_method_callback  loc (self : Bs_ast_mapper.mapper)
          )])
 
 let to_uncurry_fn  loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label) pat body 
+    : Parsetree.expression_desc
   = 
   Bs_syntaxerr.optional_err loc label;  
   let rec aux acc (body : Parsetree.expression) = 
@@ -92,14 +93,11 @@ let to_uncurry_fn  loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label
   in 
   Bs_syntaxerr.err_large_arity loc arity;
   let arity_s = string_of_int arity in   
-  Parsetree.Pexp_constraint(
-    Exp.record ~loc [
+  Pexp_record ([
       {
-        txt = Ast_literal.Lid.hidden_field arity_s;
+        txt = Ldot (Ast_literal.Lid.js_fn, "I" ^ arity_s);
         loc
-      },body] None, Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn,"arity"^arity_s);loc}
-      [Typ.any ~loc ()]
-  )
+      },body], None)
 
 
 

jscomp/test/build.ninja

@@ -320,6 +320,7 @@ build test/gpr_405_test.cmj : cc_cmi test/gpr_405_test.ml | test/gpr_405_test.cm
 build test/gpr_405_test.cmi : cc test/gpr_405_test.mli | $stdlib
 build test/gpr_4069_test.cmi test/gpr_4069_test.cmj : cc test/gpr_4069_test.ml | $stdlib
 build test/gpr_4265_test.cmi test/gpr_4265_test.cmj : cc test/gpr_4265_test.ml | test/mt.cmj $stdlib
+build test/gpr_4274_test.cmi test/gpr_4274_test.cmj : cc test/gpr_4274_test.ml | $stdlib
 build test/gpr_4280_test.cmi test/gpr_4280_test.cmj : cc test/gpr_4280_test.ml | test/mt.cmj $stdlib
 build test/gpr_441.cmi test/gpr_441.cmj : cc test/gpr_441.ml | $stdlib
 build test/gpr_459_test.cmi test/gpr_459_test.cmj : cc test/gpr_459_test.ml | test/mt.cmj $stdlib

jscomp/test/gpr_4274_test.js

@@ -0,0 +1,41 @@
+'use strict';
+
+var Belt_List = require("../../lib/js/belt_List.js");
+var Belt_Array = require("../../lib/js/belt_Array.js");
+
+var N = { };
+
+function f(X, xs) {
+  return X.forEach(xs, {
+              i: (function (x) {
+                  console.log(x.x);
+                  
+                })
+            });
+}
+
+Belt_List.forEachU(/* :: */[
+      {
+        x: 3
+      },
+      /* [] */0
+    ], (function (x) {
+        console.log(x.x);
+        
+      }));
+
+var Foo = { };
+
+var bar = [{
+    foo: "bar"
+  }];
+
+Belt_Array.mapU(bar, (function (b) {
+        return b.foo;
+      }));
+
+exports.N = N;
+exports.f = f;
+exports.Foo = Foo;
+exports.bar = bar;
+/*  Not a pure module */

jscomp/test/gpr_4274_test.ml

@@ -0,0 +1,22 @@
+module N = struct 
+  type t = { x : int}
+end
+
+module type X = sig 
+  type 'a f = {i : 'a }  
+  val forEach : 'a array ->  ('a -> unit) f -> unit [@bs]
+end  
+
+(* type annotation here interferes.. *)
+let f (module X : X) (xs : N.t array) =
+  X.forEach xs ({ X.i = fun x -> Js.log x.x} ) [@bs]
+
+
+;; Belt.List.forEachU [{N.x=3}] (fun[@bs] x -> Js.log x.x)
+
+
+module Foo = struct type record = {
+                      foo: string;} end
+let bar = [|{ Foo.foo = (("bar")[@reason.raw_literal "bar"]) }|]
+
+let _ = Belt.Array.mapU bar ((fun[@bs ] b  -> b.foo))

lib/4.06.1/unstable/js_compiler.ml

@@ -305991,6 +305991,7 @@ let to_method_callback  loc (self : Bs_ast_mapper.mapper)
          )])
 
 let to_uncurry_fn  loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label) pat body 
+    : Parsetree.expression_desc
   = 
   Bs_syntaxerr.optional_err loc label;  
   let rec aux acc (body : Parsetree.expression) = 
@@ -306021,14 +306022,11 @@ let to_uncurry_fn  loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label
   in 
   Bs_syntaxerr.err_large_arity loc arity;
   let arity_s = string_of_int arity in   
-  Parsetree.Pexp_constraint(
-    Exp.record ~loc [
+  Pexp_record ([
       {
-        txt = Ast_literal.Lid.hidden_field arity_s;
+        txt = Ldot (Ast_literal.Lid.js_fn, "I" ^ arity_s);
         loc
-      },body] None, Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn,"arity"^arity_s);loc}
-      [Typ.any ~loc ()]
-  )
+      },body], None)
 
 
 

lib/4.06.1/unstable/js_refmt_compiler.ml

@@ -305991,6 +305991,7 @@ let to_method_callback  loc (self : Bs_ast_mapper.mapper)
          )])
 
 let to_uncurry_fn  loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label) pat body 
+    : Parsetree.expression_desc
   = 
   Bs_syntaxerr.optional_err loc label;  
   let rec aux acc (body : Parsetree.expression) = 
@@ -306021,14 +306022,11 @@ let to_uncurry_fn  loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label
   in 
   Bs_syntaxerr.err_large_arity loc arity;
   let arity_s = string_of_int arity in   
-  Parsetree.Pexp_constraint(
-    Exp.record ~loc [
+  Pexp_record ([
       {
-        txt = Ast_literal.Lid.hidden_field arity_s;
+        txt = Ldot (Ast_literal.Lid.js_fn, "I" ^ arity_s);
         loc
-      },body] None, Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn,"arity"^arity_s);loc}
-      [Typ.any ~loc ()]
-  )
+      },body], None)
 
 
 

lib/4.06.1/unstable/native_ppx.ml

@@ -21285,6 +21285,7 @@ let to_method_callback  loc (self : Bs_ast_mapper.mapper)
          )])
 
 let to_uncurry_fn  loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label) pat body 
+    : Parsetree.expression_desc
   = 
   Bs_syntaxerr.optional_err loc label;  
   let rec aux acc (body : Parsetree.expression) = 
@@ -21315,14 +21316,11 @@ let to_uncurry_fn  loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label
   in 
   Bs_syntaxerr.err_large_arity loc arity;
   let arity_s = string_of_int arity in   
-  Parsetree.Pexp_constraint(
-    Exp.record ~loc [
+  Pexp_record ([
       {
-        txt = Ast_literal.Lid.hidden_field arity_s;
+        txt = Ldot (Ast_literal.Lid.js_fn, "I" ^ arity_s);
         loc
-      },body] None, Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn,"arity"^arity_s);loc}
-      [Typ.any ~loc ()]
-  )
+      },body], None)
 
 
 

lib/4.06.1/whole_compiler.ml

@@ -410975,6 +410975,7 @@ let to_method_callback  loc (self : Bs_ast_mapper.mapper)
          )])
 
 let to_uncurry_fn  loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label) pat body 
+    : Parsetree.expression_desc
   = 
   Bs_syntaxerr.optional_err loc label;  
   let rec aux acc (body : Parsetree.expression) = 
@@ -411005,14 +411006,11 @@ let to_uncurry_fn  loc (self : Bs_ast_mapper.mapper) (label : Asttypes.arg_label
   in 
   Bs_syntaxerr.err_large_arity loc arity;
   let arity_s = string_of_int arity in   
-  Parsetree.Pexp_constraint(
-    Exp.record ~loc [
+  Pexp_record ([
       {
-        txt = Ast_literal.Lid.hidden_field arity_s;
+        txt = Ldot (Ast_literal.Lid.js_fn, "I" ^ arity_s);
         loc
-      },body] None, Typ.constr ~loc {txt = Ldot (Ast_literal.Lid.js_fn,"arity"^arity_s);loc}
-      [Typ.any ~loc ()]
-  )
+      },body], None)