Skip to content
This repository was archived by the owner on Apr 24, 2021. It is now read-only.

Commit 2952d7b

Browse files
committed
Start removing let%foo
- The let%try and others ended up swallowing lots of important production errors (surprise... =/) - The transforms in their current state don't give an error message location (partially due to usage of metaquot. Meta yak shaving). - This makes the build depend on OMP, ppxlib and others. Giant deps, giant build times. - But seriously, if even Cristiano has problem writing proper option and result handling in production because of `let%` stuff then what chance do most others have. Anyway I'm gonna remove it because this seems to be a blocker for cleaning up the codebase's other parts... First step is to build the same monad ppx as an executable; I'll directly run this through the source files using `unmonad.sh`, print them back to Reason syntax, and manually clean up some stuff. See #86, which is converted by the script. Using the ppx script itself ensures that we don't cause conversion bugs. After this PR, I'm thinking of directly making the ppx transform the `let%` stuff into regular switch statements, and print out those.
1 parent aa00832 commit 2952d7b

File tree

4 files changed

+154
-0
lines changed

4 files changed

+154
-0
lines changed

.gitignore

+5
Original file line numberDiff line numberDiff line change
@@ -7,3 +7,8 @@ editor-extensions/vscode/*.zip
77
examples/*/node_modules
88
examples/*/lib
99
editor-extensions/vscode/node_modules
10+
11+
# TODO: remove this after un-monadification
12+
*.cm*
13+
*.out
14+
temp.txt

src/ppx2/Ppx_Unmonads.re

+138
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,138 @@
1+
2+
/**
3+
Things I would like:
4+
5+
// maybe this is overkill? also probably harder to parse
6+
switch%opt (somethingOptional) {
7+
| theContents =>
8+
};
9+
10+
// so each non-wildcard branch is wrapped in `Some`. Is this too weird?
11+
switch%orNone (x) {
12+
| each => case
13+
| doesntNeed => toBe
14+
| aSome => atTheEnd
15+
| _ => None
16+
}
17+
18+
Alsoooo I really want to be able to provide
19+
hover-for-explanation for %ppx extension points.
20+
How could I do that in a general way?
21+
22+
Done!!! As long as the ppx drops a `[@ocaml.explanation "some text"]`
23+
somewhere, the `loc` of attribute's `loc(string)` bit will be used to
24+
show the hover text that is the context of the attribute.
25+
26+
[@ocaml.explanation {|
27+
28+
```
29+
let%opt name = value;
30+
otherStuff
31+
```
32+
is transformed into
33+
```
34+
switch (value) {
35+
| None => None
36+
| Some(name) =>
37+
otherStuff
38+
}
39+
```
40+
This means that `otherStuff` needs to end with an optional.
41+
42+
If you want `otherStuff` to be automatically wrapped in `Some()`,
43+
then use `let%opt_wrap`.
44+
Alternatively, if you are just performing a side effect, and want
45+
the result of the whole thing to be unit, use `let%consume`.
46+
|}]
47+
48+
*/
49+
50+
/***
51+
* https://ocsigen.org/lwt/dev/api/Ppx_lwt
52+
* https://github.com/zepalmer/ocaml-monadic
53+
*/
54+
55+
let rec process_bindings = (bindings) =>
56+
Parsetree.(
57+
switch bindings {
58+
| [] => assert false
59+
| [binding] => (binding.pvb_pat, binding.pvb_expr)
60+
| [binding, ...rest] =>
61+
let (pattern, expr) = process_bindings(rest);
62+
(
63+
Ast_helper.Pat.tuple([binding.pvb_pat, pattern]),
64+
[%expr Let_syntax.join2([%e binding.pvb_expr], [%e expr])]
65+
)
66+
}
67+
);
68+
69+
let opt_explanation = {|
70+
Optional declaration sugar:
71+
```
72+
let%opt name = value;
73+
otherStuff
74+
```
75+
is transformed into
76+
```
77+
switch (value) {
78+
| None => None
79+
| Some(name) =>
80+
otherStuff
81+
}
82+
```
83+
This means that `otherStuff` needs to have type `option`.
84+
85+
If you want `otherStuff` to be automatically wrapped in `Some()`,
86+
then use `let%opt_wrap`.
87+
Alternatively, if you are just performing a side effect, and want
88+
the result of the whole thing to be unit, use `let%consume`.
89+
|};
90+
91+
92+
let opt_consume_explanation = {|
93+
Optional declaration sugar:
94+
```
95+
let%consume name = value;
96+
otherStuff
97+
```
98+
is transformed into
99+
```
100+
switch (value) {
101+
| None => ()
102+
| Some(name) =>
103+
otherStuff
104+
}
105+
```
106+
This is intented for performing side-effects only -- `otherStuff`
107+
must end up as type `unit`.
108+
|};
109+
110+
let mapper =
111+
Parsetree.{
112+
...Ast_mapper.default_mapper,
113+
expr: (mapper, expr) =>
114+
switch expr.pexp_desc {
115+
| Pexp_extension(({txt: (
116+
"opt" | "opt_consume"
117+
| "try" | "try_wrap"
118+
) as txt, loc}, PStr([{pstr_desc: Pstr_eval({pexp_desc: Pexp_let(Nonrecursive, bindings, continuation)}, _attributes)}]))) => {
119+
let (front, explanation) = switch (txt) {
120+
| "opt" => ([%expr Monads.Option.bind], opt_explanation)
121+
| "opt_consume" => ([%expr Monads.Option.consume], opt_consume_explanation)
122+
| "try" => ([%expr Monads.Result.bind], "Sugar for the Result type")
123+
| "try_wrap" => ([%expr Monads.Result.map], "Sugar for the Result type - auto-wraps in `Ok()`")
124+
| _ => assert(false)
125+
};
126+
let (pat, expr) = process_bindings(bindings);
127+
Ast_helper.Exp.attr(
128+
[%expr [%e front]([%e mapper.expr(mapper, expr)], ~f=([%p pat]) => [%e mapper.expr(mapper, continuation)])],
129+
({txt: "ocaml.explanation", loc}, PStr([
130+
Ast_helper.Str.eval(Ast_helper.Exp.constant(Pconst_string(explanation, None)))
131+
]))
132+
)
133+
}
134+
| _ => Ast_mapper.default_mapper.expr(mapper, expr)
135+
}
136+
};
137+
138+
let () = Ast_mapper.register("ppx_monads", (_) => mapper);

src/ppx2/dune

+8
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,8 @@
1+
(executable
2+
(name Ppx_Unmonads)
3+
(public_name ppx_unmonads.exe)
4+
(flags :standard -w -9)
5+
(libraries compiler-libs ppx_tools_versioned)
6+
(preprocess (pps ppx_tools_versioned.metaquot_406))
7+
)
8+

unmonad.sh

+3
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,3 @@
1+
file=BuildSystem
2+
ocamlc -dsource -ppx _build/default/src/ppx2/Ppx_Unmonads.exe -pp "refmt --parse re --print binary" -I src -impl src/rescript-editor-support/$file.re &> ./temp.txt
3+
# refmt --parse ml --print re ./temp.txt &> src/rescript-editor-support/$file.re

0 commit comments

Comments
 (0)