From 18a4733aa7f89397d73d16c5c39b8448a0d25a8e Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Thu, 22 Jun 2023 09:45:52 +0200 Subject: [PATCH] sync latest syntax --- analysis/vendor/ml/ast_uncurried.ml | 19 ++++++++++++++++--- .../vendor/res_syntax/react_jsx_common.ml | 2 +- .../vendor/res_syntax/res_outcome_printer.ml | 3 +++ analysis/vendor/res_syntax/res_parens.ml | 2 +- analysis/vendor/res_syntax/res_printer.ml | 12 ++++++------ 5 files changed, 27 insertions(+), 11 deletions(-) diff --git a/analysis/vendor/ml/ast_uncurried.ml b/analysis/vendor/ml/ast_uncurried.ml index f79e52f6e..8b418ef28 100644 --- a/analysis/vendor/ml/ast_uncurried.ml +++ b/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 diff --git a/analysis/vendor/res_syntax/react_jsx_common.ml b/analysis/vendor/res_syntax/react_jsx_common.ml index ae4a529d6..0cfe798a7 100644 --- a/analysis/vendor/res_syntax/react_jsx_common.ml +++ b/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 diff --git a/analysis/vendor/res_syntax/res_outcome_printer.ml b/analysis/vendor/res_syntax/res_outcome_printer.ml index c193f1434..da54dc626 100644 --- a/analysis/vendor/res_syntax/res_outcome_printer.ml +++ b/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] diff --git a/analysis/vendor/res_syntax/res_parens.ml b/analysis/vendor/res_syntax/res_parens.ml index 13e801b5c..5fc2ab9ff 100644 --- a/analysis/vendor/res_syntax/res_parens.ml +++ b/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) = diff --git a/analysis/vendor/res_syntax/res_printer.ml b/analysis/vendor/res_syntax/res_printer.ml index bf714208f..b1f47d23a 100644 --- a/analysis/vendor/res_syntax/res_printer.ml +++ b/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; ])