Skip to content

Commit

Permalink
Start removing let%foo (#87)
Browse files Browse the repository at this point in the history
- 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.
  • Loading branch information
chenglou authored Apr 6, 2021
1 parent aa00832 commit 5261974
Show file tree
Hide file tree
Showing 4 changed files with 154 additions and 0 deletions.
5 changes: 5 additions & 0 deletions .gitignore
Original file line number Diff line number Diff line change
Expand Up @@ -7,3 +7,8 @@ editor-extensions/vscode/*.zip
examples/*/node_modules
examples/*/lib
editor-extensions/vscode/node_modules

# TODO: remove this after un-monadification
*.cm*
*.out
temp.txt
138 changes: 138 additions & 0 deletions src/ppx2/Ppx_Unmonads.re
Original file line number Diff line number Diff line change
@@ -0,0 +1,138 @@

/**
Things I would like:
// maybe this is overkill? also probably harder to parse
switch%opt (somethingOptional) {
| theContents =>
};
// so each non-wildcard branch is wrapped in `Some`. Is this too weird?
switch%orNone (x) {
| each => case
| doesntNeed => toBe
| aSome => atTheEnd
| _ => None
}
Alsoooo I really want to be able to provide
hover-for-explanation for %ppx extension points.
How could I do that in a general way?
Done!!! As long as the ppx drops a `[@ocaml.explanation "some text"]`
somewhere, the `loc` of attribute's `loc(string)` bit will be used to
show the hover text that is the context of the attribute.
[@ocaml.explanation {|
```
let%opt name = value;
otherStuff
```
is transformed into
```
switch (value) {
| None => None
| Some(name) =>
otherStuff
}
```
This means that `otherStuff` needs to end with an optional.
If you want `otherStuff` to be automatically wrapped in `Some()`,
then use `let%opt_wrap`.
Alternatively, if you are just performing a side effect, and want
the result of the whole thing to be unit, use `let%consume`.
|}]
*/

/***
* https://ocsigen.org/lwt/dev/api/Ppx_lwt
* https://github.com/zepalmer/ocaml-monadic
*/

let rec process_bindings = (bindings) =>
Parsetree.(
switch bindings {
| [] => assert false
| [binding] => (binding.pvb_pat, binding.pvb_expr)
| [binding, ...rest] =>
let (pattern, expr) = process_bindings(rest);
(
Ast_helper.Pat.tuple([binding.pvb_pat, pattern]),
[%expr Let_syntax.join2([%e binding.pvb_expr], [%e expr])]
)
}
);

let opt_explanation = {|
Optional declaration sugar:
```
let%opt name = value;
otherStuff
```
is transformed into
```
switch (value) {
| None => None
| Some(name) =>
otherStuff
}
```
This means that `otherStuff` needs to have type `option`.
If you want `otherStuff` to be automatically wrapped in `Some()`,
then use `let%opt_wrap`.
Alternatively, if you are just performing a side effect, and want
the result of the whole thing to be unit, use `let%consume`.
|};


let opt_consume_explanation = {|
Optional declaration sugar:
```
let%consume name = value;
otherStuff
```
is transformed into
```
switch (value) {
| None => ()
| Some(name) =>
otherStuff
}
```
This is intented for performing side-effects only -- `otherStuff`
must end up as type `unit`.
|};

let mapper =
Parsetree.{
...Ast_mapper.default_mapper,
expr: (mapper, expr) =>
switch expr.pexp_desc {
| Pexp_extension(({txt: (
"opt" | "opt_consume"
| "try" | "try_wrap"
) as txt, loc}, PStr([{pstr_desc: Pstr_eval({pexp_desc: Pexp_let(Nonrecursive, bindings, continuation)}, _attributes)}]))) => {
let (front, explanation) = switch (txt) {
| "opt" => ([%expr Monads.Option.bind], opt_explanation)
| "opt_consume" => ([%expr Monads.Option.consume], opt_consume_explanation)
| "try" => ([%expr Monads.Result.bind], "Sugar for the Result type")
| "try_wrap" => ([%expr Monads.Result.map], "Sugar for the Result type - auto-wraps in `Ok()`")
| _ => assert(false)
};
let (pat, expr) = process_bindings(bindings);
Ast_helper.Exp.attr(
[%expr [%e front]([%e mapper.expr(mapper, expr)], ~f=([%p pat]) => [%e mapper.expr(mapper, continuation)])],
({txt: "ocaml.explanation", loc}, PStr([
Ast_helper.Str.eval(Ast_helper.Exp.constant(Pconst_string(explanation, None)))
]))
)
}
| _ => Ast_mapper.default_mapper.expr(mapper, expr)
}
};

let () = Ast_mapper.register("ppx_monads", (_) => mapper);
8 changes: 8 additions & 0 deletions src/ppx2/dune
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
(executable
(name Ppx_Unmonads)
(public_name ppx_unmonads.exe)
(flags :standard -w -9)
(libraries compiler-libs ppx_tools_versioned)
(preprocess (pps ppx_tools_versioned.metaquot_406))
)

3 changes: 3 additions & 0 deletions unmonad.sh
Original file line number Diff line number Diff line change
@@ -0,0 +1,3 @@
file=BuildSystem
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
# refmt --parse ml --print re ./temp.txt &> src/rescript-editor-support/$file.re

0 comments on commit 5261974

Please sign in to comment.