sync latest syntax

Author: zth

analysis/vendor/ml/ast_uncurried.ml

@@ -1,4 +1,4 @@
-(* Untyped AST *)
+(* Uncurried AST *)
 
 
 let encode_arity_string arity = "Has_arity" ^ string_of_int arity
@@ -50,7 +50,7 @@ let rec attributes_to_arity (attrs : Parsetree.attributes) =
 let uncurriedFun ~loc ~arity funExpr =
     Ast_helper.Exp.construct ~loc
       ~attrs:(arity_to_attributes arity)
-      { txt = Lident "Function$"; loc }
+      (Location.mknoloc (Longident.Lident "Function$"))
       (Some funExpr)
 
 let exprIsUncurriedFun (expr : Parsetree.expression) =
@@ -63,12 +63,19 @@ let exprExtractUncurriedFun (expr : Parsetree.expression) =
   | Pexp_construct ({ txt = Lident "Function$" }, Some e) -> e
   | _ -> assert false
 
-let typeIsUncurriedFun (typ : Parsetree.core_type) =
+let coreTypeIsUncurriedFun (typ : Parsetree.core_type) =
   match typ.ptyp_desc with
   | Ptyp_constr ({txt = Lident "function$"}, [{ptyp_desc = Ptyp_arrow _}; _]) ->
     true
   | _ -> false
 
+let typeIsUncurriedFun (typ : Types.type_expr) =
+  match typ.desc with
+  | Tconstr (Pident {name = "function$"}, [{desc = Tarrow _}; _], _) ->
+    true
+  | _ -> false
+
+
 let typeExtractUncurriedFun (typ : Parsetree.core_type) =
   match typ.ptyp_desc with
   | Ptyp_constr ({txt = Lident "function$"}, [tArg; tArity]) ->
@@ -106,3 +113,9 @@ let uncurried_type_get_arity ~env typ =
   | Tconstr (Pident { name = "function$" }, [ _t; tArity ], _) ->
       type_to_arity tArity
   | _ -> assert false
+
+let uncurried_type_get_arity_opt ~env typ =
+  match (Ctype.expand_head env typ).desc with
+  | Tconstr (Pident { name = "function$" }, [ _t; tArity ], _) ->
+      Some (type_to_arity tArity)
+  | _ -> None

analysis/vendor/res_syntax/react_jsx_common.ml

@@ -45,7 +45,7 @@ let raiseErrorMultipleReactComponent ~loc =
 let optionalAttr = ({txt = "res.optional"; loc = Location.none}, PStr [])
 
 let extractUncurried typ =
-  if Ast_uncurried.typeIsUncurriedFun typ then
+  if Ast_uncurried.coreTypeIsUncurriedFun typ then
     let _arity, t = Ast_uncurried.typeExtractUncurriedFun typ in
     t
   else typ

analysis/vendor/res_syntax/res_outcome_printer.ml

@@ -217,6 +217,9 @@ let rec printOutTypeDoc (outType : Outcometree.out_type) =
     ->
     (* function$<(int, int) => int, [#2]> -> (. int, int) => int *)
     printOutArrowType ~uncurried:true arrowType
+  | Otyp_constr (Oide_ident "function$", [Otyp_var _; _arity]) ->
+    (* function$<'a, arity> -> _ => _ *)
+    printOutTypeDoc (Otyp_stuff "_ => _")
   | Otyp_constr (outIdent, []) -> printOutIdentDoc ~allowUident:false outIdent
   | Otyp_manifest (typ1, typ2) ->
     Doc.concat [printOutTypeDoc typ1; Doc.text " = "; printOutTypeDoc typ2]

analysis/vendor/res_syntax/res_parens.ml

@@ -442,7 +442,7 @@ let includeModExpr modExpr =
 let arrowReturnTypExpr typExpr =
   match typExpr.Parsetree.ptyp_desc with
   | Parsetree.Ptyp_arrow _ -> true
-  | _ when Ast_uncurried.typeIsUncurriedFun typExpr -> true
+  | _ when Ast_uncurried.coreTypeIsUncurriedFun typExpr -> true
   | _ -> false
 
 let patternRecordRowRhs (pattern : Parsetree.pattern) =

analysis/vendor/res_syntax/res_printer.ml

@@ -1591,7 +1591,7 @@ and printTypExpr ~(state : State.t) (typExpr : Parsetree.core_type) cmtTbl =
         let doc = printTypExpr ~state n cmtTbl in
         match n.ptyp_desc with
         | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> addParens doc
-        | _ when Ast_uncurried.typeIsUncurriedFun n -> addParens doc
+        | _ when Ast_uncurried.coreTypeIsUncurriedFun n -> addParens doc
         | _ -> doc
       in
       Doc.group
@@ -1652,7 +1652,7 @@ and printTypExpr ~(state : State.t) (typExpr : Parsetree.core_type) cmtTbl =
         let needsParens =
           match typ.ptyp_desc with
           | Ptyp_arrow _ -> true
-          | _ when Ast_uncurried.typeIsUncurriedFun typ -> true
+          | _ when Ast_uncurried.coreTypeIsUncurriedFun typ -> true
           | _ -> false
         in
         let doc = printTypExpr ~state typ cmtTbl in
@@ -1664,7 +1664,7 @@ and printTypExpr ~(state : State.t) (typExpr : Parsetree.core_type) cmtTbl =
     | Ptyp_object (fields, openFlag) ->
       printObject ~state ~inline:false fields openFlag cmtTbl
     | Ptyp_arrow _ -> printArrow ~uncurried:false typExpr
-    | Ptyp_constr _ when Ast_uncurried.typeIsUncurriedFun typExpr ->
+    | Ptyp_constr _ when Ast_uncurried.coreTypeIsUncurriedFun typExpr ->
       let arity, tArg = Ast_uncurried.typeExtractUncurriedFun typExpr in
       printArrow ~uncurried:true ~arity tArg
     | Ptyp_constr (longidentLoc, [{ptyp_desc = Ptyp_object (fields, openFlag)}])
@@ -4018,7 +4018,7 @@ and printPexpApply ~state expr cmtTbl =
           argsDoc;
         ]
     else
-      let argsDoc = printArguments ~state ~dotted args cmtTbl in
+      let argsDoc = printArguments ~state ~dotted ~partial args cmtTbl in
       Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc]
   | _ -> assert false
 
@@ -4524,7 +4524,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl =
         Lazy.force breakAllArgs;
       ]
 
-and printArguments ~state ~dotted
+and printArguments ~state ~dotted ?(partial = false)
     (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl =
   match args with
   | [
@@ -4564,7 +4564,7 @@ and printArguments ~state ~dotted
                     ~sep:(Doc.concat [Doc.comma; Doc.line])
                     (List.map (fun arg -> printArgument ~state arg cmtTbl) args);
                 ]);
-           Doc.trailingComma;
+           (if partial then Doc.nil else Doc.trailingComma);
            Doc.softLine;
            Doc.rparen;
          ])