Prepare 12.3.1 maintenance release

CHANGELOG.md

@@ -10,6 +10,23 @@
 > - :nail_care: [Polish]
 > - :house: [Internal]
 
+# 12.3.1
+
+#### :bug: Bug fix
+
+- Fix rewatch warning replay after early compile errors. https://github.com/rescript-lang/rescript/pull/8408
+- Fix formatting of trailing comments before `=` in let bindings. https://github.com/rescript-lang/rescript/pull/8444
+- Fix namespaced reference lookup in editor analysis. https://github.com/rescript-lang/rescript/pull/8455
+- Fix build crash when the compiler emits output that is not valid UTF-8, such as a truncated multibyte character in a code frame. https://github.com/rescript-lang/rescript/pull/8482
+- Preserve multibyte characters when wrapping long source lines in compiler code frames. https://github.com/rescript-lang/rescript/pull/8520
+- Preserve parentheses around multiplication, division, and modulo expressions used as exponents. https://github.com/rescript-lang/rescript/pull/8550
+- Enforce function arity in interface/module inclusion, type equality, and coercion. https://github.com/rescript-lang/rescript/pull/8559
+- Fix bare labeled arrow types (`~x: int => string`) getting no arity and failing to unify with their parenthesized form. https://github.com/rescript-lang/rescript/pull/8563
+- Fix signature help for functions returning functions so it reports the parameters and source ranges of the current call. https://github.com/rescript-lang/rescript/pull/8566
+- Fix argument evaluation order when a function call is inlined: the beta reducer could evaluate non-substitutable arguments from last to first. https://github.com/rescript-lang/rescript/pull/8572
+- Compute optional-parameter defaults when their own curried function group is applied instead of deferring outer defaults until an inner function is called. https://github.com/rescript-lang/rescript/pull/8568
+- Fix termination-analysis false positives when progress flows through helper functions. https://github.com/rescript-lang/rescript/pull/8568
+
 # 12.3.0
 
 No changes compared to 12.3.0-beta.1.

analysis/reanalyze/src/Arnold.ml

@@ -545,7 +545,7 @@ module FindFunctionsCalled = struct
   let findCallees (expression : Typedtree.expression) =
     let isFunction =
       match expression.exp_desc with
-      | Texp_function {arity = None} -> true
+      | Texp_function _ -> true
       | _ -> false
     in
     let callees = ref StringSet.empty in

analysis/src/Cmt.ml

@@ -8,6 +8,32 @@ let fullForCmt ~moduleName ~package ~uri cmt =
     let extra = ProcessExtra.getExtra ~file ~infos in
     Some {file; extra; package}
 
+let fullForIncrementalCmt ~package ~moduleName ~uri =
+  if !Cfg.inIncrementalTypecheckingMode then
+    let path = Uri.toPath uri in
+    let incrementalCmtPath =
+      package.rootPath ^ "/lib/bs/___incremental" ^ "/" ^ moduleName
+      ^
+      match Files.classifySourceFile path with
+      | Resi -> ".cmti"
+      | _ -> ".cmt"
+    in
+    match fullForCmt ~moduleName ~package ~uri incrementalCmtPath with
+    | Some cmtInfo ->
+      if Debug.verbose () then
+        Printf.printf "[cmt] Found incremental cmt: %s\n"
+          (Filename.basename incrementalCmtPath);
+      Some cmtInfo
+    | None -> None
+  else None
+
+let fullFromModuleUri ~package ~moduleName ~uri ~paths =
+  match fullForIncrementalCmt ~package ~moduleName ~uri with
+  | Some cmtInfo -> Some cmtInfo
+  | None ->
+    let cmt = getCmtPath ~uri paths in
+    fullForCmt ~moduleName ~package ~uri cmt
+
 let fullFromUri ~uri =
   let path = Uri.toPath uri in
   match Packages.getPackage ~uri with
@@ -16,22 +42,8 @@ let fullFromUri ~uri =
     let moduleName =
       BuildSystem.namespacedName package.namespace (FindFiles.getName path)
     in
-    let incremental =
-      if !Cfg.inIncrementalTypecheckingMode then
-        let incrementalCmtPath =
-          package.rootPath ^ "/lib/bs/___incremental" ^ "/" ^ moduleName
-          ^
-          match Files.classifySourceFile path with
-          | Resi -> ".cmti"
-          | _ -> ".cmt"
-        in
-        fullForCmt ~moduleName ~package ~uri incrementalCmtPath
-      else None
-    in
-    match incremental with
-    | Some cmtInfo ->
-      if Debug.verbose () then Printf.printf "[cmt] Found incremental cmt\n";
-      Some cmtInfo
+    match fullForIncrementalCmt ~package ~moduleName ~uri with
+    | Some cmtInfo -> Some cmtInfo
     | None -> (
       match Hashtbl.find_opt package.pathsForModule moduleName with
       | Some paths ->
@@ -41,12 +53,20 @@ let fullFromUri ~uri =
         prerr_endline ("can't find module " ^ moduleName);
         None))
 
+let fullFromModule ~package ~moduleName =
+  Option.bind (Hashtbl.find_opt package.pathsForModule moduleName)
+  @@ fun paths ->
+  let uri = getUri paths in
+  fullFromModuleUri ~package ~moduleName ~uri ~paths
+
 let fullsFromModule ~package ~moduleName =
-  if Hashtbl.mem package.pathsForModule moduleName then
-    let paths = Hashtbl.find package.pathsForModule moduleName in
+  match Hashtbl.find_opt package.pathsForModule moduleName with
+  | None -> []
+  | Some paths ->
     let uris = getUris paths in
-    uris |> List.filter_map (fun uri -> fullFromUri ~uri)
-  else []
+    uris
+    |> List.filter_map (fun uri ->
+           fullFromModuleUri ~package ~moduleName ~uri ~paths)
 
 let loadFullCmtFromPath ~path =
   let uri = Uri.fromPath path in

analysis/src/References.ml

@@ -18,6 +18,20 @@ let locItemsForPos ~extra pos =
 
 let lineColToCmtLoc ~pos:(line, col) = (line + 1, col)
 
+(** External references in namespaced projects are indexed by the public
+  * namespace path, e.g. MyNamespace.MyModule1.myFunc1, while definitions live
+  * in hidden compiled modules like MyModule1-MyNamespace.
+  * We return the lookup key pair used by the external reference index.
+  *)
+let normalizeExternalReferenceKey ~namespace ~moduleName ~path =
+  match namespace with
+  | Some namespace when Utils.endsWith moduleName ("-" ^ namespace) ->
+    let suffixLen = String.length namespace + 1 in
+    let sourceModuleLen = String.length moduleName - suffixLen in
+    let sourceModule = String.sub moduleName 0 sourceModuleLen in
+    (namespace, sourceModule :: path)
+  | _ -> (moduleName, path)
+
 let getLocItem ~full ~pos ~debug =
   let log n msg = if debug then Printf.printf "getLocItem #%d: %s\n" n msg in
   let pos = lineColToCmtLoc ~pos in
@@ -485,6 +499,10 @@ let forLocalStamp ~full:{file; extra; package} stamp (tip : Tip.t) =
             in
             maybeLog ("Now checking path " ^ pathToString path);
             let thisModuleName = file.moduleName in
+            let normalizedModuleName, normalizedPath =
+              normalizeExternalReferenceKey ~namespace:package.namespace
+                ~moduleName:thisModuleName ~path
+            in
             let externals =
               package.projectFiles |> FileSet.elements
               |> List.filter (fun name -> name <> file.moduleName)
@@ -493,14 +511,15 @@ let forLocalStamp ~full:{file; extra; package} stamp (tip : Tip.t) =
                      |> List.map (fun {file; extra} ->
                             match
                               Hashtbl.find_opt extra.externalReferences
-                                thisModuleName
+                                normalizedModuleName
                             with
                             | None -> []
                             | Some refs ->
                               let locs =
                                 refs
                                 |> Utils.filterMap (fun (p, t, locs) ->
-                                       if p = path && t = tip then Some locs
+                                       if p = normalizedPath && t = tip then
+                                         Some locs
                                        else None)
                               in
                               locs
@@ -522,10 +541,8 @@ let allReferencesForLocItem ~full:({file; package} as full) locItem =
   | TopLevelModule moduleName ->
     let otherModulesReferences =
       package.projectFiles |> FileSet.elements
-      |> Utils.filterMap (fun name ->
-             match ProcessCmt.fileForModule ~package name with
-             | None -> None
-             | Some file -> Cmt.fullFromUri ~uri:file.uri)
+      |> Utils.filterMap (fun moduleName ->
+             Cmt.fullFromModule ~package ~moduleName)
       |> List.map (fun full ->
              match Hashtbl.find_opt full.extra.fileReferences moduleName with
              | None -> []
@@ -563,7 +580,7 @@ let allReferencesForLocItem ~full:({file; package} as full) locItem =
       match exportedForTip ~env ~path ~package ~tip with
       | None -> []
       | Some (env, _name, stamp) -> (
-        match Cmt.fullFromUri ~uri:env.file.uri with
+        match Cmt.fullFromModule ~package ~moduleName:env.file.moduleName with
         | None -> []
         | Some full ->
           maybeLog

analysis/src/SignatureHelp.ml

@@ -101,24 +101,28 @@ let findFunctionType ~currentFile ~debug ~path ~pos =
         Some (args, docstring, type_expr, package, env, file)
       | _ -> None))
 
-(* Extracts all parameters from a parsed function signature *)
+(* Extracts the parameters from the outermost parsed function signature. A
+   returned function's parameters belong to a different call site. *)
 let extractParameters ~signature ~typeStrForParser ~labelPrefixLen =
   match signature with
-  | [{Parsetree.psig_desc = Psig_value {pval_type = expr}}]
-    when match expr.ptyp_desc with
-         | Ptyp_arrow _ -> true
-         | _ -> false ->
-    let rec extractParams expr params =
+  | [
+   {
+     Parsetree.psig_desc =
+       Psig_value
+         {pval_type = {ptyp_desc = Ptyp_arrow {arity = outerArity}} as expr};
+   };
+  ] ->
+    let rec extractParams expr params remaining =
       match expr with
-      | {
-       (* Gotcha: functions with multiple arugments are modelled as a series of single argument functions. *)
-       Parsetree.ptyp_desc = Ptyp_arrow {arg; ret = nextFunctionExpr};
-       ptyp_loc;
-      } ->
+      | {Parsetree.ptyp_desc = Ptyp_arrow {arg; ret = nextFunctionExpr}}
+        when remaining > 0 ->
+        let startLoc =
+          match arg.lbl with
+          | Asttypes.Labelled {loc} | Optional {loc} -> loc |> Loc.start
+          | Nolabel -> arg.typ.ptyp_loc |> Loc.start
+        in
         let startOffset =
-          ptyp_loc |> Loc.start
-          |> Pos.positionToOffset typeStrForParser
-          |> Option.get
+          startLoc |> Pos.positionToOffset typeStrForParser |> Option.get
         in
         let endOffset =
           arg.typ.ptyp_loc |> Loc.end_
@@ -140,9 +144,10 @@ let extractParameters ~signature ~typeStrForParser ~labelPrefixLen =
                 startOffset - labelPrefixLen,
                 endOffset - labelPrefixLen );
             ])
+          (remaining - 1)
       | _ -> params
     in
-    extractParams expr []
+    extractParams expr [] (Option.value outerArity ~default:max_int)
   | _ -> []
 
 (* Finds what parameter is active, if any *)

compiler/common/bs_version.ml

@@ -21,5 +21,5 @@
  * You should have received a copy of the GNU Lesser General Public License
  * along with this program; if not, write to the Free Software
  * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *)
-let version = "12.3.0"
+let version = "12.3.1"
 let header = "// Generated by ReScript, PLEASE EDIT WITH CARE"

compiler/core/js_op_util.ml

@@ -41,7 +41,7 @@ let op_prec (op : Js_op.binop) =
   | Lsl | Lsr | Asr -> (10, 10, 11)
   | Bnot | Plus | Minus -> (11, 11, 12)
   | Mul | Div | Mod -> (12, 12, 13)
-  | Pow -> (13, 14, 12)
+  | Pow -> (13, 14, 13)
 
 let op_int_prec (op : Js_op.int_op) =
   match op with

compiler/core/lam_beta_reduce.ml

@@ -63,7 +63,10 @@ let propagate_beta_reduce (meta : Lam_stats.t) (params : Ident.t list)
         (Hash_ident.of_list2 (List.rev params) rev_new_params)
         body
     in
-    Ext_list.fold_right rest_bindings new_body (fun (param, arg) l ->
+    (* [rest_bindings] is in reverse parameter order; folding left makes the
+       first parameter's binding outermost, so arguments evaluate in call
+       order. *)
+    Ext_list.fold_left rest_bindings new_body (fun l (param, arg) ->
         (match arg with
         | Lprim {primitive = Pmakeblock (_, _, Immutable); args; _} ->
           Hash_ident.replace meta.ident_tbl param
@@ -104,7 +107,8 @@ let propagate_beta_reduce_with_map (meta : Lam_stats.t)
         (Hash_ident.of_list2 (List.rev params) rev_new_params)
         body
     in
-    Ext_list.fold_right rest_bindings new_body (fun (param, (arg : Lam.t)) l ->
+    (* See above: fold left so arguments evaluate in call order. *)
+    Ext_list.fold_left rest_bindings new_body (fun l (param, (arg : Lam.t)) ->
         (match arg with
         | Lprim {primitive = Pmakeblock (_, _, Immutable); args} ->
           Hash_ident.replace meta.ident_tbl param

compiler/ml/code_frame.ml

@@ -37,14 +37,23 @@ let leading_space_count str =
   loop 0 0
 
 let break_long_line max_width line =
+  let line_length = String.length line in
+  let rec find_chunk_end pos remaining_width =
+    if pos = line_length || remaining_width = 0 then pos
+    else
+      let char_length =
+        String.get_utf_8_uchar line pos |> Uchar.utf_decode_length
+      in
+      find_chunk_end (pos + char_length) (remaining_width - 1)
+  in
   let rec loop pos accum =
-    if pos = String.length line then accum
+    if pos = line_length then List.rev accum
     else
-      let chunk_length = min max_width (String.length line - pos) in
-      let chunk = String.sub line pos chunk_length in
-      loop (pos + chunk_length) (chunk :: accum)
+      let chunk_end = find_chunk_end pos max_width in
+      let chunk = String.sub line pos (chunk_end - pos) in
+      loop chunk_end (chunk :: accum)
   in
-  loop 0 [] |> List.rev
+  loop 0 []
 
 let filter_mapi f l =
   let rec loop f l i accum =

compiler/ml/ctype.ml

@@ -2914,8 +2914,8 @@ let rec moregen inst_nongen type_pairs env t1 t2 =
               | Tvar _, _ when may_instantiate inst_nongen t1' ->
                 moregen_occur env t1'.level t2;
                 link_type t1' t2
-              | Tarrow (arg1, ret1, _, _), Tarrow (arg2, ret2, _, _)
-                when Asttypes.same_arg_label arg1.lbl arg2.lbl ->
+              | Tarrow (arg1, ret1, _, a1), Tarrow (arg2, ret2, _, a2)
+                when a1 = a2 && Asttypes.same_arg_label arg1.lbl arg2.lbl ->
                 moregen inst_nongen type_pairs env arg1.typ arg2.typ;
                 moregen inst_nongen type_pairs env ret1 ret2
               | Ttuple tl1, Ttuple tl2 ->
@@ -3184,8 +3184,8 @@ let rec eqtype rename type_pairs subst env t1 t2 =
                   if List.exists (fun (_, t) -> t == t2') !subst then
                     raise (Unify []);
                   subst := (t1', t2') :: !subst)
-              | Tarrow (arg1, ret1, _, _), Tarrow (arg2, ret2, _, _)
-                when Asttypes.same_arg_label arg1.lbl arg2.lbl ->
+              | Tarrow (arg1, ret1, _, a1), Tarrow (arg2, ret2, _, a2)
+                when a1 = a2 && Asttypes.same_arg_label arg1.lbl arg2.lbl ->
                 eqtype rename type_pairs subst env arg1.typ arg2.typ;
                 eqtype rename type_pairs subst env ret1 ret2
               | Ttuple tl1, Ttuple tl2 ->
@@ -3597,8 +3597,8 @@ let rec subtype_rec env trace t1 t2 cstrs =
       TypePairs.add subtypes (t1, t2) ();
       match (t1.desc, t2.desc) with
       | Tvar _, _ | _, Tvar _ -> (trace, t1, t2, !univar_pairs, None) :: cstrs
-      | Tarrow (arg1, ret1, _, _), Tarrow (arg2, ret2, _, _)
-        when Asttypes.same_arg_label arg1.lbl arg2.lbl ->
+      | Tarrow (arg1, ret1, _, a1), Tarrow (arg2, ret2, _, a2)
+        when a1 = a2 && Asttypes.same_arg_label arg1.lbl arg2.lbl ->
         let cstrs =
           subtype_rec env
             ((arg2.typ, arg1.typ) :: trace)

compiler/ml/translcore.ml

@@ -547,8 +547,10 @@ let rec push_defaults loc bindings case partial =
    c_lhs = pat;
    c_guard = None;
    c_rhs =
-     {exp_desc = Texp_function {arg_label; arity; param; case; partial; async}}
-     as exp;
+     {
+       exp_desc =
+         Texp_function {arg_label; arity = None; param; case; partial; async};
+     } as exp;
   } ->
     let case = push_defaults exp.exp_loc bindings case partial in
 
@@ -559,7 +561,7 @@ let rec push_defaults loc bindings case partial =
         {
           exp with
           exp_desc =
-            Texp_function {arg_label; arity; param; case; partial; async};
+            Texp_function {arg_label; arity = None; param; case; partial; async};
         };
     }
   | {

compiler/syntax/src/res_core.ml

@@ -4726,7 +4726,7 @@ and parse_es6_arrow_type ~attrs p =
     Parser.expect EqualGreater p;
     let return_type = parse_typ_expr ~alias:false p in
     let loc = mk_loc start_pos p.prev_end_pos in
-    Ast_helper.Typ.arrow ~loc ~arity:None {attrs; lbl; typ} return_type
+    Ast_helper.Typ.arrow ~loc ~arity:(Some 1) {attrs; lbl; typ} return_type
   | DocComment _ -> assert false
   | _ ->
     let parameters = parse_type_parameters p in