From 66d0b64fdce6693534e371df36a1089f5e653fa9 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sun, 29 Jun 2025 21:44:11 +0200 Subject: [PATCH] PoC of let.unwrap --- compiler/frontend/ast_attributes.ml | 6 + compiler/frontend/ast_attributes.mli | 2 + compiler/frontend/bs_builtin_ppx.ml | 69 ++++++++++++ tests/tests/src/LetUnwrap.mjs | 161 +++++++++++++++++++++++++++ tests/tests/src/LetUnwrap.res | 69 ++++++++++++ 5 files changed, 307 insertions(+) create mode 100644 tests/tests/src/LetUnwrap.mjs create mode 100644 tests/tests/src/LetUnwrap.res 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..52bf83552d 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 = Location.none 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, [ok_case; error_case]); + pexp_attributes = e.pexp_attributes @ pvb_attributes; + }) | Pexp_let ( Nonrecursive, [ diff --git a/tests/tests/src/LetUnwrap.mjs b/tests/tests/src/LetUnwrap.mjs new file mode 100644 index 0000000000..b9cc30264d --- /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 y = doStuffWithResult(s); + if (y.TAG !== "Ok") { + return { + TAG: "Error", + _0: y._0 + }; + } + let y$1 = y._0; + let x = doNextStuffWithResult(y$1); + if (x.TAG === "Ok") { + return { + TAG: "Ok", + _0: x._0 + y$1 + }; + } else { + return { + TAG: "Error", + _0: x._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 res = await doStuffResultAsync(s); + if (res.TAG !== "Ok") { + return { + TAG: "Error", + _0: res._0 + }; + } + let res$1 = res._0; + console.log(res$1.s); + let x = await decodeResAsync(res$1); + if (x.TAG === "Ok") { + return { + TAG: "Ok", + _0: x._0 + }; + } else { + return { + TAG: "Error", + _0: x._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..2a1cee99cf --- /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.unwrap let Ok(y) = doStuffWithResult(s) + @let.unwrap 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.unwrap let Some(y) = doStuffWithOption(s) + @let.unwrap 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.unwrap let Ok({s} as res) = await doStuffResultAsync(s) + Console.log(s) + @let.unwrap let Ok(x) = await decodeResAsync(res) + Ok(x) +}