Represent optional parameters with defaults structurally instead of by name sniffing

CHANGELOG.md

@@ -52,6 +52,7 @@
 #### :house: Internal
 
 - Give nominal variants one canonical runtime layout: compute their JavaScript representation once after typing each declaration, replace positional constructor tags with semantic runtime descriptors, and make construction, matching, coercion, printing, diagnostics, and GenType consume the stored representation instead of reinterpreting annotations. Pattern matching keeps occurrence-specific plans local without adding another Lambda or Lam expression form. https://github.com/rescript-lang/rescript/pull/8579
+- Represent optional parameters with defaults structurally, removing downstream name-based detection and producing more consistent JavaScript parameter names. https://github.com/rescript-lang/rescript/pull/8580
 - Sync the platform npm package's compiler binaries (`packages/@rescript/<platform>/bin`) via dune promotion on every `dune build`, instead of Makefile/CI copy steps that only ran when make did: a plain `dune build` can no longer leave `cli/*.js` and the test harnesses running a stale compiler. https://github.com/rescript-lang/rescript/pull/8560
 - Remove unused compiler IR definitions, modules, helpers, error variants, and Typedtree fields. https://github.com/rescript-lang/rescript/pull/8551 https://github.com/rescript-lang/rescript/pull/8555
 - Make locally abstract value constraints (`let f: type a. t = value`) structural in the parsetree, remove the obsolete `Pexp_newtype` and `Texp_newtype` wrapper metadata, and keep the old encoding confined to the frozen external-PPX bridge. The CMT magic number is bumped to `Caml1999T024`. https://github.com/rescript-lang/rescript/pull/8575

compiler/core/lam_convert.ml

@@ -320,40 +320,6 @@ let lam_prim ~primitive:(p : Lambda.primitive) ~args loc : Lam.t =
 
 let may_depend = Lam_module_ident.Hash_set.add
 
-let is_opt_param_name name =
-  (* [*opt*] historically; [*opt_<label>*] with the n-ary representation *)
-  String.length name >= 5
-  && String.sub name 0 4 = "*opt"
-  && String.get name (String.length name - 1) = '*'
-
-let rec rename_optional_parameters map params (body : Lambda.lambda) =
-  match body with
-  | Llet
-      ( k,
-        value_kind,
-        id,
-        Lifthenelse
-          ( Lprim (p, [Lvar ({name = opt_name} as opt)], p_loc),
-            Lprim (p1, [Lvar ({name = opt_name2} as opt2)], x_loc),
-            f ),
-        rest )
-    when is_opt_param_name opt_name
-         && is_opt_param_name opt_name2
-         && Ident.same opt opt2 && List.mem opt params ->
-    let map, rest = rename_optional_parameters map params rest in
-    let new_id = Ident.create (id.name ^ "Opt") in
-    ( Map_ident.add map opt new_id,
-      Lambda.Llet
-        ( k,
-          value_kind,
-          id,
-          Lifthenelse
-            ( Lprim (p, [Lvar new_id], p_loc),
-              Lprim (p1, [Lvar new_id], x_loc),
-              f ),
-          rest ) )
-  | _ -> (map, body)
-
 let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
     Lam.t * Lam_module_ident.Hash_set.t =
   let alias_tbl = Hash_ident.create 64 in
@@ -415,18 +381,8 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) :
         {ap_loc = loc; ap_inlined; ap_status = App_uncurry}
         ~ap_transformed_jsx
     | Lfunction {params; body; attr; loc} ->
-      let new_map, body =
-        rename_optional_parameters Map_ident.empty params body
-      in
-      if Map_ident.is_empty new_map then
-        Lam.function_ ~loc ~attr ~arity:(List.length params) ~params
-          ~body:(convert_aux body)
-      else
-        let params =
-          Ext_list.map params (fun x -> Map_ident.find_default new_map x x)
-        in
-        Lam.function_ ~loc ~attr ~arity:(List.length params) ~params
-          ~body:(convert_aux body)
+      Lam.function_ ~loc ~attr ~arity:(List.length params) ~params
+        ~body:(convert_aux body)
     | Llet (_, _, _, Lprim (Pgetglobal id, args, _), _body) when dynamic_import
       ->
       (*

compiler/core/lam_stats_export.ml

@@ -23,9 +23,6 @@
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
 
 (* let pp = Format.fprintf  *)
-(* we should exclude meaninglist names and do the convert as well *)
-
-(* let meaningless_names  = ["*opt*"; "param";] *)
 
 let single_na = Js_cmj_format.single_na
 

compiler/ext/config.ml

@@ -13,6 +13,6 @@ and ast0_impl_magic_number = "Caml1999M022"
 
 and ast0_intf_magic_number = "Caml1999N022"
 
-and cmt_magic_number = "Caml1999T024"
+and cmt_magic_number = "Caml1999T025"
 
 let load_path = ref ([] : string list)

compiler/gentype/translate_structure.ml

@@ -7,16 +7,15 @@ let rec addAnnotationsToTypes_ ~config ~(expr : Typedtree.expression)
     let rec zip (params : Typedtree.function_param list)
         (arg_types : arg_type list) =
       match (params, arg_types) with
-      | {fp_lbl; fp_param} :: rest_params, {a_type} :: rest_types ->
-        let a_name = Ident.name fp_param in
+      | ( {fp_lbl; fp_param; fp_has_default} :: rest_params,
+          {a_type} :: rest_types ) ->
         let a_name =
-          (* optional parameters with a default are bound to a synthetic
-             [*opt_<label>*] variable; show the label instead *)
-          if String.length a_name >= 4 && String.sub a_name 0 4 = "*opt" then
-            match fp_lbl with
-            | Optional {txt = l} -> l
-            | _ -> "" (* should not happen *)
-          else a_name
+          match fp_lbl with
+          | Optional {txt = l} when fp_has_default ->
+            (* the compiled parameter is a synthetic option carrier; show the
+               label instead *)
+            l
+          | _ -> Ident.name fp_param
         in
         {a_name; a_type} :: zip rest_params rest_types
       | [], rest -> rest |> addAnnotationsToTypes_ ~config ~expr:body

compiler/ml/matching.ml

@@ -2404,8 +2404,10 @@ let rec lower_bind v arg lam =
   | Llet (Alias, k, vv, lv, l) ->
     if approx_present v lv then bind Alias v arg lam
     else Llet (Alias, k, vv, lv, lower_bind v arg l)
-  | Lvar u when Ident.same u v && Ident.name u = "*sth*" ->
-    arg (* eliminate let *sth* = from_option x in *sth* *)
+  | Lvar u when Ident.same u v ->
+    (* eliminate [let v = arg in v]; [lower_bind] is only used for alias
+       bindings, so [arg] is pure *)
+    arg
   | _ -> bind Alias v arg lam
 
 let bind_check str v arg lam =

compiler/ml/typecore.ml

@@ -2441,10 +2441,9 @@ and type_expect_ ?deprecated_context ~context ?(recarg = Rejected) env sexp
       ty_expected
   | Pexp_let (rec_flag, spat_sexp_list, sbody) ->
     let scp =
-      match (sexp.pexp_attributes, rec_flag) with
-      | [({txt = "#default"}, _)], _ -> None
-      | _, Recursive -> Some (Annot.Idef loc)
-      | _, Nonrecursive -> Some (Annot.Idef sbody.pexp_loc)
+      match rec_flag with
+      | Recursive -> Some (Annot.Idef loc)
+      | Nonrecursive -> Some (Annot.Idef sbody.pexp_loc)
     in
     let pat_exp_list, new_env, unpacks =
       type_let ~context:None env rec_flag spat_sexp_list scp true
@@ -3530,7 +3529,7 @@ and type_function ~async loc attrs env ty_expected_
     (sparams : Parsetree.fun_param list) sbody =
   (* Desugar optional-parameter defaults: the parameter becomes a fresh
      [*opt_<label>*] variable and the original pattern is bound in a
-     [#default]-annotated let at the head of the body. The let syntax is kept
+     let at the head of the body. The let syntax is kept
      alongside its parameter rather than wrapped into the body here: each
      binding is typed while the parameter environment accumulates left to
      right, so a default only sees the parameters before it (typing it as
@@ -3722,20 +3721,77 @@ and type_function ~async loc attrs env ty_expected_
          parameter enters the environment, mirroring the curried per-level
          typing this replaced: a default sees only the parameters to its
          left, and its pattern's bindings are in scope for what follows. *)
-      let ext_env, unpacks, defaults_acc =
+      let pat, ext_env, unpacks, defaults_acc, opt_param =
         match default_binding with
-        | None -> (ext_env, unpacks, defaults_acc)
+        | None -> (pat, ext_env, unpacks, defaults_acc, None)
         | Some vb ->
           let let_env = ext_env in
           let pat_exp_list, ext_env, let_unpacks =
             type_let ~context:None ext_env Nonrecursive [vb] None true
           in
-          ( ext_env,
+          (* The pattern binds the option carrier under an unspellable name
+             ([*opt_<label>*]), which typing needs so that user code can
+             neither reference nor shadow it. Everything mentioning the
+             carrier has been typed at this point: replace it with a fresh
+             user-legible parameter ident derived from the label, both at its
+             binder and at its single use, the scrutinee of the synthetic
+             match. The carrier then never reaches the lambda layer. *)
+          let param_id = Ident.create (label_name p.p_lbl ^ "Opt") in
+          let pat =
+            match pat.pat_desc with
+            | Tpat_var (_, name) ->
+              {
+                pat with
+                pat_desc =
+                  Tpat_var (param_id, {name with txt = Ident.name param_id});
+              }
+            | _ -> assert false
+          in
+          let pat_exp_list =
+            match pat_exp_list with
+            | [
+             ({
+                vb_expr =
+                  {
+                    exp_desc =
+                      Texp_match
+                        ( ({exp_desc = Texp_ident (Path.Pident _, lid, vd)} as
+                           scrut),
+                          cases,
+                          exn_cases,
+                          m_partial );
+                  } as vb_expr;
+              } as vb);
+            ] ->
+              [
+                {
+                  vb with
+                  vb_expr =
+                    {
+                      vb_expr with
+                      exp_desc =
+                        Texp_match
+                          ( {
+                              scrut with
+                              exp_desc =
+                                Texp_ident (Path.Pident param_id, lid, vd);
+                            },
+                            cases,
+                            exn_cases,
+                            m_partial );
+                    };
+                };
+              ]
+            | _ -> assert false
+          in
+          ( pat,
+            ext_env,
             unpacks @ let_unpacks,
-            (pat_exp_list, let_env) :: defaults_acc )
+            (pat_exp_list, let_env) :: defaults_acc,
+            Some param_id )
       in
       type_params
-        ((p, pat, ty_arg_c) :: typed_acc)
+        ((p, opt_param, pat, ty_arg_c) :: typed_acc)
         ext_env (unpacks_acc @ unpacks) defaults_acc rest_params rest_tys
     | _ -> assert false
   in
@@ -3754,8 +3810,8 @@ and type_function ~async loc attrs env ty_expected_
      let ty_res' = instance env ty_res in
      unify_exp ~context:None env body_exp ty_res');
   (* Stack the typed default bindings back onto the body, leftmost parameter
-     outermost — the same [#default] let shape [type_expect] would have
-     produced had the lets been part of the body's syntax. *)
+     outermost — the same let shape [type_expect] would have produced had the
+     lets been part of the body's syntax. *)
   let body_exp =
     List.fold_right
       (fun (pat_exp_list, let_env) inner ->
@@ -3765,22 +3821,22 @@ and type_function ~async loc attrs env ty_expected_
             exp_loc = loc;
             exp_extra = [];
             exp_type = inner.exp_type;
-            exp_attributes = [(mknoloc "#default", Parsetree.PStr [])];
+            exp_attributes = [];
             exp_env = let_env;
           })
       default_lets body_exp
   in
   let needs_exhaust_check =
     List.exists
-      (fun ((p : Parsetree.fun_param), _, _) -> not (is_var p.p_pat))
+      (fun ((p : Parsetree.fun_param), _, _, _) -> not (is_var p.p_pat))
       typed_params
   in
   let do_init = has_gadts || needs_exhaust_check in
   let lev, env = if do_init && not has_gadts then init_env () else (lev, env) in
   ignore lev;
   let tparams =
     List.map
-      (fun ((p : Parsetree.fun_param), pat, ty_arg_c) ->
+      (fun ((p : Parsetree.fun_param), opt_param, pat, ty_arg_c) ->
         let case = {c_lhs = pat; c_guard = None; c_rhs = body_exp} in
         let ty_arg_check =
           if do_init then
@@ -3796,11 +3852,17 @@ and type_function ~async loc attrs env ty_expected_
         if contains_polyvars || do_init then
           Delayed_checks.add_delayed_check unused_check
         else unused_check ();
+        let fp_param =
+          match opt_param with
+          | Some id -> id
+          | None -> name_pattern "param" [case]
+        in
         {
           fp_lbl = p.p_lbl;
-          fp_param = name_pattern "param" [case];
+          fp_param;
           fp_pat = pat;
           fp_partial = partial;
+          fp_has_default = opt_param <> None;
         })
       typed_params
   in
@@ -4516,18 +4578,13 @@ and type_let ~context ?(check = fun s -> Warnings.Unused_var s)
   in
   begin_def ();
   let is_fake_let =
+    (* the synthetic let-declaration introduced for an optional parameter's
+       default: its variables are parameters from the user's point of view,
+       so an unused one gets the strict (parameter) warning *)
     match spat_sexp_list with
-    | [
-     {
-       pvb_expr =
-         {
-           pexp_desc =
-             Pexp_match
-               ({pexp_desc = Pexp_ident {txt = Longident.Lident "*opt*"}}, _);
-         };
-     };
-    ] ->
-      true (* the fake let-declaration introduced by fun ?(x = e) -> ... *)
+    | [{pvb_expr = {pexp_attributes}}] ->
+      Ext_list.exists pexp_attributes (fun ({txt}, _) ->
+          txt = "#optional_arg_default")
     | _ -> false
   in
   let check = if is_fake_let then check_strict else check in

compiler/ml/typedtree.ml

@@ -144,6 +144,11 @@ and function_param = {
   fp_param: Ident.t; (* the name the compiled parameter binds to *)
   fp_pat: pattern;
   fp_partial: partial; (* whether [fp_pat] is exhaustive *)
+  fp_has_default: bool;
+      (* optional parameter with a default value. [fp_pat] then binds the
+         option carrier directly to [fp_param] -- a fresh ident named after
+         the label -- and the user's pattern is bound by a let at the head
+         of the body. *)
 }
 
 and record_label_definition =

compiler/ml/typedtree.mli

@@ -245,6 +245,11 @@ and function_param = {
   fp_param: Ident.t; (* the name the compiled parameter binds to *)
   fp_pat: pattern;
   fp_partial: partial; (* whether [fp_pat] is exhaustive *)
+  fp_has_default: bool;
+      (* optional parameter with a default value. [fp_pat] then binds the
+         option carrier directly to [fp_param] -- a fresh ident named after
+         the label -- and the user's pattern is bound by a let at the head
+         of the body. *)
 }
 
 and record_label_definition =

tests/tests/src/mario_game.mjs

@@ -25,13 +25,13 @@ let Actors = {};
 
 let Dom_html = {};
 
-function setup_sprite(loopOpt, bbox_offsetOpt, bbox_sizeOpt, img_src, max_frames, max_ticks, frame_size, src_offset) {
+function setup_sprite(loopOpt, bb_offOpt, bb_szOpt, img_src, max_frames, max_ticks, frame_size, src_offset) {
   let loop = loopOpt !== undefined ? loopOpt : true;
-  let bbox_offset = bbox_offsetOpt !== undefined ? bbox_offsetOpt : [
+  let bbox_offset = bb_offOpt !== undefined ? bb_offOpt : [
       0,
       0
     ];
-  let bbox_size = bbox_sizeOpt !== undefined ? bbox_sizeOpt : [
+  let bbox_size = bb_szOpt !== undefined ? bb_szOpt : [
       0,
       0
     ];
@@ -794,9 +794,9 @@ let id_counter = {
   contents: Stdlib_Int.Constants.minValue
 };
 
-function setup_obj(has_gravityOpt, speedOpt, param) {
-  let has_gravity = has_gravityOpt !== undefined ? has_gravityOpt : true;
-  let speed = speedOpt !== undefined ? speedOpt : 1;
+function setup_obj(gOpt, spdOpt, param) {
+  let has_gravity = gOpt !== undefined ? gOpt : true;
+  let speed = spdOpt !== undefined ? spdOpt : 1;
   return {
     has_gravity: has_gravity,
     speed: speed
@@ -847,9 +847,9 @@ function new_id() {
   return id_counter.contents;
 }
 
-function make$2($staropt_id$star, $staropt_dir$star, spawnable, context, param) {
-  let id = $staropt_id$star !== undefined ? Primitive_option.valFromOption($staropt_id$star) : undefined;
-  let dir = $staropt_dir$star !== undefined ? $staropt_dir$star : "Left";
+function make$2(idOpt, dirOpt, spawnable, context, param) {
+  let id = idOpt !== undefined ? Primitive_option.valFromOption(idOpt) : undefined;
+  let dir = dirOpt !== undefined ? dirOpt : "Left";
   let spr = make(spawnable, dir, context);
   let params = make_type$2(spawnable);
   let id$1 = id !== undefined ? id : new_id();