Support type expansion in partial application.

Author: cristianoc

jscomp/build_tests/super_errors/fixtures/bucklescript.res

@@ -2949,12 +2949,12 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
     tvar || List.mem l ls
   in
   let ignored = ref [] in
-  let extract_uncurried t =
-    match t.desc with
+  let extract_uncurried_type t =
+    match (expand_head env t).desc with
     | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[t],_) -> t
     | _ -> t in
   let lower_uncurried_arity ~nargs t newT =
-    match t.desc with
+    match (expand_head env t).desc with
     | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),a,_),[_],_) ->
       let arity =
         if String.sub a 0 5 = "arity"
@@ -3078,10 +3078,12 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
       end;
       ([Nolabel, Some exp], ty_res)
   | _ ->
-      let ty_ = funct.exp_type in
-      let ty = extract_uncurried ty_ in
+      let ty = extract_uncurried_type funct.exp_type in
       let targs, ret_t = type_args [] [] ~ty_fun:ty (instance env ty) ~sargs in
-      targs, lower_uncurried_arity ty_ ~nargs:(List.length !ignored + List.length sargs) ret_t
+      let ret_t =
+        if funct.exp_type == ty then ret_t
+        else lower_uncurried_arity funct.exp_type ~nargs:(List.length !ignored + List.length sargs) ret_t in
+      targs, ret_t
 
 and type_construct env loc lid sarg ty_expected attrs =
   let opath =

jscomp/build_tests/super_errors/fixtures/uncurry_in_curry.res

@@ -64,7 +64,7 @@ function still2Args(param, param$1) {
   return withOpts(undefined, 4, param, param$1);
 }
 
-var anInt = still2Args(3, 5);
+var anInt = Curry._1(still2Args, 3)(5);
 
 var StandardNotation = {
   testRaise: testRaise,
@@ -118,7 +118,11 @@ function still2Args$1(param, param$1) {
   return withOpts$1(undefined, 4, param, param$1);
 }
 
-var anInt$1 = still2Args$1(3, 5);
+var partial_arg$2 = 3;
+
+var anInt$1 = (function (param) {
+      return still2Args$1(partial_arg$2, param);
+    })(5);
 
 exports.Uncurried = Uncurried;
 exports.E = E;

jscomp/ml/typecore.ml

@@ -18,8 +18,9 @@ module StandardNotation = {
   let ll = partial((. x) => x + 1)
 
   let withOpts = (. ~x=3, y, ~z=4, w) => x + y + z + w
-  let still2Args : (. ~z: int=?, int) => int = withOpts(4)
-  let anInt = still2Args(. ~z=3, 5)
+  type unc2 = (. ~z: int=?, int) => int
+  let still2Args : unc2 = withOpts(4)
+  let anInt = still2Args(~z=3)(. 5)
 }
 
 @@uncurried
@@ -33,5 +34,6 @@ let partial = List.map(. list{1, 2})
 let ll = partial(.x => x + 1)
 
 let withOpts = (~x=3, y, ~z=4, w) => x + y + z + w
-let still2Args : (~z: int=?, int) => int = withOpts(. 4)
-let anInt = still2Args(~z=3, 5)
+type unc2 = (~z: int=?, int) => int
+let still2Args : unc2 = withOpts(. 4)
+let anInt = still2Args(. ~z=3)(5)

jscomp/test/uncurried_cast.js

@@ -43647,12 +43647,12 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
     tvar || List.mem l ls
   in
   let ignored = ref [] in
-  let extract_uncurried t =
-    match t.desc with
+  let extract_uncurried_type t =
+    match (expand_head env t).desc with
     | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[t],_) -> t
     | _ -> t in
   let lower_uncurried_arity ~nargs t newT =
-    match t.desc with
+    match (expand_head env t).desc with
     | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),a,_),[_],_) ->
       let arity =
         if String.sub a 0 5 = "arity"
@@ -43776,10 +43776,12 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
       end;
       ([Nolabel, Some exp], ty_res)
   | _ ->
-      let ty_ = funct.exp_type in
-      let ty = extract_uncurried ty_ in
+      let ty = extract_uncurried_type funct.exp_type in
       let targs, ret_t = type_args [] [] ~ty_fun:ty (instance env ty) ~sargs in
-      targs, lower_uncurried_arity ty_ ~nargs:(List.length !ignored + List.length sargs) ret_t
+      let ret_t =
+        if funct.exp_type == ty then ret_t
+        else lower_uncurried_arity funct.exp_type ~nargs:(List.length !ignored + List.length sargs) ret_t in
+      targs, ret_t
 
 and type_construct env loc lid sarg ty_expected attrs =
   let opath =

jscomp/test/uncurried_cast.res

@@ -43647,12 +43647,12 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
     tvar || List.mem l ls
   in
   let ignored = ref [] in
-  let extract_uncurried t =
-    match t.desc with
+  let extract_uncurried_type t =
+    match (expand_head env t).desc with
     | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[t],_) -> t
     | _ -> t in
   let lower_uncurried_arity ~nargs t newT =
-    match t.desc with
+    match (expand_head env t).desc with
     | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),a,_),[_],_) ->
       let arity =
         if String.sub a 0 5 = "arity"
@@ -43776,10 +43776,12 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
       end;
       ([Nolabel, Some exp], ty_res)
   | _ ->
-      let ty_ = funct.exp_type in
-      let ty = extract_uncurried ty_ in
+      let ty = extract_uncurried_type funct.exp_type in
       let targs, ret_t = type_args [] [] ~ty_fun:ty (instance env ty) ~sargs in
-      targs, lower_uncurried_arity ty_ ~nargs:(List.length !ignored + List.length sargs) ret_t
+      let ret_t =
+        if funct.exp_type == ty then ret_t
+        else lower_uncurried_arity funct.exp_type ~nargs:(List.length !ignored + List.length sargs) ret_t in
+      targs, ret_t
 
 and type_construct env loc lid sarg ty_expected attrs =
   let opath =

lib/4.06.1/unstable/js_compiler.ml

@@ -98642,12 +98642,12 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
     tvar || List.mem l ls
   in
   let ignored = ref [] in
-  let extract_uncurried t =
-    match t.desc with
+  let extract_uncurried_type t =
+    match (expand_head env t).desc with
     | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),_,_),[t],_) -> t
     | _ -> t in
   let lower_uncurried_arity ~nargs t newT =
-    match t.desc with
+    match (expand_head env t).desc with
     | Tconstr (Pdot (Pdot(Pident {name = "Js"},"Fn",_),a,_),[_],_) ->
       let arity =
         if String.sub a 0 5 = "arity"
@@ -98771,10 +98771,12 @@ and type_application env funct (sargs : sargs) : targs * Types.type_expr =
       end;
       ([Nolabel, Some exp], ty_res)
   | _ ->
-      let ty_ = funct.exp_type in
-      let ty = extract_uncurried ty_ in
+      let ty = extract_uncurried_type funct.exp_type in
       let targs, ret_t = type_args [] [] ~ty_fun:ty (instance env ty) ~sargs in
-      targs, lower_uncurried_arity ty_ ~nargs:(List.length !ignored + List.length sargs) ret_t
+      let ret_t =
+        if funct.exp_type == ty then ret_t
+        else lower_uncurried_arity funct.exp_type ~nargs:(List.length !ignored + List.length sargs) ret_t in
+      targs, ret_t
 
 and type_construct env loc lid sarg ty_expected attrs =
   let opath =