support let unwrap syntax (let?) (#7586)

* support let unwrap syntax (`let?`)

* fix printing of let?

Author: tsnobip

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 ]