PoC of let?

compiler/frontend/ast_attributes.ml

@@ -202,6 +202,12 @@ let has_bs_optional (attrs : t) : bool =
         true
       | _ -> false)
 
+let has_unwrap_attr (attrs : t) : bool =
+  Ext_list.exists attrs (fun ({txt}, _) ->
+      match txt with
+      | "let.unwrap" -> true
+      | _ -> false)
+
 let iter_process_bs_int_as (attrs : t) =
   let st = ref None in
   Ext_list.iter attrs (fun (({txt; loc}, payload) as attr) ->

compiler/frontend/ast_attributes.mli

@@ -46,6 +46,8 @@ val iter_process_bs_string_as : t -> string option
 
 val has_bs_optional : t -> bool
 
+val has_unwrap_attr : t -> bool
+
 val iter_process_bs_int_as : t -> int option
 
 type as_const_payload = Int of int | Str of string * External_arg_spec.delim

compiler/frontend/bs_builtin_ppx.ml

@@ -145,6 +145,75 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
         ] ) ->
     default_expr_mapper self
       {e with pexp_desc = Pexp_ifthenelse (b, t_exp, Some f_exp)}
+  (* Transform:
+     - `@let.unwrap let Ok(inner_pat) = expr` 
+     - `@let.unwrap let Some(inner_pat) = expr` 
+     ...into switches *)
+  | Pexp_let
+      ( Nonrecursive,
+        [
+          {
+            pvb_pat =
+              {
+                ppat_desc =
+                  Ppat_construct
+                    ( {txt = Lident (("Ok" | "Some") as variant_name)},
+                      Some _inner_pat );
+              } as pvb_pat;
+            pvb_expr;
+            pvb_attributes;
+          };
+        ],
+        body )
+    when Ast_attributes.has_unwrap_attr pvb_attributes -> (
+    let variant =
+      match variant_name with
+      | "Ok" -> `Result
+      | _ -> `Option
+    in
+    match pvb_expr.pexp_desc with
+    | Pexp_pack _ -> default_expr_mapper self e
+    | _ ->
+      let ok_case =
+        {
+          Parsetree.pc_bar = None;
+          pc_lhs = pvb_pat;
+          pc_guard = None;
+          pc_rhs = body;
+        }
+      in
+      let loc = {pvb_pat.ppat_loc with loc_ghost = true} in
+      let error_case =
+        match variant with
+        | `Result ->
+          {
+            Parsetree.pc_bar = None;
+            pc_lhs =
+              Ast_helper.Pat.construct ~loc
+                {txt = Lident "Error"; loc}
+                (Some (Ast_helper.Pat.var ~loc {txt = "e"; loc}));
+            pc_guard = None;
+            pc_rhs =
+              Ast_helper.Exp.construct ~loc
+                {txt = Lident "Error"; loc}
+                (Some (Ast_helper.Exp.ident ~loc {txt = Lident "e"; loc}));
+          }
+        | `Option ->
+          {
+            Parsetree.pc_bar = None;
+            pc_lhs =
+              Ast_helper.Pat.construct ~loc {txt = Lident "None"; loc} None;
+            pc_guard = None;
+            pc_rhs =
+              Ast_helper.Exp.construct ~loc {txt = Lident "None"; loc} None;
+          }
+      in
+      default_expr_mapper self
+        {
+          e with
+          pexp_desc = Pexp_match (pvb_expr, [error_case; ok_case]);
+          pexp_attributes = e.pexp_attributes @ pvb_attributes;
+        })
   | Pexp_let
       ( Nonrecursive,
         [

compiler/syntax/src/res_core.ml

@@ -105,6 +105,12 @@ module ErrorMessages = struct
       ]
     |> Doc.to_string ~width:80
 
+  let experimental_let_unwrap_rec =
+    "let? is not allowed to be recursive. Use a regular `let` or remove `rec`."
+
+  let experimental_let_unwrap_sig =
+    "let? is not allowed in signatures. Use a regular `let` instead."
+
   let type_param =
     "A type param consists of a singlequote followed by a name like `'a` or \
      `'A`"
@@ -2518,21 +2524,35 @@ and parse_attributes_and_binding (p : Parser.t) =
   | _ -> []
 
 (* definition	::=	let [rec] let-binding  { and let-binding }   *)
-and parse_let_bindings ~attrs ~start_pos p =
-  Parser.optional p Let |> ignore;
+and parse_let_bindings ~unwrap ~attrs ~start_pos p =
+  Parser.optional p (Let {unwrap}) |> ignore;
   let rec_flag =
     if Parser.optional p Token.Rec then Asttypes.Recursive
     else Asttypes.Nonrecursive
   in
+  let end_pos = p.Parser.start_pos in
+  if rec_flag = Asttypes.Recursive && unwrap then
+    Parser.err ~start_pos ~end_pos p
+      (Diagnostics.message ErrorMessages.experimental_let_unwrap_rec);
+  let add_unwrap_attr ~unwrap ~start_pos ~end_pos attrs =
+    if unwrap then
+      ( {Asttypes.txt = "let.unwrap"; loc = mk_loc start_pos end_pos},
+        Ast_payload.empty )
+      :: attrs
+    else attrs
+  in
+  let attrs = add_unwrap_attr ~unwrap ~start_pos ~end_pos attrs in
   let first = parse_let_binding_body ~start_pos ~attrs p in
 
   let rec loop p bindings =
     let start_pos = p.Parser.start_pos in
+    let end_pos = p.Parser.end_pos in
     let attrs = parse_attributes_and_binding p in
+    let attrs = add_unwrap_attr ~unwrap ~start_pos ~end_pos attrs in
     match p.Parser.token with
     | And ->
       Parser.next p;
-      ignore (Parser.optional p Let);
+      ignore (Parser.optional p (Let {unwrap = false}));
       (* overparse for fault tolerance *)
       let let_binding = parse_let_binding_body ~start_pos ~attrs p in
       loop p (let_binding :: bindings)
@@ -3275,8 +3295,10 @@ and parse_expr_block_item p =
     let block_expr = parse_expr_block p in
     let loc = mk_loc start_pos p.prev_end_pos in
     Ast_helper.Exp.open_ ~loc od.popen_override od.popen_lid block_expr
-  | Let ->
-    let rec_flag, let_bindings = parse_let_bindings ~attrs ~start_pos p in
+  | Let {unwrap} ->
+    let rec_flag, let_bindings =
+      parse_let_bindings ~unwrap ~attrs ~start_pos p
+    in
     parse_newline_or_semicolon_expr_block p;
     let next =
       if Grammar.is_block_expr_start p.Parser.token then parse_expr_block p
@@ -3447,7 +3469,7 @@ and parse_if_or_if_let_expression p =
   Parser.expect If p;
   let expr =
     match p.Parser.token with
-    | Let ->
+    | Let _ ->
       Parser.next p;
       let if_let_expr = parse_if_let_expr start_pos p in
       Parser.err ~start_pos:if_let_expr.pexp_loc.loc_start
@@ -5787,8 +5809,10 @@ and parse_structure_item_region p =
     parse_newline_or_semicolon_structure p;
     let loc = mk_loc start_pos p.prev_end_pos in
     Some (Ast_helper.Str.open_ ~loc open_description)
-  | Let ->
-    let rec_flag, let_bindings = parse_let_bindings ~attrs ~start_pos p in
+  | Let {unwrap} ->
+    let rec_flag, let_bindings =
+      parse_let_bindings ~unwrap ~attrs ~start_pos p
+    in
     parse_newline_or_semicolon_structure p;
     let loc = mk_loc start_pos p.prev_end_pos in
     Some (Ast_helper.Str.value ~loc rec_flag let_bindings)
@@ -6417,7 +6441,11 @@ and parse_signature_item_region p =
   let start_pos = p.Parser.start_pos in
   let attrs = parse_attributes p in
   match p.Parser.token with
-  | Let ->
+  | Let {unwrap} ->
+    if unwrap then (
+      Parser.err ~start_pos ~end_pos:p.Parser.end_pos p
+        (Diagnostics.message ErrorMessages.experimental_let_unwrap_sig);
+      Parser.next p);
     Parser.begin_region p;
     let value_desc = parse_sign_let_desc ~attrs p in
     parse_newline_or_semicolon_signature p;
@@ -6617,7 +6645,7 @@ and parse_module_type_declaration ~attrs ~start_pos p =
 
 and parse_sign_let_desc ~attrs p =
   let start_pos = p.Parser.start_pos in
-  Parser.optional p Let |> ignore;
+  Parser.optional p (Let {unwrap = false}) |> ignore;
   let name, loc = parse_lident p in
   let name = Location.mkloc name loc in
   Parser.expect Colon p;

compiler/syntax/src/res_grammar.ml

@@ -124,8 +124,8 @@ let to_string = function
   | DictRows -> "rows of a dict"
 
 let is_signature_item_start = function
-  | Token.At | Let | Typ | External | Exception | Open | Include | Module | AtAt
-  | PercentPercent ->
+  | Token.At | Let _ | Typ | External | Exception | Open | Include | Module
+  | AtAt | PercentPercent ->
     true
   | _ -> false
 
@@ -162,7 +162,7 @@ let is_jsx_attribute_start = function
   | _ -> false
 
 let is_structure_item_start = function
-  | Token.Open | Let | Typ | External | Exception | Include | Module | AtAt
+  | Token.Open | Let _ | Typ | External | Exception | Include | Module | AtAt
   | PercentPercent | At ->
     true
   | t when is_expr_start t -> true
@@ -265,7 +265,7 @@ let is_jsx_child_start = is_atomic_expr_start
 let is_block_expr_start = function
   | Token.Assert | At | Await | Backtick | Bang | Codepoint _ | Exception
   | False | Float _ | For | Forwardslash | ForwardslashDot | Hash | If | Int _
-  | Lbrace | Lbracket | LessThan | Let | Lident _ | List | Lparen | Minus
+  | Lbrace | Lbracket | LessThan | Let _ | Lident _ | List | Lparen | Minus
   | MinusDot | Module | Open | Percent | Plus | PlusDot | String _ | Switch
   | True | Try | Uident _ | Underscore | While | Dict ->
     true

compiler/syntax/src/res_printer.ml

@@ -2078,11 +2078,20 @@ and print_type_parameter ~state (attrs, lbl, typ) cmt_tbl =
 
 and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl
     i =
+  let has_unwrap = ref false in
   let attrs =
-    print_attributes ~state ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes cmt_tbl
-  in
+    vb.pvb_attributes
+    |> List.filter_map (function
+         | {Asttypes.txt = "let.unwrap"}, _ ->
+           has_unwrap := true;
+           None
+         | attr -> Some attr)
+  in
+  let attrs = print_attributes ~state ~loc:vb.pvb_pat.ppat_loc attrs cmt_tbl in
   let header =
-    if i == 0 then Doc.concat [Doc.text "let "; rec_flag] else Doc.text "and "
+    if i == 0 then
+      Doc.concat [Doc.text (if !has_unwrap then "let? " else "let "); rec_flag]
+    else Doc.text "and "
   in
   match vb with
   | {

compiler/syntax/src/res_scanner.ml

@@ -205,6 +205,10 @@ let scan_identifier scanner =
     next scanner;
     (* TODO: this isn't great *)
     Token.lookup_keyword "dict{"
+  | {ch = '?'}, "let" ->
+    next scanner;
+    (* TODO: this isn't great *)
+    Token.lookup_keyword "let?"
   | _ -> Token.lookup_keyword str
 
 let scan_digits scanner ~base =

compiler/syntax/src/res_token.ml

@@ -17,7 +17,7 @@ type t =
   | DotDotDot
   | Bang
   | Semicolon
-  | Let
+  | Let of {unwrap: bool}
   | And
   | Rec
   | Underscore
@@ -134,7 +134,8 @@ let to_string = function
   | Float {f} -> "Float: " ^ f
   | Bang -> "!"
   | Semicolon -> ";"
-  | Let -> "let"
+  | Let {unwrap = true} -> "let?"
+  | Let {unwrap = false} -> "let"
   | And -> "and"
   | Rec -> "rec"
   | Underscore -> "_"
@@ -233,7 +234,8 @@ let keyword_table = function
   | "if" -> If
   | "in" -> In
   | "include" -> Include
-  | "let" -> Let
+  | "let?" -> Let {unwrap = true}
+  | "let" -> Let {unwrap = false}
   | "list{" -> List
   | "dict{" -> Dict
   | "module" -> Module
@@ -253,7 +255,7 @@ let keyword_table = function
 
 let is_keyword = function
   | Await | And | As | Assert | Constraint | Else | Exception | External | False
-  | For | If | In | Include | Land | Let | List | Lor | Module | Mutable | Of
+  | For | If | In | Include | Land | Let _ | List | Lor | Module | Mutable | Of
   | Open | Private | Rec | Switch | True | Try | Typ | When | While | Dict ->
     true
   | _ -> false

tests/syntax_tests/data/parsing/errors/expressions/expected/letUnwrapRec.res.txt

@@ -0,0 +1,11 @@
+
+  Syntax error!
+  syntax_tests/data/parsing/errors/expressions/letUnwrapRec.res:1:1-9
+
+  1 │ let? rec Some(baz) = someOption 
+  2 │ and Some(bar) = baz
+
+  let? is not allowed to be recursive. Use a regular `let` or remove `rec`.
+
+let rec Some baz = someOption[@@let.unwrap ]
+and Some bar = baz[@@let.unwrap ]

tests/syntax_tests/data/parsing/errors/expressions/letUnwrapRec.res

@@ -0,0 +1,2 @@
+let? rec Some(baz) = someOption 
+and Some(bar) = baz

tests/syntax_tests/data/parsing/errors/signature/expected/letUnwrap.resi.txt

@@ -0,0 +1,9 @@
+
+  Syntax error!
+  syntax_tests/data/parsing/errors/signature/letUnwrap.resi:1:1-4
+
+  1 │ let? foo: string
+
+  let? is not allowed in signatures. Use a regular `let` instead.
+
+val foo : string

tests/syntax_tests/data/parsing/errors/signature/letUnwrap.resi

@@ -0,0 +1 @@
+let? foo: string

tests/syntax_tests/data/parsing/grammar/expressions/expected/letUnwrap.res.txt

@@ -0,0 +1,4 @@
+let Ok foo = someResult[@@let.unwrap ]
+let Some bar = someOption[@@let.unwrap ]
+let Some baz = someOption[@@let.unwrap ]
+and Some bar = someOtherOption[@@let.unwrap ]

tests/syntax_tests/data/parsing/grammar/expressions/letUnwrap.res

@@ -0,0 +1,9 @@
+// with Ok
+let? Ok(foo) = someResult 
+
+// with Some 
+let? Some(bar) = someOption
+
+// with and
+let? Some(baz) = someOption 
+and Some(bar) = someOtherOption

tests/syntax_tests/data/printer/expr/expected/letUnwrap.res.txt

@@ -0,0 +1,9 @@
+// with Ok
+let? Ok(foo) = someResult
+
+// with Some
+let? Some(bar) = someOption
+
+// with and
+let? Some(baz) = someOption
+and Some(bar) = someOtherOption

tests/syntax_tests/data/printer/expr/letUnwrap.res

@@ -0,0 +1,9 @@
+// with Ok
+let? Ok(foo) = someResult 
+
+// with Some 
+let? Some(bar) = someOption
+
+// with and
+let? Some(baz) = someOption 
+and Some(bar) = someOtherOption

tests/syntax_tests/res_test.ml

@@ -94,7 +94,7 @@ module ParserApiTest = struct
     assert (parser.scanner.lnum == 1);
     assert (parser.scanner.line_offset == 0);
     assert (parser.scanner.offset == 6);
-    assert (parser.token = Res_token.Let);
+    assert (parser.token = Res_token.Let {unwrap = false});
     print_endline "✅ Parser make: initializes parser and checking offsets"
 
   let unix_lf () =