Route mk_builtin and apply through the folding constructors

lambda.mli says a term can only be built through the constructors, seven of
which normalize as they build. That held for every client and not for the
module itself: mk_builtin and apply constructed Lprim directly, which they
could do only because they own the type.

mk_builtin is the path every builtin operator takes, so nothing folded at
production. [1. < (1. < 1. ? 1. : 10.)] left translation with both float
comparisons intact; it now folds to a constant. apply's eta reduction
substituted the arguments into the primitive call and left the result
unfolded, so [((a, b) => a + b)(1, 2)] became [(+ 1 2)] rather than [3]. apply
was defined above prim and could not call it; nothing between them refers to
apply, so it moves below.

The effect was invisible because the optimizer passes rebuild every node
through the constructors, and were folding this incidentally on the way past.
It showed up while measuring what a pass allocates when it changes nothing:
converting one pass to a sharing traversal made its output four nodes larger
on ppx_apply_test, which is the beta reduction above going unfolded.

Generated JavaScript is unchanged - the folding happened either way, just
later and repeatedly.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01W8g8qwBARAcvW9MyuKQq8H

Author: cristianoc

compiler/ml/lambda.ml

@@ -766,61 +766,6 @@ let rec is_eta_conversion_exn params inner_args outer_args : t list =
   | [], [], [] -> []
   | _, _, _ -> raise_notrace Not_simple_form
 
-let rec apply ?(ap_transformed_jsx = false) fn args (ap_info : ap_info) : t =
-  match fn with
-  | Lfunction
-      {
-        params;
-        body =
-          Lprim
-            {
-              primitive =
-                ( Pnull_to_opt | Pnull_undefined_to_opt | Pis_null
-                | Pis_null_undefined | Ptypeof ) as wrap;
-              args =
-                [Lprim ({primitive = _; args = inner_args} as primitive_call)];
-            };
-      } -> (
-    match is_eta_conversion_exn params inner_args args with
-    | args ->
-      let loc = ap_info.ap_loc in
-      Lprim
-        {primitive = wrap; args = [Lprim {primitive_call with args; loc}]; loc}
-    | exception Not_simple_form ->
-      Lapply {ap_func = fn; ap_args = args; ap_info; ap_transformed_jsx})
-  | Lfunction
-      {
-        params;
-        body = Lprim ({primitive = _; args = inner_args} as primitive_call);
-      } -> (
-    match is_eta_conversion_exn params inner_args args with
-    | args -> Lprim {primitive_call with args; loc = ap_info.ap_loc}
-    | exception _ ->
-      Lapply {ap_func = fn; ap_args = args; ap_info; ap_transformed_jsx})
-  | Lfunction
-      {
-        params;
-        body =
-          Lsequence
-            ( Lprim ({primitive = _; args = inner_args} as primitive_call),
-              (Lconst _ as const) );
-      } -> (
-    match is_eta_conversion_exn params inner_args args with
-    | args ->
-      Lsequence (Lprim {primitive_call with args; loc = ap_info.ap_loc}, const)
-    | exception _ ->
-      Lapply {ap_func = fn; ap_args = args; ap_info; ap_transformed_jsx}
-      (* | Lfunction {params;body} when Ext_list.same_length params args ->
-          Ext_list.fold_right2 (fun p arg acc ->
-            Llet(Strict,p,arg,acc)
-          ) params args body *)
-      (* TODO: more rigirous analysis on [let_kind] *))
-  | Llet (kind, id, e, (Lfunction _ as fn)) ->
-    Llet (kind, id, e, apply fn args ap_info ~ap_transformed_jsx)
-  (* | Llet (kind0, id0, e0, Llet (kind,id, e, (Lfunction _ as fn))) ->
-     Llet(kind0,id0,e0,Llet (kind, id, e, apply fn args loc status)) *)
-  | _ -> Lapply {ap_func = fn; ap_args = args; ap_info; ap_transformed_jsx}
-
 let rec eq_approx (l1 : t) (l2 : t) =
   match l1 with
   | Lglobal_module i1 -> (
@@ -1082,6 +1027,62 @@ let prim ~primitive:(prim : primitive) ~args loc : t =
     *)
     | _ -> default ())
 
+let rec apply ?(ap_transformed_jsx = false) fn args (ap_info : ap_info) : t =
+  match fn with
+  | Lfunction
+      {
+        params;
+        body =
+          Lprim
+            {
+              primitive =
+                ( Pnull_to_opt | Pnull_undefined_to_opt | Pis_null
+                | Pis_null_undefined | Ptypeof ) as wrap;
+              args =
+                [Lprim ({primitive = _; args = inner_args} as primitive_call)];
+            };
+      } -> (
+    match is_eta_conversion_exn params inner_args args with
+    | args ->
+      let loc = ap_info.ap_loc in
+      prim ~primitive:wrap
+        ~args:[prim ~primitive:primitive_call.primitive ~args loc]
+        loc
+    | exception Not_simple_form ->
+      Lapply {ap_func = fn; ap_args = args; ap_info; ap_transformed_jsx})
+  | Lfunction
+      {
+        params;
+        body = Lprim ({primitive = _; args = inner_args} as primitive_call);
+      } -> (
+    match is_eta_conversion_exn params inner_args args with
+    | args -> prim ~primitive:primitive_call.primitive ~args ap_info.ap_loc
+    | exception _ ->
+      Lapply {ap_func = fn; ap_args = args; ap_info; ap_transformed_jsx})
+  | Lfunction
+      {
+        params;
+        body =
+          Lsequence
+            ( Lprim ({primitive = _; args = inner_args} as primitive_call),
+              (Lconst _ as const) );
+      } -> (
+    match is_eta_conversion_exn params inner_args args with
+    | args ->
+      seq (prim ~primitive:primitive_call.primitive ~args ap_info.ap_loc) const
+    | exception _ ->
+      Lapply {ap_func = fn; ap_args = args; ap_info; ap_transformed_jsx}
+      (* | Lfunction {params;body} when Ext_list.same_length params args ->
+          Ext_list.fold_right2 (fun p arg acc ->
+            Llet(Strict,p,arg,acc)
+          ) params args body *)
+      (* TODO: more rigirous analysis on [let_kind] *))
+  | Llet (kind, id, e, (Lfunction _ as fn)) ->
+    let_ kind id e (apply fn args ap_info ~ap_transformed_jsx)
+  (* | Llet (kind0, id0, e0, Llet (kind,id, e, (Lfunction _ as fn))) ->
+     Llet(kind0,id0,e0,Llet (kind, id, e, apply fn args loc status)) *)
+  | _ -> Lapply {ap_func = fn; ap_args = args; ap_info; ap_transformed_jsx}
+
 let not_ loc x : t =
   match x with
   | Lprim ({primitive = Pintcomp Cneq} as prim) ->
@@ -1265,7 +1266,7 @@ let sequand l r = if_ l r lambda_false
 
 let mk_builtin b args loc =
   match b with
-  | Primitive p -> Lprim {primitive = p; args; loc}
+  | Primitive p -> prim ~primitive:p ~args loc
   | Constant c -> (
     match args with
     | [] -> Lconst c
@@ -1280,7 +1281,7 @@ let mk_builtin b args loc =
     | _ -> assert false)
   | Eliminated Ignore -> (
     match args with
-    | [arg] -> Lsequence (arg, lambda_unit)
+    | [arg] -> seq arg lambda_unit
     | _ -> assert false)
 
 let default_function_attribute =