diff --git a/compiler/frontend/ast_attributes.ml b/compiler/frontend/ast_attributes.ml index 8a3eee2b91..0c2925e2a6 100644 --- a/compiler/frontend/ast_attributes.ml +++ b/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) -> diff --git a/compiler/frontend/ast_attributes.mli b/compiler/frontend/ast_attributes.mli index 1fae9799ea..4b57a0e998 100644 --- a/compiler/frontend/ast_attributes.mli +++ b/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 diff --git a/compiler/frontend/bs_builtin_ppx.ml b/compiler/frontend/bs_builtin_ppx.ml index e6be7e6247..2b47439074 100644 --- a/compiler/frontend/bs_builtin_ppx.ml +++ b/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, [ diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 63ca9878c1..06506e2169 100644 --- a/compiler/syntax/src/res_core.ml +++ b/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; diff --git a/compiler/syntax/src/res_grammar.ml b/compiler/syntax/src/res_grammar.ml index 456767c5bc..2c5b1e1ac0 100644 --- a/compiler/syntax/src/res_grammar.ml +++ b/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 diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 7e2c76a32b..8d1b00b2b9 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/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 | { diff --git a/compiler/syntax/src/res_scanner.ml b/compiler/syntax/src/res_scanner.ml index a49ea8a5ee..8080a36fad 100644 --- a/compiler/syntax/src/res_scanner.ml +++ b/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 = diff --git a/compiler/syntax/src/res_token.ml b/compiler/syntax/src/res_token.ml index 312af0c423..7430a060f4 100644 --- a/compiler/syntax/src/res_token.ml +++ b/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 diff --git a/tests/syntax_tests/data/parsing/errors/expressions/expected/letUnwrapRec.res.txt b/tests/syntax_tests/data/parsing/errors/expressions/expected/letUnwrapRec.res.txt new file mode 100644 index 0000000000..ee6fbcfcf4 --- /dev/null +++ b/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 ] \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/expressions/letUnwrapRec.res b/tests/syntax_tests/data/parsing/errors/expressions/letUnwrapRec.res new file mode 100644 index 0000000000..ce29385c36 --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/expressions/letUnwrapRec.res @@ -0,0 +1,2 @@ +let? rec Some(baz) = someOption +and Some(bar) = baz \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/signature/expected/letUnwrap.resi.txt b/tests/syntax_tests/data/parsing/errors/signature/expected/letUnwrap.resi.txt new file mode 100644 index 0000000000..74ace608ce --- /dev/null +++ b/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 \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/signature/letUnwrap.resi b/tests/syntax_tests/data/parsing/errors/signature/letUnwrap.resi new file mode 100644 index 0000000000..4b31b705e8 --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/signature/letUnwrap.resi @@ -0,0 +1 @@ +let? foo: string \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/letUnwrap.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/letUnwrap.res.txt new file mode 100644 index 0000000000..46810e3112 --- /dev/null +++ b/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 ] \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/letUnwrap.res b/tests/syntax_tests/data/parsing/grammar/expressions/letUnwrap.res new file mode 100644 index 0000000000..bf141d4d09 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/tests/syntax_tests/data/printer/expr/expected/letUnwrap.res.txt b/tests/syntax_tests/data/printer/expr/expected/letUnwrap.res.txt new file mode 100644 index 0000000000..4f64a35929 --- /dev/null +++ b/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 diff --git a/tests/syntax_tests/data/printer/expr/letUnwrap.res b/tests/syntax_tests/data/printer/expr/letUnwrap.res new file mode 100644 index 0000000000..bf141d4d09 --- /dev/null +++ b/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 \ No newline at end of file diff --git a/tests/syntax_tests/res_test.ml b/tests/syntax_tests/res_test.ml index a7a0d57b4f..505637dd04 100644 --- a/tests/syntax_tests/res_test.ml +++ b/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 () = diff --git a/tests/tests/src/LetUnwrap.mjs b/tests/tests/src/LetUnwrap.mjs new file mode 100644 index 0000000000..89d2ef8010 --- /dev/null +++ b/tests/tests/src/LetUnwrap.mjs @@ -0,0 +1,161 @@ +// Generated by ReScript, PLEASE EDIT WITH CARE + + +function doStuffWithResult(s) { + if (s === "s") { + return { + TAG: "Ok", + _0: "hello" + }; + } else { + return { + TAG: "Error", + _0: "InvalidString" + }; + } +} + +function doNextStuffWithResult(s) { + if (s === "s") { + return { + TAG: "Ok", + _0: "hello" + }; + } else { + return { + TAG: "Error", + _0: "InvalidNext" + }; + } +} + +function getXWithResult(s) { + let e = doStuffWithResult(s); + if (e.TAG !== "Ok") { + return { + TAG: "Error", + _0: e._0 + }; + } + let y = e._0; + let e$1 = doNextStuffWithResult(y); + if (e$1.TAG === "Ok") { + return { + TAG: "Ok", + _0: e$1._0 + y + }; + } else { + return { + TAG: "Error", + _0: e$1._0 + }; + } +} + +let x = getXWithResult("s"); + +let someResult; + +someResult = x.TAG === "Ok" ? x._0 : ( + x._0 === "InvalidNext" ? "nope!" : "nope" + ); + +function doStuffWithOption(s) { + if (s === "s") { + return "hello"; + } + +} + +function doNextStuffWithOption(s) { + if (s === "s") { + return "hello"; + } + +} + +function getXWithOption(s) { + let y = doStuffWithOption(s); + if (y === undefined) { + return; + } + let x = doNextStuffWithOption(y); + if (x !== undefined) { + return x + y; + } + +} + +let x$1 = getXWithOption("s"); + +let someOption = x$1 !== undefined ? x$1 : "nope"; + +async function doStuffResultAsync(s) { + if (s === "s") { + return { + TAG: "Ok", + _0: { + s: "hello" + } + }; + } else { + return { + TAG: "Error", + _0: "FetchError" + }; + } +} + +async function decodeResAsync(res) { + let match = res.s; + if (match === "s") { + return { + TAG: "Ok", + _0: res.s + }; + } else { + return { + TAG: "Error", + _0: "DecodeError" + }; + } +} + +async function getXWithResultAsync(s) { + let e = await doStuffResultAsync(s); + if (e.TAG !== "Ok") { + return { + TAG: "Error", + _0: e._0 + }; + } + let res = e._0; + console.log(res.s); + let e$1 = await decodeResAsync(res); + if (e$1.TAG === "Ok") { + return { + TAG: "Ok", + _0: e$1._0 + }; + } else { + return { + TAG: "Error", + _0: e$1._0 + }; + } +} + +export { + doStuffWithResult, + doNextStuffWithResult, + getXWithResult, + someResult, + doStuffWithOption, + doNextStuffWithOption, + getXWithOption, + someOption, + doStuffResultAsync, + decodeResAsync, + getXWithResultAsync, +} +/* x Not a pure module */ diff --git a/tests/tests/src/LetUnwrap.res b/tests/tests/src/LetUnwrap.res new file mode 100644 index 0000000000..6a52c29ea1 --- /dev/null +++ b/tests/tests/src/LetUnwrap.res @@ -0,0 +1,69 @@ +let doStuffWithResult = s => + switch s { + | "s" => Ok("hello") + | _ => Error(#InvalidString) + } + +let doNextStuffWithResult = s => + switch s { + | "s" => Ok("hello") + | _ => Error(#InvalidNext) + } + +let getXWithResult = s => { + let? Ok(y) = doStuffWithResult(s) + let? Ok(x) = doNextStuffWithResult(y) + Ok(x ++ y) +} + +let someResult = switch getXWithResult("s") { +| Ok(x) => x +| Error(#InvalidString) => "nope" +| Error(#InvalidNext) => "nope!" +} + +let doStuffWithOption = s => + switch s { + | "s" => Some("hello") + | _ => None + } + +let doNextStuffWithOption = s => + switch s { + | "s" => Some("hello") + | _ => None + } + +let getXWithOption = s => { + let? Some(y) = doStuffWithOption(s) + let? Some(x) = doNextStuffWithOption(y) + Some(x ++ y) +} + +let someOption = switch getXWithOption("s") { +| Some(x) => x +| None => "nope" +} + +type res = {s: string} + +let doStuffResultAsync = async s => { + switch s { + | "s" => Ok({s: "hello"}) + | _ => Error(#FetchError) + } +} + +let decodeResAsync = async res => { + switch res.s { + | "s" => Ok(res.s) + | _ => Error(#DecodeError) + } +} + +let getXWithResultAsync = async s => { + let? Ok({s} as res) = await doStuffResultAsync(s) + Console.log(s) + let? Ok(x) = await decodeResAsync(res) + Ok(x) +}