upgrade syntax to 1680ae5

Author: bobzhang

lib/4.06.1/whole_compiler.ml

@@ -415154,13 +415154,13 @@ let shouldInlineRhsBinaryExpr rhs = match rhs.pexp_desc with
 
 let filterPrinteableAttributes attrs =
   List.filter (fun attr -> match attr with
-    | ({Location.txt="bs" | "ns.ternary" | "ns.iflet"}, _) -> false
+    | ({Location.txt="bs" | "ns.ternary" | "ns.iflet" | "JSX"}, _) -> false
     | _ -> true
   ) attrs
 
 let partitionPrinteableAttributes attrs =
   List.partition (fun attr -> match attr with
-    | ({Location.txt="bs" | "ns.ternary" | "ns.iflet"}, _) -> false
+    | ({Location.txt="bs" | "ns.ternary" | "ns.iflet" | "JSX"}, _) -> false
     | _ -> true
   ) attrs
 
@@ -416933,7 +416933,11 @@ and walkExprArgument (_argLabel, expr) t comments =
     | Ppat_construct (constr, Some pat) ->
       let (leading, trailing) = partitionLeadingTrailing comments constr.loc in
       attach t.leading constr.loc leading;
-      let (leading, inside, trailing) = partitionByLoc trailing pat.ppat_loc in
+      let (afterConstructor, rest) =
+        partitionAdjacentTrailing constr.loc trailing
+      in
+      attach t.trailing constr.loc afterConstructor;
+      let (leading, inside, trailing) = partitionByLoc rest pat.ppat_loc in
       attach t.leading pat.ppat_loc leading;
       walkPattern pat t inside;
       attach t.trailing pat.ppat_loc trailing
@@ -420405,15 +420409,41 @@ let printIdentLike ?allowUident txt =
     ]
   | NormalIdent -> Doc.text txt
 
+let rec unsafe_for_all_range s ~start ~finish p =
+  start > finish ||
+  p (String.unsafe_get s start) &&
+  unsafe_for_all_range s ~start:(start + 1) ~finish p
+
+let for_all_from s start  p =
+  let len = String.length s in
+  unsafe_for_all_range s ~start ~finish:(len - 1) p
+
+(* See https://github.com/rescript-lang/rescript-compiler/blob/726cfa534314b586e5b5734471bc2023ad99ebd9/jscomp/ext/ext_string.ml#L510 *)
+let isValidNumericPolyvarNumber (x : string) =
+  let len = String.length x in
+  len > 0 && (
+    let a = Char.code (String.unsafe_get x 0) in
+    a <= 57 &&
+    (if len > 1 then
+       a > 48 &&
+       for_all_from x 1 (function '0' .. '9' -> true | _ -> false)
+     else
+       a >= 48 )
+  )
+
 (* Exotic identifiers in poly-vars have a "lighter" syntax: #"ease-in" *)
 let printPolyVarIdent txt =
-  match classifyIdentContent ~allowUident:true txt with
-  | ExoticIdent -> Doc.concat [
-      Doc.text "\"";
-      Doc.text txt;
-      Doc.text"\""
-    ]
-  | NormalIdent -> Doc.text txt
+  (* numeric poly-vars don't need quotes: #644 *)
+  if isValidNumericPolyvarNumber txt then
+    Doc.text txt
+  else
+    match classifyIdentContent ~allowUident:true txt with
+    | ExoticIdent -> Doc.concat [
+        Doc.text "\"";
+        Doc.text txt;
+        Doc.text"\""
+      ]
+    | NormalIdent -> Doc.text txt
 
 
 let printLident l = match l with
@@ -422118,7 +422148,7 @@ and printPattern (p : Parsetree.pattern) cmtTbl =
       ])
     )
   | Ppat_construct(constrName, constructorArgs) ->
-    let constrName = printLongident constrName.txt in
+    let constrName = printLongidentLocation constrName cmtTbl in
     let argsDoc = match constructorArgs with
     | None -> Doc.nil
     | Some({ppat_loc; ppat_desc = Ppat_construct ({txt = Longident.Lident "()"}, _)}) ->
@@ -423814,7 +423844,11 @@ and printJsxExpression lident args cmtTbl =
   let name = printJsxName lident in
   let (formattedProps, children) = printJsxProps args cmtTbl in
   (* <div className="test" /> *)
-  let isSelfClosing = match children with | [] -> true | _ -> false in
+  let isSelfClosing =
+    match children with
+    | Some ({Parsetree.pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, None)}) -> true
+    | _ -> false
+  in
   Doc.group (
     Doc.concat [
       Doc.group (
@@ -423831,7 +423865,10 @@ and printJsxExpression lident args cmtTbl =
           Doc.indent (
             Doc.concat [
               Doc.line;
-              printJsxChildren children cmtTbl;
+              (match children with
+              | Some childrenExpression -> printJsxChildren childrenExpression cmtTbl
+              | None -> Doc.nil
+              );
             ]
           );
           Doc.line;
@@ -423845,17 +423882,17 @@ and printJsxExpression lident args cmtTbl =
 and printJsxFragment expr cmtTbl =
   let opening = Doc.text "<>" in
   let closing = Doc.text "</>" in
-  let (children, _) = ParsetreeViewer.collectListExpressions expr in
+  (* let (children, _) = ParsetreeViewer.collectListExpressions expr in *)
   Doc.group (
     Doc.concat [
       opening;
-      begin match children with
-      | [] -> Doc.nil
-      | children ->
+      begin match expr.pexp_desc with
+      | Pexp_construct ({txt = Longident.Lident "[]"}, None) -> Doc.nil
+      | _ ->
         Doc.indent (
           Doc.concat [
             Doc.line;
-            printJsxChildren children cmtTbl;
+            printJsxChildren expr cmtTbl;
           ]
         )
       end;
@@ -423864,29 +423901,46 @@ and printJsxFragment expr cmtTbl =
     ]
   )
 
-and printJsxChildren (children: Parsetree.expression list) cmtTbl =
-  Doc.group (
-    Doc.join ~sep:Doc.line (
-      List.map (fun (expr : Parsetree.expression) ->
-        let leadingLineCommentPresent = hasLeadingLineComment cmtTbl expr.pexp_loc in
-        let exprDoc = printExpressionWithComments expr cmtTbl in
-        match Parens.jsxChildExpr expr with
-        | Parenthesized | Braced _ ->
-          (* {(20: int)} make sure that we also protect the expression inside *)
-          let innerDoc = if Parens.bracedExpr expr then addParens exprDoc else exprDoc in
-          if leadingLineCommentPresent then
-            addBraces innerDoc
-          else
-            Doc.concat [Doc.lbrace; innerDoc; Doc.rbrace]
-        | Nothing -> exprDoc
-      ) children
+and printJsxChildren (childrenExpr : Parsetree.expression) cmtTbl =
+  match childrenExpr.pexp_desc with
+  | Pexp_construct ({txt = Longident.Lident "::"}, _) ->
+    let (children, _) = ParsetreeViewer.collectListExpressions childrenExpr in
+    Doc.group (
+      Doc.join ~sep:Doc.line (
+        List.map (fun (expr : Parsetree.expression) ->
+          let leadingLineCommentPresent = hasLeadingLineComment cmtTbl expr.pexp_loc in
+          let exprDoc = printExpressionWithComments expr cmtTbl in
+          match Parens.jsxChildExpr expr with
+          | Parenthesized | Braced _ ->
+            (* {(20: int)} make sure that we also protect the expression inside *)
+            let innerDoc = if Parens.bracedExpr expr then addParens exprDoc else exprDoc in
+            if leadingLineCommentPresent then
+              addBraces innerDoc
+            else
+              Doc.concat [Doc.lbrace; innerDoc; Doc.rbrace]
+          | Nothing -> exprDoc
+        ) children
+      )
     )
-  )
+  | _ ->
+    let leadingLineCommentPresent = hasLeadingLineComment cmtTbl childrenExpr.pexp_loc in
+    let exprDoc = printExpressionWithComments childrenExpr cmtTbl in
+    Doc.concat [
+      Doc.dotdotdot;
+      match Parens.jsxChildExpr childrenExpr with
+      | Parenthesized | Braced _ ->
+        let innerDoc = if Parens.bracedExpr childrenExpr then addParens exprDoc else exprDoc in
+        if leadingLineCommentPresent then
+          addBraces innerDoc
+        else
+          Doc.concat [Doc.lbrace; innerDoc; Doc.rbrace]
+      | Nothing -> exprDoc
+    ]
 
-and printJsxProps args cmtTbl =
+and printJsxProps args cmtTbl :(Doc.t * Parsetree.expression option) =
   let rec loop props args =
     match args with
-    | [] -> (Doc.nil, [])
+    | [] -> (Doc.nil, None)
     | [
         (Asttypes.Labelled "children", children);
         (
@@ -423905,8 +423959,7 @@ and printJsxProps args cmtTbl =
             )
           ]
       ) in
-      let (children, _) = ParsetreeViewer.collectListExpressions children in
-      (formattedProps, children)
+      (formattedProps, Some children)
     | arg::args ->
       let propDoc = printJsxProp arg cmtTbl in
       loop (propDoc::props) args
@@ -425863,6 +425916,9 @@ let parseHashIdent ~startPos p =
     Parser.next p;
     let text = if p.mode = ParseForTypeChecker then parseStringLiteral text else text in
     (text, mkLoc startPos p.prevEndPos)
+  | Int {i} ->
+    Parser.next p;
+    (i, mkLoc startPos p.prevEndPos)
   | _ ->
     parseIdent ~startPos ~msg:ErrorMessages.variantIdent p
 
@@ -426366,6 +426422,9 @@ let rec parsePattern ?(alias=true) ?(or_=true) p =
         Parser.next p;
         let text = if p.mode = ParseForTypeChecker then parseStringLiteral text else text in
         (text, mkLoc startPos p.prevEndPos)
+      | Int {i} ->
+        Parser.next p;
+        (i, mkLoc startPos p.prevEndPos)
       | _ ->
         parseIdent ~msg:ErrorMessages.variantIdent ~startPos p
       in
@@ -426766,7 +426825,7 @@ and parseTernaryExpr leftOperand p =
   | _ ->
     leftOperand
 
-and parseEs6ArrowExpression ?parameters p =
+and parseEs6ArrowExpression ?context ?parameters p =
   let startPos = p.Parser.startPos in
   Parser.leaveBreadcrumb p Grammar.Es6ArrowExpr;
   let parameters = match parameters with
@@ -426782,7 +426841,7 @@ and parseEs6ArrowExpression ?parameters p =
   in
   Parser.expect EqualGreater p;
   let body =
-    let expr = parseExpr p in
+    let expr = parseExpr ?context p in
     match returnType with
     | Some typ ->
       Ast_helper.Exp.constraint_
@@ -427298,7 +427357,7 @@ and parseOperandExpr ~context p =
     if (context != WhenExpr) &&
        isEs6ArrowExpression ~inTernary:(context=TernaryTrueBranchExpr) p
     then
-      parseEs6ArrowExpression p
+      parseEs6ArrowExpression ~context p
     else
       parseUnaryExpr p
   in
@@ -429852,7 +429911,7 @@ and parseTypeEquationOrConstrDecl p =
       | _ -> (Some typ, Asttypes.Public, Parsetree.Ptype_abstract)
       end
     | _ ->
-      let uidentEndPos = p.endPos in
+      let uidentEndPos = p.prevEndPos in
       let (args, res) = parseConstrDeclArgs p in
       let first = Some (
         let uidentLoc = mkLoc uidentStartPos uidentEndPos in
@@ -432746,6 +432805,28 @@ end = struct
 module Doc = Res_doc
 module Token = Res_token
 
+let rec unsafe_for_all_range s ~start ~finish p =
+  start > finish ||
+  p (String.unsafe_get s start) &&
+  unsafe_for_all_range s ~start:(start + 1) ~finish p
+
+let for_all_from s start  p =
+  let len = String.length s in
+  unsafe_for_all_range s ~start ~finish:(len - 1) p
+
+(* See https://github.com/rescript-lang/rescript-compiler/blob/726cfa534314b586e5b5734471bc2023ad99ebd9/jscomp/ext/ext_string.ml#L510 *)
+let isValidNumericPolyvarNumber (x : string) =
+  let len = String.length x in
+  len > 0 && (
+    let a = Char.code (String.unsafe_get x 0) in
+    a <= 57 &&
+    (if len > 1 then
+       a > 48 &&
+       for_all_from x 1 (function '0' .. '9' -> true | _ -> false)
+     else
+       a >= 48 )
+  )
+
 (* checks if ident contains "arity", like in "arity1", "arity2", "arity3" etc. *)
 let isArityIdent ident =
   if String.length ident >= 6 then
@@ -432793,13 +432874,17 @@ let printIdentLike ~allowUident txt =
   | NormalIdent -> Doc.text txt
 
 let printPolyVarIdent txt =
-  match classifyIdentContent ~allowUident:true txt with
-  | ExoticIdent -> Doc.concat [
-     Doc.text "\"";
-     Doc.text txt;
-     Doc.text"\""
-   ]
-  | NormalIdent -> Doc.text txt
+  (* numeric poly-vars don't need quotes: #644 *)
+  if isValidNumericPolyvarNumber txt then
+    Doc.text txt
+  else
+    match classifyIdentContent ~allowUident:true txt with
+    | ExoticIdent -> Doc.concat [
+       Doc.text "\"";
+       Doc.text txt;
+       Doc.text"\""
+     ]
+    | NormalIdent -> Doc.text txt
 
   (* ReScript doesn't have parenthesized identifiers.
    * We don't support custom operators. *)