diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index dc5fd62a47..e389266094 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -268,8 +268,7 @@ let rec exprToContextPathInner (e : Parsetree.expression) = (* Transform away pipe with apply call *) exprToContextPath { - pexp_desc = - Pexp_apply {funct = d; args = (Nolabel, lhs) :: args; partial}; + pexp_desc = Pexp_apply {funct = d; args = (Nolbl, lhs) :: args; partial}; pexp_loc; pexp_attributes; } @@ -289,7 +288,7 @@ let rec exprToContextPathInner (e : Parsetree.expression) = Pexp_apply { funct = {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes}; - args = [(Nolabel, lhs)]; + args = [(Nolbl, lhs)]; partial; }; pexp_loc; @@ -298,7 +297,11 @@ let rec exprToContextPathInner (e : Parsetree.expression) = | Pexp_apply {funct = e1; args} -> ( match exprToContextPath e1 with | None -> None - | Some contexPath -> Some (CPApply (contexPath, args |> List.map fst))) + | Some contexPath -> + Some + (CPApply + (contexPath, args |> List.map fst |> List.map Asttypes.to_arg_label)) + ) | Pexp_tuple exprs -> let exprsAsContextPaths = exprs |> List.filter_map exprToContextPath in if List.length exprs = List.length exprsAsContextPaths then @@ -1434,7 +1437,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor | Some (ctxPath, currentUnlabelledCount) -> (processingFun := match lbl with - | Nolabel -> Some (ctxPath, currentUnlabelledCount + 1) + | Nolbl -> Some (ctxPath, currentUnlabelledCount + 1) | _ -> Some (ctxPath, currentUnlabelledCount)); if Debug.verbose () then print_endline "[expr_iter] Completing for argument value"; @@ -1444,10 +1447,10 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor functionContextPath = ctxPath; argumentLabel = (match lbl with - | Nolabel -> + | Nolbl -> Unlabelled {argumentPosition = currentUnlabelledCount} - | Optional name -> Optional name - | Labelled name -> Labelled name); + | Opt {txt = name} -> Optional name + | Lbl {txt = name} -> Labelled name); }) in (match defaultExpOpt with diff --git a/analysis/src/CompletionJsx.ml b/analysis/src/CompletionJsx.ml index b68c06ad1a..9cf791f71e 100644 --- a/analysis/src/CompletionJsx.ml +++ b/analysis/src/CompletionJsx.ml @@ -465,20 +465,18 @@ let extractJsxProps ~(compName : Longident.t Location.loc) ~args = in let rec processProps ~acc args = match args with - | (Asttypes.Labelled "children", {Parsetree.pexp_loc}) :: _ -> + | (Asttypes.Lbl {txt = "children"}, {Parsetree.pexp_loc}) :: _ -> { compName; props = List.rev acc; childrenStart = (if pexp_loc.loc_ghost then None else Some (Loc.start pexp_loc)); } - | ((Labelled s | Optional s), (eProp : Parsetree.expression)) :: rest -> ( - let namedArgLoc = - eProp.pexp_attributes - |> List.find_opt (fun ({Asttypes.txt}, _) -> txt = "res.namedArgLoc") - in + | ((Lbl {txt = s; loc} | Opt {txt = s; loc}), (eProp : Parsetree.expression)) + :: rest -> ( + let namedArgLoc = if loc = Location.none then None else Some loc in match namedArgLoc with - | Some ({loc}, _) -> + | Some loc -> processProps ~acc: ({ diff --git a/analysis/src/DumpAst.ml b/analysis/src/DumpAst.ml index b017a39e66..5431e62c66 100644 --- a/analysis/src/DumpAst.ml +++ b/analysis/src/DumpAst.ml @@ -218,9 +218,9 @@ and printExprItem expr ~pos ~indentation = ^ addIndentation (indentation + 1) ^ "arg: " ^ (match arg with - | Nolabel -> "Nolabel" - | Labelled name -> "Labelled(" ^ name ^ ")" - | Optional name -> "Optional(" ^ name ^ ")") + | Nolbl -> "Nolabel" + | Lbl {txt = name} -> "Labelled(" ^ name ^ ")" + | Opt {txt = name} -> "Optional(" ^ name ^ ")") ^ ",\n" ^ addIndentation (indentation + 2) ^ "pattern: " diff --git a/analysis/src/SemanticTokens.ml b/analysis/src/SemanticTokens.ml index b1215e154d..7fc3fbee95 100644 --- a/analysis/src/SemanticTokens.ml +++ b/analysis/src/SemanticTokens.ml @@ -266,7 +266,7 @@ let command ~debug ~emitter ~path = let posOfGreatherthanAfterProps = let rec loop = function - | (Asttypes.Labelled "children", {Parsetree.pexp_loc}) :: _ -> + | (Asttypes.Lbl {txt = "children"}, {Parsetree.pexp_loc}) :: _ -> Loc.start pexp_loc | _ :: args -> loop args | [] -> (* should not happen *) (-1, -1) diff --git a/analysis/src/SharedTypes.ml b/analysis/src/SharedTypes.ml index 59675f1811..4104e6a43e 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -898,20 +898,18 @@ type arg = {label: label; exp: Parsetree.expression} let extractExpApplyArgs ~args = let rec processArgs ~acc args = match args with - | (((Asttypes.Labelled s | Optional s) as label), (e : Parsetree.expression)) + | ( ((Asttypes.Lbl {txt = s; loc} | Opt {txt = s; loc}) as label), + (e : Parsetree.expression) ) :: rest -> ( - let namedArgLoc = - e.pexp_attributes - |> List.find_opt (fun ({Asttypes.txt}, _) -> txt = "res.namedArgLoc") - in + let namedArgLoc = if loc = Location.none then None else Some loc in match namedArgLoc with - | Some ({loc}, _) -> + | Some loc -> let labelled = { name = s; opt = (match label with - | Optional _ -> true + | Opt _ -> true | _ -> false); posStart = Loc.start loc; posEnd = Loc.end_ loc; @@ -919,7 +917,7 @@ let extractExpApplyArgs ~args = in processArgs ~acc:({label = Some labelled; exp = e} :: acc) rest | None -> processArgs ~acc rest) - | (Asttypes.Nolabel, (e : Parsetree.expression)) :: rest -> + | (Nolbl, (e : Parsetree.expression)) :: rest -> if e.pexp_loc.loc_ghost then processArgs ~acc rest else processArgs ~acc:({label = None; exp = e} :: acc) rest | [] -> List.rev acc diff --git a/analysis/src/SignatureHelp.ml b/analysis/src/SignatureHelp.ml index 0b7b91b5b5..9ac55d3817 100644 --- a/analysis/src/SignatureHelp.ml +++ b/analysis/src/SignatureHelp.ml @@ -130,7 +130,7 @@ let extractParameters ~signature ~typeStrForParser ~labelPrefixLen = (* The AST locations does not account for "=?" of optional arguments, so add that to the offset here if needed. *) let endOffset = match argumentLabel with - | Asttypes.Optional _ -> endOffset + 2 + | Asttypes.Opt _ -> endOffset + 2 | _ -> endOffset in extractParams nextFunctionExpr @@ -474,6 +474,7 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = parameters = parameters |> List.map (fun (argLabel, start, end_) -> + let argLabel = Asttypes.to_arg_label argLabel in let paramArgCount = !paramUnlabelledArgCount in paramUnlabelledArgCount := paramArgCount + 1; let unlabelledArgCount = ref 0 in diff --git a/analysis/src/TypeUtils.ml b/analysis/src/TypeUtils.ml index 3942aae2fe..23d504d6d6 100644 --- a/analysis/src/TypeUtils.ml +++ b/analysis/src/TypeUtils.ml @@ -941,7 +941,7 @@ module Codegen = struct let mkFailWithExp () = Ast_helper.Exp.apply (Ast_helper.Exp.ident {txt = Lident "failwith"; loc = Location.none}) - [(Nolabel, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))] + [(Nolbl, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))] let mkConstructPat ?payload name = Ast_helper.Pat.construct diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml index 837f7df744..e9f083ce75 100644 --- a/analysis/src/Xform.ml +++ b/analysis/src/Xform.ml @@ -95,7 +95,7 @@ module IfThenElse = struct Pexp_ident {txt = Longident.Lident (("==" | "!=") as op)}; }; - args = [(Nolabel, arg1); (Nolabel, arg2)]; + args = [(Nolbl, arg1); (Nolbl, arg2)]; }; }, e1, @@ -300,7 +300,7 @@ module AddTypeAnnotation = struct match e.pexp_desc with | Pexp_fun {arg_label; lhs = pat; rhs = e} -> let isUnlabeledOnlyArg = - argNum = 1 && arg_label = Nolabel + argNum = 1 && arg_label = Nolbl && match e.pexp_desc with | Pexp_fun _ -> false diff --git a/compiler/frontend/ast_compatible.ml b/compiler/frontend/ast_compatible.ml index bfbafd80c0..a25860cd0d 100644 --- a/compiler/frontend/ast_compatible.ml +++ b/compiler/frontend/ast_compatible.ml @@ -31,7 +31,7 @@ open Parsetree let default_loc = Location.none let arrow ?loc ?attrs ~arity a b = - Ast_helper.Typ.arrow ?loc ?attrs ~arity Nolabel a b + Ast_helper.Typ.arrow ?loc ?attrs ~arity Nolbl a b let apply_simple ?(loc = default_loc) ?(attrs = []) (fn : expression) (args : expression list) : expression = @@ -42,7 +42,7 @@ let apply_simple ?(loc = default_loc) ?(attrs = []) (fn : expression) Pexp_apply { funct = fn; - args = Ext_list.map args (fun x -> (Asttypes.Nolabel, x)); + args = Ext_list.map args (fun x -> (Asttypes.Nolbl, x)); partial = false; }; } @@ -51,8 +51,7 @@ let app1 ?(loc = default_loc) ?(attrs = []) fn arg1 : expression = { pexp_loc = loc; pexp_attributes = attrs; - pexp_desc = - Pexp_apply {funct = fn; args = [(Nolabel, arg1)]; partial = false}; + pexp_desc = Pexp_apply {funct = fn; args = [(Nolbl, arg1)]; partial = false}; } let app2 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 : expression = @@ -61,7 +60,7 @@ let app2 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 : expression = pexp_attributes = attrs; pexp_desc = Pexp_apply - {funct = fn; args = [(Nolabel, arg1); (Nolabel, arg2)]; partial = false}; + {funct = fn; args = [(Nolbl, arg1); (Nolbl, arg2)]; partial = false}; } let app3 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 arg3 : expression = @@ -72,7 +71,7 @@ let app3 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 arg3 : expression = Pexp_apply { funct = fn; - args = [(Nolabel, arg1); (Nolabel, arg2); (Nolabel, arg3)]; + args = [(Nolbl, arg1); (Nolbl, arg2); (Nolbl, arg3)]; partial = false; }; } @@ -83,15 +82,7 @@ let fun_ ?(loc = default_loc) ?(attrs = []) ?(async = false) ~arity pat exp = pexp_attributes = attrs; pexp_desc = Pexp_fun - { - arg_label = Nolabel; - label_loc = Location.none; - default = None; - lhs = pat; - rhs = exp; - arity; - async; - }; + {arg_label = Nolbl; default = None; lhs = pat; rhs = exp; arity; async}; } let const_exp_string ?(loc = default_loc) ?(attrs = []) ?delimiter (s : string) @@ -118,25 +109,27 @@ let apply_labels ?(loc = default_loc) ?(attrs = []) fn Pexp_apply { funct = fn; - args = Ext_list.map args (fun (l, a) -> (Asttypes.Labelled l, a)); + args = + Ext_list.map args (fun (l, a) -> + (Asttypes.Lbl {txt = l; loc = Location.none}, a)); partial = false; }; } -let label_arrow ?(loc = default_loc) ?(attrs = []) ~arity s arg ret : core_type - = +let label_arrow ?(loc = default_loc) ?(attrs = []) ~arity txt arg ret : + core_type = { ptyp_desc = - Ptyp_arrow {lbl = Labelled s; lbl_loc = Location.none; arg; ret; arity}; + Ptyp_arrow {lbl = Asttypes.Lbl {txt; loc = default_loc}; arg; ret; arity}; ptyp_loc = loc; ptyp_attributes = attrs; } -let opt_arrow ?(loc = default_loc) ?(attrs = []) ~arity s arg ret : core_type = +let opt_arrow ?(loc = default_loc) ?(attrs = []) ~arity txt arg ret : core_type + = { ptyp_desc = - Ptyp_arrow - {lbl = Asttypes.Optional s; lbl_loc = Location.none; arg; ret; arity}; + Ptyp_arrow {lbl = Asttypes.Opt {txt; loc = default_loc}; arg; ret; arity}; ptyp_loc = loc; ptyp_attributes = attrs; } @@ -167,4 +160,4 @@ type object_field = Parsetree.object_field let object_field l attrs ty = Parsetree.Otag (l, attrs, ty) -type args = (Asttypes.arg_label * Parsetree.expression) list +type args = (Asttypes.arg_label_loc * Parsetree.expression) list diff --git a/compiler/frontend/ast_compatible.mli b/compiler/frontend/ast_compatible.mli index 63201f9ef8..87a7124053 100644 --- a/compiler/frontend/ast_compatible.mli +++ b/compiler/frontend/ast_compatible.mli @@ -137,4 +137,4 @@ type object_field = Parsetree.object_field val object_field : Asttypes.label Asttypes.loc -> attributes -> core_type -> object_field -type args = (Asttypes.arg_label * Parsetree.expression) list +type args = (Asttypes.arg_label_loc * Parsetree.expression) list diff --git a/compiler/frontend/ast_core_type.ml b/compiler/frontend/ast_core_type.ml index 6968d1cab8..f084ad8184 100644 --- a/compiler/frontend/ast_core_type.ml +++ b/compiler/frontend/ast_core_type.ml @@ -131,7 +131,7 @@ let get_curry_arity (ty : t) = let is_arity_one ty = get_curry_arity ty = 1 type param_type = { - label: Asttypes.arg_label; + label: Asttypes.arg_label_loc; ty: Parsetree.core_type; attr: Parsetree.attributes; loc: loc; @@ -142,15 +142,7 @@ let mk_fn_type (new_arg_types_ty : param_type list) (result : t) : t = Ext_list.fold_right new_arg_types_ty result (fun {label; ty; attr; loc} acc -> { - ptyp_desc = - Ptyp_arrow - { - lbl = label; - lbl_loc = Location.none; - arg = ty; - ret = acc; - arity = None; - }; + ptyp_desc = Ptyp_arrow {lbl = label; arg = ty; ret = acc; arity = None}; ptyp_loc = loc; ptyp_attributes = attr; }) @@ -179,5 +171,5 @@ let list_of_arrow (ty : t) : t * param_type list = let add_last_obj (ty : t) (obj : t) = let result, params = list_of_arrow ty in mk_fn_type - (params @ [{label = Nolabel; ty = obj; attr = []; loc = obj.ptyp_loc}]) + (params @ [{label = Nolbl; ty = obj; attr = []; loc = obj.ptyp_loc}]) result diff --git a/compiler/frontend/ast_core_type.mli b/compiler/frontend/ast_core_type.mli index 15dc6aed32..6e6eed7142 100644 --- a/compiler/frontend/ast_core_type.mli +++ b/compiler/frontend/ast_core_type.mli @@ -48,7 +48,7 @@ val get_uncurry_arity : t -> int option *) type param_type = { - label: Asttypes.arg_label; + label: Asttypes.arg_label_loc; ty: t; attr: Parsetree.attributes; loc: Location.t; diff --git a/compiler/frontend/ast_core_type_class_type.ml b/compiler/frontend/ast_core_type_class_type.ml index 5af87136a8..2d5a3f1ace 100644 --- a/compiler/frontend/ast_core_type_class_type.ml +++ b/compiler/frontend/ast_core_type_class_type.ml @@ -106,7 +106,7 @@ let typ_mapper (self : Bs_ast_mapper.mapper) (ty : Parsetree.core_type) = | Meth_callback attr, attrs -> (attrs, attr +> ty) in Ast_compatible.object_field name attrs - (Ast_typ_uncurry.to_uncurry_type loc self Nolabel core_type + (Ast_typ_uncurry.to_uncurry_type loc self Nolbl core_type (Ast_literal.type_unit ~loc ())) in let not_getter_setter ty = diff --git a/compiler/frontend/ast_exp_apply.ml b/compiler/frontend/ast_exp_apply.ml index fb5b500db9..640cc23672 100644 --- a/compiler/frontend/ast_exp_apply.ml +++ b/compiler/frontend/ast_exp_apply.ml @@ -91,8 +91,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp = | Pexp_apply {funct = fn1; args; partial} -> Bs_ast_invariant.warn_discarded_unused_attributes fn1.pexp_attributes; { - pexp_desc = - Pexp_apply {funct = fn1; args = (Nolabel, a) :: args; partial}; + pexp_desc = Pexp_apply {funct = fn1; args = (Nolbl, a) :: args; partial}; pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ f.pexp_attributes; } @@ -116,7 +115,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp = Pexp_apply { funct = fn; - args = (Nolabel, bounded_obj_arg) :: args; + args = (Nolbl, bounded_obj_arg) :: args; partial = false; }; pexp_attributes = []; @@ -170,7 +169,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp = let arg = self.expr self arg in let fn = Exp.send ~loc obj {txt = name ^ Literals.setter_suffix; loc} in Exp.constraint_ ~loc - (Exp.apply ~loc fn [(Nolabel, arg)]) + (Exp.apply ~loc fn [(Nolbl, arg)]) (Ast_literal.type_unit ~loc ()) in match obj.pexp_desc with diff --git a/compiler/frontend/ast_exp_extension.ml b/compiler/frontend/ast_exp_extension.ml index 47405da03d..89c86ce93e 100644 --- a/compiler/frontend/ast_exp_extension.ml +++ b/compiler/frontend/ast_exp_extension.ml @@ -45,7 +45,7 @@ let handle_extension e (self : Bs_ast_mapper.mapper) Exp.apply ~loc (Exp.ident ~loc {txt = Longident.parse "Js.Exn.raiseError"; loc}) [ - ( Nolabel, + ( Nolbl, Exp.constant ~loc (Pconst_string ( (pretext diff --git a/compiler/frontend/ast_exp_handle_external.ml b/compiler/frontend/ast_exp_handle_external.ml index 437e12dbe2..4165232be9 100644 --- a/compiler/frontend/ast_exp_handle_external.ml +++ b/compiler/frontend/ast_exp_handle_external.ml @@ -43,8 +43,7 @@ let handle_external loc (x : string) : Parsetree.expression = str_exp with pexp_desc = Ast_external_mk.local_external_apply loc ~pval_prim:["#raw_expr"] - ~pval_type: - (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) (Typ.any ())) + ~pval_type:(Typ.arrow ~arity:(Some 1) Nolbl (Typ.any ()) (Typ.any ())) [str_exp]; } in @@ -70,8 +69,7 @@ let handle_debugger loc (payload : Ast_payload.t) = | PStr [] -> Ast_external_mk.local_external_apply loc ~pval_prim:["%debugger"] ~pval_type: - (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) - (Ast_literal.type_unit ())) + (Typ.arrow ~arity:(Some 1) Nolbl (Typ.any ()) (Ast_literal.type_unit ())) [Ast_literal.val_unit ~loc ()] | _ -> Location.raise_errorf ~loc "%%debugger extension doesn't accept arguments" @@ -95,8 +93,7 @@ let handle_raw ~kind loc payload = exp with pexp_desc = Ast_external_mk.local_external_apply loc ~pval_prim:["#raw_expr"] - ~pval_type: - (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) (Typ.any ())) + ~pval_type:(Typ.arrow ~arity:(Some 1) Nolbl (Typ.any ()) (Typ.any ())) [exp]; pexp_attributes = (match !is_function with @@ -123,11 +120,11 @@ let handle_ffi ~loc ~payload = let any = Ast_helper.Typ.any ~loc:e.pexp_loc () in let unit = Ast_literal.type_unit ~loc () in let rec arrow ~arity = - if arity = 0 then Ast_helper.Typ.arrow ~arity:None ~loc Nolabel unit any + if arity = 0 then Ast_helper.Typ.arrow ~arity:None ~loc Nolbl unit any else if arity = 1 then - Ast_helper.Typ.arrow ~arity:None ~loc Nolabel any any + Ast_helper.Typ.arrow ~arity:None ~loc Nolbl any any else - Ast_helper.Typ.arrow ~loc ~arity:None Nolabel any + Ast_helper.Typ.arrow ~loc ~arity:None Nolbl any (arrow ~arity:(arity - 1)) in match !is_function with @@ -146,7 +143,7 @@ let handle_ffi ~loc ~payload = pexp_desc = Ast_external_mk.local_external_apply loc ~pval_prim:["#raw_expr"] ~pval_type: - (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) (Typ.any ())) + (Typ.arrow ~arity:(Some 1) Nolbl (Typ.any ()) (Typ.any ())) [exp]; pexp_attributes = (match !is_function with @@ -163,7 +160,7 @@ let handle_raw_structure loc payload = pexp_desc = Ast_external_mk.local_external_apply loc ~pval_prim:["#raw_stmt"] ~pval_type: - (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) (Typ.any ())) + (Typ.arrow ~arity:(Some 1) Nolbl (Typ.any ()) (Typ.any ())) [exp]; } | None -> diff --git a/compiler/frontend/ast_external_process.ml b/compiler/frontend/ast_external_process.ml index 3e73b4fd2c..b727ea5024 100644 --- a/compiler/frontend/ast_external_process.ml +++ b/compiler/frontend/ast_external_process.ml @@ -462,7 +462,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) let ty = param_type.ty in let new_arg_label, new_arg_types, output_tys = match arg_label with - | Nolabel -> ( + | Nolbl -> ( match ty.ptyp_desc with | Ptyp_constr ({txt = Lident "unit"}, []) -> ( External_arg_spec.empty_kind Extern_unit, @@ -471,7 +471,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) | _ -> Location.raise_errorf ~loc "expect label, optional, or unit here") - | Labelled label -> ( + | Lbl {txt = label} -> ( let field_name = match Ast_attributes.iter_process_bs_string_as param_type.attr @@ -530,7 +530,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) | Unwrap -> Location.raise_errorf ~loc "%@obj label %s does not support %@unwrap arguments" label) - | Optional label -> ( + | Opt {txt = label} -> ( let field_name = match Ast_attributes.iter_process_bs_string_as param_type.attr @@ -964,10 +964,10 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type) let ty = param_type.ty in (if i = 0 && splice then match arg_label with - | Optional _ -> + | Opt _ -> Location.raise_errorf ~loc "%@variadic expect the last type to be a non optional" - | Labelled _ | Nolabel -> ( + | Lbl _ | Nolbl -> ( if ty.ptyp_desc = Ptyp_any then Location.raise_errorf ~loc "%@variadic expect the last type to be an array"; @@ -983,7 +983,7 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type) arg_type, new_arg_types ) = match arg_label with - | Optional s -> ( + | Opt {txt = s} -> ( let arg_type = get_opt_arg_type ~nolabel:false ty in match arg_type with | Poly_var _ -> @@ -993,14 +993,14 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type) label %s" s | _ -> (Arg_optional, arg_type, param_type :: arg_types)) - | Labelled _ -> ( + | Lbl _ -> ( let arg_type = refine_arg_type ~nolabel:false ty in ( Arg_label, arg_type, match arg_type with | Arg_cst _ -> arg_types | _ -> param_type :: arg_types )) - | Nolabel -> ( + | Nolbl -> ( let arg_type = refine_arg_type ~nolabel:true ty in ( Arg_empty, arg_type, diff --git a/compiler/frontend/ast_pat.mli b/compiler/frontend/ast_pat.mli index 3689c09fc5..ccafa5aa22 100644 --- a/compiler/frontend/ast_pat.mli +++ b/compiler/frontend/ast_pat.mli @@ -30,6 +30,6 @@ val arity_of_fun : t -> Parsetree.expression -> int (** [arity_of_fun pat e] tells the arity of expression [fun pat -> e]*) -val labels_of_fun : Parsetree.expression -> Asttypes.arg_label list +val labels_of_fun : Parsetree.expression -> Asttypes.arg_label_loc list val is_single_variable_pattern_conservative : t -> string option diff --git a/compiler/frontend/ast_typ_uncurry.ml b/compiler/frontend/ast_typ_uncurry.ml index 0b8656e33c..0b0e28cf73 100644 --- a/compiler/frontend/ast_typ_uncurry.ml +++ b/compiler/frontend/ast_typ_uncurry.ml @@ -24,12 +24,12 @@ type typ = Parsetree.core_type type 'a cxt = Ast_helper.loc -> Bs_ast_mapper.mapper -> 'a -type uncurry_type_gen = (Asttypes.arg_label -> typ -> typ -> typ) cxt +type uncurry_type_gen = (Asttypes.arg_label_loc -> typ -> typ -> typ) cxt module Typ = Ast_helper.Typ let to_method_callback_type loc (mapper : Bs_ast_mapper.mapper) - (label : Asttypes.arg_label) (first_arg : Parsetree.core_type) + (label : Asttypes.arg_label_loc) (first_arg : Parsetree.core_type) (typ : Parsetree.core_type) = let first_arg = mapper.typ mapper first_arg in let typ = mapper.typ mapper typ in @@ -46,7 +46,7 @@ let to_method_callback_type loc (mapper : Bs_ast_mapper.mapper) | None -> assert false let to_uncurry_type loc (mapper : Bs_ast_mapper.mapper) - (label : Asttypes.arg_label) (first_arg : Parsetree.core_type) + (label : Asttypes.arg_label_loc) (first_arg : Parsetree.core_type) (typ : Parsetree.core_type) = (* no need to error for optional here, since we can not make it diff --git a/compiler/frontend/ast_typ_uncurry.mli b/compiler/frontend/ast_typ_uncurry.mli index ebd95e1bbd..b3492878ec 100644 --- a/compiler/frontend/ast_typ_uncurry.mli +++ b/compiler/frontend/ast_typ_uncurry.mli @@ -40,7 +40,7 @@ type typ = Parsetree.core_type type 'a cxt = Ast_helper.loc -> Bs_ast_mapper.mapper -> 'a type uncurry_type_gen = - (Asttypes.arg_label -> + (Asttypes.arg_label_loc -> (* label for error checking *) typ -> (* First arg *) diff --git a/compiler/frontend/ast_uncurry_gen.ml b/compiler/frontend/ast_uncurry_gen.ml index 70e4e2d550..9da0be6f49 100644 --- a/compiler/frontend/ast_uncurry_gen.ml +++ b/compiler/frontend/ast_uncurry_gen.ml @@ -57,7 +57,7 @@ let to_method_callback loc (self : Bs_ast_mapper.mapper) label {loc; txt = Ldot (Ast_literal.Lid.js_oo, "unsafe_to_method")}; args = [ - ( Nolabel, + ( Nolbl, Exp.constraint_ ~loc (Exp.record ~loc [ diff --git a/compiler/frontend/ast_uncurry_gen.mli b/compiler/frontend/ast_uncurry_gen.mli index c34c980a8d..4a4da49ff7 100644 --- a/compiler/frontend/ast_uncurry_gen.mli +++ b/compiler/frontend/ast_uncurry_gen.mli @@ -25,7 +25,7 @@ val to_method_callback : Location.t -> Bs_ast_mapper.mapper -> - Asttypes.arg_label -> + Asttypes.arg_label_loc -> Parsetree.pattern -> Parsetree.expression -> Parsetree.expression_desc diff --git a/compiler/frontend/bs_ast_mapper.ml b/compiler/frontend/bs_ast_mapper.ml index f08b78b55f..cf45c0ba43 100644 --- a/compiler/frontend/bs_ast_mapper.ml +++ b/compiler/frontend/bs_ast_mapper.ml @@ -101,9 +101,8 @@ module T = struct match desc with | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s - | Ptyp_arrow {lbl; lbl_loc; arg; ret; arity} -> - arrow ~loc ~attrs ~label_loc:lbl_loc ~arity lbl (sub.typ sub arg) - (sub.typ sub ret) + | Ptyp_arrow {lbl; arg; ret; arity} -> + arrow ~loc ~attrs ~arity lbl (sub.typ sub arg) (sub.typ sub ret) | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) @@ -312,17 +311,9 @@ module E = struct sub vbs) (sub.expr sub e) (* #end *) - | Pexp_fun - { - arg_label = lab; - label_loc; - default = def; - lhs = p; - rhs = e; - arity; - async; - } -> - fun_ ~loc ~attrs ~label_loc ~arity ~async lab + | Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity; async} + -> + fun_ ~loc ~attrs ~arity ~async lab (map_opt (sub.expr sub) def) (sub.pat sub p) (sub.expr sub e) | Pexp_apply {funct = e; args = l; partial} -> diff --git a/compiler/frontend/bs_syntaxerr.ml b/compiler/frontend/bs_syntaxerr.ml index 39a787ede7..7919064aa5 100644 --- a/compiler/frontend/bs_syntaxerr.ml +++ b/compiler/frontend/bs_syntaxerr.ml @@ -104,10 +104,10 @@ let () = let err loc error = raise (Error (loc, error)) -let optional_err loc (lbl : Asttypes.arg_label) = +let optional_err loc (lbl : Asttypes.arg_label_loc) = match lbl with - | Optional _ -> raise (Error (loc, Optional_in_uncurried_bs_attribute)) + | Opt _ -> raise (Error (loc, Optional_in_uncurried_bs_attribute)) | _ -> () -let err_if_label loc (lbl : Asttypes.arg_label) = - if lbl <> Nolabel then raise (Error (loc, Misplaced_label_syntax)) +let err_if_label loc (lbl : Asttypes.arg_label_loc) = + if lbl <> Nolbl then raise (Error (loc, Misplaced_label_syntax)) diff --git a/compiler/frontend/bs_syntaxerr.mli b/compiler/frontend/bs_syntaxerr.mli index 238c9b91f4..c24b48ef76 100644 --- a/compiler/frontend/bs_syntaxerr.mli +++ b/compiler/frontend/bs_syntaxerr.mli @@ -54,6 +54,6 @@ type error = val err : Location.t -> error -> 'a -val optional_err : Location.t -> Asttypes.arg_label -> unit +val optional_err : Location.t -> Asttypes.arg_label_loc -> unit -val err_if_label : Location.t -> Asttypes.arg_label -> unit +val err_if_label : Location.t -> Asttypes.arg_label_loc -> unit diff --git a/compiler/ml/ast_async.ml b/compiler/ml/ast_async.ml index d5494ebfba..997c0a85ed 100644 --- a/compiler/ml/ast_async.ml +++ b/compiler/ml/ast_async.ml @@ -11,7 +11,7 @@ let add_promise_type ?(loc = Location.none) ~async Ast_helper.Exp.ident ~loc {txt = Ldot (Lident Primitive_modules.promise, "unsafe_async"); loc} in - Ast_helper.Exp.apply ~loc unsafe_async [(Nolabel, result)] + Ast_helper.Exp.apply ~loc unsafe_async [(Nolbl, result)] else result let rec add_promise_to_result ~loc (e : Parsetree.expression) = diff --git a/compiler/ml/ast_await.ml b/compiler/ml/ast_await.ml index 9fd1b9081b..f5758f00dd 100644 --- a/compiler/ml/ast_await.ml +++ b/compiler/ml/ast_await.ml @@ -7,7 +7,7 @@ let create_await_expression (e : Parsetree.expression) = Ast_helper.Exp.ident ~loc {txt = Ldot (Lident Primitive_modules.promise, "unsafe_await"); loc} in - Ast_helper.Exp.apply ~loc unsafe_await [(Nolabel, e)] + Ast_helper.Exp.apply ~loc unsafe_await [(Nolbl, e)] (* Transform `@res.await M` to unpack(@res.await Js.import(module(M: __M0__))) *) let create_await_module_expression ~module_type_lid (e : Parsetree.module_expr) @@ -29,7 +29,7 @@ let create_await_module_expression ~module_type_lid (e : Parsetree.module_expr) loc = e.pmod_loc; }) [ - ( Nolabel, + ( Nolbl, Exp.constraint_ ~loc:e.pmod_loc (Exp.pack ~loc:e.pmod_loc { diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index 6c2f82190f..aa0c66dbfc 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -54,8 +54,8 @@ module Typ = struct let any ?loc ?attrs () = mk ?loc ?attrs Ptyp_any let var ?loc ?attrs a = mk ?loc ?attrs (Ptyp_var a) - let arrow ?loc ?attrs ?(label_loc = Location.none) ~arity lbl arg ret = - mk ?loc ?attrs (Ptyp_arrow {lbl; lbl_loc = label_loc; arg; ret; arity}) + let arrow ?loc ?attrs ~arity lbl arg ret = + mk ?loc ?attrs (Ptyp_arrow {lbl; arg; ret; arity}) let tuple ?loc ?attrs a = mk ?loc ?attrs (Ptyp_tuple a) let constr ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_constr (a, b)) let object_ ?loc ?attrs a b = mk ?loc ?attrs (Ptyp_object (a, b)) @@ -151,11 +151,9 @@ module Exp = struct let ident ?loc ?attrs a = mk ?loc ?attrs (Pexp_ident a) let constant ?loc ?attrs a = mk ?loc ?attrs (Pexp_constant a) let let_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_let (a, b, c)) - let fun_ ?loc ?attrs ?(async = false) ?(label_loc = Location.none) ~arity a b - c d = + let fun_ ?loc ?attrs ?(async = false) ~arity a b c d = mk ?loc ?attrs - (Pexp_fun - {arg_label = a; label_loc; default = b; lhs = c; rhs = d; arity; async}) + (Pexp_fun {arg_label = a; default = b; lhs = c; rhs = d; arity; async}) let apply ?loc ?attrs ?(partial = false) funct args = mk ?loc ?attrs (Pexp_apply {funct; args; partial}) let match_ ?loc ?attrs a b = mk ?loc ?attrs (Pexp_match (a, b)) diff --git a/compiler/ml/ast_helper.mli b/compiler/ml/ast_helper.mli index 226c9eb145..1b91cc2377 100644 --- a/compiler/ml/ast_helper.mli +++ b/compiler/ml/ast_helper.mli @@ -57,9 +57,8 @@ module Typ : sig val arrow : ?loc:loc -> ?attrs:attrs -> - ?label_loc:loc -> arity:arity -> - arg_label -> + arg_label_loc -> core_type -> core_type -> core_type @@ -140,9 +139,8 @@ module Exp : sig ?loc:loc -> ?attrs:attrs -> ?async:bool -> - ?label_loc:loc -> arity:int option -> - arg_label -> + arg_label_loc -> expression option -> pattern -> expression -> @@ -152,7 +150,7 @@ module Exp : sig ?attrs:attrs -> ?partial:bool -> expression -> - (arg_label * expression) list -> + (arg_label_loc * expression) list -> expression val match_ : ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression val try_ : ?loc:loc -> ?attrs:attrs -> expression -> case list -> expression diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index cc0e32bebe..66b06f655e 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -93,9 +93,8 @@ module T = struct match desc with | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s - | Ptyp_arrow {lbl; lbl_loc; arg; ret; arity} -> - arrow ~loc ~attrs ~label_loc:lbl_loc ~arity lbl (sub.typ sub arg) - (sub.typ sub ret) + | Ptyp_arrow {lbl; arg; ret; arity} -> + arrow ~loc ~attrs ~arity lbl (sub.typ sub arg) (sub.typ sub ret) | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> constr ~loc ~attrs (map_loc sub lid) (List.map (sub.typ sub) tl) @@ -275,17 +274,9 @@ module E = struct | Pexp_constant x -> constant ~loc ~attrs x | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) - | Pexp_fun - { - arg_label = lab; - label_loc; - default = def; - lhs = p; - rhs = e; - arity; - async; - } -> - fun_ ~loc ~attrs ~label_loc ~arity ~async lab + | Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity; async} + -> + fun_ ~loc ~attrs ~arity ~async lab (map_opt (sub.expr sub) def) (sub.pat sub p) (sub.expr sub e) | Pexp_apply {funct = e; args = l; partial} -> diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index f36bea1f0d..1b4281208c 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -99,6 +99,7 @@ module T = struct | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s | Ptyp_arrow (lab, t1, t2) -> + let lab = Asttypes.to_arg_label_loc lab in arrow ~loc ~attrs ~arity:None lab (sub.typ sub t1) (sub.typ sub t2) | Ptyp_tuple tyl -> tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> ( @@ -304,6 +305,7 @@ module E = struct | Pexp_let (r, vbs, e) -> let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) | Pexp_fun (lab, def, p, e) -> + let lab = Asttypes.to_arg_label_loc lab in let async = Ext_list.exists attrs (fun ({txt}, _) -> txt = "res.async") in fun_ ~loc ~attrs ~async ~arity:None lab (map_opt (sub.expr sub) def) @@ -349,7 +351,9 @@ module E = struct in let partial, attrs = process_partial_app_attribute attrs in apply ~loc ~attrs ~partial (sub.expr sub e) - (List.map (map_snd (sub.expr sub)) l) + (List.map + (fun (lbl, e) -> (Asttypes.to_arg_label_loc lbl, sub.expr sub e)) + l) | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 99a84e776e..1a20a6ac2c 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -99,6 +99,7 @@ module T = struct | Ptyp_any -> any ~loc ~attrs () | Ptyp_var s -> var ~loc ~attrs s | Ptyp_arrow {lbl; arg; ret; arity} -> ( + let lbl = Asttypes.to_arg_label lbl in let typ0 = arrow ~loc ~attrs lbl (sub.typ sub arg) (sub.typ sub ret) in match arity with | None -> typ0 @@ -293,6 +294,7 @@ module E = struct let_ ~loc ~attrs r (List.map (sub.value_binding sub) vbs) (sub.expr sub e) | Pexp_fun {arg_label = lab; default = def; lhs = p; rhs = e; arity; async} -> ( + let lab = Asttypes.to_arg_label lab in let attrs = if async then ({txt = "res.async"; loc = Location.none}, Pt.PStr []) :: attrs @@ -325,22 +327,22 @@ module E = struct let e = match (e.pexp_desc, args) with | ( Pexp_ident ({txt = Longident.Lident "->"} as lid), - [(Nolabel, _); (Nolabel, _)] ) -> + [(Nolbl, _); (Nolbl, _)] ) -> {e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "|."}} | ( Pexp_ident ({txt = Longident.Lident "++"} as lid), - [(Nolabel, _); (Nolabel, _)] ) -> + [(Nolbl, _); (Nolbl, _)] ) -> {e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "^"}} | ( Pexp_ident ({txt = Longident.Lident "!="} as lid), - [(Nolabel, _); (Nolabel, _)] ) -> + [(Nolbl, _); (Nolbl, _)] ) -> {e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "<>"}} | ( Pexp_ident ({txt = Longident.Lident "!=="} as lid), - [(Nolabel, _); (Nolabel, _)] ) -> + [(Nolbl, _); (Nolbl, _)] ) -> {e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "!="}} | ( Pexp_ident ({txt = Longident.Lident "==="} as lid), - [(Nolabel, _); (Nolabel, _)] ) -> + [(Nolbl, _); (Nolbl, _)] ) -> {e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "=="}} | ( Pexp_ident ({txt = Longident.Lident "=="} as lid), - [(Nolabel, _); (Nolabel, _)] ) -> + [(Nolbl, _); (Nolbl, _)] ) -> {e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "="}} | _ -> e in @@ -349,7 +351,9 @@ module E = struct else [] in apply ~loc ~attrs (sub.expr sub e) - (List.map (map_snd (sub.expr sub)) args) + (List.map + (fun (lbl, e) -> (Asttypes.to_arg_label lbl, sub.expr sub e)) + args) | Pexp_match (e, pel) -> match_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) | Pexp_try (e, pel) -> try_ ~loc ~attrs (sub.expr sub e) (sub.cases sub pel) diff --git a/compiler/ml/asttypes.ml b/compiler/ml/asttypes.ml index cd5379cb8e..b70f4d8254 100644 --- a/compiler/ml/asttypes.ml +++ b/compiler/ml/asttypes.ml @@ -63,3 +63,35 @@ let same_arg_label (x : arg_label) y = match y with | Optional s0 -> s = s0 | _ -> false) + +type arg_label_loc = + | Nolbl + | Lbl of string loc (* label:T -> ... *) + | Opt of string loc (* ?label:T -> ... *) + +let to_arg_label_loc ?(loc = Location.none) lbl = + match lbl with + | Nolabel -> Nolbl + | Labelled s -> Lbl {loc; txt = s} + | Optional s -> Opt {loc; txt = s} + +let to_arg_label = function + | Nolbl -> Nolabel + | Lbl {txt} -> Labelled txt + | Opt {txt} -> Optional txt + +let same_arg_label_loc (x : arg_label_loc) y = + match x with + | Nolbl -> y = Nolbl + | Lbl {txt = s} -> ( + match y with + | Lbl {txt = s0} -> s = s0 + | _ -> false) + | Opt {txt = s} -> ( + match y with + | Opt {txt = s0} -> s = s0 + | _ -> false) + +let get_lbl_loc = function + | Nolbl -> Location.none + | Lbl {loc} | Opt {loc} -> loc diff --git a/compiler/ml/btype.ml b/compiler/ml/btype.ml index 81e8d24cd0..7dc575f764 100644 --- a/compiler/ml/btype.ml +++ b/compiler/ml/btype.ml @@ -596,31 +596,39 @@ let is_optional = function | Optional _ -> true | _ -> false +let is_optional_loc = function + | Opt _ -> true + | _ -> false + let label_name = function | Nolabel -> "" | Labelled s | Optional s -> s +let label_loc_name = function + | Nolbl -> "" + | Lbl {txt} | Opt {txt} -> txt + let prefixed_label_name = function | Nolabel -> "" | Labelled s -> "~" ^ s | Optional s -> "?" ^ s -type sargs = (Asttypes.arg_label * Parsetree.expression) list +type sargs = (Asttypes.arg_label_loc * Parsetree.expression) list let rec extract_label_aux hd l = function | [] -> None | ((l', t) as p) :: ls -> - if label_name l' = l then Some (l', t, List.rev_append hd ls) + if label_loc_name l' = l then Some (l', t, List.rev_append hd ls) else extract_label_aux (p :: hd) l ls let extract_label l (ls : sargs) : - (arg_label * Parsetree.expression * sargs) option = + (arg_label_loc * Parsetree.expression * sargs) option = extract_label_aux [] l ls let rec label_assoc x (args : sargs) = match args with | [] -> false - | (a, _) :: l -> Asttypes.same_arg_label a x || label_assoc x l + | (a, _) :: l -> Asttypes.same_arg_label_loc a x || label_assoc x l (**********************************) (* Utilities for backtracking *) diff --git a/compiler/ml/btype.mli b/compiler/ml/btype.mli index ef099af22b..6a647c2ef1 100644 --- a/compiler/ml/btype.mli +++ b/compiler/ml/btype.mli @@ -181,18 +181,20 @@ val forget_abbrev : abbrev_memo ref -> Path.t -> unit (**** Utilities for labels ****) val is_optional : arg_label -> bool +val is_optional_loc : arg_label_loc -> bool val label_name : arg_label -> label +val label_loc_name : arg_label_loc -> label (* Returns the label name with first character '?' or '~' as appropriate. *) val prefixed_label_name : arg_label -> label -type sargs = (arg_label * Parsetree.expression) list +type sargs = (arg_label_loc * Parsetree.expression) list val extract_label : - label -> sargs -> (arg_label * Parsetree.expression * sargs) option + label -> sargs -> (arg_label_loc * Parsetree.expression * sargs) option (* actual label, value, new list with the same order *) -val label_assoc : arg_label -> sargs -> bool +val label_assoc : arg_label_loc -> sargs -> bool (**** Utilities for backtracking ****) type snapshot diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index be253d016a..36264f1af7 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -77,8 +77,7 @@ and core_type_desc = | Ptyp_any (* _ *) | Ptyp_var of string (* 'a *) | Ptyp_arrow of { - lbl: arg_label; - lbl_loc: Location.t; + lbl: arg_label_loc; arg: core_type; ret: core_type; arity: arity; @@ -231,8 +230,7 @@ and expression_desc = let rec P1 = E1 and ... and Pn = EN in E (flag = Recursive) *) | Pexp_fun of { - arg_label: arg_label; - label_loc: Location.t; + arg_label: arg_label_loc; default: expression option; lhs: pattern; rhs: expression; @@ -251,7 +249,7 @@ and expression_desc = *) | Pexp_apply of { funct: expression; - args: (arg_label * expression) list; + args: (arg_label_loc * expression) list; partial: bool; } (* E0 ~l1:E1 ... ~ln:En diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index ca6ae8d64e..35966c13ae 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -287,9 +287,9 @@ let string_quot f x = pp f "`%s" x let rec type_with_label ctxt f (label, c) = match label with - | Nolabel -> core_type1 ctxt f c (* otherwise parenthesize *) - | Labelled s -> pp f "%s:%a" s (core_type1 ctxt) c - | Optional s -> pp f "?%s:%a" s (core_type1 ctxt) c + | Nolbl -> core_type1 ctxt f c (* otherwise parenthesize *) + | Lbl {txt = s} -> pp f "%s:%a" s (core_type1 ctxt) c + | Opt {txt = s} -> pp f "?%s:%a" s (core_type1 ctxt) c and core_type ctxt f x = if x.ptyp_attributes <> [] then @@ -494,10 +494,10 @@ and simple_pattern ctxt (f : Format.formatter) (x : pattern) : unit = and label_exp ctxt f (l, opt, p) = match l with - | Nolabel -> + | Nolbl -> (* single case pattern parens needed here *) pp f "%a@ " (simple_pattern ctxt) p - | Optional rest -> ( + | Opt {txt = rest} -> ( match p with | {ppat_desc = Ppat_var {txt; _}; ppat_attributes = []} when txt = rest -> ( match opt with @@ -508,7 +508,7 @@ and label_exp ctxt f (l, opt, p) = | Some o -> pp f "?%s:(%a=@;%a)@;" rest (pattern1 ctxt) p (expression ctxt) o | None -> pp f "?%s:%a@;" rest (simple_pattern ctxt) p)) - | Labelled l -> ( + | Lbl {txt = l} -> ( match p with | {ppat_desc = Ppat_var {txt; _}; ppat_attributes = []} when txt = l -> pp f "~%s@;" l @@ -523,7 +523,7 @@ and sugar_expr ctxt f e = funct = {pexp_desc = Pexp_ident {txt = id; _}; pexp_attributes = []; _}; args; } - when List.for_all (fun (lab, _) -> lab = Nolabel) args -> ( + when List.for_all (fun (lab, _) -> lab = Nolbl) args -> ( let print_indexop a path_prefix assign left right print_index indices rem_args = let print_path ppf = function @@ -636,7 +636,7 @@ and expression ctxt f x = match view_fixity_of_exp e with | `Infix s -> ( match l with - | [((Nolabel, _) as arg1); ((Nolabel, _) as arg2)] -> + | [((Nolbl, _) as arg1); ((Nolbl, _) as arg2)] -> (* FIXME associativity label_x_expression_param *) pp f "@[<2>%a@;%s@;%a@]" (label_x_expression_param reset_ctxt) @@ -661,7 +661,7 @@ and expression ctxt f x = else s in match l with - | [(Nolabel, x)] -> pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x + | [(Nolbl, x)] -> pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x | _ -> pp f "@[<2>%a %a@]" (simple_expr ctxt) e (list (label_x_expression_param ctxt)) @@ -988,7 +988,7 @@ and binding ctxt f {pvb_pat = p; pvb_expr = x; _} = | Some arity -> "[arity:" ^ string_of_int arity ^ "]" in let async_str = if async then "async " else "" in - if label = Nolabel then + if label = Nolbl then pp f "%s%s%a@ %a" async_str arity_str (simple_pattern ctxt) p pp_print_pexp_function e else @@ -1281,11 +1281,11 @@ and label_x_expression_param ctxt f (l, e) = | _ -> None in match l with - | Nolabel -> expression2 ctxt f e (* level 2*) - | Optional str -> + | Nolbl -> expression2 ctxt f e (* level 2*) + | Opt {txt = str} -> if Some str = simple_name then pp f "?%s" str else pp f "?%s:%a" str (simple_expr ctxt) e - | Labelled lbl -> + | Lbl {txt = lbl} -> if Some lbl = simple_name then pp f "~%s" lbl else pp f "~%s:%a" lbl (simple_expr ctxt) e diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index 56d0037d22..fd53085be7 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -110,10 +110,11 @@ let option i f ppf x = let longident_loc i ppf li = line i ppf "%a\n" fmt_longident_loc li let string i ppf s = line i ppf "\"%s\"\n" s let string_loc i ppf s = line i ppf "%a\n" fmt_string_loc s -let arg_label i ppf = function - | Nolabel -> line i ppf "Nolabel\n" - | Optional s -> line i ppf "Optional \"%s\"\n" s - | Labelled s -> line i ppf "Labelled \"%s\"\n" s + +let arg_label_loc i ppf = function + | Nolbl -> line i ppf "Nolabel\n" + | Opt {txt = s} -> line i ppf "Optional \"%s\"\n" s + | Lbl {txt = s} -> line i ppf "Labelled \"%s\"\n" s let rec core_type i ppf x = line i ppf "core_type %a\n" fmt_location x.ptyp_loc; @@ -129,7 +130,7 @@ let rec core_type i ppf x = | None -> () | Some n -> line i ppf "arity = %d\n" n in - arg_label i ppf lbl; + arg_label_loc i ppf lbl; core_type i ppf arg; core_type i ppf ret | Ptyp_tuple l -> @@ -246,7 +247,7 @@ and expression i ppf x = | None -> () | Some arity -> line i ppf "arity:%d\n" arity in - arg_label i ppf l; + arg_label_loc i ppf l; option i expression ppf eo; pattern i ppf p; expression i ppf e @@ -657,7 +658,7 @@ and longident_x_expression i ppf (li, e, opt) = and label_x_expression i ppf (l, e) = line i ppf "\n"; - arg_label i ppf l; + arg_label_loc i ppf l; expression (i + 1) ppf e and label_x_bool_x_core_type_list i ppf x = diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index a0e4e42200..0c6c0ac97a 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -1879,6 +1879,7 @@ and is_nonexpansive_opt = function let rec approx_type env sty = match sty.ptyp_desc with | Ptyp_arrow {lbl = p; ret = sty; arity} -> + let p = Asttypes.to_arg_label p in let ty1 = if is_optional p then type_option (newvar ()) else newvar () in newty (Tarrow (p, ty1, approx_type env sty, Cok, arity)) | Ptyp_tuple args -> newty (Ttuple (List.map (approx_type env) args)) @@ -1897,6 +1898,7 @@ let rec type_approx env sexp = match sexp.pexp_desc with | Pexp_let (_, _, e) -> type_approx env e | Pexp_fun {arg_label = p; rhs = e; arity} -> + let p = Asttypes.to_arg_label p in let ty = if is_optional p then type_option (newvar ()) else newvar () in newty (Tarrow (p, ty, type_approx env e, Cok, arity)) | Pexp_match (_, {pc_rhs = e} :: _) -> type_approx env e @@ -2362,6 +2364,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp arity; async; } -> + let l = Asttypes.to_arg_label l in assert (is_optional l); (* default allowed only with optional argument *) let open Ast_helper in @@ -2404,6 +2407,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg = Rejected) env sexp [Exp.case pat body] | Pexp_fun {arg_label = l; default = None; lhs = spat; rhs = sbody; arity; async} -> + let l = Asttypes.to_arg_label l in type_function ?in_function ~arity ~async loc sexp.pexp_attributes env ty_expected l [Ast_helper.Exp.case spat sbody] @@ -3391,7 +3395,7 @@ and translate_unified_ops (env : Env.t) (funct : Typedtree.expression) unify env lhs_type Predef.type_int; Predef.type_int in - let targs = [(lhs_label, Some lhs)] in + let targs = [(to_arg_label lhs_label, Some lhs)] in Some (targs, result_type) | ( Some {form = Binary; specialization}, [(lhs_label, lhs_expr); (rhs_label, rhs_expr)] ) -> @@ -3449,7 +3453,9 @@ and translate_unified_ops (env : Env.t) (funct : Typedtree.expression) let rhs = type_expect env rhs_expr Predef.type_int in (lhs, rhs, Predef.type_int)) in - let targs = [(lhs_label, Some lhs); (rhs_label, Some rhs)] in + let targs = + [(to_arg_label lhs_label, Some lhs); (to_arg_label rhs_label, Some rhs)] + in Some (targs, result_type) | _ -> None) | _ -> None @@ -3549,12 +3555,13 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) : omitted t2 [] | _ -> collect_args () else collect_args () - | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] + | [(Nolbl, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] when total_app && omitted = [] && args <> [] && List.length args = List.length !ignored -> (* foo(. ) treated as empty application if all args are optional (hence ignored) *) type_unknown_args max_arity ~args ~top_arity:None omitted ty_fun [] | (l1, sarg1) :: sargl -> + let l1 = to_arg_label l1 in let ty1, ty2 = let ty_fun = expand_head env ty_fun in let arity_ok = List.length args < max_arity in @@ -3613,20 +3620,20 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) : let sargs, omitted, arg = match extract_label name sargs with | None -> - if optional && (total_app || label_assoc Nolabel sargs) then ( + if optional && (total_app || label_assoc Nolbl sargs) then ( ignored := (l, ty, lv) :: !ignored; ( sargs, omitted, Some (fun () -> option_none (instance env ty) Location.none) )) else (sargs, (l, ty, lv) :: omitted, None) | Some (l', sarg0, sargs) -> - if (not optional) && is_optional l' then + if (not optional) && is_optional_loc l' then Location.prerr_warning sarg0.pexp_loc (Warnings.Nonoptional_label (Printtyp.string_of_label l)); ( sargs, omitted, Some - (if (not optional) || is_optional l' then fun () -> + (if (not optional) || is_optional_loc l' then fun () -> type_argument ?type_clash_context: (type_clash_context_for_function_argument @@ -3649,7 +3656,7 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) : let top_arity = if total_app then Some max_arity else None in match sargs with (* Special case for ignore: avoid discarding warning *) - | [(Nolabel, sarg)] when is_ignore ~env ~arity:top_arity funct -> + | [(Nolbl, sarg)] when is_ignore ~env ~arity:top_arity funct -> let ty_arg, ty_res = filter_arrow ~env ~arity:top_arity (instance env funct.exp_type) Nolabel in diff --git a/compiler/ml/typetexp.ml b/compiler/ml/typetexp.ml index 16117f64bc..c29ffacd5e 100644 --- a/compiler/ml/typetexp.ml +++ b/compiler/ml/typetexp.ml @@ -328,6 +328,7 @@ and transl_type_aux env policy styp = in ctyp (Ttyp_var name) ty | Ptyp_arrow {lbl; arg = st1; ret = st2; arity} -> + let lbl = Asttypes.to_arg_label lbl in let cty1 = transl_type env policy st1 in let cty2 = transl_type env policy st2 in let ty1 = cty1.ctyp_type in diff --git a/compiler/syntax/src/jsx_common.ml b/compiler/syntax/src/jsx_common.ml index 20f0c61413..d22d027a2f 100644 --- a/compiler/syntax/src/jsx_common.ml +++ b/compiler/syntax/src/jsx_common.ml @@ -59,5 +59,5 @@ let async_component ~async expr = loc = Location.none; txt = Ldot (Lident "JsxPPXReactSupport", "asyncComponent"); }) - [(Nolabel, expr)] + [(Nolbl, expr)] else expr diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml index d2a2307508..40c9ff7e32 100644 --- a/compiler/syntax/src/jsx_v4.ml +++ b/compiler/syntax/src/jsx_v4.ml @@ -8,18 +8,18 @@ let module_access_name config value = String.capitalize_ascii config.Jsx_common.module_ ^ "." ^ value |> Longident.parse -let nolabel = Nolabel +let nolabel = Nolbl -let labelled str = Labelled str +let labelled str = Lbl {txt = str; loc = Location.none} let is_optional str = match str with - | Optional _ -> true + | Opt _ -> true | _ -> false let is_labelled str = match str with - | Labelled _ -> true + | Lbl _ -> true | _ -> false let is_forward_ref = function @@ -28,8 +28,8 @@ let is_forward_ref = function let get_label str = match str with - | Optional str | Labelled str -> str - | Nolabel -> "" + | Opt {txt = str} | Lbl {txt = str} -> str + | Nolbl -> "" let constant_string ~loc str = Ast_helper.Exp.constant ~loc (Pconst_string (str, None)) @@ -95,9 +95,8 @@ let extract_children ?(remove_last_position_unit = false) ~loc let rec allButLast_ lst acc = match lst with | [] -> [] - | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] -> - acc - | (Nolabel, {pexp_loc}) :: _rest -> + | [(Nolbl, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] -> acc + | (Nolbl, {pexp_loc}) :: _rest -> Jsx_common.raise_error ~loc:pexp_loc "JSX: found non-labelled argument before the last position" | arg :: rest -> allButLast_ rest (arg :: acc) @@ -192,14 +191,13 @@ let record_from_props ~loc ~remove_key call_arguments = let rec remove_last_position_unit_aux props acc = match props with | [] -> acc - | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)}, _)] - -> + | [(Nolbl, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)}, _)] -> acc - | (Nolabel, {pexp_loc}, _) :: _rest -> + | (Nolbl, {pexp_loc}, _) :: _rest -> Jsx_common.raise_error ~loc:pexp_loc "JSX: found non-labelled argument before the last position" - | ((Labelled txt, {pexp_loc}, _) as prop) :: rest - | ((Optional txt, {pexp_loc}, _) as prop) :: rest -> + | ((Lbl {txt}, {pexp_loc}, _) as prop) :: rest + | ((Opt {txt}, {pexp_loc}, _) as prop) :: rest -> if txt = spread_props_label then match acc with | [] -> remove_last_position_unit_aux rest (prop :: acc) @@ -212,7 +210,10 @@ let record_from_props ~loc ~remove_key call_arguments = let props, props_to_spread = remove_last_position_unit_aux call_arguments [] |> List.rev - |> List.partition (fun (label, _, _) -> label <> labelled "_spreadProps") + |> List.partition (fun (label, _, _) -> + match label with + | Lbl {txt = "_spreadProps"} -> false + | _ -> true) in let props = if remove_key then @@ -253,7 +254,10 @@ let make_props_type_params_tvar named_type_list = named_type_list |> List.filter_map (fun (_isOptional, label, _, loc, _interiorType) -> if label = "key" then None - else Some (Typ.var ~loc @@ safe_type_from_value (Labelled label))) + else + Some + (Typ.var ~loc + @@ safe_type_from_value (Lbl {txt = label; loc = Location.none}))) let strip_option core_type = match core_type with @@ -322,10 +326,12 @@ let make_label_decls named_type_list = interior_type else if is_optional then Type.field ~loc ~attrs ~optional:true {txt = label; loc} - (Typ.var @@ safe_type_from_value @@ Labelled label) + (Typ.var @@ safe_type_from_value + @@ Lbl {txt = label; loc = Location.none}) else Type.field ~loc ~attrs {txt = label; loc} - (Typ.var @@ safe_type_from_value @@ Labelled label)) + (Typ.var @@ safe_type_from_value + @@ Lbl {txt = label; loc = Location.none})) let make_type_decls ~attrs props_name loc named_type_list = let label_decl_list = make_label_decls named_type_list in @@ -408,7 +414,7 @@ let transform_uppercase_call3 ~config module_path mapper jsx_expr_loc Exp.apply (Exp.ident {txt = module_access_name config "array"; loc = Location.none}) - [(Nolabel, expression)], + [(Nolbl, expression)], false ); ] | _ -> @@ -540,7 +546,7 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs txt = Ldot (element_binding, "someElement"); loc = Location.none; }) - [(Nolabel, children)], + [(Nolbl, children)], true ); ] | ListLiteral {pexp_desc = Pexp_array list} when list = [] -> [] @@ -552,7 +558,7 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs Exp.apply (Exp.ident {txt = module_access_name config "array"; loc = Location.none}) - [(Nolabel, expression)], + [(Nolbl, expression)], false ); ] in @@ -644,11 +650,11 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs let rec recursively_transform_named_args_for_make expr args newtypes core_type = match expr.pexp_desc with (* TODO: make this show up with a loc. *) - | Pexp_fun {arg_label = Labelled "key" | Optional "key"} -> + | Pexp_fun {arg_label = Lbl {txt = "key"} | Opt {txt = "key"}} -> Jsx_common.raise_error ~loc:expr.pexp_loc "Key cannot be accessed inside of a component. Don't worry - you can \ always key a component from its parent!" - | Pexp_fun {arg_label = Labelled "ref" | Optional "ref"} -> + | Pexp_fun {arg_label = Lbl {txt = "ref"} | Opt {txt = "ref"}} -> Jsx_common.raise_error ~loc:expr.pexp_loc "Ref cannot be passed as a normal prop. Please use `forwardRef` API \ instead." @@ -700,13 +706,13 @@ let rec recursively_transform_named_args_for_make expr args newtypes core_type = newtypes core_type | Pexp_fun { - arg_label = Nolabel; + arg_label = Nolbl; lhs = {ppat_desc = Ppat_construct ({txt = Lident "()"}, _) | Ppat_any}; } -> (args, newtypes, core_type) | Pexp_fun { - arg_label = Nolabel; + arg_label = Nolbl; lhs = { ppat_desc = @@ -720,11 +726,17 @@ let rec recursively_transform_named_args_for_make expr args newtypes core_type = | _ -> None in (* The ref arguement of forwardRef should be optional *) - ( (Optional "ref", None, pattern, txt, pattern.ppat_loc, type_) :: args, + ( ( Opt {txt = "ref"; loc = Location.none}, + None, + pattern, + txt, + pattern.ppat_loc, + type_ ) + :: args, newtypes, core_type ) else (args, newtypes, core_type) - | Pexp_fun {arg_label = Nolabel; lhs = pattern} -> + | Pexp_fun {arg_label = Nolbl; lhs = pattern} -> Location.raise_errorf ~loc:pattern.ppat_loc "React: react.component refs only support plain arguments and type \ annotations." @@ -738,8 +750,12 @@ let rec recursively_transform_named_args_for_make expr args newtypes core_type = let arg_to_type types ((name, default, {ppat_attributes = attrs}, _alias, loc, type_) : - arg_label * expression option * pattern * label * 'loc * core_type option) - = + arg_label_loc + * expression option + * pattern + * label + * 'loc + * core_type option) = match (type_, name, default) with | Some type_, name, _ when is_optional name -> (true, get_label name, attrs, loc, type_) :: types @@ -791,8 +807,7 @@ let modified_binding_old binding = (* here's where we spelunk! *) spelunk_for_fun_expression return_expression (* let make = React.forwardRef((~prop) => ...) *) - | {pexp_desc = Pexp_apply {args = [(Nolabel, inner_function_expression)]}} - -> + | {pexp_desc = Pexp_apply {args = [(Nolbl, inner_function_expression)]}} -> spelunk_for_fun_expression inner_function_expression | { pexp_desc = Pexp_sequence (_wrapperExpression, inner_function_expression); @@ -823,7 +838,7 @@ let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding = pexp_desc = Pexp_fun ({ - arg_label = Labelled _ | Optional _; + arg_label = Lbl _ | Opt _; rhs = {pexp_desc = Pexp_fun _} as internal_expression; } as f); } -> @@ -839,14 +854,14 @@ let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding = pexp_desc = Pexp_fun { - arg_label = Nolabel; + arg_label = Nolbl; lhs = {ppat_desc = Ppat_construct ({txt = Lident "()"}, _) | Ppat_any}; }; } -> ((fun a -> a), false, expression) (* let make = (~prop) => ... *) - | {pexp_desc = Pexp_fun {arg_label = Labelled _ | Optional _}} -> + | {pexp_desc = Pexp_fun {arg_label = Lbl _ | Opt _}} -> ((fun a -> a), false, expression) (* let make = (prop) => ... *) | {pexp_desc = Pexp_fun {lhs = pattern}} -> @@ -870,7 +885,7 @@ let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding = | { pexp_desc = Pexp_apply - {funct = wrapper_expression; args = [(Nolabel, internal_expression)]}; + {funct = wrapper_expression; args = [(Nolbl, internal_expression)]}; } -> let () = has_application := true in let _, _, exp = spelunk_for_fun_expression internal_expression in @@ -972,10 +987,10 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = (match rec_flag with | Recursive -> internal_fn_name | Nonrecursive -> fn_name))) - ([(Nolabel, Exp.ident (Location.mknoloc @@ Lident "props"))] + ([(Nolbl, Exp.ident (Location.mknoloc @@ Lident "props"))] @ match has_forward_ref with - | true -> [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "ref"))] + | true -> [(Nolbl, Exp.ident (Location.mknoloc @@ Lident "ref"))] | false -> []) in let make_props_pattern = function @@ -994,12 +1009,12 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = (* let make = React.forwardRef({ let \"App" = (props, ref) => make({...props, ref: @optional (Js.Nullabel.toOption(ref))}) })*) - Exp.fun_ ~arity:None nolabel None + Exp.fun_ ~arity:None Nolbl None (match core_type_of_attr with | None -> make_props_pattern named_type_list | Some _ -> make_props_pattern typ_vars_of_core_type) (if has_forward_ref then - Exp.fun_ ~arity:None nolabel None + Exp.fun_ ~arity:None Nolbl None (Pat.var @@ Location.mknoloc "ref") inner_expression else inner_expression) @@ -1114,7 +1129,7 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = Pat.constraint_ pattern (ref_type Location.none) | _ -> pattern in - Exp.fun_ ~arity:None Nolabel None pattern expr) + Exp.fun_ ~arity:None Nolbl None pattern expr) expression patterns_with_nolabel in (* ({a, b, _}: props<'a, 'b>) *) @@ -1124,7 +1139,7 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = | _ -> Pat.record (List.rev patterns_with_label) Open in let expression = - Exp.fun_ ~arity:(Some 1) ~async:is_async Nolabel None + Exp.fun_ ~arity:(Some 1) ~async:is_async Nolbl None (Pat.constraint_ record_pattern (Typ.constr ~loc:empty_loc {txt = Lident "props"; loc = empty_loc} @@ -1191,18 +1206,18 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = match binding.pvb_expr with | { pexp_desc = - Pexp_apply {funct = wrapper_expr; args = [(Nolabel, func_expr)]}; + Pexp_apply {funct = wrapper_expr; args = [(Nolbl, func_expr)]}; } when is_forward_ref wrapper_expr -> (* Case when using React.forwardRef *) let rec check_invalid_forward_ref expr = match expr.pexp_desc with - | Pexp_fun {arg_label = Labelled _ | Optional _} -> + | Pexp_fun {arg_label = Lbl _ | Opt _} -> Location.raise_errorf ~loc:expr.pexp_loc "Components using React.forwardRef cannot use \ @react.componentWithProps. Please use @react.component \ instead." - | Pexp_fun {arg_label = Nolabel; rhs = body} -> + | Pexp_fun {arg_label = Nolbl; rhs = body} -> check_invalid_forward_ref body | _ -> () in @@ -1227,7 +1242,7 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = in let wrapper_expr = - Exp.fun_ ~arity:None Nolabel None props_pattern + Exp.fun_ ~arity:None Nolbl None props_pattern (Jsx_common.async_component ~async:is_async (Exp.apply (Exp.ident @@ -1239,7 +1254,7 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = | Nonrecursive -> fn_name); loc; }) - [(Nolabel, Exp.ident {txt = Lident "props"; loc})])) + [(Nolbl, Exp.ident {txt = Lident "props"; loc})])) in let wrapper_expr = Ast_uncurried.uncurried_fun ~arity:1 wrapper_expr in @@ -1308,7 +1323,7 @@ let transform_structure_item ~config item = | Ptyp_arrow {lbl = name; arg; ret = {ptyp_desc = Ptyp_arrow _} as typ2} when is_labelled name || is_optional name -> get_prop_types ((name, ptyp_attributes, ptyp_loc, arg) :: types) typ2 - | Ptyp_arrow {lbl = Nolabel; ret} -> get_prop_types types ret + | Ptyp_arrow {lbl = Nolbl; ret} -> get_prop_types types ret | Ptyp_arrow {lbl = name; arg; ret = return_value} when is_labelled name || is_optional name -> ( return_value, @@ -1416,12 +1431,12 @@ let transform_signature_item ~config item = get_prop_types ((lbl, attrs, ptyp_loc, type_) :: types) rest | Ptyp_arrow { - lbl = Nolabel; + lbl = Nolbl; arg = {ptyp_desc = Ptyp_constr ({txt = Lident "unit"}, _)}; ret = rest; } -> get_prop_types types rest - | Ptyp_arrow {lbl = Nolabel; ret = rest} -> get_prop_types types rest + | Ptyp_arrow {lbl = Nolbl; ret = rest} -> get_prop_types types rest | Ptyp_arrow { lbl = name; @@ -1561,7 +1576,7 @@ let expr ~config mapper expression = Exp.apply (Exp.ident {txt = module_access_name config "array"; loc = Location.none}) - [(Nolabel, expr)] + [(Nolbl, expr)] in let count_of_children = function | {pexp_desc = Pexp_array children} -> List.length children diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index 767558b77b..991cad32b2 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -111,11 +111,11 @@ module SexpAst = struct | Contravariant -> Sexp.atom "Contravariant" | Invariant -> Sexp.atom "Invariant" - let arg_label lbl = + let arg_label_loc lbl = match lbl with - | Asttypes.Nolabel -> Sexp.atom "Nolabel" - | Labelled txt -> Sexp.list [Sexp.atom "Labelled"; string txt] - | Optional txt -> Sexp.list [Sexp.atom "Optional"; string txt] + | Asttypes.Nolbl -> Sexp.atom "Nolabel" + | Lbl {txt} -> Sexp.list [Sexp.atom "Labelled"; string txt] + | Opt {txt} -> Sexp.list [Sexp.atom "Optional"; string txt] let constant c = let sexpr = @@ -559,7 +559,7 @@ module SexpAst = struct Sexp.list [ Sexp.atom "Pexp_fun"; - arg_label arg_lbl; + arg_label_loc arg_lbl; (match expr_opt with | None -> Sexp.atom "None" | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]); @@ -574,7 +574,7 @@ module SexpAst = struct Sexp.list (map_empty ~f:(fun (arg_lbl, expr) -> - Sexp.list [arg_label arg_lbl; expression expr]) + Sexp.list [arg_label_loc arg_lbl; expression expr]) args); ] | Pexp_match (expr, cases) -> @@ -838,7 +838,12 @@ module SexpAst = struct | Ptyp_var var -> Sexp.list [Sexp.atom "Ptyp_var"; string var] | Ptyp_arrow {lbl; arg; ret} -> Sexp.list - [Sexp.atom "Ptyp_arrow"; arg_label lbl; core_type arg; core_type ret] + [ + Sexp.atom "Ptyp_arrow"; + arg_label_loc lbl; + core_type arg; + core_type ret; + ] | Ptyp_tuple types -> Sexp.list [Sexp.atom "Ptyp_tuple"; Sexp.list (map_empty ~f:core_type types)] diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml index 8aa4997e3c..a91460741e 100644 --- a/compiler/syntax/src/res_comments_table.ml +++ b/compiler/syntax/src/res_comments_table.ml @@ -168,28 +168,27 @@ let arrow_type ct = let rec process attrs_before acc typ = match typ with | { - ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; lbl_loc; arg; ret}; + ptyp_desc = Ptyp_arrow {lbl = Nolbl as lbl; arg; ret}; ptyp_attributes = []; } -> - let arg = ([], lbl, lbl_loc, arg) in + let arg = ([], lbl, arg) in process attrs_before (arg :: acc) ret | { - ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; lbl_loc; arg; ret}; + ptyp_desc = Ptyp_arrow {lbl = Nolbl as lbl; arg; ret}; ptyp_attributes = [({txt = "bs"}, _)] as attrs; } -> - let arg = (attrs, lbl, lbl_loc, arg) in + let arg = (attrs, lbl, arg) in process attrs_before (arg :: acc) ret - | {ptyp_desc = Ptyp_arrow {lbl = Nolabel}} as return_type -> + | {ptyp_desc = Ptyp_arrow {lbl = Nolbl}} as return_type -> let args = List.rev acc in (attrs_before, args, return_type) - | {ptyp_desc = Ptyp_arrow {lbl; lbl_loc; arg; ret}; ptyp_attributes = attrs} - -> - let arg = (attrs, lbl, lbl_loc, arg) in + | {ptyp_desc = Ptyp_arrow {lbl; arg; ret}; ptyp_attributes = attrs} -> + let arg = (attrs, lbl, arg) in process attrs_before (arg :: acc) ret | typ -> (attrs_before, List.rev acc, typ) in match ct with - | {ptyp_desc = Ptyp_arrow {lbl = Nolabel}; ptyp_attributes = attrs} as typ -> + | {ptyp_desc = Ptyp_arrow {lbl = Nolbl}; ptyp_attributes = attrs} as typ -> process attrs [] {typ with ptyp_attributes = []} | typ -> process [] [] typ @@ -264,23 +263,18 @@ let fun_expr expr = Pexp_fun { arg_label = lbl; - label_loc; default = default_expr; lhs = pattern; rhs = return_expr; }; pexp_attributes = []; } -> - let parameter = ([], lbl, label_loc, default_expr, pattern) in + let parameter = ([], lbl, default_expr, pattern) in collect attrs_before (parameter :: acc) return_expr | {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs} -> let var, return_expr = collect_new_types [string_loc] rest in let parameter = - ( attrs, - Asttypes.Nolabel, - Location.none, - None, - Ast_helper.Pat.var ~loc:string_loc.loc var ) + (attrs, Asttypes.Nolbl, None, Ast_helper.Pat.var ~loc:string_loc.loc var) in collect attrs_before (parameter :: acc) return_expr | { @@ -288,34 +282,32 @@ let fun_expr expr = Pexp_fun { arg_label = lbl; - label_loc; default = default_expr; lhs = pattern; rhs = return_expr; }; pexp_attributes = [({txt = "bs"}, _)] as attrs; } -> - let parameter = (attrs, lbl, label_loc, default_expr, pattern) in + let parameter = (attrs, lbl, default_expr, pattern) in collect attrs_before (parameter :: acc) return_expr | { pexp_desc = Pexp_fun { - arg_label = (Labelled _ | Optional _) as lbl; - label_loc; + arg_label = (Lbl _ | Opt _) as lbl; default = default_expr; lhs = pattern; rhs = return_expr; }; pexp_attributes = attrs; } -> - let parameter = (attrs, lbl, label_loc, default_expr, pattern) in + let parameter = (attrs, lbl, default_expr, pattern) in collect attrs_before (parameter :: acc) return_expr | expr -> (attrs_before, List.rev acc, expr) in match expr with - | {pexp_desc = Pexp_fun {arg_label = Nolabel}; pexp_attributes = attrs} as - expr -> + | {pexp_desc = Pexp_fun {arg_label = Nolbl}; pexp_attributes = attrs} as expr + -> collect attrs [] {expr with pexp_attributes = []} | expr -> collect [] [] expr @@ -340,7 +332,7 @@ let is_if_then_else_expr expr = type node = | Case of Parsetree.case | CoreType of Parsetree.core_type - | ExprArgument of Parsetree.expression + | ExprArgument of {expr: Parsetree.expression; loc: Location.t} | Expression of Parsetree.expression | ExprRecordRow of Longident.t Asttypes.loc * Parsetree.expression | ExtensionConstructor of Parsetree.extension_constructor @@ -370,11 +362,7 @@ let get_loc node = | Some ({loc}, _), _ -> loc.Location.loc_end); } | CoreType ct -> ct.ptyp_loc - | ExprArgument expr -> ( - match expr.Parsetree.pexp_attributes with - | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs -> - {loc with loc_end = expr.pexp_loc.loc_end} - | _ -> expr.pexp_loc) + | ExprArgument {loc} -> loc | Expression e -> ( match e.pexp_attributes with | ({txt = "res.braces" | "ns.braces"; loc}, _) :: _ -> loc @@ -563,7 +551,7 @@ and walk_node node tbl comments = match node with | Case c -> walk_case c tbl comments | CoreType ct -> walk_core_type ct tbl comments - | ExprArgument ea -> walk_expr_argument ea tbl comments + | ExprArgument ea -> walk_expr_argument ea.expr ea.loc tbl comments | Expression e -> walk_expression e tbl comments | ExprRecordRow (ri, e) -> walk_expr_record_row (ri, e) tbl comments | ExtensionConstructor ec -> walk_extension_constructor ec tbl comments @@ -1320,7 +1308,7 @@ and walk_expression expr t comments = Longident.Lident ("~+" | "~+." | "~-" | "~-." | "not" | "!"); }; }; - args = [(Nolabel, arg_expr)]; + args = [(Nolbl, arg_expr)]; } -> let before, inside, after = partition_by_loc comments arg_expr.pexp_loc in attach t.leading arg_expr.pexp_loc before; @@ -1342,7 +1330,7 @@ and walk_expression expr t comments = | "<>" ); }; }; - args = [(Nolabel, operand1); (Nolabel, operand2)]; + args = [(Nolbl, operand1); (Nolbl, operand2)]; } -> let before, inside, after = partition_by_loc comments operand1.pexp_loc in attach t.leading operand1.pexp_loc before; @@ -1362,7 +1350,7 @@ and walk_expression expr t comments = { pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}; }; - args = [(Nolabel, parent_expr); (Nolabel, member_expr)]; + args = [(Nolbl, parent_expr); (Nolbl, member_expr)]; } -> walk_list [Expression parent_expr; Expression member_expr] t comments | Pexp_apply @@ -1372,11 +1360,7 @@ and walk_expression expr t comments = pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "set")}; }; args = - [ - (Nolabel, parent_expr); - (Nolabel, member_expr); - (Nolabel, target_expr); - ]; + [(Nolbl, parent_expr); (Nolbl, member_expr); (Nolbl, target_expr)]; } -> walk_list [Expression parent_expr; Expression member_expr; Expression target_expr] @@ -1389,7 +1373,7 @@ and walk_expression expr t comments = Pexp_ident {txt = Longident.Ldot (Lident "Primitive_dict", "make")}; }; - args = [(Nolabel, key_values)]; + args = [(Nolbl, key_values)]; } when Res_parsetree_viewer.is_tuple_array key_values -> walk_list [Expression key_values] t comments @@ -1412,14 +1396,16 @@ and walk_expression expr t comments = arguments |> List.filter (fun (label, _) -> match label with - | Asttypes.Labelled "children" -> false - | Asttypes.Nolabel -> false + | Asttypes.Lbl {txt = "children"} -> false + | Asttypes.Nolbl -> false | _ -> true) in let maybe_children = arguments |> List.find_opt (fun (label, _) -> - label = Asttypes.Labelled "children") + match label with + | Asttypes.Lbl {txt = "children"} -> true + | _ -> false) in match maybe_children with (* There is no need to deal with this situation as the children cannot be NONE *) @@ -1438,20 +1424,41 @@ and walk_expression expr t comments = in attach t.trailing call_expr.pexp_loc after_expr else - walk_list (props |> List.map (fun (_, e) -> ExprArgument e)) t leading; + walk_list + (props + |> List.map (fun (lbl, expr) -> + let loc = + match lbl with + | Asttypes.Lbl {loc} | Opt {loc} -> + {loc with loc_end = expr.Parsetree.pexp_loc.loc_end} + | _ -> expr.pexp_loc + in + ExprArgument {expr; loc})) + t leading; walk_expression children t inside) else let after_expr, rest = partition_adjacent_trailing call_expr.pexp_loc after in attach t.trailing call_expr.pexp_loc after_expr; - walk_list (arguments |> List.map (fun (_, e) -> ExprArgument e)) t rest + walk_list + (arguments + |> List.map (fun (lbl, expr) -> + let loc = + match lbl with + | Asttypes.Lbl {loc} | Opt {loc} -> + {loc with loc_end = expr.Parsetree.pexp_loc.loc_end} + | _ -> expr.pexp_loc + in + ExprArgument {expr; loc})) + t rest | Pexp_fun _ | Pexp_newtype _ -> ( let _, parameters, return_expr = fun_expr expr in let comments = visit_list_but_continue_with_remaining_comments ~newline_delimited:false - ~walk_node:walk_expr_pararameter - ~get_loc:(fun (_attrs, _argLbl, label_loc, expr_opt, pattern) -> + ~walk_node:walk_expr_parameter + ~get_loc:(fun (_attrs, argLbl, expr_opt, pattern) -> + let label_loc = Asttypes.get_lbl_loc argLbl in let open Parsetree in let start_pos = if label_loc <> Location.none then label_loc.loc_start @@ -1496,8 +1503,7 @@ and walk_expression expr t comments = attach t.trailing return_expr.pexp_loc trailing) | _ -> () -and walk_expr_pararameter (_attrs, _argLbl, _label_loc, expr_opt, pattern) t - comments = +and walk_expr_parameter (_attrs, _argLbl, expr_opt, pattern) t comments = let leading, inside, trailing = partition_by_loc comments pattern.ppat_loc in attach t.leading pattern.ppat_loc leading; walk_pattern pattern t inside; @@ -1515,22 +1521,15 @@ and walk_expr_pararameter (_attrs, _argLbl, _label_loc, expr_opt, pattern) t attach t.trailing expr.pexp_loc trailing | None -> attach t.trailing pattern.ppat_loc trailing -and walk_expr_argument expr t comments = - match expr.Parsetree.pexp_attributes with - | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs -> - let leading, trailing = partition_leading_trailing comments loc in - attach t.leading loc leading; - let after_label, rest = partition_adjacent_trailing loc trailing in - attach t.trailing loc after_label; - let before, inside, after = partition_by_loc rest expr.pexp_loc in - attach t.leading expr.pexp_loc before; - walk_expression expr t inside; - attach t.trailing expr.pexp_loc after - | _ -> - let before, inside, after = partition_by_loc comments expr.pexp_loc in - attach t.leading expr.pexp_loc before; - walk_expression expr t inside; - attach t.trailing expr.pexp_loc after +and walk_expr_argument expr loc t comments = + let leading, trailing = partition_leading_trailing comments loc in + attach t.leading loc leading; + let after_label, rest = partition_adjacent_trailing loc trailing in + attach t.trailing loc after_label; + let before, inside, after = partition_by_loc rest expr.pexp_loc in + attach t.leading expr.pexp_loc before; + walk_expression expr t inside; + attach t.trailing expr.pexp_loc after and walk_case (case : Parsetree.case) t comments = let before, inside, after = partition_by_loc comments case.pc_lhs.ppat_loc in @@ -1939,14 +1938,15 @@ and walk_object_field field t comments = and walk_type_parameters type_parameters t comments = visit_list_but_continue_with_remaining_comments - ~get_loc:(fun (_, _, lbl_loc, typexpr) -> + ~get_loc:(fun (_, lbl, typexpr) -> + let lbl_loc = Asttypes.get_lbl_loc lbl in if lbl_loc <> Location.none then {lbl_loc with loc_end = typexpr.Parsetree.ptyp_loc.loc_end} else typexpr.ptyp_loc) ~walk_node:walk_type_parameter ~newline_delimited:false type_parameters t comments -and walk_type_parameter (_attrs, _lbl, _lbl_loc, typexpr) t comments = +and walk_type_parameter (_attrs, _lbl, typexpr) t comments = let before_typ, inside_typ, after_typ = partition_by_loc comments typexpr.ptyp_loc in diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index 9fccfe49e4..bf2262c5f1 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -166,12 +166,11 @@ let tagged_template_literal_attr = let spread_attr = (Location.mknoloc "res.spread", Parsetree.PStr []) -type argument = {label: Asttypes.arg_label; expr: Parsetree.expression} +type argument = {label: Asttypes.arg_label_loc; expr: Parsetree.expression} type type_parameter = { attrs: Ast_helper.attrs; - label: Asttypes.arg_label; - label_loc: Location.t; + label: Asttypes.arg_label_loc; typ: Parsetree.core_type; start_pos: Lexing.position; } @@ -191,8 +190,7 @@ type fundef_type_param = { type fundef_term_param = { attrs: Parsetree.attributes; - p_label: Asttypes.arg_label; - lbl_loc: Location.t; + p_label: Asttypes.arg_label_loc; expr: Parsetree.expression option; pat: Parsetree.pattern; p_pos: Lexing.position; @@ -427,14 +425,14 @@ let make_unary_expr start_pos token_end token operand = ~loc:(mk_loc start_pos operand.Parsetree.pexp_loc.loc_end) (Ast_helper.Exp.ident ~loc:token_loc (Location.mkloc (Longident.Lident operator) token_loc)) - [(Nolabel, operand)] + [(Nolbl, operand)] | Token.Bang, _ -> let token_loc = mk_loc start_pos token_end in Ast_helper.Exp.apply ~loc:(mk_loc start_pos operand.Parsetree.pexp_loc.loc_end) (Ast_helper.Exp.ident ~loc:token_loc (Location.mkloc (Longident.Lident "not") token_loc)) - [(Nolabel, operand)] + [(Nolbl, operand)] | _ -> operand let make_list_expression loc seq ext_opt = @@ -541,7 +539,7 @@ let process_underscore_application args = ~loc:Location.none in let fun_expr = - Ast_helper.Exp.fun_ ~loc ~arity:(Some 1) Nolabel None pattern exp_apply + Ast_helper.Exp.fun_ ~loc ~arity:(Some 1) Nolbl None pattern exp_apply in Ast_uncurried.uncurried_fun ~arity:1 fun_expr | None -> exp_apply @@ -1596,19 +1594,12 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None) let arrow_expr = List.fold_right (fun parameter expr -> - let { - attrs; - p_label = lbl; - lbl_loc; - expr = default_expr; - pat; - p_pos = start_pos; - } = + let {attrs; p_label = lbl; expr = default_expr; pat; p_pos = start_pos} + = parameter in let loc = mk_loc start_pos end_pos in - Ast_helper.Exp.fun_ ~loc ~attrs ~label_loc:lbl_loc ~arity:None lbl - default_expr pat expr) + Ast_helper.Exp.fun_ ~loc ~attrs ~arity:None lbl default_expr pat expr) term_parameters body in let arrow_expr = @@ -1665,7 +1656,7 @@ and parse_parameter p = | Comma | Equal | Rparen -> let loc = mk_loc start_pos p.prev_end_pos in ( [], - Asttypes.Labelled lbl_name, + Asttypes.Lbl {txt = lbl_name; loc = lbl_loc}, lbl_loc, Ast_helper.Pat.var ~attrs ~loc (Location.mkloc lbl_name loc) ) | Colon -> @@ -1678,26 +1669,26 @@ and parse_parameter p = let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Pat.constraint_ ~attrs ~loc pat typ in - ([], Asttypes.Labelled lbl_name, lbl_loc, pat) + ([], Asttypes.Lbl {txt = lbl_name; loc = lbl_loc}, lbl_loc, pat) | As -> Parser.next p; let pat = let pat = parse_constrained_pattern p in {pat with ppat_attributes = attrs @ pat.ppat_attributes} in - ([], Asttypes.Labelled lbl_name, lbl_loc, pat) + ([], Asttypes.Lbl {txt = lbl_name; loc = lbl_loc}, lbl_loc, pat) | t -> Parser.err p (Diagnostics.unexpected t p.breadcrumbs); let loc = mk_loc start_pos p.prev_end_pos in ( [], - Asttypes.Labelled lbl_name, + Asttypes.Lbl {txt = lbl_name; loc = lbl_loc}, lbl_loc, Ast_helper.Pat.var ~attrs ~loc (Location.mkloc lbl_name loc) )) | _ -> let pattern = parse_constrained_pattern p in let attrs = List.concat [pattern.ppat_attributes; attrs] in ( [], - Asttypes.Nolabel, + Asttypes.Nolbl, Location.none, {pattern with ppat_attributes = attrs} ) in @@ -1706,8 +1697,8 @@ and parse_parameter p = Parser.next p; let lbl = match lbl with - | Asttypes.Labelled lbl_name -> Asttypes.Optional lbl_name - | Asttypes.Nolabel -> + | Asttypes.Lbl lbl_name -> Asttypes.Opt lbl_name + | Asttypes.Nolbl -> let lbl_name = match pat.ppat_desc with | Ppat_var var -> var.txt @@ -1716,7 +1707,7 @@ and parse_parameter p = Parser.err ~start_pos ~end_pos:p.prev_end_pos p (Diagnostics.message (ErrorMessages.missing_tilde_labeled_parameter lbl_name)); - Asttypes.Optional lbl_name + Asttypes.Opt {txt = lbl_name; loc = lbl_loc} | lbl -> lbl in match p.Parser.token with @@ -1724,37 +1715,17 @@ and parse_parameter p = Parser.next p; Some (TermParameter - { - attrs; - p_label = lbl; - lbl_loc; - expr = None; - pat; - p_pos = start_pos; - }) + {attrs; p_label = lbl; expr = None; pat; p_pos = start_pos}) | _ -> let expr = parse_constrained_or_coerced_expr p in Some (TermParameter - { - attrs; - p_label = lbl; - lbl_loc; - expr = Some expr; - pat; - p_pos = start_pos; - })) + {attrs; p_label = lbl; expr = Some expr; pat; p_pos = start_pos}) + ) | _ -> Some (TermParameter - { - attrs; - p_label = lbl; - lbl_loc; - expr = None; - pat; - p_pos = start_pos; - }) + {attrs; p_label = lbl; expr = None; pat; p_pos = start_pos}) else None and parse_parameter_list p = @@ -1783,8 +1754,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list = in { attrs = []; - p_label = Asttypes.Nolabel; - lbl_loc = Location.none; + p_label = Asttypes.Nolbl; expr = None; pat = unit_pattern; p_pos = start_pos; @@ -1798,8 +1768,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list = [ { attrs = []; - p_label = Asttypes.Nolabel; - lbl_loc = Location.none; + p_label = Asttypes.Nolbl; expr = None; pat = Ast_helper.Pat.var ~loc (Location.mkloc ident loc); p_pos = start_pos; @@ -1812,8 +1781,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list = [ { attrs = []; - p_label = Asttypes.Nolabel; - lbl_loc = Location.none; + p_label = Asttypes.Nolbl; expr = None; pat = Ast_helper.Pat.any ~loc (); p_pos = start_pos; @@ -2033,7 +2001,7 @@ and parse_bracket_access p expr start_pos = Ast_helper.Exp.apply ~loc (Ast_helper.Exp.ident ~loc:operator_loc (Location.mkloc (Longident.Lident "#=") operator_loc)) - [(Nolabel, e); (Nolabel, rhs_expr)] + [(Nolbl, e); (Nolbl, rhs_expr)] | _ -> e) | _ -> ( let access_expr = parse_constrained_or_coerced_expr p in @@ -2060,7 +2028,7 @@ and parse_bracket_access p expr start_pos = let array_set = Ast_helper.Exp.apply ~loc:(mk_loc start_pos end_pos) (Ast_helper.Exp.ident ~loc:array_loc array_set) - [(Nolabel, expr); (Nolabel, access_expr); (Nolabel, rhs_expr)] + [(Nolbl, expr); (Nolbl, access_expr); (Nolbl, rhs_expr)] in Parser.eat_breadcrumb p; array_set @@ -2070,7 +2038,7 @@ and parse_bracket_access p expr start_pos = Ast_helper.Exp.apply ~loc:(mk_loc start_pos end_pos) (Ast_helper.Exp.ident ~loc:array_loc (Location.mkloc (Longident.Ldot (Lident "Array", "get")) array_loc)) - [(Nolabel, expr); (Nolabel, access_expr)] + [(Nolbl, expr); (Nolbl, access_expr)] in parse_primary_expr ~operand:e p) @@ -2247,14 +2215,13 @@ and parse_binary_expr ?(context = OrdinaryExpr) ?a p prec = { b with pexp_desc = - Pexp_apply - {funct = fun_expr; args = args @ [(Nolabel, a)]; partial}; + Pexp_apply {funct = fun_expr; args = args @ [(Nolbl, a)]; partial}; } - | BarGreater, _ -> Ast_helper.Exp.apply ~loc b [(Nolabel, a)] + | BarGreater, _ -> Ast_helper.Exp.apply ~loc b [(Nolbl, a)] | _ -> Ast_helper.Exp.apply ~loc (make_infix_operator p token start_pos end_pos) - [(Nolabel, a); (Nolabel, b)] + [(Nolbl, a); (Nolbl, b)] in Parser.eat_breadcrumb p; loop expr) @@ -2346,7 +2313,7 @@ and parse_template_expr ?prefix p = Ast_helper.Exp.apply ~attrs:[tagged_template_literal_attr] ~loc:lident_loc.loc ident - [(Nolabel, strings_array); (Nolabel, values_array)] + [(Nolbl, strings_array); (Nolbl, values_array)] in let hidden_operator = @@ -2356,7 +2323,7 @@ and parse_template_expr ?prefix p = let concat (e1 : Parsetree.expression) (e2 : Parsetree.expression) = let loc = mk_loc e1.pexp_loc.loc_start e2.pexp_loc.loc_end in Ast_helper.Exp.apply ~attrs:[template_literal_attr] ~loc hidden_operator - [(Nolabel, e1); (Nolabel, e2)] + [(Nolbl, e1); (Nolbl, e2)] in let gen_interpolated_string () = let subparts = @@ -2420,13 +2387,13 @@ and over_parse_constrained_or_coerced_or_arrow_expression p expr = let arrow1 = Ast_helper.Exp.fun_ ~loc:(mk_loc expr.pexp_loc.loc_start body.pexp_loc.loc_end) - ~arity:None Asttypes.Nolabel None pat + ~arity:None Asttypes.Nolbl None pat (Ast_helper.Exp.constraint_ body typ) in let arrow2 = Ast_helper.Exp.fun_ ~loc:(mk_loc expr.pexp_loc.loc_start body.pexp_loc.loc_end) - ~arity:None Asttypes.Nolabel None + ~arity:None Asttypes.Nolbl None (Ast_helper.Pat.constraint_ pat typ) body in @@ -2705,8 +2672,8 @@ and parse_jsx_opening_or_self_closing_element ~start_pos p = [ jsx_props; [ - (Asttypes.Labelled "children", children); - ( Asttypes.Nolabel, + (Asttypes.Lbl {txt = "children"; loc = Location.none}, children); + ( Asttypes.Nolbl, Ast_helper.Exp.construct (Location.mknoloc (Longident.Lident "()")) None ); @@ -2768,15 +2735,12 @@ and parse_jsx_prop p = | Question | Lident _ -> ( let optional = Parser.optional p Question in let name, loc = parse_lident p in - let prop_loc_attr = - (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) - in (* optional punning: *) if optional then Some - ( Asttypes.Optional name, - Ast_helper.Exp.ident ~attrs:[prop_loc_attr] ~loc - (Location.mkloc (Longident.Lident name) loc) ) + ( Asttypes.Opt {txt = name; loc}, + Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident name) loc) + ) else match p.Parser.token with | Equal -> @@ -2784,21 +2748,19 @@ and parse_jsx_prop p = (* no punning *) let optional = Parser.optional p Question in Scanner.pop_mode p.scanner Jsx; - let attr_expr = - let e = parse_primary_expr ~operand:(parse_atomic_expr p) p in - {e with pexp_attributes = prop_loc_attr :: e.pexp_attributes} - in + let attr_expr = parse_primary_expr ~operand:(parse_atomic_expr p) p in let label = - if optional then Asttypes.Optional name else Asttypes.Labelled name + if optional then Asttypes.Opt {txt = name; loc} + else Asttypes.Lbl {txt = name; loc} in Some (label, attr_expr) | _ -> let attr_expr = - Ast_helper.Exp.ident ~loc ~attrs:[prop_loc_attr] - (Location.mkloc (Longident.Lident name) loc) + Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident name) loc) in let label = - if optional then Asttypes.Optional name else Asttypes.Labelled name + if optional then Asttypes.Opt {txt = name; loc} + else Asttypes.Lbl {txt = name; loc} in Some (label, attr_expr)) (* {...props} *) @@ -2810,15 +2772,9 @@ and parse_jsx_prop p = Scanner.pop_mode p.scanner Jsx; Parser.next p; let loc = mk_loc p.Parser.start_pos p.prev_end_pos in - let prop_loc_attr = - (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) - in - let attr_expr = - let e = parse_primary_expr ~operand:(parse_expr p) p in - {e with pexp_attributes = prop_loc_attr :: e.pexp_attributes} - in + let attr_expr = parse_primary_expr ~operand:(parse_expr p) p in (* using label "spreadProps" to distinguish from others *) - let label = Asttypes.Labelled "_spreadProps" in + let label = Asttypes.Lbl {txt = "_spreadProps"; loc} in match p.Parser.token with | Rbrace -> Parser.next p; @@ -3034,8 +2990,7 @@ and parse_braced_or_record_expr p = [ { attrs = []; - p_label = Asttypes.Nolabel; - lbl_loc = Location.none; + p_label = Nolbl; expr = None; pat = Ast_helper.Pat.var ~loc:ident.loc ident; p_pos = start_pos; @@ -3628,7 +3583,7 @@ and parse_argument p : argument option = (Location.mknoloc (Longident.Lident "()")) None in - Some {label = Asttypes.Nolabel; expr = unit_expr} + Some {label = Asttypes.Nolbl; expr = unit_expr} | _ -> parse_argument2 p) | _ -> parse_argument2 p else None @@ -3642,7 +3597,7 @@ and parse_argument2 p : argument option = let expr = Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "_") loc) in - Some {label = Nolabel; expr} + Some {label = Nolbl; expr} | Tilde -> ( Parser.next p; (* TODO: nesting of pattern matches not intuitive for error recovery *) @@ -3652,25 +3607,22 @@ and parse_argument2 p : argument option = Parser.next p; let end_pos = p.prev_end_pos in let loc = mk_loc start_pos end_pos in - let prop_loc_attr = - (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) - in + let named_arg_loc = loc in let ident_expr = - Ast_helper.Exp.ident ~attrs:[prop_loc_attr] ~loc - (Location.mkloc (Longident.Lident ident) loc) + Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident ident) loc) in match p.Parser.token with | Question -> Parser.next p; - Some {label = Optional ident; expr = ident_expr} + Some {label = Opt {txt = ident; loc = named_arg_loc}; expr = ident_expr} | Equal -> Parser.next p; let label = match p.Parser.token with | Question -> Parser.next p; - Asttypes.Optional ident - | _ -> Labelled ident + Asttypes.Opt {txt = ident; loc = named_arg_loc} + | _ -> Asttypes.Lbl {txt = ident; loc = named_arg_loc} in let expr = match p.Parser.token with @@ -3679,24 +3631,25 @@ and parse_argument2 p : argument option = Parser.next p; Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "_") loc) - | _ -> - let expr = parse_constrained_or_coerced_expr p in - {expr with pexp_attributes = prop_loc_attr :: expr.pexp_attributes} + | _ -> parse_constrained_or_coerced_expr p in Some {label; expr} | Colon -> Parser.next p; let typ = parse_typ_expr p in let loc = mk_loc start_pos p.prev_end_pos in - let expr = - Ast_helper.Exp.constraint_ ~attrs:[prop_loc_attr] ~loc ident_expr typ - in - Some {label = Labelled ident; expr} - | _ -> Some {label = Labelled ident; expr = ident_expr}) + let expr = Ast_helper.Exp.constraint_ ~loc ident_expr typ in + Some {label = Asttypes.Lbl {txt = ident; loc = named_arg_loc}; expr} + | _ -> + Some + { + label = Asttypes.Lbl {txt = ident; loc = named_arg_loc}; + expr = ident_expr; + }) | t -> Parser.err p (Diagnostics.lident t); - Some {label = Nolabel; expr = Recover.default_expr ()}) - | _ -> Some {label = Nolabel; expr = parse_constrained_or_coerced_expr p} + Some {label = Nolbl; expr = Recover.default_expr ()}) + | _ -> Some {label = Nolbl; expr = parse_constrained_or_coerced_expr p} and parse_call_expr p fun_expr = Parser.expect Lparen p; @@ -3721,7 +3674,7 @@ and parse_call_expr p fun_expr = (* No args -> unit sugar: `foo()` *) [ { - label = Nolabel; + label = Nolbl; expr = Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) @@ -3924,7 +3877,7 @@ and parse_list_expr ~start_pos p = (Longident.Ldot (Longident.Ldot (Longident.Lident "Belt", "List"), "concatMany")) loc)) - [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc list_exprs)] + [(Asttypes.Nolbl, Ast_helper.Exp.array ~loc list_exprs)] and parse_dict_expr ~start_pos p = let rows = @@ -3953,7 +3906,7 @@ and parse_dict_expr ~start_pos p = (Location.mkloc (Longident.Ldot (Longident.Lident Primitive_modules.dict, "make")) loc)) - [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc key_value_pairs)] + [(Asttypes.Nolbl, Ast_helper.Exp.array ~loc key_value_pairs)] and parse_array_exp p = let start_pos = p.Parser.start_pos in @@ -4008,7 +3961,7 @@ and parse_array_exp p = (Longident.Ldot (Longident.Ldot (Longident.Lident "Belt", "Array"), "concatMany")) loc)) - [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc list_exprs)] + [(Nolbl, Ast_helper.Exp.array ~loc list_exprs)] (* TODO: check attributes in the case of poly type vars, * might be context dependend: parseFieldDeclaration (see ocaml) *) @@ -4035,8 +3988,7 @@ and parse_poly_type_expr p = let typ = Ast_helper.Typ.var ~loc:var.loc var.txt in let return_type = parse_typ_expr ~alias:false p in let loc = mk_loc typ.Parsetree.ptyp_loc.loc_start p.prev_end_pos in - Ast_helper.Typ.arrow ~loc ~arity:(Some 1) Asttypes.Nolabel typ - return_type + Ast_helper.Typ.arrow ~loc ~arity:(Some 1) Nolbl typ return_type | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt) | _ -> assert false) | _ -> parse_typ_expr p @@ -4268,9 +4220,8 @@ and parse_type_parameter p = | Equal -> Parser.next p; Parser.expect Question p; - Some {attrs; label = Optional name; label_loc = loc; typ; start_pos} - | _ -> - Some {attrs; label = Labelled name; label_loc = loc; typ; start_pos}) + Some {attrs; label = Opt {txt = name; loc}; typ; start_pos} + | _ -> Some {attrs; label = Lbl {txt = name; loc}; typ; start_pos}) | Lident _ -> ( let name, loc = parse_lident p in match p.token with @@ -4288,9 +4239,8 @@ and parse_type_parameter p = | Equal -> Parser.next p; Parser.expect Question p; - Some {attrs; label = Optional name; label_loc = loc; typ; start_pos} - | _ -> - Some {attrs; label = Labelled name; label_loc = loc; typ; start_pos}) + Some {attrs; label = Opt {txt = name; loc}; typ; start_pos} + | _ -> Some {attrs; label = Lbl {txt = name; loc}; typ; start_pos}) | _ -> let constr = Location.mkloc (Longident.Lident name) loc in let args = parse_type_constructor_args ~constr_name:constr p in @@ -4302,27 +4252,13 @@ and parse_type_parameter p = let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in let typ = parse_type_alias p typ in - Some - { - attrs = []; - label = Nolabel; - label_loc = Location.none; - typ; - start_pos; - }) + Some {attrs = []; label = Nolbl; typ; start_pos}) | _ -> let typ = parse_typ_expr p in let typ_with_attributes = {typ with ptyp_attributes = List.concat [attrs; typ.ptyp_attributes]} in - Some - { - attrs = []; - label = Nolabel; - label_loc = Location.none; - typ = typ_with_attributes; - start_pos; - } + Some {attrs = []; label = Nolbl; typ = typ_with_attributes; start_pos} else None (* (int, ~x:string, float) *) @@ -4335,7 +4271,7 @@ and parse_type_parameters p = let loc = mk_loc start_pos p.prev_end_pos in let unit_constr = Location.mkloc (Longident.Lident "unit") loc in let typ = Ast_helper.Typ.constr unit_constr [] in - [{attrs = []; label = Nolabel; label_loc = Location.none; typ; start_pos}] + [{attrs = []; label = Nolbl; typ; start_pos}] | _ -> let params = parse_comma_delimited_region ~grammar:Grammar.TypeParameters @@ -4349,22 +4285,16 @@ and parse_es6_arrow_type ~attrs p = match p.Parser.token with | Tilde -> Parser.next p; - let name, loc = parse_lident p in - let lbl_loc_attr = - (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) - in + let name, label_loc = parse_lident p in Parser.expect ~grammar:Grammar.TypeExpression Colon p; - let typ = - let typ = parse_typ_expr ~alias:false ~es6_arrow:false p in - {typ with ptyp_attributes = lbl_loc_attr :: typ.ptyp_attributes} - in + let typ = parse_typ_expr ~alias:false ~es6_arrow:false p in let arg = match p.Parser.token with | Equal -> Parser.next p; Parser.expect Question p; - Asttypes.Optional name - | _ -> Asttypes.Labelled name + Asttypes.Opt {txt = name; loc = label_loc} + | _ -> Asttypes.Lbl {txt = name; loc = label_loc} in Parser.expect EqualGreater p; let return_type = parse_typ_expr ~alias:false p in @@ -4379,13 +4309,12 @@ and parse_es6_arrow_type ~attrs p = let return_type_arity = 0 in let _paramNum, typ, _arity = List.fold_right - (fun {attrs; label = arg_lbl; label_loc; typ; start_pos} - (param_num, t, arity) -> + (fun {attrs; label = arg_lbl; typ; start_pos} (param_num, t, arity) -> let loc = mk_loc start_pos end_pos in let arity = (* Workaround for ~lbl: @as(json`false`) _, which changes the arity *) match arg_lbl with - | Labelled _s -> + | Lbl _s -> let typ_is_any = match typ.ptyp_desc with | Ptyp_any -> true @@ -4399,8 +4328,7 @@ and parse_es6_arrow_type ~attrs p = | _ -> arity in let t_arg = - Ast_helper.Typ.arrow ~loc ~label_loc ~attrs ~arity:None arg_lbl typ - t + Ast_helper.Typ.arrow ~loc ~attrs ~arity:None arg_lbl typ t in if param_num = 1 then (param_num - 1, Ast_uncurried.uncurried_type ~arity t_arg, 1) @@ -4460,7 +4388,7 @@ and parse_arrow_type_rest ~es6_arrow ~start_pos typ p = Parser.next p; let return_type = parse_typ_expr ~alias:false p in let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Typ.arrow ~loc ~arity:(Some 1) Asttypes.Nolabel typ return_type + Ast_helper.Typ.arrow ~loc ~arity:(Some 1) Nolbl typ return_type | _ -> typ and parse_typ_expr_region p = @@ -5067,8 +4995,7 @@ and parse_type_equation_or_constr_decl p = let return_type = parse_typ_expr ~alias:false p in let loc = mk_loc uident_start_pos p.prev_end_pos in let arrow_type = - Ast_helper.Typ.arrow ~loc ~arity:(Some 1) Asttypes.Nolabel typ - return_type + Ast_helper.Typ.arrow ~loc ~arity:(Some 1) Nolbl typ return_type in let typ = parse_type_alias p arrow_type in (Some typ, Asttypes.Public, Parsetree.Ptype_abstract) diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml index 3260786cee..a0b453d064 100644 --- a/compiler/syntax/src/res_parsetree_viewer.ml +++ b/compiler/syntax/src/res_parsetree_viewer.ml @@ -11,25 +11,24 @@ let arrow_type ?(max_arity = max_int) ct = when acc <> [] -> (attrs_before, List.rev acc, typ) | { - ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; lbl_loc; arg; ret}; + ptyp_desc = Ptyp_arrow {lbl = Nolbl as lbl; arg; ret}; ptyp_attributes = []; } -> - let arg = ([], lbl, lbl_loc, arg) in + let arg = ([], lbl, arg) in process attrs_before (arg :: acc) ret (arity - 1) | { - ptyp_desc = Ptyp_arrow {lbl = Nolabel}; + ptyp_desc = Ptyp_arrow {lbl = Nolbl}; ptyp_attributes = [({txt = "bs"}, _)]; } -> (* stop here, the uncurried attribute always indicates the beginning of an arrow function * e.g. `(. int) => (. int)` instead of `(. int, . int)` *) (attrs_before, List.rev acc, typ) - | {ptyp_desc = Ptyp_arrow {lbl = Nolabel}; ptyp_attributes = _attrs} as + | {ptyp_desc = Ptyp_arrow {lbl = Nolbl}; ptyp_attributes = _attrs} as return_type -> let args = List.rev acc in (attrs_before, args, return_type) | { - ptyp_desc = - Ptyp_arrow {lbl = (Labelled _ | Optional _) as lbl; lbl_loc; arg; ret}; + ptyp_desc = Ptyp_arrow {lbl = (Lbl _ | Opt _) as lbl; arg; ret}; ptyp_attributes = attrs; } -> (* Res_core.parse_es6_arrow_type has a workaround that removed an extra arity for the function if the @@ -44,12 +43,12 @@ let arrow_type ?(max_arity = max_int) ct = arity | _ -> arity - 1 in - let arg = (attrs, lbl, lbl_loc, arg) in + let arg = (attrs, lbl, arg) in process attrs_before (arg :: acc) ret arity | typ -> (attrs_before, List.rev acc, typ) in match ct with - | {ptyp_desc = Ptyp_arrow {lbl = Nolabel}; ptyp_attributes = attrs1} as typ -> + | {ptyp_desc = Ptyp_arrow {lbl = Nolbl}; ptyp_attributes = attrs1} as typ -> process attrs1 [] {typ with ptyp_attributes = []} max_arity | typ -> process [] [] typ max_arity @@ -113,7 +112,7 @@ let rewrite_underscore_apply expr = match expr_fun.pexp_desc with | Pexp_fun { - arg_label = Nolabel; + arg_label = Nolbl; default = None; lhs = {ppat_desc = Ppat_var {txt = "__x"}}; rhs = {pexp_desc = Pexp_apply {funct = call_expr; args}} as e; @@ -143,8 +142,7 @@ let rewrite_underscore_apply expr = type fun_param_kind = | Parameter of { attrs: Parsetree.attributes; - lbl: Asttypes.arg_label; - lbl_loc: Location.t; + lbl: Asttypes.arg_label_loc; default_expr: Parsetree.expression option; pat: Parsetree.pattern; } @@ -159,7 +157,6 @@ let fun_expr expr_ = Pexp_fun { arg_label = lbl; - label_loc; default = default_expr; lhs = pattern; rhs = return_expr; @@ -168,9 +165,7 @@ let fun_expr expr_ = pexp_attributes = attrs; } when arity = None || n_fun = 0 -> - let parameter = - Parameter {attrs; lbl; lbl_loc = label_loc; default_expr; pat = pattern} - in + let parameter = Parameter {attrs; lbl; default_expr; pat = pattern} in collect_params ~n_fun:(n_fun + 1) ~params:(parameter :: params) return_expr | _ -> (async, List.rev params, expr) @@ -201,10 +196,9 @@ let filter_parsing_attrs attrs = match attr with | ( { Location.txt = - ( "res.braces" | "ns.braces" | "res.iflet" | "res.namedArgLoc" - | "res.ternary" | "res.await" | "res.template" - | "res.taggedTemplate" | "res.patVariantSpread" - | "res.dictPattern" ); + ( "res.braces" | "ns.braces" | "res.iflet" | "res.ternary" + | "res.await" | "res.template" | "res.taggedTemplate" + | "res.patVariantSpread" | "res.dictPattern" ); }, _ ) -> false @@ -287,7 +281,7 @@ let is_unary_expression expr = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}; - args = [(Nolabel, _arg)]; + args = [(Nolbl, _arg)]; } when is_unary_operator operator -> true @@ -311,7 +305,7 @@ let is_binary_expression expr = pexp_desc = Pexp_ident {txt = Longident.Lident operator; loc = operator_loc}; }; - args = [(Nolabel, _operand1); (Nolabel, _operand2)]; + args = [(Nolbl, _operand1); (Nolbl, _operand2)]; } when is_binary_operator operator && not (operator_loc.loc_ghost && operator = "++") @@ -386,7 +380,7 @@ let is_array_access expr = Pexp_ident {txt = Longident.Ldot (Longident.Lident "Array", "get")}; }; - args = [(Nolabel, _parentExpr); (Nolabel, _memberExpr)]; + args = [(Nolbl, _parentExpr); (Nolbl, _memberExpr)]; } -> true | _ -> false @@ -460,7 +454,7 @@ let collect_ternary_parts expr = let parameters_should_hug parameters = match parameters with - | [Parameter {attrs = []; lbl = Asttypes.Nolabel; default_expr = None; pat}] + | [Parameter {attrs = []; lbl = Nolbl; default_expr = None; pat}] when is_huggable_pattern pat -> true | _ -> false @@ -518,7 +512,7 @@ let should_indent_binary_expr expr = Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident sub_operator}}; - args = [(Nolabel, _lhs); (Nolabel, _rhs)]; + args = [(Nolbl, _lhs); (Nolbl, _rhs)]; }; } when is_binary_operator sub_operator -> @@ -531,7 +525,7 @@ let should_indent_binary_expr expr = Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}; - args = [(Nolabel, lhs); (Nolabel, _rhs)]; + args = [(Nolbl, lhs); (Nolbl, _rhs)]; }; } when is_binary_operator operator -> @@ -644,7 +638,7 @@ let is_template_literal expr = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "++"}}; - args = [(Nolabel, _); (Nolabel, _)]; + args = [(Nolbl, _); (Nolbl, _)]; } when has_template_literal_attr expr.pexp_attributes -> true @@ -715,7 +709,7 @@ let is_single_pipe_expr expr = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident ("->" | "|>")}}; - args = [(Nolabel, _operand1); (Nolabel, _operand2)]; + args = [(Nolbl, _operand1); (Nolbl, _operand2)]; } -> true | _ -> false @@ -724,7 +718,7 @@ let is_single_pipe_expr expr = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident ("->" | "|>")}}; - args = [(Nolabel, operand1); (Nolabel, _operand2)]; + args = [(Nolbl, operand1); (Nolbl, _operand2)]; } when not (is_pipe_expr operand1) -> true @@ -734,7 +728,7 @@ let is_underscore_apply_sugar expr = match expr.pexp_desc with | Pexp_fun { - arg_label = Nolabel; + arg_label = Nolbl; default = None; lhs = {ppat_desc = Ppat_var {txt = "__x"}}; rhs = {pexp_desc = Pexp_apply _}; diff --git a/compiler/syntax/src/res_parsetree_viewer.mli b/compiler/syntax/src/res_parsetree_viewer.mli index 96c720c8ea..d409fa4be5 100644 --- a/compiler/syntax/src/res_parsetree_viewer.mli +++ b/compiler/syntax/src/res_parsetree_viewer.mli @@ -5,11 +5,7 @@ val arrow_type : ?max_arity:int -> Parsetree.core_type -> Parsetree.attributes - * (Parsetree.attributes - * Asttypes.arg_label - * Location.t - * Parsetree.core_type) - list + * (Parsetree.attributes * Asttypes.arg_label_loc * Parsetree.core_type) list * Parsetree.core_type val functor_type : @@ -45,8 +41,7 @@ val collect_list_expressions : type fun_param_kind = | Parameter of { attrs: Parsetree.attributes; - lbl: Asttypes.arg_label; - lbl_loc: Location.t; + lbl: Asttypes.arg_label_loc; default_expr: Parsetree.expression option; pat: Parsetree.pattern; } @@ -103,9 +98,9 @@ val partition_printable_attributes : Parsetree.attributes -> Parsetree.attributes * Parsetree.attributes val requires_special_callback_printing_last_arg : - (Asttypes.arg_label * Parsetree.expression) list -> bool + (Asttypes.arg_label_loc * Parsetree.expression) list -> bool val requires_special_callback_printing_first_arg : - (Asttypes.arg_label * Parsetree.expression) list -> bool + (Asttypes.arg_label_loc * Parsetree.expression) list -> bool val mod_expr_apply : Parsetree.module_expr -> Parsetree.module_expr list * Parsetree.module_expr diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 9b4e4c358b..e03606478b 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -1606,7 +1606,7 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl = in match args with | [] -> Doc.nil - | [([], Nolabel, _, n)] -> + | [([], Nolbl, n)] -> let has_attrs_before = not (attrs_before = []) in let attrs = if has_attrs_before then @@ -1931,29 +1931,23 @@ and print_object_field ~state (field : Parsetree.object_field) cmt_tbl = (* es6 arrow type arg * type t = (~foo: string, ~bar: float=?, unit) => unit * i.e. ~foo: string, ~bar: float *) -and print_type_parameter ~state (attrs, lbl, lbl_loc, typ) cmt_tbl = +and print_type_parameter ~state (attrs, lbl, typ) cmt_tbl = (* Converting .ml code to .res requires processing uncurried attributes *) let attrs = print_attributes ~state attrs cmt_tbl in let label = match lbl with - | Asttypes.Nolabel -> Doc.nil - | Labelled lbl -> + | Asttypes.Nolbl -> Doc.nil + | Lbl {txt = lbl} -> Doc.concat [Doc.text "~"; print_ident_like lbl; Doc.text ": "] - | Optional lbl -> + | Opt {txt = lbl} -> Doc.concat [Doc.text "~"; print_ident_like lbl; Doc.text ": "] in let optional_indicator = match lbl with - | Asttypes.Nolabel | Labelled _ -> Doc.nil - | Optional _lbl -> Doc.text "=?" + | Nolbl | Lbl _ -> Doc.nil + | Opt _ -> Doc.text "=?" in - let typ = - match typ.ptyp_attributes with - | ({Location.txt = "res.namedArgLoc"}, _) :: attrs -> - {typ with ptyp_attributes = attrs} - | _ -> typ - in - let loc = {lbl_loc with loc_end = typ.ptyp_loc.loc_end} in + let loc = {(Asttypes.get_lbl_loc lbl) with loc_end = typ.ptyp_loc.loc_end} in let doc = Doc.group (Doc.concat @@ -2776,7 +2770,7 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = match e_fun.pexp_desc with | Pexp_fun { - arg_label = Nolabel; + arg_label = Nolbl; default = None; lhs = {ppat_desc = Ppat_var {txt = "__x"}}; rhs = {pexp_desc = Pexp_apply _}; @@ -3150,11 +3144,11 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = | extension -> print_extension ~state ~at_module_lvl:false extension cmt_tbl) | Pexp_apply - {funct = e; args = [(Nolabel, {pexp_desc = Pexp_array sub_lists})]} + {funct = e; args = [(Nolbl, {pexp_desc = Pexp_array sub_lists})]} when ParsetreeViewer.is_spread_belt_array_concat e -> print_belt_array_concat_apply ~state sub_lists cmt_tbl | Pexp_apply - {funct = e; args = [(Nolabel, {pexp_desc = Pexp_array sub_lists})]} + {funct = e; args = [(Nolbl, {pexp_desc = Pexp_array sub_lists})]} when ParsetreeViewer.is_spread_belt_list_concat e -> print_belt_list_concat_apply ~state sub_lists cmt_tbl | Pexp_apply {funct = call_expr; args} -> @@ -3558,7 +3552,7 @@ and print_template_literal ~state expr cmt_tbl = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "++"}}; - args = [(Nolabel, arg1); (Nolabel, arg2)]; + args = [(Nolbl, arg1); (Nolbl, arg2)]; } -> let lhs = walk_expr arg1 in let rhs = walk_expr arg2 in @@ -3647,7 +3641,7 @@ and print_unary_expression ~state expr cmt_tbl = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}; - args = [(Nolabel, operand)]; + args = [(Nolbl, operand)]; } -> let printed_operand = let doc = print_expression_with_comments ~state operand cmt_tbl in @@ -3792,7 +3786,7 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "++"; loc}}; - args = [(Nolabel, _); (Nolabel, _)]; + args = [(Nolbl, _); (Nolbl, _)]; } when loc.loc_ghost -> let doc = print_template_literal ~state expr cmt_tbl in @@ -3806,7 +3800,7 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}; - args = [(Nolabel, lhs); (Nolabel, rhs)]; + args = [(Nolbl, lhs); (Nolbl, rhs)]; } -> let rhs_doc = print_expression_with_comments ~state rhs cmt_tbl in let lhs_doc = print_expression_with_comments ~state lhs cmt_tbl in @@ -3847,7 +3841,7 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = { pexp_desc = Pexp_ident {txt = Longident.Lident (("->" | "|>") as op)}; }; - args = [(Nolabel, lhs); (Nolabel, rhs)]; + args = [(Nolbl, lhs); (Nolbl, rhs)]; } when not (ParsetreeViewer.is_binary_expression lhs @@ -3873,7 +3867,7 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}; - args = [(Nolabel, lhs); (Nolabel, rhs)]; + args = [(Nolbl, lhs); (Nolbl, rhs)]; } -> let is_multiline = lhs.pexp_loc.loc_start.pos_lnum < rhs.pexp_loc.loc_start.pos_lnum @@ -4045,7 +4039,7 @@ and print_pexp_apply ~state expr cmt_tbl = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}}; - args = [(Nolabel, parent_expr); (Nolabel, member_expr)]; + args = [(Nolbl, parent_expr); (Nolbl, member_expr)]; } -> let parent_doc = let doc = print_expression_with_comments ~state parent_expr cmt_tbl in @@ -4077,7 +4071,7 @@ and print_pexp_apply ~state expr cmt_tbl = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}; - args = [(Nolabel, lhs); (Nolabel, rhs)]; + args = [(Nolbl, lhs); (Nolbl, rhs)]; } -> ( let rhs_doc = let doc = print_expression_with_comments ~state rhs cmt_tbl in @@ -4114,7 +4108,7 @@ and print_pexp_apply ~state expr cmt_tbl = Pexp_ident {txt = Longident.Ldot (Lident "Primitive_dict", "make")}; }; - args = [(Nolabel, key_values)]; + args = [(Nolbl, key_values)]; } when Res_parsetree_viewer.is_tuple_array key_values -> Doc.concat @@ -4129,7 +4123,7 @@ and print_pexp_apply ~state expr cmt_tbl = { pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}; }; - args = [(Nolabel, parent_expr); (Nolabel, member_expr)]; + args = [(Nolbl, parent_expr); (Nolbl, member_expr)]; } when not (ParsetreeViewer.is_rewritten_underscore_apply_sugar parent_expr) -> @@ -4175,11 +4169,7 @@ and print_pexp_apply ~state expr cmt_tbl = pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "set")}; }; args = - [ - (Nolabel, parent_expr); - (Nolabel, member_expr); - (Nolabel, target_expr); - ]; + [(Nolbl, parent_expr); (Nolbl, member_expr); (Nolbl, target_expr)]; } -> let member = let member_doc = @@ -4257,7 +4247,7 @@ and print_pexp_apply ~state expr cmt_tbl = let args = if partial then let dummy = Ast_helper.Exp.constant ~attrs (Ast_helper.Const.int 0) in - args @ [(Asttypes.Labelled "...", dummy)] + args @ [(Asttypes.Lbl {txt = "..."; loc = Location.none}, dummy)] else args in let call_expr_doc = @@ -4509,8 +4499,8 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option = match args with | [] -> (Doc.nil, None) | [ - (Asttypes.Labelled "children", children); - ( Asttypes.Nolabel, + (Asttypes.Lbl {txt = "children"}, children); + ( Asttypes.Nolbl, { Parsetree.pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); @@ -4518,20 +4508,20 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option = ] -> let doc = if is_self_closing children then Doc.line else Doc.nil in (doc, Some children) - | ((_, expr) as last_prop) + | ((e_lbl, expr) as last_prop) :: [ - (Asttypes.Labelled "children", children); - ( Asttypes.Nolabel, + (Asttypes.Lbl {txt = "children"}, children); + ( Asttypes.Nolbl, { Parsetree.pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); } ); ] -> let loc = - match expr.Parsetree.pexp_attributes with - | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs -> + match e_lbl with + | Asttypes.Lbl {loc} | Asttypes.Opt {loc} -> {loc with loc_end = expr.pexp_loc.loc_end} - | _ -> expr.pexp_loc + | Nolbl -> expr.pexp_loc in let trailing_comments_present = has_trailing_comments cmt_tbl loc in let prop_doc = print_jsx_prop ~state last_prop cmt_tbl in @@ -4562,48 +4552,41 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option = and print_jsx_prop ~state arg cmt_tbl = match arg with - | ( ((Asttypes.Labelled lbl_txt | Optional lbl_txt) as lbl), + | ( ((Asttypes.Lbl {txt = lbl_txt} | Opt {txt = lbl_txt}) as lbl), { - Parsetree.pexp_attributes = - [({Location.txt = "res.namedArgLoc"; loc = arg_loc}, _)]; + pexp_attributes = []; pexp_desc = Pexp_ident {txt = Longident.Lident ident}; } ) when lbl_txt = ident (* jsx punning *) -> ( match lbl with - | Nolabel -> Doc.nil - | Labelled _lbl -> print_comments (print_ident_like ident) cmt_tbl arg_loc - | Optional _lbl -> + | Nolbl -> Doc.nil + | Lbl {loc} -> print_comments (print_ident_like ident) cmt_tbl loc + | Opt {loc} -> let doc = Doc.concat [Doc.question; print_ident_like ident] in - print_comments doc cmt_tbl arg_loc) - | ( ((Asttypes.Labelled lbl_txt | Optional lbl_txt) as lbl), + print_comments doc cmt_tbl loc) + | ( ((Asttypes.Lbl {txt = lbl_txt} | Opt {txt = lbl_txt}) as lbl), { Parsetree.pexp_attributes = []; pexp_desc = Pexp_ident {txt = Longident.Lident ident}; } ) when lbl_txt = ident (* jsx punning when printing from Reason *) -> ( match lbl with - | Nolabel -> Doc.nil - | Labelled _lbl -> print_ident_like ident - | Optional _lbl -> Doc.concat [Doc.question; print_ident_like ident]) - | Asttypes.Labelled "_spreadProps", expr -> + | Nolbl -> Doc.nil + | Lbl _lbl -> print_ident_like ident + | Opt _lbl -> Doc.concat [Doc.question; print_ident_like ident]) + | Asttypes.Lbl {txt = "_spreadProps"}, expr -> let doc = print_expression_with_comments ~state expr cmt_tbl in Doc.concat [Doc.lbrace; Doc.dotdotdot; doc; Doc.rbrace] | lbl, expr -> - let arg_loc, expr = - match expr.pexp_attributes with - | ({Location.txt = "res.namedArgLoc"; loc}, _) :: attrs -> - (loc, {expr with pexp_attributes = attrs}) - | _ -> (Location.none, expr) - in - let lbl_doc = + let arg_loc, lbl_doc = match lbl with - | Asttypes.Labelled lbl -> - let lbl = print_comments (print_ident_like lbl) cmt_tbl arg_loc in - Doc.concat [lbl; Doc.equal] - | Asttypes.Optional lbl -> - let lbl = print_comments (print_ident_like lbl) cmt_tbl arg_loc in - Doc.concat [lbl; Doc.equal; Doc.question] - | Nolabel -> Doc.nil + | Asttypes.Lbl {txt = lbl; loc} -> + let lbl = print_comments (print_ident_like lbl) cmt_tbl loc in + (loc, Doc.concat [lbl; Doc.equal]) + | Asttypes.Opt {txt = lbl; loc} -> + let lbl = print_comments (print_ident_like lbl) cmt_tbl loc in + (loc, Doc.concat [lbl; Doc.equal; Doc.question]) + | Nolbl -> (Location.none, Doc.nil) in let expr_doc = let leading_line_comment_present = @@ -4653,10 +4636,10 @@ and print_arguments_with_callback_in_first_position ~state ~partial args cmt_tbl | (lbl, expr) :: args -> let lbl_doc = match lbl with - | Asttypes.Nolabel -> Doc.nil - | Asttypes.Labelled txt -> + | Asttypes.Nolbl -> Doc.nil + | Asttypes.Lbl {txt} -> Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal] - | Asttypes.Optional txt -> + | Asttypes.Opt {txt} -> Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal; Doc.question] in let callback = @@ -4741,10 +4724,10 @@ and print_arguments_with_callback_in_last_position ~state ~partial args cmt_tbl | [(lbl, expr)] -> let lbl_doc = match lbl with - | Asttypes.Nolabel -> Doc.nil - | Asttypes.Labelled txt -> + | Asttypes.Nolbl -> Doc.nil + | Asttypes.Lbl {txt} -> Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal] - | Asttypes.Optional txt -> + | Asttypes.Opt {txt} -> Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal; Doc.question] in let callback_fits_on_one_line = @@ -4833,10 +4816,10 @@ and print_arguments_with_callback_in_last_position ~state ~partial args cmt_tbl ] and print_arguments ~state ~partial - (args : (Asttypes.arg_label * Parsetree.expression) list) cmt_tbl = + (args : (Asttypes.arg_label_loc * Parsetree.expression) list) cmt_tbl = match args with | [ - ( Nolabel, + ( Nolbl, { pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _); pexp_loc = loc; @@ -4851,7 +4834,7 @@ and print_arguments ~state ~partial Doc.rparen; ] else Doc.text "()" - | [(Nolabel, arg)] when ParsetreeViewer.is_huggable_expression arg -> + | [(Nolbl, arg)] when ParsetreeViewer.is_huggable_expression arg -> let arg_doc = let doc = print_expression_with_comments ~state arg cmt_tbl in match Parens.expr arg with @@ -4897,37 +4880,26 @@ and print_arguments ~state ~partial and print_argument ~state (arg_lbl, arg) cmt_tbl = match (arg_lbl, arg) with (* ~a (punned)*) - | ( Labelled lbl, - ({ - pexp_desc = Pexp_ident {txt = Longident.Lident name}; - pexp_attributes = [] | [({Location.txt = "res.namedArgLoc"}, _)]; - } as arg_expr) ) - when lbl = name && not (ParsetreeViewer.is_braced_expr arg_expr) -> - let loc = - match arg.pexp_attributes with - | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _ -> loc - | _ -> arg.pexp_loc - in + | ( Lbl {txt = lbl; loc = l0}, + { + pexp_attributes = []; + pexp_desc = Pexp_ident {txt = Longident.Lident name}; + } ) + when lbl = name && not (ParsetreeViewer.is_braced_expr arg) -> + let loc = {l0 with loc_end = arg.pexp_loc.loc_end} in let doc = Doc.concat [Doc.tilde; print_ident_like lbl] in print_comments doc cmt_tbl loc (* ~a: int (punned)*) - | ( Labelled lbl, + | ( Lbl {txt = lbl; loc = l0}, { pexp_desc = Pexp_constraint ( ({pexp_desc = Pexp_ident {txt = Longident.Lident name}} as arg_expr), typ ); - pexp_loc; - pexp_attributes = - ([] | [({Location.txt = "res.namedArgLoc"}, _)]) as attrs; + pexp_attributes = []; } ) when lbl = name && not (ParsetreeViewer.is_braced_expr arg_expr) -> - let loc = - match attrs with - | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _ -> - {loc with loc_end = pexp_loc.loc_end} - | _ -> arg.pexp_loc - in + let loc = {l0 with loc_end = arg.pexp_loc.loc_end} in let doc = Doc.concat [ @@ -4939,40 +4911,32 @@ and print_argument ~state (arg_lbl, arg) cmt_tbl = in print_comments doc cmt_tbl loc (* ~a? (optional lbl punned)*) - | ( Optional lbl, + | ( Opt {txt = lbl; loc}, { pexp_desc = Pexp_ident {txt = Longident.Lident name}; - pexp_attributes = [] | [({Location.txt = "res.namedArgLoc"}, _)]; + pexp_attributes = []; } ) when lbl = name -> - let loc = - match arg.pexp_attributes with - | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _ -> loc - | _ -> arg.pexp_loc - in let doc = Doc.concat [Doc.tilde; print_ident_like lbl; Doc.question] in print_comments doc cmt_tbl loc | _lbl, expr -> - let arg_loc, expr = - match expr.pexp_attributes with - | ({Location.txt = "res.namedArgLoc"; loc}, _) :: attrs -> - (loc, {expr with pexp_attributes = attrs}) - | _ -> (expr.pexp_loc, expr) - in - let printed_lbl, dotdotdot = + let arg_loc, printed_lbl, dotdotdot = match arg_lbl with - | Nolabel -> (Doc.nil, false) - | Labelled "..." -> + | Nolbl -> (expr.pexp_loc, Doc.nil, false) + | Lbl {txt = "..."; loc} -> + let arg_loc = loc in let doc = Doc.text "..." in - (print_comments doc cmt_tbl arg_loc, true) - | Labelled lbl -> + (loc, print_comments doc cmt_tbl arg_loc, true) + | Lbl {txt = lbl; loc} -> + let arg_loc = loc in let doc = Doc.concat [Doc.tilde; print_ident_like lbl; Doc.equal] in - (print_comments doc cmt_tbl arg_loc, false) - | Optional lbl -> + (loc, print_comments doc cmt_tbl arg_loc, false) + | Opt {txt = lbl; loc} -> + let arg_loc = loc in let doc = Doc.concat [Doc.tilde; print_ident_like lbl; Doc.equal; Doc.question] in - (print_comments doc cmt_tbl arg_loc, false) + (loc, print_comments doc cmt_tbl arg_loc, false) in let printed_expr = let doc = print_expression_with_comments ~state expr cmt_tbl in @@ -5077,7 +5041,7 @@ and print_expr_fun_parameters ~state ~in_callback ~async ~has_constraint ParsetreeViewer.Parameter { attrs = []; - lbl = Asttypes.Nolabel; + lbl = Nolbl; default_expr = None; pat = {Parsetree.ppat_desc = Ppat_any; ppat_loc}; }; @@ -5092,7 +5056,7 @@ and print_expr_fun_parameters ~state ~in_callback ~async ~has_constraint ParsetreeViewer.Parameter { attrs = []; - lbl = Asttypes.Nolabel; + lbl = Nolbl; default_expr = None; pat = { @@ -5118,7 +5082,7 @@ and print_expr_fun_parameters ~state ~in_callback ~async ~has_constraint ParsetreeViewer.Parameter { attrs = []; - lbl = Asttypes.Nolabel; + lbl = Nolbl; default_expr = None; pat = {ppat_desc = Ppat_construct ({txt = Longident.Lident "()"; loc}, None)}; @@ -5184,7 +5148,7 @@ and print_exp_fun_parameter ~state parameter cmt_tbl = cmt_tbl lbl.Asttypes.loc) lbls); ]) - | Parameter {attrs; lbl; lbl_loc; default_expr; pat = pattern} -> + | Parameter {attrs; lbl; default_expr; pat = pattern} -> let attrs = print_attributes ~state attrs cmt_tbl in (* =defaultValue *) let default_expr_doc = @@ -5198,8 +5162,8 @@ and print_exp_fun_parameter ~state parameter cmt_tbl = * ~from -> punning *) let label_with_pattern = match (lbl, pattern) with - | Asttypes.Nolabel, pattern -> print_pattern ~state pattern cmt_tbl - | ( (Asttypes.Labelled lbl | Optional lbl), + | Nolbl, pattern -> print_pattern ~state pattern cmt_tbl + | ( (Lbl {txt = lbl} | Opt {txt = lbl}), {ppat_desc = Ppat_var string_loc; ppat_attributes} ) when lbl = string_loc.txt -> (* ~d *) @@ -5209,7 +5173,7 @@ and print_exp_fun_parameter ~state parameter cmt_tbl = Doc.text "~"; print_ident_like lbl; ] - | ( (Asttypes.Labelled lbl | Optional lbl), + | ( (Lbl {txt = lbl} | Opt {txt = lbl}), { ppat_desc = Ppat_constraint ({ppat_desc = Ppat_var {txt}}, typ); ppat_attributes; @@ -5224,7 +5188,7 @@ and print_exp_fun_parameter ~state parameter cmt_tbl = Doc.text ": "; print_typ_expr ~state typ cmt_tbl; ] - | (Asttypes.Labelled lbl | Optional lbl), pattern -> + | (Lbl {txt = lbl} | Opt {txt = lbl}), pattern -> (* ~b as c *) Doc.concat [ @@ -5236,7 +5200,7 @@ and print_exp_fun_parameter ~state parameter cmt_tbl = in let optional_label_suffix = match (lbl, default_expr) with - | Asttypes.Optional _, None -> Doc.text "=?" + | Opt _, None -> Doc.text "=?" | _ -> Doc.nil in let doc = @@ -5244,6 +5208,7 @@ and print_exp_fun_parameter ~state parameter cmt_tbl = (Doc.concat [attrs; label_with_pattern; default_expr_doc; optional_label_suffix]) in + let lbl_loc = Asttypes.get_lbl_loc lbl in let cmt_loc = match default_expr with | None -> {lbl_loc with loc_end = pattern.ppat_loc.loc_end} diff --git a/tests/syntax_tests/data/parsing/errors/expressions/expected/jsx.res.txt b/tests/syntax_tests/data/parsing/errors/expressions/expected/jsx.res.txt index c384682f15..2853150fe2 100644 --- a/tests/syntax_tests/data/parsing/errors/expressions/expected/jsx.res.txt +++ b/tests/syntax_tests/data/parsing/errors/expressions/expected/jsx.res.txt @@ -65,6 +65,4 @@ let x = ([%rescript.exprhole ]) let x = ((Foo.bar.createElement ~children:[] ())[@JSX ]) > ([%rescript.exprhole ]) -let x = - ((Foo.bar.createElement ~baz:((baz)[@res.namedArgLoc ]) ~children:[] ()) - [@JSX ]) \ No newline at end of file +let x = ((Foo.bar.createElement ~baz ~children:[] ())[@JSX ]) \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/structure/expected/gh16B.res.txt b/tests/syntax_tests/data/parsing/errors/structure/expected/gh16B.res.txt index bd44146f4f..58a09da053 100644 --- a/tests/syntax_tests/data/parsing/errors/structure/expected/gh16B.res.txt +++ b/tests/syntax_tests/data/parsing/errors/structure/expected/gh16B.res.txt @@ -35,6 +35,6 @@ module ClientSet = (b -> Client.getUniqueId)) [@res.braces ]) end) - let empty = Belt.Set.make ~id:(((module T))[@res.namedArgLoc ]) + let empty = Belt.Set.make ~id:(module T) end ;;Js.log {js|test|js} \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/typexpr/expected/arrow.res.txt b/tests/syntax_tests/data/parsing/errors/typexpr/expected/arrow.res.txt index 699b64da8d..c621d68f7f 100644 --- a/tests/syntax_tests/data/parsing/errors/typexpr/expected/arrow.res.txt +++ b/tests/syntax_tests/data/parsing/errors/typexpr/expected/arrow.res.txt @@ -46,6 +46,5 @@ module Error3 = type nonrec observation = { observed: int ; - onStep: - currentValue:((unit)[@res.namedArgLoc ]) -> [%rescript.typehole ] } + onStep: currentValue:unit -> [%rescript.typehole ] } end \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/apply.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/apply.res.txt index ffe47af868..106a05e81e 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/apply.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/apply.res.txt @@ -5,5 +5,5 @@ ;;List.map (fun [arity:1]x -> x + 1) myList ;;List.reduce (fun [arity:2]acc -> fun curr -> acc + curr) 0 myList let unitUncurried = apply () -;;call ~a:(((((a)[@res.namedArgLoc ]) : int))[@res.namedArgLoc ]) +;;call ~a:(a : int) ;;call_partial 3 ... \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/argument.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/argument.res.txt index 0f5238e48d..fcd6932823 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/argument.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/argument.res.txt @@ -1,11 +1,9 @@ let foo [arity:1]~a = (a ()) +. 1. let a [arity:1]() = 2 -let bar = foo ~a:((a)[@res.namedArgLoc ]) -let comparisonResult = - compare currentNode.value ~targetValue:((targetValue)[@res.namedArgLoc ]) -;;callback firstNode ~y:((y)[@res.namedArgLoc ]) +let bar = foo ~a +let comparisonResult = compare currentNode.value ~targetValue +;;callback firstNode ~y ;;document.createElementWithOptions {js|div|js} - (elementProps ~onClick:((fun [arity:1]_ -> Js.log {js|hello world|js}) - [@res.namedArgLoc ])) + (elementProps ~onClick:(fun [arity:1]_ -> Js.log {js|hello world|js})) ;;resolve () ;;resolve () \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/async.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/async.res.txt index 66d56df041..ed3e620e20 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/async.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/async.res.txt @@ -21,11 +21,11 @@ let f = then async fun [arity:2]a -> fun b -> (a + b : int) else (async fun [arity:2]c -> fun d -> (c - d : int))) [@res.ternary ]) -let foo = async ~a:((34)[@res.namedArgLoc ]) +let foo = async ~a:34 let bar async [arity:1]~a = a + 1 let ex1 = ((3)[@res.await ]) + ((4)[@res.await ]) let ex2 = ((3)[@res.await ]) ** ((4)[@res.await ]) -let ex3 = ((foo -> (bar ~arg:((arg)[@res.namedArgLoc ])))[@res.await ]) +let ex3 = ((foo -> (bar ~arg))[@res.await ]) let ex4 = (((foo.bar).baz)[@res.await ]) let attr1 = ((async fun [arity:1]x -> x + 1)[@a ]) let attr2 = ((fun (type a) -> diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/binaryNoEs6Arrow.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/binaryNoEs6Arrow.res.txt index b510458769..71c6ce2066 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/binaryNoEs6Arrow.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/binaryNoEs6Arrow.res.txt @@ -29,6 +29,5 @@ ({ startTime = (percent *. duration) } : Video.chapter) in { a; b } -> onChange | _ -> ()) - [@res.braces ]))[@res.namedArgLoc ][@res.braces ]) - ~children:[] ())[@JSX ]) + [@res.braces ]))[@res.braces ]) ~children:[] ())[@JSX ]) ;;if inclusions.(index) <- (uid, url) then onChange inclusions \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/firstClassModule.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/firstClassModule.res.txt index 2e7a5a90ed..b1a932b369 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/firstClassModule.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/firstClassModule.res.txt @@ -33,13 +33,11 @@ let unique_instance = build_instance (module Unique) 0 let build_dispatch_table [arity:1]handlers = ((let table = Hashtbl.create (module String) in List.iter handlers - ~f:((fun - [arity:1](((module I) : (module Query_handler_instance)) as - instance) - -> - Hashtbl.set table ~key:((I.Query_handler.name) - [@res.namedArgLoc ]) ~data:((instance)[@res.namedArgLoc ])) - [@res.namedArgLoc ]) table) + ~f:(fun + [arity:1](((module I) : (module Query_handler_instance)) as + instance) + -> Hashtbl.set table ~key:I.Query_handler.name ~data:instance) + table) [@res.braces ]) ;;(module Three) ;;((module Three) : (module X_int)) diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/jsx.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/jsx.res.txt index 02430a9034..7a853a944a 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/jsx.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/jsx.res.txt @@ -1,29 +1,23 @@ let _ = ((div ~children:[] ())[@JSX ]) let _ = ((div ~children:[] ())[@JSX ]) -let _ = ((div ~className:(({js|menu|js})[@res.namedArgLoc ]) ~children:[] ()) - [@JSX ]) -let _ = ((div ~className:(({js|menu|js})[@res.namedArgLoc ]) ~children:[] ()) - [@JSX ]) -let _ = ((div ~className:(({js|menu|js})[@res.namedArgLoc ]) ~children:[] ()) - [@JSX ]) -let _ = ((div ~className:(({js|menu|js})[@res.namedArgLoc ]) ~children:[] ()) - [@JSX ]) +let _ = ((div ~className:{js|menu|js} ~children:[] ())[@JSX ]) +let _ = ((div ~className:{js|menu|js} ~children:[] ())[@JSX ]) +let _ = ((div ~className:{js|menu|js} ~children:[] ())[@JSX ]) +let _ = ((div ~className:{js|menu|js} ~children:[] ())[@JSX ]) let _ = - ((div ~className:(({js|menu|js})[@res.namedArgLoc ]) - ~onClick:((fun [arity:1]_ -> Js.log {js|click|js}) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + ((div ~className:{js|menu|js} + ~onClick:((fun [arity:1]_ -> Js.log {js|click|js})[@res.braces ]) + ~children:[] ()) [@JSX ]) let _ = - ((div ~className:(({js|menu|js})[@res.namedArgLoc ]) - ~onClick:((fun [arity:1]_ -> Js.log {js|click|js}) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + ((div ~className:{js|menu|js} + ~onClick:((fun [arity:1]_ -> Js.log {js|click|js})[@res.braces ]) + ~children:[] ()) [@JSX ]) let _ = ((Navbar.createElement ~children:[] ())[@JSX ]) let _ = ((Navbar.createElement ~children:[] ())[@JSX ]) let _ = ((Navbar.createElement ~children:[] ())[@JSX ]) -let _ = - ((Navbar.createElement ~className:(({js|menu|js})[@res.namedArgLoc ]) - ~children:[] ()) +let _ = ((Navbar.createElement ~className:{js|menu|js} ~children:[] ()) [@JSX ]) let _ = ((Dot.Up.createElement ~children:[] ())[@JSX ]) let _ = ((Dot.Up.createElement ~children:[] ())[@JSX ]) @@ -36,9 +30,7 @@ let _ = ((Dot.Up.createElement ~children:[((Dot.Up.createElement ~children:[] ())[@JSX ])] ()) [@JSX ]) -let _ = - ((Dot.Up.createElement ~className:(({js|menu|js})[@res.namedArgLoc ]) - ~children:[] ()) +let _ = ((Dot.Up.createElement ~className:{js|menu|js} ~children:[] ()) [@JSX ]) let _ = ((Dot.low.createElement ~children:[] ())[@JSX ]) let _ = ((Dot.low.createElement ~children:[] ())[@JSX ]) @@ -51,34 +43,28 @@ let _ = ((Dot.low.createElement ~children:[((Dot.low.createElement ~children:[] ())[@JSX ])] ()) [@JSX ]) -let _ = - ((Dot.low.createElement ~className:(({js|menu|js})[@res.namedArgLoc ]) - ~children:[] ()) +let _ = ((Dot.low.createElement ~className:{js|menu|js} ~children:[] ()) [@JSX ]) -let _ = ((el ~punned:((punned)[@res.namedArgLoc ]) ~children:[] ())[@JSX ]) -let _ = ((el ?punned:((punned)[@res.namedArgLoc ]) ~children:[] ())[@JSX ]) -let _ = ((el ~punned:((punned)[@res.namedArgLoc ]) ~children:[] ())[@JSX ]) -let _ = ((el ?punned:((punned)[@res.namedArgLoc ]) ~children:[] ())[@JSX ]) -let _ = ((el ?a:((b)[@res.namedArgLoc ]) ~children:[] ())[@JSX ]) -let _ = ((el ?a:((b)[@res.namedArgLoc ]) ~children:[] ())[@JSX ]) +let _ = ((el ~punned ~children:[] ())[@JSX ]) +let _ = ((el ?punned ~children:[] ())[@JSX ]) +let _ = ((el ~punned ~children:[] ())[@JSX ]) +let _ = ((el ?punned ~children:[] ())[@JSX ]) +let _ = ((el ?a:b ~children:[] ())[@JSX ]) +let _ = ((el ?a:b ~children:[] ())[@JSX ]) let _ = (([])[@JSX ]) let _ = (([])[@JSX ]) let _ = - ((div ~className:(({js|menu|js})[@res.namedArgLoc ]) - ~children:[((div ~className:(({js|submenu|js})[@res.namedArgLoc ]) - ~children:[sub1] ()) + ((div ~className:{js|menu|js} + ~children:[((div ~className:{js|submenu|js} ~children:[sub1] ()) [@JSX ]); - ((div ~className:(({js|submenu|js})[@res.namedArgLoc ]) - ~children:[sub2] ()) + ((div ~className:{js|submenu|js} ~children:[sub2] ()) [@JSX ])] ()) [@JSX ]) let _ = - ((div ~className:(({js|menu|js})[@res.namedArgLoc ]) - ~children:[((div ~className:(({js|submenu|js})[@res.namedArgLoc ]) - ~children:[sub1] ()) + ((div ~className:{js|menu|js} + ~children:[((div ~className:{js|submenu|js} ~children:[sub1] ()) [@JSX ]); - ((div ~className:(({js|submenu|js})[@res.namedArgLoc ]) - ~children:[sub2] ()) + ((div ~className:{js|submenu|js} ~children:[sub2] ()) [@JSX ])] ()) [@JSX ]) let _ = ((div ~children:child ())[@JSX ]) @@ -95,27 +81,23 @@ let _ = [@JSX ]) let _ = ((Outer.createElement ~inner:((Inner.createElement ~children:[] ()) - [@res.namedArgLoc ][@JSX ]) ~children:[] ()) + [@JSX ]) ~children:[] ()) [@JSX ]) let _ = - ((div ~onClick:((onClickHandler)[@res.namedArgLoc ]) - ~children:[(([{js|foobar|js}])[@JSX ])] ()) + ((div ~onClick:onClickHandler ~children:[(([{js|foobar|js}])[@JSX ])] ()) [@JSX ]) let _ = ((Window.createElement - ~style:(({ - width = 10; - height = 10; - paddingTop = 10; - paddingLeft = 10; - paddingRight = 10; - paddingBottom = 10 - })[@res.namedArgLoc ]) ~children:[] ()) - [@JSX ]) -let _ = - ((OverEager.createElement ~fiber:((Metal.fiber)[@res.namedArgLoc ]) - ~children:[] ()) - [@JSX ]) + ~style:{ + width = 10; + height = 10; + paddingTop = 10; + paddingLeft = 10; + paddingRight = 10; + paddingBottom = 10 + } ~children:[] ()) + [@JSX ]) +let _ = ((OverEager.createElement ~fiber:Metal.fiber ~children:[] ())[@JSX ]) let arrayOfListOfJsx = [|(([])[@JSX ])|] let arrayOfListOfJsx = [|(([((Foo.createElement ~children:[] ())[@JSX ])])[@JSX ])|] @@ -146,8 +128,7 @@ let _ = ((a ~children:[] ())[@JSX ]) > ((b ~children:[] ())[@JSX ]) let _ = ((a ~children:[] ())[@JSX ]) < ((b ~children:[] ())[@JSX ]) let _ = ((a ~children:[] ())[@JSX ]) > ((b ~children:[] ())[@JSX ]) let y = - ((Routes.createElement ~path:((Routes.stateToPath state) - [@res.namedArgLoc ]) ~isHistorical:((true)[@res.namedArgLoc ]) + ((Routes.createElement ~path:(Routes.stateToPath state) ~isHistorical:true ~onHashChange:((fun [arity:3]_oldPath -> fun _oldUrl -> fun newUrl -> @@ -167,47 +148,37 @@ let y = currentActualPath) latestComponentBag ()) [@res.ternary ])) - [@res.braces ])) ()) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + [@res.braces ])) ())[@res.braces ]) + ~children:[] ()) [@JSX ]) let z = ((div - ~style:((ReactDOMRe.Style.make ~width:((width)[@res.namedArgLoc ]) - ~height:((height)[@res.namedArgLoc ]) ~color:((color) - [@res.namedArgLoc ]) ~backgroundColor:((backgroundColor) - [@res.namedArgLoc ]) ~margin:((margin)[@res.namedArgLoc ]) - ~padding:((padding)[@res.namedArgLoc ]) ~border:((border) - [@res.namedArgLoc ]) ~borderColor:((borderColor) - [@res.namedArgLoc ]) - ~someOtherAttribute:((someOtherAttribute) - [@res.namedArgLoc ]) ())[@res.namedArgLoc ]) - ~key:((string_of_int 1)[@res.namedArgLoc ]) ~children:[] ()) + ~style:(ReactDOMRe.Style.make ~width ~height ~color ~backgroundColor + ~margin ~padding ~border ~borderColor ~someOtherAttribute ()) + ~key:(string_of_int 1) ~children:[] ()) [@JSX ]) let omega = ((div - ~aList:(([width; - height; - color; - backgroundColor; - margin; - padding; - border; - borderColor; - someOtherAttribute])[@res.namedArgLoc ]) - ~key:((string_of_int 1)[@res.namedArgLoc ]) ~children:[] ()) + ~aList:[width; + height; + color; + backgroundColor; + margin; + padding; + border; + borderColor; + someOtherAttribute] ~key:(string_of_int 1) ~children:[] ()) [@JSX ]) let someArray = ((div - ~anArray:(([|width;height;color;backgroundColor;margin;padding;border;borderColor;someOtherAttribute|]) - [@res.namedArgLoc ]) ~key:((string_of_int 1)[@res.namedArgLoc ]) - ~children:[] ()) + ~anArray:[|width;height;color;backgroundColor;margin;padding;border;borderColor;someOtherAttribute|] + ~key:(string_of_int 1) ~children:[] ()) [@JSX ]) let tuples = ((div - ~aTuple:(((width, height, color, backgroundColor, margin, padding, - border, borderColor, someOtherAttribute, - definitelyBreakere))[@res.namedArgLoc ]) - ~key:((string_of_int 1)[@res.namedArgLoc ]) ~children:[] ()) + ~aTuple:(width, height, color, backgroundColor, margin, padding, + border, borderColor, someOtherAttribute, definitelyBreakere) + ~key:(string_of_int 1) ~children:[] ()) [@JSX ]) let icon = ((Icon.createElement @@ -215,124 +186,100 @@ let icon = | v when v < 0.1 -> {js|sound-off|js} | v when v < 0.11 -> {js|sound-min|js} | v when v < 0.51 -> {js|sound-med|js} - | _ -> {js|sound-max|js})[@res.namedArgLoc ][@res.braces ]) - ~children:[] ()) + | _ -> {js|sound-max|js})[@res.braces ]) ~children:[] ()) [@JSX ]) let _ = ((MessengerSharedPhotosAlbumViewPhotoReact.createElement ?ref:((if foo#bar === baz then Some (foooooooooooooooooooooooo setRefChild) - else None)[@res.namedArgLoc ][@res.ternary ]) - ~key:((node#legacy_attachment_id)[@res.namedArgLoc ]) ~children:[] ()) - [@JSX ]) -let _ = ((Foo.createElement ~bar:((bar)[@res.namedArgLoc ]) ~children:[] ()) - [@JSX ]) -let _ = ((Foo.createElement ?bar:((bar)[@res.namedArgLoc ]) ~children:[] ()) - [@JSX ]) -let _ = - ((Foo.createElement ?bar:((Baz.bar)[@res.namedArgLoc ]) ~children:[] ()) + else None)[@res.ternary ]) ~key:(node#legacy_attachment_id) + ~children:[] ()) [@JSX ]) +let _ = ((Foo.createElement ~bar ~children:[] ())[@JSX ]) +let _ = ((Foo.createElement ?bar ~children:[] ())[@JSX ]) +let _ = ((Foo.createElement ?bar:Baz.bar ~children:[] ())[@JSX ]) let x = ((div ~children:[] ())[@JSX ]) -let _ = ((div ~asd:((1)[@res.namedArgLoc ]) ~children:[] ())[@JSX ]) +let _ = ((div ~asd:1 ~children:[] ())[@JSX ]) ;;foo#bar #= ((bar ~children:[] ())[@JSX ]) ;;foo #= ((bar ~children:[] ())[@JSX ]) ;;foo #= ((bar ~children:[] ())[@JSX ]) let x = [|((div ~children:[] ())[@JSX ])|] let z = ((div ~children:[] ())[@JSX ]) let z = - (((Button.createElement ~onClick:((handleStaleClick)[@res.namedArgLoc ]) - ~children:[] ())[@JSX ]), - ((Button.createElement ~onClick:((handleStaleClick)[@res.namedArgLoc ]) - ~children:[] ())[@JSX ])) + (((Button.createElement ~onClick:handleStaleClick ~children:[] ())[@JSX ]), + ((Button.createElement ~onClick:handleStaleClick ~children:[] ()) + [@JSX ])) let y = [|((div ~children:[] ())[@JSX ]);((div ~children:[] ())[@JSX ])|] let y = - [|((Button.createElement ~onClick:((handleStaleClick)[@res.namedArgLoc ]) - ~children:[] ()) - [@JSX ]);((Button.createElement ~onClick:((handleStaleClick) - [@res.namedArgLoc ]) ~children:[] ()) + [|((Button.createElement ~onClick:handleStaleClick ~children:[] ()) + [@JSX ]);((Button.createElement ~onClick:handleStaleClick ~children:[] ()) [@JSX ])|] let _ = ((Description.createElement - ~term:((Text.createElement ~text:(({js|Age|js})[@res.namedArgLoc ]) - ~children:[] ())[@res.namedArgLoc ][@res.braces ][@JSX ]) - ~children:[child] ()) + ~term:((Text.createElement ~text:{js|Age|js} ~children:[] ()) + [@res.braces ][@JSX ]) ~children:[child] ()) [@JSX ]) let _ = ((Description.createElement - ~term:((Text.createElement ~text:(({js|Age|js})[@res.namedArgLoc ]) - ~children:(([||])[@res.namedArgLoc ]) ()) - [@res.namedArgLoc ][@res.braces ]) ~children:[child] ()) + ~term:((Text.createElement ~text:{js|Age|js} ~children:[||] ()) + [@res.braces ]) ~children:[child] ()) [@JSX ]) let _ = ((Description.createElement - ~term:((Text.createElement ~text:(({js|Age|js})[@res.namedArgLoc ]) ()) - [@res.namedArgLoc ][@res.braces ][@JSX ]) ~children:[child] ()) + ~term:((Text.createElement ~text:{js|Age|js} ())[@res.braces ][@JSX ]) + ~children:[child] ()) [@JSX ]) let _ = ((Description.createElement - ~term:((Text.createElement ~superLongPunnedProp:((superLongPunnedProp) - [@res.namedArgLoc ]) - ~anotherSuperLongOneCrazyLongThingHere:((anotherSuperLongOneCrazyLongThingHere) - [@res.namedArgLoc ]) ~text:(({js|Age|js})[@res.namedArgLoc ]) - ~children:[] ())[@res.namedArgLoc ][@res.braces ][@JSX ]) - ~children:[child] ()) + ~term:((Text.createElement ~superLongPunnedProp + ~anotherSuperLongOneCrazyLongThingHere ~text:{js|Age|js} + ~children:[] ())[@res.braces ][@JSX ]) ~children:[child] ()) [@JSX ]) let _ = ((Foo.createElement - ~bar:((Baz.createElement ~superLongPunnedProp:((superLongPunnedProp) - [@res.namedArgLoc ]) - ~anotherSuperLongOneCrazyLongThingHere:((anotherSuperLongOneCrazyLongThingHere) - [@res.namedArgLoc ]) ~children:[] ()) - [@res.namedArgLoc ][@res.braces ][@JSX ]) ~children:[] ()) + ~bar:((Baz.createElement ~superLongPunnedProp + ~anotherSuperLongOneCrazyLongThingHere ~children:[] ()) + [@res.braces ][@JSX ]) ~children:[] ()) [@JSX ]) let _ = ((div ~children:[((span ~children:[str {js|hello|js}] ())[@JSX ])] ()) [@JSX ]) let _ = - ((description - ~term:((text ~text:(({js|Age|js})[@res.namedArgLoc ]) ~children:[] ()) - [@res.namedArgLoc ][@res.braces ][@JSX ]) ~children:[child] ()) + ((description ~term:((text ~text:{js|Age|js} ~children:[] ()) + [@res.braces ][@JSX ]) ~children:[child] ()) [@JSX ]) let _ = - ((description - ~term:((text ~text:(({js|Age|js})[@res.namedArgLoc ]) ~children:(( - [||])[@res.namedArgLoc ]) ()) - [@res.namedArgLoc ][@res.braces ]) ~children:[child] ()) + ((description ~term:((text ~text:{js|Age|js} ~children:[||] ()) + [@res.braces ]) ~children:[child] ()) [@JSX ]) let _ = - ((description - ~term:((text ~text:(({js|Age|js})[@res.namedArgLoc ]) ~children:(( - [||])[@res.namedArgLoc ])) - [@res.namedArgLoc ][@res.braces ][@JSX ]) ~children:[child] ()) + ((description ~term:((text ~text:{js|Age|js} ~children:[||]) + [@res.braces ][@JSX ]) ~children:[child] ()) [@JSX ]) let _ = - ((description ~term:((text ~text:(({js|Age|js})[@res.namedArgLoc ]) ()) - [@res.namedArgLoc ][@res.braces ][@JSX ]) ~children:[child] ()) + ((description ~term:((text ~text:{js|Age|js} ())[@res.braces ][@JSX ]) + ~children:[child] ()) [@JSX ]) let _ = ((description - ~term:((div ~superLongPunnedProp:((superLongPunnedProp) - [@res.namedArgLoc ]) - ~anotherSuperLongOneCrazyLongThingHere:((anotherSuperLongOneCrazyLongThingHere) - [@res.namedArgLoc ]) ~text:(({js|Age|js})[@res.namedArgLoc ]) - ~children:[] ())[@res.namedArgLoc ][@res.braces ][@JSX ]) + ~term:((div ~superLongPunnedProp ~anotherSuperLongOneCrazyLongThingHere + ~text:{js|Age|js} ~children:[] ())[@res.braces ][@JSX ]) ~children:[child] ()) [@JSX ]) let _ = - ((div ~onClick:((fun [arity:1]event -> handleChange event) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + ((div ~onClick:((fun [arity:1]event -> handleChange event)[@res.braces ]) + ~children:[] ()) [@JSX ]) let _ = ((div ~onClick:((fun [arity:1]eventWithLongIdent -> - handleChange eventWithLongIdent) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + handleChange eventWithLongIdent)[@res.braces ]) + ~children:[] ()) [@JSX ]) let _ = ((div ~onClick:((fun [arity:1]event -> ((Js.log event; handleChange event) - [@res.braces ]))[@res.namedArgLoc ][@res.braces ]) - ~children:[] ()) + [@res.braces ]))[@res.braces ]) ~children:[] ()) [@JSX ]) let _ = ((StaticDiv.createElement @@ -342,19 +289,18 @@ let _ = fun lineBreak -> fun identifier -> ((doStuff foo bar baz; bar lineBreak identifier) - [@res.braces ]))[@res.namedArgLoc ][@res.braces ]) - ~children:[] ()) + [@res.braces ]))[@res.braces ]) ~children:[] ()) [@JSX ]) let _ = ((AttrDiv.createElement ~onClick:((fun [arity:1]event -> handleChange event) - [@res.namedArgLoc ][@res.braces ][@bar ]) ~children:[] ()) + [@res.braces ][@bar ]) ~children:[] ()) [@JSX ]) let _ = ((AttrDiv.createElement ~onClick:((fun [arity:1]eventLongIdentifier -> - handleChange eventLongIdentifier) - [@res.namedArgLoc ][@res.braces ][@bar ]) ~children:[] ()) + handleChange eventLongIdentifier)[@res.braces ][@bar ]) + ~children:[] ()) [@JSX ]) let _ = ((StaticDivNamed.createElement @@ -363,20 +309,19 @@ let _ = fun ~baz -> fun ~lineBreak -> fun ~identifier -> - fun () -> bar lineBreak identifier) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + fun () -> bar lineBreak identifier)[@res.braces ]) + ~children:[] ()) [@JSX ]) let _ = ((div ~onClick:((fun [arity:1]e -> (((doStuff (); bar foo) - [@res.braces ]) : event)) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + [@res.braces ]) : event))[@res.braces ]) ~children:[] ()) [@JSX ]) let _ = ((div ~onClick:((fun [arity:2]e -> fun e2 -> (((doStuff (); bar foo)[@res.braces ]) : event)) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + [@res.braces ]) ~children:[] ()) [@JSX ]) let _ = ((div @@ -387,7 +332,7 @@ let _ = fun breakLine -> (((doStuff (); bar foo) [@res.braces ]) : (event * event2 * event3 * event4 * event5))) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + [@res.braces ]) ~children:[] ()) [@JSX ]) let _ = ((div @@ -397,8 +342,8 @@ let _ = fun superLongIdent -> fun breakLine -> (doStuff () : (event * event2 * event3 * event4 * - event5))) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + event5)))[@res.braces ]) + ~children:[] ()) [@JSX ]) let _ = ((div @@ -409,126 +354,91 @@ let _ = [@JSX ]) let _ = ((div - ~style:((ReactDOMRe.Style.make ~width:(({js|20px|js}) - [@res.namedArgLoc ]) ~height:(({js|20px|js}) - [@res.namedArgLoc ]) ~borderRadius:(({js|100%|js}) - [@res.namedArgLoc ]) ~backgroundColor:(({js|red|js}) - [@res.namedArgLoc ])) - [@res.namedArgLoc ][@res.braces ][@foo ]) ~children:[] ()) + ~style:((ReactDOMRe.Style.make ~width:{js|20px|js} ~height:{js|20px|js} + ~borderRadius:{js|100%|js} ~backgroundColor:{js|red|js}) + [@res.braces ][@foo ]) ~children:[] ()) [@JSX ]) let _ = - ((Animated.createElement ~initialValue:((0.0)[@res.namedArgLoc ]) - ~value:((value)[@res.namedArgLoc ]) - ~children:((ReactDOMRe.Style.make ~width:(({js|20px|js}) - [@res.namedArgLoc ]) ~height:(({js|20px|js}) - [@res.namedArgLoc ]) ~borderRadius:(({js|100%|js}) - [@res.namedArgLoc ]) ~backgroundColor:(({js|red|js}) - [@res.namedArgLoc ]))[@res.braces ]) ()) + ((Animated.createElement ~initialValue:0.0 ~value + ~children:((ReactDOMRe.Style.make ~width:{js|20px|js} + ~height:{js|20px|js} ~borderRadius:{js|100%|js} + ~backgroundColor:{js|red|js})[@res.braces ]) ()) [@JSX ]) let _ = - ((Animated.createElement ~initialValue:((0.0)[@res.namedArgLoc ]) - ~value:((value)[@res.namedArgLoc ]) + ((Animated.createElement ~initialValue:0.0 ~value ~children:((fun [arity:1]value -> ((div - ~style:((ReactDOMRe.Style.make ~width:(({js|20px|js}) - [@res.namedArgLoc ]) - ~height:(({js|20px|js}) - [@res.namedArgLoc ]) - ~borderRadius:(({js|100%|js}) - [@res.namedArgLoc ]) - ~backgroundColor:(({js|red|js}) - [@res.namedArgLoc ])) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + ~style:((ReactDOMRe.Style.make ~width:{js|20px|js} + ~height:{js|20px|js} + ~borderRadius:{js|100%|js} + ~backgroundColor:{js|red|js}) + [@res.braces ]) ~children:[] ()) [@JSX ]))[@res.braces ]) ()) [@JSX ]) let _ = - ((Animated.createElement ~initialValue:((0.0)[@res.namedArgLoc ]) - ~value:((value)[@res.namedArgLoc ]) + ((Animated.createElement ~initialValue:0.0 ~value ~children:((fun [arity:1]value -> (((div - ~style:((ReactDOMRe.Style.make - ~width:(({js|20px|js}) - [@res.namedArgLoc ]) - ~height:(({js|20px|js}) - [@res.namedArgLoc ]) - ~borderRadius:(({js|100%|js}) - [@res.namedArgLoc ]) - ~backgroundColor:(({js|red|js}) - [@res.namedArgLoc ])) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + ~style:((ReactDOMRe.Style.make ~width:{js|20px|js} + ~height:{js|20px|js} + ~borderRadius:{js|100%|js} + ~backgroundColor:{js|red|js}) + [@res.braces ]) ~children:[] ()) [@JSX ]) : ReasonReact.element))[@res.braces ]) ()) [@JSX ]) let _ = - ((Animated.createElement ~initialValue:((0.0)[@res.namedArgLoc ]) - ~value:((value)[@res.namedArgLoc ]) + ((Animated.createElement ~initialValue:0.0 ~value ~children:((fun [arity:1]value -> ((div - ~style:((ReactDOMRe.Style.make ~width:(({js|20px|js}) - [@res.namedArgLoc ]) - ~height:(({js|20px|js}) - [@res.namedArgLoc ]) - ~borderRadius:(({js|100%|js}) - [@res.namedArgLoc ]) - ~backgroundColor:(({js|red|js}) - [@res.namedArgLoc ])) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + ~style:((ReactDOMRe.Style.make ~width:{js|20px|js} + ~height:{js|20px|js} + ~borderRadius:{js|100%|js} + ~backgroundColor:{js|red|js}) + [@res.braces ]) ~children:[] ()) [@res.braces ][@JSX ]))[@res.braces ][@foo ]) ()) [@JSX ]) let _ = - ((Animated.createElement ~initialValue:((0.0)[@res.namedArgLoc ]) - ~value:((value)[@res.namedArgLoc ]) + ((Animated.createElement ~initialValue:0.0 ~value ~children:((fun [arity:1]value -> ((let width = {js|20px|js} in let height = {js|20px|js} in ((div - ~style:((ReactDOMRe.Style.make ~width:((width) - [@res.namedArgLoc ]) ~height:((height) - [@res.namedArgLoc ]) - ~borderRadius:(({js|100%|js}) - [@res.namedArgLoc ]) - ~backgroundColor:(({js|red|js}) - [@res.namedArgLoc ])) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + ~style:((ReactDOMRe.Style.make ~width ~height + ~borderRadius:{js|100%|js} + ~backgroundColor:{js|red|js}) + [@res.braces ]) ~children:[] ()) [@JSX ])) [@res.braces ]))[@res.braces ]) ()) [@JSX ]) let _ = - ((div ~callback:((reduce (fun [arity:1]() -> not state)) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + ((div ~callback:((reduce (fun [arity:1]() -> not state))[@res.braces ]) + ~children:[] ()) [@JSX ]) let _ = - ((button ?id:((id)[@res.namedArgLoc ]) - ~className:((Cn.make [|{js|button|js};{js|is-fullwidth|js}|]) - [@res.namedArgLoc ][@res.braces ]) ~onClick:((onClick) - [@res.namedArgLoc ]) ~children:[((ste {js|Submit|js})[@res.braces ])] - ()) + ((button ?id ~className:((Cn.make [|{js|button|js};{js|is-fullwidth|js}|]) + [@res.braces ]) ~onClick + ~children:[((ste {js|Submit|js})[@res.braces ])] ()) [@JSX ]) let _ = - ((button ?id:((id)[@res.namedArgLoc ]) - ~className:((Cn.make [{js|button|js}; {js|is-fullwidth|js}]) - [@res.namedArgLoc ][@res.braces ]) ~onClick:((onClick) - [@res.namedArgLoc ]) ~children:[((ste {js|Submit|js})[@res.braces ])] - ()) + ((button ?id ~className:((Cn.make [{js|button|js}; {js|is-fullwidth|js}]) + [@res.braces ]) ~onClick + ~children:[((ste {js|Submit|js})[@res.braces ])] ()) [@JSX ]) let _ = - ((button ?id:((id)[@res.namedArgLoc ]) - ~className:((Cn.make ({js|button|js}, {js|is-fullwidth|js})) - [@res.namedArgLoc ][@res.braces ]) ~onClick:((onClick) - [@res.namedArgLoc ]) ~children:[((ste {js|Submit|js})[@res.braces ])] - ()) + ((button ?id ~className:((Cn.make ({js|button|js}, {js|is-fullwidth|js})) + [@res.braces ]) ~onClick + ~children:[((ste {js|Submit|js})[@res.braces ])] ()) [@JSX ]) let _ = - ((button ?id:((id)[@res.namedArgLoc ]) ~className:((Cn.make { a = b }) - [@res.namedArgLoc ][@res.braces ]) ~onClick:((onClick) - [@res.namedArgLoc ]) ~children:[((ste {js|Submit|js})[@res.braces ])] - ()) + ((button ?id ~className:((Cn.make { a = b })[@res.braces ]) ~onClick + ~children:[((ste {js|Submit|js})[@res.braces ])] ()) [@JSX ]) let _ = ((X.createElement ~y:((z -> (Belt.Option.getWithDefault {js||js})) - [@res.namedArgLoc ][@res.braces ]) ~children:[] ()) + [@res.braces ]) ~children:[] ()) [@JSX ]) let _ = - ((div ~style:((getStyle ())[@res.namedArgLoc ][@res.braces ]) + ((div ~style:((getStyle ())[@res.braces ]) ~children:[((ReasonReact.string {js|BugTest|js})[@res.braces ])] ()) [@JSX ]) let _ = @@ -541,13 +451,10 @@ let _ = [@res.braces ])] ()) [@JSX ]) let _ = - ((View.createElement ~style:((styles#backgroundImageWrapper) - [@res.namedArgLoc ]) + ((View.createElement ~style:(styles#backgroundImageWrapper) ~children:[(((let uri = {js|/images/header-background.png|js} in - ((Image.createElement ~resizeMode:((Contain) - [@res.namedArgLoc ]) ~style:((styles#backgroundImage) - [@res.namedArgLoc ]) ~uri:((uri)[@res.namedArgLoc ]) - ~children:[] ()) + ((Image.createElement ~resizeMode:Contain + ~style:(styles#backgroundImage) ~uri ~children:[] ()) [@JSX ]))) [@res.braces ])] ()) [@JSX ]) @@ -558,9 +465,9 @@ let _ = (fun [arity:1]possibleGradeValue -> ((option ~key:((string_of_int possibleGradeValue) - [@res.namedArgLoc ][@res.braces ]) + [@res.braces ]) ~value:((string_of_int possibleGradeValue) - [@res.namedArgLoc ][@res.braces ]) + [@res.braces ]) ~children:[((str (string_of_int possibleGradeValue)) @@ -576,7 +483,7 @@ let _ = [@JSX ])] ())[@JSX ]) ;;((div ~children:[((div ~onClick:((fun [arity:1]_ -> Js.log (a <= 10)) - [@res.namedArgLoc ][@res.braces ]) + [@res.braces ]) ~children:[((div ~children:[((Js.log (a <= 10)) [@res.braces ])] ()) @@ -594,7 +501,5 @@ let _ = ;;(([[|a|]])[@JSX ]) ;;(([(1, 2)])[@JSX ]) ;;(([((array -> f)[@res.braces ])])[@JSX ]) -let _ = - ((A.createElement ~x:(({js|y|js})[@res.namedArgLoc ]) ~_spreadProps:((str) - [@res.namedArgLoc ]) ~children:[] ()) +let _ = ((A.createElement ~x:{js|y|js} ~_spreadProps:str ~children:[] ()) [@JSX ]) \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/parenthesized.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/parenthesized.res.txt index 871890abac..9640bcb5fe 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/parenthesized.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/parenthesized.res.txt @@ -16,9 +16,7 @@ let aTuple = (1, 2) let aRecord = { name = {js|steve|js}; age = 30 } let blockExpression = ((let a = 1 in let b = 2 in a + b)[@res.braces ]) let assertSmthing = assert true -let jsx = - ((div ~className:(({js|cx|js})[@res.namedArgLoc ]) ~children:[foo] ()) - [@JSX ]) +let jsx = ((div ~className:{js|cx|js} ~children:[foo] ())[@JSX ]) let ifExpr = if true then Js.log true else Js.log false let forExpr = for p = 0 to 10 do () done let whileExpr = while true do doSomeImperativeThing () done diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/primary.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/primary.res.txt index f7aabdd001..b825a969be 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/primary.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/primary.res.txt @@ -18,15 +18,9 @@ let x = (arr.((x : int))).((y : int)) ;;f (x : int) ;;f a b c ;;f a b c -;;f ~a:((a)[@res.namedArgLoc ]) ~b:((bArg)[@res.namedArgLoc ]) ?c:((c) - [@res.namedArgLoc ]) ?d:((expr)[@res.namedArgLoc ]) -;;((f ~a:((a)[@res.namedArgLoc ]) ~b:((bArg)[@res.namedArgLoc ]) ?c:((c) - [@res.namedArgLoc ]) ?d:((expr)[@res.namedArgLoc ])) ~a:((a) - [@res.namedArgLoc ]) ~b:((bArg)[@res.namedArgLoc ]) ?c:((c) - [@res.namedArgLoc ]) ?d:((expr)[@res.namedArgLoc ])) ~a:((a) - [@res.namedArgLoc ]) ~b:((bArg)[@res.namedArgLoc ]) ?c:((c) - [@res.namedArgLoc ]) ?d:((expr)[@res.namedArgLoc ]) -;;f ~a:(((x : int))[@res.namedArgLoc ]) ?b:(((y : int))[@res.namedArgLoc ]) +;;f ~a ~b:bArg ?c ?d:expr +;;((f ~a ~b:bArg ?c ?d:expr) ~a ~b:bArg ?c ?d:expr) ~a ~b:bArg ?c ?d:expr +;;f ~a:(x : int) ?b:(y : int) ;;connection#platformId ;;((connection#left)#account)#accountName ;;john#age #= 99 diff --git a/tests/syntax_tests/data/parsing/grammar/pattern/expected/firstClassModules.res.txt b/tests/syntax_tests/data/parsing/grammar/pattern/expected/firstClassModules.res.txt index a538484514..072909bd18 100644 --- a/tests/syntax_tests/data/parsing/grammar/pattern/expected/firstClassModules.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/pattern/expected/firstClassModules.res.txt @@ -8,7 +8,7 @@ let sort (type s) let foo [arity:2](module Foo) baz = Foo.bar baz let bump_list (type a) [arity:2]((module B) : (module Bumpable with type t = a)) (l : a list) = - List.map ~f:((B.bump l)[@res.namedArgLoc ]) + List.map ~f:(B.bump l) ;;match x with | (module Set) -> () | ((module Set) : (module Set.S with type elt = s)) -> () diff --git a/tests/syntax_tests/data/parsing/grammar/typexpr/expected/es6Arrow.res.txt b/tests/syntax_tests/data/parsing/grammar/typexpr/expected/es6Arrow.res.txt index 62e7c445db..aa42f44491 100644 --- a/tests/syntax_tests/data/parsing/grammar/typexpr/expected/es6Arrow.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/typexpr/expected/es6Arrow.res.txt @@ -12,15 +12,15 @@ let (t : a:int -> b:int -> int (a:2)) = xf let (t : ?a:int -> ?b:int -> int (a:2)) = xf let (t : int -> int -> int -> int (a:1) (a:1) (a:1)) = xf let (t : a:int -> b:int -> c:int -> int (a:1) (a:1) (a:1)) = xf -type nonrec t = f:((int)[@res.namedArgLoc ]) -> string -type nonrec t = ?f:((int)[@res.namedArgLoc ]) -> string -let (f : f:((int)[@res.namedArgLoc ]) -> string) = fx -let (f : ?f:((int)[@res.namedArgLoc ]) -> string) = fx +type nonrec t = f:int -> string +type nonrec t = ?f:int -> string +let (f : f:int -> string) = fx +let (f : ?f:int -> string) = fx type nonrec t = f:int -> string (a:1) -type nonrec t = f:((int)[@res.namedArgLoc ]) -> string +type nonrec t = f:int -> string type nonrec t = f:(int -> string (a:1)) -> float (a:1) -type nonrec t = f:((int -> string (a:1))[@res.namedArgLoc ]) -> float -type nonrec t = f:((int)[@res.namedArgLoc ]) -> string -> float (a:1) +type nonrec t = f:(int -> string (a:1)) -> float +type nonrec t = f:int -> string -> float (a:1) type nonrec t = ((a:int -> ((b:int -> ((float)[@attr ]) -> unit)[@attrBeforeLblB ]) (a:3)) [@attrBeforeLblA ]) @@ -28,7 +28,7 @@ type nonrec t = ((a:int -> ((b:int -> ((float)[@attr ]) -> unit (a:1) (a:1))[@attrBeforeLblB ]) (a:1)) [@attrBeforeLblA ]) -type nonrec t = ((a:((int)[@res.namedArgLoc ]) -> unit)[@attr ]) +type nonrec t = ((a:int -> unit)[@attr ]) type nonrec 'a getInitialPropsFn = < query: string dict ;req: 'a Js.t Js.Nullable.t > -> 'a Js.t Js.Promise.t (a:1) \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/infiniteLoops/expected/nonRecTypes.res.txt b/tests/syntax_tests/data/parsing/infiniteLoops/expected/nonRecTypes.res.txt index 737105ab8c..1d67914ae9 100644 --- a/tests/syntax_tests/data/parsing/infiniteLoops/expected/nonRecTypes.res.txt +++ b/tests/syntax_tests/data/parsing/infiniteLoops/expected/nonRecTypes.res.txt @@ -141,9 +141,8 @@ include match successor with | None -> let leaf = - createNode ~value:((Js.Internal.raw_expr {js|0|js}) - [@res.namedArgLoc ]) ~color:((Black)[@res.namedArgLoc ]) - ~height:((0.)[@res.namedArgLoc ]) in + createNode ~value:(Js.Internal.raw_expr {js|0|js}) + ~color:Black ~height:0. in let isLeaf = Js.Internal.fn_mk1 (fun [arity:1]x -> x === leaf) in (leaf, isLeaf) | Some successor -> @@ -153,8 +152,7 @@ include (match nodeParent with | None -> () | Some parent -> - leftOrRightSet parent ~node:((nodeToRemove)[@res.namedArgLoc ]) - (Some successor)); + leftOrRightSet parent ~node:nodeToRemove (Some successor)); updateSumRecursive rbt successor; if (colorGet nodeToRemove) === Black then @@ -276,9 +274,7 @@ include (if (rootGet rbt) === (Some successor) then rootSet rbt None; (match parentGet successor with | None -> () - | Some parent -> - leftOrRightSet parent ~node:((successor)[@res.namedArgLoc ]) - None))) + | Some parent -> leftOrRightSet parent ~node:successor None))) [@res.braces ]) let remove [arity:2]rbt value = match _findNode rbt (rootGet rbt) value with @@ -303,9 +299,7 @@ include | None -> None | Some node -> Some (valueGet node)) [@res.braces ]) - let make [arity:1]~compare = - t ~size:((0)[@res.namedArgLoc ]) ~root:((None)[@res.namedArgLoc ]) - ~compare:((compare)[@res.namedArgLoc ]) + let make [arity:1]~compare = t ~size:0 ~root:None ~compare let rec heightOfInterval [arity:4]rbt node lhs rhs = match node with | None -> 0. @@ -383,12 +377,10 @@ include | Some parent -> leftSpine +. (sumLeftSpine parent - ~fromRightChild:(((rightGet parent) === (Some node)) - [@res.namedArgLoc ]))) + ~fromRightChild:((rightGet parent) === (Some node)))) [@res.braces ]) let getY [arity:1]node = - (sumLeftSpine node ~fromRightChild:((true)[@res.namedArgLoc ])) -. - (heightGet node) + (sumLeftSpine node ~fromRightChild:true) -. (heightGet node) let linearSearch [arity:2]rbt callback = ((let rec find [arity:2]node callback = if Js.Internal.fn_run1 callback (valueGet node) @@ -409,9 +401,7 @@ include if (!==) firstNode lastNode then (if not inclusive then Js.Internal.fn_run1 callback node; - iterate ~inclusive:((inclusive)[@res.namedArgLoc ]) - (nextNode node) lastNode ~callback:((callback) - [@res.namedArgLoc ]))) + iterate ~inclusive (nextNode node) lastNode ~callback)) let rec iterateWithY [arity:5]?y ~inclusive firstNode lastNode ~callback = match firstNode with @@ -422,22 +412,20 @@ include if (!==) firstNode lastNode then (if not inclusive then Js.Internal.fn_run2 callback node y; - iterateWithY ~y:((y +. (heightGet node))[@res.namedArgLoc ]) - ~inclusive:((inclusive)[@res.namedArgLoc ]) (nextNode node) - lastNode ~callback:((callback)[@res.namedArgLoc ]))) + iterateWithY ~y:(y +. (heightGet node)) ~inclusive + (nextNode node) lastNode ~callback)) let rec updateSum [arity:2]node ~delta = match node with | None -> () | Some node -> (sumSet node ((sumGet node) +. delta); - updateSum (parentGet node) ~delta:((delta)[@res.namedArgLoc ])) + updateSum (parentGet node) ~delta) let setHeight [arity:3]rbt value ~height = match _findNode rbt (rootGet rbt) value with | None -> () | Some node -> let delta = height -. (heightGet node) in - (heightSet node height; - updateSum (Some node) ~delta:((delta)[@res.namedArgLoc ])) + (heightSet node height; updateSum (Some node) ~delta) type nonrec 'value oldNewVisibleNodes = { mutable old: 'value array ; diff --git a/tests/syntax_tests/data/ppx/react/expected/externalWithCustomName.res.txt b/tests/syntax_tests/data/ppx/react/expected/externalWithCustomName.res.txt index 93680d0ead..3eadedfee0 100644 --- a/tests/syntax_tests/data/ppx/react/expected/externalWithCustomName.res.txt +++ b/tests/syntax_tests/data/ppx/react/expected/externalWithCustomName.res.txt @@ -8,7 +8,7 @@ module Foo = { external component: React.componentLike, React.element> = "component" } -let t = React.createElement(Foo.component, {a: 1, b: "1"}) +let t = React.createElement(Foo.component, {a: 1, b: {"1"}}) @@jsxConfig({version: 4, mode: "automatic"}) @@ -20,4 +20,4 @@ module Foo = { external component: React.componentLike, React.element> = "component" } -let t = React.jsx(Foo.component, {a: 1, b: "1"}) +let t = React.jsx(Foo.component, {a: 1, b: {"1"}}) diff --git a/tests/syntax_tests/data/ppx/react/expected/forwardRef.res.txt b/tests/syntax_tests/data/ppx/react/expected/forwardRef.res.txt index 6f5d0caad5..84afe72df2 100644 --- a/tests/syntax_tests/data/ppx/react/expected/forwardRef.res.txt +++ b/tests/syntax_tests/data/ppx/react/expected/forwardRef.res.txt @@ -21,7 +21,7 @@ module V4C = { ~props={ type_: "text", ?className, - ref: ?(Js.Nullable.toOption(ref)->Belt.Option.map(React.Ref.domRef)), + ref: ?{Js.Nullable.toOption(ref)->Belt.Option.map(React.Ref.domRef)}, }, [], ), @@ -78,7 +78,7 @@ module V4CUncurried = { ~props={ type_: "text", ?className, - ref: ?(Js.Nullable.toOption(ref)->Belt.Option.map(React.Ref.domRef)), + ref: ?{Js.Nullable.toOption(ref)->Belt.Option.map(React.Ref.domRef)}, }, [], ), @@ -135,7 +135,7 @@ module V4A = { { type_: "text", ?className, - ref: ?(Js.Nullable.toOption(ref)->Belt.Option.map(ReactDOM.Ref.domRef)), + ref: ?{Js.Nullable.toOption(ref)->Belt.Option.map(ReactDOM.Ref.domRef)}, }, ), children, @@ -189,7 +189,7 @@ module V4AUncurried = { { type_: "text", ?className, - ref: ?(Js.Nullable.toOption(ref)->Belt.Option.map(ReactDOM.Ref.domRef)), + ref: ?{Js.Nullable.toOption(ref)->Belt.Option.map(ReactDOM.Ref.domRef)}, }, ), children, diff --git a/tests/syntax_tests/data/ppx/react/expected/uncurriedProps.res.txt b/tests/syntax_tests/data/ppx/react/expected/uncurriedProps.res.txt index 28da95c83e..3cd05a73c2 100644 --- a/tests/syntax_tests/data/ppx/react/expected/uncurriedProps.res.txt +++ b/tests/syntax_tests/data/ppx/react/expected/uncurriedProps.res.txt @@ -51,7 +51,7 @@ module Bar = { @res.jsxComponentProps type props = {} - let make = (_: props) => React.jsx(Foo.make, {callback: (_, _, _) => ()}) + let make = (_: props) => React.jsx(Foo.make, {callback: {(_, _, _) => ()}}) let make = { let \"UncurriedProps$Bar" = props => make(props)