Experiment with emitting functors as 1 arg at a time

See #7245

Author: cristianoc

compiler/ml/translmod.ml

@@ -220,7 +220,7 @@ let merge_inline_attributes (attr1 : Lambda.inline_attribute)
     else raise (Error (loc, Conflicting_inline_attributes))
 
 let merge_functors mexp coercion root_path =
-  let rec merge mexp coercion path acc inline_attribute =
+  let merge mexp coercion path acc inline_attribute =
     let finished = (acc, mexp, path, coercion, inline_attribute) in
     match mexp.mod_desc with
     | Tmod_functor (param, _, _, body) ->
@@ -239,9 +239,19 @@ let merge_functors mexp coercion root_path =
       let inline_attribute =
         merge_inline_attributes inline_attribute inline_attribute' loc
       in
-      merge body res_coercion path
-        ((param, loc, arg_coercion) :: acc)
-        inline_attribute
+      let r =
+        ( (param, loc, arg_coercion) :: acc,
+          body,
+          path,
+          res_coercion,
+          inline_attribute )
+      in
+      (* let _ =
+           merge body res_coercion path
+             ((param, loc, arg_coercion) :: acc)
+             inline_attribute
+         in *)
+      r
     | _ -> finished
   in
   merge mexp coercion root_path [] Default_inline

tests/tests/src/functors.mjs

@@ -10,32 +10,42 @@ function O(X) {
   };
 }
 
-function F(X, Y) {
-  let cow = x => Y.foo(X.foo(x));
-  let sheep = x => 1 + Y.foo(X.foo(x)) | 0;
-  return {
-    cow: cow,
-    sheep: sheep
+function F(X) {
+  return Y => {
+    let cow = x => Y.foo(X.foo(x));
+    let sheep = x => 1 + Y.foo(X.foo(x)) | 0;
+    return {
+      cow: cow,
+      sheep: sheep
+    };
   };
 }
 
-function F1(X, Y) {
-  let sheep = x => 1 + Y.foo(X.foo(x)) | 0;
-  return {
-    sheep: sheep
+function F1(X) {
+  return Y => {
+    let sheep = x => 1 + Y.foo(X.foo(x)) | 0;
+    return {
+      sheep: sheep
+    };
   };
 }
 
-function F2(X, Y) {
-  let sheep = x => 1 + Y.foo(X.foo(x)) | 0;
-  return {
-    sheep: sheep
+function F2(X) {
+  return Y => {
+    let sheep = x => 1 + Y.foo(X.foo(x)) | 0;
+    return {
+      sheep: sheep
+    };
   };
 }
 
 let M = {
   F: (funarg, funarg$1) => {
-    let sheep = x => 1 + funarg$1.foo(funarg.foo(x)) | 0;
+    let Y = {
+      foo: funarg$1.foo
+    };
+    let cow = x => Y.foo(funarg.foo(x));
+    let sheep = x => 1 + cow(x) | 0;
     return {
       sheep: sheep
     };

tests/tests/src/functors_one_arg_at_a_time.mjs

@@ -0,0 +1,38 @@
+// Generated by ReScript, PLEASE EDIT WITH CARE
+
+
+function Make(T) {
+  return Q => {
+    let Eq = E => (A => ({}));
+    return {
+      Eq: Eq
+    };
+  };
+}
+
+function Eq(E) {
+  return A => ({});
+}
+
+let M = {
+  Eq: Eq
+};
+
+let EQ = Eq({})({});
+
+let MF = {
+  F: (funarg, funarg$1) => ({})
+};
+
+function UseF(X) {
+  return Y => MF.F(X)(Y);
+}
+
+export {
+  Make,
+  M,
+  EQ,
+  MF,
+  UseF,
+}
+/* EQ Not a pure module */

tests/tests/src/functors_one_arg_at_a_time.res

@@ -0,0 +1,17 @@
+module Make = (T: {}, Q: {}) => {
+  module Eq = (E: {}, A: {}) => {}
+}
+
+module M = Make((), ())
+
+module EQ = M.Eq((), ())
+
+module MF: {
+  module F: (X: {}, Y: {}) => {}
+} = {
+  module F = (X: {}, Y: {}) => {
+    let c = 12
+  }
+}
+
+module UseF = (X: {}, Y: {}) => MF.F(X, Y)

tests/tests/src/recmodule.mjs

@@ -18,12 +18,14 @@ let UseCase = {
   MakeLayer: MakeLayer
 };
 
-function MakeLayer$1(Deps, UC) {
-  let presentLight = light => Deps.presentJson(light, 200);
-  let handleGetLight = req => UC.getLight(req.params.id);
-  return {
-    handleGetLight: handleGetLight,
-    presentLight: presentLight
+function MakeLayer$1(Deps) {
+  return UC => {
+    let presentLight = light => Deps.presentJson(light, 200);
+    let handleGetLight = req => UC.getLight(req.params.id);
+    return {
+      handleGetLight: handleGetLight,
+      presentLight: presentLight
+    };
   };
 }