try to improve error message

Author: zth

compiler/ml/error_message_utils.ml

@@ -94,6 +94,7 @@ type type_clash_context =
   | AssertCondition
   | IfReturn
   | SwitchReturn
+  | LetUnwrapReturn
   | TryReturn
   | StringConcat
   | ComparisonOperator
@@ -126,6 +127,7 @@ let context_to_string = function
   | Some ComparisonOperator -> "ComparisonOperator"
   | Some IfReturn -> "IfReturn"
   | Some Await -> "Await"
+  | Some LetUnwrapReturn -> "LetUnwrapReturn"
   | None -> "None"
 
 let fprintf = Format.fprintf
@@ -158,6 +160,9 @@ let error_expected_type_text ppf type_clash_context =
   | Some ComparisonOperator ->
     fprintf ppf "But it's being compared to something of type:"
   | Some SwitchReturn -> fprintf ppf "But this switch is expected to return:"
+  | Some LetUnwrapReturn ->
+    fprintf ppf
+      "But this @{<info>let?@} is used in a context expecting the type:"
   | Some TryReturn -> fprintf ppf "But this try/catch is expected to return:"
   | Some WhileCondition ->
     fprintf ppf "But a @{<info>while@} loop condition must always be of type:"
@@ -308,6 +313,11 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
       "\n\n\
       \  All branches in a @{<info>switch@} must return the same type.@,\
        To fix this, change your branch to return the expected type."
+  | Some LetUnwrapReturn, _ ->
+    fprintf ppf
+      "\n\n\
+      \  @{<info>let?@} can only be used in a context that expects \
+       @{<info>option@} or @{<info>result@}."
   | Some TryReturn, _ ->
     fprintf ppf
       "\n\n\

compiler/ml/typecore.ml

@@ -2475,12 +2475,21 @@ and type_expect_ ~context ?in_function ?(recarg = Rejected) env sexp ty_expected
     (* Note: val_caselist = [] and exn_caselist = [], i.e. a fully
        empty pattern matching can be generated by Camlp4 with its
        revised syntax.  Let's accept it for backward compatibility. *)
+    let call_context =
+      if
+        Ext_list.exists sexp.pexp_attributes (fun ({txt}, _) ->
+            match txt with
+            | "let.unwrap" -> true
+            | _ -> false)
+      then `LetUnwrap
+      else `Switch
+    in
     let val_cases, partial =
-      type_cases ~call_context:`Switch env arg.exp_type ty_expected true loc
+      type_cases ~call_context env arg.exp_type ty_expected true loc
         val_caselist
     in
     let exn_cases, _ =
-      type_cases ~call_context:`Switch env Predef.type_exn ty_expected false loc
+      type_cases ~call_context env Predef.type_exn ty_expected false loc
         exn_caselist
     in
     re
@@ -3864,8 +3873,9 @@ and type_statement ~context env sexp =
 
 (* Typing of match cases *)
 
-and type_cases ~(call_context : [`Switch | `Function | `Try]) ?in_function env
-    ty_arg ty_res partial_flag loc caselist : _ * Typedtree.partial =
+and type_cases ~(call_context : [`LetUnwrap | `Switch | `Function | `Try])
+    ?in_function env ty_arg ty_res partial_flag loc caselist :
+    _ * Typedtree.partial =
   (* ty_arg is _fully_ generalized *)
   let patterns = List.map (fun {pc_lhs = p} -> p) caselist in
   let contains_polyvars = List.exists contains_polymorphic_variant patterns in
@@ -3983,6 +3993,7 @@ and type_cases ~(call_context : [`Switch | `Function | `Try]) ?in_function env
               (match call_context with
               | `Switch -> Some SwitchReturn
               | `Try -> Some TryReturn
+              | `LetUnwrap -> Some LetUnwrapReturn
               | `Function -> None)
             ?in_function ext_env sexp ty_res'
         in

tests/build_tests/super_errors/expected/let_unwrap_return_type_mismatch.res.expected

@@ -1,15 +1,14 @@
 
   We've found a bug for you!
-  /.../fixtures/let_unwrap_return_type_mismatch.res:4:8-14
+  /.../fixtures/let_unwrap_return_type_mismatch.res:6:8-14
 
-  2 │ 
-  3 │ let fn = (): int => {
-  4 │   let? Some(x) = None
-  5 │   42
-  6 │ }
+  4 │ 
+  5 │ let fn = (): int => {
+  6 │   let? Some(x) = None
+  7 │   42
+  8 │ }
 
   This has type: option<'a>
-  But this switch is expected to return: int
+  But this let? is used in a context expecting the type: int
 
-  All branches in a switch must return the same type.
-  To fix this, change your branch to return the expected type.
+  let? can only be used in a context that expects option or result.

tests/build_tests/super_errors/fixtures/let_unwrap_return_type_mismatch.res

@@ -1,5 +1,7 @@
 @@config({flags: ["-enable-experimental", "LetUnwrap"]})
 
+let x = Some(1)
+
 let fn = (): int => {
   let? Some(x) = None
   42