error handling

Author: zth

compiler/frontend/bs_builtin_ppx.ml

@@ -149,6 +149,15 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
      - `@let.unwrap let Some(inner_pat) = expr`
      - `@let.unwrap let None = expr`
      ...into switches *)
+  | Pexp_let (_, [{pvb_pat; pvb_attributes}], _)
+    when Ast_attributes.has_unwrap_attr pvb_attributes ->
+    if not (Experimental_features.is_enabled Experimental_features.LetUnwrap)
+    then
+      Bs_syntaxerr.err pvb_pat.ppat_loc
+        (Experimental_feature_not_enabled LetUnwrap)
+    else
+      Bs_syntaxerr.err pvb_pat.ppat_loc
+        (LetUnwrap_not_supported_in_position `Unsupported_type)
   | Pexp_let
       ( Nonrecursive,
         [
@@ -441,6 +450,19 @@ let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) :
 let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) :
     Parsetree.structure_item =
   match str.pstr_desc with
+  | Pstr_value (_, vbs)
+    when List.exists
+           (fun (vb : Parsetree.value_binding) ->
+             Ast_attributes.has_unwrap_attr vb.pvb_attributes)
+           vbs ->
+    let vb =
+      List.find
+        (fun (vb : Parsetree.value_binding) ->
+          Ast_attributes.has_unwrap_attr vb.pvb_attributes)
+        vbs
+    in
+    Bs_syntaxerr.err vb.pvb_pat.ppat_loc
+      (LetUnwrap_not_supported_in_position `Toplevel)
   | Pstr_type (rf, tdcls) (* [ {ptype_attributes} as tdcl ] *) ->
     Ast_tdcls.handle_tdcls_in_stru self str rf tdcls
   | Pstr_primitive prim

compiler/frontend/bs_syntaxerr.ml

@@ -48,6 +48,7 @@ type error =
   | Optional_in_uncurried_bs_attribute
   | Bs_this_simple_pattern
   | Experimental_feature_not_enabled of Experimental_features.feature
+  | LetUnwrap_not_supported_in_position of [`Toplevel | `Unsupported_type]
 
 let pp_error fmt err =
   Format.pp_print_string fmt
@@ -89,7 +90,13 @@ let pp_error fmt err =
         "Experimental feature not enabled: %s. Enable it by setting \"%s\" to \
          true under \"experimentalFeatures\" in rescript.json"
         (Experimental_features.to_string feature)
-        (Experimental_features.to_string feature))
+        (Experimental_features.to_string feature)
+    | LetUnwrap_not_supported_in_position hint -> (
+      match hint with
+      | `Toplevel -> "`let?` is not allowed for top-level bindings."
+      | `Unsupported_type ->
+        "`let?` is only supported in let bindings targeting the `result` or \
+         `option` type."))
 
 type exn += Error of Location.t * error
 

compiler/frontend/bs_syntaxerr.mli

@@ -48,6 +48,7 @@ type error =
   | Optional_in_uncurried_bs_attribute
   | Bs_this_simple_pattern
   | Experimental_feature_not_enabled of Experimental_features.feature
+  | LetUnwrap_not_supported_in_position of [`Toplevel | `Unsupported_type]
 
 val err : Location.t -> error -> 'a
 

compiler/common/experimental_features.ml renamed to compiler/ml/experimental_features.ml

@@ -9,10 +9,15 @@ let from_string (s : string) : feature option =
   | "LetUnwrap" -> Some LetUnwrap
   | _ -> None
 
-let enabled_features : feature list ref = ref []
+module FeatureSet = Set.Make (struct
+  type t = feature
+  let compare = compare
+end)
+
+let enabled_features : FeatureSet.t ref = ref FeatureSet.empty
 let enable_from_string (s : string) =
   match from_string s with
-  | Some f -> enabled_features := f :: !enabled_features
+  | Some f -> enabled_features := FeatureSet.add f !enabled_features
   | None -> ()
 
-let is_enabled (f : feature) = List.mem f !enabled_features
+let is_enabled (f : feature) = FeatureSet.mem f !enabled_features

compiler/common/experimental_features.mli renamed to compiler/ml/experimental_features.mli

@@ -0,0 +1,11 @@
+
+  We've found a bug for you!
+  /.../fixtures/let_unwrap_on_not_supported_variant.res:13:8-16
+
+  11 │ 
+  12 │ let ff = {
+  13 │   let? Failed(x) = xx
+  14 │   Ok(x)
+  15 │ }
+
+  `let?` is only supported in let bindings targeting the `result` or `option` type.

tests/build_tests/super_errors/expected/let_unwrap_on_not_supported_variant.res.expected

@@ -0,0 +1,10 @@
+
+  We've found a bug for you!
+  /.../fixtures/let_unwrap_on_top_level.res:3:6-10
+
+  1 │ let x = Ok(1)
+  2 │ 
+  3 │ let? Ok(_) = x
+  4 │ 
+
+  `let?` is not allowed for top-level bindings.

tests/build_tests/super_errors/expected/let_unwrap_on_top_level.res.expected

@@ -0,0 +1,15 @@
+@@config({flags: ["-enable-experimental", "LetUnwrap"]})
+
+let x = switch 1 {
+| 1 => Ok(1)
+| _ => Error(#Invalid)
+}
+
+type ff = Failed(int) | GoOn
+
+let xx = Failed(1)
+
+let ff = {
+  let? Failed(x) = xx
+  Ok(x)
+}

tests/build_tests/super_errors/fixtures/let_unwrap_on_not_supported_variant.res

@@ -0,0 +1,3 @@
+let x = Ok(1)
+
+let? Ok(_) = x