Vendor latest parser/printer.

Author: cristianoc

analysis/vendor/res_outcome_printer/res_core.ml

@@ -161,6 +161,8 @@ let uncurryAttr = (Location.mknoloc "bs", Parsetree.PStr [])
 let ternaryAttr = (Location.mknoloc "ns.ternary", Parsetree.PStr [])
 let ifLetAttr = (Location.mknoloc "ns.iflet", Parsetree.PStr [])
 let optionalAttr = (Location.mknoloc "ns.optional", Parsetree.PStr [])
+let makeAwaitAttr loc = (Location.mkloc "res.await" loc, Parsetree.PStr [])
+let makeAsyncAttr loc = (Location.mkloc "res.async" loc, Parsetree.PStr [])
 
 let makeExpressionOptional ~optional (e : Parsetree.expression) =
   if optional then {e with pexp_attributes = optionalAttr :: e.pexp_attributes}
@@ -237,6 +239,9 @@ let rec goToClosing closingToken state =
 (* Madness *)
 let isEs6ArrowExpression ~inTernary p =
   Parser.lookahead p (fun state ->
+      (match state.Parser.token with
+      | Lident "async" -> Parser.next state
+      | _ -> ());
       match state.Parser.token with
       | Lident _ | Underscore -> (
         Parser.next state;
@@ -611,35 +616,30 @@ let parseHashIdent ~startPos p =
 let parseValuePath p =
   let startPos = p.Parser.startPos in
   let rec aux p path =
-    match p.Parser.token with
-    | Lident ident -> Longident.Ldot (path, ident)
-    | Uident uident ->
-      Parser.next p;
-      if p.Parser.token = Dot then (
-        Parser.expect Dot p;
-        aux p (Ldot (path, uident)))
-      else (
-        Parser.err p (Diagnostics.unexpected p.Parser.token p.breadcrumbs);
-        path)
-    | token ->
-      Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
-      Longident.Ldot (path, "_")
+    let startPos = p.Parser.startPos in
+    let token = p.token in
+
+    Parser.next p;
+    if p.Parser.token = Dot then (
+      Parser.expect Dot p;
+
+      match p.Parser.token with
+      | Lident ident -> Longident.Ldot (path, ident)
+      | Uident uident -> aux p (Ldot (path, uident))
+      | token ->
+        Parser.err p (Diagnostics.unexpected token p.breadcrumbs);
+        Longident.Ldot (path, "_"))
+    else (
+      Parser.err p ~startPos ~endPos:p.prevEndPos (Diagnostics.lident token);
+      path)
   in
   let ident =
     match p.Parser.token with
     | Lident ident ->
       Parser.next p;
       Longident.Lident ident
     | Uident ident ->
-      Parser.next p;
-      let res =
-        if p.Parser.token = Dot then (
-          Parser.expect Dot p;
-          aux p (Lident ident))
-        else (
-          Parser.err p (Diagnostics.unexpected p.Parser.token p.breadcrumbs);
-          Longident.Lident ident)
-      in
+      let res = aux p (Lident ident) in
       Parser.nextUnsafe p;
       res
     | token ->
@@ -2031,6 +2031,16 @@ and parseOperandExpr ~context p =
       let expr = parseUnaryExpr p in
       let loc = mkLoc startPos p.prevEndPos in
       Ast_helper.Exp.assert_ ~loc expr
+    | Lident "async"
+    (* we need to be careful when we're in a ternary true branch:
+       `condition ? ternary-true-branch : false-branch`
+       Arrow expressions could be of the form: `async (): int => stuff()`
+       But if we're in a ternary, the `:` of the ternary takes precedence
+    *)
+      when isEs6ArrowExpression ~inTernary:(context = TernaryTrueBranchExpr) p
+      ->
+      parseAsyncArrowExpression p
+    | Await -> parseAwaitExpression p
     | Lazy ->
       Parser.next p;
       let expr = parseUnaryExpr p in
@@ -2744,6 +2754,21 @@ and parseBracedOrRecordExpr p =
     let expr = parseRecordExpr ~startPos [] p in
     Parser.expect Rbrace p;
     expr
+  (*
+    The branch below takes care of the "braced" expression {async}.
+    The big reason that we need all these branches is that {x} isn't a record with a punned field x, but a braced expression… There's lots of "ambiguity" between a record with a single punned field and a braced expression…
+    What is {x}?
+      1) record {x: x}
+      2) expression x which happens to wrapped in braces
+    Due to historical reasons, we always follow 2
+  *)
+  | Lident "async" when isEs6ArrowExpression ~inTernary:false p ->
+    let expr = parseAsyncArrowExpression p in
+    let expr = parseExprBlock ~first:expr p in
+    Parser.expect Rbrace p;
+    let loc = mkLoc startPos p.prevEndPos in
+    let braces = makeBracesAttr loc in
+    {expr with pexp_attributes = braces :: expr.pexp_attributes}
   | Uident _ | Lident _ -> (
     let startToken = p.token in
     let valueOrConstructor = parseValueOrConstructor p in
@@ -3099,6 +3124,28 @@ and parseExprBlock ?first p =
   Parser.eatBreadcrumb p;
   overParseConstrainedOrCoercedOrArrowExpression p blockExpr
 
+and parseAsyncArrowExpression p =
+  let startPos = p.Parser.startPos in
+  Parser.expect (Lident "async") p;
+  let asyncAttr = makeAsyncAttr (mkLoc startPos p.prevEndPos) in
+  let expr = parseEs6ArrowExpression p in
+  {
+    expr with
+    pexp_attributes = asyncAttr :: expr.pexp_attributes;
+    pexp_loc = {expr.pexp_loc with loc_start = startPos};
+  }
+
+and parseAwaitExpression p =
+  let awaitLoc = mkLoc p.Parser.startPos p.endPos in
+  let awaitAttr = makeAwaitAttr awaitLoc in
+  Parser.expect Await p;
+  let expr = parseUnaryExpr p in
+  {
+    expr with
+    pexp_attributes = awaitAttr :: expr.pexp_attributes;
+    pexp_loc = {expr.pexp_loc with loc_start = awaitLoc.loc_start};
+  }
+
 and parseTryExpression p =
   let startPos = p.Parser.startPos in
   Parser.expect Try p;

analysis/vendor/res_outcome_printer/res_grammar.ml

@@ -147,11 +147,11 @@ let isAtomicTypExprStart = function
   | _ -> false
 
 let isExprStart = function
-  | Token.True | False | Int _ | String _ | Float _ | Codepoint _ | Backtick
-  | Underscore (* _ => doThings() *)
-  | Uident _ | Lident _ | Hash | Lparen | List | Module | Lbracket | Lbrace
-  | LessThan | Minus | MinusDot | Plus | PlusDot | Bang | Percent | At | If
-  | Switch | While | For | Assert | Lazy | Try ->
+  | Token.Assert | At | Await | Backtick | Bang | Codepoint _ | False | Float _
+  | For | Hash | If | Int _ | Lazy | Lbrace | Lbracket | LessThan | Lident _
+  | List | Lparen | Minus | MinusDot | Module | Percent | Plus | PlusDot
+  | String _ | Switch | True | Try | Uident _ | Underscore (* _ => doThings() *)
+  | While ->
     true
   | _ -> false
 
@@ -255,11 +255,11 @@ let isAttributeStart = function
 let isJsxChildStart = isAtomicExprStart
 
 let isBlockExprStart = function
-  | Token.At | Hash | Percent | Minus | MinusDot | Plus | PlusDot | Bang | True
-  | False | Float _ | Int _ | String _ | Codepoint _ | Lident _ | Uident _
-  | Lparen | List | Lbracket | Lbrace | Forwardslash | Assert | Lazy | If | For
-  | While | Switch | Open | Module | Exception | Let | LessThan | Backtick | Try
-  | Underscore ->
+  | Token.Assert | At | Await | Backtick | Bang | Codepoint _ | Exception
+  | False | Float _ | For | Forwardslash | Hash | If | Int _ | Lazy | Lbrace
+  | Lbracket | LessThan | Let | Lident _ | List | Lparen | Minus | MinusDot
+  | Module | Open | Percent | Plus | PlusDot | String _ | Switch | True | Try
+  | Uident _ | Underscore | While ->
     true
   | _ -> false
 

analysis/vendor/res_outcome_printer/res_parens.ml

@@ -45,6 +45,8 @@ let callExpr expr =
        | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_ifthenelse _ );
     } ->
       Parenthesized
+    | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes ->
+      Parenthesized
     | _ -> Nothing)
 
 let structureExpr expr =
@@ -96,6 +98,8 @@ let unaryExprOperand expr =
        | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_ifthenelse _ );
     } ->
       Parenthesized
+    | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes ->
+      Parenthesized
     | _ -> Nothing)
 
 let binaryExprOperand ~isLhs expr =
@@ -120,6 +124,8 @@ let binaryExprOperand ~isLhs expr =
     | expr when ParsetreeViewer.isBinaryExpression expr -> Parenthesized
     | expr when ParsetreeViewer.isTernaryExpr expr -> Parenthesized
     | {pexp_desc = Pexp_lazy _ | Pexp_assert _} when isLhs -> Parenthesized
+    | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes ->
+      Parenthesized
     | {Parsetree.pexp_attributes = attrs} ->
       if ParsetreeViewer.hasPrintableAttributes attrs then Parenthesized
       else Nothing)
@@ -169,7 +175,7 @@ let flattenOperandRhs parentOperator rhs =
   | _ when ParsetreeViewer.isTernaryExpr rhs -> true
   | _ -> false
 
-let lazyOrAssertExprRhs expr =
+let lazyOrAssertOrAwaitExprRhs expr =
   let optBraces, _ = ParsetreeViewer.processBracesAttr expr in
   match optBraces with
   | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc
@@ -196,6 +202,8 @@ let lazyOrAssertExprRhs expr =
        | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_ifthenelse _ );
     } ->
       Parenthesized
+    | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes ->
+      Parenthesized
     | _ -> Nothing)
 
 let isNegativeConstant constant =
@@ -240,6 +248,8 @@ let fieldExpr expr =
        | Pexp_ifthenelse _ );
     } ->
       Parenthesized
+    | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes ->
+      Parenthesized
     | _ -> Nothing)
 
 let setFieldExprRhs expr =
@@ -302,6 +312,8 @@ let jsxPropExpr expr =
       }
         when startsWithMinus x ->
         Parenthesized
+      | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes ->
+        Parenthesized
       | {
        Parsetree.pexp_desc =
          ( Pexp_ident _ | Pexp_constant _ | Pexp_field _ | Pexp_construct _
@@ -338,6 +350,8 @@ let jsxChildExpr expr =
       }
         when startsWithMinus x ->
         Parenthesized
+      | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes ->
+        Parenthesized
       | {
        Parsetree.pexp_desc =
          ( Pexp_ident _ | Pexp_constant _ | Pexp_field _ | Pexp_construct _

analysis/vendor/res_outcome_printer/res_parens.mli

@@ -10,7 +10,7 @@ val subBinaryExprOperand : string -> string -> bool
 val rhsBinaryExprOperand : string -> Parsetree.expression -> bool
 val flattenOperandRhs : string -> Parsetree.expression -> bool
 
-val lazyOrAssertExprRhs : Parsetree.expression -> kind
+val lazyOrAssertOrAwaitExprRhs : Parsetree.expression -> kind
 
 val fieldExpr : Parsetree.expression -> kind
 

analysis/vendor/res_outcome_printer/res_parsetree_viewer.ml

@@ -11,7 +11,7 @@ let arrowType ct =
       process attrsBefore (arg :: acc) typ2
     | {
      ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2);
-     ptyp_attributes = [({txt = "bs"}, _)] as attrs;
+     ptyp_attributes = [({txt = "bs" | "res.async"}, _)] as attrs;
     } ->
       let arg = (attrs, lbl, typ1) in
       process attrsBefore (arg :: acc) typ2
@@ -55,6 +55,30 @@ let processUncurriedAttribute attrs =
   in
   process false [] attrs
 
+type functionAttributesInfo = {
+  async: bool;
+  uncurried: bool;
+  attributes: Parsetree.attributes;
+}
+
+let processFunctionAttributes attrs =
+  let rec process async uncurried acc attrs =
+    match attrs with
+    | [] -> {async; uncurried; attributes = List.rev acc}
+    | ({Location.txt = "bs"}, _) :: rest -> process async true acc rest
+    | ({Location.txt = "res.async"}, _) :: rest ->
+      process true uncurried acc rest
+    | attr :: rest -> process async uncurried (attr :: acc) rest
+  in
+  process false false [] attrs
+
+let hasAwaitAttribute attrs =
+  List.exists
+    (function
+      | {Location.txt = "res.await"}, _ -> true
+      | _ -> false)
+    attrs
+
 let collectListExpressions expr =
   let rec collect acc expr =
     match expr.pexp_desc with
@@ -168,8 +192,9 @@ let filterParsingAttrs attrs =
       match attr with
       | ( {
             Location.txt =
-              ( "ns.ternary" | "ns.braces" | "res.template" | "bs" | "ns.iflet"
-              | "ns.namedArgLoc" | "ns.optional" );
+              ( "bs" | "ns.braces" | "ns.iflet" | "ns.namedArgLoc"
+              | "ns.optional" | "ns.ternary" | "res.async" | "res.await"
+              | "res.template" );
           },
           _ ) ->
         false
@@ -316,7 +341,8 @@ let hasAttributes attrs =
       match attr with
       | ( {
             Location.txt =
-              "bs" | "res.template" | "ns.ternary" | "ns.braces" | "ns.iflet";
+              ( "bs" | "ns.braces" | "ns.iflet" | "ns.ternary" | "res.async"
+              | "res.await" | "res.template" );
           },
           _ ) ->
         false
@@ -497,8 +523,8 @@ let isPrintableAttribute attr =
   match attr with
   | ( {
         Location.txt =
-          ( "bs" | "res.template" | "ns.ternary" | "ns.braces" | "ns.iflet"
-          | "JSX" );
+          ( "bs" | "ns.iflet" | "ns.braces" | "JSX" | "res.async" | "res.await"
+          | "res.template" | "ns.ternary" );
       },
       _ ) ->
     false

analysis/vendor/res_outcome_printer/res_parsetree_viewer.mli

@@ -17,6 +17,17 @@ val functorType :
 val processUncurriedAttribute :
   Parsetree.attributes -> bool * Parsetree.attributes
 
+type functionAttributesInfo = {
+  async: bool;
+  uncurried: bool;
+  attributes: Parsetree.attributes;
+}
+
+(* determines whether a function is async and/or uncurried based on the given attributes *)
+val processFunctionAttributes : Parsetree.attributes -> functionAttributesInfo
+
+val hasAwaitAttribute : Parsetree.attributes -> bool
+
 type ifConditionKind =
   | If of Parsetree.expression
   | IfLet of Parsetree.pattern * Parsetree.expression