From 25c45ecb31895da7ad1f92e45f35aea483aad279 Mon Sep 17 00:00:00 2001 From: Cristiano Calcagno Date: Sat, 25 Jan 2025 12:03:35 +0100 Subject: [PATCH] Use identical variant names for `arg_label` and `arg_label_loc`. In several places, additional type annotations need to be added to disambiguate which definition is used: with or without location. In exchange, the naming is uniform. --- analysis/reanalyze/src/Arnold.ml | 4 +- analysis/reanalyze/src/DeadValue.ml | 2 +- analysis/src/CompletionBackEnd.ml | 4 +- analysis/src/CompletionFrontEnd.ml | 13 +- analysis/src/CompletionJsx.ml | 5 +- analysis/src/CreateInterface.ml | 4 +- analysis/src/DumpAst.ml | 6 +- analysis/src/SemanticTokens.ml | 2 +- analysis/src/SharedTypes.ml | 8 +- analysis/src/SignatureHelp.ml | 15 +- analysis/src/TypeUtils.ml | 4 +- analysis/src/Xform.ml | 4 +- compiler/frontend/ast_compatible.ml | 29 ++-- compiler/frontend/ast_core_type.ml | 2 +- compiler/frontend/ast_core_type_class_type.ml | 2 +- compiler/frontend/ast_exp_apply.ml | 7 +- compiler/frontend/ast_exp_extension.ml | 2 +- compiler/frontend/ast_exp_handle_external.ml | 19 ++- compiler/frontend/ast_external_process.ml | 16 +- compiler/frontend/ast_uncurry_gen.ml | 2 +- compiler/frontend/bs_syntaxerr.ml | 4 +- compiler/ml/ast_async.ml | 2 +- compiler/ml/ast_await.ml | 4 +- compiler/ml/ast_mapper_to0.ml | 12 +- compiler/ml/asttypes.ml | 34 ++--- compiler/ml/btype.ml | 12 +- compiler/ml/pprintast.ml | 26 ++-- compiler/ml/printast.ml | 6 +- compiler/ml/printtyp.ml | 2 +- compiler/ml/printtyped.ml | 2 +- compiler/ml/typecore.ml | 20 +-- compiler/syntax/src/jsx_common.ml | 2 +- compiler/syntax/src/jsx_v4.ml | 112 ++++++++------ compiler/syntax/src/res_ast_debugger.ml | 8 +- compiler/syntax/src/res_comments_table.ml | 51 ++++--- compiler/syntax/src/res_core.ml | 139 +++++++++--------- compiler/syntax/src/res_parsetree_viewer.ml | 32 ++-- compiler/syntax/src/res_printer.ml | 128 ++++++++-------- 38 files changed, 400 insertions(+), 346 deletions(-) diff --git a/analysis/reanalyze/src/Arnold.ml b/analysis/reanalyze/src/Arnold.ml index 70d1f97924..b20fc75a73 100644 --- a/analysis/reanalyze/src/Arnold.ml +++ b/analysis/reanalyze/src/Arnold.ml @@ -761,7 +761,7 @@ module Compile = struct let argsFromKind = innerFunctionDefinition.kind |> List.map (fun (entry : Kind.entry) -> - ( Asttypes.Labelled entry.label, + ( (Asttypes.Labelled entry.label : Asttypes.arg_label), Some { expr with @@ -785,7 +785,7 @@ module Compile = struct args |> List.find_opt (fun arg -> match arg with - | Asttypes.Labelled s, Some _ -> s = label + | (Labelled s : Asttypes.arg_label), Some _ -> s = label | _ -> false) in let argOpt = diff --git a/analysis/reanalyze/src/DeadValue.ml b/analysis/reanalyze/src/DeadValue.ml index 9c07e696ae..0282c4cc20 100644 --- a/analysis/reanalyze/src/DeadValue.ml +++ b/analysis/reanalyze/src/DeadValue.ml @@ -104,7 +104,7 @@ let processOptionalArgs ~expType ~(locFrom : Location.t) ~locTo ~path args = | None -> Some false in match lbl with - | Asttypes.Optional s when not locFrom.loc_ghost -> + | (Optional s : Asttypes.arg_label) when not locFrom.loc_ghost -> if argIsSupplied <> Some false then supplied := s :: !supplied; if argIsSupplied = None then suppliedMaybe := s :: !suppliedMaybe | _ -> ()); diff --git a/analysis/src/CompletionBackEnd.ml b/analysis/src/CompletionBackEnd.ml index 3982783510..505a4f3b74 100644 --- a/analysis/src/CompletionBackEnd.ml +++ b/analysis/src/CompletionBackEnd.ml @@ -952,7 +952,9 @@ and getCompletionsForContextPath ~debug ~full ~opens ~rawOpens ~pos ~env ~exact (* compute the application of the first label, then the next ones *) let args = processApply args [label] in processApply args nextLabels - | (Asttypes.Nolabel, _) :: nextArgs, [Asttypes.Nolabel] -> nextArgs + | ( ((Nolabel : Asttypes.arg_label), _) :: nextArgs, + [(Nolabel : Asttypes.arg_label)] ) -> + nextArgs | ((Labelled _, _) as arg) :: nextArgs, [Nolabel] -> arg :: processApply nextArgs labels | (Optional _, _) :: nextArgs, [Nolabel] -> processApply nextArgs labels diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index e389266094..91d115c92c 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -268,7 +268,8 @@ let rec exprToContextPathInner (e : Parsetree.expression) = (* Transform away pipe with apply call *) exprToContextPath { - pexp_desc = Pexp_apply {funct = d; args = (Nolbl, lhs) :: args; partial}; + pexp_desc = + Pexp_apply {funct = d; args = (Nolabel, lhs) :: args; partial}; pexp_loc; pexp_attributes; } @@ -288,7 +289,7 @@ let rec exprToContextPathInner (e : Parsetree.expression) = Pexp_apply { funct = {pexp_desc = Pexp_ident id; pexp_loc; pexp_attributes}; - args = [(Nolbl, lhs)]; + args = [(Nolabel, lhs)]; partial; }; pexp_loc; @@ -1437,7 +1438,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor | Some (ctxPath, currentUnlabelledCount) -> (processingFun := match lbl with - | Nolbl -> Some (ctxPath, currentUnlabelledCount + 1) + | Nolabel -> Some (ctxPath, currentUnlabelledCount + 1) | _ -> Some (ctxPath, currentUnlabelledCount)); if Debug.verbose () then print_endline "[expr_iter] Completing for argument value"; @@ -1447,10 +1448,10 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor functionContextPath = ctxPath; argumentLabel = (match lbl with - | Nolbl -> + | Nolabel -> Unlabelled {argumentPosition = currentUnlabelledCount} - | Opt {txt = name} -> Optional name - | Lbl {txt = name} -> Labelled name); + | Optional {txt = name} -> Optional name + | Labelled {txt = name} -> Labelled name); }) in (match defaultExpOpt with diff --git a/analysis/src/CompletionJsx.ml b/analysis/src/CompletionJsx.ml index 9cf791f71e..5014a665c8 100644 --- a/analysis/src/CompletionJsx.ml +++ b/analysis/src/CompletionJsx.ml @@ -465,14 +465,15 @@ let extractJsxProps ~(compName : Longident.t Location.loc) ~args = in let rec processProps ~acc args = match args with - | (Asttypes.Lbl {txt = "children"}, {Parsetree.pexp_loc}) :: _ -> + | (Asttypes.Labelled {txt = "children"}, {Parsetree.pexp_loc}) :: _ -> { compName; props = List.rev acc; childrenStart = (if pexp_loc.loc_ghost then None else Some (Loc.start pexp_loc)); } - | ((Lbl {txt = s; loc} | Opt {txt = s; loc}), (eProp : Parsetree.expression)) + | ( (Labelled {txt = s; loc} | Optional {txt = s; loc}), + (eProp : Parsetree.expression) ) :: rest -> ( let namedArgLoc = if loc = Location.none then None else Some loc in match namedArgLoc with diff --git a/analysis/src/CreateInterface.ml b/analysis/src/CreateInterface.ml index 962ea4469c..010e455647 100644 --- a/analysis/src/CreateInterface.ml +++ b/analysis/src/CreateInterface.ml @@ -169,8 +169,8 @@ let printSignature ~extractor ~signature = labelDecl.ld_type in let lblName = labelDecl.ld_id |> Ident.name in - let lbl = - if labelDecl.ld_optional then Asttypes.Optional lblName + let lbl : Asttypes.arg_label = + if labelDecl.ld_optional then Optional lblName else Labelled lblName in { diff --git a/analysis/src/DumpAst.ml b/analysis/src/DumpAst.ml index 5431e62c66..627cd8106e 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 - | Nolbl -> "Nolabel" - | Lbl {txt = name} -> "Labelled(" ^ name ^ ")" - | Opt {txt = name} -> "Optional(" ^ name ^ ")") + | Nolabel -> "Nolabel" + | Labelled {txt = name} -> "Labelled(" ^ name ^ ")" + | Optional {txt = name} -> "Optional(" ^ name ^ ")") ^ ",\n" ^ addIndentation (indentation + 2) ^ "pattern: " diff --git a/analysis/src/SemanticTokens.ml b/analysis/src/SemanticTokens.ml index 7fc3fbee95..cbd435a5c4 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.Lbl {txt = "children"}, {Parsetree.pexp_loc}) :: _ -> + | (Asttypes.Labelled {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 4104e6a43e..861510e653 100644 --- a/analysis/src/SharedTypes.ml +++ b/analysis/src/SharedTypes.ml @@ -692,7 +692,7 @@ module Completable = struct contextPathToString cp ^ "(" ^ (labels |> List.map (function - | Asttypes.Nolabel -> "Nolabel" + | (Nolabel : Asttypes.arg_label) -> "Nolabel" | Labelled s -> "~" ^ s | Optional s -> "?" ^ s) |> String.concat ", ") @@ -898,7 +898,7 @@ type arg = {label: label; exp: Parsetree.expression} let extractExpApplyArgs ~args = let rec processArgs ~acc args = match args with - | ( ((Asttypes.Lbl {txt = s; loc} | Opt {txt = s; loc}) as label), + | ( ((Asttypes.Labelled {txt = s; loc} | Optional {txt = s; loc}) as label), (e : Parsetree.expression) ) :: rest -> ( let namedArgLoc = if loc = Location.none then None else Some loc in @@ -909,7 +909,7 @@ let extractExpApplyArgs ~args = name = s; opt = (match label with - | Opt _ -> true + | Optional _ -> true | _ -> false); posStart = Loc.start loc; posEnd = Loc.end_ loc; @@ -917,7 +917,7 @@ let extractExpApplyArgs ~args = in processArgs ~acc:({label = Some labelled; exp = e} :: acc) rest | None -> processArgs ~acc rest) - | (Nolbl, (e : Parsetree.expression)) :: rest -> + | (Nolabel, (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 9ac55d3817..cf7150d566 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.Opt _ -> endOffset + 2 + | Asttypes.Optional _ -> endOffset + 2 | _ -> endOffset in extractParams nextFunctionExpr @@ -154,14 +154,15 @@ let findActiveParameter ~argAtCursor ~args = (* If a function only has one, unlabelled argument, we can safely assume that's active whenever we're in the signature help for that function, even if we technically didn't find anything at the cursor (which we don't for empty expressions). *) match args with - | [(Asttypes.Nolabel, _)] -> Some 0 + | [((Nolabel : Asttypes.arg_label), _)] -> Some 0 | _ -> None) | Some (Unlabelled unlabelledArgumentIndex) -> let index = ref 0 in args |> List.find_map (fun (label, _) -> match label with - | Asttypes.Nolabel when !index = unlabelledArgumentIndex -> + | (Nolabel : Asttypes.arg_label) + when !index = unlabelledArgumentIndex -> Some !index | _ -> index := !index + 1; @@ -169,10 +170,9 @@ let findActiveParameter ~argAtCursor ~args = | Some (Labelled name) -> let index = ref 0 in args - |> List.find_map (fun (label, _) -> + |> List.find_map (fun ((label : Asttypes.arg_label), _) -> match label with - | (Asttypes.Labelled labelName | Optional labelName) - when labelName = name -> + | (Labelled labelName | Optional labelName) when labelName = name -> Some !index | _ -> index := !index + 1; @@ -483,7 +483,8 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = documentation = (match args - |> List.find_opt (fun (lbl, _) -> + |> List.find_opt + (fun ((lbl : Asttypes.arg_label), _) -> let argCount = !unlabelledArgCount in unlabelledArgCount := argCount + 1; match (lbl, argLabel) with diff --git a/analysis/src/TypeUtils.ml b/analysis/src/TypeUtils.ml index 23d504d6d6..e17cb89de4 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}) - [(Nolbl, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))] + [(Nolabel, Ast_helper.Exp.constant (Pconst_string ("TODO", None)))] let mkConstructPat ?payload name = Ast_helper.Pat.construct @@ -1123,7 +1123,7 @@ let getFirstFnUnlabelledArgType ~env ~full t = in let rec findFirstUnlabelledArgType labels = match labels with - | (Asttypes.Nolabel, t) :: _ -> Some t + | ((Nolabel : Asttypes.arg_label), t) :: _ -> Some t | _ :: rest -> findFirstUnlabelledArgType rest | [] -> None in diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml index e9f083ce75..837f7df744 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 = [(Nolbl, arg1); (Nolbl, arg2)]; + args = [(Nolabel, arg1); (Nolabel, 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 = Nolbl + argNum = 1 && arg_label = Nolabel && match e.pexp_desc with | Pexp_fun _ -> false diff --git a/compiler/frontend/ast_compatible.ml b/compiler/frontend/ast_compatible.ml index a25860cd0d..976d394b59 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 Nolbl a b + Ast_helper.Typ.arrow ?loc ?attrs ~arity Nolabel a b let apply_simple ?(loc = default_loc) ?(attrs = []) (fn : expression) (args : expression list) : expression = @@ -42,7 +42,8 @@ let apply_simple ?(loc = default_loc) ?(attrs = []) (fn : expression) Pexp_apply { funct = fn; - args = Ext_list.map args (fun x -> (Asttypes.Nolbl, x)); + args = + Ext_list.map args (fun x -> ((Nolabel : Asttypes.arg_label_loc), x)); partial = false; }; } @@ -51,7 +52,8 @@ let app1 ?(loc = default_loc) ?(attrs = []) fn arg1 : expression = { pexp_loc = loc; pexp_attributes = attrs; - pexp_desc = Pexp_apply {funct = fn; args = [(Nolbl, arg1)]; partial = false}; + pexp_desc = + Pexp_apply {funct = fn; args = [(Nolabel, arg1)]; partial = false}; } let app2 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 : expression = @@ -60,7 +62,7 @@ let app2 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 : expression = pexp_attributes = attrs; pexp_desc = Pexp_apply - {funct = fn; args = [(Nolbl, arg1); (Nolbl, arg2)]; partial = false}; + {funct = fn; args = [(Nolabel, arg1); (Nolabel, arg2)]; partial = false}; } let app3 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 arg3 : expression = @@ -71,7 +73,7 @@ let app3 ?(loc = default_loc) ?(attrs = []) fn arg1 arg2 arg3 : expression = Pexp_apply { funct = fn; - args = [(Nolbl, arg1); (Nolbl, arg2); (Nolbl, arg3)]; + args = [(Nolabel, arg1); (Nolabel, arg2); (Nolabel, arg3)]; partial = false; }; } @@ -82,7 +84,14 @@ let fun_ ?(loc = default_loc) ?(attrs = []) ?(async = false) ~arity pat exp = pexp_attributes = attrs; pexp_desc = Pexp_fun - {arg_label = Nolbl; default = None; lhs = pat; rhs = exp; arity; async}; + { + arg_label = Nolabel; + default = None; + lhs = pat; + rhs = exp; + arity; + async; + }; } let const_exp_string ?(loc = default_loc) ?(attrs = []) ?delimiter (s : string) @@ -111,7 +120,9 @@ let apply_labels ?(loc = default_loc) ?(attrs = []) fn funct = fn; args = Ext_list.map args (fun (l, a) -> - (Asttypes.Lbl {txt = l; loc = Location.none}, a)); + ( (Labelled {txt = l; loc = Location.none} + : Asttypes.arg_label_loc), + a )); partial = false; }; } @@ -120,7 +131,7 @@ let label_arrow ?(loc = default_loc) ?(attrs = []) ~arity txt arg ret : core_type = { ptyp_desc = - Ptyp_arrow {lbl = Asttypes.Lbl {txt; loc = default_loc}; arg; ret; arity}; + Ptyp_arrow {lbl = Labelled {txt; loc = default_loc}; arg; ret; arity}; ptyp_loc = loc; ptyp_attributes = attrs; } @@ -129,7 +140,7 @@ let opt_arrow ?(loc = default_loc) ?(attrs = []) ~arity txt arg ret : core_type = { ptyp_desc = - Ptyp_arrow {lbl = Asttypes.Opt {txt; loc = default_loc}; arg; ret; arity}; + Ptyp_arrow {lbl = Optional {txt; loc = default_loc}; arg; ret; arity}; ptyp_loc = loc; ptyp_attributes = attrs; } diff --git a/compiler/frontend/ast_core_type.ml b/compiler/frontend/ast_core_type.ml index f084ad8184..2439b73204 100644 --- a/compiler/frontend/ast_core_type.ml +++ b/compiler/frontend/ast_core_type.ml @@ -171,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 = Nolbl; ty = obj; attr = []; loc = obj.ptyp_loc}]) + (params @ [{label = Nolabel; ty = obj; attr = []; loc = obj.ptyp_loc}]) result diff --git a/compiler/frontend/ast_core_type_class_type.ml b/compiler/frontend/ast_core_type_class_type.ml index 2d5a3f1ace..5af87136a8 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 Nolbl core_type + (Ast_typ_uncurry.to_uncurry_type loc self Nolabel 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 640cc23672..fb5b500db9 100644 --- a/compiler/frontend/ast_exp_apply.ml +++ b/compiler/frontend/ast_exp_apply.ml @@ -91,7 +91,8 @@ 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 = (Nolbl, a) :: args; partial}; + pexp_desc = + Pexp_apply {funct = fn1; args = (Nolabel, a) :: args; partial}; pexp_loc = e.pexp_loc; pexp_attributes = e.pexp_attributes @ f.pexp_attributes; } @@ -115,7 +116,7 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) : exp = Pexp_apply { funct = fn; - args = (Nolbl, bounded_obj_arg) :: args; + args = (Nolabel, bounded_obj_arg) :: args; partial = false; }; pexp_attributes = []; @@ -169,7 +170,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 [(Nolbl, arg)]) + (Exp.apply ~loc fn [(Nolabel, 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 89c86ce93e..47405da03d 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}) [ - ( Nolbl, + ( Nolabel, 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 4165232be9..437e12dbe2 100644 --- a/compiler/frontend/ast_exp_handle_external.ml +++ b/compiler/frontend/ast_exp_handle_external.ml @@ -43,7 +43,8 @@ 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) Nolbl (Typ.any ()) (Typ.any ())) + ~pval_type: + (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) (Typ.any ())) [str_exp]; } in @@ -69,7 +70,8 @@ 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) Nolbl (Typ.any ()) (Ast_literal.type_unit ())) + (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) + (Ast_literal.type_unit ())) [Ast_literal.val_unit ~loc ()] | _ -> Location.raise_errorf ~loc "%%debugger extension doesn't accept arguments" @@ -93,7 +95,8 @@ 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) Nolbl (Typ.any ()) (Typ.any ())) + ~pval_type: + (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) (Typ.any ())) [exp]; pexp_attributes = (match !is_function with @@ -120,11 +123,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 Nolbl unit any + if arity = 0 then Ast_helper.Typ.arrow ~arity:None ~loc Nolabel unit any else if arity = 1 then - Ast_helper.Typ.arrow ~arity:None ~loc Nolbl any any + Ast_helper.Typ.arrow ~arity:None ~loc Nolabel any any else - Ast_helper.Typ.arrow ~loc ~arity:None Nolbl any + Ast_helper.Typ.arrow ~loc ~arity:None Nolabel any (arrow ~arity:(arity - 1)) in match !is_function with @@ -143,7 +146,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) Nolbl (Typ.any ()) (Typ.any ())) + (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) (Typ.any ())) [exp]; pexp_attributes = (match !is_function with @@ -160,7 +163,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) Nolbl (Typ.any ()) (Typ.any ())) + (Typ.arrow ~arity:(Some 1) Nolabel (Typ.any ()) (Typ.any ())) [exp]; } | None -> diff --git a/compiler/frontend/ast_external_process.ml b/compiler/frontend/ast_external_process.ml index b727ea5024..4753594c55 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 - | Nolbl -> ( + | Nolabel -> ( 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") - | Lbl {txt = label} -> ( + | Labelled {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) - | Opt {txt = label} -> ( + | Optional {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 - | Opt _ -> + | Optional _ -> Location.raise_errorf ~loc "%@variadic expect the last type to be a non optional" - | Lbl _ | Nolbl -> ( + | Labelled _ | Nolabel -> ( 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 - | Opt {txt = s} -> ( + | Optional {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)) - | Lbl _ -> ( + | Labelled _ -> ( 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 )) - | Nolbl -> ( + | Nolabel -> ( let arg_type = refine_arg_type ~nolabel:true ty in ( Arg_empty, arg_type, diff --git a/compiler/frontend/ast_uncurry_gen.ml b/compiler/frontend/ast_uncurry_gen.ml index 9da0be6f49..70e4e2d550 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 = [ - ( Nolbl, + ( Nolabel, Exp.constraint_ ~loc (Exp.record ~loc [ diff --git a/compiler/frontend/bs_syntaxerr.ml b/compiler/frontend/bs_syntaxerr.ml index 7919064aa5..48e57e8481 100644 --- a/compiler/frontend/bs_syntaxerr.ml +++ b/compiler/frontend/bs_syntaxerr.ml @@ -106,8 +106,8 @@ let err loc error = raise (Error (loc, error)) let optional_err loc (lbl : Asttypes.arg_label_loc) = match lbl with - | Opt _ -> raise (Error (loc, Optional_in_uncurried_bs_attribute)) + | Optional _ -> raise (Error (loc, Optional_in_uncurried_bs_attribute)) | _ -> () let err_if_label loc (lbl : Asttypes.arg_label_loc) = - if lbl <> Nolbl then raise (Error (loc, Misplaced_label_syntax)) + if lbl <> Nolabel then raise (Error (loc, Misplaced_label_syntax)) diff --git a/compiler/ml/ast_async.ml b/compiler/ml/ast_async.ml index 997c0a85ed..d5494ebfba 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 [(Nolbl, result)] + Ast_helper.Exp.apply ~loc unsafe_async [(Nolabel, 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 f5758f00dd..9fd1b9081b 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 [(Nolbl, e)] + Ast_helper.Exp.apply ~loc unsafe_await [(Nolabel, 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; }) [ - ( Nolbl, + ( Nolabel, Exp.constraint_ ~loc:e.pmod_loc (Exp.pack ~loc:e.pmod_loc { diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 1a20a6ac2c..fe349a4bcc 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -327,22 +327,22 @@ module E = struct let e = match (e.pexp_desc, args) with | ( Pexp_ident ({txt = Longident.Lident "->"} as lid), - [(Nolbl, _); (Nolbl, _)] ) -> + [(Nolabel, _); (Nolabel, _)] ) -> {e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "|."}} | ( Pexp_ident ({txt = Longident.Lident "++"} as lid), - [(Nolbl, _); (Nolbl, _)] ) -> + [(Nolabel, _); (Nolabel, _)] ) -> {e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "^"}} | ( Pexp_ident ({txt = Longident.Lident "!="} as lid), - [(Nolbl, _); (Nolbl, _)] ) -> + [(Nolabel, _); (Nolabel, _)] ) -> {e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "<>"}} | ( Pexp_ident ({txt = Longident.Lident "!=="} as lid), - [(Nolbl, _); (Nolbl, _)] ) -> + [(Nolabel, _); (Nolabel, _)] ) -> {e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "!="}} | ( Pexp_ident ({txt = Longident.Lident "==="} as lid), - [(Nolbl, _); (Nolbl, _)] ) -> + [(Nolabel, _); (Nolabel, _)] ) -> {e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "=="}} | ( Pexp_ident ({txt = Longident.Lident "=="} as lid), - [(Nolbl, _); (Nolbl, _)] ) -> + [(Nolabel, _); (Nolabel, _)] ) -> {e with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "="}} | _ -> e in diff --git a/compiler/ml/asttypes.ml b/compiler/ml/asttypes.ml index b70f4d8254..8391ef8cae 100644 --- a/compiler/ml/asttypes.ml +++ b/compiler/ml/asttypes.ml @@ -65,33 +65,33 @@ let same_arg_label (x : arg_label) y = | _ -> false) type arg_label_loc = - | Nolbl - | Lbl of string loc (* label:T -> ... *) - | Opt of string loc (* ?label:T -> ... *) + | Nolabel + | Labelled of string loc (* label:T -> ... *) + | Optional of string loc (* ?label:T -> ... *) -let to_arg_label_loc ?(loc = Location.none) lbl = +let to_arg_label_loc ?(loc = Location.none) (lbl : arg_label) : arg_label_loc = match lbl with - | Nolabel -> Nolbl - | Labelled s -> Lbl {loc; txt = s} - | Optional s -> Opt {loc; txt = s} + | Nolabel -> Nolabel + | Labelled s -> Labelled {loc; txt = s} + | Optional s -> Optional {loc; txt = s} let to_arg_label = function - | Nolbl -> Nolabel - | Lbl {txt} -> Labelled txt - | Opt {txt} -> Optional txt + | (Nolabel : arg_label_loc) -> (Nolabel : arg_label) + | Labelled {txt} -> Labelled txt + | Optional {txt} -> Optional txt let same_arg_label_loc (x : arg_label_loc) y = match x with - | Nolbl -> y = Nolbl - | Lbl {txt = s} -> ( + | Nolabel -> y = Nolabel + | Labelled {txt = s} -> ( match y with - | Lbl {txt = s0} -> s = s0 + | Labelled {txt = s0} -> s = s0 | _ -> false) - | Opt {txt = s} -> ( + | Optional {txt = s} -> ( match y with - | Opt {txt = s0} -> s = s0 + | Optional {txt = s0} -> s = s0 | _ -> false) let get_lbl_loc = function - | Nolbl -> Location.none - | Lbl {loc} | Opt {loc} -> loc + | (Nolabel : arg_label_loc) -> Location.none + | Labelled {loc} | Optional {loc} -> loc diff --git a/compiler/ml/btype.ml b/compiler/ml/btype.ml index 7dc575f764..28b80b3904 100644 --- a/compiler/ml/btype.ml +++ b/compiler/ml/btype.ml @@ -593,23 +593,23 @@ let forget_abbrev mem path = (**********************************) let is_optional = function - | Optional _ -> true + | (Optional _ : arg_label) -> true | _ -> false let is_optional_loc = function - | Opt _ -> true + | Optional _ -> true | _ -> false let label_name = function - | Nolabel -> "" + | (Nolabel : arg_label) -> "" | Labelled s | Optional s -> s let label_loc_name = function - | Nolbl -> "" - | Lbl {txt} | Opt {txt} -> txt + | (Nolabel : arg_label_loc) -> "" + | Labelled {txt} | Optional {txt} -> txt let prefixed_label_name = function - | Nolabel -> "" + | (Nolabel : arg_label) -> "" | Labelled s -> "~" ^ s | Optional s -> "?" ^ s diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index 35966c13ae..33a8a2655f 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 - | 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 + | Nolabel -> core_type1 ctxt f c (* otherwise parenthesize *) + | Labelled {txt = s} -> pp f "%s:%a" s (core_type1 ctxt) c + | Optional {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 - | Nolbl -> + | Nolabel -> (* single case pattern parens needed here *) pp f "%a@ " (simple_pattern ctxt) p - | Opt {txt = rest} -> ( + | Optional {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)) - | Lbl {txt = l} -> ( + | Labelled {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 = Nolbl) args -> ( + when List.for_all (fun (lab, _) -> lab = Nolabel) 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 - | [((Nolbl, _) as arg1); ((Nolbl, _) as arg2)] -> + | [((Nolabel, _) as arg1); ((Nolabel, _) 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 - | [(Nolbl, x)] -> pp f "@[<2>%s@;%a@]" s (simple_expr ctxt) x + | [(Nolabel, 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 = Nolbl then + if label = Nolabel 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 - | Nolbl -> expression2 ctxt f e (* level 2*) - | Opt {txt = str} -> + | Nolabel -> expression2 ctxt f e (* level 2*) + | Optional {txt = str} -> if Some str = simple_name then pp f "?%s" str else pp f "?%s:%a" str (simple_expr ctxt) e - | Lbl {txt = lbl} -> + | Labelled {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 fd53085be7..777829f0c9 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -112,9 +112,9 @@ 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_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 + | Nolabel -> line i ppf "Nolabel\n" + | Optional {txt = s} -> line i ppf "Optional \"%s\"\n" s + | Labelled {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; diff --git a/compiler/ml/printtyp.ml b/compiler/ml/printtyp.ml index 90a9fa1289..0df9ebc46b 100644 --- a/compiler/ml/printtyp.ml +++ b/compiler/ml/printtyp.ml @@ -142,7 +142,7 @@ let print_name ppf = function | Some name -> fprintf ppf "\"%s\"" name let string_of_label = function - | Nolabel -> "" + | (Nolabel : arg_label) -> "" | Labelled s -> s | Optional s -> "?" ^ s diff --git a/compiler/ml/printtyped.ml b/compiler/ml/printtyped.ml index 31cb9ef213..ec8197c817 100644 --- a/compiler/ml/printtyped.ml +++ b/compiler/ml/printtyped.ml @@ -121,7 +121,7 @@ let option i f ppf x = let longident i ppf li = line i ppf "%a\n" fmt_longident li let string i ppf s = line i ppf "\"%s\"\n" s let arg_label i ppf = function - | Nolabel -> line i ppf "Nolabel\n" + | (Nolabel : arg_label) -> line i ppf "Nolabel\n" | Optional s -> line i ppf "Optional \"%s\"\n" s | Labelled s -> line i ppf "Labelled \"%s\"\n" s diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 0c6c0ac97a..9acdf36dc0 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -738,9 +738,9 @@ let print_expr_type_clash ?type_clash_context env trace ppf = let print_arguments = Format.pp_print_list ~pp_sep:(fun ppf _ -> fprintf ppf ",@ ") - (fun ppf (label, argtype) -> + (fun ppf ((label : Asttypes.arg_label), argtype) -> match label with - | Asttypes.Nolabel -> fprintf ppf "@[%a@]" Printtyp.type_expr argtype + | Nolabel -> fprintf ppf "@[%a@]" Printtyp.type_expr argtype | Labelled label -> fprintf ppf "@[(~%s: %a)@]" label Printtyp.type_expr argtype | Optional label -> @@ -3546,16 +3546,17 @@ and type_application ?type_clash_context total_app env funct (sargs : sargs) : if List.length args < max_arity && total_app then match (expand_head env ty_fun).desc with | Tarrow (Optional l, t1, t2, _, _) -> - ignored := (Optional l, t1, ty_fun.level) :: !ignored; + ignored := + ((Optional l : Asttypes.arg_label), t1, ty_fun.level) :: !ignored; let arg = - ( Optional l, + ( (Optional l : Asttypes.arg_label), Some (fun () -> option_none (instance env t1) Location.none) ) in type_unknown_args max_arity ~args:(arg :: args) ~top_arity:None omitted t2 [] | _ -> collect_args () else collect_args () - | [(Nolbl, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] + | [(Nolabel, {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) *) @@ -3620,7 +3621,7 @@ 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 Nolbl sargs) then ( + if optional && (total_app || label_assoc Nolabel sargs) then ( ignored := (l, ty, lv) :: !ignored; ( sargs, omitted, @@ -3656,7 +3657,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 *) - | [(Nolbl, sarg)] when is_ignore ~env ~arity:top_arity funct -> + | [(Nolabel, 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 @@ -4297,7 +4298,7 @@ let report_error env ppf error = "It is not a function.") | Apply_wrong_label (l, ty) -> let print_label ppf = function - | Nolabel -> fprintf ppf "without label" + | (Nolabel : Asttypes.arg_label) -> fprintf ppf "without label" | l -> fprintf ppf "with label %s" (prefixed_label_name l) in fprintf ppf @@ -4376,7 +4377,8 @@ let report_error env ppf error = fprintf ppf "the expected type is@ %a@]" type_expr ty) | Abstract_wrong_label (l, ty) -> let label_mark = function - | Nolabel -> "but its first argument is not labelled" + | (Nolabel : Asttypes.arg_label) -> + "but its first argument is not labelled" | l -> sprintf "but its first argument is labelled %s" (prefixed_label_name l) in diff --git a/compiler/syntax/src/jsx_common.ml b/compiler/syntax/src/jsx_common.ml index d22d027a2f..20f0c61413 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"); }) - [(Nolbl, expr)] + [(Nolabel, expr)] else expr diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml index 40c9ff7e32..3b75fecb7f 100644 --- a/compiler/syntax/src/jsx_v4.ml +++ b/compiler/syntax/src/jsx_v4.ml @@ -8,28 +8,29 @@ let module_access_name config value = String.capitalize_ascii config.Jsx_common.module_ ^ "." ^ value |> Longident.parse -let nolabel = Nolbl +let nolabel = (Nolabel : arg_label_loc) -let labelled str = Lbl {txt = str; loc = Location.none} +let labelled str : Asttypes.arg_label_loc = + Labelled {txt = str; loc = Location.none} -let is_optional str = +let is_optional (str : arg_label_loc) = match str with - | Opt _ -> true + | Optional _ -> true | _ -> false -let is_labelled str = +let is_labelled (str : arg_label_loc) = match str with - | Lbl _ -> true + | Labelled _ -> true | _ -> false let is_forward_ref = function | {pexp_desc = Pexp_ident {txt = Ldot (Lident "React", "forwardRef")}} -> true | _ -> false -let get_label str = +let get_label (str : arg_label_loc) = match str with - | Opt {txt = str} | Lbl {txt = str} -> str - | Nolbl -> "" + | Optional {txt = str} | Labelled {txt = str} -> str + | Nolabel -> "" let constant_string ~loc str = Ast_helper.Exp.constant ~loc (Pconst_string (str, None)) @@ -95,8 +96,12 @@ let extract_children ?(remove_last_position_unit = false) ~loc let rec allButLast_ lst acc = match lst with | [] -> [] - | [(Nolbl, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] -> acc - | (Nolbl, {pexp_loc}) :: _rest -> + | [ + ( (Nolabel : arg_label_loc), + {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)} ); + ] -> + acc + | (Nolabel, {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) @@ -191,13 +196,17 @@ let record_from_props ~loc ~remove_key call_arguments = let rec remove_last_position_unit_aux props acc = match props with | [] -> acc - | [(Nolbl, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)}, _)] -> + | [ + ( (Nolabel : arg_label_loc), + {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)}, + _ ); + ] -> acc - | (Nolbl, {pexp_loc}, _) :: _rest -> + | (Nolabel, {pexp_loc}, _) :: _rest -> Jsx_common.raise_error ~loc:pexp_loc "JSX: found non-labelled argument before the last position" - | ((Lbl {txt}, {pexp_loc}, _) as prop) :: rest - | ((Opt {txt}, {pexp_loc}, _) as prop) :: rest -> + | ((Labelled {txt}, {pexp_loc}, _) as prop) :: rest + | ((Optional {txt}, {pexp_loc}, _) as prop) :: rest -> if txt = spread_props_label then match acc with | [] -> remove_last_position_unit_aux rest (prop :: acc) @@ -210,9 +219,9 @@ 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, _, _) -> + |> List.partition (fun ((label : Asttypes.arg_label_loc), _, _) -> match label with - | Lbl {txt = "_spreadProps"} -> false + | Labelled {txt = "_spreadProps"} -> false | _ -> true) in let props = @@ -257,7 +266,8 @@ let make_props_type_params_tvar named_type_list = else Some (Typ.var ~loc - @@ safe_type_from_value (Lbl {txt = label; loc = Location.none}))) + @@ safe_type_from_value + (Labelled {txt = label; loc = Location.none}))) let strip_option core_type = match core_type with @@ -327,11 +337,11 @@ let make_label_decls named_type_list = else if is_optional then Type.field ~loc ~attrs ~optional:true {txt = label; loc} (Typ.var @@ safe_type_from_value - @@ Lbl {txt = label; loc = Location.none}) + @@ Labelled {txt = label; loc = Location.none}) else Type.field ~loc ~attrs {txt = label; loc} (Typ.var @@ safe_type_from_value - @@ Lbl {txt = label; loc = Location.none})) + @@ Labelled {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 @@ -414,7 +424,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}) - [(Nolbl, expression)], + [(Nolabel, expression)], false ); ] | _ -> @@ -546,7 +556,7 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs txt = Ldot (element_binding, "someElement"); loc = Location.none; }) - [(Nolbl, children)], + [(Nolabel, children)], true ); ] | ListLiteral {pexp_desc = Pexp_array list} when list = [] -> [] @@ -558,7 +568,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}) - [(Nolbl, expression)], + [(Nolabel, expression)], false ); ] in @@ -650,11 +660,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 = Lbl {txt = "key"} | Opt {txt = "key"}} -> + | Pexp_fun {arg_label = Labelled {txt = "key"} | Optional {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 = Lbl {txt = "ref"} | Opt {txt = "ref"}} -> + | Pexp_fun {arg_label = Labelled {txt = "ref"} | Optional {txt = "ref"}} -> Jsx_common.raise_error ~loc:expr.pexp_loc "Ref cannot be passed as a normal prop. Please use `forwardRef` API \ instead." @@ -706,13 +716,13 @@ let rec recursively_transform_named_args_for_make expr args newtypes core_type = newtypes core_type | Pexp_fun { - arg_label = Nolbl; + arg_label = Nolabel; lhs = {ppat_desc = Ppat_construct ({txt = Lident "()"}, _) | Ppat_any}; } -> (args, newtypes, core_type) | Pexp_fun { - arg_label = Nolbl; + arg_label = Nolabel; lhs = { ppat_desc = @@ -726,7 +736,7 @@ let rec recursively_transform_named_args_for_make expr args newtypes core_type = | _ -> None in (* The ref arguement of forwardRef should be optional *) - ( ( Opt {txt = "ref"; loc = Location.none}, + ( ( Optional {txt = "ref"; loc = Location.none}, None, pattern, txt, @@ -736,7 +746,7 @@ let rec recursively_transform_named_args_for_make expr args newtypes core_type = newtypes, core_type ) else (args, newtypes, core_type) - | Pexp_fun {arg_label = Nolbl; lhs = pattern} -> + | Pexp_fun {arg_label = Nolabel; lhs = pattern} -> Location.raise_errorf ~loc:pattern.ppat_loc "React: react.component refs only support plain arguments and type \ annotations." @@ -807,7 +817,8 @@ 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 = [(Nolbl, inner_function_expression)]}} -> + | {pexp_desc = Pexp_apply {args = [(Nolabel, inner_function_expression)]}} + -> spelunk_for_fun_expression inner_function_expression | { pexp_desc = Pexp_sequence (_wrapperExpression, inner_function_expression); @@ -838,7 +849,7 @@ let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding = pexp_desc = Pexp_fun ({ - arg_label = Lbl _ | Opt _; + arg_label = Labelled _ | Optional _; rhs = {pexp_desc = Pexp_fun _} as internal_expression; } as f); } -> @@ -854,14 +865,14 @@ let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding = pexp_desc = Pexp_fun { - arg_label = Nolbl; + arg_label = Nolabel; lhs = {ppat_desc = Ppat_construct ({txt = Lident "()"}, _) | Ppat_any}; }; } -> ((fun a -> a), false, expression) (* let make = (~prop) => ... *) - | {pexp_desc = Pexp_fun {arg_label = Lbl _ | Opt _}} -> + | {pexp_desc = Pexp_fun {arg_label = Labelled _ | Optional _}} -> ((fun a -> a), false, expression) (* let make = (prop) => ... *) | {pexp_desc = Pexp_fun {lhs = pattern}} -> @@ -885,7 +896,7 @@ let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding = | { pexp_desc = Pexp_apply - {funct = wrapper_expression; args = [(Nolbl, internal_expression)]}; + {funct = wrapper_expression; args = [(Nolabel, internal_expression)]}; } -> let () = has_application := true in let _, _, exp = spelunk_for_fun_expression internal_expression in @@ -987,10 +998,13 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = (match rec_flag with | Recursive -> internal_fn_name | Nonrecursive -> fn_name))) - ([(Nolbl, Exp.ident (Location.mknoloc @@ Lident "props"))] + ([ + ( (Nolabel : arg_label_loc), + Exp.ident (Location.mknoloc @@ Lident "props") ); + ] @ match has_forward_ref with - | true -> [(Nolbl, Exp.ident (Location.mknoloc @@ Lident "ref"))] + | true -> [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "ref"))] | false -> []) in let make_props_pattern = function @@ -1009,12 +1023,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 Nolbl None + Exp.fun_ ~arity:None Nolabel 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 Nolbl None + Exp.fun_ ~arity:None Nolabel None (Pat.var @@ Location.mknoloc "ref") inner_expression else inner_expression) @@ -1129,7 +1143,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 Nolbl None pattern expr) + Exp.fun_ ~arity:None Nolabel None pattern expr) expression patterns_with_nolabel in (* ({a, b, _}: props<'a, 'b>) *) @@ -1139,7 +1153,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 Nolbl None + Exp.fun_ ~arity:(Some 1) ~async:is_async Nolabel None (Pat.constraint_ record_pattern (Typ.constr ~loc:empty_loc {txt = Lident "props"; loc = empty_loc} @@ -1206,18 +1220,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 = [(Nolbl, func_expr)]}; + Pexp_apply {funct = wrapper_expr; args = [(Nolabel, 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 = Lbl _ | Opt _} -> + | Pexp_fun {arg_label = Labelled _ | Optional _} -> Location.raise_errorf ~loc:expr.pexp_loc "Components using React.forwardRef cannot use \ @react.componentWithProps. Please use @react.component \ instead." - | Pexp_fun {arg_label = Nolbl; rhs = body} -> + | Pexp_fun {arg_label = Nolabel; rhs = body} -> check_invalid_forward_ref body | _ -> () in @@ -1242,7 +1256,7 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = in let wrapper_expr = - Exp.fun_ ~arity:None Nolbl None props_pattern + Exp.fun_ ~arity:None Nolabel None props_pattern (Jsx_common.async_component ~async:is_async (Exp.apply (Exp.ident @@ -1254,7 +1268,7 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = | Nonrecursive -> fn_name); loc; }) - [(Nolbl, Exp.ident {txt = Lident "props"; loc})])) + [(Nolabel, Exp.ident {txt = Lident "props"; loc})])) in let wrapper_expr = Ast_uncurried.uncurried_fun ~arity:1 wrapper_expr in @@ -1323,7 +1337,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 = Nolbl; ret} -> get_prop_types types ret + | Ptyp_arrow {lbl = Nolabel; ret} -> get_prop_types types ret | Ptyp_arrow {lbl = name; arg; ret = return_value} when is_labelled name || is_optional name -> ( return_value, @@ -1431,12 +1445,12 @@ let transform_signature_item ~config item = get_prop_types ((lbl, attrs, ptyp_loc, type_) :: types) rest | Ptyp_arrow { - lbl = Nolbl; + lbl = Nolabel; arg = {ptyp_desc = Ptyp_constr ({txt = Lident "unit"}, _)}; ret = rest; } -> get_prop_types types rest - | Ptyp_arrow {lbl = Nolbl; ret = rest} -> get_prop_types types rest + | Ptyp_arrow {lbl = Nolabel; ret = rest} -> get_prop_types types rest | Ptyp_arrow { lbl = name; @@ -1576,7 +1590,7 @@ let expr ~config mapper expression = Exp.apply (Exp.ident {txt = module_access_name config "array"; loc = Location.none}) - [(Nolbl, expr)] + [(Nolabel, 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 991cad32b2..f8ab8435b1 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_loc lbl = + let arg_label_loc (lbl : Asttypes.arg_label_loc) = match lbl with - | Asttypes.Nolbl -> Sexp.atom "Nolabel" - | Lbl {txt} -> Sexp.list [Sexp.atom "Labelled"; string txt] - | Opt {txt} -> Sexp.list [Sexp.atom "Optional"; string txt] + | Nolabel -> Sexp.atom "Nolabel" + | Labelled {txt} -> Sexp.list [Sexp.atom "Labelled"; string txt] + | Optional {txt} -> Sexp.list [Sexp.atom "Optional"; string txt] let constant c = let sexpr = diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml index a91460741e..5f24230578 100644 --- a/compiler/syntax/src/res_comments_table.ml +++ b/compiler/syntax/src/res_comments_table.ml @@ -168,18 +168,18 @@ let arrow_type ct = let rec process attrs_before acc typ = match typ with | { - ptyp_desc = Ptyp_arrow {lbl = Nolbl as lbl; arg; ret}; + ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; arg; ret}; ptyp_attributes = []; } -> let arg = ([], lbl, arg) in process attrs_before (arg :: acc) ret | { - ptyp_desc = Ptyp_arrow {lbl = Nolbl as lbl; arg; ret}; + ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; arg; ret}; ptyp_attributes = [({txt = "bs"}, _)] as attrs; } -> let arg = (attrs, lbl, arg) in process attrs_before (arg :: acc) ret - | {ptyp_desc = Ptyp_arrow {lbl = Nolbl}} as return_type -> + | {ptyp_desc = Ptyp_arrow {lbl = Nolabel}} as return_type -> let args = List.rev acc in (attrs_before, args, return_type) | {ptyp_desc = Ptyp_arrow {lbl; arg; ret}; ptyp_attributes = attrs} -> @@ -188,7 +188,7 @@ let arrow_type ct = | typ -> (attrs_before, List.rev acc, typ) in match ct with - | {ptyp_desc = Ptyp_arrow {lbl = Nolbl}; ptyp_attributes = attrs} as typ -> + | {ptyp_desc = Ptyp_arrow {lbl = Nolabel}; ptyp_attributes = attrs} as typ -> process attrs [] {typ with ptyp_attributes = []} | typ -> process [] [] typ @@ -274,7 +274,10 @@ let fun_expr 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.Nolbl, None, Ast_helper.Pat.var ~loc:string_loc.loc var) + ( attrs, + (Nolabel : Asttypes.arg_label_loc), + None, + Ast_helper.Pat.var ~loc:string_loc.loc var ) in collect attrs_before (parameter :: acc) return_expr | { @@ -294,7 +297,7 @@ let fun_expr expr = pexp_desc = Pexp_fun { - arg_label = (Lbl _ | Opt _) as lbl; + arg_label = (Labelled _ | Optional _) as lbl; default = default_expr; lhs = pattern; rhs = return_expr; @@ -306,8 +309,8 @@ let fun_expr expr = | expr -> (attrs_before, List.rev acc, expr) in match expr with - | {pexp_desc = Pexp_fun {arg_label = Nolbl}; pexp_attributes = attrs} as expr - -> + | {pexp_desc = Pexp_fun {arg_label = Nolabel}; pexp_attributes = attrs} as + expr -> collect attrs [] {expr with pexp_attributes = []} | expr -> collect [] [] expr @@ -1308,7 +1311,7 @@ and walk_expression expr t comments = Longident.Lident ("~+" | "~+." | "~-" | "~-." | "not" | "!"); }; }; - args = [(Nolbl, arg_expr)]; + args = [(Nolabel, arg_expr)]; } -> let before, inside, after = partition_by_loc comments arg_expr.pexp_loc in attach t.leading arg_expr.pexp_loc before; @@ -1330,7 +1333,7 @@ and walk_expression expr t comments = | "<>" ); }; }; - args = [(Nolbl, operand1); (Nolbl, operand2)]; + args = [(Nolabel, operand1); (Nolabel, operand2)]; } -> let before, inside, after = partition_by_loc comments operand1.pexp_loc in attach t.leading operand1.pexp_loc before; @@ -1350,7 +1353,7 @@ and walk_expression expr t comments = { pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}; }; - args = [(Nolbl, parent_expr); (Nolbl, member_expr)]; + args = [(Nolabel, parent_expr); (Nolabel, member_expr)]; } -> walk_list [Expression parent_expr; Expression member_expr] t comments | Pexp_apply @@ -1360,7 +1363,11 @@ and walk_expression expr t comments = pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "set")}; }; args = - [(Nolbl, parent_expr); (Nolbl, member_expr); (Nolbl, target_expr)]; + [ + (Nolabel, parent_expr); + (Nolabel, member_expr); + (Nolabel, target_expr); + ]; } -> walk_list [Expression parent_expr; Expression member_expr; Expression target_expr] @@ -1373,7 +1380,7 @@ and walk_expression expr t comments = Pexp_ident {txt = Longident.Ldot (Lident "Primitive_dict", "make")}; }; - args = [(Nolbl, key_values)]; + args = [(Nolabel, key_values)]; } when Res_parsetree_viewer.is_tuple_array key_values -> walk_list [Expression key_values] t comments @@ -1394,17 +1401,17 @@ and walk_expression expr t comments = if ParsetreeViewer.is_jsx_expression expr then ( let props = arguments - |> List.filter (fun (label, _) -> + |> List.filter (fun ((label : Asttypes.arg_label_loc), _) -> match label with - | Asttypes.Lbl {txt = "children"} -> false - | Asttypes.Nolbl -> false + | Labelled {txt = "children"} -> false + | Nolabel -> false | _ -> true) in let maybe_children = arguments - |> List.find_opt (fun (label, _) -> + |> List.find_opt (fun ((label : Asttypes.arg_label_loc), _) -> match label with - | Asttypes.Lbl {txt = "children"} -> true + | Labelled {txt = "children"} -> true | _ -> false) in match maybe_children with @@ -1426,10 +1433,10 @@ and walk_expression expr t comments = else walk_list (props - |> List.map (fun (lbl, expr) -> + |> List.map (fun ((lbl : Asttypes.arg_label_loc), expr) -> let loc = match lbl with - | Asttypes.Lbl {loc} | Opt {loc} -> + | Labelled {loc} | Optional {loc} -> {loc with loc_end = expr.Parsetree.pexp_loc.loc_end} | _ -> expr.pexp_loc in @@ -1443,10 +1450,10 @@ and walk_expression expr t comments = attach t.trailing call_expr.pexp_loc after_expr; walk_list (arguments - |> List.map (fun (lbl, expr) -> + |> List.map (fun ((lbl : Asttypes.arg_label_loc), expr) -> let loc = match lbl with - | Asttypes.Lbl {loc} | Opt {loc} -> + | Labelled {loc} | Optional {loc} -> {loc with loc_end = expr.Parsetree.pexp_loc.loc_end} | _ -> expr.pexp_loc in diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index bf2262c5f1..e78988782c 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -425,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)) - [(Nolbl, operand)] + [(Nolabel, 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)) - [(Nolbl, operand)] + [(Nolabel, operand)] | _ -> operand let make_list_expression loc seq ext_opt = @@ -539,7 +539,7 @@ let process_underscore_application args = ~loc:Location.none in let fun_expr = - Ast_helper.Exp.fun_ ~loc ~arity:(Some 1) Nolbl None pattern exp_apply + Ast_helper.Exp.fun_ ~loc ~arity:(Some 1) Nolabel None pattern exp_apply in Ast_uncurried.uncurried_fun ~arity:1 fun_expr | None -> exp_apply @@ -1656,7 +1656,8 @@ and parse_parameter p = | Comma | Equal | Rparen -> let loc = mk_loc start_pos p.prev_end_pos in ( [], - Asttypes.Lbl {txt = lbl_name; loc = lbl_loc}, + (Labelled {txt = lbl_name; loc = lbl_loc} + : Asttypes.arg_label_loc), lbl_loc, Ast_helper.Pat.var ~attrs ~loc (Location.mkloc lbl_name loc) ) | Colon -> @@ -1669,36 +1670,33 @@ 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.Lbl {txt = lbl_name; loc = lbl_loc}, lbl_loc, pat) + ([], Labelled {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.Lbl {txt = lbl_name; loc = lbl_loc}, lbl_loc, pat) + ([], Labelled {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.Lbl {txt = lbl_name; loc = lbl_loc}, + Labelled {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.Nolbl, - Location.none, - {pattern with ppat_attributes = attrs} ) + ([], Nolabel, Location.none, {pattern with ppat_attributes = attrs}) in match p.Parser.token with | Equal -> ( Parser.next p; let lbl = match lbl with - | Asttypes.Lbl lbl_name -> Asttypes.Opt lbl_name - | Asttypes.Nolbl -> + | Labelled lbl_name -> (Optional lbl_name : Asttypes.arg_label_loc) + | Nolabel -> let lbl_name = match pat.ppat_desc with | Ppat_var var -> var.txt @@ -1707,7 +1705,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.Opt {txt = lbl_name; loc = lbl_loc} + Asttypes.Optional {txt = lbl_name; loc = lbl_loc} | lbl -> lbl in match p.Parser.token with @@ -1754,7 +1752,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list = in { attrs = []; - p_label = Asttypes.Nolbl; + p_label = Nolabel; expr = None; pat = unit_pattern; p_pos = start_pos; @@ -1768,7 +1766,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list = [ { attrs = []; - p_label = Asttypes.Nolbl; + p_label = Nolabel; expr = None; pat = Ast_helper.Pat.var ~loc (Location.mkloc ident loc); p_pos = start_pos; @@ -1781,7 +1779,7 @@ and parse_parameters p : fundef_type_param option * fundef_term_param list = [ { attrs = []; - p_label = Asttypes.Nolbl; + p_label = Nolabel; expr = None; pat = Ast_helper.Pat.any ~loc (); p_pos = start_pos; @@ -2001,7 +1999,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)) - [(Nolbl, e); (Nolbl, rhs_expr)] + [(Nolabel, e); (Nolabel, rhs_expr)] | _ -> e) | _ -> ( let access_expr = parse_constrained_or_coerced_expr p in @@ -2028,7 +2026,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) - [(Nolbl, expr); (Nolbl, access_expr); (Nolbl, rhs_expr)] + [(Nolabel, expr); (Nolabel, access_expr); (Nolabel, rhs_expr)] in Parser.eat_breadcrumb p; array_set @@ -2038,7 +2036,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)) - [(Nolbl, expr); (Nolbl, access_expr)] + [(Nolabel, expr); (Nolabel, access_expr)] in parse_primary_expr ~operand:e p) @@ -2215,13 +2213,14 @@ and parse_binary_expr ?(context = OrdinaryExpr) ?a p prec = { b with pexp_desc = - Pexp_apply {funct = fun_expr; args = args @ [(Nolbl, a)]; partial}; + Pexp_apply + {funct = fun_expr; args = args @ [(Nolabel, a)]; partial}; } - | BarGreater, _ -> Ast_helper.Exp.apply ~loc b [(Nolbl, a)] + | BarGreater, _ -> Ast_helper.Exp.apply ~loc b [(Nolabel, a)] | _ -> Ast_helper.Exp.apply ~loc (make_infix_operator p token start_pos end_pos) - [(Nolbl, a); (Nolbl, b)] + [(Nolabel, a); (Nolabel, b)] in Parser.eat_breadcrumb p; loop expr) @@ -2313,7 +2312,7 @@ and parse_template_expr ?prefix p = Ast_helper.Exp.apply ~attrs:[tagged_template_literal_attr] ~loc:lident_loc.loc ident - [(Nolbl, strings_array); (Nolbl, values_array)] + [(Nolabel, strings_array); (Nolabel, values_array)] in let hidden_operator = @@ -2323,7 +2322,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 - [(Nolbl, e1); (Nolbl, e2)] + [(Nolabel, e1); (Nolabel, e2)] in let gen_interpolated_string () = let subparts = @@ -2387,13 +2386,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.Nolbl None pat + ~arity:None Asttypes.Nolabel 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.Nolbl None + ~arity:None Asttypes.Nolabel None (Ast_helper.Pat.constraint_ pat typ) body in @@ -2672,8 +2671,10 @@ and parse_jsx_opening_or_self_closing_element ~start_pos p = [ jsx_props; [ - (Asttypes.Lbl {txt = "children"; loc = Location.none}, children); - ( Asttypes.Nolbl, + ( (Labelled {txt = "children"; loc = Location.none} + : Asttypes.arg_label_loc), + children ); + ( Asttypes.Nolabel, Ast_helper.Exp.construct (Location.mknoloc (Longident.Lident "()")) None ); @@ -2738,7 +2739,7 @@ and parse_jsx_prop p = (* optional punning: *) if optional then Some - ( Asttypes.Opt {txt = name; loc}, + ( (Optional {txt = name; loc} : Asttypes.arg_label_loc), Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident name) loc) ) else @@ -2749,18 +2750,18 @@ and parse_jsx_prop p = let optional = Parser.optional p Question in Scanner.pop_mode p.scanner Jsx; let attr_expr = parse_primary_expr ~operand:(parse_atomic_expr p) p in - let label = - if optional then Asttypes.Opt {txt = name; loc} - else Asttypes.Lbl {txt = name; loc} + let label : Asttypes.arg_label_loc = + if optional then Optional {txt = name; loc} + else Labelled {txt = name; loc} in Some (label, attr_expr) | _ -> let attr_expr = Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident name) loc) in - let label = - if optional then Asttypes.Opt {txt = name; loc} - else Asttypes.Lbl {txt = name; loc} + let label : Asttypes.arg_label_loc = + if optional then Optional {txt = name; loc} + else Labelled {txt = name; loc} in Some (label, attr_expr)) (* {...props} *) @@ -2774,7 +2775,9 @@ and parse_jsx_prop p = let loc = mk_loc p.Parser.start_pos p.prev_end_pos in let attr_expr = parse_primary_expr ~operand:(parse_expr p) p in (* using label "spreadProps" to distinguish from others *) - let label = Asttypes.Lbl {txt = "_spreadProps"; loc} in + let label : Asttypes.arg_label_loc = + Labelled {txt = "_spreadProps"; loc} + in match p.Parser.token with | Rbrace -> Parser.next p; @@ -2990,7 +2993,7 @@ and parse_braced_or_record_expr p = [ { attrs = []; - p_label = Nolbl; + p_label = Nolabel; expr = None; pat = Ast_helper.Pat.var ~loc:ident.loc ident; p_pos = start_pos; @@ -3583,7 +3586,7 @@ and parse_argument p : argument option = (Location.mknoloc (Longident.Lident "()")) None in - Some {label = Asttypes.Nolbl; expr = unit_expr} + Some {label = Asttypes.Nolabel; expr = unit_expr} | _ -> parse_argument2 p) | _ -> parse_argument2 p else None @@ -3597,7 +3600,7 @@ and parse_argument2 p : argument option = let expr = Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "_") loc) in - Some {label = Nolbl; expr} + Some {label = Nolabel; expr} | Tilde -> ( Parser.next p; (* TODO: nesting of pattern matches not intuitive for error recovery *) @@ -3614,15 +3617,19 @@ and parse_argument2 p : argument option = match p.Parser.token with | Question -> Parser.next p; - Some {label = Opt {txt = ident; loc = named_arg_loc}; expr = ident_expr} + Some + { + label = Optional {txt = ident; loc = named_arg_loc}; + expr = ident_expr; + } | Equal -> Parser.next p; - let label = + let label : Asttypes.arg_label_loc = match p.Parser.token with | Question -> Parser.next p; - Asttypes.Opt {txt = ident; loc = named_arg_loc} - | _ -> Asttypes.Lbl {txt = ident; loc = named_arg_loc} + Optional {txt = ident; loc = named_arg_loc} + | _ -> Labelled {txt = ident; loc = named_arg_loc} in let expr = match p.Parser.token with @@ -3639,17 +3646,17 @@ and parse_argument2 p : argument option = let typ = parse_typ_expr p in let loc = mk_loc start_pos p.prev_end_pos in let expr = Ast_helper.Exp.constraint_ ~loc ident_expr typ in - Some {label = Asttypes.Lbl {txt = ident; loc = named_arg_loc}; expr} + Some {label = Labelled {txt = ident; loc = named_arg_loc}; expr} | _ -> Some { - label = Asttypes.Lbl {txt = ident; loc = named_arg_loc}; + label = Labelled {txt = ident; loc = named_arg_loc}; expr = ident_expr; }) | t -> Parser.err p (Diagnostics.lident t); - Some {label = Nolbl; expr = Recover.default_expr ()}) - | _ -> Some {label = Nolbl; expr = parse_constrained_or_coerced_expr p} + Some {label = Nolabel; expr = Recover.default_expr ()}) + | _ -> Some {label = Nolabel; expr = parse_constrained_or_coerced_expr p} and parse_call_expr p fun_expr = Parser.expect Lparen p; @@ -3674,7 +3681,7 @@ and parse_call_expr p fun_expr = (* No args -> unit sugar: `foo()` *) [ { - label = Nolbl; + label = Nolabel; expr = Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) @@ -3877,7 +3884,7 @@ and parse_list_expr ~start_pos p = (Longident.Ldot (Longident.Ldot (Longident.Lident "Belt", "List"), "concatMany")) loc)) - [(Asttypes.Nolbl, Ast_helper.Exp.array ~loc list_exprs)] + [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc list_exprs)] and parse_dict_expr ~start_pos p = let rows = @@ -3906,7 +3913,7 @@ and parse_dict_expr ~start_pos p = (Location.mkloc (Longident.Ldot (Longident.Lident Primitive_modules.dict, "make")) loc)) - [(Asttypes.Nolbl, Ast_helper.Exp.array ~loc key_value_pairs)] + [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc key_value_pairs)] and parse_array_exp p = let start_pos = p.Parser.start_pos in @@ -3961,7 +3968,7 @@ and parse_array_exp p = (Longident.Ldot (Longident.Ldot (Longident.Lident "Belt", "Array"), "concatMany")) loc)) - [(Nolbl, Ast_helper.Exp.array ~loc list_exprs)] + [(Nolabel, Ast_helper.Exp.array ~loc list_exprs)] (* TODO: check attributes in the case of poly type vars, * might be context dependend: parseFieldDeclaration (see ocaml) *) @@ -3988,7 +3995,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) Nolbl typ return_type + Ast_helper.Typ.arrow ~loc ~arity:(Some 1) Nolabel typ return_type | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt) | _ -> assert false) | _ -> parse_typ_expr p @@ -4220,8 +4227,8 @@ and parse_type_parameter p = | Equal -> Parser.next p; Parser.expect Question p; - Some {attrs; label = Opt {txt = name; loc}; typ; start_pos} - | _ -> Some {attrs; label = Lbl {txt = name; loc}; typ; start_pos}) + Some {attrs; label = Optional {txt = name; loc}; typ; start_pos} + | _ -> Some {attrs; label = Labelled {txt = name; loc}; typ; start_pos}) | Lident _ -> ( let name, loc = parse_lident p in match p.token with @@ -4239,8 +4246,8 @@ and parse_type_parameter p = | Equal -> Parser.next p; Parser.expect Question p; - Some {attrs; label = Opt {txt = name; loc}; typ; start_pos} - | _ -> Some {attrs; label = Lbl {txt = name; loc}; typ; start_pos}) + Some {attrs; label = Optional {txt = name; loc}; typ; start_pos} + | _ -> Some {attrs; label = Labelled {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 @@ -4252,13 +4259,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 = Nolbl; typ; start_pos}) + Some {attrs = []; label = Nolabel; 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 = Nolbl; typ = typ_with_attributes; start_pos} + Some {attrs = []; label = Nolabel; typ = typ_with_attributes; start_pos} else None (* (int, ~x:string, float) *) @@ -4271,7 +4278,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 = Nolbl; typ; start_pos}] + [{attrs = []; label = Nolabel; typ; start_pos}] | _ -> let params = parse_comma_delimited_region ~grammar:Grammar.TypeParameters @@ -4288,13 +4295,13 @@ and parse_es6_arrow_type ~attrs p = let name, label_loc = parse_lident p in Parser.expect ~grammar:Grammar.TypeExpression Colon p; let typ = parse_typ_expr ~alias:false ~es6_arrow:false p in - let arg = + let arg : Asttypes.arg_label_loc = match p.Parser.token with | Equal -> Parser.next p; Parser.expect Question p; - Asttypes.Opt {txt = name; loc = label_loc} - | _ -> Asttypes.Lbl {txt = name; loc = label_loc} + Optional {txt = name; loc = label_loc} + | _ -> Labelled {txt = name; loc = label_loc} in Parser.expect EqualGreater p; let return_type = parse_typ_expr ~alias:false p in @@ -4314,7 +4321,7 @@ and parse_es6_arrow_type ~attrs p = let arity = (* Workaround for ~lbl: @as(json`false`) _, which changes the arity *) match arg_lbl with - | Lbl _s -> + | Labelled _s -> let typ_is_any = match typ.ptyp_desc with | Ptyp_any -> true @@ -4388,7 +4395,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) Nolbl typ return_type + Ast_helper.Typ.arrow ~loc ~arity:(Some 1) Nolabel typ return_type | _ -> typ and parse_typ_expr_region p = @@ -4995,7 +5002,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) Nolbl typ return_type + Ast_helper.Typ.arrow ~loc ~arity:(Some 1) Nolabel 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 a0b453d064..46c8f5fb75 100644 --- a/compiler/syntax/src/res_parsetree_viewer.ml +++ b/compiler/syntax/src/res_parsetree_viewer.ml @@ -11,24 +11,24 @@ let arrow_type ?(max_arity = max_int) ct = when acc <> [] -> (attrs_before, List.rev acc, typ) | { - ptyp_desc = Ptyp_arrow {lbl = Nolbl as lbl; arg; ret}; + ptyp_desc = Ptyp_arrow {lbl = Nolabel as lbl; arg; ret}; ptyp_attributes = []; } -> let arg = ([], lbl, arg) in process attrs_before (arg :: acc) ret (arity - 1) | { - ptyp_desc = Ptyp_arrow {lbl = Nolbl}; + ptyp_desc = Ptyp_arrow {lbl = Nolabel}; 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 = Nolbl}; ptyp_attributes = _attrs} as + | {ptyp_desc = Ptyp_arrow {lbl = Nolabel}; ptyp_attributes = _attrs} as return_type -> let args = List.rev acc in (attrs_before, args, return_type) | { - ptyp_desc = Ptyp_arrow {lbl = (Lbl _ | Opt _) as lbl; arg; ret}; + ptyp_desc = Ptyp_arrow {lbl = (Labelled _ | Optional _) 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 @@ -48,7 +48,7 @@ let arrow_type ?(max_arity = max_int) ct = | typ -> (attrs_before, List.rev acc, typ) in match ct with - | {ptyp_desc = Ptyp_arrow {lbl = Nolbl}; ptyp_attributes = attrs1} as typ -> + | {ptyp_desc = Ptyp_arrow {lbl = Nolabel}; ptyp_attributes = attrs1} as typ -> process attrs1 [] {typ with ptyp_attributes = []} max_arity | typ -> process [] [] typ max_arity @@ -112,7 +112,7 @@ let rewrite_underscore_apply expr = match expr_fun.pexp_desc with | Pexp_fun { - arg_label = Nolbl; + arg_label = Nolabel; default = None; lhs = {ppat_desc = Ppat_var {txt = "__x"}}; rhs = {pexp_desc = Pexp_apply {funct = call_expr; args}} as e; @@ -281,7 +281,7 @@ let is_unary_expression expr = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}; - args = [(Nolbl, _arg)]; + args = [(Nolabel, _arg)]; } when is_unary_operator operator -> true @@ -305,7 +305,7 @@ let is_binary_expression expr = pexp_desc = Pexp_ident {txt = Longident.Lident operator; loc = operator_loc}; }; - args = [(Nolbl, _operand1); (Nolbl, _operand2)]; + args = [(Nolabel, _operand1); (Nolabel, _operand2)]; } when is_binary_operator operator && not (operator_loc.loc_ghost && operator = "++") @@ -380,7 +380,7 @@ let is_array_access expr = Pexp_ident {txt = Longident.Ldot (Longident.Lident "Array", "get")}; }; - args = [(Nolbl, _parentExpr); (Nolbl, _memberExpr)]; + args = [(Nolabel, _parentExpr); (Nolabel, _memberExpr)]; } -> true | _ -> false @@ -454,7 +454,7 @@ let collect_ternary_parts expr = let parameters_should_hug parameters = match parameters with - | [Parameter {attrs = []; lbl = Nolbl; default_expr = None; pat}] + | [Parameter {attrs = []; lbl = Nolabel; default_expr = None; pat}] when is_huggable_pattern pat -> true | _ -> false @@ -512,7 +512,7 @@ let should_indent_binary_expr expr = Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident sub_operator}}; - args = [(Nolbl, _lhs); (Nolbl, _rhs)]; + args = [(Nolabel, _lhs); (Nolabel, _rhs)]; }; } when is_binary_operator sub_operator -> @@ -525,7 +525,7 @@ let should_indent_binary_expr expr = Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}; - args = [(Nolbl, lhs); (Nolbl, _rhs)]; + args = [(Nolabel, lhs); (Nolabel, _rhs)]; }; } when is_binary_operator operator -> @@ -638,7 +638,7 @@ let is_template_literal expr = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "++"}}; - args = [(Nolbl, _); (Nolbl, _)]; + args = [(Nolabel, _); (Nolabel, _)]; } when has_template_literal_attr expr.pexp_attributes -> true @@ -709,7 +709,7 @@ let is_single_pipe_expr expr = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident ("->" | "|>")}}; - args = [(Nolbl, _operand1); (Nolbl, _operand2)]; + args = [(Nolabel, _operand1); (Nolabel, _operand2)]; } -> true | _ -> false @@ -718,7 +718,7 @@ let is_single_pipe_expr expr = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident ("->" | "|>")}}; - args = [(Nolbl, operand1); (Nolbl, _operand2)]; + args = [(Nolabel, operand1); (Nolabel, _operand2)]; } when not (is_pipe_expr operand1) -> true @@ -728,7 +728,7 @@ let is_underscore_apply_sugar expr = match expr.pexp_desc with | Pexp_fun { - arg_label = Nolbl; + arg_label = Nolabel; default = None; lhs = {ppat_desc = Ppat_var {txt = "__x"}}; rhs = {pexp_desc = Pexp_apply _}; diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index e03606478b..a04421f0f5 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 - | [([], Nolbl, n)] -> + | [([], Nolabel, n)] -> let has_attrs_before = not (attrs_before = []) in let attrs = if has_attrs_before then @@ -1936,16 +1936,16 @@ and print_type_parameter ~state (attrs, lbl, typ) cmt_tbl = let attrs = print_attributes ~state attrs cmt_tbl in let label = match lbl with - | Asttypes.Nolbl -> Doc.nil - | Lbl {txt = lbl} -> + | Asttypes.Nolabel -> Doc.nil + | Labelled {txt = lbl} -> Doc.concat [Doc.text "~"; print_ident_like lbl; Doc.text ": "] - | Opt {txt = lbl} -> + | Optional {txt = lbl} -> Doc.concat [Doc.text "~"; print_ident_like lbl; Doc.text ": "] in let optional_indicator = match lbl with - | Nolbl | Lbl _ -> Doc.nil - | Opt _ -> Doc.text "=?" + | Nolabel | Labelled _ -> Doc.nil + | Optional _ -> Doc.text "=?" in let loc = {(Asttypes.get_lbl_loc lbl) with loc_end = typ.ptyp_loc.loc_end} in let doc = @@ -2770,7 +2770,7 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = match e_fun.pexp_desc with | Pexp_fun { - arg_label = Nolbl; + arg_label = Nolabel; default = None; lhs = {ppat_desc = Ppat_var {txt = "__x"}}; rhs = {pexp_desc = Pexp_apply _}; @@ -3144,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 = [(Nolbl, {pexp_desc = Pexp_array sub_lists})]} + {funct = e; args = [(Nolabel, {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 = [(Nolbl, {pexp_desc = Pexp_array sub_lists})]} + {funct = e; args = [(Nolabel, {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} -> @@ -3552,7 +3552,7 @@ and print_template_literal ~state expr cmt_tbl = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "++"}}; - args = [(Nolbl, arg1); (Nolbl, arg2)]; + args = [(Nolabel, arg1); (Nolabel, arg2)]; } -> let lhs = walk_expr arg1 in let rhs = walk_expr arg2 in @@ -3641,7 +3641,7 @@ and print_unary_expression ~state expr cmt_tbl = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}; - args = [(Nolbl, operand)]; + args = [(Nolabel, operand)]; } -> let printed_operand = let doc = print_expression_with_comments ~state operand cmt_tbl in @@ -3786,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 = [(Nolbl, _); (Nolbl, _)]; + args = [(Nolabel, _); (Nolabel, _)]; } when loc.loc_ghost -> let doc = print_template_literal ~state expr cmt_tbl in @@ -3800,7 +3800,7 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}; - args = [(Nolbl, lhs); (Nolbl, rhs)]; + args = [(Nolabel, lhs); (Nolabel, 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 @@ -3841,7 +3841,7 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = { pexp_desc = Pexp_ident {txt = Longident.Lident (("->" | "|>") as op)}; }; - args = [(Nolbl, lhs); (Nolbl, rhs)]; + args = [(Nolabel, lhs); (Nolabel, rhs)]; } when not (ParsetreeViewer.is_binary_expression lhs @@ -3867,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 = [(Nolbl, lhs); (Nolbl, rhs)]; + args = [(Nolabel, lhs); (Nolabel, rhs)]; } -> let is_multiline = lhs.pexp_loc.loc_start.pos_lnum < rhs.pexp_loc.loc_start.pos_lnum @@ -4039,7 +4039,7 @@ and print_pexp_apply ~state expr cmt_tbl = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}}; - args = [(Nolbl, parent_expr); (Nolbl, member_expr)]; + args = [(Nolabel, parent_expr); (Nolabel, member_expr)]; } -> let parent_doc = let doc = print_expression_with_comments ~state parent_expr cmt_tbl in @@ -4071,7 +4071,7 @@ and print_pexp_apply ~state expr cmt_tbl = | Pexp_apply { funct = {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}; - args = [(Nolbl, lhs); (Nolbl, rhs)]; + args = [(Nolabel, lhs); (Nolabel, rhs)]; } -> ( let rhs_doc = let doc = print_expression_with_comments ~state rhs cmt_tbl in @@ -4108,7 +4108,7 @@ and print_pexp_apply ~state expr cmt_tbl = Pexp_ident {txt = Longident.Ldot (Lident "Primitive_dict", "make")}; }; - args = [(Nolbl, key_values)]; + args = [(Nolabel, key_values)]; } when Res_parsetree_viewer.is_tuple_array key_values -> Doc.concat @@ -4123,7 +4123,7 @@ and print_pexp_apply ~state expr cmt_tbl = { pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}; }; - args = [(Nolbl, parent_expr); (Nolbl, member_expr)]; + args = [(Nolabel, parent_expr); (Nolabel, member_expr)]; } when not (ParsetreeViewer.is_rewritten_underscore_apply_sugar parent_expr) -> @@ -4169,7 +4169,11 @@ and print_pexp_apply ~state expr cmt_tbl = pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "set")}; }; args = - [(Nolbl, parent_expr); (Nolbl, member_expr); (Nolbl, target_expr)]; + [ + (Nolabel, parent_expr); + (Nolabel, member_expr); + (Nolabel, target_expr); + ]; } -> let member = let member_doc = @@ -4247,7 +4251,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.Lbl {txt = "..."; loc = Location.none}, dummy)] + args @ [(Labelled {txt = "..."; loc = Location.none}, dummy)] else args in let call_expr_doc = @@ -4499,8 +4503,8 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option = match args with | [] -> (Doc.nil, None) | [ - (Asttypes.Lbl {txt = "children"}, children); - ( Asttypes.Nolbl, + ((Labelled {txt = "children"} : Asttypes.arg_label_loc), children); + ( Nolabel, { Parsetree.pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); @@ -4510,8 +4514,8 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option = (doc, Some children) | ((e_lbl, expr) as last_prop) :: [ - (Asttypes.Lbl {txt = "children"}, children); - ( Asttypes.Nolbl, + ((Labelled {txt = "children"} : Asttypes.arg_label_loc), children); + ( Nolabel, { Parsetree.pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); @@ -4519,9 +4523,9 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option = ] -> let loc = match e_lbl with - | Asttypes.Lbl {loc} | Asttypes.Opt {loc} -> + | Labelled {loc} | Optional {loc} -> {loc with loc_end = expr.pexp_loc.loc_end} - | Nolbl -> expr.pexp_loc + | Nolabel -> 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 @@ -4552,41 +4556,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.Lbl {txt = lbl_txt} | Opt {txt = lbl_txt}) as lbl), + | ( ((Labelled {txt = lbl_txt} | Optional {txt = lbl_txt}) as lbl), { pexp_attributes = []; pexp_desc = Pexp_ident {txt = Longident.Lident ident}; } ) when lbl_txt = ident (* jsx punning *) -> ( match lbl with - | Nolbl -> Doc.nil - | Lbl {loc} -> print_comments (print_ident_like ident) cmt_tbl loc - | Opt {loc} -> + | Nolabel -> Doc.nil + | Labelled {loc} -> print_comments (print_ident_like ident) cmt_tbl loc + | Optional {loc} -> let doc = Doc.concat [Doc.question; print_ident_like ident] in print_comments doc cmt_tbl loc) - | ( ((Asttypes.Lbl {txt = lbl_txt} | Opt {txt = lbl_txt}) as lbl), + | ( ((Labelled {txt = lbl_txt} | Optional {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 - | Nolbl -> Doc.nil - | Lbl _lbl -> print_ident_like ident - | Opt _lbl -> Doc.concat [Doc.question; print_ident_like ident]) - | Asttypes.Lbl {txt = "_spreadProps"}, expr -> + | Nolabel -> Doc.nil + | Labelled _lbl -> print_ident_like ident + | Optional _lbl -> Doc.concat [Doc.question; print_ident_like ident]) + | Labelled {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, lbl_doc = match lbl with - | Asttypes.Lbl {txt = lbl; loc} -> + | Labelled {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} -> + | Optional {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) + | Nolabel -> (Location.none, Doc.nil) in let expr_doc = let leading_line_comment_present = @@ -4636,10 +4640,10 @@ and print_arguments_with_callback_in_first_position ~state ~partial args cmt_tbl | (lbl, expr) :: args -> let lbl_doc = match lbl with - | Asttypes.Nolbl -> Doc.nil - | Asttypes.Lbl {txt} -> + | Nolabel -> Doc.nil + | Labelled {txt} -> Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal] - | Asttypes.Opt {txt} -> + | Optional {txt} -> Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal; Doc.question] in let callback = @@ -4724,10 +4728,10 @@ and print_arguments_with_callback_in_last_position ~state ~partial args cmt_tbl | [(lbl, expr)] -> let lbl_doc = match lbl with - | Asttypes.Nolbl -> Doc.nil - | Asttypes.Lbl {txt} -> + | (Nolabel : Asttypes.arg_label_loc) -> Doc.nil + | Labelled {txt} -> Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal] - | Asttypes.Opt {txt} -> + | Optional {txt} -> Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal; Doc.question] in let callback_fits_on_one_line = @@ -4819,7 +4823,7 @@ and print_arguments ~state ~partial (args : (Asttypes.arg_label_loc * Parsetree.expression) list) cmt_tbl = match args with | [ - ( Nolbl, + ( Nolabel, { pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _); pexp_loc = loc; @@ -4834,7 +4838,7 @@ and print_arguments ~state ~partial Doc.rparen; ] else Doc.text "()" - | [(Nolbl, arg)] when ParsetreeViewer.is_huggable_expression arg -> + | [(Nolabel, 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 @@ -4880,7 +4884,7 @@ and print_arguments ~state ~partial and print_argument ~state (arg_lbl, arg) cmt_tbl = match (arg_lbl, arg) with (* ~a (punned)*) - | ( Lbl {txt = lbl; loc = l0}, + | ( Labelled {txt = lbl; loc = l0}, { pexp_attributes = []; pexp_desc = Pexp_ident {txt = Longident.Lident name}; @@ -4890,7 +4894,7 @@ and print_argument ~state (arg_lbl, arg) cmt_tbl = let doc = Doc.concat [Doc.tilde; print_ident_like lbl] in print_comments doc cmt_tbl loc (* ~a: int (punned)*) - | ( Lbl {txt = lbl; loc = l0}, + | ( Labelled {txt = lbl; loc = l0}, { pexp_desc = Pexp_constraint @@ -4911,7 +4915,7 @@ and print_argument ~state (arg_lbl, arg) cmt_tbl = in print_comments doc cmt_tbl loc (* ~a? (optional lbl punned)*) - | ( Opt {txt = lbl; loc}, + | ( Optional {txt = lbl; loc}, { pexp_desc = Pexp_ident {txt = Longident.Lident name}; pexp_attributes = []; @@ -4922,16 +4926,16 @@ and print_argument ~state (arg_lbl, arg) cmt_tbl = | _lbl, expr -> let arg_loc, printed_lbl, dotdotdot = match arg_lbl with - | Nolbl -> (expr.pexp_loc, Doc.nil, false) - | Lbl {txt = "..."; loc} -> + | Nolabel -> (expr.pexp_loc, Doc.nil, false) + | Labelled {txt = "..."; loc} -> let arg_loc = loc in let doc = Doc.text "..." in (loc, print_comments doc cmt_tbl arg_loc, true) - | Lbl {txt = lbl; loc} -> + | Labelled {txt = lbl; loc} -> let arg_loc = loc in let doc = Doc.concat [Doc.tilde; print_ident_like lbl; Doc.equal] in (loc, print_comments doc cmt_tbl arg_loc, false) - | Opt {txt = lbl; loc} -> + | Optional {txt = lbl; loc} -> let arg_loc = loc in let doc = Doc.concat [Doc.tilde; print_ident_like lbl; Doc.equal; Doc.question] @@ -5041,7 +5045,7 @@ and print_expr_fun_parameters ~state ~in_callback ~async ~has_constraint ParsetreeViewer.Parameter { attrs = []; - lbl = Nolbl; + lbl = Nolabel; default_expr = None; pat = {Parsetree.ppat_desc = Ppat_any; ppat_loc}; }; @@ -5056,7 +5060,7 @@ and print_expr_fun_parameters ~state ~in_callback ~async ~has_constraint ParsetreeViewer.Parameter { attrs = []; - lbl = Nolbl; + lbl = Nolabel; default_expr = None; pat = { @@ -5082,7 +5086,7 @@ and print_expr_fun_parameters ~state ~in_callback ~async ~has_constraint ParsetreeViewer.Parameter { attrs = []; - lbl = Nolbl; + lbl = Nolabel; default_expr = None; pat = {ppat_desc = Ppat_construct ({txt = Longident.Lident "()"; loc}, None)}; @@ -5162,8 +5166,8 @@ and print_exp_fun_parameter ~state parameter cmt_tbl = * ~from -> punning *) let label_with_pattern = match (lbl, pattern) with - | Nolbl, pattern -> print_pattern ~state pattern cmt_tbl - | ( (Lbl {txt = lbl} | Opt {txt = lbl}), + | Nolabel, pattern -> print_pattern ~state pattern cmt_tbl + | ( (Labelled {txt = lbl} | Optional {txt = lbl}), {ppat_desc = Ppat_var string_loc; ppat_attributes} ) when lbl = string_loc.txt -> (* ~d *) @@ -5173,7 +5177,7 @@ and print_exp_fun_parameter ~state parameter cmt_tbl = Doc.text "~"; print_ident_like lbl; ] - | ( (Lbl {txt = lbl} | Opt {txt = lbl}), + | ( (Labelled {txt = lbl} | Optional {txt = lbl}), { ppat_desc = Ppat_constraint ({ppat_desc = Ppat_var {txt}}, typ); ppat_attributes; @@ -5188,7 +5192,7 @@ and print_exp_fun_parameter ~state parameter cmt_tbl = Doc.text ": "; print_typ_expr ~state typ cmt_tbl; ] - | (Lbl {txt = lbl} | Opt {txt = lbl}), pattern -> + | (Labelled {txt = lbl} | Optional {txt = lbl}), pattern -> (* ~b as c *) Doc.concat [ @@ -5200,7 +5204,7 @@ and print_exp_fun_parameter ~state parameter cmt_tbl = in let optional_label_suffix = match (lbl, default_expr) with - | Opt _, None -> Doc.text "=?" + | Optional _, None -> Doc.text "=?" | _ -> Doc.nil in let doc =