Skip to content

Commit 7a7bc1e

Browse files
committed
support let? on Error and None as well
1 parent 15d7572 commit 7a7bc1e

File tree

3 files changed

+126
-43
lines changed

3 files changed

+126
-43
lines changed

compiler/frontend/bs_builtin_ppx.ml

Lines changed: 58 additions & 23 deletions
Original file line numberDiff line numberDiff line change
@@ -144,8 +144,10 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
144144
default_expr_mapper self
145145
{e with pexp_desc = Pexp_ifthenelse (b, t_exp, Some f_exp)}
146146
(* Transform:
147-
- `@let.unwrap let Ok(inner_pat) = expr`
148-
- `@let.unwrap let Some(inner_pat) = expr`
147+
- `@let.unwrap let Ok(inner_pat) = expr`
148+
- `@let.unwrap let Error(inner_pat) = expr`
149+
- `@let.unwrap let Some(inner_pat) = expr`
150+
- `@let.unwrap let None = expr`
149151
...into switches *)
150152
| Pexp_let
151153
( Nonrecursive,
@@ -154,25 +156,32 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
154156
pvb_pat =
155157
{
156158
ppat_desc =
157-
Ppat_construct
158-
( {txt = Lident (("Ok" | "Some") as variant_name)},
159-
Some _inner_pat );
159+
( Ppat_construct
160+
({txt = Lident ("Ok" as variant_name)}, Some _)
161+
| Ppat_construct
162+
({txt = Lident ("Error" as variant_name)}, Some _)
163+
| Ppat_construct
164+
({txt = Lident ("Some" as variant_name)}, Some _)
165+
| Ppat_construct
166+
({txt = Lident ("None" as variant_name)}, None) );
160167
} as pvb_pat;
161168
pvb_expr;
162169
pvb_attributes;
163170
};
164171
],
165172
body )
166173
when Ast_attributes.has_unwrap_attr pvb_attributes -> (
167-
let variant =
174+
let variant : [`Result_Ok | `Result_Error | `Option_Some | `Option_None] =
168175
match variant_name with
169-
| "Ok" -> `Result
170-
| _ -> `Option
176+
| "Ok" -> `Result_Ok
177+
| "Error" -> `Result_Error
178+
| "Some" -> `Option_Some
179+
| _ -> `Option_None
171180
in
172181
match pvb_expr.pexp_desc with
173182
| Pexp_pack _ -> default_expr_mapper self e
174183
| _ ->
175-
let ok_case =
184+
let cont_case =
176185
{
177186
Parsetree.pc_bar = None;
178187
pc_lhs = pvb_pat;
@@ -181,35 +190,61 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
181190
}
182191
in
183192
let loc = {pvb_pat.ppat_loc with loc_ghost = true} in
184-
let error_case =
193+
let early_case =
185194
match variant with
186-
| `Result ->
195+
(* Result: continue on Ok(_), early-return on Error(e) *)
196+
| `Result_Ok ->
187197
{
188198
Parsetree.pc_bar = None;
189199
pc_lhs =
190-
Ast_helper.Pat.construct ~loc
191-
{txt = Lident "Error"; loc}
192-
(Some (Ast_helper.Pat.var ~loc {txt = "e"; loc}));
200+
Ast_helper.Pat.alias
201+
(Ast_helper.Pat.construct ~loc
202+
{txt = Lident "Error"; loc}
203+
(Some (Ast_helper.Pat.any ~loc ())))
204+
{txt = "e"; loc};
193205
pc_guard = None;
194-
pc_rhs =
195-
Ast_helper.Exp.construct ~loc
196-
{txt = Lident "Error"; loc}
197-
(Some (Ast_helper.Exp.ident ~loc {txt = Lident "e"; loc}));
206+
pc_rhs = Ast_helper.Exp.ident ~loc {txt = Lident "e"; loc};
198207
}
199-
| `Option ->
208+
(* Result: continue on Error(_), early-return on Ok(x) *)
209+
| `Result_Error ->
200210
{
201211
Parsetree.pc_bar = None;
202212
pc_lhs =
203-
Ast_helper.Pat.construct ~loc {txt = Lident "None"; loc} None;
213+
Ast_helper.Pat.alias
214+
(Ast_helper.Pat.construct ~loc {txt = Lident "Ok"; loc}
215+
(Some (Ast_helper.Pat.any ~loc ())))
216+
{txt = "x"; loc};
204217
pc_guard = None;
205-
pc_rhs =
206-
Ast_helper.Exp.construct ~loc {txt = Lident "None"; loc} None;
218+
pc_rhs = Ast_helper.Exp.ident ~loc {txt = Lident "x"; loc};
219+
}
220+
(* Option: continue on Some(_), early-return on None *)
221+
| `Option_Some ->
222+
{
223+
Parsetree.pc_bar = None;
224+
pc_lhs =
225+
Ast_helper.Pat.alias
226+
(Ast_helper.Pat.construct ~loc {txt = Lident "None"; loc} None)
227+
{txt = "x"; loc};
228+
pc_guard = None;
229+
pc_rhs = Ast_helper.Exp.ident ~loc {txt = Lident "x"; loc};
230+
}
231+
(* Option: continue on None, early-return on Some(x) *)
232+
| `Option_None ->
233+
{
234+
Parsetree.pc_bar = None;
235+
pc_lhs =
236+
Ast_helper.Pat.alias
237+
(Ast_helper.Pat.construct ~loc {txt = Lident "Some"; loc}
238+
(Some (Ast_helper.Pat.any ~loc ())))
239+
{txt = "x"; loc};
240+
pc_guard = None;
241+
pc_rhs = Ast_helper.Exp.ident ~loc {txt = Lident "x"; loc};
207242
}
208243
in
209244
default_expr_mapper self
210245
{
211246
e with
212-
pexp_desc = Pexp_match (pvb_expr, [error_case; ok_case]);
247+
pexp_desc = Pexp_match (pvb_expr, [early_case; cont_case]);
213248
pexp_attributes = e.pexp_attributes @ pvb_attributes;
214249
})
215250
| Pexp_let

tests/tests/src/LetUnwrap.mjs

Lines changed: 52 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -32,10 +32,7 @@ function doNextStuffWithResult(s) {
3232
function getXWithResult(s) {
3333
let e = doStuffWithResult(s);
3434
if (e.TAG !== "Ok") {
35-
return {
36-
TAG: "Error",
37-
_0: e._0
38-
};
35+
return e;
3936
}
4037
let y = e._0;
4138
let e$1 = doNextStuffWithResult(y);
@@ -45,10 +42,7 @@ function getXWithResult(s) {
4542
_0: e$1._0 + y
4643
};
4744
} else {
48-
return {
49-
TAG: "Error",
50-
_0: e$1._0
51-
};
45+
return e$1;
5246
}
5347
}
5448

@@ -75,15 +69,16 @@ function doNextStuffWithOption(s) {
7569
}
7670

7771
function getXWithOption(s) {
78-
let y = doStuffWithOption(s);
79-
if (y === undefined) {
80-
return;
72+
let x = doStuffWithOption(s);
73+
if (x === undefined) {
74+
return x;
8175
}
82-
let x = doNextStuffWithOption(y);
83-
if (x !== undefined) {
84-
return x + y;
76+
let x$1 = doNextStuffWithOption(x);
77+
if (x$1 !== undefined) {
78+
return x$1 + x;
79+
} else {
80+
return x$1;
8581
}
86-
8782
}
8883

8984
let x$1 = getXWithOption("s");
@@ -124,10 +119,7 @@ async function decodeResAsync(res) {
124119
async function getXWithResultAsync(s) {
125120
let e = await doStuffResultAsync(s);
126121
if (e.TAG !== "Ok") {
127-
return {
128-
TAG: "Error",
129-
_0: e._0
130-
};
122+
return e;
131123
}
132124
let res = e._0;
133125
console.log(res.s);
@@ -137,10 +129,47 @@ async function getXWithResultAsync(s) {
137129
TAG: "Ok",
138130
_0: e$1._0
139131
};
132+
} else {
133+
return e$1;
134+
}
135+
}
136+
137+
function returnsAliasOnFirstError(s) {
138+
let e = doStuffWithResult(s);
139+
if (e.TAG === "Ok") {
140+
return {
141+
TAG: "Ok",
142+
_0: "ok"
143+
};
144+
} else {
145+
return e;
146+
}
147+
}
148+
149+
function returnsAliasOnSecondError(s) {
150+
let e = doStuffWithResult(s);
151+
if (e.TAG !== "Ok") {
152+
return e;
153+
}
154+
let e$1 = doNextStuffWithResult(e._0);
155+
if (e$1.TAG === "Ok") {
156+
return {
157+
TAG: "Ok",
158+
_0: "ok"
159+
};
160+
} else {
161+
return e$1;
162+
}
163+
}
164+
165+
function returnsAliasOnOk(s) {
166+
let x = doStuffWithResult(s);
167+
if (x.TAG === "Ok") {
168+
return x;
140169
} else {
141170
return {
142171
TAG: "Error",
143-
_0: e$1._0
172+
_0: "GotError"
144173
};
145174
}
146175
}
@@ -157,5 +186,8 @@ export {
157186
doStuffResultAsync,
158187
decodeResAsync,
159188
getXWithResultAsync,
189+
returnsAliasOnFirstError,
190+
returnsAliasOnSecondError,
191+
returnsAliasOnOk,
160192
}
161193
/* x Not a pure module */

tests/tests/src/LetUnwrap.res

Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -67,3 +67,19 @@ let getXWithResultAsync = async s => {
6767
let? Ok(x) = await decodeResAsync(res)
6868
Ok(x)
6969
}
70+
71+
let returnsAliasOnFirstError = s => {
72+
let? Ok(_y) = doStuffWithResult(s)
73+
Ok("ok")
74+
}
75+
76+
let returnsAliasOnSecondError = s => {
77+
let? Ok(y) = doStuffWithResult(s)
78+
let? Ok(_x) = doNextStuffWithResult(y)
79+
Ok("ok")
80+
}
81+
82+
let returnsAliasOnOk = s => {
83+
let? Error(_e) = doStuffWithResult(s)
84+
Error(#GotError)
85+
}

0 commit comments

Comments
 (0)