Add let.Foo sugar for continuation-passing-style

formatTest/typeCheckedTests/expected_output/sequences.re

@@ -75,3 +75,55 @@ let singlePunAcceptedIfExtended = {
   ...firstFieldPunned,
   a,
 };
+
+module Option = {
+  let map = (x, f) =>
+    switch (x) {
+    | Some(x) => Some(f(x))
+    | None => None
+    };
+
+  let flatMap = (x, f) =>
+    switch (x) {
+    | Some(x) => f(x)
+    | None => None
+    };
+
+  let pair = (x, y) =>
+    switch (x, y) {
+    | (Some(x), Some(y)) => Some((x, y))
+    | _ => None
+    };
+};
+
+let _ = {
+  let!Option x = Some(23)
+  and!Option y = Some(5);
+
+  Some(x + y)
+};
+
+module Async = {
+  type t('value) = Js.Promise.t('value);
+  let let_: (t('a), 'a => t('b)) => t('b) = Js.Promise.then_;
+  let and_: (t('a), t('b)) => t(('a, 'b)) = Js.Promise.all2;
+  let try_: (t('a), exn => t('a)) => t('a) = Js.Promise.catch;
+  let resolve = Js.Promise.resolve;
+  let reject = Js.Promise.reject;
+};
+
+let getAge = () => Async.reject(Failure("Cannot get age"));
+
+let _ = {
+  let!Async x = try!Async (getAge()) {
+    | Failure(message) => Ok(23)
+    | exn => raise(exn)
+  };
+
+  let!Async a = Async.resolve(2)
+  and!Async b = Async.resolve(5)
+  and!Async c = Async.resolve(7);
+  print_endline(string_of_int(a));
+
+  Async.resolve(a + x * b + c);
+};

formatTest/typeCheckedTests/input/sequences.re

@@ -79,3 +79,56 @@ let thirdFieldPunned = {
   c
 };
 let singlePunAcceptedIfExtended = {...firstFieldPunned, a};
+
+
+module Option = {
+  let map = (x, f) =>
+    switch (x) {
+    | Some(x) => Some(f(x))
+    | None => None
+    };
+
+  let flatMap = (x, f) =>
+    switch (x) {
+    | Some(x) => f(x)
+    | None => None
+    };
+
+  let pair = (x, y) =>
+    switch (x, y) {
+    | (Some(x), Some(y)) => Some((x, y))
+    | _ => None
+    };
+};
+
+let _ = {
+  let!Option x = Some(23)
+  and!Option y = Some(5);
+
+  Some(x + y)
+};
+
+module Async = {
+  type t('value) = Js.Promise.t('value);
+  let let_: (t('a), 'a => t('b)) => t('b) = Js.Promise.then_;
+  let and_: (t('a), t('b)) => t(('a, 'b)) = Js.Promise.all2;
+  let try_: (t('a), exn => t('a)) => t('a) = Js.Promise.catch;
+  let resolve = Js.Promise.resolve;
+  let reject = Js.Promise.reject;
+};
+
+let getAge = () => Async.reject(Failure("Cannot get age"));
+
+let _ = {
+  let!Async x = try!Async (getAge()) {
+    | Failure(message) => Ok(23)
+    | exn => raise(exn)
+  };
+
+  let!Async a = Async.resolve(2)
+  and!Async b = Async.resolve(5)
+  and!Async c = Async.resolve(7);
+  print_endline(string_of_int(a));
+
+  Async.resolve(a + x * b + c);
+};

src/reason-parser/dune

@@ -69,6 +69,7 @@
   reason_syntax_util
   reason_comment
   reason_layout
+  reason_attrs
   reason_heuristics
   reason_location
   reason_toolchain

src/reason-parser/reason_attrs.ml

@@ -0,0 +1,103 @@
+
+open Ast_404
+open Parsetree
+open Location
+
+module T = struct
+  (** Kinds of attributes *)
+  type attributesPartition = {
+    arityAttrs : attributes;
+    docAttrs : attributes;
+    stdAttrs : attributes;
+    jsxAttrs : attributes;
+    refmtAttrs : attributes;
+    literalAttrs : attributes;
+    uncurried : bool
+  }
+end
+
+let letCombinator = "letCombinator"
+let andCombinator = "andCombinator"
+
+let isRefmtTag tag attr =
+  match attr with
+  | (
+      {txt="refmt"},
+      PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Pconst_string(foundTag, None))}, _)}]
+    ) -> foundTag = tag
+  | _ -> false
+
+let hasRefmtTag tag = List.exists (isRefmtTag tag)
+
+let isRefmt ~filter attr =
+  match attr with
+  | (
+      {txt="refmt"},
+      PStr [{pstr_desc=Pstr_eval({pexp_desc=Pexp_constant(Pconst_string(tag, None))}, _)}]
+    ) -> (
+      match filter with
+      | None -> true
+      | Some style -> String.compare tag style == 0
+    )
+  | _ -> false
+let isRefmtExplicitBraces = isRefmt ~filter:(Some "explicitBraces")
+let isRefmtInlineOpen = isRefmt ~filter:(Some "inlineOpen")
+
+(** Partition attributes into kinds *)
+let rec partitionAttributes ?(partDoc=false) ?(allowUncurry=true) attrs : T.attributesPartition =
+  let open T in
+  match attrs with
+    | [] ->
+      {arityAttrs=[]; docAttrs=[]; stdAttrs=[]; jsxAttrs=[]; refmtAttrs=[]; literalAttrs=[]; uncurried = false}
+    | (({txt = "bs"}, PStr []) as attr)::atTl ->
+        let partition = partitionAttributes ~partDoc ~allowUncurry atTl in
+        if allowUncurry then
+          {partition with uncurried = true}
+        else {partition with stdAttrs=attr::partition.stdAttrs}
+    | attr::atTl when isRefmt ~filter:None attr ->
+        let partition = partitionAttributes ~partDoc ~allowUncurry atTl in
+        {partition with refmtAttrs=attr::partition.refmtAttrs}
+    | (({txt="JSX"}, _) as jsx)::atTl ->
+        let partition = partitionAttributes ~partDoc ~allowUncurry atTl in
+        {partition with jsxAttrs=jsx::partition.jsxAttrs}
+    | (({txt="explicit_arity"}, _) as arity_attr)::atTl
+    | (({txt="implicit_arity"}, _) as arity_attr)::atTl ->
+        let partition = partitionAttributes ~partDoc ~allowUncurry atTl in
+        {partition with arityAttrs=arity_attr::partition.arityAttrs}
+    | (({txt="ocaml.text"}, _) as doc)::atTl when partDoc = true ->
+        let partition = partitionAttributes ~partDoc ~allowUncurry atTl in
+        {partition with docAttrs=doc::partition.docAttrs}
+    | (({txt="ocaml.doc"}, _) as doc)::atTl when partDoc = true ->
+        let partition = partitionAttributes ~partDoc ~allowUncurry atTl in
+        {partition with docAttrs=doc::partition.docAttrs}
+    | (({txt="reason.raw_literal"; _}, _) as attr) :: atTl ->
+        let partition = partitionAttributes ~partDoc ~allowUncurry atTl in
+        {partition with literalAttrs=attr::partition.literalAttrs}
+    | atHd :: atTl ->
+        let partition = partitionAttributes ~partDoc ~allowUncurry atTl in
+        {partition with stdAttrs=atHd::partition.stdAttrs}
+
+let extractStdAttrs attrs =
+  (partitionAttributes attrs).stdAttrs
+
+let extract_raw_literal attrs =
+  let rec loop acc = function
+    | ({txt="reason.raw_literal"},
+       PStr [{pstr_desc = Pstr_eval({pexp_desc = Pexp_constant(Pconst_string(text, None)); _}, _); _}])
+      :: rest ->
+      (Some text, List.rev_append acc rest)
+    | [] -> (None, List.rev acc)
+    | attr :: rest -> loop (attr :: acc) rest
+  in
+  loop [] attrs
+
+(* Returns (selected, remaining) *)
+let rec partition fn attrs : attribute list * attribute list =
+  match attrs with
+  | [] -> ([], [])
+  | attr::atTl when fn attr ->
+    let (selectedRec, remainingRec) = partition fn atTl in
+    (attr::selectedRec, remainingRec)
+  | attr::atTl ->
+    let (selectedRec, remainingRec) = partition fn atTl in
+    (selectedRec, attr::remainingRec)