Fix type errors and test failures

src/analysis/inlay_hints.ml

@@ -23,7 +23,7 @@ let structure_iterator
     typedtree
     range
     callback =
-  
+
   let case_iterator hint_lhs (iterator : Iterator.iterator) case =
     let () = log ~title:"case" "on case" in
     let () =
@@ -68,13 +68,13 @@ let structure_iterator
       | Texp_letop { body; _ } ->
         let () = log ~title:"expression" "on let-op" in
         case_iterator hint_let_binding iterator body
-      | Texp_match (expr, cases, _) ->
+      | Texp_match (expr, _, cases, _) ->
         let () = log ~title:"expression" "on match" in
         let () = iterator.expr iterator expr in
         List.iter ~f:(case_iterator hint_pattern_binding iterator) cases
-      | Texp_function (_, Tfunction_cases {cases = [
+      | Texp_function { body = Tfunction_cases {fc_cases = [
           { c_rhs = { exp_desc = Texp_let (_, [ {vb_pat; _} ], body); _ }; _ }
-        ]; _}) ->
+        ]; _}; _ } ->
         let () = log ~title:"expression" "on function" in
         let () = iterator.pat iterator vb_pat in
         iterator.expr iterator body
@@ -118,7 +118,7 @@ let structure_iterator
         callback pattern.pat_env pattern.pat_type pattern.pat_loc
       | _ -> log ~title:"pattern" "not a var"
   in
-    
+
   let iterator = {
     Ocaml_typing.Tast_iterator.default_iterator with
     expr = expr_iterator;
@@ -129,7 +129,7 @@ let structure_iterator
   in iterator.structure iterator typedtree
 
 type hint = Lexing.position * string
-    
+
 let create_hint env typ loc =
   let label =  Printtyp.wrap_printing_env env (fun () ->
     Format.asprintf "%a" Printtyp.type_scheme typ)

src/analysis/signature_help.ml

@@ -3,7 +3,7 @@ open Std
 let {Logger. log} = Logger.for_section "signature-help"
 
 type parameter_info =
-  { label : Asttypes.arg_label
+  { label : Typedtree.arg_label
   ; param_start : int
   ; param_end : int
   ; argument : Typedtree.expression option
@@ -27,7 +27,7 @@ let extract_ident (exp_desc : Typedtree.expression_desc) =
     | Lapply (p1, p2) -> Format.fprintf ppf "%a(%a)" longident p1 longident p2
   in
   match exp_desc with
-  | Texp_ident (_, { txt = li; _ }, _) ->
+  | Texp_ident (_, { txt = li; _ }, _, _, _) ->
     let ppf, to_string = Format.to_string () in
     longident ppf li;
     Some (to_string ())
@@ -56,19 +56,21 @@ let pp_parameter_type env ppf ty =
 
 (* print parameter labels and types *)
 let pp_parameter env label ppf ty =
-  match (label : Asttypes.arg_label) with
+  match (label : Typedtree.arg_label) with
   | Nolabel -> pp_parameter_type env ppf ty
   | Labelled l -> Format.fprintf ppf "%s:%a" l (pp_parameter_type env) ty
   | Optional l ->
     (* unwrap option for optional labels the same way as
        [Raw_compat.labels_of_application] *)
-    let unwrap_option ty =
+    let rec unwrap_option ty =
       match Types.get_desc ty with
       | Types.Tconstr (path, [ ty ], _) when Path.same path Predef.path_option
         -> ty
+      | Types.Tpoly (ty, []) -> unwrap_option ty
       | _ -> ty
     in
     Format.fprintf ppf "?%s:%a" l (pp_parameter_type env) (unwrap_option ty)
+  | Position l -> Format.fprintf ppf "%s:[%%call_pos]" l
 
 (* record buffer offsets to be able to underline parameter types *)
 let print_parameter_offset ?arg:argument ppf buffer env label ty =
@@ -88,12 +90,17 @@ let separate_function_signature ~args (e : Typedtree.expression) =
   let ppf = Format.formatter_of_buffer buffer in
   let rec separate ?(parameters = []) args ty =
     match (args, Types.get_desc ty) with
-    | (_l, arg) :: args, Tarrow (label, ty1, ty2, _) ->
+    | (_l, arg) :: args, Tarrow ((label, _, _), ty1, ty2, _) ->
+      let arg =
+        match (arg : Typedtree.apply_arg) with
+        | Arg (arg, _) -> Some arg
+        | Omitted _ -> None
+      in
       let parameter =
-        print_parameter_offset ppf buffer e.exp_env label ty1 ?arg
+        print_parameter_offset ppf buffer e.exp_env label ty1 ?arg:arg
       in
       separate args ty2 ~parameters:(parameter :: parameters)
-    | [], Tarrow (label, ty1, ty2, _) ->
+    | [], Tarrow ((label, _, _), ty1, ty2, _) ->
       let parameter = print_parameter_offset ppf buffer e.exp_env label ty1 in
       separate args ty2 ~parameters:(parameter :: parameters)
     (* end of function type, print remaining type without recording offsets *)
@@ -117,19 +124,19 @@ let active_parameter_by_arg ~arg params =
 
 let first_unassigned_argument params =
   let positional = function
-    | { argument = None; label = Asttypes.Nolabel; _ } -> true
+    | { argument = None; label = Nolabel; _ } -> true
     | _ -> false
   in
   let labelled = function
-    | { argument = None; label = Asttypes.Labelled _ | Optional _; _ } -> true
+    | { argument = None; label = Labelled _ | Optional _; _ } -> true
     | _ -> false
   in
   try Some (List.index params ~f:positional) with Not_found ->
     try Some (List.index params ~f:labelled) with Not_found -> None
 
 let active_parameter_by_prefix ~prefix params =
   let common = function
-    | Asttypes.Nolabel -> Some 0
+    | Typedtree.Nolabel -> Some 0
     | l
       when String.is_prefixed ~by:"~" prefix
            || String.is_prefixed ~by:"?" prefix ->
@@ -157,7 +164,7 @@ let is_arrow t =
 let application_signature ~prefix ~cursor = function
   | (_, Browse_raw.Expression arg)
     :: ( _
-       , Expression { exp_desc = Texp_apply (({ exp_type; _ } as e), args); _ }
+       , Expression { exp_desc = Texp_apply (({ exp_type; _ } as e), args, _, _, _); _ }
        )
     :: _
     when is_arrow exp_type ->

src/analysis/signature_help.mli

@@ -1,5 +1,5 @@
 type parameter_info =
-  { label : Asttypes.arg_label
+  { label : Typedtree.arg_label
   ; param_start : int
   ; param_end : int
   ; argument : Typedtree.expression option

src/analysis/typedtree_utils.ml

@@ -26,11 +26,12 @@ let extract_toplevel_identifier item =
 let let_bound_vars bindings =
   List.filter_map ~f:(fun value_binding ->
     match value_binding.Typedtree.vb_pat.pat_desc with
-    | Tpat_var (id, loc, _) -> Some (id, loc)
+    | Tpat_var (id, loc, _, _m) -> Some (id, loc)
     | Typedtree.Tpat_any
-    | Typedtree.Tpat_alias (_, _, _, _)
+    | Typedtree.Tpat_alias (_, _, _, _, _)
     | Typedtree.Tpat_constant _
     | Typedtree.Tpat_tuple _
+    | Typedtree.Tpat_unboxed_tuple _
     | Typedtree.Tpat_construct (_, _, _, _)
     | Typedtree.Tpat_variant (_, _, _)
     | Typedtree.Tpat_record (_, _)
@@ -68,12 +69,11 @@ let location_of_declaration ~uid =
 
 
 let pat_var_id_and_loc = function
-  | Typedtree.{ pat_desc = Tpat_var (id, loc, _); _ } ->
+  | Typedtree.{ pat_desc = Tpat_var (id, loc, _, _); _ } ->
     Some (id, loc)
   | _ -> None
 
 let pat_alias_pat_id_and_loc = function
-  | Typedtree.{ pat_desc = Tpat_alias (pat, id, loc, _); _ } ->
+  | Typedtree.{ pat_desc = Tpat_alias (pat, id, loc, _, _); _ } ->
     Some (pat, id, loc)
   | _ -> None
-

src/ocaml-index/lib/index.ml

@@ -197,7 +197,7 @@ let index_of_cmt ~root ~build_path ~shapes cmt_infos =
   in
   let uid_to_loc =
     Shape.Uid.Tbl.to_list cmt_uid_to_decl
-    |> List.map (fun (uid, fragment) -> uid, Misc_utils.loc_of_decl ~uid fragment)
+    |> List.map (fun (uid, fragment) -> uid, Typedtree_utils.location_of_declaration ~uid fragment)
     |> Shape.Uid.Tbl.of_list
   in
   index_of_artifact