From c6ec68de6b35044e93289b889c6e2480e57878e0 Mon Sep 17 00:00:00 2001 From: Gabriel Nordeborn Date: Sun, 16 Feb 2025 16:11:24 +0100 Subject: [PATCH] wip --- analysis/src/Codemod.ml | 4 +- analysis/src/Commands.ml | 12 +- analysis/src/CompletionFrontEnd.ml | 12 +- analysis/src/CreateInterface.ml | 3 +- analysis/src/Diagnostics.ml | 9 +- analysis/src/DocumentSymbol.ml | 6 +- analysis/src/DumpAst.ml | 2 +- analysis/src/Hint.ml | 4 +- analysis/src/PrintType.ml | 8 +- analysis/src/ProcessCmt.ml | 6 +- analysis/src/SemanticTokens.ml | 6 +- analysis/src/SignatureHelp.ml | 6 +- analysis/src/Utils.ml | 2 +- analysis/src/Xform.ml | 18 +- analysis/vendor/ml/ast_async.ml | 3 +- analysis/vendor/ml/ast_uncurried.ml | 79 +- analysis/vendor/ml/ast_uncurried_utils.ml | 7 +- analysis/vendor/ml/ast_untagged_variants.ml | 2 +- analysis/vendor/ml/transl_recmodule.ml | 2 +- analysis/vendor/ml/typecore.ml | 6 +- analysis/vendor/res_syntax/jsx_common.ml | 52 +- analysis/vendor/res_syntax/jsx_ppx.ml | 122 +- analysis/vendor/res_syntax/jsx_ppx.mli | 12 +- analysis/vendor/res_syntax/jsx_v4.ml | 1188 +++-- analysis/vendor/res_syntax/reactjs_jsx_v3.ml | 862 ++- .../vendor/res_syntax/res_ast_conversion.ml | 283 +- .../vendor/res_syntax/res_ast_conversion.mli | 4 +- .../vendor/res_syntax/res_ast_debugger.ml | 561 +- .../vendor/res_syntax/res_ast_debugger.mli | 6 +- analysis/vendor/res_syntax/res_cli.ml | 320 -- analysis/vendor/res_syntax/res_comment.ml | 34 +- analysis/vendor/res_syntax/res_comment.mli | 24 +- .../vendor/res_syntax/res_comments_table.ml | 1953 ++++--- analysis/vendor/res_syntax/res_core.ml | 4629 ++++++++--------- analysis/vendor/res_syntax/res_core.mli | 4 +- analysis/vendor/res_syntax/res_diagnostics.ml | 73 +- .../vendor/res_syntax/res_diagnostics.mli | 16 +- analysis/vendor/res_syntax/res_doc.ml | 195 +- analysis/vendor/res_syntax/res_doc.mli | 30 +- analysis/vendor/res_syntax/res_driver.ml | 113 +- analysis/vendor/res_syntax/res_driver.mli | 49 +- .../vendor/res_syntax/res_driver_binary.ml | 6 +- .../vendor/res_syntax/res_driver_binary.mli | 2 +- .../vendor/res_syntax/res_driver_ml_parser.ml | 52 +- .../res_syntax/res_driver_ml_parser.mli | 6 +- analysis/vendor/res_syntax/res_grammar.ml | 142 +- analysis/vendor/res_syntax/res_io.ml | 4 +- analysis/vendor/res_syntax/res_io.mli | 4 +- .../vendor/res_syntax/res_multi_printer.ml | 88 +- .../vendor/res_syntax/res_multi_printer.mli | 2 +- .../vendor/res_syntax/res_outcome_printer.ml | 686 +-- .../vendor/res_syntax/res_outcome_printer.mli | 6 +- analysis/vendor/res_syntax/res_parens.ml | 309 +- analysis/vendor/res_syntax/res_parens.mli | 49 +- analysis/vendor/res_syntax/res_parser.ml | 144 +- analysis/vendor/res_syntax/res_parser.mli | 32 +- .../vendor/res_syntax/res_parsetree_viewer.ml | 397 +- .../res_syntax/res_parsetree_viewer.mli | 130 +- analysis/vendor/res_syntax/res_printer.ml | 4361 ++++++++-------- analysis/vendor/res_syntax/res_printer.mli | 28 +- analysis/vendor/res_syntax/res_reporting.ml | 2 +- analysis/vendor/res_syntax/res_scanner.ml | 448 +- analysis/vendor/res_syntax/res_scanner.mli | 22 +- analysis/vendor/res_syntax/res_string.ml | 12 +- analysis/vendor/res_syntax/res_token.ml | 23 +- analysis/vendor/res_syntax/res_uncurried.ml | 4 +- analysis/vendor/res_syntax/res_utf8.ml | 16 +- analysis/vendor/res_syntax/res_utf8.mli | 6 +- tools/src/tools.ml | 2 +- 69 files changed, 8578 insertions(+), 9132 deletions(-) delete mode 100644 analysis/vendor/res_syntax/res_cli.ml diff --git a/analysis/src/Codemod.ml b/analysis/src/Codemod.ml index 5c273637d..1df04ede5 100644 --- a/analysis/src/Codemod.ml +++ b/analysis/src/Codemod.ml @@ -11,8 +11,8 @@ let transform ~path ~pos ~debug ~typ ~hint = | AddMissingCases -> ( let source = "let " ^ hint ^ " = ()" in let {Res_driver.parsetree = hintStructure} = - Res_driver.parse_implementation_from_source ~for_printer:false - ~display_filename:"" ~source + Res_driver.parseImplementationFromSource ~forPrinter:false + ~displayFilename:"" ~source in match hintStructure with | [{pstr_desc = Pstr_value (_, [{pvb_pat = pattern}])}] -> ( diff --git a/analysis/src/Commands.ml b/analysis/src/Commands.ml index 32bfe08ff..65c70e181 100644 --- a/analysis/src/Commands.ml +++ b/analysis/src/Commands.ml @@ -278,21 +278,17 @@ let rename ~path ~pos ~newName ~debug = let format ~path = if Filename.check_suffix path ".res" then let {Res_driver.parsetree = structure; comments; diagnostics} = - Res_driver.parsing_engine.parse_implementation ~for_printer:true + Res_driver.parsingEngine.parseImplementation ~forPrinter:true ~filename:path in if List.length diagnostics > 0 then "" - else - Res_printer.print_implementation ~width:!Res_cli.ResClflags.width - ~comments structure + else Res_printer.printImplementation ~width:80 ~comments structure else if Filename.check_suffix path ".resi" then let {Res_driver.parsetree = signature; comments; diagnostics} = - Res_driver.parsing_engine.parse_interface ~for_printer:true ~filename:path + Res_driver.parsingEngine.parseInterface ~forPrinter:true ~filename:path in if List.length diagnostics > 0 then "" - else - Res_printer.print_interface ~width:!Res_cli.ResClflags.width ~comments - signature + else Res_printer.printInterface ~width:80 ~comments signature else "" let diagnosticSyntax ~path = diff --git a/analysis/src/CompletionFrontEnd.ml b/analysis/src/CompletionFrontEnd.ml index ec3b5566f..34c887d76 100644 --- a/analysis/src/CompletionFrontEnd.ml +++ b/analysis/src/CompletionFrontEnd.ml @@ -77,7 +77,7 @@ let findArgCompletables ~(args : arg list) ~endPos ~posBeforeCursor if CursorPosition.locIsEmpty exp.pexp_loc ~pos:posBeforeCursor then someArgHadEmptyExprLoc := true; - if Res_parsetree_viewer.is_template_literal exp then None + if Res_parsetree_viewer.isTemplateLiteral exp then None else if exp.pexp_loc |> Loc.hasPos ~pos:posBeforeCursor then ( if Debug.verbose () then print_endline @@ -294,7 +294,7 @@ let rec exprToContextPathInner (e : Parsetree.expression) = and exprToContextPath (e : Parsetree.expression) = match - ( Res_parsetree_viewer.has_await_attribute e.pexp_attributes, + ( Res_parsetree_viewer.hasAwaitAttribute e.pexp_attributes, exprToContextPathInner e ) with | true, Some ctxPath -> Some (CPAwait ctxPath) @@ -1134,7 +1134,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor completionContext = (if isLikelyModulePath - && expr |> Res_parsetree_viewer.is_braced_expr + && expr |> Res_parsetree_viewer.isBracedExpr then ValueOrField else Value); })) @@ -1228,7 +1228,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor })) | None -> ()) | Pexp_apply ({pexp_desc = Pexp_ident compName}, args) - when Res_parsetree_viewer.is_jsx_expression expr -> + when Res_parsetree_viewer.isJsxExpression expr -> inJsxContext := true; let jsxProps = CompletionJsx.extractJsxProps ~compName ~args in let compNamePath = flattenLidCheckDot ~jsx:true compName in @@ -1585,7 +1585,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor if Filename.check_suffix path ".res" then ( let parser = - Res_driver.parsing_engine.parse_implementation ~for_printer:false + Res_driver.parsingEngine.parseImplementation ~forPrinter:false in let {Res_driver.parsetree = str} = parser ~filename:currentFile in iterator.structure iterator str |> ignore; @@ -1597,7 +1597,7 @@ let completionWithParser1 ~currentFile ~debug ~offset ~path ~posCursor if !found = false then if debug then Printf.printf "XXX Not found!\n"; !result) else if Filename.check_suffix path ".resi" then ( - let parser = Res_driver.parsing_engine.parse_interface ~for_printer:false in + let parser = Res_driver.parsingEngine.parseInterface ~forPrinter:false in let {Res_driver.parsetree = signature} = parser ~filename:currentFile in iterator.signature iterator signature |> ignore; if blankAfterCursor = Some ' ' || blankAfterCursor = Some '\n' then ( diff --git a/analysis/src/CreateInterface.ml b/analysis/src/CreateInterface.ml index 09fa7e0f9..6b76baa49 100644 --- a/analysis/src/CreateInterface.ml +++ b/analysis/src/CreateInterface.ml @@ -147,8 +147,7 @@ let printSignature ~extractor ~signature = Printtyp.reset_names (); let sigItemToString (item : Outcometree.out_sig_item) = - item |> Res_outcome_printer.print_out_sig_item_doc - |> Res_doc.to_string ~width:!Res_cli.ResClflags.width + item |> Res_outcome_printer.printOutSigItemDoc |> Res_doc.toString ~width:80 in let genSigStrForInlineAttr lines attributes id vd = diff --git a/analysis/src/Diagnostics.ml b/analysis/src/Diagnostics.ml index 0b30d0e33..b4c073425 100644 --- a/analysis/src/Diagnostics.ml +++ b/analysis/src/Diagnostics.ml @@ -3,10 +3,10 @@ let document_syntax ~path = diagnostics |> List.map (fun diagnostic -> let _, startline, startcol = - Location.get_pos_info (Res_diagnostics.get_start_pos diagnostic) + Location.get_pos_info (Res_diagnostics.getStartPos diagnostic) in let _, endline, endcol = - Location.get_pos_info (Res_diagnostics.get_end_pos diagnostic) + Location.get_pos_info (Res_diagnostics.getEndPos diagnostic) in Protocol.stringifyDiagnostic { @@ -21,14 +21,13 @@ let document_syntax ~path = in if FindFiles.isImplementation path then let parseImplementation = - Res_driver.parsing_engine.parse_implementation ~for_printer:false + Res_driver.parsingEngine.parseImplementation ~forPrinter:false ~filename:path in get_diagnostics parseImplementation.diagnostics else if FindFiles.isInterface path then let parseInterface = - Res_driver.parsing_engine.parse_interface ~for_printer:false - ~filename:path + Res_driver.parsingEngine.parseInterface ~forPrinter:false ~filename:path in get_diagnostics parseInterface.diagnostics else [] diff --git a/analysis/src/DocumentSymbol.ml b/analysis/src/DocumentSymbol.ml index 44580f1e6..7beaafc0d 100644 --- a/analysis/src/DocumentSymbol.ml +++ b/analysis/src/DocumentSymbol.ml @@ -136,14 +136,12 @@ let command ~path = (if Filename.check_suffix path ".res" then let parser = - Res_driver.parsing_engine.parse_implementation ~for_printer:false + Res_driver.parsingEngine.parseImplementation ~forPrinter:false in let {Res_driver.parsetree = structure} = parser ~filename:path in iterator.structure iterator structure |> ignore else - let parser = - Res_driver.parsing_engine.parse_interface ~for_printer:false - in + let parser = Res_driver.parsingEngine.parseInterface ~forPrinter:false in let {Res_driver.parsetree = signature} = parser ~filename:path in iterator.signature iterator signature |> ignore); let isInside diff --git a/analysis/src/DumpAst.ml b/analysis/src/DumpAst.ml index 0515dc9fc..60395a60b 100644 --- a/analysis/src/DumpAst.ml +++ b/analysis/src/DumpAst.ml @@ -313,7 +313,7 @@ let printStructItem structItem ~pos ~source = let dump ~currentFile ~pos = let {Res_driver.parsetree = structure; source} = - Res_driver.parsing_engine.parse_implementation ~for_printer:true + Res_driver.parsingEngine.parseImplementation ~forPrinter:true ~filename:currentFile in diff --git a/analysis/src/Hint.ml b/analysis/src/Hint.ml index 9f553d063..163aee250 100644 --- a/analysis/src/Hint.ml +++ b/analysis/src/Hint.ml @@ -72,7 +72,7 @@ let inlay ~path ~pos ~maxLength ~debug = let iterator = {Ast_iterator.default_iterator with value_binding} in (if Files.classifySourceFile path = Res then let parser = - Res_driver.parsing_engine.parse_implementation ~for_printer:false + Res_driver.parsingEngine.parseImplementation ~forPrinter:false in let {Res_driver.parsetree = structure} = parser ~filename:path in iterator.structure iterator structure |> ignore); @@ -136,7 +136,7 @@ let codeLens ~path ~debug = where the definition itself will be the same thing as what would've been printed in the code lens. *) (if Files.classifySourceFile path = Res then let parser = - Res_driver.parsing_engine.parse_implementation ~for_printer:false + Res_driver.parsingEngine.parseImplementation ~forPrinter:false in let {Res_driver.parsetree = structure} = parser ~filename:path in iterator.structure iterator structure |> ignore); diff --git a/analysis/src/PrintType.ml b/analysis/src/PrintType.ml index 3234d11b4..3fe104398 100644 --- a/analysis/src/PrintType.ml +++ b/analysis/src/PrintType.ml @@ -1,11 +1,11 @@ let printExpr ?(lineWidth = 60) typ = Printtyp.reset_names (); Printtyp.reset_and_mark_loops typ; - Res_doc.to_string ~width:lineWidth - (Res_outcome_printer.print_out_type_doc (Printtyp.tree_of_typexp false typ)) + Res_doc.toString ~width:lineWidth + (Res_outcome_printer.printOutTypeDoc (Printtyp.tree_of_typexp false typ)) let printDecl ?printNameAsIs ~recStatus name decl = Printtyp.reset_names (); - Res_doc.to_string ~width:60 - (Res_outcome_printer.print_out_sig_item_doc ?print_name_as_is:printNameAsIs + Res_doc.toString ~width:60 + (Res_outcome_printer.printOutSigItemDoc ?printNameAsIs (Printtyp.tree_of_type_declaration (Ident.create name) decl recStatus)) diff --git a/analysis/src/ProcessCmt.ml b/analysis/src/ProcessCmt.ml index b60ded55d..44d2cd907 100644 --- a/analysis/src/ProcessCmt.ml +++ b/analysis/src/ProcessCmt.ml @@ -27,7 +27,7 @@ let mapRecordField {Types.ld_id; ld_type; ld_attributes} = stamp = astamp; fname = Location.mknoloc name; typ = ld_type; - optional = Res_parsetree_viewer.has_optional_attribute ld_attributes; + optional = Res_parsetree_viewer.hasOptionalAttribute ld_attributes; docstring = (match ProcessAttributes.findDocAttribute ld_attributes with | None -> [] @@ -261,7 +261,7 @@ let forTypeDeclaration ~env ~(exported : Exported.t) typ = f.ld_type.ctyp_type; optional = Res_parsetree_viewer - .has_optional_attribute + .hasOptionalAttribute f.ld_attributes; docstring = (match @@ -308,7 +308,7 @@ let forTypeDeclaration ~env ~(exported : Exported.t) fname; typ = ctyp_type; optional = - Res_parsetree_viewer.has_optional_attribute + Res_parsetree_viewer.hasOptionalAttribute ld_attributes; docstring = attrsToDocstring ld_attributes; deprecated = diff --git a/analysis/src/SemanticTokens.ml b/analysis/src/SemanticTokens.ml index 58564aa1f..9ddd47b61 100644 --- a/analysis/src/SemanticTokens.ml +++ b/analysis/src/SemanticTokens.ml @@ -247,7 +247,7 @@ let command ~debug ~emitter ~path = ~lid ~debug; Ast_iterator.default_iterator.expr iterator e | Pexp_apply ({pexp_desc = Pexp_ident lident; pexp_loc}, args) - when Res_parsetree_viewer.is_jsx_expression e -> + when Res_parsetree_viewer.isJsxExpression e -> (* Angled brackets: - These are handled in the grammar: <> @@ -440,7 +440,7 @@ let command ~debug ~emitter ~path = if Files.classifySourceFile path = Res then ( let parser = - Res_driver.parsing_engine.parse_implementation ~for_printer:false + Res_driver.parsingEngine.parseImplementation ~forPrinter:false in let {Res_driver.parsetree = structure; diagnostics} = parser ~filename:path @@ -450,7 +450,7 @@ let command ~debug ~emitter ~path = (List.length structure) (List.length diagnostics); iterator.structure iterator structure |> ignore) else - let parser = Res_driver.parsing_engine.parse_interface ~for_printer:false in + let parser = Res_driver.parsingEngine.parseInterface ~forPrinter:false in let {Res_driver.parsetree = signature; diagnostics} = parser ~filename:path in diff --git a/analysis/src/SignatureHelp.ml b/analysis/src/SignatureHelp.ml index c2e148de8..489c070b2 100644 --- a/analysis/src/SignatureHelp.ml +++ b/analysis/src/SignatureHelp.ml @@ -427,7 +427,7 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = in let iterator = {Ast_iterator.default_iterator with expr; pat} in let parser = - Res_driver.parsing_engine.parse_implementation ~for_printer:false + Res_driver.parsingEngine.parseImplementation ~forPrinter:false in let {Res_driver.parsetree = structure} = parser ~filename:currentFile in iterator.structure iterator structure |> ignore; @@ -456,8 +456,8 @@ let signatureHelp ~path ~pos ~currentFile ~debug ~allowForConstructorPayloads = let fnTypeStr = Shared.typeToString type_expr in let typeStrForParser = labelPrefix ^ fnTypeStr in let {Res_driver.parsetree = signature} = - Res_driver.parse_interface_from_source ~for_printer:false - ~display_filename:"" ~source:typeStrForParser + Res_driver.parseInterfaceFromSource ~forPrinter:false + ~displayFilename:"" ~source:typeStrForParser in let parameters = diff --git a/analysis/src/Utils.ml b/analysis/src/Utils.ml index d136c181a..bb9f94a2e 100644 --- a/analysis/src/Utils.ml +++ b/analysis/src/Utils.ml @@ -259,7 +259,7 @@ let printMaybeExoticIdent ?(allowUident = false) txt = | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '\'' | '_' -> loop (i + 1) | _ -> "\"" ^ txt ^ "\"" in - if Res_token.is_keyword_txt txt then "\"" ^ txt ^ "\"" else loop 0 + if Res_token.isKeywordTxt txt then "\"" ^ txt ^ "\"" else loop 0 let findPackageJson root = let path = Uri.toPath root in diff --git a/analysis/src/Xform.ml b/analysis/src/Xform.ml index 904fa5bf8..4bb0bb769 100644 --- a/analysis/src/Xform.ml +++ b/analysis/src/Xform.ml @@ -1,6 +1,6 @@ (** Code transformations using the parser/printer and ast operations *) -let isBracedExpr = Res_parsetree_viewer.is_braced_expr +let isBracedExpr = Res_parsetree_viewer.isBracedExpr let extractTypeFromExpr expr ~debug ~path ~currentFile ~full ~pos = match @@ -447,7 +447,7 @@ module ExpandCatchAllForVariants = struct let newText = missingConstructors |> List.map (fun (c : SharedTypes.polyVariantConstructor) -> - Res_printer.polyvar_ident_to_string c.name + Res_printer.polyVarIdentToString c.name ^ match c.args with | [] -> "" @@ -504,7 +504,7 @@ module ExpandCatchAllForVariants = struct (fun (c : SharedTypes.polyVariantConstructor) -> if currentConstructorNames |> List.mem c.name = false then Some - ( Res_printer.polyvar_ident_to_string c.name, + ( Res_printer.polyVarIdentToString c.name, match c.args with | [] -> false | _ -> true ) @@ -841,7 +841,7 @@ end let parseImplementation ~filename = let {Res_driver.parsetree = structure; comments} = - Res_driver.parsing_engine.parse_implementation ~for_printer:false ~filename + Res_driver.parsingEngine.parseImplementation ~forPrinter:false ~filename in let filterComments ~loc comments = (* Relevant comments in the range of the expression *) @@ -853,7 +853,7 @@ let parseImplementation ~filename = let printExpr ~(range : Protocol.range) (expr : Parsetree.expression) = let structure = [Ast_helper.Str.eval ~loc:expr.pexp_loc expr] in structure - |> Res_printer.print_implementation ~width:!Res_cli.ResClflags.width + |> Res_printer.printImplementation ~width:80 ~comments:(comments |> filterComments ~loc:expr.pexp_loc) |> Utils.indent range.start.character in @@ -861,20 +861,20 @@ let parseImplementation ~filename = (item : Parsetree.structure_item) = let structure = [item] in structure - |> Res_printer.print_implementation ~width:!Res_cli.ResClflags.width + |> Res_printer.printImplementation ~width:80 ~comments:(comments |> filterComments ~loc:item.pstr_loc) |> Utils.indent range.start.character in let printStandaloneStructure ~(loc : Location.t) structure = structure - |> Res_printer.print_implementation ~width:!Res_cli.ResClflags.width + |> Res_printer.printImplementation ~width:80 ~comments:(comments |> filterComments ~loc) in (structure, printExpr, printStructureItem, printStandaloneStructure) let parseInterface ~filename = let {Res_driver.parsetree = structure; comments} = - Res_driver.parsing_engine.parse_interface ~for_printer:false ~filename + Res_driver.parsingEngine.parseInterface ~forPrinter:false ~filename in let filterComments ~loc comments = (* Relevant comments in the range of the expression *) @@ -887,7 +887,7 @@ let parseInterface ~filename = (item : Parsetree.signature_item) = let signature_item = [item] in signature_item - |> Res_printer.print_interface ~width:!Res_cli.ResClflags.width + |> Res_printer.printInterface ~width:80 ~comments:(comments |> filterComments ~loc:item.psig_loc) |> Utils.indent range.start.character in diff --git a/analysis/vendor/ml/ast_async.ml b/analysis/vendor/ml/ast_async.ml index 4ed394708..f383001c6 100644 --- a/analysis/vendor/ml/ast_async.ml +++ b/analysis/vendor/ml/ast_async.ml @@ -14,8 +14,7 @@ let add_promise_type ?(loc = Location.none) ~async let add_async_attribute ~async (body : Parsetree.expression) = if async then match body.pexp_desc with - | Pexp_construct (x, Some e) when Ast_uncurried.expr_is_uncurried_fun body - -> + | Pexp_construct (x, Some e) when Ast_uncurried.exprIsUncurriedFun body -> { body with pexp_desc = diff --git a/analysis/vendor/ml/ast_uncurried.ml b/analysis/vendor/ml/ast_uncurried.ml index 3d36fcc65..432bb6cab 100644 --- a/analysis/vendor/ml/ast_uncurried.ml +++ b/analysis/vendor/ml/ast_uncurried.ml @@ -1,23 +1,24 @@ (* Uncurried AST *) + let encode_arity_string arity = "Has_arity" ^ string_of_int arity -let decode_arity_string arity_s = - int_of_string - ((String.sub [@doesNotRaise]) arity_s 9 (String.length arity_s - 9)) +let decode_arity_string arity_s = int_of_string ((String.sub [@doesNotRaise]) arity_s 9 (String.length arity_s - 9)) -let arity_type ~loc arity = +let arityType ~loc arity = Ast_helper.Typ.variant ~loc - [Rtag ({txt = encode_arity_string arity; loc}, [], true, [])] + [ Rtag ({ txt = encode_arity_string arity; loc }, [], true, []) ] Closed None -let arity_from_type (typ : Parsetree.core_type) = +let arityFromType (typ : Parsetree.core_type) = match typ.ptyp_desc with | Ptyp_variant ([Rtag ({txt}, _, _, _)], _, _) -> decode_arity_string txt | _ -> assert false -let uncurried_type ~loc ~arity t_arg = - let t_arity = arity_type ~loc arity in - Ast_helper.Typ.constr ~loc {txt = Lident "function$"; loc} [t_arg; t_arity] +let uncurriedType ~loc ~arity tArg = + let tArity = arityType ~loc arity in + Ast_helper.Typ.constr ~loc + { txt = Lident "function$"; loc } + [ tArg; tArity ] let arity_to_attributes arity = [ @@ -32,53 +33,54 @@ let arity_to_attributes arity = let rec attributes_to_arity (attrs : Parsetree.attributes) = match attrs with - | ( {txt = "res.arity"}, + | ( { txt = "res.arity" }, PStr [ { pstr_desc = Pstr_eval - ({pexp_desc = Pexp_constant (Pconst_integer (arity, _))}, _); + ({ pexp_desc = Pexp_constant (Pconst_integer (arity, _)) }, _); }; ] ) :: _ -> - int_of_string arity + int_of_string arity | _ :: rest -> attributes_to_arity rest | _ -> assert false -let uncurried_fun ~loc ~arity fun_expr = - Ast_helper.Exp.construct ~loc - ~attrs:(arity_to_attributes arity) - (Location.mknoloc (Longident.Lident "Function$")) - (Some fun_expr) +let uncurriedFun ~loc ~arity funExpr = + Ast_helper.Exp.construct ~loc + ~attrs:(arity_to_attributes arity) + (Location.mknoloc (Longident.Lident "Function$")) + (Some funExpr) -let expr_is_uncurried_fun (expr : Parsetree.expression) = +let exprIsUncurriedFun (expr : Parsetree.expression) = match expr.pexp_desc with - | Pexp_construct ({txt = Lident "Function$"}, Some _) -> true + | Pexp_construct ({ txt = Lident "Function$" }, Some _) -> true | _ -> false -let expr_extract_uncurried_fun (expr : Parsetree.expression) = +let exprExtractUncurriedFun (expr : Parsetree.expression) = match expr.pexp_desc with - | Pexp_construct ({txt = Lident "Function$"}, Some e) -> e + | Pexp_construct ({ txt = Lident "Function$" }, Some e) -> e | _ -> assert false -let core_type_is_uncurried_fun (typ : Parsetree.core_type) = +let coreTypeIsUncurriedFun (typ : Parsetree.core_type) = match typ.ptyp_desc with | Ptyp_constr ({txt = Lident "function$"}, [{ptyp_desc = Ptyp_arrow _}; _]) -> true | _ -> false -let core_type_extract_uncurried_fun (typ : Parsetree.core_type) = +let coreTypeExtractUncurriedFun (typ : Parsetree.core_type) = match typ.ptyp_desc with - | Ptyp_constr ({txt = Lident "function$"}, [t_arg; t_arity]) -> - (arity_from_type t_arity, t_arg) + | Ptyp_constr ({txt = Lident "function$"}, [tArg; tArity]) -> + (arityFromType tArity, tArg) | _ -> assert false -let type_is_uncurried_fun = Ast_uncurried_utils.type_is_uncurried_fun +let typeIsUncurriedFun = Ast_uncurried_utils.typeIsUncurriedFun -let type_extract_uncurried_fun (typ : Types.type_expr) = +let typeExtractUncurriedFun (typ : Types.type_expr) = match typ.desc with - | Tconstr (Pident {name = "function$"}, [t_arg; _], _) -> t_arg + | Tconstr (Pident {name = "function$"}, [tArg; _], _) -> + tArg | _ -> assert false (* Typed AST *) @@ -88,7 +90,7 @@ let arity_to_type arity = Ctype.newty (Tvariant { - row_fields = [(arity_s, Rpresent None)]; + row_fields = [ (arity_s, Rpresent None) ]; row_more = Ctype.newty Tnil; row_bound = (); row_closed = true; @@ -96,25 +98,28 @@ let arity_to_type arity = row_name = None; }) -let type_to_arity (t_arity : Types.type_expr) = - match (Ctype.repr t_arity).desc with - | Tvariant {row_fields = [(label, _)]} -> decode_arity_string label +let type_to_arity (tArity : Types.type_expr) = + match (Ctype.repr tArity).desc with + | Tvariant { row_fields = [ (label, _) ] } -> decode_arity_string label | _ -> assert false let make_uncurried_type ~env ~arity t = let typ_arity = arity_to_type arity in let lid : Longident.t = Lident "function$" in let path = Env.lookup_type lid env in - Ctype.newconstr path [t; typ_arity] + Ctype.newconstr path [ t; typ_arity ] let uncurried_type_get_arity ~env typ = match (Ctype.expand_head env typ).desc with - | Tconstr (Pident {name = "function$"}, [_t; t_arity], _) -> - type_to_arity t_arity + | Tconstr (Pident { name = "function$" }, [ _t; tArity ], _) -> + type_to_arity tArity | _ -> assert false let uncurried_type_get_arity_opt ~env typ = match (Ctype.expand_head env typ).desc with - | Tconstr (Pident {name = "function$"}, [_t; t_arity], _) -> - Some (type_to_arity t_arity) + | Tconstr (Pident { name = "function$" }, [ _t; tArity ], _) -> + Some (type_to_arity tArity) | _ -> None + + + diff --git a/analysis/vendor/ml/ast_uncurried_utils.ml b/analysis/vendor/ml/ast_uncurried_utils.ml index fd0ea8983..ad18b01a6 100644 --- a/analysis/vendor/ml/ast_uncurried_utils.ml +++ b/analysis/vendor/ml/ast_uncurried_utils.ml @@ -1,4 +1,5 @@ -let type_is_uncurried_fun (typ : Types.type_expr) = +let typeIsUncurriedFun (typ : Types.type_expr) = match typ.desc with - | Tconstr (Pident {name = "function$"}, [{desc = Tarrow _}; _], _) -> true - | _ -> false + | Tconstr (Pident {name = "function$"}, [{desc = Tarrow _}; _], _) -> + true + | _ -> false \ No newline at end of file diff --git a/analysis/vendor/ml/ast_untagged_variants.ml b/analysis/vendor/ml/ast_untagged_variants.ml index 6566693af..79bf7f598 100644 --- a/analysis/vendor/ml/ast_untagged_variants.ml +++ b/analysis/vendor/ml/ast_untagged_variants.ml @@ -185,7 +185,7 @@ let get_block_type_from_typ ~env (t : Types.type_expr) : block_type option = Some BigintType | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_bool -> Some BooleanType - | {desc = Tconstr _} as t when Ast_uncurried_utils.type_is_uncurried_fun t -> + | {desc = Tconstr _} as t when Ast_uncurried_utils.typeIsUncurriedFun t -> Some FunctionType | {desc = Tarrow _} -> Some FunctionType | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_string -> diff --git a/analysis/vendor/ml/transl_recmodule.ml b/analysis/vendor/ml/transl_recmodule.ml index 102eca421..23210cf00 100644 --- a/analysis/vendor/ml/transl_recmodule.ml +++ b/analysis/vendor/ml/transl_recmodule.ml @@ -50,7 +50,7 @@ let init_shape modl = | [] -> [] | Sig_value (id, {val_kind = Val_reg; val_type = ty}) :: rem -> let is_function t = - Ast_uncurried_utils.type_is_uncurried_fun t + Ast_uncurried_utils.typeIsUncurriedFun t || match t.desc with | Tarrow _ -> true diff --git a/analysis/vendor/ml/typecore.ml b/analysis/vendor/ml/typecore.ml index 909d73bab..e16303b89 100644 --- a/analysis/vendor/ml/typecore.ml +++ b/analysis/vendor/ml/typecore.ml @@ -293,7 +293,7 @@ let extract_concrete_record env ty = let extract_concrete_variant env ty = match extract_concrete_typedecl env ty with | p0, p, {type_kind = Type_variant cstrs} - when not (Ast_uncurried.type_is_uncurried_fun ty) -> + when not (Ast_uncurried.typeIsUncurriedFun ty) -> (p0, p, cstrs) | p0, p, {type_kind = Type_open} -> (p0, p, []) | _ -> raise Not_found @@ -690,8 +690,8 @@ let rec collect_missing_arguments env type1 type2 = match collect_missing_arguments env typ type2 with | Some res -> Some ((label, argtype) :: res) | None -> None) - | t when Ast_uncurried.type_is_uncurried_fun t -> - let typ = Ast_uncurried.type_extract_uncurried_fun t in + | t when Ast_uncurried.typeIsUncurriedFun t -> + let typ = Ast_uncurried.typeExtractUncurriedFun t in collect_missing_arguments env typ type2 | _ -> None diff --git a/analysis/vendor/res_syntax/jsx_common.ml b/analysis/vendor/res_syntax/jsx_common.ml index fa55a802e..5379e10e5 100644 --- a/analysis/vendor/res_syntax/jsx_common.ml +++ b/analysis/vendor/res_syntax/jsx_common.ml @@ -1,73 +1,73 @@ open Asttypes open Parsetree -type jsx_config = { +type jsxConfig = { mutable version: int; mutable module_: string; mutable mode: string; - mutable nested_modules: string list; - mutable has_component: bool; + mutable nestedModules: string list; + mutable hasComponent: bool; } (* Helper method to look up the [@react.component] attribute *) -let has_attr (loc, _) = +let hasAttr (loc, _) = match loc.txt with | "react.component" | "jsx.component" -> true | _ -> false (* Iterate over the attributes and try to find the [@react.component] attribute *) -let has_attr_on_binding {pvb_attributes} = - List.find_opt has_attr pvb_attributes <> None +let hasAttrOnBinding {pvb_attributes} = + List.find_opt hasAttr pvb_attributes <> None -let core_type_of_attrs attributes = +let coreTypeOfAttrs attributes = List.find_map (fun ({txt}, payload) -> match (txt, payload) with - | ("react.component" | "jsx.component"), PTyp core_type -> Some core_type + | ("react.component" | "jsx.component"), PTyp coreType -> Some coreType | _ -> None) attributes -let typ_vars_of_core_type {ptyp_desc} = +let typVarsOfCoreType {ptyp_desc} = match ptyp_desc with - | Ptyp_constr (_, core_types) -> + | Ptyp_constr (_, coreTypes) -> List.filter (fun {ptyp_desc} -> match ptyp_desc with | Ptyp_var _ -> true | _ -> false) - core_types + coreTypes | _ -> [] -let raise_error ~loc msg = Location.raise_errorf ~loc msg +let raiseError ~loc msg = Location.raise_errorf ~loc msg -let raise_error_multiple_component ~loc = - raise_error ~loc +let raiseErrorMultipleComponent ~loc = + raiseError ~loc "Only one component definition is allowed for each module. Move to a \ submodule or other file if necessary." -let optional_attr = ({txt = "res.optional"; loc = Location.none}, PStr []) +let optionalAttr = ({txt = "res.optional"; loc = Location.none}, PStr []) -let extract_uncurried typ = - if Ast_uncurried.core_type_is_uncurried_fun typ then - let _arity, t = Ast_uncurried.core_type_extract_uncurried_fun typ in +let extractUncurried typ = + if Ast_uncurried.coreTypeIsUncurriedFun typ then + let _arity, t = Ast_uncurried.coreTypeExtractUncurriedFun typ in t else typ -let remove_arity binding = - let rec remove_arity_record expr = +let removeArity binding = + let rec removeArityRecord expr = match expr.pexp_desc with - | _ when Ast_uncurried.expr_is_uncurried_fun expr -> - Ast_uncurried.expr_extract_uncurried_fun expr + | _ when Ast_uncurried.exprIsUncurriedFun expr -> + Ast_uncurried.exprExtractUncurriedFun expr | Pexp_newtype (label, e) -> - {expr with pexp_desc = Pexp_newtype (label, remove_arity_record e)} - | Pexp_apply (forward_ref, [(label, e)]) -> + {expr with pexp_desc = Pexp_newtype (label, removeArityRecord e)} + | Pexp_apply (forwardRef, [(label, e)]) -> { expr with - pexp_desc = Pexp_apply (forward_ref, [(label, remove_arity_record e)]); + pexp_desc = Pexp_apply (forwardRef, [(label, removeArityRecord e)]); } | _ -> expr in - {binding with pvb_expr = remove_arity_record binding.pvb_expr} + {binding with pvb_expr = removeArityRecord binding.pvb_expr} let async_component ~async expr = if async then diff --git a/analysis/vendor/res_syntax/jsx_ppx.ml b/analysis/vendor/res_syntax/jsx_ppx.ml index baf3da544..e0e1cac10 100644 --- a/analysis/vendor/res_syntax/jsx_ppx.ml +++ b/analysis/vendor/res_syntax/jsx_ppx.ml @@ -3,20 +3,20 @@ open Asttypes open Parsetree open Longident -let get_payload_fields payload = +let getPayloadFields payload = match payload with | PStr ({ pstr_desc = - Pstr_eval ({pexp_desc = Pexp_record (record_fields, None)}, _); + Pstr_eval ({pexp_desc = Pexp_record (recordFields, None)}, _); } :: _rest) -> - record_fields + recordFields | _ -> [] -type config_key = Int | String +type configKey = Int | String -let get_jsx_config_by_key ~key ~type_ record_fields = +let getJsxConfigByKey ~key ~type_ recordFields = let values = List.filter_map (fun ((lid, expr) : Longident.t Location.loc * expression) -> @@ -33,56 +33,50 @@ let get_jsx_config_by_key ~key ~type_ record_fields = when k = key -> Some value | _ -> None) - record_fields + recordFields in match values with | [] -> None | [v] | v :: _ -> Some v -let get_int ~key fields = - match fields |> get_jsx_config_by_key ~key ~type_:Int with +let getInt ~key fields = + match fields |> getJsxConfigByKey ~key ~type_:Int with | None -> None | Some s -> int_of_string_opt s -let get_string ~key fields = fields |> get_jsx_config_by_key ~key ~type_:String +let getString ~key fields = fields |> getJsxConfigByKey ~key ~type_:String -let update_config config payload = - let fields = get_payload_fields payload in - let module_raw = get_string ~key:"module_" fields in - let is_generic = - match module_raw |> Option.map (fun m -> String.lowercase_ascii m) with +let updateConfig config payload = + let fields = getPayloadFields payload in + let moduleRaw = getString ~key:"module_" fields in + let isGeneric = + match moduleRaw |> Option.map (fun m -> String.lowercase_ascii m) with | Some "react" | None -> false | Some _ -> true in - (match (is_generic, get_int ~key:"version" fields) with + (match (isGeneric, getInt ~key:"version" fields) with | true, _ -> config.Jsx_common.version <- 4 | false, Some i -> config.Jsx_common.version <- i | _ -> ()); - (match module_raw with + (match moduleRaw with | None -> () | Some s -> config.module_ <- s); - match (is_generic, get_string ~key:"mode" fields) with + match (isGeneric, getString ~key:"mode" fields) with | true, _ -> config.mode <- "automatic" | false, Some s -> config.mode <- s | _ -> () -let is_jsx_config_attr ((loc, _) : attribute) = loc.txt = "jsxConfig" +let isJsxConfigAttr ((loc, _) : attribute) = loc.txt = "jsxConfig" -let process_config_attribute attribute config = - if is_jsx_config_attr attribute then update_config config (snd attribute) +let processConfigAttribute attribute config = + if isJsxConfigAttr attribute then updateConfig config (snd attribute) -let get_mapper ~config = - let ( expr3, - module_binding3, - transform_signature_item3, - transform_structure_item3 ) = - Reactjs_jsx_v3.jsx_mapper ~config +let getMapper ~config = + let expr3, module_binding3, transformSignatureItem3, transformStructureItem3 = + Reactjs_jsx_v3.jsxMapper ~config in - let ( expr4, - module_binding4, - transform_signature_item4, - transform_structure_item4 ) = - Jsx_v4.jsx_mapper ~config + let expr4, module_binding4, transformSignatureItem4, transformStructureItem4 = + Jsx_v4.jsxMapper ~config in let expr mapper e = @@ -97,86 +91,86 @@ let get_mapper ~config = | 4 -> module_binding4 mapper mb | _ -> default_mapper.module_binding mapper mb in - let save_config () = + let saveConfig () = { config with version = config.version; module_ = config.module_; mode = config.mode; - has_component = config.has_component; + hasComponent = config.hasComponent; } in - let restore_config old_config = - config.version <- old_config.Jsx_common.version; - config.module_ <- old_config.module_; - config.mode <- old_config.mode; - config.has_component <- old_config.has_component + let restoreConfig oldConfig = + config.version <- oldConfig.Jsx_common.version; + config.module_ <- oldConfig.module_; + config.mode <- oldConfig.mode; + config.hasComponent <- oldConfig.hasComponent in let signature mapper items = - let old_config = save_config () in - config.has_component <- false; + let oldConfig = saveConfig () in + config.hasComponent <- false; let result = List.map (fun item -> (match item.psig_desc with - | Psig_attribute attr -> process_config_attribute attr config + | Psig_attribute attr -> processConfigAttribute attr config | _ -> ()); let item = default_mapper.signature_item mapper item in - if config.version = 3 then transform_signature_item3 item - else if config.version = 4 then transform_signature_item4 item + if config.version = 3 then transformSignatureItem3 item + else if config.version = 4 then transformSignatureItem4 item else [item]) items |> List.flatten in - restore_config old_config; + restoreConfig oldConfig; result in let structure mapper items = - let old_config = save_config () in - config.has_component <- false; + let oldConfig = saveConfig () in + config.hasComponent <- false; let result = List.map (fun item -> (match item.pstr_desc with - | Pstr_attribute attr -> process_config_attribute attr config + | Pstr_attribute attr -> processConfigAttribute attr config | _ -> ()); let item = default_mapper.structure_item mapper item in - if config.version = 3 then transform_structure_item3 item - else if config.version = 4 then transform_structure_item4 item + if config.version = 3 then transformStructureItem3 item + else if config.version = 4 then transformStructureItem4 item else [item]) items |> List.flatten in - restore_config old_config; + restoreConfig oldConfig; result in {default_mapper with expr; module_binding; signature; structure} -let rewrite_implementation ~jsx_version ~jsx_module ~jsx_mode +let rewrite_implementation ~jsxVersion ~jsxModule ~jsxMode (code : Parsetree.structure) : Parsetree.structure = let config = { - Jsx_common.version = jsx_version; - module_ = jsx_module; - mode = jsx_mode; - nested_modules = []; - has_component = false; + Jsx_common.version = jsxVersion; + module_ = jsxModule; + mode = jsxMode; + nestedModules = []; + hasComponent = false; } in - let mapper = get_mapper ~config in + let mapper = getMapper ~config in mapper.structure mapper code -let rewrite_signature ~jsx_version ~jsx_module ~jsx_mode +let rewrite_signature ~jsxVersion ~jsxModule ~jsxMode (code : Parsetree.signature) : Parsetree.signature = let config = { - Jsx_common.version = jsx_version; - module_ = jsx_module; - mode = jsx_mode; - nested_modules = []; - has_component = false; + Jsx_common.version = jsxVersion; + module_ = jsxModule; + mode = jsxMode; + nestedModules = []; + hasComponent = false; } in - let mapper = get_mapper ~config in + let mapper = getMapper ~config in mapper.signature mapper code diff --git a/analysis/vendor/res_syntax/jsx_ppx.mli b/analysis/vendor/res_syntax/jsx_ppx.mli index 0f7c808c6..36a846868 100644 --- a/analysis/vendor/res_syntax/jsx_ppx.mli +++ b/analysis/vendor/res_syntax/jsx_ppx.mli @@ -9,15 +9,15 @@ *) val rewrite_implementation : - jsx_version:int -> - jsx_module:string -> - jsx_mode:string -> + jsxVersion:int -> + jsxModule:string -> + jsxMode:string -> Parsetree.structure -> Parsetree.structure val rewrite_signature : - jsx_version:int -> - jsx_module:string -> - jsx_mode:string -> + jsxVersion:int -> + jsxModule:string -> + jsxMode:string -> Parsetree.signature -> Parsetree.signature diff --git a/analysis/vendor/res_syntax/jsx_v4.ml b/analysis/vendor/res_syntax/jsx_v4.ml index ad5a99d4f..89427fb72 100644 --- a/analysis/vendor/res_syntax/jsx_v4.ml +++ b/analysis/vendor/res_syntax/jsx_v4.ml @@ -1,10 +1,10 @@ -open! Ast_helper +open Ast_helper open Ast_mapper open Asttypes open Parsetree open Longident -let module_access_name config value = +let moduleAccessName config value = String.capitalize_ascii config.Jsx_common.module_ ^ "." ^ value |> Longident.parse @@ -12,58 +12,58 @@ let nolabel = Nolabel let labelled str = Labelled str -let is_optional str = +let isOptional str = match str with | Optional _ -> true | _ -> false -let is_labelled str = +let isLabelled str = match str with | Labelled _ -> true | _ -> false -let is_forward_ref = function +let isForwardRef = function | {pexp_desc = Pexp_ident {txt = Ldot (Lident "React", "forwardRef")}} -> true | _ -> false -let get_label str = +let getLabel str = match str with | Optional str | Labelled str -> str | Nolabel -> "" -let optional_attrs = [Jsx_common.optional_attr] +let optionalAttrs = [Jsx_common.optionalAttr] -let constant_string ~loc str = +let constantString ~loc str = Ast_helper.Exp.constant ~loc (Pconst_string (str, None)) (* {} empty record *) -let empty_record ~loc = Exp.record ~loc [] None +let emptyRecord ~loc = Exp.record ~loc [] None -let unit_expr ~loc = Exp.construct ~loc (Location.mkloc (Lident "()") loc) None +let unitExpr ~loc = Exp.construct ~loc (Location.mkloc (Lident "()") loc) None -let safe_type_from_value value_str = - let value_str = get_label value_str in - if value_str = "" || (value_str.[0] [@doesNotRaise]) <> '_' then value_str - else "T" ^ value_str +let safeTypeFromValue valueStr = + let valueStr = getLabel valueStr in + if valueStr = "" || (valueStr.[0] [@doesNotRaise]) <> '_' then valueStr + else "T" ^ valueStr -let ref_type_var loc = Typ.var ~loc "ref" +let refTypeVar loc = Typ.var ~loc "ref" -let ref_type loc = +let refType loc = Typ.constr ~loc {loc; txt = Ldot (Ldot (Lident "Js", "Nullable"), "t")} - [ref_type_var loc] + [refTypeVar loc] type 'a children = ListLiteral of 'a | Exact of 'a (* if children is a list, convert it to an array while mapping each element. If not, just map over it, as usual *) -let transform_children_if_list_upper ~mapper the_list = - let rec transformChildren_ the_list accum = +let transformChildrenIfListUpper ~mapper theList = + let rec transformChildren_ theList accum = (* not in the sense of converting a list to an array; convert the AST reprensentation of a list to the AST reprensentation of an array *) - match the_list with + match theList with | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> ( match accum with - | [single_element] -> Exact single_element + | [singleElement] -> Exact singleElement | accum -> ListLiteral (Exp.array (List.rev accum))) | { pexp_desc = @@ -71,15 +71,15 @@ let transform_children_if_list_upper ~mapper the_list = ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple [v; acc]}); } -> transformChildren_ acc (mapper.expr mapper v :: accum) - | not_a_list -> Exact (mapper.expr mapper not_a_list) + | notAList -> Exact (mapper.expr mapper notAList) in - transformChildren_ the_list [] + transformChildren_ theList [] -let transform_children_if_list ~mapper the_list = - let rec transformChildren_ the_list accum = +let transformChildrenIfList ~mapper theList = + let rec transformChildren_ theList accum = (* not in the sense of converting a list to an array; convert the AST reprensentation of a list to the AST reprensentation of an array *) - match the_list with + match theList with | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> Exp.array (List.rev accum) | { @@ -88,97 +88,95 @@ let transform_children_if_list ~mapper the_list = ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple [v; acc]}); } -> transformChildren_ acc (mapper.expr mapper v :: accum) - | not_a_list -> mapper.expr mapper not_a_list + | notAList -> mapper.expr mapper notAList in - transformChildren_ the_list [] + transformChildren_ theList [] -let extract_children ?(remove_last_position_unit = false) ~loc - props_and_children = +let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren = let rec allButLast_ lst acc = match lst with | [] -> [] | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] -> acc | (Nolabel, {pexp_loc}) :: _rest -> - Jsx_common.raise_error ~loc:pexp_loc + Jsx_common.raiseError ~loc:pexp_loc "JSX: found non-labelled argument before the last position" | arg :: rest -> allButLast_ rest (arg :: acc) in - let all_but_last lst = allButLast_ lst [] |> List.rev in + let allButLast lst = allButLast_ lst [] |> List.rev in match List.partition (fun (label, _) -> label = labelled "children") - props_and_children + propsAndChildren with | [], props -> (* no children provided? Place a placeholder list *) ( Exp.construct {loc = Location.none; txt = Lident "[]"} None, - if remove_last_position_unit then all_but_last props else props ) - | [(_, children_expr)], props -> - ( children_expr, - if remove_last_position_unit then all_but_last props else props ) + if removeLastPositionUnit then allButLast props else props ) + | [(_, childrenExpr)], props -> + (childrenExpr, if removeLastPositionUnit then allButLast props else props) | _ -> - Jsx_common.raise_error ~loc + Jsx_common.raiseError ~loc "JSX: somehow there's more than one `children` label" -let merlin_focus = ({loc = Location.none; txt = "merlin.focus"}, PStr []) +let merlinFocus = ({loc = Location.none; txt = "merlin.focus"}, PStr []) (* Helper method to filter out any attribute that isn't [@react.component] *) -let other_attrs_pure (loc, _) = +let otherAttrsPure (loc, _) = match loc.txt with | "react.component" | "jsx.component" -> false | _ -> true (* Finds the name of the variable the binding is assigned to, otherwise raises Invalid_argument *) -let rec get_fn_name binding = +let rec getFnName binding = match binding with | {ppat_desc = Ppat_var {txt}} -> txt - | {ppat_desc = Ppat_constraint (pat, _)} -> get_fn_name pat + | {ppat_desc = Ppat_constraint (pat, _)} -> getFnName pat | {ppat_loc} -> - Jsx_common.raise_error ~loc:ppat_loc + Jsx_common.raiseError ~loc:ppat_loc "JSX component calls cannot be destructured." -let make_new_binding binding expression new_name = +let makeNewBinding binding expression newName = match binding with | {pvb_pat = {ppat_desc = Ppat_var ppat_var} as pvb_pat} -> { binding with pvb_pat = - {pvb_pat with ppat_desc = Ppat_var {ppat_var with txt = new_name}}; + {pvb_pat with ppat_desc = Ppat_var {ppat_var with txt = newName}}; pvb_expr = expression; - pvb_attributes = [merlin_focus]; + pvb_attributes = [merlinFocus]; } | {pvb_loc} -> - Jsx_common.raise_error ~loc:pvb_loc + Jsx_common.raiseError ~loc:pvb_loc "JSX component calls cannot be destructured." (* Lookup the filename from the location information on the AST node and turn it into a valid module identifier *) -let filename_from_loc (pstr_loc : Location.t) = - let file_name = +let filenameFromLoc (pstr_loc : Location.t) = + let fileName = match pstr_loc.loc_start.pos_fname with | "" -> !Location.input_name - | file_name -> file_name + | fileName -> fileName in - let file_name = - try Filename.chop_extension (Filename.basename file_name) - with Invalid_argument _ -> file_name + let fileName = + try Filename.chop_extension (Filename.basename fileName) + with Invalid_argument _ -> fileName in - let file_name = String.capitalize_ascii file_name in - file_name + let fileName = String.capitalize_ascii fileName in + fileName (* Build a string representation of a module name with segments separated by $ *) -let make_module_name file_name nested_modules fn_name = - let full_module_name = - match (file_name, nested_modules, fn_name) with +let makeModuleName fileName nestedModules fnName = + let fullModuleName = + match (fileName, nestedModules, fnName) with (* TODO: is this even reachable? It seems like the fileName always exists *) - | "", nested_modules, "make" -> nested_modules - | "", nested_modules, fn_name -> List.rev (fn_name :: nested_modules) - | file_name, nested_modules, "make" -> file_name :: List.rev nested_modules - | file_name, nested_modules, fn_name -> - file_name :: List.rev (fn_name :: nested_modules) + | "", nestedModules, "make" -> nestedModules + | "", nestedModules, fnName -> List.rev (fnName :: nestedModules) + | fileName, nestedModules, "make" -> fileName :: List.rev nestedModules + | fileName, nestedModules, fnName -> + fileName :: List.rev (fnName :: nestedModules) in - let full_module_name = String.concat "$" full_module_name in - full_module_name + let fullModuleName = String.concat "$" fullModuleName in + fullModuleName (* AST node builders @@ -187,98 +185,98 @@ let make_module_name file_name nested_modules fn_name = *) (* make record from props and spread props if exists *) -let record_from_props ~loc ~remove_key call_arguments = - let spread_props_label = "_spreadProps" in - let rec remove_last_position_unit_aux props acc = +let recordFromProps ~loc ~removeKey callArguments = + let spreadPropsLabel = "_spreadProps" in + let rec removeLastPositionUnitAux props acc = match props with | [] -> acc | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] -> acc | (Nolabel, {pexp_loc}) :: _rest -> - Jsx_common.raise_error ~loc:pexp_loc + Jsx_common.raiseError ~loc:pexp_loc "JSX: found non-labelled argument before the last position" | ((Labelled txt, {pexp_loc}) as prop) :: rest | ((Optional txt, {pexp_loc}) as prop) :: rest -> - if txt = spread_props_label then + if txt = spreadPropsLabel then match acc with - | [] -> remove_last_position_unit_aux rest (prop :: acc) + | [] -> removeLastPositionUnitAux rest (prop :: acc) | _ -> - Jsx_common.raise_error ~loc:pexp_loc + Jsx_common.raiseError ~loc:pexp_loc "JSX: use {...p} {x: v} not {x: v} {...p} \n\ \ multiple spreads {...p} {...p} not allowed." - else remove_last_position_unit_aux rest (prop :: acc) + else removeLastPositionUnitAux rest (prop :: acc) in - let props, props_to_spread = - remove_last_position_unit_aux call_arguments [] + let props, propsToSpread = + removeLastPositionUnitAux callArguments [] |> List.rev |> List.partition (fun (label, _) -> label <> labelled "_spreadProps") in let props = - if remove_key then - props |> List.filter (fun (arg_label, _) -> "key" <> get_label arg_label) + if removeKey then + props |> List.filter (fun (arg_label, _) -> "key" <> getLabel arg_label) else props in - let process_prop (arg_label, ({pexp_loc} as pexpr)) = + let processProp (arg_label, ({pexp_loc} as pexpr)) = (* In case filed label is "key" only then change expression to option *) - let id = get_label arg_label in - if is_optional arg_label then + let id = getLabel arg_label in + if isOptional arg_label then ( {txt = Lident id; loc = pexp_loc}, - {pexpr with pexp_attributes = optional_attrs} ) + {pexpr with pexp_attributes = optionalAttrs} ) else ({txt = Lident id; loc = pexp_loc}, pexpr) in - let fields = props |> List.map process_prop in - let spread_fields = - props_to_spread |> List.map (fun (_, expression) -> expression) + let fields = props |> List.map processProp in + let spreadFields = + propsToSpread |> List.map (fun (_, expression) -> expression) in - match (fields, spread_fields) with - | [], [spread_props] | [], spread_props :: _ -> spread_props + match (fields, spreadFields) with + | [], [spreadProps] | [], spreadProps :: _ -> spreadProps | _, [] -> { pexp_desc = Pexp_record (fields, None); pexp_loc = loc; pexp_attributes = []; } - | _, [spread_props] + | _, [spreadProps] (* take the first spreadProps only *) - | _, spread_props :: _ -> + | _, spreadProps :: _ -> { - pexp_desc = Pexp_record (fields, Some spread_props); + pexp_desc = Pexp_record (fields, Some spreadProps); pexp_loc = loc; pexp_attributes = []; } (* make type params for make fn arguments *) (* let make = ({id, name, children}: props<'id, 'name, 'children>) *) -let make_props_type_params_tvar named_type_list = - named_type_list +let makePropsTypeParamsTvar namedTypeList = + namedTypeList |> List.filter_map (fun (_isOptional, label, _, loc, _interiorType) -> if label = "key" then None - else Some (Typ.var ~loc @@ safe_type_from_value (Labelled label))) + else Some (Typ.var ~loc @@ safeTypeFromValue (Labelled label))) -let strip_option core_type = - match core_type with - | {ptyp_desc = Ptyp_constr ({txt = Lident "option"}, core_types)} -> - List.nth_opt core_types 0 [@doesNotRaise] - | _ -> Some core_type +let stripOption coreType = + match coreType with + | {ptyp_desc = Ptyp_constr ({txt = Lident "option"}, coreTypes)} -> + List.nth_opt coreTypes 0 [@doesNotRaise] + | _ -> Some coreType -let strip_js_nullable core_type = - match core_type with +let stripJsNullable coreType = + match coreType with | { ptyp_desc = - Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Nullable"), "t")}, core_types); + Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Nullable"), "t")}, coreTypes); } -> - List.nth_opt core_types 0 [@doesNotRaise] - | _ -> Some core_type + List.nth_opt coreTypes 0 [@doesNotRaise] + | _ -> Some coreType (* Make type params of the props type *) (* (Sig) let make: React.componentLike, React.element> *) (* (Str) let make = ({x, _}: props<'x>) => body *) (* (Str) external make: React.componentLike, React.element> = "default" *) -let make_props_type_params ?(strip_explicit_option = false) - ?(strip_explicit_js_nullable_of_ref = false) named_type_list = - named_type_list - |> List.filter_map (fun (is_optional, label, _, loc, interior_type) -> +let makePropsTypeParams ?(stripExplicitOption = false) + ?(stripExplicitJsNullableOfRef = false) namedTypeList = + namedTypeList + |> List.filter_map (fun (isOptional, label, _, loc, interiorType) -> if label = "key" then None (* TODO: Worth thinking how about "ref_" or "_ref" usages *) else if label = "ref" then @@ -286,21 +284,19 @@ let make_props_type_params ?(strip_explicit_option = false) If ref has a type annotation then use it, else 'ref. For example, if JSX ppx is used for React Native, type would be different. *) - match interior_type with - | {ptyp_desc = Ptyp_any} -> Some (ref_type_var loc) + match interiorType with + | {ptyp_desc = Ptyp_any} -> Some (refTypeVar loc) | _ -> (* Strip explicit Js.Nullable.t in case of forwardRef *) - if strip_explicit_js_nullable_of_ref then - strip_js_nullable interior_type - else Some interior_type + if stripExplicitJsNullableOfRef then stripJsNullable interiorType + else Some interiorType (* Strip the explicit option type in implementation *) (* let make = (~x: option=?) => ... *) - else if is_optional && strip_explicit_option then - strip_option interior_type - else Some interior_type) + else if isOptional && stripExplicitOption then stripOption interiorType + else Some interiorType) -let make_label_decls named_type_list = - let rec check_duplicated_label l = +let makeLabelDecls namedTypeList = + let rec checkDuplicatedLabel l = let rec mem_label ((_, (la : string), _, _, _) as x) = function | [] -> false | (_, (lb : string), _, _, _) :: l -> lb = la || mem_label x l @@ -310,92 +306,93 @@ let make_label_decls named_type_list = | hd :: tl -> if mem_label hd tl then let _, label, _, loc, _ = hd in - Jsx_common.raise_error ~loc "JSX: found the duplicated prop `%s`" label - else check_duplicated_label tl + Jsx_common.raiseError ~loc "JSX: found the duplicated prop `%s`" label + else checkDuplicatedLabel tl in - let () = named_type_list |> List.rev |> check_duplicated_label in + let () = namedTypeList |> List.rev |> checkDuplicatedLabel in - named_type_list - |> List.map (fun (is_optional, label, attrs, loc, interior_type) -> + namedTypeList + |> List.map (fun (isOptional, label, attrs, loc, interiorType) -> if label = "key" then - Type.field ~loc ~attrs:(optional_attrs @ attrs) {txt = label; loc} - interior_type - else if is_optional then - Type.field ~loc ~attrs:(optional_attrs @ attrs) {txt = label; loc} - (Typ.var @@ safe_type_from_value @@ Labelled label) + Type.field ~loc ~attrs:(optionalAttrs @ attrs) {txt = label; loc} + interiorType + else if isOptional then + Type.field ~loc ~attrs:(optionalAttrs @ attrs) {txt = label; loc} + (Typ.var @@ safeTypeFromValue @@ Labelled label) else Type.field ~loc ~attrs {txt = label; loc} - (Typ.var @@ safe_type_from_value @@ Labelled label)) + (Typ.var @@ safeTypeFromValue @@ Labelled label)) -let make_type_decls props_name loc named_type_list = - let label_decl_list = make_label_decls named_type_list in +let makeTypeDecls ~attrs propsName loc namedTypeList = + let labelDeclList = makeLabelDecls namedTypeList in (* 'id, 'className, ... *) let params = - make_props_type_params_tvar named_type_list - |> List.map (fun core_type -> (core_type, Invariant)) + makePropsTypeParamsTvar namedTypeList + |> List.map (fun coreType -> (coreType, Invariant)) in [ - Type.mk ~loc ~params {txt = props_name; loc} - ~kind:(Ptype_record label_decl_list); + Type.mk ~attrs ~loc ~params {txt = propsName; loc} + ~kind:(Ptype_record labelDeclList); ] -let make_type_decls_with_core_type props_name loc core_type typ_vars = +let makeTypeDeclsWithCoreType propsName loc coreType typVars = [ - Type.mk ~loc {txt = props_name; loc} ~kind:Ptype_abstract - ~params:(typ_vars |> List.map (fun v -> (v, Invariant))) - ~manifest:core_type; + Type.mk ~loc {txt = propsName; loc} ~kind:Ptype_abstract + ~params:(typVars |> List.map (fun v -> (v, Invariant))) + ~manifest:coreType; ] +let live_attr = ({txt = "live"; loc = Location.none}, PStr []) + (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *) -let make_props_record_type ~core_type_of_attr ~typ_vars_of_core_type props_name - loc named_type_list = +let makePropsRecordType ~coreTypeOfAttr ~external_ ~typVarsOfCoreType propsName + loc namedTypeList = + let attrs = if external_ then [live_attr] else [] in Str.type_ Nonrecursive - (match core_type_of_attr with - | None -> make_type_decls props_name loc named_type_list - | Some core_type -> - make_type_decls_with_core_type props_name loc core_type - typ_vars_of_core_type) + (match coreTypeOfAttr with + | None -> makeTypeDecls ~attrs propsName loc namedTypeList + | Some coreType -> + makeTypeDeclsWithCoreType propsName loc coreType typVarsOfCoreType) (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *) -let make_props_record_type_sig ~core_type_of_attr ~typ_vars_of_core_type - props_name loc named_type_list = +let makePropsRecordTypeSig ~coreTypeOfAttr ~external_ ~typVarsOfCoreType + propsName loc namedTypeList = + let attrs = if external_ then [live_attr] else [] in Sig.type_ Nonrecursive - (match core_type_of_attr with - | None -> make_type_decls props_name loc named_type_list - | Some core_type -> - make_type_decls_with_core_type props_name loc core_type - typ_vars_of_core_type) + (match coreTypeOfAttr with + | None -> makeTypeDecls ~attrs propsName loc namedTypeList + | Some coreType -> + makeTypeDeclsWithCoreType propsName loc coreType typVarsOfCoreType) -let transform_uppercase_call3 ~config module_path mapper jsx_expr_loc - call_expr_loc attrs call_arguments = - let children, args_with_labels = - extract_children ~remove_last_position_unit:true ~loc:jsx_expr_loc - call_arguments +let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc + attrs callArguments = + let children, argsWithLabels = + extractChildren ~removeLastPositionUnit:true ~loc:jsxExprLoc callArguments in - let args_for_make = args_with_labels in - let children_expr = transform_children_if_list_upper ~mapper children in - let recursively_transformed_args_for_make = - args_for_make + let argsForMake = argsWithLabels in + let childrenExpr = transformChildrenIfListUpper ~mapper children in + let recursivelyTransformedArgsForMake = + argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in - let children_arg = ref None in + let childrenArg = ref None in let args = - recursively_transformed_args_for_make + recursivelyTransformedArgsForMake @ - match children_expr with + match childrenExpr with | Exact children -> [(labelled "children", children)] | ListLiteral {pexp_desc = Pexp_array list} when list = [] -> [] | ListLiteral expression -> ( (* this is a hack to support react components that introspect into their children *) - children_arg := Some expression; + childrenArg := Some expression; match config.Jsx_common.mode with | "automatic" -> [ ( labelled "children", Exp.apply (Exp.ident - {txt = module_access_name config "array"; loc = Location.none}) + {txt = moduleAccessName config "array"; loc = Location.none}) [(Nolabel, expression)] ); ] | _ -> @@ -406,123 +403,121 @@ let transform_uppercase_call3 ~config module_path mapper jsx_expr_loc ]) in - let is_cap str = String.capitalize_ascii str = str in + let isCap str = String.capitalize_ascii str = str in let ident ~suffix = - match module_path with - | Lident _ -> Ldot (module_path, suffix) - | Ldot (_modulePath, value) as full_path when is_cap value -> - Ldot (full_path, suffix) - | module_path -> module_path + match modulePath with + | Lident _ -> Ldot (modulePath, suffix) + | Ldot (_modulePath, value) as fullPath when isCap value -> + Ldot (fullPath, suffix) + | modulePath -> modulePath in - let is_empty_record {pexp_desc} = + let isEmptyRecord {pexp_desc} = match pexp_desc with - | Pexp_record (label_decls, _) when List.length label_decls = 0 -> true + | Pexp_record (labelDecls, _) when List.length labelDecls = 0 -> true | _ -> false in (* handle key, ref, children *) (* React.createElement(Component.make, props, ...children) *) - let record = record_from_props ~loc:jsx_expr_loc ~remove_key:true args in + let record = recordFromProps ~loc:jsxExprLoc ~removeKey:true args in let props = - if is_empty_record record then empty_record ~loc:jsx_expr_loc else record + if isEmptyRecord record then emptyRecord ~loc:jsxExprLoc else record in - let key_prop = - args |> List.filter (fun (arg_label, _) -> "key" = get_label arg_label) + let keyProp = + args |> List.filter (fun (arg_label, _) -> "key" = getLabel arg_label) in - let make_i_d = - Exp.ident ~loc:call_expr_loc - {txt = ident ~suffix:"make"; loc = call_expr_loc} + let makeID = + Exp.ident ~loc:callExprLoc {txt = ident ~suffix:"make"; loc = callExprLoc} in match config.mode with (* The new jsx transform *) | "automatic" -> - let jsx_expr, key_and_unit = - match (!children_arg, key_prop) with + let jsxExpr, keyAndUnit = + match (!childrenArg, keyProp) with | None, key :: _ -> ( Exp.ident - {loc = Location.none; txt = module_access_name config "jsxKeyed"}, - [key; (nolabel, unit_expr ~loc:Location.none)] ) + {loc = Location.none; txt = moduleAccessName config "jsxKeyed"}, + [key; (nolabel, unitExpr ~loc:Location.none)] ) | None, [] -> - ( Exp.ident {loc = Location.none; txt = module_access_name config "jsx"}, + ( Exp.ident {loc = Location.none; txt = moduleAccessName config "jsx"}, [] ) | Some _, key :: _ -> ( Exp.ident - {loc = Location.none; txt = module_access_name config "jsxsKeyed"}, - [key; (nolabel, unit_expr ~loc:Location.none)] ) + {loc = Location.none; txt = moduleAccessName config "jsxsKeyed"}, + [key; (nolabel, unitExpr ~loc:Location.none)] ) | Some _, [] -> - ( Exp.ident {loc = Location.none; txt = module_access_name config "jsxs"}, + ( Exp.ident {loc = Location.none; txt = moduleAccessName config "jsxs"}, [] ) in - Exp.apply ~loc:jsx_expr_loc ~attrs jsx_expr - ([(nolabel, make_i_d); (nolabel, props)] @ key_and_unit) + Exp.apply ~loc:jsxExprLoc ~attrs jsxExpr + ([(nolabel, makeID); (nolabel, props)] @ keyAndUnit) | _ -> ( - match (!children_arg, key_prop) with + match (!childrenArg, keyProp) with | None, key :: _ -> - Exp.apply ~loc:jsx_expr_loc ~attrs + Exp.apply ~loc:jsxExprLoc ~attrs (Exp.ident { loc = Location.none; txt = Ldot (Lident "JsxPPXReactSupport", "createElementWithKey"); }) - [key; (nolabel, make_i_d); (nolabel, props)] + [key; (nolabel, makeID); (nolabel, props)] | None, [] -> - Exp.apply ~loc:jsx_expr_loc ~attrs + Exp.apply ~loc:jsxExprLoc ~attrs (Exp.ident {loc = Location.none; txt = Ldot (Lident "React", "createElement")}) - [(nolabel, make_i_d); (nolabel, props)] + [(nolabel, makeID); (nolabel, props)] | Some children, key :: _ -> - Exp.apply ~loc:jsx_expr_loc ~attrs + Exp.apply ~loc:jsxExprLoc ~attrs (Exp.ident { loc = Location.none; txt = Ldot (Lident "JsxPPXReactSupport", "createElementVariadicWithKey"); }) - [key; (nolabel, make_i_d); (nolabel, props); (nolabel, children)] + [key; (nolabel, makeID); (nolabel, props); (nolabel, children)] | Some children, [] -> - Exp.apply ~loc:jsx_expr_loc ~attrs + Exp.apply ~loc:jsxExprLoc ~attrs (Exp.ident { loc = Location.none; txt = Ldot (Lident "React", "createElementVariadic"); }) - [(nolabel, make_i_d); (nolabel, props); (nolabel, children)]) + [(nolabel, makeID); (nolabel, props); (nolabel, children)]) -let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs - call_arguments id = - let component_name_expr = constant_string ~loc:call_expr_loc id in +let transformLowercaseCall3 ~config mapper jsxExprLoc callExprLoc attrs + callArguments id = + let componentNameExpr = constantString ~loc:callExprLoc id in match config.Jsx_common.mode with (* the new jsx transform *) | "automatic" -> - let element_binding = + let elementBinding = match config.module_ |> String.lowercase_ascii with | "react" -> Lident "ReactDOM" - | _generic -> module_access_name config "Elements" + | _generic -> moduleAccessName config "Elements" in - let children, non_children_props = - extract_children ~remove_last_position_unit:true ~loc:jsx_expr_loc - call_arguments + let children, nonChildrenProps = + extractChildren ~removeLastPositionUnit:true ~loc:jsxExprLoc callArguments in - let args_for_make = non_children_props in - let children_expr = transform_children_if_list_upper ~mapper children in - let recursively_transformed_args_for_make = - args_for_make + let argsForMake = nonChildrenProps in + let childrenExpr = transformChildrenIfListUpper ~mapper children in + let recursivelyTransformedArgsForMake = + argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in - let children_arg = ref None in + let childrenArg = ref None in let args = - recursively_transformed_args_for_make + recursivelyTransformedArgsForMake @ - match children_expr with + match childrenExpr with | Exact children -> [ ( labelled "children", - Exp.apply ~attrs:optional_attrs + Exp.apply ~attrs:optionalAttrs (Exp.ident { - txt = Ldot (element_binding, "someElement"); + txt = Ldot (elementBinding, "someElement"); loc = Location.none; }) [(Nolabel, children)] ); @@ -530,52 +525,51 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs | ListLiteral {pexp_desc = Pexp_array list} when list = [] -> [] | ListLiteral expression -> (* this is a hack to support react components that introspect into their children *) - children_arg := Some expression; + childrenArg := Some expression; [ ( labelled "children", Exp.apply (Exp.ident - {txt = module_access_name config "array"; loc = Location.none}) + {txt = moduleAccessName config "array"; loc = Location.none}) [(Nolabel, expression)] ); ] in - let is_empty_record {pexp_desc} = + let isEmptyRecord {pexp_desc} = match pexp_desc with - | Pexp_record (label_decls, _) when List.length label_decls = 0 -> true + | Pexp_record (labelDecls, _) when List.length labelDecls = 0 -> true | _ -> false in - let record = record_from_props ~loc:jsx_expr_loc ~remove_key:true args in + let record = recordFromProps ~loc:jsxExprLoc ~removeKey:true args in let props = - if is_empty_record record then empty_record ~loc:jsx_expr_loc else record + if isEmptyRecord record then emptyRecord ~loc:jsxExprLoc else record in - let key_prop = - args |> List.filter (fun (arg_label, _) -> "key" = get_label arg_label) + let keyProp = + args |> List.filter (fun (arg_label, _) -> "key" = getLabel arg_label) in - let jsx_expr, key_and_unit = - match (!children_arg, key_prop) with + let jsxExpr, keyAndUnit = + match (!childrenArg, keyProp) with | None, key :: _ -> ( Exp.ident - {loc = Location.none; txt = Ldot (element_binding, "jsxKeyed")}, - [key; (nolabel, unit_expr ~loc:Location.none)] ) + {loc = Location.none; txt = Ldot (elementBinding, "jsxKeyed")}, + [key; (nolabel, unitExpr ~loc:Location.none)] ) | None, [] -> - ( Exp.ident {loc = Location.none; txt = Ldot (element_binding, "jsx")}, - [] ) + (Exp.ident {loc = Location.none; txt = Ldot (elementBinding, "jsx")}, []) | Some _, key :: _ -> ( Exp.ident - {loc = Location.none; txt = Ldot (element_binding, "jsxsKeyed")}, - [key; (nolabel, unit_expr ~loc:Location.none)] ) + {loc = Location.none; txt = Ldot (elementBinding, "jsxsKeyed")}, + [key; (nolabel, unitExpr ~loc:Location.none)] ) | Some _, [] -> - ( Exp.ident {loc = Location.none; txt = Ldot (element_binding, "jsxs")}, + ( Exp.ident {loc = Location.none; txt = Ldot (elementBinding, "jsxs")}, [] ) in - Exp.apply ~loc:jsx_expr_loc ~attrs jsx_expr - ([(nolabel, component_name_expr); (nolabel, props)] @ key_and_unit) + Exp.apply ~loc:jsxExprLoc ~attrs jsxExpr + ([(nolabel, componentNameExpr); (nolabel, props)] @ keyAndUnit) | _ -> - let children, non_children_props = - extract_children ~loc:jsx_expr_loc call_arguments + let children, nonChildrenProps = + extractChildren ~loc:jsxExprLoc callArguments in - let children_expr = transform_children_if_list ~mapper children in - let create_element_call = + let childrenExpr = transformChildrenIfList ~mapper children in + let createElementCall = match children with (* [@JSX] div(~children=[a]), coming from
a
*) | { @@ -586,61 +580,61 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs "createDOMElementVariadic" (* [@JSX] div(~children= value), coming from
...(value)
*) | {pexp_loc} -> - Jsx_common.raise_error ~loc:pexp_loc + Jsx_common.raiseError ~loc:pexp_loc "A spread as a DOM element's children don't make sense written \ together. You can simply remove the spread." in let args = - match non_children_props with + match nonChildrenProps with | [_justTheUnitArgumentAtEnd] -> [ (* "div" *) - (nolabel, component_name_expr); + (nolabel, componentNameExpr); (* [|moreCreateElementCallsHere|] *) - (nolabel, children_expr); + (nolabel, childrenExpr); ] - | non_empty_props -> - let props_record = - record_from_props ~loc:Location.none ~remove_key:false non_empty_props + | nonEmptyProps -> + let propsRecord = + recordFromProps ~loc:Location.none ~removeKey:false nonEmptyProps in [ (* "div" *) - (nolabel, component_name_expr); + (nolabel, componentNameExpr); (* ReactDOM.domProps(~className=blabla, ~foo=bar, ()) *) - (labelled "props", props_record); + (labelled "props", propsRecord); (* [|moreCreateElementCallsHere|] *) - (nolabel, children_expr); + (nolabel, childrenExpr); ] in - Exp.apply ~loc:jsx_expr_loc ~attrs + Exp.apply ~loc:jsxExprLoc ~attrs (* ReactDOM.createElement *) (Exp.ident { loc = Location.none; - txt = Ldot (Lident "ReactDOM", create_element_call); + txt = Ldot (Lident "ReactDOM", createElementCall); }) args -let rec recursively_transform_named_args_for_make expr args newtypes core_type = +let rec recursivelyTransformNamedArgsForMake expr args newtypes coreType = match expr.pexp_desc with (* TODO: make this show up with a loc. *) | Pexp_fun (Labelled "key", _, _, _) | Pexp_fun (Optional "key", _, _, _) -> - Jsx_common.raise_error ~loc:expr.pexp_loc + Jsx_common.raiseError ~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 (Labelled "ref", _, _, _) | Pexp_fun (Optional "ref", _, _, _) -> - Jsx_common.raise_error ~loc:expr.pexp_loc + Jsx_common.raiseError ~loc:expr.pexp_loc "Ref cannot be passed as a normal prop. Please use `forwardRef` API \ instead." | Pexp_fun (arg, default, pattern, expression) - when is_optional arg || is_labelled arg -> + when isOptional arg || isLabelled arg -> let () = - match (is_optional arg, pattern, default) with + match (isOptional arg, pattern, default) with | true, {ppat_desc = Ppat_constraint (_, {ptyp_desc})}, None -> ( match ptyp_desc with | Ptyp_constr ({txt = Lident "option"}, [_]) -> () | _ -> - let current_type = + let currentType = match ptyp_desc with | Ptyp_constr ({txt}, []) -> String.concat "." (Longident.flatten txt) @@ -653,7 +647,7 @@ let rec recursively_transform_named_args_for_make expr args newtypes core_type = (Printf.sprintf "React: optional argument annotations must have explicit \ `option`. Did you mean `option<%s>=?`?" - current_type))) + currentType))) | _ -> () in let alias = @@ -666,7 +660,7 @@ let rec recursively_transform_named_args_for_make expr args newtypes core_type = } -> txt | {ppat_desc = Ppat_any} -> "_" - | _ -> get_label arg + | _ -> getLabel arg in let type_ = match pattern with @@ -675,15 +669,15 @@ let rec recursively_transform_named_args_for_make expr args newtypes core_type = | _ -> None in - recursively_transform_named_args_for_make expression + recursivelyTransformNamedArgsForMake expression ((arg, default, pattern, alias, pattern.ppat_loc, type_) :: args) - newtypes core_type + newtypes coreType | Pexp_fun ( Nolabel, _, {ppat_desc = Ppat_construct ({txt = Lident "()"}, _) | Ppat_any}, _expression ) -> - (args, newtypes, core_type) + (args, newtypes, coreType) | Pexp_fun ( Nolabel, _, @@ -701,103 +695,102 @@ let rec recursively_transform_named_args_for_make expr args newtypes core_type = (* The ref arguement of forwardRef should be optional *) ( (Optional "ref", None, pattern, txt, pattern.ppat_loc, type_) :: args, newtypes, - core_type ) - else (args, newtypes, core_type) + coreType ) + else (args, newtypes, coreType) | Pexp_fun (Nolabel, _, pattern, _expression) -> Location.raise_errorf ~loc:pattern.ppat_loc "React: react.component refs only support plain arguments and type \ annotations." | Pexp_newtype (label, expression) -> - recursively_transform_named_args_for_make expression args - (label :: newtypes) core_type - | Pexp_constraint (expression, core_type) -> - recursively_transform_named_args_for_make expression args newtypes - (Some core_type) - | _ -> (args, newtypes, core_type) + recursivelyTransformNamedArgsForMake expression args (label :: newtypes) + coreType + | Pexp_constraint (expression, coreType) -> + recursivelyTransformNamedArgsForMake expression args newtypes + (Some coreType) + | _ -> (args, newtypes, coreType) -let arg_to_type types +let argToType types ((name, default, {ppat_attributes = attrs}, _alias, loc, type_) : arg_label * expression option * pattern * label * 'loc * core_type option) = match (type_, name, default) with - | Some type_, name, _ when is_optional name -> - (true, get_label name, attrs, loc, type_) :: types - | Some type_, name, _ -> (false, get_label name, attrs, loc, type_) :: types - | None, name, _ when is_optional name -> - (true, get_label name, attrs, loc, Typ.any ~loc ()) :: types - | None, name, _ when is_labelled name -> - (false, get_label name, attrs, loc, Typ.any ~loc ()) :: types + | Some type_, name, _ when isOptional name -> + (true, getLabel name, attrs, loc, type_) :: types + | Some type_, name, _ -> (false, getLabel name, attrs, loc, type_) :: types + | None, name, _ when isOptional name -> + (true, getLabel name, attrs, loc, Typ.any ~loc ()) :: types + | None, name, _ when isLabelled name -> + (false, getLabel name, attrs, loc, Typ.any ~loc ()) :: types | _ -> types -let has_default_value name_arg_list = - name_arg_list +let hasDefaultValue nameArgList = + nameArgList |> List.exists (fun (name, default, _, _, _, _) -> - Option.is_some default && is_optional name) + Option.is_some default && isOptional name) -let arg_to_concrete_type types (name, attrs, loc, type_) = +let argToConcreteType types (name, attrs, loc, type_) = match name with - | name when is_labelled name -> - (false, get_label name, attrs, loc, type_) :: types - | name when is_optional name -> - (true, get_label name, attrs, loc, type_) :: types + | name when isLabelled name -> + (false, getLabel name, attrs, loc, type_) :: types + | name when isOptional name -> + (true, getLabel name, attrs, loc, type_) :: types | _ -> types let check_string_int_attribute_iter = let attribute _ ({txt; loc}, _) = if txt = "string" || txt = "int" then - Jsx_common.raise_error ~loc + Jsx_common.raiseError ~loc "@string and @int attributes not supported. See \ https://github.com/rescript-lang/rescript-compiler/issues/5724" in {Ast_iterator.default_iterator with attribute} -let check_multiple_components ~config ~loc = +let checkMultipleComponents ~config ~loc = (* If there is another component, throw error *) - if config.Jsx_common.has_component then - Jsx_common.raise_error_multiple_component ~loc - else config.has_component <- true + if config.Jsx_common.hasComponent then + Jsx_common.raiseErrorMultipleComponent ~loc + else config.hasComponent <- true -let modified_binding_old binding = +let modifiedBindingOld binding = let expression = binding.pvb_expr in (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunk_for_fun_expression expression = + let rec spelunkForFunExpression expression = match expression with (* let make = (~prop) => ... *) | {pexp_desc = Pexp_fun _} | {pexp_desc = Pexp_newtype _} -> expression (* let make = {let foo = bar in (~prop) => ...} *) - | {pexp_desc = Pexp_let (_recursive, _vbs, return_expression)} -> + | {pexp_desc = Pexp_let (_recursive, _vbs, returnExpression)} -> (* here's where we spelunk! *) - spelunk_for_fun_expression return_expression + spelunkForFunExpression returnExpression (* let make = React.forwardRef((~prop) => ...) *) | { pexp_desc = - Pexp_apply (_wrapperExpression, [(Nolabel, inner_function_expression)]); - } -> - spelunk_for_fun_expression inner_function_expression - | { - pexp_desc = Pexp_sequence (_wrapperExpression, inner_function_expression); + Pexp_apply (_wrapperExpression, [(Nolabel, innerFunctionExpression)]); } -> - spelunk_for_fun_expression inner_function_expression - | {pexp_desc = Pexp_constraint (inner_function_expression, _typ)} -> - spelunk_for_fun_expression inner_function_expression + spelunkForFunExpression innerFunctionExpression + | {pexp_desc = Pexp_sequence (_wrapperExpression, innerFunctionExpression)} + -> + spelunkForFunExpression innerFunctionExpression + | {pexp_desc = Pexp_constraint (innerFunctionExpression, _typ)} -> + spelunkForFunExpression innerFunctionExpression | {pexp_loc} -> - Jsx_common.raise_error ~loc:pexp_loc + Jsx_common.raiseError ~loc:pexp_loc "JSX component calls can only be on function definitions or component \ wrappers (forwardRef, memo)." in - spelunk_for_fun_expression expression + spelunkForFunExpression expression -let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding = - let has_application = ref false in - let wrap_expression_with_binding expression_fn expression = - Vb.mk ~loc:binding_loc ~attrs:binding.pvb_attributes - (Pat.var ~loc:binding_pat_loc {loc = binding_pat_loc; txt = fn_name}) - (expression_fn expression) +let modifiedBinding ~bindingLoc ~bindingPatLoc ~fnName binding = + let hasApplication = ref false in + let wrapExpressionWithBinding expressionFn expression = + Vb.mk ~loc:bindingLoc ~attrs:binding.pvb_attributes + (Pat.var ~loc:bindingPatLoc {loc = bindingPatLoc; txt = fnName}) + (expressionFn expression) in let expression = binding.pvb_expr in (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunk_for_fun_expression expression = + let rec spelunkForFunExpression expression = match expression with (* let make = (~prop) => ... with no final unit *) | { @@ -806,13 +799,13 @@ let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding = ( ((Labelled _ | Optional _) as label), default, pattern, - ({pexp_desc = Pexp_fun _} as internal_expression) ); + ({pexp_desc = Pexp_fun _} as internalExpression) ); } -> - let wrap, has_forward_ref, exp = - spelunk_for_fun_expression internal_expression + let wrap, hasForwardRef, exp = + spelunkForFunExpression internalExpression in ( wrap, - has_forward_ref, + hasForwardRef, {expression with pexp_desc = Pexp_fun (label, default, pattern, exp)} ) (* let make = (()) => ... *) (* let make = (_) => ... *) @@ -835,7 +828,7 @@ let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding = (* let make = (prop) => ... *) | {pexp_desc = Pexp_fun (_nolabel, _default, pattern, _internalExpression)} -> - if !has_application then ((fun a -> a), false, expression) + if !hasApplication then ((fun a -> a), false, expression) else Location.raise_errorf ~loc:pattern.ppat_loc "React: props need to be labelled arguments.\n\ @@ -843,41 +836,40 @@ let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding = \ If your component doesn't have any props use () or _ instead of a \ name." (* let make = {let foo = bar in (~prop) => ...} *) - | {pexp_desc = Pexp_let (recursive, vbs, internal_expression)} -> + | {pexp_desc = Pexp_let (recursive, vbs, internalExpression)} -> (* here's where we spelunk! *) - let wrap, has_forward_ref, exp = - spelunk_for_fun_expression internal_expression + let wrap, hasForwardRef, exp = + spelunkForFunExpression internalExpression in ( wrap, - has_forward_ref, + hasForwardRef, {expression with pexp_desc = Pexp_let (recursive, vbs, exp)} ) (* let make = React.forwardRef((~prop) => ...) *) | { - pexp_desc = - Pexp_apply (wrapper_expression, [(Nolabel, internal_expression)]); + pexp_desc = Pexp_apply (wrapperExpression, [(Nolabel, internalExpression)]); } -> - let () = has_application := true in - let _, _, exp = spelunk_for_fun_expression internal_expression in - let has_forward_ref = is_forward_ref wrapper_expression in - ( (fun exp -> Exp.apply wrapper_expression [(nolabel, exp)]), - has_forward_ref, + let () = hasApplication := true in + let _, _, exp = spelunkForFunExpression internalExpression in + let hasForwardRef = isForwardRef wrapperExpression in + ( (fun exp -> Exp.apply wrapperExpression [(nolabel, exp)]), + hasForwardRef, exp ) - | {pexp_desc = Pexp_sequence (wrapper_expression, internal_expression)} -> - let wrap, has_forward_ref, exp = - spelunk_for_fun_expression internal_expression + | {pexp_desc = Pexp_sequence (wrapperExpression, internalExpression)} -> + let wrap, hasForwardRef, exp = + spelunkForFunExpression internalExpression in ( wrap, - has_forward_ref, - {expression with pexp_desc = Pexp_sequence (wrapper_expression, exp)} ) + hasForwardRef, + {expression with pexp_desc = Pexp_sequence (wrapperExpression, exp)} ) | e -> ((fun a -> a), false, e) in - let wrap_expression, has_forward_ref, expression = - spelunk_for_fun_expression expression + let wrapExpression, hasForwardRef, expression = + spelunkForFunExpression expression in - (wrap_expression_with_binding wrap_expression, has_forward_ref, expression) + (wrapExpressionWithBinding wrapExpression, hasForwardRef, expression) -let vb_match ~expr (name, default, _, alias, loc, _) = - let label = get_label name in +let vbMatch ~expr (name, default, _, alias, loc, _) = + let label = getLabel name in match default with | Some default -> let value_binding = @@ -899,128 +891,124 @@ let vb_match ~expr (name, default, _, alias, loc, _) = Exp.let_ Nonrecursive [value_binding] expr | None -> expr -let vb_match_expr named_arg_list expr = - let rec aux named_arg_list = - match named_arg_list with +let vbMatchExpr namedArgList expr = + let rec aux namedArgList = + match namedArgList with | [] -> expr - | named_arg :: rest -> vb_match named_arg ~expr:(aux rest) + | namedArg :: rest -> vbMatch namedArg ~expr:(aux rest) in - aux (List.rev named_arg_list) + aux (List.rev namedArgList) -let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = - if Jsx_common.has_attr_on_binding binding then ( - check_multiple_components ~config ~loc:pstr_loc; - let binding = Jsx_common.remove_arity binding in - let core_type_of_attr = - Jsx_common.core_type_of_attrs binding.pvb_attributes - in - let typ_vars_of_core_type = - core_type_of_attr - |> Option.map Jsx_common.typ_vars_of_core_type +let mapBinding ~config ~emptyLoc ~pstr_loc ~fileName ~recFlag binding = + if Jsx_common.hasAttrOnBinding binding then ( + checkMultipleComponents ~config ~loc:pstr_loc; + let binding = Jsx_common.removeArity binding in + let coreTypeOfAttr = Jsx_common.coreTypeOfAttrs binding.pvb_attributes in + let typVarsOfCoreType = + coreTypeOfAttr + |> Option.map Jsx_common.typVarsOfCoreType |> Option.value ~default:[] in - let binding_loc = binding.pvb_loc in - let binding_pat_loc = binding.pvb_pat.ppat_loc in + let bindingLoc = binding.pvb_loc in + let bindingPatLoc = binding.pvb_pat.ppat_loc in let binding = { binding with - pvb_pat = {binding.pvb_pat with ppat_loc = empty_loc}; - pvb_loc = empty_loc; - pvb_attributes = binding.pvb_attributes |> List.filter other_attrs_pure; + pvb_pat = {binding.pvb_pat with ppat_loc = emptyLoc}; + pvb_loc = emptyLoc; + pvb_attributes = binding.pvb_attributes |> List.filter otherAttrsPure; } in - let fn_name = get_fn_name binding.pvb_pat in - let internal_fn_name = fn_name ^ "$Internal" in - let full_module_name = - make_module_name file_name config.nested_modules fn_name - in - let binding_wrapper, has_forward_ref, expression = - modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding + let fnName = getFnName binding.pvb_pat in + let internalFnName = fnName ^ "$Internal" in + let fullModuleName = makeModuleName fileName config.nestedModules fnName in + let bindingWrapper, hasForwardRef, expression = + modifiedBinding ~bindingLoc ~bindingPatLoc ~fnName binding in - let is_async = + let isAsync = Ext_list.find_first binding.pvb_expr.pexp_attributes Ast_async.is_async |> Option.is_some in (* do stuff here! *) - let named_arg_list, newtypes, _typeConstraints = - recursively_transform_named_args_for_make - (modified_binding_old binding) + let namedArgList, newtypes, _typeConstraints = + recursivelyTransformNamedArgsForMake + (modifiedBindingOld binding) [] [] None in - let named_type_list = List.fold_left arg_to_type [] named_arg_list in + let namedTypeList = List.fold_left argToType [] namedArgList in (* type props = { ... } *) - let props_record_type = - make_props_record_type ~core_type_of_attr ~typ_vars_of_core_type "props" - pstr_loc named_type_list + let propsRecordType = + makePropsRecordType ~coreTypeOfAttr ~external_:false ~typVarsOfCoreType + "props" pstr_loc namedTypeList in - let inner_expression = + let innerExpression = Exp.apply (Exp.ident (Location.mknoloc @@ Lident - (match rec_flag with - | Recursive -> internal_fn_name - | Nonrecursive -> fn_name))) + (match recFlag with + | Recursive -> internalFnName + | Nonrecursive -> fnName))) ([(Nolabel, Exp.ident (Location.mknoloc @@ Lident "props"))] @ - match has_forward_ref with + match hasForwardRef with | true -> [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "ref"))] | false -> []) in - let make_props_pattern = function + let makePropsPattern = function | [] -> Pat.var @@ Location.mknoloc "props" | _ -> Pat.constraint_ (Pat.var @@ Location.mknoloc "props") (Typ.constr (Location.mknoloc @@ Lident "props") [Typ.any ()]) in - let inner_expression = - Jsx_common.async_component ~async:is_async inner_expression + let innerExpression = + Jsx_common.async_component ~async:isAsync innerExpression in - let full_expression = + let fullExpression = (* React component name should start with uppercase letter *) (* let make = { let \"App" = props => make(props); \"App" } *) (* let make = React.forwardRef({ let \"App" = (props, ref) => make({...props, ref: @optional (Js.Nullabel.toOption(ref))}) })*) Exp.fun_ 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 + (match coreTypeOfAttr with + | None -> makePropsPattern namedTypeList + | Some _ -> makePropsPattern typVarsOfCoreType) + (if hasForwardRef then Exp.fun_ nolabel None (Pat.var @@ Location.mknoloc "ref") - inner_expression - else inner_expression) + innerExpression + else innerExpression) in - let full_expression = + let fullExpression = if !Config.uncurried = Uncurried then - full_expression - |> Ast_uncurried.uncurried_fun ~loc:full_expression.pexp_loc - ~arity:(if has_forward_ref then 2 else 1) - else full_expression + fullExpression + |> Ast_uncurried.uncurriedFun ~loc:fullExpression.pexp_loc + ~arity:(if hasForwardRef then 2 else 1) + else fullExpression in - let full_expression = - match full_module_name with - | "" -> full_expression + let fullExpression = + match fullModuleName with + | "" -> fullExpression | txt -> Exp.let_ Nonrecursive [ - Vb.mk ~loc:empty_loc - (Pat.var ~loc:empty_loc {loc = empty_loc; txt}) - full_expression; + Vb.mk ~loc:emptyLoc + (Pat.var ~loc:emptyLoc {loc = emptyLoc; txt}) + fullExpression; ] - (Exp.ident ~loc:pstr_loc {loc = empty_loc; txt = Lident txt}) + (Exp.ident ~loc:pstr_loc {loc = emptyLoc; txt = Lident txt}) in - let rec strip_constraint_unpack ~label pattern = + let rec stripConstraintUnpack ~label pattern = match pattern with | {ppat_desc = Ppat_constraint (_, {ptyp_desc = Ptyp_package _})} -> pattern | {ppat_desc = Ppat_constraint (pattern, _)} -> - strip_constraint_unpack ~label pattern + stripConstraintUnpack ~label pattern | _ -> pattern in - let safe_pattern_label pattern = + let safePatternLabel pattern = match pattern with | {ppat_desc = Ppat_var {txt; loc}} -> {pattern with ppat_desc = Ppat_var {txt = "__" ^ txt; loc}} @@ -1028,70 +1016,68 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = {pattern with ppat_desc = Ppat_alias (p, {txt = "__" ^ txt; loc})} | _ -> pattern in - let rec returned_expression patterns_with_label patterns_with_nolabel + let rec returnedExpression patternsWithLabel patternsWithNolabel ({pexp_desc} as expr) = match pexp_desc with | Pexp_newtype (_, expr) -> - returned_expression patterns_with_label patterns_with_nolabel expr + returnedExpression patternsWithLabel patternsWithNolabel expr | Pexp_constraint (expr, _) -> - returned_expression patterns_with_label patterns_with_nolabel expr + returnedExpression patternsWithLabel patternsWithNolabel expr | Pexp_fun ( _arg_label, _default, {ppat_desc = Ppat_construct ({txt = Lident "()"}, _)}, expr ) -> - (patterns_with_label, patterns_with_nolabel, expr) + (patternsWithLabel, patternsWithNolabel, expr) | Pexp_fun (arg_label, default, ({ppat_loc; ppat_desc} as pattern), expr) -> ( - let pattern_without_constraint = - strip_constraint_unpack ~label:(get_label arg_label) pattern + let patternWithoutConstraint = + stripConstraintUnpack ~label:(getLabel arg_label) pattern in (* If prop has the default value as Ident, it will get a build error when the referenced Ident value and the prop have the same name. So we add a "__" to label to resolve the build error. *) - let pattern_with_safe_label = + let patternWithSafeLabel = match default with - | Some _ -> safe_pattern_label pattern_without_constraint - | _ -> pattern_without_constraint + | Some _ -> safePatternLabel patternWithoutConstraint + | _ -> patternWithoutConstraint in - if is_labelled arg_label || is_optional arg_label then - returned_expression - (( {loc = ppat_loc; txt = Lident (get_label arg_label)}, + if isLabelled arg_label || isOptional arg_label then + returnedExpression + (( {loc = ppat_loc; txt = Lident (getLabel arg_label)}, { - pattern_with_safe_label with + patternWithSafeLabel with ppat_attributes = - (if is_optional arg_label then optional_attrs else []) + (if isOptional arg_label then optionalAttrs else []) @ pattern.ppat_attributes; } ) - :: patterns_with_label) - patterns_with_nolabel expr + :: patternsWithLabel) + patternsWithNolabel expr else (* Special case of nolabel arg "ref" in forwardRef fn *) (* let make = React.forwardRef(ref => body) *) match ppat_desc with | Ppat_var {txt} | Ppat_constraint ({ppat_desc = Ppat_var {txt}}, _) -> - returned_expression patterns_with_label + returnedExpression patternsWithLabel (( {loc = ppat_loc; txt = Lident txt}, { pattern with - ppat_attributes = optional_attrs @ pattern.ppat_attributes; + ppat_attributes = optionalAttrs @ pattern.ppat_attributes; } ) - :: patterns_with_nolabel) + :: patternsWithNolabel) expr - | _ -> - returned_expression patterns_with_label patterns_with_nolabel expr) - | _ -> (patterns_with_label, patterns_with_nolabel, expr) + | _ -> returnedExpression patternsWithLabel patternsWithNolabel expr) + | _ -> (patternsWithLabel, patternsWithNolabel, expr) in - let patterns_with_label, patterns_with_nolabel, expression = - returned_expression [] [] expression + let patternsWithLabel, patternsWithNolabel, expression = + returnedExpression [] [] expression in (* add pattern matching for optional prop value *) let expression = - if has_default_value named_arg_list then - vb_match_expr named_arg_list expression + if hasDefaultValue namedArgList then vbMatchExpr namedArgList expression else expression in (* (ref) => expr *) @@ -1101,67 +1087,64 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = let pattern = match pattern.ppat_desc with | Ppat_var {txt} when txt = "ref" -> - Pat.constraint_ pattern (ref_type Location.none) + Pat.constraint_ pattern (refType Location.none) | _ -> pattern in Exp.fun_ Nolabel None pattern expr) - expression patterns_with_nolabel + expression patternsWithNolabel in (* ({a, b, _}: props<'a, 'b>) *) - let record_pattern = - match patterns_with_label with + let recordPattern = + match patternsWithLabel with | [] -> Pat.any () - | _ -> Pat.record (List.rev patterns_with_label) Open + | _ -> Pat.record (List.rev patternsWithLabel) Open in let expression = Exp.fun_ Nolabel None - (Pat.constraint_ record_pattern - (Typ.constr ~loc:empty_loc - {txt = Lident "props"; loc = empty_loc} - (match core_type_of_attr with + (Pat.constraint_ recordPattern + (Typ.constr ~loc:emptyLoc + {txt = Lident "props"; loc = emptyLoc} + (match coreTypeOfAttr with | None -> - make_props_type_params ~strip_explicit_option:true - ~strip_explicit_js_nullable_of_ref:has_forward_ref - named_type_list + makePropsTypeParams ~stripExplicitOption:true + ~stripExplicitJsNullableOfRef:hasForwardRef namedTypeList | Some _ -> ( - match typ_vars_of_core_type with + match typVarsOfCoreType with | [] -> [] | _ -> [Typ.any ()])))) expression in - let expression = Ast_async.add_async_attribute ~async:is_async expression in + let expression = Ast_async.add_async_attribute ~async:isAsync expression in let expression = (* Add new tupes (type a,b,c) to make's definition *) newtypes |> List.fold_left (fun e newtype -> Exp.newtype newtype e) expression in (* let make = ({id, name, ...}: props<'id, 'name, ...>) => { ... } *) - let binding, new_binding = - match rec_flag with + let binding, newBinding = + match recFlag with | Recursive -> - ( binding_wrapper - (Exp.let_ ~loc:empty_loc Nonrecursive - [make_new_binding binding expression internal_fn_name] - (Exp.let_ ~loc:empty_loc Nonrecursive + ( bindingWrapper + (Exp.let_ ~loc:emptyLoc Nonrecursive + [makeNewBinding binding expression internalFnName] + (Exp.let_ ~loc:emptyLoc Nonrecursive [ - Vb.mk - (Pat.var {loc = empty_loc; txt = fn_name}) - full_expression; + Vb.mk (Pat.var {loc = emptyLoc; txt = fnName}) fullExpression; ] - (Exp.ident {loc = empty_loc; txt = Lident fn_name}))), + (Exp.ident {loc = emptyLoc; txt = Lident fnName}))), None ) | Nonrecursive -> ( { binding with pvb_expr = expression; - pvb_pat = Pat.var {txt = fn_name; loc = Location.none}; + pvb_pat = Pat.var {txt = fnName; loc = Location.none}; }, - Some (binding_wrapper full_expression) ) + Some (bindingWrapper fullExpression) ) in - (Some props_record_type, binding, new_binding)) + (Some propsRecordType, binding, newBinding)) else (None, binding, None) -let transform_structure_item ~config item = +let transformStructureItem ~config item = match item with (* external *) | { @@ -1169,213 +1152,212 @@ let transform_structure_item ~config item = pstr_desc = Pstr_primitive ({pval_attributes; pval_type} as value_description); } as pstr -> ( - match List.filter Jsx_common.has_attr pval_attributes with + match List.filter Jsx_common.hasAttr pval_attributes with | [] -> [item] | [_] -> - check_multiple_components ~config ~loc:pstr_loc; + checkMultipleComponents ~config ~loc:pstr_loc; check_string_int_attribute_iter.structure_item check_string_int_attribute_iter item; - let pval_type = Jsx_common.extract_uncurried pval_type in - let core_type_of_attr = Jsx_common.core_type_of_attrs pval_attributes in - let typ_vars_of_core_type = - core_type_of_attr - |> Option.map Jsx_common.typ_vars_of_core_type + let pval_type = Jsx_common.extractUncurried pval_type in + let coreTypeOfAttr = Jsx_common.coreTypeOfAttrs pval_attributes in + let typVarsOfCoreType = + coreTypeOfAttr + |> Option.map Jsx_common.typVarsOfCoreType |> Option.value ~default:[] in - let rec get_prop_types types - ({ptyp_loc; ptyp_desc; ptyp_attributes} as full_type) = + let rec getPropTypes types + ({ptyp_loc; ptyp_desc; ptyp_attributes} as fullType) = match ptyp_desc with | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) - when is_labelled name || is_optional name -> - get_prop_types - ((name, ptyp_attributes, ptyp_loc, type_) :: types) - rest - | Ptyp_arrow (Nolabel, _type, rest) -> get_prop_types types rest - | Ptyp_arrow (name, type_, return_value) - when is_labelled name || is_optional name -> - ( return_value, - (name, ptyp_attributes, return_value.ptyp_loc, type_) :: types ) - | _ -> (full_type, types) + when isLabelled name || isOptional name -> + getPropTypes ((name, ptyp_attributes, ptyp_loc, type_) :: types) rest + | Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest + | Ptyp_arrow (name, type_, returnValue) + when isLabelled name || isOptional name -> + ( returnValue, + (name, ptyp_attributes, returnValue.ptyp_loc, type_) :: types ) + | _ -> (fullType, types) in - let inner_type, prop_types = get_prop_types [] pval_type in - let named_type_list = List.fold_left arg_to_concrete_type [] prop_types in - let ret_props_type = + let innerType, propTypes = getPropTypes [] pval_type in + let namedTypeList = List.fold_left argToConcreteType [] propTypes in + let retPropsType = Typ.constr ~loc:pstr_loc (Location.mkloc (Lident "props") pstr_loc) - (match core_type_of_attr with - | None -> make_props_type_params named_type_list + (match coreTypeOfAttr with + | None -> makePropsTypeParams namedTypeList | Some _ -> ( - match typ_vars_of_core_type with + match typVarsOfCoreType with | [] -> [] | _ -> [Typ.any ()])) in (* type props<'x, 'y> = { x: 'x, y?: 'y, ... } *) - let props_record_type = - make_props_record_type ~core_type_of_attr ~typ_vars_of_core_type "props" - pstr_loc named_type_list + let propsRecordType = + makePropsRecordType ~coreTypeOfAttr ~external_:true ~typVarsOfCoreType + "props" pstr_loc namedTypeList in (* can't be an arrow because it will defensively uncurry *) - let new_external_type = + let newExternalType = Ptyp_constr - ( {loc = pstr_loc; txt = module_access_name config "componentLike"}, - [ret_props_type; inner_type] ) + ( {loc = pstr_loc; txt = moduleAccessName config "componentLike"}, + [retPropsType; innerType] ) in - let new_structure = + let newStructure = { pstr with pstr_desc = Pstr_primitive { value_description with - pval_type = {pval_type with ptyp_desc = new_external_type}; - pval_attributes = List.filter other_attrs_pure pval_attributes; + pval_type = {pval_type with ptyp_desc = newExternalType}; + pval_attributes = List.filter otherAttrsPure pval_attributes; }; } in - [props_record_type; new_structure] + [propsRecordType; newStructure] | _ -> - Jsx_common.raise_error ~loc:pstr_loc + Jsx_common.raiseError ~loc:pstr_loc "Only one JSX component call can exist on a component at one time") (* let component = ... *) - | {pstr_loc; pstr_desc = Pstr_value (rec_flag, value_bindings)} -> ( - let file_name = filename_from_loc pstr_loc in - let empty_loc = Location.in_file file_name in - let process_binding binding (new_items, bindings, new_bindings) = - let new_item, binding, new_binding = - map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding + | {pstr_loc; pstr_desc = Pstr_value (recFlag, valueBindings)} -> ( + let fileName = filenameFromLoc pstr_loc in + let emptyLoc = Location.in_file fileName in + let processBinding binding (newItems, bindings, newBindings) = + let newItem, binding, newBinding = + mapBinding ~config ~emptyLoc ~pstr_loc ~fileName ~recFlag binding in - let new_items = - match new_item with - | Some item -> item :: new_items - | None -> new_items + let newItems = + match newItem with + | Some item -> item :: newItems + | None -> newItems in - let new_bindings = - match new_binding with - | Some new_binding -> new_binding :: new_bindings - | None -> new_bindings + let newBindings = + match newBinding with + | Some newBinding -> newBinding :: newBindings + | None -> newBindings in - (new_items, binding :: bindings, new_bindings) + (newItems, binding :: bindings, newBindings) in - let new_items, bindings, new_bindings = - List.fold_right process_binding value_bindings ([], [], []) + let newItems, bindings, newBindings = + List.fold_right processBinding valueBindings ([], [], []) in - new_items - @ [{pstr_loc; pstr_desc = Pstr_value (rec_flag, bindings)}] + newItems + @ [{pstr_loc; pstr_desc = Pstr_value (recFlag, bindings)}] @ - match new_bindings with + match newBindings with | [] -> [] - | new_bindings -> - [{pstr_loc = empty_loc; pstr_desc = Pstr_value (rec_flag, new_bindings)}]) + | newBindings -> + [{pstr_loc = emptyLoc; pstr_desc = Pstr_value (recFlag, newBindings)}]) | _ -> [item] -let transform_signature_item ~config item = +let transformSignatureItem ~config item = match item with | { psig_loc; psig_desc = Psig_value ({pval_attributes; pval_type} as psig_desc); } as psig -> ( - match List.filter Jsx_common.has_attr pval_attributes with + match List.filter Jsx_common.hasAttr pval_attributes with | [] -> [item] | [_] -> - check_multiple_components ~config ~loc:psig_loc; - let pval_type = Jsx_common.extract_uncurried pval_type in + checkMultipleComponents ~config ~loc:psig_loc; + let pval_type = Jsx_common.extractUncurried pval_type in check_string_int_attribute_iter.signature_item check_string_int_attribute_iter item; - let core_type_of_attr = Jsx_common.core_type_of_attrs pval_attributes in - let typ_vars_of_core_type = - core_type_of_attr - |> Option.map Jsx_common.typ_vars_of_core_type + let coreTypeOfAttr = Jsx_common.coreTypeOfAttrs pval_attributes in + let typVarsOfCoreType = + coreTypeOfAttr + |> Option.map Jsx_common.typVarsOfCoreType |> Option.value ~default:[] in - let rec get_prop_types types ({ptyp_loc; ptyp_desc} as full_type) = + let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = match ptyp_desc with | Ptyp_arrow ( name, ({ptyp_attributes = attrs} as type_), ({ptyp_desc = Ptyp_arrow _} as rest) ) - when is_optional name || is_labelled name -> - get_prop_types ((name, attrs, ptyp_loc, type_) :: types) rest + when isOptional name || isLabelled name -> + getPropTypes ((name, attrs, ptyp_loc, type_) :: types) rest | Ptyp_arrow (Nolabel, {ptyp_desc = Ptyp_constr ({txt = Lident "unit"}, _)}, rest) -> - get_prop_types types rest - | Ptyp_arrow (Nolabel, _type, rest) -> get_prop_types types rest - | Ptyp_arrow (name, ({ptyp_attributes = attrs} as type_), return_value) - when is_optional name || is_labelled name -> - (return_value, (name, attrs, return_value.ptyp_loc, type_) :: types) - | _ -> (full_type, types) + getPropTypes types rest + | Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest + | Ptyp_arrow (name, ({ptyp_attributes = attrs} as type_), returnValue) + when isOptional name || isLabelled name -> + (returnValue, (name, attrs, returnValue.ptyp_loc, type_) :: types) + | _ -> (fullType, types) in - let inner_type, prop_types = get_prop_types [] pval_type in - let named_type_list = List.fold_left arg_to_concrete_type [] prop_types in - let ret_props_type = + let innerType, propTypes = getPropTypes [] pval_type in + let namedTypeList = List.fold_left argToConcreteType [] propTypes in + let retPropsType = Typ.constr (Location.mkloc (Lident "props") psig_loc) - (match core_type_of_attr with - | None -> make_props_type_params named_type_list + (match coreTypeOfAttr with + | None -> makePropsTypeParams namedTypeList | Some _ -> ( - match typ_vars_of_core_type with + match typVarsOfCoreType with | [] -> [] | _ -> [Typ.any ()])) in - let props_record_type = - make_props_record_type_sig ~core_type_of_attr ~typ_vars_of_core_type - "props" psig_loc named_type_list + let external_ = psig_desc.pval_prim <> [] in + let propsRecordType = + makePropsRecordTypeSig ~coreTypeOfAttr ~external_ ~typVarsOfCoreType + "props" psig_loc namedTypeList in (* can't be an arrow because it will defensively uncurry *) - let new_external_type = + let newExternalType = Ptyp_constr - ( {loc = psig_loc; txt = module_access_name config "componentLike"}, - [ret_props_type; inner_type] ) + ( {loc = psig_loc; txt = moduleAccessName config "componentLike"}, + [retPropsType; innerType] ) in - let new_structure = + let newStructure = { psig with psig_desc = Psig_value { psig_desc with - pval_type = {pval_type with ptyp_desc = new_external_type}; - pval_attributes = List.filter other_attrs_pure pval_attributes; + pval_type = {pval_type with ptyp_desc = newExternalType}; + pval_attributes = List.filter otherAttrsPure pval_attributes; }; } in - [props_record_type; new_structure] + [propsRecordType; newStructure] | _ -> - Jsx_common.raise_error ~loc:psig_loc + Jsx_common.raiseError ~loc:psig_loc "Only one JSX component call can exist on a component at one time") | _ -> [item] -let transform_jsx_call ~config mapper call_expression call_arguments - jsx_expr_loc attrs = - match call_expression.pexp_desc with +let transformJsxCall ~config mapper callExpression callArguments jsxExprLoc + attrs = + match callExpression.pexp_desc with | Pexp_ident caller -> ( match caller with | {txt = Lident "createElement"; loc} -> - Jsx_common.raise_error ~loc + Jsx_common.raiseError ~loc "JSX: `createElement` should be preceeded by a module name." (* Foo.createElement(~prop1=foo, ~prop2=bar, ~children=[], ()) *) - | {loc; txt = Ldot (module_path, ("createElement" | "make"))} -> - transform_uppercase_call3 ~config module_path mapper jsx_expr_loc loc - attrs call_arguments + | {loc; txt = Ldot (modulePath, ("createElement" | "make"))} -> + transformUppercaseCall3 ~config modulePath mapper jsxExprLoc loc attrs + callArguments (* div(~prop1=foo, ~prop2=bar, ~children=[bla], ()) *) (* turn that into ReactDOM.createElement(~props=ReactDOM.props(~props1=foo, ~props2=bar, ()), [|bla|]) *) | {loc; txt = Lident id} -> - transform_lowercase_call3 ~config mapper jsx_expr_loc loc attrs - call_arguments id - | {txt = Ldot (_, anything_not_create_element_or_make); loc} -> - Jsx_common.raise_error ~loc + transformLowercaseCall3 ~config mapper jsxExprLoc loc attrs callArguments + id + | {txt = Ldot (_, anythingNotCreateElementOrMake); loc} -> + Jsx_common.raiseError ~loc "JSX: the JSX attribute should be attached to a \ `YourModuleName.createElement` or `YourModuleName.make` call. We saw \ `%s` instead" - anything_not_create_element_or_make + anythingNotCreateElementOrMake | {txt = Lapply _; loc} -> (* don't think there's ever a case where this is reached *) - Jsx_common.raise_error ~loc + Jsx_common.raiseError ~loc "JSX: encountered a weird case while processing the code. Please \ report this!") | _ -> - Jsx_common.raise_error ~loc:call_expression.pexp_loc + Jsx_common.raiseError ~loc:callExpression.pexp_loc "JSX: `createElement` should be preceeded by a simple, direct module \ name." @@ -1383,21 +1365,21 @@ let expr ~config mapper expression = match expression with (* Does the function application have the @JSX attribute? *) | { - pexp_desc = Pexp_apply (call_expression, call_arguments); + pexp_desc = Pexp_apply (callExpression, callArguments); pexp_attributes; pexp_loc; } -> ( - let jsx_attribute, non_jsx_attributes = + let jsxAttribute, nonJSXAttributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - match (jsx_attribute, non_jsx_attributes) with + match (jsxAttribute, nonJSXAttributes) with (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression - | _, non_jsx_attributes -> - transform_jsx_call ~config mapper call_expression call_arguments pexp_loc - non_jsx_attributes) + | _, nonJSXAttributes -> + transformJsxCall ~config mapper callExpression callArguments pexp_loc + nonJSXAttributes) (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) | { pexp_desc = @@ -1405,73 +1387,73 @@ let expr ~config mapper expression = ({txt = Lident "::"; loc}, Some {pexp_desc = Pexp_tuple _}) | Pexp_construct ({txt = Lident "[]"; loc}, None) ); pexp_attributes; - } as list_items -> ( - let jsx_attribute, non_jsx_attributes = + } as listItems -> ( + let jsxAttribute, nonJSXAttributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - match (jsx_attribute, non_jsx_attributes) with + match (jsxAttribute, nonJSXAttributes) with (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression - | _, non_jsx_attributes -> + | _, nonJSXAttributes -> let loc = {loc with loc_ghost = true} in let fragment = match config.mode with | "automatic" -> - Exp.ident ~loc {loc; txt = module_access_name config "jsxFragment"} + Exp.ident ~loc {loc; txt = moduleAccessName config "jsxFragment"} | "classic" | _ -> Exp.ident ~loc {loc; txt = Ldot (Lident "React", "fragment")} in - let children_expr = transform_children_if_list ~mapper list_items in - let record_of_children children = + let childrenExpr = transformChildrenIfList ~mapper listItems in + let recordOfChildren children = Exp.record [(Location.mknoloc (Lident "children"), children)] None in - let apply_jsx_array expr = + let applyJsxArray expr = Exp.apply (Exp.ident - {txt = module_access_name config "array"; loc = Location.none}) + {txt = moduleAccessName config "array"; loc = Location.none}) [(Nolabel, expr)] in - let count_of_children = function + let countOfChildren = function | {pexp_desc = Pexp_array children} -> List.length children | _ -> 0 in - let transform_children_to_props children_expr = - match children_expr with + let transformChildrenToProps childrenExpr = + match childrenExpr with | {pexp_desc = Pexp_array children} -> ( match children with - | [] -> empty_record ~loc:Location.none - | [child] -> record_of_children child + | [] -> emptyRecord ~loc:Location.none + | [child] -> recordOfChildren child | _ -> ( match config.mode with - | "automatic" -> record_of_children @@ apply_jsx_array children_expr - | "classic" | _ -> empty_record ~loc:Location.none)) + | "automatic" -> recordOfChildren @@ applyJsxArray childrenExpr + | "classic" | _ -> emptyRecord ~loc:Location.none)) | _ -> ( match config.mode with - | "automatic" -> record_of_children @@ apply_jsx_array children_expr - | "classic" | _ -> empty_record ~loc:Location.none) + | "automatic" -> recordOfChildren @@ applyJsxArray childrenExpr + | "classic" | _ -> emptyRecord ~loc:Location.none) in let args = (nolabel, fragment) - :: (nolabel, transform_children_to_props children_expr) + :: (nolabel, transformChildrenToProps childrenExpr) :: (match config.mode with - | "classic" when count_of_children children_expr > 1 -> - [(nolabel, children_expr)] + | "classic" when countOfChildren childrenExpr > 1 -> + [(nolabel, childrenExpr)] | _ -> []) in Exp.apply ~loc (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs:non_jsx_attributes + ~attrs:nonJSXAttributes (* ReactDOM.createElement *) (match config.mode with | "automatic" -> - if count_of_children children_expr > 1 then - Exp.ident ~loc {loc; txt = module_access_name config "jsxs"} - else Exp.ident ~loc {loc; txt = module_access_name config "jsx"} + if countOfChildren childrenExpr > 1 then + Exp.ident ~loc {loc; txt = moduleAccessName config "jsxs"} + else Exp.ident ~loc {loc; txt = moduleAccessName config "jsx"} | "classic" | _ -> - if count_of_children children_expr > 1 then + if countOfChildren childrenExpr > 1 then Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElementVariadic")} else @@ -1480,20 +1462,20 @@ let expr ~config mapper expression = (* Delegate to the default mapper, a deep identity traversal *) | e -> default_mapper.expr mapper e -let module_binding ~(config : Jsx_common.jsx_config) mapper module_binding = - config.nested_modules <- module_binding.pmb_name.txt :: config.nested_modules; +let module_binding ~(config : Jsx_common.jsxConfig) mapper module_binding = + config.nestedModules <- module_binding.pmb_name.txt :: config.nestedModules; let mapped = default_mapper.module_binding mapper module_binding in let () = - match config.nested_modules with - | _ :: rest -> config.nested_modules <- rest + match config.nestedModules with + | _ :: rest -> config.nestedModules <- rest | [] -> () in mapped (* TODO: some line number might still be wrong *) -let jsx_mapper ~config = +let jsxMapper ~config = let expr = expr ~config in let module_binding = module_binding ~config in - let transform_structure_item = transform_structure_item ~config in - let transform_signature_item = transform_signature_item ~config in - (expr, module_binding, transform_signature_item, transform_structure_item) + let transformStructureItem = transformStructureItem ~config in + let transformSignatureItem = transformSignatureItem ~config in + (expr, module_binding, transformSignatureItem, transformStructureItem) diff --git a/analysis/vendor/res_syntax/reactjs_jsx_v3.ml b/analysis/vendor/res_syntax/reactjs_jsx_v3.ml index 46de98bf4..83316c9d5 100644 --- a/analysis/vendor/res_syntax/reactjs_jsx_v3.ml +++ b/analysis/vendor/res_syntax/reactjs_jsx_v3.ml @@ -10,48 +10,48 @@ let labelled str = Labelled str let optional str = Optional str -let is_optional str = +let isOptional str = match str with | Optional _ -> true | _ -> false -let is_labelled str = +let isLabelled str = match str with | Labelled _ -> true | _ -> false -let get_label str = +let getLabel str = match str with | Optional str | Labelled str -> str | Nolabel -> "" -let option_ident = Lident "option" +let optionIdent = Lident "option" -let constant_string ~loc str = +let constantString ~loc str = Ast_helper.Exp.constant ~loc (Pconst_string (str, None)) -let safe_type_from_value value_str = - let value_str = get_label value_str in - if value_str = "" || (value_str.[0] [@doesNotRaise]) <> '_' then value_str - else "T" ^ value_str +let safeTypeFromValue valueStr = + let valueStr = getLabel valueStr in + if valueStr = "" || (valueStr.[0] [@doesNotRaise]) <> '_' then valueStr + else "T" ^ valueStr -let key_type loc = - Typ.constr ~loc {loc; txt = option_ident} +let keyType loc = + Typ.constr ~loc {loc; txt = optionIdent} [Typ.constr ~loc {loc; txt = Lident "string"} []] type 'a children = ListLiteral of 'a | Exact of 'a -type component_config = {props_name: string} +type componentConfig = {propsName: string} (* if children is a list, convert it to an array while mapping each element. If not, just map over it, as usual *) -let transform_children_if_list_upper ~loc ~mapper the_list = - let rec transformChildren_ the_list accum = +let transformChildrenIfListUpper ~loc ~mapper theList = + let rec transformChildren_ theList accum = (* not in the sense of converting a list to an array; convert the AST reprensentation of a list to the AST reprensentation of an array *) - match the_list with + match theList with | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> ( match accum with - | [single_element] -> Exact single_element + | [singleElement] -> Exact singleElement | accum -> ListLiteral (Exp.array ~loc (List.rev accum))) | { pexp_desc = @@ -59,15 +59,15 @@ let transform_children_if_list_upper ~loc ~mapper the_list = ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple [v; acc]}); } -> transformChildren_ acc (mapper.expr mapper v :: accum) - | not_a_list -> Exact (mapper.expr mapper not_a_list) + | notAList -> Exact (mapper.expr mapper notAList) in - transformChildren_ the_list [] + transformChildren_ theList [] -let transform_children_if_list ~loc ~mapper the_list = - let rec transformChildren_ the_list accum = +let transformChildrenIfList ~loc ~mapper theList = + let rec transformChildren_ theList accum = (* not in the sense of converting a list to an array; convert the AST reprensentation of a list to the AST reprensentation of an array *) - match the_list with + match theList with | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> Exp.array ~loc (List.rev accum) | { @@ -76,93 +76,91 @@ let transform_children_if_list ~loc ~mapper the_list = ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple [v; acc]}); } -> transformChildren_ acc (mapper.expr mapper v :: accum) - | not_a_list -> mapper.expr mapper not_a_list + | notAList -> mapper.expr mapper notAList in - transformChildren_ the_list [] + transformChildren_ theList [] -let extract_children ?(remove_last_position_unit = false) ~loc - props_and_children = +let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren = let rec allButLast_ lst acc = match lst with | [] -> [] | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] -> acc | (Nolabel, {pexp_loc}) :: _rest -> - Jsx_common.raise_error ~loc:pexp_loc + Jsx_common.raiseError ~loc:pexp_loc "JSX: found non-labelled argument before the last position" | arg :: rest -> allButLast_ rest (arg :: acc) in - let all_but_last lst = allButLast_ lst [] |> List.rev in + let allButLast lst = allButLast_ lst [] |> List.rev in match List.partition (fun (label, _) -> label = labelled "children") - props_and_children + propsAndChildren with | [], props -> (* no children provided? Place a placeholder list *) ( Exp.construct ~loc {loc; txt = Lident "[]"} None, - if remove_last_position_unit then all_but_last props else props ) - | [(_, children_expr)], props -> - ( children_expr, - if remove_last_position_unit then all_but_last props else props ) + if removeLastPositionUnit then allButLast props else props ) + | [(_, childrenExpr)], props -> + (childrenExpr, if removeLastPositionUnit then allButLast props else props) | _ -> - Jsx_common.raise_error ~loc + Jsx_common.raiseError ~loc "JSX: somehow there's more than one `children` label" -let unerasable_ignore loc = +let unerasableIgnore loc = ( {loc; txt = "warning"}, PStr [Str.eval (Exp.constant (Pconst_string ("-16", None)))] ) -let merlin_focus = ({loc = Location.none; txt = "merlin.focus"}, PStr []) +let merlinFocus = ({loc = Location.none; txt = "merlin.focus"}, PStr []) (* Helper method to filter out any attribute that isn't [@react.component] *) -let other_attrs_pure (loc, _) = loc.txt <> "react.component" +let otherAttrsPure (loc, _) = loc.txt <> "react.component" (* Finds the name of the variable the binding is assigned to, otherwise raises Invalid_argument *) -let rec get_fn_name binding = +let rec getFnName binding = match binding with | {ppat_desc = Ppat_var {txt}} -> txt - | {ppat_desc = Ppat_constraint (pat, _)} -> get_fn_name pat + | {ppat_desc = Ppat_constraint (pat, _)} -> getFnName pat | {ppat_loc} -> - Jsx_common.raise_error ~loc:ppat_loc + Jsx_common.raiseError ~loc:ppat_loc "react.component calls cannot be destructured." -let make_new_binding binding expression new_name = +let makeNewBinding binding expression newName = match binding with | {pvb_pat = {ppat_desc = Ppat_var ppat_var} as pvb_pat} -> { binding with pvb_pat = - {pvb_pat with ppat_desc = Ppat_var {ppat_var with txt = new_name}}; + {pvb_pat with ppat_desc = Ppat_var {ppat_var with txt = newName}}; pvb_expr = expression; - pvb_attributes = [merlin_focus]; + pvb_attributes = [merlinFocus]; } | {pvb_loc} -> - Jsx_common.raise_error ~loc:pvb_loc + Jsx_common.raiseError ~loc:pvb_loc "react.component calls cannot be destructured." (* Lookup the value of `props` otherwise raise Invalid_argument error *) -let get_props_name_value _acc (loc, exp) = +let getPropsNameValue _acc (loc, exp) = match (loc, exp) with | {txt = Lident "props"}, {pexp_desc = Pexp_ident {txt = Lident str}} -> - {props_name = str} + {propsName = str} | {txt; loc}, _ -> - Jsx_common.raise_error ~loc + Jsx_common.raiseError ~loc "react.component only accepts props as an option, given: { %s }" (Longident.last txt) (* Lookup the `props` record or string as part of [@react.component] and store the name for use when rewriting *) -let get_props_attr payload = - let default_props = {props_name = "Props"} in +let getPropsAttr payload = + let defaultProps = {propsName = "Props"} in match payload with | Some (PStr ({ pstr_desc = - Pstr_eval ({pexp_desc = Pexp_record (record_fields, None)}, _); + Pstr_eval ({pexp_desc = Pexp_record (recordFields, None)}, _); } :: _rest)) -> - List.fold_left get_props_name_value default_props record_fields + List.fold_left getPropsNameValue defaultProps recordFields | Some (PStr ({ @@ -170,43 +168,43 @@ let get_props_attr payload = Pstr_eval ({pexp_desc = Pexp_ident {txt = Lident "props"}}, _); } :: _rest)) -> - {props_name = "props"} + {propsName = "props"} | Some (PStr ({pstr_desc = Pstr_eval (_, _); pstr_loc} :: _rest)) -> - Jsx_common.raise_error ~loc:pstr_loc + Jsx_common.raiseError ~loc:pstr_loc "react.component accepts a record config with props as an options." - | _ -> default_props + | _ -> defaultProps (* Plucks the label, loc, and type_ from an AST node *) -let pluck_label_default_loc_type (label, default, _, _, loc, type_) = +let pluckLabelDefaultLocType (label, default, _, _, loc, type_) = (label, default, loc, type_) (* Lookup the filename from the location information on the AST node and turn it into a valid module identifier *) -let filename_from_loc (pstr_loc : Location.t) = - let file_name = +let filenameFromLoc (pstr_loc : Location.t) = + let fileName = match pstr_loc.loc_start.pos_fname with | "" -> !Location.input_name - | file_name -> file_name + | fileName -> fileName in - let file_name = - try Filename.chop_extension (Filename.basename file_name) - with Invalid_argument _ -> file_name + let fileName = + try Filename.chop_extension (Filename.basename fileName) + with Invalid_argument _ -> fileName in - let file_name = String.capitalize_ascii file_name in - file_name + let fileName = String.capitalize_ascii fileName in + fileName (* Build a string representation of a module name with segments separated by $ *) -let make_module_name file_name nested_modules fn_name = - let full_module_name = - match (file_name, nested_modules, fn_name) with +let makeModuleName fileName nestedModules fnName = + let fullModuleName = + match (fileName, nestedModules, fnName) with (* TODO: is this even reachable? It seems like the fileName always exists *) - | "", nested_modules, "make" -> nested_modules - | "", nested_modules, fn_name -> List.rev (fn_name :: nested_modules) - | file_name, nested_modules, "make" -> file_name :: List.rev nested_modules - | file_name, nested_modules, fn_name -> - file_name :: List.rev (fn_name :: nested_modules) + | "", nestedModules, "make" -> nestedModules + | "", nestedModules, fnName -> List.rev (fnName :: nestedModules) + | fileName, nestedModules, "make" -> fileName :: List.rev nestedModules + | fileName, nestedModules, fnName -> + fileName :: List.rev (fnName :: nestedModules) in - let full_module_name = String.concat "$" full_module_name in - full_module_name + let fullModuleName = String.concat "$" fullModuleName in + fullModuleName (* AST node builders @@ -215,16 +213,16 @@ let make_module_name file_name nested_modules fn_name = *) (* Build an AST node representing all named args for the `external` definition for a component's props *) -let rec recursively_make_named_args_for_external list args = +let rec recursivelyMakeNamedArgsForExternal list args = match list with - | (label, default, loc, interior_type) :: tl -> - recursively_make_named_args_for_external tl + | (label, default, loc, interiorType) :: tl -> + recursivelyMakeNamedArgsForExternal tl (Typ.arrow ~loc label - (match (label, interior_type, default) with + (match (label, interiorType, default) with (* ~foo=1 *) | label, None, Some _ -> { - ptyp_desc = Ptyp_var (safe_type_from_value label); + ptyp_desc = Ptyp_var (safeTypeFromValue label); ptyp_loc = loc; ptyp_attributes = []; } @@ -244,19 +242,19 @@ let rec recursively_make_named_args_for_external list args = _ ) (* ~foo: int=? - note this isnt valid. but we want to get a type error *) | label, Some type_, _ - when is_optional label -> + when isOptional label -> type_ (* ~foo=? *) - | label, None, _ when is_optional label -> + | label, None, _ when isOptional label -> { - ptyp_desc = Ptyp_var (safe_type_from_value label); + ptyp_desc = Ptyp_var (safeTypeFromValue label); ptyp_loc = loc; ptyp_attributes = []; } (* ~foo *) | label, None, _ -> { - ptyp_desc = Ptyp_var (safe_type_from_value label); + ptyp_desc = Ptyp_var (safeTypeFromValue label); ptyp_loc = loc; ptyp_attributes = []; } @@ -264,64 +262,61 @@ let rec recursively_make_named_args_for_external list args = args) | [] -> args -(* Build an AST node for the [@obj] representing props for a component *) -let make_props_value fn_name loc named_arg_list_with_key_and_ref props_type = - let props_name = fn_name ^ "Props" in +(* Build an AST node for the [@bs.obj] representing props for a component *) +let makePropsValue fnName loc namedArgListWithKeyAndRef propsType = + let propsName = fnName ^ "Props" in { - pval_name = {txt = props_name; loc}; + pval_name = {txt = propsName; loc}; pval_type = - recursively_make_named_args_for_external named_arg_list_with_key_and_ref + recursivelyMakeNamedArgsForExternal namedArgListWithKeyAndRef (Typ.arrow nolabel { ptyp_desc = Ptyp_constr ({txt = Lident "unit"; loc}, []); ptyp_loc = loc; ptyp_attributes = []; } - props_type); + propsType); pval_prim = [""]; - pval_attributes = [({txt = "obj"; loc}, PStr [])]; + pval_attributes = [({txt = "bs.obj"; loc}, PStr [])]; pval_loc = loc; } -(* Build an AST node representing an `external` with the definition of the [@obj] *) -let make_props_external fn_name loc named_arg_list_with_key_and_ref props_type = +(* Build an AST node representing an `external` with the definition of the [@bs.obj] *) +let makePropsExternal fnName loc namedArgListWithKeyAndRef propsType = { pstr_loc = loc; pstr_desc = Pstr_primitive - (make_props_value fn_name loc named_arg_list_with_key_and_ref props_type); + (makePropsValue fnName loc namedArgListWithKeyAndRef propsType); } (* Build an AST node for the signature of the `external` definition *) -let make_props_external_sig fn_name loc named_arg_list_with_key_and_ref - props_type = +let makePropsExternalSig fnName loc namedArgListWithKeyAndRef propsType = { psig_loc = loc; psig_desc = - Psig_value - (make_props_value fn_name loc named_arg_list_with_key_and_ref props_type); + Psig_value (makePropsValue fnName loc namedArgListWithKeyAndRef propsType); } (* Build an AST node for the props name when converted to an object inside the function signature *) -let make_props_name ~loc name = +let makePropsName ~loc name = {ppat_desc = Ppat_var {txt = name; loc}; ppat_loc = loc; ppat_attributes = []} -let make_object_field loc (str, attrs, type_) = +let makeObjectField loc (str, attrs, type_) = Otag ({loc; txt = str}, attrs, type_) (* Build an AST node representing a "closed" object representing a component's props *) -let make_props_type ~loc named_type_list = +let makePropsType ~loc namedTypeList = Typ.mk ~loc - (Ptyp_object (List.map (make_object_field loc) named_type_list, Closed)) + (Ptyp_object (List.map (makeObjectField loc) namedTypeList, Closed)) (* Builds an AST node for the entire `external` definition of props *) -let make_external_decl fn_name loc named_arg_list_with_key_and_ref - named_type_list = - make_props_external fn_name loc - (List.map pluck_label_default_loc_type named_arg_list_with_key_and_ref) - (make_props_type ~loc named_type_list) +let makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList = + makePropsExternal fnName loc + (List.map pluckLabelDefaultLocType namedArgListWithKeyAndRef) + (makePropsType ~loc namedTypeList) -let newtype_to_var newtype type_ = +let newtypeToVar newtype type_ = let var_desc = Ptyp_var ("type-" ^ newtype) in let typ (mapper : Ast_mapper.mapper) typ = match typ.ptyp_desc with @@ -333,57 +328,55 @@ let newtype_to_var newtype type_ = mapper.typ mapper type_ (* TODO: some line number might still be wrong *) -let jsx_mapper ~config = - let transform_uppercase_call3 module_path mapper loc attrs _ call_arguments = - let children, args_with_labels = - extract_children ~loc ~remove_last_position_unit:true call_arguments +let jsxMapper ~config = + let transformUppercaseCall3 modulePath mapper loc attrs _ callArguments = + let children, argsWithLabels = + extractChildren ~loc ~removeLastPositionUnit:true callArguments in - let args_for_make = args_with_labels in - let children_expr = - transform_children_if_list_upper ~loc ~mapper children - in - let recursively_transformed_args_for_make = - args_for_make + let argsForMake = argsWithLabels in + let childrenExpr = transformChildrenIfListUpper ~loc ~mapper children in + let recursivelyTransformedArgsForMake = + argsForMake |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in - let children_arg = ref None in + let childrenArg = ref None in let args = - recursively_transformed_args_for_make - @ (match children_expr with + recursivelyTransformedArgsForMake + @ (match childrenExpr with | Exact children -> [(labelled "children", children)] | ListLiteral {pexp_desc = Pexp_array list} when list = [] -> [] | ListLiteral expression -> (* this is a hack to support react components that introspect into their children *) - children_arg := Some expression; + childrenArg := Some expression; [ ( labelled "children", Exp.ident ~loc {loc; txt = Ldot (Lident "React", "null")} ); ]) @ [(nolabel, Exp.construct ~loc {loc; txt = Lident "()"} None)] in - let is_cap str = String.capitalize_ascii str = str in + let isCap str = String.capitalize_ascii str = str in let ident = - match module_path with - | Lident _ -> Ldot (module_path, "make") - | Ldot (_modulePath, value) as full_path when is_cap value -> - Ldot (full_path, "make") - | module_path -> module_path + match modulePath with + | Lident _ -> Ldot (modulePath, "make") + | Ldot (_modulePath, value) as fullPath when isCap value -> + Ldot (fullPath, "make") + | modulePath -> modulePath in - let props_ident = + let propsIdent = match ident with | Lident path -> Lident (path ^ "Props") | Ldot (ident, path) -> Ldot (ident, path ^ "Props") | _ -> - Jsx_common.raise_error ~loc + Jsx_common.raiseError ~loc "JSX name can't be the result of function applications" in let props = - Exp.apply ~attrs ~loc (Exp.ident ~loc {loc; txt = props_ident}) args + Exp.apply ~attrs ~loc (Exp.ident ~loc {loc; txt = propsIdent}) args in (* handle key, ref, children *) (* React.createElement(Component.make, props, ...children) *) - match !children_arg with + match !childrenArg with | None -> Exp.apply ~loc ~attrs (Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElement")}) @@ -399,11 +392,11 @@ let jsx_mapper ~config = ] in - let transform_lowercase_call3 mapper loc attrs call_arguments id = - let children, non_children_props = extract_children ~loc call_arguments in - let component_name_expr = constant_string ~loc id in - let children_expr = transform_children_if_list ~loc ~mapper children in - let create_element_call = + let transformLowercaseCall3 mapper loc attrs callArguments id = + let children, nonChildrenProps = extractChildren ~loc callArguments in + let componentNameExpr = constantString ~loc id in + let childrenExpr = transformChildrenIfList ~loc ~mapper children in + let createElementCall = match children with (* [@JSX] div(~children=[a]), coming from
a
*) | { @@ -414,34 +407,34 @@ let jsx_mapper ~config = "createDOMElementVariadic" (* [@JSX] div(~children= value), coming from
...(value)
*) | {pexp_loc} -> - Jsx_common.raise_error ~loc:pexp_loc + Jsx_common.raiseError ~loc:pexp_loc "A spread as a DOM element's children don't make sense written \ together. You can simply remove the spread." in let args = - match non_children_props with + match nonChildrenProps with | [_justTheUnitArgumentAtEnd] -> [ (* "div" *) - (nolabel, component_name_expr); + (nolabel, componentNameExpr); (* [|moreCreateElementCallsHere|] *) - (nolabel, children_expr); + (nolabel, childrenExpr); ] - | non_empty_props -> - let props_call = + | nonEmptyProps -> + let propsCall = Exp.apply ~loc (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "domProps")}) - (non_empty_props + (nonEmptyProps |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression))) in [ (* "div" *) - (nolabel, component_name_expr); + (nolabel, componentNameExpr); (* ReactDOMRe.props(~className=blabla, ~foo=bar, ()) *) - (labelled "props", props_call); + (labelled "props", propsCall); (* [|moreCreateElementCallsHere|] *) - (nolabel, children_expr); + (nolabel, childrenExpr); ] in Exp.apply @@ -449,30 +442,30 @@ let jsx_mapper ~config = ~attrs (* ReactDOMRe.createElement *) (Exp.ident ~loc - {loc; txt = Ldot (Lident "ReactDOMRe", create_element_call)}) + {loc; txt = Ldot (Lident "ReactDOMRe", createElementCall)}) args in - let rec recursively_transform_named_args_for_make expr args newtypes = + let rec recursivelyTransformNamedArgsForMake expr args newtypes = match expr.pexp_desc with (* TODO: make this show up with a loc. *) | Pexp_fun (Labelled "key", _, _, _) | Pexp_fun (Optional "key", _, _, _) -> - Jsx_common.raise_error ~loc:expr.pexp_loc + Jsx_common.raiseError ~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 (Labelled "ref", _, _, _) | Pexp_fun (Optional "ref", _, _, _) -> - Jsx_common.raise_error ~loc:expr.pexp_loc + Jsx_common.raiseError ~loc:expr.pexp_loc "Ref cannot be passed as a normal prop. Either give the prop a \ different name or use the `forwardRef` API instead." | Pexp_fun (arg, default, pattern, expression) - when is_optional arg || is_labelled arg -> + when isOptional arg || isLabelled arg -> let () = - match (is_optional arg, pattern, default) with + match (isOptional arg, pattern, default) with | true, {ppat_desc = Ppat_constraint (_, {ptyp_desc})}, None -> ( match ptyp_desc with | Ptyp_constr ({txt = Lident "option"}, [_]) -> () | _ -> - let current_type = + let currentType = match ptyp_desc with | Ptyp_constr ({txt}, []) -> String.concat "." (Longident.flatten txt) @@ -485,14 +478,14 @@ let jsx_mapper ~config = (Printf.sprintf "React: optional argument annotations must have explicit \ `option`. Did you mean `option<%s>=?`?" - current_type))) + currentType))) | _ -> () in let alias = match pattern with | {ppat_desc = Ppat_alias (_, {txt}) | Ppat_var {txt}} -> txt | {ppat_desc = Ppat_any} -> "_" - | _ -> get_label arg + | _ -> getLabel arg in let type_ = match pattern with @@ -500,7 +493,7 @@ let jsx_mapper ~config = | _ -> None in - recursively_transform_named_args_for_make expression + recursivelyTransformNamedArgsForMake expression ((arg, default, pattern, alias, pattern.ppat_loc, type_) :: args) newtypes | Pexp_fun @@ -523,45 +516,44 @@ let jsx_mapper ~config = "React: react.component refs only support plain arguments and type \ annotations." | Pexp_newtype (label, expression) -> - recursively_transform_named_args_for_make expression args - (label :: newtypes) + recursivelyTransformNamedArgsForMake expression args (label :: newtypes) | Pexp_constraint (expression, _typ) -> - recursively_transform_named_args_for_make expression args newtypes + recursivelyTransformNamedArgsForMake expression args newtypes | _ -> (args, newtypes, None) in - let arg_to_type types (name, default, _noLabelName, _alias, loc, type_) = + let argToType types (name, default, _noLabelName, _alias, loc, type_) = match (type_, name, default) with | Some {ptyp_desc = Ptyp_constr ({txt = Lident "option"}, [type_])}, name, _ - when is_optional name -> - ( get_label name, + when isOptional name -> + ( getLabel name, [], { type_ with ptyp_desc = - Ptyp_constr ({loc = type_.ptyp_loc; txt = option_ident}, [type_]); + Ptyp_constr ({loc = type_.ptyp_loc; txt = optionIdent}, [type_]); } ) :: types | Some type_, name, Some _default -> - ( get_label name, + ( getLabel name, [], { - ptyp_desc = Ptyp_constr ({loc; txt = option_ident}, [type_]); + ptyp_desc = Ptyp_constr ({loc; txt = optionIdent}, [type_]); ptyp_loc = loc; ptyp_attributes = []; } ) :: types - | Some type_, name, _ -> (get_label name, [], type_) :: types - | None, name, _ when is_optional name -> - ( get_label name, + | Some type_, name, _ -> (getLabel name, [], type_) :: types + | None, name, _ when isOptional name -> + ( getLabel name, [], { ptyp_desc = Ptyp_constr - ( {loc; txt = option_ident}, + ( {loc; txt = optionIdent}, [ { - ptyp_desc = Ptyp_var (safe_type_from_value name); + ptyp_desc = Ptyp_var (safeTypeFromValue name); ptyp_loc = loc; ptyp_attributes = []; }; @@ -570,11 +562,11 @@ let jsx_mapper ~config = ptyp_attributes = []; } ) :: types - | None, name, _ when is_labelled name -> - ( get_label name, + | None, name, _ when isLabelled name -> + ( getLabel name, [], { - ptyp_desc = Ptyp_var (safe_type_from_value name); + ptyp_desc = Ptyp_var (safeTypeFromValue name); ptyp_loc = loc; ptyp_attributes = []; } ) @@ -582,151 +574,145 @@ let jsx_mapper ~config = | _ -> types in - let arg_to_concrete_type types (name, loc, type_) = + let argToConcreteType types (name, loc, type_) = match name with - | name when is_labelled name -> (get_label name, [], type_) :: types - | name when is_optional name -> - (get_label name, [], Typ.constr ~loc {loc; txt = option_ident} [type_]) + | name when isLabelled name -> (getLabel name, [], type_) :: types + | name when isOptional name -> + (getLabel name, [], Typ.constr ~loc {loc; txt = optionIdent} [type_]) :: types | _ -> types in - let nested_modules = ref [] in - let transform_structure_item item = + let nestedModules = ref [] in + let transformStructureItem item = match item with (* external *) | { pstr_loc; pstr_desc = Pstr_primitive - ({pval_name = {txt = fn_name}; pval_attributes; pval_type} as + ({pval_name = {txt = fnName}; pval_attributes; pval_type} as value_description); } as pstr -> ( - match List.filter Jsx_common.has_attr pval_attributes with + match List.filter Jsx_common.hasAttr pval_attributes with | [] -> [item] | [_] -> - let pval_type = Jsx_common.extract_uncurried pval_type in - let rec get_prop_types types ({ptyp_loc; ptyp_desc} as full_type) = + let pval_type = Jsx_common.extractUncurried pval_type in + let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = match ptyp_desc with | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) - when is_labelled name || is_optional name -> - get_prop_types ((name, ptyp_loc, type_) :: types) rest - | Ptyp_arrow (Nolabel, _type, rest) -> get_prop_types types rest - | Ptyp_arrow (name, type_, return_value) - when is_labelled name || is_optional name -> - (return_value, (name, return_value.ptyp_loc, type_) :: types) - | _ -> (full_type, types) - in - let inner_type, prop_types = get_prop_types [] pval_type in - let named_type_list = - List.fold_left arg_to_concrete_type [] prop_types + when isLabelled name || isOptional name -> + getPropTypes ((name, ptyp_loc, type_) :: types) rest + | Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest + | Ptyp_arrow (name, type_, returnValue) + when isLabelled name || isOptional name -> + (returnValue, (name, returnValue.ptyp_loc, type_) :: types) + | _ -> (fullType, types) in - let pluck_label_and_loc (label, loc, type_) = + let innerType, propTypes = getPropTypes [] pval_type in + let namedTypeList = List.fold_left argToConcreteType [] propTypes in + let pluckLabelAndLoc (label, loc, type_) = (label, None (* default *), loc, Some type_) in - let ret_props_type = make_props_type ~loc:pstr_loc named_type_list in - let external_props_decl = - make_props_external fn_name pstr_loc - ((optional "key", None, pstr_loc, Some (key_type pstr_loc)) - :: List.map pluck_label_and_loc prop_types) - ret_props_type + let retPropsType = makePropsType ~loc:pstr_loc namedTypeList in + let externalPropsDecl = + makePropsExternal fnName pstr_loc + ((optional "key", None, pstr_loc, Some (keyType pstr_loc)) + :: List.map pluckLabelAndLoc propTypes) + retPropsType in (* can't be an arrow because it will defensively uncurry *) - let new_external_type = + let newExternalType = Ptyp_constr ( {loc = pstr_loc; txt = Ldot (Lident "React", "componentLike")}, - [ret_props_type; inner_type] ) + [retPropsType; innerType] ) in - let new_structure = + let newStructure = { pstr with pstr_desc = Pstr_primitive { value_description with - pval_type = {pval_type with ptyp_desc = new_external_type}; - pval_attributes = List.filter other_attrs_pure pval_attributes; + pval_type = {pval_type with ptyp_desc = newExternalType}; + pval_attributes = List.filter otherAttrsPure pval_attributes; }; } in - [external_props_decl; new_structure] + [externalPropsDecl; newStructure] | _ -> - Jsx_common.raise_error ~loc:pstr_loc + Jsx_common.raiseError ~loc:pstr_loc "Only one react.component call can exist on a component at one time") (* let component = ... *) - | {pstr_loc; pstr_desc = Pstr_value (rec_flag, value_bindings)} -> ( - let file_name = filename_from_loc pstr_loc in - let empty_loc = Location.in_file file_name in - let map_binding binding = - if Jsx_common.has_attr_on_binding binding then - let binding = Jsx_common.remove_arity binding in - let binding_loc = binding.pvb_loc in - let binding_pat_loc = binding.pvb_pat.ppat_loc in + | {pstr_loc; pstr_desc = Pstr_value (recFlag, valueBindings)} -> ( + let fileName = filenameFromLoc pstr_loc in + let emptyLoc = Location.in_file fileName in + let mapBinding binding = + if Jsx_common.hasAttrOnBinding binding then + let binding = Jsx_common.removeArity binding in + let bindingLoc = binding.pvb_loc in + let bindingPatLoc = binding.pvb_pat.ppat_loc in let binding = { binding with - pvb_pat = {binding.pvb_pat with ppat_loc = empty_loc}; - pvb_loc = empty_loc; + pvb_pat = {binding.pvb_pat with ppat_loc = emptyLoc}; + pvb_loc = emptyLoc; } in - let fn_name = get_fn_name binding.pvb_pat in - let internal_fn_name = fn_name ^ "$Internal" in - let full_module_name = - make_module_name file_name !nested_modules fn_name - in - let modified_binding_old binding = + let fnName = getFnName binding.pvb_pat in + let internalFnName = fnName ^ "$Internal" in + let fullModuleName = makeModuleName fileName !nestedModules fnName in + let modifiedBindingOld binding = let expression = binding.pvb_expr in (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunk_for_fun_expression expression = + let rec spelunkForFunExpression expression = match expression with (* let make = (~prop) => ... *) | {pexp_desc = Pexp_fun _} | {pexp_desc = Pexp_newtype _} -> expression (* let make = {let foo = bar in (~prop) => ...} *) - | {pexp_desc = Pexp_let (_recursive, _vbs, return_expression)} -> + | {pexp_desc = Pexp_let (_recursive, _vbs, returnExpression)} -> (* here's where we spelunk! *) - spelunk_for_fun_expression return_expression + spelunkForFunExpression returnExpression (* let make = React.forwardRef((~prop) => ...) *) | { pexp_desc = Pexp_apply - (_wrapperExpression, [(Nolabel, inner_function_expression)]); + (_wrapperExpression, [(Nolabel, innerFunctionExpression)]); } -> - spelunk_for_fun_expression inner_function_expression + spelunkForFunExpression innerFunctionExpression | { pexp_desc = - Pexp_sequence (_wrapperExpression, inner_function_expression); + Pexp_sequence (_wrapperExpression, innerFunctionExpression); } -> - spelunk_for_fun_expression inner_function_expression - | {pexp_desc = Pexp_constraint (inner_function_expression, _typ)} - -> - spelunk_for_fun_expression inner_function_expression + spelunkForFunExpression innerFunctionExpression + | {pexp_desc = Pexp_constraint (innerFunctionExpression, _typ)} -> + spelunkForFunExpression innerFunctionExpression | {pexp_loc} -> - Jsx_common.raise_error ~loc:pexp_loc + Jsx_common.raiseError ~loc:pexp_loc "react.component calls can only be on function definitions \ or component wrappers (forwardRef, memo)." in - spelunk_for_fun_expression expression + spelunkForFunExpression expression in - let modified_binding binding = - let has_application = ref false in - let wrap_expression_with_binding expression_fn expression = - Vb.mk ~loc:binding_loc - ~attrs:(List.filter other_attrs_pure binding.pvb_attributes) - (Pat.var ~loc:binding_pat_loc - {loc = binding_pat_loc; txt = fn_name}) - (expression_fn expression) + let modifiedBinding binding = + let hasApplication = ref false in + let wrapExpressionWithBinding expressionFn expression = + Vb.mk ~loc:bindingLoc + ~attrs:(List.filter otherAttrsPure binding.pvb_attributes) + (Pat.var ~loc:bindingPatLoc {loc = bindingPatLoc; txt = fnName}) + (expressionFn expression) in let expression = binding.pvb_expr in - let unerasable_ignore_exp exp = + let unerasableIgnoreExp exp = { exp with pexp_attributes = - unerasable_ignore empty_loc :: exp.pexp_attributes; + unerasableIgnore emptyLoc :: exp.pexp_attributes; } in (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunk_for_fun_expression expression = + let rec spelunkForFunExpression expression = match expression with (* let make = (~prop) => ... with no final unit *) | { @@ -735,14 +721,14 @@ let jsx_mapper ~config = ( ((Labelled _ | Optional _) as label), default, pattern, - ({pexp_desc = Pexp_fun _} as internal_expression) ); + ({pexp_desc = Pexp_fun _} as internalExpression) ); } -> - let wrap, has_unit, exp = - spelunk_for_fun_expression internal_expression + let wrap, hasUnit, exp = + spelunkForFunExpression internalExpression in ( wrap, - has_unit, - unerasable_ignore_exp + hasUnit, + unerasableIgnoreExp { expression with pexp_desc = Pexp_fun (label, default, pattern, exp); @@ -770,14 +756,14 @@ let jsx_mapper ~config = _pattern, _internalExpression ); } -> - ((fun a -> a), false, unerasable_ignore_exp expression) + ((fun a -> a), false, unerasableIgnoreExp expression) (* let make = (prop) => ... *) | { pexp_desc = Pexp_fun (_nolabel, _default, pattern, _internalExpression); } -> - if has_application.contents then - ((fun a -> a), false, unerasable_ignore_exp expression) + if hasApplication.contents then + ((fun a -> a), false, unerasableIgnoreExp expression) else Location.raise_errorf ~loc:pattern.ppat_loc "React: props need to be labelled arguments.\n\ @@ -786,366 +772,357 @@ let jsx_mapper ~config = \ If your component doesn't have any props use () or _ \ instead of a name." (* let make = {let foo = bar in (~prop) => ...} *) - | {pexp_desc = Pexp_let (recursive, vbs, internal_expression)} -> + | {pexp_desc = Pexp_let (recursive, vbs, internalExpression)} -> (* here's where we spelunk! *) - let wrap, has_unit, exp = - spelunk_for_fun_expression internal_expression + let wrap, hasUnit, exp = + spelunkForFunExpression internalExpression in ( wrap, - has_unit, + hasUnit, {expression with pexp_desc = Pexp_let (recursive, vbs, exp)} ) (* let make = React.forwardRef((~prop) => ...) *) | { pexp_desc = - Pexp_apply - (wrapper_expression, [(Nolabel, internal_expression)]); + Pexp_apply (wrapperExpression, [(Nolabel, internalExpression)]); } -> - let () = has_application := true in - let _, has_unit, exp = - spelunk_for_fun_expression internal_expression + let () = hasApplication := true in + let _, hasUnit, exp = + spelunkForFunExpression internalExpression in - ( (fun exp -> Exp.apply wrapper_expression [(nolabel, exp)]), - has_unit, + ( (fun exp -> Exp.apply wrapperExpression [(nolabel, exp)]), + hasUnit, exp ) | { - pexp_desc = - Pexp_sequence (wrapper_expression, internal_expression); + pexp_desc = Pexp_sequence (wrapperExpression, internalExpression); } -> - let wrap, has_unit, exp = - spelunk_for_fun_expression internal_expression + let wrap, hasUnit, exp = + spelunkForFunExpression internalExpression in ( wrap, - has_unit, + hasUnit, { expression with - pexp_desc = Pexp_sequence (wrapper_expression, exp); + pexp_desc = Pexp_sequence (wrapperExpression, exp); } ) | e -> ((fun a -> a), false, e) in - let wrap_expression, has_unit, expression = - spelunk_for_fun_expression expression + let wrapExpression, hasUnit, expression = + spelunkForFunExpression expression in - (wrap_expression_with_binding wrap_expression, has_unit, expression) - in - let binding_wrapper, has_unit, expression = - modified_binding binding + (wrapExpressionWithBinding wrapExpression, hasUnit, expression) in - let react_component_attribute = - try Some (List.find Jsx_common.has_attr binding.pvb_attributes) + let bindingWrapper, hasUnit, expression = modifiedBinding binding in + let reactComponentAttribute = + try Some (List.find Jsx_common.hasAttr binding.pvb_attributes) with Not_found -> None in let _attr_loc, payload = - match react_component_attribute with + match reactComponentAttribute with | Some (loc, payload) -> (loc.loc, Some payload) - | None -> (empty_loc, None) + | None -> (emptyLoc, None) in - let props = get_props_attr payload in + let props = getPropsAttr payload in (* do stuff here! *) - let named_arg_list, newtypes, forward_ref = - recursively_transform_named_args_for_make - (modified_binding_old binding) + let namedArgList, newtypes, forwardRef = + recursivelyTransformNamedArgsForMake + (modifiedBindingOld binding) [] [] in - let named_arg_list_with_key_and_ref = + let namedArgListWithKeyAndRef = ( optional "key", None, - Pat.var {txt = "key"; loc = empty_loc}, + Pat.var {txt = "key"; loc = emptyLoc}, "key", - empty_loc, - Some (key_type empty_loc) ) - :: named_arg_list + emptyLoc, + Some (keyType emptyLoc) ) + :: namedArgList in - let named_arg_list_with_key_and_ref = - match forward_ref with + let namedArgListWithKeyAndRef = + match forwardRef with | Some _ -> ( optional "ref", None, - Pat.var {txt = "key"; loc = empty_loc}, + Pat.var {txt = "key"; loc = emptyLoc}, "ref", - empty_loc, + emptyLoc, None ) - :: named_arg_list_with_key_and_ref - | None -> named_arg_list_with_key_and_ref + :: namedArgListWithKeyAndRef + | None -> namedArgListWithKeyAndRef in - let named_arg_list_with_key_and_ref_for_new = - match forward_ref with + let namedArgListWithKeyAndRefForNew = + match forwardRef with | Some txt -> - named_arg_list + namedArgList @ [ ( nolabel, None, - Pat.var {txt; loc = empty_loc}, + Pat.var {txt; loc = emptyLoc}, txt, - empty_loc, + emptyLoc, None ); ] - | None -> named_arg_list + | None -> namedArgList in - let pluck_arg (label, _, _, alias, loc, _) = - let label_string = + let pluckArg (label, _, _, alias, loc, _) = + let labelString = match label with - | label when is_optional label || is_labelled label -> - get_label label + | label when isOptional label || isLabelled label -> + getLabel label | _ -> "" in ( label, - match label_string with + match labelString with | "" -> Exp.ident ~loc {txt = Lident alias; loc} - | label_string -> + | labelString -> Exp.apply ~loc (Exp.ident ~loc {txt = Lident "##"; loc}) [ - ( nolabel, - Exp.ident ~loc {txt = Lident props.props_name; loc} ); - (nolabel, Exp.ident ~loc {txt = Lident label_string; loc}); + (nolabel, Exp.ident ~loc {txt = Lident props.propsName; loc}); + (nolabel, Exp.ident ~loc {txt = Lident labelString; loc}); ] ) in - let named_type_list = List.fold_left arg_to_type [] named_arg_list in - let loc = empty_loc in - let external_args = + let namedTypeList = List.fold_left argToType [] namedArgList in + let loc = emptyLoc in + let externalArgs = (* translate newtypes to type variables *) List.fold_left (fun args newtype -> List.map - (fun (a, b, c, d, e, maybe_typ) -> - match maybe_typ with + (fun (a, b, c, d, e, maybeTyp) -> + match maybeTyp with | Some typ -> - (a, b, c, d, e, Some (newtype_to_var newtype.txt typ)) + (a, b, c, d, e, Some (newtypeToVar newtype.txt typ)) | None -> (a, b, c, d, e, None)) args) - named_arg_list_with_key_and_ref newtypes + namedArgListWithKeyAndRef newtypes in - let external_types = + let externalTypes = (* translate newtypes to type variables *) List.fold_left (fun args newtype -> List.map - (fun (a, b, typ) -> (a, b, newtype_to_var newtype.txt typ)) + (fun (a, b, typ) -> (a, b, newtypeToVar newtype.txt typ)) args) - named_type_list newtypes + namedTypeList newtypes in - let external_decl = - make_external_decl fn_name loc external_args external_types + let externalDecl = + makeExternalDecl fnName loc externalArgs externalTypes in - let inner_expression_args = - List.map pluck_arg named_arg_list_with_key_and_ref_for_new + let innerExpressionArgs = + List.map pluckArg namedArgListWithKeyAndRefForNew @ - if has_unit then + if hasUnit then [(Nolabel, Exp.construct {loc; txt = Lident "()"} None)] else [] in - let inner_expression = + let innerExpression = Exp.apply (Exp.ident { loc; txt = Lident - (match rec_flag with - | Recursive -> internal_fn_name - | Nonrecursive -> fn_name); + (match recFlag with + | Recursive -> internalFnName + | Nonrecursive -> fnName); }) - inner_expression_args + innerExpressionArgs in - let inner_expression_with_ref = - match forward_ref with + let innerExpressionWithRef = + match forwardRef with | Some txt -> { - inner_expression with + innerExpression with pexp_desc = Pexp_fun ( nolabel, None, { - ppat_desc = Ppat_var {txt; loc = empty_loc}; - ppat_loc = empty_loc; + ppat_desc = Ppat_var {txt; loc = emptyLoc}; + ppat_loc = emptyLoc; ppat_attributes = []; }, - inner_expression ); + innerExpression ); } - | None -> inner_expression + | None -> innerExpression in - let full_expression = + let fullExpression = Exp.fun_ nolabel None { ppat_desc = Ppat_constraint - ( make_props_name ~loc:empty_loc props.props_name, - make_props_type ~loc:empty_loc external_types ); - ppat_loc = empty_loc; + ( makePropsName ~loc:emptyLoc props.propsName, + makePropsType ~loc:emptyLoc externalTypes ); + ppat_loc = emptyLoc; ppat_attributes = []; } - inner_expression_with_ref + innerExpressionWithRef in - let full_expression = + let fullExpression = if !Config.uncurried = Uncurried then - full_expression - |> Ast_uncurried.uncurried_fun ~loc:full_expression.pexp_loc + fullExpression + |> Ast_uncurried.uncurriedFun ~loc:fullExpression.pexp_loc ~arity:1 - else full_expression + else fullExpression in - let full_expression = - match full_module_name with - | "" -> full_expression + let fullExpression = + match fullModuleName with + | "" -> fullExpression | txt -> Exp.let_ Nonrecursive [ - Vb.mk ~loc:empty_loc - (Pat.var ~loc:empty_loc {loc = empty_loc; txt}) - full_expression; + Vb.mk ~loc:emptyLoc + (Pat.var ~loc:emptyLoc {loc = emptyLoc; txt}) + fullExpression; ] - (Exp.ident ~loc:empty_loc {loc = empty_loc; txt = Lident txt}) + (Exp.ident ~loc:emptyLoc {loc = emptyLoc; txt = Lident txt}) in - let bindings, new_binding = - match rec_flag with + let bindings, newBinding = + match recFlag with | Recursive -> ( [ - binding_wrapper - (Exp.let_ ~loc:empty_loc Recursive + bindingWrapper + (Exp.let_ ~loc:emptyLoc Recursive [ - make_new_binding binding expression internal_fn_name; + makeNewBinding binding expression internalFnName; Vb.mk - (Pat.var {loc = empty_loc; txt = fn_name}) - full_expression; + (Pat.var {loc = emptyLoc; txt = fnName}) + fullExpression; ] - (Exp.ident {loc = empty_loc; txt = Lident fn_name})); + (Exp.ident {loc = emptyLoc; txt = Lident fnName})); ], None ) | Nonrecursive -> ( [{binding with pvb_expr = expression}], - Some (binding_wrapper full_expression) ) + Some (bindingWrapper fullExpression) ) in - (Some external_decl, bindings, new_binding) + (Some externalDecl, bindings, newBinding) else (None, [binding], None) in - let structures_and_binding = List.map map_binding value_bindings in - let other_structures (extern, binding, new_binding) - (externs, bindings, new_bindings) = + let structuresAndBinding = List.map mapBinding valueBindings in + let otherStructures (extern, binding, newBinding) + (externs, bindings, newBindings) = let externs = match extern with | Some extern -> extern :: externs | None -> externs in - let new_bindings = - match new_binding with - | Some new_binding -> new_binding :: new_bindings - | None -> new_bindings + let newBindings = + match newBinding with + | Some newBinding -> newBinding :: newBindings + | None -> newBindings in - (externs, binding @ bindings, new_bindings) + (externs, binding @ bindings, newBindings) in - let externs, bindings, new_bindings = - List.fold_right other_structures structures_and_binding ([], [], []) + let externs, bindings, newBindings = + List.fold_right otherStructures structuresAndBinding ([], [], []) in externs - @ [{pstr_loc; pstr_desc = Pstr_value (rec_flag, bindings)}] + @ [{pstr_loc; pstr_desc = Pstr_value (recFlag, bindings)}] @ - match new_bindings with + match newBindings with | [] -> [] - | new_bindings -> - [ - {pstr_loc = empty_loc; pstr_desc = Pstr_value (rec_flag, new_bindings)}; - ]) + | newBindings -> + [{pstr_loc = emptyLoc; pstr_desc = Pstr_value (recFlag, newBindings)}]) | _ -> [item] in - let transform_signature_item item = + let transformSignatureItem item = match item with | { psig_loc; psig_desc = Psig_value - ({pval_name = {txt = fn_name}; pval_attributes; pval_type} as + ({pval_name = {txt = fnName}; pval_attributes; pval_type} as psig_desc); } as psig -> ( - match List.filter Jsx_common.has_attr pval_attributes with + match List.filter Jsx_common.hasAttr pval_attributes with | [] -> [item] | [_] -> - let pval_type = Jsx_common.extract_uncurried pval_type in - let rec get_prop_types types ({ptyp_loc; ptyp_desc} as full_type) = + let pval_type = Jsx_common.extractUncurried pval_type in + let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = match ptyp_desc with | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) - when is_optional name || is_labelled name -> - get_prop_types ((name, ptyp_loc, type_) :: types) rest - | Ptyp_arrow (Nolabel, _type, rest) -> get_prop_types types rest - | Ptyp_arrow (name, type_, return_value) - when is_optional name || is_labelled name -> - (return_value, (name, return_value.ptyp_loc, type_) :: types) - | _ -> (full_type, types) - in - let inner_type, prop_types = get_prop_types [] pval_type in - let named_type_list = - List.fold_left arg_to_concrete_type [] prop_types + when isOptional name || isLabelled name -> + getPropTypes ((name, ptyp_loc, type_) :: types) rest + | Ptyp_arrow (Nolabel, _type, rest) -> getPropTypes types rest + | Ptyp_arrow (name, type_, returnValue) + when isOptional name || isLabelled name -> + (returnValue, (name, returnValue.ptyp_loc, type_) :: types) + | _ -> (fullType, types) in - let pluck_label_and_loc (label, loc, type_) = + let innerType, propTypes = getPropTypes [] pval_type in + let namedTypeList = List.fold_left argToConcreteType [] propTypes in + let pluckLabelAndLoc (label, loc, type_) = (label, None, loc, Some type_) in - let ret_props_type = make_props_type ~loc:psig_loc named_type_list in - let external_props_decl = - make_props_external_sig fn_name psig_loc - ((optional "key", None, psig_loc, Some (key_type psig_loc)) - :: List.map pluck_label_and_loc prop_types) - ret_props_type + let retPropsType = makePropsType ~loc:psig_loc namedTypeList in + let externalPropsDecl = + makePropsExternalSig fnName psig_loc + ((optional "key", None, psig_loc, Some (keyType psig_loc)) + :: List.map pluckLabelAndLoc propTypes) + retPropsType in (* can't be an arrow because it will defensively uncurry *) - let new_external_type = + let newExternalType = Ptyp_constr ( {loc = psig_loc; txt = Ldot (Lident "React", "componentLike")}, - [ret_props_type; inner_type] ) + [retPropsType; innerType] ) in - let new_structure = + let newStructure = { psig with psig_desc = Psig_value { psig_desc with - pval_type = {pval_type with ptyp_desc = new_external_type}; - pval_attributes = List.filter other_attrs_pure pval_attributes; + pval_type = {pval_type with ptyp_desc = newExternalType}; + pval_attributes = List.filter otherAttrsPure pval_attributes; }; } in - [external_props_decl; new_structure] + [externalPropsDecl; newStructure] | _ -> - Jsx_common.raise_error ~loc:psig_loc + Jsx_common.raiseError ~loc:psig_loc "Only one react.component call can exist on a component at one time") | _ -> [item] in - let transform_jsx_call mapper call_expression call_arguments attrs = - match call_expression.pexp_desc with + let transformJsxCall mapper callExpression callArguments attrs = + match callExpression.pexp_desc with | Pexp_ident caller -> ( match caller with | {txt = Lident "createElement"; loc} -> - Jsx_common.raise_error ~loc + Jsx_common.raiseError ~loc "JSX: `createElement` should be preceeded by a module name." (* Foo.createElement(~prop1=foo, ~prop2=bar, ~children=[], ()) *) - | {loc; txt = Ldot (module_path, ("createElement" | "make"))} -> ( + | {loc; txt = Ldot (modulePath, ("createElement" | "make"))} -> ( match config.Jsx_common.version with | 3 -> - transform_uppercase_call3 module_path mapper loc attrs call_expression - call_arguments - | _ -> Jsx_common.raise_error ~loc "JSX: the JSX version must be 3") + transformUppercaseCall3 modulePath mapper loc attrs callExpression + callArguments + | _ -> Jsx_common.raiseError ~loc "JSX: the JSX version must be 3") (* div(~prop1=foo, ~prop2=bar, ~children=[bla], ()) *) (* turn that into ReactDOMRe.createElement(~props=ReactDOMRe.props(~props1=foo, ~props2=bar, ()), [|bla|]) *) | {loc; txt = Lident id} -> ( match config.version with - | 3 -> transform_lowercase_call3 mapper loc attrs call_arguments id - | _ -> Jsx_common.raise_error ~loc "JSX: the JSX version must be 3") - | {txt = Ldot (_, anything_not_create_element_or_make); loc} -> - Jsx_common.raise_error ~loc + | 3 -> transformLowercaseCall3 mapper loc attrs callArguments id + | _ -> Jsx_common.raiseError ~loc "JSX: the JSX version must be 3") + | {txt = Ldot (_, anythingNotCreateElementOrMake); loc} -> + Jsx_common.raiseError ~loc "JSX: the JSX attribute should be attached to a \ `YourModuleName.createElement` or `YourModuleName.make` call. We \ saw `%s` instead" - anything_not_create_element_or_make + anythingNotCreateElementOrMake | {txt = Lapply _; loc} -> (* don't think there's ever a case where this is reached *) - Jsx_common.raise_error ~loc + Jsx_common.raiseError ~loc "JSX: encountered a weird case while processing the code. Please \ report this!") | _ -> - Jsx_common.raise_error ~loc:call_expression.pexp_loc + Jsx_common.raiseError ~loc:callExpression.pexp_loc "JSX: `createElement` should be preceeded by a simple, direct module \ name." in @@ -1153,21 +1130,18 @@ let jsx_mapper ~config = let expr mapper expression = match expression with (* Does the function application have the @JSX attribute? *) - | { - pexp_desc = Pexp_apply (call_expression, call_arguments); - pexp_attributes; - } -> ( - let jsx_attribute, non_jsx_attributes = + | {pexp_desc = Pexp_apply (callExpression, callArguments); pexp_attributes} + -> ( + let jsxAttribute, nonJSXAttributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - match (jsx_attribute, non_jsx_attributes) with + match (jsxAttribute, nonJSXAttributes) with (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression - | _, non_jsx_attributes -> - transform_jsx_call mapper call_expression call_arguments - non_jsx_attributes) + | _, nonJSXAttributes -> + transformJsxCall mapper callExpression callArguments nonJSXAttributes) (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) | { pexp_desc = @@ -1175,34 +1149,32 @@ let jsx_mapper ~config = ({txt = Lident "::"; loc}, Some {pexp_desc = Pexp_tuple _}) | Pexp_construct ({txt = Lident "[]"; loc}, None) ); pexp_attributes; - } as list_items -> ( - let jsx_attribute, non_jsx_attributes = + } as listItems -> ( + let jsxAttribute, nonJSXAttributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - match (jsx_attribute, non_jsx_attributes) with + match (jsxAttribute, nonJSXAttributes) with (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression - | _, non_jsx_attributes -> + | _, nonJSXAttributes -> let loc = {loc with loc_ghost = true} in let fragment = Exp.ident ~loc {loc; txt = Ldot (Lident "ReasonReact", "fragment")} in - let children_expr = - transform_children_if_list ~loc ~mapper list_items - in + let childrenExpr = transformChildrenIfList ~loc ~mapper listItems in let args = [ (* "div" *) (nolabel, fragment); (* [|moreCreateElementCallsHere|] *) - (nolabel, children_expr); + (nolabel, childrenExpr); ] in Exp.apply ~loc (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs:non_jsx_attributes + ~attrs:nonJSXAttributes (* ReactDOMRe.createElement *) (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "createElement")}) @@ -1212,13 +1184,13 @@ let jsx_mapper ~config = in let module_binding mapper module_binding = - let _ = nested_modules := module_binding.pmb_name.txt :: !nested_modules in + let _ = nestedModules := module_binding.pmb_name.txt :: !nestedModules in let mapped = default_mapper.module_binding mapper module_binding in let () = - match !nested_modules with - | _ :: rest -> nested_modules := rest + match !nestedModules with + | _ :: rest -> nestedModules := rest | [] -> () in mapped in - (expr, module_binding, transform_signature_item, transform_structure_item) + (expr, module_binding, transformSignatureItem, transformStructureItem) diff --git a/analysis/vendor/res_syntax/res_ast_conversion.ml b/analysis/vendor/res_syntax/res_ast_conversion.ml index 910d7e731..b8c419b80 100644 --- a/analysis/vendor/res_syntax/res_ast_conversion.ml +++ b/analysis/vendor/res_syntax/res_ast_conversion.ml @@ -1,4 +1,4 @@ -let concat_longidents l1 l2 = +let concatLongidents l1 l2 = let parts1 = Longident.flatten l1 in let parts2 = Longident.flatten l2 in match List.concat [parts1; parts2] |> Longident.unflatten with @@ -6,85 +6,78 @@ let concat_longidents l1 l2 = | None -> l2 (* TODO: support nested open's ? *) -let rec rewrite_ppat_open longident_open pat = +let rec rewritePpatOpen longidentOpen pat = match pat.Parsetree.ppat_desc with | Ppat_array (first :: rest) -> (* Color.[Red, Blue, Green] -> [Color.Red, Blue, Green] *) { pat with - ppat_desc = Ppat_array (rewrite_ppat_open longident_open first :: rest); + ppat_desc = Ppat_array (rewritePpatOpen longidentOpen first :: rest); } | Ppat_tuple (first :: rest) -> (* Color.(Red, Blue, Green) -> (Color.Red, Blue, Green) *) { pat with - ppat_desc = Ppat_tuple (rewrite_ppat_open longident_open first :: rest); + ppat_desc = Ppat_tuple (rewritePpatOpen longidentOpen first :: rest); } | Ppat_construct - ( ({txt = Longident.Lident "::"} as list_constructor), + ( ({txt = Longident.Lident "::"} as listConstructor), Some ({ppat_desc = Ppat_tuple (pat :: rest)} as element) ) -> (* Color.(list[Red, Blue, Green]) -> list[Color.Red, Blue, Green] *) { pat with ppat_desc = Ppat_construct - ( list_constructor, + ( listConstructor, Some { element with ppat_desc = - Ppat_tuple (rewrite_ppat_open longident_open pat :: rest); + Ppat_tuple (rewritePpatOpen longidentOpen pat :: rest); } ); } - | Ppat_construct (({txt = constructor} as longident_loc), opt_pattern) -> + | Ppat_construct (({txt = constructor} as longidentLoc), optPattern) -> (* Foo.(Bar(a)) -> Foo.Bar(a) *) { pat with ppat_desc = Ppat_construct - ( { - longident_loc with - txt = concat_longidents longident_open constructor; - }, - opt_pattern ); + ( {longidentLoc with txt = concatLongidents longidentOpen constructor}, + optPattern ); } - | Ppat_record ((({txt = lbl} as longident_loc), first_pat) :: rest, flag) -> + | Ppat_record ((({txt = lbl} as longidentLoc), firstPat) :: rest, flag) -> (* Foo.{x} -> {Foo.x: x} *) - let first_row = - ( {longident_loc with txt = concat_longidents longident_open lbl}, - first_pat ) + let firstRow = + ({longidentLoc with txt = concatLongidents longidentOpen lbl}, firstPat) in - {pat with ppat_desc = Ppat_record (first_row :: rest, flag)} + {pat with ppat_desc = Ppat_record (firstRow :: rest, flag)} | Ppat_or (pat1, pat2) -> { pat with ppat_desc = Ppat_or - ( rewrite_ppat_open longident_open pat1, - rewrite_ppat_open longident_open pat2 ); + ( rewritePpatOpen longidentOpen pat1, + rewritePpatOpen longidentOpen pat2 ); } | Ppat_constraint (pattern, typ) -> { pat with - ppat_desc = Ppat_constraint (rewrite_ppat_open longident_open pattern, typ); + ppat_desc = Ppat_constraint (rewritePpatOpen longidentOpen pattern, typ); } - | Ppat_type ({txt = constructor} as longident_loc) -> + | Ppat_type ({txt = constructor} as longidentLoc) -> { pat with ppat_desc = Ppat_type - { - longident_loc with - txt = concat_longidents longident_open constructor; - }; + {longidentLoc with txt = concatLongidents longidentOpen constructor}; } | Ppat_lazy p -> - {pat with ppat_desc = Ppat_lazy (rewrite_ppat_open longident_open p)} + {pat with ppat_desc = Ppat_lazy (rewritePpatOpen longidentOpen p)} | Ppat_exception p -> - {pat with ppat_desc = Ppat_exception (rewrite_ppat_open longident_open p)} + {pat with ppat_desc = Ppat_exception (rewritePpatOpen longidentOpen p)} | _ -> pat -let escape_template_literal s = +let escapeTemplateLiteral s = let len = String.length s in let b = Buffer.create len in let i = ref 0 in @@ -118,7 +111,7 @@ let escape_template_literal s = done; Buffer.contents b -let escape_string_contents s = +let escapeStringContents s = let len = String.length s in let b = Buffer.create len in @@ -144,65 +137,64 @@ let escape_string_contents s = done; Buffer.contents b -let looks_like_recursive_type_declaration type_declaration = +let looksLikeRecursiveTypeDeclaration typeDeclaration = let open Parsetree in - let name = type_declaration.ptype_name.txt in - let rec check_kind kind = + let name = typeDeclaration.ptype_name.txt in + let rec checkKind kind = match kind with | Ptype_abstract | Ptype_open -> false - | Ptype_variant constructor_declarations -> - List.exists check_constructor_declaration constructor_declarations - | Ptype_record label_declarations -> - List.exists check_label_declaration label_declarations - and check_constructor_declaration constr_decl = - check_constructor_arguments constr_decl.pcd_args + | Ptype_variant constructorDeclarations -> + List.exists checkConstructorDeclaration constructorDeclarations + | Ptype_record labelDeclarations -> + List.exists checkLabelDeclaration labelDeclarations + and checkConstructorDeclaration constrDecl = + checkConstructorArguments constrDecl.pcd_args || - match constr_decl.pcd_res with - | Some typexpr -> check_typ_expr typexpr + match constrDecl.pcd_res with + | Some typexpr -> checkTypExpr typexpr | None -> false - and check_label_declaration label_declaration = - check_typ_expr label_declaration.pld_type - and check_constructor_arguments constr_arg = - match constr_arg with - | Pcstr_tuple types -> List.exists check_typ_expr types - | Pcstr_record label_declarations -> - List.exists check_label_declaration label_declarations - and check_typ_expr typ = + and checkLabelDeclaration labelDeclaration = + checkTypExpr labelDeclaration.pld_type + and checkConstructorArguments constrArg = + match constrArg with + | Pcstr_tuple types -> List.exists checkTypExpr types + | Pcstr_record labelDeclarations -> + List.exists checkLabelDeclaration labelDeclarations + and checkTypExpr typ = match typ.ptyp_desc with | Ptyp_any -> false | Ptyp_var _ -> false - | Ptyp_object (fields, _) -> List.exists check_object_field fields + | Ptyp_object (fields, _) -> List.exists checkObjectField fields | Ptyp_class _ -> false | Ptyp_package _ -> false | Ptyp_extension _ -> false - | Ptyp_arrow (_lbl, typ1, typ2) -> - check_typ_expr typ1 || check_typ_expr typ2 - | Ptyp_tuple types -> List.exists check_typ_expr types + | Ptyp_arrow (_lbl, typ1, typ2) -> checkTypExpr typ1 || checkTypExpr typ2 + | Ptyp_tuple types -> List.exists checkTypExpr types | Ptyp_constr ({txt = longident}, types) -> (match longident with | Lident ident -> ident = name | _ -> false) - || List.exists check_typ_expr types - | Ptyp_alias (typ, _) -> check_typ_expr typ - | Ptyp_variant (row_fields, _, _) -> List.exists check_row_fields row_fields - | Ptyp_poly (_, typ) -> check_typ_expr typ - and check_object_field field = + || List.exists checkTypExpr types + | Ptyp_alias (typ, _) -> checkTypExpr typ + | Ptyp_variant (rowFields, _, _) -> List.exists checkRowFields rowFields + | Ptyp_poly (_, typ) -> checkTypExpr typ + and checkObjectField field = match field with - | Otag (_label, _attrs, typ) -> check_typ_expr typ - | Oinherit typ -> check_typ_expr typ - and check_row_fields row_field = - match row_field with - | Rtag (_, _, _, types) -> List.exists check_typ_expr types - | Rinherit typexpr -> check_typ_expr typexpr - and check_manifest manifest = + | Otag (_label, _attrs, typ) -> checkTypExpr typ + | Oinherit typ -> checkTypExpr typ + and checkRowFields rowField = + match rowField with + | Rtag (_, _, _, types) -> List.exists checkTypExpr types + | Rinherit typexpr -> checkTypExpr typexpr + and checkManifest manifest = match manifest with - | Some typ -> check_typ_expr typ + | Some typ -> checkTypExpr typ | None -> false in - check_kind type_declaration.ptype_kind - || check_manifest type_declaration.ptype_manifest + checkKind typeDeclaration.ptype_kind + || checkManifest typeDeclaration.ptype_manifest -let filter_reason_raw_literal attrs = +let filterReasonRawLiteral attrs = List.filter (fun attr -> match attr with @@ -210,12 +202,12 @@ let filter_reason_raw_literal attrs = | _ -> true) attrs -let string_literal_mapper string_data = - let is_same_location l1 l2 = +let stringLiteralMapper stringData = + let isSameLocation l1 l2 = let open Location in l1.loc_start.pos_cnum == l2.loc_start.pos_cnum in - let remaining_string_data = string_data in + let remainingStringData = stringData in let open Ast_mapper in { default_mapper with @@ -225,12 +217,12 @@ let string_literal_mapper string_data = | Pexp_constant (Pconst_string (_txt, None)) -> ( match List.find_opt - (fun (_stringData, string_loc) -> - is_same_location string_loc expr.pexp_loc) - remaining_string_data + (fun (_stringData, stringLoc) -> + isSameLocation stringLoc expr.pexp_loc) + remainingStringData with - | Some (string_data, _) -> - let string_data = + | Some (stringData, _) -> + let stringData = let attr = List.find_opt (fun attr -> @@ -256,19 +248,19 @@ let string_literal_mapper string_data = ] ) -> raw | _ -> - (String.sub [@doesNotRaise]) string_data 1 - (String.length string_data - 2) + (String.sub [@doesNotRaise]) stringData 1 + (String.length stringData - 2) in { expr with - pexp_attributes = filter_reason_raw_literal expr.pexp_attributes; - pexp_desc = Pexp_constant (Pconst_string (string_data, None)); + pexp_attributes = filterReasonRawLiteral expr.pexp_attributes; + pexp_desc = Pexp_constant (Pconst_string (stringData, None)); } | None -> default_mapper.expr mapper expr) | _ -> default_mapper.expr mapper expr); } -let has_uncurried_attribute attrs = +let hasUncurriedAttribute attrs = List.exists (fun attr -> match attr with @@ -276,12 +268,24 @@ let has_uncurried_attribute attrs = | _ -> false) attrs -let template_literal_attr = (Location.mknoloc "res.template", Parsetree.PStr []) +let templateLiteralAttr = (Location.mknoloc "res.template", Parsetree.PStr []) let normalize = let open Ast_mapper in { default_mapper with + extension = + (fun mapper ext -> + match ext with + | id, payload -> + ( {id with txt = Res_printer.convertBsExtension id.txt}, + default_mapper.payload mapper payload )); + attribute = + (fun mapper attr -> + match attr with + | id, payload -> + ( {id with txt = Res_printer.convertBsExternalAttribute id.txt}, + default_mapper.payload mapper payload )); attributes = (fun mapper attrs -> attrs @@ -299,24 +303,21 @@ let normalize = pat = (fun mapper p -> match p.ppat_desc with - | Ppat_open ({txt = longident_open}, pattern) -> - let p = rewrite_ppat_open longident_open pattern in + | Ppat_open ({txt = longidentOpen}, pattern) -> + let p = rewritePpatOpen longidentOpen pattern in default_mapper.pat mapper p | Ppat_constant (Pconst_string (txt, tag)) -> - let new_tag = + let newTag = match tag with (* transform {|abc|} into {js|abc|js}, because `template string` is interpreted as {js||js} *) | Some "" -> Some "js" | tag -> tag in - let s = - Parsetree.Pconst_string (escape_template_literal txt, new_tag) - in + let s = Parsetree.Pconst_string (escapeTemplateLiteral txt, newTag) in { p with ppat_attributes = - template_literal_attr - :: mapper.attributes mapper p.ppat_attributes; + templateLiteralAttr :: mapper.attributes mapper p.ppat_attributes; ppat_desc = Ppat_constant s; } | _ -> default_mapper.pat mapper p); @@ -333,48 +334,46 @@ let normalize = (fun mapper expr -> match expr.pexp_desc with | Pexp_constant (Pconst_string (txt, None)) -> - let raw = escape_string_contents txt in + let raw = escapeStringContents txt in let s = Parsetree.Pconst_string (raw, None) in {expr with pexp_desc = Pexp_constant s} | Pexp_constant (Pconst_string (txt, tag)) -> - let new_tag = + let newTag = match tag with (* transform {|abc|} into {js|abc|js}, we want to preserve unicode by default *) | Some "" -> Some "js" | tag -> tag in - let s = - Parsetree.Pconst_string (escape_template_literal txt, new_tag) - in + let s = Parsetree.Pconst_string (escapeTemplateLiteral txt, newTag) in { expr with pexp_attributes = - template_literal_attr + templateLiteralAttr :: mapper.attributes mapper expr.pexp_attributes; pexp_desc = Pexp_constant s; } | Pexp_apply - ( call_expr, + ( callExpr, [ ( Nolabel, ({ pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); pexp_attributes = []; - } as unit_expr) ); + } as unitExpr) ); ] ) - when has_uncurried_attribute expr.pexp_attributes -> + when hasUncurriedAttribute expr.pexp_attributes -> { expr with pexp_attributes = mapper.attributes mapper expr.pexp_attributes; pexp_desc = Pexp_apply - ( call_expr, + ( callExpr, [ ( Nolabel, { - unit_expr with - pexp_loc = {unit_expr.pexp_loc with loc_ghost = true}; + unitExpr with + pexp_loc = {unitExpr.pexp_loc with loc_ghost = true}; } ); ] ); } @@ -439,10 +438,10 @@ let normalize = pexp_desc = ( Pexp_constant (Pconst_string (txt, None)) | Pexp_ident {txt = Longident.Lident txt} ); - pexp_loc = label_loc; + pexp_loc = labelLoc; } ); ] ) -> - let label = Location.mkloc txt label_loc in + let label = Location.mkloc txt labelLoc in { pexp_loc = expr.pexp_loc; pexp_attributes = expr.pexp_attributes; @@ -457,7 +456,7 @@ let normalize = ppat_desc = Ppat_construct ({txt = Longident.Lident "true"}, None); }; - pc_rhs = then_expr; + pc_rhs = thenExpr; }; { pc_lhs = @@ -465,10 +464,10 @@ let normalize = ppat_desc = Ppat_construct ({txt = Longident.Lident "false"}, None); }; - pc_rhs = else_expr; + pc_rhs = elseExpr; }; ] ) -> - let ternary_marker = + let ternaryMarker = (Location.mknoloc "res.ternary", Parsetree.PStr []) in { @@ -476,59 +475,57 @@ let normalize = pexp_desc = Pexp_ifthenelse ( mapper.expr mapper condition, - mapper.expr mapper then_expr, - Some (mapper.expr mapper else_expr) ); - pexp_attributes = ternary_marker :: expr.pexp_attributes; + mapper.expr mapper thenExpr, + Some (mapper.expr mapper elseExpr) ); + pexp_attributes = ternaryMarker :: expr.pexp_attributes; } | _ -> default_mapper.expr mapper expr); structure_item = - (fun mapper structure_item -> - match structure_item.pstr_desc with + (fun mapper structureItem -> + match structureItem.pstr_desc with (* heuristic: if we have multiple type declarations, mark them recursive *) - | Pstr_type ((Recursive as rec_flag), type_declarations) -> + | Pstr_type ((Recursive as recFlag), typeDeclarations) -> let flag = - match type_declarations with + match typeDeclarations with | [td] -> - if looks_like_recursive_type_declaration td then - Asttypes.Recursive + if looksLikeRecursiveTypeDeclaration td then Asttypes.Recursive else Asttypes.Nonrecursive - | _ -> rec_flag + | _ -> recFlag in { - structure_item with + structureItem with pstr_desc = Pstr_type ( flag, List.map - (fun type_declaration -> - default_mapper.type_declaration mapper type_declaration) - type_declarations ); + (fun typeDeclaration -> + default_mapper.type_declaration mapper typeDeclaration) + typeDeclarations ); } - | _ -> default_mapper.structure_item mapper structure_item); + | _ -> default_mapper.structure_item mapper structureItem); signature_item = - (fun mapper signature_item -> - match signature_item.psig_desc with + (fun mapper signatureItem -> + match signatureItem.psig_desc with (* heuristic: if we have multiple type declarations, mark them recursive *) - | Psig_type ((Recursive as rec_flag), type_declarations) -> + | Psig_type ((Recursive as recFlag), typeDeclarations) -> let flag = - match type_declarations with + match typeDeclarations with | [td] -> - if looks_like_recursive_type_declaration td then - Asttypes.Recursive + if looksLikeRecursiveTypeDeclaration td then Asttypes.Recursive else Asttypes.Nonrecursive - | _ -> rec_flag + | _ -> recFlag in { - signature_item with + signatureItem with psig_desc = Psig_type ( flag, List.map - (fun type_declaration -> - default_mapper.type_declaration mapper type_declaration) - type_declarations ); + (fun typeDeclaration -> + default_mapper.type_declaration mapper typeDeclaration) + typeDeclarations ); } - | _ -> default_mapper.signature_item mapper signature_item); + | _ -> default_mapper.signature_item mapper signatureItem); value_binding = (fun mapper vb -> match vb with @@ -542,7 +539,7 @@ let normalize = let typ = default_mapper.typ mapper typ in let pat = default_mapper.pat mapper pat in let expr = mapper.expr mapper expr in - let new_pattern = + let newPattern = { Parsetree.ppat_loc = {pat.ppat_loc with loc_end = typ.ptyp_loc.loc_end}; @@ -552,7 +549,7 @@ let normalize = in { vb with - pvb_pat = new_pattern; + pvb_pat = newPattern; pvb_expr = expr; pvb_attributes = default_mapper.attributes mapper vb.pvb_attributes; } @@ -567,7 +564,7 @@ let normalize = let typ = default_mapper.typ mapper typ in let pat = default_mapper.pat mapper pat in let expr = mapper.expr mapper expr in - let new_pattern = + let newPattern = { Parsetree.ppat_loc = {pat.ppat_loc with loc_end = typ.ptyp_loc.loc_end}; @@ -577,7 +574,7 @@ let normalize = in { vb with - pvb_pat = new_pattern; + pvb_pat = newPattern; pvb_expr = expr; pvb_attributes = default_mapper.attributes mapper vb.pvb_attributes; } @@ -587,10 +584,10 @@ let normalize = let structure s = normalize.Ast_mapper.structure normalize s let signature s = normalize.Ast_mapper.signature normalize s -let replace_string_literal_structure string_data structure = - let mapper = string_literal_mapper string_data in +let replaceStringLiteralStructure stringData structure = + let mapper = stringLiteralMapper stringData in mapper.Ast_mapper.structure mapper structure -let replace_string_literal_signature string_data signature = - let mapper = string_literal_mapper string_data in +let replaceStringLiteralSignature stringData signature = + let mapper = stringLiteralMapper stringData in mapper.Ast_mapper.signature mapper signature diff --git a/analysis/vendor/res_syntax/res_ast_conversion.mli b/analysis/vendor/res_syntax/res_ast_conversion.mli index 745b7cc84..32163e8ce 100644 --- a/analysis/vendor/res_syntax/res_ast_conversion.mli +++ b/analysis/vendor/res_syntax/res_ast_conversion.mli @@ -7,9 +7,9 @@ * The purpose of this routine is to place the original string back in * the parsetree for printing purposes. Unicode and escape sequences * shouldn't be mangled when *) -val replace_string_literal_structure : +val replaceStringLiteralStructure : (string * Location.t) list -> Parsetree.structure -> Parsetree.structure -val replace_string_literal_signature : +val replaceStringLiteralSignature : (string * Location.t) list -> Parsetree.signature -> Parsetree.signature (* transform parts of the parsetree into a suitable parsetree suitable diff --git a/analysis/vendor/res_syntax/res_ast_debugger.ml b/analysis/vendor/res_syntax/res_ast_debugger.ml index 569026d62..150ff78e3 100644 --- a/analysis/vendor/res_syntax/res_ast_debugger.ml +++ b/analysis/vendor/res_syntax/res_ast_debugger.ml @@ -1,13 +1,13 @@ module Doc = Res_doc module CommentTable = Res_comments_table -let print_engine = +let printEngine = Res_driver. { - print_implementation = + printImplementation = (fun ~width:_ ~filename:_ ~comments:_ structure -> Printast.implementation Format.std_formatter structure); - print_interface = + printInterface = (fun ~width:_ ~filename:_ ~comments:_ signature -> Printast.interface Format.std_formatter signature); } @@ -17,49 +17,48 @@ module Sexp : sig val atom : string -> t val list : t list -> t - val to_string : t -> string + val toString : t -> string end = struct type t = Atom of string | List of t list let atom s = Atom s let list l = List l - let rec to_doc t = + let rec toDoc t = match t with | Atom s -> Doc.text s | List [] -> Doc.text "()" - | List [sexpr] -> Doc.concat [Doc.lparen; to_doc sexpr; Doc.rparen] + | List [sexpr] -> Doc.concat [Doc.lparen; toDoc sexpr; Doc.rparen] | List (hd :: tail) -> Doc.group (Doc.concat [ Doc.lparen; - to_doc hd; + toDoc hd; Doc.indent (Doc.concat - [Doc.line; Doc.join ~sep:Doc.line (List.map to_doc tail)]); + [Doc.line; Doc.join ~sep:Doc.line (List.map toDoc tail)]); Doc.rparen; ]) - let to_string sexpr = - let doc = to_doc sexpr in - Doc.to_string ~width:80 doc + let toString sexpr = + let doc = toDoc sexpr in + Doc.toString ~width:80 doc end module SexpAst = struct open Parsetree - let map_empty ~f items = + let mapEmpty ~f items = match items with | [] -> [Sexp.list []] | items -> List.map f items - let string txt = - Sexp.atom ("\"" ^ Ext_ident.unwrap_uppercase_exotic txt ^ "\"") + let string txt = Sexp.atom ("\"" ^ txt ^ "\"") let char c = Sexp.atom ("'" ^ Char.escaped c ^ "'") - let opt_char oc = + let optChar oc = match oc with | None -> Sexp.atom "None" | Some c -> Sexp.list [Sexp.atom "Some"; char c] @@ -75,32 +74,32 @@ module SexpAst = struct in Sexp.list [Sexp.atom "longident"; loop l] - let closed_flag flag = + let closedFlag flag = match flag with | Asttypes.Closed -> Sexp.atom "Closed" | Open -> Sexp.atom "Open" - let direction_flag flag = + let directionFlag flag = match flag with | Asttypes.Upto -> Sexp.atom "Upto" | Downto -> Sexp.atom "Downto" - let rec_flag flag = + let recFlag flag = match flag with | Asttypes.Recursive -> Sexp.atom "Recursive" | Nonrecursive -> Sexp.atom "Nonrecursive" - let override_flag flag = + let overrideFlag flag = match flag with | Asttypes.Override -> Sexp.atom "Override" | Fresh -> Sexp.atom "Fresh" - let private_flag flag = + let privateFlag flag = match flag with | Asttypes.Public -> Sexp.atom "Public" | Private -> Sexp.atom "Private" - let mutable_flag flag = + let mutableFlag flag = match flag with | Asttypes.Immutable -> Sexp.atom "Immutable" | Mutable -> Sexp.atom "Mutable" @@ -111,7 +110,7 @@ module SexpAst = struct | Contravariant -> Sexp.atom "Contravariant" | Invariant -> Sexp.atom "Invariant" - let arg_label lbl = + let argLabel lbl = match lbl with | Asttypes.Nolabel -> Sexp.atom "Nolabel" | Labelled txt -> Sexp.list [Sexp.atom "Labelled"; string txt] @@ -121,7 +120,7 @@ module SexpAst = struct let sexpr = match c with | Pconst_integer (txt, tag) -> - Sexp.list [Sexp.atom "Pconst_integer"; string txt; opt_char tag] + Sexp.list [Sexp.atom "Pconst_integer"; string txt; optChar tag] | Pconst_char _ -> Sexp.list [Sexp.atom "Pconst_char"] | Pconst_string (_, Some "INTERNAL_RES_CHAR_CONTENTS") -> Sexp.list [Sexp.atom "Pconst_char"] @@ -135,14 +134,14 @@ module SexpAst = struct | None -> Sexp.atom "None"); ] | Pconst_float (txt, tag) -> - Sexp.list [Sexp.atom "Pconst_float"; string txt; opt_char tag] + Sexp.list [Sexp.atom "Pconst_float"; string txt; optChar tag] in Sexp.list [Sexp.atom "constant"; sexpr] let rec structure s = - Sexp.list (Sexp.atom "structure" :: List.map structure_item s) + Sexp.list (Sexp.atom "structure" :: List.map structureItem s) - and structure_item si = + and structureItem si = let desc = match si.pstr_desc with | Pstr_eval (expr, attrs) -> @@ -151,38 +150,36 @@ module SexpAst = struct Sexp.list [ Sexp.atom "Pstr_value"; - rec_flag flag; - Sexp.list (map_empty ~f:value_binding vbs); + recFlag flag; + Sexp.list (mapEmpty ~f:valueBinding vbs); ] | Pstr_primitive vd -> - Sexp.list [Sexp.atom "Pstr_primitive"; value_description vd] + Sexp.list [Sexp.atom "Pstr_primitive"; valueDescription vd] | Pstr_type (flag, tds) -> Sexp.list [ Sexp.atom "Pstr_type"; - rec_flag flag; - Sexp.list (map_empty ~f:type_declaration tds); + recFlag flag; + Sexp.list (mapEmpty ~f:typeDeclaration tds); ] | Pstr_typext typext -> - Sexp.list [Sexp.atom "Pstr_type"; type_extension typext] + Sexp.list [Sexp.atom "Pstr_type"; typeExtension typext] | Pstr_exception ec -> - Sexp.list [Sexp.atom "Pstr_exception"; extension_constructor ec] - | Pstr_module mb -> Sexp.list [Sexp.atom "Pstr_module"; module_binding mb] + Sexp.list [Sexp.atom "Pstr_exception"; extensionConstructor ec] + | Pstr_module mb -> Sexp.list [Sexp.atom "Pstr_module"; moduleBinding mb] | Pstr_recmodule mbs -> Sexp.list [ - Sexp.atom "Pstr_recmodule"; - Sexp.list (map_empty ~f:module_binding mbs); + Sexp.atom "Pstr_recmodule"; Sexp.list (mapEmpty ~f:moduleBinding mbs); ] - | Pstr_modtype mod_typ_decl -> - Sexp.list - [Sexp.atom "Pstr_modtype"; module_type_declaration mod_typ_decl] - | Pstr_open open_desc -> - Sexp.list [Sexp.atom "Pstr_open"; open_description open_desc] + | Pstr_modtype modTypDecl -> + Sexp.list [Sexp.atom "Pstr_modtype"; moduleTypeDeclaration modTypDecl] + | Pstr_open openDesc -> + Sexp.list [Sexp.atom "Pstr_open"; openDescription openDesc] | Pstr_class _ -> Sexp.atom "Pstr_class" | Pstr_class_type _ -> Sexp.atom "Pstr_class_type" | Pstr_include id -> - Sexp.list [Sexp.atom "Pstr_include"; include_declaration id] + Sexp.list [Sexp.atom "Pstr_include"; includeDeclaration id] | Pstr_attribute attr -> Sexp.list [Sexp.atom "Pstr_attribute"; attribute attr] | Pstr_extension (ext, attrs) -> @@ -190,15 +187,15 @@ module SexpAst = struct in Sexp.list [Sexp.atom "structure_item"; desc] - and include_declaration id = + and includeDeclaration id = Sexp.list [ Sexp.atom "include_declaration"; - module_expression id.pincl_mod; + moduleExpression id.pincl_mod; attributes id.pincl_attributes; ] - and open_description od = + and openDescription od = Sexp.list [ Sexp.atom "open_description"; @@ -206,56 +203,55 @@ module SexpAst = struct attributes od.popen_attributes; ] - and module_type_declaration mtd = + and moduleTypeDeclaration mtd = Sexp.list [ Sexp.atom "module_type_declaration"; string mtd.pmtd_name.Asttypes.txt; (match mtd.pmtd_type with | None -> Sexp.atom "None" - | Some mod_type -> Sexp.list [Sexp.atom "Some"; module_type mod_type]); + | Some modType -> Sexp.list [Sexp.atom "Some"; moduleType modType]); attributes mtd.pmtd_attributes; ] - and module_binding mb = + and moduleBinding mb = Sexp.list [ Sexp.atom "module_binding"; string mb.pmb_name.Asttypes.txt; - module_expression mb.pmb_expr; + moduleExpression mb.pmb_expr; attributes mb.pmb_attributes; ] - and module_expression me = + and moduleExpression me = let desc = match me.pmod_desc with - | Pmod_ident mod_name -> - Sexp.list [Sexp.atom "Pmod_ident"; longident mod_name.Asttypes.txt] + | Pmod_ident modName -> + Sexp.list [Sexp.atom "Pmod_ident"; longident modName.Asttypes.txt] | Pmod_structure s -> Sexp.list [Sexp.atom "Pmod_structure"; structure s] - | Pmod_functor (lbl, opt_mod_type, mod_expr) -> + | Pmod_functor (lbl, optModType, modExpr) -> Sexp.list [ Sexp.atom "Pmod_functor"; string lbl.Asttypes.txt; - (match opt_mod_type with + (match optModType with | None -> Sexp.atom "None" - | Some mod_type -> - Sexp.list [Sexp.atom "Some"; module_type mod_type]); - module_expression mod_expr; + | Some modType -> Sexp.list [Sexp.atom "Some"; moduleType modType]); + moduleExpression modExpr; ] - | Pmod_apply (call_mod_expr, mod_expr_arg) -> + | Pmod_apply (callModExpr, modExprArg) -> Sexp.list [ Sexp.atom "Pmod_apply"; - module_expression call_mod_expr; - module_expression mod_expr_arg; + moduleExpression callModExpr; + moduleExpression modExprArg; ] - | Pmod_constraint (mod_expr, mod_type) -> + | Pmod_constraint (modExpr, modType) -> Sexp.list [ Sexp.atom "Pmod_constraint"; - module_expression mod_expr; - module_type mod_type; + moduleExpression modExpr; + moduleType modType; ] | Pmod_unpack expr -> Sexp.list [Sexp.atom "Pmod_unpack"; expression expr] | Pmod_extension ext -> @@ -263,47 +259,46 @@ module SexpAst = struct in Sexp.list [Sexp.atom "module_expr"; desc; attributes me.pmod_attributes] - and module_type mt = + and moduleType mt = let desc = match mt.pmty_desc with - | Pmty_ident longident_loc -> - Sexp.list [Sexp.atom "Pmty_ident"; longident longident_loc.Asttypes.txt] + | Pmty_ident longidentLoc -> + Sexp.list [Sexp.atom "Pmty_ident"; longident longidentLoc.Asttypes.txt] | Pmty_signature s -> Sexp.list [Sexp.atom "Pmty_signature"; signature s] - | Pmty_functor (lbl, opt_mod_type, mod_type) -> + | Pmty_functor (lbl, optModType, modType) -> Sexp.list [ Sexp.atom "Pmty_functor"; string lbl.Asttypes.txt; - (match opt_mod_type with + (match optModType with | None -> Sexp.atom "None" - | Some mod_type -> - Sexp.list [Sexp.atom "Some"; module_type mod_type]); - module_type mod_type; + | Some modType -> Sexp.list [Sexp.atom "Some"; moduleType modType]); + moduleType modType; ] - | Pmty_alias longident_loc -> - Sexp.list [Sexp.atom "Pmty_alias"; longident longident_loc.Asttypes.txt] + | Pmty_alias longidentLoc -> + Sexp.list [Sexp.atom "Pmty_alias"; longident longidentLoc.Asttypes.txt] | Pmty_extension ext -> Sexp.list [Sexp.atom "Pmty_extension"; extension ext] - | Pmty_typeof mod_expr -> - Sexp.list [Sexp.atom "Pmty_typeof"; module_expression mod_expr] - | Pmty_with (mod_type, with_constraints) -> + | Pmty_typeof modExpr -> + Sexp.list [Sexp.atom "Pmty_typeof"; moduleExpression modExpr] + | Pmty_with (modType, withConstraints) -> Sexp.list [ Sexp.atom "Pmty_with"; - module_type mod_type; - Sexp.list (map_empty ~f:with_constraint with_constraints); + moduleType modType; + Sexp.list (mapEmpty ~f:withConstraint withConstraints); ] in Sexp.list [Sexp.atom "module_type"; desc; attributes mt.pmty_attributes] - and with_constraint wc = + and withConstraint wc = match wc with - | Pwith_type (longident_loc, td) -> + | Pwith_type (longidentLoc, td) -> Sexp.list [ Sexp.atom "Pmty_with"; - longident longident_loc.Asttypes.txt; - type_declaration td; + longident longidentLoc.Asttypes.txt; + typeDeclaration td; ] | Pwith_module (l1, l2) -> Sexp.list @@ -312,12 +307,12 @@ module SexpAst = struct longident l1.Asttypes.txt; longident l2.Asttypes.txt; ] - | Pwith_typesubst (longident_loc, td) -> + | Pwith_typesubst (longidentLoc, td) -> Sexp.list [ Sexp.atom "Pwith_typesubst"; - longident longident_loc.Asttypes.txt; - type_declaration td; + longident longidentLoc.Asttypes.txt; + typeDeclaration td; ] | Pwith_modsubst (l1, l2) -> Sexp.list @@ -327,40 +322,37 @@ module SexpAst = struct longident l2.Asttypes.txt; ] - and signature s = - Sexp.list (Sexp.atom "signature" :: List.map signature_item s) + and signature s = Sexp.list (Sexp.atom "signature" :: List.map signatureItem s) - and signature_item si = + and signatureItem si = let descr = match si.psig_desc with - | Psig_value vd -> - Sexp.list [Sexp.atom "Psig_value"; value_description vd] - | Psig_type (flag, type_declarations) -> + | Psig_value vd -> Sexp.list [Sexp.atom "Psig_value"; valueDescription vd] + | Psig_type (flag, typeDeclarations) -> Sexp.list [ Sexp.atom "Psig_type"; - rec_flag flag; - Sexp.list (map_empty ~f:type_declaration type_declarations); + recFlag flag; + Sexp.list (mapEmpty ~f:typeDeclaration typeDeclarations); ] - | Psig_typext typ_ext -> - Sexp.list [Sexp.atom "Psig_typext"; type_extension typ_ext] - | Psig_exception ext_constr -> - Sexp.list [Sexp.atom "Psig_exception"; extension_constructor ext_constr] - | Psig_module mod_decl -> - Sexp.list [Sexp.atom "Psig_module"; module_declaration mod_decl] - | Psig_recmodule mod_decls -> + | Psig_typext typExt -> + Sexp.list [Sexp.atom "Psig_typext"; typeExtension typExt] + | Psig_exception extConstr -> + Sexp.list [Sexp.atom "Psig_exception"; extensionConstructor extConstr] + | Psig_module modDecl -> + Sexp.list [Sexp.atom "Psig_module"; moduleDeclaration modDecl] + | Psig_recmodule modDecls -> Sexp.list [ Sexp.atom "Psig_recmodule"; - Sexp.list (map_empty ~f:module_declaration mod_decls); - ] - | Psig_modtype mod_typ_decl -> - Sexp.list - [Sexp.atom "Psig_modtype"; module_type_declaration mod_typ_decl] - | Psig_open open_desc -> - Sexp.list [Sexp.atom "Psig_open"; open_description open_desc] - | Psig_include incl_decl -> - Sexp.list [Sexp.atom "Psig_include"; include_description incl_decl] + Sexp.list (mapEmpty ~f:moduleDeclaration modDecls); + ] + | Psig_modtype modTypDecl -> + Sexp.list [Sexp.atom "Psig_modtype"; moduleTypeDeclaration modTypDecl] + | Psig_open openDesc -> + Sexp.list [Sexp.atom "Psig_open"; openDescription openDesc] + | Psig_include inclDecl -> + Sexp.list [Sexp.atom "Psig_include"; includeDescription inclDecl] | Psig_class _ -> Sexp.list [Sexp.atom "Psig_class"] | Psig_class_type _ -> Sexp.list [Sexp.atom "Psig_class_type"] | Psig_attribute attr -> @@ -370,24 +362,24 @@ module SexpAst = struct in Sexp.list [Sexp.atom "signature_item"; descr] - and include_description id = + and includeDescription id = Sexp.list [ Sexp.atom "include_description"; - module_type id.pincl_mod; + moduleType id.pincl_mod; attributes id.pincl_attributes; ] - and module_declaration md = + and moduleDeclaration md = Sexp.list [ Sexp.atom "module_declaration"; string md.pmd_name.Asttypes.txt; - module_type md.pmd_type; + moduleType md.pmd_type; attributes md.pmd_attributes; ] - and value_binding vb = + and valueBinding vb = Sexp.list [ Sexp.atom "value_binding"; @@ -396,17 +388,17 @@ module SexpAst = struct attributes vb.pvb_attributes; ] - and value_description vd = + and valueDescription vd = Sexp.list [ Sexp.atom "value_description"; string vd.pval_name.Asttypes.txt; - core_type vd.pval_type; - Sexp.list (map_empty ~f:string vd.pval_prim); + coreType vd.pval_type; + Sexp.list (mapEmpty ~f:string vd.pval_prim); attributes vd.pval_attributes; ] - and type_declaration td = + and typeDeclaration td = Sexp.list [ Sexp.atom "type_declaration"; @@ -415,56 +407,56 @@ module SexpAst = struct [ Sexp.atom "ptype_params"; Sexp.list - (map_empty + (mapEmpty ~f:(fun (typexpr, var) -> - Sexp.list [core_type typexpr; variance var]) + Sexp.list [coreType typexpr; variance var]) td.ptype_params); ]; Sexp.list [ Sexp.atom "ptype_cstrs"; Sexp.list - (map_empty + (mapEmpty ~f:(fun (typ1, typ2, _loc) -> - Sexp.list [core_type typ1; core_type typ2]) + Sexp.list [coreType typ1; coreType typ2]) td.ptype_cstrs); ]; - Sexp.list [Sexp.atom "ptype_kind"; type_kind td.ptype_kind]; + Sexp.list [Sexp.atom "ptype_kind"; typeKind td.ptype_kind]; Sexp.list [ Sexp.atom "ptype_manifest"; (match td.ptype_manifest with | None -> Sexp.atom "None" - | Some typ -> Sexp.list [Sexp.atom "Some"; core_type typ]); + | Some typ -> Sexp.list [Sexp.atom "Some"; coreType typ]); ]; - Sexp.list [Sexp.atom "ptype_private"; private_flag td.ptype_private]; + Sexp.list [Sexp.atom "ptype_private"; privateFlag td.ptype_private]; attributes td.ptype_attributes; ] - and extension_constructor ec = + and extensionConstructor ec = Sexp.list [ Sexp.atom "extension_constructor"; string ec.pext_name.Asttypes.txt; - extension_constructor_kind ec.pext_kind; + extensionConstructorKind ec.pext_kind; attributes ec.pext_attributes; ] - and extension_constructor_kind kind = + and extensionConstructorKind kind = match kind with - | Pext_decl (args, opt_typ_expr) -> + | Pext_decl (args, optTypExpr) -> Sexp.list [ Sexp.atom "Pext_decl"; - constructor_arguments args; - (match opt_typ_expr with + constructorArguments args; + (match optTypExpr with | None -> Sexp.atom "None" - | Some typ -> Sexp.list [Sexp.atom "Some"; core_type typ]); + | Some typ -> Sexp.list [Sexp.atom "Some"; coreType typ]); ] - | Pext_rebind longident_loc -> - Sexp.list [Sexp.atom "Pext_rebind"; longident longident_loc.Asttypes.txt] + | Pext_rebind longidentLoc -> + Sexp.list [Sexp.atom "Pext_rebind"; longident longidentLoc.Asttypes.txt] - and type_extension te = + and typeExtension te = Sexp.list [ Sexp.atom "type_extension"; @@ -474,99 +466,95 @@ module SexpAst = struct [ Sexp.atom "ptyext_parms"; Sexp.list - (map_empty + (mapEmpty ~f:(fun (typexpr, var) -> - Sexp.list [core_type typexpr; variance var]) + Sexp.list [coreType typexpr; variance var]) te.ptyext_params); ]; Sexp.list [ Sexp.atom "ptyext_constructors"; - Sexp.list - (map_empty ~f:extension_constructor te.ptyext_constructors); + Sexp.list (mapEmpty ~f:extensionConstructor te.ptyext_constructors); ]; - Sexp.list [Sexp.atom "ptyext_private"; private_flag te.ptyext_private]; + Sexp.list [Sexp.atom "ptyext_private"; privateFlag te.ptyext_private]; attributes te.ptyext_attributes; ] - and type_kind kind = + and typeKind kind = match kind with | Ptype_abstract -> Sexp.atom "Ptype_abstract" - | Ptype_variant constr_decls -> + | Ptype_variant constrDecls -> Sexp.list [ Sexp.atom "Ptype_variant"; - Sexp.list (map_empty ~f:constructor_declaration constr_decls); + Sexp.list (mapEmpty ~f:constructorDeclaration constrDecls); ] - | Ptype_record lbl_decls -> + | Ptype_record lblDecls -> Sexp.list [ Sexp.atom "Ptype_record"; - Sexp.list (map_empty ~f:label_declaration lbl_decls); + Sexp.list (mapEmpty ~f:labelDeclaration lblDecls); ] | Ptype_open -> Sexp.atom "Ptype_open" - and constructor_declaration cd = + and constructorDeclaration cd = Sexp.list [ Sexp.atom "constructor_declaration"; string cd.pcd_name.Asttypes.txt; - Sexp.list [Sexp.atom "pcd_args"; constructor_arguments cd.pcd_args]; + Sexp.list [Sexp.atom "pcd_args"; constructorArguments cd.pcd_args]; Sexp.list [ Sexp.atom "pcd_res"; (match cd.pcd_res with | None -> Sexp.atom "None" - | Some typ -> Sexp.list [Sexp.atom "Some"; core_type typ]); + | Some typ -> Sexp.list [Sexp.atom "Some"; coreType typ]); ]; attributes cd.pcd_attributes; ] - and constructor_arguments args = + and constructorArguments args = match args with | Pcstr_tuple types -> Sexp.list - [Sexp.atom "Pcstr_tuple"; Sexp.list (map_empty ~f:core_type types)] + [Sexp.atom "Pcstr_tuple"; Sexp.list (mapEmpty ~f:coreType types)] | Pcstr_record lds -> Sexp.list - [ - Sexp.atom "Pcstr_record"; - Sexp.list (map_empty ~f:label_declaration lds); - ] + [Sexp.atom "Pcstr_record"; Sexp.list (mapEmpty ~f:labelDeclaration lds)] - and label_declaration ld = + and labelDeclaration ld = Sexp.list [ Sexp.atom "label_declaration"; string ld.pld_name.Asttypes.txt; - mutable_flag ld.pld_mutable; - core_type ld.pld_type; + mutableFlag ld.pld_mutable; + coreType ld.pld_type; attributes ld.pld_attributes; ] and expression expr = let desc = match expr.pexp_desc with - | Pexp_ident longident_loc -> - Sexp.list [Sexp.atom "Pexp_ident"; longident longident_loc.Asttypes.txt] + | Pexp_ident longidentLoc -> + Sexp.list [Sexp.atom "Pexp_ident"; longident longidentLoc.Asttypes.txt] | Pexp_constant c -> Sexp.list [Sexp.atom "Pexp_constant"; constant c] | Pexp_let (flag, vbs, expr) -> Sexp.list [ Sexp.atom "Pexp_let"; - rec_flag flag; - Sexp.list (map_empty ~f:value_binding vbs); + recFlag flag; + Sexp.list (mapEmpty ~f:valueBinding vbs); expression expr; ] | Pexp_function cases -> Sexp.list - [Sexp.atom "Pexp_function"; Sexp.list (map_empty ~f:case cases)] - | Pexp_fun (arg_lbl, expr_opt, pat, expr) -> + [Sexp.atom "Pexp_function"; Sexp.list (mapEmpty ~f:case cases)] + | Pexp_fun (argLbl, exprOpt, pat, expr) -> Sexp.list [ Sexp.atom "Pexp_fun"; - arg_label arg_lbl; - (match expr_opt with + argLabel argLbl; + (match exprOpt with | None -> Sexp.atom "None" | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]); pattern pat; @@ -578,9 +566,9 @@ module SexpAst = struct Sexp.atom "Pexp_apply"; expression expr; Sexp.list - (map_empty - ~f:(fun (arg_lbl, expr) -> - Sexp.list [arg_label arg_lbl; expression expr]) + (mapEmpty + ~f:(fun (argLbl, expr) -> + Sexp.list [argLabel argLbl; expression expr]) args); ] | Pexp_match (expr, cases) -> @@ -588,75 +576,75 @@ module SexpAst = struct [ Sexp.atom "Pexp_match"; expression expr; - Sexp.list (map_empty ~f:case cases); + Sexp.list (mapEmpty ~f:case cases); ] | Pexp_try (expr, cases) -> Sexp.list [ Sexp.atom "Pexp_try"; expression expr; - Sexp.list (map_empty ~f:case cases); + Sexp.list (mapEmpty ~f:case cases); ] | Pexp_tuple exprs -> Sexp.list - [Sexp.atom "Pexp_tuple"; Sexp.list (map_empty ~f:expression exprs)] - | Pexp_construct (longident_loc, expr_opt) -> + [Sexp.atom "Pexp_tuple"; Sexp.list (mapEmpty ~f:expression exprs)] + | Pexp_construct (longidentLoc, exprOpt) -> Sexp.list [ Sexp.atom "Pexp_construct"; - longident longident_loc.Asttypes.txt; - (match expr_opt with + longident longidentLoc.Asttypes.txt; + (match exprOpt with | None -> Sexp.atom "None" | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]); ] - | Pexp_variant (lbl, expr_opt) -> + | Pexp_variant (lbl, exprOpt) -> Sexp.list [ Sexp.atom "Pexp_variant"; string lbl; - (match expr_opt with + (match exprOpt with | None -> Sexp.atom "None" | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]); ] - | Pexp_record (rows, opt_expr) -> + | Pexp_record (rows, optExpr) -> Sexp.list [ Sexp.atom "Pexp_record"; Sexp.list - (map_empty - ~f:(fun (longident_loc, expr) -> + (mapEmpty + ~f:(fun (longidentLoc, expr) -> Sexp.list - [longident longident_loc.Asttypes.txt; expression expr]) + [longident longidentLoc.Asttypes.txt; expression expr]) rows); - (match opt_expr with + (match optExpr with | None -> Sexp.atom "None" | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]); ] - | Pexp_field (expr, longident_loc) -> + | Pexp_field (expr, longidentLoc) -> Sexp.list [ Sexp.atom "Pexp_field"; expression expr; - longident longident_loc.Asttypes.txt; + longident longidentLoc.Asttypes.txt; ] - | Pexp_setfield (expr1, longident_loc, expr2) -> + | Pexp_setfield (expr1, longidentLoc, expr2) -> Sexp.list [ Sexp.atom "Pexp_setfield"; expression expr1; - longident longident_loc.Asttypes.txt; + longident longidentLoc.Asttypes.txt; expression expr2; ] | Pexp_array exprs -> Sexp.list - [Sexp.atom "Pexp_array"; Sexp.list (map_empty ~f:expression exprs)] - | Pexp_ifthenelse (expr1, expr2, opt_expr) -> + [Sexp.atom "Pexp_array"; Sexp.list (mapEmpty ~f:expression exprs)] + | Pexp_ifthenelse (expr1, expr2, optExpr) -> Sexp.list [ Sexp.atom "Pexp_ifthenelse"; expression expr1; expression expr2; - (match opt_expr with + (match optExpr with | None -> Sexp.atom "None" | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]); ] @@ -672,39 +660,39 @@ module SexpAst = struct pattern pat; expression e1; expression e2; - direction_flag flag; + directionFlag flag; expression e3; ] | Pexp_constraint (expr, typexpr) -> Sexp.list - [Sexp.atom "Pexp_constraint"; expression expr; core_type typexpr] - | Pexp_coerce (expr, opt_typ, typexpr) -> + [Sexp.atom "Pexp_constraint"; expression expr; coreType typexpr] + | Pexp_coerce (expr, optTyp, typexpr) -> Sexp.list [ Sexp.atom "Pexp_coerce"; expression expr; - (match opt_typ with + (match optTyp with | None -> Sexp.atom "None" - | Some typ -> Sexp.list [Sexp.atom "Some"; core_type typ]); - core_type typexpr; + | Some typ -> Sexp.list [Sexp.atom "Some"; coreType typ]); + coreType typexpr; ] | Pexp_send _ -> Sexp.list [Sexp.atom "Pexp_send"] | Pexp_new _ -> Sexp.list [Sexp.atom "Pexp_new"] | Pexp_setinstvar _ -> Sexp.list [Sexp.atom "Pexp_setinstvar"] | Pexp_override _ -> Sexp.list [Sexp.atom "Pexp_override"] - | Pexp_letmodule (mod_name, mod_expr, expr) -> + | Pexp_letmodule (modName, modExpr, expr) -> Sexp.list [ Sexp.atom "Pexp_letmodule"; - string mod_name.Asttypes.txt; - module_expression mod_expr; + string modName.Asttypes.txt; + moduleExpression modExpr; expression expr; ] - | Pexp_letexception (ext_constr, expr) -> + | Pexp_letexception (extConstr, expr) -> Sexp.list [ Sexp.atom "Pexp_letexception"; - extension_constructor ext_constr; + extensionConstructor extConstr; expression expr; ] | Pexp_assert expr -> Sexp.list [Sexp.atom "Pexp_assert"; expression expr] @@ -714,14 +702,14 @@ module SexpAst = struct | Pexp_newtype (lbl, expr) -> Sexp.list [Sexp.atom "Pexp_newtype"; string lbl.Asttypes.txt; expression expr] - | Pexp_pack mod_expr -> - Sexp.list [Sexp.atom "Pexp_pack"; module_expression mod_expr] - | Pexp_open (flag, longident_loc, expr) -> + | Pexp_pack modExpr -> + Sexp.list [Sexp.atom "Pexp_pack"; moduleExpression modExpr] + | Pexp_open (flag, longidentLoc, expr) -> Sexp.list [ Sexp.atom "Pexp_open"; - override_flag flag; - longident longident_loc.Asttypes.txt; + overrideFlag flag; + longident longidentLoc.Asttypes.txt; expression expr; ] | Pexp_extension ext -> @@ -758,22 +746,22 @@ module SexpAst = struct Sexp.list [Sexp.atom "Ppat_interval"; constant lo; constant hi] | Ppat_tuple patterns -> Sexp.list - [Sexp.atom "Ppat_tuple"; Sexp.list (map_empty ~f:pattern patterns)] - | Ppat_construct (longident_loc, opt_pattern) -> + [Sexp.atom "Ppat_tuple"; Sexp.list (mapEmpty ~f:pattern patterns)] + | Ppat_construct (longidentLoc, optPattern) -> Sexp.list [ Sexp.atom "Ppat_construct"; - longident longident_loc.Location.txt; - (match opt_pattern with + longident longidentLoc.Location.txt; + (match optPattern with | None -> Sexp.atom "None" | Some p -> Sexp.list [Sexp.atom "some"; pattern p]); ] - | Ppat_variant (lbl, opt_pattern) -> + | Ppat_variant (lbl, optPattern) -> Sexp.list [ Sexp.atom "Ppat_variant"; string lbl; - (match opt_pattern with + (match optPattern with | None -> Sexp.atom "None" | Some p -> Sexp.list [Sexp.atom "Some"; pattern p]); ] @@ -781,134 +769,125 @@ module SexpAst = struct Sexp.list [ Sexp.atom "Ppat_record"; - closed_flag flag; + closedFlag flag; Sexp.list - (map_empty - ~f:(fun (longident_loc, p) -> - Sexp.list [longident longident_loc.Location.txt; pattern p]) + (mapEmpty + ~f:(fun (longidentLoc, p) -> + Sexp.list [longident longidentLoc.Location.txt; pattern p]) rows); ] | Ppat_array patterns -> Sexp.list - [Sexp.atom "Ppat_array"; Sexp.list (map_empty ~f:pattern patterns)] + [Sexp.atom "Ppat_array"; Sexp.list (mapEmpty ~f:pattern patterns)] | Ppat_or (p1, p2) -> Sexp.list [Sexp.atom "Ppat_or"; pattern p1; pattern p2] | Ppat_constraint (p, typexpr) -> - Sexp.list [Sexp.atom "Ppat_constraint"; pattern p; core_type typexpr] - | Ppat_type longident_loc -> - Sexp.list [Sexp.atom "Ppat_type"; longident longident_loc.Location.txt] + Sexp.list [Sexp.atom "Ppat_constraint"; pattern p; coreType typexpr] + | Ppat_type longidentLoc -> + Sexp.list [Sexp.atom "Ppat_type"; longident longidentLoc.Location.txt] | Ppat_lazy p -> Sexp.list [Sexp.atom "Ppat_lazy"; pattern p] - | Ppat_unpack string_loc -> - Sexp.list [Sexp.atom "Ppat_unpack"; string string_loc.Location.txt] + | Ppat_unpack stringLoc -> + Sexp.list [Sexp.atom "Ppat_unpack"; string stringLoc.Location.txt] | Ppat_exception p -> Sexp.list [Sexp.atom "Ppat_exception"; pattern p] | Ppat_extension ext -> Sexp.list [Sexp.atom "Ppat_extension"; extension ext] - | Ppat_open (longident_loc, p) -> + | Ppat_open (longidentLoc, p) -> Sexp.list [ - Sexp.atom "Ppat_open"; - longident longident_loc.Location.txt; - pattern p; + Sexp.atom "Ppat_open"; longident longidentLoc.Location.txt; pattern p; ] in Sexp.list [Sexp.atom "pattern"; descr] - and object_field field = + and objectField field = match field with - | Otag (lbl_loc, attrs, typexpr) -> + | Otag (lblLoc, attrs, typexpr) -> Sexp.list [ - Sexp.atom "Otag"; - string lbl_loc.txt; - attributes attrs; - core_type typexpr; + Sexp.atom "Otag"; string lblLoc.txt; attributes attrs; coreType typexpr; ] - | Oinherit typexpr -> Sexp.list [Sexp.atom "Oinherit"; core_type typexpr] + | Oinherit typexpr -> Sexp.list [Sexp.atom "Oinherit"; coreType typexpr] - and row_field field = + and rowField field = match field with - | Rtag (label_loc, attrs, truth, types) -> + | Rtag (labelLoc, attrs, truth, types) -> Sexp.list [ Sexp.atom "Rtag"; - string label_loc.txt; + string labelLoc.txt; attributes attrs; Sexp.atom (if truth then "true" else "false"); - Sexp.list (map_empty ~f:core_type types); + Sexp.list (mapEmpty ~f:coreType types); ] - | Rinherit typexpr -> Sexp.list [Sexp.atom "Rinherit"; core_type typexpr] + | Rinherit typexpr -> Sexp.list [Sexp.atom "Rinherit"; coreType typexpr] - and package_type (mod_name_loc, package_constraints) = + and packageType (modNameLoc, packageConstraints) = Sexp.list [ Sexp.atom "package_type"; - longident mod_name_loc.Asttypes.txt; + longident modNameLoc.Asttypes.txt; Sexp.list - (map_empty - ~f:(fun (mod_name_loc, typexpr) -> - Sexp.list - [longident mod_name_loc.Asttypes.txt; core_type typexpr]) - package_constraints); + (mapEmpty + ~f:(fun (modNameLoc, typexpr) -> + Sexp.list [longident modNameLoc.Asttypes.txt; coreType typexpr]) + packageConstraints); ] - and core_type typexpr = + and coreType typexpr = let desc = match typexpr.ptyp_desc with | Ptyp_any -> Sexp.atom "Ptyp_any" | Ptyp_var var -> Sexp.list [Sexp.atom "Ptyp_var"; string var] - | Ptyp_arrow (arg_lbl, typ1, typ2) -> + | Ptyp_arrow (argLbl, typ1, typ2) -> Sexp.list [ - Sexp.atom "Ptyp_arrow"; - arg_label arg_lbl; - core_type typ1; - core_type typ2; + Sexp.atom "Ptyp_arrow"; argLabel argLbl; coreType typ1; coreType typ2; ] | Ptyp_tuple types -> Sexp.list - [Sexp.atom "Ptyp_tuple"; Sexp.list (map_empty ~f:core_type types)] - | Ptyp_constr (longident_loc, types) -> + [Sexp.atom "Ptyp_tuple"; Sexp.list (mapEmpty ~f:coreType types)] + | Ptyp_constr (longidentLoc, types) -> Sexp.list [ Sexp.atom "Ptyp_constr"; - longident longident_loc.txt; - Sexp.list (map_empty ~f:core_type types); + longident longidentLoc.txt; + Sexp.list (mapEmpty ~f:coreType types); ] | Ptyp_alias (typexpr, alias) -> - Sexp.list [Sexp.atom "Ptyp_alias"; core_type typexpr; string alias] + Sexp.list [Sexp.atom "Ptyp_alias"; coreType typexpr; string alias] | Ptyp_object (fields, flag) -> Sexp.list [ Sexp.atom "Ptyp_object"; - closed_flag flag; - Sexp.list (map_empty ~f:object_field fields); + closedFlag flag; + Sexp.list (mapEmpty ~f:objectField fields); ] - | Ptyp_class (longident_loc, types) -> + | Ptyp_class (longidentLoc, types) -> Sexp.list [ Sexp.atom "Ptyp_class"; - longident longident_loc.Location.txt; - Sexp.list (map_empty ~f:core_type types); + longident longidentLoc.Location.txt; + Sexp.list (mapEmpty ~f:coreType types); ] - | Ptyp_variant (fields, flag, opt_labels) -> + | Ptyp_variant (fields, flag, optLabels) -> Sexp.list [ Sexp.atom "Ptyp_variant"; - Sexp.list (map_empty ~f:row_field fields); - closed_flag flag; - (match opt_labels with + Sexp.list (mapEmpty ~f:rowField fields); + closedFlag flag; + (match optLabels with | None -> Sexp.atom "None" - | Some lbls -> Sexp.list (map_empty ~f:string lbls)); + | Some lbls -> Sexp.list (mapEmpty ~f:string lbls)); ] | Ptyp_poly (lbls, typexpr) -> Sexp.list [ Sexp.atom "Ptyp_poly"; - Sexp.list (map_empty ~f:(fun lbl -> string lbl.Asttypes.txt) lbls); - core_type typexpr; + Sexp.list (mapEmpty ~f:(fun lbl -> string lbl.Asttypes.txt) lbls); + coreType typexpr; ] | Ptyp_package package -> - Sexp.list [Sexp.atom "Ptyp_package"; package_type package] + Sexp.list [Sexp.atom "Ptyp_package"; packageType package] | Ptyp_extension ext -> Sexp.list [Sexp.atom "Ptyp_extension"; extension ext] in @@ -916,55 +895,55 @@ module SexpAst = struct and payload p = match p with - | PStr s -> Sexp.list (Sexp.atom "PStr" :: map_empty ~f:structure_item s) + | PStr s -> Sexp.list (Sexp.atom "PStr" :: mapEmpty ~f:structureItem s) | PSig s -> Sexp.list [Sexp.atom "PSig"; signature s] - | PTyp ct -> Sexp.list [Sexp.atom "PTyp"; core_type ct] - | PPat (pat, opt_expr) -> + | PTyp ct -> Sexp.list [Sexp.atom "PTyp"; coreType ct] + | PPat (pat, optExpr) -> Sexp.list [ Sexp.atom "PPat"; pattern pat; - (match opt_expr with + (match optExpr with | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr] | None -> Sexp.atom "None"); ] - and attribute (string_loc, p) = + and attribute (stringLoc, p) = Sexp.list - [Sexp.atom "attribute"; Sexp.atom string_loc.Asttypes.txt; payload p] + [Sexp.atom "attribute"; Sexp.atom stringLoc.Asttypes.txt; payload p] - and extension (string_loc, p) = + and extension (stringLoc, p) = Sexp.list - [Sexp.atom "extension"; Sexp.atom string_loc.Asttypes.txt; payload p] + [Sexp.atom "extension"; Sexp.atom stringLoc.Asttypes.txt; payload p] and attributes attrs = - let sexprs = map_empty ~f:attribute attrs in + let sexprs = mapEmpty ~f:attribute attrs in Sexp.list (Sexp.atom "attributes" :: sexprs) - let print_engine = + let printEngine = Res_driver. { - print_implementation = + printImplementation = (fun ~width:_ ~filename:_ ~comments:_ parsetree -> - parsetree |> structure |> Sexp.to_string |> print_string); - print_interface = + parsetree |> structure |> Sexp.toString |> print_string); + printInterface = (fun ~width:_ ~filename:_ ~comments:_ parsetree -> - parsetree |> signature |> Sexp.to_string |> print_string); + parsetree |> signature |> Sexp.toString |> print_string); } end -let sexp_print_engine = SexpAst.print_engine +let sexpPrintEngine = SexpAst.printEngine -let comments_print_engine = +let commentsPrintEngine = { - Res_driver.print_implementation = + Res_driver.printImplementation = (fun ~width:_ ~filename:_ ~comments s -> - let cmt_tbl = CommentTable.make () in - CommentTable.walk_structure s cmt_tbl comments; - CommentTable.log cmt_tbl); - print_interface = + let cmtTbl = CommentTable.make () in + CommentTable.walkStructure s cmtTbl comments; + CommentTable.log cmtTbl); + printInterface = (fun ~width:_ ~filename:_ ~comments s -> - let cmt_tbl = CommentTable.make () in - CommentTable.walk_signature s cmt_tbl comments; - CommentTable.log cmt_tbl); + let cmtTbl = CommentTable.make () in + CommentTable.walkSignature s cmtTbl comments; + CommentTable.log cmtTbl); } diff --git a/analysis/vendor/res_syntax/res_ast_debugger.mli b/analysis/vendor/res_syntax/res_ast_debugger.mli index 66588af59..1b325b742 100644 --- a/analysis/vendor/res_syntax/res_ast_debugger.mli +++ b/analysis/vendor/res_syntax/res_ast_debugger.mli @@ -1,3 +1,3 @@ -val print_engine : Res_driver.print_engine -val sexp_print_engine : Res_driver.print_engine -val comments_print_engine : Res_driver.print_engine +val printEngine : Res_driver.printEngine +val sexpPrintEngine : Res_driver.printEngine +val commentsPrintEngine : Res_driver.printEngine diff --git a/analysis/vendor/res_syntax/res_cli.ml b/analysis/vendor/res_syntax/res_cli.ml deleted file mode 100644 index fe35a63f7..000000000 --- a/analysis/vendor/res_syntax/res_cli.ml +++ /dev/null @@ -1,320 +0,0 @@ -(* - This CLI isn't used apart for this repo's testing purposes. The syntax - itself is used by ReScript's compiler programmatically through various other apis. -*) - -(* - This is OCaml's Misc.ml's Color module. More specifically, this is - ReScript's OCaml fork's Misc.ml's Color module: - https://github.com/rescript-lang/ocaml/blob/92e58bedced8d7e3e177677800a38922327ab860/utils/misc.ml#L540 - - The syntax's printing's coloring logic depends on: - 1. a global mutable variable that's set in the compiler: Misc.Color.color_enabled - 2. the colors tags supported by Misc.Color, e.g. style_of_tag, which Format - tags like @{hello@} use - 3. etc. - - When this syntax is programmatically used inside ReScript, the various - Format tags like and get properly colored depending on the - above points. - - But when used by this cli file, that coloring logic doesn't render properly - because we're compiling against vanilla OCaml 4.06 instead of ReScript's - OCaml fork. For example, the vanilla compiler doesn't support the `dim` - color (grey). So we emulate the right coloring logic by copy pasting how our - forked OCaml compiler does it. -*) -module Color = struct - (* use ANSI color codes, see https://en.wikipedia.org/wiki/ANSI_escape_code *) - type color = - | Black [@live] - | Red - | Green [@live] - | Yellow - | Blue [@live] - | Magenta - | Cyan - | White [@live] - - type style = - | FG of color (* foreground *) - | BG of color [@live] (* background *) - | Bold - | Reset - | Dim - - let ansi_of_color = function - | Black -> "0" - | Red -> "1" - | Green -> "2" - | Yellow -> "3" - | Blue -> "4" - | Magenta -> "5" - | Cyan -> "6" - | White -> "7" - - let code_of_style = function - | FG c -> "3" ^ ansi_of_color c - | BG c -> "4" ^ ansi_of_color c - | Bold -> "1" - | Reset -> "0" - | Dim -> "2" - - let ansi_of_style_l l = - let s = - match l with - | [] -> code_of_style Reset - | [s] -> code_of_style s - | _ -> String.concat ";" (List.map code_of_style l) - in - "\x1b[" ^ s ^ "m" - - type styles = {error: style list; warning: style list; loc: style list} - - let default_styles = - {warning = [Bold; FG Magenta]; error = [Bold; FG Red]; loc = [Bold]} - - let cur_styles = ref default_styles - - (* let get_styles () = !cur_styles *) - (* let set_styles s = cur_styles := s *) - - (* map a tag to a style, if the tag is known. - @raise Not_found otherwise *) - let style_of_tag s = - match s with - | Format.String_tag "error" -> !cur_styles.error - | Format.String_tag "warning" -> !cur_styles.warning - | Format.String_tag "loc" -> !cur_styles.loc - | Format.String_tag "info" -> [Bold; FG Yellow] - | Format.String_tag "dim" -> [Dim] - | Format.String_tag "filename" -> [FG Cyan] - | _ -> raise Not_found - [@@raises Not_found] - - let color_enabled = ref true - - (* either prints the tag of [s] or delegates to [or_else] *) - let mark_open_tag ~or_else s = - try - let style = style_of_tag s in - if !color_enabled then ansi_of_style_l style else "" - with Not_found -> or_else s - - let mark_close_tag ~or_else s = - try - let _ = style_of_tag s in - if !color_enabled then ansi_of_style_l [Reset] else "" - with Not_found -> or_else s - - (* add color handling to formatter [ppf] *) - let set_color_tag_handling ppf = - let open Format in - let functions = pp_get_formatter_stag_functions ppf () in - let functions' = - { - functions with - mark_open_stag = mark_open_tag ~or_else:functions.mark_open_stag; - mark_close_stag = mark_close_tag ~or_else:functions.mark_close_stag; - } - in - pp_set_mark_tags ppf true; - (* enable tags *) - pp_set_formatter_stag_functions ppf functions'; - (* also setup margins *) - pp_set_margin ppf (pp_get_margin std_formatter ()); - () - - external isatty : out_channel -> bool = "caml_sys_isatty" - - (* reasonable heuristic on whether colors should be enabled *) - let should_enable_color () = - let term = try Sys.getenv "TERM" with Not_found -> "" in - term <> "dumb" && term <> "" && isatty stderr - - type setting = Auto [@live] | Always [@live] | Never [@live] - - let setup = - let first = ref true in - (* initialize only once *) - let formatter_l = - [Format.std_formatter; Format.err_formatter; Format.str_formatter] - in - fun o -> - if !first then ( - first := false; - Format.set_mark_tags true; - List.iter set_color_tag_handling formatter_l; - color_enabled := - match o with - | Some Always -> true - | Some Auto -> should_enable_color () - | Some Never -> false - | None -> should_enable_color ()); - () -end - -(* command line flags *) -module ResClflags : sig - val recover : bool ref - val print : string ref - val width : int ref - val origin : string ref - val file : string ref - val interface : bool ref - val jsx_version : int ref - val jsx_module : string ref - val jsx_mode : string ref - val typechecker : bool ref - - val parse : unit -> unit -end = struct - let recover = ref false - let width = ref 100 - - let print = ref "res" - let origin = ref "" - let interface = ref false - let jsx_version = ref (-1) - let jsx_module = ref "react" - let jsx_mode = ref "automatic" - let file = ref "" - let typechecker = ref false - - let usage = - "\n\ - **This command line is for the repo developer's testing purpose only. DO \ - NOT use it in production**!\n\n" - ^ "Usage:\n res_parser \n\n" ^ "Examples:\n" - ^ " res_parser myFile.res\n" - ^ " res_parser -parse ml -print res myFile.ml\n" - ^ " res_parser -parse res -print binary -interface myFile.resi\n\n" - ^ "Options are:" - - let spec = - [ - ("-recover", Arg.Unit (fun () -> recover := true), "Emit partial ast"); - ( "-parse", - Arg.String (fun txt -> origin := txt), - "Parse ml or res. Default: res" ); - ( "-print", - Arg.String (fun txt -> print := txt), - "Print either binary, ml, ast, sexp, comments or res. Default: res" ); - ( "-width", - Arg.Int (fun w -> width := w), - "Specify the line length for the printer (formatter)" ); - ( "-interface", - Arg.Unit (fun () -> interface := true), - "Parse as interface" ); - ( "-jsx-version", - Arg.Int (fun i -> jsx_version := i), - "Apply a specific built-in ppx before parsing, none or 3, 4. Default: \ - none" ); - ( "-jsx-module", - Arg.String (fun txt -> jsx_module := txt), - "Specify the jsx module. Default: react" ); - ( "-jsx-mode", - Arg.String (fun txt -> jsx_mode := txt), - "Specify the jsx mode, classic or automatic. Default: automatic" ); - ( "-typechecker", - Arg.Unit (fun () -> typechecker := true), - "Parses the ast as it would be passed to the typechecker and not the \ - printer" ); - ] - - let parse () = Arg.parse spec (fun f -> file := f) usage -end - -module CliArgProcessor = struct - type backend = Parser : 'diagnostics Res_driver.parsing_engine -> backend - [@@unboxed] - - let process_file ~is_interface ~width ~recover ~origin ~target ~jsx_version - ~jsx_module ~jsx_mode ~typechecker filename = - let len = String.length filename in - let process_interface = - is_interface - || (len > 0 && (String.get [@doesNotRaise]) filename (len - 1) = 'i') - in - let parsing_engine = - match origin with - | "ml" -> Parser Res_driver_ml_parser.parsing_engine - | "res" -> Parser Res_driver.parsing_engine - | "" -> ( - match Filename.extension filename with - | ".ml" | ".mli" -> Parser Res_driver_ml_parser.parsing_engine - | _ -> Parser Res_driver.parsing_engine) - | origin -> - print_endline - ("-parse needs to be either ml or res. You provided " ^ origin); - exit 1 - in - let print_engine = - match target with - | "binary" -> Res_driver_binary.print_engine - | "ml" -> Res_driver_ml_parser.print_engine - | "ast" -> Res_ast_debugger.print_engine - | "sexp" -> Res_ast_debugger.sexp_print_engine - | "comments" -> Res_ast_debugger.comments_print_engine - | "res" -> Res_driver.print_engine - | target -> - print_endline - ("-print needs to be either binary, ml, ast, sexp, comments or res. \ - You provided " ^ target); - exit 1 - in - - let for_printer = - match target with - | ("res" | "sexp") when not typechecker -> true - | _ -> false - in - - let (Parser backend) = parsing_engine in - (* This is the whole purpose of the Color module above *) - Color.setup None; - if process_interface then - let parse_result = backend.parse_interface ~for_printer ~filename in - if parse_result.invalid then ( - backend.string_of_diagnostics ~source:parse_result.source - ~filename:parse_result.filename parse_result.diagnostics; - if recover then - print_engine.print_interface ~width ~filename - ~comments:parse_result.comments parse_result.parsetree - else exit 1) - else - let parsetree = - Jsx_ppx.rewrite_signature ~jsx_version ~jsx_module ~jsx_mode - parse_result.parsetree - in - print_engine.print_interface ~width ~filename - ~comments:parse_result.comments parsetree - else - let parse_result = backend.parse_implementation ~for_printer ~filename in - if parse_result.invalid then ( - backend.string_of_diagnostics ~source:parse_result.source - ~filename:parse_result.filename parse_result.diagnostics; - if recover then - print_engine.print_implementation ~width ~filename - ~comments:parse_result.comments parse_result.parsetree - else exit 1) - else - let parsetree = - Jsx_ppx.rewrite_implementation ~jsx_version ~jsx_module ~jsx_mode - parse_result.parsetree - in - print_engine.print_implementation ~width ~filename - ~comments:parse_result.comments parsetree - [@@raises exit] -end - -(*let () = - if not !Sys.interactive then ( - ResClflags.parse (); - CliArgProcessor.process_file ~is_interface:!ResClflags.interface - ~width:!ResClflags.width ~recover:!ResClflags.recover - ~target:!ResClflags.print ~origin:!ResClflags.origin - ~jsx_version:!ResClflags.jsx_version ~jsx_module:!ResClflags.jsx_module - ~jsx_mode:!ResClflags.jsx_mode ~typechecker:!ResClflags.typechecker - !ResClflags.file) - [@@raises exit]*) diff --git a/analysis/vendor/res_syntax/res_comment.ml b/analysis/vendor/res_syntax/res_comment.ml index d4e7bd0a4..579b5d327 100644 --- a/analysis/vendor/res_syntax/res_comment.ml +++ b/analysis/vendor/res_syntax/res_comment.ml @@ -1,6 +1,6 @@ type style = SingleLine | MultiLine | DocComment | ModuleComment -let style_to_string s = +let styleToString s = match s with | SingleLine -> "SingleLine" | MultiLine -> "MultiLine" @@ -11,46 +11,46 @@ type t = { txt: string; style: style; loc: Location.t; - mutable prev_tok_end_pos: Lexing.position; + mutable prevTokEndPos: Lexing.position; } let loc t = t.loc let txt t = t.txt -let prev_tok_end_pos t = t.prev_tok_end_pos +let prevTokEndPos t = t.prevTokEndPos -let set_prev_tok_end_pos t pos = t.prev_tok_end_pos <- pos +let setPrevTokEndPos t pos = t.prevTokEndPos <- pos -let is_single_line_comment t = t.style = SingleLine +let isSingleLineComment t = t.style = SingleLine -let is_doc_comment t = t.style = DocComment +let isDocComment t = t.style = DocComment -let is_module_comment t = t.style = ModuleComment +let isModuleComment t = t.style = ModuleComment -let to_string t = +let toString t = let {Location.loc_start; loc_end} = t.loc in Format.sprintf "(txt: %s\nstyle: %s\nlocation: %d,%d-%d,%d)" t.txt - (style_to_string t.style) loc_start.pos_lnum + (styleToString t.style) loc_start.pos_lnum (loc_start.pos_cnum - loc_start.pos_bol) loc_end.pos_lnum (loc_end.pos_cnum - loc_end.pos_bol) -let make_single_line_comment ~loc txt = - {txt; loc; style = SingleLine; prev_tok_end_pos = Lexing.dummy_pos} +let makeSingleLineComment ~loc txt = + {txt; loc; style = SingleLine; prevTokEndPos = Lexing.dummy_pos} -let make_multi_line_comment ~loc ~doc_comment ~standalone txt = +let makeMultiLineComment ~loc ~docComment ~standalone txt = { txt; loc; style = - (if doc_comment then if standalone then ModuleComment else DocComment + (if docComment then if standalone then ModuleComment else DocComment else MultiLine); - prev_tok_end_pos = Lexing.dummy_pos; + prevTokEndPos = Lexing.dummy_pos; } -let from_ocaml_comment ~loc ~txt ~prev_tok_end_pos = - {txt; loc; style = MultiLine; prev_tok_end_pos} +let fromOcamlComment ~loc ~txt ~prevTokEndPos = + {txt; loc; style = MultiLine; prevTokEndPos} -let trim_spaces s = +let trimSpaces s = let len = String.length s in if len = 0 then s else if String.unsafe_get s 0 = ' ' || String.unsafe_get s (len - 1) = ' ' diff --git a/analysis/vendor/res_syntax/res_comment.mli b/analysis/vendor/res_syntax/res_comment.mli index 7cf10edd4..f1d5424d9 100644 --- a/analysis/vendor/res_syntax/res_comment.mli +++ b/analysis/vendor/res_syntax/res_comment.mli @@ -1,22 +1,22 @@ type t -val to_string : t -> string +val toString : t -> string val loc : t -> Location.t val txt : t -> string -val prev_tok_end_pos : t -> Lexing.position +val prevTokEndPos : t -> Lexing.position -val set_prev_tok_end_pos : t -> Lexing.position -> unit +val setPrevTokEndPos : t -> Lexing.position -> unit -val is_doc_comment : t -> bool +val isDocComment : t -> bool -val is_module_comment : t -> bool +val isModuleComment : t -> bool -val is_single_line_comment : t -> bool +val isSingleLineComment : t -> bool -val make_single_line_comment : loc:Location.t -> string -> t -val make_multi_line_comment : - loc:Location.t -> doc_comment:bool -> standalone:bool -> string -> t -val from_ocaml_comment : - loc:Location.t -> txt:string -> prev_tok_end_pos:Lexing.position -> t -val trim_spaces : string -> string +val makeSingleLineComment : loc:Location.t -> string -> t +val makeMultiLineComment : + loc:Location.t -> docComment:bool -> standalone:bool -> string -> t +val fromOcamlComment : + loc:Location.t -> txt:string -> prevTokEndPos:Lexing.position -> t +val trimSpaces : string -> string diff --git a/analysis/vendor/res_syntax/res_comments_table.ml b/analysis/vendor/res_syntax/res_comments_table.ml index b531fde32..b23e65c5f 100644 --- a/analysis/vendor/res_syntax/res_comments_table.ml +++ b/analysis/vendor/res_syntax/res_comments_table.ml @@ -24,7 +24,7 @@ let copy tbl = let empty = make () -let print_entries tbl = +let printEntries tbl = let open Location in Hashtbl.fold (fun (k : Location.t) (v : Comment.t list) acc -> @@ -44,7 +44,7 @@ let print_entries tbl = ] in let doc = - Doc.breakable_group ~force_break:true + Doc.breakableGroup ~forceBreak:true (Doc.concat [ loc; @@ -63,133 +63,133 @@ let print_entries tbl = tbl [] let log t = - let leading_stuff = print_entries t.leading in - let trailing_stuff = print_entries t.trailing in - let stuff_inside = print_entries t.inside in - Doc.breakable_group ~force_break:true + let leadingStuff = printEntries t.leading in + let trailingStuff = printEntries t.trailing in + let stuffInside = printEntries t.inside in + Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.text "leading comments:"; - Doc.indent (Doc.concat [Doc.line; Doc.concat leading_stuff]); + Doc.indent (Doc.concat [Doc.line; Doc.concat leadingStuff]); Doc.line; Doc.text "comments inside:"; - Doc.indent (Doc.concat [Doc.line; Doc.concat stuff_inside]); + Doc.indent (Doc.concat [Doc.line; Doc.concat stuffInside]); Doc.line; Doc.text "trailing comments:"; - Doc.indent (Doc.concat [Doc.line; Doc.concat trailing_stuff]); + Doc.indent (Doc.concat [Doc.line; Doc.concat trailingStuff]); Doc.line; ]) - |> Doc.to_string ~width:80 |> print_endline + |> Doc.toString ~width:80 |> print_endline let attach tbl loc comments = match comments with | [] -> () | comments -> Hashtbl.replace tbl loc comments -let partition_by_loc comments loc = +let partitionByLoc comments loc = let rec loop (leading, inside, trailing) comments = let open Location in match comments with | comment :: rest -> - let cmt_loc = Comment.loc comment in - if cmt_loc.loc_end.pos_cnum <= loc.loc_start.pos_cnum then + let cmtLoc = Comment.loc comment in + if cmtLoc.loc_end.pos_cnum <= loc.loc_start.pos_cnum then loop (comment :: leading, inside, trailing) rest - else if cmt_loc.loc_start.pos_cnum >= loc.loc_end.pos_cnum then + else if cmtLoc.loc_start.pos_cnum >= loc.loc_end.pos_cnum then loop (leading, inside, comment :: trailing) rest else loop (leading, comment :: inside, trailing) rest | [] -> (List.rev leading, List.rev inside, List.rev trailing) in loop ([], [], []) comments -let partition_leading_trailing comments loc = +let partitionLeadingTrailing comments loc = let rec loop (leading, trailing) comments = let open Location in match comments with | comment :: rest -> - let cmt_loc = Comment.loc comment in - if cmt_loc.loc_end.pos_cnum <= loc.loc_start.pos_cnum then + let cmtLoc = Comment.loc comment in + if cmtLoc.loc_end.pos_cnum <= loc.loc_start.pos_cnum then loop (comment :: leading, trailing) rest else loop (leading, comment :: trailing) rest | [] -> (List.rev leading, List.rev trailing) in loop ([], []) comments -let partition_by_on_same_line loc comments = - let rec loop (on_same_line, on_other_line) comments = +let partitionByOnSameLine loc comments = + let rec loop (onSameLine, onOtherLine) comments = let open Location in match comments with - | [] -> (List.rev on_same_line, List.rev on_other_line) + | [] -> (List.rev onSameLine, List.rev onOtherLine) | comment :: rest -> - let cmt_loc = Comment.loc comment in - if cmt_loc.loc_start.pos_lnum == loc.loc_end.pos_lnum then - loop (comment :: on_same_line, on_other_line) rest - else loop (on_same_line, comment :: on_other_line) rest + let cmtLoc = Comment.loc comment in + if cmtLoc.loc_start.pos_lnum == loc.loc_end.pos_lnum then + loop (comment :: onSameLine, onOtherLine) rest + else loop (onSameLine, comment :: onOtherLine) rest in loop ([], []) comments -let partition_adjacent_trailing loc1 comments = +let partitionAdjacentTrailing loc1 comments = let open Location in let open Lexing in - let rec loop ~prev_end_pos after_loc1 comments = + let rec loop ~prevEndPos afterLoc1 comments = match comments with - | [] -> (List.rev after_loc1, []) + | [] -> (List.rev afterLoc1, []) | comment :: rest as comments -> - let cmt_prev_end_pos = Comment.prev_tok_end_pos comment in - if prev_end_pos.Lexing.pos_cnum == cmt_prev_end_pos.pos_cnum then - let comment_end = (Comment.loc comment).loc_end in - loop ~prev_end_pos:comment_end (comment :: after_loc1) rest - else (List.rev after_loc1, comments) + let cmtPrevEndPos = Comment.prevTokEndPos comment in + if prevEndPos.Lexing.pos_cnum == cmtPrevEndPos.pos_cnum then + let commentEnd = (Comment.loc comment).loc_end in + loop ~prevEndPos:commentEnd (comment :: afterLoc1) rest + else (List.rev afterLoc1, comments) in - loop ~prev_end_pos:loc1.loc_end [] comments + loop ~prevEndPos:loc1.loc_end [] comments -let rec collect_list_patterns acc pattern = +let rec collectListPatterns acc pattern = let open Parsetree in match pattern.ppat_desc with | Ppat_construct ({txt = Longident.Lident "::"}, Some {ppat_desc = Ppat_tuple [pat; rest]}) -> - collect_list_patterns (pat :: acc) rest + collectListPatterns (pat :: acc) rest | Ppat_construct ({txt = Longident.Lident "[]"}, None) -> List.rev acc | _ -> List.rev (pattern :: acc) -let rec collect_list_exprs acc expr = +let rec collectListExprs acc expr = let open Parsetree in match expr.pexp_desc with | Pexp_construct ({txt = Longident.Lident "::"}, Some {pexp_desc = Pexp_tuple [expr; rest]}) -> - collect_list_exprs (expr :: acc) rest + collectListExprs (expr :: acc) rest | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> List.rev acc | _ -> List.rev (expr :: acc) (* TODO: use ParsetreeViewer *) -let arrow_type ct = +let arrowType ct = let open Parsetree in - let rec process attrs_before acc typ = + let rec process attrsBefore acc typ = match typ with | { ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2); ptyp_attributes = []; } -> let arg = ([], lbl, typ1) in - process attrs_before (arg :: acc) typ2 + process attrsBefore (arg :: acc) typ2 | { ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2); ptyp_attributes = [({txt = "bs"}, _)] as attrs; } -> let arg = (attrs, lbl, typ1) in - process attrs_before (arg :: acc) typ2 + process attrsBefore (arg :: acc) typ2 | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = _attrs} - as return_type -> + as returnType -> let args = List.rev acc in - (attrs_before, args, return_type) + (attrsBefore, args, returnType) | { ptyp_desc = Ptyp_arrow (((Labelled _ | Optional _) as lbl), typ1, typ2); ptyp_attributes = attrs; } -> let arg = (attrs, lbl, typ1) in - process attrs_before (arg :: acc) typ2 - | typ -> (attrs_before, List.rev acc, typ) + process attrsBefore (arg :: acc) typ2 + | typ -> (attrsBefore, List.rev acc, typ) in match ct with | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as @@ -198,54 +198,54 @@ let arrow_type ct = | typ -> process [] [] typ (* TODO: avoiding the dependency on ParsetreeViewer here, is this a good idea? *) -let mod_expr_apply mod_expr = - let rec loop acc mod_expr = - match mod_expr with +let modExprApply modExpr = + let rec loop acc modExpr = + match modExpr with | {Parsetree.pmod_desc = Pmod_apply (next, arg)} -> loop (arg :: acc) next - | _ -> mod_expr :: acc + | _ -> modExpr :: acc in - loop [] mod_expr + loop [] modExpr (* TODO: avoiding the dependency on ParsetreeViewer here, is this a good idea? *) -let mod_expr_functor mod_expr = - let rec loop acc mod_expr = - match mod_expr with +let modExprFunctor modExpr = + let rec loop acc modExpr = + match modExpr with | { - Parsetree.pmod_desc = Pmod_functor (lbl, mod_type, return_mod_expr); + Parsetree.pmod_desc = Pmod_functor (lbl, modType, returnModExpr); pmod_attributes = attrs; } -> - let param = (attrs, lbl, mod_type) in - loop (param :: acc) return_mod_expr - | return_mod_expr -> (List.rev acc, return_mod_expr) + let param = (attrs, lbl, modType) in + loop (param :: acc) returnModExpr + | returnModExpr -> (List.rev acc, returnModExpr) in - loop [] mod_expr + loop [] modExpr -let functor_type modtype = +let functorType modtype = let rec process acc modtype = match modtype with | { - Parsetree.pmty_desc = Pmty_functor (lbl, arg_type, return_type); + Parsetree.pmty_desc = Pmty_functor (lbl, argType, returnType); pmty_attributes = attrs; } -> - let arg = (attrs, lbl, arg_type) in - process (arg :: acc) return_type - | mod_type -> (List.rev acc, mod_type) + let arg = (attrs, lbl, argType) in + process (arg :: acc) returnType + | modType -> (List.rev acc, modType) in process [] modtype -let fun_expr expr = +let funExpr expr = let open Parsetree in (* Turns (type t, type u, type z) into "type t u z" *) - let rec collect_new_types acc return_expr = - match return_expr with - | {pexp_desc = Pexp_newtype (string_loc, return_expr); pexp_attributes = []} + let rec collectNewTypes acc returnExpr = + match returnExpr with + | {pexp_desc = Pexp_newtype (stringLoc, returnExpr); pexp_attributes = []} -> - collect_new_types (string_loc :: acc) return_expr - | return_expr -> + collectNewTypes (stringLoc :: acc) returnExpr + | returnExpr -> let loc = match (acc, List.rev acc) with - | _startLoc :: _, end_loc :: _ -> - {end_loc.loc with loc_end = end_loc.loc.loc_end} + | _startLoc :: _, endLoc :: _ -> + {endLoc.loc with loc_end = endLoc.loc.loc_end} | _ -> Location.none in let txt = @@ -253,7 +253,7 @@ let fun_expr expr = (fun curr acc -> acc ^ " " ^ curr.Location.txt) acc "type" in - (Location.mkloc txt loc, return_expr) + (Location.mkloc txt loc, returnExpr) in (* For simplicity reason Pexp_newtype gets converted to a Nolabel parameter, * otherwise this function would need to return a variant: @@ -261,38 +261,38 @@ let fun_expr expr = * | NewType(...) * This complicates printing with an extra variant/boxing/allocation for a code-path * that is not often used. Lets just keep it simple for now *) - let rec collect attrs_before acc expr = + let rec collect attrsBefore acc expr = match expr with | { - pexp_desc = Pexp_fun (lbl, default_expr, pattern, return_expr); + pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); pexp_attributes = []; } -> - let parameter = ([], lbl, default_expr, pattern) in - collect attrs_before (parameter :: acc) return_expr - | {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs} -> - let var, return_expr = collect_new_types [string_loc] rest in + let parameter = ([], lbl, defaultExpr, pattern) in + collect attrsBefore (parameter :: acc) returnExpr + | {pexp_desc = Pexp_newtype (stringLoc, rest); pexp_attributes = attrs} -> + let var, returnExpr = collectNewTypes [stringLoc] rest in let parameter = ( attrs, Asttypes.Nolabel, None, - Ast_helper.Pat.var ~loc:string_loc.loc var ) + Ast_helper.Pat.var ~loc:stringLoc.loc var ) in - collect attrs_before (parameter :: acc) return_expr + collect attrsBefore (parameter :: acc) returnExpr | { - pexp_desc = Pexp_fun (lbl, default_expr, pattern, return_expr); + pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); pexp_attributes = [({txt = "bs"}, _)] as attrs; } -> - let parameter = (attrs, lbl, default_expr, pattern) in - collect attrs_before (parameter :: acc) return_expr + let parameter = (attrs, lbl, defaultExpr, pattern) in + collect attrsBefore (parameter :: acc) returnExpr | { pexp_desc = Pexp_fun - (((Labelled _ | Optional _) as lbl), default_expr, pattern, return_expr); + (((Labelled _ | Optional _) as lbl), defaultExpr, pattern, returnExpr); pexp_attributes = attrs; } -> - let parameter = (attrs, lbl, default_expr, pattern) in - collect attrs_before (parameter :: acc) return_expr - | expr -> (attrs_before, List.rev acc, expr) + let parameter = (attrs, lbl, defaultExpr, pattern) in + collect attrsBefore (parameter :: acc) returnExpr + | expr -> (attrsBefore, List.rev acc, expr) in match expr with | { @@ -302,19 +302,19 @@ let fun_expr expr = collect attrs [] {expr with pexp_attributes = []} | expr -> collect [] [] expr -let rec is_block_expr expr = +let rec isBlockExpr expr = let open Parsetree in match expr.pexp_desc with | Pexp_letmodule _ | Pexp_letexception _ | Pexp_let _ | Pexp_open _ | Pexp_sequence _ -> true - | Pexp_apply (call_expr, _) when is_block_expr call_expr -> true - | Pexp_constraint (expr, _) when is_block_expr expr -> true - | Pexp_field (expr, _) when is_block_expr expr -> true - | Pexp_setfield (expr, _, _) when is_block_expr expr -> true + | Pexp_apply (callExpr, _) when isBlockExpr callExpr -> true + | Pexp_constraint (expr, _) when isBlockExpr expr -> true + | Pexp_field (expr, _) when isBlockExpr expr -> true + | Pexp_setfield (expr, _, _) when isBlockExpr expr -> true | _ -> false -let is_if_then_else_expr expr = +let isIfThenElseExpr expr = let open Parsetree in match expr.pexp_desc with | Pexp_ifthenelse _ -> true @@ -341,14 +341,14 @@ type node = | TypeDeclaration of Parsetree.type_declaration | ValueBinding of Parsetree.value_binding -let get_loc node = +let getLoc node = let open Parsetree in match node with | Case case -> { case.pc_lhs.ppat_loc with loc_end = - (match ParsetreeViewer.process_braces_attr case.pc_rhs with + (match ParsetreeViewer.processBracesAttr case.pc_rhs with | None, _ -> case.pc_rhs.pexp_loc.loc_end | Some ({loc}, _), _ -> loc.Location.loc_end); } @@ -385,332 +385,311 @@ let get_loc node = | TypeDeclaration td -> td.ptype_loc | ValueBinding vb -> vb.pvb_loc -let rec walk_structure s t comments = +let rec walkStructure s t comments = match s with | _ when comments = [] -> () | [] -> attach t.inside Location.none comments - | s -> walk_list (s |> List.map (fun si -> StructureItem si)) t comments + | s -> walkList (s |> List.map (fun si -> StructureItem si)) t comments -and walk_structure_item si t comments = +and walkStructureItem si t comments = match si.Parsetree.pstr_desc with | _ when comments = [] -> () - | Pstr_primitive value_description -> - walk_value_description value_description t comments - | Pstr_open open_description -> - walk_open_description open_description t comments - | Pstr_value (_, value_bindings) -> - walk_value_bindings value_bindings t comments - | Pstr_type (_, type_declarations) -> - walk_type_declarations type_declarations t comments - | Pstr_eval (expr, _) -> walk_expression expr t comments - | Pstr_module module_binding -> walk_module_binding module_binding t comments - | Pstr_recmodule module_bindings -> - walk_list - (module_bindings |> List.map (fun mb -> ModuleBinding mb)) + | Pstr_primitive valueDescription -> + walkValueDescription valueDescription t comments + | Pstr_open openDescription -> walkOpenDescription openDescription t comments + | Pstr_value (_, valueBindings) -> walkValueBindings valueBindings t comments + | Pstr_type (_, typeDeclarations) -> + walkTypeDeclarations typeDeclarations t comments + | Pstr_eval (expr, _) -> walkExpression expr t comments + | Pstr_module moduleBinding -> walkModuleBinding moduleBinding t comments + | Pstr_recmodule moduleBindings -> + walkList + (moduleBindings |> List.map (fun mb -> ModuleBinding mb)) t comments - | Pstr_modtype mod_typ_decl -> - walk_module_type_declaration mod_typ_decl t comments - | Pstr_attribute attribute -> walk_attribute attribute t comments - | Pstr_extension (extension, _) -> walk_extension extension t comments - | Pstr_include include_declaration -> - walk_include_declaration include_declaration t comments - | Pstr_exception extension_constructor -> - walk_extension_constructor extension_constructor t comments - | Pstr_typext type_extension -> walk_type_extension type_extension t comments + | Pstr_modtype modTypDecl -> walkModuleTypeDeclaration modTypDecl t comments + | Pstr_attribute attribute -> walkAttribute attribute t comments + | Pstr_extension (extension, _) -> walkExtension extension t comments + | Pstr_include includeDeclaration -> + walkIncludeDeclaration includeDeclaration t comments + | Pstr_exception extensionConstructor -> + walkExtensionConstructor extensionConstructor t comments + | Pstr_typext typeExtension -> walkTypeExtension typeExtension t comments | Pstr_class_type _ | Pstr_class _ -> () -and walk_value_description vd t comments = - let leading, trailing = - partition_leading_trailing comments vd.pval_name.loc - in +and walkValueDescription vd t comments = + let leading, trailing = partitionLeadingTrailing comments vd.pval_name.loc in attach t.leading vd.pval_name.loc leading; - let after_name, rest = - partition_adjacent_trailing vd.pval_name.loc trailing - in - attach t.trailing vd.pval_name.loc after_name; - let before, inside, after = partition_by_loc rest vd.pval_type.ptyp_loc in + let afterName, rest = partitionAdjacentTrailing vd.pval_name.loc trailing in + attach t.trailing vd.pval_name.loc afterName; + let before, inside, after = partitionByLoc rest vd.pval_type.ptyp_loc in attach t.leading vd.pval_type.ptyp_loc before; - walk_core_type vd.pval_type t inside; + walkCoreType vd.pval_type t inside; attach t.trailing vd.pval_type.ptyp_loc after -and walk_type_extension te t comments = +and walkTypeExtension te t comments = let leading, trailing = - partition_leading_trailing comments te.ptyext_path.loc + partitionLeadingTrailing comments te.ptyext_path.loc in attach t.leading te.ptyext_path.loc leading; - let after_path, rest = - partition_adjacent_trailing te.ptyext_path.loc trailing - in - attach t.trailing te.ptyext_path.loc after_path; + let afterPath, rest = partitionAdjacentTrailing te.ptyext_path.loc trailing in + attach t.trailing te.ptyext_path.loc afterPath; (* type params *) let rest = match te.ptyext_params with | [] -> rest - | type_params -> - visit_list_but_continue_with_remaining_comments - ~get_loc:(fun (typexpr, _variance) -> typexpr.Parsetree.ptyp_loc) - ~walk_node:walk_type_param ~newline_delimited:false type_params t rest + | typeParams -> + visitListButContinueWithRemainingComments + ~getLoc:(fun (typexpr, _variance) -> typexpr.Parsetree.ptyp_loc) + ~walkNode:walkTypeParam ~newlineDelimited:false typeParams t rest in - walk_list + walkList (te.ptyext_constructors |> List.map (fun ec -> ExtensionConstructor ec)) t rest -and walk_include_declaration incl_decl t comments = +and walkIncludeDeclaration inclDecl t comments = let before, inside, after = - partition_by_loc comments incl_decl.pincl_mod.pmod_loc + partitionByLoc comments inclDecl.pincl_mod.pmod_loc in - attach t.leading incl_decl.pincl_mod.pmod_loc before; - walk_module_expr incl_decl.pincl_mod t inside; - attach t.trailing incl_decl.pincl_mod.pmod_loc after + attach t.leading inclDecl.pincl_mod.pmod_loc before; + walkModuleExpr inclDecl.pincl_mod t inside; + attach t.trailing inclDecl.pincl_mod.pmod_loc after -and walk_module_type_declaration mtd t comments = - let leading, trailing = - partition_leading_trailing comments mtd.pmtd_name.loc - in +and walkModuleTypeDeclaration mtd t comments = + let leading, trailing = partitionLeadingTrailing comments mtd.pmtd_name.loc in attach t.leading mtd.pmtd_name.loc leading; match mtd.pmtd_type with | None -> attach t.trailing mtd.pmtd_name.loc trailing - | Some mod_type -> - let after_name, rest = - partition_adjacent_trailing mtd.pmtd_name.loc trailing + | Some modType -> + let afterName, rest = + partitionAdjacentTrailing mtd.pmtd_name.loc trailing in - attach t.trailing mtd.pmtd_name.loc after_name; - let before, inside, after = partition_by_loc rest mod_type.pmty_loc in - attach t.leading mod_type.pmty_loc before; - walk_mod_type mod_type t inside; - attach t.trailing mod_type.pmty_loc after - -and walk_module_binding mb t comments = - let leading, trailing = partition_leading_trailing comments mb.pmb_name.loc in + attach t.trailing mtd.pmtd_name.loc afterName; + let before, inside, after = partitionByLoc rest modType.pmty_loc in + attach t.leading modType.pmty_loc before; + walkModType modType t inside; + attach t.trailing modType.pmty_loc after + +and walkModuleBinding mb t comments = + let leading, trailing = partitionLeadingTrailing comments mb.pmb_name.loc in attach t.leading mb.pmb_name.loc leading; - let after_name, rest = partition_adjacent_trailing mb.pmb_name.loc trailing in - attach t.trailing mb.pmb_name.loc after_name; - let leading, inside, trailing = partition_by_loc rest mb.pmb_expr.pmod_loc in + let afterName, rest = partitionAdjacentTrailing mb.pmb_name.loc trailing in + attach t.trailing mb.pmb_name.loc afterName; + let leading, inside, trailing = partitionByLoc rest mb.pmb_expr.pmod_loc in (match mb.pmb_expr.pmod_desc with | Pmod_constraint _ -> - walk_module_expr mb.pmb_expr t (List.concat [leading; inside]) + walkModuleExpr mb.pmb_expr t (List.concat [leading; inside]) | _ -> attach t.leading mb.pmb_expr.pmod_loc leading; - walk_module_expr mb.pmb_expr t inside); + walkModuleExpr mb.pmb_expr t inside); attach t.trailing mb.pmb_expr.pmod_loc trailing -and walk_signature signature t comments = +and walkSignature signature t comments = match signature with | _ when comments = [] -> () | [] -> attach t.inside Location.none comments | _s -> - walk_list (signature |> List.map (fun si -> SignatureItem si)) t comments + walkList (signature |> List.map (fun si -> SignatureItem si)) t comments -and walk_signature_item (si : Parsetree.signature_item) t comments = +and walkSignatureItem (si : Parsetree.signature_item) t comments = match si.psig_desc with | _ when comments = [] -> () - | Psig_value value_description -> - walk_value_description value_description t comments - | Psig_type (_, type_declarations) -> - walk_type_declarations type_declarations t comments - | Psig_typext type_extension -> walk_type_extension type_extension t comments - | Psig_exception extension_constructor -> - walk_extension_constructor extension_constructor t comments - | Psig_module module_declaration -> - walk_module_declaration module_declaration t comments - | Psig_recmodule module_declarations -> - walk_list - (module_declarations |> List.map (fun md -> ModuleDeclaration md)) + | Psig_value valueDescription -> + walkValueDescription valueDescription t comments + | Psig_type (_, typeDeclarations) -> + walkTypeDeclarations typeDeclarations t comments + | Psig_typext typeExtension -> walkTypeExtension typeExtension t comments + | Psig_exception extensionConstructor -> + walkExtensionConstructor extensionConstructor t comments + | Psig_module moduleDeclaration -> + walkModuleDeclaration moduleDeclaration t comments + | Psig_recmodule moduleDeclarations -> + walkList + (moduleDeclarations |> List.map (fun md -> ModuleDeclaration md)) t comments - | Psig_modtype module_type_declaration -> - walk_module_type_declaration module_type_declaration t comments - | Psig_open open_description -> - walk_open_description open_description t comments - | Psig_include include_description -> - walk_include_description include_description t comments - | Psig_attribute attribute -> walk_attribute attribute t comments - | Psig_extension (extension, _) -> walk_extension extension t comments + | Psig_modtype moduleTypeDeclaration -> + walkModuleTypeDeclaration moduleTypeDeclaration t comments + | Psig_open openDescription -> walkOpenDescription openDescription t comments + | Psig_include includeDescription -> + walkIncludeDescription includeDescription t comments + | Psig_attribute attribute -> walkAttribute attribute t comments + | Psig_extension (extension, _) -> walkExtension extension t comments | Psig_class _ | Psig_class_type _ -> () -and walk_include_description id t comments = - let before, inside, after = partition_by_loc comments id.pincl_mod.pmty_loc in +and walkIncludeDescription id t comments = + let before, inside, after = partitionByLoc comments id.pincl_mod.pmty_loc in attach t.leading id.pincl_mod.pmty_loc before; - walk_mod_type id.pincl_mod t inside; + walkModType id.pincl_mod t inside; attach t.trailing id.pincl_mod.pmty_loc after -and walk_module_declaration md t comments = - let leading, trailing = partition_leading_trailing comments md.pmd_name.loc in +and walkModuleDeclaration md t comments = + let leading, trailing = partitionLeadingTrailing comments md.pmd_name.loc in attach t.leading md.pmd_name.loc leading; - let after_name, rest = partition_adjacent_trailing md.pmd_name.loc trailing in - attach t.trailing md.pmd_name.loc after_name; - let leading, inside, trailing = partition_by_loc rest md.pmd_type.pmty_loc in + let afterName, rest = partitionAdjacentTrailing md.pmd_name.loc trailing in + attach t.trailing md.pmd_name.loc afterName; + let leading, inside, trailing = partitionByLoc rest md.pmd_type.pmty_loc in attach t.leading md.pmd_type.pmty_loc leading; - walk_mod_type md.pmd_type t inside; + walkModType md.pmd_type t inside; attach t.trailing md.pmd_type.pmty_loc trailing -and walk_node node tbl comments = +and walkNode node tbl comments = match node with - | Case c -> walk_case c tbl comments - | CoreType ct -> walk_core_type ct tbl comments - | ExprArgument ea -> walk_expr_argument ea tbl comments - | Expression e -> walk_expression e tbl comments - | ExprRecordRow (ri, e) -> walk_expr_record_row (ri, e) tbl comments - | ExtensionConstructor ec -> walk_extension_constructor ec tbl comments - | LabelDeclaration ld -> walk_label_declaration ld tbl comments - | ModuleBinding mb -> walk_module_binding mb tbl comments - | ModuleDeclaration md -> walk_module_declaration md tbl comments - | ModuleExpr me -> walk_module_expr me tbl comments - | ObjectField f -> walk_object_field f tbl comments - | PackageConstraint (li, te) -> walk_package_constraint (li, te) tbl comments - | Pattern p -> walk_pattern p tbl comments - | PatternRecordRow (li, p) -> walk_pattern_record_row (li, p) tbl comments - | RowField rf -> walk_row_field rf tbl comments - | SignatureItem si -> walk_signature_item si tbl comments - | StructureItem si -> walk_structure_item si tbl comments - | TypeDeclaration td -> walk_type_declaration td tbl comments - | ValueBinding vb -> walk_value_binding vb tbl comments - -and walk_list : ?prev_loc:Location.t -> node list -> t -> Comment.t list -> unit - = - fun ?prev_loc l t comments -> + | Case c -> walkCase c tbl comments + | CoreType ct -> walkCoreType ct tbl comments + | ExprArgument ea -> walkExprArgument ea tbl comments + | Expression e -> walkExpression e tbl comments + | ExprRecordRow (ri, e) -> walkExprRecordRow (ri, e) tbl comments + | ExtensionConstructor ec -> walkExtensionConstructor ec tbl comments + | LabelDeclaration ld -> walkLabelDeclaration ld tbl comments + | ModuleBinding mb -> walkModuleBinding mb tbl comments + | ModuleDeclaration md -> walkModuleDeclaration md tbl comments + | ModuleExpr me -> walkModuleExpr me tbl comments + | ObjectField f -> walkObjectField f tbl comments + | PackageConstraint (li, te) -> walkPackageConstraint (li, te) tbl comments + | Pattern p -> walkPattern p tbl comments + | PatternRecordRow (li, p) -> walkPatternRecordRow (li, p) tbl comments + | RowField rf -> walkRowField rf tbl comments + | SignatureItem si -> walkSignatureItem si tbl comments + | StructureItem si -> walkStructureItem si tbl comments + | TypeDeclaration td -> walkTypeDeclaration td tbl comments + | ValueBinding vb -> walkValueBinding vb tbl comments + +and walkList : ?prevLoc:Location.t -> node list -> t -> Comment.t list -> unit = + fun ?prevLoc l t comments -> match l with | _ when comments = [] -> () | [] -> ( - match prev_loc with + match prevLoc with | Some loc -> attach t.trailing loc comments | None -> ()) | node :: rest -> - let curr_loc = get_loc node in - let leading, inside, trailing = partition_by_loc comments curr_loc in - (match prev_loc with + let currLoc = getLoc node in + let leading, inside, trailing = partitionByLoc comments currLoc in + (match prevLoc with | None -> (* first node, all leading comments attach here *) - attach t.leading curr_loc leading - | Some prev_loc -> + attach t.leading currLoc leading + | Some prevLoc -> (* Same line *) - if prev_loc.loc_end.pos_lnum == curr_loc.loc_start.pos_lnum then ( - let after_prev, before_curr = - partition_adjacent_trailing prev_loc leading - in - attach t.trailing prev_loc after_prev; - attach t.leading curr_loc before_curr) + if prevLoc.loc_end.pos_lnum == currLoc.loc_start.pos_lnum then ( + let afterPrev, beforeCurr = partitionAdjacentTrailing prevLoc leading in + attach t.trailing prevLoc afterPrev; + attach t.leading currLoc beforeCurr) else - let on_same_line_as_prev, after_prev = - partition_by_on_same_line prev_loc leading - in - attach t.trailing prev_loc on_same_line_as_prev; - let leading, _inside, _trailing = - partition_by_loc after_prev curr_loc + let onSameLineAsPrev, afterPrev = + partitionByOnSameLine prevLoc leading in - attach t.leading curr_loc leading); - walk_node node t inside; - walk_list ~prev_loc:curr_loc rest t trailing + attach t.trailing prevLoc onSameLineAsPrev; + let leading, _inside, _trailing = partitionByLoc afterPrev currLoc in + attach t.leading currLoc leading); + walkNode node t inside; + walkList ~prevLoc:currLoc rest t trailing (* The parsetree doesn't always contain location info about the opening or * closing token of a "list-of-things". This routine visits the whole list, * but returns any remaining comments that likely fall after the whole list. *) -and visit_list_but_continue_with_remaining_comments : +and visitListButContinueWithRemainingComments : 'node. - ?prev_loc:Location.t -> - newline_delimited:bool -> - get_loc:('node -> Location.t) -> - walk_node:('node -> t -> Comment.t list -> unit) -> + ?prevLoc:Location.t -> + newlineDelimited:bool -> + getLoc:('node -> Location.t) -> + walkNode:('node -> t -> Comment.t list -> unit) -> 'node list -> t -> Comment.t list -> Comment.t list = - fun ?prev_loc ~newline_delimited ~get_loc ~walk_node l t comments -> + fun ?prevLoc ~newlineDelimited ~getLoc ~walkNode l t comments -> let open Location in match l with | _ when comments = [] -> [] | [] -> ( - match prev_loc with + match prevLoc with | Some loc -> - let after_prev, rest = - if newline_delimited then partition_by_on_same_line loc comments - else partition_adjacent_trailing loc comments + let afterPrev, rest = + if newlineDelimited then partitionByOnSameLine loc comments + else partitionAdjacentTrailing loc comments in - attach t.trailing loc after_prev; + attach t.trailing loc afterPrev; rest | None -> comments) | node :: rest -> - let curr_loc = get_loc node in - let leading, inside, trailing = partition_by_loc comments curr_loc in + let currLoc = getLoc node in + let leading, inside, trailing = partitionByLoc comments currLoc in let () = - match prev_loc with + match prevLoc with | None -> (* first node, all leading comments attach here *) - attach t.leading curr_loc leading; + attach t.leading currLoc leading; () - | Some prev_loc -> + | Some prevLoc -> (* Same line *) - if prev_loc.loc_end.pos_lnum == curr_loc.loc_start.pos_lnum then - let after_prev, before_curr = - partition_adjacent_trailing prev_loc leading + if prevLoc.loc_end.pos_lnum == currLoc.loc_start.pos_lnum then + let afterPrev, beforeCurr = + partitionAdjacentTrailing prevLoc leading in - let () = attach t.trailing prev_loc after_prev in - let () = attach t.leading curr_loc before_curr in + let () = attach t.trailing prevLoc afterPrev in + let () = attach t.leading currLoc beforeCurr in () else - let on_same_line_as_prev, after_prev = - partition_by_on_same_line prev_loc leading - in - let () = attach t.trailing prev_loc on_same_line_as_prev in - let leading, _inside, _trailing = - partition_by_loc after_prev curr_loc + let onSameLineAsPrev, afterPrev = + partitionByOnSameLine prevLoc leading in - let () = attach t.leading curr_loc leading in + let () = attach t.trailing prevLoc onSameLineAsPrev in + let leading, _inside, _trailing = partitionByLoc afterPrev currLoc in + let () = attach t.leading currLoc leading in () in - walk_node node t inside; - visit_list_but_continue_with_remaining_comments ~prev_loc:curr_loc ~get_loc - ~walk_node ~newline_delimited rest t trailing + walkNode node t inside; + visitListButContinueWithRemainingComments ~prevLoc:currLoc ~getLoc ~walkNode + ~newlineDelimited rest t trailing -and walk_value_bindings vbs t comments = - walk_list (vbs |> List.map (fun vb -> ValueBinding vb)) t comments +and walkValueBindings vbs t comments = + walkList (vbs |> List.map (fun vb -> ValueBinding vb)) t comments -and walk_open_description open_description t comments = - let loc = open_description.popen_lid.loc in - let leading, trailing = partition_leading_trailing comments loc in +and walkOpenDescription openDescription t comments = + let loc = openDescription.popen_lid.loc in + let leading, trailing = partitionLeadingTrailing comments loc in attach t.leading loc leading; attach t.trailing loc trailing -and walk_type_declarations type_declarations t comments = - walk_list - (type_declarations |> List.map (fun td -> TypeDeclaration td)) +and walkTypeDeclarations typeDeclarations t comments = + walkList + (typeDeclarations |> List.map (fun td -> TypeDeclaration td)) t comments -and walk_type_param (typexpr, _variance) t comments = - walk_core_type typexpr t comments +and walkTypeParam (typexpr, _variance) t comments = + walkCoreType typexpr t comments -and walk_type_declaration (td : Parsetree.type_declaration) t comments = - let before_name, rest = - partition_leading_trailing comments td.ptype_name.loc - in - attach t.leading td.ptype_name.loc before_name; +and walkTypeDeclaration (td : Parsetree.type_declaration) t comments = + let beforeName, rest = partitionLeadingTrailing comments td.ptype_name.loc in + attach t.leading td.ptype_name.loc beforeName; - let after_name, rest = partition_adjacent_trailing td.ptype_name.loc rest in - attach t.trailing td.ptype_name.loc after_name; + let afterName, rest = partitionAdjacentTrailing td.ptype_name.loc rest in + attach t.trailing td.ptype_name.loc afterName; (* type params *) let rest = match td.ptype_params with | [] -> rest - | type_params -> - visit_list_but_continue_with_remaining_comments - ~get_loc:(fun (typexpr, _variance) -> typexpr.Parsetree.ptyp_loc) - ~walk_node:walk_type_param ~newline_delimited:false type_params t rest + | typeParams -> + visitListButContinueWithRemainingComments + ~getLoc:(fun (typexpr, _variance) -> typexpr.Parsetree.ptyp_loc) + ~walkNode:walkTypeParam ~newlineDelimited:false typeParams t rest in (* manifest: = typexpr *) let rest = match td.ptype_manifest with | Some typexpr -> - let before_typ, inside_typ, after_typ = - partition_by_loc rest typexpr.ptyp_loc + let beforeTyp, insideTyp, afterTyp = + partitionByLoc rest typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc before_typ; - walk_core_type typexpr t inside_typ; - let after_typ, rest = - partition_adjacent_trailing typexpr.Parsetree.ptyp_loc after_typ + attach t.leading typexpr.ptyp_loc beforeTyp; + walkCoreType typexpr t insideTyp; + let afterTyp, rest = + partitionAdjacentTrailing typexpr.Parsetree.ptyp_loc afterTyp in - attach t.trailing typexpr.ptyp_loc after_typ; + attach t.trailing typexpr.ptyp_loc afterTyp; rest | None -> rest in @@ -718,77 +697,76 @@ and walk_type_declaration (td : Parsetree.type_declaration) t comments = let rest = match td.ptype_kind with | Ptype_abstract | Ptype_open -> rest - | Ptype_record label_declarations -> + | Ptype_record labelDeclarations -> let () = - if label_declarations = [] then attach t.inside td.ptype_loc rest + if labelDeclarations = [] then attach t.inside td.ptype_loc rest else - walk_list - (label_declarations |> List.map (fun ld -> LabelDeclaration ld)) + walkList + (labelDeclarations |> List.map (fun ld -> LabelDeclaration ld)) t rest in [] - | Ptype_variant constructor_declarations -> - walk_constructor_declarations constructor_declarations t rest + | Ptype_variant constructorDeclarations -> + walkConstructorDeclarations constructorDeclarations t rest in attach t.trailing td.ptype_loc rest -and walk_label_declarations lds t comments = - visit_list_but_continue_with_remaining_comments - ~get_loc:(fun ld -> ld.Parsetree.pld_loc) - ~walk_node:walk_label_declaration ~newline_delimited:false lds t comments - -and walk_label_declaration ld t comments = - let before_name, rest = partition_leading_trailing comments ld.pld_name.loc in - attach t.leading ld.pld_name.loc before_name; - let after_name, rest = partition_adjacent_trailing ld.pld_name.loc rest in - attach t.trailing ld.pld_name.loc after_name; - let before_typ, inside_typ, after_typ = - partition_by_loc rest ld.pld_type.ptyp_loc +and walkLabelDeclarations lds t comments = + visitListButContinueWithRemainingComments + ~getLoc:(fun ld -> ld.Parsetree.pld_loc) + ~walkNode:walkLabelDeclaration ~newlineDelimited:false lds t comments + +and walkLabelDeclaration ld t comments = + let beforeName, rest = partitionLeadingTrailing comments ld.pld_name.loc in + attach t.leading ld.pld_name.loc beforeName; + let afterName, rest = partitionAdjacentTrailing ld.pld_name.loc rest in + attach t.trailing ld.pld_name.loc afterName; + let beforeTyp, insideTyp, afterTyp = + partitionByLoc rest ld.pld_type.ptyp_loc in - attach t.leading ld.pld_type.ptyp_loc before_typ; - walk_core_type ld.pld_type t inside_typ; - attach t.trailing ld.pld_type.ptyp_loc after_typ - -and walk_constructor_declarations cds t comments = - visit_list_but_continue_with_remaining_comments - ~get_loc:(fun cd -> cd.Parsetree.pcd_loc) - ~walk_node:walk_constructor_declaration ~newline_delimited:false cds t - comments - -and walk_constructor_declaration cd t comments = - let before_name, rest = partition_leading_trailing comments cd.pcd_name.loc in - attach t.leading cd.pcd_name.loc before_name; - let after_name, rest = partition_adjacent_trailing cd.pcd_name.loc rest in - attach t.trailing cd.pcd_name.loc after_name; - let rest = walk_constructor_arguments cd.pcd_args t rest in + attach t.leading ld.pld_type.ptyp_loc beforeTyp; + walkCoreType ld.pld_type t insideTyp; + attach t.trailing ld.pld_type.ptyp_loc afterTyp + +and walkConstructorDeclarations cds t comments = + visitListButContinueWithRemainingComments + ~getLoc:(fun cd -> cd.Parsetree.pcd_loc) + ~walkNode:walkConstructorDeclaration ~newlineDelimited:false cds t comments + +and walkConstructorDeclaration cd t comments = + let beforeName, rest = partitionLeadingTrailing comments cd.pcd_name.loc in + attach t.leading cd.pcd_name.loc beforeName; + let afterName, rest = partitionAdjacentTrailing cd.pcd_name.loc rest in + attach t.trailing cd.pcd_name.loc afterName; + let rest = walkConstructorArguments cd.pcd_args t rest in let rest = match cd.pcd_res with | Some typexpr -> - let before_typ, inside_typ, after_typ = - partition_by_loc rest typexpr.ptyp_loc + let beforeTyp, insideTyp, afterTyp = + partitionByLoc rest typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc before_typ; - walk_core_type typexpr t inside_typ; - let after_typ, rest = - partition_adjacent_trailing typexpr.Parsetree.ptyp_loc after_typ + attach t.leading typexpr.ptyp_loc beforeTyp; + walkCoreType typexpr t insideTyp; + let afterTyp, rest = + partitionAdjacentTrailing typexpr.Parsetree.ptyp_loc afterTyp in - attach t.trailing typexpr.ptyp_loc after_typ; + attach t.trailing typexpr.ptyp_loc afterTyp; rest | None -> rest in attach t.trailing cd.pcd_loc rest -and walk_constructor_arguments args t comments = +and walkConstructorArguments args t comments = match args with | Pcstr_tuple typexprs -> - visit_list_but_continue_with_remaining_comments - ~get_loc:(fun n -> n.Parsetree.ptyp_loc) - ~walk_node:walk_core_type ~newline_delimited:false typexprs t comments - | Pcstr_record label_declarations -> - walk_label_declarations label_declarations t comments + visitListButContinueWithRemainingComments + ~getLoc:(fun n -> n.Parsetree.ptyp_loc) + ~walkNode:walkCoreType ~newlineDelimited:false typexprs t comments + | Pcstr_record labelDeclarations -> + walkLabelDeclarations labelDeclarations t comments -and walk_value_binding vb t comments = +and walkValueBinding vb t comments = let open Location in let vb = let open Parsetree in @@ -816,7 +794,7 @@ and walk_value_binding vb t comments = | ( ({ ppat_desc = Ppat_constraint (pat, ({ptyp_desc = Ptyp_poly (_ :: _, t)} as typ)); - } as constrained_pattern), + } as constrainedPattern), {pexp_desc = Pexp_newtype (_, {pexp_desc = Pexp_constraint (expr, _)})} ) -> (* @@ -832,482 +810,458 @@ and walk_value_binding vb t comments = vb with pvb_pat = { - constrained_pattern with + constrainedPattern with ppat_desc = Ppat_constraint (pat, typ); ppat_loc = - {constrained_pattern.ppat_loc with loc_end = t.ptyp_loc.loc_end}; + {constrainedPattern.ppat_loc with loc_end = t.ptyp_loc.loc_end}; }; pvb_expr = expr; } | _ -> vb in - let pattern_loc = vb.Parsetree.pvb_pat.ppat_loc in - let expr_loc = vb.Parsetree.pvb_expr.pexp_loc in + let patternLoc = vb.Parsetree.pvb_pat.ppat_loc in + let exprLoc = vb.Parsetree.pvb_expr.pexp_loc in let expr = vb.pvb_expr in - let leading, inside, trailing = partition_by_loc comments pattern_loc in + let leading, inside, trailing = partitionByLoc comments patternLoc in (* everything before start of pattern can only be leading on the pattern: * let |* before *| a = 1 *) - attach t.leading pattern_loc leading; - walk_pattern vb.Parsetree.pvb_pat t inside; - let after_pat, surrounding_expr = - partition_adjacent_trailing pattern_loc trailing + attach t.leading patternLoc leading; + walkPattern vb.Parsetree.pvb_pat t inside; + let afterPat, surroundingExpr = + partitionAdjacentTrailing patternLoc trailing in - attach t.trailing pattern_loc after_pat; - let before_expr, inside_expr, after_expr = - partition_by_loc surrounding_expr expr_loc + attach t.trailing patternLoc afterPat; + let beforeExpr, insideExpr, afterExpr = + partitionByLoc surroundingExpr exprLoc in - if is_block_expr expr then - walk_expression expr t (List.concat [before_expr; inside_expr; after_expr]) + if isBlockExpr expr then + walkExpression expr t (List.concat [beforeExpr; insideExpr; afterExpr]) else ( - attach t.leading expr_loc before_expr; - walk_expression expr t inside_expr; - attach t.trailing expr_loc after_expr) + attach t.leading exprLoc beforeExpr; + walkExpression expr t insideExpr; + attach t.trailing exprLoc afterExpr) -and walk_expression expr t comments = +and walkExpression expr t comments = let open Location in match expr.Parsetree.pexp_desc with | _ when comments = [] -> () | Pexp_constant _ -> - let leading, trailing = partition_leading_trailing comments expr.pexp_loc in + let leading, trailing = partitionLeadingTrailing comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; attach t.trailing expr.pexp_loc trailing | Pexp_ident longident -> - let leading, trailing = partition_leading_trailing comments longident.loc in + let leading, trailing = partitionLeadingTrailing comments longident.loc in attach t.leading longident.loc leading; attach t.trailing longident.loc trailing | Pexp_let ( _recFlag, - value_bindings, + valueBindings, {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None)} ) -> - walk_value_bindings value_bindings t comments - | Pexp_let (_recFlag, value_bindings, expr2) -> + walkValueBindings valueBindings t comments + | Pexp_let (_recFlag, valueBindings, expr2) -> let comments = - visit_list_but_continue_with_remaining_comments - ~get_loc:(fun n -> + visitListButContinueWithRemainingComments + ~getLoc:(fun n -> if n.Parsetree.pvb_pat.ppat_loc.loc_ghost then n.pvb_expr.pexp_loc else n.Parsetree.pvb_loc) - ~walk_node:walk_value_binding ~newline_delimited:true value_bindings t + ~walkNode:walkValueBinding ~newlineDelimited:true valueBindings t comments in - if is_block_expr expr2 then walk_expression expr2 t comments + if isBlockExpr expr2 then walkExpression expr2 t comments else - let leading, inside, trailing = - partition_by_loc comments expr2.pexp_loc - in + let leading, inside, trailing = partitionByLoc comments expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walk_expression expr2 t inside; + walkExpression expr2 t inside; attach t.trailing expr2.pexp_loc trailing | Pexp_sequence (expr1, expr2) -> - let leading, inside, trailing = partition_by_loc comments expr1.pexp_loc in + let leading, inside, trailing = partitionByLoc comments expr1.pexp_loc in let comments = - if is_block_expr expr1 then ( - let after_expr, comments = - partition_by_on_same_line expr1.pexp_loc trailing + if isBlockExpr expr1 then ( + let afterExpr, comments = + partitionByOnSameLine expr1.pexp_loc trailing in - walk_expression expr1 t (List.concat [leading; inside; after_expr]); + walkExpression expr1 t (List.concat [leading; inside; afterExpr]); comments) else ( attach t.leading expr1.pexp_loc leading; - walk_expression expr1 t inside; - let after_expr, comments = - partition_by_on_same_line expr1.pexp_loc trailing + walkExpression expr1 t inside; + let afterExpr, comments = + partitionByOnSameLine expr1.pexp_loc trailing in - attach t.trailing expr1.pexp_loc after_expr; + attach t.trailing expr1.pexp_loc afterExpr; comments) in - if is_block_expr expr2 then walk_expression expr2 t comments + if isBlockExpr expr2 then walkExpression expr2 t comments else - let leading, inside, trailing = - partition_by_loc comments expr2.pexp_loc - in + let leading, inside, trailing = partitionByLoc comments expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walk_expression expr2 t inside; + walkExpression expr2 t inside; attach t.trailing expr2.pexp_loc trailing | Pexp_open (_override, longident, expr2) -> - let leading, comments = partition_leading_trailing comments expr.pexp_loc in + let leading, comments = partitionLeadingTrailing comments expr.pexp_loc in attach t.leading {expr.pexp_loc with loc_end = longident.loc.loc_end} leading; - let leading, trailing = partition_leading_trailing comments longident.loc in + let leading, trailing = partitionLeadingTrailing comments longident.loc in attach t.leading longident.loc leading; - let after_longident, rest = - partition_by_on_same_line longident.loc trailing - in - attach t.trailing longident.loc after_longident; - if is_block_expr expr2 then walk_expression expr2 t rest + let afterLongident, rest = partitionByOnSameLine longident.loc trailing in + attach t.trailing longident.loc afterLongident; + if isBlockExpr expr2 then walkExpression expr2 t rest else - let leading, inside, trailing = partition_by_loc rest expr2.pexp_loc in + let leading, inside, trailing = partitionByLoc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walk_expression expr2 t inside; + walkExpression expr2 t inside; attach t.trailing expr2.pexp_loc trailing | Pexp_extension - ( {txt = "obj"}, + ( {txt = "bs.obj" | "obj"}, PStr [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_record (rows, _)}, [])}] ) -> - walk_list + walkList (rows |> List.map (fun (li, e) -> ExprRecordRow (li, e))) t comments - | Pexp_extension extension -> walk_extension extension t comments - | Pexp_letexception (extension_constructor, expr2) -> - let leading, comments = partition_leading_trailing comments expr.pexp_loc in + | Pexp_extension extension -> walkExtension extension t comments + | Pexp_letexception (extensionConstructor, expr2) -> + let leading, comments = partitionLeadingTrailing comments expr.pexp_loc in attach t.leading - {expr.pexp_loc with loc_end = extension_constructor.pext_loc.loc_end} + {expr.pexp_loc with loc_end = extensionConstructor.pext_loc.loc_end} leading; let leading, inside, trailing = - partition_by_loc comments extension_constructor.pext_loc + partitionByLoc comments extensionConstructor.pext_loc in - attach t.leading extension_constructor.pext_loc leading; - walk_extension_constructor extension_constructor t inside; - let after_ext_constr, rest = - partition_by_on_same_line extension_constructor.pext_loc trailing + attach t.leading extensionConstructor.pext_loc leading; + walkExtensionConstructor extensionConstructor t inside; + let afterExtConstr, rest = + partitionByOnSameLine extensionConstructor.pext_loc trailing in - attach t.trailing extension_constructor.pext_loc after_ext_constr; - if is_block_expr expr2 then walk_expression expr2 t rest + attach t.trailing extensionConstructor.pext_loc afterExtConstr; + if isBlockExpr expr2 then walkExpression expr2 t rest else - let leading, inside, trailing = partition_by_loc rest expr2.pexp_loc in + let leading, inside, trailing = partitionByLoc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walk_expression expr2 t inside; + walkExpression expr2 t inside; attach t.trailing expr2.pexp_loc trailing - | Pexp_letmodule (string_loc, mod_expr, expr2) -> - let leading, comments = partition_leading_trailing comments expr.pexp_loc in + | Pexp_letmodule (stringLoc, modExpr, expr2) -> + let leading, comments = partitionLeadingTrailing comments expr.pexp_loc in attach t.leading - {expr.pexp_loc with loc_end = mod_expr.pmod_loc.loc_end} + {expr.pexp_loc with loc_end = modExpr.pmod_loc.loc_end} leading; - let leading, trailing = - partition_leading_trailing comments string_loc.loc - in - attach t.leading string_loc.loc leading; - let after_string, rest = - partition_adjacent_trailing string_loc.loc trailing - in - attach t.trailing string_loc.loc after_string; - let before_mod_expr, inside_mod_expr, after_mod_expr = - partition_by_loc rest mod_expr.pmod_loc + let leading, trailing = partitionLeadingTrailing comments stringLoc.loc in + attach t.leading stringLoc.loc leading; + let afterString, rest = partitionAdjacentTrailing stringLoc.loc trailing in + attach t.trailing stringLoc.loc afterString; + let beforeModExpr, insideModExpr, afterModExpr = + partitionByLoc rest modExpr.pmod_loc in - attach t.leading mod_expr.pmod_loc before_mod_expr; - walk_module_expr mod_expr t inside_mod_expr; - let after_mod_expr, rest = - partition_by_on_same_line mod_expr.pmod_loc after_mod_expr + attach t.leading modExpr.pmod_loc beforeModExpr; + walkModuleExpr modExpr t insideModExpr; + let afterModExpr, rest = + partitionByOnSameLine modExpr.pmod_loc afterModExpr in - attach t.trailing mod_expr.pmod_loc after_mod_expr; - if is_block_expr expr2 then walk_expression expr2 t rest + attach t.trailing modExpr.pmod_loc afterModExpr; + if isBlockExpr expr2 then walkExpression expr2 t rest else - let leading, inside, trailing = partition_by_loc rest expr2.pexp_loc in + let leading, inside, trailing = partitionByLoc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walk_expression expr2 t inside; + walkExpression expr2 t inside; attach t.trailing expr2.pexp_loc trailing | Pexp_assert expr | Pexp_lazy expr -> - if is_block_expr expr then walk_expression expr t comments + if isBlockExpr expr then walkExpression expr t comments else - let leading, inside, trailing = partition_by_loc comments expr.pexp_loc in + let leading, inside, trailing = partitionByLoc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walk_expression expr t inside; + walkExpression expr t inside; attach t.trailing expr.pexp_loc trailing - | Pexp_coerce (expr, opt_typexpr, typexpr) -> - let leading, inside, trailing = partition_by_loc comments expr.pexp_loc in + | Pexp_coerce (expr, optTypexpr, typexpr) -> + let leading, inside, trailing = partitionByLoc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walk_expression expr t inside; - let after_expr, rest = partition_adjacent_trailing expr.pexp_loc trailing in - attach t.trailing expr.pexp_loc after_expr; + walkExpression expr t inside; + let afterExpr, rest = partitionAdjacentTrailing expr.pexp_loc trailing in + attach t.trailing expr.pexp_loc afterExpr; let rest = - match opt_typexpr with + match optTypexpr with | Some typexpr -> let leading, inside, trailing = - partition_by_loc comments typexpr.ptyp_loc + partitionByLoc comments typexpr.ptyp_loc in attach t.leading typexpr.ptyp_loc leading; - walk_core_type typexpr t inside; - let after_typ, rest = - partition_adjacent_trailing typexpr.ptyp_loc trailing + walkCoreType typexpr t inside; + let afterTyp, rest = + partitionAdjacentTrailing typexpr.ptyp_loc trailing in - attach t.trailing typexpr.ptyp_loc after_typ; + attach t.trailing typexpr.ptyp_loc afterTyp; rest | None -> rest in - let leading, inside, trailing = partition_by_loc rest typexpr.ptyp_loc in + let leading, inside, trailing = partitionByLoc rest typexpr.ptyp_loc in attach t.leading typexpr.ptyp_loc leading; - walk_core_type typexpr t inside; + walkCoreType typexpr t inside; attach t.trailing typexpr.ptyp_loc trailing | Pexp_constraint (expr, typexpr) -> - let leading, inside, trailing = partition_by_loc comments expr.pexp_loc in + let leading, inside, trailing = partitionByLoc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walk_expression expr t inside; - let after_expr, rest = partition_adjacent_trailing expr.pexp_loc trailing in - attach t.trailing expr.pexp_loc after_expr; - let leading, inside, trailing = partition_by_loc rest typexpr.ptyp_loc in + walkExpression expr t inside; + let afterExpr, rest = partitionAdjacentTrailing expr.pexp_loc trailing in + attach t.trailing expr.pexp_loc afterExpr; + let leading, inside, trailing = partitionByLoc rest typexpr.ptyp_loc in attach t.leading typexpr.ptyp_loc leading; - walk_core_type typexpr t inside; + walkCoreType typexpr t inside; attach t.trailing typexpr.ptyp_loc trailing | Pexp_tuple [] | Pexp_array [] | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> attach t.inside expr.pexp_loc comments | Pexp_construct ({txt = Longident.Lident "::"}, _) -> - walk_list - (collect_list_exprs [] expr |> List.map (fun e -> Expression e)) + walkList + (collectListExprs [] expr |> List.map (fun e -> Expression e)) t comments | Pexp_construct (longident, args) -> ( - let leading, trailing = partition_leading_trailing comments longident.loc in + let leading, trailing = partitionLeadingTrailing comments longident.loc in attach t.leading longident.loc leading; match args with | Some expr -> - let after_longident, rest = - partition_adjacent_trailing longident.loc trailing + let afterLongident, rest = + partitionAdjacentTrailing longident.loc trailing in - attach t.trailing longident.loc after_longident; - walk_expression expr t rest + attach t.trailing longident.loc afterLongident; + walkExpression expr t rest | None -> attach t.trailing longident.loc trailing) | Pexp_variant (_label, None) -> () - | Pexp_variant (_label, Some expr) -> walk_expression expr t comments + | Pexp_variant (_label, Some expr) -> walkExpression expr t comments | Pexp_array exprs | Pexp_tuple exprs -> - walk_list (exprs |> List.map (fun e -> Expression e)) t comments - | Pexp_record (rows, spread_expr) -> + walkList (exprs |> List.map (fun e -> Expression e)) t comments + | Pexp_record (rows, spreadExpr) -> if rows = [] then attach t.inside expr.pexp_loc comments else let comments = - match spread_expr with + match spreadExpr with | None -> comments | Some expr -> let leading, inside, trailing = - partition_by_loc comments expr.pexp_loc + partitionByLoc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walk_expression expr t inside; - let after_expr, rest = - partition_adjacent_trailing expr.pexp_loc trailing + walkExpression expr t inside; + let afterExpr, rest = + partitionAdjacentTrailing expr.pexp_loc trailing in - attach t.trailing expr.pexp_loc after_expr; + attach t.trailing expr.pexp_loc afterExpr; rest in - walk_list + walkList (rows |> List.map (fun (li, e) -> ExprRecordRow (li, e))) t comments | Pexp_field (expr, longident) -> - let leading, inside, trailing = partition_by_loc comments expr.pexp_loc in + let leading, inside, trailing = partitionByLoc comments expr.pexp_loc in let trailing = - if is_block_expr expr then ( - let after_expr, rest = - partition_adjacent_trailing expr.pexp_loc trailing + if isBlockExpr expr then ( + let afterExpr, rest = + partitionAdjacentTrailing expr.pexp_loc trailing in - walk_expression expr t (List.concat [leading; inside; after_expr]); + walkExpression expr t (List.concat [leading; inside; afterExpr]); rest) else ( attach t.leading expr.pexp_loc leading; - walk_expression expr t inside; + walkExpression expr t inside; trailing) in - let after_expr, rest = partition_adjacent_trailing expr.pexp_loc trailing in - attach t.trailing expr.pexp_loc after_expr; - let leading, trailing = partition_leading_trailing rest longident.loc in + let afterExpr, rest = partitionAdjacentTrailing expr.pexp_loc trailing in + attach t.trailing expr.pexp_loc afterExpr; + let leading, trailing = partitionLeadingTrailing rest longident.loc in attach t.leading longident.loc leading; attach t.trailing longident.loc trailing | Pexp_setfield (expr1, longident, expr2) -> - let leading, inside, trailing = partition_by_loc comments expr1.pexp_loc in + let leading, inside, trailing = partitionByLoc comments expr1.pexp_loc in let rest = - if is_block_expr expr1 then ( - let after_expr, rest = - partition_adjacent_trailing expr1.pexp_loc trailing + if isBlockExpr expr1 then ( + let afterExpr, rest = + partitionAdjacentTrailing expr1.pexp_loc trailing in - walk_expression expr1 t (List.concat [leading; inside; after_expr]); + walkExpression expr1 t (List.concat [leading; inside; afterExpr]); rest) else - let after_expr, rest = - partition_adjacent_trailing expr1.pexp_loc trailing + let afterExpr, rest = + partitionAdjacentTrailing expr1.pexp_loc trailing in attach t.leading expr1.pexp_loc leading; - walk_expression expr1 t inside; - attach t.trailing expr1.pexp_loc after_expr; + walkExpression expr1 t inside; + attach t.trailing expr1.pexp_loc afterExpr; rest in - let before_longident, after_longident = - partition_leading_trailing rest longident.loc + let beforeLongident, afterLongident = + partitionLeadingTrailing rest longident.loc in - attach t.leading longident.loc before_longident; - let after_longident, rest = - partition_adjacent_trailing longident.loc after_longident + attach t.leading longident.loc beforeLongident; + let afterLongident, rest = + partitionAdjacentTrailing longident.loc afterLongident in - attach t.trailing longident.loc after_longident; - if is_block_expr expr2 then walk_expression expr2 t rest + attach t.trailing longident.loc afterLongident; + if isBlockExpr expr2 then walkExpression expr2 t rest else - let leading, inside, trailing = partition_by_loc rest expr2.pexp_loc in + let leading, inside, trailing = partitionByLoc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walk_expression expr2 t inside; + walkExpression expr2 t inside; attach t.trailing expr2.pexp_loc trailing - | Pexp_ifthenelse (if_expr, then_expr, else_expr) -> ( - let leading, rest = partition_leading_trailing comments expr.pexp_loc in + | Pexp_ifthenelse (ifExpr, thenExpr, elseExpr) -> ( + let leading, rest = partitionLeadingTrailing comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - let leading, inside, trailing = partition_by_loc rest if_expr.pexp_loc in + let leading, inside, trailing = partitionByLoc rest ifExpr.pexp_loc in let comments = - if is_block_expr if_expr then ( - let after_expr, comments = - partition_adjacent_trailing if_expr.pexp_loc trailing + if isBlockExpr ifExpr then ( + let afterExpr, comments = + partitionAdjacentTrailing ifExpr.pexp_loc trailing in - walk_expression if_expr t (List.concat [leading; inside; after_expr]); + walkExpression ifExpr t (List.concat [leading; inside; afterExpr]); comments) else ( - attach t.leading if_expr.pexp_loc leading; - walk_expression if_expr t inside; - let after_expr, comments = - partition_adjacent_trailing if_expr.pexp_loc trailing + attach t.leading ifExpr.pexp_loc leading; + walkExpression ifExpr t inside; + let afterExpr, comments = + partitionAdjacentTrailing ifExpr.pexp_loc trailing in - attach t.trailing if_expr.pexp_loc after_expr; + attach t.trailing ifExpr.pexp_loc afterExpr; comments) in - let leading, inside, trailing = - partition_by_loc comments then_expr.pexp_loc - in + let leading, inside, trailing = partitionByLoc comments thenExpr.pexp_loc in let comments = - if is_block_expr then_expr then ( - let after_expr, trailing = - partition_adjacent_trailing then_expr.pexp_loc trailing + if isBlockExpr thenExpr then ( + let afterExpr, trailing = + partitionAdjacentTrailing thenExpr.pexp_loc trailing in - walk_expression then_expr t (List.concat [leading; inside; after_expr]); + walkExpression thenExpr t (List.concat [leading; inside; afterExpr]); trailing) else ( - attach t.leading then_expr.pexp_loc leading; - walk_expression then_expr t inside; - let after_expr, comments = - partition_adjacent_trailing then_expr.pexp_loc trailing + attach t.leading thenExpr.pexp_loc leading; + walkExpression thenExpr t inside; + let afterExpr, comments = + partitionAdjacentTrailing thenExpr.pexp_loc trailing in - attach t.trailing then_expr.pexp_loc after_expr; + attach t.trailing thenExpr.pexp_loc afterExpr; comments) in - match else_expr with + match elseExpr with | None -> () | Some expr -> - if is_block_expr expr || is_if_then_else_expr expr then - walk_expression expr t comments + if isBlockExpr expr || isIfThenElseExpr expr then + walkExpression expr t comments else - let leading, inside, trailing = - partition_by_loc comments expr.pexp_loc - in + let leading, inside, trailing = partitionByLoc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walk_expression expr t inside; + walkExpression expr t inside; attach t.trailing expr.pexp_loc trailing) | Pexp_while (expr1, expr2) -> - let leading, inside, trailing = partition_by_loc comments expr1.pexp_loc in + let leading, inside, trailing = partitionByLoc comments expr1.pexp_loc in let rest = - if is_block_expr expr1 then ( - let after_expr, rest = - partition_adjacent_trailing expr1.pexp_loc trailing + if isBlockExpr expr1 then ( + let afterExpr, rest = + partitionAdjacentTrailing expr1.pexp_loc trailing in - walk_expression expr1 t (List.concat [leading; inside; after_expr]); + walkExpression expr1 t (List.concat [leading; inside; afterExpr]); rest) else ( attach t.leading expr1.pexp_loc leading; - walk_expression expr1 t inside; - let after_expr, rest = - partition_adjacent_trailing expr1.pexp_loc trailing + walkExpression expr1 t inside; + let afterExpr, rest = + partitionAdjacentTrailing expr1.pexp_loc trailing in - attach t.trailing expr1.pexp_loc after_expr; + attach t.trailing expr1.pexp_loc afterExpr; rest) in - if is_block_expr expr2 then walk_expression expr2 t rest + if isBlockExpr expr2 then walkExpression expr2 t rest else - let leading, inside, trailing = partition_by_loc rest expr2.pexp_loc in + let leading, inside, trailing = partitionByLoc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walk_expression expr2 t inside; + walkExpression expr2 t inside; attach t.trailing expr2.pexp_loc trailing | Pexp_for (pat, expr1, expr2, _, expr3) -> - let leading, inside, trailing = partition_by_loc comments pat.ppat_loc in + let leading, inside, trailing = partitionByLoc comments pat.ppat_loc in attach t.leading pat.ppat_loc leading; - walk_pattern pat t inside; - let after_pat, rest = partition_adjacent_trailing pat.ppat_loc trailing in - attach t.trailing pat.ppat_loc after_pat; - let leading, inside, trailing = partition_by_loc rest expr1.pexp_loc in + walkPattern pat t inside; + let afterPat, rest = partitionAdjacentTrailing pat.ppat_loc trailing in + attach t.trailing pat.ppat_loc afterPat; + let leading, inside, trailing = partitionByLoc rest expr1.pexp_loc in attach t.leading expr1.pexp_loc leading; - walk_expression expr1 t inside; - let after_expr, rest = - partition_adjacent_trailing expr1.pexp_loc trailing - in - attach t.trailing expr1.pexp_loc after_expr; - let leading, inside, trailing = partition_by_loc rest expr2.pexp_loc in + walkExpression expr1 t inside; + let afterExpr, rest = partitionAdjacentTrailing expr1.pexp_loc trailing in + attach t.trailing expr1.pexp_loc afterExpr; + let leading, inside, trailing = partitionByLoc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walk_expression expr2 t inside; - let after_expr, rest = - partition_adjacent_trailing expr2.pexp_loc trailing - in - attach t.trailing expr2.pexp_loc after_expr; - if is_block_expr expr3 then walk_expression expr3 t rest + walkExpression expr2 t inside; + let afterExpr, rest = partitionAdjacentTrailing expr2.pexp_loc trailing in + attach t.trailing expr2.pexp_loc afterExpr; + if isBlockExpr expr3 then walkExpression expr3 t rest else - let leading, inside, trailing = partition_by_loc rest expr3.pexp_loc in + let leading, inside, trailing = partitionByLoc rest expr3.pexp_loc in attach t.leading expr3.pexp_loc leading; - walk_expression expr3 t inside; + walkExpression expr3 t inside; attach t.trailing expr3.pexp_loc trailing - | Pexp_pack mod_expr -> - let before, inside, after = partition_by_loc comments mod_expr.pmod_loc in - attach t.leading mod_expr.pmod_loc before; - walk_module_expr mod_expr t inside; - attach t.trailing mod_expr.pmod_loc after - | Pexp_match (expr1, [case; else_branch]) - when Res_parsetree_viewer.has_if_let_attribute expr.pexp_attributes -> - let before, inside, after = - partition_by_loc comments case.pc_lhs.ppat_loc - in + | Pexp_pack modExpr -> + let before, inside, after = partitionByLoc comments modExpr.pmod_loc in + attach t.leading modExpr.pmod_loc before; + walkModuleExpr modExpr t inside; + attach t.trailing modExpr.pmod_loc after + | Pexp_match (expr1, [case; elseBranch]) + when Res_parsetree_viewer.hasIfLetAttribute expr.pexp_attributes -> + let before, inside, after = partitionByLoc comments case.pc_lhs.ppat_loc in attach t.leading case.pc_lhs.ppat_loc before; - walk_pattern case.pc_lhs t inside; - let after_pat, rest = - partition_adjacent_trailing case.pc_lhs.ppat_loc after - in - attach t.trailing case.pc_lhs.ppat_loc after_pat; - let before, inside, after = partition_by_loc rest expr1.pexp_loc in + walkPattern case.pc_lhs t inside; + let afterPat, rest = partitionAdjacentTrailing case.pc_lhs.ppat_loc after in + attach t.trailing case.pc_lhs.ppat_loc afterPat; + let before, inside, after = partitionByLoc rest expr1.pexp_loc in attach t.leading expr1.pexp_loc before; - walk_expression expr1 t inside; - let after_expr, rest = partition_adjacent_trailing expr1.pexp_loc after in - attach t.trailing expr1.pexp_loc after_expr; - let before, inside, after = partition_by_loc rest case.pc_rhs.pexp_loc in + walkExpression expr1 t inside; + let afterExpr, rest = partitionAdjacentTrailing expr1.pexp_loc after in + attach t.trailing expr1.pexp_loc afterExpr; + let before, inside, after = partitionByLoc rest case.pc_rhs.pexp_loc in let after = - if is_block_expr case.pc_rhs then ( - let after_expr, rest = - partition_adjacent_trailing case.pc_rhs.pexp_loc after + if isBlockExpr case.pc_rhs then ( + let afterExpr, rest = + partitionAdjacentTrailing case.pc_rhs.pexp_loc after in - walk_expression case.pc_rhs t (List.concat [before; inside; after_expr]); + walkExpression case.pc_rhs t (List.concat [before; inside; afterExpr]); rest) else ( attach t.leading case.pc_rhs.pexp_loc before; - walk_expression case.pc_rhs t inside; + walkExpression case.pc_rhs t inside; after) in - let after_expr, rest = - partition_adjacent_trailing case.pc_rhs.pexp_loc after + let afterExpr, rest = + partitionAdjacentTrailing case.pc_rhs.pexp_loc after in - attach t.trailing case.pc_rhs.pexp_loc after_expr; + attach t.trailing case.pc_rhs.pexp_loc afterExpr; let before, inside, after = - partition_by_loc rest else_branch.pc_rhs.pexp_loc + partitionByLoc rest elseBranch.pc_rhs.pexp_loc in let after = - if is_block_expr else_branch.pc_rhs then ( - let after_expr, rest = - partition_adjacent_trailing else_branch.pc_rhs.pexp_loc after + if isBlockExpr elseBranch.pc_rhs then ( + let afterExpr, rest = + partitionAdjacentTrailing elseBranch.pc_rhs.pexp_loc after in - walk_expression else_branch.pc_rhs t - (List.concat [before; inside; after_expr]); + walkExpression elseBranch.pc_rhs t + (List.concat [before; inside; afterExpr]); rest) else ( - attach t.leading else_branch.pc_rhs.pexp_loc before; - walk_expression else_branch.pc_rhs t inside; + attach t.leading elseBranch.pc_rhs.pexp_loc before; + walkExpression elseBranch.pc_rhs t inside; after) in - attach t.trailing else_branch.pc_rhs.pexp_loc after + attach t.trailing elseBranch.pc_rhs.pexp_loc after | Pexp_match (expr, cases) | Pexp_try (expr, cases) -> - let before, inside, after = partition_by_loc comments expr.pexp_loc in + let before, inside, after = partitionByLoc comments expr.pexp_loc in let after = - if is_block_expr expr then ( - let after_expr, rest = - partition_adjacent_trailing expr.pexp_loc after - in - walk_expression expr t (List.concat [before; inside; after_expr]); + if isBlockExpr expr then ( + let afterExpr, rest = partitionAdjacentTrailing expr.pexp_loc after in + walkExpression expr t (List.concat [before; inside; afterExpr]); rest) else ( attach t.leading expr.pexp_loc before; - walk_expression expr t inside; + walkExpression expr t inside; after) in - let after_expr, rest = partition_adjacent_trailing expr.pexp_loc after in - attach t.trailing expr.pexp_loc after_expr; - walk_list (cases |> List.map (fun case -> Case case)) t rest + let afterExpr, rest = partitionAdjacentTrailing expr.pexp_loc after in + attach t.trailing expr.pexp_loc afterExpr; + walkList (cases |> List.map (fun case -> Case case)) t rest (* unary expression: todo use parsetreeviewer *) | Pexp_apply ( { @@ -1318,11 +1272,11 @@ and walk_expression expr t comments = Longident.Lident ("~+" | "~+." | "~-" | "~-." | "not" | "!"); }; }, - [(Nolabel, arg_expr)] ) -> - let before, inside, after = partition_by_loc comments arg_expr.pexp_loc in - attach t.leading arg_expr.pexp_loc before; - walk_expression arg_expr t inside; - attach t.trailing arg_expr.pexp_loc after + [(Nolabel, argExpr)] ) -> + let before, inside, after = partitionByLoc comments argExpr.pexp_loc in + attach t.leading argExpr.pexp_loc before; + walkExpression argExpr t inside; + attach t.trailing argExpr.pexp_loc after (* binary expression *) | Pexp_apply ( { @@ -1337,44 +1291,44 @@ and walk_expression expr t comments = }; }, [(Nolabel, operand1); (Nolabel, operand2)] ) -> - let before, inside, after = partition_by_loc comments operand1.pexp_loc in + let before, inside, after = partitionByLoc comments operand1.pexp_loc in attach t.leading operand1.pexp_loc before; - walk_expression operand1 t inside; - let after_operand1, rest = - partition_adjacent_trailing operand1.pexp_loc after + walkExpression operand1 t inside; + let afterOperand1, rest = + partitionAdjacentTrailing operand1.pexp_loc after in - attach t.trailing operand1.pexp_loc after_operand1; - let before, inside, after = partition_by_loc rest operand2.pexp_loc in + attach t.trailing operand1.pexp_loc afterOperand1; + let before, inside, after = partitionByLoc rest operand2.pexp_loc in attach t.leading operand2.pexp_loc before; - walk_expression operand2 t inside; + walkExpression operand2 t inside; (* (List.concat [inside; after]); *) attach t.trailing operand2.pexp_loc after | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}}, - [(Nolabel, parent_expr); (Nolabel, member_expr)] ) -> - walk_list [Expression parent_expr; Expression member_expr] t comments + [(Nolabel, parentExpr); (Nolabel, memberExpr)] ) -> + walkList [Expression parentExpr; Expression memberExpr] t comments | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "set")}}, - [(Nolabel, parent_expr); (Nolabel, member_expr); (Nolabel, target_expr)] - ) -> - walk_list - [Expression parent_expr; Expression member_expr; Expression target_expr] + [(Nolabel, parentExpr); (Nolabel, memberExpr); (Nolabel, targetExpr)] ) + -> + walkList + [Expression parentExpr; Expression memberExpr; Expression targetExpr] t comments - | Pexp_apply (call_expr, arguments) -> - let before, inside, after = partition_by_loc comments call_expr.pexp_loc in + | Pexp_apply (callExpr, arguments) -> + let before, inside, after = partitionByLoc comments callExpr.pexp_loc in let after = - if is_block_expr call_expr then ( - let after_expr, rest = - partition_adjacent_trailing call_expr.pexp_loc after + if isBlockExpr callExpr then ( + let afterExpr, rest = + partitionAdjacentTrailing callExpr.pexp_loc after in - walk_expression call_expr t (List.concat [before; inside; after_expr]); + walkExpression callExpr t (List.concat [before; inside; afterExpr]); rest) else ( - attach t.leading call_expr.pexp_loc before; - walk_expression call_expr t inside; + attach t.leading callExpr.pexp_loc before; + walkExpression callExpr t inside; after) in - if ParsetreeViewer.is_jsx_expression expr then ( + if ParsetreeViewer.isJsxExpression expr then ( let props = arguments |> List.filter (fun (label, _) -> @@ -1383,16 +1337,16 @@ and walk_expression expr t comments = | Asttypes.Nolabel -> false | _ -> true) in - let maybe_children = + let maybeChildren = arguments |> List.find_opt (fun (label, _) -> label = Asttypes.Labelled "children") in - match maybe_children with + match maybeChildren with (* There is no need to deal with this situation as the children cannot be NONE *) | None -> () | Some (_, children) -> - let leading, inside, _ = partition_by_loc after children.pexp_loc in + let leading, inside, _ = partitionByLoc after children.pexp_loc in if props = [] then (* All comments inside a tag are trailing comments of the tag if there are no props *) - let after_expr, _ = - partition_adjacent_trailing call_expr.pexp_loc after + let afterExpr, _ = + partitionAdjacentTrailing callExpr.pexp_loc after in - attach t.trailing call_expr.pexp_loc after_expr + attach t.trailing callExpr.pexp_loc afterExpr else - walk_list (props |> List.map (fun (_, e) -> ExprArgument e)) t leading; - walk_expression children t inside) + walkList (props |> List.map (fun (_, e) -> ExprArgument e)) t leading; + walkExpression children t inside) else - let after_expr, rest = - partition_adjacent_trailing call_expr.pexp_loc after - in - attach t.trailing call_expr.pexp_loc after_expr; - walk_list (arguments |> List.map (fun (_, e) -> ExprArgument e)) t rest + let afterExpr, rest = partitionAdjacentTrailing callExpr.pexp_loc after in + attach t.trailing callExpr.pexp_loc afterExpr; + walkList (arguments |> List.map (fun (_, e) -> ExprArgument e)) t rest | Pexp_fun (_, _, _, _) | Pexp_newtype _ -> ( - let _, parameters, return_expr = fun_expr expr in + let _, parameters, returnExpr = funExpr expr in let comments = - visit_list_but_continue_with_remaining_comments ~newline_delimited:false - ~walk_node:walk_expr_pararameter - ~get_loc:(fun (_attrs, _argLbl, expr_opt, pattern) -> + visitListButContinueWithRemainingComments ~newlineDelimited:false + ~walkNode:walkExprPararameter + ~getLoc:(fun (_attrs, _argLbl, exprOpt, pattern) -> let open Parsetree in - let start_pos = + let startPos = match pattern.ppat_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs -> loc.loc_start | _ -> pattern.ppat_loc.loc_start in - match expr_opt with - | None -> {pattern.ppat_loc with loc_start = start_pos} + match exprOpt with + | None -> {pattern.ppat_loc with loc_start = startPos} | Some expr -> { pattern.ppat_loc with - loc_start = start_pos; + loc_start = startPos; loc_end = expr.pexp_loc.loc_end; }) parameters t comments in - match return_expr.pexp_desc with + match returnExpr.pexp_desc with | Pexp_constraint (expr, typ) when expr.pexp_loc.loc_start.pos_cnum >= typ.ptyp_loc.loc_end.pos_cnum -> - let leading, inside, trailing = partition_by_loc comments typ.ptyp_loc in + let leading, inside, trailing = partitionByLoc comments typ.ptyp_loc in attach t.leading typ.ptyp_loc leading; - walk_core_type typ t inside; - let after_typ, comments = - partition_adjacent_trailing typ.ptyp_loc trailing + walkCoreType typ t inside; + let afterTyp, comments = + partitionAdjacentTrailing typ.ptyp_loc trailing in - attach t.trailing typ.ptyp_loc after_typ; - if is_block_expr expr then walk_expression expr t comments + attach t.trailing typ.ptyp_loc afterTyp; + if isBlockExpr expr then walkExpression expr t comments else - let leading, inside, trailing = - partition_by_loc comments expr.pexp_loc - in + let leading, inside, trailing = partitionByLoc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walk_expression expr t inside; + walkExpression expr t inside; attach t.trailing expr.pexp_loc trailing + | Pexp_construct ({txt = Longident.Lident "Function$"}, Some returnExpr) -> + walkExpression returnExpr t comments | _ -> - if is_block_expr return_expr then walk_expression return_expr t comments + if isBlockExpr returnExpr then walkExpression returnExpr t comments else let leading, inside, trailing = - partition_by_loc comments return_expr.pexp_loc + partitionByLoc comments returnExpr.pexp_loc in - attach t.leading return_expr.pexp_loc leading; - walk_expression return_expr t inside; - attach t.trailing return_expr.pexp_loc trailing) + attach t.leading returnExpr.pexp_loc leading; + walkExpression returnExpr t inside; + attach t.trailing returnExpr.pexp_loc trailing) | _ -> () -and walk_expr_pararameter (_attrs, _argLbl, expr_opt, pattern) t comments = - let leading, inside, trailing = partition_by_loc comments pattern.ppat_loc in +and walkExprPararameter (_attrs, _argLbl, exprOpt, pattern) t comments = + let leading, inside, trailing = partitionByLoc comments pattern.ppat_loc in attach t.leading pattern.ppat_loc leading; - walk_pattern pattern t inside; - match expr_opt with + walkPattern pattern t inside; + match exprOpt with | Some expr -> - let _afterPat, rest = - partition_adjacent_trailing pattern.ppat_loc trailing - in + let _afterPat, rest = partitionAdjacentTrailing pattern.ppat_loc trailing in attach t.trailing pattern.ppat_loc trailing; - if is_block_expr expr then walk_expression expr t rest + if isBlockExpr expr then walkExpression expr t rest else - let leading, inside, trailing = partition_by_loc rest expr.pexp_loc in + let leading, inside, trailing = partitionByLoc rest expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walk_expression expr t inside; + walkExpression expr t inside; attach t.trailing expr.pexp_loc trailing | None -> attach t.trailing pattern.ppat_loc trailing -and walk_expr_argument expr t comments = +and walkExprArgument expr t comments = match expr.Parsetree.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs -> - let leading, trailing = partition_leading_trailing comments loc in + let leading, trailing = partitionLeadingTrailing comments loc in attach t.leading loc leading; - let after_label, rest = partition_adjacent_trailing loc trailing in - attach t.trailing loc after_label; - let before, inside, after = partition_by_loc rest expr.pexp_loc in + let afterLabel, rest = partitionAdjacentTrailing loc trailing in + attach t.trailing loc afterLabel; + let before, inside, after = partitionByLoc rest expr.pexp_loc in attach t.leading expr.pexp_loc before; - walk_expression expr t inside; + walkExpression expr t inside; attach t.trailing expr.pexp_loc after | _ -> - let before, inside, after = partition_by_loc comments expr.pexp_loc in + let before, inside, after = partitionByLoc comments expr.pexp_loc in attach t.leading expr.pexp_loc before; - walk_expression expr t inside; + walkExpression expr t inside; attach t.trailing expr.pexp_loc after -and walk_case (case : Parsetree.case) t comments = - let before, inside, after = partition_by_loc comments case.pc_lhs.ppat_loc in +and walkCase (case : Parsetree.case) t comments = + let before, inside, after = partitionByLoc comments case.pc_lhs.ppat_loc in (* cases don't have a location on their own, leading comments should go * after the bar on the pattern *) - walk_pattern case.pc_lhs t (List.concat [before; inside]); - let after_pat, rest = - partition_adjacent_trailing case.pc_lhs.ppat_loc after - in - attach t.trailing case.pc_lhs.ppat_loc after_pat; + walkPattern case.pc_lhs t (List.concat [before; inside]); + let afterPat, rest = partitionAdjacentTrailing case.pc_lhs.ppat_loc after in + attach t.trailing case.pc_lhs.ppat_loc afterPat; let comments = match case.pc_guard with | Some expr -> - let before, inside, after = partition_by_loc rest expr.pexp_loc in - let after_expr, rest = partition_adjacent_trailing expr.pexp_loc after in - if is_block_expr expr then - walk_expression expr t (List.concat [before; inside; after_expr]) + let before, inside, after = partitionByLoc rest expr.pexp_loc in + let afterExpr, rest = partitionAdjacentTrailing expr.pexp_loc after in + if isBlockExpr expr then + walkExpression expr t (List.concat [before; inside; afterExpr]) else ( attach t.leading expr.pexp_loc before; - walk_expression expr t inside; - attach t.trailing expr.pexp_loc after_expr); + walkExpression expr t inside; + attach t.trailing expr.pexp_loc afterExpr); rest | None -> rest in - if is_block_expr case.pc_rhs then walk_expression case.pc_rhs t comments + if isBlockExpr case.pc_rhs then walkExpression case.pc_rhs t comments else - let before, inside, after = - partition_by_loc comments case.pc_rhs.pexp_loc - in + let before, inside, after = partitionByLoc comments case.pc_rhs.pexp_loc in attach t.leading case.pc_rhs.pexp_loc before; - walk_expression case.pc_rhs t inside; + walkExpression case.pc_rhs t inside; attach t.trailing case.pc_rhs.pexp_loc after -and walk_expr_record_row (longident, expr) t comments = - let before_longident, after_longident = - partition_leading_trailing comments longident.loc +and walkExprRecordRow (longident, expr) t comments = + let beforeLongident, afterLongident = + partitionLeadingTrailing comments longident.loc in - attach t.leading longident.loc before_longident; - let after_longident, rest = - partition_adjacent_trailing longident.loc after_longident + attach t.leading longident.loc beforeLongident; + let afterLongident, rest = + partitionAdjacentTrailing longident.loc afterLongident in - attach t.trailing longident.loc after_longident; - let leading, inside, trailing = partition_by_loc rest expr.pexp_loc in + attach t.trailing longident.loc afterLongident; + let leading, inside, trailing = partitionByLoc rest expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walk_expression expr t inside; + walkExpression expr t inside; attach t.trailing expr.pexp_loc trailing -and walk_extension_constructor ext_constr t comments = +and walkExtensionConstructor extConstr t comments = let leading, trailing = - partition_leading_trailing comments ext_constr.pext_name.loc + partitionLeadingTrailing comments extConstr.pext_name.loc in - attach t.leading ext_constr.pext_name.loc leading; - let after_name, rest = - partition_adjacent_trailing ext_constr.pext_name.loc trailing + attach t.leading extConstr.pext_name.loc leading; + let afterName, rest = + partitionAdjacentTrailing extConstr.pext_name.loc trailing in - attach t.trailing ext_constr.pext_name.loc after_name; - walk_extension_constructor_kind ext_constr.pext_kind t rest + attach t.trailing extConstr.pext_name.loc afterName; + walkExtensionConstructorKind extConstr.pext_kind t rest -and walk_extension_constructor_kind kind t comments = +and walkExtensionConstructorKind kind t comments = match kind with | Pext_rebind longident -> - let leading, trailing = partition_leading_trailing comments longident.loc in + let leading, trailing = partitionLeadingTrailing comments longident.loc in attach t.leading longident.loc leading; attach t.trailing longident.loc trailing - | Pext_decl (constructor_arguments, maybe_typ_expr) -> ( - let rest = walk_constructor_arguments constructor_arguments t comments in - match maybe_typ_expr with + | Pext_decl (constructorArguments, maybeTypExpr) -> ( + let rest = walkConstructorArguments constructorArguments t comments in + match maybeTypExpr with | None -> () | Some typexpr -> - let before, inside, after = partition_by_loc rest typexpr.ptyp_loc in + let before, inside, after = partitionByLoc rest typexpr.ptyp_loc in attach t.leading typexpr.ptyp_loc before; - walk_core_type typexpr t inside; + walkCoreType typexpr t inside; attach t.trailing typexpr.ptyp_loc after) -and walk_module_expr mod_expr t comments = - match mod_expr.pmod_desc with +and walkModuleExpr modExpr t comments = + match modExpr.pmod_desc with | Pmod_ident longident -> - let before, after = partition_leading_trailing comments longident.loc in + let before, after = partitionLeadingTrailing comments longident.loc in attach t.leading longident.loc before; attach t.trailing longident.loc after - | Pmod_structure [] -> attach t.inside mod_expr.pmod_loc comments - | Pmod_structure structure -> walk_structure structure t comments - | Pmod_extension extension -> walk_extension extension t comments + | Pmod_structure [] -> attach t.inside modExpr.pmod_loc comments + | Pmod_structure structure -> walkStructure structure t comments + | Pmod_extension extension -> walkExtension extension t comments | Pmod_unpack expr -> - let before, inside, after = partition_by_loc comments expr.pexp_loc in + let before, inside, after = partitionByLoc comments expr.pexp_loc in attach t.leading expr.pexp_loc before; - walk_expression expr t inside; + walkExpression expr t inside; attach t.trailing expr.pexp_loc after | Pmod_constraint (modexpr, modtype) -> if modtype.pmty_loc.loc_start >= modexpr.pmod_loc.loc_end then ( - let before, inside, after = partition_by_loc comments modexpr.pmod_loc in + let before, inside, after = partitionByLoc comments modexpr.pmod_loc in attach t.leading modexpr.pmod_loc before; - walk_module_expr modexpr t inside; - let after, rest = partition_adjacent_trailing modexpr.pmod_loc after in + walkModuleExpr modexpr t inside; + let after, rest = partitionAdjacentTrailing modexpr.pmod_loc after in attach t.trailing modexpr.pmod_loc after; - let before, inside, after = partition_by_loc rest modtype.pmty_loc in + let before, inside, after = partitionByLoc rest modtype.pmty_loc in attach t.leading modtype.pmty_loc before; - walk_mod_type modtype t inside; + walkModType modtype t inside; attach t.trailing modtype.pmty_loc after) else - let before, inside, after = partition_by_loc comments modtype.pmty_loc in + let before, inside, after = partitionByLoc comments modtype.pmty_loc in attach t.leading modtype.pmty_loc before; - walk_mod_type modtype t inside; - let after, rest = partition_adjacent_trailing modtype.pmty_loc after in + walkModType modtype t inside; + let after, rest = partitionAdjacentTrailing modtype.pmty_loc after in attach t.trailing modtype.pmty_loc after; - let before, inside, after = partition_by_loc rest modexpr.pmod_loc in + let before, inside, after = partitionByLoc rest modexpr.pmod_loc in attach t.leading modexpr.pmod_loc before; - walk_module_expr modexpr t inside; + walkModuleExpr modexpr t inside; attach t.trailing modexpr.pmod_loc after | Pmod_apply (_callModExpr, _argModExpr) -> - let mod_exprs = mod_expr_apply mod_expr in - walk_list (mod_exprs |> List.map (fun me -> ModuleExpr me)) t comments + let modExprs = modExprApply modExpr in + walkList (modExprs |> List.map (fun me -> ModuleExpr me)) t comments | Pmod_functor _ -> ( - let parameters, return_mod_expr = mod_expr_functor mod_expr in + let parameters, returnModExpr = modExprFunctor modExpr in let comments = - visit_list_but_continue_with_remaining_comments - ~get_loc:(fun (_, lbl, mod_type_option) -> - match mod_type_option with + visitListButContinueWithRemainingComments + ~getLoc:(fun (_, lbl, modTypeOption) -> + match modTypeOption with | None -> lbl.Asttypes.loc - | Some mod_type -> - {lbl.loc with loc_end = mod_type.Parsetree.pmty_loc.loc_end}) - ~walk_node:walk_mod_expr_parameter ~newline_delimited:false parameters t + | Some modType -> + {lbl.loc with loc_end = modType.Parsetree.pmty_loc.loc_end}) + ~walkNode:walkModExprParameter ~newlineDelimited:false parameters t comments in - match return_mod_expr.pmod_desc with - | Pmod_constraint (mod_expr, mod_type) - when mod_type.pmty_loc.loc_end.pos_cnum - <= mod_expr.pmod_loc.loc_start.pos_cnum -> - let before, inside, after = partition_by_loc comments mod_type.pmty_loc in - attach t.leading mod_type.pmty_loc before; - walk_mod_type mod_type t inside; - let after, rest = partition_adjacent_trailing mod_type.pmty_loc after in - attach t.trailing mod_type.pmty_loc after; - let before, inside, after = partition_by_loc rest mod_expr.pmod_loc in - attach t.leading mod_expr.pmod_loc before; - walk_module_expr mod_expr t inside; - attach t.trailing mod_expr.pmod_loc after + match returnModExpr.pmod_desc with + | Pmod_constraint (modExpr, modType) + when modType.pmty_loc.loc_end.pos_cnum + <= modExpr.pmod_loc.loc_start.pos_cnum -> + let before, inside, after = partitionByLoc comments modType.pmty_loc in + attach t.leading modType.pmty_loc before; + walkModType modType t inside; + let after, rest = partitionAdjacentTrailing modType.pmty_loc after in + attach t.trailing modType.pmty_loc after; + let before, inside, after = partitionByLoc rest modExpr.pmod_loc in + attach t.leading modExpr.pmod_loc before; + walkModuleExpr modExpr t inside; + attach t.trailing modExpr.pmod_loc after | _ -> let before, inside, after = - partition_by_loc comments return_mod_expr.pmod_loc + partitionByLoc comments returnModExpr.pmod_loc in - attach t.leading return_mod_expr.pmod_loc before; - walk_module_expr return_mod_expr t inside; - attach t.trailing return_mod_expr.pmod_loc after) + attach t.leading returnModExpr.pmod_loc before; + walkModuleExpr returnModExpr t inside; + attach t.trailing returnModExpr.pmod_loc after) -and walk_mod_expr_parameter parameter t comments = - let _attrs, lbl, mod_type_option = parameter in - let leading, trailing = partition_leading_trailing comments lbl.loc in +and walkModExprParameter parameter t comments = + let _attrs, lbl, modTypeOption = parameter in + let leading, trailing = partitionLeadingTrailing comments lbl.loc in attach t.leading lbl.loc leading; - match mod_type_option with + match modTypeOption with | None -> attach t.trailing lbl.loc trailing - | Some mod_type -> - let after_lbl, rest = partition_adjacent_trailing lbl.loc trailing in - attach t.trailing lbl.loc after_lbl; - let before, inside, after = partition_by_loc rest mod_type.pmty_loc in - attach t.leading mod_type.pmty_loc before; - walk_mod_type mod_type t inside; - attach t.trailing mod_type.pmty_loc after - -and walk_mod_type mod_type t comments = - match mod_type.pmty_desc with + | Some modType -> + let afterLbl, rest = partitionAdjacentTrailing lbl.loc trailing in + attach t.trailing lbl.loc afterLbl; + let before, inside, after = partitionByLoc rest modType.pmty_loc in + attach t.leading modType.pmty_loc before; + walkModType modType t inside; + attach t.trailing modType.pmty_loc after + +and walkModType modType t comments = + match modType.pmty_desc with | Pmty_ident longident | Pmty_alias longident -> - let leading, trailing = partition_leading_trailing comments longident.loc in + let leading, trailing = partitionLeadingTrailing comments longident.loc in attach t.leading longident.loc leading; attach t.trailing longident.loc trailing - | Pmty_signature [] -> attach t.inside mod_type.pmty_loc comments - | Pmty_signature signature -> walk_signature signature t comments - | Pmty_extension extension -> walk_extension extension t comments - | Pmty_typeof mod_expr -> - let before, inside, after = partition_by_loc comments mod_expr.pmod_loc in - attach t.leading mod_expr.pmod_loc before; - walk_module_expr mod_expr t inside; - attach t.trailing mod_expr.pmod_loc after - | Pmty_with (mod_type, _withConstraints) -> - let before, inside, after = partition_by_loc comments mod_type.pmty_loc in - attach t.leading mod_type.pmty_loc before; - walk_mod_type mod_type t inside; - attach t.trailing mod_type.pmty_loc after + | Pmty_signature [] -> attach t.inside modType.pmty_loc comments + | Pmty_signature signature -> walkSignature signature t comments + | Pmty_extension extension -> walkExtension extension t comments + | Pmty_typeof modExpr -> + let before, inside, after = partitionByLoc comments modExpr.pmod_loc in + attach t.leading modExpr.pmod_loc before; + walkModuleExpr modExpr t inside; + attach t.trailing modExpr.pmod_loc after + | Pmty_with (modType, _withConstraints) -> + let before, inside, after = partitionByLoc comments modType.pmty_loc in + attach t.leading modType.pmty_loc before; + walkModType modType t inside; + attach t.trailing modType.pmty_loc after (* TODO: withConstraints*) | Pmty_functor _ -> - let parameters, return_mod_type = functor_type mod_type in + let parameters, returnModType = functorType modType in let comments = - visit_list_but_continue_with_remaining_comments - ~get_loc:(fun (_, lbl, mod_type_option) -> - match mod_type_option with + visitListButContinueWithRemainingComments + ~getLoc:(fun (_, lbl, modTypeOption) -> + match modTypeOption with | None -> lbl.Asttypes.loc - | Some mod_type -> - if lbl.txt = "_" then mod_type.Parsetree.pmty_loc - else {lbl.loc with loc_end = mod_type.Parsetree.pmty_loc.loc_end}) - ~walk_node:walk_mod_type_parameter ~newline_delimited:false parameters t + | Some modType -> + if lbl.txt = "_" then modType.Parsetree.pmty_loc + else {lbl.loc with loc_end = modType.Parsetree.pmty_loc.loc_end}) + ~walkNode:walkModTypeParameter ~newlineDelimited:false parameters t comments in let before, inside, after = - partition_by_loc comments return_mod_type.pmty_loc + partitionByLoc comments returnModType.pmty_loc in - attach t.leading return_mod_type.pmty_loc before; - walk_mod_type return_mod_type t inside; - attach t.trailing return_mod_type.pmty_loc after + attach t.leading returnModType.pmty_loc before; + walkModType returnModType t inside; + attach t.trailing returnModType.pmty_loc after -and walk_mod_type_parameter (_, lbl, mod_type_option) t comments = - let leading, trailing = partition_leading_trailing comments lbl.loc in +and walkModTypeParameter (_, lbl, modTypeOption) t comments = + let leading, trailing = partitionLeadingTrailing comments lbl.loc in attach t.leading lbl.loc leading; - match mod_type_option with + match modTypeOption with | None -> attach t.trailing lbl.loc trailing - | Some mod_type -> - let after_lbl, rest = partition_adjacent_trailing lbl.loc trailing in - attach t.trailing lbl.loc after_lbl; - let before, inside, after = partition_by_loc rest mod_type.pmty_loc in - attach t.leading mod_type.pmty_loc before; - walk_mod_type mod_type t inside; - attach t.trailing mod_type.pmty_loc after - -and walk_pattern pat t comments = + | Some modType -> + let afterLbl, rest = partitionAdjacentTrailing lbl.loc trailing in + attach t.trailing lbl.loc afterLbl; + let before, inside, after = partitionByLoc rest modType.pmty_loc in + attach t.leading modType.pmty_loc before; + walkModType modType t inside; + attach t.trailing modType.pmty_loc after + +and walkPattern pat t comments = let open Location in match pat.Parsetree.ppat_desc with | _ when comments = [] -> () | Ppat_alias (pat, alias) -> - let leading, inside, trailing = partition_by_loc comments pat.ppat_loc in + let leading, inside, trailing = partitionByLoc comments pat.ppat_loc in attach t.leading pat.ppat_loc leading; - walk_pattern pat t inside; - let after_pat, rest = partition_adjacent_trailing pat.ppat_loc trailing in + walkPattern pat t inside; + let afterPat, rest = partitionAdjacentTrailing pat.ppat_loc trailing in attach t.leading pat.ppat_loc leading; - attach t.trailing pat.ppat_loc after_pat; - let before_alias, after_alias = partition_leading_trailing rest alias.loc in - attach t.leading alias.loc before_alias; - attach t.trailing alias.loc after_alias + attach t.trailing pat.ppat_loc afterPat; + let beforeAlias, afterAlias = partitionLeadingTrailing rest alias.loc in + attach t.leading alias.loc beforeAlias; + attach t.trailing alias.loc afterAlias | Ppat_tuple [] | Ppat_array [] | Ppat_construct ({txt = Longident.Lident "()"}, _) | Ppat_construct ({txt = Longident.Lident "[]"}, _) -> attach t.inside pat.ppat_loc comments | Ppat_array patterns -> - walk_list (patterns |> List.map (fun p -> Pattern p)) t comments + walkList (patterns |> List.map (fun p -> Pattern p)) t comments | Ppat_tuple patterns -> - walk_list (patterns |> List.map (fun p -> Pattern p)) t comments + walkList (patterns |> List.map (fun p -> Pattern p)) t comments | Ppat_construct ({txt = Longident.Lident "::"}, _) -> - walk_list - (collect_list_patterns [] pat |> List.map (fun p -> Pattern p)) + walkList + (collectListPatterns [] pat |> List.map (fun p -> Pattern p)) t comments | Ppat_construct (constr, None) -> - let before_constr, after_constr = - partition_leading_trailing comments constr.loc + let beforeConstr, afterConstr = + partitionLeadingTrailing comments constr.loc in - attach t.leading constr.loc before_constr; - attach t.trailing constr.loc after_constr + attach t.leading constr.loc beforeConstr; + attach t.trailing constr.loc afterConstr | Ppat_construct (constr, Some pat) -> - let leading, trailing = partition_leading_trailing comments constr.loc in + let leading, trailing = partitionLeadingTrailing comments constr.loc in attach t.leading constr.loc leading; - let after_constructor, rest = - partition_adjacent_trailing constr.loc trailing + let afterConstructor, rest = + partitionAdjacentTrailing constr.loc trailing in - attach t.trailing constr.loc after_constructor; - let leading, inside, trailing = partition_by_loc rest pat.ppat_loc in + attach t.trailing constr.loc afterConstructor; + let leading, inside, trailing = partitionByLoc rest pat.ppat_loc in attach t.leading pat.ppat_loc leading; - walk_pattern pat t inside; + walkPattern pat t inside; attach t.trailing pat.ppat_loc trailing | Ppat_variant (_label, None) -> () - | Ppat_variant (_label, Some pat) -> walk_pattern pat t comments + | Ppat_variant (_label, Some pat) -> walkPattern pat t comments | Ppat_type _ -> () - | Ppat_record (record_rows, _) -> - walk_list - (record_rows |> List.map (fun (li, p) -> PatternRecordRow (li, p))) + | Ppat_record (recordRows, _) -> + walkList + (recordRows |> List.map (fun (li, p) -> PatternRecordRow (li, p))) t comments | Ppat_or _ -> - walk_list - (Res_parsetree_viewer.collect_or_pattern_chain pat + walkList + (Res_parsetree_viewer.collectOrPatternChain pat |> List.map (fun pat -> Pattern pat)) t comments | Ppat_constraint (pattern, typ) -> - let before_pattern, inside_pattern, after_pattern = - partition_by_loc comments pattern.ppat_loc + let beforePattern, insidePattern, afterPattern = + partitionByLoc comments pattern.ppat_loc in - attach t.leading pattern.ppat_loc before_pattern; - walk_pattern pattern t inside_pattern; - let after_pattern, rest = - partition_adjacent_trailing pattern.ppat_loc after_pattern + attach t.leading pattern.ppat_loc beforePattern; + walkPattern pattern t insidePattern; + let afterPattern, rest = + partitionAdjacentTrailing pattern.ppat_loc afterPattern in - attach t.trailing pattern.ppat_loc after_pattern; - let before_typ, inside_typ, after_typ = - partition_by_loc rest typ.ptyp_loc - in - attach t.leading typ.ptyp_loc before_typ; - walk_core_type typ t inside_typ; - attach t.trailing typ.ptyp_loc after_typ + attach t.trailing pattern.ppat_loc afterPattern; + let beforeTyp, insideTyp, afterTyp = partitionByLoc rest typ.ptyp_loc in + attach t.leading typ.ptyp_loc beforeTyp; + walkCoreType typ t insideTyp; + attach t.trailing typ.ptyp_loc afterTyp | Ppat_lazy pattern | Ppat_exception pattern -> - let leading, inside, trailing = - partition_by_loc comments pattern.ppat_loc - in + let leading, inside, trailing = partitionByLoc comments pattern.ppat_loc in attach t.leading pattern.ppat_loc leading; - walk_pattern pattern t inside; + walkPattern pattern t inside; attach t.trailing pattern.ppat_loc trailing - | Ppat_unpack string_loc -> - let leading, trailing = - partition_leading_trailing comments string_loc.loc - in - attach t.leading string_loc.loc leading; - attach t.trailing string_loc.loc trailing - | Ppat_extension extension -> walk_extension extension t comments + | Ppat_unpack stringLoc -> + let leading, trailing = partitionLeadingTrailing comments stringLoc.loc in + attach t.leading stringLoc.loc leading; + attach t.trailing stringLoc.loc trailing + | Ppat_extension extension -> walkExtension extension t comments | _ -> () (* name: firstName *) -and walk_pattern_record_row row t comments = +and walkPatternRecordRow row t comments = match row with (* punned {x}*) - | ( {Location.txt = Longident.Lident ident; loc = longident_loc}, + | ( {Location.txt = Longident.Lident ident; loc = longidentLoc}, {Parsetree.ppat_desc = Ppat_var {txt; _}} ) when ident = txt -> - let before_lbl, after_lbl = - partition_leading_trailing comments longident_loc - in - attach t.leading longident_loc before_lbl; - attach t.trailing longident_loc after_lbl + let beforeLbl, afterLbl = partitionLeadingTrailing comments longidentLoc in + attach t.leading longidentLoc beforeLbl; + attach t.trailing longidentLoc afterLbl | longident, pattern -> - let before_lbl, after_lbl = - partition_leading_trailing comments longident.loc - in - attach t.leading longident.loc before_lbl; - let after_lbl, rest = partition_adjacent_trailing longident.loc after_lbl in - attach t.trailing longident.loc after_lbl; - let leading, inside, trailing = partition_by_loc rest pattern.ppat_loc in + let beforeLbl, afterLbl = partitionLeadingTrailing comments longident.loc in + attach t.leading longident.loc beforeLbl; + let afterLbl, rest = partitionAdjacentTrailing longident.loc afterLbl in + attach t.trailing longident.loc afterLbl; + let leading, inside, trailing = partitionByLoc rest pattern.ppat_loc in attach t.leading pattern.ppat_loc leading; - walk_pattern pattern t inside; + walkPattern pattern t inside; attach t.trailing pattern.ppat_loc trailing -and walk_row_field (row_field : Parsetree.row_field) t comments = - match row_field with +and walkRowField (rowField : Parsetree.row_field) t comments = + match rowField with | Parsetree.Rtag ({loc}, _, _, _) -> - let before, after = partition_leading_trailing comments loc in + let before, after = partitionLeadingTrailing comments loc in attach t.leading loc before; attach t.trailing loc after | Rinherit _ -> () -and walk_core_type typ t comments = +and walkCoreType typ t comments = match typ.Parsetree.ptyp_desc with | _ when comments = [] -> () | Ptyp_tuple typexprs -> - walk_list (typexprs |> List.map (fun ct -> CoreType ct)) t comments - | Ptyp_extension extension -> walk_extension extension t comments - | Ptyp_package package_type -> walk_package_type package_type t comments + walkList (typexprs |> List.map (fun ct -> CoreType ct)) t comments + | Ptyp_extension extension -> walkExtension extension t comments + | Ptyp_package packageType -> walkPackageType packageType t comments | Ptyp_alias (typexpr, _alias) -> - let before_typ, inside_typ, after_typ = - partition_by_loc comments typexpr.ptyp_loc + let beforeTyp, insideTyp, afterTyp = + partitionByLoc comments typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc before_typ; - walk_core_type typexpr t inside_typ; - attach t.trailing typexpr.ptyp_loc after_typ + attach t.leading typexpr.ptyp_loc beforeTyp; + walkCoreType typexpr t insideTyp; + attach t.trailing typexpr.ptyp_loc afterTyp | Ptyp_poly (strings, typexpr) -> let comments = - visit_list_but_continue_with_remaining_comments - ~get_loc:(fun n -> n.Asttypes.loc) - ~walk_node:(fun longident t comments -> - let before_longident, after_longident = - partition_leading_trailing comments longident.loc + visitListButContinueWithRemainingComments + ~getLoc:(fun n -> n.Asttypes.loc) + ~walkNode:(fun longident t comments -> + let beforeLongident, afterLongident = + partitionLeadingTrailing comments longident.loc in - attach t.leading longident.loc before_longident; - attach t.trailing longident.loc after_longident) - ~newline_delimited:false strings t comments + attach t.leading longident.loc beforeLongident; + attach t.trailing longident.loc afterLongident) + ~newlineDelimited:false strings t comments in - let before_typ, inside_typ, after_typ = - partition_by_loc comments typexpr.ptyp_loc + let beforeTyp, insideTyp, afterTyp = + partitionByLoc comments typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc before_typ; - walk_core_type typexpr t inside_typ; - attach t.trailing typexpr.ptyp_loc after_typ - | Ptyp_variant (row_fields, _, _) -> - walk_list (row_fields |> List.map (fun rf -> RowField rf)) t comments + attach t.leading typexpr.ptyp_loc beforeTyp; + walkCoreType typexpr t insideTyp; + attach t.trailing typexpr.ptyp_loc afterTyp + | Ptyp_variant (rowFields, _, _) -> + walkList (rowFields |> List.map (fun rf -> RowField rf)) t comments | Ptyp_constr ({txt = Lident "function$"}, [({ptyp_desc = Ptyp_arrow _} as desc); _]) -> - walk_core_type desc t comments + walkCoreType desc t comments | Ptyp_constr (longident, typexprs) -> - let before_longident, _afterLongident = - partition_leading_trailing comments longident.loc + let beforeLongident, _afterLongident = + partitionLeadingTrailing comments longident.loc in - let after_longident, rest = - partition_adjacent_trailing longident.loc comments + let afterLongident, rest = + partitionAdjacentTrailing longident.loc comments in - attach t.leading longident.loc before_longident; - attach t.trailing longident.loc after_longident; - walk_list (typexprs |> List.map (fun ct -> CoreType ct)) t rest + attach t.leading longident.loc beforeLongident; + attach t.trailing longident.loc afterLongident; + walkList (typexprs |> List.map (fun ct -> CoreType ct)) t rest | Ptyp_arrow _ -> - let _, parameters, typexpr = arrow_type typ in - let comments = walk_type_parameters parameters t comments in - let before_typ, inside_typ, after_typ = - partition_by_loc comments typexpr.ptyp_loc + let _, parameters, typexpr = arrowType typ in + let comments = walkTypeParameters parameters t comments in + let beforeTyp, insideTyp, afterTyp = + partitionByLoc comments typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc before_typ; - walk_core_type typexpr t inside_typ; - attach t.trailing typexpr.ptyp_loc after_typ - | Ptyp_object (fields, _) -> walk_typ_object_fields fields t comments + attach t.leading typexpr.ptyp_loc beforeTyp; + walkCoreType typexpr t insideTyp; + attach t.trailing typexpr.ptyp_loc afterTyp + | Ptyp_object (fields, _) -> walkTypObjectFields fields t comments | _ -> () -and walk_typ_object_fields fields t comments = - walk_list (fields |> List.map (fun f -> ObjectField f)) t comments +and walkTypObjectFields fields t comments = + walkList (fields |> List.map (fun f -> ObjectField f)) t comments -and walk_object_field field t comments = +and walkObjectField field t comments = match field with | Otag (lbl, _, typexpr) -> - let before_lbl, after_lbl = partition_leading_trailing comments lbl.loc in - attach t.leading lbl.loc before_lbl; - let after_lbl, rest = partition_adjacent_trailing lbl.loc after_lbl in - attach t.trailing lbl.loc after_lbl; - let before_typ, inside_typ, after_typ = - partition_by_loc rest typexpr.ptyp_loc - in - attach t.leading typexpr.ptyp_loc before_typ; - walk_core_type typexpr t inside_typ; - attach t.trailing typexpr.ptyp_loc after_typ + let beforeLbl, afterLbl = partitionLeadingTrailing comments lbl.loc in + attach t.leading lbl.loc beforeLbl; + let afterLbl, rest = partitionAdjacentTrailing lbl.loc afterLbl in + attach t.trailing lbl.loc afterLbl; + let beforeTyp, insideTyp, afterTyp = partitionByLoc rest typexpr.ptyp_loc in + attach t.leading typexpr.ptyp_loc beforeTyp; + walkCoreType typexpr t insideTyp; + attach t.trailing typexpr.ptyp_loc afterTyp | _ -> () -and walk_type_parameters type_parameters t comments = - visit_list_but_continue_with_remaining_comments - ~get_loc:(fun (_, _, typexpr) -> +and walkTypeParameters typeParameters t comments = + visitListButContinueWithRemainingComments + ~getLoc:(fun (_, _, typexpr) -> match typexpr.Parsetree.ptyp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs -> {loc with loc_end = typexpr.ptyp_loc.loc_end} | _ -> typexpr.ptyp_loc) - ~walk_node:walk_type_parameter ~newline_delimited:false type_parameters t + ~walkNode:walkTypeParameter ~newlineDelimited:false typeParameters t comments -and walk_type_parameter (_attrs, _lbl, typexpr) t comments = - let before_typ, inside_typ, after_typ = - partition_by_loc comments typexpr.ptyp_loc +and walkTypeParameter (_attrs, _lbl, typexpr) t comments = + let beforeTyp, insideTyp, afterTyp = + partitionByLoc comments typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc before_typ; - walk_core_type typexpr t inside_typ; - attach t.trailing typexpr.ptyp_loc after_typ - -and walk_package_type package_type t comments = - let longident, package_constraints = package_type in - let before_longident, after_longident = - partition_leading_trailing comments longident.loc + attach t.leading typexpr.ptyp_loc beforeTyp; + walkCoreType typexpr t insideTyp; + attach t.trailing typexpr.ptyp_loc afterTyp + +and walkPackageType packageType t comments = + let longident, packageConstraints = packageType in + let beforeLongident, afterLongident = + partitionLeadingTrailing comments longident.loc in - attach t.leading longident.loc before_longident; - let after_longident, rest = - partition_adjacent_trailing longident.loc after_longident + attach t.leading longident.loc beforeLongident; + let afterLongident, rest = + partitionAdjacentTrailing longident.loc afterLongident in - attach t.trailing longident.loc after_longident; - walk_package_constraints package_constraints t rest + attach t.trailing longident.loc afterLongident; + walkPackageConstraints packageConstraints t rest -and walk_package_constraints package_constraints t comments = - walk_list - (package_constraints - |> List.map (fun (li, te) -> PackageConstraint (li, te))) +and walkPackageConstraints packageConstraints t comments = + walkList + (packageConstraints |> List.map (fun (li, te) -> PackageConstraint (li, te))) t comments -and walk_package_constraint package_constraint t comments = - let longident, typexpr = package_constraint in - let before_longident, after_longident = - partition_leading_trailing comments longident.loc - in - attach t.leading longident.loc before_longident; - let after_longident, rest = - partition_adjacent_trailing longident.loc after_longident +and walkPackageConstraint packageConstraint t comments = + let longident, typexpr = packageConstraint in + let beforeLongident, afterLongident = + partitionLeadingTrailing comments longident.loc in - attach t.trailing longident.loc after_longident; - let before_typ, inside_typ, after_typ = - partition_by_loc rest typexpr.ptyp_loc + attach t.leading longident.loc beforeLongident; + let afterLongident, rest = + partitionAdjacentTrailing longident.loc afterLongident in - attach t.leading typexpr.ptyp_loc before_typ; - walk_core_type typexpr t inside_typ; - attach t.trailing typexpr.ptyp_loc after_typ + attach t.trailing longident.loc afterLongident; + let beforeTyp, insideTyp, afterTyp = partitionByLoc rest typexpr.ptyp_loc in + attach t.leading typexpr.ptyp_loc beforeTyp; + walkCoreType typexpr t insideTyp; + attach t.trailing typexpr.ptyp_loc afterTyp -and walk_extension extension t comments = +and walkExtension extension t comments = let id, payload = extension in - let before_id, after_id = partition_leading_trailing comments id.loc in - attach t.leading id.loc before_id; - let after_id, rest = partition_adjacent_trailing id.loc after_id in - attach t.trailing id.loc after_id; - walk_payload payload t rest - -and walk_attribute (id, payload) t comments = - let before_id, after_id = partition_leading_trailing comments id.loc in - attach t.leading id.loc before_id; - let after_id, rest = partition_adjacent_trailing id.loc after_id in - attach t.trailing id.loc after_id; - walk_payload payload t rest - -and walk_payload payload t comments = + let beforeId, afterId = partitionLeadingTrailing comments id.loc in + attach t.leading id.loc beforeId; + let afterId, rest = partitionAdjacentTrailing id.loc afterId in + attach t.trailing id.loc afterId; + walkPayload payload t rest + +and walkAttribute (id, payload) t comments = + let beforeId, afterId = partitionLeadingTrailing comments id.loc in + attach t.leading id.loc beforeId; + let afterId, rest = partitionAdjacentTrailing id.loc afterId in + attach t.trailing id.loc afterId; + walkPayload payload t rest + +and walkPayload payload t comments = match payload with - | PStr s -> walk_structure s t comments + | PStr s -> walkStructure s t comments | _ -> () diff --git a/analysis/vendor/res_syntax/res_core.ml b/analysis/vendor/res_syntax/res_core.ml index 48023f378..2a0807416 100644 --- a/analysis/vendor/res_syntax/res_core.ml +++ b/analysis/vendor/res_syntax/res_core.ml @@ -8,60 +8,59 @@ module Scanner = Res_scanner module Parser = Res_parser module LoopProgress = struct - let list_rest list = + let listRest list = match list with | [] -> assert false | _ :: rest -> rest end -let mk_loc start_loc end_loc = - Location.{loc_start = start_loc; loc_end = end_loc; loc_ghost = false} +let mkLoc startLoc endLoc = + Location.{loc_start = startLoc; loc_end = endLoc; loc_ghost = false} module Recover = struct - let default_expr () = + let defaultExpr () = let id = Location.mknoloc "rescript.exprhole" in Ast_helper.Exp.mk (Pexp_extension (id, PStr [])) - let default_type () = + let defaultType () = let id = Location.mknoloc "rescript.typehole" in Ast_helper.Typ.extension (id, PStr []) - let default_pattern () = + let defaultPattern () = let id = Location.mknoloc "rescript.patternhole" in Ast_helper.Pat.extension (id, PStr []) - let default_module_expr () = Ast_helper.Mod.structure [] - let default_module_type () = Ast_helper.Mty.signature [] + let defaultModuleExpr () = Ast_helper.Mod.structure [] + let defaultModuleType () = Ast_helper.Mty.signature [] - let default_signature_item = + let defaultSignatureItem = let id = Location.mknoloc "rescript.sigitemhole" in Ast_helper.Sig.extension (id, PStr []) - let recover_equal_greater p = + let recoverEqualGreater p = Parser.expect EqualGreater p; match p.Parser.token with | MinusGreater -> Parser.next p | _ -> () - let should_abort_list_parse p = + let shouldAbortListParse p = let rec check breadcrumbs = match breadcrumbs with | [] -> false | (grammar, _) :: rest -> - if Grammar.is_part_of_list grammar p.Parser.token then true - else check rest + if Grammar.isPartOfList grammar p.Parser.token then true else check rest in check p.breadcrumbs end module ErrorMessages = struct - let list_pattern_spread = + let listPatternSpread = "List pattern matches only supports one `...` spread, at the end.\n\ Explanation: a list spread at the tail is efficient, but a spread in the \ middle would create new lists; out of performance concern, our pattern \ matching currently guarantees to never create new intermediate data." - let record_pattern_spread = + let recordPatternSpread = "Record's `...` spread is not supported in pattern matches.\n\ Explanation: you can't collect a subset of a record's field into its own \ record, since a record needs an explicit declaration and that subset \ @@ -70,7 +69,7 @@ module ErrorMessages = struct (* let recordPatternUnderscore = "Record patterns only support one `_`, at the end." *) [@@live] - let array_pattern_spread = + let arrayPatternSpread = "Array's `...` spread is not supported in pattern matches.\n\ Explanation: such spread would create a subarray; out of performance \ concern, our pattern matching currently guarantees to never create new \ @@ -79,18 +78,18 @@ module ErrorMessages = struct + Array size check + `get` checks on the current pattern. If it's to \ obtain a subarray, use `Array.sub` or `Belt.Array.slice`." - let record_expr_spread = + let recordExprSpread = "Records can only have one `...` spread, at the beginning.\n\ Explanation: since records have a known, fixed shape, a spread like `{a, \ ...b}` wouldn't make sense, as `b` would override every field of `a` \ anyway." - let variant_ident = + let variantIdent = "A polymorphic variant (e.g. #id) must start with an alphabetical letter \ or be a number (e.g. #742)" - let experimental_if_let expr = - let switch_expr = {expr with Parsetree.pexp_attributes = []} in + let experimentalIfLet expr = + let switchExpr = {expr with Parsetree.pexp_attributes = []} in Doc.concat [ Doc.text "If-let is currently highly experimental."; @@ -98,52 +97,52 @@ module ErrorMessages = struct Doc.text "Use a regular `switch` with pattern matching instead:"; Doc.concat [ - Doc.hard_line; - Doc.hard_line; - ResPrinter.print_expression switch_expr CommentTable.empty; + Doc.hardLine; + Doc.hardLine; + ResPrinter.printExpression switchExpr CommentTable.empty; ]; ] - |> Doc.to_string ~width:80 + |> Doc.toString ~width:80 - let type_param = + let typeParam = "A type param consists of a singlequote followed by a name like `'a` or \ `'A`" - let type_var = + let typeVar = "A type variable consists of a singlequote followed by a name like `'a` or \ `'A`" - let attribute_without_node (attr : Parsetree.attribute) = - let {Asttypes.txt = attr_name}, _ = attr in - "Did you forget to attach `" ^ attr_name + let attributeWithoutNode (attr : Parsetree.attribute) = + let {Asttypes.txt = attrName}, _ = attr in + "Did you forget to attach `" ^ attrName ^ "` to an item?\n Standalone attributes start with `@@` like: `@@" - ^ attr_name ^ "`" + ^ attrName ^ "`" - let type_declaration_name_longident longident = + let typeDeclarationNameLongident longident = "A type declaration's name cannot contain a module access. Did you mean `" ^ Longident.last longident ^ "`?" - let tuple_single_element = "A tuple needs at least two elements" + let tupleSingleElement = "A tuple needs at least two elements" - let missing_tilde_labeled_parameter name = + let missingTildeLabeledParameter name = if name = "" then "A labeled parameter starts with a `~`." else "A labeled parameter starts with a `~`. Did you mean: `~" ^ name ^ "`?" - let string_interpolation_in_pattern = + let stringInterpolationInPattern = "String interpolation is not supported in pattern matching." - let spread_in_record_declaration = + let spreadInRecordDeclaration = "A record type declaration doesn't support the ... spread. Only an object \ (with quoted field names) does." - let object_quoted_field_name name = + let objectQuotedFieldName name = "An object type declaration needs quoted field names. Did you mean \"" ^ name ^ "\"?" - let forbidden_inline_record_declaration = + let forbiddenInlineRecordDeclaration = "An inline record type declaration is only allowed in a variant \ constructor's declaration" - let poly_var_int_with_suffix number = + let polyVarIntWithSuffix number = "A numeric polymorphic variant cannot be followed by a letter. Did you \ mean `#" ^ number ^ "`?" end @@ -152,35 +151,35 @@ module InExternal = struct let status = ref false end -let jsx_attr = (Location.mknoloc "JSX", Parsetree.PStr []) -let uncurried_app_attr = (Location.mknoloc "res.uapp", Parsetree.PStr []) -let ternary_attr = (Location.mknoloc "res.ternary", Parsetree.PStr []) -let if_let_attr = (Location.mknoloc "res.iflet", Parsetree.PStr []) -let optional_attr = (Location.mknoloc "res.optional", Parsetree.PStr []) -let make_await_attr loc = (Location.mkloc "res.await" loc, Parsetree.PStr []) -let make_async_attr loc = (Location.mkloc "res.async" loc, Parsetree.PStr []) +let jsxAttr = (Location.mknoloc "JSX", Parsetree.PStr []) +let uncurriedAppAttr = (Location.mknoloc "res.uapp", Parsetree.PStr []) +let ternaryAttr = (Location.mknoloc "res.ternary", Parsetree.PStr []) +let ifLetAttr = (Location.mknoloc "res.iflet", Parsetree.PStr []) +let optionalAttr = (Location.mknoloc "res.optional", Parsetree.PStr []) +let makeAwaitAttr loc = (Location.mkloc "res.await" loc, Parsetree.PStr []) +let makeAsyncAttr loc = (Location.mkloc "res.async" loc, Parsetree.PStr []) -let make_expression_optional ~optional (e : Parsetree.expression) = - if optional then {e with pexp_attributes = optional_attr :: e.pexp_attributes} +let makeExpressionOptional ~optional (e : Parsetree.expression) = + if optional then {e with pexp_attributes = optionalAttr :: e.pexp_attributes} else e -let make_pattern_optional ~optional (p : Parsetree.pattern) = - if optional then {p with ppat_attributes = optional_attr :: p.ppat_attributes} +let makePatternOptional ~optional (p : Parsetree.pattern) = + if optional then {p with ppat_attributes = optionalAttr :: p.ppat_attributes} else p -let suppress_fragile_match_warning_attr = +let suppressFragileMatchWarningAttr = ( Location.mknoloc "warning", Parsetree.PStr [ Ast_helper.Str.eval (Ast_helper.Exp.constant (Pconst_string ("-4", None))); ] ) -let make_braces_attr loc = (Location.mkloc "res.braces" loc, Parsetree.PStr []) -let template_literal_attr = (Location.mknoloc "res.template", Parsetree.PStr []) +let makeBracesAttr loc = (Location.mkloc "res.braces" loc, Parsetree.PStr []) +let templateLiteralAttr = (Location.mknoloc "res.template", Parsetree.PStr []) -let tagged_template_literal_attr = +let taggedTemplateLiteralAttr = (Location.mknoloc "res.taggedTemplate", Parsetree.PStr []) -let spread_attr = (Location.mknoloc "res.spread", Parsetree.PStr []) +let spreadAttr = (Location.mknoloc "res.spread", Parsetree.PStr []) type argument = { dotted: bool; @@ -188,22 +187,22 @@ type argument = { expr: Parsetree.expression; } -type type_parameter = { +type typeParameter = { dotted: bool; attrs: Ast_helper.attrs; label: Asttypes.arg_label; typ: Parsetree.core_type; - start_pos: Lexing.position; + startPos: Lexing.position; } -type typ_def_or_ext = +type typDefOrExt = | TypeDef of { - rec_flag: Asttypes.rec_flag; + recFlag: Asttypes.rec_flag; types: Parsetree.type_declaration list; } | TypeExt of Parsetree.type_extension -type labelled_parameter = +type labelledParameter = | TermParameter of { dotted: bool; attrs: Parsetree.attributes; @@ -219,13 +218,13 @@ type labelled_parameter = pos: Lexing.position; } -type record_pattern_item = +type recordPatternItem = | PatUnderscore | PatField of (Ast_helper.lid * Parsetree.pattern) type context = OrdinaryExpr | TernaryTrueBranchExpr | WhenExpr -let get_closing_token = function +let getClosingToken = function | Token.Lparen -> Token.Rparen | Lbrace -> Rbrace | Lbracket -> Rbracket @@ -233,8 +232,8 @@ let get_closing_token = function | LessThan -> GreaterThan | _ -> assert false -let rec go_to_closing closing_token state = - match (state.Parser.token, closing_token) with +let rec goToClosing closingToken state = + match (state.Parser.token, closingToken) with | Rparen, Token.Rparen | Rbrace, Rbrace | Rbracket, Rbracket @@ -243,16 +242,16 @@ let rec go_to_closing closing_token state = () | ((Token.Lbracket | Lparen | Lbrace | List | LessThan) as t), _ -> Parser.next state; - go_to_closing (get_closing_token t) state; - go_to_closing closing_token state + goToClosing (getClosingToken t) state; + goToClosing closingToken state | (Rparen | Token.Rbrace | Rbracket | Eof), _ -> () (* TODO: how do report errors here? *) | _ -> Parser.next state; - go_to_closing closing_token state + goToClosing closingToken state (* Madness *) -let is_es6_arrow_expression ~in_ternary p = +let isEs6ArrowExpression ~inTernary p = Parser.lookahead p (fun state -> let async = match state.Parser.token with @@ -273,7 +272,7 @@ let is_es6_arrow_expression ~in_ternary p = | EqualGreater -> true | _ -> false) | Lparen -> ( - let prev_end_pos = state.prev_end_pos in + let prevEndPos = state.prevEndPos in Parser.next state; match state.token with (* arrived at `()` here *) @@ -281,7 +280,7 @@ let is_es6_arrow_expression ~in_ternary p = Parser.next state; match state.Parser.token with (* arrived at `() :` here *) - | Colon when not in_ternary -> ( + | Colon when not inTernary -> ( Parser.next state; match state.Parser.token with (* arrived at `() :typ` here *) @@ -291,7 +290,7 @@ let is_es6_arrow_expression ~in_ternary p = (* arrived at `() :typ<` here *) | LessThan -> Parser.next state; - go_to_closing GreaterThan state + goToClosing GreaterThan state | _ -> ()); match state.Parser.token with (* arrived at `() :typ =>` or `() :typ<'a,'b> =>` here *) @@ -306,11 +305,11 @@ let is_es6_arrow_expression ~in_ternary p = false (* (` always indicates the start of an expr, can't be es6 parameter *) | _ -> ( - go_to_closing Rparen state; + goToClosing Rparen state; match state.Parser.token with | EqualGreater -> true (* | Lbrace TODO: detect missing =>, is this possible? *) - | Colon when not in_ternary -> true + | Colon when not inTernary -> true | Rparen -> (* imagine having something as : * switch colour { @@ -322,19 +321,19 @@ let is_es6_arrow_expression ~in_ternary p = * *) false | _ -> ( - Parser.next_unsafe state; + Parser.nextUnsafe state; (* error recovery, peek at the next token, * (elements, providerId] => { * in the example above, we have an unbalanced ] here *) match state.Parser.token with - | EqualGreater - when state.start_pos.pos_lnum == prev_end_pos.pos_lnum -> + | EqualGreater when state.startPos.pos_lnum == prevEndPos.pos_lnum + -> true | _ -> false))) | _ -> false) -let is_es6_arrow_functor p = +let isEs6ArrowFunctor p = Parser.lookahead p (fun state -> match state.Parser.token with (* | Uident _ | Underscore -> *) @@ -352,14 +351,14 @@ let is_es6_arrow_functor p = | Colon | EqualGreater -> true | _ -> false) | _ -> ( - go_to_closing Rparen state; + goToClosing Rparen state; match state.Parser.token with | EqualGreater | Lbrace -> true | Colon -> true | _ -> false)) | _ -> false) -let is_es6_arrow_type p = +let isEs6ArrowType p = Parser.lookahead p (fun state -> match state.Parser.token with | Lparen -> ( @@ -372,20 +371,20 @@ let is_es6_arrow_type p = | _ -> false) | Tilde | Dot -> true | _ -> ( - go_to_closing Rparen state; + goToClosing Rparen state; match state.Parser.token with | EqualGreater -> true | _ -> false)) | Tilde -> true | _ -> false) -let build_longident words = +let buildLongident words = match List.rev words with | [] -> assert false | hd :: tl -> List.fold_left (fun p s -> Longident.Ldot (p, s)) (Lident hd) tl -let make_infix_operator (p : Parser.t) token start_pos end_pos = - let stringified_token = +let makeInfixOperator (p : Parser.t) token startPos endPos = + let stringifiedToken = if token = Token.MinusGreater then if p.uncurried_config = Legacy then "|." else "|.u" else if token = Token.PlusPlus then "^" @@ -393,73 +392,73 @@ let make_infix_operator (p : Parser.t) token start_pos end_pos = else if token = Token.BangEqualEqual then "!=" else if token = Token.Equal then ( (* TODO: could have a totally different meaning like x->fooSet(y)*) - Parser.err ~start_pos ~end_pos p + Parser.err ~startPos ~endPos p (Diagnostics.message "Did you mean `==` here?"); "=") else if token = Token.EqualEqual then "=" else if token = Token.EqualEqualEqual then "==" - else Token.to_string token + else Token.toString token in - let loc = mk_loc start_pos end_pos in - let operator = Location.mkloc (Longident.Lident stringified_token) loc in + let loc = mkLoc startPos endPos in + let operator = Location.mkloc (Longident.Lident stringifiedToken) loc in Ast_helper.Exp.ident ~loc operator -let negate_string s = +let negateString s = if String.length s > 0 && (s.[0] [@doesNotRaise]) = '-' then (String.sub [@doesNotRaise]) s 1 (String.length s - 1) else "-" ^ s -let make_unary_expr start_pos token_end token operand = +let makeUnaryExpr startPos tokenEnd token operand = match (token, operand.Parsetree.pexp_desc) with | (Token.Plus | PlusDot), Pexp_constant (Pconst_integer _ | Pconst_float _) -> operand | Minus, Pexp_constant (Pconst_integer (n, m)) -> { operand with - pexp_desc = Pexp_constant (Pconst_integer (negate_string n, m)); + pexp_desc = Pexp_constant (Pconst_integer (negateString n, m)); } | (Minus | MinusDot), Pexp_constant (Pconst_float (n, m)) -> - {operand with pexp_desc = Pexp_constant (Pconst_float (negate_string n, m))} + {operand with pexp_desc = Pexp_constant (Pconst_float (negateString n, m))} | (Token.Plus | PlusDot | Minus | MinusDot), _ -> - let token_loc = mk_loc start_pos token_end in - let operator = "~" ^ Token.to_string token in + let tokenLoc = mkLoc startPos tokenEnd in + let operator = "~" ^ Token.toString token 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 operator) token_loc)) + ~loc:(mkLoc startPos operand.Parsetree.pexp_loc.loc_end) + (Ast_helper.Exp.ident ~loc:tokenLoc + (Location.mkloc (Longident.Lident operator) tokenLoc)) [(Nolabel, operand)] | Token.Bang, _ -> - let token_loc = mk_loc start_pos token_end in + let tokenLoc = mkLoc startPos tokenEnd 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)) + ~loc:(mkLoc startPos operand.Parsetree.pexp_loc.loc_end) + (Ast_helper.Exp.ident ~loc:tokenLoc + (Location.mkloc (Longident.Lident "not") tokenLoc)) [(Nolabel, operand)] | _ -> operand -let make_list_expression loc seq ext_opt = - let rec handle_seq = function +let makeListExpression loc seq extOpt = + let rec handleSeq = function | [] -> ( - match ext_opt with + match extOpt with | Some ext -> ext | None -> let loc = {loc with Location.loc_ghost = true} in let nil = Location.mkloc (Longident.Lident "[]") loc in Ast_helper.Exp.construct ~loc nil None) | e1 :: el -> - let exp_el = handle_seq el in + let exp_el = handleSeq el in let loc = - mk_loc e1.Parsetree.pexp_loc.Location.loc_start exp_el.pexp_loc.loc_end + mkLoc e1.Parsetree.pexp_loc.Location.loc_start exp_el.pexp_loc.loc_end in let arg = Ast_helper.Exp.tuple ~loc [e1; exp_el] in Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "::") loc) (Some arg) in - let expr = handle_seq seq in + let expr = handleSeq seq in {expr with pexp_loc = loc} -let make_list_pattern loc seq ext_opt = +let makeListPattern loc seq ext_opt = let rec handle_seq = function | [] -> let base_case = @@ -473,9 +472,7 @@ let make_list_pattern loc seq ext_opt = base_case | p1 :: pl -> let pat_pl = handle_seq pl in - let loc = - mk_loc p1.Parsetree.ppat_loc.loc_start pat_pl.ppat_loc.loc_end - in + let loc = mkLoc p1.Parsetree.ppat_loc.loc_start pat_pl.ppat_loc.loc_end in let arg = Ast_helper.Pat.mk ~loc (Ppat_tuple [p1; pat_pl]) in Ast_helper.Pat.mk ~loc (Ppat_construct (Location.mkloc (Longident.Lident "::") loc, Some arg)) @@ -483,12 +480,12 @@ let make_list_pattern loc seq ext_opt = handle_seq seq (* TODO: diagnostic reporting *) -let lident_of_path longident = +let lidentOfPath longident = match Longident.flatten longident |> List.rev with | [] -> "" | ident :: _ -> ident -let make_newtypes ~attrs ~loc newtypes exp = +let makeNewtypes ~attrs ~loc newtypes exp = let expr = List.fold_right (fun newtype exp -> Ast_helper.Exp.mk ~loc (Pexp_newtype (newtype, exp))) @@ -502,9 +499,9 @@ let make_newtypes ~attrs ~loc newtypes exp = * into * let f = (type t u v. foo : list) => ... *) -let wrap_type_annotation ~loc newtypes core_type body = +let wrapTypeAnnotation ~loc newtypes core_type body = let exp = - make_newtypes ~attrs:[] ~loc newtypes + makeNewtypes ~attrs:[] ~loc newtypes (Ast_helper.Exp.constraint_ ~loc body core_type) in let typ = @@ -519,7 +516,7 @@ let wrap_type_annotation ~loc newtypes core_type body = * return a wrapping function that wraps ((__x) => ...) around an expression * e.g. foo(_, 3) becomes (__x) => foo(__x, 3) *) -let process_underscore_application (p : Parser.t) args = +let processUnderscoreApplication (p : Parser.t) args = let exp_question = ref None in let hidden_var = "__x" in let check_arg ((lab, exp) as arg) = @@ -540,37 +537,36 @@ let process_underscore_application (p : Parser.t) args = (Ppat_var (Location.mkloc hidden_var loc)) ~loc:Location.none in - let fun_expr = Ast_helper.Exp.fun_ ~loc Nolabel None pattern exp_apply in - if p.uncurried_config = Legacy then fun_expr - else Ast_uncurried.uncurried_fun ~loc ~arity:1 fun_expr + let funExpr = Ast_helper.Exp.fun_ ~loc Nolabel None pattern exp_apply in + if p.uncurried_config = Legacy then funExpr + else Ast_uncurried.uncurriedFun ~loc ~arity:1 funExpr | None -> exp_apply in (args, wrap) (* Transform A.a into a. For use with punned record fields as in {A.a, b}. *) -let remove_module_name_from_punned_field_value exp = +let removeModuleNameFromPunnedFieldValue exp = match exp.Parsetree.pexp_desc with - | Pexp_ident path_ident -> + | Pexp_ident pathIdent -> { exp with pexp_desc = - Pexp_ident - {path_ident with txt = Lident (Longident.last path_ident.txt)}; + Pexp_ident {pathIdent with txt = Lident (Longident.last pathIdent.txt)}; } | _ -> exp -let rec parse_lident p = - let recover_lident p = +let rec parseLident p = + let recoverLident p = if - Token.is_keyword p.Parser.token - && p.Parser.prev_end_pos.pos_lnum == p.start_pos.pos_lnum + Token.isKeyword p.Parser.token + && p.Parser.prevEndPos.pos_lnum == p.startPos.pos_lnum then ( Parser.err p (Diagnostics.lident p.Parser.token); Parser.next p; None) else let rec loop p = - if (not (Recover.should_abort_list_parse p)) && p.token <> Eof then ( + if (not (Recover.shouldAbortListParse p)) && p.token <> Eof then ( Parser.next p; loop p) in @@ -581,70 +577,69 @@ let rec parse_lident p = | Lident _ -> Some () | _ -> None in - let start_pos = p.Parser.start_pos in + let startPos = p.Parser.startPos in match p.Parser.token with | Lident ident -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in (ident, loc) | Eof -> - Parser.err ~start_pos p - (Diagnostics.unexpected p.Parser.token p.breadcrumbs); - ("_", mk_loc start_pos p.prev_end_pos) + Parser.err ~startPos p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); + ("_", mkLoc startPos p.prevEndPos) | _ -> ( - match recover_lident p with - | Some () -> parse_lident p - | None -> ("_", mk_loc start_pos p.prev_end_pos)) + match recoverLident p with + | Some () -> parseLident p + | None -> ("_", mkLoc startPos p.prevEndPos)) -let parse_ident ~msg ~start_pos p = +let parseIdent ~msg ~startPos p = match p.Parser.token with | Lident ident | Uident ident -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in (ident, loc) | token - when Token.is_keyword token - && p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> - let token_txt = Token.to_string token in + when Token.isKeyword token && p.prevEndPos.pos_lnum == p.startPos.pos_lnum + -> + let tokenTxt = Token.toString token in let msg = - "`" ^ token_txt - ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" ^ token_txt + "`" ^ tokenTxt + ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" ^ tokenTxt ^ "\"" in - Parser.err ~start_pos p (Diagnostics.message msg); + Parser.err ~startPos p (Diagnostics.message msg); Parser.next p; - (token_txt, mk_loc start_pos p.prev_end_pos) + (tokenTxt, mkLoc startPos p.prevEndPos) | _token -> - Parser.err ~start_pos p (Diagnostics.message msg); + Parser.err ~startPos p (Diagnostics.message msg); Parser.next p; - ("", mk_loc start_pos p.prev_end_pos) + ("", mkLoc startPos p.prevEndPos) -let parse_hash_ident ~start_pos p = +let parseHashIdent ~startPos p = Parser.expect Hash p; match p.token with | String text -> Parser.next p; - (text, mk_loc start_pos p.prev_end_pos) + (text, mkLoc startPos p.prevEndPos) | Int {i; suffix} -> let () = match suffix with | Some _ -> Parser.err p - (Diagnostics.message (ErrorMessages.poly_var_int_with_suffix i)) + (Diagnostics.message (ErrorMessages.polyVarIntWithSuffix i)) | None -> () in Parser.next p; - (i, mk_loc start_pos p.prev_end_pos) + (i, mkLoc startPos p.prevEndPos) | Eof -> - Parser.err ~start_pos p (Diagnostics.unexpected p.token p.breadcrumbs); - ("", mk_loc start_pos p.prev_end_pos) - | _ -> parse_ident ~start_pos ~msg:ErrorMessages.variant_ident p + Parser.err ~startPos p (Diagnostics.unexpected p.token p.breadcrumbs); + ("", mkLoc startPos p.prevEndPos) + | _ -> parseIdent ~startPos ~msg:ErrorMessages.variantIdent p (* Ldot (Ldot (Lident "Foo", "Bar"), "baz") *) -let parse_value_path p = - let start_pos = p.Parser.start_pos in +let parseValuePath p = + let startPos = p.Parser.startPos in let rec aux p path = - let start_pos = p.Parser.start_pos in + let startPos = p.Parser.startPos in let token = p.token in Parser.next p; @@ -658,7 +653,7 @@ let parse_value_path p = Parser.err p (Diagnostics.unexpected token p.breadcrumbs); Longident.Ldot (path, "_")) else ( - Parser.err p ~start_pos ~end_pos:p.prev_end_pos (Diagnostics.lident token); + Parser.err p ~startPos ~endPos:p.prevEndPos (Diagnostics.lident token); path) in let ident = @@ -668,123 +663,119 @@ let parse_value_path p = Longident.Lident ident | Uident ident -> let res = aux p (Lident ident) in - Parser.next_unsafe p; + Parser.nextUnsafe p; res | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Parser.next_unsafe p; + Parser.nextUnsafe p; Longident.Lident "_" in - Location.mkloc ident (mk_loc start_pos p.prev_end_pos) + Location.mkloc ident (mkLoc startPos p.prevEndPos) -let parse_value_path_after_dot p = - let start_pos = p.Parser.start_pos in +let parseValuePathAfterDot p = + let startPos = p.Parser.startPos in match p.Parser.token with - | Lident _ | Uident _ -> parse_value_path p + | Lident _ | Uident _ -> parseValuePath p | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Location.mkloc (Longident.Lident "_") (mk_loc start_pos p.prev_end_pos) + Location.mkloc (Longident.Lident "_") (mkLoc startPos p.prevEndPos) -let parse_value_path_tail p start_pos ident = +let parseValuePathTail p startPos ident = let rec loop p path = match p.Parser.token with | Lident ident -> Parser.next p; Location.mkloc (Longident.Ldot (path, ident)) - (mk_loc start_pos p.prev_end_pos) + (mkLoc startPos p.prevEndPos) | Uident ident -> Parser.next p; Parser.expect Dot p; loop p (Longident.Ldot (path, ident)) | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Location.mkloc - (Longident.Ldot (path, "_")) - (mk_loc start_pos p.prev_end_pos) + Location.mkloc (Longident.Ldot (path, "_")) (mkLoc startPos p.prevEndPos) in loop p ident -let parse_module_long_ident_tail ~lowercase p start_pos ident = +let parseModuleLongIdentTail ~lowercase p startPos ident = let rec loop p acc = match p.Parser.token with | Lident ident when lowercase -> Parser.next p; let lident = Longident.Ldot (acc, ident) in - Location.mkloc lident (mk_loc start_pos p.prev_end_pos) + Location.mkloc lident (mkLoc startPos p.prevEndPos) | Uident ident -> ( Parser.next p; - let end_pos = p.prev_end_pos in + let endPos = p.prevEndPos in let lident = Longident.Ldot (acc, ident) in match p.Parser.token with | Dot -> Parser.next p; loop p lident - | _ -> Location.mkloc lident (mk_loc start_pos end_pos)) + | _ -> Location.mkloc lident (mkLoc startPos endPos)) | t -> Parser.err p (Diagnostics.uident t); - Location.mkloc - (Longident.Ldot (acc, "_")) - (mk_loc start_pos p.prev_end_pos) + Location.mkloc (Longident.Ldot (acc, "_")) (mkLoc startPos p.prevEndPos) in loop p ident (* Parses module identifiers: Foo Foo.Bar *) -let parse_module_long_ident ~lowercase p = +let parseModuleLongIdent ~lowercase p = (* Parser.leaveBreadcrumb p Reporting.ModuleLongIdent; *) - let start_pos = p.Parser.start_pos in - let module_ident = + let startPos = p.Parser.startPos in + let moduleIdent = match p.Parser.token with | Lident ident when lowercase -> - let loc = mk_loc start_pos p.end_pos in + let loc = mkLoc startPos p.endPos in let lident = Longident.Lident ident in Parser.next p; Location.mkloc lident loc | Uident ident -> ( let lident = Longident.Lident ident in - let end_pos = p.end_pos in + let endPos = p.endPos in Parser.next p; match p.Parser.token with | Dot -> Parser.next p; - parse_module_long_ident_tail ~lowercase p start_pos lident - | _ -> Location.mkloc lident (mk_loc start_pos end_pos)) + parseModuleLongIdentTail ~lowercase p startPos lident + | _ -> Location.mkloc lident (mkLoc startPos endPos)) | t -> Parser.err p (Diagnostics.uident t); - Location.mkloc (Longident.Lident "_") (mk_loc start_pos p.prev_end_pos) + Location.mkloc (Longident.Lident "_") (mkLoc startPos p.prevEndPos) in (* Parser.eatBreadcrumb p; *) - module_ident + moduleIdent -let verify_jsx_opening_closing_name p name_expr = +let verifyJsxOpeningClosingName p nameExpr = let closing = match p.Parser.token with | Lident lident -> Parser.next p; Longident.Lident lident - | Uident _ -> (parse_module_long_ident ~lowercase:true p).txt + | Uident _ -> (parseModuleLongIdent ~lowercase:true p).txt | _ -> Longident.Lident "" in - match name_expr.Parsetree.pexp_desc with - | Pexp_ident opening_ident -> + match nameExpr.Parsetree.pexp_desc with + | Pexp_ident openingIdent -> let opening = - let without_create_element = - Longident.flatten opening_ident.txt + let withoutCreateElement = + Longident.flatten openingIdent.txt |> List.filter (fun s -> s <> "createElement") in - match Longident.unflatten without_create_element with + match Longident.unflatten withoutCreateElement with | Some li -> li | None -> Longident.Lident "" in opening = closing | _ -> assert false -let string_of_pexp_ident name_expr = - match name_expr.Parsetree.pexp_desc with - | Pexp_ident opening_ident -> - Longident.flatten opening_ident.txt +let string_of_pexp_ident nameExpr = + match nameExpr.Parsetree.pexp_desc with + | Pexp_ident openingIdent -> + Longident.flatten openingIdent.txt |> List.filter (fun s -> s <> "createElement") |> String.concat "." | _ -> "" @@ -792,23 +783,23 @@ let string_of_pexp_ident name_expr = (* open-def ::= * | open module-path * | open! module-path *) -let parse_open_description ~attrs p = - Parser.leave_breadcrumb p Grammar.OpenDescription; - let start_pos = p.Parser.start_pos in +let parseOpenDescription ~attrs p = + Parser.leaveBreadcrumb p Grammar.OpenDescription; + let startPos = p.Parser.startPos in Parser.expect Open p; let override = if Parser.optional p Token.Bang then Asttypes.Override else Asttypes.Fresh in - let modident = parse_module_long_ident ~lowercase:false p in - let loc = mk_loc start_pos p.prev_end_pos in - Parser.eat_breadcrumb p; + let modident = parseModuleLongIdent ~lowercase:false p in + let loc = mkLoc startPos p.prevEndPos in + Parser.eatBreadcrumb p; Ast_helper.Opn.mk ~loc ~attrs ~override modident (* constant ::= integer-literal *) (* ∣ float-literal *) (* ∣ string-literal *) -let parse_constant p = - let is_negative = +let parseConstant p = + let isNegative = match p.Parser.token with | Token.Minus -> Parser.next p; @@ -827,11 +818,11 @@ let parse_constant p = (Diagnostics.message "Invalid bigint literal. Only decimal literal is allowed for \ bigint."); - let int_txt = if is_negative then "-" ^ i else i in - Parsetree.Pconst_integer (int_txt, suffix) + let intTxt = if isNegative then "-" ^ i else i in + Parsetree.Pconst_integer (intTxt, suffix) | Float {f; suffix} -> - let float_txt = if is_negative then "-" ^ f else f in - Parsetree.Pconst_float (float_txt, suffix) + let floatTxt = if isNegative then "-" ^ f else f in + Parsetree.Pconst_float (floatTxt, suffix) | String s -> Pconst_string (s, if p.mode = ParseForTypeChecker then Some "js" else None) | Codepoint {c; original} -> @@ -845,34 +836,34 @@ let parse_constant p = Parser.err p (Diagnostics.unexpected token p.breadcrumbs); Pconst_string ("", None) in - Parser.next_unsafe p; + Parser.nextUnsafe p; constant -let parse_template_constant ~prefix (p : Parser.t) = +let parseTemplateConstant ~prefix (p : Parser.t) = (* Arrived at the ` char *) - let start_pos = p.start_pos in - Parser.next_template_literal_token p; + let startPos = p.startPos in + Parser.nextTemplateLiteralToken p; match p.token with | TemplateTail (txt, _) -> Parser.next p; Parsetree.Pconst_string (txt, prefix) | _ -> - let rec skip_tokens () = + let rec skipTokens () = if p.token <> Eof then ( Parser.next p; match p.token with | Backtick -> Parser.next p; () - | _ -> skip_tokens ()) + | _ -> skipTokens ()) in - skip_tokens (); - Parser.err ~start_pos ~end_pos:p.prev_end_pos p - (Diagnostics.message ErrorMessages.string_interpolation_in_pattern); + skipTokens (); + Parser.err ~startPos ~endPos:p.prevEndPos p + (Diagnostics.message ErrorMessages.stringInterpolationInPattern); Pconst_string ("", None) -let parse_comma_delimited_region p ~grammar ~closing ~f = - Parser.leave_breadcrumb p grammar; +let parseCommaDelimitedRegion p ~grammar ~closing ~f = + Parser.leaveBreadcrumb p grammar; let rec loop nodes = match f p with | Some node -> ( @@ -881,7 +872,7 @@ let parse_comma_delimited_region p ~grammar ~closing ~f = Parser.next p; loop (node :: nodes) | token when token = closing || token = Eof -> List.rev (node :: nodes) - | _ when Grammar.is_list_element grammar p.token -> + | _ when Grammar.isListElement grammar p.token -> (* missing comma between nodes in the region and the current token * looks like the start of something valid in the current region. * Example: @@ -900,12 +891,12 @@ let parse_comma_delimited_region p ~grammar ~closing ~f = if not (p.token = Eof || p.token = closing - || Recover.should_abort_list_parse p) + || Recover.shouldAbortListParse p) then Parser.expect Comma p; if p.token = Semicolon then Parser.next p; loop (node :: nodes)) | None -> - if p.token = Eof || p.token = closing || Recover.should_abort_list_parse p + if p.token = Eof || p.token = closing || Recover.shouldAbortListParse p then List.rev nodes else ( Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); @@ -913,11 +904,11 @@ let parse_comma_delimited_region p ~grammar ~closing ~f = loop nodes) in let nodes = loop [] in - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; nodes -let parse_comma_delimited_reversed_list p ~grammar ~closing ~f = - Parser.leave_breadcrumb p grammar; +let parseCommaDelimitedReversedList p ~grammar ~closing ~f = + Parser.leaveBreadcrumb p grammar; let rec loop nodes = match f p with | Some node -> ( @@ -926,7 +917,7 @@ let parse_comma_delimited_reversed_list p ~grammar ~closing ~f = Parser.next p; loop (node :: nodes) | token when token = closing || token = Eof -> node :: nodes - | _ when Grammar.is_list_element grammar p.token -> + | _ when Grammar.isListElement grammar p.token -> (* missing comma between nodes in the region and the current token * looks like the start of something valid in the current region. * Example: @@ -945,12 +936,12 @@ let parse_comma_delimited_reversed_list p ~grammar ~closing ~f = if not (p.token = Eof || p.token = closing - || Recover.should_abort_list_parse p) + || Recover.shouldAbortListParse p) then Parser.expect Comma p; if p.token = Semicolon then Parser.next p; loop (node :: nodes)) | None -> - if p.token = Eof || p.token = closing || Recover.should_abort_list_parse p + if p.token = Eof || p.token = closing || Recover.shouldAbortListParse p then nodes else ( Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); @@ -958,18 +949,18 @@ let parse_comma_delimited_reversed_list p ~grammar ~closing ~f = loop nodes) in let nodes = loop [] in - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; nodes -let parse_delimited_region p ~grammar ~closing ~f = - Parser.leave_breadcrumb p grammar; +let parseDelimitedRegion p ~grammar ~closing ~f = + Parser.leaveBreadcrumb p grammar; let rec loop nodes = match f p with | Some node -> loop (node :: nodes) | None -> if p.Parser.token = Token.Eof || p.token = closing - || Recover.should_abort_list_parse p + || Recover.shouldAbortListParse p then List.rev nodes else ( Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); @@ -977,16 +968,16 @@ let parse_delimited_region p ~grammar ~closing ~f = loop nodes) in let nodes = loop [] in - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; nodes -let parse_region p ~grammar ~f = - Parser.leave_breadcrumb p grammar; +let parseRegion p ~grammar ~f = + Parser.leaveBreadcrumb p grammar; let rec loop nodes = match f p with | Some node -> loop (node :: nodes) | None -> - if p.Parser.token = Token.Eof || Recover.should_abort_list_parse p then + if p.Parser.token = Token.Eof || Recover.shouldAbortListParse p then List.rev nodes else ( Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); @@ -994,7 +985,7 @@ let parse_region p ~grammar ~f = loop nodes) in let nodes = loop [] in - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; nodes (* let-binding ::= pattern = expr *) @@ -1018,177 +1009,180 @@ let parse_region p ~grammar ~f = (* ∣ [| pattern { ; pattern } [ ; ] |] *) (* ∣ char-literal .. char-literal *) (* ∣ exception pattern *) -let rec parse_pattern ?(alias = true) ?(or_ = true) p = - let start_pos = p.Parser.start_pos in - let attrs = parse_attributes p in +let rec parsePattern ?(alias = true) ?(or_ = true) p = + let startPos = p.Parser.startPos in + let attrs = parseAttributes p in let pat = match p.Parser.token with | (True | False) as token -> - let end_pos = p.end_pos in + let endPos = p.endPos in Parser.next p; - let loc = mk_loc start_pos end_pos in + let loc = mkLoc startPos endPos in Ast_helper.Pat.construct ~loc - (Location.mkloc (Longident.Lident (Token.to_string token)) loc) + (Location.mkloc (Longident.Lident (Token.toString token)) loc) None | Int _ | String _ | Float _ | Codepoint _ | Minus | Plus -> ( - let c = parse_constant p in + let c = parseConstant p in match p.token with | DotDot -> Parser.next p; - let c2 = parse_constant p in - Ast_helper.Pat.interval ~loc:(mk_loc start_pos p.prev_end_pos) c c2 - | _ -> Ast_helper.Pat.constant ~loc:(mk_loc start_pos p.prev_end_pos) c) + let c2 = parseConstant p in + Ast_helper.Pat.interval ~loc:(mkLoc startPos p.prevEndPos) c c2 + | _ -> Ast_helper.Pat.constant ~loc:(mkLoc startPos p.prevEndPos) c) | Backtick -> - let constant = parse_template_constant ~prefix:(Some "js") p in - Ast_helper.Pat.constant ~attrs:[template_literal_attr] - ~loc:(mk_loc start_pos p.prev_end_pos) + let constant = parseTemplateConstant ~prefix:(Some "js") p in + Ast_helper.Pat.constant ~attrs:[templateLiteralAttr] + ~loc:(mkLoc startPos p.prevEndPos) constant | Lparen -> ( Parser.next p; match p.token with | Rparen -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in let lid = Location.mkloc (Longident.Lident "()") loc in Ast_helper.Pat.construct ~loc lid None | _ -> ( - let pat = parse_constrained_pattern p in + let pat = parseConstrainedPattern p in match p.token with | Comma -> Parser.next p; - parse_tuple_pattern ~attrs ~first:pat ~start_pos p + parseTuplePattern ~attrs ~first:pat ~startPos p | _ -> Parser.expect Rparen p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in { pat with ppat_loc = loc; ppat_attributes = attrs @ pat.Parsetree.ppat_attributes; })) - | Lbracket -> parse_array_pattern ~attrs p - | Lbrace -> parse_record_pattern ~attrs p + | Lbracket -> parseArrayPattern ~attrs p + | Lbrace -> parseRecordPattern ~attrs p | Underscore -> - let end_pos = p.end_pos in - let loc = mk_loc start_pos end_pos in + let endPos = p.endPos in + let loc = mkLoc startPos endPos in Parser.next p; Ast_helper.Pat.any ~loc ~attrs () | Lident ident -> ( - let end_pos = p.end_pos in - let loc = mk_loc start_pos end_pos in + let endPos = p.endPos in + let loc = mkLoc startPos endPos in Parser.next p; match p.token with | Backtick -> - let constant = parse_template_constant ~prefix:(Some ident) p in - Ast_helper.Pat.constant ~loc:(mk_loc start_pos p.prev_end_pos) constant + let constant = parseTemplateConstant ~prefix:(Some ident) p in + Ast_helper.Pat.constant ~loc:(mkLoc startPos p.prevEndPos) constant | _ -> Ast_helper.Pat.var ~loc ~attrs (Location.mkloc ident loc)) | Uident _ -> ( - let constr = parse_module_long_ident ~lowercase:false p in + let constr = parseModuleLongIdent ~lowercase:false p in match p.Parser.token with - | Lparen -> parse_constructor_pattern_args p constr start_pos attrs + | Lparen -> parseConstructorPatternArgs p constr startPos attrs | _ -> Ast_helper.Pat.construct ~loc:constr.loc ~attrs constr None) | Hash -> ( Parser.next p; if p.Parser.token == DotDotDot then ( Parser.next p; - let ident = parse_value_path p in - let loc = mk_loc start_pos ident.loc.loc_end in + let ident = parseValuePath p in + let loc = mkLoc startPos ident.loc.loc_end in Ast_helper.Pat.type_ ~loc ~attrs ident) else let ident, loc = match p.token with | String text -> Parser.next p; - (text, mk_loc start_pos p.prev_end_pos) + (text, mkLoc startPos p.prevEndPos) | Int {i; suffix} -> let () = match suffix with | Some _ -> Parser.err p - (Diagnostics.message - (ErrorMessages.poly_var_int_with_suffix i)) + (Diagnostics.message (ErrorMessages.polyVarIntWithSuffix i)) | None -> () in Parser.next p; - (i, mk_loc start_pos p.prev_end_pos) + (i, mkLoc startPos p.prevEndPos) | Eof -> - Parser.err ~start_pos p + Parser.err ~startPos p (Diagnostics.unexpected p.token p.breadcrumbs); - ("", mk_loc start_pos p.prev_end_pos) - | _ -> parse_ident ~msg:ErrorMessages.variant_ident ~start_pos p + ("", mkLoc startPos p.prevEndPos) + | _ -> parseIdent ~msg:ErrorMessages.variantIdent ~startPos p in match p.Parser.token with - | Lparen -> parse_variant_pattern_args p ident start_pos attrs + | Lparen -> parseVariantPatternArgs p ident startPos attrs | _ -> Ast_helper.Pat.variant ~loc ~attrs ident None) | Exception -> Parser.next p; - let pat = parse_pattern ~alias:false ~or_:false p in - let loc = mk_loc start_pos p.prev_end_pos in + let pat = parsePattern ~alias:false ~or_:false p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Pat.exception_ ~loc ~attrs pat + | Lazy -> + Parser.next p; + let pat = parsePattern ~alias:false ~or_:false p in + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Pat.lazy_ ~loc ~attrs pat | List -> Parser.next p; - parse_list_pattern ~start_pos ~attrs p - | Module -> parse_module_pattern ~attrs p + parseListPattern ~startPos ~attrs p + | Module -> parseModulePattern ~attrs p | Percent -> - let extension = parse_extension p in - let loc = mk_loc start_pos p.prev_end_pos in + let extension = parseExtension p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Pat.extension ~loc ~attrs extension | Eof -> Parser.err p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); - Recover.default_pattern () + Recover.defaultPattern () | token -> ( Parser.err p (Diagnostics.unexpected token p.breadcrumbs); match - skip_tokens_and_maybe_retry p - ~is_start_of_grammar:Grammar.is_atomic_pattern_start + skipTokensAndMaybeRetry p ~isStartOfGrammar:Grammar.isAtomicPatternStart with - | None -> Recover.default_pattern () - | Some () -> parse_pattern p) + | None -> Recover.defaultPattern () + | Some () -> parsePattern p) in - let pat = if alias then parse_alias_pattern ~attrs pat p else pat in - if or_ then parse_or_pattern pat p else pat + let pat = if alias then parseAliasPattern ~attrs pat p else pat in + if or_ then parseOrPattern pat p else pat -and skip_tokens_and_maybe_retry p ~is_start_of_grammar = +and skipTokensAndMaybeRetry p ~isStartOfGrammar = if - Token.is_keyword p.Parser.token - && p.Parser.prev_end_pos.pos_lnum == p.start_pos.pos_lnum + Token.isKeyword p.Parser.token + && p.Parser.prevEndPos.pos_lnum == p.startPos.pos_lnum then ( Parser.next p; None) - else if Recover.should_abort_list_parse p then - if is_start_of_grammar p.Parser.token then ( + else if Recover.shouldAbortListParse p then + if isStartOfGrammar p.Parser.token then ( Parser.next p; Some ()) else None else ( Parser.next p; let rec loop p = - if not (Recover.should_abort_list_parse p) then ( + if not (Recover.shouldAbortListParse p) then ( Parser.next p; loop p) in loop p; - if is_start_of_grammar p.Parser.token then Some () else None) + if isStartOfGrammar p.Parser.token then Some () else None) (* alias ::= pattern as lident *) -and parse_alias_pattern ~attrs pattern p = +and parseAliasPattern ~attrs pattern p = match p.Parser.token with | As -> Parser.next p; - let name, loc = parse_lident p in + let name, loc = parseLident p in let name = Location.mkloc name loc in Ast_helper.Pat.alias - ~loc:{pattern.ppat_loc with loc_end = p.prev_end_pos} + ~loc:{pattern.ppat_loc with loc_end = p.prevEndPos} ~attrs pattern name | _ -> pattern (* or ::= pattern | pattern * precedence: Red | Blue | Green is interpreted as (Red | Blue) | Green *) -and parse_or_pattern pattern1 p = +and parseOrPattern pattern1 p = let rec loop pattern1 = match p.Parser.token with | Bar -> Parser.next p; - let pattern2 = parse_pattern ~or_:false p in + let pattern2 = parsePattern ~or_:false p in let loc = {pattern1.Parsetree.ppat_loc with loc_end = pattern2.ppat_loc.loc_end} in @@ -1197,7 +1191,7 @@ and parse_or_pattern pattern1 p = in loop pattern1 -and parse_non_spread_pattern ~msg p = +and parseNonSpreadPattern ~msg p = let () = match p.Parser.token with | DotDotDot -> @@ -1206,34 +1200,33 @@ and parse_non_spread_pattern ~msg p = | _ -> () in match p.Parser.token with - | token when Grammar.is_pattern_start token -> ( - let pat = parse_pattern p in + | token when Grammar.isPatternStart token -> ( + let pat = parsePattern p in match p.Parser.token with | Colon -> Parser.next p; - let typ = parse_typ_expr p in - let loc = mk_loc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in + let typ = parseTypExpr p in + let loc = mkLoc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in Some (Ast_helper.Pat.constraint_ ~loc pat typ) | _ -> Some pat) | _ -> None -and parse_constrained_pattern p = - let pat = parse_pattern p in +and parseConstrainedPattern p = + let pat = parsePattern p in match p.Parser.token with | Colon -> Parser.next p; - let typ = parse_typ_expr p in - let loc = mk_loc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in + let typ = parseTypExpr p in + let loc = mkLoc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in Ast_helper.Pat.constraint_ ~loc pat typ | _ -> pat -and parse_constrained_pattern_region p = +and parseConstrainedPatternRegion p = match p.Parser.token with - | token when Grammar.is_pattern_start token -> - Some (parse_constrained_pattern p) + | token when Grammar.isPatternStart token -> Some (parseConstrainedPattern p) | _ -> None -and parse_optional_label p = +and parseOptionalLabel p = match p.Parser.token with | Question -> Parser.next p; @@ -1250,15 +1243,15 @@ and parse_optional_label p = * | field , _ * | field , _, *) -and parse_record_pattern_row_field ~attrs p = - let label = parse_value_path p in +and parseRecordPatternRowField ~attrs p = + let label = parseValuePath p in let pattern = match p.Parser.token with | Colon -> Parser.next p; - let optional = parse_optional_label p in - let pat = parse_pattern p in - make_pattern_optional ~optional pat + let optional = parseOptionalLabel p in + let pat = parsePattern p in + makePatternOptional ~optional pat | _ -> Ast_helper.Pat.var ~loc:label.loc ~attrs (Location.mkloc (Longident.last label.txt) label.loc) @@ -1266,90 +1259,90 @@ and parse_record_pattern_row_field ~attrs p = (label, pattern) (* TODO: there are better representations than PatField|Underscore ? *) -and parse_record_pattern_row p = - let attrs = parse_attributes p in +and parseRecordPatternRow p = + let attrs = parseAttributes p in match p.Parser.token with | DotDotDot -> Parser.next p; - Some (true, PatField (parse_record_pattern_row_field ~attrs p)) + Some (true, PatField (parseRecordPatternRowField ~attrs p)) | Uident _ | Lident _ -> - Some (false, PatField (parse_record_pattern_row_field ~attrs p)) + Some (false, PatField (parseRecordPatternRowField ~attrs p)) | Question -> ( Parser.next p; match p.token with | Uident _ | Lident _ -> - let lid, pat = parse_record_pattern_row_field ~attrs p in - Some (false, PatField (lid, make_pattern_optional ~optional:true pat)) + let lid, pat = parseRecordPatternRowField ~attrs p in + Some (false, PatField (lid, makePatternOptional ~optional:true pat)) | _ -> None) | Underscore -> Parser.next p; Some (false, PatUnderscore) | _ -> None -and parse_record_pattern ~attrs p = - let start_pos = p.start_pos in +and parseRecordPattern ~attrs p = + let startPos = p.startPos in Parser.expect Lbrace p; - let raw_fields = - parse_comma_delimited_reversed_list p ~grammar:PatternRecord ~closing:Rbrace - ~f:parse_record_pattern_row + let rawFields = + parseCommaDelimitedReversedList p ~grammar:PatternRecord ~closing:Rbrace + ~f:parseRecordPatternRow in Parser.expect Rbrace p; - let fields, closed_flag = - let raw_fields, flag = - match raw_fields with + let fields, closedFlag = + let rawFields, flag = + match rawFields with | (_hasSpread, PatUnderscore) :: rest -> (rest, Asttypes.Open) - | raw_fields -> (raw_fields, Asttypes.Closed) + | rawFields -> (rawFields, Asttypes.Closed) in List.fold_left (fun (fields, flag) curr -> - let has_spread, field = curr in + let hasSpread, field = curr in match field with | PatField field -> - (if has_spread then + (if hasSpread then let _, pattern = field in - Parser.err ~start_pos:pattern.Parsetree.ppat_loc.loc_start p - (Diagnostics.message ErrorMessages.record_pattern_spread)); + Parser.err ~startPos:pattern.Parsetree.ppat_loc.loc_start p + (Diagnostics.message ErrorMessages.recordPatternSpread)); (field :: fields, flag) | PatUnderscore -> (fields, flag)) - ([], flag) raw_fields + ([], flag) rawFields in - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Pat.record ~loc ~attrs fields closed_flag + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Pat.record ~loc ~attrs fields closedFlag -and parse_tuple_pattern ~attrs ~first ~start_pos p = +and parseTuplePattern ~attrs ~first ~startPos p = let patterns = first - :: parse_comma_delimited_region p ~grammar:Grammar.PatternList - ~closing:Rparen ~f:parse_constrained_pattern_region + :: parseCommaDelimitedRegion p ~grammar:Grammar.PatternList ~closing:Rparen + ~f:parseConstrainedPatternRegion in Parser.expect Rparen p; let () = match patterns with | [_] -> - Parser.err ~start_pos ~end_pos:p.prev_end_pos p - (Diagnostics.message ErrorMessages.tuple_single_element) + Parser.err ~startPos ~endPos:p.prevEndPos p + (Diagnostics.message ErrorMessages.tupleSingleElement) | _ -> () in - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Pat.tuple ~loc ~attrs patterns -and parse_pattern_region p = +and parsePatternRegion p = match p.Parser.token with | DotDotDot -> Parser.next p; - Some (true, parse_constrained_pattern p) - | token when Grammar.is_pattern_start token -> - Some (false, parse_constrained_pattern p) + Some (true, parseConstrainedPattern p) + | token when Grammar.isPatternStart token -> + Some (false, parseConstrainedPattern p) | _ -> None -and parse_module_pattern ~attrs p = - let start_pos = p.Parser.start_pos in +and parseModulePattern ~attrs p = + let startPos = p.Parser.startPos in Parser.expect Module p; Parser.expect Lparen p; let uident = match p.token with | Uident uident -> - let loc = mk_loc p.start_pos p.end_pos in + let loc = mkLoc p.startPos p.endPos in Parser.next p; Location.mkloc uident loc | _ -> @@ -1358,69 +1351,68 @@ and parse_module_pattern ~attrs p = in match p.token with | Colon -> - let colon_start = p.Parser.start_pos in + let colonStart = p.Parser.startPos in Parser.next p; - let package_typ_attrs = parse_attributes p in - let package_type = - parse_package_type ~start_pos:colon_start ~attrs:package_typ_attrs p + let packageTypAttrs = parseAttributes p in + let packageType = + parsePackageType ~startPos:colonStart ~attrs:packageTypAttrs p in Parser.expect Rparen p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in let unpack = Ast_helper.Pat.unpack ~loc:uident.loc uident in - Ast_helper.Pat.constraint_ ~loc ~attrs unpack package_type + Ast_helper.Pat.constraint_ ~loc ~attrs unpack packageType | _ -> Parser.expect Rparen p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Pat.unpack ~loc ~attrs uident -and parse_list_pattern ~start_pos ~attrs p = - let list_patterns = - parse_comma_delimited_reversed_list p ~grammar:Grammar.PatternOcamlList - ~closing:Rbrace ~f:parse_pattern_region +and parseListPattern ~startPos ~attrs p = + let listPatterns = + parseCommaDelimitedReversedList p ~grammar:Grammar.PatternOcamlList + ~closing:Rbrace ~f:parsePatternRegion in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let filter_spread (has_spread, pattern) = - if has_spread then ( - Parser.err ~start_pos:pattern.Parsetree.ppat_loc.loc_start p - (Diagnostics.message ErrorMessages.list_pattern_spread); + let loc = mkLoc startPos p.prevEndPos in + let filterSpread (hasSpread, pattern) = + if hasSpread then ( + Parser.err ~startPos:pattern.Parsetree.ppat_loc.loc_start p + (Diagnostics.message ErrorMessages.listPatternSpread); pattern) else pattern in - match list_patterns with + match listPatterns with | (true, pattern) :: patterns -> - let patterns = patterns |> List.map filter_spread |> List.rev in - let pat = make_list_pattern loc patterns (Some pattern) in + let patterns = patterns |> List.map filterSpread |> List.rev in + let pat = makeListPattern loc patterns (Some pattern) in {pat with ppat_loc = loc; ppat_attributes = attrs} | patterns -> - let patterns = patterns |> List.map filter_spread |> List.rev in - let pat = make_list_pattern loc patterns None in + let patterns = patterns |> List.map filterSpread |> List.rev in + let pat = makeListPattern loc patterns None in {pat with ppat_loc = loc; ppat_attributes = attrs} -and parse_array_pattern ~attrs p = - let start_pos = p.start_pos in +and parseArrayPattern ~attrs p = + let startPos = p.startPos in Parser.expect Lbracket p; let patterns = - parse_comma_delimited_region p ~grammar:Grammar.PatternList - ~closing:Rbracket - ~f:(parse_non_spread_pattern ~msg:ErrorMessages.array_pattern_spread) + parseCommaDelimitedRegion p ~grammar:Grammar.PatternList ~closing:Rbracket + ~f:(parseNonSpreadPattern ~msg:ErrorMessages.arrayPatternSpread) in Parser.expect Rbracket p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Pat.array ~loc ~attrs patterns -and parse_constructor_pattern_args p constr start_pos attrs = - let lparen = p.start_pos in +and parseConstructorPatternArgs p constr startPos attrs = + let lparen = p.startPos in Parser.expect Lparen p; let args = - parse_comma_delimited_region p ~grammar:Grammar.PatternList ~closing:Rparen - ~f:parse_constrained_pattern_region + parseCommaDelimitedRegion p ~grammar:Grammar.PatternList ~closing:Rparen + ~f:parseConstrainedPatternRegion in Parser.expect Rparen p; let args = match args with | [] -> - let loc = mk_loc lparen p.prev_end_pos in + let loc = mkLoc lparen p.prevEndPos in Some (Ast_helper.Pat.construct ~loc (Location.mkloc (Longident.Lident "()") loc) @@ -1431,26 +1423,24 @@ and parse_constructor_pattern_args p constr start_pos attrs = Some pat else (* Some((1, 2)) for printer *) - Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) + Some (Ast_helper.Pat.tuple ~loc:(mkLoc lparen p.endPos) patterns) | [pattern] -> Some pattern | patterns -> - Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) + Some (Ast_helper.Pat.tuple ~loc:(mkLoc lparen p.endPos) patterns) in - Ast_helper.Pat.construct - ~loc:(mk_loc start_pos p.prev_end_pos) - ~attrs constr args + Ast_helper.Pat.construct ~loc:(mkLoc startPos p.prevEndPos) ~attrs constr args -and parse_variant_pattern_args p ident start_pos attrs = - let lparen = p.start_pos in +and parseVariantPatternArgs p ident startPos attrs = + let lparen = p.startPos in Parser.expect Lparen p; let patterns = - parse_comma_delimited_region p ~grammar:Grammar.PatternList ~closing:Rparen - ~f:parse_constrained_pattern_region + parseCommaDelimitedRegion p ~grammar:Grammar.PatternList ~closing:Rparen + ~f:parseConstrainedPatternRegion in let args = match patterns with | [] -> - let loc = mk_loc lparen p.prev_end_pos in + let loc = mkLoc lparen p.prevEndPos in Some (Ast_helper.Pat.construct ~loc (Location.mkloc (Longident.Lident "()") loc) @@ -1461,46 +1451,44 @@ and parse_variant_pattern_args p ident start_pos attrs = Some pat else (* #ident((1, 2)) for printer *) - Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) + Some (Ast_helper.Pat.tuple ~loc:(mkLoc lparen p.endPos) patterns) | [pattern] -> Some pattern | patterns -> - Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) + Some (Ast_helper.Pat.tuple ~loc:(mkLoc lparen p.endPos) patterns) in Parser.expect Rparen p; - Ast_helper.Pat.variant - ~loc:(mk_loc start_pos p.prev_end_pos) - ~attrs ident args + Ast_helper.Pat.variant ~loc:(mkLoc startPos p.prevEndPos) ~attrs ident args -and parse_expr ?(context = OrdinaryExpr) p = - let expr = parse_operand_expr ~context p in - let expr = parse_binary_expr ~context ~a:expr p 1 in - parse_ternary_expr expr p +and parseExpr ?(context = OrdinaryExpr) p = + let expr = parseOperandExpr ~context p in + let expr = parseBinaryExpr ~context ~a:expr p 1 in + parseTernaryExpr expr p (* expr ? expr : expr *) -and parse_ternary_expr left_operand p = +and parseTernaryExpr leftOperand p = match p.Parser.token with | Question -> - Parser.leave_breadcrumb p Grammar.Ternary; + Parser.leaveBreadcrumb p Grammar.Ternary; Parser.next p; - let true_branch = parse_expr ~context:TernaryTrueBranchExpr p in + let trueBranch = parseExpr ~context:TernaryTrueBranchExpr p in Parser.expect Colon p; - let false_branch = parse_expr p in - Parser.eat_breadcrumb p; + let falseBranch = parseExpr p in + Parser.eatBreadcrumb p; let loc = { - left_operand.Parsetree.pexp_loc with - loc_start = left_operand.pexp_loc.loc_start; - loc_end = false_branch.Parsetree.pexp_loc.loc_end; + leftOperand.Parsetree.pexp_loc with + loc_start = leftOperand.pexp_loc.loc_start; + loc_end = falseBranch.Parsetree.pexp_loc.loc_end; } in - Ast_helper.Exp.ifthenelse ~attrs:[ternary_attr] ~loc left_operand - true_branch (Some false_branch) - | _ -> left_operand - -and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None) - ?context ?parameters p = - let start_pos = p.Parser.start_pos in - Parser.leave_breadcrumb p Grammar.Es6ArrowExpr; + Ast_helper.Exp.ifthenelse ~attrs:[ternaryAttr] ~loc leftOperand trueBranch + (Some falseBranch) + | _ -> leftOperand + +and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context + ?parameters p = + let startPos = p.Parser.startPos in + Parser.leaveBreadcrumb p Grammar.Es6ArrowExpr; (* Parsing function parameters and attributes: 1. Basically, attributes outside of `(...)` are added to the function, except the uncurried attribute `(.)` is added to the function. e.g. async, uncurried @@ -1510,78 +1498,75 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None) let parameters = match parameters with | Some params -> params - | None -> parse_parameters p + | None -> parseParameters p in let parameters = - let update_attrs attrs = arrow_attrs @ attrs in - let update_pos pos = - match arrow_start_pos with - | Some start_pos -> start_pos + let updateAttrs attrs = arrowAttrs @ attrs in + let updatePos pos = + match arrowStartPos with + | Some startPos -> startPos | None -> pos in match parameters with | TermParameter p :: rest -> - TermParameter - {p with attrs = update_attrs p.attrs; pos = update_pos p.pos} + TermParameter {p with attrs = updateAttrs p.attrs; pos = updatePos p.pos} :: rest | TypeParameter p :: rest -> - TypeParameter - {p with attrs = update_attrs p.attrs; pos = update_pos p.pos} + TypeParameter {p with attrs = updateAttrs p.attrs; pos = updatePos p.pos} :: rest | [] -> parameters in let parameters = (* Propagate any dots from type parameters to the first term *) - let rec loop ~dot_in_type params = + let rec loop ~dotInType params = match params with | (TypeParameter {dotted} as p) :: _ -> - let rest = LoopProgress.list_rest params in + let rest = LoopProgress.listRest params in (* Tell termination checker about progress *) - p :: loop ~dot_in_type:(dot_in_type || dotted) rest - | TermParameter term_param :: rest -> - TermParameter - {term_param with dotted = dot_in_type || term_param.dotted} + p :: loop ~dotInType:(dotInType || dotted) rest + | TermParameter termParam :: rest -> + TermParameter {termParam with dotted = dotInType || termParam.dotted} :: rest | [] -> [] in - loop ~dot_in_type:false parameters + loop ~dotInType:false parameters in - let return_type = + let returnType = match p.Parser.token with | Colon -> Parser.next p; - Some (parse_typ_expr ~es6_arrow:false p) + Some (parseTypExpr ~es6Arrow:false p) | _ -> None in Parser.expect EqualGreater p; let body = - let expr = parse_expr ?context p in - match return_type with + let expr = parseExpr ?context p in + match returnType with | Some typ -> Ast_helper.Exp.constraint_ - ~loc:(mk_loc expr.pexp_loc.loc_start typ.Parsetree.ptyp_loc.loc_end) + ~loc:(mkLoc expr.pexp_loc.loc_start typ.Parsetree.ptyp_loc.loc_end) expr typ | None -> expr in - Parser.eat_breadcrumb p; - let end_pos = p.prev_end_pos in - let term_parameters = + Parser.eatBreadcrumb p; + let endPos = p.prevEndPos in + let termParameters = parameters |> List.filter (function | TermParameter _ -> true | TypeParameter _ -> false) in - let body_needs_braces = - let is_fun = + let bodyNeedsBraces = + let isFun = match body.pexp_desc with | Pexp_fun _ -> true | _ -> false in - match term_parameters with + match termParameters with | TermParameter {dotted} :: _ - when p.uncurried_config |> Res_uncurried.from_dotted ~dotted && is_fun -> + when p.uncurried_config |> Res_uncurried.fromDotted ~dotted && isFun -> true - | TermParameter _ :: rest when p.uncurried_config = Legacy && is_fun -> + | TermParameter _ :: rest when p.uncurried_config = Legacy && isFun -> rest |> List.exists (function | TermParameter {dotted} -> dotted @@ -1589,47 +1574,44 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None) | _ -> false in let body = - if body_needs_braces then + if bodyNeedsBraces then { body with - pexp_attributes = make_braces_attr body.pexp_loc :: body.pexp_attributes; + pexp_attributes = makeBracesAttr body.pexp_loc :: body.pexp_attributes; } else body in - let _paramNum, arrow_expr, _arity = + let _paramNum, arrowExpr, _arity = List.fold_right - (fun parameter (term_param_num, expr, arity) -> + (fun parameter (termParamNum, expr, arity) -> match parameter with | TermParameter { dotted; attrs; label = lbl; - expr = default_expr; + expr = defaultExpr; pat; - pos = start_pos; + pos = startPos; } -> - let loc = mk_loc start_pos end_pos in - let fun_expr = - Ast_helper.Exp.fun_ ~loc ~attrs lbl default_expr pat expr + let loc = mkLoc startPos endPos in + let funExpr = + Ast_helper.Exp.fun_ ~loc ~attrs lbl defaultExpr pat expr in let uncurried = - p.uncurried_config |> Res_uncurried.from_dotted ~dotted + p.uncurried_config |> Res_uncurried.fromDotted ~dotted in - if uncurried && (term_param_num = 1 || p.uncurried_config = Legacy) - then - ( term_param_num - 1, - Ast_uncurried.uncurried_fun ~loc ~arity fun_expr, - 1 ) - else (term_param_num - 1, fun_expr, arity + 1) - | TypeParameter {dotted = _; attrs; locs = newtypes; pos = start_pos} -> - ( term_param_num, - make_newtypes ~attrs ~loc:(mk_loc start_pos end_pos) newtypes expr, + if uncurried && (termParamNum = 1 || p.uncurried_config = Legacy) then + (termParamNum - 1, Ast_uncurried.uncurriedFun ~loc ~arity funExpr, 1) + else (termParamNum - 1, funExpr, arity + 1) + | TypeParameter {dotted = _; attrs; locs = newtypes; pos = startPos} -> + ( termParamNum, + makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr, arity )) parameters - (List.length term_parameters, body, 1) + (List.length termParameters, body, 1) in - {arrow_expr with pexp_loc = {arrow_expr.pexp_loc with loc_start = start_pos}} + {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} (* * dotted_parameter ::= @@ -1650,65 +1632,65 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None) * * labelName ::= lident *) -and parse_parameter p = +and parseParameter p = if p.Parser.token = Token.Typ || p.token = Tilde || p.token = Dot - || Grammar.is_pattern_start p.token + || Grammar.isPatternStart p.token then - let start_pos = p.Parser.start_pos in + let startPos = p.Parser.startPos in let dotted = Parser.optional p Token.Dot in - let attrs = parse_attributes p in + let attrs = parseAttributes p in if p.Parser.token = Typ then ( Parser.next p; - let lidents = parse_lident_list p in - Some (TypeParameter {dotted; attrs; locs = lidents; pos = start_pos})) + let lidents = parseLidentList p in + Some (TypeParameter {dotted; attrs; locs = lidents; pos = startPos})) else let attrs, lbl, pat = match p.Parser.token with | Tilde -> ( Parser.next p; - let lbl_name, loc = parse_lident p in - let prop_loc_attr = + let lblName, loc = parseLident p in + let propLocAttr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in match p.Parser.token with | Comma | Equal | Rparen -> - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in ( [], - Asttypes.Labelled lbl_name, - Ast_helper.Pat.var ~attrs:(prop_loc_attr :: attrs) ~loc - (Location.mkloc lbl_name loc) ) + Asttypes.Labelled lblName, + Ast_helper.Pat.var ~attrs:(propLocAttr :: attrs) ~loc + (Location.mkloc lblName loc) ) | Colon -> - let lbl_end = p.prev_end_pos in + let lblEnd = p.prevEndPos in Parser.next p; - let typ = parse_typ_expr p in - let loc = mk_loc start_pos lbl_end in + let typ = parseTypExpr p in + let loc = mkLoc startPos lblEnd in let pat = - let pat = Ast_helper.Pat.var ~loc (Location.mkloc lbl_name loc) in - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Pat.constraint_ ~attrs:(prop_loc_attr :: attrs) ~loc - pat typ + let pat = Ast_helper.Pat.var ~loc (Location.mkloc lblName loc) in + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Pat.constraint_ ~attrs:(propLocAttr :: attrs) ~loc pat + typ in - ([], Asttypes.Labelled lbl_name, pat) + ([], Asttypes.Labelled lblName, pat) | As -> Parser.next p; let pat = - let pat = parse_constrained_pattern p in + let pat = parseConstrainedPattern p in { pat with - ppat_attributes = (prop_loc_attr :: attrs) @ pat.ppat_attributes; + ppat_attributes = (propLocAttr :: attrs) @ pat.ppat_attributes; } in - ([], Asttypes.Labelled lbl_name, pat) + ([], Asttypes.Labelled lblName, pat) | t -> Parser.err p (Diagnostics.unexpected t p.breadcrumbs); - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in ( [], - Asttypes.Labelled lbl_name, - Ast_helper.Pat.var ~attrs:(prop_loc_attr :: attrs) ~loc - (Location.mkloc lbl_name loc) )) + Asttypes.Labelled lblName, + Ast_helper.Pat.var ~attrs:(propLocAttr :: attrs) ~loc + (Location.mkloc lblName loc) )) | _ -> - let pattern = parse_constrained_pattern p in + let pattern = parseConstrainedPattern p in let attrs = List.concat [pattern.ppat_attributes; attrs] in ([], Asttypes.Nolabel, {pattern with ppat_attributes = attrs}) in @@ -1717,17 +1699,17 @@ and parse_parameter p = Parser.next p; let lbl = match lbl with - | Asttypes.Labelled lbl_name -> Asttypes.Optional lbl_name + | Asttypes.Labelled lblName -> Asttypes.Optional lblName | Asttypes.Nolabel -> - let lbl_name = + let lblName = match pat.ppat_desc with | Ppat_var var -> var.txt | _ -> "" in - Parser.err ~start_pos ~end_pos:p.prev_end_pos p + Parser.err ~startPos ~endPos:p.prevEndPos p (Diagnostics.message - (ErrorMessages.missing_tilde_labeled_parameter lbl_name)); - Asttypes.Optional lbl_name + (ErrorMessages.missingTildeLabeledParameter lblName)); + Asttypes.Optional lblName | lbl -> lbl in match p.Parser.token with @@ -1735,9 +1717,9 @@ and parse_parameter p = Parser.next p; Some (TermParameter - {dotted; attrs; label = lbl; expr = None; pat; pos = start_pos}) + {dotted; attrs; label = lbl; expr = None; pat; pos = startPos}) | _ -> - let expr = parse_constrained_or_coerced_expr p in + let expr = parseConstrainedOrCoercedExpr p in Some (TermParameter { @@ -1746,18 +1728,18 @@ and parse_parameter p = label = lbl; expr = Some expr; pat; - pos = start_pos; + pos = startPos; })) | _ -> Some (TermParameter - {dotted; attrs; label = lbl; expr = None; pat; pos = start_pos}) + {dotted; attrs; label = lbl; expr = None; pat; pos = startPos}) else None -and parse_parameter_list p = +and parseParameterList p = let parameters = - parse_comma_delimited_region ~grammar:Grammar.ParameterList - ~f:parse_parameter ~closing:Rparen p + parseCommaDelimitedRegion ~grammar:Grammar.ParameterList ~f:parseParameter + ~closing:Rparen p in Parser.expect Rparen p; parameters @@ -1769,12 +1751,12 @@ and parse_parameter_list p = * | (.) * | ( parameter {, parameter} [,] ) *) -and parse_parameters p = - let start_pos = p.Parser.start_pos in +and parseParameters p = + let startPos = p.Parser.startPos in match p.Parser.token with | Lident ident -> Parser.next p; - let loc = mk_loc start_pos p.Parser.prev_end_pos in + let loc = mkLoc startPos p.Parser.prevEndPos in [ TermParameter { @@ -1783,12 +1765,12 @@ and parse_parameters p = label = Asttypes.Nolabel; expr = None; pat = Ast_helper.Pat.var ~loc (Location.mkloc ident loc); - pos = start_pos; + pos = startPos; }; ] | Underscore -> Parser.next p; - let loc = mk_loc start_pos p.Parser.prev_end_pos in + let loc = mkLoc startPos p.Parser.prevEndPos in [ TermParameter { @@ -1797,7 +1779,7 @@ and parse_parameters p = label = Asttypes.Nolabel; expr = None; pat = Ast_helper.Pat.any ~loc (); - pos = start_pos; + pos = startPos; }; ] | Lparen -> ( @@ -1805,8 +1787,8 @@ and parse_parameters p = match p.Parser.token with | Rparen -> Parser.next p; - let loc = mk_loc start_pos p.Parser.prev_end_pos in - let unit_pattern = + let loc = mkLoc startPos p.Parser.prevEndPos in + let unitPattern = Ast_helper.Pat.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None @@ -1818,8 +1800,8 @@ and parse_parameters p = attrs = []; label = Asttypes.Nolabel; expr = None; - pat = unit_pattern; - pos = start_pos; + pat = unitPattern; + pos = startPos; }; ] | Dot -> ( @@ -1827,8 +1809,8 @@ and parse_parameters p = match p.token with | Rparen -> Parser.next p; - let loc = mk_loc start_pos p.Parser.prev_end_pos in - let unit_pattern = + let loc = mkLoc startPos p.Parser.prevEndPos in + let unitPattern = Ast_helper.Pat.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None @@ -1840,53 +1822,54 @@ and parse_parameters p = attrs = []; label = Asttypes.Nolabel; expr = None; - pat = unit_pattern; - pos = start_pos; + pat = unitPattern; + pos = startPos; }; ] | _ -> ( - match parse_parameter_list p with + match parseParameterList p with | TermParameter p :: rest -> - TermParameter {p with dotted = true; pos = start_pos} :: rest + TermParameter {p with dotted = true; pos = startPos} :: rest | TypeParameter p :: rest -> - TypeParameter {p with dotted = true; pos = start_pos} :: rest + TypeParameter {p with dotted = true; pos = startPos} :: rest | parameters -> parameters)) - | _ -> parse_parameter_list p) + | _ -> parseParameterList p) | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); [] -and parse_coerced_expr ~(expr : Parsetree.expression) p = +and parseCoercedExpr ~(expr : Parsetree.expression) p = Parser.expect ColonGreaterThan p; - let typ = parse_typ_expr p in - let loc = mk_loc expr.pexp_loc.loc_start p.prev_end_pos in + let typ = parseTypExpr p in + let loc = mkLoc expr.pexp_loc.loc_start p.prevEndPos in Ast_helper.Exp.coerce ~loc expr None typ -and parse_constrained_or_coerced_expr p = - let expr = parse_expr p in +and parseConstrainedOrCoercedExpr p = + let expr = parseExpr p in match p.Parser.token with - | ColonGreaterThan -> parse_coerced_expr ~expr p + | ColonGreaterThan -> parseCoercedExpr ~expr p | Colon -> ( Parser.next p; match p.token with | _ -> ( - let typ = parse_typ_expr p in - let loc = mk_loc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in + let typ = parseTypExpr p in + let loc = mkLoc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in let expr = Ast_helper.Exp.constraint_ ~loc expr typ in match p.token with - | ColonGreaterThan -> parse_coerced_expr ~expr p + | ColonGreaterThan -> parseCoercedExpr ~expr p | _ -> expr)) | _ -> expr -and parse_constrained_expr_region p = +and parseConstrainedExprRegion p = match p.Parser.token with - | token when Grammar.is_expr_start token -> ( - let expr = parse_expr p in + | token when Grammar.isExprStart token -> ( + let expr = parseExpr p in match p.Parser.token with + | ColonGreaterThan -> Some (parseCoercedExpr ~expr p) | Colon -> Parser.next p; - let typ = parse_typ_expr p in - let loc = mk_loc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in + let typ = parseTypExpr p in + let loc = mkLoc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in Some (Ast_helper.Exp.constraint_ ~loc expr typ) | _ -> Some expr) | _ -> None @@ -1894,41 +1877,41 @@ and parse_constrained_expr_region p = (* Atomic expressions represent unambiguous expressions. * This means that regardless of the context, these expressions * are always interpreted correctly. *) -and parse_atomic_expr p = - Parser.leave_breadcrumb p Grammar.ExprOperand; - let start_pos = p.Parser.start_pos in +and parseAtomicExpr p = + Parser.leaveBreadcrumb p Grammar.ExprOperand; + let startPos = p.Parser.startPos in let expr = match p.Parser.token with | (True | False) as token -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.construct ~loc - (Location.mkloc (Longident.Lident (Token.to_string token)) loc) + (Location.mkloc (Longident.Lident (Token.toString token)) loc) None | Int _ | String _ | Float _ | Codepoint _ -> - let c = parse_constant p in - let loc = mk_loc start_pos p.prev_end_pos in + let c = parseConstant p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.constant ~loc c | Backtick -> - let expr = parse_template_expr p in - {expr with pexp_loc = mk_loc start_pos p.prev_end_pos} - | Uident _ | Lident _ -> parse_value_or_constructor p - | Hash -> parse_poly_variant_expr p + let expr = parseTemplateExpr p in + {expr with pexp_loc = mkLoc startPos p.prevEndPos} + | Uident _ | Lident _ -> parseValueOrConstructor p + | Hash -> parsePolyVariantExpr p | Lparen -> ( Parser.next p; match p.Parser.token with | Rparen -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None | _t -> ( - let expr = parse_constrained_or_coerced_expr p in + let expr = parseConstrainedOrCoercedExpr p in match p.token with | Comma -> Parser.next p; - parse_tuple_expr ~start_pos ~first:expr p + parseTupleExpr ~startPos ~first:expr p | _ -> Parser.expect Rparen p; expr @@ -1940,125 +1923,123 @@ and parse_atomic_expr p = * with for comments. *))) | List -> Parser.next p; - parse_list_expr ~start_pos p + parseListExpr ~startPos p | Module -> Parser.next p; - parse_first_class_module_expr ~start_pos p - | Lbracket -> parse_array_exp p - | Lbrace -> parse_braced_or_record_expr p - | LessThan -> parse_jsx p + parseFirstClassModuleExpr ~startPos p + | Lbracket -> parseArrayExp p + | Lbrace -> parseBracedOrRecordExpr p + | LessThan -> parseJsx p | Percent -> - let extension = parse_extension p in - let loc = mk_loc start_pos p.prev_end_pos in + let extension = parseExtension p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.extension ~loc extension | Underscore as token -> (* This case is for error recovery. Not sure if it's the correct place *) Parser.err p (Diagnostics.lident token); Parser.next p; - Recover.default_expr () + Recover.defaultExpr () | Eof -> - Parser.err ~start_pos:p.prev_end_pos p + Parser.err ~startPos:p.prevEndPos p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); - Recover.default_expr () + Recover.defaultExpr () | token -> ( - let err_pos = p.prev_end_pos in - Parser.err ~start_pos:err_pos p - (Diagnostics.unexpected token p.breadcrumbs); + let errPos = p.prevEndPos in + Parser.err ~startPos:errPos p (Diagnostics.unexpected token p.breadcrumbs); match - skip_tokens_and_maybe_retry p - ~is_start_of_grammar:Grammar.is_atomic_expr_start + skipTokensAndMaybeRetry p ~isStartOfGrammar:Grammar.isAtomicExprStart with - | None -> Recover.default_expr () - | Some () -> parse_atomic_expr p) + | None -> Recover.defaultExpr () + | Some () -> parseAtomicExpr p) in - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; expr (* module(module-expr) * module(module-expr : package-type) *) -and parse_first_class_module_expr ~start_pos p = +and parseFirstClassModuleExpr ~startPos p = Parser.expect Lparen p; - let mod_expr = parse_module_expr p in - let mod_end_loc = p.prev_end_pos in + let modExpr = parseModuleExpr p in + let modEndLoc = p.prevEndPos in match p.Parser.token with | Colon -> - let colon_start = p.Parser.start_pos in + let colonStart = p.Parser.startPos in Parser.next p; - let attrs = parse_attributes p in - let package_type = parse_package_type ~start_pos:colon_start ~attrs p in + let attrs = parseAttributes p in + let packageType = parsePackageType ~startPos:colonStart ~attrs p in Parser.expect Rparen p; - let loc = mk_loc start_pos mod_end_loc in - let first_class_module = Ast_helper.Exp.pack ~loc mod_expr in - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Exp.constraint_ ~loc first_class_module package_type + let loc = mkLoc startPos modEndLoc in + let firstClassModule = Ast_helper.Exp.pack ~loc modExpr in + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Exp.constraint_ ~loc firstClassModule packageType | _ -> Parser.expect Rparen p; - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Exp.pack ~loc mod_expr + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Exp.pack ~loc modExpr -and parse_bracket_access p expr start_pos = - Parser.leave_breadcrumb p Grammar.ExprArrayAccess; - let lbracket = p.start_pos in +and parseBracketAccess p expr startPos = + Parser.leaveBreadcrumb p Grammar.ExprArrayAccess; + let lbracket = p.startPos in Parser.expect Lbracket p; - let string_start = p.start_pos in + let stringStart = p.startPos in match p.Parser.token with | String s -> ( Parser.next p; - let string_end = p.prev_end_pos in + let stringEnd = p.prevEndPos in Parser.expect Rbracket p; - Parser.eat_breadcrumb p; - let rbracket = p.prev_end_pos in + Parser.eatBreadcrumb p; + let rbracket = p.prevEndPos in let e = - let ident_loc = mk_loc string_start string_end in - let loc = mk_loc start_pos rbracket in - Ast_helper.Exp.send ~loc expr (Location.mkloc s ident_loc) + let identLoc = mkLoc stringStart stringEnd in + let loc = mkLoc startPos rbracket in + Ast_helper.Exp.send ~loc expr (Location.mkloc s identLoc) in - let e = parse_primary_expr ~operand:e p in - let equal_start = p.start_pos in + let e = parsePrimaryExpr ~operand:e p in + let equalStart = p.startPos in match p.token with | Equal -> Parser.next p; - let equal_end = p.prev_end_pos in - let rhs_expr = parse_expr p in - let loc = mk_loc start_pos rhs_expr.pexp_loc.loc_end in - let operator_loc = mk_loc equal_start equal_end in + let equalEnd = p.prevEndPos in + let rhsExpr = parseExpr p in + let loc = mkLoc startPos rhsExpr.pexp_loc.loc_end in + let operatorLoc = mkLoc equalStart equalEnd in Ast_helper.Exp.apply ~loc - (Ast_helper.Exp.ident ~loc:operator_loc - (Location.mkloc (Longident.Lident "#=") operator_loc)) - [(Nolabel, e); (Nolabel, rhs_expr)] + (Ast_helper.Exp.ident ~loc:operatorLoc + (Location.mkloc (Longident.Lident "#=") operatorLoc)) + [(Nolabel, e); (Nolabel, rhsExpr)] | _ -> e) | _ -> ( - let access_expr = parse_constrained_or_coerced_expr p in + let accessExpr = parseConstrainedOrCoercedExpr p in Parser.expect Rbracket p; - Parser.eat_breadcrumb p; - let rbracket = p.prev_end_pos in - let array_loc = mk_loc lbracket rbracket in + Parser.eatBreadcrumb p; + let rbracket = p.prevEndPos in + let arrayLoc = mkLoc lbracket rbracket in match p.token with | Equal -> - Parser.leave_breadcrumb p ExprArrayMutation; + Parser.leaveBreadcrumb p ExprArrayMutation; Parser.next p; - let rhs_expr = parse_expr p in - let array_set = - Location.mkloc (Longident.Ldot (Lident "Array", "set")) array_loc + let rhsExpr = parseExpr p in + let arraySet = + Location.mkloc (Longident.Ldot (Lident "Array", "set")) arrayLoc in - let end_pos = p.prev_end_pos in - let array_set = - Ast_helper.Exp.apply ~loc:(mk_loc start_pos end_pos) - (Ast_helper.Exp.ident ~loc:array_loc array_set) - [(Nolabel, expr); (Nolabel, access_expr); (Nolabel, rhs_expr)] + let endPos = p.prevEndPos in + let arraySet = + Ast_helper.Exp.apply ~loc:(mkLoc startPos endPos) + (Ast_helper.Exp.ident ~loc:arrayLoc arraySet) + [(Nolabel, expr); (Nolabel, accessExpr); (Nolabel, rhsExpr)] in - Parser.eat_breadcrumb p; - array_set + Parser.eatBreadcrumb p; + arraySet | _ -> - let end_pos = p.prev_end_pos in + let endPos = p.prevEndPos in let e = - Ast_helper.Exp.apply ~loc:(mk_loc start_pos end_pos) - (Ast_helper.Exp.ident ~loc:array_loc - (Location.mkloc (Longident.Ldot (Lident "Array", "get")) array_loc)) - [(Nolabel, expr); (Nolabel, access_expr)] + Ast_helper.Exp.apply ~loc:(mkLoc startPos endPos) + (Ast_helper.Exp.ident ~loc:arrayLoc + (Location.mkloc (Longident.Ldot (Lident "Array", "get")) arrayLoc)) + [(Nolabel, expr); (Nolabel, accessExpr)] in - parse_primary_expr ~operand:e p) + parsePrimaryExpr ~operand:e p) (* * A primary expression represents * - atomic-expr @@ -2068,44 +2049,43 @@ and parse_bracket_access p expr start_pos = * * The "operand" represents the expression that is operated on *) -and parse_primary_expr ~operand ?(no_call = false) p = - let start_pos = operand.pexp_loc.loc_start in +and parsePrimaryExpr ~operand ?(noCall = false) p = + let startPos = operand.pexp_loc.loc_start in let rec loop p expr = match p.Parser.token with | Dot -> ( Parser.next p; - let lident = parse_value_path_after_dot p in + let lident = parseValuePathAfterDot p in match p.Parser.token with - | Equal when no_call = false -> - Parser.leave_breadcrumb p Grammar.ExprSetField; + | Equal when noCall = false -> + Parser.leaveBreadcrumb p Grammar.ExprSetField; Parser.next p; - let target_expr = parse_expr p in - let loc = mk_loc start_pos p.prev_end_pos in - let setfield = Ast_helper.Exp.setfield ~loc expr lident target_expr in - Parser.eat_breadcrumb p; + let targetExpr = parseExpr p in + let loc = mkLoc startPos p.prevEndPos in + let setfield = Ast_helper.Exp.setfield ~loc expr lident targetExpr in + Parser.eatBreadcrumb p; setfield | _ -> - let end_pos = p.prev_end_pos in - let loc = mk_loc start_pos end_pos in + let endPos = p.prevEndPos in + let loc = mkLoc startPos endPos in loop p (Ast_helper.Exp.field ~loc expr lident)) | Lbracket - when no_call = false && p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> - parse_bracket_access p expr start_pos - | Lparen - when no_call = false && p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> - loop p (parse_call_expr p expr) + when noCall = false && p.prevEndPos.pos_lnum == p.startPos.pos_lnum -> + parseBracketAccess p expr startPos + | Lparen when noCall = false && p.prevEndPos.pos_lnum == p.startPos.pos_lnum + -> + loop p (parseCallExpr p expr) | Backtick - when no_call = false && p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum - -> ( + when noCall = false && p.prevEndPos.pos_lnum == p.startPos.pos_lnum -> ( match expr.pexp_desc with - | Pexp_ident long_ident -> parse_template_expr ~prefix:long_ident p + | Pexp_ident long_ident -> parseTemplateExpr ~prefix:long_ident p | _ -> - Parser.err ~start_pos:expr.pexp_loc.loc_start - ~end_pos:expr.pexp_loc.loc_end p + Parser.err ~startPos:expr.pexp_loc.loc_start + ~endPos:expr.pexp_loc.loc_end p (Diagnostics.message "Tagged template literals are currently restricted to names like: \ json`null`."); - parse_template_expr p) + parseTemplateExpr p) | _ -> expr in loop p operand @@ -2116,31 +2096,31 @@ and parse_primary_expr ~operand ?(no_call = false) p = * !condition * -. 1.6 *) -and parse_unary_expr p = - let start_pos = p.Parser.start_pos in +and parseUnaryExpr p = + let startPos = p.Parser.startPos in match p.Parser.token with | (Minus | MinusDot | Plus | PlusDot | Bang) as token -> - Parser.leave_breadcrumb p Grammar.ExprUnary; - let token_end = p.end_pos in + Parser.leaveBreadcrumb p Grammar.ExprUnary; + let tokenEnd = p.endPos in Parser.next p; - let operand = parse_unary_expr p in - let unary_expr = make_unary_expr start_pos token_end token operand in - Parser.eat_breadcrumb p; - unary_expr - | _ -> parse_primary_expr ~operand:(parse_atomic_expr p) p + let operand = parseUnaryExpr p in + let unaryExpr = makeUnaryExpr startPos tokenEnd token operand in + Parser.eatBreadcrumb p; + unaryExpr + | _ -> parsePrimaryExpr ~operand:(parseAtomicExpr p) p (* Represents an "operand" in a binary expression. * If you have `a + b`, `a` and `b` both represent * the operands of the binary expression with opeartor `+` *) -and parse_operand_expr ~context p = - let start_pos = p.Parser.start_pos in - let attrs = ref (parse_attributes p) in +and parseOperandExpr ~context p = + let startPos = p.Parser.startPos in + let attrs = ref (parseAttributes p) in let expr = match p.Parser.token with | Assert -> Parser.next p; - let expr = parse_expr p in - let loc = mk_loc start_pos p.prev_end_pos in + let expr = parseExpr p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.assert_ ~loc expr | Lident "async" (* we need to be careful when we're in a ternary true branch: @@ -2148,29 +2128,31 @@ and parse_operand_expr ~context p = Arrow expressions could be of the form: `async (): int => stuff()` But if we're in a ternary, the `:` of the ternary takes precedence *) - when is_es6_arrow_expression - ~in_ternary:(context = TernaryTrueBranchExpr) - p -> - let arrow_attrs = !attrs in + when isEs6ArrowExpression ~inTernary:(context = TernaryTrueBranchExpr) p + -> + let arrowAttrs = !attrs in let () = attrs := [] in - parse_async_arrow_expression ~arrow_attrs p - | Await -> parse_await_expression p - | Try -> parse_try_expression p - | If -> parse_if_or_if_let_expression p - | For -> parse_for_expression p - | While -> parse_while_expression p - | Switch -> parse_switch_expression p + parseAsyncArrowExpression ~arrowAttrs p + | Await -> parseAwaitExpression p + | Lazy -> + Parser.next p; + let expr = parseUnaryExpr p in + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Exp.lazy_ ~loc expr + | Try -> parseTryExpression p + | If -> parseIfOrIfLetExpression p + | For -> parseForExpression p + | While -> parseWhileExpression p + | Switch -> parseSwitchExpression p | _ -> if context != WhenExpr - && is_es6_arrow_expression - ~in_ternary:(context = TernaryTrueBranchExpr) - p + && isEs6ArrowExpression ~inTernary:(context = TernaryTrueBranchExpr) p then - let arrow_attrs = !attrs in + let arrowAttrs = !attrs in let () = attrs := [] in - parse_es6_arrow_expression ~arrow_attrs ~context p - else parse_unary_expr p + parseEs6ArrowExpression ~arrowAttrs ~context p + else parseUnaryExpr p in (* let endPos = p.Parser.prevEndPos in *) { @@ -2184,15 +2166,15 @@ and parse_operand_expr ~context p = * a + b * f(x) |> g(y) *) -and parse_binary_expr ?(context = OrdinaryExpr) ?a p prec = +and parseBinaryExpr ?(context = OrdinaryExpr) ?a p prec = let a = match a with | Some e -> e - | None -> parse_operand_expr ~context p + | None -> parseOperandExpr ~context p in let rec loop a = let token = p.Parser.token in - let token_prec = + let tokenPrec = match token with (* Can the minus be interpreted as a binary operator? Or is it a unary? * let w = { @@ -2209,37 +2191,37 @@ and parse_binary_expr ?(context = OrdinaryExpr) ?a p prec = * See Scanner.isBinaryOp *) | (Minus | MinusDot | LessThan) when (not - (Scanner.is_binary_op p.scanner.src p.start_pos.pos_cnum - p.end_pos.pos_cnum)) - && p.start_pos.pos_lnum > p.prev_end_pos.pos_lnum -> + (Scanner.isBinaryOp p.scanner.src p.startPos.pos_cnum + p.endPos.pos_cnum)) + && p.startPos.pos_lnum > p.prevEndPos.pos_lnum -> -1 | token -> Token.precedence token in - if token_prec < prec then a + if tokenPrec < prec then a else ( - Parser.leave_breadcrumb p (Grammar.ExprBinaryAfterOp token); - let start_pos = p.start_pos in + Parser.leaveBreadcrumb p (Grammar.ExprBinaryAfterOp token); + let startPos = p.startPos in Parser.next p; - let end_pos = p.prev_end_pos in - let token_prec = + let endPos = p.prevEndPos in + let tokenPrec = (* exponentiation operator is right-associative *) - if token = Exponentiation then token_prec else token_prec + 1 + if token = Exponentiation then tokenPrec else tokenPrec + 1 in - let b = parse_binary_expr ~context p token_prec in - let loc = mk_loc a.Parsetree.pexp_loc.loc_start b.pexp_loc.loc_end in + let b = parseBinaryExpr ~context p tokenPrec in + let loc = mkLoc a.Parsetree.pexp_loc.loc_start b.pexp_loc.loc_end in let expr = match (token, b.pexp_desc) with - | BarGreater, Pexp_apply (fun_expr, args) + | BarGreater, Pexp_apply (funExpr, args) when p.uncurried_config = Uncurried -> - {b with pexp_desc = Pexp_apply (fun_expr, args @ [(Nolabel, a)])} + {b with pexp_desc = Pexp_apply (funExpr, args @ [(Nolabel, a)])} | BarGreater, _ when p.uncurried_config = Uncurried -> Ast_helper.Exp.apply ~loc b [(Nolabel, a)] | _ -> Ast_helper.Exp.apply ~loc - (make_infix_operator p token start_pos end_pos) + (makeInfixOperator p token startPos endPos) [(Nolabel, a); (Nolabel, b)] in - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; loop expr) in loop a @@ -2277,38 +2259,36 @@ and parse_binary_expr ?(context = OrdinaryExpr) ?a p prec = (* | _ -> false *) (* ) *) -and parse_template_expr ?prefix p = - let part_prefix = +and parseTemplateExpr ?prefix p = + let partPrefix = (* we could stop treating js and j prefix as something special for json, we would first need to remove @as(json`true`) feature *) match prefix with | Some {txt = Longident.Lident (("js" | "j" | "json") as prefix); _} -> Some prefix - | Some _ -> None - | None -> Some "js" + | _ -> Some "js" in - let start_pos = p.Parser.start_pos in - let parse_parts p = + let parseParts p = let rec aux acc = - let start_pos = p.Parser.start_pos in - Parser.next_template_literal_token p; + let startPos = p.Parser.startPos in + Parser.nextTemplateLiteralToken p; match p.token with - | TemplateTail (txt, last_pos) -> + | TemplateTail (txt, lastPos) -> Parser.next p; - let loc = mk_loc start_pos last_pos in + let loc = mkLoc startPos lastPos in let str = - Ast_helper.Exp.constant ~attrs:[template_literal_attr] ~loc - (Pconst_string (txt, part_prefix)) + Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc + (Pconst_string (txt, partPrefix)) in List.rev ((str, None) :: acc) - | TemplatePart (txt, last_pos) -> + | TemplatePart (txt, lastPos) -> Parser.next p; - let loc = mk_loc start_pos last_pos in - let expr = parse_expr_block p in + let loc = mkLoc startPos lastPos in + let expr = parseExprBlock p in let str = - Ast_helper.Exp.constant ~attrs:[template_literal_attr] ~loc - (Pconst_string (txt, part_prefix)) + Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc + (Pconst_string (txt, partPrefix)) in aux ((str, Some expr) :: acc) | token -> @@ -2317,16 +2297,12 @@ and parse_template_expr ?prefix p = in aux [] in - let parts = parse_parts p in + let parts = parseParts p in let strings = List.map fst parts in let values = Ext_list.filter_map parts snd in - let end_pos = p.Parser.end_pos in - let gen_tagged_template_call lident = - let ident = - Ast_helper.Exp.ident ~attrs:[] ~loc:Location.none - (Location.mknoloc lident) - in + let genTaggedTemplateCall (lident_loc : Longident.t Location.loc) = + let ident = Ast_helper.Exp.ident ~attrs:[] ~loc:lident_loc.loc lident_loc in let strings_array = Ast_helper.Exp.array ~attrs:[] ~loc:Location.none strings in @@ -2334,21 +2310,21 @@ and parse_template_expr ?prefix p = Ast_helper.Exp.array ~attrs:[] ~loc:Location.none values in Ast_helper.Exp.apply - ~attrs:[tagged_template_literal_attr] - ~loc:(mk_loc start_pos end_pos) ident + ~attrs:[taggedTemplateLiteralAttr] + ~loc:lident_loc.loc ident [(Nolabel, strings_array); (Nolabel, values_array)] in - let hidden_operator = + let hiddenOperator = let op = Location.mknoloc (Longident.Lident "^") in Ast_helper.Exp.ident op in 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 + let loc = mkLoc e1.pexp_loc.loc_start e2.pexp_loc.loc_end in + Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator [(Nolabel, e1); (Nolabel, e2)] in - let gen_interpolated_string () = + let genInterpolatedString () = let subparts = List.flatten (List.map @@ -2358,7 +2334,7 @@ and parse_template_expr ?prefix p = | s, None -> [s]) parts) in - let expr_option = + let exprOption = List.fold_left (fun acc subpart -> Some @@ -2367,15 +2343,15 @@ and parse_template_expr ?prefix p = | None -> subpart)) None subparts in - match expr_option with + match exprOption with | Some expr -> expr | None -> Ast_helper.Exp.constant (Pconst_string ("", None)) in match prefix with | Some {txt = Longident.Lident ("js" | "j" | "json"); _} | None -> - gen_interpolated_string () - | Some {txt = lident} -> gen_tagged_template_call lident + genInterpolatedString () + | Some lident_loc -> genTaggedTemplateCall lident_loc (* Overparse: let f = a : int => a + 1, is it (a : int) => or (a): int => * Also overparse constraints: @@ -2386,16 +2362,16 @@ and parse_template_expr ?prefix p = * * We want to give a nice error message in these cases * *) -and over_parse_constrained_or_coerced_or_arrow_expression p expr = +and overParseConstrainedOrCoercedOrArrowExpression p expr = match p.Parser.token with - | ColonGreaterThan -> parse_coerced_expr ~expr p + | ColonGreaterThan -> parseCoercedExpr ~expr p | Colon -> ( Parser.next p; - let typ = parse_typ_expr ~es6_arrow:false p in + let typ = parseTypExpr ~es6Arrow:false p in match p.Parser.token with | EqualGreater -> Parser.next p; - let body = parse_expr p in + let body = parseExpr p in let pat = match expr.pexp_desc with | Pexp_ident longident -> @@ -2410,19 +2386,19 @@ and over_parse_constrained_or_coerced_or_arrow_expression p expr = in let arrow1 = Ast_helper.Exp.fun_ - ~loc:(mk_loc expr.pexp_loc.loc_start body.pexp_loc.loc_end) + ~loc:(mkLoc expr.pexp_loc.loc_start body.pexp_loc.loc_end) 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) + ~loc:(mkLoc expr.pexp_loc.loc_start body.pexp_loc.loc_end) Asttypes.Nolabel None (Ast_helper.Pat.constraint_ pat typ) body in let msg = - Doc.breakable_group ~force_break:true + Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.text @@ -2433,25 +2409,25 @@ and over_parse_constrained_or_coerced_or_arrow_expression p expr = [ Doc.line; Doc.text "1) "; - ResPrinter.print_expression arrow1 CommentTable.empty; + ResPrinter.printExpression arrow1 CommentTable.empty; Doc.line; Doc.text "2) "; - ResPrinter.print_expression arrow2 CommentTable.empty; + ResPrinter.printExpression arrow2 CommentTable.empty; ]); ]) - |> Doc.to_string ~width:80 + |> Doc.toString ~width:80 in - Parser.err ~start_pos:expr.pexp_loc.loc_start - ~end_pos:body.pexp_loc.loc_end p (Diagnostics.message msg); + Parser.err ~startPos:expr.pexp_loc.loc_start ~endPos:body.pexp_loc.loc_end + p (Diagnostics.message msg); arrow1 | _ -> - let loc = mk_loc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in + let loc = mkLoc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in let expr = Ast_helper.Exp.constraint_ ~loc expr typ in let () = - Parser.err ~start_pos:expr.pexp_loc.loc_start - ~end_pos:typ.ptyp_loc.loc_end p + Parser.err ~startPos:expr.pexp_loc.loc_start + ~endPos:typ.ptyp_loc.loc_end p (Diagnostics.message - (Doc.breakable_group ~force_break:true + (Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.text @@ -2461,23 +2437,23 @@ and over_parse_constrained_or_coerced_or_arrow_expression p expr = (Doc.concat [ Doc.line; - ResPrinter.add_parens - (ResPrinter.print_expression expr + ResPrinter.addParens + (ResPrinter.printExpression expr CommentTable.empty); ]); ]) - |> Doc.to_string ~width:80)) + |> Doc.toString ~width:80)) in expr) | _ -> expr -and parse_let_binding_body ~start_pos ~attrs p = - Parser.begin_region p; - Parser.leave_breadcrumb p Grammar.LetBinding; +and parseLetBindingBody ~startPos ~attrs p = + Parser.beginRegion p; + Parser.leaveBreadcrumb p Grammar.LetBinding; let pat, exp = - Parser.leave_breadcrumb p Grammar.Pattern; - let pat = parse_pattern p in - Parser.eat_breadcrumb p; + Parser.leaveBreadcrumb p Grammar.Pattern; + let pat = parsePattern p in + Parser.eatBreadcrumb p; match p.Parser.token with | Colon -> ( Parser.next p; @@ -2485,36 +2461,36 @@ and parse_let_binding_body ~start_pos ~attrs p = | Typ -> (* locally abstract types *) Parser.next p; - let newtypes = parse_lident_list p in + let newtypes = parseLidentList p in Parser.expect Dot p; - let typ = parse_typ_expr p in + let typ = parseTypExpr p in Parser.expect Equal p; - let expr = parse_expr p in - let loc = mk_loc start_pos p.prev_end_pos in - let exp, poly = wrap_type_annotation ~loc newtypes typ expr in + let expr = parseExpr p in + let loc = mkLoc startPos p.prevEndPos in + let exp, poly = wrapTypeAnnotation ~loc newtypes typ expr in let pat = Ast_helper.Pat.constraint_ ~loc pat poly in (pat, exp) | _ -> - let poly_type = parse_poly_type_expr p in + let polyType = parsePolyTypeExpr p in let loc = - {pat.ppat_loc with loc_end = poly_type.Parsetree.ptyp_loc.loc_end} + {pat.ppat_loc with loc_end = polyType.Parsetree.ptyp_loc.loc_end} in - let pat = Ast_helper.Pat.constraint_ ~loc pat poly_type in + let pat = Ast_helper.Pat.constraint_ ~loc pat polyType in Parser.expect Token.Equal p; - let exp = parse_expr p in - let exp = over_parse_constrained_or_coerced_or_arrow_expression p exp in + let exp = parseExpr p in + let exp = overParseConstrainedOrCoercedOrArrowExpression p exp in (pat, exp)) | _ -> Parser.expect Token.Equal p; let exp = - over_parse_constrained_or_coerced_or_arrow_expression p (parse_expr p) + overParseConstrainedOrCoercedOrArrowExpression p (parseExpr p) in (pat, exp) in - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in let vb = Ast_helper.Vb.mk ~loc ~attrs pat exp in - Parser.eat_breadcrumb p; - Parser.end_region p; + Parser.eatBreadcrumb p; + Parser.endRegion p; vb (* TODO: find a better way? Is it possible? @@ -2532,26 +2508,26 @@ and parse_let_binding_body ~start_pos ~attrs p = * Here @attr should attach to something "new": `let b = 1` * The parser state is forked, which is quite expensive… *) -and parse_attributes_and_binding (p : Parser.t) = +and parseAttributesAndBinding (p : Parser.t) = let err = p.scanner.err in let ch = p.scanner.ch in let offset = p.scanner.offset in let offset16 = p.scanner.offset16 in - let line_offset = p.scanner.line_offset in + let lineOffset = p.scanner.lineOffset in let lnum = p.scanner.lnum in let mode = p.scanner.mode in let token = p.token in - let start_pos = p.start_pos in - let end_pos = p.end_pos in - let prev_end_pos = p.prev_end_pos in + let startPos = p.startPos in + let endPos = p.endPos in + let prevEndPos = p.prevEndPos in let breadcrumbs = p.breadcrumbs in let errors = p.errors in let diagnostics = p.diagnostics in let comments = p.comments in match p.Parser.token with - | At -> ( - let attrs = parse_attributes p in + | At | DocComment (_, _) -> ( + let attrs = parseAttributes p in match p.Parser.token with | And -> attrs | _ -> @@ -2559,13 +2535,13 @@ and parse_attributes_and_binding (p : Parser.t) = p.scanner.ch <- ch; p.scanner.offset <- offset; p.scanner.offset16 <- offset16; - p.scanner.line_offset <- line_offset; + p.scanner.lineOffset <- lineOffset; p.scanner.lnum <- lnum; p.scanner.mode <- mode; p.token <- token; - p.start_pos <- start_pos; - p.end_pos <- end_pos; - p.prev_end_pos <- prev_end_pos; + p.startPos <- startPos; + p.endPos <- endPos; + p.prevEndPos <- prevEndPos; p.breadcrumbs <- breadcrumbs; p.errors <- errors; p.diagnostics <- diagnostics; @@ -2574,44 +2550,44 @@ and parse_attributes_and_binding (p : Parser.t) = | _ -> [] (* definition ::= let [rec] let-binding { and let-binding } *) -and parse_let_bindings ~attrs ~start_pos p = +and parseLetBindings ~attrs ~startPos p = Parser.optional p Let |> ignore; - let rec_flag = + let recFlag = if Parser.optional p Token.Rec then Asttypes.Recursive else Asttypes.Nonrecursive in - let first = parse_let_binding_body ~start_pos ~attrs p in + let first = parseLetBindingBody ~startPos ~attrs p in let rec loop p bindings = - let start_pos = p.Parser.start_pos in - let attrs = parse_attributes_and_binding p in + let startPos = p.Parser.startPos in + let attrs = parseAttributesAndBinding p in match p.Parser.token with | And -> Parser.next p; ignore (Parser.optional p Let); (* overparse for fault tolerance *) - let let_binding = parse_let_binding_body ~start_pos ~attrs p in - loop p (let_binding :: bindings) + let letBinding = parseLetBindingBody ~startPos ~attrs p in + loop p (letBinding :: bindings) | _ -> List.rev bindings in - (rec_flag, loop p [first]) + (recFlag, loop p [first]) (* * div -> div * Foo -> Foo.createElement * Foo.Bar -> Foo.Bar.createElement *) -and parse_jsx_name p = +and parseJsxName p = let longident = match p.Parser.token with | Lident ident -> - let ident_start = p.start_pos in - let ident_end = p.end_pos in + let identStart = p.startPos in + let identEnd = p.endPos in Parser.next p; - let loc = mk_loc ident_start ident_end in + let loc = mkLoc identStart identEnd in Location.mkloc (Longident.Lident ident) loc | Uident _ -> - let longident = parse_module_long_ident ~lowercase:true p in + let longident = parseModuleLongIdent ~lowercase:true p in Location.mkloc (Longident.Ldot (longident.txt, "createElement")) longident.loc @@ -2625,76 +2601,76 @@ and parse_jsx_name p = in Ast_helper.Exp.ident ~loc:longident.loc longident -and parse_jsx_opening_or_self_closing_element ~start_pos p = - let jsx_start_pos = p.Parser.start_pos in - let name = parse_jsx_name p in - let jsx_props = parse_jsx_props p in +and parseJsxOpeningOrSelfClosingElement ~startPos p = + let jsxStartPos = p.Parser.startPos in + let name = parseJsxName p in + let jsxProps = parseJsxProps p in let children = match p.Parser.token with | Forwardslash -> (* *) - let children_start_pos = p.Parser.start_pos in + let childrenStartPos = p.Parser.startPos in Parser.next p; - let children_end_pos = p.Parser.start_pos in - Scanner.pop_mode p.scanner Jsx; + let childrenEndPos = p.Parser.startPos in + Scanner.popMode p.scanner Jsx; Parser.expect GreaterThan p; - let loc = mk_loc children_start_pos children_end_pos in - make_list_expression loc [] None (* no children *) + let loc = mkLoc childrenStartPos childrenEndPos in + makeListExpression loc [] None (* no children *) | GreaterThan -> ( (* bar *) - let children_start_pos = p.Parser.start_pos in + let childrenStartPos = p.Parser.startPos in Parser.next p; - let spread, children = parse_jsx_children p in - let children_end_pos = p.Parser.start_pos in + let spread, children = parseJsxChildren p in + let childrenEndPos = p.Parser.startPos in let () = match p.token with | LessThanSlash -> Parser.next p | LessThan -> Parser.next p; Parser.expect Forwardslash p - | token when Grammar.is_structure_item_start token -> () + | token when Grammar.isStructureItemStart token -> () | _ -> Parser.expect LessThanSlash p in match p.Parser.token with - | (Lident _ | Uident _) when verify_jsx_opening_closing_name p name -> ( - Scanner.pop_mode p.scanner Jsx; + | (Lident _ | Uident _) when verifyJsxOpeningClosingName p name -> ( + Scanner.popMode p.scanner Jsx; Parser.expect GreaterThan p; - let loc = mk_loc children_start_pos children_end_pos in + let loc = mkLoc childrenStartPos childrenEndPos in match (spread, children) with | true, child :: _ -> child - | _ -> make_list_expression loc children None) + | _ -> makeListExpression loc children None) | token -> ( - Scanner.pop_mode p.scanner Jsx; + Scanner.popMode p.scanner Jsx; let () = - if Grammar.is_structure_item_start token then + if Grammar.isStructureItemStart token then let closing = "" in let msg = Diagnostics.message ("Missing " ^ closing) in - Parser.err ~start_pos ~end_pos:p.prev_end_pos p msg + Parser.err ~startPos ~endPos:p.prevEndPos p msg else let opening = "" in let msg = "Closing jsx name should be the same as the opening name. Did \ you mean " ^ opening ^ " ?" in - Parser.err ~start_pos ~end_pos:p.prev_end_pos p + Parser.err ~startPos ~endPos:p.prevEndPos p (Diagnostics.message msg); Parser.expect GreaterThan p in - let loc = mk_loc children_start_pos children_end_pos in + let loc = mkLoc childrenStartPos childrenEndPos in match (spread, children) with | true, child :: _ -> child - | _ -> make_list_expression loc children None)) + | _ -> makeListExpression loc children None)) | token -> - Scanner.pop_mode p.scanner Jsx; + Scanner.popMode p.scanner Jsx; Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - make_list_expression Location.none [] None + makeListExpression Location.none [] None in - let jsx_end_pos = p.prev_end_pos in - let loc = mk_loc jsx_start_pos jsx_end_pos in + let jsxEndPos = p.prevEndPos in + let loc = mkLoc jsxStartPos jsxEndPos in Ast_helper.Exp.apply ~loc name (List.concat [ - jsx_props; + jsxProps; [ (Asttypes.Labelled "children", children); ( Asttypes.Nolabel, @@ -2712,39 +2688,38 @@ and parse_jsx_opening_or_self_closing_element ~start_pos p = * * jsx-children ::= primary-expr* * => 0 or more *) -and parse_jsx p = - Scanner.set_jsx_mode p.Parser.scanner; - Parser.leave_breadcrumb p Grammar.Jsx; - let start_pos = p.Parser.start_pos in +and parseJsx p = + Scanner.setJsxMode p.Parser.scanner; + Parser.leaveBreadcrumb p Grammar.Jsx; + let startPos = p.Parser.startPos in Parser.expect LessThan p; - let jsx_expr = + let jsxExpr = match p.Parser.token with - | Lident _ | Uident _ -> - parse_jsx_opening_or_self_closing_element ~start_pos p + | Lident _ | Uident _ -> parseJsxOpeningOrSelfClosingElement ~startPos p | GreaterThan -> (* fragment: <> foo *) - parse_jsx_fragment p - | _ -> parse_jsx_name p + parseJsxFragment p + | _ -> parseJsxName p in - Parser.eat_breadcrumb p; - {jsx_expr with pexp_attributes = [jsx_attr]} + Parser.eatBreadcrumb p; + {jsxExpr with pexp_attributes = [jsxAttr]} (* * jsx-fragment ::= * | <> * | <> jsx-children *) -and parse_jsx_fragment p = - let children_start_pos = p.Parser.start_pos in +and parseJsxFragment p = + let childrenStartPos = p.Parser.startPos in Parser.expect GreaterThan p; - let _spread, children = parse_jsx_children p in - let children_end_pos = p.Parser.start_pos in - if p.token = LessThan then p.token <- Scanner.reconsider_less_than p.scanner; + let _spread, children = parseJsxChildren p in + let childrenEndPos = p.Parser.startPos in + if p.token = LessThan then p.token <- Scanner.reconsiderLessThan p.scanner; Parser.expect LessThanSlash p; - Scanner.pop_mode p.scanner Jsx; + Scanner.popMode p.scanner Jsx; Parser.expect GreaterThan p; - let loc = mk_loc children_start_pos children_end_pos in - make_list_expression loc children None + let loc = mkLoc childrenStartPos childrenEndPos in + makeListExpression loc children None (* * jsx-prop ::= @@ -2754,19 +2729,19 @@ and parse_jsx_fragment p = * | lident = ?jsx_expr * | {...jsx_expr} *) -and parse_jsx_prop p = +and parseJsxProp p = match p.Parser.token with | Question | Lident _ -> ( let optional = Parser.optional p Question in - let name, loc = parse_lident p in - let prop_loc_attr = + let name, loc = parseLident p in + let propLocAttr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in (* optional punning: *) if optional then Some ( Asttypes.Optional name, - Ast_helper.Exp.ident ~attrs:[prop_loc_attr] ~loc + Ast_helper.Exp.ident ~attrs:[propLocAttr] ~loc (Location.mkloc (Longident.Lident name) loc) ) else match p.Parser.token with @@ -2774,56 +2749,56 @@ and parse_jsx_prop p = Parser.next p; (* no punning *) let optional = Parser.optional p Question in - Scanner.pop_mode p.scanner Jsx; - let attr_expr = - let e = parse_primary_expr ~operand:(parse_atomic_expr p) p in - {e with pexp_attributes = prop_loc_attr :: e.pexp_attributes} + Scanner.popMode p.scanner Jsx; + let attrExpr = + let e = parsePrimaryExpr ~operand:(parseAtomicExpr p) p in + {e with pexp_attributes = propLocAttr :: e.pexp_attributes} in let label = if optional then Asttypes.Optional name else Asttypes.Labelled name in - Some (label, attr_expr) + Some (label, attrExpr) | _ -> - let attr_expr = - Ast_helper.Exp.ident ~loc ~attrs:[prop_loc_attr] + let attrExpr = + Ast_helper.Exp.ident ~loc ~attrs:[propLocAttr] (Location.mkloc (Longident.Lident name) loc) in let label = if optional then Asttypes.Optional name else Asttypes.Labelled name in - Some (label, attr_expr)) + Some (label, attrExpr)) (* {...props} *) | Lbrace -> ( - Scanner.pop_mode p.scanner Jsx; + Scanner.popMode p.scanner Jsx; Parser.next p; match p.Parser.token with | DotDotDot -> ( - Scanner.pop_mode p.scanner Jsx; + Scanner.popMode p.scanner Jsx; Parser.next p; - let loc = mk_loc p.Parser.start_pos p.prev_end_pos in - let prop_loc_attr = + let loc = mkLoc p.Parser.startPos p.prevEndPos in + let propLocAttr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in - let attr_expr = - let e = parse_primary_expr ~operand:(parse_expr p) p in - {e with pexp_attributes = prop_loc_attr :: e.pexp_attributes} + let attrExpr = + let e = parsePrimaryExpr ~operand:(parseExpr p) p in + {e with pexp_attributes = propLocAttr :: e.pexp_attributes} in (* using label "spreadProps" to distinguish from others *) let label = Asttypes.Labelled "_spreadProps" in match p.Parser.token with | Rbrace -> Parser.next p; - Scanner.set_jsx_mode p.scanner; - Some (label, attr_expr) + Scanner.setJsxMode p.scanner; + Some (label, attrExpr) | _ -> None) | _ -> None) | _ -> None -and parse_jsx_props p = - parse_region ~grammar:Grammar.JsxAttribute ~f:parse_jsx_prop p +and parseJsxProps p = + parseRegion ~grammar:Grammar.JsxAttribute ~f:parseJsxProp p -and parse_jsx_children p = - Scanner.pop_mode p.scanner Jsx; +and parseJsxChildren p = + Scanner.popMode p.scanner Jsx; let rec loop p children = match p.Parser.token with | Token.Eof | LessThanSlash -> children @@ -2833,19 +2808,19 @@ and parse_jsx_children p = * or is it the start of a closing tag? * reconsiderLessThan peeks at the next token and * determines the correct token to disambiguate *) - let token = Scanner.reconsider_less_than p.scanner in + let token = Scanner.reconsiderLessThan p.scanner in if token = LessThan then let child = - parse_primary_expr ~operand:(parse_atomic_expr p) ~no_call:true p + parsePrimaryExpr ~operand:(parseAtomicExpr p) ~noCall:true p in loop p (child :: children) else (* LessThanSlash *) let () = p.token <- token in children - | token when Grammar.is_jsx_child_start token -> + | token when Grammar.isJsxChildStart token -> let child = - parse_primary_expr ~operand:(parse_atomic_expr p) ~no_call:true p + parsePrimaryExpr ~operand:(parseAtomicExpr p) ~noCall:true p in loop p (child :: children) | _ -> children @@ -2854,44 +2829,42 @@ and parse_jsx_children p = match p.Parser.token with | DotDotDot -> Parser.next p; - (true, [parse_primary_expr ~operand:(parse_atomic_expr p) ~no_call:true p]) + (true, [parsePrimaryExpr ~operand:(parseAtomicExpr p) ~noCall:true p]) | _ -> let children = List.rev (loop p []) in (false, children) in - Scanner.set_jsx_mode p.scanner; + Scanner.setJsxMode p.scanner; (spread, children) -and parse_braced_or_record_expr p = - let start_pos = p.Parser.start_pos in +and parseBracedOrRecordExpr p = + let startPos = p.Parser.startPos in Parser.expect Lbrace p; match p.Parser.token with | Rbrace -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.record ~loc [] None | DotDotDot -> (* beginning of record spread, parse record *) Parser.next p; - let spread_expr = parse_constrained_or_coerced_expr p in + let spreadExpr = parseConstrainedOrCoercedExpr p in Parser.expect Comma p; - let expr = parse_record_expr ~start_pos ~spread:(Some spread_expr) [] p in + let expr = parseRecordExpr ~startPos ~spread:(Some spreadExpr) [] p in Parser.expect Rbrace p; expr | String s -> ( let field = - let loc = mk_loc p.start_pos p.end_pos in + let loc = mkLoc p.startPos p.endPos in Parser.next p; Location.mkloc (Longident.Lident s) loc in match p.Parser.token with | Colon -> Parser.next p; - let field_expr = parse_expr p in + let fieldExpr = parseExpr p in Parser.optional p Comma |> ignore; - let expr = - parse_record_expr_with_string_keys ~start_pos (field, field_expr) p - in + let expr = parseRecordExprWithStringKeys ~startPos (field, fieldExpr) p in Parser.expect Rbrace p; expr | _ -> ( @@ -2900,32 +2873,32 @@ and parse_braced_or_record_expr p = Ast_helper.Exp.constant ~loc:field.loc (Parsetree.Pconst_string (s, tag)) in - let a = parse_primary_expr ~operand:constant p in - let e = parse_binary_expr ~a p 1 in - let e = parse_ternary_expr e p in + let a = parsePrimaryExpr ~operand:constant p in + let e = parseBinaryExpr ~a p 1 in + let e = parseTernaryExpr e p in match p.Parser.token with | Semicolon -> - let expr = parse_expr_block ~first:e p in + let expr = parseExprBlock ~first:e p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in { expr with Parsetree.pexp_attributes = braces :: expr.Parsetree.pexp_attributes; } | Rbrace -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {e with pexp_attributes = braces :: e.pexp_attributes} | _ -> - let expr = parse_expr_block ~first:e p in + let expr = parseExprBlock ~first:e p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes})) | Question -> - let expr = parse_record_expr ~start_pos [] p in + let expr = parseRecordExpr ~startPos [] p in Parser.expect Rbrace p; expr (* @@ -2936,85 +2909,80 @@ and parse_braced_or_record_expr p = 2) expression x which happens to wrapped in braces Due to historical reasons, we always follow 2 *) - | Lident "async" when is_es6_arrow_expression ~in_ternary:false p -> - let expr = parse_async_arrow_expression p in - let expr = parse_expr_block ~first:expr p in + | Lident "async" when isEs6ArrowExpression ~inTernary:false p -> + let expr = parseAsyncArrowExpression p in + let expr = parseExprBlock ~first:expr p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} | Uident _ | Lident _ -> ( - let start_token = p.token in - let value_or_constructor = parse_value_or_constructor p in - match value_or_constructor.pexp_desc with - | Pexp_ident path_ident -> ( - let ident_end_pos = p.prev_end_pos in + let startToken = p.token in + let valueOrConstructor = parseValueOrConstructor p in + match valueOrConstructor.pexp_desc with + | Pexp_ident pathIdent -> ( + let identEndPos = p.prevEndPos in match p.Parser.token with | Comma -> Parser.next p; - let value_or_constructor = - match start_token with - | Uident _ -> - remove_module_name_from_punned_field_value value_or_constructor - | _ -> value_or_constructor + let valueOrConstructor = + match startToken with + | Uident _ -> removeModuleNameFromPunnedFieldValue valueOrConstructor + | _ -> valueOrConstructor in let expr = - parse_record_expr ~start_pos [(path_ident, value_or_constructor)] p + parseRecordExpr ~startPos [(pathIdent, valueOrConstructor)] p in Parser.expect Rbrace p; expr | Colon -> ( Parser.next p; - let optional = parse_optional_label p in - let field_expr = parse_expr p in - let field_expr = make_expression_optional ~optional field_expr in + let optional = parseOptionalLabel p in + let fieldExpr = parseExpr p in + let fieldExpr = makeExpressionOptional ~optional fieldExpr in match p.token with | Rbrace -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Exp.record ~loc [(path_ident, field_expr)] None + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Exp.record ~loc [(pathIdent, fieldExpr)] None | _ -> Parser.expect Comma p; - let expr = - parse_record_expr ~start_pos [(path_ident, field_expr)] p - in + let expr = parseRecordExpr ~startPos [(pathIdent, fieldExpr)] p in Parser.expect Rbrace p; expr) (* error case *) | Lident _ -> - if p.prev_end_pos.pos_lnum < p.start_pos.pos_lnum then ( + if p.prevEndPos.pos_lnum < p.startPos.pos_lnum then ( Parser.expect Comma p; let expr = - parse_record_expr ~start_pos [(path_ident, value_or_constructor)] p + parseRecordExpr ~startPos [(pathIdent, valueOrConstructor)] p in Parser.expect Rbrace p; expr) else ( Parser.expect Colon p; let expr = - parse_record_expr ~start_pos [(path_ident, value_or_constructor)] p + parseRecordExpr ~startPos [(pathIdent, valueOrConstructor)] p in Parser.expect Rbrace p; expr) | Semicolon -> - let expr = - parse_expr_block ~first:(Ast_helper.Exp.ident path_ident) p - in + let expr = parseExprBlock ~first:(Ast_helper.Exp.ident pathIdent) p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} | Rbrace -> Parser.next p; - let expr = Ast_helper.Exp.ident ~loc:path_ident.loc path_ident in - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let expr = Ast_helper.Exp.ident ~loc:pathIdent.loc pathIdent in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} | EqualGreater -> ( - let loc = mk_loc start_pos ident_end_pos in - let ident = Location.mkloc (Longident.last path_ident.txt) loc in + let loc = mkLoc startPos identEndPos in + let ident = Location.mkloc (Longident.last pathIdent.txt) loc in let a = - parse_es6_arrow_expression + parseEs6ArrowExpression ~parameters: [ TermParameter @@ -3024,129 +2992,129 @@ and parse_braced_or_record_expr p = label = Asttypes.Nolabel; expr = None; pat = Ast_helper.Pat.var ~loc:ident.loc ident; - pos = start_pos; + pos = startPos; }; ] p in - let e = parse_binary_expr ~a p 1 in - let e = parse_ternary_expr e p in + let e = parseBinaryExpr ~a p 1 in + let e = parseTernaryExpr e p in match p.Parser.token with | Semicolon -> - let expr = parse_expr_block ~first:e p in + let expr = parseExprBlock ~first:e p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} | Rbrace -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {e with pexp_attributes = braces :: e.pexp_attributes} | _ -> - let expr = parse_expr_block ~first:e p in + let expr = parseExprBlock ~first:e p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes}) | _ -> ( - Parser.leave_breadcrumb p Grammar.ExprBlock; + Parser.leaveBreadcrumb p Grammar.ExprBlock; let a = - parse_primary_expr - ~operand:(Ast_helper.Exp.ident ~loc:path_ident.loc path_ident) + parsePrimaryExpr + ~operand:(Ast_helper.Exp.ident ~loc:pathIdent.loc pathIdent) p in - let e = parse_binary_expr ~a p 1 in - let e = parse_ternary_expr e p in - Parser.eat_breadcrumb p; + let e = parseBinaryExpr ~a p 1 in + let e = parseTernaryExpr e p in + Parser.eatBreadcrumb p; match p.Parser.token with | Semicolon -> - let expr = parse_expr_block ~first:e p in + let expr = parseExprBlock ~first:e p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} | Rbrace -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {e with pexp_attributes = braces :: e.pexp_attributes} | _ -> - let expr = parse_expr_block ~first:e p in + let expr = parseExprBlock ~first:e p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes})) | _ -> ( - Parser.leave_breadcrumb p Grammar.ExprBlock; - let a = parse_primary_expr ~operand:value_or_constructor p in - let e = parse_binary_expr ~a p 1 in - let e = parse_ternary_expr e p in - Parser.eat_breadcrumb p; + Parser.leaveBreadcrumb p Grammar.ExprBlock; + let a = parsePrimaryExpr ~operand:valueOrConstructor p in + let e = parseBinaryExpr ~a p 1 in + let e = parseTernaryExpr e p in + Parser.eatBreadcrumb p; match p.Parser.token with | Semicolon -> - let expr = parse_expr_block ~first:e p in + let expr = parseExprBlock ~first:e p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} | Rbrace -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {e with pexp_attributes = braces :: e.pexp_attributes} | _ -> - let expr = parse_expr_block ~first:e p in + let expr = parseExprBlock ~first:e p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes})) | _ -> - let expr = parse_expr_block p in + let expr = parseExprBlock p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let braces = make_braces_attr loc in + let loc = mkLoc startPos p.prevEndPos in + let braces = makeBracesAttr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} -and parse_record_expr_row_with_string_key p = +and parseRecordExprRowWithStringKey p = match p.Parser.token with | String s -> ( - let loc = mk_loc p.start_pos p.end_pos in + let loc = mkLoc p.startPos p.endPos in Parser.next p; let field = Location.mkloc (Longident.Lident s) loc in match p.Parser.token with | Colon -> Parser.next p; - let field_expr = parse_expr p in - Some (field, field_expr) + let fieldExpr = parseExpr p in + Some (field, fieldExpr) | _ -> Some (field, Ast_helper.Exp.ident ~loc:field.loc field)) | _ -> None -and parse_record_expr_row p = - let attrs = parse_attributes p in +and parseRecordExprRow p = + let attrs = parseAttributes p in let () = match p.Parser.token with | Token.DotDotDot -> - Parser.err p (Diagnostics.message ErrorMessages.record_expr_spread); + Parser.err p (Diagnostics.message ErrorMessages.recordExprSpread); Parser.next p | _ -> () in match p.Parser.token with | Lident _ | Uident _ -> ( - let start_token = p.token in - let field = parse_value_path p in + let startToken = p.token in + let field = parseValuePath p in match p.Parser.token with | Colon -> Parser.next p; - let optional = parse_optional_label p in - let field_expr = parse_expr p in - let field_expr = make_expression_optional ~optional field_expr in - Some (field, field_expr) + let optional = parseOptionalLabel p in + let fieldExpr = parseExpr p in + let fieldExpr = makeExpressionOptional ~optional fieldExpr in + Some (field, fieldExpr) | _ -> let value = Ast_helper.Exp.ident ~loc:field.loc ~attrs field in let value = - match start_token with - | Uident _ -> remove_module_name_from_punned_field_value value + match startToken with + | Uident _ -> removeModuleNameFromPunnedFieldValue value | _ -> value in Some (field, value)) @@ -3154,35 +3122,35 @@ and parse_record_expr_row p = Parser.next p; match p.Parser.token with | Lident _ | Uident _ -> - let start_token = p.token in - let field = parse_value_path p in + let startToken = p.token in + let field = parseValuePath p in let value = Ast_helper.Exp.ident ~loc:field.loc ~attrs field in let value = - match start_token with - | Uident _ -> remove_module_name_from_punned_field_value value + match startToken with + | Uident _ -> removeModuleNameFromPunnedFieldValue value | _ -> value in - Some (field, make_expression_optional ~optional:true value) + Some (field, makeExpressionOptional ~optional:true value) | _ -> None) | _ -> None -and parse_record_expr_with_string_keys ~start_pos first_row p = +and parseRecordExprWithStringKeys ~startPos firstRow p = let rows = - first_row - :: parse_comma_delimited_region ~grammar:Grammar.RecordRowsStringKey - ~closing:Rbrace ~f:parse_record_expr_row_with_string_key p + firstRow + :: parseCommaDelimitedRegion ~grammar:Grammar.RecordRowsStringKey + ~closing:Rbrace ~f:parseRecordExprRowWithStringKey p in - let loc = mk_loc start_pos p.end_pos in - let record_str_expr = + let loc = mkLoc startPos p.endPos in + let recordStrExpr = Ast_helper.Str.eval ~loc (Ast_helper.Exp.record ~loc rows None) in Ast_helper.Exp.extension ~loc - (Location.mkloc "obj" loc, Parsetree.PStr [record_str_expr]) + (Location.mkloc "obj" loc, Parsetree.PStr [recordStrExpr]) -and parse_record_expr ~start_pos ?(spread = None) rows p = +and parseRecordExpr ~startPos ?(spread = None) rows p = let exprs = - parse_comma_delimited_region ~grammar:Grammar.RecordRows ~closing:Rbrace - ~f:parse_record_expr_row p + parseCommaDelimitedRegion ~grammar:Grammar.RecordRows ~closing:Rbrace + ~f:parseRecordExprRow p in let rows = List.concat [rows; exprs] in let () = @@ -3192,82 +3160,82 @@ and parse_record_expr ~start_pos ?(spread = None) rows p = Parser.err p (Diagnostics.message msg) | _rows -> () in - let loc = mk_loc start_pos p.end_pos in + let loc = mkLoc startPos p.endPos in Ast_helper.Exp.record ~loc rows spread -and parse_newline_or_semicolon_expr_block p = +and parseNewlineOrSemicolonExprBlock p = match p.Parser.token with | Semicolon -> Parser.next p - | token when Grammar.is_block_expr_start token -> - if p.prev_end_pos.pos_lnum < p.start_pos.pos_lnum then () + | token when Grammar.isBlockExprStart token -> + if p.prevEndPos.pos_lnum < p.startPos.pos_lnum then () else - Parser.err ~start_pos:p.prev_end_pos ~end_pos:p.end_pos p + Parser.err ~startPos:p.prevEndPos ~endPos:p.endPos p (Diagnostics.message "consecutive expressions on a line must be separated by ';' or a \ newline") | _ -> () -and parse_expr_block_item p = - let start_pos = p.Parser.start_pos in - let attrs = parse_attributes p in +and parseExprBlockItem p = + let startPos = p.Parser.startPos in + let attrs = parseAttributes p in match p.Parser.token with | Module -> ( Parser.next p; match p.token with | Lparen -> - let expr = parse_first_class_module_expr ~start_pos p in - let a = parse_primary_expr ~operand:expr p in - let expr = parse_binary_expr ~a p 1 in - parse_ternary_expr expr p + let expr = parseFirstClassModuleExpr ~startPos p in + let a = parsePrimaryExpr ~operand:expr p in + let expr = parseBinaryExpr ~a p 1 in + parseTernaryExpr expr p | _ -> let name = match p.Parser.token with | Uident ident -> - let loc = mk_loc p.start_pos p.end_pos in + let loc = mkLoc p.startPos p.endPos in Parser.next p; Location.mkloc ident loc | t -> Parser.err p (Diagnostics.uident t); Location.mknoloc "_" in - let body = parse_module_binding_body p in - parse_newline_or_semicolon_expr_block p; - let expr = parse_expr_block p in - let loc = mk_loc start_pos p.prev_end_pos in + let body = parseModuleBindingBody p in + parseNewlineOrSemicolonExprBlock p; + let expr = parseExprBlock p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.letmodule ~loc name body expr) | Exception -> - let extension_constructor = parse_exception_def ~attrs p in - parse_newline_or_semicolon_expr_block p; - let block_expr = parse_expr_block p in - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Exp.letexception ~loc extension_constructor block_expr + let extensionConstructor = parseExceptionDef ~attrs p in + parseNewlineOrSemicolonExprBlock p; + let blockExpr = parseExprBlock p in + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Exp.letexception ~loc extensionConstructor blockExpr | Open -> - let od = parse_open_description ~attrs p in - parse_newline_or_semicolon_expr_block p; - let block_expr = parse_expr_block p in - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Exp.open_ ~loc od.popen_override od.popen_lid block_expr + let od = parseOpenDescription ~attrs p in + parseNewlineOrSemicolonExprBlock p; + let blockExpr = parseExprBlock p in + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Exp.open_ ~loc od.popen_override od.popen_lid blockExpr | Let -> - let rec_flag, let_bindings = parse_let_bindings ~attrs ~start_pos p in - parse_newline_or_semicolon_expr_block p; + let recFlag, letBindings = parseLetBindings ~attrs ~startPos p in + parseNewlineOrSemicolonExprBlock p; let next = - if Grammar.is_block_expr_start p.Parser.token then parse_expr_block p + if Grammar.isBlockExprStart p.Parser.token then parseExprBlock p else - let loc = mk_loc p.start_pos p.end_pos in + let loc = mkLoc p.startPos p.endPos in Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None in - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Exp.let_ ~loc rec_flag let_bindings next + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Exp.let_ ~loc recFlag letBindings next | _ -> let e1 = - let expr = parse_expr p in + let expr = parseExpr p in {expr with pexp_attributes = List.concat [attrs; expr.pexp_attributes]} in - parse_newline_or_semicolon_expr_block p; - if Grammar.is_block_expr_start p.Parser.token then - let e2 = parse_expr_block p in + parseNewlineOrSemicolonExprBlock p; + if Grammar.isBlockExprStart p.Parser.token then + let e2 = parseExprBlock p in let loc = {e1.pexp_loc with loc_end = e2.pexp_loc.loc_end} in Ast_helper.Exp.sequence ~loc e1 e2 else e1 @@ -3285,160 +3253,159 @@ and parse_expr_block_item p = * note: semi should be made optional * a block of expression is always *) -and parse_expr_block ?first p = - Parser.leave_breadcrumb p Grammar.ExprBlock; +and parseExprBlock ?first p = + Parser.leaveBreadcrumb p Grammar.ExprBlock; let item = match first with | Some e -> e - | None -> parse_expr_block_item p + | None -> parseExprBlockItem p in - parse_newline_or_semicolon_expr_block p; - let block_expr = - if Grammar.is_block_expr_start p.Parser.token then - let next = parse_expr_block_item p in + parseNewlineOrSemicolonExprBlock p; + let blockExpr = + if Grammar.isBlockExprStart p.Parser.token then + let next = parseExprBlockItem p in let loc = {item.pexp_loc with loc_end = next.pexp_loc.loc_end} in Ast_helper.Exp.sequence ~loc item next else item in - Parser.eat_breadcrumb p; - over_parse_constrained_or_coerced_or_arrow_expression p block_expr + Parser.eatBreadcrumb p; + overParseConstrainedOrCoercedOrArrowExpression p blockExpr -and parse_async_arrow_expression ?(arrow_attrs = []) p = - let start_pos = p.Parser.start_pos in +and parseAsyncArrowExpression ?(arrowAttrs = []) p = + let startPos = p.Parser.startPos in Parser.expect (Lident "async") p; - let async_attr = make_async_attr (mk_loc start_pos p.prev_end_pos) in - parse_es6_arrow_expression - ~arrow_attrs:(async_attr :: arrow_attrs) - ~arrow_start_pos:(Some start_pos) p - -and parse_await_expression p = - let await_loc = mk_loc p.Parser.start_pos p.end_pos in - let await_attr = make_await_attr await_loc in + let asyncAttr = makeAsyncAttr (mkLoc startPos p.prevEndPos) in + parseEs6ArrowExpression ~arrowAttrs:(asyncAttr :: arrowAttrs) + ~arrowStartPos:(Some startPos) p + +and parseAwaitExpression p = + let awaitLoc = mkLoc p.Parser.startPos p.endPos in + let awaitAttr = makeAwaitAttr awaitLoc in Parser.expect Await p; - let token_prec = Token.precedence MinusGreater in - let expr = parse_binary_expr ~context:OrdinaryExpr p token_prec in + let tokenPrec = Token.precedence MinusGreater in + let expr = parseBinaryExpr ~context:OrdinaryExpr p tokenPrec in { expr with - pexp_attributes = await_attr :: expr.pexp_attributes; - pexp_loc = {expr.pexp_loc with loc_start = await_loc.loc_start}; + pexp_attributes = awaitAttr :: expr.pexp_attributes; + pexp_loc = {expr.pexp_loc with loc_start = awaitLoc.loc_start}; } -and parse_try_expression p = - let start_pos = p.Parser.start_pos in +and parseTryExpression p = + let startPos = p.Parser.startPos in Parser.expect Try p; - let expr = parse_expr ~context:WhenExpr p in + let expr = parseExpr ~context:WhenExpr p in Parser.expect Res_token.catch p; Parser.expect Lbrace p; - let cases = parse_pattern_matching p in + let cases = parsePatternMatching p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.try_ ~loc expr cases -and parse_if_condition p = - Parser.leave_breadcrumb p Grammar.IfCondition; +and parseIfCondition p = + Parser.leaveBreadcrumb p Grammar.IfCondition; (* doesn't make sense to try es6 arrow here? *) - let condition_expr = parse_expr ~context:WhenExpr p in - Parser.eat_breadcrumb p; - condition_expr + let conditionExpr = parseExpr ~context:WhenExpr p in + Parser.eatBreadcrumb p; + conditionExpr -and parse_then_branch p = - Parser.leave_breadcrumb p IfBranch; +and parseThenBranch p = + Parser.leaveBreadcrumb p IfBranch; Parser.expect Lbrace p; - let then_expr = parse_expr_block p in + let thenExpr = parseExprBlock p in Parser.expect Rbrace p; - Parser.eat_breadcrumb p; - then_expr + Parser.eatBreadcrumb p; + thenExpr -and parse_else_branch p = +and parseElseBranch p = Parser.expect Lbrace p; - let block_expr = parse_expr_block p in + let blockExpr = parseExprBlock p in Parser.expect Rbrace p; - block_expr + blockExpr -and parse_if_expr start_pos p = - let condition_expr = parse_if_condition p in - let then_expr = parse_then_branch p in - let else_expr = +and parseIfExpr startPos p = + let conditionExpr = parseIfCondition p in + let thenExpr = parseThenBranch p in + let elseExpr = match p.Parser.token with | Else -> - Parser.end_region p; - Parser.leave_breadcrumb p Grammar.ElseBranch; + Parser.endRegion p; + Parser.leaveBreadcrumb p Grammar.ElseBranch; Parser.next p; - Parser.begin_region p; - let else_expr = + Parser.beginRegion p; + let elseExpr = match p.token with - | If -> parse_if_or_if_let_expression p - | _ -> parse_else_branch p + | If -> parseIfOrIfLetExpression p + | _ -> parseElseBranch p in - Parser.eat_breadcrumb p; - Parser.end_region p; - Some else_expr + Parser.eatBreadcrumb p; + Parser.endRegion p; + Some elseExpr | _ -> - Parser.end_region p; + Parser.endRegion p; None in - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Exp.ifthenelse ~loc condition_expr then_expr else_expr + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Exp.ifthenelse ~loc conditionExpr thenExpr elseExpr -and parse_if_let_expr start_pos p = - let pattern = parse_pattern p in +and parseIfLetExpr startPos p = + let pattern = parsePattern p in Parser.expect Equal p; - let condition_expr = parse_if_condition p in - let then_expr = parse_then_branch p in - let else_expr = + let conditionExpr = parseIfCondition p in + let thenExpr = parseThenBranch p in + let elseExpr = match p.Parser.token with | Else -> - Parser.end_region p; - Parser.leave_breadcrumb p Grammar.ElseBranch; + Parser.endRegion p; + Parser.leaveBreadcrumb p Grammar.ElseBranch; Parser.next p; - Parser.begin_region p; - let else_expr = + Parser.beginRegion p; + let elseExpr = match p.token with - | If -> parse_if_or_if_let_expression p - | _ -> parse_else_branch p + | If -> parseIfOrIfLetExpression p + | _ -> parseElseBranch p in - Parser.eat_breadcrumb p; - Parser.end_region p; - else_expr + Parser.eatBreadcrumb p; + Parser.endRegion p; + elseExpr | _ -> - Parser.end_region p; - let start_pos = p.Parser.start_pos in - let loc = mk_loc start_pos p.prev_end_pos in + Parser.endRegion p; + let startPos = p.Parser.startPos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None in - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.match_ - ~attrs:[if_let_attr; suppress_fragile_match_warning_attr] - ~loc condition_expr + ~attrs:[ifLetAttr; suppressFragileMatchWarningAttr] + ~loc conditionExpr [ - Ast_helper.Exp.case pattern then_expr; - Ast_helper.Exp.case (Ast_helper.Pat.any ()) else_expr; + Ast_helper.Exp.case pattern thenExpr; + Ast_helper.Exp.case (Ast_helper.Pat.any ()) elseExpr; ] -and parse_if_or_if_let_expression p = - Parser.begin_region p; - Parser.leave_breadcrumb p Grammar.ExprIf; - let start_pos = p.Parser.start_pos in +and parseIfOrIfLetExpression p = + Parser.beginRegion p; + Parser.leaveBreadcrumb p Grammar.ExprIf; + let startPos = p.Parser.startPos in Parser.expect If p; let expr = match p.Parser.token with | Let -> Parser.next p; - let if_let_expr = parse_if_let_expr start_pos p in - Parser.err ~start_pos:if_let_expr.pexp_loc.loc_start - ~end_pos:if_let_expr.pexp_loc.loc_end p - (Diagnostics.message (ErrorMessages.experimental_if_let if_let_expr)); - if_let_expr - | _ -> parse_if_expr start_pos p - in - Parser.eat_breadcrumb p; + let ifLetExpr = parseIfLetExpr startPos p in + Parser.err ~startPos:ifLetExpr.pexp_loc.loc_start + ~endPos:ifLetExpr.pexp_loc.loc_end p + (Diagnostics.message (ErrorMessages.experimentalIfLet ifLetExpr)); + ifLetExpr + | _ -> parseIfExpr startPos p + in + Parser.eatBreadcrumb p; expr -and parse_for_rest has_opening_paren pattern start_pos p = +and parseForRest hasOpeningParen pattern startPos p = Parser.expect In p; - let e1 = parse_expr p in + let e1 = parseExpr p in let direction = match p.Parser.token with | Lident "to" -> Asttypes.Upto @@ -3448,125 +3415,125 @@ and parse_for_rest has_opening_paren pattern start_pos p = Asttypes.Upto in if p.Parser.token = Eof then - Parser.err ~start_pos:p.start_pos p + Parser.err ~startPos:p.startPos p (Diagnostics.unexpected p.Parser.token p.breadcrumbs) else Parser.next p; - let e2 = parse_expr ~context:WhenExpr p in - if has_opening_paren then Parser.expect Rparen p; + let e2 = parseExpr ~context:WhenExpr p in + if hasOpeningParen then Parser.expect Rparen p; Parser.expect Lbrace p; - let body_expr = parse_expr_block p in + let bodyExpr = parseExprBlock p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Exp.for_ ~loc pattern e1 e2 direction body_expr + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Exp.for_ ~loc pattern e1 e2 direction bodyExpr -and parse_for_expression p = - let start_pos = p.Parser.start_pos in - Parser.leave_breadcrumb p Grammar.ExprFor; +and parseForExpression p = + let startPos = p.Parser.startPos in + Parser.leaveBreadcrumb p Grammar.ExprFor; Parser.expect For p; - Parser.begin_region p; - let for_expr = + Parser.beginRegion p; + let forExpr = match p.token with | Lparen -> ( - let lparen = p.start_pos in + let lparen = p.startPos in Parser.next p; match p.token with | Rparen -> Parser.next p; - let unit_pattern = - let loc = mk_loc lparen p.prev_end_pos in + let unitPattern = + let loc = mkLoc lparen p.prevEndPos in let lid = Location.mkloc (Longident.Lident "()") loc in Ast_helper.Pat.construct lid None in - parse_for_rest false - (parse_alias_pattern ~attrs:[] unit_pattern p) - start_pos p + parseForRest false + (parseAliasPattern ~attrs:[] unitPattern p) + startPos p | _ -> ( - Parser.leave_breadcrumb p Grammar.Pattern; - let pat = parse_pattern p in - Parser.eat_breadcrumb p; + Parser.leaveBreadcrumb p Grammar.Pattern; + let pat = parsePattern p in + Parser.eatBreadcrumb p; match p.token with | Comma -> Parser.next p; - let tuple_pattern = - parse_tuple_pattern ~attrs:[] ~start_pos:lparen ~first:pat p + let tuplePattern = + parseTuplePattern ~attrs:[] ~startPos:lparen ~first:pat p in - let pattern = parse_alias_pattern ~attrs:[] tuple_pattern p in - parse_for_rest false pattern start_pos p - | _ -> parse_for_rest true pat start_pos p)) + let pattern = parseAliasPattern ~attrs:[] tuplePattern p in + parseForRest false pattern startPos p + | _ -> parseForRest true pat startPos p)) | _ -> - Parser.leave_breadcrumb p Grammar.Pattern; - let pat = parse_pattern p in - Parser.eat_breadcrumb p; - parse_for_rest false pat start_pos p + Parser.leaveBreadcrumb p Grammar.Pattern; + let pat = parsePattern p in + Parser.eatBreadcrumb p; + parseForRest false pat startPos p in - Parser.eat_breadcrumb p; - Parser.end_region p; - for_expr + Parser.eatBreadcrumb p; + Parser.endRegion p; + forExpr -and parse_while_expression p = - let start_pos = p.Parser.start_pos in +and parseWhileExpression p = + let startPos = p.Parser.startPos in Parser.expect While p; - let expr1 = parse_expr ~context:WhenExpr p in + let expr1 = parseExpr ~context:WhenExpr p in Parser.expect Lbrace p; - let expr2 = parse_expr_block p in + let expr2 = parseExprBlock p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.while_ ~loc expr1 expr2 -and parse_pattern_guard p = +and parsePatternGuard p = match p.Parser.token with | When | If -> Parser.next p; - Some (parse_expr ~context:WhenExpr p) + Some (parseExpr ~context:WhenExpr p) | _ -> None -and parse_pattern_match_case p = - Parser.begin_region p; - Parser.leave_breadcrumb p Grammar.PatternMatchCase; +and parsePatternMatchCase p = + Parser.beginRegion p; + Parser.leaveBreadcrumb p Grammar.PatternMatchCase; match p.Parser.token with | Token.Bar -> Parser.next p; - Parser.leave_breadcrumb p Grammar.Pattern; - let lhs = parse_pattern p in - Parser.eat_breadcrumb p; - let guard = parse_pattern_guard p in + Parser.leaveBreadcrumb p Grammar.Pattern; + let lhs = parsePattern p in + Parser.eatBreadcrumb p; + let guard = parsePatternGuard p in let () = match p.token with | EqualGreater -> Parser.next p - | _ -> Recover.recover_equal_greater p + | _ -> Recover.recoverEqualGreater p in - let rhs = parse_expr_block p in - Parser.end_region p; - Parser.eat_breadcrumb p; + let rhs = parseExprBlock p in + Parser.endRegion p; + Parser.eatBreadcrumb p; Some (Ast_helper.Exp.case lhs ?guard rhs) | _ -> - Parser.end_region p; - Parser.eat_breadcrumb p; + Parser.endRegion p; + Parser.eatBreadcrumb p; None -and parse_pattern_matching p = +and parsePatternMatching p = let cases = - parse_delimited_region ~grammar:Grammar.PatternMatching ~closing:Rbrace - ~f:parse_pattern_match_case p + parseDelimitedRegion ~grammar:Grammar.PatternMatching ~closing:Rbrace + ~f:parsePatternMatchCase p in let () = match cases with | [] -> - Parser.err ~start_pos:p.prev_end_pos p + Parser.err ~startPos:p.prevEndPos p (Diagnostics.message "Pattern matching needs at least one case") | _ -> () in cases -and parse_switch_expression p = - let start_pos = p.Parser.start_pos in +and parseSwitchExpression p = + let startPos = p.Parser.startPos in Parser.expect Switch p; - let switch_expr = parse_expr ~context:WhenExpr p in + let switchExpr = parseExpr ~context:WhenExpr p in Parser.expect Lbrace p; - let cases = parse_pattern_matching p in + let cases = parsePatternMatching p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Exp.match_ ~loc switch_expr cases + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Exp.match_ ~loc switchExpr cases (* * argument ::= @@ -3586,11 +3553,11 @@ and parse_switch_expression p = * dotted_argument ::= * | . argument *) -and parse_argument p : argument option = +and parseArgument p : argument option = if p.Parser.token = Token.Tilde || p.token = Dot || p.token = Underscore - || Grammar.is_expr_start p.token + || Grammar.isExprStart p.token then match p.Parser.token with | Dot -> ( @@ -3599,21 +3566,21 @@ and parse_argument p : argument option = match p.token with (* apply(.) *) | Rparen -> - let unit_expr = + let unitExpr = Ast_helper.Exp.construct (Location.mknoloc (Longident.Lident "()")) None in - Some {dotted; label = Asttypes.Nolabel; expr = unit_expr} - | _ -> parse_argument2 p ~dotted) - | _ -> parse_argument2 p ~dotted:false + Some {dotted; label = Asttypes.Nolabel; expr = unitExpr} + | _ -> parseArgument2 p ~dotted) + | _ -> parseArgument2 p ~dotted:false else None -and parse_argument2 p ~dotted : argument option = +and parseArgument2 p ~dotted : argument option = match p.Parser.token with (* foo(_), do not confuse with foo(_ => x), TODO: performance *) - | Underscore when not (is_es6_arrow_expression ~in_ternary:false p) -> - let loc = mk_loc p.start_pos p.end_pos in + | Underscore when not (isEs6ArrowExpression ~inTernary:false p) -> + let loc = mkLoc p.startPos p.endPos in Parser.next p; let expr = Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "_") loc) @@ -3624,21 +3591,21 @@ and parse_argument2 p ~dotted : argument option = (* TODO: nesting of pattern matches not intuitive for error recovery *) match p.Parser.token with | Lident ident -> ( - let start_pos = p.start_pos in + let startPos = p.startPos in Parser.next p; - let end_pos = p.prev_end_pos in - let loc = mk_loc start_pos end_pos in - let prop_loc_attr = + let endPos = p.prevEndPos in + let loc = mkLoc startPos endPos in + let propLocAttr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in - let ident_expr = - Ast_helper.Exp.ident ~attrs:[prop_loc_attr] ~loc + let identExpr = + Ast_helper.Exp.ident ~attrs:[propLocAttr] ~loc (Location.mkloc (Longident.Lident ident) loc) in match p.Parser.token with | Question -> Parser.next p; - Some {dotted; label = Optional ident; expr = ident_expr} + Some {dotted; label = Optional ident; expr = identExpr} | Equal -> Parser.next p; let label = @@ -3650,44 +3617,43 @@ and parse_argument2 p ~dotted : argument option = in let expr = match p.Parser.token with - | Underscore when not (is_es6_arrow_expression ~in_ternary:false p) -> - let loc = mk_loc p.start_pos p.end_pos in + | Underscore when not (isEs6ArrowExpression ~inTernary:false p) -> + let loc = mkLoc p.startPos p.endPos in Parser.next p; Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "_") loc) | _ -> - let expr = parse_constrained_or_coerced_expr p in - {expr with pexp_attributes = prop_loc_attr :: expr.pexp_attributes} + let expr = parseConstrainedOrCoercedExpr p in + {expr with pexp_attributes = propLocAttr :: expr.pexp_attributes} in Some {dotted; label; expr} | Colon -> Parser.next p; - let typ = parse_typ_expr p in - let loc = mk_loc start_pos p.prev_end_pos in + let typ = parseTypExpr p in + let loc = mkLoc startPos p.prevEndPos in let expr = - Ast_helper.Exp.constraint_ ~attrs:[prop_loc_attr] ~loc ident_expr typ + Ast_helper.Exp.constraint_ ~attrs:[propLocAttr] ~loc identExpr typ in Some {dotted; label = Labelled ident; expr} - | _ -> Some {dotted; label = Labelled ident; expr = ident_expr}) + | _ -> Some {dotted; label = Labelled ident; expr = identExpr}) | t -> Parser.err p (Diagnostics.lident t); - Some {dotted; label = Nolabel; expr = Recover.default_expr ()}) - | _ -> - Some {dotted; label = Nolabel; expr = parse_constrained_or_coerced_expr p} + Some {dotted; label = Nolabel; expr = Recover.defaultExpr ()}) + | _ -> Some {dotted; label = Nolabel; expr = parseConstrainedOrCoercedExpr p} -and parse_call_expr p fun_expr = +and parseCallExpr p funExpr = Parser.expect Lparen p; - let start_pos = p.Parser.start_pos in - Parser.leave_breadcrumb p Grammar.ExprCall; + let startPos = p.Parser.startPos in + Parser.leaveBreadcrumb p Grammar.ExprCall; let args = - parse_comma_delimited_region ~grammar:Grammar.ArgumentList ~closing:Rparen - ~f:parse_argument p + parseCommaDelimitedRegion ~grammar:Grammar.ArgumentList ~closing:Rparen + ~f:parseArgument p in - let res_partial_attr = - let loc = mk_loc start_pos p.prev_end_pos in + let resPartialAttr = + let loc = mkLoc startPos p.prevEndPos in (Location.mkloc "res.partial" loc, Parsetree.PStr []) in - let is_partial = + let isPartial = match p.token with | DotDotDot when args <> [] -> Parser.next p; @@ -3698,7 +3664,7 @@ and parse_call_expr p fun_expr = let args = match args with | [] -> - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in (* No args -> unit sugar: `foo()` *) [ { @@ -3722,7 +3688,7 @@ and parse_call_expr p fun_expr = } as expr; }; ] - when (not loc.loc_ghost) && p.mode = ParseForTypeChecker && not is_partial + when (not loc.loc_ghost) && p.mode = ParseForTypeChecker && not isPartial -> (* Since there is no syntax space for arity zero vs arity one, * we expand @@ -3753,7 +3719,7 @@ and parse_call_expr p fun_expr = ] | args -> args in - let loc = {fun_expr.pexp_loc with loc_end = p.prev_end_pos} in + let loc = {funExpr.pexp_loc with loc_end = p.prevEndPos} in let args = match args with | {dotted = d; label = lbl; expr} :: args -> @@ -3767,44 +3733,44 @@ and parse_call_expr p fun_expr = | [] -> [] in let apply = - Ext_list.fold_left args fun_expr (fun call_body group -> + Ext_list.fold_left args funExpr (fun callBody group -> let dotted, args = group in - let args, wrap = process_underscore_application p args in + let args, wrap = processUnderscoreApplication p args in let exp = let uncurried = - p.uncurried_config |> Res_uncurried.from_dotted ~dotted + p.uncurried_config |> Res_uncurried.fromDotted ~dotted in - let attrs = if uncurried then [uncurried_app_attr] else [] in - let attrs = if is_partial then res_partial_attr :: attrs else attrs in - Ast_helper.Exp.apply ~loc ~attrs call_body args + let attrs = if uncurried then [uncurriedAppAttr] else [] in + let attrs = if isPartial then resPartialAttr :: attrs else attrs in + Ast_helper.Exp.apply ~loc ~attrs callBody args in wrap exp) in - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; apply -and parse_value_or_constructor p = - let start_pos = p.Parser.start_pos in +and parseValueOrConstructor p = + let startPos = p.Parser.startPos in let rec aux p acc = match p.Parser.token with | Uident ident -> ( - let end_pos_lident = p.end_pos in + let endPosLident = p.endPos in Parser.next p; match p.Parser.token with | Dot -> Parser.next p; aux p (ident :: acc) - | Lparen when p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> - let lparen = p.start_pos in - let args = parse_constructor_args p in - let rparen = p.prev_end_pos in - let lident = build_longident (ident :: acc) in + | Lparen when p.prevEndPos.pos_lnum == p.startPos.pos_lnum -> + let lparen = p.startPos in + let args = parseConstructorArgs p in + let rparen = p.prevEndPos in + let lident = buildLongident (ident :: acc) in let tail = match args with | [] -> None | [({Parsetree.pexp_desc = Pexp_tuple _} as arg)] as args -> - let loc = mk_loc lparen rparen in + let loc = mkLoc lparen rparen in if p.mode = ParseForTypeChecker then (* Some(1, 2) for type-checker *) Some arg @@ -3813,43 +3779,43 @@ and parse_value_or_constructor p = Some (Ast_helper.Exp.tuple ~loc args) | [arg] -> Some arg | args -> - let loc = mk_loc lparen rparen in + let loc = mkLoc lparen rparen in Some (Ast_helper.Exp.tuple ~loc args) in - let loc = mk_loc start_pos p.prev_end_pos in - let ident_loc = mk_loc start_pos end_pos_lident in - Ast_helper.Exp.construct ~loc (Location.mkloc lident ident_loc) tail + let loc = mkLoc startPos p.prevEndPos in + let identLoc = mkLoc startPos endPosLident in + Ast_helper.Exp.construct ~loc (Location.mkloc lident identLoc) tail | _ -> - let loc = mk_loc start_pos p.prev_end_pos in - let lident = build_longident (ident :: acc) in + let loc = mkLoc startPos p.prevEndPos in + let lident = buildLongident (ident :: acc) in Ast_helper.Exp.construct ~loc (Location.mkloc lident loc) None) | Lident ident -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in - let lident = build_longident (ident :: acc) in + let loc = mkLoc startPos p.prevEndPos in + let lident = buildLongident (ident :: acc) in Ast_helper.Exp.ident ~loc (Location.mkloc lident loc) | token -> if acc = [] then ( - Parser.next_unsafe p; + Parser.nextUnsafe p; Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Recover.default_expr ()) + Recover.defaultExpr ()) else - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - let lident = build_longident ("_" :: acc) in + let lident = buildLongident ("_" :: acc) in Ast_helper.Exp.ident ~loc (Location.mkloc lident loc) in aux p [] -and parse_poly_variant_expr p = - let start_pos = p.start_pos in - let ident, _loc = parse_hash_ident ~start_pos p in +and parsePolyVariantExpr p = + let startPos = p.startPos in + let ident, _loc = parseHashIdent ~startPos p in match p.Parser.token with - | Lparen when p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> - let lparen = p.start_pos in - let args = parse_constructor_args p in - let rparen = p.prev_end_pos in - let loc_paren = mk_loc lparen rparen in + | Lparen when p.prevEndPos.pos_lnum == p.startPos.pos_lnum -> + let lparen = p.startPos in + let args = parseConstructorArgs p in + let rparen = p.prevEndPos in + let loc_paren = mkLoc lparen rparen in let tail = match args with | [] -> None @@ -3865,23 +3831,23 @@ and parse_poly_variant_expr p = (* #a((1, 2)) for printer *) Some (Ast_helper.Exp.tuple ~loc:loc_paren args) in - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.variant ~loc ident tail | _ -> - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.variant ~loc ident None -and parse_constructor_args p = - let lparen = p.Parser.start_pos in +and parseConstructorArgs p = + let lparen = p.Parser.startPos in Parser.expect Lparen p; let args = - parse_comma_delimited_region ~grammar:Grammar.ExprList - ~f:parse_constrained_expr_region ~closing:Rparen p + parseCommaDelimitedRegion ~grammar:Grammar.ExprList + ~f:parseConstrainedExprRegion ~closing:Rparen p in Parser.expect Rparen p; match args with | [] -> - let loc = mk_loc lparen p.prev_end_pos in + let loc = mkLoc lparen p.prevEndPos in [ Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) @@ -3889,105 +3855,105 @@ and parse_constructor_args p = ] | args -> args -and parse_tuple_expr ~first ~start_pos p = +and parseTupleExpr ~first ~startPos p = let exprs = first - :: parse_comma_delimited_region p ~grammar:Grammar.ExprList ~closing:Rparen - ~f:parse_constrained_expr_region + :: parseCommaDelimitedRegion p ~grammar:Grammar.ExprList ~closing:Rparen + ~f:parseConstrainedExprRegion in Parser.expect Rparen p; let () = match exprs with | [_] -> - Parser.err ~start_pos ~end_pos:p.prev_end_pos p - (Diagnostics.message ErrorMessages.tuple_single_element) + Parser.err ~startPos ~endPos:p.prevEndPos p + (Diagnostics.message ErrorMessages.tupleSingleElement) | _ -> () in - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Exp.tuple ~loc exprs -and parse_spread_expr_region_with_loc p = - let start_pos = p.Parser.prev_end_pos in +and parseSpreadExprRegionWithLoc p = + let startPos = p.Parser.prevEndPos in match p.Parser.token with | DotDotDot -> Parser.next p; - let expr = parse_constrained_or_coerced_expr p in - Some (true, expr, start_pos, p.prev_end_pos) - | token when Grammar.is_expr_start token -> - Some (false, parse_constrained_or_coerced_expr p, start_pos, p.prev_end_pos) + let expr = parseConstrainedOrCoercedExpr p in + Some (true, expr, startPos, p.prevEndPos) + | token when Grammar.isExprStart token -> + Some (false, parseConstrainedOrCoercedExpr p, startPos, p.prevEndPos) | _ -> None -and parse_list_expr ~start_pos p = +and parseListExpr ~startPos p = let split_by_spread exprs = List.fold_left (fun acc curr -> match (curr, acc) with - | (true, expr, start_pos, end_pos), _ -> + | (true, expr, startPos, endPos), _ -> (* find a spread expression, prepend a new sublist *) - ([], Some expr, start_pos, end_pos) :: acc - | ( (false, expr, start_pos, _endPos), - (no_spreads, spread, _accStartPos, acc_end_pos) :: acc ) -> + ([], Some expr, startPos, endPos) :: acc + | ( (false, expr, startPos, _endPos), + (no_spreads, spread, _accStartPos, accEndPos) :: acc ) -> (* find a non-spread expression, and the accumulated is not empty, * prepend to the first sublist, and update the loc of the first sublist *) - (expr :: no_spreads, spread, start_pos, acc_end_pos) :: acc - | (false, expr, start_pos, end_pos), [] -> + (expr :: no_spreads, spread, startPos, accEndPos) :: acc + | (false, expr, startPos, endPos), [] -> (* find a non-spread expression, and the accumulated is empty *) - [([expr], None, start_pos, end_pos)]) + [([expr], None, startPos, endPos)]) [] exprs in let make_sub_expr = function - | exprs, Some spread, start_pos, end_pos -> - make_list_expression (mk_loc start_pos end_pos) exprs (Some spread) - | exprs, None, start_pos, end_pos -> - make_list_expression (mk_loc start_pos end_pos) exprs None + | exprs, Some spread, startPos, endPos -> + makeListExpression (mkLoc startPos endPos) exprs (Some spread) + | exprs, None, startPos, endPos -> + makeListExpression (mkLoc startPos endPos) exprs None in - let list_exprs_rev = - parse_comma_delimited_reversed_list p ~grammar:Grammar.ListExpr - ~closing:Rbrace ~f:parse_spread_expr_region_with_loc + let listExprsRev = + parseCommaDelimitedReversedList p ~grammar:Grammar.ListExpr ~closing:Rbrace + ~f:parseSpreadExprRegionWithLoc in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - match split_by_spread list_exprs_rev with - | [] -> make_list_expression loc [] None - | [(exprs, Some spread, _, _)] -> make_list_expression loc exprs (Some spread) - | [(exprs, None, _, _)] -> make_list_expression loc exprs None + let loc = mkLoc startPos p.prevEndPos in + match split_by_spread listExprsRev with + | [] -> makeListExpression loc [] None + | [(exprs, Some spread, _, _)] -> makeListExpression loc exprs (Some spread) + | [(exprs, None, _, _)] -> makeListExpression loc exprs None | exprs -> - let list_exprs = List.map make_sub_expr exprs in + let listExprs = List.map make_sub_expr exprs in Ast_helper.Exp.apply ~loc - (Ast_helper.Exp.ident ~loc ~attrs:[spread_attr] + (Ast_helper.Exp.ident ~loc ~attrs:[spreadAttr] (Location.mkloc (Longident.Ldot (Longident.Ldot (Longident.Lident "Belt", "List"), "concatMany")) loc)) - [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc list_exprs)] + [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc listExprs)] -and parse_array_exp p = - let start_pos = p.Parser.start_pos in +and parseArrayExp p = + let startPos = p.Parser.startPos in Parser.expect Lbracket p; let split_by_spread exprs = List.fold_left (fun acc curr -> match (curr, acc) with - | (true, expr, start_pos, end_pos), _ -> + | (true, expr, startPos, endPos), _ -> (* find a spread expression, prepend a new sublist *) - ([], Some expr, start_pos, end_pos) :: acc - | ( (false, expr, start_pos, _endPos), - (no_spreads, spread, _accStartPos, acc_end_pos) :: acc ) -> + ([], Some expr, startPos, endPos) :: acc + | ( (false, expr, startPos, _endPos), + (no_spreads, spread, _accStartPos, accEndPos) :: acc ) -> (* find a non-spread expression, and the accumulated is not empty, * prepend to the first sublist, and update the loc of the first sublist *) - (expr :: no_spreads, spread, start_pos, acc_end_pos) :: acc - | (false, expr, start_pos, end_pos), [] -> + (expr :: no_spreads, spread, startPos, accEndPos) :: acc + | (false, expr, startPos, endPos), [] -> (* find a non-spread expression, and the accumulated is empty *) - [([expr], None, start_pos, end_pos)]) + [([expr], None, startPos, endPos)]) [] exprs in - let list_exprs_rev = - parse_comma_delimited_reversed_list p ~grammar:Grammar.ExprList - ~closing:Rbracket ~f:parse_spread_expr_region_with_loc + let listExprsRev = + parseCommaDelimitedReversedList p ~grammar:Grammar.ExprList + ~closing:Rbracket ~f:parseSpreadExprRegionWithLoc in Parser.expect Rbracket p; - let loc = mk_loc start_pos p.prev_end_pos in - let collect_exprs = function + let loc = mkLoc startPos p.prevEndPos in + let collectExprs = function | [], Some spread, _startPos, _endPos -> [spread] | exprs, Some spread, _startPos, _endPos -> let els = Ast_helper.Exp.array ~loc exprs in @@ -3996,208 +3962,206 @@ and parse_array_exp p = let els = Ast_helper.Exp.array ~loc exprs in [els] in - match split_by_spread list_exprs_rev with - | [] -> Ast_helper.Exp.array ~loc:(mk_loc start_pos p.prev_end_pos) [] + match split_by_spread listExprsRev with + | [] -> Ast_helper.Exp.array ~loc:(mkLoc startPos p.prevEndPos) [] | [(exprs, None, _, _)] -> - Ast_helper.Exp.array ~loc:(mk_loc start_pos p.prev_end_pos) exprs + Ast_helper.Exp.array ~loc:(mkLoc startPos p.prevEndPos) exprs | exprs -> - let xs = List.map collect_exprs exprs in - let list_exprs = + let xs = List.map collectExprs exprs in + let listExprs = List.fold_right (fun exprs1 acc -> List.fold_right (fun expr1 acc1 -> expr1 :: acc1) exprs1 acc) xs [] in Ast_helper.Exp.apply ~loc - (Ast_helper.Exp.ident ~loc ~attrs:[spread_attr] + (Ast_helper.Exp.ident ~loc ~attrs:[spreadAttr] (Location.mkloc (Longident.Ldot (Longident.Ldot (Longident.Lident "Belt", "Array"), "concatMany")) loc)) - [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc list_exprs)] + [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc listExprs)] (* TODO: check attributes in the case of poly type vars, * might be context dependend: parseFieldDeclaration (see ocaml) *) -and parse_poly_type_expr p = - let start_pos = p.Parser.start_pos in +and parsePolyTypeExpr p = + let startPos = p.Parser.startPos in match p.Parser.token with | SingleQuote -> ( - let vars = parse_type_var_list p in + let vars = parseTypeVarList p in match vars with | _v1 :: _v2 :: _ -> Parser.expect Dot p; - let typ = parse_typ_expr p in - let loc = mk_loc start_pos p.prev_end_pos in + let typ = parseTypExpr p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Typ.poly ~loc vars typ | [var] -> ( match p.Parser.token with | Dot -> Parser.next p; - let typ = parse_typ_expr p in - let loc = mk_loc start_pos p.prev_end_pos in + let typ = parseTypExpr p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Typ.poly ~loc vars typ | EqualGreater -> Parser.next 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 - let t_fun = - Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ return_type - in - if p.uncurried_config = Legacy then t_fun - else Ast_uncurried.uncurried_type ~loc ~arity:1 t_fun + let returnType = parseTypExpr ~alias:false p in + let loc = mkLoc typ.Parsetree.ptyp_loc.loc_start p.prevEndPos in + let tFun = Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType in + if p.uncurried_config = Legacy then tFun + else Ast_uncurried.uncurriedType ~loc ~arity:1 tFun | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt) | _ -> assert false) - | _ -> parse_typ_expr p + | _ -> parseTypExpr p (* 'a 'b 'c *) -and parse_type_var_list p = +and parseTypeVarList p = let rec loop p vars = match p.Parser.token with | SingleQuote -> Parser.next p; - let lident, loc = parse_lident p in + let lident, loc = + parseIdent ~msg:ErrorMessages.typeParam ~startPos:p.startPos p + in let var = Location.mkloc lident loc in loop p (var :: vars) | _ -> List.rev vars in loop p [] -and parse_lident_list p = +and parseLidentList p = let rec loop p ls = match p.Parser.token with | Lident lident -> - let loc = mk_loc p.start_pos p.end_pos in + let loc = mkLoc p.startPos p.endPos in Parser.next p; loop p (Location.mkloc lident loc :: ls) | _ -> List.rev ls in loop p [] -and parse_atomic_typ_expr ~attrs p = - Parser.leave_breadcrumb p Grammar.AtomicTypExpr; - let start_pos = p.Parser.start_pos in +and parseAtomicTypExpr ~attrs p = + Parser.leaveBreadcrumb p Grammar.AtomicTypExpr; + let startPos = p.Parser.startPos in let typ = match p.Parser.token with | SingleQuote -> Parser.next p; let ident, loc = if p.Parser.token = Eof then ( - Parser.err ~start_pos:p.start_pos p + Parser.err ~startPos:p.startPos p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); - ("", mk_loc p.start_pos p.prev_end_pos)) - else parse_ident ~msg:ErrorMessages.type_var ~start_pos:p.start_pos p + ("", mkLoc p.startPos p.prevEndPos)) + else parseIdent ~msg:ErrorMessages.typeVar ~startPos:p.startPos p in Ast_helper.Typ.var ~loc ~attrs ident | Underscore -> - let end_pos = p.end_pos in + let endPos = p.endPos in Parser.next p; - Ast_helper.Typ.any ~loc:(mk_loc start_pos end_pos) ~attrs () + Ast_helper.Typ.any ~loc:(mkLoc startPos endPos) ~attrs () | Lparen -> ( Parser.next p; match p.Parser.token with | Rparen -> Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in - let unit_constr = Location.mkloc (Longident.Lident "unit") loc in - Ast_helper.Typ.constr ~attrs unit_constr [] + let loc = mkLoc startPos p.prevEndPos in + let unitConstr = Location.mkloc (Longident.Lident "unit") loc in + Ast_helper.Typ.constr ~attrs unitConstr [] | _ -> ( - let t = parse_typ_expr p in + let t = parseTypExpr p in match p.token with | Comma -> Parser.next p; - parse_tuple_type ~attrs ~first:t ~start_pos p + parseTupleType ~attrs ~first:t ~startPos p | _ -> Parser.expect Rparen p; { t with - ptyp_loc = mk_loc start_pos p.prev_end_pos; + ptyp_loc = mkLoc startPos p.prevEndPos; ptyp_attributes = List.concat [attrs; t.ptyp_attributes]; })) - | Lbracket -> parse_polymorphic_variant_type ~attrs p + | Lbracket -> parsePolymorphicVariantType ~attrs p | Uident _ | Lident _ -> - let constr = parse_value_path p in - let args = parse_type_constructor_args ~constr_name:constr p in + let constr = parseValuePath p in + let args = parseTypeConstructorArgs ~constrName:constr p in Ast_helper.Typ.constr - ~loc:(mk_loc start_pos p.prev_end_pos) + ~loc:(mkLoc startPos p.prevEndPos) ~attrs constr args | Module -> Parser.next p; Parser.expect Lparen p; - let package_type = parse_package_type ~start_pos ~attrs p in + let packageType = parsePackageType ~startPos ~attrs p in Parser.expect Rparen p; - {package_type with ptyp_loc = mk_loc start_pos p.prev_end_pos} + {packageType with ptyp_loc = mkLoc startPos p.prevEndPos} | Percent -> - let extension = parse_extension p in - let loc = mk_loc start_pos p.prev_end_pos in + let extension = parseExtension p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Typ.extension ~attrs ~loc extension - | Lbrace -> parse_record_or_object_type ~attrs p + | Lbrace -> parseRecordOrObjectType ~attrs p | Eof -> Parser.err p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); - Recover.default_type () + Recover.defaultType () | token -> ( Parser.err p (Diagnostics.unexpected token p.breadcrumbs); match - skip_tokens_and_maybe_retry p - ~is_start_of_grammar:Grammar.is_atomic_typ_expr_start + skipTokensAndMaybeRetry p ~isStartOfGrammar:Grammar.isAtomicTypExprStart with - | Some () -> parse_atomic_typ_expr ~attrs p + | Some () -> parseAtomicTypExpr ~attrs p | None -> - Parser.err ~start_pos:p.prev_end_pos p + Parser.err ~startPos:p.prevEndPos p (Diagnostics.unexpected token p.breadcrumbs); - Recover.default_type ()) + Recover.defaultType ()) in - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; typ (* package-type ::= | modtype-path ∣ modtype-path with package-constraint { and package-constraint } *) -and parse_package_type ~start_pos ~attrs p = - let mod_type_path = parse_module_long_ident ~lowercase:true p in +and parsePackageType ~startPos ~attrs p = + let modTypePath = parseModuleLongIdent ~lowercase:true p in match p.Parser.token with | Lident "with" -> Parser.next p; - let constraints = parse_package_constraints p in - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Typ.package ~loc ~attrs mod_type_path constraints + let constraints = parsePackageConstraints p in + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Typ.package ~loc ~attrs modTypePath constraints | _ -> - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Typ.package ~loc ~attrs mod_type_path [] + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Typ.package ~loc ~attrs modTypePath [] (* package-constraint { and package-constraint } *) -and parse_package_constraints p = +and parsePackageConstraints p = let first = Parser.expect Typ p; - let type_constr = parse_value_path p in + let typeConstr = parseValuePath p in Parser.expect Equal p; - let typ = parse_typ_expr p in - (type_constr, typ) + let typ = parseTypExpr p in + (typeConstr, typ) in let rest = - parse_region ~grammar:Grammar.PackageConstraint ~f:parse_package_constraint - p + parseRegion ~grammar:Grammar.PackageConstraint ~f:parsePackageConstraint p in first :: rest (* and type typeconstr = typexpr *) -and parse_package_constraint p = +and parsePackageConstraint p = match p.Parser.token with | And -> Parser.next p; Parser.expect Typ p; - let type_constr = parse_value_path p in + let typeConstr = parseValuePath p in Parser.expect Equal p; - let typ = parse_typ_expr p in - Some (type_constr, typ) + let typ = parseTypExpr p in + Some (typeConstr, typ) | _ -> None -and parse_record_or_object_type ~attrs p = +and parseRecordOrObjectType ~attrs p = (* for inline record in constructor *) - let start_pos = p.Parser.start_pos in + let startPos = p.Parser.startPos in Parser.expect Lbrace p; - let closed_flag = + let closedFlag = match p.token with | DotDot -> Parser.next p; @@ -4211,27 +4175,29 @@ and parse_record_or_object_type ~attrs p = match p.token with | Lident _ -> Parser.err p - (Diagnostics.message ErrorMessages.forbidden_inline_record_declaration) + (Diagnostics.message ErrorMessages.forbiddenInlineRecordDeclaration) | _ -> () in let fields = - parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations - ~closing:Rbrace ~f:parse_string_field_declaration p + parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations + ~closing:Rbrace ~f:parseStringFieldDeclaration p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Typ.object_ ~loc ~attrs fields closed_flag + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Typ.object_ ~loc ~attrs fields closedFlag (* TODO: check associativity in combination with attributes *) -and parse_type_alias p typ = +and parseTypeAlias p typ = match p.Parser.token with | As -> Parser.next p; Parser.expect SingleQuote p; - let ident, _loc = parse_lident p in + let ident, _loc = + parseIdent ~msg:ErrorMessages.typeParam ~startPos:p.startPos p + in (* TODO: how do we parse attributes here? *) Ast_helper.Typ.alias - ~loc:(mk_loc typ.Parsetree.ptyp_loc.loc_start p.prev_end_pos) + ~loc:(mkLoc typ.Parsetree.ptyp_loc.loc_start p.prevEndPos) typ ident | _ -> typ @@ -4247,118 +4213,112 @@ and parse_type_alias p typ = * dotted_type_parameter ::= * | . type_parameter *) -and parse_type_parameter p = - let doc_attr : Parsetree.attributes = +and parseTypeParameter p = + let docAttr : Parsetree.attributes = match p.Parser.token with | DocComment (loc, s) -> Parser.next p; - [doc_comment_to_attribute loc s] + [docCommentToAttribute loc s] | _ -> [] in if p.Parser.token = Token.Tilde || p.token = Dot - || Grammar.is_typ_expr_start p.token + || Grammar.isTypExprStart p.token then - let start_pos = p.Parser.start_pos in + let startPos = p.Parser.startPos in let dotted = Parser.optional p Dot in - let attrs = doc_attr @ parse_attributes p in + let attrs = docAttr @ parseAttributes p in match p.Parser.token with | Tilde -> ( Parser.next p; - let name, loc = parse_lident p in - let lbl_loc_attr = + let name, loc = parseLident p in + let lblLocAttr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in Parser.expect ~grammar:Grammar.TypeExpression Colon p; let typ = - let typ = parse_typ_expr p in - {typ with ptyp_attributes = lbl_loc_attr :: typ.ptyp_attributes} + let typ = parseTypExpr p in + {typ with ptyp_attributes = lblLocAttr :: typ.ptyp_attributes} in match p.Parser.token with | Equal -> Parser.next p; Parser.expect Question p; - Some {dotted; attrs; label = Optional name; typ; start_pos} - | _ -> Some {dotted; attrs; label = Labelled name; typ; start_pos}) + Some {dotted; attrs; label = Optional name; typ; startPos} + | _ -> Some {dotted; attrs; label = Labelled name; typ; startPos}) | Lident _ -> ( - let name, loc = parse_lident p in + let name, loc = parseLident p in match p.token with | Colon -> ( let () = let error = Diagnostics.message - (ErrorMessages.missing_tilde_labeled_parameter name) + (ErrorMessages.missingTildeLabeledParameter name) in - Parser.err ~start_pos:loc.loc_start ~end_pos:loc.loc_end p error + Parser.err ~startPos:loc.loc_start ~endPos:loc.loc_end p error in Parser.next p; - let typ = parse_typ_expr p in + let typ = parseTypExpr p in match p.Parser.token with | Equal -> Parser.next p; Parser.expect Question p; - Some {dotted; attrs; label = Optional name; typ; start_pos} - | _ -> Some {dotted; attrs; label = Labelled name; typ; start_pos}) + Some {dotted; attrs; label = Optional name; typ; startPos} + | _ -> Some {dotted; attrs; label = Labelled name; typ; startPos}) | _ -> let constr = Location.mkloc (Longident.Lident name) loc in - let args = parse_type_constructor_args ~constr_name:constr p in + let args = parseTypeConstructorArgs ~constrName:constr p in let typ = Ast_helper.Typ.constr - ~loc:(mk_loc start_pos p.prev_end_pos) + ~loc:(mkLoc startPos p.prevEndPos) ~attrs constr args in - let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in - let typ = parse_type_alias p typ in - Some {dotted; attrs = []; label = Nolabel; typ; start_pos}) + let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in + let typ = parseTypeAlias p typ in + Some {dotted; attrs = []; label = Nolabel; typ; startPos}) | _ -> - let typ = parse_typ_expr p in - let typ_with_attributes = + let typ = parseTypExpr p in + let typWithAttributes = {typ with ptyp_attributes = List.concat [attrs; typ.ptyp_attributes]} in Some - { - dotted; - attrs = []; - label = Nolabel; - typ = typ_with_attributes; - start_pos; - } + {dotted; attrs = []; label = Nolabel; typ = typWithAttributes; startPos} else None (* (int, ~x:string, float) *) -and parse_type_parameters p = - let start_pos = p.Parser.start_pos in +and parseTypeParameters p = + let startPos = p.Parser.startPos in Parser.expect Lparen p; match p.Parser.token with | Rparen -> Parser.next 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 - [{dotted = false; attrs = []; label = Nolabel; typ; start_pos}] + let loc = mkLoc startPos p.prevEndPos in + let unitConstr = Location.mkloc (Longident.Lident "unit") loc in + let typ = Ast_helper.Typ.constr unitConstr [] in + [{dotted = false; attrs = []; label = Nolabel; typ; startPos}] | _ -> let params = - parse_comma_delimited_region ~grammar:Grammar.TypeParameters - ~closing:Rparen ~f:parse_type_parameter p + parseCommaDelimitedRegion ~grammar:Grammar.TypeParameters ~closing:Rparen + ~f:parseTypeParameter p in Parser.expect Rparen p; params -and parse_es6_arrow_type ~attrs p = - let start_pos = p.Parser.start_pos in +and parseEs6ArrowType ~attrs p = + let startPos = p.Parser.startPos in match p.Parser.token with | Tilde -> Parser.next p; - let name, loc = parse_lident p in - let lbl_loc_attr = + let name, loc = parseLident p in + let lblLocAttr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in Parser.expect ~grammar:Grammar.TypeExpression Colon p; let typ = - let typ = parse_typ_expr ~alias:false ~es6_arrow:false p in - {typ with ptyp_attributes = lbl_loc_attr :: typ.ptyp_attributes} + let typ = parseTypExpr ~alias:false ~es6Arrow:false p in + {typ with ptyp_attributes = lblLocAttr :: typ.ptyp_attributes} in let arg = match p.Parser.token with @@ -4369,36 +4329,35 @@ and parse_es6_arrow_type ~attrs p = | _ -> Asttypes.Labelled name in Parser.expect EqualGreater 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 ~attrs arg typ return_type + let returnType = parseTypExpr ~alias:false p in + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Typ.arrow ~loc ~attrs arg typ returnType | DocComment _ -> assert false | _ -> - let parameters = parse_type_parameters p in + let parameters = parseTypeParameters p in Parser.expect EqualGreater p; - let return_type = parse_typ_expr ~alias:false p in - let end_pos = p.prev_end_pos in - let return_type_arity = + let returnType = parseTypExpr ~alias:false p in + let endPos = p.prevEndPos in + let returnTypeArity = match parameters with | _ when p.uncurried_config <> Legacy -> 0 | _ -> if parameters |> List.exists (function {dotted; typ = _} -> dotted) then 0 else - let _, args, _ = Res_parsetree_viewer.arrow_type return_type in + let _, args, _ = Res_parsetree_viewer.arrowType returnType in List.length args in let _paramNum, typ, _arity = List.fold_right - (fun {dotted; attrs; label = arg_lbl; typ; start_pos} - (param_num, t, arity) -> + (fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t, arity) -> let uncurried = - p.uncurried_config |> Res_uncurried.from_dotted ~dotted + p.uncurried_config |> Res_uncurried.fromDotted ~dotted in - let loc = mk_loc start_pos end_pos in + let loc = mkLoc startPos endPos in let arity = (* Workaround for ~lbl: @as(json`false`) _, which changes the arity *) - match arg_lbl with + match argLbl with | Labelled _s -> let typ_is_any = match typ.ptyp_desc with @@ -4412,17 +4371,17 @@ and parse_es6_arrow_type ~attrs p = else arity | _ -> arity in - let t_arg = Ast_helper.Typ.arrow ~loc ~attrs arg_lbl typ t in - if uncurried && (param_num = 1 || p.uncurried_config = Legacy) then - (param_num - 1, Ast_uncurried.uncurried_type ~loc ~arity t_arg, 1) - else (param_num - 1, t_arg, arity + 1)) + let tArg = Ast_helper.Typ.arrow ~loc ~attrs argLbl typ t in + if uncurried && (paramNum = 1 || p.uncurried_config = Legacy) then + (paramNum - 1, Ast_uncurried.uncurriedType ~loc ~arity tArg, 1) + else (paramNum - 1, tArg, arity + 1)) parameters - (List.length parameters, return_type, return_type_arity + 1) + (List.length parameters, returnType, returnTypeArity + 1) in { typ with ptyp_attributes = List.concat [typ.ptyp_attributes; attrs]; - ptyp_loc = mk_loc start_pos p.prev_end_pos; + ptyp_loc = mkLoc startPos p.prevEndPos; } (* @@ -4445,165 +4404,159 @@ and parse_es6_arrow_type ~attrs p = * | uident.lident * | uident.uident.lident --> long module path *) -and parse_typ_expr ?attrs ?(es6_arrow = true) ?(alias = true) p = +and parseTypExpr ?attrs ?(es6Arrow = true) ?(alias = true) p = (* Parser.leaveBreadcrumb p Grammar.TypeExpression; *) - let start_pos = p.Parser.start_pos in + let startPos = p.Parser.startPos in let attrs = match attrs with | Some attrs -> attrs - | None -> parse_attributes p + | None -> parseAttributes p in let typ = - if es6_arrow && is_es6_arrow_type p then parse_es6_arrow_type ~attrs p + if es6Arrow && isEs6ArrowType p then parseEs6ArrowType ~attrs p else - let typ = parse_atomic_typ_expr ~attrs p in - parse_arrow_type_rest ~es6_arrow ~start_pos typ p + let typ = parseAtomicTypExpr ~attrs p in + parseArrowTypeRest ~es6Arrow ~startPos typ p in - let typ = if alias then parse_type_alias p typ else typ in + let typ = if alias then parseTypeAlias p typ else typ in (* Parser.eatBreadcrumb p; *) typ -and parse_arrow_type_rest ~es6_arrow ~start_pos typ p = +and parseArrowTypeRest ~es6Arrow ~startPos typ p = match p.Parser.token with - | (EqualGreater | MinusGreater) as token when es6_arrow == true -> + | (EqualGreater | MinusGreater) as token when es6Arrow == true -> (* error recovery *) if token = MinusGreater then Parser.expect EqualGreater 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 - let arrow_typ = - Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ return_type - in - if p.uncurried_config = Legacy then arrow_typ - else Ast_uncurried.uncurried_type ~loc ~arity:1 arrow_typ + let returnType = parseTypExpr ~alias:false p in + let loc = mkLoc startPos p.prevEndPos in + let arrowTyp = Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType in + if p.uncurried_config = Legacy then arrowTyp + else Ast_uncurried.uncurriedType ~loc ~arity:1 arrowTyp | _ -> typ -and parse_typ_expr_region p = - if Grammar.is_typ_expr_start p.Parser.token then Some (parse_typ_expr p) - else None +and parseTypExprRegion p = + if Grammar.isTypExprStart p.Parser.token then Some (parseTypExpr p) else None -and parse_tuple_type ~attrs ~first ~start_pos p = +and parseTupleType ~attrs ~first ~startPos p = let typexprs = first - :: parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:Rparen - ~f:parse_typ_expr_region p + :: parseCommaDelimitedRegion ~grammar:Grammar.TypExprList ~closing:Rparen + ~f:parseTypExprRegion p in Parser.expect Rparen p; let () = match typexprs with | [_] -> - Parser.err ~start_pos ~end_pos:p.prev_end_pos p - (Diagnostics.message ErrorMessages.tuple_single_element) + Parser.err ~startPos ~endPos:p.prevEndPos p + (Diagnostics.message ErrorMessages.tupleSingleElement) | _ -> () in - let tuple_loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Typ.tuple ~attrs ~loc:tuple_loc typexprs + let tupleLoc = mkLoc startPos p.prevEndPos in + Ast_helper.Typ.tuple ~attrs ~loc:tupleLoc typexprs -and parse_type_constructor_arg_region p = - if Grammar.is_typ_expr_start p.Parser.token then Some (parse_typ_expr p) +and parseTypeConstructorArgRegion p = + if Grammar.isTypExprStart p.Parser.token then Some (parseTypExpr p) else if p.token = LessThan then ( Parser.next p; - parse_type_constructor_arg_region p) + parseTypeConstructorArgRegion p) else None (* Js.Nullable.value<'a> *) -and parse_type_constructor_args ~constr_name p = +and parseTypeConstructorArgs ~constrName p = let opening = p.Parser.token in - let opening_start_pos = p.start_pos in + let openingStartPos = p.startPos in match opening with | LessThan | Lparen -> - Scanner.set_diamond_mode p.scanner; + Scanner.setDiamondMode p.scanner; Parser.next p; - let type_args = + let typeArgs = (* TODO: change Grammar.TypExprList to TypArgList!!! Why did I wrote this? *) - parse_comma_delimited_region ~grammar:Grammar.TypExprList - ~closing:GreaterThan ~f:parse_type_constructor_arg_region p + parseCommaDelimitedRegion ~grammar:Grammar.TypExprList + ~closing:GreaterThan ~f:parseTypeConstructorArgRegion p in let () = match p.token with | Rparen when opening = Token.Lparen -> - let typ = Ast_helper.Typ.constr constr_name type_args in + let typ = Ast_helper.Typ.constr constrName typeArgs in let msg = - Doc.breakable_group ~force_break:true + Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.text "Type parameters require angle brackets:"; Doc.indent (Doc.concat - [ - Doc.line; - ResPrinter.print_typ_expr typ CommentTable.empty; - ]); + [Doc.line; ResPrinter.printTypExpr typ CommentTable.empty]); ]) - |> Doc.to_string ~width:80 + |> Doc.toString ~width:80 in - Parser.err ~start_pos:opening_start_pos p (Diagnostics.message msg); + Parser.err ~startPos:openingStartPos p (Diagnostics.message msg); Parser.next p | _ -> Parser.expect GreaterThan p in - Scanner.pop_mode p.scanner Diamond; - type_args + Scanner.popMode p.scanner Diamond; + typeArgs | _ -> [] (* string-field-decl ::= * | string: poly-typexpr * | attributes string-field-decl *) -and parse_string_field_declaration p = - let attrs = parse_attributes p in +and parseStringFieldDeclaration p = + let attrs = parseAttributes p in match p.Parser.token with | String name -> - let name_start_pos = p.start_pos in - let name_end_pos = p.end_pos in + let nameStartPos = p.startPos in + let nameEndPos = p.endPos in Parser.next p; - let field_name = Location.mkloc name (mk_loc name_start_pos name_end_pos) in + let fieldName = Location.mkloc name (mkLoc nameStartPos nameEndPos) in Parser.expect ~grammar:Grammar.TypeExpression Colon p; - let typ = parse_poly_type_expr p in - Some (Parsetree.Otag (field_name, attrs, typ)) + let typ = parsePolyTypeExpr p in + Some (Parsetree.Otag (fieldName, attrs, typ)) | DotDotDot -> Parser.next p; - let typ = parse_typ_expr p in + let typ = parseTypExpr p in Some (Parsetree.Oinherit typ) | Lident name -> - let name_loc = mk_loc p.start_pos p.end_pos in + let nameLoc = mkLoc p.startPos p.endPos in Parser.err p - (Diagnostics.message (ErrorMessages.object_quoted_field_name name)); + (Diagnostics.message (ErrorMessages.objectQuotedFieldName name)); Parser.next p; - let field_name = Location.mkloc name name_loc in + let fieldName = Location.mkloc name nameLoc in Parser.expect ~grammar:Grammar.TypeExpression Colon p; - let typ = parse_poly_type_expr p in - Some (Parsetree.Otag (field_name, attrs, typ)) + let typ = parsePolyTypeExpr p in + Some (Parsetree.Otag (fieldName, attrs, typ)) | _token -> None (* field-decl ::= * | [mutable] field-name : poly-typexpr * | attributes field-decl *) -and parse_field_declaration p = - let start_pos = p.Parser.start_pos in - let attrs = parse_attributes p in +and parseFieldDeclaration p = + let startPos = p.Parser.startPos in + let attrs = parseAttributes p in let mut = if Parser.optional p Token.Mutable then Asttypes.Mutable else Asttypes.Immutable in let lident, loc = match p.token with - | _ -> parse_lident p + | _ -> parseLident p in - let optional = parse_optional_label p in + let optional = parseOptionalLabel p in let name = Location.mkloc lident loc in let typ = match p.Parser.token with | Colon -> Parser.next p; - parse_poly_type_expr p + parsePolyTypeExpr p | _ -> Ast_helper.Typ.constr ~loc:name.loc {name with txt = Lident name.txt} [] in - let loc = mk_loc start_pos typ.ptyp_loc.loc_end in + let loc = mkLoc startPos typ.ptyp_loc.loc_end in (optional, Ast_helper.Type.field ~attrs ~loc ~mut name typ) -and parse_field_declaration_region ?found_object_field p = - let start_pos = p.Parser.start_pos in - let attrs = parse_attributes p in +and parseFieldDeclarationRegion ?foundObjectField p = + let startPos = p.Parser.startPos in + let attrs = parseAttributes p in let mut = if Parser.optional p Token.Mutable then Asttypes.Mutable else Asttypes.Immutable @@ -4611,43 +4564,43 @@ and parse_field_declaration_region ?found_object_field p = match p.token with | DotDotDot -> Parser.next p; - let name = Location.mkloc "..." (mk_loc start_pos p.prev_end_pos) in - let typ = parse_poly_type_expr p in - let loc = mk_loc start_pos typ.ptyp_loc.loc_end in + let name = Location.mkloc "..." (mkLoc startPos p.prevEndPos) in + let typ = parsePolyTypeExpr p in + let loc = mkLoc startPos typ.ptyp_loc.loc_end in Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ) - | String s when found_object_field <> None -> - Option.get found_object_field := true; + | String s when foundObjectField <> None -> + Option.get foundObjectField := true; Parser.next p; - let name = Location.mkloc s (mk_loc start_pos p.prev_end_pos) in + let name = Location.mkloc s (mkLoc startPos p.prevEndPos) in Parser.expect Colon p; - let typ = parse_poly_type_expr p in - let loc = mk_loc start_pos typ.ptyp_loc.loc_end in + let typ = parsePolyTypeExpr p in + let loc = mkLoc startPos typ.ptyp_loc.loc_end in Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ) | Lident _ -> - let lident, loc = parse_lident p in + let lident, loc = parseLident p in let name = Location.mkloc lident loc in - let optional = parse_optional_label p in + let optional = parseOptionalLabel p in let typ = match p.Parser.token with | Colon -> Parser.next p; - parse_poly_type_expr p + parsePolyTypeExpr p | _ -> Ast_helper.Typ.constr ~loc:name.loc ~attrs {name with txt = Lident name.txt} [] in - let loc = mk_loc start_pos typ.ptyp_loc.loc_end in - let attrs = if optional then optional_attr :: attrs else attrs in + let loc = mkLoc startPos typ.ptyp_loc.loc_end in + let attrs = if optional then optionalAttr :: attrs else attrs in Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ) | _ -> if attrs <> [] then - Parser.err ~start_pos p + Parser.err ~startPos p (Diagnostics.message "Attributes and doc comments can only be used at the beginning of a \ field declaration"); if mut = Mutable then - Parser.err ~start_pos p + Parser.err ~startPos p (Diagnostics.message "The `mutable` qualifier can only be used at the beginning of a \ field declaration"); @@ -4658,15 +4611,15 @@ and parse_field_declaration_region ?found_object_field p = * | { field-decl, field-decl } * | { field-decl, field-decl, field-decl, } *) -and parse_record_declaration p = - Parser.leave_breadcrumb p Grammar.RecordDecl; +and parseRecordDeclaration p = + Parser.leaveBreadcrumb p Grammar.RecordDecl; Parser.expect Lbrace p; let rows = - parse_comma_delimited_region ~grammar:Grammar.RecordDecl ~closing:Rbrace - ~f:parse_field_declaration_region p + parseCommaDelimitedRegion ~grammar:Grammar.RecordDecl ~closing:Rbrace + ~f:parseFieldDeclarationRegion p in Parser.expect Rbrace p; - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; rows (* constr-args ::= @@ -4678,8 +4631,8 @@ and parse_record_declaration p = * TODO: should we overparse inline-records in every position? * Give a good error message afterwards? *) -and parse_constr_decl_args p = - let constr_args = +and parseConstrDeclArgs p = + let constrArgs = match p.Parser.token with | Lparen -> ( Parser.next p; @@ -4687,10 +4640,10 @@ and parse_constr_decl_args p = match p.Parser.token with | Lbrace -> ( Parser.next p; - let start_pos = p.Parser.start_pos in + let startPos = p.Parser.startPos in match p.Parser.token with | DotDot | Dot -> - let closed_flag = + let closedFlag = match p.token with | DotDot -> Parser.next p; @@ -4701,26 +4654,25 @@ and parse_constr_decl_args p = | _ -> Asttypes.Closed in let fields = - parse_comma_delimited_region - ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parse_string_field_declaration p + parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations + ~closing:Rbrace ~f:parseStringFieldDeclaration p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in - let typ = Ast_helper.Typ.object_ ~loc ~attrs:[] fields closed_flag in + let loc = mkLoc startPos p.prevEndPos in + let typ = Ast_helper.Typ.object_ ~loc ~attrs:[] fields closedFlag in Parser.optional p Comma |> ignore; - let more_args = - parse_comma_delimited_region ~grammar:Grammar.TypExprList - ~closing:Rparen ~f:parse_typ_expr_region p + let moreArgs = + parseCommaDelimitedRegion ~grammar:Grammar.TypExprList + ~closing:Rparen ~f:parseTypExprRegion p in Parser.expect Rparen p; - Parsetree.Pcstr_tuple (typ :: more_args) + Parsetree.Pcstr_tuple (typ :: moreArgs) | DotDotDot -> - let dotdotdot_start = p.start_pos in - let dotdotdot_end = p.end_pos in + let dotdotdotStart = p.startPos in + let dotdotdotEnd = p.endPos in (* start of object type spreading, e.g. `User({...a, "u": int})` *) Parser.next p; - let typ = parse_typ_expr p in + let typ = parseTypExpr p in let () = match p.token with | Rbrace -> @@ -4731,46 +4683,46 @@ and parse_constr_decl_args p = let () = match p.token with | Lident _ -> - Parser.err ~start_pos:dotdotdot_start ~end_pos:dotdotdot_end p - (Diagnostics.message ErrorMessages.spread_in_record_declaration) + Parser.err ~startPos:dotdotdotStart ~endPos:dotdotdotEnd p + (Diagnostics.message ErrorMessages.spreadInRecordDeclaration) | _ -> () in let fields = Parsetree.Oinherit typ - :: parse_comma_delimited_region + :: parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parse_string_field_declaration p + ~f:parseStringFieldDeclaration p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in let typ = Ast_helper.Typ.object_ ~loc fields Asttypes.Closed - |> parse_type_alias p + |> parseTypeAlias p in - let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in + let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in Parser.optional p Comma |> ignore; - let more_args = - parse_comma_delimited_region ~grammar:Grammar.TypExprList - ~closing:Rparen ~f:parse_typ_expr_region p + let moreArgs = + parseCommaDelimitedRegion ~grammar:Grammar.TypExprList + ~closing:Rparen ~f:parseTypExprRegion p in Parser.expect Rparen p; - Parsetree.Pcstr_tuple (typ :: more_args) + Parsetree.Pcstr_tuple (typ :: moreArgs) | _ -> ( - let attrs = parse_attributes p in + let attrs = parseAttributes p in match p.Parser.token with | String _ -> - let closed_flag = Asttypes.Closed in + let closedFlag = Asttypes.Closed in let fields = match attrs with | [] -> - parse_comma_delimited_region + parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parse_string_field_declaration p + ~f:parseStringFieldDeclaration p | attrs -> let first = - Parser.leave_breadcrumb p Grammar.StringFieldDeclarations; + Parser.leaveBreadcrumb p Grammar.StringFieldDeclarations; let field = - match parse_string_field_declaration p with + match parseStringFieldDeclaration p with | Some field -> field | None -> assert false in @@ -4781,42 +4733,42 @@ and parse_constr_decl_args p = | Comma -> Parser.next p | _ -> Parser.expect Comma p in - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; match field with | Parsetree.Otag (label, _, ct) -> Parsetree.Otag (label, attrs, ct) | Oinherit ct -> Oinherit ct in first - :: parse_comma_delimited_region + :: parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parse_string_field_declaration p + ~f:parseStringFieldDeclaration p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in let typ = - Ast_helper.Typ.object_ ~loc ~attrs:[] fields closed_flag - |> parse_type_alias p + Ast_helper.Typ.object_ ~loc ~attrs:[] fields closedFlag + |> parseTypeAlias p in - let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in + let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in Parser.optional p Comma |> ignore; - let more_args = - parse_comma_delimited_region ~grammar:Grammar.TypExprList - ~closing:Rparen ~f:parse_typ_expr_region p + let moreArgs = + parseCommaDelimitedRegion ~grammar:Grammar.TypExprList + ~closing:Rparen ~f:parseTypExprRegion p in Parser.expect Rparen p; - Parsetree.Pcstr_tuple (typ :: more_args) + Parsetree.Pcstr_tuple (typ :: moreArgs) | _ -> let fields = match attrs with | [] -> - parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations - ~closing:Rbrace ~f:parse_field_declaration_region p + parseCommaDelimitedRegion ~grammar:Grammar.FieldDeclarations + ~closing:Rbrace ~f:parseFieldDeclarationRegion p | attrs -> let first = - let optional, field = parse_field_declaration p in + let optional, field = parseFieldDeclaration p in let attrs = - if optional then optional_attr :: attrs else attrs + if optional then optionalAttr :: attrs else attrs in {field with Parsetree.pld_attributes = attrs} in @@ -4824,9 +4776,9 @@ and parse_constr_decl_args p = else ( Parser.expect Comma p; first - :: parse_comma_delimited_region + :: parseCommaDelimitedRegion ~grammar:Grammar.FieldDeclarations ~closing:Rbrace - ~f:parse_field_declaration_region p) + ~f:parseFieldDeclarationRegion p) in Parser.expect Rbrace p; Parser.optional p Comma |> ignore; @@ -4834,8 +4786,8 @@ and parse_constr_decl_args p = Parsetree.Pcstr_record fields)) | _ -> let args = - parse_comma_delimited_region ~grammar:Grammar.TypExprList - ~closing:Rparen ~f:parse_typ_expr_region p + parseCommaDelimitedRegion ~grammar:Grammar.TypExprList ~closing:Rparen + ~f:parseTypExprRegion p in Parser.expect Rparen p; Parsetree.Pcstr_tuple args) @@ -4845,59 +4797,59 @@ and parse_constr_decl_args p = match p.Parser.token with | Colon -> Parser.next p; - Some (parse_typ_expr p) + Some (parseTypExpr p) | _ -> None in - (constr_args, res) + (constrArgs, res) (* constr-decl ::= * | constr-name * | attrs constr-name * | constr-name const-args * | attrs constr-name const-args *) -and parse_type_constructor_declaration_with_bar p = +and parseTypeConstructorDeclarationWithBar p = match p.Parser.token with | Bar -> - let start_pos = p.Parser.start_pos in + let startPos = p.Parser.startPos in Parser.next p; - Some (parse_type_constructor_declaration ~start_pos p) + Some (parseTypeConstructorDeclaration ~startPos p) | _ -> None -and parse_type_constructor_declaration ~start_pos p = - Parser.leave_breadcrumb p Grammar.ConstructorDeclaration; - let attrs = parse_attributes p in +and parseTypeConstructorDeclaration ~startPos p = + Parser.leaveBreadcrumb p Grammar.ConstructorDeclaration; + let attrs = parseAttributes p in match p.Parser.token with | DotDotDot -> Parser.next p; - let name = Location.mkloc "..." (mk_loc start_pos p.prev_end_pos) in - let typ = parse_poly_type_expr p in - let loc = mk_loc start_pos typ.ptyp_loc.loc_end in + let name = Location.mkloc "..." (mkLoc startPos p.prevEndPos) in + let typ = parsePolyTypeExpr p in + let loc = mkLoc startPos typ.ptyp_loc.loc_end in Ast_helper.Type.constructor ~loc ~attrs ~args:(Pcstr_tuple [typ]) name | Uident uident -> - let uident_loc = mk_loc p.start_pos p.end_pos in + let uidentLoc = mkLoc p.startPos p.endPos in Parser.next p; - let args, res = parse_constr_decl_args p in - Parser.eat_breadcrumb p; - let loc = mk_loc start_pos p.prev_end_pos in + let args, res = parseConstrDeclArgs p in + Parser.eatBreadcrumb p; + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Type.constructor ~loc ~attrs ?res ~args - (Location.mkloc uident uident_loc) + (Location.mkloc uident uidentLoc) | t -> Parser.err p (Diagnostics.uident t); Ast_helper.Type.constructor (Location.mknoloc "_") (* [|] constr-decl { | constr-decl } *) -and parse_type_constructor_declarations ?first p = - let first_constr_decl = +and parseTypeConstructorDeclarations ?first p = + let firstConstrDecl = match first with | None -> - let start_pos = p.Parser.start_pos in + let startPos = p.Parser.startPos in ignore (Parser.optional p Token.Bar); - parse_type_constructor_declaration ~start_pos p - | Some first_constr_decl -> first_constr_decl + parseTypeConstructorDeclaration ~startPos p + | Some firstConstrDecl -> firstConstrDecl in - first_constr_decl - :: parse_region ~grammar:Grammar.ConstructorDeclaration - ~f:parse_type_constructor_declaration_with_bar p + firstConstrDecl + :: parseRegion ~grammar:Grammar.ConstructorDeclaration + ~f:parseTypeConstructorDeclarationWithBar p (* * type-representation ::= @@ -4909,18 +4861,18 @@ and parse_type_constructor_declarations ?first p = * ∣ = private record-decl * | = .. *) -and parse_type_representation p = - Parser.leave_breadcrumb p Grammar.TypeRepresentation; +and parseTypeRepresentation p = + Parser.leaveBreadcrumb p Grammar.TypeRepresentation; (* = consumed *) - let private_flag = + let privateFlag = if Parser.optional p Token.Private then Asttypes.Private else Asttypes.Public in let kind = match p.Parser.token with | Bar | Uident _ -> - Parsetree.Ptype_variant (parse_type_constructor_declarations p) - | Lbrace -> Parsetree.Ptype_record (parse_record_declaration p) + Parsetree.Ptype_variant (parseTypeConstructorDeclarations p) + | Lbrace -> Parsetree.Ptype_record (parseRecordDeclaration p) | DotDot -> Parser.next p; Ptype_open @@ -4929,8 +4881,8 @@ and parse_type_representation p = (* TODO: I have no idea if this is even remotely a good idea *) Parsetree.Ptype_variant [] in - Parser.eat_breadcrumb p; - (private_flag, kind) + Parser.eatBreadcrumb p; + (privateFlag, kind) (* type-param ::= * | variance 'lident @@ -4942,7 +4894,7 @@ and parse_type_representation p = * | - * | (* empty *) *) -and parse_type_param p = +and parseTypeParam p = let variance = match p.Parser.token with | Plus -> @@ -4958,22 +4910,22 @@ and parse_type_param p = Parser.next p; let ident, loc = if p.Parser.token = Eof then ( - Parser.err ~start_pos:p.start_pos p + Parser.err ~startPos:p.startPos p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); - ("", mk_loc p.start_pos p.prev_end_pos)) - else parse_ident ~msg:ErrorMessages.type_param ~start_pos:p.start_pos p + ("", mkLoc p.startPos p.prevEndPos)) + else parseIdent ~msg:ErrorMessages.typeParam ~startPos:p.startPos p in Some (Ast_helper.Typ.var ~loc ident, variance) | Underscore -> - let loc = mk_loc p.start_pos p.end_pos in + let loc = mkLoc p.startPos p.endPos in Parser.next p; Some (Ast_helper.Typ.any ~loc (), variance) | (Uident _ | Lident _) as token -> Parser.err p (Diagnostics.message - ("Type params start with a singlequote: '" ^ Token.to_string token)); + ("Type params start with a singlequote: '" ^ Token.toString token)); let ident, loc = - parse_ident ~msg:ErrorMessages.type_param ~start_pos:p.start_pos p + parseIdent ~msg:ErrorMessages.typeParam ~startPos:p.startPos p in Some (Ast_helper.Typ.var ~loc ident, variance) | _token -> None @@ -4986,23 +4938,23 @@ and parse_type_param p = * * TODO: when we have pretty-printer show an error * with the actual code corrected. *) -and parse_type_params ~parent p = +and parseTypeParams ~parent p = let opening = p.Parser.token in match opening with - | (LessThan | Lparen) when p.start_pos.pos_lnum == p.prev_end_pos.pos_lnum -> - Scanner.set_diamond_mode p.scanner; - let opening_start_pos = p.start_pos in - Parser.leave_breadcrumb p Grammar.TypeParams; + | (LessThan | Lparen) when p.startPos.pos_lnum == p.prevEndPos.pos_lnum -> + Scanner.setDiamondMode p.scanner; + let openingStartPos = p.startPos in + Parser.leaveBreadcrumb p Grammar.TypeParams; Parser.next p; let params = - parse_comma_delimited_region ~grammar:Grammar.TypeParams - ~closing:GreaterThan ~f:parse_type_param p + parseCommaDelimitedRegion ~grammar:Grammar.TypeParams ~closing:GreaterThan + ~f:parseTypeParam p in let () = match p.token with | Rparen when opening = Token.Lparen -> let msg = - Doc.breakable_group ~force_break:true + Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.text "Type parameters require angle brackets:"; @@ -5012,42 +4964,41 @@ and parse_type_params ~parent p = Doc.line; Doc.concat [ - ResPrinter.print_longident parent.Location.txt; - ResPrinter.print_type_params params - CommentTable.empty; + ResPrinter.printLongident parent.Location.txt; + ResPrinter.printTypeParams params CommentTable.empty; ]; ]); ]) - |> Doc.to_string ~width:80 + |> Doc.toString ~width:80 in - Parser.err ~start_pos:opening_start_pos p (Diagnostics.message msg); + Parser.err ~startPos:openingStartPos p (Diagnostics.message msg); Parser.next p | _ -> Parser.expect GreaterThan p in - Scanner.pop_mode p.scanner Diamond; - Parser.eat_breadcrumb p; + Scanner.popMode p.scanner Diamond; + Parser.eatBreadcrumb p; params | _ -> [] (* type-constraint ::= constraint ' ident = typexpr *) -and parse_type_constraint p = - let start_pos = p.Parser.start_pos in +and parseTypeConstraint p = + let startPos = p.Parser.startPos in match p.Parser.token with | Token.Constraint -> ( Parser.next p; Parser.expect SingleQuote p; match p.Parser.token with - | Lident ident -> - let ident_loc = mk_loc start_pos p.end_pos in + | Lident ident | Uident ident -> + let identLoc = mkLoc startPos p.endPos in Parser.next p; Parser.expect Equal p; - let typ = parse_typ_expr p in - let loc = mk_loc start_pos p.prev_end_pos in - Some (Ast_helper.Typ.var ~loc:ident_loc ident, typ, loc) + let typ = parseTypExpr p in + let loc = mkLoc startPos p.prevEndPos in + Some (Ast_helper.Typ.var ~loc:identLoc ident, typ, loc) | t -> Parser.err p (Diagnostics.lident t); - let loc = mk_loc start_pos p.prev_end_pos in - Some (Ast_helper.Typ.any (), parse_typ_expr p, loc)) + let loc = mkLoc startPos p.prevEndPos in + Some (Ast_helper.Typ.any (), parseTypExpr p, loc)) | _ -> None (* type-constraints ::= @@ -5056,73 +5007,71 @@ and parse_type_constraint p = * | type-constraint type-constraint * | type-constraint type-constraint type-constraint (* 0 or more *) *) -and parse_type_constraints p = - parse_region ~grammar:Grammar.TypeConstraint ~f:parse_type_constraint p +and parseTypeConstraints p = + parseRegion ~grammar:Grammar.TypeConstraint ~f:parseTypeConstraint p -and parse_type_equation_or_constr_decl p = - let uident_start_pos = p.Parser.start_pos in +and parseTypeEquationOrConstrDecl p = + let uidentStartPos = p.Parser.startPos in match p.Parser.token with | Uident uident -> ( Parser.next p; match p.Parser.token with | Dot -> ( Parser.next p; - let type_constr = - parse_value_path_tail p uident_start_pos (Longident.Lident uident) + let typeConstr = + parseValuePathTail p uidentStartPos (Longident.Lident uident) in - let loc = mk_loc uident_start_pos p.prev_end_pos in + let loc = mkLoc uidentStartPos p.prevEndPos in let typ = - parse_type_alias p - (Ast_helper.Typ.constr ~loc type_constr - (parse_type_constructor_args ~constr_name:type_constr p)) + parseTypeAlias p + (Ast_helper.Typ.constr ~loc typeConstr + (parseTypeConstructorArgs ~constrName:typeConstr p)) in match p.token with | Equal -> Parser.next p; - let priv, kind = parse_type_representation p in + let priv, kind = parseTypeRepresentation p in (Some typ, priv, kind) | EqualGreater -> Parser.next 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 Asttypes.Nolabel typ return_type + let returnType = parseTypExpr ~alias:false p in + let loc = mkLoc uidentStartPos p.prevEndPos in + let arrowType = + Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType in let uncurried = p.uncurried_config <> Legacy in - let arrow_type = - if uncurried then - Ast_uncurried.uncurried_type ~loc ~arity:1 arrow_type - else arrow_type + let arrowType = + if uncurried then Ast_uncurried.uncurriedType ~loc ~arity:1 arrowType + else arrowType in - let typ = parse_type_alias p arrow_type in + let typ = parseTypeAlias p arrowType in (Some typ, Asttypes.Public, Parsetree.Ptype_abstract) | _ -> (Some typ, Asttypes.Public, Parsetree.Ptype_abstract)) | _ -> - let uident_end_pos = p.prev_end_pos in - let args, res = parse_constr_decl_args p in + let uidentEndPos = p.prevEndPos in + let args, res = parseConstrDeclArgs p in let first = Some - (let uident_loc = mk_loc uident_start_pos uident_end_pos in + (let uidentLoc = mkLoc uidentStartPos uidentEndPos in Ast_helper.Type.constructor - ~loc:(mk_loc uident_start_pos p.prev_end_pos) + ~loc:(mkLoc uidentStartPos p.prevEndPos) ?res ~args - (Location.mkloc uident uident_loc)) + (Location.mkloc uident uidentLoc)) in ( None, Asttypes.Public, - Parsetree.Ptype_variant (parse_type_constructor_declarations p ?first) - )) + Parsetree.Ptype_variant (parseTypeConstructorDeclarations p ?first) )) | t -> Parser.err p (Diagnostics.uident t); (* TODO: is this a good idea? *) (None, Asttypes.Public, Parsetree.Ptype_abstract) -and parse_record_or_object_decl p = - let start_pos = p.Parser.start_pos in +and parseRecordOrObjectDecl p = + let startPos = p.Parser.startPos in Parser.expect Lbrace p; match p.Parser.token with | DotDot | Dot -> - let closed_flag = + let closedFlag = match p.token with | DotDot -> Parser.next p; @@ -5133,82 +5082,80 @@ and parse_record_or_object_decl p = | _ -> Asttypes.Closed in let fields = - parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations - ~closing:Rbrace ~f:parse_string_field_declaration p + parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations + ~closing:Rbrace ~f:parseStringFieldDeclaration p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in let typ = - Ast_helper.Typ.object_ ~loc ~attrs:[] fields closed_flag - |> parse_type_alias p + Ast_helper.Typ.object_ ~loc ~attrs:[] fields closedFlag + |> parseTypeAlias p in - let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in + let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in (Some typ, Asttypes.Public, Parsetree.Ptype_abstract) | DotDotDot -> ( - let dotdotdot_start = p.start_pos in - let dotdotdot_end = p.end_pos in + let dotdotdotStart = p.startPos in + let dotdotdotEnd = p.endPos in (* start of object type spreading, e.g. `type u = {...a, "u": int}` *) Parser.next p; - let typ = parse_typ_expr p in + let typ = parseTypExpr p in match p.token with | Rbrace -> (* {...x}, spread without extra fields *) Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in - let dot_field = + let loc = mkLoc startPos p.prevEndPos in + let dotField = Ast_helper.Type.field ~loc - {txt = "..."; loc = mk_loc dotdotdot_start dotdotdot_end} + {txt = "..."; loc = mkLoc dotdotdotStart dotdotdotEnd} typ in - let kind = Parsetree.Ptype_record [dot_field] in + let kind = Parsetree.Ptype_record [dotField] in (None, Public, kind) | _ -> Parser.expect Comma p; - let loc = mk_loc start_pos p.prev_end_pos in - let dot_field = + let loc = mkLoc startPos p.prevEndPos in + let dotField = Ast_helper.Type.field ~loc - {txt = "..."; loc = mk_loc dotdotdot_start dotdotdot_end} + {txt = "..."; loc = mkLoc dotdotdotStart dotdotdotEnd} typ in - let found_object_field = ref false in + let foundObjectField = ref false in let fields = - parse_comma_delimited_region ~grammar:Grammar.RecordDecl ~closing:Rbrace - ~f:(parse_field_declaration_region ~found_object_field) + parseCommaDelimitedRegion ~grammar:Grammar.RecordDecl ~closing:Rbrace + ~f:(parseFieldDeclarationRegion ~foundObjectField) p in Parser.expect Rbrace p; - if !found_object_field then + if !foundObjectField then let fields = Ext_list.map fields (fun ld -> match ld.pld_name.txt with | "..." -> Parsetree.Oinherit ld.pld_type | _ -> Otag (ld.pld_name, ld.pld_attributes, ld.pld_type)) in - let dot_field = Parsetree.Oinherit typ in - let typ_obj = Ast_helper.Typ.object_ (dot_field :: fields) Closed in - let typ_obj = parse_type_alias p typ_obj in - let typ_obj = - parse_arrow_type_rest ~es6_arrow:true ~start_pos typ_obj p - in + let dotField = Parsetree.Oinherit typ in + let typ_obj = Ast_helper.Typ.object_ (dotField :: fields) Closed in + let typ_obj = parseTypeAlias p typ_obj in + let typ_obj = parseArrowTypeRest ~es6Arrow:true ~startPos typ_obj p in (Some typ_obj, Public, Ptype_abstract) else - let kind = Parsetree.Ptype_record (dot_field :: fields) in + let kind = Parsetree.Ptype_record (dotField :: fields) in (None, Public, kind)) | _ -> ( - let attrs = parse_attributes p in + let attrs = parseAttributes p in match p.Parser.token with | String _ -> - let closed_flag = Asttypes.Closed in + let closedFlag = Asttypes.Closed in let fields = match attrs with | [] -> - parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations - ~closing:Rbrace ~f:parse_string_field_declaration p + parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations + ~closing:Rbrace ~f:parseStringFieldDeclaration p | attrs -> let first = - Parser.leave_breadcrumb p Grammar.StringFieldDeclarations; + Parser.leaveBreadcrumb p Grammar.StringFieldDeclarations; let field = - match parse_string_field_declaration p with + match parseStringFieldDeclaration p with | Some field -> field | None -> assert false in @@ -5219,36 +5166,35 @@ and parse_record_or_object_decl p = | Comma -> Parser.next p | _ -> Parser.expect Comma p in - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; match field with | Parsetree.Otag (label, _, ct) -> Parsetree.Otag (label, attrs, ct) | Oinherit ct -> Oinherit ct in first - :: parse_comma_delimited_region - ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parse_string_field_declaration p + :: parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations + ~closing:Rbrace ~f:parseStringFieldDeclaration p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in let typ = - Ast_helper.Typ.object_ ~loc ~attrs:[] fields closed_flag - |> parse_type_alias p + Ast_helper.Typ.object_ ~loc ~attrs:[] fields closedFlag + |> parseTypeAlias p in - let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in + let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in (Some typ, Asttypes.Public, Parsetree.Ptype_abstract) | _ -> - Parser.leave_breadcrumb p Grammar.RecordDecl; + Parser.leaveBreadcrumb p Grammar.RecordDecl; let fields = (* XXX *) match attrs with | [] -> - parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations - ~closing:Rbrace ~f:parse_field_declaration_region p + parseCommaDelimitedRegion ~grammar:Grammar.FieldDeclarations + ~closing:Rbrace ~f:parseFieldDeclarationRegion p | attr :: _ as attrs -> let first = - let optional, field = parse_field_declaration p in - let attrs = if optional then optional_attr :: attrs else attrs in + let optional, field = parseFieldDeclaration p in + let attrs = if optional then optionalAttr :: attrs else attrs in Parser.optional p Comma |> ignore; { field with @@ -5261,29 +5207,29 @@ and parse_record_or_object_decl p = } in first - :: parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations - ~closing:Rbrace ~f:parse_field_declaration_region p + :: parseCommaDelimitedRegion ~grammar:Grammar.FieldDeclarations + ~closing:Rbrace ~f:parseFieldDeclarationRegion p in Parser.expect Rbrace p; - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; (None, Asttypes.Public, Parsetree.Ptype_record fields)) -and parse_private_eq_or_repr p = +and parsePrivateEqOrRepr p = Parser.expect Private p; match p.Parser.token with | Lbrace -> - let manifest, _, kind = parse_record_or_object_decl p in + let manifest, _, kind = parseRecordOrObjectDecl p in (manifest, Asttypes.Private, kind) | Uident _ -> - let manifest, _, kind = parse_type_equation_or_constr_decl p in + let manifest, _, kind = parseTypeEquationOrConstrDecl p in (manifest, Asttypes.Private, kind) | Bar | DotDot -> - let _, kind = parse_type_representation p in + let _, kind = parseTypeRepresentation p in (None, Asttypes.Private, kind) - | t when Grammar.is_typ_expr_start t -> - (Some (parse_typ_expr p), Asttypes.Private, Parsetree.Ptype_abstract) + | t when Grammar.isTypExprStart t -> + (Some (parseTypExpr p), Asttypes.Private, Parsetree.Ptype_abstract) | _ -> - let _, kind = parse_type_representation p in + let _, kind = parseTypeRepresentation p in (None, Asttypes.Private, kind) (* @@ -5301,150 +5247,149 @@ and parse_private_eq_or_repr p = tag-spec-full ::= `tag-name [ of [&] typexpr { & typexpr } ] | typexpr *) -and parse_polymorphic_variant_type ~attrs p = - let start_pos = p.Parser.start_pos in +and parsePolymorphicVariantType ~attrs p = + let startPos = p.Parser.startPos in Parser.expect Lbracket p; match p.token with | GreaterThan -> Parser.next p; - let row_fields = + let rowFields = match p.token with | Rbracket -> [] - | Bar -> parse_tag_specs p + | Bar -> parseTagSpecs p | _ -> - let row_field = parse_tag_spec p in - row_field :: parse_tag_specs p + let rowField = parseTagSpec p in + rowField :: parseTagSpecs p in let variant = - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Typ.variant ~attrs ~loc row_fields Open None + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Typ.variant ~attrs ~loc rowFields Open None in Parser.expect Rbracket p; variant | LessThan -> Parser.next p; Parser.optional p Bar |> ignore; - let row_field = parse_tag_spec_full p in - let row_fields = parse_tag_spec_fulls p in - let tag_names = parse_tag_names p in + let rowField = parseTagSpecFull p in + let rowFields = parseTagSpecFulls p in + let tagNames = parseTagNames p in let variant = - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Typ.variant ~attrs ~loc (row_field :: row_fields) Closed - (Some tag_names) + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Typ.variant ~attrs ~loc (rowField :: rowFields) Closed + (Some tagNames) in Parser.expect Rbracket p; variant | _ -> - let row_fields1 = parse_tag_spec_first p in - let row_fields2 = parse_tag_specs p in + let rowFields1 = parseTagSpecFirst p in + let rowFields2 = parseTagSpecs p in let variant = - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Typ.variant ~attrs ~loc (row_fields1 @ row_fields2) Closed None + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Typ.variant ~attrs ~loc (rowFields1 @ rowFields2) Closed None in Parser.expect Rbracket p; variant -and parse_tag_name p = +and parseTagName p = match p.Parser.token with | Hash -> - let ident, _loc = parse_hash_ident ~start_pos:p.start_pos p in + let ident, _loc = parseHashIdent ~startPos:p.startPos p in Some ident | _ -> None -and parse_tag_names p = +and parseTagNames p = if p.Parser.token == GreaterThan then ( Parser.next p; - parse_region p ~grammar:Grammar.TagNames ~f:parse_tag_name) + parseRegion p ~grammar:Grammar.TagNames ~f:parseTagName) else [] -and parse_tag_spec_fulls p = +and parseTagSpecFulls p = match p.Parser.token with | Rbracket -> [] | GreaterThan -> [] | Bar -> Parser.next p; - let row_field = parse_tag_spec_full p in - row_field :: parse_tag_spec_fulls p + let rowField = parseTagSpecFull p in + rowField :: parseTagSpecFulls p | _ -> [] -and parse_tag_spec_full p = - let attrs = parse_attributes p in +and parseTagSpecFull p = + let attrs = parseAttributes p in match p.Parser.token with - | Hash -> parse_polymorphic_variant_type_spec_hash ~attrs ~full:true p + | Hash -> parsePolymorphicVariantTypeSpecHash ~attrs ~full:true p | _ -> - let typ = parse_typ_expr ~attrs p in + let typ = parseTypExpr ~attrs p in Parsetree.Rinherit typ -and parse_tag_specs p = +and parseTagSpecs p = match p.Parser.token with | Bar -> Parser.next p; - let row_field = parse_tag_spec p in - row_field :: parse_tag_specs p + let rowField = parseTagSpec p in + rowField :: parseTagSpecs p | _ -> [] -and parse_tag_spec p = - let attrs = parse_attributes p in +and parseTagSpec p = + let attrs = parseAttributes p in match p.Parser.token with - | Hash -> parse_polymorphic_variant_type_spec_hash ~attrs ~full:false p + | Hash -> parsePolymorphicVariantTypeSpecHash ~attrs ~full:false p | _ -> - let typ = parse_typ_expr ~attrs p in + let typ = parseTypExpr ~attrs p in Parsetree.Rinherit typ -and parse_tag_spec_first p = - let attrs = parse_attributes p in +and parseTagSpecFirst p = + let attrs = parseAttributes p in match p.Parser.token with | Bar -> Parser.next p; - [parse_tag_spec p] - | Hash -> [parse_polymorphic_variant_type_spec_hash ~attrs ~full:false p] + [parseTagSpec p] + | Hash -> [parsePolymorphicVariantTypeSpecHash ~attrs ~full:false p] | _ -> ( - let typ = parse_typ_expr ~attrs p in + let typ = parseTypExpr ~attrs p in match p.token with | Rbracket -> (* example: [ListStyleType.t] *) [Parsetree.Rinherit typ] | _ -> Parser.expect Bar p; - [Parsetree.Rinherit typ; parse_tag_spec p]) + [Parsetree.Rinherit typ; parseTagSpec p]) -and parse_polymorphic_variant_type_spec_hash ~attrs ~full p : - Parsetree.row_field = - let start_pos = p.Parser.start_pos in - let ident, loc = parse_hash_ident ~start_pos p in +and parsePolymorphicVariantTypeSpecHash ~attrs ~full p : Parsetree.row_field = + let startPos = p.Parser.startPos in + let ident, loc = parseHashIdent ~startPos p in let rec loop p = match p.Parser.token with | Band when full -> Parser.next p; - let row_field = parse_polymorphic_variant_type_args p in - row_field :: loop p + let rowField = parsePolymorphicVariantTypeArgs p in + rowField :: loop p | _ -> [] in - let first_tuple, tag_contains_a_constant_empty_constructor = + let firstTuple, tagContainsAConstantEmptyConstructor = match p.Parser.token with | Band when full -> Parser.next p; - ([parse_polymorphic_variant_type_args p], true) - | Lparen -> ([parse_polymorphic_variant_type_args p], false) + ([parsePolymorphicVariantTypeArgs p], true) + | Lparen -> ([parsePolymorphicVariantTypeArgs p], false) | _ -> ([], true) in - let tuples = first_tuple @ loop p in + let tuples = firstTuple @ loop p in Parsetree.Rtag ( Location.mkloc ident loc, attrs, - tag_contains_a_constant_empty_constructor, + tagContainsAConstantEmptyConstructor, tuples ) -and parse_polymorphic_variant_type_args p = - let start_pos = p.Parser.start_pos in +and parsePolymorphicVariantTypeArgs p = + let startPos = p.Parser.startPos in Parser.expect Lparen p; let args = - parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:Rparen - ~f:parse_typ_expr_region p + parseCommaDelimitedRegion ~grammar:Grammar.TypExprList ~closing:Rparen + ~f:parseTypExprRegion p in Parser.expect Rparen p; let attrs = [] in - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in match args with | [({ptyp_desc = Ptyp_tuple _} as typ)] as types -> if p.mode = ParseForTypeChecker then typ @@ -5452,24 +5397,24 @@ and parse_polymorphic_variant_type_args p = | [typ] -> typ | types -> Ast_helper.Typ.tuple ~loc ~attrs types -and parse_type_equation_and_representation p = +and parseTypeEquationAndRepresentation p = match p.Parser.token with | (Equal | Bar) as token -> ( if token = Bar then Parser.expect Equal p; Parser.next p; match p.Parser.token with - | Uident _ -> parse_type_equation_or_constr_decl p - | Lbrace -> parse_record_or_object_decl p - | Private -> parse_private_eq_or_repr p + | Uident _ -> parseTypeEquationOrConstrDecl p + | Lbrace -> parseRecordOrObjectDecl p + | Private -> parsePrivateEqOrRepr p | Bar | DotDot -> - let priv, kind = parse_type_representation p in + let priv, kind = parseTypeRepresentation p in (None, priv, kind) | _ -> ( - let manifest = Some (parse_typ_expr p) in + let manifest = Some (parseTypExpr p) in match p.Parser.token with | Equal -> Parser.next p; - let priv, kind = parse_type_representation p in + let priv, kind = parseTypeRepresentation p in (manifest, priv, kind) | _ -> (manifest, Public, Parsetree.Ptype_abstract))) | _ -> (None, Public, Parsetree.Ptype_abstract) @@ -5478,91 +5423,91 @@ and parse_type_equation_and_representation p = * typedef ::= typeconstr-name [type-params] type-information * type-information ::= [type-equation] [type-representation] { type-constraint } * type-equation ::= = typexpr *) -and parse_type_def ~attrs ~start_pos p = - Parser.leave_breadcrumb p Grammar.TypeDef; +and parseTypeDef ~attrs ~startPos p = + Parser.leaveBreadcrumb p Grammar.TypeDef; (* let attrs = match attrs with | Some attrs -> attrs | None -> parseAttributes p in *) - Parser.leave_breadcrumb p Grammar.TypeConstrName; - let name, loc = parse_lident p in - let type_constr_name = Location.mkloc name loc in - Parser.eat_breadcrumb p; + Parser.leaveBreadcrumb p Grammar.TypeConstrName; + let name, loc = parseLident p in + let typeConstrName = Location.mkloc name loc in + Parser.eatBreadcrumb p; let params = - let constr_name = Location.mkloc (Longident.Lident name) loc in - parse_type_params ~parent:constr_name p + let constrName = Location.mkloc (Longident.Lident name) loc in + parseTypeParams ~parent:constrName p in - let type_def = - let manifest, priv, kind = parse_type_equation_and_representation p in - let cstrs = parse_type_constraints p in - let loc = mk_loc start_pos p.prev_end_pos in + let typeDef = + let manifest, priv, kind = parseTypeEquationAndRepresentation p in + let cstrs = parseTypeConstraints p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Type.mk ~loc ~attrs ~priv ~kind ~params ~cstrs ?manifest - type_constr_name + typeConstrName in - Parser.eat_breadcrumb p; - type_def + Parser.eatBreadcrumb p; + typeDef -and parse_type_extension ~params ~attrs ~name p = +and parseTypeExtension ~params ~attrs ~name p = Parser.expect PlusEqual p; let priv = if Parser.optional p Token.Private then Asttypes.Private else Asttypes.Public in - let constr_start = p.Parser.start_pos in + let constrStart = p.Parser.startPos in Parser.optional p Bar |> ignore; let first = let attrs, name, kind = match p.Parser.token with | Bar -> Parser.next p; - parse_constr_def ~parse_attrs:true p - | _ -> parse_constr_def ~parse_attrs:true p + parseConstrDef ~parseAttrs:true p + | _ -> parseConstrDef ~parseAttrs:true p in - let loc = mk_loc constr_start p.prev_end_pos in + let loc = mkLoc constrStart p.prevEndPos in Ast_helper.Te.constructor ~loc ~attrs name kind in let rec loop p cs = match p.Parser.token with | Bar -> - let start_pos = p.Parser.start_pos in + let startPos = p.Parser.startPos in Parser.next p; - let attrs, name, kind = parse_constr_def ~parse_attrs:true p in - let ext_constr = + let attrs, name, kind = parseConstrDef ~parseAttrs:true p in + let extConstr = Ast_helper.Te.constructor ~attrs - ~loc:(mk_loc start_pos p.prev_end_pos) + ~loc:(mkLoc startPos p.prevEndPos) name kind in - loop p (ext_constr :: cs) + loop p (extConstr :: cs) | _ -> List.rev cs in let constructors = loop p [first] in Ast_helper.Te.mk ~attrs ~params ~priv name constructors -and parse_type_definitions ~attrs ~name ~params ~start_pos p = - let type_def = - let manifest, priv, kind = parse_type_equation_and_representation p in - let cstrs = parse_type_constraints p in - let loc = mk_loc start_pos p.prev_end_pos in +and parseTypeDefinitions ~attrs ~name ~params ~startPos p = + let typeDef = + let manifest, priv, kind = parseTypeEquationAndRepresentation p in + let cstrs = parseTypeConstraints p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Type.mk ~loc ~attrs ~priv ~kind ~params ~cstrs ?manifest - {name with txt = lident_of_path name.Location.txt} + {name with txt = lidentOfPath name.Location.txt} in let rec loop p defs = - let start_pos = p.Parser.start_pos in - let attrs = parse_attributes_and_binding p in + let startPos = p.Parser.startPos in + let attrs = parseAttributesAndBinding p in match p.Parser.token with | And -> Parser.next p; - let type_def = parse_type_def ~attrs ~start_pos p in - loop p (type_def :: defs) + let typeDef = parseTypeDef ~attrs ~startPos p in + loop p (typeDef :: defs) | _ -> List.rev defs in - loop p [type_def] + loop p [typeDef] (* TODO: decide if we really want type extensions (eg. type x += Blue) * It adds quite a bit of complexity that can be avoided, * implemented for now. Needed to get a feel for the complexities of * this territory of the grammar *) -and parse_type_definition_or_extension ~attrs p = - let start_pos = p.Parser.start_pos in +and parseTypeDefinitionOrExtension ~attrs p = + let startPos = p.Parser.startPos in Parser.expect Token.Typ p; - let rec_flag = + let recFlag = match p.token with | Rec -> Parser.next p; @@ -5572,35 +5517,35 @@ and parse_type_definition_or_extension ~attrs p = Asttypes.Nonrecursive | _ -> Asttypes.Nonrecursive in - let name = parse_value_path p in - let params = parse_type_params ~parent:name p in + let name = parseValuePath p in + let params = parseTypeParams ~parent:name p in match p.Parser.token with - | PlusEqual -> TypeExt (parse_type_extension ~params ~attrs ~name p) + | PlusEqual -> TypeExt (parseTypeExtension ~params ~attrs ~name p) | _ -> (* shape of type name should be Lident, i.e. `t` is accepted. `User.t` not *) let () = match name.Location.txt with | Lident _ -> () | longident -> - Parser.err ~start_pos:name.loc.loc_start ~end_pos:name.loc.loc_end p - (longident |> ErrorMessages.type_declaration_name_longident + Parser.err ~startPos:name.loc.loc_start ~endPos:name.loc.loc_end p + (longident |> ErrorMessages.typeDeclarationNameLongident |> Diagnostics.message) in - let type_defs = parse_type_definitions ~attrs ~name ~params ~start_pos p in - TypeDef {rec_flag; types = type_defs} + let typeDefs = parseTypeDefinitions ~attrs ~name ~params ~startPos p in + TypeDef {recFlag; types = typeDefs} (* external value-name : typexp = external-declaration *) -and parse_external_def ~attrs ~start_pos p = - let in_external = !InExternal.status in +and parseExternalDef ~attrs ~startPos p = + let inExternal = !InExternal.status in InExternal.status := true; - Parser.leave_breadcrumb p Grammar.External; + Parser.leaveBreadcrumb p Grammar.External; Parser.expect Token.External p; - let name, loc = parse_lident p in + let name, loc = parseLident p in let name = Location.mkloc name loc in Parser.expect ~grammar:Grammar.TypeExpression Colon p; - let typ_expr = parse_typ_expr p in - let equal_start = p.start_pos in - let equal_end = p.end_pos in + let typExpr = parseTypExpr p in + let equalStart = p.startPos in + let equalEnd = p.endPos in Parser.expect Equal p; let prim = match p.token with @@ -5608,16 +5553,16 @@ and parse_external_def ~attrs ~start_pos p = Parser.next p; [s] | _ -> - Parser.err ~start_pos:equal_start ~end_pos:equal_end p + Parser.err ~startPos:equalStart ~endPos:equalEnd p (Diagnostics.message ("An external requires the name of the JS value you're referring \ to, like \"" ^ name.txt ^ "\".")); [] in - let loc = mk_loc start_pos p.prev_end_pos in - let vb = Ast_helper.Val.mk ~loc ~attrs ~prim name typ_expr in - Parser.eat_breadcrumb p; - InExternal.status := in_external; + let loc = mkLoc startPos p.prevEndPos in + let vb = Ast_helper.Val.mk ~loc ~attrs ~prim name typExpr in + Parser.eatBreadcrumb p; + InExternal.status := inExternal; vb (* constr-def ::= @@ -5627,12 +5572,12 @@ and parse_external_def ~attrs ~start_pos p = * constr-decl ::= constr-name constr-args * constr-name ::= uident * constr ::= path-uident *) -and parse_constr_def ~parse_attrs p = - let attrs = if parse_attrs then parse_attributes p else [] in +and parseConstrDef ~parseAttrs p = + let attrs = if parseAttrs then parseAttributes p else [] in let name = match p.Parser.token with | Uident name -> - let loc = mk_loc p.start_pos p.end_pos in + let loc = mkLoc p.startPos p.endPos in Parser.next p; Location.mkloc name loc | t -> @@ -5642,15 +5587,15 @@ and parse_constr_def ~parse_attrs p = let kind = match p.Parser.token with | Lparen -> - let args, res = parse_constr_decl_args p in + let args, res = parseConstrDeclArgs p in Parsetree.Pext_decl (args, res) | Equal -> Parser.next p; - let longident = parse_module_long_ident ~lowercase:false p in + let longident = parseModuleLongIdent ~lowercase:false p in Parsetree.Pext_rebind longident | Colon -> Parser.next p; - let typ = parse_typ_expr p in + let typ = parseTypExpr p in Parsetree.Pext_decl (Pcstr_tuple [], Some typ) | _ -> Parsetree.Pext_decl (Pcstr_tuple [], None) in @@ -5663,76 +5608,74 @@ and parse_constr_def ~parse_attrs p = * * constr-name ::= uident * constr ::= long_uident *) -and parse_exception_def ~attrs p = - let start_pos = p.Parser.start_pos in +and parseExceptionDef ~attrs p = + let startPos = p.Parser.startPos in Parser.expect Token.Exception p; - let _, name, kind = parse_constr_def ~parse_attrs:false p in - let loc = mk_loc start_pos p.prev_end_pos in + let _, name, kind = parseConstrDef ~parseAttrs:false p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Te.constructor ~loc ~attrs name kind -and parse_newline_or_semicolon_structure p = +and parseNewlineOrSemicolonStructure p = match p.Parser.token with | Semicolon -> Parser.next p - | token when Grammar.is_structure_item_start token -> - if p.prev_end_pos.pos_lnum < p.start_pos.pos_lnum then () + | token when Grammar.isStructureItemStart token -> + if p.prevEndPos.pos_lnum < p.startPos.pos_lnum then () else - Parser.err ~start_pos:p.prev_end_pos ~end_pos:p.end_pos p + Parser.err ~startPos:p.prevEndPos ~endPos:p.endPos p (Diagnostics.message "consecutive statements on a line must be separated by ';' or a \ newline") | _ -> () -and parse_structure_item_region p = - let start_pos = p.Parser.start_pos in - let attrs = parse_attributes p in +and parseStructureItemRegion p = + let startPos = p.Parser.startPos in + let attrs = parseAttributes p in match p.Parser.token with | Open -> - let open_description = parse_open_description ~attrs p in - parse_newline_or_semicolon_structure p; - let loc = mk_loc start_pos p.prev_end_pos in - Some (Ast_helper.Str.open_ ~loc open_description) + let openDescription = parseOpenDescription ~attrs p in + parseNewlineOrSemicolonStructure p; + let loc = mkLoc startPos p.prevEndPos in + Some (Ast_helper.Str.open_ ~loc openDescription) | Let -> - let rec_flag, let_bindings = parse_let_bindings ~attrs ~start_pos p in - parse_newline_or_semicolon_structure p; - let loc = mk_loc start_pos p.prev_end_pos in - Some (Ast_helper.Str.value ~loc rec_flag let_bindings) + let recFlag, letBindings = parseLetBindings ~attrs ~startPos p in + parseNewlineOrSemicolonStructure p; + let loc = mkLoc startPos p.prevEndPos in + Some (Ast_helper.Str.value ~loc recFlag letBindings) | Typ -> ( - Parser.begin_region p; - match parse_type_definition_or_extension ~attrs p with - | TypeDef {rec_flag; types} -> - parse_newline_or_semicolon_structure p; - let loc = mk_loc start_pos p.prev_end_pos in - Parser.end_region p; - Some (Ast_helper.Str.type_ ~loc rec_flag types) + Parser.beginRegion p; + match parseTypeDefinitionOrExtension ~attrs p with + | TypeDef {recFlag; types} -> + parseNewlineOrSemicolonStructure p; + let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; + Some (Ast_helper.Str.type_ ~loc recFlag types) | TypeExt ext -> - parse_newline_or_semicolon_structure p; - let loc = mk_loc start_pos p.prev_end_pos in - Parser.end_region p; + parseNewlineOrSemicolonStructure p; + let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; Some (Ast_helper.Str.type_extension ~loc ext)) | External -> - let external_def = parse_external_def ~attrs ~start_pos p in - parse_newline_or_semicolon_structure p; - let loc = mk_loc start_pos p.prev_end_pos in - Some (Ast_helper.Str.primitive ~loc external_def) + let externalDef = parseExternalDef ~attrs ~startPos p in + parseNewlineOrSemicolonStructure p; + let loc = mkLoc startPos p.prevEndPos in + Some (Ast_helper.Str.primitive ~loc externalDef) | Exception -> - let exception_def = parse_exception_def ~attrs p in - parse_newline_or_semicolon_structure p; - let loc = mk_loc start_pos p.prev_end_pos in - Some (Ast_helper.Str.exception_ ~loc exception_def) + let exceptionDef = parseExceptionDef ~attrs p in + parseNewlineOrSemicolonStructure p; + let loc = mkLoc startPos p.prevEndPos in + Some (Ast_helper.Str.exception_ ~loc exceptionDef) | Include -> - let include_statement = parse_include_statement ~attrs p in - parse_newline_or_semicolon_structure p; - let loc = mk_loc start_pos p.prev_end_pos in - Some (Ast_helper.Str.include_ ~loc include_statement) + let includeStatement = parseIncludeStatement ~attrs p in + parseNewlineOrSemicolonStructure p; + let loc = mkLoc startPos p.prevEndPos in + Some (Ast_helper.Str.include_ ~loc includeStatement) | Module -> - Parser.begin_region p; - let structure_item = - parse_module_or_module_type_impl_or_pack_expr ~attrs p - in - parse_newline_or_semicolon_structure p; - let loc = mk_loc start_pos p.prev_end_pos in - Parser.end_region p; - Some {structure_item with pstr_loc = loc} + Parser.beginRegion p; + let structureItem = parseModuleOrModuleTypeImplOrPackExpr ~attrs p in + parseNewlineOrSemicolonStructure p; + let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; + Some {structureItem with pstr_loc = loc} | ModuleComment (loc, s) -> Parser.next p; Some @@ -5744,108 +5687,105 @@ and parse_structure_item_region p = (Ast_helper.Exp.constant ~loc (Pconst_string (s, None))); ] )) | AtAt -> - let attr = parse_standalone_attribute p in - parse_newline_or_semicolon_structure p; - let loc = mk_loc start_pos p.prev_end_pos in + let attr = parseStandaloneAttribute p in + parseNewlineOrSemicolonStructure p; + let loc = mkLoc startPos p.prevEndPos in Some (Ast_helper.Str.attribute ~loc attr) | PercentPercent -> - let extension = parse_extension ~module_language:true p in - parse_newline_or_semicolon_structure p; - let loc = mk_loc start_pos p.prev_end_pos in + let extension = parseExtension ~moduleLanguage:true p in + parseNewlineOrSemicolonStructure p; + let loc = mkLoc startPos p.prevEndPos in Some (Ast_helper.Str.extension ~attrs ~loc extension) - | token when Grammar.is_expr_start token -> - let prev_end_pos = p.Parser.end_pos in - let exp = parse_expr p in - parse_newline_or_semicolon_structure p; - let loc = mk_loc start_pos p.prev_end_pos in - Parser.check_progress ~prev_end_pos + | token when Grammar.isExprStart token -> + let prevEndPos = p.Parser.endPos in + let exp = parseExpr p in + parseNewlineOrSemicolonStructure p; + let loc = mkLoc startPos p.prevEndPos in + Parser.checkProgress ~prevEndPos ~result:(Ast_helper.Str.eval ~loc ~attrs exp) p | _ -> ( match attrs with - | (({Asttypes.loc = attr_loc}, _) as attr) :: _ -> - Parser.err ~start_pos:attr_loc.loc_start ~end_pos:attr_loc.loc_end p - (Diagnostics.message (ErrorMessages.attribute_without_node attr)); - let expr = parse_expr p in + | (({Asttypes.loc = attrLoc}, _) as attr) :: _ -> + Parser.err ~startPos:attrLoc.loc_start ~endPos:attrLoc.loc_end p + (Diagnostics.message (ErrorMessages.attributeWithoutNode attr)); + let expr = parseExpr p in Some - (Ast_helper.Str.eval - ~loc:(mk_loc p.start_pos p.prev_end_pos) - ~attrs expr) + (Ast_helper.Str.eval ~loc:(mkLoc p.startPos p.prevEndPos) ~attrs expr) | _ -> None) -[@@progress Parser.next, Parser.expect, LoopProgress.list_rest] +[@@progress Parser.next, Parser.expect, LoopProgress.listRest] (* include-statement ::= include module-expr *) -and parse_include_statement ~attrs p = - let start_pos = p.Parser.start_pos in +and parseIncludeStatement ~attrs p = + let startPos = p.Parser.startPos in Parser.expect Token.Include p; - let mod_expr = parse_module_expr p in - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Incl.mk ~loc ~attrs mod_expr + let modExpr = parseModuleExpr p in + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Incl.mk ~loc ~attrs modExpr -and parse_atomic_module_expr p = - let start_pos = p.Parser.start_pos in +and parseAtomicModuleExpr p = + let startPos = p.Parser.startPos in match p.Parser.token with | Uident _ident -> - let longident = parse_module_long_ident ~lowercase:false p in + let longident = parseModuleLongIdent ~lowercase:false p in Ast_helper.Mod.ident ~loc:longident.loc longident | Lbrace -> Parser.next p; let structure = Ast_helper.Mod.structure - (parse_delimited_region ~grammar:Grammar.Structure ~closing:Rbrace - ~f:parse_structure_item_region p) + (parseDelimitedRegion ~grammar:Grammar.Structure ~closing:Rbrace + ~f:parseStructureItemRegion p) in Parser.expect Rbrace p; - let end_pos = p.prev_end_pos in - {structure with pmod_loc = mk_loc start_pos end_pos} + let endPos = p.prevEndPos in + {structure with pmod_loc = mkLoc startPos endPos} | Lparen -> Parser.next p; - let mod_expr = + let modExpr = match p.token with - | Rparen -> - Ast_helper.Mod.structure ~loc:(mk_loc start_pos p.prev_end_pos) [] - | _ -> parse_constrained_mod_expr p + | Rparen -> Ast_helper.Mod.structure ~loc:(mkLoc startPos p.prevEndPos) [] + | _ -> parseConstrainedModExpr p in Parser.expect Rparen p; - mod_expr + modExpr | Lident "unpack" -> ( (* TODO: should this be made a keyword?? *) Parser.next p; Parser.expect Lparen p; - let expr = parse_expr p in + let expr = parseExpr p in match p.Parser.token with | Colon -> - let colon_start = p.Parser.start_pos in + let colonStart = p.Parser.startPos in Parser.next p; - let attrs = parse_attributes p in - let package_type = parse_package_type ~start_pos:colon_start ~attrs p in + let attrs = parseAttributes p in + let packageType = parsePackageType ~startPos:colonStart ~attrs p in Parser.expect Rparen p; - let loc = mk_loc start_pos p.prev_end_pos in - let constraint_expr = Ast_helper.Exp.constraint_ ~loc expr package_type in - Ast_helper.Mod.unpack ~loc constraint_expr + let loc = mkLoc startPos p.prevEndPos in + let constraintExpr = Ast_helper.Exp.constraint_ ~loc expr packageType in + Ast_helper.Mod.unpack ~loc constraintExpr | _ -> Parser.expect Rparen p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Mod.unpack ~loc expr) | Percent -> - let extension = parse_extension p in - let loc = mk_loc start_pos p.prev_end_pos in + let extension = parseExtension p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Mod.extension ~loc extension | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Recover.default_module_expr () + Recover.defaultModuleExpr () -and parse_primary_mod_expr p = - let start_pos = p.Parser.start_pos in - let mod_expr = parse_atomic_module_expr p in - let rec loop p mod_expr = +and parsePrimaryModExpr p = + let startPos = p.Parser.startPos in + let modExpr = parseAtomicModuleExpr p in + let rec loop p modExpr = match p.Parser.token with - | Lparen when p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> - loop p (parse_module_application p mod_expr) - | _ -> mod_expr + | Lparen when p.prevEndPos.pos_lnum == p.startPos.pos_lnum -> + loop p (parseModuleApplication p modExpr) + | _ -> modExpr in - let mod_expr = loop p mod_expr in - {mod_expr with pmod_loc = mk_loc start_pos p.prev_end_pos} + let modExpr = loop p modExpr in + {modExpr with pmod_loc = mkLoc startPos p.prevEndPos} (* * functor-arg ::= @@ -5854,96 +5794,93 @@ and parse_primary_mod_expr p = * | modtype --> "punning" for _ : modtype * | attributes functor-arg *) -and parse_functor_arg p = - let start_pos = p.Parser.start_pos in - let attrs = parse_attributes p in +and parseFunctorArg p = + let startPos = p.Parser.startPos in + let attrs = parseAttributes p in match p.Parser.token with | Uident ident -> ( Parser.next p; - let uident_end_pos = p.prev_end_pos in + let uidentEndPos = p.prevEndPos in match p.Parser.token with | Colon -> Parser.next p; - let module_type = parse_module_type p in - let loc = mk_loc start_pos uident_end_pos in - let arg_name = Location.mkloc ident loc in - Some (attrs, arg_name, Some module_type, start_pos) + let moduleType = parseModuleType p in + let loc = mkLoc startPos uidentEndPos in + let argName = Location.mkloc ident loc in + Some (attrs, argName, Some moduleType, startPos) | Dot -> Parser.next p; - let module_type = - let module_long_ident = - parse_module_long_ident_tail ~lowercase:false p start_pos + let moduleType = + let moduleLongIdent = + parseModuleLongIdentTail ~lowercase:false p startPos (Longident.Lident ident) in - Ast_helper.Mty.ident ~loc:module_long_ident.loc module_long_ident + Ast_helper.Mty.ident ~loc:moduleLongIdent.loc moduleLongIdent in - let arg_name = Location.mknoloc "_" in - Some (attrs, arg_name, Some module_type, start_pos) + let argName = Location.mknoloc "_" in + Some (attrs, argName, Some moduleType, startPos) | _ -> - let loc = mk_loc start_pos uident_end_pos in - let mod_ident = Location.mkloc (Longident.Lident ident) loc in - let module_type = Ast_helper.Mty.ident ~loc mod_ident in - let arg_name = Location.mknoloc "_" in - Some (attrs, arg_name, Some module_type, start_pos)) + let loc = mkLoc startPos uidentEndPos in + let modIdent = Location.mkloc (Longident.Lident ident) loc in + let moduleType = Ast_helper.Mty.ident ~loc modIdent in + let argName = Location.mknoloc "_" in + Some (attrs, argName, Some moduleType, startPos)) | Underscore -> Parser.next p; - let arg_name = Location.mkloc "_" (mk_loc start_pos p.prev_end_pos) in + let argName = Location.mkloc "_" (mkLoc startPos p.prevEndPos) in Parser.expect Colon p; - let module_type = parse_module_type p in - Some (attrs, arg_name, Some module_type, start_pos) + let moduleType = parseModuleType p in + Some (attrs, argName, Some moduleType, startPos) | Lparen -> Parser.next p; Parser.expect Rparen p; - let arg_name = Location.mkloc "*" (mk_loc start_pos p.prev_end_pos) in - Some (attrs, arg_name, None, start_pos) + let argName = Location.mkloc "*" (mkLoc startPos p.prevEndPos) in + Some (attrs, argName, None, startPos) | _ -> None -and parse_functor_args p = - let start_pos = p.Parser.start_pos in +and parseFunctorArgs p = + let startPos = p.Parser.startPos in Parser.expect Lparen p; let args = - parse_comma_delimited_region ~grammar:Grammar.FunctorArgs ~closing:Rparen - ~f:parse_functor_arg p + parseCommaDelimitedRegion ~grammar:Grammar.FunctorArgs ~closing:Rparen + ~f:parseFunctorArg p in Parser.expect Rparen p; match args with | [] -> - [ - ([], Location.mkloc "*" (mk_loc start_pos p.prev_end_pos), None, start_pos); - ] + [([], Location.mkloc "*" (mkLoc startPos p.prevEndPos), None, startPos)] | args -> args -and parse_functor_module_expr p = - let start_pos = p.Parser.start_pos in - let args = parse_functor_args p in - let return_type = +and parseFunctorModuleExpr p = + let startPos = p.Parser.startPos in + let args = parseFunctorArgs p in + let returnType = match p.Parser.token with | Colon -> Parser.next p; - Some (parse_module_type ~es6_arrow:false p) + Some (parseModuleType ~es6Arrow:false p) | _ -> None in Parser.expect EqualGreater p; - let rhs_module_expr = - let mod_expr = parse_module_expr p in - match return_type with - | Some mod_type -> + let rhsModuleExpr = + let modExpr = parseModuleExpr p in + match returnType with + | Some modType -> Ast_helper.Mod.constraint_ ~loc: - (mk_loc mod_expr.pmod_loc.loc_start - mod_type.Parsetree.pmty_loc.loc_end) - mod_expr mod_type - | None -> mod_expr + (mkLoc modExpr.pmod_loc.loc_start modType.Parsetree.pmty_loc.loc_end) + modExpr modType + | None -> modExpr in - let end_pos = p.prev_end_pos in - let mod_expr = + let endPos = p.prevEndPos in + let modExpr = List.fold_right - (fun (attrs, name, module_type, start_pos) acc -> - Ast_helper.Mod.functor_ ~loc:(mk_loc start_pos end_pos) ~attrs name - module_type acc) - args rhs_module_expr + (fun (attrs, name, moduleType, startPos) acc -> + Ast_helper.Mod.functor_ ~loc:(mkLoc startPos endPos) ~attrs name + moduleType acc) + args rhsModuleExpr in - {mod_expr with pmod_loc = mk_loc start_pos end_pos} + {modExpr with pmod_loc = mkLoc startPos endPos} (* module-expr ::= * | module-path @@ -5954,233 +5891,229 @@ and parse_functor_module_expr p = * ∣ ( module-expr : module-type ) * | extension * | attributes module-expr *) -and parse_module_expr p = - let has_await, loc_await = - let start_pos = p.start_pos in +and parseModuleExpr p = + let hasAwait, loc_await = + let startPos = p.startPos in match p.Parser.token with | Await -> Parser.expect Await p; - let end_pos = p.end_pos in - (true, mk_loc start_pos end_pos) - | _ -> (false, mk_loc start_pos start_pos) + let endPos = p.endPos in + (true, mkLoc startPos endPos) + | _ -> (false, mkLoc startPos startPos) in - let attrs = parse_attributes p in + let attrs = parseAttributes p in let attrs = - if has_await then + if hasAwait then (({txt = "res.await"; loc = loc_await}, PStr []) : Parsetree.attribute) :: attrs else attrs in - let mod_expr = - if is_es6_arrow_functor p then parse_functor_module_expr p - else parse_primary_mod_expr p + let modExpr = + if isEs6ArrowFunctor p then parseFunctorModuleExpr p + else parsePrimaryModExpr p in - { - mod_expr with - pmod_attributes = List.concat [mod_expr.pmod_attributes; attrs]; - } + {modExpr with pmod_attributes = List.concat [modExpr.pmod_attributes; attrs]} -and parse_constrained_mod_expr p = - let mod_expr = parse_module_expr p in +and parseConstrainedModExpr p = + let modExpr = parseModuleExpr p in match p.Parser.token with | Colon -> Parser.next p; - let mod_type = parse_module_type p in - let loc = mk_loc mod_expr.pmod_loc.loc_start mod_type.pmty_loc.loc_end in - Ast_helper.Mod.constraint_ ~loc mod_expr mod_type - | _ -> mod_expr - -and parse_constrained_mod_expr_region p = - if Grammar.is_mod_expr_start p.Parser.token then - Some (parse_constrained_mod_expr p) + let modType = parseModuleType p in + let loc = mkLoc modExpr.pmod_loc.loc_start modType.pmty_loc.loc_end in + Ast_helper.Mod.constraint_ ~loc modExpr modType + | _ -> modExpr + +and parseConstrainedModExprRegion p = + if Grammar.isModExprStart p.Parser.token then Some (parseConstrainedModExpr p) else None -and parse_module_application p mod_expr = - let start_pos = p.Parser.start_pos in +and parseModuleApplication p modExpr = + let startPos = p.Parser.startPos in Parser.expect Lparen p; let args = - parse_comma_delimited_region ~grammar:Grammar.ModExprList ~closing:Rparen - ~f:parse_constrained_mod_expr_region p + parseCommaDelimitedRegion ~grammar:Grammar.ModExprList ~closing:Rparen + ~f:parseConstrainedModExprRegion p in Parser.expect Rparen p; let args = match args with | [] -> - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in [Ast_helper.Mod.structure ~loc []] | args -> args in List.fold_left - (fun mod_expr arg -> + (fun modExpr arg -> Ast_helper.Mod.apply ~loc: - (mk_loc mod_expr.Parsetree.pmod_loc.loc_start + (mkLoc modExpr.Parsetree.pmod_loc.loc_start arg.Parsetree.pmod_loc.loc_end) - mod_expr arg) - mod_expr args + modExpr arg) + modExpr args -and parse_module_or_module_type_impl_or_pack_expr ~attrs p = - let start_pos = p.Parser.start_pos in +and parseModuleOrModuleTypeImplOrPackExpr ~attrs p = + let startPos = p.Parser.startPos in Parser.expect Module p; match p.Parser.token with - | Typ -> parse_module_type_impl ~attrs start_pos p + | Typ -> parseModuleTypeImpl ~attrs startPos p | Lparen -> - let expr = parse_first_class_module_expr ~start_pos p in - let a = parse_primary_expr ~operand:expr p in - let expr = parse_binary_expr ~a p 1 in - let expr = parse_ternary_expr expr p in + let expr = parseFirstClassModuleExpr ~startPos p in + let a = parsePrimaryExpr ~operand:expr p in + let expr = parseBinaryExpr ~a p 1 in + let expr = parseTernaryExpr expr p in Ast_helper.Str.eval ~attrs expr - | _ -> parse_maybe_rec_module_binding ~attrs ~start_pos p + | _ -> parseMaybeRecModuleBinding ~attrs ~startPos p -and parse_module_type_impl ~attrs start_pos p = +and parseModuleTypeImpl ~attrs startPos p = Parser.expect Typ p; - let name_start = p.Parser.start_pos in + let nameStart = p.Parser.startPos in let name = match p.Parser.token with | Lident ident -> Parser.next p; - let loc = mk_loc name_start p.prev_end_pos in + let loc = mkLoc nameStart p.prevEndPos in Location.mkloc ident loc | Uident ident -> Parser.next p; - let loc = mk_loc name_start p.prev_end_pos in + let loc = mkLoc nameStart p.prevEndPos in Location.mkloc ident loc | t -> Parser.err p (Diagnostics.uident t); Location.mknoloc "_" in Parser.expect Equal p; - let module_type = parse_module_type p in - let module_type_declaration = + let moduleType = parseModuleType p in + let moduleTypeDeclaration = Ast_helper.Mtd.mk ~attrs - ~loc:(mk_loc name_start p.prev_end_pos) - ~typ:module_type name + ~loc:(mkLoc nameStart p.prevEndPos) + ~typ:moduleType name in - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Str.modtype ~loc module_type_declaration + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Str.modtype ~loc moduleTypeDeclaration (* definition ::= ∣ module rec module-name : module-type = module-expr { and module-name : module-type = module-expr } *) -and parse_maybe_rec_module_binding ~attrs ~start_pos p = +and parseMaybeRecModuleBinding ~attrs ~startPos p = match p.Parser.token with | Token.Rec -> Parser.next p; - Ast_helper.Str.rec_module (parse_module_bindings ~start_pos ~attrs p) + Ast_helper.Str.rec_module (parseModuleBindings ~startPos ~attrs p) | _ -> Ast_helper.Str.module_ - (parse_module_binding ~attrs ~start_pos:p.Parser.start_pos p) + (parseModuleBinding ~attrs ~startPos:p.Parser.startPos p) -and parse_module_binding ~attrs ~start_pos p = +and parseModuleBinding ~attrs ~startPos p = let name = match p.Parser.token with | Uident ident -> - let start_pos = p.Parser.start_pos in + let startPos = p.Parser.startPos in Parser.next p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Location.mkloc ident loc | t -> Parser.err p (Diagnostics.uident t); Location.mknoloc "_" in - let body = parse_module_binding_body p in - let loc = mk_loc start_pos p.prev_end_pos in + let body = parseModuleBindingBody p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Mb.mk ~attrs ~loc name body -and parse_module_binding_body p = +and parseModuleBindingBody p = (* TODO: make required with good error message when rec module binding *) - let return_mod_type = + let returnModType = match p.Parser.token with | Colon -> Parser.next p; - Some (parse_module_type p) + Some (parseModuleType p) | _ -> None in Parser.expect Equal p; - let mod_expr = parse_module_expr p in - match return_mod_type with - | Some mod_type -> + let modExpr = parseModuleExpr p in + match returnModType with + | Some modType -> Ast_helper.Mod.constraint_ - ~loc:(mk_loc mod_type.pmty_loc.loc_start mod_expr.pmod_loc.loc_end) - mod_expr mod_type - | None -> mod_expr + ~loc:(mkLoc modType.pmty_loc.loc_start modExpr.pmod_loc.loc_end) + modExpr modType + | None -> modExpr (* module-name : module-type = module-expr * { and module-name : module-type = module-expr } *) -and parse_module_bindings ~attrs ~start_pos p = +and parseModuleBindings ~attrs ~startPos p = let rec loop p acc = - let start_pos = p.Parser.start_pos in - let doc_attr : Parsetree.attributes = + let startPos = p.Parser.startPos in + let docAttr : Parsetree.attributes = match p.Parser.token with | DocComment (loc, s) -> Parser.next p; - [doc_comment_to_attribute loc s] + [docCommentToAttribute loc s] | _ -> [] in - let attrs = doc_attr @ parse_attributes_and_binding p in + let attrs = docAttr @ parseAttributesAndBinding p in match p.Parser.token with | And -> Parser.next p; ignore (Parser.optional p Module); (* over-parse for fault-tolerance *) - let mod_binding = parse_module_binding ~attrs ~start_pos p in - loop p (mod_binding :: acc) + let modBinding = parseModuleBinding ~attrs ~startPos p in + loop p (modBinding :: acc) | _ -> List.rev acc in - let first = parse_module_binding ~attrs ~start_pos p in + let first = parseModuleBinding ~attrs ~startPos p in loop p [first] -and parse_atomic_module_type p = - let start_pos = p.Parser.start_pos in - let module_type = +and parseAtomicModuleType p = + let startPos = p.Parser.startPos in + let moduleType = match p.Parser.token with | Uident _ | Lident _ -> (* Ocaml allows module types to end with lowercase: module Foo : bar = { ... } * lets go with uppercase terminal for now *) - let module_long_ident = parse_module_long_ident ~lowercase:true p in - Ast_helper.Mty.ident ~loc:module_long_ident.loc module_long_ident + let moduleLongIdent = parseModuleLongIdent ~lowercase:true p in + Ast_helper.Mty.ident ~loc:moduleLongIdent.loc moduleLongIdent | Lparen -> Parser.next p; - let mty = parse_module_type p in + let mty = parseModuleType p in Parser.expect Rparen p; - {mty with pmty_loc = mk_loc start_pos p.prev_end_pos} + {mty with pmty_loc = mkLoc startPos p.prevEndPos} | Lbrace -> Parser.next p; let spec = - parse_delimited_region ~grammar:Grammar.Signature ~closing:Rbrace - ~f:parse_signature_item_region p + parseDelimitedRegion ~grammar:Grammar.Signature ~closing:Rbrace + ~f:parseSignatureItemRegion p in Parser.expect Rbrace p; - let loc = mk_loc start_pos p.prev_end_pos in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Mty.signature ~loc spec | Module -> (* TODO: check if this is still atomic when implementing first class modules*) - parse_module_type_of p + parseModuleTypeOf p | Percent -> - let extension = parse_extension p in - let loc = mk_loc start_pos p.prev_end_pos in + let extension = parseExtension p in + let loc = mkLoc startPos p.prevEndPos in Ast_helper.Mty.extension ~loc extension | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Recover.default_module_type () + Recover.defaultModuleType () in - let module_type_loc = mk_loc start_pos p.prev_end_pos in - {module_type with pmty_loc = module_type_loc} + let moduleTypeLoc = mkLoc startPos p.prevEndPos in + {moduleType with pmty_loc = moduleTypeLoc} -and parse_functor_module_type p = - let start_pos = p.Parser.start_pos in - let args = parse_functor_args p in +and parseFunctorModuleType p = + let startPos = p.Parser.startPos in + let args = parseFunctorArgs p in Parser.expect EqualGreater p; - let rhs = parse_module_type p in - let end_pos = p.prev_end_pos in - let mod_type = + let rhs = parseModuleType p in + let endPos = p.prevEndPos in + let modType = List.fold_right - (fun (attrs, name, module_type, start_pos) acc -> - Ast_helper.Mty.functor_ ~loc:(mk_loc start_pos end_pos) ~attrs name - module_type acc) + (fun (attrs, name, moduleType, startPos) acc -> + Ast_helper.Mty.functor_ ~loc:(mkLoc startPos endPos) ~attrs name + moduleType acc) args rhs in - {mod_type with pmty_loc = mk_loc start_pos end_pos} + {modType with pmty_loc = mkLoc startPos endPos} (* Module types are the module-level equivalent of type expressions: they * specify the general shape and type properties of modules. @@ -6196,42 +6129,42 @@ and parse_functor_module_type p = * | module-type with-mod-constraints * | extension *) -and parse_module_type ?(es6_arrow = true) ?(with_ = true) p = - let attrs = parse_attributes p in +and parseModuleType ?(es6Arrow = true) ?(with_ = true) p = + let attrs = parseAttributes p in let modty = - if es6_arrow && is_es6_arrow_functor p then parse_functor_module_type p + if es6Arrow && isEs6ArrowFunctor p then parseFunctorModuleType p else - let modty = parse_atomic_module_type p in + let modty = parseAtomicModuleType p in match p.Parser.token with - | EqualGreater when es6_arrow == true -> + | EqualGreater when es6Arrow == true -> Parser.next p; - let rhs = parse_module_type ~with_:false p in + let rhs = parseModuleType ~with_:false p in let str = Location.mknoloc "_" in - let loc = mk_loc modty.pmty_loc.loc_start p.prev_end_pos in + let loc = mkLoc modty.pmty_loc.loc_start p.prevEndPos in Ast_helper.Mty.functor_ ~loc str (Some modty) rhs | _ -> modty in - let module_type = + let moduleType = {modty with pmty_attributes = List.concat [modty.pmty_attributes; attrs]} in - if with_ then parse_with_constraints module_type p else module_type + if with_ then parseWithConstraints moduleType p else moduleType -and parse_with_constraints module_type p = +and parseWithConstraints moduleType p = match p.Parser.token with | Lident "with" -> Parser.next p; - let first = parse_with_constraint p in + let first = parseWithConstraint p in let rec loop p acc = match p.Parser.token with | And -> Parser.next p; - loop p (parse_with_constraint p :: acc) + loop p (parseWithConstraint p :: acc) | _ -> List.rev acc in let constraints = loop p [first] in - let loc = mk_loc module_type.pmty_loc.loc_start p.prev_end_pos in - Ast_helper.Mty.with_ ~loc module_type constraints - | _ -> module_type + let loc = mkLoc moduleType.pmty_loc.loc_start p.prevEndPos in + Ast_helper.Mty.with_ ~loc moduleType constraints + | _ -> moduleType (* mod-constraint ::= * | type typeconstr type-equation type-constraints? @@ -6240,164 +6173,162 @@ and parse_with_constraints module_type p = * ∣ module module-path := extended-module-path * * TODO: split this up into multiple functions, better errors *) -and parse_with_constraint p = +and parseWithConstraint p = match p.Parser.token with | Module -> ( Parser.next p; - let module_path = parse_module_long_ident ~lowercase:false p in + let modulePath = parseModuleLongIdent ~lowercase:false p in match p.Parser.token with | ColonEqual -> Parser.next p; - let lident = parse_module_long_ident ~lowercase:false p in - Parsetree.Pwith_modsubst (module_path, lident) + let lident = parseModuleLongIdent ~lowercase:false p in + Parsetree.Pwith_modsubst (modulePath, lident) | Equal -> Parser.next p; - let lident = parse_module_long_ident ~lowercase:false p in - Parsetree.Pwith_module (module_path, lident) + let lident = parseModuleLongIdent ~lowercase:false p in + Parsetree.Pwith_module (modulePath, lident) | token -> (* TODO: revisit *) Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - let lident = parse_module_long_ident ~lowercase:false p in - Parsetree.Pwith_modsubst (module_path, lident)) + let lident = parseModuleLongIdent ~lowercase:false p in + Parsetree.Pwith_modsubst (modulePath, lident)) | Typ -> ( Parser.next p; - let type_constr = parse_value_path p in - let params = parse_type_params ~parent:type_constr p in + let typeConstr = parseValuePath p in + let params = parseTypeParams ~parent:typeConstr p in match p.Parser.token with | ColonEqual -> Parser.next p; - let typ_expr = parse_typ_expr p in + let typExpr = parseTypExpr p in Parsetree.Pwith_typesubst - ( type_constr, - Ast_helper.Type.mk ~loc:type_constr.loc ~params ~manifest:typ_expr - (Location.mkloc (Longident.last type_constr.txt) type_constr.loc) ) + ( typeConstr, + Ast_helper.Type.mk ~loc:typeConstr.loc ~params ~manifest:typExpr + (Location.mkloc (Longident.last typeConstr.txt) typeConstr.loc) ) | Equal -> Parser.next p; - let typ_expr = parse_typ_expr p in - let type_constraints = parse_type_constraints p in + let typExpr = parseTypExpr p in + let typeConstraints = parseTypeConstraints p in Parsetree.Pwith_type - ( type_constr, - Ast_helper.Type.mk ~loc:type_constr.loc ~params ~manifest:typ_expr - ~cstrs:type_constraints - (Location.mkloc (Longident.last type_constr.txt) type_constr.loc) ) + ( typeConstr, + Ast_helper.Type.mk ~loc:typeConstr.loc ~params ~manifest:typExpr + ~cstrs:typeConstraints + (Location.mkloc (Longident.last typeConstr.txt) typeConstr.loc) ) | token -> (* TODO: revisit *) Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - let typ_expr = parse_typ_expr p in - let type_constraints = parse_type_constraints p in + let typExpr = parseTypExpr p in + let typeConstraints = parseTypeConstraints p in Parsetree.Pwith_type - ( type_constr, - Ast_helper.Type.mk ~loc:type_constr.loc ~params ~manifest:typ_expr - ~cstrs:type_constraints - (Location.mkloc (Longident.last type_constr.txt) type_constr.loc) )) + ( typeConstr, + Ast_helper.Type.mk ~loc:typeConstr.loc ~params ~manifest:typExpr + ~cstrs:typeConstraints + (Location.mkloc (Longident.last typeConstr.txt) typeConstr.loc) )) | token -> (* TODO: implement recovery strategy *) Parser.err p (Diagnostics.unexpected token p.breadcrumbs); Parsetree.Pwith_type ( Location.mknoloc (Longident.Lident ""), - Ast_helper.Type.mk ~params:[] ~manifest:(Recover.default_type ()) + Ast_helper.Type.mk ~params:[] ~manifest:(Recover.defaultType ()) ~cstrs:[] (Location.mknoloc "") ) -and parse_module_type_of p = - let start_pos = p.Parser.start_pos in +and parseModuleTypeOf p = + let startPos = p.Parser.startPos in Parser.expect Module p; Parser.expect Typ p; Parser.expect Of p; - let module_expr = parse_module_expr p in - Ast_helper.Mty.typeof_ ~loc:(mk_loc start_pos p.prev_end_pos) module_expr + let moduleExpr = parseModuleExpr p in + Ast_helper.Mty.typeof_ ~loc:(mkLoc startPos p.prevEndPos) moduleExpr -and parse_newline_or_semicolon_signature p = +and parseNewlineOrSemicolonSignature p = match p.Parser.token with | Semicolon -> Parser.next p - | token when Grammar.is_signature_item_start token -> - if p.prev_end_pos.pos_lnum < p.start_pos.pos_lnum then () + | token when Grammar.isSignatureItemStart token -> + if p.prevEndPos.pos_lnum < p.startPos.pos_lnum then () else - Parser.err ~start_pos:p.prev_end_pos ~end_pos:p.end_pos p + Parser.err ~startPos:p.prevEndPos ~endPos:p.endPos p (Diagnostics.message "consecutive specifications on a line must be separated by ';' or a \ newline") | _ -> () -and parse_signature_item_region p = - let start_pos = p.Parser.start_pos in - let attrs = parse_attributes p in +and parseSignatureItemRegion p = + let startPos = p.Parser.startPos in + let attrs = parseAttributes p in match p.Parser.token with | Let -> - Parser.begin_region p; - let value_desc = parse_sign_let_desc ~attrs p in - parse_newline_or_semicolon_signature p; - let loc = mk_loc start_pos p.prev_end_pos in - Parser.end_region p; - Some (Ast_helper.Sig.value ~loc value_desc) + Parser.beginRegion p; + let valueDesc = parseSignLetDesc ~attrs p in + parseNewlineOrSemicolonSignature p; + let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; + Some (Ast_helper.Sig.value ~loc valueDesc) | Typ -> ( - Parser.begin_region p; - match parse_type_definition_or_extension ~attrs p with - | TypeDef {rec_flag; types} -> - parse_newline_or_semicolon_signature p; - let loc = mk_loc start_pos p.prev_end_pos in - Parser.end_region p; - Some (Ast_helper.Sig.type_ ~loc rec_flag types) + Parser.beginRegion p; + match parseTypeDefinitionOrExtension ~attrs p with + | TypeDef {recFlag; types} -> + parseNewlineOrSemicolonSignature p; + let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; + Some (Ast_helper.Sig.type_ ~loc recFlag types) | TypeExt ext -> - parse_newline_or_semicolon_signature p; - let loc = mk_loc start_pos p.prev_end_pos in - Parser.end_region p; + parseNewlineOrSemicolonSignature p; + let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; Some (Ast_helper.Sig.type_extension ~loc ext)) | External -> - let external_def = parse_external_def ~attrs ~start_pos p in - parse_newline_or_semicolon_signature p; - let loc = mk_loc start_pos p.prev_end_pos in - Some (Ast_helper.Sig.value ~loc external_def) + let externalDef = parseExternalDef ~attrs ~startPos p in + parseNewlineOrSemicolonSignature p; + let loc = mkLoc startPos p.prevEndPos in + Some (Ast_helper.Sig.value ~loc externalDef) | Exception -> - let exception_def = parse_exception_def ~attrs p in - parse_newline_or_semicolon_signature p; - let loc = mk_loc start_pos p.prev_end_pos in - Some (Ast_helper.Sig.exception_ ~loc exception_def) + let exceptionDef = parseExceptionDef ~attrs p in + parseNewlineOrSemicolonSignature p; + let loc = mkLoc startPos p.prevEndPos in + Some (Ast_helper.Sig.exception_ ~loc exceptionDef) | Open -> - let open_description = parse_open_description ~attrs p in - parse_newline_or_semicolon_signature p; - let loc = mk_loc start_pos p.prev_end_pos in - Some (Ast_helper.Sig.open_ ~loc open_description) + let openDescription = parseOpenDescription ~attrs p in + parseNewlineOrSemicolonSignature p; + let loc = mkLoc startPos p.prevEndPos in + Some (Ast_helper.Sig.open_ ~loc openDescription) | Include -> Parser.next p; - let module_type = parse_module_type p in - let include_description = - Ast_helper.Incl.mk - ~loc:(mk_loc start_pos p.prev_end_pos) - ~attrs module_type + let moduleType = parseModuleType p in + let includeDescription = + Ast_helper.Incl.mk ~loc:(mkLoc startPos p.prevEndPos) ~attrs moduleType in - parse_newline_or_semicolon_signature p; - let loc = mk_loc start_pos p.prev_end_pos in - Some (Ast_helper.Sig.include_ ~loc include_description) + parseNewlineOrSemicolonSignature p; + let loc = mkLoc startPos p.prevEndPos in + Some (Ast_helper.Sig.include_ ~loc includeDescription) | Module -> ( - Parser.begin_region p; + Parser.beginRegion p; Parser.next p; match p.Parser.token with | Uident _ -> - let mod_decl = parse_module_declaration_or_alias ~attrs p in - parse_newline_or_semicolon_signature p; - let loc = mk_loc start_pos p.prev_end_pos in - Parser.end_region p; - Some (Ast_helper.Sig.module_ ~loc mod_decl) + let modDecl = parseModuleDeclarationOrAlias ~attrs p in + parseNewlineOrSemicolonSignature p; + let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; + Some (Ast_helper.Sig.module_ ~loc modDecl) | Rec -> - let rec_module = parse_rec_module_spec ~attrs ~start_pos p in - parse_newline_or_semicolon_signature p; - let loc = mk_loc start_pos p.prev_end_pos in - Parser.end_region p; - Some (Ast_helper.Sig.rec_module ~loc rec_module) + let recModule = parseRecModuleSpec ~attrs ~startPos p in + parseNewlineOrSemicolonSignature p; + let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; + Some (Ast_helper.Sig.rec_module ~loc recModule) | Typ -> - let mod_type_decl = parse_module_type_declaration ~attrs ~start_pos p in - Parser.end_region p; - Some mod_type_decl + let modTypeDecl = parseModuleTypeDeclaration ~attrs ~startPos p in + Parser.endRegion p; + Some modTypeDecl | _t -> - let mod_decl = parse_module_declaration_or_alias ~attrs p in - parse_newline_or_semicolon_signature p; - let loc = mk_loc start_pos p.prev_end_pos in - Parser.end_region p; - Some (Ast_helper.Sig.module_ ~loc mod_decl)) + let modDecl = parseModuleDeclarationOrAlias ~attrs p in + parseNewlineOrSemicolonSignature p; + let loc = mkLoc startPos p.prevEndPos in + Parser.endRegion p; + Some (Ast_helper.Sig.module_ ~loc modDecl)) | AtAt -> - let attr = parse_standalone_attribute p in - parse_newline_or_semicolon_signature p; - let loc = mk_loc start_pos p.prev_end_pos in + let attr = parseStandaloneAttribute p in + parseNewlineOrSemicolonSignature p; + let loc = mkLoc startPos p.prevEndPos in Some (Ast_helper.Sig.attribute ~loc attr) | ModuleComment (loc, s) -> Parser.next p; @@ -6410,25 +6341,25 @@ and parse_signature_item_region p = (Ast_helper.Exp.constant ~loc (Pconst_string (s, None))); ] )) | PercentPercent -> - let extension = parse_extension ~module_language:true p in - parse_newline_or_semicolon_signature p; - let loc = mk_loc start_pos p.prev_end_pos in + let extension = parseExtension ~moduleLanguage:true p in + parseNewlineOrSemicolonSignature p; + let loc = mkLoc startPos p.prevEndPos in Some (Ast_helper.Sig.extension ~attrs ~loc extension) | _ -> ( match attrs with - | (({Asttypes.loc = attr_loc}, _) as attr) :: _ -> - Parser.err ~start_pos:attr_loc.loc_start ~end_pos:attr_loc.loc_end p - (Diagnostics.message (ErrorMessages.attribute_without_node attr)); - Some Recover.default_signature_item + | (({Asttypes.loc = attrLoc}, _) as attr) :: _ -> + Parser.err ~startPos:attrLoc.loc_start ~endPos:attrLoc.loc_end p + (Diagnostics.message (ErrorMessages.attributeWithoutNode attr)); + Some Recover.defaultSignatureItem | _ -> None) -[@@progress Parser.next, Parser.expect, LoopProgress.list_rest] +[@@progress Parser.next, Parser.expect, LoopProgress.listRest] (* module rec module-name : module-type { and module-name: module-type } *) -and parse_rec_module_spec ~attrs ~start_pos p = +and parseRecModuleSpec ~attrs ~startPos p = Parser.expect Rec p; let rec loop p spec = - let start_pos = p.Parser.start_pos in - let attrs = parse_attributes_and_binding p in + let startPos = p.Parser.startPos in + let attrs = parseAttributesAndBinding p in match p.Parser.token with | And -> (* TODO: give a good error message when with constraint, no parens @@ -6438,35 +6369,35 @@ and parse_rec_module_spec ~attrs ~start_pos p = * `with-constraint` *) Parser.expect And p; - let decl = parse_rec_module_declaration ~attrs ~start_pos p in + let decl = parseRecModuleDeclaration ~attrs ~startPos p in loop p (decl :: spec) | _ -> List.rev spec in - let first = parse_rec_module_declaration ~attrs ~start_pos p in + let first = parseRecModuleDeclaration ~attrs ~startPos p in loop p [first] (* module-name : module-type *) -and parse_rec_module_declaration ~attrs ~start_pos p = +and parseRecModuleDeclaration ~attrs ~startPos p = let name = match p.Parser.token with - | Uident mod_name -> - let loc = mk_loc p.start_pos p.end_pos in + | Uident modName -> + let loc = mkLoc p.startPos p.endPos in Parser.next p; - Location.mkloc mod_name loc + Location.mkloc modName loc | t -> Parser.err p (Diagnostics.uident t); Location.mknoloc "_" in Parser.expect Colon p; - let mod_type = parse_module_type p in - Ast_helper.Md.mk ~loc:(mk_loc start_pos p.prev_end_pos) ~attrs name mod_type + let modType = parseModuleType p in + Ast_helper.Md.mk ~loc:(mkLoc startPos p.prevEndPos) ~attrs name modType -and parse_module_declaration_or_alias ~attrs p = - let start_pos = p.Parser.start_pos in - let module_name = +and parseModuleDeclarationOrAlias ~attrs p = + let startPos = p.Parser.startPos in + let moduleName = match p.Parser.token with | Uident ident -> - let loc = mk_loc p.Parser.start_pos p.end_pos in + let loc = mkLoc p.Parser.startPos p.endPos in Parser.next p; Location.mkloc ident loc | t -> @@ -6477,28 +6408,28 @@ and parse_module_declaration_or_alias ~attrs p = match p.Parser.token with | Colon -> Parser.next p; - parse_module_type p + parseModuleType p | Equal -> Parser.next p; - let lident = parse_module_long_ident ~lowercase:false p in + let lident = parseModuleLongIdent ~lowercase:false p in Ast_helper.Mty.alias lident | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Recover.default_module_type () + Recover.defaultModuleType () in - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Md.mk ~loc ~attrs module_name body + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Md.mk ~loc ~attrs moduleName body -and parse_module_type_declaration ~attrs ~start_pos p = +and parseModuleTypeDeclaration ~attrs ~startPos p = Parser.expect Typ p; - let module_name = + let moduleName = match p.Parser.token with | Uident ident -> - let loc = mk_loc p.start_pos p.end_pos in + let loc = mkLoc p.startPos p.endPos in Parser.next p; Location.mkloc ident loc | Lident ident -> - let loc = mk_loc p.start_pos p.end_pos in + let loc = mkLoc p.startPos p.endPos in Parser.next p; Location.mkloc ident loc | t -> @@ -6509,26 +6440,26 @@ and parse_module_type_declaration ~attrs ~start_pos p = match p.Parser.token with | Equal -> Parser.next p; - Some (parse_module_type p) + Some (parseModuleType p) | _ -> None in - let module_decl = Ast_helper.Mtd.mk ~attrs ?typ module_name in - Ast_helper.Sig.modtype ~loc:(mk_loc start_pos p.prev_end_pos) module_decl + let moduleDecl = Ast_helper.Mtd.mk ~attrs ?typ moduleName in + Ast_helper.Sig.modtype ~loc:(mkLoc startPos p.prevEndPos) moduleDecl -and parse_sign_let_desc ~attrs p = - let start_pos = p.Parser.start_pos in +and parseSignLetDesc ~attrs p = + let startPos = p.Parser.startPos in Parser.optional p Let |> ignore; - let name, loc = parse_lident p in + let name, loc = parseLident p in let name = Location.mkloc name loc in Parser.expect Colon p; - let typ_expr = parse_poly_type_expr p in - let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Val.mk ~loc ~attrs name typ_expr + let typExpr = parsePolyTypeExpr p in + let loc = mkLoc startPos p.prevEndPos in + Ast_helper.Val.mk ~loc ~attrs name typExpr (* attr-id ::= lowercase-ident ∣ capitalized-ident ∣ attr-id . attr-id *) -and parse_attribute_id ~start_pos p = +and parseAttributeId ~startPos p = let rec loop p acc = match p.Parser.token with | Lident ident | Uident ident -> ( @@ -6539,9 +6470,9 @@ and parse_attribute_id ~start_pos p = Parser.next p; loop p (id ^ ".") | _ -> id) - | token when Token.is_keyword token -> ( + | token when Token.isKeyword token -> ( Parser.next p; - let id = acc ^ Token.to_string token in + let id = acc ^ Token.toString token in match p.Parser.token with | Dot -> Parser.next p; @@ -6552,8 +6483,8 @@ and parse_attribute_id ~start_pos p = acc in let id = loop p "" in - let end_pos = p.prev_end_pos in - Location.mkloc id (mk_loc start_pos end_pos) + let endPos = p.prevEndPos in + Location.mkloc id (mkLoc startPos endPos) (* * payload ::= empty @@ -6565,62 +6496,62 @@ and parse_attribute_id ~start_pos p = * Also what about type-expressions and specifications? * @attr(:myType) ??? *) -and parse_payload p = +and parsePayload p = match p.Parser.token with - | Lparen when p.start_pos.pos_cnum = p.prev_end_pos.pos_cnum -> ( - Parser.leave_breadcrumb p Grammar.AttributePayload; + | Lparen when p.startPos.pos_cnum = p.prevEndPos.pos_cnum -> ( + Parser.leaveBreadcrumb p Grammar.AttributePayload; Parser.next p; match p.token with | Colon -> Parser.next p; let payload = - if Grammar.is_signature_item_start p.token then + if Grammar.isSignatureItemStart p.token then Parsetree.PSig - (parse_delimited_region ~grammar:Grammar.Signature ~closing:Rparen - ~f:parse_signature_item_region p) - else Parsetree.PTyp (parse_typ_expr p) + (parseDelimitedRegion ~grammar:Grammar.Signature ~closing:Rparen + ~f:parseSignatureItemRegion p) + else Parsetree.PTyp (parseTypExpr p) in Parser.expect Rparen p; - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; payload | Question -> Parser.next p; - let pattern = parse_pattern p in + let pattern = parsePattern p in let expr = match p.token with | When | If -> Parser.next p; - Some (parse_expr p) + Some (parseExpr p) | _ -> None in Parser.expect Rparen p; - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; Parsetree.PPat (pattern, expr) | _ -> let items = - parse_delimited_region ~grammar:Grammar.Structure ~closing:Rparen - ~f:parse_structure_item_region p + parseDelimitedRegion ~grammar:Grammar.Structure ~closing:Rparen + ~f:parseStructureItemRegion p in Parser.expect Rparen p; - Parser.eat_breadcrumb p; + Parser.eatBreadcrumb p; Parsetree.PStr items) | _ -> Parsetree.PStr [] (* type attribute = string loc * payload *) -and parse_attribute p = +and parseAttribute p = match p.Parser.token with | At -> - let start_pos = p.start_pos in + let startPos = p.startPos in Parser.next p; - let attr_id = parse_attribute_id ~start_pos p in - let payload = parse_payload p in - Some (attr_id, payload) + let attrId = parseAttributeId ~startPos p in + let payload = parsePayload p in + Some (attrId, payload) | DocComment (loc, s) -> Parser.next p; - Some (doc_comment_to_attribute loc s) + Some (docCommentToAttribute loc s) | _ -> None -and doc_comment_to_attribute loc s : Parsetree.attribute = +and docCommentToAttribute loc s : Parsetree.attribute = ( {txt = "res.doc"; loc}, PStr [ @@ -6628,30 +6559,30 @@ and doc_comment_to_attribute loc s : Parsetree.attribute = (Ast_helper.Exp.constant ~loc (Pconst_string (s, None))); ] ) -and parse_attributes p = - parse_region p ~grammar:Grammar.Attribute ~f:parse_attribute +and parseAttributes p = + parseRegion p ~grammar:Grammar.Attribute ~f:parseAttribute (* * standalone-attribute ::= * | @@ atribute-id * | @@ attribute-id ( structure-item ) *) -and parse_standalone_attribute p = - let start_pos = p.start_pos in +and parseStandaloneAttribute p = + let startPos = p.startPos in Parser.expect AtAt p; - let attr_id = parse_attribute_id ~start_pos p in - let attr_id = - match attr_id.txt with + let attrId = parseAttributeId ~startPos p in + let attrId = + match attrId.txt with | "uncurried.swap" -> p.uncurried_config <- Config.Swap; - attr_id + attrId | "uncurried" -> p.uncurried_config <- Config.Uncurried; - attr_id - | _ -> attr_id + attrId + | _ -> attrId in - let payload = parse_payload p in - (attr_id, payload) + let payload = parsePayload p in + (attrId, payload) (* extension ::= % attr-id attr-payload * | %% attr-id( @@ -6686,18 +6617,18 @@ and parse_standalone_attribute p = * * ~moduleLanguage represents whether we're on the module level or not *) -and parse_extension ?(module_language = false) p = - let start_pos = p.Parser.start_pos in - if module_language then Parser.expect PercentPercent p +and parseExtension ?(moduleLanguage = false) p = + let startPos = p.Parser.startPos in + if moduleLanguage then Parser.expect PercentPercent p else Parser.expect Percent p; - let attr_id = parse_attribute_id ~start_pos p in - let payload = parse_payload p in - (attr_id, payload) + let attrId = parseAttributeId ~startPos p in + let payload = parsePayload p in + (attrId, payload) (* module signature on the file level *) -let parse_specification p : Parsetree.signature = - parse_region p ~grammar:Grammar.Specification ~f:parse_signature_item_region +let parseSpecification p : Parsetree.signature = + parseRegion p ~grammar:Grammar.Specification ~f:parseSignatureItemRegion (* module structure on the file level *) -let parse_implementation p : Parsetree.structure = - parse_region p ~grammar:Grammar.Implementation ~f:parse_structure_item_region +let parseImplementation p : Parsetree.structure = + parseRegion p ~grammar:Grammar.Implementation ~f:parseStructureItemRegion diff --git a/analysis/vendor/res_syntax/res_core.mli b/analysis/vendor/res_syntax/res_core.mli index 30d1e5f5e..e77ca30bb 100644 --- a/analysis/vendor/res_syntax/res_core.mli +++ b/analysis/vendor/res_syntax/res_core.mli @@ -1,2 +1,2 @@ -val parse_implementation : Res_parser.t -> Parsetree.structure -val parse_specification : Res_parser.t -> Parsetree.signature +val parseImplementation : Res_parser.t -> Parsetree.structure +val parseSpecification : Res_parser.t -> Parsetree.signature diff --git a/analysis/vendor/res_syntax/res_diagnostics.ml b/analysis/vendor/res_syntax/res_diagnostics.ml index 7df65840b..3b1da1521 100644 --- a/analysis/vendor/res_syntax/res_diagnostics.ml +++ b/analysis/vendor/res_syntax/res_diagnostics.ml @@ -17,45 +17,45 @@ type category = | UnknownUchar of Char.t type t = { - start_pos: Lexing.position; - end_pos: Lexing.position; + startPos: Lexing.position; + endPos: Lexing.position; category: category; } type report = t list -let get_start_pos t = t.start_pos -let get_end_pos t = t.end_pos +let getStartPos t = t.startPos +let getEndPos t = t.endPos -let default_unexpected token = - "I'm not sure what to parse here when looking at \"" ^ Token.to_string token +let defaultUnexpected token = + "I'm not sure what to parse here when looking at \"" ^ Token.toString token ^ "\"." -let reserved_keyword token = - let token_txt = Token.to_string token in - "`" ^ token_txt ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" - ^ token_txt ^ "\"" +let reservedKeyword token = + let tokenTxt = Token.toString token in + "`" ^ tokenTxt ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" + ^ tokenTxt ^ "\"" let explain t = match t.category with - | Uident current_token -> ( - match current_token with + | Uident currentToken -> ( + match currentToken with | Lident lident -> let guess = String.capitalize_ascii lident in "Did you mean `" ^ guess ^ "` instead of `" ^ lident ^ "`?" - | t when Token.is_keyword t -> - let token = Token.to_string t in + | t when Token.isKeyword t -> + let token = Token.toString t in "`" ^ token ^ "` is a reserved keyword." | _ -> "At this point, I'm looking for an uppercased name like `Belt` or `Array`" ) - | Lident current_token -> ( - match current_token with + | Lident currentToken -> ( + match currentToken with | Uident uident -> let guess = String.uncapitalize_ascii uident in "Did you mean `" ^ guess ^ "` instead of `" ^ uident ^ "`?" - | t when Token.is_keyword t -> - let token = Token.to_string t in + | t when Token.isKeyword t -> + let token = Token.toString t in "`" ^ token ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" ^ token ^ "\"" | Underscore -> "`_` isn't a valid name." @@ -76,21 +76,21 @@ let explain t = | Expected {context; token = t} -> let hint = match context with - | Some grammar -> " It signals the start of " ^ Grammar.to_string grammar + | Some grammar -> " It signals the start of " ^ Grammar.toString grammar | None -> "" in - "Did you forget a `" ^ Token.to_string t ^ "` here?" ^ hint + "Did you forget a `" ^ Token.toString t ^ "` here?" ^ hint | Unexpected {token = t; context = breadcrumbs} -> ( - let name = Token.to_string t in + let name = Token.toString t in match breadcrumbs with | (AtomicTypExpr, _) :: breadcrumbs -> ( match (breadcrumbs, t) with | ( ((StringFieldDeclarations | FieldDeclarations), _) :: _, (String _ | At | Rbrace | Comma | Eof) ) -> "I'm missing a type here" - | _, t when Grammar.is_structure_item_start t || t = Eof -> + | _, t when Grammar.isStructureItemStart t || t = Eof -> "Missing a type here" - | _ -> default_unexpected t) + | _ -> defaultUnexpected t) | (ExprOperand, _) :: breadcrumbs -> ( match (breadcrumbs, t) with | (ExprBlock, _) :: _, Rbrace -> @@ -125,19 +125,19 @@ let explain t = to supply a name before `in`?" | EqualGreater, (PatternMatchCase, _) :: _ -> "I was expecting a pattern to match on before the `=>`" - | token, _ when Token.is_keyword t -> reserved_keyword token - | token, _ -> default_unexpected token) + | token, _ when Token.isKeyword t -> reservedKeyword token + | token, _ -> defaultUnexpected token) | _ -> (* TODO: match on circumstance to verify Lident needed ? *) - if Token.is_keyword t then + if Token.isKeyword t then "`" ^ name ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" - ^ Token.to_string t ^ "\"" + ^ Token.toString t ^ "\"" else "I'm not sure what to parse here when looking at \"" ^ name ^ "\".") -let make ~start_pos ~end_pos category = {start_pos; end_pos; category} +let make ~startPos ~endPos category = {startPos; endPos; category} -let print_report diagnostics src = +let printReport diagnostics src = let rec print diagnostics src = match diagnostics with | [] -> () @@ -145,8 +145,7 @@ let print_report diagnostics src = Location.report_error ~src:(Some src) Format.err_formatter Location. { - loc = - {loc_start = d.start_pos; loc_end = d.end_pos; loc_ghost = false}; + loc = {loc_start = d.startPos; loc_end = d.endPos; loc_ghost = false}; msg = explain d; sub = []; if_highlight = ""; @@ -164,10 +163,10 @@ let unexpected token context = Unexpected {token; context} let expected ?grammar pos token = Expected {context = grammar; pos; token} -let uident current_token = Uident current_token -let lident current_token = Lident current_token -let unclosed_string = UnclosedString -let unclosed_comment = UnclosedComment -let unclosed_template = UnclosedTemplate -let unknown_uchar code = UnknownUchar code +let uident currentToken = Uident currentToken +let lident currentToken = Lident currentToken +let unclosedString = UnclosedString +let unclosedComment = UnclosedComment +let unclosedTemplate = UnclosedTemplate +let unknownUchar code = UnknownUchar code let message txt = Message txt diff --git a/analysis/vendor/res_syntax/res_diagnostics.mli b/analysis/vendor/res_syntax/res_diagnostics.mli index 4fd915566..0ae74cec2 100644 --- a/analysis/vendor/res_syntax/res_diagnostics.mli +++ b/analysis/vendor/res_syntax/res_diagnostics.mli @@ -5,8 +5,8 @@ type t type category type report -val get_start_pos : t -> Lexing.position [@@live] (* for playground *) -val get_end_pos : t -> Lexing.position [@@live] (* for playground *) +val getStartPos : t -> Lexing.position [@@live] (* for playground *) +val getEndPos : t -> Lexing.position [@@live] (* for playground *) val explain : t -> string [@@live] (* for playground *) @@ -14,12 +14,12 @@ val unexpected : Token.t -> (Grammar.t * Lexing.position) list -> category val expected : ?grammar:Grammar.t -> Lexing.position -> Token.t -> category val uident : Token.t -> category val lident : Token.t -> category -val unclosed_string : category -val unclosed_template : category -val unclosed_comment : category -val unknown_uchar : Char.t -> category +val unclosedString : category +val unclosedTemplate : category +val unclosedComment : category +val unknownUchar : Char.t -> category val message : string -> category -val make : start_pos:Lexing.position -> end_pos:Lexing.position -> category -> t +val make : startPos:Lexing.position -> endPos:Lexing.position -> category -> t -val print_report : t list -> string -> unit +val printReport : t list -> string -> unit diff --git a/analysis/vendor/res_syntax/res_doc.ml b/analysis/vendor/res_syntax/res_doc.ml index 301c0520b..fe626e479 100644 --- a/analysis/vendor/res_syntax/res_doc.ml +++ b/analysis/vendor/res_syntax/res_doc.ml @@ -2,7 +2,7 @@ module MiniBuffer = Res_minibuffer type mode = Break | Flat -type line_style = +type lineStyle = | Classic (* fits? -> replace with space *) | Soft (* fits? -> replaced with nothing *) | Hard @@ -19,16 +19,16 @@ type t = | IfBreaks of {yes: t; no: t; mutable broken: bool} (* when broken is true, treat as the yes branch *) | LineSuffix of t - | LineBreak of line_style - | Group of {mutable should_break: bool; doc: t} + | LineBreak of lineStyle + | Group of {mutable shouldBreak: bool; doc: t} | CustomLayout of t list | BreakParent let nil = Nil let line = LineBreak Classic -let hard_line = LineBreak Hard -let soft_line = LineBreak Soft -let literal_line = LineBreak Literal +let hardLine = LineBreak Hard +let softLine = LineBreak Soft +let literalLine = LineBreak Literal let text s = Text s (* Optimization. We eagerly collapse and reduce whatever allocation we can *) @@ -46,20 +46,20 @@ let rec _concat acc l = let concat l = Concat (_concat [] l) let indent d = Indent d -let if_breaks t f = IfBreaks {yes = t; no = f; broken = false} -let line_suffix d = LineSuffix d -let group d = Group {should_break = false; doc = d} -let breakable_group ~force_break d = Group {should_break = force_break; doc = d} -let custom_layout gs = CustomLayout gs -let break_parent = BreakParent +let ifBreaks t f = IfBreaks {yes = t; no = f; broken = false} +let lineSuffix d = LineSuffix d +let group d = Group {shouldBreak = false; doc = d} +let breakableGroup ~forceBreak d = Group {shouldBreak = forceBreak; doc = d} +let customLayout gs = CustomLayout gs +let breakParent = BreakParent let space = Text " " let comma = Text "," let dot = Text "." let dotdot = Text ".." let dotdotdot = Text "..." -let less_than = Text "<" -let greater_than = Text ">" +let lessThan = Text "<" +let greaterThan = Text ">" let lbrace = Text "{" let rbrace = Text "}" let lparen = Text "(" @@ -69,10 +69,10 @@ let rbracket = Text "]" let question = Text "?" let tilde = Text "~" let equal = Text "=" -let trailing_comma = if_breaks comma nil -let double_quote = Text "\"" +let trailingComma = ifBreaks comma nil +let doubleQuote = Text "\"" -let propagate_forced_breaks doc = +let propagateForcedBreaks doc = let rec walk doc = match doc with | Text _ | Nil | LineSuffix _ -> false @@ -80,27 +80,27 @@ let propagate_forced_breaks doc = | LineBreak (Hard | Literal) -> true | LineBreak (Classic | Soft) -> false | Indent children -> - let child_forces_break = walk children in - child_forces_break - | IfBreaks ({yes = true_doc; no = false_doc} as ib) -> - let false_force_break = walk false_doc in - if false_force_break then ( - let _ = walk true_doc in + let childForcesBreak = walk children in + childForcesBreak + | IfBreaks ({yes = trueDoc; no = falseDoc} as ib) -> + let falseForceBreak = walk falseDoc in + if falseForceBreak then ( + let _ = walk trueDoc in ib.broken <- true; true) else - let force_break = walk true_doc in - force_break - | Group ({should_break = force_break; doc = children} as gr) -> - let child_forces_break = walk children in - let should_break = force_break || child_forces_break in - gr.should_break <- should_break; - should_break + let forceBreak = walk trueDoc in + forceBreak + | Group ({shouldBreak = forceBreak; doc = children} as gr) -> + let childForcesBreak = walk children in + let shouldBreak = forceBreak || childForcesBreak in + gr.shouldBreak <- shouldBreak; + shouldBreak | Concat children -> List.fold_left - (fun force_break child -> - let child_forces_break = walk child in - force_break || child_forces_break) + (fun forceBreak child -> + let childForcesBreak = walk child in + forceBreak || childForcesBreak) false children | CustomLayout children -> (* When using CustomLayout, we don't want to propagate forced breaks @@ -115,13 +115,13 @@ let propagate_forced_breaks doc = () (* See documentation in interface file *) -let rec will_break doc = +let rec willBreak doc = match doc with - | LineBreak (Hard | Literal) | BreakParent | Group {should_break = true} -> + | LineBreak (Hard | Literal) | BreakParent | Group {shouldBreak = true} -> true - | Group {doc} | Indent doc | CustomLayout (doc :: _) -> will_break doc - | Concat docs -> List.exists will_break docs - | IfBreaks {yes; no} -> will_break yes || will_break no + | Group {doc} | Indent doc | CustomLayout (doc :: _) -> willBreak doc + | Concat docs -> List.exists willBreak docs + | IfBreaks {yes; no} -> willBreak yes || willBreak no | _ -> false let join ~sep docs = @@ -133,14 +133,14 @@ let join ~sep docs = in concat (loop [] sep docs) -let join_with_sep docs_with_sep = +let joinWithSep docsWithSep = let rec loop acc docs = match docs with | [] -> List.rev acc | [(x, _sep)] -> List.rev (x :: acc) | (x, sep) :: xs -> loop (sep :: x :: acc) xs in - concat (loop [] docs_with_sep) + concat (loop [] docsWithSep) let fits w stack = let width = ref w in @@ -157,63 +157,63 @@ let fits w stack = | Flat, LineBreak Classic -> width := width.contents - 1 | Flat, LineBreak Soft -> () | Break, LineBreak _ -> result := Some true - | _, Group {should_break = true; doc} -> calculate indent Break doc + | _, Group {shouldBreak = true; doc} -> calculate indent Break doc | _, Group {doc} -> calculate indent mode doc - | _, IfBreaks {yes = break_doc; broken = true} -> - calculate indent mode break_doc - | Break, IfBreaks {yes = break_doc} -> calculate indent mode break_doc - | Flat, IfBreaks {no = flat_doc} -> calculate indent mode flat_doc - | _, Concat docs -> calculate_concat indent mode docs + | _, IfBreaks {yes = breakDoc; broken = true} -> + calculate indent mode breakDoc + | Break, IfBreaks {yes = breakDoc} -> calculate indent mode breakDoc + | Flat, IfBreaks {no = flatDoc} -> calculate indent mode flatDoc + | _, Concat docs -> calculateConcat indent mode docs | _, CustomLayout (hd :: _) -> (* TODO: if we have nested custom layouts, what we should do here? *) calculate indent mode hd | _, CustomLayout [] -> () - and calculate_concat indent mode docs = + and calculateConcat indent mode docs = if result.contents == None then match docs with | [] -> () | doc :: rest -> calculate indent mode doc; - calculate_concat indent mode rest + calculateConcat indent mode rest in - let rec calculate_all stack = + let rec calculateAll stack = match (result.contents, stack) with | Some r, _ -> r | None, [] -> !width >= 0 | None, (indent, mode, doc) :: rest -> calculate indent mode doc; - calculate_all rest + calculateAll rest in - calculate_all stack + calculateAll stack -let to_string ~width doc = - propagate_forced_breaks doc; +let toString ~width doc = + propagateForcedBreaks doc; let buffer = MiniBuffer.create 1000 in - let rec process ~pos line_suffices stack = + let rec process ~pos lineSuffices stack = match stack with | ((ind, mode, doc) as cmd) :: rest -> ( match doc with - | Nil | BreakParent -> process ~pos line_suffices rest + | Nil | BreakParent -> process ~pos lineSuffices rest | Text txt -> MiniBuffer.add_string buffer txt; - process ~pos:(String.length txt + pos) line_suffices rest - | LineSuffix doc -> process ~pos ((ind, mode, doc) :: line_suffices) rest + process ~pos:(String.length txt + pos) lineSuffices rest + | LineSuffix doc -> process ~pos ((ind, mode, doc) :: lineSuffices) rest | Concat docs -> let ops = List.map (fun doc -> (ind, mode, doc)) docs in - process ~pos line_suffices (List.append ops rest) - | Indent doc -> process ~pos line_suffices ((ind + 2, mode, doc) :: rest) - | IfBreaks {yes = break_doc; broken = true} -> - process ~pos line_suffices ((ind, mode, break_doc) :: rest) - | IfBreaks {yes = break_doc; no = flat_doc} -> + process ~pos lineSuffices (List.append ops rest) + | Indent doc -> process ~pos lineSuffices ((ind + 2, mode, doc) :: rest) + | IfBreaks {yes = breakDoc; broken = true} -> + process ~pos lineSuffices ((ind, mode, breakDoc) :: rest) + | IfBreaks {yes = breakDoc; no = flatDoc} -> if mode = Break then - process ~pos line_suffices ((ind, mode, break_doc) :: rest) - else process ~pos line_suffices ((ind, mode, flat_doc) :: rest) - | LineBreak line_style -> + process ~pos lineSuffices ((ind, mode, breakDoc) :: rest) + else process ~pos lineSuffices ((ind, mode, flatDoc) :: rest) + | LineBreak lineStyle -> if mode = Break then - match line_suffices with + match lineSuffices with | [] -> - if line_style = Literal then ( + if lineStyle = Literal then ( MiniBuffer.add_char buffer '\n'; process ~pos:0 [] rest) else ( @@ -222,11 +222,11 @@ let to_string ~width doc = process ~pos:ind [] rest) | _docs -> process ~pos:ind [] - (List.concat [List.rev line_suffices; cmd :: rest]) + (List.concat [List.rev lineSuffices; cmd :: rest]) else (* mode = Flat *) let pos = - match line_style with + match lineStyle with | Classic -> MiniBuffer.add_string buffer " "; pos + 1 @@ -238,24 +238,24 @@ let to_string ~width doc = 0 | Soft -> pos in - process ~pos line_suffices rest - | Group {should_break; doc} -> - if should_break || not (fits (width - pos) ((ind, Flat, doc) :: rest)) - then process ~pos line_suffices ((ind, Break, doc) :: rest) - else process ~pos line_suffices ((ind, Flat, doc) :: rest) + process ~pos lineSuffices rest + | Group {shouldBreak; doc} -> + if shouldBreak || not (fits (width - pos) ((ind, Flat, doc) :: rest)) + then process ~pos lineSuffices ((ind, Break, doc) :: rest) + else process ~pos lineSuffices ((ind, Flat, doc) :: rest) | CustomLayout docs -> - let rec find_group_that_fits groups = + let rec findGroupThatFits groups = match groups with | [] -> Nil - | [last_group] -> last_group + | [lastGroup] -> lastGroup | doc :: docs -> if fits (width - pos) ((ind, Flat, doc) :: rest) then doc - else find_group_that_fits docs + else findGroupThatFits docs in - let doc = find_group_that_fits docs in - process ~pos line_suffices ((ind, Flat, doc) :: rest)) + let doc = findGroupThatFits docs in + process ~pos lineSuffices ((ind, Flat, doc) :: rest)) | [] -> ( - match line_suffices with + match lineSuffices with | [] -> () | suffices -> process ~pos:0 [] (List.rev suffices)) in @@ -263,7 +263,7 @@ let to_string ~width doc = MiniBuffer.contents buffer let debug t = - let rec to_doc = function + let rec toDoc = function | Nil -> text "nil" | BreakParent -> text "breakparent" | Text txt -> text ("text(\"" ^ txt ^ "\")") @@ -272,7 +272,7 @@ let debug t = (concat [ text "linesuffix("; - indent (concat [line; to_doc doc]); + indent (concat [line; toDoc doc]); line; text ")"; ]) @@ -286,7 +286,7 @@ let debug t = (concat [ line; - join ~sep:(concat [text ","; line]) (List.map to_doc docs); + join ~sep:(concat [text ","; line]) (List.map toDoc docs); ]); line; text ")"; @@ -300,40 +300,35 @@ let debug t = (concat [ line; - join ~sep:(concat [text ","; line]) (List.map to_doc docs); + join ~sep:(concat [text ","; line]) (List.map toDoc docs); ]); line; text ")"; ]) | Indent doc -> - concat [text "indent("; soft_line; to_doc doc; soft_line; text ")"] - | IfBreaks {yes = true_doc; broken = true} -> to_doc true_doc - | IfBreaks {yes = true_doc; no = false_doc} -> + concat [text "indent("; softLine; toDoc doc; softLine; text ")"] + | IfBreaks {yes = trueDoc; broken = true} -> toDoc trueDoc + | IfBreaks {yes = trueDoc; no = falseDoc} -> group (concat [ text "ifBreaks("; indent (concat - [ - line; - to_doc true_doc; - concat [text ","; line]; - to_doc false_doc; - ]); + [line; toDoc trueDoc; concat [text ","; line]; toDoc falseDoc]); line; text ")"; ]) | LineBreak break -> - let break_txt = + let breakTxt = match break with | Classic -> "Classic" | Soft -> "Soft" | Hard -> "Hard" | Literal -> "Liteal" in - text ("LineBreak(" ^ break_txt ^ ")") - | Group {should_break; doc} -> + text ("LineBreak(" ^ breakTxt ^ ")") + | Group {shouldBreak; doc} -> group (concat [ @@ -342,14 +337,14 @@ let debug t = (concat [ line; - text ("{shouldBreak: " ^ string_of_bool should_break ^ "}"); + text ("{shouldBreak: " ^ string_of_bool shouldBreak ^ "}"); concat [text ","; line]; - to_doc doc; + toDoc doc; ]); line; text ")"; ]) in - let doc = to_doc t in - to_string ~width:10 doc |> print_endline + let doc = toDoc t in + toString ~width:10 doc |> print_endline [@@live] diff --git a/analysis/vendor/res_syntax/res_doc.mli b/analysis/vendor/res_syntax/res_doc.mli index 763c20220..f1a0c6ea6 100644 --- a/analysis/vendor/res_syntax/res_doc.mli +++ b/analysis/vendor/res_syntax/res_doc.mli @@ -2,34 +2,34 @@ type t val nil : t val line : t -val hard_line : t -val soft_line : t -val literal_line : t +val hardLine : t +val softLine : t +val literalLine : t val text : string -> t val concat : t list -> t val indent : t -> t -val if_breaks : t -> t -> t -val line_suffix : t -> t +val ifBreaks : t -> t -> t +val lineSuffix : t -> t val group : t -> t -val breakable_group : force_break:bool -> t -> t +val breakableGroup : forceBreak:bool -> t -> t (* `customLayout docs` will pick the layout that fits from `docs`. * This is a very expensive computation as every layout from the list * will be checked until one fits. *) -val custom_layout : t list -> t -val break_parent : t +val customLayout : t list -> t +val breakParent : t val join : sep:t -> t list -> t (* [(doc1, sep1); (doc2,sep2)] joins as doc1 sep1 doc2 *) -val join_with_sep : (t * t) list -> t +val joinWithSep : (t * t) list -> t val space : t val comma : t val dot : t val dotdot : t val dotdotdot : t -val less_than : t -val greater_than : t +val lessThan : t +val greaterThan : t val lbrace : t val rbrace : t val lparen : t @@ -39,8 +39,8 @@ val rbracket : t val question : t val tilde : t val equal : t -val trailing_comma : t -val double_quote : t [@@live] +val trailingComma : t +val doubleQuote : t [@@live] (* * `willBreak doc` checks whether `doc` contains forced line breaks. @@ -61,7 +61,7 @@ val double_quote : t [@@live] * The consumer can then manually insert a `breakParent` doc, to manually propagate the * force breaks from bottom to top. *) -val will_break : t -> bool +val willBreak : t -> bool -val to_string : width:int -> t -> string +val toString : width:int -> t -> string val debug : t -> unit [@@live] diff --git a/analysis/vendor/res_syntax/res_driver.ml b/analysis/vendor/res_syntax/res_driver.ml index 64039e765..a82c9a2a1 100644 --- a/analysis/vendor/res_syntax/res_driver.ml +++ b/analysis/vendor/res_syntax/res_driver.ml @@ -1,6 +1,6 @@ module IO = Res_io -type ('ast, 'diagnostics) parse_result = { +type ('ast, 'diagnostics) parseResult = { filename: string; [@live] source: string; parsetree: 'ast; @@ -9,27 +9,26 @@ type ('ast, 'diagnostics) parse_result = { comments: Res_comment.t list; } -type 'diagnostics parsing_engine = { - parse_implementation: - for_printer:bool -> +type 'diagnostics parsingEngine = { + parseImplementation: + forPrinter:bool -> filename:string -> - (Parsetree.structure, 'diagnostics) parse_result; - parse_interface: - for_printer:bool -> + (Parsetree.structure, 'diagnostics) parseResult; + parseInterface: + forPrinter:bool -> filename:string -> - (Parsetree.signature, 'diagnostics) parse_result; - string_of_diagnostics: - source:string -> filename:string -> 'diagnostics -> unit; + (Parsetree.signature, 'diagnostics) parseResult; + stringOfDiagnostics: source:string -> filename:string -> 'diagnostics -> unit; } -type print_engine = { - print_implementation: +type printEngine = { + printImplementation: width:int -> filename:string -> comments:Res_comment.t list -> Parsetree.structure -> unit; - print_interface: + printInterface: width:int -> filename:string -> comments:Res_comment.t list -> @@ -37,21 +36,21 @@ type print_engine = { unit; } -let setup ~filename ~for_printer () = - let src = IO.read_file ~filename in - let mode = if for_printer then Res_parser.Default else ParseForTypeChecker in +let setup ~filename ~forPrinter () = + let src = IO.readFile ~filename in + let mode = if forPrinter then Res_parser.Default else ParseForTypeChecker in Res_parser.make ~mode src filename -let setup_from_source ~display_filename ~source ~for_printer () = - let mode = if for_printer then Res_parser.Default else ParseForTypeChecker in - Res_parser.make ~mode source display_filename +let setupFromSource ~displayFilename ~source ~forPrinter () = + let mode = if forPrinter then Res_parser.Default else ParseForTypeChecker in + Res_parser.make ~mode source displayFilename -let parsing_engine = +let parsingEngine = { - parse_implementation = - (fun ~for_printer ~filename -> - let engine = setup ~filename ~for_printer () in - let structure = Res_core.parse_implementation engine in + parseImplementation = + (fun ~forPrinter ~filename -> + let engine = setup ~filename ~forPrinter () in + let structure = Res_core.parseImplementation engine in let invalid, diagnostics = match engine.diagnostics with | [] as diagnostics -> (false, diagnostics) @@ -65,10 +64,10 @@ let parsing_engine = invalid; comments = List.rev engine.comments; }); - parse_interface = - (fun ~for_printer ~filename -> - let engine = setup ~filename ~for_printer () in - let signature = Res_core.parse_specification engine in + parseInterface = + (fun ~forPrinter ~filename -> + let engine = setup ~filename ~forPrinter () in + let signature = Res_core.parseSpecification engine in let invalid, diagnostics = match engine.diagnostics with | [] as diagnostics -> (false, diagnostics) @@ -82,14 +81,14 @@ let parsing_engine = invalid; comments = List.rev engine.comments; }); - string_of_diagnostics = + stringOfDiagnostics = (fun ~source ~filename:_ diagnostics -> - Res_diagnostics.print_report diagnostics source); + Res_diagnostics.printReport diagnostics source); } -let parse_implementation_from_source ~for_printer ~display_filename ~source = - let engine = setup_from_source ~display_filename ~source ~for_printer () in - let structure = Res_core.parse_implementation engine in +let parseImplementationFromSource ~forPrinter ~displayFilename ~source = + let engine = setupFromSource ~displayFilename ~source ~forPrinter () in + let structure = Res_core.parseImplementation engine in let invalid, diagnostics = match engine.diagnostics with | [] as diagnostics -> (false, diagnostics) @@ -104,9 +103,9 @@ let parse_implementation_from_source ~for_printer ~display_filename ~source = comments = List.rev engine.comments; } -let parse_interface_from_source ~for_printer ~display_filename ~source = - let engine = setup_from_source ~display_filename ~source ~for_printer () in - let signature = Res_core.parse_specification engine in +let parseInterfaceFromSource ~forPrinter ~displayFilename ~source = + let engine = setupFromSource ~displayFilename ~source ~forPrinter () in + let signature = Res_core.parseSpecification engine in let invalid, diagnostics = match engine.diagnostics with | [] as diagnostics -> (false, diagnostics) @@ -121,42 +120,42 @@ let parse_interface_from_source ~for_printer ~display_filename ~source = comments = List.rev engine.comments; } -let print_engine = +let printEngine = { - print_implementation = + printImplementation = (fun ~width ~filename:_ ~comments structure -> print_string - (Res_printer.print_implementation ~width structure ~comments)); - print_interface = + (Res_printer.printImplementation ~width structure ~comments)); + printInterface = (fun ~width ~filename:_ ~comments signature -> - print_string (Res_printer.print_interface ~width signature ~comments)); + print_string (Res_printer.printInterface ~width signature ~comments)); } -let parse_implementation ?(ignore_parse_errors = false) sourcefile = +let parse_implementation ?(ignoreParseErrors = false) sourcefile = Location.input_name := sourcefile; - let parse_result = - parsing_engine.parse_implementation ~for_printer:false ~filename:sourcefile + let parseResult = + parsingEngine.parseImplementation ~forPrinter:false ~filename:sourcefile in - if parse_result.invalid then ( - Res_diagnostics.print_report parse_result.diagnostics parse_result.source; - if not ignore_parse_errors then exit 1); - parse_result.parsetree + if parseResult.invalid then ( + Res_diagnostics.printReport parseResult.diagnostics parseResult.source; + if not ignoreParseErrors then exit 1); + parseResult.parsetree [@@raises exit] -let parse_interface ?(ignore_parse_errors = false) sourcefile = +let parse_interface ?(ignoreParseErrors = false) sourcefile = Location.input_name := sourcefile; - let parse_result = - parsing_engine.parse_interface ~for_printer:false ~filename:sourcefile + let parseResult = + parsingEngine.parseInterface ~forPrinter:false ~filename:sourcefile in - if parse_result.invalid then ( - Res_diagnostics.print_report parse_result.diagnostics parse_result.source; - if not ignore_parse_errors then exit 1); - parse_result.parsetree + if parseResult.invalid then ( + Res_diagnostics.printReport parseResult.diagnostics parseResult.source; + if not ignoreParseErrors then exit 1); + parseResult.parsetree [@@raises exit] (* suppress unused optional arg *) let _ = fun s -> - ( parse_implementation ~ignore_parse_errors:false s, - parse_interface ~ignore_parse_errors:false s ) + ( parse_implementation ~ignoreParseErrors:false s, + parse_interface ~ignoreParseErrors:false s ) [@@raises exit] diff --git a/analysis/vendor/res_syntax/res_driver.mli b/analysis/vendor/res_syntax/res_driver.mli index 2b717013c..ddc264739 100644 --- a/analysis/vendor/res_syntax/res_driver.mli +++ b/analysis/vendor/res_syntax/res_driver.mli @@ -1,4 +1,4 @@ -type ('ast, 'diagnostics) parse_result = { +type ('ast, 'diagnostics) parseResult = { filename: string; [@live] source: string; parsetree: 'ast; @@ -7,41 +7,40 @@ type ('ast, 'diagnostics) parse_result = { comments: Res_comment.t list; } -type 'diagnostics parsing_engine = { - parse_implementation: - for_printer:bool -> +type 'diagnostics parsingEngine = { + parseImplementation: + forPrinter:bool -> filename:string -> - (Parsetree.structure, 'diagnostics) parse_result; - parse_interface: - for_printer:bool -> + (Parsetree.structure, 'diagnostics) parseResult; + parseInterface: + forPrinter:bool -> filename:string -> - (Parsetree.signature, 'diagnostics) parse_result; - string_of_diagnostics: - source:string -> filename:string -> 'diagnostics -> unit; + (Parsetree.signature, 'diagnostics) parseResult; + stringOfDiagnostics: source:string -> filename:string -> 'diagnostics -> unit; } -val parse_implementation_from_source : - for_printer:bool -> - display_filename:string -> +val parseImplementationFromSource : + forPrinter:bool -> + displayFilename:string -> source:string -> - (Parsetree.structure, Res_diagnostics.t list) parse_result + (Parsetree.structure, Res_diagnostics.t list) parseResult [@@live] -val parse_interface_from_source : - for_printer:bool -> - display_filename:string -> +val parseInterfaceFromSource : + forPrinter:bool -> + displayFilename:string -> source:string -> - (Parsetree.signature, Res_diagnostics.t list) parse_result + (Parsetree.signature, Res_diagnostics.t list) parseResult [@@live] -type print_engine = { - print_implementation: +type printEngine = { + printImplementation: width:int -> filename:string -> comments:Res_comment.t list -> Parsetree.structure -> unit; - print_interface: + printInterface: width:int -> filename:string -> comments:Res_comment.t list -> @@ -49,15 +48,15 @@ type print_engine = { unit; } -val parsing_engine : Res_diagnostics.t list parsing_engine +val parsingEngine : Res_diagnostics.t list parsingEngine -val print_engine : print_engine +val printEngine : printEngine (* ReScript implementation parsing compatible with ocaml pparse driver. Used by the compiler. *) val parse_implementation : - ?ignore_parse_errors:bool -> string -> Parsetree.structure + ?ignoreParseErrors:bool -> string -> Parsetree.structure [@@live] [@@raises Location.Error] (* ReScript interface parsing compatible with ocaml pparse driver. Used by the compiler *) -val parse_interface : ?ignore_parse_errors:bool -> string -> Parsetree.signature +val parse_interface : ?ignoreParseErrors:bool -> string -> Parsetree.signature [@@live] [@@raises Location.Error] diff --git a/analysis/vendor/res_syntax/res_driver_binary.ml b/analysis/vendor/res_syntax/res_driver_binary.ml index 71eb12bd4..58a815363 100644 --- a/analysis/vendor/res_syntax/res_driver_binary.ml +++ b/analysis/vendor/res_syntax/res_driver_binary.ml @@ -1,12 +1,12 @@ -let print_engine = +let printEngine = Res_driver. { - print_implementation = + printImplementation = (fun ~width:_ ~filename ~comments:_ structure -> output_string stdout Config.ast_impl_magic_number; output_value stdout filename; output_value stdout structure); - print_interface = + printInterface = (fun ~width:_ ~filename ~comments:_ signature -> output_string stdout Config.ast_intf_magic_number; output_value stdout filename; diff --git a/analysis/vendor/res_syntax/res_driver_binary.mli b/analysis/vendor/res_syntax/res_driver_binary.mli index 46358ea37..7991ba8db 100644 --- a/analysis/vendor/res_syntax/res_driver_binary.mli +++ b/analysis/vendor/res_syntax/res_driver_binary.mli @@ -1 +1 @@ -val print_engine : Res_driver.print_engine +val printEngine : Res_driver.printEngine diff --git a/analysis/vendor/res_syntax/res_driver_ml_parser.ml b/analysis/vendor/res_syntax/res_driver_ml_parser.ml index b910d49fa..0d6a99e9a 100644 --- a/analysis/vendor/res_syntax/res_driver_ml_parser.ml +++ b/analysis/vendor/res_syntax/res_driver_ml_parser.ml @@ -4,25 +4,23 @@ module IO = Res_io let setup ~filename = if String.length filename > 0 then ( Location.input_name := filename; - IO.read_file ~filename |> Lexing.from_string) + IO.readFile ~filename |> Lexing.from_string) else Lexing.from_channel stdin -let extract_ocaml_concrete_syntax filename = +let extractOcamlConcreteSyntax filename = let lexbuf = if String.length filename > 0 then - IO.read_file ~filename |> Lexing.from_string + IO.readFile ~filename |> Lexing.from_string else Lexing.from_channel stdin in - let string_locs = ref [] in - let comment_data = ref [] in - let rec next (prev_tok_end_pos : Lexing.position) () = + let stringLocs = ref [] in + let commentData = ref [] in + let rec next (prevTokEndPos : Lexing.position) () = let token = Lexer.token_with_comments lexbuf in match token with | OcamlParser.COMMENT (txt, loc) -> - let comment = - Res_comment.from_ocaml_comment ~loc ~prev_tok_end_pos ~txt - in - comment_data := comment :: !comment_data; + let comment = Res_comment.fromOcamlComment ~loc ~prevTokEndPos ~txt in + commentData := comment :: !commentData; next loc.Location.loc_end () | OcamlParser.STRING (_txt, None) -> let open Location in @@ -39,25 +37,25 @@ let extract_ocaml_concrete_syntax filename = ((Bytes.sub [@doesNotRaise]) lexbuf.Lexing.lex_buffer loc.loc_start.pos_cnum len) in - string_locs := (txt, loc) :: !string_locs; + stringLocs := (txt, loc) :: !stringLocs; next lexbuf.Lexing.lex_curr_p () | OcamlParser.EOF -> () | _ -> next lexbuf.Lexing.lex_curr_p () in next lexbuf.Lexing.lex_start_p (); - (List.rev !string_locs, List.rev !comment_data) + (List.rev !stringLocs, List.rev !commentData) -let parsing_engine = +let parsingEngine = { - Res_driver.parse_implementation = - (fun ~for_printer:_ ~filename -> + Res_driver.parseImplementation = + (fun ~forPrinter:_ ~filename -> let lexbuf = setup ~filename in - let string_data, comments = - extract_ocaml_concrete_syntax !Location.input_name + let stringData, comments = + extractOcamlConcreteSyntax !Location.input_name in let structure = Parse.implementation lexbuf - |> Res_ast_conversion.replace_string_literal_structure string_data + |> Res_ast_conversion.replaceStringLiteralStructure stringData |> Res_ast_conversion.structure in { @@ -68,15 +66,15 @@ let parsing_engine = invalid = false; comments; }); - parse_interface = - (fun ~for_printer:_ ~filename -> + parseInterface = + (fun ~forPrinter:_ ~filename -> let lexbuf = setup ~filename in - let string_data, comments = - extract_ocaml_concrete_syntax !Location.input_name + let stringData, comments = + extractOcamlConcreteSyntax !Location.input_name in let signature = Parse.interface lexbuf - |> Res_ast_conversion.replace_string_literal_signature string_data + |> Res_ast_conversion.replaceStringLiteralSignature stringData |> Res_ast_conversion.signature in { @@ -87,16 +85,16 @@ let parsing_engine = invalid = false; comments; }); - string_of_diagnostics = (fun ~source:_ ~filename:_ _diagnostics -> ()); + stringOfDiagnostics = (fun ~source:_ ~filename:_ _diagnostics -> ()); } -let print_engine = +let printEngine = Res_driver. { - print_implementation = + printImplementation = (fun ~width:_ ~filename:_ ~comments:_ structure -> Pprintast.structure Format.std_formatter structure); - print_interface = + printInterface = (fun ~width:_ ~filename:_ ~comments:_ signature -> Pprintast.signature Format.std_formatter signature); } diff --git a/analysis/vendor/res_syntax/res_driver_ml_parser.mli b/analysis/vendor/res_syntax/res_driver_ml_parser.mli index e104f6e63..55a99c4d5 100644 --- a/analysis/vendor/res_syntax/res_driver_ml_parser.mli +++ b/analysis/vendor/res_syntax/res_driver_ml_parser.mli @@ -1,10 +1,10 @@ (* This module represents a general interface to parse marshalled reason ast *) (* extracts comments and the original string data from an ocaml file *) -val extract_ocaml_concrete_syntax : +val extractOcamlConcreteSyntax : string -> (string * Location.t) list * Res_comment.t list [@@live] -val parsing_engine : unit Res_driver.parsing_engine +val parsingEngine : unit Res_driver.parsingEngine -val print_engine : Res_driver.print_engine +val printEngine : Res_driver.printEngine diff --git a/analysis/vendor/res_syntax/res_grammar.ml b/analysis/vendor/res_syntax/res_grammar.ml index daf9a788e..61e6f4ea8 100644 --- a/analysis/vendor/res_syntax/res_grammar.ml +++ b/analysis/vendor/res_syntax/res_grammar.ml @@ -60,7 +60,7 @@ type t = | AttributePayload | TagNames -let to_string = function +let toString = function | OpenDescription -> "an open description" | ModuleLongIdent -> "a module path" | Ternary -> "a ternary expression" @@ -70,7 +70,7 @@ let to_string = function | ExprOperand -> "a basic expression" | ExprUnary -> "a unary expression" | ExprBinaryAfterOp op -> - "an expression after the operator \"" ^ Token.to_string op ^ "\"" + "an expression after the operator \"" ^ Token.toString op ^ "\"" | ExprIf -> "an if expression" | IfCondition -> "the condition of an if expression" | IfBranch -> "the true-branch of an if expression" @@ -121,181 +121,181 @@ let to_string = function | AttributePayload -> "an attribute payload" | TagNames -> "tag names" -let is_signature_item_start = function +let isSignatureItemStart = function | Token.At | Let | Typ | External | Exception | Open | Include | Module | AtAt | PercentPercent -> true | _ -> false -let is_atomic_pattern_start = function +let isAtomicPatternStart = function | Token.Int _ | String _ | Codepoint _ | Backtick | Lparen | Lbracket | Lbrace - | Underscore | Lident _ | Uident _ | List | Exception | Percent -> + | Underscore | Lident _ | Uident _ | List | Exception | Lazy | Percent -> true | _ -> false -let is_atomic_expr_start = function +let isAtomicExprStart = function | Token.True | False | Int _ | String _ | Float _ | Codepoint _ | Backtick | Uident _ | Lident _ | Hash | Lparen | List | Lbracket | Lbrace | LessThan | Module | Percent -> true | _ -> false -let is_atomic_typ_expr_start = function +let isAtomicTypExprStart = function | Token.SingleQuote | Underscore | Lparen | Lbrace | Uident _ | Lident _ | Percent -> true | _ -> false -let is_expr_start = function +let isExprStart = function | Token.Assert | At | Await | Backtick | Bang | Codepoint _ | False | Float _ - | For | Hash | If | Int _ | Lbrace | Lbracket | LessThan | Lident _ | List - | Lparen | Minus | MinusDot | Module | Percent | Plus | PlusDot | String _ - | Switch | True | Try | Uident _ | Underscore (* _ => doThings() *) + | For | Hash | If | Int _ | Lazy | Lbrace | Lbracket | LessThan | Lident _ + | List | Lparen | Minus | MinusDot | Module | Percent | Plus | PlusDot + | String _ | Switch | True | Try | Uident _ | Underscore (* _ => doThings() *) | While -> true | _ -> false -let is_jsx_attribute_start = function +let isJsxAttributeStart = function | Token.Lident _ | Question | Lbrace -> true | _ -> false -let is_structure_item_start = function +let isStructureItemStart = function | Token.Open | Let | Typ | External | Exception | Include | Module | AtAt | PercentPercent | At -> true - | t when is_expr_start t -> true + | t when isExprStart t -> true | _ -> false -let is_pattern_start = function +let isPatternStart = function | Token.Int _ | Float _ | String _ | Codepoint _ | Backtick | True | False | Minus | Plus | Lparen | Lbracket | Lbrace | List | Underscore | Lident _ - | Uident _ | Hash | Exception | Percent | Module | At -> + | Uident _ | Hash | Exception | Lazy | Percent | Module | At -> true | _ -> false -let is_parameter_start = function +let isParameterStart = function | Token.Typ | Tilde | Dot -> true - | token when is_pattern_start token -> true + | token when isPatternStart token -> true | _ -> false (* TODO: overparse Uident ? *) -let is_string_field_decl_start = function +let isStringFieldDeclStart = function | Token.String _ | Lident _ | At | DotDotDot -> true | _ -> false (* TODO: overparse Uident ? *) -let is_field_decl_start = function +let isFieldDeclStart = function | Token.At | Mutable | Lident _ -> true (* recovery, TODO: this is not ideal… *) | Uident _ -> true - | t when Token.is_keyword t -> true + | t when Token.isKeyword t -> true | _ -> false -let is_record_decl_start = function +let isRecordDeclStart = function | Token.At | Mutable | Lident _ | DotDotDot | String _ -> true | _ -> false -let is_typ_expr_start = function +let isTypExprStart = function | Token.At | SingleQuote | Underscore | Lparen | Lbracket | Uident _ | Lident _ | Module | Percent | Lbrace -> true | _ -> false -let is_type_parameter_start = function +let isTypeParameterStart = function | Token.Tilde | Dot -> true - | token when is_typ_expr_start token -> true + | token when isTypExprStart token -> true | _ -> false -let is_type_param_start = function +let isTypeParamStart = function | Token.Plus | Minus | SingleQuote | Underscore -> true | _ -> false -let is_functor_arg_start = function +let isFunctorArgStart = function | Token.At | Uident _ | Underscore | Percent | Lbrace | Lparen -> true | _ -> false -let is_mod_expr_start = function +let isModExprStart = function | Token.At | Percent | Uident _ | Lbrace | Lparen | Lident "unpack" | Await -> true | _ -> false -let is_record_row_start = function +let isRecordRowStart = function | Token.DotDotDot -> true | Token.Uident _ | Lident _ -> true (* TODO *) - | t when Token.is_keyword t -> true + | t when Token.isKeyword t -> true | _ -> false -let is_record_row_string_key_start = function +let isRecordRowStringKeyStart = function | Token.String _ -> true | _ -> false -let is_argument_start = function +let isArgumentStart = function | Token.Tilde | Dot | Underscore -> true - | t when is_expr_start t -> true + | t when isExprStart t -> true | _ -> false -let is_pattern_match_start = function +let isPatternMatchStart = function | Token.Bar -> true - | t when is_pattern_start t -> true + | t when isPatternStart t -> true | _ -> false -let is_pattern_ocaml_list_start = function +let isPatternOcamlListStart = function | Token.DotDotDot -> true - | t when is_pattern_start t -> true + | t when isPatternStart t -> true | _ -> false -let is_pattern_record_item_start = function +let isPatternRecordItemStart = function | Token.DotDotDot | Uident _ | Lident _ | Underscore -> true | _ -> false -let is_attribute_start = function +let isAttributeStart = function | Token.At -> true | _ -> false -let is_jsx_child_start = is_atomic_expr_start +let isJsxChildStart = isAtomicExprStart -let is_block_expr_start = function +let isBlockExprStart = function | Token.Assert | At | Await | Backtick | Bang | Codepoint _ | Exception - | False | Float _ | For | Forwardslash | Hash | If | Int _ | Lbrace | Lbracket - | LessThan | Let | Lident _ | List | Lparen | Minus | MinusDot | Module | Open - | Percent | Plus | PlusDot | String _ | Switch | True | Try | Uident _ - | Underscore | While -> + | False | Float _ | For | Forwardslash | Hash | If | Int _ | Lazy | Lbrace + | Lbracket | LessThan | Let | Lident _ | List | Lparen | Minus | MinusDot + | Module | Open | Percent | Plus | PlusDot | String _ | Switch | True | Try + | Uident _ | Underscore | While -> true | _ -> false -let is_list_element grammar token = +let isListElement grammar token = match grammar with - | ExprList -> token = Token.DotDotDot || is_expr_start token - | ListExpr -> token = DotDotDot || is_expr_start token - | PatternList -> token = DotDotDot || is_pattern_start token - | ParameterList -> is_parameter_start token - | StringFieldDeclarations -> is_string_field_decl_start token - | FieldDeclarations -> is_field_decl_start token - | RecordDecl -> is_record_decl_start token - | TypExprList -> is_typ_expr_start token || token = Token.LessThan - | TypeParams -> is_type_param_start token - | FunctorArgs -> is_functor_arg_start token - | ModExprList -> is_mod_expr_start token - | TypeParameters -> is_type_parameter_start token - | RecordRows -> is_record_row_start token - | RecordRowsStringKey -> is_record_row_string_key_start token - | ArgumentList -> is_argument_start token - | Signature | Specification -> is_signature_item_start token - | Structure | Implementation -> is_structure_item_start token - | PatternMatching -> is_pattern_match_start token - | PatternOcamlList -> is_pattern_ocaml_list_start token - | PatternRecord -> is_pattern_record_item_start token - | Attribute -> is_attribute_start token + | ExprList -> token = Token.DotDotDot || isExprStart token + | ListExpr -> token = DotDotDot || isExprStart token + | PatternList -> token = DotDotDot || isPatternStart token + | ParameterList -> isParameterStart token + | StringFieldDeclarations -> isStringFieldDeclStart token + | FieldDeclarations -> isFieldDeclStart token + | RecordDecl -> isRecordDeclStart token + | TypExprList -> isTypExprStart token || token = Token.LessThan + | TypeParams -> isTypeParamStart token + | FunctorArgs -> isFunctorArgStart token + | ModExprList -> isModExprStart token + | TypeParameters -> isTypeParameterStart token + | RecordRows -> isRecordRowStart token + | RecordRowsStringKey -> isRecordRowStringKeyStart token + | ArgumentList -> isArgumentStart token + | Signature | Specification -> isSignatureItemStart token + | Structure | Implementation -> isStructureItemStart token + | PatternMatching -> isPatternMatchStart token + | PatternOcamlList -> isPatternOcamlListStart token + | PatternRecord -> isPatternRecordItemStart token + | Attribute -> isAttributeStart token | TypeConstraint -> token = Constraint | PackageConstraint -> token = And | ConstructorDeclaration -> token = Bar - | JsxAttribute -> is_jsx_attribute_start token + | JsxAttribute -> isJsxAttributeStart token | AttributePayload -> token = Lparen | TagNames -> token = Hash | _ -> false -let is_list_terminator grammar token = +let isListTerminator grammar token = match (grammar, token) with | _, Token.Eof | ExprList, (Rparen | Forwardslash | Rbracket) @@ -322,5 +322,5 @@ let is_list_terminator grammar token = | TagNames, Rbracket -> true | _ -> false -let is_part_of_list grammar token = - is_list_element grammar token || is_list_terminator grammar token +let isPartOfList grammar token = + isListElement grammar token || isListTerminator grammar token diff --git a/analysis/vendor/res_syntax/res_io.ml b/analysis/vendor/res_syntax/res_io.ml index 1d55da831..e5934b848 100644 --- a/analysis/vendor/res_syntax/res_io.ml +++ b/analysis/vendor/res_syntax/res_io.ml @@ -1,4 +1,4 @@ -let read_file ~filename = +let readFile ~filename = let chan = open_in_bin filename in let content = try really_input_string chan (in_channel_length chan) @@ -7,7 +7,7 @@ let read_file ~filename = close_in_noerr chan; content -let write_file ~filename ~contents:txt = +let writeFile ~filename ~contents:txt = let chan = open_out_bin filename in output_string chan txt; close_out chan diff --git a/analysis/vendor/res_syntax/res_io.mli b/analysis/vendor/res_syntax/res_io.mli index 65e399e15..dcc6e1425 100644 --- a/analysis/vendor/res_syntax/res_io.mli +++ b/analysis/vendor/res_syntax/res_io.mli @@ -1,7 +1,7 @@ (* utilities to read and write to/from files or stdin *) (* reads the contents of "filename" into a string *) -val read_file : filename:string -> string +val readFile : filename:string -> string (* writes "content" into file with name "filename" *) -val write_file : filename:string -> contents:string -> unit +val writeFile : filename:string -> contents:string -> unit diff --git a/analysis/vendor/res_syntax/res_multi_printer.ml b/analysis/vendor/res_syntax/res_multi_printer.ml index fd212eb45..98cd1d423 100644 --- a/analysis/vendor/res_syntax/res_multi_printer.ml +++ b/analysis/vendor/res_syntax/res_multi_printer.ml @@ -1,28 +1,28 @@ -let default_print_width = 100 +let defaultPrintWidth = 100 (* Look at rescript.json (or bsconfig.json) to set Uncurried or Legacy mode if it contains "uncurried": false *) -let get_uncurried_from_config ~filename = - let rec find_config ~dir = +let getUncurriedFromConfig ~filename = + let rec findConfig ~dir = let config = Filename.concat dir "rescript.json" in - if Sys.file_exists config then Some (Res_io.read_file ~filename:config) + if Sys.file_exists config then Some (Res_io.readFile ~filename:config) else let config = Filename.concat dir "bsconfig.json" in - if Sys.file_exists config then Some (Res_io.read_file ~filename:config) + if Sys.file_exists config then Some (Res_io.readFile ~filename:config) else let parent = Filename.dirname dir in - if parent = dir then None else find_config ~dir:parent + if parent = dir then None else findConfig ~dir:parent in - let rec find_from_node_modules ~dir = + let rec findFromNodeModules ~dir = let parent = Filename.dirname dir in if Filename.basename dir = "node_modules" then let config = Filename.concat parent "rescript.json" in - if Sys.file_exists config then Some (Res_io.read_file ~filename:config) + if Sys.file_exists config then Some (Res_io.readFile ~filename:config) else let config = Filename.concat parent "bsconfig.json" in - if Sys.file_exists config then Some (Res_io.read_file ~filename:config) + if Sys.file_exists config then Some (Res_io.readFile ~filename:config) else None else if parent = dir then None - else find_from_node_modules ~dir:parent + else findFromNodeModules ~dir:parent in let dir = if Filename.is_relative filename then @@ -30,12 +30,12 @@ let get_uncurried_from_config ~filename = else Filename.dirname filename in let config () = - match find_config ~dir with + match findConfig ~dir with | None -> (* The editor calls format on a temporary file. So bsconfig can't be found. This looks outside the node_modules containing the bsc binary *) let dir = (Filename.dirname Sys.argv.(0) [@doesNotRaise]) in - find_from_node_modules ~dir + findFromNodeModules ~dir | x -> x in match config () with @@ -65,55 +65,55 @@ let get_uncurried_from_config ~filename = if not is_legacy_uncurried then Config.uncurried := Uncurried (* print res files to res syntax *) -let print_res ~ignore_parse_errors ~is_interface ~filename = - get_uncurried_from_config ~filename; - if is_interface then ( - let parse_result = - Res_driver.parsing_engine.parse_interface ~for_printer:true ~filename +let printRes ~ignoreParseErrors ~isInterface ~filename = + getUncurriedFromConfig ~filename; + if isInterface then ( + let parseResult = + Res_driver.parsingEngine.parseInterface ~forPrinter:true ~filename in - if parse_result.invalid then ( - Res_diagnostics.print_report parse_result.diagnostics parse_result.source; - if not ignore_parse_errors then exit 1); - Res_printer.print_interface ~width:default_print_width - ~comments:parse_result.comments parse_result.parsetree) + if parseResult.invalid then ( + Res_diagnostics.printReport parseResult.diagnostics parseResult.source; + if not ignoreParseErrors then exit 1); + Res_printer.printInterface ~width:defaultPrintWidth + ~comments:parseResult.comments parseResult.parsetree) else - let parse_result = - Res_driver.parsing_engine.parse_implementation ~for_printer:true ~filename + let parseResult = + Res_driver.parsingEngine.parseImplementation ~forPrinter:true ~filename in - if parse_result.invalid then ( - Res_diagnostics.print_report parse_result.diagnostics parse_result.source; - if not ignore_parse_errors then exit 1); - Res_printer.print_implementation ~width:default_print_width - ~comments:parse_result.comments parse_result.parsetree + if parseResult.invalid then ( + Res_diagnostics.printReport parseResult.diagnostics parseResult.source; + if not ignoreParseErrors then exit 1); + Res_printer.printImplementation ~width:defaultPrintWidth + ~comments:parseResult.comments parseResult.parsetree [@@raises exit] (* print ocaml files to res syntax *) -let print_ml ~is_interface ~filename = - if is_interface then - let parse_result = - Res_driver_ml_parser.parsing_engine.parse_interface ~for_printer:true +let printMl ~isInterface ~filename = + if isInterface then + let parseResult = + Res_driver_ml_parser.parsingEngine.parseInterface ~forPrinter:true ~filename in - Res_printer.print_interface ~width:default_print_width - ~comments:parse_result.comments parse_result.parsetree + Res_printer.printInterface ~width:defaultPrintWidth + ~comments:parseResult.comments parseResult.parsetree else - let parse_result = - Res_driver_ml_parser.parsing_engine.parse_implementation ~for_printer:true + let parseResult = + Res_driver_ml_parser.parsingEngine.parseImplementation ~forPrinter:true ~filename in - Res_printer.print_implementation ~width:default_print_width - ~comments:parse_result.comments parse_result.parsetree + Res_printer.printImplementation ~width:defaultPrintWidth + ~comments:parseResult.comments parseResult.parsetree (* print the given file named input to from "language" to res, general interface exposed by the compiler *) -let print ?(ignore_parse_errors = false) language ~input = - let is_interface = +let print ?(ignoreParseErrors = false) language ~input = + let isInterface = let len = String.length input in len > 0 && String.unsafe_get input (len - 1) = 'i' in match language with - | `res -> print_res ~ignore_parse_errors ~is_interface ~filename:input - | `ml -> print_ml ~is_interface ~filename:input + | `res -> printRes ~ignoreParseErrors ~isInterface ~filename:input + | `ml -> printMl ~isInterface ~filename:input [@@raises exit] (* suppress unused optional arg *) -let _ = fun s -> print ~ignore_parse_errors:false s [@@raises exit] +let _ = fun s -> print ~ignoreParseErrors:false s [@@raises exit] diff --git a/analysis/vendor/res_syntax/res_multi_printer.mli b/analysis/vendor/res_syntax/res_multi_printer.mli index ff3da3b3a..1d15c71e2 100644 --- a/analysis/vendor/res_syntax/res_multi_printer.mli +++ b/analysis/vendor/res_syntax/res_multi_printer.mli @@ -1,3 +1,3 @@ (* Interface to print source code from different languages to res. * Takes a filename called "input" and returns the corresponding formatted res syntax *) -val print : ?ignore_parse_errors:bool -> [`ml | `res] -> input:string -> string +val print : ?ignoreParseErrors:bool -> [`ml | `res] -> input:string -> string diff --git a/analysis/vendor/res_syntax/res_outcome_printer.ml b/analysis/vendor/res_syntax/res_outcome_printer.ml index 08f260c36..f704bd808 100644 --- a/analysis/vendor/res_syntax/res_outcome_printer.ml +++ b/analysis/vendor/res_syntax/res_outcome_printer.ml @@ -8,14 +8,77 @@ * In general it represent messages to show results or errors to the user. *) module Doc = Res_doc -module Printer = Res_printer +module Token = Res_token + +let rec unsafe_for_all_range s ~start ~finish p = + start > finish + || p (String.unsafe_get s start) + && unsafe_for_all_range s ~start:(start + 1) ~finish p + +let for_all_from s start p = + let len = String.length s in + unsafe_for_all_range s ~start ~finish:(len - 1) p + +(* See https://github.com/rescript-lang/rescript-compiler/blob/726cfa534314b586e5b5734471bc2023ad99ebd9/jscomp/ext/ext_string.ml#L510 *) +let isValidNumericPolyvarNumber (x : string) = + let len = String.length x in + len > 0 + && + let a = Char.code (String.unsafe_get x 0) in + a <= 57 + && + if len > 1 then + a > 48 + && for_all_from x 1 (function + | '0' .. '9' -> true + | _ -> false) + else a >= 48 + +type identifierStyle = ExoticIdent | NormalIdent + +let classifyIdentContent ~allowUident txt = + let len = String.length txt in + let rec go i = + if i == len then NormalIdent + else + let c = String.unsafe_get txt i in + if + i == 0 + && not + ((allowUident && c >= 'A' && c <= 'Z') + || (c >= 'a' && c <= 'z') + || c = '_') + then ExoticIdent + else if + not + ((c >= 'a' && c <= 'z') + || (c >= 'A' && c <= 'Z') + || c = '\'' || c = '_' + || (c >= '0' && c <= '9')) + then ExoticIdent + else go (i + 1) + in + if Token.isKeywordTxt txt then ExoticIdent else go 0 + +let printIdentLike ~allowUident txt = + match classifyIdentContent ~allowUident txt with + | ExoticIdent -> Doc.concat [Doc.text "\\\""; Doc.text txt; Doc.text "\""] + | NormalIdent -> Doc.text txt + +let printPolyVarIdent txt = + (* numeric poly-vars don't need quotes: #644 *) + if isValidNumericPolyvarNumber txt then Doc.text txt + else + match classifyIdentContent ~allowUident:true txt with + | ExoticIdent -> Doc.concat [Doc.text "\""; Doc.text txt; Doc.text "\""] + | NormalIdent -> Doc.text txt (* ReScript doesn't have parenthesized identifiers. * We don't support custom operators. *) let parenthesized_ident _name = true (* TODO: better allocation strategy for the buffer *) -let escape_string_contents s = +let escapeStringContents s = let len = String.length s in let b = Buffer.create len in for i = 0 to len - 1 do @@ -54,64 +117,59 @@ let escape_string_contents s = print_ident fmt id2; Format.pp_print_char fmt ')' *) -let rec print_out_ident_doc ?(allow_uident = true) - (ident : Outcometree.out_ident) = +let rec printOutIdentDoc ?(allowUident = true) (ident : Outcometree.out_ident) = match ident with - | Oide_ident s -> Printer.print_ident_like ~allow_uident s + | Oide_ident s -> printIdentLike ~allowUident s | Oide_dot (ident, s) -> - Doc.concat [print_out_ident_doc ident; Doc.dot; Doc.text s] + Doc.concat [printOutIdentDoc ident; Doc.dot; Doc.text s] | Oide_apply (call, arg) -> Doc.concat - [ - print_out_ident_doc call; Doc.lparen; print_out_ident_doc arg; Doc.rparen; - ] + [printOutIdentDoc call; Doc.lparen; printOutIdentDoc arg; Doc.rparen] -let print_out_attribute_doc (out_attribute : Outcometree.out_attribute) = - Doc.concat [Doc.text "@"; Doc.text out_attribute.oattr_name] +let printOutAttributeDoc (outAttribute : Outcometree.out_attribute) = + Doc.concat [Doc.text "@"; Doc.text outAttribute.oattr_name] -let print_out_attributes_doc (attrs : Outcometree.out_attribute list) = +let printOutAttributesDoc (attrs : Outcometree.out_attribute list) = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.group - (Doc.join ~sep:Doc.line (List.map print_out_attribute_doc attrs)); + Doc.group (Doc.join ~sep:Doc.line (List.map printOutAttributeDoc attrs)); Doc.line; ] -let rec collect_arrow_args (out_type : Outcometree.out_type) args = - match out_type with - | Otyp_arrow (label, arg_type, return_type) -> - let arg = (label, arg_type) in - collect_arrow_args return_type (arg :: args) - | _ as return_type -> (List.rev args, return_type) +let rec collectArrowArgs (outType : Outcometree.out_type) args = + match outType with + | Otyp_arrow (label, argType, returnType) -> + let arg = (label, argType) in + collectArrowArgs returnType (arg :: args) + | _ as returnType -> (List.rev args, returnType) -let rec collect_functor_args (out_module_type : Outcometree.out_module_type) - args = - match out_module_type with - | Omty_functor (lbl, opt_mod_type, return_mod_type) -> - let arg = (lbl, opt_mod_type) in - collect_functor_args return_mod_type (arg :: args) - | _ -> (List.rev args, out_module_type) +let rec collectFunctorArgs (outModuleType : Outcometree.out_module_type) args = + match outModuleType with + | Omty_functor (lbl, optModType, returnModType) -> + let arg = (lbl, optModType) in + collectFunctorArgs returnModType (arg :: args) + | _ -> (List.rev args, outModuleType) -let rec print_out_type_doc (out_type : Outcometree.out_type) = - match out_type with +let rec printOutTypeDoc (outType : Outcometree.out_type) = + match outType with | Otyp_abstract | Otyp_open -> Doc.nil - | Otyp_variant (non_gen, out_variant, closed, labels) -> + | Otyp_variant (nonGen, outVariant, closed, labels) -> (* bool * out_variant * bool * (string list) option *) let opening = match (closed, labels) with - | true, None -> (* [#A | #B] *) Doc.soft_line + | true, None -> (* [#A | #B] *) Doc.softLine | false, None -> (* [> #A | #B] *) - Doc.concat [Doc.greater_than; Doc.line] + Doc.concat [Doc.greaterThan; Doc.line] | true, Some [] -> (* [< #A | #B] *) - Doc.concat [Doc.less_than; Doc.line] + Doc.concat [Doc.lessThan; Doc.line] | true, Some _ -> (* [< #A | #B > #X #Y ] *) - Doc.concat [Doc.less_than; Doc.line] + Doc.concat [Doc.lessThan; Doc.line] | false, Some _ -> (* impossible!? ocaml seems to print ?, see oprint.ml in 4.06 *) Doc.concat [Doc.text "?"; Doc.line] @@ -119,9 +177,9 @@ let rec print_out_type_doc (out_type : Outcometree.out_type) = Doc.group (Doc.concat [ - (if non_gen then Doc.text "_" else Doc.nil); + (if nonGen then Doc.text "_" else Doc.nil); Doc.lbracket; - Doc.indent (Doc.concat [opening; print_out_variant out_variant]); + Doc.indent (Doc.concat [opening; printOutVariant outVariant]); (match labels with | None | Some [] -> Doc.nil | Some tags -> @@ -131,83 +189,80 @@ let rec print_out_type_doc (out_type : Outcometree.out_type) = Doc.space; Doc.join ~sep:Doc.space (List.map - (fun lbl -> - Printer.print_ident_like ~allow_uident:true lbl) + (fun lbl -> printIdentLike ~allowUident:true lbl) tags); ])); - Doc.soft_line; + Doc.softLine; Doc.rbracket; ]) - | Otyp_alias (typ, alias_txt) -> + | Otyp_alias (typ, aliasTxt) -> Doc.concat [ Doc.lparen; - print_out_type_doc typ; + printOutTypeDoc typ; Doc.text " as '"; - Doc.text alias_txt; + Doc.text aliasTxt; Doc.rparen; ] | Otyp_constr (Oide_dot (Oide_dot (Oide_ident "Js", "Fn"), "arity0"), [typ]) -> (* Compatibility with compiler up to v10.x *) - Doc.concat [Doc.text "(. ()) => "; print_out_type_doc typ] + Doc.concat [Doc.text "(. ()) => "; printOutTypeDoc typ] | Otyp_constr ( Oide_dot (Oide_dot (Oide_ident "Js", "Fn"), _), - [(Otyp_arrow _ as arrow_type)] ) -> + [(Otyp_arrow _ as arrowType)] ) -> (* Compatibility with compiler up to v10.x *) - print_out_arrow_type ~uncurried:true arrow_type - | Otyp_constr (Oide_ident "function$", [(Otyp_arrow _ as arrow_type); _arity]) + printOutArrowType ~uncurried:true arrowType + | Otyp_constr (Oide_ident "function$", [(Otyp_arrow _ as arrowType); _arity]) -> (* function$<(int, int) => int, [#2]> -> (. int, int) => int *) - print_out_arrow_type ~uncurried:true arrow_type + printOutArrowType ~uncurried:true arrowType | Otyp_constr (Oide_ident "function$", [Otyp_var _; _arity]) -> (* function$<'a, arity> -> _ => _ *) - print_out_type_doc (Otyp_stuff "_ => _") - | Otyp_constr (out_ident, []) -> - print_out_ident_doc ~allow_uident:false out_ident + printOutTypeDoc (Otyp_stuff "_ => _") + | Otyp_constr (outIdent, []) -> printOutIdentDoc ~allowUident:false outIdent | Otyp_manifest (typ1, typ2) -> - Doc.concat - [print_out_type_doc typ1; Doc.text " = "; print_out_type_doc typ2] - | Otyp_record record -> print_record_declaration_doc ~inline:true record + Doc.concat [printOutTypeDoc typ1; Doc.text " = "; printOutTypeDoc typ2] + | Otyp_record record -> printRecordDeclarationDoc ~inline:true record | Otyp_stuff txt -> Doc.text txt | Otyp_var (ng, s) -> Doc.concat [Doc.text ("'" ^ if ng then "_" else ""); Doc.text s] - | Otyp_object (fields, rest) -> print_object_fields fields rest + | Otyp_object (fields, rest) -> printObjectFields fields rest | Otyp_class _ -> Doc.nil | Otyp_attribute (typ, attribute) -> Doc.group (Doc.concat - [print_out_attribute_doc attribute; Doc.line; print_out_type_doc typ]) + [printOutAttributeDoc attribute; Doc.line; printOutTypeDoc typ]) (* example: Red | Blue | Green | CustomColour(float, float, float) *) - | Otyp_sum constructors -> print_out_constructors_doc constructors + | Otyp_sum constructors -> printOutConstructorsDoc constructors (* example: {"name": string, "age": int} *) | Otyp_constr (Oide_dot (Oide_ident "Js", "t"), [Otyp_object (fields, rest)]) -> - print_object_fields fields rest + printObjectFields fields rest (* example: node *) - | Otyp_constr (out_ident, args) -> - let args_doc = + | Otyp_constr (outIdent, args) -> + let argsDoc = match args with | [] -> Doc.nil | args -> Doc.concat [ - Doc.less_than; + Doc.lessThan; Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map print_out_type_doc args); + (List.map printOutTypeDoc args); ]); - Doc.trailing_comma; - Doc.soft_line; - Doc.greater_than; + Doc.trailingComma; + Doc.softLine; + Doc.greaterThan; ] in - Doc.group (Doc.concat [print_out_ident_doc out_ident; args_doc]) - | Otyp_tuple tuple_args -> + Doc.group (Doc.concat [printOutIdentDoc outIdent; argsDoc]) + | Otyp_tuple tupleArgs -> Doc.group (Doc.concat [ @@ -215,16 +270,16 @@ let rec print_out_type_doc (out_type : Outcometree.out_type) = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map print_out_type_doc tuple_args); + (List.map printOutTypeDoc tupleArgs); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ]) - | Otyp_poly (vars, out_type) -> + | Otyp_poly (vars, outType) -> Doc.group (Doc.concat [ @@ -232,12 +287,12 @@ let rec print_out_type_doc (out_type : Outcometree.out_type) = (List.map (fun var -> Doc.text ("'" ^ var)) vars); Doc.dot; Doc.space; - print_out_type_doc out_type; + printOutTypeDoc outType; ]) - | Otyp_arrow _ as typ -> print_out_arrow_type ~uncurried:false typ - | Otyp_module (mod_name, string_list, out_types) -> - let package_type_doc = - match (string_list, out_types) with + | Otyp_arrow _ as typ -> printOutArrowType ~uncurried:false typ + | Otyp_module (modName, stringList, outTypes) -> + let packageTypeDoc = + match (stringList, outTypes) with | [], [] -> Doc.nil | labels, types -> let i = ref 0 in @@ -251,7 +306,7 @@ let rec print_out_type_doc (out_type : Outcometree.out_type) = (if i.contents > 0 then "and type " else "with type "); Doc.text lbl; Doc.text " = "; - print_out_type_doc typ; + printOutTypeDoc typ; ]) labels types) in @@ -261,42 +316,41 @@ let rec print_out_type_doc (out_type : Outcometree.out_type) = [ Doc.text "module"; Doc.lparen; - Doc.text mod_name; - package_type_doc; + Doc.text modName; + packageTypeDoc; Doc.rparen; ] -and print_out_arrow_type ~uncurried typ = - let uncurried = Res_uncurried.get_dotted ~uncurried !Config.uncurried in - let typ_args, typ = collect_arrow_args typ [] in +and printOutArrowType ~uncurried typ = + let uncurried = Res_uncurried.getDotted ~uncurried !Config.uncurried in + let typArgs, typ = collectArrowArgs typ [] in let args = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun (lbl, typ) -> - let lbl_len = String.length lbl in - if lbl_len = 0 then print_out_type_doc typ + let lblLen = String.length lbl in + if lblLen = 0 then printOutTypeDoc typ else - let lbl, optional_indicator = + let lbl, optionalIndicator = (* the ocaml compiler hardcodes the optional label inside the string of the label in printtyp.ml *) match String.unsafe_get lbl 0 with | '?' -> - ( (String.sub [@doesNotRaise]) lbl 1 (lbl_len - 1), - Doc.text "=?" ) + ((String.sub [@doesNotRaise]) lbl 1 (lblLen - 1), Doc.text "=?") | _ -> (lbl, Doc.nil) in Doc.group (Doc.concat [ Doc.text ("~" ^ lbl ^ ": "); - print_out_type_doc typ; - optional_indicator; + printOutTypeDoc typ; + optionalIndicator; ])) - typ_args) + typArgs) in - let args_doc = - let needs_parens = - match typ_args with + let argsDoc = + let needsParens = + match typArgs with | _ when uncurried -> true | [ ( _, @@ -308,21 +362,21 @@ and print_out_arrow_type ~uncurried typ = | [("", _)] -> false | _ -> true in - if needs_parens then + if needsParens then Doc.group (Doc.concat [ (if uncurried then Doc.text "(. " else Doc.lparen); - Doc.indent (Doc.concat [Doc.soft_line; args]); - Doc.trailing_comma; - Doc.soft_line; + Doc.indent (Doc.concat [Doc.softLine; args]); + Doc.trailingComma; + Doc.softLine; Doc.rparen; ]) else args in - Doc.concat [args_doc; Doc.text " => "; print_out_type_doc typ] + Doc.concat [argsDoc; Doc.text " => "; printOutTypeDoc typ] -and print_out_variant variant = +and printOutVariant variant = match variant with | Ovar_fields fields -> (* (string * bool * out_type list) list *) @@ -333,7 +387,7 @@ and print_out_variant variant = *) List.mapi (fun i (name, ampersand, types) -> - let needs_parens = + let needsParens = match types with | [Outcometree.Otyp_tuple _] -> false | _ -> true @@ -341,12 +395,12 @@ and print_out_variant variant = Doc.concat [ (if i > 0 then Doc.text "| " - else Doc.if_breaks (Doc.text "| ") Doc.nil); + else Doc.ifBreaks (Doc.text "| ") Doc.nil); Doc.group (Doc.concat [ Doc.text "#"; - Printer.print_poly_var_ident name; + printPolyVarIdent name; (match types with | [] -> Doc.nil | types -> @@ -360,26 +414,26 @@ and print_out_variant variant = ~sep:(Doc.concat [Doc.text " &"; Doc.line]) (List.map (fun typ -> - let out_type_doc = - print_out_type_doc typ + let outTypeDoc = + printOutTypeDoc typ in - if needs_parens then + if needsParens then Doc.concat [ Doc.lparen; - out_type_doc; + outTypeDoc; Doc.rparen; ] - else out_type_doc) + else outTypeDoc) types); ]); ]); ]); ]) fields) - | Ovar_typ typ -> print_out_type_doc typ + | Ovar_typ typ -> printOutTypeDoc typ -and print_object_fields fields rest = +and printObjectFields fields rest = let dots = match rest with | Some non_gen -> Doc.text ((if non_gen then "_" else "") ^ "..") @@ -393,49 +447,54 @@ and print_object_fields fields rest = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun (lbl, out_type) -> + (fun (lbl, outType) -> Doc.group (Doc.concat [ Doc.text ("\"" ^ lbl ^ "\": "); - print_out_type_doc out_type; + printOutTypeDoc outType; ])) fields); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbrace; ]) -and print_out_constructors_doc constructors = +and printOutConstructorsDoc constructors = Doc.group (Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:Doc.line (List.mapi (fun i constructor -> Doc.concat [ (if i > 0 then Doc.text "| " - else Doc.if_breaks (Doc.text "| ") Doc.nil); - print_out_constructor_doc constructor; + else Doc.ifBreaks (Doc.text "| ") Doc.nil); + printOutConstructorDoc constructor; ]) constructors); ])) -and print_out_constructor_doc (name, args, gadt) = - let gadt_doc = +and printOutConstructorDoc (name, args, gadt, repr) = + let reprDoc = + match repr with + | None -> Doc.nil + | Some s -> Doc.text (s ^ " ") + in + let gadtDoc = match gadt with - | Some out_type -> Doc.concat [Doc.text ": "; print_out_type_doc out_type] + | Some outType -> Doc.concat [Doc.text ": "; printOutTypeDoc outType] | None -> Doc.nil in - let args_doc = + let argsDoc = match args with | [] -> Doc.nil | [Otyp_record record] -> @@ -448,7 +507,7 @@ and print_out_constructor_doc (name, args, gadt) = Doc.concat [ Doc.lparen; - Doc.indent (print_record_declaration_doc ~inline:true record); + Doc.indent (printRecordDeclarationDoc ~inline:true record); Doc.rparen; ] | _types -> @@ -459,30 +518,30 @@ and print_out_constructor_doc (name, args, gadt) = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map print_out_type_doc args); + (List.map printOutTypeDoc args); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ]) in - Doc.group (Doc.concat [Doc.text name; args_doc; gadt_doc]) + Doc.group (Doc.concat [reprDoc; Doc.text name; argsDoc; gadtDoc]) -and print_record_decl_row_doc (name, mut, opt, arg) = +and printRecordDeclRowDoc (name, mut, opt, arg) = Doc.group (Doc.concat [ (if mut then Doc.text "mutable " else Doc.nil); - Printer.print_ident_like ~allow_uident:false name; + printIdentLike ~allowUident:false name; (if opt then Doc.text "?" else Doc.nil); Doc.text ": "; - print_out_type_doc arg; + printOutTypeDoc arg; ]) -and print_record_declaration_doc ~inline rows = +and printRecordDeclarationDoc ~inline rows = let content = Doc.concat [ @@ -490,48 +549,47 @@ and print_record_declaration_doc ~inline rows = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map print_record_decl_row_doc rows); + (List.map printRecordDeclRowDoc rows); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbrace; ] in if not inline then Doc.group content else content -let print_out_type fmt out_type = - Format.pp_print_string fmt - (Doc.to_string ~width:80 (print_out_type_doc out_type)) +let printOutType fmt outType = + Format.pp_print_string fmt (Doc.toString ~width:80 (printOutTypeDoc outType)) -let print_type_parameter_doc (typ, (co, cn)) = +let printTypeParameterDoc (typ, (co, cn)) = Doc.concat [ (if not cn then Doc.text "+" else if not co then Doc.text "-" else Doc.nil); (if typ = "_" then Doc.text "_" else Doc.text ("'" ^ typ)); ] -let rec print_out_sig_item_doc ?(print_name_as_is = false) - (out_sig_item : Outcometree.out_sig_item) = - match out_sig_item with +let rec printOutSigItemDoc ?(printNameAsIs = false) + (outSigItem : Outcometree.out_sig_item) = + match outSigItem with | Osig_class _ | Osig_class_type _ -> Doc.nil | Osig_ellipsis -> Doc.dotdotdot - | Osig_value value_decl -> + | Osig_value valueDecl -> Doc.group (Doc.concat [ - print_out_attributes_doc value_decl.oval_attributes; + printOutAttributesDoc valueDecl.oval_attributes; Doc.text - (match value_decl.oval_prims with + (match valueDecl.oval_prims with | [] -> "let " | _ -> "external "); - Doc.text value_decl.oval_name; + Doc.text valueDecl.oval_name; Doc.text ":"; Doc.space; - print_out_type_doc value_decl.oval_type; - (match value_decl.oval_prims with + printOutTypeDoc valueDecl.oval_type; + (match valueDecl.oval_prims with | [] -> Doc.nil | primitives -> Doc.indent @@ -555,46 +613,46 @@ let rec print_out_sig_item_doc ?(print_name_as_is = false) primitives)); ])); ]) - | Osig_typext (out_extension_constructor, _outExtStatus) -> - print_out_extension_constructor_doc out_extension_constructor - | Osig_modtype (mod_name, Omty_signature []) -> - Doc.concat [Doc.text "module type "; Doc.text mod_name] - | Osig_modtype (mod_name, out_module_type) -> + | Osig_typext (outExtensionConstructor, _outExtStatus) -> + printOutExtensionConstructorDoc outExtensionConstructor + | Osig_modtype (modName, Omty_signature []) -> + Doc.concat [Doc.text "module type "; Doc.text modName] + | Osig_modtype (modName, outModuleType) -> Doc.group (Doc.concat [ Doc.text "module type "; - Doc.text mod_name; + Doc.text modName; Doc.text " = "; - print_out_module_type_doc out_module_type; + printOutModuleTypeDoc outModuleType; ]) - | Osig_module (mod_name, Omty_alias ident, _) -> + | Osig_module (modName, Omty_alias ident, _) -> Doc.group (Doc.concat [ Doc.text "module "; - Doc.text mod_name; + Doc.text modName; Doc.text " ="; Doc.line; - print_out_ident_doc ident; + printOutIdentDoc ident; ]) - | Osig_module (mod_name, out_mod_type, out_rec_status) -> + | Osig_module (modName, outModType, outRecStatus) -> Doc.group (Doc.concat [ Doc.text - (match out_rec_status with + (match outRecStatus with | Orec_not -> "module " | Orec_first -> "module rec " | Orec_next -> "and "); - Doc.text mod_name; + Doc.text modName; Doc.text ": "; - print_out_module_type_doc out_mod_type; + printOutModuleTypeDoc outModType; ]) - | Osig_type (out_type_decl, out_rec_status) -> + | Osig_type (outTypeDecl, outRecStatus) -> (* TODO: manifest ? *) let attrs = - match (out_type_decl.otype_immediate, out_type_decl.otype_unboxed) with + match (outTypeDecl.otype_immediate, outTypeDecl.otype_unboxed) with | false, false -> Doc.nil | true, false -> Doc.concat [Doc.text "@immediate"; Doc.line] | false, true -> Doc.concat [Doc.text "@unboxed"; Doc.line] @@ -602,60 +660,59 @@ let rec print_out_sig_item_doc ?(print_name_as_is = false) in let kw = Doc.text - (match out_rec_status with + (match outRecStatus with | Orec_not -> "type " | Orec_first -> "type rec " | Orec_next -> "and ") in - let type_params = - match out_type_decl.otype_params with + let typeParams = + match outTypeDecl.otype_params with | [] -> Doc.nil | _params -> Doc.group (Doc.concat [ - Doc.less_than; + Doc.lessThan; Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map print_type_parameter_doc - out_type_decl.otype_params); + (List.map printTypeParameterDoc outTypeDecl.otype_params); ]); - Doc.trailing_comma; - Doc.soft_line; - Doc.greater_than; + Doc.trailingComma; + Doc.softLine; + Doc.greaterThan; ]) in - let private_doc = - match out_type_decl.otype_private with + let privateDoc = + match outTypeDecl.otype_private with | Asttypes.Private -> Doc.text "private " | Public -> Doc.nil in let kind = - match out_type_decl.otype_type with - | Otyp_open -> Doc.concat [Doc.text " = "; private_doc; Doc.text ".."] + match outTypeDecl.otype_type with + | Otyp_open -> Doc.concat [Doc.text " = "; privateDoc; Doc.text ".."] | Otyp_abstract -> Doc.nil | Otyp_record record -> Doc.concat [ Doc.text " = "; - private_doc; - print_record_declaration_doc ~inline:false record; + privateDoc; + printRecordDeclarationDoc ~inline:false record; ] - | typ -> Doc.concat [Doc.text " = "; print_out_type_doc typ] + | typ -> Doc.concat [Doc.text " = "; printOutTypeDoc typ] in let constraints = - match out_type_decl.otype_cstrs with + match outTypeDecl.otype_cstrs with | [] -> Doc.nil | _ -> Doc.group (Doc.indent (Doc.concat [ - Doc.hard_line; + Doc.hardLine; Doc.join ~sep:Doc.line (List.map (fun (typ1, typ2) -> @@ -663,12 +720,12 @@ let rec print_out_sig_item_doc ?(print_name_as_is = false) (Doc.concat [ Doc.text "constraint "; - print_out_type_doc typ1; + printOutTypeDoc typ1; Doc.text " ="; Doc.space; - print_out_type_doc typ2; + printOutTypeDoc typ2; ])) - out_type_decl.otype_cstrs); + outTypeDecl.otype_cstrs); ])) in Doc.group @@ -678,26 +735,23 @@ let rec print_out_sig_item_doc ?(print_name_as_is = false) Doc.group (Doc.concat [ - attrs; kw; - (if print_name_as_is then Doc.text out_type_decl.otype_name - else - Printer.print_ident_like ~allow_uident:false - out_type_decl.otype_name); - type_params; + (if printNameAsIs then Doc.text outTypeDecl.otype_name + else printIdentLike ~allowUident:false outTypeDecl.otype_name); + typeParams; kind; ]); constraints; ]) -and print_out_module_type_doc (out_mod_type : Outcometree.out_module_type) = - match out_mod_type with +and printOutModuleTypeDoc (outModType : Outcometree.out_module_type) = + match outModType with | Omty_abstract -> Doc.nil - | Omty_ident ident -> print_out_ident_doc ident + | Omty_ident ident -> printOutIdentDoc ident (* example: module Increment = (M: X_int) => X_int *) | Omty_functor _ -> - let args, return_mod_type = collect_functor_args out_mod_type [] in - let args_doc = + let args, returnModType = collectFunctorArgs outModType [] in + let argsDoc = match args with | [(_, None)] -> Doc.text "()" | args -> @@ -708,47 +762,47 @@ and print_out_module_type_doc (out_mod_type : Outcometree.out_module_type) = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun (lbl, opt_mod_type) -> + (fun (lbl, optModType) -> Doc.group (Doc.concat [ Doc.text lbl; - (match opt_mod_type with + (match optModType with | None -> Doc.nil - | Some mod_type -> + | Some modType -> Doc.concat [ Doc.text ": "; - print_out_module_type_doc mod_type; + printOutModuleTypeDoc modType; ]); ])) args); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ]) in Doc.group (Doc.concat - [args_doc; Doc.text " => "; print_out_module_type_doc return_mod_type]) + [argsDoc; Doc.text " => "; printOutModuleTypeDoc returnModType]) | Omty_signature [] -> Doc.nil | Omty_signature signature -> - Doc.breakable_group ~force_break:true + Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.lbrace; - Doc.indent (Doc.concat [Doc.line; print_out_signature_doc signature]); - Doc.soft_line; + Doc.indent (Doc.concat [Doc.line; printOutSignatureDoc signature]); + Doc.softLine; Doc.rbrace; ]) | Omty_alias _ident -> Doc.nil -and print_out_signature_doc (signature : Outcometree.out_sig_item list) = +and printOutSignatureDoc (signature : Outcometree.out_sig_item list) = let rec loop signature acc = match signature with | [] -> List.rev acc @@ -758,13 +812,14 @@ and print_out_signature_doc (signature : Outcometree.out_sig_item list) = match items with | Outcometree.Osig_typext (ext, Oext_next) :: items -> gather_extensions - ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc) + ((ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr) + :: acc) items | _ -> (List.rev acc, items) in let exts, items = gather_extensions - [(ext.oext_name, ext.oext_args, ext.oext_ret_type)] + [(ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr)] items in let te = @@ -775,30 +830,30 @@ and print_out_signature_doc (signature : Outcometree.out_sig_item list) = otyext_private = ext.oext_private; } in - let doc = print_out_type_extension_doc te in + let doc = printOutTypeExtensionDoc te in loop items (doc :: acc) | item :: items -> - let doc = print_out_sig_item_doc ~print_name_as_is:false item in + let doc = printOutSigItemDoc ~printNameAsIs:false item in loop items (doc :: acc) in match loop signature [] with | [doc] -> doc - | docs -> Doc.breakable_group ~force_break:true (Doc.join ~sep:Doc.line docs) + | docs -> Doc.breakableGroup ~forceBreak:true (Doc.join ~sep:Doc.line docs) -and print_out_extension_constructor_doc - (out_ext : Outcometree.out_extension_constructor) = - let type_params = - match out_ext.oext_type_params with +and printOutExtensionConstructorDoc + (outExt : Outcometree.out_extension_constructor) = + let typeParams = + match outExt.oext_type_params with | [] -> Doc.nil | params -> Doc.group (Doc.concat [ - Doc.less_than; + Doc.lessThan; Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map @@ -806,8 +861,8 @@ and print_out_extension_constructor_doc Doc.text (if ty = "_" then ty else "'" ^ ty)) params); ]); - Doc.soft_line; - Doc.greater_than; + Doc.softLine; + Doc.greaterThan; ]) in @@ -815,30 +870,32 @@ and print_out_extension_constructor_doc (Doc.concat [ Doc.text "type "; - Printer.print_ident_like ~allow_uident:false out_ext.oext_type_name; - type_params; + printIdentLike ~allowUident:false outExt.oext_type_name; + typeParams; Doc.text " += "; Doc.line; - (if out_ext.oext_private = Asttypes.Private then Doc.text "private " + (if outExt.oext_private = Asttypes.Private then Doc.text "private " else Doc.nil); - print_out_constructor_doc - (out_ext.oext_name, out_ext.oext_args, out_ext.oext_ret_type); + printOutConstructorDoc + ( outExt.oext_name, + outExt.oext_args, + outExt.oext_ret_type, + outExt.oext_repr ); ]) -and print_out_type_extension_doc - (type_extension : Outcometree.out_type_extension) = - let type_params = - match type_extension.otyext_params with +and printOutTypeExtensionDoc (typeExtension : Outcometree.out_type_extension) = + let typeParams = + match typeExtension.otyext_params with | [] -> Doc.nil | params -> Doc.group (Doc.concat [ - Doc.less_than; + Doc.lessThan; Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map @@ -846,8 +903,8 @@ and print_out_type_extension_doc Doc.text (if ty = "_" then ty else "'" ^ ty)) params); ]); - Doc.soft_line; - Doc.greater_than; + Doc.softLine; + Doc.greaterThan; ]) in @@ -855,24 +912,24 @@ and print_out_type_extension_doc (Doc.concat [ Doc.text "type "; - Printer.print_ident_like ~allow_uident:false type_extension.otyext_name; - type_params; + printIdentLike ~allowUident:false typeExtension.otyext_name; + typeParams; Doc.text " += "; - (if type_extension.otyext_private = Asttypes.Private then + (if typeExtension.otyext_private = Asttypes.Private then Doc.text "private " else Doc.nil); - print_out_constructors_doc type_extension.otyext_constructors; + printOutConstructorsDoc typeExtension.otyext_constructors; ]) -let print_out_sig_item fmt out_sig_item = +let printOutSigItem fmt outSigItem = Format.pp_print_string fmt - (Doc.to_string ~width:80 (print_out_sig_item_doc out_sig_item)) + (Doc.toString ~width:80 (printOutSigItemDoc outSigItem)) -let print_out_signature fmt signature = +let printOutSignature fmt signature = Format.pp_print_string fmt - (Doc.to_string ~width:80 (print_out_signature_doc signature)) + (Doc.toString ~width:80 (printOutSignatureDoc signature)) -let valid_float_lexeme s = +let validFloatLexeme s = let l = String.length s in let rec loop i = if i >= l then s ^ "." @@ -883,7 +940,7 @@ let valid_float_lexeme s = in loop 0 -let float_repres f = +let floatRepres f = match classify_float f with | FP_nan -> "nan" | FP_infinite -> if f < 0.0 then "neg_infinity" else "infinity" @@ -896,11 +953,11 @@ let float_repres f = if f = (float_of_string [@doesNotRaise]) s2 then s2 else Printf.sprintf "%.18g" f in - valid_float_lexeme float_val + validFloatLexeme float_val -let rec print_out_value_doc (out_value : Outcometree.out_value) = - match out_value with - | Oval_array out_values -> +let rec printOutValueDoc (outValue : Outcometree.out_value) = + match outValue with + | Oval_array outValues -> Doc.group (Doc.concat [ @@ -908,32 +965,32 @@ let rec print_out_value_doc (out_value : Outcometree.out_value) = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map print_out_value_doc out_values); + (List.map printOutValueDoc outValues); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbracket; ]) | Oval_char c -> Doc.text ("'" ^ Char.escaped c ^ "'") - | Oval_constr (out_ident, out_values) -> + | Oval_constr (outIdent, outValues) -> Doc.group (Doc.concat [ - print_out_ident_doc out_ident; + printOutIdentDoc outIdent; Doc.lparen; Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map print_out_value_doc out_values); + (List.map printOutValueDoc outValues); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ]) | Oval_ellipsis -> Doc.text "..." @@ -941,8 +998,8 @@ let rec print_out_value_doc (out_value : Outcometree.out_value) = | Oval_int32 i -> Doc.text (Format.sprintf "%lil" i) | Oval_int64 i -> Doc.text (Format.sprintf "%LiL" i) | Oval_nativeint i -> Doc.text (Format.sprintf "%nin" i) - | Oval_float f -> Doc.text (float_repres f) - | Oval_list out_values -> + | Oval_float f -> Doc.text (floatRepres f) + | Oval_list outValues -> Doc.group (Doc.concat [ @@ -950,13 +1007,13 @@ let rec print_out_value_doc (out_value : Outcometree.out_value) = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map print_out_value_doc out_values); + (List.map printOutValueDoc outValues); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbracket; ]) | Oval_printer fn -> @@ -972,28 +1029,28 @@ let rec print_out_value_doc (out_value : Outcometree.out_value) = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun (out_ident, out_value) -> + (fun (outIdent, outValue) -> Doc.group (Doc.concat [ - print_out_ident_doc out_ident; + printOutIdentDoc outIdent; Doc.text ": "; - print_out_value_doc out_value; + printOutValueDoc outValue; ])) rows); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ]) | Oval_string (txt, _sizeToPrint, _kind) -> - Doc.text (escape_string_contents txt) + Doc.text (escapeStringContents txt) | Oval_stuff txt -> Doc.text txt - | Oval_tuple out_values -> + | Oval_tuple outValues -> Doc.group (Doc.concat [ @@ -1001,19 +1058,19 @@ let rec print_out_value_doc (out_value : Outcometree.out_value) = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map print_out_value_doc out_values); + (List.map printOutValueDoc outValues); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ]) (* Not supported by ReScript *) | Oval_variant _ -> Doc.nil -let print_out_exception_doc exc out_value = +let printOutExceptionDoc exc outValue = match exc with | Sys.Break -> Doc.text "Interrupted." | Out_of_memory -> Doc.text "Out of memory during evaluation." @@ -1023,9 +1080,9 @@ let print_out_exception_doc exc out_value = Doc.group (Doc.indent (Doc.concat - [Doc.text "Exception:"; Doc.line; print_out_value_doc out_value])) + [Doc.text "Exception:"; Doc.line; printOutValueDoc outValue])) -let print_out_phrase_signature signature = +let printOutPhraseSignature signature = let rec loop signature acc = match signature with | [] -> List.rev acc @@ -1035,13 +1092,14 @@ let print_out_phrase_signature signature = match items with | (Outcometree.Osig_typext (ext, Oext_next), None) :: items -> gather_extensions - ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc) + ((ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr) + :: acc) items | _ -> (List.rev acc, items) in let exts, signature = gather_extensions - [(ext.oext_name, ext.oext_args, ext.oext_ret_type)] + [(ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr)] signature in let te = @@ -1052,65 +1110,65 @@ let print_out_phrase_signature signature = otyext_private = ext.oext_private; } in - let doc = print_out_type_extension_doc te in + let doc = printOutTypeExtensionDoc te in loop signature (doc :: acc) - | (sig_item, opt_out_value) :: signature -> + | (sigItem, optOutValue) :: signature -> let doc = - match opt_out_value with - | None -> print_out_sig_item_doc sig_item - | Some out_value -> + match optOutValue with + | None -> printOutSigItemDoc sigItem + | Some outValue -> Doc.group (Doc.concat [ - print_out_sig_item_doc sig_item; + printOutSigItemDoc sigItem; Doc.text " = "; - print_out_value_doc out_value; + printOutValueDoc outValue; ]) in loop signature (doc :: acc) in - Doc.breakable_group ~force_break:true + Doc.breakableGroup ~forceBreak:true (Doc.join ~sep:Doc.line (loop signature [])) -let print_out_phrase_doc (out_phrase : Outcometree.out_phrase) = - match out_phrase with - | Ophr_eval (out_value, out_type) -> +let printOutPhraseDoc (outPhrase : Outcometree.out_phrase) = + match outPhrase with + | Ophr_eval (outValue, outType) -> Doc.group (Doc.concat [ Doc.text "- : "; - print_out_type_doc out_type; + printOutTypeDoc outType; Doc.text " ="; - Doc.indent (Doc.concat [Doc.line; print_out_value_doc out_value]); + Doc.indent (Doc.concat [Doc.line; printOutValueDoc outValue]); ]) | Ophr_signature [] -> Doc.nil - | Ophr_signature signature -> print_out_phrase_signature signature - | Ophr_exception (exc, out_value) -> print_out_exception_doc exc out_value + | Ophr_signature signature -> printOutPhraseSignature signature + | Ophr_exception (exc, outValue) -> printOutExceptionDoc exc outValue -let print_out_phrase fmt out_phrase = +let printOutPhrase fmt outPhrase = Format.pp_print_string fmt - (Doc.to_string ~width:80 (print_out_phrase_doc out_phrase)) + (Doc.toString ~width:80 (printOutPhraseDoc outPhrase)) -let print_out_module_type fmt out_module_type = +let printOutModuleType fmt outModuleType = Format.pp_print_string fmt - (Doc.to_string ~width:80 (print_out_module_type_doc out_module_type)) + (Doc.toString ~width:80 (printOutModuleTypeDoc outModuleType)) -let print_out_type_extension fmt type_extension = +let printOutTypeExtension fmt typeExtension = Format.pp_print_string fmt - (Doc.to_string ~width:80 (print_out_type_extension_doc type_extension)) + (Doc.toString ~width:80 (printOutTypeExtensionDoc typeExtension)) -let print_out_value fmt out_value = +let printOutValue fmt outValue = Format.pp_print_string fmt - (Doc.to_string ~width:80 (print_out_value_doc out_value)) + (Doc.toString ~width:80 (printOutValueDoc outValue)) (* Not supported in ReScript *) (* Oprint.out_class_type *) let setup = lazy - (Oprint.out_value := print_out_value; - Oprint.out_type := print_out_type; - Oprint.out_module_type := print_out_module_type; - Oprint.out_sig_item := print_out_sig_item; - Oprint.out_signature := print_out_signature; - Oprint.out_type_extension := print_out_type_extension; - Oprint.out_phrase := print_out_phrase) + (Oprint.out_value := printOutValue; + Oprint.out_type := printOutType; + Oprint.out_module_type := printOutModuleType; + Oprint.out_sig_item := printOutSigItem; + Oprint.out_signature := printOutSignature; + Oprint.out_type_extension := printOutTypeExtension; + Oprint.out_phrase := printOutPhrase) diff --git a/analysis/vendor/res_syntax/res_outcome_printer.mli b/analysis/vendor/res_syntax/res_outcome_printer.mli index 609644e77..c51bb0931 100644 --- a/analysis/vendor/res_syntax/res_outcome_printer.mli +++ b/analysis/vendor/res_syntax/res_outcome_printer.mli @@ -12,7 +12,7 @@ val parenthesized_ident : string -> bool [@@live] val setup : unit lazy_t [@@live] (* Needed for e.g. the playground to print typedtree data *) -val print_out_type_doc : Outcometree.out_type -> Res_doc.t [@@live] -val print_out_sig_item_doc : - ?print_name_as_is:bool -> Outcometree.out_sig_item -> Res_doc.t +val printOutTypeDoc : Outcometree.out_type -> Res_doc.t [@@live] +val printOutSigItemDoc : + ?printNameAsIs:bool -> Outcometree.out_sig_item -> Res_doc.t [@@live] diff --git a/analysis/vendor/res_syntax/res_parens.ml b/analysis/vendor/res_syntax/res_parens.ml index bf946c315..83ae636bd 100644 --- a/analysis/vendor/res_syntax/res_parens.ml +++ b/analysis/vendor/res_syntax/res_parens.ml @@ -2,9 +2,9 @@ module ParsetreeViewer = Res_parsetree_viewer type kind = Parenthesized | Braced of Location.t | Nothing let expr expr = - let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in - match opt_braces with - | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc + let optBraces, _ = ParsetreeViewer.processBracesAttr expr in + match optBraces with + | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc | _ -> ( match expr with | { @@ -15,38 +15,38 @@ let expr expr = | {pexp_desc = Pexp_constraint _} -> Parenthesized | _ -> Nothing) -let expr_record_row_rhs e = +let exprRecordRowRhs e = let kind = expr e in match kind with - | Nothing when Res_parsetree_viewer.has_optional_attribute e.pexp_attributes + | Nothing when Res_parsetree_viewer.hasOptionalAttribute e.pexp_attributes -> ( match e.pexp_desc with | Pexp_ifthenelse _ | Pexp_fun _ -> Parenthesized | _ -> kind) | _ -> kind -let call_expr expr = - let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in - match opt_braces with - | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc +let callExpr expr = + let optBraces, _ = ParsetreeViewer.processBracesAttr expr in + match optBraces with + | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc | _ -> ( match expr with | {Parsetree.pexp_attributes = attrs} - when match ParsetreeViewer.filter_parsing_attrs attrs with + when match ParsetreeViewer.filterParsingAttrs attrs with | _ :: _ -> true | [] -> false -> Parenthesized | _ - when ParsetreeViewer.is_unary_expression expr - || ParsetreeViewer.is_binary_expression expr -> + when ParsetreeViewer.isUnaryExpression expr + || ParsetreeViewer.isBinaryExpression expr -> Parenthesized | { Parsetree.pexp_desc = Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}); } -> Nothing - | {pexp_desc = Pexp_fun _} - when ParsetreeViewer.is_underscore_apply_sugar expr -> + | {pexp_desc = Pexp_fun _} when ParsetreeViewer.isUnderscoreApplySugar expr + -> Nothing | { pexp_desc = @@ -55,20 +55,20 @@ let call_expr expr = | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_ifthenelse _ ); } -> Parenthesized - | _ when Ast_uncurried.expr_is_uncurried_fun expr -> Parenthesized - | _ when ParsetreeViewer.has_await_attribute expr.pexp_attributes -> + | _ when Ast_uncurried.exprIsUncurriedFun expr -> Parenthesized + | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> Parenthesized | _ -> Nothing) -let structure_expr expr = - let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in - match opt_braces with - | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc +let structureExpr expr = + let optBraces, _ = ParsetreeViewer.processBracesAttr expr in + match optBraces with + | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc | None -> ( match expr with | _ - when ParsetreeViewer.has_attributes expr.pexp_attributes - && not (ParsetreeViewer.is_jsx_expression expr) -> + when ParsetreeViewer.hasAttributes expr.pexp_attributes + && not (ParsetreeViewer.isJsxExpression expr) -> Parenthesized | { Parsetree.pexp_desc = @@ -78,28 +78,28 @@ let structure_expr expr = | {pexp_desc = Pexp_constraint _} -> Parenthesized | _ -> Nothing) -let unary_expr_operand expr = - let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in - match opt_braces with - | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc +let unaryExprOperand expr = + let optBraces, _ = ParsetreeViewer.processBracesAttr expr in + match optBraces with + | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc | None -> ( match expr with | {Parsetree.pexp_attributes = attrs} - when match ParsetreeViewer.filter_parsing_attrs attrs with + when match ParsetreeViewer.filterParsingAttrs attrs with | _ :: _ -> true | [] -> false -> Parenthesized | expr - when ParsetreeViewer.is_unary_expression expr - || ParsetreeViewer.is_binary_expression expr -> + when ParsetreeViewer.isUnaryExpression expr + || ParsetreeViewer.isBinaryExpression expr -> Parenthesized | { pexp_desc = Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}); } -> Nothing - | {pexp_desc = Pexp_fun _} - when ParsetreeViewer.is_underscore_apply_sugar expr -> + | {pexp_desc = Pexp_fun _} when ParsetreeViewer.isUnderscoreApplySugar expr + -> Nothing | { pexp_desc = @@ -109,14 +109,19 @@ let unary_expr_operand expr = | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_ifthenelse _ ); } -> Parenthesized - | _ when ParsetreeViewer.has_await_attribute expr.pexp_attributes -> + | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> + Parenthesized + | {pexp_desc = Pexp_construct ({txt = Lident "Function$"}, Some expr)} + when ParsetreeViewer.isUnderscoreApplySugar expr -> + Nothing + | {pexp_desc = Pexp_construct ({txt = Lident "Function$"}, Some _)} -> Parenthesized | _ -> Nothing) -let binary_expr_operand ~is_lhs expr = - let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in - match opt_braces with - | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc +let binaryExprOperand ~isLhs expr = + let optBraces, _ = ParsetreeViewer.processBracesAttr expr in + match optBraces with + | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc | None -> ( match expr with | { @@ -124,83 +129,82 @@ let binary_expr_operand ~is_lhs expr = Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}); } -> Nothing - | {pexp_desc = Pexp_fun _} - when ParsetreeViewer.is_underscore_apply_sugar expr -> + | {pexp_desc = Pexp_fun _} when ParsetreeViewer.isUnderscoreApplySugar expr + -> Nothing | { pexp_desc = Pexp_constraint _ | Pexp_fun _ | Pexp_function _ | Pexp_newtype _; } -> Parenthesized - | _ when Ast_uncurried.expr_is_uncurried_fun expr -> Parenthesized - | expr when ParsetreeViewer.is_binary_expression expr -> Parenthesized - | expr when ParsetreeViewer.is_ternary_expr expr -> Parenthesized - | {pexp_desc = Pexp_lazy _ | Pexp_assert _} when is_lhs -> Parenthesized - | _ when ParsetreeViewer.has_await_attribute expr.pexp_attributes -> + | _ when Ast_uncurried.exprIsUncurriedFun expr -> Parenthesized + | expr when ParsetreeViewer.isBinaryExpression expr -> Parenthesized + | expr when ParsetreeViewer.isTernaryExpr expr -> Parenthesized + | {pexp_desc = Pexp_lazy _ | Pexp_assert _} when isLhs -> Parenthesized + | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> Parenthesized | {Parsetree.pexp_attributes = attrs} -> - if ParsetreeViewer.has_printable_attributes attrs then Parenthesized + if ParsetreeViewer.hasPrintableAttributes attrs then Parenthesized else Nothing) -let sub_binary_expr_operand parent_operator child_operator = - let prec_parent = ParsetreeViewer.operator_precedence parent_operator in - let prec_child = ParsetreeViewer.operator_precedence child_operator in - prec_parent > prec_child - || prec_parent == prec_child - && not - (ParsetreeViewer.flattenable_operators parent_operator child_operator) +let subBinaryExprOperand parentOperator childOperator = + let precParent = ParsetreeViewer.operatorPrecedence parentOperator in + let precChild = ParsetreeViewer.operatorPrecedence childOperator in + precParent > precChild + || precParent == precChild + && not (ParsetreeViewer.flattenableOperators parentOperator childOperator) || (* a && b || c, add parens to (a && b) for readability, who knows the difference by heart… *) - (parent_operator = "||" && child_operator = "&&") + (parentOperator = "||" && childOperator = "&&") -let rhs_binary_expr_operand parent_operator rhs = +let rhsBinaryExprOperand parentOperator rhs = match rhs.Parsetree.pexp_desc with | Parsetree.Pexp_apply ( { pexp_attributes = []; pexp_desc = - Pexp_ident {txt = Longident.Lident operator; loc = operator_loc}; + Pexp_ident {txt = Longident.Lident operator; loc = operatorLoc}; }, [(_, _left); (_, _right)] ) - when ParsetreeViewer.is_binary_operator operator - && not (operator_loc.loc_ghost && operator = "^") -> - let prec_parent = ParsetreeViewer.operator_precedence parent_operator in - let prec_child = ParsetreeViewer.operator_precedence operator in - prec_parent == prec_child + when ParsetreeViewer.isBinaryOperator operator + && not (operatorLoc.loc_ghost && operator = "^") -> + let precParent = ParsetreeViewer.operatorPrecedence parentOperator in + let precChild = ParsetreeViewer.operatorPrecedence operator in + precParent == precChild | _ -> false -let flatten_operand_rhs parent_operator rhs = +let flattenOperandRhs parentOperator rhs = match rhs.Parsetree.pexp_desc with | Parsetree.Pexp_apply ( { pexp_desc = - Pexp_ident {txt = Longident.Lident operator; loc = operator_loc}; + Pexp_ident {txt = Longident.Lident operator; loc = operatorLoc}; }, [(_, _left); (_, _right)] ) - when ParsetreeViewer.is_binary_operator operator - && not (operator_loc.loc_ghost && operator = "^") -> - let prec_parent = ParsetreeViewer.operator_precedence parent_operator in - let prec_child = ParsetreeViewer.operator_precedence operator in - prec_parent >= prec_child || rhs.pexp_attributes <> [] + when ParsetreeViewer.isBinaryOperator operator + && not (operatorLoc.loc_ghost && operator = "^") -> + let precParent = ParsetreeViewer.operatorPrecedence parentOperator in + let precChild = ParsetreeViewer.operatorPrecedence operator in + precParent >= precChild || rhs.pexp_attributes <> [] | Pexp_construct ({txt = Lident "Function$"}, Some _) -> true | Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}) -> false - | Pexp_fun _ when ParsetreeViewer.is_underscore_apply_sugar rhs -> false + | Pexp_fun _ when ParsetreeViewer.isUnderscoreApplySugar rhs -> false | Pexp_fun _ | Pexp_newtype _ | Pexp_setfield _ | Pexp_constraint _ -> true - | _ when ParsetreeViewer.is_ternary_expr rhs -> true + | _ when ParsetreeViewer.isTernaryExpr rhs -> true | _ -> false -let binary_operator_inside_await_needs_parens operator = - ParsetreeViewer.operator_precedence operator - < ParsetreeViewer.operator_precedence "|." +let binaryOperatorInsideAwaitNeedsParens operator = + ParsetreeViewer.operatorPrecedence operator + < ParsetreeViewer.operatorPrecedence "|." -let lazy_or_assert_or_await_expr_rhs ?(in_await = false) expr = - let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in - match opt_braces with - | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc +let lazyOrAssertOrAwaitExprRhs ?(inAwait = false) expr = + let optBraces, _ = ParsetreeViewer.processBracesAttr expr in + match optBraces with + | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc | None -> ( match expr with | {Parsetree.pexp_attributes = attrs} - when match ParsetreeViewer.filter_parsing_attrs attrs with + when match ParsetreeViewer.filterParsingAttrs attrs with | _ :: _ -> true | [] -> false -> Parenthesized @@ -208,17 +212,17 @@ let lazy_or_assert_or_await_expr_rhs ?(in_await = false) expr = pexp_desc = Pexp_apply ({pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, _); } - when ParsetreeViewer.is_binary_expression expr -> - if in_await && not (binary_operator_inside_await_needs_parens operator) - then Nothing + when ParsetreeViewer.isBinaryExpression expr -> + if inAwait && not (binaryOperatorInsideAwaitNeedsParens operator) then + Nothing else Parenthesized | { pexp_desc = Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}); } -> Nothing - | {pexp_desc = Pexp_fun _} - when ParsetreeViewer.is_underscore_apply_sugar expr -> + | {pexp_desc = Pexp_fun _} when ParsetreeViewer.isUnderscoreApplySugar expr + -> Nothing | { pexp_desc = @@ -228,44 +232,43 @@ let lazy_or_assert_or_await_expr_rhs ?(in_await = false) expr = } -> Parenthesized | _ - when (not in_await) - && ParsetreeViewer.has_await_attribute expr.pexp_attributes -> + when (not inAwait) + && ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> Parenthesized | _ -> Nothing) -let is_negative_constant constant = - let is_neg txt = +let isNegativeConstant constant = + let isNeg txt = let len = String.length txt in len > 0 && (String.get [@doesNotRaise]) txt 0 = '-' in match constant with - | (Parsetree.Pconst_integer (i, _) | Pconst_float (i, _)) when is_neg i -> - true + | (Parsetree.Pconst_integer (i, _) | Pconst_float (i, _)) when isNeg i -> true | _ -> false -let field_expr expr = - let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in - match opt_braces with - | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc +let fieldExpr expr = + let optBraces, _ = ParsetreeViewer.processBracesAttr expr in + match optBraces with + | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc | None -> ( match expr with | {Parsetree.pexp_attributes = attrs} - when match ParsetreeViewer.filter_parsing_attrs attrs with + when match ParsetreeViewer.filterParsingAttrs attrs with | _ :: _ -> true | [] -> false -> Parenthesized | expr - when ParsetreeViewer.is_binary_expression expr - || ParsetreeViewer.is_unary_expression expr -> + when ParsetreeViewer.isBinaryExpression expr + || ParsetreeViewer.isUnaryExpression expr -> Parenthesized | { pexp_desc = Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}); } -> Nothing - | {pexp_desc = Pexp_constant c} when is_negative_constant c -> Parenthesized - | {pexp_desc = Pexp_fun _} - when ParsetreeViewer.is_underscore_apply_sugar expr -> + | {pexp_desc = Pexp_constant c} when isNegativeConstant c -> Parenthesized + | {pexp_desc = Pexp_fun _} when ParsetreeViewer.isUnderscoreApplySugar expr + -> Nothing | { pexp_desc = @@ -276,14 +279,19 @@ let field_expr expr = | Pexp_ifthenelse _ ); } -> Parenthesized - | _ when ParsetreeViewer.has_await_attribute expr.pexp_attributes -> + | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> + Parenthesized + | {pexp_desc = Pexp_construct ({txt = Lident "Function$"}, Some expr)} + when ParsetreeViewer.isUnderscoreApplySugar expr -> + Nothing + | {pexp_desc = Pexp_construct ({txt = Lident "Function$"}, Some _)} -> Parenthesized | _ -> Nothing) -let set_field_expr_rhs expr = - let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in - match opt_braces with - | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc +let setFieldExprRhs expr = + let optBraces, _ = ParsetreeViewer.processBracesAttr expr in + match optBraces with + | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc | None -> ( match expr with | { @@ -294,10 +302,10 @@ let set_field_expr_rhs expr = | {pexp_desc = Pexp_constraint _} -> Parenthesized | _ -> Nothing) -let ternary_operand expr = - let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in - match opt_braces with - | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc +let ternaryOperand expr = + let optBraces, _ = ParsetreeViewer.processBracesAttr expr in + match optBraces with + | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc | None -> ( match expr with | { @@ -306,31 +314,31 @@ let ternary_operand expr = } -> Nothing | {pexp_desc = Pexp_constraint _} -> Parenthesized - | _ when Res_parsetree_viewer.is_fun_newtype expr -> ( - let _uncurried, _attrsOnArrow, _parameters, return_expr = - ParsetreeViewer.fun_expr expr + | _ when Res_parsetree_viewer.isFunNewtype expr -> ( + let _uncurried, _attrsOnArrow, _parameters, returnExpr = + ParsetreeViewer.funExpr expr in - match return_expr.pexp_desc with + match returnExpr.pexp_desc with | Pexp_constraint _ -> Parenthesized | _ -> Nothing) | _ -> Nothing) -let starts_with_minus txt = +let startsWithMinus txt = let len = String.length txt in if len == 0 then false else let s = (String.get [@doesNotRaise]) txt 0 in s = '-' -let jsx_prop_expr expr = +let jsxPropExpr expr = match expr.Parsetree.pexp_desc with | Parsetree.Pexp_let _ | Pexp_sequence _ | Pexp_letexception _ | Pexp_letmodule _ | Pexp_open _ -> Nothing | _ -> ( - let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in - match opt_braces with - | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc + let optBraces, _ = ParsetreeViewer.processBracesAttr expr in + match optBraces with + | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc | None -> ( match expr with | { @@ -338,9 +346,9 @@ let jsx_prop_expr expr = Pexp_constant (Pconst_integer (x, _) | Pconst_float (x, _)); pexp_attributes = []; } - when starts_with_minus x -> + when startsWithMinus x -> Parenthesized - | _ when ParsetreeViewer.has_await_attribute expr.pexp_attributes -> + | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> Parenthesized | { Parsetree.pexp_desc = @@ -360,15 +368,15 @@ let jsx_prop_expr expr = Nothing | _ -> Parenthesized)) -let jsx_child_expr expr = +let jsxChildExpr expr = match expr.Parsetree.pexp_desc with | Parsetree.Pexp_let _ | Pexp_sequence _ | Pexp_letexception _ | Pexp_letmodule _ | Pexp_open _ -> Nothing | _ -> ( - let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in - match opt_braces with - | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc + let optBraces, _ = ParsetreeViewer.processBracesAttr expr in + match optBraces with + | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc | _ -> ( match expr with | { @@ -376,9 +384,9 @@ let jsx_child_expr expr = Pexp_constant (Pconst_integer (x, _) | Pconst_float (x, _)); pexp_attributes = []; } - when starts_with_minus x -> + when startsWithMinus x -> Parenthesized - | _ when ParsetreeViewer.has_await_attribute expr.pexp_attributes -> + | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> Parenthesized | { Parsetree.pexp_desc = @@ -396,22 +404,22 @@ let jsx_child_expr expr = pexp_attributes = []; } -> Nothing - | expr when ParsetreeViewer.is_jsx_expression expr -> Nothing + | expr when ParsetreeViewer.isJsxExpression expr -> Nothing | _ -> Parenthesized)) -let binary_expr expr = - let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in - match opt_braces with - | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc +let binaryExpr expr = + let optBraces, _ = ParsetreeViewer.processBracesAttr expr in + match optBraces with + | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc | None -> ( match expr with | {Parsetree.pexp_attributes = _ :: _} as expr - when ParsetreeViewer.is_binary_expression expr -> + when ParsetreeViewer.isBinaryExpression expr -> Parenthesized | _ -> Nothing) -let mod_type_functor_return mod_type = - match mod_type with +let modTypeFunctorReturn modType = + match modType with | {Parsetree.pmty_desc = Pmty_with _} -> true | _ -> false @@ -420,35 +428,52 @@ let mod_type_functor_return mod_type = This is actually: module type Functor = (SetLike => Set) with type t = A.t *) -let mod_type_with_operand mod_type = - match mod_type with +let modTypeWithOperand modType = + match modType with | {Parsetree.pmty_desc = Pmty_functor _ | Pmty_with _} -> true | _ -> false -let mod_expr_functor_constraint mod_type = - match mod_type with +let modExprFunctorConstraint modType = + match modType with | {Parsetree.pmty_desc = Pmty_functor _ | Pmty_with _} -> true | _ -> false -let braced_expr expr = +let bracedExpr expr = match expr.Parsetree.pexp_desc with | Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}) -> false | Pexp_constraint _ -> true | _ -> false -let include_mod_expr mod_expr = - match mod_expr.Parsetree.pmod_desc with +let includeModExpr modExpr = + match modExpr.Parsetree.pmod_desc with | Parsetree.Pmod_constraint _ -> true | _ -> false -let arrow_return_typ_expr typ_expr = - match typ_expr.Parsetree.ptyp_desc with +let modExprParens modExpr = + match modExpr with + | { + Parsetree.pmod_desc = + Pmod_constraint + ( {Parsetree.pmod_desc = Pmod_structure _}, + {Parsetree.pmty_desc = Pmty_signature [{psig_desc = Psig_module _}]} ); + } -> + false + | { + Parsetree.pmod_desc = + Pmod_constraint + (_, {Parsetree.pmty_desc = Pmty_signature [{psig_desc = Psig_module _}]}); + } -> + true + | _ -> false + +let arrowReturnTypExpr typExpr = + match typExpr.Parsetree.ptyp_desc with | Parsetree.Ptyp_arrow _ -> true - | _ when Ast_uncurried.core_type_is_uncurried_fun typ_expr -> true + | _ when Ast_uncurried.coreTypeIsUncurriedFun typExpr -> true | _ -> false -let pattern_record_row_rhs (pattern : Parsetree.pattern) = +let patternRecordRowRhs (pattern : Parsetree.pattern) = match pattern.ppat_desc with | Ppat_constraint ({ppat_desc = Ppat_unpack _}, {ptyp_desc = Ptyp_package _}) -> diff --git a/analysis/vendor/res_syntax/res_parens.mli b/analysis/vendor/res_syntax/res_parens.mli index 28e35a634..5d1abf9e1 100644 --- a/analysis/vendor/res_syntax/res_parens.mli +++ b/analysis/vendor/res_syntax/res_parens.mli @@ -1,40 +1,41 @@ type kind = Parenthesized | Braced of Location.t | Nothing val expr : Parsetree.expression -> kind -val structure_expr : Parsetree.expression -> kind +val structureExpr : Parsetree.expression -> kind -val unary_expr_operand : Parsetree.expression -> kind +val unaryExprOperand : Parsetree.expression -> kind -val binary_expr_operand : is_lhs:bool -> Parsetree.expression -> kind -val sub_binary_expr_operand : string -> string -> bool -val rhs_binary_expr_operand : string -> Parsetree.expression -> bool -val flatten_operand_rhs : string -> Parsetree.expression -> bool +val binaryExprOperand : isLhs:bool -> Parsetree.expression -> kind +val subBinaryExprOperand : string -> string -> bool +val rhsBinaryExprOperand : string -> Parsetree.expression -> bool +val flattenOperandRhs : string -> Parsetree.expression -> bool -val binary_operator_inside_await_needs_parens : string -> bool -val lazy_or_assert_or_await_expr_rhs : - ?in_await:bool -> Parsetree.expression -> kind +val binaryOperatorInsideAwaitNeedsParens : string -> bool +val lazyOrAssertOrAwaitExprRhs : ?inAwait:bool -> Parsetree.expression -> kind -val field_expr : Parsetree.expression -> kind +val fieldExpr : Parsetree.expression -> kind -val set_field_expr_rhs : Parsetree.expression -> kind +val setFieldExprRhs : Parsetree.expression -> kind -val ternary_operand : Parsetree.expression -> kind +val ternaryOperand : Parsetree.expression -> kind -val jsx_prop_expr : Parsetree.expression -> kind -val jsx_child_expr : Parsetree.expression -> kind +val jsxPropExpr : Parsetree.expression -> kind +val jsxChildExpr : Parsetree.expression -> kind -val binary_expr : Parsetree.expression -> kind -val mod_type_functor_return : Parsetree.module_type -> bool -val mod_type_with_operand : Parsetree.module_type -> bool -val mod_expr_functor_constraint : Parsetree.module_type -> bool +val binaryExpr : Parsetree.expression -> kind +val modTypeFunctorReturn : Parsetree.module_type -> bool +val modTypeWithOperand : Parsetree.module_type -> bool +val modExprFunctorConstraint : Parsetree.module_type -> bool -val braced_expr : Parsetree.expression -> bool -val call_expr : Parsetree.expression -> kind +val bracedExpr : Parsetree.expression -> bool +val callExpr : Parsetree.expression -> kind -val include_mod_expr : Parsetree.module_expr -> bool +val includeModExpr : Parsetree.module_expr -> bool -val arrow_return_typ_expr : Parsetree.core_type -> bool +val modExprParens : Parsetree.module_expr -> bool -val pattern_record_row_rhs : Parsetree.pattern -> bool +val arrowReturnTypExpr : Parsetree.core_type -> bool -val expr_record_row_rhs : Parsetree.expression -> kind +val patternRecordRowRhs : Parsetree.pattern -> bool + +val exprRecordRowRhs : Parsetree.expression -> kind diff --git a/analysis/vendor/res_syntax/res_parser.ml b/analysis/vendor/res_syntax/res_parser.ml index 424629092..ca39cfcf8 100644 --- a/analysis/vendor/res_syntax/res_parser.ml +++ b/analysis/vendor/res_syntax/res_parser.ml @@ -8,54 +8,54 @@ module Comment = Res_comment type mode = ParseForTypeChecker | Default -type region_status = Report | Silent +type regionStatus = Report | Silent type t = { mode: mode; mutable scanner: Scanner.t; mutable token: Token.t; - mutable start_pos: Lexing.position; - mutable end_pos: Lexing.position; - mutable prev_end_pos: Lexing.position; + mutable startPos: Lexing.position; + mutable endPos: Lexing.position; + mutable prevEndPos: Lexing.position; mutable breadcrumbs: (Grammar.t * Lexing.position) list; - mutable errors: Reporting.parse_error list; + mutable errors: Reporting.parseError list; mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; - mutable regions: region_status ref list; + mutable regions: regionStatus ref list; mutable uncurried_config: Config.uncurried; } -let err ?start_pos ?end_pos p error = +let err ?startPos ?endPos p error = match p.regions with | ({contents = Report} as region) :: _ -> let d = Diagnostics.make - ~start_pos: - (match start_pos with + ~startPos: + (match startPos with | Some pos -> pos - | None -> p.start_pos) - ~end_pos: - (match end_pos with + | None -> p.startPos) + ~endPos: + (match endPos with | Some pos -> pos - | None -> p.end_pos) + | None -> p.endPos) error in p.diagnostics <- d :: p.diagnostics; region := Silent | _ -> () -let begin_region p = p.regions <- ref Report :: p.regions -let end_region p = +let beginRegion p = p.regions <- ref Report :: p.regions +let endRegion p = match p.regions with | [] -> () | _ :: rest -> p.regions <- rest -let doc_comment_to_attribute_token comment = +let docCommentToAttributeToken comment = let txt = Comment.txt comment in let loc = Comment.loc comment in Token.DocComment (loc, txt) -let module_comment_to_attribute_token comment = +let moduleCommentToAttributeToken comment = let txt = Comment.txt comment in let loc = Comment.loc comment in Token.ModuleComment (loc, txt) @@ -63,62 +63,60 @@ let module_comment_to_attribute_token comment = (* Advance to the next non-comment token and store any encountered comment * in the parser's state. Every comment contains the end position of its * previous token to facilite comment interleaving *) -let rec next ?prev_end_pos p = +let rec next ?prevEndPos p = if p.token = Eof then assert false; - let prev_end_pos = - match prev_end_pos with + let prevEndPos = + match prevEndPos with | Some pos -> pos - | None -> p.end_pos + | None -> p.endPos in - let start_pos, end_pos, token = Scanner.scan p.scanner in + let startPos, endPos, token = Scanner.scan p.scanner in match token with | Comment c -> - if Comment.is_doc_comment c then ( - p.token <- doc_comment_to_attribute_token c; - p.prev_end_pos <- prev_end_pos; - p.start_pos <- start_pos; - p.end_pos <- end_pos) - else if Comment.is_module_comment c then ( - p.token <- module_comment_to_attribute_token c; - p.prev_end_pos <- prev_end_pos; - p.start_pos <- start_pos; - p.end_pos <- end_pos) + if Comment.isDocComment c then ( + p.token <- docCommentToAttributeToken c; + p.prevEndPos <- prevEndPos; + p.startPos <- startPos; + p.endPos <- endPos) + else if Comment.isModuleComment c then ( + p.token <- moduleCommentToAttributeToken c; + p.prevEndPos <- prevEndPos; + p.startPos <- startPos; + p.endPos <- endPos) else ( - Comment.set_prev_tok_end_pos c p.end_pos; + Comment.setPrevTokEndPos c p.endPos; p.comments <- c :: p.comments; - p.prev_end_pos <- p.end_pos; - p.end_pos <- end_pos; - next ~prev_end_pos p) + p.prevEndPos <- p.endPos; + p.endPos <- endPos; + next ~prevEndPos p) | _ -> p.token <- token; - p.prev_end_pos <- prev_end_pos; - p.start_pos <- start_pos; - p.end_pos <- end_pos + p.prevEndPos <- prevEndPos; + p.startPos <- startPos; + p.endPos <- endPos -let next_unsafe p = if p.token <> Eof then next p +let nextUnsafe p = if p.token <> Eof then next p -let next_template_literal_token p = - let start_pos, end_pos, token = - Scanner.scan_template_literal_token p.scanner - in +let nextTemplateLiteralToken p = + let startPos, endPos, token = Scanner.scanTemplateLiteralToken p.scanner in p.token <- token; - p.prev_end_pos <- p.end_pos; - p.start_pos <- start_pos; - p.end_pos <- end_pos + p.prevEndPos <- p.endPos; + p.startPos <- startPos; + p.endPos <- endPos -let check_progress ~prev_end_pos ~result p = - if p.end_pos == prev_end_pos then None else Some result +let checkProgress ~prevEndPos ~result p = + if p.endPos == prevEndPos then None else Some result let make ?(mode = ParseForTypeChecker) src filename = let scanner = Scanner.make ~filename src in - let parser_state = + let parserState = { mode; scanner; token = Token.Semicolon; - start_pos = Lexing.dummy_pos; - prev_end_pos = Lexing.dummy_pos; - end_pos = Lexing.dummy_pos; + startPos = Lexing.dummy_pos; + prevEndPos = Lexing.dummy_pos; + endPos = Lexing.dummy_pos; breadcrumbs = []; errors = []; diagnostics = []; @@ -127,18 +125,18 @@ let make ?(mode = ParseForTypeChecker) src filename = uncurried_config = !Config.uncurried; } in - parser_state.scanner.err <- - (fun ~start_pos ~end_pos error -> - let diagnostic = Diagnostics.make ~start_pos ~end_pos error in - parser_state.diagnostics <- diagnostic :: parser_state.diagnostics); - next parser_state; - parser_state - -let leave_breadcrumb p circumstance = - let crumb = (circumstance, p.start_pos) in + parserState.scanner.err <- + (fun ~startPos ~endPos error -> + let diagnostic = Diagnostics.make ~startPos ~endPos error in + parserState.diagnostics <- diagnostic :: parserState.diagnostics); + next parserState; + parserState + +let leaveBreadcrumb p circumstance = + let crumb = (circumstance, p.startPos) in p.breadcrumbs <- crumb :: p.breadcrumbs -let eat_breadcrumb p = +let eatBreadcrumb p = match p.breadcrumbs with | [] -> () | _ :: crumbs -> p.breadcrumbs <- crumbs @@ -152,8 +150,8 @@ let optional p token = let expect ?grammar token p = if p.token = token then next p else - let error = Diagnostics.expected ?grammar p.prev_end_pos token in - err ~start_pos:p.prev_end_pos p error + let error = Diagnostics.expected ?grammar p.prevEndPos token in + err ~startPos:p.prevEndPos p error (* Don't use immutable copies here, it trashes certain heuristics * in the ocaml compiler, resulting in massive slowdowns of the parser *) @@ -162,13 +160,13 @@ let lookahead p callback = let ch = p.scanner.ch in let offset = p.scanner.offset in let offset16 = p.scanner.offset16 in - let line_offset = p.scanner.line_offset in + let lineOffset = p.scanner.lineOffset in let lnum = p.scanner.lnum in let mode = p.scanner.mode in let token = p.token in - let start_pos = p.start_pos in - let end_pos = p.end_pos in - let prev_end_pos = p.prev_end_pos in + let startPos = p.startPos in + let endPos = p.endPos in + let prevEndPos = p.prevEndPos in let breadcrumbs = p.breadcrumbs in let errors = p.errors in let diagnostics = p.diagnostics in @@ -181,13 +179,13 @@ let lookahead p callback = p.scanner.ch <- ch; p.scanner.offset <- offset; p.scanner.offset16 <- offset16; - p.scanner.line_offset <- line_offset; + p.scanner.lineOffset <- lineOffset; p.scanner.lnum <- lnum; p.scanner.mode <- mode; p.token <- token; - p.start_pos <- start_pos; - p.end_pos <- end_pos; - p.prev_end_pos <- prev_end_pos; + p.startPos <- startPos; + p.endPos <- endPos; + p.prevEndPos <- prevEndPos; p.breadcrumbs <- breadcrumbs; p.errors <- errors; p.diagnostics <- diagnostics; diff --git a/analysis/vendor/res_syntax/res_parser.mli b/analysis/vendor/res_syntax/res_parser.mli index 9e1c73381..9544a7cc2 100644 --- a/analysis/vendor/res_syntax/res_parser.mli +++ b/analysis/vendor/res_syntax/res_parser.mli @@ -7,20 +7,20 @@ module Comment = Res_comment type mode = ParseForTypeChecker | Default -type region_status = Report | Silent +type regionStatus = Report | Silent type t = { mode: mode; mutable scanner: Scanner.t; mutable token: Token.t; - mutable start_pos: Lexing.position; - mutable end_pos: Lexing.position; - mutable prev_end_pos: Lexing.position; + mutable startPos: Lexing.position; + mutable endPos: Lexing.position; + mutable prevEndPos: Lexing.position; mutable breadcrumbs: (Grammar.t * Lexing.position) list; - mutable errors: Reporting.parse_error list; + mutable errors: Reporting.parseError list; mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; - mutable regions: region_status ref list; + mutable regions: regionStatus ref list; mutable uncurried_config: Config.uncurried; } @@ -28,21 +28,21 @@ val make : ?mode:mode -> string -> string -> t val expect : ?grammar:Grammar.t -> Token.t -> t -> unit val optional : t -> Token.t -> bool -val next : ?prev_end_pos:Lexing.position -> t -> unit -val next_unsafe : t -> unit (* Does not assert on Eof, makes no progress *) -val next_template_literal_token : t -> unit +val next : ?prevEndPos:Lexing.position -> t -> unit +val nextUnsafe : t -> unit (* Does not assert on Eof, makes no progress *) +val nextTemplateLiteralToken : t -> unit val lookahead : t -> (t -> 'a) -> 'a val err : - ?start_pos:Lexing.position -> - ?end_pos:Lexing.position -> + ?startPos:Lexing.position -> + ?endPos:Lexing.position -> t -> Diagnostics.category -> unit -val leave_breadcrumb : t -> Grammar.t -> unit -val eat_breadcrumb : t -> unit +val leaveBreadcrumb : t -> Grammar.t -> unit +val eatBreadcrumb : t -> unit -val begin_region : t -> unit -val end_region : t -> unit +val beginRegion : t -> unit +val endRegion : t -> unit -val check_progress : prev_end_pos:Lexing.position -> result:'a -> t -> 'a option +val checkProgress : prevEndPos:Lexing.position -> result:'a -> t -> 'a option diff --git a/analysis/vendor/res_syntax/res_parsetree_viewer.ml b/analysis/vendor/res_syntax/res_parsetree_viewer.ml index 35e02d872..9d8d5948a 100644 --- a/analysis/vendor/res_syntax/res_parsetree_viewer.ml +++ b/analysis/vendor/res_syntax/res_parsetree_viewer.ml @@ -1,33 +1,33 @@ open Parsetree -let arrow_type ?(arity = max_int) ct = - let rec process attrs_before acc typ arity = +let arrowType ?(arity = max_int) ct = + let rec process attrsBefore acc typ arity = match typ with - | typ when arity <= 0 -> (attrs_before, List.rev acc, typ) + | typ when arity <= 0 -> (attrsBefore, List.rev acc, typ) | { ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2); ptyp_attributes = []; } -> let arg = ([], lbl, typ1) in - process attrs_before (arg :: acc) typ2 (arity - 1) + process attrsBefore (arg :: acc) typ2 (arity - 1) | { ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); 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) + (attrsBefore, List.rev acc, typ) | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = _attrs} - as return_type -> + as returnType -> let args = List.rev acc in - (attrs_before, args, return_type) + (attrsBefore, args, returnType) | { ptyp_desc = Ptyp_arrow (((Labelled _ | Optional _) as lbl), typ1, typ2); ptyp_attributes = attrs; } -> let arg = (attrs, lbl, typ1) in - process attrs_before (arg :: acc) typ2 (arity - 1) - | typ -> (attrs_before, List.rev acc, typ) + process attrsBefore (arg :: acc) typ2 (arity - 1) + | typ -> (attrsBefore, List.rev acc, typ) in match ct with | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as @@ -35,32 +35,32 @@ let arrow_type ?(arity = max_int) ct = process attrs [] {typ with ptyp_attributes = []} arity | typ -> process [] [] typ arity -let functor_type modtype = +let functorType modtype = let rec process acc modtype = match modtype with | { - pmty_desc = Pmty_functor (lbl, arg_type, return_type); + pmty_desc = Pmty_functor (lbl, argType, returnType); pmty_attributes = attrs; } -> - let arg = (attrs, lbl, arg_type) in - process (arg :: acc) return_type - | mod_type -> (List.rev acc, mod_type) + let arg = (attrs, lbl, argType) in + process (arg :: acc) returnType + | modType -> (List.rev acc, modType) in process [] modtype -let process_bs_attribute attrs = - let rec process bs_spotted acc attrs = +let processBsAttribute attrs = + let rec process bsSpotted acc attrs = match attrs with - | [] -> (bs_spotted, List.rev acc) + | [] -> (bsSpotted, List.rev acc) | ({Location.txt = "bs"}, _) :: rest -> process true acc rest - | attr :: rest -> process bs_spotted (attr :: acc) rest + | attr :: rest -> process bsSpotted (attr :: acc) rest in process false [] attrs -let process_uncurried_app_attribute attrs = - let rec process uncurried_app acc attrs = +let processUncurriedAppAttribute attrs = + let rec process uncurriedApp acc attrs = match attrs with - | [] -> (uncurried_app, List.rev acc) + | [] -> (uncurriedApp, List.rev acc) | ( { Location.txt = "bs" (* still support @bs to convert .ml files *) | "res.uapp"; @@ -68,26 +68,33 @@ let process_uncurried_app_attribute attrs = _ ) :: rest -> process true acc rest - | attr :: rest -> process uncurried_app (attr :: acc) rest + | attr :: rest -> process uncurriedApp (attr :: acc) rest in process false [] attrs -let process_partial_app_attribute attrs = - let rec process partial_app acc attrs = +let hasPartialAttribute attrs = + List.exists + (function + | {Location.txt = "res.partial"}, _ -> true + | _ -> false) + attrs + +let processPartialAppAttribute attrs = + let rec process partialApp acc attrs = match attrs with - | [] -> (partial_app, List.rev acc) + | [] -> (partialApp, List.rev acc) | ({Location.txt = "res.partial"}, _) :: rest -> process true acc rest - | attr :: rest -> process partial_app (attr :: acc) rest + | attr :: rest -> process partialApp (attr :: acc) rest in process false [] attrs -type function_attributes_info = { +type functionAttributesInfo = { async: bool; bs: bool; attributes: Parsetree.attributes; } -let process_function_attributes attrs = +let processFunctionAttributes attrs = let rec process async bs acc attrs = match attrs with | [] -> {async; bs; attributes = List.rev acc} @@ -97,19 +104,19 @@ let process_function_attributes attrs = in process false false [] attrs -let has_await_attribute attrs = +let hasAwaitAttribute attrs = List.exists (function | {Location.txt = "res.await"}, _ -> true | _ -> false) attrs -let collect_array_expressions expr = +let collectArrayExpressions expr = match expr.pexp_desc with | Pexp_array exprs -> (exprs, None) | _ -> ([], Some expr) -let collect_list_expressions expr = +let collectListExpressions expr = let rec collect acc expr = match expr.pexp_desc with | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> (List.rev acc, None) @@ -122,10 +129,10 @@ let collect_list_expressions expr = collect [] expr (* (__x) => f(a, __x, c) -----> f(a, _, c) *) -let rewrite_underscore_apply expr = +let rewriteUnderscoreApply expr = let expr_fun = - if Ast_uncurried.expr_is_uncurried_fun expr then - Ast_uncurried.expr_extract_uncurried_fun expr + if Ast_uncurried.exprIsUncurriedFun expr then + Ast_uncurried.exprExtractUncurriedFun expr else expr in match expr_fun.pexp_desc with @@ -133,44 +140,44 @@ let rewrite_underscore_apply expr = ( Nolabel, None, {ppat_desc = Ppat_var {txt = "__x"}}, - ({pexp_desc = Pexp_apply (call_expr, args)} as e) ) -> - let new_args = + ({pexp_desc = Pexp_apply (callExpr, args)} as e) ) -> + let newArgs = List.map (fun arg -> match arg with | ( lbl, ({pexp_desc = Pexp_ident ({txt = Longident.Lident "__x"} as lid)} - as arg_expr) ) -> + as argExpr) ) -> ( lbl, { - arg_expr with + argExpr with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "_"}; } ) | arg -> arg) args in - {e with pexp_desc = Pexp_apply (call_expr, new_args)} + {e with pexp_desc = Pexp_apply (callExpr, newArgs)} | _ -> expr -type fun_param_kind = +type funParamKind = | Parameter of { attrs: Parsetree.attributes; lbl: Asttypes.arg_label; - default_expr: Parsetree.expression option; + defaultExpr: Parsetree.expression option; pat: Parsetree.pattern; } | NewTypes of {attrs: Parsetree.attributes; locs: string Asttypes.loc list} -let fun_expr expr = +let funExpr expr = (* Turns (type t, type u, type z) into "type t u z" *) - let rec collect_new_types acc return_expr = - match return_expr with - | {pexp_desc = Pexp_newtype (string_loc, return_expr); pexp_attributes = []} + let rec collectNewTypes acc returnExpr = + match returnExpr with + | {pexp_desc = Pexp_newtype (stringLoc, returnExpr); pexp_attributes = []} -> - collect_new_types (string_loc :: acc) return_expr - | return_expr -> (List.rev acc, return_expr) + collectNewTypes (stringLoc :: acc) returnExpr + | returnExpr -> (List.rev acc, returnExpr) in - let rec collect ~uncurried ~n_fun attrs_before acc expr = + let rec collect ~uncurried ~nFun attrsBefore acc expr = match expr with | { pexp_desc = @@ -180,45 +187,43 @@ let fun_expr expr = {ppat_desc = Ppat_var {txt = "__x"}}, {pexp_desc = Pexp_apply _} ); } -> - (uncurried, attrs_before, List.rev acc, rewrite_underscore_apply expr) - | {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs} -> - let string_locs, return_expr = collect_new_types [string_loc] rest in - let param = NewTypes {attrs; locs = string_locs} in - collect ~uncurried ~n_fun attrs_before (param :: acc) return_expr + (uncurried, attrsBefore, List.rev acc, rewriteUnderscoreApply expr) + | {pexp_desc = Pexp_newtype (stringLoc, rest); pexp_attributes = attrs} -> + let stringLocs, returnExpr = collectNewTypes [stringLoc] rest in + let param = NewTypes {attrs; locs = stringLocs} in + collect ~uncurried ~nFun attrsBefore (param :: acc) returnExpr | { - pexp_desc = Pexp_fun (lbl, default_expr, pattern, return_expr); + pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); pexp_attributes = []; } -> - let parameter = - Parameter {attrs = []; lbl; default_expr; pat = pattern} - in - collect ~uncurried ~n_fun:(n_fun + 1) attrs_before (parameter :: acc) - return_expr + let parameter = Parameter {attrs = []; lbl; defaultExpr; pat = pattern} in + collect ~uncurried ~nFun:(nFun + 1) attrsBefore (parameter :: acc) + returnExpr (* If a fun has an attribute, then it stops here and makes currying. i.e attributes outside of (...), uncurried `(.)` and `async` make currying *) - | {pexp_desc = Pexp_fun _} -> (uncurried, attrs_before, List.rev acc, expr) - | expr when n_fun = 0 && Ast_uncurried.expr_is_uncurried_fun expr -> - let expr = Ast_uncurried.expr_extract_uncurried_fun expr in - collect ~uncurried:true ~n_fun attrs_before acc expr - | expr -> (uncurried, attrs_before, List.rev acc, expr) + | {pexp_desc = Pexp_fun _} -> (uncurried, attrsBefore, List.rev acc, expr) + | expr when nFun = 0 && Ast_uncurried.exprIsUncurriedFun expr -> + let expr = Ast_uncurried.exprExtractUncurriedFun expr in + collect ~uncurried:true ~nFun attrsBefore acc expr + | expr -> (uncurried, attrsBefore, List.rev acc, expr) in match expr with | {pexp_desc = Pexp_fun _ | Pexp_newtype _} -> - collect ~uncurried:false ~n_fun:0 expr.pexp_attributes [] + collect ~uncurried:false ~nFun:0 expr.pexp_attributes [] {expr with pexp_attributes = []} - | _ when Ast_uncurried.expr_is_uncurried_fun expr -> - let expr = Ast_uncurried.expr_extract_uncurried_fun expr in - collect ~uncurried:true ~n_fun:0 expr.pexp_attributes [] + | _ when Ast_uncurried.exprIsUncurriedFun expr -> + let expr = Ast_uncurried.exprExtractUncurriedFun expr in + collect ~uncurried:true ~nFun:0 expr.pexp_attributes [] {expr with pexp_attributes = []} - | _ -> collect ~uncurried:false ~n_fun:0 [] [] expr + | _ -> collect ~uncurried:false ~nFun:0 [] [] expr -let process_braces_attr expr = +let processBracesAttr expr = match expr.pexp_attributes with | (({txt = "res.braces" | "ns.braces"}, _) as attr) :: attrs -> (Some attr, {expr with pexp_attributes = attrs}) | _ -> (None, expr) -let filter_parsing_attrs attrs = +let filterParsingAttrs attrs = List.filter (fun attr -> match attr with @@ -234,19 +239,19 @@ let filter_parsing_attrs attrs = | _ -> true) attrs -let is_block_expr expr = +let isBlockExpr expr = match expr.pexp_desc with | Pexp_letmodule _ | Pexp_letexception _ | Pexp_let _ | Pexp_open _ | Pexp_sequence _ -> true | _ -> false -let is_braced_expr expr = - match process_braces_attr expr with +let isBracedExpr expr = + match processBracesAttr expr with | Some _, _ -> true | _ -> false -let is_multiline_text txt = +let isMultilineText txt = let len = String.length txt in let rec check i = if i >= len then false @@ -259,36 +264,36 @@ let is_multiline_text txt = in check 0 -let is_huggable_expression expr = +let isHuggableExpression expr = match expr.pexp_desc with | Pexp_array _ | Pexp_tuple _ | Pexp_constant (Pconst_string (_, Some _)) | Pexp_construct ({txt = Longident.Lident ("::" | "[]")}, _) - | Pexp_extension ({txt = "obj"}, _) + | Pexp_extension ({txt = "bs.obj" | "obj"}, _) | Pexp_record _ -> true - | _ when is_block_expr expr -> true - | _ when is_braced_expr expr -> true - | Pexp_constant (Pconst_string (txt, None)) when is_multiline_text txt -> true + | _ when isBlockExpr expr -> true + | _ when isBracedExpr expr -> true + | Pexp_constant (Pconst_string (txt, None)) when isMultilineText txt -> true | _ -> false -let is_huggable_rhs expr = +let isHuggableRhs expr = match expr.pexp_desc with | Pexp_array _ | Pexp_tuple _ - | Pexp_extension ({txt = "obj"}, _) + | Pexp_extension ({txt = "bs.obj" | "obj"}, _) | Pexp_record _ -> true - | _ when is_braced_expr expr -> true + | _ when isBracedExpr expr -> true | _ -> false -let is_huggable_pattern pattern = +let isHuggablePattern pattern = match pattern.ppat_desc with | Ppat_array _ | Ppat_tuple _ | Ppat_record _ | Ppat_variant _ | Ppat_construct _ -> true | _ -> false -let operator_precedence operator = +let operatorPrecedence operator = match operator with | ":=" -> 1 | "||" -> 2 @@ -300,22 +305,22 @@ let operator_precedence operator = | "#" | "##" | "|." | "|.u" -> 8 | _ -> 0 -let is_unary_operator operator = +let isUnaryOperator operator = match operator with | "~+" | "~+." | "~-" | "~-." | "not" -> true | _ -> false -let is_unary_expression expr = +let isUnaryExpression expr = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, _arg)] ) - when is_unary_operator operator -> + when isUnaryOperator operator -> true | _ -> false (* TODO: tweak this to check for ghost ^ as template literal *) -let is_binary_operator operator = +let isBinaryOperator operator = match operator with | ":=" | "||" | "&&" | "=" | "==" | "<" | ">" | "!=" | "!==" | "<=" | ">=" | "|>" | "+" | "+." | "-" | "-." | "^" | "*" | "*." | "/" | "/." | "**" | "|." @@ -323,59 +328,57 @@ let is_binary_operator operator = true | _ -> false -let is_binary_expression expr = +let isBinaryExpression expr = match expr.pexp_desc with | Pexp_apply ( { pexp_desc = - Pexp_ident {txt = Longident.Lident operator; loc = operator_loc}; + Pexp_ident {txt = Longident.Lident operator; loc = operatorLoc}; }, [(Nolabel, _operand1); (Nolabel, _operand2)] ) - when is_binary_operator operator - && not (operator_loc.loc_ghost && operator = "^") + when isBinaryOperator operator + && not (operatorLoc.loc_ghost && operator = "^") (* template literal *) -> true | _ -> false -let is_equality_operator operator = +let isEqualityOperator operator = match operator with | "=" | "==" | "<>" | "!=" -> true | _ -> false -let is_rhs_binary_operator operator = +let isRhsBinaryOperator operator = match operator with | "**" -> true | _ -> false -let flattenable_operators parent_operator child_operator = - let prec_parent = operator_precedence parent_operator in - let prec_child = operator_precedence child_operator in - if prec_parent == prec_child then - not - (is_equality_operator parent_operator - && is_equality_operator child_operator) +let flattenableOperators parentOperator childOperator = + let precParent = operatorPrecedence parentOperator in + let precChild = operatorPrecedence childOperator in + if precParent == precChild then + not (isEqualityOperator parentOperator && isEqualityOperator childOperator) else false -let rec has_if_let_attribute attrs = +let rec hasIfLetAttribute attrs = match attrs with | [] -> false | ({Location.txt = "res.iflet"}, _) :: _ -> true - | _ :: attrs -> has_if_let_attribute attrs + | _ :: attrs -> hasIfLetAttribute attrs -let is_if_let_expr expr = +let isIfLetExpr expr = match expr with | {pexp_attributes = attrs; pexp_desc = Pexp_match _} - when has_if_let_attribute attrs -> + when hasIfLetAttribute attrs -> true | _ -> false -let rec has_optional_attribute attrs = +let rec hasOptionalAttribute attrs = match attrs with | [] -> false | ({Location.txt = "ns.optional" | "res.optional"}, _) :: _ -> true - | _ :: attrs -> has_optional_attribute attrs + | _ :: attrs -> hasOptionalAttribute attrs -let has_attributes attrs = +let hasAttributes attrs = List.exists (fun attr -> match attr with @@ -397,11 +400,11 @@ let has_attributes attrs = ({pexp_desc = Pexp_constant (Pconst_string ("-4", None))}, _); }; ] ) -> - not (has_if_let_attribute attrs) + not (hasIfLetAttribute attrs) | _ -> true) attrs -let is_array_access expr = +let isArrayAccess expr = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}}, @@ -409,81 +412,79 @@ let is_array_access expr = true | _ -> false -type if_condition_kind = +type ifConditionKind = | If of Parsetree.expression | IfLet of Parsetree.pattern * Parsetree.expression -let collect_if_expressions expr = +let collectIfExpressions expr = let rec collect acc expr = - let expr_loc = expr.pexp_loc in + let exprLoc = expr.pexp_loc in match expr.pexp_desc with - | Pexp_ifthenelse (if_expr, then_expr, Some else_expr) -> - collect ((expr_loc, If if_expr, then_expr) :: acc) else_expr - | Pexp_ifthenelse (if_expr, then_expr, (None as else_expr)) -> - let ifs = List.rev ((expr_loc, If if_expr, then_expr) :: acc) in - (ifs, else_expr) + | Pexp_ifthenelse (ifExpr, thenExpr, Some elseExpr) -> + collect ((exprLoc, If ifExpr, thenExpr) :: acc) elseExpr + | Pexp_ifthenelse (ifExpr, thenExpr, (None as elseExpr)) -> + let ifs = List.rev ((exprLoc, If ifExpr, thenExpr) :: acc) in + (ifs, elseExpr) | Pexp_match ( condition, [ - {pc_lhs = pattern; pc_guard = None; pc_rhs = then_expr}; + {pc_lhs = pattern; pc_guard = None; pc_rhs = thenExpr}; { pc_rhs = {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}; }; ] ) - when is_if_let_expr expr -> + when isIfLetExpr expr -> let ifs = - List.rev ((expr_loc, IfLet (pattern, condition), then_expr) :: acc) + List.rev ((exprLoc, IfLet (pattern, condition), thenExpr) :: acc) in (ifs, None) | Pexp_match ( condition, [ - {pc_lhs = pattern; pc_guard = None; pc_rhs = then_expr}; - {pc_rhs = else_expr}; + {pc_lhs = pattern; pc_guard = None; pc_rhs = thenExpr}; + {pc_rhs = elseExpr}; ] ) - when is_if_let_expr expr -> - collect - ((expr_loc, IfLet (pattern, condition), then_expr) :: acc) - else_expr + when isIfLetExpr expr -> + collect ((exprLoc, IfLet (pattern, condition), thenExpr) :: acc) elseExpr | _ -> (List.rev acc, Some expr) in collect [] expr -let rec has_ternary_attribute attrs = +let rec hasTernaryAttribute attrs = match attrs with | [] -> false | ({Location.txt = "res.ternary"}, _) :: _ -> true - | _ :: attrs -> has_ternary_attribute attrs + | _ :: attrs -> hasTernaryAttribute attrs -let is_ternary_expr expr = +let isTernaryExpr expr = match expr with | {pexp_attributes = attrs; pexp_desc = Pexp_ifthenelse _} - when has_ternary_attribute attrs -> + when hasTernaryAttribute attrs -> true | _ -> false -let collect_ternary_parts expr = +let collectTernaryParts expr = let rec collect acc expr = match expr with | { pexp_attributes = attrs; pexp_desc = Pexp_ifthenelse (condition, consequent, Some alternate); } - when has_ternary_attribute attrs -> + when hasTernaryAttribute attrs -> collect ((condition, consequent) :: acc) alternate | alternate -> (List.rev acc, alternate) in collect [] expr -let parameters_should_hug parameters = +let parametersShouldHug parameters = match parameters with - | [Parameter {attrs = []; lbl = Asttypes.Nolabel; default_expr = None; pat}] - when is_huggable_pattern pat -> + | [Parameter {attrs = []; lbl = Asttypes.Nolabel; defaultExpr = None; pat}] + when isHuggablePattern pat -> true | _ -> false -let filter_ternary_attributes attrs = +let filterTernaryAttributes attrs = List.filter (fun attr -> match attr with @@ -491,7 +492,7 @@ let filter_ternary_attributes attrs = | _ -> true) attrs -let filter_fragile_match_attributes attrs = +let filterFragileMatchAttributes attrs = List.filter (fun attr -> match attr with @@ -508,7 +509,7 @@ let filter_fragile_match_attributes attrs = | _ -> true) attrs -let is_jsx_expression expr = +let isJsxExpression expr = let rec loop attrs = match attrs with | [] -> false @@ -519,7 +520,7 @@ let is_jsx_expression expr = | Pexp_apply _ -> loop expr.Parsetree.pexp_attributes | _ -> false -let has_jsx_attribute attributes = +let hasJsxAttribute attributes = let rec loop attrs = match attrs with | [] -> false @@ -528,17 +529,17 @@ let has_jsx_attribute attributes = in loop attributes -let should_indent_binary_expr expr = - let same_precedence_sub_expression operator sub_expression = - match sub_expression with +let shouldIndentBinaryExpr expr = + let samePrecedenceSubExpression operator subExpression = + match subExpression with | { pexp_desc = Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident sub_operator}}, + ( {pexp_desc = Pexp_ident {txt = Longident.Lident subOperator}}, [(Nolabel, _lhs); (Nolabel, _rhs)] ); } - when is_binary_operator sub_operator -> - flattenable_operators operator sub_operator + when isBinaryOperator subOperator -> + flattenableOperators operator subOperator | _ -> true in match expr with @@ -548,13 +549,13 @@ let should_indent_binary_expr expr = ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, lhs); (Nolabel, _rhs)] ); } - when is_binary_operator operator -> - is_equality_operator operator - || (not (same_precedence_sub_expression operator lhs)) + when isBinaryOperator operator -> + isEqualityOperator operator + || (not (samePrecedenceSubExpression operator lhs)) || operator = ":=" | _ -> false -let should_inline_rhs_binary_expr rhs = +let shouldInlineRhsBinaryExpr rhs = match rhs.pexp_desc with | Parsetree.Pexp_constant _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_sequence _ | Pexp_open _ | Pexp_ifthenelse _ @@ -562,7 +563,7 @@ let should_inline_rhs_binary_expr rhs = true | _ -> false -let is_printable_attribute attr = +let isPrintableAttribute attr = match attr with | ( { Location.txt = @@ -574,71 +575,71 @@ let is_printable_attribute attr = false | _ -> true -let has_printable_attributes attrs = List.exists is_printable_attribute attrs +let hasPrintableAttributes attrs = List.exists isPrintableAttribute attrs -let filter_printable_attributes attrs = List.filter is_printable_attribute attrs +let filterPrintableAttributes attrs = List.filter isPrintableAttribute attrs -let partition_printable_attributes attrs = - List.partition is_printable_attribute attrs +let partitionPrintableAttributes attrs = + List.partition isPrintableAttribute attrs -let is_fun_newtype expr = +let isFunNewtype expr = match expr.pexp_desc with | Pexp_fun _ | Pexp_newtype _ -> true - | _ -> Ast_uncurried.expr_is_uncurried_fun expr + | _ -> Ast_uncurried.exprIsUncurriedFun expr -let requires_special_callback_printing_last_arg args = +let requiresSpecialCallbackPrintingLastArg args = let rec loop args = match args with | [] -> false - | [(_, expr)] when is_fun_newtype expr -> true - | (_, expr) :: _ when is_fun_newtype expr -> false + | [(_, expr)] when isFunNewtype expr -> true + | (_, expr) :: _ when isFunNewtype expr -> false | _ :: rest -> loop rest in loop args -let requires_special_callback_printing_first_arg args = +let requiresSpecialCallbackPrintingFirstArg args = let rec loop args = match args with | [] -> true - | (_, expr) :: _ when is_fun_newtype expr -> false + | (_, expr) :: _ when isFunNewtype expr -> false | _ :: rest -> loop rest in match args with - | [(_, expr)] when is_fun_newtype expr -> false - | (_, expr) :: rest when is_fun_newtype expr -> loop rest + | [(_, expr)] when isFunNewtype expr -> false + | (_, expr) :: rest when isFunNewtype expr -> loop rest | _ -> false -let mod_expr_apply mod_expr = - let rec loop acc mod_expr = - match mod_expr with +let modExprApply modExpr = + let rec loop acc modExpr = + match modExpr with | {pmod_desc = Pmod_apply (next, arg)} -> loop (arg :: acc) next - | _ -> (acc, mod_expr) + | _ -> (acc, modExpr) in - loop [] mod_expr + loop [] modExpr -let mod_expr_functor mod_expr = - let rec loop acc mod_expr = - match mod_expr with +let modExprFunctor modExpr = + let rec loop acc modExpr = + match modExpr with | { - pmod_desc = Pmod_functor (lbl, mod_type, return_mod_expr); + pmod_desc = Pmod_functor (lbl, modType, returnModExpr); pmod_attributes = attrs; } -> - let param = (attrs, lbl, mod_type) in - loop (param :: acc) return_mod_expr - | return_mod_expr -> (List.rev acc, return_mod_expr) + let param = (attrs, lbl, modType) in + loop (param :: acc) returnModExpr + | returnModExpr -> (List.rev acc, returnModExpr) in - loop [] mod_expr + loop [] modExpr -let rec collect_patterns_from_list_construct acc pattern = +let rec collectPatternsFromListConstruct acc pattern = let open Parsetree in match pattern.ppat_desc with | Ppat_construct ({txt = Longident.Lident "::"}, Some {ppat_desc = Ppat_tuple [pat; rest]}) -> - collect_patterns_from_list_construct (pat :: acc) rest + collectPatternsFromListConstruct (pat :: acc) rest | _ -> (List.rev acc, pattern) -let has_template_literal_attr attrs = +let hasTemplateLiteralAttr attrs = List.exists (fun attr -> match attr with @@ -646,7 +647,7 @@ let has_template_literal_attr attrs = | _ -> false) attrs -let has_tagged_template_literal_attr attrs = +let hasTaggedTemplateLiteralAttr attrs = List.exists (fun attr -> match attr with @@ -654,24 +655,24 @@ let has_tagged_template_literal_attr attrs = | _ -> false) attrs -let is_template_literal expr = +let isTemplateLiteral expr = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "^"}}, [(Nolabel, _); (Nolabel, _)] ) - when has_template_literal_attr expr.pexp_attributes -> + when hasTemplateLiteralAttr expr.pexp_attributes -> true | Pexp_constant (Pconst_string (_, Some "")) -> true - | Pexp_constant _ when has_template_literal_attr expr.pexp_attributes -> true + | Pexp_constant _ when hasTemplateLiteralAttr expr.pexp_attributes -> true | _ -> false -let is_tagged_template_literal expr = +let isTaggedTemplateLiteral expr = match expr with | {pexp_desc = Pexp_apply _; pexp_attributes = attrs} -> - has_tagged_template_literal_attr attrs + hasTaggedTemplateLiteralAttr attrs | _ -> false -let has_spread_attr attrs = +let hasSpreadAttr attrs = List.exists (fun attr -> match attr with @@ -679,7 +680,7 @@ let has_spread_attr attrs = | _ -> false) attrs -let is_spread_belt_list_concat expr = +let isSpreadBeltListConcat expr = match expr.pexp_desc with | Pexp_ident { @@ -687,10 +688,10 @@ let is_spread_belt_list_concat expr = Longident.Ldot (Longident.Ldot (Longident.Lident "Belt", "List"), "concatMany"); } -> - has_spread_attr expr.pexp_attributes + hasSpreadAttr expr.pexp_attributes | _ -> false -let is_spread_belt_array_concat expr = +let isSpreadBeltArrayConcat expr = match expr.pexp_desc with | Pexp_ident { @@ -698,11 +699,11 @@ let is_spread_belt_array_concat expr = Longident.Ldot (Longident.Ldot (Longident.Lident "Belt", "Array"), "concatMany"); } -> - has_spread_attr expr.pexp_attributes + hasSpreadAttr expr.pexp_attributes | _ -> false (* Blue | Red | Green -> [Blue; Red; Green] *) -let collect_or_pattern_chain pat = +let collectOrPatternChain pat = let rec loop pattern chain = match pattern.ppat_desc with | Ppat_or (left, right) -> loop left (right :: chain) @@ -710,7 +711,7 @@ let collect_or_pattern_chain pat = in loop pat [] -let is_single_pipe_expr expr = +let isSinglePipeExpr expr = (* handles: * x * ->Js.Dict.get("wm-property") @@ -723,7 +724,7 @@ let is_single_pipe_expr expr = * } * ) *) - let is_pipe_expr expr = + let isPipeExpr expr = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|.u" | "|>")}}, @@ -735,11 +736,11 @@ let is_single_pipe_expr expr = | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|.u" | "|>")}}, [(Nolabel, operand1); (Nolabel, _operand2)] ) - when not (is_pipe_expr operand1) -> + when not (isPipeExpr operand1) -> true | _ -> false -let is_underscore_apply_sugar expr = +let isUnderscoreApplySugar expr = match expr.pexp_desc with | Pexp_fun ( Nolabel, @@ -749,7 +750,7 @@ let is_underscore_apply_sugar expr = true | _ -> false -let is_rewritten_underscore_apply_sugar expr = +let isRewrittenUnderscoreApplySugar expr = match expr.pexp_desc with | Pexp_ident {txt = Longident.Lident "_"} -> true | _ -> false diff --git a/analysis/vendor/res_syntax/res_parsetree_viewer.mli b/analysis/vendor/res_syntax/res_parsetree_viewer.mli index d270e05e0..d1bb8df45 100644 --- a/analysis/vendor/res_syntax/res_parsetree_viewer.mli +++ b/analysis/vendor/res_syntax/res_parsetree_viewer.mli @@ -1,72 +1,73 @@ (* Restructures a nested tree of arrow types into its args & returnType * The parsetree contains: a => b => c => d, for printing purposes * we restructure the tree into (a, b, c) and its returnType d *) -val arrow_type : +val arrowType : ?arity:int -> Parsetree.core_type -> Parsetree.attributes * (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list * Parsetree.core_type -val functor_type : +val functorType : Parsetree.module_type -> (Parsetree.attributes * string Asttypes.loc * Parsetree.module_type option) list * Parsetree.module_type (* filters @bs out of the provided attributes *) -val process_bs_attribute : Parsetree.attributes -> bool * Parsetree.attributes +val processBsAttribute : Parsetree.attributes -> bool * Parsetree.attributes -val process_uncurried_app_attribute : +val processUncurriedAppAttribute : Parsetree.attributes -> bool * Parsetree.attributes -val process_partial_app_attribute : +val processPartialAppAttribute : Parsetree.attributes -> bool * Parsetree.attributes -type function_attributes_info = { +type functionAttributesInfo = { async: bool; bs: bool; attributes: Parsetree.attributes; } +val hasPartialAttribute : Parsetree.attributes -> bool + (* determines whether a function is async and/or uncurried based on the given attributes *) -val process_function_attributes : - Parsetree.attributes -> function_attributes_info +val processFunctionAttributes : Parsetree.attributes -> functionAttributesInfo -val has_await_attribute : Parsetree.attributes -> bool +val hasAwaitAttribute : Parsetree.attributes -> bool -type if_condition_kind = +type ifConditionKind = | If of Parsetree.expression | IfLet of Parsetree.pattern * Parsetree.expression (* if ... else if ... else ... is represented as nested expressions: if ... else { if ... } * The purpose of this function is to flatten nested ifs into one sequence. * Basically compute: ([if, else if, else if, else if], else) *) -val collect_if_expressions : +val collectIfExpressions : Parsetree.expression -> - (Location.t * if_condition_kind * Parsetree.expression) list + (Location.t * ifConditionKind * Parsetree.expression) list * Parsetree.expression option -val collect_array_expressions : +val collectArrayExpressions : Parsetree.expression -> Parsetree.expression list * Parsetree.expression option -val collect_list_expressions : +val collectListExpressions : Parsetree.expression -> Parsetree.expression list * Parsetree.expression option -type fun_param_kind = +type funParamKind = | Parameter of { attrs: Parsetree.attributes; lbl: Asttypes.arg_label; - default_expr: Parsetree.expression option; + defaultExpr: Parsetree.expression option; pat: Parsetree.pattern; } | NewTypes of {attrs: Parsetree.attributes; locs: string Asttypes.loc list} -val fun_expr : +val funExpr : Parsetree.expression -> - bool * Parsetree.attributes * fun_param_kind list * Parsetree.expression + bool * Parsetree.attributes * funParamKind list * Parsetree.expression (* example: * `makeCoordinate({ @@ -74,54 +75,53 @@ val fun_expr : * y: 2, * })` * Notice howe `({` and `})` "hug" or stick to each other *) -val is_huggable_expression : Parsetree.expression -> bool +val isHuggableExpression : Parsetree.expression -> bool -val is_huggable_pattern : Parsetree.pattern -> bool +val isHuggablePattern : Parsetree.pattern -> bool -val is_huggable_rhs : Parsetree.expression -> bool +val isHuggableRhs : Parsetree.expression -> bool -val operator_precedence : string -> int +val operatorPrecedence : string -> int -val is_unary_expression : Parsetree.expression -> bool -val is_binary_operator : string -> bool -val is_binary_expression : Parsetree.expression -> bool -val is_rhs_binary_operator : string -> bool +val isUnaryExpression : Parsetree.expression -> bool +val isBinaryOperator : string -> bool +val isBinaryExpression : Parsetree.expression -> bool +val isRhsBinaryOperator : string -> bool -val flattenable_operators : string -> string -> bool +val flattenableOperators : string -> string -> bool -val has_attributes : Parsetree.attributes -> bool +val hasAttributes : Parsetree.attributes -> bool -val is_array_access : Parsetree.expression -> bool -val is_ternary_expr : Parsetree.expression -> bool -val is_if_let_expr : Parsetree.expression -> bool +val isArrayAccess : Parsetree.expression -> bool +val isTernaryExpr : Parsetree.expression -> bool +val isIfLetExpr : Parsetree.expression -> bool -val collect_ternary_parts : +val collectTernaryParts : Parsetree.expression -> (Parsetree.expression * Parsetree.expression) list * Parsetree.expression -val parameters_should_hug : fun_param_kind list -> bool +val parametersShouldHug : funParamKind list -> bool -val filter_ternary_attributes : Parsetree.attributes -> Parsetree.attributes -val filter_fragile_match_attributes : - Parsetree.attributes -> Parsetree.attributes +val filterTernaryAttributes : Parsetree.attributes -> Parsetree.attributes +val filterFragileMatchAttributes : Parsetree.attributes -> Parsetree.attributes -val is_jsx_expression : Parsetree.expression -> bool -val has_jsx_attribute : Parsetree.attributes -> bool -val has_optional_attribute : Parsetree.attributes -> bool +val isJsxExpression : Parsetree.expression -> bool +val hasJsxAttribute : Parsetree.attributes -> bool +val hasOptionalAttribute : Parsetree.attributes -> bool -val should_indent_binary_expr : Parsetree.expression -> bool -val should_inline_rhs_binary_expr : Parsetree.expression -> bool -val has_printable_attributes : Parsetree.attributes -> bool -val filter_printable_attributes : Parsetree.attributes -> Parsetree.attributes -val partition_printable_attributes : +val shouldIndentBinaryExpr : Parsetree.expression -> bool +val shouldInlineRhsBinaryExpr : Parsetree.expression -> bool +val hasPrintableAttributes : Parsetree.attributes -> bool +val filterPrintableAttributes : Parsetree.attributes -> Parsetree.attributes +val partitionPrintableAttributes : Parsetree.attributes -> Parsetree.attributes * Parsetree.attributes -val requires_special_callback_printing_last_arg : +val requiresSpecialCallbackPrintingLastArg : (Asttypes.arg_label * Parsetree.expression) list -> bool -val requires_special_callback_printing_first_arg : +val requiresSpecialCallbackPrintingFirstArg : (Asttypes.arg_label * Parsetree.expression) list -> bool -val mod_expr_apply : +val modExprApply : Parsetree.module_expr -> Parsetree.module_expr list * Parsetree.module_expr (* Collection of utilities to view the ast in a more a convenient form, @@ -129,46 +129,46 @@ val mod_expr_apply : * Example: given a ptyp_arrow type, what are its arguments and what is the * returnType? *) -val mod_expr_functor : +val modExprFunctor : Parsetree.module_expr -> (Parsetree.attributes * string Asttypes.loc * Parsetree.module_type option) list * Parsetree.module_expr -val collect_patterns_from_list_construct : +val collectPatternsFromListConstruct : Parsetree.pattern list -> Parsetree.pattern -> Parsetree.pattern list * Parsetree.pattern -val is_block_expr : Parsetree.expression -> bool +val isBlockExpr : Parsetree.expression -> bool -val is_template_literal : Parsetree.expression -> bool -val is_tagged_template_literal : Parsetree.expression -> bool -val has_template_literal_attr : Parsetree.attributes -> bool +val isTemplateLiteral : Parsetree.expression -> bool +val isTaggedTemplateLiteral : Parsetree.expression -> bool +val hasTemplateLiteralAttr : Parsetree.attributes -> bool -val is_spread_belt_list_concat : Parsetree.expression -> bool +val isSpreadBeltListConcat : Parsetree.expression -> bool -val is_spread_belt_array_concat : Parsetree.expression -> bool +val isSpreadBeltArrayConcat : Parsetree.expression -> bool -val collect_or_pattern_chain : Parsetree.pattern -> Parsetree.pattern list +val collectOrPatternChain : Parsetree.pattern -> Parsetree.pattern list -val process_braces_attr : +val processBracesAttr : Parsetree.expression -> Parsetree.attribute option * Parsetree.expression -val filter_parsing_attrs : Parsetree.attributes -> Parsetree.attributes +val filterParsingAttrs : Parsetree.attributes -> Parsetree.attributes -val is_braced_expr : Parsetree.expression -> bool +val isBracedExpr : Parsetree.expression -> bool -val is_single_pipe_expr : Parsetree.expression -> bool +val isSinglePipeExpr : Parsetree.expression -> bool (* (__x) => f(a, __x, c) -----> f(a, _, c) *) -val rewrite_underscore_apply : Parsetree.expression -> Parsetree.expression +val rewriteUnderscoreApply : Parsetree.expression -> Parsetree.expression (* (__x) => f(a, __x, c) -----> f(a, _, c) *) -val is_underscore_apply_sugar : Parsetree.expression -> bool +val isUnderscoreApplySugar : Parsetree.expression -> bool -val has_if_let_attribute : Parsetree.attributes -> bool +val hasIfLetAttribute : Parsetree.attributes -> bool -val is_rewritten_underscore_apply_sugar : Parsetree.expression -> bool +val isRewrittenUnderscoreApplySugar : Parsetree.expression -> bool -val is_fun_newtype : Parsetree.expression -> bool +val isFunNewtype : Parsetree.expression -> bool diff --git a/analysis/vendor/res_syntax/res_printer.ml b/analysis/vendor/res_syntax/res_printer.ml index f9d370af4..f8fd5adf4 100644 --- a/analysis/vendor/res_syntax/res_printer.ml +++ b/analysis/vendor/res_syntax/res_printer.ml @@ -5,7 +5,7 @@ module Token = Res_token module Parens = Res_parens module ParsetreeViewer = Res_parsetree_viewer -type callback_style = +type callbackStyle = (* regular arrow function, example: `let f = x => x + 1` *) | NoCallback (* `Thing.map(foo, (arg1, arg2) => MyModuleBlah.toList(argument))` *) @@ -16,71 +16,114 @@ type callback_style = *) | ArgumentsFitOnOneLine -let add_parens doc = +(* Since compiler version 8.3, the bs. prefix is no longer needed *) +(* Synced from + https://github.com/rescript-lang/rescript-compiler/blob/29174de1a5fde3b16cf05d10f5ac109cfac5c4ca/jscomp/frontend/ast_external_process.ml#L291-L367 *) +let convertBsExternalAttribute = function + | "bs.as" -> "as" + | "bs.deriving" -> "deriving" + | "bs.get" -> "get" + | "bs.get_index" -> "get_index" + | "bs.ignore" -> "ignore" + | "bs.inline" -> "inline" + | "bs.int" -> "int" + | "bs.meth" -> "meth" + | "bs.module" -> "module" + | "bs.new" -> "new" + | "bs.obj" -> "obj" + | "bs.optional" -> "optional" + | "bs.return" -> "return" + | "bs.send" -> "send" + | "bs.scope" -> "scope" + | "bs.set" -> "set" + | "bs.set_index" -> "set_index" + | "bs.splice" | "bs.variadic" -> "variadic" + | "bs.string" -> "string" + | "bs.this" -> "this" + | "bs.uncurry" -> "uncurry" + | "bs.unwrap" -> "unwrap" + | "bs.val" -> "val" + (* bs.send.pipe shouldn't be transformed *) + | txt -> txt + +(* These haven't been needed for a long time now *) +(* Synced from + https://github.com/rescript-lang/rescript-compiler/blob/29174de1a5fde3b16cf05d10f5ac109cfac5c4ca/jscomp/frontend/ast_exp_extension.ml *) +let convertBsExtension = function + | "bs.debugger" -> "debugger" + | "bs.external" -> "raw" + (* We should never see this one since we use the sugared object form, but still *) + | "bs.obj" -> "obj" + | "bs.raw" -> "raw" + | "bs.re" -> "re" + (* TODO: what about bs.time and bs.node? *) + | txt -> txt + +let addParens doc = Doc.group (Doc.concat [ Doc.lparen; - Doc.indent (Doc.concat [Doc.soft_line; doc]); - Doc.soft_line; + Doc.indent (Doc.concat [Doc.softLine; doc]); + Doc.softLine; Doc.rparen; ]) -let add_braces doc = +let addBraces doc = Doc.group (Doc.concat [ Doc.lbrace; - Doc.indent (Doc.concat [Doc.soft_line; doc]); - Doc.soft_line; + Doc.indent (Doc.concat [Doc.softLine; doc]); + Doc.softLine; Doc.rbrace; ]) -let add_async doc = Doc.concat [Doc.text "async "; doc] +let addAsync doc = Doc.concat [Doc.text "async "; doc] -let get_first_leading_comment tbl loc = +let getFirstLeadingComment tbl loc = match Hashtbl.find tbl.CommentTable.leading loc with | comment :: _ -> Some comment | [] -> None | exception Not_found -> None (* Checks if `loc` has a leading line comment, i.e. `// comment above`*) -let has_leading_line_comment tbl loc = - match get_first_leading_comment tbl loc with - | Some comment -> Comment.is_single_line_comment comment +let hasLeadingLineComment tbl loc = + match getFirstLeadingComment tbl loc with + | Some comment -> Comment.isSingleLineComment comment | None -> false -let has_comment_below tbl loc = +let hasCommentBelow tbl loc = match Hashtbl.find tbl.CommentTable.trailing loc with | comment :: _ -> - let comment_loc = Comment.loc comment in - comment_loc.Location.loc_start.pos_lnum > loc.Location.loc_end.pos_lnum + let commentLoc = Comment.loc comment in + commentLoc.Location.loc_start.pos_lnum > loc.Location.loc_end.pos_lnum | [] -> false | exception Not_found -> false -let has_nested_jsx_or_more_than_one_child expr = - let rec loop in_recursion expr = +let hasNestedJsxOrMoreThanOneChild expr = + let rec loop inRecursion expr = match expr.Parsetree.pexp_desc with | Pexp_construct ({txt = Longident.Lident "::"}, Some {pexp_desc = Pexp_tuple [hd; tail]}) -> - if in_recursion || ParsetreeViewer.is_jsx_expression hd then true + if inRecursion || ParsetreeViewer.isJsxExpression hd then true else loop true tail | _ -> false in loop false expr -let has_comments_inside tbl loc = +let hasCommentsInside tbl loc = match Hashtbl.find_opt tbl.CommentTable.inside loc with | None -> false | _ -> true -let has_trailing_comments tbl loc = +let hasTrailingComments tbl loc = match Hashtbl.find_opt tbl.CommentTable.trailing loc with | None -> false | _ -> true -let print_multiline_comment_content txt = +let printMultilineCommentContent txt = (* Turns * |* first line * * second line @@ -93,103 +136,102 @@ let print_multiline_comment_content txt = * What makes a comment suitable for this kind of indentation? * -> multiple lines + every line starts with a star *) - let rec indent_stars lines acc = + let rec indentStars lines acc = match lines with | [] -> Doc.nil - | [last_line] -> - let line = String.trim last_line in + | [lastLine] -> + let line = String.trim lastLine in let doc = Doc.text (" " ^ line) in - let trailing_space = if line = "" then Doc.nil else Doc.space in - List.rev (trailing_space :: doc :: acc) |> Doc.concat + let trailingSpace = if line = "" then Doc.nil else Doc.space in + List.rev (trailingSpace :: doc :: acc) |> Doc.concat | line :: lines -> let line = String.trim line in if line != "" && String.unsafe_get line 0 == '*' then let doc = Doc.text (" " ^ line) in - indent_stars lines (Doc.hard_line :: doc :: acc) + indentStars lines (Doc.hardLine :: doc :: acc) else - let trailing_space = + let trailingSpace = let len = String.length txt in if len > 0 && String.unsafe_get txt (len - 1) = ' ' then Doc.space else Doc.nil in - let content = Comment.trim_spaces txt in - Doc.concat [Doc.text content; trailing_space] + let content = Comment.trimSpaces txt in + Doc.concat [Doc.text content; trailingSpace] in let lines = String.split_on_char '\n' txt in match lines with | [] -> Doc.text "/* */" | [line] -> Doc.concat - [Doc.text "/* "; Doc.text (Comment.trim_spaces line); Doc.text " */"] + [Doc.text "/* "; Doc.text (Comment.trimSpaces line); Doc.text " */"] | first :: rest -> - let first_line = Comment.trim_spaces first in + let firstLine = Comment.trimSpaces first in Doc.concat [ Doc.text "/*"; - (match first_line with + (match firstLine with | "" | "*" -> Doc.nil | _ -> Doc.space); - indent_stars rest [Doc.hard_line; Doc.text first_line]; + indentStars rest [Doc.hardLine; Doc.text firstLine]; Doc.text "*/"; ] -let print_trailing_comment (prev_loc : Location.t) (node_loc : Location.t) - comment = - let single_line = Comment.is_single_line_comment comment in +let printTrailingComment (prevLoc : Location.t) (nodeLoc : Location.t) comment = + let singleLine = Comment.isSingleLineComment comment in let content = let txt = Comment.txt comment in - if single_line then Doc.text ("//" ^ txt) - else print_multiline_comment_content txt + if singleLine then Doc.text ("//" ^ txt) + else printMultilineCommentContent txt in let diff = - let cmt_start = (Comment.loc comment).loc_start in - cmt_start.pos_lnum - prev_loc.loc_end.pos_lnum + let cmtStart = (Comment.loc comment).loc_start in + cmtStart.pos_lnum - prevLoc.loc_end.pos_lnum in - let is_below = - (Comment.loc comment).loc_start.pos_lnum > node_loc.loc_end.pos_lnum + let isBelow = + (Comment.loc comment).loc_start.pos_lnum > nodeLoc.loc_end.pos_lnum in - if diff > 0 || is_below then + if diff > 0 || isBelow then Doc.concat [ - Doc.break_parent; - Doc.line_suffix + Doc.breakParent; + Doc.lineSuffix (Doc.concat [ - Doc.hard_line; - (if diff > 1 then Doc.hard_line else Doc.nil); + Doc.hardLine; + (if diff > 1 then Doc.hardLine else Doc.nil); content; ]); ] - else if not single_line then Doc.concat [Doc.space; content] - else Doc.line_suffix (Doc.concat [Doc.space; content]) + else if not singleLine then Doc.concat [Doc.space; content] + else Doc.lineSuffix (Doc.concat [Doc.space; content]) -let print_leading_comment ?next_comment comment = - let single_line = Comment.is_single_line_comment comment in +let printLeadingComment ?nextComment comment = + let singleLine = Comment.isSingleLineComment comment in let content = let txt = Comment.txt comment in - if single_line then Doc.text ("//" ^ txt) - else print_multiline_comment_content txt + if singleLine then Doc.text ("//" ^ txt) + else printMultilineCommentContent txt in let separator = Doc.concat [ - (if single_line then Doc.concat [Doc.hard_line; Doc.break_parent] + (if singleLine then Doc.concat [Doc.hardLine; Doc.breakParent] else Doc.nil); - (match next_comment with + (match nextComment with | Some next -> - let next_loc = Comment.loc next in - let curr_loc = Comment.loc comment in + let nextLoc = Comment.loc next in + let currLoc = Comment.loc comment in let diff = - next_loc.Location.loc_start.pos_lnum - - curr_loc.Location.loc_end.pos_lnum + nextLoc.Location.loc_start.pos_lnum + - currLoc.Location.loc_end.pos_lnum in - let next_single_line = Comment.is_single_line_comment next in - if single_line && next_single_line then - if diff > 1 then Doc.hard_line else Doc.nil - else if single_line && not next_single_line then - if diff > 1 then Doc.hard_line else Doc.nil - else if diff > 1 then Doc.concat [Doc.hard_line; Doc.hard_line] - else if diff == 1 then Doc.hard_line + let nextSingleLine = Comment.isSingleLineComment next in + if singleLine && nextSingleLine then + if diff > 1 then Doc.hardLine else Doc.nil + else if singleLine && not nextSingleLine then + if diff > 1 then Doc.hardLine else Doc.nil + else if diff > 1 then Doc.concat [Doc.hardLine; Doc.hardLine] + else if diff == 1 then Doc.hardLine else Doc.space | None -> Doc.nil); ] @@ -197,84 +239,83 @@ let print_leading_comment ?next_comment comment = Doc.concat [content; separator] (* This function is used for printing comments inside an empty block *) -let print_comments_inside cmt_tbl loc = - let print_comment comment = - let single_line = Comment.is_single_line_comment comment in +let printCommentsInside cmtTbl loc = + let printComment comment = + let singleLine = Comment.isSingleLineComment comment in let txt = Comment.txt comment in - if single_line then Doc.text ("//" ^ txt) - else print_multiline_comment_content txt + if singleLine then Doc.text ("//" ^ txt) + else printMultilineCommentContent txt in - let force_break = + let forceBreak = loc.Location.loc_start.pos_lnum <> loc.Location.loc_end.pos_lnum in let rec loop acc comments = match comments with | [] -> Doc.nil | [comment] -> - let cmt_doc = print_comment comment in - let cmts_doc = Doc.concat (Doc.soft_line :: List.rev (cmt_doc :: acc)) in + let cmtDoc = printComment comment in + let cmtsDoc = Doc.concat (Doc.softLine :: List.rev (cmtDoc :: acc)) in let doc = - Doc.breakable_group ~force_break - (Doc.concat - [Doc.if_breaks (Doc.indent cmts_doc) cmts_doc; Doc.soft_line]) + Doc.breakableGroup ~forceBreak + (Doc.concat [Doc.ifBreaks (Doc.indent cmtsDoc) cmtsDoc; Doc.softLine]) in doc | comment :: rest -> - let cmt_doc = Doc.concat [print_comment comment; Doc.line] in - loop (cmt_doc :: acc) rest + let cmtDoc = Doc.concat [printComment comment; Doc.line] in + loop (cmtDoc :: acc) rest in - match Hashtbl.find cmt_tbl.CommentTable.inside loc with + match Hashtbl.find cmtTbl.CommentTable.inside loc with | exception Not_found -> Doc.nil | comments -> - Hashtbl.remove cmt_tbl.inside loc; + Hashtbl.remove cmtTbl.inside loc; loop [] comments (* This function is used for printing comments inside an empty file *) -let print_comments_inside_file cmt_tbl = +let printCommentsInsideFile cmtTbl = let rec loop acc comments = match comments with | [] -> Doc.nil | [comment] -> - let cmt_doc = print_leading_comment comment in + let cmtDoc = printLeadingComment comment in let doc = - Doc.group (Doc.concat [Doc.concat (List.rev (cmt_doc :: acc))]) + Doc.group (Doc.concat [Doc.concat (List.rev (cmtDoc :: acc))]) in doc - | comment :: (next_comment :: _comments as rest) -> - let cmt_doc = print_leading_comment ~next_comment comment in - loop (cmt_doc :: acc) rest + | comment :: (nextComment :: _comments as rest) -> + let cmtDoc = printLeadingComment ~nextComment comment in + loop (cmtDoc :: acc) rest in - match Hashtbl.find cmt_tbl.CommentTable.inside Location.none with + match Hashtbl.find cmtTbl.CommentTable.inside Location.none with | exception Not_found -> Doc.nil | comments -> - Hashtbl.remove cmt_tbl.inside Location.none; + Hashtbl.remove cmtTbl.inside Location.none; Doc.group (loop [] comments) -let print_leading_comments node tbl loc = +let printLeadingComments node tbl loc = let rec loop acc comments = match comments with | [] -> node | [comment] -> - let cmt_doc = print_leading_comment comment in + let cmtDoc = printLeadingComment comment in let diff = loc.Location.loc_start.pos_lnum - (Comment.loc comment).Location.loc_end.pos_lnum in let separator = - if Comment.is_single_line_comment comment then - if diff > 1 then Doc.hard_line else Doc.nil + if Comment.isSingleLineComment comment then + if diff > 1 then Doc.hardLine else Doc.nil else if diff == 0 then Doc.space - else if diff > 1 then Doc.concat [Doc.hard_line; Doc.hard_line] - else Doc.hard_line + else if diff > 1 then Doc.concat [Doc.hardLine; Doc.hardLine] + else Doc.hardLine in let doc = Doc.group - (Doc.concat [Doc.concat (List.rev (cmt_doc :: acc)); separator; node]) + (Doc.concat [Doc.concat (List.rev (cmtDoc :: acc)); separator; node]) in doc - | comment :: (next_comment :: _comments as rest) -> - let cmt_doc = print_leading_comment ~next_comment comment in - loop (cmt_doc :: acc) rest + | comment :: (nextComment :: _comments as rest) -> + let cmtDoc = printLeadingComment ~nextComment comment in + loop (cmtDoc :: acc) rest in match Hashtbl.find tbl loc with | exception Not_found -> node @@ -284,13 +325,13 @@ let print_leading_comments node tbl loc = Hashtbl.remove tbl loc; loop [] comments -let print_trailing_comments node tbl loc = +let printTrailingComments node tbl loc = let rec loop prev acc comments = match comments with | [] -> Doc.concat (List.rev acc) | comment :: comments -> - let cmt_doc = print_trailing_comment prev loc comment in - loop (Comment.loc comment) (cmt_doc :: acc) comments + let cmtDoc = printTrailingComment prev loc comment in + loop (Comment.loc comment) (cmtDoc :: acc) comments in match Hashtbl.find tbl loc with | exception Not_found -> node @@ -299,110 +340,109 @@ let print_trailing_comments node tbl loc = (* Remove comments from tbl: Some ast nodes have the same location. * We only want to print comments once *) Hashtbl.remove tbl loc; - let cmts_doc = loop loc [] comments in - Doc.concat [node; cmts_doc] + let cmtsDoc = loop loc [] comments in + Doc.concat [node; cmtsDoc] -let print_comments doc (tbl : CommentTable.t) loc = - let doc_with_leading_comments = print_leading_comments doc tbl.leading loc in - print_trailing_comments doc_with_leading_comments tbl.trailing loc +let printComments doc (tbl : CommentTable.t) loc = + let docWithLeadingComments = printLeadingComments doc tbl.leading loc in + printTrailingComments docWithLeadingComments tbl.trailing loc -let print_list ~get_loc ~nodes ~print ?(force_break = false) t = - let rec loop (prev_loc : Location.t) acc nodes = +let printList ~getLoc ~nodes ~print ?(forceBreak = false) t = + let rec loop (prevLoc : Location.t) acc nodes = match nodes with - | [] -> (prev_loc, Doc.concat (List.rev acc)) + | [] -> (prevLoc, Doc.concat (List.rev acc)) | node :: nodes -> - let loc = get_loc node in - let start_pos = - match get_first_leading_comment t loc with + let loc = getLoc node in + let startPos = + match getFirstLeadingComment t loc with | None -> loc.loc_start | Some comment -> (Comment.loc comment).loc_start in let sep = - if start_pos.pos_lnum - prev_loc.loc_end.pos_lnum > 1 then - Doc.concat [Doc.hard_line; Doc.hard_line] - else Doc.hard_line + if startPos.pos_lnum - prevLoc.loc_end.pos_lnum > 1 then + Doc.concat [Doc.hardLine; Doc.hardLine] + else Doc.hardLine in - let doc = print_comments (print node t) t loc in + let doc = printComments (print node t) t loc in loop loc (doc :: sep :: acc) nodes in match nodes with | [] -> Doc.nil | node :: nodes -> - let first_loc = get_loc node in - let doc = print_comments (print node t) t first_loc in - let last_loc, docs = loop first_loc [doc] nodes in - let force_break = - force_break || first_loc.loc_start.pos_lnum != last_loc.loc_end.pos_lnum + let firstLoc = getLoc node in + let doc = printComments (print node t) t firstLoc in + let lastLoc, docs = loop firstLoc [doc] nodes in + let forceBreak = + forceBreak || firstLoc.loc_start.pos_lnum != lastLoc.loc_end.pos_lnum in - Doc.breakable_group ~force_break docs + Doc.breakableGroup ~forceBreak docs -let print_listi ~get_loc ~nodes ~print ?(force_break = false) t = - let rec loop i (prev_loc : Location.t) acc nodes = +let printListi ~getLoc ~nodes ~print ?(forceBreak = false) t = + let rec loop i (prevLoc : Location.t) acc nodes = match nodes with - | [] -> (prev_loc, Doc.concat (List.rev acc)) + | [] -> (prevLoc, Doc.concat (List.rev acc)) | node :: nodes -> - let loc = get_loc node in - let start_pos = - match get_first_leading_comment t loc with + let loc = getLoc node in + let startPos = + match getFirstLeadingComment t loc with | None -> loc.loc_start | Some comment -> (Comment.loc comment).loc_start in let sep = - if start_pos.pos_lnum - prev_loc.loc_end.pos_lnum > 1 then - Doc.concat [Doc.hard_line; Doc.hard_line] + if startPos.pos_lnum - prevLoc.loc_end.pos_lnum > 1 then + Doc.concat [Doc.hardLine; Doc.hardLine] else Doc.line in - let doc = print_comments (print node t i) t loc in + let doc = printComments (print node t i) t loc in loop (i + 1) loc (doc :: sep :: acc) nodes in match nodes with | [] -> Doc.nil | node :: nodes -> - let first_loc = get_loc node in - let doc = print_comments (print node t 0) t first_loc in - let last_loc, docs = loop 1 first_loc [doc] nodes in - let force_break = - force_break || first_loc.loc_start.pos_lnum != last_loc.loc_end.pos_lnum + let firstLoc = getLoc node in + let doc = printComments (print node t 0) t firstLoc in + let lastLoc, docs = loop 1 firstLoc [doc] nodes in + let forceBreak = + forceBreak || firstLoc.loc_start.pos_lnum != lastLoc.loc_end.pos_lnum in - Doc.breakable_group ~force_break docs + Doc.breakableGroup ~forceBreak docs -let rec print_longident_aux accu = function +let rec printLongidentAux accu = function | Longident.Lident s -> Doc.text s :: accu - | Ldot (lid, s) -> print_longident_aux (Doc.text s :: accu) lid + | Ldot (lid, s) -> printLongidentAux (Doc.text s :: accu) lid | Lapply (lid1, lid2) -> - let d1 = Doc.join ~sep:Doc.dot (print_longident_aux [] lid1) in - let d2 = Doc.join ~sep:Doc.dot (print_longident_aux [] lid2) in + let d1 = Doc.join ~sep:Doc.dot (printLongidentAux [] lid1) in + let d2 = Doc.join ~sep:Doc.dot (printLongidentAux [] lid2) in Doc.concat [d1; Doc.lparen; d2; Doc.rparen] :: accu -let print_longident = function +let printLongident = function | Longident.Lident txt -> Doc.text txt - | lid -> Doc.join ~sep:Doc.dot (print_longident_aux [] lid) + | lid -> Doc.join ~sep:Doc.dot (printLongidentAux [] lid) -type identifier_style = ExoticIdent | NormalIdent +type identifierStyle = ExoticIdent | NormalIdent -let classify_ident_content ?(allow_uident = false) ?(allow_hyphen = false) txt = - if Token.is_keyword_txt txt then ExoticIdent +let classifyIdentContent ?(allowUident = false) ?(allowHyphen = false) txt = + if Token.isKeywordTxt txt then ExoticIdent else let len = String.length txt in let rec loop i = if i == len then NormalIdent else if i == 0 then match String.unsafe_get txt i with - | 'A' .. 'Z' when allow_uident -> loop (i + 1) + | 'A' .. 'Z' when allowUident -> loop (i + 1) | 'a' .. 'z' | '_' -> loop (i + 1) - | '-' when allow_hyphen -> loop (i + 1) + | '-' when allowHyphen -> loop (i + 1) | _ -> ExoticIdent else match String.unsafe_get txt i with | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '\'' | '_' -> loop (i + 1) - | '-' when allow_hyphen -> loop (i + 1) + | '-' when allowHyphen -> loop (i + 1) | _ -> ExoticIdent in loop 0 -let print_ident_like ?allow_uident ?allow_hyphen txt = - let txt = Ext_ident.unwrap_uppercase_exotic txt in - match classify_ident_content ?allow_uident ?allow_hyphen txt with +let printIdentLike ?allowUident ?allowHyphen txt = + match classifyIdentContent ?allowUident ?allowHyphen txt with | ExoticIdent -> Doc.concat [Doc.text "\\\""; Doc.text txt; Doc.text "\""] | NormalIdent -> Doc.text txt @@ -416,7 +456,7 @@ let for_all_from s start p = unsafe_for_all_range s ~start ~finish:(len - 1) p (* See https://github.com/rescript-lang/rescript-compiler/blob/726cfa534314b586e5b5734471bc2023ad99ebd9/jscomp/ext/ext_string.ml#L510 *) -let is_valid_numeric_polyvar_number (x : string) = +let isValidNumericPolyvarNumber (x : string) = let len = String.length x in len > 0 && @@ -431,24 +471,23 @@ let is_valid_numeric_polyvar_number (x : string) = else a >= 48 (* Exotic identifiers in poly-vars have a "lighter" syntax: #"ease-in" *) -let print_poly_var_ident txt = +let printPolyVarIdent txt = (* numeric poly-vars don't need quotes: #644 *) - if is_valid_numeric_polyvar_number txt then Doc.text txt + if isValidNumericPolyvarNumber txt then Doc.text txt else - let txt = Ext_ident.unwrap_uppercase_exotic txt in - match classify_ident_content ~allow_uident:true txt with + match classifyIdentContent ~allowUident:true txt with | ExoticIdent -> Doc.concat [Doc.text "\""; Doc.text txt; Doc.text "\""] | NormalIdent -> ( match txt with | "" -> Doc.concat [Doc.text "\""; Doc.text txt; Doc.text "\""] | _ -> Doc.text txt) -let polyvar_ident_to_string poly_var_ident = - Doc.concat [Doc.text "#"; print_poly_var_ident poly_var_ident] - |> Doc.to_string ~width:80 +let polyVarIdentToString polyVarIdent = + Doc.concat [Doc.text "#"; printPolyVarIdent polyVarIdent] + |> Doc.toString ~width:80 -let print_lident l = - let flat_lid_opt lid = +let printLident l = + let flatLidOpt lid = let rec flat accu = function | Longident.Lident s -> Some (s :: accu) | Ldot (lid, s) -> flat (s :: accu) lid @@ -457,64 +496,64 @@ let print_lident l = flat [] lid in match l with - | Longident.Lident txt -> print_ident_like txt + | Longident.Lident txt -> printIdentLike txt | Longident.Ldot (path, txt) -> let doc = - match flat_lid_opt path with + match flatLidOpt path with | Some txts -> Doc.concat [ Doc.join ~sep:Doc.dot (List.map Doc.text txts); Doc.dot; - print_ident_like txt; + printIdentLike txt; ] | None -> Doc.text "printLident: Longident.Lapply is not supported" in doc | Lapply (_, _) -> Doc.text "printLident: Longident.Lapply is not supported" -let print_longident_location l cmt_tbl = - let doc = print_longident l.Location.txt in - print_comments doc cmt_tbl l.loc +let printLongidentLocation l cmtTbl = + let doc = printLongident l.Location.txt in + printComments doc cmtTbl l.loc (* Module.SubModule.x *) -let print_lident_path path cmt_tbl = - let doc = print_lident path.Location.txt in - print_comments doc cmt_tbl path.loc +let printLidentPath path cmtTbl = + let doc = printLident path.Location.txt in + printComments doc cmtTbl path.loc (* Module.SubModule.x or Module.SubModule.X *) -let print_ident_path path cmt_tbl = - let doc = print_lident path.Location.txt in - print_comments doc cmt_tbl path.loc +let printIdentPath path cmtTbl = + let doc = printLident path.Location.txt in + printComments doc cmtTbl path.loc -let print_string_loc sloc cmt_tbl = - let doc = print_ident_like sloc.Location.txt in - print_comments doc cmt_tbl sloc.loc +let printStringLoc sloc cmtTbl = + let doc = printIdentLike sloc.Location.txt in + printComments doc cmtTbl sloc.loc -let print_string_contents txt = +let printStringContents txt = let lines = String.split_on_char '\n' txt in - Doc.join ~sep:Doc.literal_line (List.map Doc.text lines) + Doc.join ~sep:Doc.literalLine (List.map Doc.text lines) -let print_constant ?(template_literal = false) c = +let printConstant ?(templateLiteral = false) c = match c with | Parsetree.Pconst_integer (s, suffix) -> ( match suffix with | Some c -> Doc.text (s ^ Char.escaped c) | None -> Doc.text s) | Pconst_string (txt, None) -> - Doc.concat [Doc.text "\""; print_string_contents txt; Doc.text "\""] + Doc.concat [Doc.text "\""; printStringContents txt; Doc.text "\""] | Pconst_string (txt, Some prefix) -> if prefix = "INTERNAL_RES_CHAR_CONTENTS" then Doc.concat [Doc.text "'"; Doc.text txt; Doc.text "'"] else let lquote, rquote = - if template_literal then ("`", "`") else ("\"", "\"") + if templateLiteral then ("`", "`") else ("\"", "\"") in Doc.concat [ (if prefix = "js" then Doc.nil else Doc.text prefix); Doc.text lquote; - print_string_contents txt; + printStringContents txt; Doc.text rquote; ] | Pconst_float (s, _) -> Doc.text s @@ -531,122 +570,120 @@ let print_constant ?(template_literal = false) c = let s = (Bytes.create [@doesNotRaise]) 1 in Bytes.unsafe_set s 0 c; Bytes.unsafe_to_string s - | _ -> Res_utf8.encode_code_point c + | _ -> Res_utf8.encodeCodePoint c in Doc.text ("'" ^ str ^ "'") -let print_optional_label attrs = - if Res_parsetree_viewer.has_optional_attribute attrs then Doc.text "?" +let printOptionalLabel attrs = + if Res_parsetree_viewer.hasOptionalAttribute attrs then Doc.text "?" else Doc.nil module State = struct - let custom_layout_threshold = 2 + let customLayoutThreshold = 2 - type t = {custom_layout: int; mutable uncurried_config: Config.uncurried} + type t = {customLayout: int; mutable uncurried_config: Config.uncurried} - let init () = {custom_layout = 0; uncurried_config = !Config.uncurried} + let init () = {customLayout = 0; uncurried_config = !Config.uncurried} - let next_custom_layout t = {t with custom_layout = t.custom_layout + 1} + let nextCustomLayout t = {t with customLayout = t.customLayout + 1} - let should_break_callback t = t.custom_layout > custom_layout_threshold + let shouldBreakCallback t = t.customLayout > customLayoutThreshold end -let rec print_structure ~state (s : Parsetree.structure) t = +let rec printStructure ~state (s : Parsetree.structure) t = match s with - | [] -> print_comments_inside_file t + | [] -> printCommentsInsideFile t | structure -> - print_list - ~get_loc:(fun s -> s.Parsetree.pstr_loc) + printList + ~getLoc:(fun s -> s.Parsetree.pstr_loc) ~nodes:structure - ~print:(print_structure_item ~state) + ~print:(printStructureItem ~state) t -and print_structure_item ~state (si : Parsetree.structure_item) cmt_tbl = +and printStructureItem ~state (si : Parsetree.structure_item) cmtTbl = match si.pstr_desc with - | Pstr_value (rec_flag, value_bindings) -> - let rec_flag = + | Pstr_value (rec_flag, valueBindings) -> + let recFlag = match rec_flag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - print_value_bindings ~state ~rec_flag value_bindings cmt_tbl - | Pstr_type (rec_flag, type_declarations) -> - let rec_flag = - match rec_flag with + printValueBindings ~state ~recFlag valueBindings cmtTbl + | Pstr_type (recFlag, typeDeclarations) -> + let recFlag = + match recFlag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - print_type_declarations ~state ~rec_flag type_declarations cmt_tbl - | Pstr_primitive value_description -> - print_value_description ~state value_description cmt_tbl + printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl + | Pstr_primitive valueDescription -> + printValueDescription ~state valueDescription cmtTbl | Pstr_eval (expr, attrs) -> - let expr_doc = - let doc = print_expression_with_comments ~state expr cmt_tbl in - match Parens.structure_expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + let exprDoc = + let doc = printExpressionWithComments ~state expr cmtTbl in + match Parens.structureExpr expr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc in - Doc.concat [print_attributes ~state attrs cmt_tbl; expr_doc] + Doc.concat [printAttributes ~state attrs cmtTbl; exprDoc] | Pstr_attribute attr -> - fst (print_attribute ~state ~standalone:true attr cmt_tbl) + fst (printAttribute ~state ~standalone:true attr cmtTbl) | Pstr_extension (extension, attrs) -> Doc.concat [ - print_attributes ~state attrs cmt_tbl; - Doc.concat - [print_extension ~state ~at_module_lvl:true extension cmt_tbl]; + printAttributes ~state attrs cmtTbl; + Doc.concat [printExtension ~state ~atModuleLvl:true extension cmtTbl]; ] - | Pstr_include include_declaration -> - print_include_declaration ~state include_declaration cmt_tbl - | Pstr_open open_description -> - print_open_description ~state open_description cmt_tbl - | Pstr_modtype mod_type_decl -> - print_module_type_declaration ~state mod_type_decl cmt_tbl - | Pstr_module module_binding -> - print_module_binding ~state ~is_rec:false module_binding cmt_tbl 0 - | Pstr_recmodule module_bindings -> - print_listi - ~get_loc:(fun mb -> mb.Parsetree.pmb_loc) - ~nodes:module_bindings - ~print:(print_module_binding ~state ~is_rec:true) - cmt_tbl - | Pstr_exception extension_constructor -> - print_exception_def ~state extension_constructor cmt_tbl - | Pstr_typext type_extension -> - print_type_extension ~state type_extension cmt_tbl + | Pstr_include includeDeclaration -> + printIncludeDeclaration ~state includeDeclaration cmtTbl + | Pstr_open openDescription -> + printOpenDescription ~state openDescription cmtTbl + | Pstr_modtype modTypeDecl -> + printModuleTypeDeclaration ~state modTypeDecl cmtTbl + | Pstr_module moduleBinding -> + printModuleBinding ~state ~isRec:false moduleBinding cmtTbl 0 + | Pstr_recmodule moduleBindings -> + printListi + ~getLoc:(fun mb -> mb.Parsetree.pmb_loc) + ~nodes:moduleBindings + ~print:(printModuleBinding ~state ~isRec:true) + cmtTbl + | Pstr_exception extensionConstructor -> + printExceptionDef ~state extensionConstructor cmtTbl + | Pstr_typext typeExtension -> printTypeExtension ~state typeExtension cmtTbl | Pstr_class _ | Pstr_class_type _ -> Doc.nil -and print_type_extension ~state (te : Parsetree.type_extension) cmt_tbl = +and printTypeExtension ~state (te : Parsetree.type_extension) cmtTbl = let prefix = Doc.text "type " in - let name = print_lident_path te.ptyext_path cmt_tbl in - let type_params = print_type_params ~state te.ptyext_params cmt_tbl in - let extension_constructors = + let name = printLidentPath te.ptyext_path cmtTbl in + let typeParams = printTypeParams ~state te.ptyext_params cmtTbl in + let extensionConstructors = let ecs = te.ptyext_constructors in - let force_break = + let forceBreak = match (ecs, List.rev ecs) with | first :: _, last :: _ -> first.pext_loc.loc_start.pos_lnum > te.ptyext_path.loc.loc_end.pos_lnum || first.pext_loc.loc_start.pos_lnum < last.pext_loc.loc_end.pos_lnum | _ -> false in - let private_flag = + let privateFlag = match te.ptyext_private with | Asttypes.Private -> Doc.concat [Doc.text "private"; Doc.line] | Public -> Doc.nil in let rows = - print_listi - ~get_loc:(fun n -> n.Parsetree.pext_loc) - ~print:(print_extension_constructor ~state) - ~nodes:ecs ~force_break cmt_tbl + printListi + ~getLoc:(fun n -> n.Parsetree.pext_loc) + ~print:(printExtensionConstructor ~state) + ~nodes:ecs ~forceBreak cmtTbl in - Doc.breakable_group ~force_break + Doc.breakableGroup ~forceBreak (Doc.indent (Doc.concat [ Doc.line; - private_flag; + privateFlag; rows; (* Doc.join ~sep:Doc.line ( *) (* List.mapi printExtensionConstructor ecs *) @@ -656,119 +693,119 @@ and print_type_extension ~state (te : Parsetree.type_extension) cmt_tbl = Doc.group (Doc.concat [ - print_attributes ~state ~loc:te.ptyext_path.loc te.ptyext_attributes - cmt_tbl; + printAttributes ~state ~loc:te.ptyext_path.loc te.ptyext_attributes + cmtTbl; prefix; name; - type_params; + typeParams; Doc.text " +="; - extension_constructors; + extensionConstructors; ]) -and print_module_binding ~state ~is_rec module_binding cmt_tbl i = +and printModuleBinding ~state ~isRec moduleBinding cmtTbl i = let prefix = if i = 0 then Doc.concat - [Doc.text "module "; (if is_rec then Doc.text "rec " else Doc.nil)] + [Doc.text "module "; (if isRec then Doc.text "rec " else Doc.nil)] else Doc.text "and " in - let mod_expr_doc, mod_constraint_doc = - match module_binding.pmb_expr with - | {pmod_desc = Pmod_constraint (mod_expr, mod_type)} + let modExprDoc, modConstraintDoc = + match moduleBinding.pmb_expr with + | {pmod_desc = Pmod_constraint (modExpr, modType)} when not - (ParsetreeViewer.has_await_attribute - module_binding.pmb_expr.pmod_attributes) -> - ( print_mod_expr ~state mod_expr cmt_tbl, - Doc.concat [Doc.text ": "; print_mod_type ~state mod_type cmt_tbl] ) - | mod_expr -> (print_mod_expr ~state mod_expr cmt_tbl, Doc.nil) + (ParsetreeViewer.hasAwaitAttribute + moduleBinding.pmb_expr.pmod_attributes) -> + ( printModExpr ~state modExpr cmtTbl, + Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl] ) + | modExpr -> (printModExpr ~state modExpr cmtTbl, Doc.nil) in - let mod_name = - let doc = Doc.text module_binding.pmb_name.Location.txt in - print_comments doc cmt_tbl module_binding.pmb_name.loc + let modExprDocParens = + if Parens.modExprParens moduleBinding.pmb_expr then + Doc.concat [Doc.lparen; modExprDoc; Doc.rparen] + else modExprDoc + in + let modName = + let doc = Doc.text moduleBinding.pmb_name.Location.txt in + printComments doc cmtTbl moduleBinding.pmb_name.loc in let doc = Doc.concat [ - print_attributes ~state ~loc:module_binding.pmb_name.loc - module_binding.pmb_attributes cmt_tbl; + printAttributes ~state ~loc:moduleBinding.pmb_name.loc + moduleBinding.pmb_attributes cmtTbl; prefix; - mod_name; - mod_constraint_doc; + modName; + modConstraintDoc; Doc.text " = "; - mod_expr_doc; + modExprDocParens; ] in - print_comments doc cmt_tbl module_binding.pmb_loc + printComments doc cmtTbl moduleBinding.pmb_loc -and print_module_type_declaration ~state - (mod_type_decl : Parsetree.module_type_declaration) cmt_tbl = - let mod_name = - let doc = Doc.text mod_type_decl.pmtd_name.txt in - print_comments doc cmt_tbl mod_type_decl.pmtd_name.loc +and printModuleTypeDeclaration ~state + (modTypeDecl : Parsetree.module_type_declaration) cmtTbl = + let modName = + let doc = Doc.text modTypeDecl.pmtd_name.txt in + printComments doc cmtTbl modTypeDecl.pmtd_name.loc in Doc.concat [ - print_attributes ~state mod_type_decl.pmtd_attributes cmt_tbl; + printAttributes ~state modTypeDecl.pmtd_attributes cmtTbl; Doc.text "module type "; - mod_name; - (match mod_type_decl.pmtd_type with + modName; + (match modTypeDecl.pmtd_type with | None -> Doc.nil - | Some mod_type -> - Doc.concat [Doc.text " = "; print_mod_type ~state mod_type cmt_tbl]); + | Some modType -> + Doc.concat [Doc.text " = "; printModType ~state modType cmtTbl]); ] -and print_mod_type ~state mod_type cmt_tbl = - let mod_type_doc = - match mod_type.pmty_desc with +and printModType ~state modType cmtTbl = + let modTypeDoc = + match modType.pmty_desc with | Parsetree.Pmty_ident longident -> Doc.concat [ - print_attributes ~state ~loc:longident.loc mod_type.pmty_attributes - cmt_tbl; - print_longident_location longident cmt_tbl; + printAttributes ~state ~loc:longident.loc modType.pmty_attributes + cmtTbl; + printLongidentLocation longident cmtTbl; ] | Pmty_signature [] -> - if has_comments_inside cmt_tbl mod_type.pmty_loc then - let doc = print_comments_inside cmt_tbl mod_type.pmty_loc in + if hasCommentsInside cmtTbl modType.pmty_loc then + let doc = printCommentsInside cmtTbl modType.pmty_loc in Doc.concat [Doc.lbrace; doc; Doc.rbrace] else - let should_break = - mod_type.pmty_loc.loc_start.pos_lnum - < mod_type.pmty_loc.loc_end.pos_lnum + let shouldBreak = + modType.pmty_loc.loc_start.pos_lnum + < modType.pmty_loc.loc_end.pos_lnum in - Doc.breakable_group ~force_break:should_break - (Doc.concat [Doc.lbrace; Doc.soft_line; Doc.soft_line; Doc.rbrace]) + Doc.breakableGroup ~forceBreak:shouldBreak + (Doc.concat [Doc.lbrace; Doc.softLine; Doc.softLine; Doc.rbrace]) | Pmty_signature signature -> - let signature_doc = - Doc.breakable_group ~force_break:true + let signatureDoc = + Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.lbrace; Doc.indent - (Doc.concat - [Doc.line; print_signature ~state signature cmt_tbl]); + (Doc.concat [Doc.line; printSignature ~state signature cmtTbl]); Doc.line; Doc.rbrace; ]) in Doc.concat - [ - print_attributes ~state mod_type.pmty_attributes cmt_tbl; signature_doc; - ] + [printAttributes ~state modType.pmty_attributes cmtTbl; signatureDoc] | Pmty_functor _ -> - let parameters, return_type = ParsetreeViewer.functor_type mod_type in - let parameters_doc = + let parameters, returnType = ParsetreeViewer.functorType modType in + let parametersDoc = match parameters with | [] -> Doc.nil - | [(attrs, {Location.txt = "_"; loc}, Some mod_type)] -> - let cmt_loc = - {loc with loc_end = mod_type.Parsetree.pmty_loc.loc_end} - in - let attrs = print_attributes ~state attrs cmt_tbl in - let doc = - Doc.concat [attrs; print_mod_type ~state mod_type cmt_tbl] + | [(attrs, {Location.txt = "_"; loc}, Some modType)] -> + let cmtLoc = + {loc with loc_end = modType.Parsetree.pmty_loc.loc_end} in - print_comments doc cmt_tbl cmt_loc + let attrs = printAttributes ~state attrs cmtTbl in + let doc = Doc.concat [attrs; printModType ~state modType cmtTbl] in + printComments doc cmtTbl cmtLoc | params -> Doc.group (Doc.concat @@ -777,79 +814,76 @@ and print_mod_type ~state mod_type cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun (attrs, lbl, mod_type) -> - let cmt_loc = - match mod_type with + (fun (attrs, lbl, modType) -> + let cmtLoc = + match modType with | None -> lbl.Asttypes.loc - | Some mod_type -> + | Some modType -> { lbl.Asttypes.loc with loc_end = - mod_type.Parsetree.pmty_loc.loc_end; + modType.Parsetree.pmty_loc.loc_end; } in let attrs = - print_attributes ~state attrs cmt_tbl + printAttributes ~state attrs cmtTbl in - let lbl_doc = + let lblDoc = if lbl.Location.txt = "_" || lbl.txt = "*" then Doc.nil else let doc = Doc.text lbl.txt in - print_comments doc cmt_tbl lbl.loc + printComments doc cmtTbl lbl.loc in let doc = Doc.concat [ attrs; - lbl_doc; - (match mod_type with + lblDoc; + (match modType with | None -> Doc.nil - | Some mod_type -> + | Some modType -> Doc.concat [ (if lbl.txt = "_" then Doc.nil else Doc.text ": "); - print_mod_type ~state mod_type - cmt_tbl; + printModType ~state modType cmtTbl; ]); ] in - print_comments doc cmt_tbl cmt_loc) + printComments doc cmtTbl cmtLoc) params); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ]) in - let return_doc = - let doc = print_mod_type ~state return_type cmt_tbl in - if Parens.mod_type_functor_return return_type then add_parens doc - else doc + let returnDoc = + let doc = printModType ~state returnType cmtTbl in + if Parens.modTypeFunctorReturn returnType then addParens doc else doc in Doc.group (Doc.concat [ - parameters_doc; - Doc.group (Doc.concat [Doc.text " =>"; Doc.line; return_doc]); + parametersDoc; + Doc.group (Doc.concat [Doc.text " =>"; Doc.line; returnDoc]); ]) - | Pmty_typeof mod_expr -> + | Pmty_typeof modExpr -> Doc.concat - [Doc.text "module type of "; print_mod_expr ~state mod_expr cmt_tbl] + [Doc.text "module type of "; printModExpr ~state modExpr cmtTbl] | Pmty_extension extension -> - print_extension ~state ~at_module_lvl:false extension cmt_tbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Pmty_alias longident -> - Doc.concat - [Doc.text "module "; print_longident_location longident cmt_tbl] - | Pmty_with (mod_type, with_constraints) -> + Doc.concat [Doc.text "module "; printLongidentLocation longident cmtTbl] + | Pmty_with (modType, withConstraints) -> let operand = - let doc = print_mod_type ~state mod_type cmt_tbl in - if Parens.mod_type_with_operand mod_type then add_parens doc else doc + let doc = printModType ~state modType cmtTbl in + if Parens.modTypeWithOperand modType then addParens doc else doc in Doc.group (Doc.concat @@ -857,235 +891,228 @@ and print_mod_type ~state mod_type cmt_tbl = operand; Doc.indent (Doc.concat - [ - Doc.line; - print_with_constraints ~state with_constraints cmt_tbl; - ]); + [Doc.line; printWithConstraints ~state withConstraints cmtTbl]); ]) in - let attrs_already_printed = - match mod_type.pmty_desc with + let attrsAlreadyPrinted = + match modType.pmty_desc with | Pmty_functor _ | Pmty_signature _ | Pmty_ident _ -> true | _ -> false in let doc = Doc.concat [ - (if attrs_already_printed then Doc.nil - else print_attributes ~state mod_type.pmty_attributes cmt_tbl); - mod_type_doc; + (if attrsAlreadyPrinted then Doc.nil + else printAttributes ~state modType.pmty_attributes cmtTbl); + modTypeDoc; ] in - print_comments doc cmt_tbl mod_type.pmty_loc + printComments doc cmtTbl modType.pmty_loc -and print_with_constraints ~state with_constraints cmt_tbl = +and printWithConstraints ~state withConstraints cmtTbl = let rows = List.mapi - (fun i with_constraint -> + (fun i withConstraint -> Doc.group (Doc.concat [ (if i == 0 then Doc.text "with " else Doc.text "and "); - print_with_constraint ~state with_constraint cmt_tbl; + printWithConstraint ~state withConstraint cmtTbl; ])) - with_constraints + withConstraints in Doc.join ~sep:Doc.line rows -and print_with_constraint ~state (with_constraint : Parsetree.with_constraint) - cmt_tbl = - match with_constraint with +and printWithConstraint ~state (withConstraint : Parsetree.with_constraint) + cmtTbl = + match withConstraint with (* with type X.t = ... *) - | Pwith_type (longident, type_declaration) -> + | Pwith_type (longident, typeDeclaration) -> Doc.group - (print_type_declaration ~state - ~name:(print_lident_path longident cmt_tbl) - ~equal_sign:"=" ~rec_flag:Doc.nil 0 type_declaration CommentTable.empty) + (printTypeDeclaration ~state + ~name:(printLidentPath longident cmtTbl) + ~equalSign:"=" ~recFlag:Doc.nil 0 typeDeclaration CommentTable.empty) (* with module X.Y = Z *) | Pwith_module ({txt = longident1}, {txt = longident2}) -> Doc.concat [ Doc.text "module "; - print_longident longident1; + printLongident longident1; Doc.text " ="; - Doc.indent (Doc.concat [Doc.line; print_longident longident2]); + Doc.indent (Doc.concat [Doc.line; printLongident longident2]); ] (* with type X.t := ..., same format as [Pwith_type] *) - | Pwith_typesubst (longident, type_declaration) -> + | Pwith_typesubst (longident, typeDeclaration) -> Doc.group - (print_type_declaration ~state - ~name:(print_lident_path longident cmt_tbl) - ~equal_sign:":=" ~rec_flag:Doc.nil 0 type_declaration - CommentTable.empty) + (printTypeDeclaration ~state + ~name:(printLidentPath longident cmtTbl) + ~equalSign:":=" ~recFlag:Doc.nil 0 typeDeclaration CommentTable.empty) | Pwith_modsubst ({txt = longident1}, {txt = longident2}) -> Doc.concat [ Doc.text "module "; - print_longident longident1; + printLongident longident1; Doc.text " :="; - Doc.indent (Doc.concat [Doc.line; print_longident longident2]); + Doc.indent (Doc.concat [Doc.line; printLongident longident2]); ] -and print_signature ~state signature cmt_tbl = +and printSignature ~state signature cmtTbl = match signature with - | [] -> print_comments_inside_file cmt_tbl + | [] -> printCommentsInsideFile cmtTbl | signature -> - print_list - ~get_loc:(fun s -> s.Parsetree.psig_loc) + printList + ~getLoc:(fun s -> s.Parsetree.psig_loc) ~nodes:signature - ~print:(print_signature_item ~state) - cmt_tbl + ~print:(printSignatureItem ~state) + cmtTbl -and print_signature_item ~state (si : Parsetree.signature_item) cmt_tbl = +and printSignatureItem ~state (si : Parsetree.signature_item) cmtTbl = match si.psig_desc with - | Parsetree.Psig_value value_description -> - print_value_description ~state value_description cmt_tbl - | Psig_type (rec_flag, type_declarations) -> - let rec_flag = - match rec_flag with + | Parsetree.Psig_value valueDescription -> + printValueDescription ~state valueDescription cmtTbl + | Psig_type (recFlag, typeDeclarations) -> + let recFlag = + match recFlag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - print_type_declarations ~state ~rec_flag type_declarations cmt_tbl - | Psig_typext type_extension -> - print_type_extension ~state type_extension cmt_tbl - | Psig_exception extension_constructor -> - print_exception_def ~state extension_constructor cmt_tbl - | Psig_module module_declaration -> - print_module_declaration ~state module_declaration cmt_tbl - | Psig_recmodule module_declarations -> - print_rec_module_declarations ~state module_declarations cmt_tbl - | Psig_modtype mod_type_decl -> - print_module_type_declaration ~state mod_type_decl cmt_tbl - | Psig_open open_description -> - print_open_description ~state open_description cmt_tbl - | Psig_include include_description -> - print_include_description ~state include_description cmt_tbl + printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl + | Psig_typext typeExtension -> printTypeExtension ~state typeExtension cmtTbl + | Psig_exception extensionConstructor -> + printExceptionDef ~state extensionConstructor cmtTbl + | Psig_module moduleDeclaration -> + printModuleDeclaration ~state moduleDeclaration cmtTbl + | Psig_recmodule moduleDeclarations -> + printRecModuleDeclarations ~state moduleDeclarations cmtTbl + | Psig_modtype modTypeDecl -> + printModuleTypeDeclaration ~state modTypeDecl cmtTbl + | Psig_open openDescription -> + printOpenDescription ~state openDescription cmtTbl + | Psig_include includeDescription -> + printIncludeDescription ~state includeDescription cmtTbl | Psig_attribute attr -> - fst (print_attribute ~state ~standalone:true attr cmt_tbl) + fst (printAttribute ~state ~standalone:true attr cmtTbl) | Psig_extension (extension, attrs) -> Doc.concat [ - print_attributes ~state attrs cmt_tbl; - Doc.concat - [print_extension ~state ~at_module_lvl:true extension cmt_tbl]; + printAttributes ~state attrs cmtTbl; + Doc.concat [printExtension ~state ~atModuleLvl:true extension cmtTbl]; ] | Psig_class _ | Psig_class_type _ -> Doc.nil -and print_rec_module_declarations ~state module_declarations cmt_tbl = - print_listi - ~get_loc:(fun n -> n.Parsetree.pmd_loc) - ~nodes:module_declarations - ~print:(print_rec_module_declaration ~state) - cmt_tbl +and printRecModuleDeclarations ~state moduleDeclarations cmtTbl = + printListi + ~getLoc:(fun n -> n.Parsetree.pmd_loc) + ~nodes:moduleDeclarations + ~print:(printRecModuleDeclaration ~state) + cmtTbl -and print_rec_module_declaration ~state md cmt_tbl i = +and printRecModuleDeclaration ~state md cmtTbl i = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> - Doc.concat [Doc.text " = "; print_longident_location longident cmt_tbl] + Doc.concat [Doc.text " = "; printLongidentLocation longident cmtTbl] | _ -> - let needs_parens = + let needsParens = match md.pmd_type.pmty_desc with | Pmty_with _ -> true | _ -> false in - let mod_type_doc = - let doc = print_mod_type ~state md.pmd_type cmt_tbl in - if needs_parens then add_parens doc else doc + let modTypeDoc = + let doc = printModType ~state md.pmd_type cmtTbl in + if needsParens then addParens doc else doc in - Doc.concat [Doc.text ": "; mod_type_doc] + Doc.concat [Doc.text ": "; modTypeDoc] in let prefix = if i < 1 then "module rec " else "and " in Doc.concat [ - print_attributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmt_tbl; + printAttributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; Doc.text prefix; - print_comments (Doc.text md.pmd_name.txt) cmt_tbl md.pmd_name.loc; + printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; body; ] -and print_module_declaration ~state (md : Parsetree.module_declaration) cmt_tbl - = +and printModuleDeclaration ~state (md : Parsetree.module_declaration) cmtTbl = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> - Doc.concat [Doc.text " = "; print_longident_location longident cmt_tbl] - | _ -> Doc.concat [Doc.text ": "; print_mod_type ~state md.pmd_type cmt_tbl] + Doc.concat [Doc.text " = "; printLongidentLocation longident cmtTbl] + | _ -> Doc.concat [Doc.text ": "; printModType ~state md.pmd_type cmtTbl] in Doc.concat [ - print_attributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmt_tbl; + printAttributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; Doc.text "module "; - print_comments (Doc.text md.pmd_name.txt) cmt_tbl md.pmd_name.loc; + printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; body; ] -and print_open_description ~state - (open_description : Parsetree.open_description) cmt_tbl = +and printOpenDescription ~state (openDescription : Parsetree.open_description) + cmtTbl = Doc.concat [ - print_attributes ~state open_description.popen_attributes cmt_tbl; + printAttributes ~state openDescription.popen_attributes cmtTbl; Doc.text "open"; - (match open_description.popen_override with + (match openDescription.popen_override with | Asttypes.Fresh -> Doc.space | Asttypes.Override -> Doc.text "! "); - print_longident_location open_description.popen_lid cmt_tbl; + printLongidentLocation openDescription.popen_lid cmtTbl; ] -and print_include_description ~state - (include_description : Parsetree.include_description) cmt_tbl = +and printIncludeDescription ~state + (includeDescription : Parsetree.include_description) cmtTbl = Doc.concat [ - print_attributes ~state include_description.pincl_attributes cmt_tbl; + printAttributes ~state includeDescription.pincl_attributes cmtTbl; Doc.text "include "; - print_mod_type ~state include_description.pincl_mod cmt_tbl; + printModType ~state includeDescription.pincl_mod cmtTbl; ] -and print_include_declaration ~state - (include_declaration : Parsetree.include_declaration) cmt_tbl = +and printIncludeDeclaration ~state + (includeDeclaration : Parsetree.include_declaration) cmtTbl = Doc.concat [ - print_attributes ~state include_declaration.pincl_attributes cmt_tbl; + printAttributes ~state includeDeclaration.pincl_attributes cmtTbl; Doc.text "include "; - (let include_doc = - print_mod_expr ~state include_declaration.pincl_mod cmt_tbl + (let includeDoc = + printModExpr ~state includeDeclaration.pincl_mod cmtTbl in - if Parens.include_mod_expr include_declaration.pincl_mod then - add_parens include_doc - else include_doc); + if Parens.includeModExpr includeDeclaration.pincl_mod then + addParens includeDoc + else includeDoc); ] -and print_value_bindings ~state ~rec_flag (vbs : Parsetree.value_binding list) - cmt_tbl = - print_listi - ~get_loc:(fun vb -> vb.Parsetree.pvb_loc) +and printValueBindings ~state ~recFlag (vbs : Parsetree.value_binding list) + cmtTbl = + printListi + ~getLoc:(fun vb -> vb.Parsetree.pvb_loc) ~nodes:vbs - ~print:(print_value_binding ~state ~rec_flag) - cmt_tbl + ~print:(printValueBinding ~state ~recFlag) + cmtTbl -and print_value_description ~state value_description cmt_tbl = - let is_external = - match value_description.pval_prim with +and printValueDescription ~state valueDescription cmtTbl = + let isExternal = + match valueDescription.pval_prim with | [] -> false | _ -> true in let attrs = - print_attributes ~state ~loc:value_description.pval_name.loc - value_description.pval_attributes cmt_tbl + printAttributes ~state ~loc:valueDescription.pval_name.loc + valueDescription.pval_attributes cmtTbl in - let header = if is_external then "external " else "let " in + let header = if isExternal then "external " else "let " in Doc.group (Doc.concat [ attrs; Doc.text header; - print_comments - (print_ident_like value_description.pval_name.txt) - cmt_tbl value_description.pval_name.loc; + printComments + (printIdentLike valueDescription.pval_name.txt) + cmtTbl valueDescription.pval_name.loc; Doc.text ": "; - print_typ_expr ~state value_description.pval_type cmt_tbl; - (if is_external then + printTypExpr ~state valueDescription.pval_type cmtTbl; + (if isExternal then Doc.group (Doc.concat [ @@ -1099,18 +1126,18 @@ and print_value_description ~state value_description cmt_tbl = (fun s -> Doc.concat [Doc.text "\""; Doc.text s; Doc.text "\""]) - value_description.pval_prim); + valueDescription.pval_prim); ]); ]) else Doc.nil); ]) -and print_type_declarations ~state ~rec_flag type_declarations cmt_tbl = - print_listi - ~get_loc:(fun n -> n.Parsetree.ptype_loc) - ~nodes:type_declarations - ~print:(print_type_declaration2 ~state ~rec_flag) - cmt_tbl +and printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl = + printListi + ~getLoc:(fun n -> n.Parsetree.ptype_loc) + ~nodes:typeDeclarations + ~print:(printTypeDeclaration2 ~state ~recFlag) + cmtTbl (* * type_declaration = { @@ -1144,17 +1171,17 @@ and print_type_declarations ~state ~rec_flag type_declarations cmt_tbl = * (* Invariant: non-empty list *) * | Ptype_open *) -and print_type_declaration ~state ~name ~equal_sign ~rec_flag i - (td : Parsetree.type_declaration) cmt_tbl = +and printTypeDeclaration ~state ~name ~equalSign ~recFlag i + (td : Parsetree.type_declaration) cmtTbl = let attrs = - print_attributes ~state ~loc:td.ptype_loc td.ptype_attributes cmt_tbl + printAttributes ~state ~loc:td.ptype_loc td.ptype_attributes cmtTbl in let prefix = - if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; rec_flag] + if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; recFlag] in - let type_name = name in - let type_params = print_type_params ~state td.ptype_params cmt_tbl in - let manifest_and_kind = + let typeName = name in + let typeParams = printTypeParams ~state td.ptype_params cmtTbl in + let manifestAndKind = match td.ptype_kind with | Ptype_abstract -> ( match td.ptype_manifest with @@ -1162,15 +1189,15 @@ and print_type_declaration ~state ~name ~equal_sign ~rec_flag i | Some typ -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; - print_private_flag td.ptype_private; - print_typ_expr ~state typ cmt_tbl; + Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; + printPrivateFlag td.ptype_private; + printTypExpr ~state typ cmtTbl; ]) | Ptype_open -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; - print_private_flag td.ptype_private; + Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; + printPrivateFlag td.ptype_private; Doc.text ".."; ] | Ptype_record lds -> @@ -1180,16 +1207,16 @@ and print_type_declaration ~state ~name ~equal_sign ~rec_flag i | Some typ -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; - print_typ_expr ~state typ cmt_tbl; + Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; + printTypExpr ~state typ cmtTbl; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; - print_private_flag td.ptype_private; - print_record_declaration ~state lds cmt_tbl; + Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; + printPrivateFlag td.ptype_private; + printRecordDeclaration ~state lds cmtTbl; ] | Ptype_variant cds -> let manifest = @@ -1198,39 +1225,39 @@ and print_type_declaration ~state ~name ~equal_sign ~rec_flag i | Some typ -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; - print_typ_expr ~state typ cmt_tbl; + Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; + printTypExpr ~state typ cmtTbl; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equal_sign]; - print_constructor_declarations ~state ~private_flag:td.ptype_private - cds cmt_tbl; + Doc.concat [Doc.space; Doc.text equalSign]; + printConstructorDeclarations ~state ~privateFlag:td.ptype_private cds + cmtTbl; ] in - let constraints = print_type_definition_constraints ~state td.ptype_cstrs in + let constraints = printTypeDefinitionConstraints ~state td.ptype_cstrs in Doc.group (Doc.concat - [attrs; prefix; type_name; type_params; manifest_and_kind; constraints]) + [attrs; prefix; typeName; typeParams; manifestAndKind; constraints]) -and print_type_declaration2 ~state ~rec_flag (td : Parsetree.type_declaration) - cmt_tbl i = +and printTypeDeclaration2 ~state ~recFlag (td : Parsetree.type_declaration) + cmtTbl i = let name = - let doc = print_ident_like td.Parsetree.ptype_name.txt in - print_comments doc cmt_tbl td.ptype_name.loc + let doc = printIdentLike td.Parsetree.ptype_name.txt in + printComments doc cmtTbl td.ptype_name.loc in - let equal_sign = "=" in + let equalSign = "=" in let attrs = - print_attributes ~state ~loc:td.ptype_loc td.ptype_attributes cmt_tbl + printAttributes ~state ~loc:td.ptype_loc td.ptype_attributes cmtTbl in let prefix = - if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; rec_flag] + if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; recFlag] in - let type_name = name in - let type_params = print_type_params ~state td.ptype_params cmt_tbl in - let manifest_and_kind = + let typeName = name in + let typeParams = printTypeParams ~state td.ptype_params cmtTbl in + let manifestAndKind = match td.ptype_kind with | Ptype_abstract -> ( match td.ptype_manifest with @@ -1238,15 +1265,15 @@ and print_type_declaration2 ~state ~rec_flag (td : Parsetree.type_declaration) | Some typ -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; - print_private_flag td.ptype_private; - print_typ_expr ~state typ cmt_tbl; + Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; + printPrivateFlag td.ptype_private; + printTypExpr ~state typ cmtTbl; ]) | Ptype_open -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; - print_private_flag td.ptype_private; + Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; + printPrivateFlag td.ptype_private; Doc.text ".."; ] | Ptype_record lds -> @@ -1254,10 +1281,10 @@ and print_type_declaration2 ~state ~rec_flag (td : Parsetree.type_declaration) Doc.concat [ Doc.space; - Doc.text equal_sign; + Doc.text equalSign; Doc.space; Doc.lbrace; - print_comments_inside cmt_tbl td.ptype_loc; + printCommentsInside cmtTbl td.ptype_loc; Doc.rbrace; ] else @@ -1267,16 +1294,16 @@ and print_type_declaration2 ~state ~rec_flag (td : Parsetree.type_declaration) | Some typ -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; - print_typ_expr ~state typ cmt_tbl; + Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; + printTypExpr ~state typ cmtTbl; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; - print_private_flag td.ptype_private; - print_record_declaration ~state lds cmt_tbl; + Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; + printPrivateFlag td.ptype_private; + printRecordDeclaration ~state lds cmtTbl; ] | Ptype_variant cds -> let manifest = @@ -1285,24 +1312,24 @@ and print_type_declaration2 ~state ~rec_flag (td : Parsetree.type_declaration) | Some typ -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; - print_typ_expr ~state typ cmt_tbl; + Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; + printTypExpr ~state typ cmtTbl; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equal_sign]; - print_constructor_declarations ~state ~private_flag:td.ptype_private - cds cmt_tbl; + Doc.concat [Doc.space; Doc.text equalSign]; + printConstructorDeclarations ~state ~privateFlag:td.ptype_private cds + cmtTbl; ] in - let constraints = print_type_definition_constraints ~state td.ptype_cstrs in + let constraints = printTypeDefinitionConstraints ~state td.ptype_cstrs in Doc.group (Doc.concat - [attrs; prefix; type_name; type_params; manifest_and_kind; constraints]) + [attrs; prefix; typeName; typeParams; manifestAndKind; constraints]) -and print_type_definition_constraints ~state cstrs = +and printTypeDefinitionConstraints ~state cstrs = match cstrs with | [] -> Doc.nil | cstrs -> @@ -1313,137 +1340,137 @@ and print_type_definition_constraints ~state cstrs = Doc.line; Doc.group (Doc.join ~sep:Doc.line - (List.map (print_type_definition_constraint ~state) cstrs)); + (List.map (printTypeDefinitionConstraint ~state) cstrs)); ])) -and print_type_definition_constraint ~state +and printTypeDefinitionConstraint ~state ((typ1, typ2, _loc) : Parsetree.core_type * Parsetree.core_type * Location.t) = Doc.concat [ Doc.text "constraint "; - print_typ_expr ~state typ1 CommentTable.empty; + printTypExpr ~state typ1 CommentTable.empty; Doc.text " = "; - print_typ_expr ~state typ2 CommentTable.empty; + printTypExpr ~state typ2 CommentTable.empty; ] -and print_private_flag (flag : Asttypes.private_flag) = +and printPrivateFlag (flag : Asttypes.private_flag) = match flag with | Private -> Doc.text "private " | Public -> Doc.nil -and print_type_params ~state type_params cmt_tbl = - match type_params with +and printTypeParams ~state typeParams cmtTbl = + match typeParams with | [] -> Doc.nil - | type_params -> + | typeParams -> Doc.group (Doc.concat [ - Doc.less_than; + Doc.lessThan; Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun type_param -> - let doc = print_type_param ~state type_param cmt_tbl in - print_comments doc cmt_tbl - (fst type_param).Parsetree.ptyp_loc) - type_params); + (fun typeParam -> + let doc = printTypeParam ~state typeParam cmtTbl in + printComments doc cmtTbl + (fst typeParam).Parsetree.ptyp_loc) + typeParams); ]); - Doc.trailing_comma; - Doc.soft_line; - Doc.greater_than; + Doc.trailingComma; + Doc.softLine; + Doc.greaterThan; ]) -and print_type_param ~state (param : Parsetree.core_type * Asttypes.variance) - cmt_tbl = +and printTypeParam ~state (param : Parsetree.core_type * Asttypes.variance) + cmtTbl = let typ, variance = param in - let printed_variance = + let printedVariance = match variance with | Covariant -> Doc.text "+" | Contravariant -> Doc.text "-" | Invariant -> Doc.nil in - Doc.concat [printed_variance; print_typ_expr ~state typ cmt_tbl] + Doc.concat [printedVariance; printTypExpr ~state typ cmtTbl] -and print_record_declaration ~state (lds : Parsetree.label_declaration list) - cmt_tbl = - let force_break = +and printRecordDeclaration ~state (lds : Parsetree.label_declaration list) + cmtTbl = + let forceBreak = match (lds, List.rev lds) with | first :: _, last :: _ -> first.pld_loc.loc_start.pos_lnum < last.pld_loc.loc_end.pos_lnum | _ -> false in - Doc.breakable_group ~force_break + Doc.breakableGroup ~forceBreak (Doc.concat [ Doc.lbrace; Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = print_label_declaration ~state ld cmt_tbl in - print_comments doc cmt_tbl ld.Parsetree.pld_loc) + let doc = printLabelDeclaration ~state ld cmtTbl in + printComments doc cmtTbl ld.Parsetree.pld_loc) lds); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbrace; ]) -and print_constructor_declarations ~state ~private_flag - (cds : Parsetree.constructor_declaration list) cmt_tbl = - let force_break = +and printConstructorDeclarations ~state ~privateFlag + (cds : Parsetree.constructor_declaration list) cmtTbl = + let forceBreak = match (cds, List.rev cds) with | first :: _, last :: _ -> first.pcd_loc.loc_start.pos_lnum < last.pcd_loc.loc_end.pos_lnum | _ -> false in - let private_flag = - match private_flag with + let privateFlag = + match privateFlag with | Asttypes.Private -> Doc.concat [Doc.text "private"; Doc.line] | Public -> Doc.nil in let rows = - print_listi - ~get_loc:(fun cd -> cd.Parsetree.pcd_loc) + printListi + ~getLoc:(fun cd -> cd.Parsetree.pcd_loc) ~nodes:cds - ~print:(fun cd cmt_tbl i -> - let doc = print_constructor_declaration2 ~state i cd cmt_tbl in - print_comments doc cmt_tbl cd.Parsetree.pcd_loc) - ~force_break cmt_tbl - in - Doc.breakable_group ~force_break - (Doc.indent (Doc.concat [Doc.line; private_flag; rows])) - -and print_constructor_declaration2 ~state i - (cd : Parsetree.constructor_declaration) cmt_tbl = - let attrs = print_attributes ~state cd.pcd_attributes cmt_tbl in - let is_dot_dot_dot = cd.pcd_name.txt = "..." in + ~print:(fun cd cmtTbl i -> + let doc = printConstructorDeclaration2 ~state i cd cmtTbl in + printComments doc cmtTbl cd.Parsetree.pcd_loc) + ~forceBreak cmtTbl + in + Doc.breakableGroup ~forceBreak + (Doc.indent (Doc.concat [Doc.line; privateFlag; rows])) + +and printConstructorDeclaration2 ~state i + (cd : Parsetree.constructor_declaration) cmtTbl = + let attrs = printAttributes ~state cd.pcd_attributes cmtTbl in + let isDotDotDot = cd.pcd_name.txt = "..." in let bar = - if i > 0 || cd.pcd_attributes <> [] || is_dot_dot_dot then Doc.text "| " - else Doc.if_breaks (Doc.text "| ") Doc.nil + if i > 0 || cd.pcd_attributes <> [] || isDotDotDot then Doc.text "| " + else Doc.ifBreaks (Doc.text "| ") Doc.nil in - let constr_name = + let constrName = let doc = Doc.text cd.pcd_name.txt in - print_comments doc cmt_tbl cd.pcd_name.loc + printComments doc cmtTbl cd.pcd_name.loc in - let constr_args = - print_constructor_arguments ~is_dot_dot_dot ~state ~indent:true cd.pcd_args - cmt_tbl + let constrArgs = + printConstructorArguments ~isDotDotDot ~state ~indent:true cd.pcd_args + cmtTbl in let gadt = match cd.pcd_res with | None -> Doc.nil | Some typ -> - Doc.indent (Doc.concat [Doc.text ": "; print_typ_expr ~state typ cmt_tbl]) + Doc.indent (Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl]) in Doc.concat [ @@ -1453,34 +1480,34 @@ and print_constructor_declaration2 ~state i [ attrs; (* TODO: fix parsing of attributes, so when can print them above the bar? *) - constr_name; - constr_args; + constrName; + constrArgs; gadt; ]); ] -and print_constructor_arguments ?(is_dot_dot_dot = false) ~state ~indent - (cd_args : Parsetree.constructor_arguments) cmt_tbl = - match cd_args with +and printConstructorArguments ?(isDotDotDot = false) ~state ~indent + (cdArgs : Parsetree.constructor_arguments) cmtTbl = + match cdArgs with | Pcstr_tuple [] -> Doc.nil | Pcstr_tuple types -> let args = Doc.concat [ - (if is_dot_dot_dot then Doc.nil else Doc.lparen); + (if isDotDotDot then Doc.nil else Doc.lparen); Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> print_typ_expr ~state typexpr cmt_tbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) types); ]); - Doc.trailing_comma; - Doc.soft_line; - (if is_dot_dot_dot then Doc.nil else Doc.rparen); + Doc.trailingComma; + Doc.softLine; + (if isDotDotDot then Doc.nil else Doc.rparen); ] in Doc.group (if indent then Doc.indent args else args) @@ -1494,88 +1521,88 @@ and print_constructor_arguments ?(is_dot_dot_dot = false) ~state ~indent Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = print_label_declaration ~state ld cmt_tbl in - print_comments doc cmt_tbl ld.Parsetree.pld_loc) + let doc = printLabelDeclaration ~state ld cmtTbl in + printComments doc cmtTbl ld.Parsetree.pld_loc) lds); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbrace; Doc.rparen; ] in if indent then Doc.indent args else args -and print_label_declaration ~state (ld : Parsetree.label_declaration) cmt_tbl = +and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = let attrs = - print_attributes ~state ~loc:ld.pld_name.loc ld.pld_attributes cmt_tbl + printAttributes ~state ~loc:ld.pld_name.loc ld.pld_attributes cmtTbl in - let mutable_flag = + let mutableFlag = match ld.pld_mutable with | Mutable -> Doc.text "mutable " | Immutable -> Doc.nil in - let name, is_dot = - let doc, is_dot = + let name, isDot = + let doc, isDot = if ld.pld_name.txt = "..." then (Doc.text ld.pld_name.txt, true) - else (print_ident_like ld.pld_name.txt, false) + else (printIdentLike ld.pld_name.txt, false) in - (print_comments doc cmt_tbl ld.pld_name.loc, is_dot) + (printComments doc cmtTbl ld.pld_name.loc, isDot) in - let optional = print_optional_label ld.pld_attributes in + let optional = printOptionalLabel ld.pld_attributes in Doc.group (Doc.concat [ attrs; - mutable_flag; + mutableFlag; name; optional; - (if is_dot then Doc.nil else Doc.text ": "); - print_typ_expr ~state ld.pld_type cmt_tbl; + (if isDot then Doc.nil else Doc.text ": "); + printTypExpr ~state ld.pld_type cmtTbl; ]) -and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl = - let print_arrow ~uncurried ?(arity = max_int) typ_expr = - let attrs_before, args, return_type = - ParsetreeViewer.arrow_type ~arity typ_expr +and printTypExpr ~(state : State.t) (typExpr : Parsetree.core_type) cmtTbl = + let printArrow ~uncurried ?(arity = max_int) typExpr = + let attrsBefore, args, returnType = + ParsetreeViewer.arrowType ~arity typExpr in - let dotted, attrs_before = + let dotted, attrsBefore = let dotted = - state.uncurried_config |> Res_uncurried.get_dotted ~uncurried + state.uncurried_config |> Res_uncurried.getDotted ~uncurried in (* Converting .ml code to .res requires processing uncurried attributes *) - let has_bs, attrs = ParsetreeViewer.process_bs_attribute attrs_before in - (dotted || has_bs, attrs) + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in + (dotted || hasBs, attrs) in - let return_type_needs_parens = - match return_type.ptyp_desc with + let returnTypeNeedsParens = + match returnType.ptyp_desc with | Ptyp_alias _ -> true | _ -> false in - let return_doc = - let doc = print_typ_expr ~state return_type cmt_tbl in - if return_type_needs_parens then Doc.concat [Doc.lparen; doc; Doc.rparen] + let returnDoc = + let doc = printTypExpr ~state returnType cmtTbl in + if returnTypeNeedsParens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in match args with | [] -> Doc.nil | [([], Nolabel, n)] when not dotted -> - let has_attrs_before = not (attrs_before = []) in + let hasAttrsBefore = not (attrsBefore = []) in let attrs = - if has_attrs_before then - print_attributes ~state ~inline:true attrs_before cmt_tbl + if hasAttrsBefore then + printAttributes ~state ~inline:true attrsBefore cmtTbl else Doc.nil in - let typ_doc = - let doc = print_typ_expr ~state n cmt_tbl in + let typDoc = + let doc = printTypExpr ~state n cmtTbl in match n.ptyp_desc with - | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> add_parens doc - | _ when Ast_uncurried.core_type_is_uncurried_fun n -> add_parens doc + | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> addParens doc + | _ when Ast_uncurried.coreTypeIsUncurriedFun n -> addParens doc | _ -> doc in Doc.group @@ -1583,21 +1610,21 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl = [ Doc.group attrs; Doc.group - (if has_attrs_before then + (if hasAttrsBefore then Doc.concat [ Doc.lparen; Doc.indent (Doc.concat - [Doc.soft_line; typ_doc; Doc.text " => "; return_doc]); - Doc.soft_line; + [Doc.softLine; typDoc; Doc.text " => "; returnDoc]); + Doc.softLine; Doc.rparen; ] - else Doc.concat [typ_doc; Doc.text " => "; return_doc]); + else Doc.concat [typDoc; Doc.text " => "; returnDoc]); ]) | args -> - let attrs = print_attributes ~state ~inline:true attrs_before cmt_tbl in - let rendered_args = + let attrs = printAttributes ~state ~inline:true attrsBefore cmtTbl in + let renderedArgs = Doc.concat [ attrs; @@ -1605,149 +1632,143 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; (if dotted then Doc.concat [Doc.dot; Doc.space] else Doc.nil); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun tp -> print_type_parameter ~state tp cmt_tbl) + (fun tp -> printTypeParameter ~state tp cmtTbl) args); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.text ")"; ] in - Doc.group (Doc.concat [rendered_args; Doc.text " => "; return_doc]) + Doc.group (Doc.concat [renderedArgs; Doc.text " => "; returnDoc]) in - let rendered_type = - match typ_expr.ptyp_desc with + let renderedType = + match typExpr.ptyp_desc with | Ptyp_any -> Doc.text "_" | Ptyp_var var -> - Doc.concat [Doc.text "'"; print_ident_like ~allow_uident:true var] + Doc.concat [Doc.text "'"; printIdentLike ~allowUident:true var] | Ptyp_extension extension -> - print_extension ~state ~at_module_lvl:false extension cmt_tbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Ptyp_alias (typ, alias) -> let typ = (* Technically type t = (string, float) => unit as 'x, doesn't require * parens around the arrow expression. This is very confusing though. * Is the "as" part of "unit" or "(string, float) => unit". By printing * parens we guide the user towards its meaning.*) - let needs_parens = + let needsParens = match typ.ptyp_desc with | Ptyp_arrow _ -> true - | _ when Ast_uncurried.core_type_is_uncurried_fun typ -> true + | _ when Ast_uncurried.coreTypeIsUncurriedFun typ -> true | _ -> false in - let doc = print_typ_expr ~state typ cmt_tbl in - if needs_parens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc + let doc = printTypExpr ~state typ cmtTbl in + if needsParens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in Doc.concat - [ - typ; Doc.text " as "; Doc.concat [Doc.text "'"; print_ident_like alias]; - ] + [typ; Doc.text " as "; Doc.concat [Doc.text "'"; printIdentLike alias]] (* object printings *) - | Ptyp_object (fields, open_flag) -> - print_object ~state ~inline:false fields open_flag cmt_tbl - | Ptyp_arrow _ -> print_arrow ~uncurried:false typ_expr - | Ptyp_constr _ when Ast_uncurried.core_type_is_uncurried_fun typ_expr -> - let arity, t_arg = - Ast_uncurried.core_type_extract_uncurried_fun typ_expr - in - print_arrow ~uncurried:true ~arity t_arg - | Ptyp_constr - (longident_loc, [{ptyp_desc = Ptyp_object (fields, open_flag)}]) -> + | Ptyp_object (fields, openFlag) -> + printObject ~state ~inline:false fields openFlag cmtTbl + | Ptyp_arrow _ -> printArrow ~uncurried:false typExpr + | Ptyp_constr _ when Ast_uncurried.coreTypeIsUncurriedFun typExpr -> + let arity, tArg = Ast_uncurried.coreTypeExtractUncurriedFun typExpr in + printArrow ~uncurried:true ~arity tArg + | Ptyp_constr (longidentLoc, [{ptyp_desc = Ptyp_object (fields, openFlag)}]) + -> (* for foo<{"a": b}>, when the object is long and needs a line break, we want the <{ and }> to stay hugged together *) - let constr_name = print_lident_path longident_loc cmt_tbl in + let constrName = printLidentPath longidentLoc cmtTbl in Doc.concat [ - constr_name; - Doc.less_than; - print_object ~state ~inline:true fields open_flag cmt_tbl; - Doc.greater_than; + constrName; + Doc.lessThan; + printObject ~state ~inline:true fields openFlag cmtTbl; + Doc.greaterThan; ] - | Ptyp_constr (longident_loc, [{ptyp_desc = Parsetree.Ptyp_tuple tuple}]) -> - let constr_name = print_lident_path longident_loc cmt_tbl in + | Ptyp_constr (longidentLoc, [{ptyp_desc = Parsetree.Ptyp_tuple tuple}]) -> + let constrName = printLidentPath longidentLoc cmtTbl in Doc.group (Doc.concat [ - constr_name; - Doc.less_than; - print_tuple_type ~state ~inline:true tuple cmt_tbl; - Doc.greater_than; + constrName; + Doc.lessThan; + printTupleType ~state ~inline:true tuple cmtTbl; + Doc.greaterThan; ]) - | Ptyp_constr (longident_loc, constr_args) -> ( - let constr_name = print_lident_path longident_loc cmt_tbl in - match constr_args with - | [] -> constr_name + | Ptyp_constr (longidentLoc, constrArgs) -> ( + let constrName = printLidentPath longidentLoc cmtTbl in + match constrArgs with + | [] -> constrName | _args -> Doc.group (Doc.concat [ - constr_name; - Doc.less_than; + constrName; + Doc.lessThan; Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> - print_typ_expr ~state typexpr cmt_tbl) - constr_args); + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) + constrArgs); ]); - Doc.trailing_comma; - Doc.soft_line; - Doc.greater_than; + Doc.trailingComma; + Doc.softLine; + Doc.greaterThan; ])) - | Ptyp_tuple types -> print_tuple_type ~state ~inline:false types cmt_tbl - | Ptyp_poly ([], typ) -> print_typ_expr ~state typ cmt_tbl - | Ptyp_poly (string_locs, typ) -> + | Ptyp_tuple types -> printTupleType ~state ~inline:false types cmtTbl + | Ptyp_poly ([], typ) -> printTypExpr ~state typ cmtTbl + | Ptyp_poly (stringLocs, typ) -> Doc.concat [ Doc.join ~sep:Doc.space (List.map (fun {Location.txt; loc} -> let doc = Doc.concat [Doc.text "'"; Doc.text txt] in - print_comments doc cmt_tbl loc) - string_locs); + printComments doc cmtTbl loc) + stringLocs); Doc.dot; Doc.space; - print_typ_expr ~state typ cmt_tbl; + printTypExpr ~state typ cmtTbl; ] - | Ptyp_package package_type -> - print_package_type ~state ~print_module_keyword_and_parens:true - package_type cmt_tbl + | Ptyp_package packageType -> + printPackageType ~state ~printModuleKeywordAndParens:true packageType + cmtTbl | Ptyp_class _ -> Doc.text "classes are not supported in types" - | Ptyp_variant (row_fields, closed_flag, labels_opt) -> - let force_break = - typ_expr.ptyp_loc.Location.loc_start.pos_lnum - < typ_expr.ptyp_loc.loc_end.pos_lnum + | Ptyp_variant (rowFields, closedFlag, labelsOpt) -> + let forceBreak = + typExpr.ptyp_loc.Location.loc_start.pos_lnum + < typExpr.ptyp_loc.loc_end.pos_lnum in - let print_row_field = function + let printRowField = function | Parsetree.Rtag ({txt; loc}, attrs, true, []) -> let doc = Doc.group (Doc.concat [ - print_attributes ~state attrs cmt_tbl; - Doc.concat [Doc.text "#"; print_poly_var_ident txt]; + printAttributes ~state attrs cmtTbl; + Doc.concat [Doc.text "#"; printPolyVarIdent txt]; ]) in - print_comments doc cmt_tbl loc + printComments doc cmtTbl loc | Rtag ({txt}, attrs, truth, types) -> - let do_type t = + let doType t = match t.Parsetree.ptyp_desc with - | Ptyp_tuple _ -> print_typ_expr ~state t cmt_tbl + | Ptyp_tuple _ -> printTypExpr ~state t cmtTbl | _ -> - Doc.concat - [Doc.lparen; print_typ_expr ~state t cmt_tbl; Doc.rparen] + Doc.concat [Doc.lparen; printTypExpr ~state t cmtTbl; Doc.rparen] in - let printed_types = List.map do_type types in + let printedTypes = List.map doType types in let cases = - Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "& "]) printed_types + Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "& "]) printedTypes in let cases = if truth then Doc.concat [Doc.line; Doc.text "& "; cases] else cases @@ -1755,70 +1776,69 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl = Doc.group (Doc.concat [ - print_attributes ~state attrs cmt_tbl; - Doc.concat [Doc.text "#"; print_poly_var_ident txt]; + printAttributes ~state attrs cmtTbl; + Doc.concat [Doc.text "#"; printPolyVarIdent txt]; cases; ]) - | Rinherit core_type -> print_typ_expr ~state core_type cmt_tbl + | Rinherit coreType -> printTypExpr ~state coreType cmtTbl in - let docs = List.map print_row_field row_fields in + let docs = List.map printRowField rowFields in let cases = Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "| "]) docs in let cases = if docs = [] then cases - else Doc.concat [Doc.if_breaks (Doc.text "| ") Doc.nil; cases] + else Doc.concat [Doc.ifBreaks (Doc.text "| ") Doc.nil; cases] in - let opening_symbol = - if closed_flag = Open then Doc.concat [Doc.greater_than; Doc.line] - else if labels_opt = None then Doc.soft_line - else Doc.concat [Doc.less_than; Doc.line] + let openingSymbol = + if closedFlag = Open then Doc.concat [Doc.greaterThan; Doc.line] + else if labelsOpt = None then Doc.softLine + else Doc.concat [Doc.lessThan; Doc.line] in let labels = - match labels_opt with + match labelsOpt with | None | Some [] -> Doc.nil | Some labels -> Doc.concat (List.map (fun label -> - Doc.concat [Doc.line; Doc.text "#"; print_poly_var_ident label]) + Doc.concat [Doc.line; Doc.text "#"; printPolyVarIdent label]) labels) in - let closing_symbol = - match labels_opt with + let closingSymbol = + match labelsOpt with | None | Some [] -> Doc.nil | _ -> Doc.text " >" in - Doc.breakable_group ~force_break + Doc.breakableGroup ~forceBreak (Doc.concat [ Doc.lbracket; Doc.indent - (Doc.concat [opening_symbol; cases; closing_symbol; labels]); - Doc.soft_line; + (Doc.concat [openingSymbol; cases; closingSymbol; labels]); + Doc.softLine; Doc.rbracket; ]) in - let should_print_its_own_attributes = - match typ_expr.ptyp_desc with + let shouldPrintItsOwnAttributes = + match typExpr.ptyp_desc with | Ptyp_arrow _ (* es6 arrow types print their own attributes *) -> true | _ -> false in let doc = - match typ_expr.ptyp_attributes with - | _ :: _ as attrs when not should_print_its_own_attributes -> - Doc.group - (Doc.concat [print_attributes ~state attrs cmt_tbl; rendered_type]) - | _ -> rendered_type + match typExpr.ptyp_attributes with + | _ :: _ as attrs when not shouldPrintItsOwnAttributes -> + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; renderedType]) + | _ -> renderedType in - print_comments doc cmt_tbl typ_expr.ptyp_loc + printComments doc cmtTbl typExpr.ptyp_loc -and print_object ~state ~inline fields open_flag cmt_tbl = +and printObject ~state ~inline fields openFlag cmtTbl = let doc = match fields with | [] -> Doc.concat [ Doc.lbrace; - (match open_flag with + (match openFlag with | Asttypes.Closed -> Doc.dot | Open -> Doc.dotdot); Doc.rbrace; @@ -1827,7 +1847,7 @@ and print_object ~state ~inline fields open_flag cmt_tbl = Doc.concat [ Doc.lbrace; - (match open_flag with + (match openFlag with | Asttypes.Closed -> Doc.nil | Open -> ( match fields with @@ -1838,21 +1858,21 @@ and print_object ~state ~inline fields open_flag cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun field -> print_object_field ~state field cmt_tbl) + (fun field -> printObjectField ~state field cmtTbl) fields); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbrace; ] in if inline then doc else Doc.group doc -and print_tuple_type ~state ~inline (types : Parsetree.core_type list) cmt_tbl = +and printTupleType ~state ~inline (types : Parsetree.core_type list) cmtTbl = let tuple = Doc.concat [ @@ -1860,58 +1880,58 @@ and print_tuple_type ~state ~inline (types : Parsetree.core_type list) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> print_typ_expr ~state typexpr cmt_tbl) + (fun typexpr -> printTypExpr ~state typexpr cmtTbl) types); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ] in if inline == false then Doc.group tuple else tuple -and print_object_field ~state (field : Parsetree.object_field) cmt_tbl = +and printObjectField ~state (field : Parsetree.object_field) cmtTbl = match field with - | Otag (label_loc, attrs, typ) -> + | Otag (labelLoc, attrs, typ) -> let lbl = - let doc = Doc.text ("\"" ^ label_loc.txt ^ "\"") in - print_comments doc cmt_tbl label_loc.loc + let doc = Doc.text ("\"" ^ labelLoc.txt ^ "\"") in + printComments doc cmtTbl labelLoc.loc in let doc = Doc.concat [ - print_attributes ~state ~loc:label_loc.loc attrs cmt_tbl; + printAttributes ~state ~loc:labelLoc.loc attrs cmtTbl; lbl; Doc.text ": "; - print_typ_expr ~state typ cmt_tbl; + printTypExpr ~state typ cmtTbl; ] in - let cmt_loc = {label_loc.loc with loc_end = typ.ptyp_loc.loc_end} in - print_comments doc cmt_tbl cmt_loc + let cmtLoc = {labelLoc.loc with loc_end = typ.ptyp_loc.loc_end} in + printComments doc cmtTbl cmtLoc | Oinherit typexpr -> - Doc.concat [Doc.dotdotdot; print_typ_expr ~state typexpr cmt_tbl] + Doc.concat [Doc.dotdotdot; printTypExpr ~state typexpr cmtTbl] (* es6 arrow type arg * type t = (~foo: string, ~bar: float=?, unit) => unit * i.e. ~foo: string, ~bar: float *) -and print_type_parameter ~state (attrs, lbl, typ) cmt_tbl = +and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = (* Converting .ml code to .res requires processing uncurried attributes *) - let has_bs, attrs = ParsetreeViewer.process_bs_attribute attrs in - let dotted = if has_bs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in - let attrs = print_attributes ~state attrs cmt_tbl in + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in + let dotted = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + let attrs = printAttributes ~state attrs cmtTbl in let label = match lbl with | Asttypes.Nolabel -> Doc.nil | Labelled lbl -> - Doc.concat [Doc.text "~"; print_ident_like lbl; Doc.text ": "] + Doc.concat [Doc.text "~"; printIdentLike lbl; Doc.text ": "] | Optional lbl -> - Doc.concat [Doc.text "~"; print_ident_like lbl; Doc.text ": "] + Doc.concat [Doc.text "~"; printIdentLike lbl; Doc.text ": "] in - let optional_indicator = + let optionalIndicator = match lbl with | Asttypes.Nolabel | Labelled _ -> Doc.nil | Optional _lbl -> Doc.text "=?" @@ -1930,33 +1950,32 @@ and print_type_parameter ~state (attrs, lbl, typ) cmt_tbl = dotted; attrs; label; - print_typ_expr ~state typ cmt_tbl; - optional_indicator; + printTypExpr ~state typ cmtTbl; + optionalIndicator; ]) in - print_comments doc cmt_tbl loc + printComments doc cmtTbl loc -and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl - i = +and printValueBinding ~state ~recFlag (vb : Parsetree.value_binding) cmtTbl i = let attrs = - print_attributes ~state ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes cmt_tbl + printAttributes ~state ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes cmtTbl in let header = - if i == 0 then Doc.concat [Doc.text "let "; rec_flag] else Doc.text "and " + if i == 0 then Doc.concat [Doc.text "let "; recFlag] else Doc.text "and " in match vb with | { pvb_pat = { ppat_desc = - Ppat_constraint (pattern, ({ptyp_desc = Ptyp_poly _} as pat_typ)); + Ppat_constraint (pattern, ({ptyp_desc = Ptyp_poly _} as patTyp)); }; pvb_expr = {pexp_desc = Pexp_newtype _} as expr; } -> ( - let _uncurried, _attrs, parameters, return_expr = - ParsetreeViewer.fun_expr expr + let _uncurried, _attrs, parameters, returnExpr = + ParsetreeViewer.funExpr expr in - let abstract_type = + let abstractType = match parameters with | [NewTypes {locs = vars}] -> Doc.concat @@ -1968,28 +1987,25 @@ and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl ] | _ -> Doc.nil in - match return_expr.pexp_desc with + match returnExpr.pexp_desc with | Pexp_constraint (expr, typ) -> Doc.group (Doc.concat [ attrs; header; - print_pattern ~state pattern cmt_tbl; + printPattern ~state pattern cmtTbl; Doc.text ":"; Doc.indent (Doc.concat [ Doc.line; - abstract_type; + abstractType; Doc.space; - print_typ_expr ~state typ cmt_tbl; + printTypExpr ~state typ cmtTbl; Doc.text " ="; Doc.concat - [ - Doc.line; - print_expression_with_comments ~state expr cmt_tbl; - ]; + [Doc.line; printExpressionWithComments ~state expr cmtTbl]; ]); ]) | _ -> @@ -2002,33 +2018,30 @@ and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl [ attrs; header; - print_pattern ~state pattern cmt_tbl; + printPattern ~state pattern cmtTbl; Doc.text ":"; Doc.indent (Doc.concat [ Doc.line; - abstract_type; + abstractType; Doc.space; - print_typ_expr ~state pat_typ cmt_tbl; + printTypExpr ~state patTyp cmtTbl; Doc.text " ="; Doc.concat - [ - Doc.line; - print_expression_with_comments ~state expr cmt_tbl; - ]; + [Doc.line; printExpressionWithComments ~state expr cmtTbl]; ]); ])) | _ -> - let opt_braces, expr = ParsetreeViewer.process_braces_attr vb.pvb_expr in - let printed_expr = - let doc = print_expression_with_comments ~state vb.pvb_expr cmt_tbl in + let optBraces, expr = ParsetreeViewer.processBracesAttr vb.pvb_expr in + let printedExpr = + let doc = printExpressionWithComments ~state vb.pvb_expr cmtTbl in match Parens.expr vb.pvb_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc in - let pattern_doc = print_pattern ~state vb.pvb_pat cmt_tbl in + let patternDoc = printPattern ~state vb.pvb_pat cmtTbl in (* * we want to optimize the layout of one pipe: * let tbl = data->Js.Array2.reduce((map, curr) => { @@ -2041,82 +2054,77 @@ and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl * ->Belt.Array.map(...) * Multiple pipes chained together lend themselves more towards the last layout. *) - if ParsetreeViewer.is_single_pipe_expr vb.pvb_expr then - Doc.custom_layout + if ParsetreeViewer.isSinglePipeExpr vb.pvb_expr then + Doc.customLayout [ Doc.group (Doc.concat [ - attrs; - header; - pattern_doc; - Doc.text " ="; - Doc.space; - printed_expr; + attrs; header; patternDoc; Doc.text " ="; Doc.space; printedExpr; ]); Doc.group (Doc.concat [ attrs; header; - pattern_doc; + patternDoc; Doc.text " ="; - Doc.indent (Doc.concat [Doc.line; printed_expr]); + Doc.indent (Doc.concat [Doc.line; printedExpr]); ]); ] else - let should_indent = - match opt_braces with + let shouldIndent = + match optBraces with | Some _ -> false | _ -> ( - ParsetreeViewer.is_binary_expression expr + ParsetreeViewer.isBinaryExpression expr || match vb.pvb_expr with | { pexp_attributes = [({Location.txt = "res.ternary"}, _)]; - pexp_desc = Pexp_ifthenelse (if_expr, _, _); + pexp_desc = Pexp_ifthenelse (ifExpr, _, _); } -> - ParsetreeViewer.is_binary_expression if_expr - || ParsetreeViewer.has_attributes if_expr.pexp_attributes + ParsetreeViewer.isBinaryExpression ifExpr + || ParsetreeViewer.hasAttributes ifExpr.pexp_attributes | {pexp_desc = Pexp_newtype _} -> false | {pexp_attributes = [({Location.txt = "res.taggedTemplate"}, _)]} -> false | e -> - ParsetreeViewer.has_attributes e.pexp_attributes - || ParsetreeViewer.is_array_access e) + ParsetreeViewer.hasAttributes e.pexp_attributes + || ParsetreeViewer.isArrayAccess e) in Doc.group (Doc.concat [ attrs; header; - pattern_doc; + patternDoc; Doc.text " ="; - (if should_indent then - Doc.indent (Doc.concat [Doc.line; printed_expr]) - else Doc.concat [Doc.space; printed_expr]); + (if shouldIndent then + Doc.indent (Doc.concat [Doc.line; printedExpr]) + else Doc.concat [Doc.space; printedExpr]); ]) -and print_package_type ~state ~print_module_keyword_and_parens - (package_type : Parsetree.package_type) cmt_tbl = +and printPackageType ~state ~printModuleKeywordAndParens + (packageType : Parsetree.package_type) cmtTbl = let doc = - match package_type with - | longident_loc, [] -> - Doc.group (Doc.concat [print_longident_location longident_loc cmt_tbl]) - | longident_loc, package_constraints -> + match packageType with + | longidentLoc, [] -> + Doc.group (Doc.concat [printLongidentLocation longidentLoc cmtTbl]) + | longidentLoc, packageConstraints -> Doc.group (Doc.concat [ - print_longident_location longident_loc cmt_tbl; - print_package_constraints ~state package_constraints cmt_tbl; - Doc.soft_line; + printLongidentLocation longidentLoc cmtTbl; + printPackageConstraints ~state packageConstraints cmtTbl; + Doc.softLine; ]) in - if print_module_keyword_and_parens then + if printModuleKeywordAndParens then Doc.concat [Doc.text "module("; doc; Doc.rparen] else doc -and print_package_constraints ~state package_constraints cmt_tbl = +and printPackageConstraints ~state packageConstraints cmtTbl = Doc.concat [ Doc.text " with"; @@ -2128,53 +2136,53 @@ and print_package_constraints ~state package_constraints cmt_tbl = (List.mapi (fun i pc -> let longident, typexpr = pc in - let cmt_loc = + let cmtLoc = { longident.Asttypes.loc with loc_end = typexpr.Parsetree.ptyp_loc.loc_end; } in - let doc = print_package_constraint ~state i cmt_tbl pc in - print_comments doc cmt_tbl cmt_loc) - package_constraints); + let doc = printPackageConstraint ~state i cmtTbl pc in + printComments doc cmtTbl cmtLoc) + packageConstraints); ]); ] -and print_package_constraint ~state i cmt_tbl (longident_loc, typ) = +and printPackageConstraint ~state i cmtTbl (longidentLoc, typ) = let prefix = if i == 0 then Doc.text "type " else Doc.text "and type " in Doc.concat [ prefix; - print_longident_location longident_loc cmt_tbl; + printLongidentLocation longidentLoc cmtTbl; Doc.text " = "; - print_typ_expr ~state typ cmt_tbl; + printTypExpr ~state typ cmtTbl; ] -and print_extension ~state ~at_module_lvl (string_loc, payload) cmt_tbl = - let txt = string_loc.Location.txt in - let ext_name = +and printExtension ~state ~atModuleLvl (stringLoc, payload) cmtTbl = + let txt = convertBsExtension stringLoc.Location.txt in + let extName = let doc = Doc.concat [ Doc.text "%"; - (if at_module_lvl then Doc.text "%" else Doc.nil); + (if atModuleLvl then Doc.text "%" else Doc.nil); Doc.text txt; ] in - print_comments doc cmt_tbl string_loc.Location.loc + printComments doc cmtTbl stringLoc.Location.loc in - Doc.group (Doc.concat [ext_name; print_payload ~state payload cmt_tbl]) + Doc.group (Doc.concat [extName; printPayload ~state payload cmtTbl]) -and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = - let pattern_without_attributes = +and printPattern ~state (p : Parsetree.pattern) cmtTbl = + let patternWithoutAttributes = match p.ppat_desc with | Ppat_any -> Doc.text "_" - | Ppat_var var -> print_ident_like var.txt + | Ppat_var var -> printIdentLike var.txt | Ppat_constant c -> - let template_literal = - ParsetreeViewer.has_template_literal_attr p.ppat_attributes + let templateLiteral = + ParsetreeViewer.hasTemplateLiteralAttr p.ppat_attributes in - print_constant ~template_literal c + printConstant ~templateLiteral c | Ppat_tuple patterns -> Doc.group (Doc.concat @@ -2183,20 +2191,20 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun pat -> print_pattern ~state pat cmt_tbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ]) | Ppat_array [] -> Doc.concat - [Doc.lbracket; print_comments_inside cmt_tbl p.ppat_loc; Doc.rbracket] + [Doc.lbracket; printCommentsInside cmtTbl p.ppat_loc; Doc.rbracket] | Ppat_array patterns -> Doc.group (Doc.concat @@ -2205,48 +2213,47 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun pat -> print_pattern ~state pat cmt_tbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.text "]"; ]) | Ppat_construct ({txt = Longident.Lident "()"}, _) -> - Doc.concat - [Doc.lparen; print_comments_inside cmt_tbl p.ppat_loc; Doc.rparen] + Doc.concat [Doc.lparen; printCommentsInside cmtTbl p.ppat_loc; Doc.rparen] | Ppat_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat - [Doc.text "list{"; print_comments_inside cmt_tbl p.ppat_loc; Doc.rbrace] + [Doc.text "list{"; printCommentsInside cmtTbl p.ppat_loc; Doc.rbrace] | Ppat_construct ({txt = Longident.Lident "::"}, _) -> let patterns, tail = - ParsetreeViewer.collect_patterns_from_list_construct [] p + ParsetreeViewer.collectPatternsFromListConstruct [] p in - let should_hug = + let shouldHug = match (patterns, tail) with | [pat], {ppat_desc = Ppat_construct ({txt = Longident.Lident "[]"}, _)} - when ParsetreeViewer.is_huggable_pattern pat -> + when ParsetreeViewer.isHuggablePattern pat -> true | _ -> false in let children = Doc.concat [ - (if should_hug then Doc.nil else Doc.soft_line); + (if shouldHug then Doc.nil else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map (fun pat -> print_pattern ~state pat cmt_tbl) patterns); + (List.map (fun pat -> printPattern ~state pat cmtTbl) patterns); (match tail.Parsetree.ppat_desc with | Ppat_construct ({txt = Longident.Lident "[]"}, _) -> Doc.nil | _ -> let doc = - Doc.concat [Doc.text "..."; print_pattern ~state tail cmt_tbl] + Doc.concat [Doc.text "..."; printPattern ~state tail cmtTbl] in - let tail = print_comments doc cmt_tbl tail.ppat_loc in + let tail = printComments doc cmtTbl tail.ppat_loc in Doc.concat [Doc.text ","; Doc.line; tail]); ] in @@ -2254,20 +2261,20 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = (Doc.concat [ Doc.text "list{"; - (if should_hug then children + (if shouldHug then children else Doc.concat [ Doc.indent children; - Doc.if_breaks (Doc.text ",") Doc.nil; - Doc.soft_line; + Doc.ifBreaks (Doc.text ",") Doc.nil; + Doc.softLine; ]); Doc.rbrace; ]) - | Ppat_construct (constr_name, constructor_args) -> - let constr_name = print_longident_location constr_name cmt_tbl in - let args_doc = - match constructor_args with + | Ppat_construct (constrName, constructorArgs) -> + let constrName = printLongidentLocation constrName cmtTbl in + let argsDoc = + match constructorArgs with | None -> Doc.nil | Some { @@ -2275,12 +2282,12 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = ppat_desc = Ppat_construct ({txt = Longident.Lident "()"}, _); } -> Doc.concat - [Doc.lparen; print_comments_inside cmt_tbl ppat_loc; Doc.rparen] + [Doc.lparen; printCommentsInside cmtTbl ppat_loc; Doc.rparen] | Some {ppat_desc = Ppat_tuple []; ppat_loc = loc} -> - Doc.concat [Doc.lparen; print_comments_inside cmt_tbl loc; Doc.rparen] + Doc.concat [Doc.lparen; printCommentsInside cmtTbl loc; Doc.rparen] (* Some((1, 2) *) | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} -> - Doc.concat [Doc.lparen; print_pattern ~state arg cmt_tbl; Doc.rparen] + Doc.concat [Doc.lparen; printPattern ~state arg cmtTbl; Doc.rparen] | Some {ppat_desc = Ppat_tuple patterns} -> Doc.concat [ @@ -2288,52 +2295,50 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun pat -> print_pattern ~state pat cmt_tbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ] | Some arg -> - let arg_doc = print_pattern ~state arg cmt_tbl in - let should_hug = ParsetreeViewer.is_huggable_pattern arg in + let argDoc = printPattern ~state arg cmtTbl in + let shouldHug = ParsetreeViewer.isHuggablePattern arg in Doc.concat [ Doc.lparen; - (if should_hug then arg_doc + (if shouldHug then argDoc else Doc.concat [ - Doc.indent (Doc.concat [Doc.soft_line; arg_doc]); - Doc.trailing_comma; - Doc.soft_line; + Doc.indent (Doc.concat [Doc.softLine; argDoc]); + Doc.trailingComma; + Doc.softLine; ]); Doc.rparen; ] in - Doc.group (Doc.concat [constr_name; args_doc]) + Doc.group (Doc.concat [constrName; argsDoc]) | Ppat_variant (label, None) -> - Doc.concat [Doc.text "#"; print_poly_var_ident label] - | Ppat_variant (label, variant_args) -> - let variant_name = - Doc.concat [Doc.text "#"; print_poly_var_ident label] - in - let args_doc = - match variant_args with + Doc.concat [Doc.text "#"; printPolyVarIdent label] + | Ppat_variant (label, variantArgs) -> + let variantName = Doc.concat [Doc.text "#"; printPolyVarIdent label] in + let argsDoc = + match variantArgs with | None -> Doc.nil | Some {ppat_desc = Ppat_construct ({txt = Longident.Lident "()"}, _)} -> Doc.text "()" | Some {ppat_desc = Ppat_tuple []; ppat_loc = loc} -> - Doc.concat [Doc.lparen; print_comments_inside cmt_tbl loc; Doc.rparen] + Doc.concat [Doc.lparen; printCommentsInside cmtTbl loc; Doc.rparen] (* Some((1, 2) *) | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} -> - Doc.concat [Doc.lparen; print_pattern ~state arg cmt_tbl; Doc.rparen] + Doc.concat [Doc.lparen; printPattern ~state arg cmtTbl; Doc.rparen] | Some {ppat_desc = Ppat_tuple patterns} -> Doc.concat [ @@ -2341,38 +2346,40 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun pat -> print_pattern ~state pat cmt_tbl) + (fun pat -> printPattern ~state pat cmtTbl) patterns); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ] | Some arg -> - let arg_doc = print_pattern ~state arg cmt_tbl in - let should_hug = ParsetreeViewer.is_huggable_pattern arg in + let argDoc = printPattern ~state arg cmtTbl in + let shouldHug = ParsetreeViewer.isHuggablePattern arg in Doc.concat [ Doc.lparen; - (if should_hug then arg_doc + (if shouldHug then argDoc else Doc.concat [ - Doc.indent (Doc.concat [Doc.soft_line; arg_doc]); - Doc.trailing_comma; - Doc.soft_line; + Doc.indent (Doc.concat [Doc.softLine; argDoc]); + Doc.trailingComma; + Doc.softLine; ]); Doc.rparen; ] in - Doc.group (Doc.concat [variant_name; args_doc]) + Doc.group (Doc.concat [variantName; argsDoc]) | Ppat_type ident -> - Doc.concat [Doc.text "#..."; print_ident_path ident cmt_tbl] - | Ppat_record (rows, open_flag) -> + Doc.concat [Doc.text "#..."; printIdentPath ident cmtTbl] + | Ppat_record ([], Open) -> + Doc.concat [Doc.lbrace; Doc.text "_"; Doc.rbrace] + | Ppat_record (rows, openFlag) -> Doc.group (Doc.concat [ @@ -2380,129 +2387,126 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> - print_pattern_record_row ~state row cmt_tbl) + (fun row -> printPatternRecordRow ~state row cmtTbl) rows); - (match open_flag with + (match openFlag with | Open -> Doc.concat [Doc.text ","; Doc.line; Doc.text "_"] | Closed -> Doc.nil); ]); - Doc.if_breaks (Doc.text ",") Doc.nil; - Doc.soft_line; + Doc.ifBreaks (Doc.text ",") Doc.nil; + Doc.softLine; Doc.rbrace; ]) | Ppat_exception p -> - let needs_parens = + let needsParens = match p.ppat_desc with | Ppat_or (_, _) | Ppat_alias (_, _) -> true | _ -> false in let pat = - let p = print_pattern ~state p cmt_tbl in - if needs_parens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p + let p = printPattern ~state p cmtTbl in + if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.group (Doc.concat [Doc.text "exception"; Doc.line; pat]) | Ppat_or _ -> (* Blue | Red | Green -> [Blue; Red; Green] *) - let or_chain = ParsetreeViewer.collect_or_pattern_chain p in + let orChain = ParsetreeViewer.collectOrPatternChain p in let docs = List.mapi (fun i pat -> - let pattern_doc = print_pattern ~state pat cmt_tbl in + let patternDoc = printPattern ~state pat cmtTbl in Doc.concat [ (if i == 0 then Doc.nil else Doc.concat [Doc.line; Doc.text "| "]); (match pat.ppat_desc with (* (Blue | Red) | (Green | Black) | White *) - | Ppat_or _ -> add_parens pattern_doc - | _ -> pattern_doc); + | Ppat_or _ -> addParens patternDoc + | _ -> patternDoc); ]) - or_chain + orChain in - let is_spread_over_multiple_lines = - match (or_chain, List.rev or_chain) with + let isSpreadOverMultipleLines = + match (orChain, List.rev orChain) with | first :: _, last :: _ -> first.ppat_loc.loc_start.pos_lnum < last.ppat_loc.loc_end.pos_lnum | _ -> false in - Doc.breakable_group ~force_break:is_spread_over_multiple_lines - (Doc.concat docs) - | Ppat_extension ext -> - print_extension ~state ~at_module_lvl:false ext cmt_tbl + Doc.breakableGroup ~forceBreak:isSpreadOverMultipleLines (Doc.concat docs) + | Ppat_extension ext -> printExtension ~state ~atModuleLvl:false ext cmtTbl | Ppat_lazy p -> - let needs_parens = + let needsParens = match p.ppat_desc with | Ppat_or (_, _) | Ppat_alias (_, _) -> true | _ -> false in let pat = - let p = print_pattern ~state p cmt_tbl in - if needs_parens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p + let p = printPattern ~state p cmtTbl in + if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat [Doc.text "lazy "; pat] - | Ppat_alias (p, alias_loc) -> - let needs_parens = + | Ppat_alias (p, aliasLoc) -> + let needsParens = match p.ppat_desc with | Ppat_or (_, _) | Ppat_alias (_, _) -> true | _ -> false in - let rendered_pattern = - let p = print_pattern ~state p cmt_tbl in - if needs_parens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p + let renderedPattern = + let p = printPattern ~state p cmtTbl in + if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat - [rendered_pattern; Doc.text " as "; print_string_loc alias_loc cmt_tbl] + [renderedPattern; Doc.text " as "; printStringLoc aliasLoc cmtTbl] (* Note: module(P : S) is represented as *) (* Ppat_constraint(Ppat_unpack, Ptyp_package) *) | Ppat_constraint - ( {ppat_desc = Ppat_unpack string_loc}, - {ptyp_desc = Ptyp_package package_type; ptyp_loc} ) -> + ( {ppat_desc = Ppat_unpack stringLoc}, + {ptyp_desc = Ptyp_package packageType; ptyp_loc} ) -> Doc.concat [ Doc.text "module("; - print_comments (Doc.text string_loc.txt) cmt_tbl string_loc.loc; + printComments (Doc.text stringLoc.txt) cmtTbl stringLoc.loc; Doc.text ": "; - print_comments - (print_package_type ~state ~print_module_keyword_and_parens:false - package_type cmt_tbl) - cmt_tbl ptyp_loc; + printComments + (printPackageType ~state ~printModuleKeywordAndParens:false + packageType cmtTbl) + cmtTbl ptyp_loc; Doc.rparen; ] | Ppat_constraint (pattern, typ) -> Doc.concat [ - print_pattern ~state pattern cmt_tbl; + printPattern ~state pattern cmtTbl; Doc.text ": "; - print_typ_expr ~state typ cmt_tbl; + printTypExpr ~state typ cmtTbl; ] (* Note: module(P : S) is represented as *) (* Ppat_constraint(Ppat_unpack, Ptyp_package) *) - | Ppat_unpack string_loc -> + | Ppat_unpack stringLoc -> Doc.concat [ Doc.text "module("; - print_comments (Doc.text string_loc.txt) cmt_tbl string_loc.loc; + printComments (Doc.text stringLoc.txt) cmtTbl stringLoc.loc; Doc.rparen; ] | Ppat_interval (a, b) -> - Doc.concat [print_constant a; Doc.text " .. "; print_constant b] + Doc.concat [printConstant a; Doc.text " .. "; printConstant b] | Ppat_open _ -> Doc.nil in let doc = match p.ppat_attributes with - | [] -> pattern_without_attributes + | [] -> patternWithoutAttributes | attrs -> Doc.group (Doc.concat - [print_attributes ~state attrs cmt_tbl; pattern_without_attributes]) + [printAttributes ~state attrs cmtTbl; patternWithoutAttributes]) in - print_comments doc cmt_tbl p.ppat_loc + printComments doc cmtTbl p.ppat_loc -and print_pattern_record_row ~state row cmt_tbl = +and printPatternRecordRow ~state row cmtTbl = match row with (* punned {x}*) | ( ({Location.txt = Longident.Lident ident} as longident), @@ -2510,142 +2514,139 @@ and print_pattern_record_row ~state row cmt_tbl = when ident = txt -> Doc.concat [ - print_optional_label ppat_attributes; - print_attributes ~state ppat_attributes cmt_tbl; - print_lident_path longident cmt_tbl; + printOptionalLabel ppat_attributes; + printAttributes ~state ppat_attributes cmtTbl; + printLidentPath longident cmtTbl; ] | longident, pattern -> - let loc_for_comments = + let locForComments = {longident.loc with loc_end = pattern.Parsetree.ppat_loc.loc_end} in - let rhs_doc = - let doc = print_pattern ~state pattern cmt_tbl in + let rhsDoc = + let doc = printPattern ~state pattern cmtTbl in let doc = - if Parens.pattern_record_row_rhs pattern then add_parens doc else doc + if Parens.patternRecordRowRhs pattern then addParens doc else doc in - Doc.concat [print_optional_label pattern.ppat_attributes; doc] + Doc.concat [printOptionalLabel pattern.ppat_attributes; doc] in let doc = Doc.group (Doc.concat [ - print_lident_path longident cmt_tbl; + printLidentPath longident cmtTbl; Doc.text ":"; - (if ParsetreeViewer.is_huggable_pattern pattern then - Doc.concat [Doc.space; rhs_doc] - else Doc.indent (Doc.concat [Doc.line; rhs_doc])); + (if ParsetreeViewer.isHuggablePattern pattern then + Doc.concat [Doc.space; rhsDoc] + else Doc.indent (Doc.concat [Doc.line; rhsDoc])); ]) in - print_comments doc cmt_tbl loc_for_comments + printComments doc cmtTbl locForComments -and print_expression_with_comments ~state expr cmt_tbl : Doc.t = - let doc = print_expression ~state expr cmt_tbl in - print_comments doc cmt_tbl expr.Parsetree.pexp_loc +and printExpressionWithComments ~state expr cmtTbl : Doc.t = + let doc = printExpression ~state expr cmtTbl in + printComments doc cmtTbl expr.Parsetree.pexp_loc -and print_if_chain ~state pexp_attributes ifs else_expr cmt_tbl = - let if_docs = +and printIfChain ~state pexp_attributes ifs elseExpr cmtTbl = + let ifDocs = Doc.join ~sep:Doc.space (List.mapi - (fun i (outer_loc, if_expr, then_expr) -> - let if_txt = if i > 0 then Doc.text "else if " else Doc.text "if " in + (fun i (outerLoc, ifExpr, thenExpr) -> + let ifTxt = if i > 0 then Doc.text "else if " else Doc.text "if " in let doc = - match if_expr with - | ParsetreeViewer.If if_expr -> + match ifExpr with + | ParsetreeViewer.If ifExpr -> let condition = - if ParsetreeViewer.is_block_expr if_expr then - print_expression_block ~state ~braces:true if_expr cmt_tbl + if ParsetreeViewer.isBlockExpr ifExpr then + printExpressionBlock ~state ~braces:true ifExpr cmtTbl else - let doc = - print_expression_with_comments ~state if_expr cmt_tbl - in - match Parens.expr if_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc if_expr braces - | Nothing -> Doc.if_breaks (add_parens doc) doc + let doc = printExpressionWithComments ~state ifExpr cmtTbl in + match Parens.expr ifExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc ifExpr braces + | Nothing -> Doc.ifBreaks (addParens doc) doc in Doc.concat [ - if_txt; + ifTxt; Doc.group condition; Doc.space; - (let then_expr = - match ParsetreeViewer.process_braces_attr then_expr with + (let thenExpr = + match ParsetreeViewer.processBracesAttr thenExpr with (* This case only happens when coming from Reason, we strip braces *) | Some _, expr -> expr - | _ -> then_expr + | _ -> thenExpr in - print_expression_block ~state ~braces:true then_expr cmt_tbl); + printExpressionBlock ~state ~braces:true thenExpr cmtTbl); ] - | IfLet (pattern, condition_expr) -> - let condition_doc = + | IfLet (pattern, conditionExpr) -> + let conditionDoc = let doc = - print_expression_with_comments ~state condition_expr cmt_tbl + printExpressionWithComments ~state conditionExpr cmtTbl in - match Parens.expr condition_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc condition_expr braces + match Parens.expr conditionExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc conditionExpr braces | Nothing -> doc in Doc.concat [ - if_txt; + ifTxt; Doc.text "let "; - print_pattern ~state pattern cmt_tbl; + printPattern ~state pattern cmtTbl; Doc.text " = "; - condition_doc; + conditionDoc; Doc.space; - print_expression_block ~state ~braces:true then_expr cmt_tbl; + printExpressionBlock ~state ~braces:true thenExpr cmtTbl; ] in - print_leading_comments doc cmt_tbl.leading outer_loc) + printLeadingComments doc cmtTbl.leading outerLoc) ifs) in - let else_doc = - match else_expr with + let elseDoc = + match elseExpr with | None -> Doc.nil | Some expr -> Doc.concat [ - Doc.text " else "; - print_expression_block ~state ~braces:true expr cmt_tbl; + Doc.text " else "; printExpressionBlock ~state ~braces:true expr cmtTbl; ] in - let attrs = ParsetreeViewer.filter_fragile_match_attributes pexp_attributes in - Doc.concat [print_attributes ~state attrs cmt_tbl; if_docs; else_doc] + let attrs = ParsetreeViewer.filterFragileMatchAttributes pexp_attributes in + Doc.concat [printAttributes ~state attrs cmtTbl; ifDocs; elseDoc] -and print_expression ~state (e : Parsetree.expression) cmt_tbl = - let print_arrow e = - let uncurried, attrs_on_arrow, parameters, return_expr = - ParsetreeViewer.fun_expr e +and printExpression ~state (e : Parsetree.expression) cmtTbl = + let printArrow e = + let uncurried, attrsOnArrow, parameters, returnExpr = + ParsetreeViewer.funExpr e in let ParsetreeViewer.{async; bs; attributes = attrs} = - ParsetreeViewer.process_function_attributes attrs_on_arrow + ParsetreeViewer.processFunctionAttributes attrsOnArrow in let uncurried = uncurried || bs in - let return_expr, typ_constraint = - match return_expr.pexp_desc with + let returnExpr, typConstraint = + match returnExpr.pexp_desc with | Pexp_constraint (expr, typ) -> ( { expr with pexp_attributes = - List.concat [expr.pexp_attributes; return_expr.pexp_attributes]; + List.concat [expr.pexp_attributes; returnExpr.pexp_attributes]; }, Some typ ) - | _ -> (return_expr, None) + | _ -> (returnExpr, None) in - let has_constraint = - match typ_constraint with + let hasConstraint = + match typConstraint with | Some _ -> true | None -> false in - let parameters_doc = - print_expr_fun_parameters ~state ~in_callback:NoCallback ~uncurried ~async - ~has_constraint parameters cmt_tbl + let parametersDoc = + printExprFunParameters ~state ~inCallback:NoCallback ~uncurried ~async + ~hasConstraint parameters cmtTbl in - let return_expr_doc = - let opt_braces, _ = ParsetreeViewer.process_braces_attr return_expr in - let should_inline = - match (return_expr.pexp_desc, opt_braces) with + let returnExprDoc = + let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in + let shouldInline = + match (returnExpr.pexp_desc, optBraces) with | _, Some _ -> true | ( ( Pexp_array _ | Pexp_tuple _ | Pexp_construct (_, Some _) @@ -2654,52 +2655,46 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = true | _ -> false in - let should_indent = - match return_expr.pexp_desc with + let shouldIndent = + match returnExpr.pexp_desc with | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ -> false | _ -> true in - let return_doc = - let doc = print_expression_with_comments ~state return_expr cmt_tbl in - match Parens.expr return_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc return_expr braces + let returnDoc = + let doc = printExpressionWithComments ~state returnExpr cmtTbl in + match Parens.expr returnExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc returnExpr braces | Nothing -> doc in - if should_inline then Doc.concat [Doc.space; return_doc] + if shouldInline then Doc.concat [Doc.space; returnDoc] else Doc.group - (if should_indent then Doc.indent (Doc.concat [Doc.line; return_doc]) - else Doc.concat [Doc.space; return_doc]) + (if shouldIndent then Doc.indent (Doc.concat [Doc.line; returnDoc]) + else Doc.concat [Doc.space; returnDoc]) in - let typ_constraint_doc = - match typ_constraint with + let typConstraintDoc = + match typConstraint with | Some typ -> - let typ_doc = - let doc = print_typ_expr ~state typ cmt_tbl in - if Parens.arrow_return_typ_expr typ then add_parens doc else doc + let typDoc = + let doc = printTypExpr ~state typ cmtTbl in + if Parens.arrowReturnTypExpr typ then addParens doc else doc in - Doc.concat [Doc.text ": "; typ_doc] + Doc.concat [Doc.text ": "; typDoc] | _ -> Doc.nil in - let attrs = print_attributes ~state attrs cmt_tbl in + let attrs = printAttributes ~state attrs cmtTbl in Doc.group (Doc.concat - [ - attrs; - parameters_doc; - typ_constraint_doc; - Doc.text " =>"; - return_expr_doc; - ]) + [attrs; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc]) in - let uncurried = Ast_uncurried.expr_is_uncurried_fun e in + let uncurried = Ast_uncurried.exprIsUncurriedFun e in let e_fun = - if uncurried then Ast_uncurried.expr_extract_uncurried_fun e else e + if uncurried then Ast_uncurried.exprExtractUncurriedFun e else e in - let printed_expression = + let printedExpression = match e_fun.pexp_desc with | Pexp_fun ( Nolabel, @@ -2718,22 +2713,21 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = {pexp_desc = Pexp_apply _} ); } ) -> (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - print_expression_with_comments ~state - (ParsetreeViewer.rewrite_underscore_apply e_fun) - cmt_tbl - | Pexp_fun _ | Pexp_newtype _ -> print_arrow e + printExpressionWithComments ~state + (ParsetreeViewer.rewriteUnderscoreApply e_fun) + cmtTbl + | Pexp_fun _ | Pexp_newtype _ -> printArrow e | Parsetree.Pexp_constant c -> - print_constant ~template_literal:(ParsetreeViewer.is_template_literal e) c - | Pexp_construct _ when ParsetreeViewer.has_jsx_attribute e.pexp_attributes - -> - print_jsx_fragment ~state e cmt_tbl + printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c + | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> + printJsxFragment ~state e cmtTbl | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat - [Doc.text "list{"; print_comments_inside cmt_tbl e.pexp_loc; Doc.rbrace] + [Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace] | Pexp_construct ({txt = Longident.Lident "::"}, _) -> - let expressions, spread = ParsetreeViewer.collect_list_expressions e in - let spread_doc = + let expressions, spread = ParsetreeViewer.collectListExpressions e in + let spreadDoc = match spread with | Some expr -> Doc.concat @@ -2741,10 +2735,10 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.text ","; Doc.line; Doc.dotdotdot; - (let doc = print_expression_with_comments ~state expr cmt_tbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc); ] | None -> Doc.nil @@ -2756,27 +2750,27 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> let doc = - print_expression_with_comments ~state expr cmt_tbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc) expressions); - spread_doc; + spreadDoc; ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbrace; ]) - | Pexp_construct (longident_loc, args) -> - let constr = print_longident_location longident_loc cmt_tbl in + | Pexp_construct (longidentLoc, args) -> + let constr = printLongidentLocation longidentLoc cmtTbl in let args = match args with | None -> Doc.nil @@ -2788,10 +2782,10 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.concat [ Doc.lparen; - (let doc = print_expression_with_comments ~state arg cmt_tbl in + (let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc arg braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc arg braces | Nothing -> doc); Doc.rparen; ] @@ -2802,49 +2796,49 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun expr -> let doc = - print_expression_with_comments ~state expr cmt_tbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc) args); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ] | Some arg -> - let arg_doc = - let doc = print_expression_with_comments ~state arg cmt_tbl in + let argDoc = + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc arg braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc arg braces | Nothing -> doc in - let should_hug = ParsetreeViewer.is_huggable_expression arg in + let shouldHug = ParsetreeViewer.isHuggableExpression arg in Doc.concat [ Doc.lparen; - (if should_hug then arg_doc + (if shouldHug then argDoc else Doc.concat [ - Doc.indent (Doc.concat [Doc.soft_line; arg_doc]); - Doc.trailing_comma; - Doc.soft_line; + Doc.indent (Doc.concat [Doc.softLine; argDoc]); + Doc.trailingComma; + Doc.softLine; ]); Doc.rparen; ] in Doc.group (Doc.concat [constr; args]) - | Pexp_ident path -> print_lident_path path cmt_tbl + | Pexp_ident path -> printLidentPath path cmtTbl | Pexp_tuple exprs -> Doc.group (Doc.concat @@ -2853,27 +2847,27 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> let doc = - print_expression_with_comments ~state expr cmt_tbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc) exprs); ]); - Doc.if_breaks (Doc.text ",") Doc.nil; - Doc.soft_line; + Doc.ifBreaks (Doc.text ",") Doc.nil; + Doc.softLine; Doc.rparen; ]) | Pexp_array [] -> Doc.concat - [Doc.lbracket; print_comments_inside cmt_tbl e.pexp_loc; Doc.rbracket] + [Doc.lbracket; printCommentsInside cmtTbl e.pexp_loc; Doc.rbracket] | Pexp_array exprs -> Doc.group (Doc.concat @@ -2882,28 +2876,26 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> let doc = - print_expression_with_comments ~state expr cmt_tbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc) exprs); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbracket; ]) | Pexp_variant (label, args) -> - let variant_name = - Doc.concat [Doc.text "#"; print_poly_var_ident label] - in + let variantName = Doc.concat [Doc.text "#"; printPolyVarIdent label] in let args = match args with | None -> Doc.nil @@ -2915,10 +2907,10 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.concat [ Doc.lparen; - (let doc = print_expression_with_comments ~state arg cmt_tbl in + (let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc arg braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc arg braces | Nothing -> doc); Doc.rparen; ] @@ -2929,75 +2921,75 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun expr -> let doc = - print_expression_with_comments ~state expr cmt_tbl + printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc) args); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ] | Some arg -> - let arg_doc = - let doc = print_expression_with_comments ~state arg cmt_tbl in + let argDoc = + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc arg braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc arg braces | Nothing -> doc in - let should_hug = ParsetreeViewer.is_huggable_expression arg in + let shouldHug = ParsetreeViewer.isHuggableExpression arg in Doc.concat [ Doc.lparen; - (if should_hug then arg_doc + (if shouldHug then argDoc else Doc.concat [ - Doc.indent (Doc.concat [Doc.soft_line; arg_doc]); - Doc.trailing_comma; - Doc.soft_line; + Doc.indent (Doc.concat [Doc.softLine; argDoc]); + Doc.trailingComma; + Doc.softLine; ]); Doc.rparen; ] in - Doc.group (Doc.concat [variant_name; args]) - | Pexp_record (rows, spread_expr) -> + Doc.group (Doc.concat [variantName; args]) + | Pexp_record (rows, spreadExpr) -> if rows = [] then Doc.concat - [Doc.lbrace; print_comments_inside cmt_tbl e.pexp_loc; Doc.rbrace] + [Doc.lbrace; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace] else let spread = - match spread_expr with + match spreadExpr with | None -> Doc.nil | Some ({pexp_desc} as expr) -> let doc = match pexp_desc with - | Pexp_ident {txt = expr} -> print_lident expr - | _ -> print_expression ~state expr cmt_tbl + | Pexp_ident {txt = expr} -> printLident expr + | _ -> printExpression ~state expr cmtTbl in - let doc_with_spread = + let docWithSpread = Doc.concat [ Doc.dotdotdot; (match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc); ] in Doc.concat [ - print_comments doc_with_spread cmt_tbl expr.Parsetree.pexp_loc; + printComments docWithSpread cmtTbl expr.Parsetree.pexp_loc; Doc.comma; Doc.line; ] @@ -3008,38 +3000,38 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = * a: 1, * b: 2, * }` -> record is written on multiple lines, break the group *) - let force_break = + let forceBreak = e.pexp_loc.loc_start.pos_lnum < e.pexp_loc.loc_end.pos_lnum in - let punning_allowed = - match (spread_expr, rows) with + let punningAllowed = + match (spreadExpr, rows) with | None, [_] -> false (* disallow punning for single-element records *) | _ -> true in - Doc.breakable_group ~force_break + Doc.breakableGroup ~forceBreak (Doc.concat [ Doc.lbrace; Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; spread; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun row -> - print_expression_record_row ~state row cmt_tbl - punning_allowed) + printExpressionRecordRow ~state row cmtTbl + punningAllowed) rows); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbrace; ]) | Pexp_extension extension -> ( match extension with - | ( {txt = "obj"}, + | ( {txt = "bs.obj" | "obj"}, PStr [ { @@ -3053,66 +3045,65 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = * "a": 1, * "b": 2, * }` -> object is written on multiple lines, break the group *) - let force_break = loc.loc_start.pos_lnum < loc.loc_end.pos_lnum in - Doc.breakable_group ~force_break + let forceBreak = loc.loc_start.pos_lnum < loc.loc_end.pos_lnum in + Doc.breakableGroup ~forceBreak (Doc.concat [ Doc.lbrace; Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> print_bs_object_row ~state row cmt_tbl) + (fun row -> printBsObjectRow ~state row cmtTbl) rows); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbrace; ]) - | extension -> - print_extension ~state ~at_module_lvl:false extension cmt_tbl) - | Pexp_apply (e, [(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 (e, [(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 (call_expr, args) -> - if ParsetreeViewer.is_unary_expression e then - print_unary_expression ~state e cmt_tbl - else if ParsetreeViewer.is_template_literal e then - print_template_literal ~state e cmt_tbl - else if ParsetreeViewer.is_tagged_template_literal e then - print_tagged_template_literal ~state call_expr args cmt_tbl - else if ParsetreeViewer.is_binary_expression e then - print_binary_expression ~state e cmt_tbl - else print_pexp_apply ~state e cmt_tbl + | extension -> printExtension ~state ~atModuleLvl:false extension cmtTbl) + | Pexp_apply (e, [(Nolabel, {pexp_desc = Pexp_array subLists})]) + when ParsetreeViewer.isSpreadBeltArrayConcat e -> + printBeltArrayConcatApply ~state subLists cmtTbl + | Pexp_apply (e, [(Nolabel, {pexp_desc = Pexp_array subLists})]) + when ParsetreeViewer.isSpreadBeltListConcat e -> + printBeltListConcatApply ~state subLists cmtTbl + | Pexp_apply (callExpr, args) -> + if ParsetreeViewer.isUnaryExpression e then + printUnaryExpression ~state e cmtTbl + else if ParsetreeViewer.isTemplateLiteral e then + printTemplateLiteral ~state e cmtTbl + else if ParsetreeViewer.isTaggedTemplateLiteral e then + printTaggedTemplateLiteral ~state callExpr args cmtTbl + else if ParsetreeViewer.isBinaryExpression e then + printBinaryExpression ~state e cmtTbl + else printPexpApply ~state e cmtTbl | Pexp_unreachable -> Doc.dot - | Pexp_field (expr, longident_loc) -> + | Pexp_field (expr, longidentLoc) -> let lhs = - let doc = print_expression_with_comments ~state expr cmt_tbl in - match Parens.field_expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + let doc = printExpressionWithComments ~state expr cmtTbl in + match Parens.fieldExpr expr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc in - Doc.concat [lhs; Doc.dot; print_lident_path longident_loc cmt_tbl] - | Pexp_setfield (expr1, longident_loc, expr2) -> - print_set_field_expr ~state e.pexp_attributes expr1 longident_loc expr2 - e.pexp_loc cmt_tbl + Doc.concat [lhs; Doc.dot; printLidentPath longidentLoc cmtTbl] + | Pexp_setfield (expr1, longidentLoc, expr2) -> + printSetFieldExpr ~state e.pexp_attributes expr1 longidentLoc expr2 + e.pexp_loc cmtTbl | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) - when ParsetreeViewer.is_ternary_expr e -> - let parts, alternate = ParsetreeViewer.collect_ternary_parts e in - let ternary_doc = + when ParsetreeViewer.isTernaryExpr e -> + let parts, alternate = ParsetreeViewer.collectTernaryParts e in + let ternaryDoc = match parts with | (condition1, consequent1) :: rest -> Doc.group (Doc.concat [ - print_ternary_operand ~state condition1 cmt_tbl; + printTernaryOperand ~state condition1 cmtTbl; Doc.indent (Doc.concat [ @@ -3121,7 +3112,7 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = (Doc.concat [ Doc.text "? "; - print_ternary_operand ~state consequent1 cmt_tbl; + printTernaryOperand ~state consequent1 cmtTbl; ]); Doc.concat (List.map @@ -3130,79 +3121,74 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = [ Doc.line; Doc.text ": "; - print_ternary_operand ~state condition - cmt_tbl; + printTernaryOperand ~state condition cmtTbl; Doc.line; Doc.text "? "; - print_ternary_operand ~state consequent - cmt_tbl; + printTernaryOperand ~state consequent cmtTbl; ]) rest); Doc.line; Doc.text ": "; - Doc.indent - (print_ternary_operand ~state alternate cmt_tbl); + Doc.indent (printTernaryOperand ~state alternate cmtTbl); ]); ]) | _ -> Doc.nil in - let attrs = ParsetreeViewer.filter_ternary_attributes e.pexp_attributes in - let needs_parens = - match ParsetreeViewer.filter_parsing_attrs attrs with + let attrs = ParsetreeViewer.filterTernaryAttributes e.pexp_attributes in + let needsParens = + match ParsetreeViewer.filterParsingAttrs attrs with | [] -> false | _ -> true in Doc.concat [ - print_attributes ~state attrs cmt_tbl; - (if needs_parens then add_parens ternary_doc else ternary_doc); + printAttributes ~state attrs cmtTbl; + (if needsParens then addParens ternaryDoc else ternaryDoc); ] | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) -> - let ifs, else_expr = ParsetreeViewer.collect_if_expressions e in - print_if_chain ~state e.pexp_attributes ifs else_expr cmt_tbl + let ifs, elseExpr = ParsetreeViewer.collectIfExpressions e in + printIfChain ~state e.pexp_attributes ifs elseExpr cmtTbl | Pexp_while (expr1, expr2) -> let condition = - let doc = print_expression_with_comments ~state expr1 cmt_tbl in + let doc = printExpressionWithComments ~state expr1 cmtTbl in match Parens.expr expr1 with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr1 braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr1 braces | Nothing -> doc in - Doc.breakable_group ~force_break:true + Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.text "while "; - (if ParsetreeViewer.is_block_expr expr1 then condition - else Doc.group (Doc.if_breaks (add_parens condition) condition)); + (if ParsetreeViewer.isBlockExpr expr1 then condition + else Doc.group (Doc.ifBreaks (addParens condition) condition)); Doc.space; - print_expression_block ~state ~braces:true expr2 cmt_tbl; + printExpressionBlock ~state ~braces:true expr2 cmtTbl; ]) - | Pexp_for (pattern, from_expr, to_expr, direction_flag, body) -> - Doc.breakable_group ~force_break:true + | Pexp_for (pattern, fromExpr, toExpr, directionFlag, body) -> + Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.text "for "; - print_pattern ~state pattern cmt_tbl; + printPattern ~state pattern cmtTbl; Doc.text " in "; - (let doc = - print_expression_with_comments ~state from_expr cmt_tbl - in - match Parens.expr from_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc from_expr braces + (let doc = printExpressionWithComments ~state fromExpr cmtTbl in + match Parens.expr fromExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc fromExpr braces | Nothing -> doc); - print_direction_flag direction_flag; - (let doc = print_expression_with_comments ~state to_expr cmt_tbl in - match Parens.expr to_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc to_expr braces + printDirectionFlag directionFlag; + (let doc = printExpressionWithComments ~state toExpr cmtTbl in + match Parens.expr toExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc toExpr braces | Nothing -> doc); Doc.space; - print_expression_block ~state ~braces:true body cmt_tbl; + printExpressionBlock ~state ~braces:true body cmtTbl; ]) | Pexp_constraint - ( {pexp_desc = Pexp_pack mod_expr}, - {ptyp_desc = Ptyp_package package_type; ptyp_loc} ) -> + ( {pexp_desc = Pexp_pack modExpr}, + {ptyp_desc = Ptyp_package packageType; ptyp_loc} ) -> Doc.group (Doc.concat [ @@ -3210,130 +3196,121 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; - print_mod_expr ~state mod_expr cmt_tbl; + Doc.softLine; + printModExpr ~state modExpr cmtTbl; Doc.text ": "; - print_comments - (print_package_type ~state - ~print_module_keyword_and_parens:false package_type - cmt_tbl) - cmt_tbl ptyp_loc; + printComments + (printPackageType ~state + ~printModuleKeywordAndParens:false packageType cmtTbl) + cmtTbl ptyp_loc; ]); - Doc.soft_line; + Doc.softLine; Doc.rparen; ]) | Pexp_constraint (expr, typ) -> - let expr_doc = - let doc = print_expression_with_comments ~state expr cmt_tbl in + let exprDoc = + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc in - Doc.concat [expr_doc; Doc.text ": "; print_typ_expr ~state typ cmt_tbl] + Doc.concat [exprDoc; Doc.text ": "; printTypExpr ~state typ cmtTbl] | Pexp_letmodule ({txt = _modName}, _modExpr, _expr) -> - print_expression_block ~state ~braces:true e cmt_tbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_letexception (_extensionConstructor, _expr) -> - print_expression_block ~state ~braces:true e cmt_tbl + printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_assert expr -> - let expr = print_expression_with_comments ~state expr cmt_tbl in + let expr = printExpressionWithComments ~state expr cmtTbl in Doc.concat [Doc.text "assert("; expr; Doc.text ")"] | Pexp_lazy expr -> let rhs = - let doc = print_expression_with_comments ~state expr cmt_tbl in - match Parens.lazy_or_assert_or_await_expr_rhs expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + let doc = printExpressionWithComments ~state expr cmtTbl in + match Parens.lazyOrAssertOrAwaitExprRhs expr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc in Doc.group (Doc.concat [Doc.text "lazy "; rhs]) | Pexp_open (_overrideFlag, _longidentLoc, _expr) -> - print_expression_block ~state ~braces:true e cmt_tbl - | Pexp_pack mod_expr -> + printExpressionBlock ~state ~braces:true e cmtTbl + | Pexp_pack modExpr -> Doc.group (Doc.concat [ Doc.text "module("; Doc.indent - (Doc.concat - [Doc.soft_line; print_mod_expr ~state mod_expr cmt_tbl]); - Doc.soft_line; + (Doc.concat [Doc.softLine; printModExpr ~state modExpr cmtTbl]); + Doc.softLine; Doc.rparen; ]) - | Pexp_sequence _ -> print_expression_block ~state ~braces:true e cmt_tbl - | Pexp_let _ -> print_expression_block ~state ~braces:true e cmt_tbl + | Pexp_sequence _ -> printExpressionBlock ~state ~braces:true e cmtTbl + | Pexp_let _ -> printExpressionBlock ~state ~braces:true e cmtTbl | Pexp_try (expr, cases) -> - let expr_doc = - let doc = print_expression_with_comments ~state expr cmt_tbl in + let exprDoc = + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc in Doc.concat [ Doc.text "try "; - expr_doc; + exprDoc; Doc.text " catch "; - print_cases ~state cases cmt_tbl; + printCases ~state cases cmtTbl; ] - | Pexp_match (_, [_; _]) when ParsetreeViewer.is_if_let_expr e -> - let ifs, else_expr = ParsetreeViewer.collect_if_expressions e in - print_if_chain ~state e.pexp_attributes ifs else_expr cmt_tbl + | Pexp_match (_, [_; _]) when ParsetreeViewer.isIfLetExpr e -> + let ifs, elseExpr = ParsetreeViewer.collectIfExpressions e in + printIfChain ~state e.pexp_attributes ifs elseExpr cmtTbl | Pexp_match (expr, cases) -> - let expr_doc = - let doc = print_expression_with_comments ~state expr cmt_tbl in + let exprDoc = + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc in Doc.concat - [ - Doc.text "switch "; - expr_doc; - Doc.space; - print_cases ~state cases cmt_tbl; - ] + [Doc.text "switch "; exprDoc; Doc.space; printCases ~state cases cmtTbl] | Pexp_function cases -> - Doc.concat [Doc.text "x => switch x "; print_cases ~state cases cmt_tbl] - | Pexp_coerce (expr, typ_opt, typ) -> - let doc_expr = print_expression_with_comments ~state expr cmt_tbl in - let doc_typ = print_typ_expr ~state typ cmt_tbl in - let of_type = - match typ_opt with + Doc.concat [Doc.text "x => switch x "; printCases ~state cases cmtTbl] + | Pexp_coerce (expr, typOpt, typ) -> + let docExpr = printExpressionWithComments ~state expr cmtTbl in + let docTyp = printTypExpr ~state typ cmtTbl in + let ofType = + match typOpt with | None -> Doc.nil | Some typ1 -> - Doc.concat [Doc.text ": "; print_typ_expr ~state typ1 cmt_tbl] + Doc.concat [Doc.text ": "; printTypExpr ~state typ1 cmtTbl] in Doc.concat - [Doc.lparen; doc_expr; of_type; Doc.text " :> "; doc_typ; Doc.rparen] - | Pexp_send (parent_expr, label) -> - let parent_doc = - let doc = print_expression_with_comments ~state parent_expr cmt_tbl in - match Parens.unary_expr_operand parent_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc parent_expr braces + [Doc.lparen; docExpr; ofType; Doc.text " :> "; docTyp; Doc.rparen] + | Pexp_send (parentExpr, label) -> + let parentDoc = + let doc = printExpressionWithComments ~state parentExpr cmtTbl in + match Parens.unaryExprOperand parentExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc parentExpr braces | Nothing -> doc in let member = - let member_doc = - print_comments (Doc.text label.txt) cmt_tbl label.loc - in - Doc.concat [Doc.text "\""; member_doc; Doc.text "\""] + let memberDoc = printComments (Doc.text label.txt) cmtTbl label.loc in + Doc.concat [Doc.text "\""; memberDoc; Doc.text "\""] in - Doc.group (Doc.concat [parent_doc; Doc.lbracket; member; Doc.rbracket]) + Doc.group (Doc.concat [parentDoc; Doc.lbracket; member; Doc.rbracket]) | Pexp_new _ -> Doc.text "Pexp_new not implemented in printer" | Pexp_setinstvar _ -> Doc.text "Pexp_setinstvar not implemented in printer" | Pexp_override _ -> Doc.text "Pexp_override not implemented in printer" | Pexp_poly _ -> Doc.text "Pexp_poly not implemented in printer" | Pexp_object _ -> Doc.text "Pexp_object not implemented in printer" in - let expr_with_await = - if ParsetreeViewer.has_await_attribute e.pexp_attributes then + let exprWithAwait = + if ParsetreeViewer.hasAwaitAttribute e.pexp_attributes then let rhs = match - Parens.lazy_or_assert_or_await_expr_rhs ~in_await:true + Parens.lazyOrAssertOrAwaitExprRhs ~inAwait:true { e with pexp_attributes = @@ -3344,69 +3321,67 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = e.pexp_attributes; } with - | Parens.Parenthesized -> add_parens printed_expression - | Braced braces -> print_braces printed_expression e braces - | Nothing -> printed_expression + | Parens.Parenthesized -> addParens printedExpression + | Braced braces -> printBraces printedExpression e braces + | Nothing -> printedExpression in Doc.concat [Doc.text "await "; rhs] - else printed_expression + else printedExpression in - let should_print_its_own_attributes = + let shouldPrintItsOwnAttributes = match e.pexp_desc with | Pexp_apply _ | Pexp_fun _ | Pexp_newtype _ | Pexp_setfield _ | Pexp_ifthenelse _ -> true - | Pexp_match _ when ParsetreeViewer.is_if_let_expr e -> true - | Pexp_construct _ when ParsetreeViewer.has_jsx_attribute e.pexp_attributes - -> + | Pexp_match _ when ParsetreeViewer.isIfLetExpr e -> true + | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> true | _ -> false in match e.pexp_attributes with - | [] -> expr_with_await - | attrs when not should_print_its_own_attributes -> - Doc.group - (Doc.concat [print_attributes ~state attrs cmt_tbl; expr_with_await]) - | _ -> expr_with_await + | [] -> exprWithAwait + | attrs when not shouldPrintItsOwnAttributes -> + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; exprWithAwait]) + | _ -> exprWithAwait -and print_pexp_fun ~state ~in_callback e cmt_tbl = - let uncurried, attrs_on_arrow, parameters, return_expr = - ParsetreeViewer.fun_expr e +and printPexpFun ~state ~inCallback e cmtTbl = + let uncurried, attrsOnArrow, parameters, returnExpr = + ParsetreeViewer.funExpr e in let ParsetreeViewer.{async; bs; attributes = attrs} = - ParsetreeViewer.process_function_attributes attrs_on_arrow + ParsetreeViewer.processFunctionAttributes attrsOnArrow in let uncurried = bs || uncurried in - let return_expr, typ_constraint = - match return_expr.pexp_desc with + let returnExpr, typConstraint = + match returnExpr.pexp_desc with | Pexp_constraint (expr, typ) -> ( { expr with pexp_attributes = - List.concat [expr.pexp_attributes; return_expr.pexp_attributes]; + List.concat [expr.pexp_attributes; returnExpr.pexp_attributes]; }, Some typ ) - | _ -> (return_expr, None) + | _ -> (returnExpr, None) in - let parameters_doc = - print_expr_fun_parameters ~state ~in_callback ~async ~uncurried - ~has_constraint: - (match typ_constraint with + let parametersDoc = + printExprFunParameters ~state ~inCallback ~async ~uncurried + ~hasConstraint: + (match typConstraint with | Some _ -> true | None -> false) - parameters cmt_tbl + parameters cmtTbl in - let return_should_indent = - match return_expr.pexp_desc with + let returnShouldIndent = + match returnExpr.pexp_desc with | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ -> false | _ -> true in - let return_expr_doc = - let opt_braces, _ = ParsetreeViewer.process_braces_attr return_expr in - let should_inline = - match (return_expr.pexp_desc, opt_braces) with + let returnExprDoc = + let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in + let shouldInline = + match (returnExpr.pexp_desc, optBraces) with | _, Some _ -> true | ( ( Pexp_array _ | Pexp_tuple _ | Pexp_construct (_, Some _) @@ -3415,109 +3390,108 @@ and print_pexp_fun ~state ~in_callback e cmt_tbl = true | _ -> false in - let return_doc = - let doc = print_expression_with_comments ~state return_expr cmt_tbl in - match Parens.expr return_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc return_expr braces + let returnDoc = + let doc = printExpressionWithComments ~state returnExpr cmtTbl in + match Parens.expr returnExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc returnExpr braces | Nothing -> doc in - if should_inline then Doc.concat [Doc.space; return_doc] + if shouldInline then Doc.concat [Doc.space; returnDoc] else Doc.group - (if return_should_indent then + (if returnShouldIndent then Doc.concat [ - Doc.indent (Doc.concat [Doc.line; return_doc]); - (match in_callback with - | FitsOnOneLine | ArgumentsFitOnOneLine -> Doc.soft_line + Doc.indent (Doc.concat [Doc.line; returnDoc]); + (match inCallback with + | FitsOnOneLine | ArgumentsFitOnOneLine -> Doc.softLine | _ -> Doc.nil); ] - else Doc.concat [Doc.space; return_doc]) + else Doc.concat [Doc.space; returnDoc]) in - let typ_constraint_doc = - match typ_constraint with - | Some typ -> Doc.concat [Doc.text ": "; print_typ_expr ~state typ cmt_tbl] + let typConstraintDoc = + match typConstraint with + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | _ -> Doc.nil in Doc.concat [ - print_attributes ~state attrs cmt_tbl; - parameters_doc; - typ_constraint_doc; + printAttributes ~state attrs cmtTbl; + parametersDoc; + typConstraintDoc; Doc.text " =>"; - return_expr_doc; + returnExprDoc; ] -and print_ternary_operand ~state expr cmt_tbl = - let doc = print_expression_with_comments ~state expr cmt_tbl in - match Parens.ternary_operand expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces +and printTernaryOperand ~state expr cmtTbl = + let doc = printExpressionWithComments ~state expr cmtTbl in + match Parens.ternaryOperand expr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc -and print_set_field_expr ~state attrs lhs longident_loc rhs loc cmt_tbl = - let rhs_doc = - let doc = print_expression_with_comments ~state rhs cmt_tbl in - match Parens.set_field_expr_rhs rhs with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc rhs braces +and printSetFieldExpr ~state attrs lhs longidentLoc rhs loc cmtTbl = + let rhsDoc = + let doc = printExpressionWithComments ~state rhs cmtTbl in + match Parens.setFieldExprRhs rhs with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc rhs braces | Nothing -> doc in - let lhs_doc = - let doc = print_expression_with_comments ~state lhs cmt_tbl in - match Parens.field_expr lhs with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc lhs braces + let lhsDoc = + let doc = printExpressionWithComments ~state lhs cmtTbl in + match Parens.fieldExpr lhs with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc lhs braces | Nothing -> doc in - let should_indent = ParsetreeViewer.is_binary_expression rhs in + let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in let doc = Doc.group (Doc.concat [ - lhs_doc; + lhsDoc; Doc.dot; - print_lident_path longident_loc cmt_tbl; + printLidentPath longidentLoc cmtTbl; Doc.text " ="; - (if should_indent then - Doc.group (Doc.indent (Doc.concat [Doc.line; rhs_doc])) - else Doc.concat [Doc.space; rhs_doc]); + (if shouldIndent then + Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc])) + else Doc.concat [Doc.space; rhsDoc]); ]) in let doc = match attrs with | [] -> doc - | attrs -> - Doc.group (Doc.concat [print_attributes ~state attrs cmt_tbl; doc]) + | attrs -> Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) in - print_comments doc cmt_tbl loc + printComments doc cmtTbl loc -and print_template_literal ~state expr cmt_tbl = +and printTemplateLiteral ~state expr cmtTbl = let tag = ref "js" in - let rec walk_expr expr = + let rec walkExpr expr = let open Parsetree in match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "^"}}, [(Nolabel, arg1); (Nolabel, arg2)] ) -> - let lhs = walk_expr arg1 in - let rhs = walk_expr arg2 in + let lhs = walkExpr arg1 in + let rhs = walkExpr arg2 in Doc.concat [lhs; rhs] | Pexp_constant (Pconst_string (txt, Some prefix)) -> tag := prefix; - print_string_contents txt + printStringContents txt | _ -> - let doc = print_expression_with_comments ~state expr cmt_tbl in + let doc = printExpressionWithComments ~state expr cmtTbl in let doc = match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc in Doc.group (Doc.concat [Doc.text "${"; Doc.indent doc; Doc.rbrace]) in - let content = walk_expr expr in + let content = walkExpr expr in Doc.concat [ (if !tag = "js" then Doc.nil else Doc.text !tag); @@ -3526,8 +3500,8 @@ and print_template_literal ~state expr cmt_tbl = Doc.text "`"; ] -and print_tagged_template_literal ~state call_expr args cmt_tbl = - let strings_list, values_list = +and printTaggedTemplateLiteral ~state callExpr args cmtTbl = + let stringsList, valuesList = match args with | [ (_, {Parsetree.pexp_desc = Pexp_array strings}); @@ -3542,9 +3516,9 @@ and print_tagged_template_literal ~state call_expr args cmt_tbl = (fun x -> match x with | {Parsetree.pexp_desc = Pexp_constant (Pconst_string (txt, _))} -> - print_string_contents txt + printStringContents txt | _ -> assert false) - strings_list + stringsList in let values = @@ -3553,10 +3527,10 @@ and print_tagged_template_literal ~state call_expr args cmt_tbl = Doc.concat [ Doc.text "${"; - print_expression_with_comments ~state x cmt_tbl; + printExpressionWithComments ~state x cmtTbl; Doc.text "}"; ]) - values_list + valuesList in let process strings values = @@ -3570,11 +3544,11 @@ and print_tagged_template_literal ~state call_expr args cmt_tbl = let content : Doc.t = process strings values in - let tag = print_expression_with_comments ~state call_expr cmt_tbl in + let tag = printExpressionWithComments ~state callExpr cmtTbl in Doc.concat [tag; Doc.text "`"; content; Doc.text "`"] -and print_unary_expression ~state expr cmt_tbl = - let print_unary_operator op = +and printUnaryExpression ~state expr cmtTbl = + let printUnaryOperator op = Doc.text (match op with | "~+" -> "+" @@ -3588,20 +3562,20 @@ and print_unary_expression ~state expr cmt_tbl = | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, operand)] ) -> - let printed_operand = - let doc = print_expression_with_comments ~state operand cmt_tbl in - match Parens.unary_expr_operand operand with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc operand braces + let printedOperand = + let doc = printExpressionWithComments ~state operand cmtTbl in + match Parens.unaryExprOperand operand with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc operand braces | Nothing -> doc in - let doc = Doc.concat [print_unary_operator operator; printed_operand] in - print_comments doc cmt_tbl expr.pexp_loc + let doc = Doc.concat [printUnaryOperator operator; printedOperand] in + printComments doc cmtTbl expr.pexp_loc | _ -> assert false -and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = - let print_binary_operator ~inline_rhs operator = - let operator_txt = +and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = + let printBinaryOperator ~inlineRhs operator = + let operatorTxt = match operator with | "|." | "|.u" -> "->" | "^" -> "++" @@ -3611,23 +3585,23 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = | "!=" -> "!==" | txt -> txt in - let spacing_before_operator = - if operator = "|." || operator = "|.u" then Doc.soft_line + let spacingBeforeOperator = + if operator = "|." || operator = "|.u" then Doc.softLine else if operator = "|>" then Doc.line else Doc.space in - let spacing_after_operator = + let spacingAfterOperator = if operator = "|." || operator = "|.u" then Doc.nil else if operator = "|>" then Doc.space - else if inline_rhs then Doc.space + else if inlineRhs then Doc.space else Doc.line in Doc.concat - [spacing_before_operator; Doc.text operator_txt; spacing_after_operator] + [spacingBeforeOperator; Doc.text operatorTxt; spacingAfterOperator] in - let print_operand ~is_lhs ~is_multiline expr parent_operator = - let rec flatten ~is_lhs ~is_multiline expr parent_operator = - if ParsetreeViewer.is_binary_expression expr then + let printOperand ~isLhs ~isMultiline expr parentOperator = + let rec flatten ~isLhs ~isMultiline expr parentOperator = + if ParsetreeViewer.isBinaryExpression expr then match expr with | { pexp_desc = @@ -3636,103 +3610,100 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = [(_, left); (_, right)] ); } -> if - ParsetreeViewer.flattenable_operators parent_operator operator - && not (ParsetreeViewer.has_attributes expr.pexp_attributes) + ParsetreeViewer.flattenableOperators parentOperator operator + && not (ParsetreeViewer.hasAttributes expr.pexp_attributes) then - let left_printed = - flatten ~is_lhs:true ~is_multiline left operator - in - let right_printed = - let right_printeable_attrs, right_internal_attrs = - ParsetreeViewer.partition_printable_attributes + let leftPrinted = flatten ~isLhs:true ~isMultiline left operator in + let rightPrinted = + let rightPrinteableAttrs, rightInternalAttrs = + ParsetreeViewer.partitionPrintableAttributes right.pexp_attributes in let doc = - print_expression_with_comments ~state - {right with pexp_attributes = right_internal_attrs} - cmt_tbl + printExpressionWithComments ~state + {right with pexp_attributes = rightInternalAttrs} + cmtTbl in let doc = - if Parens.flatten_operand_rhs parent_operator right then + if Parens.flattenOperandRhs parentOperator right then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in let doc = Doc.concat - [print_attributes ~state right_printeable_attrs cmt_tbl; doc] + [printAttributes ~state rightPrinteableAttrs cmtTbl; doc] in - match right_printeable_attrs with + match rightPrinteableAttrs with | [] -> doc - | _ -> add_parens doc + | _ -> addParens doc in - let is_await = - ParsetreeViewer.has_await_attribute expr.pexp_attributes + let isAwait = + ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes in let doc = - if is_await then + if isAwait then let parens = - Res_parens.binary_operator_inside_await_needs_parens operator + Res_parens.binaryOperatorInsideAwaitNeedsParens operator in Doc.concat [ Doc.lparen; Doc.text "await "; (if parens then Doc.lparen else Doc.nil); - left_printed; - print_binary_operator ~inline_rhs:false operator; - right_printed; + leftPrinted; + printBinaryOperator ~inlineRhs:false operator; + rightPrinted; (if parens then Doc.rparen else Doc.nil); Doc.rparen; ] else match operator with - | ("|." | "|.u") when is_multiline -> + | ("|." | "|.u") when isMultiline -> (* If the pipe-chain is written over multiple lines, break automatically * `let x = a->b->c -> same line, break when line-width exceeded * `let x = a-> * b->c` -> pipe-chain is written on multiple lines, break the group *) - Doc.breakable_group ~force_break:true + Doc.breakableGroup ~forceBreak:true (Doc.concat [ - left_printed; - print_binary_operator ~inline_rhs:false operator; - right_printed; + leftPrinted; + printBinaryOperator ~inlineRhs:false operator; + rightPrinted; ]) | _ -> Doc.concat [ - left_printed; - print_binary_operator ~inline_rhs:false operator; - right_printed; + leftPrinted; + printBinaryOperator ~inlineRhs:false operator; + rightPrinted; ] in let doc = - if (not is_lhs) && Parens.rhs_binary_expr_operand operator expr - then Doc.concat [Doc.lparen; doc; Doc.rparen] + if (not isLhs) && Parens.rhsBinaryExprOperand operator expr then + Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - print_comments doc cmt_tbl expr.pexp_loc + printComments doc cmtTbl expr.pexp_loc else - let printeable_attrs, internal_attrs = - ParsetreeViewer.partition_printable_attributes - expr.pexp_attributes + let printeableAttrs, internalAttrs = + ParsetreeViewer.partitionPrintableAttributes expr.pexp_attributes in let doc = - print_expression_with_comments ~state - {expr with pexp_attributes = internal_attrs} - cmt_tbl + printExpressionWithComments ~state + {expr with pexp_attributes = internalAttrs} + cmtTbl in let doc = if - Parens.sub_binary_expr_operand parent_operator operator - || printeable_attrs <> [] - && (ParsetreeViewer.is_binary_expression expr - || ParsetreeViewer.is_ternary_expr expr) + Parens.subBinaryExprOperand parentOperator operator + || printeableAttrs <> [] + && (ParsetreeViewer.isBinaryExpression expr + || ParsetreeViewer.isTernaryExpr expr) then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - Doc.concat [print_attributes ~state printeable_attrs cmt_tbl; doc] + Doc.concat [printAttributes ~state printeableAttrs cmtTbl; doc] | _ -> assert false else match expr.pexp_desc with @@ -3740,48 +3711,47 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident "^"; loc}}, [(Nolabel, _); (Nolabel, _)] ) when loc.loc_ghost -> - let doc = print_template_literal ~state expr cmt_tbl in - print_comments doc cmt_tbl expr.Parsetree.pexp_loc + let doc = printTemplateLiteral ~state expr cmtTbl in + printComments doc cmtTbl expr.Parsetree.pexp_loc | Pexp_setfield (lhs, field, rhs) -> let doc = - print_set_field_expr ~state expr.pexp_attributes lhs field rhs - expr.pexp_loc cmt_tbl + printSetFieldExpr ~state expr.pexp_attributes lhs field rhs + expr.pexp_loc cmtTbl in - if is_lhs then add_parens doc else doc + if isLhs then addParens doc else doc | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(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 + let rhsDoc = printExpressionWithComments ~state rhs cmtTbl in + let lhsDoc = printExpressionWithComments ~state lhs cmtTbl in (* TODO: unify indentation of "=" *) - let should_indent = ParsetreeViewer.is_binary_expression rhs in + let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in let doc = Doc.group (Doc.concat [ - lhs_doc; + lhsDoc; Doc.text " ="; - (if should_indent then - Doc.group (Doc.indent (Doc.concat [Doc.line; rhs_doc])) - else Doc.concat [Doc.space; rhs_doc]); + (if shouldIndent then + Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc])) + else Doc.concat [Doc.space; rhsDoc]); ]) in let doc = match expr.pexp_attributes with | [] -> doc | attrs -> - Doc.group - (Doc.concat [print_attributes ~state attrs cmt_tbl; doc]) + Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) in - if is_lhs then add_parens doc else doc + if isLhs then addParens doc else doc | _ -> ( - let doc = print_expression_with_comments ~state expr cmt_tbl in - match Parens.binary_expr_operand ~is_lhs expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + let doc = printExpressionWithComments ~state expr cmtTbl in + match Parens.binaryExprOperand ~isLhs expr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc) in - flatten ~is_lhs ~is_multiline expr parent_operator + flatten ~isLhs ~isMultiline expr parentOperator in match expr.pexp_desc with | Pexp_apply @@ -3791,116 +3761,115 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = }, [(Nolabel, lhs); (Nolabel, rhs)] ) when not - (ParsetreeViewer.is_binary_expression lhs - || ParsetreeViewer.is_binary_expression rhs - || print_attributes ~state expr.pexp_attributes cmt_tbl <> Doc.nil) - -> - let lhs_has_comment_below = has_comment_below cmt_tbl lhs.pexp_loc in - let lhs_doc = print_operand ~is_lhs:true ~is_multiline:false lhs op in - let rhs_doc = print_operand ~is_lhs:false ~is_multiline:false rhs op in + (ParsetreeViewer.isBinaryExpression lhs + || ParsetreeViewer.isBinaryExpression rhs + || printAttributes ~state expr.pexp_attributes cmtTbl <> Doc.nil) -> + let lhsHasCommentBelow = hasCommentBelow cmtTbl lhs.pexp_loc in + let lhsDoc = printOperand ~isLhs:true ~isMultiline:false lhs op in + let rhsDoc = printOperand ~isLhs:false ~isMultiline:false rhs op in Doc.group (Doc.concat [ - print_attributes ~state expr.pexp_attributes cmt_tbl; - lhs_doc; - (match (lhs_has_comment_below, op) with - | true, ("|." | "|.u") -> Doc.concat [Doc.soft_line; Doc.text "->"] + printAttributes ~state expr.pexp_attributes cmtTbl; + lhsDoc; + (match (lhsHasCommentBelow, op) with + | true, ("|." | "|.u") -> Doc.concat [Doc.softLine; Doc.text "->"] | false, ("|." | "|.u") -> Doc.text "->" | true, "|>" -> Doc.concat [Doc.line; Doc.text "|> "] | false, "|>" -> Doc.text " |> " | _ -> Doc.nil); - rhs_doc; + rhsDoc; ]) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> - let is_multiline = + let isMultiline = lhs.pexp_loc.loc_start.pos_lnum < rhs.pexp_loc.loc_start.pos_lnum in let right = - let operator_with_rhs = - let rhs_doc = - print_operand - ~is_lhs:(ParsetreeViewer.is_rhs_binary_operator operator) - ~is_multiline rhs operator + let operatorWithRhs = + let rhsDoc = + printOperand + ~isLhs:(ParsetreeViewer.isRhsBinaryOperator operator) + ~isMultiline rhs operator in Doc.concat [ - print_binary_operator - ~inline_rhs:(ParsetreeViewer.should_inline_rhs_binary_expr rhs) + printBinaryOperator + ~inlineRhs:(ParsetreeViewer.shouldInlineRhsBinaryExpr rhs) operator; - rhs_doc; + rhsDoc; ] in - if ParsetreeViewer.should_indent_binary_expr expr then - Doc.group (Doc.indent operator_with_rhs) - else operator_with_rhs + if ParsetreeViewer.shouldIndentBinaryExpr expr then + Doc.group (Doc.indent operatorWithRhs) + else operatorWithRhs in let doc = Doc.group (Doc.concat [ - print_operand - ~is_lhs:(not @@ ParsetreeViewer.is_rhs_binary_operator operator) - ~is_multiline lhs operator; + printOperand + ~isLhs:(not @@ ParsetreeViewer.isRhsBinaryOperator operator) + ~isMultiline lhs operator; right; ]) in Doc.group (Doc.concat [ - print_attributes ~state expr.pexp_attributes cmt_tbl; + printAttributes ~state expr.pexp_attributes cmtTbl; (match - Parens.binary_expr + Parens.binaryExpr { expr with pexp_attributes = - ParsetreeViewer.filter_printable_attributes + ParsetreeViewer.filterPrintableAttributes expr.pexp_attributes; } with - | Braced braces_loc -> print_braces doc expr braces_loc - | Parenthesized -> add_parens doc + | Braced bracesLoc -> printBraces doc expr bracesLoc + | Parenthesized -> addParens doc | Nothing -> doc); ]) | _ -> Doc.nil -and print_belt_array_concat_apply ~state sub_lists cmt_tbl = - let make_spread_doc comma_before_spread = function +and printBeltArrayConcatApply ~state subLists cmtTbl = + let makeSpreadDoc commaBeforeSpread = function | Some expr -> Doc.concat [ - comma_before_spread; + commaBeforeSpread; Doc.dotdotdot; - (let doc = print_expression_with_comments ~state expr cmt_tbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc); ] | None -> Doc.nil in - let make_sub_list_doc (expressions, spread) = - let comma_before_spread = + let makeSubListDoc (expressions, spread) = + let commaBeforeSpread = match expressions with | [] -> Doc.nil | _ -> Doc.concat [Doc.text ","; Doc.line] in - let spread_doc = make_spread_doc comma_before_spread spread in + let spreadDoc = makeSpreadDoc commaBeforeSpread spread in Doc.concat [ Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> - let doc = print_expression_with_comments ~state expr cmt_tbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc) expressions); - spread_doc; + spreadDoc; ] in Doc.group @@ -3910,53 +3879,52 @@ and print_belt_array_concat_apply ~state sub_lists cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map make_sub_list_doc - (List.map ParsetreeViewer.collect_array_expressions - sub_lists)); + (List.map makeSubListDoc + (List.map ParsetreeViewer.collectArrayExpressions subLists)); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbracket; ]) -and print_belt_list_concat_apply ~state sub_lists cmt_tbl = - let make_spread_doc comma_before_spread = function +and printBeltListConcatApply ~state subLists cmtTbl = + let makeSpreadDoc commaBeforeSpread = function | Some expr -> Doc.concat [ - comma_before_spread; + commaBeforeSpread; Doc.dotdotdot; - (let doc = print_expression_with_comments ~state expr cmt_tbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc); ] | None -> Doc.nil in - let make_sub_list_doc (expressions, spread) = - let comma_before_spread = + let makeSubListDoc (expressions, spread) = + let commaBeforeSpread = match expressions with | [] -> Doc.nil | _ -> Doc.concat [Doc.text ","; Doc.line] in - let spread_doc = make_spread_doc comma_before_spread spread in + let spreadDoc = makeSpreadDoc commaBeforeSpread spread in Doc.concat [ Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> - let doc = print_expression_with_comments ~state expr cmt_tbl in + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc) expressions); - spread_doc; + spreadDoc; ] in Doc.group @@ -3966,47 +3934,44 @@ and print_belt_list_concat_apply ~state sub_lists cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map make_sub_list_doc - (List.map ParsetreeViewer.collect_list_expressions - sub_lists)); + (List.map makeSubListDoc + (List.map ParsetreeViewer.collectListExpressions subLists)); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rbrace; ]) (* callExpr(arg1, arg2) *) -and print_pexp_apply ~state expr cmt_tbl = +and printPexpApply ~state expr cmtTbl = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}}, - [(Nolabel, parent_expr); (Nolabel, member_expr)] ) -> - let parent_doc = - let doc = print_expression_with_comments ~state parent_expr cmt_tbl in - match Parens.unary_expr_operand parent_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc parent_expr braces + [(Nolabel, parentExpr); (Nolabel, memberExpr)] ) -> + let parentDoc = + let doc = printExpressionWithComments ~state parentExpr cmtTbl in + match Parens.unaryExprOperand parentExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc parentExpr braces | Nothing -> doc in let member = - let member_doc = - match member_expr.pexp_desc with + let memberDoc = + match memberExpr.pexp_desc with | Pexp_ident lident -> - print_comments - (print_longident lident.txt) - cmt_tbl member_expr.pexp_loc - | _ -> print_expression_with_comments ~state member_expr cmt_tbl + printComments (printLongident lident.txt) cmtTbl memberExpr.pexp_loc + | _ -> printExpressionWithComments ~state memberExpr cmtTbl in - Doc.concat [Doc.text "\""; member_doc; Doc.text "\""] + Doc.concat [Doc.text "\""; memberDoc; Doc.text "\""] in Doc.group (Doc.concat [ - print_attributes ~state expr.pexp_attributes cmt_tbl; - parent_doc; + printAttributes ~state expr.pexp_attributes cmtTbl; + parentDoc; Doc.lbracket; member; Doc.rbracket; @@ -4014,181 +3979,180 @@ and print_pexp_apply ~state expr cmt_tbl = | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> ( - let rhs_doc = - let doc = print_expression_with_comments ~state rhs cmt_tbl in + let rhsDoc = + let doc = printExpressionWithComments ~state rhs cmtTbl in match Parens.expr rhs with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc rhs braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc rhs braces | Nothing -> doc in (* TODO: unify indentation of "=" *) - let should_indent = - (not (ParsetreeViewer.is_braced_expr rhs)) - && ParsetreeViewer.is_binary_expression rhs + let shouldIndent = + (not (ParsetreeViewer.isBracedExpr rhs)) + && ParsetreeViewer.isBinaryExpression rhs in let doc = Doc.group (Doc.concat [ - print_expression_with_comments ~state lhs cmt_tbl; + printExpressionWithComments ~state lhs cmtTbl; Doc.text " ="; - (if should_indent then - Doc.group (Doc.indent (Doc.concat [Doc.line; rhs_doc])) - else Doc.concat [Doc.space; rhs_doc]); + (if shouldIndent then + Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc])) + else Doc.concat [Doc.space; rhsDoc]); ]) in match expr.pexp_attributes with | [] -> doc - | attrs -> - Doc.group (Doc.concat [print_attributes ~state attrs cmt_tbl; doc])) + | attrs -> Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) + ) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}}, - [(Nolabel, parent_expr); (Nolabel, member_expr)] ) - when not (ParsetreeViewer.is_rewritten_underscore_apply_sugar parent_expr) - -> + [(Nolabel, parentExpr); (Nolabel, memberExpr)] ) + when not (ParsetreeViewer.isRewrittenUnderscoreApplySugar parentExpr) -> (* Don't print the Array.get(_, 0) sugar a.k.a. (__x) => Array.get(__x, 0) as _[0] *) let member = - let member_doc = - let doc = print_expression_with_comments ~state member_expr cmt_tbl in - match Parens.expr member_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc member_expr braces + let memberDoc = + let doc = printExpressionWithComments ~state memberExpr cmtTbl in + match Parens.expr memberExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc memberExpr braces | Nothing -> doc in - let should_inline = - match member_expr.pexp_desc with + let shouldInline = + match memberExpr.pexp_desc with | Pexp_constant _ | Pexp_ident _ -> true | _ -> false in - if should_inline then member_doc + if shouldInline then memberDoc else Doc.concat - [Doc.indent (Doc.concat [Doc.soft_line; member_doc]); Doc.soft_line] + [Doc.indent (Doc.concat [Doc.softLine; memberDoc]); Doc.softLine] in - let parent_doc = - let doc = print_expression_with_comments ~state parent_expr cmt_tbl in - match Parens.unary_expr_operand parent_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc parent_expr braces + let parentDoc = + let doc = printExpressionWithComments ~state parentExpr cmtTbl in + match Parens.unaryExprOperand parentExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc parentExpr braces | Nothing -> doc in Doc.group (Doc.concat [ - print_attributes ~state expr.pexp_attributes cmt_tbl; - parent_doc; + printAttributes ~state expr.pexp_attributes cmtTbl; + parentDoc; Doc.lbracket; member; Doc.rbracket; ]) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "set")}}, - [(Nolabel, parent_expr); (Nolabel, member_expr); (Nolabel, target_expr)] - ) -> + [(Nolabel, parentExpr); (Nolabel, memberExpr); (Nolabel, targetExpr)] ) + -> let member = - let member_doc = - let doc = print_expression_with_comments ~state member_expr cmt_tbl in - match Parens.expr member_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc member_expr braces + let memberDoc = + let doc = printExpressionWithComments ~state memberExpr cmtTbl in + match Parens.expr memberExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc memberExpr braces | Nothing -> doc in - let should_inline = - match member_expr.pexp_desc with + let shouldInline = + match memberExpr.pexp_desc with | Pexp_constant _ | Pexp_ident _ -> true | _ -> false in - if should_inline then member_doc + if shouldInline then memberDoc else Doc.concat - [Doc.indent (Doc.concat [Doc.soft_line; member_doc]); Doc.soft_line] + [Doc.indent (Doc.concat [Doc.softLine; memberDoc]); Doc.softLine] in - let should_indent_target_expr = - if ParsetreeViewer.is_braced_expr target_expr then false + let shouldIndentTargetExpr = + if ParsetreeViewer.isBracedExpr targetExpr then false else - ParsetreeViewer.is_binary_expression target_expr + ParsetreeViewer.isBinaryExpression targetExpr || - match target_expr with + match targetExpr with | { pexp_attributes = [({Location.txt = "res.ternary"}, _)]; - pexp_desc = Pexp_ifthenelse (if_expr, _, _); + pexp_desc = Pexp_ifthenelse (ifExpr, _, _); } -> - ParsetreeViewer.is_binary_expression if_expr - || ParsetreeViewer.has_attributes if_expr.pexp_attributes + ParsetreeViewer.isBinaryExpression ifExpr + || ParsetreeViewer.hasAttributes ifExpr.pexp_attributes | {pexp_desc = Pexp_newtype _} -> false | e -> - ParsetreeViewer.has_attributes e.pexp_attributes - || ParsetreeViewer.is_array_access e + ParsetreeViewer.hasAttributes e.pexp_attributes + || ParsetreeViewer.isArrayAccess e in - let target_expr = - let doc = print_expression_with_comments ~state target_expr cmt_tbl in - match Parens.expr target_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc target_expr braces + let targetExpr = + let doc = printExpressionWithComments ~state targetExpr cmtTbl in + match Parens.expr targetExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc targetExpr braces | Nothing -> doc in - let parent_doc = - let doc = print_expression_with_comments ~state parent_expr cmt_tbl in - match Parens.unary_expr_operand parent_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc parent_expr braces + let parentDoc = + let doc = printExpressionWithComments ~state parentExpr cmtTbl in + match Parens.unaryExprOperand parentExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc parentExpr braces | Nothing -> doc in Doc.group (Doc.concat [ - print_attributes ~state expr.pexp_attributes cmt_tbl; - parent_doc; + printAttributes ~state expr.pexp_attributes cmtTbl; + parentDoc; Doc.lbracket; member; Doc.rbracket; Doc.text " ="; - (if should_indent_target_expr then - Doc.indent (Doc.concat [Doc.line; target_expr]) - else Doc.concat [Doc.space; target_expr]); + (if shouldIndentTargetExpr then + Doc.indent (Doc.concat [Doc.line; targetExpr]) + else Doc.concat [Doc.space; targetExpr]); ]) (* TODO: cleanup, are those branches even remotely performant? *) | Pexp_apply ({pexp_desc = Pexp_ident lident}, args) - when ParsetreeViewer.is_jsx_expression expr -> - print_jsx_expression ~state lident args cmt_tbl - | Pexp_apply (call_expr, args) -> + when ParsetreeViewer.isJsxExpression expr -> + printJsxExpression ~state lident args cmtTbl + | Pexp_apply (callExpr, args) -> let args = List.map - (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewrite_underscore_apply arg)) + (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewriteUnderscoreApply arg)) args in let uncurried, attrs = - ParsetreeViewer.process_uncurried_app_attribute expr.pexp_attributes + ParsetreeViewer.processUncurriedAppAttribute expr.pexp_attributes in - let partial, attrs = ParsetreeViewer.process_partial_app_attribute attrs in + let partial, attrs = ParsetreeViewer.processPartialAppAttribute attrs in let args = if partial then - let dummy = Ast_helper.Exp.constant (Ast_helper.Const.int 0) in + let loc = + {Asttypes.txt = "res.partial"; Asttypes.loc = expr.pexp_loc} + in + let attr = (loc, Parsetree.PTyp (Ast_helper.Typ.any ())) in + let dummy = + Ast_helper.Exp.constant ~attrs:[attr] (Ast_helper.Const.int 0) + in args @ [(Asttypes.Labelled "...", dummy)] else args in - let dotted = - state.uncurried_config |> Res_uncurried.get_dotted ~uncurried - in - let call_expr_doc = - let doc = print_expression_with_comments ~state call_expr cmt_tbl in - match Parens.call_expr call_expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc call_expr braces + let dotted = state.uncurried_config |> Res_uncurried.getDotted ~uncurried in + let callExprDoc = + let doc = printExpressionWithComments ~state callExpr cmtTbl in + match Parens.callExpr callExpr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc callExpr braces | Nothing -> doc in - if ParsetreeViewer.requires_special_callback_printing_first_arg args then - let args_doc = - print_arguments_with_callback_in_first_position ~dotted ~state args - cmt_tbl + if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then + let argsDoc = + printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl in - Doc.concat - [print_attributes ~state attrs cmt_tbl; call_expr_doc; args_doc] - else if ParsetreeViewer.requires_special_callback_printing_last_arg args - then - let args_doc = - print_arguments_with_callback_in_last_position ~state ~dotted args - cmt_tbl + Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] + else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then + let argsDoc = + printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -4204,27 +4168,26 @@ and print_pexp_apply ~state expr cmt_tbl = * https://github.com/rescript-lang/syntax/issues/111 * https://github.com/rescript-lang/syntax/issues/166 *) - let maybe_break_parent = - if Doc.will_break args_doc then Doc.break_parent else Doc.nil + let maybeBreakParent = + if Doc.willBreak argsDoc then Doc.breakParent else Doc.nil in Doc.concat [ - maybe_break_parent; - print_attributes ~state attrs cmt_tbl; - call_expr_doc; - args_doc; + maybeBreakParent; + printAttributes ~state attrs cmtTbl; + callExprDoc; + argsDoc; ] else - let args_doc = print_arguments ~state ~dotted ~partial args cmt_tbl in - Doc.concat - [print_attributes ~state attrs cmt_tbl; call_expr_doc; args_doc] + let argsDoc = printArguments ~state ~dotted ~partial args cmtTbl in + Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] | _ -> assert false -and print_jsx_expression ~state lident args cmt_tbl = - let name = print_jsx_name lident in - let formatted_props, children = print_jsx_props ~state args cmt_tbl in +and printJsxExpression ~state lident args cmtTbl = + let name = printJsxName lident in + let formattedProps, children = printJsxProps ~state args cmtTbl in (*
*) - let has_children = + let hasChildren = match children with | Some { @@ -4235,7 +4198,7 @@ and print_jsx_expression ~state lident args cmt_tbl = | None -> false | _ -> true in - let is_self_closing = + let isSelfClosing = match children with | Some { @@ -4243,15 +4206,14 @@ and print_jsx_expression ~state lident args cmt_tbl = Pexp_construct ({txt = Longident.Lident "[]"}, None); pexp_loc = loc; } -> - not (has_comments_inside cmt_tbl loc) + not (hasCommentsInside cmtTbl loc) | _ -> false in - let print_children children = - let line_sep = + let printChildren children = + let lineSep = match children with | Some expr -> - if has_nested_jsx_or_more_than_one_child expr then Doc.hard_line - else Doc.line + if hasNestedJsxOrMoreThanOneChild expr then Doc.hardLine else Doc.line | None -> Doc.line in Doc.concat @@ -4261,12 +4223,11 @@ and print_jsx_expression ~state lident args cmt_tbl = [ Doc.line; (match children with - | Some children_expression -> - print_jsx_children ~state children_expression ~sep:line_sep - cmt_tbl + | Some childrenExpression -> + printJsxChildren ~state childrenExpression ~sep:lineSep cmtTbl | None -> Doc.nil); ]); - line_sep; + lineSep; ] in Doc.group @@ -4275,17 +4236,17 @@ and print_jsx_expression ~state lident args cmt_tbl = Doc.group (Doc.concat [ - print_comments - (Doc.concat [Doc.less_than; name]) - cmt_tbl lident.Asttypes.loc; - formatted_props; + printComments + (Doc.concat [Doc.lessThan; name]) + cmtTbl lident.Asttypes.loc; + formattedProps; (match children with | Some { Parsetree.pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, None); } - when is_self_closing -> + when isSelfClosing -> Doc.text "/>" | _ -> (* if tag A has trailing comments then put > on the next line @@ -4294,15 +4255,15 @@ and print_jsx_expression ~state lident args cmt_tbl = > *) - if has_trailing_comments cmt_tbl lident.Asttypes.loc then - Doc.concat [Doc.soft_line; Doc.greater_than] - else Doc.greater_than); + if hasTrailingComments cmtTbl lident.Asttypes.loc then + Doc.concat [Doc.softLine; Doc.greaterThan] + else Doc.greaterThan); ]); - (if is_self_closing then Doc.nil + (if isSelfClosing then Doc.nil else Doc.concat [ - (if has_children then print_children children + (if hasChildren then printChildren children else match children with | Some @@ -4311,20 +4272,19 @@ and print_jsx_expression ~state lident args cmt_tbl = Pexp_construct ({txt = Longident.Lident "[]"}, None); pexp_loc = loc; } -> - print_comments_inside cmt_tbl loc + printCommentsInside cmtTbl loc | _ -> Doc.nil); Doc.text "" in let closing = Doc.text "" in - let line_sep = - if has_nested_jsx_or_more_than_one_child expr then Doc.hard_line - else Doc.line + let lineSep = + if hasNestedJsxOrMoreThanOneChild expr then Doc.hardLine else Doc.line in Doc.group (Doc.concat @@ -4335,65 +4295,57 @@ and print_jsx_fragment ~state expr cmt_tbl = | _ -> Doc.indent (Doc.concat - [Doc.line; print_jsx_children ~state expr ~sep:line_sep cmt_tbl])); - line_sep; + [Doc.line; printJsxChildren ~state expr ~sep:lineSep cmtTbl])); + lineSep; closing; ]) -and print_jsx_children ~state (children_expr : Parsetree.expression) ~sep - cmt_tbl = - match children_expr.pexp_desc with +and printJsxChildren ~state (childrenExpr : Parsetree.expression) ~sep cmtTbl = + match childrenExpr.pexp_desc with | Pexp_construct ({txt = Longident.Lident "::"}, _) -> - let children, _ = ParsetreeViewer.collect_list_expressions children_expr in + let children, _ = ParsetreeViewer.collectListExpressions childrenExpr in Doc.group (Doc.join ~sep (List.map (fun (expr : Parsetree.expression) -> - let leading_line_comment_present = - has_leading_line_comment cmt_tbl expr.pexp_loc - in - let expr_doc = - print_expression_with_comments ~state expr cmt_tbl + let leadingLineCommentPresent = + hasLeadingLineComment cmtTbl expr.pexp_loc in - let add_parens_or_braces expr_doc = + let exprDoc = printExpressionWithComments ~state expr cmtTbl in + let addParensOrBraces exprDoc = (* {(20: int)} make sure that we also protect the expression inside *) - let inner_doc = - if Parens.braced_expr expr then add_parens expr_doc - else expr_doc + let innerDoc = + if Parens.bracedExpr expr then addParens exprDoc else exprDoc in - if leading_line_comment_present then add_braces inner_doc - else Doc.concat [Doc.lbrace; inner_doc; Doc.rbrace] + if leadingLineCommentPresent then addBraces innerDoc + else Doc.concat [Doc.lbrace; innerDoc; Doc.rbrace] in - match Parens.jsx_child_expr expr with - | Nothing -> expr_doc - | Parenthesized -> add_parens_or_braces expr_doc - | Braced braces_loc -> - print_comments - (add_parens_or_braces expr_doc) - cmt_tbl braces_loc) + match Parens.jsxChildExpr expr with + | Nothing -> exprDoc + | Parenthesized -> addParensOrBraces exprDoc + | Braced bracesLoc -> + printComments (addParensOrBraces exprDoc) cmtTbl bracesLoc) children)) | _ -> - let leading_line_comment_present = - has_leading_line_comment cmt_tbl children_expr.pexp_loc - in - let expr_doc = - print_expression_with_comments ~state children_expr cmt_tbl + let leadingLineCommentPresent = + hasLeadingLineComment cmtTbl childrenExpr.pexp_loc in + let exprDoc = printExpressionWithComments ~state childrenExpr cmtTbl in Doc.concat [ Doc.dotdotdot; - (match Parens.jsx_child_expr children_expr with + (match Parens.jsxChildExpr childrenExpr with | Parenthesized | Braced _ -> - let inner_doc = - if Parens.braced_expr children_expr then add_parens expr_doc - else expr_doc + let innerDoc = + if Parens.bracedExpr childrenExpr then addParens exprDoc + else exprDoc in - if leading_line_comment_present then add_braces inner_doc - else Doc.concat [Doc.lbrace; inner_doc; Doc.rbrace] - | Nothing -> expr_doc); + if leadingLineCommentPresent then addBraces innerDoc + else Doc.concat [Doc.lbrace; innerDoc; Doc.rbrace] + | Nothing -> exprDoc); ] -and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option = +and printJsxProps ~state args cmtTbl : Doc.t * Parsetree.expression option = (* This function was introduced because we have different formatting behavior for self-closing tags and other tags we always put /> on a new line for self-closing tag when it breaks we should remove this function once the format is unified *) - let is_self_closing children = + let isSelfClosing children = match children with | { Parsetree.pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, None); pexp_loc = loc; } -> - not (has_comments_inside cmt_tbl loc) + not (hasCommentsInside cmtTbl loc) | _ -> false in let rec loop props args = @@ -4426,9 +4378,9 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option = Pexp_construct ({txt = Longident.Lident "()"}, None); } ); ] -> - let doc = if is_self_closing children then Doc.line else Doc.nil in + let doc = if isSelfClosing children then Doc.line else Doc.nil in (doc, Some children) - | ((_, expr) as last_prop) + | ((_, expr) as lastProp) :: [ (Asttypes.Labelled "children", children); ( Asttypes.Nolabel, @@ -4443,9 +4395,9 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option = {loc with loc_end = expr.pexp_loc.loc_end} | _ -> 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 - let formatted_props = + let trailingCommentsPresent = hasTrailingComments cmtTbl loc in + let propDoc = printJsxProp ~state lastProp cmtTbl in + let formattedProps = Doc.concat [ Doc.indent @@ -4453,137 +4405,131 @@ and print_jsx_props ~state args cmt_tbl : Doc.t * Parsetree.expression option = [ Doc.line; Doc.group - (Doc.join ~sep:Doc.line (prop_doc :: props |> List.rev)); + (Doc.join ~sep:Doc.line (propDoc :: props |> List.rev)); ]); (* print > on new line if the last prop has trailing comments *) - (match (is_self_closing children, trailing_comments_present) with + (match (isSelfClosing children, trailingCommentsPresent) with (* we always put /> on a new line when a self-closing tag breaks *) | true, _ -> Doc.line - | false, true -> Doc.soft_line + | false, true -> Doc.softLine | false, false -> Doc.nil); ] in - (formatted_props, Some children) + (formattedProps, Some children) | arg :: args -> - let prop_doc = print_jsx_prop ~state arg cmt_tbl in - loop (prop_doc :: props) args + let propDoc = printJsxProp ~state arg cmtTbl in + loop (propDoc :: props) args in loop [] args -and print_jsx_prop ~state arg cmt_tbl = +and printJsxProp ~state arg cmtTbl = match arg with - | ( ((Asttypes.Labelled lbl_txt | Optional lbl_txt) as lbl), + | ( ((Asttypes.Labelled lblTxt | Optional lblTxt) as lbl), { Parsetree.pexp_attributes = - [({Location.txt = "res.namedArgLoc"; loc = arg_loc}, _)]; + [({Location.txt = "res.namedArgLoc"; loc = argLoc}, _)]; pexp_desc = Pexp_ident {txt = Longident.Lident ident}; } ) - when lbl_txt = ident (* jsx punning *) -> ( + when lblTxt = ident (* jsx punning *) -> ( match lbl with | Nolabel -> Doc.nil - | Labelled _lbl -> print_comments (print_ident_like ident) cmt_tbl arg_loc + | Labelled _lbl -> printComments (printIdentLike ident) cmtTbl argLoc | Optional _lbl -> - let doc = Doc.concat [Doc.question; print_ident_like ident] in - print_comments doc cmt_tbl arg_loc) - | ( ((Asttypes.Labelled lbl_txt | Optional lbl_txt) as lbl), + let doc = Doc.concat [Doc.question; printIdentLike ident] in + printComments doc cmtTbl argLoc) + | ( ((Asttypes.Labelled lblTxt | Optional lblTxt) as lbl), { Parsetree.pexp_attributes = []; pexp_desc = Pexp_ident {txt = Longident.Lident ident}; } ) - when lbl_txt = ident (* jsx punning when printing from Reason *) -> ( + when lblTxt = ident (* jsx punning when printing from Reason *) -> ( match lbl with | Nolabel -> Doc.nil - | Labelled _lbl -> print_ident_like ident - | Optional _lbl -> Doc.concat [Doc.question; print_ident_like ident]) + | Labelled _lbl -> printIdentLike ident + | Optional _lbl -> Doc.concat [Doc.question; printIdentLike ident]) | Asttypes.Labelled "_spreadProps", expr -> - let doc = print_expression_with_comments ~state expr cmt_tbl in + let doc = printExpressionWithComments ~state expr cmtTbl in Doc.concat [Doc.lbrace; Doc.dotdotdot; doc; Doc.rbrace] | lbl, expr -> - let arg_loc, expr = + let argLoc, expr = match expr.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: attrs -> (loc, {expr with pexp_attributes = attrs}) | _ -> (Location.none, expr) in - let lbl_doc = + let lblDoc = match lbl with | Asttypes.Labelled lbl -> - let lbl = print_comments (print_ident_like lbl) cmt_tbl arg_loc in + let lbl = printComments (printIdentLike lbl) cmtTbl argLoc in Doc.concat [lbl; Doc.equal] | Asttypes.Optional lbl -> - let lbl = print_comments (print_ident_like lbl) cmt_tbl arg_loc in + let lbl = printComments (printIdentLike lbl) cmtTbl argLoc in Doc.concat [lbl; Doc.equal; Doc.question] | Nolabel -> Doc.nil in - let expr_doc = - let leading_line_comment_present = - has_leading_line_comment cmt_tbl expr.pexp_loc + let exprDoc = + let leadingLineCommentPresent = + hasLeadingLineComment cmtTbl expr.pexp_loc in - let doc = print_expression_with_comments ~state expr cmt_tbl in - match Parens.jsx_prop_expr expr with + let doc = printExpressionWithComments ~state expr cmtTbl in + match Parens.jsxPropExpr expr with | Parenthesized | Braced _ -> (* {(20: int)} make sure that we also protect the expression inside *) - let inner_doc = - if Parens.braced_expr expr then add_parens doc else doc - in - if leading_line_comment_present then add_braces inner_doc - else Doc.concat [Doc.lbrace; inner_doc; Doc.rbrace] + let innerDoc = if Parens.bracedExpr expr then addParens doc else doc in + if leadingLineCommentPresent then addBraces innerDoc + else Doc.concat [Doc.lbrace; innerDoc; Doc.rbrace] | _ -> doc in - let full_loc = {arg_loc with loc_end = expr.pexp_loc.loc_end} in - print_comments (Doc.concat [lbl_doc; expr_doc]) cmt_tbl full_loc + let fullLoc = {argLoc with loc_end = expr.pexp_loc.loc_end} in + printComments (Doc.concat [lblDoc; exprDoc]) cmtTbl fullLoc (* div -> div. * Navabar.createElement -> Navbar * Staff.Users.createElement -> Staff.Users *) -and print_jsx_name {txt = lident} = - let print_ident = print_ident_like ~allow_uident:true ~allow_hyphen:true in +and printJsxName {txt = lident} = + let printIdent = printIdentLike ~allowUident:true ~allowHyphen:true in let rec flatten acc lident = match lident with - | Longident.Lident txt -> print_ident txt :: acc + | Longident.Lident txt -> printIdent txt :: acc | Ldot (lident, "createElement") -> flatten acc lident - | Ldot (lident, txt) -> flatten (print_ident txt :: acc) lident + | Ldot (lident, txt) -> flatten (printIdent txt :: acc) lident | _ -> acc in match lident with - | Longident.Lident txt -> print_ident txt + | Longident.Lident txt -> printIdent txt | _ as lident -> let segments = flatten [] lident in Doc.join ~sep:Doc.dot segments -and print_arguments_with_callback_in_first_position ~dotted ~state args cmt_tbl - = +and printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) - let state = State.next_custom_layout state in - let cmt_tbl_copy = CommentTable.copy cmt_tbl in - let callback, printed_args = + let state = State.nextCustomLayout state in + let cmtTblCopy = CommentTable.copy cmtTbl in + let callback, printedArgs = match args with | (lbl, expr) :: args -> - let lbl_doc = + let lblDoc = match lbl with | Asttypes.Nolabel -> Doc.nil | Asttypes.Labelled txt -> - Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal] + Doc.concat [Doc.tilde; printIdentLike txt; Doc.equal] | Asttypes.Optional txt -> - Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal; Doc.question] + Doc.concat [Doc.tilde; printIdentLike txt; Doc.equal; Doc.question] in let callback = Doc.concat - [ - lbl_doc; - print_pexp_fun ~state ~in_callback:FitsOnOneLine expr cmt_tbl; - ] + [lblDoc; printPexpFun ~state ~inCallback:FitsOnOneLine expr cmtTbl] in - let callback = lazy (print_comments callback cmt_tbl expr.pexp_loc) in - let printed_args = + let callback = lazy (printComments callback cmtTbl expr.pexp_loc) in + let printedArgs = lazy (Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map (fun arg -> print_argument ~state arg cmt_tbl) args)) + (List.map (fun arg -> printArgument ~state arg cmtTbl) args)) in - (callback, printed_args) + (callback, printedArgs) | _ -> assert false in @@ -4592,7 +4538,7 @@ and print_arguments_with_callback_in_first_position ~dotted ~state args cmt_tbl * MyModuleBlah.toList(argument) * }, longArgumet, veryLooooongArgument) *) - let fits_on_one_line = + let fitsOnOneLine = lazy (Doc.concat [ @@ -4600,7 +4546,7 @@ and print_arguments_with_callback_in_first_position ~dotted ~state args cmt_tbl Lazy.force callback; Doc.comma; Doc.line; - Lazy.force printed_args; + Lazy.force printedArgs; Doc.rparen; ]) in @@ -4612,9 +4558,7 @@ and print_arguments_with_callback_in_first_position ~dotted ~state args cmt_tbl * arg3, * ) *) - let break_all_args = - lazy (print_arguments ~state ~dotted args cmt_tbl_copy) - in + let breakAllArgs = lazy (printArguments ~state ~dotted args cmtTblCopy) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -4631,64 +4575,62 @@ and print_arguments_with_callback_in_first_position ~dotted ~state args cmt_tbl * In this case, we always want the arguments broken over multiple lines, * like a normal function call. *) - if state |> State.should_break_callback then Lazy.force break_all_args - else if Doc.will_break (Lazy.force printed_args) then - Lazy.force break_all_args - else - Doc.custom_layout [Lazy.force fits_on_one_line; Lazy.force break_all_args] + if state |> State.shouldBreakCallback then Lazy.force breakAllArgs + else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs + else Doc.customLayout [Lazy.force fitsOnOneLine; Lazy.force breakAllArgs] -and print_arguments_with_callback_in_last_position ~state ~dotted args cmt_tbl = +and printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. * consumed comments need to be marked not-consumed and reprinted… * Cheng's different comment algorithm will solve this. *) - let state = state |> State.next_custom_layout in - let cmt_tbl_copy = CommentTable.copy cmt_tbl in - let cmt_tbl_copy2 = CommentTable.copy cmt_tbl in + let state = state |> State.nextCustomLayout in + let cmtTblCopy = CommentTable.copy cmtTbl in + let cmtTblCopy2 = CommentTable.copy cmtTbl in let rec loop acc args = match args with | [] -> (lazy Doc.nil, lazy Doc.nil, lazy Doc.nil) | [(lbl, expr)] -> - let lbl_doc = + let lblDoc = match lbl with | Asttypes.Nolabel -> Doc.nil | Asttypes.Labelled txt -> - Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal] + Doc.concat [Doc.tilde; printIdentLike txt; Doc.equal] | Asttypes.Optional txt -> - Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal; Doc.question] + Doc.concat [Doc.tilde; printIdentLike txt; Doc.equal; Doc.question] in - let callback_fits_on_one_line = + let callbackFitsOnOneLine = lazy - (let pexp_fun_doc = - print_pexp_fun ~state ~in_callback:FitsOnOneLine expr cmt_tbl + (let pexpFunDoc = + printPexpFun ~state ~inCallback:FitsOnOneLine expr cmtTbl in - let doc = Doc.concat [lbl_doc; pexp_fun_doc] in - print_comments doc cmt_tbl expr.pexp_loc) + let doc = Doc.concat [lblDoc; pexpFunDoc] in + printComments doc cmtTbl expr.pexp_loc) in - let callback_arguments_fits_on_one_line = + let callbackArgumentsFitsOnOneLine = lazy - (let pexp_fun_doc = - print_pexp_fun ~state ~in_callback:ArgumentsFitOnOneLine expr - cmt_tbl_copy + (let pexpFunDoc = + printPexpFun ~state ~inCallback:ArgumentsFitOnOneLine expr + cmtTblCopy in - let doc = Doc.concat [lbl_doc; pexp_fun_doc] in - print_comments doc cmt_tbl_copy expr.pexp_loc) + let doc = Doc.concat [lblDoc; pexpFunDoc] in + printComments doc cmtTblCopy expr.pexp_loc) in ( lazy (Doc.concat (List.rev acc)), - callback_fits_on_one_line, - callback_arguments_fits_on_one_line ) + callbackFitsOnOneLine, + callbackArgumentsFitsOnOneLine ) | arg :: args -> - let arg_doc = print_argument ~state arg cmt_tbl in - loop (Doc.line :: Doc.comma :: arg_doc :: acc) args + let argDoc = printArgument ~state arg cmtTbl in + loop (Doc.line :: Doc.comma :: argDoc :: acc) args in - let printed_args, callback, callback2 = loop [] args in + let printedArgs, callback, callback2 = loop [] args in (* Thing.map(foo, (arg1, arg2) => MyModuleBlah.toList(argument)) *) - let fits_on_one_line = + let fitsOnOneLine = lazy (Doc.concat [ (if dotted then Doc.text "(." else Doc.lparen); - Lazy.force printed_args; + Lazy.force printedArgs; Lazy.force callback; Doc.rparen; ]) @@ -4698,13 +4640,13 @@ and print_arguments_with_callback_in_last_position ~state ~dotted args cmt_tbl = * MyModuleBlah.toList(argument) * ) *) - let arugments_fit_on_one_line = + let arugmentsFitOnOneLine = lazy (Doc.concat [ (if dotted then Doc.text "(." else Doc.lparen); - Lazy.force printed_args; - Doc.breakable_group ~force_break:true (Lazy.force callback2); + Lazy.force printedArgs; + Doc.breakableGroup ~forceBreak:true (Lazy.force callback2); Doc.rparen; ]) in @@ -4716,9 +4658,7 @@ and print_arguments_with_callback_in_last_position ~state ~dotted args cmt_tbl = * (param1, parm2) => doStuff(param1, parm2) * ) *) - let break_all_args = - lazy (print_arguments ~state ~dotted args cmt_tbl_copy2) - in + let breakAllArgs = lazy (printArguments ~state ~dotted args cmtTblCopy2) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -4735,19 +4675,18 @@ and print_arguments_with_callback_in_last_position ~state ~dotted args cmt_tbl = * In this case, we always want the arguments broken over multiple lines, * like a normal function call. *) - if state |> State.should_break_callback then Lazy.force break_all_args - else if Doc.will_break (Lazy.force printed_args) then - Lazy.force break_all_args + if state |> State.shouldBreakCallback then Lazy.force breakAllArgs + else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs else - Doc.custom_layout + Doc.customLayout [ - Lazy.force fits_on_one_line; - Lazy.force arugments_fit_on_one_line; - Lazy.force break_all_args; + Lazy.force fitsOnOneLine; + Lazy.force arugmentsFitOnOneLine; + Lazy.force breakAllArgs; ] -and print_arguments ~state ~dotted ?(partial = false) - (args : (Asttypes.arg_label * Parsetree.expression) list) cmt_tbl = +and printArguments ~state ~dotted ?(partial = false) + (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl = match args with | [ ( Nolabel, @@ -4763,17 +4702,29 @@ and print_arguments ~state ~dotted ?(partial = false) | true, true -> Doc.text "(.)" (* arity zero *) | true, false -> Doc.text "(. ())" (* arity one *) | _ -> Doc.text "()") - | [(Nolabel, arg)] when ParsetreeViewer.is_huggable_expression arg -> - let arg_doc = - let doc = print_expression_with_comments ~state arg cmt_tbl in + | [(Nolabel, arg)] when ParsetreeViewer.isHuggableExpression arg -> + let argDoc = + let doc = printExpressionWithComments ~state arg cmtTbl in match Parens.expr arg with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc arg braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc arg braces | Nothing -> doc in Doc.concat - [(if dotted then Doc.text "(. " else Doc.lparen); arg_doc; Doc.rparen] + [(if dotted then Doc.text "(. " else Doc.lparen); argDoc; Doc.rparen] | args -> + (* Avoid printing trailing comma when there is ... in function application *) + let hasPartialAttr, printedArgs = + List.fold_right + (fun arg (flag, acc) -> + let _, expr = arg in + let hasPartialAttr = + ParsetreeViewer.hasPartialAttribute expr.Parsetree.pexp_attributes + in + let doc = printArgument ~state arg cmtTbl in + (flag || hasPartialAttr, doc :: acc)) + args (false, []) + in Doc.group (Doc.concat [ @@ -4781,15 +4732,11 @@ and print_arguments ~state ~dotted ?(partial = false) Doc.indent (Doc.concat [ - (if dotted then Doc.line else Doc.soft_line); - Doc.join - ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map - (fun arg -> print_argument ~state arg cmt_tbl) - args); + (if dotted then Doc.line else Doc.softLine); + Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) printedArgs; ]); - (if partial then Doc.nil else Doc.trailing_comma); - Doc.soft_line; + (if partial || hasPartialAttr then Doc.nil else Doc.trailingComma); + Doc.softLine; Doc.rparen; ]) @@ -4807,34 +4754,34 @@ and print_arguments ~state ~dotted ?(partial = false) * | ~ label-name = ? expr * | ~ label-name = ? _ (* syntax sugar *) * | ~ label-name = ? expr : type *) -and print_argument ~state (arg_lbl, arg) cmt_tbl = - match (arg_lbl, arg) with +and printArgument ~state (argLbl, arg) cmtTbl = + match (argLbl, arg) with (* ~a (punned)*) | ( Labelled lbl, ({ pexp_desc = Pexp_ident {txt = Longident.Lident name}; pexp_attributes = [] | [({Location.txt = "res.namedArgLoc"}, _)]; - } as arg_expr) ) - when lbl = name && not (ParsetreeViewer.is_braced_expr arg_expr) -> + } as argExpr) ) + when lbl = name && not (ParsetreeViewer.isBracedExpr argExpr) -> let loc = match arg.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _ -> loc | _ -> arg.pexp_loc in - let doc = Doc.concat [Doc.tilde; print_ident_like lbl] in - print_comments doc cmt_tbl loc + let doc = Doc.concat [Doc.tilde; printIdentLike lbl] in + printComments doc cmtTbl loc (* ~a: int (punned)*) | ( Labelled lbl, { pexp_desc = Pexp_constraint - ( ({pexp_desc = Pexp_ident {txt = Longident.Lident name}} as arg_expr), + ( ({pexp_desc = Pexp_ident {txt = Longident.Lident name}} as argExpr), typ ); pexp_loc; pexp_attributes = ([] | [({Location.txt = "res.namedArgLoc"}, _)]) as attrs; } ) - when lbl = name && not (ParsetreeViewer.is_braced_expr arg_expr) -> + when lbl = name && not (ParsetreeViewer.isBracedExpr argExpr) -> let loc = match attrs with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _ -> @@ -4845,12 +4792,12 @@ and print_argument ~state (arg_lbl, arg) cmt_tbl = Doc.concat [ Doc.tilde; - print_ident_like lbl; + printIdentLike lbl; Doc.text ": "; - print_typ_expr ~state typ cmt_tbl; + printTypExpr ~state typ cmtTbl; ] in - print_comments doc cmt_tbl loc + printComments doc cmtTbl loc (* ~a? (optional lbl punned)*) | ( Optional lbl, { @@ -4863,78 +4810,78 @@ and print_argument ~state (arg_lbl, arg) cmt_tbl = | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _ -> loc | _ -> arg.pexp_loc in - let doc = Doc.concat [Doc.tilde; print_ident_like lbl; Doc.question] in - print_comments doc cmt_tbl loc + let doc = Doc.concat [Doc.tilde; printIdentLike lbl; Doc.question] in + printComments doc cmtTbl loc | _lbl, expr -> - let arg_loc, expr = + let argLoc, expr = match expr.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: attrs -> (loc, {expr with pexp_attributes = attrs}) | _ -> (expr.pexp_loc, expr) in - let printed_lbl, dotdotdot = - match arg_lbl with + let printedLbl, dotdotdot = + match argLbl with | Nolabel -> (Doc.nil, false) | Labelled "..." -> let doc = Doc.text "..." in - (print_comments doc cmt_tbl arg_loc, true) + (printComments doc cmtTbl argLoc, true) | Labelled lbl -> - let doc = Doc.concat [Doc.tilde; print_ident_like lbl; Doc.equal] in - (print_comments doc cmt_tbl arg_loc, false) + let doc = Doc.concat [Doc.tilde; printIdentLike lbl; Doc.equal] in + (printComments doc cmtTbl argLoc, false) | Optional lbl -> let doc = - Doc.concat [Doc.tilde; print_ident_like lbl; Doc.equal; Doc.question] + Doc.concat [Doc.tilde; printIdentLike lbl; Doc.equal; Doc.question] in - (print_comments doc cmt_tbl arg_loc, false) + (printComments doc cmtTbl argLoc, false) in - let printed_expr = - let doc = print_expression_with_comments ~state expr cmt_tbl in + let printedExpr = + let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc in - let loc = {arg_loc with loc_end = expr.pexp_loc.loc_end} in + let loc = {argLoc with loc_end = expr.pexp_loc.loc_end} in let doc = - if dotdotdot then printed_lbl else Doc.concat [printed_lbl; printed_expr] + if dotdotdot then printedLbl else Doc.concat [printedLbl; printedExpr] in - print_comments doc cmt_tbl loc + printComments doc cmtTbl loc -and print_cases ~state (cases : Parsetree.case list) cmt_tbl = - Doc.breakable_group ~force_break:true +and printCases ~state (cases : Parsetree.case list) cmtTbl = + Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.lbrace; Doc.concat [ Doc.line; - print_list - ~get_loc:(fun n -> + printList + ~getLoc:(fun n -> { n.Parsetree.pc_lhs.ppat_loc with loc_end = - (match ParsetreeViewer.process_braces_attr n.pc_rhs with + (match ParsetreeViewer.processBracesAttr n.pc_rhs with | None, _ -> n.pc_rhs.pexp_loc.loc_end | Some ({loc}, _), _ -> loc.Location.loc_end); }) - ~print:(print_case ~state) ~nodes:cases cmt_tbl; + ~print:(printCase ~state) ~nodes:cases cmtTbl; ]; Doc.line; Doc.rbrace; ]) -and print_case ~state (case : Parsetree.case) cmt_tbl = +and printCase ~state (case : Parsetree.case) cmtTbl = let rhs = match case.pc_rhs.pexp_desc with | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ | Pexp_sequence _ -> - print_expression_block ~state - ~braces:(ParsetreeViewer.is_braced_expr case.pc_rhs) - case.pc_rhs cmt_tbl + printExpressionBlock ~state + ~braces:(ParsetreeViewer.isBracedExpr case.pc_rhs) + case.pc_rhs cmtTbl | _ -> ( - let doc = print_expression_with_comments ~state case.pc_rhs cmt_tbl in + let doc = printExpressionWithComments ~state case.pc_rhs cmtTbl in match Parens.expr case.pc_rhs with - | Parenthesized -> add_parens doc + | Parenthesized -> addParens doc | _ -> doc) in @@ -4947,44 +4894,43 @@ and print_case ~state (case : Parsetree.case) cmt_tbl = [ Doc.line; Doc.text "if "; - print_expression_with_comments ~state expr cmt_tbl; + printExpressionWithComments ~state expr cmtTbl; ]) in - let should_inline_rhs = + let shouldInlineRhs = match case.pc_rhs.pexp_desc with | Pexp_construct ({txt = Longident.Lident ("()" | "true" | "false")}, _) | Pexp_constant _ | Pexp_ident _ -> true - | _ when ParsetreeViewer.is_huggable_rhs case.pc_rhs -> true + | _ when ParsetreeViewer.isHuggableRhs case.pc_rhs -> true | _ -> false in - let should_indent_pattern = + let shouldIndentPattern = match case.pc_lhs.ppat_desc with | Ppat_or _ -> false | _ -> true in - let pattern_doc = - let doc = print_pattern ~state case.pc_lhs cmt_tbl in + let patternDoc = + let doc = printPattern ~state case.pc_lhs cmtTbl in match case.pc_lhs.ppat_desc with - | Ppat_constraint _ -> add_parens doc + | Ppat_constraint _ -> addParens doc | _ -> doc in let content = Doc.concat [ - (if should_indent_pattern then Doc.indent pattern_doc else pattern_doc); + (if shouldIndentPattern then Doc.indent patternDoc else patternDoc); Doc.indent guard; Doc.text " =>"; Doc.indent - (Doc.concat - [(if should_inline_rhs then Doc.space else Doc.line); rhs]); + (Doc.concat [(if shouldInlineRhs then Doc.space else Doc.line); rhs]); ] in Doc.group (Doc.concat [Doc.text "| "; content]) -and print_expr_fun_parameters ~state ~in_callback ~async ~uncurried - ~has_constraint parameters cmt_tbl = - let dotted = state.uncurried_config |> Res_uncurried.get_dotted ~uncurried in +and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint + parameters cmtTbl = + let dotted = state.uncurried_config |> Res_uncurried.getDotted ~uncurried in match parameters with (* let f = _ => () *) | [ @@ -4992,141 +4938,137 @@ and print_expr_fun_parameters ~state ~in_callback ~async ~uncurried { attrs = []; lbl = Asttypes.Nolabel; - default_expr = None; + defaultExpr = None; pat = {Parsetree.ppat_desc = Ppat_any; ppat_loc}; }; ] when not dotted -> let any = - let doc = if has_constraint then Doc.text "(_)" else Doc.text "_" in - print_comments doc cmt_tbl ppat_loc + let doc = if hasConstraint then Doc.text "(_)" else Doc.text "_" in + printComments doc cmtTbl ppat_loc in - if async then add_async any else any + if async then addAsync any else any (* let f = a => () *) | [ ParsetreeViewer.Parameter { attrs = []; lbl = Asttypes.Nolabel; - default_expr = None; + defaultExpr = None; pat = { - Parsetree.ppat_desc = Ppat_var string_loc; + Parsetree.ppat_desc = Ppat_var stringLoc; Parsetree.ppat_attributes = attrs; }; }; ] when not dotted -> - let txt_doc = - let var = print_ident_like string_loc.txt in + let txtDoc = + let var = printIdentLike stringLoc.txt in let var = match attrs with - | [] -> if has_constraint then add_parens var else var + | [] -> if hasConstraint then addParens var else var | attrs -> - let attrs = print_attributes ~state attrs cmt_tbl in - add_parens (Doc.concat [attrs; var]) + let attrs = printAttributes ~state attrs cmtTbl in + addParens (Doc.concat [attrs; var]) in - if async then add_async var else var + if async then addAsync var else var in - print_comments txt_doc cmt_tbl string_loc.loc + printComments txtDoc cmtTbl stringLoc.loc (* let f = () => () *) | [ ParsetreeViewer.Parameter { attrs = []; lbl = Asttypes.Nolabel; - default_expr = None; + defaultExpr = None; pat = {ppat_desc = Ppat_construct ({txt = Longident.Lident "()"; loc}, None)}; }; ] when not dotted -> let doc = - let lparen_rparen = Doc.text "()" in - if async then add_async lparen_rparen else lparen_rparen + let lparenRparen = Doc.text "()" in + if async then addAsync lparenRparen else lparenRparen in - print_comments doc cmt_tbl loc + printComments doc cmtTbl loc (* let f = (~greeting, ~from as hometown, ~x=?) => () *) | parameters -> - let in_callback = - match in_callback with + let inCallback = + match inCallback with | FitsOnOneLine -> true | _ -> false in - let maybe_async_lparen = + let maybeAsyncLparen = let lparen = if dotted then Doc.text "(. " else Doc.lparen in - if async then add_async lparen else lparen + if async then addAsync lparen else lparen in - let should_hug = ParsetreeViewer.parameters_should_hug parameters in - let printed_paramaters = + let shouldHug = ParsetreeViewer.parametersShouldHug parameters in + let printedParamaters = Doc.concat [ - (if should_hug || in_callback then Doc.nil else Doc.soft_line); + (if shouldHug || inCallback then Doc.nil else Doc.softLine); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun p -> print_exp_fun_parameter ~state p cmt_tbl) + (fun p -> printExpFunParameter ~state p cmtTbl) parameters); ] in Doc.group (Doc.concat [ - maybe_async_lparen; - (if should_hug || in_callback then printed_paramaters + maybeAsyncLparen; + (if shouldHug || inCallback then printedParamaters else Doc.concat - [ - Doc.indent printed_paramaters; - Doc.trailing_comma; - Doc.soft_line; - ]); + [Doc.indent printedParamaters; Doc.trailingComma; Doc.softLine]); Doc.rparen; ]) -and print_exp_fun_parameter ~state parameter cmt_tbl = +and printExpFunParameter ~state parameter cmtTbl = match parameter with | ParsetreeViewer.NewTypes {attrs; locs = lbls} -> Doc.group (Doc.concat [ - print_attributes ~state attrs cmt_tbl; + printAttributes ~state attrs cmtTbl; Doc.text "type "; (* XX *) Doc.join ~sep:Doc.space (List.map (fun lbl -> - print_comments - (print_ident_like lbl.Asttypes.txt) - cmt_tbl lbl.Asttypes.loc) + printComments + (printIdentLike lbl.Asttypes.txt) + cmtTbl lbl.Asttypes.loc) lbls); ]) - | Parameter {attrs; lbl; default_expr; pat = pattern} -> - let has_bs, attrs = ParsetreeViewer.process_bs_attribute attrs in - let dotted = if has_bs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in - let attrs = print_attributes ~state attrs cmt_tbl in + | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> + let hasBs, attrs = ParsetreeViewer.processBsAttribute attrs in + let dotted = if hasBs then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + let attrs = printAttributes ~state attrs cmtTbl in (* =defaultValue *) - let default_expr_doc = - match default_expr with + let defaultExprDoc = + match defaultExpr with | Some expr -> Doc.concat - [Doc.text "="; print_expression_with_comments ~state expr cmt_tbl] + [Doc.text "="; printExpressionWithComments ~state expr cmtTbl] | None -> Doc.nil in (* ~from as hometown * ~from -> punning *) - let label_with_pattern = + let labelWithPattern = match (lbl, pattern) with - | Asttypes.Nolabel, pattern -> print_pattern ~state pattern cmt_tbl + | Asttypes.Nolabel, pattern -> printPattern ~state pattern cmtTbl | ( (Asttypes.Labelled lbl | Optional lbl), - {ppat_desc = Ppat_var string_loc; ppat_attributes} ) - when lbl = string_loc.txt -> + {ppat_desc = Ppat_var stringLoc; ppat_attributes} ) + when lbl = stringLoc.txt -> (* ~d *) Doc.concat [ - print_attributes ~state ppat_attributes cmt_tbl; + printAttributes ~state ppat_attributes cmtTbl; Doc.text "~"; - print_ident_like lbl; + printIdentLike lbl; ] | ( (Asttypes.Labelled lbl | Optional lbl), { @@ -5137,24 +5079,24 @@ and print_exp_fun_parameter ~state parameter cmt_tbl = (* ~d: e *) Doc.concat [ - print_attributes ~state ppat_attributes cmt_tbl; + printAttributes ~state ppat_attributes cmtTbl; Doc.text "~"; - print_ident_like lbl; + printIdentLike lbl; Doc.text ": "; - print_typ_expr ~state typ cmt_tbl; + printTypExpr ~state typ cmtTbl; ] | (Asttypes.Labelled lbl | Optional lbl), pattern -> (* ~b as c *) Doc.concat [ Doc.text "~"; - print_ident_like lbl; + printIdentLike lbl; Doc.text " as "; - print_pattern ~state pattern cmt_tbl; + printPattern ~state pattern cmtTbl; ] in - let optional_label_suffix = - match (lbl, default_expr) with + let optionalLabelSuffix = + match (lbl, defaultExpr) with | Asttypes.Optional _, None -> Doc.text "=?" | _ -> Doc.nil in @@ -5162,125 +5104,117 @@ and print_exp_fun_parameter ~state parameter cmt_tbl = Doc.group (Doc.concat [ - dotted; - attrs; - label_with_pattern; - default_expr_doc; - optional_label_suffix; + dotted; attrs; labelWithPattern; defaultExprDoc; optionalLabelSuffix; ]) in - let cmt_loc = - match default_expr with + let cmtLoc = + match defaultExpr with | None -> ( match pattern.ppat_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _ -> {loc with loc_end = pattern.ppat_loc.loc_end} | _ -> pattern.ppat_loc) | Some expr -> - let start_pos = + let startPos = match pattern.ppat_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _ -> loc.loc_start | _ -> pattern.ppat_loc.loc_start in { pattern.ppat_loc with - loc_start = start_pos; + loc_start = startPos; loc_end = expr.pexp_loc.loc_end; } in - print_comments doc cmt_tbl cmt_loc + printComments doc cmtTbl cmtLoc -and print_expression_block ~state ~braces expr cmt_tbl = - let rec collect_rows acc expr = +and printExpressionBlock ~state ~braces expr cmtTbl = + let rec collectRows acc expr = match expr.Parsetree.pexp_desc with - | Parsetree.Pexp_letmodule (mod_name, mod_expr, expr2) -> + | Parsetree.Pexp_letmodule (modName, modExpr, expr2) -> let name = - let doc = Doc.text mod_name.txt in - print_comments doc cmt_tbl mod_name.loc + let doc = Doc.text modName.txt in + printComments doc cmtTbl modName.loc in - let name, mod_expr = - match mod_expr.pmod_desc with - | Pmod_constraint (mod_expr2, mod_type) - when not - (ParsetreeViewer.has_await_attribute mod_expr.pmod_attributes) + let name, modExpr = + match modExpr.pmod_desc with + | Pmod_constraint (modExpr2, modType) + when not (ParsetreeViewer.hasAwaitAttribute modExpr.pmod_attributes) -> let name = - Doc.concat - [name; Doc.text ": "; print_mod_type ~state mod_type cmt_tbl] + Doc.concat [name; Doc.text ": "; printModType ~state modType cmtTbl] in - (name, mod_expr2) - | _ -> (name, mod_expr) + (name, modExpr2) + | _ -> (name, modExpr) in - let let_module_doc = + let letModuleDoc = Doc.concat [ Doc.text "module "; name; Doc.text " = "; - print_mod_expr ~state mod_expr cmt_tbl; + printModExpr ~state modExpr cmtTbl; ] in - let loc = {expr.pexp_loc with loc_end = mod_expr.pmod_loc.loc_end} in - collect_rows ((loc, let_module_doc) :: acc) expr2 - | Pexp_letexception (extension_constructor, expr2) -> + let loc = {expr.pexp_loc with loc_end = modExpr.pmod_loc.loc_end} in + collectRows ((loc, letModuleDoc) :: acc) expr2 + | Pexp_letexception (extensionConstructor, expr2) -> let loc = let loc = - {expr.pexp_loc with loc_end = extension_constructor.pext_loc.loc_end} + {expr.pexp_loc with loc_end = extensionConstructor.pext_loc.loc_end} in - match get_first_leading_comment cmt_tbl loc with + match getFirstLeadingComment cmtTbl loc with | None -> loc | Some comment -> - let cmt_loc = Comment.loc comment in - {cmt_loc with loc_end = loc.loc_end} + let cmtLoc = Comment.loc comment in + {cmtLoc with loc_end = loc.loc_end} in - let let_exception_doc = - print_exception_def ~state extension_constructor cmt_tbl + let letExceptionDoc = + printExceptionDef ~state extensionConstructor cmtTbl in - collect_rows ((loc, let_exception_doc) :: acc) expr2 - | Pexp_open (override_flag, longident_loc, expr2) -> - let open_doc = + collectRows ((loc, letExceptionDoc) :: acc) expr2 + | Pexp_open (overrideFlag, longidentLoc, expr2) -> + let openDoc = Doc.concat [ Doc.text "open"; - print_override_flag override_flag; + printOverrideFlag overrideFlag; Doc.space; - print_longident_location longident_loc cmt_tbl; + printLongidentLocation longidentLoc cmtTbl; ] in - let loc = {expr.pexp_loc with loc_end = longident_loc.loc.loc_end} in - collect_rows ((loc, open_doc) :: acc) expr2 + let loc = {expr.pexp_loc with loc_end = longidentLoc.loc.loc_end} in + collectRows ((loc, openDoc) :: acc) expr2 | Pexp_sequence (expr1, expr2) -> - let expr_doc = - let doc = print_expression ~state expr1 cmt_tbl in + let exprDoc = + let doc = printExpression ~state expr1 cmtTbl in match Parens.expr expr1 with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr1 braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr1 braces | Nothing -> doc in let loc = expr1.pexp_loc in - collect_rows ((loc, expr_doc) :: acc) expr2 - | Pexp_let (rec_flag, value_bindings, expr2) -> ( + collectRows ((loc, exprDoc) :: acc) expr2 + | Pexp_let (recFlag, valueBindings, expr2) -> ( let loc = let loc = - match (value_bindings, List.rev value_bindings) with - | vb :: _, last_vb :: _ -> - {vb.pvb_loc with loc_end = last_vb.pvb_loc.loc_end} + match (valueBindings, List.rev valueBindings) with + | vb :: _, lastVb :: _ -> + {vb.pvb_loc with loc_end = lastVb.pvb_loc.loc_end} | _ -> Location.none in - match get_first_leading_comment cmt_tbl loc with + match getFirstLeadingComment cmtTbl loc with | None -> loc | Some comment -> - let cmt_loc = Comment.loc comment in - {cmt_loc with loc_end = loc.loc_end} + let cmtLoc = Comment.loc comment in + {cmtLoc with loc_end = loc.loc_end} in - let rec_flag = - match rec_flag with + let recFlag = + match recFlag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - let let_doc = - print_value_bindings ~state ~rec_flag value_bindings cmt_tbl - in + let letDoc = printValueBindings ~state ~recFlag valueBindings cmtTbl in (* let () = { * let () = foo() * () @@ -5289,25 +5223,25 @@ and print_expression_block ~state ~braces expr cmt_tbl = *) match expr2.pexp_desc with | Pexp_construct ({txt = Longident.Lident "()"}, _) -> - List.rev ((loc, let_doc) :: acc) - | _ -> collect_rows ((loc, let_doc) :: acc) expr2) + List.rev ((loc, letDoc) :: acc) + | _ -> collectRows ((loc, letDoc) :: acc) expr2) | _ -> - let expr_doc = - let doc = print_expression ~state expr cmt_tbl in + let exprDoc = + let doc = printExpression ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc in - List.rev ((expr.pexp_loc, expr_doc) :: acc) + List.rev ((expr.pexp_loc, exprDoc) :: acc) in - let rows = collect_rows [] expr in + let rows = collectRows [] expr in let block = - print_list ~get_loc:fst ~nodes:rows + printList ~getLoc:fst ~nodes:rows ~print:(fun (_, doc) _ -> doc) - ~force_break:true cmt_tbl + ~forceBreak:true cmtTbl in - Doc.breakable_group ~force_break:true + Doc.breakableGroup ~forceBreak:true (if braces then Doc.concat [ @@ -5335,10 +5269,10 @@ and print_expression_block ~state ~braces expr cmt_tbl = * a + b * } *) -and print_braces doc expr braces_loc = - let over_multiple_lines = +and printBraces doc expr bracesLoc = + let overMultipleLines = let open Location in - braces_loc.loc_end.pos_lnum > braces_loc.loc_start.pos_lnum + bracesLoc.loc_end.pos_lnum > bracesLoc.loc_start.pos_lnum in match expr.Parsetree.pexp_desc with | Pexp_letmodule _ | Pexp_letexception _ | Pexp_let _ | Pexp_open _ @@ -5346,80 +5280,80 @@ and print_braces doc expr braces_loc = (* already has braces *) doc | _ -> - Doc.breakable_group ~force_break:over_multiple_lines + Doc.breakableGroup ~forceBreak:overMultipleLines (Doc.concat [ Doc.lbrace; Doc.indent (Doc.concat [ - Doc.soft_line; - (if Parens.braced_expr expr then add_parens doc else doc); + Doc.softLine; + (if Parens.bracedExpr expr then addParens doc else doc); ]); - Doc.soft_line; + Doc.softLine; Doc.rbrace; ]) -and print_override_flag override_flag = - match override_flag with +and printOverrideFlag overrideFlag = + match overrideFlag with | Asttypes.Override -> Doc.text "!" | Fresh -> Doc.nil -and print_direction_flag flag = +and printDirectionFlag flag = match flag with | Asttypes.Downto -> Doc.text " downto " | Asttypes.Upto -> Doc.text " to " -and print_expression_record_row ~state (lbl, expr) cmt_tbl punning_allowed = - let cmt_loc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in +and printExpressionRecordRow ~state (lbl, expr) cmtTbl punningAllowed = + let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in let doc = Doc.group (match expr.pexp_desc with | Pexp_ident {txt = Lident key; loc = _keyLoc} - when punning_allowed && Longident.last lbl.txt = key -> + when punningAllowed && Longident.last lbl.txt = key -> (* print punned field *) Doc.concat [ - print_attributes ~state expr.pexp_attributes cmt_tbl; - print_optional_label expr.pexp_attributes; - print_lident_path lbl cmt_tbl; + printAttributes ~state expr.pexp_attributes cmtTbl; + printOptionalLabel expr.pexp_attributes; + printLidentPath lbl cmtTbl; ] | _ -> Doc.concat [ - print_lident_path lbl cmt_tbl; + printLidentPath lbl cmtTbl; Doc.text ": "; - print_optional_label expr.pexp_attributes; - (let doc = print_expression_with_comments ~state expr cmt_tbl in - match Parens.expr_record_row_rhs expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + printOptionalLabel expr.pexp_attributes; + (let doc = printExpressionWithComments ~state expr cmtTbl in + match Parens.exprRecordRowRhs expr with + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc); ]) in - print_comments doc cmt_tbl cmt_loc + printComments doc cmtTbl cmtLoc -and print_bs_object_row ~state (lbl, expr) cmt_tbl = - let cmt_loc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in - let lbl_doc = +and printBsObjectRow ~state (lbl, expr) cmtTbl = + let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in + let lblDoc = let doc = - Doc.concat [Doc.text "\""; print_longident lbl.txt; Doc.text "\""] + Doc.concat [Doc.text "\""; printLongident lbl.txt; Doc.text "\""] in - print_comments doc cmt_tbl lbl.loc + printComments doc cmtTbl lbl.loc in let doc = Doc.concat [ - lbl_doc; + lblDoc; Doc.text ": "; - (let doc = print_expression_with_comments ~state expr cmt_tbl in + (let doc = printExpressionWithComments ~state expr cmtTbl in match Parens.expr expr with - | Parens.Parenthesized -> add_parens doc - | Braced braces -> print_braces doc expr braces + | Parens.Parenthesized -> addParens doc + | Braced braces -> printBraces doc expr braces | Nothing -> doc); ] in - print_comments doc cmt_tbl cmt_loc + printComments doc cmtTbl cmtLoc (* The optional loc indicates whether we need to print the attributes in * relation to some location. In practise this means the following: @@ -5427,46 +5361,46 @@ and print_bs_object_row ~state (lbl, expr) cmt_tbl = * `@attr * type t = string` -> attr is on prev line, print the attributes * with a line break between, we respect the users' original layout *) -and print_attributes ?loc ?(inline = false) ~state - (attrs : Parsetree.attributes) cmt_tbl = - match ParsetreeViewer.filter_parsing_attrs attrs with +and printAttributes ?loc ?(inline = false) ~state (attrs : Parsetree.attributes) + cmtTbl = + match ParsetreeViewer.filterParsingAttrs attrs with | [] -> Doc.nil | attrs -> - let line_break = + let lineBreak = match loc with | None -> Doc.line | Some loc -> ( match List.rev attrs with - | ({loc = first_loc}, _) :: _ - when loc.loc_start.pos_lnum > first_loc.loc_end.pos_lnum -> - Doc.hard_line + | ({loc = firstLoc}, _) :: _ + when loc.loc_start.pos_lnum > firstLoc.loc_end.pos_lnum -> + Doc.hardLine | _ -> Doc.line) in Doc.concat [ Doc.group - (Doc.join_with_sep - (List.map (fun attr -> print_attribute ~state attr cmt_tbl) attrs)); - (if inline then Doc.space else line_break); + (Doc.joinWithSep + (List.map (fun attr -> printAttribute ~state attr cmtTbl) attrs)); + (if inline then Doc.space else lineBreak); ] -and print_payload ~state (payload : Parsetree.payload) cmt_tbl = +and printPayload ~state (payload : Parsetree.payload) cmtTbl = match payload with | PStr [] -> Doc.nil | PStr [{pstr_desc = Pstr_eval (expr, attrs)}] -> - let expr_doc = print_expression_with_comments ~state expr cmt_tbl in - let needs_parens = + let exprDoc = printExpressionWithComments ~state expr cmtTbl in + let needsParens = match attrs with | [] -> false | _ -> true in - let should_hug = ParsetreeViewer.is_huggable_expression expr in - if should_hug then + let shouldHug = ParsetreeViewer.isHuggableExpression expr in + if shouldHug then Doc.concat [ Doc.lparen; - print_attributes ~state attrs cmt_tbl; - (if needs_parens then add_parens expr_doc else expr_doc); + printAttributes ~state attrs cmtTbl; + (if needsParens then addParens exprDoc else exprDoc); Doc.rparen; ] else @@ -5476,34 +5410,34 @@ and print_payload ~state (payload : Parsetree.payload) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; - print_attributes ~state attrs cmt_tbl; - (if needs_parens then add_parens expr_doc else expr_doc); + Doc.softLine; + printAttributes ~state attrs cmtTbl; + (if needsParens then addParens exprDoc else exprDoc); ]); - Doc.soft_line; + Doc.softLine; Doc.rparen; ] | PStr [({pstr_desc = Pstr_value (_recFlag, _bindings)} as si)] -> - add_parens (print_structure_item ~state si cmt_tbl) - | PStr structure -> add_parens (print_structure ~state structure cmt_tbl) + addParens (printStructureItem ~state si cmtTbl) + | PStr structure -> addParens (printStructure ~state structure cmtTbl) | PTyp typ -> Doc.concat [ Doc.lparen; Doc.text ":"; - Doc.indent (Doc.concat [Doc.line; print_typ_expr ~state typ cmt_tbl]); - Doc.soft_line; + Doc.indent (Doc.concat [Doc.line; printTypExpr ~state typ cmtTbl]); + Doc.softLine; Doc.rparen; ] - | PPat (pat, opt_expr) -> - let when_doc = - match opt_expr with + | PPat (pat, optExpr) -> + let whenDoc = + match optExpr with | Some expr -> Doc.concat [ Doc.line; Doc.text "if "; - print_expression_with_comments ~state expr cmt_tbl; + printExpressionWithComments ~state expr cmtTbl; ] | None -> Doc.nil in @@ -5513,12 +5447,12 @@ and print_payload ~state (payload : Parsetree.payload) cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.text "? "; - print_pattern ~state pat cmt_tbl; - when_doc; + printPattern ~state pat cmtTbl; + whenDoc; ]); - Doc.soft_line; + Doc.softLine; Doc.rparen; ] | PSig signature -> @@ -5527,13 +5461,13 @@ and print_payload ~state (payload : Parsetree.payload) cmt_tbl = Doc.lparen; Doc.text ":"; Doc.indent - (Doc.concat [Doc.line; print_signature ~state signature cmt_tbl]); - Doc.soft_line; + (Doc.concat [Doc.line; printSignature ~state signature cmtTbl]); + Doc.softLine; Doc.rparen; ] -and print_attribute ?(standalone = false) ~state - ((id, payload) : Parsetree.attribute) cmt_tbl = +and printAttribute ?(standalone = false) ~state + ((id, payload) : Parsetree.attribute) cmtTbl = match (id, payload) with | ( {txt = "res.doc"}, PStr @@ -5549,7 +5483,7 @@ and print_attribute ?(standalone = false) ~state Doc.text txt; Doc.text "*/"; ], - Doc.hard_line ) + Doc.hardLine ) | _ -> let id = match id.txt with @@ -5565,40 +5499,35 @@ and print_attribute ?(standalone = false) ~state (Doc.concat [ Doc.text (if standalone then "@@" else "@"); - Doc.text id.txt; - print_payload ~state payload cmt_tbl; + Doc.text (convertBsExternalAttribute id.txt); + printPayload ~state payload cmtTbl; ]), Doc.line ) -and print_mod_expr ~state mod_expr cmt_tbl = +and printModExpr ~state modExpr cmtTbl = let doc = - match mod_expr.pmod_desc with - | Pmod_ident longident_loc -> print_longident_location longident_loc cmt_tbl + match modExpr.pmod_desc with + | Pmod_ident longidentLoc -> printLongidentLocation longidentLoc cmtTbl | Pmod_structure [] -> - let should_break = - mod_expr.pmod_loc.loc_start.pos_lnum - < mod_expr.pmod_loc.loc_end.pos_lnum + let shouldBreak = + modExpr.pmod_loc.loc_start.pos_lnum < modExpr.pmod_loc.loc_end.pos_lnum in - Doc.breakable_group ~force_break:should_break + Doc.breakableGroup ~forceBreak:shouldBreak (Doc.concat - [ - Doc.lbrace; - print_comments_inside cmt_tbl mod_expr.pmod_loc; - Doc.rbrace; - ]) + [Doc.lbrace; printCommentsInside cmtTbl modExpr.pmod_loc; Doc.rbrace]) | Pmod_structure structure -> - Doc.breakable_group ~force_break:true + Doc.breakableGroup ~forceBreak:true (Doc.concat [ Doc.lbrace; Doc.indent (Doc.concat - [Doc.soft_line; print_structure ~state structure cmt_tbl]); - Doc.soft_line; + [Doc.softLine; printStructure ~state structure cmtTbl]); + Doc.softLine; Doc.rbrace; ]) | Pmod_unpack expr -> - let should_hug = + let shouldHug = match expr.pexp_desc with | Pexp_let _ -> true | Pexp_constraint @@ -5607,56 +5536,53 @@ and print_mod_expr ~state mod_expr cmt_tbl = true | _ -> false in - let expr, module_constraint = + let expr, moduleConstraint = match expr.pexp_desc with | Pexp_constraint - (expr, {ptyp_desc = Ptyp_package package_type; ptyp_loc}) -> - let package_doc = + (expr, {ptyp_desc = Ptyp_package packageType; ptyp_loc}) -> + let packageDoc = let doc = - print_package_type ~state ~print_module_keyword_and_parens:false - package_type cmt_tbl + printPackageType ~state ~printModuleKeywordAndParens:false + packageType cmtTbl in - print_comments doc cmt_tbl ptyp_loc + printComments doc cmtTbl ptyp_loc in - let type_doc = + let typeDoc = Doc.group (Doc.concat - [Doc.text ":"; Doc.indent (Doc.concat [Doc.line; package_doc])]) + [Doc.text ":"; Doc.indent (Doc.concat [Doc.line; packageDoc])]) in - (expr, type_doc) + (expr, typeDoc) | _ -> (expr, Doc.nil) in - let unpack_doc = + let unpackDoc = Doc.group (Doc.concat - [ - print_expression_with_comments ~state expr cmt_tbl; - module_constraint; - ]) + [printExpressionWithComments ~state expr cmtTbl; moduleConstraint]) in Doc.group (Doc.concat [ Doc.text "unpack("; - (if should_hug then unpack_doc + (if shouldHug then unpackDoc else Doc.concat [ - Doc.indent (Doc.concat [Doc.soft_line; unpack_doc]); - Doc.soft_line; + Doc.indent (Doc.concat [Doc.softLine; unpackDoc]); + Doc.softLine; ]); Doc.rparen; ]) | Pmod_extension extension -> - print_extension ~state ~at_module_lvl:false extension cmt_tbl + printExtension ~state ~atModuleLvl:false extension cmtTbl | Pmod_apply _ -> - let args, call_expr = ParsetreeViewer.mod_expr_apply mod_expr in - let is_unit_sugar = + let args, callExpr = ParsetreeViewer.modExprApply modExpr in + let isUnitSugar = match args with | [{pmod_desc = Pmod_structure []}] -> true | _ -> false in - let should_hug = + let shouldHug = match args with | [{pmod_desc = Pmod_structure _}] -> true | _ -> false @@ -5664,80 +5590,77 @@ and print_mod_expr ~state mod_expr cmt_tbl = Doc.group (Doc.concat [ - print_mod_expr ~state call_expr cmt_tbl; - (if is_unit_sugar then - print_mod_apply_arg ~state - (List.hd args [@doesNotRaise]) - cmt_tbl + printModExpr ~state callExpr cmtTbl; + (if isUnitSugar then + printModApplyArg ~state (List.hd args [@doesNotRaise]) cmtTbl else Doc.concat [ Doc.lparen; - (if should_hug then - print_mod_apply_arg ~state + (if shouldHug then + printModApplyArg ~state (List.hd args [@doesNotRaise]) - cmt_tbl + cmtTbl else Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun mod_arg -> - print_mod_apply_arg ~state mod_arg cmt_tbl) + (fun modArg -> + printModApplyArg ~state modArg cmtTbl) args); ])); - (if not should_hug then - Doc.concat [Doc.trailing_comma; Doc.soft_line] + (if not shouldHug then + Doc.concat [Doc.trailingComma; Doc.softLine] else Doc.nil); Doc.rparen; ]); ]) - | Pmod_constraint (mod_expr, mod_type) -> + | Pmod_constraint (modExpr, modType) -> Doc.concat [ - print_mod_expr ~state mod_expr cmt_tbl; + printModExpr ~state modExpr cmtTbl; Doc.text ": "; - print_mod_type ~state mod_type cmt_tbl; + printModType ~state modType cmtTbl; ] - | Pmod_functor _ -> print_mod_functor ~state mod_expr cmt_tbl + | Pmod_functor _ -> printModFunctor ~state modExpr cmtTbl in let doc = - if ParsetreeViewer.has_await_attribute mod_expr.pmod_attributes then - match mod_expr.pmod_desc with + if ParsetreeViewer.hasAwaitAttribute modExpr.pmod_attributes then + match modExpr.pmod_desc with | Pmod_constraint _ -> Doc.concat [Doc.text "await "; Doc.lparen; doc; Doc.rparen] | _ -> Doc.concat [Doc.text "await "; doc] else doc in - print_comments doc cmt_tbl mod_expr.pmod_loc + printComments doc cmtTbl modExpr.pmod_loc -and print_mod_functor ~state mod_expr cmt_tbl = - let parameters, return_mod_expr = ParsetreeViewer.mod_expr_functor mod_expr in +and printModFunctor ~state modExpr cmtTbl = + let parameters, returnModExpr = ParsetreeViewer.modExprFunctor modExpr in (* let shouldInline = match returnModExpr.pmod_desc with *) (* | Pmod_structure _ | Pmod_ident _ -> true *) (* | Pmod_constraint ({pmod_desc = Pmod_structure _}, _) -> true *) (* | _ -> false *) (* in *) - let return_constraint, return_mod_expr = - match return_mod_expr.pmod_desc with - | Pmod_constraint (mod_expr, mod_type) -> - let constraint_doc = - let doc = print_mod_type ~state mod_type cmt_tbl in - if Parens.mod_expr_functor_constraint mod_type then add_parens doc - else doc + let returnConstraint, returnModExpr = + match returnModExpr.pmod_desc with + | Pmod_constraint (modExpr, modType) -> + let constraintDoc = + let doc = printModType ~state modType cmtTbl in + if Parens.modExprFunctorConstraint modType then addParens doc else doc in - let mod_constraint = Doc.concat [Doc.text ": "; constraint_doc] in - (mod_constraint, print_mod_expr ~state mod_expr cmt_tbl) - | _ -> (Doc.nil, print_mod_expr ~state return_mod_expr cmt_tbl) + let modConstraint = Doc.concat [Doc.text ": "; constraintDoc] in + (modConstraint, printModExpr ~state modExpr cmtTbl) + | _ -> (Doc.nil, printModExpr ~state returnModExpr cmtTbl) in - let parameters_doc = + let parametersDoc = match parameters with | [(attrs, {txt = "*"}, None)] -> Doc.group - (Doc.concat [print_attributes ~state attrs cmt_tbl; Doc.text "()"]) + (Doc.concat [printAttributes ~state attrs cmtTbl; Doc.text "()"]) | [([], {txt = lbl}, None)] -> Doc.text lbl | parameters -> Doc.group @@ -5747,136 +5670,128 @@ and print_mod_functor ~state mod_expr cmt_tbl = Doc.indent (Doc.concat [ - Doc.soft_line; + Doc.softLine; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun param -> - print_mod_functor_param ~state param cmt_tbl) + (fun param -> printModFunctorParam ~state param cmtTbl) parameters); ]); - Doc.trailing_comma; - Doc.soft_line; + Doc.trailingComma; + Doc.softLine; Doc.rparen; ]) in Doc.group (Doc.concat - [parameters_doc; return_constraint; Doc.text " => "; return_mod_expr]) + [parametersDoc; returnConstraint; Doc.text " => "; returnModExpr]) -and print_mod_functor_param ~state (attrs, lbl, opt_mod_type) cmt_tbl = - let cmt_loc = - match opt_mod_type with +and printModFunctorParam ~state (attrs, lbl, optModType) cmtTbl = + let cmtLoc = + match optModType with | None -> lbl.Asttypes.loc - | Some mod_type -> - {lbl.loc with loc_end = mod_type.Parsetree.pmty_loc.loc_end} + | Some modType -> + {lbl.loc with loc_end = modType.Parsetree.pmty_loc.loc_end} in - let attrs = print_attributes ~state attrs cmt_tbl in - let lbl_doc = + let attrs = printAttributes ~state attrs cmtTbl in + let lblDoc = let doc = if lbl.txt = "*" then Doc.text "()" else Doc.text lbl.txt in - print_comments doc cmt_tbl lbl.loc + printComments doc cmtTbl lbl.loc in let doc = Doc.group (Doc.concat [ attrs; - lbl_doc; - (match opt_mod_type with + lblDoc; + (match optModType with | None -> Doc.nil - | Some mod_type -> - Doc.concat [Doc.text ": "; print_mod_type ~state mod_type cmt_tbl]); + | Some modType -> + Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl]); ]) in - print_comments doc cmt_tbl cmt_loc + printComments doc cmtTbl cmtLoc -and print_mod_apply_arg ~state mod_expr cmt_tbl = - match mod_expr.pmod_desc with +and printModApplyArg ~state modExpr cmtTbl = + match modExpr.pmod_desc with | Pmod_structure [] -> Doc.text "()" - | _ -> print_mod_expr ~state mod_expr cmt_tbl + | _ -> printModExpr ~state modExpr cmtTbl -and print_exception_def ~state (constr : Parsetree.extension_constructor) - cmt_tbl = +and printExceptionDef ~state (constr : Parsetree.extension_constructor) cmtTbl = let kind = match constr.pext_kind with | Pext_rebind longident -> Doc.indent (Doc.concat - [Doc.text " ="; Doc.line; print_longident_location longident cmt_tbl]) + [Doc.text " ="; Doc.line; printLongidentLocation longident cmtTbl]) | Pext_decl (Pcstr_tuple [], None) -> Doc.nil | Pext_decl (args, gadt) -> - let gadt_doc = + let gadtDoc = match gadt with - | Some typ -> - Doc.concat [Doc.text ": "; print_typ_expr ~state typ cmt_tbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | None -> Doc.nil in Doc.concat - [ - print_constructor_arguments ~state ~indent:false args cmt_tbl; gadt_doc; - ] + [printConstructorArguments ~state ~indent:false args cmtTbl; gadtDoc] in let name = - print_comments (Doc.text constr.pext_name.txt) cmt_tbl constr.pext_name.loc + printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc in let doc = Doc.group (Doc.concat [ - print_attributes ~state constr.pext_attributes cmt_tbl; + printAttributes ~state constr.pext_attributes cmtTbl; Doc.text "exception "; name; kind; ]) in - print_comments doc cmt_tbl constr.pext_loc + printComments doc cmtTbl constr.pext_loc -and print_extension_constructor ~state - (constr : Parsetree.extension_constructor) cmt_tbl i = - let attrs = print_attributes ~state constr.pext_attributes cmt_tbl in +and printExtensionConstructor ~state (constr : Parsetree.extension_constructor) + cmtTbl i = + let attrs = printAttributes ~state constr.pext_attributes cmtTbl in let bar = - if i > 0 then Doc.text "| " else Doc.if_breaks (Doc.text "| ") Doc.nil + if i > 0 then Doc.text "| " else Doc.ifBreaks (Doc.text "| ") Doc.nil in let kind = match constr.pext_kind with | Pext_rebind longident -> Doc.indent (Doc.concat - [Doc.text " ="; Doc.line; print_longident_location longident cmt_tbl]) + [Doc.text " ="; Doc.line; printLongidentLocation longident cmtTbl]) | Pext_decl (Pcstr_tuple [], None) -> Doc.nil | Pext_decl (args, gadt) -> - let gadt_doc = + let gadtDoc = match gadt with - | Some typ -> - Doc.concat [Doc.text ": "; print_typ_expr ~state typ cmt_tbl] + | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] | None -> Doc.nil in Doc.concat - [ - print_constructor_arguments ~state ~indent:false args cmt_tbl; gadt_doc; - ] + [printConstructorArguments ~state ~indent:false args cmtTbl; gadtDoc] in let name = - print_comments (Doc.text constr.pext_name.txt) cmt_tbl constr.pext_name.loc + printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc in Doc.concat [bar; Doc.group (Doc.concat [attrs; name; kind])] -let print_type_params params = print_type_params ~state:(State.init ()) params -let print_typ_expr t = print_typ_expr ~state:(State.init ()) t -let print_expression e = print_expression ~state:(State.init ()) e -let print_pattern p = print_pattern ~state:(State.init ()) p +let printTypeParams params = printTypeParams ~state:(State.init ()) params +let printTypExpr t = printTypExpr ~state:(State.init ()) t +let printExpression e = printExpression ~state:(State.init ()) e +let printPattern p = printPattern ~state:(State.init ()) p -let print_implementation ~width (s : Parsetree.structure) ~comments = - let cmt_tbl = CommentTable.make () in - CommentTable.walk_structure s cmt_tbl comments; +let printImplementation ~width (s : Parsetree.structure) ~comments = + let cmtTbl = CommentTable.make () in + CommentTable.walkStructure s cmtTbl comments; (* CommentTable.log cmtTbl; *) - let doc = print_structure ~state:(State.init ()) s cmt_tbl in + let doc = printStructure ~state:(State.init ()) s cmtTbl in (* Doc.debug doc; *) - Doc.to_string ~width doc ^ "\n" + Doc.toString ~width doc ^ "\n" -let print_interface ~width (s : Parsetree.signature) ~comments = - let cmt_tbl = CommentTable.make () in - CommentTable.walk_signature s cmt_tbl comments; - Doc.to_string ~width (print_signature ~state:(State.init ()) s cmt_tbl) ^ "\n" +let printInterface ~width (s : Parsetree.signature) ~comments = + let cmtTbl = CommentTable.make () in + CommentTable.walkSignature s cmtTbl comments; + Doc.toString ~width (printSignature ~state:(State.init ()) s cmtTbl) ^ "\n" -let print_structure = print_structure ~state:(State.init ()) +let printStructure = printStructure ~state:(State.init ()) diff --git a/analysis/vendor/res_syntax/res_printer.mli b/analysis/vendor/res_syntax/res_printer.mli index c3b95b8e2..3647dc379 100644 --- a/analysis/vendor/res_syntax/res_printer.mli +++ b/analysis/vendor/res_syntax/res_printer.mli @@ -1,30 +1,28 @@ -val print_type_params : +val convertBsExternalAttribute : string -> string +val convertBsExtension : string -> string + +val printTypeParams : (Parsetree.core_type * Asttypes.variance) list -> Res_comments_table.t -> Res_doc.t -val print_longident : Longident.t -> Res_doc.t +val printLongident : Longident.t -> Res_doc.t -val print_typ_expr : Parsetree.core_type -> Res_comments_table.t -> Res_doc.t +val printTypExpr : Parsetree.core_type -> Res_comments_table.t -> Res_doc.t -val add_parens : Res_doc.t -> Res_doc.t +val addParens : Res_doc.t -> Res_doc.t -val print_expression : Parsetree.expression -> Res_comments_table.t -> Res_doc.t +val printExpression : Parsetree.expression -> Res_comments_table.t -> Res_doc.t -val print_pattern : Parsetree.pattern -> Res_comments_table.t -> Res_doc.t +val printPattern : Parsetree.pattern -> Res_comments_table.t -> Res_doc.t [@@live] -val print_structure : Parsetree.structure -> Res_comments_table.t -> Res_doc.t +val printStructure : Parsetree.structure -> Res_comments_table.t -> Res_doc.t [@@live] -val print_implementation : +val printImplementation : width:int -> Parsetree.structure -> comments:Res_comment.t list -> string -val print_interface : +val printInterface : width:int -> Parsetree.signature -> comments:Res_comment.t list -> string -val print_ident_like : - ?allow_uident:bool -> ?allow_hyphen:bool -> string -> Res_doc.t - -val print_poly_var_ident : string -> Res_doc.t - -val polyvar_ident_to_string : string -> string [@@live] +val polyVarIdentToString : string -> string [@@live] diff --git a/analysis/vendor/res_syntax/res_reporting.ml b/analysis/vendor/res_syntax/res_reporting.ml index 53a3eedce..77d370af0 100644 --- a/analysis/vendor/res_syntax/res_reporting.ml +++ b/analysis/vendor/res_syntax/res_reporting.ml @@ -13,4 +13,4 @@ type problem = | Lident [@live] | Unbalanced of Token.t [@live] -type parse_error = Lexing.position * problem +type parseError = Lexing.position * problem diff --git a/analysis/vendor/res_syntax/res_scanner.ml b/analysis/vendor/res_syntax/res_scanner.ml index 5d823a737..7eaeea2a6 100644 --- a/analysis/vendor/res_syntax/res_scanner.ml +++ b/analysis/vendor/res_syntax/res_scanner.ml @@ -7,41 +7,41 @@ type mode = Jsx | Diamond (* We hide the implementation detail of the scanner reading character. Our char will also contain the special -1 value to indicate end-of-file. This isn't ideal; we should clean this up *) -let hacky_eof_char = Char.unsafe_chr (-1) -type char_encoding = Char.t +let hackyEOFChar = Char.unsafe_chr (-1) +type charEncoding = Char.t type t = { filename: string; src: string; mutable err: - start_pos:Lexing.position -> - end_pos:Lexing.position -> + startPos:Lexing.position -> + endPos:Lexing.position -> Diagnostics.category -> unit; - mutable ch: char_encoding; (* current character *) + mutable ch: charEncoding; (* current character *) mutable offset: int; (* current byte offset *) mutable offset16: int; (* current number of utf16 code units since line start *) - mutable line_offset: int; (* current line offset *) + mutable lineOffset: int; (* current line offset *) mutable lnum: int; (* current line number *) mutable mode: mode list; } -let set_diamond_mode scanner = scanner.mode <- Diamond :: scanner.mode +let setDiamondMode scanner = scanner.mode <- Diamond :: scanner.mode -let set_jsx_mode scanner = scanner.mode <- Jsx :: scanner.mode +let setJsxMode scanner = scanner.mode <- Jsx :: scanner.mode -let pop_mode scanner mode = +let popMode scanner mode = match scanner.mode with | m :: ms when m = mode -> scanner.mode <- ms | _ -> () -let in_diamond_mode scanner = +let inDiamondMode scanner = match scanner.mode with | Diamond :: _ -> true | _ -> false -let in_jsx_mode scanner = +let inJsxMode scanner = match scanner.mode with | Jsx :: _ -> true | _ -> false @@ -55,9 +55,9 @@ let position scanner = (* offset of the beginning of the line (number of bytes between the beginning of the scanner and the beginning of the line) *) - pos_bol = scanner.line_offset; + pos_bol = scanner.lineOffset; (* [pos_cnum - pos_bol] is the number of utf16 code units since line start *) - pos_cnum = scanner.line_offset + scanner.offset16; + pos_cnum = scanner.lineOffset + scanner.offset16; } (* Small debugging util @@ -74,28 +74,28 @@ let position scanner = ^ eof 18-18 let msg = "hello" *) -let _printDebug ~start_pos ~end_pos scanner token = +let _printDebug ~startPos ~endPos scanner token = let open Lexing in print_string scanner.src; - print_string ((String.make [@doesNotRaise]) start_pos.pos_cnum ' '); + print_string ((String.make [@doesNotRaise]) startPos.pos_cnum ' '); print_char '^'; - (match end_pos.pos_cnum - start_pos.pos_cnum with + (match endPos.pos_cnum - startPos.pos_cnum with | 0 -> if token = Token.Eof then () else assert false | 1 -> () | n -> print_string ((String.make [@doesNotRaise]) (n - 2) '-'); print_char '^'); print_char ' '; - print_string (Res_token.to_string token); + print_string (Res_token.toString token); print_char ' '; - print_int start_pos.pos_cnum; + print_int startPos.pos_cnum; print_char '-'; - print_int end_pos.pos_cnum; + print_int endPos.pos_cnum; print_endline "" [@@live] let next scanner = - let next_offset = scanner.offset + 1 in + let nextOffset = scanner.offset + 1 in let utf16len = match Ext_utf8.classify scanner.ch with | Single _ | Invalid -> 1 @@ -109,17 +109,17 @@ let next scanner = -> we can just bump the line count on \n *) in if newline then ( - scanner.line_offset <- next_offset; + scanner.lineOffset <- nextOffset; scanner.offset16 <- 0; scanner.lnum <- scanner.lnum + 1) else scanner.offset16 <- scanner.offset16 + utf16len; - if next_offset < String.length scanner.src then ( - scanner.offset <- next_offset; - scanner.ch <- String.unsafe_get scanner.src next_offset) + if nextOffset < String.length scanner.src then ( + scanner.offset <- nextOffset; + scanner.ch <- String.unsafe_get scanner.src nextOffset) else ( scanner.offset <- String.length scanner.src; - scanner.offset16 <- scanner.offset - scanner.line_offset; - scanner.ch <- hacky_eof_char) + scanner.offset16 <- scanner.offset - scanner.lineOffset; + scanner.ch <- hackyEOFChar) let next2 scanner = next scanner; @@ -133,44 +133,44 @@ let next3 scanner = let peek scanner = if scanner.offset + 1 < String.length scanner.src then String.unsafe_get scanner.src (scanner.offset + 1) - else hacky_eof_char + else hackyEOFChar let peek2 scanner = if scanner.offset + 2 < String.length scanner.src then String.unsafe_get scanner.src (scanner.offset + 2) - else hacky_eof_char + else hackyEOFChar let peek3 scanner = if scanner.offset + 3 < String.length scanner.src then String.unsafe_get scanner.src (scanner.offset + 3) - else hacky_eof_char + else hackyEOFChar let make ~filename src = { filename; src; - err = (fun ~start_pos:_ ~end_pos:_ _ -> ()); - ch = (if src = "" then hacky_eof_char else String.unsafe_get src 0); + err = (fun ~startPos:_ ~endPos:_ _ -> ()); + ch = (if src = "" then hackyEOFChar else String.unsafe_get src 0); offset = 0; offset16 = 0; - line_offset = 0; + lineOffset = 0; lnum = 1; mode = []; } (* generic helpers *) -let is_whitespace ch = +let isWhitespace ch = match ch with | ' ' | '\t' | '\n' | '\r' -> true | _ -> false -let rec skip_whitespace scanner = - if is_whitespace scanner.ch then ( +let rec skipWhitespace scanner = + if isWhitespace scanner.ch then ( next scanner; - skip_whitespace scanner) + skipWhitespace scanner) -let digit_value ch = +let digitValue ch = match ch with | '0' .. '9' -> Char.code ch - 48 | 'a' .. 'f' -> Char.code ch - Char.code 'a' + 10 @@ -179,53 +179,58 @@ let digit_value ch = (* scanning helpers *) -let scan_identifier scanner = - let start_off = scanner.offset in - let rec skip_good_chars scanner = - match (scanner.ch, in_jsx_mode scanner) with +let scanIdentifier scanner = + let startOff = scanner.offset in + let rec skipGoodChars scanner = + match (scanner.ch, inJsxMode scanner) with | ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' | '\''), false -> next scanner; - skip_good_chars scanner + skipGoodChars scanner | ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' | '\'' | '-'), true -> next scanner; - skip_good_chars scanner + skipGoodChars scanner | _ -> () in - skip_good_chars scanner; + skipGoodChars scanner; let str = - (String.sub [@doesNotRaise]) scanner.src start_off - (scanner.offset - start_off) + (String.sub [@doesNotRaise]) scanner.src startOff (scanner.offset - startOff) in if '{' == scanner.ch && str = "list" then ( next scanner; (* TODO: this isn't great *) - Token.lookup_keyword "list{") - else Token.lookup_keyword str + Token.lookupKeyword "list{") + else Token.lookupKeyword str -let scan_digits scanner ~base = +let scanDigits scanner ~base = if base <= 10 then - let rec loop scanner = + let rec loop scanner foundDigits = match scanner.ch with - | '0' .. '9' | '_' -> + | '0' .. '9' -> next scanner; - loop scanner - | _ -> () + loop scanner true + | '_' -> + next scanner; + loop scanner false + | _ -> foundDigits in - loop scanner + loop scanner false else - let rec loop scanner = + let rec loop scanner foundDigits = match scanner.ch with (* hex *) - | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' | '_' -> + | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> + next scanner; + loop scanner true + | '_' -> next scanner; - loop scanner - | _ -> () + loop scanner false + | _ -> foundDigits in - loop scanner + loop scanner false (* float: (0…9) { 0…9∣ _ } [. { 0…9∣ _ }] [(e∣ E) [+∣ -] (0…9) { 0…9∣ _ }] *) -let scan_number scanner = - let start_off = scanner.offset in +let scanNumber scanner = + let startOff = scanner.offset in (* integer part *) let base = @@ -246,31 +251,35 @@ let scan_number scanner = 8) | _ -> 10 in - scan_digits scanner ~base; + ignore (scanDigits scanner ~base); (* *) - let is_float = + let isFloat = if '.' == scanner.ch then ( next scanner; - scan_digits scanner ~base; + ignore (scanDigits scanner ~base); true) else false in (* exponent part *) - let is_float = + let isFloat = + let startPos = position scanner in match scanner.ch with | 'e' | 'E' | 'p' | 'P' -> (match peek scanner with | '+' | '-' -> next2 scanner | _ -> next scanner); - scan_digits scanner ~base; + let endPos = position scanner in + let foundDigits = scanDigits scanner ~base in + if not foundDigits then + scanner.err ~startPos ~endPos + (Diagnostics.message "Expected digits after exponential notation."); true - | _ -> is_float + | _ -> isFloat in let literal = - (String.sub [@doesNotRaise]) scanner.src start_off - (scanner.offset - start_off) + (String.sub [@doesNotRaise]) scanner.src startOff (scanner.offset - startOff) in (* suffix *) @@ -281,61 +290,50 @@ let scan_number scanner = Some ch | _ -> None in - if is_float then Token.Float {f = literal; suffix} + if isFloat then Token.Float {f = literal; suffix} else Token.Int {i = literal; suffix} -let scan_exotic_identifier scanner = - let start_pos = position scanner in - let start_off = scanner.offset in - - next2 scanner; +let scanExoticIdentifier scanner = + (* TODO: are we disregarding the current char...? Should be a quote *) + next scanner; + let buffer = Buffer.create 20 in + let startPos = position scanner in let rec scan () = match scanner.ch with | '"' -> next scanner | '\n' | '\r' -> (* line break *) - let end_pos = position scanner in - scanner.err ~start_pos ~end_pos + let endPos = position scanner in + scanner.err ~startPos ~endPos (Diagnostics.message "A quoted identifier can't contain line breaks."); next scanner - | ch when ch == hacky_eof_char -> - let end_pos = position scanner in - scanner.err ~start_pos ~end_pos + | ch when ch == hackyEOFChar -> + let endPos = position scanner in + scanner.err ~startPos ~endPos (Diagnostics.message "Did you forget a \" here?") - | _ -> + | ch -> + Buffer.add_char buffer ch; next scanner; scan () in scan (); + (* TODO: do we really need to create a new buffer instead of substring once? *) + Token.Lident (Buffer.contents buffer) - let ident = - (String.sub [@doesNotRaise]) scanner.src start_off - (scanner.offset - start_off) - in - let name = Ext_ident.unwrap_uppercase_exotic ident in - if name = String.empty then ( - let end_pos = position scanner in - scanner.err ~start_pos ~end_pos - (Diagnostics.message "A quoted identifier can't be empty string."); - Token.Lident ident) - else if Ext_ident.is_uident name then Token.Lident ident - (* Exotic ident with uppercase letter should be encoded to avoid confusing in OCaml parsetree *) - else Token.Lident name - -let scan_string_escape_sequence ~start_pos scanner = +let scanStringEscapeSequence ~startPos scanner = let scan ~n ~base ~max = let rec loop n x = if n == 0 then x else - let d = digit_value scanner.ch in + let d = digitValue scanner.ch in if d >= base then ( let pos = position scanner in let msg = - if scanner.ch == hacky_eof_char then "unclosed escape sequence" + if scanner.ch == hackyEOFChar then "unclosed escape sequence" else "unknown escape sequence" in - scanner.err ~start_pos ~end_pos:pos (Diagnostics.message msg); + scanner.err ~startPos ~endPos:pos (Diagnostics.message msg); -1) else let () = next scanner in @@ -345,7 +343,7 @@ let scan_string_escape_sequence ~start_pos scanner = if x > max || (0xD800 <= x && x < 0xE000) then let pos = position scanner in let msg = "escape sequence is invalid unicode code point" in - scanner.err ~start_pos ~end_pos:pos (Diagnostics.message msg) + scanner.err ~startPos ~endPos:pos (Diagnostics.message msg) in match scanner.ch with (* \ already consumed *) @@ -372,7 +370,7 @@ let scan_string_escape_sequence ~start_pos scanner = | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false do - x := (!x * 16) + digit_value scanner.ch; + x := (!x * 16) + digitValue scanner.ch; next scanner done; (* consume '}' in '\u{7A}' *) @@ -393,96 +391,95 @@ let scan_string_escape_sequence ~start_pos scanner = *) () -let scan_string scanner = +let scanString scanner = (* assumption: we've just matched a quote *) - let start_pos_with_quote = position scanner in + let startPosWithQuote = position scanner in next scanner; (* If the text needs changing, a buffer is used *) let buf = Buffer.create 0 in - let first_char_offset = scanner.offset in - let last_offset_in_buf = ref first_char_offset in + let firstCharOffset = scanner.offset in + let lastOffsetInBuf = ref firstCharOffset in - let bring_buf_up_to_date ~start_offset = - let str_up_to_now = - (String.sub scanner.src !last_offset_in_buf - (start_offset - !last_offset_in_buf) [@doesNotRaise]) + let bringBufUpToDate ~startOffset = + let strUpToNow = + (String.sub scanner.src !lastOffsetInBuf + (startOffset - !lastOffsetInBuf) [@doesNotRaise]) in - Buffer.add_string buf str_up_to_now; - last_offset_in_buf := start_offset + Buffer.add_string buf strUpToNow; + lastOffsetInBuf := startOffset in - let result ~first_char_offset ~last_char_offset = + let result ~firstCharOffset ~lastCharOffset = if Buffer.length buf = 0 then - (String.sub [@doesNotRaise]) scanner.src first_char_offset - (last_char_offset - first_char_offset) + (String.sub [@doesNotRaise]) scanner.src firstCharOffset + (lastCharOffset - firstCharOffset) else ( - bring_buf_up_to_date ~start_offset:last_char_offset; + bringBufUpToDate ~startOffset:lastCharOffset; Buffer.contents buf) in let rec scan () = match scanner.ch with | '"' -> - let last_char_offset = scanner.offset in + let lastCharOffset = scanner.offset in next scanner; - result ~first_char_offset ~last_char_offset + result ~firstCharOffset ~lastCharOffset | '\\' -> - let start_pos = position scanner in - let start_offset = scanner.offset + 1 in - next scanner; - scan_string_escape_sequence ~start_pos scanner; - let end_offset = scanner.offset in - convert_octal_to_hex ~start_offset ~end_offset - | ch when ch == hacky_eof_char -> - let end_pos = position scanner in - scanner.err ~start_pos:start_pos_with_quote ~end_pos - Diagnostics.unclosed_string; - let last_char_offset = scanner.offset in - result ~first_char_offset ~last_char_offset + let startPos = position scanner in + let startOffset = scanner.offset + 1 in + next scanner; + scanStringEscapeSequence ~startPos scanner; + let endOffset = scanner.offset in + convertOctalToHex ~startOffset ~endOffset + | ch when ch == hackyEOFChar -> + let endPos = position scanner in + scanner.err ~startPos:startPosWithQuote ~endPos Diagnostics.unclosedString; + let lastCharOffset = scanner.offset in + result ~firstCharOffset ~lastCharOffset | _ -> next scanner; scan () - and convert_octal_to_hex ~start_offset ~end_offset = - let len = end_offset - start_offset in - let is_digit = function + and convertOctalToHex ~startOffset ~endOffset = + let len = endOffset - startOffset in + let isDigit = function | '0' .. '9' -> true | _ -> false in let txt = scanner.src in - let is_numeric_escape = + let isNumericEscape = len = 3 - && (is_digit txt.[start_offset] [@doesNotRaise]) - && (is_digit txt.[start_offset + 1] [@doesNotRaise]) - && (is_digit txt.[start_offset + 2] [@doesNotRaise]) + && (isDigit txt.[startOffset] [@doesNotRaise]) + && (isDigit txt.[startOffset + 1] [@doesNotRaise]) + && (isDigit txt.[startOffset + 2] [@doesNotRaise]) in - if is_numeric_escape then ( - let str_decimal = (String.sub txt start_offset 3 [@doesNotRaise]) in - bring_buf_up_to_date ~start_offset; - let str_hex = Res_string.convert_decimal_to_hex ~str_decimal in - last_offset_in_buf := start_offset + 3; - Buffer.add_string buf str_hex; + if isNumericEscape then ( + let strDecimal = (String.sub txt startOffset 3 [@doesNotRaise]) in + bringBufUpToDate ~startOffset; + let strHex = Res_string.convertDecimalToHex ~strDecimal in + lastOffsetInBuf := startOffset + 3; + Buffer.add_string buf strHex; scan ()) else scan () in Token.String (scan ()) -let scan_escape scanner = +let scanEscape scanner = (* '\' consumed *) let offset = scanner.offset - 1 in - let convert_number scanner ~n ~base = + let convertNumber scanner ~n ~base = let x = ref 0 in for _ = n downto 1 do - let d = digit_value scanner.ch in + let d = digitValue scanner.ch in x := (!x * base) + d; next scanner done; let c = !x in - if Res_utf8.is_valid_code_point c then c else Res_utf8.repl + if Res_utf8.isValidCodePoint c then c else Res_utf8.repl in let codepoint = match scanner.ch with - | '0' .. '9' -> convert_number scanner ~n:3 ~base:10 + | '0' .. '9' -> convertNumber scanner ~n:3 ~base:10 | 'b' -> next scanner; 8 @@ -497,10 +494,10 @@ let scan_escape scanner = 009 | 'x' -> next scanner; - convert_number scanner ~n:2 ~base:16 + convertNumber scanner ~n:2 ~base:16 | 'o' -> next scanner; - convert_number scanner ~n:3 ~base:8 + convertNumber scanner ~n:3 ~base:8 | 'u' -> ( next scanner; match scanner.ch with @@ -513,7 +510,7 @@ let scan_escape scanner = | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false do - x := (!x * 16) + digit_value scanner.ch; + x := (!x * 16) + digitValue scanner.ch; next scanner done; (* consume '}' in '\u{7A}' *) @@ -521,10 +518,10 @@ let scan_escape scanner = | '}' -> next scanner | _ -> ()); let c = !x in - if Res_utf8.is_valid_code_point c then c else Res_utf8.repl + if Res_utf8.isValidCodePoint c then c else Res_utf8.repl | _ -> (* unicode escape sequence: '\u007A', exactly 4 hex digits *) - convert_number scanner ~n:4 ~base:16) + convertNumber scanner ~n:4 ~base:16) | ch -> next scanner; Char.code ch @@ -537,34 +534,33 @@ let scan_escape scanner = (* TODO: do we know it's \' ? *) Token.Codepoint {c = codepoint; original = contents} -let scan_single_line_comment scanner = - let start_off = scanner.offset in - let start_pos = position scanner in +let scanSingleLineComment scanner = + let startOff = scanner.offset in + let startPos = position scanner in let rec skip scanner = match scanner.ch with | '\n' | '\r' -> () - | ch when ch == hacky_eof_char -> () + | ch when ch == hackyEOFChar -> () | _ -> next scanner; skip scanner in skip scanner; - let end_pos = position scanner in + let endPos = position scanner in Token.Comment - (Comment.make_single_line_comment - ~loc: - Location.{loc_start = start_pos; loc_end = end_pos; loc_ghost = false} - ((String.sub [@doesNotRaise]) scanner.src start_off - (scanner.offset - start_off))) + (Comment.makeSingleLineComment + ~loc:Location.{loc_start = startPos; loc_end = endPos; loc_ghost = false} + ((String.sub [@doesNotRaise]) scanner.src startOff + (scanner.offset - startOff))) -let scan_multi_line_comment scanner = +let scanMultiLineComment scanner = (* assumption: we're only ever using this helper in `scan` after detecting a comment *) - let doc_comment = peek2 scanner = '*' && peek3 scanner <> '/' (* no /**/ *) in - let standalone = doc_comment && peek3 scanner = '*' (* /*** *) in - let content_start_off = - scanner.offset + if doc_comment then if standalone then 4 else 3 else 2 + let docComment = peek2 scanner = '*' && peek3 scanner <> '/' (* no /**/ *) in + let standalone = docComment && peek3 scanner = '*' (* /*** *) in + let contentStartOff = + scanner.offset + if docComment then if standalone then 4 else 3 else 2 in - let start_pos = position scanner in + let startPos = position scanner in let rec scan ~depth = (* invariant: depth > 0 right after this match. See assumption *) match (scanner.ch, peek scanner) with @@ -574,54 +570,50 @@ let scan_multi_line_comment scanner = | '*', '/' -> next2 scanner; if depth > 1 then scan ~depth:(depth - 1) - | ch, _ when ch == hacky_eof_char -> - let end_pos = position scanner in - scanner.err ~start_pos ~end_pos Diagnostics.unclosed_comment + | ch, _ when ch == hackyEOFChar -> + let endPos = position scanner in + scanner.err ~startPos ~endPos Diagnostics.unclosedComment | _ -> next scanner; scan ~depth in scan ~depth:0; - let length = scanner.offset - 2 - content_start_off in + let length = scanner.offset - 2 - contentStartOff in let length = if length < 0 (* in case of EOF *) then 0 else length in Token.Comment - (Comment.make_multi_line_comment ~doc_comment ~standalone + (Comment.makeMultiLineComment ~docComment ~standalone ~loc: Location. - { - loc_start = start_pos; - loc_end = position scanner; - loc_ghost = false; - } - ((String.sub [@doesNotRaise]) scanner.src content_start_off length)) + {loc_start = startPos; loc_end = position scanner; loc_ghost = false} + ((String.sub [@doesNotRaise]) scanner.src contentStartOff length)) -let scan_template_literal_token scanner = - let start_off = scanner.offset in +let scanTemplateLiteralToken scanner = + let startOff = scanner.offset in (* if starting } here, consume it *) if scanner.ch == '}' then next scanner; - let start_pos = position scanner in + let startPos = position scanner in let rec scan () = - let last_pos = position scanner in + let lastPos = position scanner in match scanner.ch with | '`' -> next scanner; let contents = - (String.sub [@doesNotRaise]) scanner.src start_off - (scanner.offset - 1 - start_off) + (String.sub [@doesNotRaise]) scanner.src startOff + (scanner.offset - 1 - startOff) in - Token.TemplateTail (contents, last_pos) + Token.TemplateTail (contents, lastPos) | '$' -> ( match peek scanner with | '{' -> next2 scanner; let contents = - (String.sub [@doesNotRaise]) scanner.src start_off - (scanner.offset - 2 - start_off) + (String.sub [@doesNotRaise]) scanner.src startOff + (scanner.offset - 2 - startOff) in - Token.TemplatePart (contents, last_pos) + Token.TemplatePart (contents, lastPos) | _ -> next scanner; scan ()) @@ -634,31 +626,31 @@ let scan_template_literal_token scanner = | _ -> next scanner; scan ()) - | ch when ch = hacky_eof_char -> - let end_pos = position scanner in - scanner.err ~start_pos ~end_pos Diagnostics.unclosed_template; + | ch when ch = hackyEOFChar -> + let endPos = position scanner in + scanner.err ~startPos ~endPos Diagnostics.unclosedTemplate; let contents = - (String.sub [@doesNotRaise]) scanner.src start_off - (max (scanner.offset - 1 - start_off) 0) + (String.sub [@doesNotRaise]) scanner.src startOff + (max (scanner.offset - 1 - startOff) 0) in - Token.TemplateTail (contents, last_pos) + Token.TemplateTail (contents, lastPos) | _ -> next scanner; scan () in let token = scan () in - let end_pos = position scanner in - (start_pos, end_pos, token) + let endPos = position scanner in + (startPos, endPos, token) let rec scan scanner = - skip_whitespace scanner; - let start_pos = position scanner in + skipWhitespace scanner; + let startPos = position scanner in let token = match scanner.ch with (* peeking 0 char *) - | 'A' .. 'Z' | 'a' .. 'z' -> scan_identifier scanner - | '0' .. '9' -> scan_number scanner + | 'A' .. 'Z' | 'a' .. 'z' -> scanIdentifier scanner + | '0' .. '9' -> scanNumber scanner | '`' -> next scanner; Token.Backtick @@ -692,11 +684,11 @@ let rec scan scanner = | ',' -> next scanner; Token.Comma - | '"' -> scan_string scanner + | '"' -> scanString scanner (* peeking 1 char *) | '_' -> ( match peek scanner with - | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' -> scan_identifier scanner + | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' -> scanIdentifier scanner | _ -> next scanner; Token.Underscore) @@ -765,13 +757,15 @@ let rec scan scanner = | _ -> next scanner; Token.Colon) - | '\\' -> scan_exotic_identifier scanner + | '\\' -> + next scanner; + scanExoticIdentifier scanner | '/' -> ( match peek scanner with | '/' -> next2 scanner; - scan_single_line_comment scanner - | '*' -> scan_multi_line_comment scanner + scanSingleLineComment scanner + | '*' -> scanMultiLineComment scanner | '.' -> next2 scanner; Token.ForwardslashDot @@ -805,13 +799,13 @@ let rec scan scanner = Token.Plus) | '>' -> ( match peek scanner with - | '=' when not (in_diamond_mode scanner) -> + | '=' when not (inDiamondMode scanner) -> next2 scanner; Token.GreaterEqual | _ -> next scanner; Token.GreaterThan) - | '<' when not (in_jsx_mode scanner) -> ( + | '<' when not (inJsxMode scanner) -> ( match peek scanner with | '=' -> next2 scanner; @@ -829,7 +823,7 @@ let rec scan scanner = * This signals a closing element. To simulate the two-token lookahead, * the next scanner; @@ -859,7 +853,7 @@ let rec scan scanner = SingleQuote | '\\', _ -> next2 scanner; - scan_escape scanner + scanEscape scanner | ch, '\'' -> let offset = scanner.offset + 1 in next3 scanner; @@ -873,7 +867,7 @@ let rec scan scanner = let offset = scanner.offset in let offset16 = scanner.offset16 in let codepoint, length = - Res_utf8.decode_code_point scanner.offset scanner.src + Res_utf8.decodeCodePoint scanner.offset scanner.src (String.length scanner.src) in for _ = 0 to length - 1 do @@ -916,21 +910,21 @@ let rec scan scanner = next scanner; Token.Equal) (* special cases *) - | ch when ch == hacky_eof_char -> + | ch when ch == hackyEOFChar -> next scanner; Token.Eof | ch -> (* if we arrive here, we're dealing with an unknown character, * report the error and continue scanning… *) next scanner; - let end_pos = position scanner in - scanner.err ~start_pos ~end_pos (Diagnostics.unknown_uchar ch); + let endPos = position scanner in + scanner.err ~startPos ~endPos (Diagnostics.unknownUchar ch); let _, _, token = scan scanner in token in - let end_pos = position scanner in + let endPos = position scanner in (* _printDebug ~startPos ~endPos scanner token; *) - (start_pos, end_pos, token) + (startPos, endPos, token) (* misc helpers used elsewhere *) @@ -939,9 +933,9 @@ let rec scan scanner = * or is it the start of a closing tag?
* reconsiderLessThan peeks at the next token and * determines the correct token to disambiguate *) -let reconsider_less_than scanner = +let reconsiderLessThan scanner = (* < consumed *) - skip_whitespace scanner; + skipWhitespace scanner; if scanner.ch == '/' then let () = next scanner in Token.LessThanSlash @@ -949,17 +943,17 @@ let reconsider_less_than scanner = (* If an operator has whitespace around both sides, it's a binary operator *) (* TODO: this helper seems out of place *) -let is_binary_op src start_cnum end_cnum = - if start_cnum == 0 then false +let isBinaryOp src startCnum endCnum = + if startCnum == 0 then false else ( (* we're gonna put some assertions and invariant checks here because this is used outside of the scanner's normal invariant assumptions *) - assert (end_cnum >= 0); - assert (start_cnum > 0 && start_cnum < String.length src); - let left_ok = is_whitespace (String.unsafe_get src (start_cnum - 1)) in + assert (endCnum >= 0); + assert (startCnum > 0 && startCnum < String.length src); + let leftOk = isWhitespace (String.unsafe_get src (startCnum - 1)) in (* we need some stronger confidence that endCnum is ok *) - let right_ok = - end_cnum >= String.length src - || is_whitespace (String.unsafe_get src end_cnum) + let rightOk = + endCnum >= String.length src + || isWhitespace (String.unsafe_get src endCnum) in - left_ok && right_ok) + leftOk && rightOk) diff --git a/analysis/vendor/res_syntax/res_scanner.mli b/analysis/vendor/res_syntax/res_scanner.mli index 5ae40e812..cc002699f 100644 --- a/analysis/vendor/res_syntax/res_scanner.mli +++ b/analysis/vendor/res_syntax/res_scanner.mli @@ -1,20 +1,20 @@ type mode = Jsx | Diamond -type char_encoding +type charEncoding type t = { filename: string; src: string; mutable err: - start_pos:Lexing.position -> - end_pos:Lexing.position -> + startPos:Lexing.position -> + endPos:Lexing.position -> Res_diagnostics.category -> unit; - mutable ch: char_encoding; (* current character *) + mutable ch: charEncoding; (* current character *) mutable offset: int; (* current byte offset *) mutable offset16: int; (* current number of utf16 code units since line start *) - mutable line_offset: int; (* current line offset *) + mutable lineOffset: int; (* current line offset *) mutable lnum: int; (* current line number *) mutable mode: mode list; } @@ -24,13 +24,13 @@ val make : filename:string -> string -> t (* TODO: make this a record *) val scan : t -> Lexing.position * Lexing.position * Res_token.t -val is_binary_op : string -> int -> int -> bool +val isBinaryOp : string -> int -> int -> bool -val set_jsx_mode : t -> unit -val set_diamond_mode : t -> unit -val pop_mode : t -> mode -> unit +val setJsxMode : t -> unit +val setDiamondMode : t -> unit +val popMode : t -> mode -> unit -val reconsider_less_than : t -> Res_token.t +val reconsiderLessThan : t -> Res_token.t -val scan_template_literal_token : +val scanTemplateLiteralToken : t -> Lexing.position * Lexing.position * Res_token.t diff --git a/analysis/vendor/res_syntax/res_string.ml b/analysis/vendor/res_syntax/res_string.ml index 6ef33a29e..a4ecba11d 100644 --- a/analysis/vendor/res_syntax/res_string.ml +++ b/analysis/vendor/res_syntax/res_string.ml @@ -1,11 +1,11 @@ -let hex_table = +let hexTable = [| '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'; 'a'; 'b'; 'c'; 'd'; 'e'; 'f'; |] [@ocamlformat "disable"] -let convert_decimal_to_hex ~str_decimal = +let convertDecimalToHex ~strDecimal = try - let int_num = int_of_string str_decimal in - let c1 = Array.get hex_table (int_num lsr 4) in - let c2 = Array.get hex_table (int_num land 15) in + let intNum = int_of_string strDecimal in + let c1 = Array.get hexTable (intNum lsr 4) in + let c2 = Array.get hexTable (intNum land 15) in "x" ^ String.concat "" [String.make 1 c1; String.make 1 c2] - with Invalid_argument _ | Failure _ -> str_decimal + with Invalid_argument _ | Failure _ -> strDecimal diff --git a/analysis/vendor/res_syntax/res_token.ml b/analysis/vendor/res_syntax/res_token.ml index 16c88e55c..5d12e0f14 100644 --- a/analysis/vendor/res_syntax/res_token.ml +++ b/analysis/vendor/res_syntax/res_token.ml @@ -55,6 +55,7 @@ type t = | Hash | HashEqual | Assert + | Lazy | Tilde | Question | If @@ -110,7 +111,7 @@ let precedence = function | Dot -> 9 | _ -> 0 -let to_string = function +let toString = function | Await -> "await" | Open -> "open" | True -> "true" @@ -165,6 +166,7 @@ let to_string = function | AsteriskDot -> "*." | Exponentiation -> "**" | Assert -> "assert" + | Lazy -> "lazy" | Tilde -> "tilde" | Question -> "?" | If -> "if" @@ -196,7 +198,7 @@ let to_string = function | AtAt -> "@@" | Percent -> "%" | PercentPercent -> "%%" - | Comment c -> "Comment" ^ Comment.to_string c + | Comment c -> "Comment" ^ Comment.toString c | List -> "list{" | TemplatePart (text, _) -> text ^ "${" | TemplateTail (text, _) -> "TemplateTail(" ^ text ^ ")" @@ -206,7 +208,7 @@ let to_string = function | DocComment (_loc, s) -> "DocComment " ^ s | ModuleComment (_loc, s) -> "ModuleComment " ^ s -let keyword_table = function +let keywordTable = function | "and" -> And | "as" -> As | "assert" -> Assert @@ -220,6 +222,7 @@ let keyword_table = function | "if" -> If | "in" -> In | "include" -> Include + | "lazy" -> Lazy | "let" -> Let | "list{" -> List | "module" -> Module @@ -237,23 +240,23 @@ let keyword_table = function | _ -> raise Not_found [@@raises Not_found] -let is_keyword = function +let isKeyword = function | Await | And | As | Assert | Constraint | Else | Exception | External | False - | For | If | In | Include | Land | Let | List | Lor | Module | Mutable | Of - | Open | Private | Rec | Switch | True | Try | Typ | When | While -> + | For | If | In | Include | Land | Lazy | Let | List | Lor | Module | Mutable + | Of | Open | Private | Rec | Switch | True | Try | Typ | When | While -> true | _ -> false -let lookup_keyword str = - try keyword_table str +let lookupKeyword str = + try keywordTable str with Not_found -> ( match str.[0] [@doesNotRaise] with | 'A' .. 'Z' -> Uident str | _ -> Lident str) -let is_keyword_txt str = +let isKeywordTxt str = try - let _ = keyword_table str in + let _ = keywordTable str in true with Not_found -> false diff --git a/analysis/vendor/res_syntax/res_uncurried.ml b/analysis/vendor/res_syntax/res_uncurried.ml index b5d3706c6..1a777e159 100644 --- a/analysis/vendor/res_syntax/res_uncurried.ml +++ b/analysis/vendor/res_syntax/res_uncurried.ml @@ -1,11 +1,11 @@ (* For parsing *) -let from_dotted ~dotted = function +let fromDotted ~dotted = function | Config.Legacy -> dotted | Swap -> not dotted | Uncurried -> true (* For printing *) -let get_dotted ~uncurried = function +let getDotted ~uncurried = function | Config.Legacy -> uncurried | Swap -> not uncurried | Uncurried -> false diff --git a/analysis/vendor/res_syntax/res_utf8.ml b/analysis/vendor/res_syntax/res_utf8.ml index c41621761..69c7d234f 100644 --- a/analysis/vendor/res_syntax/res_utf8.ml +++ b/analysis/vendor/res_syntax/res_utf8.ml @@ -6,8 +6,8 @@ let repl = 0xFFFD (* let min = 0x0000 *) let max = 0x10FFFF -let surrogate_min = 0xD800 -let surrogate_max = 0xDFFF +let surrogateMin = 0xD800 +let surrogateMax = 0xDFFF (* * Char. number range | UTF-8 octet sequence @@ -29,7 +29,7 @@ type category = {low: int; high: int; size: int} let locb = 0b1000_0000 let hicb = 0b1011_1111 -let category_table = [| +let categoryTable = [| (* 0 *) {low = -1; high= -1; size= 1}; (* invalid *) (* 1 *) {low = 1; high= -1; size= 1}; (* ascii *) (* 2 *) {low = locb; high= hicb; size= 2}; @@ -62,7 +62,7 @@ let categories = [| 6; 7; 7 ;7; 8; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; 0; |] [@@ocamlformat "disable"] -let decode_code_point i s len = +let decodeCodePoint i s len = if len < 1 then (repl, 1) else let first = int_of_char (String.unsafe_get s i) in @@ -71,7 +71,7 @@ let decode_code_point i s len = let index = Array.unsafe_get categories first in if index = 0 then (repl, 1) else - let cat = Array.unsafe_get category_table index in + let cat = Array.unsafe_get categoryTable index in if len < i + cat.size then (repl, 1) else if cat.size == 2 then let c1 = int_of_char (String.unsafe_get s (i + 1)) in @@ -108,7 +108,7 @@ let decode_code_point i s len = let uc = i0 lor i3 lor i2 lor i1 in (uc, 4) -let encode_code_point c = +let encodeCodePoint c = if c <= 127 then ( let bytes = (Bytes.create [@doesNotRaise]) 1 in Bytes.unsafe_set bytes 0 (Char.unsafe_chr c); @@ -139,5 +139,5 @@ let encode_code_point c = (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask))); Bytes.unsafe_to_string bytes -let is_valid_code_point c = - (0 <= c && c < surrogate_min) || (surrogate_max < c && c <= max) +let isValidCodePoint c = + (0 <= c && c < surrogateMin) || (surrogateMax < c && c <= max) diff --git a/analysis/vendor/res_syntax/res_utf8.mli b/analysis/vendor/res_syntax/res_utf8.mli index fc80c8be9..7dcb342d6 100644 --- a/analysis/vendor/res_syntax/res_utf8.mli +++ b/analysis/vendor/res_syntax/res_utf8.mli @@ -2,8 +2,8 @@ val repl : int val max : int -val decode_code_point : int -> string -> int -> int * int +val decodeCodePoint : int -> string -> int -> int * int -val encode_code_point : int -> string +val encodeCodePoint : int -> string -val is_valid_code_point : int -> bool +val isValidCodePoint : int -> bool diff --git a/tools/src/tools.ml b/tools/src/tools.ml index db5a052d6..f0a4f7529 100644 --- a/tools/src/tools.ml +++ b/tools/src/tools.ml @@ -622,7 +622,7 @@ let extractDocs ~entryPointFile ~debug = let extractEmbedded ~extensionPoints ~filename = let {Res_driver.parsetree = structure} = - Res_driver.parsing_engine.parse_implementation ~for_printer:false ~filename + Res_driver.parsingEngine.parseImplementation ~forPrinter:false ~filename in let content = ref [] in let append item = content := item :: !content in