From d2674678e1040e65bb6a085ea0b521276c7b2895 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 26 May 2024 15:50:10 -0300 Subject: [PATCH 1/6] format files --- jscomp/bsc/rescript_compiler_main.ml | 34 +- jscomp/common/js_config.ml | 6 +- jscomp/common/js_config.mli | 2 +- jscomp/common/pattern_printer.ml | 12 +- jscomp/core/bs_conditional_initial.ml | 2 +- jscomp/core/j.ml | 2 +- jscomp/core/js_cmj_format.ml | 42 +- jscomp/core/js_dump.ml | 10 +- jscomp/core/js_dump_import_export.ml | 22 +- jscomp/core/js_dump_lit.ml | 4 +- jscomp/core/js_exp_make.ml | 12 +- jscomp/core/js_exp_make.mli | 2 +- jscomp/core/js_implementation.ml | 2 +- jscomp/core/lam.ml | 2 +- jscomp/core/lam_compile.ml | 16 +- jscomp/core/lam_compile_const.ml | 6 +- jscomp/core/lam_compile_external_call.ml | 4 +- jscomp/core/lam_compile_primitive.ml | 2 +- jscomp/core/lam_constant_convert.ml | 2 +- jscomp/core/lam_convert.ml | 8 +- jscomp/core/lam_pass_alpha_conversion.ml | 6 +- jscomp/core/lam_pass_deep_flatten.ml | 6 +- jscomp/ext/ext_cmp.ml | 2 +- jscomp/ext/ext_cmp.mli | 2 +- jscomp/ext/ext_string_array.ml | 42 +- jscomp/ext/js_reserved_map.ml | 18 +- jscomp/ext/warnings.ml | 12 +- jscomp/ext/warnings.mli | 4 +- jscomp/frontend/ast_core_type.ml | 4 +- jscomp/frontend/ast_derive_abstract.ml | 32 +- jscomp/frontend/ast_derive_abstract.mli | 8 +- jscomp/frontend/ast_derive_js_mapper.ml | 172 +- jscomp/frontend/ast_derive_projector.ml | 12 +- jscomp/frontend/ast_derive_util.ml | 10 +- jscomp/frontend/ast_derive_util.mli | 2 +- jscomp/frontend/ast_exp_apply.ml | 4 +- jscomp/frontend/ast_exp_extension.ml | 6 +- jscomp/frontend/ast_exp_handle_external.ml | 6 +- jscomp/frontend/ast_external.ml | 4 +- jscomp/frontend/ast_external.mli | 4 +- jscomp/frontend/ast_external_process.ml | 58 +- jscomp/frontend/ast_signature.ml | 2 +- jscomp/frontend/ast_signature.mli | 2 +- jscomp/frontend/ast_structure.ml | 2 +- jscomp/frontend/ast_structure.mli | 2 +- jscomp/frontend/ast_tdcls.ml | 56 +- jscomp/frontend/ast_tdcls.mli | 4 +- jscomp/frontend/ast_typ_uncurry.ml | 2 +- jscomp/frontend/ast_uncurry_gen.ml | 2 +- jscomp/frontend/bs_builtin_ppx.ml | 22 +- jscomp/frontend/bs_syntaxerr.ml | 2 +- jscomp/frontend/bs_syntaxerr.mli | 2 +- jscomp/frontend/lam_constant.ml | 4 +- jscomp/frontend/lam_constant.mli | 2 +- jscomp/frontend/ppx_entry.ml | 20 +- jscomp/gentype/Annotation.ml | 240 +- jscomp/gentype/CodeItem.ml | 60 +- jscomp/gentype/Converter.ml | 76 +- jscomp/gentype/Debug.ml | 52 +- jscomp/gentype/Dependencies.ml | 80 +- jscomp/gentype/EmitJs.ml | 702 +- jscomp/gentype/EmitText.ml | 10 +- jscomp/gentype/EmitType.ml | 382 +- jscomp/gentype/Emitters.ml | 46 +- jscomp/gentype/Emitters.mli | 6 +- jscomp/gentype/ExportModule.ml | 158 +- jscomp/gentype/GenIdent.ml | 18 +- jscomp/gentype/GenTypeCommon.ml | 122 +- jscomp/gentype/GenTypeConfig.ml | 228 +- jscomp/gentype/GenTypeMain.ml | 184 +- jscomp/gentype/GeneratedFiles.ml | 38 +- jscomp/gentype/ImportPath.ml | 20 +- jscomp/gentype/ImportPath.mli | 10 +- jscomp/gentype/Indent.ml | 4 +- jscomp/gentype/Log_.ml | 12 +- jscomp/gentype/ModuleExtension.ml | 28 +- jscomp/gentype/ModuleName.ml | 14 +- jscomp/gentype/ModuleName.mli | 10 +- jscomp/gentype/ModuleResolver.ml | 258 +- jscomp/gentype/NamedArgs.ml | 12 +- jscomp/gentype/Paths.ml | 70 +- jscomp/gentype/ResolvedName.ml | 36 +- jscomp/gentype/ResolvedName.mli | 8 +- jscomp/gentype/Runtime.ml | 24 +- jscomp/gentype/Runtime.mli | 18 +- jscomp/gentype/TranslateCoreType.ml | 292 +- jscomp/gentype/TranslateSignature.ml | 154 +- jscomp/gentype/TranslateSignatureFromTypes.ml | 114 +- jscomp/gentype/TranslateStructure.ml | 330 +- jscomp/gentype/TranslateTypeDeclarations.ml | 358 +- jscomp/gentype/TranslateTypeExprFromTypes.ml | 502 +- jscomp/gentype/Translation.ml | 218 +- jscomp/gentype/TypeEnv.ml | 224 +- jscomp/gentype/TypeEnv.mli | 28 +- jscomp/gentype/TypeVars.ml | 70 +- jscomp/jsoo/jsoo_playground_main.ml | 234 +- jscomp/ml/ast_async.ml | 2 +- jscomp/ml/ast_payload.ml | 6 +- jscomp/ml/ast_payload.mli | 2 +- jscomp/ml/ast_uncurried.ml | 46 +- jscomp/ml/ast_uncurried_utils.ml | 2 +- jscomp/ml/ast_untagged_variants.ml | 98 +- jscomp/ml/code_frame.ml | 14 +- jscomp/ml/ctype.ml | 6 +- jscomp/ml/error_message_utils.ml | 76 +- jscomp/ml/includecore.ml | 6 +- jscomp/ml/lambda.ml | 4 +- jscomp/ml/lambda.mli | 2 +- jscomp/ml/location.ml | 8 +- jscomp/ml/transl_recmodule.ml | 2 +- jscomp/ml/translmod.ml | 2 +- jscomp/ml/typecore.ml | 174 +- jscomp/ml/typecore.mli | 2 +- jscomp/ml/typedecl.ml | 50 +- jscomp/ml/variant_coercion.ml | 16 +- jscomp/syntax/benchmarks/Benchmark.ml | 142 +- jscomp/syntax/benchmarks/data/HeroGraphic.ml | 48 +- jscomp/syntax/benchmarks/data/Napkinscript.ml | 12350 ++++++++-------- .../syntax/benchmarks/data/PrinterNapkin.ml | 702 +- jscomp/syntax/benchmarks/data/PrinterOcaml.ml | 2084 +-- jscomp/syntax/benchmarks/data/RedBlackTree.ml | 476 +- jscomp/syntax/cli/res_cli.ml | 104 +- jscomp/syntax/src/jsx_common.ml | 52 +- jscomp/syntax/src/jsx_ppx.ml | 116 +- jscomp/syntax/src/jsx_ppx.mli | 12 +- jscomp/syntax/src/jsx_v4.ml | 1152 +- jscomp/syntax/src/reactjs_jsx_v3.ml | 826 +- jscomp/syntax/src/res_ast_conversion.ml | 256 +- jscomp/syntax/src/res_ast_conversion.mli | 4 +- jscomp/syntax/src/res_ast_debugger.ml | 538 +- jscomp/syntax/src/res_ast_debugger.mli | 6 +- jscomp/syntax/src/res_comment.ml | 34 +- jscomp/syntax/src/res_comment.mli | 24 +- jscomp/syntax/src/res_comments_table.ml | 1876 +-- jscomp/syntax/src/res_core.ml | 4506 +++--- jscomp/syntax/src/res_core.mli | 4 +- jscomp/syntax/src/res_diagnostics.ml | 72 +- jscomp/syntax/src/res_diagnostics.mli | 16 +- jscomp/syntax/src/res_doc.ml | 190 +- jscomp/syntax/src/res_doc.mli | 30 +- jscomp/syntax/src/res_driver.ml | 112 +- jscomp/syntax/src/res_driver.mli | 48 +- jscomp/syntax/src/res_driver_binary.ml | 6 +- jscomp/syntax/src/res_driver_binary.mli | 2 +- jscomp/syntax/src/res_driver_ml_parser.ml | 50 +- jscomp/syntax/src/res_driver_ml_parser.mli | 6 +- jscomp/syntax/src/res_grammar.ml | 124 +- jscomp/syntax/src/res_io.ml | 4 +- jscomp/syntax/src/res_io.mli | 4 +- jscomp/syntax/src/res_multi_printer.ml | 88 +- jscomp/syntax/src/res_multi_printer.mli | 2 +- jscomp/syntax/src/res_outcome_printer.ml | 590 +- jscomp/syntax/src/res_outcome_printer.mli | 6 +- jscomp/syntax/src/res_parens.ml | 268 +- jscomp/syntax/src/res_parens.mli | 46 +- jscomp/syntax/src/res_parser.ml | 142 +- jscomp/syntax/src/res_parser.mli | 32 +- jscomp/syntax/src/res_parsetree_viewer.ml | 380 +- jscomp/syntax/src/res_parsetree_viewer.mli | 126 +- jscomp/syntax/src/res_printer.ml | 4126 +++--- jscomp/syntax/src/res_printer.mli | 26 +- jscomp/syntax/src/res_reporting.ml | 2 +- jscomp/syntax/src/res_scanner.ml | 390 +- jscomp/syntax/src/res_scanner.mli | 22 +- jscomp/syntax/src/res_string.ml | 12 +- jscomp/syntax/src/res_token.ml | 16 +- jscomp/syntax/src/res_uncurried.ml | 4 +- jscomp/syntax/src/res_utf8.ml | 16 +- jscomp/syntax/src/res_utf8.mli | 6 +- jscomp/syntax/testrunner/res_test.ml | 58 +- jscomp/syntax/testrunner/res_utf8_test.ml | 42 +- 171 files changed, 19537 insertions(+), 19537 deletions(-) diff --git a/jscomp/bsc/rescript_compiler_main.ml b/jscomp/bsc/rescript_compiler_main.ml index 33d043cb8e..1642a74bb6 100644 --- a/jscomp/bsc/rescript_compiler_main.ml +++ b/jscomp/bsc/rescript_compiler_main.ml @@ -72,13 +72,13 @@ let process_file sourcefile ?(kind ) ppf = let sourcefile = set_abs_input_name sourcefile in setup_compiler_printer `rescript; Js_implementation.implementation - ~parser:(Res_driver.parse_implementation ~ignoreParseErrors:!Clflags.ignore_parse_errors) + ~parser:(Res_driver.parse_implementation ~ignore_parse_errors:!Clflags.ignore_parse_errors) ppf sourcefile | Resi -> let sourcefile = set_abs_input_name sourcefile in setup_compiler_printer `rescript; Js_implementation.interface - ~parser:(Res_driver.parse_interface ~ignoreParseErrors:!Clflags.ignore_parse_errors) + ~parser:(Res_driver.parse_interface ~ignore_parse_errors:!Clflags.ignore_parse_errors) ppf sourcefile | Intf_ast -> @@ -113,32 +113,32 @@ let reprint_source_file sourcefile = let sourcefile = set_abs_input_name sourcefile in let res = match kind with | Res -> - let parseResult = - Res_driver.parsingEngine.parseImplementation ~forPrinter:true ~filename:sourcefile + let parse_result = + Res_driver.parsing_engine.parse_implementation ~for_printer:true ~filename:sourcefile in - if parseResult.invalid then ( - Res_diagnostics.printReport parseResult.diagnostics parseResult.source; + if parse_result.invalid then ( + Res_diagnostics.print_report parse_result.diagnostics parse_result.source; exit 1 ); Res_compmisc.init_path (); - parseResult.parsetree + parse_result.parsetree |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name Ml |> Ppx_entry.rewrite_implementation - |> Res_printer.printImplementation ~width:100 ~comments:parseResult.comments + |> Res_printer.print_implementation ~width:100 ~comments:parse_result.comments |> print_endline | Resi -> - let parseResult = - Res_driver.parsingEngine.parseInterface ~forPrinter:true ~filename:sourcefile + let parse_result = + Res_driver.parsing_engine.parse_interface ~for_printer:true ~filename:sourcefile in - if parseResult.invalid then ( - Res_diagnostics.printReport parseResult.diagnostics parseResult.source; + if parse_result.invalid then ( + Res_diagnostics.print_report parse_result.diagnostics parse_result.source; exit 1 ); Res_compmisc.init_path (); - parseResult.parsetree + parse_result.parsetree |> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name Mli |> Ppx_entry.rewrite_signature - |> Res_printer.printInterface ~width:100 ~comments:parseResult.comments + |> Res_printer.print_interface ~width:100 ~comments:parse_result.comments |> print_endline | _ -> @@ -198,7 +198,7 @@ let format_file input = | Ml | Mli -> `ml | Res | Resi -> `res | _ -> Bsc_args.bad_arg ("don't know what to do with " ^ input) in - let formatted = Res_multi_printer.print ~ignoreParseErrors:!Clflags.ignore_parse_errors syntax ~input in + let formatted = Res_multi_printer.print ~ignore_parse_errors:!Clflags.ignore_parse_errors syntax ~input in match !Clflags.output_name with | None -> output_string stdout formatted @@ -293,11 +293,11 @@ let buckle_script_flags : (string * Bsc_args.spec * string) array = "*internal* Set jsx version"; "-bs-jsx-module", string_call (fun i -> - let isGeneric = match i |> String.lowercase_ascii with + let is_generic = match i |> String.lowercase_ascii with | "react" -> false | _ -> true in Js_config.jsx_module := Js_config.jsx_module_of_string i; - if isGeneric then ( + if is_generic then ( Js_config.jsx_mode := Automatic; Js_config.jsx_version := Some Jsx_v4 )), diff --git a/jscomp/common/js_config.ml b/jscomp/common/js_config.ml index 379555b5f0..7d8bb61b99 100644 --- a/jscomp/common/js_config.ml +++ b/jscomp/common/js_config.ml @@ -25,7 +25,7 @@ (** Browser is not set via command line only for internal use *) type jsx_version = Jsx_v3 | Jsx_v4 -type jsx_module = React | Generic of {moduleName: string} +type jsx_module = React | Generic of {module_name: string} type jsx_mode = Classic | Automatic let no_version_header = ref false @@ -63,7 +63,7 @@ let int_of_jsx_version = function let string_of_jsx_module = function | React -> "react" -| Generic {moduleName} -> moduleName +| Generic {module_name} -> module_name let string_of_jsx_mode = function | Classic -> "classic" @@ -76,7 +76,7 @@ let jsx_version_of_int = function let jsx_module_of_string = function | "react" -> React -| moduleName -> Generic {moduleName} +| module_name -> Generic {module_name} let jsx_mode_of_string = function | "classic" -> Classic diff --git a/jscomp/common/js_config.mli b/jscomp/common/js_config.mli index c162e0c86c..ac3df0c8f0 100644 --- a/jscomp/common/js_config.mli +++ b/jscomp/common/js_config.mli @@ -23,7 +23,7 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) type jsx_version = Jsx_v3 | Jsx_v4 -type jsx_module = React | Generic of {moduleName: string} +type jsx_module = React | Generic of {module_name: string} type jsx_mode = Classic | Automatic (* val get_packages_info : diff --git a/jscomp/common/pattern_printer.ml b/jscomp/common/pattern_printer.ml index 8648f23d77..0ca6dd96c6 100644 --- a/jscomp/common/pattern_printer.ml +++ b/jscomp/common/pattern_printer.ml @@ -7,11 +7,11 @@ let mkpat desc = Ast_helper.Pat.mk desc let untype typed = let rec loop pat = match pat.pat_desc with - | Tpat_or (p1, { pat_desc = Tpat_or (p2, p3, rI) }, rO) -> + | Tpat_or (p1, { pat_desc = Tpat_or (p2, p3, r_i) }, r_o) -> (* Turn A | (B | C) into (A | B) | C for pretty printing without parens *) - let newInner = { pat with pat_desc = Tpat_or (p1, p2, rI) } in - let newOuter = { pat with pat_desc = Tpat_or (newInner, p3, rO) } in - loop newOuter + let new_inner = { pat with pat_desc = Tpat_or (p1, p2, r_i) } in + let new_outer = { pat with pat_desc = Tpat_or (new_inner, p3, r_o) } in + loop new_outer | Tpat_or (pa, pb, _) -> mkpat (Ppat_or (loop pa, loop pb)) | Tpat_any | Tpat_var _ -> mkpat Ppat_any | Tpat_constant c -> mkpat (Ppat_constant (Untypeast.constant c)) @@ -44,5 +44,5 @@ let untype typed = let print_pattern typed = let pat = untype typed in - let doc = Res_printer.printPattern pat Res_comments_table.empty in - Res_doc.toString ~width:80 doc + let doc = Res_printer.print_pattern pat Res_comments_table.empty in + Res_doc.to_string ~width:80 doc diff --git a/jscomp/core/bs_conditional_initial.ml b/jscomp/core/bs_conditional_initial.ml index 52010a4bb4..7bf62e708f 100644 --- a/jscomp/core/bs_conditional_initial.ml +++ b/jscomp/core/bs_conditional_initial.ml @@ -49,7 +49,7 @@ let setup_env () = Rescript_cpp.replace_directive_bool "BS" true; Rescript_cpp.replace_directive_bool "JS" true; - Printtyp.print_res_poly_identifier := Res_printer.polyVarIdentToString; + Printtyp.print_res_poly_identifier := Res_printer.poly_var_ident_to_string; Rescript_cpp.replace_directive_string "BS_VERSION" Bs_version.version (*; Switch.cut := 100*) (* tweakable but not very useful *) diff --git a/jscomp/core/j.ml b/jscomp/core/j.ml index fca04904fe..3ab6112495 100644 --- a/jscomp/core/j.ml +++ b/jscomp/core/j.ml @@ -160,7 +160,7 @@ and expression_desc = *) | Number of number | Object of property_map - | Undefined of {isUnit: bool} + | Undefined of {is_unit: bool} | Null | Await of expression diff --git a/jscomp/core/js_cmj_format.ml b/jscomp/core/js_cmj_format.ml index 9f33ebc7e5..20d3a52262 100644 --- a/jscomp/core/js_cmj_format.ml +++ b/jscomp/core/js_cmj_format.ml @@ -104,57 +104,57 @@ let to_file name ~check_exists (v : t) = output_string oc s; close_out oc) -let keyComp (a : string) b = Map_string.compare_key a b.name +let key_comp (a : string) b = Map_string.compare_key a b.name let not_found key = { name = key; arity = single_na; persistent_closed_lambda = None } -let get_result midVal = - match midVal.persistent_closed_lambda with +let get_result mid_val = + match mid_val.persistent_closed_lambda with | Some (Lconst (Const_js_null | Const_js_undefined _ | Const_js_true | Const_js_false)) | None -> - midVal + mid_val | Some _ -> - if !Js_config.cross_module_inline then midVal - else { midVal with persistent_closed_lambda = None } + if !Js_config.cross_module_inline then mid_val + else { mid_val with persistent_closed_lambda = None } -let rec binarySearchAux arr lo hi (key : string) = +let rec binary_search_aux arr lo hi (key : string) = let mid = (lo + hi) / 2 in - let midVal = Array.unsafe_get arr mid in - let c = keyComp key midVal in - if c = 0 then get_result midVal + let mid_val = Array.unsafe_get arr mid in + let c = key_comp key mid_val in + if c = 0 then get_result mid_val else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *) if hi = mid then - let loVal = Array.unsafe_get arr lo in - if loVal.name = key then get_result loVal else not_found key - else binarySearchAux arr lo mid key + let lo_val = Array.unsafe_get arr lo in + if lo_val.name = key then get_result lo_val else not_found key + else binary_search_aux arr lo mid key else if (* a[lo] =< a[mid] < key <= a[hi] *) lo = mid then - let hiVal = Array.unsafe_get arr hi in - if hiVal.name = key then get_result hiVal else not_found key - else binarySearchAux arr mid hi key + let hi_val = Array.unsafe_get arr hi in + if hi_val.name = key then get_result hi_val else not_found key + else binary_search_aux arr mid hi key -let binarySearch (sorted : keyed_cmj_values) (key : string) : keyed_cmj_value = +let binary_search (sorted : keyed_cmj_values) (key : string) : keyed_cmj_value = let len = Array.length sorted in if len = 0 then not_found key else let lo = Array.unsafe_get sorted 0 in - let c = keyComp key lo in + let c = key_comp key lo in if c < 0 then not_found key else let hi = Array.unsafe_get sorted (len - 1) in - let c2 = keyComp key hi in - if c2 > 0 then not_found key else binarySearchAux sorted 0 (len - 1) key + let c2 = key_comp key hi in + if c2 > 0 then not_found key else binary_search_aux sorted 0 (len - 1) key (* FIXME: better error message when ocamldep get self-cycle *) let query_by_name (cmj_table : t) name : keyed_cmj_value = let values = cmj_table.values in - binarySearch values name + binary_search values name type path = string diff --git a/jscomp/core/js_dump.ml b/jscomp/core/js_dump.ml index 121a0f3182..4a6abca10b 100644 --- a/jscomp/core/js_dump.ml +++ b/jscomp/core/js_dump.ml @@ -524,7 +524,7 @@ and expression_desc cxt ~(level : int) f x : cxt = params body env | _ -> let el = match el with - | [e] when e.expression_desc = Undefined {isUnit = true} -> + | [e] when e.expression_desc = Undefined {is_unit = true} -> (* omit passing undefined when the call is f() *) [] | _ -> @@ -548,8 +548,8 @@ and expression_desc cxt ~(level : int) f x : cxt = P.string f L.null; comma_sp f; expression ~level:1 cxt f el)) - | Tagged_template (callExpr, stringArgs, valueArgs) -> - let cxt = expression cxt ~level f callExpr in + | Tagged_template (call_expr, string_args, value_args) -> + let cxt = expression cxt ~level f call_expr in P.string f "`"; let rec aux cxt xs ys = match xs, ys with | [], [] -> () @@ -563,14 +563,14 @@ and expression_desc cxt ~(level : int) f x : cxt = aux cxt x_rest y_rest | _ -> assert false in - aux cxt stringArgs valueArgs; + aux cxt string_args value_args; P.string f "`"; cxt | String_index (a, b) -> P.group f 1 (fun _ -> let cxt = expression ~level:15 cxt f a in P.string f L.dot; - P.string f L.codePointAt; + P.string f L.code_point_at; (* FIXME: use code_point_at *) P.paren_group f 1 (fun _ -> expression ~level:0 cxt f b)) | Str { delim; txt } -> diff --git a/jscomp/core/js_dump_import_export.ml b/jscomp/core/js_dump_import_export.ml index b6e32d4dd9..18b23a58ea 100644 --- a/jscomp/core/js_dump_import_export.ml +++ b/jscomp/core/js_dump_import_export.ml @@ -27,7 +27,7 @@ module L = Js_dump_lit let default_export = "default" -let esModule = ("__esModule", "true") +let es_module = ("__esModule", "true") (* Exports printer *) let rev_iter_inter lst f inter = @@ -50,7 +50,7 @@ let exports cxt f (idents : Ident.t list) = ( cxt, if id_name = default_export then (* TODO check how it will affect AMDJS*) - esModule :: (default_export, str) :: acc + es_module :: (default_export, str) :: acc else (s, str) :: acc )) in P.at_least_two_lines f; @@ -124,23 +124,23 @@ let requires require_lit cxt f (modules : (Ident.t * string * bool) list) = P.newline f); outer_cxt -let dumpImportAttributes f (importAttributes : External_ffi_types.import_attributes option) = - match importAttributes with +let dump_import_attributes f (import_attributes : External_ffi_types.import_attributes option) = + match import_attributes with | None -> () - | Some importAttributes -> + | Some import_attributes -> P.space f; P.string f "with"; P.space f; - let total = Hashtbl.length importAttributes in + let total = Hashtbl.length import_attributes in let idx = ref 1 in P.brace_group f 0 ( fun _ -> - importAttributes |> Hashtbl.iter(fun key value -> + import_attributes |> Hashtbl.iter(fun key value -> Js_dump_string.pp_string f key; P.string f L.colon_space; Js_dump_string.pp_string f value; - let shouldAddComma = !idx < total in - if shouldAddComma then ( + let should_add_comma = !idx < total in + if should_add_comma then ( P.string f L.comma; P.space f ); @@ -166,7 +166,7 @@ let imports cxt f (modules : (Ident.t * string * bool * External_ffi_types.impor P.string f L.from; P.space f; Js_dump_string.pp_string f file; - dumpImportAttributes f import_attributes) + dump_import_attributes f import_attributes) else ( P.string f L.star; P.space f; @@ -178,7 +178,7 @@ let imports cxt f (modules : (Ident.t * string * bool * External_ffi_types.impor P.string f L.from; P.space f; Js_dump_string.pp_string f file; - dumpImportAttributes f import_attributes); + dump_import_attributes f import_attributes); P.string f L.semi; P.newline f); outer_cxt diff --git a/jscomp/core/js_dump_lit.ml b/jscomp/core/js_dump_lit.ml index b90eab0b25..104e4252b7 100644 --- a/jscomp/core/js_dump_lit.ml +++ b/jscomp/core/js_dump_lit.ml @@ -66,7 +66,7 @@ let default = "default" let length = "length" -let codePointAt = "codePointAt" +let code_point_at = "codePointAt" let new_ = "new" @@ -136,7 +136,7 @@ let undefined = "undefined" let string_cap = "String" -let fromCharcode = "fromCharCode" +let from_charcode = "fromCharCode" let eq = "=" diff --git a/jscomp/core/js_exp_make.ml b/jscomp/core/js_exp_make.ml index c9d5136ccf..79f2477e9e 100644 --- a/jscomp/core/js_exp_make.ml +++ b/jscomp/core/js_exp_make.ml @@ -60,7 +60,7 @@ let var ?comment id : t = { expression_desc = Var (Id id); comment } Invariant: it should not call an external module .. *) let js_global ?comment (v : string) = var ?comment (Ext_ident.create_js v) -let undefined : t = { expression_desc = Undefined {isUnit = false}; comment = None } +let undefined : t = { expression_desc = Undefined {is_unit = false}; comment = None } let nil : t = { expression_desc = Null; comment = None } let call ?comment ~info e0 args : t = @@ -72,8 +72,8 @@ let call ?comment ~info e0 args : t = let flat_call ?comment e0 es : t = { expression_desc = FlatCall (e0, es); comment } -let tagged_template ?comment callExpr stringArgs valueArgs : t = - { expression_desc = Tagged_template (callExpr, stringArgs, valueArgs); comment } +let tagged_template ?comment call_expr string_args value_args : t = + { expression_desc = Tagged_template (call_expr, string_args, value_args); comment } let runtime_var_dot ?comment (x : string) (e1 : string) : J.expression = { @@ -186,7 +186,7 @@ let is_array (e0 : t) : t = let new_ ?comment e0 args : t = { expression_desc = New (e0, Some args); comment } -let unit : t = { expression_desc = Undefined {isUnit = true}; comment = None } +let unit : t = { expression_desc = Undefined {is_unit = true}; comment = None } (* let math ?comment v args : t = {comment ; expression_desc = Math(v,args)} *) @@ -207,8 +207,8 @@ let unit : t = { expression_desc = Undefined {isUnit = true}; comment = None } [Js_fun_env.empty] is a mutable state .. *) -let ocaml_fun ?comment ?immutable_mask ~return_unit ~async ~oneUnitArg ?directive params body : t = - let params = if oneUnitArg then [] else params in +let ocaml_fun ?comment ?immutable_mask ~return_unit ~async ~one_unit_arg ?directive params body : t = + let params = if one_unit_arg then [] else params in let len = List.length params in { expression_desc = diff --git a/jscomp/core/js_exp_make.mli b/jscomp/core/js_exp_make.mli index 0f25e3c0f9..c1a7af03cd 100644 --- a/jscomp/core/js_exp_make.mli +++ b/jscomp/core/js_exp_make.mli @@ -90,7 +90,7 @@ val ocaml_fun : ?immutable_mask:bool array -> return_unit:bool -> async:bool -> - oneUnitArg:bool -> + one_unit_arg:bool -> ?directive:string -> J.ident list -> J.block -> diff --git a/jscomp/core/js_implementation.ml b/jscomp/core/js_implementation.ml index 01b1229259..e26a6abe3f 100644 --- a/jscomp/core/js_implementation.ml +++ b/jscomp/core/js_implementation.ml @@ -42,7 +42,7 @@ let output_deps_set name set = output_string stdout "\n" let process_with_gentype cmt_file = - if !Clflags.bs_gentype then GenTypeMain.processCmtFile cmt_file + if !Clflags.bs_gentype then GenTypeMain.process_cmt_file cmt_file let after_parsing_sig ppf outputprefix ast = if !Clflags.only_parse = false then ( diff --git a/jscomp/core/lam.ml b/jscomp/core/lam.ml index 383817194a..bba04cba7f 100644 --- a/jscomp/core/lam.ml +++ b/jscomp/core/lam.ml @@ -423,7 +423,7 @@ let stringswitch (lam : t) cases default : t = let true_ : t = Lconst Const_js_true let false_ : t = Lconst Const_js_false -let unit : t = Lconst (Const_js_undefined {isUnit = true}) +let unit : t = Lconst (Const_js_undefined {is_unit = true}) let rec seq (a : t) b : t = match a with diff --git a/jscomp/core/lam_compile.ml b/jscomp/core/lam_compile.ml index 49a05f3de5..6f192c1bbc 100644 --- a/jscomp/core/lam_compile.ml +++ b/jscomp/core/lam_compile.ml @@ -56,7 +56,7 @@ let rec apply_with_arity_aux (fn : J.expression) (arity : int list) let params = Ext_list.init (x - len) (fun _ -> Ext_ident.create "param") in - E.ocaml_fun params ~return_unit:false (* unknown info *) ~async:false ~oneUnitArg:false + E.ocaml_fun params ~return_unit:false (* unknown info *) ~async:false ~one_unit_arg:false [ S.return_stmt (E.call @@ -319,7 +319,7 @@ and compile_external_field_apply ?(dynamic_import = false) (appinfo : Lam.apply) and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t) (id : Ident.t) (arg : Lam.t) : Js_output.t * initialization = match arg with - | Lfunction { params; body; attr = { return_unit; async; oneUnitArg; directive } } -> + | Lfunction { params; body; attr = { return_unit; async; one_unit_arg; directive } } -> (* TODO: Think about recursive value {[ let rec v = ref (fun _ ... @@ -357,7 +357,7 @@ and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t) it will be renamed into [method] when it is detected by a primitive *) - ~return_unit ~async ~oneUnitArg ?directive ~immutable_mask:ret.immutable_mask + ~return_unit ~async ~one_unit_arg ?directive ~immutable_mask:ret.immutable_mask (Ext_list.map params (fun x -> Map_ident.find_default ret.new_params x x)) [ @@ -368,7 +368,7 @@ and compile_recursive_let ~all_bindings (cxt : Lam_compile_context.t) ] else (* TODO: save computation of length several times *) - E.ocaml_fun params (Js_output.output_as_block output) ~return_unit ~async ~oneUnitArg ?directive + E.ocaml_fun params (Js_output.output_as_block output) ~return_unit ~async ~one_unit_arg ?directive in ( Js_output.output_of_expression (Declare (Alias, id)) @@ -772,8 +772,8 @@ and compile_untagged_cases ~cxt ~switch_exp ~default ~block_cases cases = let switch ?default ?declaration e clauses = let (not_typeof_clauses, typeof_clauses) = List.partition is_not_typeof clauses in let rec build_if_chain remaining_clauses = (match remaining_clauses with - | (Ast_untagged_variants.Untagged (InstanceType instanceType), {J.switch_body}) :: rest -> - S.if_ (E.emit_check (IsInstanceOf (instanceType, Expr e))) + | (Ast_untagged_variants.Untagged (InstanceType instance_type), {J.switch_body}) :: rest -> + S.if_ (E.emit_check (IsInstanceOf (instance_type, Expr e))) (switch_body) ~else_:([build_if_chain rest]) | _ -> S.string_switch ?default ?declaration (E.typeof e) typeof_clauses) in @@ -1670,10 +1670,10 @@ and compile_prim (prim_info : Lam.prim_info) and compile_lambda (lambda_cxt : Lam_compile_context.t) (cur_lam : Lam.t) : Js_output.t = match cur_lam with - | Lfunction { params; body; attr = { return_unit; async; oneUnitArg; directive } } -> + | Lfunction { params; body; attr = { return_unit; async; one_unit_arg; directive } } -> Js_output.output_of_expression lambda_cxt.continuation ~no_effects:no_effects_const - (E.ocaml_fun params ~return_unit ~async ~oneUnitArg ?directive + (E.ocaml_fun params ~return_unit ~async ~one_unit_arg ?directive (* Invariant: jmp_table can not across function boundary, here we share env *) diff --git a/jscomp/core/lam_compile_const.ml b/jscomp/core/lam_compile_const.ml index 7c56808160..275f17830c 100644 --- a/jscomp/core/lam_compile_const.ml +++ b/jscomp/core/lam_compile_const.ml @@ -37,7 +37,7 @@ let rec nested_some_none n none = let rec translate_some (x : Lam_constant.t) : J.expression = let depth = is_some_none_aux x 0 in if depth < 0 then E.optional_not_nest_block (translate x) - else nested_some_none depth (E.optional_block (translate (Const_js_undefined {isUnit = false}))) + else nested_some_none depth (E.optional_block (translate (Const_js_undefined {is_unit = false}))) and translate (x : Lam_constant.t) : J.expression = match x with @@ -46,8 +46,8 @@ and translate (x : Lam_constant.t) : J.expression = | Const_js_true -> E.bool true | Const_js_false -> E.bool false | Const_js_null -> E.nil - | Const_js_undefined {isUnit = true} -> E.unit - | Const_js_undefined {isUnit = false} -> E.undefined + | Const_js_undefined {is_unit = true} -> E.unit + | Const_js_undefined {is_unit = false} -> E.undefined | Const_int { i; comment = Pt_constructor {cstr_name={name; tag_type=None}}} when name <> "[]" -> E.str name | Const_int { i; comment = Pt_constructor {cstr_name={tag_type = Some t}}} -> diff --git a/jscomp/core/lam_compile_external_call.ml b/jscomp/core/lam_compile_external_call.ml index 77a982ccd1..e663861f8b 100644 --- a/jscomp/core/lam_compile_external_call.ml +++ b/jscomp/core/lam_compile_external_call.ml @@ -155,7 +155,7 @@ let keep_non_undefined_args (arg_types : specs) (args : exprs) = let rec has_undefined_trailing_args arg_types args = match (arg_types, args) with | ( [{External_arg_spec.arg_label = Arg_optional; _}], - [{J.expression_desc = Undefined {isUnit = false}; _}] ) -> + [{J.expression_desc = Undefined {is_unit = false}; _}] ) -> true | ( _ :: arg_types_rest, _ :: args_rest ) -> has_undefined_trailing_args arg_types_rest args_rest @@ -164,7 +164,7 @@ let keep_non_undefined_args (arg_types : specs) (args : exprs) = let rec aux arg_types args = match (arg_types, args) with | ( {External_arg_spec.arg_label = Arg_optional; _} :: arg_types_rest, - {J.expression_desc = Undefined {isUnit = false}; _} :: args_rest ) -> + {J.expression_desc = Undefined {is_unit = false}; _} :: args_rest ) -> aux arg_types_rest args_rest | _ -> args in diff --git a/jscomp/core/lam_compile_primitive.ml b/jscomp/core/lam_compile_primitive.ml index f78c5deaeb..b400f014ee 100644 --- a/jscomp/core/lam_compile_primitive.ml +++ b/jscomp/core/lam_compile_primitive.ml @@ -63,7 +63,7 @@ let wrap_then import value = ~info:{ arity = Full; call_info = Call_na } (E.dot import "then") [ - E.ocaml_fun ~return_unit:false ~async:false ~oneUnitArg:false [ arg ] + E.ocaml_fun ~return_unit:false ~async:false ~one_unit_arg:false [ arg ] [ { statement_desc = J.Return (E.dot (E.var arg) value); diff --git a/jscomp/core/lam_constant_convert.ml b/jscomp/core/lam_constant_convert.ml index 360eb55db3..91e2201a1d 100644 --- a/jscomp/core/lam_constant_convert.ml +++ b/jscomp/core/lam_constant_convert.ml @@ -39,7 +39,7 @@ let rec convert_constant (const : Lambda.structured_constant) : Lam_constant.t = | Const_base (Const_bigint (sign, i)) -> Const_bigint (sign, i) | Const_pointer (0, Pt_constructor { name = "()"; const = 1; non_const = 0 }) -> - Const_js_undefined {isUnit = true} + Const_js_undefined {is_unit = true} | Const_false -> Const_js_false | Const_true -> Const_js_true | Const_pointer (i, p) -> ( diff --git a/jscomp/core/lam_convert.ml b/jscomp/core/lam_convert.ml index 8264a60310..107c7be959 100644 --- a/jscomp/core/lam_convert.ml +++ b/jscomp/core/lam_convert.ml @@ -455,7 +455,7 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : | _ when s = "#null" -> Lam.const Const_js_null | _ when s = "#os_type" -> prim ~primitive:(Pctconst Ostype) ~args:[ unit ] loc - | _ when s = "#undefined" -> Lam.const (Const_js_undefined {isUnit = false}) + | _ when s = "#undefined" -> Lam.const (Const_js_undefined {is_unit = false}) | _ when s = "#init_mod" -> ( let args = Ext_list.map args convert_aux in match args with @@ -596,10 +596,10 @@ let convert (exports : Set_ident.t) (lam : Lambda.lambda) : let body = convert_aux b in let handler = convert_aux handler in if exception_id_destructed handler id then - let newId = Ident.create ("raw_" ^ id.name) in - Lam.try_ body newId + let new_id = Ident.create ("raw_" ^ id.name) in + Lam.try_ body new_id (Lam.let_ StrictOpt id - (prim ~primitive:Pwrap_exn ~args:[ Lam.var newId ] Location.none) + (prim ~primitive:Pwrap_exn ~args:[ Lam.var new_id ] Location.none) handler) else Lam.try_ body id handler | Lifthenelse (b, then_, else_) -> diff --git a/jscomp/core/lam_pass_alpha_conversion.ml b/jscomp/core/lam_pass_alpha_conversion.ml index aa1fd1b7b6..e00ccf8d3a 100644 --- a/jscomp/core/lam_pass_alpha_conversion.ml +++ b/jscomp/core/lam_pass_alpha_conversion.ml @@ -23,7 +23,7 @@ * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) let alpha_conversion (meta : Lam_stats.t) (lam : Lam.t) : Lam.t = - let rec populateApplyInfo (args_arity : int list) (len : int) (fn : Lam.t) + let rec populate_apply_info (args_arity : int list) (len : int) (fn : Lam.t) (args : Lam.t list) ap_info : Lam.t = match args_arity with | 0 :: _ | [] -> Lam.apply (simpl fn) (Ext_list.map args simpl) ap_info @@ -54,7 +54,7 @@ let alpha_conversion (meta : Lam_stats.t) (lam : Lam.t) : Lam.t = Lam_arity.extract_arity (Lam_arity_analysis.get_arity meta ap_func) in let len = List.length ap_args in - populateApplyInfo args_arity len ap_func ap_args ap_info + populate_apply_info args_arity len ap_func ap_args ap_info | Llet (str, v, l1, l2) -> Lam.let_ str v (simpl l1) (simpl l2) | Lletrec (bindings, body) -> let bindings = Ext_list.map_snd bindings simpl in @@ -72,7 +72,7 @@ let alpha_conversion (meta : Lam_stats.t) (lam : Lam.t) : Lam.t = | Lprim { primitive = Pjs_fn_make_unit; args = [ arg ]; loc } -> let arg = match arg with | Lfunction ({arity=1; params=[x]; attr; body}) when Ident.name x = "param" (* "()" *) -> - Lam.function_ ~params:[x] ~attr:{attr with oneUnitArg=true} ~body ~arity:1 + Lam.function_ ~params:[x] ~attr:{attr with one_unit_arg=true} ~body ~arity:1 | _ -> arg in simpl arg | Lprim { primitive; args; loc } -> diff --git a/jscomp/core/lam_pass_deep_flatten.ml b/jscomp/core/lam_pass_deep_flatten.ml index 73d8814434..c33a1e869b 100644 --- a/jscomp/core/lam_pass_deep_flatten.ml +++ b/jscomp/core/lam_pass_deep_flatten.ml @@ -141,11 +141,11 @@ let deep_flatten (lam : Lam.t) : Lam.t = args = [ arg ]; }, body ) -> - let newId = Ident.rename id in + let new_id = Ident.rename id in flatten acc - (Lam.let_ str newId arg + (Lam.let_ str new_id arg (Lam.let_ Alias id - (Lam.prim ~primitive ~args:[ Lam.var newId ] + (Lam.prim ~primitive ~args:[ Lam.var new_id ] Location.none (* FIXME*)) body)) | Llet (str, id, arg, body) -> ( diff --git a/jscomp/ext/ext_cmp.ml b/jscomp/ext/ext_cmp.ml index e14746cea5..86e966e152 100644 --- a/jscomp/ext/ext_cmp.ml +++ b/jscomp/ext/ext_cmp.ml @@ -2,7 +2,7 @@ type 'a compare = 'a -> 'a -> int type ('a, 'id) cmp = 'a compare -external getCmp : ('a, 'id) cmp -> 'a compare = "%identity" +external get_cmp : ('a, 'id) cmp -> 'a compare = "%identity" module type S = sig type id diff --git a/jscomp/ext/ext_cmp.mli b/jscomp/ext/ext_cmp.mli index 8588d120e6..18fc84654b 100644 --- a/jscomp/ext/ext_cmp.mli +++ b/jscomp/ext/ext_cmp.mli @@ -2,7 +2,7 @@ type 'a compare = 'a -> 'a -> int type ('a, 'id) cmp -external getCmp : ('a, 'id) cmp -> 'a compare = "%identity" +external get_cmp : ('a, 'id) cmp -> 'a compare = "%identity" (** only used for data structures, not exported for client usage *) module type S = sig diff --git a/jscomp/ext/ext_string_array.ml b/jscomp/ext/ext_string_array.ml index 27b8c182d4..94234d6d13 100644 --- a/jscomp/ext/ext_string_array.ml +++ b/jscomp/ext/ext_string_array.ml @@ -25,23 +25,23 @@ (* Invariant: the same as encoding Map_string.compare_key *) let cmp = Ext_string.compare -let rec binarySearchAux (arr : string array) (lo : int) (hi : int) +let rec binary_search_aux (arr : string array) (lo : int) (hi : int) (key : string) : _ option = let mid = (lo + hi) / 2 in - let midVal = Array.unsafe_get arr mid in - let c = cmp key midVal in + let mid_val = Array.unsafe_get arr mid in + let c = cmp key mid_val in if c = 0 then Some mid else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *) if hi = mid then - let loVal = Array.unsafe_get arr lo in - if loVal = key then Some lo else None - else binarySearchAux arr lo mid key + let lo_val = Array.unsafe_get arr lo in + if lo_val = key then Some lo else None + else binary_search_aux arr lo mid key else if (* a[lo] =< a[mid] < key <= a[hi] *) lo = mid then - let hiVal = Array.unsafe_get arr hi in - if hiVal = key then Some hi else None - else binarySearchAux arr mid hi key + let hi_val = Array.unsafe_get arr hi in + if hi_val = key then Some hi else None + else binary_search_aux arr mid hi key let find_sorted sorted key : int option = let len = Array.length sorted in @@ -53,25 +53,25 @@ let find_sorted sorted key : int option = else let hi = Array.unsafe_get sorted (len - 1) in let c2 = cmp key hi in - if c2 > 0 then None else binarySearchAux sorted 0 (len - 1) key + if c2 > 0 then None else binary_search_aux sorted 0 (len - 1) key -let rec binarySearchAssoc (arr : (string * _) array) (lo : int) (hi : int) +let rec binary_search_assoc (arr : (string * _) array) (lo : int) (hi : int) (key : string) : _ option = let mid = (lo + hi) / 2 in - let midVal = Array.unsafe_get arr mid in - let c = cmp key (fst midVal) in - if c = 0 then Some (snd midVal) + let mid_val = Array.unsafe_get arr mid in + let c = cmp key (fst mid_val) in + if c = 0 then Some (snd mid_val) else if c < 0 then (* a[lo] =< key < a[mid] <= a[hi] *) if hi = mid then - let loVal = Array.unsafe_get arr lo in - if fst loVal = key then Some (snd loVal) else None - else binarySearchAssoc arr lo mid key + let lo_val = Array.unsafe_get arr lo in + if fst lo_val = key then Some (snd lo_val) else None + else binary_search_assoc arr lo mid key else if (* a[lo] =< a[mid] < key <= a[hi] *) lo = mid then - let hiVal = Array.unsafe_get arr hi in - if fst hiVal = key then Some (snd hiVal) else None - else binarySearchAssoc arr mid hi key + let hi_val = Array.unsafe_get arr hi in + if fst hi_val = key then Some (snd hi_val) else None + else binary_search_assoc arr mid hi key let find_sorted_assoc (type a) (sorted : (string * a) array) (key : string) : a option = @@ -84,4 +84,4 @@ let find_sorted_assoc (type a) (sorted : (string * a) array) (key : string) : else let hi = Array.unsafe_get sorted (len - 1) in let c2 = cmp key (fst hi) in - if c2 > 0 then None else binarySearchAssoc sorted 0 (len - 1) key + if c2 > 0 then None else binary_search_assoc sorted 0 (len - 1) key diff --git a/jscomp/ext/js_reserved_map.ml b/jscomp/ext/js_reserved_map.ml index c60bea0975..a5eaeeca91 100644 --- a/jscomp/ext/js_reserved_map.ml +++ b/jscomp/ext/js_reserved_map.ml @@ -790,21 +790,21 @@ let sorted_keywords = [| type element = string -let rec binarySearchAux (arr : element array) (lo : int) (hi : int) key : bool = +let rec binary_search_aux (arr : element array) (lo : int) (hi : int) key : bool = let mid = (lo + hi)/2 in - let midVal = Array.unsafe_get arr mid in + let mid_val = Array.unsafe_get arr mid in (* let c = cmp key midVal [@bs] in *) - if key = midVal then true - else if key < midVal then (* a[lo] =< key < a[mid] <= a[hi] *) + if key = mid_val then true + else if key < mid_val then (* a[lo] =< key < a[mid] <= a[hi] *) if hi = mid then (Array.unsafe_get arr lo) = key - else binarySearchAux arr lo mid key + else binary_search_aux arr lo mid key else (* a[lo] =< a[mid] < key <= a[hi] *) if lo = mid then (Array.unsafe_get arr hi) = key - else binarySearchAux arr mid hi key + else binary_search_aux arr mid hi key -let binarySearch (sorted : element array) (key : element) : bool = +let binary_search (sorted : element array) (key : element) : bool = let len = Array.length sorted in if len = 0 then false else @@ -815,6 +815,6 @@ let binarySearch (sorted : element array) (key : element) : bool = let hi = Array.unsafe_get sorted (len - 1) in (* let c2 = cmp key hi [@bs]in *) if key > hi then false - else binarySearchAux sorted 0 (len - 1) key + else binary_search_aux sorted 0 (len - 1) key -let is_reserved s = binarySearch sorted_keywords s +let is_reserved s = binary_search sorted_keywords s diff --git a/jscomp/ext/warnings.ml b/jscomp/ext/warnings.ml index 5e789e81c0..1b04a325a1 100644 --- a/jscomp/ext/warnings.ml +++ b/jscomp/ext/warnings.ml @@ -26,7 +26,7 @@ type loc = { loc_ghost : bool; } -type topLevelUnitHelp = FunctionCall | Other +type top_level_unit_help = FunctionCall | Other type t = | Comment_start (* 1 *) @@ -85,7 +85,7 @@ type t = | Bs_unimplemented_primitive of string (* 106 *) | Bs_integer_literal_overflow (* 107 *) | Bs_uninterpreted_delimiters of string (* 108 *) - | Bs_toplevel_expression_unit of (string * topLevelUnitHelp) option (* 109 *) + | Bs_toplevel_expression_unit of (string * top_level_unit_help) option (* 109 *) | Bs_todo of string option (* 110 *) (* If you remove a warning, leave a hole in the numbering. NEVER change @@ -501,15 +501,15 @@ let message = function | _ -> " ") (match help with - | Some (returnType, _) -> Printf.sprintf "`%s`" returnType + | Some (return_type, _) -> Printf.sprintf "`%s`" return_type | None -> "something that is not `unit`") (match help with - | Some (_, helpTyp) -> - let helpText = (match helpTyp with + | Some (_, help_typ) -> + let help_text = (match help_typ with | FunctionCall -> "yourFunctionCall()" | Other -> "yourExpression") in - Printf.sprintf "\n\n Possible solutions:\n - Assigning to a value that is then ignored: `let _ = %s`\n - Piping into the built-in ignore function to ignore the result: `%s->ignore`" helpText helpText + Printf.sprintf "\n\n Possible solutions:\n - Assigning to a value that is then ignored: `let _ = %s`\n - Piping into the built-in ignore function to ignore the result: `%s->ignore`" help_text help_text | _ -> "") | Bs_todo maybe_text -> ( match maybe_text with diff --git a/jscomp/ext/warnings.mli b/jscomp/ext/warnings.mli index b5dab78bf0..e72f4f980c 100644 --- a/jscomp/ext/warnings.mli +++ b/jscomp/ext/warnings.mli @@ -19,7 +19,7 @@ type loc = { loc_ghost : bool; } -type topLevelUnitHelp = FunctionCall | Other +type top_level_unit_help = FunctionCall | Other type t = | Comment_start (* 1 *) @@ -78,7 +78,7 @@ type t = | Bs_unimplemented_primitive of string (* 106 *) | Bs_integer_literal_overflow (* 107 *) | Bs_uninterpreted_delimiters of string (* 108 *) - | Bs_toplevel_expression_unit of (string * topLevelUnitHelp) option (* 109 *) + | Bs_toplevel_expression_unit of (string * top_level_unit_help) option (* 109 *) | Bs_todo of string option (* 110 *) val parse_options : bool -> string -> unit diff --git a/jscomp/frontend/ast_core_type.ml b/jscomp/frontend/ast_core_type.ml index e7b57b907c..5cc6469f13 100644 --- a/jscomp/frontend/ast_core_type.ml +++ b/jscomp/frontend/ast_core_type.ml @@ -125,8 +125,8 @@ let get_uncurry_arity (ty : t) = | _ -> None let get_curry_arity (ty : t) = - if Ast_uncurried.coreTypeIsUncurriedFun ty then - let arity, _ = Ast_uncurried.coreTypeExtractUncurriedFun ty in + if Ast_uncurried.core_type_is_uncurried_fun ty then + let arity, _ = Ast_uncurried.core_type_extract_uncurried_fun ty in arity else get_uncurry_arity_aux ty 0 diff --git a/jscomp/frontend/ast_derive_abstract.ml b/jscomp/frontend/ast_derive_abstract.ml index 273978e9b1..c0400eeb9b 100644 --- a/jscomp/frontend/ast_derive_abstract.ml +++ b/jscomp/frontend/ast_derive_abstract.ml @@ -27,9 +27,9 @@ module U = Ast_derive_util open Ast_helper (* type tdcls = Parsetree.type_declaration list *) -type abstractKind = Not_abstract | Light_abstract | Complex_abstract +type abstract_kind = Not_abstract | Light_abstract | Complex_abstract -let isAbstract (xs : Ast_payload.action list) = +let is_abstract (xs : Ast_payload.action list) = match xs with | [({txt = "abstract"}, None)] -> Complex_abstract | [({txt = "abstract"}, Some {pexp_desc = Pexp_ident {txt = Lident "light"}})] @@ -61,12 +61,12 @@ let get_attrs = [Ast_attributes.bs_get_arity] let set_attrs = [Ast_attributes.set] -let handleTdcl light (tdcl : Parsetree.type_declaration) : +let handle_tdcl light (tdcl : Parsetree.type_declaration) : Parsetree.type_declaration * Parsetree.value_description list = let core_type = U.core_type_of_type_declaration tdcl in let loc = tdcl.ptype_loc in let type_name = tdcl.ptype_name.txt in - let newTdcl = + let new_tdcl = { tdcl with ptype_kind = Ptype_abstract; @@ -80,7 +80,7 @@ let handleTdcl light (tdcl : Parsetree.type_declaration) : Ext_list.exists label_declarations (fun x -> Ast_attributes.has_bs_optional x.pld_attributes) in - let setter_accessor, makeType, labels = + let setter_accessor, make_type, labels = Ext_list.fold_right label_declarations ( [], (if has_optional_field then @@ -95,7 +95,7 @@ let handleTdcl light (tdcl : Parsetree.type_declaration) : pld_loc; } : Parsetree.label_declaration) (acc, maker, labels) -> - let prim_as_name, newLabel = + let prim_as_name, new_label = match Ast_attributes.iter_process_bs_string_as pld_attributes with | None -> (label_name, pld_name) | Some new_name -> (new_name, {pld_name with txt = new_name}) @@ -141,28 +141,28 @@ let handleTdcl light (tdcl : Parsetree.type_declaration) : :: acc else acc in - (acc, maker, (is_optional, newLabel) :: labels)) + (acc, maker, (is_optional, new_label) :: labels)) in - ( newTdcl, + ( new_tdcl, if is_private then setter_accessor else - let myPrims = + let my_prims = Ast_external_process.pval_prim_of_option_labels labels has_optional_field in - let myMaker = - Val.mk ~loc {loc; txt = type_name} ~prim:myPrims makeType + let my_maker = + Val.mk ~loc {loc; txt = type_name} ~prim:my_prims make_type in - myMaker :: setter_accessor ) + my_maker :: setter_accessor ) | Ptype_abstract | Ptype_variant _ | Ptype_open -> (* Looks obvious that it does not make sense to warn *) (* U.notApplicable tdcl.ptype_loc derivingName; *) (tdcl, []) -let handleTdclsInStr ~light rf tdcls = +let handle_tdcls_in_str ~light rf tdcls = let tdcls, code = Ext_list.fold_right tdcls ([], []) (fun tdcl (tdcls, sts) -> - match handleTdcl light tdcl with + match handle_tdcl light tdcl with | ntdcl, value_descriptions -> ( ntdcl :: tdcls, Ext_list.map_append value_descriptions sts (fun x -> @@ -171,10 +171,10 @@ let handleTdclsInStr ~light rf tdcls = Ast_compatible.rec_type_str rf tdcls :: code (* still need perform transformation for non-abstract type*) -let handleTdclsInSig ~light rf tdcls = +let handle_tdcls_in_sig ~light rf tdcls = let tdcls, code = Ext_list.fold_right tdcls ([], []) (fun tdcl (tdcls, sts) -> - match handleTdcl light tdcl with + match handle_tdcl light tdcl with | ntdcl, value_descriptions -> ( ntdcl :: tdcls, Ext_list.map_append value_descriptions sts (fun x -> Sig.value x) )) diff --git a/jscomp/frontend/ast_derive_abstract.mli b/jscomp/frontend/ast_derive_abstract.mli index 5e23f9db6d..4b71ddb562 100644 --- a/jscomp/frontend/ast_derive_abstract.mli +++ b/jscomp/frontend/ast_derive_abstract.mli @@ -22,21 +22,21 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type abstractKind = Not_abstract | Light_abstract | Complex_abstract +type abstract_kind = Not_abstract | Light_abstract | Complex_abstract -val isAbstract : Ast_payload.action list -> abstractKind +val is_abstract : Ast_payload.action list -> abstract_kind (** if only [abstract] happens [true] if [abstract] does not appear [false] if [abstract] happens with other, raise exception *) -val handleTdclsInStr : +val handle_tdcls_in_str : light:bool -> Asttypes.rec_flag -> Parsetree.type_declaration list -> Parsetree.structure -val handleTdclsInSig : +val handle_tdcls_in_sig : light:bool -> Asttypes.rec_flag -> Parsetree.type_declaration list -> diff --git a/jscomp/frontend/ast_derive_js_mapper.ml b/jscomp/frontend/ast_derive_js_mapper.ml index 8b9949b2b2..29827bb70b 100644 --- a/jscomp/frontend/ast_derive_js_mapper.ml +++ b/jscomp/frontend/ast_derive_js_mapper.ml @@ -55,30 +55,30 @@ let handle_config (config : Parsetree.expression option) = let noloc = Location.none (* [eraseType] will be instrumented, be careful about the name conflict*) -let eraseTypeLit = "_eraseType" +let erase_type_lit = "_eraseType" -let eraseTypeExp = Exp.ident {loc = noloc; txt = Lident eraseTypeLit} +let erase_type_exp = Exp.ident {loc = noloc; txt = Lident erase_type_lit} -let eraseType x = Ast_compatible.app1 eraseTypeExp x +let erase_type x = Ast_compatible.app1 erase_type_exp x -let eraseTypeStr = +let erase_type_str = let any = Typ.any () in Str.primitive (Val.mk ~prim:["%identity"] - {loc = noloc; txt = eraseTypeLit} + {loc = noloc; txt = erase_type_lit} (Ast_compatible.arrow any any)) -let unsafeIndex = "_index" +let unsafe_index = "_index" -let unsafeIndexGet = +let unsafe_index_get = let any = Typ.any () in Str.primitive (Val.mk ~prim:[""] - {loc = noloc; txt = unsafeIndex} + {loc = noloc; txt = unsafe_index} ~attrs:[Ast_attributes.get_index] (Ast_compatible.arrow any (Ast_compatible.arrow any any))) -let unsafeIndexGetExp = Exp.ident {loc = noloc; txt = Lident unsafeIndex} +let unsafe_index_get_exp = Exp.ident {loc = noloc; txt = Lident unsafe_index} (* JavaScript has allowed trailing commas in array literals since the beginning, and later added them to object literals (ECMAScript 5) and most recently (ECMAScript 2017) @@ -90,13 +90,13 @@ let add_key_value buf key value last = if last then Ext_buffer.add_string buf "\"" else Ext_buffer.add_string buf "\"," -let buildMap (row_fields : Parsetree.row_field list) = +let build_map (row_fields : Parsetree.row_field list) = let has_bs_as = ref false in - let data, revData = + let data, rev_data = let buf = Ext_buffer.create 50 in - let revBuf = Ext_buffer.create 50 in + let rev_buf = Ext_buffer.create 50 in Ext_buffer.add_string buf "{"; - Ext_buffer.add_string revBuf "{"; + Ext_buffer.add_string rev_buf "{"; let rec aux (row_fields : Parsetree.row_field list) = match row_fields with | [] -> () @@ -112,16 +112,16 @@ let buildMap (row_fields : Parsetree.row_field list) = in let last = rest = [] in add_key_value buf txt name last; - add_key_value revBuf name txt last + add_key_value rev_buf name txt last | _ -> assert false (* checked by [is_enum_polyvar] *)); aux rest in aux row_fields; Ext_buffer.add_string buf "}"; - Ext_buffer.add_string revBuf "}"; - (Ext_buffer.contents buf, Ext_buffer.contents revBuf) + Ext_buffer.add_string rev_buf "}"; + (Ext_buffer.contents buf, Ext_buffer.contents rev_buf) in - (data, revData, !has_bs_as) + (data, rev_data, !has_bs_as) let app1 = Ast_compatible.app1 @@ -129,18 +129,18 @@ let app2 = Ast_compatible.app2 let ( ->~ ) a b = Ast_compatible.arrow a b -let jsMapperRt = Longident.Ldot (Lident "Js", "MapperRt") +let js_mapper_rt = Longident.Ldot (Lident "Js", "MapperRt") -let raiseWhenNotFound x = +let raise_when_not_found x = app1 (Exp.ident - {loc = noloc; txt = Longident.Ldot (jsMapperRt, "raiseWhenNotFound")}) + {loc = noloc; txt = Longident.Ldot (js_mapper_rt, "raiseWhenNotFound")}) x -let derivingName = "jsConverter" +let deriving_name = "jsConverter" let init () = - Ast_derive.register derivingName (fun (x : Parsetree.expression option) -> - let createType = handle_config x in + Ast_derive.register deriving_name (fun (x : Parsetree.expression option) -> + let create_type = handle_config x in { structure_gen = @@ -148,38 +148,38 @@ let init () = let handle_tdcl (tdcl : Parsetree.type_declaration) = let core_type = U.core_type_of_type_declaration tdcl in let name = tdcl.ptype_name.txt in - let toJs = name ^ "ToJs" in - let fromJs = name ^ "FromJs" in + let to_js = name ^ "ToJs" in + let from_js = name ^ "FromJs" in let loc = tdcl.ptype_loc in - let patToJs = {Asttypes.loc; txt = toJs} in - let patFromJs = {Asttypes.loc; txt = fromJs} in + let pat_to_js = {Asttypes.loc; txt = to_js} in + let pat_from_js = {Asttypes.loc; txt = from_js} in let param = "param" in let ident_param = {Asttypes.txt = Longident.Lident param; loc} in let pat_param = {Asttypes.loc; txt = param} in let exp_param = Exp.ident ident_param in - let newType, newTdcl = + let new_type, new_tdcl = U.new_type_of_type_declaration tdcl ("abs_" ^ name) in - let newTypeStr = + let new_type_str = (* Abstract type *) - Ast_compatible.rec_type_str Nonrecursive [newTdcl] + Ast_compatible.rec_type_str Nonrecursive [new_tdcl] in - let toJsBody body = - Ast_comb.single_non_rec_value patToJs + let to_js_body body = + Ast_comb.single_non_rec_value pat_to_js (Ast_compatible.fun_ (Pat.constraint_ (Pat.var pat_param) core_type) body) in - let ( +> ) a ty = Exp.constraint_ (eraseType a) ty in - let ( +: ) a ty = eraseType (Exp.constraint_ a ty) in - let coerceResultToNewType e = - if createType then e +> newType else e + let ( +> ) a ty = Exp.constraint_ (erase_type a) ty in + let ( +: ) a ty = erase_type (Exp.constraint_ a ty) in + let coerce_result_to_new_type e = + if create_type then e +> new_type else e in match tdcl.ptype_kind with | Ptype_record label_declarations -> let exp = - coerceResultToNewType + coerce_result_to_new_type (Exp.extension ( {Asttypes.loc; txt = "obj"}, PStr @@ -198,7 +198,7 @@ let init () = None); ] )) in - let toJs = toJsBody exp in + let to_js = to_js_body exp in let obj_exp = Exp.record (Ext_list.map label_declarations @@ -209,65 +209,65 @@ let init () = (label, js_field exp_param label))) None in - let fromJs = - Ast_comb.single_non_rec_value patFromJs + let from_js = + Ast_comb.single_non_rec_value pat_from_js (Ast_compatible.fun_ (Pat.var pat_param) - (if createType then + (if create_type then Exp.let_ Nonrecursive - [Vb.mk (Pat.var pat_param) (exp_param +: newType)] + [Vb.mk (Pat.var pat_param) (exp_param +: new_type)] (Exp.constraint_ obj_exp core_type) else Exp.constraint_ obj_exp core_type)) in - let rest = [toJs; fromJs] in - if createType then eraseTypeStr :: newTypeStr :: rest else rest + let rest = [to_js; from_js] in + if create_type then erase_type_str :: new_type_str :: rest else rest | Ptype_abstract -> ( match Ast_polyvar.is_enum_polyvar tdcl with | Some row_fields -> - let map, revMap = ("_map", "_revMap") in - let expMap = Exp.ident {loc; txt = Lident map} in - let revExpMap = Exp.ident {loc; txt = Lident revMap} in - let data, revData, has_bs_as = buildMap row_fields in + let map, rev_map = ("_map", "_revMap") in + let exp_map = Exp.ident {loc; txt = Lident map} in + let rev_exp_map = Exp.ident {loc; txt = Lident rev_map} in + let data, rev_data, has_bs_as = build_map row_fields in let v = [ - eraseTypeStr; - unsafeIndexGet; + erase_type_str; + unsafe_index_get; Ast_comb.single_non_rec_value {loc; txt = map} (Exp.extension ( {txt = "raw"; loc}, PStr [Str.eval (Exp.constant (Const.string data))] )); - Ast_comb.single_non_rec_value {loc; txt = revMap} + Ast_comb.single_non_rec_value {loc; txt = rev_map} (if has_bs_as then Exp.extension ( {txt = "raw"; loc}, PStr [ - Str.eval (Exp.constant (Const.string revData)); + Str.eval (Exp.constant (Const.string rev_data)); ] ) - else expMap); - toJsBody + else exp_map); + to_js_body (if has_bs_as then - app2 unsafeIndexGetExp expMap exp_param - else app1 eraseTypeExp exp_param); - Ast_comb.single_non_rec_value patFromJs + app2 unsafe_index_get_exp exp_map exp_param + else app1 erase_type_exp exp_param); + Ast_comb.single_non_rec_value pat_from_js (Ast_compatible.fun_ (Pat.var pat_param) (let result = - app2 unsafeIndexGetExp revExpMap exp_param + app2 unsafe_index_get_exp rev_exp_map exp_param in - if createType then raiseWhenNotFound result + if create_type then raise_when_not_found result else result)); ] in - if createType then newTypeStr :: v else v + if create_type then new_type_str :: v else v | None -> - U.notApplicable tdcl.Parsetree.ptype_loc derivingName; + U.not_applicable tdcl.Parsetree.ptype_loc deriving_name; []) | Ptype_variant _ -> - U.notApplicable tdcl.Parsetree.ptype_loc derivingName; + U.not_applicable tdcl.Parsetree.ptype_loc deriving_name; [] | Ptype_open -> - U.notApplicable tdcl.Parsetree.ptype_loc derivingName; + U.not_applicable tdcl.Parsetree.ptype_loc deriving_name; [] in Ext_list.flat_map tdcls handle_tdcl); @@ -276,61 +276,61 @@ let init () = let handle_tdcl tdcl = let core_type = U.core_type_of_type_declaration tdcl in let name = tdcl.ptype_name.txt in - let toJs = name ^ "ToJs" in - let fromJs = name ^ "FromJs" in + let to_js = name ^ "ToJs" in + let from_js = name ^ "FromJs" in let loc = tdcl.ptype_loc in - let patToJs = {Asttypes.loc; txt = toJs} in - let patFromJs = {Asttypes.loc; txt = fromJs} in - let toJsType result = - Ast_comb.single_non_rec_val patToJs + let pat_to_js = {Asttypes.loc; txt = to_js} in + let pat_from_js = {Asttypes.loc; txt = from_js} in + let to_js_type result = + Ast_comb.single_non_rec_val pat_to_js (Ast_compatible.arrow core_type result) in - let newType, newTdcl = + let new_type, new_tdcl = U.new_type_of_type_declaration tdcl ("abs_" ^ name) in - let newTypeStr = - Ast_compatible.rec_type_sig Nonrecursive [newTdcl] + let new_type_str = + Ast_compatible.rec_type_sig Nonrecursive [new_tdcl] in - let ( +? ) v rest = if createType then v :: rest else rest in + let ( +? ) v rest = if create_type then v :: rest else rest in match tdcl.ptype_kind with | Ptype_record label_declarations -> - let objType flag = + let obj_type flag = Typ.object_ (Ext_list.map label_declarations (fun {pld_name; pld_type} -> Parsetree.Otag (pld_name, [], pld_type))) flag in - newTypeStr + new_type_str +? [ - toJsType (if createType then newType else objType Closed); - Ast_comb.single_non_rec_val patFromJs - ((if createType then newType else objType Open) + to_js_type (if create_type then new_type else obj_type Closed); + Ast_comb.single_non_rec_val pat_from_js + ((if create_type then new_type else obj_type Open) ->~ core_type); ] | Ptype_abstract -> ( match Ast_polyvar.is_enum_polyvar tdcl with | Some _ -> let ty1 = - if createType then newType else Ast_literal.type_string () + if create_type then new_type else Ast_literal.type_string () in let ty2 = - if createType then core_type + if create_type then core_type else Ast_core_type.lift_option_type core_type in - newTypeStr + new_type_str +? [ - toJsType ty1; - Ast_comb.single_non_rec_val patFromJs (ty1 ->~ ty2); + to_js_type ty1; + Ast_comb.single_non_rec_val pat_from_js (ty1 ->~ ty2); ] | None -> - U.notApplicable tdcl.Parsetree.ptype_loc derivingName; + U.not_applicable tdcl.Parsetree.ptype_loc deriving_name; []) | Ptype_variant _ -> - U.notApplicable tdcl.Parsetree.ptype_loc derivingName; + U.not_applicable tdcl.Parsetree.ptype_loc deriving_name; [] | Ptype_open -> - U.notApplicable tdcl.Parsetree.ptype_loc derivingName; + U.not_applicable tdcl.Parsetree.ptype_loc deriving_name; [] in Ext_list.flat_map tdcls handle_tdcl); diff --git a/jscomp/frontend/ast_derive_projector.ml b/jscomp/frontend/ast_derive_projector.ml index 48ff7d6f85..f9cb679135 100644 --- a/jscomp/frontend/ast_derive_projector.ml +++ b/jscomp/frontend/ast_derive_projector.ml @@ -12,10 +12,10 @@ let raise_unsupported_vaiant_record_arg loc = type tdcls = Parsetree.type_declaration list -let derivingName = "accessors" +let deriving_name = "accessors" let init () = - Ast_derive.register derivingName (fun (x : Parsetree.expression option) -> + Ast_derive.register deriving_name (fun (x : Parsetree.expression option) -> Ext_option.iter x invalid_config; { structure_gen = @@ -24,7 +24,7 @@ let init () = (* Accessors with no params (arity of 0) are simply values and not functions *) match Config.uncurried.contents with | Uncurried when arity > 0 -> - Ast_uncurried.uncurriedFun ~loc ~arity accessor + Ast_uncurried.uncurried_fun ~loc ~arity accessor | _ -> accessor in let handle_tdcl tdcl = @@ -113,7 +113,7 @@ let init () = Ast_compatible.fun_ (Pat.var {loc; txt = var}) b) |> handle_uncurried_accessor_tranform ~loc ~arity)) | Ptype_abstract | Ptype_open -> - Ast_derive_util.notApplicable tdcl.ptype_loc derivingName; + Ast_derive_util.not_applicable tdcl.ptype_loc deriving_name; [] (* Location.raise_errorf "projector only works with record" *) in @@ -124,7 +124,7 @@ let init () = match Config.uncurried.contents with (* Accessors with no params (arity of 0) are simply values and not functions *) | Uncurried when arity > 0 -> - Ast_uncurried.uncurriedType ~loc ~arity t + Ast_uncurried.uncurried_type ~loc ~arity t | _ -> t in let handle_tdcl tdcl = @@ -175,7 +175,7 @@ let init () = Ast_compatible.arrow x acc) |> handle_uncurried_type_tranform ~arity ~loc)) | Ptype_open | Ptype_abstract -> - Ast_derive_util.notApplicable tdcl.ptype_loc derivingName; + Ast_derive_util.not_applicable tdcl.ptype_loc deriving_name; [] in Ext_list.flat_map tdcls handle_tdcl); diff --git a/jscomp/frontend/ast_derive_util.ml b/jscomp/frontend/ast_derive_util.ml index 782c055d48..2e5b6af092 100644 --- a/jscomp/frontend/ast_derive_util.ml +++ b/jscomp/frontend/ast_derive_util.ml @@ -29,13 +29,13 @@ let core_type_of_type_declaration (tdcl : Parsetree.type_declaration) = | {ptype_name = {txt; loc}; ptype_params; ptype_attributes = attrs} -> Typ.constr ~attrs {txt = Lident txt; loc} (Ext_list.map ptype_params fst) -let new_type_of_type_declaration (tdcl : Parsetree.type_declaration) newName = +let new_type_of_type_declaration (tdcl : Parsetree.type_declaration) new_name = match tdcl with | {ptype_name = {loc}; ptype_params} -> - ( Typ.constr {txt = Lident newName; loc} (Ext_list.map ptype_params fst), + ( Typ.constr {txt = Lident new_name; loc} (Ext_list.map ptype_params fst), { Parsetree.ptype_params = tdcl.ptype_params; - ptype_name = {txt = newName; loc}; + ptype_name = {txt = new_name; loc}; ptype_kind = Ptype_abstract; ptype_attributes = []; ptype_loc = tdcl.ptype_loc; @@ -43,9 +43,9 @@ let new_type_of_type_declaration (tdcl : Parsetree.type_declaration) newName = ptype_private = Public; ptype_manifest = None; } ) -let notApplicable loc derivingName = +let not_applicable loc deriving_name = Location.prerr_warning loc - (Warnings.Bs_derive_warning (derivingName ^ " not applicable to this type")) + (Warnings.Bs_derive_warning (deriving_name ^ " not applicable to this type")) let invalid_config (config : Parsetree.expression) = Location.raise_errorf ~loc:config.pexp_loc diff --git a/jscomp/frontend/ast_derive_util.mli b/jscomp/frontend/ast_derive_util.mli index 1cc656eaee..96ad2d68f8 100644 --- a/jscomp/frontend/ast_derive_util.mli +++ b/jscomp/frontend/ast_derive_util.mli @@ -43,6 +43,6 @@ val new_type_of_type_declaration : Parsetree.label_declaration list -> (Parsetree.core_type * Parsetree.expression) list * string list *) -val notApplicable : Location.t -> string -> unit +val not_applicable : Location.t -> string -> unit val invalid_config : Parsetree.expression -> 'a diff --git a/jscomp/frontend/ast_exp_apply.ml b/jscomp/frontend/ast_exp_apply.ml index 4c0ad3affb..5919ce627d 100644 --- a/jscomp/frontend/ast_exp_apply.ml +++ b/jscomp/frontend/ast_exp_apply.ml @@ -208,12 +208,12 @@ let app_exp_mapper (e : exp) (self : Bs_ast_mapper.mapper) (fn : exp) (* syntax: {[f arg0 arg1 [@bs]]} only for legacy .ml files *) let fn = self.expr self fn in let args = Ext_list.map args (fun (lbl, e) -> (lbl, self.expr self e)) in - let jsInternal = Ast_literal.Lid.js_internal in + let js_internal = Ast_literal.Lid.js_internal in let loc = e.pexp_loc in match args with | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] -> Exp.apply ~loc ~attrs:pexp_attributes - (Exp.ident {txt = Ldot (jsInternal, "run"); loc}) + (Exp.ident {txt = Ldot (js_internal, "run"); loc}) [(Nolabel, fn)] | _ -> Exp.apply ~loc diff --git a/jscomp/frontend/ast_exp_extension.ml b/jscomp/frontend/ast_exp_extension.ml index 6f4f217b28..3877132257 100644 --- a/jscomp/frontend/ast_exp_extension.ml +++ b/jscomp/frontend/ast_exp_extension.ml @@ -74,7 +74,7 @@ let handle_extension e (self : Bs_ast_mapper.mapper) | "time" -> ( match payload with | PStr [{pstr_desc = Pstr_eval (e, _)}] -> - let locString = + let loc_string = if loc.loc_ghost then "GHOST LOC" else let loc_start = loc.loc_start in @@ -86,14 +86,14 @@ let handle_extension e (self : Bs_ast_mapper.mapper) (Ast_compatible.app1 ~loc (Exp.ident ~loc {loc; txt = Ldot (Ldot (Lident "Js", "Console"), "timeStart")}) - (Ast_compatible.const_exp_string ~loc locString)) + (Ast_compatible.const_exp_string ~loc loc_string)) (Exp.let_ ~loc Nonrecursive [Vb.mk ~loc (Pat.var ~loc {loc; txt = "timed"}) e] (Exp.sequence ~loc (Ast_compatible.app1 ~loc (Exp.ident ~loc {loc; txt = Ldot (Ldot (Lident "Js", "Console"), "timeEnd")}) - (Ast_compatible.const_exp_string ~loc locString)) + (Ast_compatible.const_exp_string ~loc loc_string)) (Exp.ident ~loc {loc; txt = Lident "timed"}))) | _ -> Location.raise_errorf ~loc "expect a boolean expression in the payload") diff --git a/jscomp/frontend/ast_exp_handle_external.ml b/jscomp/frontend/ast_exp_handle_external.ml index 63cddf041f..753af63441 100644 --- a/jscomp/frontend/ast_exp_handle_external.ml +++ b/jscomp/frontend/ast_exp_handle_external.ml @@ -112,7 +112,7 @@ let handle_ffi ~loc ~payload = | Some exp -> (* Wrap a type constraint based on arity. E.g. for arity 2 constrain to type (_, _) => _ *) - let wrapTypeConstraint (e : Parsetree.expression) = + let wrap_type_constraint (e : Parsetree.expression) = let loc = e.pexp_loc in let any = Ast_helper.Typ.any ~loc:e.pexp_loc () in let unit = Ast_literal.type_unit ~loc () in @@ -124,14 +124,14 @@ let handle_ffi ~loc ~payload = match !is_function with | Some arity -> let type_ = - Ast_uncurried.uncurriedType ~loc + Ast_uncurried.uncurried_type ~loc ~arity:(if arity = 0 then 1 else arity) (arrow ~arity) in Ast_helper.Exp.constraint_ ~loc e type_ | _ -> err () in - wrapTypeConstraint + wrap_type_constraint { exp with pexp_desc = diff --git a/jscomp/frontend/ast_external.ml b/jscomp/frontend/ast_external.ml index c02830579a..479227d3dc 100644 --- a/jscomp/frontend/ast_external.ml +++ b/jscomp/frontend/ast_external.ml @@ -22,7 +22,7 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -let handleExternalInSig (self : Bs_ast_mapper.mapper) +let handle_external_in_sig (self : Bs_ast_mapper.mapper) (prim : Parsetree.value_description) (sigi : Parsetree.signature_item) : Parsetree.signature_item = let loc = prim.pval_loc in @@ -66,7 +66,7 @@ let handleExternalInSig (self : Bs_ast_mapper.mapper) }; })) -let handleExternalInStru (self : Bs_ast_mapper.mapper) +let handle_external_in_stru (self : Bs_ast_mapper.mapper) (prim : Parsetree.value_description) (str : Parsetree.structure_item) : Parsetree.structure_item = let loc = prim.pval_loc in diff --git a/jscomp/frontend/ast_external.mli b/jscomp/frontend/ast_external.mli index 21f832fe1a..8e53466962 100644 --- a/jscomp/frontend/ast_external.mli +++ b/jscomp/frontend/ast_external.mli @@ -22,13 +22,13 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val handleExternalInSig : +val handle_external_in_sig : Bs_ast_mapper.mapper -> Parsetree.value_description -> Parsetree.signature_item -> Parsetree.signature_item -val handleExternalInStru : +val handle_external_in_stru : Bs_ast_mapper.mapper -> Parsetree.value_description -> Parsetree.structure_item -> diff --git a/jscomp/frontend/ast_external_process.ml b/jscomp/frontend/ast_external_process.ml index 423d586d79..39dac1c36a 100644 --- a/jscomp/frontend/ast_external_process.ml +++ b/jscomp/frontend/ast_external_process.ml @@ -68,8 +68,8 @@ let spec_of_ptyp (nolabel : bool) (ptyp : Parsetree.core_type) : | _ -> Bs_syntaxerr.err ptyp.ptyp_loc Invalid_bs_unwrap_type) | `Uncurry opt_arity -> ( let real_arity = - if Ast_uncurried.coreTypeIsUncurriedFun ptyp then - let arity, _ = Ast_uncurried.coreTypeExtractUncurriedFun ptyp in + if Ast_uncurried.core_type_is_uncurried_fun ptyp then + let arity, _ = Ast_uncurried.core_type_extract_uncurried_fun ptyp in Some arity else Ast_core_type.get_uncurry_arity ptyp in @@ -277,7 +277,7 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string) _; }; ] -> ( - let fromName = ref None in + let from_name = ref None in let with_ = ref None in fields |> List.iter @@ -288,11 +288,11 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string) match (l, exp.pexp_desc) with | ( {txt = Lident "from"; _}, Pexp_constant (Pconst_string (s, _)) ) -> - fromName := Some s + from_name := Some s | {txt = Lident "with"; _}, Pexp_record (fields, _) -> with_ := Some fields | _ -> ()); - match (!fromName, !with_) with + match (!from_name, !with_) with | None, _ -> Location.raise_errorf ~loc:pexp_loc "@module annotations with import attributes must have a \ @@ -304,9 +304,9 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string) "@module annotations with import attributes must have a \ \"with\" field. This \"with\" field should hold a record of \ the import attributes you want applied to the import." - | Some fromName, Some withFields -> - let importAttributesFromRecord = - withFields + | Some from_name, Some with_fields -> + let import_attributes_from_record = + with_fields |> List.filter_map (fun ((l, exp) : @@ -325,9 +325,9 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string) "Only string values are allowed here.") in let import_attributes = - Hashtbl.create (List.length importAttributesFromRecord) + Hashtbl.create (List.length import_attributes_from_record) in - importAttributesFromRecord + import_attributes_from_record |> List.iter (fun (key, value) -> Hashtbl.replace import_attributes key value); { @@ -335,7 +335,7 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string) external_module_name = Some { - bundle = fromName; + bundle = from_name; module_bind_name = Phint_nothing; import_attributes = Some import_attributes; }; @@ -492,7 +492,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) Location.raise_errorf ~loc "expect label, optional, or unit here") | Labelled label -> ( - let fieldName = + let field_name = match Ast_attributes.iter_process_bs_string_as param_type.attr with @@ -507,7 +507,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) result_types ) | Arg_cst _ -> ( { - obj_arg_label = External_arg_spec.obj_label fieldName; + obj_arg_label = External_arg_spec.obj_label field_name; obj_arg_type; }, arg_types, @@ -515,31 +515,31 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) result_types ) | Nothing -> ( { - obj_arg_label = External_arg_spec.obj_label fieldName; + obj_arg_label = External_arg_spec.obj_label field_name; obj_arg_type; }, param_type :: arg_types, - Parsetree.Otag ({Asttypes.txt = fieldName; loc}, [], ty) + Parsetree.Otag ({Asttypes.txt = field_name; loc}, [], ty) :: result_types ) | Int _ -> ( { - obj_arg_label = External_arg_spec.obj_label fieldName; + obj_arg_label = External_arg_spec.obj_label field_name; obj_arg_type; }, param_type :: arg_types, Otag - ( {Asttypes.txt = fieldName; loc}, + ( {Asttypes.txt = field_name; loc}, [], Ast_literal.type_int ~loc () ) :: result_types ) | Poly_var_string _ -> ( { - obj_arg_label = External_arg_spec.obj_label fieldName; + obj_arg_label = External_arg_spec.obj_label field_name; obj_arg_type; }, param_type :: arg_types, Otag - ( {Asttypes.txt = fieldName; loc}, + ( {Asttypes.txt = field_name; loc}, [], Ast_literal.type_string ~loc () ) :: result_types ) @@ -554,7 +554,7 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) Location.raise_errorf ~loc "%@obj label %s does not support %@unwrap arguments" label) | Optional label -> ( - let fieldName = + let field_name = match Ast_attributes.iter_process_bs_string_as param_type.attr with @@ -576,35 +576,35 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) in ( { obj_arg_label = - External_arg_spec.optional for_sure_not_nested fieldName; + External_arg_spec.optional for_sure_not_nested field_name; obj_arg_type; }, param_type :: arg_types, Parsetree.Otag - ( {Asttypes.txt = fieldName; loc}, + ( {Asttypes.txt = field_name; loc}, [], Ast_comb.to_undefined_type loc ty ) :: result_types ) | Int _ -> ( { - obj_arg_label = External_arg_spec.optional true fieldName; + obj_arg_label = External_arg_spec.optional true field_name; obj_arg_type; }, param_type :: arg_types, Otag - ( {Asttypes.txt = fieldName; loc}, + ( {Asttypes.txt = field_name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_int ~loc () ) :: result_types ) | Poly_var_string _ -> ( { - obj_arg_label = External_arg_spec.optional true fieldName; + obj_arg_label = External_arg_spec.optional true field_name; obj_arg_type; }, param_type :: arg_types, Otag - ( {Asttypes.txt = fieldName; loc}, + ( {Asttypes.txt = field_name; loc}, [], Ast_comb.to_undefined_type loc @@ Ast_literal.type_string ~loc () ) @@ -966,12 +966,12 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type) | Ptyp_constr (({txt = Lident "function$"; _} as lid), [t; arity_]) -> ( t, fun ~arity x -> - let tArity = + let t_arity = match arity with - | Some arity -> Ast_uncurried.arityType ~loc arity + | Some arity -> Ast_uncurried.arity_type ~loc arity | None -> arity_ in - {x with Parsetree.ptyp_desc = Ptyp_constr (lid, [x; tArity])} ) + {x with Parsetree.ptyp_desc = Ptyp_constr (lid, [x; t_arity])} ) | _ -> (type_annotation, fun ~arity:_ x -> x) in let result_type, arg_types_ty = diff --git a/jscomp/frontend/ast_signature.ml b/jscomp/frontend/ast_signature.ml index b73378093a..e75ff87d88 100644 --- a/jscomp/frontend/ast_signature.ml +++ b/jscomp/frontend/ast_signature.ml @@ -28,5 +28,5 @@ type t = item list open Ast_helper -let fuseAll ?(loc = Location.none) (t : t) : item = +let fuse_all ?(loc = Location.none) (t : t) : item = Sig.include_ ~loc (Incl.mk ~loc (Mty.signature ~loc t)) diff --git a/jscomp/frontend/ast_signature.mli b/jscomp/frontend/ast_signature.mli index b382420786..e43765269b 100644 --- a/jscomp/frontend/ast_signature.mli +++ b/jscomp/frontend/ast_signature.mli @@ -26,4 +26,4 @@ type item = Parsetree.signature_item type t = item list -val fuseAll : ?loc:Ast_helper.loc -> t -> item +val fuse_all : ?loc:Ast_helper.loc -> t -> item diff --git a/jscomp/frontend/ast_structure.ml b/jscomp/frontend/ast_structure.ml index 2143f09150..b4152e884e 100644 --- a/jscomp/frontend/ast_structure.ml +++ b/jscomp/frontend/ast_structure.ml @@ -28,7 +28,7 @@ type t = item list open Ast_helper -let fuseAll ?(loc = Location.none) (t : t) : item = +let fuse_all ?(loc = Location.none) (t : t) : item = Str.include_ ~loc (Incl.mk ~loc (Mod.structure ~loc t)) (* let fuse_with_constraint diff --git a/jscomp/frontend/ast_structure.mli b/jscomp/frontend/ast_structure.mli index 77608b4078..240cbc3ee9 100644 --- a/jscomp/frontend/ast_structure.mli +++ b/jscomp/frontend/ast_structure.mli @@ -26,7 +26,7 @@ type item = Parsetree.structure_item type t = item list -val fuseAll : ?loc:Ast_helper.loc -> t -> item +val fuse_all : ?loc:Ast_helper.loc -> t -> item (* val fuse_with_constraint: ?loc:Ast_helper.loc -> diff --git a/jscomp/frontend/ast_tdcls.ml b/jscomp/frontend/ast_tdcls.ml index 09c34871da..c367cb0c6c 100644 --- a/jscomp/frontend/ast_tdcls.ml +++ b/jscomp/frontend/ast_tdcls.ml @@ -27,77 +27,77 @@ open Ast_helper (** [newTdcls tdcls newAttrs] functional update attributes of last declaration *) -let newTdcls (tdcls : Parsetree.type_declaration list) - (newAttrs : Parsetree.attributes) : Parsetree.type_declaration list = +let new_tdcls (tdcls : Parsetree.type_declaration list) + (new_attrs : Parsetree.attributes) : Parsetree.type_declaration list = match tdcls with - | [x] -> [{x with Parsetree.ptype_attributes = newAttrs}] + | [x] -> [{x with Parsetree.ptype_attributes = new_attrs}] | _ -> Ext_list.map_last tdcls (fun last x -> - if last then {x with Parsetree.ptype_attributes = newAttrs} else x) + if last then {x with Parsetree.ptype_attributes = new_attrs} else x) -let handleTdclsInSigi (self : Bs_ast_mapper.mapper) +let handle_tdcls_in_sigi (self : Bs_ast_mapper.mapper) (sigi : Parsetree.signature_item) rf (tdcls : Parsetree.type_declaration list) : Ast_signature.item = match Ast_attributes.process_derive_type (Ext_list.last tdcls).ptype_attributes with - | {bs_deriving = Some actions}, newAttrs -> + | {bs_deriving = Some actions}, new_attrs -> let loc = sigi.psig_loc in - let originalTdclsNewAttrs = newTdcls tdcls newAttrs in + let original_tdcls_new_attrs = new_tdcls tdcls new_attrs in (* remove the processed attr*) - let newTdclsNewAttrs = - self.type_declaration_list self originalTdclsNewAttrs + let new_tdcls_new_attrs = + self.type_declaration_list self original_tdcls_new_attrs in - let kind = Ast_derive_abstract.isAbstract actions in + let kind = Ast_derive_abstract.is_abstract actions in if kind <> Not_abstract then let codes = - Ast_derive_abstract.handleTdclsInSig ~light:(kind = Light_abstract) rf - originalTdclsNewAttrs + Ast_derive_abstract.handle_tdcls_in_sig ~light:(kind = Light_abstract) rf + original_tdcls_new_attrs in - Ast_signature.fuseAll ~loc + Ast_signature.fuse_all ~loc (Sig.include_ ~loc (Incl.mk ~loc (Mty.typeof_ ~loc (Mod.constraint_ ~loc (Mod.structure ~loc - [Ast_compatible.rec_type_str ~loc rf newTdclsNewAttrs]) + [Ast_compatible.rec_type_str ~loc rf new_tdcls_new_attrs]) (Mty.signature ~loc [])))) :: (* include module type of struct [processed_code for checking like invariance ]end *) self.signature self codes) else - Ast_signature.fuseAll ~loc - (Ast_compatible.rec_type_sig ~loc rf newTdclsNewAttrs + Ast_signature.fuse_all ~loc + (Ast_compatible.rec_type_sig ~loc rf new_tdcls_new_attrs :: self.signature self (Ast_derive.gen_signature tdcls actions rf)) | {bs_deriving = None}, _ -> Bs_ast_mapper.default_mapper.signature_item self sigi -let handleTdclsInStru (self : Bs_ast_mapper.mapper) +let handle_tdcls_in_stru (self : Bs_ast_mapper.mapper) (str : Parsetree.structure_item) rf (tdcls : Parsetree.type_declaration list) : Ast_structure.item = match Ast_attributes.process_derive_type (Ext_list.last tdcls).ptype_attributes with - | {bs_deriving = Some actions}, newAttrs -> + | {bs_deriving = Some actions}, new_attrs -> let loc = str.pstr_loc in - let originalTdclsNewAttrs = newTdcls tdcls newAttrs in - let newStr : Parsetree.structure_item = + let original_tdcls_new_attrs = new_tdcls tdcls new_attrs in + let new_str : Parsetree.structure_item = Ast_compatible.rec_type_str ~loc rf - (self.type_declaration_list self originalTdclsNewAttrs) + (self.type_declaration_list self original_tdcls_new_attrs) in - let kind = Ast_derive_abstract.isAbstract actions in + let kind = Ast_derive_abstract.is_abstract actions in if kind <> Not_abstract then let codes = - Ast_derive_abstract.handleTdclsInStr ~light:(kind = Light_abstract) rf - originalTdclsNewAttrs + Ast_derive_abstract.handle_tdcls_in_str ~light:(kind = Light_abstract) rf + original_tdcls_new_attrs in (* use [tdcls2] avoid nonterminating *) - Ast_structure.fuseAll ~loc - (Ast_structure.constraint_ ~loc [newStr] [] + Ast_structure.fuse_all ~loc + (Ast_structure.constraint_ ~loc [new_str] [] :: (* [include struct end : sig end] for error checking *) self.structure self codes) else - Ast_structure.fuseAll ~loc - (newStr + Ast_structure.fuse_all ~loc + (new_str :: self.structure self (List.map (fun action -> diff --git a/jscomp/frontend/ast_tdcls.mli b/jscomp/frontend/ast_tdcls.mli index 1f8e62ab0e..1ebdfb833a 100644 --- a/jscomp/frontend/ast_tdcls.mli +++ b/jscomp/frontend/ast_tdcls.mli @@ -22,14 +22,14 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -val handleTdclsInSigi : +val handle_tdcls_in_sigi : Bs_ast_mapper.mapper -> Parsetree.signature_item -> Asttypes.rec_flag -> Parsetree.type_declaration list -> Ast_signature.item -val handleTdclsInStru : +val handle_tdcls_in_stru : Bs_ast_mapper.mapper -> Parsetree.structure_item -> Asttypes.rec_flag -> diff --git a/jscomp/frontend/ast_typ_uncurry.ml b/jscomp/frontend/ast_typ_uncurry.ml index 36861ea71a..e60738f172 100644 --- a/jscomp/frontend/ast_typ_uncurry.ml +++ b/jscomp/frontend/ast_typ_uncurry.ml @@ -60,5 +60,5 @@ let to_uncurry_type loc (mapper : Bs_ast_mapper.mapper) let fn_type = Typ.arrow ~loc label first_arg typ in let arity = Ast_core_type.get_uncurry_arity fn_type in match arity with - | Some arity -> Ast_uncurried.uncurriedType ~loc ~arity fn_type + | Some arity -> Ast_uncurried.uncurried_type ~loc ~arity fn_type | None -> assert false diff --git a/jscomp/frontend/ast_uncurry_gen.ml b/jscomp/frontend/ast_uncurry_gen.ml index ec69cdaaf0..69479e9a33 100644 --- a/jscomp/frontend/ast_uncurry_gen.ml +++ b/jscomp/frontend/ast_uncurry_gen.ml @@ -93,7 +93,7 @@ let to_uncurry_fn (e : Parsetree.expression) (self : Bs_ast_mapper.mapper) let arity = List.length rev_extra_args in Bs_syntaxerr.err_large_arity loc arity; - let fun_exp = Ast_uncurried.uncurriedFun ~loc ~arity body in + let fun_exp = Ast_uncurried.uncurried_fun ~loc ~arity body in { e with pexp_desc = fun_exp.pexp_desc; diff --git a/jscomp/frontend/bs_builtin_ppx.ml b/jscomp/frontend/bs_builtin_ppx.ml index 23f1fdfbc9..f014d1a523 100644 --- a/jscomp/frontend/bs_builtin_ppx.ml +++ b/jscomp/frontend/bs_builtin_ppx.ml @@ -114,16 +114,16 @@ let expr_mapper ~async_context ~in_function_def (self : mapper) async_context := false; default_expr_mapper self e | _ - when Ast_uncurried.exprIsUncurriedFun e + when Ast_uncurried.expr_is_uncurried_fun e && match Ast_attributes.process_attributes_rev - (Ast_uncurried.exprExtractUncurriedFun e).pexp_attributes + (Ast_uncurried.expr_extract_uncurried_fun e).pexp_attributes with | Meth_callback _, _ -> true | _ -> false -> (* Treat @this (. x, y, z) => ... just like @this (x, y, z) => ... *) - let fun_expr = Ast_uncurried.exprExtractUncurriedFun e in + let fun_expr = Ast_uncurried.expr_extract_uncurried_fun e in self.expr self fun_expr | Pexp_newtype (s, body) -> let async = Ast_attributes.has_async_payload e.pexp_attributes <> None in @@ -217,7 +217,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper) (* module M = await Belt.List *) | Pexp_letmodule (lid, ({pmod_desc = Pmod_ident {txt}; pmod_attributes} as me), expr) - when Res_parsetree_viewer.hasAwaitAttribute pmod_attributes -> + when Res_parsetree_viewer.has_await_attribute pmod_attributes -> let safe_module_type_lid : Ast_helper.lid = {txt = Lident (local_module_type_name txt); loc = me.pmod_loc} in @@ -240,7 +240,7 @@ let expr_mapper ~async_context ~in_function_def (self : mapper) pmod_attributes; } as me), expr ) - when Res_parsetree_viewer.hasAwaitAttribute pmod_attributes -> + when Res_parsetree_viewer.has_await_attribute pmod_attributes -> { e with pexp_desc = @@ -287,11 +287,11 @@ let typ_mapper (self : mapper) (typ : Parsetree.core_type) = let signature_item_mapper (self : mapper) (sigi : Parsetree.signature_item) : Parsetree.signature_item = match sigi.psig_desc with - | Psig_type (rf, tdcls) -> Ast_tdcls.handleTdclsInSigi self sigi rf tdcls + | Psig_type (rf, tdcls) -> Ast_tdcls.handle_tdcls_in_sigi self sigi rf tdcls | Psig_value ({pval_attributes; pval_prim} as value_desc) -> ( let pval_attributes = self.attributes self pval_attributes in if Ast_attributes.rs_externals pval_attributes pval_prim then - Ast_external.handleExternalInSig self value_desc sigi + Ast_external.handle_external_in_sig self value_desc sigi else match Ast_attributes.has_inline_payload pval_attributes with | Some ((_, PStr [{pstr_desc = Pstr_eval ({pexp_desc}, _)}]) as attr) -> ( @@ -379,10 +379,10 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) : Parsetree.structure_item = match str.pstr_desc with | Pstr_type (rf, tdcls) (* [ {ptype_attributes} as tdcl ] *) -> - Ast_tdcls.handleTdclsInStru self str rf tdcls + Ast_tdcls.handle_tdcls_in_stru self str rf tdcls | Pstr_primitive prim when Ast_attributes.rs_externals prim.pval_attributes prim.pval_prim -> - Ast_external.handleExternalInStru self prim str + Ast_external.handle_external_in_stru self prim str | Pstr_value ( Nonrecursive, [ @@ -555,7 +555,7 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t) | Pstr_module ({pmb_expr = {pmod_desc = Pmod_ident {txt; loc}; pmod_attributes} as me} as mb) - when Res_parsetree_viewer.hasAwaitAttribute pmod_attributes -> + when Res_parsetree_viewer.has_await_attribute pmod_attributes -> let item = self.structure_item self item in let safe_module_type_name = local_module_type_name txt in let has_local_module_name = @@ -605,7 +605,7 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t) ( _, ({pmod_desc = Pmod_ident {txt; loc}; pmod_attributes} as me), expr ) - when Res_parsetree_viewer.hasAwaitAttribute pmod_attributes -> ( + when Res_parsetree_viewer.has_await_attribute pmod_attributes -> ( let safe_module_type_name = local_module_type_name txt in let has_local_module_name = Hashtbl.find_opt !await_context safe_module_type_name diff --git a/jscomp/frontend/bs_syntaxerr.ml b/jscomp/frontend/bs_syntaxerr.ml index 8ab399b55f..a112ef88e0 100644 --- a/jscomp/frontend/bs_syntaxerr.ml +++ b/jscomp/frontend/bs_syntaxerr.ml @@ -22,7 +22,7 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type untaggedVariant = OnlyOneUnknown | AtMostOneObject | AtMostOneArray +type untagged_variant = OnlyOneUnknown | AtMostOneObject | AtMostOneArray type error = | Unsupported_predicates diff --git a/jscomp/frontend/bs_syntaxerr.mli b/jscomp/frontend/bs_syntaxerr.mli index bf198914bf..0ec6e9a6a9 100644 --- a/jscomp/frontend/bs_syntaxerr.mli +++ b/jscomp/frontend/bs_syntaxerr.mli @@ -22,7 +22,7 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type untaggedVariant = OnlyOneUnknown | AtMostOneObject | AtMostOneArray +type untagged_variant = OnlyOneUnknown | AtMostOneObject | AtMostOneArray type error = | Unsupported_predicates diff --git a/jscomp/frontend/lam_constant.ml b/jscomp/frontend/lam_constant.ml index 7985af2c83..5e534668d7 100644 --- a/jscomp/frontend/lam_constant.ml +++ b/jscomp/frontend/lam_constant.ml @@ -42,7 +42,7 @@ let string_of_pointer_info (x : pointer_info) : string option = type t = | Const_js_null - | Const_js_undefined of {isUnit: bool} + | Const_js_undefined of {is_unit: bool} | Const_js_true | Const_js_false | Const_int of {i: int32; comment: pointer_info} @@ -109,4 +109,4 @@ let rec eq_approx (x : t) (y : t) = | Const_some iy -> eq_approx ix iy | _ -> false) -let lam_none : t = Const_js_undefined {isUnit = false} +let lam_none : t = Const_js_undefined {is_unit = false} diff --git a/jscomp/frontend/lam_constant.mli b/jscomp/frontend/lam_constant.mli index 2514b1dea7..5d2fc05deb 100644 --- a/jscomp/frontend/lam_constant.mli +++ b/jscomp/frontend/lam_constant.mli @@ -38,7 +38,7 @@ val string_of_pointer_info : pointer_info -> string option type t = | Const_js_null - | Const_js_undefined of {isUnit: bool} + | Const_js_undefined of {is_unit: bool} | Const_js_true | Const_js_false | Const_int of {i: int32; comment: pointer_info} diff --git a/jscomp/frontend/ppx_entry.ml b/jscomp/frontend/ppx_entry.ml index 67d50bb61c..422892310a 100644 --- a/jscomp/frontend/ppx_entry.ml +++ b/jscomp/frontend/ppx_entry.ml @@ -30,12 +30,12 @@ let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature = let ast = match !Js_config.jsx_version with | None -> ast - | Some jsxVersion -> + | Some jsx_version -> let open Js_config in - let jsxVersion = int_of_jsx_version jsxVersion in - let jsxModule = string_of_jsx_module !jsx_module in - let jsxMode = string_of_jsx_mode !jsx_mode in - Jsx_ppx.rewrite_signature ~jsxVersion ~jsxModule ~jsxMode ast + let jsx_version = int_of_jsx_version jsx_version in + let jsx_module = string_of_jsx_module !jsx_module in + let jsx_mode = string_of_jsx_mode !jsx_mode in + Jsx_ppx.rewrite_signature ~jsx_version ~jsx_module ~jsx_mode ast in if !Js_config.no_builtin_ppx then ast else @@ -50,12 +50,12 @@ let rewrite_implementation (ast : Parsetree.structure) : Parsetree.structure = let ast = match !Js_config.jsx_version with | None -> ast - | Some jsxVersion -> + | Some jsx_version -> let open Js_config in - let jsxVersion = int_of_jsx_version jsxVersion in - let jsxModule = string_of_jsx_module !jsx_module in - let jsxMode = string_of_jsx_mode !jsx_mode in - Jsx_ppx.rewrite_implementation ~jsxVersion ~jsxModule ~jsxMode ast + let jsx_version = int_of_jsx_version jsx_version in + let jsx_module = string_of_jsx_module !jsx_module in + let jsx_mode = string_of_jsx_mode !jsx_mode in + Jsx_ppx.rewrite_implementation ~jsx_version ~jsx_module ~jsx_mode ast in if !Js_config.no_builtin_ppx then ast else diff --git a/jscomp/gentype/Annotation.ml b/jscomp/gentype/Annotation.ml index e6836690cb..4c7f691847 100644 --- a/jscomp/gentype/Annotation.ml +++ b/jscomp/gentype/Annotation.ml @@ -1,49 +1,49 @@ -type import = {importPath: ImportPath.t} +type import = {import_path: ImportPath.t} -type attributePayload = +type attribute_payload = | BoolPayload of bool | FloatPayload of string | IdentPayload of Longident.t | IntPayload of string | StringPayload of string - | TuplePayload of attributePayload list + | TuplePayload of attribute_payload list | UnrecognizedPayload type t = GenType | GenTypeOpaque | NoGenType -let toString annotation = +let to_string annotation = match annotation with | GenType -> "GenType" | GenTypeOpaque -> "GenTypeOpaque" | NoGenType -> "NoGenType" -let tagIsGenType s = s = "genType" || s = "gentype" -let tagIsGenTypeAs s = s = "genType.as" || s = "gentype.as" -let tagIsAs s = s = "as" -let tagIsInt s = s = "int" -let tagIsString s = s = "string" +let tag_is_gen_type s = s = "genType" || s = "gentype" +let tag_is_gen_type_as s = s = "genType.as" || s = "gentype.as" +let tag_is_as s = s = "as" +let tag_is_int s = s = "int" +let tag_is_string s = s = "string" -let tagIsTag s = s = "tag" +let tag_is_tag s = s = "tag" -let tagIsUnboxed s = s = "unboxed" || s = "ocaml.unboxed" -let tagIsGenTypeImport s = s = "genType.import" || s = "gentype.import" -let tagIsGenTypeOpaque s = s = "genType.opaque" || s = "gentype.opaque" +let tag_is_unboxed s = s = "unboxed" || s = "ocaml.unboxed" +let tag_is_gen_type_import s = s = "genType.import" || s = "gentype.import" +let tag_is_gen_type_opaque s = s = "genType.opaque" || s = "gentype.opaque" -let tagIsOneOfTheGenTypeAnnotations s = - tagIsGenType s || tagIsGenTypeAs s || tagIsGenTypeImport s - || tagIsGenTypeOpaque s +let tag_is_one_of_the_gen_type_annotations s = + tag_is_gen_type s || tag_is_gen_type_as s || tag_is_gen_type_import s + || tag_is_gen_type_opaque s -let tagIsGenTypeIgnoreInterface s = +let tag_is_gen_type_ignore_interface s = s = "genType.ignoreInterface" || s = "gentype.ignoreInterface" -let tagIsDoc s = +let tag_is_doc s = match s with | "ocaml.doc" | "res.doc" -> true | _ -> false -let tagIsInternLocal s = s = "internal.local" +let tag_is_intern_local s = s = "internal.local" -let rec getAttributePayload checkText (attributes : Typedtree.attributes) = - let rec fromExpr (expr : Parsetree.expression) = +let rec get_attribute_payload check_text (attributes : Typedtree.attributes) = + let rec from_expr (expr : Parsetree.expression) = match expr with | {pexp_desc = Pexp_constant (Pconst_string (s, _))} -> Some (StringPayload s) @@ -59,7 +59,7 @@ let rec getAttributePayload checkText (attributes : Typedtree.attributes) = exprs |> List.rev |> List.fold_left (fun payloads expr -> - match expr |> fromExpr with + match expr |> from_expr with | Some payload -> payload :: payloads | None -> payloads) [] @@ -70,11 +70,11 @@ let rec getAttributePayload checkText (attributes : Typedtree.attributes) = in match attributes with | [] -> None - | ({txt; loc}, payload) :: _tl when checkText txt -> ( + | ({txt; loc}, payload) :: _tl when check_text txt -> ( let payload = match payload with | PStr [] -> Some UnrecognizedPayload - | PStr ({pstr_desc = Pstr_eval (expr, _)} :: _) -> expr |> fromExpr + | PStr ({pstr_desc = Pstr_eval (expr, _)} :: _) -> expr |> from_expr | PStr ({pstr_desc = Pstr_extension _} :: _) -> Some UnrecognizedPayload | PStr ({pstr_desc = Pstr_value _} :: _) -> Some UnrecognizedPayload | PStr ({pstr_desc = Pstr_primitive _} :: _) -> Some UnrecognizedPayload @@ -96,19 +96,19 @@ let rec getAttributePayload checkText (attributes : Typedtree.attributes) = match payload with | None -> None | Some payload -> Some (loc, payload)) - | _hd :: tl -> getAttributePayload checkText tl + | _hd :: tl -> get_attribute_payload check_text tl -let getGenTypeAsRenaming attributes = - match attributes |> getAttributePayload tagIsGenTypeAs with +let get_gen_type_as_renaming attributes = + match attributes |> get_attribute_payload tag_is_gen_type_as with | Some (_, StringPayload s) -> Some s | None -> ( - match attributes |> getAttributePayload tagIsGenType with + match attributes |> get_attribute_payload tag_is_gen_type with | Some (_, StringPayload s) -> Some s | _ -> None) | _ -> None (* This is not supported anymore: only use to give a warning *) -let checkUnsupportedGenTypeAsRenaming attributes = +let check_unsupported_gen_type_as_renaming attributes = let error ~loc = Log_.Color.setup (); Log_.info ~loc ~name:"Warning genType" (fun ppf () -> @@ -117,61 +117,61 @@ let checkUnsupportedGenTypeAsRenaming attributes = @genType.as is not supported anymore in type definitions. Use @as \ from the language.") in - match attributes |> getAttributePayload tagIsGenTypeAs with + match attributes |> get_attribute_payload tag_is_gen_type_as with | Some (loc, _) -> error ~loc | None -> ( - match attributes |> getAttributePayload tagIsGenType with + match attributes |> get_attribute_payload tag_is_gen_type with | Some (loc, _) -> error ~loc | None -> ()) -let getAsString attributes = - match attributes |> getAttributePayload tagIsAs with +let get_as_string attributes = + match attributes |> get_attribute_payload tag_is_as with | Some (_, StringPayload s) -> Some s | _ -> None -let getAsInt attributes = - match attributes |> getAttributePayload tagIsAs with +let get_as_int attributes = + match attributes |> get_attribute_payload tag_is_as with | Some (_, IntPayload s) -> ( try Some (int_of_string s) with Failure _ -> None) | _ -> None -let getAttributeImportRenaming attributes = - let attributeImport = attributes |> getAttributePayload tagIsGenTypeImport in - let genTypeAsRenaming = attributes |> getGenTypeAsRenaming in - match (attributeImport, genTypeAsRenaming) with - | Some (_, StringPayload importString), _ -> - (Some importString, genTypeAsRenaming) +let get_attribute_import_renaming attributes = + let attribute_import = attributes |> get_attribute_payload tag_is_gen_type_import in + let gen_type_as_renaming = attributes |> get_gen_type_as_renaming in + match (attribute_import, gen_type_as_renaming) with + | Some (_, StringPayload import_string), _ -> + (Some import_string, gen_type_as_renaming) | ( Some ( _, - TuplePayload [StringPayload importString; StringPayload renameString] + TuplePayload [StringPayload import_string; StringPayload rename_string] ), _ ) -> - (Some importString, Some renameString) - | _ -> (None, genTypeAsRenaming) + (Some import_string, Some rename_string) + | _ -> (None, gen_type_as_renaming) -let getTag attributes = - match attributes |> getAttributePayload tagIsTag with +let get_tag attributes = + match attributes |> get_attribute_payload tag_is_tag with | Some (_, StringPayload s) -> Some s | _ -> None -let getDocPayload attributes = - let docPayload = attributes |> getAttributePayload tagIsDoc in - match docPayload with - | Some (_, StringPayload docString) when docString <> "" -> Some docString +let get_doc_payload attributes = + let doc_payload = attributes |> get_attribute_payload tag_is_doc in + match doc_payload with + | Some (_, StringPayload doc_string) when doc_string <> "" -> Some doc_string | _ -> None -let docStringFromAttrs attributes = attributes |> getDocPayload +let doc_string_from_attrs attributes = attributes |> get_doc_payload -let hasAttribute checkText (attributes : Typedtree.attributes) = - getAttributePayload checkText attributes <> None +let has_attribute check_text (attributes : Typedtree.attributes) = + get_attribute_payload check_text attributes <> None -let fromAttributes ~(config : GenTypeConfig.t) ~loc +let from_attributes ~(config : GenTypeConfig.t) ~loc (attributes : Typedtree.attributes) = let default = if config.everything then GenType else NoGenType in - if hasAttribute tagIsGenTypeOpaque attributes then GenTypeOpaque - else if hasAttribute (fun s -> tagIsGenType s || tagIsGenTypeAs s) attributes + if has_attribute tag_is_gen_type_opaque attributes then GenTypeOpaque + else if has_attribute (fun s -> tag_is_gen_type s || tag_is_gen_type_as s) attributes then ( - (match attributes |> getAttributePayload tagIsGenType with + (match attributes |> get_attribute_payload tag_is_gen_type with | Some (_, UnrecognizedPayload) -> () | Some _ -> Log_.Color.setup (); @@ -181,118 +181,118 @@ let fromAttributes ~(config : GenTypeConfig.t) ~loc GenType) else default -let rec moduleTypeCheckAnnotation ~checkAnnotation +let rec module_type_check_annotation ~check_annotation ({mty_desc} : Typedtree.module_type) = match mty_desc with | Tmty_signature signature -> - signature |> signatureCheckAnnotation ~checkAnnotation + signature |> signature_check_annotation ~check_annotation | Tmty_ident _ | Tmty_functor _ | Tmty_with _ | Tmty_typeof _ | Tmty_alias _ -> false -and moduleTypeDeclarationCheckAnnotation ~checkAnnotation +and module_type_declaration_check_annotation ~check_annotation ({mtd_type; mtd_attributes; mtd_loc = loc} : Typedtree.module_type_declaration) = - mtd_attributes |> checkAnnotation ~loc + mtd_attributes |> check_annotation ~loc || match mtd_type with | None -> false | Some module_type -> - module_type |> moduleTypeCheckAnnotation ~checkAnnotation + module_type |> module_type_check_annotation ~check_annotation -and moduleDeclarationCheckAnnotation ~checkAnnotation +and module_declaration_check_annotation ~check_annotation ({md_attributes; md_type; md_loc = loc} : Typedtree.module_declaration) = - md_attributes |> checkAnnotation ~loc - || md_type |> moduleTypeCheckAnnotation ~checkAnnotation + md_attributes |> check_annotation ~loc + || md_type |> module_type_check_annotation ~check_annotation -and signatureItemCheckAnnotation ~checkAnnotation - (signatureItem : Typedtree.signature_item) = - match signatureItem.sig_desc with - | Tsig_type (_, typeDeclarations) -> - typeDeclarations +and signature_item_check_annotation ~check_annotation + (signature_item : Typedtree.signature_item) = + match signature_item.sig_desc with + | Tsig_type (_, type_declarations) -> + type_declarations |> List.exists (fun ({typ_attributes; typ_loc = loc} : Typedtree.type_declaration) -> - typ_attributes |> checkAnnotation ~loc) + typ_attributes |> check_annotation ~loc) | Tsig_value {val_attributes; val_loc = loc} -> - val_attributes |> checkAnnotation ~loc - | Tsig_module moduleDeclaration -> - moduleDeclaration |> moduleDeclarationCheckAnnotation ~checkAnnotation + val_attributes |> check_annotation ~loc + | Tsig_module module_declaration -> + module_declaration |> module_declaration_check_annotation ~check_annotation | Tsig_attribute attribute -> - [attribute] |> checkAnnotation ~loc:signatureItem.sig_loc - | Tsig_modtype moduleTypeDeclaration -> - moduleTypeDeclaration - |> moduleTypeDeclarationCheckAnnotation ~checkAnnotation + [attribute] |> check_annotation ~loc:signature_item.sig_loc + | Tsig_modtype module_type_declaration -> + module_type_declaration + |> module_type_declaration_check_annotation ~check_annotation | Tsig_typext _ | Tsig_exception _ | Tsig_recmodule _ | Tsig_open _ | Tsig_include _ | Tsig_class _ | Tsig_class_type _ -> false -and signatureCheckAnnotation ~checkAnnotation (signature : Typedtree.signature) +and signature_check_annotation ~check_annotation (signature : Typedtree.signature) = signature.sig_items - |> List.exists (signatureItemCheckAnnotation ~checkAnnotation) + |> List.exists (signature_item_check_annotation ~check_annotation) -let rec structureItemCheckAnnotation ~checkAnnotation - (structureItem : Typedtree.structure_item) = - match structureItem.str_desc with - | Tstr_type (_, typeDeclarations) -> - typeDeclarations +let rec structure_item_check_annotation ~check_annotation + (structure_item : Typedtree.structure_item) = + match structure_item.str_desc with + | Tstr_type (_, type_declarations) -> + type_declarations |> List.exists (fun ({typ_attributes; typ_loc = loc} : Typedtree.type_declaration) -> - typ_attributes |> checkAnnotation ~loc) - | Tstr_value (_loc, valueBindings) -> - valueBindings + typ_attributes |> check_annotation ~loc) + | Tstr_value (_loc, value_bindings) -> + value_bindings |> List.exists (fun ({vb_attributes; vb_loc = loc} : Typedtree.value_binding) -> - vb_attributes |> checkAnnotation ~loc) + vb_attributes |> check_annotation ~loc) | Tstr_primitive {val_attributes; val_loc = loc} -> - val_attributes |> checkAnnotation ~loc - | Tstr_module moduleBinding -> - moduleBinding |> moduleBindingCheckAnnotation ~checkAnnotation - | Tstr_recmodule moduleBindings -> - moduleBindings - |> List.exists (moduleBindingCheckAnnotation ~checkAnnotation) + val_attributes |> check_annotation ~loc + | Tstr_module module_binding -> + module_binding |> module_binding_check_annotation ~check_annotation + | Tstr_recmodule module_bindings -> + module_bindings + |> List.exists (module_binding_check_annotation ~check_annotation) | Tstr_include {incl_attributes; incl_mod; incl_loc = loc} -> - incl_attributes |> checkAnnotation ~loc - || incl_mod |> moduleExprCheckAnnotation ~checkAnnotation - | Tstr_modtype moduleTypeDeclaration -> - moduleTypeDeclaration - |> moduleTypeDeclarationCheckAnnotation ~checkAnnotation + incl_attributes |> check_annotation ~loc + || incl_mod |> module_expr_check_annotation ~check_annotation + | Tstr_modtype module_type_declaration -> + module_type_declaration + |> module_type_declaration_check_annotation ~check_annotation | Tstr_attribute attribute -> - [attribute] |> checkAnnotation ~loc:structureItem.str_loc + [attribute] |> check_annotation ~loc:structure_item.str_loc | Tstr_eval _ | Tstr_typext _ | Tstr_exception _ | Tstr_open _ | Tstr_class _ | Tstr_class_type _ -> false -and moduleExprCheckAnnotation ~checkAnnotation - (moduleExpr : Typedtree.module_expr) = - match moduleExpr.mod_desc with +and module_expr_check_annotation ~check_annotation + (module_expr : Typedtree.module_expr) = + match module_expr.mod_desc with | Tmod_structure structure -> - structure |> structureCheckAnnotation ~checkAnnotation + structure |> structure_check_annotation ~check_annotation | Tmod_constraint - (moduleExpr, _moduleType, moduleTypeConstraint, _moduleCoercion) -> ( - moduleExpr |> moduleExprCheckAnnotation ~checkAnnotation + (module_expr, _moduleType, module_type_constraint, _moduleCoercion) -> ( + module_expr |> module_expr_check_annotation ~check_annotation || - match moduleTypeConstraint with - | Tmodtype_explicit moduleType -> - moduleType |> moduleTypeCheckAnnotation ~checkAnnotation + match module_type_constraint with + | Tmodtype_explicit module_type -> + module_type |> module_type_check_annotation ~check_annotation | Tmodtype_implicit -> false) | Tmod_ident _ | Tmod_functor _ | Tmod_apply _ | Tmod_unpack _ -> false -and moduleBindingCheckAnnotation ~checkAnnotation +and module_binding_check_annotation ~check_annotation ({mb_expr; mb_attributes; mb_loc = loc} : Typedtree.module_binding) = - mb_attributes |> checkAnnotation ~loc - || mb_expr |> moduleExprCheckAnnotation ~checkAnnotation + mb_attributes |> check_annotation ~loc + || mb_expr |> module_expr_check_annotation ~check_annotation -and structureCheckAnnotation ~checkAnnotation (structure : Typedtree.structure) +and structure_check_annotation ~check_annotation (structure : Typedtree.structure) = structure.str_items - |> List.exists (structureItemCheckAnnotation ~checkAnnotation) + |> List.exists (structure_item_check_annotation ~check_annotation) -let importFromString importString : import = - let importPath = ImportPath.fromStringUnsafe importString in - {importPath} +let import_from_string import_string : import = + let import_path = ImportPath.from_string_unsafe import_string in + {import_path} -let updateConfigForModule ~(config : GenTypeConfig.t) attributes = - if attributes |> hasAttribute tagIsGenType then +let update_config_for_module ~(config : GenTypeConfig.t) attributes = + if attributes |> has_attribute tag_is_gen_type then {config with everything = true} else config diff --git a/jscomp/gentype/CodeItem.ml b/jscomp/gentype/CodeItem.ml index 176fa03e62..7913263c67 100644 --- a/jscomp/gentype/CodeItem.ml +++ b/jscomp/gentype/CodeItem.ml @@ -1,58 +1,58 @@ open GenTypeCommon -type exportType = { +type export_type = { loc: Location.t; - nameAs: string option; + name_as: string option; opaque: bool option; type_: type_; - typeVars: string list; - resolvedTypeName: ResolvedName.t; - docString: DocString.t; + type_vars: string list; + resolved_type_name: ResolvedName.t; + doc_string: DocString.t; } -type importValue = { - asPath: string; - importAnnotation: Annotation.import; +type import_value = { + as_path: string; + import_annotation: Annotation.import; type_: type_; - valueName: string; + value_name: string; } -type exportValue = { - docString: DocString.t; - moduleAccessPath: Runtime.moduleAccessPath; - originalName: string; - resolvedName: ResolvedName.t; +type export_value = { + doc_string: DocString.t; + module_access_path: Runtime.module_access_path; + original_name: string; + resolved_name: ResolvedName.t; type_: type_; } -type exportFromTypeDeclaration = { - exportType: exportType; +type export_from_type_declaration = { + export_type: export_type; annotation: Annotation.t; } -type importType = { - typeName: string; - asTypeName: string option; - importPath: ImportPath.t; +type import_type = { + type_name: string; + as_type_name: string option; + import_path: ImportPath.t; } -type exportTypeItem = { - typeVars: string list; +type export_type_item = { + type_vars: string list; type_: type_; annotation: Annotation.t; } -type exportTypeMap = exportTypeItem StringMap.t +type export_type_map = export_type_item StringMap.t -type typeDeclaration = { - exportFromTypeDeclaration: exportFromTypeDeclaration; - importTypes: importType list; +type type_declaration = { + export_from_type_declaration: export_from_type_declaration; + import_types: import_type list; } -type t = ExportValue of exportValue | ImportValue of importValue +type t = ExportValue of export_value | ImportValue of import_value type translation = { - importTypes: importType list; - codeItems: t list; - typeDeclarations: typeDeclaration list; + import_types: import_type list; + code_items: t list; + type_declarations: type_declaration list; } diff --git a/jscomp/gentype/Converter.ml b/jscomp/gentype/Converter.ml index 297da01cc6..f9b19509db 100644 --- a/jscomp/gentype/Converter.ml +++ b/jscomp/gentype/Converter.ml @@ -1,84 +1,84 @@ open GenTypeCommon -let typeGetInlined ~config ~lookupId ~typeNameIsInterface type0 = +let type_get_inlined ~config ~lookup_id ~type_name_is_interface type0 = let circular = ref "" in let rec visit ~(visited : StringSet.t) type_ = let normalized_ = type_ in match type_ with | Array (t, mutable_) -> - let tNormalized = t |> visit ~visited in - Array (tNormalized, mutable_) + let t_normalized = t |> visit ~visited in + Array (t_normalized, mutable_) | Dict _ -> normalized_ - | Function ({argTypes; retType} as function_) -> - let argConverted = argTypes |> List.map (argTypeToGroupedArg ~visited) in - let retNormalized = retType |> visit ~visited in - Function {function_ with argTypes = argConverted; retType = retNormalized} + | Function ({arg_types; ret_type} as function_) -> + let arg_converted = arg_types |> List.map (arg_type_to_grouped_arg ~visited) in + let ret_normalized = ret_type |> visit ~visited in + Function {function_ with arg_types = arg_converted; ret_type = ret_normalized} | Ident {builtin = true} -> normalized_ - | Ident {builtin = false; name; typeArgs} -> ( + | Ident {builtin = false; name; type_args} -> ( if visited |> StringSet.mem name then ( circular := name; normalized_) else let visited = visited |> StringSet.add name in - match name |> lookupId with + match name |> lookup_id with | {CodeItem.annotation = GenTypeOpaque} -> normalized_ | {annotation = NoGenType} -> normalized_ - | {typeVars; type_} -> + | {type_vars; type_} -> let pairs = - try List.combine typeVars typeArgs with Invalid_argument _ -> [] + try List.combine type_vars type_args with Invalid_argument _ -> [] in - let f typeVar = + let f type_var = match - pairs |> List.find (fun (typeVar1, _) -> typeVar = typeVar1) + pairs |> List.find (fun (type_var1, _) -> type_var = type_var1) with - | _, typeArgument -> Some typeArgument + | _, type_argument -> Some type_argument | exception Not_found -> None in let inlined = type_ |> TypeVars.substitute ~f |> visit ~visited in inlined | exception Not_found -> - let typeArgs = typeArgs |> List.map (fun t -> t |> visit ~visited) in - Ident {builtin = false; name; typeArgs}) + let type_args = type_args |> List.map (fun t -> t |> visit ~visited) in + Ident {builtin = false; name; type_args}) | Null t -> - let tNormalized = t |> visit ~visited in - Null tNormalized + let t_normalized = t |> visit ~visited in + Null t_normalized | Nullable t -> - let tNormalized = t |> visit ~visited in - Nullable tNormalized + let t_normalized = t |> visit ~visited in + Nullable t_normalized | Object _ -> normalized_ | Option t -> - let tNormalized = t |> visit ~visited in - Option tNormalized + let t_normalized = t |> visit ~visited in + Option t_normalized | Promise t -> - let tNormalized = t |> visit ~visited in - Promise tNormalized - | Tuple innerTypes -> - let normalizedList = innerTypes |> List.map (visit ~visited) in - Tuple normalizedList + let t_normalized = t |> visit ~visited in + Promise t_normalized + | Tuple inner_types -> + let normalized_list = inner_types |> List.map (visit ~visited) in + Tuple normalized_list | TypeVar _ -> normalized_ | Variant variant -> - let ordinaryVariant = not variant.polymorphic in - let withPayloadConverted = + let ordinary_variant = not variant.polymorphic in + let with_payload_converted = variant.payloads |> List.map (fun (payload : payload) -> {payload with t = payload.t |> visit ~visited}) in let normalized = - match withPayloadConverted with - | [] when ordinaryVariant -> normalized_ - | [payload] when ordinaryVariant -> + match with_payload_converted with + | [] when ordinary_variant -> normalized_ + | [payload] when ordinary_variant -> let normalized = Variant {variant with payloads = [payload]} in normalized - | withPayloadConverted -> - Variant {variant with payloads = withPayloadConverted} + | with_payload_converted -> + Variant {variant with payloads = with_payload_converted} in normalized - and argTypeToGroupedArg ~visited {aName; aType} = - let tNormalized = aType |> visit ~visited in - {aName; aType = tNormalized} + and arg_type_to_grouped_arg ~visited {a_name; a_type} = + let t_normalized = a_type |> visit ~visited in + {a_name; a_type = t_normalized} in let normalized = type0 |> visit ~visited:StringSet.empty in if !Debug.converter then Log_.item "type0:%s \n" - (type0 |> EmitType.typeToString ~config ~typeNameIsInterface); + (type0 |> EmitType.type_to_string ~config ~type_name_is_interface); normalized diff --git a/jscomp/gentype/Debug.ml b/jscomp/gentype/Debug.ml index b29c257009..193db60c01 100644 --- a/jscomp/gentype/Debug.ml +++ b/jscomp/gentype/Debug.ml @@ -1,42 +1,42 @@ let basic = ref false -let codeItems = ref false +let code_items = ref false let config = ref false let converter = ref false let dependencies = ref false -let moduleResolution = ref false -let notImplemented = ref false +let module_resolution = ref false +let not_implemented = ref false let translation = ref false -let typeEnv = ref false -let typeResolution = ref false +let type_env = ref false +let type_resolution = ref false -let setAll () = +let set_all () = basic := true; - codeItems := true; + code_items := true; config := true; converter := true; dependencies := true; - moduleResolution := true; - notImplemented := true; + module_resolution := true; + not_implemented := true; translation := true; - typeEnv := true; - typeResolution := true + type_env := true; + type_resolution := true -let setItem debugItem debugValue = - let isOn = - match debugValue with +let set_item debug_item debug_value = + let is_on = + match debug_value with | Ext_json_types.True _ -> true | _ -> false in - match debugItem with - | "all" when isOn -> setAll () - | "basic" -> basic := isOn - | "codeItems" -> codeItems := isOn - | "config" -> config := isOn - | "converter" -> converter := isOn - | "dependencies" -> dependencies := isOn - | "moduleResolution" -> moduleResolution := isOn - | "notImplemented" -> notImplemented := isOn - | "translation" -> translation := isOn - | "typeEnv" -> typeEnv := isOn - | "typeResolution" -> typeResolution := isOn + match debug_item with + | "all" when is_on -> set_all () + | "basic" -> basic := is_on + | "codeItems" -> code_items := is_on + | "config" -> config := is_on + | "converter" -> converter := is_on + | "dependencies" -> dependencies := is_on + | "moduleResolution" -> module_resolution := is_on + | "notImplemented" -> not_implemented := is_on + | "translation" -> translation := is_on + | "typeEnv" -> type_env := is_on + | "typeResolution" -> type_resolution := is_on | _ -> () diff --git a/jscomp/gentype/Dependencies.ml b/jscomp/gentype/Dependencies.ml index 889d0f4891..d0a1899ee6 100644 --- a/jscomp/gentype/Dependencies.ml +++ b/jscomp/gentype/Dependencies.ml @@ -1,69 +1,69 @@ open GenTypeCommon -let rec handleNamespace ~name dep = +let rec handle_namespace ~name dep = match dep with | External _ | Internal _ -> dep - | Dot (External s, moduleName) when s = name -> External moduleName - | Dot (dep1, s) -> Dot (dep1 |> handleNamespace ~name, s) + | Dot (External s, module_name) when s = name -> External module_name + | Dot (dep1, s) -> Dot (dep1 |> handle_namespace ~name, s) -let rec fromPath1 ~config ~typeEnv (path : Path.t) = +let rec from_path1 ~config ~type_env (path : Path.t) = match path with | Pident id -> ( let name = id |> Ident.name in - match typeEnv |> TypeEnv.lookup ~name with - | None -> (typeEnv, External name) - | Some typeEnv1 -> ( - let typeEnv2 = - match typeEnv |> TypeEnv.getModule ~name with - | Some typeEnv2 -> typeEnv2 - | None -> typeEnv1 + match type_env |> TypeEnv.lookup ~name with + | None -> (type_env, External name) + | Some type_env1 -> ( + let type_env2 = + match type_env |> TypeEnv.get_module ~name with + | Some type_env2 -> type_env2 + | None -> type_env1 in - match typeEnv1 |> TypeEnv.expandAliasToExternalModule ~name with - | Some dep -> (typeEnv2, dep) + match type_env1 |> TypeEnv.expand_alias_to_external_module ~name with + | Some dep -> (type_env2, dep) | None -> - let resolvedName = name |> TypeEnv.addModulePath ~typeEnv:typeEnv1 in - (typeEnv2, Internal resolvedName))) - | Pdot (Pident id, s, _pos) when id |> ScopedPackage.isGeneratedModule ~config + let resolved_name = name |> TypeEnv.add_module_path ~type_env:type_env1 in + (type_env2, Internal resolved_name))) + | Pdot (Pident id, s, _pos) when id |> ScopedPackage.is_generated_module ~config -> - ( typeEnv, - External (s |> ScopedPackage.addGeneratedModule ~generatedModule:id) ) + ( type_env, + External (s |> ScopedPackage.add_generated_module ~generated_module:id) ) | Pdot (p, s, _pos) -> ( - let typeEnvFromP, dep = p |> fromPath1 ~config ~typeEnv in - match typeEnvFromP |> TypeEnv.expandAliasToExternalModule ~name:s with - | Some dep -> (typeEnvFromP, dep) - | None -> (typeEnvFromP, Dot (dep, s))) + let type_env_from_p, dep = p |> from_path1 ~config ~type_env in + match type_env_from_p |> TypeEnv.expand_alias_to_external_module ~name:s with + | Some dep -> (type_env_from_p, dep) + | None -> (type_env_from_p, Dot (dep, s))) | Papply _ -> - ( typeEnv, - Internal ("__Papply_unsupported_genType__" |> ResolvedName.fromString) ) + ( type_env, + Internal ("__Papply_unsupported_genType__" |> ResolvedName.from_string) ) -let rec isInternal dep = +let rec is_internal dep = match dep with | External _ -> false | Internal _ -> true - | Dot (d, _) -> d |> isInternal + | Dot (d, _) -> d |> is_internal -let fromPath ~config ~typeEnv path = - let _, dep = path |> fromPath1 ~config ~typeEnv in - if !Debug.typeResolution then +let from_path ~config ~type_env path = + let _, dep = path |> from_path1 ~config ~type_env in + if !Debug.type_resolution then Log_.item "fromPath path:%s typeEnv:%s %s resolved:%s\n" (path |> Path.name) - (typeEnv |> TypeEnv.toString) - (match dep |> isInternal with + (type_env |> TypeEnv.to_string) + (match dep |> is_internal with | true -> "Internal" | false -> "External") - (dep |> depToString); + (dep |> dep_to_string); match config.namespace with | None -> dep - | Some name -> dep |> handleNamespace ~name + | Some name -> dep |> handle_namespace ~name -let rec getOuterModuleName dep = +let rec get_outer_module_name dep = match dep with - | External name -> name |> ModuleName.fromStringUnsafe - | Internal resolvedName -> - resolvedName |> ResolvedName.toString |> ModuleName.fromStringUnsafe - | Dot (dep1, _) -> dep1 |> getOuterModuleName + | External name -> name |> ModuleName.from_string_unsafe + | Internal resolved_name -> + resolved_name |> ResolvedName.to_string |> ModuleName.from_string_unsafe + | Dot (dep1, _) -> dep1 |> get_outer_module_name -let rec removeExternalOuterModule dep = +let rec remove_external_outer_module dep = match dep with | External _ | Internal _ -> dep | Dot (External _, s) -> External s - | Dot (dep1, s) -> Dot (dep1 |> removeExternalOuterModule, s) + | Dot (dep1, s) -> Dot (dep1 |> remove_external_outer_module, s) diff --git a/jscomp/gentype/EmitJs.ml b/jscomp/gentype/EmitJs.ml index ec289babdf..b1607af8a7 100644 --- a/jscomp/gentype/EmitJs.ml +++ b/jscomp/gentype/EmitJs.ml @@ -1,89 +1,89 @@ open GenTypeCommon type env = { - requiresEarly: ImportPath.t Config.ModuleNameMap.t; + requires_early: ImportPath.t Config.ModuleNameMap.t; requires: ImportPath.t Config.ModuleNameMap.t; (** For each .cmt we import types from, keep the map of exported types *) - cmtToExportTypeMap: CodeItem.exportTypeMap StringMap.t; + cmt_to_export_type_map: CodeItem.export_type_map StringMap.t; (** Map of types imported from other files *) - exportTypeMapFromOtherFiles: CodeItem.exportTypeMap; - importedValueOrComponent: bool; + export_type_map_from_other_files: CodeItem.export_type_map; + imported_value_or_component: bool; } -let requireModule ~import ~env ~importPath moduleName = +let require_module ~import ~env ~import_path module_name = let requires = match import with - | true -> env.requiresEarly + | true -> env.requires_early | false -> env.requires in - let requiresNew = - requires |> Config.ModuleNameMap.add moduleName importPath + let requires_new = + requires |> Config.ModuleNameMap.add module_name import_path in match import with - | true -> {env with requiresEarly = requiresNew} - | false -> {env with requires = requiresNew} + | true -> {env with requires_early = requires_new} + | false -> {env with requires = requires_new} -let createExportTypeMap ~config ~file ~fromCmtReadRecursively - (typeDeclarations : CodeItem.typeDeclaration list) : CodeItem.exportTypeMap +let create_export_type_map ~config ~file ~from_cmt_read_recursively + (type_declarations : CodeItem.type_declaration list) : CodeItem.export_type_map = - if !Debug.codeItems then Log_.item "Create Type Map for %s\n" file; - let updateExportTypeMap (exportTypeMap : CodeItem.exportTypeMap) - (typeDeclaration : CodeItem.typeDeclaration) : CodeItem.exportTypeMap = - let addExportType ~annotation - ({resolvedTypeName; type_; typeVars} : CodeItem.exportType) = + if !Debug.code_items then Log_.item "Create Type Map for %s\n" file; + let update_export_type_map (export_type_map : CodeItem.export_type_map) + (type_declaration : CodeItem.type_declaration) : CodeItem.export_type_map = + let add_export_type ~annotation + ({resolved_type_name; type_; type_vars} : CodeItem.export_type) = let annotation = match annotation with - | Annotation.NoGenType when fromCmtReadRecursively -> Annotation.GenType + | Annotation.NoGenType when from_cmt_read_recursively -> Annotation.GenType | _ -> annotation in - if !Debug.codeItems then + if !Debug.code_items then Log_.item "Type Map: %s%s%s\n" - (resolvedTypeName |> ResolvedName.toString) - (match typeVars = [] with + (resolved_type_name |> ResolvedName.to_string) + (match type_vars = [] with | true -> "" - | false -> "(" ^ (typeVars |> String.concat ",") ^ ")") + | false -> "(" ^ (type_vars |> String.concat ",") ^ ")") (" " - ^ (annotation |> Annotation.toString |> EmitText.comment) + ^ (annotation |> Annotation.to_string |> EmitText.comment) ^ " = " ^ (type_ - |> EmitType.typeToString ~config ~typeNameIsInterface:(fun _ -> + |> EmitType.type_to_string ~config ~type_name_is_interface:(fun _ -> false))); - exportTypeMap + export_type_map |> StringMap.add - (resolvedTypeName |> ResolvedName.toString) - {CodeItem.typeVars; type_; annotation} + (resolved_type_name |> ResolvedName.to_string) + {CodeItem.type_vars; type_; annotation} in - match typeDeclaration.exportFromTypeDeclaration with - | {exportType; annotation} -> exportType |> addExportType ~annotation + match type_declaration.export_from_type_declaration with + | {export_type; annotation} -> export_type |> add_export_type ~annotation in - typeDeclarations |> List.fold_left updateExportTypeMap StringMap.empty + type_declarations |> List.fold_left update_export_type_map StringMap.empty -let codeItemToString ~config ~typeNameIsInterface (codeItem : CodeItem.t) = - match codeItem with - | ExportValue {resolvedName; type_} -> +let code_item_to_string ~config ~type_name_is_interface (code_item : CodeItem.t) = + match code_item with + | ExportValue {resolved_name; type_} -> "ExportValue" ^ " resolvedName:" - ^ ResolvedName.toString resolvedName + ^ ResolvedName.to_string resolved_name ^ " type:" - ^ EmitType.typeToString ~config ~typeNameIsInterface type_ - | ImportValue {importAnnotation} -> - "ImportValue " ^ (importAnnotation.importPath |> ImportPath.dump) + ^ EmitType.type_to_string ~config ~type_name_is_interface type_ + | ImportValue {import_annotation} -> + "ImportValue " ^ (import_annotation.import_path |> ImportPath.dump) -let emitExportType ~emitters ~config ~typeNameIsInterface - {CodeItem.loc; nameAs; opaque; type_; typeVars; resolvedTypeName; docString} +let emit_export_type ~emitters ~config ~type_name_is_interface + {CodeItem.loc; name_as; opaque; type_; type_vars; resolved_type_name; doc_string} = - let freeTypeVars = TypeVars.free type_ in - let isGADT = - freeTypeVars |> List.exists (fun s -> not (List.mem s typeVars)) + let free_type_vars = TypeVars.free type_ in + let is_g_a_d_t = + free_type_vars |> List.exists (fun s -> not (List.mem s type_vars)) in let opaque = match opaque with | Some true -> opaque - | _ when isGADT -> + | _ when is_g_a_d_t -> Log_.Color.setup (); Log_.info ~loc ~name:"Warning genType" (fun ppf () -> Format.fprintf ppf "GADT types are not supported: exporting %s as opaque type" - (resolvedTypeName |> ResolvedName.toString)); + (resolved_type_name |> ResolvedName.to_string)); Some true | _ -> opaque in @@ -92,103 +92,103 @@ let emitExportType ~emitters ~config ~typeNameIsInterface | Some opaque -> opaque | None -> false in - resolvedTypeName |> ResolvedName.toString - |> EmitType.emitExportType ~config ~emitters ~nameAs ~opaque ~type_ - ~typeNameIsInterface ~typeVars ~docString + resolved_type_name |> ResolvedName.to_string + |> EmitType.emit_export_type ~config ~emitters ~name_as ~opaque ~type_ + ~type_name_is_interface ~type_vars ~doc_string -let typeNameIsInterface ~(exportTypeMap : CodeItem.exportTypeMap) - ~(exportTypeMapFromOtherFiles : CodeItem.exportTypeMap) typeName = - let typeIsInterface type_ = +let type_name_is_interface ~(export_type_map : CodeItem.export_type_map) + ~(export_type_map_from_other_files : CodeItem.export_type_map) type_name = + let type_is_interface type_ = match type_ with | Object _ -> true | _ -> false in - match exportTypeMap |> StringMap.find typeName with - | {type_} -> type_ |> typeIsInterface + match export_type_map |> StringMap.find type_name with + | {type_} -> type_ |> type_is_interface | exception Not_found -> ( - match exportTypeMapFromOtherFiles |> StringMap.find typeName with - | {type_} -> type_ |> typeIsInterface + match export_type_map_from_other_files |> StringMap.find type_name with + | {type_} -> type_ |> type_is_interface | exception Not_found -> false) -let emitExportFromTypeDeclaration ~config ~emitters ~env ~typeNameIsInterface - (exportFromTypeDeclaration : CodeItem.exportFromTypeDeclaration) = +let emit_export_from_type_declaration ~config ~emitters ~env ~type_name_is_interface + (export_from_type_declaration : CodeItem.export_from_type_declaration) = ( env, - exportFromTypeDeclaration.exportType - |> emitExportType ~emitters ~config ~typeNameIsInterface ) + export_from_type_declaration.export_type + |> emit_export_type ~emitters ~config ~type_name_is_interface ) -let emitExportFromTypeDeclarations ~config ~emitters ~env ~typeNameIsInterface - exportFromTypeDeclarations = - exportFromTypeDeclarations +let emit_export_from_type_declarations ~config ~emitters ~env ~type_name_is_interface + export_from_type_declarations = + export_from_type_declarations |> List.fold_left (fun (env, emitters) -> - emitExportFromTypeDeclaration ~config ~emitters ~env - ~typeNameIsInterface) + emit_export_from_type_declaration ~config ~emitters ~env + ~type_name_is_interface) (env, emitters) -let emitCodeItem ~config ~emitters ~moduleItemsEmitter ~env ~fileName - ~outputFileRelative ~resolver ~inlineOneLevel ~typeNameIsInterface codeItem +let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name + ~output_file_relative ~resolver ~inline_one_level ~type_name_is_interface code_item = - if !Debug.codeItems then + if !Debug.code_items then Log_.item "Code Item: %s\n" - (codeItem |> codeItemToString ~config ~typeNameIsInterface); - match codeItem with - | ImportValue {asPath; importAnnotation; type_; valueName} -> - let importPath = importAnnotation.importPath in - let firstNameInPath, restOfPath = - match valueName = asPath with - | true -> (valueName, "") + (code_item |> code_item_to_string ~config ~type_name_is_interface); + match code_item with + | ImportValue {as_path; import_annotation; type_; value_name} -> + let import_path = import_annotation.import_path in + let first_name_in_path, rest_of_path = + match value_name = as_path with + | true -> (value_name, "") | false -> ( - match asPath |> String.split_on_char '.' with + match as_path |> String.split_on_char '.' with | x :: y -> (x, "" :: y |> String.concat ".") - | _ -> (asPath, "")) + | _ -> (as_path, "")) in - let emitters, importedAsName, env = + let emitters, imported_as_name, env = (* emit an import {... as ...} immediately *) - let valueNameNotChecked = valueName ^ "NotChecked" in + let value_name_not_checked = value_name ^ "NotChecked" in let emitters = - importPath - |> EmitType.emitImportValueAsEarly ~emitters ~name:firstNameInPath - ~nameAs:(Some valueNameNotChecked) + import_path + |> EmitType.emit_import_value_as_early ~emitters ~name:first_name_in_path + ~name_as:(Some value_name_not_checked) in - (emitters, valueNameNotChecked, env) + (emitters, value_name_not_checked, env) in let type_ = match type_ with | Function - ({argTypes = [{aType = Object (closedFlag, fields); aName}]; retType} + ({arg_types = [{a_type = Object (closed_flag, fields); a_name}]; ret_type} as function_) - when retType |> EmitType.isTypeFunctionComponent ~fields -> + when ret_type |> EmitType.is_type_function_component ~fields -> (* JSX V3 *) let fields = fields |> List.map (fun (field : field) -> match - field.nameJS = "children" - && field.type_ |> EmitType.isTypeReactElement + field.name_j_s = "children" + && field.type_ |> EmitType.is_type_react_element with - | true -> {field with type_ = EmitType.typeReactChild} + | true -> {field with type_ = EmitType.type_react_child} | false -> field) in let function_ = { function_ with - argTypes = [{aType = Object (closedFlag, fields); aName}]; + arg_types = [{a_type = Object (closed_flag, fields); a_name}]; } in Function function_ | Function - ({argTypes = [{aType = Ident {name} as propsType; aName}]; retType} as + ({arg_types = [{a_type = Ident {name} as props_type; a_name}]; ret_type} as function_) when Filename.check_suffix name "props" - && retType |> EmitType.isTypeFunctionComponent ~fields:[] -> ( - match inlineOneLevel propsType with - | Object (closedFlags, fields) -> + && ret_type |> EmitType.is_type_function_component ~fields:[] -> ( + match inline_one_level props_type with + | Object (closed_flags, fields) -> (* JSX V3 *) let fields = Ext_list.filter_map fields (fun (field : field) -> - match field.nameJS with - | "children" when field.type_ |> EmitType.isTypeReactElement -> - Some {field with type_ = EmitType.typeReactChild} + match field.name_j_s with + | "children" when field.type_ |> EmitType.is_type_react_element -> + Some {field with type_ = EmitType.type_react_child} | "key" -> (* Filter out key, which is added to the props type definition in V4 *) None @@ -197,360 +197,360 @@ let emitCodeItem ~config ~emitters ~moduleItemsEmitter ~env ~fileName let function_ = { function_ with - argTypes = [{aType = Object (closedFlags, fields); aName}]; + arg_types = [{a_type = Object (closed_flags, fields); a_name}]; } in Function function_ | _ -> type_) | _ -> type_ in - let valueNameTypeChecked = valueName ^ "TypeChecked" in + let value_name_type_checked = value_name ^ "TypeChecked" in let emitters = - importedAsName ^ restOfPath - |> EmitType.emitExportConst ~config + imported_as_name ^ rest_of_path + |> EmitType.emit_export_const ~config ~comment: - ("In case of type error, check the type of '" ^ valueName + ("In case of type error, check the type of '" ^ value_name ^ "' in '" - ^ (fileName |> ModuleName.toString) + ^ (file_name |> ModuleName.to_string) ^ ".res'" ^ " and '" - ^ (importPath |> ImportPath.emit) + ^ (import_path |> ImportPath.emit) ^ "'.") - ~early:true ~emitters ~name:valueNameTypeChecked ~type_ - ~typeNameIsInterface + ~early:true ~emitters ~name:value_name_type_checked ~type_ + ~type_name_is_interface in - let valueNameNotDefault = - match valueName = "default" with + let value_name_not_default = + match value_name = "default" with | true -> Runtime.default - | false -> valueName + | false -> value_name in let emitters = - valueNameTypeChecked - |> EmitType.emitTypeCast ~config ~type_ ~typeNameIsInterface - |> EmitType.emitExportConst + value_name_type_checked + |> EmitType.emit_type_cast ~config ~type_ ~type_name_is_interface + |> EmitType.emit_export_const ~comment: - ("Export '" ^ valueNameNotDefault + ("Export '" ^ value_name_not_default ^ "' early to allow circular import from the '.bs.js' file.") - ~config ~early:true ~emitters ~name:valueNameNotDefault - ~type_:unknown ~typeNameIsInterface + ~config ~early:true ~emitters ~name:value_name_not_default + ~type_:unknown ~type_name_is_interface in let emitters = - match valueName = "default" with - | true -> EmitType.emitExportDefault ~emitters valueNameNotDefault + match value_name = "default" with + | true -> EmitType.emit_export_default ~emitters value_name_not_default | false -> emitters in - ({env with importedValueOrComponent = true}, emitters) - | ExportValue {docString; moduleAccessPath; originalName; resolvedName; type_} + ({env with imported_value_or_component = true}, emitters) + | ExportValue {doc_string; module_access_path; original_name; resolved_name; type_} -> - let resolvedNameStr = ResolvedName.toString resolvedName in - let importPath = - fileName - |> ModuleResolver.resolveModule ~config ~importExtension:config.suffix - ~outputFileRelative ~resolver ~useBsDependencies:false + let resolved_name_str = ResolvedName.to_string resolved_name in + let import_path = + file_name + |> ModuleResolver.resolve_module ~config ~import_extension:config.suffix + ~output_file_relative ~resolver ~use_bs_dependencies:false in - let fileNameJs = fileName |> ModuleName.forJsFile in - let envWithRequires = - fileNameJs |> requireModule ~import:false ~env ~importPath + let file_name_js = file_name |> ModuleName.for_js_file in + let env_with_requires = + file_name_js |> require_module ~import:false ~env ~import_path in let default = "default" in let make = "make" in let name = - match originalName = default with + match original_name = default with | true -> Runtime.default - | false -> resolvedNameStr + | false -> resolved_name_str in let module HookType = struct type t = { - propsType: type_; - resolvedTypeName: ResolvedName.t; - typeVars: string list; + props_type: type_; + resolved_type_name: ResolvedName.t; + type_vars: string list; } end in - let type_, hookType = + let type_, hook_type = match type_ with | Function ({ - argTypes = [{aType = Object (closedFlags, fields)}]; - retType; - typeVars; + arg_types = [{a_type = Object (closed_flags, fields)}]; + ret_type; + type_vars; } as function_) - when retType |> EmitType.isTypeFunctionComponent ~fields -> + when ret_type |> EmitType.is_type_function_component ~fields -> (* JSX V3 *) - let propsType = + let props_type = let fields = fields |> List.map (fun (field : field) -> match - field.nameJS = "children" - && field.type_ |> EmitType.isTypeReactElement + field.name_j_s = "children" + && field.type_ |> EmitType.is_type_react_element with - | true -> {field with type_ = EmitType.typeReactChild} + | true -> {field with type_ = EmitType.type_react_child} | false -> field) in - Object (closedFlags, fields) + Object (closed_flags, fields) in let function_ = - {function_ with argTypes = [{aName = ""; aType = propsType}]} + {function_ with arg_types = [{a_name = ""; a_type = props_type}]} in - let resolvedTypeName = + let resolved_type_name = if - (not config.emitTypePropDone) - && (originalName = default || originalName = make) + (not config.emit_type_prop_done) + && (original_name = default || original_name = make) then ( - config.emitTypePropDone <- true; - ResolvedName.fromString "Props") - else ResolvedName.fromString name |> ResolvedName.dot "Props" + config.emit_type_prop_done <- true; + ResolvedName.from_string "Props") + else ResolvedName.from_string name |> ResolvedName.dot "Props" in ( Function function_, - Some {HookType.propsType; resolvedTypeName; typeVars} ) + Some {HookType.props_type; resolved_type_name; type_vars} ) | Function - ({argTypes = [{aType = Ident {name} as propsType}]; retType} as + ({arg_types = [{a_type = Ident {name} as props_type}]; ret_type} as function_) when Filename.check_suffix name "props" - && retType |> EmitType.isTypeFunctionComponent ~fields:[] -> - let compType = - match inlineOneLevel propsType with - | Object (closedFlags, fields) -> + && ret_type |> EmitType.is_type_function_component ~fields:[] -> + let comp_type = + match inline_one_level props_type with + | Object (closed_flags, fields) -> (* JSX V4 *) - let propsType = + let props_type = let fields = Ext_list.filter_map fields (fun (field : field) -> - match field.nameJS with - | "children" when field.type_ |> EmitType.isTypeReactElement + match field.name_j_s with + | "children" when field.type_ |> EmitType.is_type_react_element -> - Some {field with type_ = EmitType.typeReactChild} + Some {field with type_ = EmitType.type_react_child} | "key" -> (* Filter out key, which is added to the props type definition in V4 *) None | _ -> Some field) in - Object (closedFlags, fields) + Object (closed_flags, fields) in let function_ = - {function_ with argTypes = [{aName = ""; aType = propsType}]} + {function_ with arg_types = [{a_name = ""; a_type = props_type}]} in Function function_ | _ -> type_ in - (compType, None) + (comp_type, None) | _ -> (type_, None) in - resolvedName - |> ExportModule.extendExportModules ~docString ~moduleItemsEmitter ~type_; + resolved_name + |> ExportModule.extend_export_modules ~doc_string ~module_items_emitter ~type_; let emitters = - match hookType with - | Some {propsType; resolvedTypeName; typeVars} -> - let exportType = + match hook_type with + | Some {props_type; resolved_type_name; type_vars} -> + let export_type = ({ loc = Location.none; - nameAs = None; + name_as = None; opaque = Some false; - type_ = propsType; - typeVars; - resolvedTypeName; - docString; + type_ = props_type; + type_vars; + resolved_type_name; + doc_string; } - : CodeItem.exportType) + : CodeItem.export_type) in (* For doc gen (https://github.com/cristianoc/genType/issues/342) *) - config.emitImportReact <- true; - emitExportType ~emitters ~config ~typeNameIsInterface exportType + config.emit_import_react <- true; + emit_export_type ~emitters ~config ~type_name_is_interface export_type | _ -> emitters in let emitters = - (fileNameJs |> ModuleName.toString) + (file_name_js |> ModuleName.to_string) ^ "." - ^ (moduleAccessPath |> Runtime.emitModuleAccessPath ~config) - |> EmitType.emitExportConst ~config ~docString ~early:false ~emitters - ~name ~type_ ~typeNameIsInterface + ^ (module_access_path |> Runtime.emit_module_access_path ~config) + |> EmitType.emit_export_const ~config ~doc_string ~early:false ~emitters + ~name ~type_ ~type_name_is_interface in let emitters = - match originalName = default with - | true -> EmitType.emitExportDefault ~emitters Runtime.default + match original_name = default with + | true -> EmitType.emit_export_default ~emitters Runtime.default | false -> emitters in - (envWithRequires, emitters) + (env_with_requires, emitters) -let emitCodeItems ~config ~outputFileRelative ~emitters ~moduleItemsEmitter ~env - ~fileName ~resolver ~typeNameIsInterface ~inlineOneLevel codeItems = - codeItems +let emit_code_items ~config ~output_file_relative ~emitters ~module_items_emitter ~env + ~file_name ~resolver ~type_name_is_interface ~inline_one_level code_items = + code_items |> List.fold_left (fun (env, emitters) -> - emitCodeItem ~config ~emitters ~moduleItemsEmitter ~env ~fileName - ~outputFileRelative ~resolver ~inlineOneLevel ~typeNameIsInterface) + emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name + ~output_file_relative ~resolver ~inline_one_level ~type_name_is_interface) (env, emitters) -let emitRequires ~importedValueOrComponent ~early ~config ~requires emitters = +let emit_requires ~imported_value_or_component ~early ~config ~requires emitters = Config.ModuleNameMap.fold - (fun moduleName importPath emitters -> - importPath - |> EmitType.emitRequire ~importedValueOrComponent ~early ~emitters ~config - ~moduleName) + (fun module_name import_path emitters -> + import_path + |> EmitType.emit_require ~imported_value_or_component ~early ~emitters ~config + ~module_name) requires emitters -let typeGetInlined ~config ~exportTypeMap type_ = +let type_get_inlined ~config ~export_type_map type_ = type_ - |> Converter.typeGetInlined ~config - ~lookupId:(fun s -> exportTypeMap |> StringMap.find s) - ~typeNameIsInterface:(fun _ -> false) + |> Converter.type_get_inlined ~config + ~lookup_id:(fun s -> export_type_map |> StringMap.find s) + ~type_name_is_interface:(fun _ -> false) (** Read the cmt file referenced in an import type, and recursively for the import types obtained from reading the cmt file. *) -let rec readCmtFilesRecursively ~config ~env ~inputCmtTranslateTypeDeclarations - ~outputFileRelative ~resolver {CodeItem.typeName; asTypeName; importPath} = - let updateTypeMapFromOtherFiles ~asType ~exportTypeMapFromCmt env = - match exportTypeMapFromCmt |> StringMap.find typeName with - | (exportTypeItem : CodeItem.exportTypeItem) -> +let rec read_cmt_files_recursively ~config ~env ~input_cmt_translate_type_declarations + ~output_file_relative ~resolver {CodeItem.type_name; as_type_name; import_path} = + let update_type_map_from_other_files ~as_type ~export_type_map_from_cmt env = + match export_type_map_from_cmt |> StringMap.find type_name with + | (export_type_item : CodeItem.export_type_item) -> let type_ = - exportTypeItem.type_ - |> typeGetInlined ~config ~exportTypeMap:exportTypeMapFromCmt + export_type_item.type_ + |> type_get_inlined ~config ~export_type_map:export_type_map_from_cmt in { env with - exportTypeMapFromOtherFiles = - env.exportTypeMapFromOtherFiles - |> StringMap.add asType {exportTypeItem with type_}; + export_type_map_from_other_files = + env.export_type_map_from_other_files + |> StringMap.add as_type {export_type_item with type_}; } | exception Not_found -> env in - let cmtFile = - importPath - |> ImportPath.toCmt ~config ~outputFileRelative - |> Paths.getCmtFile + let cmt_file = + import_path + |> ImportPath.to_cmt ~config ~output_file_relative + |> Paths.get_cmt_file in - match asTypeName with - | Some asType when cmtFile <> "" -> ( - match env.cmtToExportTypeMap |> StringMap.find cmtFile with - | exportTypeMapFromCmt -> - env |> updateTypeMapFromOtherFiles ~asType ~exportTypeMapFromCmt + match as_type_name with + | Some as_type when cmt_file <> "" -> ( + match env.cmt_to_export_type_map |> StringMap.find cmt_file with + | export_type_map_from_cmt -> + env |> update_type_map_from_other_files ~as_type ~export_type_map_from_cmt | exception Not_found -> (* cmt file not read before: this ensures termination *) - let typeDeclarations = - Cmt_format.read_cmt cmtFile - |> inputCmtTranslateTypeDeclarations ~config ~outputFileRelative + let type_declarations = + Cmt_format.read_cmt cmt_file + |> input_cmt_translate_type_declarations ~config ~output_file_relative ~resolver - |> fun (x : CodeItem.translation) -> x.typeDeclarations + |> fun (x : CodeItem.translation) -> x.type_declarations in - let exportTypeMapFromCmt = - typeDeclarations - |> createExportTypeMap ~config ~fromCmtReadRecursively:true + let export_type_map_from_cmt = + type_declarations + |> create_export_type_map ~config ~from_cmt_read_recursively:true ~file: - (cmtFile |> Filename.basename + (cmt_file |> Filename.basename |> (Filename.chop_extension [@doesNotRaise])) in - let cmtToExportTypeMap = - env.cmtToExportTypeMap |> StringMap.add cmtFile exportTypeMapFromCmt + let cmt_to_export_type_map = + env.cmt_to_export_type_map |> StringMap.add cmt_file export_type_map_from_cmt in let env = - {env with cmtToExportTypeMap} - |> updateTypeMapFromOtherFiles ~asType ~exportTypeMapFromCmt + {env with cmt_to_export_type_map} + |> update_type_map_from_other_files ~as_type ~export_type_map_from_cmt in - let newImportTypes = - typeDeclarations - |> List.map (fun (typeDeclaration : CodeItem.typeDeclaration) -> - typeDeclaration.importTypes) + let new_import_types = + type_declarations + |> List.map (fun (type_declaration : CodeItem.type_declaration) -> + type_declaration.import_types) |> List.concat in - newImportTypes + new_import_types |> List.fold_left - (fun env newImportType -> - newImportType - |> readCmtFilesRecursively ~config ~env - ~inputCmtTranslateTypeDeclarations ~outputFileRelative + (fun env new_import_type -> + new_import_type + |> read_cmt_files_recursively ~config ~env + ~input_cmt_translate_type_declarations ~output_file_relative ~resolver) env) | _ -> env -let emitImportType ~config ~emitters ~env ~inputCmtTranslateTypeDeclarations - ~outputFileRelative ~resolver ~typeNameIsInterface - ({CodeItem.typeName; asTypeName; importPath} as importType) = +let emit_import_type ~config ~emitters ~env ~input_cmt_translate_type_declarations + ~output_file_relative ~resolver ~type_name_is_interface + ({CodeItem.type_name; as_type_name; import_path} as import_type) = let env = - importType - |> readCmtFilesRecursively ~config ~env ~inputCmtTranslateTypeDeclarations - ~outputFileRelative ~resolver + import_type + |> read_cmt_files_recursively ~config ~env ~input_cmt_translate_type_declarations + ~output_file_relative ~resolver in let emitters = - EmitType.emitImportTypeAs ~emitters ~config ~typeName ~asTypeName - ~typeNameIsInterface:(typeNameIsInterface ~env) ~importPath + EmitType.emit_import_type_as ~emitters ~config ~type_name ~as_type_name + ~type_name_is_interface:(type_name_is_interface ~env) ~import_path in (env, emitters) -let emitImportTypes ~config ~emitters ~env ~inputCmtTranslateTypeDeclarations - ~outputFileRelative ~resolver ~typeNameIsInterface importTypes = - importTypes +let emit_import_types ~config ~emitters ~env ~input_cmt_translate_type_declarations + ~output_file_relative ~resolver ~type_name_is_interface import_types = + import_types |> List.fold_left (fun (env, emitters) -> - emitImportType ~config ~emitters ~env - ~inputCmtTranslateTypeDeclarations ~outputFileRelative ~resolver - ~typeNameIsInterface) + emit_import_type ~config ~emitters ~env + ~input_cmt_translate_type_declarations ~output_file_relative ~resolver + ~type_name_is_interface) (env, emitters) -let getAnnotatedTypedDeclarations ~annotatedSet typeDeclarations = - typeDeclarations - |> List.map (fun typeDeclaration -> - let nameInAnnotatedSet = - annotatedSet +let get_annotated_typed_declarations ~annotated_set type_declarations = + type_declarations + |> List.map (fun type_declaration -> + let name_in_annotated_set = + annotated_set |> StringSet.mem - (typeDeclaration.CodeItem.exportFromTypeDeclaration.exportType - .resolvedTypeName |> ResolvedName.toString) + (type_declaration.CodeItem.export_from_type_declaration.export_type + .resolved_type_name |> ResolvedName.to_string) in - if nameInAnnotatedSet then + if name_in_annotated_set then { - typeDeclaration with - exportFromTypeDeclaration = + type_declaration with + export_from_type_declaration = { - typeDeclaration.exportFromTypeDeclaration with + type_declaration.export_from_type_declaration with annotation = GenType; }; } - else typeDeclaration) + else type_declaration) |> List.filter (fun - ({exportFromTypeDeclaration = {annotation}} : CodeItem.typeDeclaration) + ({export_from_type_declaration = {annotation}} : CodeItem.type_declaration) -> annotation <> NoGenType) -let propagateAnnotationToSubTypes ~codeItems (typeMap : CodeItem.exportTypeMap) +let propagate_annotation_to_sub_types ~code_items (type_map : CodeItem.export_type_map) = - let annotatedSet = ref StringSet.empty in - let initialAnnotatedTypes = - typeMap |> StringMap.bindings + let annotated_set = ref StringSet.empty in + let initial_annotated_types = + type_map |> StringMap.bindings |> List.filter (fun (_, {CodeItem.annotation}) -> annotation = Annotation.GenType) |> List.map (fun (_, {CodeItem.type_}) -> type_) in - let typesOfExportedValue (codeItem : CodeItem.t) = - match codeItem with + let types_of_exported_value (code_item : CodeItem.t) = + match code_item with | ExportValue {type_} | ImportValue {type_} -> [type_] in - let typesOfExportedValues = - codeItems |> List.map typesOfExportedValue |> List.concat + let types_of_exported_values = + code_items |> List.map types_of_exported_value |> List.concat in - let visitTypAndUpdateMarked type0 = + let visit_typ_and_update_marked type0 = let visited = ref StringSet.empty in let rec visit type_ = match type_ with - | Ident {name = typeName; typeArgs} -> - if !visited |> StringSet.mem typeName then () + | Ident {name = type_name; type_args} -> + if !visited |> StringSet.mem type_name then () else ( - visited := !visited |> StringSet.add typeName; - typeArgs |> List.iter visit; - match typeMap |> StringMap.find typeName with + visited := !visited |> StringSet.add type_name; + type_args |> List.iter visit; + match type_map |> StringMap.find type_name with | {annotation = GenType | GenTypeOpaque} -> () | {type_ = type1; annotation = NoGenType} -> if !Debug.translation then - Log_.item "Marking Type As Annotated %s\n" typeName; - annotatedSet := !annotatedSet |> StringSet.add typeName; + Log_.item "Marking Type As Annotated %s\n" type_name; + annotated_set := !annotated_set |> StringSet.add type_name; type1 |> visit | exception Not_found -> - annotatedSet := !annotatedSet |> StringSet.add typeName) + annotated_set := !annotated_set |> StringSet.add type_name) | Array (t, _) | Dict t -> t |> visit - | Function {argTypes; retType} -> - argTypes |> List.iter (fun {aType} -> visit aType); - retType |> visit + | Function {arg_types; ret_type} -> + arg_types |> List.iter (fun {a_type} -> visit a_type); + ret_type |> visit | Object (_, fields) -> fields |> List.iter (fun {type_} -> type_ |> visit) | Option t | Null t | Nullable t | Promise t -> t |> visit - | Tuple innerTypes -> innerTypes |> List.iter visit + | Tuple inner_types -> inner_types |> List.iter visit | TypeVar _ -> () | Variant {inherits; payloads} -> inherits |> List.iter visit; @@ -558,90 +558,90 @@ let propagateAnnotationToSubTypes ~codeItems (typeMap : CodeItem.exportTypeMap) in type0 |> visit in - initialAnnotatedTypes @ typesOfExportedValues - |> List.iter visitTypAndUpdateMarked; - let newTypeMap = - typeMap + initial_annotated_types @ types_of_exported_values + |> List.iter visit_typ_and_update_marked; + let new_type_map = + type_map |> StringMap.mapi - (fun typeName (exportTypeItem : CodeItem.exportTypeItem) -> + (fun type_name (export_type_item : CodeItem.export_type_item) -> { - exportTypeItem with + export_type_item with annotation = - (match !annotatedSet |> StringSet.mem typeName with + (match !annotated_set |> StringSet.mem type_name with | true -> Annotation.GenType - | false -> exportTypeItem.annotation); + | false -> export_type_item.annotation); }) in - (newTypeMap, !annotatedSet) + (new_type_map, !annotated_set) -let emitTranslationAsString ~config ~fileName ~inputCmtTranslateTypeDeclarations - ~outputFileRelative ~resolver (translation : Translation.t) = - let initialEnv = +let emit_translation_as_string ~config ~file_name ~input_cmt_translate_type_declarations + ~output_file_relative ~resolver (translation : Translation.t) = + let initial_env = { requires = Config.ModuleNameMap.empty; - requiresEarly = Config.ModuleNameMap.empty; - cmtToExportTypeMap = StringMap.empty; - exportTypeMapFromOtherFiles = StringMap.empty; - importedValueOrComponent = false; + requires_early = Config.ModuleNameMap.empty; + cmt_to_export_type_map = StringMap.empty; + export_type_map_from_other_files = StringMap.empty; + imported_value_or_component = false; } in - let exportTypeMap, annotatedSet = - translation.typeDeclarations - |> createExportTypeMap ~config - ~file:(fileName |> ModuleName.toString) - ~fromCmtReadRecursively:false - |> propagateAnnotationToSubTypes ~codeItems:translation.codeItems + let export_type_map, annotated_set = + translation.type_declarations + |> create_export_type_map ~config + ~file:(file_name |> ModuleName.to_string) + ~from_cmt_read_recursively:false + |> propagate_annotation_to_sub_types ~code_items:translation.code_items in - let annotatedTypeDeclarations = - translation.typeDeclarations |> getAnnotatedTypedDeclarations ~annotatedSet + let annotated_type_declarations = + translation.type_declarations |> get_annotated_typed_declarations ~annotated_set in - let importTypesFromTypeDeclarations = - annotatedTypeDeclarations - |> List.map (fun (typeDeclaration : CodeItem.typeDeclaration) -> - typeDeclaration.importTypes) + let import_types_from_type_declarations = + annotated_type_declarations + |> List.map (fun (type_declaration : CodeItem.type_declaration) -> + type_declaration.import_types) |> List.concat in - let exportFromTypeDeclarations = - annotatedTypeDeclarations - |> List.map (fun (typeDeclaration : CodeItem.typeDeclaration) -> - typeDeclaration.exportFromTypeDeclaration) + let export_from_type_declarations = + annotated_type_declarations + |> List.map (fun (type_declaration : CodeItem.type_declaration) -> + type_declaration.export_from_type_declaration) in - let typeNameIsInterface ~env = - typeNameIsInterface ~exportTypeMap - ~exportTypeMapFromOtherFiles:env.exportTypeMapFromOtherFiles + let type_name_is_interface ~env = + type_name_is_interface ~export_type_map + ~export_type_map_from_other_files:env.export_type_map_from_other_files in let lookupId_ ~env s = - try exportTypeMap |> StringMap.find s - with Not_found -> env.exportTypeMapFromOtherFiles |> StringMap.find s + try export_type_map |> StringMap.find s + with Not_found -> env.export_type_map_from_other_files |> StringMap.find s in let emitters = Emitters.initial - and moduleItemsEmitter = ExportModule.createModuleItemsEmitter () - and env = initialEnv in + and module_items_emitter = ExportModule.create_module_items_emitter () + and env = initial_env in let env, emitters = (* imports from type declarations go first to build up type tables *) - importTypesFromTypeDeclarations @ translation.importTypes - |> List.sort_uniq Translation.importTypeCompare - |> emitImportTypes ~config ~emitters ~env ~inputCmtTranslateTypeDeclarations - ~outputFileRelative ~resolver ~typeNameIsInterface + import_types_from_type_declarations @ translation.import_types + |> List.sort_uniq Translation.import_type_compare + |> emit_import_types ~config ~emitters ~env ~input_cmt_translate_type_declarations + ~output_file_relative ~resolver ~type_name_is_interface in let env, emitters = - exportFromTypeDeclarations - |> emitExportFromTypeDeclarations ~config ~emitters ~env - ~typeNameIsInterface:(typeNameIsInterface ~env) + export_from_type_declarations + |> emit_export_from_type_declarations ~config ~emitters ~env + ~type_name_is_interface:(type_name_is_interface ~env) in - let inlineOneLevel type_ = + let inline_one_level type_ = match type_ with - | Ident {builtin = false; name; typeArgs} -> ( + | Ident {builtin = false; name; type_args} -> ( match name |> lookupId_ ~env with - | {type_; typeVars} -> + | {type_; type_vars} -> let pairs = - try List.combine typeVars typeArgs with Invalid_argument _ -> [] + try List.combine type_vars type_args with Invalid_argument _ -> [] in - let f typeVar = + let f type_var = match - pairs |> List.find (fun (typeVar1, _) -> typeVar = typeVar1) + pairs |> List.find (fun (type_var1, _) -> type_var = type_var1) with - | _, typeArgument -> Some typeArgument + | _, type_argument -> Some type_argument | exception Not_found -> None in type_ |> TypeVars.substitute ~f @@ -649,32 +649,32 @@ let emitTranslationAsString ~config ~fileName ~inputCmtTranslateTypeDeclarations | _ -> type_ in let env, emitters = - translation.codeItems - |> emitCodeItems ~config ~emitters ~moduleItemsEmitter ~env ~fileName - ~outputFileRelative ~resolver ~inlineOneLevel - ~typeNameIsInterface:(typeNameIsInterface ~env) + translation.code_items + |> emit_code_items ~config ~emitters ~module_items_emitter ~env ~file_name + ~output_file_relative ~resolver ~inline_one_level + ~type_name_is_interface:(type_name_is_interface ~env) in let emitters = - match config.emitImportReact with - | true -> EmitType.emitImportReact ~emitters + match config.emit_import_react with + | true -> EmitType.emit_import_react ~emitters | false -> emitters in let env = - match config.emitImportCurry with + match config.emit_import_curry with | true -> ModuleName.curry - |> requireModule ~import:true ~env - ~importPath:(ImportPath.bsCurryPath ~config) + |> require_module ~import:true ~env + ~import_path:(ImportPath.bs_curry_path ~config) | false -> env in - let finalEnv = env in + let final_env = env in let emitters = - moduleItemsEmitter - |> ExportModule.emitAllModuleItems ~config ~emitters ~fileName + module_items_emitter + |> ExportModule.emit_all_module_items ~config ~emitters ~file_name in emitters - |> emitRequires ~importedValueOrComponent:false ~early:true ~config - ~requires:finalEnv.requiresEarly - |> emitRequires ~importedValueOrComponent:finalEnv.importedValueOrComponent - ~early:false ~config ~requires:finalEnv.requires - |> Emitters.toString ~separator:"\n\n" + |> emit_requires ~imported_value_or_component:false ~early:true ~config + ~requires:final_env.requires_early + |> emit_requires ~imported_value_or_component:final_env.imported_value_or_component + ~early:false ~config ~requires:final_env.requires + |> Emitters.to_string ~separator:"\n\n" diff --git a/jscomp/gentype/EmitText.ml b/jscomp/gentype/EmitText.ml index 9ec5c1ec3b..3cc68260c5 100644 --- a/jscomp/gentype/EmitText.ml +++ b/jscomp/gentype/EmitText.ml @@ -1,13 +1,13 @@ -type nameGen = (string, int) Hashtbl.t +type name_gen = (string, int) Hashtbl.t let parens xs = "(" ^ (xs |> String.concat ", ") ^ ")" let comment x = "/* " ^ x ^ " */" -let genericsString ~typeVars = - match typeVars == [] with +let generics_string ~type_vars = + match type_vars == [] with | true -> "" - | false -> "<" ^ String.concat "," typeVars ^ ">" + | false -> "<" ^ String.concat "," type_vars ^ ">" let quotes x = "\"" ^ x ^ "\"" -let fieldAccess ~label value = value ^ "." ^ label +let field_access ~label value = value ^ "." ^ label diff --git a/jscomp/gentype/EmitType.ml b/jscomp/gentype/EmitType.ml index 9a55a77520..2a9a845680 100644 --- a/jscomp/gentype/EmitType.ml +++ b/jscomp/gentype/EmitType.ml @@ -1,7 +1,7 @@ open GenTypeCommon -let fileHeader ~sourceFile = - let makeHeader ~lines = +let file_header ~source_file = + let make_header ~lines = match lines with | [line] -> "/* " ^ line ^ " */\n\n" | _ -> @@ -9,84 +9,84 @@ let fileHeader ~sourceFile = ^ (lines |> List.map (fun line -> " * " ^ line) |> String.concat "\n") ^ "\n */\n\n" in - makeHeader - ~lines:["TypeScript file generated from " ^ sourceFile ^ " by genType."] + make_header + ~lines:["TypeScript file generated from " ^ source_file ^ " by genType."] ^ "/* eslint-disable */\n" ^ "/* tslint:disable */\n" -let interfaceName ~(config : Config.t) name = - match config.exportInterfaces with +let interface_name ~(config : Config.t) name = + match config.export_interfaces with | true -> "I" ^ name | false -> name -let typeAny = ident ~builtin:true "any" +let type_any = ident ~builtin:true "any" -let typeReactComponent ~propsType = - "React.ComponentType" |> ident ~builtin:true ~typeArgs:[propsType] +let type_react_component ~props_type = + "React.ComponentType" |> ident ~builtin:true ~type_args:[props_type] -let typeReactContext ~type_ = - "React.Context" |> ident ~builtin:true ~typeArgs:[type_] +let type_react_context ~type_ = + "React.Context" |> ident ~builtin:true ~type_args:[type_] -let typeReactElementTypeScript = ident ~builtin:true "JSX.Element" -let typeReactChildTypeScript = ident ~builtin:true "React.ReactNode" -let typeReactElement = typeReactElementTypeScript -let typeReactChild = typeReactChildTypeScript -let isTypeReactElement type_ = type_ == typeReactElement +let type_react_element_type_script = ident ~builtin:true "JSX.Element" +let type_react_child_type_script = ident ~builtin:true "React.ReactNode" +let type_react_element = type_react_element_type_script +let type_react_child = type_react_child_type_script +let is_type_react_element type_ = type_ == type_react_element -let typeReactDOMReDomRef = - "React.Ref" |> ident ~builtin:true ~typeArgs:[unknown] +let type_react_d_o_m_re_dom_ref = + "React.Ref" |> ident ~builtin:true ~type_args:[unknown] -let typeReactEventMouseT = "MouseEvent" |> ident ~builtin:true -let reactRefCurrent = "current" +let type_react_event_mouse_t = "MouseEvent" |> ident ~builtin:true +let react_ref_current = "current" -let typeReactRef ~type_ = +let type_react_ref ~type_ = Object ( Open, [ { mutable_ = Mutable; - nameJS = reactRefCurrent; + name_j_s = react_ref_current; optional = Mandatory; type_ = Null type_; - docString = DocString.empty; + doc_string = DocString.empty; }; ] ) -let isTypeReactRef ~fields = +let is_type_react_ref ~fields = match fields with - | [{mutable_ = Mutable; nameJS; optional = Mandatory}] -> - nameJS == reactRefCurrent + | [{mutable_ = Mutable; name_j_s; optional = Mandatory}] -> + name_j_s == react_ref_current | _ -> false -let isTypeFunctionComponent ~fields type_ = - type_ |> isTypeReactElement && not (isTypeReactRef ~fields) +let is_type_function_component ~fields type_ = + type_ |> is_type_react_element && not (is_type_react_ref ~fields) -let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface - ~inFunType type0 = +let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interface + ~in_fun_type type0 = match type0 with - | Array (t, arrayKind) -> - let typeIsSimple = + | Array (t, array_kind) -> + let type_is_simple = match t with | Ident _ | TypeVar _ -> true | _ -> false in - if typeIsSimple && arrayKind = Mutable then - (t |> renderType ~config ~indent ~typeNameIsInterface ~inFunType) ^ "[]" + if type_is_simple && array_kind = Mutable then + (t |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ "[]" else - let arrayName = - match arrayKind = Mutable with + let array_name = + match array_kind = Mutable with | true -> "Array" | false -> "ReadonlyArray" in - arrayName ^ "<" - ^ (t |> renderType ~config ~indent ~typeNameIsInterface ~inFunType) + array_name ^ "<" + ^ (t |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ ">" | Dict type_ -> "{[id: string]: " - ^ (type_ |> renderType ~config ~indent ~typeNameIsInterface ~inFunType) + ^ (type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ "}" | Function - {argTypes = [{aType = Object (closedFlag, fields)}]; retType; typeVars} - when retType |> isTypeFunctionComponent ~fields -> + {arg_types = [{a_type = Object (closed_flag, fields)}]; ret_type; type_vars} + when ret_type |> is_type_function_component ~fields -> let fields = fields |> List.map (fun field -> @@ -95,117 +95,117 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface type_ = field.type_ |> TypeVars.substitute ~f:(fun s -> - if typeVars |> List.mem s then Some typeAny else None); + if type_vars |> List.mem s then Some type_any else None); }) in - let componentType = - typeReactComponent ~propsType:(Object (closedFlag, fields)) + let component_type = + type_react_component ~props_type:(Object (closed_flag, fields)) in - componentType |> renderType ~config ~indent ~typeNameIsInterface ~inFunType - | Function {argTypes; retType; typeVars} -> - renderFunType ~config ~indent ~inFunType ~typeNameIsInterface ~typeVars - argTypes retType + component_type |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type + | Function {arg_types; ret_type; type_vars} -> + render_fun_type ~config ~indent ~in_fun_type ~type_name_is_interface ~type_vars + arg_types ret_type | Object (_, fields) -> - let indent1 = fields |> Indent.heuristicFields ~indent in + let indent1 = fields |> Indent.heuristic_fields ~indent in fields - |> renderFields ~config ~indent:indent1 ~inFunType ~typeNameIsInterface - | Ident {builtin; name; typeArgs} -> - let name = name |> sanitizeTypeName in + |> render_fields ~config ~indent:indent1 ~in_fun_type ~type_name_is_interface + | Ident {builtin; name; type_args} -> + let name = name |> sanitize_type_name in (match - (not builtin) && config.exportInterfaces && name |> typeNameIsInterface + (not builtin) && config.export_interfaces && name |> type_name_is_interface with - | true -> name |> interfaceName ~config + | true -> name |> interface_name ~config | false -> name) - ^ EmitText.genericsString - ~typeVars: - (typeArgs + ^ EmitText.generics_string + ~type_vars: + (type_args |> List.map - (renderType ~config ~indent ~typeNameIsInterface ~inFunType)) + (render_type ~config ~indent ~type_name_is_interface ~in_fun_type)) | Null type_ -> "(null | " - ^ (type_ |> renderType ~config ~indent ~typeNameIsInterface ~inFunType) + ^ (type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ ")" | Nullable type_ -> - let useParens x = + let use_parens x = match type_ with | Function _ | Variant _ -> EmitText.parens [x] | _ -> x in "(null | undefined | " - ^ useParens - (type_ |> renderType ~config ~indent ~typeNameIsInterface ~inFunType) + ^ use_parens + (type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ ")" | Option type_ -> - let useParens x = + let use_parens x = match type_ with | Function _ | Variant _ -> EmitText.parens [x] | _ -> x in "(undefined | " - ^ useParens - (type_ |> renderType ~config ~indent ~typeNameIsInterface ~inFunType) + ^ use_parens + (type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ ")" | Promise type_ -> "Promise" ^ "<" - ^ (type_ |> renderType ~config ~indent ~typeNameIsInterface ~inFunType) + ^ (type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ ">" - | Tuple innerTypes -> + | Tuple inner_types -> "[" - ^ (innerTypes - |> List.map (renderType ~config ~indent ~typeNameIsInterface ~inFunType) + ^ (inner_types + |> List.map (render_type ~config ~indent ~type_name_is_interface ~in_fun_type) |> String.concat ", ") ^ "]" | TypeVar s -> s - | Variant {inherits; noPayloads; payloads; polymorphic; tag; unboxed} -> - let inheritsRendered = + | Variant {inherits; no_payloads; payloads; polymorphic; tag; unboxed} -> + let inherits_rendered = inherits |> List.map (fun type_ -> - type_ |> renderType ~config ~indent ~typeNameIsInterface ~inFunType) + type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) in - let noPayloadsRendered = noPayloads |> List.map labelJSToString in + let no_payloads_rendered = no_payloads |> List.map label_j_s_to_string in let field ~name value = { mutable_ = Mutable; - nameJS = name; + name_j_s = name; optional = Mandatory; type_ = TypeVar value; - docString = DocString.empty; + doc_string = DocString.empty; } in let fields fields = - fields |> renderFields ~config ~indent ~inFunType ~typeNameIsInterface + fields |> render_fields ~config ~indent ~in_fun_type ~type_name_is_interface in - let payloadsRendered = + let payloads_rendered = payloads |> List.map (fun {case; t = type_} -> let render t = - t |> renderType ~config ~indent ~typeNameIsInterface ~inFunType + t |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type in - let tagField = - case |> labelJSToString - |> field ~name:(Runtime.jsVariantTag ~polymorphic:false ~tag) + let tag_field = + case |> label_j_s_to_string + |> field ~name:(Runtime.js_variant_tag ~polymorphic:false ~tag) in match (unboxed, type_) with | true, type_ -> - let needParens = + let need_parens = match type_ with | Function _ -> true | _ -> false in let t = type_ |> render in - if needParens then EmitText.parens [t] else t + if need_parens then EmitText.parens [t] else t | false, type_ when polymorphic -> (* poly variant *) [ - case |> labelJSToString - |> field ~name:(Runtime.jsVariantTag ~polymorphic ~tag); + case |> label_j_s_to_string + |> field ~name:(Runtime.js_variant_tag ~polymorphic ~tag); type_ |> render - |> field ~name:(Runtime.jsVariantValue ~polymorphic); + |> field ~name:(Runtime.js_variant_value ~polymorphic); ] |> fields | false, Object (Inline, flds) -> (* inlined record *) - tagField :: flds |> fields + tag_field :: flds |> fields | false, type_ -> (* ordinary variant *) let payloads = @@ -214,15 +214,15 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface | _ -> [type_] in let flds = - tagField + tag_field :: Ext_list.mapi payloads (fun n t -> t |> render - |> field ~name:(Runtime.jsVariantPayloadTag ~n)) + |> field ~name:(Runtime.js_variant_payload_tag ~n)) in flds |> fields) in - let rendered = inheritsRendered @ noPayloadsRendered @ payloadsRendered in - let indent1 = rendered |> Indent.heuristicVariants ~indent in + let rendered = inherits_rendered @ no_payloads_rendered @ payloads_rendered in + let indent1 = rendered |> Indent.heuristic_variants ~indent in (match indent1 = None with | true -> "" | false -> Indent.break ~indent:indent1 ^ " ") @@ -233,200 +233,200 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface | false -> Indent.break ~indent:indent1) ^ "| ")) -and renderField ~config ~indent ~typeNameIsInterface ~inFunType - {mutable_; nameJS = lbl; optional; type_; docString} = - let optMarker = +and render_field ~config ~indent ~type_name_is_interface ~in_fun_type + {mutable_; name_j_s = lbl; optional; type_; doc_string} = + let opt_marker = match optional == Optional with | true -> "?" | false -> "" in - let mutMarker = + let mut_marker = match mutable_ = Immutable with | true -> "readonly " | false -> "" in let lbl = - match isJSSafePropertyName lbl with + match is_j_s_safe_property_name lbl with | true -> lbl | false -> EmitText.quotes lbl in - let defStr = - mutMarker ^ lbl ^ optMarker ^ ": " - ^ (type_ |> renderType ~config ~indent ~typeNameIsInterface ~inFunType) + let def_str = + mut_marker ^ lbl ^ opt_marker ^ ": " + ^ (type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) in - if DocString.hasContent docString then + if DocString.has_content doc_string then (* Always print comments on newline before definition. *) - let indentStr = indent |> Option.value ~default:"" in - "\n" ^ indentStr ^ DocString.render docString ^ indentStr ^ defStr - else Indent.break ~indent ^ defStr + let indent_str = indent |> Option.value ~default:"" in + "\n" ^ indent_str ^ DocString.render doc_string ^ indent_str ^ def_str + else Indent.break ~indent ^ def_str -and renderFields ~config ~indent ~inFunType ~typeNameIsInterface fields = +and render_fields ~config ~indent ~in_fun_type ~type_name_is_interface fields = let indent1 = indent |> Indent.more in let space = match indent = None && fields <> [] with | true -> " " | false -> "" in - let renderedFields = + let rendered_fields = fields |> List.map - (renderField ~config ~indent:indent1 ~typeNameIsInterface ~inFunType) + (render_field ~config ~indent:indent1 ~type_name_is_interface ~in_fun_type) in ("{" ^ space) - ^ String.concat "; " renderedFields + ^ String.concat "; " rendered_fields ^ Indent.break ~indent ^ space ^ "}" -and renderFunType ~config ~indent ~inFunType ~typeNameIsInterface ~typeVars - argTypes retType = - (match inFunType with +and render_fun_type ~config ~indent ~in_fun_type ~type_name_is_interface ~type_vars + arg_types ret_type = + (match in_fun_type with | true -> "(" | false -> "") - ^ EmitText.genericsString ~typeVars + ^ EmitText.generics_string ~type_vars ^ "(" ^ String.concat ", " (List.mapi - (fun i {aName; aType} -> - let parameterName = - (match aName = "" with + (fun i {a_name; a_type} -> + let parameter_name = + (match a_name = "" with | true -> "_" ^ string_of_int (i + 1) - | false -> aName) + | false -> a_name) ^ ":" in - parameterName - ^ (aType - |> renderType ~config ~indent ~typeNameIsInterface ~inFunType:true + parameter_name + ^ (a_type + |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type:true )) - argTypes) + arg_types) ^ ") => " - ^ (retType |> renderType ~config ~indent ~typeNameIsInterface ~inFunType) + ^ (ret_type |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ - match inFunType with + match in_fun_type with | true -> ")" | false -> "" -let typeToString ~config ~typeNameIsInterface type_ = - type_ |> renderType ~config ~typeNameIsInterface ~inFunType:false +let type_to_string ~config ~type_name_is_interface type_ = + type_ |> render_type ~config ~type_name_is_interface ~in_fun_type:false -let emitExportConst ~early ?(comment = "") ~config - ?(docString = DocString.empty) ~emitters ~name ~type_ ~typeNameIsInterface +let emit_export_const ~early ?(comment = "") ~config + ?(doc_string = DocString.empty) ~emitters ~name ~type_ ~type_name_is_interface line = - let typeString = type_ |> typeToString ~config ~typeNameIsInterface in + let type_string = type_ |> type_to_string ~config ~type_name_is_interface in (match comment = "" with | true -> comment | false -> "// " ^ comment ^ "\n") - ^ DocString.render docString ^ "export const " ^ name ^ ": " ^ typeString + ^ DocString.render doc_string ^ "export const " ^ name ^ ": " ^ type_string ^ " = " ^ line ^ " as any;" |> (match early with - | true -> Emitters.exportEarly + | true -> Emitters.export_early | false -> Emitters.export) ~emitters -let emitExportDefault ~emitters name = +let emit_export_default ~emitters name = "export default " ^ name ^ ";" |> Emitters.export ~emitters -let emitExportType ~(config : Config.t) ~emitters ~nameAs ~opaque ~type_ - ~typeNameIsInterface ~typeVars ~docString resolvedTypeName = - let docString = DocString.render docString in - let typeParamsString = EmitText.genericsString ~typeVars in - let isInterface = resolvedTypeName |> typeNameIsInterface in - let resolvedTypeName = - match config.exportInterfaces && isInterface with - | true -> resolvedTypeName |> interfaceName ~config - | false -> resolvedTypeName +let emit_export_type ~(config : Config.t) ~emitters ~name_as ~opaque ~type_ + ~type_name_is_interface ~type_vars ~doc_string resolved_type_name = + let doc_string = DocString.render doc_string in + let type_params_string = EmitText.generics_string ~type_vars in + let is_interface = resolved_type_name |> type_name_is_interface in + let resolved_type_name = + match config.export_interfaces && is_interface with + | true -> resolved_type_name |> interface_name ~config + | false -> resolved_type_name in - let exportNameAs = - match nameAs with + let export_name_as = + match name_as with | None -> "" | Some s -> - "\nexport type " ^ s ^ typeParamsString ^ " = " ^ resolvedTypeName - ^ typeParamsString ^ ";" + "\nexport type " ^ s ^ type_params_string ^ " = " ^ resolved_type_name + ^ type_params_string ^ ";" in if opaque then (* Represent an opaque type as an absract class with a field called 'opaque'. Any type parameters must occur in the type of opaque, so that different instantiations are considered different types. *) - let typeOfOpaqueField = - match typeVars = [] with + let type_of_opaque_field = + match type_vars = [] with | true -> "any" - | false -> typeVars |> String.concat " | " + | false -> type_vars |> String.concat " | " in - docString ^ "export abstract class " ^ resolvedTypeName ^ typeParamsString - ^ " { protected opaque!: " ^ typeOfOpaqueField - ^ " }; /* simulate opaque types */" ^ exportNameAs + doc_string ^ "export abstract class " ^ resolved_type_name ^ type_params_string + ^ " { protected opaque!: " ^ type_of_opaque_field + ^ " }; /* simulate opaque types */" ^ export_name_as |> Emitters.export ~emitters else - (if isInterface && config.exportInterfaces then - docString ^ "export interface " ^ resolvedTypeName ^ typeParamsString + (if is_interface && config.export_interfaces then + doc_string ^ "export interface " ^ resolved_type_name ^ type_params_string ^ " " else - docString ^ "export type " ^ resolvedTypeName ^ typeParamsString ^ " = ") + doc_string ^ "export type " ^ resolved_type_name ^ type_params_string ^ " = ") ^ (match type_ with - | _ -> type_ |> typeToString ~config ~typeNameIsInterface) - ^ ";" ^ exportNameAs + | _ -> type_ |> type_to_string ~config ~type_name_is_interface) + ^ ";" ^ export_name_as |> Emitters.export ~emitters -let emitImportValueAsEarly ~emitters ~name ~nameAs importPath = +let emit_import_value_as_early ~emitters ~name ~name_as import_path = "import " - ^ (match nameAs with - | Some nameAs -> "{" ^ name ^ " as " ^ nameAs ^ "}" + ^ (match name_as with + | Some name_as -> "{" ^ name ^ " as " ^ name_as ^ "}" | None -> name) ^ " from " ^ "'" - ^ (importPath |> ImportPath.emit) + ^ (import_path |> ImportPath.emit) ^ "';" - |> Emitters.requireEarly ~emitters + |> Emitters.require_early ~emitters -let emitRequire ~importedValueOrComponent ~early ~emitters ~(config : Config.t) - ~moduleName importPath = - let moduleNameString = ModuleName.toString moduleName in - let importPathString = ImportPath.emit importPath in +let emit_require ~imported_value_or_component ~early ~emitters ~(config : Config.t) + ~module_name import_path = + let module_name_string = ModuleName.to_string module_name in + let import_path_string = ImportPath.emit import_path in let output = match config.module_ with - | ESModule when not importedValueOrComponent -> - "import * as " ^ moduleNameString ^ " from '" ^ importPathString ^ "';" + | ESModule when not imported_value_or_component -> + "import * as " ^ module_name_string ^ " from '" ^ import_path_string ^ "';" | _ -> - "const " ^ moduleNameString ^ " = require('" ^ importPathString ^ "');" + "const " ^ module_name_string ^ " = require('" ^ import_path_string ^ "');" in output |> (match early with - | true -> Emitters.requireEarly + | true -> Emitters.require_early | false -> Emitters.require) ~emitters let require ~early = match early with - | true -> Emitters.requireEarly + | true -> Emitters.require_early | false -> Emitters.require -let emitImportReact ~emitters = +let emit_import_react ~emitters = "import * as React from 'react';" |> require ~early:true ~emitters -let emitImportTypeAs ~emitters ~config ~typeName ~asTypeName - ~typeNameIsInterface ~importPath = - let typeName = sanitizeTypeName typeName in - let asTypeName = - match asTypeName with - | None -> asTypeName - | Some s -> Some (sanitizeTypeName s) +let emit_import_type_as ~emitters ~config ~type_name ~as_type_name + ~type_name_is_interface ~import_path = + let type_name = sanitize_type_name type_name in + let as_type_name = + match as_type_name with + | None -> as_type_name + | Some s -> Some (sanitize_type_name s) in - let typeName, asTypeName = - match asTypeName with - | Some asName -> ( - match asName |> typeNameIsInterface with + let type_name, as_type_name = + match as_type_name with + | Some as_name -> ( + match as_name |> type_name_is_interface with | true -> - ( typeName |> interfaceName ~config, - Some (asName |> interfaceName ~config) ) - | false -> (typeName, asTypeName)) - | None -> (typeName, asTypeName) + ( type_name |> interface_name ~config, + Some (as_name |> interface_name ~config) ) + | false -> (type_name, as_type_name)) + | None -> (type_name, as_type_name) in - let importPathString = importPath |> ImportPath.emit in - let importPrefix = "import type" in - importPrefix ^ " " ^ "{" ^ typeName - ^ (match asTypeName with - | Some asT -> " as " ^ asT + let import_path_string = import_path |> ImportPath.emit in + let import_prefix = "import type" in + import_prefix ^ " " ^ "{" ^ type_name + ^ (match as_type_name with + | Some as_t -> " as " ^ as_t | None -> "") - ^ "} from '" ^ importPathString ^ "';" + ^ "} from '" ^ import_path_string ^ "';" |> Emitters.import ~emitters -let emitTypeCast ~config ~type_ ~typeNameIsInterface s = - s ^ " as " ^ (type_ |> typeToString ~config ~typeNameIsInterface) +let emit_type_cast ~config ~type_ ~type_name_is_interface s = + s ^ " as " ^ (type_ |> type_to_string ~config ~type_name_is_interface) diff --git a/jscomp/gentype/Emitters.ml b/jscomp/gentype/Emitters.ml index c40317e9a6..9002738449 100644 --- a/jscomp/gentype/Emitters.ml +++ b/jscomp/gentype/Emitters.ml @@ -1,49 +1,49 @@ type t = { - requireEmitterEarly: string list; - exportEmitterEarly: string list; - requireEmitter: string list; - importEmitter: string list; - exportEmitter: string list; + require_emitter_early: string list; + export_emitter_early: string list; + require_emitter: string list; + import_emitter: string list; + export_emitter: string list; } let initial = { - requireEmitterEarly = []; - exportEmitterEarly = []; - requireEmitter = []; - importEmitter = []; - exportEmitter = []; + require_emitter_early = []; + export_emitter_early = []; + require_emitter = []; + import_emitter = []; + export_emitter = []; } let string ~emitter s = s :: emitter -let requireEarly ~emitters s = +let require_early ~emitters s = { emitters with - requireEmitterEarly = s |> string ~emitter:emitters.requireEmitterEarly; + require_emitter_early = s |> string ~emitter:emitters.require_emitter_early; } -let exportEarly ~emitters s = +let export_early ~emitters s = { emitters with - exportEmitterEarly = s |> string ~emitter:emitters.exportEmitterEarly; + export_emitter_early = s |> string ~emitter:emitters.export_emitter_early; } let require ~emitters s = - {emitters with requireEmitter = s |> string ~emitter:emitters.requireEmitter} + {emitters with require_emitter = s |> string ~emitter:emitters.require_emitter} let import ~emitters s = - {emitters with importEmitter = s |> string ~emitter:emitters.importEmitter} + {emitters with import_emitter = s |> string ~emitter:emitters.import_emitter} let export ~emitters s = - {emitters with exportEmitter = s |> string ~emitter:emitters.exportEmitter} + {emitters with export_emitter = s |> string ~emitter:emitters.export_emitter} -let toString ~separator emitters = +let to_string ~separator emitters = [ - emitters.requireEmitterEarly |> List.rev; - emitters.exportEmitterEarly |> List.rev; - emitters.requireEmitter |> List.rev; - emitters.importEmitter |> List.rev; - emitters.exportEmitter |> List.rev; + emitters.require_emitter_early |> List.rev; + emitters.export_emitter_early |> List.rev; + emitters.require_emitter |> List.rev; + emitters.import_emitter |> List.rev; + emitters.export_emitter |> List.rev; ] |> List.concat |> String.concat separator diff --git a/jscomp/gentype/Emitters.mli b/jscomp/gentype/Emitters.mli index 7d661f663b..ad0c63856b 100644 --- a/jscomp/gentype/Emitters.mli +++ b/jscomp/gentype/Emitters.mli @@ -1,9 +1,9 @@ type t val initial : t -val exportEarly : emitters:t -> string -> t -val requireEarly : emitters:t -> string -> t +val export_early : emitters:t -> string -> t +val require_early : emitters:t -> string -> t val export : emitters:t -> string -> t val import : emitters:t -> string -> t val require : emitters:t -> string -> t -val toString : separator:string -> t -> string +val to_string : separator:string -> t -> string diff --git a/jscomp/gentype/ExportModule.ml b/jscomp/gentype/ExportModule.ml index b4798f5e6e..b0e8e593b4 100644 --- a/jscomp/gentype/ExportModule.ml +++ b/jscomp/gentype/ExportModule.ml @@ -1,124 +1,124 @@ open GenTypeCommon -type exportModuleItem = (string, exportModuleValue) Hashtbl.t +type export_module_item = (string, export_module_value) Hashtbl.t -and exportModuleValue = - | S of {name: string; type_: type_; docString: DocString.t} - | M of {exportModuleItem: exportModuleItem} +and export_module_value = + | S of {name: string; type_: type_; doc_string: DocString.t} + | M of {export_module_item: export_module_item} -type exportModuleItems = (string, exportModuleItem) Hashtbl.t +type export_module_items = (string, export_module_item) Hashtbl.t -type types = {typeForValue: type_; typeForType: type_; docString: DocString.t} +type types = {type_for_value: type_; type_for_type: type_; doc_string: DocString.t} -type fieldInfo = {fieldForValue: field; fieldForType: field} +type field_info = {field_for_value: field; field_for_type: field} -let rec exportModuleValueToType ~config exportModuleValue = - match exportModuleValue with - | S {name; type_; docString} -> - {typeForValue = ident name; typeForType = type_; docString} - | M {exportModuleItem} -> - let fieldsInfo = exportModuleItem |> exportModuleItemToFields ~config in - let fieldsForValue = - fieldsInfo |> List.map (fun {fieldForValue} -> fieldForValue) +let rec export_module_value_to_type ~config export_module_value = + match export_module_value with + | S {name; type_; doc_string} -> + {type_for_value = ident name; type_for_type = type_; doc_string} + | M {export_module_item} -> + let fields_info = export_module_item |> export_module_item_to_fields ~config in + let fields_for_value = + fields_info |> List.map (fun {field_for_value} -> field_for_value) in - let fieldsForType = - fieldsInfo |> List.map (fun {fieldForType} -> fieldForType) + let fields_for_type = + fields_info |> List.map (fun {field_for_type} -> field_for_type) in { - typeForValue = Object (Open, fieldsForValue); - typeForType = Object (Open, fieldsForType); - docString = DocString.empty; + type_for_value = Object (Open, fields_for_value); + type_for_type = Object (Open, fields_for_type); + doc_string = DocString.empty; } -and exportModuleItemToFields = - (fun ~config exportModuleItem -> +and export_module_item_to_fields = + (fun ~config export_module_item -> Hashtbl.fold - (fun fieldName exportModuleValue fields -> - let {typeForValue; typeForType; docString} = - exportModuleValue |> exportModuleValueToType ~config + (fun field_name export_module_value fields -> + let {type_for_value; type_for_type; doc_string} = + export_module_value |> export_module_value_to_type ~config in - let fieldForType = + let field_for_type = { mutable_ = Mutable; - nameJS = fieldName; + name_j_s = field_name; optional = Mandatory; - type_ = typeForType; - docString; + type_ = type_for_type; + doc_string; } in - let fieldForValue = {fieldForType with type_ = typeForValue} in - {fieldForValue; fieldForType} :: fields) - exportModuleItem [] - : config:Config.t -> exportModuleItem -> fieldInfo list) + let field_for_value = {field_for_type with type_ = type_for_value} in + {field_for_value; field_for_type} :: fields) + export_module_item [] + : config:Config.t -> export_module_item -> field_info list) -let rec extendExportModuleItem ~docString x - ~(exportModuleItem : exportModuleItem) ~type_ ~valueName = +let rec extend_export_module_item ~doc_string x + ~(export_module_item : export_module_item) ~type_ ~value_name = match x with | [] -> () - | [fieldName] -> - Hashtbl.replace exportModuleItem fieldName - (S {name = valueName; type_; docString}) - | fieldName :: rest -> - let innerExportModuleItem = - match Hashtbl.find exportModuleItem fieldName with - | M {exportModuleItem = innerExportModuleItem} -> innerExportModuleItem + | [field_name] -> + Hashtbl.replace export_module_item field_name + (S {name = value_name; type_; doc_string}) + | field_name :: rest -> + let inner_export_module_item = + match Hashtbl.find export_module_item field_name with + | M {export_module_item = inner_export_module_item} -> inner_export_module_item | S _ -> assert false | exception Not_found -> - let innerExportModuleItem = Hashtbl.create 1 in - Hashtbl.replace exportModuleItem fieldName - (M {exportModuleItem = innerExportModuleItem}); - innerExportModuleItem + let inner_export_module_item = Hashtbl.create 1 in + Hashtbl.replace export_module_item field_name + (M {export_module_item = inner_export_module_item}); + inner_export_module_item in rest - |> extendExportModuleItem ~docString ~exportModuleItem:innerExportModuleItem - ~valueName ~type_ + |> extend_export_module_item ~doc_string ~export_module_item:inner_export_module_item + ~value_name ~type_ -let extendExportModuleItems x ~docString - ~(exportModuleItems : exportModuleItems) ~type_ ~valueName = +let extend_export_module_items x ~doc_string + ~(export_module_items : export_module_items) ~type_ ~value_name = match x with | [] -> assert false | [_valueName] -> () - | moduleName :: rest -> - let exportModuleItem = - match Hashtbl.find exportModuleItems moduleName with - | exportModuleItem -> exportModuleItem + | module_name :: rest -> + let export_module_item = + match Hashtbl.find export_module_items module_name with + | export_module_item -> export_module_item | exception Not_found -> - let exportModuleItem = Hashtbl.create 1 in - Hashtbl.replace exportModuleItems moduleName exportModuleItem; - exportModuleItem + let export_module_item = Hashtbl.create 1 in + Hashtbl.replace export_module_items module_name export_module_item; + export_module_item in rest - |> extendExportModuleItem ~docString ~exportModuleItem ~type_ ~valueName + |> extend_export_module_item ~doc_string ~export_module_item ~type_ ~value_name -let createModuleItemsEmitter = - (fun () -> Hashtbl.create 1 : unit -> exportModuleItems) +let create_module_items_emitter = + (fun () -> Hashtbl.create 1 : unit -> export_module_items) let rev_fold f tbl base = let list = Hashtbl.fold (fun k v l -> (k, v) :: l) tbl [] in List.fold_left (fun x (k, v) -> f k v x) base list -let emitAllModuleItems ~config ~emitters ~fileName - (exportModuleItems : exportModuleItems) = +let emit_all_module_items ~config ~emitters ~file_name + (export_module_items : export_module_items) = emitters |> rev_fold - (fun moduleName exportModuleItem emitters -> - let {typeForType; docString} = - M {exportModuleItem} |> exportModuleValueToType ~config + (fun module_name export_module_item emitters -> + let {type_for_type; doc_string} = + M {export_module_item} |> export_module_value_to_type ~config in - if !Debug.codeItems then Log_.item "EmitModule %s @." moduleName; - let emittedModuleItem = - ModuleName.forInnerModule ~fileName ~innerModuleName:moduleName - |> ModuleName.toString + if !Debug.code_items then Log_.item "EmitModule %s @." module_name; + let emitted_module_item = + ModuleName.for_inner_module ~file_name ~inner_module_name:module_name + |> ModuleName.to_string in - emittedModuleItem - |> EmitType.emitExportConst ~docString ~early:false ~config ~emitters - ~name:moduleName ~type_:typeForType ~typeNameIsInterface:(fun _ -> + emitted_module_item + |> EmitType.emit_export_const ~doc_string ~early:false ~config ~emitters + ~name:module_name ~type_:type_for_type ~type_name_is_interface:(fun _ -> false)) - exportModuleItems + export_module_items -let extendExportModules ~(moduleItemsEmitter : exportModuleItems) ~docString - ~type_ resolvedName = - resolvedName |> ResolvedName.toList - |> extendExportModuleItems ~exportModuleItems:moduleItemsEmitter ~type_ - ~docString - ~valueName:(resolvedName |> ResolvedName.toString) +let extend_export_modules ~(module_items_emitter : export_module_items) ~doc_string + ~type_ resolved_name = + resolved_name |> ResolvedName.to_list + |> extend_export_module_items ~export_module_items:module_items_emitter ~type_ + ~doc_string + ~value_name:(resolved_name |> ResolvedName.to_string) diff --git a/jscomp/gentype/GenIdent.ml b/jscomp/gentype/GenIdent.ml index fcf9b7f707..880742eea3 100644 --- a/jscomp/gentype/GenIdent.ml +++ b/jscomp/gentype/GenIdent.ml @@ -4,18 +4,18 @@ module IntMap = Map.Make (struct let compare (x : int) (y : int) = compare x y end) -type typeVarsGen = { +type type_vars_gen = { (* Generate fresh identifiers *) - mutable typeNameMap: string IntMap.t; - mutable typeNameCounter: int; + mutable type_name_map: string IntMap.t; + mutable type_name_counter: int; } -let createTypeVarsGen () = {typeNameMap = IntMap.empty; typeNameCounter = 0} +let create_type_vars_gen () = {type_name_map = IntMap.empty; type_name_counter = 0} -let jsTypeNameForAnonymousTypeID ~typeVarsGen id = - try typeVarsGen.typeNameMap |> IntMap.find id +let js_type_name_for_anonymous_type_i_d ~type_vars_gen id = + try type_vars_gen.type_name_map |> IntMap.find id with Not_found -> - typeVarsGen.typeNameCounter <- typeVarsGen.typeNameCounter + 1; - let name = "T" ^ string_of_int typeVarsGen.typeNameCounter in - typeVarsGen.typeNameMap <- typeVarsGen.typeNameMap |> IntMap.add id name; + type_vars_gen.type_name_counter <- type_vars_gen.type_name_counter + 1; + let name = "T" ^ string_of_int type_vars_gen.type_name_counter in + type_vars_gen.type_name_map <- type_vars_gen.type_name_map |> IntMap.add id name; name diff --git a/jscomp/gentype/GenTypeCommon.ml b/jscomp/gentype/GenTypeCommon.ml index 4581323aa2..d9a14b73bc 100644 --- a/jscomp/gentype/GenTypeCommon.ml +++ b/jscomp/gentype/GenTypeCommon.ml @@ -7,18 +7,18 @@ module DocString = struct let render t = match t with | None | Some "" -> "" - | Some docString -> "/** " ^ String.trim docString ^ " */\n" + | Some doc_string -> "/** " ^ String.trim doc_string ^ " */\n" let empty = None - let hasContent docString = Option.is_some docString + let has_content doc_string = Option.is_some doc_string end -let logNotImplemented x = - if !Debug.notImplemented then Log_.item "Not Implemented: %s\n" x +let log_not_implemented x = + if !Debug.not_implemented then Log_.item "Not Implemented: %s\n" x type optional = Mandatory | Optional type mutable_ = Immutable | Mutable -type labelJS = +type label_j_s = | NullLabel | UndefinedLabel | BoolLabel of bool @@ -26,9 +26,9 @@ type labelJS = | IntLabel of string | StringLabel of string -type case = {labelJS: labelJS} +type case = {label_j_s: label_j_s} -let isJSSafePropertyName name = +let is_j_s_safe_property_name name = name = "" || (match name.[0] [@doesNotRaise] with | 'A' .. 'z' -> true @@ -38,7 +38,7 @@ let isJSSafePropertyName name = | 'A' .. 'z' | '0' .. '9' -> true | _ -> false) -let isNumber s = +let is_number s = let len = String.length s in len > 0 && (match len > 1 with @@ -53,8 +53,8 @@ let isNumber s = done; res.contents -let labelJSToString case = - match case.labelJS with +let label_j_s_to_string case = + match case.label_j_s with | NullLabel -> "null" | UndefinedLabel -> "undefined" | BoolLabel b -> b |> string_of_bool @@ -62,7 +62,7 @@ let labelJSToString case = | IntLabel i -> i | StringLabel s -> s |> EmitText.quotes -type closedFlag = Open | Closed | Inline +type closed_flag = Open | Closed | Inline type type_ = | Array of type_ * mutable_ @@ -71,7 +71,7 @@ type type_ = | Ident of ident | Null of type_ | Nullable of type_ - | Object of closedFlag * fields + | Object of closed_flag * fields | Option of type_ | Promise of type_ | Tuple of type_ list @@ -79,23 +79,23 @@ type type_ = | Variant of variant (* ordinary and polymorphic variants *) and fields = field list -and argType = {aName: string; aType: type_} +and arg_type = {a_name: string; a_type: type_} and field = { mutable_: mutable_; - nameJS: string; + name_j_s: string; optional: optional; type_: type_; - docString: DocString.t; + doc_string: DocString.t; } -and function_ = {argTypes: argType list; retType: type_; typeVars: string list} +and function_ = {arg_types: arg_type list; ret_type: type_; type_vars: string list} -and ident = {builtin: bool; name: string; typeArgs: type_ list} +and ident = {builtin: bool; name: string; type_args: type_ list} and variant = { inherits: type_ list; - noPayloads: case list; + no_payloads: case list; payloads: payload list; polymorphic: bool; (* If true, this is a polymorphic variant *) tag: string option; (* The name of the tag field at runtime *) @@ -134,99 +134,99 @@ struct Buffer.contents buf (** @demo/some-library -> DemoSomelibrary *) - let packageNameToGeneratedModuleName packageName = - if String.contains packageName '/' then - Some (packageName |> namespace_of_package_name) + let package_name_to_generated_module_name package_name = + if String.contains package_name '/' then + Some (package_name |> namespace_of_package_name) else None - let isGeneratedModule id ~(config : Config.t) = - config.bsDependencies - |> List.exists (fun packageName -> - packageName |> packageNameToGeneratedModuleName + let is_generated_module id ~(config : Config.t) = + config.bs_dependencies + |> List.exists (fun package_name -> + package_name |> package_name_to_generated_module_name = Some (id |> Ident.name)) (** (Common, DemoSomelibrary) -> Common-DemoSomelibrary *) - let addGeneratedModule s ~generatedModule = - s ^ "-" ^ Ident.name generatedModule + let add_generated_module s ~generated_module = + s ^ "-" ^ Ident.name generated_module (** Common-DemoSomelibrary -> Common *) - let removeGeneratedModule s = + let remove_generated_module s = match s |> String.split_on_char '-' with | [name; _scope] -> name | _ -> s end -let rec depToString dep = +let rec dep_to_string dep = match dep with - | External name -> name |> ScopedPackage.removeGeneratedModule - | Internal resolvedName -> resolvedName |> ResolvedName.toString - | Dot (d, s) -> depToString d ^ "_" ^ s + | External name -> name |> ScopedPackage.remove_generated_module + | Internal resolved_name -> resolved_name |> ResolvedName.to_string + | Dot (d, s) -> dep_to_string d ^ "_" ^ s -let rec depToResolvedName (dep : dep) = +let rec dep_to_resolved_name (dep : dep) = match dep with - | External name -> name |> ResolvedName.fromString - | Internal resolvedName -> resolvedName - | Dot (p, s) -> ResolvedName.dot s (p |> depToResolvedName) + | External name -> name |> ResolvedName.from_string + | Internal resolved_name -> resolved_name + | Dot (p, s) -> ResolvedName.dot s (p |> dep_to_resolved_name) -let createVariant ~inherits ~noPayloads ~payloads ~polymorphic ~tag ~unboxed = - Variant {inherits; noPayloads; payloads; polymorphic; tag; unboxed} +let create_variant ~inherits ~no_payloads ~payloads ~polymorphic ~tag ~unboxed = + Variant {inherits; no_payloads; payloads; polymorphic; tag; unboxed} -let ident ?(builtin = true) ?(typeArgs = []) name = - Ident {builtin; name; typeArgs} +let ident ?(builtin = true) ?(type_args = []) name = + Ident {builtin; name; type_args} -let sanitizeTypeName name = +let sanitize_type_name name = name |> String.map (function | '\'' -> '_' | c -> c) let unknown = ident "unknown" -let bigintT = ident "BigInt" -let booleanT = ident "boolean" -let dateT = ident "Date" -let mapT (x, y) = ident ~typeArgs:[x; y] "Map" -let numberT = ident "number" -let regexpT = ident "RegExp" -let setT x = ident ~typeArgs:[x] "Set" -let stringT = ident "string" -let unitT = ident "void" -let weakmapT (x, y) = ident ~typeArgs:[x; y] "WeakMap" -let weaksetT x = ident ~typeArgs:[x] "WeakSet" -let int64T = Tuple [numberT; numberT] +let bigint_t = ident "BigInt" +let boolean_t = ident "boolean" +let date_t = ident "Date" +let map_t (x, y) = ident ~type_args:[x; y] "Map" +let number_t = ident "number" +let regexp_t = ident "RegExp" +let set_t x = ident ~type_args:[x] "Set" +let string_t = ident "string" +let unit_t = ident "void" +let weakmap_t (x, y) = ident ~type_args:[x; y] "WeakMap" +let weakset_t x = ident ~type_args:[x] "WeakSet" +let int64_t = Tuple [number_t; number_t] module NodeFilename = struct include Filename (* Force "/" separator. *) - let dirSep = "/" + let dir_sep = "/" module Path : sig type t val normalize : string -> t val concat : t -> string -> t - val toString : t -> string + val to_string : t -> string end = struct type t = string let normalize path : t = match Sys.os_type with - | "Win32" -> path |> String.split_on_char '\\' |> String.concat dirSep + | "Win32" -> path |> String.split_on_char '\\' |> String.concat dir_sep | _ -> path - let toString path = path + let to_string path = path let length path = String.length path let concat dirname filename = - let isDirSep s i = + let is_dir_sep s i = let c = (s.[i] [@doesNotRaise]) in c = '/' || c = '\\' || c = ':' in let l = length dirname in - if l = 0 || isDirSep dirname (l - 1) then dirname ^ filename - else dirname ^ dirSep ^ filename + if l = 0 || is_dir_sep dirname (l - 1) then dirname ^ filename + else dirname ^ dir_sep ^ filename end let concat (dirname : string) filename = let open Path in - Path.concat (normalize dirname) filename |> toString + Path.concat (normalize dirname) filename |> to_string end diff --git a/jscomp/gentype/GenTypeConfig.ml b/jscomp/gentype/GenTypeConfig.ml index 9e5ec193c8..11046212ba 100644 --- a/jscomp/gentype/GenTypeConfig.ml +++ b/jscomp/gentype/GenTypeConfig.ml @@ -3,83 +3,83 @@ module ModuleNameMap = Map.Make (ModuleName) type module_ = CommonJS | ESModule (** Compatibility for `compilerOptions.moduleResolution` in TypeScript projects. *) -type moduleResolution = +type module_resolution = | Node (** should drop extension on import statements *) | Node16 (** should use TS output's extension (e.g. `.gen.js`) on import statements *) | Bundler (** should use TS input's extension (e.g. `.gen.tsx`) on import statements *) -type bsVersion = int * int * int +type bs_version = int * int * int type t = { - mutable bsbProjectRoot: string; - bsDependencies: string list; - mutable emitImportCurry: bool; - mutable emitImportReact: bool; - mutable emitTypePropDone: bool; + mutable bsb_project_root: string; + bs_dependencies: string list; + mutable emit_import_curry: bool; + mutable emit_import_react: bool; + mutable emit_type_prop_done: bool; mutable everything: bool; - exportInterfaces: bool; - generatedFileExtension: string option; + export_interfaces: bool; + generated_file_extension: string option; module_: module_; - moduleResolution: moduleResolution; + module_resolution: module_resolution; namespace: string option; - platformLib: string; - mutable projectRoot: string; - shimsMap: ModuleName.t ModuleNameMap.t; + platform_lib: string; + mutable project_root: string; + shims_map: ModuleName.t ModuleNameMap.t; sources: Ext_json_types.t option; suffix: string; } let default = { - bsbProjectRoot = ""; - bsDependencies = []; - emitImportCurry = false; - emitImportReact = false; - emitTypePropDone = false; + bsb_project_root = ""; + bs_dependencies = []; + emit_import_curry = false; + emit_import_react = false; + emit_type_prop_done = false; everything = false; - exportInterfaces = false; - generatedFileExtension = None; + export_interfaces = false; + generated_file_extension = None; module_ = ESModule; - moduleResolution = Node; + module_resolution = Node; namespace = None; - platformLib = ""; - projectRoot = ""; - shimsMap = ModuleNameMap.empty; + platform_lib = ""; + project_root = ""; + shims_map = ModuleNameMap.empty; sources = None; suffix = ".bs.js"; } -let bsPlatformLib ~config = +let bs_platform_lib ~config = match config.module_ with - | ESModule -> config.platformLib ^ "/lib/es6" - | CommonJS -> config.platformLib ^ "/lib/js" + | ESModule -> config.platform_lib ^ "/lib/es6" + | CommonJS -> config.platform_lib ^ "/lib/js" -let getBsCurryPath ~config = Filename.concat (bsPlatformLib ~config) "curry.js" +let get_bs_curry_path ~config = Filename.concat (bs_platform_lib ~config) "curry.js" type map = Ext_json_types.t Map_string.t -let getOpt s (map : map) = Map_string.find_opt map s +let get_opt s (map : map) = Map_string.find_opt map s -let getBool s map = - match map |> getOpt s with +let get_bool s map = + match map |> get_opt s with | Some (True _) -> Some true | Some (False _) -> Some false | _ -> None -let getStringOption s map = - match map |> getOpt s with +let get_string_option s map = + match map |> get_opt s with | Some (Str {str}) -> Some str | _ -> None -let getShims map = +let get_shims map = let shims = ref [] in - (match map |> getOpt "shims" with - | Some (Obj {map = shimsMap}) -> - Map_string.iter shimsMap (fun fromModule toModule -> - match toModule with - | Ext_json_types.Str {str} -> shims := (fromModule, str) :: !shims + (match map |> get_opt "shims" with + | Some (Obj {map = shims_map}) -> + Map_string.iter shims_map (fun from_module to_module -> + match to_module with + | Ext_json_types.Str {str} -> shims := (from_module, str) :: !shims | _ -> ()) | Some (Arr {content}) -> (* To be deprecated: array of strings *) @@ -87,118 +87,118 @@ let getShims map = |> Array.iter (fun x -> match x with | Ext_json_types.Str {str} -> - let fromTo = str |> String.split_on_char '=' |> Array.of_list in - assert (Array.length fromTo == 2); + let from_to = str |> String.split_on_char '=' |> Array.of_list in + assert (Array.length from_to == 2); shims := - ((fromTo.(0) [@doesNotRaise]), (fromTo.(1) [@doesNotRaise])) + ((from_to.(0) [@doesNotRaise]), (from_to.(1) [@doesNotRaise])) :: !shims | _ -> ()) | _ -> ()); !shims -let setDebug ~gtconf = - match gtconf |> getOpt "debug" with - | Some (Obj {map}) -> Map_string.iter map Debug.setItem +let set_debug ~gtconf = + match gtconf |> get_opt "debug" with + | Some (Obj {map}) -> Map_string.iter map Debug.set_item | _ -> () -let compilerConfigFile = "rescript.json" -let legacyCompilerConfigFile = "bsconfig.json" +let compiler_config_file = "rescript.json" +let legacy_compiler_config_file = "bsconfig.json" -let rec findProjectRoot ~dir = +let rec find_project_root ~dir = if - Sys.file_exists (Filename.concat dir compilerConfigFile) - || Sys.file_exists (Filename.concat dir legacyCompilerConfigFile) + Sys.file_exists (Filename.concat dir compiler_config_file) + || Sys.file_exists (Filename.concat dir legacy_compiler_config_file) then dir else let parent = dir |> Filename.dirname in if parent = dir then ( prerr_endline - ("Error: cannot find project root containing " ^ compilerConfigFile + ("Error: cannot find project root containing " ^ compiler_config_file ^ "."); assert false) - else findProjectRoot ~dir:parent + else find_project_root ~dir:parent -let readConfig ~getConfigFile ~namespace = - let projectRoot = findProjectRoot ~dir:(Sys.getcwd ()) in - let bsbProjectRoot = +let read_config ~get_config_file ~namespace = + let project_root = find_project_root ~dir:(Sys.getcwd ()) in + let bsb_project_root = match Sys.getenv_opt "BSB_PROJECT_ROOT" with - | None -> projectRoot + | None -> project_root | Some s -> s in - let parseConfig ~bsconf ~gtconf = - let moduleString = gtconf |> getStringOption "module" in - let moduleResolutionString = gtconf |> getStringOption "moduleResolution" in - let exportInterfacesBool = gtconf |> getBool "exportInterfaces" in - let generatedFileExtensionStringOption = - gtconf |> getStringOption "generatedFileExtension" + let parse_config ~bsconf ~gtconf = + let module_string = gtconf |> get_string_option "module" in + let module_resolution_string = gtconf |> get_string_option "moduleResolution" in + let export_interfaces_bool = gtconf |> get_bool "exportInterfaces" in + let generated_file_extension_string_option = + gtconf |> get_string_option "generatedFileExtension" in - let shimsMap = - gtconf |> getShims + let shims_map = + gtconf |> get_shims |> List.fold_left - (fun map (fromModule, toModule) -> - let moduleName = - (fromModule |> ModuleName.fromStringUnsafe : ModuleName.t) + (fun map (from_module, to_module) -> + let module_name = + (from_module |> ModuleName.from_string_unsafe : ModuleName.t) in - let shimModuleName = toModule |> ModuleName.fromStringUnsafe in - ModuleNameMap.add moduleName shimModuleName map) + let shim_module_name = to_module |> ModuleName.from_string_unsafe in + ModuleNameMap.add module_name shim_module_name map) ModuleNameMap.empty in - setDebug ~gtconf; + set_debug ~gtconf; let module_ = - let packageSpecsModuleString = - match bsconf |> getOpt "package-specs" with - | Some (Obj {map = packageSpecs}) -> - packageSpecs |> getStringOption "module" + let package_specs_module_string = + match bsconf |> get_opt "package-specs" with + | Some (Obj {map = package_specs}) -> + package_specs |> get_string_option "module" | _ -> None in (* Give priority to gentypeconfig, followed by package-specs *) - match (moduleString, packageSpecsModuleString) with + match (module_string, package_specs_module_string) with | Some "commonjs", _ -> CommonJS | Some ("esmodule" | "es6"), _ -> ESModule | None, Some "commonjs" -> CommonJS | None, Some ("esmodule" | "es6" | "es6-global") -> ESModule | _ -> default.module_ in - let moduleResolution = - match moduleResolutionString with + let module_resolution = + match module_resolution_string with | Some "node" -> Node | Some "node16" -> Node16 | Some "bundler" -> Bundler - | _ -> default.moduleResolution + | _ -> default.module_resolution in - let exportInterfaces = - match exportInterfacesBool with - | None -> default.exportInterfaces + let export_interfaces = + match export_interfaces_bool with + | None -> default.export_interfaces | Some b -> b in - let generatedFileExtension = generatedFileExtensionStringOption in - let externalStdlib = bsconf |> getStringOption "external-stdlib" in - let platformLib = - match externalStdlib with + let generated_file_extension = generated_file_extension_string_option in + let external_stdlib = bsconf |> get_string_option "external-stdlib" in + let platform_lib = + match external_stdlib with | None -> "rescript" - | Some externalStdlib -> externalStdlib + | Some external_stdlib -> external_stdlib in if !Debug.config then ( - Log_.item "Project roLiterals.bsconfig_jsonot: %s\n" projectRoot; - if bsbProjectRoot <> projectRoot then - Log_.item "bsb project root: %s\n" bsbProjectRoot; + Log_.item "Project roLiterals.bsconfig_jsonot: %s\n" project_root; + if bsb_project_root <> project_root then + Log_.item "bsb project root: %s\n" bsb_project_root; Log_.item "Config module:%s shims:%d entries \n" - (match moduleString with + (match module_string with | None -> "" | Some s -> s) - (shimsMap |> ModuleNameMap.cardinal)); + (shims_map |> ModuleNameMap.cardinal)); let namespace = - match bsconf |> getOpt "namespace" with + match bsconf |> get_opt "namespace" with | Some (True _) -> namespace | _ -> default.namespace in let suffix = - match bsconf |> getStringOption "suffix" with + match bsconf |> get_string_option "suffix" with | Some s -> s | _ -> default.suffix in - let bsDependencies = - match bsconf |> getOpt "bs-dependencies" with + let bs_dependencies = + match bsconf |> get_opt "bs-dependencies" with | Some (Arr {content}) -> let strings = ref [] in content @@ -207,41 +207,41 @@ let readConfig ~getConfigFile ~namespace = | Ext_json_types.Str {str} -> strings := str :: !strings | _ -> ()); !strings - | _ -> default.bsDependencies + | _ -> default.bs_dependencies in let sources = - match bsconf |> getOpt "sources" with - | Some sourceItem -> Some sourceItem + match bsconf |> get_opt "sources" with + | Some source_item -> Some source_item | _ -> default.sources in let everything = false in { - bsbProjectRoot; - bsDependencies; + bsb_project_root; + bs_dependencies; suffix; - emitImportCurry = false; - emitImportReact = false; - emitTypePropDone = false; + emit_import_curry = false; + emit_import_react = false; + emit_type_prop_done = false; everything; - exportInterfaces; - generatedFileExtension; + export_interfaces; + generated_file_extension; module_; - moduleResolution; + module_resolution; namespace; - platformLib; - projectRoot; - shimsMap; + platform_lib; + project_root; + shims_map; sources; } in - match getConfigFile ~projectRoot with - | Some bsConfigFile -> ( + match get_config_file ~project_root with + | Some bs_config_file -> ( try - let json = bsConfigFile |> Ext_json_parse.parse_json_from_file in + let json = bs_config_file |> Ext_json_parse.parse_json_from_file in match json with | Obj {map = bsconf} -> ( - match bsconf |> getOpt "gentypeconfig" with - | Some (Obj {map = gtconf}) -> parseConfig ~bsconf ~gtconf + match bsconf |> get_opt "gentypeconfig" with + | Some (Obj {map = gtconf}) -> parse_config ~bsconf ~gtconf | _ -> default) | _ -> default with _ -> default) diff --git a/jscomp/gentype/GenTypeMain.ml b/jscomp/gentype/GenTypeMain.ml index 5b733f1e57..7d173e9ce7 100644 --- a/jscomp/gentype/GenTypeMain.ml +++ b/jscomp/gentype/GenTypeMain.ml @@ -1,137 +1,137 @@ module StringSet = Set.Make (String) -let cmtCheckAnnotations ~checkAnnotation inputCMT = - match inputCMT.Cmt_format.cmt_annots with +let cmt_check_annotations ~check_annotation input_c_m_t = + match input_c_m_t.Cmt_format.cmt_annots with | Implementation structure -> - structure |> Annotation.structureCheckAnnotation ~checkAnnotation + structure |> Annotation.structure_check_annotation ~check_annotation | Interface signature -> - signature |> Annotation.signatureCheckAnnotation ~checkAnnotation + signature |> Annotation.signature_check_annotation ~check_annotation | _ -> false -let cmtHasTypeErrors inputCMT = - match inputCMT.Cmt_format.cmt_annots with +let cmt_has_type_errors input_c_m_t = + match input_c_m_t.Cmt_format.cmt_annots with | Partial_implementation _ | Partial_interface _ -> true | _ -> false -let structureItemIsDeclaration structItem = - match structItem.Typedtree.str_desc with +let structure_item_is_declaration struct_item = + match struct_item.Typedtree.str_desc with | Typedtree.Tstr_type _ | Tstr_modtype _ | Tstr_module _ -> true | _ -> false -let signatureItemIsDeclaration signatureItem = - match signatureItem.Typedtree.sig_desc with +let signature_item_is_declaration signature_item = + match signature_item.Typedtree.sig_desc with | Typedtree.Tsig_type _ | Tsig_modtype _ -> true | _ -> false -let inputCmtTranslateTypeDeclarations ~config ~outputFileRelative ~resolver - inputCMT : CodeItem.translation = - let {Cmt_format.cmt_annots} = inputCMT in - let typeEnv = TypeEnv.root () in +let input_cmt_translate_type_declarations ~config ~output_file_relative ~resolver + input_c_m_t : CodeItem.translation = + let {Cmt_format.cmt_annots} = input_c_m_t in + let type_env = TypeEnv.root () in let translations = match cmt_annots with | Implementation structure -> { structure with str_items = - structure.str_items |> List.filter structureItemIsDeclaration; + structure.str_items |> List.filter structure_item_is_declaration; } - |> TranslateStructure.translateStructure ~config ~outputFileRelative - ~resolver ~typeEnv + |> TranslateStructure.translate_structure ~config ~output_file_relative + ~resolver ~type_env | Interface signature -> { signature with sig_items = - signature.sig_items |> List.filter signatureItemIsDeclaration; + signature.sig_items |> List.filter signature_item_is_declaration; } - |> TranslateSignature.translateSignature ~config ~outputFileRelative - ~resolver ~typeEnv + |> TranslateSignature.translate_signature ~config ~output_file_relative + ~resolver ~type_env | Packed _ | Partial_implementation _ | Partial_interface _ -> [] in translations |> Translation.combine - |> Translation.addTypeDeclarationsFromModuleEquations ~typeEnv + |> Translation.add_type_declarations_from_module_equations ~type_env -let translateCMT ~config ~outputFileRelative ~resolver inputCMT : Translation.t +let translate_c_m_t ~config ~output_file_relative ~resolver input_c_m_t : Translation.t = - let {Cmt_format.cmt_annots} = inputCMT in - let typeEnv = TypeEnv.root () in + let {Cmt_format.cmt_annots} = input_c_m_t in + let type_env = TypeEnv.root () in let translations = match cmt_annots with | Implementation structure -> structure - |> TranslateStructure.translateStructure ~config ~outputFileRelative - ~resolver ~typeEnv + |> TranslateStructure.translate_structure ~config ~output_file_relative + ~resolver ~type_env | Interface signature -> signature - |> TranslateSignature.translateSignature ~config ~outputFileRelative - ~resolver ~typeEnv + |> TranslateSignature.translate_signature ~config ~output_file_relative + ~resolver ~type_env | _ -> [] in translations |> Translation.combine - |> Translation.addTypeDeclarationsFromModuleEquations ~typeEnv + |> Translation.add_type_declarations_from_module_equations ~type_env -let emitTranslation ~config ~fileName ~outputFile ~outputFileRelative ~resolver - ~sourceFile translation = - let codeText = +let emit_translation ~config ~file_name ~output_file ~output_file_relative ~resolver + ~source_file translation = + let code_text = translation - |> EmitJs.emitTranslationAsString ~config ~fileName ~outputFileRelative - ~resolver ~inputCmtTranslateTypeDeclarations + |> EmitJs.emit_translation_as_string ~config ~file_name ~output_file_relative + ~resolver ~input_cmt_translate_type_declarations in - let fileContents = - EmitType.fileHeader ~sourceFile:(Filename.basename sourceFile) - ^ "\n" ^ codeText ^ "\n" + let file_contents = + EmitType.file_header ~source_file:(Filename.basename source_file) + ^ "\n" ^ code_text ^ "\n" in - GeneratedFiles.writeFileIfRequired ~outputFile ~fileContents + GeneratedFiles.write_file_if_required ~output_file ~file_contents -let readCmt cmtFile = - try Cmt_format.read_cmt cmtFile +let read_cmt cmt_file = + try Cmt_format.read_cmt cmt_file with Cmi_format.Error _ -> - Log_.item "Error loading %s\n\n" cmtFile; + Log_.item "Error loading %s\n\n" cmt_file; Log_.item "It looks like you might have stale compilation artifacts.\n"; Log_.item "Try to clean and rebuild.\n\n"; assert false -let processCmtFile cmt = - let config = Paths.readConfig ~namespace:(cmt |> Paths.findNameSpace) in +let process_cmt_file cmt = + let config = Paths.read_config ~namespace:(cmt |> Paths.find_name_space) in if !Debug.basic then Log_.item "Cmt %s\n" cmt; - let cmtFile = cmt |> Paths.getCmtFile in - if cmtFile <> "" then - let outputFile = cmt |> Paths.getOutputFile ~config in - let outputFileRelative = cmt |> Paths.getOutputFileRelative ~config in - let fileName = cmt |> Paths.getModuleName in - let isInterface = Filename.check_suffix cmtFile ".cmti" in + let cmt_file = cmt |> Paths.get_cmt_file in + if cmt_file <> "" then + let output_file = cmt |> Paths.get_output_file ~config in + let output_file_relative = cmt |> Paths.get_output_file_relative ~config in + let file_name = cmt |> Paths.get_module_name in + let is_interface = Filename.check_suffix cmt_file ".cmti" in let resolver = - ModuleResolver.createLazyResolver ~config ~extensions:[".res"; ".shim.ts"] - ~excludeFile:(fun fname -> + ModuleResolver.create_lazy_resolver ~config ~extensions:[".res"; ".shim.ts"] + ~exclude_file:(fun fname -> fname = "React.res" || fname = "ReasonReact.res") in - let inputCMT, hasGenTypeAnnotations = - let inputCMT = readCmt cmtFile in - let ignoreInterface = ref false in - let checkAnnotation ~loc:_ attributes = + let input_c_m_t, has_gen_type_annotations = + let input_c_m_t = read_cmt cmt_file in + let ignore_interface = ref false in + let check_annotation ~loc:_ attributes = if attributes - |> Annotation.getAttributePayload - Annotation.tagIsGenTypeIgnoreInterface + |> Annotation.get_attribute_payload + Annotation.tag_is_gen_type_ignore_interface <> None - then ignoreInterface := true; + then ignore_interface := true; attributes - |> Annotation.getAttributePayload - Annotation.tagIsOneOfTheGenTypeAnnotations + |> Annotation.get_attribute_payload + Annotation.tag_is_one_of_the_gen_type_annotations <> None in - let hasGenTypeAnnotations = - inputCMT |> cmtCheckAnnotations ~checkAnnotation + let has_gen_type_annotations = + input_c_m_t |> cmt_check_annotations ~check_annotation in - if isInterface then - let cmtFileImpl = - (cmtFile |> (Filename.chop_extension [@doesNotRaise])) ^ ".cmt" + if is_interface then + let cmt_file_impl = + (cmt_file |> (Filename.chop_extension [@doesNotRaise])) ^ ".cmt" in - let inputCMTImpl = readCmt cmtFileImpl in - let hasGenTypeAnnotationsImpl = - inputCMTImpl - |> cmtCheckAnnotations ~checkAnnotation:(fun ~loc attributes -> - if attributes |> checkAnnotation ~loc then ( - if not !ignoreInterface then ( + let input_c_m_t_impl = read_cmt cmt_file_impl in + let has_gen_type_annotations_impl = + input_c_m_t_impl + |> cmt_check_annotations ~check_annotation:(fun ~loc attributes -> + if attributes |> check_annotation ~loc then ( + if not !ignore_interface then ( Log_.Color.setup (); Log_.info ~loc ~name:"Warning genType" (fun ppf () -> Format.fprintf ppf @@ -139,32 +139,32 @@ let processCmtFile cmt = true) else false) in - ( (match !ignoreInterface with - | true -> inputCMTImpl - | false -> inputCMT), - match !ignoreInterface with - | true -> hasGenTypeAnnotationsImpl - | false -> hasGenTypeAnnotations ) - else (inputCMT, hasGenTypeAnnotations) + ( (match !ignore_interface with + | true -> input_c_m_t_impl + | false -> input_c_m_t), + match !ignore_interface with + | true -> has_gen_type_annotations_impl + | false -> has_gen_type_annotations ) + else (input_c_m_t, has_gen_type_annotations) in - if hasGenTypeAnnotations then - let sourceFile = - match inputCMT.cmt_annots |> FindSourceFile.cmt with - | Some sourceFile -> sourceFile + if has_gen_type_annotations then + let source_file = + match input_c_m_t.cmt_annots |> FindSourceFile.cmt with + | Some source_file -> source_file | None -> ( - (fileName |> ModuleName.toString) + (file_name |> ModuleName.to_string) ^ - match isInterface with + match is_interface with | true -> ".resi" | false -> ".res") in - inputCMT - |> translateCMT ~config ~outputFileRelative ~resolver - |> emitTranslation ~config ~fileName ~outputFile ~outputFileRelative - ~resolver ~sourceFile - else if inputCMT |> cmtHasTypeErrors then - outputFile |> GeneratedFiles.logFileAction TypeError + input_c_m_t + |> translate_c_m_t ~config ~output_file_relative ~resolver + |> emit_translation ~config ~file_name ~output_file ~output_file_relative + ~resolver ~source_file + else if input_c_m_t |> cmt_has_type_errors then + output_file |> GeneratedFiles.log_file_action TypeError else ( - outputFile |> GeneratedFiles.logFileAction NoMatch; - if Sys.file_exists outputFile then Sys.remove outputFile) + output_file |> GeneratedFiles.log_file_action NoMatch; + if Sys.file_exists output_file then Sys.remove output_file) [@@live] diff --git a/jscomp/gentype/GeneratedFiles.ml b/jscomp/gentype/GeneratedFiles.ml index 5b22a99b3d..5cb6acf154 100644 --- a/jscomp/gentype/GeneratedFiles.ml +++ b/jscomp/gentype/GeneratedFiles.ml @@ -1,4 +1,4 @@ -type fileAction = +type file_action = | NoMatch (* No @genType annotation found. *) | Replace (* Replace existing file on disk with new contents. *) | Identical (* File already on disk with identical contents. Skip. *) @@ -6,18 +6,18 @@ type fileAction = (* The cmt file was produced after a type error -- don't delete generated files. *) | Write (* File not present on disk. *) -let logFileAction fileAction fileName = +let log_file_action file_action file_name = if !Debug.basic then Log_.item "%s %s\n" - (match fileAction with + (match file_action with | NoMatch -> "NoMatch" | Replace -> "Replace" | Identical -> "Identical" | TypeError -> "TypeError" | Write -> "Write") - fileName + file_name -let readLines (file : string) : string list = +let read_lines (file : string) : string list = let lines = ref [] in let chan = open_in file in let finished_lines = @@ -32,21 +32,21 @@ let readLines (file : string) : string list = in finished_lines -let readFile (file : string) : string = String.concat "\n" (readLines file) +let read_file (file : string) : string = String.concat "\n" (read_lines file) -let writeFile (filePath : string) (contents : string) = - let outFile = open_out filePath in - output_string outFile contents; - close_out outFile [@doesNotRaise] +let write_file (file_path : string) (contents : string) = + let out_file = open_out file_path in + output_string out_file contents; + close_out out_file [@doesNotRaise] -let writeFileIfRequired ~outputFile ~fileContents = - if Sys.file_exists outputFile then - let oldContents = readFile outputFile in - let identical = oldContents = fileContents in - if identical then outputFile |> logFileAction Identical +let write_file_if_required ~output_file ~file_contents = + if Sys.file_exists output_file then + let old_contents = read_file output_file in + let identical = old_contents = file_contents in + if identical then output_file |> log_file_action Identical else ( - outputFile |> logFileAction Replace; - writeFile outputFile fileContents) + output_file |> log_file_action Replace; + write_file output_file file_contents) else ( - outputFile |> logFileAction Write; - writeFile outputFile fileContents) + output_file |> log_file_action Write; + write_file output_file file_contents) diff --git a/jscomp/gentype/ImportPath.ml b/jscomp/gentype/ImportPath.ml index a1c11145d2..5cc7929297 100644 --- a/jscomp/gentype/ImportPath.ml +++ b/jscomp/gentype/ImportPath.ml @@ -2,25 +2,25 @@ open GenTypeCommon type t = string * string -let bsCurryPath ~config = ("", Config.getBsCurryPath ~config) +let bs_curry_path ~config = ("", Config.get_bs_curry_path ~config) -let fromModule ~dir ~importExtension moduleName = - let withNoPath = - (moduleName |> ModuleName.toString |> ScopedPackage.removeGeneratedModule) - ^ importExtension +let from_module ~dir ~import_extension module_name = + let with_no_path = + (module_name |> ModuleName.to_string |> ScopedPackage.remove_generated_module) + ^ import_extension in - (dir, withNoPath) + (dir, with_no_path) -let fromStringUnsafe s = ("", s) +let from_string_unsafe s = ("", s) -let chopExtensionSafe (dir, s) = +let chop_extension_safe (dir, s) = try (dir, s |> Filename.chop_extension) with Invalid_argument _ -> (dir, s) let dump (dir, s) = NodeFilename.concat dir s -let toCmt ~(config : Config.t) ~outputFileRelative (dir, s) = +let to_cmt ~(config : Config.t) ~output_file_relative (dir, s) = let open Filename in - concat (outputFileRelative |> dirname) ((dir, s) |> chopExtensionSafe |> dump) + concat (output_file_relative |> dirname) ((dir, s) |> chop_extension_safe |> dump) ^ (match config.namespace with | None -> "" | Some name -> "-" ^ name) diff --git a/jscomp/gentype/ImportPath.mli b/jscomp/gentype/ImportPath.mli index 740e629f9a..f44a63cc5b 100644 --- a/jscomp/gentype/ImportPath.mli +++ b/jscomp/gentype/ImportPath.mli @@ -2,10 +2,10 @@ open GenTypeCommon type t -val bsCurryPath : config:Config.t -> t -val chopExtensionSafe : t -> t [@@live] +val bs_curry_path : config:Config.t -> t +val chop_extension_safe : t -> t [@@live] val dump : t -> string val emit : t -> string -val fromModule : dir:string -> importExtension:string -> ModuleName.t -> t -val fromStringUnsafe : string -> t -val toCmt : config:Config.t -> outputFileRelative:string -> t -> string +val from_module : dir:string -> import_extension:string -> ModuleName.t -> t +val from_string_unsafe : string -> t +val to_cmt : config:Config.t -> output_file_relative:string -> t -> string diff --git a/jscomp/gentype/Indent.ml b/jscomp/gentype/Indent.ml index f0282b32ce..71a490a612 100644 --- a/jscomp/gentype/Indent.ml +++ b/jscomp/gentype/Indent.ml @@ -9,13 +9,13 @@ let more indent = | None -> None | Some s -> Some (" " ^ s) -let heuristicFields ~indent fields = +let heuristic_fields ~indent fields = let threshold = 2 in match fields |> List.length > threshold && indent = None with | true -> Some "" | false -> indent -let heuristicVariants ~indent rendered = +let heuristic_variants ~indent rendered = let threshold = 40 in let break = rendered |> String.concat " " |> String.length > threshold in match break && indent = None with diff --git a/jscomp/gentype/Log_.ml b/jscomp/gentype/Log_.ml index 377821f0fa..16db5bbff0 100644 --- a/jscomp/gentype/Log_.ml +++ b/jscomp/gentype/Log_.ml @@ -51,7 +51,7 @@ module Loc = struct | "_none_" | "" -> Format.fprintf ppf "(No file name)" | real_file -> Format.fprintf ppf "%s" (Location.show_filename real_file) - let print_loc ~normalizedRange ppf (loc : Location.t) = + let print_loc ~normalized_range ppf (loc : Location.t) = let file, _, _ = Location.get_pos_info loc.loc_start in if file = "//toplevel//" then Format.fprintf ppf "Characters %i-%i" loc.loc_start.pos_cnum @@ -74,12 +74,12 @@ module Loc = struct start_line_start_char end_line end_line_end_char in Format.fprintf ppf "@{%a@}%a" print_filename file dim_loc - normalizedRange + normalized_range let print ppf (loc : Location.t) = let _file, start_line, start_char = Location.get_pos_info loc.loc_start in let _, end_line, end_char = Location.get_pos_info loc.loc_end in - let normalizedRange = + let normalized_range = if start_char == -1 || end_char == -1 then None else if start_line = end_line && start_char >= end_char then let same_char = start_char + 1 in @@ -87,15 +87,15 @@ module Loc = struct else Some ((start_line, start_char + 1), (end_line, end_char)) in - Format.fprintf ppf "@[%a@]" (print_loc ~normalizedRange) loc + Format.fprintf ppf "@[%a@]" (print_loc ~normalized_range) loc end let item x = Format.fprintf Format.std_formatter " "; Format.fprintf Format.std_formatter x -let logKind body ~color ~loc ~name = +let log_kind body ~color ~loc ~name = Format.fprintf Format.std_formatter "@[@,%a@,%a@,%a@]@." color name Loc.print loc body () -let info body ~loc ~name = logKind body ~color:Color.info ~loc ~name +let info body ~loc ~name = log_kind body ~color:Color.info ~loc ~name diff --git a/jscomp/gentype/ModuleExtension.ml b/jscomp/gentype/ModuleExtension.ml index c983f4ec30..0a1604f36f 100644 --- a/jscomp/gentype/ModuleExtension.ml +++ b/jscomp/gentype/ModuleExtension.ml @@ -1,28 +1,28 @@ open GenTypeCommon -let shimTsOutputFileExtension ~(config : Config.t) = - match config.moduleResolution with +let shim_ts_output_file_extension ~(config : Config.t) = + match config.module_resolution with | Node -> ".shim" | Node16 -> ".shim.js" | Bundler -> ".shim.ts" -let generatedFilesExtension ~(config : Config.t) = - match config.generatedFileExtension with +let generated_files_extension ~(config : Config.t) = + match config.generated_file_extension with | Some s -> (* from .foo.bar to .foo *) Filename.remove_extension s | None -> ".gen" -let tsInputFileSuffix ~(config : Config.t) = - match config.generatedFileExtension with +let ts_input_file_suffix ~(config : Config.t) = + match config.generated_file_extension with | Some s when Filename.extension s <> "" (* double extension *) -> s - | _ -> generatedFilesExtension ~config ^ ".tsx" + | _ -> generated_files_extension ~config ^ ".tsx" -let tsOutputFileSuffix ~(config : Config.t) = - generatedFilesExtension ~config ^ ".js" +let ts_output_file_suffix ~(config : Config.t) = + generated_files_extension ~config ^ ".js" -let generatedModuleExtension ~(config : Config.t) = - match config.moduleResolution with - | Node -> generatedFilesExtension ~config - | Node16 -> tsOutputFileSuffix ~config - | Bundler -> tsInputFileSuffix ~config +let generated_module_extension ~(config : Config.t) = + match config.module_resolution with + | Node -> generated_files_extension ~config + | Node16 -> ts_output_file_suffix ~config + | Bundler -> ts_input_file_suffix ~config diff --git a/jscomp/gentype/ModuleName.ml b/jscomp/gentype/ModuleName.ml index 549942e594..efd0d25370 100644 --- a/jscomp/gentype/ModuleName.ml +++ b/jscomp/gentype/ModuleName.ml @@ -1,9 +1,9 @@ type t = string let curry = "Curry" -let rescriptPervasives = "RescriptPervasives" +let rescript_pervasives = "RescriptPervasives" -let sanitizeId s = +let sanitize_id s = let s = if String.contains s '.' || String.contains s '[' || String.contains s ']' then @@ -17,12 +17,12 @@ let sanitizeId s = then s else "_" ^ s -let forJsFile s = sanitizeId s ^ "JS" +let for_js_file s = sanitize_id s ^ "JS" -let forInnerModule ~fileName ~innerModuleName = - (fileName |> forJsFile) ^ "." ^ innerModuleName +let for_inner_module ~file_name ~inner_module_name = + (file_name |> for_js_file) ^ "." ^ inner_module_name -let fromStringUnsafe s = s -let toString s = s +let from_string_unsafe s = s +let to_string s = s let compare (s1 : string) s2 = compare s1 s2 let uncapitalize = String.uncapitalize_ascii diff --git a/jscomp/gentype/ModuleName.mli b/jscomp/gentype/ModuleName.mli index bf1fa3d118..fcd5555302 100644 --- a/jscomp/gentype/ModuleName.mli +++ b/jscomp/gentype/ModuleName.mli @@ -2,12 +2,12 @@ type t val compare : t -> t -> int val curry : t -val forJsFile : t -> t -val forInnerModule : fileName:t -> innerModuleName:string -> t +val for_js_file : t -> t +val for_inner_module : file_name:t -> inner_module_name:string -> t -val fromStringUnsafe : string -> t +val from_string_unsafe : string -> t (** Used to turn strings read from external files into module names. *) -val rescriptPervasives : t -val toString : t -> string +val rescript_pervasives : t +val to_string : t -> string val uncapitalize : t -> t diff --git a/jscomp/gentype/ModuleResolver.ml b/jscomp/gentype/ModuleResolver.ml index 838ecca198..f876b143a9 100644 --- a/jscomp/gentype/ModuleResolver.ml +++ b/jscomp/gentype/ModuleResolver.ml @@ -4,42 +4,42 @@ module ModuleNameMap = Map.Make (ModuleName) let ( +++ ) = Filename.concat (** Read all the dirs from a library in node_modules *) -let readBsDependenciesDirs ~root = +let read_bs_dependencies_dirs ~root = let dirs = ref [] in - let rec findSubDirs dir = - let absDir = + let rec find_sub_dirs dir = + let abs_dir = match dir = "" with | true -> root | false -> root +++ dir in - if Sys.file_exists absDir && Sys.is_directory absDir then ( + if Sys.file_exists abs_dir && Sys.is_directory abs_dir then ( dirs := dir :: !dirs; - absDir |> Sys.readdir |> Array.iter (fun d -> findSubDirs (dir +++ d))) + abs_dir |> Sys.readdir |> Array.iter (fun d -> find_sub_dirs (dir +++ d))) in - findSubDirs ""; + find_sub_dirs ""; !dirs type pkgs = {dirs: string list; pkgs: (string, string) Hashtbl.t} -let readDirsFromConfig ~(config : Config.t) = +let read_dirs_from_config ~(config : Config.t) = let dirs = ref [] in - let root = config.projectRoot in + let root = config.project_root in let ( +++ ) = Filename.concat in - let rec processDir ~subdirs dir = - let absDir = + let rec process_dir ~subdirs dir = + let abs_dir = match dir = "" with | true -> root | false -> root +++ dir in - if Sys.file_exists absDir && Sys.is_directory absDir then ( + if Sys.file_exists abs_dir && Sys.is_directory abs_dir then ( dirs := dir :: !dirs; if subdirs then - absDir |> Sys.readdir - |> Array.iter (fun d -> processDir ~subdirs (dir +++ d))) + abs_dir |> Sys.readdir + |> Array.iter (fun d -> process_dir ~subdirs (dir +++ d))) in - let rec processSourceItem (sourceItem : Ext_json_types.t) = - match sourceItem with - | Str {str} -> str |> processDir ~subdirs:false + let rec process_source_item (source_item : Ext_json_types.t) = + match source_item with + | Str {str} -> str |> process_dir ~subdirs:false | Obj {map} -> ( match Map_string.find_opt map "dir" with | Some (Str {str}) -> @@ -49,24 +49,24 @@ let readDirsFromConfig ~(config : Config.t) = | Some (False _) -> false | _ -> false in - str |> processDir ~subdirs + str |> process_dir ~subdirs | _ -> ()) - | Arr {content} -> Array.iter processSourceItem content + | Arr {content} -> Array.iter process_source_item content | _ -> () in (match config.sources with - | Some sourceItem -> processSourceItem sourceItem + | Some source_item -> process_source_item source_item | None -> ()); !dirs -let readSourceDirs ~(config : Config.t) = - let sourceDirs = +let read_source_dirs ~(config : Config.t) = + let source_dirs = ["lib"; "bs"; ".sourcedirs.json"] - |> List.fold_left ( +++ ) config.bsbProjectRoot + |> List.fold_left ( +++ ) config.bsb_project_root in let dirs = ref [] in let pkgs = Hashtbl.create 1 in - let readDirs json = + let read_dirs json = match json with | Ext_json_types.Obj {map} -> ( match Map_string.find_opt map "dirs" with @@ -80,7 +80,7 @@ let readSourceDirs ~(config : Config.t) = | _ -> ()) | _ -> () in - let readPkgs json = + let read_pkgs json = match json with | Ext_json_types.Obj {map} -> ( match Map_string.find_opt map "pkgs" with @@ -96,189 +96,189 @@ let readSourceDirs ~(config : Config.t) = | _ -> ()) | _ -> () in - if sourceDirs |> Sys.file_exists then + if source_dirs |> Sys.file_exists then try - let json = sourceDirs |> Ext_json_parse.parse_json_from_file in - if config.bsbProjectRoot <> config.projectRoot then - dirs := readDirsFromConfig ~config - else readDirs json; - readPkgs json + let json = source_dirs |> Ext_json_parse.parse_json_from_file in + if config.bsb_project_root <> config.project_root then + dirs := read_dirs_from_config ~config + else read_dirs json; + read_pkgs json with _ -> () else ( - Log_.item "Warning: can't find source dirs: %s\n" sourceDirs; + Log_.item "Warning: can't find source dirs: %s\n" source_dirs; Log_.item "Types for cross-references will not be found by genType.\n"; - dirs := readDirsFromConfig ~config); + dirs := read_dirs_from_config ~config); {dirs = !dirs; pkgs} (** Read the project's .sourcedirs.json file if it exists and build a map of the files with the given extension back to the directory where they belong. *) -let sourcedirsJsonToMap ~config ~extensions ~excludeFile = - let rec chopExtensions fname = +let sourcedirs_json_to_map ~config ~extensions ~exclude_file = + let rec chop_extensions fname = match fname |> Filename.chop_extension with - | fnameChopped -> fnameChopped |> chopExtensions + | fname_chopped -> fname_chopped |> chop_extensions | exception _ -> fname in - let fileMap = ref ModuleNameMap.empty in - let bsDependenciesFileMap = ref ModuleNameMap.empty in - let filterGivenExtension fileName = - extensions |> List.exists (fun ext -> Filename.check_suffix fileName ext) - && not (excludeFile fileName) + let file_map = ref ModuleNameMap.empty in + let bs_dependencies_file_map = ref ModuleNameMap.empty in + let filter_given_extension file_name = + extensions |> List.exists (fun ext -> Filename.check_suffix file_name ext) + && not (exclude_file file_name) in - let addDir ~dirOnDisk ~dirEmitted ~filter ~map = - dirOnDisk |> Sys.readdir + let add_dir ~dir_on_disk ~dir_emitted ~filter ~map = + dir_on_disk |> Sys.readdir |> Array.iter (fun fname -> if fname |> filter then map := !map |> ModuleNameMap.add - (fname |> chopExtensions |> ModuleName.fromStringUnsafe) - dirEmitted) + (fname |> chop_extensions |> ModuleName.from_string_unsafe) + dir_emitted) in - let {dirs; pkgs} = readSourceDirs ~config in + let {dirs; pkgs} = read_source_dirs ~config in dirs |> List.iter (fun dir -> - addDir ~dirEmitted:dir - ~dirOnDisk:(config.projectRoot +++ dir) - ~filter:filterGivenExtension ~map:fileMap); - config.bsDependencies - |> List.iter (fun packageName -> - match Hashtbl.find pkgs packageName with + add_dir ~dir_emitted:dir + ~dir_on_disk:(config.project_root +++ dir) + ~filter:filter_given_extension ~map:file_map); + config.bs_dependencies + |> List.iter (fun package_name -> + match Hashtbl.find pkgs package_name with | path -> let root = ["lib"; "bs"] |> List.fold_left ( +++ ) path in - let filter fileName = + let filter file_name = [".cmt"; ".cmti"] - |> List.exists (fun ext -> Filename.check_suffix fileName ext) + |> List.exists (fun ext -> Filename.check_suffix file_name ext) in - readBsDependenciesDirs ~root + read_bs_dependencies_dirs ~root |> List.iter (fun dir -> - let dirOnDisk = root +++ dir in - let dirEmitted = packageName +++ dir in - addDir ~dirEmitted ~dirOnDisk ~filter - ~map:bsDependenciesFileMap) + let dir_on_disk = root +++ dir in + let dir_emitted = package_name +++ dir in + add_dir ~dir_emitted ~dir_on_disk ~filter + ~map:bs_dependencies_file_map) | exception Not_found -> ()); - (!fileMap, !bsDependenciesFileMap) + (!file_map, !bs_dependencies_file_map) type case = Lowercase | Uppercase type resolver = { - lazyFind: - (useBsDependencies:bool -> ModuleName.t -> (string * case * bool) option) + lazy_find: + (use_bs_dependencies:bool -> ModuleName.t -> (string * case * bool) option) Lazy.t; } -let createLazyResolver ~config ~extensions ~excludeFile = +let create_lazy_resolver ~config ~extensions ~exclude_file = { - lazyFind = + lazy_find = lazy - (let moduleNameMap, bsDependenciesFileMap = - sourcedirsJsonToMap ~config ~extensions ~excludeFile + (let module_name_map, bs_dependencies_file_map = + sourcedirs_json_to_map ~config ~extensions ~exclude_file in - let find ~bsDependencies ~map moduleName = - match map |> ModuleNameMap.find moduleName with - | resolvedModuleDir -> - Some (resolvedModuleDir, Uppercase, bsDependencies) + let find ~bs_dependencies ~map module_name = + match map |> ModuleNameMap.find module_name with + | resolved_module_dir -> + Some (resolved_module_dir, Uppercase, bs_dependencies) | exception Not_found -> ( match - map |> ModuleNameMap.find (moduleName |> ModuleName.uncapitalize) + map |> ModuleNameMap.find (module_name |> ModuleName.uncapitalize) with - | resolvedModuleDir -> - Some (resolvedModuleDir, Lowercase, bsDependencies) + | resolved_module_dir -> + Some (resolved_module_dir, Lowercase, bs_dependencies) | exception Not_found -> None) in - fun ~useBsDependencies moduleName -> + fun ~use_bs_dependencies module_name -> match - moduleName |> find ~bsDependencies:false ~map:moduleNameMap + module_name |> find ~bs_dependencies:false ~map:module_name_map with - | None when useBsDependencies -> - moduleName |> find ~bsDependencies:true ~map:bsDependenciesFileMap + | None when use_bs_dependencies -> + module_name |> find ~bs_dependencies:true ~map:bs_dependencies_file_map | res -> res); } -let apply ~resolver ~useBsDependencies moduleName = - moduleName |> Lazy.force resolver.lazyFind ~useBsDependencies +let apply ~resolver ~use_bs_dependencies module_name = + module_name |> Lazy.force resolver.lazy_find ~use_bs_dependencies (** Resolve a reference to ModuleName, and produce a path suitable for require. E.g. require "../foo/bar/ModuleName.ext" where ext is ".res" or ".js". *) -let resolveModule ~(config : Config.t) ~importExtension ~outputFileRelative - ~resolver ~useBsDependencies moduleName = - let outputFileRelativeDir = +let resolve_module ~(config : Config.t) ~import_extension ~output_file_relative + ~resolver ~use_bs_dependencies module_name = + let output_file_relative_dir = (* e.g. src if we're generating src/File.bs.js *) - Filename.dirname outputFileRelative + Filename.dirname output_file_relative in - let outputFileAbsoluteDir = config.projectRoot +++ outputFileRelativeDir in - let moduleNameResFile = + let output_file_absolute_dir = config.project_root +++ output_file_relative_dir in + let module_name_res_file = (* Check if the module is in the same directory as the file being generated. So if e.g. project_root/src/ModuleName.res exists. *) - outputFileAbsoluteDir +++ (ModuleName.toString moduleName ^ ".res") + output_file_absolute_dir +++ (ModuleName.to_string module_name ^ ".res") in let candidate = (* e.g. import "./Modulename.ext" *) - moduleName - |> ImportPath.fromModule ~dir:Filename.current_dir_name ~importExtension + module_name + |> ImportPath.from_module ~dir:Filename.current_dir_name ~import_extension in - if Sys.file_exists moduleNameResFile then candidate + if Sys.file_exists module_name_res_file then candidate else - let rec pathToList path = - let isRoot = path |> Filename.basename = path in - match isRoot with + let rec path_to_list path = + let is_root = path |> Filename.basename = path in + match is_root with | true -> [path] | false -> - (path |> Filename.basename) :: (path |> Filename.dirname |> pathToList) + (path |> Filename.basename) :: (path |> Filename.dirname |> path_to_list) in - match moduleName |> apply ~resolver ~useBsDependencies with + match module_name |> apply ~resolver ~use_bs_dependencies with | None -> candidate - | Some (resolvedModuleDir, case, bsDependencies) -> + | Some (resolved_module_dir, case, bs_dependencies) -> (* e.g. "dst" in case of dst/ModuleName.res *) - let walkUpOutputDir = - outputFileRelativeDir |> pathToList + let walk_up_output_dir = + output_file_relative_dir |> path_to_list |> List.map (fun _ -> Filename.parent_dir_name) |> fun l -> match l with | [] -> "" | _ :: rest -> rest |> List.fold_left ( +++ ) Filename.parent_dir_name in - let fromOutputDirToModuleDir = + let from_output_dir_to_module_dir = (* e.g. "../dst" *) - match bsDependencies with - | true -> resolvedModuleDir - | false -> walkUpOutputDir +++ resolvedModuleDir + match bs_dependencies with + | true -> resolved_module_dir + | false -> walk_up_output_dir +++ resolved_module_dir in (* e.g. import "../dst/ModuleName.ext" *) (match case = Uppercase with - | true -> moduleName - | false -> moduleName |> ModuleName.uncapitalize) - |> ImportPath.fromModule ~dir:fromOutputDirToModuleDir ~importExtension + | true -> module_name + | false -> module_name |> ModuleName.uncapitalize) + |> ImportPath.from_module ~dir:from_output_dir_to_module_dir ~import_extension -let resolveGeneratedModule ~config ~outputFileRelative ~resolver moduleName = - if !Debug.moduleResolution then +let resolve_generated_module ~config ~output_file_relative ~resolver module_name = + if !Debug.module_resolution then Log_.item "Resolve Generated Module: %s\n" - (moduleName |> ModuleName.toString); - let importPath = - resolveModule ~config - ~importExtension:(ModuleExtension.generatedModuleExtension ~config) - ~outputFileRelative ~resolver ~useBsDependencies:true moduleName + (module_name |> ModuleName.to_string); + let import_path = + resolve_module ~config + ~import_extension:(ModuleExtension.generated_module_extension ~config) + ~output_file_relative ~resolver ~use_bs_dependencies:true module_name in - if !Debug.moduleResolution then - Log_.item "Import Path: %s\n" (importPath |> ImportPath.dump); - importPath + if !Debug.module_resolution then + Log_.item "Import Path: %s\n" (import_path |> ImportPath.dump); + import_path (** Returns the path to import a given Reason module name. *) -let importPathForReasonModuleName ~(config : Config.t) ~outputFileRelative - ~resolver moduleName = - if !Debug.moduleResolution then - Log_.item "Resolve Reason Module: %s\n" (moduleName |> ModuleName.toString); - match config.shimsMap |> ModuleNameMap.find moduleName with - | shimModuleName -> - if !Debug.moduleResolution then - Log_.item "ShimModuleName: %s\n" (shimModuleName |> ModuleName.toString); - let importExtension = ModuleExtension.shimTsOutputFileExtension ~config in - let importPath = - resolveModule ~config ~importExtension ~outputFileRelative ~resolver - ~useBsDependencies:false shimModuleName +let import_path_for_reason_module_name ~(config : Config.t) ~output_file_relative + ~resolver module_name = + if !Debug.module_resolution then + Log_.item "Resolve Reason Module: %s\n" (module_name |> ModuleName.to_string); + match config.shims_map |> ModuleNameMap.find module_name with + | shim_module_name -> + if !Debug.module_resolution then + Log_.item "ShimModuleName: %s\n" (shim_module_name |> ModuleName.to_string); + let import_extension = ModuleExtension.shim_ts_output_file_extension ~config in + let import_path = + resolve_module ~config ~import_extension ~output_file_relative ~resolver + ~use_bs_dependencies:false shim_module_name in - if !Debug.moduleResolution then - Log_.item "Import Path: %s\n" (importPath |> ImportPath.dump); - importPath + if !Debug.module_resolution then + Log_.item "Import Path: %s\n" (import_path |> ImportPath.dump); + import_path | exception Not_found -> - moduleName |> resolveGeneratedModule ~config ~outputFileRelative ~resolver + module_name |> resolve_generated_module ~config ~output_file_relative ~resolver diff --git a/jscomp/gentype/NamedArgs.ml b/jscomp/gentype/NamedArgs.ml index a5c0d0638d..4d34a0fa28 100644 --- a/jscomp/gentype/NamedArgs.ml +++ b/jscomp/gentype/NamedArgs.ml @@ -1,14 +1,14 @@ open GenTypeCommon -let group labeledTypes = +let group labeled_types = let types = - Ext_list.map labeledTypes (fun (lbl, aType) -> + Ext_list.map labeled_types (fun (lbl, a_type) -> match lbl with - | Nolabel -> {aName = ""; aType} - | Label lbl -> {aName = lbl; aType} - | OptLabel lbl -> {aName = lbl; aType = Option aType}) + | Nolabel -> {a_name = ""; a_type} + | Label lbl -> {a_name = lbl; a_type} + | OptLabel lbl -> {a_name = lbl; a_type = Option a_type}) in match types with - | [{aType}] when aType = unitT -> + | [{a_type}] when a_type = unit_t -> [] (* treat a single argument of type unit as no argument *) | _ -> types diff --git a/jscomp/gentype/Paths.ml b/jscomp/gentype/Paths.ml index ed95905268..f7018312f6 100644 --- a/jscomp/gentype/Paths.ml +++ b/jscomp/gentype/Paths.ml @@ -2,73 +2,73 @@ open GenTypeCommon let concat = Filename.concat -let handleNamespace cmt = - let cutAfterDash s = +let handle_namespace cmt = + let cut_after_dash s = match String.index s '-' with | n -> String.sub s 0 n [@doesNotRaise] | exception Not_found -> s in - let noDir = Filename.basename cmt = cmt in - if noDir then cmt |> (Filename.chop_extension [@doesNotRaise]) |> cutAfterDash + let no_dir = Filename.basename cmt = cmt in + if no_dir then cmt |> (Filename.chop_extension [@doesNotRaise]) |> cut_after_dash else let dir = cmt |> Filename.dirname in let base = cmt |> Filename.basename |> (Filename.chop_extension [@doesNotRaise]) - |> cutAfterDash + |> cut_after_dash in Filename.concat dir base -let findNameSpace cmt = - let keepAfterDash s = +let find_name_space cmt = + let keep_after_dash s = match String.index s '-' with | n -> Some ((String.sub s (n + 1) [@doesNotRaise]) (String.length s - n - 1)) | exception Not_found -> None in cmt |> Filename.basename |> (Filename.chop_extension [@doesNotRaise]) - |> keepAfterDash + |> keep_after_dash -let getOutputFileRelative ~config cmt = - (cmt |> handleNamespace) ^ ModuleExtension.tsInputFileSuffix ~config +let get_output_file_relative ~config cmt = + (cmt |> handle_namespace) ^ ModuleExtension.ts_input_file_suffix ~config -let getOutputFile ~(config : Config.t) cmt = - Filename.concat config.projectRoot (getOutputFileRelative ~config cmt) +let get_output_file ~(config : Config.t) cmt = + Filename.concat config.project_root (get_output_file_relative ~config cmt) -let getModuleName cmt = - cmt |> handleNamespace |> Filename.basename |> ModuleName.fromStringUnsafe +let get_module_name cmt = + cmt |> handle_namespace |> Filename.basename |> ModuleName.from_string_unsafe -let getCmtFile cmt = - let pathCmt = Filename.concat (Sys.getcwd ()) cmt in - let cmtFile = - if Filename.check_suffix pathCmt ".cmt" then - let pathCmtLowerCase = - let dirName = pathCmt |> Filename.dirname in - let baseName = pathCmt |> Filename.basename in - Filename.concat dirName (baseName |> String.uncapitalize_ascii) +let get_cmt_file cmt = + let path_cmt = Filename.concat (Sys.getcwd ()) cmt in + let cmt_file = + if Filename.check_suffix path_cmt ".cmt" then + let path_cmt_lower_case = + let dir_name = path_cmt |> Filename.dirname in + let base_name = path_cmt |> Filename.basename in + Filename.concat dir_name (base_name |> String.uncapitalize_ascii) in - let pathCmti = - (Filename.chop_extension pathCmt [@doesNotRaise]) ^ ".cmti" + let path_cmti = + (Filename.chop_extension path_cmt [@doesNotRaise]) ^ ".cmti" in - let pathCmtiLowerCase = - (Filename.chop_extension pathCmtLowerCase [@doesNotRaise]) ^ ".cmti" + let path_cmti_lower_case = + (Filename.chop_extension path_cmt_lower_case [@doesNotRaise]) ^ ".cmti" in - if Sys.file_exists pathCmtiLowerCase then pathCmtiLowerCase - else if Sys.file_exists pathCmti then pathCmti - else if Sys.file_exists pathCmtLowerCase then pathCmtLowerCase - else if Sys.file_exists pathCmt then pathCmt + if Sys.file_exists path_cmti_lower_case then path_cmti_lower_case + else if Sys.file_exists path_cmti then path_cmti + else if Sys.file_exists path_cmt_lower_case then path_cmt_lower_case + else if Sys.file_exists path_cmt then path_cmt else "" else "" in - cmtFile + cmt_file -let getConfigFile ~projectRoot = - let config = concat projectRoot Config.compilerConfigFile in +let get_config_file ~project_root = + let config = concat project_root Config.compiler_config_file in match config |> Sys.file_exists with | true -> Some config | false -> ( - let config = concat projectRoot Config.legacyCompilerConfigFile in + let config = concat project_root Config.legacy_compiler_config_file in match config |> Sys.file_exists with | true -> Some config | false -> None) -let readConfig ~namespace = Config.readConfig ~getConfigFile ~namespace +let read_config ~namespace = Config.read_config ~get_config_file ~namespace diff --git a/jscomp/gentype/ResolvedName.ml b/jscomp/gentype/ResolvedName.ml index 0c41d23290..cf56010e44 100644 --- a/jscomp/gentype/ResolvedName.ml +++ b/jscomp/gentype/ResolvedName.ml @@ -1,9 +1,9 @@ type t = string list let dot s x = x @ [s] -let fromString x = [x] -let toList x = x -let toString x = x |> String.concat "_" +let from_string x = [x] +let to_list x = x +let to_string x = x |> String.concat "_" type eq = t * t @@ -22,37 +22,37 @@ module NameSet = Set.Make (struct | false -> compare rest1 rest2) end) -let rec applyEquation ~(el : t) (eq : eq) : t list = +let rec apply_equation ~(el : t) (eq : eq) : t list = match (eq, el) with | ([], rhs), _ -> [rhs @ el] | (s1 :: rest1, rhs), s2 :: rest2 -> ( match s1 = s2 with - | true -> (rest1, rhs) |> applyEquation ~el:rest2 + | true -> (rest1, rhs) |> apply_equation ~el:rest2 | false -> []) | (_ :: _, _), [] -> [] -let rec applyEquationsToElements ~(eqs : eq list) ~seen (elements : t list) : +let rec apply_equations_to_elements ~(eqs : eq list) ~seen (elements : t list) : eq list = - let applyEqs el = - let freshElements = + let apply_eqs el = + let fresh_elements = eqs - |> List.map (applyEquation ~el) + |> List.map (apply_equation ~el) |> List.concat |> List.filter (fun y -> not (NameSet.mem y seen)) in - freshElements |> List.map (fun elFresh -> (elFresh, el)) + fresh_elements |> List.map (fun el_fresh -> (el_fresh, el)) in - let newEquations = elements |> List.map applyEqs |> List.concat in - let newElements = newEquations |> List.map fst in - let newSeen = NameSet.union seen (newElements |> NameSet.of_list) in - match newEquations = [] with - | true -> newEquations + let new_equations = elements |> List.map apply_eqs |> List.concat in + let new_elements = new_equations |> List.map fst in + let new_seen = NameSet.union seen (new_elements |> NameSet.of_list) in + match new_equations = [] with + | true -> new_equations | false -> - newEquations @ (newElements |> applyEquationsToElements ~eqs ~seen:newSeen) + new_equations @ (new_elements |> apply_equations_to_elements ~eqs ~seen:new_seen) (* Apply equations of the form e.g. X.Y = A from the alias: module A = X.Y. Return a list of equations on types. E.g. if the element is X.Y.t, return equation A.t = X.Y.t *) -let applyEquations ~(eqs : eq list) (el : t) : eq list = - [el] |> applyEquationsToElements ~eqs ~seen:NameSet.empty +let apply_equations ~(eqs : eq list) (el : t) : eq list = + [el] |> apply_equations_to_elements ~eqs ~seen:NameSet.empty diff --git a/jscomp/gentype/ResolvedName.mli b/jscomp/gentype/ResolvedName.mli index 00a78049ac..a6dea26ef1 100644 --- a/jscomp/gentype/ResolvedName.mli +++ b/jscomp/gentype/ResolvedName.mli @@ -1,8 +1,8 @@ type t type eq = t * t -val applyEquations : eqs:eq list -> t -> eq list +val apply_equations : eqs:eq list -> t -> eq list val dot : string -> t -> t -val fromString : string -> t -val toList : t -> string list -val toString : t -> string +val from_string : string -> t +val to_list : t -> string list +val to_string : t -> string diff --git a/jscomp/gentype/Runtime.ml b/jscomp/gentype/Runtime.ml index 2af7f2bff9..7fb3279290 100644 --- a/jscomp/gentype/Runtime.ml +++ b/jscomp/gentype/Runtime.ml @@ -1,15 +1,15 @@ -type moduleItem = string -type moduleAccessPath = Root of string | Dot of moduleAccessPath * moduleItem +type module_item = string +type module_access_path = Root of string | Dot of module_access_path * module_item -let newModuleItem ~name = name +let new_module_item ~name = name -let rec emitModuleAccessPath ~config moduleAccessPath = - match moduleAccessPath with +let rec emit_module_access_path ~config module_access_path = + match module_access_path with | Root s -> s - | Dot (p, moduleItem) -> - p |> emitModuleAccessPath ~config |> EmitText.fieldAccess ~label:moduleItem + | Dot (p, module_item) -> + p |> emit_module_access_path ~config |> EmitText.field_access ~label:module_item -let jsVariantTag ~polymorphic ~tag = +let js_variant_tag ~polymorphic ~tag = match polymorphic with | true -> "NAME" | false -> ( @@ -17,20 +17,20 @@ let jsVariantTag ~polymorphic ~tag = | Some tag -> tag | None -> "TAG") -let jsVariantPayloadTag ~n = "_" ^ string_of_int n +let js_variant_payload_tag ~n = "_" ^ string_of_int n -let jsVariantValue ~polymorphic = +let js_variant_value ~polymorphic = match polymorphic with | true -> "VAL" | false -> "value" -let isMutableObjectField name = +let is_mutable_object_field name = String.length name >= 2 && (String.sub name (String.length name - 2) 2 [@doesNotRaise]) = "#=" (** Mutable fields, i.e. fields annotated "[@set]" are represented as extra fields called "fieldName#=" preceding the normal field. *) -let checkMutableObjectField ~previousName ~name = previousName = name ^ "#=" +let check_mutable_object_field ~previous_name ~name = previous_name = name ^ "#=" let default = "$$default" diff --git a/jscomp/gentype/Runtime.mli b/jscomp/gentype/Runtime.mli index a7d16b4e87..c462e9b7c9 100644 --- a/jscomp/gentype/Runtime.mli +++ b/jscomp/gentype/Runtime.mli @@ -1,14 +1,14 @@ open GenTypeCommon -type moduleItem -type moduleAccessPath = Root of string | Dot of moduleAccessPath * moduleItem +type module_item +type module_access_path = Root of string | Dot of module_access_path * module_item -val checkMutableObjectField : previousName:string -> name:string -> bool +val check_mutable_object_field : previous_name:string -> name:string -> bool val default : string -val emitModuleAccessPath : config:Config.t -> moduleAccessPath -> string +val emit_module_access_path : config:Config.t -> module_access_path -> string -val isMutableObjectField : string -> bool -val newModuleItem : name:string -> moduleItem -val jsVariantTag : polymorphic:bool -> tag:string option -> string -val jsVariantPayloadTag : n:int -> string -val jsVariantValue : polymorphic:bool -> string +val is_mutable_object_field : string -> bool +val new_module_item : name:string -> module_item +val js_variant_tag : polymorphic:bool -> tag:string option -> string +val js_variant_payload_tag : n:int -> string +val js_variant_value : polymorphic:bool -> string diff --git a/jscomp/gentype/TranslateCoreType.ml b/jscomp/gentype/TranslateCoreType.ml index 0325f04f05..3ca4c33e8e 100644 --- a/jscomp/gentype/TranslateCoreType.ml +++ b/jscomp/gentype/TranslateCoreType.ml @@ -1,277 +1,277 @@ open GenTypeCommon open! TranslateTypeExprFromTypes -let removeOption ~(label : Asttypes.arg_label) (coreType : Typedtree.core_type) +let remove_option ~(label : Asttypes.arg_label) (core_type : Typedtree.core_type) = - match (coreType.ctyp_desc, label) with + match (core_type.ctyp_desc, label) with | Ttyp_constr (Path.Pident id, _, [t]), Optional lbl when Ident.name id = "option" -> Some (lbl, t) - | Ttyp_constr (Pdot (Path.Pident nameSpace, id, _), _, [t]), Optional lbl + | Ttyp_constr (Pdot (Path.Pident name_space, id, _), _, [t]), Optional lbl when (* This has a different representation in 4.03+ *) - Ident.name nameSpace = "FB" && id = "option" -> + Ident.name name_space = "FB" && id = "option" -> Some (lbl, t) | _ -> None -type processVariant = { - noPayloads: (string * Typedtree.attributes) list; +type process_variant = { + no_payloads: (string * Typedtree.attributes) list; payloads: (string * Typedtree.attributes * Typedtree.core_type) list; inherits: Typedtree.core_type list; } -let processVariant rowFields = - let rec loop ~noPayloads ~payloads ~inherits fields = +let process_variant row_fields = + let rec loop ~no_payloads ~payloads ~inherits fields = match fields with | Typedtree.Ttag ({txt = label}, attributes, _, (* only variants with no payload *) []) - :: otherFields -> - otherFields + :: other_fields -> + other_fields |> loop - ~noPayloads:((label, attributes) :: noPayloads) + ~no_payloads:((label, attributes) :: no_payloads) ~payloads ~inherits - | Ttag ({txt = label}, attributes, _, [payload]) :: otherFields -> - otherFields - |> loop ~noPayloads + | Ttag ({txt = label}, attributes, _, [payload]) :: other_fields -> + other_fields + |> loop ~no_payloads ~payloads:((label, attributes, payload) :: payloads) ~inherits - | Ttag (_, _, _, _ :: _ :: _) :: otherFields -> + | Ttag (_, _, _, _ :: _ :: _) :: other_fields -> (* Unknown: skipping *) - otherFields |> loop ~noPayloads ~payloads ~inherits - | Tinherit t :: otherFields -> - otherFields |> loop ~noPayloads ~payloads ~inherits:(t :: inherits) + other_fields |> loop ~no_payloads ~payloads ~inherits + | Tinherit t :: other_fields -> + other_fields |> loop ~no_payloads ~payloads ~inherits:(t :: inherits) | [] -> { - noPayloads = noPayloads |> List.rev; + no_payloads = no_payloads |> List.rev; payloads = payloads |> List.rev; inherits = inherits |> List.rev; } in - rowFields |> loop ~noPayloads:[] ~payloads:[] ~inherits:[] + row_fields |> loop ~no_payloads:[] ~payloads:[] ~inherits:[] -let rec translateArrowType ~config ~typeVarsGen ~noFunctionReturnDependencies - ~typeEnv ~revArgDeps ~revArgs (coreType : Typedtree.core_type) = - match coreType.ctyp_desc with - | Ttyp_arrow (Nolabel, coreType1, coreType2) -> +let rec translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependencies + ~type_env ~rev_arg_deps ~rev_args (core_type : Typedtree.core_type) = + match core_type.ctyp_desc with + | Ttyp_arrow (Nolabel, core_type1, core_type2) -> let {dependencies; type_} = - coreType1 |> fun __x -> - translateCoreType_ ~config ~typeVarsGen ~typeEnv __x + core_type1 |> fun __x -> + translateCoreType_ ~config ~type_vars_gen ~type_env __x in - let nextRevDeps = List.rev_append dependencies revArgDeps in - coreType2 - |> translateArrowType ~config ~typeVarsGen ~noFunctionReturnDependencies - ~typeEnv ~revArgDeps:nextRevDeps - ~revArgs:((Nolabel, type_) :: revArgs) - | Ttyp_arrow (((Labelled lbl | Optional lbl) as label), coreType1, coreType2) + let next_rev_deps = List.rev_append dependencies rev_arg_deps in + core_type2 + |> translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependencies + ~type_env ~rev_arg_deps:next_rev_deps + ~rev_args:((Nolabel, type_) :: rev_args) + | Ttyp_arrow (((Labelled lbl | Optional lbl) as label), core_type1, core_type2) -> ( - let asLabel = - match coreType.ctyp_attributes |> Annotation.getGenTypeAsRenaming with + let as_label = + match core_type.ctyp_attributes |> Annotation.get_gen_type_as_renaming with | Some s -> s | None -> "" in - match coreType1 |> removeOption ~label with + match core_type1 |> remove_option ~label with | None -> let {dependencies; type_ = type1} = - coreType1 |> translateCoreType_ ~config ~typeVarsGen ~typeEnv + core_type1 |> translateCoreType_ ~config ~type_vars_gen ~type_env in - let nextRevDeps = List.rev_append dependencies revArgDeps in - coreType2 - |> translateArrowType ~config ~typeVarsGen ~noFunctionReturnDependencies - ~typeEnv ~revArgDeps:nextRevDeps - ~revArgs: + let next_rev_deps = List.rev_append dependencies rev_arg_deps in + core_type2 + |> translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependencies + ~type_env ~rev_arg_deps:next_rev_deps + ~rev_args: (( Label - (match asLabel = "" with + (match as_label = "" with | true -> lbl - | false -> asLabel), + | false -> as_label), type1 ) - :: revArgs) + :: rev_args) | Some (lbl, t1) -> let {dependencies; type_ = type1} = - t1 |> translateCoreType_ ~config ~typeVarsGen ~typeEnv + t1 |> translateCoreType_ ~config ~type_vars_gen ~type_env in - let nextRevDeps = List.rev_append dependencies revArgDeps in - coreType2 - |> translateArrowType ~config ~typeVarsGen ~noFunctionReturnDependencies - ~typeEnv ~revArgDeps:nextRevDeps - ~revArgs:((OptLabel lbl, type1) :: revArgs)) + let next_rev_deps = List.rev_append dependencies rev_arg_deps in + core_type2 + |> translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependencies + ~type_env ~rev_arg_deps:next_rev_deps + ~rev_args:((OptLabel lbl, type1) :: rev_args)) | _ -> - let {dependencies; type_ = retType} = - coreType |> translateCoreType_ ~config ~typeVarsGen ~typeEnv + let {dependencies; type_ = ret_type} = + core_type |> translateCoreType_ ~config ~type_vars_gen ~type_env in - let allDeps = - List.rev_append revArgDeps - (match noFunctionReturnDependencies with + let all_deps = + List.rev_append rev_arg_deps + (match no_function_return_dependencies with | true -> [] | false -> dependencies) in - let labeledConvertableTypes = revArgs |> List.rev in - let argTypes = labeledConvertableTypes |> NamedArgs.group in - let functionType = Function {argTypes; retType; typeVars = []} in - {dependencies = allDeps; type_ = functionType} + let labeled_convertable_types = rev_args |> List.rev in + let arg_types = labeled_convertable_types |> NamedArgs.group in + let function_type = Function {arg_types; ret_type; type_vars = []} in + {dependencies = all_deps; type_ = function_type} -and translateCoreType_ ~config ~typeVarsGen - ?(noFunctionReturnDependencies = false) ~typeEnv - (coreType : Typedtree.core_type) = - match coreType.ctyp_desc with +and translateCoreType_ ~config ~type_vars_gen + ?(no_function_return_dependencies = false) ~type_env + (core_type : Typedtree.core_type) = + match core_type.ctyp_desc with | Ttyp_alias (ct, _) -> ct - |> translateCoreType_ ~config ~typeVarsGen - ~noFunctionReturnDependencies:false ~typeEnv - | Ttyp_object (tObj, closedFlag) -> - let getFieldType objectField = - match objectField with + |> translateCoreType_ ~config ~type_vars_gen + ~no_function_return_dependencies:false ~type_env + | Ttyp_object (t_obj, closed_flag) -> + let get_field_type object_field = + match object_field with | Typedtree.OTtag ({txt = name}, _, t) -> ( name, - match name |> Runtime.isMutableObjectField with + match name |> Runtime.is_mutable_object_field with | true -> {dependencies = []; type_ = ident ""} - | false -> t |> translateCoreType_ ~config ~typeVarsGen ~typeEnv ) + | false -> t |> translateCoreType_ ~config ~type_vars_gen ~type_env ) | OTinherit t -> - ("Inherit", t |> translateCoreType_ ~config ~typeVarsGen ~typeEnv) + ("Inherit", t |> translateCoreType_ ~config ~type_vars_gen ~type_env) in - let fieldsTranslations = tObj |> List.map getFieldType in - translateObjType - (match closedFlag = Closed with + let fields_translations = t_obj |> List.map get_field_type in + translate_obj_type + (match closed_flag = Closed with | true -> Closed | false -> Open) - fieldsTranslations - | Ttyp_constr (path, _, typeParams) -> - let paramsTranslation = - typeParams |> translateCoreTypes_ ~config ~typeVarsGen ~typeEnv + fields_translations + | Ttyp_constr (path, _, type_params) -> + let params_translation = + type_params |> translateCoreTypes_ ~config ~type_vars_gen ~type_env in - TranslateTypeExprFromTypes.translateConstr ~config ~paramsTranslation ~path - ~typeEnv + TranslateTypeExprFromTypes.translate_constr ~config ~params_translation ~path + ~type_env | Ttyp_poly (_, t) -> t - |> translateCoreType_ ~config ~typeVarsGen ~noFunctionReturnDependencies - ~typeEnv + |> translateCoreType_ ~config ~type_vars_gen ~no_function_return_dependencies + ~type_env | Ttyp_arrow _ -> - coreType - |> translateArrowType ~config ~typeVarsGen ~noFunctionReturnDependencies - ~typeEnv ~revArgDeps:[] ~revArgs:[] - | Ttyp_tuple listExp -> - let innerTypesTranslation = - listExp |> translateCoreTypes_ ~config ~typeVarsGen ~typeEnv + core_type + |> translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependencies + ~type_env ~rev_arg_deps:[] ~rev_args:[] + | Ttyp_tuple list_exp -> + let inner_types_translation = + list_exp |> translateCoreTypes_ ~config ~type_vars_gen ~type_env in - let innerTypes = innerTypesTranslation |> List.map (fun {type_} -> type_) in - let innerTypesDeps = - innerTypesTranslation + let inner_types = inner_types_translation |> List.map (fun {type_} -> type_) in + let inner_types_deps = + inner_types_translation |> List.map (fun {dependencies} -> dependencies) |> List.concat in - let tupleType = Tuple innerTypes in - {dependencies = innerTypesDeps; type_ = tupleType} + let tuple_type = Tuple inner_types in + {dependencies = inner_types_deps; type_ = tuple_type} | Ttyp_var s -> {dependencies = []; type_ = TypeVar s} - | Ttyp_variant (rowFields, _, _) -> ( - match rowFields |> processVariant with - | {noPayloads; payloads; inherits} -> - let asString = - coreType.ctyp_attributes - |> Annotation.hasAttribute Annotation.tagIsString + | Ttyp_variant (row_fields, _, _) -> ( + match row_fields |> process_variant with + | {no_payloads; payloads; inherits} -> + let as_string = + core_type.ctyp_attributes + |> Annotation.has_attribute Annotation.tag_is_string in - let asInt = - coreType.ctyp_attributes |> Annotation.hasAttribute Annotation.tagIsInt + let as_int = + core_type.ctyp_attributes |> Annotation.has_attribute Annotation.tag_is_int in - let lastBsInt = ref (-1) in - let noPayloads = - noPayloads + let last_bs_int = ref (-1) in + let no_payloads = + no_payloads |> List.map (fun (label, attributes) -> - let labelJS = - if asString then - match attributes |> Annotation.getAsString with - | Some labelRenamed -> StringLabel labelRenamed + let label_j_s = + if as_string then + match attributes |> Annotation.get_as_string with + | Some label_renamed -> StringLabel label_renamed | None -> - if isNumber label then IntLabel label + if is_number label then IntLabel label else StringLabel label - else if asInt then ( - match attributes |> Annotation.getAsInt with + else if as_int then ( + match attributes |> Annotation.get_as_int with | Some n -> - lastBsInt := n; + last_bs_int := n; IntLabel (string_of_int n) | None -> - lastBsInt := !lastBsInt + 1; - IntLabel (string_of_int !lastBsInt)) - else if isNumber label then IntLabel label + last_bs_int := !last_bs_int + 1; + IntLabel (string_of_int !last_bs_int)) + else if is_number label then IntLabel label else StringLabel label in - {labelJS}) + {label_j_s}) in - let payloadsTranslations = + let payloads_translations = payloads |> List.map (fun (label, attributes, payload) -> ( label, attributes, - payload |> translateCoreType_ ~config ~typeVarsGen ~typeEnv )) + payload |> translateCoreType_ ~config ~type_vars_gen ~type_env )) in let payloads = - payloadsTranslations + payloads_translations |> List.map (fun (label, _attributes, translation) -> { case = { - labelJS = - (if isNumber label then IntLabel label + label_j_s = + (if is_number label then IntLabel label else StringLabel label); }; t = translation.type_; }) in - let inheritsTranslations = - inherits |> translateCoreTypes_ ~config ~typeVarsGen ~typeEnv + let inherits_translations = + inherits |> translateCoreTypes_ ~config ~type_vars_gen ~type_env in - let inherits = inheritsTranslations |> List.map (fun {type_} -> type_) in + let inherits = inherits_translations |> List.map (fun {type_} -> type_) in let type_ = - createVariant ~noPayloads ~payloads ~inherits ~polymorphic:true + create_variant ~no_payloads ~payloads ~inherits ~polymorphic:true ~tag:None ~unboxed:false in let dependencies = - (inheritsTranslations + (inherits_translations |> List.map (fun {dependencies} -> dependencies) |> List.concat) - @ (payloadsTranslations + @ (payloads_translations |> List.map (fun (_, _, {dependencies}) -> dependencies) |> List.concat) in {dependencies; type_}) | Ttyp_package {pack_path; pack_fields} -> ( - match typeEnv |> TypeEnv.lookupModuleTypeSignature ~path:pack_path with - | Some (signature, typeEnv) -> - let typeEquationsTranslation = + match type_env |> TypeEnv.lookup_module_type_signature ~path:pack_path with + | Some (signature, type_env) -> + let type_equations_translation = pack_fields |> List.map (fun (x, t) -> ( x.Asttypes.txt, - t |> translateCoreType_ ~config ~typeVarsGen ~typeEnv )) + t |> translateCoreType_ ~config ~type_vars_gen ~type_env )) in - let typeEquations = - typeEquationsTranslation + let type_equations = + type_equations_translation |> List.map (fun (x, translation) -> (x, translation.type_)) in - let dependenciesFromTypeEquations = - typeEquationsTranslation + let dependencies_from_type_equations = + type_equations_translation |> List.map (fun (_, translation) -> translation.dependencies) |> List.flatten in - let typeEnv1 = typeEnv |> TypeEnv.addTypeEquations ~typeEquations in - let dependenciesFromRecordType, type_ = + let type_env1 = type_env |> TypeEnv.add_type_equations ~type_equations in + let dependencies_from_record_type, type_ = signature.sig_type - |> signatureToModuleRuntimeRepresentation ~config ~typeVarsGen - ~typeEnv:typeEnv1 + |> signature_to_module_runtime_representation ~config ~type_vars_gen + ~type_env:type_env1 in { - dependencies = dependenciesFromTypeEquations @ dependenciesFromRecordType; + dependencies = dependencies_from_type_equations @ dependencies_from_record_type; type_; } | None -> {dependencies = []; type_ = unknown}) | Ttyp_any | Ttyp_class _ -> {dependencies = []; type_ = unknown} -and translateCoreTypes_ ~config ~typeVarsGen ~typeEnv typeExprs : +and translateCoreTypes_ ~config ~type_vars_gen ~type_env type_exprs : translation list = - typeExprs |> List.map (translateCoreType_ ~config ~typeVarsGen ~typeEnv) + type_exprs |> List.map (translateCoreType_ ~config ~type_vars_gen ~type_env) -let translateCoreType ~config ~typeEnv coreType = - let typeVarsGen = GenIdent.createTypeVarsGen () in +let translate_core_type ~config ~type_env core_type = + let type_vars_gen = GenIdent.create_type_vars_gen () in let translation = - coreType |> translateCoreType_ ~config ~typeVarsGen ~typeEnv + core_type |> translateCoreType_ ~config ~type_vars_gen ~type_env in if !Debug.dependencies then translation.dependencies - |> List.iter (fun dep -> Log_.item "Dependency: %s\n" (dep |> depToString)); + |> List.iter (fun dep -> Log_.item "Dependency: %s\n" (dep |> dep_to_string)); translation diff --git a/jscomp/gentype/TranslateSignature.ml b/jscomp/gentype/TranslateSignature.ml index a38890a36c..86bc80933f 100644 --- a/jscomp/gentype/TranslateSignature.ml +++ b/jscomp/gentype/TranslateSignature.ml @@ -1,61 +1,61 @@ open GenTypeCommon -let translateSignatureValue ~config ~outputFileRelative ~resolver ~typeEnv - (valueDescription : Typedtree.value_description) : Translation.t = +let translate_signature_value ~config ~output_file_relative ~resolver ~type_env + (value_description : Typedtree.value_description) : Translation.t = let {Typedtree.val_attributes; val_desc; val_id; val_loc} = - valueDescription + value_description in if !Debug.translation then Log_.item "Translate Signature Value %s\n" (val_id |> Ident.name); - let typeExpr = val_desc.ctyp_type in - let addAnnotationsToFunction type_ = type_ in + let type_expr = val_desc.ctyp_type in + let add_annotations_to_function type_ = type_ in match - (val_id, val_attributes |> Annotation.fromAttributes ~config ~loc:val_loc) + (val_id, val_attributes |> Annotation.from_attributes ~config ~loc:val_loc) with | id, GenType -> id |> Ident.name - |> Translation.translateValue ~attributes:val_attributes ~config - ~docString:(Annotation.docStringFromAttrs val_attributes) - ~outputFileRelative ~resolver ~typeEnv ~typeExpr - ~addAnnotationsToFunction + |> Translation.translate_value ~attributes:val_attributes ~config + ~doc_string:(Annotation.doc_string_from_attrs val_attributes) + ~output_file_relative ~resolver ~type_env ~type_expr + ~add_annotations_to_function | _ -> Translation.empty -let rec translateModuleDeclaration ~config ~outputFileRelative ~resolver - ~typeEnv ({md_id; md_type} : Typedtree.module_declaration) = +let rec translate_module_declaration ~config ~output_file_relative ~resolver + ~type_env ({md_id; md_type} : Typedtree.module_declaration) = let name = md_id |> Ident.name in if !Debug.translation then Log_.item "Translate Module Declaration %s\n" name; - let typeEnv = typeEnv |> TypeEnv.newModule ~name in + let type_env = type_env |> TypeEnv.new_module ~name in match md_type.mty_desc with | Tmty_signature signature -> signature - |> translateSignature ~config ~outputFileRelative ~resolver ~typeEnv + |> translate_signature ~config ~output_file_relative ~resolver ~type_env |> Translation.combine | Tmty_ident (path, _) -> ( - match typeEnv |> TypeEnv.lookupModuleTypeSignature ~path with + match type_env |> TypeEnv.lookup_module_type_signature ~path with | None -> Translation.empty | Some (signature, _) -> signature - |> translateSignature ~config ~outputFileRelative ~resolver ~typeEnv + |> translate_signature ~config ~output_file_relative ~resolver ~type_env |> Translation.combine) | Tmty_functor _ -> - logNotImplemented ("Tmty_functor " ^ __LOC__); + log_not_implemented ("Tmty_functor " ^ __LOC__); Translation.empty | Tmty_with _ -> - logNotImplemented ("Tmty_with " ^ __LOC__); + log_not_implemented ("Tmty_with " ^ __LOC__); Translation.empty | Tmty_typeof _ -> - logNotImplemented ("Tmty_typeof " ^ __LOC__); + log_not_implemented ("Tmty_typeof " ^ __LOC__); Translation.empty | Tmty_alias _ -> - logNotImplemented ("Tmty_alias " ^ __LOC__); + log_not_implemented ("Tmty_alias " ^ __LOC__); Translation.empty -and translateModuleTypeDeclaration ~config ~outputFileRelative ~resolver - ~typeEnv (moduleTypeDeclaration : Typedtree.module_type_declaration) = +and translate_module_type_declaration ~config ~output_file_relative ~resolver + ~type_env (module_type_declaration : Typedtree.module_type_declaration) = if !Debug.translation then Log_.item "Translate Module Type Declaration %s\n" - (moduleTypeDeclaration.mtd_id |> Ident.name); - match moduleTypeDeclaration with + (module_type_declaration.mtd_id |> Ident.name); + match module_type_declaration with | {mtd_type = None} -> Translation.empty | {mtd_id; mtd_type = Some mtd_type} -> ( match mtd_type.mty_desc with @@ -73,99 +73,99 @@ and translateModuleTypeDeclaration ~config ~outputFileRelative ~resolver in let translation = signature_without_values - |> translateSignature ~config ~outputFileRelative ~resolver - ~typeEnv:(typeEnv |> TypeEnv.newModuleType ~name ~signature) + |> translate_signature ~config ~output_file_relative ~resolver + ~type_env:(type_env |> TypeEnv.new_module_type ~name ~signature) |> Translation.combine in translation | Tmty_ident _ -> - logNotImplemented ("Tmty_ident " ^ __LOC__); + log_not_implemented ("Tmty_ident " ^ __LOC__); Translation.empty | Tmty_functor _ -> - logNotImplemented ("Tmty_functor " ^ __LOC__); + log_not_implemented ("Tmty_functor " ^ __LOC__); Translation.empty | Tmty_with _ -> - logNotImplemented ("Tmty_with " ^ __LOC__); + log_not_implemented ("Tmty_with " ^ __LOC__); Translation.empty | Tmty_typeof _ -> - logNotImplemented ("Tmty_typeof " ^ __LOC__); + log_not_implemented ("Tmty_typeof " ^ __LOC__); Translation.empty | Tmty_alias _ -> - logNotImplemented ("Tmty_alias " ^ __LOC__); + log_not_implemented ("Tmty_alias " ^ __LOC__); Translation.empty) -and translateSignatureItem ~config ~outputFileRelative ~resolver ~typeEnv - signatureItem : Translation.t = - match signatureItem with - | {Typedtree.sig_desc = Typedtree.Tsig_type (recFlag, typeDeclarations)} -> +and translate_signature_item ~config ~output_file_relative ~resolver ~type_env + signature_item : Translation.t = + match signature_item with + | {Typedtree.sig_desc = Typedtree.Tsig_type (rec_flag, type_declarations)} -> { - importTypes = []; - codeItems = []; - typeDeclarations = - typeDeclarations - |> TranslateTypeDeclarations.translateTypeDeclarations ~config - ~outputFileRelative ~recursive:(recFlag = Recursive) ~resolver - ~typeEnv; + import_types = []; + code_items = []; + type_declarations = + type_declarations + |> TranslateTypeDeclarations.translate_type_declarations ~config + ~output_file_relative ~recursive:(rec_flag = Recursive) ~resolver + ~type_env; } - | {Typedtree.sig_desc = Tsig_value valueDescription} -> - let isImport = - valueDescription.val_attributes - |> Annotation.hasAttribute Annotation.tagIsGenTypeImport + | {Typedtree.sig_desc = Tsig_value value_description} -> + let is_import = + value_description.val_attributes + |> Annotation.has_attribute Annotation.tag_is_gen_type_import in - if valueDescription.val_prim <> [] || isImport then - valueDescription - |> Translation.translatePrimitive ~config ~outputFileRelative ~resolver - ~typeEnv + if value_description.val_prim <> [] || is_import then + value_description + |> Translation.translate_primitive ~config ~output_file_relative ~resolver + ~type_env else - let moduleItem = - Runtime.newModuleItem ~name:(valueDescription.val_id |> Ident.name) + let module_item = + Runtime.new_module_item ~name:(value_description.val_id |> Ident.name) in - typeEnv |> TypeEnv.updateModuleItem ~moduleItem; - valueDescription - |> translateSignatureValue ~config ~outputFileRelative ~resolver ~typeEnv - | {Typedtree.sig_desc = Typedtree.Tsig_module moduleDeclaration} -> - moduleDeclaration - |> translateModuleDeclaration ~config ~outputFileRelative ~resolver ~typeEnv - | {Typedtree.sig_desc = Typedtree.Tsig_modtype moduleTypeDeclaration} -> - let moduleItem = - Runtime.newModuleItem ~name:(moduleTypeDeclaration.mtd_id |> Ident.name) + type_env |> TypeEnv.update_module_item ~module_item; + value_description + |> translate_signature_value ~config ~output_file_relative ~resolver ~type_env + | {Typedtree.sig_desc = Typedtree.Tsig_module module_declaration} -> + module_declaration + |> translate_module_declaration ~config ~output_file_relative ~resolver ~type_env + | {Typedtree.sig_desc = Typedtree.Tsig_modtype module_type_declaration} -> + let module_item = + Runtime.new_module_item ~name:(module_type_declaration.mtd_id |> Ident.name) in let config = - moduleTypeDeclaration.mtd_attributes - |> Annotation.updateConfigForModule ~config + module_type_declaration.mtd_attributes + |> Annotation.update_config_for_module ~config in - typeEnv |> TypeEnv.updateModuleItem ~moduleItem; - moduleTypeDeclaration - |> translateModuleTypeDeclaration ~config ~outputFileRelative ~resolver - ~typeEnv + type_env |> TypeEnv.update_module_item ~module_item; + module_type_declaration + |> translate_module_type_declaration ~config ~output_file_relative ~resolver + ~type_env | {Typedtree.sig_desc = Typedtree.Tsig_typext _} -> - logNotImplemented ("Tsig_typext " ^ __LOC__); + log_not_implemented ("Tsig_typext " ^ __LOC__); Translation.empty | {Typedtree.sig_desc = Typedtree.Tsig_exception _} -> - logNotImplemented ("Tsig_exception " ^ __LOC__); + log_not_implemented ("Tsig_exception " ^ __LOC__); Translation.empty | {Typedtree.sig_desc = Typedtree.Tsig_recmodule _} -> - logNotImplemented ("Tsig_recmodule " ^ __LOC__); + log_not_implemented ("Tsig_recmodule " ^ __LOC__); Translation.empty | {Typedtree.sig_desc = Typedtree.Tsig_open _} -> - logNotImplemented ("Tsig_open " ^ __LOC__); + log_not_implemented ("Tsig_open " ^ __LOC__); Translation.empty | {Typedtree.sig_desc = Typedtree.Tsig_include _} -> - logNotImplemented ("Tsig_include " ^ __LOC__); + log_not_implemented ("Tsig_include " ^ __LOC__); Translation.empty | {Typedtree.sig_desc = Typedtree.Tsig_class _} -> - logNotImplemented ("Tsig_class " ^ __LOC__); + log_not_implemented ("Tsig_class " ^ __LOC__); Translation.empty | {Typedtree.sig_desc = Typedtree.Tsig_class_type _} -> - logNotImplemented ("Tsig_class_type " ^ __LOC__); + log_not_implemented ("Tsig_class_type " ^ __LOC__); Translation.empty | {Typedtree.sig_desc = Typedtree.Tsig_attribute _} -> - logNotImplemented ("Tsig_attribute " ^ __LOC__); + log_not_implemented ("Tsig_attribute " ^ __LOC__); Translation.empty -and translateSignature ~config ~outputFileRelative ~resolver ~typeEnv signature +and translate_signature ~config ~output_file_relative ~resolver ~type_env signature : Translation.t list = if !Debug.translation then Log_.item "Translate Signature\n"; signature.Typedtree.sig_items |> List.map - (translateSignatureItem ~config ~outputFileRelative ~resolver ~typeEnv) + (translate_signature_item ~config ~output_file_relative ~resolver ~type_env) diff --git a/jscomp/gentype/TranslateSignatureFromTypes.ml b/jscomp/gentype/TranslateSignatureFromTypes.ml index 27c9d63def..f07de09649 100644 --- a/jscomp/gentype/TranslateSignatureFromTypes.ml +++ b/jscomp/gentype/TranslateSignatureFromTypes.ml @@ -1,109 +1,109 @@ open GenTypeCommon (** Like translateTypeDeclaration but from Types not Typedtree *) -let translateTypeDeclarationFromTypes ~config ~outputFileRelative ~resolver - ~typeEnv ~id +let translate_type_declaration_from_types ~config ~output_file_relative ~resolver + ~type_env ~id ({type_attributes; type_kind; type_loc; type_manifest; type_params} : - Types.type_declaration) : CodeItem.typeDeclaration list = - typeEnv |> TypeEnv.newType ~name:(id |> Ident.name); - let typeName = Ident.name id in - let typeVars = type_params |> TypeVars.extractFromTypeExpr in + Types.type_declaration) : CodeItem.type_declaration list = + type_env |> TypeEnv.new_type ~name:(id |> Ident.name); + let type_name = Ident.name id in + let type_vars = type_params |> TypeVars.extract_from_type_expr in if !Debug.translation then - Log_.item "Translate Types.type_declaration %s\n" typeName; - let declarationKind = + Log_.item "Translate Types.type_declaration %s\n" type_name; + let declaration_kind = match type_kind with - | Type_record (labelDeclarations, recordRepresentation) -> + | Type_record (label_declarations, record_representation) -> TranslateTypeDeclarations.RecordDeclarationFromTypes - (labelDeclarations, recordRepresentation) - | Type_variant constructorDeclarations + (label_declarations, record_representation) + | Type_variant constructor_declarations when not - (TranslateTypeDeclarations.hasSomeGADTLeaf constructorDeclarations) + (TranslateTypeDeclarations.has_some_g_a_d_t_leaf constructor_declarations) -> - VariantDeclarationFromTypes constructorDeclarations + VariantDeclarationFromTypes constructor_declarations | Type_abstract -> GeneralDeclarationFromTypes type_manifest | _ -> NoDeclaration in - declarationKind - |> TranslateTypeDeclarations.traslateDeclarationKind ~config ~loc:type_loc - ~outputFileRelative ~resolver ~typeAttributes:type_attributes ~typeEnv - ~typeName ~typeVars + declaration_kind + |> TranslateTypeDeclarations.traslate_declaration_kind ~config ~loc:type_loc + ~output_file_relative ~resolver ~type_attributes:type_attributes ~type_env + ~type_name ~type_vars (** Like translateModuleDeclaration but from Types not Typedtree *) -let rec translateModuleDeclarationFromTypes ~config ~outputFileRelative - ~resolver ~typeEnv ~id (moduleDeclaration : Types.module_declaration) : +let rec translate_module_declaration_from_types ~config ~output_file_relative + ~resolver ~type_env ~id (module_declaration : Types.module_declaration) : Translation.t = - match moduleDeclaration.md_type with + match module_declaration.md_type with | Mty_signature signature -> let name = id |> Ident.name in signature - |> translateSignatureFromTypes ~config ~outputFileRelative ~resolver - ~typeEnv:(typeEnv |> TypeEnv.newModule ~name) + |> translate_signature_from_types ~config ~output_file_relative ~resolver + ~type_env:(type_env |> TypeEnv.new_module ~name) |> Translation.combine | Mty_ident _ -> - logNotImplemented ("Mty_ident " ^ __LOC__); + log_not_implemented ("Mty_ident " ^ __LOC__); Translation.empty | Mty_functor _ -> - logNotImplemented ("Mty_functor " ^ __LOC__); + log_not_implemented ("Mty_functor " ^ __LOC__); Translation.empty | Mty_alias _ -> - logNotImplemented ("Mty_alias " ^ __LOC__); + log_not_implemented ("Mty_alias " ^ __LOC__); Translation.empty (** Like translateSignatureItem but from Types not Typedtree *) -and translateSignatureItemFromTypes ~config ~outputFileRelative ~resolver - ~typeEnv (signatureItem : Types.signature_item) : Translation.t = - match signatureItem with - | Types.Sig_type (id, typeDeclaration, _) -> +and translate_signature_item_from_types ~config ~output_file_relative ~resolver + ~type_env (signature_item : Types.signature_item) : Translation.t = + match signature_item with + | Types.Sig_type (id, type_declaration, _) -> { - importTypes = []; - codeItems = []; - typeDeclarations = - typeDeclaration - |> translateTypeDeclarationFromTypes ~config ~outputFileRelative - ~resolver ~typeEnv ~id; + import_types = []; + code_items = []; + type_declarations = + type_declaration + |> translate_type_declaration_from_types ~config ~output_file_relative + ~resolver ~type_env ~id; } - | Types.Sig_module (id, moduleDeclaration, _) -> - let moduleItem = Runtime.newModuleItem ~name:(id |> Ident.name) in + | Types.Sig_module (id, module_declaration, _) -> + let module_item = Runtime.new_module_item ~name:(id |> Ident.name) in let config = - moduleDeclaration.md_attributes - |> Annotation.updateConfigForModule ~config + module_declaration.md_attributes + |> Annotation.update_config_for_module ~config in - typeEnv |> TypeEnv.updateModuleItem ~moduleItem; - moduleDeclaration - |> translateModuleDeclarationFromTypes ~config ~outputFileRelative ~resolver - ~typeEnv ~id + type_env |> TypeEnv.update_module_item ~module_item; + module_declaration + |> translate_module_declaration_from_types ~config ~output_file_relative ~resolver + ~type_env ~id | Types.Sig_value (id, {val_attributes; val_loc; val_type}) -> let name = id |> Ident.name in if !Debug.translation then Log_.item "Translate Sig Value %s\n" name; - let moduleItem = Runtime.newModuleItem ~name in - typeEnv |> TypeEnv.updateModuleItem ~moduleItem; + let module_item = Runtime.new_module_item ~name in + type_env |> TypeEnv.update_module_item ~module_item; if - val_attributes |> Annotation.fromAttributes ~config ~loc:val_loc = GenType + val_attributes |> Annotation.from_attributes ~config ~loc:val_loc = GenType then name - |> Translation.translateValue ~attributes:val_attributes ~config - ~docString:(Annotation.docStringFromAttrs val_attributes) - ~outputFileRelative ~resolver ~typeEnv ~typeExpr:val_type - ~addAnnotationsToFunction:(fun t -> t) + |> Translation.translate_value ~attributes:val_attributes ~config + ~doc_string:(Annotation.doc_string_from_attrs val_attributes) + ~output_file_relative ~resolver ~type_env ~type_expr:val_type + ~add_annotations_to_function:(fun t -> t) else Translation.empty | Types.Sig_typext _ -> - logNotImplemented ("Sig_typext " ^ __LOC__); + log_not_implemented ("Sig_typext " ^ __LOC__); Translation.empty | Types.Sig_modtype _ -> - logNotImplemented ("Sig_modtype " ^ __LOC__); + log_not_implemented ("Sig_modtype " ^ __LOC__); Translation.empty | Types.Sig_class _ -> - logNotImplemented ("Sig_class " ^ __LOC__); + log_not_implemented ("Sig_class " ^ __LOC__); Translation.empty | Types.Sig_class_type _ -> - logNotImplemented ("Sig_class_type " ^ __LOC__); + log_not_implemented ("Sig_class_type " ^ __LOC__); Translation.empty (** Like translateSignature but from Types not Typedtree *) -and translateSignatureFromTypes ~config ~outputFileRelative ~resolver ~typeEnv +and translate_signature_from_types ~config ~output_file_relative ~resolver ~type_env (signature : Types.signature_item list) : Translation.t list = if !Debug.translation then Log_.item "Translate Types.signature\n"; signature |> List.map - (translateSignatureItemFromTypes ~config ~outputFileRelative ~resolver - ~typeEnv) + (translate_signature_item_from_types ~config ~output_file_relative ~resolver + ~type_env) diff --git a/jscomp/gentype/TranslateStructure.ml b/jscomp/gentype/TranslateStructure.ml index a4a6d6d3b8..066c20453c 100644 --- a/jscomp/gentype/TranslateStructure.ml +++ b/jscomp/gentype/TranslateStructure.ml @@ -1,236 +1,236 @@ open GenTypeCommon let rec addAnnotationsToTypes_ ~config ~(expr : Typedtree.expression) - (argTypes : argType list) = - match (expr.exp_desc, expr.exp_type.desc, argTypes) with - | Texp_function {arg_label; param; cases = [{c_rhs}]}, _, {aType} :: nextTypes + (arg_types : arg_type list) = + match (expr.exp_desc, expr.exp_type.desc, arg_types) with + | Texp_function {arg_label; param; cases = [{c_rhs}]}, _, {a_type} :: next_types -> - let nextTypes1 = nextTypes |> addAnnotationsToTypes_ ~config ~expr:c_rhs in - let aName = Ident.name param in + let next_types1 = next_types |> addAnnotationsToTypes_ ~config ~expr:c_rhs in + let a_name = Ident.name param in let _ = Printtyped.implementation in - let aName = - if aName = "*opt*" then + let a_name = + if a_name = "*opt*" then match arg_label with | Optional l -> l | _ -> "" (* should not happen *) - else aName + else a_name in - {aName; aType} :: nextTypes1 - | Texp_construct ({txt = Lident "Function$"}, _, [funExpr]), _, _ -> + {a_name; a_type} :: next_types1 + | Texp_construct ({txt = Lident "Function$"}, _, [fun_expr]), _, _ -> (* let uncurried1: function$<_, _> = Function$(x => x |> string_of_int, [`Has_arity1]) *) - addAnnotationsToTypes_ ~config ~expr:funExpr argTypes + addAnnotationsToTypes_ ~config ~expr:fun_expr arg_types | Texp_apply ({exp_desc = Texp_ident (path, _, _)}, [(_, Some expr1)]), _, _ -> ( - match path |> TranslateTypeExprFromTypes.pathToList |> List.rev with + match path |> TranslateTypeExprFromTypes.path_to_list |> List.rev with | ["Js"; "Internal"; fn_mk] when (* Uncurried function definition uses Js.Internal.fn_mkX(...) *) String.length fn_mk >= 5 && (String.sub fn_mk 0 5 [@doesNotRaise]) = "fn_mk" -> - argTypes |> addAnnotationsToTypes_ ~config ~expr:expr1 - | _ -> argTypes) - | _ -> argTypes + arg_types |> addAnnotationsToTypes_ ~config ~expr:expr1 + | _ -> arg_types) + | _ -> arg_types -and addAnnotationsToTypes ~config ~(expr : Typedtree.expression) - (argTypes : argType list) = - let argTypes = addAnnotationsToTypes_ ~config ~expr argTypes in - if argTypes |> List.filter (fun {aName} -> aName = "param") |> List.length > 1 +and add_annotations_to_types ~config ~(expr : Typedtree.expression) + (arg_types : arg_type list) = + let arg_types = addAnnotationsToTypes_ ~config ~expr arg_types in + if arg_types |> List.filter (fun {a_name} -> a_name = "param") |> List.length > 1 then (* Underscore "_" appears as "param", can occur more than once *) - argTypes - |> List.mapi (fun i {aName; aType} -> - {aName = aName ^ "_" ^ string_of_int i; aType}) - else argTypes + arg_types + |> List.mapi (fun i {a_name; a_type} -> + {a_name = a_name ^ "_" ^ string_of_int i; a_type}) + else arg_types -and addAnnotationsToFields ~config (expr : Typedtree.expression) - (fields : fields) (argTypes : argType list) = - match (expr.exp_desc, fields, argTypes) with - | _, [], _ -> ([], argTypes |> addAnnotationsToTypes ~config ~expr) - | Texp_function {cases = [{c_rhs}]}, field :: nextFields, _ -> - let nextFields1, types1 = - addAnnotationsToFields ~config c_rhs nextFields argTypes +and add_annotations_to_fields ~config (expr : Typedtree.expression) + (fields : fields) (arg_types : arg_type list) = + match (expr.exp_desc, fields, arg_types) with + | _, [], _ -> ([], arg_types |> add_annotations_to_types ~config ~expr) + | Texp_function {cases = [{c_rhs}]}, field :: next_fields, _ -> + let next_fields1, types1 = + add_annotations_to_fields ~config c_rhs next_fields arg_types in let name = - TranslateTypeDeclarations.renameRecordField - ~attributes:expr.exp_attributes ~name:field.nameJS + TranslateTypeDeclarations.rename_record_field + ~attributes:expr.exp_attributes ~name:field.name_j_s in - ({field with nameJS = name} :: nextFields1, types1) - | _ -> (fields, argTypes) + ({field with name_j_s = name} :: next_fields1, types1) + | _ -> (fields, arg_types) [@@live] (** Recover from expr the renaming annotations on named arguments. *) -let addAnnotationsToFunctionType ~config (expr : Typedtree.expression) +let add_annotations_to_function_type ~config (expr : Typedtree.expression) (type_ : type_) = match type_ with | Function function_ -> - let argTypes = function_.argTypes |> addAnnotationsToTypes ~config ~expr in - Function {function_ with argTypes} + let arg_types = function_.arg_types |> add_annotations_to_types ~config ~expr in + Function {function_ with arg_types} | _ -> type_ -let removeValueBindingDuplicates structureItems = - let rec processBindings (bindings : Typedtree.value_binding list) ~seen = +let remove_value_binding_duplicates structure_items = + let rec process_bindings (bindings : Typedtree.value_binding list) ~seen = match bindings with - | ({vb_pat = {pat_desc = Tpat_var (id, _)}} as binding) :: otherBindings -> + | ({vb_pat = {pat_desc = Tpat_var (id, _)}} as binding) :: other_bindings -> let name = Ident.name id in - if !seen |> StringSet.mem name then otherBindings |> processBindings ~seen + if !seen |> StringSet.mem name then other_bindings |> process_bindings ~seen else ( seen := !seen |> StringSet.add name; - binding :: (otherBindings |> processBindings ~seen)) - | binding :: otherBindings -> - binding :: (otherBindings |> processBindings ~seen) + binding :: (other_bindings |> process_bindings ~seen)) + | binding :: other_bindings -> + binding :: (other_bindings |> process_bindings ~seen) | [] -> [] in - let rec processItems (items : Typedtree.structure_item list) ~acc ~seen = + let rec process_items (items : Typedtree.structure_item list) ~acc ~seen = match items with - | ({Typedtree.str_desc = Tstr_value (loc, valueBindings)} as item) - :: otherItems -> - let bindings = valueBindings |> processBindings ~seen in + | ({Typedtree.str_desc = Tstr_value (loc, value_bindings)} as item) + :: other_items -> + let bindings = value_bindings |> process_bindings ~seen in let item = {item with str_desc = Tstr_value (loc, bindings)} in - otherItems |> processItems ~acc:(item :: acc) ~seen - | item :: otherItems -> otherItems |> processItems ~acc:(item :: acc) ~seen + other_items |> process_items ~acc:(item :: acc) ~seen + | item :: other_items -> other_items |> process_items ~acc:(item :: acc) ~seen | [] -> acc in - structureItems |> List.rev |> processItems ~acc:[] ~seen:(ref StringSet.empty) + structure_items |> List.rev |> process_items ~acc:[] ~seen:(ref StringSet.empty) -let translateValueBinding ~config ~outputFileRelative ~resolver ~typeEnv +let translate_value_binding ~config ~output_file_relative ~resolver ~type_env {Typedtree.vb_attributes; vb_expr; vb_pat} : Translation.t = match vb_pat.pat_desc with | Tpat_var (id, _) | Tpat_alias ({pat_desc = Tpat_any}, id, _) -> let name = id |> Ident.name in if !Debug.translation then Log_.item "Translate Value Binding %s\n" name; - let moduleItem = Runtime.newModuleItem ~name in - typeEnv |> TypeEnv.updateModuleItem ~moduleItem; + let module_item = Runtime.new_module_item ~name in + type_env |> TypeEnv.update_module_item ~module_item; if vb_attributes - |> Annotation.fromAttributes ~config ~loc:vb_pat.pat_loc + |> Annotation.from_attributes ~config ~loc:vb_pat.pat_loc = GenType then id |> Ident.name - |> Translation.translateValue ~attributes:vb_attributes ~config - ~docString:(Annotation.docStringFromAttrs vb_attributes) - ~outputFileRelative ~resolver ~typeEnv ~typeExpr:vb_pat.pat_type - ~addAnnotationsToFunction: - (addAnnotationsToFunctionType ~config vb_expr) + |> Translation.translate_value ~attributes:vb_attributes ~config + ~doc_string:(Annotation.doc_string_from_attrs vb_attributes) + ~output_file_relative ~resolver ~type_env ~type_expr:vb_pat.pat_type + ~add_annotations_to_function: + (add_annotations_to_function_type ~config vb_expr) else Translation.empty | _ -> Translation.empty -let rec removeDuplicateValueBindings - (structureItems : Typedtree.structure_item list) = - match structureItems with - | ({Typedtree.str_desc = Tstr_value (loc, valueBindings)} as structureItem) +let rec remove_duplicate_value_bindings + (structure_items : Typedtree.structure_item list) = + match structure_items with + | ({Typedtree.str_desc = Tstr_value (loc, value_bindings)} as structure_item) :: rest -> - let boundInRest, filteredRest = rest |> removeDuplicateValueBindings in - let valueBindingsFiltered = - valueBindings - |> List.filter (fun valueBinding -> - match valueBinding with + let bound_in_rest, filtered_rest = rest |> remove_duplicate_value_bindings in + let value_bindings_filtered = + value_bindings + |> List.filter (fun value_binding -> + match value_binding with | {Typedtree.vb_pat = {pat_desc = Tpat_var (id, _)}} -> - not (boundInRest |> StringSet.mem (id |> Ident.name)) + not (bound_in_rest |> StringSet.mem (id |> Ident.name)) | _ -> true) in let bound = - valueBindings + value_bindings |> List.fold_left - (fun bound (valueBinding : Typedtree.value_binding) -> - match valueBinding with + (fun bound (value_binding : Typedtree.value_binding) -> + match value_binding with | {vb_pat = {pat_desc = Tpat_var (id, _)}} -> bound |> StringSet.add (id |> Ident.name) | _ -> bound) - boundInRest + bound_in_rest in ( bound, - {structureItem with str_desc = Tstr_value (loc, valueBindingsFiltered)} - :: filteredRest ) - | structureItem :: rest -> - let boundInRest, filteredRest = rest |> removeDuplicateValueBindings in - (boundInRest, structureItem :: filteredRest) + {structure_item with str_desc = Tstr_value (loc, value_bindings_filtered)} + :: filtered_rest ) + | structure_item :: rest -> + let bound_in_rest, filtered_rest = rest |> remove_duplicate_value_bindings in + (bound_in_rest, structure_item :: filtered_rest) | [] -> (StringSet.empty, []) -let rec translateModuleBinding ~(config : GenTypeConfig.t) ~outputFileRelative - ~resolver ~typeEnv +let rec translate_module_binding ~(config : GenTypeConfig.t) ~output_file_relative + ~resolver ~type_env ({mb_id; mb_expr; mb_attributes} : Typedtree.module_binding) : Translation.t = let name = mb_id |> Ident.name in if !Debug.translation then Log_.item "Translate Module Binding %s\n" name; - let moduleItem = Runtime.newModuleItem ~name in - let config = mb_attributes |> Annotation.updateConfigForModule ~config in - typeEnv |> TypeEnv.updateModuleItem ~moduleItem; - let typeEnv = typeEnv |> TypeEnv.newModule ~name in + let module_item = Runtime.new_module_item ~name in + let config = mb_attributes |> Annotation.update_config_for_module ~config in + type_env |> TypeEnv.update_module_item ~module_item; + let type_env = type_env |> TypeEnv.new_module ~name in match mb_expr.mod_desc with | Tmod_ident (path, _) -> ( - let dep = path |> Dependencies.fromPath ~config ~typeEnv in - let internal = dep |> Dependencies.isInternal in - typeEnv |> TypeEnv.addModuleEquation ~dep ~internal; + let dep = path |> Dependencies.from_path ~config ~type_env in + let internal = dep |> Dependencies.is_internal in + type_env |> TypeEnv.add_module_equation ~dep ~internal; match Env.scrape_alias mb_expr.mod_env mb_expr.mod_type with | Mty_signature signature -> (* Treat module M = N as include N *) signature - |> TranslateSignatureFromTypes.translateSignatureFromTypes ~config - ~outputFileRelative ~resolver ~typeEnv + |> TranslateSignatureFromTypes.translate_signature_from_types ~config + ~output_file_relative ~resolver ~type_env |> Translation.combine | Mty_alias _ | Mty_ident _ | Mty_functor _ -> Translation.empty) | Tmod_structure structure -> - let isLetPrivate = - mb_attributes |> Annotation.hasAttribute Annotation.tagIsInternLocal + let is_let_private = + mb_attributes |> Annotation.has_attribute Annotation.tag_is_intern_local in - if isLetPrivate then Translation.empty + if is_let_private then Translation.empty else structure - |> translateStructure ~config ~outputFileRelative ~resolver ~typeEnv + |> translate_structure ~config ~output_file_relative ~resolver ~type_env |> Translation.combine | Tmod_apply _ -> ( (* Only look at the resulting type of the module *) match mb_expr.mod_type with | Mty_signature signature -> signature - |> TranslateSignatureFromTypes.translateSignatureFromTypes ~config - ~outputFileRelative ~resolver ~typeEnv + |> TranslateSignatureFromTypes.translate_signature_from_types ~config + ~output_file_relative ~resolver ~type_env |> Translation.combine | Mty_ident _ -> - logNotImplemented ("Mty_ident " ^ __LOC__); + log_not_implemented ("Mty_ident " ^ __LOC__); Translation.empty | Mty_functor _ -> - logNotImplemented ("Mty_functor " ^ __LOC__); + log_not_implemented ("Mty_functor " ^ __LOC__); Translation.empty | Mty_alias _ -> - logNotImplemented ("Mty_alias " ^ __LOC__); + log_not_implemented ("Mty_alias " ^ __LOC__); Translation.empty) - | Tmod_unpack (_, moduleType) -> ( - match moduleType with + | Tmod_unpack (_, module_type) -> ( + match module_type with | Mty_signature signature -> signature - |> TranslateSignatureFromTypes.translateSignatureFromTypes ~config - ~outputFileRelative ~resolver ~typeEnv + |> TranslateSignatureFromTypes.translate_signature_from_types ~config + ~output_file_relative ~resolver ~type_env |> Translation.combine | Mty_ident path -> ( - match typeEnv |> TypeEnv.lookupModuleTypeSignature ~path with + match type_env |> TypeEnv.lookup_module_type_signature ~path with | None -> Translation.empty | Some (signature, _) -> signature - |> TranslateSignature.translateSignature ~config ~outputFileRelative - ~resolver ~typeEnv + |> TranslateSignature.translate_signature ~config ~output_file_relative + ~resolver ~type_env |> Translation.combine) | Mty_functor _ -> - logNotImplemented ("Mty_functor " ^ __LOC__); + log_not_implemented ("Mty_functor " ^ __LOC__); Translation.empty | Mty_alias _ -> - logNotImplemented ("Mty_alias " ^ __LOC__); + log_not_implemented ("Mty_alias " ^ __LOC__); Translation.empty) | Tmod_functor _ -> - logNotImplemented ("Tmod_functor " ^ __LOC__); + log_not_implemented ("Tmod_functor " ^ __LOC__); Translation.empty | Tmod_constraint (_, Mty_ident path, Tmodtype_explicit _, Tcoerce_none) -> ( - match typeEnv |> TypeEnv.lookupModuleTypeSignature ~path with + match type_env |> TypeEnv.lookup_module_type_signature ~path with | None -> Translation.empty | Some (signature, _) -> signature - |> TranslateSignature.translateSignature ~config ~outputFileRelative - ~resolver ~typeEnv + |> TranslateSignature.translate_signature ~config ~output_file_relative + ~resolver ~type_env |> Translation.combine) | Tmod_constraint (_, Mty_signature signature, Tmodtype_explicit _, Tcoerce_none) -> signature - |> TranslateSignatureFromTypes.translateSignatureFromTypes ~config - ~outputFileRelative ~resolver ~typeEnv + |> TranslateSignatureFromTypes.translate_signature_from_types ~config + ~output_file_relative ~resolver ~type_env |> Translation.combine | Tmod_constraint ( {mod_desc = Tmod_structure structure}, @@ -239,9 +239,9 @@ let rec translateModuleBinding ~(config : GenTypeConfig.t) ~outputFileRelative Tcoerce_structure _ ) -> { structure with - str_items = structure.str_items |> removeDuplicateValueBindings |> snd; + str_items = structure.str_items |> remove_duplicate_value_bindings |> snd; } - |> translateStructure ~config ~outputFileRelative ~resolver ~typeEnv + |> translate_structure ~config ~output_file_relative ~resolver ~type_env |> Translation.combine | Tmod_constraint ( _, @@ -249,47 +249,47 @@ let rec translateModuleBinding ~(config : GenTypeConfig.t) ~outputFileRelative Tmodtype_explicit {mty_desc = Tmty_signature {sig_type = signature}}, _ ) -> signature - |> TranslateSignatureFromTypes.translateSignatureFromTypes ~config - ~outputFileRelative ~resolver ~typeEnv + |> TranslateSignatureFromTypes.translate_signature_from_types ~config + ~output_file_relative ~resolver ~type_env |> Translation.combine | Tmod_constraint _ -> - logNotImplemented ("Tmod_constraint " ^ __LOC__); + log_not_implemented ("Tmod_constraint " ^ __LOC__); Translation.empty -and translateStructureItem ~config ~outputFileRelative ~resolver ~typeEnv - (structItem : Typedtree.structure_item) : Translation.t = - match structItem with - | {str_desc = Tstr_type (recFlag, typeDeclarations)} -> +and translate_structure_item ~config ~output_file_relative ~resolver ~type_env + (struct_item : Typedtree.structure_item) : Translation.t = + match struct_item with + | {str_desc = Tstr_type (rec_flag, type_declarations)} -> { - importTypes = []; - codeItems = []; - typeDeclarations = - typeDeclarations - |> TranslateTypeDeclarations.translateTypeDeclarations ~config - ~outputFileRelative ~recursive:(recFlag = Recursive) ~resolver - ~typeEnv; + import_types = []; + code_items = []; + type_declarations = + type_declarations + |> TranslateTypeDeclarations.translate_type_declarations ~config + ~output_file_relative ~recursive:(rec_flag = Recursive) ~resolver + ~type_env; } - | {str_desc = Tstr_value (_loc, valueBindings)} -> - valueBindings + | {str_desc = Tstr_value (_loc, value_bindings)} -> + value_bindings |> List.map - (translateValueBinding ~config ~outputFileRelative ~resolver ~typeEnv) + (translate_value_binding ~config ~output_file_relative ~resolver ~type_env) |> Translation.combine - | {str_desc = Tstr_primitive valueDescription} -> + | {str_desc = Tstr_primitive value_description} -> (* external declaration *) - valueDescription - |> Translation.translatePrimitive ~config ~outputFileRelative ~resolver - ~typeEnv - | {str_desc = Tstr_module moduleBinding} -> - moduleBinding - |> translateModuleBinding ~config ~outputFileRelative ~resolver ~typeEnv - | {str_desc = Tstr_modtype moduleTypeDeclaration} -> - moduleTypeDeclaration - |> TranslateSignature.translateModuleTypeDeclaration ~config - ~outputFileRelative ~resolver ~typeEnv - | {str_desc = Tstr_recmodule moduleBindings} -> - moduleBindings + value_description + |> Translation.translate_primitive ~config ~output_file_relative ~resolver + ~type_env + | {str_desc = Tstr_module module_binding} -> + module_binding + |> translate_module_binding ~config ~output_file_relative ~resolver ~type_env + | {str_desc = Tstr_modtype module_type_declaration} -> + module_type_declaration + |> TranslateSignature.translate_module_type_declaration ~config + ~output_file_relative ~resolver ~type_env + | {str_desc = Tstr_recmodule module_bindings} -> + module_bindings |> List.map - (translateModuleBinding ~config ~outputFileRelative ~resolver ~typeEnv) + (translate_module_binding ~config ~output_file_relative ~resolver ~type_env) |> Translation.combine | { str_desc = @@ -305,7 +305,7 @@ and translateStructureItem ~config ~outputFileRelative ~resolver ~typeEnv Tmod_structure { str_items = - [({str_desc = Tstr_primitive _} as structItem1)]; + [({str_desc = Tstr_primitive _} as struct_item1)]; }; }, _, @@ -316,40 +316,40 @@ and translateStructureItem ~config ~outputFileRelative ~resolver ~typeEnv }; _; } -> - structItem1 - |> translateStructureItem ~config ~outputFileRelative ~resolver ~typeEnv + struct_item1 + |> translate_structure_item ~config ~output_file_relative ~resolver ~type_env | {str_desc = Tstr_include {incl_type = signature}} -> signature - |> TranslateSignatureFromTypes.translateSignatureFromTypes ~config - ~outputFileRelative ~resolver ~typeEnv + |> TranslateSignatureFromTypes.translate_signature_from_types ~config + ~output_file_relative ~resolver ~type_env |> Translation.combine | {str_desc = Tstr_eval _} -> - logNotImplemented ("Tstr_eval " ^ __LOC__); + log_not_implemented ("Tstr_eval " ^ __LOC__); Translation.empty | {str_desc = Tstr_typext _} -> - logNotImplemented ("Tstr_typext " ^ __LOC__); + log_not_implemented ("Tstr_typext " ^ __LOC__); Translation.empty | {str_desc = Tstr_exception _} -> - logNotImplemented ("Tstr_exception " ^ __LOC__); + log_not_implemented ("Tstr_exception " ^ __LOC__); Translation.empty | {str_desc = Tstr_open _} -> - logNotImplemented ("Tstr_open " ^ __LOC__); + log_not_implemented ("Tstr_open " ^ __LOC__); Translation.empty | {str_desc = Tstr_class _} -> - logNotImplemented ("Tstr_class " ^ __LOC__); + log_not_implemented ("Tstr_class " ^ __LOC__); Translation.empty | {str_desc = Tstr_class_type _} -> - logNotImplemented ("Tstr_class_type " ^ __LOC__); + log_not_implemented ("Tstr_class_type " ^ __LOC__); Translation.empty | {str_desc = Tstr_attribute _} -> - logNotImplemented ("Tstr_attribute " ^ __LOC__); + log_not_implemented ("Tstr_attribute " ^ __LOC__); Translation.empty -and translateStructure ~config ~outputFileRelative ~resolver ~typeEnv structure +and translate_structure ~config ~output_file_relative ~resolver ~type_env structure : Translation.t list = if !Debug.translation then Log_.item "Translate Structure\n"; - structure.Typedtree.str_items |> removeValueBindingDuplicates - |> List.map (fun structItem -> - structItem - |> translateStructureItem ~config ~outputFileRelative ~resolver - ~typeEnv) + structure.Typedtree.str_items |> remove_value_binding_duplicates + |> List.map (fun struct_item -> + struct_item + |> translate_structure_item ~config ~output_file_relative ~resolver + ~type_env) diff --git a/jscomp/gentype/TranslateTypeDeclarations.ml b/jscomp/gentype/TranslateTypeDeclarations.ml index a97e1f4950..1b03344665 100644 --- a/jscomp/gentype/TranslateTypeDeclarations.ml +++ b/jscomp/gentype/TranslateTypeDeclarations.ml @@ -1,6 +1,6 @@ open GenTypeCommon -type declarationKind = +type declaration_kind = | RecordDeclarationFromTypes of Types.label_declaration list * Types.record_representation | GeneralDeclaration of Typedtree.core_type option @@ -9,32 +9,32 @@ type declarationKind = | VariantDeclarationFromTypes of Types.constructor_declaration list | NoDeclaration -let createExportTypeFromTypeDeclaration ~annotation ~loc ~nameAs ~opaque ~type_ - ~typeEnv ~docString typeName ~typeVars : CodeItem.exportFromTypeDeclaration +let create_export_type_from_type_declaration ~annotation ~loc ~name_as ~opaque ~type_ + ~type_env ~doc_string type_name ~type_vars : CodeItem.export_from_type_declaration = - let resolvedTypeName = - typeName |> sanitizeTypeName |> TypeEnv.addModulePath ~typeEnv + let resolved_type_name = + type_name |> sanitize_type_name |> TypeEnv.add_module_path ~type_env in { - exportType = - {loc; nameAs; opaque; type_; typeVars; resolvedTypeName; docString}; + export_type = + {loc; name_as; opaque; type_; type_vars; resolved_type_name; doc_string}; annotation; } -let createCase (label, attributes) ~poly = +let create_case (label, attributes) ~poly = { - labelJS = + label_j_s = (match - attributes |> Annotation.getAttributePayload Annotation.tagIsAs + attributes |> Annotation.get_attribute_payload Annotation.tag_is_as with | Some (_, IdentPayload (Lident "null")) -> NullLabel | Some (_, IdentPayload (Lident "undefined")) -> UndefinedLabel | Some (_, BoolPayload b) -> BoolLabel b | Some (_, FloatPayload s) -> FloatLabel s | Some (_, IntPayload i) -> IntLabel i - | Some (_, StringPayload asLabel) -> StringLabel asLabel + | Some (_, StringPayload as_label) -> StringLabel as_label | _ -> - if poly && isNumber label then IntLabel label else StringLabel label); + if poly && is_number label then IntLabel label else StringLabel label); } (** @@ -43,60 +43,60 @@ let createCase (label, attributes) ~poly = * If @as is used (with records-as-objects active), escape and quote if * the identifier contains characters which are invalid as JS property names. *) -let renameRecordField ~attributes ~name = - attributes |> Annotation.checkUnsupportedGenTypeAsRenaming; - match attributes |> Annotation.getAsString with +let rename_record_field ~attributes ~name = + attributes |> Annotation.check_unsupported_gen_type_as_renaming; + match attributes |> Annotation.get_as_string with | Some s -> s |> String.escaped | None -> name -let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver - ~typeAttributes ~typeEnv ~typeName ~typeVars declarationKind : - CodeItem.typeDeclaration list = - let docString = typeAttributes |> Annotation.docStringFromAttrs in - let annotation = typeAttributes |> Annotation.fromAttributes ~config ~loc in +let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver + ~type_attributes ~type_env ~type_name ~type_vars declaration_kind : + CodeItem.type_declaration list = + let doc_string = type_attributes |> Annotation.doc_string_from_attrs in + let annotation = type_attributes |> Annotation.from_attributes ~config ~loc in let opaque = match annotation = Annotation.GenTypeOpaque with | true -> Some true | false -> None (* one means don't know *) in - let importStringOpt, nameAs = - typeAttributes |> Annotation.getAttributeImportRenaming + let import_string_opt, name_as = + type_attributes |> Annotation.get_attribute_import_renaming in - let unboxedAnnotation = - typeAttributes |> Annotation.hasAttribute Annotation.tagIsUnboxed + let unboxed_annotation = + type_attributes |> Annotation.has_attribute Annotation.tag_is_unboxed in - let tagAnnotation = typeAttributes |> Annotation.getTag in - let returnTypeDeclaration (typeDeclaration : CodeItem.typeDeclaration) = + let tag_annotation = type_attributes |> Annotation.get_tag in + let return_type_declaration (type_declaration : CodeItem.type_declaration) = match opaque = Some true with - | true -> [{typeDeclaration with importTypes = []}] - | false -> [typeDeclaration] + | true -> [{type_declaration with import_types = []}] + | false -> [type_declaration] in - let handleGeneralDeclaration + let handle_general_declaration (translation : TranslateTypeExprFromTypes.translation) = - let exportFromTypeDeclaration = - typeName - |> createExportTypeFromTypeDeclaration ~annotation ~loc ~nameAs ~opaque - ~type_:translation.type_ ~typeEnv ~docString ~typeVars + let export_from_type_declaration = + type_name + |> create_export_type_from_type_declaration ~annotation ~loc ~name_as ~opaque + ~type_:translation.type_ ~type_env ~doc_string ~type_vars in - let importTypes = + let import_types = translation.dependencies - |> Translation.translateDependencies ~config ~outputFileRelative ~resolver + |> Translation.translate_dependencies ~config ~output_file_relative ~resolver in - {CodeItem.importTypes; exportFromTypeDeclaration} + {CodeItem.import_types; export_from_type_declaration} in - let translateLabelDeclarations ?(inline = false) ~recordRepresentation - labelDeclarations = - let isOptional l = - match recordRepresentation with + let translate_label_declarations ?(inline = false) ~record_representation + label_declarations = + let is_optional l = + match record_representation with | Types.Record_optional_labels lbls -> List.mem l lbls | _ -> false in - let fieldTranslations = - labelDeclarations + let field_translations = + label_declarations |> List.map (fun {Types.ld_id; ld_mutable; ld_type; ld_attributes} -> let name = - renameRecordField ~attributes:ld_attributes + rename_record_field ~attributes:ld_attributes ~name:(ld_id |> Ident.name) in let mutability = @@ -107,255 +107,255 @@ let traslateDeclarationKind ~config ~loc ~outputFileRelative ~resolver ( name, mutability, ld_type - |> TranslateTypeExprFromTypes.translateTypeExprFromTypes ~config - ~typeEnv, - Annotation.docStringFromAttrs ld_attributes )) + |> TranslateTypeExprFromTypes.translate_type_expr_from_types ~config + ~type_env, + Annotation.doc_string_from_attrs ld_attributes )) in let dependencies = - fieldTranslations + field_translations |> List.map (fun (_, _, {TranslateTypeExprFromTypes.dependencies}, _) -> dependencies) |> List.concat in let fields = - fieldTranslations + field_translations |> List.map (fun - (name, mutable_, {TranslateTypeExprFromTypes.type_}, docString) -> + (name, mutable_, {TranslateTypeExprFromTypes.type_}, doc_string) -> let optional, type1 = match type_ with - | Option type1 when isOptional name -> (Optional, type1) + | Option type1 when is_optional name -> (Optional, type1) | _ -> (Mandatory, type_) in - {mutable_; nameJS = name; optional; type_ = type1; docString}) + {mutable_; name_j_s = name; optional; type_ = type1; doc_string}) in let type_ = match fields with - | [field] when unboxedAnnotation -> field.type_ + | [field] when unboxed_annotation -> field.type_ | _ -> Object ((if inline then Inline else Closed), fields) in {TranslateTypeExprFromTypes.dependencies; type_} in - match (declarationKind, importStringOpt) with - | _, Some importString -> + match (declaration_kind, import_string_opt) with + | _, Some import_string -> (* import type *) - let typeName_ = typeName in - let nameWithModulePath = - typeName_ |> TypeEnv.addModulePath ~typeEnv |> ResolvedName.toString + let typeName_ = type_name in + let name_with_module_path = + typeName_ |> TypeEnv.add_module_path ~type_env |> ResolvedName.to_string in - let typeName, asTypeName = - match nameAs with - | Some asString -> (asString, "$$" ^ nameWithModulePath) - | None -> (nameWithModulePath, "$$" ^ nameWithModulePath) + let type_name, as_type_name = + match name_as with + | Some as_string -> (as_string, "$$" ^ name_with_module_path) + | None -> (name_with_module_path, "$$" ^ name_with_module_path) in - let importTypes = + let import_types = [ { - CodeItem.typeName; - asTypeName = Some asTypeName; - importPath = importString |> ImportPath.fromStringUnsafe; + CodeItem.type_name; + as_type_name = Some as_type_name; + import_path = import_string |> ImportPath.from_string_unsafe; }; ] in - let exportFromTypeDeclaration = + let export_from_type_declaration = (* Make the imported type usable from other modules by exporting it too. *) typeName_ - |> createExportTypeFromTypeDeclaration ~docString ~annotation:GenType ~loc - ~nameAs:None ~opaque:(Some false) + |> create_export_type_from_type_declaration ~doc_string ~annotation:GenType ~loc + ~name_as:None ~opaque:(Some false) ~type_: - (asTypeName - |> ident ~typeArgs:(typeVars |> List.map (fun s -> TypeVar s))) - ~typeEnv ~typeVars + (as_type_name + |> ident ~type_args:(type_vars |> List.map (fun s -> TypeVar s))) + ~type_env ~type_vars in - [{CodeItem.importTypes; exportFromTypeDeclaration}] + [{CodeItem.import_types; export_from_type_declaration}] | (GeneralDeclarationFromTypes None | GeneralDeclaration None), None -> { - CodeItem.importTypes = []; - exportFromTypeDeclaration = - typeName - |> createExportTypeFromTypeDeclaration ~docString ~annotation ~loc - ~nameAs ~opaque:(Some true) ~type_:unknown ~typeEnv ~typeVars; + CodeItem.import_types = []; + export_from_type_declaration = + type_name + |> create_export_type_from_type_declaration ~doc_string ~annotation ~loc + ~name_as ~opaque:(Some true) ~type_:unknown ~type_env ~type_vars; } - |> returnTypeDeclaration - | GeneralDeclarationFromTypes (Some typeExpr), None -> + |> return_type_declaration + | GeneralDeclarationFromTypes (Some type_expr), None -> let translation = - typeExpr - |> TranslateTypeExprFromTypes.translateTypeExprFromTypes ~config ~typeEnv + type_expr + |> TranslateTypeExprFromTypes.translate_type_expr_from_types ~config ~type_env in - translation |> handleGeneralDeclaration |> returnTypeDeclaration - | GeneralDeclaration (Some coreType), None -> + translation |> handle_general_declaration |> return_type_declaration + | GeneralDeclaration (Some core_type), None -> let translation = - coreType |> TranslateCoreType.translateCoreType ~config ~typeEnv + core_type |> TranslateCoreType.translate_core_type ~config ~type_env in let type_ = - match (coreType, translation.type_) with - | {ctyp_desc = Ttyp_variant (rowFields, _, _)}, Variant variant -> - let rowFieldsVariants = rowFields |> TranslateCoreType.processVariant in - let noPayloads = - rowFieldsVariants.noPayloads |> List.map (createCase ~poly:true) + match (core_type, translation.type_) with + | {ctyp_desc = Ttyp_variant (row_fields, _, _)}, Variant variant -> + let row_fields_variants = row_fields |> TranslateCoreType.process_variant in + let no_payloads = + row_fields_variants.no_payloads |> List.map (create_case ~poly:true) in let payloads = if variant.payloads |> List.length - = (rowFieldsVariants.payloads |> List.length) + = (row_fields_variants.payloads |> List.length) then - (List.combine variant.payloads rowFieldsVariants.payloads + (List.combine variant.payloads row_fields_variants.payloads [@doesNotRaise]) |> List.map (fun (payload, (label, attributes, _)) -> - let case = (label, attributes) |> createCase ~poly:true in + let case = (label, attributes) |> create_case ~poly:true in {payload with case}) else variant.payloads in - createVariant ~inherits:variant.inherits ~noPayloads ~payloads + create_variant ~inherits:variant.inherits ~no_payloads ~payloads ~polymorphic:true ~tag:None ~unboxed:false | _ -> translation.type_ in - {translation with type_} |> handleGeneralDeclaration - |> returnTypeDeclaration - | RecordDeclarationFromTypes (labelDeclarations, recordRepresentation), None + {translation with type_} |> handle_general_declaration + |> return_type_declaration + | RecordDeclarationFromTypes (label_declarations, record_representation), None -> let {TranslateTypeExprFromTypes.dependencies; type_} = - labelDeclarations |> translateLabelDeclarations ~recordRepresentation + label_declarations |> translate_label_declarations ~record_representation in - let importTypes = + let import_types = dependencies - |> Translation.translateDependencies ~config ~outputFileRelative ~resolver + |> Translation.translate_dependencies ~config ~output_file_relative ~resolver in { - CodeItem.importTypes; - exportFromTypeDeclaration = - typeName - |> createExportTypeFromTypeDeclaration ~docString ~annotation ~loc - ~nameAs ~opaque ~type_ ~typeEnv ~typeVars; + CodeItem.import_types; + export_from_type_declaration = + type_name + |> create_export_type_from_type_declaration ~doc_string ~annotation ~loc + ~name_as ~opaque ~type_ ~type_env ~type_vars; } - |> returnTypeDeclaration - | VariantDeclarationFromTypes constructorDeclarations, None -> + |> return_type_declaration + | VariantDeclarationFromTypes constructor_declarations, None -> let variants = - constructorDeclarations - |> List.map (fun constructorDeclaration -> - let constructorArgs = constructorDeclaration.Types.cd_args in - let attributes = constructorDeclaration.cd_attributes in - let name = constructorDeclaration.cd_id |> Ident.name in - let argsTranslation = - match constructorArgs with - | Cstr_tuple typeExprs -> - typeExprs - |> TranslateTypeExprFromTypes.translateTypeExprsFromTypes - ~config ~typeEnv - | Cstr_record labelDeclarations -> + constructor_declarations + |> List.map (fun constructor_declaration -> + let constructor_args = constructor_declaration.Types.cd_args in + let attributes = constructor_declaration.cd_attributes in + let name = constructor_declaration.cd_id |> Ident.name in + let args_translation = + match constructor_args with + | Cstr_tuple type_exprs -> + type_exprs + |> TranslateTypeExprFromTypes.translate_type_exprs_from_types + ~config ~type_env + | Cstr_record label_declarations -> [ - labelDeclarations - |> translateLabelDeclarations ~inline:true - ~recordRepresentation:Types.Record_regular; + label_declarations + |> translate_label_declarations ~inline:true + ~record_representation:Types.Record_regular; ] in - let argTypes = - argsTranslation + let arg_types = + args_translation |> List.map (fun {TranslateTypeExprFromTypes.type_} -> type_) in - let importTypes = - argsTranslation + let import_types = + args_translation |> List.map (fun {TranslateTypeExprFromTypes.dependencies} -> dependencies) |> List.concat - |> Translation.translateDependencies ~config ~outputFileRelative + |> Translation.translate_dependencies ~config ~output_file_relative ~resolver in - (name, attributes, argTypes, importTypes)) + (name, attributes, arg_types, import_types)) in - let variantsNoPayload, variantsWithPayload = - variants |> List.partition (fun (_, _, argTypes, _) -> argTypes = []) + let variants_no_payload, variants_with_payload = + variants |> List.partition (fun (_, _, arg_types, _) -> arg_types = []) in - let noPayloads = - variantsNoPayload + let no_payloads = + variants_no_payload |> List.map (fun (name, attributes, _argTypes, _importTypes) -> - (name, attributes) |> createCase ~poly:false) + (name, attributes) |> create_case ~poly:false) in let payloads = - variantsWithPayload - |> List.map (fun (name, attributes, argTypes, _importTypes) -> + variants_with_payload + |> List.map (fun (name, attributes, arg_types, _importTypes) -> let type_ = - match argTypes with + match arg_types with | [type_] -> type_ - | _ -> Tuple argTypes + | _ -> Tuple arg_types in - {case = (name, attributes) |> createCase ~poly:false; t = type_}) + {case = (name, attributes) |> create_case ~poly:false; t = type_}) in - let variantTyp = - createVariant ~inherits:[] ~noPayloads ~payloads ~polymorphic:false - ~tag:tagAnnotation ~unboxed:unboxedAnnotation + let variant_typ = + create_variant ~inherits:[] ~no_payloads ~payloads ~polymorphic:false + ~tag:tag_annotation ~unboxed:unboxed_annotation in - let resolvedTypeName = typeName |> TypeEnv.addModulePath ~typeEnv in - let exportFromTypeDeclaration = + let resolved_type_name = type_name |> TypeEnv.add_module_path ~type_env in + let export_from_type_declaration = { - CodeItem.exportType = + CodeItem.export_type = { loc; - nameAs; + name_as; opaque; - type_ = variantTyp; - typeVars; - resolvedTypeName; - docString; + type_ = variant_typ; + type_vars; + resolved_type_name; + doc_string; }; annotation; } in - let importTypes = + let import_types = variants - |> List.map (fun (_, _, _, importTypes) -> importTypes) + |> List.map (fun (_, _, _, import_types) -> import_types) |> List.concat in - {CodeItem.exportFromTypeDeclaration; importTypes} |> returnTypeDeclaration + {CodeItem.export_from_type_declaration; import_types} |> return_type_declaration | NoDeclaration, None -> [] -let hasSomeGADTLeaf constructorDeclarations = +let has_some_g_a_d_t_leaf constructor_declarations = List.exists (fun declaration -> declaration.Types.cd_res != None) - constructorDeclarations + constructor_declarations -let translateTypeDeclaration ~config ~outputFileRelative ~resolver ~typeEnv +let translate_type_declaration ~config ~output_file_relative ~resolver ~type_env ({typ_attributes; typ_id; typ_loc; typ_manifest; typ_params; typ_type} : - Typedtree.type_declaration) : CodeItem.typeDeclaration list = + Typedtree.type_declaration) : CodeItem.type_declaration list = if !Debug.translation then Log_.item "Translate Type Declaration %s\n" (typ_id |> Ident.name); - let typeName = Ident.name typ_id in - let typeVars = + let type_name = Ident.name typ_id in + let type_vars = typ_params - |> List.map (fun (coreType, _) -> coreType) - |> TypeVars.extractFromCoreType + |> List.map (fun (core_type, _) -> core_type) + |> TypeVars.extract_from_core_type in - let declarationKind = + let declaration_kind = match typ_type.type_kind with - | Type_record (labelDeclarations, recordRepresentation) -> - RecordDeclarationFromTypes (labelDeclarations, recordRepresentation) - | Type_variant constructorDeclarations -> - VariantDeclarationFromTypes constructorDeclarations + | Type_record (label_declarations, record_representation) -> + RecordDeclarationFromTypes (label_declarations, record_representation) + | Type_variant constructor_declarations -> + VariantDeclarationFromTypes constructor_declarations | Type_abstract -> GeneralDeclaration typ_manifest | _ -> NoDeclaration in - declarationKind - |> traslateDeclarationKind ~config ~loc:typ_loc ~outputFileRelative ~resolver - ~typeAttributes:typ_attributes ~typeEnv ~typeName ~typeVars + declaration_kind + |> traslate_declaration_kind ~config ~loc:typ_loc ~output_file_relative ~resolver + ~type_attributes:typ_attributes ~type_env ~type_name ~type_vars -let addTypeDeclarationIdToTypeEnv ~typeEnv +let add_type_declaration_id_to_type_env ~type_env ({typ_id} : Typedtree.type_declaration) = - typeEnv |> TypeEnv.newType ~name:(typ_id |> Ident.name) + type_env |> TypeEnv.new_type ~name:(typ_id |> Ident.name) -let translateTypeDeclarations ~config ~outputFileRelative ~recursive ~resolver - ~typeEnv (typeDeclarations : Typedtree.type_declaration list) : - CodeItem.typeDeclaration list = +let translate_type_declarations ~config ~output_file_relative ~recursive ~resolver + ~type_env (type_declarations : Typedtree.type_declaration list) : + CodeItem.type_declaration list = if recursive then - typeDeclarations |> List.iter (addTypeDeclarationIdToTypeEnv ~typeEnv); - typeDeclarations - |> List.map (fun typeDeclaration -> + type_declarations |> List.iter (add_type_declaration_id_to_type_env ~type_env); + type_declarations + |> List.map (fun type_declaration -> let res = - typeDeclaration - |> translateTypeDeclaration ~config ~outputFileRelative ~resolver - ~typeEnv + type_declaration + |> translate_type_declaration ~config ~output_file_relative ~resolver + ~type_env in if not recursive then - typeDeclaration |> addTypeDeclarationIdToTypeEnv ~typeEnv; + type_declaration |> add_type_declaration_id_to_type_env ~type_env; res) |> List.concat diff --git a/jscomp/gentype/TranslateTypeExprFromTypes.ml b/jscomp/gentype/TranslateTypeExprFromTypes.ml index a469313966..6b690ce47f 100644 --- a/jscomp/gentype/TranslateTypeExprFromTypes.ml +++ b/jscomp/gentype/TranslateTypeExprFromTypes.ml @@ -2,42 +2,42 @@ open GenTypeCommon type translation = {dependencies: dep list; type_: type_} -let rec removeOption ~(label : Asttypes.arg_label) (typeExpr : Types.type_expr) +let rec remove_option ~(label : Asttypes.arg_label) (type_expr : Types.type_expr) = - match (typeExpr.desc, label) with + match (type_expr.desc, label) with | Tconstr (Path.Pident id, [t], _), Optional lbl when Ident.name id = "option" -> Some (lbl, t) - | Tconstr (Pdot (Path.Pident nameSpace, id, _), [t], _), Optional lbl - when Ident.name nameSpace = "FB" && id = "option" -> + | Tconstr (Pdot (Path.Pident name_space, id, _), [t], _), Optional lbl + when Ident.name name_space = "FB" && id = "option" -> Some (lbl, t) - | Tlink t, _ -> t |> removeOption ~label + | Tlink t, _ -> t |> remove_option ~label | _ -> None -let rec pathToList path = +let rec path_to_list path = match path with | Path.Pident id -> [id |> Ident.name] - | Path.Pdot (p, s, _) -> s :: (p |> pathToList) + | Path.Pdot (p, s, _) -> s :: (p |> path_to_list) | Path.Papply _ -> [] -let translateObjType closedFlag fieldsTranslations = +let translate_obj_type closed_flag fields_translations = let dependencies = - fieldsTranslations + fields_translations |> List.map (fun (_, {dependencies}) -> dependencies) |> List.concat in - let rec checkMutableField ?(acc = []) fields = + let rec check_mutable_field ?(acc = []) fields = match fields with - | (previousName, {type_ = _}) :: (name, {type_}) :: rest - when Runtime.checkMutableObjectField ~previousName ~name -> + | (previous_name, {type_ = _}) :: (name, {type_}) :: rest + when Runtime.check_mutable_object_field ~previous_name ~name -> (* The field was annotated "@set" *) - rest |> checkMutableField ~acc:((name, type_, Mutable) :: acc) + rest |> check_mutable_field ~acc:((name, type_, Mutable) :: acc) | (name, {type_}) :: rest -> - rest |> checkMutableField ~acc:((name, type_, Immutable) :: acc) + rest |> check_mutable_field ~acc:((name, type_, Immutable) :: acc) | [] -> acc |> List.rev in let fields = - fieldsTranslations |> checkMutableField + fields_translations |> check_mutable_field |> List.map (fun (name, t, mutable_) -> let optional, type_ = match t with @@ -46,464 +46,464 @@ let translateObjType closedFlag fieldsTranslations = in { mutable_; - nameJS = name; + name_j_s = name; optional; type_; - docString = DocString.empty; + doc_string = DocString.empty; }) in - let type_ = Object (closedFlag, fields) in + let type_ = Object (closed_flag, fields) in {dependencies; type_} -let translateConstr ~config ~paramsTranslation ~(path : Path.t) ~typeEnv = - let defaultCase () = - let typeArgs = - paramsTranslation |> List.map (fun ({type_} : translation) -> type_) +let translate_constr ~config ~params_translation ~(path : Path.t) ~type_env = + let default_case () = + let type_args = + params_translation |> List.map (fun ({type_} : translation) -> type_) in - let typeParamDeps = - paramsTranslation + let type_param_deps = + params_translation |> List.map (fun {dependencies} -> dependencies) |> List.concat in - match typeEnv |> TypeEnv.applyTypeEquations ~config ~path with - | Some type_ -> {dependencies = typeParamDeps; type_} + match type_env |> TypeEnv.apply_type_equations ~config ~path with + | Some type_ -> {dependencies = type_param_deps; type_} | None -> - let dep = path |> Dependencies.fromPath ~config ~typeEnv in + let dep = path |> Dependencies.from_path ~config ~type_env in { - dependencies = dep :: typeParamDeps; - type_ = Ident {builtin = false; name = dep |> depToString; typeArgs}; + dependencies = dep :: type_param_deps; + type_ = Ident {builtin = false; name = dep |> dep_to_string; type_args}; } in - match (path |> pathToList |> List.rev, paramsTranslation) with - | (["FB"; "bool"] | ["bool"]), [] -> {dependencies = []; type_ = booleanT} - | (["FB"; "int"] | ["int"]), [] -> {dependencies = []; type_ = numberT} - | (["Int64"; "t"] | ["int64"]), [] -> {dependencies = []; type_ = int64T} - | (["FB"; "float"] | ["float"]), [] -> {dependencies = []; type_ = numberT} + match (path |> path_to_list |> List.rev, params_translation) with + | (["FB"; "bool"] | ["bool"]), [] -> {dependencies = []; type_ = boolean_t} + | (["FB"; "int"] | ["int"]), [] -> {dependencies = []; type_ = number_t} + | (["Int64"; "t"] | ["int64"]), [] -> {dependencies = []; type_ = int64_t} + | (["FB"; "float"] | ["float"]), [] -> {dependencies = []; type_ = number_t} | ( ( ["FB"; "string"] | ["string"] | ["String"; "t"] | ["Js"; ("String" | "String2"); "t"] ), [] ) -> - {dependencies = []; type_ = stringT} + {dependencies = []; type_ = string_t} | (["Js"; "Types"; "bigint_val"] | ["BigInt"; "t"]), [] -> - {dependencies = []; type_ = bigintT} + {dependencies = []; type_ = bigint_t} | (["Js"; "Date"; "t"] | ["Date"; "t"]), [] -> - {dependencies = []; type_ = dateT} - | ["Map"; "t"], [paramTranslation1; paramTranslation2] -> + {dependencies = []; type_ = date_t} + | ["Map"; "t"], [param_translation1; param_translation2] -> { dependencies = - paramTranslation1.dependencies @ paramTranslation2.dependencies; - type_ = mapT (paramTranslation1.type_, paramTranslation2.type_); + param_translation1.dependencies @ param_translation2.dependencies; + type_ = map_t (param_translation1.type_, param_translation2.type_); } - | ["WeakMap"; "t"], [paramTranslation1; paramTranslation2] -> + | ["WeakMap"; "t"], [param_translation1; param_translation2] -> { dependencies = - paramTranslation1.dependencies @ paramTranslation2.dependencies; - type_ = weakmapT (paramTranslation1.type_, paramTranslation2.type_); + param_translation1.dependencies @ param_translation2.dependencies; + type_ = weakmap_t (param_translation1.type_, param_translation2.type_); } - | ["Set"; "t"], [paramTranslation] -> + | ["Set"; "t"], [param_translation] -> { - dependencies = paramTranslation.dependencies; - type_ = setT paramTranslation.type_; + dependencies = param_translation.dependencies; + type_ = set_t param_translation.type_; } - | ["WeakSet"; "t"], [paramTranslation] -> + | ["WeakSet"; "t"], [param_translation] -> { - dependencies = paramTranslation.dependencies; - type_ = weaksetT paramTranslation.type_; + dependencies = param_translation.dependencies; + type_ = weakset_t param_translation.type_; } | (["Js"; "Re"; "t"] | ["RegExp"; "t"]), [] -> - {dependencies = []; type_ = regexpT} - | (["FB"; "unit"] | ["unit"]), [] -> {dependencies = []; type_ = unitT} + {dependencies = []; type_ = regexp_t} + | (["FB"; "unit"] | ["unit"]), [] -> {dependencies = []; type_ = unit_t} | ( (["FB"; "array"] | ["array"] | ["Js"; ("Array" | "Array2"); "t"]), - [paramTranslation] ) -> - {paramTranslation with type_ = Array (paramTranslation.type_, Mutable)} - | ["ImmutableArray"; "t"], [paramTranslation] -> - {paramTranslation with type_ = Array (paramTranslation.type_, Immutable)} - | ["Pervasives"; "ref"], [paramTranslation] -> + [param_translation] ) -> + {param_translation with type_ = Array (param_translation.type_, Mutable)} + | ["ImmutableArray"; "t"], [param_translation] -> + {param_translation with type_ = Array (param_translation.type_, Immutable)} + | ["Pervasives"; "ref"], [param_translation] -> { - dependencies = paramTranslation.dependencies; + dependencies = param_translation.dependencies; type_ = Object ( Closed, [ { mutable_ = Mutable; - nameJS = "contents"; + name_j_s = "contents"; optional = Mandatory; - type_ = paramTranslation.type_; - docString = DocString.empty; + type_ = param_translation.type_; + doc_string = DocString.empty; }; ] ); } | ( (["Pervasives"; "result"] | ["Belt"; "Result"; "t"] | ["result"]), - [paramTranslation1; paramTranslation2] ) -> - let case name type_ = {case = {labelJS = StringLabel name}; t = type_} in + [param_translation1; param_translation2] ) -> + let case name type_ = {case = {label_j_s = StringLabel name}; t = type_} in let variant = - createVariant ~inherits:[] ~noPayloads:[] + create_variant ~inherits:[] ~no_payloads:[] ~payloads: [ - case "Ok" paramTranslation1.type_; - case "Error" paramTranslation2.type_; + case "Ok" param_translation1.type_; + case "Error" param_translation2.type_; ] ~polymorphic:false ~tag:None ~unboxed:false in { dependencies = - paramTranslation1.dependencies @ paramTranslation2.dependencies; + param_translation1.dependencies @ param_translation2.dependencies; type_ = variant; } | ( (["React"; "callback"] | ["ReactV3"; "React"; "callback"]), - [fromTranslation; toTranslation] ) -> + [from_translation; to_translation] ) -> { - dependencies = fromTranslation.dependencies @ toTranslation.dependencies; + dependencies = from_translation.dependencies @ to_translation.dependencies; type_ = Function { - argTypes = [{aName = ""; aType = fromTranslation.type_}]; - retType = toTranslation.type_; - typeVars = []; + arg_types = [{a_name = ""; a_type = from_translation.type_}]; + ret_type = to_translation.type_; + type_vars = []; }; } | ( (["React"; "componentLike"] | ["ReactV3"; "React"; "componentLike"]), - [propsTranslation; retTranslation] ) -> + [props_translation; ret_translation] ) -> { - dependencies = propsTranslation.dependencies @ retTranslation.dependencies; + dependencies = props_translation.dependencies @ ret_translation.dependencies; type_ = Function { - argTypes = [{aName = ""; aType = propsTranslation.type_}]; - retType = retTranslation.type_; - typeVars = []; + arg_types = [{a_name = ""; a_type = props_translation.type_}]; + ret_type = ret_translation.type_; + type_vars = []; }; } | ( (["React"; "component"] | ["ReactV3"; "React"; "component"]), - [propsTranslation] ) -> + [props_translation] ) -> { - dependencies = propsTranslation.dependencies; + dependencies = props_translation.dependencies; type_ = Function { - argTypes = [{aName = ""; aType = propsTranslation.type_}]; - retType = EmitType.typeReactElement; - typeVars = []; + arg_types = [{a_name = ""; a_type = props_translation.type_}]; + ret_type = EmitType.type_react_element; + type_vars = []; }; } | ( (["React"; "Context"; "t"] | ["ReactV3"; "React"; "Context"; "t"]), - [paramTranslation] ) -> + [param_translation] ) -> { - dependencies = paramTranslation.dependencies; - type_ = EmitType.typeReactContext ~type_:paramTranslation.type_; + dependencies = param_translation.dependencies; + type_ = EmitType.type_react_context ~type_:param_translation.type_; } | ( ( ["React"; "Ref"; "t"] | ["React"; "ref"] | ["ReactV3"; "React"; "Ref"; "t"] | ["ReactV3"; "React"; "ref"] ), - [paramTranslation] ) -> + [param_translation] ) -> { - dependencies = paramTranslation.dependencies; - type_ = EmitType.typeReactRef ~type_:paramTranslation.type_; + dependencies = param_translation.dependencies; + type_ = EmitType.type_react_ref ~type_:param_translation.type_; } | (["ReactDOM"; "domRef"] | ["ReactDOM"; "Ref"; "t"]), [] -> - {dependencies = []; type_ = EmitType.typeReactDOMReDomRef} + {dependencies = []; type_ = EmitType.type_react_d_o_m_re_dom_ref} | ["ReactDOM"; "Ref"; "currentDomRef"], [] -> - {dependencies = []; type_ = EmitType.typeAny} + {dependencies = []; type_ = EmitType.type_any} | ["ReactDOMRe"; "domRef"], [] -> - {dependencies = []; type_ = EmitType.typeReactDOMReDomRef} + {dependencies = []; type_ = EmitType.type_react_d_o_m_re_dom_ref} | ["ReactDOMRe"; "Ref"; "currentDomRef"], [] -> - {dependencies = []; type_ = EmitType.typeAny} + {dependencies = []; type_ = EmitType.type_any} | ["ReactEvent"; "Mouse"; "t"], [] -> - {dependencies = []; type_ = EmitType.typeReactEventMouseT} + {dependencies = []; type_ = EmitType.type_react_event_mouse_t} | ( ( ["React"; "element"] | ["ReactV3"; "React"; "element"] | ["ReasonReact"; "reactElement"] ), [] ) -> - {dependencies = []; type_ = EmitType.typeReactElement} - | (["FB"; "option"] | ["option"]), [paramTranslation] -> - {paramTranslation with type_ = Option paramTranslation.type_} + {dependencies = []; type_ = EmitType.type_react_element} + | (["FB"; "option"] | ["option"]), [param_translation] -> + {param_translation with type_ = Option param_translation.type_} | ( (["Js"; "Undefined"; "t"] | ["Undefined"; "t"] | ["Js"; "undefined"]), - [paramTranslation] ) -> - {paramTranslation with type_ = Option paramTranslation.type_} - | (["Js"; "Null"; "t"] | ["Null"; "t"] | ["Js"; "null"]), [paramTranslation] + [param_translation] ) -> + {param_translation with type_ = Option param_translation.type_} + | (["Js"; "Null"; "t"] | ["Null"; "t"] | ["Js"; "null"]), [param_translation] -> - {paramTranslation with type_ = Null paramTranslation.type_} + {param_translation with type_ = Null param_translation.type_} | ( ( ["Js"; "Nullable"; "t"] | ["Nullable"; "t"] | ["Js"; "nullable"] | ["Js"; "Null_undefined"; "t"] | ["Js"; "null_undefined"] ), - [paramTranslation] ) -> - {paramTranslation with type_ = Nullable paramTranslation.type_} + [param_translation] ) -> + {param_translation with type_ = Nullable param_translation.type_} | ( (["Js"; "Promise"; "t"] | ["Promise"; "t"] | ["promise"]), - [paramTranslation] ) -> - {paramTranslation with type_ = Promise paramTranslation.type_} - | (["Js"; "Dict"; "t"] | ["Dict"; "t"] | ["dict"]), [paramTranslation] -> - {paramTranslation with type_ = Dict paramTranslation.type_} + [param_translation] ) -> + {param_translation with type_ = Promise param_translation.type_} + | (["Js"; "Dict"; "t"] | ["Dict"; "t"] | ["dict"]), [param_translation] -> + {param_translation with type_ = Dict param_translation.type_} | ["function$"], [arg; _arity] -> {dependencies = arg.dependencies; type_ = arg.type_} - | _ -> defaultCase () + | _ -> default_case () -type processVariant = { - noPayloads: string list; +type process_variant = { + no_payloads: string list; payloads: (string * Types.type_expr) list; unknowns: string list; } -let processVariant rowFields = - let rec loop ~noPayloads ~payloads ~unknowns fields = +let process_variant row_fields = + let rec loop ~no_payloads ~payloads ~unknowns fields = match fields with | ( label, ( Types.Rpresent (* no payload *) None | Reither ((* constant constructor *) true, _, _, _) ) ) - :: otherFields -> - otherFields |> loop ~noPayloads:(label :: noPayloads) ~payloads ~unknowns - | (label, Rpresent (Some payload)) :: otherFields -> - otherFields - |> loop ~noPayloads ~payloads:((label, payload) :: payloads) ~unknowns - | (label, (Rabsent | Reither (false, _, _, _))) :: otherFields -> - otherFields |> loop ~noPayloads ~payloads ~unknowns:(label :: unknowns) + :: other_fields -> + other_fields |> loop ~no_payloads:(label :: no_payloads) ~payloads ~unknowns + | (label, Rpresent (Some payload)) :: other_fields -> + other_fields + |> loop ~no_payloads ~payloads:((label, payload) :: payloads) ~unknowns + | (label, (Rabsent | Reither (false, _, _, _))) :: other_fields -> + other_fields |> loop ~no_payloads ~payloads ~unknowns:(label :: unknowns) | [] -> { - noPayloads = noPayloads |> List.rev; + no_payloads = no_payloads |> List.rev; payloads = payloads |> List.rev; unknowns = unknowns |> List.rev; } in - rowFields |> loop ~noPayloads:[] ~payloads:[] ~unknowns:[] + row_fields |> loop ~no_payloads:[] ~payloads:[] ~unknowns:[] -let rec translateArrowType ~config ~typeVarsGen ~typeEnv ~revArgDeps ~revArgs - (typeExpr : Types.type_expr) = - match typeExpr.desc with +let rec translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps ~rev_args + (type_expr : Types.type_expr) = + match type_expr.desc with | Tlink t -> - translateArrowType ~config ~typeVarsGen ~typeEnv ~revArgDeps ~revArgs t - | Tarrow (Nolabel, typeExpr1, typeExpr2, _) -> + translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps ~rev_args t + | Tarrow (Nolabel, type_expr1, type_expr2, _) -> let {dependencies; type_} = - typeExpr1 |> fun __x -> - translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv __x + type_expr1 |> fun __x -> + translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env __x in - let nextRevDeps = List.rev_append dependencies revArgDeps in - typeExpr2 - |> translateArrowType ~config ~typeVarsGen ~typeEnv ~revArgDeps:nextRevDeps - ~revArgs:((Nolabel, type_) :: revArgs) - | Tarrow (((Labelled lbl | Optional lbl) as label), typeExpr1, typeExpr2, _) + let next_rev_deps = List.rev_append dependencies rev_arg_deps in + type_expr2 + |> translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps:next_rev_deps + ~rev_args:((Nolabel, type_) :: rev_args) + | Tarrow (((Labelled lbl | Optional lbl) as label), type_expr1, type_expr2, _) -> ( - match typeExpr1 |> removeOption ~label with + match type_expr1 |> remove_option ~label with | None -> let {dependencies; type_ = type1} = - typeExpr1 |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv + type_expr1 |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env in - let nextRevDeps = List.rev_append dependencies revArgDeps in - typeExpr2 - |> translateArrowType ~config ~typeVarsGen ~typeEnv - ~revArgDeps:nextRevDeps - ~revArgs:((Label lbl, type1) :: revArgs) + let next_rev_deps = List.rev_append dependencies rev_arg_deps in + type_expr2 + |> translate_arrow_type ~config ~type_vars_gen ~type_env + ~rev_arg_deps:next_rev_deps + ~rev_args:((Label lbl, type1) :: rev_args) | Some (lbl, t1) -> let {dependencies; type_ = type1} = - t1 |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv + t1 |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env in - let nextRevDeps = List.rev_append dependencies revArgDeps in - typeExpr2 - |> translateArrowType ~config ~typeVarsGen ~typeEnv - ~revArgDeps:nextRevDeps - ~revArgs:((OptLabel lbl, type1) :: revArgs)) + let next_rev_deps = List.rev_append dependencies rev_arg_deps in + type_expr2 + |> translate_arrow_type ~config ~type_vars_gen ~type_env + ~rev_arg_deps:next_rev_deps + ~rev_args:((OptLabel lbl, type1) :: rev_args)) | _ -> - let {dependencies; type_ = retType} = - typeExpr |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv + let {dependencies; type_ = ret_type} = + type_expr |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env in - let allDeps = List.rev_append revArgDeps dependencies in - let labeledConvertableTypes = revArgs |> List.rev in - let argTypes = labeledConvertableTypes |> NamedArgs.group in - let functionType = Function {argTypes; retType; typeVars = []} in - {dependencies = allDeps; type_ = functionType} + let all_deps = List.rev_append rev_arg_deps dependencies in + let labeled_convertable_types = rev_args |> List.rev in + let arg_types = labeled_convertable_types |> NamedArgs.group in + let function_type = Function {arg_types; ret_type; type_vars = []} in + {dependencies = all_deps; type_ = function_type} -and translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv - (typeExpr : Types.type_expr) = - match typeExpr.desc with +and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env + (type_expr : Types.type_expr) = + match type_expr.desc with | Tvar None -> - let typeName = - GenIdent.jsTypeNameForAnonymousTypeID ~typeVarsGen typeExpr.id + let type_name = + GenIdent.js_type_name_for_anonymous_type_i_d ~type_vars_gen type_expr.id in - {dependencies = []; type_ = TypeVar typeName} + {dependencies = []; type_ = TypeVar type_name} | Tvar (Some s) -> {dependencies = []; type_ = TypeVar s} | Tconstr (Pdot (Pident {name = "Js"}, "t", _), [{desc = Tvar _ | Tconstr _}], _) -> (* Preserve some existing uses of Js.t(Obj.t) and Js.t('a). *) - translateObjType Closed [] + translate_obj_type Closed [] | Tconstr (Pdot (Pident {name = "Js"}, "t", _), [t], _) -> - t |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv - | Tobject (tObj, _) -> - let rec getFieldTypes (texp : Types.type_expr) = + t |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env + | Tobject (t_obj, _) -> + let rec get_field_types (texp : Types.type_expr) = match texp.desc with | Tfield (name, _, t1, t2) -> - let closedFlafg, fields = t2 |> getFieldTypes in - ( closedFlafg, + let closed_flafg, fields = t2 |> get_field_types in + ( closed_flafg, ( name, - match name |> Runtime.isMutableObjectField with + match name |> Runtime.is_mutable_object_field with | true -> {dependencies = []; type_ = ident ""} | false -> - t1 |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv ) + t1 |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env ) :: fields ) - | Tlink te -> te |> getFieldTypes + | Tlink te -> te |> get_field_types | Tvar None -> (Open, []) | _ -> (Closed, []) in - let closedFlag, fieldsTranslations = tObj |> getFieldTypes in - translateObjType closedFlag fieldsTranslations + let closed_flag, fields_translations = t_obj |> get_field_types in + translate_obj_type closed_flag fields_translations | Tconstr (path, [{desc = Tlink te}], r) -> - {typeExpr with desc = Types.Tconstr (path, [te], r)} - |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv - | Tconstr (path, typeParams, _) -> - let paramsTranslation = - typeParams |> translateTypeExprsFromTypes_ ~config ~typeVarsGen ~typeEnv + {type_expr with desc = Types.Tconstr (path, [te], r)} + |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env + | Tconstr (path, type_params, _) -> + let params_translation = + type_params |> translateTypeExprsFromTypes_ ~config ~type_vars_gen ~type_env in - translateConstr ~config ~paramsTranslation ~path ~typeEnv + translate_constr ~config ~params_translation ~path ~type_env | Tpoly (t, []) -> - t |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv + t |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env | Tarrow _ -> - typeExpr - |> translateArrowType ~config ~typeVarsGen ~typeEnv ~revArgDeps:[] - ~revArgs:[] - | Ttuple listExp -> - let innerTypesTranslation = - listExp |> translateTypeExprsFromTypes_ ~config ~typeVarsGen ~typeEnv + type_expr + |> translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps:[] + ~rev_args:[] + | Ttuple list_exp -> + let inner_types_translation = + list_exp |> translateTypeExprsFromTypes_ ~config ~type_vars_gen ~type_env in - let innerTypes = innerTypesTranslation |> List.map (fun {type_} -> type_) in - let innerTypesDeps = - innerTypesTranslation + let inner_types = inner_types_translation |> List.map (fun {type_} -> type_) in + let inner_types_deps = + inner_types_translation |> List.map (fun {dependencies} -> dependencies) |> List.concat in - let tupleType = Tuple innerTypes in - {dependencies = innerTypesDeps; type_ = tupleType} - | Tlink t -> t |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv - | Tvariant rowDesc -> ( - match rowDesc.row_fields |> processVariant with - | {noPayloads; payloads = []; unknowns = []} -> - let noPayloads = - noPayloads + let tuple_type = Tuple inner_types in + {dependencies = inner_types_deps; type_ = tuple_type} + | Tlink t -> t |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env + | Tvariant row_desc -> ( + match row_desc.row_fields |> process_variant with + | {no_payloads; payloads = []; unknowns = []} -> + let no_payloads = + no_payloads |> List.map (fun label -> { - labelJS = - (if isNumber label then IntLabel label else StringLabel label); + label_j_s = + (if is_number label then IntLabel label else StringLabel label); }) in let type_ = - createVariant ~inherits:[] ~noPayloads ~payloads:[] ~polymorphic:true + create_variant ~inherits:[] ~no_payloads ~payloads:[] ~polymorphic:true ~tag:None ~unboxed:false in {dependencies = []; type_} - | {noPayloads = []; payloads = [(_label, t)]; unknowns = []} -> + | {no_payloads = []; payloads = [(_label, t)]; unknowns = []} -> (* Handle ReScript's "Arity_" encoding in first argument of Js.Internal.fn(_,_) for uncurried functions. Return the argument tuple. *) - t |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv - | {noPayloads; payloads; unknowns = []} -> - let noPayloads = - noPayloads |> List.map (fun label -> {labelJS = StringLabel label}) + t |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env + | {no_payloads; payloads; unknowns = []} -> + let no_payloads = + no_payloads |> List.map (fun label -> {label_j_s = StringLabel label}) in - let payloadTranslations = + let payload_translations = payloads |> List.map (fun (label, payload) -> ( label, payload - |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv )) + |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env )) in let payloads = - payloadTranslations + payload_translations |> List.map (fun (label, translation) -> - {case = {labelJS = StringLabel label}; t = translation.type_}) + {case = {label_j_s = StringLabel label}; t = translation.type_}) in let type_ = - createVariant ~inherits:[] ~noPayloads ~payloads ~polymorphic:true + create_variant ~inherits:[] ~no_payloads ~payloads ~polymorphic:true ~tag:None ~unboxed:false in let dependencies = - payloadTranslations + payload_translations |> List.map (fun (_, {dependencies}) -> dependencies) |> List.concat in {dependencies; type_} | {unknowns = _ :: _} -> {dependencies = []; type_ = unknown}) | Tpackage (path, ids, types) -> ( - match typeEnv |> TypeEnv.lookupModuleTypeSignature ~path with - | Some (signature, typeEnv) -> - let typeEquationsTranslation = + match type_env |> TypeEnv.lookup_module_type_signature ~path with + | Some (signature, type_env) -> + let type_equations_translation = (List.combine ids types [@doesNotRaise]) |> List.map (fun (x, t) -> ( x, - t |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv + t |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env )) in - let typeEquations = - typeEquationsTranslation + let type_equations = + type_equations_translation |> List.map (fun (x, translation) -> (x, translation.type_)) in - let dependenciesFromTypeEquations = - typeEquationsTranslation + let dependencies_from_type_equations = + type_equations_translation |> List.map (fun (_, translation) -> translation.dependencies) |> List.flatten in - let typeEnv1 = typeEnv |> TypeEnv.addTypeEquations ~typeEquations in - let dependenciesFromRecordType, type_ = + let type_env1 = type_env |> TypeEnv.add_type_equations ~type_equations in + let dependencies_from_record_type, type_ = signature.sig_type - |> signatureToModuleRuntimeRepresentation ~config ~typeVarsGen - ~typeEnv:typeEnv1 + |> signature_to_module_runtime_representation ~config ~type_vars_gen + ~type_env:type_env1 in { - dependencies = dependenciesFromTypeEquations @ dependenciesFromRecordType; + dependencies = dependencies_from_type_equations @ dependencies_from_record_type; type_; } | None -> {dependencies = []; type_ = unknown}) | Tfield _ | Tnil | Tpoly _ | Tsubst _ | Tunivar _ -> {dependencies = []; type_ = unknown} -and translateTypeExprsFromTypes_ ~config ~typeVarsGen ~typeEnv typeExprs : +and translateTypeExprsFromTypes_ ~config ~type_vars_gen ~type_env type_exprs : translation list = - typeExprs - |> List.map (translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv) + type_exprs + |> List.map (translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env) -and signatureToModuleRuntimeRepresentation ~config ~typeVarsGen ~typeEnv +and signature_to_module_runtime_representation ~config ~type_vars_gen ~type_env signature = - let dependenciesAndFields = + let dependencies_and_fields = signature - |> List.map (fun signatureItem -> - match signatureItem with + |> List.map (fun signature_item -> + match signature_item with | Types.Sig_value (_id, {val_kind = Val_prim _}) -> ([], []) - | Types.Sig_value (id, {val_type = typeExpr; val_attributes}) -> + | Types.Sig_value (id, {val_type = type_expr; val_attributes}) -> let {dependencies; type_} = - typeExpr - |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv + type_expr + |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env in let field = { mutable_ = Immutable; - nameJS = id |> Ident.name; + name_j_s = id |> Ident.name; optional = Mandatory; type_; - docString = Annotation.docStringFromAttrs val_attributes; + doc_string = Annotation.doc_string_from_attrs val_attributes; } in (dependencies, [field]) - | Types.Sig_module (id, moduleDeclaration, _recStatus) -> - let typeEnv1 = - match typeEnv |> TypeEnv.getModule ~name:(id |> Ident.name) with - | Some typeEnv1 -> typeEnv1 - | None -> typeEnv + | Types.Sig_module (id, module_declaration, _recStatus) -> + let type_env1 = + match type_env |> TypeEnv.get_module ~name:(id |> Ident.name) with + | Some type_env1 -> type_env1 + | None -> type_env in let dependencies, type_ = - match moduleDeclaration.md_type with + match module_declaration.md_type with | Mty_signature signature -> signature - |> signatureToModuleRuntimeRepresentation ~config ~typeVarsGen - ~typeEnv:typeEnv1 + |> signature_to_module_runtime_representation ~config ~type_vars_gen + ~type_env:type_env1 | Mty_ident _ | Mty_functor _ | Mty_alias _ -> ([], unknown) in let field = { mutable_ = Immutable; - nameJS = id |> Ident.name; + name_j_s = id |> Ident.name; optional = Mandatory; type_; - docString = - Annotation.docStringFromAttrs moduleDeclaration.md_attributes; + doc_string = + Annotation.doc_string_from_attrs module_declaration.md_attributes; } in (dependencies, [field]) @@ -512,30 +512,30 @@ and signatureToModuleRuntimeRepresentation ~config ~typeVarsGen ~typeEnv ([], [])) in let dependencies, fields = - let dl, fl = dependenciesAndFields |> List.split in + let dl, fl = dependencies_and_fields |> List.split in (dl |> List.concat, fl |> List.concat) in (dependencies, Object (Closed, fields)) -let translateTypeExprFromTypes ~config ~typeEnv typeExpr = - let typeVarsGen = GenIdent.createTypeVarsGen () in +let translate_type_expr_from_types ~config ~type_env type_expr = + let type_vars_gen = GenIdent.create_type_vars_gen () in let translation = - typeExpr |> translateTypeExprFromTypes_ ~config ~typeVarsGen ~typeEnv + type_expr |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env in if !Debug.dependencies then translation.dependencies - |> List.iter (fun dep -> Log_.item "Dependency: %s\n" (dep |> depToString)); + |> List.iter (fun dep -> Log_.item "Dependency: %s\n" (dep |> dep_to_string)); translation -let translateTypeExprsFromTypes ~config ~typeEnv typeExprs = - let typeVarsGen = GenIdent.createTypeVarsGen () in +let translate_type_exprs_from_types ~config ~type_env type_exprs = + let type_vars_gen = GenIdent.create_type_vars_gen () in let translations = - typeExprs |> translateTypeExprsFromTypes_ ~config ~typeVarsGen ~typeEnv + type_exprs |> translateTypeExprsFromTypes_ ~config ~type_vars_gen ~type_env in if !Debug.dependencies then translations |> List.iter (fun translation -> translation.dependencies |> List.iter (fun dep -> - Log_.item "Dependency: %s\n" (dep |> depToString))); + Log_.item "Dependency: %s\n" (dep |> dep_to_string))); translations diff --git a/jscomp/gentype/Translation.ml b/jscomp/gentype/Translation.ml index 64eabdb37d..658739c9d9 100644 --- a/jscomp/gentype/Translation.ml +++ b/jscomp/gentype/Translation.ml @@ -2,206 +2,206 @@ open GenTypeCommon type t = CodeItem.translation -let empty = ({importTypes = []; codeItems = []; typeDeclarations = []} : t) +let empty = ({import_types = []; code_items = []; type_declarations = []} : t) -let getImportTypeUniqueName ({typeName; asTypeName} : CodeItem.importType) = - typeName +let get_import_type_unique_name ({type_name; as_type_name} : CodeItem.import_type) = + type_name ^ - match asTypeName with + match as_type_name with | None -> "" | Some s -> "_as_" ^ s -let importTypeCompare i1 i2 = - compare (i1 |> getImportTypeUniqueName) (i2 |> getImportTypeUniqueName) +let import_type_compare i1 i2 = + compare (i1 |> get_import_type_unique_name) (i2 |> get_import_type_unique_name) let combine (translations : t list) : t = ( translations - |> List.map (fun {CodeItem.importTypes; codeItems; typeDeclarations} -> - ((importTypes, codeItems), typeDeclarations)) + |> List.map (fun {CodeItem.import_types; code_items; type_declarations} -> + ((import_types, code_items), type_declarations)) |> List.split |> fun (x, y) -> (x |> List.split, y) ) - |> fun ((importTypes, codeItems), typeDeclarations) -> + |> fun ((import_types, code_items), type_declarations) -> { - CodeItem.importTypes = importTypes |> List.concat; - codeItems = codeItems |> List.concat; - typeDeclarations = typeDeclarations |> List.concat; + CodeItem.import_types = import_types |> List.concat; + code_items = code_items |> List.concat; + type_declarations = type_declarations |> List.concat; } (** Applies type parameters to types (for all) *) -let abstractTheTypeParameters ~typeVars type_ = +let abstract_the_type_parameters ~type_vars type_ = match type_ with - | Function function_ -> Function {function_ with typeVars} + | Function function_ -> Function {function_ with type_vars} | _ -> type_ -let depToImportType ~config ~outputFileRelative ~resolver (dep : dep) = +let dep_to_import_type ~config ~output_file_relative ~resolver (dep : dep) = match dep with - | _ when dep |> Dependencies.isInternal -> [] + | _ when dep |> Dependencies.is_internal -> [] | External name when name = "list" -> [ { - CodeItem.typeName = "list"; - asTypeName = None; - importPath = - ModuleName.rescriptPervasives - |> ModuleResolver.importPathForReasonModuleName ~config - ~outputFileRelative ~resolver; + CodeItem.type_name = "list"; + as_type_name = None; + import_path = + ModuleName.rescript_pervasives + |> ModuleResolver.import_path_for_reason_module_name ~config + ~output_file_relative ~resolver; }; ] | External _ -> [] | Internal _ -> [] | Dot _ -> - let moduleName = dep |> Dependencies.getOuterModuleName in - let typeName = - dep |> Dependencies.removeExternalOuterModule |> depToString + let module_name = dep |> Dependencies.get_outer_module_name in + let type_name = + dep |> Dependencies.remove_external_outer_module |> dep_to_string in - let asTypeName = - match dep |> Dependencies.isInternal with + let as_type_name = + match dep |> Dependencies.is_internal with | true -> None - | false -> Some (dep |> depToString) + | false -> Some (dep |> dep_to_string) in - let importPath = - moduleName - |> ModuleResolver.importPathForReasonModuleName ~config - ~outputFileRelative ~resolver + let import_path = + module_name + |> ModuleResolver.import_path_for_reason_module_name ~config + ~output_file_relative ~resolver in - [{typeName; asTypeName; importPath}] + [{type_name; as_type_name; import_path}] -let translateDependencies ~config ~outputFileRelative ~resolver dependencies : - CodeItem.importType list = +let translate_dependencies ~config ~output_file_relative ~resolver dependencies : + CodeItem.import_type list = dependencies - |> List.map (depToImportType ~config ~outputFileRelative ~resolver) + |> List.map (dep_to_import_type ~config ~output_file_relative ~resolver) |> List.concat -let translateValue ~attributes ~config ~docString ~outputFileRelative ~resolver - ~typeEnv ~typeExpr ~(addAnnotationsToFunction : type_ -> type_) name : t = - let nameAs = - match Annotation.getGenTypeAsRenaming attributes with +let translate_value ~attributes ~config ~doc_string ~output_file_relative ~resolver + ~type_env ~type_expr ~(add_annotations_to_function : type_ -> type_) name : t = + let name_as = + match Annotation.get_gen_type_as_renaming attributes with | Some s -> s | _ -> name in - let typeExprTranslation = - typeExpr - |> TranslateTypeExprFromTypes.translateTypeExprFromTypes ~config ~typeEnv + let type_expr_translation = + type_expr + |> TranslateTypeExprFromTypes.translate_type_expr_from_types ~config ~type_env in - let typeVars = typeExprTranslation.type_ |> TypeVars.free in + let type_vars = type_expr_translation.type_ |> TypeVars.free in let type_ = - typeExprTranslation.type_ - |> abstractTheTypeParameters ~typeVars - |> addAnnotationsToFunction + type_expr_translation.type_ + |> abstract_the_type_parameters ~type_vars + |> add_annotations_to_function in - let resolvedNameOriginal = - name |> TypeEnv.addModulePath ~typeEnv |> ResolvedName.toString + let resolved_name_original = + name |> TypeEnv.add_module_path ~type_env |> ResolvedName.to_string in - let resolvedName = nameAs |> TypeEnv.addModulePath ~typeEnv in - let moduleAccessPath = - typeEnv |> TypeEnv.getModuleAccessPath ~name:resolvedNameOriginal + let resolved_name = name_as |> TypeEnv.add_module_path ~type_env in + let module_access_path = + type_env |> TypeEnv.get_module_access_path ~name:resolved_name_original in - let codeItems = + let code_items = [ CodeItem.ExportValue - {docString; moduleAccessPath; originalName = name; resolvedName; type_}; + {doc_string; module_access_path; original_name = name; resolved_name; type_}; ] in { - importTypes = - typeExprTranslation.dependencies - |> translateDependencies ~config ~outputFileRelative ~resolver; - codeItems; - typeDeclarations = []; + import_types = + type_expr_translation.dependencies + |> translate_dependencies ~config ~output_file_relative ~resolver; + code_items; + type_declarations = []; } (** [@genType] [@module] external myBanner : ReasonReact.reactClass = "./MyBanner"; *) -let translatePrimitive ~config ~outputFileRelative ~resolver ~typeEnv - (valueDescription : Typedtree.value_description) : t = +let translate_primitive ~config ~output_file_relative ~resolver ~type_env + (value_description : Typedtree.value_description) : t = if !Debug.translation then Log_.item "Translate Primitive\n"; - let valueName = - match valueDescription.val_prim with - | "" :: _ | [] -> valueDescription.val_id |> Ident.name - | nameOfExtern :: _ -> + let value_name = + match value_description.val_prim with + | "" :: _ | [] -> value_description.val_id |> Ident.name + | name_of_extern :: _ -> (* extern foo : someType = "abc" The first element of val_prim is "abc" *) - nameOfExtern + name_of_extern in - let typeExprTranslation = - valueDescription.val_desc - |> TranslateCoreType.translateCoreType ~config ~typeEnv + let type_expr_translation = + value_description.val_desc + |> TranslateCoreType.translate_core_type ~config ~type_env in - let attributeImport, attributeRenaming = - valueDescription.val_attributes |> Annotation.getAttributeImportRenaming + let attribute_import, attribute_renaming = + value_description.val_attributes |> Annotation.get_attribute_import_renaming in - match (typeExprTranslation.type_, attributeImport) with - | _, Some importString -> - let asPath = - match attributeRenaming with - | Some asPath -> asPath - | None -> valueName + match (type_expr_translation.type_, attribute_import) with + | _, Some import_string -> + let as_path = + match attribute_renaming with + | Some as_path -> as_path + | None -> value_name in - let typeVars = typeExprTranslation.type_ |> TypeVars.free in + let type_vars = type_expr_translation.type_ |> TypeVars.free in let type_ = - typeExprTranslation.type_ |> abstractTheTypeParameters ~typeVars + type_expr_translation.type_ |> abstract_the_type_parameters ~type_vars in { - importTypes = - typeExprTranslation.dependencies - |> translateDependencies ~config ~outputFileRelative ~resolver; - codeItems = + import_types = + type_expr_translation.dependencies + |> translate_dependencies ~config ~output_file_relative ~resolver; + code_items = [ ImportValue { - asPath; - importAnnotation = importString |> Annotation.importFromString; + as_path; + import_annotation = import_string |> Annotation.import_from_string; type_; - valueName; + value_name; }; ]; - typeDeclarations = []; + type_declarations = []; } - | _ -> {importTypes = []; codeItems = []; typeDeclarations = []} + | _ -> {import_types = []; code_items = []; type_declarations = []} -let addTypeDeclarationsFromModuleEquations ~typeEnv (translation : t) = - let eqs = typeEnv |> TypeEnv.getModuleEquations in - let newTypeDeclarations = - translation.typeDeclarations - |> List.map (fun (typeDeclaration : CodeItem.typeDeclaration) -> - let exportType = - typeDeclaration.exportFromTypeDeclaration.exportType +let add_type_declarations_from_module_equations ~type_env (translation : t) = + let eqs = type_env |> TypeEnv.get_module_equations in + let new_type_declarations = + translation.type_declarations + |> List.map (fun (type_declaration : CodeItem.type_declaration) -> + let export_type = + type_declaration.export_from_type_declaration.export_type in let equations = - exportType.resolvedTypeName |> ResolvedName.applyEquations ~eqs + export_type.resolved_type_name |> ResolvedName.apply_equations ~eqs in equations |> List.map (fun (x, y) -> - let newExportType = + let new_export_type = { - exportType with - nameAs = None; + export_type with + name_as = None; type_ = - y |> ResolvedName.toString + y |> ResolvedName.to_string |> ident ~builtin:false - ~typeArgs: - (exportType.typeVars + ~type_args: + (export_type.type_vars |> List.map (fun s -> TypeVar s)); - resolvedTypeName = x; + resolved_type_name = x; } in { - CodeItem.exportFromTypeDeclaration = + CodeItem.export_from_type_declaration = { - CodeItem.exportType = newExportType; + CodeItem.export_type = new_export_type; annotation = - typeDeclaration.exportFromTypeDeclaration.annotation; + type_declaration.export_from_type_declaration.annotation; }; - importTypes = []; + import_types = []; })) |> List.concat in - match newTypeDeclarations = [] with + match new_type_declarations = [] with | true -> translation | false -> { translation with - typeDeclarations = translation.typeDeclarations @ newTypeDeclarations; + type_declarations = translation.type_declarations @ new_type_declarations; } diff --git a/jscomp/gentype/TypeEnv.ml b/jscomp/gentype/TypeEnv.ml index 693d1540e2..3875a99497 100644 --- a/jscomp/gentype/TypeEnv.ml +++ b/jscomp/gentype/TypeEnv.ml @@ -1,198 +1,198 @@ open GenTypeCommon -type moduleEquation = {internal: bool; dep: dep} +type module_equation = {internal: bool; dep: dep} type t = { mutable map: entry StringMap.t; - mutable mapModuleTypes: (Typedtree.signature * t) StringMap.t; - mutable moduleEquation: moduleEquation option; - mutable moduleItem: Runtime.moduleItem; + mutable map_module_types: (Typedtree.signature * t) StringMap.t; + mutable module_equation: module_equation option; + mutable module_item: Runtime.module_item; name: string; parent: t option; - typeEquations: type_ StringMap.t; + type_equations: type_ StringMap.t; } and entry = Module of t | Type of string -let createTypeEnv ~name parent = - let moduleItem = Runtime.newModuleItem ~name in +let create_type_env ~name parent = + let module_item = Runtime.new_module_item ~name in { map = StringMap.empty; - mapModuleTypes = StringMap.empty; - moduleEquation = None; - moduleItem; + map_module_types = StringMap.empty; + module_equation = None; + module_item; name; parent; - typeEquations = StringMap.empty; + type_equations = StringMap.empty; } -let root () = None |> createTypeEnv ~name:"__root__" -let toString typeEnv = typeEnv.name - -let newModule ~name typeEnv = - if !Debug.typeEnv then - Log_.item "TypeEnv.newModule %s %s\n" (typeEnv |> toString) name; - let newTypeEnv = Some typeEnv |> createTypeEnv ~name in - typeEnv.map <- typeEnv.map |> StringMap.add name (Module newTypeEnv); - newTypeEnv - -let newModuleType ~name ~signature typeEnv = - if !Debug.typeEnv then - Log_.item "TypeEnv.newModuleType %s %s\n" (typeEnv |> toString) name; - let newTypeEnv = Some typeEnv |> createTypeEnv ~name in - typeEnv.mapModuleTypes <- - typeEnv.mapModuleTypes |> StringMap.add name (signature, newTypeEnv); - newTypeEnv - -let newType ~name typeEnv = - if !Debug.typeEnv then - Log_.item "TypeEnv.newType %s %s\n" (typeEnv |> toString) name; - typeEnv.map <- typeEnv.map |> StringMap.add name (Type name) - -let getModule ~name typeEnv = - match typeEnv.map |> StringMap.find name with - | Module typeEnv1 -> Some typeEnv1 +let root () = None |> create_type_env ~name:"__root__" +let to_string type_env = type_env.name + +let new_module ~name type_env = + if !Debug.type_env then + Log_.item "TypeEnv.newModule %s %s\n" (type_env |> to_string) name; + let new_type_env = Some type_env |> create_type_env ~name in + type_env.map <- type_env.map |> StringMap.add name (Module new_type_env); + new_type_env + +let new_module_type ~name ~signature type_env = + if !Debug.type_env then + Log_.item "TypeEnv.newModuleType %s %s\n" (type_env |> to_string) name; + let new_type_env = Some type_env |> create_type_env ~name in + type_env.map_module_types <- + type_env.map_module_types |> StringMap.add name (signature, new_type_env); + new_type_env + +let new_type ~name type_env = + if !Debug.type_env then + Log_.item "TypeEnv.newType %s %s\n" (type_env |> to_string) name; + type_env.map <- type_env.map |> StringMap.add name (Type name) + +let get_module ~name type_env = + match type_env.map |> StringMap.find name with + | Module type_env1 -> Some type_env1 | Type _ -> None | exception Not_found -> None -let expandAliasToExternalModule ~name typeEnv = - match typeEnv |> getModule ~name with - | Some {moduleEquation = Some {internal = false; dep}} -> - if !Debug.typeEnv then +let expand_alias_to_external_module ~name type_env = + match type_env |> get_module ~name with + | Some {module_equation = Some {internal = false; dep}} -> + if !Debug.type_env then Log_.item "TypeEnv.expandAliasToExternalModule %s %s aliased to %s\n" - (typeEnv |> toString) name (dep |> depToString); + (type_env |> to_string) name (dep |> dep_to_string); Some dep | _ -> None -let addModuleEquation ~dep ~internal typeEnv = - if !Debug.typeEnv then - Log_.item "Typenv.addModuleEquation %s %s dep:%s\n" (typeEnv |> toString) +let add_module_equation ~dep ~internal type_env = + if !Debug.type_env then + Log_.item "Typenv.addModuleEquation %s %s dep:%s\n" (type_env |> to_string) (match internal with | true -> "Internal" | false -> "External") - (dep |> depToString); - typeEnv.moduleEquation <- Some {internal; dep} + (dep |> dep_to_string); + type_env.module_equation <- Some {internal; dep} -let rec addTypeEquation ~flattened ~type_ typeEnv = +let rec add_type_equation ~flattened ~type_ type_env = match flattened with | [name] -> { - typeEnv with - typeEquations = typeEnv.typeEquations |> StringMap.add name type_; + type_env with + type_equations = type_env.type_equations |> StringMap.add name type_; } - | moduleName :: rest -> ( - match typeEnv |> getModule ~name:moduleName with - | Some typeEnv1 -> + | module_name :: rest -> ( + match type_env |> get_module ~name:module_name with + | Some type_env1 -> { - typeEnv with + type_env with map = - typeEnv.map - |> StringMap.add moduleName - (Module (typeEnv1 |> addTypeEquation ~flattened:rest ~type_)); + type_env.map + |> StringMap.add module_name + (Module (type_env1 |> add_type_equation ~flattened:rest ~type_)); } - | None -> typeEnv) - | [] -> typeEnv + | None -> type_env) + | [] -> type_env -let addTypeEquations ~typeEquations typeEnv = - typeEquations +let add_type_equations ~type_equations type_env = + type_equations |> List.fold_left - (fun te (longIdent, type_) -> + (fun te (long_ident, type_) -> te - |> addTypeEquation ~flattened:(longIdent |> Longident.flatten) ~type_) - typeEnv + |> add_type_equation ~flattened:(long_ident |> Longident.flatten) ~type_) + type_env -let applyTypeEquations ~config ~path typeEnv = +let apply_type_equations ~config ~path type_env = match path with | Path.Pident id -> ( - match typeEnv.typeEquations |> StringMap.find (id |> Ident.name) with + match type_env.type_equations |> StringMap.find (id |> Ident.name) with | type_ -> - if !Debug.typeResolution then + if !Debug.type_resolution then Log_.item "Typenv.applyTypeEquations %s name:%s type_:%s\n" - (typeEnv |> toString) (id |> Ident.name) + (type_env |> to_string) (id |> Ident.name) (type_ - |> EmitType.typeToString ~config ~typeNameIsInterface:(fun _ -> false) + |> EmitType.type_to_string ~config ~type_name_is_interface:(fun _ -> false) ); Some type_ | exception Not_found -> None) | _ -> None -let rec lookup ~name typeEnv = - match typeEnv.map |> StringMap.find name with - | _ -> Some typeEnv +let rec lookup ~name type_env = + match type_env.map |> StringMap.find name with + | _ -> Some type_env | exception Not_found -> ( - match typeEnv.parent with + match type_env.parent with | None -> None | Some parent -> parent |> lookup ~name) -let rec lookupModuleType ~path typeEnv = +let rec lookup_module_type ~path type_env = match path with - | [moduleTypeName] -> ( - if !Debug.typeEnv then + | [module_type_name] -> ( + if !Debug.type_env then Log_.item "Typenv.lookupModuleType %s moduleTypeName:%s\n" - (typeEnv |> toString) moduleTypeName; - match typeEnv.mapModuleTypes |> StringMap.find moduleTypeName with + (type_env |> to_string) module_type_name; + match type_env.map_module_types |> StringMap.find module_type_name with | x -> Some x | exception Not_found -> ( - match typeEnv.parent with + match type_env.parent with | None -> None - | Some parent -> parent |> lookupModuleType ~path)) - | moduleName :: path1 -> ( - if !Debug.typeEnv then + | Some parent -> parent |> lookup_module_type ~path)) + | module_name :: path1 -> ( + if !Debug.type_env then Log_.item "Typenv.lookupModuleType %s moduleName:%s\n" - (typeEnv |> toString) moduleName; - match typeEnv.map |> StringMap.find moduleName with - | Module typeEnv1 -> typeEnv1 |> lookupModuleType ~path:path1 + (type_env |> to_string) module_name; + match type_env.map |> StringMap.find module_name with + | Module type_env1 -> type_env1 |> lookup_module_type ~path:path1 | Type _ -> None | exception Not_found -> ( - match typeEnv.parent with + match type_env.parent with | None -> None - | Some parent -> parent |> lookupModuleType ~path)) + | Some parent -> parent |> lookup_module_type ~path)) | [] -> None -let rec pathToList path = +let rec path_to_list path = match path with | Path.Pident id -> [id |> Ident.name] - | Path.Pdot (p, s, _) -> s :: (p |> pathToList) + | Path.Pdot (p, s, _) -> s :: (p |> path_to_list) | Path.Papply _ -> [] -let lookupModuleTypeSignature ~path typeEnv = - if !Debug.typeEnv then - Log_.item "TypeEnv.lookupModuleTypeSignature %s %s\n" (typeEnv |> toString) +let lookup_module_type_signature ~path type_env = + if !Debug.type_env then + Log_.item "TypeEnv.lookupModuleTypeSignature %s %s\n" (type_env |> to_string) (path |> Path.name); - typeEnv |> lookupModuleType ~path:(path |> pathToList |> List.rev) + type_env |> lookup_module_type ~path:(path |> path_to_list |> List.rev) -let updateModuleItem ~moduleItem typeEnv = typeEnv.moduleItem <- moduleItem +let update_module_item ~module_item type_env = type_env.module_item <- module_item -let rec addModulePath ~typeEnv name = - match typeEnv.parent with - | None -> name |> ResolvedName.fromString +let rec add_module_path ~type_env name = + match type_env.parent with + | None -> name |> ResolvedName.from_string | Some parent -> - typeEnv.name |> addModulePath ~typeEnv:parent |> ResolvedName.dot name + type_env.name |> add_module_path ~type_env:parent |> ResolvedName.dot name -let rec getModuleEquations typeEnv : ResolvedName.eq list = - let subEquations = - typeEnv.map |> StringMap.bindings +let rec get_module_equations type_env : ResolvedName.eq list = + let sub_equations = + type_env.map |> StringMap.bindings |> List.map (fun (_, entry) -> match entry with - | Module te -> te |> getModuleEquations + | Module te -> te |> get_module_equations | Type _ -> []) |> List.concat in - match (typeEnv.moduleEquation, typeEnv.parent) with - | None, _ | _, None -> subEquations + match (type_env.module_equation, type_env.parent) with + | None, _ | _, None -> sub_equations | Some {dep}, Some parent -> - [(dep |> depToResolvedName, typeEnv.name |> addModulePath ~typeEnv:parent)] + [(dep |> dep_to_resolved_name, type_env.name |> add_module_path ~type_env:parent)] -let getModuleAccessPath ~name typeEnv = - let rec accessPath typeEnv = - match typeEnv.parent with +let get_module_access_path ~name type_env = + let rec access_path type_env = + match type_env.parent with | None -> Runtime.Root name (* not nested *) | Some parent -> Dot ( (match parent.parent = None with - | true -> Root typeEnv.name - | false -> parent |> accessPath), - typeEnv.moduleItem ) + | true -> Root type_env.name + | false -> parent |> access_path), + type_env.module_item ) in - typeEnv |> accessPath + type_env |> access_path diff --git a/jscomp/gentype/TypeEnv.mli b/jscomp/gentype/TypeEnv.mli index c56558ef29..724bfbc5f9 100644 --- a/jscomp/gentype/TypeEnv.mli +++ b/jscomp/gentype/TypeEnv.mli @@ -2,22 +2,22 @@ open GenTypeCommon type t -val addModuleEquation : dep:dep -> internal:bool -> t -> unit -val addModulePath : typeEnv:t -> string -> ResolvedName.t -val addTypeEquations : typeEquations:(Longident.t * type_) list -> t -> t -val applyTypeEquations : config:Config.t -> path:Path.t -> t -> type_ option -val expandAliasToExternalModule : name:string -> t -> dep option -val getModuleEquations : t -> ResolvedName.eq list -val getModuleAccessPath : name:string -> t -> Runtime.moduleAccessPath -val getModule : name:string -> t -> t option +val add_module_equation : dep:dep -> internal:bool -> t -> unit +val add_module_path : type_env:t -> string -> ResolvedName.t +val add_type_equations : type_equations:(Longident.t * type_) list -> t -> t +val apply_type_equations : config:Config.t -> path:Path.t -> t -> type_ option +val expand_alias_to_external_module : name:string -> t -> dep option +val get_module_equations : t -> ResolvedName.eq list +val get_module_access_path : name:string -> t -> Runtime.module_access_path +val get_module : name:string -> t -> t option val lookup : name:string -> t -> t option -val lookupModuleTypeSignature : +val lookup_module_type_signature : path:Path.t -> t -> (Typedtree.signature * t) option -val newModule : name:string -> t -> t -val newModuleType : name:string -> signature:Typedtree.signature -> t -> t -val newType : name:string -> t -> unit +val new_module : name:string -> t -> t +val new_module_type : name:string -> signature:Typedtree.signature -> t -> t +val new_type : name:string -> t -> unit val root : unit -> t -val toString : t -> string -val updateModuleItem : moduleItem:Runtime.moduleItem -> t -> unit +val to_string : t -> string +val update_module_item : module_item:Runtime.module_item -> t -> unit diff --git a/jscomp/gentype/TypeVars.ml b/jscomp/gentype/TypeVars.ml index 3957362cb7..98508da4f6 100644 --- a/jscomp/gentype/TypeVars.ml +++ b/jscomp/gentype/TypeVars.ml @@ -1,59 +1,59 @@ open GenTypeCommon -let extractFromTypeExpr typeParams = - typeParams +let extract_from_type_expr type_params = + type_params |> List.fold_left - (fun soFar typeExpr -> - match typeExpr with + (fun so_far type_expr -> + match type_expr with | {Types.desc = Tvar (Some s)} -> - let typeName = s in - typeName :: soFar + let type_name = s in + type_name :: so_far | {Types.desc = Tlink _} -> (* see if we need to collect more type vars here: t as 'a *) - soFar + so_far | _ -> assert false) [] |> List.rev -let extractFromCoreType typeParams = - typeParams +let extract_from_core_type type_params = + type_params |> List.fold_left - (fun soFar typeExpr -> - match typeExpr.Typedtree.ctyp_desc with + (fun so_far type_expr -> + match type_expr.Typedtree.ctyp_desc with | Ttyp_var s -> - let typeName = s in - typeName :: soFar - | _ -> soFar) + let type_name = s in + type_name :: so_far + | _ -> so_far) [] |> List.rev let rec substitute ~f type0 = match type0 with - | Array (t, arrayKind) -> Array (t |> substitute ~f, arrayKind) + | Array (t, array_kind) -> Array (t |> substitute ~f, array_kind) | Dict type_ -> Dict (type_ |> substitute ~f) | Function function_ -> Function { function_ with - argTypes = - function_.argTypes - |> List.map (fun {aName; aType = t} -> - {aName; aType = t |> substitute ~f}); + arg_types = + function_.arg_types + |> List.map (fun {a_name; a_type = t} -> + {a_name; a_type = t |> substitute ~f}); } - | Ident {typeArgs = []} -> type0 - | Ident ({typeArgs} as ident) -> - Ident {ident with typeArgs = typeArgs |> List.map (substitute ~f)} + | Ident {type_args = []} -> type0 + | Ident ({type_args} as ident) -> + Ident {ident with type_args = type_args |> List.map (substitute ~f)} | Null type_ -> Null (type_ |> substitute ~f) | Nullable type_ -> Nullable (type_ |> substitute ~f) - | Object (closedFlag, fields) -> + | Object (closed_flag, fields) -> Object - ( closedFlag, + ( closed_flag, fields |> List.map (fun field -> {field with type_ = field.type_ |> substitute ~f}) ) | Option type_ -> Option (type_ |> substitute ~f) | Promise type_ -> Promise (type_ |> substitute ~f) - | Tuple innerTypes -> Tuple (innerTypes |> List.map (substitute ~f)) + | Tuple inner_types -> Tuple (inner_types |> List.map (substitute ~f)) | TypeVar s -> ( match f s with | None -> type0 @@ -71,26 +71,26 @@ let rec substitute ~f type0 = let rec free_ type0 : StringSet.t = match type0 with | Array (t, _) -> t |> free_ - | Function {argTypes; retType; typeVars} -> + | Function {arg_types; ret_type; type_vars} -> StringSet.diff - ((argTypes |> freeOfList_) +++ (retType |> free_)) - (typeVars |> StringSet.of_list) + ((arg_types |> freeOfList_) +++ (ret_type |> free_)) + (type_vars |> StringSet.of_list) | Object (_, fields) -> fields |> List.fold_left (fun s {type_} -> StringSet.union s (type_ |> free_)) StringSet.empty - | Ident {typeArgs} -> - typeArgs + | Ident {type_args} -> + type_args |> List.fold_left - (fun s typeArg -> StringSet.union s (typeArg |> free_)) + (fun s type_arg -> StringSet.union s (type_arg |> free_)) StringSet.empty | Dict type_ | Null type_ | Nullable type_ -> type_ |> free_ | Option type_ | Promise type_ -> type_ |> free_ - | Tuple innerTypes -> - innerTypes + | Tuple inner_types -> + inner_types |> List.fold_left - (fun s typeArg -> StringSet.union s (typeArg |> free_)) + (fun s type_arg -> StringSet.union s (type_arg |> free_)) StringSet.empty | TypeVar s -> s |> StringSet.singleton | Variant {payloads} -> @@ -101,7 +101,7 @@ let rec free_ type0 : StringSet.t = and freeOfList_ types = types - |> List.fold_left (fun s {aType} -> s +++ (aType |> free_)) StringSet.empty + |> List.fold_left (fun s {a_type} -> s +++ (a_type |> free_)) StringSet.empty and ( +++ ) = StringSet.union diff --git a/jscomp/jsoo/jsoo_playground_main.ml b/jscomp/jsoo/jsoo_playground_main.ml index 0bc73daf12..4b0399c959 100644 --- a/jscomp/jsoo/jsoo_playground_main.ml +++ b/jscomp/jsoo/jsoo_playground_main.ml @@ -51,7 +51,7 @@ * v4: Added `config.open_modules` to the BundleConfig to enable implicitly opened * modules in the playground. * *) -let apiVersion = "4" +let api_version = "4" module Js = Js_of_ocaml.Js @@ -62,12 +62,12 @@ let export (field : string) v = module Lang = struct type t = OCaml | Res - let fromString t = match t with + let from_string t = match t with | "ocaml" | "ml" -> Some OCaml | "res" -> Some Res | _ -> None - let toString t = match t with + let to_string t = match t with | OCaml -> "ml" | Res -> "res" end @@ -94,7 +94,7 @@ module BundleConfig = struct } - let default_filename (lang: Lang.t) = "playground." ^ (Lang.toString lang) + let default_filename (lang: Lang.t) = "playground." ^ (Lang.to_string lang) let string_of_module_system m = (match m with | Ext_module_system.Commonjs -> "nodejs" @@ -102,97 +102,97 @@ module BundleConfig = struct | Es6_global -> "es6_global") end -type locErrInfo = { - fullMsg: string; (* Full report string with all context *) - shortMsg: string; (* simple explain message without any extra context *) +type loc_err_info = { + full_msg: string; (* Full report string with all context *) + short_msg: string; (* simple explain message without any extra context *) loc: Location.t; } module LocWarnInfo = struct type t = { - fullMsg: string; (* Full super_error related warn string *) - shortMsg: string; (* Plain warn message without any context *) - warnNumber: int; - isError: bool; + full_msg: string; (* Full super_error related warn string *) + short_msg: string; (* Plain warn message without any context *) + warn_number: int; + is_error: bool; loc: Location.t; } end -exception RescriptParsingErrors of locErrInfo list +exception RescriptParsingErrors of loc_err_info list module ErrorRet = struct - let locErrorAttributes ~(type_: string) ~(fullMsg: string) ~(shortMsg: string) (loc: Location.t) = + let loc_error_attributes ~(type_: string) ~(full_msg: string) ~(short_msg: string) (loc: Location.t) = let (_file,line,startchar) = Location.get_pos_info loc.Location.loc_start in let (_file,endline,endchar) = Location.get_pos_info loc.Location.loc_end in Js.Unsafe.([| - "fullMsg", inject @@ Js.string fullMsg; + "fullMsg", inject @@ Js.string full_msg; "row" , inject line; "column" , inject startchar; "endRow" , inject endline; "endColumn" , inject endchar; - "shortMsg" , inject @@ Js.string shortMsg; + "shortMsg" , inject @@ Js.string short_msg; "type" , inject @@ Js.string type_; |]) - let makeWarning (e: LocWarnInfo.t) = - let locAttrs = locErrorAttributes + let make_warning (e: LocWarnInfo.t) = + let loc_attrs = loc_error_attributes ~type_:"warning" - ~fullMsg: e.fullMsg - ~shortMsg: e.shortMsg + ~full_msg: e.full_msg + ~short_msg: e.short_msg e.loc in - let warnAttrs = Js.Unsafe.([| - "warnNumber", inject @@ (e.warnNumber |> float_of_int |> Js.number_of_float); - "isError", inject @@ Js.bool e.isError; + let warn_attrs = Js.Unsafe.([| + "warnNumber", inject @@ (e.warn_number |> float_of_int |> Js.number_of_float); + "isError", inject @@ Js.bool e.is_error; |]) in - let attrs = Array.append locAttrs warnAttrs in + let attrs = Array.append loc_attrs warn_attrs in Js.Unsafe.obj attrs - let fromLocErrors ?(warnings: LocWarnInfo.t array option) ~(type_: string) (errors: locErrInfo array) = - let jsErrors = Array.map - (fun (e: locErrInfo) -> + let from_loc_errors ?(warnings: LocWarnInfo.t array option) ~(type_: string) (errors: loc_err_info array) = + let js_errors = Array.map + (fun (e: loc_err_info) -> Js.Unsafe.(obj - (locErrorAttributes + (loc_error_attributes ~type_ - ~fullMsg: e.fullMsg - ~shortMsg: e.shortMsg + ~full_msg: e.full_msg + ~short_msg: e.short_msg e.loc))) errors in - let locErrAttrs = Js.Unsafe.([| - "errors" , inject @@ Js.array jsErrors; + let loc_err_attrs = Js.Unsafe.([| + "errors" , inject @@ Js.array js_errors; "type" , inject @@ Js.string type_ |]) in - let warningAttr = match warnings with + let warning_attr = match warnings with | Some warnings -> Js.Unsafe.([| "warnings", - inject @@ Js.array (Array.map makeWarning warnings) + inject @@ Js.array (Array.map make_warning warnings) |]) | None -> [||] in - let attrs = Array.append locErrAttrs warningAttr in + let attrs = Array.append loc_err_attrs warning_attr in Js.Unsafe.(obj attrs) - let fromSyntaxErrors (errors: locErrInfo array) = - fromLocErrors ~type_:"syntax_error" errors + let from_syntax_errors (errors: loc_err_info array) = + from_loc_errors ~type_:"syntax_error" errors (* for raised errors caused by malformed warning / warning_error flags *) - let makeWarningFlagError ~(warn_flags: string) (msg: string) = + let make_warning_flag_error ~(warn_flags: string) (msg: string) = Js.Unsafe.(obj [| "msg" , inject @@ Js.string msg; "warn_flags", inject @@ Js.string warn_flags; "type" , inject @@ Js.string "warning_flag_error" |]) - let makeWarningError (errors: LocWarnInfo.t array) = + let make_warning_error (errors: LocWarnInfo.t array) = let type_ = "warning_error" in - let jsErrors = Array.map makeWarning errors in + let js_errors = Array.map make_warning errors in Js.Unsafe.(obj [| - "errors" , inject @@ Js.array jsErrors; + "errors" , inject @@ Js.array js_errors; "type" , inject @@ Js.string type_ |]) - let makeUnexpectedError msg = + let make_unexpected_error msg = Js.Unsafe.(obj [| "msg" , inject @@ Js.string msg; "type" , inject @@ Js.string "unexpected_error" @@ -235,19 +235,19 @@ module ResDriver = struct open Res_driver (* adds ~src parameter *) - let setup ~src ~filename ~forPrinter () = - let mode = if forPrinter + let setup ~src ~filename ~for_printer () = + let mode = if for_printer then Res_parser.Default else ParseForTypeChecker in Res_parser.make ~mode src filename (* get full super error message *) - let diagnosticToString ~(src: string) (d: Res_diagnostics.t) = - let startPos = Res_diagnostics.getStartPos(d) in - let endPos = Res_diagnostics.getEndPos(d) in + let diagnostic_to_string ~(src: string) (d: Res_diagnostics.t) = + let start_pos = Res_diagnostics.get_start_pos(d) in + let end_pos = Res_diagnostics.get_end_pos(d) in let msg = Res_diagnostics.explain(d) in - let loc = {loc_start = startPos; Location.loc_end=endPos; loc_ghost=false} in + let loc = {loc_start = start_pos; Location.loc_end=end_pos; loc_ghost=false} in let err = { Location.loc; msg; sub=[]; if_highlight=""} in Location.default_error_reporter ~src:(Some src) @@ -255,11 +255,11 @@ module ResDriver = struct err; Format.flush_str_formatter () - let parse_implementation ~sourcefile ~forPrinter ~src = + let parse_implementation ~sourcefile ~for_printer ~src = Location.input_name := sourcefile; - let parseResult = - let engine = setup ~filename:sourcefile ~forPrinter ~src () in - let structure = Res_core.parseImplementation engine in + let parse_result = + let engine = setup ~filename:sourcefile ~for_printer ~src () in + let structure = Res_core.parse_implementation engine in let (invalid, diagnostics) = match engine.diagnostics with | [] as diagnostics -> (false, diagnostics) | _ as diagnostics -> (true, diagnostics) @@ -272,19 +272,19 @@ module ResDriver = struct comments = List.rev engine.comments; } in - let () = if parseResult.invalid then - let errors = parseResult.diagnostics + let () = if parse_result.invalid then + let errors = parse_result.diagnostics |> List.map (fun d -> - let fullMsg = diagnosticToString ~src:parseResult.source d in - let shortMsg = Res_diagnostics.explain d in + let full_msg = diagnostic_to_string ~src:parse_result.source d in + let short_msg = Res_diagnostics.explain d in let loc = { - Location.loc_start = Res_diagnostics.getStartPos d; - Location.loc_end = Res_diagnostics.getEndPos d; + Location.loc_start = Res_diagnostics.get_start_pos d; + Location.loc_end = Res_diagnostics.get_end_pos d; loc_ghost = false } in { - fullMsg; - shortMsg; + full_msg; + short_msg; loc; } ) @@ -292,28 +292,28 @@ module ResDriver = struct in raise (RescriptParsingErrors errors) in - (parseResult.parsetree, parseResult.comments) + (parse_result.parsetree, parse_result.comments) end let rescript_parse ~filename src = - let (structure, _ ) = ResDriver.parse_implementation ~forPrinter:false ~sourcefile:filename ~src + let (structure, _ ) = ResDriver.parse_implementation ~for_printer:false ~sourcefile:filename ~src in structure module Printer = struct - let printExpr typ = + let print_expr typ = Printtyp.reset_names(); Printtyp.reset_and_mark_loops typ; - Res_doc.toString - ~width:60 (Res_outcome_printer.printOutTypeDoc (Printtyp.tree_of_typexp false typ)) + Res_doc.to_string + ~width:60 (Res_outcome_printer.print_out_type_doc (Printtyp.tree_of_typexp false typ)) - let printDecl ~recStatus name decl = + let print_decl ~rec_status name decl = Printtyp.reset_names(); - Res_doc.toString + Res_doc.to_string ~width:60 - (Res_outcome_printer.printOutSigItemDoc (Printtyp.tree_of_type_declaration (Ident.create name) decl recStatus)) + (Res_outcome_printer.print_out_sig_item_doc (Printtyp.tree_of_type_declaration (Ident.create name) decl rec_status)) end module Compile = struct @@ -339,13 +339,13 @@ module Compile = struct | `Active { Warnings. number; is_error; } -> Location.default_warning_printer loc ppf w; let open LocWarnInfo in - let fullMsg = flush_warning_buffer () in - let shortMsg = Warnings.message w in + let full_msg = flush_warning_buffer () in + let short_msg = Warnings.message w in let info = { - fullMsg; - shortMsg; - warnNumber=number; - isError=is_error; + full_msg; + short_msg; + warn_number=number; + is_error=is_error; loc; } in warning_infos := Array.append !warning_infos [|info|] @@ -371,22 +371,22 @@ module Compile = struct | Syntaxerr.Error _ -> "syntax_error" | _ -> "other_error" in - let fullMsg = + let full_msg = Location.report_error Format.str_formatter error; Format.flush_str_formatter () in - let err = { fullMsg; shortMsg=error.msg; loc=error.loc; } in - ErrorRet.fromLocErrors ~type_ [|err|] + let err = { full_msg; short_msg=error.msg; loc=error.loc; } in + ErrorRet.from_loc_errors ~type_ [|err|] | None -> match e with | RescriptParsingErrors errors -> - ErrorRet.fromSyntaxErrors(Array.of_list errors) + ErrorRet.from_syntax_errors(Array.of_list errors) | _ -> let msg = Printexc.to_string e in match e with | Warnings.Errors -> - ErrorRet.makeWarningError !warning_infos - | _ -> ErrorRet.makeUnexpectedError msg) + ErrorRet.make_warning_error !warning_infos + | _ -> ErrorRet.make_unexpected_error msg) (* Responsible for resetting all compiler state as if it were a new instance *) let reset_compiler () = @@ -401,9 +401,9 @@ module Compile = struct * * Note: start / end positions * *) - let collectTypeHints typed_tree = + let collect_type_hints typed_tree = let open Typedtree in - let createTypeHintObj loc kind hint = + let create_type_hint_obj loc kind hint = let open Location in let (_ , startline, startcol) = Location.get_pos_info loc.loc_start in let (_ , endline, endcol) = Location.get_pos_info loc.loc_end in @@ -428,22 +428,22 @@ module Compile = struct let cur_rec_status = ref None let enter_expression expr = - let hint = Printer.printExpr expr.exp_type in - let obj = createTypeHintObj expr.exp_loc "expression" hint in + let hint = Printer.print_expr expr.exp_type in + let obj = create_type_hint_obj expr.exp_loc "expression" hint in acc := obj :: !acc let enter_binding binding = - let hint = Printer.printExpr binding.vb_expr.exp_type in - let obj = createTypeHintObj binding.vb_loc "binding" hint in + let hint = Printer.print_expr binding.vb_expr.exp_type in + let obj = create_type_hint_obj binding.vb_loc "binding" hint in acc := obj :: !acc let enter_core_type ct = - let hint = Printer.printExpr ct.ctyp_type in - let obj = createTypeHintObj ct.ctyp_loc "core_type" hint in + let hint = Printer.print_expr ct.ctyp_type in + let obj = create_type_hint_obj ct.ctyp_loc "core_type" hint in acc := obj :: !acc - let enter_type_declarations recFlag = - let status = match recFlag with + let enter_type_declarations rec_flag = + let status = match rec_flag with | Asttypes.Nonrecursive -> Types.Trec_not | Recursive -> Trec_first in @@ -452,11 +452,11 @@ module Compile = struct let enter_type_declaration tdecl = let open Types in match !cur_rec_status with - | Some recStatus -> - let hint = Printer.printDecl ~recStatus tdecl.typ_name.Asttypes.txt tdecl.typ_type in - let obj = createTypeHintObj tdecl.typ_loc "type_declaration" hint in + | Some rec_status -> + let hint = Printer.print_decl ~rec_status tdecl.typ_name.Asttypes.txt tdecl.typ_type in + let obj = create_type_hint_obj tdecl.typ_loc "type_declaration" hint in acc := obj :: !acc; - (match recStatus with + (match rec_status with | Trec_not | Trec_first -> cur_rec_status := Some Trec_next | _ -> ()) @@ -505,24 +505,24 @@ module Compile = struct (Lam_compile_main.compile "" exports lam) (Ext_pp.from_buffer buffer) in let v = Buffer.contents buffer in - let typeHints = collectTypeHints typed_tree in + let type_hints = collect_type_hints typed_tree in Js.Unsafe.(obj [| "js_code", inject @@ Js.string v; "warnings", inject @@ ( !warning_infos - |> Array.map ErrorRet.makeWarning + |> Array.map ErrorRet.make_warning |> Js.array |> inject ); - "type_hints", inject @@ typeHints; + "type_hints", inject @@ type_hints; "type" , inject @@ Js.string "success" |])) with | e -> match e with | Arg.Bad msg -> - ErrorRet.makeWarningFlagError ~warn_flags msg + ErrorRet.make_warning_flag_error ~warn_flags msg | _ -> handle_err e;; let syntax_format ?(filename: string option) ~(from:Lang.t) ~(to_:Lang.t) (src: string) = @@ -535,10 +535,10 @@ module Compile = struct |> lexbuf_from_string ~filename |> Parse.implementation in - Res_printer.printImplementation ~width:80 structure ~comments:[] + Res_printer.print_implementation ~width:80 structure ~comments:[] | (Res, OCaml) -> let (structure, _) = - ResDriver.parse_implementation ~forPrinter:false ~sourcefile:filename ~src + ResDriver.parse_implementation ~for_printer:false ~sourcefile:filename ~src in Pprintast.structure Format.str_formatter structure; Format.flush_str_formatter () @@ -547,15 +547,15 @@ module Compile = struct * IMPORTANT: we need forPrinter:true when parsing code here, * otherwise we will loose some information for the ReScript printer *) let (structure, comments) = - ResDriver.parse_implementation ~forPrinter:true ~sourcefile:filename ~src + ResDriver.parse_implementation ~for_printer:true ~sourcefile:filename ~src in - Res_printer.printImplementation ~width:80 structure ~comments + Res_printer.print_implementation ~width:80 structure ~comments | (OCaml, OCaml) -> src in Js.Unsafe.(obj [| "code", inject @@ Js.string code; - "fromLang", inject @@ Js.string (Lang.toString from); - "toLang", inject @@ Js.string (Lang.toString to_); + "fromLang", inject @@ Js.string (Lang.to_string from); + "toLang", inject @@ Js.string (Lang.to_string to_); "type" , inject @@ Js.string "success" |]) with @@ -573,7 +573,7 @@ module Export = struct let make_compiler ~config ~lang = let open Lang in let open Js.Unsafe in - let baseAttrs = + let base_attrs = [|"compile", inject @@ Js.wrap_meth_callback @@ -588,17 +588,17 @@ module Export = struct |] in let attrs = if lang != OCaml then - Array.append baseAttrs [| + Array.append base_attrs [| ("format", inject @@ Js.wrap_meth_callback (fun _ code -> (match lang with - | OCaml -> ErrorRet.makeUnexpectedError ("OCaml pretty printing not supported") + | OCaml -> ErrorRet.make_unexpected_error ("OCaml pretty printing not supported") | _ -> Compile.syntax_format ?filename:config.filename ~from:lang ~to_:lang (Js.to_string code)))) |] else - baseAttrs + base_attrs in obj attrs @@ -622,19 +622,19 @@ module Export = struct let set_open_modules value = config.open_modules <- value; true in - let convert_syntax ~(fromLang: string) ~(toLang: string) (src: string) = + let convert_syntax ~(from_lang: string) ~(to_lang: string) (src: string) = let open Lang in - match (fromString fromLang, fromString toLang) with + match (from_string from_lang, from_string to_lang) with | (Some from, Some to_) -> Compile.syntax_format ?filename:config.filename ~from ~to_ src | other -> let msg = match other with - | (None, None) -> "Unknown from / to language: " ^ fromLang ^ ", " ^ toLang - | (None, Some _) -> "Unknown from language: " ^ fromLang - | (Some _, None) -> "Unknown to language: " ^ toLang - | (Some _, Some _) -> "Can't convert from " ^ fromLang ^ " to " ^ toLang + | (None, None) -> "Unknown from / to language: " ^ from_lang ^ ", " ^ to_lang + | (None, Some _) -> "Unknown from language: " ^ from_lang + | (Some _, None) -> "Unknown to language: " ^ to_lang + | (Some _, Some _) -> "Can't convert from " ^ from_lang ^ " to " ^ to_lang in - ErrorRet.makeUnexpectedError(msg) + ErrorRet.make_unexpected_error(msg) in Js.Unsafe.(obj [| "version", @@ -646,8 +646,8 @@ module Export = struct "convertSyntax", inject @@ Js.wrap_meth_callback - (fun _ fromLang toLang src -> - (convert_syntax ~fromLang:(Js.to_string fromLang) ~toLang:(Js.to_string toLang) (Js.to_string src)) + (fun _ from_lang to_lang src -> + (convert_syntax ~from_lang:(Js.to_string from_lang) ~to_lang:(Js.to_string to_lang) (Js.to_string src)) ); "setModuleSystem", inject @@ @@ -700,7 +700,7 @@ let () = (Js.Unsafe.(obj [| "api_version", - inject @@ Js.string apiVersion; + inject @@ Js.string api_version; "version", inject @@ Js.string Bs_version.version; "make", diff --git a/jscomp/ml/ast_async.ml b/jscomp/ml/ast_async.ml index b1552cd9a2..51dff6e4dc 100644 --- a/jscomp/ml/ast_async.ml +++ b/jscomp/ml/ast_async.ml @@ -15,7 +15,7 @@ let add_async_attribute ~async (body : Parsetree.expression) = if async then ( match body.pexp_desc with - | Pexp_construct (x, Some e) when Ast_uncurried.exprIsUncurriedFun body -> + | Pexp_construct (x, Some e) when Ast_uncurried.expr_is_uncurried_fun body -> {body with pexp_desc = Pexp_construct (x, Some {e with pexp_attributes = ({txt = "res.async"; loc = Location.none}, PStr []) :: e.pexp_attributes} )} | _ -> diff --git a/jscomp/ml/ast_payload.ml b/jscomp/ml/ast_payload.ml index f49ac59a4f..0fe198d432 100644 --- a/jscomp/ml/ast_payload.ml +++ b/jscomp/ml/ast_payload.ml @@ -184,7 +184,7 @@ type action = lid * Parsetree.expression option {[ { x = exp }]} *) -let unrecognizedConfigRecord loc text = +let unrecognized_config_record loc text = Location.prerr_warning loc (Warnings.Bs_derive_warning text) let ident_or_record_as_config loc (x : t) : @@ -211,7 +211,7 @@ let ident_or_record_as_config loc (x : t) : | {txt = Lident name; loc}, y -> ({Asttypes.txt = name; loc}, Some y) | _ -> Location.raise_errorf ~loc "Qualified label is not allowed") | Some _ -> - unrecognizedConfigRecord loc "`with` is not supported, discarding"; + unrecognized_config_record loc "`with` is not supported, discarding"; []) | PStr [ @@ -224,7 +224,7 @@ let ident_or_record_as_config loc (x : t) : [({Asttypes.txt; loc = lloc}, None)] | PStr [] -> [] | _ -> - unrecognizedConfigRecord loc "invalid attribute config-record, ignoring"; + unrecognized_config_record loc "invalid attribute config-record, ignoring"; [] let assert_strings loc (x : t) : string list = diff --git a/jscomp/ml/ast_payload.mli b/jscomp/ml/ast_payload.mli index 93ab10aac0..493ad8efb6 100644 --- a/jscomp/ml/ast_payload.mli +++ b/jscomp/ml/ast_payload.mli @@ -89,6 +89,6 @@ val empty : t val table_dispatch : (Parsetree.expression option -> 'a) Map_string.t -> action -> 'a -val unrecognizedConfigRecord : Location.t -> string -> unit +val unrecognized_config_record : Location.t -> string -> unit (** Report to the user, as a warning, that the bs-attribute parser is bailing out. (This is to allow external ppx, like ppx_deriving, to pick up where the builtin ppx leave off.) *) diff --git a/jscomp/ml/ast_uncurried.ml b/jscomp/ml/ast_uncurried.ml index 432bb6cab2..ef7ad20c5b 100644 --- a/jscomp/ml/ast_uncurried.ml +++ b/jscomp/ml/ast_uncurried.ml @@ -4,21 +4,21 @@ 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 arityType ~loc arity = +let arity_type ~loc arity = Ast_helper.Typ.variant ~loc [ Rtag ({ txt = encode_arity_string arity; loc }, [], true, []) ] Closed None -let arityFromType (typ : Parsetree.core_type) = +let arity_from_type (typ : Parsetree.core_type) = match typ.ptyp_desc with | Ptyp_variant ([Rtag ({txt}, _, _, _)], _, _) -> decode_arity_string txt | _ -> assert false -let uncurriedType ~loc ~arity tArg = - let tArity = arityType ~loc arity in +let uncurried_type ~loc ~arity t_arg = + let t_arity = arity_type ~loc arity in Ast_helper.Typ.constr ~loc { txt = Lident "function$"; loc } - [ tArg; tArity ] + [ t_arg; t_arity ] let arity_to_attributes arity = [ @@ -47,40 +47,40 @@ let rec attributes_to_arity (attrs : Parsetree.attributes) = | _ :: rest -> attributes_to_arity rest | _ -> assert false -let uncurriedFun ~loc ~arity funExpr = +let uncurried_fun ~loc ~arity fun_expr = Ast_helper.Exp.construct ~loc ~attrs:(arity_to_attributes arity) (Location.mknoloc (Longident.Lident "Function$")) - (Some funExpr) + (Some fun_expr) -let exprIsUncurriedFun (expr : Parsetree.expression) = +let expr_is_uncurried_fun (expr : Parsetree.expression) = match expr.pexp_desc with | Pexp_construct ({ txt = Lident "Function$" }, Some _) -> true | _ -> false -let exprExtractUncurriedFun (expr : Parsetree.expression) = +let expr_extract_uncurried_fun (expr : Parsetree.expression) = match expr.pexp_desc with | Pexp_construct ({ txt = Lident "Function$" }, Some e) -> e | _ -> assert false -let coreTypeIsUncurriedFun (typ : Parsetree.core_type) = +let core_type_is_uncurried_fun (typ : Parsetree.core_type) = match typ.ptyp_desc with | Ptyp_constr ({txt = Lident "function$"}, [{ptyp_desc = Ptyp_arrow _}; _]) -> true | _ -> false -let coreTypeExtractUncurriedFun (typ : Parsetree.core_type) = +let core_type_extract_uncurried_fun (typ : Parsetree.core_type) = match typ.ptyp_desc with - | Ptyp_constr ({txt = Lident "function$"}, [tArg; tArity]) -> - (arityFromType tArity, tArg) + | Ptyp_constr ({txt = Lident "function$"}, [t_arg; t_arity]) -> + (arity_from_type t_arity, t_arg) | _ -> assert false -let typeIsUncurriedFun = Ast_uncurried_utils.typeIsUncurriedFun +let type_is_uncurried_fun = Ast_uncurried_utils.type_is_uncurried_fun -let typeExtractUncurriedFun (typ : Types.type_expr) = +let type_extract_uncurried_fun (typ : Types.type_expr) = match typ.desc with - | Tconstr (Pident {name = "function$"}, [tArg; _], _) -> - tArg + | Tconstr (Pident {name = "function$"}, [t_arg; _], _) -> + t_arg | _ -> assert false (* Typed AST *) @@ -98,8 +98,8 @@ let arity_to_type arity = row_name = None; }) -let type_to_arity (tArity : Types.type_expr) = - match (Ctype.repr tArity).desc with +let type_to_arity (t_arity : Types.type_expr) = + match (Ctype.repr t_arity).desc with | Tvariant { row_fields = [ (label, _) ] } -> decode_arity_string label | _ -> assert false @@ -111,14 +111,14 @@ let make_uncurried_type ~env ~arity t = let uncurried_type_get_arity ~env typ = match (Ctype.expand_head env typ).desc with - | Tconstr (Pident { name = "function$" }, [ _t; tArity ], _) -> - type_to_arity tArity + | Tconstr (Pident { name = "function$" }, [ _t; t_arity ], _) -> + type_to_arity t_arity | _ -> assert false let uncurried_type_get_arity_opt ~env typ = match (Ctype.expand_head env typ).desc with - | Tconstr (Pident { name = "function$" }, [ _t; tArity ], _) -> - Some (type_to_arity tArity) + | Tconstr (Pident { name = "function$" }, [ _t; t_arity ], _) -> + Some (type_to_arity t_arity) | _ -> None diff --git a/jscomp/ml/ast_uncurried_utils.ml b/jscomp/ml/ast_uncurried_utils.ml index ad18b01a6d..d884593903 100644 --- a/jscomp/ml/ast_uncurried_utils.ml +++ b/jscomp/ml/ast_uncurried_utils.ml @@ -1,4 +1,4 @@ -let typeIsUncurriedFun (typ : Types.type_expr) = +let type_is_uncurried_fun (typ : Types.type_expr) = match typ.desc with | Tconstr (Pident {name = "function$"}, [{desc = Tarrow _}; _], _) -> true diff --git a/jscomp/ml/ast_untagged_variants.ml b/jscomp/ml/ast_untagged_variants.ml index 14a6fa6cd1..21944c6a1d 100644 --- a/jscomp/ml/ast_untagged_variants.ml +++ b/jscomp/ml/ast_untagged_variants.ml @@ -15,7 +15,7 @@ module Instance = struct | RegExp -> "RegExp" end -type untaggedError = +type untagged_error = | OnlyOneUnknown of string | AtMostOneObject | AtMostOneInstance of Instance.t @@ -30,7 +30,7 @@ type error = | InvalidVariantAsAnnotation | Duplicated_bs_as | InvalidVariantTagAnnotation - | InvalidUntaggedVariantDefinition of untaggedError + | InvalidUntaggedVariantDefinition of untagged_error exception Error of Location.t * error let report_error ppf = @@ -43,9 +43,9 @@ let report_error ppf = | Duplicated_bs_as -> fprintf ppf "duplicate @as " | InvalidVariantTagAnnotation -> fprintf ppf "A variant tag annotation @tag(...) must be a string" - | InvalidUntaggedVariantDefinition untaggedVariant -> + | InvalidUntaggedVariantDefinition untagged_variant -> fprintf ppf "This untagged variant definition is invalid: %s" - (match untaggedVariant with + (match untagged_variant with | OnlyOneUnknown name -> "Case " ^ name ^ " has a payload that is not of one of the recognized shapes (object, array, etc). Then it must be the only case with payloads." | AtMostOneObject -> "At most one case can be an object type." | AtMostOneInstance Array -> "At most one case can be an array or tuple type." @@ -145,7 +145,7 @@ let () = | Error (loc, err) -> Some (Location.error_of_printer loc report_error err) | _ -> None) -let reportConstructorMoreThanOneArg ~loc ~name = +let report_constructor_more_than_one_arg ~loc ~name = raise (Error (loc, InvalidUntaggedVariantDefinition (ConstructorMoreThanOneArg name))) let type_is_builtin_object (t : Types.type_expr) = @@ -184,7 +184,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.typeIsUncurriedFun t -> + | ({desc = Tconstr _} as t) when Ast_uncurried_utils.type_is_uncurried_fun t -> Some FunctionType | {desc = Tarrow _} -> Some FunctionType | {desc = Tconstr (path, _, _)} when Path.same path Predef.path_string -> @@ -194,7 +194,7 @@ let get_block_type_from_typ ~env (t: Types.type_expr) : block_type option = | ({desc = Tconstr _} as t) when type_to_instanceof_backed_obj t |> Option.is_some -> (match type_to_instanceof_backed_obj t with | None -> None - | Some instanceType -> Some (InstanceType instanceType)) + | Some instance_type -> Some (InstanceType instance_type)) | {desc = Ttuple _} -> Some (InstanceType Array) | _ -> None @@ -240,84 +240,84 @@ let is_nullary_variant (x : Types.constructor_arguments) = | Types.Cstr_tuple [] -> true | _ -> false -let checkInvariant ~isUntaggedDef ~(consts : (Location.t * tag) list) +let check_invariant ~is_untagged_def ~(consts : (Location.t * tag) list) ~(blocks : (Location.t * block) list) = let module StringSet = Set.Make (String) in let string_literals = ref StringSet.empty in let nonstring_literals = ref StringSet.empty in - let instanceTypes = Hashtbl.create 1 in - let functionTypes = ref 0 in - let objectTypes = ref 0 in - let stringTypes = ref 0 in - let numberTypes = ref 0 in - let bigintTypes = ref 0 in - let booleanTypes = ref 0 in - let unknownTypes = ref 0 in - let addStringLiteral ~loc s = + let instance_types = Hashtbl.create 1 in + let function_types = ref 0 in + let object_types = ref 0 in + let string_types = ref 0 in + let number_types = ref 0 in + let bigint_types = ref 0 in + let boolean_types = ref 0 in + let unknown_types = ref 0 in + let add_string_literal ~loc s = if StringSet.mem s !string_literals then raise (Error (loc, InvalidUntaggedVariantDefinition (DuplicateLiteral s))); string_literals := StringSet.add s !string_literals in - let addNonstringLiteral ~loc s = + let add_nonstring_literal ~loc s = if StringSet.mem s !nonstring_literals then raise (Error (loc, InvalidUntaggedVariantDefinition (DuplicateLiteral s))); nonstring_literals := StringSet.add s !nonstring_literals in let invariant loc name = - if !unknownTypes <> 0 && List.length blocks <> 1 then + if !unknown_types <> 0 && List.length blocks <> 1 then raise (Error (loc, InvalidUntaggedVariantDefinition (OnlyOneUnknown name))); - if !objectTypes > 1 then + if !object_types > 1 then raise (Error (loc, InvalidUntaggedVariantDefinition AtMostOneObject)); Hashtbl.iter (fun i count -> if count > 1 then raise (Error (loc, InvalidUntaggedVariantDefinition (AtMostOneInstance i)))) - instanceTypes; - if !functionTypes > 1 then + instance_types; + if !function_types > 1 then raise (Error (loc, InvalidUntaggedVariantDefinition AtMostOneFunction)); - if !stringTypes > 1 then + if !string_types > 1 then raise (Error (loc, InvalidUntaggedVariantDefinition AtMostOneString)); - if !numberTypes > 1 then + if !number_types > 1 then raise (Error (loc, InvalidUntaggedVariantDefinition AtMostOneNumber)); - if !bigintTypes > 1 then + if !bigint_types > 1 then raise (Error (loc, InvalidUntaggedVariantDefinition AtMostOneBigint)); - if !booleanTypes > 1 then + if !boolean_types > 1 then raise (Error (loc, InvalidUntaggedVariantDefinition AtMostOneBoolean)); - if !booleanTypes > 0 && (StringSet.mem "true" !nonstring_literals || StringSet.mem "false" !nonstring_literals) then + if !boolean_types > 0 && (StringSet.mem "true" !nonstring_literals || StringSet.mem "false" !nonstring_literals) then raise (Error (loc, InvalidUntaggedVariantDefinition AtMostOneBoolean)); () in Ext_list.rev_iter consts (fun (loc, literal) -> match literal.tag_type with - | Some (String s) -> addStringLiteral ~loc s - | Some (Int i) -> addNonstringLiteral ~loc (string_of_int i) - | Some (Float f) -> addNonstringLiteral ~loc f - | Some (BigInt i) -> addNonstringLiteral ~loc i - | Some Null -> addNonstringLiteral ~loc "null" - | Some Undefined -> addNonstringLiteral ~loc "undefined" - | Some (Bool b) -> addNonstringLiteral ~loc (if b then "true" else "false") + | Some (String s) -> add_string_literal ~loc s + | Some (Int i) -> add_nonstring_literal ~loc (string_of_int i) + | Some (Float f) -> add_nonstring_literal ~loc f + | Some (BigInt i) -> add_nonstring_literal ~loc i + | Some Null -> add_nonstring_literal ~loc "null" + | Some Undefined -> add_nonstring_literal ~loc "undefined" + | Some (Bool b) -> add_nonstring_literal ~loc (if b then "true" else "false") | Some (Untagged _) -> () - | None -> addStringLiteral ~loc literal.name); - if isUntaggedDef then + | None -> add_string_literal ~loc literal.name); + if is_untagged_def then Ext_list.rev_iter blocks (fun (loc, block) -> match block.block_type with | Some block_type -> (match block_type with - | UnknownType -> incr unknownTypes; - | ObjectType -> incr objectTypes; + | UnknownType -> incr unknown_types; + | ObjectType -> incr object_types; | (InstanceType i) -> - let count = Hashtbl.find_opt instanceTypes i |> Option.value ~default:0 in - Hashtbl.replace instanceTypes i (count + 1); - | FunctionType -> incr functionTypes; - | (IntType | FloatType) -> incr numberTypes; - | BigintType -> incr bigintTypes; - | BooleanType -> incr booleanTypes; - | StringType -> incr stringTypes; + let count = Hashtbl.find_opt instance_types i |> Option.value ~default:0 in + Hashtbl.replace instance_types i (count + 1); + | FunctionType -> incr function_types; + | (IntType | FloatType) -> incr number_types; + | BigintType -> incr bigint_types; + | BooleanType -> incr boolean_types; + | StringType -> incr string_types; ); invariant loc block.tag.name | None -> () ) -let names_from_type_variant ?(isUntaggedDef = false) ~env +let names_from_type_variant ?(is_untagged_def = false) ~env (cstrs : Types.constructor_declaration list) = let get_cstr_name (cstr : Types.constructor_declaration) = ( cstr.cd_loc, @@ -336,16 +336,16 @@ let names_from_type_variant ?(isUntaggedDef = false) ~env (get_cstr_name cstr :: consts, blocks) else (consts, (cstr.cd_loc, get_block cstr) :: blocks)) in - checkInvariant ~isUntaggedDef ~consts ~blocks; + check_invariant ~is_untagged_def ~consts ~blocks; let blocks = blocks |> List.map snd in let consts = consts |> List.map snd in let consts = Ext_array.reverse_of_list consts in let blocks = Ext_array.reverse_of_list blocks in Some {consts; blocks} -let check_well_formed ~env ~isUntaggedDef +let check_well_formed ~env ~is_untagged_def (cstrs : Types.constructor_declaration list) = - ignore (names_from_type_variant ~env ~isUntaggedDef cstrs) + ignore (names_from_type_variant ~env ~is_untagged_def cstrs) let has_undefined_literal attrs = process_tag_type attrs = Some Undefined diff --git a/jscomp/ml/code_frame.ml b/jscomp/ml/code_frame.ml index dc536152a3..f0fdad1201 100644 --- a/jscomp/ml/code_frame.ml +++ b/jscomp/ml/code_frame.ml @@ -119,12 +119,12 @@ type line = { - center snippet when it's heavily indented - ellide intermediate lines when the reported range is huge *) -let print ~is_warning ~src ~(startPos : Lexing.position) ~(endPos:Lexing.position) = +let print ~is_warning ~src ~(start_pos : Lexing.position) ~(end_pos:Lexing.position) = let indent = 2 in - let highlight_line_start_line = startPos.pos_lnum in - let highlight_line_end_line = endPos.pos_lnum in - let (start_line_line_offset, first_shown_line) = seek_2_lines_before src startPos in - let (end_line_line_end_offset, last_shown_line) = seek_2_lines_after src endPos in + let highlight_line_start_line = start_pos.pos_lnum in + let highlight_line_end_line = end_pos.pos_lnum in + let (start_line_line_offset, first_shown_line) = seek_2_lines_before src start_pos in + let (end_line_line_end_offset, last_shown_line) = seek_2_lines_after src end_pos in let more_than_5_highlighted_lines = highlight_line_end_line - highlight_line_start_line + 1 > 5 @@ -167,8 +167,8 @@ let print ~is_warning ~src ~(startPos : Lexing.position) ~(endPos:Lexing.positio match gutter with | Elided -> {s = line; start = 0; end_ = 0} | Number line_number -> - let highlight_line_start_offset = startPos.pos_cnum - startPos.pos_bol in - let highlight_line_end_offset = endPos.pos_cnum - endPos.pos_bol in + let highlight_line_start_offset = start_pos.pos_cnum - start_pos.pos_bol in + let highlight_line_end_offset = end_pos.pos_cnum - end_pos.pos_bol in let start = if i = 0 && line_number = highlight_line_start_line then highlight_line_start_offset - leading_space_to_cut diff --git a/jscomp/ml/ctype.ml b/jscomp/ml/ctype.ml index 901a0db72c..9aa37f2765 100644 --- a/jscomp/ml/ctype.ml +++ b/jscomp/ml/ctype.ml @@ -2396,9 +2396,9 @@ and unify3 env t1 t1' t2 t2' = link_type t2' t1; | (Tfield _, Tfield _) -> (* special case for GADTs *) unify_fields env t1' t2' - | (Tconstr (Pident {name="function$"}, [tFun; _], _), Tarrow _) when !Config.uncurried = Uncurried -> + | (Tconstr (Pident {name="function$"}, [t_fun; _], _), Tarrow _) when !Config.uncurried = Uncurried -> (* subtype: an uncurried function is cast to a curried one *) - unify2 env tFun t2 + unify2 env t_fun t2 | _ -> begin match !umode with | Expression -> @@ -3983,7 +3983,7 @@ let rec subtype_rec env trace t1 t2 cstrs = (* type coercion for variants to primitives *) (match Variant_coercion.can_try_coerce_variant_to_primitive_opt (extract_concrete_typedecl_opt env t1) with | Some (constructors, unboxed) -> - if constructors |> Variant_coercion.variant_has_same_runtime_representation_as_target ~targetPath:path ~unboxed then + if constructors |> Variant_coercion.variant_has_same_runtime_representation_as_target ~target_path:path ~unboxed then cstrs else (trace, t1, t2, !univar_pairs)::cstrs diff --git a/jscomp/ml/error_message_utils.ml b/jscomp/ml/error_message_utils.ml index 14a4913c75..2f53129167 100644 --- a/jscomp/ml/error_message_utils.ml +++ b/jscomp/ml/error_message_utils.ml @@ -1,5 +1,5 @@ -type typeClashStatement = FunctionCall -type typeClashContext = +type type_clash_statement = FunctionCall +type type_clash_context = | SetRecordField | ArrayValue | FunctionReturn @@ -10,20 +10,20 @@ type typeClashContext = | StringConcat | ComparisonOperator | MathOperator of { - forFloat: bool; + for_float: bool; operator: string; - isConstant: string option; + is_constant: string option; } | FunctionArgument - | Statement of typeClashStatement + | Statement of type_clash_statement let fprintf = Format.fprintf -let errorTypeText ppf typeClashContext = +let error_type_text ppf type_clash_context = let text = - match typeClashContext with + match type_clash_context with | Some (Statement FunctionCall) -> "This function call returns:" - | Some (MathOperator {isConstant = Some _}) -> "This value has type:" + | Some (MathOperator {is_constant = Some _}) -> "This value has type:" | Some ArrayValue -> "This array item has type:" | Some SetRecordField -> "You're assigning something to this field that has type:" @@ -31,8 +31,8 @@ let errorTypeText ppf typeClashContext = in fprintf ppf "%s" text -let errorExpectedTypeText ppf typeClashContext = - match typeClashContext with +let error_expected_type_text ppf type_clash_context = + match type_clash_context with | Some FunctionArgument -> fprintf ppf "But this function argument is expecting:" | Some ComparisonOperator -> @@ -54,10 +54,10 @@ let errorExpectedTypeText ppf typeClashContext = fprintf ppf "But this function is expecting you to return:" | _ -> fprintf ppf "But it's expected to have type:" -let printExtraTypeClashHelp ppf trace typeClashContext = - match (typeClashContext, trace) with - | Some (MathOperator {forFloat; operator; isConstant}), _ -> ( - let operatorForOtherType = +let print_extra_type_clash_help ppf trace type_clash_context = + match (type_clash_context, trace) with + | Some (MathOperator {for_float; operator; is_constant}), _ -> ( + let operator_for_other_type = match operator with | "+" -> "+." | "+." -> "+" @@ -68,7 +68,7 @@ let printExtraTypeClashHelp ppf trace typeClashContext = | "*." -> "*" | v -> v in - let operatorText = + let operator_text = match operator.[0] with | '+' -> "add" | '-' -> "subtract" @@ -100,11 +100,11 @@ let printExtraTypeClashHelp ppf trace typeClashContext = \ - Ensure all values in this calculation has the type @{%s@}. \ You can convert between floats and ints via \ @{Belt.Float.toInt@} and @{Belt.Int.fromFloat@}." - operatorText - (if forFloat then "float" else "int")); - match (isConstant, trace) with + operator_text + (if for_float then "float" else "int")); + match (is_constant, trace) with | Some constant, _ -> - if forFloat then + if for_float then fprintf ppf "\n\ \ - Make @{%s@} a @{float@} by adding a trailing dot: \ @@ -126,8 +126,8 @@ let printExtraTypeClashHelp ppf trace typeClashContext = fprintf ppf "\n\ \ - Change the operator to @{%s@}, which works on @{%s@}" - operatorForOtherType - (if forFloat then "int" else "float") + operator_for_other_type + (if for_float then "int" else "float") | _ -> ()) | _ -> ()) | Some Switch, _ -> @@ -164,8 +164,8 @@ let printExtraTypeClashHelp ppf trace typeClashContext = myTuple = (10, \"hello\", 15.5, true)" | _ -> () -let typeClashContextFromFunction sexp sfunct = - let isConstant = +let type_clash_context_from_function sexp sfunct = + let is_constant = match sexp.Parsetree.pexp_desc with | Pexp_constant (Pconst_integer (txt, _) | Pconst_float (txt, _)) -> Some txt @@ -177,39 +177,39 @@ let typeClashContextFromFunction sexp sfunct = Some ComparisonOperator | Pexp_ident {txt = Lident "++"} -> Some StringConcat | Pexp_ident {txt = Lident (("/." | "*." | "+." | "-.") as operator)} -> - Some (MathOperator {forFloat = true; operator; isConstant}) + Some (MathOperator {for_float = true; operator; is_constant}) | Pexp_ident {txt = Lident (("/" | "*" | "+" | "-") as operator)} -> - Some (MathOperator {forFloat = false; operator; isConstant}) + Some (MathOperator {for_float = false; operator; is_constant}) | _ -> Some FunctionArgument -let typeClashContextForFunctionArgument typeClashContext sarg0 = - match typeClashContext with - | Some (MathOperator {forFloat; operator}) -> +let type_clash_context_for_function_argument type_clash_context sarg0 = + match type_clash_context with + | Some (MathOperator {for_float; operator}) -> Some (MathOperator { - forFloat; + for_float; operator; - isConstant = + is_constant = (match sarg0.Parsetree.pexp_desc with | Pexp_constant (Pconst_integer (txt, _) | Pconst_float (txt, _)) -> Some txt | _ -> None); }) - | typeClashContext -> typeClashContext + | type_clash_context -> type_clash_context -let typeClashContextMaybeOption ty_expected ty_res = +let type_clash_context_maybe_option ty_expected ty_res = match (ty_expected, ty_res) with - | ( {Types.desc = Tconstr (expectedPath, _, _)}, - {Types.desc = Tconstr (typePath, _, _)} ) - when Path.same Predef.path_option typePath - && Path.same expectedPath Predef.path_option = false - && Path.same expectedPath Predef.path_uncurried = false -> + | ( {Types.desc = Tconstr (expected_path, _, _)}, + {Types.desc = Tconstr (type_path, _, _)} ) + when Path.same Predef.path_option type_path + && Path.same expected_path Predef.path_option = false + && Path.same expected_path Predef.path_uncurried = false -> Some MaybeUnwrapOption | _ -> None -let typeClashContextInStatement sexp = +let type_clash_context_in_statement sexp = match sexp.Parsetree.pexp_desc with | Pexp_apply _ -> Some (Statement FunctionCall) | _ -> None diff --git a/jscomp/ml/includecore.ml b/jscomp/ml/includecore.ml index 8a3eb04714..af4515be1b 100644 --- a/jscomp/ml/includecore.ml +++ b/jscomp/ml/includecore.ml @@ -167,11 +167,11 @@ let report_type_mismatch0 first second decl ppf err = let default () = pr "Their internal representations differ" in ( match rep1, rep2 with | Record_optional_labels lbls1, Record_optional_labels lbls2 -> - let onlyInLhs = + let only_in_lhs = Ext_list.find_first lbls1 (fun l -> not (Ext_list.mem_string lbls2 l)) in - let onlyInRhs = + let only_in_rhs = Ext_list.find_first lbls2 (fun l -> not (Ext_list.mem_string lbls1 l)) in - (match onlyInLhs, onlyInRhs with + (match only_in_lhs, only_in_rhs with | Some l, _ -> pr "@optional label %s only in %s" l second | _, Some l -> diff --git a/jscomp/ml/lambda.ml b/jscomp/ml/lambda.ml index b6f5da7a88..96f82c9e28 100644 --- a/jscomp/ml/lambda.ml +++ b/jscomp/ml/lambda.ml @@ -323,7 +323,7 @@ type function_attribute = { return_unit : bool; async : bool; directive : string option; - oneUnitArg : bool; + one_unit_arg : bool; } type lambda = @@ -392,7 +392,7 @@ let default_function_attribute = { is_a_functor = false; return_unit = false; async = false; - oneUnitArg = false; + one_unit_arg = false; directive = None; } diff --git a/jscomp/ml/lambda.mli b/jscomp/ml/lambda.mli index 599cbcee8d..1bf6b802f4 100644 --- a/jscomp/ml/lambda.mli +++ b/jscomp/ml/lambda.mli @@ -293,7 +293,7 @@ type function_attribute = { return_unit : bool; async : bool; directive : string option; - oneUnitArg : bool; + one_unit_arg : bool; } type lambda = diff --git a/jscomp/ml/location.ml b/jscomp/ml/location.ml index 561a045221..4ca193cfd6 100644 --- a/jscomp/ml/location.ml +++ b/jscomp/ml/location.ml @@ -170,7 +170,7 @@ let print ?(src = None) ~message_kind intro ppf (loc : t) = let (_, end_line, end_char) = get_pos_info loc.loc_end in (* line is 1-indexed, column is 0-indexed. We convert all of them to 1-indexed to avoid confusion *) (* start_char is inclusive, end_char is exclusive *) - let normalizedRange = + let normalized_range = (* TODO: lots of the handlings here aren't needed anymore because the new rescript syntax has much stronger invariants regarding positions, e.g. no -1 *) @@ -189,7 +189,7 @@ let print ?(src = None) ~message_kind intro ppf (loc : t) = Some ((start_line, start_char + 1), (end_line, end_char)) in fprintf ppf " @[%a@]@," print_loc loc; - match normalizedRange with + match normalized_range with | None -> () | Some _ -> begin try @@ -206,8 +206,8 @@ let print ?(src = None) ~message_kind intro ppf (loc : t) = (Code_frame.print ~is_warning:(message_kind=`warning) ~src - ~startPos:loc.loc_start - ~endPos:loc.loc_end + ~start_pos:loc.loc_start + ~end_pos:loc.loc_end ) with (* this might happen if the file is e.g. "", "_none_" or any of the fake file name placeholders. diff --git a/jscomp/ml/transl_recmodule.ml b/jscomp/ml/transl_recmodule.ml index 5d2c1746d6..cfef64ec74 100644 --- a/jscomp/ml/transl_recmodule.ml +++ b/jscomp/ml/transl_recmodule.ml @@ -52,7 +52,7 @@ let init_shape modl = | [] -> [] | Sig_value (id, { val_kind = Val_reg; val_type = ty }) :: rem -> let is_function t = - Ast_uncurried_utils.typeIsUncurriedFun t || match t.desc with + Ast_uncurried_utils.type_is_uncurried_fun t || match t.desc with | Tarrow _ -> true | _ -> false in let init_v = diff --git a/jscomp/ml/translmod.ml b/jscomp/ml/translmod.ml index 2742eb5205..7fea4909a1 100644 --- a/jscomp/ml/translmod.ml +++ b/jscomp/ml/translmod.ml @@ -275,7 +275,7 @@ let rec compile_functor mexp coercion root_path loc = is_a_functor = true; return_unit = false; async = false; - oneUnitArg = false; + one_unit_arg = false; directive = None; }; loc; diff --git a/jscomp/ml/typecore.ml b/jscomp/ml/typecore.ml index 568a3695be..0e8f61f984 100644 --- a/jscomp/ml/typecore.ml +++ b/jscomp/ml/typecore.ml @@ -32,7 +32,7 @@ type error = | Or_pattern_type_clash of Ident.t * (type_expr * type_expr) list | Multiply_bound_variable of string | Orpat_vars of Ident.t * Ident.t list - | Expr_type_clash of (type_expr * type_expr) list * (typeClashContext option) + | Expr_type_clash of (type_expr * type_expr) list * (type_clash_context option) | Apply_non_function of type_expr | Apply_wrong_label of arg_label * type_expr | Label_multiply_defined of string @@ -306,7 +306,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.typeIsUncurriedFun ty) + when not (Ast_uncurried.type_is_uncurried_fun ty) -> (p0, p, cstrs) | (p0, p, {type_kind=Type_open}) -> (p0, p, []) | _ -> raise Not_found @@ -336,14 +336,14 @@ let unify_pat_types loc env ty ty' = raise(Typetexp.Error(loc, env, Typetexp.Variant_tags (l1, l2))) (* unification inside type_exp and type_expect *) -let unify_exp_types ?typeClashContext loc env ty expected_ty = +let unify_exp_types ?type_clash_context loc env ty expected_ty = (* Format.eprintf "@[%a@ %a@]@." Printtyp.raw_type_expr exp.exp_type Printtyp.raw_type_expr expected_ty; *) try unify env ty expected_ty with Unify trace -> - raise(Error(loc, env, Expr_type_clash(trace, typeClashContext))) + raise(Error(loc, env, Expr_type_clash(trace, type_clash_context))) | Tags(l1,l2) -> raise(Typetexp.Error(loc, env, Typetexp.Variant_tags (l1, l2))) @@ -642,11 +642,11 @@ let print_simple_message ppf = function let show_extra_help ppf _env trace = begin match bottom_aliases trace with - | Some ({Types.desc = Tconstr (actualPath, actualArgs, _)}, {desc = Tconstr (expectedPath, expextedArgs, _)}) -> begin - match (actualPath, actualArgs, expectedPath, expextedArgs) with - | (Pident {name = actualName}, [], Pident {name = expectedName}, []) -> begin - print_simple_conversion ppf (actualName, expectedName); - print_simple_message ppf (actualName, expectedName); + | Some ({Types.desc = Tconstr (actual_path, actual_args, _)}, {desc = Tconstr (expected_path, expexted_args, _)}) -> begin + match (actual_path, actual_args, expected_path, expexted_args) with + | (Pident {name = actual_name}, [], Pident {name = expected_name}, []) -> begin + print_simple_conversion ppf (actual_name, expected_name); + print_simple_message ppf (actual_name, expected_name); end | _ -> () end; @@ -662,12 +662,12 @@ let rec collect_missing_arguments env type1 type2 = match type1 with | Some res -> Some ((label, argtype) :: res) | None -> None end - | t when Ast_uncurried.typeIsUncurriedFun t -> - let typ = Ast_uncurried.typeExtractUncurriedFun t in + | t when Ast_uncurried.type_is_uncurried_fun t -> + let typ = Ast_uncurried.type_extract_uncurried_fun t in collect_missing_arguments env typ type2 | _ -> None -let print_expr_type_clash ?typeClashContext env trace ppf = begin +let print_expr_type_clash ?type_clash_context env trace ppf = begin (* this is the most frequent error. We should do whatever we can to provide specific guidance to this generic error before giving up *) let bottom_aliases_result = bottom_aliases trace in @@ -688,11 +688,11 @@ let print_expr_type_clash ?typeClashContext env trace ppf = begin ) in match missing_arguments with - | Some [singleArgument] -> + | Some [single_argument] -> (* btw, you can't say "final arguments". Intermediate labeled arguments might be the ones missing *) fprintf ppf "@[@{This call is missing an argument@} of type@ %a@]" - print_arguments [singleArgument] + print_arguments [single_argument] | Some arguments -> fprintf ppf "@[@{This call is missing arguments@} of type:@ %a@]" print_arguments arguments @@ -702,9 +702,9 @@ let print_expr_type_clash ?typeClashContext env trace ppf = begin | None -> assert false in begin match missing_parameters with - | Some [singleParameter] -> + | Some [single_parameter] -> fprintf ppf "@[This value might need to be @{wrapped in a function@ that@ takes@ an@ extra@ parameter@}@ of@ type@ %a@]@,@," - print_arguments [singleParameter]; + print_arguments [single_parameter]; fprintf ppf "@[@{Here's the original error message@}@]@," | Some arguments -> fprintf ppf "@[This value seems to @{need to be wrapped in a function that takes extra@ arguments@}@ of@ type:@ @[%a@]@]@,@," @@ -715,18 +715,18 @@ let print_expr_type_clash ?typeClashContext env trace ppf = begin Printtyp.super_report_unification_error ppf env trace (function ppf -> - errorTypeText ppf typeClashContext) + error_type_text ppf type_clash_context) (function ppf -> - errorExpectedTypeText ppf typeClashContext); - printExtraTypeClashHelp ppf trace typeClashContext; + error_expected_type_text ppf type_clash_context); + print_extra_type_clash_help ppf trace type_clash_context; show_extra_help ppf env trace; end -let reportArityMismatch ~arityA ~arityB ppf = +let report_arity_mismatch ~arity_a ~arity_b ppf = fprintf ppf "This function expected @{%s@} %s, but got @{%s@}" - arityB - (if arityB = "1" then "argument" else "arguments") - arityA + arity_b + (if arity_b = "1" then "argument" else "arguments") + arity_a (* Records *) let label_of_kind kind = @@ -1284,12 +1284,12 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env in let process_optional_label (ld, pat) = let exp_optional_attr = check_optional_attr !env ld pat.ppat_attributes pat.ppat_loc in - let isFromPamatch = match pat.ppat_desc with + let is_from_pamatch = match pat.ppat_desc with | Ppat_construct ({txt = Lident s}, _) -> String.length s >= 2 && s.[0] = '#' && s.[1] = '$' | _ -> false in - if label_is_optional ld && not exp_optional_attr && not isFromPamatch then + if label_is_optional ld && not exp_optional_attr && not is_from_pamatch then let lid = mknoloc (Longident.(Ldot (Lident "*predef*", "Some"))) in Ast_helper.Pat.construct ~loc:pat.ppat_loc lid (Some pat) else pat @@ -1936,9 +1936,9 @@ let rec name_pattern default = function (* Typing of expressions *) -let unify_exp ?typeClashContext env exp expected_ty = +let unify_exp ?type_clash_context env exp expected_ty = let loc = proper_exp_loc exp in - unify_exp_types ?typeClashContext loc env exp.exp_type expected_ty + unify_exp_types ?type_clash_context loc env exp.exp_type expected_ty let is_ignore funct env = @@ -1988,23 +1988,23 @@ let rec type_exp ?recarg env sexp = In the principal case, [type_expected'] may be at generic_level. *) -and type_expect ?typeClashContext ?in_function ?recarg env sexp ty_expected = +and type_expect ?type_clash_context ?in_function ?recarg env sexp ty_expected = let previous_saved_types = Cmt_format.get_saved_types () in let exp = Builtin_attributes.warning_scope sexp.pexp_attributes (fun () -> - type_expect_ ?typeClashContext ?in_function ?recarg env sexp ty_expected + type_expect_ ?type_clash_context ?in_function ?recarg env sexp ty_expected ) in Cmt_format.set_saved_types (Cmt_format.Partial_expression exp :: previous_saved_types); exp -and type_expect_ ?typeClashContext ?in_function ?(recarg=Rejected) env sexp ty_expected = +and type_expect_ ?type_clash_context ?in_function ?(recarg=Rejected) env sexp ty_expected = let loc = sexp.pexp_loc in (* Record the expression type before unifying it with the expected type *) let rue exp = - unify_exp ?typeClashContext env (re exp) (instance env ty_expected); + unify_exp ?type_clash_context env (re exp) (instance env ty_expected); exp in let process_optional_label (id, ld, e) = @@ -2142,8 +2142,8 @@ and type_expect_ ?typeClashContext ?in_function ?(recarg=Rejected) env sexp ty_e Ext_list.exists sexp.pexp_attributes (fun ({txt },_) -> txt = "res.uapp") && not @@ Ext_list.exists sexp.pexp_attributes (fun ({txt },_) -> txt = "res.partial") && not @@ is_automatic_curried_application env funct in - let typeClashContext = typeClashContextFromFunction sexp sfunct in - let (args, ty_res, fully_applied) = type_application ?typeClashContext uncurried env funct sargs in + let type_clash_context = type_clash_context_from_function sexp sfunct in + let (args, ty_res, fully_applied) = type_application ?type_clash_context uncurried env funct sargs in end_def (); unify_var env (newvar()) funct.exp_type; @@ -2195,9 +2195,9 @@ and type_expect_ ?typeClashContext ?in_function ?(recarg=Rejected) env sexp ty_e empty pattern matching can be generated by Camlp4 with its revised syntax. Let's accept it for backward compatibility. *) let val_cases, partial = - type_cases ~rootTypeClashContext:Switch env arg.exp_type ty_expected true loc val_caselist in + type_cases ~root_type_clash_context:Switch env arg.exp_type ty_expected true loc val_caselist in let exn_cases, _ = - type_cases ~rootTypeClashContext:Switch env Predef.type_exn ty_expected false loc exn_caselist in + type_cases ~root_type_clash_context:Switch env Predef.type_exn ty_expected false loc exn_caselist in re { exp_desc = Texp_match(arg, val_cases, exn_cases, partial); exp_loc = loc; exp_extra = []; @@ -2452,7 +2452,7 @@ and type_expect_ ?typeClashContext ?in_function ?(recarg=Rejected) env sexp ty_e let (record, label, opath) = type_label_access env srecord lid in let ty_record = if opath = None then newvar () else record.exp_type in let (label_loc, label, newval) = - type_label_exp ~typeClashContext:SetRecordField false env loc ty_record (lid, label, snewval) in + type_label_exp ~type_clash_context:SetRecordField false env loc ty_record (lid, label, snewval) in unify_exp env record ty_record; if label.lbl_mut = Immutable then raise(Error(loc, env, Label_not_mutable lid.txt)); @@ -2468,7 +2468,7 @@ and type_expect_ ?typeClashContext ?in_function ?(recarg=Rejected) env sexp ty_e let ty = newgenvar() in let to_unify = Predef.type_array ty in unify_exp_types loc env to_unify ty_expected; - let argl = List.map (fun sarg -> type_expect ~typeClashContext:ArrayValue env sarg ty) sargl in + let argl = List.map (fun sarg -> type_expect ~type_clash_context:ArrayValue env sarg ty) sargl in re { exp_desc = Texp_array argl; exp_loc = loc; exp_extra = []; @@ -2476,10 +2476,10 @@ and type_expect_ ?typeClashContext ?in_function ?(recarg=Rejected) env sexp ty_e exp_attributes = sexp.pexp_attributes; exp_env = env } | Pexp_ifthenelse(scond, sifso, sifnot) -> - let cond = type_expect ~typeClashContext:IfCondition env scond Predef.type_bool in + let cond = type_expect ~type_clash_context:IfCondition env scond Predef.type_bool in begin match sifnot with None -> - let ifso = type_expect ~typeClashContext:IfReturn env sifso Predef.type_unit in + let ifso = type_expect ~type_clash_context:IfReturn env sifso Predef.type_unit in rue { exp_desc = Texp_ifthenelse(cond, ifso, None); exp_loc = loc; exp_extra = []; @@ -2487,10 +2487,10 @@ and type_expect_ ?typeClashContext ?in_function ?(recarg=Rejected) env sexp ty_e exp_attributes = sexp.pexp_attributes; exp_env = env } | Some sifnot -> - let ifso = type_expect ~typeClashContext:IfReturn env sifso ty_expected in - let ifnot = type_expect ~typeClashContext:IfReturn env sifnot ty_expected in + let ifso = type_expect ~type_clash_context:IfReturn env sifso ty_expected in + let ifnot = type_expect ~type_clash_context:IfReturn env sifnot ty_expected in (* Keep sharing *) - unify_exp ~typeClashContext:IfReturn env ifnot ifso.exp_type; + unify_exp ~type_clash_context:IfReturn env ifnot ifso.exp_type; re { exp_desc = Texp_ifthenelse(cond, ifso, Some ifnot); exp_loc = loc; exp_extra = []; @@ -2578,7 +2578,7 @@ and type_expect_ ?typeClashContext ?in_function ?(recarg=Rejected) env sexp ty_e let tv = newvar () in let gen = generalizable tv.level arg.exp_type in (try unify_var env tv arg.exp_type with Unify trace -> - raise(Error(arg.exp_loc, env, Expr_type_clash (trace, typeClashContext)))); + raise(Error(arg.exp_loc, env, Expr_type_clash (trace, type_clash_context)))); gen end else true in @@ -2968,7 +2968,7 @@ and type_label_access env srecord lid = (* Typing format strings for printing or reading. These formats are used by functions in modules Printf, Format, and Scanf. (Handling of * modifiers contributed by Thorsten Ohl.) *) -and type_label_exp ?typeClashContext create env loc ty_expected +and type_label_exp ?type_clash_context create env loc ty_expected (lid, label, sarg) = (* Here also ty_expected may be at generic_level *) begin_def (); @@ -3000,7 +3000,7 @@ and type_label_exp ?typeClashContext create env loc ty_expected raise (Error(lid.loc, env, Private_label(lid.txt, ty_expected))); let arg = let snap = if vars = [] then None else Some (Btype.snapshot ()) in - let arg = type_argument ?typeClashContext env sarg ty_arg (instance env ty_arg) in + let arg = type_argument ?type_clash_context env sarg ty_arg (instance env ty_arg) in end_def (); try check_univars env (vars <> []) "field value" arg label.lbl_arg vars; @@ -3020,7 +3020,7 @@ and type_label_exp ?typeClashContext create env loc ty_expected in (lid, label, {arg with exp_type = instance env arg.exp_type}) -and type_argument ?typeClashContext ?recarg env sarg ty_expected' ty_expected = +and type_argument ?type_clash_context ?recarg env sarg ty_expected' ty_expected = (* ty_expected' may be generic *) let no_labels ty = let ls, tvar = list_labels env ty in @@ -3100,8 +3100,8 @@ and type_argument ?typeClashContext ?recarg env sarg ty_expected' ty_expected = func let_var) } end | _ -> - let texp = type_expect ?typeClashContext ?recarg env sarg ty_expected' in - unify_exp ?typeClashContext env texp ty_expected; + let texp = type_expect ?type_clash_context ?recarg env sarg ty_expected' in + unify_exp ?type_clash_context env texp ty_expected; texp and is_automatic_curried_application env funct = (* When a curried function is used with uncurried application, treat it as a curried application *) @@ -3109,7 +3109,7 @@ and is_automatic_curried_application env funct = match (expand_head env funct.exp_type).desc with | Tarrow _ -> true | _ -> false -and type_application ?typeClashContext uncurried env funct (sargs : sargs) : targs * Types.type_expr * bool = +and type_application ?type_clash_context uncurried env funct (sargs : sargs) : targs * Types.type_expr * bool = (* funct.exp_type may be generic *) let result_type omitted ty_fun = List.fold_left @@ -3123,8 +3123,8 @@ and type_application ?typeClashContext uncurried env funct (sargs : sargs) : tar let ignored = ref [] in let has_uncurried_type t = match (expand_head env t).desc with - | Tconstr (Pident {name = "function$"},[t; tArity],_) -> - let arity = Ast_uncurried.type_to_arity tArity in + | Tconstr (Pident {name = "function$"},[t; t_arity],_) -> + let arity = Ast_uncurried.type_to_arity t_arity in Some (arity, t) | _ -> None in let force_uncurried_type funct = @@ -3148,7 +3148,7 @@ and type_application ?typeClashContext uncurried env funct (sargs : sargs) : tar Uncurried_arity_mismatch (t, arity, List.length sargs))); t1, arity | None -> t, max_int in - let update_uncurried_arity ~nargs t newT = + let update_uncurried_arity ~nargs t new_t = match has_uncurried_type t with | Some (arity, _) -> let newarity = arity - nargs in @@ -3156,9 +3156,9 @@ and type_application ?typeClashContext uncurried env funct (sargs : sargs) : tar if uncurried && not fully_applied then raise(Error(funct.exp_loc, env, Uncurried_arity_mismatch (t, arity, List.length sargs))); - let newT = if fully_applied then newT else Ast_uncurried.make_uncurried_type ~env ~arity:newarity newT in - (fully_applied, newT) - | _ -> (false, newT) + let new_t = if fully_applied then new_t else Ast_uncurried.make_uncurried_type ~env ~arity:newarity new_t in + (fully_applied, new_t) + | _ -> (false, new_t) in let rec type_unknown_args max_arity ~(args : lazy_args) omitted ty_fun (syntax_args : sargs) : targs * _ = @@ -3224,7 +3224,7 @@ and type_application ?typeClashContext uncurried env funct (sargs : sargs) : tar in type_unknown_args max_arity ~args:((l1, Some arg1) :: args) omitted ty2 sargl in - let rec type_args ?typeClashContext max_arity args omitted ~ty_fun ty_fun0 ~(sargs : sargs) = + let rec type_args ?type_clash_context max_arity args omitted ~ty_fun ty_fun0 ~(sargs : sargs) = match expand_head env ty_fun, expand_head env ty_fun0 with {desc=Tarrow (l, ty, ty_fun, com); level=lv} , {desc=Tarrow (_, ty0, ty_fun0, _)} @@ -3247,13 +3247,13 @@ and type_application ?typeClashContext uncurried env funct (sargs : sargs) : tar sargs, omitted , Some ( if not optional || is_optional l' then - (fun () -> type_argument ?typeClashContext:(typeClashContextForFunctionArgument typeClashContext sarg0) env sarg0 ty ty0) + (fun () -> type_argument ?type_clash_context:(type_clash_context_for_function_argument type_clash_context sarg0) env sarg0 ty ty0) else - (fun () -> option_some (type_argument ?typeClashContext env sarg0 + (fun () -> option_some (type_argument ?type_clash_context env sarg0 (extract_option_type env ty) (extract_option_type env ty0)))) in - type_args ?typeClashContext max_arity ((l,arg)::args) omitted ~ty_fun ty_fun0 ~sargs + type_args ?type_clash_context max_arity ((l,arg)::args) omitted ~ty_fun ty_fun0 ~sargs | _ -> type_unknown_args max_arity ~args omitted ty_fun0 sargs (* This is the hot path for non-labeled function*) in @@ -3289,7 +3289,7 @@ and type_application ?typeClashContext uncurried env funct (sargs : sargs) : tar | _ -> if uncurried then force_uncurried_type funct; let ty, max_arity = extract_uncurried_type funct.exp_type in - let targs, ret_t = type_args ?typeClashContext max_arity [] [] ~ty_fun:ty (instance env ty) ~sargs in + let targs, ret_t = type_args ?type_clash_context max_arity [] [] ~ty_fun:ty (instance env ty) ~sargs in let fully_applied, ret_t = update_uncurried_arity funct.exp_type ~nargs:(List.length !ignored + List.length sargs) ret_t in targs, ret_t, fully_applied @@ -3328,11 +3328,11 @@ and type_construct env loc lid sarg ty_expected attrs = exp_type = ty_res; exp_attributes = attrs; exp_env = env } in - let typeClashContext = typeClashContextMaybeOption ty_expected ty_res in + let type_clash_context = type_clash_context_maybe_option ty_expected ty_res in if separate then begin end_def (); generalize_structure ty_res; - unify_exp ?typeClashContext env {texp with exp_type = instance_def ty_res} + unify_exp ?type_clash_context env {texp with exp_type = instance_def ty_res} (instance env ty_expected); end_def (); List.iter generalize_structure ty_args; @@ -3344,7 +3344,7 @@ and type_construct env loc lid sarg ty_expected attrs = | _ -> assert false in let texp = {texp with exp_type = ty_res} in - if not separate then unify_exp ?typeClashContext env texp (instance env ty_expected); + if not separate then unify_exp ?type_clash_context env texp (instance env ty_expected); let recarg = match constr.cstr_inlined with | None -> Rejected @@ -3378,13 +3378,13 @@ and type_statement env sexp = if is_Tvar ty && ty.level > tv.level then Location.prerr_warning loc Warnings.Nonreturning_statement; let expected_ty = instance_def Predef.type_unit in - let typeClashContext = typeClashContextInStatement sexp in - unify_exp ?typeClashContext env exp expected_ty; + let type_clash_context = type_clash_context_in_statement sexp in + unify_exp ?type_clash_context env exp expected_ty; exp (* Typing of match cases *) -and type_cases ?rootTypeClashContext ?in_function env ty_arg ty_res partial_flag loc caselist : _ * Typedtree.partial = +and type_cases ?root_type_clash_context ?in_function env ty_arg ty_res partial_flag loc caselist : _ * Typedtree.partial = (* ty_arg is _fully_ generalized *) let patterns = List.map (fun {pc_lhs=p} -> p) caselist in let contains_polyvars = List.exists contains_polymorphic_variant patterns in @@ -3491,10 +3491,10 @@ and type_cases ?rootTypeClashContext ?in_function env ty_arg ty_res partial_flag | None -> None | Some scond -> Some - (type_expect ?typeClashContext:(if Option.is_some rootTypeClashContext then Some IfCondition else None) ext_env (wrap_unpacks scond unpacks) + (type_expect ?type_clash_context:(if Option.is_some root_type_clash_context then Some IfCondition else None) ext_env (wrap_unpacks scond unpacks) Predef.type_bool) in - let exp = type_expect ?typeClashContext:rootTypeClashContext ?in_function ext_env sexp ty_res' in + let exp = type_expect ?type_clash_context:root_type_clash_context ?in_function ext_env sexp ty_res' in { c_lhs = pat; c_guard = guard; @@ -3758,11 +3758,11 @@ let type_expression env sexp = let formatter = Format.formatter_of_buffer buffer in Printtyp.type_expr formatter exp.exp_type; Format.pp_print_flush formatter (); - let returnType = Buffer.contents buffer in + let return_type = Buffer.contents buffer in Location.prerr_warning sexp.pexp_loc (Bs_toplevel_expression_unit ( match sexp.pexp_desc with - | Pexp_apply _ -> Some (returnType, FunctionCall) - | _ -> Some (returnType, Other) + | Pexp_apply _ -> Some (return_type, FunctionCall) + | _ -> Some (return_type, Other) )) | Tags _ -> Location.prerr_warning sexp.pexp_loc (Bs_toplevel_expression_unit None)); end_def(); @@ -3836,38 +3836,38 @@ let report_error env ppf = function ), _) -> fprintf ppf "This function is an uncurried function where a curried function is expected" | Expr_type_clash (( - (_, {desc = Tconstr (Pident {name = "function$"},[_; tA],_)}) :: - (_, {desc = Tconstr (Pident {name = "function$"},[_; tB],_)}) :: _ - ), _) when Ast_uncurried.type_to_arity tA <> Ast_uncurried.type_to_arity tB -> - let arityA = Ast_uncurried.type_to_arity tA |> string_of_int in - let arityB = Ast_uncurried.type_to_arity tB |> string_of_int in - reportArityMismatch ~arityA ~arityB ppf + (_, {desc = Tconstr (Pident {name = "function$"},[_; t_a],_)}) :: + (_, {desc = Tconstr (Pident {name = "function$"},[_; t_b],_)}) :: _ + ), _) when Ast_uncurried.type_to_arity t_a <> Ast_uncurried.type_to_arity t_b -> + let arity_a = Ast_uncurried.type_to_arity t_a |> string_of_int in + let arity_b = Ast_uncurried.type_to_arity t_b |> string_of_int in + report_arity_mismatch ~arity_a ~arity_b ppf | Expr_type_clash (( (_, {desc = Tconstr (Pdot (Pdot(Pident {name = "Js_OO"},"Meth",_),a,_),_,_)}) :: (_, {desc = Tconstr (Pdot (Pdot(Pident {name = "Js_OO"},"Meth",_),b,_),_,_)}) :: _ ), _) when a <> b -> fprintf ppf "This method has %s but was expected %s" a b - | Expr_type_clash (trace, typeClashContext) -> + | Expr_type_clash (trace, type_clash_context) -> (* modified *) fprintf ppf "@["; - print_expr_type_clash ?typeClashContext env trace ppf; + print_expr_type_clash ?type_clash_context env trace ppf; fprintf ppf "@]" | Apply_non_function typ -> (* modified *) reset_and_mark_loops typ; begin match (repr typ).desc with - Tarrow (_, _inputType, returnType, _) -> - let rec countNumberOfArgs count {Types.desc} = match desc with - | Tarrow (_, _inputType, returnType, _) -> countNumberOfArgs (count + 1) returnType + Tarrow (_, _inputType, return_type, _) -> + let rec count_number_of_args count {Types.desc} = match desc with + | Tarrow (_, _inputType, return_type, _) -> count_number_of_args (count + 1) return_type | _ -> count in - let countNumberOfArgs = countNumberOfArgs 1 in - let acceptsCount = countNumberOfArgs returnType in + let count_number_of_args = count_number_of_args 1 in + let accepts_count = count_number_of_args return_type in fprintf ppf "@[@[<2>This function has type@ @{%a@}@]" type_expr typ; fprintf ppf "@ @[It only accepts %i %s; here, it's called with more.@]@]" - acceptsCount (if acceptsCount == 1 then "argument" else "arguments") + accepts_count (if accepts_count == 1 then "argument" else "arguments") | _ -> fprintf ppf "@[@[<2>This expression has type@ %a@]@ %s@]" type_expr typ @@ -4063,9 +4063,9 @@ let report_error env ppf = function fprintf ppf "Label ~%s was omitted in the application of this labeled function." label | Labels_omitted labels -> - let labelsString = labels |> List.map(fun label -> "~" ^ label) |> String.concat ", " in + let labels_string = labels |> List.map(fun label -> "~" ^ label) |> String.concat ", " in fprintf ppf "Labels %s were omitted in the application of this labeled function." - labelsString + labels_string | Empty_record_literal -> fprintf ppf "Empty record literal {} should be type annotated or used in a record context." | Uncurried_arity_mismatch (typ, arity, args) -> diff --git a/jscomp/ml/typecore.mli b/jscomp/ml/typecore.mli index 650bae0d5f..23cbeedb23 100644 --- a/jscomp/ml/typecore.mli +++ b/jscomp/ml/typecore.mli @@ -68,7 +68,7 @@ type error = | Or_pattern_type_clash of Ident.t * (type_expr * type_expr) list | Multiply_bound_variable of string | Orpat_vars of Ident.t * Ident.t list - | Expr_type_clash of (type_expr * type_expr) list * (Error_message_utils.typeClashContext option) + | Expr_type_clash of (type_expr * type_expr) list * (Error_message_utils.type_clash_context option) | Apply_non_function of type_expr | Apply_wrong_label of arg_label * type_expr | Label_multiply_defined of string diff --git a/jscomp/ml/typedecl.ml b/jscomp/ml/typedecl.ml index 43a8b3f05f..f6fb1627b9 100644 --- a/jscomp/ml/typedecl.ml +++ b/jscomp/ml/typedecl.ml @@ -207,17 +207,17 @@ let make_params env params = in List.map make_param params -let transl_labels ?recordName env closed lbls = +let transl_labels ?record_name env closed lbls = if !Config.bs_only then match !Builtin_attributes.check_duplicated_labels lbls with | None -> () - | Some {loc;txt=name} -> raise (Error(loc,Duplicate_label (name, recordName))) + | Some {loc;txt=name} -> raise (Error(loc,Duplicate_label (name, record_name))) else ( let all_labels = ref StringSet.empty in List.iter (fun {pld_name = {txt=name; loc}} -> if StringSet.mem name !all_labels then - raise(Error(loc, Duplicate_label (name, recordName))); + raise(Error(loc, Duplicate_label (name, record_name))); all_labels := StringSet.add name !all_labels) lbls); let mk {pld_name=name;pld_mutable=mut;pld_type=arg;pld_loc=loc; @@ -292,7 +292,7 @@ let make_constructor env type_path type_params sargs sret_type = *) -let transl_declaration ~typeRecordAsObject env sdecl id = +let transl_declaration ~type_record_as_object env sdecl id = (* Bind type parameters *) reset_type_variables(); Ctype.begin_def (); @@ -306,19 +306,19 @@ let transl_declaration ~typeRecordAsObject env sdecl id = in let raw_status = get_unboxed_from_attributes sdecl in - let checkUntaggedVariant() = match sdecl.ptype_kind with + let check_untagged_variant() = match sdecl.ptype_kind with | Ptype_variant cds -> Ext_list.for_all cds (function | {pcd_args = Pcstr_tuple ([] | [_])} -> (* at most one payload allowed for untagged variants *) true | {pcd_args = Pcstr_tuple (_::_::_); pcd_name={txt=name}} -> - Ast_untagged_variants.reportConstructorMoreThanOneArg ~loc:sdecl.ptype_loc ~name + Ast_untagged_variants.report_constructor_more_than_one_arg ~loc:sdecl.ptype_loc ~name | {pcd_args = Pcstr_record _} -> true ) | _ -> false in - if raw_status.unboxed && not raw_status.default && not (checkUntaggedVariant()) then begin + if raw_status.unboxed && not raw_status.default && not (check_untagged_variant()) then begin match sdecl.ptype_kind with | Ptype_abstract -> raise(Error(sdecl.ptype_loc, Bad_unboxed_attribute @@ -486,16 +486,16 @@ let transl_declaration ~typeRecordAsObject env sdecl id = (fun () -> make_cstr scstr) in let tcstrs, cstrs = List.split (List.filter_map make_cstr scstrs) in - let isUntaggedDef = Ast_untagged_variants.has_untagged sdecl.ptype_attributes in - Ast_untagged_variants.check_well_formed ~env ~isUntaggedDef cstrs; + let is_untagged_def = Ast_untagged_variants.has_untagged sdecl.ptype_attributes in + Ast_untagged_variants.check_well_formed ~env ~is_untagged_def cstrs; Ttype_variant tcstrs, Type_variant cstrs, sdecl | Ptype_record lbls_ -> let has_optional attrs = Ext_list.exists attrs (fun ({txt },_) -> txt = "res.optional") in - let optionalLabels = + let optional_labels = Ext_list.filter_map lbls_ (fun lbl -> if has_optional lbl.pld_attributes then Some lbl.pld_name.txt else None) in let lbls = - if optionalLabels = [] then lbls_ + if optional_labels = [] then lbls_ else Ext_list.map lbls_ (fun lbl -> let typ = lbl.pld_type in let typ = @@ -503,13 +503,13 @@ let transl_declaration ~typeRecordAsObject env sdecl id = {typ with ptyp_desc = Ptyp_constr ({txt = Lident "option"; loc=typ.ptyp_loc}, [typ])} else typ in {lbl with pld_type = typ }) in - let lbls, lbls' = transl_labels ~recordName:(sdecl.ptype_name.txt) env true lbls in + let lbls, lbls' = transl_labels ~record_name:(sdecl.ptype_name.txt) env true lbls in let lbls_opt = match Record_type_spread.has_type_spread lbls with | true -> let rec extract t = match t.desc with | Tpoly(t, []) -> extract t | _ -> Ctype.repr t in - let mkLbl (l: Types.label_declaration) (ld_type: Typedtree.core_type) (type_vars: (string * Types.type_expr) list) : Typedtree.label_declaration = + let mk_lbl (l: Types.label_declaration) (ld_type: Typedtree.core_type) (type_vars: (string * Types.type_expr) list) : Typedtree.label_declaration = { ld_id = l.ld_id; ld_name = {txt = Ident.name l.ld_id; loc = l.ld_loc}; @@ -526,7 +526,7 @@ let transl_declaration ~typeRecordAsObject env sdecl id = process_lbls ( fst acc @ (Ext_list.map fields (fun l -> - mkLbl l ld_type type_vars)) + mk_lbl l ld_type type_vars)) , snd acc @ (Ext_list.map fields (fun l -> @@ -552,18 +552,18 @@ let transl_declaration ~typeRecordAsObject env sdecl id = (match lbls_opt with | Some (lbls, lbls') -> check_duplicates sdecl.ptype_loc lbls StringSet.empty; - let optionalLabels = + let optional_labels = Ext_list.filter_map lbls (fun lbl -> if has_optional lbl.ld_attributes then Some lbl.ld_name.txt else None) in Ttype_record lbls, Type_record(lbls', if unbox then Record_unboxed false - else if optionalLabels <> [] then - Record_optional_labels optionalLabels + else if optional_labels <> [] then + Record_optional_labels optional_labels else Record_regular), sdecl | None -> (* Could not find record type decl for ...t: assume t is an object type and this is syntax ambiguity *) - typeRecordAsObject := true; + type_record_as_object := true; let fields = Ext_list.map lbls_ (fun ld -> match ld.pld_name.txt with | "..." -> Parsetree.Oinherit ld.pld_type @@ -683,7 +683,7 @@ let check_constraints_labels env visited l pl = check_constraints_rec env (get_loc (Ident.name name) pl) visited ty) l -let check_constraints ~typeRecordAsObject env sdecl (_, decl) = +let check_constraints ~type_record_as_object env sdecl (_, decl) = let visited = ref TypeSet.empty in begin match decl.type_kind with | Type_abstract -> () @@ -732,7 +732,7 @@ let check_constraints ~typeRecordAsObject env sdecl (_, decl) = begin match decl.type_manifest with | None -> () | Some ty -> - if not !typeRecordAsObject then + if not !type_record_as_object then let sty = match sdecl.ptype_manifest with Some sty -> sty | _ -> assert false in @@ -1397,12 +1397,12 @@ let transl_type_decl env rec_flag sdecl_list = | Asttypes.Recursive | Asttypes.Nonrecursive -> id, None in - let typeRecordAsObject = ref false in + let type_record_as_object = ref false in let transl_declaration name_sdecl (id, slot) = current_slot := slot; Builtin_attributes.warning_scope name_sdecl.ptype_attributes - (fun () -> transl_declaration ~typeRecordAsObject temp_env name_sdecl id) + (fun () -> transl_declaration ~type_record_as_object temp_env name_sdecl id) in let tdecls = List.map2 transl_declaration sdecl_list (List.map id_slots id_list) in @@ -1454,7 +1454,7 @@ let transl_type_decl env rec_flag sdecl_list = | None -> ()) sdecl_list tdecls; (* Check that constraints are enforced *) - List.iter2 (check_constraints ~typeRecordAsObject newenv) sdecl_list decls; + List.iter2 (check_constraints ~type_record_as_object newenv) sdecl_list decls; (* Name recursion *) let decls = List.map2 (fun sdecl (id, decl) -> id, name_recursion sdecl id decl) @@ -2002,8 +2002,8 @@ let report_error ppf = function fprintf ppf "Two constructors are named %s" s | Duplicate_label (s, None) -> fprintf ppf "The field @{%s@} is defined several times in this record. Fields can only be added once to a record." s - | Duplicate_label (s, Some recordName) -> - fprintf ppf "The field @{%s@} is defined several times in the record @{%s@}. Fields can only be added once to a record." s recordName + | Duplicate_label (s, Some record_name) -> + fprintf ppf "The field @{%s@} is defined several times in the record @{%s@}. Fields can only be added once to a record." s record_name | Recursive_abbrev s -> fprintf ppf "The type abbreviation %s is cyclic" s | Cycle_in_def (s, ty) -> diff --git a/jscomp/ml/variant_coercion.ml b/jscomp/ml/variant_coercion.ml index e2b272d2a6..86f525ad2c 100644 --- a/jscomp/ml/variant_coercion.ml +++ b/jscomp/ml/variant_coercion.ml @@ -25,16 +25,16 @@ let variant_has_relevant_primitive_catch_all (constructors : Types.constructor_d variant_has_catch_all_case constructors can_coerce_primitive (* Checks if every case of the variant has the same runtime representation as the target type. *) -let variant_has_same_runtime_representation_as_target ~(targetPath : Path.t) +let variant_has_same_runtime_representation_as_target ~(target_path : Path.t) ~unboxed (constructors : Types.constructor_declaration list) = (* Helper function to check if a constructor has the same runtime representation as the target type *) let has_same_runtime_representation (c : Types.constructor_declaration) = let args = c.cd_args in - let asPayload = Ast_untagged_variants.process_tag_type c.cd_attributes in + let as_payload = Ast_untagged_variants.process_tag_type c.cd_attributes in match args with | Cstr_tuple [{desc = Tconstr (p, [], _)}] when unboxed -> - let path_same = check_paths_same p targetPath in + let path_same = check_paths_same p target_path in (* unboxed String(string) :> string *) path_same Predef.path_string || (* unboxed Number(float) :> float *) @@ -44,11 +44,11 @@ let variant_has_same_runtime_representation_as_target ~(targetPath : Path.t) | Cstr_tuple [] -> ( (* Check that @as payloads match with the target path to coerce to. No @as means the default encoding, which is string *) - match asPayload with - | None | Some (String _) -> Path.same targetPath Predef.path_string - | Some (Int _) -> Path.same targetPath Predef.path_int - | Some (Float _) -> Path.same targetPath Predef.path_float - | Some (BigInt _) -> Path.same targetPath Predef.path_bigint + match as_payload with + | None | Some (String _) -> Path.same target_path Predef.path_string + | Some (Int _) -> Path.same target_path Predef.path_int + | Some (Float _) -> Path.same target_path Predef.path_float + | Some (BigInt _) -> Path.same target_path Predef.path_bigint | Some (Null | Undefined | Bool _ | Untagged _) -> false) | _ -> false in diff --git a/jscomp/syntax/benchmarks/Benchmark.ml b/jscomp/syntax/benchmarks/Benchmark.ml index 1a9f3cc49b..3afa9e88f5 100644 --- a/jscomp/syntax/benchmarks/Benchmark.ml +++ b/jscomp/syntax/benchmarks/Benchmark.ml @@ -5,18 +5,18 @@ module Parser = Res_parser module Printer = Res_printer module IO : sig - val readFile : string -> string + val read_file : string -> string end = struct (* random chunk size: 2^15, TODO: why do we guess randomly? *) - let chunkSize = 32768 + let chunk_size = 32768 - let readFile filename = + let read_file filename = let chan = open_in filename in - let buffer = Buffer.create chunkSize in - let chunk = (Bytes.create [@doesNotRaise]) chunkSize in + let buffer = Buffer.create chunk_size in + let chunk = (Bytes.create [@doesNotRaise]) chunk_size in let rec loop () = let len = - try input chan chunk 0 chunkSize with Invalid_argument _ -> 0 + try input chan chunk 0 chunk_size with Invalid_argument _ -> 0 in if len == 0 then ( close_in_noerr chan; @@ -33,7 +33,7 @@ module Time : sig val now : unit -> t - val toUint64 : t -> int64 [@@live] + val to_uint64 : t -> int64 [@@live] (* let of_uint64_ns ns = ns *) @@ -55,7 +55,7 @@ end = struct let zero = 0L - let toUint64 s = s + let to_uint64 s = s let nanosecond = 1L let microsecond = Int64.mul 1000L nanosecond @@ -86,15 +86,15 @@ end = struct mutable start: Time.t; mutable n: int; (* current iterations count *) mutable duration: Time.t; - benchFunc: t -> unit; - mutable timerOn: bool; + bench_func: t -> unit; + mutable timer_on: bool; (* mutable result: benchmarkResult; *) (* The initial states *) - mutable startAllocs: float; - mutable startBytes: float; + mutable start_allocs: float; + mutable start_bytes: float; (* The net total of this test after being run. *) - mutable netAllocs: float; - mutable netBytes: float; + mutable net_allocs: float; + mutable net_bytes: float; } let report b = @@ -107,10 +107,10 @@ end = struct (Time.print b.duration /. float_of_int b.n)); print_endline (Format.sprintf "Allocs/op: %d" - (int_of_float (b.netAllocs /. float_of_int b.n))); + (int_of_float (b.net_allocs /. float_of_int b.n))); print_endline (Format.sprintf "B/op: %d" - (int_of_float (b.netBytes /. float_of_int b.n))); + (int_of_float (b.net_bytes /. float_of_int b.n))); (* return (float64(r.Bytes) * float64(r.N) / 1e6) / r.T.Seconds() *) print_newline (); @@ -121,13 +121,13 @@ end = struct name; start = Time.zero; n = 0; - benchFunc = f; + bench_func = f; duration = Time.zero; - timerOn = false; - startAllocs = 0.; - startBytes = 0.; - netAllocs = 0.; - netBytes = 0.; + timer_on = false; + start_allocs = 0.; + start_bytes = 0.; + net_allocs = 0.; + net_bytes = 0.; } (* total amount of memory allocated by the program since it started in words *) @@ -135,44 +135,44 @@ end = struct let stats = Gc.quick_stat () in stats.minor_words +. stats.major_words -. stats.promoted_words - let startTimer b = - if not b.timerOn then ( - let allocatedWords = mallocs () in - b.startAllocs <- allocatedWords; - b.startBytes <- allocatedWords *. 8.; + let start_timer b = + if not b.timer_on then ( + let allocated_words = mallocs () in + b.start_allocs <- allocated_words; + b.start_bytes <- allocated_words *. 8.; b.start <- Time.now (); - b.timerOn <- true) + b.timer_on <- true) - let stopTimer b = - if b.timerOn then ( - let allocatedWords = mallocs () in + let stop_timer b = + if b.timer_on then ( + let allocated_words = mallocs () in let diff = Time.diff b.start (Time.now ()) in b.duration <- Time.add b.duration diff; - b.netAllocs <- b.netAllocs +. (allocatedWords -. b.startAllocs); - b.netBytes <- b.netBytes +. ((allocatedWords *. 8.) -. b.startBytes); - b.timerOn <- false) - - let resetTimer b = - if b.timerOn then ( - let allocatedWords = mallocs () in - b.startAllocs <- allocatedWords; - b.netAllocs <- allocatedWords *. 8.; + b.net_allocs <- b.net_allocs +. (allocated_words -. b.start_allocs); + b.net_bytes <- b.net_bytes +. ((allocated_words *. 8.) -. b.start_bytes); + b.timer_on <- false) + + let reset_timer b = + if b.timer_on then ( + let allocated_words = mallocs () in + b.start_allocs <- allocated_words; + b.net_allocs <- allocated_words *. 8.; b.start <- Time.now ()); - b.netAllocs <- 0.; - b.netBytes <- 0. + b.net_allocs <- 0.; + b.net_bytes <- 0. - let runIteration b n = + let run_iteration b n = Gc.full_major (); b.n <- n; - resetTimer b; - startTimer b; - b.benchFunc b; - stopTimer b + reset_timer b; + start_timer b; + b.bench_func b; + stop_timer b let launch b = (* 150 runs * all the benchmarks means around 1m of benchmark time *) for n = 1 to 150 do - runIteration b n + run_iteration b n done end @@ -192,64 +192,64 @@ end = struct | Ocaml -> "ocaml" | Rescript -> "rescript" - let parseOcaml src filename = + let parse_ocaml src filename = let lexbuf = Lexing.from_string src in Location.init lexbuf filename; Parse.implementation lexbuf - let parseRescript src filename = + let parse_rescript src filename = let p = Parser.make src filename in - let structure = ResParser.parseImplementation p in + let structure = ResParser.parse_implementation p in assert (p.diagnostics == []); structure let benchmark filename lang action = - let src = IO.readFile filename in + let src = IO.read_file filename in let name = filename ^ " " ^ string_of_lang lang ^ " " ^ string_of_action action in - let benchmarkFn = + let benchmark_fn = match (lang, action) with | Rescript, Parse -> fun _ -> - let _ = Sys.opaque_identity (parseRescript src filename) in + let _ = Sys.opaque_identity (parse_rescript src filename) in () | Ocaml, Parse -> fun _ -> - let _ = Sys.opaque_identity (parseOcaml src filename) in + let _ = Sys.opaque_identity (parse_ocaml src filename) in () | Rescript, Print -> let p = Parser.make src filename in - let ast = ResParser.parseImplementation p in + let ast = ResParser.parse_implementation p in fun _ -> let _ = Sys.opaque_identity - (let cmtTbl = CommentTable.make () in + (let cmt_tbl = CommentTable.make () in let comments = List.rev p.Parser.comments in - let () = CommentTable.walkStructure ast cmtTbl comments in - Doc.toString ~width:80 (Printer.printStructure ast cmtTbl)) + let () = CommentTable.walk_structure ast cmt_tbl comments in + Doc.to_string ~width:80 (Printer.print_structure ast cmt_tbl)) in () | _ -> fun _ -> () in - let b = Benchmark.make ~name ~f:benchmarkFn () in + let b = Benchmark.make ~name ~f:benchmark_fn () in Benchmark.launch b; Benchmark.report b let run () = - let dataDir = "jscomp/syntax/benchmarks/data" in - benchmark (Filename.concat dataDir "RedBlackTree.res") Rescript Parse; - benchmark (Filename.concat dataDir "RedBlackTree.ml") Ocaml Parse; - benchmark (Filename.concat dataDir "RedBlackTree.res") Rescript Print; + let data_dir = "jscomp/syntax/benchmarks/data" in + benchmark (Filename.concat data_dir "RedBlackTree.res") Rescript Parse; + benchmark (Filename.concat data_dir "RedBlackTree.ml") Ocaml Parse; + benchmark (Filename.concat data_dir "RedBlackTree.res") Rescript Print; benchmark - (Filename.concat dataDir "RedBlackTreeNoComments.res") + (Filename.concat data_dir "RedBlackTreeNoComments.res") Rescript Print; - benchmark (Filename.concat dataDir "Napkinscript.res") Rescript Parse; - benchmark (Filename.concat dataDir "Napkinscript.ml") Ocaml Parse; - benchmark (Filename.concat dataDir "Napkinscript.res") Rescript Print; - benchmark (Filename.concat dataDir "HeroGraphic.res") Rescript Parse; - benchmark (Filename.concat dataDir "HeroGraphic.ml") Ocaml Parse; - benchmark (Filename.concat dataDir "HeroGraphic.res") Rescript Print + benchmark (Filename.concat data_dir "Napkinscript.res") Rescript Parse; + benchmark (Filename.concat data_dir "Napkinscript.ml") Ocaml Parse; + benchmark (Filename.concat data_dir "Napkinscript.res") Rescript Print; + benchmark (Filename.concat data_dir "HeroGraphic.res") Rescript Parse; + benchmark (Filename.concat data_dir "HeroGraphic.ml") Ocaml Parse; + benchmark (Filename.concat data_dir "HeroGraphic.res") Rescript Print end let () = Benchmarks.run () diff --git a/jscomp/syntax/benchmarks/data/HeroGraphic.ml b/jscomp/syntax/benchmarks/data/HeroGraphic.ml index e33360dbd5..fd79c89436 100644 --- a/jscomp/syntax/benchmarks/data/HeroGraphic.ml +++ b/jscomp/syntax/benchmarks/data/HeroGraphic.ml @@ -1,7 +1,7 @@ ;;[%raw {|require('./HeroGraphic.css')|}] let make ?(width= "760") ?(height= "380") = ((svg ~width:((width)) ~height:((height)) - ~viewBox:(("0 0 758 381")) ~fill:(("none") + ~view_box:(("0 0 758 381")) ~fill:(("none") ) ~xmlns:(("http://www.w3.org/2000/svg") ) ~children:[((path @@ -14,7 +14,7 @@ let make ?(width= "760") ?(height= "380") = ) ~fill:(("#0D1522")) ~children:[] ()) [@JSX ]); - ((path ~className:(("HeroGraphic-cloudLeft") + ((path ~class_name:(("HeroGraphic-cloudLeft") ) ~opacity:(("0.7")) ~d:(("M0.4885 96.7017H97.599C97.599 96.7017 99.0047 89.1463 88.6152 87.8779C88.6152 87.8779 87.393 74.4216 72.6644 69.6237C57.9359 64.8258 51.2133 72.2157 51.2133 72.2157C51.2133 72.2157 46.6909 67.3075 40.8239 68.0244C34.8958 68.7413 32.4513 75.5246 32.4513 75.5246C32.4513 75.5246 28.9677 73.3187 25.3009 75.1386C21.634 76.9585 21.8174 79.385 21.8174 79.385C21.8174 79.385 17.6005 78.4475 14.6059 78.282C11.6113 78.0615 -2.75056 78.999 0.4885 96.7017Z") ) ~fill:(("white")) @@ -407,10 +407,10 @@ let make ?(width= "760") ?(height= "380") = ) ~fill:(("#E37056")) ~children:[] ()) [@JSX ]); - ((path ~className:(("HeroGraphic-wave")) + ((path ~class_name:(("HeroGraphic-wave")) ~d:(("M81.5264 248.14H667.612C667.612 248.14 680.14 249.518 680.14 263.747C680.14 277.975 670.362 280.953 670.362 280.953H582.174C582.174 280.953 594.703 282.939 594.703 297.663C594.703 312.388 585.474 313.877 585.474 313.877H527.233C527.233 313.877 510.365 315.366 511.465 326.671C512.565 337.977 522.893 338.969 522.893 338.969H629.538C629.538 338.969 646.955 340.458 645.855 356.672C644.755 372.886 634.977 372.886 634.977 372.886H188.721C188.721 372.886 169.653 371.893 170.203 357.168C170.753 342.444 189.271 343.436 189.271 343.436H124.49C124.49 343.436 107.317 344.374 107.317 331.028C107.317 313.491 124.551 314.925 124.551 314.925H145.146C145.146 314.925 161.953 316.138 161.953 298.876C161.953 286.523 147.346 285.475 147.346 285.475H80.3041C80.3041 285.475 59.0975 283.214 59.1586 268.545C59.2808 253.655 68.998 248.14 81.5264 248.14Z") ) ~fill:(("url(#paint0_linear)") - ) ~fillOpacity:(("0.7") + ) ~fill_opacity:(("0.7") ) ~children:[] ()) [@JSX ]); ((path ~opacity:(("0.66")) @@ -443,7 +443,7 @@ let make ?(width= "760") ?(height= "380") = ) ~fill:(("#2484C6")) ~children:[] ()) [@JSX ]); - ((path ~className:(("HeroGraphic-wave")) + ((path ~class_name:(("HeroGraphic-wave")) ~d:(("M391.681 296.836C391.681 295.733 392.659 294.85 393.881 294.85H479.747C480.969 294.85 481.947 295.733 481.947 296.836C481.947 297.939 480.969 298.821 479.747 298.821H393.881C392.659 298.766 391.681 297.884 391.681 296.836Z") ) ~fill:(("#2484C6")) ~children:[] ()) @@ -453,7 +453,7 @@ let make ?(width= "760") ?(height= "380") = ) ~fill:(("#2484C6")) ~children:[] ()) [@JSX ]); - ((path ~className:(("HeroGraphic-wave")) + ((path ~class_name:(("HeroGraphic-wave")) ~d:(("M309.788 324.631C309.788 326.009 308.566 327.168 306.977 327.168H236.634C235.106 327.168 233.823 326.065 233.823 324.631C233.823 323.252 235.045 322.094 236.634 322.094H307.038C308.505 322.094 309.788 323.252 309.788 324.631Z") ) ~fill:(("#2484C6")) ~children:[] ()) @@ -7167,10 +7167,10 @@ let make ?(width= "760") ?(height= "380") = ((path ~d:(("M531.877 158.964L549.05 181.741L530.594 206.282L514.765 181.741L531.877 158.964Z") ) ~stroke:(("#E37056")) - ~strokeWidth:(("3")) - ~strokeMiterlimit:(("10")) - ~strokeLinecap:(("round")) - ~strokeLinejoin:(("round")) ~children:[] + ~stroke_width:(("3")) + ~stroke_miterlimit:(("10")) + ~stroke_linecap:(("round")) + ~stroke_linejoin:(("round")) ~children:[] ()) [@JSX ]); ((path @@ -8363,7 +8363,7 @@ let make ?(width= "760") ?(height= "380") = ) ~fill:(("#2484C6")) ~children:[] ()) [@JSX ]); - ((path ~className:(("HeroGraphic-cloudRight") + ((path ~class_name:(("HeroGraphic-cloudRight") ) ~opacity:(("0.7")) ~d:(("M609.126 61.903H757.878C757.878 61.903 760.078 50.3218 744.127 48.3364C744.127 48.3364 742.232 27.7108 719.742 20.3761C697.252 13.0413 686.924 24.3468 686.924 24.3468C686.924 24.3468 680.018 16.8466 670.973 17.8944C661.928 18.9422 658.139 29.4205 658.139 29.4205C658.139 29.4205 652.822 26.0564 647.2 28.869C641.577 31.6815 641.883 35.3765 641.883 35.3765C641.883 35.3765 635.405 33.9426 630.821 33.6669C626.238 33.3912 604.237 34.825 609.126 61.903Z") ) ~fill:(("white")) @@ -8464,13 +8464,13 @@ let make ?(width= "760") ?(height= "380") = ) ~fill:(("#E37056")) ~children:[] ()) [@JSX ]); - ((path ~className:(("HeroGraphic-starCenterLeft") + ((path ~class_name:(("HeroGraphic-starCenterLeft") ) ~d:(("M380.497 100.893L381.17 102.161L382.759 102.382L381.658 103.375L381.903 104.809L380.497 104.147L379.092 104.809L379.336 103.375L378.175 102.382L379.764 102.161L380.497 100.893Z") ) ~fill:(("#E37056")) ~children:[] ()) [@JSX ]); - ((path ~className:(("HeroGraphic-startRight") + ((path ~class_name:(("HeroGraphic-startRight") ) ~d:(("M160.914 73.9805L161.647 75.2489L163.236 75.4695L162.075 76.4621L162.319 77.896L160.914 77.2342L159.508 77.896L159.814 76.4621L158.653 75.4695L160.242 75.2489L160.914 73.9805Z") ) ~fill:(("#E37056")) @@ -8486,7 +8486,7 @@ let make ?(width= "760") ?(height= "380") = ) ~fill:(("#E37056")) ~children:[] ()) [@JSX ]); - ((path ~className:(("HeroGraphic-starCenterLeft") + ((path ~class_name:(("HeroGraphic-starCenterLeft") ) ~d:(("M531.877 90.9662L532.427 91.9589L533.649 92.1244L532.733 92.8964L532.977 93.9443L531.877 93.4479L530.838 93.9443L531.022 92.8964L530.166 92.1244L531.388 91.9589L531.877 90.9662Z") ) ~fill:(("#E37056")) @@ -8502,13 +8502,13 @@ let make ?(width= "760") ?(height= "380") = ) ~fill:(("#E37056")) ~children:[] ()) [@JSX ]); - ((path ~className:(("HeroGraphic-starRight") + ((path ~class_name:(("HeroGraphic-starRight") ) ~d:(("M669.873 94.3854L671.095 96.7017L673.907 97.0326L671.89 98.7973L672.379 101.334L669.873 100.121L667.368 101.334L667.856 98.7973L665.84 97.0326L668.59 96.7017L669.873 94.3854Z") ) ~fill:(("#E37056")) ~children:[] ()) [@JSX ]); - ((path ~className:(("HeroGraphic-starCenter") + ((path ~class_name:(("HeroGraphic-starCenter") ) ~d:(("M261.997 28.0417L263.28 30.3028L266.03 30.6888L264.014 32.4536L264.502 34.9904L261.997 33.7771L259.552 34.9904L259.98 32.4536L257.963 30.6888L260.774 30.3028L261.997 28.0417Z") ) ~fill:(("#E37056")) @@ -8605,47 +8605,47 @@ let make ?(width= "760") ?(height= "380") = ~children:[] ()) [@JSX ]); ((defs - ~children:[((linearGradient ~id:(("paint0_linear") + ~children:[((linear_gradient ~id:(("paint0_linear") ) ~x1:(("374.5") ) ~y1:(("180.64") ) ~x2:(("362.765") ) ~y2:(("435.722") ) - ~gradientUnits:(("userSpaceOnUse") + ~gradient_units:(("userSpaceOnUse") ) ~children:[((stop ~offset:(("0.0658436") ) - ~stopColor:(("#3A7DDD") + ~stop_color:(("#3A7DDD") ) ~children:[] ()) [@JSX ]); ((stop ~offset:(("0.4001") ) - ~stopColor:(("#265291") + ~stop_color:(("#265291") ) ~children:[] ()) [@JSX ]); ((stop ~offset:(("0.571") ) - ~stopColor:(("#1D3E6E") + ~stop_color:(("#1D3E6E") ) ~children:[] ()) [@JSX ]); ((stop ~offset:(("0.7224") ) - ~stopColor:(("#173156") + ~stop_color:(("#173156") ) ~children:[] ()) [@JSX ]); ((stop ~offset:(("0.8486") ) - ~stopColor:(("#10213A") + ~stop_color:(("#10213A") ) ~children:[] ()) [@JSX ]); ((stop ~offset:(("0.9342") ) - ~stopColor:(("#091321") + ~stop_color:(("#091321") ) ~children:[] ()) [@JSX ])] ()) diff --git a/jscomp/syntax/benchmarks/data/Napkinscript.ml b/jscomp/syntax/benchmarks/data/Napkinscript.ml index 37512e4fcd..8011a18d1f 100644 --- a/jscomp/syntax/benchmarks/data/Napkinscript.ml +++ b/jscomp/syntax/benchmarks/data/Napkinscript.ml @@ -68,7 +68,7 @@ end module Doc = struct type mode = Break | Flat - type lineStyle = + type line_style = | Classic (* fits? -> replace with space *) | Soft (* fits? -> replaced with nothing *) | Hard (* always included, forces breaks in parents *) @@ -80,25 +80,25 @@ module Doc = struct | Indent of t | IfBreaks of {yes: t; no: t} | LineSuffix of t - | LineBreak of lineStyle - | Group of {shouldBreak: bool; doc: t} + | LineBreak of line_style + | Group of {should_break: bool; doc: t} | CustomLayout of t list | BreakParent (* | Cursor *) let nil = Nil let line = LineBreak Classic - let hardLine = LineBreak Hard - let softLine = LineBreak Soft + let hard_line = LineBreak Hard + let soft_line = LineBreak Soft let text s = Text s let concat l = Concat l let indent d = Indent d - let ifBreaks t f = IfBreaks {yes = t; no = f} - 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 if_breaks t f = IfBreaks {yes = t; no = f} + 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 cursor = Cursor *) let space = Text " " @@ -106,8 +106,8 @@ module Doc = struct let dot = Text "." let dotdot = Text ".." let dotdotdot = Text "..." - let lessThan = Text "<" - let greaterThan = Text ">" + let less_than = Text "<" + let greater_than = Text ">" let lbrace = Text "{" let rbrace = Text "}" let lparen = Text "(" @@ -117,10 +117,10 @@ module Doc = struct let question = Text "?" let tilde = Text "~" let equal = Text "=" - let trailingComma = IfBreaks {yes = comma; no = nil} - let doubleQuote = Text "\"" + let trailing_comma = IfBreaks {yes = comma; no = nil} + let double_quote = Text "\"" - let propagateForcedBreaks doc = + let propagate_forced_breaks doc = let rec walk doc = match doc with | Text _ | Nil | LineSuffix _ -> (false, doc) @@ -131,27 +131,27 @@ module Doc = struct | LineBreak (Classic | Soft) -> (false, doc) | Indent children -> - let (childForcesBreak, newChildren) = walk children in - (childForcesBreak, Indent newChildren) - | IfBreaks {yes = trueDoc; no = falseDoc} -> - let (falseForceBreak, falseDoc) = walk falseDoc in - if falseForceBreak then - let (_, trueDoc) = walk trueDoc in - (true, trueDoc) + let (child_forces_break, new_children) = walk children in + (child_forces_break, Indent new_children) + | IfBreaks {yes = true_doc; no = false_doc} -> + let (false_force_break, false_doc) = walk false_doc in + if false_force_break then + let (_, true_doc) = walk true_doc in + (true, true_doc) else - let forceBreak, trueDoc = walk trueDoc in - (forceBreak, IfBreaks {yes = trueDoc; no = falseDoc}) - | Group {shouldBreak = forceBreak; doc = children} -> - let (childForcesBreak, newChildren) = walk children in - let shouldBreak = forceBreak || childForcesBreak in - (shouldBreak, Group {shouldBreak; doc = newChildren}) + let force_break, true_doc = walk true_doc in + (force_break, IfBreaks {yes = true_doc; no = false_doc}) + | Group {should_break = force_break; doc = children} -> + let (child_forces_break, new_children) = walk children in + let should_break = force_break || child_forces_break in + (should_break, Group {should_break; doc = new_children}) | Concat children -> - let (forceBreak, newChildren) = List.fold_left (fun (forceBreak, newChildren) child -> - let (childForcesBreak, newChild) = walk child in - (forceBreak || childForcesBreak, newChild::newChildren) + let (force_break, new_children) = List.fold_left (fun (force_break, new_children) child -> + let (child_forces_break, new_child) = walk child in + (force_break || child_forces_break, new_child::new_children) ) (false, []) children in - (forceBreak, Concat (List.rev newChildren)) + (force_break, Concat (List.rev new_children)) | CustomLayout children -> (* When using CustomLayout, we don't want to propagate forced breaks * from the children up. By definition it picks the first layout that fits @@ -164,8 +164,8 @@ module Doc = struct in (false, CustomLayout children) in - let (_, processedDoc) = walk doc in - processedDoc + let (_, processed_doc) = walk doc in + processed_doc let join ~sep docs = let rec loop acc sep docs = @@ -188,14 +188,14 @@ module Doc = struct fits w rest | (_ind, _mode, Nil)::rest -> fits w rest | (_ind, Break, LineBreak _break)::_rest -> true - | (ind, mode, Group {shouldBreak = forceBreak; doc})::rest -> - let mode = if forceBreak then Break else mode in + | (ind, mode, Group {should_break = force_break; doc})::rest -> + let mode = if force_break then Break else mode in fits w ((ind, mode, doc)::rest) - | (ind, mode, IfBreaks {yes = breakDoc; no = flatDoc})::rest -> + | (ind, mode, IfBreaks {yes = break_doc; no = flat_doc})::rest -> if mode = Break then - fits w ((ind, mode, breakDoc)::rest) + fits w ((ind, mode, break_doc)::rest) else - fits w ((ind, mode, flatDoc)::rest) + fits w ((ind, mode, flat_doc)::rest) | (ind, mode, Concat docs)::rest -> let ops = List.map (fun doc -> (ind, mode, doc)) docs in fits w (List.append ops rest) @@ -208,69 +208,69 @@ module Doc = struct | (_ind, _mode, CustomLayout _)::rest -> fits w rest - let toString ~width doc = - let doc = propagateForcedBreaks doc in + let to_string ~width doc = + let doc = propagate_forced_breaks doc in let buffer = MiniBuffer.create 1000 in - let rec process ~pos lineSuffices stack = + let rec process ~pos line_suffices stack = match stack with | ((ind, mode, doc) as cmd)::rest -> begin match doc with | Nil | BreakParent -> - process ~pos lineSuffices rest + process ~pos line_suffices rest | Text txt -> MiniBuffer.add_string buffer txt; - process ~pos:(String.length txt + pos) lineSuffices rest + process ~pos:(String.length txt + pos) line_suffices rest | LineSuffix doc -> - process ~pos ((ind, mode, doc)::lineSuffices) rest + process ~pos ((ind, mode, doc)::line_suffices) rest | Concat docs -> let ops = List.map (fun doc -> (ind, mode, doc)) docs in - process ~pos lineSuffices (List.append ops rest) + process ~pos line_suffices (List.append ops rest) | Indent doc -> - process ~pos lineSuffices ((ind + 2, mode, doc)::rest) - | IfBreaks {yes = breakDoc; no = flatDoc} -> + process ~pos line_suffices ((ind + 2, mode, doc)::rest) + | IfBreaks {yes = break_doc; no = flat_doc} -> if mode = Break then - process ~pos lineSuffices ((ind, mode, breakDoc)::rest) + process ~pos line_suffices ((ind, mode, break_doc)::rest) else - process ~pos lineSuffices ((ind, mode, flatDoc)::rest) - | LineBreak lineStyle -> + process ~pos line_suffices ((ind, mode, flat_doc)::rest) + | LineBreak line_style -> if mode = Break then ( - begin match lineSuffices with + begin match line_suffices with | [] -> MiniBuffer.flush_newline buffer; MiniBuffer.add_string buffer (String.make ind ' ' [@doesNotRaise]); process ~pos:ind [] rest | _docs -> - process ~pos:ind [] (List.concat [List.rev lineSuffices; cmd::rest]) + process ~pos:ind [] (List.concat [List.rev line_suffices; cmd::rest]) end ) else (* mode = Flat *) ( - let pos = match lineStyle with + let pos = match line_style with | Classic -> MiniBuffer.add_string buffer " "; pos + 1 | Hard -> MiniBuffer.flush_newline buffer; 0 | Soft -> pos in - process ~pos lineSuffices rest + process ~pos line_suffices rest ) - | Group {shouldBreak; doc} -> - if shouldBreak || not (fits (width - pos) ((ind, Flat, doc)::rest)) then - process ~pos lineSuffices ((ind, Break, doc)::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 lineSuffices ((ind, Flat, doc)::rest) + process ~pos line_suffices ((ind, Flat, doc)::rest) | CustomLayout docs -> - let rec findGroupThatFits groups = match groups with + let rec find_group_that_fits groups = match groups with | [] -> Nil - | [lastGroup] -> lastGroup + | [last_group] -> last_group | doc::docs -> if (fits (width - pos) ((ind, Flat, doc)::rest)) then doc else - findGroupThatFits docs + find_group_that_fits docs in - let doc = findGroupThatFits docs in - process ~pos lineSuffices ((ind, Flat, doc)::rest) + let doc = find_group_that_fits docs in + process ~pos line_suffices ((ind, Flat, doc)::rest) end | [] -> - begin match lineSuffices with + begin match line_suffices with | [] -> () | suffices -> process ~pos:0 [] (List.rev suffices) @@ -285,7 +285,7 @@ module Doc = struct let debug t = - let rec toDoc = function + let rec to_doc = function | Nil -> text "nil" | BreakParent -> text "breakparent" | Text txt -> text ("text(" ^ txt ^ ")") @@ -293,7 +293,7 @@ module Doc = struct concat [ text "linesuffix("; indent ( - concat [line; toDoc doc] + concat [line; to_doc doc] ); line; text ")" @@ -306,7 +306,7 @@ module Doc = struct concat [ line; join ~sep:(concat [text ","; line]) - (List.map toDoc docs) ; + (List.map to_doc docs) ; ] ); line; @@ -320,7 +320,7 @@ module Doc = struct concat [ line; join ~sep:(concat [text ","; line]) - (List.map toDoc docs) ; + (List.map to_doc docs) ; ] ); line; @@ -330,21 +330,21 @@ module Doc = struct | Indent doc -> concat [ text "indent("; - softLine; - toDoc doc; - softLine; + soft_line; + to_doc doc; + soft_line; text ")"; ] - | IfBreaks {yes = trueDoc; no = falseDoc} -> + | IfBreaks {yes = true_doc; no = false_doc} -> group( concat [ text "ifBreaks("; indent ( concat [ line; - toDoc trueDoc; + to_doc true_doc; concat [text ","; line]; - toDoc falseDoc; + to_doc false_doc; ] ); line; @@ -352,22 +352,22 @@ module Doc = struct ] ) | LineBreak break -> - let breakTxt = match break with + let break_txt = match break with | Classic -> "Classic" | Soft -> "Soft" | Hard -> "Hard" in - text ("LineBreak(" ^ breakTxt ^ ")") - | Group {shouldBreak; doc} -> + text ("LineBreak(" ^ break_txt ^ ")") + | Group {should_break; doc} -> group( concat [ text "Group("; indent ( concat [ line; - text ("shouldBreak: " ^ (string_of_bool shouldBreak)); + text ("shouldBreak: " ^ (string_of_bool should_break)); concat [text ","; line]; - toDoc doc; + to_doc doc; ] ); line; @@ -375,8 +375,8 @@ module Doc = struct ] ) in - let doc = toDoc t in - toString ~width:10 doc |> print_endline + let doc = to_doc t in + to_string ~width:10 doc |> print_endline [@@live] end @@ -385,7 +385,7 @@ module Sexp: sig val atom: string -> t val list: t list -> t - val toString: t -> string + val to_string: t -> string end = struct type t = | Atom of string @@ -394,29 +394,29 @@ end = struct let atom s = Atom s let list l = List l - let rec toDoc t = + let rec to_doc t = match t with | Atom s -> Doc.text s | List [] -> Doc.text "()" - | List [sexpr] -> Doc.concat [Doc.lparen; toDoc sexpr; Doc.rparen;] + | List [sexpr] -> Doc.concat [Doc.lparen; to_doc sexpr; Doc.rparen;] | List (hd::tail) -> Doc.group ( Doc.concat [ Doc.lparen; - toDoc hd; + to_doc hd; Doc.indent ( Doc.concat [ Doc.line; - Doc.join ~sep:Doc.line (List.map toDoc tail); + Doc.join ~sep:Doc.line (List.map to_doc tail); ] ); Doc.rparen; ] ) - let toString sexpr = - let doc = toDoc sexpr in - Doc.toString ~width:80 doc + let to_string sexpr = + let doc = to_doc sexpr in + Doc.to_string ~width:80 doc end module SexpAst: sig @@ -425,7 +425,7 @@ module SexpAst: sig end = struct open Parsetree - let mapEmpty ~f items = + let map_empty ~f items = match items with | [] -> [Sexp.list []] | items -> List.map f items @@ -436,7 +436,7 @@ end = struct let char c = Sexp.atom ("'" ^ (Char.escaped c) ^ "'") - let optChar oc = + let opt_char oc = match oc with | None -> Sexp.atom "None" | Some c -> @@ -469,27 +469,27 @@ end = struct loop l; ] - let closedFlag flag = match flag with + let closed_flag flag = match flag with | Asttypes.Closed -> Sexp.atom "Closed" | Open -> Sexp.atom "Open" - let directionFlag flag = match flag with + let direction_flag flag = match flag with | Asttypes.Upto -> Sexp.atom "Upto" | Downto -> Sexp.atom "Downto" - let recFlag flag = match flag with + let rec_flag flag = match flag with | Asttypes.Recursive -> Sexp.atom "Recursive" | Nonrecursive -> Sexp.atom "Nonrecursive" - let overrideFlag flag = match flag with + let override_flag flag = match flag with | Asttypes.Override -> Sexp.atom "Override" | Fresh -> Sexp.atom "Fresh" - let privateFlag flag = match flag with + let private_flag flag = match flag with | Asttypes.Public -> Sexp.atom "Public" | Private -> Sexp.atom "Private" - let mutableFlag flag = match flag with + let mutable_flag flag = match flag with | Asttypes.Immutable -> Sexp.atom "Immutable" | Mutable -> Sexp.atom "Mutable" @@ -498,7 +498,7 @@ end = struct | Contravariant -> Sexp.atom "Contravariant" | Invariant -> Sexp.atom "Invariant" - let argLabel lbl = match lbl with + let arg_label lbl = match lbl with | Asttypes.Nolabel -> Sexp.atom "Nolabel" | Labelled txt -> Sexp.list [ Sexp.atom "Labelled"; @@ -515,7 +515,7 @@ end = struct Sexp.list [ Sexp.atom "Pconst_integer"; string txt; - optChar tag; + opt_char tag; ] | Pconst_char c -> Sexp.list [ @@ -537,7 +537,7 @@ end = struct Sexp.list [ Sexp.atom "Pconst_float"; string txt; - optChar tag; + opt_char tag; ] in Sexp.list [ @@ -547,10 +547,10 @@ end = struct let rec structure s = Sexp.list ( - (Sexp.atom "structure")::(List.map structureItem s) + (Sexp.atom "structure")::(List.map structure_item s) ) - and structureItem si = + and structure_item si = let desc = match si.pstr_desc with | Pstr_eval (expr, attrs) -> Sexp.list [ @@ -561,56 +561,56 @@ end = struct | Pstr_value (flag, vbs) -> Sexp.list [ Sexp.atom "Pstr_value"; - recFlag flag; - Sexp.list (mapEmpty ~f:valueBinding vbs) + rec_flag flag; + Sexp.list (map_empty ~f:value_binding vbs) ] | Pstr_primitive (vd) -> Sexp.list [ Sexp.atom "Pstr_primitive"; - valueDescription vd; + value_description vd; ] | Pstr_type (flag, tds) -> Sexp.list [ Sexp.atom "Pstr_type"; - recFlag flag; - Sexp.list (mapEmpty ~f:typeDeclaration tds) + rec_flag flag; + Sexp.list (map_empty ~f:type_declaration tds) ] | Pstr_typext typext -> Sexp.list [ Sexp.atom "Pstr_type"; - typeExtension typext; + type_extension typext; ] | Pstr_exception ec -> Sexp.list [ Sexp.atom "Pstr_exception"; - extensionConstructor ec; + extension_constructor ec; ] | Pstr_module mb -> Sexp.list [ Sexp.atom "Pstr_module"; - moduleBinding mb; + module_binding mb; ] | Pstr_recmodule mbs -> Sexp.list [ Sexp.atom "Pstr_recmodule"; - Sexp.list (mapEmpty ~f:moduleBinding mbs); + Sexp.list (map_empty ~f:module_binding mbs); ] - | Pstr_modtype modTypDecl -> + | Pstr_modtype mod_typ_decl -> Sexp.list [ Sexp.atom "Pstr_modtype"; - moduleTypeDeclaration modTypDecl; + module_type_declaration mod_typ_decl; ] - | Pstr_open openDesc -> + | Pstr_open open_desc -> Sexp.list [ Sexp.atom "Pstr_open"; - openDescription openDesc; + open_description open_desc; ] | Pstr_class _ -> Sexp.atom "Pstr_class" | Pstr_class_type _ -> Sexp.atom "Pstr_class_type" | Pstr_include id -> Sexp.list [ Sexp.atom "Pstr_include"; - includeDeclaration id; + include_declaration id; ] | Pstr_attribute attr -> Sexp.list [ @@ -629,76 +629,76 @@ end = struct desc; ] - and includeDeclaration id = + and include_declaration id = Sexp.list [ Sexp.atom "include_declaration"; - moduleExpression id.pincl_mod; + module_expression id.pincl_mod; attributes id.pincl_attributes; ] - and openDescription od = + and open_description od = Sexp.list [ Sexp.atom "open_description"; longident od.popen_lid.Asttypes.txt; attributes od.popen_attributes; ] - and moduleTypeDeclaration mtd = + and module_type_declaration mtd = Sexp.list [ Sexp.atom "module_type_declaration"; string mtd.pmtd_name.Asttypes.txt; (match mtd.pmtd_type with | None -> Sexp.atom "None" - | Some modType -> Sexp.list [ + | Some mod_type -> Sexp.list [ Sexp.atom "Some"; - moduleType modType; + module_type mod_type; ]); attributes mtd.pmtd_attributes; ] - and moduleBinding mb = + and module_binding mb = Sexp.list [ Sexp.atom "module_binding"; string mb.pmb_name.Asttypes.txt; - moduleExpression mb.pmb_expr; + module_expression mb.pmb_expr; attributes mb.pmb_attributes; ] - and moduleExpression me = + and module_expression me = let desc = match me.pmod_desc with - | Pmod_ident modName -> + | Pmod_ident mod_name -> Sexp.list [ Sexp.atom "Pmod_ident"; - longident modName.Asttypes.txt; + longident mod_name.Asttypes.txt; ] | Pmod_structure s -> Sexp.list [ Sexp.atom "Pmod_structure"; structure s; ] - | Pmod_functor (lbl, optModType, modExpr) -> + | Pmod_functor (lbl, opt_mod_type, mod_expr) -> Sexp.list [ Sexp.atom "Pmod_functor"; string lbl.Asttypes.txt; - (match optModType with + (match opt_mod_type with | None -> Sexp.atom "None" - | Some modType -> Sexp.list [ + | Some mod_type -> Sexp.list [ Sexp.atom "Some"; - moduleType modType; + module_type mod_type; ]); - moduleExpression modExpr; + module_expression mod_expr; ] - | Pmod_apply (callModExpr, modExprArg) -> + | Pmod_apply (call_mod_expr, mod_expr_arg) -> Sexp.list [ Sexp.atom "Pmod_apply"; - moduleExpression callModExpr; - moduleExpression modExprArg; + module_expression call_mod_expr; + module_expression mod_expr_arg; ] - | Pmod_constraint (modExpr, modType) -> + | Pmod_constraint (mod_expr, mod_type) -> Sexp.list [ Sexp.atom "Pmod_constraint"; - moduleExpression modExpr; - moduleType modType; + module_expression mod_expr; + module_type mod_type; ] | Pmod_unpack expr -> Sexp.list [ @@ -717,50 +717,50 @@ end = struct attributes me.pmod_attributes; ] - and moduleType mt = + and module_type mt = let desc = match mt.pmty_desc with - | Pmty_ident longidentLoc -> + | Pmty_ident longident_loc -> Sexp.list [ Sexp.atom "Pmty_ident"; - longident longidentLoc.Asttypes.txt; + longident longident_loc.Asttypes.txt; ] | Pmty_signature s -> Sexp.list [ Sexp.atom "Pmty_signature"; signature s; ] - | Pmty_functor (lbl, optModType, modType) -> + | Pmty_functor (lbl, opt_mod_type, mod_type) -> Sexp.list [ Sexp.atom "Pmty_functor"; string lbl.Asttypes.txt; - (match optModType with + (match opt_mod_type with | None -> Sexp.atom "None" - | Some modType -> Sexp.list [ + | Some mod_type -> Sexp.list [ Sexp.atom "Some"; - moduleType modType; + module_type mod_type; ]); - moduleType modType; + module_type mod_type; ] - | Pmty_alias longidentLoc -> + | Pmty_alias longident_loc -> Sexp.list [ Sexp.atom "Pmty_alias"; - longident longidentLoc.Asttypes.txt; + longident longident_loc.Asttypes.txt; ] | Pmty_extension ext -> Sexp.list [ Sexp.atom "Pmty_extension"; extension ext; ] - | Pmty_typeof modExpr -> + | Pmty_typeof mod_expr -> Sexp.list [ Sexp.atom "Pmty_typeof"; - moduleExpression modExpr; + module_expression mod_expr; ] - | Pmty_with (modType, withConstraints) -> + | Pmty_with (mod_type, with_constraints) -> Sexp.list [ Sexp.atom "Pmty_with"; - moduleType modType; - Sexp.list (mapEmpty ~f:withConstraint withConstraints); + module_type mod_type; + Sexp.list (map_empty ~f:with_constraint with_constraints); ] in Sexp.list [ @@ -769,12 +769,12 @@ end = struct attributes mt.pmty_attributes; ] - and withConstraint wc = match wc with - | Pwith_type (longidentLoc, td) -> + and with_constraint wc = match wc with + | Pwith_type (longident_loc, td) -> Sexp.list [ Sexp.atom "Pmty_with"; - longident longidentLoc.Asttypes.txt; - typeDeclaration td; + longident longident_loc.Asttypes.txt; + type_declaration td; ] | Pwith_module (l1, l2) -> Sexp.list [ @@ -782,11 +782,11 @@ end = struct longident l1.Asttypes.txt; longident l2.Asttypes.txt; ] - | Pwith_typesubst (longidentLoc, td) -> + | Pwith_typesubst (longident_loc, td) -> Sexp.list [ Sexp.atom "Pwith_typesubst"; - longident longidentLoc.Asttypes.txt; - typeDeclaration td; + longident longident_loc.Asttypes.txt; + type_declaration td; ] | Pwith_modsubst (l1, l2) -> Sexp.list [ @@ -797,56 +797,56 @@ end = struct and signature s = Sexp.list ( - (Sexp.atom "signature")::(List.map signatureItem s) + (Sexp.atom "signature")::(List.map signature_item s) ) - and signatureItem si = + and signature_item si = let descr = match si.psig_desc with | Psig_value vd -> Sexp.list [ Sexp.atom "Psig_value"; - valueDescription vd; + value_description vd; ] - | Psig_type (flag, typeDeclarations) -> + | Psig_type (flag, type_declarations) -> Sexp.list [ Sexp.atom "Psig_type"; - recFlag flag; - Sexp.list (mapEmpty ~f:typeDeclaration typeDeclarations); + rec_flag flag; + Sexp.list (map_empty ~f:type_declaration type_declarations); ] - | Psig_typext typExt -> + | Psig_typext typ_ext -> Sexp.list [ Sexp.atom "Psig_typext"; - typeExtension typExt; + type_extension typ_ext; ] - | Psig_exception extConstr -> + | Psig_exception ext_constr -> Sexp.list [ Sexp.atom "Psig_exception"; - extensionConstructor extConstr; + extension_constructor ext_constr; ] - | Psig_module modDecl -> + | Psig_module mod_decl -> Sexp.list [ Sexp.atom "Psig_module"; - moduleDeclaration modDecl; + module_declaration mod_decl; ] - | Psig_recmodule modDecls -> + | Psig_recmodule mod_decls -> Sexp.list [ Sexp.atom "Psig_recmodule"; - Sexp.list (mapEmpty ~f:moduleDeclaration modDecls); + Sexp.list (map_empty ~f:module_declaration mod_decls); ] - | Psig_modtype modTypDecl -> + | Psig_modtype mod_typ_decl -> Sexp.list [ Sexp.atom "Psig_modtype"; - moduleTypeDeclaration modTypDecl; + module_type_declaration mod_typ_decl; ] - | Psig_open openDesc -> + | Psig_open open_desc -> Sexp.list [ Sexp.atom "Psig_open"; - openDescription openDesc; + open_description open_desc; ] - | Psig_include inclDecl -> + | Psig_include incl_decl -> Sexp.list [ Sexp.atom "Psig_include"; - includeDescription inclDecl + include_description incl_decl ] | Psig_class _ -> Sexp.list [Sexp.atom "Psig_class";] | Psig_class_type _ -> Sexp.list [ Sexp.atom "Psig_class_type"; ] @@ -867,22 +867,22 @@ end = struct descr; ] - and includeDescription id = + and include_description id = Sexp.list [ Sexp.atom "include_description"; - moduleType id.pincl_mod; + module_type id.pincl_mod; attributes id.pincl_attributes; ] - and moduleDeclaration md = + and module_declaration md = Sexp.list [ Sexp.atom "module_declaration"; string md.pmd_name.Asttypes.txt; - moduleType md.pmd_type; + module_type md.pmd_type; attributes md.pmd_attributes; ] - and valueBinding vb = + and value_binding vb = Sexp.list [ Sexp.atom "value_binding"; pattern vb.pvb_pat; @@ -890,38 +890,38 @@ end = struct attributes vb.pvb_attributes; ] - and valueDescription vd = + and value_description vd = Sexp.list [ Sexp.atom "value_description"; string vd.pval_name.Asttypes.txt; - coreType vd.pval_type; - Sexp.list (mapEmpty ~f:string vd.pval_prim); + core_type vd.pval_type; + Sexp.list (map_empty ~f:string vd.pval_prim); attributes vd.pval_attributes; ] - and typeDeclaration td = + and type_declaration td = Sexp.list [ Sexp.atom "type_declaration"; string td.ptype_name.Asttypes.txt; Sexp.list [ Sexp.atom "ptype_params"; - Sexp.list (mapEmpty ~f:(fun (typexpr, var) -> + Sexp.list (map_empty ~f:(fun (typexpr, var) -> Sexp.list [ - coreType typexpr; + core_type typexpr; variance var; ]) td.ptype_params) ]; Sexp.list [ Sexp.atom "ptype_cstrs"; - Sexp.list (mapEmpty ~f:(fun (typ1, typ2, _loc) -> + Sexp.list (map_empty ~f:(fun (typ1, typ2, _loc) -> Sexp.list [ - coreType typ1; - coreType typ2; + core_type typ1; + core_type typ2; ]) td.ptype_cstrs) ]; Sexp.list [ Sexp.atom "ptype_kind"; - typeKind td.ptype_kind; + type_kind td.ptype_kind; ]; Sexp.list [ Sexp.atom "ptype_manifest"; @@ -929,43 +929,43 @@ end = struct | None -> Sexp.atom "None" | Some typ -> Sexp.list [ Sexp.atom "Some"; - coreType typ; + core_type typ; ] ]; Sexp.list [ Sexp.atom "ptype_private"; - privateFlag td.ptype_private; + private_flag td.ptype_private; ]; attributes td.ptype_attributes; ] - and extensionConstructor ec = + and extension_constructor ec = Sexp.list [ Sexp.atom "extension_constructor"; string ec.pext_name.Asttypes.txt; - extensionConstructorKind ec.pext_kind; + extension_constructor_kind ec.pext_kind; attributes ec.pext_attributes; ] - and extensionConstructorKind kind = match kind with - | Pext_decl (args, optTypExpr) -> + and extension_constructor_kind kind = match kind with + | Pext_decl (args, opt_typ_expr) -> Sexp.list [ Sexp.atom "Pext_decl"; - constructorArguments args; - match optTypExpr with + constructor_arguments args; + match opt_typ_expr with | None -> Sexp.atom "None" | Some typ -> Sexp.list [ Sexp.atom "Some"; - coreType typ; + core_type typ; ] ] - | Pext_rebind longidentLoc -> + | Pext_rebind longident_loc -> Sexp.list [ Sexp.atom "Pext_rebind"; - longident longidentLoc.Asttypes.txt; + longident longident_loc.Asttypes.txt; ] - and typeExtension te = + and type_extension te = Sexp.list [ Sexp.atom "type_extension"; Sexp.list [ @@ -974,44 +974,44 @@ end = struct ]; Sexp.list [ Sexp.atom "ptyext_parms"; - Sexp.list (mapEmpty ~f:(fun (typexpr, var) -> + Sexp.list (map_empty ~f:(fun (typexpr, var) -> Sexp.list [ - coreType typexpr; + core_type typexpr; variance var; ]) te.ptyext_params) ]; Sexp.list [ Sexp.atom "ptyext_constructors"; - Sexp.list (mapEmpty ~f:extensionConstructor te.ptyext_constructors); + Sexp.list (map_empty ~f:extension_constructor te.ptyext_constructors); ]; Sexp.list [ Sexp.atom "ptyext_private"; - privateFlag te.ptyext_private; + private_flag te.ptyext_private; ]; attributes te.ptyext_attributes; ] - and typeKind kind = match kind with + and type_kind kind = match kind with | Ptype_abstract -> Sexp.atom "Ptype_abstract" - | Ptype_variant constrDecls -> + | Ptype_variant constr_decls -> Sexp.list [ Sexp.atom "Ptype_variant"; - Sexp.list (mapEmpty ~f:constructorDeclaration constrDecls); + Sexp.list (map_empty ~f:constructor_declaration constr_decls); ] - | Ptype_record lblDecls -> + | Ptype_record lbl_decls -> Sexp.list [ Sexp.atom "Ptype_record"; - Sexp.list (mapEmpty ~f:labelDeclaration lblDecls); + Sexp.list (map_empty ~f:label_declaration lbl_decls); ] | Ptype_open -> Sexp.atom "Ptype_open" - and constructorDeclaration cd = + and constructor_declaration cd = Sexp.list [ Sexp.atom "constructor_declaration"; string cd.pcd_name.Asttypes.txt; Sexp.list [ Sexp.atom "pcd_args"; - constructorArguments cd.pcd_args; + constructor_arguments cd.pcd_args; ]; Sexp.list [ Sexp.atom "pcd_res"; @@ -1019,39 +1019,39 @@ end = struct | None -> Sexp.atom "None" | Some typ -> Sexp.list [ Sexp.atom "Some"; - coreType typ; + core_type typ; ] ]; attributes cd.pcd_attributes; ] - and constructorArguments args = match args with + and constructor_arguments args = match args with | Pcstr_tuple types -> Sexp.list [ Sexp.atom "Pcstr_tuple"; - Sexp.list (mapEmpty ~f:coreType types) + Sexp.list (map_empty ~f:core_type types) ] | Pcstr_record lds -> Sexp.list [ Sexp.atom "Pcstr_record"; - Sexp.list (mapEmpty ~f:labelDeclaration lds) + Sexp.list (map_empty ~f:label_declaration lds) ] - and labelDeclaration ld = + and label_declaration ld = Sexp.list [ Sexp.atom "label_declaration"; string ld.pld_name.Asttypes.txt; - mutableFlag ld.pld_mutable; - coreType ld.pld_type; + mutable_flag ld.pld_mutable; + core_type ld.pld_type; attributes ld.pld_attributes; ] and expression expr = let desc = match expr.pexp_desc with - | Pexp_ident longidentLoc -> + | Pexp_ident longident_loc -> Sexp.list [ Sexp.atom "Pexp_ident"; - longident longidentLoc.Asttypes.txt; + longident longident_loc.Asttypes.txt; ] | Pexp_constant c -> Sexp.list [ @@ -1061,20 +1061,20 @@ end = struct | Pexp_let (flag, vbs, expr) -> Sexp.list [ Sexp.atom "Pexp_let"; - recFlag flag; - Sexp.list (mapEmpty ~f:valueBinding vbs); + rec_flag flag; + Sexp.list (map_empty ~f:value_binding vbs); expression expr; ] | Pexp_function cases -> Sexp.list [ Sexp.atom "Pexp_function"; - Sexp.list (mapEmpty ~f:case cases); + Sexp.list (map_empty ~f:case cases); ] - | Pexp_fun (argLbl, exprOpt, pat, expr) -> + | Pexp_fun (arg_lbl, expr_opt, pat, expr) -> Sexp.list [ Sexp.atom "Pexp_fun"; - argLabel argLbl; - (match exprOpt with + arg_label arg_lbl; + (match expr_opt with | None -> Sexp.atom "None" | Some expr -> Sexp.list [ Sexp.atom "Some"; @@ -1087,8 +1087,8 @@ end = struct Sexp.list [ Sexp.atom "Pexp_apply"; expression expr; - Sexp.list (mapEmpty ~f:(fun (argLbl, expr) -> Sexp.list [ - argLabel argLbl; + Sexp.list (map_empty ~f:(fun (arg_lbl, expr) -> Sexp.list [ + arg_label arg_lbl; expression expr ]) args); ] @@ -1096,24 +1096,24 @@ end = struct Sexp.list [ Sexp.atom "Pexp_match"; expression expr; - Sexp.list (mapEmpty ~f:case cases); + Sexp.list (map_empty ~f:case cases); ] | Pexp_try (expr, cases) -> Sexp.list [ Sexp.atom "Pexp_try"; expression expr; - Sexp.list (mapEmpty ~f:case cases); + Sexp.list (map_empty ~f:case cases); ] | Pexp_tuple exprs -> Sexp.list [ Sexp.atom "Pexp_tuple"; - Sexp.list (mapEmpty ~f:expression exprs); + Sexp.list (map_empty ~f:expression exprs); ] - | Pexp_construct (longidentLoc, exprOpt) -> + | Pexp_construct (longident_loc, expr_opt) -> Sexp.list [ Sexp.atom "Pexp_construct"; - longident longidentLoc.Asttypes.txt; - match exprOpt with + longident longident_loc.Asttypes.txt; + match expr_opt with | None -> Sexp.atom "None" | Some expr -> Sexp.list [ @@ -1121,11 +1121,11 @@ end = struct expression expr; ] ] - | Pexp_variant (lbl, exprOpt) -> + | Pexp_variant (lbl, expr_opt) -> Sexp.list [ Sexp.atom "Pexp_variant"; string lbl; - match exprOpt with + match expr_opt with | None -> Sexp.atom "None" | Some expr -> Sexp.list [ @@ -1133,14 +1133,14 @@ end = struct expression expr; ] ] - | Pexp_record (rows, optExpr) -> + | Pexp_record (rows, opt_expr) -> Sexp.list [ Sexp.atom "Pexp_record"; - Sexp.list (mapEmpty ~f:(fun (longidentLoc, expr) -> Sexp.list [ - longident longidentLoc.Asttypes.txt; + Sexp.list (map_empty ~f:(fun (longident_loc, expr) -> Sexp.list [ + longident longident_loc.Asttypes.txt; expression expr; ]) rows); - (match optExpr with + (match opt_expr with | None -> Sexp.atom "None" | Some expr -> Sexp.list [ @@ -1148,30 +1148,30 @@ end = struct expression expr; ]); ] - | Pexp_field (expr, longidentLoc) -> + | Pexp_field (expr, longident_loc) -> Sexp.list [ Sexp.atom "Pexp_field"; expression expr; - longident longidentLoc.Asttypes.txt; + longident longident_loc.Asttypes.txt; ] - | Pexp_setfield (expr1, longidentLoc, expr2) -> + | Pexp_setfield (expr1, longident_loc, expr2) -> Sexp.list [ Sexp.atom "Pexp_setfield"; expression expr1; - longident longidentLoc.Asttypes.txt; + longident longident_loc.Asttypes.txt; expression expr2; ] | Pexp_array exprs -> Sexp.list [ Sexp.atom "Pexp_array"; - Sexp.list (mapEmpty ~f:expression exprs); + Sexp.list (map_empty ~f:expression exprs); ] - | Pexp_ifthenelse (expr1, expr2, optExpr) -> + | Pexp_ifthenelse (expr1, expr2, opt_expr) -> Sexp.list [ Sexp.atom "Pexp_ifthenelse"; expression expr1; expression expr2; - (match optExpr with + (match opt_expr with | None -> Sexp.atom "None" | Some expr -> Sexp.list [ @@ -1197,26 +1197,26 @@ end = struct pattern pat; expression e1; expression e2; - directionFlag flag; + direction_flag flag; expression e3; ] | Pexp_constraint (expr, typexpr) -> Sexp.list [ Sexp.atom "Pexp_constraint"; expression expr; - coreType typexpr; + core_type typexpr; ] - | Pexp_coerce (expr, optTyp, typexpr) -> + | Pexp_coerce (expr, opt_typ, typexpr) -> Sexp.list [ Sexp.atom "Pexp_coerce"; expression expr; - (match optTyp with + (match opt_typ with | None -> Sexp.atom "None" | Some typ -> Sexp.list [ Sexp.atom "Some"; - coreType typ; + core_type typ; ]); - coreType typexpr; + core_type typexpr; ] | Pexp_send _ -> Sexp.list [ @@ -1234,17 +1234,17 @@ end = struct Sexp.list [ Sexp.atom "Pexp_override"; ] - | Pexp_letmodule (modName, modExpr, expr) -> + | Pexp_letmodule (mod_name, mod_expr, expr) -> Sexp.list [ Sexp.atom "Pexp_letmodule"; - string modName.Asttypes.txt; - moduleExpression modExpr; + string mod_name.Asttypes.txt; + module_expression mod_expr; expression expr; ] - | Pexp_letexception (extConstr, expr) -> + | Pexp_letexception (ext_constr, expr) -> Sexp.list [ Sexp.atom "Pexp_letexception"; - extensionConstructor extConstr; + extension_constructor ext_constr; expression expr; ] | Pexp_assert expr -> @@ -1271,16 +1271,16 @@ end = struct string lbl.Asttypes.txt; expression expr; ] - | Pexp_pack modExpr -> + | Pexp_pack mod_expr -> Sexp.list [ Sexp.atom "Pexp_pack"; - moduleExpression modExpr; + module_expression mod_expr; ] - | Pexp_open (flag, longidentLoc, expr) -> + | Pexp_open (flag, longident_loc, expr) -> Sexp.list [ Sexp.atom "Pexp_open"; - overrideFlag flag; - longident longidentLoc.Asttypes.txt; + override_flag flag; + longident longident_loc.Asttypes.txt; expression expr; ] | Pexp_extension ext -> @@ -1346,24 +1346,24 @@ end = struct | Ppat_tuple (patterns) -> Sexp.list [ Sexp.atom "Ppat_tuple"; - Sexp.list (mapEmpty ~f:pattern patterns); + Sexp.list (map_empty ~f:pattern patterns); ] - | Ppat_construct (longidentLoc, optPattern) -> + | Ppat_construct (longident_loc, opt_pattern) -> Sexp.list [ Sexp.atom "Ppat_construct"; - longident longidentLoc.Location.txt; - match optPattern with + longident longident_loc.Location.txt; + match opt_pattern with | None -> Sexp.atom "None" | Some p -> Sexp.list [ Sexp.atom "some"; pattern p; ] ] - | Ppat_variant (lbl, optPattern) -> + | Ppat_variant (lbl, opt_pattern) -> Sexp.list [ Sexp.atom "Ppat_variant"; string lbl; - match optPattern with + match opt_pattern with | None -> Sexp.atom "None" | Some p -> Sexp.list [ Sexp.atom "Some"; @@ -1373,10 +1373,10 @@ end = struct | Ppat_record (rows, flag) -> Sexp.list [ Sexp.atom "Ppat_record"; - closedFlag flag; - Sexp.list (mapEmpty ~f:(fun (longidentLoc, p) -> + closed_flag flag; + Sexp.list (map_empty ~f:(fun (longident_loc, p) -> Sexp.list [ - longident longidentLoc.Location.txt; + longident longident_loc.Location.txt; pattern p; ] ) rows) @@ -1384,7 +1384,7 @@ end = struct | Ppat_array patterns -> Sexp.list [ Sexp.atom "Ppat_array"; - Sexp.list (mapEmpty ~f:pattern patterns); + Sexp.list (map_empty ~f:pattern patterns); ] | Ppat_or (p1, p2) -> Sexp.list [ @@ -1396,22 +1396,22 @@ end = struct Sexp.list [ Sexp.atom "Ppat_constraint"; pattern p; - coreType typexpr; + core_type typexpr; ] - | Ppat_type longidentLoc -> + | Ppat_type longident_loc -> Sexp.list [ Sexp.atom "Ppat_type"; - longident longidentLoc.Location.txt + longident longident_loc.Location.txt ] | Ppat_lazy p -> Sexp.list [ Sexp.atom "Ppat_lazy"; pattern p; ] - | Ppat_unpack stringLoc -> + | Ppat_unpack string_loc -> Sexp.list [ Sexp.atom "Ppat_unpack"; - string stringLoc.Location.txt; + string string_loc.Location.txt; ] | Ppat_exception p -> Sexp.list [ @@ -1423,10 +1423,10 @@ end = struct Sexp.atom "Ppat_extension"; extension ext; ] - | Ppat_open (longidentLoc, p) -> + | Ppat_open (longident_loc, p) -> Sexp.list [ Sexp.atom "Ppat_open"; - longident longidentLoc.Location.txt; + longident longident_loc.Location.txt; pattern p; ] in @@ -1435,109 +1435,109 @@ end = struct descr; ] - and objectField field = match field with - | Otag (lblLoc, attrs, typexpr) -> + and object_field field = match field with + | Otag (lbl_loc, attrs, typexpr) -> Sexp.list [ Sexp.atom "Otag"; - string lblLoc.txt; + string lbl_loc.txt; attributes attrs; - coreType typexpr; + core_type typexpr; ] | Oinherit typexpr -> Sexp.list [ Sexp.atom "Oinherit"; - coreType typexpr; + core_type typexpr; ] - and rowField field = match field with - | Rtag (labelLoc, attrs, truth, types) -> + and row_field field = match field with + | Rtag (label_loc, attrs, truth, types) -> Sexp.list [ Sexp.atom "Rtag"; - string labelLoc.txt; + string label_loc.txt; attributes attrs; Sexp.atom (if truth then "true" else "false"); - Sexp.list (mapEmpty ~f:coreType types); + Sexp.list (map_empty ~f:core_type types); ] | Rinherit typexpr -> Sexp.list [ Sexp.atom "Rinherit"; - coreType typexpr; + core_type typexpr; ] - and packageType (modNameLoc, packageConstraints) = + and package_type (mod_name_loc, package_constraints) = Sexp.list [ Sexp.atom "package_type"; - longident modNameLoc.Asttypes.txt; - Sexp.list (mapEmpty ~f:(fun (modNameLoc, typexpr) -> + longident mod_name_loc.Asttypes.txt; + Sexp.list (map_empty ~f:(fun (mod_name_loc, typexpr) -> Sexp.list [ - longident modNameLoc.Asttypes.txt; - coreType typexpr; + longident mod_name_loc.Asttypes.txt; + core_type typexpr; ] - ) packageConstraints) + ) package_constraints) ] - and coreType typexpr = + and core_type 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 (argLbl, typ1, typ2) -> + | Ptyp_arrow (arg_lbl, typ1, typ2) -> Sexp.list [ Sexp.atom "Ptyp_arrow"; - argLabel argLbl; - coreType typ1; - coreType typ2; + arg_label arg_lbl; + core_type typ1; + core_type typ2; ] | Ptyp_tuple types -> Sexp.list [ Sexp.atom "Ptyp_tuple"; - Sexp.list (mapEmpty ~f:coreType types); + Sexp.list (map_empty ~f:core_type types); ] - | Ptyp_constr (longidentLoc, types) -> + | Ptyp_constr (longident_loc, types) -> Sexp.list [ Sexp.atom "Ptyp_constr"; - longident longidentLoc.txt; - Sexp.list (mapEmpty ~f:coreType types); + longident longident_loc.txt; + Sexp.list (map_empty ~f:core_type types); ] | Ptyp_alias (typexpr, alias) -> Sexp.list [ Sexp.atom "Ptyp_alias"; - coreType typexpr; + core_type typexpr; string alias; ] | Ptyp_object (fields, flag) -> Sexp.list [ Sexp.atom "Ptyp_object"; - closedFlag flag; - Sexp.list (mapEmpty ~f:objectField fields) + closed_flag flag; + Sexp.list (map_empty ~f:object_field fields) ] - | Ptyp_class (longidentLoc, types) -> + | Ptyp_class (longident_loc, types) -> Sexp.list [ Sexp.atom "Ptyp_class"; - longident longidentLoc.Location.txt; - Sexp.list (mapEmpty ~f:coreType types) + longident longident_loc.Location.txt; + Sexp.list (map_empty ~f:core_type types) ] - | Ptyp_variant (fields, flag, optLabels) -> + | Ptyp_variant (fields, flag, opt_labels) -> Sexp.list [ Sexp.atom "Ptyp_variant"; - Sexp.list (mapEmpty ~f:rowField fields); - closedFlag flag; - match optLabels with + Sexp.list (map_empty ~f:row_field fields); + closed_flag flag; + match opt_labels with | None -> Sexp.atom "None" - | Some lbls -> Sexp.list (mapEmpty ~f:string lbls); + | Some lbls -> Sexp.list (map_empty ~f:string lbls); ] | Ptyp_poly (lbls, typexpr) -> Sexp.list [ Sexp.atom "Ptyp_poly"; - Sexp.list (mapEmpty ~f:(fun lbl -> string lbl.Asttypes.txt) lbls); - coreType typexpr; + Sexp.list (map_empty ~f:(fun lbl -> string lbl.Asttypes.txt) lbls); + core_type typexpr; ] | Ptyp_package (package) -> Sexp.list [ Sexp.atom "Ptyp_package"; - packageType package; + package_type package; ] | Ptyp_extension (ext) -> Sexp.list [ @@ -1554,7 +1554,7 @@ end = struct match p with | PStr s -> Sexp.list ( - (Sexp.atom "PStr")::(mapEmpty ~f:structureItem s) + (Sexp.atom "PStr")::(map_empty ~f:structure_item s) ) | PSig s -> Sexp.list [ @@ -1564,13 +1564,13 @@ end = struct | PTyp ct -> Sexp.list [ Sexp.atom "PTyp"; - coreType ct + core_type ct ] - | PPat (pat, optExpr) -> + | PPat (pat, opt_expr) -> Sexp.list [ Sexp.atom "PPat"; pattern pat; - match optExpr with + match opt_expr with | Some expr -> Sexp.list [ Sexp.atom "Some"; expression expr; @@ -1578,22 +1578,22 @@ end = struct | None -> Sexp.atom "None"; ] - and attribute (stringLoc, p) = + and attribute (string_loc, p) = Sexp.list [ Sexp.atom "attribute"; - Sexp.atom stringLoc.Asttypes.txt; + Sexp.atom string_loc.Asttypes.txt; payload p; ] - and extension (stringLoc, p) = + and extension (string_loc, p) = Sexp.list [ Sexp.atom "extension"; - Sexp.atom stringLoc.Asttypes.txt; + Sexp.atom string_loc.Asttypes.txt; payload p; ] and attributes attrs = - let sexprs = mapEmpty ~f:attribute attrs in + let sexprs = map_empty ~f:attribute attrs in Sexp.list ((Sexp.atom "attributes")::sexprs) let implementation = structure @@ -1601,18 +1601,18 @@ end = struct end module IO: sig - val readFile: string -> string - val readStdin: unit -> string + val read_file: string -> string + val read_stdin: unit -> string end = struct (* random chunk size: 2^15, TODO: why do we guess randomly? *) - let chunkSize = 32768 + let chunk_size = 32768 - let readFile filename = + let read_file filename = let chan = open_in filename in - let buffer = Buffer.create chunkSize in - let chunk = (Bytes.create [@doesNotRaise]) chunkSize in + let buffer = Buffer.create chunk_size in + let chunk = (Bytes.create [@doesNotRaise]) chunk_size in let rec loop () = - let len = try input chan chunk 0 chunkSize with Invalid_argument _ -> 0 in + let len = try input chan chunk 0 chunk_size with Invalid_argument _ -> 0 in if len == 0 then ( close_in_noerr chan; Buffer.contents buffer @@ -1623,11 +1623,11 @@ end = struct in loop () - let readStdin () = - let buffer = Buffer.create chunkSize in - let chunk = (Bytes.create [@doesNotRaise]) chunkSize in + let read_stdin () = + let buffer = Buffer.create chunk_size in + let chunk = (Bytes.create [@doesNotRaise]) chunk_size in let rec loop () = - let len = try input stdin chunk 0 chunkSize with Invalid_argument _ -> 0 in + let len = try input stdin chunk 0 chunk_size with Invalid_argument _ -> 0 in if len == 0 then ( close_in_noerr stdin; Buffer.contents buffer @@ -1644,10 +1644,10 @@ module CharacterCodes = struct let space = 0x0020 let newline = 0x0A (* \n *) [@@live] - let lineFeed = 0x0A (* \n *) - let carriageReturn = 0x0D (* \r *) - let lineSeparator = 0x2028 - let paragraphSeparator = 0x2029 + let line_feed = 0x0A (* \n *) + let carriage_return = 0x0D (* \r *) + let line_separator = 0x2028 + let paragraph_separator = 0x2029 let tab = 0x09 @@ -1659,8 +1659,8 @@ module CharacterCodes = struct (* let question = 0x3F *) let semicolon = 0x3B let underscore = 0x5F - let singleQuote = 0x27 - let doubleQuote = 0x22 + let single_quote = 0x27 + let double_quote = 0x22 let equal = 0x3D let bar = 0x7C let tilde = 0x7E @@ -1680,9 +1680,9 @@ module CharacterCodes = struct let forwardslash = 0x2F (* / *) let backslash = 0x5C (* \ *) - let greaterThan = 0x3E + let greater_than = 0x3E let hash = 0x23 - let lessThan = 0x3C + let less_than = 0x3C let minus = 0x2D let plus = 0x2B @@ -1762,16 +1762,16 @@ module CharacterCodes = struct (* if ch >= Lower.a && ch <= Lower.z then ch else ch + 32 *) 32 lor ch - let isLetter ch = + let is_letter ch = Lower.a <= ch && ch <= Lower.z || Upper.a <= ch && ch <= Upper.z - let isUpperCase ch = + let is_upper_case ch = Upper.a <= ch && ch <= Upper.z - let isDigit ch = _0 <= ch && ch <= _9 + let is_digit ch = _0 <= ch && ch <= _9 - let isHex ch = + let is_hex ch = (_0 <= ch && ch <= _9) || (Lower.a <= (lower ch) && (lower ch) <= Lower.f) @@ -1787,13 +1787,13 @@ module CharacterCodes = struct // Only the characters in Table 3 are treated as line terminators. Other new line or line // breaking characters are treated as white space but not as line terminators. *) - let isLineBreak ch = - ch == lineFeed - || ch == carriageReturn - || ch == lineSeparator - || ch == paragraphSeparator + let is_line_break ch = + ch == line_feed + || ch == carriage_return + || ch == line_separator + || ch == paragraph_separator - let digitValue ch = + let digit_value ch = if _0 <= ch && ch <= _9 then ch - 48 else if Lower.a <= (lower ch) && (lower ch) <= Lower.f then @@ -1805,27 +1805,27 @@ end module Comment: sig type t - val toString: t -> string + val to_string: t -> string val loc: t -> Location.t val txt: t -> string - val prevTokEndPos: t -> Lexing.position + val prev_tok_end_pos: t -> Lexing.position - val setPrevTokEndPos: t -> Lexing.position -> unit + val set_prev_tok_end_pos: t -> Lexing.position -> unit - val isSingleLineComment: t -> bool + val is_single_line_comment: t -> bool - val makeSingleLineComment: loc:Location.t -> string -> t - val makeMultiLineComment: loc:Location.t -> string -> t - val fromOcamlComment: - loc:Location.t -> txt:string -> prevTokEndPos:Lexing.position -> t - val trimSpaces: string -> string + val make_single_line_comment: loc:Location.t -> string -> t + val make_multi_line_comment: loc:Location.t -> string -> t + val from_ocaml_comment: + loc:Location.t -> txt:string -> prev_tok_end_pos:Lexing.position -> t + val trim_spaces: string -> string end = struct type style = | SingleLine | MultiLine - let styleToString s = match s with + let style_to_string s = match s with | SingleLine -> "SingleLine" | MultiLine -> "MultiLine" @@ -1833,50 +1833,50 @@ end = struct txt: string; style: style; loc: Location.t; - mutable prevTokEndPos: Lexing.position; + mutable prev_tok_end_pos: Lexing.position; } let loc t = t.loc let txt t = t.txt - let prevTokEndPos t = t.prevTokEndPos + let prev_tok_end_pos t = t.prev_tok_end_pos - let setPrevTokEndPos t pos = - t.prevTokEndPos <- pos + let set_prev_tok_end_pos t pos = + t.prev_tok_end_pos <- pos - let isSingleLineComment t = match t.style with + let is_single_line_comment t = match t.style with | SingleLine -> true | MultiLine -> false - let toString t = + let to_string t = Format.sprintf "(txt: %s\nstyle: %s\nlines: %d-%d)" t.txt - (styleToString t.style) + (style_to_string t.style) t.loc.loc_start.pos_lnum t.loc.loc_end.pos_lnum - let makeSingleLineComment ~loc txt = { + let make_single_line_comment ~loc txt = { txt; loc; style = SingleLine; - prevTokEndPos = Lexing.dummy_pos; + prev_tok_end_pos = Lexing.dummy_pos; } - let makeMultiLineComment ~loc txt = { + let make_multi_line_comment ~loc txt = { txt; loc; style = MultiLine; - prevTokEndPos = Lexing.dummy_pos; + prev_tok_end_pos = Lexing.dummy_pos; } - let fromOcamlComment ~loc ~txt ~prevTokEndPos = { + let from_ocaml_comment ~loc ~txt ~prev_tok_end_pos = { txt; loc; style = MultiLine; - prevTokEndPos = prevTokEndPos + prev_tok_end_pos = prev_tok_end_pos } - let trimSpaces s = + let trim_spaces 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) = ' ' then ( @@ -1983,7 +1983,7 @@ module Token = struct | Dot -> 9 | _ -> 0 - let toString = function + let to_string = function | Open -> "open" | True -> "true" | False -> "false" | Character c -> "'" ^ (Char.escaped c) ^ "'" @@ -2050,7 +2050,7 @@ module Token = struct | ColonEqual -> ":=" | At -> "@" | AtAt -> "@@" | Percent -> "%" | PercentPercent -> "%%" - | Comment c -> "Comment(" ^ (Comment.toString c) ^ ")" + | Comment c -> "Comment(" ^ (Comment.to_string c) ^ ")" | List -> "list" | TemplatePart text -> text ^ "${" | TemplateTail text -> "TemplateTail(" ^ text ^ ")" @@ -2060,7 +2060,7 @@ module Token = struct | Import -> "import" | Export -> "export" - let keywordTable = function + let keyword_table = function | "true" -> True | "false" -> False | "open" -> Open @@ -2097,7 +2097,7 @@ module Token = struct | _ -> raise Not_found [@@raises Not_found] - let isKeyword = function + let is_keyword = function | True | False | Open | Let | Rec | And | As | Exception | Assert | Lazy | If | Else | For | In | To | Downto | While | Switch | When | External | Typ | Private @@ -2106,15 +2106,15 @@ module Token = struct | Try | Catch | Import | Export -> true | _ -> false - let lookupKeyword str = - try keywordTable str with + let lookup_keyword str = + try keyword_table str with | Not_found -> - if CharacterCodes.isUpperCase (int_of_char (str.[0] [@doesNotRaise])) then + if CharacterCodes.is_upper_case (int_of_char (str.[0] [@doesNotRaise])) then Uident str else Lident str - let isKeywordTxt str = - try let _ = keywordTable str in true with + let is_keyword_txt str = + try let _ = keyword_table str in true with | Not_found -> false end @@ -2178,7 +2178,7 @@ module Grammar = struct | ListExpr | JsFfiImport - let toString = function + let to_string = function | OpenDescription -> "an open description" | ModuleLongIdent -> "a module identifier" | Ternary -> "a ternary expression" @@ -2187,7 +2187,7 @@ module Grammar = struct | JsxAttribute -> "a jsx attribute" | ExprOperand -> "a basic expression" | ExprUnary -> "a unary expression" - | ExprBinaryAfterOp op -> "an expression after the operator \"" ^ Token.toString op ^ "\"" + | ExprBinaryAfterOp op -> "an expression after the operator \"" ^ Token.to_string op ^ "\"" | ExprIf -> "an if expression" | IfCondition -> "the condition of an if expression" | IfBranch -> "the true-branch of an if expression" @@ -2236,7 +2236,7 @@ module Grammar = struct | JsFfiImport -> "js ffi import" | JsxChild -> "jsx child" - let isSignatureItemStart = function + let is_signature_item_start = function | Token.At | Let | Typ @@ -2249,7 +2249,7 @@ module Grammar = struct | PercentPercent -> true | _ -> false - let isAtomicPatternStart = function + let is_atomic_pattern_start = function | Token.Int _ | String _ | Character _ | Lparen | Lbracket | Lbrace | Underscore @@ -2258,7 +2258,7 @@ module Grammar = struct | Percent -> true | _ -> false - let isAtomicExprStart = function + let is_atomic_expr_start = function | Token.True | False | Int _ | String _ | Float _ | Character _ | Backtick @@ -2272,14 +2272,14 @@ module Grammar = struct | Percent -> true | _ -> false - let isAtomicTypExprStart = function + let is_atomic_typ_expr_start = function | Token.SingleQuote | Underscore | Lparen | Lbrace | Uident _ | Lident _ | List | Percent -> true | _ -> false - let isExprStart = function + let is_expr_start = function | Token.True | False | Int _ | String _ | Float _ | Character _ | Backtick | Underscore (* _ => doThings() *) @@ -2291,11 +2291,11 @@ module Grammar = struct | If | Switch | While | For | Assert | Lazy | Try -> true | _ -> false - let isJsxAttributeStart = function + let is_jsx_attribute_start = function | Token.Lident _ | Question -> true | _ -> false - let isStructureItemStart = function + let is_structure_item_start = function | Token.Open | Let | Typ @@ -2306,10 +2306,10 @@ module Grammar = struct | AtAt | PercentPercent | At -> true - | t when isExprStart t -> true + | t when is_expr_start t -> true | _ -> false - let isPatternStart = function + let is_pattern_start = function | Token.Int _ | Float _ | String _ | Character _ | True | False | Minus | Plus | Lparen | Lbracket | Lbrace | List | Underscore @@ -2318,31 +2318,31 @@ module Grammar = struct | At -> true | _ -> false - let isParameterStart = function + let is_parameter_start = function | Token.Typ | Tilde | Dot -> true - | token when isPatternStart token -> true + | token when is_pattern_start token -> true | _ -> false (* TODO: overparse Uident ? *) - let isStringFieldDeclStart = function + let is_string_field_decl_start = function | Token.String _ | At -> true | _ -> false (* TODO: overparse Uident ? *) - let isFieldDeclStart = function + let is_field_decl_start = function | Token.At | Mutable | Lident _ | List -> true (* recovery, TODO: this is not ideal… *) | Uident _ -> true - | t when Token.isKeyword t -> true + | t when Token.is_keyword t -> true | _ -> false - let isRecordDeclStart = function + let is_record_decl_start = function | Token.At | Mutable | Lident _ | List -> true | _ -> false - let isTypExprStart = function + let is_typ_expr_start = function | Token.At | SingleQuote | Underscore @@ -2353,68 +2353,68 @@ module Grammar = struct | Lbrace -> true | _ -> false - let isTypeParameterStart = function + let is_type_parameter_start = function | Token.Tilde | Dot -> true - | token when isTypExprStart token -> true + | token when is_typ_expr_start token -> true | _ -> false - let isTypeParamStart = function + let is_type_param_start = function | Token.Plus | Minus | SingleQuote | Underscore -> true | _ -> false - let isFunctorArgStart = function + let is_functor_arg_start = function | Token.At | Uident _ | Underscore | Percent | Lbrace | Lparen -> true | _ -> false - let isModExprStart = function + let is_mod_expr_start = function | Token.At | Percent | Uident _ | Lbrace | Lparen -> true | _ -> false - let isRecordRowStart = function + let is_record_row_start = function | Token.DotDotDot -> true | Token.Uident _ | Lident _ | List -> true (* TODO *) - | t when Token.isKeyword t -> true + | t when Token.is_keyword t -> true | _ -> false - let isRecordRowStringKeyStart = function + let is_record_row_string_key_start = function | Token.String _ -> true | _ -> false - let isArgumentStart = function + let is_argument_start = function | Token.Tilde | Dot | Underscore -> true - | t when isExprStart t -> true + | t when is_expr_start t -> true | _ -> false - let isPatternMatchStart = function + let is_pattern_match_start = function | Token.Bar -> true - | t when isPatternStart t -> true + | t when is_pattern_start t -> true | _ -> false - let isPatternOcamlListStart = function + let is_pattern_ocaml_list_start = function | Token.DotDotDot -> true - | t when isPatternStart t -> true + | t when is_pattern_start t -> true | _ -> false - let isPatternRecordItemStart = function + let is_pattern_record_item_start = function | Token.DotDotDot | Uident _ | Lident _ | List | Underscore -> true | _ -> false - let isAttributeStart = function + let is_attribute_start = function | Token.At -> true | _ -> false - let isJsFfiImportStart = function + let is_js_ffi_import_start = function | Token.Lident _ | At -> true | _ -> false - let isJsxChildStart = isAtomicExprStart + let is_jsx_child_start = is_atomic_expr_start - let isBlockExprStart = function + let is_block_expr_start = function | Token.At | Hash | Percent | Minus | MinusDot | Plus | PlusDot | Bang | True | False | Int _ | String _ | Character _ | Lident _ | Uident _ | Lparen | List | Lbracket | Lbrace | Forwardslash | Assert @@ -2422,38 +2422,38 @@ module Grammar = struct | LessThan | Backtick | Try | Underscore -> true | _ -> false - let isListElement grammar token = + let is_list_element grammar token = match grammar with - | 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 + | 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 | TypeConstraint -> token = Constraint | PackageConstraint -> token = And | ConstructorDeclaration -> token = Bar | Primitive -> begin match token with Token.String _ -> true | _ -> false end - | JsxAttribute -> isJsxAttributeStart token - | JsFfiImport -> isJsFfiImportStart token + | JsxAttribute -> is_jsx_attribute_start token + | JsFfiImport -> is_js_ffi_import_start token | _ -> false - let isListTerminator grammar token = + let is_list_terminator grammar token = match grammar, token with | _, Token.Eof | ExprList, (Rparen | Forwardslash | Rbracket) @@ -2476,12 +2476,12 @@ module Grammar = struct | PackageConstraint, token when token <> And -> true | ConstructorDeclaration, token when token <> Bar -> true | Primitive, Semicolon -> true - | Primitive, token when isStructureItemStart token -> true + | Primitive, token when is_structure_item_start token -> true | _ -> false - let isPartOfList grammar token = - isListElement grammar token || isListTerminator grammar token + let is_part_of_list grammar token = + is_list_element grammar token || is_list_terminator grammar token end module Reporting = struct @@ -2513,7 +2513,7 @@ module Reporting = struct | Flat | Break - let toString (* ~width *) (doc : document) = + let to_string (* ~width *) (doc : document) = let buffer = Buffer.create 100 in let rec loop stack mode offset = match stack with @@ -2586,25 +2586,25 @@ module Reporting = struct | x::xs -> x::(take (n -1) xs) (* TODO: cleanup *) - let renderCodeContext ~missing (src : string) startPos endPos = + let render_code_context ~missing (src : string) start_pos end_pos = let open Lexing in - let startCol = (startPos.pos_cnum - startPos.pos_bol) in - let endCol = endPos.pos_cnum - startPos.pos_cnum + startCol in - let startLine = max 1 (startPos.pos_lnum - 2) in (* 2 lines before *) + let start_col = (start_pos.pos_cnum - start_pos.pos_bol) in + let end_col = end_pos.pos_cnum - start_pos.pos_cnum + start_col in + let start_line = max 1 (start_pos.pos_lnum - 2) in (* 2 lines before *) let lines = String.split_on_char '\n' src in - let endLine = + let end_line = let len = List.length lines in - min len (startPos.pos_lnum + 3) (* 2 lines after *) + min len (start_pos.pos_lnum + 3) (* 2 lines after *) in let lines = lines - |> drop startLine - |> take (endLine - startLine) + |> drop start_line + |> take (end_line - start_line) |> Array.of_list in - let renderLine x ix = - let x = if ix = startPos.pos_lnum then + let render_line x ix = + let x = if ix = start_pos.pos_lnum then begin match missing with | Some _len -> x ^ (String.make 10 ' ' [@doesNotRaise]) | None -> x @@ -2614,57 +2614,57 @@ module Reporting = struct in let open TerminalDoc in - let rowNr = + let row_nr = let txt = string_of_int ix in let len = String.length txt in - if ix = startPos.pos_lnum then + if ix = start_pos.pos_lnum then highlight ~from:0 ~len txt else txt in let len = - let len = if endCol >= 0 then - endCol - startCol + let len = if end_col >= 0 then + end_col - start_col else 1 in - if (startCol + len) > String.length x then String.length x - startCol - 1 else len + if (start_col + len) > String.length x then String.length x - start_col - 1 else len in let line = - if ix = startPos.pos_lnum then + if ix = start_pos.pos_lnum then begin match missing with | Some len -> underline ~from:( - startCol + String.length (String.length (string_of_int ix) |> string_of_int) + 5 + start_col + String.length (String.length (string_of_int ix) |> string_of_int) + 5 ) ~len x | None -> - let len = if startCol + len > String.length x then - (String.length x) - startCol + let len = if start_col + len > String.length x then + (String.length x) - start_col else len in - text (highlight ~from:startCol ~len x) + text (highlight ~from:start_col ~len x) end else text x in group ~break:Never (append - (append (text rowNr) (text " │")) + (append (text row_nr) (text " │")) (indent 2 line)) in - let reportDoc = ref TerminalDoc.nil in + let report_doc = ref TerminalDoc.nil in - let linesLen = Array.length lines in - for i = 0 to (linesLen - 1) do + let lines_len = Array.length lines in + for i = 0 to (lines_len - 1) do let line = try (Array.get [@doesNotRaise]) lines i with Invalid_argument _ -> "" in - reportDoc := + report_doc := let open TerminalDoc in - let ix = startLine + i in - group ~break:Always (append !reportDoc (renderLine line ix)) + let ix = start_line + i in + group ~break:Always (append !report_doc (render_line line ix)) done; - TerminalDoc.toString !reportDoc + TerminalDoc.to_string !report_doc type problem = | Unexpected of Token.t [@live] @@ -2674,7 +2674,7 @@ module Reporting = struct | Lident [@live] | Unbalanced of Token.t [@live] - type parseError = Lexing.position * problem + type parse_error = Lexing.position * problem end module Diagnostics: sig @@ -2682,27 +2682,27 @@ module Diagnostics: sig type category type report - type reportStyle - val parseReportStyle: string -> reportStyle + type report_style + val parse_report_style: string -> report_style 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 unclosedString: category - val unclosedTemplate: category - val unclosedComment: category - val unknownUchar: int -> category + val unclosed_string: category + val unclosed_template: category + val unclosed_comment: category + val unknown_uchar: int -> category val message: string -> category val make: filename: string - -> startPos: Lexing.position - -> endPos: Lexing.position + -> start_pos: Lexing.position + -> end_pos: Lexing.position -> category -> t - val stringOfReport: style:reportStyle -> t list -> string -> string + val string_of_report: style:report_style -> t list -> string -> string end = struct type category = | Unexpected of {token: Token.t; context: (Grammar.t * Lexing.position) list} @@ -2717,45 +2717,45 @@ end = struct type t = { filename: string; - startPos: Lexing.position; - endPos: Lexing.position; + start_pos: Lexing.position; + end_pos: Lexing.position; category: category; } type report = t list (* TODO: add json here *) - type reportStyle = + type report_style = | Pretty | Plain - let parseReportStyle txt = match (String.lowercase_ascii txt) with + let parse_report_style txt = match (String.lowercase_ascii txt) with | "plain" -> Plain | _ -> Pretty - let defaultUnexpected token = - "I'm not sure what to parse here when looking at \"" ^ (Token.toString token) ^ "\"." + let default_unexpected token = + "I'm not sure what to parse here when looking at \"" ^ (Token.to_string token) ^ "\"." let explain t = match t.category with - | Uident currentToken -> - begin match currentToken with + | Uident current_token -> + begin match current_token with | Lident lident -> let guess = String.capitalize_ascii lident in "Did you mean `" ^ guess ^"` instead of `" ^ lident ^ "`?" - | t when Token.isKeyword t -> - let token = Token.toString t in + | t when Token.is_keyword t -> + let token = Token.to_string t in "`" ^ token ^ "` is a reserved keyword." | _ -> "At this point, I'm looking for an uppercased identifier like `Belt` or `Array`" end - | Lident currentToken -> - begin match currentToken with + | Lident current_token -> + begin match current_token with | Uident uident -> let guess = String.uncapitalize_ascii uident in "Did you mean `" ^ guess ^"` instead of `" ^ uident ^ "`?" - | t when Token.isKeyword t -> - let token = Token.toString t in + | t when Token.is_keyword t -> + let token = Token.to_string t in "`" ^ token ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" ^ token ^ "\"" | Underscore -> "`_` isn't a valid name." @@ -2778,21 +2778,21 @@ end = struct end | Expected {context; token = t} -> let hint = match context with - | Some grammar -> "It signals the start of " ^ (Grammar.toString grammar) + | Some grammar -> "It signals the start of " ^ (Grammar.to_string grammar) | None -> "" in - "Did you forget a `" ^ (Token.toString t) ^ "` here? " ^ hint + "Did you forget a `" ^ (Token.to_string t) ^ "` here? " ^ hint | Unexpected {token = t; context = breadcrumbs} -> - let name = (Token.toString t) in + let name = (Token.to_string t) in begin match breadcrumbs with | (AtomicTypExpr, _)::breadcrumbs -> begin match breadcrumbs, t with | ((StringFieldDeclarations | FieldDeclarations) , _) :: _, (String _ | At | Rbrace | Comma | Eof) -> "I'm missing a type here" - | _, t when Grammar.isStructureItemStart t || t = Eof -> + | _, t when Grammar.is_structure_item_start t || t = Eof -> "Missing a type here" | _ -> - defaultUnexpected t + default_unexpected t end | (ExprOperand, _)::breadcrumbs -> begin match breadcrumbs, t with @@ -2822,62 +2822,62 @@ end = struct end | _ -> (* TODO: match on circumstance to verify Lident needed ? *) - if Token.isKeyword t then - "`" ^ name ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" ^ (Token.toString t) ^ "\"" + if Token.is_keyword t then + "`" ^ name ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" ^ (Token.to_string t) ^ "\"" else "I'm not sure what to parse here when looking at \"" ^ name ^ "\"." end - let toPlainString t buffer = + let to_plain_string t buffer = Buffer.add_string buffer t.filename; Buffer.add_char buffer '('; - Buffer.add_string buffer (string_of_int t.startPos.pos_cnum); + Buffer.add_string buffer (string_of_int t.start_pos.pos_cnum); Buffer.add_char buffer ','; - Buffer.add_string buffer (string_of_int t.endPos.pos_cnum); + Buffer.add_string buffer (string_of_int t.end_pos.pos_cnum); Buffer.add_char buffer ')'; Buffer.add_char buffer ':'; Buffer.add_string buffer (explain t) - let toString t src = + let to_string t src = let open Lexing in - let startchar = t.startPos.pos_cnum - t.startPos.pos_bol in - let endchar = t.endPos.pos_cnum - t.startPos.pos_cnum + startchar in - let locationInfo = + let startchar = t.start_pos.pos_cnum - t.start_pos.pos_bol in + let endchar = t.end_pos.pos_cnum - t.start_pos.pos_cnum + startchar in + let location_info = Printf.sprintf (* ReasonLanguageServer requires the following format *) "File \"%s\", line %d, characters %d-%d:" t.filename - t.startPos.pos_lnum + t.start_pos.pos_lnum startchar endchar in let code = let missing = match t.category with | Expected {token = t} -> - Some (String.length (Token.toString t)) + Some (String.length (Token.to_string t)) | _ -> None in - Reporting.renderCodeContext ~missing src t.startPos t.endPos + Reporting.render_code_context ~missing src t.start_pos t.end_pos in let explanation = explain t in - Printf.sprintf "%s\n\n%s\n\n%s\n\n" locationInfo code explanation + Printf.sprintf "%s\n\n%s\n\n%s\n\n" location_info code explanation - let make ~filename ~startPos ~endPos category = { + let make ~filename ~start_pos ~end_pos category = { filename; - startPos; - endPos; + start_pos; + end_pos; category } - let stringOfReport ~style diagnostics src = + let string_of_report ~style diagnostics src = match style with | Pretty -> List.fold_left (fun report diagnostic -> - report ^ (toString diagnostic src) ^ "\n" + report ^ (to_string diagnostic src) ^ "\n" ) "\n" (List.rev diagnostics) | Plain -> let buffer = Buffer.create 100 in List.iter (fun diagnostic -> - toPlainString diagnostic buffer; + to_plain_string diagnostic buffer; Buffer.add_char buffer '\n'; ) diagnostics; Buffer.contents buffer @@ -2888,12 +2888,12 @@ end = struct let expected ?grammar pos token = Expected {context = grammar; pos; token} - 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 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 message txt = Message txt end @@ -2905,41 +2905,41 @@ module ParsetreeViewer : sig (* 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 arrowType: Parsetree.core_type -> + val arrow_type: Parsetree.core_type -> Parsetree.attributes * (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list * Parsetree.core_type - val functorType: Parsetree.module_type -> + val functor_type: Parsetree.module_type -> (Parsetree.attributes * string Asttypes.loc * Parsetree.module_type option) list * Parsetree.module_type (* filters @bs out of the provided attributes *) - val processUncurriedAttribute: Parsetree.attributes -> bool * Parsetree.attributes + val process_uncurried_attribute: Parsetree.attributes -> bool * Parsetree.attributes (* 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 collectIfExpressions: + val collect_if_expressions: Parsetree.expression -> (Parsetree.expression * Parsetree.expression) list * Parsetree.expression option - val collectListExpressions: + val collect_list_expressions: Parsetree.expression -> (Parsetree.expression list * Parsetree.expression option) - type funParamKind = + type fun_param_kind = | Parameter of { attrs: Parsetree.attributes; lbl: Asttypes.arg_label; - defaultExpr: Parsetree.expression option; + default_expr: Parsetree.expression option; pat: Parsetree.pattern; } | NewTypes of {attrs: Parsetree.attributes; locs: string Asttypes.loc list} - val funExpr: + val fun_expr: Parsetree.expression -> Parsetree.attributes * - funParamKind list * + fun_param_kind list * Parsetree.expression (* example: @@ -2948,106 +2948,106 @@ module ParsetreeViewer : sig * y: 2, * })` * Notice howe `({` and `})` "hug" or stick to each other *) - val isHuggableExpression: Parsetree.expression -> bool + val is_huggable_expression: Parsetree.expression -> bool - val isHuggablePattern: Parsetree.pattern -> bool + val is_huggable_pattern: Parsetree.pattern -> bool - val isHuggableRhs: Parsetree.expression -> bool + val is_huggable_rhs: Parsetree.expression -> bool - val operatorPrecedence: string -> int + val operator_precedence: string -> int - val isUnaryExpression: Parsetree.expression -> bool - val isBinaryOperator: string -> bool - val isBinaryExpression: Parsetree.expression -> bool + val is_unary_expression: Parsetree.expression -> bool + val is_binary_operator: string -> bool + val is_binary_expression: Parsetree.expression -> bool - val flattenableOperators: string -> string -> bool + val flattenable_operators: string -> string -> bool - val hasAttributes: Parsetree.attributes -> bool + val has_attributes: Parsetree.attributes -> bool - val isArrayAccess: Parsetree.expression -> bool - val isTernaryExpr: Parsetree.expression -> bool + val is_array_access: Parsetree.expression -> bool + val is_ternary_expr: Parsetree.expression -> bool - val collectTernaryParts: Parsetree.expression -> ((Parsetree.expression * Parsetree.expression) list * Parsetree.expression) + val collect_ternary_parts: Parsetree.expression -> ((Parsetree.expression * Parsetree.expression) list * Parsetree.expression) - val parametersShouldHug: - funParamKind list -> bool + val parameters_should_hug: + fun_param_kind list -> bool - val filterTernaryAttributes: Parsetree.attributes -> Parsetree.attributes + val filter_ternary_attributes: Parsetree.attributes -> Parsetree.attributes - val isJsxExpression: Parsetree.expression -> bool - val hasJsxAttribute: Parsetree.attributes -> bool + val is_jsx_expression: Parsetree.expression -> bool + val has_jsx_attribute: Parsetree.attributes -> bool - val shouldIndentBinaryExpr: Parsetree.expression -> bool - val shouldInlineRhsBinaryExpr: Parsetree.expression -> bool - val filterPrinteableAttributes: Parsetree.attributes -> Parsetree.attributes - val partitionPrinteableAttributes: Parsetree.attributes -> (Parsetree.attributes * Parsetree.attributes) + val should_indent_binary_expr: Parsetree.expression -> bool + val should_inline_rhs_binary_expr: Parsetree.expression -> bool + val filter_printeable_attributes: Parsetree.attributes -> Parsetree.attributes + val partition_printeable_attributes: Parsetree.attributes -> (Parsetree.attributes * Parsetree.attributes) - val requiresSpecialCallbackPrintingLastArg: (Asttypes.arg_label * Parsetree.expression) list -> bool - val requiresSpecialCallbackPrintingFirstArg: (Asttypes.arg_label * Parsetree.expression) list -> bool + val requires_special_callback_printing_last_arg: (Asttypes.arg_label * Parsetree.expression) list -> bool + val requires_special_callback_printing_first_arg: (Asttypes.arg_label * Parsetree.expression) list -> bool - val modExprApply : Parsetree.module_expr -> ( + val mod_expr_apply : Parsetree.module_expr -> ( Parsetree.module_expr list * Parsetree.module_expr ) - val modExprFunctor : Parsetree.module_expr -> ( + val mod_expr_functor : Parsetree.module_expr -> ( (Parsetree.attributes * string Asttypes.loc * Parsetree.module_type option) list * Parsetree.module_expr ) - val splitGenTypeAttr : Parsetree.attributes -> (bool * Parsetree.attributes) + val split_gen_type_attr : Parsetree.attributes -> (bool * Parsetree.attributes) - val collectPatternsFromListConstruct: + val collect_patterns_from_list_construct: Parsetree.pattern list -> Parsetree.pattern -> (Parsetree.pattern list * Parsetree.pattern) - val isBlockExpr : Parsetree.expression -> bool + val is_block_expr : Parsetree.expression -> bool - val isTemplateLiteral: Parsetree.expression -> bool + val is_template_literal: Parsetree.expression -> bool - val collectOrPatternChain: + val collect_or_pattern_chain: Parsetree.pattern -> Parsetree.pattern list - val processBracesAttr : Parsetree.expression -> (Parsetree.attribute option * Parsetree.expression) + val process_braces_attr : Parsetree.expression -> (Parsetree.attribute option * Parsetree.expression) - val filterParsingAttrs : Parsetree.attributes -> Parsetree.attributes + val filter_parsing_attrs : Parsetree.attributes -> Parsetree.attributes - val isBracedExpr : Parsetree.expression -> bool + val is_braced_expr : Parsetree.expression -> bool - val isPipeExpr : Parsetree.expression -> bool + val is_pipe_expr : Parsetree.expression -> bool - val extractValueDescriptionFromModExpr: Parsetree.module_expr -> Parsetree.value_description list + val extract_value_description_from_mod_expr: Parsetree.module_expr -> Parsetree.value_description list - type jsImportScope = + type js_import_scope = | JsGlobalImport (* nothing *) | JsModuleImport of string (* from "path" *) | JsScopedImport of string list (* window.location *) - val classifyJsImport: Parsetree.value_description -> jsImportScope + val classify_js_import: Parsetree.value_description -> js_import_scope (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - val rewriteUnderscoreApply: Parsetree.expression -> Parsetree.expression + val rewrite_underscore_apply: Parsetree.expression -> Parsetree.expression (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - val isUnderscoreApplySugar: Parsetree.expression -> bool + val is_underscore_apply_sugar: Parsetree.expression -> bool end = struct open Parsetree - let arrowType ct = - let rec process attrsBefore acc typ = match typ with + let arrow_type ct = + let rec process attrs_before acc typ = match typ with | {ptyp_desc = Ptyp_arrow (Nolabel as lbl, typ1, typ2); ptyp_attributes = []} -> let arg = ([], lbl, typ1) in - process attrsBefore (arg::acc) typ2 + process attrs_before (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 attrsBefore (arg::acc) typ2 - | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = _attrs} as returnType -> + process attrs_before (arg::acc) typ2 + | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = _attrs} as return_type -> let args = List.rev acc in - (attrsBefore, args, returnType) + (attrs_before, args, return_type) | {ptyp_desc = Ptyp_arrow ((Labelled _ | Optional _) as lbl, typ1, typ2); ptyp_attributes = attrs} -> let arg = (attrs, lbl, typ1) in - process attrsBefore (arg::acc) typ2 + process attrs_before (arg::acc) typ2 | typ -> - (attrsBefore, List.rev acc, typ) + (attrs_before, List.rev acc, typ) in begin match ct with | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as typ -> @@ -3055,38 +3055,38 @@ end = struct | typ -> process [] [] typ end - let functorType modtype = + let functor_type modtype = let rec process acc modtype = match modtype with - | {pmty_desc = Pmty_functor (lbl, argType, returnType); pmty_attributes = attrs} -> - let arg = (attrs, lbl, argType) in - process (arg::acc) returnType - | modType -> - (List.rev acc, modType) + | {pmty_desc = Pmty_functor (lbl, arg_type, return_type); pmty_attributes = attrs} -> + let arg = (attrs, lbl, arg_type) in + process (arg::acc) return_type + | mod_type -> + (List.rev acc, mod_type) in process [] modtype - let processUncurriedAttribute attrs = - let rec process uncurriedSpotted acc attrs = + let process_uncurried_attribute attrs = + let rec process uncurried_spotted acc attrs = match attrs with - | [] -> (uncurriedSpotted, List.rev acc) + | [] -> (uncurried_spotted, List.rev acc) | ({Location.txt = "bs"}, _)::rest -> process true acc rest - | attr::rest -> process uncurriedSpotted (attr::acc) rest + | attr::rest -> process uncurried_spotted (attr::acc) rest in process false [] attrs - let collectIfExpressions expr = + let collect_if_expressions expr = let rec collect acc expr = match expr.pexp_desc with - | Pexp_ifthenelse (ifExpr, thenExpr, Some elseExpr) -> - collect ((ifExpr, thenExpr)::acc) elseExpr - | Pexp_ifthenelse (ifExpr, thenExpr, (None as elseExpr)) -> - let ifs = List.rev ((ifExpr, thenExpr)::acc) in - (ifs, elseExpr) + | Pexp_ifthenelse (if_expr, then_expr, Some else_expr) -> + collect ((if_expr, then_expr)::acc) else_expr + | Pexp_ifthenelse (if_expr, then_expr, (None as else_expr)) -> + let ifs = List.rev ((if_expr, then_expr)::acc) in + (ifs, else_expr) | _ -> (List.rev acc, Some expr) in collect [] expr - let collectListExpressions expr = + let collect_list_expressions expr = let rec collect acc expr = match expr.pexp_desc with | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> (List.rev acc, None) @@ -3101,85 +3101,85 @@ end = struct collect [] expr (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - let rewriteUnderscoreApply expr = + let rewrite_underscore_apply expr = match expr.pexp_desc with | Pexp_fun ( Nolabel, None, {ppat_desc = Ppat_var {txt="__x"}}, - ({pexp_desc = Pexp_apply (callExpr, args)} as e) + ({pexp_desc = Pexp_apply (call_expr, args)} as e) ) -> - let newArgs = List.map (fun arg -> + let new_args = List.map (fun arg -> match arg with | ( lbl, - ({pexp_desc = Pexp_ident ({txt = Longident.Lident "__x"} as lid)} as argExpr) + ({pexp_desc = Pexp_ident ({txt = Longident.Lident "__x"} as lid)} as arg_expr) ) -> - (lbl, {argExpr with pexp_desc = Pexp_ident ({lid with txt = Longident.Lident "_"})}) + (lbl, {arg_expr with pexp_desc = Pexp_ident ({lid with txt = Longident.Lident "_"})}) | arg -> arg ) args in - {e with pexp_desc = Pexp_apply (callExpr, newArgs)} + {e with pexp_desc = Pexp_apply (call_expr, new_args)} | _ -> expr - type funParamKind = + type fun_param_kind = | Parameter of { attrs: Parsetree.attributes; lbl: Asttypes.arg_label; - defaultExpr: Parsetree.expression option; + default_expr: Parsetree.expression option; pat: Parsetree.pattern; } | NewTypes of {attrs: Parsetree.attributes; locs: string Asttypes.loc list} - let funExpr expr = + let fun_expr expr = (* Turns (type t, type u, type z) into "type t u z" *) - let rec collectNewTypes acc returnExpr = - match returnExpr with - | {pexp_desc = Pexp_newtype (stringLoc, returnExpr); pexp_attributes = []} -> - collectNewTypes (stringLoc::acc) returnExpr - | returnExpr -> - (List.rev acc, returnExpr) - in - let rec collect attrsBefore acc expr = match expr with + let rec collect_new_types acc return_expr = + match return_expr with + | {pexp_desc = Pexp_newtype (string_loc, return_expr); pexp_attributes = []} -> + collect_new_types (string_loc::acc) return_expr + | return_expr -> + (List.rev acc, return_expr) + in + let rec collect attrs_before acc expr = match expr with | {pexp_desc = Pexp_fun ( Nolabel, None, {ppat_desc = Ppat_var {txt="__x"}}, {pexp_desc = Pexp_apply _} )} -> - (attrsBefore, List.rev acc, rewriteUnderscoreApply expr) - | {pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); pexp_attributes = []} -> + (attrs_before, List.rev acc, rewrite_underscore_apply expr) + | {pexp_desc = Pexp_fun (lbl, default_expr, pattern, return_expr); pexp_attributes = []} -> let parameter = Parameter { attrs = []; lbl = lbl; - defaultExpr = defaultExpr; + default_expr = default_expr; pat = pattern; } in - collect attrsBefore (parameter::acc) returnExpr - | {pexp_desc = Pexp_newtype (stringLoc, rest); pexp_attributes = attrs} -> - let (stringLocs, returnExpr) = collectNewTypes [stringLoc] rest in - let param = NewTypes {attrs; locs = stringLocs} in - collect attrsBefore (param::acc) returnExpr - | {pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); pexp_attributes = [({txt = "bs"}, _)] as attrs} -> + collect attrs_before (parameter::acc) return_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 attrs_before (param::acc) return_expr + | {pexp_desc = Pexp_fun (lbl, default_expr, pattern, return_expr); pexp_attributes = [({txt = "bs"}, _)] as attrs} -> let parameter = Parameter { attrs = attrs; lbl = lbl; - defaultExpr = defaultExpr; + default_expr = default_expr; pat = pattern; } in - collect attrsBefore (parameter::acc) returnExpr + collect attrs_before (parameter::acc) return_expr | { - pexp_desc = Pexp_fun ((Labelled _ | Optional _) as lbl, defaultExpr, pattern, returnExpr); + pexp_desc = Pexp_fun ((Labelled _ | Optional _) as lbl, default_expr, pattern, return_expr); pexp_attributes = attrs } -> let parameter = Parameter { attrs = attrs; lbl = lbl; - defaultExpr = defaultExpr; + default_expr = default_expr; pat = pattern; } in - collect attrsBefore (parameter::acc) returnExpr + collect attrs_before (parameter::acc) return_expr | expr -> - (attrsBefore, List.rev acc, expr) + (attrs_before, List.rev acc, expr) in begin match expr with | {pexp_desc = Pexp_fun (Nolabel, _defaultExpr, _pattern, _returnExpr); pexp_attributes = attrs} as expr -> @@ -3187,21 +3187,21 @@ end = struct | expr -> collect [] [] expr end - let processBracesAttr expr = + let process_braces_attr expr = match expr.pexp_attributes with | (({txt = "res.braces"}, _) as attr)::attrs -> (Some attr, {expr with pexp_attributes = attrs}) | _ -> (None, expr) - let filterParsingAttrs attrs = + let filter_parsing_attrs attrs = List.filter (fun attr -> match attr with | ({Location.txt = ("res.ternary" | "res.braces" | "bs" | "res.namedArgLoc")}, _) -> false | _ -> true ) attrs - let isBlockExpr expr = + let is_block_expr expr = match expr.pexp_desc with | Pexp_letmodule _ | Pexp_letexception _ @@ -3210,33 +3210,33 @@ end = struct | Pexp_sequence _ -> true | _ -> false - let isBracedExpr expr = - match processBracesAttr expr with + let is_braced_expr expr = + match process_braces_attr expr with | (Some _, _) -> true | _ -> false - let isHuggableExpression expr = + let is_huggable_expression expr = match expr.pexp_desc with | Pexp_array _ | Pexp_tuple _ | Pexp_construct ({txt = Longident.Lident ("::" | "[]")}, _) | Pexp_extension ({txt = "obj"}, _) | Pexp_record _ -> true - | _ when isBlockExpr expr -> true - | _ when isBracedExpr expr -> true + | _ when is_block_expr expr -> true + | _ when is_braced_expr expr -> true | _ -> false - let isHuggableRhs expr = + let is_huggable_rhs expr = match expr.pexp_desc with | Pexp_array _ | Pexp_tuple _ | Pexp_construct ({txt = Longident.Lident ("::" | "[]")}, _) | Pexp_extension ({txt = "obj"}, _) | Pexp_record _ -> true - | _ when isBracedExpr expr -> true + | _ when is_braced_expr expr -> true | _ -> false - let isHuggablePattern pattern = + let is_huggable_pattern pattern = match pattern.ppat_desc with | Ppat_array _ | Ppat_tuple _ @@ -3244,7 +3244,7 @@ end = struct | Ppat_construct _ -> true | _ -> false - let operatorPrecedence operator = match operator with + let operator_precedence operator = match operator with | ":=" -> 1 | "||" -> 2 | "&&" -> 3 @@ -3255,18 +3255,18 @@ end = struct | "#" | "##" | "|." -> 8 | _ -> 0 - let isUnaryOperator operator = match operator with + let is_unary_operator operator = match operator with | "~+" | "~+." | "~-" | "~-." | "not" -> true | _ -> false - let isUnaryExpression expr = match expr.pexp_desc with + let is_unary_expression expr = match expr.pexp_desc with | Pexp_apply( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [Nolabel, _arg] - ) when isUnaryOperator operator -> true + ) when is_unary_operator operator -> true | _ -> false - let isBinaryOperator operator = match operator with + let is_binary_operator operator = match operator with | ":=" | "||" | "&&" @@ -3277,80 +3277,80 @@ end = struct | "|." | "<>" -> true | _ -> false - let isBinaryExpression expr = match expr.pexp_desc with + let is_binary_expression expr = match expr.pexp_desc with | Pexp_apply( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, _operand1); (Nolabel, _operand2)] - ) when isBinaryOperator operator -> true + ) when is_binary_operator operator -> true | _ -> false - let isEqualityOperator operator = match operator with + let is_equality_operator operator = match operator with | "=" | "==" | "<>" | "!=" -> true | _ -> false - let flattenableOperators parentOperator childOperator = - let precParent = operatorPrecedence parentOperator in - let precChild = operatorPrecedence childOperator in - if precParent == precChild then + 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 ( - isEqualityOperator parentOperator && - isEqualityOperator childOperator + is_equality_operator parent_operator && + is_equality_operator child_operator ) else false - let hasAttributes attrs = + let has_attributes attrs = List.exists (fun attr -> match attr with | ({Location.txt = "bs" | "res.ternary" | "res.braces"}, _) -> false | _ -> true ) attrs - let isArrayAccess expr = match expr.pexp_desc with + let is_array_access expr = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}}, [Nolabel, _parentExpr; Nolabel, _memberExpr] ) -> true | _ -> false - let rec hasTernaryAttribute attrs = + let rec has_ternary_attribute attrs = match attrs with | [] -> false | ({Location.txt="res.ternary"},_)::_ -> true - | _::attrs -> hasTernaryAttribute attrs + | _::attrs -> has_ternary_attribute attrs - let isTernaryExpr expr = match expr with + let is_ternary_expr expr = match expr with | { pexp_attributes = attrs; pexp_desc = Pexp_ifthenelse _ - } when hasTernaryAttribute attrs -> true + } when has_ternary_attribute attrs -> true | _ -> false - let collectTernaryParts expr = + let collect_ternary_parts expr = let rec collect acc expr = match expr with | { pexp_attributes = attrs; pexp_desc = Pexp_ifthenelse (condition, consequent, Some(alternate)) - } when hasTernaryAttribute attrs -> collect ((condition, consequent)::acc) alternate + } when has_ternary_attribute attrs -> collect ((condition, consequent)::acc) alternate | alternate -> (List.rev acc, alternate) in collect [] expr - let parametersShouldHug parameters = match parameters with + let parameters_should_hug parameters = match parameters with | [Parameter { attrs = []; lbl = Asttypes.Nolabel; - defaultExpr = None; + default_expr = None; pat = pat - }] when isHuggablePattern pat -> true + }] when is_huggable_pattern pat -> true | _ -> false - let filterTernaryAttributes attrs = + let filter_ternary_attributes attrs = List.filter (fun attr -> match attr with |({Location.txt="res.ternary"},_) -> false | _ -> true ) attrs - let isJsxExpression expr = + let is_jsx_expression expr = let rec loop attrs = match attrs with | [] -> false @@ -3362,31 +3362,31 @@ end = struct loop expr.Parsetree.pexp_attributes | _ -> false - let hasJsxAttribute attributes = match attributes with + let has_jsx_attribute attributes = match attributes with | ({Location.txt = "JSX"},_)::_ -> true | _ -> false - let shouldIndentBinaryExpr expr = - let samePrecedenceSubExpression operator subExpression = - match subExpression with + let should_indent_binary_expr expr = + let same_precedence_sub_expression operator sub_expression = + match sub_expression with | {pexp_desc = Pexp_apply ( - {pexp_desc = Pexp_ident {txt = Longident.Lident subOperator}}, + {pexp_desc = Pexp_ident {txt = Longident.Lident sub_operator}}, [Nolabel, _lhs; Nolabel, _rhs] - )} when isBinaryOperator subOperator -> - flattenableOperators operator subOperator + )} when is_binary_operator sub_operator -> + flattenable_operators operator sub_operator | _ -> true in match expr with | {pexp_desc = Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [Nolabel, lhs; Nolabel, _rhs] - )} when isBinaryOperator operator -> - isEqualityOperator operator || - not (samePrecedenceSubExpression operator lhs) || + )} when is_binary_operator operator -> + is_equality_operator operator || + not (same_precedence_sub_expression operator lhs) || operator = ":=" | _ -> false - let shouldInlineRhsBinaryExpr rhs = match rhs.pexp_desc with + let should_inline_rhs_binary_expr rhs = match rhs.pexp_desc with | Parsetree.Pexp_constant _ | Pexp_let _ | Pexp_letmodule _ @@ -3401,19 +3401,19 @@ end = struct | Pexp_record _ -> true | _ -> false - let filterPrinteableAttributes attrs = + let filter_printeable_attributes attrs = List.filter (fun attr -> match attr with | ({Location.txt="bs" | "res.ternary"}, _) -> false | _ -> true ) attrs - let partitionPrinteableAttributes attrs = + let partition_printeable_attributes attrs = List.partition (fun attr -> match attr with | ({Location.txt="bs" | "res.ternary"}, _) -> false | _ -> true ) attrs - let requiresSpecialCallbackPrintingLastArg args = + let requires_special_callback_printing_last_arg args = let rec loop args = match args with | [] -> false | [(_, {pexp_desc = Pexp_fun _ | Pexp_newtype _})] -> true @@ -3422,7 +3422,7 @@ end = struct in loop args - let requiresSpecialCallbackPrintingFirstArg args = + let requires_special_callback_printing_first_arg args = let rec loop args = match args with | [] -> true | (_, {pexp_desc = Pexp_fun _ | Pexp_newtype _})::_ -> false @@ -3433,41 +3433,41 @@ end = struct | (_, {pexp_desc = Pexp_fun _ | Pexp_newtype _})::rest -> loop rest | _ -> false - let modExprApply modExpr = - let rec loop acc modExpr = match modExpr with + let mod_expr_apply mod_expr = + let rec loop acc mod_expr = match mod_expr with | {pmod_desc = Pmod_apply (next, arg)} -> loop (arg::acc) next - | _ -> (acc, modExpr) + | _ -> (acc, mod_expr) in - loop [] modExpr + loop [] mod_expr - let modExprFunctor modExpr = - let rec loop acc modExpr = match modExpr with - | {pmod_desc = Pmod_functor (lbl, modType, returnModExpr); pmod_attributes = attrs} -> - let param = (attrs, lbl, modType) in - loop (param::acc) returnModExpr - | returnModExpr -> - (List.rev acc, returnModExpr) + let mod_expr_functor mod_expr = + let rec loop acc mod_expr = match mod_expr with + | {pmod_desc = Pmod_functor (lbl, mod_type, return_mod_expr); 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) in - loop [] modExpr + loop [] mod_expr - let splitGenTypeAttr attrs = + let split_gen_type_attr attrs = match attrs with | ({Location.txt = "genType"}, _)::attrs -> (true, attrs) | attrs -> (false, attrs) - let rec collectPatternsFromListConstruct acc pattern = + let rec collect_patterns_from_list_construct acc pattern = let open Parsetree in match pattern.ppat_desc with | Ppat_construct( {txt = Longident.Lident "::"}, Some {ppat_desc=Ppat_tuple (pat::rest::[])} ) -> - collectPatternsFromListConstruct (pat::acc) rest + collect_patterns_from_list_construct (pat::acc) rest | _ -> List.rev acc, pattern - let rec isTemplateLiteral expr = - let isPexpConstantString expr = match expr.pexp_desc with + let rec is_template_literal expr = + let is_pexp_constant_string expr = match expr.pexp_desc with | Pexp_constant (Pconst_string (_, Some _)) -> true | _ -> false in @@ -3475,13 +3475,13 @@ end = struct | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "^"}}, [Nolabel, arg1; Nolabel, arg2] - ) when not (isPexpConstantString arg1 && isPexpConstantString arg2) -> - isTemplateLiteral arg1 || isTemplateLiteral arg2 + ) when not (is_pexp_constant_string arg1 && is_pexp_constant_string arg2) -> + is_template_literal arg1 || is_template_literal arg2 | Pexp_constant (Pconst_string (_, Some _)) -> true | _ -> false (* Blue | Red | Green -> [Blue; Red; Green] *) - let collectOrPatternChain pat = + let collect_or_pattern_chain pat = let rec loop pattern chain = match pattern.ppat_desc with | Ppat_or (left, right) -> loop left (right::chain) @@ -3489,33 +3489,33 @@ end = struct in loop pat [] - let isPipeExpr expr = match expr.pexp_desc with + let is_pipe_expr expr = match expr.pexp_desc with | Pexp_apply( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|>") }}, [(Nolabel, _operand1); (Nolabel, _operand2)] ) -> true | _ -> false - let extractValueDescriptionFromModExpr modExpr = + let extract_value_description_from_mod_expr mod_expr = let rec loop structure acc = match structure with | [] -> List.rev acc - | structureItem::structure -> - begin match structureItem.Parsetree.pstr_desc with + | structure_item::structure -> + begin match structure_item.Parsetree.pstr_desc with | Pstr_primitive vd -> loop structure (vd::acc) | _ -> loop structure acc end in - match modExpr.pmod_desc with + match mod_expr.pmod_desc with | Pmod_structure structure -> loop structure [] | _ -> [] - type jsImportScope = + type js_import_scope = | JsGlobalImport (* nothing *) | JsModuleImport of string (* from "path" *) | JsScopedImport of string list (* window.location *) - let classifyJsImport valueDescription = + let classify_js_import value_description = let rec loop attrs = let open Parsetree in match attrs with @@ -3535,9 +3535,9 @@ end = struct | _::attrs -> loop attrs in - loop valueDescription.pval_attributes + loop value_description.pval_attributes - let isUnderscoreApplySugar expr = + let is_underscore_apply_sugar expr = match expr.pexp_desc with | Pexp_fun ( Nolabel, @@ -3552,42 +3552,42 @@ module Parens: sig type kind = Parenthesized | Braced of Location.t | Nothing val expr: Parsetree.expression -> kind - val structureExpr: Parsetree.expression -> kind + val structure_expr: Parsetree.expression -> kind - val unaryExprOperand: Parsetree.expression -> kind + val unary_expr_operand: Parsetree.expression -> kind - 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_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 lazyOrAssertExprRhs: Parsetree.expression -> kind + val lazy_or_assert_expr_rhs: Parsetree.expression -> kind - val fieldExpr: Parsetree.expression -> kind + val field_expr: Parsetree.expression -> kind - val setFieldExprRhs: Parsetree.expression -> kind + val set_field_expr_rhs: Parsetree.expression -> kind - val ternaryOperand: Parsetree.expression -> kind + val ternary_operand: Parsetree.expression -> kind - val jsxPropExpr: Parsetree.expression -> kind - val jsxChildExpr: Parsetree.expression -> kind + val jsx_prop_expr: Parsetree.expression -> kind + val jsx_child_expr: Parsetree.expression -> kind - val binaryExpr: Parsetree.expression -> kind - val modTypeFunctorReturn: Parsetree.module_type -> bool - val modTypeWithOperand: Parsetree.module_type -> bool - val modExprFunctorConstraint: Parsetree.module_type -> bool + 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 bracedExpr: Parsetree.expression -> bool - val callExpr: Parsetree.expression -> kind + val braced_expr: Parsetree.expression -> bool + val call_expr: Parsetree.expression -> kind - val includeModExpr : Parsetree.module_expr -> bool + val include_mod_expr : Parsetree.module_expr -> bool end = struct type kind = Parenthesized | Braced of Location.t | Nothing let expr expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced(bracesLoc) + let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in + match opt_braces with + | Some ({Location.loc = braces_loc}, _) -> Braced(braces_loc) | _ -> begin match expr with | {Parsetree.pexp_desc = Pexp_constraint ( @@ -3598,25 +3598,25 @@ end = struct | _ -> Nothing end - let callExpr expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced(bracesLoc) + 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) | _ -> begin match expr with | {Parsetree.pexp_attributes = attrs} when - begin match ParsetreeViewer.filterParsingAttrs attrs with + begin match ParsetreeViewer.filter_parsing_attrs attrs with | _::_ -> true | [] -> false end -> Parenthesized - | _ when ParsetreeViewer.isUnaryExpression expr || ParsetreeViewer.isBinaryExpression expr -> Parenthesized + | _ when ParsetreeViewer.is_unary_expression expr || ParsetreeViewer.is_binary_expression expr -> Parenthesized | {Parsetree.pexp_desc = Pexp_constraint ( {pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _} )} -> Nothing | {pexp_desc = Pexp_fun _} - when ParsetreeViewer.isUnderscoreApplySugar expr -> Nothing + when ParsetreeViewer.is_underscore_apply_sugar expr -> Nothing | {pexp_desc = Pexp_lazy _ | Pexp_assert _ @@ -3634,14 +3634,14 @@ end = struct | _ -> Nothing end - let structureExpr expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced(bracesLoc) + 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) | None -> begin match expr with - | _ when ParsetreeViewer.hasAttributes expr.pexp_attributes && - not (ParsetreeViewer.isJsxExpression expr) -> Parenthesized + | _ when ParsetreeViewer.has_attributes expr.pexp_attributes && + not (ParsetreeViewer.is_jsx_expression expr) -> Parenthesized | {Parsetree.pexp_desc = Pexp_constraint ( {pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _} @@ -3650,28 +3650,28 @@ end = struct | _ -> Nothing end - let unaryExprOperand expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced(bracesLoc) + 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) | None -> begin match expr with | {Parsetree.pexp_attributes = attrs} when - begin match ParsetreeViewer.filterParsingAttrs attrs with + begin match ParsetreeViewer.filter_parsing_attrs attrs with | _::_ -> true | [] -> false end -> Parenthesized | expr when - ParsetreeViewer.isUnaryExpression expr || - ParsetreeViewer.isBinaryExpression expr + ParsetreeViewer.is_unary_expression expr || + ParsetreeViewer.is_binary_expression expr -> Parenthesized | {pexp_desc = Pexp_constraint ( {pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _} )} -> Nothing | {pexp_desc = Pexp_fun _} - when ParsetreeViewer.isUnderscoreApplySugar expr -> Nothing + when ParsetreeViewer.is_underscore_apply_sugar expr -> Nothing | {pexp_desc = Pexp_lazy _ | Pexp_assert _ @@ -3690,10 +3690,10 @@ end = struct | _ -> Nothing end - let binaryExprOperand ~isLhs expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced(bracesLoc) + 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) | None -> begin match expr with | {Parsetree.pexp_desc = Pexp_constraint ( @@ -3701,78 +3701,78 @@ end = struct {ptyp_desc = Ptyp_package _} )} -> Nothing | {pexp_desc = Pexp_fun _} - when ParsetreeViewer.isUnderscoreApplySugar expr -> Nothing + when ParsetreeViewer.is_underscore_apply_sugar expr -> Nothing | {pexp_desc = Pexp_constraint _ | Pexp_fun _ | Pexp_function _ | Pexp_newtype _} -> Parenthesized - | expr when ParsetreeViewer.isBinaryExpression expr -> Parenthesized - | expr when ParsetreeViewer.isTernaryExpr 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 isLhs -> Parenthesized + } when is_lhs -> Parenthesized | _ -> Nothing end - 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)) || + 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)) || (* a && b || c, add parens to (a && b) for readability, who knows the difference by heart… *) - (parentOperator = "||" && childOperator = "&&") + (parent_operator = "||" && child_operator = "&&") - let rhsBinaryExprOperand parentOperator rhs = + let rhs_binary_expr_operand parent_operator rhs = match rhs.Parsetree.pexp_desc with | Parsetree.Pexp_apply( {pexp_attributes = []; pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [_, _left; _, _right] - ) when ParsetreeViewer.isBinaryOperator operator -> - let precParent = ParsetreeViewer.operatorPrecedence parentOperator in - let precChild = ParsetreeViewer.operatorPrecedence operator in - precParent == precChild + ) when ParsetreeViewer.is_binary_operator operator -> + let prec_parent = ParsetreeViewer.operator_precedence parent_operator in + let prec_child = ParsetreeViewer.operator_precedence operator in + prec_parent == prec_child | _ -> false - let flattenOperandRhs parentOperator rhs = + let flatten_operand_rhs parent_operator rhs = match rhs.Parsetree.pexp_desc with | Parsetree.Pexp_apply( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [_, _left; _, _right] - ) when ParsetreeViewer.isBinaryOperator operator -> - let precParent = ParsetreeViewer.operatorPrecedence parentOperator in - let precChild = ParsetreeViewer.operatorPrecedence operator in - precParent >= precChild || rhs.pexp_attributes <> [] + ) when ParsetreeViewer.is_binary_operator 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 <> [] | Pexp_constraint ( {pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _} ) -> false - | Pexp_fun _ when ParsetreeViewer.isUnderscoreApplySugar rhs -> false + | Pexp_fun _ when ParsetreeViewer.is_underscore_apply_sugar rhs -> false | Pexp_fun _ | Pexp_newtype _ | Pexp_setfield _ | Pexp_constraint _ -> true - | _ when ParsetreeViewer.isTernaryExpr rhs -> true + | _ when ParsetreeViewer.is_ternary_expr rhs -> true | _ -> false - let lazyOrAssertExprRhs expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced(bracesLoc) + let lazy_or_assert_expr_rhs expr = + let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in + match opt_braces with + | Some ({Location.loc = braces_loc}, _) -> Braced(braces_loc) | None -> begin match expr with | {Parsetree.pexp_attributes = attrs} when - begin match ParsetreeViewer.filterParsingAttrs attrs with + begin match ParsetreeViewer.filter_parsing_attrs attrs with | _::_ -> true | [] -> false end -> Parenthesized - | expr when ParsetreeViewer.isBinaryExpression expr -> Parenthesized + | expr when ParsetreeViewer.is_binary_expression expr -> Parenthesized | {pexp_desc = Pexp_constraint ( {pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _} )} -> Nothing | {pexp_desc = Pexp_fun _} - when ParsetreeViewer.isUnderscoreApplySugar expr -> Nothing + when ParsetreeViewer.is_underscore_apply_sugar expr -> Nothing | {pexp_desc = Pexp_lazy _ | Pexp_assert _ @@ -3790,38 +3790,38 @@ end = struct | _ -> Nothing end - let isNegativeConstant constant = - let isNeg txt = + let is_negative_constant constant = + let is_neg 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 isNeg i -> true + | Parsetree.Pconst_integer (i, _) | Pconst_float (i, _) when is_neg i -> true | _ -> false - let fieldExpr expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced(bracesLoc) + 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) | None -> begin match expr with | {Parsetree.pexp_attributes = attrs} when - begin match ParsetreeViewer.filterParsingAttrs attrs with + begin match ParsetreeViewer.filter_parsing_attrs attrs with | _::_ -> true | [] -> false end -> Parenthesized | expr when - ParsetreeViewer.isBinaryExpression expr || - ParsetreeViewer.isUnaryExpression expr + ParsetreeViewer.is_binary_expression expr || + ParsetreeViewer.is_unary_expression expr -> Parenthesized | {pexp_desc = Pexp_constraint ( {pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _} )} -> Nothing - | {pexp_desc = Pexp_constant c } when isNegativeConstant c -> Parenthesized + | {pexp_desc = Pexp_constant c } when is_negative_constant c -> Parenthesized | {pexp_desc = Pexp_fun _} - when ParsetreeViewer.isUnderscoreApplySugar expr -> Nothing + when ParsetreeViewer.is_underscore_apply_sugar expr -> Nothing | {pexp_desc = Pexp_lazy _ | Pexp_assert _ @@ -3840,10 +3840,10 @@ end = struct | _ -> Nothing end - let setFieldExprRhs expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced(bracesLoc) + 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) | None -> begin match expr with | {Parsetree.pexp_desc = Pexp_constraint ( @@ -3854,10 +3854,10 @@ end = struct | _ -> Nothing end - let ternaryOperand expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced(bracesLoc) + 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) | None -> begin match expr with | {Parsetree.pexp_desc = Pexp_constraint ( @@ -3866,15 +3866,15 @@ end = struct )} -> Nothing | {pexp_desc = Pexp_constraint _ } -> Parenthesized | {pexp_desc = Pexp_fun _ | Pexp_newtype _} -> - let (_attrsOnArrow, _parameters, returnExpr) = ParsetreeViewer.funExpr expr in - begin match returnExpr.pexp_desc with + let (_attrsOnArrow, _parameters, return_expr) = ParsetreeViewer.fun_expr expr in + begin match return_expr.pexp_desc with | Pexp_constraint _ -> Parenthesized | _ -> Nothing end | _ -> Nothing end - let startsWithMinus txt = + let starts_with_minus txt = let len = String.length txt in if len == 0 then false @@ -3882,7 +3882,7 @@ end = struct let s = (String.get [@doesNotRaise]) txt 0 in s = '-' - let jsxPropExpr expr = + let jsx_prop_expr expr = match expr.Parsetree.pexp_desc with | Parsetree.Pexp_let _ | Pexp_sequence _ @@ -3890,15 +3890,15 @@ end = struct | Pexp_letmodule _ | Pexp_open _ -> Nothing | _ -> - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - begin match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced(bracesLoc) + let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in + begin match opt_braces with + | Some ({Location.loc = braces_loc}, _) -> Braced(braces_loc) | None -> begin match expr with | {Parsetree.pexp_desc = Pexp_constant (Pconst_integer (x, _) | Pconst_float (x, _)); pexp_attributes = []} - when startsWithMinus x -> Parenthesized + when starts_with_minus x -> Parenthesized | {Parsetree.pexp_desc = Pexp_ident _ | Pexp_constant _ | Pexp_field _ | Pexp_construct _ | Pexp_variant _ | Pexp_array _ | Pexp_pack _ | Pexp_record _ | Pexp_extension _ | @@ -3914,7 +3914,7 @@ end = struct end end - let jsxChildExpr expr = + let jsx_child_expr expr = match expr.Parsetree.pexp_desc with | Parsetree.Pexp_let _ | Pexp_sequence _ @@ -3922,14 +3922,14 @@ end = struct | Pexp_letmodule _ | Pexp_open _ -> Nothing | _ -> - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - begin match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced(bracesLoc) + let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in + begin match opt_braces with + | Some ({Location.loc = braces_loc}, _) -> Braced(braces_loc) | _ -> begin match expr with | {Parsetree.pexp_desc = Pexp_constant (Pconst_integer (x, _) | Pconst_float (x, _)); pexp_attributes = [] - } when startsWithMinus x -> Parenthesized + } when starts_with_minus x -> Parenthesized | {Parsetree.pexp_desc = Pexp_ident _ | Pexp_constant _ | Pexp_field _ | Pexp_construct _ | Pexp_variant _ | Pexp_array _ | Pexp_pack _ | Pexp_record _ | Pexp_extension _ | @@ -3941,23 +3941,23 @@ end = struct {pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _} ); pexp_attributes = []} -> Nothing - | expr when ParsetreeViewer.isJsxExpression expr -> Nothing + | expr when ParsetreeViewer.is_jsx_expression expr -> Nothing | _ -> Parenthesized end end - let binaryExpr expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced(bracesLoc) + 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) | None -> begin match expr with | {Parsetree.pexp_attributes = _::_} as expr - when ParsetreeViewer.isBinaryExpression expr -> Parenthesized + when ParsetreeViewer.is_binary_expression expr -> Parenthesized | _ -> Nothing end - let modTypeFunctorReturn modType = match modType with + let mod_type_functor_return mod_type = match mod_type with | {Parsetree.pmty_desc = Pmty_with _} -> true | _ -> false @@ -3966,15 +3966,15 @@ end = struct This is actually: module type Functor = (SetLike => Set) with type t = A.t *) - let modTypeWithOperand modType = match modType with + let mod_type_with_operand mod_type = match mod_type with | {Parsetree.pmty_desc = Pmty_functor _} -> true | _ -> false - let modExprFunctorConstraint modType = match modType with + let mod_expr_functor_constraint mod_type = match mod_type with | {Parsetree.pmty_desc = Pmty_functor _ | Pmty_with _} -> true | _ -> false - let bracedExpr expr = match expr.Parsetree.pexp_desc with + let braced_expr expr = match expr.Parsetree.pexp_desc with | Pexp_constraint ( {pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _} @@ -3982,7 +3982,7 @@ end = struct | Pexp_constraint _ -> true | _ -> false - let includeModExpr modExpr = match modExpr.Parsetree.pmod_desc with + let include_mod_expr mod_expr = match mod_expr.Parsetree.pmod_desc with | Parsetree.Pmod_constraint _ -> true | _ -> false end @@ -4004,7 +4004,7 @@ module CommentTable = struct let log t = let open Location in - let leadingStuff = Hashtbl.fold (fun (k : Location.t) (v : Comment.t list) acc -> + let leading_stuff = Hashtbl.fold (fun (k : Location.t) (v : Comment.t list) acc -> let loc = Doc.concat [ Doc.lbracket; Doc.text (string_of_int k.loc_start.pos_lnum); @@ -4016,7 +4016,7 @@ module CommentTable = struct Doc.text (string_of_int (k.loc_end.pos_cnum - k.loc_end.pos_bol)); Doc.rbracket; ] in - let doc = Doc.breakableGroup ~forceBreak:true ( + let doc = Doc.breakable_group ~force_break:true ( Doc.concat [ loc; Doc.indent ( @@ -4031,7 +4031,7 @@ module CommentTable = struct doc::acc ) t.leading [] in - let trailingStuff = Hashtbl.fold (fun (k : Location.t) (v : Comment.t list) acc -> + let trailing_stuff = Hashtbl.fold (fun (k : Location.t) (v : Comment.t list) acc -> let loc = Doc.concat [ Doc.lbracket; Doc.text (string_of_int k.loc_start.pos_lnum); @@ -4043,7 +4043,7 @@ module CommentTable = struct Doc.text (string_of_int (k.loc_end.pos_cnum - k.loc_end.pos_bol)); Doc.rbracket; ] in - let doc = Doc.breakableGroup ~forceBreak:true ( + let doc = Doc.breakable_group ~force_break:true ( Doc.concat [ loc; Doc.indent ( @@ -4058,34 +4058,34 @@ module CommentTable = struct doc::acc ) t.trailing [] in - Doc.breakableGroup ~forceBreak:true ( + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.text "leading comments:"; Doc.line; - Doc.indent (Doc.concat leadingStuff); + Doc.indent (Doc.concat leading_stuff); Doc.line; Doc.line; Doc.text "trailing comments:"; - Doc.indent (Doc.concat trailingStuff); + Doc.indent (Doc.concat trailing_stuff); Doc.line; Doc.line; ] - ) |> Doc.toString ~width:80 |> print_endline + ) |> Doc.to_string ~width:80 |> print_endline [@@live] let attach tbl loc comments = match comments with | [] -> () | comments -> Hashtbl.replace tbl loc comments - let partitionByLoc comments loc = + let partition_by_loc comments loc = let rec loop (leading, inside, trailing) comments = let open Location in match comments with | comment::rest -> - let cmtLoc = Comment.loc comment in - if cmtLoc.loc_end.pos_cnum <= loc.loc_start.pos_cnum then + let cmt_loc = Comment.loc comment in + if cmt_loc.loc_end.pos_cnum <= loc.loc_start.pos_cnum then loop (comment::leading, inside, trailing) rest - else if cmtLoc.loc_start.pos_cnum >= loc.loc_end.pos_cnum then + else if cmt_loc.loc_start.pos_cnum >= loc.loc_end.pos_cnum then loop (leading, inside, comment::trailing) rest else loop (leading, comment::inside, trailing) rest @@ -4093,13 +4093,13 @@ module CommentTable = struct in loop ([], [], []) comments - let partitionLeadingTrailing comments loc = + let partition_leading_trailing comments loc = let rec loop (leading, trailing) comments = let open Location in match comments with | comment::rest -> - let cmtLoc = Comment.loc comment in - if cmtLoc.loc_end.pos_cnum <= loc.loc_start.pos_cnum then + let cmt_loc = Comment.loc comment in + if cmt_loc.loc_end.pos_cnum <= loc.loc_start.pos_cnum then loop (comment::leading, trailing) rest else loop (leading, comment::trailing) rest @@ -4107,78 +4107,78 @@ module CommentTable = struct in loop ([], []) comments - let partitionByOnSameLine loc comments = - let rec loop (onSameLine, onOtherLine) comments = + let partition_by_on_same_line loc comments = + let rec loop (on_same_line, on_other_line) comments = let open Location in match comments with - | [] -> (List.rev onSameLine, List.rev onOtherLine) + | [] -> (List.rev on_same_line, List.rev on_other_line) | comment::rest -> - let cmtLoc = Comment.loc comment in - if cmtLoc.loc_start.pos_lnum == loc.loc_end.pos_lnum then - loop (comment::onSameLine, onOtherLine) 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 (onSameLine, comment::onOtherLine) rest + loop (on_same_line, comment::on_other_line) rest in loop ([], []) comments - let partitionAdjacentTrailing loc1 comments = + let partition_adjacent_trailing loc1 comments = let open Location in let open Lexing in - let rec loop ~prevEndPos afterLoc1 comments = + let rec loop ~prev_end_pos after_loc1 comments = match comments with - | [] -> (List.rev afterLoc1, []) + | [] -> (List.rev after_loc1, []) | (comment::rest) as 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 + 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 afterLoc1, comments) + (List.rev after_loc1, comments) in - loop ~prevEndPos:loc1.loc_end [] comments + loop ~prev_end_pos:loc1.loc_end [] comments - let rec collectListPatterns acc pattern = + let rec collect_list_patterns acc pattern = let open Parsetree in match pattern.ppat_desc with | Ppat_construct( {txt = Longident.Lident "::"}, Some {ppat_desc=Ppat_tuple (pat::rest::[])} ) -> - collectListPatterns (pat::acc) rest + collect_list_patterns (pat::acc) rest | Ppat_construct ({txt = Longident.Lident "[]"}, None) -> List.rev acc | _ -> List.rev (pattern::acc) - let rec collectListExprs acc expr = + let rec collect_list_exprs acc expr = let open Parsetree in match expr.pexp_desc with | Pexp_construct( {txt = Longident.Lident "::"}, Some {pexp_desc=Pexp_tuple (expr::rest::[])} ) -> - collectListExprs (expr::acc) rest + collect_list_exprs (expr::acc) rest | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> List.rev acc | _ -> List.rev (expr::acc) (* TODO: use ParsetreeViewer *) - let arrowType ct = + let arrow_type ct = let open Parsetree in - let rec process attrsBefore acc typ = match typ with + let rec process attrs_before acc typ = match typ with | {ptyp_desc = Ptyp_arrow (Nolabel as lbl, typ1, typ2); ptyp_attributes = []} -> let arg = ([], lbl, typ1) in - process attrsBefore (arg::acc) typ2 + process attrs_before (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 attrsBefore (arg::acc) typ2 - | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = _attrs} as returnType -> + process attrs_before (arg::acc) typ2 + | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = _attrs} as return_type -> let args = List.rev acc in - (attrsBefore, args, returnType) + (attrs_before, args, return_type) | {ptyp_desc = Ptyp_arrow ((Labelled _ | Optional _) as lbl, typ1, typ2); ptyp_attributes = attrs} -> let arg = (attrs, lbl, typ1) in - process attrsBefore (arg::acc) typ2 + process attrs_before (arg::acc) typ2 | typ -> - (attrsBefore, List.rev acc, typ) + (attrs_before, List.rev acc, typ) in begin match ct with | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as typ -> @@ -4187,49 +4187,49 @@ module CommentTable = struct end (* TODO: avoiding the dependency on ParsetreeViewer here, is this a good idea? *) - let modExprApply modExpr = - let rec loop acc modExpr = match modExpr with + let mod_expr_apply mod_expr = + let rec loop acc mod_expr = match mod_expr with | {Parsetree.pmod_desc = Pmod_apply (next, arg)} -> loop (arg::acc) next - | _ -> (modExpr::acc) + | _ -> (mod_expr::acc) in - loop [] modExpr + loop [] mod_expr (* TODO: avoiding the dependency on ParsetreeViewer here, is this a good idea? *) - let modExprFunctor modExpr = - let rec loop acc modExpr = match modExpr with - | {Parsetree.pmod_desc = Pmod_functor (lbl, modType, returnModExpr); pmod_attributes = attrs} -> - let param = (attrs, lbl, modType) in - loop (param::acc) returnModExpr - | returnModExpr -> - (List.rev acc, returnModExpr) + let mod_expr_functor mod_expr = + let rec loop acc mod_expr = match mod_expr with + | {Parsetree.pmod_desc = Pmod_functor (lbl, mod_type, return_mod_expr); 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) in - loop [] modExpr + loop [] mod_expr - let functorType modtype = + let functor_type modtype = let rec process acc modtype = match modtype with - | {Parsetree.pmty_desc = Pmty_functor (lbl, argType, returnType); pmty_attributes = attrs} -> - let arg = (attrs, lbl, argType) in - process (arg::acc) returnType - | modType -> - (List.rev acc, modType) + | {Parsetree.pmty_desc = Pmty_functor (lbl, arg_type, return_type); pmty_attributes = attrs} -> + let arg = (attrs, lbl, arg_type) in + process (arg::acc) return_type + | mod_type -> + (List.rev acc, mod_type) in process [] modtype - let funExpr expr = + let fun_expr expr = let open Parsetree in (* Turns (type t, type u, type z) into "type t u z" *) - let rec collectNewTypes acc returnExpr = - match returnExpr with - | {pexp_desc = Pexp_newtype (stringLoc, returnExpr); pexp_attributes = []} -> - collectNewTypes (stringLoc::acc) returnExpr - | returnExpr -> + let rec collect_new_types acc return_expr = + match return_expr with + | {pexp_desc = Pexp_newtype (string_loc, return_expr); pexp_attributes = []} -> + collect_new_types (string_loc::acc) return_expr + | return_expr -> let loc = match (acc, List.rev acc) with - | (_startLoc::_, endLoc::_) -> { endLoc.loc with loc_end = endLoc.loc.loc_end } + | (_startLoc::_, end_loc::_) -> { end_loc.loc with loc_end = end_loc.loc.loc_end } | _ -> Location.none in let txt = List.fold_right (fun curr acc -> acc ^ " " ^ curr.Location.txt) acc "type" in - (Location.mkloc txt loc, returnExpr) + (Location.mkloc txt loc, return_expr) in (* For simplicity reason Pexp_newtype gets converted to a Nolabel parameter, * otherwise this function would need to return a variant: @@ -4237,30 +4237,30 @@ module CommentTable = struct * | 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 attrsBefore acc expr = match expr with - | {pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); pexp_attributes = []} -> - 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 rec collect attrs_before acc expr = match expr with + | {pexp_desc = Pexp_fun (lbl, default_expr, pattern, return_expr); 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 = ( attrs, Asttypes.Nolabel, None, - Ast_helper.Pat.var ~loc:stringLoc.loc var + Ast_helper.Pat.var ~loc:string_loc.loc var ) in - collect attrsBefore (parameter::acc) returnExpr - | {pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); pexp_attributes = [({txt = "bs"}, _)] as attrs} -> - let parameter = (attrs, lbl, defaultExpr, pattern) in - collect attrsBefore (parameter::acc) returnExpr + collect attrs_before (parameter::acc) return_expr + | {pexp_desc = Pexp_fun (lbl, default_expr, pattern, return_expr); pexp_attributes = [({txt = "bs"}, _)] as attrs} -> + let parameter = (attrs, lbl, default_expr, pattern) in + collect attrs_before (parameter::acc) return_expr | { - pexp_desc = Pexp_fun ((Labelled _ | Optional _) as lbl, defaultExpr, pattern, returnExpr); + pexp_desc = Pexp_fun ((Labelled _ | Optional _) as lbl, default_expr, pattern, return_expr); pexp_attributes = attrs } -> - let parameter = (attrs, lbl, defaultExpr, pattern) in - collect attrsBefore (parameter::acc) returnExpr + let parameter = (attrs, lbl, default_expr, pattern) in + collect attrs_before (parameter::acc) return_expr | expr -> - (attrsBefore, List.rev acc, expr) + (attrs_before, List.rev acc, expr) in begin match expr with | {pexp_desc = Pexp_fun (Nolabel, _defaultExpr, _pattern, _returnExpr); pexp_attributes = attrs} as expr -> @@ -4268,7 +4268,7 @@ module CommentTable = struct | expr -> collect [] [] expr end - let rec isBlockExpr expr = + let rec is_block_expr expr = let open Parsetree in match expr.pexp_desc with | Pexp_letmodule _ @@ -4276,333 +4276,333 @@ module CommentTable = struct | Pexp_let _ | Pexp_open _ | Pexp_sequence _ -> 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 + | 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 | _ -> false - let rec walkStructure s t comments = + let rec walk_structure s t comments = match s with | _ when comments = [] -> () | [] -> attach t.inside Location.none comments | s -> - walkList - ~getLoc:(fun n -> n.Parsetree.pstr_loc) - ~walkNode:walkStructureItem + walk_list + ~get_loc:(fun n -> n.Parsetree.pstr_loc) + ~walk_node:walk_structure_item s t comments - and walkStructureItem si t comments = + and walk_structure_item si t comments = match si.Parsetree.pstr_desc with | _ when comments = [] -> () - | 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_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, _) -> - walkExpr expr t comments - | Pstr_module moduleBinding -> - walkModuleBinding moduleBinding t comments - | Pstr_recmodule moduleBindings -> - walkList - ~getLoc:(fun mb -> mb.Parsetree.pmb_loc) - ~walkNode:walkModuleBinding - moduleBindings + walk_expr expr t comments + | Pstr_module module_binding -> + walk_module_binding module_binding t comments + | Pstr_recmodule module_bindings -> + walk_list + ~get_loc:(fun mb -> mb.Parsetree.pmb_loc) + ~walk_node:walk_module_binding + module_bindings t comments - | Pstr_modtype modTypDecl -> - walkModuleTypeDeclaration modTypDecl t comments + | Pstr_modtype mod_typ_decl -> + walk_module_type_declaration mod_typ_decl t comments | Pstr_attribute attribute -> - walkAttribute attribute t comments + walk_attribute attribute t comments | Pstr_extension (extension, _) -> - walkExtension extension t comments - | Pstr_include includeDeclaration -> - walkIncludeDeclaration includeDeclaration t comments - | Pstr_exception extensionConstructor -> - walkExtConstr extensionConstructor t comments - | Pstr_typext typeExtension -> - walkTypeExtension typeExtension t comments + walk_extension extension t comments + | Pstr_include include_declaration -> + walk_include_declaration include_declaration t comments + | Pstr_exception extension_constructor -> + walk_ext_constr extension_constructor t comments + | Pstr_typext type_extension -> + walk_type_extension type_extension t comments | Pstr_class_type _ | Pstr_class _ -> () - and walkValueDescription vd t comments = + and walk_value_description vd t comments = let (leading, trailing) = - partitionLeadingTrailing comments vd.pval_name.loc in + partition_leading_trailing comments vd.pval_name.loc in attach t.leading vd.pval_name.loc leading; - let (afterName, rest) = - partitionAdjacentTrailing vd.pval_name.loc trailing in - attach t.trailing vd.pval_name.loc afterName; + 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) = - partitionByLoc rest vd.pval_type.ptyp_loc + partition_by_loc rest vd.pval_type.ptyp_loc in attach t.leading vd.pval_type.ptyp_loc before; - walkTypExpr vd.pval_type t inside; + walk_typ_expr vd.pval_type t inside; attach t.trailing vd.pval_type.ptyp_loc after - and walkTypeExtension te t comments = + and walk_type_extension te t comments = let (leading, trailing) = - partitionLeadingTrailing comments te.ptyext_path.loc in + partition_leading_trailing comments te.ptyext_path.loc in attach t.leading te.ptyext_path.loc leading; - let (afterPath, rest) = - partitionAdjacentTrailing te.ptyext_path.loc trailing in - attach t.trailing te.ptyext_path.loc afterPath; + let (after_path, rest) = + partition_adjacent_trailing te.ptyext_path.loc trailing in + attach t.trailing te.ptyext_path.loc after_path; (* type params *) let rest = match te.ptyext_params with | [] -> rest - | typeParams -> - visitListButContinueWithRemainingComments - ~getLoc:(fun (typexpr, _variance) -> typexpr.Parsetree.ptyp_loc) - ~walkNode:walkTypeParam - ~newlineDelimited:false - typeParams + | 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 in - walkList - ~getLoc:(fun n -> n.Parsetree.pext_loc) - ~walkNode:walkExtConstr + walk_list + ~get_loc:(fun n -> n.Parsetree.pext_loc) + ~walk_node:walk_ext_constr te.ptyext_constructors t rest - and walkIncludeDeclaration inclDecl t comments = + and walk_include_declaration incl_decl t comments = let (before, inside, after) = - partitionByLoc comments inclDecl.pincl_mod.pmod_loc in - attach t.leading inclDecl.pincl_mod.pmod_loc before; - walkModExpr inclDecl.pincl_mod t inside; - attach t.trailing inclDecl.pincl_mod.pmod_loc after + partition_by_loc comments incl_decl.pincl_mod.pmod_loc in + attach t.leading incl_decl.pincl_mod.pmod_loc before; + walk_mod_expr incl_decl.pincl_mod t inside; + attach t.trailing incl_decl.pincl_mod.pmod_loc after - and walkModuleTypeDeclaration mtd t comments = + and walk_module_type_declaration mtd t comments = let (leading, trailing) = - partitionLeadingTrailing comments mtd.pmtd_name.loc in + partition_leading_trailing comments mtd.pmtd_name.loc in attach t.leading mtd.pmtd_name.loc leading; begin match mtd.pmtd_type with | None -> attach t.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 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 + | Some mod_type -> + let (after_name, rest) = partition_adjacent_trailing 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 end - and walkModuleBinding mb t comments = - let (leading, trailing) = partitionLeadingTrailing comments mb.pmb_name.loc in + and walk_module_binding mb t comments = + let (leading, trailing) = partition_leading_trailing comments mb.pmb_name.loc in attach t.leading mb.pmb_name.loc leading; - 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 + 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 begin match mb.pmb_expr.pmod_desc with | Pmod_constraint _ -> - walkModExpr mb.pmb_expr t (List.concat [leading; inside]); + walk_mod_expr mb.pmb_expr t (List.concat [leading; inside]); | _ -> attach t.leading mb.pmb_expr.pmod_loc leading; - walkModExpr mb.pmb_expr t inside; + walk_mod_expr mb.pmb_expr t inside; end; attach t.trailing mb.pmb_expr.pmod_loc trailing - and walkSignature signature t comments = + and walk_signature signature t comments = match signature with | _ when comments = [] -> () | [] -> attach t.inside Location.none comments | _s -> - walkList - ~getLoc:(fun n -> n.Parsetree.psig_loc) - ~walkNode:walkSignatureItem + walk_list + ~get_loc:(fun n -> n.Parsetree.psig_loc) + ~walk_node:walk_signature_item signature t comments - and walkSignatureItem si t comments = + and walk_signature_item si t comments = match si.psig_desc with | _ when comments = [] -> () - | Psig_value valueDescription -> - walkValueDescription valueDescription t comments - | Psig_type (_, typeDeclarations) -> - walkTypeDeclarations typeDeclarations t comments - | Psig_typext typeExtension -> - walkTypeExtension typeExtension t comments - | Psig_exception extensionConstructor -> - walkExtConstr extensionConstructor t comments - | Psig_module moduleDeclaration -> - walkModuleDeclaration moduleDeclaration t comments - | Psig_recmodule moduleDeclarations -> - walkList - ~getLoc:(fun n -> n.Parsetree.pmd_loc) - ~walkNode:walkModuleDeclaration - moduleDeclarations + | 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_ext_constr extension_constructor t comments + | Psig_module module_declaration -> + walk_module_declaration module_declaration t comments + | Psig_recmodule module_declarations -> + walk_list + ~get_loc:(fun n -> n.Parsetree.pmd_loc) + ~walk_node:walk_module_declaration + module_declarations t comments - | Psig_modtype moduleTypeDeclaration -> - walkModuleTypeDeclaration moduleTypeDeclaration t comments - | Psig_open openDescription -> - walkOpenDescription openDescription t comments - | Psig_include includeDescription -> - walkIncludeDescription includeDescription 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 -> - walkAttribute attribute t comments + walk_attribute attribute t comments | Psig_extension (extension, _) -> - walkExtension extension t comments + walk_extension extension t comments | Psig_class _ | Psig_class_type _ -> () - and walkIncludeDescription id t comments = + and walk_include_description id t comments = let (before, inside, after) = - partitionByLoc comments id.pincl_mod.pmty_loc in + partition_by_loc comments id.pincl_mod.pmty_loc in attach t.leading id.pincl_mod.pmty_loc before; - walkModType id.pincl_mod t inside; + walk_mod_type id.pincl_mod t inside; attach t.trailing id.pincl_mod.pmty_loc after - and walkModuleDeclaration md t comments = - let (leading, trailing) = partitionLeadingTrailing comments md.pmd_name.loc in + and walk_module_declaration md t comments = + let (leading, trailing) = partition_leading_trailing comments md.pmd_name.loc in attach t.leading md.pmd_name.loc leading; - 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 + 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 attach t.leading md.pmd_type.pmty_loc leading; - walkModType md.pmd_type t inside; + walk_mod_type md.pmd_type t inside; attach t.trailing md.pmd_type.pmty_loc trailing - and walkList: + and walk_list: 'node. - ?prevLoc:Location.t -> - getLoc:('node -> Location.t) -> - walkNode:('node -> t -> Comment.t list -> unit) -> + ?prev_loc:Location.t -> + get_loc:('node -> Location.t) -> + walk_node:('node -> t -> Comment.t list -> unit) -> 'node list -> t -> Comment.t list -> unit - = fun ?prevLoc ~getLoc ~walkNode l t comments -> + = fun ?prev_loc ~get_loc ~walk_node l t comments -> let open Location in match l with | _ when comments = [] -> () | [] -> - begin match prevLoc with + begin match prev_loc with | Some loc -> attach t.trailing loc comments | None -> () end | node::rest -> - let currLoc = getLoc node in - let (leading, inside, trailing) = partitionByLoc comments currLoc in - begin match prevLoc with + let curr_loc = get_loc node in + let (leading, inside, trailing) = partition_by_loc comments curr_loc in + begin match prev_loc with | None -> (* first node, all leading comments attach here *) - attach t.leading currLoc leading - | Some prevLoc -> + attach t.leading curr_loc leading + | Some prev_loc -> (* Same line *) - if prevLoc.loc_end.pos_lnum == currLoc.loc_start.pos_lnum then - let (afterPrev, beforeCurr) = partitionAdjacentTrailing prevLoc leading in - let () = attach t.trailing prevLoc afterPrev in - attach t.leading currLoc beforeCurr + 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 + let () = attach t.trailing prev_loc after_prev in + attach t.leading curr_loc before_curr else - let (onSameLineAsPrev, afterPrev) = partitionByOnSameLine prevLoc leading in - let () = attach t.trailing prevLoc onSameLineAsPrev in - let (leading, _inside, _trailing) = partitionByLoc afterPrev currLoc in - attach t.leading currLoc leading + 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 in + attach t.leading curr_loc leading end; - walkNode node t inside; - walkList ~prevLoc:currLoc ~getLoc ~walkNode rest t trailing + walk_node node t inside; + walk_list ~prev_loc:curr_loc ~get_loc ~walk_node 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 visitListButContinueWithRemainingComments: + and visit_list_but_continue_with_remaining_comments: 'node. - ?prevLoc:Location.t -> - newlineDelimited:bool -> - getLoc:('node -> Location.t) -> - walkNode:('node -> t -> Comment.t list -> unit) -> + ?prev_loc:Location.t -> + newline_delimited:bool -> + get_loc:('node -> Location.t) -> + walk_node:('node -> t -> Comment.t list -> unit) -> 'node list -> t -> Comment.t list -> Comment.t list - = fun ?prevLoc ~newlineDelimited ~getLoc ~walkNode l t comments -> + = fun ?prev_loc ~newline_delimited ~get_loc ~walk_node l t comments -> let open Location in match l with | _ when comments = [] -> [] | [] -> - begin match prevLoc with + begin match prev_loc with | Some loc -> - let (afterPrev, rest) = - if newlineDelimited then - partitionByOnSameLine loc comments + let (after_prev, rest) = + if newline_delimited then + partition_by_on_same_line loc comments else - partitionAdjacentTrailing loc comments + partition_adjacent_trailing loc comments in - attach t.trailing loc afterPrev; + attach t.trailing loc after_prev; rest | None -> comments end | node::rest -> - let currLoc = getLoc node in - let (leading, inside, trailing) = partitionByLoc comments currLoc in - let () = match prevLoc with + let curr_loc = get_loc node in + let (leading, inside, trailing) = partition_by_loc comments curr_loc in + let () = match prev_loc with | None -> (* first node, all leading comments attach here *) - attach t.leading currLoc leading; + attach t.leading curr_loc leading; () - | Some prevLoc -> + | Some prev_loc -> (* Same line *) - if prevLoc.loc_end.pos_lnum == currLoc.loc_start.pos_lnum then - let (afterPrev, beforeCurr) = partitionAdjacentTrailing prevLoc leading in - let () = attach t.trailing prevLoc afterPrev in - let () = attach t.leading currLoc beforeCurr in + 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 + let () = attach t.trailing prev_loc after_prev in + let () = attach t.leading curr_loc before_curr in () else - let (onSameLineAsPrev, afterPrev) = partitionByOnSameLine prevLoc leading in - let () = attach t.trailing prevLoc onSameLineAsPrev in - let (leading, _inside, _trailing) = partitionByLoc afterPrev currLoc in - let () = attach t.leading currLoc leading in + 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 in + let () = attach t.leading curr_loc leading in () in - walkNode node t inside; - visitListButContinueWithRemainingComments - ~prevLoc:currLoc ~getLoc ~walkNode ~newlineDelimited + 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 - and walkValueBindings vbs t comments = - walkList - ~getLoc:(fun n -> n.Parsetree.pvb_loc) - ~walkNode:walkValueBinding + and walk_value_bindings vbs t comments = + walk_list + ~get_loc:(fun n -> n.Parsetree.pvb_loc) + ~walk_node:walk_value_binding vbs t comments - and walkOpenDescription openDescription t comments = - let loc = openDescription.popen_lid.loc in - let (leading, trailing) = partitionLeadingTrailing comments loc in + 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 attach t.leading loc leading; attach t.trailing loc trailing; - and walkTypeDeclarations typeDeclarations t comments = - walkList - ~getLoc:(fun n -> n.Parsetree.ptype_loc) - ~walkNode:walkTypeDeclaration - typeDeclarations + and walk_type_declarations type_declarations t comments = + walk_list + ~get_loc:(fun n -> n.Parsetree.ptype_loc) + ~walk_node:walk_type_declaration + type_declarations t comments - and walkTypeParam (typexpr, _variance) t comments = - walkTypExpr typexpr t comments + and walk_type_param (typexpr, _variance) t comments = + walk_typ_expr typexpr t comments - and walkTypeDeclaration td t comments = - let (beforeName, rest) = - partitionLeadingTrailing comments td.ptype_name.loc in - attach t.leading td.ptype_name.loc beforeName; + and walk_type_declaration td t comments = + let (before_name, rest) = + partition_leading_trailing comments td.ptype_name.loc in + attach t.leading td.ptype_name.loc before_name; - let (afterName, rest) = - partitionAdjacentTrailing td.ptype_name.loc rest in - attach t.trailing td.ptype_name.loc afterName; + let (after_name, rest) = + partition_adjacent_trailing td.ptype_name.loc rest in + attach t.trailing td.ptype_name.loc after_name; (* type params *) let rest = match td.ptype_params with | [] -> rest - | typeParams -> - visitListButContinueWithRemainingComments - ~getLoc:(fun (typexpr, _variance) -> typexpr.Parsetree.ptyp_loc) - ~walkNode:walkTypeParam - ~newlineDelimited:false - typeParams + | 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 in @@ -4610,100 +4610,100 @@ module CommentTable = struct (* manifest: = typexpr *) let rest = match td.ptype_manifest with | Some typexpr -> - let (beforeTyp, insideTyp, afterTyp) = - partitionByLoc rest typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc beforeTyp; - walkTypExpr typexpr t insideTyp; - let (afterTyp, rest) = - partitionAdjacentTrailing typexpr.Parsetree.ptyp_loc afterTyp in - attach t.trailing typexpr.ptyp_loc afterTyp; + let (before_typ, inside_typ, after_typ) = + partition_by_loc rest typexpr.ptyp_loc in + attach t.leading typexpr.ptyp_loc before_typ; + walk_typ_expr typexpr t inside_typ; + let (after_typ, rest) = + partition_adjacent_trailing typexpr.Parsetree.ptyp_loc after_typ in + attach t.trailing typexpr.ptyp_loc after_typ; rest | None -> rest in let rest = match td.ptype_kind with | Ptype_abstract | Ptype_open -> rest - | Ptype_record labelDeclarations -> - let () = walkList - ~getLoc:(fun ld -> ld.Parsetree.pld_loc) - ~walkNode:walkLabelDeclaration - labelDeclarations + | Ptype_record label_declarations -> + let () = walk_list + ~get_loc:(fun ld -> ld.Parsetree.pld_loc) + ~walk_node:walk_label_declaration + label_declarations t rest in [] - | Ptype_variant constructorDeclarations -> - walkConstructorDeclarations constructorDeclarations t rest + | Ptype_variant constructor_declarations -> + walk_constructor_declarations constructor_declarations t rest in attach t.trailing td.ptype_loc rest - and walkLabelDeclarations lds t comments = - visitListButContinueWithRemainingComments - ~getLoc:(fun ld -> ld.Parsetree.pld_loc) - ~walkNode:walkLabelDeclaration - ~newlineDelimited:false + 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 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 beforeTyp; - walkTypExpr 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 + 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 in + attach t.leading ld.pld_type.ptyp_loc before_typ; + walk_typ_expr 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 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 + 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 let rest = match cd.pcd_res with | Some typexpr -> - let (beforeTyp, insideTyp, afterTyp) = - partitionByLoc rest typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc beforeTyp; - walkTypExpr typexpr t insideTyp; - let (afterTyp, rest) = - partitionAdjacentTrailing typexpr.Parsetree.ptyp_loc afterTyp in - attach t.trailing typexpr.ptyp_loc afterTyp; + let (before_typ, inside_typ, after_typ) = + partition_by_loc rest typexpr.ptyp_loc in + attach t.leading typexpr.ptyp_loc before_typ; + walk_typ_expr typexpr t inside_typ; + let (after_typ, rest) = + partition_adjacent_trailing typexpr.Parsetree.ptyp_loc after_typ in + attach t.trailing typexpr.ptyp_loc after_typ; rest | None -> rest in attach t.trailing cd.pcd_loc rest - and walkConstructorArguments args t comments = + and walk_constructor_arguments args t comments = match args with | Pcstr_tuple typexprs -> - visitListButContinueWithRemainingComments - ~getLoc:(fun n -> n.Parsetree.ptyp_loc) - ~walkNode:walkTypExpr - ~newlineDelimited:false + visit_list_but_continue_with_remaining_comments + ~get_loc:(fun n -> n.Parsetree.ptyp_loc) + ~walk_node:walk_typ_expr + ~newline_delimited:false typexprs t comments - | Pcstr_record labelDeclarations -> - walkLabelDeclarations labelDeclarations t comments + | Pcstr_record label_declarations -> + walk_label_declarations label_declarations t comments - and walkValueBinding vb t comments = + and walk_value_binding vb t comments = let open Location in let vb = @@ -4723,108 +4723,108 @@ module CommentTable = struct ppat_loc = {pat.ppat_loc with loc_end = t.ptyp_loc.loc_end}}} | _ -> vb in - let patternLoc = vb.Parsetree.pvb_pat.ppat_loc in - let exprLoc = vb.Parsetree.pvb_expr.pexp_loc in + let pattern_loc = vb.Parsetree.pvb_pat.ppat_loc in + let expr_loc = vb.Parsetree.pvb_expr.pexp_loc in let (leading, inside, trailing) = - partitionByLoc comments patternLoc in + partition_by_loc comments pattern_loc in (* everything before start of pattern can only be leading on the pattern: * let |* before *| a = 1 *) - attach t.leading patternLoc leading; - walkPattern vb.Parsetree.pvb_pat t inside; + attach t.leading pattern_loc leading; + walk_pattern vb.Parsetree.pvb_pat t inside; (* let pattern = expr -> pattern and expr on the same line *) (* if patternLoc.loc_end.pos_lnum == exprLoc.loc_start.pos_lnum then ( *) - let (afterPat, surroundingExpr) = - partitionAdjacentTrailing patternLoc trailing + let (after_pat, surrounding_expr) = + partition_adjacent_trailing pattern_loc trailing in - attach t.trailing patternLoc afterPat; - let (beforeExpr, insideExpr, afterExpr) = - partitionByLoc surroundingExpr exprLoc in - if isBlockExpr vb.pvb_expr then ( - walkExpr vb.pvb_expr t (List.concat [beforeExpr; insideExpr; afterExpr]) + attach t.trailing pattern_loc after_pat; + let (before_expr, inside_expr, after_expr) = + partition_by_loc surrounding_expr expr_loc in + if is_block_expr vb.pvb_expr then ( + walk_expr vb.pvb_expr t (List.concat [before_expr; inside_expr; after_expr]) ) else ( - attach t.leading exprLoc beforeExpr; - walkExpr vb.Parsetree.pvb_expr t insideExpr; - attach t.trailing exprLoc afterExpr + attach t.leading expr_loc before_expr; + walk_expr vb.Parsetree.pvb_expr t inside_expr; + attach t.trailing expr_loc after_expr ) - and walkExpr expr t comments = + and walk_expr expr t comments = let open Location in match expr.Parsetree.pexp_desc with | _ when comments = [] -> () | Pexp_constant _ -> let (leading, trailing) = - partitionLeadingTrailing comments expr.pexp_loc in + partition_leading_trailing 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) = - partitionLeadingTrailing comments longident.loc in + partition_leading_trailing comments longident.loc in attach t.leading longident.loc leading; attach t.trailing longident.loc trailing; - | Pexp_let (_recFlag, valueBindings, expr2) -> - let comments = visitListButContinueWithRemainingComments - ~getLoc:(fun n -> + | Pexp_let (_recFlag, value_bindings, expr2) -> + let comments = visit_list_but_continue_with_remaining_comments + ~get_loc:(fun n -> if n.Parsetree.pvb_pat.ppat_loc.loc_ghost then n.pvb_expr.pexp_loc else n.Parsetree.pvb_loc ) - ~walkNode:walkValueBinding - ~newlineDelimited:true - valueBindings + ~walk_node:walk_value_binding + ~newline_delimited:true + value_bindings t comments in - if isBlockExpr expr2 then ( - walkExpr expr2 t comments; + if is_block_expr expr2 then ( + walk_expr expr2 t comments; ) else ( - let (leading, inside, trailing) = partitionByLoc comments expr2.pexp_loc in + let (leading, inside, trailing) = partition_by_loc comments expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpr expr2 t inside; + walk_expr expr2 t inside; attach t.trailing expr2.pexp_loc trailing ) | Pexp_sequence (expr1, expr2) -> - let (leading, inside, trailing) = partitionByLoc comments expr1.pexp_loc in - let comments = if isBlockExpr expr1 then ( - let (afterExpr, comments) = partitionByOnSameLine expr1.pexp_loc trailing in - walkExpr expr1 t (List.concat [leading; inside; afterExpr]); + let (leading, inside, trailing) = partition_by_loc 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 in + walk_expr expr1 t (List.concat [leading; inside; after_expr]); comments ) else ( attach t.leading expr1.pexp_loc leading; - walkExpr expr1 t inside; - let (afterExpr, comments) = partitionByOnSameLine expr1.pexp_loc trailing in - attach t.trailing expr1.pexp_loc afterExpr; + walk_expr expr1 t inside; + let (after_expr, comments) = partition_by_on_same_line expr1.pexp_loc trailing in + attach t.trailing expr1.pexp_loc after_expr; comments ) in - if isBlockExpr expr2 then ( - walkExpr expr2 t comments + if is_block_expr expr2 then ( + walk_expr expr2 t comments ) else ( - let (leading, inside, trailing) = partitionByLoc comments expr2.pexp_loc in + let (leading, inside, trailing) = partition_by_loc comments expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpr expr2 t inside; + walk_expr expr2 t inside; attach t.trailing expr2.pexp_loc trailing ) | Pexp_open (_override, longident, expr2) -> let (leading, comments) = - partitionLeadingTrailing comments expr.pexp_loc in + partition_leading_trailing comments expr.pexp_loc in attach t.leading {expr.pexp_loc with loc_end = longident.loc.loc_end} leading; let (leading, trailing) = - partitionLeadingTrailing comments longident.loc in + partition_leading_trailing comments longident.loc in attach t.leading longident.loc leading; - let (afterLongident, rest) = - partitionByOnSameLine longident.loc trailing in - attach t.trailing longident.loc afterLongident; - if isBlockExpr expr2 then ( - walkExpr expr2 t rest + 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_expr expr2 t rest ) else ( - let (leading, inside, trailing) = partitionByLoc rest expr2.pexp_loc in + let (leading, inside, trailing) = partition_by_loc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpr expr2 t inside; + walk_expr expr2 t inside; attach t.trailing expr2.pexp_loc trailing ) | Pexp_extension ( @@ -4833,312 +4833,312 @@ module CommentTable = struct pstr_desc = Pstr_eval({pexp_desc = Pexp_record (rows, _)}, []) }] ) -> - walkList - ~getLoc:(fun ( + walk_list + ~get_loc:(fun ( (longident, expr): (Longident.t Asttypes.loc * Parsetree.expression) ) -> { longident.loc with loc_end = expr.pexp_loc.loc_end }) - ~walkNode:walkExprRecordRow + ~walk_node:walk_expr_record_row rows t comments | Pexp_extension extension -> - walkExtension extension t comments - | Pexp_letexception (extensionConstructor, expr2) -> + walk_extension extension t comments + | Pexp_letexception (extension_constructor, expr2) -> let (leading, comments) = - partitionLeadingTrailing comments expr.pexp_loc in + partition_leading_trailing comments expr.pexp_loc in attach t.leading - {expr.pexp_loc with loc_end = extensionConstructor.pext_loc.loc_end} + {expr.pexp_loc with loc_end = extension_constructor.pext_loc.loc_end} leading; let (leading, inside, trailing) = - partitionByLoc comments extensionConstructor.pext_loc in - attach t.leading extensionConstructor.pext_loc leading; - walkExtConstr extensionConstructor t inside; - let (afterExtConstr, rest) = - partitionByOnSameLine extensionConstructor.pext_loc trailing in - attach t.trailing extensionConstructor.pext_loc afterExtConstr; - if isBlockExpr expr2 then ( - walkExpr expr2 t rest + partition_by_loc comments extension_constructor.pext_loc in + attach t.leading extension_constructor.pext_loc leading; + walk_ext_constr extension_constructor t inside; + let (after_ext_constr, rest) = + partition_by_on_same_line extension_constructor.pext_loc trailing in + attach t.trailing extension_constructor.pext_loc after_ext_constr; + if is_block_expr expr2 then ( + walk_expr expr2 t rest ) else ( - let (leading, inside, trailing) = partitionByLoc rest expr2.pexp_loc in + let (leading, inside, trailing) = partition_by_loc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpr expr2 t inside; + walk_expr expr2 t inside; attach t.trailing expr2.pexp_loc trailing ) - | Pexp_letmodule (stringLoc, modExpr, expr2) -> + | Pexp_letmodule (string_loc, mod_expr, expr2) -> let (leading, comments) = - partitionLeadingTrailing comments expr.pexp_loc in - attach t.leading {expr.pexp_loc with loc_end = modExpr.pmod_loc.loc_end} leading; - 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 modExpr.pmod_loc beforeModExpr; - walkModExpr modExpr t insideModExpr; - let (afterModExpr, rest) = - partitionByOnSameLine modExpr.pmod_loc afterModExpr in - attach t.trailing modExpr.pmod_loc afterModExpr; - if isBlockExpr expr2 then ( - walkExpr expr2 t rest; + partition_leading_trailing comments expr.pexp_loc in + attach t.leading {expr.pexp_loc with loc_end = mod_expr.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 in + attach t.leading mod_expr.pmod_loc before_mod_expr; + walk_mod_expr mod_expr t inside_mod_expr; + let (after_mod_expr, rest) = + partition_by_on_same_line mod_expr.pmod_loc after_mod_expr in + attach t.trailing mod_expr.pmod_loc after_mod_expr; + if is_block_expr expr2 then ( + walk_expr expr2 t rest; ) else ( - let (leading, inside, trailing) = partitionByLoc rest expr2.pexp_loc in + let (leading, inside, trailing) = partition_by_loc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpr expr2 t inside; + walk_expr expr2 t inside; attach t.trailing expr2.pexp_loc trailing ) | Pexp_assert expr | Pexp_lazy expr -> - if isBlockExpr expr then ( - walkExpr expr t comments + if is_block_expr expr then ( + walk_expr expr t comments ) else ( - let (leading, inside, trailing) = partitionByLoc comments expr.pexp_loc in + let (leading, inside, trailing) = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpr expr t inside; + walk_expr expr t inside; attach t.trailing expr.pexp_loc trailing ) - | Pexp_coerce (expr, optTypexpr, typexpr) -> - let (leading, inside, trailing) = partitionByLoc comments expr.pexp_loc in + | Pexp_coerce (expr, opt_typexpr, typexpr) -> + let (leading, inside, trailing) = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpr expr t inside; - let (afterExpr, rest) = - partitionAdjacentTrailing expr.pexp_loc trailing in - attach t.trailing expr.pexp_loc afterExpr; - let rest = match optTypexpr with + walk_expr expr t inside; + let (after_expr, rest) = + partition_adjacent_trailing expr.pexp_loc trailing in + attach t.trailing expr.pexp_loc after_expr; + let rest = match opt_typexpr with | Some typexpr -> - let (leading, inside, trailing) = partitionByLoc comments typexpr.ptyp_loc in + let (leading, inside, trailing) = partition_by_loc comments typexpr.ptyp_loc in attach t.leading typexpr.ptyp_loc leading; - walkTypExpr typexpr t inside; - let (afterTyp, rest) = - partitionAdjacentTrailing typexpr.ptyp_loc trailing in - attach t.trailing typexpr.ptyp_loc afterTyp; + walk_typ_expr typexpr t inside; + let (after_typ, rest) = + partition_adjacent_trailing typexpr.ptyp_loc trailing in + attach t.trailing typexpr.ptyp_loc after_typ; rest | None -> rest in - let (leading, inside, trailing) = partitionByLoc rest typexpr.ptyp_loc in + let (leading, inside, trailing) = partition_by_loc rest typexpr.ptyp_loc in attach t.leading typexpr.ptyp_loc leading; - walkTypExpr typexpr t inside; + walk_typ_expr typexpr t inside; attach t.trailing typexpr.ptyp_loc trailing | Pexp_constraint (expr, typexpr) -> - let (leading, inside, trailing) = partitionByLoc comments expr.pexp_loc in + let (leading, inside, trailing) = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpr 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 + walk_expr 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 attach t.leading typexpr.ptyp_loc leading; - walkTypExpr typexpr t inside; + walk_typ_expr 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 "::"}, _) -> - walkList - ~getLoc:(fun n -> n.Parsetree.pexp_loc) - ~walkNode:walkExpr - (collectListExprs [] expr) + walk_list + ~get_loc:(fun n -> n.Parsetree.pexp_loc) + ~walk_node:walk_expr + (collect_list_exprs [] expr) t comments | Pexp_construct (longident, args) -> let (leading, trailing) = - partitionLeadingTrailing comments longident.loc in + partition_leading_trailing comments longident.loc in attach t.leading longident.loc leading; begin match args with | Some expr -> - let (afterLongident, rest) = - partitionAdjacentTrailing longident.loc trailing in - attach t.trailing longident.loc afterLongident; - walkExpr expr t rest + let (after_longident, rest) = + partition_adjacent_trailing longident.loc trailing in + attach t.trailing longident.loc after_longident; + walk_expr expr t rest | None -> attach t.trailing longident.loc trailing end | Pexp_variant (_label, None) -> () | Pexp_variant (_label, Some expr) -> - walkExpr expr t comments + walk_expr expr t comments | Pexp_array exprs | Pexp_tuple exprs -> - walkList - ~getLoc:(fun n -> n.Parsetree.pexp_loc) - ~walkNode:walkExpr + walk_list + ~get_loc:(fun n -> n.Parsetree.pexp_loc) + ~walk_node:walk_expr exprs t comments - | Pexp_record (rows, spreadExpr) -> - let comments = match spreadExpr with + | Pexp_record (rows, spread_expr) -> + let comments = match spread_expr with | None -> comments | Some expr -> - let (leading, inside, trailing) = partitionByLoc comments expr.pexp_loc in + let (leading, inside, trailing) = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpr expr t inside; - let (afterExpr, rest) = partitionAdjacentTrailing expr.pexp_loc trailing in - attach t.trailing expr.pexp_loc afterExpr; + walk_expr expr t inside; + let (after_expr, rest) = partition_adjacent_trailing expr.pexp_loc trailing in + attach t.trailing expr.pexp_loc after_expr; rest in - walkList - ~getLoc:(fun ( + walk_list + ~get_loc:(fun ( (longident, expr): (Longident.t Asttypes.loc * Parsetree.expression) ) -> { longident.loc with loc_end = expr.pexp_loc.loc_end }) - ~walkNode:walkExprRecordRow + ~walk_node:walk_expr_record_row rows t comments | Pexp_field (expr, longident) -> - let (leading, inside, trailing) = partitionByLoc comments expr.pexp_loc in - let trailing = if isBlockExpr expr then ( - let (afterExpr, rest) = - partitionAdjacentTrailing expr.pexp_loc trailing in - walkExpr expr t (List.concat [leading; inside; afterExpr]); + let (leading, inside, trailing) = partition_by_loc comments expr.pexp_loc in + let trailing = if is_block_expr expr then ( + let (after_expr, rest) = + partition_adjacent_trailing expr.pexp_loc trailing in + walk_expr expr t (List.concat [leading; inside; after_expr]); rest ) else ( attach t.leading expr.pexp_loc leading; - walkExpr expr t inside; + walk_expr expr t inside; trailing ) 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 + 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 attach t.leading longident.loc leading; attach t.trailing longident.loc trailing | Pexp_setfield (expr1, longident, expr2) -> - let (leading, inside, trailing) = partitionByLoc comments expr1.pexp_loc in - let rest = if isBlockExpr expr1 then ( - let (afterExpr, rest) = - partitionAdjacentTrailing expr1.pexp_loc trailing in - walkExpr expr1 t (List.concat [leading; inside; afterExpr]); + let (leading, inside, trailing) = partition_by_loc comments expr1.pexp_loc in + let rest = if is_block_expr expr1 then ( + let (after_expr, rest) = + partition_adjacent_trailing expr1.pexp_loc trailing in + walk_expr expr1 t (List.concat [leading; inside; after_expr]); rest ) else ( - let (afterExpr, rest) = - partitionAdjacentTrailing expr1.pexp_loc trailing in + let (after_expr, rest) = + partition_adjacent_trailing expr1.pexp_loc trailing in attach t.leading expr1.pexp_loc leading; - walkExpr expr1 t inside; - attach t.trailing expr1.pexp_loc afterExpr; + walk_expr expr1 t inside; + attach t.trailing expr1.pexp_loc after_expr; rest ) in - let (beforeLongident, afterLongident) = partitionLeadingTrailing rest longident.loc in - attach t.leading longident.loc beforeLongident; - let (afterLongident, rest) = partitionAdjacentTrailing longident.loc afterLongident in - attach t.trailing longident.loc afterLongident; - if isBlockExpr expr2 then - walkExpr expr2 t rest + let (before_longident, after_longident) = partition_leading_trailing rest longident.loc in + attach t.leading longident.loc before_longident; + let (after_longident, rest) = partition_adjacent_trailing longident.loc after_longident in + attach t.trailing longident.loc after_longident; + if is_block_expr expr2 then + walk_expr expr2 t rest else ( - let (leading, inside, trailing) = partitionByLoc rest expr2.pexp_loc in + let (leading, inside, trailing) = partition_by_loc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpr expr2 t inside; + walk_expr expr2 t inside; attach t.trailing expr2.pexp_loc trailing ) - | Pexp_ifthenelse (ifExpr, thenExpr, elseExpr) -> - let (leading, inside, trailing) = partitionByLoc comments ifExpr.pexp_loc in - let comments = if isBlockExpr ifExpr then ( - let (afterExpr, comments) = partitionAdjacentTrailing ifExpr.pexp_loc trailing in - walkExpr ifExpr t (List.concat [leading; inside; afterExpr]); + | Pexp_ifthenelse (if_expr, then_expr, else_expr) -> + let (leading, inside, trailing) = partition_by_loc comments if_expr.pexp_loc in + let comments = if is_block_expr if_expr then ( + let (after_expr, comments) = partition_adjacent_trailing if_expr.pexp_loc trailing in + walk_expr if_expr t (List.concat [leading; inside; after_expr]); comments ) else ( - attach t.leading ifExpr.pexp_loc leading; - walkExpr ifExpr t inside; - let (afterExpr, comments) = partitionAdjacentTrailing ifExpr.pexp_loc trailing in - attach t.trailing ifExpr.pexp_loc afterExpr; + attach t.leading if_expr.pexp_loc leading; + walk_expr if_expr t inside; + let (after_expr, comments) = partition_adjacent_trailing if_expr.pexp_loc trailing in + attach t.trailing if_expr.pexp_loc after_expr; comments ) in - let (leading, inside, trailing) = partitionByLoc comments thenExpr.pexp_loc in - let comments = if isBlockExpr thenExpr then ( - let (afterExpr, trailing) = partitionAdjacentTrailing thenExpr.pexp_loc trailing in - walkExpr thenExpr t (List.concat [leading; inside; afterExpr]); + let (leading, inside, trailing) = partition_by_loc comments then_expr.pexp_loc in + let comments = if is_block_expr then_expr then ( + let (after_expr, trailing) = partition_adjacent_trailing then_expr.pexp_loc trailing in + walk_expr then_expr t (List.concat [leading; inside; after_expr]); trailing ) else ( - attach t.leading thenExpr.pexp_loc leading; - walkExpr thenExpr t inside; - let (afterExpr, comments) = partitionAdjacentTrailing thenExpr.pexp_loc trailing in - attach t.trailing thenExpr.pexp_loc afterExpr; + attach t.leading then_expr.pexp_loc leading; + walk_expr then_expr t inside; + let (after_expr, comments) = partition_adjacent_trailing then_expr.pexp_loc trailing in + attach t.trailing then_expr.pexp_loc after_expr; comments ) in - begin match elseExpr with + begin match else_expr with | None -> () | Some expr -> - if isBlockExpr expr then - walkExpr expr t comments + if is_block_expr expr then + walk_expr expr t comments else ( - let (leading, inside, trailing) = partitionByLoc comments expr.pexp_loc in + let (leading, inside, trailing) = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpr expr t inside; + walk_expr expr t inside; attach t.trailing expr.pexp_loc trailing ) end | Pexp_while (expr1, expr2) -> - let (leading, inside, trailing) = partitionByLoc comments expr1.pexp_loc in - let rest = if isBlockExpr expr1 then - let (afterExpr, rest) = partitionAdjacentTrailing expr1.pexp_loc trailing in - walkExpr expr1 t (List.concat [leading; inside; afterExpr]); + let (leading, inside, trailing) = partition_by_loc comments expr1.pexp_loc in + let rest = if is_block_expr expr1 then + let (after_expr, rest) = partition_adjacent_trailing expr1.pexp_loc trailing in + walk_expr expr1 t (List.concat [leading; inside; after_expr]); rest else ( attach t.leading expr1.pexp_loc leading; - walkExpr expr1 t inside; - let (afterExpr, rest) = partitionAdjacentTrailing expr1.pexp_loc trailing in - attach t.trailing expr1.pexp_loc afterExpr; + walk_expr expr1 t inside; + let (after_expr, rest) = partition_adjacent_trailing expr1.pexp_loc trailing in + attach t.trailing expr1.pexp_loc after_expr; rest ) in - if isBlockExpr expr2 then ( - walkExpr expr2 t rest + if is_block_expr expr2 then ( + walk_expr expr2 t rest ) else ( - let (leading, inside, trailing) = partitionByLoc rest expr2.pexp_loc in + let (leading, inside, trailing) = partition_by_loc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpr expr2 t inside; + walk_expr expr2 t inside; attach t.trailing expr2.pexp_loc trailing ) | Pexp_for (pat, expr1, expr2, _, expr3) -> - let (leading, inside, trailing) = partitionByLoc comments pat.ppat_loc in + let (leading, inside, trailing) = partition_by_loc comments pat.ppat_loc in attach t.leading pat.ppat_loc leading; - 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 + 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 attach t.leading expr1.pexp_loc leading; - walkExpr 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 + walk_expr 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 attach t.leading expr2.pexp_loc leading; - walkExpr expr2 t inside; - let (afterExpr, rest) = partitionAdjacentTrailing expr2.pexp_loc trailing in - attach t.trailing expr2.pexp_loc afterExpr; - if isBlockExpr expr3 then ( - walkExpr expr3 t rest + walk_expr 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_expr expr3 t rest ) else ( - let (leading, inside, trailing) = partitionByLoc rest expr3.pexp_loc in + let (leading, inside, trailing) = partition_by_loc rest expr3.pexp_loc in attach t.leading expr3.pexp_loc leading; - walkExpr expr3 t inside; + walk_expr expr3 t inside; attach t.trailing expr3.pexp_loc trailing ) - | Pexp_pack modExpr -> - let (before, inside, after) = partitionByLoc comments modExpr.pmod_loc in - attach t.leading modExpr.pmod_loc before; - walkModExpr modExpr t inside; - attach t.trailing modExpr.pmod_loc after + | 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_mod_expr mod_expr t inside; + attach t.trailing mod_expr.pmod_loc after | Pexp_match (expr, cases) | Pexp_try (expr, cases) -> - let (before, inside, after) = partitionByLoc comments expr.pexp_loc in - let after = if isBlockExpr expr then ( - let (afterExpr, rest) = - partitionAdjacentTrailing expr.pexp_loc after in - walkExpr expr t (List.concat [before; inside; afterExpr]); + let (before, inside, after) = partition_by_loc 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_expr expr t (List.concat [before; inside; after_expr]); rest ) else ( attach t.leading expr.pexp_loc before; - walkExpr expr t inside; + walk_expr expr t inside; after ) in - let (afterExpr, rest) = partitionAdjacentTrailing expr.pexp_loc after in - attach t.trailing expr.pexp_loc afterExpr; - walkList - ~getLoc:(fun n -> {n.Parsetree.pc_lhs.ppat_loc with + let (after_expr, rest) = partition_adjacent_trailing expr.pexp_loc after in + attach t.trailing expr.pexp_loc after_expr; + walk_list + ~get_loc:(fun n -> {n.Parsetree.pc_lhs.ppat_loc with loc_end = n.pc_rhs.pexp_loc.loc_end}) - ~walkNode:walkCase + ~walk_node:walk_case cases t rest @@ -5147,12 +5147,12 @@ module CommentTable = struct {pexp_desc = Pexp_ident {txt = Longident.Lident ("~+" | "~+." | "~-" | "~-." | "not" | "!") }}, - [Nolabel, argExpr] + [Nolabel, arg_expr] ) -> - let (before, inside, after) = partitionByLoc comments argExpr.pexp_loc in - attach t.leading argExpr.pexp_loc before; - walkExpr argExpr t inside; - attach t.trailing argExpr.pexp_loc after + let (before, inside, after) = partition_by_loc comments arg_expr.pexp_loc in + attach t.leading arg_expr.pexp_loc before; + walk_expr arg_expr t inside; + attach t.trailing arg_expr.pexp_loc after (* binary expression *) | Pexp_apply( {pexp_desc = Pexp_ident {txt = Longident.Lident @@ -5162,32 +5162,32 @@ module CommentTable = struct | "/." | "**" | "|." | "<>") }}, [(Nolabel, operand1); (Nolabel, operand2)] ) -> - let (before, inside, after) = partitionByLoc comments operand1.pexp_loc in + let (before, inside, after) = partition_by_loc comments operand1.pexp_loc in attach t.leading operand1.pexp_loc before; - walkExpr operand1 t inside; - let (afterOperand1, rest) = - partitionAdjacentTrailing operand1.pexp_loc after in - attach t.trailing operand1.pexp_loc afterOperand1; - let (before, inside, after) = partitionByLoc rest operand2.pexp_loc in + walk_expr operand1 t inside; + let (after_operand1, rest) = + partition_adjacent_trailing 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.leading operand2.pexp_loc before; - walkExpr operand2 t inside; (* (List.concat [inside; after]); *) + walk_expr operand2 t inside; (* (List.concat [inside; after]); *) attach t.trailing operand2.pexp_loc after; - | Pexp_apply (callExpr, arguments) -> - let (before, inside, after) = partitionByLoc comments callExpr.pexp_loc in - let after = if isBlockExpr callExpr then ( - let (afterExpr, rest) = - partitionAdjacentTrailing callExpr.pexp_loc after in - walkExpr callExpr t (List.concat [before; inside; afterExpr]); + | Pexp_apply (call_expr, arguments) -> + let (before, inside, after) = partition_by_loc comments call_expr.pexp_loc in + let after = if is_block_expr call_expr then ( + let (after_expr, rest) = + partition_adjacent_trailing call_expr.pexp_loc after in + walk_expr call_expr t (List.concat [before; inside; after_expr]); rest ) else ( - attach t.leading callExpr.pexp_loc before; - walkExpr callExpr t inside; + attach t.leading call_expr.pexp_loc before; + walk_expr call_expr t inside; after ) in - let (afterExpr, rest) = partitionAdjacentTrailing callExpr.pexp_loc after in - attach t.trailing callExpr.pexp_loc afterExpr; - walkList - ~getLoc:(fun (_argLabel, expr) -> + let (after_expr, rest) = partition_adjacent_trailing call_expr.pexp_loc after in + attach t.trailing call_expr.pexp_loc after_expr; + walk_list + ~get_loc:(fun (_argLabel, expr) -> let loc = match expr.Parsetree.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _)::_attrs -> {loc with loc_end = expr.pexp_loc.loc_end} @@ -5195,28 +5195,28 @@ module CommentTable = struct expr.pexp_loc in loc) - ~walkNode:walkExprArgument + ~walk_node:walk_expr_argument arguments t rest | Pexp_fun (_, _, _, _) | Pexp_newtype _ -> - let (_, parameters, returnExpr) = funExpr expr in - let comments = visitListButContinueWithRemainingComments - ~newlineDelimited:false - ~walkNode:walkExprPararameter - ~getLoc:(fun (_attrs, _argLbl, exprOpt, pattern) -> + let (_, parameters, return_expr) = fun_expr expr in + let comments = visit_list_but_continue_with_remaining_comments + ~newline_delimited:false + ~walk_node:walk_expr_pararameter + ~get_loc:(fun (_attrs, _argLbl, expr_opt, pattern) -> let open Parsetree in - let startPos = match pattern.ppat_attributes with + let start_pos = match pattern.ppat_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _)::_attrs -> loc.loc_start | _ -> pattern.ppat_loc.loc_start in - match exprOpt with - | None -> {pattern.ppat_loc with loc_start = startPos} + match expr_opt with + | None -> {pattern.ppat_loc with loc_start = start_pos} | Some expr -> { pattern.ppat_loc with - loc_start = startPos; + loc_start = start_pos; loc_end = expr.pexp_loc.loc_end } ) @@ -5224,614 +5224,614 @@ module CommentTable = struct t comments in - begin match returnExpr.pexp_desc with + begin match return_expr.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) = partitionByLoc comments typ.ptyp_loc in + let (leading, inside, trailing) = partition_by_loc comments typ.ptyp_loc in attach t.leading typ.ptyp_loc leading; - walkTypExpr typ t inside; - let (afterTyp, comments) = - partitionAdjacentTrailing typ.ptyp_loc trailing in - attach t.trailing typ.ptyp_loc afterTyp; - if isBlockExpr expr then - walkExpr expr t comments + walk_typ_expr typ t inside; + let (after_typ, comments) = + partition_adjacent_trailing typ.ptyp_loc trailing in + attach t.trailing typ.ptyp_loc after_typ; + if is_block_expr expr then + walk_expr expr t comments else ( let (leading, inside, trailing) = - partitionByLoc comments expr.pexp_loc in + partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpr expr t inside; + walk_expr expr t inside; attach t.trailing expr.pexp_loc trailing ) | _ -> - if isBlockExpr returnExpr then - walkExpr returnExpr t comments + if is_block_expr return_expr then + walk_expr return_expr t comments else ( let (leading, inside, trailing) = - partitionByLoc comments returnExpr.pexp_loc in - attach t.leading returnExpr.pexp_loc leading; - walkExpr returnExpr t inside; - attach t.trailing returnExpr.pexp_loc trailing + partition_by_loc comments return_expr.pexp_loc in + attach t.leading return_expr.pexp_loc leading; + walk_expr return_expr t inside; + attach t.trailing return_expr.pexp_loc trailing ) end | _ -> () - and walkExprPararameter (_attrs, _argLbl, exprOpt, pattern) t comments = - let (leading, inside, trailing) = partitionByLoc comments pattern.ppat_loc in + and walk_expr_pararameter (_attrs, _argLbl, expr_opt, pattern) t comments = + let (leading, inside, trailing) = partition_by_loc comments pattern.ppat_loc in attach t.leading pattern.ppat_loc leading; - walkPattern pattern t inside; - begin match exprOpt with + walk_pattern pattern t inside; + begin match expr_opt with | Some expr -> let (_afterPat, rest) = - partitionAdjacentTrailing pattern.ppat_loc trailing in + partition_adjacent_trailing pattern.ppat_loc trailing in attach t.trailing pattern.ppat_loc trailing; - if isBlockExpr expr then - walkExpr expr t rest + if is_block_expr expr then + walk_expr expr t rest else ( - let (leading, inside, trailing) = partitionByLoc rest expr.pexp_loc in + let (leading, inside, trailing) = partition_by_loc rest expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpr expr t inside; + walk_expr expr t inside; attach t.trailing expr.pexp_loc trailing ) | None -> attach t.trailing pattern.ppat_loc trailing end - and walkExprArgument (_argLabel, expr) t comments = + and walk_expr_argument (_argLabel, expr) t comments = match expr.Parsetree.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _)::_attrs -> - let (leading, trailing) = partitionLeadingTrailing comments loc in + let (leading, trailing) = partition_leading_trailing comments loc in attach t.leading loc leading; - let (afterLabel, rest) = partitionAdjacentTrailing loc trailing in - attach t.trailing loc afterLabel; - let (before, inside, after) = partitionByLoc rest expr.pexp_loc in + let (after_label, rest) = partition_adjacent_trailing loc trailing in + attach t.trailing loc after_label; + let (before, inside, after) = partition_by_loc rest expr.pexp_loc in attach t.leading expr.pexp_loc before; - walkExpr expr t inside; + walk_expr expr t inside; attach t.trailing expr.pexp_loc after | _ -> - let (before, inside, after) = partitionByLoc comments expr.pexp_loc in + let (before, inside, after) = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc before; - walkExpr expr t inside; + walk_expr expr t inside; attach t.trailing expr.pexp_loc after - and walkCase case t comments = - let (before, inside, after) = partitionByLoc comments case.pc_lhs.ppat_loc in + and walk_case case t comments = + let (before, inside, after) = partition_by_loc 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 *) - 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; + 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; let comments = match case.pc_guard with | Some expr -> - let (before, inside, after) = partitionByLoc rest expr.pexp_loc in - let (afterExpr, rest) = partitionAdjacentTrailing expr.pexp_loc after in - if isBlockExpr expr then ( - walkExpr expr t (List.concat [before; inside; afterExpr]) + 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_expr expr t (List.concat [before; inside; after_expr]) ) else ( attach t.leading expr.pexp_loc before; - walkExpr expr t inside; - attach t.trailing expr.pexp_loc afterExpr; + walk_expr expr t inside; + attach t.trailing expr.pexp_loc after_expr; ); rest | None -> rest in - if isBlockExpr case.pc_rhs then ( - walkExpr case.pc_rhs t comments + if is_block_expr case.pc_rhs then ( + walk_expr case.pc_rhs t comments ) else ( - let (before, inside, after) = partitionByLoc comments case.pc_rhs.pexp_loc in + let (before, inside, after) = partition_by_loc comments case.pc_rhs.pexp_loc in attach t.leading case.pc_rhs.pexp_loc before; - walkExpr case.pc_rhs t inside; + walk_expr case.pc_rhs t inside; attach t.trailing case.pc_rhs.pexp_loc after ) - and walkExprRecordRow (longident, expr) t comments = - let (beforeLongident, afterLongident) = - partitionLeadingTrailing comments longident.loc + and walk_expr_record_row (longident, expr) t comments = + let (before_longident, after_longident) = + partition_leading_trailing comments longident.loc in - attach t.leading longident.loc beforeLongident; - let (afterLongident, rest) = - partitionAdjacentTrailing longident.loc afterLongident in - attach t.trailing longident.loc afterLongident; - let (leading, inside, trailing) = partitionByLoc rest expr.pexp_loc in + attach t.leading longident.loc before_longident; + let (after_longident, rest) = + partition_adjacent_trailing longident.loc after_longident in + attach t.trailing longident.loc after_longident; + let (leading, inside, trailing) = partition_by_loc rest expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpr expr t inside; + walk_expr expr t inside; attach t.trailing expr.pexp_loc trailing - and walkExtConstr extConstr t comments = + and walk_ext_constr ext_constr t comments = let (leading, trailing) = - partitionLeadingTrailing comments extConstr.pext_name.loc in - attach t.leading extConstr.pext_name.loc leading; - let (afterName, rest) = - partitionAdjacentTrailing extConstr.pext_name.loc trailing in - attach t.trailing extConstr.pext_name.loc afterName; - walkExtensionConstructorKind extConstr.pext_kind t rest - - and walkExtensionConstructorKind kind t comments = + partition_leading_trailing comments ext_constr.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 in + attach t.trailing ext_constr.pext_name.loc after_name; + walk_extension_constructor_kind ext_constr.pext_kind t rest + + and walk_extension_constructor_kind kind t comments = match kind with | Pext_rebind longident -> let (leading, trailing) = - partitionLeadingTrailing comments longident.loc in + partition_leading_trailing comments longident.loc in attach t.leading longident.loc leading; attach t.trailing longident.loc trailing - | Pext_decl (constructorArguments, maybeTypExpr) -> - let rest = walkConstructorArguments constructorArguments t comments in - begin match maybeTypExpr with + | Pext_decl (constructor_arguments, maybe_typ_expr) -> + let rest = walk_constructor_arguments constructor_arguments t comments in + begin match maybe_typ_expr with | None -> () | Some typexpr -> - let (before, inside, after) = partitionByLoc rest typexpr.ptyp_loc in + let (before, inside, after) = partition_by_loc rest typexpr.ptyp_loc in attach t.leading typexpr.ptyp_loc before; - walkTypExpr typexpr t inside; + walk_typ_expr typexpr t inside; attach t.trailing typexpr.ptyp_loc after end - and walkModExpr modExpr t comments = - match modExpr.pmod_desc with + and walk_mod_expr mod_expr t comments = + match mod_expr.pmod_desc with | Pmod_ident longident -> - let (before, after) = partitionLeadingTrailing comments longident.loc in + let (before, after) = partition_leading_trailing comments longident.loc in attach t.leading longident.loc before; attach t.trailing longident.loc after | Pmod_structure structure -> - walkStructure structure t comments + walk_structure structure t comments | Pmod_extension extension -> - walkExtension extension t comments + walk_extension extension t comments | Pmod_unpack expr -> - let (before, inside, after) = partitionByLoc comments expr.pexp_loc in + let (before, inside, after) = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc before; - walkExpr expr t inside; + walk_expr 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) = partitionByLoc comments modexpr.pmod_loc in + let (before, inside, after) = partition_by_loc comments modexpr.pmod_loc in attach t.leading modexpr.pmod_loc before; - walkModExpr modexpr t inside; - let (after, rest) = partitionAdjacentTrailing modexpr.pmod_loc after in + walk_mod_expr modexpr t inside; + let (after, rest) = partition_adjacent_trailing modexpr.pmod_loc after in attach t.trailing modexpr.pmod_loc after; - let (before, inside, after) = partitionByLoc rest modtype.pmty_loc in + let (before, inside, after) = partition_by_loc rest modtype.pmty_loc in attach t.leading modtype.pmty_loc before; - walkModType modtype t inside; + walk_mod_type modtype t inside; attach t.trailing modtype.pmty_loc after ) else ( - let (before, inside, after) = partitionByLoc comments modtype.pmty_loc in + let (before, inside, after) = partition_by_loc 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 + walk_mod_type modtype t inside; + let (after, rest) = partition_adjacent_trailing modtype.pmty_loc after in attach t.trailing modtype.pmty_loc after; - let (before, inside, after) = partitionByLoc rest modexpr.pmod_loc in + let (before, inside, after) = partition_by_loc rest modexpr.pmod_loc in attach t.leading modexpr.pmod_loc before; - walkModExpr modexpr t inside; + walk_mod_expr modexpr t inside; attach t.trailing modexpr.pmod_loc after; ) | Pmod_apply (_callModExpr, _argModExpr) -> - let modExprs = modExprApply modExpr in - walkList - ~getLoc:(fun n -> n.Parsetree.pmod_loc) - ~walkNode:walkModExpr - modExprs + let mod_exprs = mod_expr_apply mod_expr in + walk_list + ~get_loc:(fun n -> n.Parsetree.pmod_loc) + ~walk_node:walk_mod_expr + mod_exprs t comments | Pmod_functor _ -> - let (parameters, returnModExpr) = modExprFunctor modExpr in - let comments = visitListButContinueWithRemainingComments - ~getLoc:(fun - (_, lbl, modTypeOption) -> match modTypeOption with + let (parameters, return_mod_expr) = mod_expr_functor mod_expr in + let comments = visit_list_but_continue_with_remaining_comments + ~get_loc:(fun + (_, lbl, mod_type_option) -> match mod_type_option with | None -> lbl.Asttypes.loc - | Some modType -> {lbl.loc with loc_end = modType.Parsetree.pmty_loc.loc_end} + | Some mod_type -> {lbl.loc with loc_end = mod_type.Parsetree.pmty_loc.loc_end} ) - ~walkNode:walkModExprParameter - ~newlineDelimited:false + ~walk_node:walk_mod_expr_parameter + ~newline_delimited:false parameters t comments in - begin 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; - walkModExpr modExpr t inside; - attach t.trailing modExpr.pmod_loc after + begin 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_mod_expr mod_expr t inside; + attach t.trailing mod_expr.pmod_loc after | _ -> - let (before, inside, after) = partitionByLoc comments returnModExpr.pmod_loc in - attach t.leading returnModExpr.pmod_loc before; - walkModExpr returnModExpr t inside; - attach t.trailing returnModExpr.pmod_loc after + let (before, inside, after) = partition_by_loc comments return_mod_expr.pmod_loc in + attach t.leading return_mod_expr.pmod_loc before; + walk_mod_expr return_mod_expr t inside; + attach t.trailing return_mod_expr.pmod_loc after end - and walkModExprParameter parameter t comments = - let (_attrs, lbl, modTypeOption) = parameter in - let (leading, trailing) = partitionLeadingTrailing comments lbl.loc in + 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 attach t.leading lbl.loc leading; - begin match modTypeOption with + begin match mod_type_option with | None -> attach t.trailing lbl.loc trailing - | 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; + | 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; end - and walkModType modType t comments = - match modType.pmty_desc with + and walk_mod_type mod_type t comments = + match mod_type.pmty_desc with | Pmty_ident longident | Pmty_alias longident -> - let (leading, trailing) = partitionLeadingTrailing comments longident.loc in + let (leading, trailing) = partition_leading_trailing comments longident.loc in attach t.leading longident.loc leading; attach t.trailing longident.loc trailing; | Pmty_signature signature -> - walkSignature signature t comments + walk_signature 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; - walkModExpr 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 + 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_mod_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 (* TODO: withConstraints*) | Pmty_functor _ -> - let (parameters, returnModType) = functorType modType in - let comments = visitListButContinueWithRemainingComments - ~getLoc:(fun - (_, lbl, modTypeOption) -> match modTypeOption with + let (parameters, return_mod_type) = functor_type mod_type in + let comments = visit_list_but_continue_with_remaining_comments + ~get_loc:(fun + (_, lbl, mod_type_option) -> match mod_type_option with | None -> lbl.Asttypes.loc - | Some modType -> - if lbl.txt = "_" then modType.Parsetree.pmty_loc - else {lbl.loc with loc_end = modType.Parsetree.pmty_loc.loc_end} + | 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} ) - ~walkNode:walkModTypeParameter - ~newlineDelimited:false + ~walk_node:walk_mod_type_parameter + ~newline_delimited:false parameters t comments in - let (before, inside, after) = partitionByLoc comments returnModType.pmty_loc in - attach t.leading returnModType.pmty_loc before; - walkModType returnModType t inside; - attach t.trailing returnModType.pmty_loc after + let (before, inside, after) = partition_by_loc comments return_mod_type.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 - and walkModTypeParameter (_, lbl, modTypeOption) t comments = - let (leading, trailing) = partitionLeadingTrailing comments lbl.loc in + and walk_mod_type_parameter (_, lbl, mod_type_option) t comments = + let (leading, trailing) = partition_leading_trailing comments lbl.loc in attach t.leading lbl.loc leading; - begin match modTypeOption with + begin match mod_type_option with | None -> attach t.trailing lbl.loc trailing - | 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; + | 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; end - and walkPattern pat t comments = + and walk_pattern pat t comments = let open Location in match pat.Parsetree.ppat_desc with | _ when comments = [] -> () | Ppat_alias (pat, alias) -> - let (leading, inside, trailing) = partitionByLoc comments pat.ppat_loc in + let (leading, inside, trailing) = partition_by_loc comments pat.ppat_loc in attach t.leading pat.ppat_loc leading; - walkPattern pat t inside; - let (afterPat, rest) = partitionAdjacentTrailing pat.ppat_loc trailing in + walk_pattern pat t inside; + let (after_pat, rest) = partition_adjacent_trailing pat.ppat_loc trailing in attach t.leading pat.ppat_loc leading; - 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 + 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 | Ppat_tuple [] | Ppat_array [] | Ppat_construct({txt = Longident.Lident "()"}, _) | Ppat_construct({txt = Longident.Lident "[]"}, _) -> attach t.inside pat.ppat_loc comments; | Ppat_array patterns -> - walkList - ~getLoc:(fun n -> n.Parsetree.ppat_loc) - ~walkNode:walkPattern + walk_list + ~get_loc:(fun n -> n.Parsetree.ppat_loc) + ~walk_node:walk_pattern patterns t comments | Ppat_tuple patterns -> - walkList - ~getLoc:(fun n -> n.Parsetree.ppat_loc) - ~walkNode:walkPattern + walk_list + ~get_loc:(fun n -> n.Parsetree.ppat_loc) + ~walk_node:walk_pattern patterns t comments | Ppat_construct({txt = Longident.Lident "::"}, _) -> - walkList - ~getLoc:(fun n -> n.Parsetree.ppat_loc) - ~walkNode:walkPattern - (collectListPatterns [] pat) + walk_list + ~get_loc:(fun n -> n.Parsetree.ppat_loc) + ~walk_node:walk_pattern + (collect_list_patterns [] pat) t comments | Ppat_construct (constr, None) -> - let (beforeConstr, afterConstr) = - partitionLeadingTrailing comments constr.loc + let (before_constr, after_constr) = + partition_leading_trailing comments constr.loc in - attach t.leading constr.loc beforeConstr; - attach t.trailing constr.loc afterConstr + attach t.leading constr.loc before_constr; + attach t.trailing constr.loc after_constr | Ppat_construct (constr, Some pat) -> - let (leading, trailing) = partitionLeadingTrailing comments constr.loc in + let (leading, trailing) = partition_leading_trailing comments constr.loc in attach t.leading constr.loc leading; - let (leading, inside, trailing) = partitionByLoc trailing pat.ppat_loc in + let (leading, inside, trailing) = partition_by_loc trailing pat.ppat_loc in attach t.leading pat.ppat_loc leading; - walkPattern pat t inside; + walk_pattern pat t inside; attach t.trailing pat.ppat_loc trailing | Ppat_variant (_label, None) -> () | Ppat_variant (_label, Some pat) -> - walkPattern pat t comments + walk_pattern pat t comments | Ppat_type _ -> () - | Ppat_record (recordRows, _) -> - walkList - ~getLoc:(fun ( - (longidentLoc, pattern): (Longident.t Asttypes.loc * Parsetree.pattern) + | Ppat_record (record_rows, _) -> + walk_list + ~get_loc:(fun ( + (longident_loc, pattern): (Longident.t Asttypes.loc * Parsetree.pattern) ) -> { - longidentLoc.loc with + longident_loc.loc with loc_end = pattern.Parsetree.ppat_loc.loc_end }) - ~walkNode:walkPatternRecordRow - recordRows + ~walk_node:walk_pattern_record_row + record_rows t comments | Ppat_or (pattern1, pattern2) -> - let (beforePattern1, insidePattern1, afterPattern1) = - partitionByLoc comments pattern1.ppat_loc + let (before_pattern1, inside_pattern1, after_pattern1) = + partition_by_loc comments pattern1.ppat_loc in - attach t.leading pattern1.ppat_loc beforePattern1; - walkPattern pattern1 t insidePattern1; - let (afterPattern1, rest) = - partitionAdjacentTrailing pattern1.ppat_loc afterPattern1 + attach t.leading pattern1.ppat_loc before_pattern1; + walk_pattern pattern1 t inside_pattern1; + let (after_pattern1, rest) = + partition_adjacent_trailing pattern1.ppat_loc after_pattern1 in - attach t.trailing pattern1.ppat_loc afterPattern1; - let (beforePattern2, insidePattern2, afterPattern2) = - partitionByLoc rest pattern2.ppat_loc + attach t.trailing pattern1.ppat_loc after_pattern1; + let (before_pattern2, inside_pattern2, after_pattern2) = + partition_by_loc rest pattern2.ppat_loc in - attach t.leading pattern2.ppat_loc beforePattern2; - walkPattern pattern2 t insidePattern2; - attach t.trailing pattern2.ppat_loc afterPattern2 + attach t.leading pattern2.ppat_loc before_pattern2; + walk_pattern pattern2 t inside_pattern2; + attach t.trailing pattern2.ppat_loc after_pattern2 | Ppat_constraint (pattern, typ) -> - let (beforePattern, insidePattern, afterPattern) = - partitionByLoc comments pattern.ppat_loc + let (before_pattern, inside_pattern, after_pattern) = + partition_by_loc comments pattern.ppat_loc in - attach t.leading pattern.ppat_loc beforePattern; - walkPattern pattern t insidePattern; - let (afterPattern, rest) = - partitionAdjacentTrailing pattern.ppat_loc afterPattern + 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 in - attach t.trailing pattern.ppat_loc afterPattern; - let (beforeTyp, insideTyp, afterTyp) = - partitionByLoc rest typ.ptyp_loc + 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 beforeTyp; - walkTypExpr typ t insideTyp; - attach t.trailing typ.ptyp_loc afterTyp + attach t.leading typ.ptyp_loc before_typ; + walk_typ_expr typ t inside_typ; + attach t.trailing typ.ptyp_loc after_typ | Ppat_lazy pattern | Ppat_exception pattern -> - let (leading, inside, trailing) = partitionByLoc comments pattern.ppat_loc in + let (leading, inside, trailing) = partition_by_loc comments pattern.ppat_loc in attach t.leading pattern.ppat_loc leading; - walkPattern pattern t inside; + walk_pattern pattern t inside; attach t.trailing pattern.ppat_loc trailing - | Ppat_unpack stringLoc -> - let (leading, trailing) = partitionLeadingTrailing comments stringLoc.loc in - attach t.leading stringLoc.loc leading; - attach t.trailing stringLoc.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 -> - walkExtension extension t comments + walk_extension extension t comments | _ -> () (* name: firstName *) - and walkPatternRecordRow row t comments = + and walk_pattern_record_row row t comments = match row with (* punned {x}*) - | ({Location.txt=Longident.Lident ident; loc = longidentLoc}, + | ({Location.txt=Longident.Lident ident; loc = longident_loc}, {Parsetree.ppat_desc=Ppat_var {txt;_}}) when ident = txt -> - let (beforeLbl, afterLbl) = - partitionLeadingTrailing comments longidentLoc + let (before_lbl, after_lbl) = + partition_leading_trailing comments longident_loc in - attach t.leading longidentLoc beforeLbl; - attach t.trailing longidentLoc afterLbl + attach t.leading longident_loc before_lbl; + attach t.trailing longident_loc after_lbl | (longident, pattern) -> - let (beforeLbl, afterLbl) = - partitionLeadingTrailing comments longident.loc + let (before_lbl, after_lbl) = + partition_leading_trailing 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 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 attach t.leading pattern.ppat_loc leading; - walkPattern pattern t inside; + walk_pattern pattern t inside; attach t.trailing pattern.ppat_loc trailing - and walkTypExpr typ t comments = + and walk_typ_expr typ t comments = match typ.Parsetree.ptyp_desc with | _ when comments = [] -> () | Ptyp_tuple typexprs -> - walkList - ~getLoc:(fun n -> n.Parsetree.ptyp_loc) - ~walkNode:walkTypExpr + walk_list + ~get_loc:(fun n -> n.Parsetree.ptyp_loc) + ~walk_node:walk_typ_expr typexprs t comments | Ptyp_extension extension -> - walkExtension extension t comments - | Ptyp_package packageType -> - walkPackageType packageType t comments + walk_extension extension t comments + | Ptyp_package package_type -> + walk_package_type package_type t comments | Ptyp_alias (typexpr, _alias) -> - let (beforeTyp, insideTyp, afterTyp) = - partitionByLoc comments typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc beforeTyp; - walkTypExpr typexpr t insideTyp; - attach t.trailing typexpr.ptyp_loc afterTyp; + let (before_typ, inside_typ, after_typ) = + partition_by_loc comments typexpr.ptyp_loc in + attach t.leading typexpr.ptyp_loc before_typ; + walk_typ_expr typexpr t inside_typ; + attach t.trailing typexpr.ptyp_loc after_typ; | Ptyp_poly (strings, typexpr) -> - let comments = 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 beforeLongident; - attach t.trailing longident.loc afterLongident + 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 in + attach t.leading longident.loc before_longident; + attach t.trailing longident.loc after_longident ) - ~newlineDelimited:false + ~newline_delimited:false strings t comments in - let (beforeTyp, insideTyp, afterTyp) = - partitionByLoc comments typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc beforeTyp; - walkTypExpr typexpr t insideTyp; - attach t.trailing typexpr.ptyp_loc afterTyp + let (before_typ, inside_typ, after_typ) = + partition_by_loc comments typexpr.ptyp_loc in + attach t.leading typexpr.ptyp_loc before_typ; + walk_typ_expr typexpr t inside_typ; + attach t.trailing typexpr.ptyp_loc after_typ | Ptyp_constr (longident, typexprs) -> - let (beforeLongident, _afterLongident) = - partitionLeadingTrailing comments longident.loc in - let (afterLongident, rest) = - partitionAdjacentTrailing longident.loc comments in - attach t.leading longident.loc beforeLongident; - attach t.trailing longident.loc afterLongident; - walkList - ~getLoc:(fun n -> n.Parsetree.ptyp_loc) - ~walkNode:walkTypExpr + let (before_longident, _afterLongident) = + partition_leading_trailing comments longident.loc in + let (after_longident, rest) = + partition_adjacent_trailing longident.loc comments in + attach t.leading longident.loc before_longident; + attach t.trailing longident.loc after_longident; + walk_list + ~get_loc:(fun n -> n.Parsetree.ptyp_loc) + ~walk_node:walk_typ_expr typexprs t rest | Ptyp_arrow _ -> - 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 beforeTyp; - walkTypExpr typexpr t insideTyp; - attach t.trailing typexpr.ptyp_loc afterTyp + 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 in + attach t.leading typexpr.ptyp_loc before_typ; + walk_typ_expr typexpr t inside_typ; + attach t.trailing typexpr.ptyp_loc after_typ | Ptyp_object (fields, _) -> - walkTypObjectFields fields t comments + walk_typ_object_fields fields t comments | _ -> () - and walkTypObjectFields fields t comments = - walkList - ~getLoc:(fun field -> + and walk_typ_object_fields fields t comments = + walk_list + ~get_loc:(fun field -> match field with | Parsetree.Otag (lbl, _, typ) -> {lbl.loc with loc_end = typ.ptyp_loc.loc_end} | _ -> Location.none ) - ~walkNode:walkTypObjectField + ~walk_node:walk_typ_object_field fields t comments - and walkTypObjectField field t comments = + and walk_typ_object_field field t comments = match field with | Otag (lbl, _, typexpr) -> - 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; - walkTypExpr typexpr t insideTyp; - attach t.trailing typexpr.ptyp_loc afterTyp + 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_typ_expr typexpr t inside_typ; + attach t.trailing typexpr.ptyp_loc after_typ | _ -> () - and walkTypeParameters typeParameters t comments = - visitListButContinueWithRemainingComments - ~getLoc:(fun (_, _, typexpr) -> typexpr.Parsetree.ptyp_loc) - ~walkNode:walkTypeParameter - ~newlineDelimited:false - typeParameters + and walk_type_parameters type_parameters t comments = + visit_list_but_continue_with_remaining_comments + ~get_loc:(fun (_, _, typexpr) -> typexpr.Parsetree.ptyp_loc) + ~walk_node:walk_type_parameter + ~newline_delimited:false + type_parameters t comments - and walkTypeParameter (_attrs, _lbl, typexpr) t comments = - let (beforeTyp, insideTyp, afterTyp) = - partitionByLoc comments typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc beforeTyp; - walkTypExpr 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 beforeLongident; - let (afterLongident, rest) = - partitionAdjacentTrailing longident.loc afterLongident in - attach t.trailing longident.loc afterLongident; - walkPackageConstraints packageConstraints t rest - - and walkPackageConstraints packageConstraints t comments = - walkList - ~getLoc:(fun (longident, typexpr) -> {longident.Asttypes.loc with + and walk_type_parameter (_attrs, _lbl, typexpr) t comments = + let (before_typ, inside_typ, after_typ) = + partition_by_loc comments typexpr.ptyp_loc in + attach t.leading typexpr.ptyp_loc before_typ; + walk_typ_expr 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 in + attach t.leading longident.loc before_longident; + let (after_longident, rest) = + partition_adjacent_trailing longident.loc after_longident in + attach t.trailing longident.loc after_longident; + walk_package_constraints package_constraints t rest + + and walk_package_constraints package_constraints t comments = + walk_list + ~get_loc:(fun (longident, typexpr) -> {longident.Asttypes.loc with loc_end = typexpr.Parsetree.ptyp_loc.loc_end }) - ~walkNode:walkPackageConstraint - packageConstraints + ~walk_node:walk_package_constraint + package_constraints t comments - and walkPackageConstraint packageConstraint t comments = - let (longident, typexpr) = packageConstraint in - let (beforeLongident, afterLongident) = - partitionLeadingTrailing comments longident.loc in - attach t.leading longident.loc beforeLongident; - let (afterLongident, rest) = - partitionAdjacentTrailing longident.loc afterLongident in - attach t.trailing longident.loc afterLongident; - let (beforeTyp, insideTyp, afterTyp) = - partitionByLoc rest typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc beforeTyp; - walkTypExpr typexpr t insideTyp; - attach t.trailing typexpr.ptyp_loc afterTyp; - - and walkExtension extension 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 in + attach t.trailing longident.loc after_longident; + let (before_typ, inside_typ, after_typ) = + partition_by_loc rest typexpr.ptyp_loc in + attach t.leading typexpr.ptyp_loc before_typ; + walk_typ_expr typexpr t inside_typ; + attach t.trailing typexpr.ptyp_loc after_typ; + + and walk_extension extension t comments = let (id, payload) = extension in - 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 = + 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 = match payload with - | PStr s -> walkStructure s t comments + | PStr s -> walk_structure s t comments | _ -> () end module Printer = struct - let addParens doc = + let add_parens doc = Doc.group ( Doc.concat [ Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; doc ] ); - Doc.softLine; + Doc.soft_line; Doc.rparen; ] ) - let addBraces doc = + let add_braces doc = Doc.group ( Doc.concat [ Doc.lbrace; @@ -5840,13 +5840,13 @@ module Printer = struct ] ) - let getFirstLeadingComment tbl loc = + let get_first_leading_comment tbl loc = match Hashtbl.find tbl.CommentTable.leading loc with | comment::_ -> Some comment | [] -> None | exception Not_found -> None - let printMultilineCommentContent txt = + let print_multiline_comment_content txt = (* Turns * |* first line * * second line @@ -5859,106 +5859,106 @@ module Printer = struct * What makes a comment suitable for this kind of indentation? * -> multiple lines + every line starts with a star *) - let rec indentStars lines acc = + let rec indent_stars lines acc = match lines with | [] -> Doc.nil - | [lastLine] -> - let line = String.trim lastLine in + | [last_line] -> + let line = String.trim last_line in let doc = Doc.text (" " ^ line) in - let trailingSpace = if String.length line > 0 then Doc.space else Doc.nil in - List.rev (trailingSpace::doc::acc) |> Doc.concat + let trailing_space = if String.length line > 0 then Doc.space else Doc.nil in + List.rev (trailing_space::doc::acc) |> Doc.concat | line::lines -> let line = String.trim line in let len = String.length line in if len > 0 && (String.get [@doesNotRaise]) line 0 == '*' then let doc = Doc.text (" " ^ (String.trim line)) in - indentStars lines (Doc.hardLine::doc::acc) + indent_stars lines (Doc.hard_line::doc::acc) else - let trailingSpace = + let trailing_space = 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.trimSpaces txt in - Doc.concat [Doc.text content; trailingSpace] + let content = Comment.trim_spaces txt in + Doc.concat [Doc.text content; trailing_space] in let lines = String.split_on_char '\n' txt in match lines with | [] -> Doc.text "/* */" | [line] -> Doc.concat [ Doc.text "/* "; - Doc.text (Comment.trimSpaces line); + Doc.text (Comment.trim_spaces line); Doc.text " */"; ] | first::rest -> - let firstLine = Comment.trimSpaces first in + let first_line = Comment.trim_spaces first in Doc.concat [ Doc.text "/*"; - if String.length firstLine > 0 && not (String.equal firstLine "*") then + if String.length first_line > 0 && not (String.equal first_line "*") then Doc.space else Doc.nil; - indentStars rest [Doc.hardLine; Doc.text firstLine]; + indent_stars rest [Doc.hard_line; Doc.text first_line]; Doc.text "*/"; ] - let printTrailingComment (nodeLoc : Location.t) comment = - let singleLine = Comment.isSingleLineComment comment in + let print_trailing_comment (node_loc : Location.t) comment = + let single_line = Comment.is_single_line_comment comment in let content = let txt = Comment.txt comment in - if singleLine then + if single_line then Doc.text ("// " ^ String.trim txt) else - printMultilineCommentContent txt + print_multiline_comment_content txt in let diff = - let cmtStart = (Comment.loc comment).loc_start in - let prevTokEndPos = Comment.prevTokEndPos comment in - cmtStart.pos_lnum - prevTokEndPos.pos_lnum + let cmt_start = (Comment.loc comment).loc_start in + let prev_tok_end_pos = Comment.prev_tok_end_pos comment in + cmt_start.pos_lnum - prev_tok_end_pos.pos_lnum in - let isBelow = - (Comment.loc comment).loc_start.pos_lnum > nodeLoc.loc_end.pos_lnum in - if diff > 0 || isBelow then + let is_below = + (Comment.loc comment).loc_start.pos_lnum > node_loc.loc_end.pos_lnum in + if diff > 0 || is_below then Doc.concat [ - Doc.breakParent; - Doc.lineSuffix( - (Doc.concat [Doc.hardLine; if diff > 1 then Doc.hardLine else Doc.nil; content]) + Doc.break_parent; + Doc.line_suffix( + (Doc.concat [Doc.hard_line; if diff > 1 then Doc.hard_line else Doc.nil; content]) ) ] - else if not singleLine then + else if not single_line then Doc.concat [Doc.space; content] else - Doc.lineSuffix (Doc.concat [Doc.space; content]) + Doc.line_suffix (Doc.concat [Doc.space; content]) - let printLeadingComment ?nextComment comment = - let singleLine = Comment.isSingleLineComment comment in + let print_leading_comment ?next_comment comment = + let single_line = Comment.is_single_line_comment comment in let content = let txt = Comment.txt comment in - if singleLine then + if single_line then Doc.text ("// " ^ String.trim txt) else - printMultilineCommentContent txt + print_multiline_comment_content txt in let separator = Doc.concat [ - if singleLine then Doc.concat [ - Doc.hardLine; - Doc.breakParent; + if single_line then Doc.concat [ + Doc.hard_line; + Doc.break_parent; ] else Doc.nil; - (match nextComment with + (match next_comment with | Some next -> - let nextLoc = Comment.loc next in - let currLoc = Comment.loc comment in + let next_loc = Comment.loc next in + let curr_loc = Comment.loc comment in let diff = - nextLoc.Location.loc_start.pos_lnum - - currLoc.Location.loc_end.pos_lnum + next_loc.Location.loc_start.pos_lnum - + curr_loc.Location.loc_end.pos_lnum in - 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 + 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.hardLine; Doc.hardLine] - else if diff == 1 then Doc.hardLine + if diff > 1 then Doc.concat [Doc.hard_line; Doc.hard_line] + else if diff == 1 then Doc.hard_line else Doc.space | None -> Doc.nil) @@ -5969,62 +5969,62 @@ module Printer = struct separator; ] - let printCommentsInside cmtTbl loc = + let print_comments_inside cmt_tbl loc = let rec loop acc comments = match comments with | [] -> Doc.nil | [comment] -> - let cmtDoc = printLeadingComment comment in + let cmt_doc = print_leading_comment comment in let doc = Doc.group ( Doc.concat [ - Doc.concat (List.rev (cmtDoc::acc)); + Doc.concat (List.rev (cmt_doc::acc)); ] ) in doc - | comment::((nextComment::_comments) as rest) -> - let cmtDoc = printLeadingComment ~nextComment comment in - loop (cmtDoc::acc) rest + | comment::((next_comment::_comments) as rest) -> + let cmt_doc = print_leading_comment ~next_comment comment in + loop (cmt_doc::acc) rest in - match Hashtbl.find cmtTbl.CommentTable.inside loc with + match Hashtbl.find cmt_tbl.CommentTable.inside loc with | exception Not_found -> Doc.nil | comments -> - Hashtbl.remove cmtTbl.inside loc; + Hashtbl.remove cmt_tbl.inside loc; Doc.group ( loop [] comments ) - let printLeadingComments node tbl loc = + let print_leading_comments node tbl loc = let rec loop acc comments = match comments with | [] -> node | [comment] -> - let cmtDoc = printLeadingComment comment in + let cmt_doc = print_leading_comment comment in let diff = loc.Location.loc_start.pos_lnum - (Comment.loc comment).Location.loc_end.pos_lnum in let separator = - if Comment.isSingleLineComment comment then - if diff > 1 then Doc.hardLine else Doc.nil + if Comment.is_single_line_comment comment then + if diff > 1 then Doc.hard_line else Doc.nil else if diff == 0 then Doc.space - else if diff > 1 then Doc.concat [Doc.hardLine; Doc.hardLine] + else if diff > 1 then Doc.concat [Doc.hard_line; Doc.hard_line] else - Doc.hardLine + Doc.hard_line in let doc = Doc.group ( Doc.concat [ - Doc.concat (List.rev (cmtDoc::acc)); + Doc.concat (List.rev (cmt_doc::acc)); separator; node ] ) in doc - | comment::((nextComment::_comments) as rest) -> - let cmtDoc = printLeadingComment ~nextComment comment in - loop (cmtDoc::acc) rest + | comment::((next_comment::_comments) as rest) -> + let cmt_doc = print_leading_comment ~next_comment comment in + loop (cmt_doc::acc) rest in match Hashtbl.find tbl loc with | exception Not_found -> node @@ -6034,13 +6034,13 @@ module Printer = struct Hashtbl.remove tbl loc; loop [] comments - let printTrailingComments node tbl loc = + let print_trailing_comments node tbl loc = let rec loop acc comments = match comments with | [] -> Doc.concat (List.rev acc) | comment::comments -> - let cmtDoc = printTrailingComment loc comment in - loop (cmtDoc::acc) comments + let cmt_doc = print_trailing_comment loc comment in + loop (cmt_doc::acc) comments in match Hashtbl.find tbl loc with | exception Not_found -> node @@ -6049,100 +6049,100 @@ module Printer = struct (* Remove comments from tbl: Some ast nodes have the same location. * We only want to print comments once *) Hashtbl.remove tbl loc; - let cmtsDoc = loop [] comments in + let cmts_doc = loop [] comments in Doc.concat [ node; - cmtsDoc; + cmts_doc; ] - let printComments doc (tbl: CommentTable.t) loc = - let docWithLeadingComments = printLeadingComments doc tbl.leading loc in - printTrailingComments docWithLeadingComments tbl.trailing loc + 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 printList ~getLoc ~nodes ~print ?(forceBreak=false) t = - let rec loop (prevLoc: Location.t) acc nodes = + let print_list ~get_loc ~nodes ~print ?(force_break=false) t = + let rec loop (prev_loc: Location.t) acc nodes = match nodes with - | [] -> (prevLoc, Doc.concat (List.rev acc)) + | [] -> (prev_loc, Doc.concat (List.rev acc)) | node::nodes -> - let loc = getLoc node in - let startPos = match getFirstLeadingComment t loc with + let loc = get_loc node in + let start_pos = match get_first_leading_comment t loc with | None -> loc.loc_start | Some comment -> (Comment.loc comment).loc_start in - let sep = if startPos.pos_lnum - prevLoc.loc_end.pos_lnum > 1 then - Doc.concat [Doc.hardLine; Doc.hardLine] + 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.hardLine + Doc.hard_line in - let doc = printComments (print node t) t loc in + let doc = print_comments (print node t) t loc in loop loc (doc::sep::acc) nodes in match nodes with | [] -> Doc.nil | node::nodes -> - 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 + 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 in - Doc.breakableGroup ~forceBreak docs + Doc.breakable_group ~force_break docs - let printListi ~getLoc ~nodes ~print ?(forceBreak=false) t = - let rec loop i (prevLoc: Location.t) acc nodes = + let print_listi ~get_loc ~nodes ~print ?(force_break=false) t = + let rec loop i (prev_loc: Location.t) acc nodes = match nodes with - | [] -> (prevLoc, Doc.concat (List.rev acc)) + | [] -> (prev_loc, Doc.concat (List.rev acc)) | node::nodes -> - let loc = getLoc node in - let startPos = match getFirstLeadingComment t loc with + let loc = get_loc node in + let start_pos = match get_first_leading_comment t loc with | None -> loc.loc_start | Some comment -> (Comment.loc comment).loc_start in - let sep = if startPos.pos_lnum - prevLoc.loc_end.pos_lnum > 1 then - Doc.concat [Doc.hardLine; Doc.hardLine] + 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.line in - let doc = printComments (print node t i) t loc in + let doc = print_comments (print node t i) t loc in loop (i + 1) loc (doc::sep::acc) nodes in match nodes with | [] -> Doc.nil | node::nodes -> - 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 + 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 in - Doc.breakableGroup ~forceBreak docs + Doc.breakable_group ~force_break docs - let rec printLongidentAux accu = function + let rec print_longident_aux accu = function | Longident.Lident s -> (Doc.text s) :: accu - | Ldot(lid, s) -> printLongidentAux ((Doc.text s) :: accu) lid + | Ldot(lid, s) -> print_longident_aux ((Doc.text s) :: accu) lid | Lapply(lid1, lid2) -> - let d1 = Doc.join ~sep:Doc.dot (printLongidentAux [] lid1) in - let d2 = Doc.join ~sep:Doc.dot (printLongidentAux [] lid2) in + let d1 = Doc.join ~sep:Doc.dot (print_longident_aux [] lid1) in + let d2 = Doc.join ~sep:Doc.dot (print_longident_aux [] lid2) in (Doc.concat [d1; Doc.lparen; d2; Doc.rparen]) :: accu - let printLongident = function + let print_longident = function | Longident.Lident txt -> Doc.text txt - | lid -> Doc.join ~sep:Doc.dot (printLongidentAux [] lid) + | lid -> Doc.join ~sep:Doc.dot (print_longident_aux [] lid) - type identifierStyle = + type identifier_style = | ExoticIdent | NormalIdent - let classifyIdentContent ?(allowUident=false) txt = + let classify_ident_content ?(allow_uident=false) 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')) || + (allow_uident && (c >= 'A' && c <= 'Z')) || (c >= 'a' && c <= 'z') || c = '_' || (c >= '0' && c <= '9')) then ExoticIdent else if not ( @@ -6156,13 +6156,13 @@ module Printer = struct else go (i + 1) in - if Token.isKeywordTxt txt && txt <> "list" then + if Token.is_keyword_txt txt && txt <> "list" then ExoticIdent else go 0 - let printIdentLike ?allowUident txt = - match classifyIdentContent ?allowUident txt with + let print_ident_like ?allow_uident txt = + match classify_ident_content ?allow_uident txt with | ExoticIdent -> Doc.concat [ Doc.text "\\\""; Doc.text txt; @@ -6170,36 +6170,36 @@ module Printer = struct ] | NormalIdent -> Doc.text txt - let printLident l = match l with - | Longident.Lident txt -> printIdentLike txt + let print_lident l = match l with + | Longident.Lident txt -> print_ident_like txt | Longident.Ldot (path, txt) -> let txts = Longident.flatten path in Doc.concat [ Doc.join ~sep:Doc.dot (List.map Doc.text txts); Doc.dot; - printIdentLike txt; + print_ident_like txt; ] | _ -> Doc.text("printLident: Longident.Lapply is not supported") - let printLongidentLocation l cmtTbl = - let doc = printLongident l.Location.txt in - printComments doc cmtTbl l.loc + let print_longident_location l cmt_tbl = + let doc = print_longident l.Location.txt in + print_comments doc cmt_tbl l.loc (* Module.SubModule.x *) - let printLidentPath path cmtTbl = - let doc = printLident path.Location.txt in - printComments doc cmtTbl path.loc + let print_lident_path path cmt_tbl = + let doc = print_lident path.Location.txt in + print_comments doc cmt_tbl path.loc (* Module.SubModule.x or Module.SubModule.X *) - let printIdentPath path cmtTbl = - let doc = printLident path.Location.txt in - printComments doc cmtTbl path.loc + let print_ident_path path cmt_tbl = + let doc = print_lident path.Location.txt in + print_comments doc cmt_tbl path.loc - let printStringLoc sloc cmtTbl = - let doc = printIdentLike sloc.Location.txt in - printComments doc cmtTbl sloc.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 printConstant c = match c with + let print_constant c = match c with | Parsetree.Pconst_integer (s, suffix) -> begin match suffix with | Some c -> Doc.text (s ^ (Char.escaped c)) @@ -6215,86 +6215,86 @@ module Printer = struct | Pconst_float (s, _) -> Doc.text s | Pconst_char c -> Doc.text ("'" ^ (Char.escaped c) ^ "'") - let rec printStructure (s : Parsetree.structure) t = + let rec print_structure (s : Parsetree.structure) t = match s with - | [] -> printCommentsInside t Location.none + | [] -> print_comments_inside t Location.none | structure -> - printList - ~getLoc:(fun s -> s.Parsetree.pstr_loc) + print_list + ~get_loc:(fun s -> s.Parsetree.pstr_loc) ~nodes:structure - ~print:printStructureItem + ~print:print_structure_item t - and printStructureItem (si: Parsetree.structure_item) cmtTbl = + and print_structure_item (si: Parsetree.structure_item) cmt_tbl = match si.pstr_desc with - | Pstr_value(rec_flag, valueBindings) -> - let recFlag = match rec_flag with + | Pstr_value(rec_flag, value_bindings) -> + let rec_flag = match rec_flag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printValueBindings ~recFlag valueBindings cmtTbl - | Pstr_type(recFlag, typeDeclarations) -> - let recFlag = match recFlag with + print_value_bindings ~rec_flag value_bindings cmt_tbl + | Pstr_type(rec_flag, type_declarations) -> + let rec_flag = match rec_flag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~recFlag typeDeclarations cmtTbl - | Pstr_primitive valueDescription -> - printValueDescription valueDescription cmtTbl + print_type_declarations ~rec_flag type_declarations cmt_tbl + | Pstr_primitive value_description -> + print_value_description value_description cmt_tbl | Pstr_eval (expr, attrs) -> - let exprDoc = - let doc = printExpressionWithComments expr cmtTbl in - match Parens.structureExpr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + let expr_doc = + let doc = print_expression_with_comments expr cmt_tbl in + match Parens.structure_expr expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in Doc.concat [ - printAttributes attrs; - exprDoc; + print_attributes attrs; + expr_doc; ] | Pstr_attribute attr -> Doc.concat [ Doc.text "@"; - printAttributeWithComments attr cmtTbl + print_attribute_with_comments attr cmt_tbl ] | Pstr_extension (extension, attrs) -> Doc.concat [ - printAttributes attrs; - Doc.concat [printExtensionWithComments ~atModuleLvl:true extension cmtTbl]; + print_attributes attrs; + Doc.concat [print_extension_with_comments ~at_module_lvl:true extension cmt_tbl]; ] - | Pstr_include includeDeclaration -> - printIncludeDeclaration includeDeclaration cmtTbl - | Pstr_open openDescription -> - printOpenDescription openDescription cmtTbl - | Pstr_modtype modTypeDecl -> - printModuleTypeDeclaration modTypeDecl cmtTbl - | Pstr_module moduleBinding -> - printModuleBinding ~isRec:false moduleBinding cmtTbl 0 - | Pstr_recmodule moduleBindings -> - printListi - ~getLoc:(fun mb -> mb.Parsetree.pmb_loc) - ~nodes:moduleBindings - ~print:(printModuleBinding ~isRec:true) - cmtTbl - | Pstr_exception extensionConstructor -> - printExceptionDef extensionConstructor cmtTbl - | Pstr_typext typeExtension -> - printTypeExtension typeExtension cmtTbl + | Pstr_include include_declaration -> + print_include_declaration include_declaration cmt_tbl + | Pstr_open open_description -> + print_open_description open_description cmt_tbl + | Pstr_modtype mod_type_decl -> + print_module_type_declaration mod_type_decl cmt_tbl + | Pstr_module module_binding -> + print_module_binding ~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 ~is_rec:true) + cmt_tbl + | Pstr_exception extension_constructor -> + print_exception_def extension_constructor cmt_tbl + | Pstr_typext type_extension -> + print_type_extension type_extension cmt_tbl | Pstr_class _ | Pstr_class_type _ -> Doc.nil - and printTypeExtension (te : Parsetree.type_extension) cmtTbl = + and print_type_extension (te : Parsetree.type_extension) cmt_tbl = let prefix = Doc.text "type " in - let name = printLidentPath te.ptyext_path cmtTbl in - let typeParams = printTypeParams te.ptyext_params cmtTbl in - let extensionConstructors = + let name = print_lident_path te.ptyext_path cmt_tbl in + let type_params = print_type_params te.ptyext_params cmt_tbl in + let extension_constructors = let ecs = te.ptyext_constructors in - let forceBreak = + let force_break = 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 privateFlag = match te.ptyext_private with + let private_flag = match te.ptyext_private with | Asttypes.Private -> Doc.concat [ Doc.text "private"; Doc.line; @@ -6302,18 +6302,18 @@ module Printer = struct | Public -> Doc.nil in let rows = - printListi - ~getLoc:(fun n -> n.Parsetree.pext_loc) - ~print:printExtensionConstructor + print_listi + ~get_loc:(fun n -> n.Parsetree.pext_loc) + ~print:print_extension_constructor ~nodes: ecs - ~forceBreak - cmtTbl + ~force_break + cmt_tbl in - Doc.breakableGroup ~forceBreak ( + Doc.breakable_group ~force_break ( Doc.indent ( Doc.concat [ Doc.line; - privateFlag; + private_flag; rows; (* Doc.join ~sep:Doc.line ( *) (* List.mapi printExtensionConstructor ecs *) @@ -6324,83 +6324,83 @@ module Printer = struct in Doc.group ( Doc.concat [ - printAttributes ~loc: te.ptyext_path.loc te.ptyext_attributes; + print_attributes ~loc: te.ptyext_path.loc te.ptyext_attributes; prefix; name; - typeParams; + type_params; Doc.text " +="; - extensionConstructors; + extension_constructors; ] ) - and printModuleBinding ~isRec moduleBinding cmtTbl i = + and print_module_binding ~is_rec module_binding cmt_tbl i = let prefix = if i = 0 then Doc.concat [ Doc.text "module "; - if isRec then Doc.text "rec " else Doc.nil; + if is_rec then Doc.text "rec " else Doc.nil; ] else Doc.text "and " in - let (modExprDoc, modConstraintDoc) = - match moduleBinding.pmb_expr with - | {pmod_desc = Pmod_constraint (modExpr, modType)} -> + let (mod_expr_doc, mod_constraint_doc) = + match module_binding.pmb_expr with + | {pmod_desc = Pmod_constraint (mod_expr, mod_type)} -> ( - printModExpr modExpr cmtTbl, + print_mod_expr mod_expr cmt_tbl, Doc.concat [ Doc.text ": "; - printModType modType cmtTbl + print_mod_type mod_type cmt_tbl ] ) - | modExpr -> - (printModExpr modExpr cmtTbl, Doc.nil) + | mod_expr -> + (print_mod_expr mod_expr cmt_tbl, Doc.nil) in - let modName = - let doc = Doc.text moduleBinding.pmb_name.Location.txt in - printComments doc cmtTbl moduleBinding.pmb_name.loc + let mod_name = + let doc = Doc.text module_binding.pmb_name.Location.txt in + print_comments doc cmt_tbl module_binding.pmb_name.loc in let doc = Doc.concat [ - printAttributes ~loc:moduleBinding.pmb_name.loc moduleBinding.pmb_attributes; + print_attributes ~loc:module_binding.pmb_name.loc module_binding.pmb_attributes; prefix; - modName; - modConstraintDoc; + mod_name; + mod_constraint_doc; Doc.text " = "; - modExprDoc; + mod_expr_doc; ] in - printComments doc cmtTbl moduleBinding.pmb_loc + print_comments doc cmt_tbl module_binding.pmb_loc - and printModuleTypeDeclaration (modTypeDecl : Parsetree.module_type_declaration) cmtTbl = - let modName = - let doc = Doc.text modTypeDecl.pmtd_name.txt in - printComments doc cmtTbl modTypeDecl.pmtd_name.loc + and print_module_type_declaration (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 in Doc.concat [ - printAttributes modTypeDecl.pmtd_attributes; + print_attributes mod_type_decl.pmtd_attributes; Doc.text "module type "; - modName; - (match modTypeDecl.pmtd_type with + mod_name; + (match mod_type_decl.pmtd_type with | None -> Doc.nil - | Some modType -> Doc.concat [ + | Some mod_type -> Doc.concat [ Doc.text " = "; - printModType modType cmtTbl; + print_mod_type mod_type cmt_tbl; ]); ] - and printModType modType cmtTbl = - let modTypeDoc = match modType.pmty_desc with + and print_mod_type mod_type cmt_tbl = + let mod_type_doc = match mod_type.pmty_desc with | Parsetree.Pmty_ident longident -> Doc.concat [ - printAttributes ~loc:longident.loc modType.pmty_attributes; - printLongidentLocation longident cmtTbl + print_attributes ~loc:longident.loc mod_type.pmty_attributes; + print_longident_location longident cmt_tbl ] | Pmty_signature signature -> - let signatureDoc = Doc.breakableGroup ~forceBreak:true ( + let signature_doc = Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.lbrace; Doc.indent ( Doc.concat [ Doc.line; - printSignature signature cmtTbl; + print_signature signature cmt_tbl; ] ); Doc.line; @@ -6408,103 +6408,103 @@ module Printer = struct ] ) in Doc.concat [ - printAttributes modType.pmty_attributes; - signatureDoc + print_attributes mod_type.pmty_attributes; + signature_doc ] | Pmty_functor _ -> - let (parameters, returnType) = ParsetreeViewer.functorType modType in - let parametersDoc = match parameters with + let (parameters, return_type) = ParsetreeViewer.functor_type mod_type in + let parameters_doc = match parameters with | [] -> Doc.nil - | [attrs, {Location.txt = "_"; loc}, Some modType] -> - let cmtLoc = - {loc with loc_end = modType.Parsetree.pmty_loc.loc_end} + | [attrs, {Location.txt = "_"; loc}, Some mod_type] -> + let cmt_loc = + {loc with loc_end = mod_type.Parsetree.pmty_loc.loc_end} in let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.line; ] in let doc = Doc.concat [ attrs; - printModType modType cmtTbl + print_mod_type mod_type cmt_tbl ] in - printComments doc cmtTbl cmtLoc + print_comments doc cmt_tbl cmt_loc | params -> Doc.group ( Doc.concat [ Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun (attrs, lbl, modType) -> - let cmtLoc = match modType with + List.map (fun (attrs, lbl, mod_type) -> + let cmt_loc = match mod_type with | None -> lbl.Asttypes.loc - | Some modType -> - {lbl.Asttypes.loc with loc_end = modType.Parsetree.pmty_loc.loc_end} + | Some mod_type -> + {lbl.Asttypes.loc with loc_end = mod_type.Parsetree.pmty_loc.loc_end} in let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.line; ] in - let lblDoc = if lbl.Location.txt = "_" then Doc.nil + let lbl_doc = if lbl.Location.txt = "_" then Doc.nil else let doc = Doc.text lbl.txt in - printComments doc cmtTbl lbl.loc + print_comments doc cmt_tbl lbl.loc in let doc = Doc.concat [ attrs; - lblDoc; - (match modType with + lbl_doc; + (match mod_type with | None -> Doc.nil - | Some modType -> Doc.concat [ + | Some mod_type -> Doc.concat [ if lbl.txt = "_" then Doc.nil else Doc.text ": "; - printModType modType cmtTbl; + print_mod_type mod_type cmt_tbl; ]); ] in - printComments doc cmtTbl cmtLoc + print_comments doc cmt_tbl cmt_loc ) params ); ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) in - let returnDoc = - let doc = printModType returnType cmtTbl in - if Parens.modTypeFunctorReturn returnType then addParens doc else doc + let return_doc = + let doc = print_mod_type return_type cmt_tbl in + if Parens.mod_type_functor_return return_type then add_parens doc else doc in Doc.group ( Doc.concat [ - parametersDoc; + parameters_doc; Doc.group ( Doc.concat [ Doc.text " =>"; Doc.line; - returnDoc; + return_doc; ] ) ] ) - | Pmty_typeof modExpr -> Doc.concat [ + | Pmty_typeof mod_expr -> Doc.concat [ Doc.text "module type of "; - printModExpr modExpr cmtTbl + print_mod_expr mod_expr cmt_tbl ] - | Pmty_extension extension -> printExtensionWithComments ~atModuleLvl:false extension cmtTbl + | Pmty_extension extension -> print_extension_with_comments ~at_module_lvl:false extension cmt_tbl | Pmty_alias longident -> Doc.concat [ Doc.text "module "; - printLongidentLocation longident cmtTbl; + print_longident_location longident cmt_tbl; ] - | Pmty_with (modType, withConstraints) -> + | Pmty_with (mod_type, with_constraints) -> let operand = - let doc = printModType modType cmtTbl in - if Parens.modTypeWithOperand modType then addParens doc else doc + let doc = print_mod_type mod_type cmt_tbl in + if Parens.mod_type_with_operand mod_type then add_parens doc else doc in Doc.group ( Doc.concat [ @@ -6512,243 +6512,243 @@ module Printer = struct Doc.indent ( Doc.concat [ Doc.line; - printWithConstraints withConstraints cmtTbl; + print_with_constraints with_constraints cmt_tbl; ] ) ] ) in - let attrsAlreadyPrinted = match modType.pmty_desc with + let attrs_already_printed = match mod_type.pmty_desc with | Pmty_functor _ | Pmty_signature _ | Pmty_ident _ -> true | _ -> false in let doc =Doc.concat [ - if attrsAlreadyPrinted then Doc.nil else printAttributes modType.pmty_attributes; - modTypeDoc; + if attrs_already_printed then Doc.nil else print_attributes mod_type.pmty_attributes; + mod_type_doc; ] in - printComments doc cmtTbl modType.pmty_loc + print_comments doc cmt_tbl mod_type.pmty_loc - and printWithConstraints withConstraints cmtTbl = - let rows = List.mapi (fun i withConstraint -> + and print_with_constraints with_constraints cmt_tbl = + let rows = List.mapi (fun i with_constraint -> Doc.group ( Doc.concat [ if i == 0 then Doc.text "with " else Doc.text "and "; - printWithConstraint withConstraint cmtTbl; + print_with_constraint with_constraint cmt_tbl; ] ) - ) withConstraints + ) with_constraints in Doc.join ~sep:Doc.line rows - and printWithConstraint (withConstraint : Parsetree.with_constraint) cmtTbl = - match withConstraint with + and print_with_constraint (with_constraint : Parsetree.with_constraint) cmt_tbl = + match with_constraint with (* with type X.t = ... *) - | Pwith_type (longident, typeDeclaration) -> - Doc.group (printTypeDeclaration - ~name:(printLidentPath longident cmtTbl) - ~equalSign:"=" - ~recFlag:Doc.nil + | Pwith_type (longident, type_declaration) -> + Doc.group (print_type_declaration + ~name:(print_lident_path longident cmt_tbl) + ~equal_sign:"=" + ~rec_flag:Doc.nil 0 - typeDeclaration + type_declaration CommentTable.empty) (* with module X.Y = Z *) | Pwith_module ({txt = longident1}, {txt = longident2}) -> Doc.concat [ Doc.text "module "; - printLongident longident1; + print_longident longident1; Doc.text " ="; Doc.indent ( Doc.concat [ Doc.line; - printLongident longident2; + print_longident longident2; ] ) ] (* with type X.t := ..., same format as [Pwith_type] *) - | Pwith_typesubst (longident, typeDeclaration) -> - Doc.group(printTypeDeclaration - ~name:(printLidentPath longident cmtTbl) - ~equalSign:":=" - ~recFlag:Doc.nil + | Pwith_typesubst (longident, type_declaration) -> + Doc.group(print_type_declaration + ~name:(print_lident_path longident cmt_tbl) + ~equal_sign:":=" + ~rec_flag:Doc.nil 0 - typeDeclaration + type_declaration CommentTable.empty) | Pwith_modsubst ({txt = longident1}, {txt = longident2}) -> Doc.concat [ Doc.text "module "; - printLongident longident1; + print_longident longident1; Doc.text " :="; Doc.indent ( Doc.concat [ Doc.line; - printLongident longident2; + print_longident longident2; ] ) ] - and printSignature signature cmtTbl = + and print_signature signature cmt_tbl = match signature with - | [] -> printCommentsInside cmtTbl Location.none + | [] -> print_comments_inside cmt_tbl Location.none | signature -> - printList - ~getLoc:(fun s -> s.Parsetree.psig_loc) + print_list + ~get_loc:(fun s -> s.Parsetree.psig_loc) ~nodes:signature - ~print:printSignatureItem - cmtTbl + ~print:print_signature_item + cmt_tbl - and printSignatureItem (si : Parsetree.signature_item) cmtTbl = + and print_signature_item (si : Parsetree.signature_item) cmt_tbl = match si.psig_desc with - | Parsetree.Psig_value valueDescription -> - printValueDescription valueDescription cmtTbl - | Psig_type (recFlag, typeDeclarations) -> - let recFlag = match recFlag with + | Parsetree.Psig_value value_description -> + print_value_description value_description cmt_tbl + | Psig_type (rec_flag, type_declarations) -> + let rec_flag = match rec_flag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~recFlag typeDeclarations cmtTbl - | Psig_typext typeExtension -> - printTypeExtension typeExtension cmtTbl - | Psig_exception extensionConstructor -> - printExceptionDef extensionConstructor cmtTbl - | Psig_module moduleDeclaration -> - printModuleDeclaration moduleDeclaration cmtTbl - | Psig_recmodule moduleDeclarations -> - printRecModuleDeclarations moduleDeclarations cmtTbl - | Psig_modtype modTypeDecl -> - printModuleTypeDeclaration modTypeDecl cmtTbl - | Psig_open openDescription -> - printOpenDescription openDescription cmtTbl - | Psig_include includeDescription -> - printIncludeDescription includeDescription cmtTbl + print_type_declarations ~rec_flag type_declarations cmt_tbl + | Psig_typext type_extension -> + print_type_extension type_extension cmt_tbl + | Psig_exception extension_constructor -> + print_exception_def extension_constructor cmt_tbl + | Psig_module module_declaration -> + print_module_declaration module_declaration cmt_tbl + | Psig_recmodule module_declarations -> + print_rec_module_declarations module_declarations cmt_tbl + | Psig_modtype mod_type_decl -> + print_module_type_declaration mod_type_decl cmt_tbl + | Psig_open open_description -> + print_open_description open_description cmt_tbl + | Psig_include include_description -> + print_include_description include_description cmt_tbl | Psig_attribute attr -> Doc.concat [ Doc.text "@"; - printAttributeWithComments attr cmtTbl + print_attribute_with_comments attr cmt_tbl ] | Psig_extension (extension, attrs) -> Doc.concat [ - printAttributes attrs; - Doc.concat [printExtensionWithComments ~atModuleLvl:true extension cmtTbl]; + print_attributes attrs; + Doc.concat [print_extension_with_comments ~at_module_lvl:true extension cmt_tbl]; ] | Psig_class _ | Psig_class_type _ -> Doc.nil - and printRecModuleDeclarations moduleDeclarations cmtTbl = - printListi - ~getLoc:(fun n -> n.Parsetree.pmd_loc) - ~nodes:moduleDeclarations - ~print:printRecModuleDeclaration - cmtTbl + and print_rec_module_declarations module_declarations cmt_tbl = + print_listi + ~get_loc:(fun n -> n.Parsetree.pmd_loc) + ~nodes:module_declarations + ~print:print_rec_module_declaration + cmt_tbl - and printRecModuleDeclaration md cmtTbl i = + and print_rec_module_declaration md cmt_tbl i = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> - Doc.concat [Doc.text " = "; printLongidentLocation longident cmtTbl] + Doc.concat [Doc.text " = "; print_longident_location longident cmt_tbl] | _ -> - let needsParens = match md.pmd_type.pmty_desc with + let needs_parens = match md.pmd_type.pmty_desc with | Pmty_with _ -> true | _ -> false in - let modTypeDoc = - let doc = printModType md.pmd_type cmtTbl in - if needsParens then addParens doc else doc + let mod_type_doc = + let doc = print_mod_type md.pmd_type cmt_tbl in + if needs_parens then add_parens doc else doc in - Doc.concat [Doc.text ": "; modTypeDoc] + Doc.concat [Doc.text ": "; mod_type_doc] in let prefix = if i < 1 then "module rec " else "and " in Doc.concat [ - printAttributes ~loc:md.pmd_name.loc md.pmd_attributes; + print_attributes ~loc:md.pmd_name.loc md.pmd_attributes; Doc.text prefix; - printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; + print_comments (Doc.text md.pmd_name.txt) cmt_tbl md.pmd_name.loc; body ] - and printModuleDeclaration (md: Parsetree.module_declaration) cmtTbl = + and print_module_declaration (md: Parsetree.module_declaration) cmt_tbl = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> - Doc.concat [Doc.text " = "; printLongidentLocation longident cmtTbl] - | _ -> Doc.concat [Doc.text ": "; printModType md.pmd_type cmtTbl] + Doc.concat [Doc.text " = "; print_longident_location longident cmt_tbl] + | _ -> Doc.concat [Doc.text ": "; print_mod_type md.pmd_type cmt_tbl] in Doc.concat [ - printAttributes ~loc:md.pmd_name.loc md.pmd_attributes; + print_attributes ~loc:md.pmd_name.loc md.pmd_attributes; Doc.text "module "; - printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; + print_comments (Doc.text md.pmd_name.txt) cmt_tbl md.pmd_name.loc; body ] - and printOpenDescription (openDescription : Parsetree.open_description) p = + and print_open_description (open_description : Parsetree.open_description) p = Doc.concat [ - printAttributes openDescription.popen_attributes; + print_attributes open_description.popen_attributes; Doc.text "open"; - (match openDescription.popen_override with + (match open_description.popen_override with | Asttypes.Fresh -> Doc.space | Asttypes.Override -> Doc.text "! "); - printLongidentLocation openDescription.popen_lid p + print_longident_location open_description.popen_lid p ] - and printIncludeDescription (includeDescription: Parsetree.include_description) cmtTbl = + and print_include_description (include_description: Parsetree.include_description) cmt_tbl = Doc.concat [ - printAttributes includeDescription.pincl_attributes; + print_attributes include_description.pincl_attributes; Doc.text "include "; - printModType includeDescription.pincl_mod cmtTbl; + print_mod_type include_description.pincl_mod cmt_tbl; ] - and printIncludeDeclaration (includeDeclaration : Parsetree.include_declaration) cmtTbl = - let isJsFfiImport = List.exists (fun attr -> + and print_include_declaration (include_declaration : Parsetree.include_declaration) cmt_tbl = + let is_js_ffi_import = List.exists (fun attr -> match attr with | ({Location.txt = "ns.jsFfi"}, _) -> true | _ -> false - ) includeDeclaration.pincl_attributes + ) include_declaration.pincl_attributes in - if isJsFfiImport then - printJsFfiImportDeclaration includeDeclaration cmtTbl + if is_js_ffi_import then + print_js_ffi_import_declaration include_declaration cmt_tbl else Doc.concat [ - printAttributes includeDeclaration.pincl_attributes; + print_attributes include_declaration.pincl_attributes; Doc.text "include "; - let includeDoc = - printModExpr includeDeclaration.pincl_mod cmtTbl + let include_doc = + print_mod_expr include_declaration.pincl_mod cmt_tbl in - if Parens.includeModExpr includeDeclaration.pincl_mod then - addParens includeDoc - else includeDoc; + if Parens.include_mod_expr include_declaration.pincl_mod then + add_parens include_doc + else include_doc; ] - and printJsFfiImport (valueDescription: Parsetree.value_description) cmtTbl = + and print_js_ffi_import (value_description: Parsetree.value_description) cmt_tbl = let attrs = List.filter (fun attr -> match attr with | ({Location.txt = "val" | "genType.import" | "scope" }, _) -> false | _ -> true - ) valueDescription.pval_attributes in - let (ident, alias) = match valueDescription.pval_prim with + ) value_description.pval_attributes in + let (ident, alias) = match value_description.pval_prim with | primitive::_ -> - if primitive <> valueDescription.pval_name.txt then + if primitive <> value_description.pval_name.txt then ( - printIdentLike primitive, + print_ident_like primitive, Doc.concat [ Doc.text " as "; - printIdentLike valueDescription.pval_name.txt; + print_ident_like value_description.pval_name.txt; ] ) else - (printIdentLike primitive, Doc.nil) + (print_ident_like primitive, Doc.nil) | _ -> - (printIdentLike valueDescription.pval_name.txt, Doc.nil) + (print_ident_like value_description.pval_name.txt, Doc.nil) in Doc.concat [ - printAttributes ~loc:valueDescription.pval_name.loc attrs; + print_attributes ~loc:value_description.pval_name.loc attrs; ident; alias; Doc.text ": "; - printTypExpr valueDescription.pval_type cmtTbl; + print_typ_expr value_description.pval_type cmt_tbl; ] - and printJsFfiImportScope (scope: ParsetreeViewer.jsImportScope) = + and print_js_ffi_import_scope (scope: ParsetreeViewer.js_import_scope) = match scope with | JsGlobalImport -> Doc.nil - | JsModuleImport modName -> + | JsModuleImport mod_name -> Doc.concat [ Doc.text " from "; - Doc.doubleQuote; - Doc.text modName; - Doc.doubleQuote; + Doc.double_quote; + Doc.text mod_name; + Doc.double_quote; ] | JsScopedImport idents -> Doc.concat [ @@ -6756,65 +6756,65 @@ module Printer = struct Doc.join ~sep:Doc.dot (List.map Doc.text idents) ] - and printJsFfiImportDeclaration (includeDeclaration: Parsetree.include_declaration) cmtTbl = + and print_js_ffi_import_declaration (include_declaration: Parsetree.include_declaration) cmt_tbl = let attrs = List.filter (fun attr -> match attr with | ({Location.txt = "ns.jsFfi"}, _) -> false | _ -> true - ) includeDeclaration.pincl_attributes + ) include_declaration.pincl_attributes in - let imports = ParsetreeViewer.extractValueDescriptionFromModExpr includeDeclaration.pincl_mod in + let imports = ParsetreeViewer.extract_value_description_from_mod_expr include_declaration.pincl_mod in let scope = match imports with - | vd::_ -> ParsetreeViewer.classifyJsImport vd + | vd::_ -> ParsetreeViewer.classify_js_import vd | [] -> ParsetreeViewer.JsGlobalImport in - let scopeDoc = printJsFfiImportScope scope in + let scope_doc = print_js_ffi_import_scope scope in Doc.group ( Doc.concat [ - printAttributes attrs; + print_attributes attrs; Doc.text "import "; Doc.group ( Doc.concat [ Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun vd -> printJsFfiImport vd cmtTbl) imports + List.map (fun vd -> print_js_ffi_import vd cmt_tbl) imports ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ] ); - scopeDoc; + scope_doc; ] ) - and printValueBindings ~recFlag (vbs: Parsetree.value_binding list) cmtTbl = - printListi - ~getLoc:(fun vb -> vb.Parsetree.pvb_loc) + and print_value_bindings ~rec_flag (vbs: Parsetree.value_binding list) cmt_tbl = + print_listi + ~get_loc:(fun vb -> vb.Parsetree.pvb_loc) ~nodes:vbs - ~print:(printValueBinding ~recFlag) - cmtTbl + ~print:(print_value_binding ~rec_flag) + cmt_tbl - and printValueDescription valueDescription cmtTbl = - let isExternal = - match valueDescription.pval_prim with | [] -> false | _ -> true + and print_value_description value_description cmt_tbl = + let is_external = + match value_description.pval_prim with | [] -> false | _ -> true in Doc.group ( Doc.concat [ - printAttributes valueDescription.pval_attributes; - Doc.text (if isExternal then "external " else "let "); - printComments - (printIdentLike valueDescription.pval_name.txt) - cmtTbl - valueDescription.pval_name.loc; + print_attributes value_description.pval_attributes; + Doc.text (if is_external then "external " else "let "); + print_comments + (print_ident_like value_description.pval_name.txt) + cmt_tbl + value_description.pval_name.loc; Doc.text ": "; - printTypExpr valueDescription.pval_type cmtTbl; - if isExternal then + print_typ_expr value_description.pval_type cmt_tbl; + if is_external then Doc.group ( Doc.concat [ Doc.text " ="; @@ -6827,7 +6827,7 @@ module Printer = struct Doc.text s; Doc.text "\""; ]) - valueDescription.pval_prim + value_description.pval_prim ); ] ) @@ -6837,12 +6837,12 @@ module Printer = struct ] ) - and printTypeDeclarations ~recFlag typeDeclarations cmtTbl = - printListi - ~getLoc:(fun n -> n.Parsetree.ptype_loc) - ~nodes:typeDeclarations - ~print:(printTypeDeclaration2 ~recFlag) - cmtTbl + and print_type_declarations ~rec_flag type_declarations cmt_tbl = + print_listi + ~get_loc:(fun n -> n.Parsetree.ptype_loc) + ~nodes:type_declarations + ~print:(print_type_declaration2 ~rec_flag) + cmt_tbl (* * type_declaration = { @@ -6876,156 +6876,156 @@ module Printer = struct * (* Invariant: non-empty list *) * | Ptype_open *) - and printTypeDeclaration ~name ~equalSign ~recFlag i (td: Parsetree.type_declaration) cmtTbl = - let (hasGenType, attrs) = ParsetreeViewer.splitGenTypeAttr td.ptype_attributes in - let attrs = printAttributes ~loc:td.ptype_loc attrs in + and print_type_declaration ~name ~equal_sign ~rec_flag i (td: Parsetree.type_declaration) cmt_tbl = + let (has_gen_type, attrs) = ParsetreeViewer.split_gen_type_attr td.ptype_attributes in + let attrs = print_attributes ~loc:td.ptype_loc attrs in let prefix = if i > 0 then Doc.concat [ Doc.text "and "; - if hasGenType then Doc.text "export " else Doc.nil + if has_gen_type then Doc.text "export " else Doc.nil ] else Doc.concat [ - Doc.text (if hasGenType then "export type " else "type "); - recFlag + Doc.text (if has_gen_type then "export type " else "type "); + rec_flag ] in - let typeName = name in - let typeParams = printTypeParams td.ptype_params cmtTbl in - let manifestAndKind = match td.ptype_kind with + let type_name = name in + let type_params = print_type_params td.ptype_params cmt_tbl in + let manifest_and_kind = match td.ptype_kind with | Ptype_abstract -> begin match td.ptype_manifest with | None -> Doc.nil | Some(typ) -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; - printTypExpr typ cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; + print_typ_expr typ cmt_tbl; ] end | Ptype_open -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; Doc.text ".."; ] | Ptype_record(lds) -> let manifest = match td.ptype_manifest with | None -> Doc.nil | Some(typ) -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr typ cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_typ_expr typ cmt_tbl; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; - printRecordDeclaration lds cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; + print_record_declaration lds cmt_tbl; ] | Ptype_variant(cds) -> let manifest = match td.ptype_manifest with | None -> Doc.nil | Some(typ) -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr typ cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_typ_expr typ cmt_tbl; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~privateFlag:td.ptype_private cds cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign]; + print_constructor_declarations ~private_flag:td.ptype_private cds cmt_tbl; ] in - let constraints = printTypeDefinitionConstraints td.ptype_cstrs in + let constraints = print_type_definition_constraints td.ptype_cstrs in Doc.group ( Doc.concat [ attrs; prefix; - typeName; - typeParams; - manifestAndKind; + type_name; + type_params; + manifest_and_kind; constraints; ] ) - and printTypeDeclaration2 ~recFlag (td: Parsetree.type_declaration) cmtTbl i = + and print_type_declaration2 ~rec_flag (td: Parsetree.type_declaration) cmt_tbl i = let name = - let doc = printIdentLike td.Parsetree.ptype_name.txt in - printComments doc cmtTbl td.ptype_name.loc + let doc = print_ident_like td.Parsetree.ptype_name.txt in + print_comments doc cmt_tbl td.ptype_name.loc in - let equalSign = "=" in - let (hasGenType, attrs) = ParsetreeViewer.splitGenTypeAttr td.ptype_attributes in - let attrs = printAttributes ~loc:td.ptype_loc attrs in + let equal_sign = "=" in + let (has_gen_type, attrs) = ParsetreeViewer.split_gen_type_attr td.ptype_attributes in + let attrs = print_attributes ~loc:td.ptype_loc attrs in let prefix = if i > 0 then Doc.concat [ Doc.text "and "; - if hasGenType then Doc.text "export " else Doc.nil + if has_gen_type then Doc.text "export " else Doc.nil ] else Doc.concat [ - Doc.text (if hasGenType then "export type " else "type "); - recFlag + Doc.text (if has_gen_type then "export type " else "type "); + rec_flag ] in - let typeName = name in - let typeParams = printTypeParams td.ptype_params cmtTbl in - let manifestAndKind = match td.ptype_kind with + let type_name = name in + let type_params = print_type_params td.ptype_params cmt_tbl in + let manifest_and_kind = match td.ptype_kind with | Ptype_abstract -> begin match td.ptype_manifest with | None -> Doc.nil | Some(typ) -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; - printTypExpr typ cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; + print_typ_expr typ cmt_tbl; ] end | Ptype_open -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; Doc.text ".."; ] | Ptype_record(lds) -> let manifest = match td.ptype_manifest with | None -> Doc.nil | Some(typ) -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr typ cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_typ_expr typ cmt_tbl; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; - printRecordDeclaration lds cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; + print_record_declaration lds cmt_tbl; ] | Ptype_variant(cds) -> let manifest = match td.ptype_manifest with | None -> Doc.nil | Some(typ) -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr typ cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_typ_expr typ cmt_tbl; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~privateFlag:td.ptype_private cds cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign]; + print_constructor_declarations ~private_flag:td.ptype_private cds cmt_tbl; ] in - let constraints = printTypeDefinitionConstraints td.ptype_cstrs in + let constraints = print_type_definition_constraints td.ptype_cstrs in Doc.group ( Doc.concat [ attrs; prefix; - typeName; - typeParams; - manifestAndKind; + type_name; + type_params; + manifest_and_kind; constraints; ] ) - and printTypeDefinitionConstraints cstrs = + and print_type_definition_constraints cstrs = match cstrs with | [] -> Doc.nil | cstrs -> Doc.indent ( @@ -7034,95 +7034,95 @@ module Printer = struct Doc.line; Doc.group( Doc.join ~sep:Doc.line ( - List.map printTypeDefinitionConstraint cstrs + List.map print_type_definition_constraint cstrs ) ) ] ) ) - and printTypeDefinitionConstraint ((typ1, typ2, _loc ): Parsetree.core_type * Parsetree.core_type * Location.t) = + and print_type_definition_constraint ((typ1, typ2, _loc ): Parsetree.core_type * Parsetree.core_type * Location.t) = Doc.concat [ Doc.text "constraint "; - printTypExpr typ1 CommentTable.empty; + print_typ_expr typ1 CommentTable.empty; Doc.text " = "; - printTypExpr typ2 CommentTable.empty; + print_typ_expr typ2 CommentTable.empty; ] - and printPrivateFlag (flag : Asttypes.private_flag) = match flag with + and print_private_flag (flag : Asttypes.private_flag) = match flag with | Private -> Doc.text "private " | Public -> Doc.nil - and printTypeParams typeParams cmtTbl = - match typeParams with + and print_type_params type_params cmt_tbl = + match type_params with | [] -> Doc.nil - | typeParams -> + | type_params -> Doc.group ( Doc.concat [ - Doc.lessThan; + Doc.less_than; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun typeParam -> - let doc = printTypeParam typeParam cmtTbl in - printComments doc cmtTbl (fst typeParam).Parsetree.ptyp_loc - ) typeParams + List.map (fun type_param -> + let doc = print_type_param type_param cmt_tbl in + print_comments doc cmt_tbl (fst type_param).Parsetree.ptyp_loc + ) type_params ) ] ); - Doc.trailingComma; - Doc.softLine; - Doc.greaterThan; + Doc.trailing_comma; + Doc.soft_line; + Doc.greater_than; ] ) - and printTypeParam (param : (Parsetree.core_type * Asttypes.variance)) cmtTbl = + and print_type_param (param : (Parsetree.core_type * Asttypes.variance)) cmt_tbl = let (typ, variance) = param in - let printedVariance = match variance with + let printed_variance = match variance with | Covariant -> Doc.text "+" | Contravariant -> Doc.text "-" | Invariant -> Doc.nil in Doc.concat [ - printedVariance; - printTypExpr typ cmtTbl + printed_variance; + print_typ_expr typ cmt_tbl ] - and printRecordDeclaration (lds: Parsetree.label_declaration list) cmtTbl = - let forceBreak = match (lds, List.rev lds) with + and print_record_declaration (lds: Parsetree.label_declaration list) cmt_tbl = + let force_break = 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.breakableGroup ~forceBreak ( + Doc.breakable_group ~force_break ( Doc.concat [ Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = printLabelDeclaration ld cmtTbl in - printComments doc cmtTbl ld.Parsetree.pld_loc + let doc = print_label_declaration ld cmt_tbl in + print_comments doc cmt_tbl ld.Parsetree.pld_loc ) lds) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ] ) - and printConstructorDeclarations - ~privateFlag (cds: Parsetree.constructor_declaration list) cmtTbl + and print_constructor_declarations + ~private_flag (cds: Parsetree.constructor_declaration list) cmt_tbl = - let forceBreak = match (cds, List.rev cds) with + let force_break = 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 privateFlag = match privateFlag with + let private_flag = match private_flag with | Asttypes.Private -> Doc.concat [ Doc.text "private"; Doc.line; @@ -7130,42 +7130,42 @@ module Printer = struct | Public -> Doc.nil in let rows = - printListi - ~getLoc:(fun cd -> cd.Parsetree.pcd_loc) + print_listi + ~get_loc:(fun cd -> cd.Parsetree.pcd_loc) ~nodes:cds - ~print:(fun cd cmtTbl i -> - let doc = printConstructorDeclaration2 i cd cmtTbl in - printComments doc cmtTbl cd.Parsetree.pcd_loc + ~print:(fun cd cmt_tbl i -> + let doc = print_constructor_declaration2 i cd cmt_tbl in + print_comments doc cmt_tbl cd.Parsetree.pcd_loc ) - ~forceBreak - cmtTbl + ~force_break + cmt_tbl in - Doc.breakableGroup ~forceBreak ( + Doc.breakable_group ~force_break ( Doc.indent ( Doc.concat [ Doc.line; - privateFlag; + private_flag; rows; ] ) ) - and printConstructorDeclaration2 i (cd : Parsetree.constructor_declaration) cmtTbl = - let attrs = printAttributes cd.pcd_attributes in + and print_constructor_declaration2 i (cd : Parsetree.constructor_declaration) cmt_tbl = + let attrs = print_attributes cd.pcd_attributes in let bar = if i > 0 then Doc.text "| " - else Doc.ifBreaks (Doc.text "| ") Doc.nil + else Doc.if_breaks (Doc.text "| ") Doc.nil in - let constrName = + let constr_name = let doc = Doc.text cd.pcd_name.txt in - printComments doc cmtTbl cd.pcd_name.loc + print_comments doc cmt_tbl cd.pcd_name.loc in - let constrArgs = printConstructorArguments ~indent:true cd.pcd_args cmtTbl in + let constr_args = print_constructor_arguments ~indent:true cd.pcd_args cmt_tbl in let gadt = match cd.pcd_res with | None -> Doc.nil | Some(typ) -> Doc.indent ( Doc.concat [ Doc.text ": "; - printTypExpr typ cmtTbl; + print_typ_expr typ cmt_tbl; ] ) in @@ -7174,31 +7174,31 @@ module Printer = struct Doc.group ( Doc.concat [ attrs; (* TODO: fix parsing of attributes, so when can print them above the bar? *) - constrName; - constrArgs; + constr_name; + constr_args; gadt; ] ) ] - and printConstructorArguments ~indent (cdArgs : Parsetree.constructor_arguments) cmtTbl = - match cdArgs with + and print_constructor_arguments ~indent (cd_args : Parsetree.constructor_arguments) cmt_tbl = + match cd_args with | Pcstr_tuple [] -> Doc.nil | Pcstr_tuple types -> let args = Doc.concat [ Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( List.map (fun typexpr -> - printTypExpr typexpr cmtTbl + print_typ_expr typexpr cmt_tbl ) types ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] in Doc.group ( @@ -7211,180 +7211,180 @@ module Printer = struct Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = printLabelDeclaration ld cmtTbl in - printComments doc cmtTbl ld.Parsetree.pld_loc + let doc = print_label_declaration ld cmt_tbl in + print_comments doc cmt_tbl ld.Parsetree.pld_loc ) lds) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; Doc.rparen; ] in if indent then Doc.indent args else args - and printLabelDeclaration (ld : Parsetree.label_declaration) cmtTbl = - let attrs = printAttributes ~loc:ld.pld_name.loc ld.pld_attributes in - let mutableFlag = match ld.pld_mutable with + and print_label_declaration (ld : Parsetree.label_declaration) cmt_tbl = + let attrs = print_attributes ~loc:ld.pld_name.loc ld.pld_attributes in + let mutable_flag = match ld.pld_mutable with | Mutable -> Doc.text "mutable " | Immutable -> Doc.nil in let name = - let doc = printIdentLike ld.pld_name.txt in - printComments doc cmtTbl ld.pld_name.loc + let doc = print_ident_like ld.pld_name.txt in + print_comments doc cmt_tbl ld.pld_name.loc in Doc.group ( Doc.concat [ attrs; - mutableFlag; + mutable_flag; name; Doc.text ": "; - printTypExpr ld.pld_type cmtTbl; + print_typ_expr ld.pld_type cmt_tbl; ] ) - and printTypExpr (typExpr : Parsetree.core_type) cmtTbl = - let renderedType = match typExpr.ptyp_desc with + and print_typ_expr (typ_expr : Parsetree.core_type) cmt_tbl = + let rendered_type = match typ_expr.ptyp_desc with | Ptyp_any -> Doc.text "_" | Ptyp_var var -> Doc.concat [ Doc.text "'"; - printIdentLike var; + print_ident_like var; ] | Ptyp_extension(extension) -> - printExtensionWithComments ~atModuleLvl:false extension cmtTbl + print_extension_with_comments ~at_module_lvl:false extension cmt_tbl | 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 needsParens = match typ.ptyp_desc with + let needs_parens = match typ.ptyp_desc with | Ptyp_arrow _ -> true | _ -> false in - let doc = printTypExpr typ cmtTbl in - if needsParens then + let doc = print_typ_expr typ cmt_tbl in + if needs_parens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - Doc.concat [typ; Doc.text " as "; Doc.concat [Doc.text "'"; printIdentLike alias]] + Doc.concat [typ; Doc.text " as "; Doc.concat [Doc.text "'"; print_ident_like alias]] | Ptyp_constr({txt = Longident.Ldot(Longident.Lident "Js", "t")}, [{ptyp_desc = Ptyp_object (_fields, _openFlag)} as typ]) -> - let bsObject = printTypExpr typ cmtTbl in - begin match typExpr.ptyp_attributes with - | [] -> bsObject + let bs_object = print_typ_expr typ cmt_tbl in + begin match typ_expr.ptyp_attributes with + | [] -> bs_object | attrs -> Doc.concat [ Doc.group ( - Doc.join ~sep:Doc.line (List.map printAttribute attrs) + Doc.join ~sep:Doc.line (List.map print_attribute attrs) ); Doc.space; - printTypExpr typ cmtTbl; + print_typ_expr typ cmt_tbl; ] end - | Ptyp_constr(longidentLoc, [{ ptyp_desc = Parsetree.Ptyp_tuple tuple }]) -> - let constrName = printLidentPath longidentLoc cmtTbl in + | Ptyp_constr(longident_loc, [{ ptyp_desc = Parsetree.Ptyp_tuple tuple }]) -> + let constr_name = print_lident_path longident_loc cmt_tbl in Doc.group( Doc.concat([ - constrName; - Doc.lessThan; - printTupleType ~inline:true tuple cmtTbl; - Doc.greaterThan; + constr_name; + Doc.less_than; + print_tuple_type ~inline:true tuple cmt_tbl; + Doc.greater_than; ]) ) - | Ptyp_constr(longidentLoc, constrArgs) -> - let constrName = printLidentPath longidentLoc cmtTbl in - begin match constrArgs with - | [] -> constrName + | Ptyp_constr(longident_loc, constr_args) -> + let constr_name = print_lident_path longident_loc cmt_tbl in + begin match constr_args with + | [] -> constr_name | [{ Parsetree.ptyp_desc = Ptyp_constr({txt = Longident.Ldot(Longident.Lident "Js", "t")}, - [{ptyp_desc = Ptyp_object (fields, openFlag)}]) + [{ptyp_desc = Ptyp_object (fields, open_flag)}]) }] -> Doc.concat([ - constrName; - Doc.lessThan; - printBsObjectSugar ~inline:true fields openFlag cmtTbl; - Doc.greaterThan; + constr_name; + Doc.less_than; + print_bs_object_sugar ~inline:true fields open_flag cmt_tbl; + Doc.greater_than; ]) | _args -> Doc.group( Doc.concat([ - constrName; - Doc.lessThan; + constr_name; + Doc.less_than; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( List.map - (fun typexpr -> printTypExpr typexpr cmtTbl) - constrArgs + (fun typexpr -> print_typ_expr typexpr cmt_tbl) + constr_args ) ] ); - Doc.trailingComma; - Doc.softLine; - Doc.greaterThan; + Doc.trailing_comma; + Doc.soft_line; + Doc.greater_than; ]) ) end | Ptyp_arrow _ -> - let (attrsBefore, args, returnType) = ParsetreeViewer.arrowType typExpr in - let returnTypeNeedsParens = match returnType.ptyp_desc with + let (attrs_before, args, return_type) = ParsetreeViewer.arrow_type typ_expr in + let return_type_needs_parens = match return_type.ptyp_desc with | Ptyp_alias _ -> true | _ -> false in - let returnDoc = - let doc = printTypExpr returnType cmtTbl in - if returnTypeNeedsParens then + let return_doc = + let doc = print_typ_expr return_type cmt_tbl in + if return_type_needs_parens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - let (isUncurried, attrs) = - ParsetreeViewer.processUncurriedAttribute attrsBefore + let (is_uncurried, attrs) = + ParsetreeViewer.process_uncurried_attribute attrs_before in begin match args with | [] -> Doc.nil - | [([], Nolabel, n)] when not isUncurried -> - let hasAttrsBefore = not (attrs = []) in - let attrs = if hasAttrsBefore then + | [([], Nolabel, n)] when not is_uncurried -> + let has_attrs_before = not (attrs = []) in + let attrs = if has_attrs_before then Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrsBefore); + Doc.join ~sep:Doc.line (List.map print_attribute attrs_before); Doc.space; ] else Doc.nil in - let typDoc = - let doc = printTypExpr n cmtTbl in + let typ_doc = + let doc = print_typ_expr n cmt_tbl in match n.ptyp_desc with - | Ptyp_arrow _ | Ptyp_tuple _ -> addParens doc + | Ptyp_arrow _ | Ptyp_tuple _ -> add_parens doc | _ -> doc in Doc.group ( Doc.concat [ Doc.group attrs; Doc.group ( - if hasAttrsBefore then + if has_attrs_before then Doc.concat [ Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; - typDoc; + Doc.soft_line; + typ_doc; Doc.text " => "; - returnDoc; + return_doc; ] ); - Doc.softLine; + Doc.soft_line; Doc.rparen ] else Doc.concat [ - typDoc; + typ_doc; Doc.text " => "; - returnDoc; + return_doc; ] ) ] @@ -7393,119 +7393,119 @@ module Printer = struct let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.space; ] in - let renderedArgs = Doc.concat [ + let rendered_args = Doc.concat [ attrs; Doc.text "("; Doc.indent ( Doc.concat [ - Doc.softLine; - if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil; + Doc.soft_line; + if is_uncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun tp -> printTypeParameter tp cmtTbl) args + List.map (fun tp -> print_type_parameter tp cmt_tbl) args ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.text ")"; ] in Doc.group ( Doc.concat [ - renderedArgs; + rendered_args; Doc.text " => "; - returnDoc; + return_doc; ] ) end - | Ptyp_tuple types -> printTupleType ~inline:false types cmtTbl - | Ptyp_object (fields, openFlag) -> - printBsObjectSugar ~inline:false fields openFlag cmtTbl + | Ptyp_tuple types -> print_tuple_type ~inline:false types cmt_tbl + | Ptyp_object (fields, open_flag) -> + print_bs_object_sugar ~inline:false fields open_flag cmt_tbl | Ptyp_poly([], typ) -> - printTypExpr typ cmtTbl - | Ptyp_poly(stringLocs, typ) -> + print_typ_expr typ cmt_tbl + | Ptyp_poly(string_locs, typ) -> Doc.concat [ Doc.join ~sep:Doc.space (List.map (fun {Location.txt; loc} -> let doc = Doc.concat [Doc.text "'"; Doc.text txt] in - printComments doc cmtTbl loc - ) stringLocs); + print_comments doc cmt_tbl loc + ) string_locs); Doc.dot; Doc.space; - printTypExpr typ cmtTbl + print_typ_expr typ cmt_tbl ] - | Ptyp_package packageType -> - printPackageType ~printModuleKeywordAndParens:true packageType cmtTbl + | Ptyp_package package_type -> + print_package_type ~print_module_keyword_and_parens:true package_type cmt_tbl | Ptyp_class _ -> Doc.text "classes are not supported in types" - | Ptyp_variant (rowFields, closedFlag, labelsOpt) -> - let printRowField = function + | Ptyp_variant (row_fields, closed_flag, labels_opt) -> + let print_row_field = function | Parsetree.Rtag ({txt}, attrs, true, []) -> Doc.concat [ - printAttributes attrs; - Doc.concat [Doc.text "#"; printIdentLike ~allowUident:true txt] + print_attributes attrs; + Doc.concat [Doc.text "#"; print_ident_like ~allow_uident:true txt] ] | Rtag ({txt}, attrs, truth, types) -> - let doType t = match t.Parsetree.ptyp_desc with - | Ptyp_tuple _ -> printTypExpr t cmtTbl - | _ -> Doc.concat [ Doc.lparen; printTypExpr t cmtTbl; Doc.rparen ] + let do_type t = match t.Parsetree.ptyp_desc with + | Ptyp_tuple _ -> print_typ_expr t cmt_tbl + | _ -> Doc.concat [ Doc.lparen; print_typ_expr t cmt_tbl; Doc.rparen ] in - let printedTypes = List.map doType types in - let cases = Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "& "]) printedTypes in + let printed_types = List.map do_type types in + let cases = Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "& "]) printed_types in let cases = if truth then Doc.concat [Doc.line; Doc.text "& "; cases] else cases in Doc.group (Doc.concat [ - printAttributes attrs; - Doc.concat [Doc.text "#"; printIdentLike ~allowUident:true txt]; + print_attributes attrs; + Doc.concat [Doc.text "#"; print_ident_like ~allow_uident:true txt]; cases ]) - | Rinherit coreType -> - printTypExpr coreType cmtTbl + | Rinherit core_type -> + print_typ_expr core_type cmt_tbl in - let docs = List.map printRowField rowFields in + let docs = List.map print_row_field row_fields in let cases = Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "| "]) docs in let cases = if docs = [] then cases else Doc.concat [Doc.text "| "; cases] in - let openingSymbol = - if closedFlag = Open - then Doc.greaterThan - else if labelsOpt = None + let opening_symbol = + if closed_flag = Open + then Doc.greater_than + else if labels_opt = None then Doc.nil - else Doc.lessThan in - let hasLabels = labelsOpt <> None && labelsOpt <> Some [] in - let labels = match labelsOpt with + else Doc.less_than in + let has_labels = labels_opt <> None && labels_opt <> Some [] in + let labels = match labels_opt with | None | Some([]) -> Doc.nil | Some(labels) -> - Doc.concat (List.map (fun label -> Doc.concat [Doc.line; Doc.text "#" ; printIdentLike ~allowUident:true label] ) labels) + Doc.concat (List.map (fun label -> Doc.concat [Doc.line; Doc.text "#" ; print_ident_like ~allow_uident:true label] ) labels) in - let closingSymbol = if hasLabels then Doc.text " >" else Doc.nil in - Doc.group (Doc.concat [Doc.lbracket; openingSymbol; Doc.line; cases; closingSymbol; labels; Doc.line; Doc.rbracket]) + let closing_symbol = if has_labels then Doc.text " >" else Doc.nil in + Doc.group (Doc.concat [Doc.lbracket; opening_symbol; Doc.line; cases; closing_symbol; labels; Doc.line; Doc.rbracket]) in - let shouldPrintItsOwnAttributes = match typExpr.ptyp_desc with + let should_print_its_own_attributes = match typ_expr.ptyp_desc with | Ptyp_arrow _ (* es6 arrow types print their own attributes *) | Ptyp_constr({txt = Longident.Ldot(Longident.Lident "Js", "t")}, _) -> true | _ -> false in - let doc = begin match typExpr.ptyp_attributes with - | _::_ as attrs when not shouldPrintItsOwnAttributes -> + let doc = begin match typ_expr.ptyp_attributes with + | _::_ as attrs when not should_print_its_own_attributes -> Doc.group ( Doc.concat [ - printAttributes attrs; - renderedType; + print_attributes attrs; + rendered_type; ] ) - | _ -> renderedType + | _ -> rendered_type end in - printComments doc cmtTbl typExpr.ptyp_loc + print_comments doc cmt_tbl typ_expr.ptyp_loc - and printBsObjectSugar ~inline fields openFlag cmtTbl = + and print_bs_object_sugar ~inline fields open_flag cmt_tbl = let doc = match fields with | [] -> Doc.concat [ Doc.lbrace; - (match openFlag with + (match open_flag with | Asttypes.Closed -> Doc.dot | Open -> Doc.dotdot); Doc.rbrace @@ -7513,85 +7513,85 @@ module Printer = struct | fields -> Doc.concat [ Doc.lbrace; - (match openFlag with + (match open_flag with | Asttypes.Closed -> Doc.nil | Open -> Doc.dotdot); Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun field -> printObjectField field cmtTbl) fields + List.map (fun field -> print_object_field field cmt_tbl) fields ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ] in if inline then doc else Doc.group doc - and printTupleType ~inline (types: Parsetree.core_type list) cmtTbl = + and print_tuple_type ~inline (types: Parsetree.core_type list) cmt_tbl = let tuple = Doc.concat([ Doc.lparen; Doc.indent ( Doc.concat([ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun typexpr -> printTypExpr typexpr cmtTbl) types + List.map (fun typexpr -> print_typ_expr typexpr cmt_tbl) types ) ]) ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ]) in if inline == false then Doc.group(tuple) else tuple - and printObjectField (field : Parsetree.object_field) cmtTbl = + and print_object_field (field : Parsetree.object_field) cmt_tbl = match field with - | Otag (labelLoc, attrs, typ) -> + | Otag (label_loc, attrs, typ) -> let lbl = - let doc = Doc.text ("\"" ^ labelLoc.txt ^ "\"") in - printComments doc cmtTbl labelLoc.loc + let doc = Doc.text ("\"" ^ label_loc.txt ^ "\"") in + print_comments doc cmt_tbl label_loc.loc in let doc = Doc.concat [ - printAttributes ~loc:labelLoc.loc attrs; + print_attributes ~loc:label_loc.loc attrs; lbl; Doc.text ": "; - printTypExpr typ cmtTbl; + print_typ_expr typ cmt_tbl; ] in - let cmtLoc = {labelLoc.loc with loc_end = typ.ptyp_loc.loc_end} in - printComments doc cmtTbl cmtLoc + let cmt_loc = {label_loc.loc with loc_end = typ.ptyp_loc.loc_end} in + print_comments doc cmt_tbl cmt_loc | _ -> Doc.nil (* es6 arrow type arg * type t = (~foo: string, ~bar: float=?, unit) => unit * i.e. ~foo: string, ~bar: float *) - and printTypeParameter (attrs, lbl, typ) cmtTbl = - let (isUncurried, attrs) = ParsetreeViewer.processUncurriedAttribute attrs in - let uncurried = if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + and print_type_parameter (attrs, lbl, typ) cmt_tbl = + let (is_uncurried, attrs) = ParsetreeViewer.process_uncurried_attribute attrs in + let uncurried = if is_uncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.line; ] in let label = match lbl with | Asttypes.Nolabel -> Doc.nil | Labelled lbl -> Doc.concat [ Doc.text "~"; - printIdentLike lbl; + print_ident_like lbl; Doc.text ": "; ] | Optional lbl -> Doc.concat [ Doc.text "~"; - printIdentLike lbl; + print_ident_like lbl; Doc.text ": "; ] in - let optionalIndicator = match lbl with + let optional_indicator = match lbl with | Asttypes.Nolabel | Labelled _ -> Doc.nil | Optional _lbl -> Doc.text "=?" @@ -7601,24 +7601,24 @@ module Printer = struct uncurried; attrs; label; - printTypExpr typ cmtTbl; - optionalIndicator; + print_typ_expr typ cmt_tbl; + optional_indicator; ] ) in - printComments doc cmtTbl typ.ptyp_loc + print_comments doc cmt_tbl typ.ptyp_loc - and printValueBinding ~recFlag vb cmtTbl i = - let (hasGenType, attrs) = ParsetreeViewer.splitGenTypeAttr vb.pvb_attributes in - let attrs = printAttributes ~loc:vb.pvb_pat.ppat_loc attrs in + and print_value_binding ~rec_flag vb cmt_tbl i = + let (has_gen_type, attrs) = ParsetreeViewer.split_gen_type_attr vb.pvb_attributes in + let attrs = print_attributes ~loc:vb.pvb_pat.ppat_loc attrs in let header = if i == 0 then Doc.concat [ - if hasGenType then Doc.text "export " else Doc.text "let "; - recFlag + if has_gen_type then Doc.text "export " else Doc.text "let "; + rec_flag ] else Doc.concat [ Doc.text "and "; - if hasGenType then Doc.text "export " else Doc.nil + if has_gen_type then Doc.text "export " else Doc.nil ] in match vb with @@ -7627,8 +7627,8 @@ module Printer = struct pvb_expr = {pexp_desc = Pexp_newtype _} as expr } -> - let (_attrs, parameters, returnExpr) = ParsetreeViewer.funExpr expr in - let abstractType = match parameters with + let (_attrs, parameters, return_expr) = ParsetreeViewer.fun_expr expr in + let abstract_type = match parameters with | [NewTypes {locs = vars}] -> Doc.concat [ Doc.text "type "; @@ -7637,24 +7637,24 @@ module Printer = struct ] | _ -> Doc.nil in - begin match returnExpr.pexp_desc with + begin match return_expr.pexp_desc with | Pexp_constraint (expr, typ) -> Doc.group ( Doc.concat [ attrs; header; - printPattern pattern cmtTbl; + print_pattern pattern cmt_tbl; Doc.text ":"; Doc.indent ( Doc.concat [ Doc.line; - abstractType; + abstract_type; Doc.space; - printTypExpr typ cmtTbl; + print_typ_expr typ cmt_tbl; Doc.text " ="; Doc.concat [ Doc.line; - printExpressionWithComments expr cmtTbl; + print_expression_with_comments expr cmt_tbl; ] ] ) @@ -7663,96 +7663,96 @@ module Printer = struct | _ -> Doc.nil end | _ -> - let (optBraces, expr) = ParsetreeViewer.processBracesAttr vb.pvb_expr in - let printedExpr = - let doc = printExpressionWithComments vb.pvb_expr cmtTbl in + let (opt_braces, expr) = ParsetreeViewer.process_braces_attr vb.pvb_expr in + let printed_expr = + let doc = print_expression_with_comments vb.pvb_expr cmt_tbl in match Parens.expr vb.pvb_expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in - if ParsetreeViewer.isPipeExpr vb.pvb_expr then - Doc.customLayout [ + if ParsetreeViewer.is_pipe_expr vb.pvb_expr then + Doc.custom_layout [ Doc.group ( Doc.concat [ attrs; header; - printPattern vb.pvb_pat cmtTbl; + print_pattern vb.pvb_pat cmt_tbl; Doc.text " ="; Doc.space; - printedExpr; + printed_expr; ] ); Doc.group ( Doc.concat [ attrs; header; - printPattern vb.pvb_pat cmtTbl; + print_pattern vb.pvb_pat cmt_tbl; Doc.text " ="; Doc.indent ( Doc.concat [ Doc.line; - printedExpr; + printed_expr; ] ) ] ); ] else - let shouldIndent = - match optBraces with + let should_indent = + match opt_braces with | Some _ -> false | _ -> - ParsetreeViewer.isBinaryExpression expr || + ParsetreeViewer.is_binary_expression expr || (match vb.pvb_expr with | { pexp_attributes = [({Location.txt="res.ternary"}, _)]; - pexp_desc = Pexp_ifthenelse (ifExpr, _, _) + pexp_desc = Pexp_ifthenelse (if_expr, _, _) } -> - ParsetreeViewer.isBinaryExpression ifExpr || ParsetreeViewer.hasAttributes ifExpr.pexp_attributes + ParsetreeViewer.is_binary_expression if_expr || ParsetreeViewer.has_attributes if_expr.pexp_attributes | { pexp_desc = Pexp_newtype _} -> false | e -> - ParsetreeViewer.hasAttributes e.pexp_attributes || - ParsetreeViewer.isArrayAccess e + ParsetreeViewer.has_attributes e.pexp_attributes || + ParsetreeViewer.is_array_access e ) in Doc.group ( Doc.concat [ attrs; header; - printPattern vb.pvb_pat cmtTbl; + print_pattern vb.pvb_pat cmt_tbl; Doc.text " ="; - if shouldIndent then + if should_indent then Doc.indent ( Doc.concat [ Doc.line; - printedExpr; + printed_expr; ] ) else Doc.concat [ Doc.space; - printedExpr; + printed_expr; ] ] ) - and printPackageType ~printModuleKeywordAndParens (packageType: Parsetree.package_type) cmtTbl = - let doc = match packageType with - | (longidentLoc, []) -> Doc.group( + and print_package_type ~print_module_keyword_and_parens (package_type: Parsetree.package_type) cmt_tbl = + let doc = match package_type with + | (longident_loc, []) -> Doc.group( Doc.concat [ - printLongidentLocation longidentLoc cmtTbl; + print_longident_location longident_loc cmt_tbl; ] ) - | (longidentLoc, packageConstraints) -> Doc.group( + | (longident_loc, package_constraints) -> Doc.group( Doc.concat [ - printLongidentLocation longidentLoc cmtTbl; - printPackageConstraints packageConstraints cmtTbl; - Doc.softLine; + print_longident_location longident_loc cmt_tbl; + print_package_constraints package_constraints cmt_tbl; + Doc.soft_line; ] ) in - if printModuleKeywordAndParens then + if print_module_keyword_and_parens then Doc.concat[ Doc.text "module("; doc; @@ -7761,7 +7761,7 @@ module Printer = struct else doc - and printPackageConstraints packageConstraints cmtTbl = + and print_package_constraints package_constraints cmt_tbl = Doc.concat [ Doc.text " with"; Doc.indent ( @@ -7770,78 +7770,78 @@ module Printer = struct Doc.join ~sep:Doc.line ( List.mapi (fun i pc -> let (longident, typexpr) = pc in - let cmtLoc = {longident.Asttypes.loc with + let cmt_loc = {longident.Asttypes.loc with loc_end = typexpr.Parsetree.ptyp_loc.loc_end } in - let doc = printPackageConstraint i cmtTbl pc in - printComments doc cmtTbl cmtLoc - ) packageConstraints + let doc = print_package_constraint i cmt_tbl pc in + print_comments doc cmt_tbl cmt_loc + ) package_constraints ) ] ) ] - and printPackageConstraint i cmtTbl (longidentLoc, typ) = + and print_package_constraint i cmt_tbl (longident_loc, typ) = let prefix = if i == 0 then Doc.text "type " else Doc.text "and type " in Doc.concat [ prefix; - printLongidentLocation longidentLoc cmtTbl; + print_longident_location longident_loc cmt_tbl; Doc.text " = "; - printTypExpr typ cmtTbl; + print_typ_expr typ cmt_tbl; ] - and printExtensionWithComments ~atModuleLvl (stringLoc, payload) cmtTbl = - let extName = + and print_extension_with_comments ~at_module_lvl (string_loc, payload) cmt_tbl = + let ext_name = let doc = Doc.concat [ Doc.text "%"; - if atModuleLvl then Doc.text "%" else Doc.nil; - Doc.text stringLoc.Location.txt; + if at_module_lvl then Doc.text "%" else Doc.nil; + Doc.text string_loc.Location.txt; ] in - printComments doc cmtTbl stringLoc.Location.loc + print_comments doc cmt_tbl string_loc.Location.loc in match payload with | Parsetree.PStr [{pstr_desc = Pstr_eval (expr, attrs)}] -> - let exprDoc = printExpressionWithComments expr cmtTbl in - let needsParens = match attrs with | [] -> false | _ -> true in + let expr_doc = print_expression_with_comments expr cmt_tbl in + let needs_parens = match attrs with | [] -> false | _ -> true in Doc.group ( Doc.concat [ - extName; - addParens ( + ext_name; + add_parens ( Doc.concat [ - printAttributes attrs; - if needsParens then addParens exprDoc else exprDoc; + print_attributes attrs; + if needs_parens then add_parens expr_doc else expr_doc; ] ) ] ) - | _ -> extName + | _ -> ext_name - and printPattern (p : Parsetree.pattern) cmtTbl = - let patternWithoutAttributes = match p.ppat_desc with + and print_pattern (p : Parsetree.pattern) cmt_tbl = + let pattern_without_attributes = match p.ppat_desc with | Ppat_any -> Doc.text "_" - | Ppat_var var -> printIdentLike var.txt - | Ppat_constant c -> printConstant c + | Ppat_var var -> print_ident_like var.txt + | Ppat_constant c -> print_constant c | Ppat_tuple patterns -> Doc.group( Doc.concat([ Doc.lparen; Doc.indent ( Doc.concat([ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun pat -> - printPattern pat cmtTbl) patterns) + print_pattern pat cmt_tbl) patterns) ]) ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen ]) ) | Ppat_array [] -> Doc.concat [ Doc.lbracket; - printCommentsInside cmtTbl p.ppat_loc; + print_comments_inside cmt_tbl p.ppat_loc; Doc.rbracket; ] | Ppat_array patterns -> @@ -7850,82 +7850,82 @@ module Printer = struct Doc.text "["; Doc.indent ( Doc.concat([ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun pat -> - printPattern pat cmtTbl) patterns) + print_pattern pat cmt_tbl) patterns) ]) ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.text "]"; ]) ) | Ppat_construct({txt = Longident.Lident "()"}, _) -> Doc.concat [ Doc.lparen; - printCommentsInside cmtTbl p.ppat_loc; + print_comments_inside cmt_tbl p.ppat_loc; Doc.rparen; ] | Ppat_construct({txt = Longident.Lident "[]"}, _) -> Doc.concat [ Doc.text "list["; - printCommentsInside cmtTbl p.ppat_loc; + print_comments_inside cmt_tbl p.ppat_loc; Doc.rbracket; ] | Ppat_construct({txt = Longident.Lident "::"}, _) -> - let (patterns, tail) = ParsetreeViewer.collectPatternsFromListConstruct [] p in - let shouldHug = match (patterns, tail) with + let (patterns, tail) = ParsetreeViewer.collect_patterns_from_list_construct [] p in + let should_hug = match (patterns, tail) with | ([pat], - {ppat_desc = Ppat_construct({txt = Longident.Lident "[]"}, _)}) when ParsetreeViewer.isHuggablePattern pat -> true + {ppat_desc = Ppat_construct({txt = Longident.Lident "[]"}, _)}) when ParsetreeViewer.is_huggable_pattern pat -> true | _ -> false in let children = Doc.concat([ - if shouldHug then Doc.nil else Doc.softLine; + if should_hug then Doc.nil else Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun pat -> - printPattern pat cmtTbl) patterns); + print_pattern pat cmt_tbl) patterns); begin match tail.Parsetree.ppat_desc with | Ppat_construct({txt = Longident.Lident "[]"}, _) -> Doc.nil | _ -> - let doc = Doc.concat [Doc.text "..."; printPattern tail cmtTbl] in - let tail = printComments doc cmtTbl tail.ppat_loc in + let doc = Doc.concat [Doc.text "..."; print_pattern tail cmt_tbl] in + let tail = print_comments doc cmt_tbl tail.ppat_loc in Doc.concat([Doc.text ","; Doc.line; tail]) end; ]) in Doc.group( Doc.concat([ Doc.text "list["; - if shouldHug then children else Doc.concat [ + if should_hug then children else Doc.concat [ Doc.indent children; - Doc.ifBreaks (Doc.text ",") Doc.nil; - Doc.softLine; + Doc.if_breaks (Doc.text ",") Doc.nil; + Doc.soft_line; ]; Doc.rbracket; ]) ) - | Ppat_construct(constrName, constructorArgs) -> - let constrName = printLongident constrName.txt in - let argsDoc = match constructorArgs with + | Ppat_construct(constr_name, constructor_args) -> + let constr_name = print_longident constr_name.txt in + let args_doc = match constructor_args with | None -> Doc.nil | Some({ppat_loc; ppat_desc = Ppat_construct ({txt = Longident.Lident "()"}, _)}) -> Doc.concat [ Doc.lparen; - printCommentsInside cmtTbl ppat_loc; + print_comments_inside cmt_tbl ppat_loc; Doc.rparen; ] | Some({ppat_desc = Ppat_tuple []; ppat_loc = loc}) -> Doc.concat [ Doc.lparen; - Doc.softLine; - printCommentsInside cmtTbl loc; + Doc.soft_line; + print_comments_inside cmt_tbl loc; Doc.rparen; ] (* Some((1, 2) *) | Some({ppat_desc = Ppat_tuple [{ppat_desc = Ppat_tuple _} as arg]}) -> Doc.concat [ Doc.lparen; - printPattern arg cmtTbl; + print_pattern arg cmt_tbl; Doc.rparen; ] | Some({ppat_desc = Ppat_tuple patterns}) -> @@ -7933,58 +7933,58 @@ module Printer = struct Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun pat -> printPattern pat cmtTbl) patterns + List.map (fun pat -> print_pattern pat cmt_tbl) patterns ); ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] | Some(arg) -> - let argDoc = printPattern arg cmtTbl in - let shouldHug = ParsetreeViewer.isHuggablePattern arg in + let arg_doc = print_pattern arg cmt_tbl in + let should_hug = ParsetreeViewer.is_huggable_pattern arg in Doc.concat [ Doc.lparen; - if shouldHug then argDoc + if should_hug then arg_doc else Doc.concat [ Doc.indent ( Doc.concat [ - Doc.softLine; - argDoc; + Doc.soft_line; + arg_doc; ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; ]; Doc.rparen; ] in - Doc.group(Doc.concat [constrName; argsDoc]) + Doc.group(Doc.concat [constr_name; args_doc]) | Ppat_variant (label, None) -> - Doc.concat [Doc.text "#"; printIdentLike ~allowUident:true label] - | Ppat_variant (label, variantArgs) -> - let variantName = - Doc.concat [Doc.text "#"; printIdentLike ~allowUident:true label] in - let argsDoc = match variantArgs with + Doc.concat [Doc.text "#"; print_ident_like ~allow_uident:true label] + | Ppat_variant (label, variant_args) -> + let variant_name = + Doc.concat [Doc.text "#"; print_ident_like ~allow_uident:true label] in + let args_doc = match variant_args 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; - Doc.softLine; - printCommentsInside cmtTbl loc; + Doc.soft_line; + print_comments_inside cmt_tbl loc; Doc.rparen; ] (* Some((1, 2) *) | Some({ppat_desc = Ppat_tuple [{ppat_desc = Ppat_tuple _} as arg]}) -> Doc.concat [ Doc.lparen; - printPattern arg cmtTbl; + print_pattern arg cmt_tbl; Doc.rparen; ] | Some({ppat_desc = Ppat_tuple patterns}) -> @@ -7992,68 +7992,68 @@ module Printer = struct Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun pat -> printPattern pat cmtTbl) patterns + List.map (fun pat -> print_pattern pat cmt_tbl) patterns ); ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] | Some(arg) -> - let argDoc = printPattern arg cmtTbl in - let shouldHug = ParsetreeViewer.isHuggablePattern arg in + let arg_doc = print_pattern arg cmt_tbl in + let should_hug = ParsetreeViewer.is_huggable_pattern arg in Doc.concat [ Doc.lparen; - if shouldHug then argDoc + if should_hug then arg_doc else Doc.concat [ Doc.indent ( Doc.concat [ - Doc.softLine; - argDoc; + Doc.soft_line; + arg_doc; ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; ]; Doc.rparen; ] in - Doc.group(Doc.concat [variantName; argsDoc]) + Doc.group(Doc.concat [variant_name; args_doc]) | Ppat_type ident -> - Doc.concat [Doc.text "##"; printIdentPath ident cmtTbl] - | Ppat_record(rows, openFlag) -> + Doc.concat [Doc.text "##"; print_ident_path ident cmt_tbl] + | Ppat_record(rows, open_flag) -> Doc.group( Doc.concat([ Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map (fun row -> printPatternRecordRow row cmtTbl) rows); - begin match openFlag with + (List.map (fun row -> print_pattern_record_row row cmt_tbl) rows); + begin match open_flag with | Open -> Doc.concat [Doc.text ","; Doc.line; Doc.text "_"] | Closed -> Doc.nil end; ] ); - Doc.ifBreaks (Doc.text ",") Doc.nil; - Doc.softLine; + Doc.if_breaks (Doc.text ",") Doc.nil; + Doc.soft_line; Doc.rbrace; ]) ) | Ppat_exception p -> - let needsParens = match p.ppat_desc with + let needs_parens = match p.ppat_desc with | Ppat_or (_, _) | Ppat_alias (_, _) -> true | _ -> false in let pat = - let p = printPattern p cmtTbl in - if needsParens then + let p = print_pattern p cmt_tbl in + if needs_parens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p @@ -8063,151 +8063,151 @@ module Printer = struct ) | Ppat_or _ -> (* Blue | Red | Green -> [Blue; Red; Green] *) - let orChain = ParsetreeViewer.collectOrPatternChain p in + let or_chain = ParsetreeViewer.collect_or_pattern_chain p in let docs = List.mapi (fun i pat -> - let patternDoc = printPattern pat cmtTbl in + let pattern_doc = print_pattern pat cmt_tbl 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 _ -> addParens patternDoc - | _ -> patternDoc + | Ppat_or _ -> add_parens pattern_doc + | _ -> pattern_doc ] - ) orChain in + ) or_chain in Doc.group (Doc.concat docs) | Ppat_extension ext -> - printExtensionWithComments ~atModuleLvl:false ext cmtTbl + print_extension_with_comments ~at_module_lvl:false ext cmt_tbl | Ppat_lazy p -> - let needsParens = match p.ppat_desc with + let needs_parens = match p.ppat_desc with | Ppat_or (_, _) | Ppat_alias (_, _) -> true | _ -> false in let pat = - let p = printPattern p cmtTbl in - if needsParens then + let p = print_pattern p cmt_tbl in + if needs_parens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat [Doc.text "lazy "; pat] - | Ppat_alias (p, aliasLoc) -> - let needsParens = match p.ppat_desc with + | Ppat_alias (p, alias_loc) -> + let needs_parens = match p.ppat_desc with | Ppat_or (_, _) | Ppat_alias (_, _) -> true | _ -> false in - let renderedPattern = - let p = printPattern p cmtTbl in - if needsParens then + let rendered_pattern = + let p = print_pattern p cmt_tbl in + if needs_parens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat([ - renderedPattern; + rendered_pattern; Doc.text " as "; - printStringLoc aliasLoc cmtTbl; + print_string_loc alias_loc cmt_tbl; ]) (* Note: module(P : S) is represented as *) (* Ppat_constraint(Ppat_unpack, Ptyp_package) *) - | Ppat_constraint ({ppat_desc = Ppat_unpack stringLoc}, {ptyp_desc = Ptyp_package packageType; ptyp_loc}) -> + | Ppat_constraint ({ppat_desc = Ppat_unpack string_loc}, {ptyp_desc = Ptyp_package package_type; ptyp_loc}) -> Doc.concat [ Doc.text "module("; - printComments (Doc.text stringLoc.txt) cmtTbl stringLoc.loc; + print_comments (Doc.text string_loc.txt) cmt_tbl string_loc.loc; Doc.text ": "; - printComments - (printPackageType ~printModuleKeywordAndParens:false packageType cmtTbl) - cmtTbl + print_comments + (print_package_type ~print_module_keyword_and_parens:false package_type cmt_tbl) + cmt_tbl ptyp_loc; Doc.rparen; ] | Ppat_constraint (pattern, typ) -> Doc.concat [ - printPattern pattern cmtTbl; + print_pattern pattern cmt_tbl; Doc.text ": "; - printTypExpr typ cmtTbl; + print_typ_expr typ cmt_tbl; ] (* Note: module(P : S) is represented as *) (* Ppat_constraint(Ppat_unpack, Ptyp_package) *) - | Ppat_unpack stringLoc -> + | Ppat_unpack string_loc -> Doc.concat [ Doc.text "module("; - printComments (Doc.text stringLoc.txt) cmtTbl stringLoc.loc; + print_comments (Doc.text string_loc.txt) cmt_tbl string_loc.loc; Doc.rparen; ] | Ppat_interval (a, b) -> Doc.concat [ - printConstant a; + print_constant a; Doc.text " .. "; - printConstant b; + print_constant b; ] | Ppat_open _ -> Doc.nil in let doc = match p.ppat_attributes with - | [] -> patternWithoutAttributes + | [] -> pattern_without_attributes | attrs -> Doc.group ( Doc.concat [ - printAttributes attrs; - patternWithoutAttributes; + print_attributes attrs; + pattern_without_attributes; ] ) in - printComments doc cmtTbl p.ppat_loc + print_comments doc cmt_tbl p.ppat_loc - and printPatternRecordRow row cmtTbl = + and print_pattern_record_row row cmt_tbl = match row with (* punned {x}*) | ({Location.txt=Longident.Lident ident} as longident, {Parsetree.ppat_desc=Ppat_var {txt;_}}) when ident = txt -> - printLidentPath longident cmtTbl + print_lident_path longident cmt_tbl | (longident, pattern) -> - let locForComments = { + let loc_for_comments = { longident.loc with loc_end = pattern.Parsetree.ppat_loc.loc_end } in let doc = Doc.group ( Doc.concat([ - printLidentPath longident cmtTbl; + print_lident_path longident cmt_tbl; Doc.text ": "; Doc.indent( Doc.concat [ - Doc.softLine; - printPattern pattern cmtTbl; + Doc.soft_line; + print_pattern pattern cmt_tbl; ] ) ]) ) in - printComments doc cmtTbl locForComments + print_comments doc cmt_tbl loc_for_comments - and printExpressionWithComments expr cmtTbl = - let doc = printExpression expr cmtTbl in - printComments doc cmtTbl expr.Parsetree.pexp_loc + and print_expression_with_comments expr cmt_tbl = + let doc = print_expression expr cmt_tbl in + print_comments doc cmt_tbl expr.Parsetree.pexp_loc - and printExpression (e : Parsetree.expression) cmtTbl = - let printedExpression = match e.pexp_desc with - | Parsetree.Pexp_constant c -> printConstant c - | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> - printJsxFragment e cmtTbl + and print_expression (e : Parsetree.expression) cmt_tbl = + let printed_expression = match e.pexp_desc with + | Parsetree.Pexp_constant c -> print_constant c + | Pexp_construct _ when ParsetreeViewer.has_jsx_attribute e.pexp_attributes -> + print_jsx_fragment e cmt_tbl | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat [ Doc.text "list["; - printCommentsInside cmtTbl e.pexp_loc; + print_comments_inside cmt_tbl e.pexp_loc; Doc.rbracket; ] | Pexp_construct ({txt = Longident.Lident "::"}, _) -> - let (expressions, spread) = ParsetreeViewer.collectListExpressions e in - let spreadDoc = match spread with + let (expressions, spread) = ParsetreeViewer.collect_list_expressions e in + let spread_doc = match spread with | Some(expr) -> Doc.concat [ Doc.text ","; Doc.line; Doc.dotdotdot; - let doc = printExpressionWithComments expr cmtTbl in + let doc = print_expression_with_comments expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc ] | None -> Doc.nil @@ -8217,27 +8217,27 @@ module Printer = struct Doc.text "list["; Doc.indent ( Doc.concat([ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> - let doc = printExpressionWithComments expr cmtTbl in + let doc = print_expression_with_comments expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc ) expressions); - spreadDoc; + spread_doc; ]) ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbracket; ]) ) - | Pexp_construct (longidentLoc, args) -> - let constr = printLongidentLocation longidentLoc cmtTbl in + | Pexp_construct (longident_loc, args) -> + let constr = print_longident_location longident_loc cmt_tbl in let args = match args with | None -> Doc.nil | Some({pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}) -> @@ -8246,10 +8246,10 @@ module Printer = struct | Some({pexp_desc = Pexp_tuple [{pexp_desc = Pexp_tuple _} as arg]}) -> Doc.concat [ Doc.lparen; - (let doc = printExpressionWithComments arg cmtTbl in + (let doc = print_expression_with_comments arg cmt_tbl in match Parens.expr arg with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc arg braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc arg braces | Nothing -> doc); Doc.rparen; ] @@ -8258,77 +8258,77 @@ module Printer = struct Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( List.map (fun expr -> - let doc = printExpressionWithComments expr cmtTbl in + let doc = print_expression_with_comments expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc) args ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] | Some(arg) -> - let argDoc = - let doc = printExpressionWithComments arg cmtTbl in + let arg_doc = + let doc = print_expression_with_comments arg cmt_tbl in match Parens.expr arg with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc arg braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc arg braces | Nothing -> doc in - let shouldHug = ParsetreeViewer.isHuggableExpression arg in + let should_hug = ParsetreeViewer.is_huggable_expression arg in Doc.concat [ Doc.lparen; - if shouldHug then argDoc + if should_hug then arg_doc else Doc.concat [ Doc.indent ( Doc.concat [ - Doc.softLine; - argDoc; + Doc.soft_line; + arg_doc; ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; ]; Doc.rparen; ] in Doc.group(Doc.concat [constr; args]) | Pexp_ident path -> - printLidentPath path cmtTbl + print_lident_path path cmt_tbl | Pexp_tuple exprs -> Doc.group( Doc.concat([ Doc.lparen; Doc.indent ( Doc.concat([ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> - let doc = printExpressionWithComments expr cmtTbl in + let doc = print_expression_with_comments expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc) exprs) ]) ); - Doc.ifBreaks (Doc.text ",") Doc.nil; - Doc.softLine; + Doc.if_breaks (Doc.text ",") Doc.nil; + Doc.soft_line; Doc.rparen; ]) ) | Pexp_array [] -> Doc.concat [ Doc.lbracket; - printCommentsInside cmtTbl e.pexp_loc; + print_comments_inside cmt_tbl e.pexp_loc; Doc.rbracket; ] | Pexp_array exprs -> @@ -8337,25 +8337,25 @@ module Printer = struct Doc.lbracket; Doc.indent ( Doc.concat([ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> - let doc = printExpressionWithComments expr cmtTbl in + let doc = print_expression_with_comments expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc ) exprs) ]) ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbracket; ]) ) | Pexp_variant (label, args) -> - let variantName = - Doc.concat [Doc.text "#"; printIdentLike ~allowUident:true label] in + let variant_name = + Doc.concat [Doc.text "#"; print_ident_like ~allow_uident:true label] in let args = match args with | None -> Doc.nil | Some({pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}) -> @@ -8364,10 +8364,10 @@ module Printer = struct | Some({pexp_desc = Pexp_tuple [{pexp_desc = Pexp_tuple _} as arg]}) -> Doc.concat [ Doc.lparen; - (let doc = printExpressionWithComments arg cmtTbl in + (let doc = print_expression_with_comments arg cmt_tbl in match Parens.expr arg with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc arg braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc arg braces | Nothing -> doc); Doc.rparen; ] @@ -8376,58 +8376,58 @@ module Printer = struct Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( List.map (fun expr -> - let doc = printExpressionWithComments expr cmtTbl in + let doc = print_expression_with_comments expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc) args ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] | Some(arg) -> - let argDoc = - let doc = printExpressionWithComments arg cmtTbl in + let arg_doc = + let doc = print_expression_with_comments arg cmt_tbl in match Parens.expr arg with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc arg braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc arg braces | Nothing -> doc in - let shouldHug = ParsetreeViewer.isHuggableExpression arg in + let should_hug = ParsetreeViewer.is_huggable_expression arg in Doc.concat [ Doc.lparen; - if shouldHug then argDoc + if should_hug then arg_doc else Doc.concat [ Doc.indent ( Doc.concat [ - Doc.softLine; - argDoc; + Doc.soft_line; + arg_doc; ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; ]; Doc.rparen; ] in - Doc.group(Doc.concat [variantName; args]) - | Pexp_record (rows, spreadExpr) -> - let spread = match spreadExpr with + Doc.group(Doc.concat [variant_name; args]) + | Pexp_record (rows, spread_expr) -> + let spread = match spread_expr with | None -> Doc.nil | Some expr -> Doc.concat [ Doc.dotdotdot; - (let doc = printExpressionWithComments expr cmtTbl in + (let doc = print_expression_with_comments expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc); Doc.comma; Doc.line; @@ -8439,22 +8439,22 @@ module Printer = struct * a: 1, * b: 2, * }` -> record is written on multiple lines, break the group *) - let forceBreak = + let force_break = e.pexp_loc.loc_start.pos_lnum < e.pexp_loc.loc_end.pos_lnum in - Doc.breakableGroup ~forceBreak ( + Doc.breakable_group ~force_break ( Doc.concat([ Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; spread; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map (fun row -> printRecordRow row cmtTbl) rows) + (List.map (fun row -> print_record_row row cmt_tbl) rows) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ]) ) @@ -8473,66 +8473,66 @@ module Printer = struct * "a": 1, * "b": 2, * }` -> object is written on multiple lines, break the group *) - let forceBreak = + let force_break = loc.loc_start.pos_lnum < loc.loc_end.pos_lnum in - Doc.breakableGroup ~forceBreak ( + Doc.breakable_group ~force_break ( Doc.concat([ Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map (fun row -> printBsObjectRow row cmtTbl) rows) + (List.map (fun row -> print_bs_object_row row cmt_tbl) rows) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ]) ) | extension -> - printExtensionWithComments ~atModuleLvl:false extension cmtTbl + print_extension_with_comments ~at_module_lvl:false extension cmt_tbl end | Pexp_apply _ -> - if ParsetreeViewer.isUnaryExpression e then - printUnaryExpression e cmtTbl - else if ParsetreeViewer.isTemplateLiteral e then - printTemplateLiteral e cmtTbl - else if ParsetreeViewer.isBinaryExpression e then - printBinaryExpression e cmtTbl + if ParsetreeViewer.is_unary_expression e then + print_unary_expression e cmt_tbl + else if ParsetreeViewer.is_template_literal e then + print_template_literal e cmt_tbl + else if ParsetreeViewer.is_binary_expression e then + print_binary_expression e cmt_tbl else - printPexpApply e cmtTbl + print_pexp_apply e cmt_tbl | Pexp_unreachable -> Doc.dot - | Pexp_field (expr, longidentLoc) -> + | Pexp_field (expr, longident_loc) -> let lhs = - let doc = printExpressionWithComments expr cmtTbl in - match Parens.fieldExpr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + let doc = print_expression_with_comments expr cmt_tbl in + match Parens.field_expr expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in Doc.concat [ lhs; Doc.dot; - printLidentPath longidentLoc cmtTbl; + print_lident_path longident_loc cmt_tbl; ] - | Pexp_setfield (expr1, longidentLoc, expr2) -> - printSetFieldExpr e.pexp_attributes expr1 longidentLoc expr2 e.pexp_loc cmtTbl + | Pexp_setfield (expr1, longident_loc, expr2) -> + print_set_field_expr e.pexp_attributes expr1 longident_loc expr2 e.pexp_loc cmt_tbl | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) -> - if ParsetreeViewer.isTernaryExpr e then - let (parts, alternate) = ParsetreeViewer.collectTernaryParts e in - let ternaryDoc = match parts with + if ParsetreeViewer.is_ternary_expr e then + let (parts, alternate) = ParsetreeViewer.collect_ternary_parts e in + let ternary_doc = match parts with | (condition1, consequent1)::rest -> Doc.group (Doc.concat [ - printTernaryOperand condition1 cmtTbl; + print_ternary_operand condition1 cmt_tbl; Doc.indent ( Doc.concat [ Doc.line; Doc.indent ( Doc.concat [ Doc.text "? "; - printTernaryOperand consequent1 cmtTbl + print_ternary_operand consequent1 cmt_tbl ] ); Doc.concat ( @@ -8540,157 +8540,157 @@ module Printer = struct Doc.concat [ Doc.line; Doc.text ": "; - printTernaryOperand condition cmtTbl; + print_ternary_operand condition cmt_tbl; Doc.line; Doc.text "? "; - printTernaryOperand consequent cmtTbl; + print_ternary_operand consequent cmt_tbl; ] ) rest ); Doc.line; Doc.text ": "; - Doc.indent (printTernaryOperand alternate cmtTbl); + Doc.indent (print_ternary_operand alternate cmt_tbl); ] ) ]) | _ -> Doc.nil in - let attrs = ParsetreeViewer.filterTernaryAttributes e.pexp_attributes in - let needsParens = match ParsetreeViewer.filterParsingAttrs attrs with + let attrs = ParsetreeViewer.filter_ternary_attributes e.pexp_attributes in + let needs_parens = match ParsetreeViewer.filter_parsing_attrs attrs with | [] -> false | _ -> true in Doc.concat [ - printAttributes attrs; - if needsParens then addParens ternaryDoc else ternaryDoc; + print_attributes attrs; + if needs_parens then add_parens ternary_doc else ternary_doc; ] else - let (ifs, elseExpr) = ParsetreeViewer.collectIfExpressions e in - let ifDocs = Doc.join ~sep:Doc.space ( - List.mapi (fun i (ifExpr, thenExpr) -> - let ifTxt = if i > 0 then Doc.text "else if " else Doc.text "if " in + let (ifs, else_expr) = ParsetreeViewer.collect_if_expressions e in + let if_docs = Doc.join ~sep:Doc.space ( + List.mapi (fun i (if_expr, then_expr) -> + let if_txt = if i > 0 then Doc.text "else if " else Doc.text "if " in let condition = - if ParsetreeViewer.isBlockExpr ifExpr then - printExpressionBlock ~braces:true ifExpr cmtTbl + if ParsetreeViewer.is_block_expr if_expr then + print_expression_block ~braces:true if_expr cmt_tbl else - let doc = printExpressionWithComments ifExpr cmtTbl in - match Parens.expr ifExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc ifExpr braces - | Nothing -> Doc.ifBreaks (addParens doc) doc + let doc = print_expression_with_comments 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 in Doc.concat [ - ifTxt; + if_txt; Doc.group (condition); Doc.space; - let thenExpr = match ParsetreeViewer.processBracesAttr thenExpr with + let then_expr = match ParsetreeViewer.process_braces_attr then_expr with (* This case only happens when coming from Reason, we strip braces *) | (Some _, expr) -> expr - | _ -> thenExpr + | _ -> then_expr in - printExpressionBlock ~braces:true thenExpr cmtTbl; + print_expression_block ~braces:true then_expr cmt_tbl; ] ) ifs ) in - let elseDoc = match elseExpr with + let else_doc = match else_expr with | None -> Doc.nil | Some expr -> Doc.concat [ Doc.text " else "; - printExpressionBlock ~braces:true expr cmtTbl; + print_expression_block ~braces:true expr cmt_tbl; ] in Doc.concat [ - printAttributes e.pexp_attributes; - ifDocs; - elseDoc; + print_attributes e.pexp_attributes; + if_docs; + else_doc; ] | Pexp_while (expr1, expr2) -> let condition = - let doc = printExpressionWithComments expr1 cmtTbl in + let doc = print_expression_with_comments expr1 cmt_tbl in match Parens.expr expr1 with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr1 braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr1 braces | Nothing -> doc in - Doc.breakableGroup ~forceBreak:true ( + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.text "while "; - if ParsetreeViewer.isBlockExpr expr1 then + if ParsetreeViewer.is_block_expr expr1 then condition else Doc.group ( - Doc.ifBreaks (addParens condition) condition + Doc.if_breaks (add_parens condition) condition ); Doc.space; - printExpressionBlock ~braces:true expr2 cmtTbl; + print_expression_block ~braces:true expr2 cmt_tbl; ] ) - | Pexp_for (pattern, fromExpr, toExpr, directionFlag, body) -> - Doc.breakableGroup ~forceBreak:true ( + | Pexp_for (pattern, from_expr, to_expr, direction_flag, body) -> + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.text "for "; - printPattern pattern cmtTbl; + print_pattern pattern cmt_tbl; Doc.text " in "; - (let doc = printExpressionWithComments fromExpr cmtTbl in - match Parens.expr fromExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc fromExpr braces + (let doc = print_expression_with_comments from_expr cmt_tbl in + match Parens.expr from_expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc from_expr braces | Nothing -> doc); - printDirectionFlag directionFlag; - (let doc = printExpressionWithComments toExpr cmtTbl in - match Parens.expr toExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc toExpr braces + print_direction_flag direction_flag; + (let doc = print_expression_with_comments to_expr cmt_tbl in + match Parens.expr to_expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc to_expr braces | Nothing -> doc); Doc.space; - printExpressionBlock ~braces:true body cmtTbl; + print_expression_block ~braces:true body cmt_tbl; ] ) | Pexp_constraint( - {pexp_desc = Pexp_pack modExpr}, - {ptyp_desc = Ptyp_package packageType; ptyp_loc} + {pexp_desc = Pexp_pack mod_expr}, + {ptyp_desc = Ptyp_package package_type; ptyp_loc} ) -> Doc.group ( Doc.concat [ Doc.text "module("; Doc.indent ( Doc.concat [ - Doc.softLine; - printModExpr modExpr cmtTbl; + Doc.soft_line; + print_mod_expr mod_expr cmt_tbl; Doc.text ": "; - printComments - (printPackageType ~printModuleKeywordAndParens:false packageType cmtTbl) - cmtTbl + print_comments + (print_package_type ~print_module_keyword_and_parens:false package_type cmt_tbl) + cmt_tbl ptyp_loc ] ); - Doc.softLine; + Doc.soft_line; Doc.rparen; ] ) | Pexp_constraint (expr, typ) -> - let exprDoc = - let doc = printExpressionWithComments expr cmtTbl in + let expr_doc = + let doc = print_expression_with_comments expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in Doc.concat [ - exprDoc; + expr_doc; Doc.text ": "; - printTypExpr typ cmtTbl; + print_typ_expr typ cmt_tbl; ] | Pexp_letmodule ({txt = _modName}, _modExpr, _expr) -> - printExpressionBlock ~braces:true e cmtTbl + print_expression_block ~braces:true e cmt_tbl | Pexp_letexception (_extensionConstructor, _expr) -> - printExpressionBlock ~braces:true e cmtTbl + print_expression_block ~braces:true e cmt_tbl | Pexp_assert expr -> let rhs = - let doc = printExpressionWithComments expr cmtTbl in - match Parens.lazyOrAssertExprRhs expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + let doc = print_expression_with_comments expr cmt_tbl in + match Parens.lazy_or_assert_expr_rhs expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in Doc.concat [ @@ -8699,10 +8699,10 @@ module Printer = struct ] | Pexp_lazy expr -> let rhs = - let doc = printExpressionWithComments expr cmtTbl in - match Parens.lazyOrAssertExprRhs expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + let doc = print_expression_with_comments expr cmt_tbl in + match Parens.lazy_or_assert_expr_rhs expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in Doc.group ( @@ -8712,53 +8712,53 @@ module Printer = struct ] ) | Pexp_open (_overrideFlag, _longidentLoc, _expr) -> - printExpressionBlock ~braces:true e cmtTbl - | Pexp_pack (modExpr) -> + print_expression_block ~braces:true e cmt_tbl + | Pexp_pack (mod_expr) -> Doc.group (Doc.concat [ Doc.text "module("; Doc.indent ( Doc.concat [ - Doc.softLine; - printModExpr modExpr cmtTbl; + Doc.soft_line; + print_mod_expr mod_expr cmt_tbl; ] ); - Doc.softLine; + Doc.soft_line; Doc.rparen; ]) | Pexp_sequence _ -> - printExpressionBlock ~braces:true e cmtTbl + print_expression_block ~braces:true e cmt_tbl | Pexp_let _ -> - printExpressionBlock ~braces:true e cmtTbl + print_expression_block ~braces:true e cmt_tbl | Pexp_fun (Nolabel, None, {ppat_desc = Ppat_var {txt="__x"}}, ({pexp_desc = Pexp_apply _})) -> (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - printExpressionWithComments (ParsetreeViewer.rewriteUnderscoreApply e) cmtTbl + print_expression_with_comments (ParsetreeViewer.rewrite_underscore_apply e) cmt_tbl | Pexp_fun _ | Pexp_newtype _ -> - let (attrsOnArrow, parameters, returnExpr) = ParsetreeViewer.funExpr e in + let (attrs_on_arrow, parameters, return_expr) = ParsetreeViewer.fun_expr e in let (uncurried, attrs) = - ParsetreeViewer.processUncurriedAttribute attrsOnArrow + ParsetreeViewer.process_uncurried_attribute attrs_on_arrow in - let (returnExpr, typConstraint) = match returnExpr.pexp_desc with + let (return_expr, typ_constraint) = match return_expr.pexp_desc with | Pexp_constraint (expr, typ) -> ( {expr with pexp_attributes = List.concat [ expr.pexp_attributes; - returnExpr.pexp_attributes; + return_expr.pexp_attributes; ]}, Some typ ) - | _ -> (returnExpr, None) + | _ -> (return_expr, None) in - let hasConstraint = match typConstraint with | Some _ -> true | None -> false in - let parametersDoc = printExprFunParameters - ~inCallback:false + let has_constraint = match typ_constraint with | Some _ -> true | None -> false in + let parameters_doc = print_expr_fun_parameters + ~in_callback:false ~uncurried - ~hasConstraint + ~has_constraint parameters - cmtTbl + cmt_tbl in - let returnExprDoc = - let (optBraces, _) = ParsetreeViewer.processBracesAttr returnExpr in - let shouldInline = match (returnExpr.pexp_desc, optBraces) with + 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 | (_, Some _ ) -> true | ((Pexp_array _ | Pexp_tuple _ @@ -8766,7 +8766,7 @@ module Printer = struct | Pexp_record _), _) -> true | _ -> false in - let shouldIndent = match returnExpr.pexp_desc with + let should_indent = match return_expr.pexp_desc with | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ @@ -8774,88 +8774,88 @@ module Printer = struct | Pexp_open _ -> false | _ -> true in - let returnDoc = - let doc = printExpressionWithComments returnExpr cmtTbl in - match Parens.expr returnExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc returnExpr braces + let return_doc = + let doc = print_expression_with_comments return_expr cmt_tbl in + match Parens.expr return_expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc return_expr braces | Nothing -> doc in - if shouldInline then Doc.concat [ + if should_inline then Doc.concat [ Doc.space; - returnDoc; + return_doc; ] else Doc.group ( - if shouldIndent then + if should_indent then Doc.indent ( Doc.concat [ Doc.line; - returnDoc; + return_doc; ] ) else Doc.concat [ Doc.space; - returnDoc + return_doc ] ) in - let typConstraintDoc = match typConstraint with - | Some(typ) -> Doc.concat [Doc.text ": "; printTypExpr typ cmtTbl] + let typ_constraint_doc = match typ_constraint with + | Some(typ) -> Doc.concat [Doc.text ": "; print_typ_expr typ cmt_tbl] | _ -> Doc.nil in - let attrs = printAttributes attrs in + let attrs = print_attributes attrs in Doc.group ( Doc.concat [ attrs; - parametersDoc; - typConstraintDoc; + parameters_doc; + typ_constraint_doc; Doc.text " =>"; - returnExprDoc; + return_expr_doc; ] ) | Pexp_try (expr, cases) -> - let exprDoc = - let doc = printExpressionWithComments expr cmtTbl in + let expr_doc = + let doc = print_expression_with_comments expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in Doc.concat [ Doc.text "try "; - exprDoc; + expr_doc; Doc.text " catch "; - printCases cases cmtTbl; + print_cases cases cmt_tbl; ] | Pexp_match (expr, cases) -> - let exprDoc = - let doc = printExpressionWithComments expr cmtTbl in + let expr_doc = + let doc = print_expression_with_comments expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in Doc.concat [ Doc.text "switch "; - exprDoc; + expr_doc; Doc.space; - printCases cases cmtTbl; + print_cases cases cmt_tbl; ] | Pexp_function cases -> Doc.concat [ Doc.text "x => switch x "; - printCases cases cmtTbl; + print_cases cases cmt_tbl; ] - | Pexp_coerce (expr, typOpt, typ) -> - let docExpr = printExpressionWithComments expr cmtTbl in - let docTyp = printTypExpr typ cmtTbl in - let ofType = match typOpt with + | Pexp_coerce (expr, typ_opt, typ) -> + let doc_expr = print_expression_with_comments expr cmt_tbl in + let doc_typ = print_typ_expr typ cmt_tbl in + let of_type = match typ_opt with | None -> Doc.nil | Some(typ1) -> - Doc.concat [Doc.text ": "; printTypExpr typ1 cmtTbl] + Doc.concat [Doc.text ": "; print_typ_expr typ1 cmt_tbl] in - Doc.concat [Doc.lparen; docExpr; ofType; Doc.text " :> "; docTyp; Doc.rparen] + Doc.concat [Doc.lparen; doc_expr; of_type; Doc.text " :> "; doc_typ; Doc.rparen] | Pexp_send _ -> Doc.text "Pexp_send not implemented in printer" | Pexp_new _ -> @@ -8869,53 +8869,53 @@ module Printer = struct | Pexp_object _ -> Doc.text "Pexp_object not implemented in printer" in - let shouldPrintItsOwnAttributes = match e.pexp_desc with + let should_print_its_own_attributes = match e.pexp_desc with | Pexp_apply _ | Pexp_fun _ | Pexp_newtype _ | Pexp_setfield _ | Pexp_ifthenelse _ -> true - | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> true + | Pexp_construct _ when ParsetreeViewer.has_jsx_attribute e.pexp_attributes -> true | _ -> false in match e.pexp_attributes with - | [] -> printedExpression - | attrs when not shouldPrintItsOwnAttributes -> + | [] -> printed_expression + | attrs when not should_print_its_own_attributes -> Doc.group ( Doc.concat [ - printAttributes attrs; - printedExpression; + print_attributes attrs; + printed_expression; ] ) - | _ -> printedExpression + | _ -> printed_expression - and printPexpFun ~inCallback e cmtTbl = - let (attrsOnArrow, parameters, returnExpr) = ParsetreeViewer.funExpr e in + and print_pexp_fun ~in_callback e cmt_tbl = + let (attrs_on_arrow, parameters, return_expr) = ParsetreeViewer.fun_expr e in let (uncurried, attrs) = - ParsetreeViewer.processUncurriedAttribute attrsOnArrow + ParsetreeViewer.process_uncurried_attribute attrs_on_arrow in - let (returnExpr, typConstraint) = match returnExpr.pexp_desc with + let (return_expr, typ_constraint) = match return_expr.pexp_desc with | Pexp_constraint (expr, typ) -> ( {expr with pexp_attributes = List.concat [ expr.pexp_attributes; - returnExpr.pexp_attributes; + return_expr.pexp_attributes; ]}, Some typ ) - | _ -> (returnExpr, None) + | _ -> (return_expr, None) in - let parametersDoc = printExprFunParameters - ~inCallback + let parameters_doc = print_expr_fun_parameters + ~in_callback ~uncurried - ~hasConstraint:(match typConstraint with | Some _ -> true | None -> false) - parameters cmtTbl in - let returnShouldIndent = match returnExpr.pexp_desc with + ~has_constraint:(match typ_constraint with | Some _ -> true | None -> false) + parameters cmt_tbl in + let return_should_indent = match return_expr.pexp_desc with | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ -> false | _ -> true in - let returnExprDoc = - let (optBraces, _) = ParsetreeViewer.processBracesAttr returnExpr in - let shouldInline = match (returnExpr.pexp_desc, optBraces) with + 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 | (_, Some _) -> true | ((Pexp_array _ | Pexp_tuple _ @@ -8923,119 +8923,119 @@ module Printer = struct | Pexp_record _), _) -> true | _ -> false in - let returnDoc = - let doc = printExpressionWithComments returnExpr cmtTbl in - match Parens.expr returnExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc returnExpr braces + let return_doc = + let doc = print_expression_with_comments return_expr cmt_tbl in + match Parens.expr return_expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc return_expr braces | Nothing -> doc in - if shouldInline then Doc.concat [ + if should_inline then Doc.concat [ Doc.space; - returnDoc; + return_doc; ] else Doc.group ( - if returnShouldIndent then + if return_should_indent then Doc.concat [ Doc.indent ( Doc.concat [ Doc.line; - returnDoc; + return_doc; ] ); - if inCallback then Doc.softLine else Doc.nil; + if in_callback then Doc.soft_line else Doc.nil; ] else Doc.concat [ Doc.space; - returnDoc; + return_doc; ] ) in - let typConstraintDoc = match typConstraint with + let typ_constraint_doc = match typ_constraint with | Some(typ) -> Doc.concat [ Doc.text ": "; - printTypExpr typ cmtTbl + print_typ_expr typ cmt_tbl ] | _ -> Doc.nil in Doc.group ( Doc.concat [ - printAttributes attrs; - parametersDoc; - typConstraintDoc; + print_attributes attrs; + parameters_doc; + typ_constraint_doc; Doc.text " =>"; - returnExprDoc; + return_expr_doc; ] ) - and printTernaryOperand expr cmtTbl = - let doc = printExpressionWithComments expr cmtTbl in - match Parens.ternaryOperand expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + and print_ternary_operand expr cmt_tbl = + let doc = print_expression_with_comments expr cmt_tbl in + match Parens.ternary_operand expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc - and printSetFieldExpr attrs lhs longidentLoc rhs loc cmtTbl = - let rhsDoc = - let doc = printExpressionWithComments rhs cmtTbl in - match Parens.setFieldExprRhs rhs with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc rhs braces + and print_set_field_expr attrs lhs longident_loc rhs loc cmt_tbl = + let rhs_doc = + let doc = print_expression_with_comments rhs cmt_tbl in + match Parens.set_field_expr_rhs rhs with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc rhs braces | Nothing -> doc in - let lhsDoc = - let doc = printExpressionWithComments lhs cmtTbl in - match Parens.fieldExpr lhs with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc lhs braces + let lhs_doc = + let doc = print_expression_with_comments lhs cmt_tbl in + match Parens.field_expr lhs with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc lhs braces | Nothing -> doc in - let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in + let should_indent = ParsetreeViewer.is_binary_expression rhs in let doc = Doc.group (Doc.concat [ - lhsDoc; + lhs_doc; Doc.dot; - printLidentPath longidentLoc cmtTbl; + print_lident_path longident_loc cmt_tbl; Doc.text " ="; - if shouldIndent then Doc.group ( + if should_indent then Doc.group ( Doc.indent ( - (Doc.concat [Doc.line; rhsDoc]) + (Doc.concat [Doc.line; rhs_doc]) ) ) else - Doc.concat [Doc.space; rhsDoc] + Doc.concat [Doc.space; rhs_doc] ]) in let doc = match attrs with | [] -> doc | attrs -> Doc.group ( Doc.concat [ - printAttributes attrs; + print_attributes attrs; doc ] ) in - printComments doc cmtTbl loc + print_comments doc cmt_tbl loc - and printTemplateLiteral expr cmtTbl = + and print_template_literal expr cmt_tbl = let tag = ref "j" in - let rec walkExpr expr = + let rec walk_expr 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 = walkExpr arg1 in - let rhs = walkExpr arg2 in + let lhs = walk_expr arg1 in + let rhs = walk_expr arg2 in Doc.concat [lhs; rhs] | Pexp_constant (Pconst_string (txt, Some prefix)) -> tag := prefix; Doc.text txt | _ -> - let doc = printExpressionWithComments expr cmtTbl in + let doc = print_expression_with_comments expr cmt_tbl in Doc.concat [Doc.text "${"; doc; Doc.rbrace] in - let content = walkExpr expr in + let content = walk_expr expr in Doc.concat [ if !tag = "j" then Doc.nil else Doc.text !tag; Doc.text "`"; @@ -9043,8 +9043,8 @@ module Printer = struct Doc.text "`" ] - and printUnaryExpression expr cmtTbl = - let printUnaryOperator op = Doc.text ( + and print_unary_expression expr cmt_tbl = + let print_unary_operator op = Doc.text ( match op with | "~+" -> "+" | "~+." -> "+." @@ -9058,23 +9058,23 @@ module Printer = struct {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [Nolabel, operand] ) -> - let printedOperand = - let doc = printExpressionWithComments operand cmtTbl in - match Parens.unaryExprOperand operand with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc operand braces + let printed_operand = + let doc = print_expression_with_comments operand cmt_tbl in + match Parens.unary_expr_operand operand with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc operand braces | Nothing -> doc in let doc = Doc.concat [ - printUnaryOperator operator; - printedOperand; + print_unary_operator operator; + printed_operand; ] in - printComments doc cmtTbl expr.pexp_loc + print_comments doc cmt_tbl expr.pexp_loc | _ -> assert false - and printBinaryExpression (expr : Parsetree.expression) cmtTbl = - let printBinaryOperator ~inlineRhs operator = - let operatorTxt = match operator with + and print_binary_expression (expr : Parsetree.expression) cmt_tbl = + let print_binary_operator ~inline_rhs operator = + let operator_txt = match operator with | "|." -> "->" | "^" -> "++" | "=" -> "==" @@ -9083,75 +9083,75 @@ module Printer = struct | "!=" -> "!==" | txt -> txt in - let spacingBeforeOperator = - if operator = "|." then Doc.softLine + let spacing_before_operator = + if operator = "|." then Doc.soft_line else if operator = "|>" then Doc.line else Doc.space; in - let spacingAfterOperator = + let spacing_after_operator = if operator = "|." then Doc.nil else if operator = "|>" then Doc.space - else if inlineRhs then Doc.space else Doc.line + else if inline_rhs then Doc.space else Doc.line in Doc.concat [ - spacingBeforeOperator; - Doc.text operatorTxt; - spacingAfterOperator; + spacing_before_operator; + Doc.text operator_txt; + spacing_after_operator; ] in - let printOperand ~isLhs expr parentOperator = - let rec flatten ~isLhs expr parentOperator = - if ParsetreeViewer.isBinaryExpression expr then + let print_operand ~is_lhs expr parent_operator = + let rec flatten ~is_lhs expr parent_operator = + if ParsetreeViewer.is_binary_expression expr then begin match expr with | {pexp_desc = Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [_, left; _, right] )} -> - if ParsetreeViewer.flattenableOperators parentOperator operator && - not (ParsetreeViewer.hasAttributes expr.pexp_attributes) + if ParsetreeViewer.flattenable_operators parent_operator operator && + not (ParsetreeViewer.has_attributes expr.pexp_attributes) then - let leftPrinted = flatten ~isLhs:true left operator in - let rightPrinted = - let (_, rightAttrs) = - ParsetreeViewer.partitionPrinteableAttributes right.pexp_attributes + let left_printed = flatten ~is_lhs:true left operator in + let right_printed = + let (_, right_attrs) = + ParsetreeViewer.partition_printeable_attributes right.pexp_attributes in let doc = - printExpressionWithComments - {right with pexp_attributes = rightAttrs} - cmtTbl + print_expression_with_comments + {right with pexp_attributes = right_attrs} + cmt_tbl in - let doc = if Parens.flattenOperandRhs parentOperator right then + let doc = if Parens.flatten_operand_rhs parent_operator right then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - let printeableAttrs = - ParsetreeViewer.filterPrinteableAttributes right.pexp_attributes + let printeable_attrs = + ParsetreeViewer.filter_printeable_attributes right.pexp_attributes in - Doc.concat [printAttributes printeableAttrs; doc] + Doc.concat [print_attributes printeable_attrs; doc] in let doc = Doc.concat [ - leftPrinted; - printBinaryOperator ~inlineRhs:false operator; - rightPrinted; + left_printed; + print_binary_operator ~inline_rhs:false operator; + right_printed; ] in let doc = - if not isLhs && (Parens.rhsBinaryExprOperand operator expr) then + if not is_lhs && (Parens.rhs_binary_expr_operand operator expr) then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - printComments doc cmtTbl expr.pexp_loc + print_comments doc cmt_tbl expr.pexp_loc else ( - let doc = printExpressionWithComments {expr with pexp_attributes = []} cmtTbl in - let doc = if Parens.subBinaryExprOperand parentOperator operator || + let doc = print_expression_with_comments {expr with pexp_attributes = []} cmt_tbl in + let doc = if Parens.sub_binary_expr_operand parent_operator operator || (expr.pexp_attributes <> [] && - (ParsetreeViewer.isBinaryExpression expr || - ParsetreeViewer.isTernaryExpr expr)) + (ParsetreeViewer.is_binary_expression expr || + ParsetreeViewer.is_ternary_expr expr)) then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in Doc.concat [ - printAttributes expr.pexp_attributes; + print_attributes expr.pexp_attributes; doc ] ) @@ -9160,24 +9160,24 @@ module Printer = struct else begin match expr.pexp_desc with | Pexp_setfield (lhs, field, rhs) -> - let doc = printSetFieldExpr expr.pexp_attributes lhs field rhs expr.pexp_loc cmtTbl in - if isLhs then addParens doc else doc + let doc = print_set_field_expr expr.pexp_attributes lhs field rhs expr.pexp_loc cmt_tbl in + if is_lhs then add_parens doc else doc | Pexp_apply( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> - let rhsDoc = printExpressionWithComments rhs cmtTbl in - let lhsDoc = printExpressionWithComments lhs cmtTbl in + let rhs_doc = print_expression_with_comments rhs cmt_tbl in + let lhs_doc = print_expression_with_comments lhs cmt_tbl in (* TODO: unify indentation of "=" *) - let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in + let should_indent = ParsetreeViewer.is_binary_expression rhs in let doc = Doc.group ( Doc.concat [ - lhsDoc; + lhs_doc; Doc.text " ="; - if shouldIndent then Doc.group ( - Doc.indent (Doc.concat [Doc.line; rhsDoc]) + if should_indent then Doc.group ( + Doc.indent (Doc.concat [Doc.line; rhs_doc]) ) else - Doc.concat [Doc.space; rhsDoc] + Doc.concat [Doc.space; rhs_doc] ] ) in let doc = match expr.pexp_attributes with @@ -9185,41 +9185,41 @@ module Printer = struct | attrs -> Doc.group ( Doc.concat [ - printAttributes attrs; + print_attributes attrs; doc ] ) in - if isLhs then addParens doc else doc + if is_lhs then add_parens doc else doc | _ -> - let doc = printExpressionWithComments expr cmtTbl in - begin match Parens.binaryExprOperand ~isLhs expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + let doc = print_expression_with_comments expr cmt_tbl in + begin match Parens.binary_expr_operand ~is_lhs expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc end end in - flatten ~isLhs expr parentOperator + flatten ~is_lhs expr parent_operator in match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident (("|." | "|>") as op)}}, [Nolabel, lhs; Nolabel, rhs] ) when not ( - ParsetreeViewer.isBinaryExpression lhs || - ParsetreeViewer.isBinaryExpression rhs + ParsetreeViewer.is_binary_expression lhs || + ParsetreeViewer.is_binary_expression rhs ) -> - let lhsDoc = printOperand ~isLhs:true lhs op in - let rhsDoc = printOperand ~isLhs:false rhs op in + let lhs_doc = print_operand ~is_lhs:true lhs op in + let rhs_doc = print_operand ~is_lhs:false rhs op in Doc.group ( Doc.concat [ - lhsDoc; + lhs_doc; (match op with | "|." -> Doc.text "->" | "|>" -> Doc.text " |> " | _ -> assert false); - rhsDoc; + rhs_doc; ] ) | Pexp_apply ( @@ -9227,65 +9227,65 @@ module Printer = struct [Nolabel, lhs; Nolabel, rhs] ) -> let right = - let operatorWithRhs = - let rhsDoc = printOperand ~isLhs:false rhs operator in + let operator_with_rhs = + let rhs_doc = print_operand ~is_lhs:false rhs operator in Doc.concat [ - printBinaryOperator - ~inlineRhs:(ParsetreeViewer.shouldInlineRhsBinaryExpr rhs) operator; - rhsDoc; + print_binary_operator + ~inline_rhs:(ParsetreeViewer.should_inline_rhs_binary_expr rhs) operator; + rhs_doc; ] in - if ParsetreeViewer.shouldIndentBinaryExpr expr then - Doc.group (Doc.indent operatorWithRhs) - else operatorWithRhs + if ParsetreeViewer.should_indent_binary_expr expr then + Doc.group (Doc.indent operator_with_rhs) + else operator_with_rhs in let doc = Doc.group ( Doc.concat [ - printOperand ~isLhs:true lhs operator; + print_operand ~is_lhs:true lhs operator; right ] ) in Doc.group ( Doc.concat [ - printAttributes expr.pexp_attributes; - match Parens.binaryExpr {expr with + print_attributes expr.pexp_attributes; + match Parens.binary_expr {expr with pexp_attributes = List.filter (fun attr -> match attr with | ({Location.txt = ("res.braces")}, _) -> false | _ -> true ) expr.pexp_attributes } with - | Braced(bracesLoc) -> printBraces doc expr bracesLoc - | Parenthesized -> addParens doc + | Braced(braces_loc) -> print_braces doc expr braces_loc + | Parenthesized -> add_parens doc | Nothing -> doc; ] ) | _ -> Doc.nil (* callExpr(arg1, arg2) *) - and printPexpApply expr cmtTbl = + and print_pexp_apply expr cmt_tbl = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}}, - [Nolabel, parentExpr; Nolabel, memberExpr] + [Nolabel, parent_expr; Nolabel, member_expr] ) -> - let parentDoc = - let doc = printExpressionWithComments parentExpr cmtTbl in - match Parens.unaryExprOperand parentExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc parentExpr braces + let parent_doc = + let doc = print_expression_with_comments 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 | Nothing -> doc in let member = - let memberDoc = match memberExpr.pexp_desc with + let member_doc = match member_expr.pexp_desc with | Pexp_ident lident -> - printComments (printLongident lident.txt) cmtTbl memberExpr.pexp_loc - | _ -> printExpressionWithComments memberExpr cmtTbl + print_comments (print_longident lident.txt) cmt_tbl member_expr.pexp_loc + | _ -> print_expression_with_comments member_expr cmt_tbl in - Doc.concat [Doc.text "\""; memberDoc; Doc.text "\""] + Doc.concat [Doc.text "\""; member_doc; Doc.text "\""] in Doc.group (Doc.concat [ - printAttributes expr.pexp_attributes; - parentDoc; + print_attributes expr.pexp_attributes; + parent_doc; Doc.lbracket; member; Doc.rbracket; @@ -9294,25 +9294,25 @@ module Printer = struct {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [Nolabel, lhs; Nolabel, rhs] ) -> - let rhsDoc = - let doc = printExpressionWithComments rhs cmtTbl in + let rhs_doc = + let doc = print_expression_with_comments rhs cmt_tbl in match Parens.expr rhs with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc rhs braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc rhs braces | Nothing -> doc in (* TODO: unify indentation of "=" *) - let shouldIndent = not (ParsetreeViewer.isBracedExpr rhs) && ParsetreeViewer.isBinaryExpression rhs in + let should_indent = not (ParsetreeViewer.is_braced_expr rhs) && ParsetreeViewer.is_binary_expression rhs in let doc = Doc.group( Doc.concat [ - printExpressionWithComments lhs cmtTbl; + print_expression_with_comments lhs cmt_tbl; Doc.text " ="; - if shouldIndent then Doc.group ( + if should_indent then Doc.group ( Doc.indent ( - (Doc.concat [Doc.line; rhsDoc]) + (Doc.concat [Doc.line; rhs_doc]) ) ) else - Doc.concat [Doc.space; rhsDoc] + Doc.concat [Doc.space; rhs_doc] ] ) in begin match expr.pexp_attributes with @@ -9320,131 +9320,131 @@ module Printer = struct | attrs -> Doc.group ( Doc.concat [ - printAttributes attrs; + print_attributes attrs; doc ] ) end | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}}, - [Nolabel, parentExpr; Nolabel, memberExpr] + [Nolabel, parent_expr; Nolabel, member_expr] ) -> let member = - let memberDoc = - let doc = printExpressionWithComments memberExpr cmtTbl in - match Parens.expr memberExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc memberExpr braces + let member_doc = + let doc = print_expression_with_comments member_expr cmt_tbl in + match Parens.expr member_expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc member_expr braces | Nothing -> doc in - let shouldInline = match memberExpr.pexp_desc with + let should_inline = match member_expr.pexp_desc with | Pexp_constant _ | Pexp_ident _ -> true | _ -> false in - if shouldInline then memberDoc else ( + if should_inline then member_doc else ( Doc.concat [ Doc.indent ( Doc.concat [ - Doc.softLine; - memberDoc; + Doc.soft_line; + member_doc; ] ); - Doc.softLine + Doc.soft_line ] ) in - let parentDoc = - let doc = printExpressionWithComments parentExpr cmtTbl in - match Parens.unaryExprOperand parentExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc parentExpr braces + let parent_doc = + let doc = print_expression_with_comments 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 | Nothing -> doc in Doc.group (Doc.concat [ - printAttributes expr.pexp_attributes; - parentDoc; + print_attributes expr.pexp_attributes; + parent_doc; Doc.lbracket; member; Doc.rbracket; ]) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "set")}}, - [Nolabel, parentExpr; Nolabel, memberExpr; Nolabel, targetExpr] + [Nolabel, parent_expr; Nolabel, member_expr; Nolabel, target_expr] ) -> let member = - let memberDoc = - let doc = printExpressionWithComments memberExpr cmtTbl in - match Parens.expr memberExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc memberExpr braces + let member_doc = + let doc = print_expression_with_comments member_expr cmt_tbl in + match Parens.expr member_expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc member_expr braces | Nothing -> doc in - let shouldInline = match memberExpr.pexp_desc with + let should_inline = match member_expr.pexp_desc with | Pexp_constant _ | Pexp_ident _ -> true | _ -> false in - if shouldInline then memberDoc else ( + if should_inline then member_doc else ( Doc.concat [ Doc.indent ( Doc.concat [ - Doc.softLine; - memberDoc; + Doc.soft_line; + member_doc; ] ); - Doc.softLine + Doc.soft_line ] ) in - let shouldIndentTargetExpr = - if ParsetreeViewer.isBracedExpr targetExpr then + let should_indent_target_expr = + if ParsetreeViewer.is_braced_expr target_expr then false else - ParsetreeViewer.isBinaryExpression targetExpr || - (match targetExpr with + ParsetreeViewer.is_binary_expression target_expr || + (match target_expr with | { pexp_attributes = [({Location.txt="res.ternary"}, _)]; - pexp_desc = Pexp_ifthenelse (ifExpr, _, _) + pexp_desc = Pexp_ifthenelse (if_expr, _, _) } -> - ParsetreeViewer.isBinaryExpression ifExpr || ParsetreeViewer.hasAttributes ifExpr.pexp_attributes + ParsetreeViewer.is_binary_expression if_expr || ParsetreeViewer.has_attributes if_expr.pexp_attributes | { pexp_desc = Pexp_newtype _} -> false | e -> - ParsetreeViewer.hasAttributes e.pexp_attributes || - ParsetreeViewer.isArrayAccess e + ParsetreeViewer.has_attributes e.pexp_attributes || + ParsetreeViewer.is_array_access e ) in - let targetExpr = - let doc = printExpressionWithComments targetExpr cmtTbl in - match Parens.expr targetExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc targetExpr braces + let target_expr = + let doc = print_expression_with_comments target_expr cmt_tbl in + match Parens.expr target_expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc target_expr braces | Nothing -> doc in - let parentDoc = - let doc = printExpressionWithComments parentExpr cmtTbl in - match Parens.unaryExprOperand parentExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc parentExpr braces + let parent_doc = + let doc = print_expression_with_comments 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 | Nothing -> doc in Doc.group ( Doc.concat [ - printAttributes expr.pexp_attributes; - parentDoc; + print_attributes expr.pexp_attributes; + parent_doc; Doc.lbracket; member; Doc.rbracket; Doc.text " ="; - if shouldIndentTargetExpr then + if should_indent_target_expr then Doc.indent ( Doc.concat [ Doc.line; - targetExpr; + target_expr; ] ) else Doc.concat [ Doc.space; - targetExpr; + target_expr; ] ] ) @@ -9452,86 +9452,86 @@ module Printer = struct | Pexp_apply ( {pexp_desc = Pexp_ident lident}, args - ) when ParsetreeViewer.isJsxExpression expr -> - printJsxExpression lident args cmtTbl - | Pexp_apply (callExpr, args) -> + ) when ParsetreeViewer.is_jsx_expression expr -> + print_jsx_expression lident args cmt_tbl + | Pexp_apply (call_expr, args) -> let args = List.map (fun (lbl, arg) -> - (lbl, ParsetreeViewer.rewriteUnderscoreApply arg) + (lbl, ParsetreeViewer.rewrite_underscore_apply arg) ) args in let (uncurried, attrs) = - ParsetreeViewer.processUncurriedAttribute expr.pexp_attributes + ParsetreeViewer.process_uncurried_attribute expr.pexp_attributes in - let callExprDoc = - let doc = printExpressionWithComments callExpr cmtTbl in - match Parens.callExpr callExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc callExpr braces + let call_expr_doc = + let doc = print_expression_with_comments 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 | Nothing -> doc in - if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then - let argsDoc = - printArgumentsWithCallbackInFirstPosition ~uncurried args cmtTbl + if ParsetreeViewer.requires_special_callback_printing_first_arg args then + let args_doc = + print_arguments_with_callback_in_first_position ~uncurried args cmt_tbl in Doc.concat [ - printAttributes attrs; - callExprDoc; - argsDoc; + print_attributes attrs; + call_expr_doc; + args_doc; ] - else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then - let argsDoc = - printArgumentsWithCallbackInLastPosition ~uncurried args cmtTbl + else if ParsetreeViewer.requires_special_callback_printing_last_arg args then + let args_doc = + print_arguments_with_callback_in_last_position ~uncurried args cmt_tbl in Doc.concat [ - printAttributes attrs; - callExprDoc; - argsDoc; + print_attributes attrs; + call_expr_doc; + args_doc; ] else - let argsDoc = printArguments ~uncurried args cmtTbl in + let args_doc = print_arguments ~uncurried args cmt_tbl in Doc.concat [ - printAttributes attrs; - callExprDoc; - argsDoc; + print_attributes attrs; + call_expr_doc; + args_doc; ] | _ -> assert false - and printJsxExpression lident args cmtTbl = - let name = printJsxName lident in - let (formattedProps, children) = printJsxProps args cmtTbl in + and print_jsx_expression lident args cmt_tbl = + let name = print_jsx_name lident in + let (formatted_props, children) = print_jsx_props args cmt_tbl in (*
*) - let isSelfClosing = match children with | [] -> true | _ -> false in + let is_self_closing = match children with | [] -> true | _ -> false in Doc.group ( Doc.concat [ Doc.group ( Doc.concat [ - printComments (Doc.concat [Doc.lessThan; name]) cmtTbl lident.Asttypes.loc; - formattedProps; - if isSelfClosing then Doc.concat [Doc.line; Doc.text "/>"] else Doc.nil + print_comments (Doc.concat [Doc.less_than; name]) cmt_tbl lident.Asttypes.loc; + formatted_props; + if is_self_closing then Doc.concat [Doc.line; Doc.text "/>"] else Doc.nil ] ); - if isSelfClosing then Doc.nil + if is_self_closing then Doc.nil else Doc.concat [ - Doc.greaterThan; + Doc.greater_than; Doc.indent ( Doc.concat [ Doc.line; - printJsxChildren children cmtTbl; + print_jsx_children children cmt_tbl; ] ); Doc.line; Doc.text "" in let closing = Doc.text "" in - let (children, _) = ParsetreeViewer.collectListExpressions expr in + let (children, _) = ParsetreeViewer.collect_list_expressions expr in Doc.group ( Doc.concat [ opening; @@ -9541,7 +9541,7 @@ module Printer = struct Doc.indent ( Doc.concat [ Doc.line; - printJsxChildren children cmtTbl; + print_jsx_children children cmt_tbl; ] ) end; @@ -9550,21 +9550,21 @@ module Printer = struct ] ) - and printJsxChildren (children: Parsetree.expression list) cmtTbl = + and print_jsx_children (children: Parsetree.expression list) cmt_tbl = Doc.group ( Doc.join ~sep:Doc.line ( List.map (fun expr -> - let exprDoc = printExpressionWithComments expr cmtTbl in - match Parens.jsxChildExpr expr with + let expr_doc = print_expression_with_comments expr cmt_tbl in + match Parens.jsx_child_expr expr with | Parenthesized | Braced _ -> (* {(20: int)} make sure that we also protect the expression inside *) - addBraces (if Parens.bracedExpr expr then addParens exprDoc else exprDoc) - | Nothing -> exprDoc + add_braces (if Parens.braced_expr expr then add_parens expr_doc else expr_doc) + | Nothing -> expr_doc ) children ) ) - and printJsxProps args cmtTbl = + and print_jsx_props args cmt_tbl = let rec loop props args = match args with | [] -> (Doc.nil, []) @@ -9575,7 +9575,7 @@ module Printer = struct {Parsetree.pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None)} ) ] -> - let formattedProps = Doc.indent ( + let formatted_props = Doc.indent ( match props with | [] -> Doc.nil | props -> @@ -9586,86 +9586,86 @@ module Printer = struct ) ] ) in - let (children, _) = ParsetreeViewer.collectListExpressions children in - (formattedProps, children) + let (children, _) = ParsetreeViewer.collect_list_expressions children in + (formatted_props, children) | arg::args -> - let propDoc = printJsxProp arg cmtTbl in - loop (propDoc::props) args + let prop_doc = print_jsx_prop arg cmt_tbl in + loop (prop_doc::props) args in loop [] args - and printJsxProp arg cmtTbl = + and print_jsx_prop arg cmt_tbl = match arg with | ( - (Asttypes.Labelled lblTxt | Optional lblTxt) as lbl, + (Asttypes.Labelled lbl_txt | Optional lbl_txt) as lbl, { - Parsetree.pexp_attributes = [({Location.txt = "res.namedArgLoc"; loc = argLoc}, _)]; + Parsetree.pexp_attributes = [({Location.txt = "res.namedArgLoc"; loc = arg_loc}, _)]; pexp_desc = Pexp_ident {txt = Longident.Lident ident} } - ) when lblTxt = ident (* jsx punning *) -> + ) when lbl_txt = ident (* jsx punning *) -> begin match lbl with | Nolabel -> Doc.nil | Labelled _lbl -> - printComments (printIdentLike ident) cmtTbl argLoc + print_comments (print_ident_like ident) cmt_tbl arg_loc | Optional _lbl -> let doc = Doc.concat [ Doc.question; - printIdentLike ident; + print_ident_like ident; ] in - printComments doc cmtTbl argLoc + print_comments doc cmt_tbl arg_loc end | ( - (Asttypes.Labelled lblTxt | Optional lblTxt) as lbl, + (Asttypes.Labelled lbl_txt | Optional lbl_txt) as lbl, { Parsetree.pexp_attributes = []; pexp_desc = Pexp_ident {txt = Longident.Lident ident} } - ) when lblTxt = ident (* jsx punning when printing from Reason *) -> + ) when lbl_txt = ident (* jsx punning when printing from Reason *) -> begin match lbl with | Nolabel -> Doc.nil - | Labelled _lbl -> printIdentLike ident + | Labelled _lbl -> print_ident_like ident | Optional _lbl -> Doc.concat [ Doc.question; - printIdentLike ident; + print_ident_like ident; ] end | (lbl, expr) -> - let (argLoc, expr) = match expr.pexp_attributes with + let (arg_loc, expr) = match expr.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _)::attrs -> (loc, {expr with pexp_attributes = attrs}) | _ -> Location.none, expr in - let lblDoc = match lbl with + let lbl_doc = match lbl with | Asttypes.Labelled lbl -> - let lbl = printComments (printIdentLike lbl) cmtTbl argLoc in + let lbl = print_comments (print_ident_like lbl) cmt_tbl arg_loc in Doc.concat [lbl; Doc.equal] | Asttypes.Optional lbl -> - let lbl = printComments (printIdentLike lbl) cmtTbl argLoc in + let lbl = print_comments (print_ident_like lbl) cmt_tbl arg_loc in Doc.concat [lbl; Doc.equal; Doc.question] | Nolabel -> Doc.nil in - let exprDoc = - let doc = printExpression expr cmtTbl in - match Parens.jsxPropExpr expr with + let expr_doc = + let doc = print_expression expr cmt_tbl in + match Parens.jsx_prop_expr expr with | Parenthesized | Braced(_) -> (* {(20: int)} make sure that we also protect the expression inside *) - addBraces (if Parens.bracedExpr expr then addParens doc else doc) + add_braces (if Parens.braced_expr expr then add_parens doc else doc) | _ -> doc in - let fullLoc = {argLoc with loc_end = expr.pexp_loc.loc_end} in - printComments + let full_loc = {arg_loc with loc_end = expr.pexp_loc.loc_end} in + print_comments (Doc.concat [ - lblDoc; - exprDoc; + lbl_doc; + expr_doc; ]) - cmtTbl - fullLoc + cmt_tbl + full_loc (* div -> div. * Navabar.createElement -> Navbar * Staff.Users.createElement -> Staff.Users *) - and printJsxName {txt = lident} = + and print_jsx_name {txt = lident} = let rec flatten acc lident = match lident with | Longident.Lident txt -> txt::acc | Ldot (lident, txt) -> @@ -9679,29 +9679,29 @@ module Printer = struct let segments = flatten [] lident in Doc.join ~sep:Doc.dot (List.map Doc.text segments) - and printArgumentsWithCallbackInFirstPosition ~uncurried args cmtTbl = - let (callback, printedArgs) = match args with + and print_arguments_with_callback_in_first_position ~uncurried args cmt_tbl = + let (callback, printed_args) = match args with | (lbl, expr)::args -> - let lblDoc = match lbl with + let lbl_doc = match lbl with | Asttypes.Nolabel -> Doc.nil | Asttypes.Labelled txt -> Doc.concat [ - Doc.tilde; printIdentLike txt; Doc.equal; + Doc.tilde; print_ident_like txt; Doc.equal; ] | Asttypes.Optional txt -> Doc.concat [ - Doc.tilde; printIdentLike txt; Doc.equal; Doc.question; + Doc.tilde; print_ident_like txt; Doc.equal; Doc.question; ] in let callback = Doc.concat [ - lblDoc; - printPexpFun ~inCallback:true expr cmtTbl + lbl_doc; + print_pexp_fun ~in_callback:true expr cmt_tbl ] in - let printedArgs = List.map (fun arg -> - printArgument arg cmtTbl + let printed_args = List.map (fun arg -> + print_argument arg cmt_tbl ) args |> Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) in - (callback, printedArgs) + (callback, printed_args) | _ -> assert false in (* Thing.map((arg1, arg2) => MyModuleBlah.toList(argument), foo) *) @@ -9709,12 +9709,12 @@ module Printer = struct * MyModuleBlah.toList(argument) * }, longArgumet, veryLooooongArgument) *) - let fitsOnOneLine = Doc.concat [ + let fits_on_one_line = Doc.concat [ if uncurried then Doc.text "(. " else Doc.lparen; callback; Doc.comma; Doc.line; - printedArgs; + printed_args; Doc.rparen; ] in @@ -9725,39 +9725,39 @@ module Printer = struct * arg3, * ) *) - let breakAllArgs = printArguments ~uncurried args cmtTbl in - Doc.customLayout [ - fitsOnOneLine; - breakAllArgs; + let break_all_args = print_arguments ~uncurried args cmt_tbl in + Doc.custom_layout [ + fits_on_one_line; + break_all_args; ] - and printArgumentsWithCallbackInLastPosition ~uncurried args cmtTbl = + and print_arguments_with_callback_in_last_position ~uncurried args cmt_tbl = let rec loop acc args = match args with | [] -> (Doc.nil, Doc.nil) | [lbl, expr] -> - let lblDoc = match lbl with + let lbl_doc = match lbl with | Asttypes.Nolabel -> Doc.nil | Asttypes.Labelled txt -> Doc.concat [ - Doc.tilde; printIdentLike txt; Doc.equal; + Doc.tilde; print_ident_like txt; Doc.equal; ] | Asttypes.Optional txt -> Doc.concat [ - Doc.tilde; printIdentLike txt; Doc.equal; Doc.question; + Doc.tilde; print_ident_like txt; Doc.equal; Doc.question; ] in - let callback = printPexpFun ~inCallback:true expr cmtTbl in - (Doc.concat (List.rev acc), Doc.concat [lblDoc; callback]) + let callback = print_pexp_fun ~in_callback:true expr cmt_tbl in + (Doc.concat (List.rev acc), Doc.concat [lbl_doc; callback]) | arg::args -> - let argDoc = printArgument arg cmtTbl in - loop (Doc.line::Doc.comma::argDoc::acc) args + let arg_doc = print_argument arg cmt_tbl in + loop (Doc.line::Doc.comma::arg_doc::acc) args in - let (printedArgs, callback) = loop [] args in + let (printed_args, callback) = loop [] args in (* Thing.map(foo, (arg1, arg2) => MyModuleBlah.toList(argument)) *) - let fitsOnOneLine = Doc.concat [ + let fits_on_one_line = Doc.concat [ if uncurried then Doc.text "(." else Doc.lparen; - printedArgs; + printed_args; callback; Doc.rparen; ] in @@ -9766,13 +9766,13 @@ module Printer = struct * MyModuleBlah.toList(argument) * ) *) - let arugmentsFitOnOneLine = + let arugments_fit_on_one_line = Doc.concat [ if uncurried then Doc.text "(." else Doc.lparen; - Doc.softLine; - printedArgs; - Doc.breakableGroup ~forceBreak:true callback; - Doc.softLine; + Doc.soft_line; + printed_args; + Doc.breakable_group ~force_break:true callback; + Doc.soft_line; Doc.rparen; ] in @@ -9784,28 +9784,28 @@ module Printer = struct * (param1, parm2) => doStuff(param1, parm2) * ) *) - let breakAllArgs = printArguments ~uncurried args cmtTbl in - Doc.customLayout [ - fitsOnOneLine; - arugmentsFitOnOneLine; - breakAllArgs; + let break_all_args = print_arguments ~uncurried args cmt_tbl in + Doc.custom_layout [ + fits_on_one_line; + arugments_fit_on_one_line; + break_all_args; ] - and printArguments ~uncurried (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl = + and print_arguments ~uncurried (args : (Asttypes.arg_label * Parsetree.expression) list) cmt_tbl = match args with | [Nolabel, {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}] -> if uncurried then Doc.text "(.)" else Doc.text "()" - | [(Nolabel, arg)] when ParsetreeViewer.isHuggableExpression arg -> - let argDoc = - let doc = printExpressionWithComments arg cmtTbl in + | [(Nolabel, arg)] when ParsetreeViewer.is_huggable_expression arg -> + let arg_doc = + let doc = print_expression_with_comments arg cmt_tbl in match Parens.expr arg with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc arg braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc arg braces | Nothing -> doc in Doc.concat [ if uncurried then Doc.text "(." else Doc.lparen; - argDoc; + arg_doc; Doc.rparen; ] | args -> Doc.group ( @@ -9813,14 +9813,14 @@ module Printer = struct if uncurried then Doc.text "(." else Doc.lparen; Doc.indent ( Doc.concat [ - if uncurried then Doc.line else Doc.softLine; + if uncurried then Doc.line else Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun arg -> printArgument arg cmtTbl) args + List.map (fun arg -> print_argument arg cmt_tbl) args ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) @@ -9839,36 +9839,36 @@ module Printer = struct * | ~ label-name = ? expr * | ~ label-name = ? _ (* syntax sugar *) * | ~ label-name = ? expr : type *) - and printArgument (argLbl, arg) cmtTbl = - match (argLbl, arg) with + and print_argument (arg_lbl, arg) cmt_tbl = + match (arg_lbl, arg) with (* ~a (punned)*) | ( (Asttypes.Labelled lbl), ({pexp_desc=Pexp_ident {txt = Longident.Lident name}; pexp_attributes = ([] | [({Location.txt = "res.namedArgLoc";}, _)]) - } as argExpr) - ) when lbl = name && not (ParsetreeViewer.isBracedExpr argExpr) -> + } as arg_expr) + ) when lbl = name && not (ParsetreeViewer.is_braced_expr arg_expr) -> let loc = match arg.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _)::_ -> loc | _ -> arg.pexp_loc in let doc = Doc.concat [ Doc.tilde; - printIdentLike lbl + print_ident_like lbl ] in - printComments doc cmtTbl loc + print_comments doc cmt_tbl loc (* ~a: int (punned)*) | ( (Asttypes.Labelled lbl), {pexp_desc = Pexp_constraint ( - {pexp_desc = Pexp_ident {txt = Longident.Lident name}} as argExpr, + {pexp_desc = Pexp_ident {txt = Longident.Lident name}} as arg_expr, typ ); pexp_loc; pexp_attributes = ([] | [({Location.txt = "res.namedArgLoc";}, _)]) as attrs } - ) when lbl = name && not (ParsetreeViewer.isBracedExpr argExpr) -> + ) when lbl = name && not (ParsetreeViewer.is_braced_expr arg_expr) -> let loc = match attrs with | ({Location.txt = "res.namedArgLoc"; loc}, _)::_ -> {loc with loc_end = pexp_loc.loc_end} @@ -9876,11 +9876,11 @@ module Printer = struct in let doc = Doc.concat [ Doc.tilde; - printIdentLike lbl; + print_ident_like lbl; Doc.text ": "; - printTypExpr typ cmtTbl; + print_typ_expr typ cmt_tbl; ] in - printComments doc cmtTbl loc + print_comments doc cmt_tbl loc (* ~a? (optional lbl punned)*) | ( (Asttypes.Optional lbl), @@ -9894,74 +9894,74 @@ module Printer = struct in let doc = Doc.concat [ Doc.tilde; - printIdentLike lbl; + print_ident_like lbl; Doc.question; ] in - printComments doc cmtTbl loc + print_comments doc cmt_tbl loc | (_lbl, expr) -> - let (argLoc, expr) = match expr.pexp_attributes with + let (arg_loc, expr) = match expr.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _)::attrs -> (loc, {expr with pexp_attributes = attrs}) | _ -> expr.pexp_loc, expr in - let printedLbl = match argLbl with + let printed_lbl = match arg_lbl with | Asttypes.Nolabel -> Doc.nil | Asttypes.Labelled lbl -> - let doc = Doc.concat [Doc.tilde; printIdentLike lbl; Doc.equal] in - printComments doc cmtTbl argLoc + let doc = Doc.concat [Doc.tilde; print_ident_like lbl; Doc.equal] in + print_comments doc cmt_tbl arg_loc | Asttypes.Optional lbl -> - let doc = Doc.concat [Doc.tilde; printIdentLike lbl; Doc.equal; Doc.question] in - printComments doc cmtTbl argLoc + let doc = Doc.concat [Doc.tilde; print_ident_like lbl; Doc.equal; Doc.question] in + print_comments doc cmt_tbl arg_loc in - let printedExpr = - let doc = printExpressionWithComments expr cmtTbl in + let printed_expr = + let doc = print_expression_with_comments expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in - let loc = {argLoc with loc_end = expr.pexp_loc.loc_end} in + let loc = {arg_loc with loc_end = expr.pexp_loc.loc_end} in let doc = Doc.concat [ - printedLbl; - printedExpr; + printed_lbl; + printed_expr; ] in - printComments doc cmtTbl loc + print_comments doc cmt_tbl loc - and printCases (cases: Parsetree.case list) cmtTbl = - Doc.breakableGroup ~forceBreak:true ( + and print_cases (cases: Parsetree.case list) cmt_tbl = + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.lbrace; Doc.concat [ Doc.line; - printList - ~getLoc:(fun n -> {n.Parsetree.pc_lhs.ppat_loc with + print_list + ~get_loc:(fun n -> {n.Parsetree.pc_lhs.ppat_loc with loc_end = - match ParsetreeViewer.processBracesAttr n.Parsetree.pc_rhs with + match ParsetreeViewer.process_braces_attr n.Parsetree.pc_rhs with | (None, _) -> n.pc_rhs.pexp_loc.loc_end | (Some ({loc}, _), _) -> loc.Location.loc_end }) - ~print:printCase + ~print:print_case ~nodes:cases - cmtTbl + cmt_tbl ]; Doc.line; Doc.rbrace; ] ) - and printCase (case: Parsetree.case) cmtTbl = + and print_case (case: Parsetree.case) cmt_tbl = let rhs = match case.pc_rhs.pexp_desc with | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ | Pexp_sequence _ -> - printExpressionBlock ~braces:(ParsetreeViewer.isBracedExpr case.pc_rhs) case.pc_rhs cmtTbl + print_expression_block ~braces:(ParsetreeViewer.is_braced_expr case.pc_rhs) case.pc_rhs cmt_tbl | _ -> - let doc = printExpressionWithComments case.pc_rhs cmtTbl in + let doc = print_expression_with_comments case.pc_rhs cmt_tbl in begin match Parens.expr case.pc_rhs with - | Parenthesized -> addParens doc + | Parenthesized -> add_parens doc | _ -> doc end @@ -9972,34 +9972,34 @@ module Printer = struct Doc.concat [ Doc.line; Doc.text "when "; - printExpressionWithComments expr cmtTbl; + print_expression_with_comments expr cmt_tbl; ] ) in - let shouldInlineRhs = match case.pc_rhs.pexp_desc with + let should_inline_rhs = match case.pc_rhs.pexp_desc with | Pexp_construct ({txt = Longident.Lident ("()" | "true" | "false")}, _) | Pexp_constant _ | Pexp_ident _ -> true - | _ when ParsetreeViewer.isHuggableRhs case.pc_rhs -> true + | _ when ParsetreeViewer.is_huggable_rhs case.pc_rhs -> true | _ -> false in - let shouldIndentPattern = match case.pc_lhs.ppat_desc with + let should_indent_pattern = match case.pc_lhs.ppat_desc with | Ppat_or _ -> false | _ -> true in - let patternDoc = - let doc = printPattern case.pc_lhs cmtTbl in + let pattern_doc = + let doc = print_pattern case.pc_lhs cmt_tbl in match case.pc_lhs.ppat_desc with - | Ppat_constraint _ -> addParens doc + | Ppat_constraint _ -> add_parens doc | _ -> doc in let content = Doc.concat [ - if shouldIndentPattern then Doc.indent patternDoc else patternDoc; + if should_indent_pattern then Doc.indent pattern_doc else pattern_doc; Doc.indent guard; Doc.text " =>"; Doc.indent ( Doc.concat [ - if shouldInlineRhs then Doc.space else Doc.line; + if should_inline_rhs then Doc.space else Doc.line; rhs; ] ) @@ -10011,97 +10011,97 @@ module Printer = struct ] ) - and printExprFunParameters ~inCallback ~uncurried ~hasConstraint parameters cmtTbl = + and print_expr_fun_parameters ~in_callback ~uncurried ~has_constraint parameters cmt_tbl = match parameters with (* let f = _ => () *) | [ParsetreeViewer.Parameter { attrs = []; lbl = Asttypes.Nolabel; - defaultExpr = None; + default_expr = None; pat = {Parsetree.ppat_desc = Ppat_any} }] when not uncurried -> - if hasConstraint then Doc.text "(_)" else Doc.text "_" + if has_constraint then Doc.text "(_)" else Doc.text "_" (* let f = a => () *) | [ParsetreeViewer.Parameter { attrs = []; lbl = Asttypes.Nolabel; - defaultExpr = None; - pat = {Parsetree.ppat_desc = Ppat_var stringLoc} + default_expr = None; + pat = {Parsetree.ppat_desc = Ppat_var string_loc} }] when not uncurried -> - let txtDoc = - let var = printIdentLike stringLoc.txt in - if hasConstraint then addParens var else var + let txt_doc = + let var = print_ident_like string_loc.txt in + if has_constraint then add_parens var else var in - printComments txtDoc cmtTbl stringLoc.loc + print_comments txt_doc cmt_tbl string_loc.loc (* let f = () => () *) | [ParsetreeViewer.Parameter { attrs = []; lbl = Asttypes.Nolabel; - defaultExpr = None; + default_expr = None; pat = {ppat_desc = Ppat_construct({txt = Longident.Lident "()"}, None)} }] when not uncurried -> Doc.text "()" (* let f = (~greeting, ~from as hometown, ~x=?) => () *) | parameters -> let lparen = if uncurried then Doc.text "(. " else Doc.lparen in - let shouldHug = ParsetreeViewer.parametersShouldHug parameters in - let printedParamaters = Doc.concat [ - if shouldHug || inCallback then Doc.nil else Doc.softLine; - Doc.join ~sep:(Doc.concat [Doc.comma; if inCallback then Doc.space else Doc.line]) - (List.map (fun p -> printExpFunParameter p cmtTbl) parameters) + let should_hug = ParsetreeViewer.parameters_should_hug parameters in + let printed_paramaters = Doc.concat [ + if should_hug || in_callback then Doc.nil else Doc.soft_line; + Doc.join ~sep:(Doc.concat [Doc.comma; if in_callback then Doc.space else Doc.line]) + (List.map (fun p -> print_exp_fun_parameter p cmt_tbl) parameters) ] in Doc.group ( Doc.concat [ lparen; - if shouldHug || inCallback then - printedParamaters - else Doc.indent printedParamaters; - if shouldHug || inCallback then + if should_hug || in_callback then + printed_paramaters + else Doc.indent printed_paramaters; + if should_hug || in_callback then Doc.nil else - Doc.concat [Doc.trailingComma; Doc.softLine]; + Doc.concat [Doc.trailing_comma; Doc.soft_line]; Doc.rparen; ] ) - and printExpFunParameter parameter cmtTbl = + and print_exp_fun_parameter parameter cmt_tbl = match parameter with | ParsetreeViewer.NewTypes {attrs; locs = lbls} -> Doc.group ( Doc.concat [ - printAttributes attrs; + print_attributes attrs; Doc.text "type "; Doc.join ~sep:Doc.space (List.map (fun lbl -> - printComments (printIdentLike lbl.Asttypes.txt) cmtTbl lbl.Asttypes.loc + print_comments (print_ident_like lbl.Asttypes.txt) cmt_tbl lbl.Asttypes.loc ) lbls) ] ) - | Parameter {attrs; lbl; defaultExpr; pat = pattern} -> - let (isUncurried, attrs) = ParsetreeViewer.processUncurriedAttribute attrs in - let uncurried = if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in - let attrs = printAttributes attrs in + | Parameter {attrs; lbl; default_expr; pat = pattern} -> + let (is_uncurried, attrs) = ParsetreeViewer.process_uncurried_attribute attrs in + let uncurried = if is_uncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + let attrs = print_attributes attrs in (* =defaultValue *) - let defaultExprDoc = match defaultExpr with + let default_expr_doc = match default_expr with | Some expr -> Doc.concat [ Doc.text "="; - printExpressionWithComments expr cmtTbl + print_expression_with_comments expr cmt_tbl ] | None -> Doc.nil in (* ~from as hometown * ~from -> punning *) - let labelWithPattern = match (lbl, pattern) with - | (Asttypes.Nolabel, pattern) -> printPattern pattern cmtTbl + let label_with_pattern = match (lbl, pattern) with + | (Asttypes.Nolabel, pattern) -> print_pattern pattern cmt_tbl | ( (Asttypes.Labelled lbl | Optional lbl), - {ppat_desc = Ppat_var stringLoc; + {ppat_desc = Ppat_var string_loc; ppat_attributes = ([] | [({Location.txt = "res.namedArgLoc";}, _)]) } - ) when lbl = stringLoc.txt -> + ) when lbl = string_loc.txt -> (* ~d *) Doc.concat [ Doc.text "~"; - printIdentLike lbl; + print_ident_like lbl; ] | ( (Asttypes.Labelled lbl | Optional lbl), @@ -10112,20 +10112,20 @@ module Printer = struct (* ~d: e *) Doc.concat [ Doc.text "~"; - printIdentLike lbl; + print_ident_like lbl; Doc.text ": "; - printTypExpr typ cmtTbl; + print_typ_expr typ cmt_tbl; ] | ((Asttypes.Labelled lbl | Optional lbl), pattern) -> (* ~b as c *) Doc.concat [ Doc.text "~"; - printIdentLike lbl; + print_ident_like lbl; Doc.text " as "; - printPattern pattern cmtTbl + print_pattern pattern cmt_tbl ] in - let optionalLabelSuffix = match (lbl, defaultExpr) with + let optional_label_suffix = match (lbl, default_expr) with | (Asttypes.Optional _, None) -> Doc.text "=?" | _ -> Doc.nil in @@ -10133,12 +10133,12 @@ module Printer = struct Doc.concat [ uncurried; attrs; - labelWithPattern; - defaultExprDoc; - optionalLabelSuffix; + label_with_pattern; + default_expr_doc; + optional_label_suffix; ] ) in - let cmtLoc = match defaultExpr with + let cmt_loc = match default_expr with | None -> begin match pattern.ppat_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _)::_ -> @@ -10146,80 +10146,80 @@ module Printer = struct | _ -> pattern.ppat_loc end | Some expr -> - let startPos = match pattern.ppat_attributes with + let start_pos = 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 = startPos; + loc_start = start_pos; loc_end = expr.pexp_loc.loc_end } in - printComments doc cmtTbl cmtLoc + print_comments doc cmt_tbl cmt_loc - and printExpressionBlock ~braces expr cmtTbl = - let rec collectRows acc expr = match expr.Parsetree.pexp_desc with - | Parsetree.Pexp_letmodule (modName, modExpr, expr2) -> + and print_expression_block ~braces expr cmt_tbl = + let rec collect_rows acc expr = match expr.Parsetree.pexp_desc with + | Parsetree.Pexp_letmodule (mod_name, mod_expr, expr2) -> let name = - let doc = Doc.text modName.txt in - printComments doc cmtTbl modName.loc + let doc = Doc.text mod_name.txt in + print_comments doc cmt_tbl mod_name.loc in - let letModuleDoc = Doc.concat [ + let let_module_doc = Doc.concat [ Doc.text "module "; name; Doc.text " = "; - printModExpr modExpr cmtTbl; + print_mod_expr mod_expr cmt_tbl; ] in - 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 = {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 = - let loc = {expr.pexp_loc with loc_end = extensionConstructor.pext_loc.loc_end} in - match getFirstLeadingComment cmtTbl loc with + let loc = {expr.pexp_loc with loc_end = extension_constructor.pext_loc.loc_end} in + match get_first_leading_comment cmt_tbl loc with | None -> loc | Some comment -> - let cmtLoc = Comment.loc comment in - {cmtLoc with loc_end = loc.loc_end} + let cmt_loc = Comment.loc comment in + {cmt_loc with loc_end = loc.loc_end} in - let letExceptionDoc = printExceptionDef extensionConstructor cmtTbl in - collectRows ((loc, letExceptionDoc)::acc) expr2 - | Pexp_open (overrideFlag, longidentLoc, expr2) -> - let openDoc = Doc.concat [ + let let_exception_doc = print_exception_def extension_constructor cmt_tbl in + collect_rows ((loc, let_exception_doc)::acc) expr2 + | Pexp_open (override_flag, longident_loc, expr2) -> + let open_doc = Doc.concat [ Doc.text "open"; - printOverrideFlag overrideFlag; + print_override_flag override_flag; Doc.space; - printLongidentLocation longidentLoc cmtTbl; + print_longident_location longident_loc cmt_tbl; ] in - let loc = {expr.pexp_loc with loc_end = longidentLoc.loc.loc_end} in - collectRows ((loc, openDoc)::acc) expr2 + let loc = {expr.pexp_loc with loc_end = longident_loc.loc.loc_end} in + collect_rows ((loc, open_doc)::acc) expr2 | Pexp_sequence (expr1, expr2) -> - let exprDoc = - let doc = printExpression expr1 cmtTbl in + let expr_doc = + let doc = print_expression expr1 cmt_tbl in match Parens.expr expr1 with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr1 braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr1 braces | Nothing -> doc in let loc = expr1.pexp_loc in - collectRows ((loc, exprDoc)::acc) expr2 - | Pexp_let (recFlag, valueBindings, expr2) -> + collect_rows ((loc, expr_doc)::acc) expr2 + | Pexp_let (rec_flag, value_bindings, expr2) -> let loc = - let loc = match (valueBindings, List.rev valueBindings) with - | (vb::_, lastVb::_) -> {vb.pvb_loc with loc_end = lastVb.pvb_loc.loc_end} + 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} | _ -> Location.none in - match getFirstLeadingComment cmtTbl loc with + match get_first_leading_comment cmt_tbl loc with | None -> loc | Some comment -> - let cmtLoc = Comment.loc comment in - {cmtLoc with loc_end = loc.loc_end} + let cmt_loc = Comment.loc comment in + {cmt_loc with loc_end = loc.loc_end} in - let recFlag = match recFlag with + let rec_flag = match rec_flag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - let letDoc = printValueBindings ~recFlag valueBindings cmtTbl in + let let_doc = print_value_bindings ~rec_flag value_bindings cmt_tbl in (* let () = { * let () = foo() * () @@ -10228,30 +10228,30 @@ module Printer = struct *) begin match expr2.pexp_desc with | Pexp_construct ({txt = Longident.Lident "()"}, _) -> - List.rev ((loc, letDoc)::acc) + List.rev ((loc, let_doc)::acc) | _ -> - collectRows ((loc, letDoc)::acc) expr2 + collect_rows ((loc, let_doc)::acc) expr2 end | _ -> - let exprDoc = - let doc = printExpression expr cmtTbl in + let expr_doc = + let doc = print_expression expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in - List.rev ((expr.pexp_loc, exprDoc)::acc) + List.rev ((expr.pexp_loc, expr_doc)::acc) in - let rows = collectRows [] expr in + let rows = collect_rows [] expr in let block = - printList - ~getLoc:fst + print_list + ~get_loc:fst ~nodes:rows ~print:(fun (_, doc) _ -> doc) - ~forceBreak:true - cmtTbl + ~force_break:true + cmt_tbl in - Doc.breakableGroup ~forceBreak:true ( + Doc.breakable_group ~force_break:true ( if braces then Doc.concat [ Doc.lbrace; @@ -10284,10 +10284,10 @@ module Printer = struct * a + b * } *) - and printBraces doc expr bracesLoc = - let overMultipleLines = + and print_braces doc expr braces_loc = + let over_multiple_lines = let open Location in - bracesLoc.loc_end.pos_lnum > bracesLoc.loc_start.pos_lnum + braces_loc.loc_end.pos_lnum > braces_loc.loc_start.pos_lnum in match expr.Parsetree.pexp_desc with | Pexp_letmodule _ @@ -10298,57 +10298,57 @@ module Printer = struct (* already has braces *) doc | _ -> - Doc.breakableGroup ~forceBreak:overMultipleLines ( + Doc.breakable_group ~force_break:over_multiple_lines ( Doc.concat [ Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; - if Parens.bracedExpr expr then addParens doc else doc; + Doc.soft_line; + if Parens.braced_expr expr then add_parens doc else doc; ] ); - Doc.softLine; + Doc.soft_line; Doc.rbrace; ] ) - and printOverrideFlag overrideFlag = match overrideFlag with + and print_override_flag override_flag = match override_flag with | Asttypes.Override -> Doc.text "!" | Fresh -> Doc.nil - and printDirectionFlag flag = match flag with + and print_direction_flag flag = match flag with | Asttypes.Downto -> Doc.text " downto " | Asttypes.Upto -> Doc.text " to " - and printRecordRow (lbl, expr) cmtTbl = - let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in + and print_record_row (lbl, expr) cmt_tbl = + let cmt_loc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in let doc = Doc.group (Doc.concat [ - printLidentPath lbl cmtTbl; + print_lident_path lbl cmt_tbl; Doc.text ": "; - (let doc = printExpressionWithComments expr cmtTbl in + (let doc = print_expression_with_comments expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc); ]) in - printComments doc cmtTbl cmtLoc + print_comments doc cmt_tbl cmt_loc - and printBsObjectRow (lbl, expr) cmtTbl = - let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in - let lblDoc = + and print_bs_object_row (lbl, expr) cmt_tbl = + let cmt_loc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in + let lbl_doc = let doc = Doc.concat [ Doc.text "\""; - printLongident lbl.txt; + print_longident lbl.txt; Doc.text "\""; ] in - printComments doc cmtTbl lbl.loc + print_comments doc cmt_tbl lbl.loc in let doc = Doc.concat [ - lblDoc; + lbl_doc; Doc.text ": "; - printExpressionWithComments expr cmtTbl + print_expression_with_comments expr cmt_tbl ] in - printComments doc cmtTbl cmtLoc + print_comments doc cmt_tbl cmt_loc (* The optional loc indicates whether we need to print the attributes in * relation to some location. In practise this means the following: @@ -10356,39 +10356,39 @@ module Printer = struct * `@attr * type t = string` -> attr is on prev line, print the attributes * with a line break between, we respect the users' original layout *) - and printAttributes ?loc (attrs: Parsetree.attributes) = - match ParsetreeViewer.filterParsingAttrs attrs with + and print_attributes ?loc (attrs: Parsetree.attributes) = + match ParsetreeViewer.filter_parsing_attrs attrs with | [] -> Doc.nil | attrs -> - let lineBreak = match loc with + let line_break = match loc with | None -> Doc.line | Some loc -> begin match List.rev attrs with - | ({loc = firstLoc}, _)::_ when loc.loc_start.pos_lnum > firstLoc.loc_end.pos_lnum -> - Doc.hardLine; + | ({loc = first_loc}, _)::_ when loc.loc_start.pos_lnum > first_loc.loc_end.pos_lnum -> + Doc.hard_line; | _ -> Doc.line end in Doc.concat [ - Doc.group (Doc.join ~sep:Doc.line (List.map printAttribute attrs)); - lineBreak; + Doc.group (Doc.join ~sep:Doc.line (List.map print_attribute attrs)); + line_break; ] - and printAttribute ((id, payload) : Parsetree.attribute) = - let attrName = Doc.concat [ + and print_attribute ((id, payload) : Parsetree.attribute) = + let attr_name = Doc.concat [ Doc.text "@"; Doc.text id.txt ] in match payload with | PStr [{pstr_desc = Pstr_eval (expr, attrs)}] -> - let exprDoc = printExpression expr CommentTable.empty in - let needsParens = match attrs with | [] -> false | _ -> true in + let expr_doc = print_expression expr CommentTable.empty in + let needs_parens = match attrs with | [] -> false | _ -> true in Doc.group ( Doc.concat [ - attrName; - addParens ( + attr_name; + add_parens ( Doc.concat [ - printAttributes attrs; - if needsParens then addParens exprDoc else exprDoc; + print_attributes attrs; + if needs_parens then add_parens expr_doc else expr_doc; ] ) ] @@ -10396,60 +10396,60 @@ module Printer = struct | PTyp typ -> Doc.group ( Doc.concat [ - attrName; + attr_name; Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.text ": "; - printTypExpr typ CommentTable.empty; + print_typ_expr typ CommentTable.empty; ] ); - Doc.softLine; + Doc.soft_line; Doc.rparen; ] ) - | _ -> attrName + | _ -> attr_name - and printAttributeWithComments ((id, payload) : Parsetree.attribute) cmtTbl = - let attrName = Doc.text ("@" ^ id.txt) in + and print_attribute_with_comments ((id, payload) : Parsetree.attribute) cmt_tbl = + let attr_name = Doc.text ("@" ^ id.txt) in match payload with | PStr [{pstr_desc = Pstr_eval (expr, attrs)}] -> - let exprDoc = printExpressionWithComments expr cmtTbl in - let needsParens = match attrs with | [] -> false | _ -> true in + let expr_doc = print_expression_with_comments expr cmt_tbl in + let needs_parens = match attrs with | [] -> false | _ -> true in Doc.group ( Doc.concat [ - attrName; - addParens ( + attr_name; + add_parens ( Doc.concat [ - printAttributes attrs; - if needsParens then addParens exprDoc else exprDoc; + print_attributes attrs; + if needs_parens then add_parens expr_doc else expr_doc; ] ) ] ) - | _ -> attrName + | _ -> attr_name - and printModExpr modExpr cmtTbl = - let doc = match modExpr.pmod_desc with - | Pmod_ident longidentLoc -> - printLongidentLocation longidentLoc cmtTbl + and print_mod_expr mod_expr cmt_tbl = + let doc = match mod_expr.pmod_desc with + | Pmod_ident longident_loc -> + print_longident_location longident_loc cmt_tbl | Pmod_structure structure -> - Doc.breakableGroup ~forceBreak:true ( + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; - printStructure structure cmtTbl; + Doc.soft_line; + print_structure structure cmt_tbl; ]; ); - Doc.softLine; + Doc.soft_line; Doc.rbrace; ] ) | Pmod_unpack expr -> - let shouldHug = match expr.pexp_desc with + let should_hug = match expr.pexp_desc with | Pexp_let _ -> true | Pexp_constraint ( {pexp_desc = Pexp_let _ }, @@ -10457,126 +10457,126 @@ module Printer = struct ) -> true | _ -> false in - let (expr, moduleConstraint) = match expr.pexp_desc with + let (expr, module_constraint) = match expr.pexp_desc with | Pexp_constraint ( expr, - {ptyp_desc = Ptyp_package packageType; ptyp_loc} + {ptyp_desc = Ptyp_package package_type; ptyp_loc} ) -> - let packageDoc = - let doc = printPackageType ~printModuleKeywordAndParens:false packageType cmtTbl in - printComments doc cmtTbl ptyp_loc + let package_doc = + let doc = print_package_type ~print_module_keyword_and_parens:false package_type cmt_tbl in + print_comments doc cmt_tbl ptyp_loc in - let typeDoc = Doc.group (Doc.concat [ + let type_doc = Doc.group (Doc.concat [ Doc.text ":"; Doc.indent ( Doc.concat [ Doc.line; - packageDoc + package_doc ] ) ]) in - (expr, typeDoc) + (expr, type_doc) | _ -> (expr, Doc.nil) in - let unpackDoc = Doc.group(Doc.concat [ - printExpressionWithComments expr cmtTbl; - moduleConstraint; + let unpack_doc = Doc.group(Doc.concat [ + print_expression_with_comments expr cmt_tbl; + module_constraint; ]) in Doc.group ( Doc.concat [ Doc.text "unpack("; - if shouldHug then unpackDoc + if should_hug then unpack_doc else Doc.concat [ Doc.indent ( Doc.concat [ - Doc.softLine; - unpackDoc; + Doc.soft_line; + unpack_doc; ] ); - Doc.softLine; + Doc.soft_line; ]; Doc.rparen; ] ) | Pmod_extension extension -> - printExtensionWithComments ~atModuleLvl:false extension cmtTbl + print_extension_with_comments ~at_module_lvl:false extension cmt_tbl | Pmod_apply _ -> - let (args, callExpr) = ParsetreeViewer.modExprApply modExpr in - let isUnitSugar = match args with + let (args, call_expr) = ParsetreeViewer.mod_expr_apply mod_expr in + let is_unit_sugar = match args with | [{pmod_desc = Pmod_structure []}] -> true | _ -> false in - let shouldHug = match args with + let should_hug = match args with | [{pmod_desc = Pmod_structure _}] -> true | _ -> false in Doc.group ( Doc.concat [ - printModExpr callExpr cmtTbl; - if isUnitSugar then - printModApplyArg (List.hd args [@doesNotRaise]) cmtTbl + print_mod_expr call_expr cmt_tbl; + if is_unit_sugar then + print_mod_apply_arg (List.hd args [@doesNotRaise]) cmt_tbl else Doc.concat [ Doc.lparen; - if shouldHug then - printModApplyArg (List.hd args [@doesNotRaise]) cmtTbl + if should_hug then + print_mod_apply_arg (List.hd args [@doesNotRaise]) cmt_tbl else Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun modArg -> printModApplyArg modArg cmtTbl) args + List.map (fun mod_arg -> print_mod_apply_arg mod_arg cmt_tbl) args ) ] ); - if not shouldHug then + if not should_hug then Doc.concat [ - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; ] else Doc.nil; Doc.rparen; ] ] ) - | Pmod_constraint (modExpr, modType) -> + | Pmod_constraint (mod_expr, mod_type) -> Doc.concat [ - printModExpr modExpr cmtTbl; + print_mod_expr mod_expr cmt_tbl; Doc.text ": "; - printModType modType cmtTbl; + print_mod_type mod_type cmt_tbl; ] | Pmod_functor _ -> - printModFunctor modExpr cmtTbl + print_mod_functor mod_expr cmt_tbl in - printComments doc cmtTbl modExpr.pmod_loc + print_comments doc cmt_tbl mod_expr.pmod_loc - and printModFunctor modExpr cmtTbl = - let (parameters, returnModExpr) = ParsetreeViewer.modExprFunctor modExpr in + and print_mod_functor mod_expr cmt_tbl = + let (parameters, return_mod_expr) = ParsetreeViewer.mod_expr_functor mod_expr in (* let shouldInline = match returnModExpr.pmod_desc with *) (* | Pmod_structure _ | Pmod_ident _ -> true *) (* | Pmod_constraint ({pmod_desc = Pmod_structure _}, _) -> true *) (* | _ -> false *) (* in *) - let (returnConstraint, returnModExpr) = match returnModExpr.pmod_desc with - | Pmod_constraint (modExpr, modType) -> - let constraintDoc = - let doc = printModType modType cmtTbl in - if Parens.modExprFunctorConstraint modType then addParens doc else doc + 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 mod_type cmt_tbl in + if Parens.mod_expr_functor_constraint mod_type then add_parens doc else doc in - let modConstraint = Doc.concat [ + let mod_constraint = Doc.concat [ Doc.text ": "; - constraintDoc; + constraint_doc; ] in - (modConstraint, printModExpr modExpr cmtTbl) - | _ -> (Doc.nil, printModExpr returnModExpr cmtTbl) + (mod_constraint, print_mod_expr mod_expr cmt_tbl) + | _ -> (Doc.nil, print_mod_expr return_mod_expr cmt_tbl) in - let parametersDoc = match parameters with + let parameters_doc = match parameters with | [(attrs, {txt = "*"}, None)] -> let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.line; ] in Doc.group (Doc.concat [ @@ -10590,133 +10590,133 @@ module Printer = struct Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun param -> printModFunctorParam param cmtTbl) parameters + List.map (fun param -> print_mod_functor_param param cmt_tbl) parameters ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) in Doc.group ( Doc.concat [ - parametersDoc; - returnConstraint; + parameters_doc; + return_constraint; Doc.text " => "; - returnModExpr + return_mod_expr ] ) - and printModFunctorParam (attrs, lbl, optModType) cmtTbl = - let cmtLoc = match optModType with + and print_mod_functor_param (attrs, lbl, opt_mod_type) cmt_tbl = + let cmt_loc = match opt_mod_type with | None -> lbl.Asttypes.loc - | Some modType -> {lbl.loc with loc_end = - modType.Parsetree.pmty_loc.loc_end + | Some mod_type -> {lbl.loc with loc_end = + mod_type.Parsetree.pmty_loc.loc_end } in let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.line; ] in - let lblDoc = + let lbl_doc = let doc = Doc.text lbl.txt in - printComments doc cmtTbl lbl.loc + print_comments doc cmt_tbl lbl.loc in let doc = Doc.group ( Doc.concat [ attrs; - lblDoc; - (match optModType with + lbl_doc; + (match opt_mod_type with | None -> Doc.nil - | Some modType -> + | Some mod_type -> Doc.concat [ Doc.text ": "; - printModType modType cmtTbl + print_mod_type mod_type cmt_tbl ]); ] ) in - printComments doc cmtTbl cmtLoc + print_comments doc cmt_tbl cmt_loc - and printModApplyArg modExpr cmtTbl = - match modExpr.pmod_desc with + and print_mod_apply_arg mod_expr cmt_tbl = + match mod_expr.pmod_desc with | Pmod_structure [] -> Doc.text "()" - | _ -> printModExpr modExpr cmtTbl + | _ -> print_mod_expr mod_expr cmt_tbl - and printExceptionDef (constr : Parsetree.extension_constructor) cmtTbl = + and print_exception_def (constr : Parsetree.extension_constructor) cmt_tbl = let kind = match constr.pext_kind with | Pext_rebind longident -> Doc.indent ( Doc.concat [ Doc.text " ="; Doc.line; - printLongidentLocation longident cmtTbl; + print_longident_location longident cmt_tbl; ] ) | Pext_decl (Pcstr_tuple [], None) -> Doc.nil | Pext_decl (args, gadt) -> - let gadtDoc = match gadt with + let gadt_doc = match gadt with | Some typ -> Doc.concat [ Doc.text ": "; - printTypExpr typ cmtTbl + print_typ_expr typ cmt_tbl ] | None -> Doc.nil in Doc.concat [ - printConstructorArguments ~indent:false args cmtTbl; - gadtDoc + print_constructor_arguments ~indent:false args cmt_tbl; + gadt_doc ] in let name = - printComments + print_comments (Doc.text constr.pext_name.txt) - cmtTbl + cmt_tbl constr.pext_name.loc in let doc = Doc.group ( Doc.concat [ - printAttributes constr.pext_attributes; + print_attributes constr.pext_attributes; Doc.text "exception "; name; kind ] ) in - printComments doc cmtTbl constr.pext_loc + print_comments doc cmt_tbl constr.pext_loc - and printExtensionConstructor (constr : Parsetree.extension_constructor) cmtTbl i = - let attrs = printAttributes constr.pext_attributes in + and print_extension_constructor (constr : Parsetree.extension_constructor) cmt_tbl i = + let attrs = print_attributes constr.pext_attributes in let bar = if i > 0 then Doc.text "| " - else Doc.ifBreaks (Doc.text "| ") Doc.nil + else Doc.if_breaks (Doc.text "| ") Doc.nil in let kind = match constr.pext_kind with | Pext_rebind longident -> Doc.indent ( Doc.concat [ Doc.text " ="; Doc.line; - printLongidentLocation longident cmtTbl; + print_longident_location longident cmt_tbl; ] ) | Pext_decl (Pcstr_tuple [], None) -> Doc.nil | Pext_decl (args, gadt) -> - let gadtDoc = match gadt with + let gadt_doc = match gadt with | Some typ -> Doc.concat [ Doc.text ": "; - printTypExpr typ cmtTbl; + print_typ_expr typ cmt_tbl; ] | None -> Doc.nil in Doc.concat [ - printConstructorArguments ~indent:false args cmtTbl; - gadtDoc + print_constructor_arguments ~indent:false args cmt_tbl; + gadt_doc ] in let name = - printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc + print_comments (Doc.text constr.pext_name.txt) cmt_tbl constr.pext_name.loc in Doc.concat [ bar; @@ -10729,20 +10729,20 @@ module Printer = struct ) ] - let printImplementation ~width (s: Parsetree.structure) comments = - let cmtTbl = CommentTable.make () in - CommentTable.walkStructure s cmtTbl comments; + let print_implementation ~width (s: Parsetree.structure) comments = + let cmt_tbl = CommentTable.make () in + CommentTable.walk_structure s cmt_tbl comments; (* CommentTable.log cmtTbl; *) - let doc = printStructure s cmtTbl in + let doc = print_structure s cmt_tbl in (* Doc.debug doc; *) - let stringDoc = Doc.toString ~width doc in - print_string stringDoc + let string_doc = Doc.to_string ~width doc in + print_string string_doc - let printInterface ~width (s: Parsetree.signature) comments = - let cmtTbl = CommentTable.make () in - CommentTable.walkSignature s cmtTbl comments; - let stringDoc = Doc.toString ~width (printSignature s cmtTbl) in - print_string stringDoc + let print_interface ~width (s: Parsetree.signature) comments = + let cmt_tbl = CommentTable.make () in + CommentTable.walk_signature s cmt_tbl comments; + let string_doc = Doc.to_string ~width (print_signature s cmt_tbl) in + print_string string_doc end @@ -10753,42 +10753,42 @@ module Scanner = struct filename: string; src: bytes; mutable err: - startPos: Lexing.position - -> endPos: Lexing.position + start_pos: Lexing.position + -> end_pos: Lexing.position -> Diagnostics.category -> unit; mutable ch: int; (* current character *) mutable offset: int; (* character offset *) - mutable rdOffset: int; (* reading offset (position after current character) *) - mutable lineOffset: int; (* current line offset *) + mutable rd_offset: int; (* reading offset (position after current character) *) + mutable line_offset: int; (* current line offset *) mutable lnum: int; (* current line number *) mutable mode: mode list; } - let setDiamondMode scanner = + let set_diamond_mode scanner = scanner.mode <- Diamond::scanner.mode - let setTemplateMode scanner = + let set_template_mode scanner = scanner.mode <- Template::scanner.mode - let setJsxMode scanner = + let set_jsx_mode scanner = scanner.mode <- Jsx::scanner.mode - let popMode scanner mode = + let pop_mode scanner mode = match scanner.mode with | m::ms when m = mode -> scanner.mode <- ms | _ -> () - let inDiamondMode scanner = match scanner.mode with + let in_diamond_mode scanner = match scanner.mode with | Diamond::_ -> true | _ -> false - let inJsxMode scanner = match scanner.mode with + let in_jsx_mode scanner = match scanner.mode with | Jsx::_ -> true | _ -> false - let inTemplateMode scanner = match scanner.mode with + let in_template_mode scanner = match scanner.mode with | Template::_ -> true | _ -> false @@ -10799,17 +10799,17 @@ module Scanner = struct (* offset of the beginning of the line (number of characters between the beginning of the scanner and the beginning of the line) *) - pos_bol = scanner.lineOffset; + pos_bol = scanner.line_offset; (* [pos_cnum] is the offset of the position (number of characters between the beginning of the scanner and the position). *) pos_cnum = scanner.offset; } let next scanner = - if scanner.rdOffset < (Bytes.length scanner.src) then ( - scanner.offset <- scanner.rdOffset; - let ch = (Bytes.get [@doesNotRaise]) scanner.src scanner.rdOffset in - scanner.rdOffset <- scanner.rdOffset + 1; + if scanner.rd_offset < (Bytes.length scanner.src) then ( + scanner.offset <- scanner.rd_offset; + let ch = (Bytes.get [@doesNotRaise]) scanner.src scanner.rd_offset in + scanner.rd_offset <- scanner.rd_offset + 1; scanner.ch <- int_of_char ch ) else ( scanner.offset <- Bytes.length scanner.src; @@ -10817,8 +10817,8 @@ module Scanner = struct ) let peek scanner = - if scanner.rdOffset < (Bytes.length scanner.src) then - int_of_char (Bytes.unsafe_get scanner.src scanner.rdOffset) + if scanner.rd_offset < (Bytes.length scanner.src) then + int_of_char (Bytes.unsafe_get scanner.src scanner.rd_offset) else -1 @@ -10826,24 +10826,24 @@ module Scanner = struct let scanner = { filename; src = b; - err = (fun ~startPos:_ ~endPos:_ _ -> ()); + err = (fun ~start_pos:_ ~end_pos:_ _ -> ()); ch = CharacterCodes.space; offset = 0; - rdOffset = 0; - lineOffset = 0; + rd_offset = 0; + line_offset = 0; lnum = 1; mode = []; } in next scanner; scanner - let skipWhitespace scanner = + let skip_whitespace scanner = let rec scan () = if scanner.ch == CharacterCodes.space || scanner.ch == CharacterCodes.tab then ( next scanner; scan() - ) else if CharacterCodes.isLineBreak scanner.ch then ( - scanner.lineOffset <- scanner.offset + 1; + ) else if CharacterCodes.is_line_break scanner.ch then ( + scanner.line_offset <- scanner.offset + 1; scanner.lnum <- scanner.lnum + 1; next scanner; scan() @@ -10853,33 +10853,33 @@ module Scanner = struct in scan() - let scanIdentifier scanner = - let startOff = scanner.offset in + let scan_identifier scanner = + let start_off = scanner.offset in while ( - CharacterCodes.isLetter scanner.ch || - CharacterCodes.isDigit scanner.ch || + CharacterCodes.is_letter scanner.ch || + CharacterCodes.is_digit scanner.ch || CharacterCodes.underscore == scanner.ch || - CharacterCodes.singleQuote == scanner.ch + CharacterCodes.single_quote == scanner.ch ) do next scanner done; - let str = Bytes.sub_string scanner.src startOff (scanner.offset - startOff) in - Token.lookupKeyword str + let str = Bytes.sub_string scanner.src start_off (scanner.offset - start_off) in + Token.lookup_keyword str - let scanDigits scanner ~base = + let scan_digits scanner ~base = if base <= 10 then ( - while CharacterCodes.isDigit scanner.ch || scanner.ch == CharacterCodes.underscore do + while CharacterCodes.is_digit scanner.ch || scanner.ch == CharacterCodes.underscore do next scanner done; ) else ( - while CharacterCodes.isHex scanner.ch || scanner.ch == CharacterCodes.underscore do + while CharacterCodes.is_hex scanner.ch || scanner.ch == CharacterCodes.underscore do next scanner done; ) (* float: (0…9) { 0…9∣ _ } [. { 0…9∣ _ }] [(e∣ E) [+∣ -] (0…9) { 0…9∣ _ }] *) - let scanNumber scanner = - let startOff = scanner.offset in + let scan_number scanner = + let start_off = scanner.offset in (* integer part *) let base, _prefix = if scanner.ch != CharacterCodes.dot then ( @@ -10903,32 +10903,32 @@ module Scanner = struct ) ) else (10, ' ') in - scanDigits scanner ~base; + scan_digits scanner ~base; (* *) - let isFloat = if CharacterCodes.dot == scanner.ch then ( + let is_float = if CharacterCodes.dot == scanner.ch then ( next scanner; - scanDigits scanner ~base; + scan_digits scanner ~base; true ) else ( false ) in (* exponent part *) - let isFloat = + let is_float = if let exp = CharacterCodes.lower scanner.ch in exp == CharacterCodes.Lower.e || exp == CharacterCodes.Lower.p then ( next scanner; if scanner.ch == CharacterCodes.plus || scanner.ch == CharacterCodes.minus then next scanner; - scanDigits scanner ~base; + scan_digits scanner ~base; true ) else - isFloat + is_float in let literal = - Bytes.sub_string scanner.src startOff (scanner.offset - startOff) + Bytes.sub_string scanner.src start_off (scanner.offset - start_off) in (* suffix *) @@ -10942,27 +10942,27 @@ module Scanner = struct ) else None in - if isFloat then + if is_float then Token.Float {f = literal; suffix} else Token.Int {i = literal; suffix} - let scanExoticIdentifier scanner = + let scan_exotic_identifier scanner = next scanner; let buffer = Buffer.create 20 in - let startPos = position scanner in + let start_pos = position scanner in let rec scan () = if scanner.ch == CharacterCodes.eof then - let endPos = position scanner in - scanner.err ~startPos ~endPos (Diagnostics.message "Did you forget a \" here?") - else if scanner.ch == CharacterCodes.doubleQuote then ( + let end_pos = position scanner in + scanner.err ~start_pos ~end_pos (Diagnostics.message "Did you forget a \" here?") + else if scanner.ch == CharacterCodes.double_quote then ( next scanner - ) else if CharacterCodes.isLineBreak scanner.ch then ( - scanner.lineOffset <- scanner.offset + 1; + ) else if CharacterCodes.is_line_break scanner.ch then ( + scanner.line_offset <- scanner.offset + 1; scanner.lnum <- scanner.lnum + 1; - let endPos = position scanner in - scanner.err ~startPos ~endPos (Diagnostics.message "Did you forget a \" here?"); + let end_pos = position scanner in + scanner.err ~start_pos ~end_pos (Diagnostics.message "Did you forget a \" here?"); next scanner ) else ( Buffer.add_char buffer ((Char.chr [@doesNotRaise]) scanner.ch); @@ -10973,7 +10973,7 @@ module Scanner = struct scan(); Token.Lident (Buffer.contents buffer) - let scanStringEscapeSequence ~startPos scanner = + let scan_string_escape_sequence ~start_pos scanner = (* \ already consumed *) if CharacterCodes.Lower.n == scanner.ch || CharacterCodes.Lower.t == scanner.ch @@ -10981,13 +10981,13 @@ module Scanner = struct || CharacterCodes.Lower.r == scanner.ch || CharacterCodes.backslash == scanner.ch || CharacterCodes.space == scanner.ch - || CharacterCodes.singleQuote == scanner.ch - || CharacterCodes.doubleQuote == scanner.ch + || CharacterCodes.single_quote == scanner.ch + || CharacterCodes.double_quote == scanner.ch then next scanner else let (n, base, max) = - if CharacterCodes.isDigit scanner.ch then + if CharacterCodes.is_digit scanner.ch then (* decimal *) (3, 10, 255) else if scanner.ch == CharacterCodes.Lower.o then @@ -11016,14 +11016,14 @@ module Scanner = struct let rec while_ n x = if n == 0 then x else - let d = CharacterCodes.digitValue scanner.ch in + let d = CharacterCodes.digit_value scanner.ch in if d >= base then let pos = position scanner in let msg = if scanner.ch == -1 then "unclosed escape sequence" else "unknown escape sequence" in - scanner.err ~startPos ~endPos:pos (Diagnostics.message msg); + scanner.err ~start_pos ~end_pos:pos (Diagnostics.message msg); -1 else let () = next scanner in @@ -11033,26 +11033,26 @@ module Scanner = struct if x > max then let pos = position scanner in let msg = "invalid escape sequence (value too high)" in - scanner.err ~startPos ~endPos:pos (Diagnostics.message msg); + scanner.err ~start_pos ~end_pos:pos (Diagnostics.message msg); () - let scanString scanner = + let scan_string scanner = let offs = scanner.offset in - let startPos = position scanner in + let start_pos = position scanner in let rec scan () = if scanner.ch == CharacterCodes.eof then - let endPos = position scanner in - scanner.err ~startPos ~endPos Diagnostics.unclosedString - else if scanner.ch == CharacterCodes.doubleQuote then ( + let end_pos = position scanner in + scanner.err ~start_pos ~end_pos Diagnostics.unclosed_string + else if scanner.ch == CharacterCodes.double_quote then ( next scanner; ) else if scanner.ch == CharacterCodes.backslash then ( - let startPos = position scanner in + let start_pos = position scanner in next scanner; - scanStringEscapeSequence ~startPos scanner; + scan_string_escape_sequence ~start_pos scanner; scan () - ) else if CharacterCodes.isLineBreak scanner.ch then ( - scanner.lineOffset <- scanner.offset + 1; + ) else if CharacterCodes.is_line_break scanner.ch then ( + scanner.line_offset <- scanner.offset + 1; scanner.lnum <- scanner.lnum + 1; next scanner; scan () @@ -11065,32 +11065,32 @@ module Scanner = struct Token.String (Bytes.sub_string scanner.src offs (scanner.offset - offs - 1)) (* I wonder if this gets inlined *) - let convertNumber scanner ~n ~base = + let convert_number scanner ~n ~base = let x = ref 0 in for _ = n downto 1 do - let d = CharacterCodes.digitValue scanner.ch in + let d = CharacterCodes.digit_value scanner.ch in x := (!x * base) + d; next scanner done; !x - let scanEscape scanner = + let scan_escape scanner = (* let offset = scanner.offset in *) let c = match scanner.ch with | 98 (* b *) -> next scanner; '\008' | 110 (* n *) -> next scanner; '\010' | 114 (* r *) -> next scanner; '\013' | 116 (* t *) -> next scanner; '\009' - | ch when CharacterCodes.isDigit ch -> - let x = convertNumber scanner ~n:3 ~base:10 in + | ch when CharacterCodes.is_digit ch -> + let x = convert_number scanner ~n:3 ~base:10 in (Char.chr [@doesNotRaise]) x | ch when ch == CharacterCodes.Lower.x -> next scanner; - let x = convertNumber scanner ~n:2 ~base:16 in + let x = convert_number scanner ~n:2 ~base:16 in (Char.chr [@doesNotRaise]) x | ch when ch == CharacterCodes.Lower.o -> next scanner; - let x = convertNumber scanner ~n:3 ~base:8 in + let x = convert_number scanner ~n:3 ~base:8 in (Char.chr [@doesNotRaise]) x | ch -> next scanner; @@ -11099,22 +11099,22 @@ module Scanner = struct next scanner; (* Consume \' *) Token.Character c - let scanSingleLineComment scanner = - let startOff = scanner.offset in - let startPos = position scanner in - while not (CharacterCodes.isLineBreak scanner.ch) && scanner.ch >= 0 do + let scan_single_line_comment scanner = + let start_off = scanner.offset in + let start_pos = position scanner in + while not (CharacterCodes.is_line_break scanner.ch) && scanner.ch >= 0 do next scanner done; - let endPos = position scanner in + let end_pos = position scanner in Token.Comment ( - Comment.makeSingleLineComment - ~loc:(Location.{loc_start = startPos; loc_end = endPos; loc_ghost = false}) - (Bytes.sub_string scanner.src startOff (scanner.offset - startOff)) + Comment.make_single_line_comment + ~loc:(Location.{loc_start = start_pos; loc_end = end_pos; loc_ghost = false}) + (Bytes.sub_string scanner.src start_off (scanner.offset - start_off)) ) - let scanMultiLineComment scanner = - let startOff = scanner.offset in - let startPos = position scanner in + let scan_multi_line_comment scanner = + let start_off = scanner.offset in + let start_pos = position scanner in let rec scan ~depth () = if scanner.ch == CharacterCodes.asterisk && peek scanner == CharacterCodes.forwardslash then ( @@ -11122,16 +11122,16 @@ module Scanner = struct next scanner; if depth > 0 then scan ~depth:(depth - 1) () else () ) else if scanner.ch == CharacterCodes.eof then ( - let endPos = position scanner in - scanner.err ~startPos ~endPos Diagnostics.unclosedComment + let end_pos = position scanner in + scanner.err ~start_pos ~end_pos Diagnostics.unclosed_comment ) else if scanner.ch == CharacterCodes.forwardslash && peek scanner == CharacterCodes. asterisk then ( next scanner; next scanner; scan ~depth:(depth + 1) () ) else ( - if CharacterCodes.isLineBreak scanner.ch then ( - scanner.lineOffset <- scanner.offset + 1; + if CharacterCodes.is_line_break scanner.ch then ( + scanner.line_offset <- scanner.offset + 1; scanner.lnum <- scanner.lnum + 1; ); next scanner; @@ -11140,22 +11140,22 @@ module Scanner = struct in scan ~depth:0 (); Token.Comment ( - Comment.makeMultiLineComment - ~loc:(Location.{loc_start = startPos; loc_end = (position scanner); loc_ghost = false}) - (Bytes.sub_string scanner.src startOff (scanner.offset - 2 - startOff)) + Comment.make_multi_line_comment + ~loc:(Location.{loc_start = start_pos; loc_end = (position scanner); loc_ghost = false}) + (Bytes.sub_string scanner.src start_off (scanner.offset - 2 - start_off)) ) - let scanTemplate scanner = - let startOff = scanner.offset in - let startPos = position scanner in + let scan_template scanner = + let start_off = scanner.offset in + let start_pos = position scanner in let rec scan () = if scanner.ch == CharacterCodes.eof then ( - let endPos = position scanner in - scanner.err ~startPos ~endPos Diagnostics.unclosedTemplate; - popMode scanner Template; + let end_pos = position scanner in + scanner.err ~start_pos ~end_pos Diagnostics.unclosed_template; + pop_mode scanner Template; Token.TemplateTail( - Bytes.sub_string scanner.src startOff (scanner.offset - 2 - startOff) + Bytes.sub_string scanner.src start_off (scanner.offset - 2 - start_off) ) ) else if scanner.ch == CharacterCodes.backslash then ( @@ -11168,9 +11168,9 @@ module Scanner = struct ) else if scanner.ch == CharacterCodes.backtick then ( next scanner; let contents = - Bytes.sub_string scanner.src startOff (scanner.offset - 1 - startOff) + Bytes.sub_string scanner.src start_off (scanner.offset - 1 - start_off) in - popMode scanner Template; + pop_mode scanner Template; Token.TemplateTail contents ) else if scanner.ch == CharacterCodes.dollar && peek scanner == CharacterCodes.lbrace @@ -11178,13 +11178,13 @@ module Scanner = struct next scanner; (* consume $ *) next scanner; (* consume { *) let contents = - Bytes.sub_string scanner.src startOff (scanner.offset - 2 - startOff) + Bytes.sub_string scanner.src start_off (scanner.offset - 2 - start_off) in - popMode scanner Template; + pop_mode scanner Template; Token.TemplatePart contents ) else ( - if CharacterCodes.isLineBreak scanner.ch then ( - scanner.lineOffset <- scanner.offset + 1; + if CharacterCodes.is_line_break scanner.ch then ( + scanner.line_offset <- scanner.offset + 1; scanner.lnum <- scanner.lnum + 1; ); next scanner; @@ -11194,23 +11194,23 @@ module Scanner = struct scan() let rec scan scanner = - if not (inTemplateMode scanner) then skipWhitespace scanner; - let startPos = position scanner in + if not (in_template_mode scanner) then skip_whitespace scanner; + let start_pos = position scanner in let ch = scanner.ch in - let token = if inTemplateMode scanner then - scanTemplate scanner + let token = if in_template_mode scanner then + scan_template scanner else if ch == CharacterCodes.underscore then ( - let nextCh = peek scanner in - if nextCh == CharacterCodes.underscore || CharacterCodes.isDigit nextCh || CharacterCodes.isLetter nextCh then - scanIdentifier scanner + let next_ch = peek scanner in + if next_ch == CharacterCodes.underscore || CharacterCodes.is_digit next_ch || CharacterCodes.is_letter next_ch then + scan_identifier scanner else ( next scanner; Token.Underscore ) - ) else if CharacterCodes.isLetter ch then - scanIdentifier scanner - else if CharacterCodes.isDigit ch then - scanNumber scanner + ) else if CharacterCodes.is_letter ch then + scan_identifier scanner + else if CharacterCodes.is_digit ch then + scan_number scanner else begin next scanner; if ch == CharacterCodes.dot then @@ -11225,15 +11225,15 @@ module Scanner = struct ) else ( Token.Dot ) - else if ch == CharacterCodes.doubleQuote then - scanString scanner - else if ch == CharacterCodes.singleQuote then ( + else if ch == CharacterCodes.double_quote then + scan_string scanner + else if ch == CharacterCodes.single_quote then ( if scanner.ch == CharacterCodes.backslash - && not ((peek scanner) == CharacterCodes.doubleQuote) (* start of exotic ident *) + && not ((peek scanner) == CharacterCodes.double_quote) (* start of exotic ident *) then ( next scanner; - scanEscape scanner - ) else if (peek scanner) == CharacterCodes.singleQuote then ( + scan_escape scanner + ) else if (peek scanner) == CharacterCodes.single_quote then ( let ch = scanner.ch in next scanner; next scanner; @@ -11256,7 +11256,7 @@ module Scanner = struct else if ch == CharacterCodes.semicolon then Token.Semicolon else if ch == CharacterCodes.equal then ( - if scanner.ch == CharacterCodes.greaterThan then ( + if scanner.ch == CharacterCodes.greater_than then ( next scanner; Token.EqualGreater ) else if scanner.ch == CharacterCodes.equal then ( @@ -11274,7 +11274,7 @@ module Scanner = struct if scanner.ch == CharacterCodes.bar then ( next scanner; Token.Lor - ) else if scanner.ch == CharacterCodes.greaterThan then ( + ) else if scanner.ch == CharacterCodes.greater_than then ( next scanner; Token.BarGreater ) else ( @@ -11305,21 +11305,21 @@ module Scanner = struct if scanner.ch == CharacterCodes.equal then( next scanner; Token.ColonEqual - ) else if (scanner.ch == CharacterCodes.greaterThan) then ( + ) else if (scanner.ch == CharacterCodes.greater_than) then ( next scanner; Token.ColonGreaterThan ) else ( Token.Colon ) else if ch == CharacterCodes.backslash then - scanExoticIdentifier scanner + scan_exotic_identifier scanner else if ch == CharacterCodes.forwardslash then if scanner.ch == CharacterCodes.forwardslash then ( next scanner; - scanSingleLineComment scanner + scan_single_line_comment scanner ) else if (scanner.ch == CharacterCodes.asterisk) then ( next scanner; - scanMultiLineComment scanner + scan_multi_line_comment scanner ) else if scanner.ch == CharacterCodes.dot then ( next scanner; Token.ForwardslashDot @@ -11330,7 +11330,7 @@ module Scanner = struct if scanner.ch == CharacterCodes.dot then ( next scanner; Token.MinusDot - ) else if scanner.ch == CharacterCodes.greaterThan then ( + ) else if scanner.ch == CharacterCodes.greater_than then ( next scanner; Token.MinusGreater; ) else ( @@ -11349,14 +11349,14 @@ module Scanner = struct ) else ( Token.Plus ) - else if ch == CharacterCodes.greaterThan then - if scanner.ch == CharacterCodes.equal && not (inDiamondMode scanner) then ( + else if ch == CharacterCodes.greater_than then + if scanner.ch == CharacterCodes.equal && not (in_diamond_mode scanner) then ( next scanner; Token.GreaterEqual ) else ( Token.GreaterThan ) - else if ch == CharacterCodes.lessThan then + else if ch == CharacterCodes.less_than then (* Imagine the following:
< * < indicates the start of a new jsx-element, the parser expects * the name of a new element after the < @@ -11364,8 +11364,8 @@ module Scanner = struct * But what if we have a / here: example
* This signals a closing element. To simulate the two-token lookahead, * the < * is `<` the start of a jsx-child?
* reconsiderLessThan peeks at the next token and * determines the correct token to disambiguate *) - let reconsiderLessThan scanner = + let reconsider_less_than scanner = (* < consumed *) - skipWhitespace scanner; + skip_whitespace scanner; if scanner.ch == CharacterCodes.forwardslash then let () = next scanner in Token.LessThanSlash @@ -11446,30 +11446,30 @@ module Scanner = struct Token.LessThan (* If an operator has whitespace around both sides, it's a binary operator *) - let isBinaryOp src startCnum endCnum = - if startCnum == 0 then false + let is_binary_op src start_cnum end_cnum = + if start_cnum == 0 then false else - let leftOk = + let left_ok = let c = - (startCnum - 1) + (start_cnum - 1) |> (Bytes.get [@doesNotRaise]) src |> Char.code in c == CharacterCodes.space || c == CharacterCodes.tab || - CharacterCodes.isLineBreak c + CharacterCodes.is_line_break c in - let rightOk = + let right_ok = let c = - if endCnum == Bytes.length src then -1 - else endCnum |> (Bytes.get [@doesNotRaise]) src |> Char.code + if end_cnum == Bytes.length src then -1 + else end_cnum |> (Bytes.get [@doesNotRaise]) src |> Char.code in c == CharacterCodes.space || c == CharacterCodes.tab || - CharacterCodes.isLineBreak c || + CharacterCodes.is_line_break c || c == CharacterCodes.eof in - leftOk && rightOk + left_ok && right_ok end (* AST for js externals *) @@ -11487,13 +11487,13 @@ module JsFfi = struct jld_loc: Location.t } - type importSpec = + type import_spec = | Default of label_declaration | Spec of label_declaration list type import_description = { jid_loc: Location.t; - jid_spec: importSpec; + jid_spec: import_spec; jid_scope: scope; jid_attributes: Parsetree.attributes; } @@ -11506,17 +11506,17 @@ module JsFfi = struct jld_type = typ } - let importDescr ~attrs ~scope ~importSpec ~loc = { + let import_descr ~attrs ~scope ~import_spec ~loc = { jid_loc = loc; - jid_spec = importSpec; + jid_spec = import_spec; jid_scope = scope; jid_attributes = attrs; } - let toParsetree importDescr = - let bsVal = (Location.mknoloc "val", Parsetree.PStr []) in - let attrs = match importDescr.jid_scope with - | Global -> [bsVal] + let to_parsetree import_descr = + let bs_val = (Location.mknoloc "val", Parsetree.PStr []) in + let attrs = match import_descr.jid_scope with + | Global -> [bs_val] (* @genType.import("./MyMath"), * @genType.import(/"./MyMath", "default"/) *) | Module s -> @@ -11525,10 +11525,10 @@ module JsFfi = struct |> Ast_helper.Exp.constant |> Ast_helper.Str.eval ] in - let genType = (Location.mknoloc "genType.import", Parsetree.PStr structure) in - [genType] + let gen_type = (Location.mknoloc "genType.import", Parsetree.PStr structure) in + [gen_type] | Scope longident -> - let structureItem = + let structure_item = let expr = match Longident.flatten longident |> List.map (fun s -> Ast_helper.Exp.constant (Parsetree.Pconst_string (s, None)) ) with @@ -11537,62 +11537,62 @@ module JsFfi = struct in Ast_helper.Str.eval expr in - let bsScope = ( + let bs_scope = ( Location.mknoloc "scope", - Parsetree. PStr [structureItem] + Parsetree. PStr [structure_item] ) in - [bsVal; bsScope] + [bs_val; bs_scope] in - let valueDescrs = match importDescr.jid_spec with + let value_descrs = match import_descr.jid_spec with | Default decl -> let prim = [decl.jld_name] in - let allAttrs = - List.concat [attrs; importDescr.jid_attributes] + let all_attrs = + List.concat [attrs; import_descr.jid_attributes] |> List.map (fun attr -> match attr with | ( {Location.txt = "genType.import"} as id, - Parsetree.PStr [{pstr_desc = Parsetree.Pstr_eval (moduleName, _) }] + Parsetree.PStr [{pstr_desc = Parsetree.Pstr_eval (module_name, _) }] ) -> let default = Parsetree.Pconst_string ("default", None) |> Ast_helper.Exp.constant in - let structureItem = - [moduleName; default] + let structure_item = + [module_name; default] |> Ast_helper.Exp.tuple |> Ast_helper.Str.eval in - (id, Parsetree.PStr [structureItem]) + (id, Parsetree.PStr [structure_item]) | attr -> attr ) in [Ast_helper.Val.mk - ~loc:importDescr.jid_loc + ~loc:import_descr.jid_loc ~prim - ~attrs:allAttrs + ~attrs:all_attrs (Location.mknoloc decl.jld_alias) decl.jld_type |> Ast_helper.Str.primitive] | Spec decls -> List.map (fun decl -> let prim = [decl.jld_name] in - let allAttrs = List.concat [attrs; decl.jld_attributes] in + let all_attrs = List.concat [attrs; decl.jld_attributes] in Ast_helper.Val.mk - ~loc:importDescr.jid_loc + ~loc:import_descr.jid_loc ~prim - ~attrs:allAttrs + ~attrs:all_attrs (Location.mknoloc decl.jld_alias) decl.jld_type |> Ast_helper.Str.primitive ~loc:decl.jld_loc ) decls in - let jsFfiAttr = (Location.mknoloc "ns.jsFfi", Parsetree.PStr []) in - Ast_helper.Mod.structure ~loc:importDescr.jid_loc valueDescrs - |> Ast_helper.Incl.mk ~attrs:[jsFfiAttr] ~loc:importDescr.jid_loc - |> Ast_helper.Str.include_ ~loc:importDescr.jid_loc + let js_ffi_attr = (Location.mknoloc "ns.jsFfi", Parsetree.PStr []) in + Ast_helper.Mod.structure ~loc:import_descr.jid_loc value_descrs + |> Ast_helper.Incl.mk ~attrs:[js_ffi_attr] ~loc:import_descr.jid_loc + |> Ast_helper.Str.include_ ~loc:import_descr.jid_loc end module ParsetreeCompatibility = struct - let concatLongidents l1 l2 = + let concat_longidents l1 l2 = let parts1 = Longident.flatten l1 in let parts2 = Longident.flatten l2 in match List.concat [parts1; parts2] |> Longident.unflatten with @@ -11600,85 +11600,85 @@ module ParsetreeCompatibility = struct | None -> l2 (* TODO: support nested open's ? *) - let rec rewritePpatOpen longidentOpen pat = + let rec rewrite_ppat_open longident_open pat = let open Parsetree in match pat.ppat_desc with | Ppat_array (first::rest) -> (* Color.[Red, Blue, Green] -> [Color.Red, Blue, Green] *) - {pat with ppat_desc = Ppat_array ((rewritePpatOpen longidentOpen first)::rest)} + {pat with ppat_desc = Ppat_array ((rewrite_ppat_open longident_open first)::rest)} | Ppat_tuple (first::rest) -> (* Color.(Red, Blue, Green) -> (Color.Red, Blue, Green) *) - {pat with ppat_desc = Ppat_tuple ((rewritePpatOpen longidentOpen first)::rest)} + {pat with ppat_desc = Ppat_tuple ((rewrite_ppat_open longident_open first)::rest)} | Ppat_construct( - {txt = Longident.Lident "::"} as listConstructor, + {txt = Longident.Lident "::"} as list_constructor, 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 ( - listConstructor, - Some {element with ppat_desc = Ppat_tuple ((rewritePpatOpen longidentOpen pat)::rest)} + list_constructor, + Some {element with ppat_desc = Ppat_tuple ((rewrite_ppat_open longident_open pat)::rest)} ) } - | Ppat_construct ({txt = constructor} as longidentLoc, optPattern) -> + | Ppat_construct ({txt = constructor} as longident_loc, opt_pattern) -> (* Foo.(Bar(a)) -> Foo.Bar(a) *) {pat with ppat_desc = Ppat_construct ( - {longidentLoc with txt = concatLongidents longidentOpen constructor}, - optPattern + {longident_loc with txt = concat_longidents longident_open constructor}, + opt_pattern ) } - | Ppat_record (({txt = lbl} as longidentLoc, firstPat)::rest, flag) -> + | Ppat_record (({txt = lbl} as longident_loc, first_pat)::rest, flag) -> (* Foo.{x} -> {Foo.x: x} *) - let firstRow = ( - {longidentLoc with txt = concatLongidents longidentOpen lbl}, - firstPat + let first_row = ( + {longident_loc with txt = concat_longidents longident_open lbl}, + first_pat ) in - {pat with ppat_desc = Ppat_record (firstRow::rest, flag)} + {pat with ppat_desc = Ppat_record (first_row::rest, flag)} | Ppat_or (pat1, pat2) -> {pat with ppat_desc = Ppat_or ( - rewritePpatOpen longidentOpen pat1, - rewritePpatOpen longidentOpen pat2 + rewrite_ppat_open longident_open pat1, + rewrite_ppat_open longident_open pat2 )} | Ppat_constraint (pattern, typ) -> {pat with ppat_desc = Ppat_constraint ( - rewritePpatOpen longidentOpen pattern, + rewrite_ppat_open longident_open pattern, typ )} - | Ppat_type ({txt = constructor} as longidentLoc) -> + | Ppat_type ({txt = constructor} as longident_loc) -> {pat with ppat_desc = Ppat_type ( - {longidentLoc with txt = concatLongidents longidentOpen constructor} + {longident_loc with txt = concat_longidents longident_open constructor} )} | Ppat_lazy p -> - {pat with ppat_desc = Ppat_lazy (rewritePpatOpen longidentOpen p)} + {pat with ppat_desc = Ppat_lazy (rewrite_ppat_open longident_open p)} | Ppat_exception p -> - {pat with ppat_desc = Ppat_exception (rewritePpatOpen longidentOpen p)} + {pat with ppat_desc = Ppat_exception (rewrite_ppat_open longident_open p)} | _ -> pat - let rec rewriteReasonFastPipe expr = + let rec rewrite_reason_fast_pipe expr = let open Parsetree in match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "|."}} as op, [Asttypes.Nolabel, lhs; Nolabel, rhs] - ); pexp_attributes = subAttrs}, + ); pexp_attributes = sub_attrs}, args ) -> - let rhsLoc = {rhs.pexp_loc with loc_end = expr.pexp_loc.loc_end} in - let newLhs = - let expr = rewriteReasonFastPipe lhs in - {expr with pexp_attributes = subAttrs} + let rhs_loc = {rhs.pexp_loc with loc_end = expr.pexp_loc.loc_end} in + let new_lhs = + let expr = rewrite_reason_fast_pipe lhs in + {expr with pexp_attributes = sub_attrs} in - let allArgs = - (Asttypes.Nolabel, newLhs)::[ - Asttypes.Nolabel, Ast_helper.Exp.apply ~loc:rhsLoc rhs args + let all_args = + (Asttypes.Nolabel, new_lhs)::[ + Asttypes.Nolabel, Ast_helper.Exp.apply ~loc:rhs_loc rhs args ] in - Ast_helper.Exp.apply ~attrs:expr.pexp_attributes ~loc:expr.pexp_loc op allArgs + Ast_helper.Exp.apply ~attrs:expr.pexp_attributes ~loc:expr.pexp_loc op all_args | _ -> expr - let makeReasonArityMapper ~forPrinter = + let make_reason_arity_mapper ~for_printer = let open Ast_mapper in { default_mapper with expr = begin fun mapper expr -> @@ -11693,15 +11693,15 @@ module ParsetreeCompatibility = struct (* in *) (* default_mapper.expr mapper {pexp_desc=Pexp_variant(lbl, newArgs); pexp_loc; pexp_attributes} *) | {pexp_desc=Pexp_construct(lid, args); pexp_loc; pexp_attributes} -> - let newArgs = match args with + let new_args = match args with | (Some {pexp_desc = Pexp_tuple [{pexp_desc = Pexp_tuple _ } as sp]}) as args -> - if forPrinter then args else Some sp + if for_printer then args else Some sp | Some {pexp_desc = Pexp_tuple [sp]} -> Some sp | _ -> args in - default_mapper.expr mapper { pexp_desc=Pexp_construct(lid, newArgs); pexp_loc; pexp_attributes} + default_mapper.expr mapper { pexp_desc=Pexp_construct(lid, new_args); pexp_loc; pexp_attributes} | expr -> - default_mapper.expr mapper (rewriteReasonFastPipe expr) + default_mapper.expr mapper (rewrite_reason_fast_pipe expr) end; pat = begin fun mapper pattern -> match pattern with @@ -11719,7 +11719,7 @@ module ParsetreeCompatibility = struct ppat_attributes} -> let new_args = match args with | (Some {ppat_desc = Ppat_tuple [{ppat_desc = Ppat_tuple _} as sp]}) as args -> - if forPrinter then args else Some sp + if for_printer then args else Some sp | Some {ppat_desc = Ppat_tuple [sp]} -> Some sp | _ -> args in default_mapper.pat mapper { ppat_desc=Ppat_construct(lid, new_args); ppat_loc; ppat_attributes;} @@ -11727,7 +11727,7 @@ module ParsetreeCompatibility = struct end; } - let escapeTemplateLiteral s = + let escape_template_literal s = let len = String.length s in let b = Buffer.create len in let i = ref 0 in @@ -11764,7 +11764,7 @@ module ParsetreeCompatibility = struct done; Buffer.contents b - let escapeStringContents s = + let escape_string_contents s = let len = String.length s in let b = Buffer.create len in @@ -11792,36 +11792,36 @@ module ParsetreeCompatibility = struct done; Buffer.contents b - let looksLikeRecursiveTypeDeclaration typeDeclaration = + let looks_like_recursive_type_declaration type_declaration = let open Parsetree in - let name = typeDeclaration.ptype_name.txt in - let rec checkKind kind = + let name = type_declaration.ptype_name.txt in + let rec check_kind kind = match kind with | Ptype_abstract | Ptype_open -> false - | Ptype_variant constructorDeclarations -> - List.exists checkConstructorDeclaration constructorDeclarations - | Ptype_record labelDeclarations -> - List.exists checkLabelDeclaration labelDeclarations - - and checkConstructorDeclaration constrDecl = - checkConstructorArguments constrDecl.pcd_args - || (match constrDecl.pcd_res with + | 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 + || (match constr_decl.pcd_res with | Some typexpr -> - checkTypExpr typexpr + check_typ_expr typexpr | None -> false ) - and checkLabelDeclaration labelDeclaration = - checkTypExpr labelDeclaration.pld_type + and check_label_declaration label_declaration = + check_typ_expr label_declaration.pld_type - and checkConstructorArguments constrArg = - match constrArg with + and check_constructor_arguments constr_arg = + match constr_arg with | Pcstr_tuple types -> - List.exists checkTypExpr types - | Pcstr_record labelDeclarations -> - List.exists checkLabelDeclaration labelDeclarations + List.exists check_typ_expr types + | Pcstr_record label_declarations -> + List.exists check_label_declaration label_declarations - and checkTypExpr typ = + and check_typ_expr typ = match typ.ptyp_desc with | Ptyp_any -> false | Ptyp_var _ -> false @@ -11830,56 +11830,56 @@ module ParsetreeCompatibility = struct | Ptyp_package _ -> false | Ptyp_extension _ -> false | Ptyp_arrow (_lbl, typ1, typ2) -> - checkTypExpr typ1 || checkTypExpr typ2 + check_typ_expr typ1 || check_typ_expr typ2 | Ptyp_tuple types -> - List.exists checkTypExpr types + List.exists check_typ_expr types | Ptyp_constr ({txt = longident}, types) -> (match longident with | Lident ident -> ident = name | _ -> false ) || - List.exists checkTypExpr types - | Ptyp_alias (typ, _) -> checkTypExpr typ - | Ptyp_variant (rowFields, _, _) -> - List.exists checkRowFields rowFields + 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) -> - checkTypExpr typ + check_typ_expr typ - and checkRowFields rowField = - match rowField with + and check_row_fields row_field = + match row_field with | Rtag (_, _, _, types) -> - List.exists checkTypExpr types + List.exists check_typ_expr types | Rinherit typexpr -> - checkTypExpr typexpr + check_typ_expr typexpr in - checkKind typeDeclaration.ptype_kind + check_kind type_declaration.ptype_kind - let filterReasonRawLiteral attrs = + let filter_reason_raw_literal attrs = List.filter (fun attr -> match attr with | ({Location.txt = ("reason.raw_literal")}, _) -> false | _ -> true ) attrs - let stringLiteralMapper stringData = - let isSameLocation l1 l2 = + let string_literal_mapper string_data = + let is_same_location l1 l2 = let open Location in l1.loc_start.pos_cnum == l2.loc_start.pos_cnum in - let remainingStringData = stringData in + let remaining_string_data = string_data in let open Ast_mapper in { default_mapper with expr = (fun mapper expr -> match expr.pexp_desc with | Pexp_constant (Pconst_string (_txt, None)) -> begin match - List.find_opt (fun (_stringData, stringLoc) -> - isSameLocation stringLoc expr.pexp_loc - ) remainingStringData + List.find_opt (fun (_stringData, string_loc) -> + is_same_location string_loc expr.pexp_loc + ) remaining_string_data with - | Some(stringData, _) -> - let stringData = + | Some(string_data, _) -> + let string_data = let attr = List.find_opt (fun attr -> match attr with | ({Location.txt = ("reason.raw_literal")}, _) -> true | _ -> false @@ -11887,11 +11887,11 @@ module ParsetreeCompatibility = struct match attr with | Some (_, PStr [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_constant (Pconst_string (raw, _))}, _)}]) -> raw - | _ -> (String.sub [@doesNotRaise]) stringData 1 (String.length stringData - 2) + | _ -> (String.sub [@doesNotRaise]) string_data 1 (String.length string_data - 2) in {expr with - pexp_attributes = filterReasonRawLiteral expr.pexp_attributes; - pexp_desc = Pexp_constant (Pconst_string (stringData, None)) + pexp_attributes = filter_reason_raw_literal expr.pexp_attributes; + pexp_desc = Pexp_constant (Pconst_string (string_data, None)) } | None -> default_mapper.expr mapper expr @@ -11918,8 +11918,8 @@ module ParsetreeCompatibility = struct ); pat = begin fun mapper p -> match p.ppat_desc with - | Ppat_open ({txt = longidentOpen}, pattern) -> - let p = rewritePpatOpen longidentOpen pattern in + | Ppat_open ({txt = longident_open}, pattern) -> + let p = rewrite_ppat_open longident_open pattern in default_mapper.pat mapper p | _ -> default_mapper.pat mapper p @@ -11927,7 +11927,7 @@ module ParsetreeCompatibility = struct expr = (fun mapper expr -> match expr.pexp_desc with | Pexp_constant (Pconst_string (txt, None)) -> - let raw = escapeStringContents txt in + let raw = escape_string_contents txt in let s = Parsetree.Pconst_string (raw, None) in let expr = Ast_helper.Exp.constant ~attrs:expr.pexp_attributes @@ -11935,7 +11935,7 @@ module ParsetreeCompatibility = struct in expr | Pexp_constant (Pconst_string (txt, tag)) -> - let s = Parsetree.Pconst_string ((escapeTemplateLiteral txt), tag) in + let s = Parsetree.Pconst_string ((escape_template_literal txt), tag) in Ast_helper.Exp.constant ~attrs:(mapper.attributes mapper expr.pexp_attributes) ~loc:expr.pexp_loc @@ -11962,79 +11962,79 @@ module ParsetreeCompatibility = struct (Location.mknoloc (Longident.Lident "contents")) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}} as op, - [Asttypes.Nolabel, lhs; Nolabel, ({pexp_desc = Pexp_constant (Pconst_string (txt, None))} as stringExpr)] + [Asttypes.Nolabel, lhs; Nolabel, ({pexp_desc = Pexp_constant (Pconst_string (txt, None))} as string_expr)] ) -> - let ident = Ast_helper.Exp.ident ~loc:stringExpr.pexp_loc - (Location.mkloc (Longident.Lident txt) stringExpr.pexp_loc) + let ident = Ast_helper.Exp.ident ~loc:string_expr.pexp_loc + (Location.mkloc (Longident.Lident txt) string_expr.pexp_loc) in Ast_helper.Exp.apply ~loc:expr.pexp_loc ~attrs:expr.pexp_attributes op [Asttypes.Nolabel, lhs; Nolabel, ident] | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "@@"}}, - [Asttypes.Nolabel, callExpr; Nolabel, argExpr] + [Asttypes.Nolabel, call_expr; Nolabel, arg_expr] ) -> - Ast_helper.Exp.apply (mapper.expr mapper callExpr) [ - Asttypes.Nolabel, mapper.expr mapper argExpr + Ast_helper.Exp.apply (mapper.expr mapper call_expr) [ + Asttypes.Nolabel, mapper.expr mapper arg_expr ] | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "@"}}, [Nolabel, arg1; Nolabel, arg2] ) -> - let listConcat = Longident.Ldot (Longident.Lident "List", "append") in + let list_concat = Longident.Ldot (Longident.Lident "List", "append") in Ast_helper.Exp.apply - (Ast_helper.Exp.ident (Location.mknoloc listConcat)) + (Ast_helper.Exp.ident (Location.mknoloc list_concat)) [Nolabel, mapper.expr mapper arg1; Nolabel, mapper.expr mapper arg2] | Pexp_match ( condition, [ - {pc_lhs = {ppat_desc = Ppat_construct ({txt = Longident.Lident "true"}, None)}; pc_rhs = thenExpr }; - {pc_lhs = {ppat_desc = Ppat_construct ({txt = Longident.Lident "false"}, None)}; pc_rhs = elseExpr }; + {pc_lhs = {ppat_desc = Ppat_construct ({txt = Longident.Lident "true"}, None)}; pc_rhs = then_expr }; + {pc_lhs = {ppat_desc = Ppat_construct ({txt = Longident.Lident "false"}, None)}; pc_rhs = else_expr }; ] ) -> - let ternaryMarker = (Location.mknoloc "res.ternary", Parsetree.PStr []) in + let ternary_marker = (Location.mknoloc "res.ternary", Parsetree.PStr []) in Ast_helper.Exp.ifthenelse ~loc:expr.pexp_loc - ~attrs:(ternaryMarker::expr.pexp_attributes) + ~attrs:(ternary_marker::expr.pexp_attributes) (default_mapper.expr mapper condition) - (default_mapper.expr mapper thenExpr) - (Some (default_mapper.expr mapper elseExpr)) + (default_mapper.expr mapper then_expr) + (Some (default_mapper.expr mapper else_expr)) | _ -> default_mapper.expr mapper expr ); - structure_item = begin fun mapper structureItem -> - match structureItem.pstr_desc with + structure_item = begin fun mapper structure_item -> + match structure_item.pstr_desc with (* heuristic: if we have multiple type declarations, mark them recursive *) - | Pstr_type (recFlag, typeDeclarations) -> - let flag = match typeDeclarations with + | Pstr_type (rec_flag, type_declarations) -> + let flag = match type_declarations with | [td] -> - if looksLikeRecursiveTypeDeclaration td then Asttypes.Recursive + if looks_like_recursive_type_declaration td then Asttypes.Recursive else Asttypes.Nonrecursive - | _ -> recFlag + | _ -> rec_flag in - {structureItem with pstr_desc = Pstr_type ( + {structure_item with pstr_desc = Pstr_type ( flag, - List.map (fun typeDeclaration -> - default_mapper.type_declaration mapper typeDeclaration - ) typeDeclarations + List.map (fun type_declaration -> + default_mapper.type_declaration mapper type_declaration + ) type_declarations )} - | _ -> default_mapper.structure_item mapper structureItem + | _ -> default_mapper.structure_item mapper structure_item end; - signature_item = begin fun mapper signatureItem -> - match signatureItem.psig_desc with + signature_item = begin fun mapper signature_item -> + match signature_item.psig_desc with (* heuristic: if we have multiple type declarations, mark them recursive *) - | Psig_type (recFlag, typeDeclarations) -> - let flag = match typeDeclarations with + | Psig_type (rec_flag, type_declarations) -> + let flag = match type_declarations with | [td] -> - if looksLikeRecursiveTypeDeclaration td then Asttypes.Recursive + if looks_like_recursive_type_declaration td then Asttypes.Recursive else Asttypes.Nonrecursive - | _ -> recFlag + | _ -> rec_flag in - {signatureItem with psig_desc = Psig_type ( + {signature_item with psig_desc = Psig_type ( flag, - List.map (fun typeDeclaration -> - default_mapper.type_declaration mapper typeDeclaration - ) typeDeclarations + List.map (fun type_declaration -> + default_mapper.type_declaration mapper type_declaration + ) type_declarations )} - | _ -> default_mapper.signature_item mapper signatureItem + | _ -> default_mapper.signature_item mapper signature_item end; value_binding = begin fun mapper vb -> match vb with @@ -12046,11 +12046,11 @@ module ParsetreeCompatibility = struct let typ = default_mapper.typ mapper typ in let pat = default_mapper.pat mapper pat in let expr = mapper.expr mapper expr in - let newPattern = Ast_helper.Pat.constraint_ + let new_pattern = Ast_helper.Pat.constraint_ ~loc:{pat.ppat_loc with loc_end = typ.ptyp_loc.loc_end} pat typ in {vb with - pvb_pat = newPattern; + pvb_pat = new_pattern; pvb_expr = expr; pvb_attributes = default_mapper.attributes mapper vb.pvb_attributes} | { @@ -12061,34 +12061,34 @@ module ParsetreeCompatibility = struct let typ = default_mapper.typ mapper typ in let pat = default_mapper.pat mapper pat in let expr = mapper.expr mapper expr in - let newPattern = Ast_helper.Pat.constraint_ + let new_pattern = Ast_helper.Pat.constraint_ ~loc:{pat.ppat_loc with loc_end = typ.ptyp_loc.loc_end} pat typ in {vb with - pvb_pat = newPattern; + pvb_pat = new_pattern; pvb_expr = expr; pvb_attributes = default_mapper.attributes mapper vb.pvb_attributes} | _ -> default_mapper.value_binding mapper vb end; } - let normalizeReasonArityStructure ~forPrinter s = - let mapper = makeReasonArityMapper ~forPrinter in + let normalize_reason_arity_structure ~for_printer s = + let mapper = make_reason_arity_mapper ~for_printer in mapper.Ast_mapper.structure mapper s - let normalizeReasonAritySignature ~forPrinter s = - let mapper = makeReasonArityMapper ~forPrinter in + let normalize_reason_arity_signature ~for_printer s = + let mapper = make_reason_arity_mapper ~for_printer in mapper.Ast_mapper.signature mapper s let structure s = normalize.Ast_mapper.structure normalize s let signature s = normalize.Ast_mapper.signature normalize s - let replaceStringLiteralStructure stringData structure = - let mapper = stringLiteralMapper stringData in + let replace_string_literal_structure string_data structure = + let mapper = string_literal_mapper string_data in mapper.Ast_mapper.structure mapper structure - let replaceStringLiteralSignature stringData signature = - let mapper = stringLiteralMapper stringData in + let replace_string_literal_signature string_data signature = + let mapper = string_literal_mapper string_data in mapper.Ast_mapper.signature mapper signature end @@ -12097,27 +12097,27 @@ module OcamlParser = Parser module Parser = struct type mode = ParseForTypeChecker | Default - type regionStatus = Report | Silent + type region_status = Report | Silent type t = { mode: mode; mutable scanner: Scanner.t; mutable token: Token.t; - mutable startPos: Lexing.position; - mutable endPos: Lexing.position; - mutable prevEndPos: Lexing.position; + mutable start_pos: Lexing.position; + mutable end_pos: Lexing.position; + mutable prev_end_pos: Lexing.position; mutable breadcrumbs: (Grammar.t * Lexing.position) list; - mutable errors: Reporting.parseError list; + mutable errors: Reporting.parse_error list; mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; - mutable regions: regionStatus ref list; + mutable regions: region_status ref list; } - let err ?startPos ?endPos p error = + let err ?start_pos ?end_pos p error = let d = Diagnostics.make ~filename:p.scanner.filename - ~startPos:(match startPos with | Some pos -> pos | None -> p.startPos) - ~endPos:(match endPos with | Some pos -> pos | None -> p.endPos) + ~start_pos:(match start_pos with | Some pos -> pos | None -> p.start_pos) + ~end_pos:(match end_pos with | Some pos -> pos | None -> p.end_pos) error in try @@ -12127,68 +12127,68 @@ module Parser = struct ) with Failure _ -> () - let beginRegion p = + let begin_region p = p.regions <- ref Report :: p.regions - let endRegion p = + let end_region p = try p.regions <- List.tl p.regions with Failure _ -> () (* Advance to the next non-comment token and store any encountered comment * in the parser's state. Every comment contains the end position of it's * previous token to facilite comment interleaving *) - let rec next ?prevEndPos p = - let prevEndPos = match prevEndPos with Some pos -> pos | None -> p.endPos in - let (startPos, endPos, token) = Scanner.scan p.scanner in + let rec next ?prev_end_pos p = + let prev_end_pos = match prev_end_pos with Some pos -> pos | None -> p.end_pos in + let (start_pos, end_pos, token) = Scanner.scan p.scanner in match token with | Comment c -> - Comment.setPrevTokEndPos c p.endPos; + Comment.set_prev_tok_end_pos c p.end_pos; p.comments <- c::p.comments; - p.prevEndPos <- p.endPos; - p.endPos <- endPos; - next ~prevEndPos p + p.prev_end_pos <- p.end_pos; + p.end_pos <- end_pos; + next ~prev_end_pos p | _ -> p.token <- token; (* p.prevEndPos <- prevEndPos; *) - p.prevEndPos <- prevEndPos; - p.startPos <- startPos; - p.endPos <- endPos + p.prev_end_pos <- prev_end_pos; + p.start_pos <- start_pos; + p.end_pos <- end_pos - let checkProgress ~prevEndPos ~result p = - if p.endPos == prevEndPos + let check_progress ~prev_end_pos ~result p = + if p.end_pos == prev_end_pos then None else Some result let make ?(mode=ParseForTypeChecker) src filename = let scanner = Scanner.make (Bytes.of_string src) filename in - let parserState = { + let parser_state = { mode; scanner; token = Token.Eof; - startPos = Lexing.dummy_pos; - prevEndPos = Lexing.dummy_pos; - endPos = Lexing.dummy_pos; + start_pos = Lexing.dummy_pos; + prev_end_pos = Lexing.dummy_pos; + end_pos = Lexing.dummy_pos; breadcrumbs = []; errors = []; diagnostics = []; comments = []; regions = [ref Report]; } in - parserState.scanner.err <- (fun ~startPos ~endPos error -> + parser_state.scanner.err <- (fun ~start_pos ~end_pos error -> let diagnostic = Diagnostics.make ~filename - ~startPos - ~endPos + ~start_pos + ~end_pos error in - parserState.diagnostics <- diagnostic::parserState.diagnostics + parser_state.diagnostics <- diagnostic::parser_state.diagnostics ); - next parserState; - parserState + next parser_state; + parser_state - let leaveBreadcrumb p circumstance = - let crumb = (circumstance, p.startPos) in + let leave_breadcrumb p circumstance = + let crumb = (circumstance, p.start_pos) in p.breadcrumbs <- crumb::p.breadcrumbs - let eatBreadcrumb p = + let eat_breadcrumb p = match p.breadcrumbs with | [] -> () | _::crumbs -> p.breadcrumbs <- crumbs @@ -12203,8 +12203,8 @@ module Parser = struct if p.token = token then next p else - let error = Diagnostics.expected ?grammar p.prevEndPos token in - err ~startPos:p.prevEndPos p error + let error = Diagnostics.expected ?grammar p.prev_end_pos token in + err ~start_pos:p.prev_end_pos p error (* Don't use immutable copies here, it trashes certain heuristics * in the ocaml compiler, resulting in massive slowdowns of the parser *) @@ -12212,14 +12212,14 @@ module Parser = struct let err = p.scanner.err in let ch = p.scanner.ch in let offset = p.scanner.offset in - let rdOffset = p.scanner.rdOffset in - let lineOffset = p.scanner.lineOffset in + let rd_offset = p.scanner.rd_offset in + let line_offset = p.scanner.line_offset in let lnum = p.scanner.lnum in let mode = p.scanner.mode in let token = p.token in - let startPos = p.startPos in - let endPos = p.endPos in - let prevEndPos = p.prevEndPos 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 breadcrumbs = p.breadcrumbs in let errors = p.errors in let diagnostics = p.diagnostics in @@ -12230,14 +12230,14 @@ module Parser = struct p.scanner.err <- err; p.scanner.ch <- ch; p.scanner.offset <- offset; - p.scanner.rdOffset <- rdOffset; - p.scanner.lineOffset <- lineOffset; + p.scanner.rd_offset <- rd_offset; + p.scanner.line_offset <- line_offset; p.scanner.lnum <- lnum; p.scanner.mode <- mode; p.token <- token; - p.startPos <- startPos; - p.endPos <- endPos; - p.prevEndPos <- prevEndPos; + p.start_pos <- start_pos; + p.end_pos <- end_pos; + p.prev_end_pos <- prev_end_pos; p.breadcrumbs <- breadcrumbs; p.errors <- errors; p.diagnostics <- diagnostics; @@ -12247,9 +12247,9 @@ module Parser = struct end module NapkinScript = struct - let mkLoc startLoc endLoc = Location.{ - loc_start = startLoc; - loc_end = endLoc; + let mk_loc start_loc end_loc = Location.{ + loc_start = start_loc; + loc_end = end_loc; loc_ghost = false; } @@ -12257,34 +12257,34 @@ module NapkinScript = struct module Recover = struct type action = unit option (* None is abort, Some () is retry *) - let defaultExpr () = + let default_expr () = let id = Location.mknoloc "napkinscript.exprhole" in Ast_helper.Exp.mk (Pexp_extension (id, PStr [])) - let defaultType () = + let default_type () = let id = Location.mknoloc "napkinscript.typehole" in Ast_helper.Typ.extension (id, PStr []) - let defaultPattern () = + let default_pattern () = let id = Location.mknoloc "napkinscript.patternhole" in Ast_helper.Pat.extension (id, PStr []) (* Ast_helper.Pat.any () *) - let defaultModuleExpr () = Ast_helper.Mod.structure [] - let defaultModuleType () = Ast_helper.Mty.signature [] + let default_module_expr () = Ast_helper.Mod.structure [] + let default_module_type () = Ast_helper.Mty.signature [] - let recoverEqualGreater p = + let recover_equal_greater p = Parser.expect EqualGreater p; match p.Parser.token with | MinusGreater -> Parser.next p | _ -> () - let shouldAbortListParse p = + let should_abort_list_parse p = let rec check breadcrumbs = match breadcrumbs with | [] -> false | (grammar, _)::rest -> - if Grammar.isPartOfList grammar p.Parser.token then + if Grammar.is_part_of_list grammar p.Parser.token then true else check rest @@ -12293,49 +12293,49 @@ module NapkinScript = struct end module ErrorMessages = struct - let listPatternSpread = "List pattern matches only supports one `...` spread, at the end. + let list_pattern_spread = "List pattern matches only supports one `...` spread, at the end. Explanation: a list spread at the tail is efficient, but a spread in the middle would create new list[s]; out of performance concern, our pattern matching currently guarantees to never create new intermediate data." - let recordPatternSpread = "Record's `...` spread is not supported in pattern matches. + let record_pattern_spread = "Record's `...` spread is not supported in pattern matches. 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 wouldn't have one. Solution: you need to pull out each field you want explicitly." - let recordPatternUnderscore = "Record patterns only support one `_`, at the end." + let record_pattern_underscore = "Record patterns only support one `_`, at the end." [@@live] - let arrayPatternSpread = "Array's `...` spread is not supported in pattern matches. + let array_pattern_spread = "Array's `...` spread is not supported in pattern matches. Explanation: such spread would create a subarray; out of performance concern, our pattern matching currently guarantees to never create new intermediate data. Solution: if it's to validate the first few elements, use a `when` clause + Array size check + `get` checks on the current pattern. If it's to obtain a subarray, use `Array.sub` or `Belt.Array.slice`." - let arrayExprSpread = "Arrays can't use the `...` spread currently. Please use `concat` or other Array helpers." + let array_expr_spread = "Arrays can't use the `...` spread currently. Please use `concat` or other Array helpers." - let recordExprSpread = "Records can only have one `...` spread, at the beginning. + let record_expr_spread = "Records can only have one `...` spread, at the beginning. 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 listExprSpread = "Lists can only have one `...` spread, and at the end. + let list_expr_spread = "Lists can only have one `...` spread, and at the end. Explanation: lists are singly-linked list, where a node contains a value and points to the next node. `list[a, ...bc]` efficiently creates a new item and links `bc` as its next nodes. `[...bc, a]` would be expensive, as it'd need to traverse `bc` and prepend each item to `a` one by one. We therefore disallow such syntax sugar. Solution: directly use `concat`." - let variantIdent = "A polymorphic variant (e.g. #id) must start with an alphabetical letter." + let variant_ident = "A polymorphic variant (e.g. #id) must start with an alphabetical letter." end - let jsxAttr = (Location.mknoloc "JSX", Parsetree.PStr []) - let uncurryAttr = (Location.mknoloc "bs", Parsetree.PStr []) - let ternaryAttr = (Location.mknoloc "res.ternary", Parsetree.PStr []) - let makeBracesAttr loc = (Location.mkloc "res.braces" loc, Parsetree.PStr []) + let jsx_attr = (Location.mknoloc "JSX", Parsetree.PStr []) + let uncurry_attr = (Location.mknoloc "bs", Parsetree.PStr []) + let ternary_attr = (Location.mknoloc "res.ternary", Parsetree.PStr []) + let make_braces_attr loc = (Location.mkloc "res.braces" loc, Parsetree.PStr []) - type typDefOrExt = - | TypeDef of {recFlag: Asttypes.rec_flag; types: Parsetree.type_declaration list} + type typ_def_or_ext = + | TypeDef of {rec_flag: Asttypes.rec_flag; types: Parsetree.type_declaration list} | TypeExt of Parsetree.type_extension - type labelledParameter = + type labelled_parameter = | TermParameter of {uncurried: bool; attrs: Parsetree.attributes; label: Asttypes.arg_label; expr: Parsetree.expression option; pat: Parsetree.pattern; pos: Lexing.position} | TypeParameter of {uncurried: bool; attrs: Parsetree.attributes; locs: string Location.loc list; pos: Lexing.position} - type recordPatternItem = + type record_pattern_item = | PatUnderscore | PatField of (Ast_helper.lid * Parsetree.pattern) @@ -12344,29 +12344,29 @@ end | TernaryTrueBranchExpr | WhenExpr - let getClosingToken = function + let get_closing_token = function | Token.Lparen -> Token.Rparen | Lbrace -> Rbrace | Lbracket -> Rbracket | _ -> assert false - let rec goToClosing closingToken state = - match (state.Parser.token, closingToken) with + let rec go_to_closing closing_token state = + match (state.Parser.token, closing_token) with | (Rparen, Token.Rparen) | (Rbrace, Rbrace) | (Rbracket, Rbracket) -> Parser.next state; () | (Token.Lbracket | Lparen | Lbrace) as t, _ -> Parser.next state; - goToClosing (getClosingToken t) state; - goToClosing closingToken state + go_to_closing (get_closing_token t) state; + go_to_closing closing_token state | ((Rparen | Token.Rbrace | Rbracket | Eof), _) -> () (* TODO: how do report errors here? *) | _ -> Parser.next state; - goToClosing closingToken state + go_to_closing closing_token state (* Madness *) - let isEs6ArrowExpression ~inTernary p = + let is_es6_arrow_expression ~in_ternary p = Parser.lookahead p (fun state -> match state.Parser.token with | Lident _ | List | Underscore -> @@ -12381,13 +12381,13 @@ end | _ -> false end | Lparen -> - let prevEndPos = state.prevEndPos in + let prev_end_pos = state.prev_end_pos in Parser.next state; begin match state.token with | Rparen -> Parser.next state; begin match state.Parser.token with - | Colon when not inTernary -> true + | Colon when not in_ternary -> true | EqualGreater -> true | _ -> false end @@ -12395,11 +12395,11 @@ end | Tilde -> true | Backtick -> false (* (` always indicates the start of an expr, can't be es6 parameter *) | _ -> - goToClosing Rparen state; + go_to_closing Rparen state; begin match state.Parser.token with | EqualGreater -> true (* | Lbrace TODO: detect missing =>, is this possible? *) - | Colon when not inTernary -> true + | Colon when not in_ternary -> true | Rparen -> (* imagine having something as : * switch colour { @@ -12417,7 +12417,7 @@ end * in the example above, we have an unbalanced ] here *) begin match state.Parser.token with - | EqualGreater when state.startPos.pos_lnum == prevEndPos.pos_lnum -> true + | EqualGreater when state.start_pos.pos_lnum == prev_end_pos.pos_lnum -> true | _ -> false end end @@ -12425,7 +12425,7 @@ end | _ -> false) - let isEs6ArrowFunctor p = + let is_es6_arrow_functor p = Parser.lookahead p (fun state -> match state.Parser.token with (* | Uident _ | Underscore -> *) @@ -12444,7 +12444,7 @@ end | _ -> false end | _ -> - goToClosing Rparen state; + go_to_closing Rparen state; begin match state.Parser.token with | EqualGreater | Lbrace -> true | Colon -> true @@ -12454,7 +12454,7 @@ end | _ -> false ) - let isEs6ArrowType p = + let is_es6_arrow_type p = Parser.lookahead p (fun state -> match state.Parser.token with | Lparen -> @@ -12468,7 +12468,7 @@ end end | Tilde | Dot -> true | _ -> - goToClosing Rparen state; + go_to_closing Rparen state; begin match state.Parser.token with | EqualGreater -> true | _ -> false @@ -12478,67 +12478,67 @@ end | _ -> false ) - let buildLongident words = match List.rev words with + let build_longident words = match List.rev words with | [] -> assert false | hd::tl -> List.fold_left (fun p s -> Longident.Ldot (p, s)) (Lident hd) tl - let makeInfixOperator p token startPos endPos = - let stringifiedToken = + let make_infix_operator p token start_pos end_pos = + let stringified_token = if token = Token.MinusGreater then "|." else if token = Token.PlusPlus then "^" else if token = Token.BangEqual then "<>" 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 ~startPos ~endPos p ( + Parser.err ~start_pos ~end_pos p ( Diagnostics.message "Did you mean `==` here?" ); "=" ) else if token = Token.EqualEqual then "=" else if token = Token.EqualEqualEqual then "==" - else Token.toString token + else Token.to_string token in - let loc = mkLoc startPos endPos in + let loc = mk_loc start_pos end_pos in let operator = Location.mkloc - (Longident.Lident stringifiedToken) loc + (Longident.Lident stringified_token) loc in Ast_helper.Exp.ident ~loc operator - let negateString s = + let negate_string s = if String.length s > 0 && (s.[0] [@doesNotRaise]) = '-' then (String.sub [@doesNotRaise]) s 1 (String.length s - 1) else "-" ^ s - let makeUnaryExpr startPos tokenEnd token operand = + let make_unary_expr start_pos token_end 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 (negateString n,m))} + {operand with pexp_desc = Pexp_constant(Pconst_integer (negate_string n,m))} | (Minus | MinusDot), Pexp_constant(Pconst_float (n,m)) -> - {operand with pexp_desc = Pexp_constant(Pconst_float (negateString n,m))} + {operand with pexp_desc = Pexp_constant(Pconst_float (negate_string n,m))} | (Token.Plus | PlusDot | Minus | MinusDot ), _ -> - let tokenLoc = mkLoc startPos tokenEnd in - let operator = "~" ^ Token.toString token in + let token_loc = mk_loc start_pos token_end in + let operator = "~" ^ Token.to_string token in Ast_helper.Exp.apply - ~loc:(mkLoc startPos operand.Parsetree.pexp_loc.loc_end) - (Ast_helper.Exp.ident ~loc:tokenLoc - (Location.mkloc (Longident.Lident operator) tokenLoc)) + ~loc:(mk_loc start_pos operand.Parsetree.pexp_loc.loc_end) + (Ast_helper.Exp.ident ~loc:token_loc + (Location.mkloc (Longident.Lident operator) token_loc)) [Nolabel, operand] | Token.Bang, _ -> - let tokenLoc = mkLoc startPos tokenEnd in + let token_loc = mk_loc start_pos token_end in Ast_helper.Exp.apply - ~loc:(mkLoc startPos operand.Parsetree.pexp_loc.loc_end) - (Ast_helper.Exp.ident ~loc:tokenLoc - (Location.mkloc (Longident.Lident "not") tokenLoc)) + ~loc:(mk_loc start_pos operand.Parsetree.pexp_loc.loc_end) + (Ast_helper.Exp.ident ~loc:token_loc + (Location.mkloc (Longident.Lident "not") token_loc)) [Nolabel, operand] | _ -> operand - let makeListExpression loc seq extOpt = - let rec handleSeq = function + let make_list_expression loc seq ext_opt = + let rec handle_seq = function | [] -> - begin match extOpt with + begin match ext_opt with | Some ext -> ext | None -> let loc = {loc with Location.loc_ghost = true} in @@ -12546,8 +12546,8 @@ end Ast_helper.Exp.construct ~loc nil None end | e1 :: el -> - let exp_el = handleSeq el in - let loc = mkLoc + let exp_el = handle_seq el in + let loc = mk_loc e1.Parsetree.pexp_loc.Location.loc_start exp_el.pexp_loc.loc_end in @@ -12556,10 +12556,10 @@ end (Location.mkloc (Longident.Lident "::") loc) (Some arg) in - let expr = handleSeq seq in + let expr = handle_seq seq in {expr with pexp_loc = loc} - let makeListPattern loc seq ext_opt = + let make_list_pattern loc seq ext_opt = let rec handle_seq = function [] -> let base_case = match ext_opt with @@ -12574,7 +12574,7 @@ end | p1 :: pl -> let pat_pl = handle_seq pl in let loc = - mkLoc p1.Parsetree.ppat_loc.loc_start pat_pl.ppat_loc.loc_end in + mk_loc 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)) in @@ -12584,20 +12584,20 @@ end (* {"foo": bar} -> Js.t({. foo: bar}) * {.. "foo": bar} -> Js.t({.. foo: bar}) * {..} -> Js.t({..}) *) - let makeBsObjType ~attrs ~loc ~closed rows = + let make_bs_obj_type ~attrs ~loc ~closed rows = let obj = Ast_helper.Typ.object_ ~loc rows closed in - let jsDotTCtor = + let js_dot_t_ctor = Location.mkloc (Longident.Ldot (Longident.Lident "Js", "t")) loc in - Ast_helper.Typ.constr ~loc ~attrs jsDotTCtor [obj] + Ast_helper.Typ.constr ~loc ~attrs js_dot_t_ctor [obj] (* TODO: diagnostic reporting *) - let lidentOfPath longident = + let lident_of_path longident = match Longident.flatten longident |> List.rev with | [] -> "" | ident::_ -> ident - let makeNewtypes ~attrs ~loc newtypes exp = + let make_newtypes ~attrs ~loc newtypes exp = let expr = List.fold_right (fun newtype exp -> Ast_helper.Exp.mk ~loc (Pexp_newtype (newtype, exp)) ) newtypes exp @@ -12609,8 +12609,8 @@ end * into * let f = (type t u v. foo : list) => ... *) - let wrapTypeAnnotation ~loc newtypes core_type body = - let exp = makeNewtypes ~attrs:[] ~loc newtypes + let wrap_type_annotation ~loc newtypes core_type body = + let exp = make_newtypes ~attrs:[] ~loc newtypes (Ast_helper.Exp.constraint_ ~loc body core_type) in let typ = Ast_helper.Typ.poly ~loc newtypes @@ -12624,7 +12624,7 @@ end * return a wrapping function that wraps ((__x) => ...) around an expression * e.g. foo(_, 3) becomes (__x) => foo(__x, 3) *) - let processUnderscoreApplication args = + let process_underscore_application args = let open Parsetree in let exp_question = ref None in let hidden_var = "__x" in @@ -12649,11 +12649,11 @@ end in (args, wrap) - let rec parseLident p = - let recoverLident p = + let rec parse_lident p = + let recover_lident p = if ( - Token.isKeyword p.Parser.token && - p.Parser.prevEndPos.pos_lnum == p.startPos.pos_lnum + Token.is_keyword p.Parser.token && + p.Parser.prev_end_pos.pos_lnum == p.start_pos.pos_lnum ) then ( Parser.err p (Diagnostics.lident p.Parser.token); @@ -12661,7 +12661,7 @@ end None ) else ( let rec loop p = - if not (Recover.shouldAbortListParse p) + if not (Recover.should_abort_list_parse p) then begin Parser.next p; loop p @@ -12674,47 +12674,47 @@ end | _ -> None ) in - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in match p.Parser.token with | Lident ident -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in (ident, loc) | List -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in ("list", loc) | _ -> - begin match recoverLident p with + begin match recover_lident p with | Some () -> - parseLident p + parse_lident p | None -> - ("_", mkLoc startPos p.prevEndPos) + ("_", mk_loc start_pos p.prev_end_pos) end - let parseIdent ~msg ~startPos p = + let parse_ident ~msg ~start_pos p = match p.Parser.token with | Lident ident | Uident ident -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in (ident, loc) | List -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in ("list", loc) | _token -> Parser.err p (Diagnostics.message msg); Parser.next p; - ("_", mkLoc startPos p.prevEndPos) + ("_", mk_loc start_pos p.prev_end_pos) - let parseHashIdent ~startPos p = + let parse_hash_ident ~start_pos p = Parser.expect Hash p; - parseIdent ~startPos ~msg:ErrorMessages.variantIdent p + parse_ident ~start_pos ~msg:ErrorMessages.variant_ident p (* Ldot (Ldot (Lident "Foo", "Bar"), "baz") *) - let parseValuePath p = - let startPos = p.Parser.startPos in + let parse_value_path p = + let start_pos = p.Parser.start_pos in let rec aux p path = match p.Parser.token with | List -> Longident.Ldot(path, "list") @@ -12739,17 +12739,17 @@ end Longident.Lident "_" in Parser.next p; - Location.mkloc ident (mkLoc startPos p.prevEndPos) + Location.mkloc ident (mk_loc start_pos p.prev_end_pos) - let parseValuePathTail p startPos ident = + let parse_value_path_tail p start_pos ident = let rec loop p path = match p.Parser.token with | Lident ident -> Parser.next p; - Location.mkloc (Longident.Ldot(path, ident)) (mkLoc startPos p.prevEndPos) + Location.mkloc (Longident.Ldot(path, ident)) (mk_loc start_pos p.prev_end_pos) | List -> Parser.next p; - Location.mkloc (Longident.Ldot(path, "list")) (mkLoc startPos p.prevEndPos) + Location.mkloc (Longident.Ldot(path, "list")) (mk_loc start_pos p.prev_end_pos) | Uident ident -> Parser.next p; Parser.expect Dot p; @@ -12760,68 +12760,68 @@ end in loop p ident - let parseModuleLongIdentTail ~lowercase p startPos ident = + let parse_module_long_ident_tail ~lowercase p start_pos ident = let rec loop p acc = match p.Parser.token with | List when lowercase -> Parser.next p; let lident = (Longident.Ldot (acc, "list")) in - Location.mkloc lident (mkLoc startPos p.prevEndPos) + Location.mkloc lident (mk_loc start_pos p.prev_end_pos) | Lident ident when lowercase -> Parser.next p; let lident = (Longident.Ldot (acc, ident)) in - Location.mkloc lident (mkLoc startPos p.prevEndPos) + Location.mkloc lident (mk_loc start_pos p.prev_end_pos) | Uident ident -> Parser.next p; - let endPos = p.prevEndPos in + let end_pos = p.prev_end_pos in let lident = (Longident.Ldot (acc, ident)) in begin match p.Parser.token with | Dot -> Parser.next p; loop p lident - | _ -> Location.mkloc lident (mkLoc startPos endPos) + | _ -> Location.mkloc lident (mk_loc start_pos end_pos) end | t -> Parser.err p (Diagnostics.uident t); - Location.mkloc acc (mkLoc startPos p.prevEndPos) + Location.mkloc acc (mk_loc start_pos p.prev_end_pos) in loop p ident (* Parses module identifiers: Foo Foo.Bar *) - let parseModuleLongIdent ~lowercase p = + let parse_module_long_ident ~lowercase p = (* Parser.leaveBreadcrumb p Reporting.ModuleLongIdent; *) - let startPos = p.Parser.startPos in - let moduleIdent = match p.Parser.token with + let start_pos = p.Parser.start_pos in + let module_ident = match p.Parser.token with | List when lowercase -> - let loc = mkLoc startPos p.endPos in + let loc = mk_loc start_pos p.end_pos in Parser.next p; Location.mkloc (Longident.Lident "list") loc | Lident ident when lowercase -> - let loc = mkLoc startPos p.endPos in + let loc = mk_loc start_pos p.end_pos in let lident = Longident.Lident ident in Parser.next p; Location.mkloc lident loc | Uident ident -> let lident = Longident.Lident ident in - let endPos = p.endPos in + let end_pos = p.end_pos in Parser.next p; begin match p.Parser.token with | Dot -> Parser.next p; - parseModuleLongIdentTail ~lowercase p startPos lident - | _ -> Location.mkloc lident (mkLoc startPos endPos) + parse_module_long_ident_tail ~lowercase p start_pos lident + | _ -> Location.mkloc lident (mk_loc start_pos end_pos) end | t -> Parser.err p (Diagnostics.uident t); - Location.mkloc (Longident.Lident "_") (mkLoc startPos p.prevEndPos) + Location.mkloc (Longident.Lident "_") (mk_loc start_pos p.prev_end_pos) in (* Parser.eatBreadcrumb p; *) - moduleIdent + module_ident (* `window.location` or `Math` or `Foo.Bar` *) - let parseIdentPath p = + let parse_ident_path p = let rec loop p acc = match p.Parser.token with | Uident ident | Lident ident -> @@ -12847,31 +12847,31 @@ end | _ -> Longident.Lident "_" - let verifyJsxOpeningClosingName p nameExpr = + let verify_jsx_opening_closing_name p name_expr = let closing = match p.Parser.token with | Lident lident -> Parser.next p; Longident.Lident lident | Uident _ -> - (parseModuleLongIdent ~lowercase:false p).txt + (parse_module_long_ident ~lowercase:false p).txt | _ -> Longident.Lident "" in - match nameExpr.Parsetree.pexp_desc with - | Pexp_ident openingIdent -> + match name_expr.Parsetree.pexp_desc with + | Pexp_ident opening_ident -> let opening = - let withoutCreateElement = - Longident.flatten openingIdent.txt + let without_create_element = + Longident.flatten opening_ident.txt |> List.filter (fun s -> s <> "createElement") in - match (Longident.unflatten withoutCreateElement) with + match (Longident.unflatten without_create_element) with | Some li -> li | None -> Longident.Lident "" in opening = closing | _ -> assert false - let string_of_pexp_ident nameExpr = - match nameExpr.Parsetree.pexp_desc with - | Pexp_ident openingIdent -> - Longident.flatten openingIdent.txt + let string_of_pexp_ident name_expr = + match name_expr.Parsetree.pexp_desc with + | Pexp_ident opening_ident -> + Longident.flatten opening_ident.txt |> List.filter (fun s -> s <> "createElement") |> String.concat "." | _ -> "" @@ -12879,21 +12879,21 @@ end (* open-def ::= * | open module-path * | open! module-path *) - let parseOpenDescription ~attrs p = - Parser.leaveBreadcrumb p Grammar.OpenDescription; - let startPos = p.Parser.startPos in + let parse_open_description ~attrs p = + Parser.leave_breadcrumb p Grammar.OpenDescription; + let start_pos = p.Parser.start_pos in Parser.expect Open p; let override = if Parser.optional p Token.Bang then Asttypes.Override else Asttypes.Fresh in - let modident = parseModuleLongIdent ~lowercase:false p in - let loc = mkLoc startPos p.prevEndPos in - Parser.eatBreadcrumb p; + 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; Ast_helper.Opn.mk ~loc ~attrs ~override modident - let hexValue x = + let hex_value x = match x with | '0' .. '9' -> (Char.code x) - 48 @@ -12903,7 +12903,7 @@ end (Char.code x) - 97 | _ -> 16 - let parseStringLiteral s = + let parse_string_literal s = let len = String.length s in let b = Buffer.create (String.length s) in @@ -12914,39 +12914,39 @@ end let c = String.unsafe_get s i in match c with | '\\' as c -> - let nextIx = i + 1 in - if nextIx < len then - let nextChar = String.unsafe_get s nextIx in - begin match nextChar with + let next_ix = i + 1 in + if next_ix < len then + let next_char = String.unsafe_get s next_ix in + begin match next_char with | 'n' -> Buffer.add_char b '\010'; - loop (nextIx + 1) + loop (next_ix + 1) | 'r' -> Buffer.add_char b '\013'; - loop (nextIx + 1) + loop (next_ix + 1) | 'b' -> Buffer.add_char b '\008'; - loop (nextIx + 1) + loop (next_ix + 1) | 't' -> Buffer.add_char b '\009'; - loop (nextIx + 1) + loop (next_ix + 1) | '\\' as c -> Buffer.add_char b c; - loop (nextIx + 1) + loop (next_ix + 1) | ' ' as c -> Buffer.add_char b c; - loop (nextIx + 1) + loop (next_ix + 1) | '\'' as c -> Buffer.add_char b c; - loop (nextIx + 1) + loop (next_ix + 1) | '\"' as c -> Buffer.add_char b c; - loop (nextIx + 1) + loop (next_ix + 1) | '0' .. '9' -> - if nextIx + 2 < len then - let c0 = nextChar in - let c1 = (String.unsafe_get s (nextIx + 1)) in - let c2 = (String.unsafe_get s (nextIx + 2)) in + if next_ix + 2 < len then + let c0 = next_char in + let c1 = (String.unsafe_get s (next_ix + 1)) in + let c2 = (String.unsafe_get s (next_ix + 2)) in let c = 100 * (Char.code c0 - 48) + 10 * (Char.code c1 - 48) + @@ -12957,21 +12957,21 @@ end Buffer.add_char b c0; Buffer.add_char b c1; Buffer.add_char b c2; - loop (nextIx + 3) + loop (next_ix + 3) ) else ( Buffer.add_char b (Char.unsafe_chr c); - loop (nextIx + 3) + loop (next_ix + 3) ) else ( Buffer.add_char b '\\'; - Buffer.add_char b nextChar; - loop (nextIx + 1) + Buffer.add_char b next_char; + loop (next_ix + 1) ) | 'o' -> - if nextIx + 3 < len then - let c0 = (String.unsafe_get s (nextIx + 1)) in - let c1 = (String.unsafe_get s (nextIx + 2)) in - let c2 = (String.unsafe_get s (nextIx + 3)) in + if next_ix + 3 < len then + let c0 = (String.unsafe_get s (next_ix + 1)) in + let c1 = (String.unsafe_get s (next_ix + 2)) in + let c2 = (String.unsafe_get s (next_ix + 3)) in let c = 64 * (Char.code c0 - 48) + 8 * (Char.code c1 - 48) + @@ -12983,40 +12983,40 @@ end Buffer.add_char b c0; Buffer.add_char b c1; Buffer.add_char b c2; - loop (nextIx + 4) + loop (next_ix + 4) ) else ( Buffer.add_char b (Char.unsafe_chr c); - loop (nextIx + 4) + loop (next_ix + 4) ) else ( Buffer.add_char b '\\'; - Buffer.add_char b nextChar; - loop (nextIx + 1) + Buffer.add_char b next_char; + loop (next_ix + 1) ) | 'x' as c -> - if nextIx + 2 < len then - let c0 = (String.unsafe_get s (nextIx + 1)) in - let c1 = (String.unsafe_get s (nextIx + 2)) in - let c = (16 * (hexValue c0)) + (hexValue c1) in + if next_ix + 2 < len then + let c0 = (String.unsafe_get s (next_ix + 1)) in + let c1 = (String.unsafe_get s (next_ix + 2)) in + let c = (16 * (hex_value c0)) + (hex_value c1) in if (c < 0 || c > 255) then ( Buffer.add_char b '\\'; Buffer.add_char b 'x'; Buffer.add_char b c0; Buffer.add_char b c1; - loop (nextIx + 3) + loop (next_ix + 3) ) else ( Buffer.add_char b (Char.unsafe_chr c); - loop (nextIx + 3) + loop (next_ix + 3) ) else ( Buffer.add_char b '\\'; Buffer.add_char b c; - loop (nextIx + 2) + loop (next_ix + 2) ) | _ -> Buffer.add_char b c; - Buffer.add_char b nextChar; - loop (nextIx + 1) + Buffer.add_char b next_char; + loop (next_ix + 1) end else ( Buffer.add_char b c; @@ -13029,7 +13029,7 @@ end loop 0; Buffer.contents b - let parseTemplateStringLiteral s = + let parse_template_string_literal s = let len = String.length s in let b = Buffer.create len in @@ -13039,8 +13039,8 @@ end match c with | '\\' as c -> if i + 1 < len then - let nextChar = String.unsafe_get s (i + 1) in - begin match nextChar with + let next_char = String.unsafe_get s (i + 1) in + begin match next_char with | '\\' as c -> Buffer.add_char b c; loop (i + 2) @@ -13072,22 +13072,22 @@ end (* constant ::= integer-literal *) (* ∣ float-literal *) (* ∣ string-literal *) - let parseConstant p = - let isNegative = match p.Parser.token with + let parse_constant p = + let is_negative = match p.Parser.token with | Token.Minus -> Parser.next p; true | Plus -> Parser.next p; false | _ -> false in let constant = match p.Parser.token with | Int {i; suffix} -> - let intTxt = if isNegative then "-" ^ i else i in - Parsetree.Pconst_integer (intTxt, suffix) + let int_txt = if is_negative then "-" ^ i else i in + Parsetree.Pconst_integer (int_txt, suffix) | Float {f; suffix} -> - let floatTxt = if isNegative then "-" ^ f else f in - Parsetree.Pconst_float (floatTxt, suffix) + let float_txt = if is_negative then "-" ^ f else f in + Parsetree.Pconst_float (float_txt, suffix) | String s -> let txt = if p.mode = ParseForTypeChecker then - parseStringLiteral s + parse_string_literal s else s in @@ -13100,8 +13100,8 @@ end Parser.next p; constant - let parseCommaDelimitedRegion p ~grammar ~closing ~f = - Parser.leaveBreadcrumb p grammar; + let parse_comma_delimited_region p ~grammar ~closing ~f = + Parser.leave_breadcrumb p grammar; let rec loop nodes = match f p with | Some node -> @@ -13112,13 +13112,13 @@ end | token when token = closing || token = Eof -> List.rev (node::nodes) | _ -> - if not (p.token = Eof || p.token = closing || Recover.shouldAbortListParse p) then + if not (p.token = Eof || p.token = closing || Recover.should_abort_list_parse p) then Parser.expect Comma p; if p.token = Semicolon then Parser.next p; loop (node::nodes) end | None -> - if p.token = Eof || p.token = closing || Recover.shouldAbortListParse p then + if p.token = Eof || p.token = closing || Recover.should_abort_list_parse p then List.rev nodes else ( Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); @@ -13127,11 +13127,11 @@ end ); in let nodes = loop [] in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; nodes - let parseCommaDelimitedReversedList p ~grammar ~closing ~f = - Parser.leaveBreadcrumb p grammar; + let parse_comma_delimited_reversed_list p ~grammar ~closing ~f = + Parser.leave_breadcrumb p grammar; let rec loop nodes = match f p with | Some node -> @@ -13142,13 +13142,13 @@ end | token when token = closing || token = Eof -> (node::nodes) | _ -> - if not (p.token = Eof || p.token = closing || Recover.shouldAbortListParse p) then + if not (p.token = Eof || p.token = closing || Recover.should_abort_list_parse p) then Parser.expect Comma p; if p.token = Semicolon then Parser.next p; loop (node::nodes) end | None -> - if p.token = Eof || p.token = closing || Recover.shouldAbortListParse p then + if p.token = Eof || p.token = closing || Recover.should_abort_list_parse p then nodes else ( Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); @@ -13157,11 +13157,11 @@ end ); in let nodes = loop [] in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; nodes - let parseDelimitedRegion p ~grammar ~closing ~f = - Parser.leaveBreadcrumb p grammar; + let parse_delimited_region p ~grammar ~closing ~f = + Parser.leave_breadcrumb p grammar; let rec loop nodes = match f p with | Some node -> @@ -13170,7 +13170,7 @@ end if ( p.Parser.token = Token.Eof || p.token = closing || - Recover.shouldAbortListParse p + Recover.should_abort_list_parse p ) then List.rev nodes else ( @@ -13180,17 +13180,17 @@ end ) in let nodes = loop [] in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; nodes - let parseRegion p ~grammar ~f = - Parser.leaveBreadcrumb p grammar; + let parse_region p ~grammar ~f = + Parser.leave_breadcrumb p grammar; let rec loop nodes = match f p with | Some node -> loop (node::nodes) | None -> - if p.Parser.token = Token.Eof || Recover.shouldAbortListParse p then + if p.Parser.token = Token.Eof || Recover.should_abort_list_parse p then List.rev nodes else ( Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); @@ -13199,7 +13199,7 @@ end ) in let nodes = loop [] in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; nodes (* let-binding ::= pattern = expr *) @@ -13223,128 +13223,128 @@ end (* ∣ [| pattern { ; pattern } [ ; ] |] *) (* ∣ char-literal .. char-literal *) (* ∣ exception pattern *) - let rec parsePattern ?(alias=true) ?(or_=true) p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in + let rec parse_pattern ?(alias=true) ?(or_=true) p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in let pat = match p.Parser.token with | (True | False) as token -> - let endPos = p.endPos in + let end_pos = p.end_pos in Parser.next p; - let loc = mkLoc startPos endPos in + let loc = mk_loc start_pos end_pos in Ast_helper.Pat.construct ~loc - (Location.mkloc (Longident.Lident (Token.toString token)) loc) None + (Location.mkloc (Longident.Lident (Token.to_string token)) loc) None | Int _ | String _ | Float _ | Character _ | Minus | Plus -> - let c = parseConstant p in + let c = parse_constant p in begin match p.token with | DotDot -> Parser.next p; - let c2 = parseConstant p in - Ast_helper.Pat.interval ~loc:(mkLoc startPos p.prevEndPos) c c2 + 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:(mkLoc startPos p.prevEndPos) c + Ast_helper.Pat.constant ~loc:(mk_loc start_pos p.prev_end_pos) c end | Lparen -> Parser.next p; begin match p.token with | Rparen -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in let lid = Location.mkloc (Longident.Lident "()") loc in Ast_helper.Pat.construct ~loc lid None | _ -> - let pat = parseConstrainedPattern p in + let pat = parse_constrained_pattern p in begin match p.token with | Comma -> Parser.next p; - parseTuplePattern ~attrs ~first:pat ~startPos p + parse_tuple_pattern ~attrs ~first:pat ~start_pos p | _ -> Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in {pat with ppat_loc = loc} end end | Lbracket -> - parseArrayPattern ~attrs p + parse_array_pattern ~attrs p | Lbrace -> - parseRecordPattern ~attrs p + parse_record_pattern ~attrs p | Underscore -> - let endPos = p.endPos in - let loc = mkLoc startPos endPos in + let end_pos = p.end_pos in + let loc = mk_loc start_pos end_pos in Parser.next p; Ast_helper.Pat.any ~loc ~attrs () | Lident ident -> - let endPos = p.endPos in - let loc = mkLoc startPos endPos in + let end_pos = p.end_pos in + let loc = mk_loc start_pos end_pos in Parser.next p; Ast_helper.Pat.var ~loc ~attrs (Location.mkloc ident loc) | Uident _ -> - let constr = parseModuleLongIdent ~lowercase:false p in + let constr = parse_module_long_ident ~lowercase:false p in begin match p.Parser.token with | Lparen -> - parseConstructorPatternArgs p constr startPos attrs + parse_constructor_pattern_args p constr start_pos attrs | _ -> Ast_helper.Pat.construct ~loc:constr.loc ~attrs constr None end | Hash -> - let (ident, loc) = parseHashIdent ~startPos p in + let (ident, loc) = parse_hash_ident ~start_pos p in begin match p.Parser.token with | Lparen -> - parseVariantPatternArgs p ident startPos attrs + parse_variant_pattern_args p ident start_pos attrs | _ -> Ast_helper.Pat.variant ~loc ~attrs ident None end | HashHash -> Parser.next p; - let ident = parseValuePath p in - let loc = mkLoc startPos ident.loc.loc_end in + let ident = parse_value_path p in + let loc = mk_loc start_pos ident.loc.loc_end in Ast_helper.Pat.type_ ~loc ~attrs ident | Exception -> Parser.next p; - let pat = parsePattern ~alias:false ~or_:false p in - let loc = mkLoc startPos p.prevEndPos in + let pat = parse_pattern ~alias:false ~or_:false p in + let loc = mk_loc start_pos p.prev_end_pos 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 + let pat = parse_pattern ~alias:false ~or_:false p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Pat.lazy_ ~loc ~attrs pat | List -> Parser.next p; begin match p.token with | Lbracket -> - parseListPattern ~startPos ~attrs p + parse_list_pattern ~start_pos ~attrs p | _ -> - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Pat.var ~loc ~attrs (Location.mkloc "list" loc) end | Module -> - parseModulePattern ~attrs p + parse_module_pattern ~attrs p | Percent -> - let extension = parseExtension p in - let loc = mkLoc startPos p.prevEndPos in + let extension = parse_extension p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Pat.extension ~loc ~attrs extension | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - begin match skipTokensAndMaybeRetry p ~isStartOfGrammar:Grammar.isAtomicPatternStart with + begin match skip_tokens_and_maybe_retry p ~is_start_of_grammar:Grammar.is_atomic_pattern_start with | None -> - Recover.defaultPattern() + Recover.default_pattern() | Some () -> - parsePattern p + parse_pattern p end in - let pat = if alias then parseAliasPattern ~attrs pat p else pat in - if or_ then parseOrPattern pat p else pat + let pat = if alias then parse_alias_pattern ~attrs pat p else pat in + if or_ then parse_or_pattern pat p else pat - and skipTokensAndMaybeRetry p ~isStartOfGrammar = - if Token.isKeyword p.Parser.token - && p.Parser.prevEndPos.pos_lnum == p.startPos.pos_lnum + and skip_tokens_and_maybe_retry p ~is_start_of_grammar = + if Token.is_keyword p.Parser.token + && p.Parser.prev_end_pos.pos_lnum == p.start_pos.pos_lnum then ( Parser.next p; None ) else ( - if Recover.shouldAbortListParse p then + if Recover.should_abort_list_parse p then begin - if isStartOfGrammar p.Parser.token then + if is_start_of_grammar p.Parser.token then begin Parser.next p; Some () @@ -13356,13 +13356,13 @@ end begin Parser.next p; let rec loop p = - if not (Recover.shouldAbortListParse p) + if not (Recover.should_abort_list_parse p) then begin Parser.next p; loop p end in loop p; - if isStartOfGrammar p.Parser.token then + if is_start_of_grammar p.Parser.token then Some () else None @@ -13370,14 +13370,14 @@ end ) (* alias ::= pattern as lident *) - and parseAliasPattern ~attrs pattern p = + and parse_alias_pattern ~attrs pattern p = match p.Parser.token with | As -> Parser.next p; - let (name, loc) = parseLident p in + let (name, loc) = parse_lident p in let name = Location.mkloc name loc in Ast_helper.Pat.alias - ~loc:({pattern.ppat_loc with loc_end = p.prevEndPos}) + ~loc:({pattern.ppat_loc with loc_end = p.prev_end_pos}) ~attrs pattern name @@ -13385,12 +13385,12 @@ end (* or ::= pattern | pattern * precedence: Red | Blue | Green is interpreted as (Red | Blue) | Green *) - and parseOrPattern pattern1 p = + and parse_or_pattern pattern1 p = let rec loop pattern1 = match p.Parser.token with | Bar -> Parser.next p; - let pattern2 = parsePattern ~or_:false p in + let pattern2 = parse_pattern ~or_:false p in let loc = { pattern1.Parsetree.ppat_loc with loc_end = pattern2.ppat_loc.loc_end } in @@ -13399,7 +13399,7 @@ end in loop pattern1 - and parseNonSpreadPattern ~msg p = + and parse_non_spread_pattern ~msg p = let () = match p.Parser.token with | DotDotDot -> Parser.err p (Diagnostics.message msg); @@ -13407,32 +13407,32 @@ end | _ -> () in match p.Parser.token with - | token when Grammar.isPatternStart token -> - let pat = parsePattern p in + | token when Grammar.is_pattern_start token -> + let pat = parse_pattern p in begin match p.Parser.token with | Colon -> Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in + let typ = parse_typ_expr p in + let loc = mk_loc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in Some (Ast_helper.Pat.constraint_ ~loc pat typ) | _ -> Some pat end | _ -> None - and parseConstrainedPattern p = - let pat = parsePattern p in + and parse_constrained_pattern p = + let pat = parse_pattern p in match p.Parser.token with | Colon -> Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in + let typ = parse_typ_expr p in + let loc = mk_loc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in Ast_helper.Pat.constraint_ ~loc pat typ | _ -> pat - and parseConstrainedPatternRegion p = + and parse_constrained_pattern_region p = match p.Parser.token with - | token when Grammar.isPatternStart token -> - Some (parseConstrainedPattern p) + | token when Grammar.is_pattern_start token -> + Some (parse_constrained_pattern p) | _ -> None (* field ::= @@ -13445,13 +13445,13 @@ end * | field , _ * | field , _, *) - and parseRecordPatternField p = - let startPos = p.Parser.startPos in - let label = parseValuePath p in + and parse_record_pattern_field p = + let start_pos = p.Parser.start_pos in + let label = parse_value_path p in let pattern = match p.Parser.token with | Colon -> Parser.next p; - parsePattern p + parse_pattern p | _ -> Ast_helper.Pat.var ~loc:label.loc @@ -13460,91 +13460,91 @@ end match p.token with | As -> Parser.next p; - let (name, loc) = parseLident p in + let (name, loc) = parse_lident p in let name = Location.mkloc name loc in - let aliasPattern = Ast_helper.Pat.alias - ~loc:(mkLoc startPos p.prevEndPos) + let alias_pattern = Ast_helper.Pat.alias + ~loc:(mk_loc start_pos p.prev_end_pos) pattern name in - (Location.mkloc label.txt (mkLoc startPos aliasPattern.ppat_loc.loc_end), aliasPattern) + (Location.mkloc label.txt (mk_loc start_pos alias_pattern.ppat_loc.loc_end), alias_pattern) | _ -> (label, pattern) (* TODO: there are better representations than PatField|Underscore ? *) - and parseRecordPatternItem p = + and parse_record_pattern_item p = match p.Parser.token with | DotDotDot -> Parser.next p; - Some (true, PatField (parseRecordPatternField p)) + Some (true, PatField (parse_record_pattern_field p)) | Uident _ | Lident _ -> - Some (false, PatField (parseRecordPatternField p)) + Some (false, PatField (parse_record_pattern_field p)) | Underscore -> Parser.next p; Some (false, PatUnderscore) | _ -> None - and parseRecordPattern ~attrs p = - let startPos = p.startPos in + and parse_record_pattern ~attrs p = + let start_pos = p.start_pos in Parser.expect Lbrace p; - let rawFields = - parseCommaDelimitedReversedList p + let raw_fields = + parse_comma_delimited_reversed_list p ~grammar:PatternRecord ~closing:Rbrace - ~f:parseRecordPatternItem + ~f:parse_record_pattern_item in Parser.expect Rbrace p; - let (fields, closedFlag) = - let (rawFields, flag) = match rawFields with + let (fields, closed_flag) = + let (raw_fields, flag) = match raw_fields with | (_hasSpread, PatUnderscore)::rest -> (rest, Asttypes.Open) - | rawFields -> - (rawFields, Asttypes.Closed) + | raw_fields -> + (raw_fields, Asttypes.Closed) in List.fold_left (fun (fields, flag) curr -> - let (hasSpread, field) = curr in + let (has_spread, field) = curr in match field with | PatField field -> - if hasSpread then ( + if has_spread then ( let (_, pattern) = field in - Parser.err ~startPos:pattern.Parsetree.ppat_loc.loc_start p (Diagnostics.message ErrorMessages.recordPatternSpread) + Parser.err ~start_pos:pattern.Parsetree.ppat_loc.loc_start p (Diagnostics.message ErrorMessages.record_pattern_spread) ); (field::fields, flag) | PatUnderscore -> (fields, flag) - ) ([], flag) rawFields + ) ([], flag) raw_fields in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Pat.record ~loc ~attrs fields closedFlag + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Pat.record ~loc ~attrs fields closed_flag - and parseTuplePattern ~attrs ~first ~startPos p = + and parse_tuple_pattern ~attrs ~first ~start_pos p = let patterns = - parseCommaDelimitedRegion p + parse_comma_delimited_region p ~grammar:Grammar.PatternList ~closing:Rparen - ~f:parseConstrainedPatternRegion + ~f:parse_constrained_pattern_region in Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Pat.tuple ~loc ~attrs (first::patterns) - and parsePatternRegion p = + and parse_pattern_region p = match p.Parser.token with | DotDotDot -> Parser.next p; - Some (true, parseConstrainedPattern p) - | token when Grammar.isPatternStart token -> - Some (false, parseConstrainedPattern p) + Some (true, parse_constrained_pattern p) + | token when Grammar.is_pattern_start token -> + Some (false, parse_constrained_pattern p) | _ -> None - and parseModulePattern ~attrs p = - let startPos = p.Parser.startPos in + and parse_module_pattern ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Module p; Parser.expect Lparen p; let uident = match p.token with | Uident uident -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Location.mkloc uident loc | _ -> (* TODO: error recovery *) @@ -13552,78 +13552,78 @@ end in begin match p.token with | Colon -> - let colonStart = p.Parser.startPos in + let colon_start = p.Parser.start_pos in Parser.next p; - let packageTypAttrs = parseAttributes p in - let packageType = parsePackageType ~startPos:colonStart ~attrs:packageTypAttrs p in + let package_typ_attrs = parse_attributes p in + let package_type = parse_package_type ~start_pos:colon_start ~attrs:package_typ_attrs p in Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in let unpack = Ast_helper.Pat.unpack ~loc:uident.loc uident in Ast_helper.Pat.constraint_ ~loc ~attrs unpack - packageType + package_type | _ -> Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Pat.unpack ~loc ~attrs uident end - and parseListPattern ~startPos ~attrs p = + and parse_list_pattern ~start_pos ~attrs p = Parser.expect Lbracket p; - let listPatterns = - parseCommaDelimitedReversedList p + let list_patterns = + parse_comma_delimited_reversed_list p ~grammar:Grammar.PatternOcamlList ~closing:Rbracket - ~f:parsePatternRegion + ~f:parse_pattern_region in Parser.expect Rbracket p; - let loc = mkLoc startPos p.prevEndPos in - let filterSpread (hasSpread, pattern) = - if hasSpread then ( + let loc = mk_loc start_pos p.prev_end_pos in + let filter_spread (has_spread, pattern) = + if has_spread then ( Parser.err - ~startPos:pattern.Parsetree.ppat_loc.loc_start + ~start_pos:pattern.Parsetree.ppat_loc.loc_start p - (Diagnostics.message ErrorMessages.listPatternSpread); + (Diagnostics.message ErrorMessages.list_pattern_spread); pattern ) else pattern in - match listPatterns with + match list_patterns with | (true, pattern)::patterns -> - let patterns = patterns |> List.map filterSpread |> List.rev in - let pat = makeListPattern loc patterns (Some pattern) in + let patterns = patterns |> List.map filter_spread |> List.rev in + let pat = make_list_pattern loc patterns (Some pattern) in {pat with ppat_loc = loc; ppat_attributes = attrs;} | patterns -> - let patterns = patterns |> List.map filterSpread |> List.rev in - let pat = makeListPattern loc patterns None in + let patterns = patterns |> List.map filter_spread |> List.rev in + let pat = make_list_pattern loc patterns None in {pat with ppat_loc = loc; ppat_attributes = attrs;} - and parseArrayPattern ~attrs p = - let startPos = p.startPos in + and parse_array_pattern ~attrs p = + let start_pos = p.start_pos in Parser.expect Lbracket p; let patterns = - parseCommaDelimitedRegion + parse_comma_delimited_region p ~grammar:Grammar.PatternList ~closing:Rbracket - ~f:(parseNonSpreadPattern ~msg:ErrorMessages.arrayPatternSpread) + ~f:(parse_non_spread_pattern ~msg:ErrorMessages.array_pattern_spread) in Parser.expect Rbracket p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Pat.array ~loc ~attrs patterns - and parseConstructorPatternArgs p constr startPos attrs = - let lparen = p.startPos in + and parse_constructor_pattern_args p constr start_pos attrs = + let lparen = p.start_pos in Parser.expect Lparen p; - let args = parseCommaDelimitedRegion - p ~grammar:Grammar.PatternList ~closing:Rparen ~f:parseConstrainedPatternRegion + let args = parse_comma_delimited_region + p ~grammar:Grammar.PatternList ~closing:Rparen ~f:parse_constrained_pattern_region in Parser.expect Rparen p; let args = match args with | [] -> - let loc = mkLoc lparen p.prevEndPos in + let loc = mk_loc lparen p.prev_end_pos in Some ( Ast_helper.Pat.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None ) @@ -13633,19 +13633,19 @@ end Some pat else (* Some((1, 2)) for printer *) - Some (Ast_helper.Pat.tuple ~loc:(mkLoc lparen p.endPos) patterns) + Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) | [pattern] -> Some pattern | patterns -> - Some (Ast_helper.Pat.tuple ~loc:(mkLoc lparen p.endPos) patterns) + Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) in - Ast_helper.Pat.construct ~loc:(mkLoc startPos p.prevEndPos) ~attrs constr args + Ast_helper.Pat.construct ~loc:(mk_loc start_pos p.prev_end_pos) ~attrs constr args - and parseVariantPatternArgs p ident startPos attrs = - let lparen = p.startPos in + and parse_variant_pattern_args p ident start_pos attrs = + let lparen = p.start_pos in Parser.expect Lparen p; let patterns = - parseCommaDelimitedRegion - p ~grammar:Grammar.PatternList ~closing:Rparen ~f:parseConstrainedPatternRegion in + parse_comma_delimited_region + p ~grammar:Grammar.PatternList ~closing:Rparen ~f:parse_constrained_pattern_region in let args = match patterns with | [{ppat_desc = Ppat_tuple _} as pat] as patterns -> @@ -13654,76 +13654,76 @@ end Some pat else (* #ident((1, 2)) for printer *) - Some (Ast_helper.Pat.tuple ~loc:(mkLoc lparen p.endPos) patterns) + Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) | [pattern] -> Some pattern | patterns -> - Some (Ast_helper.Pat.tuple ~loc:(mkLoc lparen p.endPos) patterns) + Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) in Parser.expect Rparen p; - Ast_helper.Pat.variant ~loc:(mkLoc startPos p.prevEndPos) ~attrs ident args + Ast_helper.Pat.variant ~loc:(mk_loc start_pos p.prev_end_pos) ~attrs ident args - and parseExpr ?(context=OrdinaryExpr) p = - let expr = parseOperandExpr ~context p in - let expr = parseBinaryExpr ~context ~a:expr p 1 in - parseTernaryExpr expr p + 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 (* expr ? expr : expr *) - and parseTernaryExpr leftOperand p = + and parse_ternary_expr left_operand p = match p.Parser.token with | Question -> - Parser.leaveBreadcrumb p Grammar.Ternary; + Parser.leave_breadcrumb p Grammar.Ternary; Parser.next p; - let trueBranch = parseExpr ~context:TernaryTrueBranchExpr p in + let true_branch = parse_expr ~context:TernaryTrueBranchExpr p in Parser.expect Colon p; - let falseBranch = parseExpr p in - Parser.eatBreadcrumb p; - let loc = {leftOperand.Parsetree.pexp_loc with - loc_start = leftOperand.pexp_loc.loc_start; - loc_end = falseBranch.Parsetree.pexp_loc.loc_end; + let false_branch = parse_expr p in + Parser.eat_breadcrumb 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; } in Ast_helper.Exp.ifthenelse - ~attrs:[ternaryAttr] ~loc - leftOperand trueBranch (Some falseBranch) + ~attrs:[ternary_attr] ~loc + left_operand true_branch (Some false_branch) | _ -> - leftOperand + left_operand - and parseEs6ArrowExpression ?parameters p = - let startPos = p.Parser.startPos in - Parser.leaveBreadcrumb p Grammar.Es6ArrowExpr; + and parse_es6_arrow_expression ?parameters p = + let start_pos = p.Parser.start_pos in + Parser.leave_breadcrumb p Grammar.Es6ArrowExpr; let parameters = match parameters with | Some params -> params - | None -> parseParameters p + | None -> parse_parameters p in - let returnType = match p.Parser.token with + let return_type = match p.Parser.token with | Colon -> Parser.next p; - Some (parseTypExpr ~es6Arrow:false p) + Some (parse_typ_expr ~es6_arrow:false p) | _ -> None in Parser.expect EqualGreater p; let body = - let expr = parseExpr p in - match returnType with + let expr = parse_expr p in + match return_type with | Some typ -> Ast_helper.Exp.constraint_ - ~loc:(mkLoc expr.pexp_loc.loc_start typ.Parsetree.ptyp_loc.loc_end) expr typ + ~loc:(mk_loc expr.pexp_loc.loc_start typ.Parsetree.ptyp_loc.loc_end) expr typ | None -> expr in - Parser.eatBreadcrumb p; - let endPos = p.prevEndPos in - let arrowExpr = + Parser.eat_breadcrumb p; + let end_pos = p.prev_end_pos in + let arrow_expr = List.fold_right (fun parameter expr -> match parameter with - | TermParameter {uncurried; attrs; label = lbl; expr = defaultExpr; pat; pos = startPos} -> - let attrs = if uncurried then uncurryAttr::attrs else attrs in - Ast_helper.Exp.fun_ ~loc:(mkLoc startPos endPos) ~attrs lbl defaultExpr pat expr - | TypeParameter {uncurried; attrs; locs = newtypes; pos = startPos} -> - let attrs = if uncurried then uncurryAttr::attrs else attrs in - makeNewtypes ~attrs ~loc:(mkLoc startPos endPos) newtypes expr + | TermParameter {uncurried; attrs; label = lbl; expr = default_expr; pat; pos = start_pos} -> + let attrs = if uncurried then uncurry_attr::attrs else attrs in + Ast_helper.Exp.fun_ ~loc:(mk_loc start_pos end_pos) ~attrs lbl default_expr pat expr + | TypeParameter {uncurried; attrs; locs = newtypes; pos = start_pos} -> + let attrs = if uncurried then uncurry_attr::attrs else attrs in + make_newtypes ~attrs ~loc:(mk_loc start_pos end_pos) newtypes expr ) parameters body in - {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} + {arrow_expr with pexp_loc = {arrow_expr.pexp_loc with loc_start = start_pos}} (* * uncurried_parameter ::= @@ -13744,14 +13744,14 @@ end * * labelName ::= lident *) - and parseParameter p = + and parse_parameter p = if ( p.Parser.token = Token.Typ || p.token = Tilde || p.token = Dot || - Grammar.isPatternStart p.token + Grammar.is_pattern_start p.token ) then ( - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in let uncurried = Parser.optional p Token.Dot in (* two scenarios: * attrs ~lbl ... @@ -13759,53 +13759,53 @@ end * Attributes before a labelled arg, indicate that it's on the whole arrow expr * Otherwise it's part of the pattern * *) - let attrs = parseAttributes p in + let attrs = parse_attributes p in if p.Parser.token = Typ then ( Parser.next p; - let lidents = parseLidentList p in - Some (TypeParameter {uncurried; attrs; locs = lidents; pos = startPos}) + let lidents = parse_lident_list p in + Some (TypeParameter {uncurried; attrs; locs = lidents; pos = start_pos}) ) else ( let (attrs, lbl, pat) = match p.Parser.token with | Tilde -> Parser.next p; - let (lblName, loc) = parseLident p in - let propLocAttr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in + let (lbl_name, loc) = parse_lident p in + let prop_loc_attr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in begin match p.Parser.token with | Comma | Equal | Rparen -> - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in ( attrs, - Asttypes.Labelled lblName, - Ast_helper.Pat.var ~attrs:[propLocAttr] ~loc (Location.mkloc lblName loc) + Asttypes.Labelled lbl_name, + Ast_helper.Pat.var ~attrs:[prop_loc_attr] ~loc (Location.mkloc lbl_name loc) ) | Colon -> - let lblEnd = p.prevEndPos in + let lbl_end = p.prev_end_pos in Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc startPos lblEnd in + let typ = parse_typ_expr p in + let loc = mk_loc start_pos lbl_end in let pat = - 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] ~loc pat typ in - (attrs, Asttypes.Labelled lblName, 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] ~loc pat typ in + (attrs, Asttypes.Labelled lbl_name, pat) | As -> Parser.next p; let pat = - let pat = parseConstrainedPattern p in - {pat with ppat_attributes = propLocAttr::pat.ppat_attributes} + let pat = parse_constrained_pattern p in + {pat with ppat_attributes = prop_loc_attr::pat.ppat_attributes} in - (attrs, Asttypes.Labelled lblName, pat) + (attrs, Asttypes.Labelled lbl_name, pat) | t -> Parser.err p (Diagnostics.unexpected t p.breadcrumbs); - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in ( attrs, - Asttypes.Labelled lblName, - Ast_helper.Pat.var ~loc (Location.mkloc lblName loc) + Asttypes.Labelled lbl_name, + Ast_helper.Pat.var ~loc (Location.mkloc lbl_name loc) ) end | _ -> - let pattern = parseConstrainedPattern p in + let pattern = parse_constrained_pattern p in let attrs = List.concat [attrs; pattern.ppat_attributes] in ([], Asttypes.Nolabel, {pattern with ppat_attributes = attrs}) in @@ -13813,28 +13813,28 @@ end | Equal -> Parser.next p; let lbl = match lbl with - | Asttypes.Labelled lblName -> Asttypes.Optional lblName + | Asttypes.Labelled lbl_name -> Asttypes.Optional lbl_name | Asttypes.Optional _ as lbl -> lbl | Asttypes.Nolabel -> Asttypes.Nolabel in begin match p.Parser.token with | Question -> Parser.next p; - Some (TermParameter {uncurried; attrs; label = lbl; expr = None; pat; pos = startPos}) + Some (TermParameter {uncurried; attrs; label = lbl; expr = None; pat; pos = start_pos}) | _ -> - let expr = parseConstrainedOrCoercedExpr p in - Some (TermParameter {uncurried; attrs; label = lbl; expr = Some expr; pat; pos = startPos}) + let expr = parse_constrained_or_coerced_expr p in + Some (TermParameter {uncurried; attrs; label = lbl; expr = Some expr; pat; pos = start_pos}) end | _ -> - Some (TermParameter {uncurried; attrs; label = lbl; expr = None; pat; pos = startPos}) + Some (TermParameter {uncurried; attrs; label = lbl; expr = None; pat; pos = start_pos}) ) ) else None - and parseParameterList p = + and parse_parameter_list p = let parameters = - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.ParameterList - ~f:parseParameter + ~f:parse_parameter ~closing:Rparen p in @@ -13848,89 +13848,89 @@ end * | (.) * | ( parameter {, parameter} [,] ) *) - and parseParameters p = - let startPos = p.Parser.startPos in + and parse_parameters p = + let start_pos = p.Parser.start_pos in match p.Parser.token with | Lident ident -> Parser.next p; - let loc = mkLoc startPos p.Parser.prevEndPos in + let loc = mk_loc start_pos p.Parser.prev_end_pos in [TermParameter { uncurried = false; attrs = []; label = Asttypes.Nolabel; expr = None; pat = Ast_helper.Pat.var ~loc (Location.mkloc ident loc); - pos = startPos; + pos = start_pos; }] | List -> Parser.next p; - let loc = mkLoc startPos p.Parser.prevEndPos in + let loc = mk_loc start_pos p.Parser.prev_end_pos in [TermParameter { uncurried = false; attrs = []; label = Asttypes.Nolabel; expr = None; pat = Ast_helper.Pat.var ~loc (Location.mkloc "list" loc); - pos = startPos; + pos = start_pos; }] | Underscore -> Parser.next p; - let loc = mkLoc startPos p.Parser.prevEndPos in - [TermParameter {uncurried = false; attrs = []; label = Asttypes.Nolabel; expr = None; pat = Ast_helper.Pat.any ~loc (); pos = startPos}] + let loc = mk_loc start_pos p.Parser.prev_end_pos in + [TermParameter {uncurried = false; attrs = []; label = Asttypes.Nolabel; expr = None; pat = Ast_helper.Pat.any ~loc (); pos = start_pos}] | Lparen -> Parser.next p; begin match p.Parser.token with | Rparen -> Parser.next p; - let loc = mkLoc startPos p.Parser.prevEndPos in - let unitPattern = Ast_helper.Pat.construct + let loc = mk_loc start_pos p.Parser.prev_end_pos in + let unit_pattern = Ast_helper.Pat.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None in - [TermParameter {uncurried = false; attrs = []; label = Asttypes.Nolabel; expr = None; pat = unitPattern; pos = startPos}] + [TermParameter {uncurried = false; attrs = []; label = Asttypes.Nolabel; expr = None; pat = unit_pattern; pos = start_pos}] | Dot -> Parser.next p; begin match p.token with | Rparen -> Parser.next p; - let loc = mkLoc startPos p.Parser.prevEndPos in - let unitPattern = Ast_helper.Pat.construct + let loc = mk_loc start_pos p.Parser.prev_end_pos in + let unit_pattern = Ast_helper.Pat.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None in - [TermParameter {uncurried = true; attrs = []; label = Asttypes.Nolabel; expr = None; pat = unitPattern; pos = startPos}] + [TermParameter {uncurried = true; attrs = []; label = Asttypes.Nolabel; expr = None; pat = unit_pattern; pos = start_pos}] | _ -> - begin match parseParameterList p with - | (TermParameter {attrs; label = lbl; expr = defaultExpr; pat = pattern; pos = startPos})::rest -> - (TermParameter {uncurried = true; attrs; label = lbl; expr = defaultExpr; pat = pattern; pos = startPos})::rest + begin match parse_parameter_list p with + | (TermParameter {attrs; label = lbl; expr = default_expr; pat = pattern; pos = start_pos})::rest -> + (TermParameter {uncurried = true; attrs; label = lbl; expr = default_expr; pat = pattern; pos = start_pos})::rest | parameters -> parameters end end - | _ -> parseParameterList p + | _ -> parse_parameter_list p end | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); [] - and parseCoercedExpr ~(expr: Parsetree.expression) p = + and parse_coerced_expr ~(expr: Parsetree.expression) p = Parser.expect ColonGreaterThan p; - let typ = parseTypExpr p in - let loc = mkLoc expr.pexp_loc.loc_start p.prevEndPos in + let typ = parse_typ_expr p in + let loc = mk_loc expr.pexp_loc.loc_start p.prev_end_pos in Ast_helper.Exp.coerce ~loc expr None typ - and parseConstrainedOrCoercedExpr p = - let expr = parseExpr p in + and parse_constrained_or_coerced_expr p = + let expr = parse_expr p in match p.Parser.token with | ColonGreaterThan -> - parseCoercedExpr ~expr p + parse_coerced_expr ~expr p | Colon -> Parser.next p; begin match p.token with | _ -> - let typ = parseTypExpr p in - let loc = mkLoc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in + let typ = parse_typ_expr p in + let loc = mk_loc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in let expr = Ast_helper.Exp.constraint_ ~loc expr typ in begin match p.token with | ColonGreaterThan -> - parseCoercedExpr ~expr p + parse_coerced_expr ~expr p | _ -> expr end @@ -13938,15 +13938,15 @@ end | _ -> expr - and parseConstrainedExprRegion p = + and parse_constrained_expr_region p = match p.Parser.token with - | token when Grammar.isExprStart token -> - let expr = parseExpr p in + | token when Grammar.is_expr_start token -> + let expr = parse_expr p in begin match p.Parser.token with | Colon -> Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in + let typ = parse_typ_expr p in + let loc = mk_loc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in Some (Ast_helper.Exp.constraint_ ~loc expr typ) | _ -> Some expr end @@ -13955,40 +13955,40 @@ end (* Atomic expressions represent unambiguous expressions. * This means that regardless of the context, these expressions * are always interpreted correctly. *) - and parseAtomicExpr p = - Parser.leaveBreadcrumb p Grammar.ExprOperand; - let startPos = p.Parser.startPos in + and parse_atomic_expr p = + Parser.leave_breadcrumb p Grammar.ExprOperand; + let start_pos = p.Parser.start_pos in let expr = match p.Parser.token with | (True | False) as token -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.construct ~loc - (Location.mkloc (Longident.Lident (Token.toString token)) loc) None + (Location.mkloc (Longident.Lident (Token.to_string token)) loc) None | Int _ | String _ | Float _ | Character _ -> - let c = parseConstant p in - let loc = mkLoc startPos p.prevEndPos in + let c = parse_constant p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.constant ~loc c | Backtick -> - let expr = parseTemplateExpr p in - {expr with pexp_loc = mkLoc startPos p.prevEndPos} + let expr = parse_template_expr p in + {expr with pexp_loc = mk_loc start_pos p.prev_end_pos} | Uident _ | Lident _ -> - parseValueOrConstructor p + parse_value_or_constructor p | Hash -> - parsePolyVariantExpr p + parse_poly_variant_expr p | Lparen -> Parser.next p; begin match p.Parser.token with | Rparen -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None | _t -> - let expr = parseConstrainedOrCoercedExpr p in + let expr = parse_constrained_or_coerced_expr p in begin match p.token with | Comma -> Parser.next p; - parseTupleExpr ~startPos ~first:expr p + parse_tuple_expr ~start_pos ~first:expr p | _ -> Parser.expect Rparen p; expr @@ -14004,132 +14004,132 @@ end Parser.next p; begin match p.token with | Lbracket -> - parseListExpr ~startPos p + parse_list_expr ~start_pos p | _ -> - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "list") loc) end | Module -> Parser.next p; - parseFirstClassModuleExpr ~startPos p + parse_first_class_module_expr ~start_pos p | Lbracket -> - parseArrayExp p + parse_array_exp p | Lbrace -> - parseBracedOrRecordExpr p + parse_braced_or_record_expr p | LessThan -> - parseJsx p + parse_jsx p | Percent -> - let extension = parseExtension p in - let loc = mkLoc startPos p.prevEndPos in + let extension = parse_extension p in + let loc = mk_loc start_pos p.prev_end_pos 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.defaultExpr () + Recover.default_expr () | token -> - let errPos = p.prevEndPos in - begin match skipTokensAndMaybeRetry p ~isStartOfGrammar:Grammar.isAtomicExprStart with + let err_pos = p.prev_end_pos in + begin match skip_tokens_and_maybe_retry p ~is_start_of_grammar:Grammar.is_atomic_expr_start with | None -> - Parser.err ~startPos:errPos p (Diagnostics.unexpected token p.breadcrumbs); - Recover.defaultExpr () - | Some () -> parseAtomicExpr p + Parser.err ~start_pos:err_pos p (Diagnostics.unexpected token p.breadcrumbs); + Recover.default_expr () + | Some () -> parse_atomic_expr p end in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; expr (* module(module-expr) * module(module-expr : package-type) *) - and parseFirstClassModuleExpr ~startPos p = + and parse_first_class_module_expr ~start_pos p = Parser.expect Lparen p; - let modExpr = parseModuleExpr p in - let modEndLoc = p.prevEndPos in + let mod_expr = parse_module_expr p in + let mod_end_loc = p.prev_end_pos in begin match p.Parser.token with | Colon -> - let colonStart = p.Parser.startPos in + let colon_start = p.Parser.start_pos in Parser.next p; - let attrs = parseAttributes p in - let packageType = parsePackageType ~startPos:colonStart ~attrs p in + let attrs = parse_attributes p in + let package_type = parse_package_type ~start_pos:colon_start ~attrs p in Parser.expect Rparen p; - 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 + 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 | _ -> Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Exp.pack ~loc modExpr + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Exp.pack ~loc mod_expr end - and parseBracketAccess p expr startPos = - Parser.leaveBreadcrumb p Grammar.ExprArrayAccess; - let lbracket = p.startPos in + and parse_bracket_access p expr start_pos = + Parser.leave_breadcrumb p Grammar.ExprArrayAccess; + let lbracket = p.start_pos in Parser.next p; - let stringStart = p.startPos in + let string_start = p.start_pos in match p.Parser.token with | String s -> Parser.next p; - let stringEnd = p.prevEndPos in + let string_end = p.prev_end_pos in Parser.expect Rbracket p; - let rbracket = p.prevEndPos in + let rbracket = p.prev_end_pos in let e = - let identLoc = mkLoc stringStart stringEnd in - let loc = mkLoc lbracket rbracket in + let ident_loc = mk_loc string_start string_end in + let loc = mk_loc lbracket rbracket in Ast_helper.Exp.apply ~loc (Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "##") loc)) - [Nolabel, expr; Nolabel, (Ast_helper.Exp.ident ~loc:identLoc (Location.mkloc (Longident.Lident s) identLoc))] + [Nolabel, expr; Nolabel, (Ast_helper.Exp.ident ~loc:ident_loc (Location.mkloc (Longident.Lident s) ident_loc))] in - let e = parsePrimaryExpr ~operand:e p in - let equalStart = p.startPos in + let e = parse_primary_expr ~operand:e p in + let equal_start = p.start_pos in begin match p.token with | Equal -> Parser.next p; - 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 + 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 Ast_helper.Exp.apply ~loc - (Ast_helper.Exp.ident ~loc:operatorLoc (Location.mkloc (Longident.Lident "#=") operatorLoc)) - [Nolabel, e; Nolabel, rhsExpr] + (Ast_helper.Exp.ident ~loc:operator_loc (Location.mkloc (Longident.Lident "#=") operator_loc)) + [Nolabel, e; Nolabel, rhs_expr] | _ -> e end | _ -> - let accessExpr = parseConstrainedOrCoercedExpr p in + let access_expr = parse_constrained_or_coerced_expr p in Parser.expect Rbracket p; - let rbracket = p.prevEndPos in - let arrayLoc = mkLoc lbracket rbracket in + let rbracket = p.prev_end_pos in + let array_loc = mk_loc lbracket rbracket in begin match p.token with | Equal -> - Parser.leaveBreadcrumb p ExprArrayMutation; + Parser.leave_breadcrumb p ExprArrayMutation; Parser.next p; - let rhsExpr = parseExpr p in - let arraySet = Location.mkloc + let rhs_expr = parse_expr p in + let array_set = Location.mkloc (Longident.Ldot(Lident "Array", "set")) - arrayLoc + array_loc in - 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] + 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] in - Parser.eatBreadcrumb p; - arraySet + Parser.eat_breadcrumb p; + array_set | _ -> - let endPos = p.prevEndPos in + let end_pos = p.prev_end_pos in let e = Ast_helper.Exp.apply - ~loc:(mkLoc startPos endPos) + ~loc:(mk_loc start_pos end_pos) (Ast_helper.Exp.ident - ~loc:arrayLoc - (Location.mkloc (Longident.Ldot(Lident "Array", "get")) arrayLoc) + ~loc:array_loc + (Location.mkloc (Longident.Ldot(Lident "Array", "get")) array_loc) ) - [Nolabel, expr; Nolabel, accessExpr] + [Nolabel, expr; Nolabel, access_expr] in - Parser.eatBreadcrumb p; - parsePrimaryExpr ~operand:e p + Parser.eat_breadcrumb p; + parse_primary_expr ~operand:e p end (* * A primary expression represents @@ -14140,42 +14140,42 @@ end * * The "operand" represents the expression that is operated on *) - and parsePrimaryExpr ~operand ?(noCall=false) p = - let startPos = operand.pexp_loc.loc_start in + and parse_primary_expr ~operand ?(no_call=false) p = + let start_pos = operand.pexp_loc.loc_start in let rec loop p expr = match p.Parser.token with | Dot -> Parser.next p; - let lident = parseValuePath p in + let lident = parse_value_path p in begin match p.Parser.token with - | Equal when noCall = false -> - Parser.leaveBreadcrumb p Grammar.ExprSetField; + | Equal when no_call = false -> + Parser.leave_breadcrumb p Grammar.ExprSetField; Parser.next 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; + 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; setfield | _ -> - let endPos = p.prevEndPos in - let loc = mkLoc startPos endPos in + let end_pos = p.prev_end_pos in + let loc = mk_loc start_pos end_pos in loop p (Ast_helper.Exp.field ~loc expr lident) end - | Lbracket 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 noCall = false && p.prevEndPos.pos_lnum == p.startPos.pos_lnum -> + | 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) + | Backtick when no_call = false && p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> begin match expr.pexp_desc with | Pexp_ident {txt = Longident.Lident ident} -> - parseTemplateExpr ~prefix:ident p + parse_template_expr ~prefix:ident p | _ -> Parser.err - ~startPos:expr.pexp_loc.loc_start - ~endPos:expr.pexp_loc.loc_end + ~start_pos:expr.pexp_loc.loc_start + ~end_pos:expr.pexp_loc.loc_end p (Diagnostics.message "Tagged template literals are currently restricted to identifiers like: json`null`."); - parseTemplateExpr p + parse_template_expr p end | _ -> expr in @@ -14187,54 +14187,54 @@ end * !condition * -. 1.6 *) - and parseUnaryExpr p = - let startPos = p.Parser.startPos in + and parse_unary_expr p = + let start_pos = p.Parser.start_pos in match p.Parser.token with | (Minus | MinusDot | Plus | PlusDot | Bang) as token -> - Parser.leaveBreadcrumb p Grammar.ExprUnary; - let tokenEnd = p.endPos in + Parser.leave_breadcrumb p Grammar.ExprUnary; + let token_end = p.end_pos in Parser.next p; - let operand = parseUnaryExpr p in - let unaryExpr = makeUnaryExpr startPos tokenEnd token operand in - Parser.eatBreadcrumb p; - unaryExpr + 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 | _ -> - parsePrimaryExpr ~operand:(parseAtomicExpr p) p + parse_primary_expr ~operand:(parse_atomic_expr 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 parseOperandExpr ~context p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in + and parse_operand_expr ~context p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in let expr = match p.Parser.token with | Assert -> Parser.next p; - let expr = parseUnaryExpr p in - let loc = mkLoc startPos p.prevEndPos in + let expr = parse_unary_expr p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.assert_ ~loc expr | Lazy -> Parser.next p; - let expr = parseUnaryExpr p in - let loc = mkLoc startPos p.prevEndPos in + let expr = parse_unary_expr p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.lazy_ ~loc expr | Try -> - parseTryExpression p + parse_try_expression p | If -> - parseIfExpression p + parse_if_expression p | For -> - parseForExpression p + parse_for_expression p | While -> - parseWhileExpression p + parse_while_expression p | Switch -> - parseSwitchExpression p + parse_switch_expression p | _ -> if (context != WhenExpr) && - isEs6ArrowExpression ~inTernary:(context=TernaryTrueBranchExpr) p + is_es6_arrow_expression ~in_ternary:(context=TernaryTrueBranchExpr) p then - parseEs6ArrowExpression p + parse_es6_arrow_expression p else - parseUnaryExpr p + parse_unary_expr p in (* let endPos = p.Parser.prevEndPos in *) {expr with @@ -14247,14 +14247,14 @@ end * a + b * f(x) |> g(y) *) - and parseBinaryExpr ?(context=OrdinaryExpr) ?a p prec = + and parse_binary_expr ?(context=OrdinaryExpr) ?a p prec = let a = match a with | Some e -> e - | None -> parseOperandExpr ~context p + | None -> parse_operand_expr ~context p in let rec loop a = let token = p.Parser.token in - let tokenPrec = + let token_prec = match token with (* Can the minus be interpreted as a binary operator? Or is it a unary? * let w = { @@ -14270,21 +14270,21 @@ end * First case is unary, second is a binary operator. * See Scanner.isBinaryOp *) | Minus | MinusDot | LessThan when not ( - Scanner.isBinaryOp p.scanner.src p.startPos.pos_cnum p.endPos.pos_cnum - ) && p.startPos.pos_lnum > p.prevEndPos.pos_lnum -> -1 + 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 -> -1 | token -> Token.precedence token in - if tokenPrec < prec then a + if token_prec < prec then a else begin - Parser.leaveBreadcrumb p (Grammar.ExprBinaryAfterOp token); - let startPos = p.startPos in + Parser.leave_breadcrumb p (Grammar.ExprBinaryAfterOp token); + let start_pos = p.start_pos in Parser.next p; - let endPos = p.prevEndPos in - let b = parseBinaryExpr ~context p (tokenPrec + 1) in - let loc = mkLoc a.Parsetree.pexp_loc.loc_start b.pexp_loc.loc_end in + let end_pos = p.prev_end_pos in + let b = parse_binary_expr ~context p (token_prec + 1) in + let loc = mk_loc a.Parsetree.pexp_loc.loc_start b.pexp_loc.loc_end in let expr = Ast_helper.Exp.apply ~loc - (makeInfixOperator p token startPos endPos) + (make_infix_operator p token start_pos end_pos) [Nolabel, a; Nolabel, b] in loop expr @@ -14325,39 +14325,39 @@ end (* | _ -> false *) (* ) *) - and parseTemplateExpr ?(prefix="") p = - let hiddenOperator = + and parse_template_expr ?(prefix="") p = + let hidden_operator = let op = Location.mknoloc (Longident.Lident "^") in Ast_helper.Exp.ident op in let rec loop acc p = - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in match p.Parser.token with | TemplateTail txt -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in if String.length txt > 0 then - let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in + let txt = if p.mode = ParseForTypeChecker then parse_template_string_literal txt else txt in let str = Ast_helper.Exp.constant ~loc (Pconst_string(txt, Some prefix)) in - Ast_helper.Exp.apply ~loc hiddenOperator + Ast_helper.Exp.apply ~loc hidden_operator [Nolabel, acc; Nolabel, str] else acc | TemplatePart txt -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let expr = parseExprBlock p in - let fullLoc = mkLoc startPos p.prevEndPos in - Scanner.setTemplateMode p.scanner; + let loc = mk_loc start_pos p.prev_end_pos in + let expr = parse_expr_block p in + let full_loc = mk_loc start_pos p.prev_end_pos in + Scanner.set_template_mode p.scanner; Parser.expect Rbrace p; - let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in + let txt = if p.mode = ParseForTypeChecker then parse_template_string_literal txt else txt in let str = Ast_helper.Exp.constant ~loc (Pconst_string(txt, Some prefix)) in let next = let a = if String.length txt > 0 then - Ast_helper.Exp.apply ~loc:fullLoc hiddenOperator [Nolabel, acc; Nolabel, str] + Ast_helper.Exp.apply ~loc:full_loc hidden_operator [Nolabel, acc; Nolabel, str] else acc in - Ast_helper.Exp.apply ~loc:fullLoc hiddenOperator + Ast_helper.Exp.apply ~loc:full_loc hidden_operator [Nolabel, a; Nolabel, expr] in loop next p @@ -14365,27 +14365,27 @@ end Parser.err p (Diagnostics.unexpected token p.breadcrumbs); acc in - Scanner.setTemplateMode p.scanner; + Scanner.set_template_mode p.scanner; Parser.expect Backtick p; - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in match p.Parser.token with | TemplateTail txt -> - let loc = mkLoc startPos p.endPos in + let loc = mk_loc start_pos p.end_pos in Parser.next p; - let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in + let txt = if p.mode = ParseForTypeChecker then parse_template_string_literal txt else txt in Ast_helper.Exp.constant ~loc (Pconst_string(txt, Some prefix)) | TemplatePart txt -> - let constantLoc = mkLoc startPos p.endPos in + let constant_loc = mk_loc start_pos p.end_pos in Parser.next p; - let expr = parseExprBlock p in - let fullLoc = mkLoc startPos p.prevEndPos in - Scanner.setTemplateMode p.scanner; + let expr = parse_expr_block p in + let full_loc = mk_loc start_pos p.prev_end_pos in + Scanner.set_template_mode p.scanner; Parser.expect Rbrace p; - let txt = if p.mode = ParseForTypeChecker then parseTemplateStringLiteral txt else txt in - let str = Ast_helper.Exp.constant ~loc:constantLoc (Pconst_string(txt, Some prefix)) in + let txt = if p.mode = ParseForTypeChecker then parse_template_string_literal txt else txt in + let str = Ast_helper.Exp.constant ~loc:constant_loc (Pconst_string(txt, Some prefix)) in let next = if String.length txt > 0 then - Ast_helper.Exp.apply ~loc:fullLoc hiddenOperator [Nolabel, str; Nolabel, expr] + Ast_helper.Exp.apply ~loc:full_loc hidden_operator [Nolabel, str; Nolabel, expr] else expr in @@ -14403,17 +14403,17 @@ end * * We want to give a nice error message in these cases * *) - and overParseConstrainedOrCoercedOrArrowExpression p expr = + and over_parse_constrained_or_coerced_or_arrow_expression p expr = match p.Parser.token with | ColonGreaterThan -> - parseCoercedExpr ~expr p + parse_coerced_expr ~expr p | Colon -> Parser.next p; - let typ = parseTypExpr ~es6Arrow:false p in + let typ = parse_typ_expr ~es6_arrow:false p in begin match p.Parser.token with | EqualGreater -> Parser.next p; - let body = parseExpr p in + let body = parse_expr p in let pat = match expr.pexp_desc with | Pexp_ident longident -> Ast_helper.Pat.var ~loc:expr.pexp_loc @@ -14425,104 +14425,104 @@ end Ast_helper.Pat.var ~loc:expr.pexp_loc (Location.mkloc "pattern" expr.pexp_loc) in let arrow1 = Ast_helper.Exp.fun_ - ~loc:(mkLoc expr.pexp_loc.loc_start body.pexp_loc.loc_end) + ~loc:(mk_loc 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:(mkLoc expr.pexp_loc.loc_start body.pexp_loc.loc_end) + ~loc:(mk_loc expr.pexp_loc.loc_start body.pexp_loc.loc_end) Asttypes.Nolabel None (Ast_helper.Pat.constraint_ pat typ) body in let msg = - Doc.breakableGroup ~forceBreak:true ( + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.text "Did you mean to annotate the parameter type or the return type?"; Doc.indent ( Doc.concat [ Doc.line; Doc.text "1) "; - Printer.printExpression arrow1 CommentTable.empty; + Printer.print_expression arrow1 CommentTable.empty; Doc.line; Doc.text "2) "; - Printer.printExpression arrow2 CommentTable.empty; + Printer.print_expression arrow2 CommentTable.empty; ] ) ] - ) |> Doc.toString ~width:80 + ) |> Doc.to_string ~width:80 in Parser.err - ~startPos:expr.pexp_loc.loc_start - ~endPos:body.pexp_loc.loc_end + ~start_pos:expr.pexp_loc.loc_start + ~end_pos:body.pexp_loc.loc_end p (Diagnostics.message msg); arrow1 | _ -> let open Parsetree in - let loc = mkLoc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in + let loc = mk_loc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in let expr = Ast_helper.Exp.constraint_ ~loc expr typ in let () = Parser.err - ~startPos:expr.pexp_loc.loc_start - ~endPos:typ.ptyp_loc.loc_end + ~start_pos:expr.pexp_loc.loc_start + ~end_pos:typ.ptyp_loc.loc_end p (Diagnostics.message - (Doc.breakableGroup ~forceBreak:true (Doc.concat [ + (Doc.breakable_group ~force_break:true (Doc.concat [ Doc.text "Expressions with type constraints need to be wrapped in parens:"; Doc.indent ( Doc.concat [ Doc.line; - Printer.addParens (Printer.printExpression expr CommentTable.empty); + Printer.add_parens (Printer.print_expression expr CommentTable.empty); ] ) - ]) |> Doc.toString ~width:80 + ]) |> Doc.to_string ~width:80 )) in expr end | _ -> expr - and parseLetBindingBody ~startPos ~attrs p = - Parser.beginRegion p; - Parser.leaveBreadcrumb p Grammar.LetBinding; + and parse_let_binding_body ~start_pos ~attrs p = + Parser.begin_region p; + Parser.leave_breadcrumb p Grammar.LetBinding; let pat, exp = - let pat = parsePattern p in + let pat = parse_pattern p in match p.Parser.token with | Colon -> Parser.next p; begin match p.token with | Typ -> (* locally abstract types *) Parser.next p; - let newtypes = parseLidentList p in + let newtypes = parse_lident_list p in Parser.expect Dot p; - let typ = parseTypExpr p in + let typ = parse_typ_expr p in Parser.expect Equal p; - let expr = parseExpr p in - let loc = mkLoc startPos p.prevEndPos in - let exp, poly = wrapTypeAnnotation ~loc newtypes typ expr in + 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 pat = Ast_helper.Pat.constraint_ ~loc pat poly in (pat, exp) | _ -> - let polyType = parsePolyTypeExpr p in - let loc = {pat.ppat_loc with loc_end = polyType.Parsetree.ptyp_loc.loc_end} in - let pat = Ast_helper.Pat.constraint_ ~loc pat polyType in + let poly_type = parse_poly_type_expr p in + let loc = {pat.ppat_loc with loc_end = poly_type.Parsetree.ptyp_loc.loc_end} in + let pat = Ast_helper.Pat.constraint_ ~loc pat poly_type in Parser.expect Token.Equal p; - let exp = parseExpr p in - let exp = overParseConstrainedOrCoercedOrArrowExpression p exp in + let exp = parse_expr p in + let exp = over_parse_constrained_or_coerced_or_arrow_expression p exp in (pat, exp) end | _ -> Parser.expect Token.Equal p; - let exp = overParseConstrainedOrCoercedOrArrowExpression p (parseExpr p) in + let exp = over_parse_constrained_or_coerced_or_arrow_expression p (parse_expr p) in (pat, exp) in - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in let vb = Ast_helper.Vb.mk ~loc ~attrs pat exp in - Parser.eatBreadcrumb p; - Parser.endRegion p; + Parser.eat_breadcrumb p; + Parser.end_region p; vb (* TODO: find a better way? Is it possible? @@ -14540,18 +14540,18 @@ end * Here @attr should attach to something "new": `let b = 1` * The parser state is forked, which is quite expensive… *) - and parseAttributesAndBinding (p : Parser.t) = + and parse_attributes_and_binding (p : Parser.t) = let err = p.scanner.err in let ch = p.scanner.ch in let offset = p.scanner.offset in - let rdOffset = p.scanner.rdOffset in - let lineOffset = p.scanner.lineOffset in + let rd_offset = p.scanner.rd_offset in + let line_offset = p.scanner.line_offset in let lnum = p.scanner.lnum in let mode = p.scanner.mode in let token = p.token in - let startPos = p.startPos in - let endPos = p.endPos in - let prevEndPos = p.prevEndPos 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 breadcrumbs = p.breadcrumbs in let errors = p.errors in let diagnostics = p.diagnostics in @@ -14559,7 +14559,7 @@ end match p.Parser.token with | At -> - let attrs = parseAttributes p in + let attrs = parse_attributes p in begin match p.Parser.token with | And -> attrs @@ -14567,14 +14567,14 @@ end p.scanner.err <- err; p.scanner.ch <- ch; p.scanner.offset <- offset; - p.scanner.rdOffset <- rdOffset; - p.scanner.lineOffset <- lineOffset; + p.scanner.rd_offset <- rd_offset; + p.scanner.line_offset <- line_offset; p.scanner.lnum <- lnum; p.scanner.mode <- mode; p.token <- token; - p.startPos <- startPos; - p.endPos <- endPos; - p.prevEndPos <- prevEndPos; + p.start_pos <- start_pos; + p.end_pos <- end_pos; + p.prev_end_pos <- prev_end_pos; p.breadcrumbs <- breadcrumbs; p.errors <- errors; p.diagnostics <- diagnostics; @@ -14584,53 +14584,53 @@ end | _ -> [] (* definition ::= let [rec] let-binding { and let-binding } *) - and parseLetBindings ~attrs p = - let startPos = p.Parser.startPos in + and parse_let_bindings ~attrs p = + let start_pos = p.Parser.start_pos in Parser.optional p Let |> ignore; - let recFlag = if Parser.optional p Token.Rec then + let rec_flag = if Parser.optional p Token.Rec then Asttypes.Recursive else Asttypes.Nonrecursive in - let first = parseLetBindingBody ~startPos ~attrs p in + let first = parse_let_binding_body ~start_pos ~attrs p in let rec loop p bindings = - let startPos = p.Parser.startPos in - let attrs = parseAttributesAndBinding p in + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes_and_binding p in match p.Parser.token with | And -> Parser.next p; let attrs = match p.token with | Export -> - let exportLoc = mkLoc p.startPos p.endPos in + let export_loc = mk_loc p.start_pos p.end_pos in Parser.next p; - let genTypeAttr = (Location.mkloc "genType" exportLoc, Parsetree.PStr []) in - genTypeAttr::attrs + let gen_type_attr = (Location.mkloc "genType" export_loc, Parsetree.PStr []) in + gen_type_attr::attrs | _ -> attrs in ignore(Parser.optional p Let); (* overparse for fault tolerance *) - let letBinding = parseLetBindingBody ~startPos ~attrs p in - loop p (letBinding::bindings) + let let_binding = parse_let_binding_body ~start_pos ~attrs p in + loop p (let_binding::bindings) | _ -> List.rev bindings in - (recFlag, loop p [first]) + (rec_flag, loop p [first]) (* * div -> div * Foo -> Foo.createElement * Foo.Bar -> Foo.Bar.createElement *) - and parseJsxName p = + and parse_jsx_name p = let longident = match p.Parser.token with | Lident ident -> - let identStart = p.startPos in - let identEnd = p.endPos in + let ident_start = p.start_pos in + let ident_end = p.end_pos in Parser.next p; - let loc = mkLoc identStart identEnd in + let loc = mk_loc ident_start ident_end in Location.mkloc (Longident.Lident ident) loc | Uident _ -> - let longident = parseModuleLongIdent ~lowercase:false p in + let longident = parse_module_long_ident ~lowercase:false p in Location.mkloc (Longident.Ldot (longident.txt, "createElement")) longident.loc | _ -> let msg = "A jsx name should start with a lowercase or uppercase identifier, like: div in
or Navbar in " @@ -14640,70 +14640,70 @@ end in Ast_helper.Exp.ident ~loc:longident.loc longident - and parseJsxOpeningOrSelfClosingElement ~startPos p = - let jsxStartPos = p.Parser.startPos in - let name = parseJsxName p in - let jsxProps = parseJsxProps p in + 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 let children = match p.Parser.token with | Forwardslash -> (* *) - let childrenStartPos = p.Parser.startPos in + let children_start_pos = p.Parser.start_pos in Parser.next p; - let childrenEndPos = p.Parser.startPos in + let children_end_pos = p.Parser.start_pos in Parser.expect GreaterThan p; - let loc = mkLoc childrenStartPos childrenEndPos in - makeListExpression loc [] None (* no children *) + let loc = mk_loc children_start_pos children_end_pos in + make_list_expression loc [] None (* no children *) | GreaterThan -> (* bar *) - let childrenStartPos = p.Parser.startPos in - Scanner.setJsxMode p.scanner; + let children_start_pos = p.Parser.start_pos in + Scanner.set_jsx_mode p.scanner; Parser.next p; - let (spread, children) = parseJsxChildren p in - let childrenEndPos = p.Parser.startPos in + let (spread, children) = parse_jsx_children p in + let children_end_pos = p.Parser.start_pos in let () = match p.token with | LessThanSlash -> Parser.next p | LessThan -> Parser.next p; Parser.expect Forwardslash p - | token when Grammar.isStructureItemStart token -> () + | token when Grammar.is_structure_item_start token -> () | _ -> Parser.expect LessThanSlash p in begin match p.Parser.token with - | Lident _ | Uident _ when verifyJsxOpeningClosingName p name -> + | Lident _ | Uident _ when verify_jsx_opening_closing_name p name -> Parser.expect GreaterThan p; - let loc = mkLoc childrenStartPos childrenEndPos in + let loc = mk_loc children_start_pos children_end_pos in ( match spread, children with | true, child :: _ -> child | _ -> - makeListExpression loc children None + make_list_expression loc children None ) | token -> - let () = if Grammar.isStructureItemStart token then ( + let () = if Grammar.is_structure_item_start token then ( let closing = "" in let msg = Diagnostics.message ("Missing " ^ closing) in - Parser.err ~startPos ~endPos:p.prevEndPos p msg; + Parser.err ~start_pos ~end_pos:p.prev_end_pos 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 ~startPos ~endPos:p.prevEndPos p (Diagnostics.message msg); + Parser.err ~start_pos ~end_pos:p.prev_end_pos p (Diagnostics.message msg); Parser.expect GreaterThan p ) in - let loc = mkLoc childrenStartPos childrenEndPos in + let loc = mk_loc children_start_pos children_end_pos in ( match spread, children with | true, child :: _ -> child | _ -> - makeListExpression loc children None + make_list_expression loc children None ) end | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - makeListExpression Location.none [] None + make_list_expression Location.none [] None in - let jsxEndPos = p.prevEndPos in - let loc = mkLoc jsxStartPos jsxEndPos in + let jsx_end_pos = p.prev_end_pos in + let loc = mk_loc jsx_start_pos jsx_end_pos in Ast_helper.Exp.apply ~loc name - (List.concat [jsxProps; [ + (List.concat [jsx_props; [ (Asttypes.Labelled "children", children); (Asttypes.Nolabel, Ast_helper.Exp.construct (Location.mknoloc (Longident.Lident "()")) None) ]]) @@ -14716,35 +14716,35 @@ end * * jsx-children ::= primary-expr* * => 0 or more *) - and parseJsx p = - Parser.leaveBreadcrumb p Grammar.Jsx; - let startPos = p.Parser.startPos in + and parse_jsx p = + Parser.leave_breadcrumb p Grammar.Jsx; + let start_pos = p.Parser.start_pos in Parser.expect LessThan p; - let jsxExpr = match p.Parser.token with + let jsx_expr = match p.Parser.token with | Lident _ | Uident _ -> - parseJsxOpeningOrSelfClosingElement ~startPos p + parse_jsx_opening_or_self_closing_element ~start_pos p | GreaterThan -> (* fragment: <> foo *) - parseJsxFragment p + parse_jsx_fragment p | _ -> - parseJsxName p + parse_jsx_name p in - {jsxExpr with pexp_attributes = [jsxAttr]} + {jsx_expr with pexp_attributes = [jsx_attr]} (* * jsx-fragment ::= * | <> * | <> jsx-children *) - and parseJsxFragment p = - let childrenStartPos = p.Parser.startPos in - Scanner.setJsxMode p.scanner; + and parse_jsx_fragment p = + let children_start_pos = p.Parser.start_pos in + Scanner.set_jsx_mode p.scanner; Parser.expect GreaterThan p; - let (_spread, children) = parseJsxChildren p in - let childrenEndPos = p.Parser.startPos in + let (_spread, children) = parse_jsx_children p in + let children_end_pos = p.Parser.start_pos in Parser.expect LessThanSlash p; Parser.expect GreaterThan p; - let loc = mkLoc childrenStartPos childrenEndPos in - makeListExpression loc children None + let loc = mk_loc children_start_pos children_end_pos in + make_list_expression loc children None (* @@ -14754,18 +14754,18 @@ end * | lident = jsx_expr * | lident = ?jsx_expr *) - and parseJsxProp p = - Parser.leaveBreadcrumb p Grammar.JsxAttribute; + and parse_jsx_prop p = + Parser.leave_breadcrumb p Grammar.JsxAttribute; match p.Parser.token with | Question | Lident _ -> let optional = Parser.optional p Question in - let (name, loc) = parseLident p in - let propLocAttr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in + let (name, loc) = parse_lident p in + let prop_loc_attr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in (* optional punning: *) if optional then Some ( Asttypes.Optional name, - Ast_helper.Exp.ident ~attrs:[propLocAttr] + Ast_helper.Exp.ident ~attrs:[prop_loc_attr] ~loc (Location.mkloc (Longident.Lident name) loc) ) else begin @@ -14774,37 +14774,37 @@ end Parser.next p; (* no punning *) let optional = Parser.optional p Question in - let attrExpr = - let e = parsePrimaryExpr ~operand:(parseAtomicExpr p) p in - {e with pexp_attributes = propLocAttr::e.pexp_attributes} + let attr_expr = + let e = parse_primary_expr ~operand:(parse_atomic_expr p) p in + {e with pexp_attributes = prop_loc_attr::e.pexp_attributes} in let label = if optional then Asttypes.Optional name else Asttypes.Labelled name in - Some (label, attrExpr) + Some (label, attr_expr) | _ -> - let attrExpr = - Ast_helper.Exp.ident ~loc ~attrs:[propLocAttr] + let attr_expr = + Ast_helper.Exp.ident ~loc ~attrs:[prop_loc_attr] (Location.mknoloc (Longident.Lident name)) in let label = if optional then Asttypes.Optional name else Asttypes.Labelled name in - Some (label, attrExpr) + Some (label, attr_expr) end | _ -> None - and parseJsxProps p = - parseRegion + and parse_jsx_props p = + parse_region ~grammar:Grammar.JsxAttribute - ~f:parseJsxProp + ~f:parse_jsx_prop p - and parseJsxChildren p = + and parse_jsx_children p = let rec loop p children = match p.Parser.token with | Token.Eof | LessThanSlash -> - Scanner.popMode p.scanner Jsx; + Scanner.pop_mode p.scanner Jsx; List.rev children | LessThan -> (* Imagine:
< @@ -14812,288 +14812,288 @@ end * 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.reconsiderLessThan p.scanner in + let token = Scanner.reconsider_less_than p.scanner in if token = LessThan then - let child = parsePrimaryExpr ~operand:(parseAtomicExpr p) ~noCall:true p in + let child = parse_primary_expr ~operand:(parse_atomic_expr p) ~no_call:true p in loop p (child::children) else (* LessThanSlash *) let () = p.token <- token in - let () = Scanner.popMode p.scanner Jsx in + let () = Scanner.pop_mode p.scanner Jsx in List.rev children - | token when Grammar.isJsxChildStart token -> - let () = Scanner.popMode p.scanner Jsx in - let child = parsePrimaryExpr ~operand:(parseAtomicExpr p) ~noCall:true p in + | token when Grammar.is_jsx_child_start token -> + let () = Scanner.pop_mode p.scanner Jsx in + let child = parse_primary_expr ~operand:(parse_atomic_expr p) ~no_call:true p in loop p (child::children) | _ -> - Scanner.popMode p.scanner Jsx; + Scanner.pop_mode p.scanner Jsx; List.rev children in match p.Parser.token with | DotDotDot -> Parser.next p; - (true, [parsePrimaryExpr ~operand:(parseAtomicExpr p) ~noCall:true p]) + (true, [parse_primary_expr ~operand:(parse_atomic_expr p) ~no_call:true p]) | _ -> (false, loop p []) - and parseBracedOrRecordExpr p = - let startPos = p.Parser.startPos in + and parse_braced_or_record_expr p = + let start_pos = p.Parser.start_pos in Parser.expect Lbrace p; match p.Parser.token with | Rbrace -> Parser.err p (Diagnostics.unexpected Rbrace p.breadcrumbs); Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in Ast_helper.Exp.construct ~attrs:[braces] ~loc (Location.mkloc (Longident.Lident "()") loc) None | DotDotDot -> (* beginning of record spread, parse record *) Parser.next p; - let spreadExpr = parseConstrainedOrCoercedExpr p in + let spread_expr = parse_constrained_or_coerced_expr p in Parser.expect Comma p; - let expr = parseRecordExpr ~startPos ~spread:(Some spreadExpr) [] p in + let expr = parse_record_expr ~start_pos ~spread:(Some spread_expr) [] p in Parser.expect Rbrace p; expr | String s -> let field = - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Location.mkloc (Longident.Lident s) loc in begin match p.Parser.token with | Colon -> Parser.next p; - let fieldExpr = parseExpr p in + let field_expr = parse_expr p in Parser.optional p Comma |> ignore; - let expr = parseRecordExprWithStringKeys ~startPos (field, fieldExpr) p in + let expr = parse_record_expr_with_string_keys ~start_pos (field, field_expr) p in Parser.expect Rbrace p; expr | _ -> let constant = Ast_helper.Exp.constant ~loc:field.loc (Parsetree.Pconst_string(s, None)) in - let a = parsePrimaryExpr ~operand:constant p in - let e = parseBinaryExpr ~a p 1 in - let e = parseTernaryExpr e p 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 begin match p.Parser.token with | Semicolon -> Parser.next p; - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces::expr.pexp_attributes} | Rbrace -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {e with pexp_attributes = braces::e.pexp_attributes} | _ -> - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces::expr.pexp_attributes} end end | Uident _ | Lident _ -> - let valueOrConstructor = parseValueOrConstructor p in - begin match valueOrConstructor.pexp_desc with - | Pexp_ident pathIdent -> - let identEndPos = p.prevEndPos in + let value_or_constructor = parse_value_or_constructor p in + begin match value_or_constructor.pexp_desc with + | Pexp_ident path_ident -> + let ident_end_pos = p.prev_end_pos in begin match p.Parser.token with | Comma -> Parser.next p; - let expr = parseRecordExpr ~startPos [(pathIdent, valueOrConstructor)] p in + let expr = parse_record_expr ~start_pos [(path_ident, value_or_constructor)] p in Parser.expect Rbrace p; expr | Colon -> Parser.next p; - let fieldExpr = parseExpr p in + let field_expr = parse_expr p in begin match p.token with | Rbrace -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Exp.record ~loc [(pathIdent, fieldExpr)] None + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Exp.record ~loc [(path_ident, field_expr)] None | _ -> Parser.expect Comma p; - let expr = parseRecordExpr ~startPos [(pathIdent, fieldExpr)] p in + let expr = parse_record_expr ~start_pos [(path_ident, field_expr)] p in Parser.expect Rbrace p; expr end (* error case *) | Lident _ -> - if p.prevEndPos.pos_lnum < p.startPos.pos_lnum then ( + if p.prev_end_pos.pos_lnum < p.start_pos.pos_lnum then ( Parser.expect Comma p; - let expr = parseRecordExpr ~startPos [(pathIdent, valueOrConstructor)] p in + let expr = parse_record_expr ~start_pos [(path_ident, value_or_constructor)] p in Parser.expect Rbrace p; expr ) else ( Parser.expect Colon p; - let expr = parseRecordExpr ~startPos [(pathIdent, valueOrConstructor)] p in + let expr = parse_record_expr ~start_pos [(path_ident, value_or_constructor)] p in Parser.expect Rbrace p; expr ) | Semicolon -> Parser.next p; - let expr = parseExprBlock ~first:(Ast_helper.Exp.ident pathIdent) p in + let expr = parse_expr_block ~first:(Ast_helper.Exp.ident path_ident) p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces::expr.pexp_attributes} | Rbrace -> Parser.next p; - let expr = Ast_helper.Exp.ident ~loc:pathIdent.loc pathIdent in - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + 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 {expr with pexp_attributes = braces::expr.pexp_attributes} | EqualGreater -> - let loc = mkLoc startPos identEndPos in - let ident = Location.mkloc (Longident.last pathIdent.txt) loc in - let a = parseEs6ArrowExpression + let loc = mk_loc start_pos ident_end_pos in + let ident = Location.mkloc (Longident.last path_ident.txt) loc in + let a = parse_es6_arrow_expression ~parameters:[TermParameter { uncurried = false; attrs = []; label = Asttypes.Nolabel; expr = None; pat = Ast_helper.Pat.var ident; - pos = startPos; + pos = start_pos; }] p in - let e = parseBinaryExpr ~a p 1 in - let e = parseTernaryExpr e p in + let e = parse_binary_expr ~a p 1 in + let e = parse_ternary_expr e p in begin match p.Parser.token with | Semicolon -> Parser.next p; - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces::expr.pexp_attributes} | Rbrace -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {e with pexp_attributes = braces::e.pexp_attributes} | _ -> - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces::expr.pexp_attributes} end | _ -> - Parser.leaveBreadcrumb p Grammar.ExprBlock; - let a = parsePrimaryExpr ~operand:(Ast_helper.Exp.ident ~loc:pathIdent.loc pathIdent) p in - let e = parseBinaryExpr ~a p 1 in - let e = parseTernaryExpr e p in - Parser.eatBreadcrumb p; + Parser.leave_breadcrumb p Grammar.ExprBlock; + let a = parse_primary_expr ~operand:(Ast_helper.Exp.ident ~loc:path_ident.loc path_ident) p in + let e = parse_binary_expr ~a p 1 in + let e = parse_ternary_expr e p in + Parser.eat_breadcrumb p; begin match p.Parser.token with | Semicolon -> Parser.next p; - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces::expr.pexp_attributes} | Rbrace -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {e with pexp_attributes = braces::e.pexp_attributes} | _ -> - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces::expr.pexp_attributes} end end | _ -> - 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; + 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; begin match p.Parser.token with | Semicolon -> Parser.next p; - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces::expr.pexp_attributes} | Rbrace -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {e with pexp_attributes = braces::e.pexp_attributes} | _ -> - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces::expr.pexp_attributes} end end | _ -> - let expr = parseExprBlock p in + let expr = parse_expr_block p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces::expr.pexp_attributes} - and parseRecordRowWithStringKey p = + and parse_record_row_with_string_key p = match p.Parser.token with | String s -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; let field = Location.mkloc (Longident.Lident s) loc in begin match p.Parser.token with | Colon -> Parser.next p; - let fieldExpr = parseExpr p in - Some (field, fieldExpr) + let field_expr = parse_expr p in + Some (field, field_expr) | _ -> Some (field, Ast_helper.Exp.ident ~loc:field.loc field) end | _ -> None - and parseRecordRow p = + and parse_record_row p = let () = match p.Parser.token with | Token.DotDotDot -> - Parser.err p (Diagnostics.message ErrorMessages.recordExprSpread); + Parser.err p (Diagnostics.message ErrorMessages.record_expr_spread); Parser.next p; | _ -> () in match p.Parser.token with | Lident _ | Uident _ | List -> - let field = parseValuePath p in + let field = parse_value_path p in begin match p.Parser.token with | Colon -> Parser.next p; - let fieldExpr = parseExpr p in - Some (field, fieldExpr) + let field_expr = parse_expr p in + Some (field, field_expr) | _ -> Some (field, Ast_helper.Exp.ident ~loc:field.loc field) end | _ -> None - and parseRecordExprWithStringKeys ~startPos firstRow p = - let rows = firstRow::( - parseCommaDelimitedRegion ~grammar:Grammar.RecordRowsStringKey ~closing:Rbrace ~f:parseRecordRowWithStringKey p + and parse_record_expr_with_string_keys ~start_pos first_row p = + let rows = first_row::( + parse_comma_delimited_region ~grammar:Grammar.RecordRowsStringKey ~closing:Rbrace ~f:parse_record_row_with_string_key p ) in - let loc = mkLoc startPos p.endPos in - let recordStrExpr = Ast_helper.Str.eval ~loc ( + let loc = mk_loc start_pos p.end_pos in + let record_str_expr = Ast_helper.Str.eval ~loc ( Ast_helper.Exp.record ~loc rows None ) in Ast_helper.Exp.extension ~loc - (Location.mkloc "obj" loc, Parsetree.PStr [recordStrExpr]) + (Location.mkloc "obj" loc, Parsetree.PStr [record_str_expr]) - and parseRecordExpr ~startPos ?(spread=None) rows p = + and parse_record_expr ~start_pos ?(spread=None) rows p = let exprs = - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.RecordRows ~closing:Rbrace - ~f:parseRecordRow p + ~f:parse_record_row p in let rows = List.concat [rows; exprs] in let () = match rows with @@ -15102,73 +15102,73 @@ end Parser.err p (Diagnostics.message msg); | _rows -> () in - let loc = mkLoc startPos p.endPos in + let loc = mk_loc start_pos p.end_pos in Ast_helper.Exp.record ~loc rows spread - and parseExprBlockItem p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in + and parse_expr_block_item p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in match p.Parser.token with | Module -> Parser.next p; begin match p.token with | Lparen -> - parseFirstClassModuleExpr ~startPos p + parse_first_class_module_expr ~start_pos p | _ -> let name = match p.Parser.token with | Uident ident -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Location.mkloc ident loc | t -> Parser.err p (Diagnostics.uident t); Location.mknoloc "_" in - let body = parseModuleBindingBody p in + let body = parse_module_binding_body p in Parser.optional p Semicolon |> ignore; - let expr = parseExprBlock p in - let loc = mkLoc startPos p.prevEndPos in + let expr = parse_expr_block p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.letmodule ~loc name body expr end | Exception -> - let extensionConstructor = parseExceptionDef ~attrs p in + let extension_constructor = parse_exception_def ~attrs p in Parser.optional p Semicolon |> ignore; - let blockExpr = parseExprBlock p in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Exp.letexception ~loc extensionConstructor blockExpr + 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 | Open -> - let od = parseOpenDescription ~attrs p in + let od = parse_open_description ~attrs p in Parser.optional p Semicolon |> ignore; - 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 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 -> - let (recFlag, letBindings) = parseLetBindings ~attrs p in + let (rec_flag, let_bindings) = parse_let_bindings ~attrs p in let next = match p.Parser.token with | Semicolon -> Parser.next p; - if Grammar.isBlockExprStart p.Parser.token then - parseExprBlock p + if Grammar.is_block_expr_start p.Parser.token then + parse_expr_block p else - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None - | token when Grammar.isBlockExprStart token -> - parseExprBlock p + | token when Grammar.is_block_expr_start token -> + parse_expr_block p | _ -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Exp.let_ ~loc recFlag letBindings next + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Exp.let_ ~loc rec_flag let_bindings next | _ -> let e1 = - let expr = parseExpr p in + let expr = parse_expr p in {expr with pexp_attributes = List.concat [attrs; expr.pexp_attributes]} in ignore (Parser.optional p Semicolon); - if Grammar.isBlockExprStart p.Parser.token then - let e2 = parseExprBlock p in + if Grammar.is_block_expr_start p.Parser.token then + let e2 = parse_expr_block 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 @@ -15186,87 +15186,87 @@ end * note: semi should be made optional * a block of expression is always *) - and parseExprBlock ?first p = - Parser.leaveBreadcrumb p Grammar.ExprBlock; + and parse_expr_block ?first p = + Parser.leave_breadcrumb p Grammar.ExprBlock; let item = match first with | Some e -> e - | None -> parseExprBlockItem p + | None -> parse_expr_block_item p in - let blockExpr = match p.Parser.token with + let block_expr = match p.Parser.token with | Semicolon -> Parser.next p; - if Grammar.isBlockExprStart p.Parser.token then - let next = parseExprBlockItem p in + if Grammar.is_block_expr_start p.Parser.token then + let next = parse_expr_block_item p in ignore(Parser.optional p Semicolon); let loc = {item.pexp_loc with loc_end = next.pexp_loc.loc_end} in Ast_helper.Exp.sequence ~loc item next else item - | token when Grammar.isBlockExprStart token -> - let next = parseExprBlockItem p in + | token when Grammar.is_block_expr_start token -> + let next = parse_expr_block_item p in ignore(Parser.optional p Semicolon); let loc = {item.pexp_loc with loc_end = next.pexp_loc.loc_end} in Ast_helper.Exp.sequence ~loc item next | _ -> item in - Parser.eatBreadcrumb p; - overParseConstrainedOrCoercedOrArrowExpression p blockExpr + Parser.eat_breadcrumb p; + over_parse_constrained_or_coerced_or_arrow_expression p block_expr - and parseTryExpression p = - let startPos = p.Parser.startPos in + and parse_try_expression p = + let start_pos = p.Parser.start_pos in Parser.expect Try p; - let expr = parseExpr ~context:WhenExpr p in + let expr = parse_expr ~context:WhenExpr p in Parser.expect Catch p; Parser.expect Lbrace p; - let cases = parsePatternMatching p in + let cases = parse_pattern_matching p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.try_ ~loc expr cases - and parseIfExpression p = - Parser.beginRegion p; - Parser.leaveBreadcrumb p Grammar.ExprIf; - let startPos = p.Parser.startPos in + and parse_if_expression p = + Parser.begin_region p; + Parser.leave_breadcrumb p Grammar.ExprIf; + let start_pos = p.Parser.start_pos in Parser.expect If p; - Parser.leaveBreadcrumb p Grammar.IfCondition; + Parser.leave_breadcrumb p Grammar.IfCondition; (* doesn't make sense to try es6 arrow here? *) - let conditionExpr = parseExpr ~context:WhenExpr p in - Parser.eatBreadcrumb p; - Parser.leaveBreadcrumb p IfBranch; + let condition_expr = parse_expr ~context:WhenExpr p in + Parser.eat_breadcrumb p; + Parser.leave_breadcrumb p IfBranch; Parser.expect Lbrace p; - let thenExpr = parseExprBlock p in + let then_expr = parse_expr_block p in Parser.expect Rbrace p; - Parser.eatBreadcrumb p; - let elseExpr = match p.Parser.token with + Parser.eat_breadcrumb p; + let else_expr = match p.Parser.token with | Else -> - Parser.endRegion p; - Parser.leaveBreadcrumb p Grammar.ElseBranch; + Parser.end_region p; + Parser.leave_breadcrumb p Grammar.ElseBranch; Parser.next p; - Parser.beginRegion p; - let elseExpr = match p.token with + Parser.begin_region p; + let else_expr = match p.token with | If -> - parseIfExpression p + parse_if_expression p | _ -> Parser.expect Lbrace p; - let blockExpr = parseExprBlock p in + let block_expr = parse_expr_block p in Parser.expect Rbrace p; - blockExpr + block_expr in - Parser.eatBreadcrumb p; - Parser.endRegion p; - Some elseExpr + Parser.eat_breadcrumb p; + Parser.end_region p; + Some else_expr | _ -> - Parser.endRegion p; + Parser.end_region p; None in - let loc = mkLoc startPos p.prevEndPos in - Parser.eatBreadcrumb p; - Ast_helper.Exp.ifthenelse ~loc conditionExpr thenExpr elseExpr + let loc = mk_loc start_pos p.prev_end_pos in + Parser.eat_breadcrumb p; + Ast_helper.Exp.ifthenelse ~loc condition_expr then_expr else_expr - and parseForRest hasOpeningParen pattern startPos p = + and parse_for_rest has_opening_paren pattern start_pos p = Parser.expect In p; - let e1 = parseExpr p in + let e1 = parse_expr p in let direction = match p.Parser.token with | To -> Asttypes.Upto | Downto -> Asttypes.Downto @@ -15275,109 +15275,109 @@ end Asttypes.Upto in Parser.next p; - let e2 = parseExpr ~context:WhenExpr p in - if hasOpeningParen then Parser.expect Rparen p; + let e2 = parse_expr ~context:WhenExpr p in + if has_opening_paren then Parser.expect Rparen p; Parser.expect Lbrace p; - let bodyExpr = parseExprBlock p in + let body_expr = parse_expr_block p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Exp.for_ ~loc pattern e1 e2 direction bodyExpr + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Exp.for_ ~loc pattern e1 e2 direction body_expr - and parseForExpression p = - let startPos = p.Parser.startPos in + and parse_for_expression p = + let start_pos = p.Parser.start_pos in Parser.expect For p; match p.token with | Lparen -> - let lparen = p.startPos in + let lparen = p.start_pos in Parser.next p; begin match p.token with | Rparen -> Parser.next p; - let unitPattern = - let loc = mkLoc lparen p.prevEndPos in + let unit_pattern = + let loc = mk_loc lparen p.prev_end_pos in let lid = Location.mkloc (Longident.Lident "()") loc in Ast_helper.Pat.construct lid None in - parseForRest false (parseAliasPattern ~attrs:[] unitPattern p) startPos p + parse_for_rest false (parse_alias_pattern ~attrs:[] unit_pattern p) start_pos p | _ -> - let pat = parsePattern p in + let pat = parse_pattern p in begin match p.token with | Comma -> Parser.next p; - let tuplePattern = - parseTuplePattern ~attrs:[] ~startPos:lparen ~first:pat p + let tuple_pattern = + parse_tuple_pattern ~attrs:[] ~start_pos:lparen ~first:pat p in - let pattern = parseAliasPattern ~attrs:[] tuplePattern p in - parseForRest false pattern startPos p + let pattern = parse_alias_pattern ~attrs:[] tuple_pattern p in + parse_for_rest false pattern start_pos p | _ -> - parseForRest true pat startPos p + parse_for_rest true pat start_pos p end end | _ -> - parseForRest false (parsePattern p) startPos p + parse_for_rest false (parse_pattern p) start_pos p - and parseWhileExpression p = - let startPos = p.Parser.startPos in + and parse_while_expression p = + let start_pos = p.Parser.start_pos in Parser.expect While p; - let expr1 = parseExpr ~context:WhenExpr p in + let expr1 = parse_expr ~context:WhenExpr p in Parser.expect Lbrace p; - let expr2 = parseExprBlock p in + let expr2 = parse_expr_block p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.while_ ~loc expr1 expr2 - and parsePatternMatchCase p = - Parser.beginRegion p; - Parser.leaveBreadcrumb p Grammar.PatternMatchCase; + and parse_pattern_match_case p = + Parser.begin_region p; + Parser.leave_breadcrumb p Grammar.PatternMatchCase; match p.Parser.token with | Token.Bar -> Parser.next p; - let lhs = parsePattern p in + let lhs = parse_pattern p in let guard = match p.Parser.token with | When -> Parser.next p; - Some (parseExpr ~context:WhenExpr p) + Some (parse_expr ~context:WhenExpr p) | _ -> None in let () = match p.token with | EqualGreater -> Parser.next p - | _ -> Recover.recoverEqualGreater p + | _ -> Recover.recover_equal_greater p in - let rhs = parseExprBlock p in - Parser.endRegion p; - Parser.eatBreadcrumb p; + let rhs = parse_expr_block p in + Parser.end_region p; + Parser.eat_breadcrumb p; Some (Ast_helper.Exp.case lhs ?guard rhs) | _ -> - Parser.endRegion p; + Parser.end_region p; None - and parsePatternMatching p = - Parser.leaveBreadcrumb p Grammar.PatternMatching; + and parse_pattern_matching p = + Parser.leave_breadcrumb p Grammar.PatternMatching; let cases = - parseDelimitedRegion + parse_delimited_region ~grammar:Grammar.PatternMatching ~closing:Rbrace - ~f:parsePatternMatchCase + ~f:parse_pattern_match_case p in let () = match cases with - | [] -> Parser.err ~startPos:p.prevEndPos p ( + | [] -> Parser.err ~start_pos:p.prev_end_pos p ( Diagnostics.message "Pattern matching needs at least one case" ) | _ -> () in cases - and parseSwitchExpression p = - let startPos = p.Parser.startPos in + and parse_switch_expression p = + let start_pos = p.Parser.start_pos in Parser.expect Switch p; - let switchExpr = parseExpr ~context:WhenExpr p in + let switch_expr = parse_expr ~context:WhenExpr p in Parser.expect Lbrace p; - let cases = parsePatternMatching p in + let cases = parse_pattern_matching p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Exp.match_ ~loc switchExpr cases + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Exp.match_ ~loc switch_expr cases (* * argument ::= @@ -15397,39 +15397,39 @@ end * uncurried_argument ::= * | . argument *) - and parseArgument p = + and parse_argument p = if ( p.Parser.token = Token.Tilde || p.token = Dot || p.token = Underscore || - Grammar.isExprStart p.token + Grammar.is_expr_start p.token ) then ( match p.Parser.token with | Dot -> let uncurried = true in - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in Parser.next(p); begin match p.token with (* apply(.) *) | Rparen -> - let loc = mkLoc startPos p.prevEndPos in - let unitExpr = Ast_helper.Exp.construct ~loc + let loc = mk_loc start_pos p.prev_end_pos in + let unit_expr = Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None in - Some (uncurried, Asttypes.Nolabel, unitExpr) + Some (uncurried, Asttypes.Nolabel, unit_expr) | _ -> - parseArgument2 p ~uncurried + parse_argument2 p ~uncurried end | _ -> - parseArgument2 p ~uncurried:false + parse_argument2 p ~uncurried:false ) else None - and parseArgument2 p ~uncurried = + and parse_argument2 p ~uncurried = match p.Parser.token with (* foo(_), do not confuse with foo(_ => x), TODO: performance *) - | Underscore when not (isEs6ArrowExpression ~inTernary:false p) -> - let loc = mkLoc p.startPos p.endPos in + | Underscore when not (is_es6_arrow_expression ~in_ternary:false p) -> + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; let exp = Ast_helper.Exp.ident ~loc ( Location.mkloc (Longident.Lident "_") loc @@ -15440,18 +15440,18 @@ end (* TODO: nesting of pattern matches not intuitive for error recovery *) begin match p.Parser.token with | Lident ident -> - let startPos = p.startPos in + let start_pos = p.start_pos in Parser.next p; - let endPos = p.prevEndPos in - let loc = mkLoc startPos endPos in - let propLocAttr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in - let identExpr = Ast_helper.Exp.ident ~attrs:[propLocAttr] ~loc ( + let end_pos = p.prev_end_pos in + let loc = mk_loc start_pos end_pos in + let prop_loc_attr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in + let ident_expr = Ast_helper.Exp.ident ~attrs:[prop_loc_attr] ~loc ( Location.mkloc (Longident.Lident ident) loc ) in begin match p.Parser.token with | Question -> Parser.next p; - Some (uncurried, Asttypes.Optional ident, identExpr) + Some (uncurried, Asttypes.Optional ident, ident_expr) | Equal -> Parser.next p; let label = match p.Parser.token with @@ -15462,46 +15462,46 @@ end Labelled ident in let expr = match p.Parser.token with - | Underscore when not (isEs6ArrowExpression ~inTernary:false p) -> - let loc = mkLoc p.startPos p.endPos in + | Underscore when not (is_es6_arrow_expression ~in_ternary:false p) -> + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Ast_helper.Exp.ident ~loc ( Location.mkloc (Longident.Lident "_") loc ) | _ -> - let expr = parseConstrainedOrCoercedExpr p in - {expr with pexp_attributes = propLocAttr::expr.pexp_attributes} + let expr = parse_constrained_or_coerced_expr p in + {expr with pexp_attributes = prop_loc_attr::expr.pexp_attributes} in Some (uncurried, label, expr) | Colon -> Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc startPos p.prevEndPos in - let expr = Ast_helper.Exp.constraint_ ~attrs:[propLocAttr] ~loc identExpr typ in + let typ = parse_typ_expr p in + let loc = mk_loc start_pos p.prev_end_pos in + let expr = Ast_helper.Exp.constraint_ ~attrs:[prop_loc_attr] ~loc ident_expr typ in Some (uncurried, Labelled ident, expr) | _ -> - Some (uncurried, Labelled ident, identExpr) + Some (uncurried, Labelled ident, ident_expr) end | t -> Parser.err p (Diagnostics.lident t); - Some (uncurried, Nolabel, Recover.defaultExpr ()) + Some (uncurried, Nolabel, Recover.default_expr ()) end - | _ -> Some (uncurried, Nolabel, parseConstrainedOrCoercedExpr p) + | _ -> Some (uncurried, Nolabel, parse_constrained_or_coerced_expr p) - and parseCallExpr p funExpr = + and parse_call_expr p fun_expr = Parser.expect Lparen p; - let startPos = p.Parser.startPos in - Parser.leaveBreadcrumb p Grammar.ExprCall; + let start_pos = p.Parser.start_pos in + Parser.leave_breadcrumb p Grammar.ExprCall; let args = - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.ArgumentList ~closing:Rparen - ~f:parseArgument p + ~f:parse_argument p in Parser.expect Rparen p; let args = match args with | [] -> - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in (* No args -> unit sugar: `foo()` *) [ false, Asttypes.Nolabel, @@ -15510,7 +15510,7 @@ end ] | args -> args in - let loc = {funExpr.pexp_loc with loc_end = p.prevEndPos} in + let loc = {fun_expr.pexp_loc with loc_end = p.prev_end_pos} in let args = match args with | (u, lbl, expr)::args -> let group (grp, acc) (uncurried, lbl, expr) = @@ -15524,41 +15524,41 @@ end List.rev ((_u, (List.rev grp))::acc) | [] -> [] in - let apply = List.fold_left (fun callBody group -> + let apply = List.fold_left (fun call_body group -> let (uncurried, args) = group in - let (args, wrap) = processUnderscoreApplication args in + let (args, wrap) = process_underscore_application args in let exp = if uncurried then - let attrs = [uncurryAttr] in - Ast_helper.Exp.apply ~loc ~attrs callBody args + let attrs = [uncurry_attr] in + Ast_helper.Exp.apply ~loc ~attrs call_body args else - Ast_helper.Exp.apply ~loc callBody args + Ast_helper.Exp.apply ~loc call_body args in wrap exp - ) funExpr args + ) fun_expr args in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; apply - and parseValueOrConstructor p = - let startPos = p.Parser.startPos in + and parse_value_or_constructor p = + let start_pos = p.Parser.start_pos in let rec aux p acc = match p.Parser.token with | Uident ident -> - let endPosLident = p.endPos in + let end_pos_lident = p.end_pos in Parser.next p; begin match p.Parser.token with | Dot -> Parser.next p; aux p (ident::acc) - | 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 + | 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 let tail = match args with | [] -> None | [{Parsetree.pexp_desc = Pexp_tuple _} as arg] as args -> - let loc = mkLoc lparen rparen in + let loc = mk_loc lparen rparen in if p.mode = ParseForTypeChecker then (* Some(1, 2) for type-checker *) Some arg @@ -15568,43 +15568,43 @@ end | [arg] -> Some arg | args -> - let loc = mkLoc lparen rparen in + let loc = mk_loc lparen rparen in Some (Ast_helper.Exp.tuple ~loc args) in - 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 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 lident = buildLongident (ident::acc) in + let loc = mk_loc start_pos p.prev_end_pos in + let lident = build_longident (ident::acc) in Ast_helper.Exp.construct ~loc (Location.mkloc lident loc) None end | Lident ident -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let lident = buildLongident (ident::acc) in + let loc = mk_loc start_pos p.prev_end_pos in + let lident = build_longident (ident::acc) in Ast_helper.Exp.ident ~loc (Location.mkloc lident loc) | List -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let lident = buildLongident ("list"::acc) in + let loc = mk_loc start_pos p.prev_end_pos in + let lident = build_longident ("list"::acc) in Ast_helper.Exp.ident ~loc (Location.mkloc lident loc) | token -> Parser.next p; Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Recover.defaultExpr() + Recover.default_expr() in aux p [] - and parsePolyVariantExpr p = - let startPos = p.startPos in - let (ident, _loc) = parseHashIdent ~startPos p in + and parse_poly_variant_expr p = + let start_pos = p.start_pos in + let (ident, _loc) = parse_hash_ident ~start_pos p in begin match p.Parser.token with - | 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 + | 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 let tail = match args with | [] -> None | [{Parsetree.pexp_desc = Pexp_tuple _} as expr ] as args -> @@ -15619,71 +15619,71 @@ end (* #a((1, 2)) for printer *) Some (Ast_helper.Exp.tuple ~loc:loc_paren args) in - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.variant ~loc ident tail | _ -> - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.variant ~loc ident None end - and parseConstructorArgs p = - let lparen = p.Parser.startPos in + and parse_constructor_args p = + let lparen = p.Parser.start_pos in Parser.expect Lparen p; let args = - parseCommaDelimitedRegion - ~grammar:Grammar.ExprList ~f:parseConstrainedExprRegion ~closing:Rparen p + parse_comma_delimited_region + ~grammar:Grammar.ExprList ~f:parse_constrained_expr_region ~closing:Rparen p in Parser.expect Rparen p; match args with | [] -> - let loc = mkLoc lparen p.prevEndPos in + let loc = mk_loc lparen p.prev_end_pos in [Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None] | args -> args - and parseTupleExpr ~first ~startPos p = + and parse_tuple_expr ~first ~start_pos p = let exprs = - parseCommaDelimitedRegion - p ~grammar:Grammar.ExprList ~closing:Rparen ~f:parseConstrainedExprRegion + parse_comma_delimited_region + p ~grammar:Grammar.ExprList ~closing:Rparen ~f:parse_constrained_expr_region in Parser.expect Rparen p; - Ast_helper.Exp.tuple ~loc:(mkLoc startPos p.prevEndPos) (first::exprs) + Ast_helper.Exp.tuple ~loc:(mk_loc start_pos p.prev_end_pos) (first::exprs) - and parseSpreadExprRegion p = + and parse_spread_expr_region p = match p.Parser.token with | DotDotDot -> Parser.next p; - let expr = parseConstrainedOrCoercedExpr p in + let expr = parse_constrained_or_coerced_expr p in Some (true, expr) - | token when Grammar.isExprStart token -> - Some (false, parseConstrainedOrCoercedExpr p) + | token when Grammar.is_expr_start token -> + Some (false, parse_constrained_or_coerced_expr p) | _ -> None - and parseListExpr ~startPos p = + and parse_list_expr ~start_pos p = Parser.expect Lbracket p; - let listExprs = - parseCommaDelimitedReversedList - p ~grammar:Grammar.ListExpr ~closing:Rbracket ~f:parseSpreadExprRegion + let list_exprs = + parse_comma_delimited_reversed_list + p ~grammar:Grammar.ListExpr ~closing:Rbracket ~f:parse_spread_expr_region in Parser.expect Rbracket p; - let loc = mkLoc startPos p.prevEndPos in - match listExprs with + let loc = mk_loc start_pos p.prev_end_pos in + match list_exprs with | (true, expr)::exprs -> let exprs = exprs |> List.map snd |> List.rev in - makeListExpression loc exprs (Some expr) + make_list_expression loc exprs (Some expr) | exprs -> let exprs = exprs |> List.map (fun (spread, expr) -> if spread then - Parser.err p (Diagnostics.message ErrorMessages.listExprSpread); + Parser.err p (Diagnostics.message ErrorMessages.list_expr_spread); expr) |> List.rev in - makeListExpression loc exprs None + make_list_expression loc exprs None (* Overparse ... and give a nice error message *) - and parseNonSpreadExp ~msg p = + and parse_non_spread_exp ~msg p = let () = match p.Parser.token with | DotDotDot -> Parser.err p (Diagnostics.message msg); @@ -15691,72 +15691,72 @@ end | _ -> () in match p.Parser.token with - | token when Grammar.isExprStart token -> - let expr = parseExpr p in + | token when Grammar.is_expr_start token -> + let expr = parse_expr p in begin match p.Parser.token with | Colon -> Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in + let typ = parse_typ_expr p in + let loc = mk_loc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in Some (Ast_helper.Exp.constraint_ ~loc expr typ) | _ -> Some expr end | _ -> None - and parseArrayExp p = - let startPos = p.Parser.startPos in + and parse_array_exp p = + let start_pos = p.Parser.start_pos in Parser.expect Lbracket p; let exprs = - parseCommaDelimitedRegion + parse_comma_delimited_region p ~grammar:Grammar.ExprList ~closing:Rbracket - ~f:(parseNonSpreadExp ~msg:ErrorMessages.arrayExprSpread) + ~f:(parse_non_spread_exp ~msg:ErrorMessages.array_expr_spread) in Parser.expect Rbracket p; - Ast_helper.Exp.array ~loc:(mkLoc startPos p.prevEndPos) exprs + Ast_helper.Exp.array ~loc:(mk_loc start_pos p.prev_end_pos) exprs (* TODO: check attributes in the case of poly type vars, * might be context dependend: parseFieldDeclaration (see ocaml) *) - and parsePolyTypeExpr p = - let startPos = p.Parser.startPos in + and parse_poly_type_expr p = + let start_pos = p.Parser.start_pos in match p.Parser.token with | SingleQuote -> - let vars = parseTypeVarList p in + let vars = parse_type_var_list p in begin match vars with | _v1::_v2::_ -> Parser.expect Dot p; - let typ = parseTypExpr p in - let loc = mkLoc startPos p.prevEndPos in + let typ = parse_typ_expr p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Typ.poly ~loc vars typ | [var] -> begin match p.Parser.token with | Dot -> Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc startPos p.prevEndPos in + let typ = parse_typ_expr p in + let loc = mk_loc start_pos p.prev_end_pos 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 returnType = parseTypExpr ~alias:false p in - let loc = mkLoc typ.Parsetree.ptyp_loc.loc_start p.prevEndPos in - Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType + let return_type = parse_typ_expr ~alias:false p in + let loc = mk_loc typ.Parsetree.ptyp_loc.loc_start p.prev_end_pos in + Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ return_type | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt end | _ -> assert false end | _ -> - parseTypExpr p + parse_typ_expr p (* 'a 'b 'c *) - and parseTypeVarList p = + and parse_type_var_list p = let rec loop p vars = match p.Parser.token with | SingleQuote -> Parser.next p; - let (lident, loc) = parseLident p in + let (lident, loc) = parse_lident p in let var = Location.mkloc lident loc in loop p (var::vars) | _ -> @@ -15764,11 +15764,11 @@ end in loop p [] - and parseLidentList p = + and parse_lident_list p = let rec loop p ls = match p.Parser.token with | Lident lident -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; loop p ((Location.mkloc lident loc)::ls) | _ -> @@ -15776,142 +15776,142 @@ end in loop p [] - and parseAtomicTypExpr ~attrs p = - Parser.leaveBreadcrumb p Grammar.AtomicTypExpr; - let startPos = p.Parser.startPos in + and parse_atomic_typ_expr ~attrs p = + Parser.leave_breadcrumb p Grammar.AtomicTypExpr; + let start_pos = p.Parser.start_pos in let typ = match p.Parser.token with | SingleQuote -> Parser.next p; - let (ident, loc) = parseLident p in + let (ident, loc) = parse_lident p in Ast_helper.Typ.var ~loc ~attrs ident | Underscore -> - let endPos = p.endPos in + let end_pos = p.end_pos in Parser.next p; - Ast_helper.Typ.any ~loc:(mkLoc startPos endPos) ~attrs () + Ast_helper.Typ.any ~loc:(mk_loc start_pos end_pos) ~attrs () | Lparen -> Parser.next p; begin match p.Parser.token with | Rparen -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let unitConstr = Location.mkloc (Longident.Lident "unit") loc in - Ast_helper.Typ.constr ~attrs unitConstr [] + 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 t = parseTypExpr p in + let t = parse_typ_expr p in begin match p.token with | Comma -> Parser.next p; - parseTupleType ~attrs ~first:t ~startPos p + parse_tuple_type ~attrs ~first:t ~start_pos p | _ -> Parser.expect Rparen p; {t with - ptyp_loc = mkLoc startPos p.prevEndPos; + ptyp_loc = mk_loc start_pos p.prev_end_pos; ptyp_attributes = List.concat [attrs; t.ptyp_attributes]} end end | Lbracket -> - parsePolymorphicVariantType ~attrs p + parse_polymorphic_variant_type ~attrs p | Uident _ | Lident _ | List -> - let constr = parseValuePath p in - let args = parseTypeConstructorArgs ~constrName:constr p in - Ast_helper.Typ.constr ~loc:(mkLoc startPos p.prevEndPos) ~attrs constr args + let constr = parse_value_path p in + let args = parse_type_constructor_args ~constr_name:constr p in + Ast_helper.Typ.constr ~loc:(mk_loc start_pos p.prev_end_pos) ~attrs constr args | Module -> Parser.next p; Parser.expect Lparen p; - let packageType = parsePackageType ~startPos ~attrs p in + let package_type = parse_package_type ~start_pos ~attrs p in Parser.expect Rparen p; - {packageType with ptyp_loc = mkLoc startPos p.prevEndPos} + {package_type with ptyp_loc = mk_loc start_pos p.prev_end_pos} | Percent -> - let extension = parseExtension p in - let loc = mkLoc startPos p.prevEndPos in + let extension = parse_extension p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Typ.extension ~attrs ~loc extension | Lbrace -> - parseBsObjectType ~attrs p + parse_bs_object_type ~attrs p | token -> - begin match skipTokensAndMaybeRetry p ~isStartOfGrammar:Grammar.isAtomicTypExprStart with + begin match skip_tokens_and_maybe_retry p ~is_start_of_grammar:Grammar.is_atomic_typ_expr_start with | Some () -> - parseAtomicTypExpr ~attrs p + parse_atomic_typ_expr ~attrs p | None -> - Parser.err ~startPos:p.prevEndPos p (Diagnostics.unexpected token p.breadcrumbs); - Recover.defaultType() + Parser.err ~start_pos:p.prev_end_pos p (Diagnostics.unexpected token p.breadcrumbs); + Recover.default_type() end in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; typ (* package-type ::= | modtype-path ∣ modtype-path with package-constraint { and package-constraint } *) - and parsePackageType ~startPos ~attrs p = - let modTypePath = parseModuleLongIdent ~lowercase:true p in + and parse_package_type ~start_pos ~attrs p = + let mod_type_path = parse_module_long_ident ~lowercase:true p in begin match p.Parser.token with | With -> Parser.next p; - let constraints = parsePackageConstraints p in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.package ~loc ~attrs modTypePath constraints + 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 loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.package ~loc ~attrs modTypePath [] + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Typ.package ~loc ~attrs mod_type_path [] end (* package-constraint { and package-constraint } *) - and parsePackageConstraints p = + and parse_package_constraints p = let first = Parser.expect Typ p; - let typeConstr = parseValuePath p in + let type_constr = parse_value_path p in Parser.expect Equal p; - let typ = parseTypExpr p in - (typeConstr, typ) + let typ = parse_typ_expr p in + (type_constr, typ) in - let rest = parseRegion + let rest = parse_region ~grammar:Grammar.PackageConstraint - ~f:parsePackageConstraint + ~f:parse_package_constraint p in first::rest (* and type typeconstr = typexpr *) - and parsePackageConstraint p = + and parse_package_constraint p = match p.Parser.token with | And -> Parser.next p; Parser.expect Typ p; - let typeConstr = parseValuePath p in + let type_constr = parse_value_path p in Parser.expect Equal p; - let typ = parseTypExpr p in - Some (typeConstr, typ) + let typ = parse_typ_expr p in + Some (type_constr, typ) | _ -> None - and parseBsObjectType ~attrs p = - let startPos = p.Parser.startPos in + and parse_bs_object_type ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Lbrace p; - let closedFlag = match p.token with + let closed_flag = match p.token with | DotDot -> Parser.next p; Asttypes.Open | Dot -> Parser.next p; Asttypes.Closed | _ -> Asttypes.Closed in let fields = - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parseStringFieldDeclaration + ~f:parse_string_field_declaration p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - makeBsObjType ~attrs ~loc ~closed:closedFlag fields + let loc = mk_loc start_pos p.prev_end_pos in + make_bs_obj_type ~attrs ~loc ~closed:closed_flag fields (* TODO: check associativity in combination with attributes *) - and parseTypeAlias p typ = + and parse_type_alias p typ = match p.Parser.token with | As -> Parser.next p; Parser.expect SingleQuote p; - let (ident, _loc) = parseLident p in + let (ident, _loc) = parse_lident p in (* TODO: how do we parse attributes here? *) - Ast_helper.Typ.alias ~loc:(mkLoc typ.Parsetree.ptyp_loc.loc_start p.prevEndPos) typ ident + Ast_helper.Typ.alias ~loc:(mk_loc typ.Parsetree.ptyp_loc.loc_start p.prev_end_pos) typ ident | _ -> typ @@ -15927,92 +15927,92 @@ end * uncurried_type_parameter ::= * | . type_parameter *) - and parseTypeParameter p = + and parse_type_parameter p = if ( p.Parser.token = Token.Tilde || p.token = Dot || - Grammar.isTypExprStart p.token + Grammar.is_typ_expr_start p.token ) then ( - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in let uncurried = Parser.optional p Dot in - let attrs = parseAttributes p in + let attrs = parse_attributes p in match p.Parser.token with | Tilde -> Parser.next p; - let (name, _loc) = parseLident p in + let (name, _loc) = parse_lident p in Parser.expect ~grammar:Grammar.TypeExpression Colon p; - let typ = parseTypExpr p in + let typ = parse_typ_expr p in begin match p.Parser.token with | Equal -> Parser.next p; Parser.expect Question p; - Some (uncurried, attrs, Asttypes.Optional name, typ, startPos) + Some (uncurried, attrs, Asttypes.Optional name, typ, start_pos) | _ -> - Some (uncurried, attrs, Asttypes.Labelled name, typ, startPos) + Some (uncurried, attrs, Asttypes.Labelled name, typ, start_pos) end | Lident _ | List -> - let (name, loc) = parseLident p in + let (name, loc) = parse_lident p in begin match p.token with | Colon -> let () = let error = Diagnostics.message ("Parameter names start with a `~`, like: ~" ^ name) in - Parser.err ~startPos:loc.loc_start ~endPos:loc.loc_end p error + Parser.err ~start_pos:loc.loc_start ~end_pos:loc.loc_end p error in Parser.next p; - let typ = parseTypExpr p in + let typ = parse_typ_expr p in begin match p.Parser.token with | Equal -> Parser.next p; Parser.expect Question p; - Some (uncurried, attrs, Asttypes.Optional name, typ, startPos) + Some (uncurried, attrs, Asttypes.Optional name, typ, start_pos) | _ -> - Some (uncurried, attrs, Asttypes.Labelled name, typ, startPos) + Some (uncurried, attrs, Asttypes.Labelled name, typ, start_pos) end | _ -> let constr = Location.mkloc (Longident.Lident name) loc in - let args = parseTypeConstructorArgs ~constrName:constr p in - let typ = Ast_helper.Typ.constr ~loc:(mkLoc startPos p.prevEndPos) ~attrs constr args + let args = parse_type_constructor_args ~constr_name:constr p in + let typ = Ast_helper.Typ.constr ~loc:(mk_loc start_pos p.prev_end_pos) ~attrs constr args in - let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in - let typ = parseTypeAlias p typ in - Some (uncurried, [], Asttypes.Nolabel, typ, startPos) + let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in + let typ = parse_type_alias p typ in + Some (uncurried, [], Asttypes.Nolabel, typ, start_pos) end | _ -> - let typ = parseTypExpr p in - let typWithAttributes = {typ with ptyp_attributes = List.concat[attrs; typ.ptyp_attributes]} in - Some (uncurried, [], Asttypes.Nolabel, typWithAttributes, startPos) + let typ = parse_typ_expr p in + let typ_with_attributes = {typ with ptyp_attributes = List.concat[attrs; typ.ptyp_attributes]} in + Some (uncurried, [], Asttypes.Nolabel, typ_with_attributes, start_pos) ) else None (* (int, ~x:string, float) *) - and parseTypeParameters p = - let startPos = p.Parser.startPos in + and parse_type_parameters p = + let start_pos = p.Parser.start_pos in Parser.expect Lparen p; match p.Parser.token with | Rparen -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let unitConstr = Location.mkloc (Longident.Lident "unit") loc in - let typ = Ast_helper.Typ.constr unitConstr [] in - [(false, [], Asttypes.Nolabel, typ, startPos)] + 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 + [(false, [], Asttypes.Nolabel, typ, start_pos)] | _ -> let params = - parseCommaDelimitedRegion ~grammar:Grammar.TypeParameters ~closing:Rparen ~f:parseTypeParameter p + parse_comma_delimited_region ~grammar:Grammar.TypeParameters ~closing:Rparen ~f:parse_type_parameter p in Parser.expect Rparen p; params - and parseEs6ArrowType ~attrs p = - let startPos = p.Parser.startPos in + and parse_es6_arrow_type ~attrs p = + let start_pos = p.Parser.start_pos in match p.Parser.token with | Tilde -> Parser.next p; - let (name, _loc) = parseLident p in + let (name, _loc) = parse_lident p in Parser.expect ~grammar:Grammar.TypeExpression Colon p; - let typ = parseTypExpr ~alias:false ~es6Arrow:false p in + let typ = parse_typ_expr ~alias:false ~es6_arrow:false p in let arg = match p.Parser.token with | Equal -> Parser.next p; @@ -16022,21 +16022,21 @@ end Asttypes.Labelled name in Parser.expect EqualGreater p; - let returnType = parseTypExpr ~alias:false p in - Ast_helper.Typ.arrow ~attrs arg typ returnType + let return_type = parse_typ_expr ~alias:false p in + Ast_helper.Typ.arrow ~attrs arg typ return_type | _ -> - let parameters = parseTypeParameters p in + let parameters = parse_type_parameters p in Parser.expect EqualGreater p; - let returnType = parseTypExpr ~alias:false p in - let endPos = p.prevEndPos in - let typ = List.fold_right (fun (uncurried, attrs, argLbl, typ, startPos) t -> - let attrs = if uncurried then uncurryAttr::attrs else attrs in - Ast_helper.Typ.arrow ~loc:(mkLoc startPos endPos) ~attrs argLbl typ t - ) parameters returnType + let return_type = parse_typ_expr ~alias:false p in + let end_pos = p.prev_end_pos in + let typ = List.fold_right (fun (uncurried, attrs, arg_lbl, typ, start_pos) t -> + let attrs = if uncurried then uncurry_attr::attrs else attrs in + Ast_helper.Typ.arrow ~loc:(mk_loc start_pos end_pos) ~attrs arg_lbl typ t + ) parameters return_type in {typ with ptyp_attributes = List.concat [typ.ptyp_attributes; attrs]; - ptyp_loc = mkLoc startPos p.prevEndPos} + ptyp_loc = mk_loc start_pos p.prev_end_pos} (* * typexpr ::= @@ -16058,128 +16058,128 @@ end * | uident.lident * | uident.uident.lident --> long module path *) - and parseTypExpr ?attrs ?(es6Arrow=true) ?(alias=true) p = + and parse_typ_expr ?attrs ?(es6_arrow=true) ?(alias=true) p = (* Parser.leaveBreadcrumb p Grammar.TypeExpression; *) - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in let attrs = match attrs with | Some attrs -> attrs | None -> - parseAttributes p in - let typ = if es6Arrow && isEs6ArrowType p then - parseEs6ArrowType ~attrs p + parse_attributes p in + let typ = if es6_arrow && is_es6_arrow_type p then + parse_es6_arrow_type ~attrs p else - let typ = parseAtomicTypExpr ~attrs p in - parseArrowTypeRest ~es6Arrow ~startPos typ p + let typ = parse_atomic_typ_expr ~attrs p in + parse_arrow_type_rest ~es6_arrow ~start_pos typ p in - let typ = if alias then parseTypeAlias p typ else typ in + let typ = if alias then parse_type_alias p typ else typ in (* Parser.eatBreadcrumb p; *) typ - and parseArrowTypeRest ~es6Arrow ~startPos typ p = + and parse_arrow_type_rest ~es6_arrow ~start_pos typ p = match p.Parser.token with - | (EqualGreater | MinusGreater) as token when es6Arrow == true -> + | (EqualGreater | MinusGreater) as token when es6_arrow == true -> (* error recovery *) if token = MinusGreater then ( Parser.expect EqualGreater p; ); Parser.next p; - let returnType = parseTypExpr ~alias:false p in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ returnType + 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 Asttypes.Nolabel typ return_type | _ -> typ - and parseTypExprRegion p = - if Grammar.isTypExprStart p.Parser.token then - Some (parseTypExpr p) + and parse_typ_expr_region p = + if Grammar.is_typ_expr_start p.Parser.token then + Some (parse_typ_expr p) else None - and parseTupleType ~attrs ~first ~startPos p = + and parse_tuple_type ~attrs ~first ~start_pos p = let typexprs = - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:Rparen - ~f:parseTypExprRegion + ~f:parse_typ_expr_region p in Parser.expect Rparen p; - let tupleLoc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.tuple ~attrs ~loc:tupleLoc (first::typexprs) + let tuple_loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Typ.tuple ~attrs ~loc:tuple_loc (first::typexprs) - and parseTypeConstructorArgRegion p = - if Grammar.isTypExprStart p.Parser.token then - Some (parseTypExpr p) + and parse_type_constructor_arg_region p = + if Grammar.is_typ_expr_start p.Parser.token then + Some (parse_typ_expr p) else if p.token = LessThan then ( Parser.next p; - parseTypeConstructorArgRegion p + parse_type_constructor_arg_region p ) else None (* Js.Nullable.value<'a> *) - and parseTypeConstructorArgs ~constrName p = + and parse_type_constructor_args ~constr_name p = let opening = p.Parser.token in - let openingStartPos = p.startPos in + let opening_start_pos = p.start_pos in match opening with | LessThan | Lparen -> - Scanner.setDiamondMode p.scanner; + Scanner.set_diamond_mode p.scanner; Parser.next p; - let typeArgs = + let type_args = (* TODO: change Grammar.TypExprList to TypArgList!!! Why did I wrote this? *) - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:GreaterThan - ~f:parseTypeConstructorArgRegion + ~f:parse_type_constructor_arg_region p in let () = match p.token with | Rparen when opening = Token.Lparen -> - let typ = Ast_helper.Typ.constr constrName typeArgs in + let typ = Ast_helper.Typ.constr constr_name type_args in let msg = - Doc.breakableGroup ~forceBreak:true ( + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.text "Type parameters require angle brackets:"; Doc.indent ( Doc.concat [ Doc.line; - Printer.printTypExpr typ CommentTable.empty; + Printer.print_typ_expr typ CommentTable.empty; ] ) ] - ) |> Doc.toString ~width:80 + ) |> Doc.to_string ~width:80 in - Parser.err ~startPos:openingStartPos p (Diagnostics.message msg); + Parser.err ~start_pos:opening_start_pos p (Diagnostics.message msg); Parser.next p | _ -> Parser.expect GreaterThan p in - Scanner.popMode p.scanner Diamond; - typeArgs + Scanner.pop_mode p.scanner Diamond; + type_args | _ -> [] (* string-field-decl ::= * | string: poly-typexpr * | attributes string-field-decl *) - and parseStringFieldDeclaration p = - let attrs = parseAttributes p in + and parse_string_field_declaration p = + let attrs = parse_attributes p in match p.Parser.token with | String name -> - let nameStartPos = p.startPos in - let nameEndPos = p.endPos in + let name_start_pos = p.start_pos in + let name_end_pos = p.end_pos in Parser.next p; - let fieldName = Location.mkloc name (mkLoc nameStartPos nameEndPos) in + let field_name = Location.mkloc name (mk_loc name_start_pos name_end_pos) in Parser.expect ~grammar:Grammar.TypeExpression Colon p; - let typ = parsePolyTypeExpr p in - Some(Parsetree.Otag (fieldName, attrs, typ)) + let typ = parse_poly_type_expr p in + Some(Parsetree.Otag (field_name, attrs, typ)) | _token -> None (* field-decl ::= * | [mutable] field-name : poly-typexpr * | attributes field-decl *) - and parseFieldDeclaration p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in + and parse_field_declaration p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in let mut = if Parser.optional p Token.Mutable then Asttypes.Mutable else @@ -16187,26 +16187,26 @@ end in let (lident, loc) = match p.token with | List -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; ("list", loc) - | _ -> parseLident p + | _ -> parse_lident p in let name = Location.mkloc lident loc in let typ = match p.Parser.token with | Colon -> Parser.next p; - parsePolyTypeExpr p + parse_poly_type_expr p | _ -> Ast_helper.Typ.constr ~loc:name.loc {name with txt = Lident name.txt} [] in - let loc = mkLoc startPos typ.ptyp_loc.loc_end in + let loc = mk_loc start_pos typ.ptyp_loc.loc_end in Ast_helper.Type.field ~attrs ~loc ~mut name typ - and parseFieldDeclarationRegion p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in + and parse_field_declaration_region p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in let mut = if Parser.optional p Token.Mutable then Asttypes.Mutable else @@ -16216,20 +16216,20 @@ end | Lident _ | List -> let (lident, loc) = match p.token with | List -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; ("list", loc) - | _ -> parseLident p + | _ -> parse_lident p in let name = Location.mkloc lident loc in let typ = match p.Parser.token with | Colon -> Parser.next p; - parsePolyTypeExpr p + parse_poly_type_expr p | _ -> Ast_helper.Typ.constr ~loc:name.loc {name with txt = Lident name.txt} [] in - let loc = mkLoc startPos typ.ptyp_loc.loc_end in + let loc = mk_loc start_pos typ.ptyp_loc.loc_end in Some(Ast_helper.Type.field ~attrs ~loc ~mut name typ) | _ -> None @@ -16239,18 +16239,18 @@ end * | { field-decl, field-decl } * | { field-decl, field-decl, field-decl, } *) - and parseRecordDeclaration p = - Parser.leaveBreadcrumb p Grammar.RecordDecl; + and parse_record_declaration p = + Parser.leave_breadcrumb p Grammar.RecordDecl; Parser.expect Lbrace p; let rows = - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.RecordDecl ~closing:Rbrace - ~f:parseFieldDeclarationRegion + ~f:parse_field_declaration_region p in Parser.expect Rbrace p; - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; rows (* constr-args ::= @@ -16262,59 +16262,59 @@ end * TODO: should we overparse inline-records in every position? * Give a good error message afterwards? *) - and parseConstrDeclArgs p = - let constrArgs = match p.Parser.token with + and parse_constr_decl_args p = + let constr_args = match p.Parser.token with | Lparen -> Parser.next p; (* TODO: this could use some cleanup/stratification *) begin match p.Parser.token with | Lbrace -> - let lbrace = p.startPos in + let lbrace = p.start_pos in Parser.next p; - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in begin match p.Parser.token with | DotDot | Dot -> - let closedFlag = match p.token with + let closed_flag = match p.token with | DotDot -> Parser.next p; Asttypes.Open | Dot -> Parser.next p; Asttypes.Closed | _ -> Asttypes.Closed in let fields = - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parseStringFieldDeclaration + ~f:parse_string_field_declaration p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let typ = makeBsObjType ~attrs:[] ~loc ~closed:closedFlag fields in + let loc = mk_loc start_pos p.prev_end_pos in + let typ = make_bs_obj_type ~attrs:[] ~loc ~closed:closed_flag fields in Parser.optional p Comma |> ignore; - let moreArgs = - parseCommaDelimitedRegion + let more_args = + parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:Rparen - ~f:parseTypExprRegion + ~f:parse_typ_expr_region p in Parser.expect Rparen p; - Parsetree.Pcstr_tuple (typ::moreArgs) + Parsetree.Pcstr_tuple (typ::more_args) | _ -> - let attrs = parseAttributes p in + let attrs = parse_attributes p in begin match p.Parser.token with | String _ -> - let closedFlag = Asttypes.Closed in + let closed_flag = Asttypes.Closed in let fields = match attrs with | [] -> - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parseStringFieldDeclaration + ~f:parse_string_field_declaration p | attrs -> let first = - Parser.leaveBreadcrumb p Grammar.StringFieldDeclarations; - let field = match parseStringFieldDeclaration p with + Parser.leave_breadcrumb p Grammar.StringFieldDeclarations; + let field = match parse_string_field_declaration p with | Some field -> field | None -> assert false in @@ -16324,55 +16324,55 @@ end | Comma -> Parser.next p | _ -> Parser.expect Comma p in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; begin match field with | Parsetree.Otag (label, _, ct) -> Parsetree.Otag (label, attrs, ct) | Oinherit ct -> Oinherit ct end in first::( - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parseStringFieldDeclaration + ~f:parse_string_field_declaration p ) in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let typ = makeBsObjType ~attrs:[] ~loc ~closed:closedFlag fields in + let loc = mk_loc start_pos p.prev_end_pos in + let typ = make_bs_obj_type ~attrs:[] ~loc ~closed:closed_flag fields in Parser.optional p Comma |> ignore; - let moreArgs = - parseCommaDelimitedRegion + let more_args = + parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:Rparen - ~f:parseTypExprRegion p + ~f:parse_typ_expr_region p in Parser.expect Rparen p; - Parsetree.Pcstr_tuple (typ::moreArgs) + Parsetree.Pcstr_tuple (typ::more_args) | _ -> let fields = match attrs with | [] -> - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations ~closing:Rbrace - ~f:parseFieldDeclarationRegion + ~f:parse_field_declaration_region p | attrs -> let first = - let field = parseFieldDeclaration p in + let field = parse_field_declaration p in Parser.expect Comma p; {field with Parsetree.pld_attributes = attrs} in first::( - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations ~closing:Rbrace - ~f:parseFieldDeclarationRegion + ~f:parse_field_declaration_region p ) in let () = match fields with - | [] -> Parser.err ~startPos:lbrace p ( + | [] -> Parser.err ~start_pos:lbrace p ( Diagnostics.message "An inline record declaration needs at least one field" ) | _ -> () @@ -16385,10 +16385,10 @@ end end | _ -> let args = - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:Rparen - ~f:parseTypExprRegion + ~f:parse_typ_expr_region p in Parser.expect Rparen p; @@ -16399,53 +16399,53 @@ end let res = match p.Parser.token with | Colon -> Parser.next p; - Some (parseTypExpr p) + Some (parse_typ_expr p) | _ -> None in - (constrArgs, res) + (constr_args, res) (* constr-decl ::= * | constr-name * | attrs constr-name * | constr-name const-args * | attrs constr-name const-args *) - and parseTypeConstructorDeclarationWithBar p = + and parse_type_constructor_declaration_with_bar p = match p.Parser.token with | Bar -> - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in Parser.next p; - Some (parseTypeConstructorDeclaration ~startPos p) + Some (parse_type_constructor_declaration ~start_pos p) | _ -> None - and parseTypeConstructorDeclaration ~startPos p = - Parser.leaveBreadcrumb p Grammar.ConstructorDeclaration; - let attrs = parseAttributes p in + and parse_type_constructor_declaration ~start_pos p = + Parser.leave_breadcrumb p Grammar.ConstructorDeclaration; + let attrs = parse_attributes p in match p.Parser.token with | Uident uident -> - let uidentLoc = mkLoc p.startPos p.endPos in + let uident_loc = mk_loc p.start_pos p.end_pos in Parser.next p; - 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 uidentLoc) + let (args, res) = parse_constr_decl_args p in + Parser.eat_breadcrumb p; + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Type.constructor ~loc ~attrs ?res ~args (Location.mkloc uident uident_loc) | t -> Parser.err p (Diagnostics.uident t); Ast_helper.Type.constructor (Location.mknoloc "_") (* [|] constr-decl { | constr-decl } *) - and parseTypeConstructorDeclarations ?first p = - let firstConstrDecl = match first with + and parse_type_constructor_declarations ?first p = + let first_constr_decl = match first with | None -> - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in ignore (Parser.optional p Token.Bar); - parseTypeConstructorDeclaration ~startPos p - | Some firstConstrDecl -> - firstConstrDecl + parse_type_constructor_declaration ~start_pos p + | Some first_constr_decl -> + first_constr_decl in - firstConstrDecl::( - parseRegion + first_constr_decl::( + parse_region ~grammar:Grammar.ConstructorDeclaration - ~f:parseTypeConstructorDeclarationWithBar + ~f:parse_type_constructor_declaration_with_bar p ) @@ -16459,19 +16459,19 @@ end * ∣ = private record-decl * | = .. *) - and parseTypeRepresentation p = - Parser.leaveBreadcrumb p Grammar.TypeRepresentation; + and parse_type_representation p = + Parser.leave_breadcrumb p Grammar.TypeRepresentation; (* = consumed *) - let privateFlag = + let private_flag = 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 (parseTypeConstructorDeclarations p) + Parsetree.Ptype_variant (parse_type_constructor_declarations p) | Lbrace -> - Parsetree.Ptype_record (parseRecordDeclaration p) + Parsetree.Ptype_record (parse_record_declaration p) | DotDot -> Parser.next p; Ptype_open @@ -16480,8 +16480,8 @@ end (* TODO: I have no idea if this is even remotely a good idea *) Parsetree.Ptype_variant [] in - Parser.eatBreadcrumb p; - (privateFlag, kind) + Parser.eat_breadcrumb p; + (private_flag, kind) (* type-param ::= * | variance 'lident @@ -16492,7 +16492,7 @@ end * | - * | (* empty *) *) - and parseTypeParam p = + and parse_type_param p = let variance = match p.Parser.token with | Plus -> Parser.next p; Asttypes.Covariant | Minus -> Parser.next p; Contravariant @@ -16501,10 +16501,10 @@ end match p.Parser.token with | SingleQuote -> Parser.next p; - let (ident, loc) = parseLident p in + let (ident, loc) = parse_lident p in Some (Ast_helper.Typ.var ~loc ident, variance) | Underscore -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Some (Ast_helper.Typ.any ~loc (), variance) (* TODO: should we try parsing lident as 'ident ? *) @@ -16519,68 +16519,68 @@ end * * TODO: when we have pretty-printer show an error * with the actual code corrected. *) - and parseTypeParams ~parent p = + and parse_type_params ~parent p = let opening = p.Parser.token in match opening with - | 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; + | 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; Parser.next p; let params = - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.TypeParams ~closing:GreaterThan - ~f:parseTypeParam + ~f:parse_type_param p in let () = match p.token with | Rparen when opening = Token.Lparen -> let msg = - Doc.breakableGroup ~forceBreak:true ( + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.text "Type parameters require angle brackets:"; Doc.indent ( Doc.concat [ Doc.line; Doc.concat [ - Printer.printLongident parent.Location.txt; - Printer.printTypeParams params CommentTable.empty; + Printer.print_longident parent.Location.txt; + Printer.print_type_params params CommentTable.empty; ] ] ) ] - ) |> Doc.toString ~width:80 + ) |> Doc.to_string ~width:80 in - Parser.err ~startPos:openingStartPos p (Diagnostics.message msg); + Parser.err ~start_pos:opening_start_pos p (Diagnostics.message msg); Parser.next p | _ -> Parser.expect GreaterThan p in - Scanner.popMode p.scanner Diamond; - Parser.eatBreadcrumb p; + Scanner.pop_mode p.scanner Diamond; + Parser.eat_breadcrumb p; params | _ -> [] (* type-constraint ::= constraint ' ident = typexpr *) - and parseTypeConstraint p = - let startPos = p.Parser.startPos in + and parse_type_constraint p = + let start_pos = p.Parser.start_pos in match p.Parser.token with | Token.Constraint -> Parser.next p; Parser.expect SingleQuote p; begin match p.Parser.token with | Lident ident -> - let identLoc = mkLoc startPos p.endPos in + let ident_loc = mk_loc start_pos p.end_pos in Parser.next p; Parser.expect Equal p; - let typ = parseTypExpr p in - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Typ.var ~loc:identLoc ident, typ, loc) + 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) | t -> Parser.err p (Diagnostics.lident t); - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Typ.any (), parseTypExpr p, loc) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Typ.any (), parse_typ_expr p, loc) end | _ -> None @@ -16590,100 +16590,100 @@ end * | type-constraint type-constraint * | type-constraint type-constraint type-constraint (* 0 or more *) *) - and parseTypeConstraints p = - parseRegion + and parse_type_constraints p = + parse_region ~grammar:Grammar.TypeConstraint - ~f:parseTypeConstraint + ~f:parse_type_constraint p - and parseTypeEquationOrConstrDecl p = - let uidentStartPos = p.Parser.startPos in + and parse_type_equation_or_constr_decl p = + let uident_start_pos = p.Parser.start_pos in match p.Parser.token with | Uident uident -> Parser.next p; begin match p.Parser.token with | Dot -> Parser.next p; - let typeConstr = - parseValuePathTail p uidentStartPos (Longident.Lident uident) + let type_constr = + parse_value_path_tail p uident_start_pos (Longident.Lident uident) in - let loc = mkLoc uidentStartPos p.prevEndPos in - let typ = parseTypeAlias p ( - Ast_helper.Typ.constr ~loc typeConstr (parseTypeConstructorArgs ~constrName:typeConstr p) + let loc = mk_loc uident_start_pos p.prev_end_pos in + let typ = parse_type_alias p ( + Ast_helper.Typ.constr ~loc type_constr (parse_type_constructor_args ~constr_name:type_constr p) ) in begin match p.token with | Equal -> Parser.next p; - let (priv, kind) = parseTypeRepresentation p in + let (priv, kind) = parse_type_representation p in (Some typ, priv, kind) | EqualGreater -> Parser.next p; - 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 typ = parseTypeAlias p arrowType in + 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 in + let typ = parse_type_alias p arrow_type in (Some typ, Asttypes.Public, Parsetree.Ptype_abstract) | _ -> (Some typ, Asttypes.Public, Parsetree.Ptype_abstract) end | _ -> - let uidentEndPos = p.endPos in - let (args, res) = parseConstrDeclArgs p in + let uident_end_pos = p.end_pos in + let (args, res) = parse_constr_decl_args p in let first = Some ( - let uidentLoc = mkLoc uidentStartPos uidentEndPos in + let uident_loc = mk_loc uident_start_pos uident_end_pos in Ast_helper.Type.constructor - ~loc:(mkLoc uidentStartPos p.prevEndPos) + ~loc:(mk_loc uident_start_pos p.prev_end_pos) ?res ~args - (Location.mkloc uident uidentLoc) + (Location.mkloc uident uident_loc) ) in - (None, Asttypes.Public, Parsetree.Ptype_variant (parseTypeConstructorDeclarations p ?first)) + (None, Asttypes.Public, Parsetree.Ptype_variant (parse_type_constructor_declarations p ?first)) end | t -> Parser.err p (Diagnostics.uident t); (* TODO: is this a good idea? *) (None, Asttypes.Public, Parsetree.Ptype_abstract) - and parseRecordOrBsObjectDecl p = - let startPos = p.Parser.startPos in + and parse_record_or_bs_object_decl p = + let start_pos = p.Parser.start_pos in Parser.expect Lbrace p; match p.Parser.token with | DotDot | Dot -> - let closedFlag = match p.token with + let closed_flag = match p.token with | DotDot -> Parser.next p; Asttypes.Open | Dot -> Parser.next p; Asttypes.Closed | _ -> Asttypes.Closed in let fields = - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parseStringFieldDeclaration + ~f:parse_string_field_declaration p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in let typ = - makeBsObjType ~attrs:[] ~loc ~closed:closedFlag fields - |> parseTypeAlias p + make_bs_obj_type ~attrs:[] ~loc ~closed:closed_flag fields + |> parse_type_alias p in - let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in + let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in (Some typ, Asttypes.Public, Parsetree.Ptype_abstract) | _ -> - let attrs = parseAttributes p in + let attrs = parse_attributes p in begin match p.Parser.token with | String _ -> - let closedFlag = Asttypes.Closed in + let closed_flag = Asttypes.Closed in let fields = match attrs with | [] -> - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parseStringFieldDeclaration + ~f:parse_string_field_declaration p | attrs -> let first = - Parser.leaveBreadcrumb p Grammar.StringFieldDeclarations; - let field = match parseStringFieldDeclaration p with + Parser.leave_breadcrumb p Grammar.StringFieldDeclarations; + let field = match parse_string_field_declaration p with | Some field -> field | None -> assert false in @@ -16693,39 +16693,39 @@ end | Comma -> Parser.next p | _ -> Parser.expect Comma p in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; begin match field with | Parsetree.Otag (label, _, ct) -> Parsetree.Otag (label, attrs, ct) | Oinherit ct -> Oinherit ct end in first::( - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parseStringFieldDeclaration + ~f:parse_string_field_declaration p ) in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in let typ = - makeBsObjType ~attrs:[] ~loc ~closed:closedFlag fields |> parseTypeAlias p + make_bs_obj_type ~attrs:[] ~loc ~closed:closed_flag fields |> parse_type_alias p in - let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in + let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in (Some typ, Asttypes.Public, Parsetree.Ptype_abstract) | _ -> - Parser.leaveBreadcrumb p Grammar.RecordDecl; + Parser.leave_breadcrumb p Grammar.RecordDecl; let fields = match attrs with | [] -> - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations ~closing:Rbrace - ~f:parseFieldDeclarationRegion + ~f:parse_field_declaration_region p | attr::_ as attrs -> let first = - let field = parseFieldDeclaration p in + let field = parse_field_declaration p in Parser.optional p Comma |> ignore; {field with Parsetree.pld_attributes = attrs; @@ -16736,40 +16736,40 @@ end } in first::( - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations ~closing:Rbrace - ~f:parseFieldDeclarationRegion + ~f:parse_field_declaration_region p ) in let () = match fields with - | [] -> Parser.err ~startPos p ( + | [] -> Parser.err ~start_pos p ( Diagnostics.message "A record needs at least one field" ) | _ -> () in Parser.expect Rbrace p; - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; (None, Asttypes.Public, Parsetree.Ptype_record fields) end - and parsePrivateEqOrRepr p = + and parse_private_eq_or_repr p = Parser.expect Private p; match p.Parser.token with | Lbrace -> - let (manifest, _ ,kind) = parseRecordOrBsObjectDecl p in + let (manifest, _ ,kind) = parse_record_or_bs_object_decl p in (manifest, Asttypes.Private, kind) | Uident _ -> - let (manifest, _, kind) = parseTypeEquationOrConstrDecl p in + let (manifest, _, kind) = parse_type_equation_or_constr_decl p in (manifest, Asttypes.Private, kind) | Bar | DotDot -> - let (_, kind) = parseTypeRepresentation p in + let (_, kind) = parse_type_representation p in (None, Asttypes.Private, kind) - | t when Grammar.isTypExprStart t -> - (Some (parseTypExpr p), Asttypes.Private, Parsetree.Ptype_abstract) + | t when Grammar.is_typ_expr_start t -> + (Some (parse_typ_expr p), Asttypes.Private, Parsetree.Ptype_abstract) | _ -> - let (_, kind) = parseTypeRepresentation p in + let (_, kind) = parse_type_representation p in (None, Asttypes.Private, kind) (* @@ -16787,61 +16787,61 @@ end tag-spec-full ::= `tag-name [ of [&] typexpr { & typexpr } ] | typexpr *) - and parsePolymorphicVariantType ~attrs p = - let startPos = p.Parser.startPos in + and parse_polymorphic_variant_type ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Lbracket p; match p.token with | GreaterThan -> Parser.next p; - let rowFields = + let row_fields = begin match p.token with | Rbracket -> [] | Bar -> - parseTagSpecs p + parse_tag_specs p | _ -> - let rowField = parseTagSpec p in - rowField :: parseTagSpecs p + let row_field = parse_tag_spec p in + row_field :: parse_tag_specs p end in let variant = - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.variant ~attrs ~loc rowFields Open None in + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Typ.variant ~attrs ~loc row_fields Open None in Parser.expect Rbracket p; variant | LessThan -> Parser.next p; Parser.optional p Bar |> ignore; - let rowField = parseTagSpecFull p in - let rowFields = parseTagSpecFulls p in - let tagNames = + let row_field = parse_tag_spec_full p in + let row_fields = parse_tag_spec_fulls p in + let tag_names = if p.token == GreaterThan then begin Parser.next p; let rec loop p = match p.Parser.token with | Rbracket -> [] | _ -> - let (ident, _loc) = parseHashIdent ~startPos:p.startPos p in + let (ident, _loc) = parse_hash_ident ~start_pos:p.start_pos p in ident :: loop p in loop p end else [] in let variant = - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.variant ~attrs ~loc (rowField :: rowFields) Closed (Some tagNames) in + 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) in Parser.expect Rbracket p; variant | _ -> - let rowFields1 = parseTagSpecFirst p in - let rowFields2 = parseTagSpecs p in + let row_fields1 = parse_tag_spec_first p in + let row_fields2 = parse_tag_specs p in let variant = - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.variant ~attrs ~loc (rowFields1 @ rowFields2) Closed None in + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Typ.variant ~attrs ~loc (row_fields1 @ row_fields2) Closed None in Parser.expect Rbracket p; variant - and parseTagSpecFulls p = + and parse_tag_spec_fulls p = match p.Parser.token with | Rbracket -> [] @@ -16849,93 +16849,93 @@ end [] | Bar -> Parser.next p; - let rowField = parseTagSpecFull p in - rowField ::parseTagSpecFulls p + let row_field = parse_tag_spec_full p in + row_field ::parse_tag_spec_fulls p | _ -> [] - and parseTagSpecFull p = - let attrs = parseAttributes p in + and parse_tag_spec_full p = + let attrs = parse_attributes p in match p.Parser.token with | Hash -> - parsePolymorphicVariantTypeSpecHash ~attrs ~full:true p + parse_polymorphic_variant_type_spec_hash ~attrs ~full:true p | _ -> - let typ = parseTypExpr ~attrs p in + let typ = parse_typ_expr ~attrs p in Parsetree.Rinherit typ - and parseTagSpecs p = + and parse_tag_specs p = match p.Parser.token with | Bar -> Parser.next p; - let rowField = parseTagSpec p in - rowField :: parseTagSpecs p + let row_field = parse_tag_spec p in + row_field :: parse_tag_specs p | _ -> [] - and parseTagSpec p = - let attrs = parseAttributes p in + and parse_tag_spec p = + let attrs = parse_attributes p in match p.Parser.token with | Hash -> - parsePolymorphicVariantTypeSpecHash ~attrs ~full:false p + parse_polymorphic_variant_type_spec_hash ~attrs ~full:false p | _ -> - let typ = parseTypExpr ~attrs p in + let typ = parse_typ_expr ~attrs p in Parsetree.Rinherit typ - and parseTagSpecFirst p = - let attrs = parseAttributes p in + and parse_tag_spec_first p = + let attrs = parse_attributes p in match p.Parser.token with | Bar -> Parser.next p; - [parseTagSpec p] + [parse_tag_spec p] | Hash -> - [parsePolymorphicVariantTypeSpecHash ~attrs ~full:false p] + [parse_polymorphic_variant_type_spec_hash ~attrs ~full:false p] | _ -> - let typ = parseTypExpr ~attrs p in + let typ = parse_typ_expr ~attrs p in Parser.expect Bar p; - [Parsetree.Rinherit typ; parseTagSpec p] + [Parsetree.Rinherit typ; parse_tag_spec p] - and parsePolymorphicVariantTypeSpecHash ~attrs ~full p : Parsetree.row_field = - let startPos = p.Parser.startPos in - let (ident, loc) = parseHashIdent ~startPos p in + 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 let rec loop p = match p.Parser.token with | Band when full -> Parser.next p; - let rowField = parsePolymorphicVariantTypeArgs p in - rowField :: loop p + let row_field = parse_polymorphic_variant_type_args p in + row_field :: loop p | _ -> [] in - let firstTuple, tagContainsAConstantEmptyConstructor = + let first_tuple, tag_contains_a_constant_empty_constructor = match p.Parser.token with | Band when full -> Parser.next p; - [parsePolymorphicVariantTypeArgs p], true + [parse_polymorphic_variant_type_args p], true | Lparen -> - [parsePolymorphicVariantTypeArgs p], false + [parse_polymorphic_variant_type_args p], false | _ -> [], true in - let tuples = firstTuple @ loop p in + let tuples = first_tuple @ loop p in Parsetree.Rtag ( Location.mkloc ident loc, attrs, - tagContainsAConstantEmptyConstructor, + tag_contains_a_constant_empty_constructor, tuples ) - and parsePolymorphicVariantTypeArgs p = - let startPos = p.Parser.startPos in + and parse_polymorphic_variant_type_args p = + let start_pos = p.Parser.start_pos in Parser.expect Lparen p; - let args = parseCommaDelimitedRegion + let args = parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:Rparen - ~f:parseTypExprRegion + ~f:parse_typ_expr_region p in Parser.expect Rparen p; let attrs = [] in - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in match args with | [{ptyp_desc = Ptyp_tuple _} as typ] as types -> if p.mode = ParseForTypeChecker then @@ -16945,27 +16945,27 @@ end | [typ] -> typ | types -> Ast_helper.Typ.tuple ~loc ~attrs types - and parseTypeEquationAndRepresentation p = + and parse_type_equation_and_representation p = match p.Parser.token with | Equal | Bar as token -> if token = Bar then Parser.expect Equal p; Parser.next p; begin match p.Parser.token with | Uident _ -> - parseTypeEquationOrConstrDecl p + parse_type_equation_or_constr_decl p | Lbrace -> - parseRecordOrBsObjectDecl p + parse_record_or_bs_object_decl p | Private -> - parsePrivateEqOrRepr p + parse_private_eq_or_repr p | Bar | DotDot -> - let (priv, kind) = parseTypeRepresentation p in + let (priv, kind) = parse_type_representation p in (None, priv, kind) | _ -> - let manifest = Some (parseTypExpr p) in + let manifest = Some (parse_typ_expr p) in begin match p.Parser.token with | Equal -> Parser.next p; - let (priv, kind) = parseTypeRepresentation p in + let (priv, kind) = parse_type_representation p in (manifest, priv, kind) | _ -> (manifest, Public, Parsetree.Ptype_abstract) @@ -16977,122 +16977,122 @@ end * typedef ::= typeconstr-name [type-params] type-information * type-information ::= [type-equation] [type-representation] { type-constraint } * type-equation ::= = typexpr *) - and parseTypeDef ~attrs ~startPos p = - Parser.leaveBreadcrumb p Grammar.TypeDef; + and parse_type_def ~attrs ~start_pos p = + Parser.leave_breadcrumb p Grammar.TypeDef; (* let attrs = match attrs with | Some attrs -> attrs | None -> parseAttributes p in *) - Parser.leaveBreadcrumb p Grammar.TypeConstrName; - let (name, loc) = parseLident p in - let typeConstrName = Location.mkloc name loc in - Parser.eatBreadcrumb p; + 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; let params = - let constrName = Location.mkloc (Longident.Lident name) loc in - parseTypeParams ~parent:constrName p in - let typeDef = - let (manifest, priv, kind) = parseTypeEquationAndRepresentation p in - let cstrs = parseTypeConstraints p in - let loc = mkLoc startPos p.prevEndPos in + let constr_name = Location.mkloc (Longident.Lident name) loc in + parse_type_params ~parent:constr_name 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 Ast_helper.Type.mk - ~loc ~attrs ~priv ~kind ~params ~cstrs ?manifest typeConstrName + ~loc ~attrs ~priv ~kind ~params ~cstrs ?manifest type_constr_name in - Parser.eatBreadcrumb p; - typeDef + Parser.eat_breadcrumb p; + type_def - and parseTypeExtension ~params ~attrs ~name p = + and parse_type_extension ~params ~attrs ~name p = Parser.expect PlusEqual p; let priv = if Parser.optional p Token.Private then Asttypes.Private else Asttypes.Public in - let constrStart = p.Parser.startPos in + let constr_start = p.Parser.start_pos in Parser.optional p Bar |> ignore; let first = let (attrs, name, kind) = match p.Parser.token with | Bar -> Parser.next p; - parseConstrDef ~parseAttrs:true p + parse_constr_def ~parse_attrs:true p | _ -> - parseConstrDef ~parseAttrs:true p + parse_constr_def ~parse_attrs:true p in - let loc = mkLoc constrStart p.prevEndPos in + let loc = mk_loc constr_start p.prev_end_pos in Ast_helper.Te.constructor ~loc ~attrs name kind in let rec loop p cs = match p.Parser.token with | Bar -> - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in Parser.next p; - let (attrs, name, kind) = parseConstrDef ~parseAttrs:true p in - let extConstr = - Ast_helper.Te.constructor ~attrs ~loc:(mkLoc startPos p.prevEndPos) name kind + let (attrs, name, kind) = parse_constr_def ~parse_attrs:true p in + let ext_constr = + Ast_helper.Te.constructor ~attrs ~loc:(mk_loc start_pos p.prev_end_pos) name kind in - loop p (extConstr::cs) + loop p (ext_constr::cs) | _ -> List.rev cs in let constructors = loop p [first] in Ast_helper.Te.mk ~attrs ~params ~priv name constructors - 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 + 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 Ast_helper.Type.mk ~loc ~attrs ~priv ~kind ~params ~cstrs ?manifest - {name with txt = lidentOfPath name.Location.txt} + {name with txt = lident_of_path name.Location.txt} in let rec loop p defs = - let startPos = p.Parser.startPos in - let attrs = parseAttributesAndBinding p in + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes_and_binding p in match p.Parser.token with | And -> Parser.next p; let attrs = match p.token with | Export -> - let exportLoc = mkLoc p.startPos p.endPos in + let export_loc = mk_loc p.start_pos p.end_pos in Parser.next p; - let genTypeAttr = (Location.mkloc "genType" exportLoc, Parsetree.PStr []) in - genTypeAttr::attrs + let gen_type_attr = (Location.mkloc "genType" export_loc, Parsetree.PStr []) in + gen_type_attr::attrs | _ -> attrs in - let typeDef = parseTypeDef ~attrs ~startPos p in - loop p (typeDef::defs) + let type_def = parse_type_def ~attrs ~start_pos p in + loop p (type_def::defs) | _ -> List.rev defs in - loop p [typeDef] + loop p [type_def] (* 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 parseTypeDefinitionOrExtension ~attrs p = - let startPos = p.Parser.startPos in + and parse_type_definition_or_extension ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Token.Typ p; - let recFlag = match p.token with + let rec_flag = match p.token with | Rec -> Parser.next p; Asttypes.Recursive | Lident "nonrec" -> Parser.next p; Asttypes.Nonrecursive | _ -> Asttypes.Nonrecursive in - let name = parseValuePath p in - let params = parseTypeParams ~parent:name p in + let name = parse_value_path p in + let params = parse_type_params ~parent:name p in match p.Parser.token with | PlusEqual -> - TypeExt(parseTypeExtension ~params ~attrs ~name p) + TypeExt(parse_type_extension ~params ~attrs ~name p) | _ -> - let typeDefs = parseTypeDefinitions ~attrs ~name ~params ~startPos p in - TypeDef {recFlag; types = typeDefs} + let type_defs = parse_type_definitions ~attrs ~name ~params ~start_pos p in + TypeDef {rec_flag; types = type_defs} - and parsePrimitive p = + and parse_primitive p = match p.Parser.token with | String s -> Parser.next p; Some s | _ -> None - and parsePrimitives p = - match (parseRegion ~grammar:Grammar.Primitive ~f:parsePrimitive p) with + and parse_primitives p = + match (parse_region ~grammar:Grammar.Primitive ~f:parse_primitive p) with | [] -> let msg = "An external definition should have at least one primitive. Example: \"setTimeout\"" in Parser.err p (Diagnostics.message msg); @@ -17100,19 +17100,19 @@ end | primitives -> primitives (* external value-name : typexp = external-declaration *) - and parseExternalDef ~attrs p = - let startPos = p.Parser.startPos in - Parser.leaveBreadcrumb p Grammar.External; + and parse_external_def ~attrs p = + let start_pos = p.Parser.start_pos in + Parser.leave_breadcrumb p Grammar.External; Parser.expect Token.External p; - let (name, loc) = parseLident p in + let (name, loc) = parse_lident p in let name = Location.mkloc name loc in Parser.expect ~grammar:(Grammar.TypeExpression) Colon p; - let typExpr = parseTypExpr p in + let typ_expr = parse_typ_expr p in Parser.expect Equal p; - let prim = parsePrimitives p in - let loc = mkLoc startPos p.prevEndPos in - let vb = Ast_helper.Val.mk ~loc ~attrs ~prim name typExpr in - Parser.eatBreadcrumb p; + let prim = parse_primitives p 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; vb (* constr-def ::= @@ -17122,11 +17122,11 @@ end * constr-decl ::= constr-name constr-args * constr-name ::= uident * constr ::= path-uident *) - and parseConstrDef ~parseAttrs p = - let attrs = if parseAttrs then parseAttributes p else [] in + and parse_constr_def ~parse_attrs p = + let attrs = if parse_attrs then parse_attributes p else [] in let name = match p.Parser.token with | Uident name -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Location.mkloc name loc | t -> @@ -17135,11 +17135,11 @@ end in let kind = match p.Parser.token with | Lparen -> - let (args, res) = parseConstrDeclArgs p in + let (args, res) = parse_constr_decl_args p in Parsetree.Pext_decl (args, res) | Equal -> Parser.next p; - let longident = parseModuleLongIdent ~lowercase:false p in + let longident = parse_module_long_ident ~lowercase:false p in Parsetree.Pext_rebind longident | _ -> Parsetree.Pext_decl (Pcstr_tuple [], None) @@ -17153,249 +17153,249 @@ end * * constr-name ::= uident * constr ::= long_uident *) - and parseExceptionDef ~attrs p = - let startPos = p.Parser.startPos in + and parse_exception_def ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Token.Exception p; - let (_, name, kind) = parseConstrDef ~parseAttrs:false p in - let loc = mkLoc startPos p.prevEndPos in + let (_, name, kind) = parse_constr_def ~parse_attrs:false p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Te.constructor ~loc ~attrs name kind (* module structure on the file level *) - and parseImplementation p : Parsetree.structure = - parseRegion p ~grammar:Grammar.Implementation ~f:parseStructureItemRegion - [@@progress (Parser.next, Parser.expect, Parser.checkProgress)] + and parse_implementation p : Parsetree.structure = + parse_region p ~grammar:Grammar.Implementation ~f:parse_structure_item_region + [@@progress (Parser.next, Parser.expect, Parser.check_progress)] - and parseStructureItemRegion p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in + and parse_structure_item_region p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in match p.Parser.token with | Open -> - let openDescription = parseOpenDescription ~attrs p in + let open_description = parse_open_description ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Str.open_ ~loc openDescription) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Str.open_ ~loc open_description) | Let -> - let (recFlag, letBindings) = parseLetBindings ~attrs p in + let (rec_flag, let_bindings) = parse_let_bindings ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Str.value ~loc recFlag letBindings) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Str.value ~loc rec_flag let_bindings) | Typ -> - Parser.beginRegion p; - begin match parseTypeDefinitionOrExtension ~attrs p with - | TypeDef {recFlag; types} -> + Parser.begin_region p; + begin match parse_type_definition_or_extension ~attrs p with + | TypeDef {rec_flag; types} -> Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Parser.endRegion p; - Some (Ast_helper.Str.type_ ~loc recFlag types) + let loc = mk_loc start_pos p.prev_end_pos in + Parser.end_region p; + Some (Ast_helper.Str.type_ ~loc rec_flag types) | TypeExt(ext) -> Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Parser.endRegion p; + let loc = mk_loc start_pos p.prev_end_pos in + Parser.end_region p; Some (Ast_helper.Str.type_extension ~loc ext) end | External -> - let externalDef = parseExternalDef ~attrs p in + let external_def = parse_external_def ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Str.primitive ~loc externalDef) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Str.primitive ~loc external_def) | Import -> - let importDescr = parseJsImport ~startPos ~attrs p in + let import_descr = parse_js_import ~start_pos ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - let structureItem = JsFfi.toParsetree importDescr in - Some {structureItem with pstr_loc = loc} + let loc = mk_loc start_pos p.prev_end_pos in + let structure_item = JsFfi.to_parsetree import_descr in + Some {structure_item with pstr_loc = loc} | Exception -> - let exceptionDef = parseExceptionDef ~attrs p in + let exception_def = parse_exception_def ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Str.exception_ ~loc exceptionDef) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Str.exception_ ~loc exception_def) | Include -> - let includeStatement = parseIncludeStatement ~attrs p in + let include_statement = parse_include_statement ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Str.include_ ~loc includeStatement) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Str.include_ ~loc include_statement) | Export -> - let structureItem = parseJsExport ~attrs p in + let structure_item = parse_js_export ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some {structureItem with pstr_loc = loc} + let loc = mk_loc start_pos p.prev_end_pos in + Some {structure_item with pstr_loc = loc} | Module -> - let structureItem = parseModuleOrModuleTypeImplOrPackExpr ~attrs p in + let structure_item = parse_module_or_module_type_impl_or_pack_expr ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some {structureItem with pstr_loc = loc} + let loc = mk_loc start_pos p.prev_end_pos in + Some {structure_item with pstr_loc = loc} | AtAt -> - let attr = parseStandaloneAttribute p in + let attr = parse_standalone_attribute p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Some (Ast_helper.Str.attribute ~loc attr) | PercentPercent -> - let extension = parseExtension ~moduleLanguage:true p in + let extension = parse_extension ~module_language:true p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Some (Ast_helper.Str.extension ~attrs ~loc extension) - | token when Grammar.isExprStart token -> - let prevEndPos = p.Parser.endPos in - let exp = parseExpr p in + | token when Grammar.is_expr_start token -> + let prev_end_pos = p.Parser.end_pos in + let exp = parse_expr p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Parser.checkProgress ~prevEndPos ~result:(Ast_helper.Str.eval ~loc ~attrs exp) p + let loc = mk_loc start_pos p.prev_end_pos in + Parser.check_progress ~prev_end_pos ~result:(Ast_helper.Str.eval ~loc ~attrs exp) p | _ -> None - and parseJsImport ~startPos ~attrs p = + and parse_js_import ~start_pos ~attrs p = Parser.expect Token.Import p; - let importSpec = match p.Parser.token with + let import_spec = match p.Parser.token with | Token.Lident _ | Token.At -> - let decl = match parseJsFfiDeclaration p with + let decl = match parse_js_ffi_declaration p with | Some decl -> decl | None -> assert false in JsFfi.Default decl - | _ -> JsFfi.Spec(parseJsFfiDeclarations p) + | _ -> JsFfi.Spec(parse_js_ffi_declarations p) in - let scope = parseJsFfiScope p in - let loc = mkLoc startPos p.prevEndPos in - JsFfi.importDescr ~attrs ~importSpec ~scope ~loc + let scope = parse_js_ffi_scope p in + let loc = mk_loc start_pos p.prev_end_pos in + JsFfi.import_descr ~attrs ~import_spec ~scope ~loc - and parseJsExport ~attrs p = - let exportStart = p.Parser.startPos in + and parse_js_export ~attrs p = + let export_start = p.Parser.start_pos in Parser.expect Token.Export p; - let exportLoc = mkLoc exportStart p.prevEndPos in - let genTypeAttr = (Location.mkloc "genType" exportLoc, Parsetree.PStr []) in - let attrs = genTypeAttr::attrs in + let export_loc = mk_loc export_start p.prev_end_pos in + let gen_type_attr = (Location.mkloc "genType" export_loc, Parsetree.PStr []) in + let attrs = gen_type_attr::attrs in match p.Parser.token with | Typ -> - begin match parseTypeDefinitionOrExtension ~attrs p with - | TypeDef {recFlag; types} -> - Ast_helper.Str.type_ recFlag types + begin match parse_type_definition_or_extension ~attrs p with + | TypeDef {rec_flag; types} -> + Ast_helper.Str.type_ rec_flag types | TypeExt(ext) -> Ast_helper.Str.type_extension ext end | (* Let *) _ -> - let (recFlag, letBindings) = parseLetBindings ~attrs p in - Ast_helper.Str.value recFlag letBindings + let (rec_flag, let_bindings) = parse_let_bindings ~attrs p in + Ast_helper.Str.value rec_flag let_bindings - and parseJsFfiScope p = + and parse_js_ffi_scope p = match p.Parser.token with | Token.Lident "from" -> Parser.next p; begin match p.token with | String s -> Parser.next p; JsFfi.Module s | Uident _ | Lident _ -> - let value = parseIdentPath p in + let value = parse_ident_path p in JsFfi.Scope value | _ -> JsFfi.Global end | _ -> JsFfi.Global - and parseJsFfiDeclarations p = + and parse_js_ffi_declarations p = Parser.expect Token.Lbrace p; - let decls = parseCommaDelimitedRegion + let decls = parse_comma_delimited_region ~grammar:Grammar.JsFfiImport ~closing:Rbrace - ~f:parseJsFfiDeclaration + ~f:parse_js_ffi_declaration p in Parser.expect Rbrace p; decls - and parseJsFfiDeclaration p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in + and parse_js_ffi_declaration p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in match p.Parser.token with | Lident _ -> - let (ident, _) = parseLident p in + let (ident, _) = parse_lident p in let alias = match p.token with | As -> Parser.next p; - let (ident, _) = parseLident p in + let (ident, _) = parse_lident p in ident | _ -> ident in Parser.expect Token.Colon p; - let typ = parseTypExpr p in - let loc = mkLoc startPos p.prevEndPos in + let typ = parse_typ_expr p in + let loc = mk_loc start_pos p.prev_end_pos in Some (JsFfi.decl ~loc ~alias ~attrs ~name:ident ~typ) | _ -> None (* include-statement ::= include module-expr *) - and parseIncludeStatement ~attrs p = - let startPos = p.Parser.startPos in + and parse_include_statement ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Token.Include p; - let modExpr = parseModuleExpr p in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Incl.mk ~loc ~attrs modExpr + 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 - and parseAtomicModuleExpr p = - let startPos = p.Parser.startPos in + and parse_atomic_module_expr p = + let start_pos = p.Parser.start_pos in match p.Parser.token with | Uident _ident -> - let longident = parseModuleLongIdent ~lowercase:false p in + let longident = parse_module_long_ident ~lowercase:false p in Ast_helper.Mod.ident ~loc:longident.loc longident | Lbrace -> Parser.next p; let structure = Ast_helper.Mod.structure ( - parseDelimitedRegion + parse_delimited_region ~grammar:Grammar.Structure ~closing:Rbrace - ~f:parseStructureItemRegion + ~f:parse_structure_item_region p ) in Parser.expect Rbrace p; - let endPos = p.prevEndPos in - {structure with pmod_loc = mkLoc startPos endPos} + let end_pos = p.prev_end_pos in + {structure with pmod_loc = mk_loc start_pos end_pos} | Lparen -> Parser.next p; - let modExpr = match p.token with + let mod_expr = match p.token with | Rparen -> - Ast_helper.Mod.structure ~loc:(mkLoc startPos p.prevEndPos) [] + Ast_helper.Mod.structure ~loc:(mk_loc start_pos p.prev_end_pos) [] | _ -> - parseConstrainedModExpr p + parse_constrained_mod_expr p in Parser.expect Rparen p; - modExpr + mod_expr | Lident "unpack" -> (* TODO: should this be made a keyword?? *) Parser.next p; Parser.expect Lparen p; - let expr = parseExpr p in + let expr = parse_expr p in begin match p.Parser.token with | Colon -> - let colonStart = p.Parser.startPos in + let colon_start = p.Parser.start_pos in Parser.next p; - let attrs = parseAttributes p in - let packageType = parsePackageType ~startPos:colonStart ~attrs p in + let attrs = parse_attributes p in + let package_type = parse_package_type ~start_pos:colon_start ~attrs p in Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in - let constraintExpr = Ast_helper.Exp.constraint_ + let loc = mk_loc start_pos p.prev_end_pos in + let constraint_expr = Ast_helper.Exp.constraint_ ~loc - expr packageType + expr package_type in - Ast_helper.Mod.unpack ~loc constraintExpr + Ast_helper.Mod.unpack ~loc constraint_expr | _ -> Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Mod.unpack ~loc expr end | Percent -> - let extension = parseExtension p in - let loc = mkLoc startPos p.prevEndPos in + let extension = parse_extension p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Mod.extension ~loc extension | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Recover.defaultModuleExpr() + Recover.default_module_expr() - and parsePrimaryModExpr p = - let startPos = p.Parser.startPos in - let modExpr = parseAtomicModuleExpr p in - let rec loop p modExpr = + 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 = match p.Parser.token with - | Lparen when p.prevEndPos.pos_lnum == p.startPos.pos_lnum -> - loop p (parseModuleApplication p modExpr) - | _ -> modExpr + | Lparen when p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> + loop p (parse_module_application p mod_expr) + | _ -> mod_expr in - let modExpr = loop p modExpr in - {modExpr with pmod_loc = mkLoc startPos p.prevEndPos} + let mod_expr = loop p mod_expr in + {mod_expr with pmod_loc = mk_loc start_pos p.prev_end_pos} (* * functor-arg ::= @@ -17404,89 +17404,89 @@ end * | modtype --> "punning" for _ : modtype * | attributes functor-arg *) - and parseFunctorArg p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in + and parse_functor_arg p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in match p.Parser.token with | Uident ident -> Parser.next p; - let uidentEndPos = p.prevEndPos in + let uident_end_pos = p.prev_end_pos in begin match p.Parser.token with | Colon -> Parser.next p; - let moduleType = parseModuleType p in - let loc = mkLoc startPos uidentEndPos in - let argName = Location.mkloc ident loc in - Some (attrs, argName, Some moduleType, startPos) + 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) | Dot -> Parser.next p; - let moduleType = - let moduleLongIdent = - parseModuleLongIdentTail ~lowercase:false p startPos (Longident.Lident ident) in - Ast_helper.Mty.ident ~loc:moduleLongIdent.loc moduleLongIdent + let module_type = + let module_long_ident = + parse_module_long_ident_tail ~lowercase:false p start_pos (Longident.Lident ident) in + Ast_helper.Mty.ident ~loc:module_long_ident.loc module_long_ident in - let argName = Location.mknoloc "_" in - Some (attrs, argName, Some moduleType, startPos) + 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) + 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) end | Underscore -> Parser.next p; - let argName = Location.mkloc "_" (mkLoc startPos p.prevEndPos) in + let arg_name = Location.mkloc "_" (mk_loc start_pos p.prev_end_pos) in Parser.expect Colon p; - let moduleType = parseModuleType p in - Some (attrs, argName, Some moduleType, startPos) + let module_type = parse_module_type p in + Some (attrs, arg_name, Some module_type, start_pos) | _ -> None - and parseFunctorArgs p = - let startPos = p.Parser.startPos in + and parse_functor_args p = + let start_pos = p.Parser.start_pos in Parser.expect Lparen p; let args = - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.FunctorArgs ~closing:Rparen - ~f:parseFunctorArg + ~f:parse_functor_arg p in Parser.expect Rparen p; match args with | [] -> - [[], Location.mkloc "*" (mkLoc startPos p.prevEndPos), None, startPos] + [[], Location.mkloc "*" (mk_loc start_pos p.prev_end_pos), None, start_pos] | args -> args - and parseFunctorModuleExpr p = - let startPos = p.Parser.startPos in - let args = parseFunctorArgs p in - let returnType = match p.Parser.token with + and parse_functor_module_expr p = + let start_pos = p.Parser.start_pos in + let args = parse_functor_args p in + let return_type = match p.Parser.token with | Colon -> Parser.next p; - Some (parseModuleType ~es6Arrow:false p) + Some (parse_module_type ~es6_arrow:false p) | _ -> None in Parser.expect EqualGreater p; - let rhsModuleExpr = - let modExpr = parseModuleExpr p in - match returnType with - | Some modType -> + let rhs_module_expr = + let mod_expr = parse_module_expr p in + match return_type with + | Some mod_type -> Ast_helper.Mod.constraint_ - ~loc:(mkLoc modExpr.pmod_loc.loc_start modType.Parsetree.pmty_loc.loc_end) - modExpr modType - | None -> modExpr + ~loc:(mk_loc mod_expr.pmod_loc.loc_start mod_type.Parsetree.pmty_loc.loc_end) + mod_expr mod_type + | None -> mod_expr in - let endPos = p.prevEndPos in - let modExpr = List.fold_right (fun (attrs, name, moduleType, startPos) acc -> + let end_pos = p.prev_end_pos in + let mod_expr = List.fold_right (fun (attrs, name, module_type, start_pos) acc -> Ast_helper.Mod.functor_ - ~loc:(mkLoc startPos endPos) + ~loc:(mk_loc start_pos end_pos) ~attrs - name moduleType acc - ) args rhsModuleExpr + name module_type acc + ) args rhs_module_expr in - {modExpr with pmod_loc = mkLoc startPos endPos} + {mod_expr with pmod_loc = mk_loc start_pos end_pos} (* module-expr ::= * | module-path @@ -17497,209 +17497,209 @@ end * ∣ ( module-expr : module-type ) * | extension * | attributes module-expr *) - and parseModuleExpr p = - let attrs = parseAttributes p in - let modExpr = if isEs6ArrowFunctor p then - parseFunctorModuleExpr p + and parse_module_expr p = + let attrs = parse_attributes p in + let mod_expr = if is_es6_arrow_functor p then + parse_functor_module_expr p else - parsePrimaryModExpr p + parse_primary_mod_expr p in - {modExpr with pmod_attributes = List.concat [modExpr.pmod_attributes; attrs]} + {mod_expr with pmod_attributes = List.concat [mod_expr.pmod_attributes; attrs]} - and parseConstrainedModExpr p = - let modExpr = parseModuleExpr p in + and parse_constrained_mod_expr p = + let mod_expr = parse_module_expr p in match p.Parser.token with | Colon -> Parser.next 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) + 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) else None - and parseModuleApplication p modExpr = - let startPos = p.Parser.startPos in + and parse_module_application p mod_expr = + let start_pos = p.Parser.start_pos in Parser.expect Lparen p; let args = - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.ModExprList ~closing:Rparen - ~f:parseConstrainedModExprRegion + ~f:parse_constrained_mod_expr_region p in Parser.expect Rparen p; let args = match args with | [] -> - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in [Ast_helper.Mod.structure ~loc []] | args -> args in - List.fold_left (fun modExpr arg -> + List.fold_left (fun mod_expr arg -> Ast_helper.Mod.apply - ~loc:(mkLoc modExpr.Parsetree.pmod_loc.loc_start arg.Parsetree.pmod_loc.loc_end) - modExpr arg - ) modExpr args + ~loc:(mk_loc mod_expr.Parsetree.pmod_loc.loc_start arg.Parsetree.pmod_loc.loc_end) + mod_expr arg + ) mod_expr args - and parseModuleOrModuleTypeImplOrPackExpr ~attrs p = - let startPos = p.Parser.startPos in + and parse_module_or_module_type_impl_or_pack_expr ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Module p; match p.Parser.token with - | Typ -> parseModuleTypeImpl ~attrs startPos p + | Typ -> parse_module_type_impl ~attrs start_pos p | Lparen -> - let expr = parseFirstClassModuleExpr ~startPos p in + let expr = parse_first_class_module_expr ~start_pos p in Ast_helper.Str.eval ~attrs expr - | _ -> parseMaybeRecModuleBinding ~attrs ~startPos p + | _ -> parse_maybe_rec_module_binding ~attrs ~start_pos p - and parseModuleTypeImpl ~attrs startPos p = + and parse_module_type_impl ~attrs start_pos p = Parser.expect Typ p; - let nameStart = p.Parser.startPos in + let name_start = p.Parser.start_pos in let name = match p.Parser.token with | List -> Parser.next p; - let loc = mkLoc nameStart p.prevEndPos in + let loc = mk_loc name_start p.prev_end_pos in Location.mkloc "list" loc | Lident ident -> Parser.next p; - let loc = mkLoc nameStart p.prevEndPos in + let loc = mk_loc name_start p.prev_end_pos in Location.mkloc ident loc | Uident ident -> Parser.next p; - let loc = mkLoc nameStart p.prevEndPos in + let loc = mk_loc name_start p.prev_end_pos in Location.mkloc ident loc | t -> Parser.err p (Diagnostics.uident t); Location.mknoloc "_" in Parser.expect Equal p; - let moduleType = parseModuleType p in - let moduleTypeDeclaration = + let module_type = parse_module_type p in + let module_type_declaration = Ast_helper.Mtd.mk ~attrs - ~loc:(mkLoc nameStart p.prevEndPos) - ~typ:moduleType + ~loc:(mk_loc name_start p.prev_end_pos) + ~typ:module_type name in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Str.modtype ~loc moduleTypeDeclaration + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Str.modtype ~loc module_type_declaration (* definition ::= ∣ module rec module-name : module-type = module-expr { and module-name : module-type = module-expr } *) - and parseMaybeRecModuleBinding ~attrs ~startPos p = + and parse_maybe_rec_module_binding ~attrs ~start_pos p = match p.Parser.token with | Token.Rec -> Parser.next p; - Ast_helper.Str.rec_module (parseModuleBindings ~startPos ~attrs p) + Ast_helper.Str.rec_module (parse_module_bindings ~start_pos ~attrs p) | _ -> - Ast_helper.Str.module_ (parseModuleBinding ~attrs ~startPos:p.Parser.startPos p) + Ast_helper.Str.module_ (parse_module_binding ~attrs ~start_pos:p.Parser.start_pos p) - and parseModuleBinding ~attrs ~startPos p = + and parse_module_binding ~attrs ~start_pos p = let name = match p.Parser.token with | Uident ident -> - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Location.mkloc ident loc | t -> Parser.err p (Diagnostics.uident t); Location.mknoloc "_" in - let body = parseModuleBindingBody p in - let loc = mkLoc startPos p.prevEndPos in + let body = parse_module_binding_body p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Mb.mk ~attrs ~loc name body - and parseModuleBindingBody p = + and parse_module_binding_body p = (* TODO: make required with good error message when rec module binding *) - let returnModType = match p.Parser.token with + let return_mod_type = match p.Parser.token with | Colon -> Parser.next p; - Some (parseModuleType p) + Some (parse_module_type p) | _ -> None in Parser.expect Equal p; - let modExpr = parseModuleExpr p in - match returnModType with - | Some modType -> + let mod_expr = parse_module_expr p in + match return_mod_type with + | Some mod_type -> Ast_helper.Mod.constraint_ - ~loc:(mkLoc modType.pmty_loc.loc_start modExpr.pmod_loc.loc_end) - modExpr modType - | None -> modExpr + ~loc:(mk_loc mod_type.pmty_loc.loc_start mod_expr.pmod_loc.loc_end) + mod_expr mod_type + | None -> mod_expr (* module-name : module-type = module-expr * { and module-name : module-type = module-expr } *) - and parseModuleBindings ~attrs ~startPos p = + and parse_module_bindings ~attrs ~start_pos p = let rec loop p acc = - let startPos = p.Parser.startPos in - let attrs = parseAttributesAndBinding p in + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes_and_binding p in match p.Parser.token with | And -> Parser.next p; ignore(Parser.optional p Module); (* over-parse for fault-tolerance *) - let modBinding = parseModuleBinding ~attrs ~startPos p in - loop p (modBinding::acc) + let mod_binding = parse_module_binding ~attrs ~start_pos p in + loop p (mod_binding::acc) | _ -> List.rev acc in - let first = parseModuleBinding ~attrs ~startPos p in + let first = parse_module_binding ~attrs ~start_pos p in loop p [first] - and parseAtomicModuleType p = - let startPos = p.Parser.startPos in - let moduleType = match p.Parser.token with + and parse_atomic_module_type p = + let start_pos = p.Parser.start_pos in + let module_type = match p.Parser.token with | Uident _ | Lident _ | List -> (* Ocaml allows module types to end with lowercase: module Foo : bar = { ... } * lets go with uppercase terminal for now *) - let moduleLongIdent = parseModuleLongIdent ~lowercase:true p in - Ast_helper.Mty.ident ~loc:moduleLongIdent.loc moduleLongIdent + let module_long_ident = parse_module_long_ident ~lowercase:true p in + Ast_helper.Mty.ident ~loc:module_long_ident.loc module_long_ident | Lparen -> Parser.next p; - let mty = parseModuleType p in + let mty = parse_module_type p in Parser.expect Rparen p; - {mty with pmty_loc = mkLoc startPos p.prevEndPos} + {mty with pmty_loc = mk_loc start_pos p.prev_end_pos} | Lbrace -> Parser.next p; let spec = - parseDelimitedRegion + parse_delimited_region ~grammar:Grammar.Signature ~closing:Rbrace - ~f:parseSignatureItemRegion + ~f:parse_signature_item_region p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Mty.signature ~loc spec | Module -> (* TODO: check if this is still atomic when implementing first class modules*) - parseModuleTypeOf p + parse_module_type_of p | Percent -> - let extension = parseExtension p in - let loc = mkLoc startPos p.prevEndPos in + let extension = parse_extension p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Mty.extension ~loc extension | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Recover.defaultModuleType() + Recover.default_module_type() in - let moduleTypeLoc = mkLoc startPos p.prevEndPos in - {moduleType with pmty_loc = moduleTypeLoc} + let module_type_loc = mk_loc start_pos p.prev_end_pos in + {module_type with pmty_loc = module_type_loc} - and parseFunctorModuleType p = - let startPos = p.Parser.startPos in - let args = parseFunctorArgs p in + and parse_functor_module_type p = + let start_pos = p.Parser.start_pos in + let args = parse_functor_args p in Parser.expect EqualGreater p; - let rhs = parseModuleType p in - let endPos = p.prevEndPos in - let modType = List.fold_right (fun (attrs, name, moduleType, startPos) acc -> + let rhs = parse_module_type p in + let end_pos = p.prev_end_pos in + let mod_type = List.fold_right (fun (attrs, name, module_type, start_pos) acc -> Ast_helper.Mty.functor_ - ~loc:(mkLoc startPos endPos) + ~loc:(mk_loc start_pos end_pos) ~attrs - name moduleType acc + name module_type acc ) args rhs in - {modType with pmty_loc = mkLoc startPos endPos} + {mod_type with pmty_loc = mk_loc start_pos end_pos} (* Module types are the module-level equivalent of type expressions: they * specify the general shape and type properties of modules. @@ -17715,47 +17715,47 @@ end * | module-type with-mod-constraints * | extension *) - and parseModuleType ?(es6Arrow=true) ?(with_=true) p = - let attrs = parseAttributes p in - let modty = if es6Arrow && isEs6ArrowFunctor p then - parseFunctorModuleType p + and parse_module_type ?(es6_arrow=true) ?(with_=true) p = + let attrs = parse_attributes p in + let modty = if es6_arrow && is_es6_arrow_functor p then + parse_functor_module_type p else - let modty = parseAtomicModuleType p in + let modty = parse_atomic_module_type p in match p.Parser.token with - | EqualGreater when es6Arrow == true -> + | EqualGreater when es6_arrow == true -> Parser.next p; - let rhs = parseModuleType ~with_:false p in + let rhs = parse_module_type ~with_:false p in let str = Location.mknoloc "_" in - let loc = mkLoc modty.pmty_loc.loc_start p.prevEndPos in + let loc = mk_loc modty.pmty_loc.loc_start p.prev_end_pos in Ast_helper.Mty.functor_ ~loc str (Some modty) rhs | _ -> modty in - let moduleType = { modty with + let module_type = { modty with pmty_attributes = List.concat [modty.pmty_attributes; attrs] } in if with_ then - parseWithConstraints moduleType p - else moduleType + parse_with_constraints module_type p + else module_type - and parseWithConstraints moduleType p = + and parse_with_constraints module_type p = match p.Parser.token with | With -> Parser.next p; - let first = parseWithConstraint p in + let first = parse_with_constraint p in let rec loop p acc = match p.Parser.token with | And -> Parser.next p; - loop p ((parseWithConstraint p)::acc) + loop p ((parse_with_constraint p)::acc) | _ -> List.rev acc in let constraints = loop p [first] in - let loc = mkLoc moduleType.pmty_loc.loc_start p.prevEndPos in - Ast_helper.Mty.with_ ~loc moduleType constraints + let loc = mk_loc module_type.pmty_loc.loc_start p.prev_end_pos in + Ast_helper.Mty.with_ ~loc module_type constraints | _ -> - moduleType + module_type (* mod-constraint ::= * | type typeconstr type-equation type-constraints? @@ -17764,181 +17764,181 @@ end * ∣ module module-path := extended-module-path * * TODO: split this up into multiple functions, better errors *) - and parseWithConstraint p = + and parse_with_constraint p = match p.Parser.token with | Module -> Parser.next p; - let modulePath = parseModuleLongIdent ~lowercase:false p in + let module_path = parse_module_long_ident ~lowercase:false p in begin match p.Parser.token with | ColonEqual -> Parser.next p; - let lident = parseModuleLongIdent ~lowercase:false p in - Parsetree.Pwith_modsubst (modulePath, lident) + let lident = parse_module_long_ident ~lowercase:false p in + Parsetree.Pwith_modsubst (module_path, lident) | Equal -> Parser.next p; - let lident = parseModuleLongIdent ~lowercase:false p in - Parsetree.Pwith_module (modulePath, lident) + let lident = parse_module_long_ident ~lowercase:false p in + Parsetree.Pwith_module (module_path, lident) | token -> (* TODO: revisit *) Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - let lident = parseModuleLongIdent ~lowercase:false p in - Parsetree.Pwith_modsubst (modulePath, lident) + let lident = parse_module_long_ident ~lowercase:false p in + Parsetree.Pwith_modsubst (module_path, lident) end | Typ -> Parser.next p; - let typeConstr = parseValuePath p in - let params = parseTypeParams ~parent:typeConstr p in + let type_constr = parse_value_path p in + let params = parse_type_params ~parent:type_constr p in begin match p.Parser.token with | ColonEqual -> Parser.next p; - let typExpr = parseTypExpr p in + let typ_expr = parse_typ_expr p in Parsetree.Pwith_typesubst ( - typeConstr, + type_constr, Ast_helper.Type.mk - ~loc:typeConstr.loc + ~loc:type_constr.loc ~params - ~manifest:typExpr - (Location.mkloc (Longident.last typeConstr.txt) typeConstr.loc) + ~manifest:typ_expr + (Location.mkloc (Longident.last type_constr.txt) type_constr.loc) ) | Equal -> Parser.next p; - let typExpr = parseTypExpr p in - let typeConstraints = parseTypeConstraints p in + let typ_expr = parse_typ_expr p in + let type_constraints = parse_type_constraints p in Parsetree.Pwith_type ( - typeConstr, + type_constr, Ast_helper.Type.mk - ~loc:typeConstr.loc + ~loc:type_constr.loc ~params - ~manifest:typExpr - ~cstrs:typeConstraints - (Location.mkloc (Longident.last typeConstr.txt) typeConstr.loc) + ~manifest:typ_expr + ~cstrs:type_constraints + (Location.mkloc (Longident.last type_constr.txt) type_constr.loc) ) | token -> (* TODO: revisit *) Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - let typExpr = parseTypExpr p in - let typeConstraints = parseTypeConstraints p in + let typ_expr = parse_typ_expr p in + let type_constraints = parse_type_constraints p in Parsetree.Pwith_type ( - typeConstr, + type_constr, Ast_helper.Type.mk - ~loc:typeConstr.loc + ~loc:type_constr.loc ~params - ~manifest:typExpr - ~cstrs:typeConstraints - (Location.mkloc (Longident.last typeConstr.txt) typeConstr.loc) + ~manifest:typ_expr + ~cstrs:type_constraints + (Location.mkloc (Longident.last type_constr.txt) type_constr.loc) ) end | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); exit (-1) (* TODO: handle this case *) - and parseModuleTypeOf p = - let startPos = p.Parser.startPos in + and parse_module_type_of p = + let start_pos = p.Parser.start_pos in Parser.expect Module p; Parser.expect Typ p; Parser.expect Of p; - let moduleExpr = parseModuleExpr p in - Ast_helper.Mty.typeof_ ~loc:(mkLoc startPos p.prevEndPos) moduleExpr + let module_expr = parse_module_expr p in + Ast_helper.Mty.typeof_ ~loc:(mk_loc start_pos p.prev_end_pos) module_expr (* module signature on the file level *) - and parseSpecification p = - parseRegion ~grammar:Grammar.Specification ~f:parseSignatureItemRegion p - [@@progress (Parser.next, Parser.expect, Parser.checkProgress)] + and parse_specification p = + parse_region ~grammar:Grammar.Specification ~f:parse_signature_item_region p + [@@progress (Parser.next, Parser.expect, Parser.check_progress)] - and parseSignatureItemRegion p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in + and parse_signature_item_region p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in match p.Parser.token with | Let -> - Parser.beginRegion p; - let valueDesc = parseSignLetDesc ~attrs p in + Parser.begin_region p; + let value_desc = parse_sign_let_desc ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Parser.endRegion p; - Some (Ast_helper.Sig.value ~loc valueDesc) + let loc = mk_loc start_pos p.prev_end_pos in + Parser.end_region p; + Some (Ast_helper.Sig.value ~loc value_desc) | Typ -> - Parser.beginRegion p; - begin match parseTypeDefinitionOrExtension ~attrs p with - | TypeDef {recFlag; types} -> + Parser.begin_region p; + begin match parse_type_definition_or_extension ~attrs p with + | TypeDef {rec_flag; types} -> Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Parser.endRegion p; - Some (Ast_helper.Sig.type_ ~loc recFlag types) + let loc = mk_loc start_pos p.prev_end_pos in + Parser.end_region p; + Some (Ast_helper.Sig.type_ ~loc rec_flag types) | TypeExt(ext) -> Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Parser.endRegion p; + let loc = mk_loc start_pos p.prev_end_pos in + Parser.end_region p; Some (Ast_helper.Sig.type_extension ~loc ext) end | External -> - let externalDef = parseExternalDef ~attrs p in + let external_def = parse_external_def ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Sig.value ~loc externalDef) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Sig.value ~loc external_def) | Exception -> - let exceptionDef = parseExceptionDef ~attrs p in + let exception_def = parse_exception_def ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Sig.exception_ ~loc exceptionDef) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Sig.exception_ ~loc exception_def) | Open -> - let openDescription = parseOpenDescription ~attrs p in + let open_description = parse_open_description ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Sig.open_ ~loc openDescription) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Sig.open_ ~loc open_description) | Include -> Parser.next p; - let moduleType = parseModuleType p in - let includeDescription = Ast_helper.Incl.mk - ~loc:(mkLoc startPos p.prevEndPos) + 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 - moduleType + module_type in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Sig.include_ ~loc includeDescription) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Sig.include_ ~loc include_description) | Module -> Parser.next p; begin match p.Parser.token with | Uident _ -> - let modDecl = parseModuleDeclarationOrAlias ~attrs p in + let mod_decl = parse_module_declaration_or_alias ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Sig.module_ ~loc modDecl) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Sig.module_ ~loc mod_decl) | Rec -> - let recModule = parseRecModuleSpec ~attrs ~startPos p in + let rec_module = parse_rec_module_spec ~attrs ~start_pos p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Sig.rec_module ~loc recModule) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Sig.rec_module ~loc rec_module) | Typ -> - Some (parseModuleTypeDeclaration ~attrs ~startPos p) + Some (parse_module_type_declaration ~attrs ~start_pos p) | _t -> - let modDecl = parseModuleDeclarationOrAlias ~attrs p in + let mod_decl = parse_module_declaration_or_alias ~attrs p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Sig.module_ ~loc modDecl) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Sig.module_ ~loc mod_decl) end | AtAt -> - let attr = parseStandaloneAttribute p in + let attr = parse_standalone_attribute p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Some (Ast_helper.Sig.attribute ~loc attr) | PercentPercent -> - let extension = parseExtension ~moduleLanguage:true p in + let extension = parse_extension ~module_language:true p in Parser.optional p Semicolon |> ignore; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Some (Ast_helper.Sig.extension ~attrs ~loc extension) | Import -> Parser.next p; - parseSignatureItemRegion p + parse_signature_item_region p | _ -> None (* module rec module-name : module-type { and module-name: module-type } *) - and parseRecModuleSpec ~attrs ~startPos p = + and parse_rec_module_spec ~attrs ~start_pos p = Parser.expect Rec p; let rec loop p spec = - let startPos = p.Parser.startPos in - let attrs = parseAttributesAndBinding p in + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes_and_binding p in match p.Parser.token with | And -> (* TODO: give a good error message when with constraint, no parens @@ -17948,34 +17948,34 @@ end * `with-constraint` *) Parser.expect And p; - let decl = parseRecModuleDeclaration ~attrs ~startPos p in + let decl = parse_rec_module_declaration ~attrs ~start_pos p in loop p (decl::spec) | _ -> List.rev spec in - let first = parseRecModuleDeclaration ~attrs ~startPos p in + let first = parse_rec_module_declaration ~attrs ~start_pos p in loop p [first] (* module-name : module-type *) - and parseRecModuleDeclaration ~attrs ~startPos p = + and parse_rec_module_declaration ~attrs ~start_pos p = let name = match p.Parser.token with - | Uident modName -> - let loc = mkLoc p.startPos p.endPos in + | Uident mod_name -> + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; - Location.mkloc modName loc + Location.mkloc mod_name loc | t -> Parser.err p (Diagnostics.uident t); Location.mknoloc "_" in Parser.expect Colon p; - let modType = parseModuleType p in - Ast_helper.Md.mk ~loc:(mkLoc startPos p.prevEndPos) ~attrs name modType + 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 - and parseModuleDeclarationOrAlias ~attrs p = - let startPos = p.Parser.startPos in - let moduleName = match p.Parser.token with + and parse_module_declaration_or_alias ~attrs p = + let start_pos = p.Parser.start_pos in + let module_name = match p.Parser.token with | Uident ident -> - let loc = mkLoc p.Parser.startPos p.endPos in + let loc = mk_loc p.Parser.start_pos p.end_pos in Parser.next p; Location.mkloc ident loc | t -> @@ -17985,27 +17985,27 @@ end let body = match p.Parser.token with | Colon -> Parser.next p; - parseModuleType p + parse_module_type p | Equal -> Parser.next p; - let lident = parseModuleLongIdent ~lowercase:false p in + let lident = parse_module_long_ident ~lowercase:false p in Ast_helper.Mty.alias lident | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Recover.defaultModuleType() + Recover.default_module_type() in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Md.mk ~loc ~attrs moduleName body + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Md.mk ~loc ~attrs module_name body - and parseModuleTypeDeclaration ~attrs ~startPos p = + and parse_module_type_declaration ~attrs ~start_pos p = Parser.expect Typ p; - let moduleName = match p.Parser.token with + let module_name = match p.Parser.token with | Uident ident -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Location.mkloc ident loc | Lident ident -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Location.mkloc ident loc | t -> @@ -18015,27 +18015,27 @@ end let typ = match p.Parser.token with | Equal -> Parser.next p; - Some (parseModuleType p) + Some (parse_module_type p) | _ -> None in - let moduleDecl = Ast_helper.Mtd.mk ~attrs ?typ moduleName in - Ast_helper.Sig.modtype ~loc:(mkLoc startPos p.prevEndPos) moduleDecl + 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 - and parseSignLetDesc ~attrs p = - let startPos = p.Parser.startPos in + and parse_sign_let_desc ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Let p; - let (name, loc) = parseLident p in + let (name, loc) = parse_lident p in let name = Location.mkloc name loc in Parser.expect Colon p; - let typExpr = parsePolyTypeExpr p in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Val.mk ~loc ~attrs name typExpr + 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 (* attr-id ::= lowercase-ident ∣ capitalized-ident ∣ attr-id . attr-id *) - and parseAttributeId p = - let startPos = p.Parser.startPos in + and parse_attribute_id p = + let start_pos = p.Parser.start_pos in let rec loop p acc = match p.Parser.token with | Lident ident | Uident ident -> @@ -18045,9 +18045,9 @@ end | Dot -> Parser.next p; loop p (id ^ ".") | _ -> id end - | token when Token.isKeyword token -> + | token when Token.is_keyword token -> Parser.next p; - let id = acc ^ (Token.toString token) in + let id = acc ^ (Token.to_string token) in begin match p.Parser.token with | Dot -> Parser.next p; loop p (id ^ ".") | _ -> id @@ -18057,8 +18057,8 @@ end acc in let id = loop p "" in - let endPos = p.prevEndPos in - Location.mkloc id (mkLoc startPos endPos) + let end_pos = p.prev_end_pos in + Location.mkloc id (mk_loc start_pos end_pos) (* * payload ::= empty @@ -18070,21 +18070,21 @@ end * Also what about type-expressions and specifications? * @attr(:myType) ??? *) - and parsePayload p = + and parse_payload p = match p.Parser.token with - | Lparen when p.startPos.pos_cnum = p.prevEndPos.pos_cnum -> + | Lparen when p.start_pos.pos_cnum = p.prev_end_pos.pos_cnum -> Parser.next p; begin match p.token with | Colon -> Parser.next p; - let typ = parseTypExpr p in + let typ = parse_typ_expr p in Parser.expect Rparen p; Parsetree.PTyp typ | _ -> - let items = parseDelimitedRegion + let items = parse_delimited_region ~grammar:Grammar.Structure ~closing:Rparen - ~f:parseStructureItemRegion + ~f:parse_structure_item_region p in Parser.expect Rparen p; @@ -18093,30 +18093,30 @@ end | _ -> Parsetree.PStr [] (* type attribute = string loc * payload *) - and parseAttribute p = + and parse_attribute p = match p.Parser.token with | At -> Parser.next p; - let attrId = parseAttributeId p in - let payload = parsePayload p in - Some(attrId, payload) + let attr_id = parse_attribute_id p in + let payload = parse_payload p in + Some(attr_id, payload) | _ -> None - and parseAttributes p = - parseRegion p + and parse_attributes p = + parse_region p ~grammar:Grammar.Attribute - ~f:parseAttribute + ~f:parse_attribute (* * standalone-attribute ::= * | @@ atribute-id * | @@ attribute-id ( structure-item ) *) - and parseStandaloneAttribute p = + and parse_standalone_attribute p = Parser.expect AtAt p; - let attrId = parseAttributeId p in - let payload = parsePayload p in - (attrId, payload) + let attr_id = parse_attribute_id p in + let payload = parse_payload p in + (attr_id, payload) (* extension ::= % attr-id attr-payload * | %% attr-id( @@ -18151,14 +18151,14 @@ end * * ~moduleLanguage represents whether we're on the module level or not *) - and parseExtension ?(moduleLanguage=false) p = - if moduleLanguage then + and parse_extension ?(module_language=false) p = + if module_language then Parser.expect PercentPercent p else Parser.expect Percent p; - let attrId = parseAttributeId p in - let payload = parsePayload p in - (attrId, payload) + let attr_id = parse_attribute_id p in + let payload = parse_payload p in + (attr_id, payload) end module OutcomePrinter: sig @@ -18181,7 +18181,7 @@ end = struct let parenthesized_ident _name = true (* TODO: better allocation strategy for the buffer *) - let escapeStringContents s = + let escape_string_contents s = let len = String.length s in let b = Buffer.create len in for i = 0 to len - 1 do @@ -18222,198 +18222,198 @@ end = struct print_ident fmt id2; Format.pp_print_char fmt ')' *) - let rec printOutIdentDoc (ident : Outcometree.out_ident) = + let rec print_out_ident_doc (ident : Outcometree.out_ident) = match ident with | Oide_ident s -> Doc.text s | Oide_dot (ident, s) -> Doc.concat [ - printOutIdentDoc ident; + print_out_ident_doc ident; Doc.dot; Doc.text s; ] | Oide_apply (call, arg) ->Doc.concat [ - printOutIdentDoc call; + print_out_ident_doc call; Doc.lparen; - printOutIdentDoc arg; + print_out_ident_doc arg; Doc.rparen; ] - let printOutAttributeDoc (outAttribute: Outcometree.out_attribute) = + let print_out_attribute_doc (out_attribute: Outcometree.out_attribute) = Doc.concat [ Doc.text "@"; - Doc.text outAttribute.oattr_name; + Doc.text out_attribute.oattr_name; ] - let printOutAttributesDoc (attrs: Outcometree.out_attribute list) = + let print_out_attributes_doc (attrs: Outcometree.out_attribute list) = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ Doc.group ( - Doc.join ~sep:Doc.line (List.map printOutAttributeDoc attrs) + Doc.join ~sep:Doc.line (List.map print_out_attribute_doc attrs) ); Doc.line; ] - 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 collectFunctorArgs (outModuleType: Outcometree.out_module_type) args = - match outModuleType with - | Omty_functor (lbl, optModType, returnModType) -> - let arg = (lbl, optModType) in - collectFunctorArgs returnModType (arg::args) + 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 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, outModuleType) + (List.rev args, out_module_type) - let rec printOutTypeDoc (outType: Outcometree.out_type) = - match outType with + let rec print_out_type_doc (out_type: Outcometree.out_type) = + match out_type with | Otyp_abstract | Otyp_variant _ (* don't support poly-variants atm *) | Otyp_open -> Doc.nil - | Otyp_alias (typ, aliasTxt) -> + | Otyp_alias (typ, alias_txt) -> Doc.concat [ - printOutTypeDoc typ; + print_out_type_doc typ; Doc.text " as '"; - Doc.text aliasTxt + Doc.text alias_txt ] - | Otyp_constr (outIdent, []) -> - printOutIdentDoc outIdent + | Otyp_constr (out_ident, []) -> + print_out_ident_doc out_ident | Otyp_manifest (typ1, typ2) -> Doc.concat [ - printOutTypeDoc typ1; + print_out_type_doc typ1; Doc.text " = "; - printOutTypeDoc typ2; + print_out_type_doc typ2; ] | Otyp_record record -> - printRecordDeclarationDoc ~inline:true record + print_record_declaration_doc ~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) -> printObjectFields fields rest + | Otyp_object (fields, rest) -> print_object_fields fields rest | Otyp_class _ -> Doc.nil | Otyp_attribute (typ, attribute) -> Doc.group ( Doc.concat [ - printOutAttributeDoc attribute; + print_out_attribute_doc attribute; Doc.line; - printOutTypeDoc typ; + print_out_type_doc typ; ] ) (* example: Red | Blue | Green | CustomColour(float, float, float) *) | Otyp_sum constructors -> - printOutConstructorsDoc constructors + print_out_constructors_doc constructors (* example: {"name": string, "age": int} *) | Otyp_constr ( (Oide_dot ((Oide_ident "Js"), "t")), [Otyp_object (fields, rest)] - ) -> printObjectFields fields rest + ) -> print_object_fields fields rest (* example: node *) - | Otyp_constr (outIdent, args) -> - let argsDoc = match args with + | Otyp_constr (out_ident, args) -> + let args_doc = match args with | [] -> Doc.nil | args -> Doc.concat [ - Doc.lessThan; + Doc.less_than; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printOutTypeDoc args + List.map print_out_type_doc args ) ] ); - Doc.trailingComma; - Doc.softLine; - Doc.greaterThan; + Doc.trailing_comma; + Doc.soft_line; + Doc.greater_than; ] in Doc.group ( Doc.concat [ - printOutIdentDoc outIdent; - argsDoc; + print_out_ident_doc out_ident; + args_doc; ] ) - | Otyp_tuple tupleArgs -> + | Otyp_tuple tuple_args -> Doc.group ( Doc.concat [ Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printOutTypeDoc tupleArgs + List.map print_out_type_doc tuple_args ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) - | Otyp_poly (vars, outType) -> + | Otyp_poly (vars, out_type) -> Doc.group ( Doc.concat [ Doc.join ~sep:Doc.space ( List.map (fun var -> Doc.text ("'" ^ var)) vars ); - printOutTypeDoc outType; + print_out_type_doc out_type; ] ) | Otyp_arrow _ as typ -> - let (typArgs, typ) = collectArrowArgs typ [] in + let (typ_args, typ) = collect_arrow_args typ [] in let args = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( List.map (fun (lbl, typ) -> if lbl = "" then - printOutTypeDoc typ + print_out_type_doc typ else Doc.group ( Doc.concat [ Doc.text ("~" ^ lbl ^ ": "); - printOutTypeDoc typ + print_out_type_doc typ ] ) - ) typArgs + ) typ_args ) in - let argsDoc = - let needsParens = match typArgs with + let args_doc = + let needs_parens = match typ_args with | [_, (Otyp_tuple _ | Otyp_arrow _)] -> true (* single argument should not be wrapped *) | ["", _] -> false | _ -> true in - if needsParens then + if needs_parens then Doc.group ( Doc.concat [ Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; args; ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) else args in Doc.concat [ - argsDoc; + args_doc; Doc.text " => "; - printOutTypeDoc typ; + print_out_type_doc typ; ] | Otyp_module (_modName, _stringList, _outTypes) -> Doc.nil - and printObjectFields fields rest = + and print_object_fields fields rest = let dots = match rest with | Some non_gen -> Doc.text ((if non_gen then "_" else "") ^ "..") | None -> Doc.nil @@ -18424,25 +18424,25 @@ end = struct dots; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun (lbl, outType) -> Doc.group ( + List.map (fun (lbl, out_type) -> Doc.group ( Doc.concat [ Doc.text ("\"" ^ lbl ^ "\": "); - printOutTypeDoc outType; + print_out_type_doc out_type; ] )) fields ) ] ); - Doc.softLine; - Doc.trailingComma; + Doc.soft_line; + Doc.trailing_comma; Doc.rbrace; ] ) - and printOutConstructorsDoc constructors = + and print_out_constructors_doc constructors = Doc.group ( Doc.indent ( Doc.concat [ @@ -18450,8 +18450,8 @@ end = struct Doc.join ~sep:Doc.line ( List.mapi (fun i constructor -> Doc.concat [ - if i > 0 then Doc.text "| " else Doc.ifBreaks (Doc.text "| ") Doc.nil; - printOutConstructorDoc constructor; + if i > 0 then Doc.text "| " else Doc.if_breaks (Doc.text "| ") Doc.nil; + print_out_constructor_doc constructor; ] ) constructors ) @@ -18459,16 +18459,16 @@ end = struct ) ) - and printOutConstructorDoc (name, args, gadt) = - let gadtDoc = match gadt with - | Some outType -> + and print_out_constructor_doc (name, args, gadt) = + let gadt_doc = match gadt with + | Some out_type -> Doc.concat [ Doc.text ": "; - printOutTypeDoc outType + print_out_type_doc out_type ] | None -> Doc.nil in - let argsDoc = match args with + let args_doc = match args with | [] -> Doc.nil | [Otyp_record record] -> (* inline records @@ -18480,7 +18480,7 @@ end = struct Doc.concat [ Doc.lparen; Doc.indent ( - printRecordDeclarationDoc ~inline:true record; + print_record_declaration_doc ~inline:true record; ); Doc.rparen; ] @@ -18490,14 +18490,14 @@ end = struct Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printOutTypeDoc args + List.map print_out_type_doc args ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) @@ -18505,67 +18505,67 @@ end = struct Doc.group ( Doc.concat [ Doc.text name; - argsDoc; - gadtDoc + args_doc; + gadt_doc ] ) - and printRecordDeclRowDoc (name, mut, arg) = + and print_record_decl_row_doc (name, mut, arg) = Doc.group ( Doc.concat [ if mut then Doc.text "mutable " else Doc.nil; Doc.text name; Doc.text ": "; - printOutTypeDoc arg; + print_out_type_doc arg; ] ) - and printRecordDeclarationDoc ~inline rows = + and print_record_declaration_doc ~inline rows = let content = Doc.concat [ Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printRecordDeclRowDoc rows + List.map print_record_decl_row_doc rows ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ] in if not inline then Doc.group content else content - let printOutType fmt outType = + let print_out_type fmt out_type = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutTypeDoc outType)) + (Doc.to_string ~width:80 (print_out_type_doc out_type)) - let printTypeParameterDoc (typ, (co, cn)) = + let print_type_parameter_doc (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 printOutSigItemDoc (outSigItem : Outcometree.out_sig_item) = - match outSigItem with + let rec print_out_sig_item_doc (out_sig_item : Outcometree.out_sig_item) = + match out_sig_item with | Osig_class _ | Osig_class_type _ -> Doc.nil | Osig_ellipsis -> Doc.dotdotdot - | Osig_value valueDecl -> + | Osig_value value_decl -> Doc.group ( Doc.concat [ - printOutAttributesDoc valueDecl.oval_attributes; + print_out_attributes_doc value_decl.oval_attributes; Doc.text ( - match valueDecl.oval_prims with | [] -> "let " | _ -> "external " + match value_decl.oval_prims with | [] -> "let " | _ -> "external " ); - Doc.text valueDecl.oval_name; + Doc.text value_decl.oval_name; Doc.text ":"; Doc.space; - printOutTypeDoc valueDecl.oval_type; - match valueDecl.oval_prims with + print_out_type_doc value_decl.oval_type; + match value_decl.oval_prims with | [] -> Doc.nil | primitives -> Doc.indent ( Doc.concat [ @@ -18578,49 +18578,49 @@ end = struct ) ] ) - | Osig_typext (outExtensionConstructor, _outExtStatus) -> - printOutExtensionConstructorDoc outExtensionConstructor - | Osig_modtype (modName, Omty_signature []) -> + | 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 modName; + Doc.text mod_name; ] - | Osig_modtype (modName, outModuleType) -> + | Osig_modtype (mod_name, out_module_type) -> Doc.group ( Doc.concat [ Doc.text "module type "; - Doc.text modName; + Doc.text mod_name; Doc.text " = "; - printOutModuleTypeDoc outModuleType; + print_out_module_type_doc out_module_type; ] ) - | Osig_module (modName, Omty_alias ident, _) -> + | Osig_module (mod_name, Omty_alias ident, _) -> Doc.group ( Doc.concat [ Doc.text "module "; - Doc.text modName; + Doc.text mod_name; Doc.text " ="; Doc.line; - printOutIdentDoc ident; + print_out_ident_doc ident; ] ) - | Osig_module (modName, outModType, outRecStatus) -> + | Osig_module (mod_name, out_mod_type, out_rec_status) -> Doc.group ( Doc.concat [ Doc.text ( - match outRecStatus with + match out_rec_status with | Orec_not -> "module " | Orec_first -> "module rec " | Orec_next -> "and" ); - Doc.text modName; + Doc.text mod_name; Doc.text " = "; - printOutModuleTypeDoc outModType; + print_out_module_type_doc out_mod_type; ] ) - | Osig_type (outTypeDecl, outRecStatus) -> + | Osig_type (out_type_decl, out_rec_status) -> (* TODO: manifest ? *) - let attrs = match outTypeDecl.otype_immediate, outTypeDecl.otype_unboxed with + let attrs = match out_type_decl.otype_immediate, out_type_decl.otype_unboxed with | false, false -> Doc.nil | true, false -> Doc.concat [Doc.text "@immediate"; Doc.line] @@ -18630,74 +18630,74 @@ end = struct Doc.concat [Doc.text "@immediate @unboxed"; Doc.line] in let kw = Doc.text ( - match outRecStatus with + match out_rec_status with | Orec_not -> "type " | Orec_first -> "type rec " | Orec_next -> "and " ) in - let typeParams = match outTypeDecl.otype_params with + let type_params = match out_type_decl.otype_params with | [] -> Doc.nil | _params -> Doc.group ( Doc.concat [ - Doc.lessThan; + Doc.less_than; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printTypeParameterDoc outTypeDecl.otype_params + List.map print_type_parameter_doc out_type_decl.otype_params ) ] ); - Doc.trailingComma; - Doc.softLine; - Doc.greaterThan; + Doc.trailing_comma; + Doc.soft_line; + Doc.greater_than; ] ) in - let privateDoc = match outTypeDecl.otype_private with + let private_doc = match out_type_decl.otype_private with | Asttypes.Private -> Doc.text "private " | Public -> Doc.nil in - let kind = match outTypeDecl.otype_type with + let kind = match out_type_decl.otype_type with | Otyp_open -> Doc.concat [ Doc.text " = "; - privateDoc; + private_doc; Doc.text ".."; ] | Otyp_abstract -> Doc.nil | Otyp_record record -> Doc.concat [ Doc.text " = "; - privateDoc; - printRecordDeclarationDoc ~inline:false record; + private_doc; + print_record_declaration_doc ~inline:false record; ] | typ -> Doc.concat [ Doc.text " = "; - printOutTypeDoc typ + print_out_type_doc typ ] in - let constraints = match outTypeDecl.otype_cstrs with + let constraints = match out_type_decl.otype_cstrs with | [] -> Doc.nil | _ -> Doc.group ( Doc.concat [ Doc.line; Doc.indent ( Doc.concat [ - Doc.hardLine; + Doc.hard_line; Doc.join ~sep:Doc.line (List.map (fun (typ1, typ2) -> Doc.group ( Doc.concat [ Doc.text "constraint "; - printOutTypeDoc typ1; + print_out_type_doc typ1; Doc.text " ="; Doc.indent ( Doc.concat [ Doc.line; - printOutTypeDoc typ2; + print_out_type_doc typ2; ] ) ] ) - ) outTypeDecl.otype_cstrs) + ) out_type_decl.otype_cstrs) ] ) ] @@ -18709,8 +18709,8 @@ end = struct Doc.concat [ attrs; kw; - Doc.text outTypeDecl.otype_name; - typeParams; + Doc.text out_type_decl.otype_name; + type_params; kind ] ); @@ -18718,14 +18718,14 @@ end = struct ] ) - and printOutModuleTypeDoc (outModType : Outcometree.out_module_type) = - match outModType with + and print_out_module_type_doc (out_mod_type : Outcometree.out_module_type) = + match out_mod_type with | Omty_abstract -> Doc.nil - | Omty_ident ident -> printOutIdentDoc ident + | Omty_ident ident -> print_out_ident_doc ident (* example: module Increment = (M: X_int) => X_int *) | Omty_functor _ -> - let (args, returnModType) = collectFunctorArgs outModType [] in - let argsDoc = match args with + let (args, return_mod_type) = collect_functor_args out_mod_type [] in + let args_doc = match args with | [_, None] -> Doc.text "()" | args -> Doc.group ( @@ -18733,53 +18733,53 @@ end = struct Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun (lbl, optModType) -> Doc.group ( + List.map (fun (lbl, opt_mod_type) -> Doc.group ( Doc.concat [ Doc.text lbl; - match optModType with + match opt_mod_type with | None -> Doc.nil - | Some modType -> Doc.concat [ + | Some mod_type -> Doc.concat [ Doc.text ": "; - printOutModuleTypeDoc modType; + print_out_module_type_doc mod_type; ] ] )) args ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) in Doc.group ( Doc.concat [ - argsDoc; + args_doc; Doc.text " => "; - printOutModuleTypeDoc returnModType + print_out_module_type_doc return_mod_type ] ) | Omty_signature [] -> Doc.nil | Omty_signature signature -> - Doc.breakableGroup ~forceBreak:true ( + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.lbrace; Doc.indent ( Doc.concat [ Doc.line; - printOutSignatureDoc signature; + print_out_signature_doc signature; ] ); - Doc.softLine; + Doc.soft_line; Doc.rbrace; ] ) | Omty_alias _ident -> Doc.nil - and printOutSignatureDoc (signature : Outcometree.out_sig_item list) = + and print_out_signature_doc (signature : Outcometree.out_sig_item list) = let rec loop signature acc = match signature with | [] -> List.rev acc @@ -18804,29 +18804,29 @@ end = struct otyext_constructors = exts; otyext_private = ext.oext_private } in - let doc = printOutTypeExtensionDoc te in + let doc = print_out_type_extension_doc te in loop items (doc::acc) | item::items -> - let doc = printOutSigItemDoc item in + let doc = print_out_sig_item_doc item in loop items (doc::acc) in match loop signature [] with | [doc] -> doc | docs -> - Doc.breakableGroup ~forceBreak:true ( + Doc.breakable_group ~force_break:true ( Doc.join ~sep:Doc.line docs ) - and printOutExtensionConstructorDoc (outExt : Outcometree.out_extension_constructor) = - let typeParams = match outExt.oext_type_params with + and print_out_extension_constructor_doc (out_ext : Outcometree.out_extension_constructor) = + let type_params = match out_ext.oext_type_params with | [] -> Doc.nil | params -> Doc.group( Doc.concat [ - Doc.lessThan; + Doc.less_than; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ty -> Doc.text (if ty = "_" then ty else "'" ^ ty)) params @@ -18834,8 +18834,8 @@ end = struct ) ] ); - Doc.softLine; - Doc.greaterThan; + Doc.soft_line; + Doc.greater_than; ] ) @@ -18843,29 +18843,29 @@ end = struct Doc.group ( Doc.concat [ Doc.text "type "; - Doc.text outExt.oext_type_name; - typeParams; + Doc.text out_ext.oext_type_name; + type_params; Doc.text " +="; Doc.line; - if outExt.oext_private = Asttypes.Private then + if out_ext.oext_private = Asttypes.Private then Doc.text "private " else Doc.nil; - printOutConstructorDoc - (outExt.oext_name, outExt.oext_args, outExt.oext_ret_type) + print_out_constructor_doc + (out_ext.oext_name, out_ext.oext_args, out_ext.oext_ret_type) ] ) - and printOutTypeExtensionDoc (typeExtension : Outcometree.out_type_extension) = - let typeParams = match typeExtension.otyext_params with + and print_out_type_extension_doc (type_extension : Outcometree.out_type_extension) = + let type_params = match type_extension.otyext_params with | [] -> Doc.nil | params -> Doc.group( Doc.concat [ - Doc.lessThan; + Doc.less_than; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ty -> Doc.text (if ty = "_" then ty else "'" ^ ty)) params @@ -18873,8 +18873,8 @@ end = struct ) ] ); - Doc.softLine; - Doc.greaterThan; + Doc.soft_line; + Doc.greater_than; ] ) @@ -18882,26 +18882,26 @@ end = struct Doc.group ( Doc.concat [ Doc.text "type "; - Doc.text typeExtension.otyext_name; - typeParams; + Doc.text type_extension.otyext_name; + type_params; Doc.text " +="; - if typeExtension.otyext_private = Asttypes.Private then + if type_extension.otyext_private = Asttypes.Private then Doc.text "private " else Doc.nil; - printOutConstructorsDoc typeExtension.otyext_constructors; + print_out_constructors_doc type_extension.otyext_constructors; ] ) - let printOutSigItem fmt outSigItem = + let print_out_sig_item fmt out_sig_item = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutSigItemDoc outSigItem)) + (Doc.to_string ~width:80 (print_out_sig_item_doc out_sig_item)) - let printOutSignature fmt signature = + let print_out_signature fmt signature = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutSignatureDoc signature)) + (Doc.to_string ~width:80 (print_out_signature_doc signature)) - let validFloatLexeme s = + let valid_float_lexeme s = let l = String.length s in let rec loop i = if i >= l then s ^ "." else @@ -18910,7 +18910,7 @@ end = struct | _ -> s in loop 0 - let floatRepres f = + let float_repres f = match classify_float f with | FP_nan -> "nan" | FP_infinite -> @@ -18922,43 +18922,43 @@ end = struct let s2 = Printf.sprintf "%.15g" f in if f = (float_of_string [@doesNotRaise]) s2 then s2 else Printf.sprintf "%.18g" f - in validFloatLexeme float_val + in valid_float_lexeme float_val - let rec printOutValueDoc (outValue : Outcometree.out_value) = - match outValue with - | Oval_array outValues -> + let rec print_out_value_doc (out_value : Outcometree.out_value) = + match out_value with + | Oval_array out_values -> Doc.group ( Doc.concat [ Doc.lbracket; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printOutValueDoc outValues + List.map print_out_value_doc out_values ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbracket; ] ) | Oval_char c -> Doc.text ("'" ^ (Char.escaped c) ^ "'") - | Oval_constr (outIdent, outValues) -> + | Oval_constr (out_ident, out_values) -> Doc.group ( Doc.concat [ - printOutIdentDoc outIdent; + print_out_ident_doc out_ident; Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printOutValueDoc outValues + List.map print_out_value_doc out_values ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) @@ -18967,21 +18967,21 @@ end = struct | 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 (floatRepres f) - | Oval_list outValues -> + | Oval_float f -> Doc.text (float_repres f) + | Oval_list out_values -> Doc.group ( Doc.concat [ Doc.text "list["; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printOutValueDoc outValues + List.map print_out_value_doc out_values ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbracket; ] ) @@ -18996,48 +18996,48 @@ end = struct Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun (outIdent, outValue) -> Doc.group ( + List.map (fun (out_ident, out_value) -> Doc.group ( Doc.concat [ - printOutIdentDoc outIdent; + print_out_ident_doc out_ident; Doc.text ": "; - printOutValueDoc outValue; + print_out_value_doc out_value; ] ) ) rows ); ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) | Oval_string (txt, _sizeToPrint, _kind) -> - Doc.text (escapeStringContents txt) + Doc.text (escape_string_contents txt) | Oval_stuff txt -> Doc.text txt - | Oval_tuple outValues -> + | Oval_tuple out_values -> Doc.group ( Doc.concat [ Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printOutValueDoc outValues + List.map print_out_value_doc out_values ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) (* Not supported by NapkinScript *) | Oval_variant _ -> Doc.nil - let printOutExceptionDoc exc outValue = + let print_out_exception_doc exc out_value = match exc with | Sys.Break -> Doc.text "Interrupted." | Out_of_memory -> Doc.text "Out of memory during evaluation." @@ -19049,12 +19049,12 @@ end = struct Doc.concat [ Doc.text "Exception:"; Doc.line; - printOutValueDoc outValue; + print_out_value_doc out_value; ] ) ) - let printOutPhraseSignature signature = + let print_out_phrase_signature signature = let rec loop signature acc = match signature with | [] -> List.rev acc @@ -19079,95 +19079,95 @@ end = struct otyext_constructors = exts; otyext_private = ext.oext_private } in - let doc = printOutTypeExtensionDoc te in + let doc = print_out_type_extension_doc te in loop signature (doc::acc) - | (sigItem, optOutValue)::signature -> - let doc = match optOutValue with + | (sig_item, opt_out_value)::signature -> + let doc = match opt_out_value with | None -> - printOutSigItemDoc sigItem - | Some outValue -> + print_out_sig_item_doc sig_item + | Some out_value -> Doc.group ( Doc.concat [ - printOutSigItemDoc sigItem; + print_out_sig_item_doc sig_item; Doc.text " = "; - printOutValueDoc outValue; + print_out_value_doc out_value; ] ) in loop signature (doc::acc) in - Doc.breakableGroup ~forceBreak:true ( + Doc.breakable_group ~force_break:true ( Doc.join ~sep:Doc.line (loop signature []) ) - let printOutPhraseDoc (outPhrase : Outcometree.out_phrase) = - match outPhrase with - | Ophr_eval (outValue, outType) -> + let print_out_phrase_doc (out_phrase : Outcometree.out_phrase) = + match out_phrase with + | Ophr_eval (out_value, out_type) -> Doc.group ( Doc.concat [ Doc.text "- : "; - printOutTypeDoc outType; + print_out_type_doc out_type; Doc.text " ="; Doc.indent ( Doc.concat [ Doc.line; - printOutValueDoc outValue; + print_out_value_doc out_value; ] ) ] ) | Ophr_signature [] -> Doc.nil - | Ophr_signature signature -> printOutPhraseSignature signature - | Ophr_exception (exc, outValue) -> - printOutExceptionDoc exc outValue + | Ophr_signature signature -> print_out_phrase_signature signature + | Ophr_exception (exc, out_value) -> + print_out_exception_doc exc out_value - let printOutPhase fmt outPhrase = + let print_out_phase fmt out_phrase = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutPhraseDoc outPhrase)) + (Doc.to_string ~width:80 (print_out_phrase_doc out_phrase)) - let printOutModuleType fmt outModuleType = + let print_out_module_type fmt out_module_type = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutModuleTypeDoc outModuleType)) + (Doc.to_string ~width:80 (print_out_module_type_doc out_module_type)) - let printOutTypeExtension fmt typeExtension = + let print_out_type_extension fmt type_extension = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutTypeExtensionDoc typeExtension)) + (Doc.to_string ~width:80 (print_out_type_extension_doc type_extension)) - let printOutValue fmt outValue = + let print_out_value fmt out_value = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutValueDoc outValue)) + (Doc.to_string ~width:80 (print_out_value_doc out_value)) (* Not supported in Napkin *) - let printOutClassType _fmt _ = () - - let out_value = ref printOutValue - let out_type = ref printOutType - let out_module_type = ref printOutModuleType - let out_sig_item = ref printOutSigItem - let out_signature = ref printOutSignature - let out_type_extension = ref printOutTypeExtension - let out_phrase = ref printOutPhase [@live] - let out_class_type = ref printOutClassType + let print_out_class_type _fmt _ = () + + let out_value = ref print_out_value + let out_type = ref print_out_type + let out_module_type = ref print_out_module_type + let out_sig_item = ref print_out_sig_item + let out_signature = ref print_out_signature + let out_type_extension = ref print_out_type_extension + let out_phrase = ref print_out_phase [@live] + let out_class_type = ref print_out_class_type end module Repl = struct - let parseToplevelPhrase filename = - let src = IO.readFile filename in + let parse_toplevel_phrase filename = + let src = IO.read_file filename in let p = Parser.make src filename in - Parsetree.Ptop_def (NapkinScript.parseImplementation p) + Parsetree.Ptop_def (NapkinScript.parse_implementation p) - let typeAndPrintOutcome filename = + let type_and_print_outcome filename = Compmisc.init_path false; let env = Compmisc.initial_env () in try - let sstr = match parseToplevelPhrase filename with + let sstr = match parse_toplevel_phrase filename with | Parsetree.Ptop_def sstr -> sstr | _ -> assert false in let (_str, signature, _newenv) = Typemod.type_toplevel_phrase env sstr in - let outSigItems = Printtyp.tree_of_signature signature in + let out_sig_items = Printtyp.tree_of_signature signature in let fmt = Format.str_formatter in - !OutcomePrinter.out_signature fmt outSigItems; + !OutcomePrinter.out_signature fmt out_sig_items; let result = Format.flush_str_formatter () in print_string result with @@ -19197,7 +19197,7 @@ end = struct let width = ref 100 let files = ref [] - let addFilename filename = files := filename::(!files) + let add_filename filename = files := filename::(!files) let print = ref "" let outcome = ref false @@ -19211,18 +19211,18 @@ end = struct ("-recover", Arg.Unit (fun () -> recover := true), "Emit partial ast"); ("-print", Arg.String (fun txt -> print := txt), "Print either binary, ocaml or ast"); ("-parse", Arg.String (fun txt -> origin := txt), "Parse ocaml or napkinscript"); - ("-outcome", Arg.Bool (fun printOutcomeTree -> outcome := printOutcomeTree), "print outcometree"); + ("-outcome", Arg.Bool (fun print_outcome_tree -> outcome := print_outcome_tree), "print outcometree"); ("-width", Arg.Int (fun w -> width := w), "Specify the line length that the printer will wrap on" ); ("-interface", Arg.Unit (fun () -> interface := true), "Parse as interface"); ("-report", Arg.String (fun txt -> report := txt), "Stylize errors and messages using color and context. Accepts `Pretty` and `Plain`. Default `Plain`") ] - let parse () = Arg.parse spec addFilename usage + let parse () = Arg.parse spec add_filename usage end module Driver: sig - val processFile: - isInterface: bool + val process_file: + is_interface: bool -> width: int -> recover: bool -> origin:string @@ -19235,18 +19235,18 @@ end = struct | Structure: Parsetree.structure file_kind | Signature: Parsetree.signature file_kind - let parseNapkin (type a) (kind : a file_kind) p : a = + let parse_napkin (type a) (kind : a file_kind) p : a = match kind with - | Structure -> NapkinScript.parseImplementation p - | Signature -> NapkinScript.parseSpecification p + | Structure -> NapkinScript.parse_implementation p + | Signature -> NapkinScript.parse_specification p - let extractOcamlStringData filename = + let extract_ocaml_string_data filename = let lexbuf = if String.length filename > 0 then - IO.readFile filename |> Lexing.from_string + IO.read_file filename |> Lexing.from_string else Lexing.from_channel stdin in - let stringLocs = ref [] in + let string_locs = ref [] in let rec next () = let token = Lexer.token_with_comments lexbuf in match token with @@ -19261,36 +19261,36 @@ end = struct let txt = Bytes.to_string ( (Bytes.sub [@doesNotRaise]) lexbuf.Lexing.lex_buffer loc.loc_start.pos_cnum len ) in - stringLocs := (txt, loc)::(!stringLocs); + string_locs := (txt, loc)::(!string_locs); next(); | OcamlParser.EOF -> () | _ -> next() in next(); - List.rev !stringLocs + List.rev !string_locs - let parseOcaml (type a) (kind : a file_kind) filename : a = + let parse_ocaml (type a) (kind : a file_kind) filename : a = let lexbuf = if String.length filename > 0 then - IO.readFile filename |> Lexing.from_string + IO.read_file filename |> Lexing.from_string else Lexing.from_channel stdin in - let stringData = extractOcamlStringData filename in + let string_data = extract_ocaml_string_data filename in match kind with | Structure -> Parse.implementation lexbuf - |> ParsetreeCompatibility.replaceStringLiteralStructure stringData + |> ParsetreeCompatibility.replace_string_literal_structure string_data |> ParsetreeCompatibility.structure | Signature -> Parse.interface lexbuf - |> ParsetreeCompatibility.replaceStringLiteralSignature stringData + |> ParsetreeCompatibility.replace_string_literal_signature string_data |> ParsetreeCompatibility.signature - let parseNapkinFile ~destination kind filename = + let parse_napkin_file ~destination kind filename = let src = if String.length filename > 0 then - IO.readFile filename + IO.read_file filename else - IO.readStdin () + IO.read_stdin () in let p = let mode = match destination with @@ -19298,29 +19298,29 @@ end = struct | _ -> Parser.ParseForTypeChecker in Parser.make ~mode src filename in - let ast = parseNapkin kind p in + let ast = parse_napkin kind p in let report = match p.diagnostics with | [] -> None | diagnostics -> Some(diagnostics) in (ast, report, p) - let parseOcamlFile kind filename = - let ast = parseOcaml kind filename in + let parse_ocaml_file kind filename = + let ast = parse_ocaml kind filename in let lexbuf2 = if String.length filename > 0 then - IO.readFile filename |> Lexing.from_string + IO.read_file filename |> Lexing.from_string else Lexing.from_channel stdin in let comments = - let rec next (prevTokEndPos : Lexing.position) comments lb = + let rec next (prev_tok_end_pos : Lexing.position) comments lb = let token = Lexer.token_with_comments lb in match token with | OcamlParser.EOF -> comments | OcamlParser.COMMENT (txt, loc) -> - let comment = Comment.fromOcamlComment + let comment = Comment.from_ocaml_comment ~loc - ~prevTokEndPos + ~prev_tok_end_pos ~txt in next loc.Location.loc_end (comment::comments) lb @@ -19334,11 +19334,11 @@ end = struct p.comments <- comments; (ast, None, p) - let reasonFilename = ref "" - let commentData = ref [] - let stringData = ref [] + let reason_filename = ref "" + let comment_data = ref [] + let string_data = ref [] - let parseReasonBinaryFromStdin (type a) (kind : a file_kind) filename :a = + let parse_reason_binary_from_stdin (type a) (kind : a file_kind) filename :a = let chan, close = match String.length filename == 0 with | true -> stdin, (fun _ -> ()) @@ -19355,33 +19355,33 @@ end = struct let buffer = (really_input_string [@doesNotRaise]) ic (String.length magic) in assert(buffer = magic); let filename = input_value ic in - reasonFilename := filename; + reason_filename := filename; let ast = input_value ic in close chan; let src = - if String.length filename > 0 then IO.readFile filename - else IO.readStdin () + if String.length filename > 0 then IO.read_file filename + else IO.read_stdin () in let scanner = Scanner.make (Bytes.of_string src) filename in - let rec next prevEndPos scanner = - let (startPos, endPos, token) = Scanner.scan scanner in + let rec next prev_end_pos scanner = + let (start_pos, end_pos, token) = Scanner.scan scanner in match token with | Eof -> () | Comment c -> - Comment.setPrevTokEndPos c prevEndPos; - commentData := c::(!commentData); - next endPos scanner + Comment.set_prev_tok_end_pos c prev_end_pos; + comment_data := c::(!comment_data); + next end_pos scanner | String _ -> - let loc = {Location.loc_start = startPos; loc_end = endPos; loc_ghost = false} in - let len = endPos.pos_cnum - startPos.pos_cnum in - let txt = (String.sub [@doesNotRaise]) src startPos.pos_cnum len in - stringData := (txt, loc)::(!stringData); - next endPos scanner + let loc = {Location.loc_start = start_pos; loc_end = end_pos; loc_ghost = false} in + let len = end_pos.pos_cnum - start_pos.pos_cnum in + let txt = (String.sub [@doesNotRaise]) src start_pos.pos_cnum len in + string_data := (txt, loc)::(!string_data); + next end_pos scanner | _ -> - next endPos scanner + next end_pos scanner in next Lexing.dummy_pos scanner; @@ -19389,16 +19389,16 @@ end = struct match kind with | Structure -> ast - |> ParsetreeCompatibility.replaceStringLiteralStructure !stringData - |> ParsetreeCompatibility.normalizeReasonArityStructure ~forPrinter:true + |> ParsetreeCompatibility.replace_string_literal_structure !string_data + |> ParsetreeCompatibility.normalize_reason_arity_structure ~for_printer:true |> ParsetreeCompatibility.structure | Signature -> ast - |> ParsetreeCompatibility.replaceStringLiteralSignature !stringData - |> ParsetreeCompatibility.normalizeReasonAritySignature ~forPrinter:true + |> ParsetreeCompatibility.replace_string_literal_signature !string_data + |> ParsetreeCompatibility.normalize_reason_arity_signature ~for_printer:true |> ParsetreeCompatibility.signature - let isReasonDocComment (comment: Comment.t) = + let is_reason_doc_comment (comment: Comment.t) = let content = Comment.txt comment in let len = String.length content in if len = 0 then true @@ -19407,101 +19407,101 @@ end = struct else false - let parseReasonBinary kind filename = - let ast = parseReasonBinaryFromStdin kind filename in - let p = Parser.make "" !reasonFilename in - p.comments <- List.filter (fun c -> not (isReasonDocComment c)) !commentData; + let parse_reason_binary kind filename = + let ast = parse_reason_binary_from_stdin kind filename in + let p = Parser.make "" !reason_filename in + p.comments <- List.filter (fun c -> not (is_reason_doc_comment c)) !comment_data; (ast, None, p) - let parseImplementation ~origin ~destination filename = + let parse_implementation ~origin ~destination filename = match origin with | "ml" | "ocaml" -> - parseOcamlFile Structure filename + parse_ocaml_file Structure filename | "reasonBinary" -> - parseReasonBinary Structure filename + parse_reason_binary Structure filename | _ -> - parseNapkinFile ~destination Structure filename + parse_napkin_file ~destination Structure filename - let parseInterface ~destination ~origin filename = + let parse_interface ~destination ~origin filename = match origin with | "ml" | "ocaml" -> - parseOcamlFile Signature filename + parse_ocaml_file Signature filename | "reasonBinary" -> - parseReasonBinary Signature filename + parse_reason_binary Signature filename | _ -> - parseNapkinFile ~destination Signature filename + parse_napkin_file ~destination Signature filename - let process ~reportStyle parseFn printFn recover filename = - let (ast, report, parserState) = parseFn filename in + let process ~report_style parse_fn print_fn recover filename = + let (ast, report, parser_state) = parse_fn filename in match report with | Some report when recover = true -> - printFn ast parserState; + print_fn ast parser_state; prerr_string ( - Diagnostics.stringOfReport - ~style:(Diagnostics.parseReportStyle reportStyle) - report (Bytes.to_string parserState.Parser.scanner.src) + Diagnostics.string_of_report + ~style:(Diagnostics.parse_report_style report_style) + report (Bytes.to_string parser_state.Parser.scanner.src) ); | Some report -> prerr_string ( - Diagnostics.stringOfReport - ~style:(Diagnostics.parseReportStyle reportStyle) - report (Bytes.to_string parserState.Parser.scanner.src) + Diagnostics.string_of_report + ~style:(Diagnostics.parse_report_style report_style) + report (Bytes.to_string parser_state.Parser.scanner.src) ); exit 1 | None -> - printFn ast parserState + print_fn ast parser_state type action = | ProcessImplementation | ProcessInterface - let printImplementation ~target ~width filename ast _parserState = + let print_implementation ~target ~width filename ast _parserState = match target with | "ml" | "ocaml" -> Pprintast.structure Format.std_formatter ast | "ns" | "napkinscript" -> - Printer.printImplementation ~width ast (List.rev _parserState.Parser.comments) + Printer.print_implementation ~width ast (List.rev _parserState.Parser.comments) | "ast" -> Printast.implementation Format.std_formatter ast | "sexp" -> - ast |> SexpAst.implementation |> Sexp.toString |> print_string + ast |> SexpAst.implementation |> Sexp.to_string |> print_string | _ -> (* default binary *) output_string stdout Config.ast_impl_magic_number; output_value stdout filename; output_value stdout ast - let printInterface ~target ~width filename ast _parserState = + let print_interface ~target ~width filename ast _parserState = match target with | "ml" | "ocaml" -> Pprintast.signature Format.std_formatter ast | "ns" | "napkinscript" -> - Printer.printInterface ~width ast (List.rev _parserState.Parser.comments) + Printer.print_interface ~width ast (List.rev _parserState.Parser.comments) | "ast" -> Printast.interface Format.std_formatter ast | "sexp" -> - ast |> SexpAst.interface |> Sexp.toString |> print_string + ast |> SexpAst.interface |> Sexp.to_string |> print_string | _ -> (* default binary *) output_string stdout Config.ast_intf_magic_number; output_value stdout filename; output_value stdout ast - let processFile ~isInterface ~width ~recover ~origin ~target ~report filename = + let process_file ~is_interface ~width ~recover ~origin ~target ~report filename = try let len = String.length filename in let action = - if isInterface || len > 0 && (String.get [@doesNotRaise]) filename (len - 1) = 'i' then + if is_interface || len > 0 && (String.get [@doesNotRaise]) filename (len - 1) = 'i' then ProcessInterface else ProcessImplementation in match action with | ProcessImplementation -> process - ~reportStyle:report - (parseImplementation ~origin ~destination:target) - (printImplementation ~target ~width filename) recover filename + ~report_style:report + (parse_implementation ~origin ~destination:target) + (print_implementation ~target ~width filename) recover filename | ProcessInterface -> process - ~reportStyle:report - (parseInterface ~origin ~destination:target) - (printInterface ~target ~width filename) recover filename + ~report_style:report + (parse_interface ~origin ~destination:target) + (print_interface ~target ~width filename) recover filename with | Failure txt -> prerr_string txt; @@ -19513,13 +19513,13 @@ end let () = Clflags.parse (); if !Clflags.outcome then ( - Repl.typeAndPrintOutcome (List.hd !Clflags.files) + Repl.type_and_print_outcome (List.hd !Clflags.files) ) else ( let () = match !Clflags.files with | (_file::_) as files -> List.iter (fun filename -> - Driver.processFile - ~isInterface:!Clflags.interface + Driver.process_file + ~is_interface:!Clflags.interface ~width:!Clflags.width ~recover:!Clflags.recover ~target:!Clflags.print @@ -19528,8 +19528,8 @@ let () = filename ) files; | [] -> - Driver.processFile - ~isInterface:!Clflags.interface + Driver.process_file + ~is_interface:!Clflags.interface ~width:!Clflags.width ~recover:!Clflags.recover ~target:!Clflags.print diff --git a/jscomp/syntax/benchmarks/data/PrinterNapkin.ml b/jscomp/syntax/benchmarks/data/PrinterNapkin.ml index d0c48e69c6..fa3b217ea2 100644 --- a/jscomp/syntax/benchmarks/data/PrinterNapkin.ml +++ b/jscomp/syntax/benchmarks/data/PrinterNapkin.ml @@ -4,7 +4,7 @@ module Printer = { comments: CommentAst.t, } - let rec collectPatternsFromListConstruct = (acc, pattern) => + let rec collect_patterns_from_list_construct = (acc, pattern) => { open Parsetree switch pattern.ppat_desc { @@ -102,35 +102,35 @@ module Printer = { Buffer.contents(b) } - let printConstant = c => + let print_constant = c => switch c { | Parsetree.Pconst_integer(s, _) => Doc.text(s) - | Pconst_string(s, _) => Doc.text("\"" ++ escapeStringContents(s) ++ "\"") + | Pconst_string(s, _) => Doc.text("\"" ++ escape_string_contents(s) ++ "\"") | Pconst_float(s, _) => Doc.text(s) | Pconst_char(c) => Doc.text("'" ++ Char.escaped(c) ++ "'") } - let rec printStructure = (s: Parsetree.structure) => - interleaveWhitespace( - List.map(si => /si.Parsetree.pstr_loc, printStructureItem(si)/, s), + let rec print_structure = (s: Parsetree.structure) => + interleave_whitespace( + List.map(si => /si.Parsetree.pstr_loc, print_structure_item(si)/, s), ) - and printStructureItem = (si: Parsetree.structure_item) => + and print_structure_item = (si: Parsetree.structure_item) => switch si.pstr_desc { - | Pstr_value(rec_flag, valueBindings) => - let recFlag = switch rec_flag { + | Pstr_value(rec_flag, value_bindings) => + let rec_flag = switch rec_flag { | Asttypes.Nonrecursive => Doc.nil | Asttypes.Recursive => Doc.text("rec ") } - printValueBindings(~recFlag, valueBindings) - | Pstr_type(recFlag, typeDeclarations) => + print_value_bindings(~rec_flag, value_bindings) + | Pstr_type(recFlag, type_declarations) => let recFlag = switch recFlag { | Asttypes.Nonrecursive => Doc.nil | Asttypes.Recursive => Doc.text("rec ") } - printTypeDeclarations(~recFlag, typeDeclarations) + print_type_declarations(~rec_flag, type_declarations) | Pstr_primitive(valueDescription) => printValueDescription(valueDescription) | Pstr_eval(expr, attrs) => @@ -140,75 +140,75 @@ module Printer = { pexp_desc: Pexp_ifthenelse(_), } => false - | _ when ParsetreeViewer.hasAttributes(expr.pexp_attributes) => true + | _ when ParsetreeViewer.has_attributes(expr.pexp_attributes) => true | _ => false } - let exprDoc = { - let doc = printExpression(expr) - if needsParens { - addParens(doc) + let expr_doc = { + let doc = print_expression(expr) + if needs_parens { + add_parens(doc) } else { doc } } - Doc.concat(list(printAttributes(attrs), exprDoc)) + Doc.concat(list(print_attributes(attrs), expr_doc)) | Pstr_attribute(attr) => - Doc.concat(list(Doc.text("@"), printAttribute(attr))) + Doc.concat(list(Doc.text("@"), print_attribute(attr))) | Pstr_extension(extension, attrs) => Doc.concat(list( - printAttributes(attrs), - Doc.concat(list(Doc.text("%"), printExtension(extension))), + print_attributes(attrs), + Doc.concat(list(Doc.text("%"), print_extension(extension))), )) - | Pstr_include(includeDeclaration) => - printIncludeDeclaration(includeDeclaration) - | Pstr_open(openDescription) => printOpenDescription(openDescription) - | Pstr_modtype(modTypeDecl) => printModuleTypeDeclaration(modTypeDecl) - | Pstr_module(moduleBinding) => - printModuleBinding(~isRec=false, 0, moduleBinding) - | Pstr_recmodule(moduleBindings) => + | Pstr_include(include_declaration) => + print_include_declaration(include_declaration) + | Pstr_open(open_description) => print_open_description(open_description) + | Pstr_modtype(mod_type_decl) => print_module_type_declaration(mod_type_decl) + | Pstr_module(module_binding) => + print_module_binding(~is_rec=false, 0, module_binding) + | Pstr_recmodule(module_bindings) => Doc.join( ~sep=Doc.line, List.mapi( - (i, mb) => printModuleBinding(~isRec=true, i, mb), - moduleBindings, + (i, mb) => print_module_binding(~is_rec=true, i, mb), + module_bindings, ), ) - | Pstr_exception(extensionConstructor) => - printExceptionDef(extensionConstructor) - | Pstr_typext(typeExtension) => printTypeExtension(typeExtension) + | Pstr_exception(extension_constructor) => + print_exception_def(extension_constructor) + | Pstr_typext(type_extension) => print_type_extension(type_extension) | Pstr_class(_) | Pstr_class_type(_) => Doc.nil } - and printTypeExtension = (te: Parsetree.type_extension) => { + and print_type_extension = (te: Parsetree.type_extension) => { let prefix = Doc.text("type ") - let name = printLongident(te.ptyext_path.txt) - let typeParams = switch te.ptyext_params { + let name = print_longident(te.ptyext_path.txt) + let type_params = switch te.ptyext_params { | list() => Doc.nil | typeParams => Doc.group( Doc.concat(list( - Doc.lessThan, + Doc.less_than, Doc.indent( Doc.concat(list( - Doc.softLine, + Doc.soft_line, Doc.join( ~sep=Doc.concat(list(Doc.comma, Doc.line)), - List.map(printTypeParam, typeParams), + List.map(print_type_param, type_params), ), )), ), - Doc.trailingComma, - Doc.softLine, - Doc.greaterThan, + Doc.trailing_comma, + Doc.soft_line, + Doc.greater_than, )), ) } - let extensionConstructors = { + let extension_constructors = { let ecs = te.ptyext_constructors - let forceBreak = switch /ecs, List.rev(ecs)/ { + let force_break = switch /ecs, List.rev(ecs)/ { | /list(first, ..._), list(last, ..._)/ => first.pext_loc.loc_start.pos_lnum > te.ptyext_path.loc.loc_end.pos_lnum || @@ -221,13 +221,13 @@ module Printer = { | Public => Doc.nil } - Doc.breakableGroup( - ~forceBreak, + Doc.breakable_group( + ~force_break, Doc.indent( Doc.concat(list( Doc.line, - privateFlag, - Doc.join(~sep=Doc.line, List.mapi(printExtensionConstructor, ecs)), + private_flag, + Doc.join(~sep=Doc.line, List.mapi(print_extension_constructor, ecs)), )), ), ) @@ -235,21 +235,21 @@ module Printer = { Doc.group( Doc.concat(list( - printAttributes(~loc=te.ptyext_path.loc, te.ptyext_attributes), + print_attributes(~loc=te.ptyext_path.loc, te.ptyext_attributes), prefix, name, - typeParams, + type_params, Doc.text(" +="), - extensionConstructors, + extension_constructors, )), ) } - and printModuleBinding = (~isRec, i, moduleBinding) => { + and print_module_binding = (~is_rec, i, module_binding) => { let prefix = if i == 0 { Doc.concat(list( Doc.text("module "), - if isRec { + if is_rec { Doc.text("rec ") } else { Doc.nil @@ -259,25 +259,25 @@ module Printer = { Doc.text("and ") } - let /modExprDoc, modConstraintDoc/ = switch moduleBinding.pmb_expr { + let /mod_expr_doc, mod_constraint_doc/ = switch module_binding.pmb_expr { | {pmod_desc: Pmod_constraint(modExpr, modType)} => / printModExpr(modExpr), - Doc.concat(list(Doc.text(": "), printModType(modType))), + Doc.concat(list(Doc.text(": "), printModType(mod_type))), / - | modExpr => /printModExpr(modExpr), Doc.nil/ + | mod_expr => /print_mod_expr(mod_expr), Doc.nil/ } Doc.concat(list( - printAttributes( - ~loc=moduleBinding.pmb_name.loc, - moduleBinding.pmb_attributes, + print_attributes( + ~loc=module_binding.pmb_name.loc, + module_binding.pmb_attributes, ), prefix, - Doc.text(moduleBinding.pmb_name.Location.txt), - modConstraintDoc, + Doc.text(module_binding.pmb_name.Location.txt), + mod_constraint_doc, Doc.text(" = "), - modExprDoc, + mod_expr_doc, )) } @@ -285,66 +285,66 @@ module Printer = { modTypeDecl: Parsetree.module_type_declaration, ) => Doc.concat(list( - printAttributes(modTypeDecl.pmtd_attributes), + print_attributes(mod_type_decl.pmtd_attributes), Doc.text("module type "), - Doc.text(modTypeDecl.pmtd_name.txt), - switch modTypeDecl.pmtd_type { + Doc.text(mod_type_decl.pmtd_name.txt), + switch mod_type_decl.pmtd_type { | None => Doc.nil - | Some(modType) => - Doc.concat(list(Doc.text(" = "), printModType(modType))) + | Some(mod_type) => + Doc.concat(list(Doc.text(" = "), print_mod_type(mod_type))) }, )) - and printModType = modType => { - let modTypeDoc = switch modType.pmty_desc { + and print_mod_type = mod_type => { + let mod_type_doc = switch mod_type.pmty_desc { | Parsetree.Pmty_ident({txt: longident, loc}) => Doc.concat(list( - printAttributes(~loc, modType.pmty_attributes), - printLongident(longident), + print_attributes(~loc, mod_type.pmty_attributes), + print_longident(longident), )) | Pmty_signature(signature) => - let signatureDoc = Doc.breakableGroup( - ~forceBreak=true, + let signature_doc = Doc.breakable_group( + ~force_break=true, Doc.concat(list( Doc.lbrace, - Doc.indent(Doc.concat(list(Doc.line, printSignature(signature)))), + Doc.indent(Doc.concat(list(Doc.line, print_signature(signature)))), Doc.line, Doc.rbrace, )), ) - Doc.concat(list(printAttributes(modType.pmty_attributes), signatureDoc)) + Doc.concat(list(print_attributes(mod_type.pmty_attributes), signature_doc)) | Pmty_functor(_) => - let /parameters, returnType/ = ParsetreeViewer.functorType(modType) - let parametersDoc = switch parameters { + let /parameters, return_type/ = ParsetreeViewer.functor_type(mod_type) + let parameters_doc = switch parameters { | list() => Doc.nil - | list(/attrs, {Location.txt: "_"}, Some(modType)/) => + | list(/attrs, {Location.txt: "_"}, Some(mod_type)/) => let attrs = switch attrs { | list() => Doc.nil | attrs => Doc.concat(list( - Doc.join(~sep=Doc.line, List.map(printAttribute, attrs)), + Doc.join(~sep=Doc.line, List.map(print_attribute, attrs)), Doc.line, )) } - Doc.concat(list(attrs, printModType(modType))) + Doc.concat(list(attrs, print_mod_type(mod_type))) | params => Doc.group( Doc.concat(list( Doc.lparen, Doc.indent( Doc.concat(list( - Doc.softLine, + Doc.soft_line, Doc.join( ~sep=Doc.concat(list(Doc.comma, Doc.line)), List.map( - (/attrs, lbl, modType/) => { + (/attrs, lbl, mod_type/) => { let attrs = switch attrs { | list() => Doc.nil | attrs => Doc.concat(list( Doc.join( ~sep=Doc.line, - List.map(printAttribute, attrs), + List.map(print_attribute, attrs), ), Doc.line, )) @@ -358,14 +358,14 @@ module Printer = { }, switch modType { | None => Doc.nil - | Some(modType) => + | Some(mod_type) => Doc.concat(list( if lbl.txt == "_" { Doc.nil } else { Doc.text(": ") }, - printModType(modType), + print_mod_type(mod_type), )) }, )) @@ -375,17 +375,17 @@ module Printer = { ), )), ), - Doc.trailingComma, - Doc.softLine, + Doc.trailing_comma, + Doc.soft_line, Doc.rparen, )), ) } - let returnDoc = { - let doc = printModType(returnType) - if Parens.modTypeFunctorReturn(returnType) { - addParens(doc) + let return_doc = { + let doc = print_mod_type(return_type) + if Parens.mod_type_functor_return(return_type) { + add_parens(doc) } else { doc } @@ -393,20 +393,20 @@ module Printer = { Doc.group( Doc.concat(list( - parametersDoc, - Doc.group(Doc.concat(list(Doc.text(" =>"), Doc.line, returnDoc))), + parameters_doc, + Doc.group(Doc.concat(list(Doc.text(" =>"), Doc.line, return_doc))), )), ) - | Pmty_typeof(modExpr) => - Doc.concat(list(Doc.text("module type of "), printModExpr(modExpr))) - | Pmty_extension(extension) => printExtension(extension) + | Pmty_typeof(mod_expr) => + Doc.concat(list(Doc.text("module type of "), print_mod_expr(mod_expr))) + | Pmty_extension(extension) => print_extension(extension) | Pmty_alias({txt: longident}) => - Doc.concat(list(Doc.text("module "), printLongident(longident))) - | Pmty_with(modType, withConstraints) => + Doc.concat(list(Doc.text("module "), print_longident(longident))) + | Pmty_with(mod_type, with_constraints) => let operand = { - let doc = printModType(modType) - if Parens.modTypeWithOperand(modType) { - addParens(doc) + let doc = print_mod_type(mod_type) + if Parens.mod_type_with_operand(mod_type) { + add_parens(doc) } else { doc } @@ -416,29 +416,29 @@ module Printer = { Doc.concat(list( operand, Doc.indent( - Doc.concat(list(Doc.line, printWithConstraints(withConstraints))), + Doc.concat(list(Doc.line, print_with_constraints(with_constraints))), ), )), ) } - let attrsAlreadyPrinted = switch modType.pmty_desc { + let attrs_already_printed = switch mod_type.pmty_desc { | (Pmty_functor(_) | Pmty_signature(_)) | Pmty_ident(_) => true | _ => false } Doc.concat(list( - if attrsAlreadyPrinted { + if attrs_already_printed { Doc.nil } else { - printAttributes(modType.pmty_attributes) + printAttributes(mod_type.pmty_attributes) }, - modTypeDoc, + mod_type_doc, )) } - and printWithConstraints = withConstraints => { + and print_with_constraints = with_constraints => { let rows = List.mapi( - (i, withConstraint) => + (i, with_constraint) => Doc.group( Doc.concat(list( if i === 0 { @@ -446,7 +446,7 @@ module Printer = { } else { Doc.text("and ") }, - printWithConstraint(withConstraint), + printWithConstraint(with_constraint), )), ), withConstraints, @@ -455,41 +455,41 @@ module Printer = { Doc.join(~sep=Doc.line, rows) } - and printWithConstraint = (withConstraint: Parsetree.with_constraint) => - switch withConstraint { - | Pwith_type({txt: longident}, typeDeclaration) => + and print_with_constraint = (with_constraint: Parsetree.with_constraint) => + switch with_constraint { + | Pwith_type({txt: longident}, type_declaration) => Doc.group( - printTypeDeclaration( - ~name=printLongident(longident), - ~equalSign="=", - ~recFlag=Doc.nil, + print_type_declaration( + ~name=print_longident(longident), + ~equal_sign="=", + ~rec_flag=Doc.nil, 0, - typeDeclaration, + type_declaration, ), ) | Pwith_module({txt: longident1}, {txt: longident2}) => Doc.concat(list( Doc.text("module "), - printLongident(longident1), + print_longident(longident1), Doc.text(" ="), - Doc.indent(Doc.concat(list(Doc.line, printLongident(longident2)))), + Doc.indent(Doc.concat(list(Doc.line, print_longident(longident2)))), )) - | Pwith_typesubst({txt: longident}, typeDeclaration) => + | Pwith_typesubst({txt: longident}, type_declaration) => Doc.group( - printTypeDeclaration( - ~name=printLongident(longident), - ~equalSign=":=", - ~recFlag=Doc.nil, + print_type_declaration( + ~name=print_longident(longident), + ~equal_sign=":=", + ~rec_flag=Doc.nil, 0, - typeDeclaration, + type_declaration, ), ) | Pwith_modsubst({txt: longident1}, {txt: longident2}) => Doc.concat(list( Doc.text("module "), - printLongident(longident1), + print_longident(longident1), Doc.text(" :="), - Doc.indent(Doc.concat(list(Doc.line, printLongident(longident2)))), + Doc.indent(Doc.concat(list(Doc.line, print_longident(longident2)))), )) } @@ -503,7 +503,7 @@ module Printer = { and printSignatureItem = (si: Parsetree.signature_item) => switch si.psig_desc { - | Parsetree.Psig_value(valueDescription) => + | Parsetree.Psig_value(value_description) => printValueDescription(valueDescription) | Psig_type(recFlag, typeDeclarations) => let recFlag = switch recFlag { @@ -524,11 +524,11 @@ module Printer = { | Psig_include(includeDescription) => printIncludeDescription(includeDescription) | Psig_attribute(attr) => - Doc.concat(list(Doc.text("@"), printAttribute(attr))) + Doc.concat(list(Doc.text("@"), print_attribute(attr))) | Psig_extension(extension, attrs) => Doc.concat(list( - printAttributes(attrs), - Doc.concat(list(Doc.text("%"), printExtension(extension))), + print_attributes(attrs), + Doc.concat(list(Doc.text("%"), print_extension(extension))), )) | Psig_class(_) | Psig_class_type(_) => Doc.nil } @@ -541,23 +541,23 @@ module Printer = { (i, md: Parsetree.module_declaration) => { let body = switch md.pmd_type.pmty_desc { | Parsetree.Pmty_alias({txt: longident}) => - Doc.concat(list(Doc.text(" = "), printLongident(longident))) + Doc.concat(list(Doc.text(" = "), print_longident(longident))) | _ => - let needsParens = switch md.pmd_type.pmty_desc { + let needs_parens = switch md.pmd_type.pmty_desc { | Pmty_with(_) => true | _ => false } - let modTypeDoc = { - let doc = printModType(md.pmd_type) - if needsParens { - addParens(doc) + let mod_type_doc = { + let doc = print_mod_type(md.pmd_type) + if needs_parens { + add_parens(doc) } else { doc } } - Doc.concat(list(Doc.text(": "), modTypeDoc)) + Doc.concat(list(Doc.text(": "), mod_type_doc)) } let prefix = if i < 1 { @@ -580,61 +580,61 @@ module Printer = { and printModuleDeclaration = (md: Parsetree.module_declaration) => { let body = switch md.pmd_type.pmty_desc { | Parsetree.Pmty_alias({txt: longident}) => - Doc.concat(list(Doc.text(" = "), printLongident(longident))) - | _ => Doc.concat(list(Doc.text(": "), printModType(md.pmd_type))) + Doc.concat(list(Doc.text(" = "), print_longident(longident))) + | _ => Doc.concat(list(Doc.text(": "), print_mod_type(md.pmd_type))) } Doc.concat(list( - printAttributes(~loc=md.pmd_name.loc, md.pmd_attributes), + print_attributes(~loc=md.pmd_name.loc, md.pmd_attributes), Doc.text("module "), Doc.text(md.pmd_name.txt), body, )) } - and printOpenDescription = (openDescription: Parsetree.open_description) => + and print_open_description = (open_description: Parsetree.open_description) => Doc.concat(list( - printAttributes(openDescription.popen_attributes), + print_attributes(open_description.popen_attributes), Doc.text("open"), - switch openDescription.popen_override { + switch open_description.popen_override { | Asttypes.Fresh => Doc.space | Asttypes.Override => Doc.text("! ") }, - printLongident(openDescription.popen_lid.txt), + printLongident(open_description.popen_lid.txt), )) - and printIncludeDescription = ( - includeDescription: Parsetree.include_description, + and print_include_description = ( + include_description: Parsetree.include_description, ) => Doc.concat(list( - printAttributes(includeDescription.pincl_attributes), + print_attributes(include_description.pincl_attributes), Doc.text("include "), - printModType(includeDescription.pincl_mod), + print_mod_type(include_description.pincl_mod), )) - and printIncludeDeclaration = ( - includeDeclaration: Parsetree.include_declaration, + and print_include_declaration = ( + include_declaration: Parsetree.include_declaration, ) => Doc.concat(list( - printAttributes(includeDeclaration.pincl_attributes), + print_attributes(include_declaration.pincl_attributes), Doc.text("include "), - printModExpr(includeDeclaration.pincl_mod), + print_mod_expr(include_declaration.pincl_mod), )) - and printValueBindings = (~recFlag, vbs: list) => { + and print_value_bindings = (~rec_flag, vbs: list) => { let rows = List.mapi( (i, vb) => { - let doc = printValueBinding(~recFlag, i, vb) + let doc = print_value_binding(~rec_flag, i, vb) /vb.Parsetree.pvb_loc, doc/ }, vbs, ) - interleaveWhitespace(rows) + interleave_whitespace(rows) } - and printValueDescription = valueDescription => { - let isExternal = switch valueDescription.pval_prim { + and print_value_description = value_description => { + let is_external = switch value_description.pval_prim { | list() => false | _ => true } @@ -642,15 +642,15 @@ module Printer = { Doc.group( Doc.concat(list( Doc.text( - if isExternal { + if is_external { "external " } else { "let " }, ), - Doc.text(valueDescription.pval_name.txt), + Doc.text(value_description.pval_name.txt), Doc.text(": "), - printTypExpr(valueDescription.pval_type), + printTypExpr(value_description.pval_type), if isExternal { Doc.group( Doc.concat(list( @@ -667,7 +667,7 @@ module Printer = { Doc.text(s), Doc.text("\""), )), - valueDescription.pval_prim, + value_description.pval_prim, ), ), )), @@ -681,76 +681,76 @@ module Printer = { ) } - and printTypeDeclarations = (~recFlag, typeDeclarations) => { + and print_type_declarations = (~rec_flag, type_declarations) => { let rows = List.mapi( (i, td) => { - let doc = printTypeDeclaration( + let doc = print_type_declaration( ~name=Doc.text(td.Parsetree.ptype_name.txt), - ~equalSign="=", - ~recFlag, + ~equal_sign="=", + ~rec_flag, i, td, ) /td.Parsetree.ptype_loc, doc/ }, - typeDeclarations, + type_declarations, ) - interleaveWhitespace(rows) + interleave_whitespace(rows) } - and printTypeDeclaration = ( + and print_type_declaration = ( ~name, - ~equalSign, - ~recFlag, + ~equal_sign, + ~rec_flag, i, td: Parsetree.type_declaration, ) => { - let attrs = printAttributes(~loc=td.ptype_loc, td.ptype_attributes) + let attrs = print_attributes(~loc=td.ptype_loc, td.ptype_attributes) let prefix = if i > 0 { Doc.text("and ") } else { - Doc.concat(list(Doc.text("type "), recFlag)) + Doc.concat(list(Doc.text("type "), rec_flag)) } - let typeName = name - let typeParams = switch td.ptype_params { + let type_name = name + let type_params = switch td.ptype_params { | list() => Doc.nil | typeParams => Doc.group( Doc.concat(list( - Doc.lessThan, + Doc.less_than, Doc.indent( Doc.concat(list( - Doc.softLine, + Doc.soft_line, Doc.join( ~sep=Doc.concat(list(Doc.comma, Doc.line)), - List.map(printTypeParam, typeParams), + List.map(print_type_param, type_params), ), )), ), - Doc.trailingComma, - Doc.softLine, - Doc.greaterThan, + Doc.trailing_comma, + Doc.soft_line, + Doc.greater_than, )), ) } - let manifestAndKind = switch td.ptype_kind { + let manifest_and_kind = switch td.ptype_kind { | Ptype_abstract => switch td.ptype_manifest { | None => Doc.nil | Some(typ) => Doc.concat(list( - Doc.concat(list(Doc.space, Doc.text(equalSign), Doc.space)), - printPrivateFlag(td.ptype_private), - printTypExpr(typ), + Doc.concat(list(Doc.space, Doc.text(equal_sign), Doc.space)), + print_private_flag(td.ptype_private), + print_typ_expr(typ), )) } | Ptype_open => Doc.concat(list( - Doc.concat(list(Doc.space, Doc.text(equalSign), Doc.space)), - printPrivateFlag(td.ptype_private), + Doc.concat(list(Doc.space, Doc.text(equal_sign), Doc.space)), + print_private_flag(td.ptype_private), Doc.text(".."), )) | Ptype_record(lds) => @@ -758,31 +758,31 @@ module Printer = { | None => Doc.nil | Some(typ) => Doc.concat(list( - Doc.concat(list(Doc.space, Doc.text(equalSign), Doc.space)), - printTypExpr(typ), + Doc.concat(list(Doc.space, Doc.text(equal_sign), Doc.space)), + print_typ_expr(typ), )) } Doc.concat(list( manifest, - Doc.concat(list(Doc.space, Doc.text(equalSign), Doc.space)), - printPrivateFlag(td.ptype_private), - printRecordDeclaration(lds), + Doc.concat(list(Doc.space, Doc.text(equal_sign), Doc.space)), + print_private_flag(td.ptype_private), + print_record_declaration(lds), )) | Ptype_variant(cds) => let manifest = switch td.ptype_manifest { | None => Doc.nil | Some(typ) => Doc.concat(list( - Doc.concat(list(Doc.space, Doc.text(equalSign), Doc.space)), - printTypExpr(typ), + Doc.concat(list(Doc.space, Doc.text(equal_sign), Doc.space)), + print_typ_expr(typ), )) } Doc.concat(list( manifest, - Doc.concat(list(Doc.space, Doc.text(equalSign))), - printConstructorDeclarations(~privateFlag=td.ptype_private, cds), + Doc.concat(list(Doc.space, Doc.text(equal_sign))), + print_constructor_declarations(~private_flag=td.ptype_private, cds), )) } @@ -791,15 +791,15 @@ module Printer = { Doc.concat(list( attrs, prefix, - typeName, - typeParams, - manifestAndKind, + type_name, + type_params, + manifest_and_kind, constraints, )), ) } - and printTypeDefinitionConstraints = cstrs => + and print_type_definition_constraints = cstrs => switch cstrs { | list() => Doc.nil | cstrs => @@ -810,7 +810,7 @@ module Printer = { Doc.group( Doc.join( ~sep=Doc.line, - List.map(printTypeDefinitionConstraint, cstrs), + List.map(print_type_definition_constraint, cstrs), ), ), )), @@ -818,114 +818,114 @@ module Printer = { ) } - and printTypeDefinitionConstraint = ( + and print_type_definition_constraint = ( /typ1, typ2, _loc/: /Parsetree.core_type, Parsetree.core_type, Location.t/, ) => Doc.concat(list( Doc.text("constraint "), - printTypExpr(typ1), + print_typ_expr(typ1), Doc.text(" = "), - printTypExpr(typ2), + print_typ_expr(typ2), )) - and printPrivateFlag = (flag: Asttypes.private_flag) => + and print_private_flag = (flag: Asttypes.private_flag) => switch flag { | Private => Doc.text("private ") | Public => Doc.nil } - and printTypeParam = (param: /Parsetree.core_type, Asttypes.variance/) => { + and print_type_param = (param: /Parsetree.core_type, Asttypes.variance/) => { let /typ, variance/ = param - let printedVariance = switch variance { + let printed_variance = switch variance { | Covariant => Doc.text("+") | Contravariant => Doc.text("-") | Invariant => Doc.nil } - Doc.concat(list(printedVariance, printTypExpr(typ))) + Doc.concat(list(printed_variance, print_typ_expr(typ))) } - and printRecordDeclaration = (lds: list) => { - let forceBreak = switch /lds, List.rev(lds)/ { + and print_record_declaration = (lds: list) => { + let force_break = switch /lds, List.rev(lds)/ { | /list(first, ..._), list(last, ..._)/ => first.pld_loc.loc_start.pos_lnum < last.pld_loc.loc_end.pos_lnum | _ => false } Doc.breakableGroup( - ~forceBreak, + ~force_break, Doc.concat(list( Doc.lbrace, Doc.indent( Doc.concat(list( - Doc.softLine, + Doc.soft_line, Doc.join( ~sep=Doc.concat(list(Doc.comma, Doc.line)), - List.map(printLabelDeclaration, lds), + List.map(print_label_declaration, lds), ), )), ), - Doc.trailingComma, - Doc.softLine, + Doc.trailing_comma, + Doc.soft_line, Doc.rbrace, )), ) } - and printConstructorDeclarations = ( - ~privateFlag, + and print_constructor_declarations = ( + ~private_flag, cds: list, ) => { - let forceBreak = switch /cds, List.rev(cds)/ { + let force_break = switch /cds, List.rev(cds)/ { | /list(first, ..._), list(last, ..._)/ => first.pcd_loc.loc_start.pos_lnum < last.pcd_loc.loc_end.pos_lnum | _ => false } - let privateFlag = switch privateFlag { + let private_flag = switch private_flag { | Asttypes.Private => Doc.concat(list(Doc.text("private"), Doc.line)) | Public => Doc.nil } - Doc.breakableGroup( - ~forceBreak, + Doc.breakable_group( + ~force_break, Doc.indent( Doc.concat(list( Doc.line, - privateFlag, - Doc.join(~sep=Doc.line, List.mapi(printConstructorDeclaration, cds)), + private_flag, + Doc.join(~sep=Doc.line, List.mapi(print_constructor_declaration, cds)), )), ), ) } - and printConstructorDeclaration = ( + and print_constructor_declaration = ( i, cd: Parsetree.constructor_declaration, ) => { - let attrs = printAttributes(cd.pcd_attributes) + let attrs = print_attributes(cd.pcd_attributes) let bar = if i > 0 { Doc.text("| ") } else { Doc.ifBreaks(Doc.text("| "), Doc.nil) } - let constrName = Doc.text(cd.pcd_name.txt) - let constrArgs = printConstructorArguments(cd.pcd_args) + let constr_name = Doc.text(cd.pcd_name.txt) + let constr_args = print_constructor_arguments(cd.pcd_args) let gadt = switch cd.pcd_res { | None => Doc.nil | Some(typ) => - Doc.indent(Doc.concat(list(Doc.text(": "), printTypExpr(typ)))) + Doc.indent(Doc.concat(list(Doc.text(": "), print_typ_expr(typ)))) } Doc.concat(list( bar, - Doc.group(Doc.concat(list(attrs, constrName, constrArgs, gadt))), + Doc.group(Doc.concat(list(attrs, constr_name, constr_args, gadt))), )) } - and printConstructorArguments = (cdArgs: Parsetree.constructor_arguments) => - switch cdArgs { + and print_constructor_arguments = (cd_args: Parsetree.constructor_arguments) => + switch cd_args { | Pcstr_tuple(list()) => Doc.nil | Pcstr_tuple(types) => Doc.group( @@ -934,15 +934,15 @@ module Printer = { Doc.lparen, Doc.indent( Doc.concat(list( - Doc.softLine, + Doc.soft_line, Doc.join( ~sep=Doc.concat(list(Doc.comma, Doc.line)), - List.map(printTypExpr, types), + List.map(print_typ_expr, types), ), )), ), - Doc.trailingComma, - Doc.softLine, + Doc.trailing_comma, + Doc.soft_line, Doc.rparen, )), ), @@ -954,24 +954,24 @@ module Printer = { Doc.lbrace, Doc.indent( Doc.concat(list( - Doc.softLine, + Doc.soft_line, Doc.join( ~sep=Doc.concat(list(Doc.comma, Doc.line)), - List.map(printLabelDeclaration, lds), + List.map(print_label_declaration, lds), ), )), ), - Doc.trailingComma, - Doc.softLine, + Doc.trailing_comma, + Doc.soft_line, Doc.rbrace, Doc.rparen, )), ) } - and printLabelDeclaration = (ld: Parsetree.label_declaration) => { - let attrs = printAttributes(~loc=ld.pld_name.loc, ld.pld_attributes) - let mutableFlag = switch ld.pld_mutable { + and print_label_declaration = (ld: Parsetree.label_declaration) => { + let attrs = print_attributes(~loc=ld.pld_name.loc, ld.pld_attributes) + let mutable_flag = switch ld.pld_mutable { | Mutable => Doc.text("mutable ") | Immutable => Doc.nil } @@ -980,28 +980,28 @@ module Printer = { Doc.group( Doc.concat(list( attrs, - mutableFlag, + mutable_flag, name, Doc.text(": "), - printTypExpr(ld.pld_type), + print_typ_expr(ld.pld_type), )), ) } - and printTypExpr = (typExpr: Parsetree.core_type) => { - let renderedType = switch typExpr.ptyp_desc { + and print_typ_expr = (typ_expr: Parsetree.core_type) => { + let rendered_type = switch typ_expr.ptyp_desc { | Ptyp_any => Doc.text("_") | Ptyp_var(var) => Doc.text("'" ++ var) - | Ptyp_extension(extension) => printExtension(extension) + | Ptyp_extension(extension) => print_extension(extension) | Ptyp_alias(typ, alias) => let typ = { - let needsParens = switch typ.ptyp_desc { + let needs_parens = switch typ.ptyp_desc { | Ptyp_arrow(_) => true | _ => false } - let doc = printTypExpr(typ) - if needsParens { + let doc = print_typ_expr(typ) + if needs_parens { Doc.concat(list(Doc.lparen, doc, Doc.rparen)) } else { doc @@ -1048,57 +1048,57 @@ module Printer = { ), }) => Doc.concat(list( - constrName, - Doc.lessThan, - printBsObjectSugar(~inline=true, fields, openFlag), - Doc.greaterThan, + constr_name, + Doc.less_than, + print_bs_object_sugar(~inline=true, fields, open_flag), + Doc.greater_than, )) | args => Doc.group( Doc.concat(list( - constrName, - Doc.lessThan, + constr_name, + Doc.less_than, Doc.indent( Doc.concat(list( - Doc.softLine, + Doc.soft_line, Doc.join( ~sep=Doc.concat(list(Doc.comma, Doc.line)), - List.map(printTypExpr, constrArgs), + List.map(print_typ_expr, constr_args), ), )), ), - Doc.trailingComma, - Doc.softLine, - Doc.greaterThan, + Doc.trailing_comma, + Doc.soft_line, + Doc.greater_than, )), ) } | Ptyp_arrow(_) => - let /attrsBefore, args, returnType/ = ParsetreeViewer.arrowType(typExpr) - let returnTypeNeedsParens = switch returnType.ptyp_desc { + let /attrs_before, args, return_type/ = ParsetreeViewer.arrow_type(typ_expr) + let return_type_needs_parens = switch return_type.ptyp_desc { | Ptyp_alias(_) => true | _ => false } - let returnDoc = { - let doc = printTypExpr(returnType) - if returnTypeNeedsParens { + let return_doc = { + let doc = print_typ_expr(return_type) + if return_type_needs_parens { Doc.concat(list(Doc.lparen, doc, Doc.rparen)) } else { doc } } - let /isUncurried, attrs/ = ParsetreeViewer.processUncurriedAttribute( - attrsBefore, + let /is_uncurried, attrs/ = ParsetreeViewer.process_uncurried_attribute( + attrs_before, ) switch args { | list() => Doc.nil - | list(/list(), Nolabel, n/) when !isUncurried => - let hasAttrsBefore = !(attrs == list()) - let attrs = if hasAttrsBefore { + | list(/list(), Nolabel, n/) when !is_uncurried => + let has_attrs_before = !(attrs == list()) + let attrs = if has_attrs_before { Doc.concat(list( - Doc.join(~sep=Doc.line, List.map(printAttribute, attrsBefore)), + Doc.join(~sep=Doc.line, List.map(print_attribute, attrs_before)), Doc.space, )) } else { @@ -1109,22 +1109,22 @@ module Printer = { Doc.concat(list( Doc.group(attrs), Doc.group( - if hasAttrsBefore { + if has_attrs_before { Doc.concat(list( Doc.lparen, Doc.indent( Doc.concat(list( - Doc.softLine, - printTypExpr(n), + Doc.soft_line, + print_typ_expr(n), Doc.text(" => "), - returnDoc, + return_doc, )), ), - Doc.softLine, + Doc.soft_line, Doc.rparen, )) } else { - Doc.concat(list(printTypExpr(n), Doc.text(" => "), returnDoc)) + Doc.concat(list(print_typ_expr(n), Doc.text(" => "), return_doc)) }, ), )), @@ -1134,7 +1134,7 @@ module Printer = { | list() => Doc.nil | attrs => Doc.concat(list( - Doc.join(~sep=Doc.line, List.map(printAttribute, attrs)), + Doc.join(~sep=Doc.line, List.map(print_attribute, attrs)), Doc.space, )) } @@ -1144,45 +1144,45 @@ module Printer = { Doc.text("("), Doc.indent( Doc.concat(list( - Doc.softLine, - if isUncurried { + Doc.soft_line, + if is_uncurried { Doc.concat(list(Doc.dot, Doc.space)) } else { Doc.nil }, Doc.join( ~sep=Doc.concat(list(Doc.comma, Doc.line)), - List.map(printTypeParameter, args), + List.map(print_type_parameter, args), ), )), ), - Doc.trailingComma, - Doc.softLine, + Doc.trailing_comma, + Doc.soft_line, Doc.text(")"), )) - Doc.group(Doc.concat(list(renderedArgs, Doc.text(" => "), returnDoc))) + Doc.group(Doc.concat(list(rendered_args, Doc.text(" => "), return_doc))) } - | Ptyp_tuple(types) => printTupleType(~inline=false, types) - | Ptyp_object(fields, openFlag) => - printBsObjectSugar(~inline=false, fields, openFlag) - | Ptyp_poly(stringLocs, typ) => + | Ptyp_tuple(types) => print_tuple_type(~inline=false, types) + | Ptyp_object(fields, open_flag) => + print_bs_object_sugar(~inline=false, fields, open_flag) + | Ptyp_poly(string_locs, typ) => Doc.concat(list( Doc.join( ~sep=Doc.space, - List.map(({Location.txt: txt}) => Doc.text("'" ++ txt), stringLocs), + List.map(({Location.txt: txt}) => Doc.text("'" ++ txt), string_locs), ), Doc.dot, Doc.space, - printTypExpr(typ), + print_typ_expr(typ), )) | Ptyp_package(packageType) => - printPackageType(~printModuleKeywordAndParens=true, packageType) + printPackageType(~printModuleKeywordAndParens=true, package_type) | Ptyp_class(_) => failwith("classes are not supported in types") | Ptyp_variant(_) => failwith("Polymorphic variants currently not supported") } - let shouldPrintItsOwnAttributes = switch typExpr.ptyp_desc { + let should_print_its_own_attributes = switch typ_expr.ptyp_desc { | Ptyp_arrow(_) | Ptyp_constr({txt: Longident.Ldot(Longident.Lident("Js"), "t")}, _) => true @@ -1230,14 +1230,14 @@ module Printer = { Doc.text("/"), Doc.indent( Doc.concat(list( - Doc.softLine, + Doc.soft_line, Doc.join( ~sep=Doc.concat(list(Doc.comma, Doc.line)), - List.map(printTypExpr, types), + List.map(print_typ_expr, types), ), )), ), - Doc.softLine, + Doc.soft_line, Doc.text("/"), )) @@ -1248,20 +1248,20 @@ module Printer = { } } - and printObjectField = (field: Parsetree.object_field) => + and print_object_field = (field: Parsetree.object_field) => switch field { - | Otag(labelLoc, attrs, typ) => + | Otag(label_loc, attrs, typ) => Doc.concat(list( - Doc.text("\"" ++ labelLoc.txt ++ "\""), + Doc.text("\"" ++ label_loc.txt ++ "\""), Doc.text(": "), - printTypExpr(typ), + print_typ_expr(typ), )) | _ => Doc.nil } - and printTypeParameter = (/attrs, lbl, typ/) => { - let /isUncurried, attrs/ = ParsetreeViewer.processUncurriedAttribute(attrs) - let uncurried = if isUncurried { + and print_type_parameter = (/attrs, lbl, typ/) => { + let /is_uncurried, attrs/ = ParsetreeViewer.process_uncurried_attribute(attrs) + let uncurried = if is_uncurried { Doc.concat(list(Doc.dot, Doc.space)) } else { Doc.nil @@ -1270,7 +1270,7 @@ module Printer = { | list() => Doc.nil | attrs => Doc.concat(list( - Doc.join(~sep=Doc.line, List.map(printAttribute, attrs)), + Doc.join(~sep=Doc.line, List.map(print_attribute, attrs)), Doc.line, )) } @@ -1280,7 +1280,7 @@ module Printer = { | Optional(lbl) => Doc.text("~" ++ lbl ++ ": ") } - let optionalIndicator = switch lbl { + let optional_indicator = switch lbl { | Asttypes.Nolabel | Labelled(_) => Doc.nil | Optional(lbl) => Doc.text("=?") } @@ -1290,25 +1290,25 @@ module Printer = { uncurried, attrs, label, - printTypExpr(typ), - optionalIndicator, + print_typ_expr(typ), + optional_indicator, )), ) } - and printValueBinding = (~recFlag, i, vb) => { - let isGhost = ParsetreeViewer.isGhostUnitBinding(i, vb) - let header = if isGhost { + and print_value_binding = (~rec_flag, i, vb) => { + let is_ghost = ParsetreeViewer.is_ghost_unit_binding(i, vb) + let header = if is_ghost { Doc.nil } else if i === 0 { - Doc.concat(list(Doc.text("let "), recFlag)) + Doc.concat(list(Doc.text("let "), rec_flag)) } else { Doc.text("and ") } - let printedExpr = { - let exprDoc = printExpression(vb.pvb_expr) - let needsParens = switch vb.pvb_expr.pexp_desc { + let printed_expr = { + let expr_doc = print_expression(vb.pvb_expr) + let needs_parens = switch vb.pvb_expr.pexp_desc { | Pexp_constraint( {pexp_desc: Pexp_pack(_)}, {ptyp_desc: Ptyp_package(_)}, @@ -1325,11 +1325,11 @@ module Printer = { } } - if isGhost { - printedExpr + if is_ghost { + printed_expr } else { - let shouldIndent = - ParsetreeViewer.isBinaryExpression(vb.pvb_expr) || + let should_indent = + ParsetreeViewer.is_binary_expression(vb.pvb_expr) || switch vb.pvb_expr { | { pexp_attributes: list(/{Location.txt: "res.ternary"}, _/), @@ -1349,9 +1349,9 @@ module Printer = { printPattern(vb.pvb_pat), Doc.text(" ="), if shouldIndent { - Doc.indent(Doc.concat(list(Doc.line, printedExpr))) + Doc.indent(Doc.concat(list(Doc.line, printed_expr))) } else { - Doc.concat(list(Doc.space, printedExpr)) + Doc.concat(list(Doc.space, printed_expr)) }, )) } @@ -1363,13 +1363,13 @@ module Printer = { ) => { let doc = switch packageType { | /longidentLoc, list()/ => - Doc.group(Doc.concat(list(printLongident(longidentLoc.txt)))) - | /longidentLoc, packageConstraints/ => + Doc.group(Doc.concat(list(print_longident(longident_loc.txt)))) + | /longidentLoc, package_constraints/ => Doc.group( Doc.concat(list( - printLongident(longidentLoc.txt), - printPackageConstraints(packageConstraints), - Doc.softLine, + print_longident(longident_loc.txt), + print_package_constraints(package_constraints), + Doc.soft_line, )), ) } @@ -1389,13 +1389,13 @@ module Printer = { Doc.line, Doc.join( ~sep=Doc.line, - List.mapi(printPackageconstraint, packageConstraints), + List.mapi(print_packageconstraint, package_constraints), ), )), ), )) - and printPackageconstraint = (i, /longidentLoc, typ/) => { + and print_packageconstraint = (i, /longident_loc, typ/) => { let prefix = if i === 0 { Doc.text("type ") } else { @@ -1403,59 +1403,59 @@ module Printer = { } Doc.concat(list( prefix, - printLongident(longidentLoc.Location.txt), + print_longident(longident_loc.Location.txt), Doc.text(" = "), - printTypExpr(typ), + print_typ_expr(typ), )) } and printExtension = (/stringLoc, payload/) => { - let extName = Doc.text("%" ++ stringLoc.Location.txt) + let extName = Doc.text("%" ++ string_loc.Location.txt) switch payload { | PStr(list({pstr_desc: Pstr_eval(expr, attrs)})) => - let exprDoc = printExpression(expr) - let needsParens = switch attrs { + let expr_doc = print_expression(expr) + let needs_parens = switch attrs { | list() => false | _ => true } Doc.group( Doc.concat(list( - extName, - addParens( + ext_name, + add_parens( Doc.concat(list( - printAttributes(attrs), - if needsParens { - addParens(exprDoc) + print_attributes(attrs), + if needs_parens { + addParens(expr_doc) } else { - exprDoc + expr_doc }, )), ), )), ) - | _ => extName + | _ => ext_name } } - and printPattern = (p: Parsetree.pattern) => { - let patternWithoutAttributes = switch p.ppat_desc { + and print_pattern = (p: Parsetree.pattern) => { + let pattern_without_attributes = switch p.ppat_desc { | Ppat_any => Doc.text("_") - | Ppat_var(stringLoc) => Doc.text(stringLoc.txt) - | Ppat_constant(c) => printConstant(c) + | Ppat_var(string_loc) => Doc.text(string_loc.txt) + | Ppat_constant(c) => print_constant(c) | Ppat_tuple(patterns) => Doc.group( Doc.concat(list( Doc.text("/"), Doc.indent( Doc.concat(list( - Doc.softLine, + Doc.soft_line, Doc.join( ~sep=Doc.concat(list(Doc.text(","), Doc.line)), - List.map(printPattern, patterns), + List.map(print_pattern, patterns), ), )), ), - Doc.softLine, + Doc.soft_line, Doc.text("/"), )), ) @@ -1465,15 +1465,15 @@ module Printer = { Doc.text("["), Doc.indent( Doc.concat(list( - Doc.softLine, + Doc.soft_line, Doc.join( ~sep=Doc.concat(list(Doc.text(","), Doc.line)), - List.map(printPattern, patterns), + List.map(print_pattern, patterns), ), )), ), - Doc.ifBreaks(Doc.text(","), Doc.nil), - Doc.softLine, + Doc.if_breaks(Doc.text(","), Doc.nil), + Doc.soft_line, Doc.text("]"), )), ) @@ -2766,7 +2766,7 @@ module Printer = { switch lident { | Longident.Lident(txt) => list(txt, ...acc) | Ldot(lident, txt) => - let acc = if txt == "createElement" { + let acc = if txt == "create_element" { acc } else { list(txt, ...acc) diff --git a/jscomp/syntax/benchmarks/data/PrinterOcaml.ml b/jscomp/syntax/benchmarks/data/PrinterOcaml.ml index 5d94110674..9e3f5041cb 100644 --- a/jscomp/syntax/benchmarks/data/PrinterOcaml.ml +++ b/jscomp/syntax/benchmarks/data/PrinterOcaml.ml @@ -6,32 +6,32 @@ module Printer = struct (* TODO: should this go inside a ast utility module? *) - let rec collectPatternsFromListConstruct acc pattern = + let rec collect_patterns_from_list_construct acc pattern = let open Parsetree in match pattern.ppat_desc with | Ppat_construct( {txt = Longident.Lident "::"}, Some {ppat_desc=Ppat_tuple (pat::rest::[])} ) -> - collectPatternsFromListConstruct (pat::acc) rest + collect_patterns_from_list_construct (pat::acc) rest | _ -> List.rev acc, pattern - let addParens doc = + let add_parens doc = Doc.group ( Doc.concat [ Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; doc ] ); - Doc.softLine; + Doc.soft_line; Doc.rparen; ] ) - let addBraces doc = + let add_braces doc = Doc.group ( Doc.concat [ Doc.lbrace; @@ -41,30 +41,30 @@ module Printer = struct ) (* This could be done in one pass by collecting locations as we go? *) - let interleaveWhitespace ?(forceBreak=false) (rows: (Location.t * Doc.t) list) = - let rec loop prevLoc acc rows = + let interleave_whitespace ?(force_break=false) (rows: (Location.t * Doc.t) list) = + let rec loop prev_loc acc rows = match rows with | [] -> Doc.concat (List.rev acc) | (loc, doc)::rest -> - if loc.Location.loc_start.pos_lnum - prevLoc.Location.loc_end.pos_lnum > 1 then + if loc.Location.loc_start.pos_lnum - prev_loc.Location.loc_end.pos_lnum > 1 then loop loc (doc::Doc.line::Doc.line::acc) rest else loop loc (doc::Doc.line::acc) rest in match rows with | [] -> Doc.nil - | (firstLoc, firstDoc)::rest -> + | (first_loc, first_doc)::rest -> (* TODO: perf, reversing the list twice! *) - let forceBreak = forceBreak || (match List.rev rest with - | (lastLoc, _)::_ -> - firstLoc.loc_start.pos_lnum != lastLoc.loc_end.pos_lnum + let force_break = force_break || (match List.rev rest with + | (last_loc, _)::_ -> + first_loc.loc_start.pos_lnum != last_loc.loc_end.pos_lnum | _ -> false) in - Doc.breakableGroup ~forceBreak ( - loop firstLoc [firstDoc] rest + Doc.breakable_group ~force_break ( + loop first_loc [first_doc] rest ) - let printLongident l = match l with + let print_longident l = match l with | Longident.Lident lident -> Doc.text lident | Longident.Ldot (lident, txt) as l -> let txts = Longident.flatten l in @@ -72,7 +72,7 @@ module Printer = struct | _ -> failwith "unsupported ident" (* TODO: better allocation strategy for the buffer *) - let escapeStringContents s = + let escape_string_contents s = let len = String.length s in let b = Buffer.create len in for i = 0 to len - 1 do @@ -101,115 +101,115 @@ module Printer = struct done; Buffer.contents b - let printConstant c = match c with + let print_constant c = match c with | Parsetree.Pconst_integer (s, _) -> Doc.text s - | Pconst_string (s, _) -> Doc.text ("\"" ^ (escapeStringContents s) ^ "\"") + | Pconst_string (s, _) -> Doc.text ("\"" ^ (escape_string_contents s) ^ "\"") | Pconst_float (s, _) -> Doc.text s | Pconst_char c -> Doc.text ("'" ^ (Char.escaped c) ^ "'") - let rec printStructure (s : Parsetree.structure) = - interleaveWhitespace ( - List.map (fun si -> (si.Parsetree.pstr_loc, printStructureItem si)) s + let rec print_structure (s : Parsetree.structure) = + interleave_whitespace ( + List.map (fun si -> (si.Parsetree.pstr_loc, print_structure_item si)) s ) - and printStructureItem (si: Parsetree.structure_item) = + and print_structure_item (si: Parsetree.structure_item) = match si.pstr_desc with - | Pstr_value(rec_flag, valueBindings) -> - let recFlag = match rec_flag with + | Pstr_value(rec_flag, value_bindings) -> + let rec_flag = match rec_flag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printValueBindings ~recFlag valueBindings - | Pstr_type(recFlag, typeDeclarations) -> - let recFlag = match recFlag with + print_value_bindings ~rec_flag value_bindings + | Pstr_type(rec_flag, type_declarations) -> + let rec_flag = match rec_flag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~recFlag typeDeclarations - | Pstr_primitive valueDescription -> - printValueDescription valueDescription + print_type_declarations ~rec_flag type_declarations + | Pstr_primitive value_description -> + print_value_description value_description | Pstr_eval (expr, attrs) -> - let needsParens = match expr with + let needs_parens = match expr with | {pexp_attributes=[({txt="res.ternary"},_)]; pexp_desc = Pexp_ifthenelse _} -> false - | _ when ParsetreeViewer.hasAttributes expr.pexp_attributes -> true + | _ when ParsetreeViewer.has_attributes expr.pexp_attributes -> true | _ -> false in - let exprDoc = - let doc = printExpression expr in - if needsParens then addParens doc else doc + let expr_doc = + let doc = print_expression expr in + if needs_parens then add_parens doc else doc in Doc.concat [ - printAttributes attrs; - exprDoc; + print_attributes attrs; + expr_doc; ] - | Pstr_attribute attr -> Doc.concat [Doc.text "@"; printAttribute attr] + | Pstr_attribute attr -> Doc.concat [Doc.text "@"; print_attribute attr] | Pstr_extension (extension, attrs) -> Doc.concat [ - printAttributes attrs; - Doc.concat [Doc.text "%";printExtension extension]; + print_attributes attrs; + Doc.concat [Doc.text "%";print_extension extension]; ] - | Pstr_include includeDeclaration -> - printIncludeDeclaration includeDeclaration - | Pstr_open openDescription -> - printOpenDescription openDescription - | Pstr_modtype modTypeDecl -> - printModuleTypeDeclaration modTypeDecl - | Pstr_module moduleBinding -> - printModuleBinding ~isRec:false 0 moduleBinding - | Pstr_recmodule moduleBindings -> + | Pstr_include include_declaration -> + print_include_declaration include_declaration + | Pstr_open open_description -> + print_open_description open_description + | Pstr_modtype mod_type_decl -> + print_module_type_declaration mod_type_decl + | Pstr_module module_binding -> + print_module_binding ~is_rec:false 0 module_binding + | Pstr_recmodule module_bindings -> Doc.join ~sep:Doc.line (List.mapi (fun i mb -> - printModuleBinding ~isRec:true i mb - ) moduleBindings) - | Pstr_exception extensionConstructor -> - printExceptionDef extensionConstructor; - | Pstr_typext typeExtension -> - printTypeExtension typeExtension + print_module_binding ~is_rec:true i mb + ) module_bindings) + | Pstr_exception extension_constructor -> + print_exception_def extension_constructor; + | Pstr_typext type_extension -> + print_type_extension type_extension | Pstr_class _ | Pstr_class_type _ -> Doc.nil - and printTypeExtension (te : Parsetree.type_extension) = + and print_type_extension (te : Parsetree.type_extension) = let prefix = Doc.text "type " in - let name = printLongident te.ptyext_path.txt in - let typeParams = match te.ptyext_params with + let name = print_longident te.ptyext_path.txt in + let type_params = match te.ptyext_params with | [] -> Doc.nil - | typeParams -> Doc.group ( + | type_params -> Doc.group ( Doc.concat [ - Doc.lessThan; + Doc.less_than; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printTypeParam typeParams + List.map print_type_param type_params ) ] ); - Doc.trailingComma; - Doc.softLine; - Doc.greaterThan; + Doc.trailing_comma; + Doc.soft_line; + Doc.greater_than; ] ) in - let extensionConstructors = + let extension_constructors = let ecs = te.ptyext_constructors in - let forceBreak = + let force_break = 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 privateFlag = match te.ptyext_private with + let private_flag = match te.ptyext_private with | Asttypes.Private -> Doc.concat [ Doc.text "private"; Doc.line; ] | Public -> Doc.nil in - Doc.breakableGroup ~forceBreak ( + Doc.breakable_group ~force_break ( Doc.indent ( Doc.concat [ Doc.line; - privateFlag; + private_flag; Doc.join ~sep:Doc.line ( - List.mapi printExtensionConstructor ecs + List.mapi print_extension_constructor ecs ) ] ) @@ -217,74 +217,74 @@ module Printer = struct in Doc.group ( Doc.concat [ - printAttributes ~loc: te.ptyext_path.loc te.ptyext_attributes; + print_attributes ~loc: te.ptyext_path.loc te.ptyext_attributes; prefix; name; - typeParams; + type_params; Doc.text " +="; - extensionConstructors; + extension_constructors; ] ) - and printModuleBinding ~isRec i moduleBinding = + and print_module_binding ~is_rec i module_binding = let prefix = if i = 0 then Doc.concat [ Doc.text "module "; - if isRec then Doc.text "rec " else Doc.nil; + if is_rec then Doc.text "rec " else Doc.nil; ] else Doc.text "and " in - let (modExprDoc, modConstraintDoc) = - match moduleBinding.pmb_expr with - | {pmod_desc = Pmod_constraint (modExpr, modType)} -> + let (mod_expr_doc, mod_constraint_doc) = + match module_binding.pmb_expr with + | {pmod_desc = Pmod_constraint (mod_expr, mod_type)} -> ( - printModExpr modExpr, + print_mod_expr mod_expr, Doc.concat [ Doc.text ": "; - printModType modType + print_mod_type mod_type ] ) - | modExpr -> - (printModExpr modExpr, Doc.nil) + | mod_expr -> + (print_mod_expr mod_expr, Doc.nil) in Doc.concat [ - printAttributes ~loc:moduleBinding.pmb_name.loc moduleBinding.pmb_attributes; + print_attributes ~loc:module_binding.pmb_name.loc module_binding.pmb_attributes; prefix; - Doc.text moduleBinding.pmb_name.Location.txt; - modConstraintDoc; + Doc.text module_binding.pmb_name.Location.txt; + mod_constraint_doc; Doc.text " = "; - modExprDoc; + mod_expr_doc; ] - and printModuleTypeDeclaration (modTypeDecl : Parsetree.module_type_declaration) = + and print_module_type_declaration (mod_type_decl : Parsetree.module_type_declaration) = Doc.concat [ - printAttributes modTypeDecl.pmtd_attributes; + print_attributes mod_type_decl.pmtd_attributes; Doc.text "module type "; - Doc.text modTypeDecl.pmtd_name.txt; - (match modTypeDecl.pmtd_type with + Doc.text mod_type_decl.pmtd_name.txt; + (match mod_type_decl.pmtd_type with | None -> Doc.nil - | Some modType -> Doc.concat [ + | Some mod_type -> Doc.concat [ Doc.text " = "; - printModType modType; + print_mod_type mod_type; ]); ] - and printModType modType = - let modTypeDoc = match modType.pmty_desc with + and print_mod_type mod_type = + let mod_type_doc = match mod_type.pmty_desc with | Parsetree.Pmty_ident {txt = longident; loc} -> Doc.concat [ - printAttributes ~loc modType.pmty_attributes; - printLongident longident + print_attributes ~loc mod_type.pmty_attributes; + print_longident longident ] | Pmty_signature signature -> - let signatureDoc = Doc.breakableGroup ~forceBreak:true ( + let signature_doc = Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.lbrace; Doc.indent ( Doc.concat [ Doc.line; - printSignature signature; + print_signature signature; ] ); Doc.line; @@ -292,23 +292,23 @@ module Printer = struct ] ) in Doc.concat [ - printAttributes modType.pmty_attributes; - signatureDoc + print_attributes mod_type.pmty_attributes; + signature_doc ] | Pmty_functor _ -> - let (parameters, returnType) = ParsetreeViewer.functorType modType in - let parametersDoc = match parameters with + let (parameters, return_type) = ParsetreeViewer.functor_type mod_type in + let parameters_doc = match parameters with | [] -> Doc.nil - | [attrs, {Location.txt = "_"}, Some modType] -> + | [attrs, {Location.txt = "_"}, Some mod_type] -> let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.line; ] in Doc.concat [ attrs; - printModType modType + print_mod_type mod_type ] | params -> Doc.group ( @@ -316,64 +316,64 @@ module Printer = struct Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map (fun (attrs, lbl, modType) -> + List.map (fun (attrs, lbl, mod_type) -> let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.line; ] in Doc.concat [ attrs; if lbl.Location.txt = "_" then Doc.nil else Doc.text lbl.txt; - (match modType with + (match mod_type with | None -> Doc.nil - | Some modType -> Doc.concat [ + | Some mod_type -> Doc.concat [ if lbl.txt = "_" then Doc.nil else Doc.text ": "; - printModType modType; + print_mod_type mod_type; ]); ] ) params ); ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) in - let returnDoc = - let doc = printModType returnType in - if Parens.modTypeFunctorReturn returnType then addParens doc else doc + let return_doc = + let doc = print_mod_type return_type in + if Parens.mod_type_functor_return return_type then add_parens doc else doc in Doc.group ( Doc.concat [ - parametersDoc; + parameters_doc; Doc.group ( Doc.concat [ Doc.text " =>"; Doc.line; - returnDoc; + return_doc; ] ) ] ) - | Pmty_typeof modExpr -> Doc.concat [ + | Pmty_typeof mod_expr -> Doc.concat [ Doc.text "module type of "; - printModExpr modExpr; + print_mod_expr mod_expr; ] - | Pmty_extension extension -> printExtension extension + | Pmty_extension extension -> print_extension extension | Pmty_alias {txt = longident} -> Doc.concat [ Doc.text "module "; - printLongident longident; + print_longident longident; ] - | Pmty_with (modType, withConstraints) -> + | Pmty_with (mod_type, with_constraints) -> let operand = - let doc = printModType modType in - if Parens.modTypeWithOperand modType then addParens doc else doc + let doc = print_mod_type mod_type in + if Parens.mod_type_with_operand mod_type then add_parens doc else doc in Doc.group ( Doc.concat [ @@ -381,186 +381,186 @@ module Printer = struct Doc.indent ( Doc.concat [ Doc.line; - printWithConstraints withConstraints; + print_with_constraints with_constraints; ] ) ] ) in - let attrsAlreadyPrinted = match modType.pmty_desc with + let attrs_already_printed = match mod_type.pmty_desc with | Pmty_functor _ | Pmty_signature _ | Pmty_ident _ -> true | _ -> false in Doc.concat [ - if attrsAlreadyPrinted then Doc.nil else printAttributes modType.pmty_attributes; - modTypeDoc; + if attrs_already_printed then Doc.nil else print_attributes mod_type.pmty_attributes; + mod_type_doc; ] - and printWithConstraints withConstraints = - let rows =List.mapi (fun i withConstraint -> + and print_with_constraints with_constraints = + let rows =List.mapi (fun i with_constraint -> Doc.group ( Doc.concat [ if i == 0 then Doc.text "with " else Doc.text "and "; - printWithConstraint withConstraint; + print_with_constraint with_constraint; ] ) - ) withConstraints + ) with_constraints in Doc.join ~sep:Doc.line rows - and printWithConstraint (withConstraint : Parsetree.with_constraint) = - match withConstraint with + and print_with_constraint (with_constraint : Parsetree.with_constraint) = + match with_constraint with (* with type X.t = ... *) - | Pwith_type ({txt = longident}, typeDeclaration) -> - Doc.group (printTypeDeclaration - ~name:(printLongident longident) - ~equalSign:"=" - ~recFlag:Doc.nil + | Pwith_type ({txt = longident}, type_declaration) -> + Doc.group (print_type_declaration + ~name:(print_longident longident) + ~equal_sign:"=" + ~rec_flag:Doc.nil 0 - typeDeclaration) + type_declaration) (* with module X.Y = Z *) | Pwith_module ({txt = longident1}, {txt = longident2}) -> Doc.concat [ Doc.text "module "; - printLongident longident1; + print_longident longident1; Doc.text " ="; Doc.indent ( Doc.concat [ Doc.line; - printLongident longident2; + print_longident longident2; ] ) ] (* with type X.t := ..., same format as [Pwith_type] *) - | Pwith_typesubst ({txt = longident}, typeDeclaration) -> - Doc.group(printTypeDeclaration - ~name:(printLongident longident) - ~equalSign:":=" - ~recFlag:Doc.nil + | Pwith_typesubst ({txt = longident}, type_declaration) -> + Doc.group(print_type_declaration + ~name:(print_longident longident) + ~equal_sign:":=" + ~rec_flag:Doc.nil 0 - typeDeclaration) + type_declaration) | Pwith_modsubst ({txt = longident1}, {txt = longident2}) -> Doc.concat [ Doc.text "module "; - printLongident longident1; + print_longident longident1; Doc.text " :="; Doc.indent ( Doc.concat [ Doc.line; - printLongident longident2; + print_longident longident2; ] ) ] - and printSignature signature = - interleaveWhitespace ( - List.map (fun si -> (si.Parsetree.psig_loc, printSignatureItem si)) signature + and print_signature signature = + interleave_whitespace ( + List.map (fun si -> (si.Parsetree.psig_loc, print_signature_item si)) signature ) - and printSignatureItem (si : Parsetree.signature_item) = + and print_signature_item (si : Parsetree.signature_item) = match si.psig_desc with - | Parsetree.Psig_value valueDescription -> - printValueDescription valueDescription - | Psig_type (recFlag, typeDeclarations) -> - let recFlag = match recFlag with + | Parsetree.Psig_value value_description -> + print_value_description value_description + | Psig_type (rec_flag, type_declarations) -> + let rec_flag = match rec_flag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~recFlag typeDeclarations - | Psig_typext typeExtension -> - printTypeExtension typeExtension - | Psig_exception extensionConstructor -> - printExceptionDef extensionConstructor - | Psig_module moduleDeclaration -> - printModuleDeclaration moduleDeclaration - | Psig_recmodule moduleDeclarations -> - printRecModuleDeclarations moduleDeclarations - | Psig_modtype modTypeDecl -> - printModuleTypeDeclaration modTypeDecl - | Psig_open openDescription -> - printOpenDescription openDescription - | Psig_include includeDescription -> - printIncludeDescription includeDescription - | Psig_attribute attr -> Doc.concat [Doc.text "@"; printAttribute attr] + print_type_declarations ~rec_flag type_declarations + | Psig_typext type_extension -> + print_type_extension type_extension + | Psig_exception extension_constructor -> + print_exception_def extension_constructor + | Psig_module module_declaration -> + print_module_declaration module_declaration + | Psig_recmodule module_declarations -> + print_rec_module_declarations module_declarations + | Psig_modtype mod_type_decl -> + print_module_type_declaration mod_type_decl + | Psig_open open_description -> + print_open_description open_description + | Psig_include include_description -> + print_include_description include_description + | Psig_attribute attr -> Doc.concat [Doc.text "@"; print_attribute attr] | Psig_extension (extension, attrs) -> Doc.concat [ - printAttributes attrs; - Doc.concat [Doc.text "%";printExtension extension]; + print_attributes attrs; + Doc.concat [Doc.text "%";print_extension extension]; ] | Psig_class _ | Psig_class_type _ -> Doc.nil - and printRecModuleDeclarations moduleDeclarations = + and print_rec_module_declarations module_declarations = Doc.group ( Doc.join ~sep:Doc.line ( List.mapi (fun i (md: Parsetree.module_declaration) -> let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias {txt = longident } -> - Doc.concat [Doc.text " = "; printLongident longident] + Doc.concat [Doc.text " = "; print_longident longident] | _ -> - let needsParens = match md.pmd_type.pmty_desc with + let needs_parens = match md.pmd_type.pmty_desc with | Pmty_with _ -> true | _ -> false in - let modTypeDoc = - let doc = printModType md.pmd_type in - if needsParens then addParens doc else doc + let mod_type_doc = + let doc = print_mod_type md.pmd_type in + if needs_parens then add_parens doc else doc in - Doc.concat [Doc.text ": "; modTypeDoc] + Doc.concat [Doc.text ": "; mod_type_doc] in let prefix = if i < 1 then "module rec " else "and " in Doc.concat [ - printAttributes ~loc:md.pmd_name.loc md.pmd_attributes; + print_attributes ~loc:md.pmd_name.loc md.pmd_attributes; Doc.text prefix; Doc.text md.pmd_name.txt; body ] - ) moduleDeclarations + ) module_declarations ) ) - and printModuleDeclaration (md: Parsetree.module_declaration) = + and print_module_declaration (md: Parsetree.module_declaration) = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias {txt = longident } -> - Doc.concat [Doc.text " = "; printLongident longident] - | _ -> Doc.concat [Doc.text ": "; printModType md.pmd_type] + Doc.concat [Doc.text " = "; print_longident longident] + | _ -> Doc.concat [Doc.text ": "; print_mod_type md.pmd_type] in Doc.concat [ - printAttributes ~loc:md.pmd_name.loc md.pmd_attributes; + print_attributes ~loc:md.pmd_name.loc md.pmd_attributes; Doc.text "module "; Doc.text md.pmd_name.txt; body ] - and printOpenDescription (openDescription : Parsetree.open_description) = + and print_open_description (open_description : Parsetree.open_description) = Doc.concat [ - printAttributes openDescription.popen_attributes; + print_attributes open_description.popen_attributes; Doc.text "open"; - (match openDescription.popen_override with + (match open_description.popen_override with | Asttypes.Fresh -> Doc.space | Asttypes.Override -> Doc.text "! "); - printLongident openDescription.popen_lid.txt + print_longident open_description.popen_lid.txt ] - and printIncludeDescription (includeDescription: Parsetree.include_description) = + and print_include_description (include_description: Parsetree.include_description) = Doc.concat [ - printAttributes includeDescription.pincl_attributes; + print_attributes include_description.pincl_attributes; Doc.text "include "; - printModType includeDescription.pincl_mod; + print_mod_type include_description.pincl_mod; ] - and printIncludeDeclaration (includeDeclaration : Parsetree.include_declaration) = + and print_include_declaration (include_declaration : Parsetree.include_declaration) = Doc.concat [ - printAttributes includeDeclaration.pincl_attributes; + print_attributes include_declaration.pincl_attributes; Doc.text "include "; - printModExpr includeDeclaration.pincl_mod; + print_mod_expr include_declaration.pincl_mod; ] - and printValueBindings ~recFlag (vbs: Parsetree.value_binding list) = + and print_value_bindings ~rec_flag (vbs: Parsetree.value_binding list) = let rows = List.mapi (fun i vb -> - let doc = printValueBinding ~recFlag i vb in + let doc = print_value_binding ~rec_flag i vb in (vb.Parsetree.pvb_loc, doc) ) vbs in - interleaveWhitespace rows + interleave_whitespace rows (* * type value_description = { @@ -571,17 +571,17 @@ module Printer = struct * pval_loc : Location.t; * } *) - and printValueDescription valueDescription = - let isExternal = - match valueDescription.pval_prim with | [] -> false | _ -> true + and print_value_description value_description = + let is_external = + match value_description.pval_prim with | [] -> false | _ -> true in Doc.group ( Doc.concat [ - Doc.text (if isExternal then "external " else "let "); - Doc.text valueDescription.pval_name.txt; + Doc.text (if is_external then "external " else "let "); + Doc.text value_description.pval_name.txt; Doc.text ": "; - printTypExpr valueDescription.pval_type; - if isExternal then + print_typ_expr value_description.pval_type; + if is_external then Doc.group ( Doc.concat [ Doc.text " ="; @@ -594,7 +594,7 @@ module Printer = struct Doc.text s; Doc.text "\""; ]) - valueDescription.pval_prim + value_description.pval_prim ); ] ) @@ -604,17 +604,17 @@ module Printer = struct ] ) - and printTypeDeclarations ~recFlag typeDeclarations = + and print_type_declarations ~rec_flag type_declarations = let rows = List.mapi (fun i td -> - let doc = printTypeDeclaration + let doc = print_type_declaration ~name:(Doc.text td.Parsetree.ptype_name.txt) - ~equalSign:"=" - ~recFlag + ~equal_sign:"=" + ~rec_flag i td in (td.Parsetree.ptype_loc, doc) - ) typeDeclarations in - interleaveWhitespace rows + ) type_declarations in + interleave_whitespace rows (* * type_declaration = { @@ -648,90 +648,90 @@ module Printer = struct * (* Invariant: non-empty list *) * | Ptype_open *) - and printTypeDeclaration ~name ~equalSign ~recFlag i (td: Parsetree.type_declaration) = - let attrs = printAttributes ~loc:td.ptype_loc td.ptype_attributes in + and print_type_declaration ~name ~equal_sign ~rec_flag i (td: Parsetree.type_declaration) = + let attrs = print_attributes ~loc:td.ptype_loc td.ptype_attributes in let prefix = if i > 0 then Doc.text "and " else - Doc.concat [Doc.text "type "; recFlag] + Doc.concat [Doc.text "type "; rec_flag] in - let typeName = name in - let typeParams = match td.ptype_params with + let type_name = name in + let type_params = match td.ptype_params with | [] -> Doc.nil - | typeParams -> Doc.group ( + | type_params -> Doc.group ( Doc.concat [ - Doc.lessThan; + Doc.less_than; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printTypeParam typeParams + List.map print_type_param type_params ) ] ); - Doc.trailingComma; - Doc.softLine; - Doc.greaterThan; + Doc.trailing_comma; + Doc.soft_line; + Doc.greater_than; ] ) in - let manifestAndKind = match td.ptype_kind with + let manifest_and_kind = match td.ptype_kind with | Ptype_abstract -> begin match td.ptype_manifest with | None -> Doc.nil | Some(typ) -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; - printTypExpr typ; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; + print_typ_expr typ; ] end | Ptype_open -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; Doc.text ".."; ] | Ptype_record(lds) -> let manifest = match td.ptype_manifest with | None -> Doc.nil | Some(typ) -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr typ; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_typ_expr typ; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; - printRecordDeclaration lds; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; + print_record_declaration lds; ] | Ptype_variant(cds) -> let manifest = match td.ptype_manifest with | None -> Doc.nil | Some(typ) -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr typ; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_typ_expr typ; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~privateFlag:td.ptype_private cds; + Doc.concat [Doc.space; Doc.text equal_sign]; + print_constructor_declarations ~private_flag:td.ptype_private cds; ] in - let constraints = printTypeDefinitionConstraints td.ptype_cstrs in + let constraints = print_type_definition_constraints td.ptype_cstrs in Doc.group ( Doc.concat [ attrs; prefix; - typeName; - typeParams; - manifestAndKind; + type_name; + type_params; + manifest_and_kind; constraints; ] ) - and printTypeDefinitionConstraints cstrs = + and print_type_definition_constraints cstrs = match cstrs with | [] -> Doc.nil | cstrs -> Doc.indent ( @@ -740,79 +740,79 @@ module Printer = struct Doc.line; Doc.group( Doc.join ~sep:Doc.line ( - List.map printTypeDefinitionConstraint cstrs + List.map print_type_definition_constraint cstrs ) ) ] ) ) - and printTypeDefinitionConstraint ((typ1, typ2, _loc ): Parsetree.core_type * Parsetree.core_type * Location.t) = + and print_type_definition_constraint ((typ1, typ2, _loc ): Parsetree.core_type * Parsetree.core_type * Location.t) = Doc.concat [ Doc.text "constraint "; - printTypExpr typ1; + print_typ_expr typ1; Doc.text " = "; - printTypExpr typ2; + print_typ_expr typ2; ] - and printPrivateFlag (flag : Asttypes.private_flag) = match flag with + and print_private_flag (flag : Asttypes.private_flag) = match flag with | Private -> Doc.text "private " | Public -> Doc.nil - and printTypeParam (param : (Parsetree.core_type * Asttypes.variance)) = + and print_type_param (param : (Parsetree.core_type * Asttypes.variance)) = let (typ, variance) = param in - let printedVariance = match variance with + let printed_variance = match variance with | Covariant -> Doc.text "+" | Contravariant -> Doc.text "-" | Invariant -> Doc.nil in Doc.concat [ - printedVariance; - printTypExpr typ + printed_variance; + print_typ_expr typ ] - and printRecordDeclaration (lds: Parsetree.label_declaration list) = - let forceBreak = match (lds, List.rev lds) with + and print_record_declaration (lds: Parsetree.label_declaration list) = + let force_break = 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.breakableGroup ~forceBreak ( + Doc.breakable_group ~force_break ( Doc.concat [ Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map printLabelDeclaration lds) + (List.map print_label_declaration lds) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ] ) - and printConstructorDeclarations ~privateFlag (cds: Parsetree.constructor_declaration list) = - let forceBreak = match (cds, List.rev cds) with + and print_constructor_declarations ~private_flag (cds: Parsetree.constructor_declaration list) = + let force_break = 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 privateFlag = match privateFlag with + let private_flag = match private_flag with | Asttypes.Private -> Doc.concat [ Doc.text "private"; Doc.line; ] | Public -> Doc.nil in - Doc.breakableGroup ~forceBreak ( + Doc.breakable_group ~force_break ( Doc.indent ( Doc.concat [ Doc.line; - privateFlag; + private_flag; Doc.join ~sep:Doc.line ( - List.mapi printConstructorDeclaration cds + List.mapi print_constructor_declaration cds ) ] ) @@ -827,19 +827,19 @@ module Printer = struct * pcd_attributes: attributes; (* C of ... [@id1] [@id2] *) * } *) - and printConstructorDeclaration i (cd : Parsetree.constructor_declaration) = - let attrs = printAttributes cd.pcd_attributes in + and print_constructor_declaration i (cd : Parsetree.constructor_declaration) = + let attrs = print_attributes cd.pcd_attributes in let bar = if i > 0 then Doc.text "| " - else Doc.ifBreaks (Doc.text "| ") Doc.nil + else Doc.if_breaks (Doc.text "| ") Doc.nil in - let constrName = Doc.text cd.pcd_name.txt in - let constrArgs = printConstructorArguments cd.pcd_args in + let constr_name = Doc.text cd.pcd_name.txt in + let constr_args = print_constructor_arguments cd.pcd_args in let gadt = match cd.pcd_res with | None -> Doc.nil | Some(typ) -> Doc.indent ( Doc.concat [ Doc.text ": "; - printTypExpr typ; + print_typ_expr typ; ] ) in @@ -848,15 +848,15 @@ module Printer = struct Doc.group ( Doc.concat [ attrs; (* TODO: fix parsing of attributes, so when can print them above the bar? *) - constrName; - constrArgs; + constr_name; + constr_args; gadt; ] ) ] - and printConstructorArguments (cdArgs : Parsetree.constructor_arguments) = - match cdArgs with + and print_constructor_arguments (cd_args : Parsetree.constructor_arguments) = + match cd_args with | Pcstr_tuple [] -> Doc.nil | Pcstr_tuple types -> Doc.group ( Doc.indent ( @@ -864,14 +864,14 @@ module Printer = struct Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printTypExpr types + List.map print_typ_expr types ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) @@ -884,22 +884,22 @@ module Printer = struct Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map printLabelDeclaration lds) + (List.map print_label_declaration lds) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; Doc.rparen; ] ) - and printLabelDeclaration (ld : Parsetree.label_declaration) = - let attrs = printAttributes ~loc:ld.pld_name.loc ld.pld_attributes in - let mutableFlag = match ld.pld_mutable with + and print_label_declaration (ld : Parsetree.label_declaration) = + let attrs = print_attributes ~loc:ld.pld_name.loc ld.pld_attributes in + let mutable_flag = match ld.pld_mutable with | Mutable -> Doc.text "mutable " | Immutable -> Doc.nil in @@ -907,112 +907,112 @@ module Printer = struct Doc.group ( Doc.concat [ attrs; - mutableFlag; + mutable_flag; name; Doc.text ": "; - printTypExpr ld.pld_type; + print_typ_expr ld.pld_type; ] ) - and printTypExpr (typExpr : Parsetree.core_type) = - let renderedType = match typExpr.ptyp_desc with + and print_typ_expr (typ_expr : Parsetree.core_type) = + let rendered_type = match typ_expr.ptyp_desc with | Ptyp_any -> Doc.text "_" | Ptyp_var var -> Doc.text ("'" ^ var) | Ptyp_extension(extension) -> - printExtension extension + print_extension extension | 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 needsParens = match typ.ptyp_desc with + let needs_parens = match typ.ptyp_desc with | Ptyp_arrow _ -> true | _ -> false in - let doc = printTypExpr typ in - if needsParens then + let doc = print_typ_expr typ in + if needs_parens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in Doc.concat [typ; Doc.text " as "; Doc.text ("'" ^ alias)] | Ptyp_constr({txt = Longident.Ldot(Longident.Lident "Js", "t")}, [typ]) -> - let bsObject = printTypExpr typ in - begin match typExpr.ptyp_attributes with - | [] -> bsObject + let bs_object = print_typ_expr typ in + begin match typ_expr.ptyp_attributes with + | [] -> bs_object | attrs -> Doc.concat [ Doc.group ( - Doc.join ~sep:Doc.line (List.map printAttribute attrs) + Doc.join ~sep:Doc.line (List.map print_attribute attrs) ); Doc.space; - printTypExpr typ; + print_typ_expr typ; ] end - | Ptyp_constr(longidentLoc, [{ ptyp_desc = Parsetree.Ptyp_tuple tuple }]) -> - let constrName = printLongident longidentLoc.txt in + | Ptyp_constr(longident_loc, [{ ptyp_desc = Parsetree.Ptyp_tuple tuple }]) -> + let constr_name = print_longident longident_loc.txt in Doc.group( Doc.concat([ - constrName; - Doc.lessThan; - printTupleType ~inline:true tuple; - Doc.greaterThan; + constr_name; + Doc.less_than; + print_tuple_type ~inline:true tuple; + Doc.greater_than; ]) ) - | Ptyp_constr(longidentLoc, constrArgs) -> - let constrName = printLongident longidentLoc.txt in - begin match constrArgs with - | [] -> constrName + | Ptyp_constr(longident_loc, constr_args) -> + let constr_name = print_longident longident_loc.txt in + begin match constr_args with + | [] -> constr_name | [{ Parsetree.ptyp_desc = Ptyp_constr({txt = Longident.Ldot(Longident.Lident "Js", "t")}, - [{ptyp_desc = Ptyp_object (fields, openFlag)}]) + [{ptyp_desc = Ptyp_object (fields, open_flag)}]) }] -> Doc.concat([ - constrName; - Doc.lessThan; - printBsObjectSugar ~inline:true fields openFlag; - Doc.greaterThan; + constr_name; + Doc.less_than; + print_bs_object_sugar ~inline:true fields open_flag; + Doc.greater_than; ]) | args -> Doc.group( Doc.concat([ - constrName; - Doc.lessThan; + constr_name; + Doc.less_than; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printTypExpr constrArgs + List.map print_typ_expr constr_args ) ] ); - Doc.trailingComma; - Doc.softLine; - Doc.greaterThan; + Doc.trailing_comma; + Doc.soft_line; + Doc.greater_than; ]) ) end | Ptyp_arrow _ -> - let (attrsBefore, args, returnType) = ParsetreeViewer.arrowType typExpr in - let returnTypeNeedsParens = match returnType.ptyp_desc with + let (attrs_before, args, return_type) = ParsetreeViewer.arrow_type typ_expr in + let return_type_needs_parens = match return_type.ptyp_desc with | Ptyp_alias _ -> true | _ -> false in - let returnDoc = - let doc = printTypExpr returnType in - if returnTypeNeedsParens then + let return_doc = + let doc = print_typ_expr return_type in + if return_type_needs_parens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - let (isUncurried, attrs) = ParsetreeViewer.processUncurriedAttribute attrsBefore in + let (is_uncurried, attrs) = ParsetreeViewer.process_uncurried_attribute attrs_before in begin match args with | [] -> Doc.nil - | [([], Nolabel, n)] when not isUncurried -> - let hasAttrsBefore = not (attrs = []) in - let attrs = if hasAttrsBefore then + | [([], Nolabel, n)] when not is_uncurried -> + let has_attrs_before = not (attrs = []) in + let attrs = if has_attrs_before then Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrsBefore); + Doc.join ~sep:Doc.line (List.map print_attribute attrs_before); Doc.space; ] else Doc.nil @@ -1021,25 +1021,25 @@ module Printer = struct Doc.concat [ Doc.group attrs; Doc.group ( - if hasAttrsBefore then + if has_attrs_before then Doc.concat [ Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; - printTypExpr n; + Doc.soft_line; + print_typ_expr n; Doc.text " => "; - returnDoc; + return_doc; ] ); - Doc.softLine; + Doc.soft_line; Doc.rparen ] else Doc.concat [ - printTypExpr n; + print_typ_expr n; Doc.text " => "; - returnDoc; + return_doc; ] ) ] @@ -1048,68 +1048,68 @@ module Printer = struct let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.space; ] in - let renderedArgs = Doc.concat [ + let rendered_args = Doc.concat [ attrs; Doc.text "("; Doc.indent ( Doc.concat [ - Doc.softLine; - if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil; + Doc.soft_line; + if is_uncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printTypeParameter args + List.map print_type_parameter args ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.text ")"; ] in Doc.group ( Doc.concat [ - renderedArgs; + rendered_args; Doc.text " => "; - returnDoc; + return_doc; ] ) end - | Ptyp_tuple types -> printTupleType ~inline:false types - | Ptyp_object (fields, openFlag) -> - printBsObjectSugar ~inline:false fields openFlag - | Ptyp_poly(stringLocs, typ) -> + | Ptyp_tuple types -> print_tuple_type ~inline:false types + | Ptyp_object (fields, open_flag) -> + print_bs_object_sugar ~inline:false fields open_flag + | Ptyp_poly(string_locs, typ) -> Doc.concat [ Doc.join ~sep:Doc.space (List.map (fun {Location.txt} -> - Doc.text ("'" ^ txt)) stringLocs); + Doc.text ("'" ^ txt)) string_locs); Doc.dot; Doc.space; - printTypExpr typ + print_typ_expr typ ] - | Ptyp_package packageType -> - printPackageType ~printModuleKeywordAndParens:true packageType + | Ptyp_package package_type -> + print_package_type ~print_module_keyword_and_parens:true package_type | Ptyp_class _ -> failwith "classes are not supported in types" | Ptyp_variant _ -> failwith "Polymorphic variants currently not supported" in - let shouldPrintItsOwnAttributes = match typExpr.ptyp_desc with + let should_print_its_own_attributes = match typ_expr.ptyp_desc with | Ptyp_arrow _ (* es6 arrow types print their own attributes *) | Ptyp_constr({txt = Longident.Ldot(Longident.Lident "Js", "t")}, _) -> true | _ -> false in - begin match typExpr.ptyp_attributes with - | _::_ as attrs when not shouldPrintItsOwnAttributes -> + begin match typ_expr.ptyp_attributes with + | _::_ as attrs when not should_print_its_own_attributes -> Doc.group ( Doc.concat [ - printAttributes attrs; - renderedType; + print_attributes attrs; + rendered_type; ] ) - | _ -> renderedType + | _ -> rendered_type end - and printBsObjectSugar ~inline fields openFlag = - let flag = match openFlag with + and print_bs_object_sugar ~inline fields open_flag = + let flag = match open_flag with | Asttypes.Closed -> Doc.nil | Open -> Doc.dotdot in @@ -1118,57 +1118,57 @@ module Printer = struct flag; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printObjectField fields + List.map print_object_field fields ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ] in if inline then doc else Doc.group doc - and printTupleType ~inline (types: Parsetree.core_type list) = + and print_tuple_type ~inline (types: Parsetree.core_type list) = let tuple = Doc.concat([ Doc.text "/"; Doc.indent ( Doc.concat([ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printTypExpr types + List.map print_typ_expr types ) ]) ); (* Doc.trailingComma; *) (* Trailing comma not supported in tuples right now‚Ķ¬†*) - Doc.softLine; + Doc.soft_line; Doc.text "/"; ]) in if inline == false then Doc.group(tuple) else tuple - and printObjectField (field : Parsetree.object_field) = + and print_object_field (field : Parsetree.object_field) = match field with - | Otag (labelLoc, attrs, typ) -> + | Otag (label_loc, attrs, typ) -> Doc.concat [ - Doc.text ("\"" ^ labelLoc.txt ^ "\""); + Doc.text ("\"" ^ label_loc.txt ^ "\""); Doc.text ": "; - printTypExpr typ; + print_typ_expr typ; ] | _ -> Doc.nil (* es6 arrow type arg * type t = (~foo: string, ~bar: float=?, unit) => unit * i.e. ~foo: string, ~bar: float *) - and printTypeParameter (attrs, lbl, typ) = - let (isUncurried, attrs) = ParsetreeViewer.processUncurriedAttribute attrs in - let uncurried = if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + and print_type_parameter (attrs, lbl, typ) = + let (is_uncurried, attrs) = ParsetreeViewer.process_uncurried_attribute attrs in + let uncurried = if is_uncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.line; ] in let label = match lbl with @@ -1176,7 +1176,7 @@ module Printer = struct | Labelled lbl -> Doc.text ("~" ^ lbl ^ ": ") | Optional lbl -> Doc.text ("~" ^ lbl ^ ": ") in - let optionalIndicator = match lbl with + let optional_indicator = match lbl with | Asttypes.Nolabel | Labelled _ -> Doc.nil | Optional lbl -> Doc.text "=?" @@ -1186,8 +1186,8 @@ module Printer = struct uncurried; attrs; label; - printTypExpr typ; - optionalIndicator; + print_typ_expr typ; + optional_indicator; ] ) @@ -1200,15 +1200,15 @@ module Printer = struct * pvb_loc: Location.t; * } *) - and printValueBinding ~recFlag i vb = - let isGhost = ParsetreeViewer.isGhostUnitBinding i vb in - let header = if isGhost then Doc.nil else - if i == 0 then Doc.concat [Doc.text "let "; recFlag] + and print_value_binding ~rec_flag i vb = + let is_ghost = ParsetreeViewer.is_ghost_unit_binding i vb in + let header = if is_ghost then Doc.nil else + if i == 0 then Doc.concat [Doc.text "let "; rec_flag] else Doc.text "and " in - let printedExpr = - let exprDoc = printExpression vb.pvb_expr in - let needsParens = match vb.pvb_expr.pexp_desc with + let printed_expr = + let expr_doc = print_expression vb.pvb_expr in + let needs_parens = match vb.pvb_expr.pexp_desc with | Pexp_constraint( {pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _} @@ -1216,60 +1216,60 @@ module Printer = struct | Pexp_constraint _ -> true | _ -> false in - if needsParens then addParens exprDoc else exprDoc + if needs_parens then add_parens expr_doc else expr_doc in - if isGhost then - printedExpr + if is_ghost then + printed_expr else - let shouldIndent = - ParsetreeViewer.isBinaryExpression vb.pvb_expr || + let should_indent = + ParsetreeViewer.is_binary_expression vb.pvb_expr || (match vb.pvb_expr with | { pexp_attributes = [({Location.txt="res.ternary"}, _)]; - pexp_desc = Pexp_ifthenelse (ifExpr, _, _) + pexp_desc = Pexp_ifthenelse (if_expr, _, _) } -> - ParsetreeViewer.isBinaryExpression ifExpr || ParsetreeViewer.hasAttributes ifExpr.pexp_attributes + ParsetreeViewer.is_binary_expression if_expr || ParsetreeViewer.has_attributes if_expr.pexp_attributes | { pexp_desc = Pexp_newtype _} -> false | e -> - ParsetreeViewer.hasAttributes e.pexp_attributes || - ParsetreeViewer.isArrayAccess e + ParsetreeViewer.has_attributes e.pexp_attributes || + ParsetreeViewer.is_array_access e ) in Doc.concat [ - printAttributes ~loc:vb.pvb_loc vb.pvb_attributes; + print_attributes ~loc:vb.pvb_loc vb.pvb_attributes; header; - printPattern vb.pvb_pat; + print_pattern vb.pvb_pat; Doc.text " ="; - if shouldIndent then + if should_indent then Doc.indent ( Doc.concat [ Doc.line; - printedExpr; + printed_expr; ] ) else Doc.concat [ Doc.space; - printedExpr; + printed_expr; ] ] - and printPackageType ~printModuleKeywordAndParens (packageType: Parsetree.package_type) = - let doc = match packageType with - | (longidentLoc, []) -> Doc.group( + and print_package_type ~print_module_keyword_and_parens (package_type: Parsetree.package_type) = + let doc = match package_type with + | (longident_loc, []) -> Doc.group( Doc.concat [ - printLongident longidentLoc.txt; + print_longident longident_loc.txt; ] ) - | (longidentLoc, packageConstraints) -> Doc.group( + | (longident_loc, package_constraints) -> Doc.group( Doc.concat [ - printLongident longidentLoc.txt; - printPackageConstraints packageConstraints; - Doc.softLine; + print_longident longident_loc.txt; + print_package_constraints package_constraints; + Doc.soft_line; ] ) in - if printModuleKeywordAndParens then + if print_module_keyword_and_parens then Doc.concat[ Doc.text "module("; doc; @@ -1281,65 +1281,65 @@ module Printer = struct - and printPackageConstraints packageConstraints = + and print_package_constraints package_constraints = Doc.concat [ Doc.text " with"; Doc.indent ( Doc.concat [ Doc.line; Doc.join ~sep:Doc.line ( - List.mapi printPackageconstraint packageConstraints + List.mapi print_packageconstraint package_constraints ) ] ) ] - and printPackageconstraint i (longidentLoc, typ) = + and print_packageconstraint i (longident_loc, typ) = let prefix = if i == 0 then Doc.text "type " else Doc.text "and type " in Doc.concat [ prefix; - printLongident longidentLoc.Location.txt; + print_longident longident_loc.Location.txt; Doc.text " = "; - printTypExpr typ + print_typ_expr typ ] - and printExtension (stringLoc, payload) = - let extName = Doc.text ("%" ^ stringLoc.Location.txt) in + and print_extension (string_loc, payload) = + let ext_name = Doc.text ("%" ^ string_loc.Location.txt) in match payload with | PStr [{pstr_desc = Pstr_eval (expr, attrs)}] -> - let exprDoc = printExpression expr in - let needsParens = match attrs with | [] -> false | _ -> true in + let expr_doc = print_expression expr in + let needs_parens = match attrs with | [] -> false | _ -> true in Doc.group ( Doc.concat [ - extName; - addParens ( + ext_name; + add_parens ( Doc.concat [ - printAttributes attrs; - if needsParens then addParens exprDoc else exprDoc; + print_attributes attrs; + if needs_parens then add_parens expr_doc else expr_doc; ] ) ] ) - | _ -> extName + | _ -> ext_name - and printPattern (p : Parsetree.pattern) = - let patternWithoutAttributes = match p.ppat_desc with + and print_pattern (p : Parsetree.pattern) = + let pattern_without_attributes = match p.ppat_desc with | Ppat_any -> Doc.text "_" - | Ppat_var stringLoc -> Doc.text (stringLoc.txt) - | Ppat_constant c -> printConstant c + | Ppat_var string_loc -> Doc.text (string_loc.txt) + | Ppat_constant c -> print_constant c | Ppat_tuple patterns -> Doc.group( Doc.concat([ Doc.text "/"; Doc.indent ( Doc.concat([ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map printPattern patterns) + (List.map print_pattern patterns) ]) ); (* Doc.ifBreaks (Doc.text ",") Doc.nil; *) - Doc.softLine; + Doc.soft_line; Doc.text "/"; ]) ) @@ -1349,101 +1349,101 @@ module Printer = struct Doc.text "["; Doc.indent ( Doc.concat([ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map printPattern patterns) + (List.map print_pattern patterns) ]) ); - Doc.ifBreaks (Doc.text ",") Doc.nil; - Doc.softLine; + Doc.if_breaks (Doc.text ",") Doc.nil; + Doc.soft_line; Doc.text "]"; ]) ) | Ppat_construct({txt = Longident.Lident "[]"}, _) -> Doc.text "list()" | Ppat_construct({txt = Longident.Lident "::"}, _) -> - let (patterns, tail) = collectPatternsFromListConstruct [] p in - let shouldHug = match (patterns, tail) with + let (patterns, tail) = collect_patterns_from_list_construct [] p in + let should_hug = match (patterns, tail) with | ([pat], - {ppat_desc = Ppat_construct({txt = Longident.Lident "[]"}, _)}) when ParsetreeViewer.isHuggablePattern pat -> true + {ppat_desc = Ppat_construct({txt = Longident.Lident "[]"}, _)}) when ParsetreeViewer.is_huggable_pattern pat -> true | _ -> false in let children = Doc.concat([ - if shouldHug then Doc.nil else Doc.softLine; + if should_hug then Doc.nil else Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map printPattern patterns); + (List.map print_pattern patterns); begin match tail.Parsetree.ppat_desc with | Ppat_construct({txt = Longident.Lident "[]"}, _) -> Doc.nil - | _ -> Doc.concat([Doc.text ","; Doc.line; Doc.text "..."; printPattern tail]) + | _ -> Doc.concat([Doc.text ","; Doc.line; Doc.text "..."; print_pattern tail]) end; ]) in Doc.group( Doc.concat([ Doc.text "list("; - if shouldHug then children else Doc.concat [ + if should_hug then children else Doc.concat [ Doc.indent children; - Doc.ifBreaks (Doc.text ",") Doc.nil; - Doc.softLine; + Doc.if_breaks (Doc.text ",") Doc.nil; + Doc.soft_line; ]; Doc.text ")"; ]) ) - | Ppat_construct(constrName, constructorArgs) -> - let constrName = printLongident constrName.txt in - begin match constructorArgs with - | None -> constrName + | Ppat_construct(constr_name, constructor_args) -> + let constr_name = print_longident constr_name.txt in + begin match constructor_args with + | None -> constr_name | Some(args) -> let args = match args.ppat_desc with | Ppat_construct({txt = Longident.Lident "()"}, None) -> [Doc.nil] - | Ppat_tuple(patterns) -> List.map printPattern patterns - | _ -> [printPattern args] + | Ppat_tuple(patterns) -> List.map print_pattern patterns + | _ -> [print_pattern args] in Doc.group( Doc.concat([ - constrName; + constr_name; Doc.text "("; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) args ] ); - Doc.ifBreaks (Doc.text ",") Doc.nil; - Doc.softLine; + Doc.if_breaks (Doc.text ",") Doc.nil; + Doc.soft_line; Doc.text ")"; ]) ) end - | Ppat_record(rows, openFlag) -> + | Ppat_record(rows, open_flag) -> Doc.group( Doc.concat([ Doc.text "{"; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map printPatternRecordRow rows); - begin match openFlag with + (List.map print_pattern_record_row rows); + begin match open_flag with | Open -> Doc.concat [Doc.text ","; Doc.line; Doc.text "_"] | Closed -> Doc.nil end; ] ); - Doc.ifBreaks (Doc.text ",") Doc.nil; - Doc.softLine; + Doc.if_breaks (Doc.text ",") Doc.nil; + Doc.soft_line; Doc.text "}"; ]) ) | Ppat_exception p -> - let needsParens = match p.ppat_desc with + let needs_parens = match p.ppat_desc with | Ppat_or (_, _) | Ppat_alias (_, _) -> true | _ -> false in let pat = - let p = printPattern p in - if needsParens then + let p = print_pattern p in + if needs_parens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p @@ -1453,13 +1453,13 @@ module Printer = struct ) | Ppat_or (p1, p2) -> let p1 = - let p = printPattern p1 in + let p = print_pattern p1 in match p1.ppat_desc with | Ppat_or (_, _) -> Doc.concat [Doc.text "("; p; Doc.text ")"] | _ -> p in let p2 = - let p = printPattern p2 in + let p = print_pattern p2 in match p2.ppat_desc with | Ppat_or (_, _) -> Doc.concat [Doc.text "("; p; Doc.text ")"] | _ -> p @@ -1468,77 +1468,77 @@ module Printer = struct Doc.concat([p1; Doc.line; Doc.text "| "; p2]) ) | Ppat_extension ext -> - printExtension ext + print_extension ext | Ppat_lazy p -> - let needsParens = match p.ppat_desc with + let needs_parens = match p.ppat_desc with | Ppat_or (_, _) | Ppat_alias (_, _) -> true | _ -> false in let pat = - let p = printPattern p in - if needsParens then + let p = print_pattern p in + if needs_parens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat [Doc.text "lazy "; pat] - | Ppat_alias (p, aliasLoc) -> - let needsParens = match p.ppat_desc with + | Ppat_alias (p, alias_loc) -> + let needs_parens = match p.ppat_desc with | Ppat_or (_, _) | Ppat_alias (_, _) -> true | _ -> false in - let renderedPattern = - let p = printPattern p in - if needsParens then + let rendered_pattern = + let p = print_pattern p in + if needs_parens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat([ - renderedPattern; + rendered_pattern; Doc.text " as "; - Doc.text aliasLoc.txt + Doc.text alias_loc.txt ]) (* Note: module(P : S) is represented as *) (* Ppat_constraint(Ppat_unpack, Ptyp_package) *) - | Ppat_constraint ({ppat_desc = Ppat_unpack stringLoc}, {ptyp_desc = Ptyp_package packageType}) -> + | Ppat_constraint ({ppat_desc = Ppat_unpack string_loc}, {ptyp_desc = Ptyp_package package_type}) -> Doc.concat [ Doc.text "module("; - Doc.text stringLoc.txt; + Doc.text string_loc.txt; Doc.text ": "; - printPackageType ~printModuleKeywordAndParens:false packageType; + print_package_type ~print_module_keyword_and_parens:false package_type; Doc.rparen; ] | Ppat_constraint (pattern, typ) -> Doc.concat [ - printPattern pattern; + print_pattern pattern; Doc.text ": "; - printTypExpr typ; + print_typ_expr typ; ] (* Note: module(P : S) is represented as *) (* Ppat_constraint(Ppat_unpack, Ptyp_package) *) - | Ppat_unpack stringLoc -> + | Ppat_unpack string_loc -> Doc.concat [ Doc.text "module("; - Doc.text stringLoc.txt; + Doc.text string_loc.txt; Doc.rparen; ] | _ -> failwith "unsupported pattern" in begin match p.ppat_attributes with - | [] -> patternWithoutAttributes + | [] -> pattern_without_attributes | attrs -> Doc.group ( Doc.concat [ - printAttributes attrs; - patternWithoutAttributes; + print_attributes attrs; + pattern_without_attributes; ] ) end - and printPatternRecordRow row = + and print_pattern_record_row row = match row with (* punned {x}*) | ({Location.txt=Longident.Lident ident}, @@ -1547,32 +1547,32 @@ module Printer = struct | (longident, pattern) -> Doc.group ( Doc.concat([ - printLongident longident.txt; + print_longident longident.txt; Doc.text ": "; Doc.indent( Doc.concat [ - Doc.softLine; - printPattern pattern; + Doc.soft_line; + print_pattern pattern; ] ) ]) ) - and printExpression (e : Parsetree.expression) = - let printedExpression = match e.pexp_desc with - | Parsetree.Pexp_constant c -> printConstant c - | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> - printJsxFragment e + and print_expression (e : Parsetree.expression) = + let printed_expression = match e.pexp_desc with + | Parsetree.Pexp_constant c -> print_constant c + | Pexp_construct _ when ParsetreeViewer.has_jsx_attribute e.pexp_attributes -> + print_jsx_fragment e | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.text "list()" | Pexp_construct ({txt = Longident.Lident "::"}, _) -> - let (expressions, spread) = ParsetreeViewer.collectListExpressions e in - let spreadDoc = match spread with + let (expressions, spread) = ParsetreeViewer.collect_list_expressions e in + let spread_doc = match spread with | Some(expr) -> Doc.concat [ Doc.text ","; Doc.line; Doc.dotdotdot; - printExpression expr + print_expression expr ] | None -> Doc.nil in @@ -1581,19 +1581,19 @@ module Printer = struct Doc.text "list("; Doc.indent ( Doc.concat([ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map printExpression expressions); - spreadDoc; + (List.map print_expression expressions); + spread_doc; ]) ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ]) ) - | Pexp_construct (longidentLoc, args) -> - let constr = printLongident longidentLoc.txt in + | Pexp_construct (longident_loc, args) -> + let constr = print_longident longident_loc.txt in let args = match args with | None -> Doc.nil | Some({pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}) -> @@ -1603,51 +1603,51 @@ module Printer = struct Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printExpression args + List.map print_expression args ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] | Some(arg) -> - let argDoc = printExpression arg in - let shouldHug = ParsetreeViewer.isHuggableExpression arg in + let arg_doc = print_expression arg in + let should_hug = ParsetreeViewer.is_huggable_expression arg in Doc.concat [ Doc.lparen; - if shouldHug then argDoc + if should_hug then arg_doc else Doc.concat [ Doc.indent ( Doc.concat [ - Doc.softLine; - argDoc; + Doc.soft_line; + arg_doc; ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; ]; Doc.rparen; ] in Doc.group(Doc.concat [constr; args]) - | Pexp_ident(longidentLoc) -> - printLongident longidentLoc.txt + | Pexp_ident(longident_loc) -> + print_longident longident_loc.txt | Pexp_tuple exprs -> Doc.group( Doc.concat([ Doc.text "/"; Doc.indent ( Doc.concat([ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map printExpression exprs) + (List.map print_expression exprs) ]) ); - Doc.ifBreaks (Doc.text ",") Doc.nil; - Doc.softLine; + Doc.if_breaks (Doc.text ",") Doc.nil; + Doc.soft_line; Doc.text "/"; ]) ) @@ -1658,22 +1658,22 @@ module Printer = struct Doc.lbracket; Doc.indent ( Doc.concat([ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map printExpression exprs) + (List.map print_expression exprs) ]) ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbracket; ]) ) - | Pexp_record (rows, spreadExpr) -> - let spread = match spreadExpr with + | Pexp_record (rows, spread_expr) -> + let spread = match spread_expr with | None -> Doc.nil | Some expr -> Doc.concat [ Doc.dotdotdot; - printExpression expr; + print_expression expr; Doc.comma; Doc.line; ] @@ -1684,22 +1684,22 @@ module Printer = struct * a: 1, * b: 2, * }` -> record is written on multiple lines, break the group *) - let forceBreak = + let force_break = e.pexp_loc.loc_start.pos_lnum < e.pexp_loc.loc_end.pos_lnum in - Doc.breakableGroup ~forceBreak ( + Doc.breakable_group ~force_break ( Doc.concat([ Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; spread; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map printRecordRow rows) + (List.map print_record_row rows) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ]) ) @@ -1718,172 +1718,172 @@ module Printer = struct * "a": 1, * "b": 2, * }` -> object is written on multiple lines, break the group *) - let forceBreak = + let force_break = loc.loc_start.pos_lnum < loc.loc_end.pos_lnum in - Doc.breakableGroup ~forceBreak ( + Doc.breakable_group ~force_break ( Doc.concat([ Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map printBsObjectRow rows) + (List.map print_bs_object_row rows) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ]) ) | extension -> - printExtension extension + print_extension extension end | Pexp_apply _ -> - if ParsetreeViewer.isUnaryExpression e then - printUnaryExpression e - else if ParsetreeViewer.isBinaryExpression e then - printBinaryExpression e + if ParsetreeViewer.is_unary_expression e then + print_unary_expression e + else if ParsetreeViewer.is_binary_expression e then + print_binary_expression e else - printPexpApply e + print_pexp_apply e | Pexp_unreachable -> Doc.dot - | Pexp_field (expr, longidentLoc) -> + | Pexp_field (expr, longident_loc) -> let lhs = - let doc = printExpression expr in - if Parens.fieldExpr expr then addParens doc else doc + let doc = print_expression expr in + if Parens.field_expr expr then add_parens doc else doc in Doc.concat [ lhs; Doc.dot; - printLongident longidentLoc.txt; + print_longident longident_loc.txt; ] - | Pexp_setfield (expr1, longidentLoc, expr2) -> - printSetFieldExpr e.pexp_attributes expr1 longidentLoc expr2 - | Pexp_ifthenelse (ifExpr, thenExpr, elseExpr) -> - if ParsetreeViewer.isTernaryExpr e then - let (parts, alternate) = ParsetreeViewer.collectTernaryParts e in - let ternaryDoc = match parts with + | Pexp_setfield (expr1, longident_loc, expr2) -> + print_set_field_expr e.pexp_attributes expr1 longident_loc expr2 + | Pexp_ifthenelse (if_expr, then_expr, else_expr) -> + if ParsetreeViewer.is_ternary_expr e then + let (parts, alternate) = ParsetreeViewer.collect_ternary_parts e in + let ternary_doc = match parts with | (condition1, consequent1)::rest -> Doc.group (Doc.concat [ - printTernaryOperand condition1; + print_ternary_operand condition1; Doc.indent ( Doc.concat [ Doc.line; - Doc.indent (Doc.concat [Doc.text "? "; printTernaryOperand consequent1]); + Doc.indent (Doc.concat [Doc.text "? "; print_ternary_operand consequent1]); Doc.concat ( List.map (fun (condition, consequent) -> Doc.concat [ Doc.line; Doc.text ": "; - printTernaryOperand condition; + print_ternary_operand condition; Doc.line; Doc.text "? "; - printTernaryOperand consequent; + print_ternary_operand consequent; ] ) rest ); Doc.line; Doc.text ": "; - Doc.indent (printTernaryOperand alternate); + Doc.indent (print_ternary_operand alternate); ] ) ]) | _ -> Doc.nil in - let attrs = ParsetreeViewer.filterTernaryAttributes e.pexp_attributes in - let needsParens = match attrs with | [] -> false | _ -> true in + let attrs = ParsetreeViewer.filter_ternary_attributes e.pexp_attributes in + let needs_parens = match attrs with | [] -> false | _ -> true in Doc.concat [ - printAttributes attrs; - if needsParens then addParens ternaryDoc else ternaryDoc; + print_attributes attrs; + if needs_parens then add_parens ternary_doc else ternary_doc; ] else - let (ifs, elseExpr) = ParsetreeViewer.collectIfExpressions e in - let ifDocs = Doc.join ~sep:Doc.space ( - List.mapi (fun i (ifExpr, thenExpr) -> - let ifTxt = if i > 0 then Doc.text "else if " else Doc.text "if " in - let condition = printExpression ifExpr in + let (ifs, else_expr) = ParsetreeViewer.collect_if_expressions e in + let if_docs = Doc.join ~sep:Doc.space ( + List.mapi (fun i (if_expr, then_expr) -> + let if_txt = if i > 0 then Doc.text "else if " else Doc.text "if " in + let condition = print_expression if_expr in Doc.concat [ - ifTxt; + if_txt; Doc.group ( - Doc.ifBreaks (addParens condition) condition; + Doc.if_breaks (add_parens condition) condition; ); Doc.space; - printExpressionBlock ~braces:true thenExpr; + print_expression_block ~braces:true then_expr; ] ) ifs ) in - let elseDoc = match elseExpr with + let else_doc = match else_expr with | None -> Doc.nil | Some expr -> Doc.concat [ Doc.text " else "; - printExpressionBlock ~braces:true expr; + print_expression_block ~braces:true expr; ] in Doc.concat [ - printAttributes e.pexp_attributes; - ifDocs; - elseDoc; + print_attributes e.pexp_attributes; + if_docs; + else_doc; ] | Pexp_while (expr1, expr2) -> - let condition = printExpression expr1 in - Doc.breakableGroup ~forceBreak:true ( + let condition = print_expression expr1 in + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.text "while "; Doc.group ( - Doc.ifBreaks (addParens condition) condition + Doc.if_breaks (add_parens condition) condition ); Doc.space; - printExpressionBlock ~braces:true expr2; + print_expression_block ~braces:true expr2; ] ) - | Pexp_for (pattern, fromExpr, toExpr, directionFlag, body) -> - Doc.breakableGroup ~forceBreak:true ( + | Pexp_for (pattern, from_expr, to_expr, direction_flag, body) -> + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.text "for "; - printPattern pattern; + print_pattern pattern; Doc.text " in "; - printExpression fromExpr; - printDirectionFlag directionFlag; - printExpression toExpr; + print_expression from_expr; + print_direction_flag direction_flag; + print_expression to_expr; Doc.space; - printExpressionBlock ~braces:true body; + print_expression_block ~braces:true body; ] ) | Pexp_constraint( - {pexp_desc = Pexp_pack modExpr}, - {ptyp_desc = Ptyp_package packageType} + {pexp_desc = Pexp_pack mod_expr}, + {ptyp_desc = Ptyp_package package_type} ) -> Doc.group ( Doc.concat [ Doc.text "module("; Doc.indent ( Doc.concat [ - Doc.softLine; - printModExpr modExpr; + Doc.soft_line; + print_mod_expr mod_expr; Doc.text ": "; - printPackageType ~printModuleKeywordAndParens:false packageType; + print_package_type ~print_module_keyword_and_parens:false package_type; ] ); - Doc.softLine; + Doc.soft_line; Doc.rparen; ] ) | Pexp_constraint (expr, typ) -> Doc.concat [ - printExpression expr; + print_expression expr; Doc.text ": "; - printTypExpr typ; + print_typ_expr typ; ] - | Pexp_letmodule ({txt = modName}, modExpr, expr) -> - printExpressionBlock ~braces:true e + | Pexp_letmodule ({txt = mod_name}, mod_expr, expr) -> + print_expression_block ~braces:true e - | Pexp_letexception (extensionConstructor, expr) -> - printExpressionBlock ~braces:true e + | Pexp_letexception (extension_constructor, expr) -> + print_expression_block ~braces:true e | Pexp_assert expr -> let rhs = - let doc = printExpression expr in - if Parens.lazyOrAssertExprRhs expr then addParens doc else doc + let doc = print_expression expr in + if Parens.lazy_or_assert_expr_rhs expr then add_parens doc else doc in Doc.concat [ Doc.text "assert "; @@ -1891,234 +1891,234 @@ module Printer = struct ] | Pexp_lazy expr -> let rhs = - let doc = printExpression expr in - if Parens.lazyOrAssertExprRhs expr then addParens doc else doc + let doc = print_expression expr in + if Parens.lazy_or_assert_expr_rhs expr then add_parens doc else doc in Doc.concat [ Doc.text "lazy "; rhs; ] - | Pexp_open (overrideFlag, longidentLoc, expr) -> - printExpressionBlock ~braces:true e - | Pexp_pack (modExpr) -> + | Pexp_open (override_flag, longident_loc, expr) -> + print_expression_block ~braces:true e + | Pexp_pack (mod_expr) -> Doc.group (Doc.concat [ Doc.text "module("; Doc.indent ( Doc.concat [ - Doc.softLine; - printModExpr modExpr; + Doc.soft_line; + print_mod_expr mod_expr; ] ); - Doc.softLine; + Doc.soft_line; Doc.rparen; ]) | Pexp_sequence _ -> - printExpressionBlock ~braces:true e + print_expression_block ~braces:true e | Pexp_let _ -> - printExpressionBlock ~braces:true e + print_expression_block ~braces:true e | Pexp_fun _ | Pexp_newtype _ -> - let (attrsOnArrow, parameters, returnExpr) = ParsetreeViewer.funExpr e in + let (attrs_on_arrow, parameters, return_expr) = ParsetreeViewer.fun_expr e in let (uncurried, attrs) = - ParsetreeViewer.processUncurriedAttribute attrsOnArrow + ParsetreeViewer.process_uncurried_attribute attrs_on_arrow in - let (returnExpr, typConstraint) = match returnExpr.pexp_desc with + let (return_expr, typ_constraint) = match return_expr.pexp_desc with | Pexp_constraint (expr, typ) -> (expr, Some typ) - | _ -> (returnExpr, None) + | _ -> (return_expr, None) in - let parametersDoc = printExprFunParameters ~inCallback:false ~uncurried parameters in - let returnExprDoc = - let shouldInline = match returnExpr.pexp_desc with + let parameters_doc = print_expr_fun_parameters ~in_callback:false ~uncurried parameters in + let return_expr_doc = + let should_inline = match return_expr.pexp_desc with | Pexp_array _ | Pexp_tuple _ | Pexp_construct (_, Some _) | Pexp_record _ -> true | _ -> false in - let shouldIndent = match returnExpr.pexp_desc with + let should_indent = match return_expr.pexp_desc with | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ -> false | _ -> true in - let returnDoc = printExpression returnExpr in - if shouldInline then Doc.concat [ + let return_doc = print_expression return_expr in + if should_inline then Doc.concat [ Doc.space; - returnDoc; + return_doc; ] else Doc.group ( - if shouldIndent then + if should_indent then Doc.indent ( Doc.concat [ Doc.line; - returnDoc; + return_doc; ] ) else Doc.concat [ Doc.space; - returnDoc + return_doc ] ) in - let typConstraintDoc = match typConstraint with - | Some(typ) -> Doc.concat [Doc.text ": "; printTypExpr typ] + let typ_constraint_doc = match typ_constraint with + | Some(typ) -> Doc.concat [Doc.text ": "; print_typ_expr typ] | _ -> Doc.nil in let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.space; ] in Doc.group ( Doc.concat [ attrs; - parametersDoc; - typConstraintDoc; + parameters_doc; + typ_constraint_doc; Doc.text " =>"; - returnExprDoc; + return_expr_doc; ] ) | Pexp_try (expr, cases) -> Doc.concat [ Doc.text "try "; - printExpression expr; + print_expression expr; Doc.text " catch "; - printCases cases; + print_cases cases; ] | Pexp_match (expr, cases) -> Doc.concat [ Doc.text "switch "; - printExpression expr; + print_expression expr; Doc.space; - printCases cases; + print_cases cases; ] | _ -> failwith "expression not yet implemented in printer" in - let shouldPrintItsOwnAttributes = match e.pexp_desc with + let should_print_its_own_attributes = match e.pexp_desc with | Pexp_apply _ | Pexp_fun _ | Pexp_newtype _ | Pexp_setfield _ | Pexp_ifthenelse _ -> true - | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> true + | Pexp_construct _ when ParsetreeViewer.has_jsx_attribute e.pexp_attributes -> true | _ -> false in begin match e.pexp_attributes with - | [] -> printedExpression - | attrs when not shouldPrintItsOwnAttributes -> + | [] -> printed_expression + | attrs when not should_print_its_own_attributes -> Doc.group ( Doc.concat [ - printAttributes attrs; - printedExpression; + print_attributes attrs; + printed_expression; ] ) - | _ -> printedExpression + | _ -> printed_expression end - and printPexpFun ~inCallback e = - let (attrsOnArrow, parameters, returnExpr) = ParsetreeViewer.funExpr e in + and print_pexp_fun ~in_callback e = + let (attrs_on_arrow, parameters, return_expr) = ParsetreeViewer.fun_expr e in let (uncurried, attrs) = - ParsetreeViewer.processUncurriedAttribute attrsOnArrow + ParsetreeViewer.process_uncurried_attribute attrs_on_arrow in - let (returnExpr, typConstraint) = match returnExpr.pexp_desc with + let (return_expr, typ_constraint) = match return_expr.pexp_desc with | Pexp_constraint (expr, typ) -> (expr, Some typ) - | _ -> (returnExpr, None) + | _ -> (return_expr, None) in - let parametersDoc = printExprFunParameters ~inCallback ~uncurried parameters in - let returnShouldIndent = match returnExpr.pexp_desc with + let parameters_doc = print_expr_fun_parameters ~in_callback ~uncurried parameters in + let return_should_indent = match return_expr.pexp_desc with | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ -> false | _ -> true in - let returnExprDoc = - let shouldInline = match returnExpr.pexp_desc with + let return_expr_doc = + let should_inline = match return_expr.pexp_desc with | Pexp_array _ | Pexp_tuple _ | Pexp_construct (_, Some _) | Pexp_record _ -> true | _ -> false in - let returnDoc = printExpression returnExpr in - if shouldInline then Doc.concat [ + let return_doc = print_expression return_expr in + if should_inline then Doc.concat [ Doc.space; - returnDoc; + return_doc; ] else Doc.group ( - if returnShouldIndent then + if return_should_indent then Doc.concat [ Doc.indent ( Doc.concat [ Doc.line; - returnDoc; + return_doc; ] ); - if inCallback then Doc.softLine else Doc.nil; + if in_callback then Doc.soft_line else Doc.nil; ] else Doc.concat [ Doc.space; - returnDoc; + return_doc; ] ) in - let typConstraintDoc = match typConstraint with - | Some(typ) -> Doc.concat [Doc.text ": "; printTypExpr typ] + let typ_constraint_doc = match typ_constraint with + | Some(typ) -> Doc.concat [Doc.text ": "; print_typ_expr typ] | _ -> Doc.nil in let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.space; ] in Doc.group ( Doc.concat [ attrs; - parametersDoc; - typConstraintDoc; + parameters_doc; + typ_constraint_doc; Doc.text " =>"; - returnExprDoc; + return_expr_doc; ] ) - and printTernaryOperand expr = - let doc = printExpression expr in - if Parens.ternaryOperand expr then addParens doc else doc + and print_ternary_operand expr = + let doc = print_expression expr in + if Parens.ternary_operand expr then add_parens doc else doc - and printSetFieldExpr attrs lhs longidentLoc rhs = - let rhsDoc = - let doc = printExpression rhs in - if Parens.setFieldExprRhs rhs then addParens doc else doc + and print_set_field_expr attrs lhs longident_loc rhs = + let rhs_doc = + let doc = print_expression rhs in + if Parens.set_field_expr_rhs rhs then add_parens doc else doc in - let lhsDoc = - let doc = printExpression lhs in - if Parens.fieldExpr lhs then addParens doc else doc + let lhs_doc = + let doc = print_expression lhs in + if Parens.field_expr lhs then add_parens doc else doc in - let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in + let should_indent = ParsetreeViewer.is_binary_expression rhs in let doc = Doc.concat [ - lhsDoc; + lhs_doc; Doc.dot; - printLongident longidentLoc.txt; + print_longident longident_loc.txt; Doc.text " ="; - if shouldIndent then Doc.group ( + if should_indent then Doc.group ( Doc.indent ( - (Doc.concat [Doc.line; rhsDoc]) + (Doc.concat [Doc.line; rhs_doc]) ) ) else - Doc.concat [Doc.space; rhsDoc] + Doc.concat [Doc.space; rhs_doc] ] in match attrs with | [] -> doc | attrs -> Doc.group ( Doc.concat [ - printAttributes attrs; + print_attributes attrs; doc ] ) - and printUnaryExpression expr = - let printUnaryOperator op = Doc.text ( + and print_unary_expression expr = + let print_unary_operator op = Doc.text ( match op with | "~+" -> "+" | "~+." -> "+." @@ -2133,19 +2133,19 @@ module Printer = struct {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [Nolabel, operand] ) -> - let printedOperand = - let doc = printExpression operand in - if Parens.unaryExprOperand operand then addParens doc else doc + let printed_operand = + let doc = print_expression operand in + if Parens.unary_expr_operand operand then add_parens doc else doc in Doc.concat [ - printUnaryOperator operator; - printedOperand; + print_unary_operator operator; + printed_operand; ] | _ -> assert false - and printBinaryExpression (expr : Parsetree.expression) = - let printBinaryOperator ~inlineRhs operator = - let operatorTxt = match operator with + and print_binary_expression (expr : Parsetree.expression) = + let print_binary_operator ~inline_rhs operator = + let operator_txt = match operator with | "|." -> "->" | "^" -> "++" | "=" -> "==" @@ -2154,64 +2154,64 @@ module Printer = struct | "!=" -> "!==" | txt -> txt in - let spacingBeforeOperator = - if operator = "|." then Doc.softLine + let spacing_before_operator = + if operator = "|." then Doc.soft_line else if operator = "|>" then Doc.line else Doc.space; in - let spacingAfterOperator = + let spacing_after_operator = if operator = "|." then Doc.nil else if operator = "|>" then Doc.space - else if inlineRhs then Doc.space else Doc.line + else if inline_rhs then Doc.space else Doc.line in Doc.concat [ - spacingBeforeOperator; - Doc.text operatorTxt; - spacingAfterOperator; + spacing_before_operator; + Doc.text operator_txt; + spacing_after_operator; ] in - let printOperand ~isLhs expr parentOperator = - let rec flatten ~isLhs expr parentOperator = - if ParsetreeViewer.isBinaryExpression expr then + let print_operand ~is_lhs expr parent_operator = + let rec flatten ~is_lhs expr parent_operator = + if ParsetreeViewer.is_binary_expression expr then begin match expr with | {pexp_desc = Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [_, left; _, right] )} -> - if ParsetreeViewer.flattenableOperators parentOperator operator && - not (ParsetreeViewer.hasAttributes expr.pexp_attributes) then - let leftPrinted = flatten ~isLhs:true left operator in - let rightPrinted = - let (_, rightAttrs) = - ParsetreeViewer.partitionPrinteableAttributes right.pexp_attributes + if ParsetreeViewer.flattenable_operators parent_operator operator && + not (ParsetreeViewer.has_attributes expr.pexp_attributes) then + let left_printed = flatten ~is_lhs:true left operator in + let right_printed = + let (_, right_attrs) = + ParsetreeViewer.partition_printeable_attributes right.pexp_attributes in let doc = - printExpression {right with pexp_attributes = rightAttrs } in - let doc = if Parens.flattenOperandRhs parentOperator right then + print_expression {right with pexp_attributes = right_attrs } in + let doc = if Parens.flatten_operand_rhs parent_operator right then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - let printeableAttrs = - ParsetreeViewer.filterPrinteableAttributes right.pexp_attributes + let printeable_attrs = + ParsetreeViewer.filter_printeable_attributes right.pexp_attributes in - Doc.concat [printAttributes printeableAttrs; doc] + Doc.concat [print_attributes printeable_attrs; doc] in Doc.concat [ - leftPrinted; - printBinaryOperator ~inlineRhs:false operator; - rightPrinted; + left_printed; + print_binary_operator ~inline_rhs:false operator; + right_printed; ] else - let doc = printExpression {expr with pexp_attributes = []} in - let doc = if Parens.subBinaryExprOperand parentOperator operator || + let doc = print_expression {expr with pexp_attributes = []} in + let doc = if Parens.sub_binary_expr_operand parent_operator operator || (expr.pexp_attributes <> [] && - (ParsetreeViewer.isBinaryExpression expr || - ParsetreeViewer.isTernaryExpr expr)) then + (ParsetreeViewer.is_binary_expression expr || + ParsetreeViewer.is_ternary_expr expr)) then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in Doc.concat [ - printAttributes expr.pexp_attributes; + print_attributes expr.pexp_attributes; doc ] | _ -> assert false @@ -2219,24 +2219,24 @@ module Printer = struct else begin match expr.pexp_desc with | Pexp_setfield (lhs, field, rhs) -> - let doc = printSetFieldExpr expr.pexp_attributes lhs field rhs in - if isLhs then addParens doc else doc + let doc = print_set_field_expr expr.pexp_attributes lhs field rhs in + if is_lhs then add_parens doc else doc | Pexp_apply( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> - let rhsDoc = printExpression rhs in - let lhsDoc = printExpression lhs in + let rhs_doc = print_expression rhs in + let lhs_doc = print_expression lhs in (* TODO: unify indentation of "=" *) - let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in + let should_indent = ParsetreeViewer.is_binary_expression rhs in let doc = Doc.group( Doc.concat [ - lhsDoc; + lhs_doc; Doc.text " ="; - if shouldIndent then Doc.group ( - Doc.indent (Doc.concat [Doc.line; rhsDoc]) + if should_indent then Doc.group ( + Doc.indent (Doc.concat [Doc.line; rhs_doc]) ) else - Doc.concat [Doc.space; rhsDoc] + Doc.concat [Doc.space; rhs_doc] ] ) in let doc = match expr.pexp_attributes with @@ -2244,79 +2244,79 @@ module Printer = struct | attrs -> Doc.group ( Doc.concat [ - printAttributes attrs; + print_attributes attrs; doc ] ) in - if isLhs then addParens doc else doc + if is_lhs then add_parens doc else doc | _ -> - let doc = printExpression expr in - if Parens.binaryExprOperand ~isLhs expr parentOperator then - addParens doc + let doc = print_expression expr in + if Parens.binary_expr_operand ~is_lhs expr parent_operator then + add_parens doc else doc end in - flatten ~isLhs expr parentOperator + flatten ~is_lhs expr parent_operator in match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident (("|." | "|>") as op)}}, [Nolabel, lhs; Nolabel, rhs] ) when not ( - ParsetreeViewer.isBinaryExpression lhs || - ParsetreeViewer.isBinaryExpression rhs + ParsetreeViewer.is_binary_expression lhs || + ParsetreeViewer.is_binary_expression rhs ) -> - let lhsDoc = printOperand ~isLhs:true lhs op in - let rhsDoc = printOperand ~isLhs:false rhs op in + let lhs_doc = print_operand ~is_lhs:true lhs op in + let rhs_doc = print_operand ~is_lhs:false rhs op in Doc.concat [ - lhsDoc; + lhs_doc; (match op with | "|." -> Doc.text "->" | "|>" -> Doc.text " |> " | _ -> assert false); - rhsDoc; + rhs_doc; ] | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [Nolabel, lhs; Nolabel, rhs] ) -> let right = - let operatorWithRhs = Doc.concat [ - printBinaryOperator - ~inlineRhs:(ParsetreeViewer.shouldInlineRhsBinaryExpr rhs) operator; - printOperand ~isLhs:false rhs operator; + let operator_with_rhs = Doc.concat [ + print_binary_operator + ~inline_rhs:(ParsetreeViewer.should_inline_rhs_binary_expr rhs) operator; + print_operand ~is_lhs:false rhs operator; ] in - if ParsetreeViewer.shouldIndentBinaryExpr expr then - Doc.group (Doc.indent operatorWithRhs) - else operatorWithRhs + if ParsetreeViewer.should_indent_binary_expr expr then + Doc.group (Doc.indent operator_with_rhs) + else operator_with_rhs in let doc = Doc.group ( Doc.concat [ - printOperand ~isLhs:true lhs operator; + print_operand ~is_lhs:true lhs operator; right ] ) in Doc.concat [ - printAttributes expr.pexp_attributes; - if Parens.binaryExpr expr then addParens doc else doc + print_attributes expr.pexp_attributes; + if Parens.binary_expr expr then add_parens doc else doc ] | _ -> Doc.nil (* callExpr(arg1, arg2)*) - and printPexpApply expr = + and print_pexp_apply expr = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}}, - [Nolabel, parentExpr; Nolabel, memberExpr] + [Nolabel, parent_expr; Nolabel, member_expr] ) -> let member = - let memberDoc = printExpression memberExpr in - Doc.concat [Doc.text "\""; memberDoc; Doc.text "\""] + let member_doc = print_expression member_expr in + Doc.concat [Doc.text "\""; member_doc; Doc.text "\""] in Doc.group (Doc.concat [ - printAttributes expr.pexp_attributes; - printExpression parentExpr; + print_attributes expr.pexp_attributes; + print_expression parent_expr; Doc.lbracket; member; Doc.rbracket; @@ -2325,19 +2325,19 @@ module Printer = struct {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [Nolabel, lhs; Nolabel, rhs] ) -> - let rhsDoc = printExpression rhs in + let rhs_doc = print_expression rhs in (* TODO: unify indentation of "=" *) - let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in + let should_indent = ParsetreeViewer.is_binary_expression rhs in let doc = Doc.group( Doc.concat [ - printExpression lhs; + print_expression lhs; Doc.text " ="; - if shouldIndent then Doc.group ( + if should_indent then Doc.group ( Doc.indent ( - (Doc.concat [Doc.line; rhsDoc]) + (Doc.concat [Doc.line; rhs_doc]) ) ) else - Doc.concat [Doc.space; rhsDoc] + Doc.concat [Doc.space; rhs_doc] ] ) in begin match expr.pexp_attributes with @@ -2345,36 +2345,36 @@ module Printer = struct | attrs -> Doc.group ( Doc.concat [ - printAttributes attrs; + print_attributes attrs; doc ] ) end | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}}, - [Nolabel, parentExpr; Nolabel, memberExpr] + [Nolabel, parent_expr; Nolabel, member_expr] ) -> let member = - let memberDoc = printExpression memberExpr in - let shouldInline = match memberExpr.pexp_desc with + let member_doc = print_expression member_expr in + let should_inline = match member_expr.pexp_desc with | Pexp_constant _ | Pexp_ident _ -> true | _ -> false in - if shouldInline then memberDoc else ( + if should_inline then member_doc else ( Doc.concat [ Doc.indent ( Doc.concat [ - Doc.softLine; - memberDoc; + Doc.soft_line; + member_doc; ] ); - Doc.softLine + Doc.soft_line ] ) in Doc.group (Doc.concat [ - printAttributes expr.pexp_attributes; - printExpression parentExpr; + print_attributes expr.pexp_attributes; + print_expression parent_expr; Doc.lbracket; member; Doc.rbracket; @@ -2383,66 +2383,66 @@ module Printer = struct | Pexp_apply ( {pexp_desc = Pexp_ident {txt = lident}}, args - ) when ParsetreeViewer.isJsxExpression expr -> - printJsxExpression lident args - | Pexp_apply (callExpr, args) -> + ) when ParsetreeViewer.is_jsx_expression expr -> + print_jsx_expression lident args + | Pexp_apply (call_expr, args) -> let (uncurried, attrs) = - ParsetreeViewer.processUncurriedAttribute expr.pexp_attributes + ParsetreeViewer.process_uncurried_attribute expr.pexp_attributes in - let callExprDoc = printExpression callExpr in - if ParsetreeViewer.requiresSpecialCallbackPrinting args then - let argsDoc = printArgumentsWithCallback ~uncurried args in + let call_expr_doc = print_expression call_expr in + if ParsetreeViewer.requires_special_callback_printing args then + let args_doc = print_arguments_with_callback ~uncurried args in Doc.concat [ - printAttributes attrs; - callExprDoc; - argsDoc; + print_attributes attrs; + call_expr_doc; + args_doc; ] else - let argsDoc = printArguments ~uncurried args in + let args_doc = print_arguments ~uncurried args in Doc.concat [ - printAttributes attrs; - callExprDoc; - argsDoc; + print_attributes attrs; + call_expr_doc; + args_doc; ] | _ -> assert false - and printJsxExpression lident args = - let name = printJsxName lident in - let (formattedProps, children) = formatJsxProps args in + and print_jsx_expression lident args = + let name = print_jsx_name lident in + let (formatted_props, children) = format_jsx_props args in (*
*) - let isSelfClosing = match children with | [] -> true | _ -> false in + let is_self_closing = match children with | [] -> true | _ -> false in Doc.group ( Doc.concat [ Doc.group ( Doc.concat [ - Doc.lessThan; + Doc.less_than; name; - formattedProps; - if isSelfClosing then Doc.concat [Doc.line; Doc.text "/>"] else Doc.nil + formatted_props; + if is_self_closing then Doc.concat [Doc.line; Doc.text "/>"] else Doc.nil ] ); - if isSelfClosing then Doc.nil + if is_self_closing then Doc.nil else Doc.concat [ - Doc.greaterThan; + Doc.greater_than; Doc.indent ( Doc.concat [ Doc.line; - printJsxChildren children; + print_jsx_children children; ] ); Doc.line; Doc.text "" in let closing = Doc.text "" in - let (children, _) = ParsetreeViewer.collectListExpressions expr in + let (children, _) = ParsetreeViewer.collect_list_expressions expr in Doc.group ( Doc.concat [ opening; @@ -2452,7 +2452,7 @@ module Printer = struct Doc.indent ( Doc.concat [ Doc.line; - printJsxChildren children; + print_jsx_children children; ] ) end; @@ -2461,17 +2461,17 @@ module Printer = struct ] ) - and printJsxChildren (children: Parsetree.expression list) = + and print_jsx_children (children: Parsetree.expression list) = Doc.group ( Doc.join ~sep:Doc.line ( List.map (fun expr -> - let exprDoc = printExpression expr in - if Parens.jsxChildExpr expr then addBraces exprDoc else exprDoc + let expr_doc = print_expression expr in + if Parens.jsx_child_expr expr then add_braces expr_doc else expr_doc ) children ) ) - and formatJsxProps args = + and format_jsx_props args = let rec loop props args = match args with | [] -> (Doc.nil, []) @@ -2482,7 +2482,7 @@ module Printer = struct {Parsetree.pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None)} ) ] -> - let formattedProps = Doc.indent ( + let formatted_props = Doc.indent ( match props with | [] -> Doc.nil | props -> @@ -2493,23 +2493,23 @@ module Printer = struct ) ] ) in - let (children, _) = ParsetreeViewer.collectListExpressions children in - (formattedProps, children) + let (children, _) = ParsetreeViewer.collect_list_expressions children in + (formatted_props, children) | arg::args -> - let propDoc = formatJsxProp arg in - loop (propDoc::props) args + let prop_doc = format_jsx_prop arg in + loop (prop_doc::props) args in loop [] args - and formatJsxProp arg = + and format_jsx_prop arg = match arg with | ( - (Asttypes.Labelled lblTxt | Optional lblTxt) as lbl, + (Asttypes.Labelled lbl_txt | Optional lbl_txt) as lbl, { Parsetree.pexp_attributes = []; pexp_desc = Pexp_ident {txt = Longident.Lident ident} } - ) when lblTxt = ident (* jsx punning *) -> + ) when lbl_txt = ident (* jsx punning *) -> begin match lbl with | Nolabel -> Doc.nil @@ -2517,21 +2517,21 @@ module Printer = struct | Optional lbl -> Doc.text ("?" ^ lbl) end | (lbl, expr) -> - let lblDoc = match lbl with + let lbl_doc = match lbl with | Asttypes.Labelled lbl -> Doc.text (lbl ^ "=") | Asttypes.Optional lbl -> Doc.text (lbl ^ "=?") | Nolabel -> Doc.nil in - let exprDoc = printExpression expr in + let expr_doc = print_expression expr in Doc.concat [ - lblDoc; - if Parens.jsxPropExpr expr then addBraces exprDoc else exprDoc; + lbl_doc; + if Parens.jsx_prop_expr expr then add_braces expr_doc else expr_doc; ] (* div -> div. * Navabar.createElement -> Navbar * Staff.Users.createElement -> Staff.Users *) - and printJsxName lident = + and print_jsx_name lident = let rec flatten acc lident = match lident with | Longident.Lident txt -> txt::acc | Ldot (lident, txt) -> @@ -2545,23 +2545,23 @@ module Printer = struct let segments = flatten [] lident in Doc.join ~sep:Doc.dot (List.map Doc.text segments) - and printArgumentsWithCallback ~uncurried args = + and print_arguments_with_callback ~uncurried args = let rec loop acc args = match args with | [] -> (Doc.nil, Doc.nil) | [_lbl, expr] -> - let callback = printPexpFun ~inCallback:true expr in + let callback = print_pexp_fun ~in_callback:true expr in (Doc.concat (List.rev acc), callback) | arg::args -> - let argDoc = printArgument arg in - loop (Doc.line::Doc.comma::argDoc::acc) args + let arg_doc = print_argument arg in + loop (Doc.line::Doc.comma::arg_doc::acc) args in - let (printedArgs, callback) = loop [] args in + let (printed_args, callback) = loop [] args in (* Thing.map(foo,(arg1, arg2) => MyModuleBlah.toList(argument)) *) - let fitsOnOneLine = Doc.concat [ + let fits_on_one_line = Doc.concat [ if uncurried then Doc.text "(." else Doc.lparen; Doc.concat [ - printedArgs; + printed_args; callback; ]; Doc.rparen; @@ -2571,15 +2571,15 @@ module Printer = struct * MyModuleBlah.toList(argument) * ) *) - let arugmentsFitOnOneLine = + let arugments_fit_on_one_line = Doc.concat [ if uncurried then Doc.text "(." else Doc.lparen; Doc.concat [ - Doc.softLine; - printedArgs; - Doc.breakableGroup ~forceBreak:true callback; + Doc.soft_line; + printed_args; + Doc.breakable_group ~force_break:true callback; ]; - Doc.softLine; + Doc.soft_line; Doc.rparen; ] in @@ -2591,21 +2591,21 @@ module Printer = struct * (param1, parm2) => doStuff(param1, parm2) * ) *) - let breakAllArgs = printArguments ~uncurried args in - Doc.customLayout [ - fitsOnOneLine; - arugmentsFitOnOneLine; - breakAllArgs; + let break_all_args = print_arguments ~uncurried args in + Doc.custom_layout [ + fits_on_one_line; + arugments_fit_on_one_line; + break_all_args; ] - and printArguments ~uncurried (args : (Asttypes.arg_label * Parsetree.expression) list) = + and print_arguments ~uncurried (args : (Asttypes.arg_label * Parsetree.expression) list) = match args with | [Nolabel, {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}] -> if uncurried then Doc.text "(.)" else Doc.text "()" - | [(Nolabel, arg)] when ParsetreeViewer.isHuggableExpression arg -> + | [(Nolabel, arg)] when ParsetreeViewer.is_huggable_expression arg -> Doc.concat [ if uncurried then Doc.text "(." else Doc.lparen; - printExpression arg; + print_expression arg; Doc.rparen; ] | args -> Doc.group ( @@ -2613,14 +2613,14 @@ module Printer = struct if uncurried then Doc.text "(." else Doc.lparen; Doc.indent ( Doc.concat [ - if uncurried then Doc.line else Doc.softLine; + if uncurried then Doc.line else Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printArgument args + List.map print_argument args ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) @@ -2639,8 +2639,8 @@ module Printer = struct * | ~ label-name = ? expr * | ~ label-name = ? _ (* syntax sugar *) * | ~ label-name = ? expr : type *) - and printArgument ((argLbl, arg) : Asttypes.arg_label * Parsetree.expression) = - match (argLbl, arg) with + and print_argument ((arg_lbl, arg) : Asttypes.arg_label * Parsetree.expression) = + match (arg_lbl, arg) with (* ~a (punned)*) | ( (Asttypes.Labelled lbl), @@ -2654,25 +2654,25 @@ module Printer = struct ) when lbl = name -> Doc.text ("~" ^ lbl ^ "?") | (lbl, expr) -> - let printedLbl = match argLbl with + let printed_lbl = match arg_lbl with | Asttypes.Nolabel -> Doc.nil | Asttypes.Labelled lbl -> Doc.text ("~" ^ lbl ^ "=") | Asttypes.Optional lbl -> Doc.text ("~" ^ lbl ^ "=?") in - let printedExpr = printExpression expr in + let printed_expr = print_expression expr in Doc.concat [ - printedLbl; - printedExpr; + printed_lbl; + printed_expr; ] - and printCases (cases: Parsetree.case list) = - Doc.breakableGroup ~forceBreak:true ( + and print_cases (cases: Parsetree.case list) = + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.lbrace; Doc.concat [ Doc.line; Doc.join ~sep:Doc.line ( - List.map printCase cases + List.map print_case cases ) ]; Doc.line; @@ -2680,15 +2680,15 @@ module Printer = struct ] ) - and printCase (case: Parsetree.case) = + and print_case (case: Parsetree.case) = let rhs = match case.pc_rhs.pexp_desc with | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ | Pexp_sequence _ -> - printExpressionBlock ~braces:false case.pc_rhs - | _ -> printExpression case.pc_rhs + print_expression_block ~braces:false case.pc_rhs + | _ -> print_expression case.pc_rhs in let guard = match case.pc_guard with | None -> Doc.nil @@ -2696,7 +2696,7 @@ module Printer = struct Doc.concat [ Doc.line; Doc.text "when "; - printExpression expr; + print_expression expr; ] ) in @@ -2705,7 +2705,7 @@ module Printer = struct Doc.text "| "; Doc.indent ( Doc.concat [ - printPattern case.pc_lhs; + print_pattern case.pc_lhs; guard; Doc.text " =>"; Doc.line; @@ -2715,60 +2715,60 @@ module Printer = struct ] ) - and printExprFunParameters ~inCallback ~uncurried parameters = + and print_expr_fun_parameters ~in_callback ~uncurried parameters = match parameters with (* let f = _ => () *) | [([], Asttypes.Nolabel, None, {Parsetree.ppat_desc = Ppat_any})] when not uncurried -> Doc.text "_" (* let f = a => () *) - | [([], Asttypes.Nolabel, None, {Parsetree.ppat_desc = Ppat_var stringLoc})] when not uncurried -> - Doc.text stringLoc.txt + | [([], Asttypes.Nolabel, None, {Parsetree.ppat_desc = Ppat_var string_loc})] when not uncurried -> + Doc.text string_loc.txt (* let f = () => () *) | [([], Nolabel, None, {ppat_desc = Ppat_construct({txt = Longident.Lident "()"}, None)})] when not uncurried -> Doc.text "()" (* let f = (~greeting, ~from as hometown, ~x=?) => () *) | parameters -> let lparen = if uncurried then Doc.text "(. " else Doc.lparen in - let shouldHug = ParsetreeViewer.parametersShouldHug parameters in - let printedParamaters = Doc.concat [ - if shouldHug || inCallback then Doc.nil else Doc.softLine; - Doc.join ~sep:(Doc.concat [Doc.comma; if inCallback then Doc.space else Doc.line]) - (List.map printExpFunParameter parameters) + let should_hug = ParsetreeViewer.parameters_should_hug parameters in + let printed_paramaters = Doc.concat [ + if should_hug || in_callback then Doc.nil else Doc.soft_line; + Doc.join ~sep:(Doc.concat [Doc.comma; if in_callback then Doc.space else Doc.line]) + (List.map print_exp_fun_parameter parameters) ] in Doc.group ( Doc.concat [ lparen; - if shouldHug || inCallback then printedParamaters else Doc.indent (printedParamaters); - if shouldHug || inCallback then Doc.nil else Doc.concat [Doc.trailingComma; Doc.softLine]; + if should_hug || in_callback then printed_paramaters else Doc.indent (printed_paramaters); + if should_hug || in_callback then Doc.nil else Doc.concat [Doc.trailing_comma; Doc.soft_line]; Doc.rparen; ] ) - and printExpFunParameter (attrs, lbl, defaultExpr, pattern) = - let (isUncurried, attrs) = ParsetreeViewer.processUncurriedAttribute attrs in - let uncurried = if isUncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in + and print_exp_fun_parameter (attrs, lbl, default_expr, pattern) = + let (is_uncurried, attrs) = ParsetreeViewer.process_uncurried_attribute attrs in + let uncurried = if is_uncurried then Doc.concat [Doc.dot; Doc.space] else Doc.nil in let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.line; ] in (* =defaultValue *) - let defaultExprDoc = match defaultExpr with + let default_expr_doc = match default_expr with | Some expr -> Doc.concat [ Doc.text "="; - printExpression expr + print_expression expr ] | None -> Doc.nil in (* ~from as hometown * ~from -> punning *) - let labelWithPattern = match (lbl, pattern) with - | (Asttypes.Nolabel, pattern) -> printPattern pattern + let label_with_pattern = match (lbl, pattern) with + | (Asttypes.Nolabel, pattern) -> print_pattern pattern | ( (Asttypes.Labelled lbl | Optional lbl), - {ppat_desc = Ppat_var stringLoc} - ) when lbl = stringLoc.txt -> + {ppat_desc = Ppat_var string_loc} + ) when lbl = string_loc.txt -> Doc.concat [ Doc.text "~"; Doc.text lbl; @@ -2778,10 +2778,10 @@ module Printer = struct Doc.text "~"; Doc.text lbl; Doc.text " as "; - printPattern pattern; + print_pattern pattern; ] in - let optionalLabelSuffix = match (lbl, defaultExpr) with + let optional_label_suffix = match (lbl, default_expr) with | (Asttypes.Optional _, None) -> Doc.text "=?" | _ -> Doc.nil in @@ -2789,9 +2789,9 @@ module Printer = struct Doc.concat [ uncurried; attrs; - labelWithPattern; - defaultExprDoc; - optionalLabelSuffix; + label_with_pattern; + default_expr_doc; + optional_label_suffix; ] ) @@ -2807,58 +2807,58 @@ module Printer = struct * } * What is an expr-block ? Everything between { ... } *) - and printExpressionBlock ~braces expr = - let rec collectRows acc expr = match expr.Parsetree.pexp_desc with - | Parsetree.Pexp_letmodule ({txt = modName; loc = modLoc}, modExpr, expr) -> - let letModuleDoc = Doc.concat [ + and print_expression_block ~braces expr = + let rec collect_rows acc expr = match expr.Parsetree.pexp_desc with + | Parsetree.Pexp_letmodule ({txt = mod_name; loc = mod_loc}, mod_expr, expr) -> + let let_module_doc = Doc.concat [ Doc.text "module "; - Doc.text modName; + Doc.text mod_name; Doc.text " = "; - printModExpr modExpr; + print_mod_expr mod_expr; ] in - let loc = {modLoc with loc_end = modExpr.pmod_loc.loc_end} in - collectRows ((loc, letModuleDoc)::acc) expr - | Pexp_letexception (extensionConstructor, expr) -> - let letExceptionDoc = printExceptionDef extensionConstructor in - let loc = extensionConstructor.pext_loc in - collectRows ((loc, letExceptionDoc)::acc) expr - | Pexp_open (overrideFlag, longidentLoc, expr) -> - let openDoc = Doc.concat [ + let loc = {mod_loc with loc_end = mod_expr.pmod_loc.loc_end} in + collect_rows ((loc, let_module_doc)::acc) expr + | Pexp_letexception (extension_constructor, expr) -> + let let_exception_doc = print_exception_def extension_constructor in + let loc = extension_constructor.pext_loc in + collect_rows ((loc, let_exception_doc)::acc) expr + | Pexp_open (override_flag, longident_loc, expr) -> + let open_doc = Doc.concat [ Doc.text "open"; - printOverrideFlag overrideFlag; + print_override_flag override_flag; Doc.space; - printLongident longidentLoc.txt; + print_longident longident_loc.txt; ] in - let loc = longidentLoc.loc in - collectRows ((loc, openDoc)::acc) expr + let loc = longident_loc.loc in + collect_rows ((loc, open_doc)::acc) expr | Pexp_sequence (expr1, expr2) -> - let exprDoc = - let doc = printExpression expr1 in - if Parens.blockExpr expr1 then addParens doc else doc + let expr_doc = + let doc = print_expression expr1 in + if Parens.block_expr expr1 then add_parens doc else doc in let loc = expr1.pexp_loc in - collectRows ((loc, exprDoc)::acc) expr2 - | Pexp_let (recFlag, valueBindings, expr) -> - let recFlag = match recFlag with + collect_rows ((loc, expr_doc)::acc) expr2 + | Pexp_let (rec_flag, value_bindings, expr) -> + let rec_flag = match rec_flag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - let letDoc = printValueBindings ~recFlag valueBindings in - let loc = match (valueBindings, List.rev valueBindings) with - | ({pvb_loc = firstLoc}::_,{pvb_loc = lastLoc}::_) -> - {firstLoc with loc_end = lastLoc.loc_end} + let let_doc = print_value_bindings ~rec_flag value_bindings in + let loc = match (value_bindings, List.rev value_bindings) with + | ({pvb_loc = first_loc}::_,{pvb_loc = last_loc}::_) -> + {first_loc with loc_end = last_loc.loc_end} | _ -> Location.none in - collectRows((loc, letDoc)::acc) expr + collect_rows((loc, let_doc)::acc) expr | _ -> - let exprDoc = - let doc = printExpression expr in - if Parens.blockExpr expr then addParens doc else doc + let expr_doc = + let doc = print_expression expr in + if Parens.block_expr expr then add_parens doc else doc in - List.rev ((expr.pexp_loc, exprDoc)::acc) + List.rev ((expr.pexp_loc, expr_doc)::acc) in - let block = collectRows [] expr |> interleaveWhitespace ~forceBreak:true in - Doc.breakableGroup ~forceBreak:true ( + let block = collect_rows [] expr |> interleave_whitespace ~force_break:true in + Doc.breakable_group ~force_break:true ( if braces then Doc.concat [ Doc.lbrace; @@ -2874,28 +2874,28 @@ module Printer = struct else block ) - and printOverrideFlag overrideFlag = match overrideFlag with + and print_override_flag override_flag = match override_flag with | Asttypes.Override -> Doc.text "!" | Fresh -> Doc.nil - and printDirectionFlag flag = match flag with + and print_direction_flag flag = match flag with | Asttypes.Downto -> Doc.text " downto " | Asttypes.Upto -> Doc.text " to " - and printRecordRow (lbl, expr) = + and print_record_row (lbl, expr) = Doc.concat [ - printLongident lbl.txt; + print_longident lbl.txt; Doc.text ": "; - printExpression expr; + print_expression expr; ] - and printBsObjectRow (lbl, expr) = + and print_bs_object_row (lbl, expr) = Doc.concat [ Doc.text "\""; - printLongident lbl.txt; + print_longident lbl.txt; Doc.text "\""; Doc.text ": "; - printExpression expr; + print_expression expr; ] (* The optional loc indicates whether we need to print the attributes in * relation to some location. In practise this means the following: @@ -2903,184 +2903,184 @@ module Printer = struct * `@attr * type t = string` -> attr is on prev line, print the attributes * with a line break between, we respect the users' original layout *) - and printAttributes ?loc (attrs: Parsetree.attributes) = + and print_attributes ?loc (attrs: Parsetree.attributes) = match attrs with | [] -> Doc.nil | attrs -> - let lineBreak = match loc with + let line_break = match loc with | None -> Doc.line | Some loc -> begin match List.rev attrs with - | ({loc = firstLoc}, _)::_ when loc.loc_start.pos_lnum > firstLoc.loc_end.pos_lnum -> - Doc.literalLine; + | ({loc = first_loc}, _)::_ when loc.loc_start.pos_lnum > first_loc.loc_end.pos_lnum -> + Doc.literal_line; | _ -> Doc.line end in Doc.concat [ - Doc.group (Doc.join ~sep:Doc.line (List.map printAttribute attrs)); - lineBreak; + Doc.group (Doc.join ~sep:Doc.line (List.map print_attribute attrs)); + line_break; ] - and printAttribute ((id, payload) : Parsetree.attribute) = - let attrName = Doc.text ("@" ^ id.txt) in + and print_attribute ((id, payload) : Parsetree.attribute) = + let attr_name = Doc.text ("@" ^ id.txt) in match payload with | PStr [{pstr_desc = Pstr_eval (expr, attrs)}] -> - let exprDoc = printExpression expr in - let needsParens = match attrs with | [] -> false | _ -> true in + let expr_doc = print_expression expr in + let needs_parens = match attrs with | [] -> false | _ -> true in Doc.group ( Doc.concat [ - attrName; - addParens ( + attr_name; + add_parens ( Doc.concat [ - printAttributes attrs; - if needsParens then addParens exprDoc else exprDoc; + print_attributes attrs; + if needs_parens then add_parens expr_doc else expr_doc; ] ) ] ) - | _ -> attrName + | _ -> attr_name - and printModExpr modExpr = - match modExpr.pmod_desc with - | Pmod_ident longidentLoc -> - printLongident longidentLoc.txt + and print_mod_expr mod_expr = + match mod_expr.pmod_desc with + | Pmod_ident longident_loc -> + print_longident longident_loc.txt | Pmod_structure structure -> - Doc.breakableGroup ~forceBreak:true ( + Doc.breakable_group ~force_break:true ( Doc.concat [ Doc.lbrace; Doc.indent ( Doc.concat [ - Doc.softLine; - printStructure structure; + Doc.soft_line; + print_structure structure; ]; ); - Doc.softLine; + Doc.soft_line; Doc.rbrace; ] ) | Pmod_unpack expr -> - let shouldHug = match expr.pexp_desc with + let should_hug = match expr.pexp_desc with | Pexp_let _ -> true | Pexp_constraint ( {pexp_desc = Pexp_let _ }, - {ptyp_desc = Ptyp_package packageType} + {ptyp_desc = Ptyp_package package_type} ) -> true | _ -> false in - let (expr, moduleConstraint) = match expr.pexp_desc with + let (expr, module_constraint) = match expr.pexp_desc with | Pexp_constraint ( expr, - {ptyp_desc = Ptyp_package packageType} + {ptyp_desc = Ptyp_package package_type} ) -> - let typeDoc = Doc.group (Doc.concat [ + let type_doc = Doc.group (Doc.concat [ Doc.text ":"; Doc.indent ( Doc.concat [ Doc.line; - printPackageType ~printModuleKeywordAndParens:false packageType + print_package_type ~print_module_keyword_and_parens:false package_type ] ) ]) in - (expr, typeDoc) + (expr, type_doc) | _ -> (expr, Doc.nil) in - let unpackDoc = Doc.group(Doc.concat [ - printExpression expr; - moduleConstraint; + let unpack_doc = Doc.group(Doc.concat [ + print_expression expr; + module_constraint; ]) in Doc.group ( Doc.concat [ Doc.text "unpack("; - if shouldHug then unpackDoc + if should_hug then unpack_doc else Doc.concat [ Doc.indent ( Doc.concat [ - Doc.softLine; - unpackDoc; + Doc.soft_line; + unpack_doc; ] ); - Doc.softLine; + Doc.soft_line; ]; Doc.rparen; ] ) | Pmod_extension extension -> - printExtension extension + print_extension extension | Pmod_apply _ -> - let (args, callExpr) = ParsetreeViewer.modExprApply modExpr in - let isUnitSugar = match args with + let (args, call_expr) = ParsetreeViewer.mod_expr_apply mod_expr in + let is_unit_sugar = match args with | [{pmod_desc = Pmod_structure []}] -> true | _ -> false in - let shouldHug = match args with + let should_hug = match args with | [{pmod_desc = Pmod_structure _}] -> true | _ -> false in Doc.group ( Doc.concat [ - printModExpr callExpr; - if isUnitSugar then - printModApplyArg (List.hd args) + print_mod_expr call_expr; + if is_unit_sugar then + print_mod_apply_arg (List.hd args) else Doc.concat [ Doc.lparen; - if shouldHug then - printModApplyArg (List.hd args) + if should_hug then + print_mod_apply_arg (List.hd args) else Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printModApplyArg args + List.map print_mod_apply_arg args ) ] ); - if not shouldHug then + if not should_hug then Doc.concat [ - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; ] else Doc.nil; Doc.rparen; ] ] ) - | Pmod_constraint (modExpr, modType) -> + | Pmod_constraint (mod_expr, mod_type) -> Doc.concat [ - printModExpr modExpr; + print_mod_expr mod_expr; Doc.text ": "; - printModType modType; + print_mod_type mod_type; ] | Pmod_functor _ -> - printModFunctor modExpr + print_mod_functor mod_expr - and printModFunctor modExpr = - let (parameters, returnModExpr) = ParsetreeViewer.modExprFunctor modExpr in + and print_mod_functor mod_expr = + let (parameters, return_mod_expr) = ParsetreeViewer.mod_expr_functor mod_expr in (* let shouldInline = match returnModExpr.pmod_desc with *) (* | Pmod_structure _ | Pmod_ident _ -> true *) (* | Pmod_constraint ({pmod_desc = Pmod_structure _}, _) -> true *) (* | _ -> false *) (* in *) - let (returnConstraint, returnModExpr) = match returnModExpr.pmod_desc with - | Pmod_constraint (modExpr, modType) -> - let constraintDoc = - let doc = printModType modType in - if Parens.modExprFunctorConstraint modType then addParens doc else doc + 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 mod_type in + if Parens.mod_expr_functor_constraint mod_type then add_parens doc else doc in - let modConstraint = Doc.concat [ + let mod_constraint = Doc.concat [ Doc.text ": "; - constraintDoc; + constraint_doc; ] in - (modConstraint, printModExpr modExpr) - | _ -> (Doc.nil, printModExpr returnModExpr) + (mod_constraint, print_mod_expr mod_expr) + | _ -> (Doc.nil, print_mod_expr return_mod_expr) in - let parametersDoc = match parameters with + let parameters_doc = match parameters with | [(attrs, {txt = "*"}, None)] -> let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.line; ] in Doc.group (Doc.concat [ @@ -3094,112 +3094,112 @@ module Printer = struct Doc.lparen; Doc.indent ( Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) ( - List.map printModFunctorParam parameters + List.map print_mod_functor_param parameters ) ] ); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] ) in Doc.group ( Doc.concat [ - parametersDoc; - returnConstraint; + parameters_doc; + return_constraint; Doc.text " => "; - returnModExpr + return_mod_expr ] ) - and printModFunctorParam (attrs, lbl, optModType) = + and print_mod_functor_param (attrs, lbl, opt_mod_type) = let attrs = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.join ~sep:Doc.line (List.map printAttribute attrs); + Doc.join ~sep:Doc.line (List.map print_attribute attrs); Doc.line; ] in Doc.group ( Doc.concat [ attrs; Doc.text lbl.txt; - (match optModType with + (match opt_mod_type with | None -> Doc.nil - | Some modType -> + | Some mod_type -> Doc.concat [ Doc.text ": "; - printModType modType + print_mod_type mod_type ]); ] ) - and printModApplyArg modExpr = - match modExpr.pmod_desc with + and print_mod_apply_arg mod_expr = + match mod_expr.pmod_desc with | Pmod_structure [] -> Doc.text "()" - | _ -> printModExpr modExpr + | _ -> print_mod_expr mod_expr - and printExceptionDef (constr : Parsetree.extension_constructor) = + and print_exception_def (constr : Parsetree.extension_constructor) = let kind = match constr.pext_kind with | Pext_rebind {txt = longident} -> Doc.indent ( Doc.concat [ Doc.text " ="; Doc.line; - printLongident longident; + print_longident longident; ] ) | Pext_decl (Pcstr_tuple [], None) -> Doc.nil | Pext_decl (args, gadt) -> - let gadtDoc = match gadt with + let gadt_doc = match gadt with | Some typ -> Doc.concat [ Doc.text ": "; - printTypExpr typ; + print_typ_expr typ; ] | None -> Doc.nil in Doc.concat [ - printConstructorArguments args; - gadtDoc + print_constructor_arguments args; + gadt_doc ] in Doc.group ( Doc.concat [ - printAttributes constr.pext_attributes; + print_attributes constr.pext_attributes; Doc.text "exception "; Doc.text constr.pext_name.txt; kind ] ) - and printExtensionConstructor i (constr : Parsetree.extension_constructor) = - let attrs = printAttributes constr.pext_attributes in + and print_extension_constructor i (constr : Parsetree.extension_constructor) = + let attrs = print_attributes constr.pext_attributes in let bar = if i > 0 then Doc.text "| " - else Doc.ifBreaks (Doc.text "| ") Doc.nil + else Doc.if_breaks (Doc.text "| ") Doc.nil in let kind = match constr.pext_kind with | Pext_rebind {txt = longident} -> Doc.indent ( Doc.concat [ Doc.text " ="; Doc.line; - printLongident longident; + print_longident longident; ] ) | Pext_decl (Pcstr_tuple [], None) -> Doc.nil | Pext_decl (args, gadt) -> - let gadtDoc = match gadt with + let gadt_doc = match gadt with | Some typ -> Doc.concat [ Doc.text ": "; - printTypExpr typ; + print_typ_expr typ; ] | None -> Doc.nil in Doc.concat [ - printConstructorArguments args; - gadtDoc + print_constructor_arguments args; + gadt_doc ] in Doc.concat [ @@ -3213,16 +3213,16 @@ module Printer = struct ) ] - let printImplementation (s: Parsetree.structure) comments src = - let t = CommentAst.initStructure s comments in + let print_implementation (s: Parsetree.structure) comments src = + let t = CommentAst.init_structure s comments in - let stringDoc = Doc.toString ~width:80 (printStructure s) in - print_endline stringDoc; + let string_doc = Doc.to_string ~width:80 (print_structure s) in + print_endline string_doc; print_newline() - let printInterface (s: Parsetree.signature) = - let stringDoc = Doc.toString ~width:80 (printSignature s) in - print_endline stringDoc; + let print_interface (s: Parsetree.signature) = + let string_doc = Doc.to_string ~width:80 (print_signature s) in + print_endline string_doc; print_newline() end diff --git a/jscomp/syntax/benchmarks/data/RedBlackTree.ml b/jscomp/syntax/benchmarks/data/RedBlackTree.ml index b2a0b42e7c..9d3dcd567b 100644 --- a/jscomp/syntax/benchmarks/data/RedBlackTree.ml +++ b/jscomp/syntax/benchmarks/data/RedBlackTree.ml @@ -1,4 +1,4 @@ -type nonrec nodeColor = +type nonrec node_color = | Red | Black type 'value node = @@ -7,7 +7,7 @@ type 'value node = mutable right: 'value node option ; mutable parent: 'value node option ; mutable sum: float ; - mutable color: nodeColor ; + mutable color: node_color ; mutable height: float ; mutable value: 'value } type nonrec 'value t = @@ -15,39 +15,39 @@ type nonrec 'value t = mutable size: int ; mutable root: 'value node option ; compare: (('value -> 'value -> int)[@bs ]) } -let createNode ~color ~value ~height = +let create_node ~color ~value ~height = { left = None; right = None; parent = None; sum = 0.; height; value; color } -external castNotOption : 'a option -> 'a = "%identity" -let updateSum node = - let leftSum = match node.left with | None -> 0. | Some left -> left.sum in - let rightSum = match node.right with | None -> 0. | Some right -> right.sum in - node.sum <- ((leftSum +. rightSum) +. node.height) -let rec updateSumRecursive rbt node = - updateSum node; +external cast_not_option : 'a option -> 'a = "%identity" +let update_sum node = + let left_sum = match node.left with | None -> 0. | Some left -> left.sum in + let right_sum = match node.right with | None -> 0. | Some right -> right.sum in + node.sum <- ((left_sum +. right_sum) +. node.height) +let rec update_sum_recursive rbt node = + update_sum node; (match node.parent with | None -> () - | Some parent -> rbt |. (updateSumRecursive parent)) -let grandParentOf node = + | Some parent -> rbt |. (update_sum_recursive parent)) +let grand_parent_of node = match node.parent with | None -> None | Some ref_ -> ref_.parent -let isLeft node = +let is_left node = match node.parent with | None -> false | Some parent -> (Some node) == parent.left -let leftOrRightSet ~node x value = - ((if isLeft node then x.left <- value else x.right <- value)[@res.ternary ]) -let siblingOf node = - if isLeft node - then (castNotOption node.parent).right - else (castNotOption node.parent).left -let uncleOf node = - match grandParentOf node with +let left_or_right_set ~node x value = + ((if is_left node then x.left <- value else x.right <- value)[@res.ternary ]) +let sibling_of node = + if is_left node + then (cast_not_option node.parent).right + else (cast_not_option node.parent).left +let uncle_of node = + match grand_parent_of node with | None -> None - | Some grandParentOfNode -> - if isLeft (castNotOption node.parent) - then grandParentOfNode.right - else grandParentOfNode.left -let rec findNode rbt node value = + | Some grand_parent_of_node -> + if is_left (cast_not_option node.parent) + then grand_parent_of_node.right + else grand_parent_of_node.left +let rec find_node rbt node value = match node with | None -> None | Some node -> @@ -56,56 +56,56 @@ let rec findNode rbt node value = then Some node else if cmp < 0 - then findNode rbt node.left value - else findNode rbt node.right value -let has rbt value = (findNode rbt rbt.root value) != None -let rec peekMinNode node = + then find_node rbt node.left value + else find_node rbt node.right value +let has rbt value = (find_node rbt rbt.root value) != None +let rec peek_min_node node = match node with | None -> None | Some node -> - ((if node.left == None then Some node else node.left |. peekMinNode) + ((if node.left == None then Some node else node.left |. peek_min_node) [@res.ternary ]) -let rec peekMaxNode node = +let rec peek_max_node node = match node with | None -> None | Some node -> - ((if node.right == None then Some node else node.right |. peekMaxNode) + ((if node.right == None then Some node else node.right |. peek_max_node) [@res.ternary ]) -let rotateLeft rbt node = +let rotate_left rbt node = let parent = node.parent in let right = node.right in (match parent with - | Some parent -> parent |. (leftOrRightSet ~node right) + | Some parent -> parent |. (left_or_right_set ~node right) | None -> rbt.root <- right); node.parent <- right; - (let right = right |. castNotOption in - let rightLeft = right.left in - node.right <- rightLeft; - (match rightLeft with - | Some rightLeft -> rightLeft.parent <- (Some node) + (let right = right |. cast_not_option in + let right_left = right.left in + node.right <- right_left; + (match right_left with + | Some right_left -> right_left.parent <- (Some node) | None -> ()); right.parent <- parent; right.left <- (Some node); - updateSum node; - updateSum right) -let rotateRight rbt node = + update_sum node; + update_sum right) +let rotate_right rbt node = let parent = node.parent in let left = node.left in (match parent with - | Some parent -> parent |. (leftOrRightSet ~node left) + | Some parent -> parent |. (left_or_right_set ~node left) | None -> rbt.root <- left); node.parent <- left; - (let left = left |. castNotOption in - let leftRight = left.right in - node.left <- leftRight; - (match leftRight with - | Some leftRight -> leftRight.parent <- (Some node) + (let left = left |. cast_not_option in + let left_right = left.right in + node.left <- left_right; + (match left_right with + | Some left_right -> left_right.parent <- (Some node) | None -> ()); left.parent <- parent; left.right <- (Some node); - updateSum node; - updateSum left) -let rec findInsert rbt node nodeToInsert value = + update_sum node; + update_sum left) +let rec find_insert rbt node node_to_insert value = match node with | None -> None | Some node -> @@ -116,94 +116,94 @@ let rec findInsert rbt node nodeToInsert value = if cmp < 0 then (if node.left != None - then rbt |. (findInsert node.left nodeToInsert value) + then rbt |. (find_insert node.left node_to_insert value) else - (nodeToInsert.parent <- (Some node); - node.left <- (Some nodeToInsert); + (node_to_insert.parent <- (Some node); + node.left <- (Some node_to_insert); None)) else if node.right != None - then rbt |. (findInsert node.right nodeToInsert value) + then rbt |. (find_insert node.right node_to_insert value) else - (nodeToInsert.parent <- (Some node); - node.right <- (Some nodeToInsert); + (node_to_insert.parent <- (Some node); + node.right <- (Some node_to_insert); None) -let rec _addLoop rbt currentNode = - if (Some currentNode) == rbt.root - then currentNode.color <- Black +let rec _addLoop rbt current_node = + if (Some current_node) == rbt.root + then current_node.color <- Black else - if (currentNode.parent |. castNotOption).color == Black + if (current_node.parent |. cast_not_option).color == Black then () else if - (let uncle = uncleOf currentNode in - (uncle != None) && ((uncle |. castNotOption).color == Red)) + (let uncle = uncle_of current_node in + (uncle != None) && ((uncle |. cast_not_option).color == Red)) then - ((currentNode.parent |. castNotOption).color <- Black; - ((uncleOf currentNode) |. castNotOption).color <- Black; - ((grandParentOf currentNode) |. castNotOption).color <- Red; - _addLoop rbt ((grandParentOf currentNode) |. castNotOption)) + ((current_node.parent |. cast_not_option).color <- Black; + ((uncle_of current_node) |. cast_not_option).color <- Black; + ((grand_parent_of current_node) |. cast_not_option).color <- Red; + _addLoop rbt ((grand_parent_of current_node) |. cast_not_option)) else - (let currentNode = + (let current_node = if - (not (isLeft currentNode)) && - (isLeft (currentNode.parent |. castNotOption)) + (not (is_left current_node)) && + (is_left (current_node.parent |. cast_not_option)) then - (rotateLeft rbt (currentNode.parent |. castNotOption); - currentNode.left |. castNotOption) + (rotate_left rbt (current_node.parent |. cast_not_option); + current_node.left |. cast_not_option) else if - (isLeft currentNode) && - (not (isLeft (currentNode.parent |. castNotOption))) + (is_left current_node) && + (not (is_left (current_node.parent |. cast_not_option))) then - (rotateRight rbt (currentNode.parent |. castNotOption); - currentNode.right |. castNotOption) - else currentNode in - (currentNode.parent |. castNotOption).color <- Black; - ((grandParentOf currentNode) |. castNotOption).color <- Red; - if isLeft currentNode - then rotateRight rbt ((grandParentOf currentNode) |. castNotOption) - else rotateLeft rbt ((grandParentOf currentNode) |. castNotOption)) + (rotate_right rbt (current_node.parent |. cast_not_option); + current_node.right |. cast_not_option) + else current_node in + (current_node.parent |. cast_not_option).color <- Black; + ((grand_parent_of current_node) |. cast_not_option).color <- Red; + if is_left current_node + then rotate_right rbt ((grand_parent_of current_node) |. cast_not_option) + else rotate_left rbt ((grand_parent_of current_node) |. cast_not_option)) let add rbt value ~height = rbt.size <- (rbt.size + 1); - (let nodeToInsert = createNode ~value ~color:Red ~height in + (let node_to_insert = create_node ~value ~color:Red ~height in let inserted = if rbt.root == None - then (rbt.root <- (Some nodeToInsert); true) + then (rbt.root <- (Some node_to_insert); true) else - (let foundNode = findInsert rbt rbt.root nodeToInsert value in - foundNode == None) in + (let found_node = find_insert rbt rbt.root node_to_insert value in + found_node == None) in if inserted then - (rbt |. (updateSumRecursive nodeToInsert); - _addLoop rbt nodeToInsert; - Some nodeToInsert) + (rbt |. (update_sum_recursive node_to_insert); + _addLoop rbt node_to_insert; + Some node_to_insert) else None) -let removeNode rbt node = - let nodeToRemove = +let remove_node rbt node = + let node_to_remove = match ((node.left), (node.right)) with | (Some _, Some _) -> - let successor = (peekMinNode node.right) |. castNotOption in + let successor = (peek_min_node node.right) |. cast_not_option in (node.value <- (successor.value); node.height <- (successor.height); successor) | _ -> node in let successor = - match nodeToRemove.left with | None -> nodeToRemove.right | left -> left in - let (successor, isLeaf) = + match node_to_remove.left with | None -> node_to_remove.right | left -> left in + let (successor, is_leaf) = match successor with | None -> - let leaf = createNode ~value:([%raw "0"]) ~color:Black ~height:0. in - let isLeaf = ((fun x -> x == leaf)[@bs ]) in (leaf, isLeaf) + let leaf = create_node ~value:([%raw "0"]) ~color:Black ~height:0. in + let is_leaf = ((fun x -> x == leaf)[@bs ]) in (leaf, is_leaf) | Some successor -> (successor, (((fun _ -> false))[@bs ])) in - let nodeParent = nodeToRemove.parent in - successor.parent <- nodeParent; - (match nodeParent with + let node_parent = node_to_remove.parent in + successor.parent <- node_parent; + (match node_parent with | None -> () | Some parent -> - parent |. (leftOrRightSet ~node:nodeToRemove (Some successor))); - rbt |. (updateSumRecursive successor); - if nodeToRemove.color == Black + parent |. (left_or_right_set ~node:node_to_remove (Some successor))); + rbt |. (update_sum_recursive successor); + if node_to_remove.color == Black then (if successor.color == Red then @@ -211,108 +211,108 @@ let removeNode rbt node = if successor.parent == None then rbt.root <- (Some successor)) else (let break = ref false in - let successorRef = ref successor in + let successor_ref = ref successor in while not break.contents do - let successor = successorRef.contents in + let successor = successor_ref.contents in match successor.parent with | None -> (rbt.root <- (Some successor); break.contents <- true) - | Some successorParent -> - let sibling = siblingOf successor in + | Some successor_parent -> + let sibling = sibling_of successor in (if (sibling != None) && - ((sibling |. castNotOption).color == Red) + ((sibling |. cast_not_option).color == Red) then - (successorParent.color <- Red; - (sibling |. castNotOption).color <- Black; - if isLeft successor - then rotateLeft rbt successorParent - else rotateRight rbt successorParent); - (let sibling = siblingOf successor in - let siblingNN = sibling |. castNotOption in + (successor_parent.color <- Red; + (sibling |. cast_not_option).color <- Black; + if is_left successor + then rotate_left rbt successor_parent + else rotate_right rbt successor_parent); + (let sibling = sibling_of successor in + let sibling_n_n = sibling |. cast_not_option in if - (successorParent.color == Black) && + (successor_parent.color == Black) && ((sibling == None) || - (((siblingNN.color == Black) && - ((siblingNN.left == None) || - ((siblingNN.left |. castNotOption).color == + (((sibling_n_n.color == Black) && + ((sibling_n_n.left == None) || + ((sibling_n_n.left |. cast_not_option).color == Black))) && - ((siblingNN.right == None) || - ((siblingNN.right |. castNotOption).color == + ((sibling_n_n.right == None) || + ((sibling_n_n.right |. cast_not_option).color == Black)))) then - (if sibling != None then siblingNN.color <- Red; - successorRef.contents <- successorParent) + (if sibling != None then sibling_n_n.color <- Red; + successor_ref.contents <- successor_parent) else if - (successorParent.color == Red) && + (successor_parent.color == Red) && ((sibling == None) || - (((siblingNN.color == Black) && - ((siblingNN.left == None) || - ((siblingNN.left |. castNotOption).color == + (((sibling_n_n.color == Black) && + ((sibling_n_n.left == None) || + ((sibling_n_n.left |. cast_not_option).color == Black))) && - ((siblingNN.right == None) || - ((siblingNN.right |. castNotOption).color == + ((sibling_n_n.right == None) || + ((sibling_n_n.right |. cast_not_option).color == Black)))) then - (if sibling != None then siblingNN.color <- Red; - successorParent.color <- Black; + (if sibling != None then sibling_n_n.color <- Red; + successor_parent.color <- Black; break.contents <- true) else if (sibling != None) && - ((sibling |. castNotOption).color == Black) + ((sibling |. cast_not_option).color == Black) then - (let sibling = sibling |. castNotOption in + (let sibling = sibling |. cast_not_option in if - (((isLeft successor) && + (((is_left successor) && ((sibling.right == None) || - ((sibling.right |. castNotOption).color == + ((sibling.right |. cast_not_option).color == Black))) && (sibling.left != None)) - && ((sibling.left |. castNotOption).color == Red) + && ((sibling.left |. cast_not_option).color == Red) then (sibling.color <- Red; - (sibling.left |. castNotOption).color <- Black; - rotateRight rbt sibling) + (sibling.left |. cast_not_option).color <- Black; + rotate_right rbt sibling) else if - (((not (isLeft successor)) && + (((not (is_left successor)) && ((sibling.left == None) || - ((sibling.left |. castNotOption).color == + ((sibling.left |. cast_not_option).color == Black))) && (sibling.right != None)) && - ((sibling.right |. castNotOption).color == Red) + ((sibling.right |. cast_not_option).color == Red) then (sibling.color <- Red; - (sibling.right |. castNotOption).color <- Black; - rotateLeft rbt sibling); + (sibling.right |. cast_not_option).color <- Black; + rotate_left rbt sibling); break.contents <- true) else - (let sibling = siblingOf successor in - let sibling = sibling |. castNotOption in - sibling.color <- (successorParent.color); - if isLeft successor + (let sibling = sibling_of successor in + let sibling = sibling |. cast_not_option in + sibling.color <- (successor_parent.color); + if is_left successor then - ((sibling.right |. castNotOption).color <- Black; - rotateRight rbt successorParent) + ((sibling.right |. cast_not_option).color <- Black; + rotate_right rbt successor_parent) else - ((sibling.left |. castNotOption).color <- Black; - rotateLeft rbt successorParent)))) + ((sibling.left |. cast_not_option).color <- Black; + rotate_left rbt successor_parent)))) done)); - if ((isLeaf successor)[@bs ]) + if ((is_leaf successor)[@bs ]) then (if rbt.root == (Some successor) then rbt.root <- None; (match successor.parent with | None -> () - | Some parent -> parent |. (leftOrRightSet ~node:successor None))) + | Some parent -> parent |. (left_or_right_set ~node:successor None))) let remove rbt value = - match findNode rbt rbt.root value with - | Some node -> (rbt |. (removeNode node); rbt.size <- (rbt.size - 1); true) + match find_node rbt rbt.root value with + | Some node -> (rbt |. (remove_node node); rbt.size <- (rbt.size - 1); true) | None -> false -let rec findNodeThroughCallback rbt node cb = +let rec find_node_through_callback rbt node cb = match node with | None -> None | Some node -> @@ -321,20 +321,20 @@ let rec findNodeThroughCallback rbt node cb = then Some node else if cmp < 0 - then findNodeThroughCallback rbt node.left cb - else findNodeThroughCallback rbt node.right cb -let removeThroughCallback rbt cb = - match findNodeThroughCallback rbt rbt.root cb with - | Some node -> (rbt |. (removeNode node); rbt.size <- (rbt.size - 1); true) + then find_node_through_callback rbt node.left cb + else find_node_through_callback rbt node.right cb +let remove_through_callback rbt cb = + match find_node_through_callback rbt rbt.root cb with + | Some node -> (rbt |. (remove_node node); rbt.size <- (rbt.size - 1); true) | None -> false let make ~compare = { size = 0; root = None; compare } -let makeWith array ~compare = +let make_with array ~compare = let rbt = make ~compare in array |. - (Js.Array2.forEach + (Js.Array2.for_each (fun (value, height) -> (add rbt value ~height) |. ignore)); rbt -let rec heightOfInterval rbt node lhs rhs = +let rec height_of_interval rbt node lhs rhs = match node with | None -> 0. | Some n -> @@ -343,156 +343,156 @@ let rec heightOfInterval rbt node lhs rhs = else if (lhs != None) && - (((rbt.compare n.value (lhs |. castNotOption))[@bs ]) < 0) - then rbt |. (heightOfInterval n.right lhs rhs) + (((rbt.compare n.value (lhs |. cast_not_option))[@bs ]) < 0) + then rbt |. (height_of_interval n.right lhs rhs) else if (rhs != None) && - (((rbt.compare n.value (rhs |. castNotOption))[@bs ]) > 0) - then rbt |. (heightOfInterval n.left lhs rhs) + (((rbt.compare n.value (rhs |. cast_not_option))[@bs ]) > 0) + then rbt |. (height_of_interval n.left lhs rhs) else - (n.height +. (rbt |. (heightOfInterval n.left lhs None))) +. - (rbt |. (heightOfInterval n.right None rhs)) -let heightOfInterval rbt lhs rhs = heightOfInterval rbt rbt.root lhs rhs -let rec firstVisibleNode node top = + (n.height +. (rbt |. (height_of_interval n.left lhs None))) +. + (rbt |. (height_of_interval n.right None rhs)) +let height_of_interval rbt lhs rhs = height_of_interval rbt rbt.root lhs rhs +let rec first_visible_node node top = match node with | None -> None | Some node -> if node.sum <= top then None else - (let nodeHeight = node.height in - let sumLeft = + (let node_height = node.height in + let sum_left = match node.left with | None -> 0.0 | Some left -> left.sum in - if sumLeft > top - then firstVisibleNode node.left top + if sum_left > top + then first_visible_node node.left top else - if (sumLeft +. nodeHeight) > top + if (sum_left +. node_height) > top then Some node else - (let offset = sumLeft +. nodeHeight in - firstVisibleNode node.right (top -. offset))) -let lastVisibleNode node top = - match firstVisibleNode node top with - | None -> node |. peekMaxNode + (let offset = sum_left +. node_height in + first_visible_node node.right (top -. offset))) +let last_visible_node node top = + match first_visible_node node top with + | None -> node |. peek_max_node | first -> first -let firstVisibleValue rbt ~top = - match firstVisibleNode rbt.root top with +let first_visible_value rbt ~top = + match first_visible_node rbt.root top with | None -> None | Some node -> Some (node.value) let rec leftmost node = match node.left with | None -> node | Some node -> node |. leftmost -let rec firstRightParent node = +let rec first_right_parent node = match node.parent with | None -> None | Some parent -> - ((if isLeft node then Some parent else parent |. firstRightParent) + ((if is_left node then Some parent else parent |. first_right_parent) [@res.ternary ]) -let nextNode node = +let next_node node = match node.right with - | None -> node |. firstRightParent + | None -> node |. first_right_parent | Some right -> Some (right |. leftmost) -let rec sumLeftSpine node ~fromRightChild = - let leftSpine = +let rec sum_left_spine node ~from_right_child = + let left_spine = match node.left with | None -> node.height - | Some left -> ((if fromRightChild then node.height +. left.sum else 0.0) + | Some left -> ((if from_right_child then node.height +. left.sum else 0.0) [@res.ternary ]) in match node.parent with - | None -> leftSpine + | None -> left_spine | Some parent -> - leftSpine +. + left_spine +. (parent |. - (sumLeftSpine ~fromRightChild:(parent.right == (Some node)))) -let getY node = (node |. (sumLeftSpine ~fromRightChild:true)) -. node.height -let rec iterate ~inclusive firstNode lastNode ~callback = - match firstNode with + (sum_left_spine ~from_right_child:(parent.right == (Some node)))) +let get_y node = (node |. (sum_left_spine ~from_right_child:true)) -. node.height +let rec iterate ~inclusive first_node last_node ~callback = + match first_node with | None -> () | Some node -> (if inclusive then ((callback node)[@bs ]); - if firstNode != lastNode + if first_node != last_node then (if not inclusive then ((callback node)[@bs ]); - iterate ~inclusive (node |. nextNode) lastNode ~callback)) -let rec iterateWithY ?y ~inclusive firstNode lastNode ~callback = - match firstNode with + iterate ~inclusive (node |. next_node) last_node ~callback)) +let rec iterate_with_y ?y ~inclusive first_node last_node ~callback = + match first_node with | None -> () | Some node -> - let y = match y with | None -> node |. getY | Some y -> y in + let y = match y with | None -> node |. get_y | Some y -> y in (if inclusive then ((callback node y)[@bs ]); - if firstNode != lastNode + if first_node != last_node then (if not inclusive then ((callback node y)[@bs ]); - iterateWithY ~y:(y +. node.height) ~inclusive (node |. nextNode) - lastNode ~callback)) -let rec updateSum node ~delta = + iterate_with_y ~y:(y +. node.height) ~inclusive (node |. next_node) + last_node ~callback)) +let rec update_sum node ~delta = match node with | None -> () | Some node -> - (node.sum <- (node.sum +. delta); node.parent |. (updateSum ~delta)) -let updateHeight node ~height = + (node.sum <- (node.sum +. delta); node.parent |. (update_sum ~delta)) +let update_height node ~height = let delta = height -. node.height in - node.height <- height; (Some node) |. (updateSum ~delta) -type nonrec 'value oldNewVisible = + node.height <- height; (Some node) |. (update_sum ~delta) +type nonrec 'value old_new_visible = { mutable old: 'value array ; mutable new_: 'value array } -let getAnchorDelta rbt ~anchor = +let get_anchor_delta rbt ~anchor = match anchor with | None -> 0.0 | Some (value, y) -> - (match rbt |. (findNode rbt.root value) with - | Some node -> y -. (node |. getY) + (match rbt |. (find_node rbt.root value) with + | Some node -> y -. (node |. get_y) | None -> 0.0) -let onChangedVisible ?(anchor= None) rbt ~oldNewVisible ~top:top_ +let on_changed_visible ?(anchor= None) rbt ~old_new_visible ~top:top_ ~bottom:bottom_ ~appear ~remained ~disappear = - let old = oldNewVisible.new_ in - let new_ = oldNewVisible.old in + let old = old_new_visible.new_ in + let new_ = old_new_visible.old in (new_ |. - (Js.Array2.removeCountInPlace ~pos:0 ~count:(new_ |. Js.Array2.length))) + (Js.Array2.remove_count_in_place ~pos:0 ~count:(new_ |. Js.Array2.length))) |. ignore; - oldNewVisible.old <- old; - oldNewVisible.new_ <- new_; - (let anchorDelta = rbt |. (getAnchorDelta ~anchor) in - let top = top_ -. anchorDelta in + old_new_visible.old <- old; + old_new_visible.new_ <- new_; + (let anchor_delta = rbt |. (get_anchor_delta ~anchor) in + let top = top_ -. anchor_delta in let top = ((if top < 0.0 then 0.0 else top)[@res.ternary ]) in - let bottom = bottom_ -. anchorDelta in - let first = firstVisibleNode rbt.root top in - let last = lastVisibleNode rbt.root bottom in - let oldLen = old |. Js.Array2.length in - let oldIter = ref 0 in - iterateWithY ~inclusive:true first last + let bottom = bottom_ -. anchor_delta in + let first = first_visible_node rbt.root top in + let last = last_visible_node rbt.root bottom in + let old_len = old |. Js.Array2.length in + let old_iter = ref 0 in + iterate_with_y ~inclusive:true first last ((fun node -> fun y_ -> - let y = y_ +. anchorDelta in + let y = y_ +. anchor_delta in if y >= 0.0 then (while - (oldIter.contents < oldLen) && - (((rbt.compare (Js.Array2.unsafe_get old oldIter.contents) + (old_iter.contents < old_len) && + (((rbt.compare (Js.Array2.unsafe_get old old_iter.contents) node.value) [@bs ]) < 0) do - (((disappear (Js.Array2.unsafe_get old oldIter.contents)) + (((disappear (Js.Array2.unsafe_get old old_iter.contents)) [@bs ]); - oldIter.contents <- (oldIter.contents + 1)) + old_iter.contents <- (old_iter.contents + 1)) done; (new_ |. (Js.Array2.push node.value)) |. ignore; - if oldIter.contents < oldLen + if old_iter.contents < old_len then (let cmp = - ((rbt.compare (Js.Array2.unsafe_get old oldIter.contents) + ((rbt.compare (Js.Array2.unsafe_get old old_iter.contents) node.value) [@bs ]) in if cmp = 0 then (((remained node y) [@bs ]); - oldIter.contents <- (oldIter.contents + 1)) + old_iter.contents <- (old_iter.contents + 1)) else ((appear node y)[@bs ])) else ((appear node y)[@bs ])))[@bs ]); - while oldIter.contents < oldLen do - (((disappear (Js.Array2.unsafe_get old oldIter.contents)) + while old_iter.contents < old_len do + (((disappear (Js.Array2.unsafe_get old old_iter.contents)) [@bs ]); - oldIter.contents <- (oldIter.contents + 1)) + old_iter.contents <- (old_iter.contents + 1)) done) diff --git a/jscomp/syntax/cli/res_cli.ml b/jscomp/syntax/cli/res_cli.ml index 23d9006f35..d5fca5d132 100644 --- a/jscomp/syntax/cli/res_cli.ml +++ b/jscomp/syntax/cli/res_cli.ml @@ -162,9 +162,9 @@ module ResClflags : sig val origin : string ref val file : string ref val interface : bool ref - val jsxVersion : int ref - val jsxModule : string ref - val jsxMode : string ref + val jsx_version : int ref + val jsx_module : string ref + val jsx_mode : string ref val typechecker : bool ref val parse : unit -> unit @@ -175,9 +175,9 @@ end = struct let print = ref "res" let origin = ref "" let interface = ref false - let jsxVersion = ref (-1) - let jsxModule = ref "react" - let jsxMode = ref "automatic" + let jsx_version = ref (-1) + let jsx_module = ref "react" + let jsx_mode = ref "automatic" let file = ref "" let typechecker = ref false @@ -207,14 +207,14 @@ end = struct Arg.Unit (fun () -> interface := true), "Parse as interface" ); ( "-jsx-version", - Arg.Int (fun i -> jsxVersion := i), + 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 -> jsxModule := txt), + Arg.String (fun txt -> jsx_module := txt), "Specify the jsx module. Default: react" ); ( "-jsx-mode", - Arg.String (fun txt -> jsxMode := txt), + Arg.String (fun txt -> jsx_mode := txt), "Specify the jsx mode, classic or automatic. Default: automatic" ); ( "-typechecker", Arg.Unit (fun () -> typechecker := true), @@ -226,37 +226,37 @@ end = struct end module CliArgProcessor = struct - type backend = Parser : 'diagnostics Res_driver.parsingEngine -> backend + type backend = Parser : 'diagnostics Res_driver.parsing_engine -> backend [@@unboxed] - let processFile ~isInterface ~width ~recover ~origin ~target ~jsxVersion - ~jsxModule ~jsxMode ~typechecker filename = + let process_file ~is_interface ~width ~recover ~origin ~target ~jsx_version + ~jsx_module ~jsx_mode ~typechecker filename = let len = String.length filename in - let processInterface = - isInterface + let process_interface = + is_interface || (len > 0 && (String.get [@doesNotRaise]) filename (len - 1) = 'i') in - let parsingEngine = + let parsing_engine = match origin with - | "ml" -> Parser Res_driver_ml_parser.parsingEngine - | "res" -> Parser Res_driver.parsingEngine + | "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.parsingEngine - | _ -> Parser Res_driver.parsingEngine) + | ".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 printEngine = + let print_engine = match target with - | "binary" -> Res_driver_binary.printEngine - | "ml" -> Res_driver_ml_parser.printEngine - | "ast" -> Res_ast_debugger.printEngine - | "sexp" -> Res_ast_debugger.sexpPrintEngine - | "comments" -> Res_ast_debugger.commentsPrintEngine - | "res" -> Res_driver.printEngine + | "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. \ @@ -264,57 +264,57 @@ module CliArgProcessor = struct exit 1 in - let forPrinter = + let for_printer = match target with | ("res" | "sexp") when not typechecker -> true | _ -> false in - let (Parser backend) = parsingEngine in + let (Parser backend) = parsing_engine in (* This is the whole purpose of the Color module above *) Color.setup None; - if processInterface then - let parseResult = backend.parseInterface ~forPrinter ~filename in - if parseResult.invalid then ( - backend.stringOfDiagnostics ~source:parseResult.source - ~filename:parseResult.filename parseResult.diagnostics; + 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 - printEngine.printInterface ~width ~filename - ~comments:parseResult.comments parseResult.parsetree + print_engine.print_interface ~width ~filename + ~comments:parse_result.comments parse_result.parsetree else exit 1) else let parsetree = - Jsx_ppx.rewrite_signature ~jsxVersion ~jsxModule ~jsxMode - parseResult.parsetree + Jsx_ppx.rewrite_signature ~jsx_version ~jsx_module ~jsx_mode + parse_result.parsetree in - printEngine.printInterface ~width ~filename - ~comments:parseResult.comments parsetree + print_engine.print_interface ~width ~filename + ~comments:parse_result.comments parsetree else - let parseResult = backend.parseImplementation ~forPrinter ~filename in - if parseResult.invalid then ( - backend.stringOfDiagnostics ~source:parseResult.source - ~filename:parseResult.filename parseResult.diagnostics; + 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 - printEngine.printImplementation ~width ~filename - ~comments:parseResult.comments parseResult.parsetree + print_engine.print_implementation ~width ~filename + ~comments:parse_result.comments parse_result.parsetree else exit 1) else let parsetree = - Jsx_ppx.rewrite_implementation ~jsxVersion ~jsxModule ~jsxMode - parseResult.parsetree + Jsx_ppx.rewrite_implementation ~jsx_version ~jsx_module ~jsx_mode + parse_result.parsetree in - printEngine.printImplementation ~width ~filename - ~comments:parseResult.comments parsetree + print_engine.print_implementation ~width ~filename + ~comments:parse_result.comments parsetree [@@raises exit] end let () = if not !Sys.interactive then ( ResClflags.parse (); - CliArgProcessor.processFile ~isInterface:!ResClflags.interface + CliArgProcessor.process_file ~is_interface:!ResClflags.interface ~width:!ResClflags.width ~recover:!ResClflags.recover ~target:!ResClflags.print ~origin:!ResClflags.origin - ~jsxVersion:!ResClflags.jsxVersion ~jsxModule:!ResClflags.jsxModule - ~jsxMode:!ResClflags.jsxMode ~typechecker:!ResClflags.typechecker + ~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/jscomp/syntax/src/jsx_common.ml b/jscomp/syntax/src/jsx_common.ml index 5379e10e52..fa55a802ef 100644 --- a/jscomp/syntax/src/jsx_common.ml +++ b/jscomp/syntax/src/jsx_common.ml @@ -1,73 +1,73 @@ open Asttypes open Parsetree -type jsxConfig = { +type jsx_config = { mutable version: int; mutable module_: string; mutable mode: string; - mutable nestedModules: string list; - mutable hasComponent: bool; + mutable nested_modules: string list; + mutable has_component: bool; } (* Helper method to look up the [@react.component] attribute *) -let hasAttr (loc, _) = +let has_attr (loc, _) = match loc.txt with | "react.component" | "jsx.component" -> true | _ -> false (* Iterate over the attributes and try to find the [@react.component] attribute *) -let hasAttrOnBinding {pvb_attributes} = - List.find_opt hasAttr pvb_attributes <> None +let has_attr_on_binding {pvb_attributes} = + List.find_opt has_attr pvb_attributes <> None -let coreTypeOfAttrs attributes = +let core_type_of_attrs attributes = List.find_map (fun ({txt}, payload) -> match (txt, payload) with - | ("react.component" | "jsx.component"), PTyp coreType -> Some coreType + | ("react.component" | "jsx.component"), PTyp core_type -> Some core_type | _ -> None) attributes -let typVarsOfCoreType {ptyp_desc} = +let typ_vars_of_core_type {ptyp_desc} = match ptyp_desc with - | Ptyp_constr (_, coreTypes) -> + | Ptyp_constr (_, core_types) -> List.filter (fun {ptyp_desc} -> match ptyp_desc with | Ptyp_var _ -> true | _ -> false) - coreTypes + core_types | _ -> [] -let raiseError ~loc msg = Location.raise_errorf ~loc msg +let raise_error ~loc msg = Location.raise_errorf ~loc msg -let raiseErrorMultipleComponent ~loc = - raiseError ~loc +let raise_error_multiple_component ~loc = + raise_error ~loc "Only one component definition is allowed for each module. Move to a \ submodule or other file if necessary." -let optionalAttr = ({txt = "res.optional"; loc = Location.none}, PStr []) +let optional_attr = ({txt = "res.optional"; loc = Location.none}, PStr []) -let extractUncurried typ = - if Ast_uncurried.coreTypeIsUncurriedFun typ then - let _arity, t = Ast_uncurried.coreTypeExtractUncurriedFun typ in +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 t else typ -let removeArity binding = - let rec removeArityRecord expr = +let remove_arity binding = + let rec remove_arity_record expr = match expr.pexp_desc with - | _ when Ast_uncurried.exprIsUncurriedFun expr -> - Ast_uncurried.exprExtractUncurriedFun expr + | _ when Ast_uncurried.expr_is_uncurried_fun expr -> + Ast_uncurried.expr_extract_uncurried_fun expr | Pexp_newtype (label, e) -> - {expr with pexp_desc = Pexp_newtype (label, removeArityRecord e)} - | Pexp_apply (forwardRef, [(label, e)]) -> + {expr with pexp_desc = Pexp_newtype (label, remove_arity_record e)} + | Pexp_apply (forward_ref, [(label, e)]) -> { expr with - pexp_desc = Pexp_apply (forwardRef, [(label, removeArityRecord e)]); + pexp_desc = Pexp_apply (forward_ref, [(label, remove_arity_record e)]); } | _ -> expr in - {binding with pvb_expr = removeArityRecord binding.pvb_expr} + {binding with pvb_expr = remove_arity_record binding.pvb_expr} let async_component ~async expr = if async then diff --git a/jscomp/syntax/src/jsx_ppx.ml b/jscomp/syntax/src/jsx_ppx.ml index e0e1cac10e..7f3f18f67d 100644 --- a/jscomp/syntax/src/jsx_ppx.ml +++ b/jscomp/syntax/src/jsx_ppx.ml @@ -3,20 +3,20 @@ open Asttypes open Parsetree open Longident -let getPayloadFields payload = +let get_payload_fields payload = match payload with | PStr ({ pstr_desc = - Pstr_eval ({pexp_desc = Pexp_record (recordFields, None)}, _); + Pstr_eval ({pexp_desc = Pexp_record (record_fields, None)}, _); } :: _rest) -> - recordFields + record_fields | _ -> [] -type configKey = Int | String +type config_key = Int | String -let getJsxConfigByKey ~key ~type_ recordFields = +let get_jsx_config_by_key ~key ~type_ record_fields = let values = List.filter_map (fun ((lid, expr) : Longident.t Location.loc * expression) -> @@ -33,50 +33,50 @@ let getJsxConfigByKey ~key ~type_ recordFields = when k = key -> Some value | _ -> None) - recordFields + record_fields in match values with | [] -> None | [v] | v :: _ -> Some v -let getInt ~key fields = - match fields |> getJsxConfigByKey ~key ~type_:Int with +let get_int ~key fields = + match fields |> get_jsx_config_by_key ~key ~type_:Int with | None -> None | Some s -> int_of_string_opt s -let getString ~key fields = fields |> getJsxConfigByKey ~key ~type_:String +let get_string ~key fields = fields |> get_jsx_config_by_key ~key ~type_:String -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 +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 | Some "react" | None -> false | Some _ -> true in - (match (isGeneric, getInt ~key:"version" fields) with + (match (is_generic, get_int ~key:"version" fields) with | true, _ -> config.Jsx_common.version <- 4 | false, Some i -> config.Jsx_common.version <- i | _ -> ()); - (match moduleRaw with + (match module_raw with | None -> () | Some s -> config.module_ <- s); - match (isGeneric, getString ~key:"mode" fields) with + match (is_generic, get_string ~key:"mode" fields) with | true, _ -> config.mode <- "automatic" | false, Some s -> config.mode <- s | _ -> () -let isJsxConfigAttr ((loc, _) : attribute) = loc.txt = "jsxConfig" +let is_jsx_config_attr ((loc, _) : attribute) = loc.txt = "jsxConfig" -let processConfigAttribute attribute config = - if isJsxConfigAttr attribute then updateConfig config (snd attribute) +let process_config_attribute attribute config = + if is_jsx_config_attr attribute then update_config config (snd attribute) -let getMapper ~config = - let expr3, module_binding3, transformSignatureItem3, transformStructureItem3 = - Reactjs_jsx_v3.jsxMapper ~config +let get_mapper ~config = + let expr3, module_binding3, transform_signature_item3, transform_structure_item3 = + Reactjs_jsx_v3.jsx_mapper ~config in - let expr4, module_binding4, transformSignatureItem4, transformStructureItem4 = - Jsx_v4.jsxMapper ~config + let expr4, module_binding4, transform_signature_item4, transform_structure_item4 = + Jsx_v4.jsx_mapper ~config in let expr mapper e = @@ -91,86 +91,86 @@ let getMapper ~config = | 4 -> module_binding4 mapper mb | _ -> default_mapper.module_binding mapper mb in - let saveConfig () = + let save_config () = { config with version = config.version; module_ = config.module_; mode = config.mode; - hasComponent = config.hasComponent; + has_component = config.has_component; } in - let restoreConfig oldConfig = - config.version <- oldConfig.Jsx_common.version; - config.module_ <- oldConfig.module_; - config.mode <- oldConfig.mode; - config.hasComponent <- oldConfig.hasComponent + 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 in let signature mapper items = - let oldConfig = saveConfig () in - config.hasComponent <- false; + let old_config = save_config () in + config.has_component <- false; let result = List.map (fun item -> (match item.psig_desc with - | Psig_attribute attr -> processConfigAttribute attr config + | Psig_attribute attr -> process_config_attribute attr config | _ -> ()); let item = default_mapper.signature_item mapper item in - if config.version = 3 then transformSignatureItem3 item - else if config.version = 4 then transformSignatureItem4 item + if config.version = 3 then transform_signature_item3 item + else if config.version = 4 then transform_signature_item4 item else [item]) items |> List.flatten in - restoreConfig oldConfig; + restore_config old_config; result in let structure mapper items = - let oldConfig = saveConfig () in - config.hasComponent <- false; + let old_config = save_config () in + config.has_component <- false; let result = List.map (fun item -> (match item.pstr_desc with - | Pstr_attribute attr -> processConfigAttribute attr config + | Pstr_attribute attr -> process_config_attribute attr config | _ -> ()); let item = default_mapper.structure_item mapper item in - if config.version = 3 then transformStructureItem3 item - else if config.version = 4 then transformStructureItem4 item + if config.version = 3 then transform_structure_item3 item + else if config.version = 4 then transform_structure_item4 item else [item]) items |> List.flatten in - restoreConfig oldConfig; + restore_config old_config; result in {default_mapper with expr; module_binding; signature; structure} -let rewrite_implementation ~jsxVersion ~jsxModule ~jsxMode +let rewrite_implementation ~jsx_version ~jsx_module ~jsx_mode (code : Parsetree.structure) : Parsetree.structure = let config = { - Jsx_common.version = jsxVersion; - module_ = jsxModule; - mode = jsxMode; - nestedModules = []; - hasComponent = false; + Jsx_common.version = jsx_version; + module_ = jsx_module; + mode = jsx_mode; + nested_modules = []; + has_component = false; } in - let mapper = getMapper ~config in + let mapper = get_mapper ~config in mapper.structure mapper code -let rewrite_signature ~jsxVersion ~jsxModule ~jsxMode +let rewrite_signature ~jsx_version ~jsx_module ~jsx_mode (code : Parsetree.signature) : Parsetree.signature = let config = { - Jsx_common.version = jsxVersion; - module_ = jsxModule; - mode = jsxMode; - nestedModules = []; - hasComponent = false; + Jsx_common.version = jsx_version; + module_ = jsx_module; + mode = jsx_mode; + nested_modules = []; + has_component = false; } in - let mapper = getMapper ~config in + let mapper = get_mapper ~config in mapper.signature mapper code diff --git a/jscomp/syntax/src/jsx_ppx.mli b/jscomp/syntax/src/jsx_ppx.mli index 36a8468687..0f7c808c6c 100644 --- a/jscomp/syntax/src/jsx_ppx.mli +++ b/jscomp/syntax/src/jsx_ppx.mli @@ -9,15 +9,15 @@ *) val rewrite_implementation : - jsxVersion:int -> - jsxModule:string -> - jsxMode:string -> + jsx_version:int -> + jsx_module:string -> + jsx_mode:string -> Parsetree.structure -> Parsetree.structure val rewrite_signature : - jsxVersion:int -> - jsxModule:string -> - jsxMode:string -> + jsx_version:int -> + jsx_module:string -> + jsx_mode:string -> Parsetree.signature -> Parsetree.signature diff --git a/jscomp/syntax/src/jsx_v4.ml b/jscomp/syntax/src/jsx_v4.ml index 8c7bbedef3..e7ce1d7b04 100644 --- a/jscomp/syntax/src/jsx_v4.ml +++ b/jscomp/syntax/src/jsx_v4.ml @@ -4,7 +4,7 @@ open Asttypes open Parsetree open Longident -let moduleAccessName config value = +let module_access_name 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 isOptional str = +let is_optional str = match str with | Optional _ -> true | _ -> false -let isLabelled str = +let is_labelled str = match str with | Labelled _ -> true | _ -> false -let isForwardRef = function +let is_forward_ref = function | {pexp_desc = Pexp_ident {txt = Ldot (Lident "React", "forwardRef")}} -> true | _ -> false -let getLabel str = +let get_label str = match str with | Optional str | Labelled str -> str | Nolabel -> "" -let optionalAttrs = [Jsx_common.optionalAttr] +let optional_attrs = [Jsx_common.optional_attr] -let constantString ~loc str = +let constant_string ~loc str = Ast_helper.Exp.constant ~loc (Pconst_string (str, None)) (* {} empty record *) -let emptyRecord ~loc = Exp.record ~loc [] None +let empty_record ~loc = Exp.record ~loc [] None -let unitExpr ~loc = Exp.construct ~loc (Location.mkloc (Lident "()") loc) None +let unit_expr ~loc = Exp.construct ~loc (Location.mkloc (Lident "()") loc) None -let safeTypeFromValue valueStr = - let valueStr = getLabel valueStr in - if valueStr = "" || (valueStr.[0] [@doesNotRaise]) <> '_' then valueStr - else "T" ^ valueStr +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 refTypeVar loc = Typ.var ~loc "ref" +let ref_type_var loc = Typ.var ~loc "ref" -let refType loc = +let ref_type loc = Typ.constr ~loc {loc; txt = Ldot (Ldot (Lident "Js", "Nullable"), "t")} - [refTypeVar loc] + [ref_type_var 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 transformChildrenIfListUpper ~mapper theList = - let rec transformChildren_ theList accum = +let transform_children_if_list_upper ~mapper the_list = + let rec transformChildren_ the_list 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 theList with + match the_list with | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> ( match accum with - | [singleElement] -> Exact singleElement + | [single_element] -> Exact single_element | accum -> ListLiteral (Exp.array (List.rev accum))) | { pexp_desc = @@ -71,15 +71,15 @@ let transformChildrenIfListUpper ~mapper theList = ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple [v; acc]}); } -> transformChildren_ acc (mapper.expr mapper v :: accum) - | notAList -> Exact (mapper.expr mapper notAList) + | not_a_list -> Exact (mapper.expr mapper not_a_list) in - transformChildren_ theList [] + transformChildren_ the_list [] -let transformChildrenIfList ~mapper theList = - let rec transformChildren_ theList accum = +let transform_children_if_list ~mapper the_list = + let rec transformChildren_ the_list 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 theList with + match the_list with | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> Exp.array (List.rev accum) | { @@ -88,95 +88,95 @@ let transformChildrenIfList ~mapper theList = ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple [v; acc]}); } -> transformChildren_ acc (mapper.expr mapper v :: accum) - | notAList -> mapper.expr mapper notAList + | not_a_list -> mapper.expr mapper not_a_list in - transformChildren_ theList [] + transformChildren_ the_list [] -let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren = +let extract_children ?(remove_last_position_unit = false) ~loc props_and_children = let rec allButLast_ lst acc = match lst with | [] -> [] | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] -> acc | (Nolabel, {pexp_loc}) :: _rest -> - Jsx_common.raiseError ~loc:pexp_loc + Jsx_common.raise_error ~loc:pexp_loc "JSX: found non-labelled argument before the last position" | arg :: rest -> allButLast_ rest (arg :: acc) in - let allButLast lst = allButLast_ lst [] |> List.rev in + let all_but_last lst = allButLast_ lst [] |> List.rev in match List.partition (fun (label, _) -> label = labelled "children") - propsAndChildren + props_and_children with | [], props -> (* no children provided? Place a placeholder list *) ( Exp.construct {loc = Location.none; txt = Lident "[]"} None, - if removeLastPositionUnit then allButLast props else props ) - | [(_, childrenExpr)], props -> - (childrenExpr, if removeLastPositionUnit then allButLast props else props) + 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) | _ -> - Jsx_common.raiseError ~loc + Jsx_common.raise_error ~loc "JSX: somehow there's more than one `children` label" -let merlinFocus = ({loc = Location.none; txt = "merlin.focus"}, PStr []) +let merlin_focus = ({loc = Location.none; txt = "merlin.focus"}, PStr []) (* Helper method to filter out any attribute that isn't [@react.component] *) -let otherAttrsPure (loc, _) = +let other_attrs_pure (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 getFnName binding = +let rec get_fn_name binding = match binding with | {ppat_desc = Ppat_var {txt}} -> txt - | {ppat_desc = Ppat_constraint (pat, _)} -> getFnName pat + | {ppat_desc = Ppat_constraint (pat, _)} -> get_fn_name pat | {ppat_loc} -> - Jsx_common.raiseError ~loc:ppat_loc + Jsx_common.raise_error ~loc:ppat_loc "JSX component calls cannot be destructured." -let makeNewBinding binding expression newName = +let make_new_binding binding expression new_name = 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 = newName}}; + {pvb_pat with ppat_desc = Ppat_var {ppat_var with txt = new_name}}; pvb_expr = expression; - pvb_attributes = [merlinFocus]; + pvb_attributes = [merlin_focus]; } | {pvb_loc} -> - Jsx_common.raiseError ~loc:pvb_loc + Jsx_common.raise_error ~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 filenameFromLoc (pstr_loc : Location.t) = - let fileName = +let filename_from_loc (pstr_loc : Location.t) = + let file_name = match pstr_loc.loc_start.pos_fname with | "" -> !Location.input_name - | fileName -> fileName + | file_name -> file_name in - let fileName = - try Filename.chop_extension (Filename.basename fileName) - with Invalid_argument _ -> fileName + let file_name = + try Filename.chop_extension (Filename.basename file_name) + with Invalid_argument _ -> file_name in - let fileName = String.capitalize_ascii fileName in - fileName + let file_name = String.capitalize_ascii file_name in + file_name (* Build a string representation of a module name with segments separated by $ *) -let makeModuleName fileName nestedModules fnName = - let fullModuleName = - match (fileName, nestedModules, fnName) with +let make_module_name file_name nested_modules fn_name = + let full_module_name = + match (file_name, nested_modules, fn_name) with (* TODO: is this even reachable? It seems like the fileName always exists *) - | "", nestedModules, "make" -> nestedModules - | "", nestedModules, fnName -> List.rev (fnName :: nestedModules) - | fileName, nestedModules, "make" -> fileName :: List.rev nestedModules - | fileName, nestedModules, fnName -> - fileName :: List.rev (fnName :: nestedModules) + | "", 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) in - let fullModuleName = String.concat "$" fullModuleName in - fullModuleName + let full_module_name = String.concat "$" full_module_name in + full_module_name (* AST node builders @@ -185,98 +185,98 @@ let makeModuleName fileName nestedModules fnName = *) (* make record from props and spread props if exists *) -let recordFromProps ~loc ~removeKey callArguments = - let spreadPropsLabel = "_spreadProps" in - let rec removeLastPositionUnitAux props acc = +let record_from_props ~loc ~remove_key call_arguments = + let spread_props_label = "_spreadProps" in + let rec remove_last_position_unit_aux props acc = match props with | [] -> acc | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] -> acc | (Nolabel, {pexp_loc}) :: _rest -> - Jsx_common.raiseError ~loc:pexp_loc + Jsx_common.raise_error ~loc:pexp_loc "JSX: found non-labelled argument before the last position" | ((Labelled txt, {pexp_loc}) as prop) :: rest | ((Optional txt, {pexp_loc}) as prop) :: rest -> - if txt = spreadPropsLabel then + if txt = spread_props_label then match acc with - | [] -> removeLastPositionUnitAux rest (prop :: acc) + | [] -> remove_last_position_unit_aux rest (prop :: acc) | _ -> - Jsx_common.raiseError ~loc:pexp_loc + Jsx_common.raise_error ~loc:pexp_loc "JSX: use {...p} {x: v} not {x: v} {...p} \n\ \ multiple spreads {...p} {...p} not allowed." - else removeLastPositionUnitAux rest (prop :: acc) + else remove_last_position_unit_aux rest (prop :: acc) in - let props, propsToSpread = - removeLastPositionUnitAux callArguments [] + let props, props_to_spread = + remove_last_position_unit_aux call_arguments [] |> List.rev |> List.partition (fun (label, _) -> label <> labelled "_spreadProps") in let props = - if removeKey then - props |> List.filter (fun (arg_label, _) -> "key" <> getLabel arg_label) + if remove_key then + props |> List.filter (fun (arg_label, _) -> "key" <> get_label arg_label) else props in - let processProp (arg_label, ({pexp_loc} as pexpr)) = + let process_prop (arg_label, ({pexp_loc} as pexpr)) = (* In case filed label is "key" only then change expression to option *) - let id = getLabel arg_label in - if isOptional arg_label then + let id = get_label arg_label in + if is_optional arg_label then ( {txt = Lident id; loc = pexp_loc}, - {pexpr with pexp_attributes = optionalAttrs} ) + {pexpr with pexp_attributes = optional_attrs} ) else ({txt = Lident id; loc = pexp_loc}, pexpr) in - let fields = props |> List.map processProp in - let spreadFields = - propsToSpread |> List.map (fun (_, expression) -> expression) + let fields = props |> List.map process_prop in + let spread_fields = + props_to_spread |> List.map (fun (_, expression) -> expression) in - match (fields, spreadFields) with - | [], [spreadProps] | [], spreadProps :: _ -> spreadProps + match (fields, spread_fields) with + | [], [spread_props] | [], spread_props :: _ -> spread_props | _, [] -> { pexp_desc = Pexp_record (fields, None); pexp_loc = loc; pexp_attributes = []; } - | _, [spreadProps] + | _, [spread_props] (* take the first spreadProps only *) - | _, spreadProps :: _ -> + | _, spread_props :: _ -> { - pexp_desc = Pexp_record (fields, Some spreadProps); + pexp_desc = Pexp_record (fields, Some spread_props); pexp_loc = loc; pexp_attributes = []; } (* make type params for make fn arguments *) (* let make = ({id, name, children}: props<'id, 'name, 'children>) *) -let makePropsTypeParamsTvar namedTypeList = - namedTypeList +let make_props_type_params_tvar named_type_list = + named_type_list |> List.filter_map (fun (_isOptional, label, _, loc, _interiorType) -> if label = "key" then None - else Some (Typ.var ~loc @@ safeTypeFromValue (Labelled label))) + else Some (Typ.var ~loc @@ safe_type_from_value (Labelled label))) -let stripOption coreType = - match coreType with - | {ptyp_desc = Ptyp_constr ({txt = Lident "option"}, coreTypes)} -> - List.nth_opt coreTypes 0 [@doesNotRaise] - | _ -> Some coreType +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 stripJsNullable coreType = - match coreType with +let strip_js_nullable core_type = + match core_type with | { ptyp_desc = - Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Nullable"), "t")}, coreTypes); + Ptyp_constr ({txt = Ldot (Ldot (Lident "Js", "Nullable"), "t")}, core_types); } -> - List.nth_opt coreTypes 0 [@doesNotRaise] - | _ -> Some coreType + List.nth_opt core_types 0 [@doesNotRaise] + | _ -> Some core_type (* 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 makePropsTypeParams ?(stripExplicitOption = false) - ?(stripExplicitJsNullableOfRef = false) namedTypeList = - namedTypeList - |> List.filter_map (fun (isOptional, label, _, loc, interiorType) -> +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) -> if label = "key" then None (* TODO: Worth thinking how about "ref_" or "_ref" usages *) else if label = "ref" then @@ -284,19 +284,19 @@ let makePropsTypeParams ?(stripExplicitOption = 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 interiorType with - | {ptyp_desc = Ptyp_any} -> Some (refTypeVar loc) + match interior_type with + | {ptyp_desc = Ptyp_any} -> Some (ref_type_var loc) | _ -> (* Strip explicit Js.Nullable.t in case of forwardRef *) - if stripExplicitJsNullableOfRef then stripJsNullable interiorType - else Some interiorType + if strip_explicit_js_nullable_of_ref then strip_js_nullable interior_type + else Some interior_type (* Strip the explicit option type in implementation *) (* let make = (~x: option=?) => ... *) - else if isOptional && stripExplicitOption then stripOption interiorType - else Some interiorType) + else if is_optional && strip_explicit_option then strip_option interior_type + else Some interior_type) -let makeLabelDecls namedTypeList = - let rec checkDuplicatedLabel l = +let make_label_decls named_type_list = + let rec check_duplicated_label l = let rec mem_label ((_, (la : string), _, _, _) as x) = function | [] -> false | (_, (lb : string), _, _, _) :: l -> lb = la || mem_label x l @@ -306,89 +306,89 @@ let makeLabelDecls namedTypeList = | hd :: tl -> if mem_label hd tl then let _, label, _, loc, _ = hd in - Jsx_common.raiseError ~loc "JSX: found the duplicated prop `%s`" label - else checkDuplicatedLabel tl + Jsx_common.raise_error ~loc "JSX: found the duplicated prop `%s`" label + else check_duplicated_label tl in - let () = namedTypeList |> List.rev |> checkDuplicatedLabel in + let () = named_type_list |> List.rev |> check_duplicated_label in - namedTypeList - |> List.map (fun (isOptional, label, attrs, loc, interiorType) -> + named_type_list + |> List.map (fun (is_optional, label, attrs, loc, interior_type) -> if label = "key" then - 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) + 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) else Type.field ~loc ~attrs {txt = label; loc} - (Typ.var @@ safeTypeFromValue @@ Labelled label)) + (Typ.var @@ safe_type_from_value @@ Labelled label)) -let makeTypeDecls propsName loc namedTypeList = - let labelDeclList = makeLabelDecls namedTypeList in +let make_type_decls props_name loc named_type_list = + let label_decl_list = make_label_decls named_type_list in (* 'id, 'className, ... *) let params = - makePropsTypeParamsTvar namedTypeList - |> List.map (fun coreType -> (coreType, Invariant)) + make_props_type_params_tvar named_type_list + |> List.map (fun core_type -> (core_type, Invariant)) in [ - Type.mk ~loc ~params {txt = propsName; loc} - ~kind:(Ptype_record labelDeclList); + Type.mk ~loc ~params {txt = props_name; loc} + ~kind:(Ptype_record label_decl_list); ] -let makeTypeDeclsWithCoreType propsName loc coreType typVars = +let make_type_decls_with_core_type props_name loc core_type typ_vars = [ - Type.mk ~loc {txt = propsName; loc} ~kind:Ptype_abstract - ~params:(typVars |> List.map (fun v -> (v, Invariant))) - ~manifest:coreType; + Type.mk ~loc {txt = props_name; loc} ~kind:Ptype_abstract + ~params:(typ_vars |> List.map (fun v -> (v, Invariant))) + ~manifest:core_type; ] (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *) -let makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType propsName loc - namedTypeList = +let make_props_record_type ~core_type_of_attr ~typ_vars_of_core_type props_name loc + named_type_list = Str.type_ Nonrecursive - (match coreTypeOfAttr with - | None -> makeTypeDecls propsName loc namedTypeList - | Some coreType -> - makeTypeDeclsWithCoreType propsName loc coreType typVarsOfCoreType) + (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) (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *) -let makePropsRecordTypeSig ~coreTypeOfAttr ~typVarsOfCoreType propsName loc - namedTypeList = +let make_props_record_type_sig ~core_type_of_attr ~typ_vars_of_core_type props_name loc + named_type_list = Sig.type_ Nonrecursive - (match coreTypeOfAttr with - | None -> makeTypeDecls propsName loc namedTypeList - | Some coreType -> - makeTypeDeclsWithCoreType propsName loc coreType typVarsOfCoreType) + (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) -let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc - attrs callArguments = - let children, argsWithLabels = - extractChildren ~removeLastPositionUnit:true ~loc:jsxExprLoc callArguments +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 in - let argsForMake = argsWithLabels in - let childrenExpr = transformChildrenIfListUpper ~mapper children in - let recursivelyTransformedArgsForMake = - argsForMake + 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 |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in - let childrenArg = ref None in + let children_arg = ref None in let args = - recursivelyTransformedArgsForMake + recursively_transformed_args_for_make @ - match childrenExpr with + match children_expr 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 *) - childrenArg := Some expression; + children_arg := Some expression; match config.Jsx_common.mode with | "automatic" -> [ ( labelled "children", Exp.apply (Exp.ident - {txt = moduleAccessName config "array"; loc = Location.none}) + {txt = module_access_name config "array"; loc = Location.none}) [(Nolabel, expression)] ); ] | _ -> @@ -399,121 +399,121 @@ let transformUppercaseCall3 ~config modulePath mapper jsxExprLoc callExprLoc ]) in - let isCap str = String.capitalize_ascii str = str in + let is_cap str = String.capitalize_ascii str = str in let ident ~suffix = - match modulePath with - | Lident _ -> Ldot (modulePath, suffix) - | Ldot (_modulePath, value) as fullPath when isCap value -> - Ldot (fullPath, suffix) - | modulePath -> modulePath + 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 in - let isEmptyRecord {pexp_desc} = + let is_empty_record {pexp_desc} = match pexp_desc with - | Pexp_record (labelDecls, _) when List.length labelDecls = 0 -> true + | Pexp_record (label_decls, _) when List.length label_decls = 0 -> true | _ -> false in (* handle key, ref, children *) (* React.createElement(Component.make, props, ...children) *) - let record = recordFromProps ~loc:jsxExprLoc ~removeKey:true args in + let record = record_from_props ~loc:jsx_expr_loc ~remove_key:true args in let props = - if isEmptyRecord record then emptyRecord ~loc:jsxExprLoc else record + if is_empty_record record then empty_record ~loc:jsx_expr_loc else record in - let keyProp = - args |> List.filter (fun (arg_label, _) -> "key" = getLabel arg_label) + let key_prop = + args |> List.filter (fun (arg_label, _) -> "key" = get_label arg_label) in - let makeID = - Exp.ident ~loc:callExprLoc {txt = ident ~suffix:"make"; loc = callExprLoc} + let make_i_d = + Exp.ident ~loc:call_expr_loc {txt = ident ~suffix:"make"; loc = call_expr_loc} in match config.mode with (* The new jsx transform *) | "automatic" -> - let jsxExpr, keyAndUnit = - match (!childrenArg, keyProp) with + let jsx_expr, key_and_unit = + match (!children_arg, key_prop) with | None, key :: _ -> ( Exp.ident - {loc = Location.none; txt = moduleAccessName config "jsxKeyed"}, - [key; (nolabel, unitExpr ~loc:Location.none)] ) + {loc = Location.none; txt = module_access_name config "jsxKeyed"}, + [key; (nolabel, unit_expr ~loc:Location.none)] ) | None, [] -> - ( Exp.ident {loc = Location.none; txt = moduleAccessName config "jsx"}, + ( Exp.ident {loc = Location.none; txt = module_access_name config "jsx"}, [] ) | Some _, key :: _ -> ( Exp.ident - {loc = Location.none; txt = moduleAccessName config "jsxsKeyed"}, - [key; (nolabel, unitExpr ~loc:Location.none)] ) + {loc = Location.none; txt = module_access_name config "jsxsKeyed"}, + [key; (nolabel, unit_expr ~loc:Location.none)] ) | Some _, [] -> - ( Exp.ident {loc = Location.none; txt = moduleAccessName config "jsxs"}, + ( Exp.ident {loc = Location.none; txt = module_access_name config "jsxs"}, [] ) in - Exp.apply ~loc:jsxExprLoc ~attrs jsxExpr - ([(nolabel, makeID); (nolabel, props)] @ keyAndUnit) + Exp.apply ~loc:jsx_expr_loc ~attrs jsx_expr + ([(nolabel, make_i_d); (nolabel, props)] @ key_and_unit) | _ -> ( - match (!childrenArg, keyProp) with + match (!children_arg, key_prop) with | None, key :: _ -> - Exp.apply ~loc:jsxExprLoc ~attrs + Exp.apply ~loc:jsx_expr_loc ~attrs (Exp.ident { loc = Location.none; txt = Ldot (Lident "JsxPPXReactSupport", "createElementWithKey"); }) - [key; (nolabel, makeID); (nolabel, props)] + [key; (nolabel, make_i_d); (nolabel, props)] | None, [] -> - Exp.apply ~loc:jsxExprLoc ~attrs + Exp.apply ~loc:jsx_expr_loc ~attrs (Exp.ident {loc = Location.none; txt = Ldot (Lident "React", "createElement")}) - [(nolabel, makeID); (nolabel, props)] + [(nolabel, make_i_d); (nolabel, props)] | Some children, key :: _ -> - Exp.apply ~loc:jsxExprLoc ~attrs + Exp.apply ~loc:jsx_expr_loc ~attrs (Exp.ident { loc = Location.none; txt = Ldot (Lident "JsxPPXReactSupport", "createElementVariadicWithKey"); }) - [key; (nolabel, makeID); (nolabel, props); (nolabel, children)] + [key; (nolabel, make_i_d); (nolabel, props); (nolabel, children)] | Some children, [] -> - Exp.apply ~loc:jsxExprLoc ~attrs + Exp.apply ~loc:jsx_expr_loc ~attrs (Exp.ident { loc = Location.none; txt = Ldot (Lident "React", "createElementVariadic"); }) - [(nolabel, makeID); (nolabel, props); (nolabel, children)]) + [(nolabel, make_i_d); (nolabel, props); (nolabel, children)]) -let transformLowercaseCall3 ~config mapper jsxExprLoc callExprLoc attrs - callArguments id = - let componentNameExpr = constantString ~loc:callExprLoc id in +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 match config.Jsx_common.mode with (* the new jsx transform *) | "automatic" -> - let elementBinding = + let element_binding = match config.module_ |> String.lowercase_ascii with | "react" -> Lident "ReactDOM" - | _generic -> moduleAccessName config "Elements" + | _generic -> module_access_name config "Elements" in - let children, nonChildrenProps = - extractChildren ~removeLastPositionUnit:true ~loc:jsxExprLoc callArguments + let children, non_children_props = + extract_children ~remove_last_position_unit:true ~loc:jsx_expr_loc call_arguments in - let argsForMake = nonChildrenProps in - let childrenExpr = transformChildrenIfListUpper ~mapper children in - let recursivelyTransformedArgsForMake = - argsForMake + 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 |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in - let childrenArg = ref None in + let children_arg = ref None in let args = - recursivelyTransformedArgsForMake + recursively_transformed_args_for_make @ - match childrenExpr with + match children_expr with | Exact children -> [ ( labelled "children", - Exp.apply ~attrs:optionalAttrs + Exp.apply ~attrs:optional_attrs (Exp.ident { - txt = Ldot (elementBinding, "someElement"); + txt = Ldot (element_binding, "someElement"); loc = Location.none; }) [(Nolabel, children)] ); @@ -521,51 +521,51 @@ let transformLowercaseCall3 ~config mapper jsxExprLoc callExprLoc attrs | ListLiteral {pexp_desc = Pexp_array list} when list = [] -> [] | ListLiteral expression -> (* this is a hack to support react components that introspect into their children *) - childrenArg := Some expression; + children_arg := Some expression; [ ( labelled "children", Exp.apply (Exp.ident - {txt = moduleAccessName config "array"; loc = Location.none}) + {txt = module_access_name config "array"; loc = Location.none}) [(Nolabel, expression)] ); ] in - let isEmptyRecord {pexp_desc} = + let is_empty_record {pexp_desc} = match pexp_desc with - | Pexp_record (labelDecls, _) when List.length labelDecls = 0 -> true + | Pexp_record (label_decls, _) when List.length label_decls = 0 -> true | _ -> false in - let record = recordFromProps ~loc:jsxExprLoc ~removeKey:true args in + let record = record_from_props ~loc:jsx_expr_loc ~remove_key:true args in let props = - if isEmptyRecord record then emptyRecord ~loc:jsxExprLoc else record + if is_empty_record record then empty_record ~loc:jsx_expr_loc else record in - let keyProp = - args |> List.filter (fun (arg_label, _) -> "key" = getLabel arg_label) + let key_prop = + args |> List.filter (fun (arg_label, _) -> "key" = get_label arg_label) in - let jsxExpr, keyAndUnit = - match (!childrenArg, keyProp) with + let jsx_expr, key_and_unit = + match (!children_arg, key_prop) with | None, key :: _ -> ( Exp.ident - {loc = Location.none; txt = Ldot (elementBinding, "jsxKeyed")}, - [key; (nolabel, unitExpr ~loc:Location.none)] ) + {loc = Location.none; txt = Ldot (element_binding, "jsxKeyed")}, + [key; (nolabel, unit_expr ~loc:Location.none)] ) | None, [] -> - (Exp.ident {loc = Location.none; txt = Ldot (elementBinding, "jsx")}, []) + (Exp.ident {loc = Location.none; txt = Ldot (element_binding, "jsx")}, []) | Some _, key :: _ -> ( Exp.ident - {loc = Location.none; txt = Ldot (elementBinding, "jsxsKeyed")}, - [key; (nolabel, unitExpr ~loc:Location.none)] ) + {loc = Location.none; txt = Ldot (element_binding, "jsxsKeyed")}, + [key; (nolabel, unit_expr ~loc:Location.none)] ) | Some _, [] -> - ( Exp.ident {loc = Location.none; txt = Ldot (elementBinding, "jsxs")}, + ( Exp.ident {loc = Location.none; txt = Ldot (element_binding, "jsxs")}, [] ) in - Exp.apply ~loc:jsxExprLoc ~attrs jsxExpr - ([(nolabel, componentNameExpr); (nolabel, props)] @ keyAndUnit) + Exp.apply ~loc:jsx_expr_loc ~attrs jsx_expr + ([(nolabel, component_name_expr); (nolabel, props)] @ key_and_unit) | _ -> - let children, nonChildrenProps = - extractChildren ~loc:jsxExprLoc callArguments + let children, non_children_props = + extract_children ~loc:jsx_expr_loc call_arguments in - let childrenExpr = transformChildrenIfList ~mapper children in - let createElementCall = + let children_expr = transform_children_if_list ~mapper children in + let create_element_call = match children with (* [@JSX] div(~children=[a]), coming from
a
*) | { @@ -576,61 +576,61 @@ let transformLowercaseCall3 ~config mapper jsxExprLoc callExprLoc attrs "createDOMElementVariadic" (* [@JSX] div(~children= value), coming from
...(value)
*) | {pexp_loc} -> - Jsx_common.raiseError ~loc:pexp_loc + Jsx_common.raise_error ~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 nonChildrenProps with + match non_children_props with | [_justTheUnitArgumentAtEnd] -> [ (* "div" *) - (nolabel, componentNameExpr); + (nolabel, component_name_expr); (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr); + (nolabel, children_expr); ] - | nonEmptyProps -> - let propsRecord = - recordFromProps ~loc:Location.none ~removeKey:false nonEmptyProps + | non_empty_props -> + let props_record = + record_from_props ~loc:Location.none ~remove_key:false non_empty_props in [ (* "div" *) - (nolabel, componentNameExpr); + (nolabel, component_name_expr); (* ReactDOM.domProps(~className=blabla, ~foo=bar, ()) *) - (labelled "props", propsRecord); + (labelled "props", props_record); (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr); + (nolabel, children_expr); ] in - Exp.apply ~loc:jsxExprLoc ~attrs + Exp.apply ~loc:jsx_expr_loc ~attrs (* ReactDOM.createElement *) (Exp.ident { loc = Location.none; - txt = Ldot (Lident "ReactDOM", createElementCall); + txt = Ldot (Lident "ReactDOM", create_element_call); }) args -let rec recursivelyTransformNamedArgsForMake expr args newtypes coreType = +let rec recursively_transform_named_args_for_make expr args newtypes core_type = match expr.pexp_desc with (* TODO: make this show up with a loc. *) | Pexp_fun (Labelled "key", _, _, _) | Pexp_fun (Optional "key", _, _, _) -> - Jsx_common.raiseError ~loc:expr.pexp_loc + Jsx_common.raise_error ~loc:expr.pexp_loc "Key cannot be accessed inside of a component. Don't worry - you can \ always key a component from its parent!" | Pexp_fun (Labelled "ref", _, _, _) | Pexp_fun (Optional "ref", _, _, _) -> - Jsx_common.raiseError ~loc:expr.pexp_loc + Jsx_common.raise_error ~loc:expr.pexp_loc "Ref cannot be passed as a normal prop. Please use `forwardRef` API \ instead." | Pexp_fun (arg, default, pattern, expression) - when isOptional arg || isLabelled arg -> + when is_optional arg || is_labelled arg -> let () = - match (isOptional arg, pattern, default) with + match (is_optional arg, pattern, default) with | true, {ppat_desc = Ppat_constraint (_, {ptyp_desc})}, None -> ( match ptyp_desc with | Ptyp_constr ({txt = Lident "option"}, [_]) -> () | _ -> - let currentType = + let current_type = match ptyp_desc with | Ptyp_constr ({txt}, []) -> String.concat "." (Longident.flatten txt) @@ -643,7 +643,7 @@ let rec recursivelyTransformNamedArgsForMake expr args newtypes coreType = (Printf.sprintf "React: optional argument annotations must have explicit \ `option`. Did you mean `option<%s>=?`?" - currentType))) + current_type))) | _ -> () in let alias = @@ -656,7 +656,7 @@ let rec recursivelyTransformNamedArgsForMake expr args newtypes coreType = } -> txt | {ppat_desc = Ppat_any} -> "_" - | _ -> getLabel arg + | _ -> get_label arg in let type_ = match pattern with @@ -665,15 +665,15 @@ let rec recursivelyTransformNamedArgsForMake expr args newtypes coreType = | _ -> None in - recursivelyTransformNamedArgsForMake expression + recursively_transform_named_args_for_make expression ((arg, default, pattern, alias, pattern.ppat_loc, type_) :: args) - newtypes coreType + newtypes core_type | Pexp_fun ( Nolabel, _, {ppat_desc = Ppat_construct ({txt = Lident "()"}, _) | Ppat_any}, _expression ) -> - (args, newtypes, coreType) + (args, newtypes, core_type) | Pexp_fun ( Nolabel, _, @@ -691,102 +691,102 @@ let rec recursivelyTransformNamedArgsForMake expr args newtypes coreType = (* The ref arguement of forwardRef should be optional *) ( (Optional "ref", None, pattern, txt, pattern.ppat_loc, type_) :: args, newtypes, - coreType ) - else (args, newtypes, coreType) + core_type ) + else (args, newtypes, core_type) | 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) -> - recursivelyTransformNamedArgsForMake expression args (label :: newtypes) - coreType - | Pexp_constraint (expression, coreType) -> - recursivelyTransformNamedArgsForMake expression args newtypes - (Some coreType) - | _ -> (args, newtypes, coreType) + 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) -let argToType types +let arg_to_type 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 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 + | 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 | _ -> types -let hasDefaultValue nameArgList = - nameArgList +let has_default_value name_arg_list = + name_arg_list |> List.exists (fun (name, default, _, _, _, _) -> - Option.is_some default && isOptional name) + Option.is_some default && is_optional name) -let argToConcreteType types (name, attrs, loc, type_) = +let arg_to_concrete_type types (name, attrs, loc, type_) = match name with - | name when isLabelled name -> - (false, getLabel name, attrs, loc, type_) :: types - | name when isOptional name -> - (true, getLabel name, attrs, loc, type_) :: types + | 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 | _ -> types let check_string_int_attribute_iter = let attribute _ ({txt; loc}, _) = if txt = "string" || txt = "int" then - Jsx_common.raiseError ~loc + Jsx_common.raise_error ~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 checkMultipleComponents ~config ~loc = +let check_multiple_components ~config ~loc = (* If there is another component, throw error *) - if config.Jsx_common.hasComponent then - Jsx_common.raiseErrorMultipleComponent ~loc - else config.hasComponent <- true + if config.Jsx_common.has_component then + Jsx_common.raise_error_multiple_component ~loc + else config.has_component <- true -let modifiedBindingOld binding = +let modified_binding_old 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 spelunkForFunExpression expression = + let rec spelunk_for_fun_expression 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, returnExpression)} -> + | {pexp_desc = Pexp_let (_recursive, _vbs, return_expression)} -> (* here's where we spelunk! *) - spelunkForFunExpression returnExpression + spelunk_for_fun_expression return_expression (* let make = React.forwardRef((~prop) => ...) *) | { pexp_desc = - Pexp_apply (_wrapperExpression, [(Nolabel, innerFunctionExpression)]); + Pexp_apply (_wrapperExpression, [(Nolabel, inner_function_expression)]); } -> - spelunkForFunExpression innerFunctionExpression - | {pexp_desc = Pexp_sequence (_wrapperExpression, innerFunctionExpression)} + spelunk_for_fun_expression inner_function_expression + | {pexp_desc = Pexp_sequence (_wrapperExpression, inner_function_expression)} -> - spelunkForFunExpression innerFunctionExpression - | {pexp_desc = Pexp_constraint (innerFunctionExpression, _typ)} -> - spelunkForFunExpression innerFunctionExpression + spelunk_for_fun_expression inner_function_expression + | {pexp_desc = Pexp_constraint (inner_function_expression, _typ)} -> + spelunk_for_fun_expression inner_function_expression | {pexp_loc} -> - Jsx_common.raiseError ~loc:pexp_loc + Jsx_common.raise_error ~loc:pexp_loc "JSX component calls can only be on function definitions or component \ wrappers (forwardRef, memo)." in - spelunkForFunExpression expression + spelunk_for_fun_expression 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) +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) 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 spelunkForFunExpression expression = + let rec spelunk_for_fun_expression expression = match expression with (* let make = (~prop) => ... with no final unit *) | { @@ -795,13 +795,13 @@ let modifiedBinding ~bindingLoc ~bindingPatLoc ~fnName binding = ( ((Labelled _ | Optional _) as label), default, pattern, - ({pexp_desc = Pexp_fun _} as internalExpression) ); + ({pexp_desc = Pexp_fun _} as internal_expression) ); } -> - let wrap, hasForwardRef, exp = - spelunkForFunExpression internalExpression + let wrap, has_forward_ref, exp = + spelunk_for_fun_expression internal_expression in ( wrap, - hasForwardRef, + has_forward_ref, {expression with pexp_desc = Pexp_fun (label, default, pattern, exp)} ) (* let make = (()) => ... *) (* let make = (_) => ... *) @@ -824,7 +824,7 @@ let modifiedBinding ~bindingLoc ~bindingPatLoc ~fnName binding = (* let make = (prop) => ... *) | {pexp_desc = Pexp_fun (_nolabel, _default, pattern, _internalExpression)} -> - if !hasApplication then ((fun a -> a), false, expression) + if !has_application then ((fun a -> a), false, expression) else Location.raise_errorf ~loc:pattern.ppat_loc "React: props need to be labelled arguments.\n\ @@ -832,40 +832,40 @@ let modifiedBinding ~bindingLoc ~bindingPatLoc ~fnName 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, internalExpression)} -> + | {pexp_desc = Pexp_let (recursive, vbs, internal_expression)} -> (* here's where we spelunk! *) - let wrap, hasForwardRef, exp = - spelunkForFunExpression internalExpression + let wrap, has_forward_ref, exp = + spelunk_for_fun_expression internal_expression in ( wrap, - hasForwardRef, + has_forward_ref, {expression with pexp_desc = Pexp_let (recursive, vbs, exp)} ) (* let make = React.forwardRef((~prop) => ...) *) | { - pexp_desc = Pexp_apply (wrapperExpression, [(Nolabel, internalExpression)]); + pexp_desc = Pexp_apply (wrapper_expression, [(Nolabel, internal_expression)]); } -> - let () = hasApplication := true in - let _, _, exp = spelunkForFunExpression internalExpression in - let hasForwardRef = isForwardRef wrapperExpression in - ( (fun exp -> Exp.apply wrapperExpression [(nolabel, exp)]), - hasForwardRef, + 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, exp ) - | {pexp_desc = Pexp_sequence (wrapperExpression, internalExpression)} -> - let wrap, hasForwardRef, exp = - spelunkForFunExpression internalExpression + | {pexp_desc = Pexp_sequence (wrapper_expression, internal_expression)} -> + let wrap, has_forward_ref, exp = + spelunk_for_fun_expression internal_expression in ( wrap, - hasForwardRef, - {expression with pexp_desc = Pexp_sequence (wrapperExpression, exp)} ) + has_forward_ref, + {expression with pexp_desc = Pexp_sequence (wrapper_expression, exp)} ) | e -> ((fun a -> a), false, e) in - let wrapExpression, hasForwardRef, expression = - spelunkForFunExpression expression + let wrap_expression, has_forward_ref, expression = + spelunk_for_fun_expression expression in - (wrapExpressionWithBinding wrapExpression, hasForwardRef, expression) + (wrap_expression_with_binding wrap_expression, has_forward_ref, expression) -let vbMatch ~expr (name, default, _, alias, loc, _) = - let label = getLabel name in +let vb_match ~expr (name, default, _, alias, loc, _) = + let label = get_label name in match default with | Some default -> let value_binding = @@ -887,124 +887,124 @@ let vbMatch ~expr (name, default, _, alias, loc, _) = Exp.let_ Nonrecursive [value_binding] expr | None -> expr -let vbMatchExpr namedArgList expr = - let rec aux namedArgList = - match namedArgList with +let vb_match_expr named_arg_list expr = + let rec aux named_arg_list = + match named_arg_list with | [] -> expr - | namedArg :: rest -> vbMatch namedArg ~expr:(aux rest) + | named_arg :: rest -> vb_match named_arg ~expr:(aux rest) in - aux (List.rev namedArgList) + aux (List.rev named_arg_list) -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 +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 |> Option.value ~default:[] in - let bindingLoc = binding.pvb_loc in - let bindingPatLoc = binding.pvb_pat.ppat_loc in + let binding_loc = binding.pvb_loc in + let binding_pat_loc = binding.pvb_pat.ppat_loc in let binding = { binding with - pvb_pat = {binding.pvb_pat with ppat_loc = emptyLoc}; - pvb_loc = emptyLoc; - pvb_attributes = binding.pvb_attributes |> List.filter otherAttrsPure; + pvb_pat = {binding.pvb_pat with ppat_loc = empty_loc}; + pvb_loc = empty_loc; + pvb_attributes = binding.pvb_attributes |> List.filter other_attrs_pure; } in - 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 + 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 in - let isAsync = + let is_async = Ext_list.find_first binding.pvb_expr.pexp_attributes Ast_async.is_async |> Option.is_some in (* do stuff here! *) - let namedArgList, newtypes, _typeConstraints = - recursivelyTransformNamedArgsForMake - (modifiedBindingOld binding) + let named_arg_list, newtypes, _typeConstraints = + recursively_transform_named_args_for_make + (modified_binding_old binding) [] [] None in - let namedTypeList = List.fold_left argToType [] namedArgList in + let named_type_list = List.fold_left arg_to_type [] named_arg_list in (* type props = { ... } *) - let propsRecordType = - makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType "props" pstr_loc - namedTypeList + let props_record_type = + make_props_record_type ~core_type_of_attr ~typ_vars_of_core_type "props" pstr_loc + named_type_list in - let innerExpression = + let inner_expression = Exp.apply (Exp.ident (Location.mknoloc @@ Lident - (match recFlag with - | Recursive -> internalFnName - | Nonrecursive -> fnName))) + (match rec_flag with + | Recursive -> internal_fn_name + | Nonrecursive -> fn_name))) ([(Nolabel, Exp.ident (Location.mknoloc @@ Lident "props"))] @ - match hasForwardRef with + match has_forward_ref with | true -> [(Nolabel, Exp.ident (Location.mknoloc @@ Lident "ref"))] | false -> []) in - let makePropsPattern = function + let make_props_pattern = function | [] -> Pat.var @@ Location.mknoloc "props" | _ -> Pat.constraint_ (Pat.var @@ Location.mknoloc "props") (Typ.constr (Location.mknoloc @@ Lident "props") [Typ.any ()]) in - let innerExpression = - Jsx_common.async_component ~async:isAsync innerExpression + let inner_expression = + Jsx_common.async_component ~async:is_async inner_expression in - let fullExpression = + let full_expression = (* 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 coreTypeOfAttr with - | None -> makePropsPattern namedTypeList - | Some _ -> makePropsPattern typVarsOfCoreType) - (if hasForwardRef then + (match core_type_of_attr with + | None -> make_props_pattern named_type_list + | Some _ -> make_props_pattern typ_vars_of_core_type) + (if has_forward_ref then Exp.fun_ nolabel None (Pat.var @@ Location.mknoloc "ref") - innerExpression - else innerExpression) + inner_expression + else inner_expression) in - let fullExpression = + let full_expression = if !Config.uncurried = Uncurried then - fullExpression - |> Ast_uncurried.uncurriedFun ~loc:fullExpression.pexp_loc - ~arity:(if hasForwardRef then 2 else 1) - else fullExpression + full_expression + |> Ast_uncurried.uncurried_fun ~loc:full_expression.pexp_loc + ~arity:(if has_forward_ref then 2 else 1) + else full_expression in - let fullExpression = - match fullModuleName with - | "" -> fullExpression + let full_expression = + match full_module_name with + | "" -> full_expression | txt -> Exp.let_ Nonrecursive [ - Vb.mk ~loc:emptyLoc - (Pat.var ~loc:emptyLoc {loc = emptyLoc; txt}) - fullExpression; + Vb.mk ~loc:empty_loc + (Pat.var ~loc:empty_loc {loc = empty_loc; txt}) + full_expression; ] - (Exp.ident ~loc:pstr_loc {loc = emptyLoc; txt = Lident txt}) + (Exp.ident ~loc:pstr_loc {loc = empty_loc; txt = Lident txt}) in - let rec stripConstraintUnpack ~label pattern = + let rec strip_constraint_unpack ~label pattern = match pattern with | {ppat_desc = Ppat_constraint (_, {ptyp_desc = Ptyp_package _})} -> pattern | {ppat_desc = Ppat_constraint (pattern, _)} -> - stripConstraintUnpack ~label pattern + strip_constraint_unpack ~label pattern | _ -> pattern in - let safePatternLabel pattern = + let safe_pattern_label pattern = match pattern with | {ppat_desc = Ppat_var {txt; loc}} -> {pattern with ppat_desc = Ppat_var {txt = "__" ^ txt; loc}} @@ -1012,68 +1012,68 @@ let mapBinding ~config ~emptyLoc ~pstr_loc ~fileName ~recFlag binding = {pattern with ppat_desc = Ppat_alias (p, {txt = "__" ^ txt; loc})} | _ -> pattern in - let rec returnedExpression patternsWithLabel patternsWithNolabel + let rec returned_expression patterns_with_label patterns_with_nolabel ({pexp_desc} as expr) = match pexp_desc with | Pexp_newtype (_, expr) -> - returnedExpression patternsWithLabel patternsWithNolabel expr + returned_expression patterns_with_label patterns_with_nolabel expr | Pexp_constraint (expr, _) -> - returnedExpression patternsWithLabel patternsWithNolabel expr + returned_expression patterns_with_label patterns_with_nolabel expr | Pexp_fun ( _arg_label, _default, {ppat_desc = Ppat_construct ({txt = Lident "()"}, _)}, expr ) -> - (patternsWithLabel, patternsWithNolabel, expr) + (patterns_with_label, patterns_with_nolabel, expr) | Pexp_fun (arg_label, default, ({ppat_loc; ppat_desc} as pattern), expr) -> ( - let patternWithoutConstraint = - stripConstraintUnpack ~label:(getLabel arg_label) pattern + let pattern_without_constraint = + strip_constraint_unpack ~label:(get_label 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 patternWithSafeLabel = + let pattern_with_safe_label = match default with - | Some _ -> safePatternLabel patternWithoutConstraint - | _ -> patternWithoutConstraint + | Some _ -> safe_pattern_label pattern_without_constraint + | _ -> pattern_without_constraint in - if isLabelled arg_label || isOptional arg_label then - returnedExpression - (( {loc = ppat_loc; txt = Lident (getLabel arg_label)}, + if is_labelled arg_label || is_optional arg_label then + returned_expression + (( {loc = ppat_loc; txt = Lident (get_label arg_label)}, { - patternWithSafeLabel with + pattern_with_safe_label with ppat_attributes = - (if isOptional arg_label then optionalAttrs else []) + (if is_optional arg_label then optional_attrs else []) @ pattern.ppat_attributes; } ) - :: patternsWithLabel) - patternsWithNolabel expr + :: patterns_with_label) + patterns_with_nolabel 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}}, _) -> - returnedExpression patternsWithLabel + returned_expression patterns_with_label (( {loc = ppat_loc; txt = Lident txt}, { pattern with - ppat_attributes = optionalAttrs @ pattern.ppat_attributes; + ppat_attributes = optional_attrs @ pattern.ppat_attributes; } ) - :: patternsWithNolabel) + :: patterns_with_nolabel) expr - | _ -> returnedExpression patternsWithLabel patternsWithNolabel expr) - | _ -> (patternsWithLabel, patternsWithNolabel, expr) + | _ -> returned_expression patterns_with_label patterns_with_nolabel expr) + | _ -> (patterns_with_label, patterns_with_nolabel, expr) in - let patternsWithLabel, patternsWithNolabel, expression = - returnedExpression [] [] expression + let patterns_with_label, patterns_with_nolabel, expression = + returned_expression [] [] expression in (* add pattern matching for optional prop value *) let expression = - if hasDefaultValue namedArgList then vbMatchExpr namedArgList expression + if has_default_value named_arg_list then vb_match_expr named_arg_list expression else expression in (* (ref) => expr *) @@ -1083,64 +1083,64 @@ let mapBinding ~config ~emptyLoc ~pstr_loc ~fileName ~recFlag binding = let pattern = match pattern.ppat_desc with | Ppat_var {txt} when txt = "ref" -> - Pat.constraint_ pattern (refType Location.none) + Pat.constraint_ pattern (ref_type Location.none) | _ -> pattern in Exp.fun_ Nolabel None pattern expr) - expression patternsWithNolabel + expression patterns_with_nolabel in (* ({a, b, _}: props<'a, 'b>) *) - let recordPattern = - match patternsWithLabel with + let record_pattern = + match patterns_with_label with | [] -> Pat.any () - | _ -> Pat.record (List.rev patternsWithLabel) Open + | _ -> Pat.record (List.rev patterns_with_label) Open in let expression = Exp.fun_ Nolabel None - (Pat.constraint_ recordPattern - (Typ.constr ~loc:emptyLoc - {txt = Lident "props"; loc = emptyLoc} - (match coreTypeOfAttr with + (Pat.constraint_ record_pattern + (Typ.constr ~loc:empty_loc + {txt = Lident "props"; loc = empty_loc} + (match core_type_of_attr with | None -> - makePropsTypeParams ~stripExplicitOption:true - ~stripExplicitJsNullableOfRef:hasForwardRef namedTypeList + make_props_type_params ~strip_explicit_option:true + ~strip_explicit_js_nullable_of_ref:has_forward_ref named_type_list | Some _ -> ( - match typVarsOfCoreType with + match typ_vars_of_core_type with | [] -> [] | _ -> [Typ.any ()])))) expression in - let expression = Ast_async.add_async_attribute ~async:isAsync expression in + let expression = Ast_async.add_async_attribute ~async:is_async 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, newBinding = - match recFlag with + let binding, new_binding = + match rec_flag with | Recursive -> - ( bindingWrapper - (Exp.let_ ~loc:emptyLoc Nonrecursive - [makeNewBinding binding expression internalFnName] - (Exp.let_ ~loc:emptyLoc Nonrecursive + ( binding_wrapper + (Exp.let_ ~loc:empty_loc Nonrecursive + [make_new_binding binding expression internal_fn_name] + (Exp.let_ ~loc:empty_loc Nonrecursive [ - Vb.mk (Pat.var {loc = emptyLoc; txt = fnName}) fullExpression; + Vb.mk (Pat.var {loc = empty_loc; txt = fn_name}) full_expression; ] - (Exp.ident {loc = emptyLoc; txt = Lident fnName}))), + (Exp.ident {loc = empty_loc; txt = Lident fn_name}))), None ) | Nonrecursive -> ( { binding with pvb_expr = expression; - pvb_pat = Pat.var {txt = fnName; loc = Location.none}; + pvb_pat = Pat.var {txt = fn_name; loc = Location.none}; }, - Some (bindingWrapper fullExpression) ) + Some (binding_wrapper full_expression) ) in - (Some propsRecordType, binding, newBinding)) + (Some props_record_type, binding, new_binding)) else (None, binding, None) -let transformStructureItem ~config item = +let transform_structure_item ~config item = match item with (* external *) | { @@ -1148,211 +1148,211 @@ let transformStructureItem ~config item = pstr_desc = Pstr_primitive ({pval_attributes; pval_type} as value_description); } as pstr -> ( - match List.filter Jsx_common.hasAttr pval_attributes with + match List.filter Jsx_common.has_attr pval_attributes with | [] -> [item] | [_] -> - checkMultipleComponents ~config ~loc:pstr_loc; + check_multiple_components ~config ~loc:pstr_loc; check_string_int_attribute_iter.structure_item check_string_int_attribute_iter item; - 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 + 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 |> Option.value ~default:[] in - let rec getPropTypes types - ({ptyp_loc; ptyp_desc; ptyp_attributes} as fullType) = + let rec get_prop_types types + ({ptyp_loc; ptyp_desc; ptyp_attributes} as full_type) = match ptyp_desc with | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) - 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) + 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) in - let innerType, propTypes = getPropTypes [] pval_type in - let namedTypeList = List.fold_left argToConcreteType [] propTypes in - let retPropsType = + 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 = Typ.constr ~loc:pstr_loc (Location.mkloc (Lident "props") pstr_loc) - (match coreTypeOfAttr with - | None -> makePropsTypeParams namedTypeList + (match core_type_of_attr with + | None -> make_props_type_params named_type_list | Some _ -> ( - match typVarsOfCoreType with + match typ_vars_of_core_type with | [] -> [] | _ -> [Typ.any ()])) in (* type props<'x, 'y> = { x: 'x, y?: 'y, ... } *) - let propsRecordType = - makePropsRecordType ~coreTypeOfAttr ~typVarsOfCoreType "props" pstr_loc - namedTypeList + let props_record_type = + make_props_record_type ~core_type_of_attr ~typ_vars_of_core_type "props" pstr_loc + named_type_list in (* can't be an arrow because it will defensively uncurry *) - let newExternalType = + let new_external_type = Ptyp_constr - ( {loc = pstr_loc; txt = moduleAccessName config "componentLike"}, - [retPropsType; innerType] ) + ( {loc = pstr_loc; txt = module_access_name config "componentLike"}, + [ret_props_type; inner_type] ) in - let newStructure = + let new_structure = { pstr with pstr_desc = Pstr_primitive { value_description with - pval_type = {pval_type with ptyp_desc = newExternalType}; - pval_attributes = List.filter otherAttrsPure pval_attributes; + pval_type = {pval_type with ptyp_desc = new_external_type}; + pval_attributes = List.filter other_attrs_pure pval_attributes; }; } in - [propsRecordType; newStructure] + [props_record_type; new_structure] | _ -> - Jsx_common.raiseError ~loc:pstr_loc + Jsx_common.raise_error ~loc:pstr_loc "Only one JSX component call can exist on a component at one time") (* let component = ... *) - | {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 + | {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 in - let newItems = - match newItem with - | Some item -> item :: newItems - | None -> newItems + let new_items = + match new_item with + | Some item -> item :: new_items + | None -> new_items in - let newBindings = - match newBinding with - | Some newBinding -> newBinding :: newBindings - | None -> newBindings + let new_bindings = + match new_binding with + | Some new_binding -> new_binding :: new_bindings + | None -> new_bindings in - (newItems, binding :: bindings, newBindings) + (new_items, binding :: bindings, new_bindings) in - let newItems, bindings, newBindings = - List.fold_right processBinding valueBindings ([], [], []) + let new_items, bindings, new_bindings = + List.fold_right process_binding value_bindings ([], [], []) in - newItems - @ [{pstr_loc; pstr_desc = Pstr_value (recFlag, bindings)}] + new_items + @ [{pstr_loc; pstr_desc = Pstr_value (rec_flag, bindings)}] @ - match newBindings with + match new_bindings with | [] -> [] - | newBindings -> - [{pstr_loc = emptyLoc; pstr_desc = Pstr_value (recFlag, newBindings)}]) + | new_bindings -> + [{pstr_loc = empty_loc; pstr_desc = Pstr_value (rec_flag, new_bindings)}]) | _ -> [item] -let transformSignatureItem ~config item = +let transform_signature_item ~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.hasAttr pval_attributes with + match List.filter Jsx_common.has_attr pval_attributes with | [] -> [item] | [_] -> - checkMultipleComponents ~config ~loc:psig_loc; - let pval_type = Jsx_common.extractUncurried pval_type in + check_multiple_components ~config ~loc:psig_loc; + let pval_type = Jsx_common.extract_uncurried pval_type in check_string_int_attribute_iter.signature_item check_string_int_attribute_iter item; - let coreTypeOfAttr = Jsx_common.coreTypeOfAttrs pval_attributes in - let typVarsOfCoreType = - coreTypeOfAttr - |> Option.map Jsx_common.typVarsOfCoreType + 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 |> Option.value ~default:[] in - let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = + let rec get_prop_types types ({ptyp_loc; ptyp_desc} as full_type) = match ptyp_desc with | Ptyp_arrow ( name, ({ptyp_attributes = attrs} as type_), ({ptyp_desc = Ptyp_arrow _} as rest) ) - when isOptional name || isLabelled name -> - getPropTypes ((name, attrs, ptyp_loc, type_) :: types) rest + when is_optional name || is_labelled name -> + get_prop_types ((name, attrs, ptyp_loc, type_) :: types) rest | Ptyp_arrow (Nolabel, {ptyp_desc = Ptyp_constr ({txt = Lident "unit"}, _)}, rest) -> - 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) + 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) in - let innerType, propTypes = getPropTypes [] pval_type in - let namedTypeList = List.fold_left argToConcreteType [] propTypes in - let retPropsType = + 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 = Typ.constr (Location.mkloc (Lident "props") psig_loc) - (match coreTypeOfAttr with - | None -> makePropsTypeParams namedTypeList + (match core_type_of_attr with + | None -> make_props_type_params named_type_list | Some _ -> ( - match typVarsOfCoreType with + match typ_vars_of_core_type with | [] -> [] | _ -> [Typ.any ()])) in - let propsRecordType = - makePropsRecordTypeSig ~coreTypeOfAttr ~typVarsOfCoreType "props" - psig_loc namedTypeList + let props_record_type = + make_props_record_type_sig ~core_type_of_attr ~typ_vars_of_core_type "props" + psig_loc named_type_list in (* can't be an arrow because it will defensively uncurry *) - let newExternalType = + let new_external_type = Ptyp_constr - ( {loc = psig_loc; txt = moduleAccessName config "componentLike"}, - [retPropsType; innerType] ) + ( {loc = psig_loc; txt = module_access_name config "componentLike"}, + [ret_props_type; inner_type] ) in - let newStructure = + let new_structure = { psig with psig_desc = Psig_value { psig_desc with - pval_type = {pval_type with ptyp_desc = newExternalType}; - pval_attributes = List.filter otherAttrsPure pval_attributes; + pval_type = {pval_type with ptyp_desc = new_external_type}; + pval_attributes = List.filter other_attrs_pure pval_attributes; }; } in - [propsRecordType; newStructure] + [props_record_type; new_structure] | _ -> - Jsx_common.raiseError ~loc:psig_loc + Jsx_common.raise_error ~loc:psig_loc "Only one JSX component call can exist on a component at one time") | _ -> [item] -let transformJsxCall ~config mapper callExpression callArguments jsxExprLoc +let transform_jsx_call ~config mapper call_expression call_arguments jsx_expr_loc attrs = - match callExpression.pexp_desc with + match call_expression.pexp_desc with | Pexp_ident caller -> ( match caller with | {txt = Lident "createElement"; loc} -> - Jsx_common.raiseError ~loc + Jsx_common.raise_error ~loc "JSX: `createElement` should be preceeded by a module name." (* Foo.createElement(~prop1=foo, ~prop2=bar, ~children=[], ()) *) - | {loc; txt = Ldot (modulePath, ("createElement" | "make"))} -> - transformUppercaseCall3 ~config modulePath mapper jsxExprLoc loc attrs - callArguments + | {loc; txt = Ldot (module_path, ("createElement" | "make"))} -> + transform_uppercase_call3 ~config module_path mapper jsx_expr_loc loc attrs + call_arguments (* div(~prop1=foo, ~prop2=bar, ~children=[bla], ()) *) (* turn that into ReactDOM.createElement(~props=ReactDOM.props(~props1=foo, ~props2=bar, ()), [|bla|]) *) | {loc; txt = Lident id} -> - transformLowercaseCall3 ~config mapper jsxExprLoc loc attrs callArguments + transform_lowercase_call3 ~config mapper jsx_expr_loc loc attrs call_arguments id - | {txt = Ldot (_, anythingNotCreateElementOrMake); loc} -> - Jsx_common.raiseError ~loc + | {txt = Ldot (_, anything_not_create_element_or_make); loc} -> + Jsx_common.raise_error ~loc "JSX: the JSX attribute should be attached to a \ `YourModuleName.createElement` or `YourModuleName.make` call. We saw \ `%s` instead" - anythingNotCreateElementOrMake + anything_not_create_element_or_make | {txt = Lapply _; loc} -> (* don't think there's ever a case where this is reached *) - Jsx_common.raiseError ~loc + Jsx_common.raise_error ~loc "JSX: encountered a weird case while processing the code. Please \ report this!") | _ -> - Jsx_common.raiseError ~loc:callExpression.pexp_loc + Jsx_common.raise_error ~loc:call_expression.pexp_loc "JSX: `createElement` should be preceeded by a simple, direct module \ name." @@ -1360,21 +1360,21 @@ let expr ~config mapper expression = match expression with (* Does the function application have the @JSX attribute? *) | { - pexp_desc = Pexp_apply (callExpression, callArguments); + pexp_desc = Pexp_apply (call_expression, call_arguments); pexp_attributes; pexp_loc; } -> ( - let jsxAttribute, nonJSXAttributes = + let jsx_attribute, non_j_s_x_attributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - match (jsxAttribute, nonJSXAttributes) with + match (jsx_attribute, non_j_s_x_attributes) with (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression - | _, nonJSXAttributes -> - transformJsxCall ~config mapper callExpression callArguments pexp_loc - nonJSXAttributes) + | _, non_j_s_x_attributes -> + transform_jsx_call ~config mapper call_expression call_arguments pexp_loc + non_j_s_x_attributes) (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) | { pexp_desc = @@ -1382,73 +1382,73 @@ let expr ~config mapper expression = ({txt = Lident "::"; loc}, Some {pexp_desc = Pexp_tuple _}) | Pexp_construct ({txt = Lident "[]"; loc}, None) ); pexp_attributes; - } as listItems -> ( - let jsxAttribute, nonJSXAttributes = + } as list_items -> ( + let jsx_attribute, non_j_s_x_attributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - match (jsxAttribute, nonJSXAttributes) with + match (jsx_attribute, non_j_s_x_attributes) with (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression - | _, nonJSXAttributes -> + | _, non_j_s_x_attributes -> let loc = {loc with loc_ghost = true} in let fragment = match config.mode with | "automatic" -> - Exp.ident ~loc {loc; txt = moduleAccessName config "jsxFragment"} + Exp.ident ~loc {loc; txt = module_access_name config "jsxFragment"} | "classic" | _ -> Exp.ident ~loc {loc; txt = Ldot (Lident "React", "fragment")} in - let childrenExpr = transformChildrenIfList ~mapper listItems in - let recordOfChildren children = + let children_expr = transform_children_if_list ~mapper list_items in + let record_of_children children = Exp.record [(Location.mknoloc (Lident "children"), children)] None in - let applyJsxArray expr = + let apply_jsx_array expr = Exp.apply (Exp.ident - {txt = moduleAccessName config "array"; loc = Location.none}) + {txt = module_access_name config "array"; loc = Location.none}) [(Nolabel, expr)] in - let countOfChildren = function + let count_of_children = function | {pexp_desc = Pexp_array children} -> List.length children | _ -> 0 in - let transformChildrenToProps childrenExpr = - match childrenExpr with + let transform_children_to_props children_expr = + match children_expr with | {pexp_desc = Pexp_array children} -> ( match children with - | [] -> emptyRecord ~loc:Location.none - | [child] -> recordOfChildren child + | [] -> empty_record ~loc:Location.none + | [child] -> record_of_children child | _ -> ( match config.mode with - | "automatic" -> recordOfChildren @@ applyJsxArray childrenExpr - | "classic" | _ -> emptyRecord ~loc:Location.none)) + | "automatic" -> record_of_children @@ apply_jsx_array children_expr + | "classic" | _ -> empty_record ~loc:Location.none)) | _ -> ( match config.mode with - | "automatic" -> recordOfChildren @@ applyJsxArray childrenExpr - | "classic" | _ -> emptyRecord ~loc:Location.none) + | "automatic" -> record_of_children @@ apply_jsx_array children_expr + | "classic" | _ -> empty_record ~loc:Location.none) in let args = (nolabel, fragment) - :: (nolabel, transformChildrenToProps childrenExpr) + :: (nolabel, transform_children_to_props children_expr) :: (match config.mode with - | "classic" when countOfChildren childrenExpr > 1 -> - [(nolabel, childrenExpr)] + | "classic" when count_of_children children_expr > 1 -> + [(nolabel, children_expr)] | _ -> []) in Exp.apply ~loc (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs:nonJSXAttributes + ~attrs:non_j_s_x_attributes (* ReactDOM.createElement *) (match config.mode with | "automatic" -> - if countOfChildren childrenExpr > 1 then - Exp.ident ~loc {loc; txt = moduleAccessName config "jsxs"} - else Exp.ident ~loc {loc; txt = moduleAccessName config "jsx"} + 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"} | "classic" | _ -> - if countOfChildren childrenExpr > 1 then + if count_of_children children_expr > 1 then Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElementVariadic")} else @@ -1457,20 +1457,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.jsxConfig) mapper module_binding = - config.nestedModules <- module_binding.pmb_name.txt :: config.nestedModules; +let module_binding ~(config : Jsx_common.jsx_config) mapper module_binding = + config.nested_modules <- module_binding.pmb_name.txt :: config.nested_modules; let mapped = default_mapper.module_binding mapper module_binding in let () = - match config.nestedModules with - | _ :: rest -> config.nestedModules <- rest + match config.nested_modules with + | _ :: rest -> config.nested_modules <- rest | [] -> () in mapped (* TODO: some line number might still be wrong *) -let jsxMapper ~config = +let jsx_mapper ~config = let expr = expr ~config in let module_binding = module_binding ~config in - let transformStructureItem = transformStructureItem ~config in - let transformSignatureItem = transformSignatureItem ~config in - (expr, module_binding, transformSignatureItem, transformStructureItem) + 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) diff --git a/jscomp/syntax/src/reactjs_jsx_v3.ml b/jscomp/syntax/src/reactjs_jsx_v3.ml index fde4ac9d23..b2dc1aab44 100644 --- a/jscomp/syntax/src/reactjs_jsx_v3.ml +++ b/jscomp/syntax/src/reactjs_jsx_v3.ml @@ -10,48 +10,48 @@ let labelled str = Labelled str let optional str = Optional str -let isOptional str = +let is_optional str = match str with | Optional _ -> true | _ -> false -let isLabelled str = +let is_labelled str = match str with | Labelled _ -> true | _ -> false -let getLabel str = +let get_label str = match str with | Optional str | Labelled str -> str | Nolabel -> "" -let optionIdent = Lident "option" +let option_ident = Lident "option" -let constantString ~loc str = +let constant_string ~loc str = Ast_helper.Exp.constant ~loc (Pconst_string (str, None)) -let safeTypeFromValue valueStr = - let valueStr = getLabel valueStr in - if valueStr = "" || (valueStr.[0] [@doesNotRaise]) <> '_' then valueStr - else "T" ^ valueStr +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 keyType loc = - Typ.constr ~loc {loc; txt = optionIdent} +let key_type loc = + Typ.constr ~loc {loc; txt = option_ident} [Typ.constr ~loc {loc; txt = Lident "string"} []] type 'a children = ListLiteral of 'a | Exact of 'a -type componentConfig = {propsName: string} +type component_config = {props_name: string} (* if children is a list, convert it to an array while mapping each element. If not, just map over it, as usual *) -let transformChildrenIfListUpper ~loc ~mapper theList = - let rec transformChildren_ theList accum = +let transform_children_if_list_upper ~loc ~mapper the_list = + let rec transformChildren_ the_list 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 theList with + match the_list with | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> ( match accum with - | [singleElement] -> Exact singleElement + | [single_element] -> Exact single_element | accum -> ListLiteral (Exp.array ~loc (List.rev accum))) | { pexp_desc = @@ -59,15 +59,15 @@ let transformChildrenIfListUpper ~loc ~mapper theList = ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple [v; acc]}); } -> transformChildren_ acc (mapper.expr mapper v :: accum) - | notAList -> Exact (mapper.expr mapper notAList) + | not_a_list -> Exact (mapper.expr mapper not_a_list) in - transformChildren_ theList [] + transformChildren_ the_list [] -let transformChildrenIfList ~loc ~mapper theList = - let rec transformChildren_ theList accum = +let transform_children_if_list ~loc ~mapper the_list = + let rec transformChildren_ the_list 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 theList with + match the_list with | {pexp_desc = Pexp_construct ({txt = Lident "[]"}, None)} -> Exp.array ~loc (List.rev accum) | { @@ -76,91 +76,91 @@ let transformChildrenIfList ~loc ~mapper theList = ({txt = Lident "::"}, Some {pexp_desc = Pexp_tuple [v; acc]}); } -> transformChildren_ acc (mapper.expr mapper v :: accum) - | notAList -> mapper.expr mapper notAList + | not_a_list -> mapper.expr mapper not_a_list in - transformChildren_ theList [] + transformChildren_ the_list [] -let extractChildren ?(removeLastPositionUnit = false) ~loc propsAndChildren = +let extract_children ?(remove_last_position_unit = false) ~loc props_and_children = let rec allButLast_ lst acc = match lst with | [] -> [] | [(Nolabel, {pexp_desc = Pexp_construct ({txt = Lident "()"}, None)})] -> acc | (Nolabel, {pexp_loc}) :: _rest -> - Jsx_common.raiseError ~loc:pexp_loc + Jsx_common.raise_error ~loc:pexp_loc "JSX: found non-labelled argument before the last position" | arg :: rest -> allButLast_ rest (arg :: acc) in - let allButLast lst = allButLast_ lst [] |> List.rev in + let all_but_last lst = allButLast_ lst [] |> List.rev in match List.partition (fun (label, _) -> label = labelled "children") - propsAndChildren + props_and_children with | [], props -> (* no children provided? Place a placeholder list *) ( Exp.construct ~loc {loc; txt = Lident "[]"} None, - if removeLastPositionUnit then allButLast props else props ) - | [(_, childrenExpr)], props -> - (childrenExpr, if removeLastPositionUnit then allButLast props else props) + 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) | _ -> - Jsx_common.raiseError ~loc + Jsx_common.raise_error ~loc "JSX: somehow there's more than one `children` label" -let unerasableIgnore loc = +let unerasable_ignore loc = ( {loc; txt = "warning"}, PStr [Str.eval (Exp.constant (Pconst_string ("-16", None)))] ) -let merlinFocus = ({loc = Location.none; txt = "merlin.focus"}, PStr []) +let merlin_focus = ({loc = Location.none; txt = "merlin.focus"}, PStr []) (* Helper method to filter out any attribute that isn't [@react.component] *) -let otherAttrsPure (loc, _) = loc.txt <> "react.component" +let other_attrs_pure (loc, _) = loc.txt <> "react.component" (* Finds the name of the variable the binding is assigned to, otherwise raises Invalid_argument *) -let rec getFnName binding = +let rec get_fn_name binding = match binding with | {ppat_desc = Ppat_var {txt}} -> txt - | {ppat_desc = Ppat_constraint (pat, _)} -> getFnName pat + | {ppat_desc = Ppat_constraint (pat, _)} -> get_fn_name pat | {ppat_loc} -> - Jsx_common.raiseError ~loc:ppat_loc + Jsx_common.raise_error ~loc:ppat_loc "react.component calls cannot be destructured." -let makeNewBinding binding expression newName = +let make_new_binding binding expression new_name = 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 = newName}}; + {pvb_pat with ppat_desc = Ppat_var {ppat_var with txt = new_name}}; pvb_expr = expression; - pvb_attributes = [merlinFocus]; + pvb_attributes = [merlin_focus]; } | {pvb_loc} -> - Jsx_common.raiseError ~loc:pvb_loc + Jsx_common.raise_error ~loc:pvb_loc "react.component calls cannot be destructured." (* Lookup the value of `props` otherwise raise Invalid_argument error *) -let getPropsNameValue _acc (loc, exp) = +let get_props_name_value _acc (loc, exp) = match (loc, exp) with | {txt = Lident "props"}, {pexp_desc = Pexp_ident {txt = Lident str}} -> - {propsName = str} + {props_name = str} | {txt; loc}, _ -> - Jsx_common.raiseError ~loc + Jsx_common.raise_error ~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 getPropsAttr payload = - let defaultProps = {propsName = "Props"} in +let get_props_attr payload = + let default_props = {props_name = "Props"} in match payload with | Some (PStr ({ pstr_desc = - Pstr_eval ({pexp_desc = Pexp_record (recordFields, None)}, _); + Pstr_eval ({pexp_desc = Pexp_record (record_fields, None)}, _); } :: _rest)) -> - List.fold_left getPropsNameValue defaultProps recordFields + List.fold_left get_props_name_value default_props record_fields | Some (PStr ({ @@ -168,43 +168,43 @@ let getPropsAttr payload = Pstr_eval ({pexp_desc = Pexp_ident {txt = Lident "props"}}, _); } :: _rest)) -> - {propsName = "props"} + {props_name = "props"} | Some (PStr ({pstr_desc = Pstr_eval (_, _); pstr_loc} :: _rest)) -> - Jsx_common.raiseError ~loc:pstr_loc + Jsx_common.raise_error ~loc:pstr_loc "react.component accepts a record config with props as an options." - | _ -> defaultProps + | _ -> default_props (* Plucks the label, loc, and type_ from an AST node *) -let pluckLabelDefaultLocType (label, default, _, _, loc, type_) = +let pluck_label_default_loc_type (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 filenameFromLoc (pstr_loc : Location.t) = - let fileName = +let filename_from_loc (pstr_loc : Location.t) = + let file_name = match pstr_loc.loc_start.pos_fname with | "" -> !Location.input_name - | fileName -> fileName + | file_name -> file_name in - let fileName = - try Filename.chop_extension (Filename.basename fileName) - with Invalid_argument _ -> fileName + let file_name = + try Filename.chop_extension (Filename.basename file_name) + with Invalid_argument _ -> file_name in - let fileName = String.capitalize_ascii fileName in - fileName + let file_name = String.capitalize_ascii file_name in + file_name (* Build a string representation of a module name with segments separated by $ *) -let makeModuleName fileName nestedModules fnName = - let fullModuleName = - match (fileName, nestedModules, fnName) with +let make_module_name file_name nested_modules fn_name = + let full_module_name = + match (file_name, nested_modules, fn_name) with (* TODO: is this even reachable? It seems like the fileName always exists *) - | "", nestedModules, "make" -> nestedModules - | "", nestedModules, fnName -> List.rev (fnName :: nestedModules) - | fileName, nestedModules, "make" -> fileName :: List.rev nestedModules - | fileName, nestedModules, fnName -> - fileName :: List.rev (fnName :: nestedModules) + | "", 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) in - let fullModuleName = String.concat "$" fullModuleName in - fullModuleName + let full_module_name = String.concat "$" full_module_name in + full_module_name (* AST node builders @@ -213,16 +213,16 @@ let makeModuleName fileName nestedModules fnName = *) (* Build an AST node representing all named args for the `external` definition for a component's props *) -let rec recursivelyMakeNamedArgsForExternal list args = +let rec recursively_make_named_args_for_external list args = match list with - | (label, default, loc, interiorType) :: tl -> - recursivelyMakeNamedArgsForExternal tl + | (label, default, loc, interior_type) :: tl -> + recursively_make_named_args_for_external tl (Typ.arrow ~loc label - (match (label, interiorType, default) with + (match (label, interior_type, default) with (* ~foo=1 *) | label, None, Some _ -> { - ptyp_desc = Ptyp_var (safeTypeFromValue label); + ptyp_desc = Ptyp_var (safe_type_from_value label); ptyp_loc = loc; ptyp_attributes = []; } @@ -242,19 +242,19 @@ let rec recursivelyMakeNamedArgsForExternal list args = _ ) (* ~foo: int=? - note this isnt valid. but we want to get a type error *) | label, Some type_, _ - when isOptional label -> + when is_optional label -> type_ (* ~foo=? *) - | label, None, _ when isOptional label -> + | label, None, _ when is_optional label -> { - ptyp_desc = Ptyp_var (safeTypeFromValue label); + ptyp_desc = Ptyp_var (safe_type_from_value label); ptyp_loc = loc; ptyp_attributes = []; } (* ~foo *) | label, None, _ -> { - ptyp_desc = Ptyp_var (safeTypeFromValue label); + ptyp_desc = Ptyp_var (safe_type_from_value label); ptyp_loc = loc; ptyp_attributes = []; } @@ -263,60 +263,60 @@ let rec recursivelyMakeNamedArgsForExternal list args = | [] -> args (* Build an AST node for the [@obj] representing props for a component *) -let makePropsValue fnName loc namedArgListWithKeyAndRef propsType = - let propsName = fnName ^ "Props" in +let make_props_value fn_name loc named_arg_list_with_key_and_ref props_type = + let props_name = fn_name ^ "Props" in { - pval_name = {txt = propsName; loc}; + pval_name = {txt = props_name; loc}; pval_type = - recursivelyMakeNamedArgsForExternal namedArgListWithKeyAndRef + recursively_make_named_args_for_external named_arg_list_with_key_and_ref (Typ.arrow nolabel { ptyp_desc = Ptyp_constr ({txt = Lident "unit"; loc}, []); ptyp_loc = loc; ptyp_attributes = []; } - propsType); + props_type); pval_prim = [""]; pval_attributes = [({txt = "obj"; loc}, PStr [])]; pval_loc = loc; } (* Build an AST node representing an `external` with the definition of the [@obj] *) -let makePropsExternal fnName loc namedArgListWithKeyAndRef propsType = +let make_props_external fn_name loc named_arg_list_with_key_and_ref props_type = { pstr_loc = loc; pstr_desc = Pstr_primitive - (makePropsValue fnName loc namedArgListWithKeyAndRef propsType); + (make_props_value fn_name loc named_arg_list_with_key_and_ref props_type); } (* Build an AST node for the signature of the `external` definition *) -let makePropsExternalSig fnName loc namedArgListWithKeyAndRef propsType = +let make_props_external_sig fn_name loc named_arg_list_with_key_and_ref props_type = { psig_loc = loc; psig_desc = - Psig_value (makePropsValue fnName loc namedArgListWithKeyAndRef propsType); + Psig_value (make_props_value fn_name loc named_arg_list_with_key_and_ref props_type); } (* Build an AST node for the props name when converted to an object inside the function signature *) -let makePropsName ~loc name = +let make_props_name ~loc name = {ppat_desc = Ppat_var {txt = name; loc}; ppat_loc = loc; ppat_attributes = []} -let makeObjectField loc (str, attrs, type_) = +let make_object_field loc (str, attrs, type_) = Otag ({loc; txt = str}, attrs, type_) (* Build an AST node representing a "closed" object representing a component's props *) -let makePropsType ~loc namedTypeList = +let make_props_type ~loc named_type_list = Typ.mk ~loc - (Ptyp_object (List.map (makeObjectField loc) namedTypeList, Closed)) + (Ptyp_object (List.map (make_object_field loc) named_type_list, Closed)) (* Builds an AST node for the entire `external` definition of props *) -let makeExternalDecl fnName loc namedArgListWithKeyAndRef namedTypeList = - makePropsExternal fnName loc - (List.map pluckLabelDefaultLocType namedArgListWithKeyAndRef) - (makePropsType ~loc namedTypeList) +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 newtypeToVar newtype type_ = +let newtype_to_var newtype type_ = let var_desc = Ptyp_var ("type-" ^ newtype) in let typ (mapper : Ast_mapper.mapper) typ = match typ.ptyp_desc with @@ -328,55 +328,55 @@ let newtypeToVar newtype type_ = mapper.typ mapper type_ (* TODO: some line number might still be wrong *) -let jsxMapper ~config = - let transformUppercaseCall3 modulePath mapper loc attrs _ callArguments = - let children, argsWithLabels = - extractChildren ~loc ~removeLastPositionUnit:true callArguments +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 in - let argsForMake = argsWithLabels in - let childrenExpr = transformChildrenIfListUpper ~loc ~mapper children in - let recursivelyTransformedArgsForMake = - argsForMake + 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 |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression)) in - let childrenArg = ref None in + let children_arg = ref None in let args = - recursivelyTransformedArgsForMake - @ (match childrenExpr with + recursively_transformed_args_for_make + @ (match children_expr 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 *) - childrenArg := Some expression; + children_arg := Some expression; [ ( labelled "children", Exp.ident ~loc {loc; txt = Ldot (Lident "React", "null")} ); ]) @ [(nolabel, Exp.construct ~loc {loc; txt = Lident "()"} None)] in - let isCap str = String.capitalize_ascii str = str in + let is_cap str = String.capitalize_ascii str = str in let ident = - match modulePath with - | Lident _ -> Ldot (modulePath, "make") - | Ldot (_modulePath, value) as fullPath when isCap value -> - Ldot (fullPath, "make") - | modulePath -> modulePath + 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 in - let propsIdent = + let props_ident = match ident with | Lident path -> Lident (path ^ "Props") | Ldot (ident, path) -> Ldot (ident, path ^ "Props") | _ -> - Jsx_common.raiseError ~loc + Jsx_common.raise_error ~loc "JSX name can't be the result of function applications" in let props = - Exp.apply ~attrs ~loc (Exp.ident ~loc {loc; txt = propsIdent}) args + Exp.apply ~attrs ~loc (Exp.ident ~loc {loc; txt = props_ident}) args in (* handle key, ref, children *) (* React.createElement(Component.make, props, ...children) *) - match !childrenArg with + match !children_arg with | None -> Exp.apply ~loc ~attrs (Exp.ident ~loc {loc; txt = Ldot (Lident "React", "createElement")}) @@ -392,11 +392,11 @@ let jsxMapper ~config = ] in - 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 = + 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 = match children with (* [@JSX] div(~children=[a]), coming from
a
*) | { @@ -407,34 +407,34 @@ let jsxMapper ~config = "createDOMElementVariadic" (* [@JSX] div(~children= value), coming from
...(value)
*) | {pexp_loc} -> - Jsx_common.raiseError ~loc:pexp_loc + Jsx_common.raise_error ~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 nonChildrenProps with + match non_children_props with | [_justTheUnitArgumentAtEnd] -> [ (* "div" *) - (nolabel, componentNameExpr); + (nolabel, component_name_expr); (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr); + (nolabel, children_expr); ] - | nonEmptyProps -> - let propsCall = + | non_empty_props -> + let props_call = Exp.apply ~loc (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "domProps")}) - (nonEmptyProps + (non_empty_props |> List.map (fun (label, expression) -> (label, mapper.expr mapper expression))) in [ (* "div" *) - (nolabel, componentNameExpr); + (nolabel, component_name_expr); (* ReactDOMRe.props(~className=blabla, ~foo=bar, ()) *) - (labelled "props", propsCall); + (labelled "props", props_call); (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr); + (nolabel, children_expr); ] in Exp.apply @@ -442,30 +442,30 @@ let jsxMapper ~config = ~attrs (* ReactDOMRe.createElement *) (Exp.ident ~loc - {loc; txt = Ldot (Lident "ReactDOMRe", createElementCall)}) + {loc; txt = Ldot (Lident "ReactDOMRe", create_element_call)}) args in - let rec recursivelyTransformNamedArgsForMake expr args newtypes = + let rec recursively_transform_named_args_for_make 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.raiseError ~loc:expr.pexp_loc + Jsx_common.raise_error ~loc:expr.pexp_loc "Key cannot be accessed inside of a component. Don't worry - you can \ always key a component from its parent!" | Pexp_fun (Labelled "ref", _, _, _) | Pexp_fun (Optional "ref", _, _, _) -> - Jsx_common.raiseError ~loc:expr.pexp_loc + Jsx_common.raise_error ~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 isOptional arg || isLabelled arg -> + when is_optional arg || is_labelled arg -> let () = - match (isOptional arg, pattern, default) with + match (is_optional arg, pattern, default) with | true, {ppat_desc = Ppat_constraint (_, {ptyp_desc})}, None -> ( match ptyp_desc with | Ptyp_constr ({txt = Lident "option"}, [_]) -> () | _ -> - let currentType = + let current_type = match ptyp_desc with | Ptyp_constr ({txt}, []) -> String.concat "." (Longident.flatten txt) @@ -478,14 +478,14 @@ let jsxMapper ~config = (Printf.sprintf "React: optional argument annotations must have explicit \ `option`. Did you mean `option<%s>=?`?" - currentType))) + current_type))) | _ -> () in let alias = match pattern with | {ppat_desc = Ppat_alias (_, {txt}) | Ppat_var {txt}} -> txt | {ppat_desc = Ppat_any} -> "_" - | _ -> getLabel arg + | _ -> get_label arg in let type_ = match pattern with @@ -493,7 +493,7 @@ let jsxMapper ~config = | _ -> None in - recursivelyTransformNamedArgsForMake expression + recursively_transform_named_args_for_make expression ((arg, default, pattern, alias, pattern.ppat_loc, type_) :: args) newtypes | Pexp_fun @@ -516,44 +516,44 @@ let jsxMapper ~config = "React: react.component refs only support plain arguments and type \ annotations." | Pexp_newtype (label, expression) -> - recursivelyTransformNamedArgsForMake expression args (label :: newtypes) + recursively_transform_named_args_for_make expression args (label :: newtypes) | Pexp_constraint (expression, _typ) -> - recursivelyTransformNamedArgsForMake expression args newtypes + recursively_transform_named_args_for_make expression args newtypes | _ -> (args, newtypes, None) in - let argToType types (name, default, _noLabelName, _alias, loc, type_) = + let arg_to_type types (name, default, _noLabelName, _alias, loc, type_) = match (type_, name, default) with | Some {ptyp_desc = Ptyp_constr ({txt = Lident "option"}, [type_])}, name, _ - when isOptional name -> - ( getLabel name, + when is_optional name -> + ( get_label name, [], { type_ with ptyp_desc = - Ptyp_constr ({loc = type_.ptyp_loc; txt = optionIdent}, [type_]); + Ptyp_constr ({loc = type_.ptyp_loc; txt = option_ident}, [type_]); } ) :: types | Some type_, name, Some _default -> - ( getLabel name, + ( get_label name, [], { - ptyp_desc = Ptyp_constr ({loc; txt = optionIdent}, [type_]); + ptyp_desc = Ptyp_constr ({loc; txt = option_ident}, [type_]); ptyp_loc = loc; ptyp_attributes = []; } ) :: types - | Some type_, name, _ -> (getLabel name, [], type_) :: types - | None, name, _ when isOptional name -> - ( getLabel name, + | Some type_, name, _ -> (get_label name, [], type_) :: types + | None, name, _ when is_optional name -> + ( get_label name, [], { ptyp_desc = Ptyp_constr - ( {loc; txt = optionIdent}, + ( {loc; txt = option_ident}, [ { - ptyp_desc = Ptyp_var (safeTypeFromValue name); + ptyp_desc = Ptyp_var (safe_type_from_value name); ptyp_loc = loc; ptyp_attributes = []; }; @@ -562,11 +562,11 @@ let jsxMapper ~config = ptyp_attributes = []; } ) :: types - | None, name, _ when isLabelled name -> - ( getLabel name, + | None, name, _ when is_labelled name -> + ( get_label name, [], { - ptyp_desc = Ptyp_var (safeTypeFromValue name); + ptyp_desc = Ptyp_var (safe_type_from_value name); ptyp_loc = loc; ptyp_attributes = []; } ) @@ -574,145 +574,145 @@ let jsxMapper ~config = | _ -> types in - let argToConcreteType types (name, loc, type_) = + let arg_to_concrete_type types (name, loc, type_) = match name with - | name when isLabelled name -> (getLabel name, [], type_) :: types - | name when isOptional name -> - (getLabel name, [], Typ.constr ~loc {loc; txt = optionIdent} [type_]) + | 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_]) :: types | _ -> types in - let nestedModules = ref [] in - let transformStructureItem item = + let nested_modules = ref [] in + let transform_structure_item item = match item with (* external *) | { pstr_loc; pstr_desc = Pstr_primitive - ({pval_name = {txt = fnName}; pval_attributes; pval_type} as + ({pval_name = {txt = fn_name}; pval_attributes; pval_type} as value_description); } as pstr -> ( - match List.filter Jsx_common.hasAttr pval_attributes with + match List.filter Jsx_common.has_attr pval_attributes with | [] -> [item] | [_] -> - let pval_type = Jsx_common.extractUncurried pval_type in - let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = + let pval_type = Jsx_common.extract_uncurried pval_type in + let rec get_prop_types types ({ptyp_loc; ptyp_desc} as full_type) = match ptyp_desc with | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) - 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) + 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 innerType, propTypes = getPropTypes [] pval_type in - let namedTypeList = List.fold_left argToConcreteType [] propTypes in - let pluckLabelAndLoc (label, loc, type_) = + 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 pluck_label_and_loc (label, loc, type_) = (label, None (* default *), loc, Some type_) in - 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 + 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 in (* can't be an arrow because it will defensively uncurry *) - let newExternalType = + let new_external_type = Ptyp_constr ( {loc = pstr_loc; txt = Ldot (Lident "React", "componentLike")}, - [retPropsType; innerType] ) + [ret_props_type; inner_type] ) in - let newStructure = + let new_structure = { pstr with pstr_desc = Pstr_primitive { value_description with - pval_type = {pval_type with ptyp_desc = newExternalType}; - pval_attributes = List.filter otherAttrsPure pval_attributes; + pval_type = {pval_type with ptyp_desc = new_external_type}; + pval_attributes = List.filter other_attrs_pure pval_attributes; }; } in - [externalPropsDecl; newStructure] + [external_props_decl; new_structure] | _ -> - Jsx_common.raiseError ~loc:pstr_loc + Jsx_common.raise_error ~loc:pstr_loc "Only one react.component call can exist on a component at one time") (* let component = ... *) - | {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 + | {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 let binding = { binding with - pvb_pat = {binding.pvb_pat with ppat_loc = emptyLoc}; - pvb_loc = emptyLoc; + pvb_pat = {binding.pvb_pat with ppat_loc = empty_loc}; + pvb_loc = empty_loc; } in - let fnName = getFnName binding.pvb_pat in - let internalFnName = fnName ^ "$Internal" in - let fullModuleName = makeModuleName fileName !nestedModules fnName in - let modifiedBindingOld binding = + 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 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 spelunkForFunExpression expression = + let rec spelunk_for_fun_expression 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, returnExpression)} -> + | {pexp_desc = Pexp_let (_recursive, _vbs, return_expression)} -> (* here's where we spelunk! *) - spelunkForFunExpression returnExpression + spelunk_for_fun_expression return_expression (* let make = React.forwardRef((~prop) => ...) *) | { pexp_desc = Pexp_apply - (_wrapperExpression, [(Nolabel, innerFunctionExpression)]); + (_wrapperExpression, [(Nolabel, inner_function_expression)]); } -> - spelunkForFunExpression innerFunctionExpression + spelunk_for_fun_expression inner_function_expression | { pexp_desc = - Pexp_sequence (_wrapperExpression, innerFunctionExpression); + Pexp_sequence (_wrapperExpression, inner_function_expression); } -> - spelunkForFunExpression innerFunctionExpression - | {pexp_desc = Pexp_constraint (innerFunctionExpression, _typ)} -> - spelunkForFunExpression innerFunctionExpression + spelunk_for_fun_expression inner_function_expression + | {pexp_desc = Pexp_constraint (inner_function_expression, _typ)} -> + spelunk_for_fun_expression inner_function_expression | {pexp_loc} -> - Jsx_common.raiseError ~loc:pexp_loc + Jsx_common.raise_error ~loc:pexp_loc "react.component calls can only be on function definitions \ or component wrappers (forwardRef, memo)." in - spelunkForFunExpression expression + spelunk_for_fun_expression expression in - 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) + 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) in let expression = binding.pvb_expr in - let unerasableIgnoreExp exp = + let unerasable_ignore_exp exp = { exp with pexp_attributes = - unerasableIgnore emptyLoc :: exp.pexp_attributes; + unerasable_ignore empty_loc :: exp.pexp_attributes; } in (* TODO: there is a long-tail of unsupported features inside of blocks - Pexp_letmodule , Pexp_letexception , Pexp_ifthenelse *) - let rec spelunkForFunExpression expression = + let rec spelunk_for_fun_expression expression = match expression with (* let make = (~prop) => ... with no final unit *) | { @@ -721,14 +721,14 @@ let jsxMapper ~config = ( ((Labelled _ | Optional _) as label), default, pattern, - ({pexp_desc = Pexp_fun _} as internalExpression) ); + ({pexp_desc = Pexp_fun _} as internal_expression) ); } -> - let wrap, hasUnit, exp = - spelunkForFunExpression internalExpression + let wrap, has_unit, exp = + spelunk_for_fun_expression internal_expression in ( wrap, - hasUnit, - unerasableIgnoreExp + has_unit, + unerasable_ignore_exp { expression with pexp_desc = Pexp_fun (label, default, pattern, exp); @@ -756,14 +756,14 @@ let jsxMapper ~config = _pattern, _internalExpression ); } -> - ((fun a -> a), false, unerasableIgnoreExp expression) + ((fun a -> a), false, unerasable_ignore_exp expression) (* let make = (prop) => ... *) | { pexp_desc = Pexp_fun (_nolabel, _default, pattern, _internalExpression); } -> - if hasApplication.contents then - ((fun a -> a), false, unerasableIgnoreExp expression) + if has_application.contents then + ((fun a -> a), false, unerasable_ignore_exp expression) else Location.raise_errorf ~loc:pattern.ppat_loc "React: props need to be labelled arguments.\n\ @@ -772,357 +772,357 @@ let jsxMapper ~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, internalExpression)} -> + | {pexp_desc = Pexp_let (recursive, vbs, internal_expression)} -> (* here's where we spelunk! *) - let wrap, hasUnit, exp = - spelunkForFunExpression internalExpression + let wrap, has_unit, exp = + spelunk_for_fun_expression internal_expression in ( wrap, - hasUnit, + has_unit, {expression with pexp_desc = Pexp_let (recursive, vbs, exp)} ) (* let make = React.forwardRef((~prop) => ...) *) | { pexp_desc = - Pexp_apply (wrapperExpression, [(Nolabel, internalExpression)]); + Pexp_apply (wrapper_expression, [(Nolabel, internal_expression)]); } -> - let () = hasApplication := true in - let _, hasUnit, exp = - spelunkForFunExpression internalExpression + let () = has_application := true in + let _, has_unit, exp = + spelunk_for_fun_expression internal_expression in - ( (fun exp -> Exp.apply wrapperExpression [(nolabel, exp)]), - hasUnit, + ( (fun exp -> Exp.apply wrapper_expression [(nolabel, exp)]), + has_unit, exp ) | { - pexp_desc = Pexp_sequence (wrapperExpression, internalExpression); + pexp_desc = Pexp_sequence (wrapper_expression, internal_expression); } -> - let wrap, hasUnit, exp = - spelunkForFunExpression internalExpression + let wrap, has_unit, exp = + spelunk_for_fun_expression internal_expression in ( wrap, - hasUnit, + has_unit, { expression with - pexp_desc = Pexp_sequence (wrapperExpression, exp); + pexp_desc = Pexp_sequence (wrapper_expression, exp); } ) | e -> ((fun a -> a), false, e) in - let wrapExpression, hasUnit, expression = - spelunkForFunExpression expression + let wrap_expression, has_unit, expression = + spelunk_for_fun_expression expression in - (wrapExpressionWithBinding wrapExpression, hasUnit, expression) + (wrap_expression_with_binding wrap_expression, has_unit, expression) in - let bindingWrapper, hasUnit, expression = modifiedBinding binding in - let reactComponentAttribute = - try Some (List.find Jsx_common.hasAttr binding.pvb_attributes) + let binding_wrapper, has_unit, expression = modified_binding binding in + let react_component_attribute = + try Some (List.find Jsx_common.has_attr binding.pvb_attributes) with Not_found -> None in let _attr_loc, payload = - match reactComponentAttribute with + match react_component_attribute with | Some (loc, payload) -> (loc.loc, Some payload) - | None -> (emptyLoc, None) + | None -> (empty_loc, None) in - let props = getPropsAttr payload in + let props = get_props_attr payload in (* do stuff here! *) - let namedArgList, newtypes, forwardRef = - recursivelyTransformNamedArgsForMake - (modifiedBindingOld binding) + let named_arg_list, newtypes, forward_ref = + recursively_transform_named_args_for_make + (modified_binding_old binding) [] [] in - let namedArgListWithKeyAndRef = + let named_arg_list_with_key_and_ref = ( optional "key", None, - Pat.var {txt = "key"; loc = emptyLoc}, + Pat.var {txt = "key"; loc = empty_loc}, "key", - emptyLoc, - Some (keyType emptyLoc) ) - :: namedArgList + empty_loc, + Some (key_type empty_loc) ) + :: named_arg_list in - let namedArgListWithKeyAndRef = - match forwardRef with + let named_arg_list_with_key_and_ref = + match forward_ref with | Some _ -> ( optional "ref", None, - Pat.var {txt = "key"; loc = emptyLoc}, + Pat.var {txt = "key"; loc = empty_loc}, "ref", - emptyLoc, + empty_loc, None ) - :: namedArgListWithKeyAndRef - | None -> namedArgListWithKeyAndRef + :: named_arg_list_with_key_and_ref + | None -> named_arg_list_with_key_and_ref in - let namedArgListWithKeyAndRefForNew = - match forwardRef with + let named_arg_list_with_key_and_ref_for_new = + match forward_ref with | Some txt -> - namedArgList + named_arg_list @ [ ( nolabel, None, - Pat.var {txt; loc = emptyLoc}, + Pat.var {txt; loc = empty_loc}, txt, - emptyLoc, + empty_loc, None ); ] - | None -> namedArgList + | None -> named_arg_list in - let pluckArg (label, _, _, alias, loc, _) = - let labelString = + let pluck_arg (label, _, _, alias, loc, _) = + let label_string = match label with - | label when isOptional label || isLabelled label -> - getLabel label + | label when is_optional label || is_labelled label -> + get_label label | _ -> "" in ( label, - match labelString with + match label_string with | "" -> Exp.ident ~loc {txt = Lident alias; loc} - | labelString -> + | label_string -> Exp.apply ~loc (Exp.ident ~loc {txt = Lident "##"; loc}) [ - (nolabel, Exp.ident ~loc {txt = Lident props.propsName; loc}); - (nolabel, Exp.ident ~loc {txt = Lident labelString; loc}); + (nolabel, Exp.ident ~loc {txt = Lident props.props_name; loc}); + (nolabel, Exp.ident ~loc {txt = Lident label_string; loc}); ] ) in - let namedTypeList = List.fold_left argToType [] namedArgList in - let loc = emptyLoc in - let externalArgs = + let named_type_list = List.fold_left arg_to_type [] named_arg_list in + let loc = empty_loc in + let external_args = (* translate newtypes to type variables *) List.fold_left (fun args newtype -> List.map - (fun (a, b, c, d, e, maybeTyp) -> - match maybeTyp with + (fun (a, b, c, d, e, maybe_typ) -> + match maybe_typ with | Some typ -> - (a, b, c, d, e, Some (newtypeToVar newtype.txt typ)) + (a, b, c, d, e, Some (newtype_to_var newtype.txt typ)) | None -> (a, b, c, d, e, None)) args) - namedArgListWithKeyAndRef newtypes + named_arg_list_with_key_and_ref newtypes in - let externalTypes = + let external_types = (* translate newtypes to type variables *) List.fold_left (fun args newtype -> List.map - (fun (a, b, typ) -> (a, b, newtypeToVar newtype.txt typ)) + (fun (a, b, typ) -> (a, b, newtype_to_var newtype.txt typ)) args) - namedTypeList newtypes + named_type_list newtypes in - let externalDecl = - makeExternalDecl fnName loc externalArgs externalTypes + let external_decl = + make_external_decl fn_name loc external_args external_types in - let innerExpressionArgs = - List.map pluckArg namedArgListWithKeyAndRefForNew + let inner_expression_args = + List.map pluck_arg named_arg_list_with_key_and_ref_for_new @ - if hasUnit then + if has_unit then [(Nolabel, Exp.construct {loc; txt = Lident "()"} None)] else [] in - let innerExpression = + let inner_expression = Exp.apply (Exp.ident { loc; txt = Lident - (match recFlag with - | Recursive -> internalFnName - | Nonrecursive -> fnName); + (match rec_flag with + | Recursive -> internal_fn_name + | Nonrecursive -> fn_name); }) - innerExpressionArgs + inner_expression_args in - let innerExpressionWithRef = - match forwardRef with + let inner_expression_with_ref = + match forward_ref with | Some txt -> { - innerExpression with + inner_expression with pexp_desc = Pexp_fun ( nolabel, None, { - ppat_desc = Ppat_var {txt; loc = emptyLoc}; - ppat_loc = emptyLoc; + ppat_desc = Ppat_var {txt; loc = empty_loc}; + ppat_loc = empty_loc; ppat_attributes = []; }, - innerExpression ); + inner_expression ); } - | None -> innerExpression + | None -> inner_expression in - let fullExpression = + let full_expression = Exp.fun_ nolabel None { ppat_desc = Ppat_constraint - ( makePropsName ~loc:emptyLoc props.propsName, - makePropsType ~loc:emptyLoc externalTypes ); - ppat_loc = emptyLoc; + ( make_props_name ~loc:empty_loc props.props_name, + make_props_type ~loc:empty_loc external_types ); + ppat_loc = empty_loc; ppat_attributes = []; } - innerExpressionWithRef + inner_expression_with_ref in - let fullExpression = + let full_expression = if !Config.uncurried = Uncurried then - fullExpression - |> Ast_uncurried.uncurriedFun ~loc:fullExpression.pexp_loc + full_expression + |> Ast_uncurried.uncurried_fun ~loc:full_expression.pexp_loc ~arity:1 - else fullExpression + else full_expression in - let fullExpression = - match fullModuleName with - | "" -> fullExpression + let full_expression = + match full_module_name with + | "" -> full_expression | txt -> Exp.let_ Nonrecursive [ - Vb.mk ~loc:emptyLoc - (Pat.var ~loc:emptyLoc {loc = emptyLoc; txt}) - fullExpression; + Vb.mk ~loc:empty_loc + (Pat.var ~loc:empty_loc {loc = empty_loc; txt}) + full_expression; ] - (Exp.ident ~loc:emptyLoc {loc = emptyLoc; txt = Lident txt}) + (Exp.ident ~loc:empty_loc {loc = empty_loc; txt = Lident txt}) in - let bindings, newBinding = - match recFlag with + let bindings, new_binding = + match rec_flag with | Recursive -> ( [ - bindingWrapper - (Exp.let_ ~loc:emptyLoc Recursive + binding_wrapper + (Exp.let_ ~loc:empty_loc Recursive [ - makeNewBinding binding expression internalFnName; + make_new_binding binding expression internal_fn_name; Vb.mk - (Pat.var {loc = emptyLoc; txt = fnName}) - fullExpression; + (Pat.var {loc = empty_loc; txt = fn_name}) + full_expression; ] - (Exp.ident {loc = emptyLoc; txt = Lident fnName})); + (Exp.ident {loc = empty_loc; txt = Lident fn_name})); ], None ) | Nonrecursive -> ( [{binding with pvb_expr = expression}], - Some (bindingWrapper fullExpression) ) + Some (binding_wrapper full_expression) ) in - (Some externalDecl, bindings, newBinding) + (Some external_decl, bindings, new_binding) else (None, [binding], None) in - let structuresAndBinding = List.map mapBinding valueBindings in - let otherStructures (extern, binding, newBinding) - (externs, bindings, newBindings) = + let structures_and_binding = List.map map_binding value_bindings in + let other_structures (extern, binding, new_binding) + (externs, bindings, new_bindings) = let externs = match extern with | Some extern -> extern :: externs | None -> externs in - let newBindings = - match newBinding with - | Some newBinding -> newBinding :: newBindings - | None -> newBindings + let new_bindings = + match new_binding with + | Some new_binding -> new_binding :: new_bindings + | None -> new_bindings in - (externs, binding @ bindings, newBindings) + (externs, binding @ bindings, new_bindings) in - let externs, bindings, newBindings = - List.fold_right otherStructures structuresAndBinding ([], [], []) + let externs, bindings, new_bindings = + List.fold_right other_structures structures_and_binding ([], [], []) in externs - @ [{pstr_loc; pstr_desc = Pstr_value (recFlag, bindings)}] + @ [{pstr_loc; pstr_desc = Pstr_value (rec_flag, bindings)}] @ - match newBindings with + match new_bindings with | [] -> [] - | newBindings -> - [{pstr_loc = emptyLoc; pstr_desc = Pstr_value (recFlag, newBindings)}]) + | new_bindings -> + [{pstr_loc = empty_loc; pstr_desc = Pstr_value (rec_flag, new_bindings)}]) | _ -> [item] in - let transformSignatureItem item = + let transform_signature_item item = match item with | { psig_loc; psig_desc = Psig_value - ({pval_name = {txt = fnName}; pval_attributes; pval_type} as + ({pval_name = {txt = fn_name}; pval_attributes; pval_type} as psig_desc); } as psig -> ( - match List.filter Jsx_common.hasAttr pval_attributes with + match List.filter Jsx_common.has_attr pval_attributes with | [] -> [item] | [_] -> - let pval_type = Jsx_common.extractUncurried pval_type in - let rec getPropTypes types ({ptyp_loc; ptyp_desc} as fullType) = + let pval_type = Jsx_common.extract_uncurried pval_type in + let rec get_prop_types types ({ptyp_loc; ptyp_desc} as full_type) = match ptyp_desc with | Ptyp_arrow (name, type_, ({ptyp_desc = Ptyp_arrow _} as rest)) - 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) + 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 innerType, propTypes = getPropTypes [] pval_type in - let namedTypeList = List.fold_left argToConcreteType [] propTypes in - let pluckLabelAndLoc (label, loc, type_) = + 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 pluck_label_and_loc (label, loc, type_) = (label, None, loc, Some type_) in - 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 + 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 in (* can't be an arrow because it will defensively uncurry *) - let newExternalType = + let new_external_type = Ptyp_constr ( {loc = psig_loc; txt = Ldot (Lident "React", "componentLike")}, - [retPropsType; innerType] ) + [ret_props_type; inner_type] ) in - let newStructure = + let new_structure = { psig with psig_desc = Psig_value { psig_desc with - pval_type = {pval_type with ptyp_desc = newExternalType}; - pval_attributes = List.filter otherAttrsPure pval_attributes; + pval_type = {pval_type with ptyp_desc = new_external_type}; + pval_attributes = List.filter other_attrs_pure pval_attributes; }; } in - [externalPropsDecl; newStructure] + [external_props_decl; new_structure] | _ -> - Jsx_common.raiseError ~loc:psig_loc + Jsx_common.raise_error ~loc:psig_loc "Only one react.component call can exist on a component at one time") | _ -> [item] in - let transformJsxCall mapper callExpression callArguments attrs = - match callExpression.pexp_desc with + let transform_jsx_call mapper call_expression call_arguments attrs = + match call_expression.pexp_desc with | Pexp_ident caller -> ( match caller with | {txt = Lident "createElement"; loc} -> - Jsx_common.raiseError ~loc + Jsx_common.raise_error ~loc "JSX: `createElement` should be preceeded by a module name." (* Foo.createElement(~prop1=foo, ~prop2=bar, ~children=[], ()) *) - | {loc; txt = Ldot (modulePath, ("createElement" | "make"))} -> ( + | {loc; txt = Ldot (module_path, ("createElement" | "make"))} -> ( match config.Jsx_common.version with | 3 -> - transformUppercaseCall3 modulePath mapper loc attrs callExpression - callArguments - | _ -> Jsx_common.raiseError ~loc "JSX: the JSX version must be 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") (* 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 -> 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 + | 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 "JSX: the JSX attribute should be attached to a \ `YourModuleName.createElement` or `YourModuleName.make` call. We \ saw `%s` instead" - anythingNotCreateElementOrMake + anything_not_create_element_or_make | {txt = Lapply _; loc} -> (* don't think there's ever a case where this is reached *) - Jsx_common.raiseError ~loc + Jsx_common.raise_error ~loc "JSX: encountered a weird case while processing the code. Please \ report this!") | _ -> - Jsx_common.raiseError ~loc:callExpression.pexp_loc + Jsx_common.raise_error ~loc:call_expression.pexp_loc "JSX: `createElement` should be preceeded by a simple, direct module \ name." in @@ -1130,18 +1130,18 @@ let jsxMapper ~config = let expr mapper expression = match expression with (* Does the function application have the @JSX attribute? *) - | {pexp_desc = Pexp_apply (callExpression, callArguments); pexp_attributes} + | {pexp_desc = Pexp_apply (call_expression, call_arguments); pexp_attributes} -> ( - let jsxAttribute, nonJSXAttributes = + let jsx_attribute, non_j_s_x_attributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - match (jsxAttribute, nonJSXAttributes) with + match (jsx_attribute, non_j_s_x_attributes) with (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression - | _, nonJSXAttributes -> - transformJsxCall mapper callExpression callArguments nonJSXAttributes) + | _, non_j_s_x_attributes -> + transform_jsx_call mapper call_expression call_arguments non_j_s_x_attributes) (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) | { pexp_desc = @@ -1149,32 +1149,32 @@ let jsxMapper ~config = ({txt = Lident "::"; loc}, Some {pexp_desc = Pexp_tuple _}) | Pexp_construct ({txt = Lident "[]"; loc}, None) ); pexp_attributes; - } as listItems -> ( - let jsxAttribute, nonJSXAttributes = + } as list_items -> ( + let jsx_attribute, non_j_s_x_attributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - match (jsxAttribute, nonJSXAttributes) with + match (jsx_attribute, non_j_s_x_attributes) with (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression - | _, nonJSXAttributes -> + | _, non_j_s_x_attributes -> let loc = {loc with loc_ghost = true} in let fragment = Exp.ident ~loc {loc; txt = Ldot (Lident "ReasonReact", "fragment")} in - let childrenExpr = transformChildrenIfList ~loc ~mapper listItems in + let children_expr = transform_children_if_list ~loc ~mapper list_items in let args = [ (* "div" *) (nolabel, fragment); (* [|moreCreateElementCallsHere|] *) - (nolabel, childrenExpr); + (nolabel, children_expr); ] in Exp.apply ~loc (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs:nonJSXAttributes + ~attrs:non_j_s_x_attributes (* ReactDOMRe.createElement *) (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "createElement")}) @@ -1184,13 +1184,13 @@ let jsxMapper ~config = in let module_binding mapper module_binding = - let _ = nestedModules := module_binding.pmb_name.txt :: !nestedModules in + let _ = nested_modules := module_binding.pmb_name.txt :: !nested_modules in let mapped = default_mapper.module_binding mapper module_binding in let () = - match !nestedModules with - | _ :: rest -> nestedModules := rest + match !nested_modules with + | _ :: rest -> nested_modules := rest | [] -> () in mapped in - (expr, module_binding, transformSignatureItem, transformStructureItem) + (expr, module_binding, transform_signature_item, transform_structure_item) diff --git a/jscomp/syntax/src/res_ast_conversion.ml b/jscomp/syntax/src/res_ast_conversion.ml index b274bcaf51..e8207d6fc8 100644 --- a/jscomp/syntax/src/res_ast_conversion.ml +++ b/jscomp/syntax/src/res_ast_conversion.ml @@ -1,4 +1,4 @@ -let concatLongidents l1 l2 = +let concat_longidents l1 l2 = let parts1 = Longident.flatten l1 in let parts2 = Longident.flatten l2 in match List.concat [parts1; parts2] |> Longident.unflatten with @@ -6,78 +6,78 @@ let concatLongidents l1 l2 = | None -> l2 (* TODO: support nested open's ? *) -let rec rewritePpatOpen longidentOpen pat = +let rec rewrite_ppat_open longident_open 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 (rewritePpatOpen longidentOpen first :: rest); + ppat_desc = Ppat_array (rewrite_ppat_open longident_open first :: rest); } | Ppat_tuple (first :: rest) -> (* Color.(Red, Blue, Green) -> (Color.Red, Blue, Green) *) { pat with - ppat_desc = Ppat_tuple (rewritePpatOpen longidentOpen first :: rest); + ppat_desc = Ppat_tuple (rewrite_ppat_open longident_open first :: rest); } | Ppat_construct - ( ({txt = Longident.Lident "::"} as listConstructor), + ( ({txt = Longident.Lident "::"} as list_constructor), 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 - ( listConstructor, + ( list_constructor, Some { element with ppat_desc = - Ppat_tuple (rewritePpatOpen longidentOpen pat :: rest); + Ppat_tuple (rewrite_ppat_open longident_open pat :: rest); } ); } - | Ppat_construct (({txt = constructor} as longidentLoc), optPattern) -> + | Ppat_construct (({txt = constructor} as longident_loc), opt_pattern) -> (* Foo.(Bar(a)) -> Foo.Bar(a) *) { pat with ppat_desc = Ppat_construct - ( {longidentLoc with txt = concatLongidents longidentOpen constructor}, - optPattern ); + ( {longident_loc with txt = concat_longidents longident_open constructor}, + opt_pattern ); } - | Ppat_record ((({txt = lbl} as longidentLoc), firstPat) :: rest, flag) -> + | Ppat_record ((({txt = lbl} as longident_loc), first_pat) :: rest, flag) -> (* Foo.{x} -> {Foo.x: x} *) - let firstRow = - ({longidentLoc with txt = concatLongidents longidentOpen lbl}, firstPat) + let first_row = + ({longident_loc with txt = concat_longidents longident_open lbl}, first_pat) in - {pat with ppat_desc = Ppat_record (firstRow :: rest, flag)} + {pat with ppat_desc = Ppat_record (first_row :: rest, flag)} | Ppat_or (pat1, pat2) -> { pat with ppat_desc = Ppat_or - ( rewritePpatOpen longidentOpen pat1, - rewritePpatOpen longidentOpen pat2 ); + ( rewrite_ppat_open longident_open pat1, + rewrite_ppat_open longident_open pat2 ); } | Ppat_constraint (pattern, typ) -> { pat with - ppat_desc = Ppat_constraint (rewritePpatOpen longidentOpen pattern, typ); + ppat_desc = Ppat_constraint (rewrite_ppat_open longident_open pattern, typ); } - | Ppat_type ({txt = constructor} as longidentLoc) -> + | Ppat_type ({txt = constructor} as longident_loc) -> { pat with ppat_desc = Ppat_type - {longidentLoc with txt = concatLongidents longidentOpen constructor}; + {longident_loc with txt = concat_longidents longident_open constructor}; } | Ppat_lazy p -> - {pat with ppat_desc = Ppat_lazy (rewritePpatOpen longidentOpen p)} + {pat with ppat_desc = Ppat_lazy (rewrite_ppat_open longident_open p)} | Ppat_exception p -> - {pat with ppat_desc = Ppat_exception (rewritePpatOpen longidentOpen p)} + {pat with ppat_desc = Ppat_exception (rewrite_ppat_open longident_open p)} | _ -> pat -let escapeTemplateLiteral s = +let escape_template_literal s = let len = String.length s in let b = Buffer.create len in let i = ref 0 in @@ -111,7 +111,7 @@ let escapeTemplateLiteral s = done; Buffer.contents b -let escapeStringContents s = +let escape_string_contents s = let len = String.length s in let b = Buffer.create len in @@ -137,64 +137,64 @@ let escapeStringContents s = done; Buffer.contents b -let looksLikeRecursiveTypeDeclaration typeDeclaration = +let looks_like_recursive_type_declaration type_declaration = let open Parsetree in - let name = typeDeclaration.ptype_name.txt in - let rec checkKind kind = + let name = type_declaration.ptype_name.txt in + let rec check_kind kind = match kind with | Ptype_abstract | Ptype_open -> false - | Ptype_variant constructorDeclarations -> - List.exists checkConstructorDeclaration constructorDeclarations - | Ptype_record labelDeclarations -> - List.exists checkLabelDeclaration labelDeclarations - and checkConstructorDeclaration constrDecl = - checkConstructorArguments constrDecl.pcd_args + | 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 || - match constrDecl.pcd_res with - | Some typexpr -> checkTypExpr typexpr + match constr_decl.pcd_res with + | Some typexpr -> check_typ_expr typexpr | None -> false - 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 = + 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 = match typ.ptyp_desc with | Ptyp_any -> false | Ptyp_var _ -> false - | Ptyp_object (fields, _) -> List.exists checkObjectField fields + | Ptyp_object (fields, _) -> List.exists check_object_field fields | Ptyp_class _ -> false | Ptyp_package _ -> false | Ptyp_extension _ -> false - | Ptyp_arrow (_lbl, typ1, typ2) -> checkTypExpr typ1 || checkTypExpr typ2 - | Ptyp_tuple types -> List.exists checkTypExpr types + | Ptyp_arrow (_lbl, typ1, typ2) -> check_typ_expr typ1 || check_typ_expr typ2 + | Ptyp_tuple types -> List.exists check_typ_expr types | Ptyp_constr ({txt = longident}, types) -> (match longident with | Lident ident -> ident = name | _ -> false) - || List.exists checkTypExpr types - | Ptyp_alias (typ, _) -> checkTypExpr typ - | Ptyp_variant (rowFields, _, _) -> List.exists checkRowFields rowFields - | Ptyp_poly (_, typ) -> checkTypExpr typ - and checkObjectField field = + || 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 = match field with - | 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 = + | 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 = match manifest with - | Some typ -> checkTypExpr typ + | Some typ -> check_typ_expr typ | None -> false in - checkKind typeDeclaration.ptype_kind - || checkManifest typeDeclaration.ptype_manifest + check_kind type_declaration.ptype_kind + || check_manifest type_declaration.ptype_manifest -let filterReasonRawLiteral attrs = +let filter_reason_raw_literal attrs = List.filter (fun attr -> match attr with @@ -202,12 +202,12 @@ let filterReasonRawLiteral attrs = | _ -> true) attrs -let stringLiteralMapper stringData = - let isSameLocation l1 l2 = +let string_literal_mapper string_data = + let is_same_location l1 l2 = let open Location in l1.loc_start.pos_cnum == l2.loc_start.pos_cnum in - let remainingStringData = stringData in + let remaining_string_data = string_data in let open Ast_mapper in { default_mapper with @@ -217,12 +217,12 @@ let stringLiteralMapper stringData = | Pexp_constant (Pconst_string (_txt, None)) -> ( match List.find_opt - (fun (_stringData, stringLoc) -> - isSameLocation stringLoc expr.pexp_loc) - remainingStringData + (fun (_stringData, string_loc) -> + is_same_location string_loc expr.pexp_loc) + remaining_string_data with - | Some (stringData, _) -> - let stringData = + | Some (string_data, _) -> + let string_data = let attr = List.find_opt (fun attr -> @@ -248,19 +248,19 @@ let stringLiteralMapper stringData = ] ) -> raw | _ -> - (String.sub [@doesNotRaise]) stringData 1 - (String.length stringData - 2) + (String.sub [@doesNotRaise]) string_data 1 + (String.length string_data - 2) in { expr with - pexp_attributes = filterReasonRawLiteral expr.pexp_attributes; - pexp_desc = Pexp_constant (Pconst_string (stringData, None)); + pexp_attributes = filter_reason_raw_literal expr.pexp_attributes; + pexp_desc = Pexp_constant (Pconst_string (string_data, None)); } | None -> default_mapper.expr mapper expr) | _ -> default_mapper.expr mapper expr); } -let hasUncurriedAttribute attrs = +let has_uncurried_attribute attrs = List.exists (fun attr -> match attr with @@ -268,7 +268,7 @@ let hasUncurriedAttribute attrs = | _ -> false) attrs -let templateLiteralAttr = (Location.mknoloc "res.template", Parsetree.PStr []) +let template_literal_attr = (Location.mknoloc "res.template", Parsetree.PStr []) let normalize = let open Ast_mapper in @@ -291,21 +291,21 @@ let normalize = pat = (fun mapper p -> match p.ppat_desc with - | Ppat_open ({txt = longidentOpen}, pattern) -> - let p = rewritePpatOpen longidentOpen pattern in + | Ppat_open ({txt = longident_open}, pattern) -> + let p = rewrite_ppat_open longident_open pattern in default_mapper.pat mapper p | Ppat_constant (Pconst_string (txt, tag)) -> - let newTag = + let new_tag = 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 (escapeTemplateLiteral txt, newTag) in + let s = Parsetree.Pconst_string (escape_template_literal txt, new_tag) in { p with ppat_attributes = - templateLiteralAttr :: mapper.attributes mapper p.ppat_attributes; + template_literal_attr :: mapper.attributes mapper p.ppat_attributes; ppat_desc = Ppat_constant s; } | _ -> default_mapper.pat mapper p); @@ -322,46 +322,46 @@ let normalize = (fun mapper expr -> match expr.pexp_desc with | Pexp_constant (Pconst_string (txt, None)) -> - let raw = escapeStringContents txt in + let raw = escape_string_contents txt in let s = Parsetree.Pconst_string (raw, None) in {expr with pexp_desc = Pexp_constant s} | Pexp_constant (Pconst_string (txt, tag)) -> - let newTag = + let new_tag = 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 (escapeTemplateLiteral txt, newTag) in + let s = Parsetree.Pconst_string (escape_template_literal txt, new_tag) in { expr with pexp_attributes = - templateLiteralAttr + template_literal_attr :: mapper.attributes mapper expr.pexp_attributes; pexp_desc = Pexp_constant s; } | Pexp_apply - ( callExpr, + ( call_expr, [ ( Nolabel, ({ pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None); pexp_attributes = []; - } as unitExpr) ); + } as unit_expr) ); ] ) - when hasUncurriedAttribute expr.pexp_attributes -> + when has_uncurried_attribute expr.pexp_attributes -> { expr with pexp_attributes = mapper.attributes mapper expr.pexp_attributes; pexp_desc = Pexp_apply - ( callExpr, + ( call_expr, [ ( Nolabel, { - unitExpr with - pexp_loc = {unitExpr.pexp_loc with loc_ghost = true}; + unit_expr with + pexp_loc = {unit_expr.pexp_loc with loc_ghost = true}; } ); ] ); } @@ -426,10 +426,10 @@ let normalize = pexp_desc = ( Pexp_constant (Pconst_string (txt, None)) | Pexp_ident {txt = Longident.Lident txt} ); - pexp_loc = labelLoc; + pexp_loc = label_loc; } ); ] ) -> - let label = Location.mkloc txt labelLoc in + let label = Location.mkloc txt label_loc in { pexp_loc = expr.pexp_loc; pexp_attributes = expr.pexp_attributes; @@ -444,7 +444,7 @@ let normalize = ppat_desc = Ppat_construct ({txt = Longident.Lident "true"}, None); }; - pc_rhs = thenExpr; + pc_rhs = then_expr; }; { pc_lhs = @@ -452,10 +452,10 @@ let normalize = ppat_desc = Ppat_construct ({txt = Longident.Lident "false"}, None); }; - pc_rhs = elseExpr; + pc_rhs = else_expr; }; ] ) -> - let ternaryMarker = + let ternary_marker = (Location.mknoloc "res.ternary", Parsetree.PStr []) in { @@ -463,57 +463,57 @@ let normalize = pexp_desc = Pexp_ifthenelse ( mapper.expr mapper condition, - mapper.expr mapper thenExpr, - Some (mapper.expr mapper elseExpr) ); - pexp_attributes = ternaryMarker :: expr.pexp_attributes; + mapper.expr mapper then_expr, + Some (mapper.expr mapper else_expr) ); + pexp_attributes = ternary_marker :: expr.pexp_attributes; } | _ -> default_mapper.expr mapper expr); structure_item = - (fun mapper structureItem -> - match structureItem.pstr_desc with + (fun mapper structure_item -> + match structure_item.pstr_desc with (* heuristic: if we have multiple type declarations, mark them recursive *) - | Pstr_type ((Recursive as recFlag), typeDeclarations) -> + | Pstr_type ((Recursive as rec_flag), type_declarations) -> let flag = - match typeDeclarations with + match type_declarations with | [td] -> - if looksLikeRecursiveTypeDeclaration td then Asttypes.Recursive + if looks_like_recursive_type_declaration td then Asttypes.Recursive else Asttypes.Nonrecursive - | _ -> recFlag + | _ -> rec_flag in { - structureItem with + structure_item with pstr_desc = Pstr_type ( flag, List.map - (fun typeDeclaration -> - default_mapper.type_declaration mapper typeDeclaration) - typeDeclarations ); + (fun type_declaration -> + default_mapper.type_declaration mapper type_declaration) + type_declarations ); } - | _ -> default_mapper.structure_item mapper structureItem); + | _ -> default_mapper.structure_item mapper structure_item); signature_item = - (fun mapper signatureItem -> - match signatureItem.psig_desc with + (fun mapper signature_item -> + match signature_item.psig_desc with (* heuristic: if we have multiple type declarations, mark them recursive *) - | Psig_type ((Recursive as recFlag), typeDeclarations) -> + | Psig_type ((Recursive as rec_flag), type_declarations) -> let flag = - match typeDeclarations with + match type_declarations with | [td] -> - if looksLikeRecursiveTypeDeclaration td then Asttypes.Recursive + if looks_like_recursive_type_declaration td then Asttypes.Recursive else Asttypes.Nonrecursive - | _ -> recFlag + | _ -> rec_flag in { - signatureItem with + signature_item with psig_desc = Psig_type ( flag, List.map - (fun typeDeclaration -> - default_mapper.type_declaration mapper typeDeclaration) - typeDeclarations ); + (fun type_declaration -> + default_mapper.type_declaration mapper type_declaration) + type_declarations ); } - | _ -> default_mapper.signature_item mapper signatureItem); + | _ -> default_mapper.signature_item mapper signature_item); value_binding = (fun mapper vb -> match vb with @@ -527,7 +527,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 newPattern = + let new_pattern = { Parsetree.ppat_loc = {pat.ppat_loc with loc_end = typ.ptyp_loc.loc_end}; @@ -537,7 +537,7 @@ let normalize = in { vb with - pvb_pat = newPattern; + pvb_pat = new_pattern; pvb_expr = expr; pvb_attributes = default_mapper.attributes mapper vb.pvb_attributes; } @@ -552,7 +552,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 newPattern = + let new_pattern = { Parsetree.ppat_loc = {pat.ppat_loc with loc_end = typ.ptyp_loc.loc_end}; @@ -562,7 +562,7 @@ let normalize = in { vb with - pvb_pat = newPattern; + pvb_pat = new_pattern; pvb_expr = expr; pvb_attributes = default_mapper.attributes mapper vb.pvb_attributes; } @@ -572,10 +572,10 @@ let normalize = let structure s = normalize.Ast_mapper.structure normalize s let signature s = normalize.Ast_mapper.signature normalize s -let replaceStringLiteralStructure stringData structure = - let mapper = stringLiteralMapper stringData in +let replace_string_literal_structure string_data structure = + let mapper = string_literal_mapper string_data in mapper.Ast_mapper.structure mapper structure -let replaceStringLiteralSignature stringData signature = - let mapper = stringLiteralMapper stringData in +let replace_string_literal_signature string_data signature = + let mapper = string_literal_mapper string_data in mapper.Ast_mapper.signature mapper signature diff --git a/jscomp/syntax/src/res_ast_conversion.mli b/jscomp/syntax/src/res_ast_conversion.mli index 32163e8ce4..745b7cc84a 100644 --- a/jscomp/syntax/src/res_ast_conversion.mli +++ b/jscomp/syntax/src/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 replaceStringLiteralStructure : +val replace_string_literal_structure : (string * Location.t) list -> Parsetree.structure -> Parsetree.structure -val replaceStringLiteralSignature : +val replace_string_literal_signature : (string * Location.t) list -> Parsetree.signature -> Parsetree.signature (* transform parts of the parsetree into a suitable parsetree suitable diff --git a/jscomp/syntax/src/res_ast_debugger.ml b/jscomp/syntax/src/res_ast_debugger.ml index c78a3e7d6e..2c9b1bca10 100644 --- a/jscomp/syntax/src/res_ast_debugger.ml +++ b/jscomp/syntax/src/res_ast_debugger.ml @@ -1,13 +1,13 @@ module Doc = Res_doc module CommentTable = Res_comments_table -let printEngine = +let print_engine = Res_driver. { - printImplementation = + print_implementation = (fun ~width:_ ~filename:_ ~comments:_ structure -> Printast.implementation Format.std_formatter structure); - printInterface = + print_interface = (fun ~width:_ ~filename:_ ~comments:_ signature -> Printast.interface Format.std_formatter signature); } @@ -17,39 +17,39 @@ module Sexp : sig val atom : string -> t val list : t list -> t - val toString : t -> string + val to_string : 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 toDoc t = + let rec to_doc t = match t with | Atom s -> Doc.text s | List [] -> Doc.text "()" - | List [sexpr] -> Doc.concat [Doc.lparen; toDoc sexpr; Doc.rparen] + | List [sexpr] -> Doc.concat [Doc.lparen; to_doc sexpr; Doc.rparen] | List (hd :: tail) -> Doc.group (Doc.concat [ Doc.lparen; - toDoc hd; + to_doc hd; Doc.indent (Doc.concat - [Doc.line; Doc.join ~sep:Doc.line (List.map toDoc tail)]); + [Doc.line; Doc.join ~sep:Doc.line (List.map to_doc tail)]); Doc.rparen; ]) - let toString sexpr = - let doc = toDoc sexpr in - Doc.toString ~width:80 doc + let to_string sexpr = + let doc = to_doc sexpr in + Doc.to_string ~width:80 doc end module SexpAst = struct open Parsetree - let mapEmpty ~f items = + let map_empty ~f items = match items with | [] -> [Sexp.list []] | items -> List.map f items @@ -59,7 +59,7 @@ module SexpAst = struct let char c = Sexp.atom ("'" ^ Char.escaped c ^ "'") - let optChar oc = + let opt_char oc = match oc with | None -> Sexp.atom "None" | Some c -> Sexp.list [Sexp.atom "Some"; char c] @@ -75,32 +75,32 @@ module SexpAst = struct in Sexp.list [Sexp.atom "longident"; loop l] - let closedFlag flag = + let closed_flag flag = match flag with | Asttypes.Closed -> Sexp.atom "Closed" | Open -> Sexp.atom "Open" - let directionFlag flag = + let direction_flag flag = match flag with | Asttypes.Upto -> Sexp.atom "Upto" | Downto -> Sexp.atom "Downto" - let recFlag flag = + let rec_flag flag = match flag with | Asttypes.Recursive -> Sexp.atom "Recursive" | Nonrecursive -> Sexp.atom "Nonrecursive" - let overrideFlag flag = + let override_flag flag = match flag with | Asttypes.Override -> Sexp.atom "Override" | Fresh -> Sexp.atom "Fresh" - let privateFlag flag = + let private_flag flag = match flag with | Asttypes.Public -> Sexp.atom "Public" | Private -> Sexp.atom "Private" - let mutableFlag flag = + let mutable_flag flag = match flag with | Asttypes.Immutable -> Sexp.atom "Immutable" | Mutable -> Sexp.atom "Mutable" @@ -111,7 +111,7 @@ module SexpAst = struct | Contravariant -> Sexp.atom "Contravariant" | Invariant -> Sexp.atom "Invariant" - let argLabel lbl = + let arg_label lbl = match lbl with | Asttypes.Nolabel -> Sexp.atom "Nolabel" | Labelled txt -> Sexp.list [Sexp.atom "Labelled"; string txt] @@ -121,7 +121,7 @@ module SexpAst = struct let sexpr = match c with | Pconst_integer (txt, tag) -> - Sexp.list [Sexp.atom "Pconst_integer"; string txt; optChar tag] + Sexp.list [Sexp.atom "Pconst_integer"; string txt; opt_char tag] | Pconst_char _ -> Sexp.list [Sexp.atom "Pconst_char"] | Pconst_string (_, Some "INTERNAL_RES_CHAR_CONTENTS") -> Sexp.list [Sexp.atom "Pconst_char"] @@ -135,14 +135,14 @@ module SexpAst = struct | None -> Sexp.atom "None"); ] | Pconst_float (txt, tag) -> - Sexp.list [Sexp.atom "Pconst_float"; string txt; optChar tag] + Sexp.list [Sexp.atom "Pconst_float"; string txt; opt_char tag] in Sexp.list [Sexp.atom "constant"; sexpr] let rec structure s = - Sexp.list (Sexp.atom "structure" :: List.map structureItem s) + Sexp.list (Sexp.atom "structure" :: List.map structure_item s) - and structureItem si = + and structure_item si = let desc = match si.pstr_desc with | Pstr_eval (expr, attrs) -> @@ -151,36 +151,36 @@ module SexpAst = struct Sexp.list [ Sexp.atom "Pstr_value"; - recFlag flag; - Sexp.list (mapEmpty ~f:valueBinding vbs); + rec_flag flag; + Sexp.list (map_empty ~f:value_binding vbs); ] | Pstr_primitive vd -> - Sexp.list [Sexp.atom "Pstr_primitive"; valueDescription vd] + Sexp.list [Sexp.atom "Pstr_primitive"; value_description vd] | Pstr_type (flag, tds) -> Sexp.list [ Sexp.atom "Pstr_type"; - recFlag flag; - Sexp.list (mapEmpty ~f:typeDeclaration tds); + rec_flag flag; + Sexp.list (map_empty ~f:type_declaration tds); ] | Pstr_typext typext -> - Sexp.list [Sexp.atom "Pstr_type"; typeExtension typext] + Sexp.list [Sexp.atom "Pstr_type"; type_extension typext] | Pstr_exception ec -> - Sexp.list [Sexp.atom "Pstr_exception"; extensionConstructor ec] - | Pstr_module mb -> Sexp.list [Sexp.atom "Pstr_module"; moduleBinding mb] + Sexp.list [Sexp.atom "Pstr_exception"; extension_constructor ec] + | Pstr_module mb -> Sexp.list [Sexp.atom "Pstr_module"; module_binding mb] | Pstr_recmodule mbs -> Sexp.list [ - Sexp.atom "Pstr_recmodule"; Sexp.list (mapEmpty ~f:moduleBinding mbs); + Sexp.atom "Pstr_recmodule"; Sexp.list (map_empty ~f:module_binding mbs); ] - | Pstr_modtype modTypDecl -> - Sexp.list [Sexp.atom "Pstr_modtype"; moduleTypeDeclaration modTypDecl] - | Pstr_open openDesc -> - Sexp.list [Sexp.atom "Pstr_open"; openDescription openDesc] + | 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_class _ -> Sexp.atom "Pstr_class" | Pstr_class_type _ -> Sexp.atom "Pstr_class_type" | Pstr_include id -> - Sexp.list [Sexp.atom "Pstr_include"; includeDeclaration id] + Sexp.list [Sexp.atom "Pstr_include"; include_declaration id] | Pstr_attribute attr -> Sexp.list [Sexp.atom "Pstr_attribute"; attribute attr] | Pstr_extension (ext, attrs) -> @@ -188,15 +188,15 @@ module SexpAst = struct in Sexp.list [Sexp.atom "structure_item"; desc] - and includeDeclaration id = + and include_declaration id = Sexp.list [ Sexp.atom "include_declaration"; - moduleExpression id.pincl_mod; + module_expression id.pincl_mod; attributes id.pincl_attributes; ] - and openDescription od = + and open_description od = Sexp.list [ Sexp.atom "open_description"; @@ -204,55 +204,55 @@ module SexpAst = struct attributes od.popen_attributes; ] - and moduleTypeDeclaration mtd = + and module_type_declaration mtd = Sexp.list [ Sexp.atom "module_type_declaration"; string mtd.pmtd_name.Asttypes.txt; (match mtd.pmtd_type with | None -> Sexp.atom "None" - | Some modType -> Sexp.list [Sexp.atom "Some"; moduleType modType]); + | Some mod_type -> Sexp.list [Sexp.atom "Some"; module_type mod_type]); attributes mtd.pmtd_attributes; ] - and moduleBinding mb = + and module_binding mb = Sexp.list [ Sexp.atom "module_binding"; string mb.pmb_name.Asttypes.txt; - moduleExpression mb.pmb_expr; + module_expression mb.pmb_expr; attributes mb.pmb_attributes; ] - and moduleExpression me = + and module_expression me = let desc = match me.pmod_desc with - | Pmod_ident modName -> - Sexp.list [Sexp.atom "Pmod_ident"; longident modName.Asttypes.txt] + | Pmod_ident mod_name -> + Sexp.list [Sexp.atom "Pmod_ident"; longident mod_name.Asttypes.txt] | Pmod_structure s -> Sexp.list [Sexp.atom "Pmod_structure"; structure s] - | Pmod_functor (lbl, optModType, modExpr) -> + | Pmod_functor (lbl, opt_mod_type, mod_expr) -> Sexp.list [ Sexp.atom "Pmod_functor"; string lbl.Asttypes.txt; - (match optModType with + (match opt_mod_type with | None -> Sexp.atom "None" - | Some modType -> Sexp.list [Sexp.atom "Some"; moduleType modType]); - moduleExpression modExpr; + | Some mod_type -> Sexp.list [Sexp.atom "Some"; module_type mod_type]); + module_expression mod_expr; ] - | Pmod_apply (callModExpr, modExprArg) -> + | Pmod_apply (call_mod_expr, mod_expr_arg) -> Sexp.list [ Sexp.atom "Pmod_apply"; - moduleExpression callModExpr; - moduleExpression modExprArg; + module_expression call_mod_expr; + module_expression mod_expr_arg; ] - | Pmod_constraint (modExpr, modType) -> + | Pmod_constraint (mod_expr, mod_type) -> Sexp.list [ Sexp.atom "Pmod_constraint"; - moduleExpression modExpr; - moduleType modType; + module_expression mod_expr; + module_type mod_type; ] | Pmod_unpack expr -> Sexp.list [Sexp.atom "Pmod_unpack"; expression expr] | Pmod_extension ext -> @@ -260,46 +260,46 @@ module SexpAst = struct in Sexp.list [Sexp.atom "module_expr"; desc; attributes me.pmod_attributes] - and moduleType mt = + and module_type mt = let desc = match mt.pmty_desc with - | Pmty_ident longidentLoc -> - Sexp.list [Sexp.atom "Pmty_ident"; longident longidentLoc.Asttypes.txt] + | Pmty_ident longident_loc -> + Sexp.list [Sexp.atom "Pmty_ident"; longident longident_loc.Asttypes.txt] | Pmty_signature s -> Sexp.list [Sexp.atom "Pmty_signature"; signature s] - | Pmty_functor (lbl, optModType, modType) -> + | Pmty_functor (lbl, opt_mod_type, mod_type) -> Sexp.list [ Sexp.atom "Pmty_functor"; string lbl.Asttypes.txt; - (match optModType with + (match opt_mod_type with | None -> Sexp.atom "None" - | Some modType -> Sexp.list [Sexp.atom "Some"; moduleType modType]); - moduleType modType; + | Some mod_type -> Sexp.list [Sexp.atom "Some"; module_type mod_type]); + module_type mod_type; ] - | Pmty_alias longidentLoc -> - Sexp.list [Sexp.atom "Pmty_alias"; longident longidentLoc.Asttypes.txt] + | Pmty_alias longident_loc -> + Sexp.list [Sexp.atom "Pmty_alias"; longident longident_loc.Asttypes.txt] | Pmty_extension ext -> Sexp.list [Sexp.atom "Pmty_extension"; extension ext] - | Pmty_typeof modExpr -> - Sexp.list [Sexp.atom "Pmty_typeof"; moduleExpression modExpr] - | Pmty_with (modType, withConstraints) -> + | Pmty_typeof mod_expr -> + Sexp.list [Sexp.atom "Pmty_typeof"; module_expression mod_expr] + | Pmty_with (mod_type, with_constraints) -> Sexp.list [ Sexp.atom "Pmty_with"; - moduleType modType; - Sexp.list (mapEmpty ~f:withConstraint withConstraints); + module_type mod_type; + Sexp.list (map_empty ~f:with_constraint with_constraints); ] in Sexp.list [Sexp.atom "module_type"; desc; attributes mt.pmty_attributes] - and withConstraint wc = + and with_constraint wc = match wc with - | Pwith_type (longidentLoc, td) -> + | Pwith_type (longident_loc, td) -> Sexp.list [ Sexp.atom "Pmty_with"; - longident longidentLoc.Asttypes.txt; - typeDeclaration td; + longident longident_loc.Asttypes.txt; + type_declaration td; ] | Pwith_module (l1, l2) -> Sexp.list @@ -308,12 +308,12 @@ module SexpAst = struct longident l1.Asttypes.txt; longident l2.Asttypes.txt; ] - | Pwith_typesubst (longidentLoc, td) -> + | Pwith_typesubst (longident_loc, td) -> Sexp.list [ Sexp.atom "Pwith_typesubst"; - longident longidentLoc.Asttypes.txt; - typeDeclaration td; + longident longident_loc.Asttypes.txt; + type_declaration td; ] | Pwith_modsubst (l1, l2) -> Sexp.list @@ -323,37 +323,37 @@ module SexpAst = struct longident l2.Asttypes.txt; ] - and signature s = Sexp.list (Sexp.atom "signature" :: List.map signatureItem s) + and signature s = Sexp.list (Sexp.atom "signature" :: List.map signature_item s) - and signatureItem si = + and signature_item si = let descr = match si.psig_desc with - | Psig_value vd -> Sexp.list [Sexp.atom "Psig_value"; valueDescription vd] - | Psig_type (flag, typeDeclarations) -> + | Psig_value vd -> Sexp.list [Sexp.atom "Psig_value"; value_description vd] + | Psig_type (flag, type_declarations) -> Sexp.list [ Sexp.atom "Psig_type"; - recFlag flag; - Sexp.list (mapEmpty ~f:typeDeclaration typeDeclarations); + rec_flag flag; + Sexp.list (map_empty ~f:type_declaration type_declarations); ] - | 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 -> + | 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 -> Sexp.list [ Sexp.atom "Psig_recmodule"; - 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] + 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] | Psig_class _ -> Sexp.list [Sexp.atom "Psig_class"] | Psig_class_type _ -> Sexp.list [Sexp.atom "Psig_class_type"] | Psig_attribute attr -> @@ -363,24 +363,24 @@ module SexpAst = struct in Sexp.list [Sexp.atom "signature_item"; descr] - and includeDescription id = + and include_description id = Sexp.list [ Sexp.atom "include_description"; - moduleType id.pincl_mod; + module_type id.pincl_mod; attributes id.pincl_attributes; ] - and moduleDeclaration md = + and module_declaration md = Sexp.list [ Sexp.atom "module_declaration"; string md.pmd_name.Asttypes.txt; - moduleType md.pmd_type; + module_type md.pmd_type; attributes md.pmd_attributes; ] - and valueBinding vb = + and value_binding vb = Sexp.list [ Sexp.atom "value_binding"; @@ -389,17 +389,17 @@ module SexpAst = struct attributes vb.pvb_attributes; ] - and valueDescription vd = + and value_description vd = Sexp.list [ Sexp.atom "value_description"; string vd.pval_name.Asttypes.txt; - coreType vd.pval_type; - Sexp.list (mapEmpty ~f:string vd.pval_prim); + core_type vd.pval_type; + Sexp.list (map_empty ~f:string vd.pval_prim); attributes vd.pval_attributes; ] - and typeDeclaration td = + and type_declaration td = Sexp.list [ Sexp.atom "type_declaration"; @@ -408,56 +408,56 @@ module SexpAst = struct [ Sexp.atom "ptype_params"; Sexp.list - (mapEmpty + (map_empty ~f:(fun (typexpr, var) -> - Sexp.list [coreType typexpr; variance var]) + Sexp.list [core_type typexpr; variance var]) td.ptype_params); ]; Sexp.list [ Sexp.atom "ptype_cstrs"; Sexp.list - (mapEmpty + (map_empty ~f:(fun (typ1, typ2, _loc) -> - Sexp.list [coreType typ1; coreType typ2]) + Sexp.list [core_type typ1; core_type typ2]) td.ptype_cstrs); ]; - Sexp.list [Sexp.atom "ptype_kind"; typeKind td.ptype_kind]; + Sexp.list [Sexp.atom "ptype_kind"; type_kind 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"; coreType typ]); + | Some typ -> Sexp.list [Sexp.atom "Some"; core_type typ]); ]; - Sexp.list [Sexp.atom "ptype_private"; privateFlag td.ptype_private]; + Sexp.list [Sexp.atom "ptype_private"; private_flag td.ptype_private]; attributes td.ptype_attributes; ] - and extensionConstructor ec = + and extension_constructor ec = Sexp.list [ Sexp.atom "extension_constructor"; string ec.pext_name.Asttypes.txt; - extensionConstructorKind ec.pext_kind; + extension_constructor_kind ec.pext_kind; attributes ec.pext_attributes; ] - and extensionConstructorKind kind = + and extension_constructor_kind kind = match kind with - | Pext_decl (args, optTypExpr) -> + | Pext_decl (args, opt_typ_expr) -> Sexp.list [ Sexp.atom "Pext_decl"; - constructorArguments args; - (match optTypExpr with + constructor_arguments args; + (match opt_typ_expr with | None -> Sexp.atom "None" - | Some typ -> Sexp.list [Sexp.atom "Some"; coreType typ]); + | Some typ -> Sexp.list [Sexp.atom "Some"; core_type typ]); ] - | Pext_rebind longidentLoc -> - Sexp.list [Sexp.atom "Pext_rebind"; longident longidentLoc.Asttypes.txt] + | Pext_rebind longident_loc -> + Sexp.list [Sexp.atom "Pext_rebind"; longident longident_loc.Asttypes.txt] - and typeExtension te = + and type_extension te = Sexp.list [ Sexp.atom "type_extension"; @@ -467,95 +467,95 @@ module SexpAst = struct [ Sexp.atom "ptyext_parms"; Sexp.list - (mapEmpty + (map_empty ~f:(fun (typexpr, var) -> - Sexp.list [coreType typexpr; variance var]) + Sexp.list [core_type typexpr; variance var]) te.ptyext_params); ]; Sexp.list [ Sexp.atom "ptyext_constructors"; - Sexp.list (mapEmpty ~f:extensionConstructor te.ptyext_constructors); + Sexp.list (map_empty ~f:extension_constructor te.ptyext_constructors); ]; - Sexp.list [Sexp.atom "ptyext_private"; privateFlag te.ptyext_private]; + Sexp.list [Sexp.atom "ptyext_private"; private_flag te.ptyext_private]; attributes te.ptyext_attributes; ] - and typeKind kind = + and type_kind kind = match kind with | Ptype_abstract -> Sexp.atom "Ptype_abstract" - | Ptype_variant constrDecls -> + | Ptype_variant constr_decls -> Sexp.list [ Sexp.atom "Ptype_variant"; - Sexp.list (mapEmpty ~f:constructorDeclaration constrDecls); + Sexp.list (map_empty ~f:constructor_declaration constr_decls); ] - | Ptype_record lblDecls -> + | Ptype_record lbl_decls -> Sexp.list [ Sexp.atom "Ptype_record"; - Sexp.list (mapEmpty ~f:labelDeclaration lblDecls); + Sexp.list (map_empty ~f:label_declaration lbl_decls); ] | Ptype_open -> Sexp.atom "Ptype_open" - and constructorDeclaration cd = + and constructor_declaration cd = Sexp.list [ Sexp.atom "constructor_declaration"; string cd.pcd_name.Asttypes.txt; - Sexp.list [Sexp.atom "pcd_args"; constructorArguments cd.pcd_args]; + Sexp.list [Sexp.atom "pcd_args"; constructor_arguments 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"; coreType typ]); + | Some typ -> Sexp.list [Sexp.atom "Some"; core_type typ]); ]; attributes cd.pcd_attributes; ] - and constructorArguments args = + and constructor_arguments args = match args with | Pcstr_tuple types -> Sexp.list - [Sexp.atom "Pcstr_tuple"; Sexp.list (mapEmpty ~f:coreType types)] + [Sexp.atom "Pcstr_tuple"; Sexp.list (map_empty ~f:core_type types)] | Pcstr_record lds -> Sexp.list - [Sexp.atom "Pcstr_record"; Sexp.list (mapEmpty ~f:labelDeclaration lds)] + [Sexp.atom "Pcstr_record"; Sexp.list (map_empty ~f:label_declaration lds)] - and labelDeclaration ld = + and label_declaration ld = Sexp.list [ Sexp.atom "label_declaration"; string ld.pld_name.Asttypes.txt; - mutableFlag ld.pld_mutable; - coreType ld.pld_type; + mutable_flag ld.pld_mutable; + core_type ld.pld_type; attributes ld.pld_attributes; ] and expression expr = let desc = match expr.pexp_desc with - | Pexp_ident longidentLoc -> - Sexp.list [Sexp.atom "Pexp_ident"; longident longidentLoc.Asttypes.txt] + | Pexp_ident longident_loc -> + Sexp.list [Sexp.atom "Pexp_ident"; longident longident_loc.Asttypes.txt] | Pexp_constant c -> Sexp.list [Sexp.atom "Pexp_constant"; constant c] | Pexp_let (flag, vbs, expr) -> Sexp.list [ Sexp.atom "Pexp_let"; - recFlag flag; - Sexp.list (mapEmpty ~f:valueBinding vbs); + rec_flag flag; + Sexp.list (map_empty ~f:value_binding vbs); expression expr; ] | Pexp_function cases -> Sexp.list - [Sexp.atom "Pexp_function"; Sexp.list (mapEmpty ~f:case cases)] - | Pexp_fun (argLbl, exprOpt, pat, expr) -> + [Sexp.atom "Pexp_function"; Sexp.list (map_empty ~f:case cases)] + | Pexp_fun (arg_lbl, expr_opt, pat, expr) -> Sexp.list [ Sexp.atom "Pexp_fun"; - argLabel argLbl; - (match exprOpt with + arg_label arg_lbl; + (match expr_opt with | None -> Sexp.atom "None" | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]); pattern pat; @@ -567,9 +567,9 @@ module SexpAst = struct Sexp.atom "Pexp_apply"; expression expr; Sexp.list - (mapEmpty - ~f:(fun (argLbl, expr) -> - Sexp.list [argLabel argLbl; expression expr]) + (map_empty + ~f:(fun (arg_lbl, expr) -> + Sexp.list [arg_label arg_lbl; expression expr]) args); ] | Pexp_match (expr, cases) -> @@ -577,75 +577,75 @@ module SexpAst = struct [ Sexp.atom "Pexp_match"; expression expr; - Sexp.list (mapEmpty ~f:case cases); + Sexp.list (map_empty ~f:case cases); ] | Pexp_try (expr, cases) -> Sexp.list [ Sexp.atom "Pexp_try"; expression expr; - Sexp.list (mapEmpty ~f:case cases); + Sexp.list (map_empty ~f:case cases); ] | Pexp_tuple exprs -> Sexp.list - [Sexp.atom "Pexp_tuple"; Sexp.list (mapEmpty ~f:expression exprs)] - | Pexp_construct (longidentLoc, exprOpt) -> + [Sexp.atom "Pexp_tuple"; Sexp.list (map_empty ~f:expression exprs)] + | Pexp_construct (longident_loc, expr_opt) -> Sexp.list [ Sexp.atom "Pexp_construct"; - longident longidentLoc.Asttypes.txt; - (match exprOpt with + longident longident_loc.Asttypes.txt; + (match expr_opt with | None -> Sexp.atom "None" | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]); ] - | Pexp_variant (lbl, exprOpt) -> + | Pexp_variant (lbl, expr_opt) -> Sexp.list [ Sexp.atom "Pexp_variant"; string lbl; - (match exprOpt with + (match expr_opt with | None -> Sexp.atom "None" | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]); ] - | Pexp_record (rows, optExpr) -> + | Pexp_record (rows, opt_expr) -> Sexp.list [ Sexp.atom "Pexp_record"; Sexp.list - (mapEmpty - ~f:(fun (longidentLoc, expr) -> + (map_empty + ~f:(fun (longident_loc, expr) -> Sexp.list - [longident longidentLoc.Asttypes.txt; expression expr]) + [longident longident_loc.Asttypes.txt; expression expr]) rows); - (match optExpr with + (match opt_expr with | None -> Sexp.atom "None" | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]); ] - | Pexp_field (expr, longidentLoc) -> + | Pexp_field (expr, longident_loc) -> Sexp.list [ Sexp.atom "Pexp_field"; expression expr; - longident longidentLoc.Asttypes.txt; + longident longident_loc.Asttypes.txt; ] - | Pexp_setfield (expr1, longidentLoc, expr2) -> + | Pexp_setfield (expr1, longident_loc, expr2) -> Sexp.list [ Sexp.atom "Pexp_setfield"; expression expr1; - longident longidentLoc.Asttypes.txt; + longident longident_loc.Asttypes.txt; expression expr2; ] | Pexp_array exprs -> Sexp.list - [Sexp.atom "Pexp_array"; Sexp.list (mapEmpty ~f:expression exprs)] - | Pexp_ifthenelse (expr1, expr2, optExpr) -> + [Sexp.atom "Pexp_array"; Sexp.list (map_empty ~f:expression exprs)] + | Pexp_ifthenelse (expr1, expr2, opt_expr) -> Sexp.list [ Sexp.atom "Pexp_ifthenelse"; expression expr1; expression expr2; - (match optExpr with + (match opt_expr with | None -> Sexp.atom "None" | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr]); ] @@ -661,39 +661,39 @@ module SexpAst = struct pattern pat; expression e1; expression e2; - directionFlag flag; + direction_flag flag; expression e3; ] | Pexp_constraint (expr, typexpr) -> Sexp.list - [Sexp.atom "Pexp_constraint"; expression expr; coreType typexpr] - | Pexp_coerce (expr, optTyp, typexpr) -> + [Sexp.atom "Pexp_constraint"; expression expr; core_type typexpr] + | Pexp_coerce (expr, opt_typ, typexpr) -> Sexp.list [ Sexp.atom "Pexp_coerce"; expression expr; - (match optTyp with + (match opt_typ with | None -> Sexp.atom "None" - | Some typ -> Sexp.list [Sexp.atom "Some"; coreType typ]); - coreType typexpr; + | Some typ -> Sexp.list [Sexp.atom "Some"; core_type typ]); + core_type 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 (modName, modExpr, expr) -> + | Pexp_letmodule (mod_name, mod_expr, expr) -> Sexp.list [ Sexp.atom "Pexp_letmodule"; - string modName.Asttypes.txt; - moduleExpression modExpr; + string mod_name.Asttypes.txt; + module_expression mod_expr; expression expr; ] - | Pexp_letexception (extConstr, expr) -> + | Pexp_letexception (ext_constr, expr) -> Sexp.list [ Sexp.atom "Pexp_letexception"; - extensionConstructor extConstr; + extension_constructor ext_constr; expression expr; ] | Pexp_assert expr -> Sexp.list [Sexp.atom "Pexp_assert"; expression expr] @@ -703,14 +703,14 @@ module SexpAst = struct | Pexp_newtype (lbl, expr) -> Sexp.list [Sexp.atom "Pexp_newtype"; string lbl.Asttypes.txt; expression expr] - | Pexp_pack modExpr -> - Sexp.list [Sexp.atom "Pexp_pack"; moduleExpression modExpr] - | Pexp_open (flag, longidentLoc, expr) -> + | Pexp_pack mod_expr -> + Sexp.list [Sexp.atom "Pexp_pack"; module_expression mod_expr] + | Pexp_open (flag, longident_loc, expr) -> Sexp.list [ Sexp.atom "Pexp_open"; - overrideFlag flag; - longident longidentLoc.Asttypes.txt; + override_flag flag; + longident longident_loc.Asttypes.txt; expression expr; ] | Pexp_extension ext -> @@ -747,22 +747,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 (mapEmpty ~f:pattern patterns)] - | Ppat_construct (longidentLoc, optPattern) -> + [Sexp.atom "Ppat_tuple"; Sexp.list (map_empty ~f:pattern patterns)] + | Ppat_construct (longident_loc, opt_pattern) -> Sexp.list [ Sexp.atom "Ppat_construct"; - longident longidentLoc.Location.txt; - (match optPattern with + longident longident_loc.Location.txt; + (match opt_pattern with | None -> Sexp.atom "None" | Some p -> Sexp.list [Sexp.atom "some"; pattern p]); ] - | Ppat_variant (lbl, optPattern) -> + | Ppat_variant (lbl, opt_pattern) -> Sexp.list [ Sexp.atom "Ppat_variant"; string lbl; - (match optPattern with + (match opt_pattern with | None -> Sexp.atom "None" | Some p -> Sexp.list [Sexp.atom "Some"; pattern p]); ] @@ -770,125 +770,125 @@ module SexpAst = struct Sexp.list [ Sexp.atom "Ppat_record"; - closedFlag flag; + closed_flag flag; Sexp.list - (mapEmpty - ~f:(fun (longidentLoc, p) -> - Sexp.list [longident longidentLoc.Location.txt; pattern p]) + (map_empty + ~f:(fun (longident_loc, p) -> + Sexp.list [longident longident_loc.Location.txt; pattern p]) rows); ] | Ppat_array patterns -> Sexp.list - [Sexp.atom "Ppat_array"; Sexp.list (mapEmpty ~f:pattern patterns)] + [Sexp.atom "Ppat_array"; Sexp.list (map_empty ~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; coreType typexpr] - | Ppat_type longidentLoc -> - Sexp.list [Sexp.atom "Ppat_type"; longident longidentLoc.Location.txt] + 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] | Ppat_lazy p -> Sexp.list [Sexp.atom "Ppat_lazy"; pattern p] - | Ppat_unpack stringLoc -> - Sexp.list [Sexp.atom "Ppat_unpack"; string stringLoc.Location.txt] + | Ppat_unpack string_loc -> + Sexp.list [Sexp.atom "Ppat_unpack"; string string_loc.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 (longidentLoc, p) -> + | Ppat_open (longident_loc, p) -> Sexp.list [ - Sexp.atom "Ppat_open"; longident longidentLoc.Location.txt; pattern p; + Sexp.atom "Ppat_open"; longident longident_loc.Location.txt; pattern p; ] in Sexp.list [Sexp.atom "pattern"; descr] - and objectField field = + and object_field field = match field with - | Otag (lblLoc, attrs, typexpr) -> + | Otag (lbl_loc, attrs, typexpr) -> Sexp.list [ - Sexp.atom "Otag"; string lblLoc.txt; attributes attrs; coreType typexpr; + Sexp.atom "Otag"; string lbl_loc.txt; attributes attrs; core_type typexpr; ] - | Oinherit typexpr -> Sexp.list [Sexp.atom "Oinherit"; coreType typexpr] + | Oinherit typexpr -> Sexp.list [Sexp.atom "Oinherit"; core_type typexpr] - and rowField field = + and row_field field = match field with - | Rtag (labelLoc, attrs, truth, types) -> + | Rtag (label_loc, attrs, truth, types) -> Sexp.list [ Sexp.atom "Rtag"; - string labelLoc.txt; + string label_loc.txt; attributes attrs; Sexp.atom (if truth then "true" else "false"); - Sexp.list (mapEmpty ~f:coreType types); + Sexp.list (map_empty ~f:core_type types); ] - | Rinherit typexpr -> Sexp.list [Sexp.atom "Rinherit"; coreType typexpr] + | Rinherit typexpr -> Sexp.list [Sexp.atom "Rinherit"; core_type typexpr] - and packageType (modNameLoc, packageConstraints) = + and package_type (mod_name_loc, package_constraints) = Sexp.list [ Sexp.atom "package_type"; - longident modNameLoc.Asttypes.txt; + longident mod_name_loc.Asttypes.txt; Sexp.list - (mapEmpty - ~f:(fun (modNameLoc, typexpr) -> - Sexp.list [longident modNameLoc.Asttypes.txt; coreType typexpr]) - packageConstraints); + (map_empty + ~f:(fun (mod_name_loc, typexpr) -> + Sexp.list [longident mod_name_loc.Asttypes.txt; core_type typexpr]) + package_constraints); ] - and coreType typexpr = + and core_type 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 (argLbl, typ1, typ2) -> + | Ptyp_arrow (arg_lbl, typ1, typ2) -> Sexp.list [ - Sexp.atom "Ptyp_arrow"; argLabel argLbl; coreType typ1; coreType typ2; + Sexp.atom "Ptyp_arrow"; arg_label arg_lbl; core_type typ1; core_type typ2; ] | Ptyp_tuple types -> Sexp.list - [Sexp.atom "Ptyp_tuple"; Sexp.list (mapEmpty ~f:coreType types)] - | Ptyp_constr (longidentLoc, types) -> + [Sexp.atom "Ptyp_tuple"; Sexp.list (map_empty ~f:core_type types)] + | Ptyp_constr (longident_loc, types) -> Sexp.list [ Sexp.atom "Ptyp_constr"; - longident longidentLoc.txt; - Sexp.list (mapEmpty ~f:coreType types); + longident longident_loc.txt; + Sexp.list (map_empty ~f:core_type types); ] | Ptyp_alias (typexpr, alias) -> - Sexp.list [Sexp.atom "Ptyp_alias"; coreType typexpr; string alias] + Sexp.list [Sexp.atom "Ptyp_alias"; core_type typexpr; string alias] | Ptyp_object (fields, flag) -> Sexp.list [ Sexp.atom "Ptyp_object"; - closedFlag flag; - Sexp.list (mapEmpty ~f:objectField fields); + closed_flag flag; + Sexp.list (map_empty ~f:object_field fields); ] - | Ptyp_class (longidentLoc, types) -> + | Ptyp_class (longident_loc, types) -> Sexp.list [ Sexp.atom "Ptyp_class"; - longident longidentLoc.Location.txt; - Sexp.list (mapEmpty ~f:coreType types); + longident longident_loc.Location.txt; + Sexp.list (map_empty ~f:core_type types); ] - | Ptyp_variant (fields, flag, optLabels) -> + | Ptyp_variant (fields, flag, opt_labels) -> Sexp.list [ Sexp.atom "Ptyp_variant"; - Sexp.list (mapEmpty ~f:rowField fields); - closedFlag flag; - (match optLabels with + Sexp.list (map_empty ~f:row_field fields); + closed_flag flag; + (match opt_labels with | None -> Sexp.atom "None" - | Some lbls -> Sexp.list (mapEmpty ~f:string lbls)); + | Some lbls -> Sexp.list (map_empty ~f:string lbls)); ] | Ptyp_poly (lbls, typexpr) -> Sexp.list [ Sexp.atom "Ptyp_poly"; - Sexp.list (mapEmpty ~f:(fun lbl -> string lbl.Asttypes.txt) lbls); - coreType typexpr; + Sexp.list (map_empty ~f:(fun lbl -> string lbl.Asttypes.txt) lbls); + core_type typexpr; ] | Ptyp_package package -> - Sexp.list [Sexp.atom "Ptyp_package"; packageType package] + Sexp.list [Sexp.atom "Ptyp_package"; package_type package] | Ptyp_extension ext -> Sexp.list [Sexp.atom "Ptyp_extension"; extension ext] in @@ -896,55 +896,55 @@ module SexpAst = struct and payload p = match p with - | PStr s -> Sexp.list (Sexp.atom "PStr" :: mapEmpty ~f:structureItem s) + | PStr s -> Sexp.list (Sexp.atom "PStr" :: map_empty ~f:structure_item s) | PSig s -> Sexp.list [Sexp.atom "PSig"; signature s] - | PTyp ct -> Sexp.list [Sexp.atom "PTyp"; coreType ct] - | PPat (pat, optExpr) -> + | PTyp ct -> Sexp.list [Sexp.atom "PTyp"; core_type ct] + | PPat (pat, opt_expr) -> Sexp.list [ Sexp.atom "PPat"; pattern pat; - (match optExpr with + (match opt_expr with | Some expr -> Sexp.list [Sexp.atom "Some"; expression expr] | None -> Sexp.atom "None"); ] - and attribute (stringLoc, p) = + and attribute (string_loc, p) = Sexp.list - [Sexp.atom "attribute"; Sexp.atom stringLoc.Asttypes.txt; payload p] + [Sexp.atom "attribute"; Sexp.atom string_loc.Asttypes.txt; payload p] - and extension (stringLoc, p) = + and extension (string_loc, p) = Sexp.list - [Sexp.atom "extension"; Sexp.atom stringLoc.Asttypes.txt; payload p] + [Sexp.atom "extension"; Sexp.atom string_loc.Asttypes.txt; payload p] and attributes attrs = - let sexprs = mapEmpty ~f:attribute attrs in + let sexprs = map_empty ~f:attribute attrs in Sexp.list (Sexp.atom "attributes" :: sexprs) - let printEngine = + let print_engine = Res_driver. { - printImplementation = + print_implementation = (fun ~width:_ ~filename:_ ~comments:_ parsetree -> - parsetree |> structure |> Sexp.toString |> print_string); - printInterface = + parsetree |> structure |> Sexp.to_string |> print_string); + print_interface = (fun ~width:_ ~filename:_ ~comments:_ parsetree -> - parsetree |> signature |> Sexp.toString |> print_string); + parsetree |> signature |> Sexp.to_string |> print_string); } end -let sexpPrintEngine = SexpAst.printEngine +let sexp_print_engine = SexpAst.print_engine -let commentsPrintEngine = +let comments_print_engine = { - Res_driver.printImplementation = + Res_driver.print_implementation = (fun ~width:_ ~filename:_ ~comments s -> - let cmtTbl = CommentTable.make () in - CommentTable.walkStructure s cmtTbl comments; - CommentTable.log cmtTbl); - printInterface = + let cmt_tbl = CommentTable.make () in + CommentTable.walk_structure s cmt_tbl comments; + CommentTable.log cmt_tbl); + print_interface = (fun ~width:_ ~filename:_ ~comments s -> - let cmtTbl = CommentTable.make () in - CommentTable.walkSignature s cmtTbl comments; - CommentTable.log cmtTbl); + let cmt_tbl = CommentTable.make () in + CommentTable.walk_signature s cmt_tbl comments; + CommentTable.log cmt_tbl); } diff --git a/jscomp/syntax/src/res_ast_debugger.mli b/jscomp/syntax/src/res_ast_debugger.mli index 1b325b742f..66588af592 100644 --- a/jscomp/syntax/src/res_ast_debugger.mli +++ b/jscomp/syntax/src/res_ast_debugger.mli @@ -1,3 +1,3 @@ -val printEngine : Res_driver.printEngine -val sexpPrintEngine : Res_driver.printEngine -val commentsPrintEngine : Res_driver.printEngine +val print_engine : Res_driver.print_engine +val sexp_print_engine : Res_driver.print_engine +val comments_print_engine : Res_driver.print_engine diff --git a/jscomp/syntax/src/res_comment.ml b/jscomp/syntax/src/res_comment.ml index 579b5d3279..d4e7bd0a42 100644 --- a/jscomp/syntax/src/res_comment.ml +++ b/jscomp/syntax/src/res_comment.ml @@ -1,6 +1,6 @@ type style = SingleLine | MultiLine | DocComment | ModuleComment -let styleToString s = +let style_to_string s = match s with | SingleLine -> "SingleLine" | MultiLine -> "MultiLine" @@ -11,46 +11,46 @@ type t = { txt: string; style: style; loc: Location.t; - mutable prevTokEndPos: Lexing.position; + mutable prev_tok_end_pos: Lexing.position; } let loc t = t.loc let txt t = t.txt -let prevTokEndPos t = t.prevTokEndPos +let prev_tok_end_pos t = t.prev_tok_end_pos -let setPrevTokEndPos t pos = t.prevTokEndPos <- pos +let set_prev_tok_end_pos t pos = t.prev_tok_end_pos <- pos -let isSingleLineComment t = t.style = SingleLine +let is_single_line_comment t = t.style = SingleLine -let isDocComment t = t.style = DocComment +let is_doc_comment t = t.style = DocComment -let isModuleComment t = t.style = ModuleComment +let is_module_comment t = t.style = ModuleComment -let toString t = +let to_string t = let {Location.loc_start; loc_end} = t.loc in Format.sprintf "(txt: %s\nstyle: %s\nlocation: %d,%d-%d,%d)" t.txt - (styleToString t.style) loc_start.pos_lnum + (style_to_string 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 makeSingleLineComment ~loc txt = - {txt; loc; style = SingleLine; prevTokEndPos = Lexing.dummy_pos} +let make_single_line_comment ~loc txt = + {txt; loc; style = SingleLine; prev_tok_end_pos = Lexing.dummy_pos} -let makeMultiLineComment ~loc ~docComment ~standalone txt = +let make_multi_line_comment ~loc ~doc_comment ~standalone txt = { txt; loc; style = - (if docComment then if standalone then ModuleComment else DocComment + (if doc_comment then if standalone then ModuleComment else DocComment else MultiLine); - prevTokEndPos = Lexing.dummy_pos; + prev_tok_end_pos = Lexing.dummy_pos; } -let fromOcamlComment ~loc ~txt ~prevTokEndPos = - {txt; loc; style = MultiLine; prevTokEndPos} +let from_ocaml_comment ~loc ~txt ~prev_tok_end_pos = + {txt; loc; style = MultiLine; prev_tok_end_pos} -let trimSpaces s = +let trim_spaces 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/jscomp/syntax/src/res_comment.mli b/jscomp/syntax/src/res_comment.mli index f1d5424d9c..7cf10edd47 100644 --- a/jscomp/syntax/src/res_comment.mli +++ b/jscomp/syntax/src/res_comment.mli @@ -1,22 +1,22 @@ type t -val toString : t -> string +val to_string : t -> string val loc : t -> Location.t val txt : t -> string -val prevTokEndPos : t -> Lexing.position +val prev_tok_end_pos : t -> Lexing.position -val setPrevTokEndPos : t -> Lexing.position -> unit +val set_prev_tok_end_pos : t -> Lexing.position -> unit -val isDocComment : t -> bool +val is_doc_comment : t -> bool -val isModuleComment : t -> bool +val is_module_comment : t -> bool -val isSingleLineComment : t -> bool +val is_single_line_comment : t -> bool -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 +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 diff --git a/jscomp/syntax/src/res_comments_table.ml b/jscomp/syntax/src/res_comments_table.ml index f2153d72b9..a8b1e35d55 100644 --- a/jscomp/syntax/src/res_comments_table.ml +++ b/jscomp/syntax/src/res_comments_table.ml @@ -24,7 +24,7 @@ let copy tbl = let empty = make () -let printEntries tbl = +let print_entries tbl = let open Location in Hashtbl.fold (fun (k : Location.t) (v : Comment.t list) acc -> @@ -44,7 +44,7 @@ let printEntries tbl = ] in let doc = - Doc.breakableGroup ~forceBreak:true + Doc.breakable_group ~force_break:true (Doc.concat [ loc; @@ -63,133 +63,133 @@ let printEntries tbl = tbl [] let log t = - let leadingStuff = printEntries t.leading in - let trailingStuff = printEntries t.trailing in - let stuffInside = printEntries t.inside in - Doc.breakableGroup ~forceBreak:true + 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 (Doc.concat [ Doc.text "leading comments:"; - Doc.indent (Doc.concat [Doc.line; Doc.concat leadingStuff]); + Doc.indent (Doc.concat [Doc.line; Doc.concat leading_stuff]); Doc.line; Doc.text "comments inside:"; - Doc.indent (Doc.concat [Doc.line; Doc.concat stuffInside]); + Doc.indent (Doc.concat [Doc.line; Doc.concat stuff_inside]); Doc.line; Doc.text "trailing comments:"; - Doc.indent (Doc.concat [Doc.line; Doc.concat trailingStuff]); + Doc.indent (Doc.concat [Doc.line; Doc.concat trailing_stuff]); Doc.line; ]) - |> Doc.toString ~width:80 |> print_endline + |> Doc.to_string ~width:80 |> print_endline let attach tbl loc comments = match comments with | [] -> () | comments -> Hashtbl.replace tbl loc comments -let partitionByLoc comments loc = +let partition_by_loc comments loc = let rec loop (leading, inside, trailing) comments = let open Location in match comments with | comment :: rest -> - let cmtLoc = Comment.loc comment in - if cmtLoc.loc_end.pos_cnum <= loc.loc_start.pos_cnum then + let cmt_loc = Comment.loc comment in + if cmt_loc.loc_end.pos_cnum <= loc.loc_start.pos_cnum then loop (comment :: leading, inside, trailing) rest - else if cmtLoc.loc_start.pos_cnum >= loc.loc_end.pos_cnum then + else if cmt_loc.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 partitionLeadingTrailing comments loc = +let partition_leading_trailing comments loc = let rec loop (leading, trailing) comments = let open Location in match comments with | comment :: rest -> - let cmtLoc = Comment.loc comment in - if cmtLoc.loc_end.pos_cnum <= loc.loc_start.pos_cnum then + let cmt_loc = Comment.loc comment in + if cmt_loc.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 partitionByOnSameLine loc comments = - let rec loop (onSameLine, onOtherLine) comments = +let partition_by_on_same_line loc comments = + let rec loop (on_same_line, on_other_line) comments = let open Location in match comments with - | [] -> (List.rev onSameLine, List.rev onOtherLine) + | [] -> (List.rev on_same_line, List.rev on_other_line) | comment :: 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 + 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 in loop ([], []) comments -let partitionAdjacentTrailing loc1 comments = +let partition_adjacent_trailing loc1 comments = let open Location in let open Lexing in - let rec loop ~prevEndPos afterLoc1 comments = + let rec loop ~prev_end_pos after_loc1 comments = match comments with - | [] -> (List.rev afterLoc1, []) + | [] -> (List.rev after_loc1, []) | comment :: rest as 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) + 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) in - loop ~prevEndPos:loc1.loc_end [] comments + loop ~prev_end_pos:loc1.loc_end [] comments -let rec collectListPatterns acc pattern = +let rec collect_list_patterns acc pattern = let open Parsetree in match pattern.ppat_desc with | Ppat_construct ({txt = Longident.Lident "::"}, Some {ppat_desc = Ppat_tuple [pat; rest]}) -> - collectListPatterns (pat :: acc) rest + collect_list_patterns (pat :: acc) rest | Ppat_construct ({txt = Longident.Lident "[]"}, None) -> List.rev acc | _ -> List.rev (pattern :: acc) -let rec collectListExprs acc expr = +let rec collect_list_exprs acc expr = let open Parsetree in match expr.pexp_desc with | Pexp_construct ({txt = Longident.Lident "::"}, Some {pexp_desc = Pexp_tuple [expr; rest]}) -> - collectListExprs (expr :: acc) rest + collect_list_exprs (expr :: acc) rest | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> List.rev acc | _ -> List.rev (expr :: acc) (* TODO: use ParsetreeViewer *) -let arrowType ct = +let arrow_type ct = let open Parsetree in - let rec process attrsBefore acc typ = + let rec process attrs_before acc typ = match typ with | { ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2); ptyp_attributes = []; } -> let arg = ([], lbl, typ1) in - process attrsBefore (arg :: acc) typ2 + process attrs_before (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 attrsBefore (arg :: acc) typ2 + process attrs_before (arg :: acc) typ2 | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = _attrs} - as returnType -> + as return_type -> let args = List.rev acc in - (attrsBefore, args, returnType) + (attrs_before, args, return_type) | { ptyp_desc = Ptyp_arrow (((Labelled _ | Optional _) as lbl), typ1, typ2); ptyp_attributes = attrs; } -> let arg = (attrs, lbl, typ1) in - process attrsBefore (arg :: acc) typ2 - | typ -> (attrsBefore, List.rev acc, typ) + process attrs_before (arg :: acc) typ2 + | typ -> (attrs_before, List.rev acc, typ) in match ct with | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as @@ -198,54 +198,54 @@ let arrowType ct = | typ -> process [] [] typ (* TODO: avoiding the dependency on ParsetreeViewer here, is this a good idea? *) -let modExprApply modExpr = - let rec loop acc modExpr = - match modExpr with +let mod_expr_apply mod_expr = + let rec loop acc mod_expr = + match mod_expr with | {Parsetree.pmod_desc = Pmod_apply (next, arg)} -> loop (arg :: acc) next - | _ -> modExpr :: acc + | _ -> mod_expr :: acc in - loop [] modExpr + loop [] mod_expr (* TODO: avoiding the dependency on ParsetreeViewer here, is this a good idea? *) -let modExprFunctor modExpr = - let rec loop acc modExpr = - match modExpr with +let mod_expr_functor mod_expr = + let rec loop acc mod_expr = + match mod_expr with | { - Parsetree.pmod_desc = Pmod_functor (lbl, modType, returnModExpr); + Parsetree.pmod_desc = Pmod_functor (lbl, mod_type, return_mod_expr); pmod_attributes = attrs; } -> - let param = (attrs, lbl, modType) in - loop (param :: acc) returnModExpr - | returnModExpr -> (List.rev acc, returnModExpr) + let param = (attrs, lbl, mod_type) in + loop (param :: acc) return_mod_expr + | return_mod_expr -> (List.rev acc, return_mod_expr) in - loop [] modExpr + loop [] mod_expr -let functorType modtype = +let functor_type modtype = let rec process acc modtype = match modtype with | { - Parsetree.pmty_desc = Pmty_functor (lbl, argType, returnType); + Parsetree.pmty_desc = Pmty_functor (lbl, arg_type, return_type); pmty_attributes = attrs; } -> - let arg = (attrs, lbl, argType) in - process (arg :: acc) returnType - | modType -> (List.rev acc, modType) + let arg = (attrs, lbl, arg_type) in + process (arg :: acc) return_type + | mod_type -> (List.rev acc, mod_type) in process [] modtype -let funExpr expr = +let fun_expr expr = let open Parsetree in (* Turns (type t, type u, type z) into "type t u z" *) - let rec collectNewTypes acc returnExpr = - match returnExpr with - | {pexp_desc = Pexp_newtype (stringLoc, returnExpr); pexp_attributes = []} + let rec collect_new_types acc return_expr = + match return_expr with + | {pexp_desc = Pexp_newtype (string_loc, return_expr); pexp_attributes = []} -> - collectNewTypes (stringLoc :: acc) returnExpr - | returnExpr -> + collect_new_types (string_loc :: acc) return_expr + | return_expr -> let loc = match (acc, List.rev acc) with - | _startLoc :: _, endLoc :: _ -> - {endLoc.loc with loc_end = endLoc.loc.loc_end} + | _startLoc :: _, end_loc :: _ -> + {end_loc.loc with loc_end = end_loc.loc.loc_end} | _ -> Location.none in let txt = @@ -253,7 +253,7 @@ let funExpr expr = (fun curr acc -> acc ^ " " ^ curr.Location.txt) acc "type" in - (Location.mkloc txt loc, returnExpr) + (Location.mkloc txt loc, return_expr) 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 funExpr 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 attrsBefore acc expr = + let rec collect attrs_before acc expr = match expr with | { - pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); + pexp_desc = Pexp_fun (lbl, default_expr, pattern, return_expr); pexp_attributes = []; } -> - 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 = ([], lbl, default_expr, pattern) in + collect attrs_before (parameter :: acc) return_expr + | {pexp_desc = Pexp_newtype (string_loc, rest); pexp_attributes = attrs} -> + let var, return_expr = collect_new_types [string_loc] rest in let parameter = ( attrs, Asttypes.Nolabel, None, - Ast_helper.Pat.var ~loc:stringLoc.loc var ) + Ast_helper.Pat.var ~loc:string_loc.loc var ) in - collect attrsBefore (parameter :: acc) returnExpr + collect attrs_before (parameter :: acc) return_expr | { - pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); + pexp_desc = Pexp_fun (lbl, default_expr, pattern, return_expr); pexp_attributes = [({txt = "bs"}, _)] as attrs; } -> - let parameter = (attrs, lbl, defaultExpr, pattern) in - collect attrsBefore (parameter :: acc) returnExpr + let parameter = (attrs, lbl, default_expr, pattern) in + collect attrs_before (parameter :: acc) return_expr | { pexp_desc = Pexp_fun - (((Labelled _ | Optional _) as lbl), defaultExpr, pattern, returnExpr); + (((Labelled _ | Optional _) as lbl), default_expr, pattern, return_expr); pexp_attributes = attrs; } -> - let parameter = (attrs, lbl, defaultExpr, pattern) in - collect attrsBefore (parameter :: acc) returnExpr - | expr -> (attrsBefore, List.rev acc, expr) + let parameter = (attrs, lbl, default_expr, pattern) in + collect attrs_before (parameter :: acc) return_expr + | expr -> (attrs_before, List.rev acc, expr) in match expr with | { @@ -302,19 +302,19 @@ let funExpr expr = collect attrs [] {expr with pexp_attributes = []} | expr -> collect [] [] expr -let rec isBlockExpr expr = +let rec is_block_expr expr = let open Parsetree in match expr.pexp_desc with | Pexp_letmodule _ | Pexp_letexception _ | Pexp_let _ | Pexp_open _ | Pexp_sequence _ -> 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 + | 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 | _ -> false -let isIfThenElseExpr expr = +let is_if_then_else_expr 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 getLoc node = +let get_loc node = let open Parsetree in match node with | Case case -> { case.pc_lhs.ppat_loc with loc_end = - (match ParsetreeViewer.processBracesAttr case.pc_rhs with + (match ParsetreeViewer.process_braces_attr case.pc_rhs with | None, _ -> case.pc_rhs.pexp_loc.loc_end | Some ({loc}, _), _ -> loc.Location.loc_end); } @@ -385,311 +385,311 @@ let getLoc node = | TypeDeclaration td -> td.ptype_loc | ValueBinding vb -> vb.pvb_loc -let rec walkStructure s t comments = +let rec walk_structure s t comments = match s with | _ when comments = [] -> () | [] -> attach t.inside Location.none comments - | s -> walkList (s |> List.map (fun si -> StructureItem si)) t comments + | s -> walk_list (s |> List.map (fun si -> StructureItem si)) t comments -and walkStructureItem si t comments = +and walk_structure_item si t comments = match si.Parsetree.pstr_desc with | _ when comments = [] -> () - | 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)) + | 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)) 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_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_class_type _ | Pstr_class _ -> () -and walkValueDescription vd t comments = - let leading, trailing = partitionLeadingTrailing comments vd.pval_name.loc in +and walk_value_description vd t comments = + let leading, trailing = partition_leading_trailing comments vd.pval_name.loc in attach t.leading vd.pval_name.loc leading; - 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 + 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 attach t.leading vd.pval_type.ptyp_loc before; - walkCoreType vd.pval_type t inside; + walk_core_type vd.pval_type t inside; attach t.trailing vd.pval_type.ptyp_loc after -and walkTypeExtension te t comments = +and walk_type_extension te t comments = let leading, trailing = - partitionLeadingTrailing comments te.ptyext_path.loc + partition_leading_trailing comments te.ptyext_path.loc in attach t.leading te.ptyext_path.loc leading; - let afterPath, rest = partitionAdjacentTrailing te.ptyext_path.loc trailing in - attach t.trailing te.ptyext_path.loc afterPath; + let after_path, rest = partition_adjacent_trailing te.ptyext_path.loc trailing in + attach t.trailing te.ptyext_path.loc after_path; (* type params *) let rest = match te.ptyext_params with | [] -> rest - | typeParams -> - visitListButContinueWithRemainingComments - ~getLoc:(fun (typexpr, _variance) -> typexpr.Parsetree.ptyp_loc) - ~walkNode:walkTypeParam ~newlineDelimited:false typeParams t 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 in - walkList + walk_list (te.ptyext_constructors |> List.map (fun ec -> ExtensionConstructor ec)) t rest -and walkIncludeDeclaration inclDecl t comments = +and walk_include_declaration incl_decl t comments = let before, inside, after = - partitionByLoc comments inclDecl.pincl_mod.pmod_loc + partition_by_loc comments incl_decl.pincl_mod.pmod_loc in - attach t.leading inclDecl.pincl_mod.pmod_loc before; - walkModuleExpr inclDecl.pincl_mod t inside; - attach t.trailing inclDecl.pincl_mod.pmod_loc after + 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 -and walkModuleTypeDeclaration mtd t comments = - let leading, trailing = partitionLeadingTrailing comments mtd.pmtd_name.loc in +and walk_module_type_declaration mtd t comments = + let leading, trailing = partition_leading_trailing 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 modType -> - let afterName, rest = - partitionAdjacentTrailing mtd.pmtd_name.loc trailing + | Some mod_type -> + let after_name, rest = + partition_adjacent_trailing mtd.pmtd_name.loc trailing 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.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.leading mb.pmb_name.loc leading; - 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 + 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 (match mb.pmb_expr.pmod_desc with | Pmod_constraint _ -> - walkModuleExpr mb.pmb_expr t (List.concat [leading; inside]) + walk_module_expr mb.pmb_expr t (List.concat [leading; inside]) | _ -> attach t.leading mb.pmb_expr.pmod_loc leading; - walkModuleExpr mb.pmb_expr t inside); + walk_module_expr mb.pmb_expr t inside); attach t.trailing mb.pmb_expr.pmod_loc trailing -and walkSignature signature t comments = +and walk_signature signature t comments = match signature with | _ when comments = [] -> () | [] -> attach t.inside Location.none comments | _s -> - walkList (signature |> List.map (fun si -> SignatureItem si)) t comments + walk_list (signature |> List.map (fun si -> SignatureItem si)) t comments -and walkSignatureItem (si : Parsetree.signature_item) t comments = +and walk_signature_item (si : Parsetree.signature_item) t comments = match si.psig_desc with | _ when comments = [] -> () - | 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)) + | 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)) 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_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_class _ | Psig_class_type _ -> () -and walkIncludeDescription id t comments = - let before, inside, after = partitionByLoc comments id.pincl_mod.pmty_loc in +and walk_include_description id t comments = + let before, inside, after = partition_by_loc comments id.pincl_mod.pmty_loc in attach t.leading id.pincl_mod.pmty_loc before; - walkModType id.pincl_mod t inside; + walk_mod_type id.pincl_mod t inside; attach t.trailing id.pincl_mod.pmty_loc after -and walkModuleDeclaration md t comments = - let leading, trailing = partitionLeadingTrailing comments md.pmd_name.loc in +and walk_module_declaration md t comments = + let leading, trailing = partition_leading_trailing comments md.pmd_name.loc in attach t.leading md.pmd_name.loc leading; - 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 + 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 attach t.leading md.pmd_type.pmty_loc leading; - walkModType md.pmd_type t inside; + walk_mod_type md.pmd_type t inside; attach t.trailing md.pmd_type.pmty_loc trailing -and walkNode node tbl comments = +and walk_node node tbl comments = match node with - | 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 -> + | 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 -> match l with | _ when comments = [] -> () | [] -> ( - match prevLoc with + match prev_loc with | Some loc -> attach t.trailing loc comments | None -> ()) | node :: rest -> - let currLoc = getLoc node in - let leading, inside, trailing = partitionByLoc comments currLoc in - (match prevLoc with + let curr_loc = get_loc node in + let leading, inside, trailing = partition_by_loc comments curr_loc in + (match prev_loc with | None -> (* first node, all leading comments attach here *) - attach t.leading currLoc leading - | Some prevLoc -> + attach t.leading curr_loc leading + | Some prev_loc -> (* Same line *) - 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) + 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) else - let onSameLineAsPrev, afterPrev = - partitionByOnSameLine prevLoc leading + let on_same_line_as_prev, after_prev = + partition_by_on_same_line prev_loc leading in - 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 + attach t.trailing prev_loc on_same_line_as_prev; + let leading, _inside, _trailing = partition_by_loc after_prev curr_loc in + attach t.leading curr_loc leading); + walk_node node t inside; + walk_list ~prev_loc:curr_loc 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 visitListButContinueWithRemainingComments : +and visit_list_but_continue_with_remaining_comments : 'node. - ?prevLoc:Location.t -> - newlineDelimited:bool -> - getLoc:('node -> Location.t) -> - walkNode:('node -> t -> Comment.t list -> unit) -> + ?prev_loc:Location.t -> + newline_delimited:bool -> + get_loc:('node -> Location.t) -> + walk_node:('node -> t -> Comment.t list -> unit) -> 'node list -> t -> Comment.t list -> Comment.t list = - fun ?prevLoc ~newlineDelimited ~getLoc ~walkNode l t comments -> + fun ?prev_loc ~newline_delimited ~get_loc ~walk_node l t comments -> let open Location in match l with | _ when comments = [] -> [] | [] -> ( - match prevLoc with + match prev_loc with | Some loc -> - let afterPrev, rest = - if newlineDelimited then partitionByOnSameLine loc comments - else partitionAdjacentTrailing loc comments + let after_prev, rest = + if newline_delimited then partition_by_on_same_line loc comments + else partition_adjacent_trailing loc comments in - attach t.trailing loc afterPrev; + attach t.trailing loc after_prev; rest | None -> comments) | node :: rest -> - let currLoc = getLoc node in - let leading, inside, trailing = partitionByLoc comments currLoc in + let curr_loc = get_loc node in + let leading, inside, trailing = partition_by_loc comments curr_loc in let () = - match prevLoc with + match prev_loc with | None -> (* first node, all leading comments attach here *) - attach t.leading currLoc leading; + attach t.leading curr_loc leading; () - | Some prevLoc -> + | Some prev_loc -> (* Same line *) - if prevLoc.loc_end.pos_lnum == currLoc.loc_start.pos_lnum then - let afterPrev, beforeCurr = - partitionAdjacentTrailing prevLoc leading + 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 - let () = attach t.trailing prevLoc afterPrev in - let () = attach t.leading currLoc beforeCurr in + let () = attach t.trailing prev_loc after_prev in + let () = attach t.leading curr_loc before_curr in () else - let onSameLineAsPrev, afterPrev = - partitionByOnSameLine prevLoc leading + let on_same_line_as_prev, after_prev = + partition_by_on_same_line prev_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 + let () = attach t.trailing prev_loc on_same_line_as_prev in + let leading, _inside, _trailing = partition_by_loc after_prev curr_loc in + let () = attach t.leading curr_loc leading in () in - walkNode node t inside; - visitListButContinueWithRemainingComments ~prevLoc:currLoc ~getLoc ~walkNode - ~newlineDelimited rest t trailing + 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 -and walkValueBindings vbs t comments = - walkList (vbs |> List.map (fun vb -> ValueBinding vb)) t comments +and walk_value_bindings vbs t comments = + walk_list (vbs |> List.map (fun vb -> ValueBinding vb)) t comments -and walkOpenDescription openDescription t comments = - let loc = openDescription.popen_lid.loc in - let leading, trailing = partitionLeadingTrailing comments loc in +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 attach t.leading loc leading; attach t.trailing loc trailing -and walkTypeDeclarations typeDeclarations t comments = - walkList - (typeDeclarations |> List.map (fun td -> TypeDeclaration td)) +and walk_type_declarations type_declarations t comments = + walk_list + (type_declarations |> List.map (fun td -> TypeDeclaration td)) t comments -and walkTypeParam (typexpr, _variance) t comments = - walkCoreType typexpr t comments +and walk_type_param (typexpr, _variance) t comments = + walk_core_type typexpr t comments -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; +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; - let afterName, rest = partitionAdjacentTrailing td.ptype_name.loc rest in - attach t.trailing td.ptype_name.loc afterName; + let after_name, rest = partition_adjacent_trailing td.ptype_name.loc rest in + attach t.trailing td.ptype_name.loc after_name; (* type params *) let rest = match td.ptype_params with | [] -> rest - | typeParams -> - visitListButContinueWithRemainingComments - ~getLoc:(fun (typexpr, _variance) -> typexpr.Parsetree.ptyp_loc) - ~walkNode:walkTypeParam ~newlineDelimited:false typeParams t 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 in (* manifest: = typexpr *) let rest = match td.ptype_manifest with | Some typexpr -> - let beforeTyp, insideTyp, afterTyp = - partitionByLoc rest typexpr.ptyp_loc + let before_typ, inside_typ, after_typ = + partition_by_loc rest typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc beforeTyp; - walkCoreType typexpr t insideTyp; - let afterTyp, rest = - partitionAdjacentTrailing typexpr.Parsetree.ptyp_loc afterTyp + 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 in - attach t.trailing typexpr.ptyp_loc afterTyp; + attach t.trailing typexpr.ptyp_loc after_typ; rest | None -> rest in @@ -697,76 +697,76 @@ and walkTypeDeclaration (td : Parsetree.type_declaration) t comments = let rest = match td.ptype_kind with | Ptype_abstract | Ptype_open -> rest - | Ptype_record labelDeclarations -> + | Ptype_record label_declarations -> let () = - if labelDeclarations = [] then attach t.inside td.ptype_loc rest + if label_declarations = [] then attach t.inside td.ptype_loc rest else - walkList - (labelDeclarations |> List.map (fun ld -> LabelDeclaration ld)) + walk_list + (label_declarations |> List.map (fun ld -> LabelDeclaration ld)) t rest in [] - | Ptype_variant constructorDeclarations -> - walkConstructorDeclarations constructorDeclarations t rest + | Ptype_variant constructor_declarations -> + walk_constructor_declarations constructor_declarations t rest in attach t.trailing td.ptype_loc rest -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 +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 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 + 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 let rest = match cd.pcd_res with | Some typexpr -> - let beforeTyp, insideTyp, afterTyp = - partitionByLoc rest typexpr.ptyp_loc + let before_typ, inside_typ, after_typ = + partition_by_loc rest typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc beforeTyp; - walkCoreType typexpr t insideTyp; - let afterTyp, rest = - partitionAdjacentTrailing typexpr.Parsetree.ptyp_loc afterTyp + 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 in - attach t.trailing typexpr.ptyp_loc afterTyp; + attach t.trailing typexpr.ptyp_loc after_typ; rest | None -> rest in attach t.trailing cd.pcd_loc rest -and walkConstructorArguments args t comments = +and walk_constructor_arguments args t comments = match args with | Pcstr_tuple typexprs -> - visitListButContinueWithRemainingComments - ~getLoc:(fun n -> n.Parsetree.ptyp_loc) - ~walkNode:walkCoreType ~newlineDelimited:false typexprs t comments - | Pcstr_record labelDeclarations -> - walkLabelDeclarations labelDeclarations t comments + 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 -and walkValueBinding vb t comments = +and walk_value_binding vb t comments = let open Location in let vb = let open Parsetree in @@ -794,7 +794,7 @@ and walkValueBinding vb t comments = | ( ({ ppat_desc = Ppat_constraint (pat, ({ptyp_desc = Ptyp_poly (_ :: _, t)} as typ)); - } as constrainedPattern), + } as constrained_pattern), {pexp_desc = Pexp_newtype (_, {pexp_desc = Pexp_constraint (expr, _)})} ) -> (* @@ -810,458 +810,458 @@ and walkValueBinding vb t comments = vb with pvb_pat = { - constrainedPattern with + constrained_pattern with ppat_desc = Ppat_constraint (pat, typ); ppat_loc = - {constrainedPattern.ppat_loc with loc_end = t.ptyp_loc.loc_end}; + {constrained_pattern.ppat_loc with loc_end = t.ptyp_loc.loc_end}; }; pvb_expr = expr; } | _ -> vb in - let patternLoc = vb.Parsetree.pvb_pat.ppat_loc in - let exprLoc = vb.Parsetree.pvb_expr.pexp_loc in + let pattern_loc = vb.Parsetree.pvb_pat.ppat_loc in + let expr_loc = vb.Parsetree.pvb_expr.pexp_loc in let expr = vb.pvb_expr in - let leading, inside, trailing = partitionByLoc comments patternLoc in + let leading, inside, trailing = partition_by_loc comments pattern_loc in (* everything before start of pattern can only be leading on the pattern: * let |* before *| a = 1 *) - attach t.leading patternLoc leading; - walkPattern vb.Parsetree.pvb_pat t inside; - let afterPat, surroundingExpr = - partitionAdjacentTrailing patternLoc trailing + 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 in - attach t.trailing patternLoc afterPat; - let beforeExpr, insideExpr, afterExpr = - partitionByLoc surroundingExpr exprLoc + attach t.trailing pattern_loc after_pat; + let before_expr, inside_expr, after_expr = + partition_by_loc surrounding_expr expr_loc in - if isBlockExpr expr then - walkExpression expr t (List.concat [beforeExpr; insideExpr; afterExpr]) + if is_block_expr expr then + walk_expression expr t (List.concat [before_expr; inside_expr; after_expr]) else ( - attach t.leading exprLoc beforeExpr; - walkExpression expr t insideExpr; - attach t.trailing exprLoc afterExpr) + attach t.leading expr_loc before_expr; + walk_expression expr t inside_expr; + attach t.trailing expr_loc after_expr) -and walkExpression expr t comments = +and walk_expression expr t comments = let open Location in match expr.Parsetree.pexp_desc with | _ when comments = [] -> () | Pexp_constant _ -> - let leading, trailing = partitionLeadingTrailing comments expr.pexp_loc in + let leading, trailing = partition_leading_trailing 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 = partitionLeadingTrailing comments longident.loc in + let leading, trailing = partition_leading_trailing comments longident.loc in attach t.leading longident.loc leading; attach t.trailing longident.loc trailing | Pexp_let ( _recFlag, - valueBindings, + value_bindings, {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, None)} ) -> - walkValueBindings valueBindings t comments - | Pexp_let (_recFlag, valueBindings, expr2) -> + walk_value_bindings value_bindings t comments + | Pexp_let (_recFlag, value_bindings, expr2) -> let comments = - visitListButContinueWithRemainingComments - ~getLoc:(fun n -> + visit_list_but_continue_with_remaining_comments + ~get_loc:(fun n -> if n.Parsetree.pvb_pat.ppat_loc.loc_ghost then n.pvb_expr.pexp_loc else n.Parsetree.pvb_loc) - ~walkNode:walkValueBinding ~newlineDelimited:true valueBindings t + ~walk_node:walk_value_binding ~newline_delimited:true value_bindings t comments in - if isBlockExpr expr2 then walkExpression expr2 t comments + if is_block_expr expr2 then walk_expression expr2 t comments else - let leading, inside, trailing = partitionByLoc comments expr2.pexp_loc in + let leading, inside, trailing = partition_by_loc comments expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpression expr2 t inside; + walk_expression expr2 t inside; attach t.trailing expr2.pexp_loc trailing | Pexp_sequence (expr1, expr2) -> - let leading, inside, trailing = partitionByLoc comments expr1.pexp_loc in + let leading, inside, trailing = partition_by_loc comments expr1.pexp_loc in let comments = - if isBlockExpr expr1 then ( - let afterExpr, comments = - partitionByOnSameLine expr1.pexp_loc trailing + if is_block_expr expr1 then ( + let after_expr, comments = + partition_by_on_same_line expr1.pexp_loc trailing in - walkExpression expr1 t (List.concat [leading; inside; afterExpr]); + walk_expression expr1 t (List.concat [leading; inside; after_expr]); comments) else ( attach t.leading expr1.pexp_loc leading; - walkExpression expr1 t inside; - let afterExpr, comments = - partitionByOnSameLine expr1.pexp_loc trailing + walk_expression expr1 t inside; + let after_expr, comments = + partition_by_on_same_line expr1.pexp_loc trailing in - attach t.trailing expr1.pexp_loc afterExpr; + attach t.trailing expr1.pexp_loc after_expr; comments) in - if isBlockExpr expr2 then walkExpression expr2 t comments + if is_block_expr expr2 then walk_expression expr2 t comments else - let leading, inside, trailing = partitionByLoc comments expr2.pexp_loc in + let leading, inside, trailing = partition_by_loc comments expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpression expr2 t inside; + walk_expression expr2 t inside; attach t.trailing expr2.pexp_loc trailing | Pexp_open (_override, longident, expr2) -> - let leading, comments = partitionLeadingTrailing comments expr.pexp_loc in + let leading, comments = partition_leading_trailing comments expr.pexp_loc in attach t.leading {expr.pexp_loc with loc_end = longident.loc.loc_end} leading; - let leading, trailing = partitionLeadingTrailing comments longident.loc in + let leading, trailing = partition_leading_trailing comments longident.loc in attach t.leading longident.loc leading; - let afterLongident, rest = partitionByOnSameLine longident.loc trailing in - attach t.trailing longident.loc afterLongident; - if isBlockExpr expr2 then walkExpression expr2 t rest + 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 else - let leading, inside, trailing = partitionByLoc rest expr2.pexp_loc in + let leading, inside, trailing = partition_by_loc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpression expr2 t inside; + walk_expression expr2 t inside; attach t.trailing expr2.pexp_loc trailing | Pexp_extension ( {txt = "obj"}, PStr [{pstr_desc = Pstr_eval ({pexp_desc = Pexp_record (rows, _)}, [])}] ) -> - walkList + walk_list (rows |> List.map (fun (li, e) -> ExprRecordRow (li, e))) t comments - | Pexp_extension extension -> walkExtension extension t comments - | Pexp_letexception (extensionConstructor, expr2) -> - let leading, comments = partitionLeadingTrailing comments expr.pexp_loc in + | Pexp_extension extension -> walk_extension extension t comments + | Pexp_letexception (extension_constructor, expr2) -> + let leading, comments = partition_leading_trailing comments expr.pexp_loc in attach t.leading - {expr.pexp_loc with loc_end = extensionConstructor.pext_loc.loc_end} + {expr.pexp_loc with loc_end = extension_constructor.pext_loc.loc_end} leading; let leading, inside, trailing = - partitionByLoc comments extensionConstructor.pext_loc + partition_by_loc comments extension_constructor.pext_loc in - attach t.leading extensionConstructor.pext_loc leading; - walkExtensionConstructor extensionConstructor t inside; - let afterExtConstr, rest = - partitionByOnSameLine extensionConstructor.pext_loc trailing + 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 in - attach t.trailing extensionConstructor.pext_loc afterExtConstr; - if isBlockExpr expr2 then walkExpression expr2 t rest + attach t.trailing extension_constructor.pext_loc after_ext_constr; + if is_block_expr expr2 then walk_expression expr2 t rest else - let leading, inside, trailing = partitionByLoc rest expr2.pexp_loc in + let leading, inside, trailing = partition_by_loc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpression expr2 t inside; + walk_expression expr2 t inside; attach t.trailing expr2.pexp_loc trailing - | Pexp_letmodule (stringLoc, modExpr, expr2) -> - let leading, comments = partitionLeadingTrailing comments expr.pexp_loc in + | Pexp_letmodule (string_loc, mod_expr, expr2) -> + let leading, comments = partition_leading_trailing comments expr.pexp_loc in attach t.leading - {expr.pexp_loc with loc_end = modExpr.pmod_loc.loc_end} + {expr.pexp_loc with loc_end = mod_expr.pmod_loc.loc_end} leading; - 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 + 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 in - attach t.leading modExpr.pmod_loc beforeModExpr; - walkModuleExpr modExpr t insideModExpr; - let afterModExpr, rest = - partitionByOnSameLine modExpr.pmod_loc afterModExpr + 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 in - attach t.trailing modExpr.pmod_loc afterModExpr; - if isBlockExpr expr2 then walkExpression expr2 t rest + attach t.trailing mod_expr.pmod_loc after_mod_expr; + if is_block_expr expr2 then walk_expression expr2 t rest else - let leading, inside, trailing = partitionByLoc rest expr2.pexp_loc in + let leading, inside, trailing = partition_by_loc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpression expr2 t inside; + walk_expression expr2 t inside; attach t.trailing expr2.pexp_loc trailing | Pexp_assert expr | Pexp_lazy expr -> - if isBlockExpr expr then walkExpression expr t comments + if is_block_expr expr then walk_expression expr t comments else - let leading, inside, trailing = partitionByLoc comments expr.pexp_loc in + let leading, inside, trailing = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpression expr t inside; + walk_expression expr t inside; attach t.trailing expr.pexp_loc trailing - | Pexp_coerce (expr, optTypexpr, typexpr) -> - let leading, inside, trailing = partitionByLoc comments expr.pexp_loc in + | Pexp_coerce (expr, opt_typexpr, typexpr) -> + let leading, inside, trailing = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpression expr t inside; - let afterExpr, rest = partitionAdjacentTrailing expr.pexp_loc trailing in - attach t.trailing expr.pexp_loc afterExpr; + 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 rest = - match optTypexpr with + match opt_typexpr with | Some typexpr -> let leading, inside, trailing = - partitionByLoc comments typexpr.ptyp_loc + partition_by_loc comments typexpr.ptyp_loc in attach t.leading typexpr.ptyp_loc leading; - walkCoreType typexpr t inside; - let afterTyp, rest = - partitionAdjacentTrailing typexpr.ptyp_loc trailing + walk_core_type typexpr t inside; + let after_typ, rest = + partition_adjacent_trailing typexpr.ptyp_loc trailing in - attach t.trailing typexpr.ptyp_loc afterTyp; + attach t.trailing typexpr.ptyp_loc after_typ; rest | None -> rest in - let leading, inside, trailing = partitionByLoc rest typexpr.ptyp_loc in + let leading, inside, trailing = partition_by_loc rest typexpr.ptyp_loc in attach t.leading typexpr.ptyp_loc leading; - walkCoreType typexpr t inside; + walk_core_type typexpr t inside; attach t.trailing typexpr.ptyp_loc trailing | Pexp_constraint (expr, typexpr) -> - let leading, inside, trailing = partitionByLoc comments expr.pexp_loc in + let leading, inside, trailing = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - 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 + 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 attach t.leading typexpr.ptyp_loc leading; - walkCoreType typexpr t inside; + walk_core_type 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 "::"}, _) -> - walkList - (collectListExprs [] expr |> List.map (fun e -> Expression e)) + walk_list + (collect_list_exprs [] expr |> List.map (fun e -> Expression e)) t comments | Pexp_construct (longident, args) -> ( - let leading, trailing = partitionLeadingTrailing comments longident.loc in + let leading, trailing = partition_leading_trailing comments longident.loc in attach t.leading longident.loc leading; match args with | Some expr -> - let afterLongident, rest = - partitionAdjacentTrailing longident.loc trailing + let after_longident, rest = + partition_adjacent_trailing longident.loc trailing in - attach t.trailing longident.loc afterLongident; - walkExpression expr t rest + attach t.trailing longident.loc after_longident; + walk_expression expr t rest | None -> attach t.trailing longident.loc trailing) | Pexp_variant (_label, None) -> () - | Pexp_variant (_label, Some expr) -> walkExpression expr t comments + | Pexp_variant (_label, Some expr) -> walk_expression expr t comments | Pexp_array exprs | Pexp_tuple exprs -> - walkList (exprs |> List.map (fun e -> Expression e)) t comments - | Pexp_record (rows, spreadExpr) -> + walk_list (exprs |> List.map (fun e -> Expression e)) t comments + | Pexp_record (rows, spread_expr) -> if rows = [] then attach t.inside expr.pexp_loc comments else let comments = - match spreadExpr with + match spread_expr with | None -> comments | Some expr -> let leading, inside, trailing = - partitionByLoc comments expr.pexp_loc + partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpression expr t inside; - let afterExpr, rest = - partitionAdjacentTrailing expr.pexp_loc trailing + walk_expression expr t inside; + let after_expr, rest = + partition_adjacent_trailing expr.pexp_loc trailing in - attach t.trailing expr.pexp_loc afterExpr; + attach t.trailing expr.pexp_loc after_expr; rest in - walkList + walk_list (rows |> List.map (fun (li, e) -> ExprRecordRow (li, e))) t comments | Pexp_field (expr, longident) -> - let leading, inside, trailing = partitionByLoc comments expr.pexp_loc in + let leading, inside, trailing = partition_by_loc comments expr.pexp_loc in let trailing = - if isBlockExpr expr then ( - let afterExpr, rest = - partitionAdjacentTrailing expr.pexp_loc trailing + if is_block_expr expr then ( + let after_expr, rest = + partition_adjacent_trailing expr.pexp_loc trailing in - walkExpression expr t (List.concat [leading; inside; afterExpr]); + walk_expression expr t (List.concat [leading; inside; after_expr]); rest) else ( attach t.leading expr.pexp_loc leading; - walkExpression expr t inside; + walk_expression expr t inside; trailing) 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 + 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 attach t.leading longident.loc leading; attach t.trailing longident.loc trailing | Pexp_setfield (expr1, longident, expr2) -> - let leading, inside, trailing = partitionByLoc comments expr1.pexp_loc in + let leading, inside, trailing = partition_by_loc comments expr1.pexp_loc in let rest = - if isBlockExpr expr1 then ( - let afterExpr, rest = - partitionAdjacentTrailing expr1.pexp_loc trailing + if is_block_expr expr1 then ( + let after_expr, rest = + partition_adjacent_trailing expr1.pexp_loc trailing in - walkExpression expr1 t (List.concat [leading; inside; afterExpr]); + walk_expression expr1 t (List.concat [leading; inside; after_expr]); rest) else - let afterExpr, rest = - partitionAdjacentTrailing expr1.pexp_loc trailing + let after_expr, rest = + partition_adjacent_trailing expr1.pexp_loc trailing in attach t.leading expr1.pexp_loc leading; - walkExpression expr1 t inside; - attach t.trailing expr1.pexp_loc afterExpr; + walk_expression expr1 t inside; + attach t.trailing expr1.pexp_loc after_expr; rest in - let beforeLongident, afterLongident = - partitionLeadingTrailing rest longident.loc + let before_longident, after_longident = + partition_leading_trailing rest longident.loc in - attach t.leading longident.loc beforeLongident; - let afterLongident, rest = - partitionAdjacentTrailing longident.loc afterLongident + attach t.leading longident.loc before_longident; + let after_longident, rest = + partition_adjacent_trailing longident.loc after_longident in - attach t.trailing longident.loc afterLongident; - if isBlockExpr expr2 then walkExpression expr2 t rest + attach t.trailing longident.loc after_longident; + if is_block_expr expr2 then walk_expression expr2 t rest else - let leading, inside, trailing = partitionByLoc rest expr2.pexp_loc in + let leading, inside, trailing = partition_by_loc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpression expr2 t inside; + walk_expression expr2 t inside; attach t.trailing expr2.pexp_loc trailing - | Pexp_ifthenelse (ifExpr, thenExpr, elseExpr) -> ( - let leading, rest = partitionLeadingTrailing comments expr.pexp_loc in + | Pexp_ifthenelse (if_expr, then_expr, else_expr) -> ( + let leading, rest = partition_leading_trailing comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - let leading, inside, trailing = partitionByLoc rest ifExpr.pexp_loc in + let leading, inside, trailing = partition_by_loc rest if_expr.pexp_loc in let comments = - if isBlockExpr ifExpr then ( - let afterExpr, comments = - partitionAdjacentTrailing ifExpr.pexp_loc trailing + if is_block_expr if_expr then ( + let after_expr, comments = + partition_adjacent_trailing if_expr.pexp_loc trailing in - walkExpression ifExpr t (List.concat [leading; inside; afterExpr]); + walk_expression if_expr t (List.concat [leading; inside; after_expr]); comments) else ( - attach t.leading ifExpr.pexp_loc leading; - walkExpression ifExpr t inside; - let afterExpr, comments = - partitionAdjacentTrailing ifExpr.pexp_loc trailing + 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 in - attach t.trailing ifExpr.pexp_loc afterExpr; + attach t.trailing if_expr.pexp_loc after_expr; comments) in - let leading, inside, trailing = partitionByLoc comments thenExpr.pexp_loc in + let leading, inside, trailing = partition_by_loc comments then_expr.pexp_loc in let comments = - if isBlockExpr thenExpr then ( - let afterExpr, trailing = - partitionAdjacentTrailing thenExpr.pexp_loc trailing + if is_block_expr then_expr then ( + let after_expr, trailing = + partition_adjacent_trailing then_expr.pexp_loc trailing in - walkExpression thenExpr t (List.concat [leading; inside; afterExpr]); + walk_expression then_expr t (List.concat [leading; inside; after_expr]); trailing) else ( - attach t.leading thenExpr.pexp_loc leading; - walkExpression thenExpr t inside; - let afterExpr, comments = - partitionAdjacentTrailing thenExpr.pexp_loc trailing + 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 in - attach t.trailing thenExpr.pexp_loc afterExpr; + attach t.trailing then_expr.pexp_loc after_expr; comments) in - match elseExpr with + match else_expr with | None -> () | Some expr -> - if isBlockExpr expr || isIfThenElseExpr expr then - walkExpression expr t comments + if is_block_expr expr || is_if_then_else_expr expr then + walk_expression expr t comments else - let leading, inside, trailing = partitionByLoc comments expr.pexp_loc in + let leading, inside, trailing = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpression expr t inside; + walk_expression expr t inside; attach t.trailing expr.pexp_loc trailing) | Pexp_while (expr1, expr2) -> - let leading, inside, trailing = partitionByLoc comments expr1.pexp_loc in + let leading, inside, trailing = partition_by_loc comments expr1.pexp_loc in let rest = - if isBlockExpr expr1 then ( - let afterExpr, rest = - partitionAdjacentTrailing expr1.pexp_loc trailing + if is_block_expr expr1 then ( + let after_expr, rest = + partition_adjacent_trailing expr1.pexp_loc trailing in - walkExpression expr1 t (List.concat [leading; inside; afterExpr]); + walk_expression expr1 t (List.concat [leading; inside; after_expr]); rest) else ( attach t.leading expr1.pexp_loc leading; - walkExpression expr1 t inside; - let afterExpr, rest = - partitionAdjacentTrailing expr1.pexp_loc trailing + walk_expression expr1 t inside; + let after_expr, rest = + partition_adjacent_trailing expr1.pexp_loc trailing in - attach t.trailing expr1.pexp_loc afterExpr; + attach t.trailing expr1.pexp_loc after_expr; rest) in - if isBlockExpr expr2 then walkExpression expr2 t rest + if is_block_expr expr2 then walk_expression expr2 t rest else - let leading, inside, trailing = partitionByLoc rest expr2.pexp_loc in + let leading, inside, trailing = partition_by_loc rest expr2.pexp_loc in attach t.leading expr2.pexp_loc leading; - walkExpression expr2 t inside; + walk_expression expr2 t inside; attach t.trailing expr2.pexp_loc trailing | Pexp_for (pat, expr1, expr2, _, expr3) -> - let leading, inside, trailing = partitionByLoc comments pat.ppat_loc in + let leading, inside, trailing = partition_by_loc comments pat.ppat_loc in attach t.leading pat.ppat_loc leading; - 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 + 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 attach t.leading expr1.pexp_loc leading; - 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 + 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 attach t.leading expr2.pexp_loc leading; - 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 + 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 else - let leading, inside, trailing = partitionByLoc rest expr3.pexp_loc in + let leading, inside, trailing = partition_by_loc rest expr3.pexp_loc in attach t.leading expr3.pexp_loc leading; - walkExpression expr3 t inside; + walk_expression expr3 t inside; attach t.trailing expr3.pexp_loc trailing - | 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 + | 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 attach t.leading case.pc_lhs.ppat_loc before; - 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 + 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 attach t.leading expr1.pexp_loc before; - 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 + 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 let after = - if isBlockExpr case.pc_rhs then ( - let afterExpr, rest = - partitionAdjacentTrailing case.pc_rhs.pexp_loc after + if is_block_expr case.pc_rhs then ( + let after_expr, rest = + partition_adjacent_trailing case.pc_rhs.pexp_loc after in - walkExpression case.pc_rhs t (List.concat [before; inside; afterExpr]); + walk_expression case.pc_rhs t (List.concat [before; inside; after_expr]); rest) else ( attach t.leading case.pc_rhs.pexp_loc before; - walkExpression case.pc_rhs t inside; + walk_expression case.pc_rhs t inside; after) in - let afterExpr, rest = - partitionAdjacentTrailing case.pc_rhs.pexp_loc after + let after_expr, rest = + partition_adjacent_trailing case.pc_rhs.pexp_loc after in - attach t.trailing case.pc_rhs.pexp_loc afterExpr; + attach t.trailing case.pc_rhs.pexp_loc after_expr; let before, inside, after = - partitionByLoc rest elseBranch.pc_rhs.pexp_loc + partition_by_loc rest else_branch.pc_rhs.pexp_loc in let after = - if isBlockExpr elseBranch.pc_rhs then ( - let afterExpr, rest = - partitionAdjacentTrailing elseBranch.pc_rhs.pexp_loc after + if is_block_expr else_branch.pc_rhs then ( + let after_expr, rest = + partition_adjacent_trailing else_branch.pc_rhs.pexp_loc after in - walkExpression elseBranch.pc_rhs t - (List.concat [before; inside; afterExpr]); + walk_expression else_branch.pc_rhs t + (List.concat [before; inside; after_expr]); rest) else ( - attach t.leading elseBranch.pc_rhs.pexp_loc before; - walkExpression elseBranch.pc_rhs t inside; + attach t.leading else_branch.pc_rhs.pexp_loc before; + walk_expression else_branch.pc_rhs t inside; after) in - attach t.trailing elseBranch.pc_rhs.pexp_loc after + attach t.trailing else_branch.pc_rhs.pexp_loc after | Pexp_match (expr, cases) | Pexp_try (expr, cases) -> - let before, inside, after = partitionByLoc comments expr.pexp_loc in + let before, inside, after = partition_by_loc comments expr.pexp_loc in let after = - if isBlockExpr expr then ( - let afterExpr, rest = partitionAdjacentTrailing expr.pexp_loc after in - walkExpression expr t (List.concat [before; inside; afterExpr]); + 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]); rest) else ( attach t.leading expr.pexp_loc before; - walkExpression expr t inside; + walk_expression expr t inside; after) in - 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 + 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 (* unary expression: todo use parsetreeviewer *) | Pexp_apply ( { @@ -1272,11 +1272,11 @@ and walkExpression expr t comments = Longident.Lident ("~+" | "~+." | "~-" | "~-." | "not" | "!"); }; }, - [(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 + [(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 (* binary expression *) | Pexp_apply ( { @@ -1291,44 +1291,44 @@ and walkExpression expr t comments = }; }, [(Nolabel, operand1); (Nolabel, operand2)] ) -> - let before, inside, after = partitionByLoc comments operand1.pexp_loc in + let before, inside, after = partition_by_loc comments operand1.pexp_loc in attach t.leading operand1.pexp_loc before; - walkExpression operand1 t inside; - let afterOperand1, rest = - partitionAdjacentTrailing operand1.pexp_loc after + walk_expression operand1 t inside; + let after_operand1, rest = + partition_adjacent_trailing operand1.pexp_loc after in - attach t.trailing operand1.pexp_loc afterOperand1; - let before, inside, after = partitionByLoc rest operand2.pexp_loc in + attach t.trailing operand1.pexp_loc after_operand1; + let before, inside, after = partition_by_loc rest operand2.pexp_loc in attach t.leading operand2.pexp_loc before; - walkExpression operand2 t inside; + walk_expression 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, parentExpr); (Nolabel, memberExpr)] ) -> - walkList [Expression parentExpr; Expression memberExpr] t comments + [(Nolabel, parent_expr); (Nolabel, member_expr)] ) -> + walk_list [Expression parent_expr; Expression member_expr] t comments | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "set")}}, - [(Nolabel, parentExpr); (Nolabel, memberExpr); (Nolabel, targetExpr)] ) + [(Nolabel, parent_expr); (Nolabel, member_expr); (Nolabel, target_expr)] ) -> - walkList - [Expression parentExpr; Expression memberExpr; Expression targetExpr] + walk_list + [Expression parent_expr; Expression member_expr; Expression target_expr] t comments - | Pexp_apply (callExpr, arguments) -> - let before, inside, after = partitionByLoc comments callExpr.pexp_loc in + | Pexp_apply (call_expr, arguments) -> + let before, inside, after = partition_by_loc comments call_expr.pexp_loc in let after = - if isBlockExpr callExpr then ( - let afterExpr, rest = - partitionAdjacentTrailing callExpr.pexp_loc after + if is_block_expr call_expr then ( + let after_expr, rest = + partition_adjacent_trailing call_expr.pexp_loc after in - walkExpression callExpr t (List.concat [before; inside; afterExpr]); + walk_expression call_expr t (List.concat [before; inside; after_expr]); rest) else ( - attach t.leading callExpr.pexp_loc before; - walkExpression callExpr t inside; + attach t.leading call_expr.pexp_loc before; + walk_expression call_expr t inside; after) in - if ParsetreeViewer.isJsxExpression expr then ( + if ParsetreeViewer.is_jsx_expression expr then ( let props = arguments |> List.filter (fun (label, _) -> @@ -1337,16 +1337,16 @@ and walkExpression expr t comments = | Asttypes.Nolabel -> false | _ -> true) in - let maybeChildren = + let maybe_children = arguments |> List.find_opt (fun (label, _) -> label = Asttypes.Labelled "children") in - match maybeChildren with + match maybe_children with (* There is no need to deal with this situation as the children cannot be NONE *) | None -> () | Some (_, children) -> - let leading, inside, _ = partitionByLoc after children.pexp_loc in + let leading, inside, _ = partition_by_loc 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 afterExpr, _ = - partitionAdjacentTrailing callExpr.pexp_loc after + let after_expr, _ = + partition_adjacent_trailing call_expr.pexp_loc after in - attach t.trailing callExpr.pexp_loc afterExpr + attach t.trailing call_expr.pexp_loc after_expr else - walkList (props |> List.map (fun (_, e) -> ExprArgument e)) t leading; - walkExpression children t inside) + walk_list (props |> List.map (fun (_, e) -> ExprArgument e)) t leading; + walk_expression children t inside) else - 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 + 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 | Pexp_fun (_, _, _, _) | Pexp_newtype _ -> ( - let _, parameters, returnExpr = funExpr expr in + let _, parameters, return_expr = fun_expr expr in let comments = - visitListButContinueWithRemainingComments ~newlineDelimited:false - ~walkNode:walkExprPararameter - ~getLoc:(fun (_attrs, _argLbl, exprOpt, pattern) -> + visit_list_but_continue_with_remaining_comments ~newline_delimited:false + ~walk_node:walk_expr_pararameter + ~get_loc:(fun (_attrs, _argLbl, expr_opt, pattern) -> let open Parsetree in - let startPos = + let start_pos = match pattern.ppat_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs -> loc.loc_start | _ -> pattern.ppat_loc.loc_start in - match exprOpt with - | None -> {pattern.ppat_loc with loc_start = startPos} + match expr_opt with + | None -> {pattern.ppat_loc with loc_start = start_pos} | Some expr -> { pattern.ppat_loc with - loc_start = startPos; + loc_start = start_pos; loc_end = expr.pexp_loc.loc_end; }) parameters t comments in - match returnExpr.pexp_desc with + match return_expr.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 = partitionByLoc comments typ.ptyp_loc in + let leading, inside, trailing = partition_by_loc comments typ.ptyp_loc in attach t.leading typ.ptyp_loc leading; - walkCoreType typ t inside; - let afterTyp, comments = - partitionAdjacentTrailing typ.ptyp_loc trailing + walk_core_type typ t inside; + let after_typ, comments = + partition_adjacent_trailing typ.ptyp_loc trailing in - attach t.trailing typ.ptyp_loc afterTyp; - if isBlockExpr expr then walkExpression expr t comments + attach t.trailing typ.ptyp_loc after_typ; + if is_block_expr expr then walk_expression expr t comments else - let leading, inside, trailing = partitionByLoc comments expr.pexp_loc in + let leading, inside, trailing = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpression expr t inside; + walk_expression expr t inside; attach t.trailing expr.pexp_loc trailing | _ -> - if isBlockExpr returnExpr then walkExpression returnExpr t comments + if is_block_expr return_expr then walk_expression return_expr t comments else let leading, inside, trailing = - partitionByLoc comments returnExpr.pexp_loc + partition_by_loc comments return_expr.pexp_loc in - attach t.leading returnExpr.pexp_loc leading; - walkExpression returnExpr t inside; - attach t.trailing returnExpr.pexp_loc trailing) + attach t.leading return_expr.pexp_loc leading; + walk_expression return_expr t inside; + attach t.trailing return_expr.pexp_loc trailing) | _ -> () -and walkExprPararameter (_attrs, _argLbl, exprOpt, pattern) t comments = - let leading, inside, trailing = partitionByLoc comments pattern.ppat_loc in +and walk_expr_pararameter (_attrs, _argLbl, expr_opt, pattern) t comments = + let leading, inside, trailing = partition_by_loc comments pattern.ppat_loc in attach t.leading pattern.ppat_loc leading; - walkPattern pattern t inside; - match exprOpt with + walk_pattern pattern t inside; + match expr_opt with | Some expr -> - let _afterPat, rest = partitionAdjacentTrailing pattern.ppat_loc trailing in + let _afterPat, rest = partition_adjacent_trailing pattern.ppat_loc trailing in attach t.trailing pattern.ppat_loc trailing; - if isBlockExpr expr then walkExpression expr t rest + if is_block_expr expr then walk_expression expr t rest else - let leading, inside, trailing = partitionByLoc rest expr.pexp_loc in + let leading, inside, trailing = partition_by_loc rest expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpression expr t inside; + walk_expression expr t inside; attach t.trailing expr.pexp_loc trailing | None -> attach t.trailing pattern.ppat_loc trailing -and walkExprArgument expr t comments = +and walk_expr_argument expr t comments = match expr.Parsetree.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _attrs -> - let leading, trailing = partitionLeadingTrailing comments loc in + let leading, trailing = partition_leading_trailing comments loc in attach t.leading loc leading; - let afterLabel, rest = partitionAdjacentTrailing loc trailing in - attach t.trailing loc afterLabel; - let before, inside, after = partitionByLoc rest expr.pexp_loc in + let after_label, rest = partition_adjacent_trailing loc trailing in + attach t.trailing loc after_label; + let before, inside, after = partition_by_loc rest expr.pexp_loc in attach t.leading expr.pexp_loc before; - walkExpression expr t inside; + walk_expression expr t inside; attach t.trailing expr.pexp_loc after | _ -> - let before, inside, after = partitionByLoc comments expr.pexp_loc in + let before, inside, after = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc before; - walkExpression expr t inside; + walk_expression expr t inside; attach t.trailing expr.pexp_loc after -and walkCase (case : Parsetree.case) t comments = - let before, inside, after = partitionByLoc comments case.pc_lhs.ppat_loc in +and walk_case (case : Parsetree.case) t comments = + let before, inside, after = partition_by_loc 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 *) - 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; + 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; let comments = match case.pc_guard with | Some 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]) + 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]) else ( attach t.leading expr.pexp_loc before; - walkExpression expr t inside; - attach t.trailing expr.pexp_loc afterExpr); + walk_expression expr t inside; + attach t.trailing expr.pexp_loc after_expr); rest | None -> rest in - if isBlockExpr case.pc_rhs then walkExpression case.pc_rhs t comments + if is_block_expr case.pc_rhs then walk_expression case.pc_rhs t comments else - let before, inside, after = partitionByLoc comments case.pc_rhs.pexp_loc in + let before, inside, after = partition_by_loc comments case.pc_rhs.pexp_loc in attach t.leading case.pc_rhs.pexp_loc before; - walkExpression case.pc_rhs t inside; + walk_expression case.pc_rhs t inside; attach t.trailing case.pc_rhs.pexp_loc after -and walkExprRecordRow (longident, expr) t comments = - let beforeLongident, afterLongident = - partitionLeadingTrailing comments longident.loc +and walk_expr_record_row (longident, expr) t comments = + let before_longident, after_longident = + partition_leading_trailing comments longident.loc in - attach t.leading longident.loc beforeLongident; - let afterLongident, rest = - partitionAdjacentTrailing longident.loc afterLongident + attach t.leading longident.loc before_longident; + let after_longident, rest = + partition_adjacent_trailing longident.loc after_longident in - attach t.trailing longident.loc afterLongident; - let leading, inside, trailing = partitionByLoc rest expr.pexp_loc in + attach t.trailing longident.loc after_longident; + let leading, inside, trailing = partition_by_loc rest expr.pexp_loc in attach t.leading expr.pexp_loc leading; - walkExpression expr t inside; + walk_expression expr t inside; attach t.trailing expr.pexp_loc trailing -and walkExtensionConstructor extConstr t comments = +and walk_extension_constructor ext_constr t comments = let leading, trailing = - partitionLeadingTrailing comments extConstr.pext_name.loc + partition_leading_trailing comments ext_constr.pext_name.loc in - attach t.leading extConstr.pext_name.loc leading; - let afterName, rest = - partitionAdjacentTrailing extConstr.pext_name.loc trailing + attach t.leading ext_constr.pext_name.loc leading; + let after_name, rest = + partition_adjacent_trailing ext_constr.pext_name.loc trailing in - attach t.trailing extConstr.pext_name.loc afterName; - walkExtensionConstructorKind extConstr.pext_kind t rest + attach t.trailing ext_constr.pext_name.loc after_name; + walk_extension_constructor_kind ext_constr.pext_kind t rest -and walkExtensionConstructorKind kind t comments = +and walk_extension_constructor_kind kind t comments = match kind with | Pext_rebind longident -> - let leading, trailing = partitionLeadingTrailing comments longident.loc in + let leading, trailing = partition_leading_trailing comments longident.loc in attach t.leading longident.loc leading; attach t.trailing longident.loc trailing - | Pext_decl (constructorArguments, maybeTypExpr) -> ( - let rest = walkConstructorArguments constructorArguments t comments in - match maybeTypExpr with + | Pext_decl (constructor_arguments, maybe_typ_expr) -> ( + let rest = walk_constructor_arguments constructor_arguments t comments in + match maybe_typ_expr with | None -> () | Some typexpr -> - let before, inside, after = partitionByLoc rest typexpr.ptyp_loc in + let before, inside, after = partition_by_loc rest typexpr.ptyp_loc in attach t.leading typexpr.ptyp_loc before; - walkCoreType typexpr t inside; + walk_core_type typexpr t inside; attach t.trailing typexpr.ptyp_loc after) -and walkModuleExpr modExpr t comments = - match modExpr.pmod_desc with +and walk_module_expr mod_expr t comments = + match mod_expr.pmod_desc with | Pmod_ident longident -> - let before, after = partitionLeadingTrailing comments longident.loc in + let before, after = partition_leading_trailing comments longident.loc in attach t.leading longident.loc before; attach t.trailing longident.loc after - | Pmod_structure [] -> attach t.inside modExpr.pmod_loc comments - | Pmod_structure structure -> walkStructure structure t comments - | Pmod_extension extension -> walkExtension extension t comments + | 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_unpack expr -> - let before, inside, after = partitionByLoc comments expr.pexp_loc in + let before, inside, after = partition_by_loc comments expr.pexp_loc in attach t.leading expr.pexp_loc before; - walkExpression expr t inside; + walk_expression 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 = partitionByLoc comments modexpr.pmod_loc in + let before, inside, after = partition_by_loc comments modexpr.pmod_loc in attach t.leading modexpr.pmod_loc before; - walkModuleExpr modexpr t inside; - let after, rest = partitionAdjacentTrailing modexpr.pmod_loc after in + walk_module_expr modexpr t inside; + let after, rest = partition_adjacent_trailing modexpr.pmod_loc after in attach t.trailing modexpr.pmod_loc after; - let before, inside, after = partitionByLoc rest modtype.pmty_loc in + let before, inside, after = partition_by_loc rest modtype.pmty_loc in attach t.leading modtype.pmty_loc before; - walkModType modtype t inside; + walk_mod_type modtype t inside; attach t.trailing modtype.pmty_loc after) else - let before, inside, after = partitionByLoc comments modtype.pmty_loc in + let before, inside, after = partition_by_loc 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 + walk_mod_type modtype t inside; + let after, rest = partition_adjacent_trailing modtype.pmty_loc after in attach t.trailing modtype.pmty_loc after; - let before, inside, after = partitionByLoc rest modexpr.pmod_loc in + let before, inside, after = partition_by_loc rest modexpr.pmod_loc in attach t.leading modexpr.pmod_loc before; - walkModuleExpr modexpr t inside; + walk_module_expr modexpr t inside; attach t.trailing modexpr.pmod_loc after | Pmod_apply (_callModExpr, _argModExpr) -> - let modExprs = modExprApply modExpr in - walkList (modExprs |> List.map (fun me -> ModuleExpr me)) t comments + let mod_exprs = mod_expr_apply mod_expr in + walk_list (mod_exprs |> List.map (fun me -> ModuleExpr me)) t comments | Pmod_functor _ -> ( - let parameters, returnModExpr = modExprFunctor modExpr in + let parameters, return_mod_expr = mod_expr_functor mod_expr in let comments = - visitListButContinueWithRemainingComments - ~getLoc:(fun (_, lbl, modTypeOption) -> - match modTypeOption with + visit_list_but_continue_with_remaining_comments + ~get_loc:(fun (_, lbl, mod_type_option) -> + match mod_type_option with | None -> lbl.Asttypes.loc - | Some modType -> - {lbl.loc with loc_end = modType.Parsetree.pmty_loc.loc_end}) - ~walkNode:walkModExprParameter ~newlineDelimited:false parameters t + | 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 comments in - 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 + 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 | _ -> let before, inside, after = - partitionByLoc comments returnModExpr.pmod_loc + partition_by_loc comments return_mod_expr.pmod_loc in - attach t.leading returnModExpr.pmod_loc before; - walkModuleExpr returnModExpr t inside; - attach t.trailing returnModExpr.pmod_loc after) + 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) -and walkModExprParameter parameter t comments = - let _attrs, lbl, modTypeOption = parameter in - let leading, trailing = partitionLeadingTrailing comments lbl.loc in +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 attach t.leading lbl.loc leading; - match modTypeOption with + match mod_type_option with | None -> attach t.trailing lbl.loc trailing - | 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 + | 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 | Pmty_ident longident | Pmty_alias longident -> - let leading, trailing = partitionLeadingTrailing comments longident.loc in + let leading, trailing = partition_leading_trailing comments longident.loc in attach t.leading longident.loc leading; attach t.trailing longident.loc trailing - | 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 + | 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 (* TODO: withConstraints*) | Pmty_functor _ -> - let parameters, returnModType = functorType modType in + let parameters, return_mod_type = functor_type mod_type in let comments = - visitListButContinueWithRemainingComments - ~getLoc:(fun (_, lbl, modTypeOption) -> - match modTypeOption with + visit_list_but_continue_with_remaining_comments + ~get_loc:(fun (_, lbl, mod_type_option) -> + match mod_type_option with | None -> lbl.Asttypes.loc - | 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 + | 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 comments in let before, inside, after = - partitionByLoc comments returnModType.pmty_loc + partition_by_loc comments return_mod_type.pmty_loc in - attach t.leading returnModType.pmty_loc before; - walkModType returnModType t inside; - attach t.trailing returnModType.pmty_loc after + 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 -and walkModTypeParameter (_, lbl, modTypeOption) t comments = - let leading, trailing = partitionLeadingTrailing comments lbl.loc in +and walk_mod_type_parameter (_, lbl, mod_type_option) t comments = + let leading, trailing = partition_leading_trailing comments lbl.loc in attach t.leading lbl.loc leading; - match modTypeOption with + match mod_type_option with | None -> attach t.trailing lbl.loc trailing - | 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 = + | 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 = let open Location in match pat.Parsetree.ppat_desc with | _ when comments = [] -> () | Ppat_alias (pat, alias) -> - let leading, inside, trailing = partitionByLoc comments pat.ppat_loc in + let leading, inside, trailing = partition_by_loc comments pat.ppat_loc in attach t.leading pat.ppat_loc leading; - walkPattern pat t inside; - let afterPat, rest = partitionAdjacentTrailing pat.ppat_loc trailing in + walk_pattern pat t inside; + let after_pat, rest = partition_adjacent_trailing pat.ppat_loc trailing in attach t.leading pat.ppat_loc leading; - 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 + 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 | Ppat_tuple [] | Ppat_array [] | Ppat_construct ({txt = Longident.Lident "()"}, _) | Ppat_construct ({txt = Longident.Lident "[]"}, _) -> attach t.inside pat.ppat_loc comments | Ppat_array patterns -> - walkList (patterns |> List.map (fun p -> Pattern p)) t comments + walk_list (patterns |> List.map (fun p -> Pattern p)) t comments | Ppat_tuple patterns -> - walkList (patterns |> List.map (fun p -> Pattern p)) t comments + walk_list (patterns |> List.map (fun p -> Pattern p)) t comments | Ppat_construct ({txt = Longident.Lident "::"}, _) -> - walkList - (collectListPatterns [] pat |> List.map (fun p -> Pattern p)) + walk_list + (collect_list_patterns [] pat |> List.map (fun p -> Pattern p)) t comments | Ppat_construct (constr, None) -> - let beforeConstr, afterConstr = - partitionLeadingTrailing comments constr.loc + let before_constr, after_constr = + partition_leading_trailing comments constr.loc in - attach t.leading constr.loc beforeConstr; - attach t.trailing constr.loc afterConstr + attach t.leading constr.loc before_constr; + attach t.trailing constr.loc after_constr | Ppat_construct (constr, Some pat) -> - let leading, trailing = partitionLeadingTrailing comments constr.loc in + let leading, trailing = partition_leading_trailing comments constr.loc in attach t.leading constr.loc leading; - let afterConstructor, rest = - partitionAdjacentTrailing constr.loc trailing + let after_constructor, rest = + partition_adjacent_trailing constr.loc trailing in - attach t.trailing constr.loc afterConstructor; - let leading, inside, trailing = partitionByLoc rest pat.ppat_loc in + attach t.trailing constr.loc after_constructor; + let leading, inside, trailing = partition_by_loc rest pat.ppat_loc in attach t.leading pat.ppat_loc leading; - walkPattern pat t inside; + walk_pattern pat t inside; attach t.trailing pat.ppat_loc trailing | Ppat_variant (_label, None) -> () - | Ppat_variant (_label, Some pat) -> walkPattern pat t comments + | Ppat_variant (_label, Some pat) -> walk_pattern pat t comments | Ppat_type _ -> () - | Ppat_record (recordRows, _) -> - walkList - (recordRows |> List.map (fun (li, p) -> PatternRecordRow (li, p))) + | Ppat_record (record_rows, _) -> + walk_list + (record_rows |> List.map (fun (li, p) -> PatternRecordRow (li, p))) t comments | Ppat_or _ -> - walkList - (Res_parsetree_viewer.collectOrPatternChain pat + walk_list + (Res_parsetree_viewer.collect_or_pattern_chain pat |> List.map (fun pat -> Pattern pat)) t comments | Ppat_constraint (pattern, typ) -> - let beforePattern, insidePattern, afterPattern = - partitionByLoc comments pattern.ppat_loc + let before_pattern, inside_pattern, after_pattern = + partition_by_loc comments pattern.ppat_loc in - attach t.leading pattern.ppat_loc beforePattern; - walkPattern pattern t insidePattern; - let afterPattern, rest = - partitionAdjacentTrailing pattern.ppat_loc afterPattern + 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 in - 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 + 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 | Ppat_lazy pattern | Ppat_exception pattern -> - let leading, inside, trailing = partitionByLoc comments pattern.ppat_loc in + let leading, inside, trailing = partition_by_loc comments pattern.ppat_loc in attach t.leading pattern.ppat_loc leading; - walkPattern pattern t inside; + walk_pattern pattern t inside; attach t.trailing pattern.ppat_loc trailing - | 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 + | 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 | _ -> () (* name: firstName *) -and walkPatternRecordRow row t comments = +and walk_pattern_record_row row t comments = match row with (* punned {x}*) - | ( {Location.txt = Longident.Lident ident; loc = longidentLoc}, + | ( {Location.txt = Longident.Lident ident; loc = longident_loc}, {Parsetree.ppat_desc = Ppat_var {txt; _}} ) when ident = txt -> - let beforeLbl, afterLbl = partitionLeadingTrailing comments longidentLoc in - attach t.leading longidentLoc beforeLbl; - attach t.trailing longidentLoc afterLbl + 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 | longident, pattern -> - 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 + 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 attach t.leading pattern.ppat_loc leading; - walkPattern pattern t inside; + walk_pattern pattern t inside; attach t.trailing pattern.ppat_loc trailing -and walkRowField (rowField : Parsetree.row_field) t comments = - match rowField with +and walk_row_field (row_field : Parsetree.row_field) t comments = + match row_field with | Parsetree.Rtag ({loc}, _, _, _) -> - let before, after = partitionLeadingTrailing comments loc in + let before, after = partition_leading_trailing comments loc in attach t.leading loc before; attach t.trailing loc after | Rinherit _ -> () -and walkCoreType typ t comments = +and walk_core_type typ t comments = match typ.Parsetree.ptyp_desc with | _ when comments = [] -> () | Ptyp_tuple typexprs -> - walkList (typexprs |> List.map (fun ct -> CoreType ct)) t comments - | Ptyp_extension extension -> walkExtension extension t comments - | Ptyp_package packageType -> walkPackageType packageType t comments + 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 | Ptyp_alias (typexpr, _alias) -> - let beforeTyp, insideTyp, afterTyp = - partitionByLoc comments typexpr.ptyp_loc + let before_typ, inside_typ, after_typ = + partition_by_loc comments typexpr.ptyp_loc in - attach t.leading typexpr.ptyp_loc beforeTyp; - walkCoreType typexpr t insideTyp; - attach t.trailing typexpr.ptyp_loc afterTyp + attach t.leading typexpr.ptyp_loc before_typ; + walk_core_type typexpr t inside_typ; + attach t.trailing typexpr.ptyp_loc after_typ | Ptyp_poly (strings, typexpr) -> let comments = - visitListButContinueWithRemainingComments - ~getLoc:(fun n -> n.Asttypes.loc) - ~walkNode:(fun longident t comments -> - let beforeLongident, afterLongident = - partitionLeadingTrailing comments longident.loc + 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 in - attach t.leading longident.loc beforeLongident; - attach t.trailing longident.loc afterLongident) - ~newlineDelimited:false strings t comments + attach t.leading longident.loc before_longident; + attach t.trailing longident.loc after_longident) + ~newline_delimited:false strings t comments in - let beforeTyp, insideTyp, afterTyp = - partitionByLoc comments typexpr.ptyp_loc + let before_typ, inside_typ, after_typ = + partition_by_loc comments typexpr.ptyp_loc in - 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 + 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 | Ptyp_constr ({txt = Lident "function$"}, [({ptyp_desc = Ptyp_arrow _} as desc); _]) -> - walkCoreType desc t comments + walk_core_type desc t comments | Ptyp_constr (longident, typexprs) -> - let beforeLongident, _afterLongident = - partitionLeadingTrailing comments longident.loc + let before_longident, _afterLongident = + partition_leading_trailing comments longident.loc in - let afterLongident, rest = - partitionAdjacentTrailing longident.loc comments + let after_longident, rest = + partition_adjacent_trailing longident.loc comments in - attach t.leading longident.loc beforeLongident; - attach t.trailing longident.loc afterLongident; - walkList (typexprs |> List.map (fun ct -> CoreType ct)) t rest + 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 | Ptyp_arrow _ -> - let _, parameters, typexpr = arrowType typ in - let comments = walkTypeParameters parameters t comments in - let beforeTyp, insideTyp, afterTyp = - partitionByLoc comments typexpr.ptyp_loc + 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 in - 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 + 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 | _ -> () -and walkTypObjectFields fields t comments = - walkList (fields |> List.map (fun f -> ObjectField f)) t comments +and walk_typ_object_fields fields t comments = + walk_list (fields |> List.map (fun f -> ObjectField f)) t comments -and walkObjectField field t comments = +and walk_object_field field t comments = match field with | Otag (lbl, _, typexpr) -> - 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 + 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 | _ -> () -and walkTypeParameters typeParameters t comments = - visitListButContinueWithRemainingComments - ~getLoc:(fun (_, _, typexpr) -> +and walk_type_parameters type_parameters t comments = + visit_list_but_continue_with_remaining_comments + ~get_loc:(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) - ~walkNode:walkTypeParameter ~newlineDelimited:false typeParameters t + ~walk_node:walk_type_parameter ~newline_delimited:false type_parameters t comments -and walkTypeParameter (_attrs, _lbl, typexpr) t comments = - let beforeTyp, insideTyp, afterTyp = - partitionByLoc comments typexpr.ptyp_loc +and walk_type_parameter (_attrs, _lbl, typexpr) t comments = + let before_typ, inside_typ, after_typ = + partition_by_loc comments typexpr.ptyp_loc in - 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 + 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 in - attach t.leading longident.loc beforeLongident; - let afterLongident, rest = - partitionAdjacentTrailing longident.loc afterLongident + attach t.leading longident.loc before_longident; + let after_longident, rest = + partition_adjacent_trailing longident.loc after_longident in - attach t.trailing longident.loc afterLongident; - walkPackageConstraints packageConstraints t rest + attach t.trailing longident.loc after_longident; + walk_package_constraints package_constraints t rest -and walkPackageConstraints packageConstraints t comments = - walkList - (packageConstraints |> List.map (fun (li, te) -> PackageConstraint (li, te))) +and walk_package_constraints package_constraints t comments = + walk_list + (package_constraints |> List.map (fun (li, te) -> PackageConstraint (li, te))) t comments -and walkPackageConstraint packageConstraint t comments = - let longident, typexpr = packageConstraint in - let beforeLongident, afterLongident = - partitionLeadingTrailing comments longident.loc +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 beforeLongident; - let afterLongident, rest = - partitionAdjacentTrailing longident.loc afterLongident + attach t.leading longident.loc before_longident; + let after_longident, rest = + partition_adjacent_trailing longident.loc after_longident in - 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 + attach t.trailing longident.loc after_longident; + 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 -and walkExtension extension t comments = +and walk_extension extension t comments = let id, payload = extension in - 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 = + 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 = match payload with - | PStr s -> walkStructure s t comments + | PStr s -> walk_structure s t comments | _ -> () diff --git a/jscomp/syntax/src/res_core.ml b/jscomp/syntax/src/res_core.ml index 96e7a30345..bbbbf2cd49 100644 --- a/jscomp/syntax/src/res_core.ml +++ b/jscomp/syntax/src/res_core.ml @@ -8,59 +8,59 @@ module Scanner = Res_scanner module Parser = Res_parser module LoopProgress = struct - let listRest list = + let list_rest list = match list with | [] -> assert false | _ :: rest -> rest end -let mkLoc startLoc endLoc = - Location.{loc_start = startLoc; loc_end = endLoc; loc_ghost = false} +let mk_loc start_loc end_loc = + Location.{loc_start = start_loc; loc_end = end_loc; loc_ghost = false} module Recover = struct - let defaultExpr () = + let default_expr () = let id = Location.mknoloc "rescript.exprhole" in Ast_helper.Exp.mk (Pexp_extension (id, PStr [])) - let defaultType () = + let default_type () = let id = Location.mknoloc "rescript.typehole" in Ast_helper.Typ.extension (id, PStr []) - let defaultPattern () = + let default_pattern () = let id = Location.mknoloc "rescript.patternhole" in Ast_helper.Pat.extension (id, PStr []) - let defaultModuleExpr () = Ast_helper.Mod.structure [] - let defaultModuleType () = Ast_helper.Mty.signature [] + let default_module_expr () = Ast_helper.Mod.structure [] + let default_module_type () = Ast_helper.Mty.signature [] - let defaultSignatureItem = + let default_signature_item = let id = Location.mknoloc "rescript.sigitemhole" in Ast_helper.Sig.extension (id, PStr []) - let recoverEqualGreater p = + let recover_equal_greater p = Parser.expect EqualGreater p; match p.Parser.token with | MinusGreater -> Parser.next p | _ -> () - let shouldAbortListParse p = + let should_abort_list_parse p = let rec check breadcrumbs = match breadcrumbs with | [] -> false | (grammar, _) :: rest -> - if Grammar.isPartOfList grammar p.Parser.token then true else check rest + if Grammar.is_part_of_list grammar p.Parser.token then true else check rest in check p.breadcrumbs end module ErrorMessages = struct - let listPatternSpread = + let list_pattern_spread = "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 recordPatternSpread = + let record_pattern_spread = "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 \ @@ -69,7 +69,7 @@ module ErrorMessages = struct (* let recordPatternUnderscore = "Record patterns only support one `_`, at the end." *) [@@live] - let arrayPatternSpread = + let array_pattern_spread = "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 \ @@ -78,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 recordExprSpread = + let record_expr_spread = "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 variantIdent = + let variant_ident = "A polymorphic variant (e.g. #id) must start with an alphabetical letter \ or be a number (e.g. #742)" - let experimentalIfLet expr = - let switchExpr = {expr with Parsetree.pexp_attributes = []} in + let experimental_if_let expr = + let switch_expr = {expr with Parsetree.pexp_attributes = []} in Doc.concat [ Doc.text "If-let is currently highly experimental."; @@ -97,52 +97,52 @@ module ErrorMessages = struct Doc.text "Use a regular `switch` with pattern matching instead:"; Doc.concat [ - Doc.hardLine; - Doc.hardLine; - ResPrinter.printExpression switchExpr CommentTable.empty; + Doc.hard_line; + Doc.hard_line; + ResPrinter.print_expression switch_expr CommentTable.empty; ]; ] - |> Doc.toString ~width:80 + |> Doc.to_string ~width:80 - let typeParam = + let type_param = "A type param consists of a singlequote followed by a name like `'a` or \ `'A`" - let typeVar = + let type_var = "A type variable consists of a singlequote followed by a name like `'a` or \ `'A`" - let attributeWithoutNode (attr : Parsetree.attribute) = - let {Asttypes.txt = attrName}, _ = attr in - "Did you forget to attach `" ^ attrName + let attribute_without_node (attr : Parsetree.attribute) = + let {Asttypes.txt = attr_name}, _ = attr in + "Did you forget to attach `" ^ attr_name ^ "` to an item?\n Standalone attributes start with `@@` like: `@@" - ^ attrName ^ "`" + ^ attr_name ^ "`" - let typeDeclarationNameLongident longident = + let type_declaration_name_longident longident = "A type declaration's name cannot contain a module access. Did you mean `" ^ Longident.last longident ^ "`?" - let tupleSingleElement = "A tuple needs at least two elements" + let tuple_single_element = "A tuple needs at least two elements" - let missingTildeLabeledParameter name = + let missing_tilde_labeled_parameter name = if name = "" then "A labeled parameter starts with a `~`." else "A labeled parameter starts with a `~`. Did you mean: `~" ^ name ^ "`?" - let stringInterpolationInPattern = + let string_interpolation_in_pattern = "String interpolation is not supported in pattern matching." - let spreadInRecordDeclaration = + let spread_in_record_declaration = "A record type declaration doesn't support the ... spread. Only an object \ (with quoted field names) does." - let objectQuotedFieldName name = + let object_quoted_field_name name = "An object type declaration needs quoted field names. Did you mean \"" ^ name ^ "\"?" - let forbiddenInlineRecordDeclaration = + let forbidden_inline_record_declaration = "An inline record type declaration is only allowed in a variant \ constructor's declaration" - let polyVarIntWithSuffix number = + let poly_var_int_with_suffix number = "A numeric polymorphic variant cannot be followed by a letter. Did you \ mean `#" ^ number ^ "`?" end @@ -151,35 +151,35 @@ module InExternal = struct let status = ref false end -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 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 makeExpressionOptional ~optional (e : Parsetree.expression) = - if optional then {e with pexp_attributes = optionalAttr :: e.pexp_attributes} +let make_expression_optional ~optional (e : Parsetree.expression) = + if optional then {e with pexp_attributes = optional_attr :: e.pexp_attributes} else e -let makePatternOptional ~optional (p : Parsetree.pattern) = - if optional then {p with ppat_attributes = optionalAttr :: p.ppat_attributes} +let make_pattern_optional ~optional (p : Parsetree.pattern) = + if optional then {p with ppat_attributes = optional_attr :: p.ppat_attributes} else p -let suppressFragileMatchWarningAttr = +let suppress_fragile_match_warning_attr = ( Location.mknoloc "warning", Parsetree.PStr [ Ast_helper.Str.eval (Ast_helper.Exp.constant (Pconst_string ("-4", None))); ] ) -let makeBracesAttr loc = (Location.mkloc "res.braces" loc, Parsetree.PStr []) -let templateLiteralAttr = (Location.mknoloc "res.template", Parsetree.PStr []) +let make_braces_attr loc = (Location.mkloc "res.braces" loc, Parsetree.PStr []) +let template_literal_attr = (Location.mknoloc "res.template", Parsetree.PStr []) -let taggedTemplateLiteralAttr = +let tagged_template_literal_attr = (Location.mknoloc "res.taggedTemplate", Parsetree.PStr []) -let spreadAttr = (Location.mknoloc "res.spread", Parsetree.PStr []) +let spread_attr = (Location.mknoloc "res.spread", Parsetree.PStr []) type argument = { dotted: bool; @@ -187,22 +187,22 @@ type argument = { expr: Parsetree.expression; } -type typeParameter = { +type type_parameter = { dotted: bool; attrs: Ast_helper.attrs; label: Asttypes.arg_label; typ: Parsetree.core_type; - startPos: Lexing.position; + start_pos: Lexing.position; } -type typDefOrExt = +type typ_def_or_ext = | TypeDef of { - recFlag: Asttypes.rec_flag; + rec_flag: Asttypes.rec_flag; types: Parsetree.type_declaration list; } | TypeExt of Parsetree.type_extension -type labelledParameter = +type labelled_parameter = | TermParameter of { dotted: bool; attrs: Parsetree.attributes; @@ -218,13 +218,13 @@ type labelledParameter = pos: Lexing.position; } -type recordPatternItem = +type record_pattern_item = | PatUnderscore | PatField of (Ast_helper.lid * Parsetree.pattern) type context = OrdinaryExpr | TernaryTrueBranchExpr | WhenExpr -let getClosingToken = function +let get_closing_token = function | Token.Lparen -> Token.Rparen | Lbrace -> Rbrace | Lbracket -> Rbracket @@ -232,8 +232,8 @@ let getClosingToken = function | LessThan -> GreaterThan | _ -> assert false -let rec goToClosing closingToken state = - match (state.Parser.token, closingToken) with +let rec go_to_closing closing_token state = + match (state.Parser.token, closing_token) with | Rparen, Token.Rparen | Rbrace, Rbrace | Rbracket, Rbracket @@ -242,16 +242,16 @@ let rec goToClosing closingToken state = () | ((Token.Lbracket | Lparen | Lbrace | List | LessThan) as t), _ -> Parser.next state; - goToClosing (getClosingToken t) state; - goToClosing closingToken state + go_to_closing (get_closing_token t) state; + go_to_closing closing_token state | (Rparen | Token.Rbrace | Rbracket | Eof), _ -> () (* TODO: how do report errors here? *) | _ -> Parser.next state; - goToClosing closingToken state + go_to_closing closing_token state (* Madness *) -let isEs6ArrowExpression ~inTernary p = +let is_es6_arrow_expression ~in_ternary p = Parser.lookahead p (fun state -> let async = match state.Parser.token with @@ -272,7 +272,7 @@ let isEs6ArrowExpression ~inTernary p = | EqualGreater -> true | _ -> false) | Lparen -> ( - let prevEndPos = state.prevEndPos in + let prev_end_pos = state.prev_end_pos in Parser.next state; match state.token with (* arrived at `()` here *) @@ -280,7 +280,7 @@ let isEs6ArrowExpression ~inTernary p = Parser.next state; match state.Parser.token with (* arrived at `() :` here *) - | Colon when not inTernary -> ( + | Colon when not in_ternary -> ( Parser.next state; match state.Parser.token with (* arrived at `() :typ` here *) @@ -290,7 +290,7 @@ let isEs6ArrowExpression ~inTernary p = (* arrived at `() :typ<` here *) | LessThan -> Parser.next state; - goToClosing GreaterThan state + go_to_closing GreaterThan state | _ -> ()); match state.Parser.token with (* arrived at `() :typ =>` or `() :typ<'a,'b> =>` here *) @@ -305,11 +305,11 @@ let isEs6ArrowExpression ~inTernary p = false (* (` always indicates the start of an expr, can't be es6 parameter *) | _ -> ( - goToClosing Rparen state; + go_to_closing Rparen state; match state.Parser.token with | EqualGreater -> true (* | Lbrace TODO: detect missing =>, is this possible? *) - | Colon when not inTernary -> true + | Colon when not in_ternary -> true | Rparen -> (* imagine having something as : * switch colour { @@ -321,19 +321,19 @@ let isEs6ArrowExpression ~inTernary p = * *) false | _ -> ( - Parser.nextUnsafe state; + Parser.next_unsafe 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.startPos.pos_lnum == prevEndPos.pos_lnum + | EqualGreater when state.start_pos.pos_lnum == prev_end_pos.pos_lnum -> true | _ -> false))) | _ -> false) -let isEs6ArrowFunctor p = +let is_es6_arrow_functor p = Parser.lookahead p (fun state -> match state.Parser.token with (* | Uident _ | Underscore -> *) @@ -351,14 +351,14 @@ let isEs6ArrowFunctor p = | Colon | EqualGreater -> true | _ -> false) | _ -> ( - goToClosing Rparen state; + go_to_closing Rparen state; match state.Parser.token with | EqualGreater | Lbrace -> true | Colon -> true | _ -> false)) | _ -> false) -let isEs6ArrowType p = +let is_es6_arrow_type p = Parser.lookahead p (fun state -> match state.Parser.token with | Lparen -> ( @@ -371,20 +371,20 @@ let isEs6ArrowType p = | _ -> false) | Tilde | Dot -> true | _ -> ( - goToClosing Rparen state; + go_to_closing Rparen state; match state.Parser.token with | EqualGreater -> true | _ -> false)) | Tilde -> true | _ -> false) -let buildLongident words = +let build_longident words = match List.rev words with | [] -> assert false | hd :: tl -> List.fold_left (fun p s -> Longident.Ldot (p, s)) (Lident hd) tl -let makeInfixOperator (p : Parser.t) token startPos endPos = - let stringifiedToken = +let make_infix_operator (p : Parser.t) token start_pos end_pos = + let stringified_token = if token = Token.MinusGreater then if p.uncurried_config = Legacy then "|." else "|.u" else if token = Token.PlusPlus then "^" @@ -392,73 +392,73 @@ let makeInfixOperator (p : Parser.t) token startPos endPos = 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 ~startPos ~endPos p + Parser.err ~start_pos ~end_pos p (Diagnostics.message "Did you mean `==` here?"); "=") else if token = Token.EqualEqual then "=" else if token = Token.EqualEqualEqual then "==" - else Token.toString token + else Token.to_string token in - let loc = mkLoc startPos endPos in - let operator = Location.mkloc (Longident.Lident stringifiedToken) loc in + let loc = mk_loc start_pos end_pos in + let operator = Location.mkloc (Longident.Lident stringified_token) loc in Ast_helper.Exp.ident ~loc operator -let negateString s = +let negate_string s = if String.length s > 0 && (s.[0] [@doesNotRaise]) = '-' then (String.sub [@doesNotRaise]) s 1 (String.length s - 1) else "-" ^ s -let makeUnaryExpr startPos tokenEnd token operand = +let make_unary_expr start_pos token_end 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 (negateString n, m)); + pexp_desc = Pexp_constant (Pconst_integer (negate_string n, m)); } | (Minus | MinusDot), Pexp_constant (Pconst_float (n, m)) -> - {operand with pexp_desc = Pexp_constant (Pconst_float (negateString n, m))} + {operand with pexp_desc = Pexp_constant (Pconst_float (negate_string n, m))} | (Token.Plus | PlusDot | Minus | MinusDot), _ -> - let tokenLoc = mkLoc startPos tokenEnd in - let operator = "~" ^ Token.toString token in + let token_loc = mk_loc start_pos token_end in + let operator = "~" ^ Token.to_string token in Ast_helper.Exp.apply - ~loc:(mkLoc startPos operand.Parsetree.pexp_loc.loc_end) - (Ast_helper.Exp.ident ~loc:tokenLoc - (Location.mkloc (Longident.Lident operator) tokenLoc)) + ~loc:(mk_loc start_pos operand.Parsetree.pexp_loc.loc_end) + (Ast_helper.Exp.ident ~loc:token_loc + (Location.mkloc (Longident.Lident operator) token_loc)) [(Nolabel, operand)] | Token.Bang, _ -> - let tokenLoc = mkLoc startPos tokenEnd in + let token_loc = mk_loc start_pos token_end in Ast_helper.Exp.apply - ~loc:(mkLoc startPos operand.Parsetree.pexp_loc.loc_end) - (Ast_helper.Exp.ident ~loc:tokenLoc - (Location.mkloc (Longident.Lident "not") tokenLoc)) + ~loc:(mk_loc start_pos operand.Parsetree.pexp_loc.loc_end) + (Ast_helper.Exp.ident ~loc:token_loc + (Location.mkloc (Longident.Lident "not") token_loc)) [(Nolabel, operand)] | _ -> operand -let makeListExpression loc seq extOpt = - let rec handleSeq = function +let make_list_expression loc seq ext_opt = + let rec handle_seq = function | [] -> ( - match extOpt with + match ext_opt 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 = handleSeq el in + let exp_el = handle_seq el in let loc = - mkLoc e1.Parsetree.pexp_loc.Location.loc_start exp_el.pexp_loc.loc_end + mk_loc 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 = handleSeq seq in + let expr = handle_seq seq in {expr with pexp_loc = loc} -let makeListPattern loc seq ext_opt = +let make_list_pattern loc seq ext_opt = let rec handle_seq = function | [] -> let base_case = @@ -472,7 +472,7 @@ let makeListPattern loc seq ext_opt = base_case | p1 :: pl -> let pat_pl = handle_seq pl in - let loc = mkLoc p1.Parsetree.ppat_loc.loc_start pat_pl.ppat_loc.loc_end in + let loc = mk_loc 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)) @@ -480,12 +480,12 @@ let makeListPattern loc seq ext_opt = handle_seq seq (* TODO: diagnostic reporting *) -let lidentOfPath longident = +let lident_of_path longident = match Longident.flatten longident |> List.rev with | [] -> "" | ident :: _ -> ident -let makeNewtypes ~attrs ~loc newtypes exp = +let make_newtypes ~attrs ~loc newtypes exp = let expr = List.fold_right (fun newtype exp -> Ast_helper.Exp.mk ~loc (Pexp_newtype (newtype, exp))) @@ -499,9 +499,9 @@ let makeNewtypes ~attrs ~loc newtypes exp = * into * let f = (type t u v. foo : list) => ... *) -let wrapTypeAnnotation ~loc newtypes core_type body = +let wrap_type_annotation ~loc newtypes core_type body = let exp = - makeNewtypes ~attrs:[] ~loc newtypes + make_newtypes ~attrs:[] ~loc newtypes (Ast_helper.Exp.constraint_ ~loc body core_type) in let typ = @@ -516,7 +516,7 @@ let wrapTypeAnnotation ~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 processUnderscoreApplication (p : Parser.t) args = +let process_underscore_application (p : Parser.t) args = let exp_question = ref None in let hidden_var = "__x" in let check_arg ((lab, exp) as arg) = @@ -537,36 +537,36 @@ let processUnderscoreApplication (p : Parser.t) args = (Ppat_var (Location.mkloc hidden_var loc)) ~loc:Location.none in - 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 + 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 | None -> exp_apply in (args, wrap) (* Transform A.a into a. For use with punned record fields as in {A.a, b}. *) -let removeModuleNameFromPunnedFieldValue exp = +let remove_module_name_from_punned_field_value exp = match exp.Parsetree.pexp_desc with - | Pexp_ident pathIdent -> + | Pexp_ident path_ident -> { exp with pexp_desc = - Pexp_ident {pathIdent with txt = Lident (Longident.last pathIdent.txt)}; + Pexp_ident {path_ident with txt = Lident (Longident.last path_ident.txt)}; } | _ -> exp -let rec parseLident p = - let recoverLident p = +let rec parse_lident p = + let recover_lident p = if - Token.isKeyword p.Parser.token - && p.Parser.prevEndPos.pos_lnum == p.startPos.pos_lnum + Token.is_keyword p.Parser.token + && p.Parser.prev_end_pos.pos_lnum == p.start_pos.pos_lnum then ( Parser.err p (Diagnostics.lident p.Parser.token); Parser.next p; None) else let rec loop p = - if (not (Recover.shouldAbortListParse p)) && p.token <> Eof then ( + if (not (Recover.should_abort_list_parse p)) && p.token <> Eof then ( Parser.next p; loop p) in @@ -577,69 +577,69 @@ let rec parseLident p = | Lident _ -> Some () | _ -> None in - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in match p.Parser.token with | Lident ident -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in (ident, loc) | Eof -> - Parser.err ~startPos p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); - ("_", mkLoc startPos p.prevEndPos) + Parser.err ~start_pos p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); + ("_", mk_loc start_pos p.prev_end_pos) | _ -> ( - match recoverLident p with - | Some () -> parseLident p - | None -> ("_", mkLoc startPos p.prevEndPos)) + match recover_lident p with + | Some () -> parse_lident p + | None -> ("_", mk_loc start_pos p.prev_end_pos)) -let parseIdent ~msg ~startPos p = +let parse_ident ~msg ~start_pos p = match p.Parser.token with | Lident ident | Uident ident -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in (ident, loc) | token - when Token.isKeyword token && p.prevEndPos.pos_lnum == p.startPos.pos_lnum + when Token.is_keyword token && p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> - let tokenTxt = Token.toString token in + let token_txt = Token.to_string token in let msg = - "`" ^ tokenTxt - ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" ^ tokenTxt + "`" ^ token_txt + ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" ^ token_txt ^ "\"" in - Parser.err ~startPos p (Diagnostics.message msg); + Parser.err ~start_pos p (Diagnostics.message msg); Parser.next p; - (tokenTxt, mkLoc startPos p.prevEndPos) + (token_txt, mk_loc start_pos p.prev_end_pos) | _token -> - Parser.err ~startPos p (Diagnostics.message msg); + Parser.err ~start_pos p (Diagnostics.message msg); Parser.next p; - ("", mkLoc startPos p.prevEndPos) + ("", mk_loc start_pos p.prev_end_pos) -let parseHashIdent ~startPos p = +let parse_hash_ident ~start_pos p = Parser.expect Hash p; match p.token with | String text -> Parser.next p; - (text, mkLoc startPos p.prevEndPos) + (text, mk_loc start_pos p.prev_end_pos) | Int {i; suffix} -> let () = match suffix with | Some _ -> Parser.err p - (Diagnostics.message (ErrorMessages.polyVarIntWithSuffix i)) + (Diagnostics.message (ErrorMessages.poly_var_int_with_suffix i)) | None -> () in Parser.next p; - (i, mkLoc startPos p.prevEndPos) + (i, mk_loc start_pos p.prev_end_pos) | Eof -> - Parser.err ~startPos p (Diagnostics.unexpected p.token p.breadcrumbs); - ("", mkLoc startPos p.prevEndPos) - | _ -> parseIdent ~startPos ~msg:ErrorMessages.variantIdent p + 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 (* Ldot (Ldot (Lident "Foo", "Bar"), "baz") *) -let parseValuePath p = - let startPos = p.Parser.startPos in +let parse_value_path p = + let start_pos = p.Parser.start_pos in let rec aux p path = - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in let token = p.token in Parser.next p; @@ -653,7 +653,7 @@ let parseValuePath p = Parser.err p (Diagnostics.unexpected token p.breadcrumbs); Longident.Ldot (path, "_")) else ( - Parser.err p ~startPos ~endPos:p.prevEndPos (Diagnostics.lident token); + Parser.err p ~start_pos ~end_pos:p.prev_end_pos (Diagnostics.lident token); path) in let ident = @@ -663,119 +663,119 @@ let parseValuePath p = Longident.Lident ident | Uident ident -> let res = aux p (Lident ident) in - Parser.nextUnsafe p; + Parser.next_unsafe p; res | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Parser.nextUnsafe p; + Parser.next_unsafe p; Longident.Lident "_" in - Location.mkloc ident (mkLoc startPos p.prevEndPos) + Location.mkloc ident (mk_loc start_pos p.prev_end_pos) -let parseValuePathAfterDot p = - let startPos = p.Parser.startPos in +let parse_value_path_after_dot p = + let start_pos = p.Parser.start_pos in match p.Parser.token with - | Lident _ | Uident _ -> parseValuePath p + | Lident _ | Uident _ -> parse_value_path p | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Location.mkloc (Longident.Lident "_") (mkLoc startPos p.prevEndPos) + Location.mkloc (Longident.Lident "_") (mk_loc start_pos p.prev_end_pos) -let parseValuePathTail p startPos ident = +let parse_value_path_tail p start_pos ident = let rec loop p path = match p.Parser.token with | Lident ident -> Parser.next p; Location.mkloc (Longident.Ldot (path, ident)) - (mkLoc startPos p.prevEndPos) + (mk_loc start_pos p.prev_end_pos) | 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, "_")) (mkLoc startPos p.prevEndPos) + Location.mkloc (Longident.Ldot (path, "_")) (mk_loc start_pos p.prev_end_pos) in loop p ident -let parseModuleLongIdentTail ~lowercase p startPos ident = +let parse_module_long_ident_tail ~lowercase p start_pos 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 (mkLoc startPos p.prevEndPos) + Location.mkloc lident (mk_loc start_pos p.prev_end_pos) | Uident ident -> ( Parser.next p; - let endPos = p.prevEndPos in + let end_pos = p.prev_end_pos in let lident = Longident.Ldot (acc, ident) in match p.Parser.token with | Dot -> Parser.next p; loop p lident - | _ -> Location.mkloc lident (mkLoc startPos endPos)) + | _ -> Location.mkloc lident (mk_loc start_pos end_pos)) | t -> Parser.err p (Diagnostics.uident t); - Location.mkloc (Longident.Ldot (acc, "_")) (mkLoc startPos p.prevEndPos) + Location.mkloc (Longident.Ldot (acc, "_")) (mk_loc start_pos p.prev_end_pos) in loop p ident (* Parses module identifiers: Foo Foo.Bar *) -let parseModuleLongIdent ~lowercase p = +let parse_module_long_ident ~lowercase p = (* Parser.leaveBreadcrumb p Reporting.ModuleLongIdent; *) - let startPos = p.Parser.startPos in - let moduleIdent = + let start_pos = p.Parser.start_pos in + let module_ident = match p.Parser.token with | Lident ident when lowercase -> - let loc = mkLoc startPos p.endPos in + let loc = mk_loc start_pos p.end_pos in let lident = Longident.Lident ident in Parser.next p; Location.mkloc lident loc | Uident ident -> ( let lident = Longident.Lident ident in - let endPos = p.endPos in + let end_pos = p.end_pos in Parser.next p; match p.Parser.token with | Dot -> Parser.next p; - parseModuleLongIdentTail ~lowercase p startPos lident - | _ -> Location.mkloc lident (mkLoc startPos endPos)) + parse_module_long_ident_tail ~lowercase p start_pos lident + | _ -> Location.mkloc lident (mk_loc start_pos end_pos)) | t -> Parser.err p (Diagnostics.uident t); - Location.mkloc (Longident.Lident "_") (mkLoc startPos p.prevEndPos) + Location.mkloc (Longident.Lident "_") (mk_loc start_pos p.prev_end_pos) in (* Parser.eatBreadcrumb p; *) - moduleIdent + module_ident -let verifyJsxOpeningClosingName p nameExpr = +let verify_jsx_opening_closing_name p name_expr = let closing = match p.Parser.token with | Lident lident -> Parser.next p; Longident.Lident lident - | Uident _ -> (parseModuleLongIdent ~lowercase:true p).txt + | Uident _ -> (parse_module_long_ident ~lowercase:true p).txt | _ -> Longident.Lident "" in - match nameExpr.Parsetree.pexp_desc with - | Pexp_ident openingIdent -> + match name_expr.Parsetree.pexp_desc with + | Pexp_ident opening_ident -> let opening = - let withoutCreateElement = - Longident.flatten openingIdent.txt + let without_create_element = + Longident.flatten opening_ident.txt |> List.filter (fun s -> s <> "createElement") in - match Longident.unflatten withoutCreateElement with + match Longident.unflatten without_create_element with | Some li -> li | None -> Longident.Lident "" in opening = closing | _ -> assert false -let string_of_pexp_ident nameExpr = - match nameExpr.Parsetree.pexp_desc with - | Pexp_ident openingIdent -> - Longident.flatten openingIdent.txt +let string_of_pexp_ident name_expr = + match name_expr.Parsetree.pexp_desc with + | Pexp_ident opening_ident -> + Longident.flatten opening_ident.txt |> List.filter (fun s -> s <> "createElement") |> String.concat "." | _ -> "" @@ -783,23 +783,23 @@ let string_of_pexp_ident nameExpr = (* open-def ::= * | open module-path * | open! module-path *) -let parseOpenDescription ~attrs p = - Parser.leaveBreadcrumb p Grammar.OpenDescription; - let startPos = p.Parser.startPos in +let parse_open_description ~attrs p = + Parser.leave_breadcrumb p Grammar.OpenDescription; + let start_pos = p.Parser.start_pos in Parser.expect Open p; let override = if Parser.optional p Token.Bang then Asttypes.Override else Asttypes.Fresh in - let modident = parseModuleLongIdent ~lowercase:false p in - let loc = mkLoc startPos p.prevEndPos in - Parser.eatBreadcrumb p; + 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; Ast_helper.Opn.mk ~loc ~attrs ~override modident (* constant ::= integer-literal *) (* ∣ float-literal *) (* ∣ string-literal *) -let parseConstant p = - let isNegative = +let parse_constant p = + let is_negative = match p.Parser.token with | Token.Minus -> Parser.next p; @@ -818,11 +818,11 @@ let parseConstant p = (Diagnostics.message "Invalid bigint literal. Only decimal literal is allowed for \ bigint."); - let intTxt = if isNegative then "-" ^ i else i in - Parsetree.Pconst_integer (intTxt, suffix) + let int_txt = if is_negative then "-" ^ i else i in + Parsetree.Pconst_integer (int_txt, suffix) | Float {f; suffix} -> - let floatTxt = if isNegative then "-" ^ f else f in - Parsetree.Pconst_float (floatTxt, suffix) + let float_txt = if is_negative then "-" ^ f else f in + Parsetree.Pconst_float (float_txt, suffix) | String s -> Pconst_string (s, if p.mode = ParseForTypeChecker then Some "js" else None) | Codepoint {c; original} -> @@ -836,34 +836,34 @@ let parseConstant p = Parser.err p (Diagnostics.unexpected token p.breadcrumbs); Pconst_string ("", None) in - Parser.nextUnsafe p; + Parser.next_unsafe p; constant -let parseTemplateConstant ~prefix (p : Parser.t) = +let parse_template_constant ~prefix (p : Parser.t) = (* Arrived at the ` char *) - let startPos = p.startPos in - Parser.nextTemplateLiteralToken p; + let start_pos = p.start_pos in + Parser.next_template_literal_token p; match p.token with | TemplateTail (txt, _) -> Parser.next p; Parsetree.Pconst_string (txt, prefix) | _ -> - let rec skipTokens () = + let rec skip_tokens () = if p.token <> Eof then ( Parser.next p; match p.token with | Backtick -> Parser.next p; () - | _ -> skipTokens ()) + | _ -> skip_tokens ()) in - skipTokens (); - Parser.err ~startPos ~endPos:p.prevEndPos p - (Diagnostics.message ErrorMessages.stringInterpolationInPattern); + skip_tokens (); + Parser.err ~start_pos ~end_pos:p.prev_end_pos p + (Diagnostics.message ErrorMessages.string_interpolation_in_pattern); Pconst_string ("", None) -let parseCommaDelimitedRegion p ~grammar ~closing ~f = - Parser.leaveBreadcrumb p grammar; +let parse_comma_delimited_region p ~grammar ~closing ~f = + Parser.leave_breadcrumb p grammar; let rec loop nodes = match f p with | Some node -> ( @@ -872,7 +872,7 @@ let parseCommaDelimitedRegion p ~grammar ~closing ~f = Parser.next p; loop (node :: nodes) | token when token = closing || token = Eof -> List.rev (node :: nodes) - | _ when Grammar.isListElement grammar p.token -> + | _ when Grammar.is_list_element 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: @@ -891,12 +891,12 @@ let parseCommaDelimitedRegion p ~grammar ~closing ~f = if not (p.token = Eof || p.token = closing - || Recover.shouldAbortListParse p) + || Recover.should_abort_list_parse 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.shouldAbortListParse p + if p.token = Eof || p.token = closing || Recover.should_abort_list_parse p then List.rev nodes else ( Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); @@ -904,11 +904,11 @@ let parseCommaDelimitedRegion p ~grammar ~closing ~f = loop nodes) in let nodes = loop [] in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; nodes -let parseCommaDelimitedReversedList p ~grammar ~closing ~f = - Parser.leaveBreadcrumb p grammar; +let parse_comma_delimited_reversed_list p ~grammar ~closing ~f = + Parser.leave_breadcrumb p grammar; let rec loop nodes = match f p with | Some node -> ( @@ -917,7 +917,7 @@ let parseCommaDelimitedReversedList p ~grammar ~closing ~f = Parser.next p; loop (node :: nodes) | token when token = closing || token = Eof -> node :: nodes - | _ when Grammar.isListElement grammar p.token -> + | _ when Grammar.is_list_element 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: @@ -936,12 +936,12 @@ let parseCommaDelimitedReversedList p ~grammar ~closing ~f = if not (p.token = Eof || p.token = closing - || Recover.shouldAbortListParse p) + || Recover.should_abort_list_parse 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.shouldAbortListParse p + if p.token = Eof || p.token = closing || Recover.should_abort_list_parse p then nodes else ( Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); @@ -949,18 +949,18 @@ let parseCommaDelimitedReversedList p ~grammar ~closing ~f = loop nodes) in let nodes = loop [] in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; nodes -let parseDelimitedRegion p ~grammar ~closing ~f = - Parser.leaveBreadcrumb p grammar; +let parse_delimited_region p ~grammar ~closing ~f = + Parser.leave_breadcrumb 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.shouldAbortListParse p + || Recover.should_abort_list_parse p then List.rev nodes else ( Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); @@ -968,16 +968,16 @@ let parseDelimitedRegion p ~grammar ~closing ~f = loop nodes) in let nodes = loop [] in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; nodes -let parseRegion p ~grammar ~f = - Parser.leaveBreadcrumb p grammar; +let parse_region p ~grammar ~f = + Parser.leave_breadcrumb p grammar; let rec loop nodes = match f p with | Some node -> loop (node :: nodes) | None -> - if p.Parser.token = Token.Eof || Recover.shouldAbortListParse p then + if p.Parser.token = Token.Eof || Recover.should_abort_list_parse p then List.rev nodes else ( Parser.err p (Diagnostics.unexpected p.token p.breadcrumbs); @@ -985,7 +985,7 @@ let parseRegion p ~grammar ~f = loop nodes) in let nodes = loop [] in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; nodes (* let-binding ::= pattern = expr *) @@ -1009,175 +1009,175 @@ let parseRegion p ~grammar ~f = (* ∣ [| pattern { ; pattern } [ ; ] |] *) (* ∣ char-literal .. char-literal *) (* ∣ exception pattern *) -let rec parsePattern ?(alias = true) ?(or_ = true) p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in +let rec parse_pattern ?(alias = true) ?(or_ = true) p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in let pat = match p.Parser.token with | (True | False) as token -> - let endPos = p.endPos in + let end_pos = p.end_pos in Parser.next p; - let loc = mkLoc startPos endPos in + let loc = mk_loc start_pos end_pos in Ast_helper.Pat.construct ~loc - (Location.mkloc (Longident.Lident (Token.toString token)) loc) + (Location.mkloc (Longident.Lident (Token.to_string token)) loc) None | Int _ | String _ | Float _ | Codepoint _ | Minus | Plus -> ( - let c = parseConstant p in + let c = parse_constant p in match p.token with | DotDot -> Parser.next p; - 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) + 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) | Backtick -> - let constant = parseTemplateConstant ~prefix:(Some "js") p in - Ast_helper.Pat.constant ~attrs:[templateLiteralAttr] - ~loc:(mkLoc startPos p.prevEndPos) + 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) constant | Lparen -> ( Parser.next p; match p.token with | Rparen -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in let lid = Location.mkloc (Longident.Lident "()") loc in Ast_helper.Pat.construct ~loc lid None | _ -> ( - let pat = parseConstrainedPattern p in + let pat = parse_constrained_pattern p in match p.token with | Comma -> Parser.next p; - parseTuplePattern ~attrs ~first:pat ~startPos p + parse_tuple_pattern ~attrs ~first:pat ~start_pos p | _ -> Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in { pat with ppat_loc = loc; ppat_attributes = attrs @ pat.Parsetree.ppat_attributes; })) - | Lbracket -> parseArrayPattern ~attrs p - | Lbrace -> parseRecordPattern ~attrs p + | Lbracket -> parse_array_pattern ~attrs p + | Lbrace -> parse_record_pattern ~attrs p | Underscore -> - let endPos = p.endPos in - let loc = mkLoc startPos endPos in + let end_pos = p.end_pos in + let loc = mk_loc start_pos end_pos in Parser.next p; Ast_helper.Pat.any ~loc ~attrs () | Lident ident -> ( - let endPos = p.endPos in - let loc = mkLoc startPos endPos in + let end_pos = p.end_pos in + let loc = mk_loc start_pos end_pos in Parser.next p; match p.token with | Backtick -> - let constant = parseTemplateConstant ~prefix:(Some ident) p in - Ast_helper.Pat.constant ~loc:(mkLoc startPos p.prevEndPos) constant + let constant = parse_template_constant ~prefix:(Some ident) p in + Ast_helper.Pat.constant ~loc:(mk_loc start_pos p.prev_end_pos) constant | _ -> Ast_helper.Pat.var ~loc ~attrs (Location.mkloc ident loc)) | Uident _ -> ( - let constr = parseModuleLongIdent ~lowercase:false p in + let constr = parse_module_long_ident ~lowercase:false p in match p.Parser.token with - | Lparen -> parseConstructorPatternArgs p constr startPos attrs + | Lparen -> parse_constructor_pattern_args p constr start_pos 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 = parseValuePath p in - let loc = mkLoc startPos ident.loc.loc_end in + let ident = parse_value_path p in + let loc = mk_loc start_pos 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, mkLoc startPos p.prevEndPos) + (text, mk_loc start_pos p.prev_end_pos) | Int {i; suffix} -> let () = match suffix with | Some _ -> Parser.err p - (Diagnostics.message (ErrorMessages.polyVarIntWithSuffix i)) + (Diagnostics.message (ErrorMessages.poly_var_int_with_suffix i)) | None -> () in Parser.next p; - (i, mkLoc startPos p.prevEndPos) + (i, mk_loc start_pos p.prev_end_pos) | Eof -> - Parser.err ~startPos p + Parser.err ~start_pos p (Diagnostics.unexpected p.token p.breadcrumbs); - ("", mkLoc startPos p.prevEndPos) - | _ -> parseIdent ~msg:ErrorMessages.variantIdent ~startPos p + ("", mk_loc start_pos p.prev_end_pos) + | _ -> parse_ident ~msg:ErrorMessages.variant_ident ~start_pos p in match p.Parser.token with - | Lparen -> parseVariantPatternArgs p ident startPos attrs + | Lparen -> parse_variant_pattern_args p ident start_pos attrs | _ -> Ast_helper.Pat.variant ~loc ~attrs ident None) | Exception -> Parser.next p; - let pat = parsePattern ~alias:false ~or_:false p in - let loc = mkLoc startPos p.prevEndPos in + let pat = parse_pattern ~alias:false ~or_:false p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Pat.exception_ ~loc ~attrs pat | List -> Parser.next p; - parseListPattern ~startPos ~attrs p - | Module -> parseModulePattern ~attrs p + parse_list_pattern ~start_pos ~attrs p + | Module -> parse_module_pattern ~attrs p | Percent -> - let extension = parseExtension p in - let loc = mkLoc startPos p.prevEndPos in + let extension = parse_extension p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Pat.extension ~loc ~attrs extension | Eof -> Parser.err p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); - Recover.defaultPattern () + Recover.default_pattern () | token -> ( Parser.err p (Diagnostics.unexpected token p.breadcrumbs); match - skipTokensAndMaybeRetry p ~isStartOfGrammar:Grammar.isAtomicPatternStart + skip_tokens_and_maybe_retry p ~is_start_of_grammar:Grammar.is_atomic_pattern_start with - | None -> Recover.defaultPattern () - | Some () -> parsePattern p) + | None -> Recover.default_pattern () + | Some () -> parse_pattern p) in - let pat = if alias then parseAliasPattern ~attrs pat p else pat in - if or_ then parseOrPattern pat p else pat + let pat = if alias then parse_alias_pattern ~attrs pat p else pat in + if or_ then parse_or_pattern pat p else pat -and skipTokensAndMaybeRetry p ~isStartOfGrammar = +and skip_tokens_and_maybe_retry p ~is_start_of_grammar = if - Token.isKeyword p.Parser.token - && p.Parser.prevEndPos.pos_lnum == p.startPos.pos_lnum + Token.is_keyword p.Parser.token + && p.Parser.prev_end_pos.pos_lnum == p.start_pos.pos_lnum then ( Parser.next p; None) - else if Recover.shouldAbortListParse p then - if isStartOfGrammar p.Parser.token then ( + else if Recover.should_abort_list_parse p then + if is_start_of_grammar p.Parser.token then ( Parser.next p; Some ()) else None else ( Parser.next p; let rec loop p = - if not (Recover.shouldAbortListParse p) then ( + if not (Recover.should_abort_list_parse p) then ( Parser.next p; loop p) in loop p; - if isStartOfGrammar p.Parser.token then Some () else None) + if is_start_of_grammar p.Parser.token then Some () else None) (* alias ::= pattern as lident *) -and parseAliasPattern ~attrs pattern p = +and parse_alias_pattern ~attrs pattern p = match p.Parser.token with | As -> Parser.next p; - let name, loc = parseLident p in + let name, loc = parse_lident p in let name = Location.mkloc name loc in Ast_helper.Pat.alias - ~loc:{pattern.ppat_loc with loc_end = p.prevEndPos} + ~loc:{pattern.ppat_loc with loc_end = p.prev_end_pos} ~attrs pattern name | _ -> pattern (* or ::= pattern | pattern * precedence: Red | Blue | Green is interpreted as (Red | Blue) | Green *) -and parseOrPattern pattern1 p = +and parse_or_pattern pattern1 p = let rec loop pattern1 = match p.Parser.token with | Bar -> Parser.next p; - let pattern2 = parsePattern ~or_:false p in + let pattern2 = parse_pattern ~or_:false p in let loc = {pattern1.Parsetree.ppat_loc with loc_end = pattern2.ppat_loc.loc_end} in @@ -1186,7 +1186,7 @@ and parseOrPattern pattern1 p = in loop pattern1 -and parseNonSpreadPattern ~msg p = +and parse_non_spread_pattern ~msg p = let () = match p.Parser.token with | DotDotDot -> @@ -1195,33 +1195,33 @@ and parseNonSpreadPattern ~msg p = | _ -> () in match p.Parser.token with - | token when Grammar.isPatternStart token -> ( - let pat = parsePattern p in + | token when Grammar.is_pattern_start token -> ( + let pat = parse_pattern p in match p.Parser.token with | Colon -> Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in + let typ = parse_typ_expr p in + let loc = mk_loc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in Some (Ast_helper.Pat.constraint_ ~loc pat typ) | _ -> Some pat) | _ -> None -and parseConstrainedPattern p = - let pat = parsePattern p in +and parse_constrained_pattern p = + let pat = parse_pattern p in match p.Parser.token with | Colon -> Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in + let typ = parse_typ_expr p in + let loc = mk_loc pat.ppat_loc.loc_start typ.Parsetree.ptyp_loc.loc_end in Ast_helper.Pat.constraint_ ~loc pat typ | _ -> pat -and parseConstrainedPatternRegion p = +and parse_constrained_pattern_region p = match p.Parser.token with - | token when Grammar.isPatternStart token -> Some (parseConstrainedPattern p) + | token when Grammar.is_pattern_start token -> Some (parse_constrained_pattern p) | _ -> None -and parseOptionalLabel p = +and parse_optional_label p = match p.Parser.token with | Question -> Parser.next p; @@ -1238,15 +1238,15 @@ and parseOptionalLabel p = * | field , _ * | field , _, *) -and parseRecordPatternRowField ~attrs p = - let label = parseValuePath p in +and parse_record_pattern_row_field ~attrs p = + let label = parse_value_path p in let pattern = match p.Parser.token with | Colon -> Parser.next p; - let optional = parseOptionalLabel p in - let pat = parsePattern p in - makePatternOptional ~optional pat + let optional = parse_optional_label p in + let pat = parse_pattern p in + make_pattern_optional ~optional pat | _ -> Ast_helper.Pat.var ~loc:label.loc ~attrs (Location.mkloc (Longident.last label.txt) label.loc) @@ -1254,90 +1254,90 @@ and parseRecordPatternRowField ~attrs p = (label, pattern) (* TODO: there are better representations than PatField|Underscore ? *) -and parseRecordPatternRow p = - let attrs = parseAttributes p in +and parse_record_pattern_row p = + let attrs = parse_attributes p in match p.Parser.token with | DotDotDot -> Parser.next p; - Some (true, PatField (parseRecordPatternRowField ~attrs p)) + Some (true, PatField (parse_record_pattern_row_field ~attrs p)) | Uident _ | Lident _ -> - Some (false, PatField (parseRecordPatternRowField ~attrs p)) + Some (false, PatField (parse_record_pattern_row_field ~attrs p)) | Question -> ( Parser.next p; match p.token with | Uident _ | Lident _ -> - let lid, pat = parseRecordPatternRowField ~attrs p in - Some (false, PatField (lid, makePatternOptional ~optional:true pat)) + let lid, pat = parse_record_pattern_row_field ~attrs p in + Some (false, PatField (lid, make_pattern_optional ~optional:true pat)) | _ -> None) | Underscore -> Parser.next p; Some (false, PatUnderscore) | _ -> None -and parseRecordPattern ~attrs p = - let startPos = p.startPos in +and parse_record_pattern ~attrs p = + let start_pos = p.start_pos in Parser.expect Lbrace p; - let rawFields = - parseCommaDelimitedReversedList p ~grammar:PatternRecord ~closing:Rbrace - ~f:parseRecordPatternRow + let raw_fields = + parse_comma_delimited_reversed_list p ~grammar:PatternRecord ~closing:Rbrace + ~f:parse_record_pattern_row in Parser.expect Rbrace p; - let fields, closedFlag = - let rawFields, flag = - match rawFields with + let fields, closed_flag = + let raw_fields, flag = + match raw_fields with | (_hasSpread, PatUnderscore) :: rest -> (rest, Asttypes.Open) - | rawFields -> (rawFields, Asttypes.Closed) + | raw_fields -> (raw_fields, Asttypes.Closed) in List.fold_left (fun (fields, flag) curr -> - let hasSpread, field = curr in + let has_spread, field = curr in match field with | PatField field -> - (if hasSpread then + (if has_spread then let _, pattern = field in - Parser.err ~startPos:pattern.Parsetree.ppat_loc.loc_start p - (Diagnostics.message ErrorMessages.recordPatternSpread)); + Parser.err ~start_pos:pattern.Parsetree.ppat_loc.loc_start p + (Diagnostics.message ErrorMessages.record_pattern_spread)); (field :: fields, flag) | PatUnderscore -> (fields, flag)) - ([], flag) rawFields + ([], flag) raw_fields in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Pat.record ~loc ~attrs fields closedFlag + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Pat.record ~loc ~attrs fields closed_flag -and parseTuplePattern ~attrs ~first ~startPos p = +and parse_tuple_pattern ~attrs ~first ~start_pos p = let patterns = first - :: parseCommaDelimitedRegion p ~grammar:Grammar.PatternList ~closing:Rparen - ~f:parseConstrainedPatternRegion + :: parse_comma_delimited_region p ~grammar:Grammar.PatternList ~closing:Rparen + ~f:parse_constrained_pattern_region in Parser.expect Rparen p; let () = match patterns with | [_] -> - Parser.err ~startPos ~endPos:p.prevEndPos p - (Diagnostics.message ErrorMessages.tupleSingleElement) + Parser.err ~start_pos ~end_pos:p.prev_end_pos p + (Diagnostics.message ErrorMessages.tuple_single_element) | _ -> () in - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Pat.tuple ~loc ~attrs patterns -and parsePatternRegion p = +and parse_pattern_region p = match p.Parser.token with | DotDotDot -> Parser.next p; - Some (true, parseConstrainedPattern p) - | token when Grammar.isPatternStart token -> - Some (false, parseConstrainedPattern p) + Some (true, parse_constrained_pattern p) + | token when Grammar.is_pattern_start token -> + Some (false, parse_constrained_pattern p) | _ -> None -and parseModulePattern ~attrs p = - let startPos = p.Parser.startPos in +and parse_module_pattern ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Module p; Parser.expect Lparen p; let uident = match p.token with | Uident uident -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Location.mkloc uident loc | _ -> @@ -1346,68 +1346,68 @@ and parseModulePattern ~attrs p = in match p.token with | Colon -> - let colonStart = p.Parser.startPos in + let colon_start = p.Parser.start_pos in Parser.next p; - let packageTypAttrs = parseAttributes p in - let packageType = - parsePackageType ~startPos:colonStart ~attrs:packageTypAttrs p + let package_typ_attrs = parse_attributes p in + let package_type = + parse_package_type ~start_pos:colon_start ~attrs:package_typ_attrs p in Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in let unpack = Ast_helper.Pat.unpack ~loc:uident.loc uident in - Ast_helper.Pat.constraint_ ~loc ~attrs unpack packageType + Ast_helper.Pat.constraint_ ~loc ~attrs unpack package_type | _ -> Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Pat.unpack ~loc ~attrs uident -and parseListPattern ~startPos ~attrs p = - let listPatterns = - parseCommaDelimitedReversedList p ~grammar:Grammar.PatternOcamlList - ~closing:Rbrace ~f:parsePatternRegion +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 in Parser.expect Rbrace p; - 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); + 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); pattern) else pattern in - match listPatterns with + match list_patterns with | (true, pattern) :: patterns -> - let patterns = patterns |> List.map filterSpread |> List.rev in - let pat = makeListPattern loc patterns (Some pattern) in + let patterns = patterns |> List.map filter_spread |> List.rev in + let pat = make_list_pattern loc patterns (Some pattern) in {pat with ppat_loc = loc; ppat_attributes = attrs} | patterns -> - let patterns = patterns |> List.map filterSpread |> List.rev in - let pat = makeListPattern loc patterns None in + let patterns = patterns |> List.map filter_spread |> List.rev in + let pat = make_list_pattern loc patterns None in {pat with ppat_loc = loc; ppat_attributes = attrs} -and parseArrayPattern ~attrs p = - let startPos = p.startPos in +and parse_array_pattern ~attrs p = + let start_pos = p.start_pos in Parser.expect Lbracket p; let patterns = - parseCommaDelimitedRegion p ~grammar:Grammar.PatternList ~closing:Rbracket - ~f:(parseNonSpreadPattern ~msg:ErrorMessages.arrayPatternSpread) + parse_comma_delimited_region p ~grammar:Grammar.PatternList ~closing:Rbracket + ~f:(parse_non_spread_pattern ~msg:ErrorMessages.array_pattern_spread) in Parser.expect Rbracket p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Pat.array ~loc ~attrs patterns -and parseConstructorPatternArgs p constr startPos attrs = - let lparen = p.startPos in +and parse_constructor_pattern_args p constr start_pos attrs = + let lparen = p.start_pos in Parser.expect Lparen p; let args = - parseCommaDelimitedRegion p ~grammar:Grammar.PatternList ~closing:Rparen - ~f:parseConstrainedPatternRegion + parse_comma_delimited_region p ~grammar:Grammar.PatternList ~closing:Rparen + ~f:parse_constrained_pattern_region in Parser.expect Rparen p; let args = match args with | [] -> - let loc = mkLoc lparen p.prevEndPos in + let loc = mk_loc lparen p.prev_end_pos in Some (Ast_helper.Pat.construct ~loc (Location.mkloc (Longident.Lident "()") loc) @@ -1418,24 +1418,24 @@ and parseConstructorPatternArgs p constr startPos attrs = Some pat else (* Some((1, 2)) for printer *) - Some (Ast_helper.Pat.tuple ~loc:(mkLoc lparen p.endPos) patterns) + Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) | [pattern] -> Some pattern | patterns -> - Some (Ast_helper.Pat.tuple ~loc:(mkLoc lparen p.endPos) patterns) + Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) in - Ast_helper.Pat.construct ~loc:(mkLoc startPos p.prevEndPos) ~attrs constr args + Ast_helper.Pat.construct ~loc:(mk_loc start_pos p.prev_end_pos) ~attrs constr args -and parseVariantPatternArgs p ident startPos attrs = - let lparen = p.startPos in +and parse_variant_pattern_args p ident start_pos attrs = + let lparen = p.start_pos in Parser.expect Lparen p; let patterns = - parseCommaDelimitedRegion p ~grammar:Grammar.PatternList ~closing:Rparen - ~f:parseConstrainedPatternRegion + parse_comma_delimited_region p ~grammar:Grammar.PatternList ~closing:Rparen + ~f:parse_constrained_pattern_region in let args = match patterns with | [] -> - let loc = mkLoc lparen p.prevEndPos in + let loc = mk_loc lparen p.prev_end_pos in Some (Ast_helper.Pat.construct ~loc (Location.mkloc (Longident.Lident "()") loc) @@ -1446,44 +1446,44 @@ and parseVariantPatternArgs p ident startPos attrs = Some pat else (* #ident((1, 2)) for printer *) - Some (Ast_helper.Pat.tuple ~loc:(mkLoc lparen p.endPos) patterns) + Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) | [pattern] -> Some pattern | patterns -> - Some (Ast_helper.Pat.tuple ~loc:(mkLoc lparen p.endPos) patterns) + Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) in Parser.expect Rparen p; - Ast_helper.Pat.variant ~loc:(mkLoc startPos p.prevEndPos) ~attrs ident args + Ast_helper.Pat.variant ~loc:(mk_loc start_pos p.prev_end_pos) ~attrs ident args -and parseExpr ?(context = OrdinaryExpr) p = - let expr = parseOperandExpr ~context p in - let expr = parseBinaryExpr ~context ~a:expr p 1 in - parseTernaryExpr expr p +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 (* expr ? expr : expr *) -and parseTernaryExpr leftOperand p = +and parse_ternary_expr left_operand p = match p.Parser.token with | Question -> - Parser.leaveBreadcrumb p Grammar.Ternary; + Parser.leave_breadcrumb p Grammar.Ternary; Parser.next p; - let trueBranch = parseExpr ~context:TernaryTrueBranchExpr p in + let true_branch = parse_expr ~context:TernaryTrueBranchExpr p in Parser.expect Colon p; - let falseBranch = parseExpr p in - Parser.eatBreadcrumb p; + let false_branch = parse_expr p in + Parser.eat_breadcrumb p; let loc = { - leftOperand.Parsetree.pexp_loc with - loc_start = leftOperand.pexp_loc.loc_start; - loc_end = falseBranch.Parsetree.pexp_loc.loc_end; + left_operand.Parsetree.pexp_loc with + loc_start = left_operand.pexp_loc.loc_start; + loc_end = false_branch.Parsetree.pexp_loc.loc_end; } in - Ast_helper.Exp.ifthenelse ~attrs:[ternaryAttr] ~loc leftOperand trueBranch - (Some falseBranch) - | _ -> leftOperand + Ast_helper.Exp.ifthenelse ~attrs:[ternary_attr] ~loc left_operand true_branch + (Some false_branch) + | _ -> left_operand -and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context +and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None) ?context ?parameters p = - let startPos = p.Parser.startPos in - Parser.leaveBreadcrumb p Grammar.Es6ArrowExpr; + let start_pos = p.Parser.start_pos in + Parser.leave_breadcrumb 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 @@ -1493,75 +1493,75 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context let parameters = match parameters with | Some params -> params - | None -> parseParameters p + | None -> parse_parameters p in let parameters = - let updateAttrs attrs = arrowAttrs @ attrs in - let updatePos pos = - match arrowStartPos with - | Some startPos -> startPos + let update_attrs attrs = arrow_attrs @ attrs in + let update_pos pos = + match arrow_start_pos with + | Some start_pos -> start_pos | None -> pos in match parameters with | TermParameter p :: rest -> - TermParameter {p with attrs = updateAttrs p.attrs; pos = updatePos p.pos} + TermParameter {p with attrs = update_attrs p.attrs; pos = update_pos p.pos} :: rest | TypeParameter p :: rest -> - TypeParameter {p with attrs = updateAttrs p.attrs; pos = updatePos p.pos} + TypeParameter {p with attrs = update_attrs p.attrs; pos = update_pos p.pos} :: rest | [] -> parameters in let parameters = (* Propagate any dots from type parameters to the first term *) - let rec loop ~dotInType params = + let rec loop ~dot_in_type params = match params with | (TypeParameter {dotted} as p) :: _ -> - let rest = LoopProgress.listRest params in + let rest = LoopProgress.list_rest params in (* Tell termination checker about progress *) - p :: loop ~dotInType:(dotInType || dotted) rest - | TermParameter termParam :: rest -> - TermParameter {termParam with dotted = dotInType || termParam.dotted} + 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} :: rest | [] -> [] in - loop ~dotInType:false parameters + loop ~dot_in_type:false parameters in - let returnType = + let return_type = match p.Parser.token with | Colon -> Parser.next p; - Some (parseTypExpr ~es6Arrow:false p) + Some (parse_typ_expr ~es6_arrow:false p) | _ -> None in Parser.expect EqualGreater p; let body = - let expr = parseExpr ?context p in - match returnType with + let expr = parse_expr ?context p in + match return_type with | Some typ -> Ast_helper.Exp.constraint_ - ~loc:(mkLoc expr.pexp_loc.loc_start typ.Parsetree.ptyp_loc.loc_end) + ~loc:(mk_loc expr.pexp_loc.loc_start typ.Parsetree.ptyp_loc.loc_end) expr typ | None -> expr in - Parser.eatBreadcrumb p; - let endPos = p.prevEndPos in - let termParameters = + Parser.eat_breadcrumb p; + let end_pos = p.prev_end_pos in + let term_parameters = parameters |> List.filter (function | TermParameter _ -> true | TypeParameter _ -> false) in - let bodyNeedsBraces = - let isFun = + let body_needs_braces = + let is_fun = match body.pexp_desc with | Pexp_fun _ -> true | _ -> false in - match termParameters with + match term_parameters with | TermParameter {dotted} :: _ - when p.uncurried_config |> Res_uncurried.fromDotted ~dotted && isFun -> + when p.uncurried_config |> Res_uncurried.from_dotted ~dotted && is_fun -> true - | TermParameter _ :: rest when p.uncurried_config = Legacy && isFun -> + | TermParameter _ :: rest when p.uncurried_config = Legacy && is_fun -> rest |> List.exists (function | TermParameter {dotted} -> dotted @@ -1569,44 +1569,44 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context | _ -> false in let body = - if bodyNeedsBraces then + if body_needs_braces then { body with - pexp_attributes = makeBracesAttr body.pexp_loc :: body.pexp_attributes; + pexp_attributes = make_braces_attr body.pexp_loc :: body.pexp_attributes; } else body in - let _paramNum, arrowExpr, _arity = + let _paramNum, arrow_expr, _arity = List.fold_right - (fun parameter (termParamNum, expr, arity) -> + (fun parameter (term_param_num, expr, arity) -> match parameter with | TermParameter { dotted; attrs; label = lbl; - expr = defaultExpr; + expr = default_expr; pat; - pos = startPos; + pos = start_pos; } -> - let loc = mkLoc startPos endPos in - let funExpr = - Ast_helper.Exp.fun_ ~loc ~attrs lbl defaultExpr pat expr + let loc = mk_loc start_pos end_pos in + let fun_expr = + Ast_helper.Exp.fun_ ~loc ~attrs lbl default_expr pat expr in let uncurried = - p.uncurried_config |> Res_uncurried.fromDotted ~dotted + p.uncurried_config |> Res_uncurried.from_dotted ~dotted in - 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, + 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, arity )) parameters - (List.length termParameters, body, 1) + (List.length term_parameters, body, 1) in - {arrowExpr with pexp_loc = {arrowExpr.pexp_loc with loc_start = startPos}} + {arrow_expr with pexp_loc = {arrow_expr.pexp_loc with loc_start = start_pos}} (* * dotted_parameter ::= @@ -1627,65 +1627,65 @@ and parseEs6ArrowExpression ?(arrowAttrs = []) ?(arrowStartPos = None) ?context * * labelName ::= lident *) -and parseParameter p = +and parse_parameter p = if p.Parser.token = Token.Typ || p.token = Tilde || p.token = Dot - || Grammar.isPatternStart p.token + || Grammar.is_pattern_start p.token then - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in let dotted = Parser.optional p Token.Dot in - let attrs = parseAttributes p in + let attrs = parse_attributes p in if p.Parser.token = Typ then ( Parser.next p; - let lidents = parseLidentList p in - Some (TypeParameter {dotted; attrs; locs = lidents; pos = startPos})) + let lidents = parse_lident_list p in + Some (TypeParameter {dotted; attrs; locs = lidents; pos = start_pos})) else let attrs, lbl, pat = match p.Parser.token with | Tilde -> ( Parser.next p; - let lblName, loc = parseLident p in - let propLocAttr = + let lbl_name, loc = parse_lident p in + let prop_loc_attr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in match p.Parser.token with | Comma | Equal | Rparen -> - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in ( [], - Asttypes.Labelled lblName, - Ast_helper.Pat.var ~attrs:(propLocAttr :: attrs) ~loc - (Location.mkloc lblName loc) ) + Asttypes.Labelled lbl_name, + Ast_helper.Pat.var ~attrs:(prop_loc_attr :: attrs) ~loc + (Location.mkloc lbl_name loc) ) | Colon -> - let lblEnd = p.prevEndPos in + let lbl_end = p.prev_end_pos in Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc startPos lblEnd in + let typ = parse_typ_expr p in + let loc = mk_loc start_pos lbl_end in let pat = - 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 + 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 in - ([], Asttypes.Labelled lblName, pat) + ([], Asttypes.Labelled lbl_name, pat) | As -> Parser.next p; let pat = - let pat = parseConstrainedPattern p in + let pat = parse_constrained_pattern p in { pat with - ppat_attributes = (propLocAttr :: attrs) @ pat.ppat_attributes; + ppat_attributes = (prop_loc_attr :: attrs) @ pat.ppat_attributes; } in - ([], Asttypes.Labelled lblName, pat) + ([], Asttypes.Labelled lbl_name, pat) | t -> Parser.err p (Diagnostics.unexpected t p.breadcrumbs); - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in ( [], - Asttypes.Labelled lblName, - Ast_helper.Pat.var ~attrs:(propLocAttr :: attrs) ~loc - (Location.mkloc lblName loc) )) + Asttypes.Labelled lbl_name, + Ast_helper.Pat.var ~attrs:(prop_loc_attr :: attrs) ~loc + (Location.mkloc lbl_name loc) )) | _ -> - let pattern = parseConstrainedPattern p in + let pattern = parse_constrained_pattern p in let attrs = List.concat [pattern.ppat_attributes; attrs] in ([], Asttypes.Nolabel, {pattern with ppat_attributes = attrs}) in @@ -1694,17 +1694,17 @@ and parseParameter p = Parser.next p; let lbl = match lbl with - | Asttypes.Labelled lblName -> Asttypes.Optional lblName + | Asttypes.Labelled lbl_name -> Asttypes.Optional lbl_name | Asttypes.Nolabel -> - let lblName = + let lbl_name = match pat.ppat_desc with | Ppat_var var -> var.txt | _ -> "" in - Parser.err ~startPos ~endPos:p.prevEndPos p + Parser.err ~start_pos ~end_pos:p.prev_end_pos p (Diagnostics.message - (ErrorMessages.missingTildeLabeledParameter lblName)); - Asttypes.Optional lblName + (ErrorMessages.missing_tilde_labeled_parameter lbl_name)); + Asttypes.Optional lbl_name | lbl -> lbl in match p.Parser.token with @@ -1712,9 +1712,9 @@ and parseParameter p = Parser.next p; Some (TermParameter - {dotted; attrs; label = lbl; expr = None; pat; pos = startPos}) + {dotted; attrs; label = lbl; expr = None; pat; pos = start_pos}) | _ -> - let expr = parseConstrainedOrCoercedExpr p in + let expr = parse_constrained_or_coerced_expr p in Some (TermParameter { @@ -1723,17 +1723,17 @@ and parseParameter p = label = lbl; expr = Some expr; pat; - pos = startPos; + pos = start_pos; })) | _ -> Some (TermParameter - {dotted; attrs; label = lbl; expr = None; pat; pos = startPos}) + {dotted; attrs; label = lbl; expr = None; pat; pos = start_pos}) else None -and parseParameterList p = +and parse_parameter_list p = let parameters = - parseCommaDelimitedRegion ~grammar:Grammar.ParameterList ~f:parseParameter + parse_comma_delimited_region ~grammar:Grammar.ParameterList ~f:parse_parameter ~closing:Rparen p in Parser.expect Rparen p; @@ -1746,12 +1746,12 @@ and parseParameterList p = * | (.) * | ( parameter {, parameter} [,] ) *) -and parseParameters p = - let startPos = p.Parser.startPos in +and parse_parameters p = + let start_pos = p.Parser.start_pos in match p.Parser.token with | Lident ident -> Parser.next p; - let loc = mkLoc startPos p.Parser.prevEndPos in + let loc = mk_loc start_pos p.Parser.prev_end_pos in [ TermParameter { @@ -1760,12 +1760,12 @@ and parseParameters p = label = Asttypes.Nolabel; expr = None; pat = Ast_helper.Pat.var ~loc (Location.mkloc ident loc); - pos = startPos; + pos = start_pos; }; ] | Underscore -> Parser.next p; - let loc = mkLoc startPos p.Parser.prevEndPos in + let loc = mk_loc start_pos p.Parser.prev_end_pos in [ TermParameter { @@ -1774,7 +1774,7 @@ and parseParameters p = label = Asttypes.Nolabel; expr = None; pat = Ast_helper.Pat.any ~loc (); - pos = startPos; + pos = start_pos; }; ] | Lparen -> ( @@ -1782,8 +1782,8 @@ and parseParameters p = match p.Parser.token with | Rparen -> Parser.next p; - let loc = mkLoc startPos p.Parser.prevEndPos in - let unitPattern = + let loc = mk_loc start_pos p.Parser.prev_end_pos in + let unit_pattern = Ast_helper.Pat.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None @@ -1795,8 +1795,8 @@ and parseParameters p = attrs = []; label = Asttypes.Nolabel; expr = None; - pat = unitPattern; - pos = startPos; + pat = unit_pattern; + pos = start_pos; }; ] | Dot -> ( @@ -1804,8 +1804,8 @@ and parseParameters p = match p.token with | Rparen -> Parser.next p; - let loc = mkLoc startPos p.Parser.prevEndPos in - let unitPattern = + let loc = mk_loc start_pos p.Parser.prev_end_pos in + let unit_pattern = Ast_helper.Pat.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None @@ -1817,53 +1817,53 @@ and parseParameters p = attrs = []; label = Asttypes.Nolabel; expr = None; - pat = unitPattern; - pos = startPos; + pat = unit_pattern; + pos = start_pos; }; ] | _ -> ( - match parseParameterList p with + match parse_parameter_list p with | TermParameter p :: rest -> - TermParameter {p with dotted = true; pos = startPos} :: rest + TermParameter {p with dotted = true; pos = start_pos} :: rest | TypeParameter p :: rest -> - TypeParameter {p with dotted = true; pos = startPos} :: rest + TypeParameter {p with dotted = true; pos = start_pos} :: rest | parameters -> parameters)) - | _ -> parseParameterList p) + | _ -> parse_parameter_list p) | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); [] -and parseCoercedExpr ~(expr : Parsetree.expression) p = +and parse_coerced_expr ~(expr : Parsetree.expression) p = Parser.expect ColonGreaterThan p; - let typ = parseTypExpr p in - let loc = mkLoc expr.pexp_loc.loc_start p.prevEndPos in + let typ = parse_typ_expr p in + let loc = mk_loc expr.pexp_loc.loc_start p.prev_end_pos in Ast_helper.Exp.coerce ~loc expr None typ -and parseConstrainedOrCoercedExpr p = - let expr = parseExpr p in +and parse_constrained_or_coerced_expr p = + let expr = parse_expr p in match p.Parser.token with - | ColonGreaterThan -> parseCoercedExpr ~expr p + | ColonGreaterThan -> parse_coerced_expr ~expr p | Colon -> ( Parser.next p; match p.token with | _ -> ( - let typ = parseTypExpr p in - let loc = mkLoc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in + let typ = parse_typ_expr p in + let loc = mk_loc 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 -> parseCoercedExpr ~expr p + | ColonGreaterThan -> parse_coerced_expr ~expr p | _ -> expr)) | _ -> expr -and parseConstrainedExprRegion p = +and parse_constrained_expr_region p = match p.Parser.token with - | token when Grammar.isExprStart token -> ( - let expr = parseExpr p in + | token when Grammar.is_expr_start token -> ( + let expr = parse_expr p in match p.Parser.token with | Colon -> Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in + let typ = parse_typ_expr p in + let loc = mk_loc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in Some (Ast_helper.Exp.constraint_ ~loc expr typ) | _ -> Some expr) | _ -> None @@ -1871,41 +1871,41 @@ and parseConstrainedExprRegion p = (* Atomic expressions represent unambiguous expressions. * This means that regardless of the context, these expressions * are always interpreted correctly. *) -and parseAtomicExpr p = - Parser.leaveBreadcrumb p Grammar.ExprOperand; - let startPos = p.Parser.startPos in +and parse_atomic_expr p = + Parser.leave_breadcrumb p Grammar.ExprOperand; + let start_pos = p.Parser.start_pos in let expr = match p.Parser.token with | (True | False) as token -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.construct ~loc - (Location.mkloc (Longident.Lident (Token.toString token)) loc) + (Location.mkloc (Longident.Lident (Token.to_string token)) loc) None | Int _ | String _ | Float _ | Codepoint _ -> - let c = parseConstant p in - let loc = mkLoc startPos p.prevEndPos in + let c = parse_constant p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.constant ~loc c | Backtick -> - let expr = parseTemplateExpr p in - {expr with pexp_loc = mkLoc startPos p.prevEndPos} - | Uident _ | Lident _ -> parseValueOrConstructor p - | Hash -> parsePolyVariantExpr p + 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 | Lparen -> ( Parser.next p; match p.Parser.token with | Rparen -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None | _t -> ( - let expr = parseConstrainedOrCoercedExpr p in + let expr = parse_constrained_or_coerced_expr p in match p.token with | Comma -> Parser.next p; - parseTupleExpr ~startPos ~first:expr p + parse_tuple_expr ~start_pos ~first:expr p | _ -> Parser.expect Rparen p; expr @@ -1917,123 +1917,123 @@ and parseAtomicExpr p = * with for comments. *))) | List -> Parser.next p; - parseListExpr ~startPos p + parse_list_expr ~start_pos p | Module -> Parser.next p; - parseFirstClassModuleExpr ~startPos p - | Lbracket -> parseArrayExp p - | Lbrace -> parseBracedOrRecordExpr p - | LessThan -> parseJsx 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 | Percent -> - let extension = parseExtension p in - let loc = mkLoc startPos p.prevEndPos in + let extension = parse_extension p in + let loc = mk_loc start_pos p.prev_end_pos 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.defaultExpr () + Recover.default_expr () | Eof -> - Parser.err ~startPos:p.prevEndPos p + Parser.err ~start_pos:p.prev_end_pos p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); - Recover.defaultExpr () + Recover.default_expr () | token -> ( - let errPos = p.prevEndPos in - Parser.err ~startPos:errPos p (Diagnostics.unexpected token p.breadcrumbs); + let err_pos = p.prev_end_pos in + Parser.err ~start_pos:err_pos p (Diagnostics.unexpected token p.breadcrumbs); match - skipTokensAndMaybeRetry p ~isStartOfGrammar:Grammar.isAtomicExprStart + skip_tokens_and_maybe_retry p ~is_start_of_grammar:Grammar.is_atomic_expr_start with - | None -> Recover.defaultExpr () - | Some () -> parseAtomicExpr p) + | None -> Recover.default_expr () + | Some () -> parse_atomic_expr p) in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; expr (* module(module-expr) * module(module-expr : package-type) *) -and parseFirstClassModuleExpr ~startPos p = +and parse_first_class_module_expr ~start_pos p = Parser.expect Lparen p; - let modExpr = parseModuleExpr p in - let modEndLoc = p.prevEndPos in + let mod_expr = parse_module_expr p in + let mod_end_loc = p.prev_end_pos in match p.Parser.token with | Colon -> - let colonStart = p.Parser.startPos in + let colon_start = p.Parser.start_pos in Parser.next p; - let attrs = parseAttributes p in - let packageType = parsePackageType ~startPos:colonStart ~attrs p in + let attrs = parse_attributes p in + let package_type = parse_package_type ~start_pos:colon_start ~attrs p in Parser.expect Rparen p; - 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 + 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 | _ -> Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Exp.pack ~loc modExpr + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Exp.pack ~loc mod_expr -and parseBracketAccess p expr startPos = - Parser.leaveBreadcrumb p Grammar.ExprArrayAccess; - let lbracket = p.startPos in +and parse_bracket_access p expr start_pos = + Parser.leave_breadcrumb p Grammar.ExprArrayAccess; + let lbracket = p.start_pos in Parser.expect Lbracket p; - let stringStart = p.startPos in + let string_start = p.start_pos in match p.Parser.token with | String s -> ( Parser.next p; - let stringEnd = p.prevEndPos in + let string_end = p.prev_end_pos in Parser.expect Rbracket p; - Parser.eatBreadcrumb p; - let rbracket = p.prevEndPos in + Parser.eat_breadcrumb p; + let rbracket = p.prev_end_pos in let e = - let identLoc = mkLoc stringStart stringEnd in - let loc = mkLoc startPos rbracket in - Ast_helper.Exp.send ~loc expr (Location.mkloc s identLoc) + 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) in - let e = parsePrimaryExpr ~operand:e p in - let equalStart = p.startPos in + let e = parse_primary_expr ~operand:e p in + let equal_start = p.start_pos in match p.token with | Equal -> Parser.next p; - 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 + 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 Ast_helper.Exp.apply ~loc - (Ast_helper.Exp.ident ~loc:operatorLoc - (Location.mkloc (Longident.Lident "#=") operatorLoc)) - [(Nolabel, e); (Nolabel, rhsExpr)] + (Ast_helper.Exp.ident ~loc:operator_loc + (Location.mkloc (Longident.Lident "#=") operator_loc)) + [(Nolabel, e); (Nolabel, rhs_expr)] | _ -> e) | _ -> ( - let accessExpr = parseConstrainedOrCoercedExpr p in + let access_expr = parse_constrained_or_coerced_expr p in Parser.expect Rbracket p; - Parser.eatBreadcrumb p; - let rbracket = p.prevEndPos in - let arrayLoc = mkLoc lbracket rbracket in + Parser.eat_breadcrumb p; + let rbracket = p.prev_end_pos in + let array_loc = mk_loc lbracket rbracket in match p.token with | Equal -> - Parser.leaveBreadcrumb p ExprArrayMutation; + Parser.leave_breadcrumb p ExprArrayMutation; Parser.next p; - let rhsExpr = parseExpr p in - let arraySet = - Location.mkloc (Longident.Ldot (Lident "Array", "set")) arrayLoc + let rhs_expr = parse_expr p in + let array_set = + Location.mkloc (Longident.Ldot (Lident "Array", "set")) array_loc in - 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)] + 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)] in - Parser.eatBreadcrumb p; - arraySet + Parser.eat_breadcrumb p; + array_set | _ -> - let endPos = p.prevEndPos in + let end_pos = p.prev_end_pos in let e = - 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)] + 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)] in - parsePrimaryExpr ~operand:e p) + parse_primary_expr ~operand:e p) (* * A primary expression represents * - atomic-expr @@ -2043,43 +2043,43 @@ and parseBracketAccess p expr startPos = * * The "operand" represents the expression that is operated on *) -and parsePrimaryExpr ~operand ?(noCall = false) p = - let startPos = operand.pexp_loc.loc_start in +and parse_primary_expr ~operand ?(no_call = false) p = + let start_pos = operand.pexp_loc.loc_start in let rec loop p expr = match p.Parser.token with | Dot -> ( Parser.next p; - let lident = parseValuePathAfterDot p in + let lident = parse_value_path_after_dot p in match p.Parser.token with - | Equal when noCall = false -> - Parser.leaveBreadcrumb p Grammar.ExprSetField; + | Equal when no_call = false -> + Parser.leave_breadcrumb p Grammar.ExprSetField; Parser.next 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; + 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; setfield | _ -> - let endPos = p.prevEndPos in - let loc = mkLoc startPos endPos in + let end_pos = p.prev_end_pos in + let loc = mk_loc start_pos end_pos in loop p (Ast_helper.Exp.field ~loc expr lident)) | Lbracket - 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 + 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 (parseCallExpr p expr) + loop p (parse_call_expr p expr) | Backtick - when noCall = false && p.prevEndPos.pos_lnum == p.startPos.pos_lnum -> ( + when no_call = false && p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> ( match expr.pexp_desc with - | Pexp_ident long_ident -> parseTemplateExpr ~prefix:long_ident p + | Pexp_ident long_ident -> parse_template_expr ~prefix:long_ident p | _ -> - Parser.err ~startPos:expr.pexp_loc.loc_start - ~endPos:expr.pexp_loc.loc_end p + Parser.err ~start_pos:expr.pexp_loc.loc_start + ~end_pos:expr.pexp_loc.loc_end p (Diagnostics.message "Tagged template literals are currently restricted to names like: \ json`null`."); - parseTemplateExpr p) + parse_template_expr p) | _ -> expr in loop p operand @@ -2090,31 +2090,31 @@ and parsePrimaryExpr ~operand ?(noCall = false) p = * !condition * -. 1.6 *) -and parseUnaryExpr p = - let startPos = p.Parser.startPos in +and parse_unary_expr p = + let start_pos = p.Parser.start_pos in match p.Parser.token with | (Minus | MinusDot | Plus | PlusDot | Bang) as token -> - Parser.leaveBreadcrumb p Grammar.ExprUnary; - let tokenEnd = p.endPos in + Parser.leave_breadcrumb p Grammar.ExprUnary; + let token_end = p.end_pos in Parser.next p; - let operand = parseUnaryExpr p in - let unaryExpr = makeUnaryExpr startPos tokenEnd token operand in - Parser.eatBreadcrumb p; - unaryExpr - | _ -> parsePrimaryExpr ~operand:(parseAtomicExpr p) 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 (* 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 parseOperandExpr ~context p = - let startPos = p.Parser.startPos in - let attrs = ref (parseAttributes p) in +and parse_operand_expr ~context p = + let start_pos = p.Parser.start_pos in + let attrs = ref (parse_attributes p) in let expr = match p.Parser.token with | Assert -> Parser.next p; - let expr = parseExpr p in - let loc = mkLoc startPos p.prevEndPos in + let expr = parse_expr p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.assert_ ~loc expr | Lident "async" (* we need to be careful when we're in a ternary true branch: @@ -2122,26 +2122,26 @@ and parseOperandExpr ~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 isEs6ArrowExpression ~inTernary:(context = TernaryTrueBranchExpr) p + when is_es6_arrow_expression ~in_ternary:(context = TernaryTrueBranchExpr) p -> - let arrowAttrs = !attrs in + let arrow_attrs = !attrs in let () = attrs := [] in - parseAsyncArrowExpression ~arrowAttrs p - | Await -> parseAwaitExpression p - | Try -> parseTryExpression p - | If -> parseIfOrIfLetExpression p - | For -> parseForExpression p - | While -> parseWhileExpression p - | Switch -> parseSwitchExpression p + 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 | _ -> if context != WhenExpr - && isEs6ArrowExpression ~inTernary:(context = TernaryTrueBranchExpr) p + && is_es6_arrow_expression ~in_ternary:(context = TernaryTrueBranchExpr) p then - let arrowAttrs = !attrs in + let arrow_attrs = !attrs in let () = attrs := [] in - parseEs6ArrowExpression ~arrowAttrs ~context p - else parseUnaryExpr p + parse_es6_arrow_expression ~arrow_attrs ~context p + else parse_unary_expr p in (* let endPos = p.Parser.prevEndPos in *) { @@ -2155,15 +2155,15 @@ and parseOperandExpr ~context p = * a + b * f(x) |> g(y) *) -and parseBinaryExpr ?(context = OrdinaryExpr) ?a p prec = +and parse_binary_expr ?(context = OrdinaryExpr) ?a p prec = let a = match a with | Some e -> e - | None -> parseOperandExpr ~context p + | None -> parse_operand_expr ~context p in let rec loop a = let token = p.Parser.token in - let tokenPrec = + let token_prec = match token with (* Can the minus be interpreted as a binary operator? Or is it a unary? * let w = { @@ -2180,37 +2180,37 @@ and parseBinaryExpr ?(context = OrdinaryExpr) ?a p prec = * See Scanner.isBinaryOp *) | (Minus | MinusDot | LessThan) when (not - (Scanner.isBinaryOp p.scanner.src p.startPos.pos_cnum - p.endPos.pos_cnum)) - && p.startPos.pos_lnum > p.prevEndPos.pos_lnum -> + (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 -> -1 | token -> Token.precedence token in - if tokenPrec < prec then a + if token_prec < prec then a else ( - Parser.leaveBreadcrumb p (Grammar.ExprBinaryAfterOp token); - let startPos = p.startPos in + Parser.leave_breadcrumb p (Grammar.ExprBinaryAfterOp token); + let start_pos = p.start_pos in Parser.next p; - let endPos = p.prevEndPos in - let tokenPrec = + let end_pos = p.prev_end_pos in + let token_prec = (* exponentiation operator is right-associative *) - if token = Exponentiation then tokenPrec else tokenPrec + 1 + if token = Exponentiation then token_prec else token_prec + 1 in - let b = parseBinaryExpr ~context p tokenPrec in - let loc = mkLoc a.Parsetree.pexp_loc.loc_start b.pexp_loc.loc_end 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 expr = match (token, b.pexp_desc) with - | BarGreater, Pexp_apply (funExpr, args) + | BarGreater, Pexp_apply (fun_expr, args) when p.uncurried_config = Uncurried -> - {b with pexp_desc = Pexp_apply (funExpr, args @ [(Nolabel, a)])} + {b with pexp_desc = Pexp_apply (fun_expr, args @ [(Nolabel, a)])} | BarGreater, _ when p.uncurried_config = Uncurried -> Ast_helper.Exp.apply ~loc b [(Nolabel, a)] | _ -> Ast_helper.Exp.apply ~loc - (makeInfixOperator p token startPos endPos) + (make_infix_operator p token start_pos end_pos) [(Nolabel, a); (Nolabel, b)] in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; loop expr) in loop a @@ -2248,8 +2248,8 @@ and parseBinaryExpr ?(context = OrdinaryExpr) ?a p prec = (* | _ -> false *) (* ) *) -and parseTemplateExpr ?prefix p = - let partPrefix = +and parse_template_expr ?prefix p = + let part_prefix = (* 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 @@ -2258,28 +2258,28 @@ and parseTemplateExpr ?prefix p = | Some _ -> None | None -> Some "js" in - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in - let parseParts p = + let parse_parts p = let rec aux acc = - let startPos = p.Parser.startPos in - Parser.nextTemplateLiteralToken p; + let start_pos = p.Parser.start_pos in + Parser.next_template_literal_token p; match p.token with - | TemplateTail (txt, lastPos) -> + | TemplateTail (txt, last_pos) -> Parser.next p; - let loc = mkLoc startPos lastPos in + let loc = mk_loc start_pos last_pos in let str = - Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc - (Pconst_string (txt, partPrefix)) + Ast_helper.Exp.constant ~attrs:[template_literal_attr] ~loc + (Pconst_string (txt, part_prefix)) in List.rev ((str, None) :: acc) - | TemplatePart (txt, lastPos) -> + | TemplatePart (txt, last_pos) -> Parser.next p; - let loc = mkLoc startPos lastPos in - let expr = parseExprBlock p in + let loc = mk_loc start_pos last_pos in + let expr = parse_expr_block p in let str = - Ast_helper.Exp.constant ~attrs:[templateLiteralAttr] ~loc - (Pconst_string (txt, partPrefix)) + Ast_helper.Exp.constant ~attrs:[template_literal_attr] ~loc + (Pconst_string (txt, part_prefix)) in aux ((str, Some expr) :: acc) | token -> @@ -2288,12 +2288,12 @@ and parseTemplateExpr ?prefix p = in aux [] in - let parts = parseParts p in + let parts = parse_parts p in let strings = List.map fst parts in let values = Ext_list.filter_map parts snd in - let endPos = p.Parser.endPos in + let end_pos = p.Parser.end_pos in - let genTaggedTemplateCall lident = + let gen_tagged_template_call lident = let ident = Ast_helper.Exp.ident ~attrs:[] ~loc:Location.none (Location.mknoloc lident) @@ -2305,21 +2305,21 @@ and parseTemplateExpr ?prefix p = Ast_helper.Exp.array ~attrs:[] ~loc:Location.none values in Ast_helper.Exp.apply - ~attrs:[taggedTemplateLiteralAttr] - ~loc:(mkLoc startPos endPos) ident + ~attrs:[tagged_template_literal_attr] + ~loc:(mk_loc start_pos end_pos) ident [(Nolabel, strings_array); (Nolabel, values_array)] in - let hiddenOperator = + let hidden_operator = let op = Location.mknoloc (Longident.Lident "^") in Ast_helper.Exp.ident op in let concat (e1 : Parsetree.expression) (e2 : Parsetree.expression) = - let loc = mkLoc e1.pexp_loc.loc_start e2.pexp_loc.loc_end in - Ast_helper.Exp.apply ~attrs:[templateLiteralAttr] ~loc hiddenOperator + let loc = mk_loc e1.pexp_loc.loc_start e2.pexp_loc.loc_end in + Ast_helper.Exp.apply ~attrs:[template_literal_attr] ~loc hidden_operator [(Nolabel, e1); (Nolabel, e2)] in - let genInterpolatedString () = + let gen_interpolated_string () = let subparts = List.flatten (List.map @@ -2329,7 +2329,7 @@ and parseTemplateExpr ?prefix p = | s, None -> [s]) parts) in - let exprOption = + let expr_option = List.fold_left (fun acc subpart -> Some @@ -2338,15 +2338,15 @@ and parseTemplateExpr ?prefix p = | None -> subpart)) None subparts in - match exprOption with + match expr_option with | Some expr -> expr | None -> Ast_helper.Exp.constant (Pconst_string ("", None)) in match prefix with | Some {txt = Longident.Lident ("js" | "j" | "json"); _} | None -> - genInterpolatedString () - | Some {txt = lident} -> genTaggedTemplateCall lident + gen_interpolated_string () + | Some {txt = lident} -> gen_tagged_template_call lident (* Overparse: let f = a : int => a + 1, is it (a : int) => or (a): int => * Also overparse constraints: @@ -2357,16 +2357,16 @@ and parseTemplateExpr ?prefix p = * * We want to give a nice error message in these cases * *) -and overParseConstrainedOrCoercedOrArrowExpression p expr = +and over_parse_constrained_or_coerced_or_arrow_expression p expr = match p.Parser.token with - | ColonGreaterThan -> parseCoercedExpr ~expr p + | ColonGreaterThan -> parse_coerced_expr ~expr p | Colon -> ( Parser.next p; - let typ = parseTypExpr ~es6Arrow:false p in + let typ = parse_typ_expr ~es6_arrow:false p in match p.Parser.token with | EqualGreater -> Parser.next p; - let body = parseExpr p in + let body = parse_expr p in let pat = match expr.pexp_desc with | Pexp_ident longident -> @@ -2381,19 +2381,19 @@ and overParseConstrainedOrCoercedOrArrowExpression p expr = in let arrow1 = Ast_helper.Exp.fun_ - ~loc:(mkLoc expr.pexp_loc.loc_start body.pexp_loc.loc_end) + ~loc:(mk_loc 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:(mkLoc expr.pexp_loc.loc_start body.pexp_loc.loc_end) + ~loc:(mk_loc expr.pexp_loc.loc_start body.pexp_loc.loc_end) Asttypes.Nolabel None (Ast_helper.Pat.constraint_ pat typ) body in let msg = - Doc.breakableGroup ~forceBreak:true + Doc.breakable_group ~force_break:true (Doc.concat [ Doc.text @@ -2404,25 +2404,25 @@ and overParseConstrainedOrCoercedOrArrowExpression p expr = [ Doc.line; Doc.text "1) "; - ResPrinter.printExpression arrow1 CommentTable.empty; + ResPrinter.print_expression arrow1 CommentTable.empty; Doc.line; Doc.text "2) "; - ResPrinter.printExpression arrow2 CommentTable.empty; + ResPrinter.print_expression arrow2 CommentTable.empty; ]); ]) - |> Doc.toString ~width:80 + |> Doc.to_string ~width:80 in - Parser.err ~startPos:expr.pexp_loc.loc_start ~endPos:body.pexp_loc.loc_end + Parser.err ~start_pos:expr.pexp_loc.loc_start ~end_pos:body.pexp_loc.loc_end p (Diagnostics.message msg); arrow1 | _ -> - let loc = mkLoc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in + let loc = mk_loc expr.pexp_loc.loc_start typ.ptyp_loc.loc_end in let expr = Ast_helper.Exp.constraint_ ~loc expr typ in let () = - Parser.err ~startPos:expr.pexp_loc.loc_start - ~endPos:typ.ptyp_loc.loc_end p + Parser.err ~start_pos:expr.pexp_loc.loc_start + ~end_pos:typ.ptyp_loc.loc_end p (Diagnostics.message - (Doc.breakableGroup ~forceBreak:true + (Doc.breakable_group ~force_break:true (Doc.concat [ Doc.text @@ -2432,23 +2432,23 @@ and overParseConstrainedOrCoercedOrArrowExpression p expr = (Doc.concat [ Doc.line; - ResPrinter.addParens - (ResPrinter.printExpression expr + ResPrinter.add_parens + (ResPrinter.print_expression expr CommentTable.empty); ]); ]) - |> Doc.toString ~width:80)) + |> Doc.to_string ~width:80)) in expr) | _ -> expr -and parseLetBindingBody ~startPos ~attrs p = - Parser.beginRegion p; - Parser.leaveBreadcrumb p Grammar.LetBinding; +and parse_let_binding_body ~start_pos ~attrs p = + Parser.begin_region p; + Parser.leave_breadcrumb p Grammar.LetBinding; let pat, exp = - Parser.leaveBreadcrumb p Grammar.Pattern; - let pat = parsePattern p in - Parser.eatBreadcrumb p; + Parser.leave_breadcrumb p Grammar.Pattern; + let pat = parse_pattern p in + Parser.eat_breadcrumb p; match p.Parser.token with | Colon -> ( Parser.next p; @@ -2456,36 +2456,36 @@ and parseLetBindingBody ~startPos ~attrs p = | Typ -> (* locally abstract types *) Parser.next p; - let newtypes = parseLidentList p in + let newtypes = parse_lident_list p in Parser.expect Dot p; - let typ = parseTypExpr p in + let typ = parse_typ_expr p in Parser.expect Equal p; - let expr = parseExpr p in - let loc = mkLoc startPos p.prevEndPos in - let exp, poly = wrapTypeAnnotation ~loc newtypes typ expr in + 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 pat = Ast_helper.Pat.constraint_ ~loc pat poly in (pat, exp) | _ -> - let polyType = parsePolyTypeExpr p in + let poly_type = parse_poly_type_expr p in let loc = - {pat.ppat_loc with loc_end = polyType.Parsetree.ptyp_loc.loc_end} + {pat.ppat_loc with loc_end = poly_type.Parsetree.ptyp_loc.loc_end} in - let pat = Ast_helper.Pat.constraint_ ~loc pat polyType in + let pat = Ast_helper.Pat.constraint_ ~loc pat poly_type in Parser.expect Token.Equal p; - let exp = parseExpr p in - let exp = overParseConstrainedOrCoercedOrArrowExpression p exp in + let exp = parse_expr p in + let exp = over_parse_constrained_or_coerced_or_arrow_expression p exp in (pat, exp)) | _ -> Parser.expect Token.Equal p; let exp = - overParseConstrainedOrCoercedOrArrowExpression p (parseExpr p) + over_parse_constrained_or_coerced_or_arrow_expression p (parse_expr p) in (pat, exp) in - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in let vb = Ast_helper.Vb.mk ~loc ~attrs pat exp in - Parser.eatBreadcrumb p; - Parser.endRegion p; + Parser.eat_breadcrumb p; + Parser.end_region p; vb (* TODO: find a better way? Is it possible? @@ -2503,18 +2503,18 @@ and parseLetBindingBody ~startPos ~attrs p = * Here @attr should attach to something "new": `let b = 1` * The parser state is forked, which is quite expensive… *) -and parseAttributesAndBinding (p : Parser.t) = +and parse_attributes_and_binding (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 lineOffset = p.scanner.lineOffset in + let line_offset = p.scanner.line_offset in let lnum = p.scanner.lnum in let mode = p.scanner.mode in let token = p.token in - let startPos = p.startPos in - let endPos = p.endPos in - let prevEndPos = p.prevEndPos 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 breadcrumbs = p.breadcrumbs in let errors = p.errors in let diagnostics = p.diagnostics in @@ -2522,7 +2522,7 @@ and parseAttributesAndBinding (p : Parser.t) = match p.Parser.token with | At -> ( - let attrs = parseAttributes p in + let attrs = parse_attributes p in match p.Parser.token with | And -> attrs | _ -> @@ -2530,13 +2530,13 @@ and parseAttributesAndBinding (p : Parser.t) = p.scanner.ch <- ch; p.scanner.offset <- offset; p.scanner.offset16 <- offset16; - p.scanner.lineOffset <- lineOffset; + p.scanner.line_offset <- line_offset; p.scanner.lnum <- lnum; p.scanner.mode <- mode; p.token <- token; - p.startPos <- startPos; - p.endPos <- endPos; - p.prevEndPos <- prevEndPos; + p.start_pos <- start_pos; + p.end_pos <- end_pos; + p.prev_end_pos <- prev_end_pos; p.breadcrumbs <- breadcrumbs; p.errors <- errors; p.diagnostics <- diagnostics; @@ -2545,45 +2545,45 @@ and parseAttributesAndBinding (p : Parser.t) = | _ -> [] (* definition ::= let [rec] let-binding { and let-binding } *) -and parseLetBindings ~attrs p = - let startPos = p.Parser.startPos in +and parse_let_bindings ~attrs p = + let start_pos = p.Parser.start_pos in Parser.optional p Let |> ignore; - let recFlag = + let rec_flag = if Parser.optional p Token.Rec then Asttypes.Recursive else Asttypes.Nonrecursive in - let first = parseLetBindingBody ~startPos ~attrs p in + let first = parse_let_binding_body ~start_pos ~attrs p in let rec loop p bindings = - let startPos = p.Parser.startPos in - let attrs = parseAttributesAndBinding p in + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes_and_binding p in match p.Parser.token with | And -> Parser.next p; ignore (Parser.optional p Let); (* overparse for fault tolerance *) - let letBinding = parseLetBindingBody ~startPos ~attrs p in - loop p (letBinding :: bindings) + let let_binding = parse_let_binding_body ~start_pos ~attrs p in + loop p (let_binding :: bindings) | _ -> List.rev bindings in - (recFlag, loop p [first]) + (rec_flag, loop p [first]) (* * div -> div * Foo -> Foo.createElement * Foo.Bar -> Foo.Bar.createElement *) -and parseJsxName p = +and parse_jsx_name p = let longident = match p.Parser.token with | Lident ident -> - let identStart = p.startPos in - let identEnd = p.endPos in + let ident_start = p.start_pos in + let ident_end = p.end_pos in Parser.next p; - let loc = mkLoc identStart identEnd in + let loc = mk_loc ident_start ident_end in Location.mkloc (Longident.Lident ident) loc | Uident _ -> - let longident = parseModuleLongIdent ~lowercase:true p in + let longident = parse_module_long_ident ~lowercase:true p in Location.mkloc (Longident.Ldot (longident.txt, "createElement")) longident.loc @@ -2597,76 +2597,76 @@ and parseJsxName p = in Ast_helper.Exp.ident ~loc:longident.loc longident -and parseJsxOpeningOrSelfClosingElement ~startPos p = - let jsxStartPos = p.Parser.startPos in - let name = parseJsxName p in - let jsxProps = parseJsxProps p in +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 let children = match p.Parser.token with | Forwardslash -> (* *) - let childrenStartPos = p.Parser.startPos in + let children_start_pos = p.Parser.start_pos in Parser.next p; - let childrenEndPos = p.Parser.startPos in - Scanner.popMode p.scanner Jsx; + let children_end_pos = p.Parser.start_pos in + Scanner.pop_mode p.scanner Jsx; Parser.expect GreaterThan p; - let loc = mkLoc childrenStartPos childrenEndPos in - makeListExpression loc [] None (* no children *) + let loc = mk_loc children_start_pos children_end_pos in + make_list_expression loc [] None (* no children *) | GreaterThan -> ( (* bar *) - let childrenStartPos = p.Parser.startPos in + let children_start_pos = p.Parser.start_pos in Parser.next p; - let spread, children = parseJsxChildren p in - let childrenEndPos = p.Parser.startPos in + let spread, children = parse_jsx_children p in + let children_end_pos = p.Parser.start_pos in let () = match p.token with | LessThanSlash -> Parser.next p | LessThan -> Parser.next p; Parser.expect Forwardslash p - | token when Grammar.isStructureItemStart token -> () + | token when Grammar.is_structure_item_start token -> () | _ -> Parser.expect LessThanSlash p in match p.Parser.token with - | (Lident _ | Uident _) when verifyJsxOpeningClosingName p name -> ( - Scanner.popMode p.scanner Jsx; + | (Lident _ | Uident _) when verify_jsx_opening_closing_name p name -> ( + Scanner.pop_mode p.scanner Jsx; Parser.expect GreaterThan p; - let loc = mkLoc childrenStartPos childrenEndPos in + let loc = mk_loc children_start_pos children_end_pos in match (spread, children) with | true, child :: _ -> child - | _ -> makeListExpression loc children None) + | _ -> make_list_expression loc children None) | token -> ( - Scanner.popMode p.scanner Jsx; + Scanner.pop_mode p.scanner Jsx; let () = - if Grammar.isStructureItemStart token then + if Grammar.is_structure_item_start token then let closing = "" in let msg = Diagnostics.message ("Missing " ^ closing) in - Parser.err ~startPos ~endPos:p.prevEndPos p msg + Parser.err ~start_pos ~end_pos:p.prev_end_pos 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 ~startPos ~endPos:p.prevEndPos p + Parser.err ~start_pos ~end_pos:p.prev_end_pos p (Diagnostics.message msg); Parser.expect GreaterThan p in - let loc = mkLoc childrenStartPos childrenEndPos in + let loc = mk_loc children_start_pos children_end_pos in match (spread, children) with | true, child :: _ -> child - | _ -> makeListExpression loc children None)) + | _ -> make_list_expression loc children None)) | token -> - Scanner.popMode p.scanner Jsx; + Scanner.pop_mode p.scanner Jsx; Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - makeListExpression Location.none [] None + make_list_expression Location.none [] None in - let jsxEndPos = p.prevEndPos in - let loc = mkLoc jsxStartPos jsxEndPos in + let jsx_end_pos = p.prev_end_pos in + let loc = mk_loc jsx_start_pos jsx_end_pos in Ast_helper.Exp.apply ~loc name (List.concat [ - jsxProps; + jsx_props; [ (Asttypes.Labelled "children", children); ( Asttypes.Nolabel, @@ -2684,38 +2684,38 @@ and parseJsxOpeningOrSelfClosingElement ~startPos p = * * jsx-children ::= primary-expr* * => 0 or more *) -and parseJsx p = - Scanner.setJsxMode p.Parser.scanner; - Parser.leaveBreadcrumb p Grammar.Jsx; - let startPos = p.Parser.startPos in +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 Parser.expect LessThan p; - let jsxExpr = + let jsx_expr = match p.Parser.token with - | Lident _ | Uident _ -> parseJsxOpeningOrSelfClosingElement ~startPos p + | Lident _ | Uident _ -> parse_jsx_opening_or_self_closing_element ~start_pos p | GreaterThan -> (* fragment: <> foo *) - parseJsxFragment p - | _ -> parseJsxName p + parse_jsx_fragment p + | _ -> parse_jsx_name p in - Parser.eatBreadcrumb p; - {jsxExpr with pexp_attributes = [jsxAttr]} + Parser.eat_breadcrumb p; + {jsx_expr with pexp_attributes = [jsx_attr]} (* * jsx-fragment ::= * | <> * | <> jsx-children *) -and parseJsxFragment p = - let childrenStartPos = p.Parser.startPos in +and parse_jsx_fragment p = + let children_start_pos = p.Parser.start_pos in Parser.expect GreaterThan p; - let _spread, children = parseJsxChildren p in - let childrenEndPos = p.Parser.startPos in - if p.token = LessThan then p.token <- Scanner.reconsiderLessThan p.scanner; + 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; Parser.expect LessThanSlash p; - Scanner.popMode p.scanner Jsx; + Scanner.pop_mode p.scanner Jsx; Parser.expect GreaterThan p; - let loc = mkLoc childrenStartPos childrenEndPos in - makeListExpression loc children None + let loc = mk_loc children_start_pos children_end_pos in + make_list_expression loc children None (* * jsx-prop ::= @@ -2725,19 +2725,19 @@ and parseJsxFragment p = * | lident = ?jsx_expr * | {...jsx_expr} *) -and parseJsxProp p = +and parse_jsx_prop p = match p.Parser.token with | Question | Lident _ -> ( let optional = Parser.optional p Question in - let name, loc = parseLident p in - let propLocAttr = + let name, loc = parse_lident p in + let prop_loc_attr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in (* optional punning: *) if optional then Some ( Asttypes.Optional name, - Ast_helper.Exp.ident ~attrs:[propLocAttr] ~loc + Ast_helper.Exp.ident ~attrs:[prop_loc_attr] ~loc (Location.mkloc (Longident.Lident name) loc) ) else match p.Parser.token with @@ -2745,56 +2745,56 @@ and parseJsxProp p = Parser.next p; (* no punning *) let optional = Parser.optional p Question in - Scanner.popMode p.scanner Jsx; - let attrExpr = - let e = parsePrimaryExpr ~operand:(parseAtomicExpr p) p in - {e with pexp_attributes = propLocAttr :: e.pexp_attributes} + Scanner.pop_mode p.scanner Jsx; + let attr_expr = + let e = parse_primary_expr ~operand:(parse_atomic_expr p) p in + {e with pexp_attributes = prop_loc_attr :: e.pexp_attributes} in let label = if optional then Asttypes.Optional name else Asttypes.Labelled name in - Some (label, attrExpr) + Some (label, attr_expr) | _ -> - let attrExpr = - Ast_helper.Exp.ident ~loc ~attrs:[propLocAttr] + let attr_expr = + Ast_helper.Exp.ident ~loc ~attrs:[prop_loc_attr] (Location.mkloc (Longident.Lident name) loc) in let label = if optional then Asttypes.Optional name else Asttypes.Labelled name in - Some (label, attrExpr)) + Some (label, attr_expr)) (* {...props} *) | Lbrace -> ( - Scanner.popMode p.scanner Jsx; + Scanner.pop_mode p.scanner Jsx; Parser.next p; match p.Parser.token with | DotDotDot -> ( - Scanner.popMode p.scanner Jsx; + Scanner.pop_mode p.scanner Jsx; Parser.next p; - let loc = mkLoc p.Parser.startPos p.prevEndPos in - let propLocAttr = + let loc = mk_loc p.Parser.start_pos p.prev_end_pos in + let prop_loc_attr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in - let attrExpr = - let e = parsePrimaryExpr ~operand:(parseExpr p) p in - {e with pexp_attributes = propLocAttr :: e.pexp_attributes} + let attr_expr = + let e = parse_primary_expr ~operand:(parse_expr p) p in + {e with pexp_attributes = prop_loc_attr :: e.pexp_attributes} in (* using label "spreadProps" to distinguish from others *) let label = Asttypes.Labelled "_spreadProps" in match p.Parser.token with | Rbrace -> Parser.next p; - Scanner.setJsxMode p.scanner; - Some (label, attrExpr) + Scanner.set_jsx_mode p.scanner; + Some (label, attr_expr) | _ -> None) | _ -> None) | _ -> None -and parseJsxProps p = - parseRegion ~grammar:Grammar.JsxAttribute ~f:parseJsxProp p +and parse_jsx_props p = + parse_region ~grammar:Grammar.JsxAttribute ~f:parse_jsx_prop p -and parseJsxChildren p = - Scanner.popMode p.scanner Jsx; +and parse_jsx_children p = + Scanner.pop_mode p.scanner Jsx; let rec loop p children = match p.Parser.token with | Token.Eof | LessThanSlash -> children @@ -2804,19 +2804,19 @@ and parseJsxChildren 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.reconsiderLessThan p.scanner in + let token = Scanner.reconsider_less_than p.scanner in if token = LessThan then let child = - parsePrimaryExpr ~operand:(parseAtomicExpr p) ~noCall:true p + parse_primary_expr ~operand:(parse_atomic_expr p) ~no_call:true p in loop p (child :: children) else (* LessThanSlash *) let () = p.token <- token in children - | token when Grammar.isJsxChildStart token -> + | token when Grammar.is_jsx_child_start token -> let child = - parsePrimaryExpr ~operand:(parseAtomicExpr p) ~noCall:true p + parse_primary_expr ~operand:(parse_atomic_expr p) ~no_call:true p in loop p (child :: children) | _ -> children @@ -2825,42 +2825,42 @@ and parseJsxChildren p = match p.Parser.token with | DotDotDot -> Parser.next p; - (true, [parsePrimaryExpr ~operand:(parseAtomicExpr p) ~noCall:true p]) + (true, [parse_primary_expr ~operand:(parse_atomic_expr p) ~no_call:true p]) | _ -> let children = List.rev (loop p []) in (false, children) in - Scanner.setJsxMode p.scanner; + Scanner.set_jsx_mode p.scanner; (spread, children) -and parseBracedOrRecordExpr p = - let startPos = p.Parser.startPos in +and parse_braced_or_record_expr p = + let start_pos = p.Parser.start_pos in Parser.expect Lbrace p; match p.Parser.token with | Rbrace -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.record ~loc [] None | DotDotDot -> (* beginning of record spread, parse record *) Parser.next p; - let spreadExpr = parseConstrainedOrCoercedExpr p in + let spread_expr = parse_constrained_or_coerced_expr p in Parser.expect Comma p; - let expr = parseRecordExpr ~startPos ~spread:(Some spreadExpr) [] p in + let expr = parse_record_expr ~start_pos ~spread:(Some spread_expr) [] p in Parser.expect Rbrace p; expr | String s -> ( let field = - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Location.mkloc (Longident.Lident s) loc in match p.Parser.token with | Colon -> Parser.next p; - let fieldExpr = parseExpr p in + let field_expr = parse_expr p in Parser.optional p Comma |> ignore; - let expr = parseRecordExprWithStringKeys ~startPos (field, fieldExpr) p in + let expr = parse_record_expr_with_string_keys ~start_pos (field, field_expr) p in Parser.expect Rbrace p; expr | _ -> ( @@ -2869,32 +2869,32 @@ and parseBracedOrRecordExpr p = Ast_helper.Exp.constant ~loc:field.loc (Parsetree.Pconst_string (s, tag)) in - let a = parsePrimaryExpr ~operand:constant p in - let e = parseBinaryExpr ~a p 1 in - let e = parseTernaryExpr e p 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 match p.Parser.token with | Semicolon -> - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in { expr with Parsetree.pexp_attributes = braces :: expr.Parsetree.pexp_attributes; } | Rbrace -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {e with pexp_attributes = braces :: e.pexp_attributes} | _ -> - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes})) | Question -> - let expr = parseRecordExpr ~startPos [] p in + let expr = parse_record_expr ~start_pos [] p in Parser.expect Rbrace p; expr (* @@ -2905,80 +2905,80 @@ and parseBracedOrRecordExpr p = 2) expression x which happens to wrapped in braces Due to historical reasons, we always follow 2 *) - | Lident "async" when isEs6ArrowExpression ~inTernary:false p -> - let expr = parseAsyncArrowExpression p in - let expr = parseExprBlock ~first:expr p in + | 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 Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} | Uident _ | Lident _ -> ( - let startToken = p.token in - let valueOrConstructor = parseValueOrConstructor p in - match valueOrConstructor.pexp_desc with - | Pexp_ident pathIdent -> ( - let identEndPos = p.prevEndPos in + 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 match p.Parser.token with | Comma -> Parser.next p; - let valueOrConstructor = - match startToken with - | Uident _ -> removeModuleNameFromPunnedFieldValue valueOrConstructor - | _ -> valueOrConstructor + let value_or_constructor = + match start_token with + | Uident _ -> remove_module_name_from_punned_field_value value_or_constructor + | _ -> value_or_constructor in let expr = - parseRecordExpr ~startPos [(pathIdent, valueOrConstructor)] p + parse_record_expr ~start_pos [(path_ident, value_or_constructor)] p in Parser.expect Rbrace p; expr | Colon -> ( Parser.next p; - let optional = parseOptionalLabel p in - let fieldExpr = parseExpr p in - let fieldExpr = makeExpressionOptional ~optional fieldExpr in + let optional = parse_optional_label p in + let field_expr = parse_expr p in + let field_expr = make_expression_optional ~optional field_expr in match p.token with | Rbrace -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Exp.record ~loc [(pathIdent, fieldExpr)] None + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Exp.record ~loc [(path_ident, field_expr)] None | _ -> Parser.expect Comma p; - let expr = parseRecordExpr ~startPos [(pathIdent, fieldExpr)] p in + let expr = parse_record_expr ~start_pos [(path_ident, field_expr)] p in Parser.expect Rbrace p; expr) (* error case *) | Lident _ -> - if p.prevEndPos.pos_lnum < p.startPos.pos_lnum then ( + if p.prev_end_pos.pos_lnum < p.start_pos.pos_lnum then ( Parser.expect Comma p; let expr = - parseRecordExpr ~startPos [(pathIdent, valueOrConstructor)] p + parse_record_expr ~start_pos [(path_ident, value_or_constructor)] p in Parser.expect Rbrace p; expr) else ( Parser.expect Colon p; let expr = - parseRecordExpr ~startPos [(pathIdent, valueOrConstructor)] p + parse_record_expr ~start_pos [(path_ident, value_or_constructor)] p in Parser.expect Rbrace p; expr) | Semicolon -> - let expr = parseExprBlock ~first:(Ast_helper.Exp.ident pathIdent) p in + let expr = parse_expr_block ~first:(Ast_helper.Exp.ident path_ident) p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} | Rbrace -> Parser.next p; - let expr = Ast_helper.Exp.ident ~loc:pathIdent.loc pathIdent in - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + 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 {expr with pexp_attributes = braces :: expr.pexp_attributes} | EqualGreater -> ( - let loc = mkLoc startPos identEndPos in - let ident = Location.mkloc (Longident.last pathIdent.txt) loc in + let loc = mk_loc start_pos ident_end_pos in + let ident = Location.mkloc (Longident.last path_ident.txt) loc in let a = - parseEs6ArrowExpression + parse_es6_arrow_expression ~parameters: [ TermParameter @@ -2988,129 +2988,129 @@ and parseBracedOrRecordExpr p = label = Asttypes.Nolabel; expr = None; pat = Ast_helper.Pat.var ~loc:ident.loc ident; - pos = startPos; + pos = start_pos; }; ] p in - let e = parseBinaryExpr ~a p 1 in - let e = parseTernaryExpr e p in + let e = parse_binary_expr ~a p 1 in + let e = parse_ternary_expr e p in match p.Parser.token with | Semicolon -> - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} | Rbrace -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {e with pexp_attributes = braces :: e.pexp_attributes} | _ -> - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes}) | _ -> ( - Parser.leaveBreadcrumb p Grammar.ExprBlock; + Parser.leave_breadcrumb p Grammar.ExprBlock; let a = - parsePrimaryExpr - ~operand:(Ast_helper.Exp.ident ~loc:pathIdent.loc pathIdent) + parse_primary_expr + ~operand:(Ast_helper.Exp.ident ~loc:path_ident.loc path_ident) p in - let e = parseBinaryExpr ~a p 1 in - let e = parseTernaryExpr e p in - Parser.eatBreadcrumb p; + let e = parse_binary_expr ~a p 1 in + let e = parse_ternary_expr e p in + Parser.eat_breadcrumb p; match p.Parser.token with | Semicolon -> - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} | Rbrace -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {e with pexp_attributes = braces :: e.pexp_attributes} | _ -> - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes})) | _ -> ( - 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; + 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; match p.Parser.token with | Semicolon -> - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} | Rbrace -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {e with pexp_attributes = braces :: e.pexp_attributes} | _ -> - let expr = parseExprBlock ~first:e p in + let expr = parse_expr_block ~first:e p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes})) | _ -> - let expr = parseExprBlock p in + let expr = parse_expr_block p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let braces = makeBracesAttr loc in + let loc = mk_loc start_pos p.prev_end_pos in + let braces = make_braces_attr loc in {expr with pexp_attributes = braces :: expr.pexp_attributes} -and parseRecordExprRowWithStringKey p = +and parse_record_expr_row_with_string_key p = match p.Parser.token with | String s -> ( - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; let field = Location.mkloc (Longident.Lident s) loc in match p.Parser.token with | Colon -> Parser.next p; - let fieldExpr = parseExpr p in - Some (field, fieldExpr) + let field_expr = parse_expr p in + Some (field, field_expr) | _ -> Some (field, Ast_helper.Exp.ident ~loc:field.loc field)) | _ -> None -and parseRecordExprRow p = - let attrs = parseAttributes p in +and parse_record_expr_row p = + let attrs = parse_attributes p in let () = match p.Parser.token with | Token.DotDotDot -> - Parser.err p (Diagnostics.message ErrorMessages.recordExprSpread); + Parser.err p (Diagnostics.message ErrorMessages.record_expr_spread); Parser.next p | _ -> () in match p.Parser.token with | Lident _ | Uident _ -> ( - let startToken = p.token in - let field = parseValuePath p in + let start_token = p.token in + let field = parse_value_path p in match p.Parser.token with | Colon -> Parser.next p; - let optional = parseOptionalLabel p in - let fieldExpr = parseExpr p in - let fieldExpr = makeExpressionOptional ~optional fieldExpr in - Some (field, fieldExpr) + 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 value = Ast_helper.Exp.ident ~loc:field.loc ~attrs field in let value = - match startToken with - | Uident _ -> removeModuleNameFromPunnedFieldValue value + match start_token with + | Uident _ -> remove_module_name_from_punned_field_value value | _ -> value in Some (field, value)) @@ -3118,35 +3118,35 @@ and parseRecordExprRow p = Parser.next p; match p.Parser.token with | Lident _ | Uident _ -> - let startToken = p.token in - let field = parseValuePath p in + let start_token = p.token in + let field = parse_value_path p in let value = Ast_helper.Exp.ident ~loc:field.loc ~attrs field in let value = - match startToken with - | Uident _ -> removeModuleNameFromPunnedFieldValue value + match start_token with + | Uident _ -> remove_module_name_from_punned_field_value value | _ -> value in - Some (field, makeExpressionOptional ~optional:true value) + Some (field, make_expression_optional ~optional:true value) | _ -> None) | _ -> None -and parseRecordExprWithStringKeys ~startPos firstRow p = +and parse_record_expr_with_string_keys ~start_pos first_row p = let rows = - firstRow - :: parseCommaDelimitedRegion ~grammar:Grammar.RecordRowsStringKey - ~closing:Rbrace ~f:parseRecordExprRowWithStringKey p + first_row + :: parse_comma_delimited_region ~grammar:Grammar.RecordRowsStringKey + ~closing:Rbrace ~f:parse_record_expr_row_with_string_key p in - let loc = mkLoc startPos p.endPos in - let recordStrExpr = + let loc = mk_loc start_pos p.end_pos in + let record_str_expr = Ast_helper.Str.eval ~loc (Ast_helper.Exp.record ~loc rows None) in Ast_helper.Exp.extension ~loc - (Location.mkloc "obj" loc, Parsetree.PStr [recordStrExpr]) + (Location.mkloc "obj" loc, Parsetree.PStr [record_str_expr]) -and parseRecordExpr ~startPos ?(spread = None) rows p = +and parse_record_expr ~start_pos ?(spread = None) rows p = let exprs = - parseCommaDelimitedRegion ~grammar:Grammar.RecordRows ~closing:Rbrace - ~f:parseRecordExprRow p + parse_comma_delimited_region ~grammar:Grammar.RecordRows ~closing:Rbrace + ~f:parse_record_expr_row p in let rows = List.concat [rows; exprs] in let () = @@ -3156,82 +3156,82 @@ and parseRecordExpr ~startPos ?(spread = None) rows p = Parser.err p (Diagnostics.message msg) | _rows -> () in - let loc = mkLoc startPos p.endPos in + let loc = mk_loc start_pos p.end_pos in Ast_helper.Exp.record ~loc rows spread -and parseNewlineOrSemicolonExprBlock p = +and parse_newline_or_semicolon_expr_block p = match p.Parser.token with | Semicolon -> Parser.next p - | token when Grammar.isBlockExprStart token -> - if p.prevEndPos.pos_lnum < p.startPos.pos_lnum then () + | token when Grammar.is_block_expr_start token -> + if p.prev_end_pos.pos_lnum < p.start_pos.pos_lnum then () else - Parser.err ~startPos:p.prevEndPos ~endPos:p.endPos p + Parser.err ~start_pos:p.prev_end_pos ~end_pos:p.end_pos p (Diagnostics.message "consecutive expressions on a line must be separated by ';' or a \ newline") | _ -> () -and parseExprBlockItem p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in +and parse_expr_block_item p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in match p.Parser.token with | Module -> ( Parser.next p; match p.token with | Lparen -> - let expr = parseFirstClassModuleExpr ~startPos p in - let a = parsePrimaryExpr ~operand:expr p in - let expr = parseBinaryExpr ~a p 1 in - parseTernaryExpr expr p + 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 name = match p.Parser.token with | Uident ident -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Location.mkloc ident loc | t -> Parser.err p (Diagnostics.uident t); Location.mknoloc "_" in - let body = parseModuleBindingBody p in - parseNewlineOrSemicolonExprBlock p; - let expr = parseExprBlock p in - let loc = mkLoc startPos p.prevEndPos 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 Ast_helper.Exp.letmodule ~loc name body expr) | Exception -> - 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 + 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 | Open -> - 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 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 -> - let recFlag, letBindings = parseLetBindings ~attrs p in - parseNewlineOrSemicolonExprBlock p; + let rec_flag, let_bindings = parse_let_bindings ~attrs p in + parse_newline_or_semicolon_expr_block p; let next = - if Grammar.isBlockExprStart p.Parser.token then parseExprBlock p + if Grammar.is_block_expr_start p.Parser.token then parse_expr_block p else - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Exp.let_ ~loc recFlag letBindings next + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Exp.let_ ~loc rec_flag let_bindings next | _ -> let e1 = - let expr = parseExpr p in + let expr = parse_expr p in {expr with pexp_attributes = List.concat [attrs; expr.pexp_attributes]} in - parseNewlineOrSemicolonExprBlock p; - if Grammar.isBlockExprStart p.Parser.token then - let e2 = parseExprBlock p 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 let loc = {e1.pexp_loc with loc_end = e2.pexp_loc.loc_end} in Ast_helper.Exp.sequence ~loc e1 e2 else e1 @@ -3249,159 +3249,159 @@ and parseExprBlockItem p = * note: semi should be made optional * a block of expression is always *) -and parseExprBlock ?first p = - Parser.leaveBreadcrumb p Grammar.ExprBlock; +and parse_expr_block ?first p = + Parser.leave_breadcrumb p Grammar.ExprBlock; let item = match first with | Some e -> e - | None -> parseExprBlockItem p + | None -> parse_expr_block_item p in - parseNewlineOrSemicolonExprBlock p; - let blockExpr = - if Grammar.isBlockExprStart p.Parser.token then - let next = 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 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.eatBreadcrumb p; - overParseConstrainedOrCoercedOrArrowExpression p blockExpr + Parser.eat_breadcrumb p; + over_parse_constrained_or_coerced_or_arrow_expression p block_expr -and parseAsyncArrowExpression ?(arrowAttrs = []) p = - let startPos = p.Parser.startPos in +and parse_async_arrow_expression ?(arrow_attrs = []) p = + let start_pos = p.Parser.start_pos in Parser.expect (Lident "async") p; - let asyncAttr = makeAsyncAttr (mkLoc startPos p.prevEndPos) in - parseEs6ArrowExpression ~arrowAttrs:(asyncAttr :: arrowAttrs) - ~arrowStartPos:(Some startPos) 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 parseAwaitExpression p = - let awaitLoc = mkLoc p.Parser.startPos p.endPos in - let awaitAttr = makeAwaitAttr awaitLoc in +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 Parser.expect Await p; - let tokenPrec = Token.precedence MinusGreater in - let expr = parseBinaryExpr ~context:OrdinaryExpr p tokenPrec in + let token_prec = Token.precedence MinusGreater in + let expr = parse_binary_expr ~context:OrdinaryExpr p token_prec in { expr with - pexp_attributes = awaitAttr :: expr.pexp_attributes; - pexp_loc = {expr.pexp_loc with loc_start = awaitLoc.loc_start}; + pexp_attributes = await_attr :: expr.pexp_attributes; + pexp_loc = {expr.pexp_loc with loc_start = await_loc.loc_start}; } -and parseTryExpression p = - let startPos = p.Parser.startPos in +and parse_try_expression p = + let start_pos = p.Parser.start_pos in Parser.expect Try p; - let expr = parseExpr ~context:WhenExpr p in + let expr = parse_expr ~context:WhenExpr p in Parser.expect Res_token.catch p; Parser.expect Lbrace p; - let cases = parsePatternMatching p in + let cases = parse_pattern_matching p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.try_ ~loc expr cases -and parseIfCondition p = - Parser.leaveBreadcrumb p Grammar.IfCondition; +and parse_if_condition p = + Parser.leave_breadcrumb p Grammar.IfCondition; (* doesn't make sense to try es6 arrow here? *) - let conditionExpr = parseExpr ~context:WhenExpr p in - Parser.eatBreadcrumb p; - conditionExpr + let condition_expr = parse_expr ~context:WhenExpr p in + Parser.eat_breadcrumb p; + condition_expr -and parseThenBranch p = - Parser.leaveBreadcrumb p IfBranch; +and parse_then_branch p = + Parser.leave_breadcrumb p IfBranch; Parser.expect Lbrace p; - let thenExpr = parseExprBlock p in + let then_expr = parse_expr_block p in Parser.expect Rbrace p; - Parser.eatBreadcrumb p; - thenExpr + Parser.eat_breadcrumb p; + then_expr -and parseElseBranch p = +and parse_else_branch p = Parser.expect Lbrace p; - let blockExpr = parseExprBlock p in + let block_expr = parse_expr_block p in Parser.expect Rbrace p; - blockExpr + block_expr -and parseIfExpr startPos p = - let conditionExpr = parseIfCondition p in - let thenExpr = parseThenBranch p in - let elseExpr = +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 = match p.Parser.token with | Else -> - Parser.endRegion p; - Parser.leaveBreadcrumb p Grammar.ElseBranch; + Parser.end_region p; + Parser.leave_breadcrumb p Grammar.ElseBranch; Parser.next p; - Parser.beginRegion p; - let elseExpr = + Parser.begin_region p; + let else_expr = match p.token with - | If -> parseIfOrIfLetExpression p - | _ -> parseElseBranch p + | If -> parse_if_or_if_let_expression p + | _ -> parse_else_branch p in - Parser.eatBreadcrumb p; - Parser.endRegion p; - Some elseExpr + Parser.eat_breadcrumb p; + Parser.end_region p; + Some else_expr | _ -> - Parser.endRegion p; + Parser.end_region p; None in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Exp.ifthenelse ~loc conditionExpr thenExpr elseExpr + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Exp.ifthenelse ~loc condition_expr then_expr else_expr -and parseIfLetExpr startPos p = - let pattern = parsePattern p in +and parse_if_let_expr start_pos p = + let pattern = parse_pattern p in Parser.expect Equal p; - let conditionExpr = parseIfCondition p in - let thenExpr = parseThenBranch p in - let elseExpr = + let condition_expr = parse_if_condition p in + let then_expr = parse_then_branch p in + let else_expr = match p.Parser.token with | Else -> - Parser.endRegion p; - Parser.leaveBreadcrumb p Grammar.ElseBranch; + Parser.end_region p; + Parser.leave_breadcrumb p Grammar.ElseBranch; Parser.next p; - Parser.beginRegion p; - let elseExpr = + Parser.begin_region p; + let else_expr = match p.token with - | If -> parseIfOrIfLetExpression p - | _ -> parseElseBranch p + | If -> parse_if_or_if_let_expression p + | _ -> parse_else_branch p in - Parser.eatBreadcrumb p; - Parser.endRegion p; - elseExpr + Parser.eat_breadcrumb p; + Parser.end_region p; + else_expr | _ -> - Parser.endRegion p; - let startPos = p.Parser.startPos in - let loc = mkLoc startPos p.prevEndPos in + Parser.end_region p; + let start_pos = p.Parser.start_pos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) None in - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.match_ - ~attrs:[ifLetAttr; suppressFragileMatchWarningAttr] - ~loc conditionExpr + ~attrs:[if_let_attr; suppress_fragile_match_warning_attr] + ~loc condition_expr [ - Ast_helper.Exp.case pattern thenExpr; - Ast_helper.Exp.case (Ast_helper.Pat.any ()) elseExpr; + Ast_helper.Exp.case pattern then_expr; + Ast_helper.Exp.case (Ast_helper.Pat.any ()) else_expr; ] -and parseIfOrIfLetExpression p = - Parser.beginRegion p; - Parser.leaveBreadcrumb p Grammar.ExprIf; - let startPos = p.Parser.startPos in +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 Parser.expect If p; let expr = match p.Parser.token with | Let -> Parser.next 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; + 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; expr -and parseForRest hasOpeningParen pattern startPos p = +and parse_for_rest has_opening_paren pattern start_pos p = Parser.expect In p; - let e1 = parseExpr p in + let e1 = parse_expr p in let direction = match p.Parser.token with | Lident "to" -> Asttypes.Upto @@ -3411,125 +3411,125 @@ and parseForRest hasOpeningParen pattern startPos p = Asttypes.Upto in if p.Parser.token = Eof then - Parser.err ~startPos:p.startPos p + Parser.err ~start_pos:p.start_pos p (Diagnostics.unexpected p.Parser.token p.breadcrumbs) else Parser.next p; - let e2 = parseExpr ~context:WhenExpr p in - if hasOpeningParen then Parser.expect Rparen p; + let e2 = parse_expr ~context:WhenExpr p in + if has_opening_paren then Parser.expect Rparen p; Parser.expect Lbrace p; - let bodyExpr = parseExprBlock p in + let body_expr = parse_expr_block p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Exp.for_ ~loc pattern e1 e2 direction bodyExpr + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Exp.for_ ~loc pattern e1 e2 direction body_expr -and parseForExpression p = - let startPos = p.Parser.startPos in - Parser.leaveBreadcrumb p Grammar.ExprFor; +and parse_for_expression p = + let start_pos = p.Parser.start_pos in + Parser.leave_breadcrumb p Grammar.ExprFor; Parser.expect For p; - Parser.beginRegion p; - let forExpr = + Parser.begin_region p; + let for_expr = match p.token with | Lparen -> ( - let lparen = p.startPos in + let lparen = p.start_pos in Parser.next p; match p.token with | Rparen -> Parser.next p; - let unitPattern = - let loc = mkLoc lparen p.prevEndPos in + let unit_pattern = + let loc = mk_loc lparen p.prev_end_pos in let lid = Location.mkloc (Longident.Lident "()") loc in Ast_helper.Pat.construct lid None in - parseForRest false - (parseAliasPattern ~attrs:[] unitPattern p) - startPos p + parse_for_rest false + (parse_alias_pattern ~attrs:[] unit_pattern p) + start_pos p | _ -> ( - Parser.leaveBreadcrumb p Grammar.Pattern; - let pat = parsePattern p in - Parser.eatBreadcrumb p; + Parser.leave_breadcrumb p Grammar.Pattern; + let pat = parse_pattern p in + Parser.eat_breadcrumb p; match p.token with | Comma -> Parser.next p; - let tuplePattern = - parseTuplePattern ~attrs:[] ~startPos:lparen ~first:pat p + let tuple_pattern = + parse_tuple_pattern ~attrs:[] ~start_pos:lparen ~first:pat p in - let pattern = parseAliasPattern ~attrs:[] tuplePattern p in - parseForRest false pattern startPos p - | _ -> parseForRest true pat startPos p)) + 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)) | _ -> - Parser.leaveBreadcrumb p Grammar.Pattern; - let pat = parsePattern p in - Parser.eatBreadcrumb p; - parseForRest false 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 in - Parser.eatBreadcrumb p; - Parser.endRegion p; - forExpr + Parser.eat_breadcrumb p; + Parser.end_region p; + for_expr -and parseWhileExpression p = - let startPos = p.Parser.startPos in +and parse_while_expression p = + let start_pos = p.Parser.start_pos in Parser.expect While p; - let expr1 = parseExpr ~context:WhenExpr p in + let expr1 = parse_expr ~context:WhenExpr p in Parser.expect Lbrace p; - let expr2 = parseExprBlock p in + let expr2 = parse_expr_block p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.while_ ~loc expr1 expr2 -and parsePatternGuard p = +and parse_pattern_guard p = match p.Parser.token with | When | If -> Parser.next p; - Some (parseExpr ~context:WhenExpr p) + Some (parse_expr ~context:WhenExpr p) | _ -> None -and parsePatternMatchCase p = - Parser.beginRegion p; - Parser.leaveBreadcrumb p Grammar.PatternMatchCase; +and parse_pattern_match_case p = + Parser.begin_region p; + Parser.leave_breadcrumb p Grammar.PatternMatchCase; match p.Parser.token with | Token.Bar -> Parser.next p; - Parser.leaveBreadcrumb p Grammar.Pattern; - let lhs = parsePattern p in - Parser.eatBreadcrumb p; - let guard = parsePatternGuard p in + Parser.leave_breadcrumb p Grammar.Pattern; + let lhs = parse_pattern p in + Parser.eat_breadcrumb p; + let guard = parse_pattern_guard p in let () = match p.token with | EqualGreater -> Parser.next p - | _ -> Recover.recoverEqualGreater p + | _ -> Recover.recover_equal_greater p in - let rhs = parseExprBlock p in - Parser.endRegion p; - Parser.eatBreadcrumb p; + let rhs = parse_expr_block p in + Parser.end_region p; + Parser.eat_breadcrumb p; Some (Ast_helper.Exp.case lhs ?guard rhs) | _ -> - Parser.endRegion p; - Parser.eatBreadcrumb p; + Parser.end_region p; + Parser.eat_breadcrumb p; None -and parsePatternMatching p = +and parse_pattern_matching p = let cases = - parseDelimitedRegion ~grammar:Grammar.PatternMatching ~closing:Rbrace - ~f:parsePatternMatchCase p + parse_delimited_region ~grammar:Grammar.PatternMatching ~closing:Rbrace + ~f:parse_pattern_match_case p in let () = match cases with | [] -> - Parser.err ~startPos:p.prevEndPos p + Parser.err ~start_pos:p.prev_end_pos p (Diagnostics.message "Pattern matching needs at least one case") | _ -> () in cases -and parseSwitchExpression p = - let startPos = p.Parser.startPos in +and parse_switch_expression p = + let start_pos = p.Parser.start_pos in Parser.expect Switch p; - let switchExpr = parseExpr ~context:WhenExpr p in + let switch_expr = parse_expr ~context:WhenExpr p in Parser.expect Lbrace p; - let cases = parsePatternMatching p in + let cases = parse_pattern_matching p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Exp.match_ ~loc switchExpr cases + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Exp.match_ ~loc switch_expr cases (* * argument ::= @@ -3549,11 +3549,11 @@ and parseSwitchExpression p = * dotted_argument ::= * | . argument *) -and parseArgument p : argument option = +and parse_argument p : argument option = if p.Parser.token = Token.Tilde || p.token = Dot || p.token = Underscore - || Grammar.isExprStart p.token + || Grammar.is_expr_start p.token then match p.Parser.token with | Dot -> ( @@ -3562,21 +3562,21 @@ and parseArgument p : argument option = match p.token with (* apply(.) *) | Rparen -> - let unitExpr = + let unit_expr = Ast_helper.Exp.construct (Location.mknoloc (Longident.Lident "()")) None in - Some {dotted; label = Asttypes.Nolabel; expr = unitExpr} - | _ -> parseArgument2 p ~dotted) - | _ -> parseArgument2 p ~dotted:false + Some {dotted; label = Asttypes.Nolabel; expr = unit_expr} + | _ -> parse_argument2 p ~dotted) + | _ -> parse_argument2 p ~dotted:false else None -and parseArgument2 p ~dotted : argument option = +and parse_argument2 p ~dotted : argument option = match p.Parser.token with (* foo(_), do not confuse with foo(_ => x), TODO: performance *) - | Underscore when not (isEs6ArrowExpression ~inTernary:false p) -> - let loc = mkLoc p.startPos p.endPos in + | Underscore when not (is_es6_arrow_expression ~in_ternary:false p) -> + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; let expr = Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "_") loc) @@ -3587,21 +3587,21 @@ and parseArgument2 p ~dotted : argument option = (* TODO: nesting of pattern matches not intuitive for error recovery *) match p.Parser.token with | Lident ident -> ( - let startPos = p.startPos in + let start_pos = p.start_pos in Parser.next p; - let endPos = p.prevEndPos in - let loc = mkLoc startPos endPos in - let propLocAttr = + let end_pos = p.prev_end_pos in + let loc = mk_loc start_pos end_pos in + let prop_loc_attr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in - let identExpr = - Ast_helper.Exp.ident ~attrs:[propLocAttr] ~loc + let ident_expr = + Ast_helper.Exp.ident ~attrs:[prop_loc_attr] ~loc (Location.mkloc (Longident.Lident ident) loc) in match p.Parser.token with | Question -> Parser.next p; - Some {dotted; label = Optional ident; expr = identExpr} + Some {dotted; label = Optional ident; expr = ident_expr} | Equal -> Parser.next p; let label = @@ -3613,43 +3613,43 @@ and parseArgument2 p ~dotted : argument option = in let expr = match p.Parser.token with - | Underscore when not (isEs6ArrowExpression ~inTernary:false p) -> - let loc = mkLoc p.startPos p.endPos in + | Underscore when not (is_es6_arrow_expression ~in_ternary:false p) -> + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "_") loc) | _ -> - let expr = parseConstrainedOrCoercedExpr p in - {expr with pexp_attributes = propLocAttr :: expr.pexp_attributes} + let expr = parse_constrained_or_coerced_expr p in + {expr with pexp_attributes = prop_loc_attr :: expr.pexp_attributes} in Some {dotted; label; expr} | Colon -> Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc startPos p.prevEndPos in + let typ = parse_typ_expr p in + let loc = mk_loc start_pos p.prev_end_pos in let expr = - Ast_helper.Exp.constraint_ ~attrs:[propLocAttr] ~loc identExpr typ + Ast_helper.Exp.constraint_ ~attrs:[prop_loc_attr] ~loc ident_expr typ in Some {dotted; label = Labelled ident; expr} - | _ -> Some {dotted; label = Labelled ident; expr = identExpr}) + | _ -> Some {dotted; label = Labelled ident; expr = ident_expr}) | t -> Parser.err p (Diagnostics.lident t); - Some {dotted; label = Nolabel; expr = Recover.defaultExpr ()}) - | _ -> Some {dotted; label = Nolabel; expr = parseConstrainedOrCoercedExpr p} + Some {dotted; label = Nolabel; expr = Recover.default_expr ()}) + | _ -> Some {dotted; label = Nolabel; expr = parse_constrained_or_coerced_expr p} -and parseCallExpr p funExpr = +and parse_call_expr p fun_expr = Parser.expect Lparen p; - let startPos = p.Parser.startPos in - Parser.leaveBreadcrumb p Grammar.ExprCall; + let start_pos = p.Parser.start_pos in + Parser.leave_breadcrumb p Grammar.ExprCall; let args = - parseCommaDelimitedRegion ~grammar:Grammar.ArgumentList ~closing:Rparen - ~f:parseArgument p + parse_comma_delimited_region ~grammar:Grammar.ArgumentList ~closing:Rparen + ~f:parse_argument p in - let resPartialAttr = - let loc = mkLoc startPos p.prevEndPos in + let res_partial_attr = + let loc = mk_loc start_pos p.prev_end_pos in (Location.mkloc "res.partial" loc, Parsetree.PStr []) in - let isPartial = + let is_partial = match p.token with | DotDotDot when args <> [] -> Parser.next p; @@ -3660,7 +3660,7 @@ and parseCallExpr p funExpr = let args = match args with | [] -> - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in (* No args -> unit sugar: `foo()` *) [ { @@ -3684,7 +3684,7 @@ and parseCallExpr p funExpr = } as expr; }; ] - when (not loc.loc_ghost) && p.mode = ParseForTypeChecker && not isPartial + when (not loc.loc_ghost) && p.mode = ParseForTypeChecker && not is_partial -> (* Since there is no syntax space for arity zero vs arity one, * we expand @@ -3715,7 +3715,7 @@ and parseCallExpr p funExpr = ] | args -> args in - let loc = {funExpr.pexp_loc with loc_end = p.prevEndPos} in + let loc = {fun_expr.pexp_loc with loc_end = p.prev_end_pos} in let args = match args with | {dotted = d; label = lbl; expr} :: args -> @@ -3729,44 +3729,44 @@ and parseCallExpr p funExpr = | [] -> [] in let apply = - Ext_list.fold_left args funExpr (fun callBody group -> + Ext_list.fold_left args fun_expr (fun call_body group -> let dotted, args = group in - let args, wrap = processUnderscoreApplication p args in + let args, wrap = process_underscore_application p args in let exp = let uncurried = - p.uncurried_config |> Res_uncurried.fromDotted ~dotted + p.uncurried_config |> Res_uncurried.from_dotted ~dotted in - 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 + 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 in wrap exp) in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; apply -and parseValueOrConstructor p = - let startPos = p.Parser.startPos in +and parse_value_or_constructor p = + let start_pos = p.Parser.start_pos in let rec aux p acc = match p.Parser.token with | Uident ident -> ( - let endPosLident = p.endPos in + let end_pos_lident = p.end_pos in Parser.next p; match p.Parser.token with | Dot -> Parser.next p; aux p (ident :: acc) - | 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 + | 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 let tail = match args with | [] -> None | [({Parsetree.pexp_desc = Pexp_tuple _} as arg)] as args -> - let loc = mkLoc lparen rparen in + let loc = mk_loc lparen rparen in if p.mode = ParseForTypeChecker then (* Some(1, 2) for type-checker *) Some arg @@ -3775,43 +3775,43 @@ and parseValueOrConstructor p = Some (Ast_helper.Exp.tuple ~loc args) | [arg] -> Some arg | args -> - let loc = mkLoc lparen rparen in + let loc = mk_loc lparen rparen in Some (Ast_helper.Exp.tuple ~loc args) in - 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 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 lident = buildLongident (ident :: acc) in + let loc = mk_loc start_pos p.prev_end_pos in + let lident = build_longident (ident :: acc) in Ast_helper.Exp.construct ~loc (Location.mkloc lident loc) None) | Lident ident -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let lident = buildLongident (ident :: acc) in + let loc = mk_loc start_pos p.prev_end_pos in + let lident = build_longident (ident :: acc) in Ast_helper.Exp.ident ~loc (Location.mkloc lident loc) | token -> if acc = [] then ( - Parser.nextUnsafe p; + Parser.next_unsafe p; Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Recover.defaultExpr ()) + Recover.default_expr ()) else - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - let lident = buildLongident ("_" :: acc) in + let lident = build_longident ("_" :: acc) in Ast_helper.Exp.ident ~loc (Location.mkloc lident loc) in aux p [] -and parsePolyVariantExpr p = - let startPos = p.startPos in - let ident, _loc = parseHashIdent ~startPos p in +and parse_poly_variant_expr p = + let start_pos = p.start_pos in + let ident, _loc = parse_hash_ident ~start_pos p in match p.Parser.token with - | 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 + | 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 let tail = match args with | [] -> None @@ -3827,23 +3827,23 @@ and parsePolyVariantExpr p = (* #a((1, 2)) for printer *) Some (Ast_helper.Exp.tuple ~loc:loc_paren args) in - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.variant ~loc ident tail | _ -> - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.variant ~loc ident None -and parseConstructorArgs p = - let lparen = p.Parser.startPos in +and parse_constructor_args p = + let lparen = p.Parser.start_pos in Parser.expect Lparen p; let args = - parseCommaDelimitedRegion ~grammar:Grammar.ExprList - ~f:parseConstrainedExprRegion ~closing:Rparen p + parse_comma_delimited_region ~grammar:Grammar.ExprList + ~f:parse_constrained_expr_region ~closing:Rparen p in Parser.expect Rparen p; match args with | [] -> - let loc = mkLoc lparen p.prevEndPos in + let loc = mk_loc lparen p.prev_end_pos in [ Ast_helper.Exp.construct ~loc (Location.mkloc (Longident.Lident "()") loc) @@ -3851,105 +3851,105 @@ and parseConstructorArgs p = ] | args -> args -and parseTupleExpr ~first ~startPos p = +and parse_tuple_expr ~first ~start_pos p = let exprs = first - :: parseCommaDelimitedRegion p ~grammar:Grammar.ExprList ~closing:Rparen - ~f:parseConstrainedExprRegion + :: parse_comma_delimited_region p ~grammar:Grammar.ExprList ~closing:Rparen + ~f:parse_constrained_expr_region in Parser.expect Rparen p; let () = match exprs with | [_] -> - Parser.err ~startPos ~endPos:p.prevEndPos p - (Diagnostics.message ErrorMessages.tupleSingleElement) + Parser.err ~start_pos ~end_pos:p.prev_end_pos p + (Diagnostics.message ErrorMessages.tuple_single_element) | _ -> () in - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Exp.tuple ~loc exprs -and parseSpreadExprRegionWithLoc p = - let startPos = p.Parser.prevEndPos in +and parse_spread_expr_region_with_loc p = + let start_pos = p.Parser.prev_end_pos in match p.Parser.token with | DotDotDot -> Parser.next p; - let expr = parseConstrainedOrCoercedExpr p in - Some (true, expr, startPos, p.prevEndPos) - | token when Grammar.isExprStart token -> - Some (false, parseConstrainedOrCoercedExpr p, startPos, p.prevEndPos) + 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) | _ -> None -and parseListExpr ~startPos p = +and parse_list_expr ~start_pos p = let split_by_spread exprs = List.fold_left (fun acc curr -> match (curr, acc) with - | (true, expr, startPos, endPos), _ -> + | (true, expr, start_pos, end_pos), _ -> (* find a spread expression, prepend a new sublist *) - ([], Some expr, startPos, endPos) :: acc - | ( (false, expr, startPos, _endPos), - (no_spreads, spread, _accStartPos, accEndPos) :: acc ) -> + ([], Some expr, start_pos, end_pos) :: acc + | ( (false, expr, start_pos, _endPos), + (no_spreads, spread, _accStartPos, acc_end_pos) :: 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, startPos, accEndPos) :: acc - | (false, expr, startPos, endPos), [] -> + (expr :: no_spreads, spread, start_pos, acc_end_pos) :: acc + | (false, expr, start_pos, end_pos), [] -> (* find a non-spread expression, and the accumulated is empty *) - [([expr], None, startPos, endPos)]) + [([expr], None, start_pos, end_pos)]) [] exprs in let make_sub_expr = function - | exprs, Some spread, startPos, endPos -> - makeListExpression (mkLoc startPos endPos) exprs (Some spread) - | exprs, None, startPos, endPos -> - makeListExpression (mkLoc startPos endPos) exprs None + | 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 in - let listExprsRev = - parseCommaDelimitedReversedList p ~grammar:Grammar.ListExpr ~closing:Rbrace - ~f:parseSpreadExprRegionWithLoc + let list_exprs_rev = + parse_comma_delimited_reversed_list p ~grammar:Grammar.ListExpr ~closing:Rbrace + ~f:parse_spread_expr_region_with_loc in Parser.expect Rbrace p; - 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 + 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 | exprs -> - let listExprs = List.map make_sub_expr exprs in + let list_exprs = List.map make_sub_expr exprs in Ast_helper.Exp.apply ~loc - (Ast_helper.Exp.ident ~loc ~attrs:[spreadAttr] + (Ast_helper.Exp.ident ~loc ~attrs:[spread_attr] (Location.mkloc (Longident.Ldot (Longident.Ldot (Longident.Lident "Belt", "List"), "concatMany")) loc)) - [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc listExprs)] + [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc list_exprs)] -and parseArrayExp p = - let startPos = p.Parser.startPos in +and parse_array_exp p = + let start_pos = p.Parser.start_pos in Parser.expect Lbracket p; let split_by_spread exprs = List.fold_left (fun acc curr -> match (curr, acc) with - | (true, expr, startPos, endPos), _ -> + | (true, expr, start_pos, end_pos), _ -> (* find a spread expression, prepend a new sublist *) - ([], Some expr, startPos, endPos) :: acc - | ( (false, expr, startPos, _endPos), - (no_spreads, spread, _accStartPos, accEndPos) :: acc ) -> + ([], Some expr, start_pos, end_pos) :: acc + | ( (false, expr, start_pos, _endPos), + (no_spreads, spread, _accStartPos, acc_end_pos) :: 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, startPos, accEndPos) :: acc - | (false, expr, startPos, endPos), [] -> + (expr :: no_spreads, spread, start_pos, acc_end_pos) :: acc + | (false, expr, start_pos, end_pos), [] -> (* find a non-spread expression, and the accumulated is empty *) - [([expr], None, startPos, endPos)]) + [([expr], None, start_pos, end_pos)]) [] exprs in - let listExprsRev = - parseCommaDelimitedReversedList p ~grammar:Grammar.ExprList - ~closing:Rbracket ~f:parseSpreadExprRegionWithLoc + let list_exprs_rev = + parse_comma_delimited_reversed_list p ~grammar:Grammar.ExprList + ~closing:Rbracket ~f:parse_spread_expr_region_with_loc in Parser.expect Rbracket p; - let loc = mkLoc startPos p.prevEndPos in - let collectExprs = function + let loc = mk_loc start_pos p.prev_end_pos in + let collect_exprs = function | [], Some spread, _startPos, _endPos -> [spread] | exprs, Some spread, _startPos, _endPos -> let els = Ast_helper.Exp.array ~loc exprs in @@ -3958,204 +3958,204 @@ and parseArrayExp p = let els = Ast_helper.Exp.array ~loc exprs in [els] in - match split_by_spread listExprsRev with - | [] -> Ast_helper.Exp.array ~loc:(mkLoc startPos p.prevEndPos) [] + match split_by_spread list_exprs_rev with + | [] -> Ast_helper.Exp.array ~loc:(mk_loc start_pos p.prev_end_pos) [] | [(exprs, None, _, _)] -> - Ast_helper.Exp.array ~loc:(mkLoc startPos p.prevEndPos) exprs + Ast_helper.Exp.array ~loc:(mk_loc start_pos p.prev_end_pos) exprs | exprs -> - let xs = List.map collectExprs exprs in - let listExprs = + let xs = List.map collect_exprs exprs in + let list_exprs = 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:[spreadAttr] + (Ast_helper.Exp.ident ~loc ~attrs:[spread_attr] (Location.mkloc (Longident.Ldot (Longident.Ldot (Longident.Lident "Belt", "Array"), "concatMany")) loc)) - [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc listExprs)] + [(Asttypes.Nolabel, Ast_helper.Exp.array ~loc list_exprs)] (* TODO: check attributes in the case of poly type vars, * might be context dependend: parseFieldDeclaration (see ocaml) *) -and parsePolyTypeExpr p = - let startPos = p.Parser.startPos in +and parse_poly_type_expr p = + let start_pos = p.Parser.start_pos in match p.Parser.token with | SingleQuote -> ( - let vars = parseTypeVarList p in + let vars = parse_type_var_list p in match vars with | _v1 :: _v2 :: _ -> Parser.expect Dot p; - let typ = parseTypExpr p in - let loc = mkLoc startPos p.prevEndPos in + let typ = parse_typ_expr p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Typ.poly ~loc vars typ | [var] -> ( match p.Parser.token with | Dot -> Parser.next p; - let typ = parseTypExpr p in - let loc = mkLoc startPos p.prevEndPos in + let typ = parse_typ_expr p in + let loc = mk_loc start_pos p.prev_end_pos 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 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 + 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 | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt) | _ -> assert false) - | _ -> parseTypExpr p + | _ -> parse_typ_expr p (* 'a 'b 'c *) -and parseTypeVarList p = +and parse_type_var_list p = let rec loop p vars = match p.Parser.token with | SingleQuote -> Parser.next p; - let lident, loc = parseLident p in + let lident, loc = parse_lident p in let var = Location.mkloc lident loc in loop p (var :: vars) | _ -> List.rev vars in loop p [] -and parseLidentList p = +and parse_lident_list p = let rec loop p ls = match p.Parser.token with | Lident lident -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; loop p (Location.mkloc lident loc :: ls) | _ -> List.rev ls in loop p [] -and parseAtomicTypExpr ~attrs p = - Parser.leaveBreadcrumb p Grammar.AtomicTypExpr; - let startPos = p.Parser.startPos in +and parse_atomic_typ_expr ~attrs p = + Parser.leave_breadcrumb p Grammar.AtomicTypExpr; + let start_pos = p.Parser.start_pos in let typ = match p.Parser.token with | SingleQuote -> Parser.next p; let ident, loc = if p.Parser.token = Eof then ( - Parser.err ~startPos:p.startPos p + Parser.err ~start_pos:p.start_pos p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); - ("", mkLoc p.startPos p.prevEndPos)) - else parseIdent ~msg:ErrorMessages.typeVar ~startPos:p.startPos p + ("", mk_loc p.start_pos p.prev_end_pos)) + else parse_ident ~msg:ErrorMessages.type_var ~start_pos:p.start_pos p in Ast_helper.Typ.var ~loc ~attrs ident | Underscore -> - let endPos = p.endPos in + let end_pos = p.end_pos in Parser.next p; - Ast_helper.Typ.any ~loc:(mkLoc startPos endPos) ~attrs () + Ast_helper.Typ.any ~loc:(mk_loc start_pos end_pos) ~attrs () | Lparen -> ( Parser.next p; match p.Parser.token with | Rparen -> Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let unitConstr = Location.mkloc (Longident.Lident "unit") loc in - Ast_helper.Typ.constr ~attrs unitConstr [] + 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 t = parseTypExpr p in + let t = parse_typ_expr p in match p.token with | Comma -> Parser.next p; - parseTupleType ~attrs ~first:t ~startPos p + parse_tuple_type ~attrs ~first:t ~start_pos p | _ -> Parser.expect Rparen p; { t with - ptyp_loc = mkLoc startPos p.prevEndPos; + ptyp_loc = mk_loc start_pos p.prev_end_pos; ptyp_attributes = List.concat [attrs; t.ptyp_attributes]; })) - | Lbracket -> parsePolymorphicVariantType ~attrs p + | Lbracket -> parse_polymorphic_variant_type ~attrs p | Uident _ | Lident _ -> - let constr = parseValuePath p in - let args = parseTypeConstructorArgs ~constrName:constr p in + let constr = parse_value_path p in + let args = parse_type_constructor_args ~constr_name:constr p in Ast_helper.Typ.constr - ~loc:(mkLoc startPos p.prevEndPos) + ~loc:(mk_loc start_pos p.prev_end_pos) ~attrs constr args | Module -> Parser.next p; Parser.expect Lparen p; - let packageType = parsePackageType ~startPos ~attrs p in + let package_type = parse_package_type ~start_pos ~attrs p in Parser.expect Rparen p; - {packageType with ptyp_loc = mkLoc startPos p.prevEndPos} + {package_type with ptyp_loc = mk_loc start_pos p.prev_end_pos} | Percent -> - let extension = parseExtension p in - let loc = mkLoc startPos p.prevEndPos in + let extension = parse_extension p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Typ.extension ~attrs ~loc extension - | Lbrace -> parseRecordOrObjectType ~attrs p + | Lbrace -> parse_record_or_object_type ~attrs p | Eof -> Parser.err p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); - Recover.defaultType () + Recover.default_type () | token -> ( Parser.err p (Diagnostics.unexpected token p.breadcrumbs); match - skipTokensAndMaybeRetry p ~isStartOfGrammar:Grammar.isAtomicTypExprStart + skip_tokens_and_maybe_retry p ~is_start_of_grammar:Grammar.is_atomic_typ_expr_start with - | Some () -> parseAtomicTypExpr ~attrs p + | Some () -> parse_atomic_typ_expr ~attrs p | None -> - Parser.err ~startPos:p.prevEndPos p + Parser.err ~start_pos:p.prev_end_pos p (Diagnostics.unexpected token p.breadcrumbs); - Recover.defaultType ()) + Recover.default_type ()) in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; typ (* package-type ::= | modtype-path ∣ modtype-path with package-constraint { and package-constraint } *) -and parsePackageType ~startPos ~attrs p = - let modTypePath = parseModuleLongIdent ~lowercase:true p in +and parse_package_type ~start_pos ~attrs p = + let mod_type_path = parse_module_long_ident ~lowercase:true p in match p.Parser.token with | Lident "with" -> Parser.next p; - let constraints = parsePackageConstraints p in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.package ~loc ~attrs modTypePath constraints + 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 loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.package ~loc ~attrs modTypePath [] + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Typ.package ~loc ~attrs mod_type_path [] (* package-constraint { and package-constraint } *) -and parsePackageConstraints p = +and parse_package_constraints p = let first = Parser.expect Typ p; - let typeConstr = parseValuePath p in + let type_constr = parse_value_path p in Parser.expect Equal p; - let typ = parseTypExpr p in - (typeConstr, typ) + let typ = parse_typ_expr p in + (type_constr, typ) in let rest = - parseRegion ~grammar:Grammar.PackageConstraint ~f:parsePackageConstraint p + parse_region ~grammar:Grammar.PackageConstraint ~f:parse_package_constraint p in first :: rest (* and type typeconstr = typexpr *) -and parsePackageConstraint p = +and parse_package_constraint p = match p.Parser.token with | And -> Parser.next p; Parser.expect Typ p; - let typeConstr = parseValuePath p in + let type_constr = parse_value_path p in Parser.expect Equal p; - let typ = parseTypExpr p in - Some (typeConstr, typ) + let typ = parse_typ_expr p in + Some (type_constr, typ) | _ -> None -and parseRecordOrObjectType ~attrs p = +and parse_record_or_object_type ~attrs p = (* for inline record in constructor *) - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in Parser.expect Lbrace p; - let closedFlag = + let closed_flag = match p.token with | DotDot -> Parser.next p; @@ -4169,27 +4169,27 @@ and parseRecordOrObjectType ~attrs p = match p.token with | Lident _ -> Parser.err p - (Diagnostics.message ErrorMessages.forbiddenInlineRecordDeclaration) + (Diagnostics.message ErrorMessages.forbidden_inline_record_declaration) | _ -> () in let fields = - parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations - ~closing:Rbrace ~f:parseStringFieldDeclaration p + parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations + ~closing:Rbrace ~f:parse_string_field_declaration p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.object_ ~loc ~attrs fields closedFlag + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Typ.object_ ~loc ~attrs fields closed_flag (* TODO: check associativity in combination with attributes *) -and parseTypeAlias p typ = +and parse_type_alias p typ = match p.Parser.token with | As -> Parser.next p; Parser.expect SingleQuote p; - let ident, _loc = parseLident p in + let ident, _loc = parse_lident p in (* TODO: how do we parse attributes here? *) Ast_helper.Typ.alias - ~loc:(mkLoc typ.Parsetree.ptyp_loc.loc_start p.prevEndPos) + ~loc:(mk_loc typ.Parsetree.ptyp_loc.loc_start p.prev_end_pos) typ ident | _ -> typ @@ -4205,112 +4205,112 @@ and parseTypeAlias p typ = * dotted_type_parameter ::= * | . type_parameter *) -and parseTypeParameter p = - let docAttr : Parsetree.attributes = +and parse_type_parameter p = + let doc_attr : Parsetree.attributes = match p.Parser.token with | DocComment (loc, s) -> Parser.next p; - [docCommentToAttribute loc s] + [doc_comment_to_attribute loc s] | _ -> [] in if p.Parser.token = Token.Tilde || p.token = Dot - || Grammar.isTypExprStart p.token + || Grammar.is_typ_expr_start p.token then - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in let dotted = Parser.optional p Dot in - let attrs = docAttr @ parseAttributes p in + let attrs = doc_attr @ parse_attributes p in match p.Parser.token with | Tilde -> ( Parser.next p; - let name, loc = parseLident p in - let lblLocAttr = + let name, loc = parse_lident p in + let lbl_loc_attr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in Parser.expect ~grammar:Grammar.TypeExpression Colon p; let typ = - let typ = parseTypExpr p in - {typ with ptyp_attributes = lblLocAttr :: typ.ptyp_attributes} + let typ = parse_typ_expr p in + {typ with ptyp_attributes = lbl_loc_attr :: typ.ptyp_attributes} in match p.Parser.token with | Equal -> Parser.next p; Parser.expect Question p; - Some {dotted; attrs; label = Optional name; typ; startPos} - | _ -> Some {dotted; attrs; label = Labelled name; typ; startPos}) + Some {dotted; attrs; label = Optional name; typ; start_pos} + | _ -> Some {dotted; attrs; label = Labelled name; typ; start_pos}) | Lident _ -> ( - let name, loc = parseLident p in + let name, loc = parse_lident p in match p.token with | Colon -> ( let () = let error = Diagnostics.message - (ErrorMessages.missingTildeLabeledParameter name) + (ErrorMessages.missing_tilde_labeled_parameter name) in - Parser.err ~startPos:loc.loc_start ~endPos:loc.loc_end p error + Parser.err ~start_pos:loc.loc_start ~end_pos:loc.loc_end p error in Parser.next p; - let typ = parseTypExpr p in + let typ = parse_typ_expr p in match p.Parser.token with | Equal -> Parser.next p; Parser.expect Question p; - Some {dotted; attrs; label = Optional name; typ; startPos} - | _ -> Some {dotted; attrs; label = Labelled name; typ; startPos}) + Some {dotted; attrs; label = Optional name; typ; start_pos} + | _ -> Some {dotted; attrs; label = Labelled name; typ; start_pos}) | _ -> let constr = Location.mkloc (Longident.Lident name) loc in - let args = parseTypeConstructorArgs ~constrName:constr p in + let args = parse_type_constructor_args ~constr_name:constr p in let typ = Ast_helper.Typ.constr - ~loc:(mkLoc startPos p.prevEndPos) + ~loc:(mk_loc start_pos p.prev_end_pos) ~attrs constr args in - 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_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 = parseTypExpr p in - let typWithAttributes = + let typ = parse_typ_expr p in + let typ_with_attributes = {typ with ptyp_attributes = List.concat [attrs; typ.ptyp_attributes]} in Some - {dotted; attrs = []; label = Nolabel; typ = typWithAttributes; startPos} + {dotted; attrs = []; label = Nolabel; typ = typ_with_attributes; start_pos} else None (* (int, ~x:string, float) *) -and parseTypeParameters p = - let startPos = p.Parser.startPos in +and parse_type_parameters p = + let start_pos = p.Parser.start_pos in Parser.expect Lparen p; match p.Parser.token with | Rparen -> Parser.next p; - 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 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 params = - parseCommaDelimitedRegion ~grammar:Grammar.TypeParameters ~closing:Rparen - ~f:parseTypeParameter p + parse_comma_delimited_region ~grammar:Grammar.TypeParameters ~closing:Rparen + ~f:parse_type_parameter p in Parser.expect Rparen p; params -and parseEs6ArrowType ~attrs p = - let startPos = p.Parser.startPos in +and parse_es6_arrow_type ~attrs p = + let start_pos = p.Parser.start_pos in match p.Parser.token with | Tilde -> Parser.next p; - let name, loc = parseLident p in - let lblLocAttr = + let name, loc = parse_lident p in + let lbl_loc_attr = (Location.mkloc "res.namedArgLoc" loc, Parsetree.PStr []) in Parser.expect ~grammar:Grammar.TypeExpression Colon p; let typ = - let typ = parseTypExpr ~alias:false ~es6Arrow:false p in - {typ with ptyp_attributes = lblLocAttr :: typ.ptyp_attributes} + let typ = parse_typ_expr ~alias:false ~es6_arrow:false p in + {typ with ptyp_attributes = lbl_loc_attr :: typ.ptyp_attributes} in let arg = match p.Parser.token with @@ -4321,35 +4321,35 @@ and parseEs6ArrowType ~attrs p = | _ -> Asttypes.Labelled name in Parser.expect EqualGreater p; - let returnType = parseTypExpr ~alias:false p in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.arrow ~loc ~attrs arg typ returnType + 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 | DocComment _ -> assert false | _ -> - let parameters = parseTypeParameters p in + let parameters = parse_type_parameters p in Parser.expect EqualGreater p; - let returnType = parseTypExpr ~alias:false p in - let endPos = p.prevEndPos in - let returnTypeArity = + let return_type = parse_typ_expr ~alias:false p in + let end_pos = p.prev_end_pos in + let return_type_arity = 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.arrowType returnType in + let _, args, _ = Res_parsetree_viewer.arrow_type return_type in List.length args in let _paramNum, typ, _arity = List.fold_right - (fun {dotted; attrs; label = argLbl; typ; startPos} (paramNum, t, arity) -> + (fun {dotted; attrs; label = arg_lbl; typ; start_pos} (param_num, t, arity) -> let uncurried = - p.uncurried_config |> Res_uncurried.fromDotted ~dotted + p.uncurried_config |> Res_uncurried.from_dotted ~dotted in - let loc = mkLoc startPos endPos in + let loc = mk_loc start_pos end_pos in let arity = (* Workaround for ~lbl: @as(json`false`) _, which changes the arity *) - match argLbl with + match arg_lbl with | Labelled _s -> let typ_is_any = match typ.ptyp_desc with @@ -4363,17 +4363,17 @@ and parseEs6ArrowType ~attrs p = else arity | _ -> arity in - 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)) + 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)) parameters - (List.length parameters, returnType, returnTypeArity + 1) + (List.length parameters, return_type, return_type_arity + 1) in { typ with ptyp_attributes = List.concat [typ.ptyp_attributes; attrs]; - ptyp_loc = mkLoc startPos p.prevEndPos; + ptyp_loc = mk_loc start_pos p.prev_end_pos; } (* @@ -4396,159 +4396,159 @@ and parseEs6ArrowType ~attrs p = * | uident.lident * | uident.uident.lident --> long module path *) -and parseTypExpr ?attrs ?(es6Arrow = true) ?(alias = true) p = +and parse_typ_expr ?attrs ?(es6_arrow = true) ?(alias = true) p = (* Parser.leaveBreadcrumb p Grammar.TypeExpression; *) - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in let attrs = match attrs with | Some attrs -> attrs - | None -> parseAttributes p + | None -> parse_attributes p in let typ = - if es6Arrow && isEs6ArrowType p then parseEs6ArrowType ~attrs p + if es6_arrow && is_es6_arrow_type p then parse_es6_arrow_type ~attrs p else - let typ = parseAtomicTypExpr ~attrs p in - parseArrowTypeRest ~es6Arrow ~startPos typ p + let typ = parse_atomic_typ_expr ~attrs p in + parse_arrow_type_rest ~es6_arrow ~start_pos typ p in - let typ = if alias then parseTypeAlias p typ else typ in + let typ = if alias then parse_type_alias p typ else typ in (* Parser.eatBreadcrumb p; *) typ -and parseArrowTypeRest ~es6Arrow ~startPos typ p = +and parse_arrow_type_rest ~es6_arrow ~start_pos typ p = match p.Parser.token with - | (EqualGreater | MinusGreater) as token when es6Arrow == true -> + | (EqualGreater | MinusGreater) as token when es6_arrow == true -> (* error recovery *) if token = MinusGreater then Parser.expect EqualGreater p; Parser.next p; - 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 + 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 | _ -> typ -and parseTypExprRegion p = - if Grammar.isTypExprStart p.Parser.token then Some (parseTypExpr p) else None +and parse_typ_expr_region p = + if Grammar.is_typ_expr_start p.Parser.token then Some (parse_typ_expr p) else None -and parseTupleType ~attrs ~first ~startPos p = +and parse_tuple_type ~attrs ~first ~start_pos p = let typexprs = first - :: parseCommaDelimitedRegion ~grammar:Grammar.TypExprList ~closing:Rparen - ~f:parseTypExprRegion p + :: parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:Rparen + ~f:parse_typ_expr_region p in Parser.expect Rparen p; let () = match typexprs with | [_] -> - Parser.err ~startPos ~endPos:p.prevEndPos p - (Diagnostics.message ErrorMessages.tupleSingleElement) + Parser.err ~start_pos ~end_pos:p.prev_end_pos p + (Diagnostics.message ErrorMessages.tuple_single_element) | _ -> () in - let tupleLoc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.tuple ~attrs ~loc:tupleLoc typexprs + let tuple_loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Typ.tuple ~attrs ~loc:tuple_loc typexprs -and parseTypeConstructorArgRegion p = - if Grammar.isTypExprStart p.Parser.token then Some (parseTypExpr p) +and parse_type_constructor_arg_region p = + if Grammar.is_typ_expr_start p.Parser.token then Some (parse_typ_expr p) else if p.token = LessThan then ( Parser.next p; - parseTypeConstructorArgRegion p) + parse_type_constructor_arg_region p) else None (* Js.Nullable.value<'a> *) -and parseTypeConstructorArgs ~constrName p = +and parse_type_constructor_args ~constr_name p = let opening = p.Parser.token in - let openingStartPos = p.startPos in + let opening_start_pos = p.start_pos in match opening with | LessThan | Lparen -> - Scanner.setDiamondMode p.scanner; + Scanner.set_diamond_mode p.scanner; Parser.next p; - let typeArgs = + let type_args = (* TODO: change Grammar.TypExprList to TypArgList!!! Why did I wrote this? *) - parseCommaDelimitedRegion ~grammar:Grammar.TypExprList - ~closing:GreaterThan ~f:parseTypeConstructorArgRegion p + parse_comma_delimited_region ~grammar:Grammar.TypExprList + ~closing:GreaterThan ~f:parse_type_constructor_arg_region p in let () = match p.token with | Rparen when opening = Token.Lparen -> - let typ = Ast_helper.Typ.constr constrName typeArgs in + let typ = Ast_helper.Typ.constr constr_name type_args in let msg = - Doc.breakableGroup ~forceBreak:true + Doc.breakable_group ~force_break:true (Doc.concat [ Doc.text "Type parameters require angle brackets:"; Doc.indent (Doc.concat - [Doc.line; ResPrinter.printTypExpr typ CommentTable.empty]); + [Doc.line; ResPrinter.print_typ_expr typ CommentTable.empty]); ]) - |> Doc.toString ~width:80 + |> Doc.to_string ~width:80 in - Parser.err ~startPos:openingStartPos p (Diagnostics.message msg); + Parser.err ~start_pos:opening_start_pos p (Diagnostics.message msg); Parser.next p | _ -> Parser.expect GreaterThan p in - Scanner.popMode p.scanner Diamond; - typeArgs + Scanner.pop_mode p.scanner Diamond; + type_args | _ -> [] (* string-field-decl ::= * | string: poly-typexpr * | attributes string-field-decl *) -and parseStringFieldDeclaration p = - let attrs = parseAttributes p in +and parse_string_field_declaration p = + let attrs = parse_attributes p in match p.Parser.token with | String name -> - let nameStartPos = p.startPos in - let nameEndPos = p.endPos in + let name_start_pos = p.start_pos in + let name_end_pos = p.end_pos in Parser.next p; - let fieldName = Location.mkloc name (mkLoc nameStartPos nameEndPos) in + let field_name = Location.mkloc name (mk_loc name_start_pos name_end_pos) in Parser.expect ~grammar:Grammar.TypeExpression Colon p; - let typ = parsePolyTypeExpr p in - Some (Parsetree.Otag (fieldName, attrs, typ)) + let typ = parse_poly_type_expr p in + Some (Parsetree.Otag (field_name, attrs, typ)) | DotDotDot -> Parser.next p; - let typ = parseTypExpr p in + let typ = parse_typ_expr p in Some (Parsetree.Oinherit typ) | Lident name -> - let nameLoc = mkLoc p.startPos p.endPos in + let name_loc = mk_loc p.start_pos p.end_pos in Parser.err p - (Diagnostics.message (ErrorMessages.objectQuotedFieldName name)); + (Diagnostics.message (ErrorMessages.object_quoted_field_name name)); Parser.next p; - let fieldName = Location.mkloc name nameLoc in + let field_name = Location.mkloc name name_loc in Parser.expect ~grammar:Grammar.TypeExpression Colon p; - let typ = parsePolyTypeExpr p in - Some (Parsetree.Otag (fieldName, attrs, typ)) + let typ = parse_poly_type_expr p in + Some (Parsetree.Otag (field_name, attrs, typ)) | _token -> None (* field-decl ::= * | [mutable] field-name : poly-typexpr * | attributes field-decl *) -and parseFieldDeclaration p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in +and parse_field_declaration p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in let mut = if Parser.optional p Token.Mutable then Asttypes.Mutable else Asttypes.Immutable in let lident, loc = match p.token with - | _ -> parseLident p + | _ -> parse_lident p in - let optional = parseOptionalLabel p in + let optional = parse_optional_label p in let name = Location.mkloc lident loc in let typ = match p.Parser.token with | Colon -> Parser.next p; - parsePolyTypeExpr p + parse_poly_type_expr p | _ -> Ast_helper.Typ.constr ~loc:name.loc {name with txt = Lident name.txt} [] in - let loc = mkLoc startPos typ.ptyp_loc.loc_end in + let loc = mk_loc start_pos typ.ptyp_loc.loc_end in (optional, Ast_helper.Type.field ~attrs ~loc ~mut name typ) -and parseFieldDeclarationRegion ?foundObjectField p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in +and parse_field_declaration_region ?found_object_field p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in let mut = if Parser.optional p Token.Mutable then Asttypes.Mutable else Asttypes.Immutable @@ -4556,43 +4556,43 @@ and parseFieldDeclarationRegion ?foundObjectField p = match p.token with | DotDotDot -> Parser.next p; - let name = Location.mkloc "..." (mkLoc startPos p.prevEndPos) in - let typ = parsePolyTypeExpr p in - let loc = mkLoc startPos typ.ptyp_loc.loc_end in + 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 Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ) - | String s when foundObjectField <> None -> - Option.get foundObjectField := true; + | String s when found_object_field <> None -> + Option.get found_object_field := true; Parser.next p; - let name = Location.mkloc s (mkLoc startPos p.prevEndPos) in + let name = Location.mkloc s (mk_loc start_pos p.prev_end_pos) in Parser.expect Colon p; - let typ = parsePolyTypeExpr p in - let loc = mkLoc startPos typ.ptyp_loc.loc_end in + let typ = parse_poly_type_expr p in + let loc = mk_loc start_pos typ.ptyp_loc.loc_end in Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ) | Lident _ -> - let lident, loc = parseLident p in + let lident, loc = parse_lident p in let name = Location.mkloc lident loc in - let optional = parseOptionalLabel p in + let optional = parse_optional_label p in let typ = match p.Parser.token with | Colon -> Parser.next p; - parsePolyTypeExpr p + parse_poly_type_expr p | _ -> Ast_helper.Typ.constr ~loc:name.loc ~attrs {name with txt = Lident name.txt} [] in - let loc = mkLoc startPos typ.ptyp_loc.loc_end in - let attrs = if optional then optionalAttr :: attrs else attrs in + let loc = mk_loc start_pos typ.ptyp_loc.loc_end in + let attrs = if optional then optional_attr :: attrs else attrs in Some (Ast_helper.Type.field ~attrs ~loc ~mut name typ) | _ -> if attrs <> [] then - Parser.err ~startPos p + Parser.err ~start_pos p (Diagnostics.message "Attributes and doc comments can only be used at the beginning of a \ field declaration"); if mut = Mutable then - Parser.err ~startPos p + Parser.err ~start_pos p (Diagnostics.message "The `mutable` qualifier can only be used at the beginning of a \ field declaration"); @@ -4603,15 +4603,15 @@ and parseFieldDeclarationRegion ?foundObjectField p = * | { field-decl, field-decl } * | { field-decl, field-decl, field-decl, } *) -and parseRecordDeclaration p = - Parser.leaveBreadcrumb p Grammar.RecordDecl; +and parse_record_declaration p = + Parser.leave_breadcrumb p Grammar.RecordDecl; Parser.expect Lbrace p; let rows = - parseCommaDelimitedRegion ~grammar:Grammar.RecordDecl ~closing:Rbrace - ~f:parseFieldDeclarationRegion p + parse_comma_delimited_region ~grammar:Grammar.RecordDecl ~closing:Rbrace + ~f:parse_field_declaration_region p in Parser.expect Rbrace p; - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; rows (* constr-args ::= @@ -4623,8 +4623,8 @@ and parseRecordDeclaration p = * TODO: should we overparse inline-records in every position? * Give a good error message afterwards? *) -and parseConstrDeclArgs p = - let constrArgs = +and parse_constr_decl_args p = + let constr_args = match p.Parser.token with | Lparen -> ( Parser.next p; @@ -4632,10 +4632,10 @@ and parseConstrDeclArgs p = match p.Parser.token with | Lbrace -> ( Parser.next p; - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in match p.Parser.token with | DotDot | Dot -> - let closedFlag = + let closed_flag = match p.token with | DotDot -> Parser.next p; @@ -4646,25 +4646,25 @@ and parseConstrDeclArgs p = | _ -> Asttypes.Closed in let fields = - parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations - ~closing:Rbrace ~f:parseStringFieldDeclaration p + parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations + ~closing:Rbrace ~f:parse_string_field_declaration p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in - let typ = Ast_helper.Typ.object_ ~loc ~attrs:[] fields closedFlag in + let loc = mk_loc start_pos p.prev_end_pos in + let typ = Ast_helper.Typ.object_ ~loc ~attrs:[] fields closed_flag in Parser.optional p Comma |> ignore; - let moreArgs = - parseCommaDelimitedRegion ~grammar:Grammar.TypExprList - ~closing:Rparen ~f:parseTypExprRegion p + let more_args = + parse_comma_delimited_region ~grammar:Grammar.TypExprList + ~closing:Rparen ~f:parse_typ_expr_region p in Parser.expect Rparen p; - Parsetree.Pcstr_tuple (typ :: moreArgs) + Parsetree.Pcstr_tuple (typ :: more_args) | DotDotDot -> - let dotdotdotStart = p.startPos in - let dotdotdotEnd = p.endPos in + let dotdotdot_start = p.start_pos in + let dotdotdot_end = p.end_pos in (* start of object type spreading, e.g. `User({...a, "u": int})` *) Parser.next p; - let typ = parseTypExpr p in + let typ = parse_typ_expr p in let () = match p.token with | Rbrace -> @@ -4675,46 +4675,46 @@ and parseConstrDeclArgs p = let () = match p.token with | Lident _ -> - Parser.err ~startPos:dotdotdotStart ~endPos:dotdotdotEnd p - (Diagnostics.message ErrorMessages.spreadInRecordDeclaration) + Parser.err ~start_pos:dotdotdot_start ~end_pos:dotdotdot_end p + (Diagnostics.message ErrorMessages.spread_in_record_declaration) | _ -> () in let fields = Parsetree.Oinherit typ - :: parseCommaDelimitedRegion + :: parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parseStringFieldDeclaration p + ~f:parse_string_field_declaration p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in let typ = Ast_helper.Typ.object_ ~loc fields Asttypes.Closed - |> parseTypeAlias p + |> parse_type_alias p in - let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in + let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in Parser.optional p Comma |> ignore; - let moreArgs = - parseCommaDelimitedRegion ~grammar:Grammar.TypExprList - ~closing:Rparen ~f:parseTypExprRegion p + let more_args = + parse_comma_delimited_region ~grammar:Grammar.TypExprList + ~closing:Rparen ~f:parse_typ_expr_region p in Parser.expect Rparen p; - Parsetree.Pcstr_tuple (typ :: moreArgs) + Parsetree.Pcstr_tuple (typ :: more_args) | _ -> ( - let attrs = parseAttributes p in + let attrs = parse_attributes p in match p.Parser.token with | String _ -> - let closedFlag = Asttypes.Closed in + let closed_flag = Asttypes.Closed in let fields = match attrs with | [] -> - parseCommaDelimitedRegion + parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parseStringFieldDeclaration p + ~f:parse_string_field_declaration p | attrs -> let first = - Parser.leaveBreadcrumb p Grammar.StringFieldDeclarations; + Parser.leave_breadcrumb p Grammar.StringFieldDeclarations; let field = - match parseStringFieldDeclaration p with + match parse_string_field_declaration p with | Some field -> field | None -> assert false in @@ -4725,42 +4725,42 @@ and parseConstrDeclArgs p = | Comma -> Parser.next p | _ -> Parser.expect Comma p in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; match field with | Parsetree.Otag (label, _, ct) -> Parsetree.Otag (label, attrs, ct) | Oinherit ct -> Oinherit ct in first - :: parseCommaDelimitedRegion + :: parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace - ~f:parseStringFieldDeclaration p + ~f:parse_string_field_declaration p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in let typ = - Ast_helper.Typ.object_ ~loc ~attrs:[] fields closedFlag - |> parseTypeAlias p + Ast_helper.Typ.object_ ~loc ~attrs:[] fields closed_flag + |> parse_type_alias p in - let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in + let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in Parser.optional p Comma |> ignore; - let moreArgs = - parseCommaDelimitedRegion ~grammar:Grammar.TypExprList - ~closing:Rparen ~f:parseTypExprRegion p + let more_args = + parse_comma_delimited_region ~grammar:Grammar.TypExprList + ~closing:Rparen ~f:parse_typ_expr_region p in Parser.expect Rparen p; - Parsetree.Pcstr_tuple (typ :: moreArgs) + Parsetree.Pcstr_tuple (typ :: more_args) | _ -> let fields = match attrs with | [] -> - parseCommaDelimitedRegion ~grammar:Grammar.FieldDeclarations - ~closing:Rbrace ~f:parseFieldDeclarationRegion p + parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations + ~closing:Rbrace ~f:parse_field_declaration_region p | attrs -> let first = - let optional, field = parseFieldDeclaration p in + let optional, field = parse_field_declaration p in let attrs = - if optional then optionalAttr :: attrs else attrs + if optional then optional_attr :: attrs else attrs in {field with Parsetree.pld_attributes = attrs} in @@ -4768,9 +4768,9 @@ and parseConstrDeclArgs p = else ( Parser.expect Comma p; first - :: parseCommaDelimitedRegion + :: parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations ~closing:Rbrace - ~f:parseFieldDeclarationRegion p) + ~f:parse_field_declaration_region p) in Parser.expect Rbrace p; Parser.optional p Comma |> ignore; @@ -4778,8 +4778,8 @@ and parseConstrDeclArgs p = Parsetree.Pcstr_record fields)) | _ -> let args = - parseCommaDelimitedRegion ~grammar:Grammar.TypExprList ~closing:Rparen - ~f:parseTypExprRegion p + parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:Rparen + ~f:parse_typ_expr_region p in Parser.expect Rparen p; Parsetree.Pcstr_tuple args) @@ -4789,59 +4789,59 @@ and parseConstrDeclArgs p = match p.Parser.token with | Colon -> Parser.next p; - Some (parseTypExpr p) + Some (parse_typ_expr p) | _ -> None in - (constrArgs, res) + (constr_args, res) (* constr-decl ::= * | constr-name * | attrs constr-name * | constr-name const-args * | attrs constr-name const-args *) -and parseTypeConstructorDeclarationWithBar p = +and parse_type_constructor_declaration_with_bar p = match p.Parser.token with | Bar -> - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in Parser.next p; - Some (parseTypeConstructorDeclaration ~startPos p) + Some (parse_type_constructor_declaration ~start_pos p) | _ -> None -and parseTypeConstructorDeclaration ~startPos p = - Parser.leaveBreadcrumb p Grammar.ConstructorDeclaration; - let attrs = parseAttributes p in +and parse_type_constructor_declaration ~start_pos p = + Parser.leave_breadcrumb p Grammar.ConstructorDeclaration; + let attrs = parse_attributes p in match p.Parser.token with | DotDotDot -> Parser.next p; - let name = Location.mkloc "..." (mkLoc startPos p.prevEndPos) in - let typ = parsePolyTypeExpr p in - let loc = mkLoc startPos typ.ptyp_loc.loc_end in + 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 Ast_helper.Type.constructor ~loc ~attrs ~args:(Pcstr_tuple [typ]) name | Uident uident -> - let uidentLoc = mkLoc p.startPos p.endPos in + let uident_loc = mk_loc p.start_pos p.end_pos in Parser.next p; - let args, res = parseConstrDeclArgs p in - Parser.eatBreadcrumb p; - let loc = mkLoc startPos p.prevEndPos in + let args, res = parse_constr_decl_args p in + Parser.eat_breadcrumb p; + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Type.constructor ~loc ~attrs ?res ~args - (Location.mkloc uident uidentLoc) + (Location.mkloc uident uident_loc) | t -> Parser.err p (Diagnostics.uident t); Ast_helper.Type.constructor (Location.mknoloc "_") (* [|] constr-decl { | constr-decl } *) -and parseTypeConstructorDeclarations ?first p = - let firstConstrDecl = +and parse_type_constructor_declarations ?first p = + let first_constr_decl = match first with | None -> - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in ignore (Parser.optional p Token.Bar); - parseTypeConstructorDeclaration ~startPos p - | Some firstConstrDecl -> firstConstrDecl + parse_type_constructor_declaration ~start_pos p + | Some first_constr_decl -> first_constr_decl in - firstConstrDecl - :: parseRegion ~grammar:Grammar.ConstructorDeclaration - ~f:parseTypeConstructorDeclarationWithBar p + first_constr_decl + :: parse_region ~grammar:Grammar.ConstructorDeclaration + ~f:parse_type_constructor_declaration_with_bar p (* * type-representation ::= @@ -4853,18 +4853,18 @@ and parseTypeConstructorDeclarations ?first p = * ∣ = private record-decl * | = .. *) -and parseTypeRepresentation p = - Parser.leaveBreadcrumb p Grammar.TypeRepresentation; +and parse_type_representation p = + Parser.leave_breadcrumb p Grammar.TypeRepresentation; (* = consumed *) - let privateFlag = + let private_flag = 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 (parseTypeConstructorDeclarations p) - | Lbrace -> Parsetree.Ptype_record (parseRecordDeclaration p) + Parsetree.Ptype_variant (parse_type_constructor_declarations p) + | Lbrace -> Parsetree.Ptype_record (parse_record_declaration p) | DotDot -> Parser.next p; Ptype_open @@ -4873,8 +4873,8 @@ and parseTypeRepresentation p = (* TODO: I have no idea if this is even remotely a good idea *) Parsetree.Ptype_variant [] in - Parser.eatBreadcrumb p; - (privateFlag, kind) + Parser.eat_breadcrumb p; + (private_flag, kind) (* type-param ::= * | variance 'lident @@ -4886,7 +4886,7 @@ and parseTypeRepresentation p = * | - * | (* empty *) *) -and parseTypeParam p = +and parse_type_param p = let variance = match p.Parser.token with | Plus -> @@ -4902,22 +4902,22 @@ and parseTypeParam p = Parser.next p; let ident, loc = if p.Parser.token = Eof then ( - Parser.err ~startPos:p.startPos p + Parser.err ~start_pos:p.start_pos p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); - ("", mkLoc p.startPos p.prevEndPos)) - else parseIdent ~msg:ErrorMessages.typeParam ~startPos:p.startPos p + ("", mk_loc p.start_pos p.prev_end_pos)) + else parse_ident ~msg:ErrorMessages.type_param ~start_pos:p.start_pos p in Some (Ast_helper.Typ.var ~loc ident, variance) | Underscore -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos 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.toString token)); + ("Type params start with a singlequote: '" ^ Token.to_string token)); let ident, loc = - parseIdent ~msg:ErrorMessages.typeParam ~startPos:p.startPos p + parse_ident ~msg:ErrorMessages.type_param ~start_pos:p.start_pos p in Some (Ast_helper.Typ.var ~loc ident, variance) | _token -> None @@ -4930,23 +4930,23 @@ and parseTypeParam p = * * TODO: when we have pretty-printer show an error * with the actual code corrected. *) -and parseTypeParams ~parent p = +and parse_type_params ~parent p = let opening = p.Parser.token in match opening with - | (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; + | (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; Parser.next p; let params = - parseCommaDelimitedRegion ~grammar:Grammar.TypeParams ~closing:GreaterThan - ~f:parseTypeParam p + parse_comma_delimited_region ~grammar:Grammar.TypeParams ~closing:GreaterThan + ~f:parse_type_param p in let () = match p.token with | Rparen when opening = Token.Lparen -> let msg = - Doc.breakableGroup ~forceBreak:true + Doc.breakable_group ~force_break:true (Doc.concat [ Doc.text "Type parameters require angle brackets:"; @@ -4956,41 +4956,41 @@ and parseTypeParams ~parent p = Doc.line; Doc.concat [ - ResPrinter.printLongident parent.Location.txt; - ResPrinter.printTypeParams params CommentTable.empty; + ResPrinter.print_longident parent.Location.txt; + ResPrinter.print_type_params params CommentTable.empty; ]; ]); ]) - |> Doc.toString ~width:80 + |> Doc.to_string ~width:80 in - Parser.err ~startPos:openingStartPos p (Diagnostics.message msg); + Parser.err ~start_pos:opening_start_pos p (Diagnostics.message msg); Parser.next p | _ -> Parser.expect GreaterThan p in - Scanner.popMode p.scanner Diamond; - Parser.eatBreadcrumb p; + Scanner.pop_mode p.scanner Diamond; + Parser.eat_breadcrumb p; params | _ -> [] (* type-constraint ::= constraint ' ident = typexpr *) -and parseTypeConstraint p = - let startPos = p.Parser.startPos in +and parse_type_constraint p = + let start_pos = p.Parser.start_pos in match p.Parser.token with | Token.Constraint -> ( Parser.next p; Parser.expect SingleQuote p; match p.Parser.token with | Lident ident -> - let identLoc = mkLoc startPos p.endPos in + let ident_loc = mk_loc start_pos p.end_pos in Parser.next p; Parser.expect Equal p; - let typ = parseTypExpr p in - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Typ.var ~loc:identLoc ident, typ, loc) + 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) | t -> Parser.err p (Diagnostics.lident t); - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Typ.any (), parseTypExpr p, loc)) + let loc = mk_loc start_pos p.prev_end_pos in + Some (Ast_helper.Typ.any (), parse_typ_expr p, loc)) | _ -> None (* type-constraints ::= @@ -4999,71 +4999,71 @@ and parseTypeConstraint p = * | type-constraint type-constraint * | type-constraint type-constraint type-constraint (* 0 or more *) *) -and parseTypeConstraints p = - parseRegion ~grammar:Grammar.TypeConstraint ~f:parseTypeConstraint p +and parse_type_constraints p = + parse_region ~grammar:Grammar.TypeConstraint ~f:parse_type_constraint p -and parseTypeEquationOrConstrDecl p = - let uidentStartPos = p.Parser.startPos in +and parse_type_equation_or_constr_decl p = + let uident_start_pos = p.Parser.start_pos in match p.Parser.token with | Uident uident -> ( Parser.next p; match p.Parser.token with | Dot -> ( Parser.next p; - let typeConstr = - parseValuePathTail p uidentStartPos (Longident.Lident uident) + let type_constr = + parse_value_path_tail p uident_start_pos (Longident.Lident uident) in - let loc = mkLoc uidentStartPos p.prevEndPos in + let loc = mk_loc uident_start_pos p.prev_end_pos in let typ = - parseTypeAlias p - (Ast_helper.Typ.constr ~loc typeConstr - (parseTypeConstructorArgs ~constrName:typeConstr p)) + parse_type_alias p + (Ast_helper.Typ.constr ~loc type_constr + (parse_type_constructor_args ~constr_name:type_constr p)) in match p.token with | Equal -> Parser.next p; - let priv, kind = parseTypeRepresentation p in + let priv, kind = parse_type_representation p in (Some typ, priv, kind) | EqualGreater -> Parser.next p; - 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 + 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 in let uncurried = p.uncurried_config <> Legacy in - let arrowType = - if uncurried then Ast_uncurried.uncurriedType ~loc ~arity:1 arrowType - else arrowType + let arrow_type = + if uncurried then Ast_uncurried.uncurried_type ~loc ~arity:1 arrow_type + else arrow_type in - let typ = parseTypeAlias p arrowType in + let typ = parse_type_alias p arrow_type in (Some typ, Asttypes.Public, Parsetree.Ptype_abstract) | _ -> (Some typ, Asttypes.Public, Parsetree.Ptype_abstract)) | _ -> - let uidentEndPos = p.prevEndPos in - let args, res = parseConstrDeclArgs p in + let uident_end_pos = p.prev_end_pos in + let args, res = parse_constr_decl_args p in let first = Some - (let uidentLoc = mkLoc uidentStartPos uidentEndPos in + (let uident_loc = mk_loc uident_start_pos uident_end_pos in Ast_helper.Type.constructor - ~loc:(mkLoc uidentStartPos p.prevEndPos) + ~loc:(mk_loc uident_start_pos p.prev_end_pos) ?res ~args - (Location.mkloc uident uidentLoc)) + (Location.mkloc uident uident_loc)) in ( None, Asttypes.Public, - Parsetree.Ptype_variant (parseTypeConstructorDeclarations p ?first) )) + Parsetree.Ptype_variant (parse_type_constructor_declarations p ?first) )) | t -> Parser.err p (Diagnostics.uident t); (* TODO: is this a good idea? *) (None, Asttypes.Public, Parsetree.Ptype_abstract) -and parseRecordOrObjectDecl p = - let startPos = p.Parser.startPos in +and parse_record_or_object_decl p = + let start_pos = p.Parser.start_pos in Parser.expect Lbrace p; match p.Parser.token with | DotDot | Dot -> - let closedFlag = + let closed_flag = match p.token with | DotDot -> Parser.next p; @@ -5074,80 +5074,80 @@ and parseRecordOrObjectDecl p = | _ -> Asttypes.Closed in let fields = - parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations - ~closing:Rbrace ~f:parseStringFieldDeclaration p + parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations + ~closing:Rbrace ~f:parse_string_field_declaration p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in let typ = - Ast_helper.Typ.object_ ~loc ~attrs:[] fields closedFlag - |> parseTypeAlias p + Ast_helper.Typ.object_ ~loc ~attrs:[] fields closed_flag + |> parse_type_alias p in - let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in + let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in (Some typ, Asttypes.Public, Parsetree.Ptype_abstract) | DotDotDot -> ( - let dotdotdotStart = p.startPos in - let dotdotdotEnd = p.endPos in + let dotdotdot_start = p.start_pos in + let dotdotdot_end = p.end_pos in (* start of object type spreading, e.g. `type u = {...a, "u": int}` *) Parser.next p; - let typ = parseTypExpr p in + let typ = parse_typ_expr p in match p.token with | Rbrace -> (* {...x}, spread without extra fields *) Parser.next p; - let loc = mkLoc startPos p.prevEndPos in - let dotField = + let loc = mk_loc start_pos p.prev_end_pos in + let dot_field = Ast_helper.Type.field ~loc - {txt = "..."; loc = mkLoc dotdotdotStart dotdotdotEnd} + {txt = "..."; loc = mk_loc dotdotdot_start dotdotdot_end} typ in - let kind = Parsetree.Ptype_record [dotField] in + let kind = Parsetree.Ptype_record [dot_field] in (None, Public, kind) | _ -> Parser.expect Comma p; - let loc = mkLoc startPos p.prevEndPos in - let dotField = + let loc = mk_loc start_pos p.prev_end_pos in + let dot_field = Ast_helper.Type.field ~loc - {txt = "..."; loc = mkLoc dotdotdotStart dotdotdotEnd} + {txt = "..."; loc = mk_loc dotdotdot_start dotdotdot_end} typ in - let foundObjectField = ref false in + let found_object_field = ref false in let fields = - parseCommaDelimitedRegion ~grammar:Grammar.RecordDecl ~closing:Rbrace - ~f:(parseFieldDeclarationRegion ~foundObjectField) + parse_comma_delimited_region ~grammar:Grammar.RecordDecl ~closing:Rbrace + ~f:(parse_field_declaration_region ~found_object_field) p in Parser.expect Rbrace p; - if !foundObjectField then + if !found_object_field 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 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 + 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 (Some typ_obj, Public, Ptype_abstract) else - let kind = Parsetree.Ptype_record (dotField :: fields) in + let kind = Parsetree.Ptype_record (dot_field :: fields) in (None, Public, kind)) | _ -> ( - let attrs = parseAttributes p in + let attrs = parse_attributes p in match p.Parser.token with | String _ -> - let closedFlag = Asttypes.Closed in + let closed_flag = Asttypes.Closed in let fields = match attrs with | [] -> - parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations - ~closing:Rbrace ~f:parseStringFieldDeclaration p + parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations + ~closing:Rbrace ~f:parse_string_field_declaration p | attrs -> let first = - Parser.leaveBreadcrumb p Grammar.StringFieldDeclarations; + Parser.leave_breadcrumb p Grammar.StringFieldDeclarations; let field = - match parseStringFieldDeclaration p with + match parse_string_field_declaration p with | Some field -> field | None -> assert false in @@ -5158,35 +5158,35 @@ and parseRecordOrObjectDecl p = | Comma -> Parser.next p | _ -> Parser.expect Comma p in - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; match field with | Parsetree.Otag (label, _, ct) -> Parsetree.Otag (label, attrs, ct) | Oinherit ct -> Oinherit ct in first - :: parseCommaDelimitedRegion ~grammar:Grammar.StringFieldDeclarations - ~closing:Rbrace ~f:parseStringFieldDeclaration p + :: parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations + ~closing:Rbrace ~f:parse_string_field_declaration p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in let typ = - Ast_helper.Typ.object_ ~loc ~attrs:[] fields closedFlag - |> parseTypeAlias p + Ast_helper.Typ.object_ ~loc ~attrs:[] fields closed_flag + |> parse_type_alias p in - let typ = parseArrowTypeRest ~es6Arrow:true ~startPos typ p in + let typ = parse_arrow_type_rest ~es6_arrow:true ~start_pos typ p in (Some typ, Asttypes.Public, Parsetree.Ptype_abstract) | _ -> - Parser.leaveBreadcrumb p Grammar.RecordDecl; + Parser.leave_breadcrumb p Grammar.RecordDecl; let fields = (* XXX *) match attrs with | [] -> - parseCommaDelimitedRegion ~grammar:Grammar.FieldDeclarations - ~closing:Rbrace ~f:parseFieldDeclarationRegion p + parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations + ~closing:Rbrace ~f:parse_field_declaration_region p | attr :: _ as attrs -> let first = - let optional, field = parseFieldDeclaration p in - let attrs = if optional then optionalAttr :: attrs else attrs in + let optional, field = parse_field_declaration p in + let attrs = if optional then optional_attr :: attrs else attrs in Parser.optional p Comma |> ignore; { field with @@ -5199,29 +5199,29 @@ and parseRecordOrObjectDecl p = } in first - :: parseCommaDelimitedRegion ~grammar:Grammar.FieldDeclarations - ~closing:Rbrace ~f:parseFieldDeclarationRegion p + :: parse_comma_delimited_region ~grammar:Grammar.FieldDeclarations + ~closing:Rbrace ~f:parse_field_declaration_region p in Parser.expect Rbrace p; - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; (None, Asttypes.Public, Parsetree.Ptype_record fields)) -and parsePrivateEqOrRepr p = +and parse_private_eq_or_repr p = Parser.expect Private p; match p.Parser.token with | Lbrace -> - let manifest, _, kind = parseRecordOrObjectDecl p in + let manifest, _, kind = parse_record_or_object_decl p in (manifest, Asttypes.Private, kind) | Uident _ -> - let manifest, _, kind = parseTypeEquationOrConstrDecl p in + let manifest, _, kind = parse_type_equation_or_constr_decl p in (manifest, Asttypes.Private, kind) | Bar | DotDot -> - let _, kind = parseTypeRepresentation p in + let _, kind = parse_type_representation p in (None, Asttypes.Private, kind) - | t when Grammar.isTypExprStart t -> - (Some (parseTypExpr p), Asttypes.Private, Parsetree.Ptype_abstract) + | t when Grammar.is_typ_expr_start t -> + (Some (parse_typ_expr p), Asttypes.Private, Parsetree.Ptype_abstract) | _ -> - let _, kind = parseTypeRepresentation p in + let _, kind = parse_type_representation p in (None, Asttypes.Private, kind) (* @@ -5239,149 +5239,149 @@ and parsePrivateEqOrRepr p = tag-spec-full ::= `tag-name [ of [&] typexpr { & typexpr } ] | typexpr *) -and parsePolymorphicVariantType ~attrs p = - let startPos = p.Parser.startPos in +and parse_polymorphic_variant_type ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Lbracket p; match p.token with | GreaterThan -> Parser.next p; - let rowFields = + let row_fields = match p.token with | Rbracket -> [] - | Bar -> parseTagSpecs p + | Bar -> parse_tag_specs p | _ -> - let rowField = parseTagSpec p in - rowField :: parseTagSpecs p + let row_field = parse_tag_spec p in + row_field :: parse_tag_specs p in let variant = - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.variant ~attrs ~loc rowFields Open None + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Typ.variant ~attrs ~loc row_fields Open None in Parser.expect Rbracket p; variant | LessThan -> Parser.next p; Parser.optional p Bar |> ignore; - let rowField = parseTagSpecFull p in - let rowFields = parseTagSpecFulls p in - let tagNames = parseTagNames p in + 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 variant = - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.variant ~attrs ~loc (rowField :: rowFields) Closed - (Some tagNames) + 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) in Parser.expect Rbracket p; variant | _ -> - let rowFields1 = parseTagSpecFirst p in - let rowFields2 = parseTagSpecs p in + let row_fields1 = parse_tag_spec_first p in + let row_fields2 = parse_tag_specs p in let variant = - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Typ.variant ~attrs ~loc (rowFields1 @ rowFields2) Closed None + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Typ.variant ~attrs ~loc (row_fields1 @ row_fields2) Closed None in Parser.expect Rbracket p; variant -and parseTagName p = +and parse_tag_name p = match p.Parser.token with | Hash -> - let ident, _loc = parseHashIdent ~startPos:p.startPos p in + let ident, _loc = parse_hash_ident ~start_pos:p.start_pos p in Some ident | _ -> None -and parseTagNames p = +and parse_tag_names p = if p.Parser.token == GreaterThan then ( Parser.next p; - parseRegion p ~grammar:Grammar.TagNames ~f:parseTagName) + parse_region p ~grammar:Grammar.TagNames ~f:parse_tag_name) else [] -and parseTagSpecFulls p = +and parse_tag_spec_fulls p = match p.Parser.token with | Rbracket -> [] | GreaterThan -> [] | Bar -> Parser.next p; - let rowField = parseTagSpecFull p in - rowField :: parseTagSpecFulls p + let row_field = parse_tag_spec_full p in + row_field :: parse_tag_spec_fulls p | _ -> [] -and parseTagSpecFull p = - let attrs = parseAttributes p in +and parse_tag_spec_full p = + let attrs = parse_attributes p in match p.Parser.token with - | Hash -> parsePolymorphicVariantTypeSpecHash ~attrs ~full:true p + | Hash -> parse_polymorphic_variant_type_spec_hash ~attrs ~full:true p | _ -> - let typ = parseTypExpr ~attrs p in + let typ = parse_typ_expr ~attrs p in Parsetree.Rinherit typ -and parseTagSpecs p = +and parse_tag_specs p = match p.Parser.token with | Bar -> Parser.next p; - let rowField = parseTagSpec p in - rowField :: parseTagSpecs p + let row_field = parse_tag_spec p in + row_field :: parse_tag_specs p | _ -> [] -and parseTagSpec p = - let attrs = parseAttributes p in +and parse_tag_spec p = + let attrs = parse_attributes p in match p.Parser.token with - | Hash -> parsePolymorphicVariantTypeSpecHash ~attrs ~full:false p + | Hash -> parse_polymorphic_variant_type_spec_hash ~attrs ~full:false p | _ -> - let typ = parseTypExpr ~attrs p in + let typ = parse_typ_expr ~attrs p in Parsetree.Rinherit typ -and parseTagSpecFirst p = - let attrs = parseAttributes p in +and parse_tag_spec_first p = + let attrs = parse_attributes p in match p.Parser.token with | Bar -> Parser.next p; - [parseTagSpec p] - | Hash -> [parsePolymorphicVariantTypeSpecHash ~attrs ~full:false p] + [parse_tag_spec p] + | Hash -> [parse_polymorphic_variant_type_spec_hash ~attrs ~full:false p] | _ -> ( - let typ = parseTypExpr ~attrs p in + let typ = parse_typ_expr ~attrs p in match p.token with | Rbracket -> (* example: [ListStyleType.t] *) [Parsetree.Rinherit typ] | _ -> Parser.expect Bar p; - [Parsetree.Rinherit typ; parseTagSpec p]) + [Parsetree.Rinherit typ; parse_tag_spec p]) -and parsePolymorphicVariantTypeSpecHash ~attrs ~full p : Parsetree.row_field = - let startPos = p.Parser.startPos in - let ident, loc = parseHashIdent ~startPos p in +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 let rec loop p = match p.Parser.token with | Band when full -> Parser.next p; - let rowField = parsePolymorphicVariantTypeArgs p in - rowField :: loop p + let row_field = parse_polymorphic_variant_type_args p in + row_field :: loop p | _ -> [] in - let firstTuple, tagContainsAConstantEmptyConstructor = + let first_tuple, tag_contains_a_constant_empty_constructor = match p.Parser.token with | Band when full -> Parser.next p; - ([parsePolymorphicVariantTypeArgs p], true) - | Lparen -> ([parsePolymorphicVariantTypeArgs p], false) + ([parse_polymorphic_variant_type_args p], true) + | Lparen -> ([parse_polymorphic_variant_type_args p], false) | _ -> ([], true) in - let tuples = firstTuple @ loop p in + let tuples = first_tuple @ loop p in Parsetree.Rtag ( Location.mkloc ident loc, attrs, - tagContainsAConstantEmptyConstructor, + tag_contains_a_constant_empty_constructor, tuples ) -and parsePolymorphicVariantTypeArgs p = - let startPos = p.Parser.startPos in +and parse_polymorphic_variant_type_args p = + let start_pos = p.Parser.start_pos in Parser.expect Lparen p; let args = - parseCommaDelimitedRegion ~grammar:Grammar.TypExprList ~closing:Rparen - ~f:parseTypExprRegion p + parse_comma_delimited_region ~grammar:Grammar.TypExprList ~closing:Rparen + ~f:parse_typ_expr_region p in Parser.expect Rparen p; let attrs = [] in - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in match args with | [({ptyp_desc = Ptyp_tuple _} as typ)] as types -> if p.mode = ParseForTypeChecker then typ @@ -5389,24 +5389,24 @@ and parsePolymorphicVariantTypeArgs p = | [typ] -> typ | types -> Ast_helper.Typ.tuple ~loc ~attrs types -and parseTypeEquationAndRepresentation p = +and parse_type_equation_and_representation 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 _ -> parseTypeEquationOrConstrDecl p - | Lbrace -> parseRecordOrObjectDecl p - | Private -> parsePrivateEqOrRepr p + | Uident _ -> parse_type_equation_or_constr_decl p + | Lbrace -> parse_record_or_object_decl p + | Private -> parse_private_eq_or_repr p | Bar | DotDot -> - let priv, kind = parseTypeRepresentation p in + let priv, kind = parse_type_representation p in (None, priv, kind) | _ -> ( - let manifest = Some (parseTypExpr p) in + let manifest = Some (parse_typ_expr p) in match p.Parser.token with | Equal -> Parser.next p; - let priv, kind = parseTypeRepresentation p in + let priv, kind = parse_type_representation p in (manifest, priv, kind) | _ -> (manifest, Public, Parsetree.Ptype_abstract))) | _ -> (None, Public, Parsetree.Ptype_abstract) @@ -5415,91 +5415,91 @@ and parseTypeEquationAndRepresentation p = * typedef ::= typeconstr-name [type-params] type-information * type-information ::= [type-equation] [type-representation] { type-constraint } * type-equation ::= = typexpr *) -and parseTypeDef ~attrs ~startPos p = - Parser.leaveBreadcrumb p Grammar.TypeDef; +and parse_type_def ~attrs ~start_pos p = + Parser.leave_breadcrumb p Grammar.TypeDef; (* let attrs = match attrs with | Some attrs -> attrs | None -> parseAttributes p in *) - Parser.leaveBreadcrumb p Grammar.TypeConstrName; - let name, loc = parseLident p in - let typeConstrName = Location.mkloc name loc in - Parser.eatBreadcrumb p; + 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; let params = - let constrName = Location.mkloc (Longident.Lident name) loc in - parseTypeParams ~parent:constrName p + let constr_name = Location.mkloc (Longident.Lident name) loc in + parse_type_params ~parent:constr_name p in - let typeDef = - let manifest, priv, kind = parseTypeEquationAndRepresentation p in - let cstrs = parseTypeConstraints p in - let loc = mkLoc startPos p.prevEndPos 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 Ast_helper.Type.mk ~loc ~attrs ~priv ~kind ~params ~cstrs ?manifest - typeConstrName + type_constr_name in - Parser.eatBreadcrumb p; - typeDef + Parser.eat_breadcrumb p; + type_def -and parseTypeExtension ~params ~attrs ~name p = +and parse_type_extension ~params ~attrs ~name p = Parser.expect PlusEqual p; let priv = if Parser.optional p Token.Private then Asttypes.Private else Asttypes.Public in - let constrStart = p.Parser.startPos in + let constr_start = p.Parser.start_pos in Parser.optional p Bar |> ignore; let first = let attrs, name, kind = match p.Parser.token with | Bar -> Parser.next p; - parseConstrDef ~parseAttrs:true p - | _ -> parseConstrDef ~parseAttrs:true p + parse_constr_def ~parse_attrs:true p + | _ -> parse_constr_def ~parse_attrs:true p in - let loc = mkLoc constrStart p.prevEndPos in + let loc = mk_loc constr_start p.prev_end_pos in Ast_helper.Te.constructor ~loc ~attrs name kind in let rec loop p cs = match p.Parser.token with | Bar -> - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in Parser.next p; - let attrs, name, kind = parseConstrDef ~parseAttrs:true p in - let extConstr = + let attrs, name, kind = parse_constr_def ~parse_attrs:true p in + let ext_constr = Ast_helper.Te.constructor ~attrs - ~loc:(mkLoc startPos p.prevEndPos) + ~loc:(mk_loc start_pos p.prev_end_pos) name kind in - loop p (extConstr :: cs) + loop p (ext_constr :: cs) | _ -> List.rev cs in let constructors = loop p [first] in Ast_helper.Te.mk ~attrs ~params ~priv name constructors -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 +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 Ast_helper.Type.mk ~loc ~attrs ~priv ~kind ~params ~cstrs ?manifest - {name with txt = lidentOfPath name.Location.txt} + {name with txt = lident_of_path name.Location.txt} in let rec loop p defs = - let startPos = p.Parser.startPos in - let attrs = parseAttributesAndBinding p in + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes_and_binding p in match p.Parser.token with | And -> Parser.next p; - let typeDef = parseTypeDef ~attrs ~startPos p in - loop p (typeDef :: defs) + let type_def = parse_type_def ~attrs ~start_pos p in + loop p (type_def :: defs) | _ -> List.rev defs in - loop p [typeDef] + loop p [type_def] (* 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 parseTypeDefinitionOrExtension ~attrs p = - let startPos = p.Parser.startPos in +and parse_type_definition_or_extension ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Token.Typ p; - let recFlag = + let rec_flag = match p.token with | Rec -> Parser.next p; @@ -5509,35 +5509,35 @@ and parseTypeDefinitionOrExtension ~attrs p = Asttypes.Nonrecursive | _ -> Asttypes.Nonrecursive in - let name = parseValuePath p in - let params = parseTypeParams ~parent:name p in + let name = parse_value_path p in + let params = parse_type_params ~parent:name p in match p.Parser.token with - | PlusEqual -> TypeExt (parseTypeExtension ~params ~attrs ~name p) + | PlusEqual -> TypeExt (parse_type_extension ~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 ~startPos:name.loc.loc_start ~endPos:name.loc.loc_end p - (longident |> ErrorMessages.typeDeclarationNameLongident + Parser.err ~start_pos:name.loc.loc_start ~end_pos:name.loc.loc_end p + (longident |> ErrorMessages.type_declaration_name_longident |> Diagnostics.message) in - let typeDefs = parseTypeDefinitions ~attrs ~name ~params ~startPos p in - TypeDef {recFlag; types = typeDefs} + let type_defs = parse_type_definitions ~attrs ~name ~params ~start_pos p in + TypeDef {rec_flag; types = type_defs} (* external value-name : typexp = external-declaration *) -and parseExternalDef ~attrs ~startPos p = - let inExternal = !InExternal.status in +and parse_external_def ~attrs ~start_pos p = + let in_external = !InExternal.status in InExternal.status := true; - Parser.leaveBreadcrumb p Grammar.External; + Parser.leave_breadcrumb p Grammar.External; Parser.expect Token.External p; - let name, loc = parseLident p in + let name, loc = parse_lident p in let name = Location.mkloc name loc in Parser.expect ~grammar:Grammar.TypeExpression Colon p; - let typExpr = parseTypExpr p in - let equalStart = p.startPos in - let equalEnd = p.endPos in + let typ_expr = parse_typ_expr p in + let equal_start = p.start_pos in + let equal_end = p.end_pos in Parser.expect Equal p; let prim = match p.token with @@ -5545,16 +5545,16 @@ and parseExternalDef ~attrs ~startPos p = Parser.next p; [s] | _ -> - Parser.err ~startPos:equalStart ~endPos:equalEnd p + Parser.err ~start_pos:equal_start ~end_pos:equal_end p (Diagnostics.message ("An external requires the name of the JS value you're referring \ to, like \"" ^ name.txt ^ "\".")); [] in - 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; + 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; vb (* constr-def ::= @@ -5564,12 +5564,12 @@ and parseExternalDef ~attrs ~startPos p = * constr-decl ::= constr-name constr-args * constr-name ::= uident * constr ::= path-uident *) -and parseConstrDef ~parseAttrs p = - let attrs = if parseAttrs then parseAttributes p else [] in +and parse_constr_def ~parse_attrs p = + let attrs = if parse_attrs then parse_attributes p else [] in let name = match p.Parser.token with | Uident name -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Location.mkloc name loc | t -> @@ -5579,15 +5579,15 @@ and parseConstrDef ~parseAttrs p = let kind = match p.Parser.token with | Lparen -> - let args, res = parseConstrDeclArgs p in + let args, res = parse_constr_decl_args p in Parsetree.Pext_decl (args, res) | Equal -> Parser.next p; - let longident = parseModuleLongIdent ~lowercase:false p in + let longident = parse_module_long_ident ~lowercase:false p in Parsetree.Pext_rebind longident | Colon -> Parser.next p; - let typ = parseTypExpr p in + let typ = parse_typ_expr p in Parsetree.Pext_decl (Pcstr_tuple [], Some typ) | _ -> Parsetree.Pext_decl (Pcstr_tuple [], None) in @@ -5600,74 +5600,74 @@ and parseConstrDef ~parseAttrs p = * * constr-name ::= uident * constr ::= long_uident *) -and parseExceptionDef ~attrs p = - let startPos = p.Parser.startPos in +and parse_exception_def ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Token.Exception p; - let _, name, kind = parseConstrDef ~parseAttrs:false p in - let loc = mkLoc startPos p.prevEndPos in + let _, name, kind = parse_constr_def ~parse_attrs:false p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Te.constructor ~loc ~attrs name kind -and parseNewlineOrSemicolonStructure p = +and parse_newline_or_semicolon_structure p = match p.Parser.token with | Semicolon -> Parser.next p - | token when Grammar.isStructureItemStart token -> - if p.prevEndPos.pos_lnum < p.startPos.pos_lnum then () + | token when Grammar.is_structure_item_start token -> + if p.prev_end_pos.pos_lnum < p.start_pos.pos_lnum then () else - Parser.err ~startPos:p.prevEndPos ~endPos:p.endPos p + Parser.err ~start_pos:p.prev_end_pos ~end_pos:p.end_pos p (Diagnostics.message "consecutive statements on a line must be separated by ';' or a \ newline") | _ -> () -and parseStructureItemRegion p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in +and parse_structure_item_region p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in match p.Parser.token with | Open -> - let openDescription = parseOpenDescription ~attrs p in - parseNewlineOrSemicolonStructure p; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Str.open_ ~loc openDescription) + 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 -> - let recFlag, letBindings = parseLetBindings ~attrs p in - parseNewlineOrSemicolonStructure p; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Str.value ~loc recFlag letBindings) + let rec_flag, let_bindings = parse_let_bindings ~attrs 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) | Typ -> ( - 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) + 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) | TypeExt ext -> - parseNewlineOrSemicolonStructure p; - let loc = mkLoc startPos p.prevEndPos in - Parser.endRegion p; + 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_extension ~loc ext)) | External -> - let externalDef = parseExternalDef ~attrs ~startPos p in - parseNewlineOrSemicolonStructure p; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Str.primitive ~loc externalDef) + 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) | Exception -> - let exceptionDef = parseExceptionDef ~attrs p in - parseNewlineOrSemicolonStructure p; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Str.exception_ ~loc exceptionDef) + 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) | Include -> - let includeStatement = parseIncludeStatement ~attrs p in - parseNewlineOrSemicolonStructure p; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Str.include_ ~loc includeStatement) + 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) | Module -> - 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} + 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} | ModuleComment (loc, s) -> Parser.next p; Some @@ -5679,105 +5679,105 @@ and parseStructureItemRegion p = (Ast_helper.Exp.constant ~loc (Pconst_string (s, None))); ] )) | AtAt -> - let attr = parseStandaloneAttribute p in - parseNewlineOrSemicolonStructure p; - let loc = mkLoc startPos p.prevEndPos in + let attr = parse_standalone_attribute p in + parse_newline_or_semicolon_structure p; + let loc = mk_loc start_pos p.prev_end_pos in Some (Ast_helper.Str.attribute ~loc attr) | PercentPercent -> - let extension = parseExtension ~moduleLanguage:true p in - parseNewlineOrSemicolonStructure p; - let loc = mkLoc startPos p.prevEndPos in + 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 Some (Ast_helper.Str.extension ~attrs ~loc extension) - | 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 + | 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 ~result:(Ast_helper.Str.eval ~loc ~attrs exp) p | _ -> ( match attrs with - | (({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 + | (({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 Some - (Ast_helper.Str.eval ~loc:(mkLoc p.startPos p.prevEndPos) ~attrs expr) + (Ast_helper.Str.eval ~loc:(mk_loc p.start_pos p.prev_end_pos) ~attrs expr) | _ -> None) -[@@progress Parser.next, Parser.expect, LoopProgress.listRest] +[@@progress Parser.next, Parser.expect, LoopProgress.list_rest] (* include-statement ::= include module-expr *) -and parseIncludeStatement ~attrs p = - let startPos = p.Parser.startPos in +and parse_include_statement ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Token.Include p; - let modExpr = parseModuleExpr p in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Incl.mk ~loc ~attrs modExpr + 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 -and parseAtomicModuleExpr p = - let startPos = p.Parser.startPos in +and parse_atomic_module_expr p = + let start_pos = p.Parser.start_pos in match p.Parser.token with | Uident _ident -> - let longident = parseModuleLongIdent ~lowercase:false p in + let longident = parse_module_long_ident ~lowercase:false p in Ast_helper.Mod.ident ~loc:longident.loc longident | Lbrace -> Parser.next p; let structure = Ast_helper.Mod.structure - (parseDelimitedRegion ~grammar:Grammar.Structure ~closing:Rbrace - ~f:parseStructureItemRegion p) + (parse_delimited_region ~grammar:Grammar.Structure ~closing:Rbrace + ~f:parse_structure_item_region p) in Parser.expect Rbrace p; - let endPos = p.prevEndPos in - {structure with pmod_loc = mkLoc startPos endPos} + let end_pos = p.prev_end_pos in + {structure with pmod_loc = mk_loc start_pos end_pos} | Lparen -> Parser.next p; - let modExpr = + let mod_expr = match p.token with - | Rparen -> Ast_helper.Mod.structure ~loc:(mkLoc startPos p.prevEndPos) [] - | _ -> parseConstrainedModExpr p + | Rparen -> Ast_helper.Mod.structure ~loc:(mk_loc start_pos p.prev_end_pos) [] + | _ -> parse_constrained_mod_expr p in Parser.expect Rparen p; - modExpr + mod_expr | Lident "unpack" -> ( (* TODO: should this be made a keyword?? *) Parser.next p; Parser.expect Lparen p; - let expr = parseExpr p in + let expr = parse_expr p in match p.Parser.token with | Colon -> - let colonStart = p.Parser.startPos in + let colon_start = p.Parser.start_pos in Parser.next p; - let attrs = parseAttributes p in - let packageType = parsePackageType ~startPos:colonStart ~attrs p in + let attrs = parse_attributes p in + let package_type = parse_package_type ~start_pos:colon_start ~attrs p in Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in - let constraintExpr = Ast_helper.Exp.constraint_ ~loc expr packageType in - Ast_helper.Mod.unpack ~loc constraintExpr + 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 | _ -> Parser.expect Rparen p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Mod.unpack ~loc expr) | Percent -> - let extension = parseExtension p in - let loc = mkLoc startPos p.prevEndPos in + let extension = parse_extension p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Mod.extension ~loc extension | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Recover.defaultModuleExpr () + Recover.default_module_expr () -and parsePrimaryModExpr p = - let startPos = p.Parser.startPos in - let modExpr = parseAtomicModuleExpr p in - let rec loop p modExpr = +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 = match p.Parser.token with - | Lparen when p.prevEndPos.pos_lnum == p.startPos.pos_lnum -> - loop p (parseModuleApplication p modExpr) - | _ -> modExpr + | Lparen when p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> + loop p (parse_module_application p mod_expr) + | _ -> mod_expr in - let modExpr = loop p modExpr in - {modExpr with pmod_loc = mkLoc startPos p.prevEndPos} + let mod_expr = loop p mod_expr in + {mod_expr with pmod_loc = mk_loc start_pos p.prev_end_pos} (* * functor-arg ::= @@ -5786,93 +5786,93 @@ and parsePrimaryModExpr p = * | modtype --> "punning" for _ : modtype * | attributes functor-arg *) -and parseFunctorArg p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in +and parse_functor_arg p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in match p.Parser.token with | Uident ident -> ( Parser.next p; - let uidentEndPos = p.prevEndPos in + let uident_end_pos = p.prev_end_pos in match p.Parser.token with | Colon -> Parser.next p; - let moduleType = parseModuleType p in - let loc = mkLoc startPos uidentEndPos in - let argName = Location.mkloc ident loc in - Some (attrs, argName, Some moduleType, startPos) + 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) | Dot -> Parser.next p; - let moduleType = - let moduleLongIdent = - parseModuleLongIdentTail ~lowercase:false p startPos + let module_type = + let module_long_ident = + parse_module_long_ident_tail ~lowercase:false p start_pos (Longident.Lident ident) in - Ast_helper.Mty.ident ~loc:moduleLongIdent.loc moduleLongIdent + Ast_helper.Mty.ident ~loc:module_long_ident.loc module_long_ident in - let argName = Location.mknoloc "_" in - Some (attrs, argName, Some moduleType, startPos) + 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)) + 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)) | Underscore -> Parser.next p; - let argName = Location.mkloc "_" (mkLoc startPos p.prevEndPos) in + let arg_name = Location.mkloc "_" (mk_loc start_pos p.prev_end_pos) in Parser.expect Colon p; - let moduleType = parseModuleType p in - Some (attrs, argName, Some moduleType, startPos) + let module_type = parse_module_type p in + Some (attrs, arg_name, Some module_type, start_pos) | Lparen -> Parser.next p; Parser.expect Rparen p; - let argName = Location.mkloc "*" (mkLoc startPos p.prevEndPos) in - Some (attrs, argName, None, startPos) + let arg_name = Location.mkloc "*" (mk_loc start_pos p.prev_end_pos) in + Some (attrs, arg_name, None, start_pos) | _ -> None -and parseFunctorArgs p = - let startPos = p.Parser.startPos in +and parse_functor_args p = + let start_pos = p.Parser.start_pos in Parser.expect Lparen p; let args = - parseCommaDelimitedRegion ~grammar:Grammar.FunctorArgs ~closing:Rparen - ~f:parseFunctorArg p + parse_comma_delimited_region ~grammar:Grammar.FunctorArgs ~closing:Rparen + ~f:parse_functor_arg p in Parser.expect Rparen p; match args with | [] -> - [([], Location.mkloc "*" (mkLoc startPos p.prevEndPos), None, startPos)] + [([], Location.mkloc "*" (mk_loc start_pos p.prev_end_pos), None, start_pos)] | args -> args -and parseFunctorModuleExpr p = - let startPos = p.Parser.startPos in - let args = parseFunctorArgs p in - let returnType = +and parse_functor_module_expr p = + let start_pos = p.Parser.start_pos in + let args = parse_functor_args p in + let return_type = match p.Parser.token with | Colon -> Parser.next p; - Some (parseModuleType ~es6Arrow:false p) + Some (parse_module_type ~es6_arrow:false p) | _ -> None in Parser.expect EqualGreater p; - let rhsModuleExpr = - let modExpr = parseModuleExpr p in - match returnType with - | Some modType -> + let rhs_module_expr = + let mod_expr = parse_module_expr p in + match return_type with + | Some mod_type -> Ast_helper.Mod.constraint_ ~loc: - (mkLoc modExpr.pmod_loc.loc_start modType.Parsetree.pmty_loc.loc_end) - modExpr modType - | None -> modExpr + (mk_loc mod_expr.pmod_loc.loc_start mod_type.Parsetree.pmty_loc.loc_end) + mod_expr mod_type + | None -> mod_expr in - let endPos = p.prevEndPos in - let modExpr = + let end_pos = p.prev_end_pos in + let mod_expr = List.fold_right - (fun (attrs, name, moduleType, startPos) acc -> - Ast_helper.Mod.functor_ ~loc:(mkLoc startPos endPos) ~attrs name - moduleType acc) - args rhsModuleExpr + (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 in - {modExpr with pmod_loc = mkLoc startPos endPos} + {mod_expr with pmod_loc = mk_loc start_pos end_pos} (* module-expr ::= * | module-path @@ -5883,229 +5883,229 @@ and parseFunctorModuleExpr p = * ∣ ( module-expr : module-type ) * | extension * | attributes module-expr *) -and parseModuleExpr p = - let hasAwait, loc_await = - let startPos = p.startPos in +and parse_module_expr p = + let has_await, loc_await = + let start_pos = p.start_pos in match p.Parser.token with | Await -> Parser.expect Await p; - let endPos = p.endPos in - (true, mkLoc startPos endPos) - | _ -> (false, mkLoc startPos startPos) + let end_pos = p.end_pos in + (true, mk_loc start_pos end_pos) + | _ -> (false, mk_loc start_pos start_pos) in - let attrs = parseAttributes p in + let attrs = parse_attributes p in let attrs = - if hasAwait then + if has_await then (({txt = "res.await"; loc = loc_await}, PStr []) : Parsetree.attribute) :: attrs else attrs in - let modExpr = - if isEs6ArrowFunctor p then parseFunctorModuleExpr p - else parsePrimaryModExpr p + let mod_expr = + if is_es6_arrow_functor p then parse_functor_module_expr p + else parse_primary_mod_expr p in - {modExpr with pmod_attributes = List.concat [modExpr.pmod_attributes; attrs]} + {mod_expr with pmod_attributes = List.concat [mod_expr.pmod_attributes; attrs]} -and parseConstrainedModExpr p = - let modExpr = parseModuleExpr p in +and parse_constrained_mod_expr p = + let mod_expr = parse_module_expr p in match p.Parser.token with | Colon -> Parser.next 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 + 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 parseConstrainedModExprRegion p = - if Grammar.isModExprStart p.Parser.token then Some (parseConstrainedModExpr p) +and parse_constrained_mod_expr_region p = + if Grammar.is_mod_expr_start p.Parser.token then Some (parse_constrained_mod_expr p) else None -and parseModuleApplication p modExpr = - let startPos = p.Parser.startPos in +and parse_module_application p mod_expr = + let start_pos = p.Parser.start_pos in Parser.expect Lparen p; let args = - parseCommaDelimitedRegion ~grammar:Grammar.ModExprList ~closing:Rparen - ~f:parseConstrainedModExprRegion p + parse_comma_delimited_region ~grammar:Grammar.ModExprList ~closing:Rparen + ~f:parse_constrained_mod_expr_region p in Parser.expect Rparen p; let args = match args with | [] -> - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in [Ast_helper.Mod.structure ~loc []] | args -> args in List.fold_left - (fun modExpr arg -> + (fun mod_expr arg -> Ast_helper.Mod.apply ~loc: - (mkLoc modExpr.Parsetree.pmod_loc.loc_start + (mk_loc mod_expr.Parsetree.pmod_loc.loc_start arg.Parsetree.pmod_loc.loc_end) - modExpr arg) - modExpr args + mod_expr arg) + mod_expr args -and parseModuleOrModuleTypeImplOrPackExpr ~attrs p = - let startPos = p.Parser.startPos in +and parse_module_or_module_type_impl_or_pack_expr ~attrs p = + let start_pos = p.Parser.start_pos in Parser.expect Module p; match p.Parser.token with - | Typ -> parseModuleTypeImpl ~attrs startPos p + | Typ -> parse_module_type_impl ~attrs start_pos p | Lparen -> - 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 + 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 Ast_helper.Str.eval ~attrs expr - | _ -> parseMaybeRecModuleBinding ~attrs ~startPos p + | _ -> parse_maybe_rec_module_binding ~attrs ~start_pos p -and parseModuleTypeImpl ~attrs startPos p = +and parse_module_type_impl ~attrs start_pos p = Parser.expect Typ p; - let nameStart = p.Parser.startPos in + let name_start = p.Parser.start_pos in let name = match p.Parser.token with | Lident ident -> Parser.next p; - let loc = mkLoc nameStart p.prevEndPos in + let loc = mk_loc name_start p.prev_end_pos in Location.mkloc ident loc | Uident ident -> Parser.next p; - let loc = mkLoc nameStart p.prevEndPos in + let loc = mk_loc name_start p.prev_end_pos in Location.mkloc ident loc | t -> Parser.err p (Diagnostics.uident t); Location.mknoloc "_" in Parser.expect Equal p; - let moduleType = parseModuleType p in - let moduleTypeDeclaration = + let module_type = parse_module_type p in + let module_type_declaration = Ast_helper.Mtd.mk ~attrs - ~loc:(mkLoc nameStart p.prevEndPos) - ~typ:moduleType name + ~loc:(mk_loc name_start p.prev_end_pos) + ~typ:module_type name in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Str.modtype ~loc moduleTypeDeclaration + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Str.modtype ~loc module_type_declaration (* definition ::= ∣ module rec module-name : module-type = module-expr { and module-name : module-type = module-expr } *) -and parseMaybeRecModuleBinding ~attrs ~startPos p = +and parse_maybe_rec_module_binding ~attrs ~start_pos p = match p.Parser.token with | Token.Rec -> Parser.next p; - Ast_helper.Str.rec_module (parseModuleBindings ~startPos ~attrs p) + Ast_helper.Str.rec_module (parse_module_bindings ~start_pos ~attrs p) | _ -> Ast_helper.Str.module_ - (parseModuleBinding ~attrs ~startPos:p.Parser.startPos p) + (parse_module_binding ~attrs ~start_pos:p.Parser.start_pos p) -and parseModuleBinding ~attrs ~startPos p = +and parse_module_binding ~attrs ~start_pos p = let name = match p.Parser.token with | Uident ident -> - let startPos = p.Parser.startPos in + let start_pos = p.Parser.start_pos in Parser.next p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Location.mkloc ident loc | t -> Parser.err p (Diagnostics.uident t); Location.mknoloc "_" in - let body = parseModuleBindingBody p in - let loc = mkLoc startPos p.prevEndPos in + let body = parse_module_binding_body p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Mb.mk ~attrs ~loc name body -and parseModuleBindingBody p = +and parse_module_binding_body p = (* TODO: make required with good error message when rec module binding *) - let returnModType = + let return_mod_type = match p.Parser.token with | Colon -> Parser.next p; - Some (parseModuleType p) + Some (parse_module_type p) | _ -> None in Parser.expect Equal p; - let modExpr = parseModuleExpr p in - match returnModType with - | Some modType -> + let mod_expr = parse_module_expr p in + match return_mod_type with + | Some mod_type -> Ast_helper.Mod.constraint_ - ~loc:(mkLoc modType.pmty_loc.loc_start modExpr.pmod_loc.loc_end) - modExpr modType - | None -> modExpr + ~loc:(mk_loc mod_type.pmty_loc.loc_start mod_expr.pmod_loc.loc_end) + mod_expr mod_type + | None -> mod_expr (* module-name : module-type = module-expr * { and module-name : module-type = module-expr } *) -and parseModuleBindings ~attrs ~startPos p = +and parse_module_bindings ~attrs ~start_pos p = let rec loop p acc = - let startPos = p.Parser.startPos in - let docAttr : Parsetree.attributes = + let start_pos = p.Parser.start_pos in + let doc_attr : Parsetree.attributes = match p.Parser.token with | DocComment (loc, s) -> Parser.next p; - [docCommentToAttribute loc s] + [doc_comment_to_attribute loc s] | _ -> [] in - let attrs = docAttr @ parseAttributesAndBinding p in + let attrs = doc_attr @ parse_attributes_and_binding p in match p.Parser.token with | And -> Parser.next p; ignore (Parser.optional p Module); (* over-parse for fault-tolerance *) - let modBinding = parseModuleBinding ~attrs ~startPos p in - loop p (modBinding :: acc) + let mod_binding = parse_module_binding ~attrs ~start_pos p in + loop p (mod_binding :: acc) | _ -> List.rev acc in - let first = parseModuleBinding ~attrs ~startPos p in + let first = parse_module_binding ~attrs ~start_pos p in loop p [first] -and parseAtomicModuleType p = - let startPos = p.Parser.startPos in - let moduleType = +and parse_atomic_module_type p = + let start_pos = p.Parser.start_pos in + let module_type = 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 moduleLongIdent = parseModuleLongIdent ~lowercase:true p in - Ast_helper.Mty.ident ~loc:moduleLongIdent.loc moduleLongIdent + let module_long_ident = parse_module_long_ident ~lowercase:true p in + Ast_helper.Mty.ident ~loc:module_long_ident.loc module_long_ident | Lparen -> Parser.next p; - let mty = parseModuleType p in + let mty = parse_module_type p in Parser.expect Rparen p; - {mty with pmty_loc = mkLoc startPos p.prevEndPos} + {mty with pmty_loc = mk_loc start_pos p.prev_end_pos} | Lbrace -> Parser.next p; let spec = - parseDelimitedRegion ~grammar:Grammar.Signature ~closing:Rbrace - ~f:parseSignatureItemRegion p + parse_delimited_region ~grammar:Grammar.Signature ~closing:Rbrace + ~f:parse_signature_item_region p in Parser.expect Rbrace p; - let loc = mkLoc startPos p.prevEndPos in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Mty.signature ~loc spec | Module -> (* TODO: check if this is still atomic when implementing first class modules*) - parseModuleTypeOf p + parse_module_type_of p | Percent -> - let extension = parseExtension p in - let loc = mkLoc startPos p.prevEndPos in + let extension = parse_extension p in + let loc = mk_loc start_pos p.prev_end_pos in Ast_helper.Mty.extension ~loc extension | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Recover.defaultModuleType () + Recover.default_module_type () in - let moduleTypeLoc = mkLoc startPos p.prevEndPos in - {moduleType with pmty_loc = moduleTypeLoc} + let module_type_loc = mk_loc start_pos p.prev_end_pos in + {module_type with pmty_loc = module_type_loc} -and parseFunctorModuleType p = - let startPos = p.Parser.startPos in - let args = parseFunctorArgs p in +and parse_functor_module_type p = + let start_pos = p.Parser.start_pos in + let args = parse_functor_args p in Parser.expect EqualGreater p; - let rhs = parseModuleType p in - let endPos = p.prevEndPos in - let modType = + let rhs = parse_module_type p in + let end_pos = p.prev_end_pos in + let mod_type = List.fold_right - (fun (attrs, name, moduleType, startPos) acc -> - Ast_helper.Mty.functor_ ~loc:(mkLoc startPos endPos) ~attrs name - moduleType acc) + (fun (attrs, name, module_type, start_pos) acc -> + Ast_helper.Mty.functor_ ~loc:(mk_loc start_pos end_pos) ~attrs name + module_type acc) args rhs in - {modType with pmty_loc = mkLoc startPos endPos} + {mod_type with pmty_loc = mk_loc start_pos end_pos} (* Module types are the module-level equivalent of type expressions: they * specify the general shape and type properties of modules. @@ -6121,42 +6121,42 @@ and parseFunctorModuleType p = * | module-type with-mod-constraints * | extension *) -and parseModuleType ?(es6Arrow = true) ?(with_ = true) p = - let attrs = parseAttributes p in +and parse_module_type ?(es6_arrow = true) ?(with_ = true) p = + let attrs = parse_attributes p in let modty = - if es6Arrow && isEs6ArrowFunctor p then parseFunctorModuleType p + if es6_arrow && is_es6_arrow_functor p then parse_functor_module_type p else - let modty = parseAtomicModuleType p in + let modty = parse_atomic_module_type p in match p.Parser.token with - | EqualGreater when es6Arrow == true -> + | EqualGreater when es6_arrow == true -> Parser.next p; - let rhs = parseModuleType ~with_:false p in + let rhs = parse_module_type ~with_:false p in let str = Location.mknoloc "_" in - let loc = mkLoc modty.pmty_loc.loc_start p.prevEndPos in + let loc = mk_loc modty.pmty_loc.loc_start p.prev_end_pos in Ast_helper.Mty.functor_ ~loc str (Some modty) rhs | _ -> modty in - let moduleType = + let module_type = {modty with pmty_attributes = List.concat [modty.pmty_attributes; attrs]} in - if with_ then parseWithConstraints moduleType p else moduleType + if with_ then parse_with_constraints module_type p else module_type -and parseWithConstraints moduleType p = +and parse_with_constraints module_type p = match p.Parser.token with | Lident "with" -> Parser.next p; - let first = parseWithConstraint p in + let first = parse_with_constraint p in let rec loop p acc = match p.Parser.token with | And -> Parser.next p; - loop p (parseWithConstraint p :: acc) + loop p (parse_with_constraint p :: acc) | _ -> List.rev acc in let constraints = loop p [first] in - let loc = mkLoc moduleType.pmty_loc.loc_start p.prevEndPos in - Ast_helper.Mty.with_ ~loc moduleType constraints - | _ -> moduleType + 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 (* mod-constraint ::= * | type typeconstr type-equation type-constraints? @@ -6165,162 +6165,162 @@ and parseWithConstraints moduleType p = * ∣ module module-path := extended-module-path * * TODO: split this up into multiple functions, better errors *) -and parseWithConstraint p = +and parse_with_constraint p = match p.Parser.token with | Module -> ( Parser.next p; - let modulePath = parseModuleLongIdent ~lowercase:false p in + let module_path = parse_module_long_ident ~lowercase:false p in match p.Parser.token with | ColonEqual -> Parser.next p; - let lident = parseModuleLongIdent ~lowercase:false p in - Parsetree.Pwith_modsubst (modulePath, lident) + let lident = parse_module_long_ident ~lowercase:false p in + Parsetree.Pwith_modsubst (module_path, lident) | Equal -> Parser.next p; - let lident = parseModuleLongIdent ~lowercase:false p in - Parsetree.Pwith_module (modulePath, lident) + let lident = parse_module_long_ident ~lowercase:false p in + Parsetree.Pwith_module (module_path, lident) | token -> (* TODO: revisit *) Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - let lident = parseModuleLongIdent ~lowercase:false p in - Parsetree.Pwith_modsubst (modulePath, lident)) + let lident = parse_module_long_ident ~lowercase:false p in + Parsetree.Pwith_modsubst (module_path, lident)) | Typ -> ( Parser.next p; - let typeConstr = parseValuePath p in - let params = parseTypeParams ~parent:typeConstr p in + let type_constr = parse_value_path p in + let params = parse_type_params ~parent:type_constr p in match p.Parser.token with | ColonEqual -> Parser.next p; - let typExpr = parseTypExpr p in + let typ_expr = parse_typ_expr p in Parsetree.Pwith_typesubst - ( typeConstr, - Ast_helper.Type.mk ~loc:typeConstr.loc ~params ~manifest:typExpr - (Location.mkloc (Longident.last typeConstr.txt) typeConstr.loc) ) + ( type_constr, + Ast_helper.Type.mk ~loc:type_constr.loc ~params ~manifest:typ_expr + (Location.mkloc (Longident.last type_constr.txt) type_constr.loc) ) | Equal -> Parser.next p; - let typExpr = parseTypExpr p in - let typeConstraints = parseTypeConstraints p in + let typ_expr = parse_typ_expr p in + let type_constraints = parse_type_constraints p in Parsetree.Pwith_type - ( typeConstr, - Ast_helper.Type.mk ~loc:typeConstr.loc ~params ~manifest:typExpr - ~cstrs:typeConstraints - (Location.mkloc (Longident.last typeConstr.txt) typeConstr.loc) ) + ( 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) ) | token -> (* TODO: revisit *) Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - let typExpr = parseTypExpr p in - let typeConstraints = parseTypeConstraints p in + let typ_expr = parse_typ_expr p in + let type_constraints = parse_type_constraints p in Parsetree.Pwith_type - ( typeConstr, - Ast_helper.Type.mk ~loc:typeConstr.loc ~params ~manifest:typExpr - ~cstrs:typeConstraints - (Location.mkloc (Longident.last typeConstr.txt) typeConstr.loc) )) + ( 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) )) | 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.defaultType ()) + Ast_helper.Type.mk ~params:[] ~manifest:(Recover.default_type ()) ~cstrs:[] (Location.mknoloc "") ) -and parseModuleTypeOf p = - let startPos = p.Parser.startPos in +and parse_module_type_of p = + let start_pos = p.Parser.start_pos in Parser.expect Module p; Parser.expect Typ p; Parser.expect Of p; - let moduleExpr = parseModuleExpr p in - Ast_helper.Mty.typeof_ ~loc:(mkLoc startPos p.prevEndPos) moduleExpr + let module_expr = parse_module_expr p in + Ast_helper.Mty.typeof_ ~loc:(mk_loc start_pos p.prev_end_pos) module_expr -and parseNewlineOrSemicolonSignature p = +and parse_newline_or_semicolon_signature p = match p.Parser.token with | Semicolon -> Parser.next p - | token when Grammar.isSignatureItemStart token -> - if p.prevEndPos.pos_lnum < p.startPos.pos_lnum then () + | token when Grammar.is_signature_item_start token -> + if p.prev_end_pos.pos_lnum < p.start_pos.pos_lnum then () else - Parser.err ~startPos:p.prevEndPos ~endPos:p.endPos p + Parser.err ~start_pos:p.prev_end_pos ~end_pos:p.end_pos p (Diagnostics.message "consecutive specifications on a line must be separated by ';' or a \ newline") | _ -> () -and parseSignatureItemRegion p = - let startPos = p.Parser.startPos in - let attrs = parseAttributes p in +and parse_signature_item_region p = + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes p in match p.Parser.token with | Let -> - 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) + 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) | Typ -> ( - 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) + 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) | TypeExt ext -> - parseNewlineOrSemicolonSignature p; - let loc = mkLoc startPos p.prevEndPos in - Parser.endRegion p; + 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_extension ~loc ext)) | External -> - let externalDef = parseExternalDef ~attrs ~startPos p in - parseNewlineOrSemicolonSignature p; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Sig.value ~loc externalDef) + 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) | Exception -> - let exceptionDef = parseExceptionDef ~attrs p in - parseNewlineOrSemicolonSignature p; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Sig.exception_ ~loc exceptionDef) + 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) | Open -> - let openDescription = parseOpenDescription ~attrs p in - parseNewlineOrSemicolonSignature p; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Sig.open_ ~loc openDescription) + 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) | Include -> Parser.next p; - let moduleType = parseModuleType p in - let includeDescription = - Ast_helper.Incl.mk ~loc:(mkLoc startPos p.prevEndPos) ~attrs moduleType + 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 in - parseNewlineOrSemicolonSignature p; - let loc = mkLoc startPos p.prevEndPos in - Some (Ast_helper.Sig.include_ ~loc includeDescription) + 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) | Module -> ( - Parser.beginRegion p; + Parser.begin_region p; Parser.next p; match p.Parser.token with | Uident _ -> - 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) + 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) | Rec -> - 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) + 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) | Typ -> - let modTypeDecl = parseModuleTypeDeclaration ~attrs ~startPos p in - Parser.endRegion p; - Some modTypeDecl + let mod_type_decl = parse_module_type_declaration ~attrs ~start_pos p in + Parser.end_region p; + Some mod_type_decl | _t -> - 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)) + 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)) | AtAt -> - let attr = parseStandaloneAttribute p in - parseNewlineOrSemicolonSignature p; - let loc = mkLoc startPos p.prevEndPos in + let attr = parse_standalone_attribute p in + parse_newline_or_semicolon_signature p; + let loc = mk_loc start_pos p.prev_end_pos in Some (Ast_helper.Sig.attribute ~loc attr) | ModuleComment (loc, s) -> Parser.next p; @@ -6333,25 +6333,25 @@ and parseSignatureItemRegion p = (Ast_helper.Exp.constant ~loc (Pconst_string (s, None))); ] )) | PercentPercent -> - let extension = parseExtension ~moduleLanguage:true p in - parseNewlineOrSemicolonSignature p; - let loc = mkLoc startPos p.prevEndPos in + 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 Some (Ast_helper.Sig.extension ~attrs ~loc extension) | _ -> ( match attrs with - | (({Asttypes.loc = attrLoc}, _) as attr) :: _ -> - Parser.err ~startPos:attrLoc.loc_start ~endPos:attrLoc.loc_end p - (Diagnostics.message (ErrorMessages.attributeWithoutNode attr)); - Some Recover.defaultSignatureItem + | (({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 | _ -> None) -[@@progress Parser.next, Parser.expect, LoopProgress.listRest] +[@@progress Parser.next, Parser.expect, LoopProgress.list_rest] (* module rec module-name : module-type { and module-name: module-type } *) -and parseRecModuleSpec ~attrs ~startPos p = +and parse_rec_module_spec ~attrs ~start_pos p = Parser.expect Rec p; let rec loop p spec = - let startPos = p.Parser.startPos in - let attrs = parseAttributesAndBinding p in + let start_pos = p.Parser.start_pos in + let attrs = parse_attributes_and_binding p in match p.Parser.token with | And -> (* TODO: give a good error message when with constraint, no parens @@ -6361,35 +6361,35 @@ and parseRecModuleSpec ~attrs ~startPos p = * `with-constraint` *) Parser.expect And p; - let decl = parseRecModuleDeclaration ~attrs ~startPos p in + let decl = parse_rec_module_declaration ~attrs ~start_pos p in loop p (decl :: spec) | _ -> List.rev spec in - let first = parseRecModuleDeclaration ~attrs ~startPos p in + let first = parse_rec_module_declaration ~attrs ~start_pos p in loop p [first] (* module-name : module-type *) -and parseRecModuleDeclaration ~attrs ~startPos p = +and parse_rec_module_declaration ~attrs ~start_pos p = let name = match p.Parser.token with - | Uident modName -> - let loc = mkLoc p.startPos p.endPos in + | Uident mod_name -> + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; - Location.mkloc modName loc + Location.mkloc mod_name loc | t -> Parser.err p (Diagnostics.uident t); Location.mknoloc "_" in Parser.expect Colon p; - let modType = parseModuleType p in - Ast_helper.Md.mk ~loc:(mkLoc startPos p.prevEndPos) ~attrs name modType + 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 -and parseModuleDeclarationOrAlias ~attrs p = - let startPos = p.Parser.startPos in - let moduleName = +and parse_module_declaration_or_alias ~attrs p = + let start_pos = p.Parser.start_pos in + let module_name = match p.Parser.token with | Uident ident -> - let loc = mkLoc p.Parser.startPos p.endPos in + let loc = mk_loc p.Parser.start_pos p.end_pos in Parser.next p; Location.mkloc ident loc | t -> @@ -6400,28 +6400,28 @@ and parseModuleDeclarationOrAlias ~attrs p = match p.Parser.token with | Colon -> Parser.next p; - parseModuleType p + parse_module_type p | Equal -> Parser.next p; - let lident = parseModuleLongIdent ~lowercase:false p in + let lident = parse_module_long_ident ~lowercase:false p in Ast_helper.Mty.alias lident | token -> Parser.err p (Diagnostics.unexpected token p.breadcrumbs); - Recover.defaultModuleType () + Recover.default_module_type () in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Md.mk ~loc ~attrs moduleName body + let loc = mk_loc start_pos p.prev_end_pos in + Ast_helper.Md.mk ~loc ~attrs module_name body -and parseModuleTypeDeclaration ~attrs ~startPos p = +and parse_module_type_declaration ~attrs ~start_pos p = Parser.expect Typ p; - let moduleName = + let module_name = match p.Parser.token with | Uident ident -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Location.mkloc ident loc | Lident ident -> - let loc = mkLoc p.startPos p.endPos in + let loc = mk_loc p.start_pos p.end_pos in Parser.next p; Location.mkloc ident loc | t -> @@ -6432,26 +6432,26 @@ and parseModuleTypeDeclaration ~attrs ~startPos p = match p.Parser.token with | Equal -> Parser.next p; - Some (parseModuleType p) + Some (parse_module_type p) | _ -> None in - let moduleDecl = Ast_helper.Mtd.mk ~attrs ?typ moduleName in - Ast_helper.Sig.modtype ~loc:(mkLoc startPos p.prevEndPos) moduleDecl + 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 -and parseSignLetDesc ~attrs p = - let startPos = p.Parser.startPos in +and parse_sign_let_desc ~attrs p = + let start_pos = p.Parser.start_pos in Parser.optional p Let |> ignore; - let name, loc = parseLident p in + let name, loc = parse_lident p in let name = Location.mkloc name loc in Parser.expect Colon p; - let typExpr = parsePolyTypeExpr p in - let loc = mkLoc startPos p.prevEndPos in - Ast_helper.Val.mk ~loc ~attrs name typExpr + 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 (* attr-id ::= lowercase-ident ∣ capitalized-ident ∣ attr-id . attr-id *) -and parseAttributeId ~startPos p = +and parse_attribute_id ~start_pos p = let rec loop p acc = match p.Parser.token with | Lident ident | Uident ident -> ( @@ -6462,9 +6462,9 @@ and parseAttributeId ~startPos p = Parser.next p; loop p (id ^ ".") | _ -> id) - | token when Token.isKeyword token -> ( + | token when Token.is_keyword token -> ( Parser.next p; - let id = acc ^ Token.toString token in + let id = acc ^ Token.to_string token in match p.Parser.token with | Dot -> Parser.next p; @@ -6475,8 +6475,8 @@ and parseAttributeId ~startPos p = acc in let id = loop p "" in - let endPos = p.prevEndPos in - Location.mkloc id (mkLoc startPos endPos) + let end_pos = p.prev_end_pos in + Location.mkloc id (mk_loc start_pos end_pos) (* * payload ::= empty @@ -6488,62 +6488,62 @@ and parseAttributeId ~startPos p = * Also what about type-expressions and specifications? * @attr(:myType) ??? *) -and parsePayload p = +and parse_payload p = match p.Parser.token with - | Lparen when p.startPos.pos_cnum = p.prevEndPos.pos_cnum -> ( - Parser.leaveBreadcrumb p Grammar.AttributePayload; + | Lparen when p.start_pos.pos_cnum = p.prev_end_pos.pos_cnum -> ( + Parser.leave_breadcrumb p Grammar.AttributePayload; Parser.next p; match p.token with | Colon -> Parser.next p; let payload = - if Grammar.isSignatureItemStart p.token then + if Grammar.is_signature_item_start p.token then Parsetree.PSig - (parseDelimitedRegion ~grammar:Grammar.Signature ~closing:Rparen - ~f:parseSignatureItemRegion p) - else Parsetree.PTyp (parseTypExpr p) + (parse_delimited_region ~grammar:Grammar.Signature ~closing:Rparen + ~f:parse_signature_item_region p) + else Parsetree.PTyp (parse_typ_expr p) in Parser.expect Rparen p; - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; payload | Question -> Parser.next p; - let pattern = parsePattern p in + let pattern = parse_pattern p in let expr = match p.token with | When | If -> Parser.next p; - Some (parseExpr p) + Some (parse_expr p) | _ -> None in Parser.expect Rparen p; - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; Parsetree.PPat (pattern, expr) | _ -> let items = - parseDelimitedRegion ~grammar:Grammar.Structure ~closing:Rparen - ~f:parseStructureItemRegion p + parse_delimited_region ~grammar:Grammar.Structure ~closing:Rparen + ~f:parse_structure_item_region p in Parser.expect Rparen p; - Parser.eatBreadcrumb p; + Parser.eat_breadcrumb p; Parsetree.PStr items) | _ -> Parsetree.PStr [] (* type attribute = string loc * payload *) -and parseAttribute p = +and parse_attribute p = match p.Parser.token with | At -> - let startPos = p.startPos in + let start_pos = p.start_pos in Parser.next p; - let attrId = parseAttributeId ~startPos p in - let payload = parsePayload p in - Some (attrId, payload) + let attr_id = parse_attribute_id ~start_pos p in + let payload = parse_payload p in + Some (attr_id, payload) | DocComment (loc, s) -> Parser.next p; - Some (docCommentToAttribute loc s) + Some (doc_comment_to_attribute loc s) | _ -> None -and docCommentToAttribute loc s : Parsetree.attribute = +and doc_comment_to_attribute loc s : Parsetree.attribute = ( {txt = "res.doc"; loc}, PStr [ @@ -6551,30 +6551,30 @@ and docCommentToAttribute loc s : Parsetree.attribute = (Ast_helper.Exp.constant ~loc (Pconst_string (s, None))); ] ) -and parseAttributes p = - parseRegion p ~grammar:Grammar.Attribute ~f:parseAttribute +and parse_attributes p = + parse_region p ~grammar:Grammar.Attribute ~f:parse_attribute (* * standalone-attribute ::= * | @@ atribute-id * | @@ attribute-id ( structure-item ) *) -and parseStandaloneAttribute p = - let startPos = p.startPos in +and parse_standalone_attribute p = + let start_pos = p.start_pos in Parser.expect AtAt p; - let attrId = parseAttributeId ~startPos p in - let attrId = - match attrId.txt with + let attr_id = parse_attribute_id ~start_pos p in + let attr_id = + match attr_id.txt with | "uncurried.swap" -> p.uncurried_config <- Config.Swap; - attrId + attr_id | "uncurried" -> p.uncurried_config <- Config.Uncurried; - attrId - | _ -> attrId + attr_id + | _ -> attr_id in - let payload = parsePayload p in - (attrId, payload) + let payload = parse_payload p in + (attr_id, payload) (* extension ::= % attr-id attr-payload * | %% attr-id( @@ -6609,18 +6609,18 @@ and parseStandaloneAttribute p = * * ~moduleLanguage represents whether we're on the module level or not *) -and parseExtension ?(moduleLanguage = false) p = - let startPos = p.Parser.startPos in - if moduleLanguage then Parser.expect PercentPercent p +and parse_extension ?(module_language = false) p = + let start_pos = p.Parser.start_pos in + if module_language then Parser.expect PercentPercent p else Parser.expect Percent p; - let attrId = parseAttributeId ~startPos p in - let payload = parsePayload p in - (attrId, payload) + let attr_id = parse_attribute_id ~start_pos p in + let payload = parse_payload p in + (attr_id, payload) (* module signature on the file level *) -let parseSpecification p : Parsetree.signature = - parseRegion p ~grammar:Grammar.Specification ~f:parseSignatureItemRegion +let parse_specification p : Parsetree.signature = + parse_region p ~grammar:Grammar.Specification ~f:parse_signature_item_region (* module structure on the file level *) -let parseImplementation p : Parsetree.structure = - parseRegion p ~grammar:Grammar.Implementation ~f:parseStructureItemRegion +let parse_implementation p : Parsetree.structure = + parse_region p ~grammar:Grammar.Implementation ~f:parse_structure_item_region diff --git a/jscomp/syntax/src/res_core.mli b/jscomp/syntax/src/res_core.mli index e77ca30bb1..30d1e5f5e5 100644 --- a/jscomp/syntax/src/res_core.mli +++ b/jscomp/syntax/src/res_core.mli @@ -1,2 +1,2 @@ -val parseImplementation : Res_parser.t -> Parsetree.structure -val parseSpecification : Res_parser.t -> Parsetree.signature +val parse_implementation : Res_parser.t -> Parsetree.structure +val parse_specification : Res_parser.t -> Parsetree.signature diff --git a/jscomp/syntax/src/res_diagnostics.ml b/jscomp/syntax/src/res_diagnostics.ml index 3b1da15210..8159321a66 100644 --- a/jscomp/syntax/src/res_diagnostics.ml +++ b/jscomp/syntax/src/res_diagnostics.ml @@ -17,45 +17,45 @@ type category = | UnknownUchar of Char.t type t = { - startPos: Lexing.position; - endPos: Lexing.position; + start_pos: Lexing.position; + end_pos: Lexing.position; category: category; } type report = t list -let getStartPos t = t.startPos -let getEndPos t = t.endPos +let get_start_pos t = t.start_pos +let get_end_pos t = t.end_pos -let defaultUnexpected token = - "I'm not sure what to parse here when looking at \"" ^ Token.toString token +let default_unexpected token = + "I'm not sure what to parse here when looking at \"" ^ Token.to_string token ^ "\"." -let reservedKeyword token = - let tokenTxt = Token.toString token in - "`" ^ tokenTxt ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" - ^ tokenTxt ^ "\"" +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 explain t = match t.category with - | Uident currentToken -> ( - match currentToken with + | Uident current_token -> ( + match current_token with | Lident lident -> let guess = String.capitalize_ascii lident in "Did you mean `" ^ guess ^ "` instead of `" ^ lident ^ "`?" - | t when Token.isKeyword t -> - let token = Token.toString t in + | t when Token.is_keyword t -> + let token = Token.to_string t in "`" ^ token ^ "` is a reserved keyword." | _ -> "At this point, I'm looking for an uppercased name like `Belt` or `Array`" ) - | Lident currentToken -> ( - match currentToken with + | Lident current_token -> ( + match current_token with | Uident uident -> let guess = String.uncapitalize_ascii uident in "Did you mean `" ^ guess ^ "` instead of `" ^ uident ^ "`?" - | t when Token.isKeyword t -> - let token = Token.toString t in + | t when Token.is_keyword t -> + let token = Token.to_string 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.toString grammar + | Some grammar -> " It signals the start of " ^ Grammar.to_string grammar | None -> "" in - "Did you forget a `" ^ Token.toString t ^ "` here?" ^ hint + "Did you forget a `" ^ Token.to_string t ^ "` here?" ^ hint | Unexpected {token = t; context = breadcrumbs} -> ( - let name = Token.toString t in + let name = Token.to_string 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.isStructureItemStart t || t = Eof -> + | _, t when Grammar.is_structure_item_start t || t = Eof -> "Missing a type here" - | _ -> defaultUnexpected t) + | _ -> default_unexpected 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.isKeyword t -> reservedKeyword token - | token, _ -> defaultUnexpected token) + | token, _ when Token.is_keyword t -> reserved_keyword token + | token, _ -> default_unexpected token) | _ -> (* TODO: match on circumstance to verify Lident needed ? *) - if Token.isKeyword t then + if Token.is_keyword t then "`" ^ name ^ "` is a reserved keyword. Keywords need to be escaped: \\\"" - ^ Token.toString t ^ "\"" + ^ Token.to_string t ^ "\"" else "I'm not sure what to parse here when looking at \"" ^ name ^ "\".") -let make ~startPos ~endPos category = {startPos; endPos; category} +let make ~start_pos ~end_pos category = {start_pos; end_pos; category} -let printReport diagnostics src = +let print_report diagnostics src = let rec print diagnostics src = match diagnostics with | [] -> () @@ -145,7 +145,7 @@ let printReport diagnostics src = Location.report_error ~src:(Some src) Format.err_formatter Location. { - loc = {loc_start = d.startPos; loc_end = d.endPos; loc_ghost = false}; + loc = {loc_start = d.start_pos; loc_end = d.end_pos; loc_ghost = false}; msg = explain d; sub = []; if_highlight = ""; @@ -163,10 +163,10 @@ let unexpected token context = Unexpected {token; context} let expected ?grammar pos token = Expected {context = grammar; pos; token} -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 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 message txt = Message txt diff --git a/jscomp/syntax/src/res_diagnostics.mli b/jscomp/syntax/src/res_diagnostics.mli index 0ae74cec23..4fd9155665 100644 --- a/jscomp/syntax/src/res_diagnostics.mli +++ b/jscomp/syntax/src/res_diagnostics.mli @@ -5,8 +5,8 @@ type t type category type report -val getStartPos : t -> Lexing.position [@@live] (* for playground *) -val getEndPos : t -> Lexing.position [@@live] (* for playground *) +val get_start_pos : t -> Lexing.position [@@live] (* for playground *) +val get_end_pos : 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 unclosedString : category -val unclosedTemplate : category -val unclosedComment : category -val unknownUchar : Char.t -> category +val unclosed_string : category +val unclosed_template : category +val unclosed_comment : category +val unknown_uchar : Char.t -> category val message : string -> category -val make : startPos:Lexing.position -> endPos:Lexing.position -> category -> t +val make : start_pos:Lexing.position -> end_pos:Lexing.position -> category -> t -val printReport : t list -> string -> unit +val print_report : t list -> string -> unit diff --git a/jscomp/syntax/src/res_doc.ml b/jscomp/syntax/src/res_doc.ml index fe626e4790..fa4ae9ce08 100644 --- a/jscomp/syntax/src/res_doc.ml +++ b/jscomp/syntax/src/res_doc.ml @@ -2,7 +2,7 @@ module MiniBuffer = Res_minibuffer type mode = Break | Flat -type lineStyle = +type line_style = | 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 lineStyle - | Group of {mutable shouldBreak: bool; doc: t} + | LineBreak of line_style + | Group of {mutable should_break: bool; doc: t} | CustomLayout of t list | BreakParent let nil = Nil let line = LineBreak Classic -let hardLine = LineBreak Hard -let softLine = LineBreak Soft -let literalLine = LineBreak Literal +let hard_line = LineBreak Hard +let soft_line = LineBreak Soft +let literal_line = 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 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 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 space = Text " " let comma = Text "," let dot = Text "." let dotdot = Text ".." let dotdotdot = Text "..." -let lessThan = Text "<" -let greaterThan = Text ">" +let less_than = Text "<" +let greater_than = 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 trailingComma = ifBreaks comma nil -let doubleQuote = Text "\"" +let trailing_comma = if_breaks comma nil +let double_quote = Text "\"" -let propagateForcedBreaks doc = +let propagate_forced_breaks doc = let rec walk doc = match doc with | Text _ | Nil | LineSuffix _ -> false @@ -80,27 +80,27 @@ let propagateForcedBreaks doc = | LineBreak (Hard | Literal) -> true | LineBreak (Classic | Soft) -> false | Indent children -> - 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 + 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 ib.broken <- true; true) else - 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 + 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 | Concat children -> List.fold_left - (fun forceBreak child -> - let childForcesBreak = walk child in - forceBreak || childForcesBreak) + (fun force_break child -> + let child_forces_break = walk child in + force_break || child_forces_break) false children | CustomLayout children -> (* When using CustomLayout, we don't want to propagate forced breaks @@ -115,13 +115,13 @@ let propagateForcedBreaks doc = () (* See documentation in interface file *) -let rec willBreak doc = +let rec will_break doc = match doc with - | LineBreak (Hard | Literal) | BreakParent | Group {shouldBreak = true} -> + | LineBreak (Hard | Literal) | BreakParent | Group {should_break = true} -> true - | Group {doc} | Indent doc | CustomLayout (doc :: _) -> willBreak doc - | Concat docs -> List.exists willBreak docs - | IfBreaks {yes; no} -> willBreak yes || willBreak no + | 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 | _ -> false let join ~sep docs = @@ -133,14 +133,14 @@ let join ~sep docs = in concat (loop [] sep docs) -let joinWithSep docsWithSep = +let join_with_sep docs_with_sep = 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 [] docsWithSep) + concat (loop [] docs_with_sep) 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 {shouldBreak = true; doc} -> calculate indent Break doc + | _, Group {should_break = true; doc} -> calculate indent Break doc | _, Group {doc} -> calculate indent mode doc - | _, 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 + | _, 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 | _, CustomLayout (hd :: _) -> (* TODO: if we have nested custom layouts, what we should do here? *) calculate indent mode hd | _, CustomLayout [] -> () - and calculateConcat indent mode docs = + and calculate_concat indent mode docs = if result.contents == None then match docs with | [] -> () | doc :: rest -> calculate indent mode doc; - calculateConcat indent mode rest + calculate_concat indent mode rest in - let rec calculateAll stack = + let rec calculate_all stack = match (result.contents, stack) with | Some r, _ -> r | None, [] -> !width >= 0 | None, (indent, mode, doc) :: rest -> calculate indent mode doc; - calculateAll rest + calculate_all rest in - calculateAll stack + calculate_all stack -let toString ~width doc = - propagateForcedBreaks doc; +let to_string ~width doc = + propagate_forced_breaks doc; let buffer = MiniBuffer.create 1000 in - let rec process ~pos lineSuffices stack = + let rec process ~pos line_suffices stack = match stack with | ((ind, mode, doc) as cmd) :: rest -> ( match doc with - | Nil | BreakParent -> process ~pos lineSuffices rest + | Nil | BreakParent -> process ~pos line_suffices rest | Text txt -> MiniBuffer.add_string buffer txt; - process ~pos:(String.length txt + pos) lineSuffices rest - | LineSuffix doc -> process ~pos ((ind, mode, doc) :: lineSuffices) rest + process ~pos:(String.length txt + pos) line_suffices rest + | LineSuffix doc -> process ~pos ((ind, mode, doc) :: line_suffices) rest | Concat docs -> let ops = List.map (fun doc -> (ind, mode, doc)) docs in - 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} -> + 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} -> if mode = Break then - process ~pos lineSuffices ((ind, mode, breakDoc) :: rest) - else process ~pos lineSuffices ((ind, mode, flatDoc) :: rest) - | LineBreak lineStyle -> + process ~pos line_suffices ((ind, mode, break_doc) :: rest) + else process ~pos line_suffices ((ind, mode, flat_doc) :: rest) + | LineBreak line_style -> if mode = Break then - match lineSuffices with + match line_suffices with | [] -> - if lineStyle = Literal then ( + if line_style = Literal then ( MiniBuffer.add_char buffer '\n'; process ~pos:0 [] rest) else ( @@ -222,11 +222,11 @@ let toString ~width doc = process ~pos:ind [] rest) | _docs -> process ~pos:ind [] - (List.concat [List.rev lineSuffices; cmd :: rest]) + (List.concat [List.rev line_suffices; cmd :: rest]) else (* mode = Flat *) let pos = - match lineStyle with + match line_style with | Classic -> MiniBuffer.add_string buffer " "; pos + 1 @@ -238,24 +238,24 @@ let toString ~width doc = 0 | Soft -> pos in - 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) + 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) | CustomLayout docs -> - let rec findGroupThatFits groups = + let rec find_group_that_fits groups = match groups with | [] -> Nil - | [lastGroup] -> lastGroup + | [last_group] -> last_group | doc :: docs -> if fits (width - pos) ((ind, Flat, doc) :: rest) then doc - else findGroupThatFits docs + else find_group_that_fits docs in - let doc = findGroupThatFits docs in - process ~pos lineSuffices ((ind, Flat, doc) :: rest)) + let doc = find_group_that_fits docs in + process ~pos line_suffices ((ind, Flat, doc) :: rest)) | [] -> ( - match lineSuffices with + match line_suffices with | [] -> () | suffices -> process ~pos:0 [] (List.rev suffices)) in @@ -263,7 +263,7 @@ let toString ~width doc = MiniBuffer.contents buffer let debug t = - let rec toDoc = function + let rec to_doc = 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; toDoc doc]); + indent (concat [line; to_doc doc]); line; text ")"; ]) @@ -286,7 +286,7 @@ let debug t = (concat [ line; - join ~sep:(concat [text ","; line]) (List.map toDoc docs); + join ~sep:(concat [text ","; line]) (List.map to_doc docs); ]); line; text ")"; @@ -300,35 +300,35 @@ let debug t = (concat [ line; - join ~sep:(concat [text ","; line]) (List.map toDoc docs); + join ~sep:(concat [text ","; line]) (List.map to_doc docs); ]); line; text ")"; ]) | Indent doc -> - concat [text "indent("; softLine; toDoc doc; softLine; text ")"] - | IfBreaks {yes = trueDoc; broken = true} -> toDoc trueDoc - | IfBreaks {yes = trueDoc; no = falseDoc} -> + 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} -> group (concat [ text "ifBreaks("; indent (concat - [line; toDoc trueDoc; concat [text ","; line]; toDoc falseDoc]); + [line; to_doc true_doc; concat [text ","; line]; to_doc false_doc]); line; text ")"; ]) | LineBreak break -> - let breakTxt = + let break_txt = match break with | Classic -> "Classic" | Soft -> "Soft" | Hard -> "Hard" | Literal -> "Liteal" in - text ("LineBreak(" ^ breakTxt ^ ")") - | Group {shouldBreak; doc} -> + text ("LineBreak(" ^ break_txt ^ ")") + | Group {should_break; doc} -> group (concat [ @@ -337,14 +337,14 @@ let debug t = (concat [ line; - text ("{shouldBreak: " ^ string_of_bool shouldBreak ^ "}"); + text ("{shouldBreak: " ^ string_of_bool should_break ^ "}"); concat [text ","; line]; - toDoc doc; + to_doc doc; ]); line; text ")"; ]) in - let doc = toDoc t in - toString ~width:10 doc |> print_endline + let doc = to_doc t in + to_string ~width:10 doc |> print_endline [@@live] diff --git a/jscomp/syntax/src/res_doc.mli b/jscomp/syntax/src/res_doc.mli index f1a0c6ea6a..763c202202 100644 --- a/jscomp/syntax/src/res_doc.mli +++ b/jscomp/syntax/src/res_doc.mli @@ -2,34 +2,34 @@ type t val nil : t val line : t -val hardLine : t -val softLine : t -val literalLine : t +val hard_line : t +val soft_line : t +val literal_line : t val text : string -> t val concat : t list -> t val indent : t -> t -val ifBreaks : t -> t -> t -val lineSuffix : t -> t +val if_breaks : t -> t -> t +val line_suffix : t -> t val group : t -> t -val breakableGroup : forceBreak:bool -> t -> t +val breakable_group : force_break: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 customLayout : t list -> t -val breakParent : t +val custom_layout : t list -> t +val break_parent : t val join : sep:t -> t list -> t (* [(doc1, sep1); (doc2,sep2)] joins as doc1 sep1 doc2 *) -val joinWithSep : (t * t) list -> t +val join_with_sep : (t * t) list -> t val space : t val comma : t val dot : t val dotdot : t val dotdotdot : t -val lessThan : t -val greaterThan : t +val less_than : t +val greater_than : 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 trailingComma : t -val doubleQuote : t [@@live] +val trailing_comma : t +val double_quote : t [@@live] (* * `willBreak doc` checks whether `doc` contains forced line breaks. @@ -61,7 +61,7 @@ val doubleQuote : t [@@live] * The consumer can then manually insert a `breakParent` doc, to manually propagate the * force breaks from bottom to top. *) -val willBreak : t -> bool +val will_break : t -> bool -val toString : width:int -> t -> string +val to_string : width:int -> t -> string val debug : t -> unit [@@live] diff --git a/jscomp/syntax/src/res_driver.ml b/jscomp/syntax/src/res_driver.ml index a82c9a2a11..cd47568ac9 100644 --- a/jscomp/syntax/src/res_driver.ml +++ b/jscomp/syntax/src/res_driver.ml @@ -1,6 +1,6 @@ module IO = Res_io -type ('ast, 'diagnostics) parseResult = { +type ('ast, 'diagnostics) parse_result = { filename: string; [@live] source: string; parsetree: 'ast; @@ -9,26 +9,26 @@ type ('ast, 'diagnostics) parseResult = { comments: Res_comment.t list; } -type 'diagnostics parsingEngine = { - parseImplementation: - forPrinter:bool -> +type 'diagnostics parsing_engine = { + parse_implementation: + for_printer:bool -> filename:string -> - (Parsetree.structure, 'diagnostics) parseResult; - parseInterface: - forPrinter:bool -> + (Parsetree.structure, 'diagnostics) parse_result; + parse_interface: + for_printer:bool -> filename:string -> - (Parsetree.signature, 'diagnostics) parseResult; - stringOfDiagnostics: source:string -> filename:string -> 'diagnostics -> unit; + (Parsetree.signature, 'diagnostics) parse_result; + string_of_diagnostics: source:string -> filename:string -> 'diagnostics -> unit; } -type printEngine = { - printImplementation: +type print_engine = { + print_implementation: width:int -> filename:string -> comments:Res_comment.t list -> Parsetree.structure -> unit; - printInterface: + print_interface: width:int -> filename:string -> comments:Res_comment.t list -> @@ -36,21 +36,21 @@ type printEngine = { unit; } -let setup ~filename ~forPrinter () = - let src = IO.readFile ~filename in - let mode = if forPrinter then Res_parser.Default else ParseForTypeChecker in +let setup ~filename ~for_printer () = + let src = IO.read_file ~filename in + let mode = if for_printer then Res_parser.Default else ParseForTypeChecker in Res_parser.make ~mode src filename -let setupFromSource ~displayFilename ~source ~forPrinter () = - let mode = if forPrinter then Res_parser.Default else ParseForTypeChecker in - Res_parser.make ~mode source displayFilename +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 parsingEngine = +let parsing_engine = { - parseImplementation = - (fun ~forPrinter ~filename -> - let engine = setup ~filename ~forPrinter () in - let structure = Res_core.parseImplementation engine in + parse_implementation = + (fun ~for_printer ~filename -> + let engine = setup ~filename ~for_printer () in + let structure = Res_core.parse_implementation engine in let invalid, diagnostics = match engine.diagnostics with | [] as diagnostics -> (false, diagnostics) @@ -64,10 +64,10 @@ let parsingEngine = invalid; comments = List.rev engine.comments; }); - parseInterface = - (fun ~forPrinter ~filename -> - let engine = setup ~filename ~forPrinter () in - let signature = Res_core.parseSpecification engine in + parse_interface = + (fun ~for_printer ~filename -> + let engine = setup ~filename ~for_printer () in + let signature = Res_core.parse_specification engine in let invalid, diagnostics = match engine.diagnostics with | [] as diagnostics -> (false, diagnostics) @@ -81,14 +81,14 @@ let parsingEngine = invalid; comments = List.rev engine.comments; }); - stringOfDiagnostics = + string_of_diagnostics = (fun ~source ~filename:_ diagnostics -> - Res_diagnostics.printReport diagnostics source); + Res_diagnostics.print_report diagnostics source); } -let parseImplementationFromSource ~forPrinter ~displayFilename ~source = - let engine = setupFromSource ~displayFilename ~source ~forPrinter () in - let structure = Res_core.parseImplementation engine in +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 invalid, diagnostics = match engine.diagnostics with | [] as diagnostics -> (false, diagnostics) @@ -103,9 +103,9 @@ let parseImplementationFromSource ~forPrinter ~displayFilename ~source = comments = List.rev engine.comments; } -let parseInterfaceFromSource ~forPrinter ~displayFilename ~source = - let engine = setupFromSource ~displayFilename ~source ~forPrinter () in - let signature = Res_core.parseSpecification engine in +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 invalid, diagnostics = match engine.diagnostics with | [] as diagnostics -> (false, diagnostics) @@ -120,42 +120,42 @@ let parseInterfaceFromSource ~forPrinter ~displayFilename ~source = comments = List.rev engine.comments; } -let printEngine = +let print_engine = { - printImplementation = + print_implementation = (fun ~width ~filename:_ ~comments structure -> print_string - (Res_printer.printImplementation ~width structure ~comments)); - printInterface = + (Res_printer.print_implementation ~width structure ~comments)); + print_interface = (fun ~width ~filename:_ ~comments signature -> - print_string (Res_printer.printInterface ~width signature ~comments)); + print_string (Res_printer.print_interface ~width signature ~comments)); } -let parse_implementation ?(ignoreParseErrors = false) sourcefile = +let parse_implementation ?(ignore_parse_errors = false) sourcefile = Location.input_name := sourcefile; - let parseResult = - parsingEngine.parseImplementation ~forPrinter:false ~filename:sourcefile + let parse_result = + parsing_engine.parse_implementation ~for_printer:false ~filename:sourcefile in - if parseResult.invalid then ( - Res_diagnostics.printReport parseResult.diagnostics parseResult.source; - if not ignoreParseErrors then exit 1); - parseResult.parsetree + 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 [@@raises exit] -let parse_interface ?(ignoreParseErrors = false) sourcefile = +let parse_interface ?(ignore_parse_errors = false) sourcefile = Location.input_name := sourcefile; - let parseResult = - parsingEngine.parseInterface ~forPrinter:false ~filename:sourcefile + let parse_result = + parsing_engine.parse_interface ~for_printer:false ~filename:sourcefile in - if parseResult.invalid then ( - Res_diagnostics.printReport parseResult.diagnostics parseResult.source; - if not ignoreParseErrors then exit 1); - parseResult.parsetree + 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 [@@raises exit] (* suppress unused optional arg *) let _ = fun s -> - ( parse_implementation ~ignoreParseErrors:false s, - parse_interface ~ignoreParseErrors:false s ) + ( parse_implementation ~ignore_parse_errors:false s, + parse_interface ~ignore_parse_errors:false s ) [@@raises exit] diff --git a/jscomp/syntax/src/res_driver.mli b/jscomp/syntax/src/res_driver.mli index ddc264739e..c704a17a08 100644 --- a/jscomp/syntax/src/res_driver.mli +++ b/jscomp/syntax/src/res_driver.mli @@ -1,4 +1,4 @@ -type ('ast, 'diagnostics) parseResult = { +type ('ast, 'diagnostics) parse_result = { filename: string; [@live] source: string; parsetree: 'ast; @@ -7,40 +7,40 @@ type ('ast, 'diagnostics) parseResult = { comments: Res_comment.t list; } -type 'diagnostics parsingEngine = { - parseImplementation: - forPrinter:bool -> +type 'diagnostics parsing_engine = { + parse_implementation: + for_printer:bool -> filename:string -> - (Parsetree.structure, 'diagnostics) parseResult; - parseInterface: - forPrinter:bool -> + (Parsetree.structure, 'diagnostics) parse_result; + parse_interface: + for_printer:bool -> filename:string -> - (Parsetree.signature, 'diagnostics) parseResult; - stringOfDiagnostics: source:string -> filename:string -> 'diagnostics -> unit; + (Parsetree.signature, 'diagnostics) parse_result; + string_of_diagnostics: source:string -> filename:string -> 'diagnostics -> unit; } -val parseImplementationFromSource : - forPrinter:bool -> - displayFilename:string -> +val parse_implementation_from_source : + for_printer:bool -> + display_filename:string -> source:string -> - (Parsetree.structure, Res_diagnostics.t list) parseResult + (Parsetree.structure, Res_diagnostics.t list) parse_result [@@live] -val parseInterfaceFromSource : - forPrinter:bool -> - displayFilename:string -> +val parse_interface_from_source : + for_printer:bool -> + display_filename:string -> source:string -> - (Parsetree.signature, Res_diagnostics.t list) parseResult + (Parsetree.signature, Res_diagnostics.t list) parse_result [@@live] -type printEngine = { - printImplementation: +type print_engine = { + print_implementation: width:int -> filename:string -> comments:Res_comment.t list -> Parsetree.structure -> unit; - printInterface: + print_interface: width:int -> filename:string -> comments:Res_comment.t list -> @@ -48,15 +48,15 @@ type printEngine = { unit; } -val parsingEngine : Res_diagnostics.t list parsingEngine +val parsing_engine : Res_diagnostics.t list parsing_engine -val printEngine : printEngine +val print_engine : print_engine (* ReScript implementation parsing compatible with ocaml pparse driver. Used by the compiler. *) val parse_implementation : - ?ignoreParseErrors:bool -> string -> Parsetree.structure + ?ignore_parse_errors:bool -> string -> Parsetree.structure [@@live] [@@raises Location.Error] (* ReScript interface parsing compatible with ocaml pparse driver. Used by the compiler *) -val parse_interface : ?ignoreParseErrors:bool -> string -> Parsetree.signature +val parse_interface : ?ignore_parse_errors:bool -> string -> Parsetree.signature [@@live] [@@raises Location.Error] diff --git a/jscomp/syntax/src/res_driver_binary.ml b/jscomp/syntax/src/res_driver_binary.ml index 58a8153630..71eb12bd48 100644 --- a/jscomp/syntax/src/res_driver_binary.ml +++ b/jscomp/syntax/src/res_driver_binary.ml @@ -1,12 +1,12 @@ -let printEngine = +let print_engine = Res_driver. { - printImplementation = + print_implementation = (fun ~width:_ ~filename ~comments:_ structure -> output_string stdout Config.ast_impl_magic_number; output_value stdout filename; output_value stdout structure); - printInterface = + print_interface = (fun ~width:_ ~filename ~comments:_ signature -> output_string stdout Config.ast_intf_magic_number; output_value stdout filename; diff --git a/jscomp/syntax/src/res_driver_binary.mli b/jscomp/syntax/src/res_driver_binary.mli index 7991ba8db3..46358ea375 100644 --- a/jscomp/syntax/src/res_driver_binary.mli +++ b/jscomp/syntax/src/res_driver_binary.mli @@ -1 +1 @@ -val printEngine : Res_driver.printEngine +val print_engine : Res_driver.print_engine diff --git a/jscomp/syntax/src/res_driver_ml_parser.ml b/jscomp/syntax/src/res_driver_ml_parser.ml index 0d6a99e9ae..e58e6fbc77 100644 --- a/jscomp/syntax/src/res_driver_ml_parser.ml +++ b/jscomp/syntax/src/res_driver_ml_parser.ml @@ -4,23 +4,23 @@ module IO = Res_io let setup ~filename = if String.length filename > 0 then ( Location.input_name := filename; - IO.readFile ~filename |> Lexing.from_string) + IO.read_file ~filename |> Lexing.from_string) else Lexing.from_channel stdin -let extractOcamlConcreteSyntax filename = +let extract_ocaml_concrete_syntax filename = let lexbuf = if String.length filename > 0 then - IO.readFile ~filename |> Lexing.from_string + IO.read_file ~filename |> Lexing.from_string else Lexing.from_channel stdin in - let stringLocs = ref [] in - let commentData = ref [] in - let rec next (prevTokEndPos : Lexing.position) () = + let string_locs = ref [] in + let comment_data = ref [] in + let rec next (prev_tok_end_pos : Lexing.position) () = let token = Lexer.token_with_comments lexbuf in match token with | OcamlParser.COMMENT (txt, loc) -> - let comment = Res_comment.fromOcamlComment ~loc ~prevTokEndPos ~txt in - commentData := comment :: !commentData; + let comment = Res_comment.from_ocaml_comment ~loc ~prev_tok_end_pos ~txt in + comment_data := comment :: !comment_data; next loc.Location.loc_end () | OcamlParser.STRING (_txt, None) -> let open Location in @@ -37,25 +37,25 @@ let extractOcamlConcreteSyntax filename = ((Bytes.sub [@doesNotRaise]) lexbuf.Lexing.lex_buffer loc.loc_start.pos_cnum len) in - stringLocs := (txt, loc) :: !stringLocs; + string_locs := (txt, loc) :: !string_locs; next lexbuf.Lexing.lex_curr_p () | OcamlParser.EOF -> () | _ -> next lexbuf.Lexing.lex_curr_p () in next lexbuf.Lexing.lex_start_p (); - (List.rev !stringLocs, List.rev !commentData) + (List.rev !string_locs, List.rev !comment_data) -let parsingEngine = +let parsing_engine = { - Res_driver.parseImplementation = - (fun ~forPrinter:_ ~filename -> + Res_driver.parse_implementation = + (fun ~for_printer:_ ~filename -> let lexbuf = setup ~filename in - let stringData, comments = - extractOcamlConcreteSyntax !Location.input_name + let string_data, comments = + extract_ocaml_concrete_syntax !Location.input_name in let structure = Parse.implementation lexbuf - |> Res_ast_conversion.replaceStringLiteralStructure stringData + |> Res_ast_conversion.replace_string_literal_structure string_data |> Res_ast_conversion.structure in { @@ -66,15 +66,15 @@ let parsingEngine = invalid = false; comments; }); - parseInterface = - (fun ~forPrinter:_ ~filename -> + parse_interface = + (fun ~for_printer:_ ~filename -> let lexbuf = setup ~filename in - let stringData, comments = - extractOcamlConcreteSyntax !Location.input_name + let string_data, comments = + extract_ocaml_concrete_syntax !Location.input_name in let signature = Parse.interface lexbuf - |> Res_ast_conversion.replaceStringLiteralSignature stringData + |> Res_ast_conversion.replace_string_literal_signature string_data |> Res_ast_conversion.signature in { @@ -85,16 +85,16 @@ let parsingEngine = invalid = false; comments; }); - stringOfDiagnostics = (fun ~source:_ ~filename:_ _diagnostics -> ()); + string_of_diagnostics = (fun ~source:_ ~filename:_ _diagnostics -> ()); } -let printEngine = +let print_engine = Res_driver. { - printImplementation = + print_implementation = (fun ~width:_ ~filename:_ ~comments:_ structure -> Pprintast.structure Format.std_formatter structure); - printInterface = + print_interface = (fun ~width:_ ~filename:_ ~comments:_ signature -> Pprintast.signature Format.std_formatter signature); } diff --git a/jscomp/syntax/src/res_driver_ml_parser.mli b/jscomp/syntax/src/res_driver_ml_parser.mli index 55a99c4d57..e104f6e637 100644 --- a/jscomp/syntax/src/res_driver_ml_parser.mli +++ b/jscomp/syntax/src/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 extractOcamlConcreteSyntax : +val extract_ocaml_concrete_syntax : string -> (string * Location.t) list * Res_comment.t list [@@live] -val parsingEngine : unit Res_driver.parsingEngine +val parsing_engine : unit Res_driver.parsing_engine -val printEngine : Res_driver.printEngine +val print_engine : Res_driver.print_engine diff --git a/jscomp/syntax/src/res_grammar.ml b/jscomp/syntax/src/res_grammar.ml index a7888f2f23..daf9a788e6 100644 --- a/jscomp/syntax/src/res_grammar.ml +++ b/jscomp/syntax/src/res_grammar.ml @@ -60,7 +60,7 @@ type t = | AttributePayload | TagNames -let toString = function +let to_string = function | OpenDescription -> "an open description" | ModuleLongIdent -> "a module path" | Ternary -> "a ternary expression" @@ -70,7 +70,7 @@ let toString = function | ExprOperand -> "a basic expression" | ExprUnary -> "a unary expression" | ExprBinaryAfterOp op -> - "an expression after the operator \"" ^ Token.toString op ^ "\"" + "an expression after the operator \"" ^ Token.to_string op ^ "\"" | ExprIf -> "an if expression" | IfCondition -> "the condition of an if expression" | IfBranch -> "the true-branch of an if expression" @@ -121,32 +121,32 @@ let toString = function | AttributePayload -> "an attribute payload" | TagNames -> "tag names" -let isSignatureItemStart = function +let is_signature_item_start = function | Token.At | Let | Typ | External | Exception | Open | Include | Module | AtAt | PercentPercent -> true | _ -> false -let isAtomicPatternStart = function +let is_atomic_pattern_start = function | Token.Int _ | String _ | Codepoint _ | Backtick | Lparen | Lbracket | Lbrace | Underscore | Lident _ | Uident _ | List | Exception | Percent -> true | _ -> false -let isAtomicExprStart = function +let is_atomic_expr_start = function | Token.True | False | Int _ | String _ | Float _ | Codepoint _ | Backtick | Uident _ | Lident _ | Hash | Lparen | List | Lbracket | Lbrace | LessThan | Module | Percent -> true | _ -> false -let isAtomicTypExprStart = function +let is_atomic_typ_expr_start = function | Token.SingleQuote | Underscore | Lparen | Lbrace | Uident _ | Lident _ | Percent -> true | _ -> false -let isExprStart = function +let is_expr_start = 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 _ @@ -155,107 +155,107 @@ let isExprStart = function true | _ -> false -let isJsxAttributeStart = function +let is_jsx_attribute_start = function | Token.Lident _ | Question | Lbrace -> true | _ -> false -let isStructureItemStart = function +let is_structure_item_start = function | Token.Open | Let | Typ | External | Exception | Include | Module | AtAt | PercentPercent | At -> true - | t when isExprStart t -> true + | t when is_expr_start t -> true | _ -> false -let isPatternStart = function +let is_pattern_start = function | Token.Int _ | Float _ | String _ | Codepoint _ | Backtick | True | False | Minus | Plus | Lparen | Lbracket | Lbrace | List | Underscore | Lident _ | Uident _ | Hash | Exception | Percent | Module | At -> true | _ -> false -let isParameterStart = function +let is_parameter_start = function | Token.Typ | Tilde | Dot -> true - | token when isPatternStart token -> true + | token when is_pattern_start token -> true | _ -> false (* TODO: overparse Uident ? *) -let isStringFieldDeclStart = function +let is_string_field_decl_start = function | Token.String _ | Lident _ | At | DotDotDot -> true | _ -> false (* TODO: overparse Uident ? *) -let isFieldDeclStart = function +let is_field_decl_start = function | Token.At | Mutable | Lident _ -> true (* recovery, TODO: this is not ideal… *) | Uident _ -> true - | t when Token.isKeyword t -> true + | t when Token.is_keyword t -> true | _ -> false -let isRecordDeclStart = function +let is_record_decl_start = function | Token.At | Mutable | Lident _ | DotDotDot | String _ -> true | _ -> false -let isTypExprStart = function +let is_typ_expr_start = function | Token.At | SingleQuote | Underscore | Lparen | Lbracket | Uident _ | Lident _ | Module | Percent | Lbrace -> true | _ -> false -let isTypeParameterStart = function +let is_type_parameter_start = function | Token.Tilde | Dot -> true - | token when isTypExprStart token -> true + | token when is_typ_expr_start token -> true | _ -> false -let isTypeParamStart = function +let is_type_param_start = function | Token.Plus | Minus | SingleQuote | Underscore -> true | _ -> false -let isFunctorArgStart = function +let is_functor_arg_start = function | Token.At | Uident _ | Underscore | Percent | Lbrace | Lparen -> true | _ -> false -let isModExprStart = function +let is_mod_expr_start = function | Token.At | Percent | Uident _ | Lbrace | Lparen | Lident "unpack" | Await -> true | _ -> false -let isRecordRowStart = function +let is_record_row_start = function | Token.DotDotDot -> true | Token.Uident _ | Lident _ -> true (* TODO *) - | t when Token.isKeyword t -> true + | t when Token.is_keyword t -> true | _ -> false -let isRecordRowStringKeyStart = function +let is_record_row_string_key_start = function | Token.String _ -> true | _ -> false -let isArgumentStart = function +let is_argument_start = function | Token.Tilde | Dot | Underscore -> true - | t when isExprStart t -> true + | t when is_expr_start t -> true | _ -> false -let isPatternMatchStart = function +let is_pattern_match_start = function | Token.Bar -> true - | t when isPatternStart t -> true + | t when is_pattern_start t -> true | _ -> false -let isPatternOcamlListStart = function +let is_pattern_ocaml_list_start = function | Token.DotDotDot -> true - | t when isPatternStart t -> true + | t when is_pattern_start t -> true | _ -> false -let isPatternRecordItemStart = function +let is_pattern_record_item_start = function | Token.DotDotDot | Uident _ | Lident _ | Underscore -> true | _ -> false -let isAttributeStart = function +let is_attribute_start = function | Token.At -> true | _ -> false -let isJsxChildStart = isAtomicExprStart +let is_jsx_child_start = is_atomic_expr_start -let isBlockExprStart = function +let is_block_expr_start = 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 @@ -264,38 +264,38 @@ let isBlockExprStart = function true | _ -> false -let isListElement grammar token = +let is_list_element grammar token = match grammar with - | 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 + | 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 | TypeConstraint -> token = Constraint | PackageConstraint -> token = And | ConstructorDeclaration -> token = Bar - | JsxAttribute -> isJsxAttributeStart token + | JsxAttribute -> is_jsx_attribute_start token | AttributePayload -> token = Lparen | TagNames -> token = Hash | _ -> false -let isListTerminator grammar token = +let is_list_terminator grammar token = match (grammar, token) with | _, Token.Eof | ExprList, (Rparen | Forwardslash | Rbracket) @@ -322,5 +322,5 @@ let isListTerminator grammar token = | TagNames, Rbracket -> true | _ -> false -let isPartOfList grammar token = - isListElement grammar token || isListTerminator grammar token +let is_part_of_list grammar token = + is_list_element grammar token || is_list_terminator grammar token diff --git a/jscomp/syntax/src/res_io.ml b/jscomp/syntax/src/res_io.ml index e5934b8483..1d55da8318 100644 --- a/jscomp/syntax/src/res_io.ml +++ b/jscomp/syntax/src/res_io.ml @@ -1,4 +1,4 @@ -let readFile ~filename = +let read_file ~filename = let chan = open_in_bin filename in let content = try really_input_string chan (in_channel_length chan) @@ -7,7 +7,7 @@ let readFile ~filename = close_in_noerr chan; content -let writeFile ~filename ~contents:txt = +let write_file ~filename ~contents:txt = let chan = open_out_bin filename in output_string chan txt; close_out chan diff --git a/jscomp/syntax/src/res_io.mli b/jscomp/syntax/src/res_io.mli index dcc6e14253..65e399e151 100644 --- a/jscomp/syntax/src/res_io.mli +++ b/jscomp/syntax/src/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 readFile : filename:string -> string +val read_file : filename:string -> string (* writes "content" into file with name "filename" *) -val writeFile : filename:string -> contents:string -> unit +val write_file : filename:string -> contents:string -> unit diff --git a/jscomp/syntax/src/res_multi_printer.ml b/jscomp/syntax/src/res_multi_printer.ml index 98cd1d4237..fd212eb453 100644 --- a/jscomp/syntax/src/res_multi_printer.ml +++ b/jscomp/syntax/src/res_multi_printer.ml @@ -1,28 +1,28 @@ -let defaultPrintWidth = 100 +let default_print_width = 100 (* Look at rescript.json (or bsconfig.json) to set Uncurried or Legacy mode if it contains "uncurried": false *) -let getUncurriedFromConfig ~filename = - let rec findConfig ~dir = +let get_uncurried_from_config ~filename = + let rec find_config ~dir = let config = Filename.concat dir "rescript.json" in - if Sys.file_exists config then Some (Res_io.readFile ~filename:config) + if Sys.file_exists config then Some (Res_io.read_file ~filename:config) else let config = Filename.concat dir "bsconfig.json" in - if Sys.file_exists config then Some (Res_io.readFile ~filename:config) + if Sys.file_exists config then Some (Res_io.read_file ~filename:config) else let parent = Filename.dirname dir in - if parent = dir then None else findConfig ~dir:parent + if parent = dir then None else find_config ~dir:parent in - let rec findFromNodeModules ~dir = + let rec find_from_node_modules ~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.readFile ~filename:config) + if Sys.file_exists config then Some (Res_io.read_file ~filename:config) else let config = Filename.concat parent "bsconfig.json" in - if Sys.file_exists config then Some (Res_io.readFile ~filename:config) + if Sys.file_exists config then Some (Res_io.read_file ~filename:config) else None else if parent = dir then None - else findFromNodeModules ~dir:parent + else find_from_node_modules ~dir:parent in let dir = if Filename.is_relative filename then @@ -30,12 +30,12 @@ let getUncurriedFromConfig ~filename = else Filename.dirname filename in let config () = - match findConfig ~dir with + match find_config ~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 - findFromNodeModules ~dir + find_from_node_modules ~dir | x -> x in match config () with @@ -65,55 +65,55 @@ let getUncurriedFromConfig ~filename = if not is_legacy_uncurried then Config.uncurried := Uncurried (* print res files to res syntax *) -let printRes ~ignoreParseErrors ~isInterface ~filename = - getUncurriedFromConfig ~filename; - if isInterface then ( - let parseResult = - Res_driver.parsingEngine.parseInterface ~forPrinter:true ~filename +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 in - 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) + 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) else - let parseResult = - Res_driver.parsingEngine.parseImplementation ~forPrinter:true ~filename + let parse_result = + Res_driver.parsing_engine.parse_implementation ~for_printer:true ~filename in - 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 + 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 [@@raises exit] (* print ocaml files to res syntax *) -let printMl ~isInterface ~filename = - if isInterface then - let parseResult = - Res_driver_ml_parser.parsingEngine.parseInterface ~forPrinter:true +let print_ml ~is_interface ~filename = + if is_interface then + let parse_result = + Res_driver_ml_parser.parsing_engine.parse_interface ~for_printer:true ~filename in - Res_printer.printInterface ~width:defaultPrintWidth - ~comments:parseResult.comments parseResult.parsetree + Res_printer.print_interface ~width:default_print_width + ~comments:parse_result.comments parse_result.parsetree else - let parseResult = - Res_driver_ml_parser.parsingEngine.parseImplementation ~forPrinter:true + let parse_result = + Res_driver_ml_parser.parsing_engine.parse_implementation ~for_printer:true ~filename in - Res_printer.printImplementation ~width:defaultPrintWidth - ~comments:parseResult.comments parseResult.parsetree + Res_printer.print_implementation ~width:default_print_width + ~comments:parse_result.comments parse_result.parsetree (* print the given file named input to from "language" to res, general interface exposed by the compiler *) -let print ?(ignoreParseErrors = false) language ~input = - let isInterface = +let print ?(ignore_parse_errors = false) language ~input = + let is_interface = let len = String.length input in len > 0 && String.unsafe_get input (len - 1) = 'i' in match language with - | `res -> printRes ~ignoreParseErrors ~isInterface ~filename:input - | `ml -> printMl ~isInterface ~filename:input + | `res -> print_res ~ignore_parse_errors ~is_interface ~filename:input + | `ml -> print_ml ~is_interface ~filename:input [@@raises exit] (* suppress unused optional arg *) -let _ = fun s -> print ~ignoreParseErrors:false s [@@raises exit] +let _ = fun s -> print ~ignore_parse_errors:false s [@@raises exit] diff --git a/jscomp/syntax/src/res_multi_printer.mli b/jscomp/syntax/src/res_multi_printer.mli index 1d15c71e28..ff3da3b3aa 100644 --- a/jscomp/syntax/src/res_multi_printer.mli +++ b/jscomp/syntax/src/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 : ?ignoreParseErrors:bool -> [`ml | `res] -> input:string -> string +val print : ?ignore_parse_errors:bool -> [`ml | `res] -> input:string -> string diff --git a/jscomp/syntax/src/res_outcome_printer.ml b/jscomp/syntax/src/res_outcome_printer.ml index 4c1534e762..7fe7eb0644 100644 --- a/jscomp/syntax/src/res_outcome_printer.ml +++ b/jscomp/syntax/src/res_outcome_printer.ml @@ -15,7 +15,7 @@ module Printer = Res_printer let parenthesized_ident _name = true (* TODO: better allocation strategy for the buffer *) -let escapeStringContents s = +let escape_string_contents s = let len = String.length s in let b = Buffer.create len in for i = 0 to len - 1 do @@ -54,59 +54,59 @@ let escapeStringContents s = print_ident fmt id2; Format.pp_print_char fmt ')' *) -let rec printOutIdentDoc ?(allowUident = true) (ident : Outcometree.out_ident) = +let rec print_out_ident_doc ?(allow_uident = true) (ident : Outcometree.out_ident) = match ident with - | Oide_ident s -> Printer.printIdentLike ~allowUident s + | Oide_ident s -> Printer.print_ident_like ~allow_uident s | Oide_dot (ident, s) -> - Doc.concat [printOutIdentDoc ident; Doc.dot; Doc.text s] + Doc.concat [print_out_ident_doc ident; Doc.dot; Doc.text s] | Oide_apply (call, arg) -> Doc.concat - [printOutIdentDoc call; Doc.lparen; printOutIdentDoc arg; Doc.rparen] + [print_out_ident_doc call; Doc.lparen; print_out_ident_doc arg; Doc.rparen] -let printOutAttributeDoc (outAttribute : Outcometree.out_attribute) = - Doc.concat [Doc.text "@"; Doc.text outAttribute.oattr_name] +let print_out_attribute_doc (out_attribute : Outcometree.out_attribute) = + Doc.concat [Doc.text "@"; Doc.text out_attribute.oattr_name] -let printOutAttributesDoc (attrs : Outcometree.out_attribute list) = +let print_out_attributes_doc (attrs : Outcometree.out_attribute list) = match attrs with | [] -> Doc.nil | attrs -> Doc.concat [ - Doc.group (Doc.join ~sep:Doc.line (List.map printOutAttributeDoc attrs)); + Doc.group (Doc.join ~sep:Doc.line (List.map print_out_attribute_doc attrs)); Doc.line; ] -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_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 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 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 printOutTypeDoc (outType : Outcometree.out_type) = - match outType with +let rec print_out_type_doc (out_type : Outcometree.out_type) = + match out_type with | Otyp_abstract | Otyp_open -> Doc.nil - | Otyp_variant (nonGen, outVariant, closed, labels) -> + | Otyp_variant (non_gen, out_variant, closed, labels) -> (* bool * out_variant * bool * (string list) option *) let opening = match (closed, labels) with - | true, None -> (* [#A | #B] *) Doc.softLine + | true, None -> (* [#A | #B] *) Doc.soft_line | false, None -> (* [> #A | #B] *) - Doc.concat [Doc.greaterThan; Doc.line] + Doc.concat [Doc.greater_than; Doc.line] | true, Some [] -> (* [< #A | #B] *) - Doc.concat [Doc.lessThan; Doc.line] + Doc.concat [Doc.less_than; Doc.line] | true, Some _ -> (* [< #A | #B > #X #Y ] *) - Doc.concat [Doc.lessThan; Doc.line] + Doc.concat [Doc.less_than; Doc.line] | false, Some _ -> (* impossible!? ocaml seems to print ?, see oprint.ml in 4.06 *) Doc.concat [Doc.text "?"; Doc.line] @@ -114,9 +114,9 @@ let rec printOutTypeDoc (outType : Outcometree.out_type) = Doc.group (Doc.concat [ - (if nonGen then Doc.text "_" else Doc.nil); + (if non_gen then Doc.text "_" else Doc.nil); Doc.lbracket; - Doc.indent (Doc.concat [opening; printOutVariant outVariant]); + Doc.indent (Doc.concat [opening; print_out_variant out_variant]); (match labels with | None | Some [] -> Doc.nil | Some tags -> @@ -127,80 +127,80 @@ let rec printOutTypeDoc (outType : Outcometree.out_type) = Doc.join ~sep:Doc.space (List.map (fun lbl -> - Printer.printIdentLike ~allowUident:true lbl) + Printer.print_ident_like ~allow_uident:true lbl) tags); ])); - Doc.softLine; + Doc.soft_line; Doc.rbracket; ]) - | Otyp_alias (typ, aliasTxt) -> + | Otyp_alias (typ, alias_txt) -> Doc.concat [ Doc.lparen; - printOutTypeDoc typ; + print_out_type_doc typ; Doc.text " as '"; - Doc.text aliasTxt; + Doc.text alias_txt; 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 "(. ()) => "; printOutTypeDoc typ] + Doc.concat [Doc.text "(. ()) => "; print_out_type_doc typ] | Otyp_constr ( Oide_dot (Oide_dot (Oide_ident "Js", "Fn"), _), - [(Otyp_arrow _ as arrowType)] ) -> + [(Otyp_arrow _ as arrow_type)] ) -> (* Compatibility with compiler up to v10.x *) - printOutArrowType ~uncurried:true arrowType - | Otyp_constr (Oide_ident "function$", [(Otyp_arrow _ as arrowType); _arity]) + print_out_arrow_type ~uncurried:true arrow_type + | Otyp_constr (Oide_ident "function$", [(Otyp_arrow _ as arrow_type); _arity]) -> (* function$<(int, int) => int, [#2]> -> (. int, int) => int *) - printOutArrowType ~uncurried:true arrowType + print_out_arrow_type ~uncurried:true arrow_type | Otyp_constr (Oide_ident "function$", [Otyp_var _; _arity]) -> (* function$<'a, arity> -> _ => _ *) - printOutTypeDoc (Otyp_stuff "_ => _") - | Otyp_constr (outIdent, []) -> printOutIdentDoc ~allowUident:false outIdent + print_out_type_doc (Otyp_stuff "_ => _") + | Otyp_constr (out_ident, []) -> print_out_ident_doc ~allow_uident:false out_ident | Otyp_manifest (typ1, typ2) -> - Doc.concat [printOutTypeDoc typ1; Doc.text " = "; printOutTypeDoc typ2] - | Otyp_record record -> printRecordDeclarationDoc ~inline:true record + Doc.concat [print_out_type_doc typ1; Doc.text " = "; print_out_type_doc typ2] + | Otyp_record record -> print_record_declaration_doc ~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) -> printObjectFields fields rest + | Otyp_object (fields, rest) -> print_object_fields fields rest | Otyp_class _ -> Doc.nil | Otyp_attribute (typ, attribute) -> Doc.group (Doc.concat - [printOutAttributeDoc attribute; Doc.line; printOutTypeDoc typ]) + [print_out_attribute_doc attribute; Doc.line; print_out_type_doc typ]) (* example: Red | Blue | Green | CustomColour(float, float, float) *) - | Otyp_sum constructors -> printOutConstructorsDoc constructors + | Otyp_sum constructors -> print_out_constructors_doc constructors (* example: {"name": string, "age": int} *) | Otyp_constr (Oide_dot (Oide_ident "Js", "t"), [Otyp_object (fields, rest)]) -> - printObjectFields fields rest + print_object_fields fields rest (* example: node *) - | Otyp_constr (outIdent, args) -> - let argsDoc = + | Otyp_constr (out_ident, args) -> + let args_doc = match args with | [] -> Doc.nil | args -> Doc.concat [ - Doc.lessThan; + Doc.less_than; Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map printOutTypeDoc args); + (List.map print_out_type_doc args); ]); - Doc.trailingComma; - Doc.softLine; - Doc.greaterThan; + Doc.trailing_comma; + Doc.soft_line; + Doc.greater_than; ] in - Doc.group (Doc.concat [printOutIdentDoc outIdent; argsDoc]) - | Otyp_tuple tupleArgs -> + Doc.group (Doc.concat [print_out_ident_doc out_ident; args_doc]) + | Otyp_tuple tuple_args -> Doc.group (Doc.concat [ @@ -208,16 +208,16 @@ let rec printOutTypeDoc (outType : Outcometree.out_type) = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map printOutTypeDoc tupleArgs); + (List.map print_out_type_doc tuple_args); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ]) - | Otyp_poly (vars, outType) -> + | Otyp_poly (vars, out_type) -> Doc.group (Doc.concat [ @@ -225,12 +225,12 @@ let rec printOutTypeDoc (outType : Outcometree.out_type) = (List.map (fun var -> Doc.text ("'" ^ var)) vars); Doc.dot; Doc.space; - printOutTypeDoc outType; + print_out_type_doc out_type; ]) - | Otyp_arrow _ as typ -> printOutArrowType ~uncurried:false typ - | Otyp_module (modName, stringList, outTypes) -> - let packageTypeDoc = - match (stringList, outTypes) with + | 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 | [], [] -> Doc.nil | labels, types -> let i = ref 0 in @@ -244,7 +244,7 @@ let rec printOutTypeDoc (outType : Outcometree.out_type) = (if i.contents > 0 then "and type " else "with type "); Doc.text lbl; Doc.text " = "; - printOutTypeDoc typ; + print_out_type_doc typ; ]) labels types) in @@ -254,41 +254,41 @@ let rec printOutTypeDoc (outType : Outcometree.out_type) = [ Doc.text "module"; Doc.lparen; - Doc.text modName; - packageTypeDoc; + Doc.text mod_name; + package_type_doc; Doc.rparen; ] -and printOutArrowType ~uncurried typ = - let uncurried = Res_uncurried.getDotted ~uncurried !Config.uncurried in - let typArgs, typ = collectArrowArgs typ [] in +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 let args = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun (lbl, typ) -> - let lblLen = String.length lbl in - if lblLen = 0 then printOutTypeDoc typ + let lbl_len = String.length lbl in + if lbl_len = 0 then print_out_type_doc typ else - let lbl, optionalIndicator = + let lbl, optional_indicator = (* 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 (lblLen - 1), Doc.text "=?") + ((String.sub [@doesNotRaise]) lbl 1 (lbl_len - 1), Doc.text "=?") | _ -> (lbl, Doc.nil) in Doc.group (Doc.concat [ Doc.text ("~" ^ lbl ^ ": "); - printOutTypeDoc typ; - optionalIndicator; + print_out_type_doc typ; + optional_indicator; ])) - typArgs) + typ_args) in - let argsDoc = - let needsParens = - match typArgs with + let args_doc = + let needs_parens = + match typ_args with | _ when uncurried -> true | [ ( _, @@ -300,21 +300,21 @@ and printOutArrowType ~uncurried typ = | [("", _)] -> false | _ -> true in - if needsParens then + if needs_parens then Doc.group (Doc.concat [ (if uncurried then Doc.text "(. " else Doc.lparen); - Doc.indent (Doc.concat [Doc.softLine; args]); - Doc.trailingComma; - Doc.softLine; + Doc.indent (Doc.concat [Doc.soft_line; args]); + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ]) else args in - Doc.concat [argsDoc; Doc.text " => "; printOutTypeDoc typ] + Doc.concat [args_doc; Doc.text " => "; print_out_type_doc typ] -and printOutVariant variant = +and print_out_variant variant = match variant with | Ovar_fields fields -> (* (string * bool * out_type list) list *) @@ -325,7 +325,7 @@ and printOutVariant variant = *) List.mapi (fun i (name, ampersand, types) -> - let needsParens = + let needs_parens = match types with | [Outcometree.Otyp_tuple _] -> false | _ -> true @@ -333,12 +333,12 @@ and printOutVariant variant = Doc.concat [ (if i > 0 then Doc.text "| " - else Doc.ifBreaks (Doc.text "| ") Doc.nil); + else Doc.if_breaks (Doc.text "| ") Doc.nil); Doc.group (Doc.concat [ Doc.text "#"; - Printer.printPolyVarIdent name; + Printer.print_poly_var_ident name; (match types with | [] -> Doc.nil | types -> @@ -352,26 +352,26 @@ and printOutVariant variant = ~sep:(Doc.concat [Doc.text " &"; Doc.line]) (List.map (fun typ -> - let outTypeDoc = - printOutTypeDoc typ + let out_type_doc = + print_out_type_doc typ in - if needsParens then + if needs_parens then Doc.concat [ Doc.lparen; - outTypeDoc; + out_type_doc; Doc.rparen; ] - else outTypeDoc) + else out_type_doc) types); ]); ]); ]); ]) fields) - | Ovar_typ typ -> printOutTypeDoc typ + | Ovar_typ typ -> print_out_type_doc typ -and printObjectFields fields rest = +and print_object_fields fields rest = let dots = match rest with | Some non_gen -> Doc.text ((if non_gen then "_" else "") ^ "..") @@ -385,49 +385,49 @@ and printObjectFields fields rest = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun (lbl, outType) -> + (fun (lbl, out_type) -> Doc.group (Doc.concat [ Doc.text ("\"" ^ lbl ^ "\": "); - printOutTypeDoc outType; + print_out_type_doc out_type; ])) fields); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ]) -and printOutConstructorsDoc constructors = +and print_out_constructors_doc constructors = Doc.group (Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:Doc.line (List.mapi (fun i constructor -> Doc.concat [ (if i > 0 then Doc.text "| " - else Doc.ifBreaks (Doc.text "| ") Doc.nil); - printOutConstructorDoc constructor; + else Doc.if_breaks (Doc.text "| ") Doc.nil); + print_out_constructor_doc constructor; ]) constructors); ])) -and printOutConstructorDoc (name, args, gadt) = - let gadtDoc = +and print_out_constructor_doc (name, args, gadt) = + let gadt_doc = match gadt with - | Some outType -> Doc.concat [Doc.text ": "; printOutTypeDoc outType] + | Some out_type -> Doc.concat [Doc.text ": "; print_out_type_doc out_type] | None -> Doc.nil in - let argsDoc = + let args_doc = match args with | [] -> Doc.nil | [Otyp_record record] -> @@ -440,7 +440,7 @@ and printOutConstructorDoc (name, args, gadt) = Doc.concat [ Doc.lparen; - Doc.indent (printRecordDeclarationDoc ~inline:true record); + Doc.indent (print_record_declaration_doc ~inline:true record); Doc.rparen; ] | _types -> @@ -451,30 +451,30 @@ and printOutConstructorDoc (name, args, gadt) = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map printOutTypeDoc args); + (List.map print_out_type_doc args); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ]) in - Doc.group (Doc.concat [Doc.text name; argsDoc; gadtDoc]) + Doc.group (Doc.concat [Doc.text name; args_doc; gadt_doc]) -and printRecordDeclRowDoc (name, mut, opt, arg) = +and print_record_decl_row_doc (name, mut, opt, arg) = Doc.group (Doc.concat [ (if mut then Doc.text "mutable " else Doc.nil); - Printer.printIdentLike ~allowUident:false name; + Printer.print_ident_like ~allow_uident:false name; (if opt then Doc.text "?" else Doc.nil); Doc.text ": "; - printOutTypeDoc arg; + print_out_type_doc arg; ]) -and printRecordDeclarationDoc ~inline rows = +and print_record_declaration_doc ~inline rows = let content = Doc.concat [ @@ -482,47 +482,47 @@ and printRecordDeclarationDoc ~inline rows = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map printRecordDeclRowDoc rows); + (List.map print_record_decl_row_doc rows); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ] in if not inline then Doc.group content else content -let printOutType fmt outType = - Format.pp_print_string fmt (Doc.toString ~width:80 (printOutTypeDoc outType)) +let print_out_type fmt out_type = + Format.pp_print_string fmt (Doc.to_string ~width:80 (print_out_type_doc out_type)) -let printTypeParameterDoc (typ, (co, cn)) = +let print_type_parameter_doc (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 printOutSigItemDoc ?(printNameAsIs = false) - (outSigItem : Outcometree.out_sig_item) = - match outSigItem with +let rec print_out_sig_item_doc ?(print_name_as_is = false) + (out_sig_item : Outcometree.out_sig_item) = + match out_sig_item with | Osig_class _ | Osig_class_type _ -> Doc.nil | Osig_ellipsis -> Doc.dotdotdot - | Osig_value valueDecl -> + | Osig_value value_decl -> Doc.group (Doc.concat [ - printOutAttributesDoc valueDecl.oval_attributes; + print_out_attributes_doc value_decl.oval_attributes; Doc.text - (match valueDecl.oval_prims with + (match value_decl.oval_prims with | [] -> "let " | _ -> "external "); - Doc.text valueDecl.oval_name; + Doc.text value_decl.oval_name; Doc.text ":"; Doc.space; - printOutTypeDoc valueDecl.oval_type; - (match valueDecl.oval_prims with + print_out_type_doc value_decl.oval_type; + (match value_decl.oval_prims with | [] -> Doc.nil | primitives -> Doc.indent @@ -546,46 +546,46 @@ let rec printOutSigItemDoc ?(printNameAsIs = false) primitives)); ])); ]) - | Osig_typext (outExtensionConstructor, _outExtStatus) -> - printOutExtensionConstructorDoc outExtensionConstructor - | Osig_modtype (modName, Omty_signature []) -> - Doc.concat [Doc.text "module type "; Doc.text modName] - | Osig_modtype (modName, outModuleType) -> + | 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) -> Doc.group (Doc.concat [ Doc.text "module type "; - Doc.text modName; + Doc.text mod_name; Doc.text " = "; - printOutModuleTypeDoc outModuleType; + print_out_module_type_doc out_module_type; ]) - | Osig_module (modName, Omty_alias ident, _) -> + | Osig_module (mod_name, Omty_alias ident, _) -> Doc.group (Doc.concat [ Doc.text "module "; - Doc.text modName; + Doc.text mod_name; Doc.text " ="; Doc.line; - printOutIdentDoc ident; + print_out_ident_doc ident; ]) - | Osig_module (modName, outModType, outRecStatus) -> + | Osig_module (mod_name, out_mod_type, out_rec_status) -> Doc.group (Doc.concat [ Doc.text - (match outRecStatus with + (match out_rec_status with | Orec_not -> "module " | Orec_first -> "module rec " | Orec_next -> "and "); - Doc.text modName; + Doc.text mod_name; Doc.text ": "; - printOutModuleTypeDoc outModType; + print_out_module_type_doc out_mod_type; ]) - | Osig_type (outTypeDecl, outRecStatus) -> + | Osig_type (out_type_decl, out_rec_status) -> (* TODO: manifest ? *) let attrs = - match (outTypeDecl.otype_immediate, outTypeDecl.otype_unboxed) with + match (out_type_decl.otype_immediate, out_type_decl.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] @@ -593,59 +593,59 @@ let rec printOutSigItemDoc ?(printNameAsIs = false) in let kw = Doc.text - (match outRecStatus with + (match out_rec_status with | Orec_not -> "type " | Orec_first -> "type rec " | Orec_next -> "and ") in - let typeParams = - match outTypeDecl.otype_params with + let type_params = + match out_type_decl.otype_params with | [] -> Doc.nil | _params -> Doc.group (Doc.concat [ - Doc.lessThan; + Doc.less_than; Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map printTypeParameterDoc outTypeDecl.otype_params); + (List.map print_type_parameter_doc out_type_decl.otype_params); ]); - Doc.trailingComma; - Doc.softLine; - Doc.greaterThan; + Doc.trailing_comma; + Doc.soft_line; + Doc.greater_than; ]) in - let privateDoc = - match outTypeDecl.otype_private with + let private_doc = + match out_type_decl.otype_private with | Asttypes.Private -> Doc.text "private " | Public -> Doc.nil in let kind = - match outTypeDecl.otype_type with - | Otyp_open -> Doc.concat [Doc.text " = "; privateDoc; Doc.text ".."] + match out_type_decl.otype_type with + | Otyp_open -> Doc.concat [Doc.text " = "; private_doc; Doc.text ".."] | Otyp_abstract -> Doc.nil | Otyp_record record -> Doc.concat [ Doc.text " = "; - privateDoc; - printRecordDeclarationDoc ~inline:false record; + private_doc; + print_record_declaration_doc ~inline:false record; ] - | typ -> Doc.concat [Doc.text " = "; printOutTypeDoc typ] + | typ -> Doc.concat [Doc.text " = "; print_out_type_doc typ] in let constraints = - match outTypeDecl.otype_cstrs with + match out_type_decl.otype_cstrs with | [] -> Doc.nil | _ -> Doc.group (Doc.indent (Doc.concat [ - Doc.hardLine; + Doc.hard_line; Doc.join ~sep:Doc.line (List.map (fun (typ1, typ2) -> @@ -653,12 +653,12 @@ let rec printOutSigItemDoc ?(printNameAsIs = false) (Doc.concat [ Doc.text "constraint "; - printOutTypeDoc typ1; + print_out_type_doc typ1; Doc.text " ="; Doc.space; - printOutTypeDoc typ2; + print_out_type_doc typ2; ])) - outTypeDecl.otype_cstrs); + out_type_decl.otype_cstrs); ])) in Doc.group @@ -670,24 +670,24 @@ let rec printOutSigItemDoc ?(printNameAsIs = false) [ attrs; kw; - (if printNameAsIs then Doc.text outTypeDecl.otype_name + (if print_name_as_is then Doc.text out_type_decl.otype_name else - Printer.printIdentLike ~allowUident:false - outTypeDecl.otype_name); - typeParams; + Printer.print_ident_like ~allow_uident:false + out_type_decl.otype_name); + type_params; kind; ]); constraints; ]) -and printOutModuleTypeDoc (outModType : Outcometree.out_module_type) = - match outModType with +and print_out_module_type_doc (out_mod_type : Outcometree.out_module_type) = + match out_mod_type with | Omty_abstract -> Doc.nil - | Omty_ident ident -> printOutIdentDoc ident + | Omty_ident ident -> print_out_ident_doc ident (* example: module Increment = (M: X_int) => X_int *) | Omty_functor _ -> - let args, returnModType = collectFunctorArgs outModType [] in - let argsDoc = + let args, return_mod_type = collect_functor_args out_mod_type [] in + let args_doc = match args with | [(_, None)] -> Doc.text "()" | args -> @@ -698,47 +698,47 @@ and printOutModuleTypeDoc (outModType : Outcometree.out_module_type) = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun (lbl, optModType) -> + (fun (lbl, opt_mod_type) -> Doc.group (Doc.concat [ Doc.text lbl; - (match optModType with + (match opt_mod_type with | None -> Doc.nil - | Some modType -> + | Some mod_type -> Doc.concat [ Doc.text ": "; - printOutModuleTypeDoc modType; + print_out_module_type_doc mod_type; ]); ])) args); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ]) in Doc.group (Doc.concat - [argsDoc; Doc.text " => "; printOutModuleTypeDoc returnModType]) + [args_doc; Doc.text " => "; print_out_module_type_doc return_mod_type]) | Omty_signature [] -> Doc.nil | Omty_signature signature -> - Doc.breakableGroup ~forceBreak:true + Doc.breakable_group ~force_break:true (Doc.concat [ Doc.lbrace; - Doc.indent (Doc.concat [Doc.line; printOutSignatureDoc signature]); - Doc.softLine; + Doc.indent (Doc.concat [Doc.line; print_out_signature_doc signature]); + Doc.soft_line; Doc.rbrace; ]) | Omty_alias _ident -> Doc.nil -and printOutSignatureDoc (signature : Outcometree.out_sig_item list) = +and print_out_signature_doc (signature : Outcometree.out_sig_item list) = let rec loop signature acc = match signature with | [] -> List.rev acc @@ -765,30 +765,30 @@ and printOutSignatureDoc (signature : Outcometree.out_sig_item list) = otyext_private = ext.oext_private; } in - let doc = printOutTypeExtensionDoc te in + let doc = print_out_type_extension_doc te in loop items (doc :: acc) | item :: items -> - let doc = printOutSigItemDoc ~printNameAsIs:false item in + let doc = print_out_sig_item_doc ~print_name_as_is:false item in loop items (doc :: acc) in match loop signature [] with | [doc] -> doc - | docs -> Doc.breakableGroup ~forceBreak:true (Doc.join ~sep:Doc.line docs) + | docs -> Doc.breakable_group ~force_break:true (Doc.join ~sep:Doc.line docs) -and printOutExtensionConstructorDoc - (outExt : Outcometree.out_extension_constructor) = - let typeParams = - match outExt.oext_type_params with +and print_out_extension_constructor_doc + (out_ext : Outcometree.out_extension_constructor) = + let type_params = + match out_ext.oext_type_params with | [] -> Doc.nil | params -> Doc.group (Doc.concat [ - Doc.lessThan; + Doc.less_than; Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map @@ -796,8 +796,8 @@ and printOutExtensionConstructorDoc Doc.text (if ty = "_" then ty else "'" ^ ty)) params); ]); - Doc.softLine; - Doc.greaterThan; + Doc.soft_line; + Doc.greater_than; ]) in @@ -805,29 +805,29 @@ and printOutExtensionConstructorDoc (Doc.concat [ Doc.text "type "; - Printer.printIdentLike ~allowUident:false outExt.oext_type_name; - typeParams; + Printer.print_ident_like ~allow_uident:false out_ext.oext_type_name; + type_params; Doc.text " += "; Doc.line; - (if outExt.oext_private = Asttypes.Private then Doc.text "private " + (if out_ext.oext_private = Asttypes.Private then Doc.text "private " else Doc.nil); - printOutConstructorDoc - (outExt.oext_name, outExt.oext_args, outExt.oext_ret_type); + print_out_constructor_doc + (out_ext.oext_name, out_ext.oext_args, out_ext.oext_ret_type); ]) -and printOutTypeExtensionDoc (typeExtension : Outcometree.out_type_extension) = - let typeParams = - match typeExtension.otyext_params with +and print_out_type_extension_doc (type_extension : Outcometree.out_type_extension) = + let type_params = + match type_extension.otyext_params with | [] -> Doc.nil | params -> Doc.group (Doc.concat [ - Doc.lessThan; + Doc.less_than; Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map @@ -835,8 +835,8 @@ and printOutTypeExtensionDoc (typeExtension : Outcometree.out_type_extension) = Doc.text (if ty = "_" then ty else "'" ^ ty)) params); ]); - Doc.softLine; - Doc.greaterThan; + Doc.soft_line; + Doc.greater_than; ]) in @@ -844,24 +844,24 @@ and printOutTypeExtensionDoc (typeExtension : Outcometree.out_type_extension) = (Doc.concat [ Doc.text "type "; - Printer.printIdentLike ~allowUident:false typeExtension.otyext_name; - typeParams; + Printer.print_ident_like ~allow_uident:false type_extension.otyext_name; + type_params; Doc.text " += "; - (if typeExtension.otyext_private = Asttypes.Private then + (if type_extension.otyext_private = Asttypes.Private then Doc.text "private " else Doc.nil); - printOutConstructorsDoc typeExtension.otyext_constructors; + print_out_constructors_doc type_extension.otyext_constructors; ]) -let printOutSigItem fmt outSigItem = +let print_out_sig_item fmt out_sig_item = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutSigItemDoc outSigItem)) + (Doc.to_string ~width:80 (print_out_sig_item_doc out_sig_item)) -let printOutSignature fmt signature = +let print_out_signature fmt signature = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutSignatureDoc signature)) + (Doc.to_string ~width:80 (print_out_signature_doc signature)) -let validFloatLexeme s = +let valid_float_lexeme s = let l = String.length s in let rec loop i = if i >= l then s ^ "." @@ -872,7 +872,7 @@ let validFloatLexeme s = in loop 0 -let floatRepres f = +let float_repres f = match classify_float f with | FP_nan -> "nan" | FP_infinite -> if f < 0.0 then "neg_infinity" else "infinity" @@ -885,11 +885,11 @@ let floatRepres f = if f = (float_of_string [@doesNotRaise]) s2 then s2 else Printf.sprintf "%.18g" f in - validFloatLexeme float_val + valid_float_lexeme float_val -let rec printOutValueDoc (outValue : Outcometree.out_value) = - match outValue with - | Oval_array outValues -> +let rec print_out_value_doc (out_value : Outcometree.out_value) = + match out_value with + | Oval_array out_values -> Doc.group (Doc.concat [ @@ -897,32 +897,32 @@ let rec printOutValueDoc (outValue : Outcometree.out_value) = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map printOutValueDoc outValues); + (List.map print_out_value_doc out_values); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbracket; ]) | Oval_char c -> Doc.text ("'" ^ Char.escaped c ^ "'") - | Oval_constr (outIdent, outValues) -> + | Oval_constr (out_ident, out_values) -> Doc.group (Doc.concat [ - printOutIdentDoc outIdent; + print_out_ident_doc out_ident; Doc.lparen; Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map printOutValueDoc outValues); + (List.map print_out_value_doc out_values); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ]) | Oval_ellipsis -> Doc.text "..." @@ -930,8 +930,8 @@ let rec printOutValueDoc (outValue : 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 (floatRepres f) - | Oval_list outValues -> + | Oval_float f -> Doc.text (float_repres f) + | Oval_list out_values -> Doc.group (Doc.concat [ @@ -939,13 +939,13 @@ let rec printOutValueDoc (outValue : Outcometree.out_value) = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map printOutValueDoc outValues); + (List.map print_out_value_doc out_values); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbracket; ]) | Oval_printer fn -> @@ -961,28 +961,28 @@ let rec printOutValueDoc (outValue : Outcometree.out_value) = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun (outIdent, outValue) -> + (fun (out_ident, out_value) -> Doc.group (Doc.concat [ - printOutIdentDoc outIdent; + print_out_ident_doc out_ident; Doc.text ": "; - printOutValueDoc outValue; + print_out_value_doc out_value; ])) rows); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ]) | Oval_string (txt, _sizeToPrint, _kind) -> - Doc.text (escapeStringContents txt) + Doc.text (escape_string_contents txt) | Oval_stuff txt -> Doc.text txt - | Oval_tuple outValues -> + | Oval_tuple out_values -> Doc.group (Doc.concat [ @@ -990,19 +990,19 @@ let rec printOutValueDoc (outValue : Outcometree.out_value) = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map printOutValueDoc outValues); + (List.map print_out_value_doc out_values); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ]) (* Not supported by ReScript *) | Oval_variant _ -> Doc.nil -let printOutExceptionDoc exc outValue = +let print_out_exception_doc exc out_value = match exc with | Sys.Break -> Doc.text "Interrupted." | Out_of_memory -> Doc.text "Out of memory during evaluation." @@ -1012,9 +1012,9 @@ let printOutExceptionDoc exc outValue = Doc.group (Doc.indent (Doc.concat - [Doc.text "Exception:"; Doc.line; printOutValueDoc outValue])) + [Doc.text "Exception:"; Doc.line; print_out_value_doc out_value])) -let printOutPhraseSignature signature = +let print_out_phrase_signature signature = let rec loop signature acc = match signature with | [] -> List.rev acc @@ -1041,65 +1041,65 @@ let printOutPhraseSignature signature = otyext_private = ext.oext_private; } in - let doc = printOutTypeExtensionDoc te in + let doc = print_out_type_extension_doc te in loop signature (doc :: acc) - | (sigItem, optOutValue) :: signature -> + | (sig_item, opt_out_value) :: signature -> let doc = - match optOutValue with - | None -> printOutSigItemDoc sigItem - | Some outValue -> + match opt_out_value with + | None -> print_out_sig_item_doc sig_item + | Some out_value -> Doc.group (Doc.concat [ - printOutSigItemDoc sigItem; + print_out_sig_item_doc sig_item; Doc.text " = "; - printOutValueDoc outValue; + print_out_value_doc out_value; ]) in loop signature (doc :: acc) in - Doc.breakableGroup ~forceBreak:true + Doc.breakable_group ~force_break:true (Doc.join ~sep:Doc.line (loop signature [])) -let printOutPhraseDoc (outPhrase : Outcometree.out_phrase) = - match outPhrase with - | Ophr_eval (outValue, outType) -> +let print_out_phrase_doc (out_phrase : Outcometree.out_phrase) = + match out_phrase with + | Ophr_eval (out_value, out_type) -> Doc.group (Doc.concat [ Doc.text "- : "; - printOutTypeDoc outType; + print_out_type_doc out_type; Doc.text " ="; - Doc.indent (Doc.concat [Doc.line; printOutValueDoc outValue]); + Doc.indent (Doc.concat [Doc.line; print_out_value_doc out_value]); ]) | Ophr_signature [] -> Doc.nil - | Ophr_signature signature -> printOutPhraseSignature signature - | Ophr_exception (exc, outValue) -> printOutExceptionDoc exc outValue + | Ophr_signature signature -> print_out_phrase_signature signature + | Ophr_exception (exc, out_value) -> print_out_exception_doc exc out_value -let printOutPhrase fmt outPhrase = +let print_out_phrase fmt out_phrase = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutPhraseDoc outPhrase)) + (Doc.to_string ~width:80 (print_out_phrase_doc out_phrase)) -let printOutModuleType fmt outModuleType = +let print_out_module_type fmt out_module_type = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutModuleTypeDoc outModuleType)) + (Doc.to_string ~width:80 (print_out_module_type_doc out_module_type)) -let printOutTypeExtension fmt typeExtension = +let print_out_type_extension fmt type_extension = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutTypeExtensionDoc typeExtension)) + (Doc.to_string ~width:80 (print_out_type_extension_doc type_extension)) -let printOutValue fmt outValue = +let print_out_value fmt out_value = Format.pp_print_string fmt - (Doc.toString ~width:80 (printOutValueDoc outValue)) + (Doc.to_string ~width:80 (print_out_value_doc out_value)) (* Not supported in ReScript *) (* Oprint.out_class_type *) let setup = lazy - (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) + (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) diff --git a/jscomp/syntax/src/res_outcome_printer.mli b/jscomp/syntax/src/res_outcome_printer.mli index c51bb0931d..609644e777 100644 --- a/jscomp/syntax/src/res_outcome_printer.mli +++ b/jscomp/syntax/src/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 printOutTypeDoc : Outcometree.out_type -> Res_doc.t [@@live] -val printOutSigItemDoc : - ?printNameAsIs:bool -> Outcometree.out_sig_item -> Res_doc.t +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 [@@live] diff --git a/jscomp/syntax/src/res_parens.ml b/jscomp/syntax/src/res_parens.ml index 4c699c9a31..50ce988e65 100644 --- a/jscomp/syntax/src/res_parens.ml +++ b/jscomp/syntax/src/res_parens.ml @@ -2,9 +2,9 @@ module ParsetreeViewer = Res_parsetree_viewer type kind = Parenthesized | Braced of Location.t | Nothing let expr expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc + let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in + match opt_braces with + | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc | _ -> ( match expr with | { @@ -15,37 +15,37 @@ let expr expr = | {pexp_desc = Pexp_constraint _} -> Parenthesized | _ -> Nothing) -let exprRecordRowRhs e = +let expr_record_row_rhs e = let kind = expr e in match kind with - | Nothing when Res_parsetree_viewer.hasOptionalAttribute e.pexp_attributes + | Nothing when Res_parsetree_viewer.has_optional_attribute e.pexp_attributes -> ( match e.pexp_desc with | Pexp_ifthenelse _ | Pexp_fun _ -> Parenthesized | _ -> kind) | _ -> kind -let callExpr expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc +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 | _ -> ( match expr with | {Parsetree.pexp_attributes = attrs} - when match ParsetreeViewer.filterParsingAttrs attrs with + when match ParsetreeViewer.filter_parsing_attrs attrs with | _ :: _ -> true | [] -> false -> Parenthesized | _ - when ParsetreeViewer.isUnaryExpression expr - || ParsetreeViewer.isBinaryExpression expr -> + when ParsetreeViewer.is_unary_expression expr + || ParsetreeViewer.is_binary_expression expr -> Parenthesized | { Parsetree.pexp_desc = Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}); } -> Nothing - | {pexp_desc = Pexp_fun _} when ParsetreeViewer.isUnderscoreApplySugar expr + | {pexp_desc = Pexp_fun _} when ParsetreeViewer.is_underscore_apply_sugar expr -> Nothing | { @@ -55,20 +55,20 @@ let callExpr expr = | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_ifthenelse _ ); } -> Parenthesized - | _ when Ast_uncurried.exprIsUncurriedFun expr -> Parenthesized - | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> + | _ when Ast_uncurried.expr_is_uncurried_fun expr -> Parenthesized + | _ when ParsetreeViewer.has_await_attribute expr.pexp_attributes -> Parenthesized | _ -> Nothing) -let structureExpr expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc +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 | None -> ( match expr with | _ - when ParsetreeViewer.hasAttributes expr.pexp_attributes - && not (ParsetreeViewer.isJsxExpression expr) -> + when ParsetreeViewer.has_attributes expr.pexp_attributes + && not (ParsetreeViewer.is_jsx_expression expr) -> Parenthesized | { Parsetree.pexp_desc = @@ -78,27 +78,27 @@ let structureExpr expr = | {pexp_desc = Pexp_constraint _} -> Parenthesized | _ -> Nothing) -let unaryExprOperand expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc +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 | None -> ( match expr with | {Parsetree.pexp_attributes = attrs} - when match ParsetreeViewer.filterParsingAttrs attrs with + when match ParsetreeViewer.filter_parsing_attrs attrs with | _ :: _ -> true | [] -> false -> Parenthesized | expr - when ParsetreeViewer.isUnaryExpression expr - || ParsetreeViewer.isBinaryExpression expr -> + when ParsetreeViewer.is_unary_expression expr + || ParsetreeViewer.is_binary_expression expr -> Parenthesized | { pexp_desc = Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}); } -> Nothing - | {pexp_desc = Pexp_fun _} when ParsetreeViewer.isUnderscoreApplySugar expr + | {pexp_desc = Pexp_fun _} when ParsetreeViewer.is_underscore_apply_sugar expr -> Nothing | { @@ -109,14 +109,14 @@ let unaryExprOperand expr = | Pexp_try _ | Pexp_while _ | Pexp_for _ | Pexp_ifthenelse _ ); } -> Parenthesized - | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> + | _ when ParsetreeViewer.has_await_attribute expr.pexp_attributes -> Parenthesized | _ -> Nothing) -let binaryExprOperand ~isLhs expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc +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 | None -> ( match expr with | { @@ -124,7 +124,7 @@ let binaryExprOperand ~isLhs expr = Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}); } -> Nothing - | {pexp_desc = Pexp_fun _} when ParsetreeViewer.isUnderscoreApplySugar expr + | {pexp_desc = Pexp_fun _} when ParsetreeViewer.is_underscore_apply_sugar expr -> Nothing | { @@ -132,74 +132,74 @@ let binaryExprOperand ~isLhs expr = Pexp_constraint _ | Pexp_fun _ | Pexp_function _ | Pexp_newtype _; } -> Parenthesized - | _ 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 -> + | _ 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 -> Parenthesized | {Parsetree.pexp_attributes = attrs} -> - if ParsetreeViewer.hasPrintableAttributes attrs then Parenthesized + if ParsetreeViewer.has_printable_attributes attrs then Parenthesized else Nothing) -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) +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) || (* a && b || c, add parens to (a && b) for readability, who knows the difference by heart… *) - (parentOperator = "||" && childOperator = "&&") + (parent_operator = "||" && child_operator = "&&") -let rhsBinaryExprOperand parentOperator rhs = +let rhs_binary_expr_operand parent_operator rhs = match rhs.Parsetree.pexp_desc with | Parsetree.Pexp_apply ( { pexp_attributes = []; pexp_desc = - Pexp_ident {txt = Longident.Lident operator; loc = operatorLoc}; + Pexp_ident {txt = Longident.Lident operator; loc = operator_loc}; }, [(_, _left); (_, _right)] ) - when ParsetreeViewer.isBinaryOperator operator - && not (operatorLoc.loc_ghost && operator = "^") -> - let precParent = ParsetreeViewer.operatorPrecedence parentOperator in - let precChild = ParsetreeViewer.operatorPrecedence operator in - precParent == precChild + 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 | _ -> false -let flattenOperandRhs parentOperator rhs = +let flatten_operand_rhs parent_operator rhs = match rhs.Parsetree.pexp_desc with | Parsetree.Pexp_apply ( { pexp_desc = - Pexp_ident {txt = Longident.Lident operator; loc = operatorLoc}; + Pexp_ident {txt = Longident.Lident operator; loc = operator_loc}; }, [(_, _left); (_, _right)] ) - 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 <> [] + 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 <> [] | Pexp_construct ({txt = Lident "Function$"}, Some _) -> true | Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}) -> false - | Pexp_fun _ when ParsetreeViewer.isUnderscoreApplySugar rhs -> false + | Pexp_fun _ when ParsetreeViewer.is_underscore_apply_sugar rhs -> false | Pexp_fun _ | Pexp_newtype _ | Pexp_setfield _ | Pexp_constraint _ -> true - | _ when ParsetreeViewer.isTernaryExpr rhs -> true + | _ when ParsetreeViewer.is_ternary_expr rhs -> true | _ -> false -let binaryOperatorInsideAwaitNeedsParens operator = - ParsetreeViewer.operatorPrecedence operator - < ParsetreeViewer.operatorPrecedence "|." +let binary_operator_inside_await_needs_parens operator = + ParsetreeViewer.operator_precedence operator + < ParsetreeViewer.operator_precedence "|." -let lazyOrAssertOrAwaitExprRhs ?(inAwait = false) expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc +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 | None -> ( match expr with | {Parsetree.pexp_attributes = attrs} - when match ParsetreeViewer.filterParsingAttrs attrs with + when match ParsetreeViewer.filter_parsing_attrs attrs with | _ :: _ -> true | [] -> false -> Parenthesized @@ -207,8 +207,8 @@ let lazyOrAssertOrAwaitExprRhs ?(inAwait = false) expr = pexp_desc = Pexp_apply ({pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, _); } - when ParsetreeViewer.isBinaryExpression expr -> - if inAwait && not (binaryOperatorInsideAwaitNeedsParens operator) then + when ParsetreeViewer.is_binary_expression expr -> + if in_await && not (binary_operator_inside_await_needs_parens operator) then Nothing else Parenthesized | { @@ -216,7 +216,7 @@ let lazyOrAssertOrAwaitExprRhs ?(inAwait = false) expr = Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}); } -> Nothing - | {pexp_desc = Pexp_fun _} when ParsetreeViewer.isUnderscoreApplySugar expr + | {pexp_desc = Pexp_fun _} when ParsetreeViewer.is_underscore_apply_sugar expr -> Nothing | { @@ -227,42 +227,42 @@ let lazyOrAssertOrAwaitExprRhs ?(inAwait = false) expr = } -> Parenthesized | _ - when (not inAwait) - && ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> + when (not in_await) + && ParsetreeViewer.has_await_attribute expr.pexp_attributes -> Parenthesized | _ -> Nothing) -let isNegativeConstant constant = - let isNeg txt = +let is_negative_constant constant = + let is_neg 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 isNeg i -> true + | (Parsetree.Pconst_integer (i, _) | Pconst_float (i, _)) when is_neg i -> true | _ -> false -let fieldExpr expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc +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 | None -> ( match expr with | {Parsetree.pexp_attributes = attrs} - when match ParsetreeViewer.filterParsingAttrs attrs with + when match ParsetreeViewer.filter_parsing_attrs attrs with | _ :: _ -> true | [] -> false -> Parenthesized | expr - when ParsetreeViewer.isBinaryExpression expr - || ParsetreeViewer.isUnaryExpression expr -> + when ParsetreeViewer.is_binary_expression expr + || ParsetreeViewer.is_unary_expression expr -> Parenthesized | { pexp_desc = Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}); } -> Nothing - | {pexp_desc = Pexp_constant c} when isNegativeConstant c -> Parenthesized - | {pexp_desc = Pexp_fun _} when ParsetreeViewer.isUnderscoreApplySugar expr + | {pexp_desc = Pexp_constant c} when is_negative_constant c -> Parenthesized + | {pexp_desc = Pexp_fun _} when ParsetreeViewer.is_underscore_apply_sugar expr -> Nothing | { @@ -274,14 +274,14 @@ let fieldExpr expr = | Pexp_ifthenelse _ ); } -> Parenthesized - | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> + | _ when ParsetreeViewer.has_await_attribute expr.pexp_attributes -> Parenthesized | _ -> Nothing) -let setFieldExprRhs expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc +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 | None -> ( match expr with | { @@ -292,10 +292,10 @@ let setFieldExprRhs expr = | {pexp_desc = Pexp_constraint _} -> Parenthesized | _ -> Nothing) -let ternaryOperand expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc +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 | None -> ( match expr with | { @@ -304,31 +304,31 @@ let ternaryOperand expr = } -> Nothing | {pexp_desc = Pexp_constraint _} -> Parenthesized - | _ when Res_parsetree_viewer.isFunNewtype expr -> ( - let _uncurried, _attrsOnArrow, _parameters, returnExpr = - ParsetreeViewer.funExpr expr + | _ when Res_parsetree_viewer.is_fun_newtype expr -> ( + let _uncurried, _attrsOnArrow, _parameters, return_expr = + ParsetreeViewer.fun_expr expr in - match returnExpr.pexp_desc with + match return_expr.pexp_desc with | Pexp_constraint _ -> Parenthesized | _ -> Nothing) | _ -> Nothing) -let startsWithMinus txt = +let starts_with_minus txt = let len = String.length txt in if len == 0 then false else let s = (String.get [@doesNotRaise]) txt 0 in s = '-' -let jsxPropExpr expr = +let jsx_prop_expr expr = match expr.Parsetree.pexp_desc with | Parsetree.Pexp_let _ | Pexp_sequence _ | Pexp_letexception _ | Pexp_letmodule _ | Pexp_open _ -> Nothing | _ -> ( - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc + let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in + match opt_braces with + | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc | None -> ( match expr with | { @@ -336,9 +336,9 @@ let jsxPropExpr expr = Pexp_constant (Pconst_integer (x, _) | Pconst_float (x, _)); pexp_attributes = []; } - when startsWithMinus x -> + when starts_with_minus x -> Parenthesized - | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> + | _ when ParsetreeViewer.has_await_attribute expr.pexp_attributes -> Parenthesized | { Parsetree.pexp_desc = @@ -358,15 +358,15 @@ let jsxPropExpr expr = Nothing | _ -> Parenthesized)) -let jsxChildExpr expr = +let jsx_child_expr expr = match expr.Parsetree.pexp_desc with | Parsetree.Pexp_let _ | Pexp_sequence _ | Pexp_letexception _ | Pexp_letmodule _ | Pexp_open _ -> Nothing | _ -> ( - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc + let opt_braces, _ = ParsetreeViewer.process_braces_attr expr in + match opt_braces with + | Some ({Location.loc = braces_loc}, _) -> Braced braces_loc | _ -> ( match expr with | { @@ -374,9 +374,9 @@ let jsxChildExpr expr = Pexp_constant (Pconst_integer (x, _) | Pconst_float (x, _)); pexp_attributes = []; } - when startsWithMinus x -> + when starts_with_minus x -> Parenthesized - | _ when ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes -> + | _ when ParsetreeViewer.has_await_attribute expr.pexp_attributes -> Parenthesized | { Parsetree.pexp_desc = @@ -394,22 +394,22 @@ let jsxChildExpr expr = pexp_attributes = []; } -> Nothing - | expr when ParsetreeViewer.isJsxExpression expr -> Nothing + | expr when ParsetreeViewer.is_jsx_expression expr -> Nothing | _ -> Parenthesized)) -let binaryExpr expr = - let optBraces, _ = ParsetreeViewer.processBracesAttr expr in - match optBraces with - | Some ({Location.loc = bracesLoc}, _) -> Braced bracesLoc +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 | None -> ( match expr with | {Parsetree.pexp_attributes = _ :: _} as expr - when ParsetreeViewer.isBinaryExpression expr -> + when ParsetreeViewer.is_binary_expression expr -> Parenthesized | _ -> Nothing) -let modTypeFunctorReturn modType = - match modType with +let mod_type_functor_return mod_type = + match mod_type with | {Parsetree.pmty_desc = Pmty_with _} -> true | _ -> false @@ -418,35 +418,35 @@ let modTypeFunctorReturn modType = This is actually: module type Functor = (SetLike => Set) with type t = A.t *) -let modTypeWithOperand modType = - match modType with +let mod_type_with_operand mod_type = + match mod_type with | {Parsetree.pmty_desc = Pmty_functor _ | Pmty_with _} -> true | _ -> false -let modExprFunctorConstraint modType = - match modType with +let mod_expr_functor_constraint mod_type = + match mod_type with | {Parsetree.pmty_desc = Pmty_functor _ | Pmty_with _} -> true | _ -> false -let bracedExpr expr = +let braced_expr expr = match expr.Parsetree.pexp_desc with | Pexp_constraint ({pexp_desc = Pexp_pack _}, {ptyp_desc = Ptyp_package _}) -> false | Pexp_constraint _ -> true | _ -> false -let includeModExpr modExpr = - match modExpr.Parsetree.pmod_desc with +let include_mod_expr mod_expr = + match mod_expr.Parsetree.pmod_desc with | Parsetree.Pmod_constraint _ -> true | _ -> false -let arrowReturnTypExpr typExpr = - match typExpr.Parsetree.ptyp_desc with +let arrow_return_typ_expr typ_expr = + match typ_expr.Parsetree.ptyp_desc with | Parsetree.Ptyp_arrow _ -> true - | _ when Ast_uncurried.coreTypeIsUncurriedFun typExpr -> true + | _ when Ast_uncurried.core_type_is_uncurried_fun typ_expr -> true | _ -> false -let patternRecordRowRhs (pattern : Parsetree.pattern) = +let pattern_record_row_rhs (pattern : Parsetree.pattern) = match pattern.ppat_desc with | Ppat_constraint ({ppat_desc = Ppat_unpack _}, {ptyp_desc = Ptyp_package _}) -> diff --git a/jscomp/syntax/src/res_parens.mli b/jscomp/syntax/src/res_parens.mli index 9b60b815f1..e36d4f9307 100644 --- a/jscomp/syntax/src/res_parens.mli +++ b/jscomp/syntax/src/res_parens.mli @@ -1,39 +1,39 @@ type kind = Parenthesized | Braced of Location.t | Nothing val expr : Parsetree.expression -> kind -val structureExpr : Parsetree.expression -> kind +val structure_expr : Parsetree.expression -> kind -val unaryExprOperand : Parsetree.expression -> kind +val unary_expr_operand : Parsetree.expression -> kind -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_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 binaryOperatorInsideAwaitNeedsParens : string -> bool -val lazyOrAssertOrAwaitExprRhs : ?inAwait:bool -> Parsetree.expression -> kind +val binary_operator_inside_await_needs_parens : string -> bool +val lazy_or_assert_or_await_expr_rhs : ?in_await:bool -> Parsetree.expression -> kind -val fieldExpr : Parsetree.expression -> kind +val field_expr : Parsetree.expression -> kind -val setFieldExprRhs : Parsetree.expression -> kind +val set_field_expr_rhs : Parsetree.expression -> kind -val ternaryOperand : Parsetree.expression -> kind +val ternary_operand : Parsetree.expression -> kind -val jsxPropExpr : Parsetree.expression -> kind -val jsxChildExpr : Parsetree.expression -> kind +val jsx_prop_expr : Parsetree.expression -> kind +val jsx_child_expr : Parsetree.expression -> kind -val binaryExpr : Parsetree.expression -> kind -val modTypeFunctorReturn : Parsetree.module_type -> bool -val modTypeWithOperand : Parsetree.module_type -> bool -val modExprFunctorConstraint : Parsetree.module_type -> bool +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 bracedExpr : Parsetree.expression -> bool -val callExpr : Parsetree.expression -> kind +val braced_expr : Parsetree.expression -> bool +val call_expr : Parsetree.expression -> kind -val includeModExpr : Parsetree.module_expr -> bool +val include_mod_expr : Parsetree.module_expr -> bool -val arrowReturnTypExpr : Parsetree.core_type -> bool +val arrow_return_typ_expr : Parsetree.core_type -> bool -val patternRecordRowRhs : Parsetree.pattern -> bool +val pattern_record_row_rhs : Parsetree.pattern -> bool -val exprRecordRowRhs : Parsetree.expression -> kind +val expr_record_row_rhs : Parsetree.expression -> kind diff --git a/jscomp/syntax/src/res_parser.ml b/jscomp/syntax/src/res_parser.ml index ca39cfcf84..5bc64365f1 100644 --- a/jscomp/syntax/src/res_parser.ml +++ b/jscomp/syntax/src/res_parser.ml @@ -8,54 +8,54 @@ module Comment = Res_comment type mode = ParseForTypeChecker | Default -type regionStatus = Report | Silent +type region_status = Report | Silent type t = { mode: mode; mutable scanner: Scanner.t; mutable token: Token.t; - mutable startPos: Lexing.position; - mutable endPos: Lexing.position; - mutable prevEndPos: Lexing.position; + mutable start_pos: Lexing.position; + mutable end_pos: Lexing.position; + mutable prev_end_pos: Lexing.position; mutable breadcrumbs: (Grammar.t * Lexing.position) list; - mutable errors: Reporting.parseError list; + mutable errors: Reporting.parse_error list; mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; - mutable regions: regionStatus ref list; + mutable regions: region_status ref list; mutable uncurried_config: Config.uncurried; } -let err ?startPos ?endPos p error = +let err ?start_pos ?end_pos p error = match p.regions with | ({contents = Report} as region) :: _ -> let d = Diagnostics.make - ~startPos: - (match startPos with + ~start_pos: + (match start_pos with | Some pos -> pos - | None -> p.startPos) - ~endPos: - (match endPos with + | None -> p.start_pos) + ~end_pos: + (match end_pos with | Some pos -> pos - | None -> p.endPos) + | None -> p.end_pos) error in p.diagnostics <- d :: p.diagnostics; region := Silent | _ -> () -let beginRegion p = p.regions <- ref Report :: p.regions -let endRegion p = +let begin_region p = p.regions <- ref Report :: p.regions +let end_region p = match p.regions with | [] -> () | _ :: rest -> p.regions <- rest -let docCommentToAttributeToken comment = +let doc_comment_to_attribute_token comment = let txt = Comment.txt comment in let loc = Comment.loc comment in Token.DocComment (loc, txt) -let moduleCommentToAttributeToken comment = +let module_comment_to_attribute_token comment = let txt = Comment.txt comment in let loc = Comment.loc comment in Token.ModuleComment (loc, txt) @@ -63,60 +63,60 @@ let moduleCommentToAttributeToken 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 ?prevEndPos p = +let rec next ?prev_end_pos p = if p.token = Eof then assert false; - let prevEndPos = - match prevEndPos with + let prev_end_pos = + match prev_end_pos with | Some pos -> pos - | None -> p.endPos + | None -> p.end_pos in - let startPos, endPos, token = Scanner.scan p.scanner in + let start_pos, end_pos, token = Scanner.scan p.scanner in match token with | Comment c -> - 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) + 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) else ( - Comment.setPrevTokEndPos c p.endPos; + Comment.set_prev_tok_end_pos c p.end_pos; p.comments <- c :: p.comments; - p.prevEndPos <- p.endPos; - p.endPos <- endPos; - next ~prevEndPos p) + p.prev_end_pos <- p.end_pos; + p.end_pos <- end_pos; + next ~prev_end_pos p) | _ -> p.token <- token; - p.prevEndPos <- prevEndPos; - p.startPos <- startPos; - p.endPos <- endPos + p.prev_end_pos <- prev_end_pos; + p.start_pos <- start_pos; + p.end_pos <- end_pos -let nextUnsafe p = if p.token <> Eof then next p +let next_unsafe p = if p.token <> Eof then next p -let nextTemplateLiteralToken p = - let startPos, endPos, token = Scanner.scanTemplateLiteralToken p.scanner in +let next_template_literal_token p = + let start_pos, end_pos, token = Scanner.scan_template_literal_token p.scanner in p.token <- token; - p.prevEndPos <- p.endPos; - p.startPos <- startPos; - p.endPos <- endPos + p.prev_end_pos <- p.end_pos; + p.start_pos <- start_pos; + p.end_pos <- end_pos -let checkProgress ~prevEndPos ~result p = - if p.endPos == prevEndPos then None else Some result +let check_progress ~prev_end_pos ~result p = + if p.end_pos == prev_end_pos then None else Some result let make ?(mode = ParseForTypeChecker) src filename = let scanner = Scanner.make ~filename src in - let parserState = + let parser_state = { mode; scanner; token = Token.Semicolon; - startPos = Lexing.dummy_pos; - prevEndPos = Lexing.dummy_pos; - endPos = Lexing.dummy_pos; + start_pos = Lexing.dummy_pos; + prev_end_pos = Lexing.dummy_pos; + end_pos = Lexing.dummy_pos; breadcrumbs = []; errors = []; diagnostics = []; @@ -125,18 +125,18 @@ let make ?(mode = ParseForTypeChecker) src filename = uncurried_config = !Config.uncurried; } 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 + 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 p.breadcrumbs <- crumb :: p.breadcrumbs -let eatBreadcrumb p = +let eat_breadcrumb p = match p.breadcrumbs with | [] -> () | _ :: crumbs -> p.breadcrumbs <- crumbs @@ -150,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.prevEndPos token in - err ~startPos:p.prevEndPos p error + let error = Diagnostics.expected ?grammar p.prev_end_pos token in + err ~start_pos:p.prev_end_pos p error (* Don't use immutable copies here, it trashes certain heuristics * in the ocaml compiler, resulting in massive slowdowns of the parser *) @@ -160,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 lineOffset = p.scanner.lineOffset in + let line_offset = p.scanner.line_offset in let lnum = p.scanner.lnum in let mode = p.scanner.mode in let token = p.token in - let startPos = p.startPos in - let endPos = p.endPos in - let prevEndPos = p.prevEndPos 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 breadcrumbs = p.breadcrumbs in let errors = p.errors in let diagnostics = p.diagnostics in @@ -179,13 +179,13 @@ let lookahead p callback = p.scanner.ch <- ch; p.scanner.offset <- offset; p.scanner.offset16 <- offset16; - p.scanner.lineOffset <- lineOffset; + p.scanner.line_offset <- line_offset; p.scanner.lnum <- lnum; p.scanner.mode <- mode; p.token <- token; - p.startPos <- startPos; - p.endPos <- endPos; - p.prevEndPos <- prevEndPos; + p.start_pos <- start_pos; + p.end_pos <- end_pos; + p.prev_end_pos <- prev_end_pos; p.breadcrumbs <- breadcrumbs; p.errors <- errors; p.diagnostics <- diagnostics; diff --git a/jscomp/syntax/src/res_parser.mli b/jscomp/syntax/src/res_parser.mli index 9544a7cc28..9e1c73381e 100644 --- a/jscomp/syntax/src/res_parser.mli +++ b/jscomp/syntax/src/res_parser.mli @@ -7,20 +7,20 @@ module Comment = Res_comment type mode = ParseForTypeChecker | Default -type regionStatus = Report | Silent +type region_status = Report | Silent type t = { mode: mode; mutable scanner: Scanner.t; mutable token: Token.t; - mutable startPos: Lexing.position; - mutable endPos: Lexing.position; - mutable prevEndPos: Lexing.position; + mutable start_pos: Lexing.position; + mutable end_pos: Lexing.position; + mutable prev_end_pos: Lexing.position; mutable breadcrumbs: (Grammar.t * Lexing.position) list; - mutable errors: Reporting.parseError list; + mutable errors: Reporting.parse_error list; mutable diagnostics: Diagnostics.t list; mutable comments: Comment.t list; - mutable regions: regionStatus ref list; + mutable regions: region_status 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 : ?prevEndPos:Lexing.position -> t -> unit -val nextUnsafe : t -> unit (* Does not assert on Eof, makes no progress *) -val nextTemplateLiteralToken : t -> unit +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 lookahead : t -> (t -> 'a) -> 'a val err : - ?startPos:Lexing.position -> - ?endPos:Lexing.position -> + ?start_pos:Lexing.position -> + ?end_pos:Lexing.position -> t -> Diagnostics.category -> unit -val leaveBreadcrumb : t -> Grammar.t -> unit -val eatBreadcrumb : t -> unit +val leave_breadcrumb : t -> Grammar.t -> unit +val eat_breadcrumb : t -> unit -val beginRegion : t -> unit -val endRegion : t -> unit +val begin_region : t -> unit +val end_region : t -> unit -val checkProgress : prevEndPos:Lexing.position -> result:'a -> t -> 'a option +val check_progress : prev_end_pos:Lexing.position -> result:'a -> t -> 'a option diff --git a/jscomp/syntax/src/res_parsetree_viewer.ml b/jscomp/syntax/src/res_parsetree_viewer.ml index a4c2ffdad4..fd0741c156 100644 --- a/jscomp/syntax/src/res_parsetree_viewer.ml +++ b/jscomp/syntax/src/res_parsetree_viewer.ml @@ -1,33 +1,33 @@ open Parsetree -let arrowType ?(arity = max_int) ct = - let rec process attrsBefore acc typ arity = +let arrow_type ?(arity = max_int) ct = + let rec process attrs_before acc typ arity = match typ with - | typ when arity <= 0 -> (attrsBefore, List.rev acc, typ) + | typ when arity <= 0 -> (attrs_before, List.rev acc, typ) | { ptyp_desc = Ptyp_arrow ((Nolabel as lbl), typ1, typ2); ptyp_attributes = []; } -> let arg = ([], lbl, typ1) in - process attrsBefore (arg :: acc) typ2 (arity - 1) + process attrs_before (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)` *) - (attrsBefore, List.rev acc, typ) + (attrs_before, List.rev acc, typ) | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = _attrs} - as returnType -> + as return_type -> let args = List.rev acc in - (attrsBefore, args, returnType) + (attrs_before, args, return_type) | { ptyp_desc = Ptyp_arrow (((Labelled _ | Optional _) as lbl), typ1, typ2); ptyp_attributes = attrs; } -> let arg = (attrs, lbl, typ1) in - process attrsBefore (arg :: acc) typ2 (arity - 1) - | typ -> (attrsBefore, List.rev acc, typ) + process attrs_before (arg :: acc) typ2 (arity - 1) + | typ -> (attrs_before, List.rev acc, typ) in match ct with | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as @@ -35,32 +35,32 @@ let arrowType ?(arity = max_int) ct = process attrs [] {typ with ptyp_attributes = []} arity | typ -> process [] [] typ arity -let functorType modtype = +let functor_type modtype = let rec process acc modtype = match modtype with | { - pmty_desc = Pmty_functor (lbl, argType, returnType); + pmty_desc = Pmty_functor (lbl, arg_type, return_type); pmty_attributes = attrs; } -> - let arg = (attrs, lbl, argType) in - process (arg :: acc) returnType - | modType -> (List.rev acc, modType) + let arg = (attrs, lbl, arg_type) in + process (arg :: acc) return_type + | mod_type -> (List.rev acc, mod_type) in process [] modtype -let processBsAttribute attrs = - let rec process bsSpotted acc attrs = +let process_bs_attribute attrs = + let rec process bs_spotted acc attrs = match attrs with - | [] -> (bsSpotted, List.rev acc) + | [] -> (bs_spotted, List.rev acc) | ({Location.txt = "bs"}, _) :: rest -> process true acc rest - | attr :: rest -> process bsSpotted (attr :: acc) rest + | attr :: rest -> process bs_spotted (attr :: acc) rest in process false [] attrs -let processUncurriedAppAttribute attrs = - let rec process uncurriedApp acc attrs = +let process_uncurried_app_attribute attrs = + let rec process uncurried_app acc attrs = match attrs with - | [] -> (uncurriedApp, List.rev acc) + | [] -> (uncurried_app, List.rev acc) | ( { Location.txt = "bs" (* still support @bs to convert .ml files *) | "res.uapp"; @@ -68,26 +68,26 @@ let processUncurriedAppAttribute attrs = _ ) :: rest -> process true acc rest - | attr :: rest -> process uncurriedApp (attr :: acc) rest + | attr :: rest -> process uncurried_app (attr :: acc) rest in process false [] attrs -let processPartialAppAttribute attrs = - let rec process partialApp acc attrs = +let process_partial_app_attribute attrs = + let rec process partial_app acc attrs = match attrs with - | [] -> (partialApp, List.rev acc) + | [] -> (partial_app, List.rev acc) | ({Location.txt = "res.partial"}, _) :: rest -> process true acc rest - | attr :: rest -> process partialApp (attr :: acc) rest + | attr :: rest -> process partial_app (attr :: acc) rest in process false [] attrs -type functionAttributesInfo = { +type function_attributes_info = { async: bool; bs: bool; attributes: Parsetree.attributes; } -let processFunctionAttributes attrs = +let process_function_attributes attrs = let rec process async bs acc attrs = match attrs with | [] -> {async; bs; attributes = List.rev acc} @@ -97,19 +97,19 @@ let processFunctionAttributes attrs = in process false false [] attrs -let hasAwaitAttribute attrs = +let has_await_attribute attrs = List.exists (function | {Location.txt = "res.await"}, _ -> true | _ -> false) attrs -let collectArrayExpressions expr = +let collect_array_expressions expr = match expr.pexp_desc with | Pexp_array exprs -> (exprs, None) | _ -> ([], Some expr) -let collectListExpressions expr = +let collect_list_expressions expr = let rec collect acc expr = match expr.pexp_desc with | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> (List.rev acc, None) @@ -122,10 +122,10 @@ let collectListExpressions expr = collect [] expr (* (__x) => f(a, __x, c) -----> f(a, _, c) *) -let rewriteUnderscoreApply expr = +let rewrite_underscore_apply expr = let expr_fun = - if Ast_uncurried.exprIsUncurriedFun expr then - Ast_uncurried.exprExtractUncurriedFun expr + if Ast_uncurried.expr_is_uncurried_fun expr then + Ast_uncurried.expr_extract_uncurried_fun expr else expr in match expr_fun.pexp_desc with @@ -133,44 +133,44 @@ let rewriteUnderscoreApply expr = ( Nolabel, None, {ppat_desc = Ppat_var {txt = "__x"}}, - ({pexp_desc = Pexp_apply (callExpr, args)} as e) ) -> - let newArgs = + ({pexp_desc = Pexp_apply (call_expr, args)} as e) ) -> + let new_args = List.map (fun arg -> match arg with | ( lbl, ({pexp_desc = Pexp_ident ({txt = Longident.Lident "__x"} as lid)} - as argExpr) ) -> + as arg_expr) ) -> ( lbl, { - argExpr with + arg_expr with pexp_desc = Pexp_ident {lid with txt = Longident.Lident "_"}; } ) | arg -> arg) args in - {e with pexp_desc = Pexp_apply (callExpr, newArgs)} + {e with pexp_desc = Pexp_apply (call_expr, new_args)} | _ -> expr -type funParamKind = +type fun_param_kind = | Parameter of { attrs: Parsetree.attributes; lbl: Asttypes.arg_label; - defaultExpr: Parsetree.expression option; + default_expr: Parsetree.expression option; pat: Parsetree.pattern; } | NewTypes of {attrs: Parsetree.attributes; locs: string Asttypes.loc list} -let funExpr expr = +let fun_expr expr = (* Turns (type t, type u, type z) into "type t u z" *) - let rec collectNewTypes acc returnExpr = - match returnExpr with - | {pexp_desc = Pexp_newtype (stringLoc, returnExpr); pexp_attributes = []} + let rec collect_new_types acc return_expr = + match return_expr with + | {pexp_desc = Pexp_newtype (string_loc, return_expr); pexp_attributes = []} -> - collectNewTypes (stringLoc :: acc) returnExpr - | returnExpr -> (List.rev acc, returnExpr) + collect_new_types (string_loc :: acc) return_expr + | return_expr -> (List.rev acc, return_expr) in - let rec collect ~uncurried ~nFun attrsBefore acc expr = + let rec collect ~uncurried ~n_fun attrs_before acc expr = match expr with | { pexp_desc = @@ -180,43 +180,43 @@ let funExpr expr = {ppat_desc = Ppat_var {txt = "__x"}}, {pexp_desc = Pexp_apply _} ); } -> - (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 + (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 | { - pexp_desc = Pexp_fun (lbl, defaultExpr, pattern, returnExpr); + pexp_desc = Pexp_fun (lbl, default_expr, pattern, return_expr); pexp_attributes = []; } -> - let parameter = Parameter {attrs = []; lbl; defaultExpr; pat = pattern} in - collect ~uncurried ~nFun:(nFun + 1) attrsBefore (parameter :: acc) - returnExpr + let parameter = Parameter {attrs = []; lbl; default_expr; pat = pattern} in + collect ~uncurried ~n_fun:(n_fun + 1) attrs_before (parameter :: acc) + return_expr (* 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, 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) + | {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) in match expr with | {pexp_desc = Pexp_fun _ | Pexp_newtype _} -> - collect ~uncurried:false ~nFun:0 expr.pexp_attributes [] + collect ~uncurried:false ~n_fun:0 expr.pexp_attributes [] {expr with pexp_attributes = []} - | _ when Ast_uncurried.exprIsUncurriedFun expr -> - let expr = Ast_uncurried.exprExtractUncurriedFun expr in - collect ~uncurried:true ~nFun:0 expr.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 [] {expr with pexp_attributes = []} - | _ -> collect ~uncurried:false ~nFun:0 [] [] expr + | _ -> collect ~uncurried:false ~n_fun:0 [] [] expr -let processBracesAttr expr = +let process_braces_attr expr = match expr.pexp_attributes with | (({txt = "res.braces" | "ns.braces"}, _) as attr) :: attrs -> (Some attr, {expr with pexp_attributes = attrs}) | _ -> (None, expr) -let filterParsingAttrs attrs = +let filter_parsing_attrs attrs = List.filter (fun attr -> match attr with @@ -232,19 +232,19 @@ let filterParsingAttrs attrs = | _ -> true) attrs -let isBlockExpr expr = +let is_block_expr expr = match expr.pexp_desc with | Pexp_letmodule _ | Pexp_letexception _ | Pexp_let _ | Pexp_open _ | Pexp_sequence _ -> true | _ -> false -let isBracedExpr expr = - match processBracesAttr expr with +let is_braced_expr expr = + match process_braces_attr expr with | Some _, _ -> true | _ -> false -let isMultilineText txt = +let is_multiline_text txt = let len = String.length txt in let rec check i = if i >= len then false @@ -257,7 +257,7 @@ let isMultilineText txt = in check 0 -let isHuggableExpression expr = +let is_huggable_expression expr = match expr.pexp_desc with | Pexp_array _ | Pexp_tuple _ | Pexp_constant (Pconst_string (_, Some _)) @@ -265,28 +265,28 @@ let isHuggableExpression expr = | Pexp_extension ({txt = "obj"}, _) | Pexp_record _ -> true - | _ when isBlockExpr expr -> true - | _ when isBracedExpr expr -> true - | Pexp_constant (Pconst_string (txt, None)) when isMultilineText txt -> 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 | _ -> false -let isHuggableRhs expr = +let is_huggable_rhs expr = match expr.pexp_desc with | Pexp_array _ | Pexp_tuple _ | Pexp_extension ({txt = "obj"}, _) | Pexp_record _ -> true - | _ when isBracedExpr expr -> true + | _ when is_braced_expr expr -> true | _ -> false -let isHuggablePattern pattern = +let is_huggable_pattern pattern = match pattern.ppat_desc with | Ppat_array _ | Ppat_tuple _ | Ppat_record _ | Ppat_variant _ | Ppat_construct _ -> true | _ -> false -let operatorPrecedence operator = +let operator_precedence operator = match operator with | ":=" -> 1 | "||" -> 2 @@ -298,22 +298,22 @@ let operatorPrecedence operator = | "#" | "##" | "|." | "|.u" -> 8 | _ -> 0 -let isUnaryOperator operator = +let is_unary_operator operator = match operator with | "~+" | "~+." | "~-" | "~-." | "not" -> true | _ -> false -let isUnaryExpression expr = +let is_unary_expression expr = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, _arg)] ) - when isUnaryOperator operator -> + when is_unary_operator operator -> true | _ -> false (* TODO: tweak this to check for ghost ^ as template literal *) -let isBinaryOperator operator = +let is_binary_operator operator = match operator with | ":=" | "||" | "&&" | "=" | "==" | "<" | ">" | "!=" | "!==" | "<=" | ">=" | "|>" | "+" | "+." | "-" | "-." | "^" | "*" | "*." | "/" | "/." | "**" | "|." @@ -321,57 +321,57 @@ let isBinaryOperator operator = true | _ -> false -let isBinaryExpression expr = +let is_binary_expression expr = match expr.pexp_desc with | Pexp_apply ( { pexp_desc = - Pexp_ident {txt = Longident.Lident operator; loc = operatorLoc}; + Pexp_ident {txt = Longident.Lident operator; loc = operator_loc}; }, [(Nolabel, _operand1); (Nolabel, _operand2)] ) - when isBinaryOperator operator - && not (operatorLoc.loc_ghost && operator = "^") + when is_binary_operator operator + && not (operator_loc.loc_ghost && operator = "^") (* template literal *) -> true | _ -> false -let isEqualityOperator operator = +let is_equality_operator operator = match operator with | "=" | "==" | "<>" | "!=" -> true | _ -> false -let isRhsBinaryOperator operator = +let is_rhs_binary_operator operator = match operator with | "**" -> true | _ -> false -let flattenableOperators parentOperator childOperator = - let precParent = operatorPrecedence parentOperator in - let precChild = operatorPrecedence childOperator in - if precParent == precChild then - not (isEqualityOperator parentOperator && isEqualityOperator childOperator) +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) else false -let rec hasIfLetAttribute attrs = +let rec has_if_let_attribute attrs = match attrs with | [] -> false | ({Location.txt = "res.iflet"}, _) :: _ -> true - | _ :: attrs -> hasIfLetAttribute attrs + | _ :: attrs -> has_if_let_attribute attrs -let isIfLetExpr expr = +let is_if_let_expr expr = match expr with | {pexp_attributes = attrs; pexp_desc = Pexp_match _} - when hasIfLetAttribute attrs -> + when has_if_let_attribute attrs -> true | _ -> false -let rec hasOptionalAttribute attrs = +let rec has_optional_attribute attrs = match attrs with | [] -> false | ({Location.txt = "ns.optional" | "res.optional"}, _) :: _ -> true - | _ :: attrs -> hasOptionalAttribute attrs + | _ :: attrs -> has_optional_attribute attrs -let hasAttributes attrs = +let has_attributes attrs = List.exists (fun attr -> match attr with @@ -393,11 +393,11 @@ let hasAttributes attrs = ({pexp_desc = Pexp_constant (Pconst_string ("-4", None))}, _); }; ] ) -> - not (hasIfLetAttribute attrs) + not (has_if_let_attribute attrs) | _ -> true) attrs -let isArrayAccess expr = +let is_array_access expr = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}}, @@ -405,79 +405,79 @@ let isArrayAccess expr = true | _ -> false -type ifConditionKind = +type if_condition_kind = | If of Parsetree.expression | IfLet of Parsetree.pattern * Parsetree.expression -let collectIfExpressions expr = +let collect_if_expressions expr = let rec collect acc expr = - let exprLoc = expr.pexp_loc in + let expr_loc = expr.pexp_loc in match expr.pexp_desc with - | 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_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_match ( condition, [ - {pc_lhs = pattern; pc_guard = None; pc_rhs = thenExpr}; + {pc_lhs = pattern; pc_guard = None; pc_rhs = then_expr}; { pc_rhs = {pexp_desc = Pexp_construct ({txt = Longident.Lident "()"}, _)}; }; ] ) - when isIfLetExpr expr -> + when is_if_let_expr expr -> let ifs = - List.rev ((exprLoc, IfLet (pattern, condition), thenExpr) :: acc) + List.rev ((expr_loc, IfLet (pattern, condition), then_expr) :: acc) in (ifs, None) | Pexp_match ( condition, [ - {pc_lhs = pattern; pc_guard = None; pc_rhs = thenExpr}; - {pc_rhs = elseExpr}; + {pc_lhs = pattern; pc_guard = None; pc_rhs = then_expr}; + {pc_rhs = else_expr}; ] ) - when isIfLetExpr expr -> - collect ((exprLoc, IfLet (pattern, condition), thenExpr) :: acc) elseExpr + when is_if_let_expr expr -> + collect ((expr_loc, IfLet (pattern, condition), then_expr) :: acc) else_expr | _ -> (List.rev acc, Some expr) in collect [] expr -let rec hasTernaryAttribute attrs = +let rec has_ternary_attribute attrs = match attrs with | [] -> false | ({Location.txt = "res.ternary"}, _) :: _ -> true - | _ :: attrs -> hasTernaryAttribute attrs + | _ :: attrs -> has_ternary_attribute attrs -let isTernaryExpr expr = +let is_ternary_expr expr = match expr with | {pexp_attributes = attrs; pexp_desc = Pexp_ifthenelse _} - when hasTernaryAttribute attrs -> + when has_ternary_attribute attrs -> true | _ -> false -let collectTernaryParts expr = +let collect_ternary_parts expr = let rec collect acc expr = match expr with | { pexp_attributes = attrs; pexp_desc = Pexp_ifthenelse (condition, consequent, Some alternate); } - when hasTernaryAttribute attrs -> + when has_ternary_attribute attrs -> collect ((condition, consequent) :: acc) alternate | alternate -> (List.rev acc, alternate) in collect [] expr -let parametersShouldHug parameters = +let parameters_should_hug parameters = match parameters with - | [Parameter {attrs = []; lbl = Asttypes.Nolabel; defaultExpr = None; pat}] - when isHuggablePattern pat -> + | [Parameter {attrs = []; lbl = Asttypes.Nolabel; default_expr = None; pat}] + when is_huggable_pattern pat -> true | _ -> false -let filterTernaryAttributes attrs = +let filter_ternary_attributes attrs = List.filter (fun attr -> match attr with @@ -485,7 +485,7 @@ let filterTernaryAttributes attrs = | _ -> true) attrs -let filterFragileMatchAttributes attrs = +let filter_fragile_match_attributes attrs = List.filter (fun attr -> match attr with @@ -502,7 +502,7 @@ let filterFragileMatchAttributes attrs = | _ -> true) attrs -let isJsxExpression expr = +let is_jsx_expression expr = let rec loop attrs = match attrs with | [] -> false @@ -513,7 +513,7 @@ let isJsxExpression expr = | Pexp_apply _ -> loop expr.Parsetree.pexp_attributes | _ -> false -let hasJsxAttribute attributes = +let has_jsx_attribute attributes = let rec loop attrs = match attrs with | [] -> false @@ -522,17 +522,17 @@ let hasJsxAttribute attributes = in loop attributes -let shouldIndentBinaryExpr expr = - let samePrecedenceSubExpression operator subExpression = - match subExpression with +let should_indent_binary_expr expr = + let same_precedence_sub_expression operator sub_expression = + match sub_expression with | { pexp_desc = Pexp_apply - ( {pexp_desc = Pexp_ident {txt = Longident.Lident subOperator}}, + ( {pexp_desc = Pexp_ident {txt = Longident.Lident sub_operator}}, [(Nolabel, _lhs); (Nolabel, _rhs)] ); } - when isBinaryOperator subOperator -> - flattenableOperators operator subOperator + when is_binary_operator sub_operator -> + flattenable_operators operator sub_operator | _ -> true in match expr with @@ -542,13 +542,13 @@ let shouldIndentBinaryExpr expr = ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, lhs); (Nolabel, _rhs)] ); } - when isBinaryOperator operator -> - isEqualityOperator operator - || (not (samePrecedenceSubExpression operator lhs)) + when is_binary_operator operator -> + is_equality_operator operator + || (not (same_precedence_sub_expression operator lhs)) || operator = ":=" | _ -> false -let shouldInlineRhsBinaryExpr rhs = +let should_inline_rhs_binary_expr rhs = match rhs.pexp_desc with | Parsetree.Pexp_constant _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_sequence _ | Pexp_open _ | Pexp_ifthenelse _ @@ -556,7 +556,7 @@ let shouldInlineRhsBinaryExpr rhs = true | _ -> false -let isPrintableAttribute attr = +let is_printable_attribute attr = match attr with | ( { Location.txt = @@ -568,71 +568,71 @@ let isPrintableAttribute attr = false | _ -> true -let hasPrintableAttributes attrs = List.exists isPrintableAttribute attrs +let has_printable_attributes attrs = List.exists is_printable_attribute attrs -let filterPrintableAttributes attrs = List.filter isPrintableAttribute attrs +let filter_printable_attributes attrs = List.filter is_printable_attribute attrs -let partitionPrintableAttributes attrs = - List.partition isPrintableAttribute attrs +let partition_printable_attributes attrs = + List.partition is_printable_attribute attrs -let isFunNewtype expr = +let is_fun_newtype expr = match expr.pexp_desc with | Pexp_fun _ | Pexp_newtype _ -> true - | _ -> Ast_uncurried.exprIsUncurriedFun expr + | _ -> Ast_uncurried.expr_is_uncurried_fun expr -let requiresSpecialCallbackPrintingLastArg args = +let requires_special_callback_printing_last_arg args = let rec loop args = match args with | [] -> false - | [(_, expr)] when isFunNewtype expr -> true - | (_, expr) :: _ when isFunNewtype expr -> false + | [(_, expr)] when is_fun_newtype expr -> true + | (_, expr) :: _ when is_fun_newtype expr -> false | _ :: rest -> loop rest in loop args -let requiresSpecialCallbackPrintingFirstArg args = +let requires_special_callback_printing_first_arg args = let rec loop args = match args with | [] -> true - | (_, expr) :: _ when isFunNewtype expr -> false + | (_, expr) :: _ when is_fun_newtype expr -> false | _ :: rest -> loop rest in match args with - | [(_, expr)] when isFunNewtype expr -> false - | (_, expr) :: rest when isFunNewtype expr -> loop rest + | [(_, expr)] when is_fun_newtype expr -> false + | (_, expr) :: rest when is_fun_newtype expr -> loop rest | _ -> false -let modExprApply modExpr = - let rec loop acc modExpr = - match modExpr with +let mod_expr_apply mod_expr = + let rec loop acc mod_expr = + match mod_expr with | {pmod_desc = Pmod_apply (next, arg)} -> loop (arg :: acc) next - | _ -> (acc, modExpr) + | _ -> (acc, mod_expr) in - loop [] modExpr + loop [] mod_expr -let modExprFunctor modExpr = - let rec loop acc modExpr = - match modExpr with +let mod_expr_functor mod_expr = + let rec loop acc mod_expr = + match mod_expr with | { - pmod_desc = Pmod_functor (lbl, modType, returnModExpr); + pmod_desc = Pmod_functor (lbl, mod_type, return_mod_expr); pmod_attributes = attrs; } -> - let param = (attrs, lbl, modType) in - loop (param :: acc) returnModExpr - | returnModExpr -> (List.rev acc, returnModExpr) + let param = (attrs, lbl, mod_type) in + loop (param :: acc) return_mod_expr + | return_mod_expr -> (List.rev acc, return_mod_expr) in - loop [] modExpr + loop [] mod_expr -let rec collectPatternsFromListConstruct acc pattern = +let rec collect_patterns_from_list_construct acc pattern = let open Parsetree in match pattern.ppat_desc with | Ppat_construct ({txt = Longident.Lident "::"}, Some {ppat_desc = Ppat_tuple [pat; rest]}) -> - collectPatternsFromListConstruct (pat :: acc) rest + collect_patterns_from_list_construct (pat :: acc) rest | _ -> (List.rev acc, pattern) -let hasTemplateLiteralAttr attrs = +let has_template_literal_attr attrs = List.exists (fun attr -> match attr with @@ -640,7 +640,7 @@ let hasTemplateLiteralAttr attrs = | _ -> false) attrs -let hasTaggedTemplateLiteralAttr attrs = +let has_tagged_template_literal_attr attrs = List.exists (fun attr -> match attr with @@ -648,24 +648,24 @@ let hasTaggedTemplateLiteralAttr attrs = | _ -> false) attrs -let isTemplateLiteral expr = +let is_template_literal expr = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "^"}}, [(Nolabel, _); (Nolabel, _)] ) - when hasTemplateLiteralAttr expr.pexp_attributes -> + when has_template_literal_attr expr.pexp_attributes -> true | Pexp_constant (Pconst_string (_, Some "")) -> true - | Pexp_constant _ when hasTemplateLiteralAttr expr.pexp_attributes -> true + | Pexp_constant _ when has_template_literal_attr expr.pexp_attributes -> true | _ -> false -let isTaggedTemplateLiteral expr = +let is_tagged_template_literal expr = match expr with | {pexp_desc = Pexp_apply _; pexp_attributes = attrs} -> - hasTaggedTemplateLiteralAttr attrs + has_tagged_template_literal_attr attrs | _ -> false -let hasSpreadAttr attrs = +let has_spread_attr attrs = List.exists (fun attr -> match attr with @@ -673,7 +673,7 @@ let hasSpreadAttr attrs = | _ -> false) attrs -let isSpreadBeltListConcat expr = +let is_spread_belt_list_concat expr = match expr.pexp_desc with | Pexp_ident { @@ -681,10 +681,10 @@ let isSpreadBeltListConcat expr = Longident.Ldot (Longident.Ldot (Longident.Lident "Belt", "List"), "concatMany"); } -> - hasSpreadAttr expr.pexp_attributes + has_spread_attr expr.pexp_attributes | _ -> false -let isSpreadBeltArrayConcat expr = +let is_spread_belt_array_concat expr = match expr.pexp_desc with | Pexp_ident { @@ -692,11 +692,11 @@ let isSpreadBeltArrayConcat expr = Longident.Ldot (Longident.Ldot (Longident.Lident "Belt", "Array"), "concatMany"); } -> - hasSpreadAttr expr.pexp_attributes + has_spread_attr expr.pexp_attributes | _ -> false (* Blue | Red | Green -> [Blue; Red; Green] *) -let collectOrPatternChain pat = +let collect_or_pattern_chain pat = let rec loop pattern chain = match pattern.ppat_desc with | Ppat_or (left, right) -> loop left (right :: chain) @@ -704,7 +704,7 @@ let collectOrPatternChain pat = in loop pat [] -let isSinglePipeExpr expr = +let is_single_pipe_expr expr = (* handles: * x * ->Js.Dict.get("wm-property") @@ -717,7 +717,7 @@ let isSinglePipeExpr expr = * } * ) *) - let isPipeExpr expr = + let is_pipe_expr expr = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|.u" | "|>")}}, @@ -729,11 +729,11 @@ let isSinglePipeExpr expr = | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident ("|." | "|.u" | "|>")}}, [(Nolabel, operand1); (Nolabel, _operand2)] ) - when not (isPipeExpr operand1) -> + when not (is_pipe_expr operand1) -> true | _ -> false -let isUnderscoreApplySugar expr = +let is_underscore_apply_sugar expr = match expr.pexp_desc with | Pexp_fun ( Nolabel, @@ -743,7 +743,7 @@ let isUnderscoreApplySugar expr = true | _ -> false -let isRewrittenUnderscoreApplySugar expr = +let is_rewritten_underscore_apply_sugar expr = match expr.pexp_desc with | Pexp_ident {txt = Longident.Lident "_"} -> true | _ -> false diff --git a/jscomp/syntax/src/res_parsetree_viewer.mli b/jscomp/syntax/src/res_parsetree_viewer.mli index 954638c06a..41fd93e9b0 100644 --- a/jscomp/syntax/src/res_parsetree_viewer.mli +++ b/jscomp/syntax/src/res_parsetree_viewer.mli @@ -1,71 +1,71 @@ (* 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 arrowType : +val arrow_type : ?arity:int -> Parsetree.core_type -> Parsetree.attributes * (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list * Parsetree.core_type -val functorType : +val functor_type : Parsetree.module_type -> (Parsetree.attributes * string Asttypes.loc * Parsetree.module_type option) list * Parsetree.module_type (* filters @bs out of the provided attributes *) -val processBsAttribute : Parsetree.attributes -> bool * Parsetree.attributes +val process_bs_attribute : Parsetree.attributes -> bool * Parsetree.attributes -val processUncurriedAppAttribute : +val process_uncurried_app_attribute : Parsetree.attributes -> bool * Parsetree.attributes -val processPartialAppAttribute : +val process_partial_app_attribute : Parsetree.attributes -> bool * Parsetree.attributes -type functionAttributesInfo = { +type function_attributes_info = { async: bool; bs: bool; attributes: Parsetree.attributes; } (* determines whether a function is async and/or uncurried based on the given attributes *) -val processFunctionAttributes : Parsetree.attributes -> functionAttributesInfo +val process_function_attributes : Parsetree.attributes -> function_attributes_info -val hasAwaitAttribute : Parsetree.attributes -> bool +val has_await_attribute : Parsetree.attributes -> bool -type ifConditionKind = +type if_condition_kind = | 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 collectIfExpressions : +val collect_if_expressions : Parsetree.expression -> - (Location.t * ifConditionKind * Parsetree.expression) list + (Location.t * if_condition_kind * Parsetree.expression) list * Parsetree.expression option -val collectArrayExpressions : +val collect_array_expressions : Parsetree.expression -> Parsetree.expression list * Parsetree.expression option -val collectListExpressions : +val collect_list_expressions : Parsetree.expression -> Parsetree.expression list * Parsetree.expression option -type funParamKind = +type fun_param_kind = | Parameter of { attrs: Parsetree.attributes; lbl: Asttypes.arg_label; - defaultExpr: Parsetree.expression option; + default_expr: Parsetree.expression option; pat: Parsetree.pattern; } | NewTypes of {attrs: Parsetree.attributes; locs: string Asttypes.loc list} -val funExpr : +val fun_expr : Parsetree.expression -> - bool * Parsetree.attributes * funParamKind list * Parsetree.expression + bool * Parsetree.attributes * fun_param_kind list * Parsetree.expression (* example: * `makeCoordinate({ @@ -73,53 +73,53 @@ val funExpr : * y: 2, * })` * Notice howe `({` and `})` "hug" or stick to each other *) -val isHuggableExpression : Parsetree.expression -> bool +val is_huggable_expression : Parsetree.expression -> bool -val isHuggablePattern : Parsetree.pattern -> bool +val is_huggable_pattern : Parsetree.pattern -> bool -val isHuggableRhs : Parsetree.expression -> bool +val is_huggable_rhs : Parsetree.expression -> bool -val operatorPrecedence : string -> int +val operator_precedence : string -> int -val isUnaryExpression : Parsetree.expression -> bool -val isBinaryOperator : string -> bool -val isBinaryExpression : Parsetree.expression -> bool -val isRhsBinaryOperator : string -> bool +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 flattenableOperators : string -> string -> bool +val flattenable_operators : string -> string -> bool -val hasAttributes : Parsetree.attributes -> bool +val has_attributes : Parsetree.attributes -> bool -val isArrayAccess : Parsetree.expression -> bool -val isTernaryExpr : Parsetree.expression -> bool -val isIfLetExpr : Parsetree.expression -> bool +val is_array_access : Parsetree.expression -> bool +val is_ternary_expr : Parsetree.expression -> bool +val is_if_let_expr : Parsetree.expression -> bool -val collectTernaryParts : +val collect_ternary_parts : Parsetree.expression -> (Parsetree.expression * Parsetree.expression) list * Parsetree.expression -val parametersShouldHug : funParamKind list -> bool +val parameters_should_hug : fun_param_kind list -> bool -val filterTernaryAttributes : Parsetree.attributes -> Parsetree.attributes -val filterFragileMatchAttributes : Parsetree.attributes -> Parsetree.attributes +val filter_ternary_attributes : Parsetree.attributes -> Parsetree.attributes +val filter_fragile_match_attributes : Parsetree.attributes -> Parsetree.attributes -val isJsxExpression : Parsetree.expression -> bool -val hasJsxAttribute : Parsetree.attributes -> bool -val hasOptionalAttribute : Parsetree.attributes -> bool +val is_jsx_expression : Parsetree.expression -> bool +val has_jsx_attribute : Parsetree.attributes -> bool +val has_optional_attribute : Parsetree.attributes -> bool -val shouldIndentBinaryExpr : Parsetree.expression -> bool -val shouldInlineRhsBinaryExpr : Parsetree.expression -> bool -val hasPrintableAttributes : Parsetree.attributes -> bool -val filterPrintableAttributes : Parsetree.attributes -> Parsetree.attributes -val partitionPrintableAttributes : +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 : Parsetree.attributes -> Parsetree.attributes * Parsetree.attributes -val requiresSpecialCallbackPrintingLastArg : +val requires_special_callback_printing_last_arg : (Asttypes.arg_label * Parsetree.expression) list -> bool -val requiresSpecialCallbackPrintingFirstArg : +val requires_special_callback_printing_first_arg : (Asttypes.arg_label * Parsetree.expression) list -> bool -val modExprApply : +val mod_expr_apply : Parsetree.module_expr -> Parsetree.module_expr list * Parsetree.module_expr (* Collection of utilities to view the ast in a more a convenient form, @@ -127,46 +127,46 @@ val modExprApply : * Example: given a ptyp_arrow type, what are its arguments and what is the * returnType? *) -val modExprFunctor : +val mod_expr_functor : Parsetree.module_expr -> (Parsetree.attributes * string Asttypes.loc * Parsetree.module_type option) list * Parsetree.module_expr -val collectPatternsFromListConstruct : +val collect_patterns_from_list_construct : Parsetree.pattern list -> Parsetree.pattern -> Parsetree.pattern list * Parsetree.pattern -val isBlockExpr : Parsetree.expression -> bool +val is_block_expr : Parsetree.expression -> bool -val isTemplateLiteral : Parsetree.expression -> bool -val isTaggedTemplateLiteral : Parsetree.expression -> bool -val hasTemplateLiteralAttr : Parsetree.attributes -> 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 isSpreadBeltListConcat : Parsetree.expression -> bool +val is_spread_belt_list_concat : Parsetree.expression -> bool -val isSpreadBeltArrayConcat : Parsetree.expression -> bool +val is_spread_belt_array_concat : Parsetree.expression -> bool -val collectOrPatternChain : Parsetree.pattern -> Parsetree.pattern list +val collect_or_pattern_chain : Parsetree.pattern -> Parsetree.pattern list -val processBracesAttr : +val process_braces_attr : Parsetree.expression -> Parsetree.attribute option * Parsetree.expression -val filterParsingAttrs : Parsetree.attributes -> Parsetree.attributes +val filter_parsing_attrs : Parsetree.attributes -> Parsetree.attributes -val isBracedExpr : Parsetree.expression -> bool +val is_braced_expr : Parsetree.expression -> bool -val isSinglePipeExpr : Parsetree.expression -> bool +val is_single_pipe_expr : Parsetree.expression -> bool (* (__x) => f(a, __x, c) -----> f(a, _, c) *) -val rewriteUnderscoreApply : Parsetree.expression -> Parsetree.expression +val rewrite_underscore_apply : Parsetree.expression -> Parsetree.expression (* (__x) => f(a, __x, c) -----> f(a, _, c) *) -val isUnderscoreApplySugar : Parsetree.expression -> bool +val is_underscore_apply_sugar : Parsetree.expression -> bool -val hasIfLetAttribute : Parsetree.attributes -> bool +val has_if_let_attribute : Parsetree.attributes -> bool -val isRewrittenUnderscoreApplySugar : Parsetree.expression -> bool +val is_rewritten_underscore_apply_sugar : Parsetree.expression -> bool -val isFunNewtype : Parsetree.expression -> bool +val is_fun_newtype : Parsetree.expression -> bool diff --git a/jscomp/syntax/src/res_printer.ml b/jscomp/syntax/src/res_printer.ml index fc87073187..d104464d6b 100644 --- a/jscomp/syntax/src/res_printer.ml +++ b/jscomp/syntax/src/res_printer.ml @@ -5,7 +5,7 @@ module Token = Res_token module Parens = Res_parens module ParsetreeViewer = Res_parsetree_viewer -type callbackStyle = +type callback_style = (* regular arrow function, example: `let f = x => x + 1` *) | NoCallback (* `Thing.map(foo, (arg1, arg2) => MyModuleBlah.toList(argument))` *) @@ -16,71 +16,71 @@ type callbackStyle = *) | ArgumentsFitOnOneLine -let addParens doc = +let add_parens doc = Doc.group (Doc.concat [ Doc.lparen; - Doc.indent (Doc.concat [Doc.softLine; doc]); - Doc.softLine; + Doc.indent (Doc.concat [Doc.soft_line; doc]); + Doc.soft_line; Doc.rparen; ]) -let addBraces doc = +let add_braces doc = Doc.group (Doc.concat [ Doc.lbrace; - Doc.indent (Doc.concat [Doc.softLine; doc]); - Doc.softLine; + Doc.indent (Doc.concat [Doc.soft_line; doc]); + Doc.soft_line; Doc.rbrace; ]) -let addAsync doc = Doc.concat [Doc.text "async "; doc] +let add_async doc = Doc.concat [Doc.text "async "; doc] -let getFirstLeadingComment tbl loc = +let get_first_leading_comment 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 hasLeadingLineComment tbl loc = - match getFirstLeadingComment tbl loc with - | Some comment -> Comment.isSingleLineComment comment +let has_leading_line_comment tbl loc = + match get_first_leading_comment tbl loc with + | Some comment -> Comment.is_single_line_comment comment | None -> false -let hasCommentBelow tbl loc = +let has_comment_below tbl loc = match Hashtbl.find tbl.CommentTable.trailing loc with | comment :: _ -> - let commentLoc = Comment.loc comment in - commentLoc.Location.loc_start.pos_lnum > loc.Location.loc_end.pos_lnum + let comment_loc = Comment.loc comment in + comment_loc.Location.loc_start.pos_lnum > loc.Location.loc_end.pos_lnum | [] -> false | exception Not_found -> false -let hasNestedJsxOrMoreThanOneChild expr = - let rec loop inRecursion expr = +let has_nested_jsx_or_more_than_one_child expr = + let rec loop in_recursion expr = match expr.Parsetree.pexp_desc with | Pexp_construct ({txt = Longident.Lident "::"}, Some {pexp_desc = Pexp_tuple [hd; tail]}) -> - if inRecursion || ParsetreeViewer.isJsxExpression hd then true + if in_recursion || ParsetreeViewer.is_jsx_expression hd then true else loop true tail | _ -> false in loop false expr -let hasCommentsInside tbl loc = +let has_comments_inside tbl loc = match Hashtbl.find_opt tbl.CommentTable.inside loc with | None -> false | _ -> true -let hasTrailingComments tbl loc = +let has_trailing_comments tbl loc = match Hashtbl.find_opt tbl.CommentTable.trailing loc with | None -> false | _ -> true -let printMultilineCommentContent txt = +let print_multiline_comment_content txt = (* Turns * |* first line * * second line @@ -93,102 +93,102 @@ let printMultilineCommentContent txt = * What makes a comment suitable for this kind of indentation? * -> multiple lines + every line starts with a star *) - let rec indentStars lines acc = + let rec indent_stars lines acc = match lines with | [] -> Doc.nil - | [lastLine] -> - let line = String.trim lastLine in + | [last_line] -> + let line = String.trim last_line in let doc = Doc.text (" " ^ line) in - let trailingSpace = if line = "" then Doc.nil else Doc.space in - List.rev (trailingSpace :: doc :: acc) |> Doc.concat + let trailing_space = if line = "" then Doc.nil else Doc.space in + List.rev (trailing_space :: 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 - indentStars lines (Doc.hardLine :: doc :: acc) + indent_stars lines (Doc.hard_line :: doc :: acc) else - let trailingSpace = + let trailing_space = 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.trimSpaces txt in - Doc.concat [Doc.text content; trailingSpace] + let content = Comment.trim_spaces txt in + Doc.concat [Doc.text content; trailing_space] in let lines = String.split_on_char '\n' txt in match lines with | [] -> Doc.text "/* */" | [line] -> Doc.concat - [Doc.text "/* "; Doc.text (Comment.trimSpaces line); Doc.text " */"] + [Doc.text "/* "; Doc.text (Comment.trim_spaces line); Doc.text " */"] | first :: rest -> - let firstLine = Comment.trimSpaces first in + let first_line = Comment.trim_spaces first in Doc.concat [ Doc.text "/*"; - (match firstLine with + (match first_line with | "" | "*" -> Doc.nil | _ -> Doc.space); - indentStars rest [Doc.hardLine; Doc.text firstLine]; + indent_stars rest [Doc.hard_line; Doc.text first_line]; Doc.text "*/"; ] -let printTrailingComment (prevLoc : Location.t) (nodeLoc : Location.t) comment = - let singleLine = Comment.isSingleLineComment comment in +let print_trailing_comment (prev_loc : Location.t) (node_loc : Location.t) comment = + let single_line = Comment.is_single_line_comment comment in let content = let txt = Comment.txt comment in - if singleLine then Doc.text ("//" ^ txt) - else printMultilineCommentContent txt + if single_line then Doc.text ("//" ^ txt) + else print_multiline_comment_content txt in let diff = - let cmtStart = (Comment.loc comment).loc_start in - cmtStart.pos_lnum - prevLoc.loc_end.pos_lnum + let cmt_start = (Comment.loc comment).loc_start in + cmt_start.pos_lnum - prev_loc.loc_end.pos_lnum in - let isBelow = - (Comment.loc comment).loc_start.pos_lnum > nodeLoc.loc_end.pos_lnum + let is_below = + (Comment.loc comment).loc_start.pos_lnum > node_loc.loc_end.pos_lnum in - if diff > 0 || isBelow then + if diff > 0 || is_below then Doc.concat [ - Doc.breakParent; - Doc.lineSuffix + Doc.break_parent; + Doc.line_suffix (Doc.concat [ - Doc.hardLine; - (if diff > 1 then Doc.hardLine else Doc.nil); + Doc.hard_line; + (if diff > 1 then Doc.hard_line else Doc.nil); content; ]); ] - else if not singleLine then Doc.concat [Doc.space; content] - else Doc.lineSuffix (Doc.concat [Doc.space; content]) + else if not single_line then Doc.concat [Doc.space; content] + else Doc.line_suffix (Doc.concat [Doc.space; content]) -let printLeadingComment ?nextComment comment = - let singleLine = Comment.isSingleLineComment comment in +let print_leading_comment ?next_comment comment = + let single_line = Comment.is_single_line_comment comment in let content = let txt = Comment.txt comment in - if singleLine then Doc.text ("//" ^ txt) - else printMultilineCommentContent txt + if single_line then Doc.text ("//" ^ txt) + else print_multiline_comment_content txt in let separator = Doc.concat [ - (if singleLine then Doc.concat [Doc.hardLine; Doc.breakParent] + (if single_line then Doc.concat [Doc.hard_line; Doc.break_parent] else Doc.nil); - (match nextComment with + (match next_comment with | Some next -> - let nextLoc = Comment.loc next in - let currLoc = Comment.loc comment in + let next_loc = Comment.loc next in + let curr_loc = Comment.loc comment in let diff = - nextLoc.Location.loc_start.pos_lnum - - currLoc.Location.loc_end.pos_lnum + next_loc.Location.loc_start.pos_lnum + - curr_loc.Location.loc_end.pos_lnum in - 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 + 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 else Doc.space | None -> Doc.nil); ] @@ -196,83 +196,83 @@ let printLeadingComment ?nextComment comment = Doc.concat [content; separator] (* This function is used for printing comments inside an empty block *) -let printCommentsInside cmtTbl loc = - let printComment comment = - let singleLine = Comment.isSingleLineComment comment in +let print_comments_inside cmt_tbl loc = + let print_comment comment = + let single_line = Comment.is_single_line_comment comment in let txt = Comment.txt comment in - if singleLine then Doc.text ("//" ^ txt) - else printMultilineCommentContent txt + if single_line then Doc.text ("//" ^ txt) + else print_multiline_comment_content txt in - let forceBreak = + let force_break = 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 cmtDoc = printComment comment in - let cmtsDoc = Doc.concat (Doc.softLine :: List.rev (cmtDoc :: acc)) in + let cmt_doc = print_comment comment in + let cmts_doc = Doc.concat (Doc.soft_line :: List.rev (cmt_doc :: acc)) in let doc = - Doc.breakableGroup ~forceBreak - (Doc.concat [Doc.ifBreaks (Doc.indent cmtsDoc) cmtsDoc; Doc.softLine]) + Doc.breakable_group ~force_break + (Doc.concat [Doc.if_breaks (Doc.indent cmts_doc) cmts_doc; Doc.soft_line]) in doc | comment :: rest -> - let cmtDoc = Doc.concat [printComment comment; Doc.line] in - loop (cmtDoc :: acc) rest + let cmt_doc = Doc.concat [print_comment comment; Doc.line] in + loop (cmt_doc :: acc) rest in - match Hashtbl.find cmtTbl.CommentTable.inside loc with + match Hashtbl.find cmt_tbl.CommentTable.inside loc with | exception Not_found -> Doc.nil | comments -> - Hashtbl.remove cmtTbl.inside loc; + Hashtbl.remove cmt_tbl.inside loc; loop [] comments (* This function is used for printing comments inside an empty file *) -let printCommentsInsideFile cmtTbl = +let print_comments_inside_file cmt_tbl = let rec loop acc comments = match comments with | [] -> Doc.nil | [comment] -> - let cmtDoc = printLeadingComment comment in + let cmt_doc = print_leading_comment comment in let doc = - Doc.group (Doc.concat [Doc.concat (List.rev (cmtDoc :: acc))]) + Doc.group (Doc.concat [Doc.concat (List.rev (cmt_doc :: acc))]) in doc - | comment :: (nextComment :: _comments as rest) -> - let cmtDoc = printLeadingComment ~nextComment comment in - loop (cmtDoc :: acc) rest + | comment :: (next_comment :: _comments as rest) -> + let cmt_doc = print_leading_comment ~next_comment comment in + loop (cmt_doc :: acc) rest in - match Hashtbl.find cmtTbl.CommentTable.inside Location.none with + match Hashtbl.find cmt_tbl.CommentTable.inside Location.none with | exception Not_found -> Doc.nil | comments -> - Hashtbl.remove cmtTbl.inside Location.none; + Hashtbl.remove cmt_tbl.inside Location.none; Doc.group (loop [] comments) -let printLeadingComments node tbl loc = +let print_leading_comments node tbl loc = let rec loop acc comments = match comments with | [] -> node | [comment] -> - let cmtDoc = printLeadingComment comment in + let cmt_doc = print_leading_comment comment in let diff = loc.Location.loc_start.pos_lnum - (Comment.loc comment).Location.loc_end.pos_lnum in let separator = - if Comment.isSingleLineComment comment then - if diff > 1 then Doc.hardLine else Doc.nil + if Comment.is_single_line_comment comment then + if diff > 1 then Doc.hard_line else Doc.nil else if diff == 0 then Doc.space - else if diff > 1 then Doc.concat [Doc.hardLine; Doc.hardLine] - else Doc.hardLine + else if diff > 1 then Doc.concat [Doc.hard_line; Doc.hard_line] + else Doc.hard_line in let doc = Doc.group - (Doc.concat [Doc.concat (List.rev (cmtDoc :: acc)); separator; node]) + (Doc.concat [Doc.concat (List.rev (cmt_doc :: acc)); separator; node]) in doc - | comment :: (nextComment :: _comments as rest) -> - let cmtDoc = printLeadingComment ~nextComment comment in - loop (cmtDoc :: acc) rest + | comment :: (next_comment :: _comments as rest) -> + let cmt_doc = print_leading_comment ~next_comment comment in + loop (cmt_doc :: acc) rest in match Hashtbl.find tbl loc with | exception Not_found -> node @@ -282,13 +282,13 @@ let printLeadingComments node tbl loc = Hashtbl.remove tbl loc; loop [] comments -let printTrailingComments node tbl loc = +let print_trailing_comments node tbl loc = let rec loop prev acc comments = match comments with | [] -> Doc.concat (List.rev acc) | comment :: comments -> - let cmtDoc = printTrailingComment prev loc comment in - loop (Comment.loc comment) (cmtDoc :: acc) comments + let cmt_doc = print_trailing_comment prev loc comment in + loop (Comment.loc comment) (cmt_doc :: acc) comments in match Hashtbl.find tbl loc with | exception Not_found -> node @@ -297,110 +297,110 @@ let printTrailingComments 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 cmtsDoc = loop loc [] comments in - Doc.concat [node; cmtsDoc] + let cmts_doc = loop loc [] comments in + Doc.concat [node; cmts_doc] -let printComments doc (tbl : CommentTable.t) loc = - let docWithLeadingComments = printLeadingComments doc tbl.leading loc in - printTrailingComments docWithLeadingComments tbl.trailing loc +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 printList ~getLoc ~nodes ~print ?(forceBreak = false) t = - let rec loop (prevLoc : Location.t) acc nodes = +let print_list ~get_loc ~nodes ~print ?(force_break = false) t = + let rec loop (prev_loc : Location.t) acc nodes = match nodes with - | [] -> (prevLoc, Doc.concat (List.rev acc)) + | [] -> (prev_loc, Doc.concat (List.rev acc)) | node :: nodes -> - let loc = getLoc node in - let startPos = - match getFirstLeadingComment t loc with + let loc = get_loc node in + let start_pos = + match get_first_leading_comment t loc with | None -> loc.loc_start | Some comment -> (Comment.loc comment).loc_start in let sep = - if startPos.pos_lnum - prevLoc.loc_end.pos_lnum > 1 then - Doc.concat [Doc.hardLine; Doc.hardLine] - else Doc.hardLine + 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 in - let doc = printComments (print node t) t loc in + let doc = print_comments (print node t) t loc in loop loc (doc :: sep :: acc) nodes in match nodes with | [] -> Doc.nil | node :: nodes -> - 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 + 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 in - Doc.breakableGroup ~forceBreak docs + Doc.breakable_group ~force_break docs -let printListi ~getLoc ~nodes ~print ?(forceBreak = false) t = - let rec loop i (prevLoc : Location.t) acc nodes = +let print_listi ~get_loc ~nodes ~print ?(force_break = false) t = + let rec loop i (prev_loc : Location.t) acc nodes = match nodes with - | [] -> (prevLoc, Doc.concat (List.rev acc)) + | [] -> (prev_loc, Doc.concat (List.rev acc)) | node :: nodes -> - let loc = getLoc node in - let startPos = - match getFirstLeadingComment t loc with + let loc = get_loc node in + let start_pos = + match get_first_leading_comment t loc with | None -> loc.loc_start | Some comment -> (Comment.loc comment).loc_start in let sep = - if startPos.pos_lnum - prevLoc.loc_end.pos_lnum > 1 then - Doc.concat [Doc.hardLine; Doc.hardLine] + if start_pos.pos_lnum - prev_loc.loc_end.pos_lnum > 1 then + Doc.concat [Doc.hard_line; Doc.hard_line] else Doc.line in - let doc = printComments (print node t i) t loc in + let doc = print_comments (print node t i) t loc in loop (i + 1) loc (doc :: sep :: acc) nodes in match nodes with | [] -> Doc.nil | node :: nodes -> - 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 + 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 in - Doc.breakableGroup ~forceBreak docs + Doc.breakable_group ~force_break docs -let rec printLongidentAux accu = function +let rec print_longident_aux accu = function | Longident.Lident s -> Doc.text s :: accu - | Ldot (lid, s) -> printLongidentAux (Doc.text s :: accu) lid + | Ldot (lid, s) -> print_longident_aux (Doc.text s :: accu) lid | Lapply (lid1, lid2) -> - let d1 = Doc.join ~sep:Doc.dot (printLongidentAux [] lid1) in - let d2 = Doc.join ~sep:Doc.dot (printLongidentAux [] lid2) in + let d1 = Doc.join ~sep:Doc.dot (print_longident_aux [] lid1) in + let d2 = Doc.join ~sep:Doc.dot (print_longident_aux [] lid2) in Doc.concat [d1; Doc.lparen; d2; Doc.rparen] :: accu -let printLongident = function +let print_longident = function | Longident.Lident txt -> Doc.text txt - | lid -> Doc.join ~sep:Doc.dot (printLongidentAux [] lid) + | lid -> Doc.join ~sep:Doc.dot (print_longident_aux [] lid) -type identifierStyle = ExoticIdent | NormalIdent +type identifier_style = ExoticIdent | NormalIdent -let classifyIdentContent ?(allowUident = false) ?(allowHyphen = false) txt = - if Token.isKeywordTxt txt then ExoticIdent +let classify_ident_content ?(allow_uident = false) ?(allow_hyphen = false) txt = + if Token.is_keyword_txt 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 allowUident -> loop (i + 1) + | 'A' .. 'Z' when allow_uident -> loop (i + 1) | 'a' .. 'z' | '_' -> loop (i + 1) - | '-' when allowHyphen -> loop (i + 1) + | '-' when allow_hyphen -> loop (i + 1) | _ -> ExoticIdent else match String.unsafe_get txt i with | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '\'' | '_' -> loop (i + 1) - | '-' when allowHyphen -> loop (i + 1) + | '-' when allow_hyphen -> loop (i + 1) | _ -> ExoticIdent in loop 0 -let printIdentLike ?allowUident ?allowHyphen txt = +let print_ident_like ?allow_uident ?allow_hyphen txt = let txt = Ext_ident.unwrap_uppercase_exotic txt in - match classifyIdentContent ?allowUident ?allowHyphen txt with + match classify_ident_content ?allow_uident ?allow_hyphen txt with | ExoticIdent -> Doc.concat [Doc.text "\\\""; Doc.text txt; Doc.text "\""] | NormalIdent -> Doc.text txt @@ -414,7 +414,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 isValidNumericPolyvarNumber (x : string) = +let is_valid_numeric_polyvar_number (x : string) = let len = String.length x in len > 0 && @@ -429,24 +429,24 @@ let isValidNumericPolyvarNumber (x : string) = else a >= 48 (* Exotic identifiers in poly-vars have a "lighter" syntax: #"ease-in" *) -let printPolyVarIdent txt = +let print_poly_var_ident txt = (* numeric poly-vars don't need quotes: #644 *) - if isValidNumericPolyvarNumber txt then Doc.text txt + if is_valid_numeric_polyvar_number txt then Doc.text txt else let txt = Ext_ident.unwrap_uppercase_exotic txt in - match classifyIdentContent ~allowUident:true txt with + match classify_ident_content ~allow_uident: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 polyVarIdentToString polyVarIdent = - Doc.concat [Doc.text "#"; printPolyVarIdent polyVarIdent] - |> Doc.toString ~width:80 +let poly_var_ident_to_string poly_var_ident = + Doc.concat [Doc.text "#"; print_poly_var_ident poly_var_ident] + |> Doc.to_string ~width:80 -let printLident l = - let flatLidOpt lid = +let print_lident l = + let flat_lid_opt lid = let rec flat accu = function | Longident.Lident s -> Some (s :: accu) | Ldot (lid, s) -> flat (s :: accu) lid @@ -455,64 +455,64 @@ let printLident l = flat [] lid in match l with - | Longident.Lident txt -> printIdentLike txt + | Longident.Lident txt -> print_ident_like txt | Longident.Ldot (path, txt) -> let doc = - match flatLidOpt path with + match flat_lid_opt path with | Some txts -> Doc.concat [ Doc.join ~sep:Doc.dot (List.map Doc.text txts); Doc.dot; - printIdentLike txt; + print_ident_like txt; ] | None -> Doc.text "printLident: Longident.Lapply is not supported" in doc | Lapply (_, _) -> Doc.text "printLident: Longident.Lapply is not supported" -let printLongidentLocation l cmtTbl = - let doc = printLongident l.Location.txt in - printComments doc cmtTbl l.loc +let print_longident_location l cmt_tbl = + let doc = print_longident l.Location.txt in + print_comments doc cmt_tbl l.loc (* Module.SubModule.x *) -let printLidentPath path cmtTbl = - let doc = printLident path.Location.txt in - printComments doc cmtTbl path.loc +let print_lident_path path cmt_tbl = + let doc = print_lident path.Location.txt in + print_comments doc cmt_tbl path.loc (* Module.SubModule.x or Module.SubModule.X *) -let printIdentPath path cmtTbl = - let doc = printLident path.Location.txt in - printComments doc cmtTbl path.loc +let print_ident_path path cmt_tbl = + let doc = print_lident path.Location.txt in + print_comments doc cmt_tbl path.loc -let printStringLoc sloc cmtTbl = - let doc = printIdentLike sloc.Location.txt in - printComments doc cmtTbl sloc.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 printStringContents txt = +let print_string_contents txt = let lines = String.split_on_char '\n' txt in - Doc.join ~sep:Doc.literalLine (List.map Doc.text lines) + Doc.join ~sep:Doc.literal_line (List.map Doc.text lines) -let printConstant ?(templateLiteral = false) c = +let print_constant ?(template_literal = 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 "\""; printStringContents txt; Doc.text "\""] + Doc.concat [Doc.text "\""; print_string_contents 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 templateLiteral then ("`", "`") else ("\"", "\"") + if template_literal then ("`", "`") else ("\"", "\"") in Doc.concat [ (if prefix = "js" then Doc.nil else Doc.text prefix); Doc.text lquote; - printStringContents txt; + print_string_contents txt; Doc.text rquote; ] | Pconst_float (s, _) -> Doc.text s @@ -529,120 +529,120 @@ let printConstant ?(templateLiteral = false) c = let s = (Bytes.create [@doesNotRaise]) 1 in Bytes.unsafe_set s 0 c; Bytes.unsafe_to_string s - | _ -> Res_utf8.encodeCodePoint c + | _ -> Res_utf8.encode_code_point c in Doc.text ("'" ^ str ^ "'") -let printOptionalLabel attrs = - if Res_parsetree_viewer.hasOptionalAttribute attrs then Doc.text "?" +let print_optional_label attrs = + if Res_parsetree_viewer.has_optional_attribute attrs then Doc.text "?" else Doc.nil module State = struct - let customLayoutThreshold = 2 + let custom_layout_threshold = 2 - type t = {customLayout: int; mutable uncurried_config: Config.uncurried} + type t = {custom_layout: int; mutable uncurried_config: Config.uncurried} - let init () = {customLayout = 0; uncurried_config = !Config.uncurried} + let init () = {custom_layout = 0; uncurried_config = !Config.uncurried} - let nextCustomLayout t = {t with customLayout = t.customLayout + 1} + let next_custom_layout t = {t with custom_layout = t.custom_layout + 1} - let shouldBreakCallback t = t.customLayout > customLayoutThreshold + let should_break_callback t = t.custom_layout > custom_layout_threshold end -let rec printStructure ~state (s : Parsetree.structure) t = +let rec print_structure ~state (s : Parsetree.structure) t = match s with - | [] -> printCommentsInsideFile t + | [] -> print_comments_inside_file t | structure -> - printList - ~getLoc:(fun s -> s.Parsetree.pstr_loc) + print_list + ~get_loc:(fun s -> s.Parsetree.pstr_loc) ~nodes:structure - ~print:(printStructureItem ~state) + ~print:(print_structure_item ~state) t -and printStructureItem ~state (si : Parsetree.structure_item) cmtTbl = +and print_structure_item ~state (si : Parsetree.structure_item) cmt_tbl = match si.pstr_desc with - | Pstr_value (rec_flag, valueBindings) -> - let recFlag = + | Pstr_value (rec_flag, value_bindings) -> + let rec_flag = match rec_flag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printValueBindings ~state ~recFlag valueBindings cmtTbl - | Pstr_type (recFlag, typeDeclarations) -> - let recFlag = - match recFlag with + print_value_bindings ~state ~rec_flag value_bindings cmt_tbl + | Pstr_type (rec_flag, type_declarations) -> + let rec_flag = + match rec_flag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl - | Pstr_primitive valueDescription -> - printValueDescription ~state valueDescription cmtTbl + print_type_declarations ~state ~rec_flag type_declarations cmt_tbl + | Pstr_primitive value_description -> + print_value_description ~state value_description cmt_tbl | Pstr_eval (expr, attrs) -> - let exprDoc = - let doc = printExpressionWithComments ~state expr cmtTbl in - match Parens.structureExpr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + 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 | Nothing -> doc in - Doc.concat [printAttributes ~state attrs cmtTbl; exprDoc] + Doc.concat [print_attributes ~state attrs cmt_tbl; expr_doc] | Pstr_attribute attr -> - fst (printAttribute ~state ~standalone:true attr cmtTbl) + fst (print_attribute ~state ~standalone:true attr cmt_tbl) | Pstr_extension (extension, attrs) -> Doc.concat [ - printAttributes ~state attrs cmtTbl; - Doc.concat [printExtension ~state ~atModuleLvl:true extension cmtTbl]; + print_attributes ~state attrs cmt_tbl; + Doc.concat [print_extension ~state ~at_module_lvl:true 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_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_class _ | Pstr_class_type _ -> Doc.nil -and printTypeExtension ~state (te : Parsetree.type_extension) cmtTbl = +and print_type_extension ~state (te : Parsetree.type_extension) cmt_tbl = let prefix = Doc.text "type " in - let name = printLidentPath te.ptyext_path cmtTbl in - let typeParams = printTypeParams ~state te.ptyext_params cmtTbl in - let extensionConstructors = + 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 ecs = te.ptyext_constructors in - let forceBreak = + let force_break = 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 privateFlag = + let private_flag = match te.ptyext_private with | Asttypes.Private -> Doc.concat [Doc.text "private"; Doc.line] | Public -> Doc.nil in let rows = - printListi - ~getLoc:(fun n -> n.Parsetree.pext_loc) - ~print:(printExtensionConstructor ~state) - ~nodes:ecs ~forceBreak cmtTbl + print_listi + ~get_loc:(fun n -> n.Parsetree.pext_loc) + ~print:(print_extension_constructor ~state) + ~nodes:ecs ~force_break cmt_tbl in - Doc.breakableGroup ~forceBreak + Doc.breakable_group ~force_break (Doc.indent (Doc.concat [ Doc.line; - privateFlag; + private_flag; rows; (* Doc.join ~sep:Doc.line ( *) (* List.mapi printExtensionConstructor ecs *) @@ -652,114 +652,114 @@ and printTypeExtension ~state (te : Parsetree.type_extension) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~state ~loc:te.ptyext_path.loc te.ptyext_attributes - cmtTbl; + print_attributes ~state ~loc:te.ptyext_path.loc te.ptyext_attributes + cmt_tbl; prefix; name; - typeParams; + type_params; Doc.text " +="; - extensionConstructors; + extension_constructors; ]) -and printModuleBinding ~state ~isRec moduleBinding cmtTbl i = +and print_module_binding ~state ~is_rec module_binding cmt_tbl i = let prefix = if i = 0 then Doc.concat - [Doc.text "module "; (if isRec then Doc.text "rec " else Doc.nil)] + [Doc.text "module "; (if is_rec then Doc.text "rec " else Doc.nil)] else Doc.text "and " in - let modExprDoc, modConstraintDoc = - match moduleBinding.pmb_expr with - | {pmod_desc = Pmod_constraint (modExpr, modType)} + let mod_expr_doc, mod_constraint_doc = + match module_binding.pmb_expr with + | {pmod_desc = Pmod_constraint (mod_expr, mod_type)} when not - (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) + (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) in - let modName = - let doc = Doc.text moduleBinding.pmb_name.Location.txt in - printComments doc cmtTbl moduleBinding.pmb_name.loc + let mod_name = + let doc = Doc.text module_binding.pmb_name.Location.txt in + print_comments doc cmt_tbl module_binding.pmb_name.loc in let doc = Doc.concat [ - printAttributes ~state ~loc:moduleBinding.pmb_name.loc - moduleBinding.pmb_attributes cmtTbl; + print_attributes ~state ~loc:module_binding.pmb_name.loc + module_binding.pmb_attributes cmt_tbl; prefix; - modName; - modConstraintDoc; + mod_name; + mod_constraint_doc; Doc.text " = "; - modExprDoc; + mod_expr_doc; ] in - printComments doc cmtTbl moduleBinding.pmb_loc + print_comments doc cmt_tbl module_binding.pmb_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 +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 in Doc.concat [ - printAttributes ~state modTypeDecl.pmtd_attributes cmtTbl; + print_attributes ~state mod_type_decl.pmtd_attributes cmt_tbl; Doc.text "module type "; - modName; - (match modTypeDecl.pmtd_type with + mod_name; + (match mod_type_decl.pmtd_type with | None -> Doc.nil - | Some modType -> - Doc.concat [Doc.text " = "; printModType ~state modType cmtTbl]); + | Some mod_type -> + Doc.concat [Doc.text " = "; print_mod_type ~state mod_type cmt_tbl]); ] -and printModType ~state modType cmtTbl = - let modTypeDoc = - match modType.pmty_desc with +and print_mod_type ~state mod_type cmt_tbl = + let mod_type_doc = + match mod_type.pmty_desc with | Parsetree.Pmty_ident longident -> Doc.concat [ - printAttributes ~state ~loc:longident.loc modType.pmty_attributes - cmtTbl; - printLongidentLocation longident cmtTbl; + print_attributes ~state ~loc:longident.loc mod_type.pmty_attributes + cmt_tbl; + print_longident_location longident cmt_tbl; ] | Pmty_signature [] -> - if hasCommentsInside cmtTbl modType.pmty_loc then - let doc = printCommentsInside cmtTbl modType.pmty_loc in + if has_comments_inside cmt_tbl mod_type.pmty_loc then + let doc = print_comments_inside cmt_tbl mod_type.pmty_loc in Doc.concat [Doc.lbrace; doc; Doc.rbrace] else - let shouldBreak = - modType.pmty_loc.loc_start.pos_lnum - < modType.pmty_loc.loc_end.pos_lnum + let should_break = + mod_type.pmty_loc.loc_start.pos_lnum + < mod_type.pmty_loc.loc_end.pos_lnum in - Doc.breakableGroup ~forceBreak:shouldBreak - (Doc.concat [Doc.lbrace; Doc.softLine; Doc.softLine; Doc.rbrace]) + Doc.breakable_group ~force_break:should_break + (Doc.concat [Doc.lbrace; Doc.soft_line; Doc.soft_line; Doc.rbrace]) | Pmty_signature signature -> - let signatureDoc = - Doc.breakableGroup ~forceBreak:true + let signature_doc = + Doc.breakable_group ~force_break:true (Doc.concat [ Doc.lbrace; Doc.indent - (Doc.concat [Doc.line; printSignature ~state signature cmtTbl]); + (Doc.concat [Doc.line; print_signature ~state signature cmt_tbl]); Doc.line; Doc.rbrace; ]) in Doc.concat - [printAttributes ~state modType.pmty_attributes cmtTbl; signatureDoc] + [print_attributes ~state mod_type.pmty_attributes cmt_tbl; signature_doc] | Pmty_functor _ -> - let parameters, returnType = ParsetreeViewer.functorType modType in - let parametersDoc = + let parameters, return_type = ParsetreeViewer.functor_type mod_type in + let parameters_doc = match parameters with | [] -> Doc.nil - | [(attrs, {Location.txt = "_"; loc}, Some modType)] -> - let cmtLoc = - {loc with loc_end = modType.Parsetree.pmty_loc.loc_end} + | [(attrs, {Location.txt = "_"; loc}, Some mod_type)] -> + let cmt_loc = + {loc with loc_end = mod_type.Parsetree.pmty_loc.loc_end} in - let attrs = printAttributes ~state attrs cmtTbl in - let doc = Doc.concat [attrs; printModType ~state modType cmtTbl] in - printComments doc cmtTbl cmtLoc + let attrs = print_attributes ~state attrs cmt_tbl in + let doc = Doc.concat [attrs; print_mod_type ~state mod_type cmt_tbl] in + print_comments doc cmt_tbl cmt_loc | params -> Doc.group (Doc.concat @@ -768,76 +768,76 @@ and printModType ~state modType cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun (attrs, lbl, modType) -> - let cmtLoc = - match modType with + (fun (attrs, lbl, mod_type) -> + let cmt_loc = + match mod_type with | None -> lbl.Asttypes.loc - | Some modType -> + | Some mod_type -> { lbl.Asttypes.loc with loc_end = - modType.Parsetree.pmty_loc.loc_end; + mod_type.Parsetree.pmty_loc.loc_end; } in let attrs = - printAttributes ~state attrs cmtTbl + print_attributes ~state attrs cmt_tbl in - let lblDoc = + let lbl_doc = if lbl.Location.txt = "_" || lbl.txt = "*" then Doc.nil else let doc = Doc.text lbl.txt in - printComments doc cmtTbl lbl.loc + print_comments doc cmt_tbl lbl.loc in let doc = Doc.concat [ attrs; - lblDoc; - (match modType with + lbl_doc; + (match mod_type with | None -> Doc.nil - | Some modType -> + | Some mod_type -> Doc.concat [ (if lbl.txt = "_" then Doc.nil else Doc.text ": "); - printModType ~state modType cmtTbl; + print_mod_type ~state mod_type cmt_tbl; ]); ] in - printComments doc cmtTbl cmtLoc) + print_comments doc cmt_tbl cmt_loc) params); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ]) in - let returnDoc = - let doc = printModType ~state returnType cmtTbl in - if Parens.modTypeFunctorReturn returnType then addParens doc else doc + 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 in Doc.group (Doc.concat [ - parametersDoc; - Doc.group (Doc.concat [Doc.text " =>"; Doc.line; returnDoc]); + parameters_doc; + Doc.group (Doc.concat [Doc.text " =>"; Doc.line; return_doc]); ]) - | Pmty_typeof modExpr -> + | Pmty_typeof mod_expr -> Doc.concat - [Doc.text "module type of "; printModExpr ~state modExpr cmtTbl] + [Doc.text "module type of "; print_mod_expr ~state mod_expr cmt_tbl] | Pmty_extension extension -> - printExtension ~state ~atModuleLvl:false extension cmtTbl + print_extension ~state ~at_module_lvl:false extension cmt_tbl | Pmty_alias longident -> - Doc.concat [Doc.text "module "; printLongidentLocation longident cmtTbl] - | Pmty_with (modType, withConstraints) -> + Doc.concat [Doc.text "module "; print_longident_location longident cmt_tbl] + | Pmty_with (mod_type, with_constraints) -> let operand = - let doc = printModType ~state modType cmtTbl in - if Parens.modTypeWithOperand modType then addParens doc else doc + 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 in Doc.group (Doc.concat @@ -845,228 +845,228 @@ and printModType ~state modType cmtTbl = operand; Doc.indent (Doc.concat - [Doc.line; printWithConstraints ~state withConstraints cmtTbl]); + [Doc.line; print_with_constraints ~state with_constraints cmt_tbl]); ]) in - let attrsAlreadyPrinted = - match modType.pmty_desc with + let attrs_already_printed = + match mod_type.pmty_desc with | Pmty_functor _ | Pmty_signature _ | Pmty_ident _ -> true | _ -> false in let doc = Doc.concat [ - (if attrsAlreadyPrinted then Doc.nil - else printAttributes ~state modType.pmty_attributes cmtTbl); - modTypeDoc; + (if attrs_already_printed then Doc.nil + else print_attributes ~state mod_type.pmty_attributes cmt_tbl); + mod_type_doc; ] in - printComments doc cmtTbl modType.pmty_loc + print_comments doc cmt_tbl mod_type.pmty_loc -and printWithConstraints ~state withConstraints cmtTbl = +and print_with_constraints ~state with_constraints cmt_tbl = let rows = List.mapi - (fun i withConstraint -> + (fun i with_constraint -> Doc.group (Doc.concat [ (if i == 0 then Doc.text "with " else Doc.text "and "); - printWithConstraint ~state withConstraint cmtTbl; + print_with_constraint ~state with_constraint cmt_tbl; ])) - withConstraints + with_constraints in Doc.join ~sep:Doc.line rows -and printWithConstraint ~state (withConstraint : Parsetree.with_constraint) - cmtTbl = - match withConstraint with +and print_with_constraint ~state (with_constraint : Parsetree.with_constraint) + cmt_tbl = + match with_constraint with (* with type X.t = ... *) - | Pwith_type (longident, typeDeclaration) -> + | Pwith_type (longident, type_declaration) -> Doc.group - (printTypeDeclaration ~state - ~name:(printLidentPath longident cmtTbl) - ~equalSign:"=" ~recFlag:Doc.nil 0 typeDeclaration CommentTable.empty) + (print_type_declaration ~state + ~name:(print_lident_path longident cmt_tbl) + ~equal_sign:"=" ~rec_flag:Doc.nil 0 type_declaration CommentTable.empty) (* with module X.Y = Z *) | Pwith_module ({txt = longident1}, {txt = longident2}) -> Doc.concat [ Doc.text "module "; - printLongident longident1; + print_longident longident1; Doc.text " ="; - Doc.indent (Doc.concat [Doc.line; printLongident longident2]); + Doc.indent (Doc.concat [Doc.line; print_longident longident2]); ] (* with type X.t := ..., same format as [Pwith_type] *) - | Pwith_typesubst (longident, typeDeclaration) -> + | Pwith_typesubst (longident, type_declaration) -> Doc.group - (printTypeDeclaration ~state - ~name:(printLidentPath longident cmtTbl) - ~equalSign:":=" ~recFlag:Doc.nil 0 typeDeclaration CommentTable.empty) + (print_type_declaration ~state + ~name:(print_lident_path longident cmt_tbl) + ~equal_sign:":=" ~rec_flag:Doc.nil 0 type_declaration CommentTable.empty) | Pwith_modsubst ({txt = longident1}, {txt = longident2}) -> Doc.concat [ Doc.text "module "; - printLongident longident1; + print_longident longident1; Doc.text " :="; - Doc.indent (Doc.concat [Doc.line; printLongident longident2]); + Doc.indent (Doc.concat [Doc.line; print_longident longident2]); ] -and printSignature ~state signature cmtTbl = +and print_signature ~state signature cmt_tbl = match signature with - | [] -> printCommentsInsideFile cmtTbl + | [] -> print_comments_inside_file cmt_tbl | signature -> - printList - ~getLoc:(fun s -> s.Parsetree.psig_loc) + print_list + ~get_loc:(fun s -> s.Parsetree.psig_loc) ~nodes:signature - ~print:(printSignatureItem ~state) - cmtTbl + ~print:(print_signature_item ~state) + cmt_tbl -and printSignatureItem ~state (si : Parsetree.signature_item) cmtTbl = +and print_signature_item ~state (si : Parsetree.signature_item) cmt_tbl = match si.psig_desc with - | Parsetree.Psig_value valueDescription -> - printValueDescription ~state valueDescription cmtTbl - | Psig_type (recFlag, typeDeclarations) -> - let recFlag = - match recFlag 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 | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - 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 + 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 | Psig_attribute attr -> - fst (printAttribute ~state ~standalone:true attr cmtTbl) + fst (print_attribute ~state ~standalone:true attr cmt_tbl) | Psig_extension (extension, attrs) -> Doc.concat [ - printAttributes ~state attrs cmtTbl; - Doc.concat [printExtension ~state ~atModuleLvl:true extension cmtTbl]; + print_attributes ~state attrs cmt_tbl; + Doc.concat [print_extension ~state ~at_module_lvl:true extension cmt_tbl]; ] | Psig_class _ | Psig_class_type _ -> Doc.nil -and printRecModuleDeclarations ~state moduleDeclarations cmtTbl = - printListi - ~getLoc:(fun n -> n.Parsetree.pmd_loc) - ~nodes:moduleDeclarations - ~print:(printRecModuleDeclaration ~state) - cmtTbl +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 printRecModuleDeclaration ~state md cmtTbl i = +and print_rec_module_declaration ~state md cmt_tbl i = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> - Doc.concat [Doc.text " = "; printLongidentLocation longident cmtTbl] + Doc.concat [Doc.text " = "; print_longident_location longident cmt_tbl] | _ -> - let needsParens = + let needs_parens = match md.pmd_type.pmty_desc with | Pmty_with _ -> true | _ -> false in - let modTypeDoc = - let doc = printModType ~state md.pmd_type cmtTbl in - if needsParens then addParens doc else doc + 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 in - Doc.concat [Doc.text ": "; modTypeDoc] + Doc.concat [Doc.text ": "; mod_type_doc] in let prefix = if i < 1 then "module rec " else "and " in Doc.concat [ - printAttributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; + print_attributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmt_tbl; Doc.text prefix; - printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; + print_comments (Doc.text md.pmd_name.txt) cmt_tbl md.pmd_name.loc; body; ] -and printModuleDeclaration ~state (md : Parsetree.module_declaration) cmtTbl = +and print_module_declaration ~state (md : Parsetree.module_declaration) cmt_tbl = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> - Doc.concat [Doc.text " = "; printLongidentLocation longident cmtTbl] - | _ -> Doc.concat [Doc.text ": "; printModType ~state md.pmd_type cmtTbl] + Doc.concat [Doc.text " = "; print_longident_location longident cmt_tbl] + | _ -> Doc.concat [Doc.text ": "; print_mod_type ~state md.pmd_type cmt_tbl] in Doc.concat [ - printAttributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmtTbl; + print_attributes ~state ~loc:md.pmd_name.loc md.pmd_attributes cmt_tbl; Doc.text "module "; - printComments (Doc.text md.pmd_name.txt) cmtTbl md.pmd_name.loc; + print_comments (Doc.text md.pmd_name.txt) cmt_tbl md.pmd_name.loc; body; ] -and printOpenDescription ~state (openDescription : Parsetree.open_description) - cmtTbl = +and print_open_description ~state (open_description : Parsetree.open_description) + cmt_tbl = Doc.concat [ - printAttributes ~state openDescription.popen_attributes cmtTbl; + print_attributes ~state open_description.popen_attributes cmt_tbl; Doc.text "open"; - (match openDescription.popen_override with + (match open_description.popen_override with | Asttypes.Fresh -> Doc.space | Asttypes.Override -> Doc.text "! "); - printLongidentLocation openDescription.popen_lid cmtTbl; + print_longident_location open_description.popen_lid cmt_tbl; ] -and printIncludeDescription ~state - (includeDescription : Parsetree.include_description) cmtTbl = +and print_include_description ~state + (include_description : Parsetree.include_description) cmt_tbl = Doc.concat [ - printAttributes ~state includeDescription.pincl_attributes cmtTbl; + print_attributes ~state include_description.pincl_attributes cmt_tbl; Doc.text "include "; - printModType ~state includeDescription.pincl_mod cmtTbl; + print_mod_type ~state include_description.pincl_mod cmt_tbl; ] -and printIncludeDeclaration ~state - (includeDeclaration : Parsetree.include_declaration) cmtTbl = +and print_include_declaration ~state + (include_declaration : Parsetree.include_declaration) cmt_tbl = Doc.concat [ - printAttributes ~state includeDeclaration.pincl_attributes cmtTbl; + print_attributes ~state include_declaration.pincl_attributes cmt_tbl; Doc.text "include "; - (let includeDoc = - printModExpr ~state includeDeclaration.pincl_mod cmtTbl + (let include_doc = + print_mod_expr ~state include_declaration.pincl_mod cmt_tbl in - if Parens.includeModExpr includeDeclaration.pincl_mod then - addParens includeDoc - else includeDoc); + if Parens.include_mod_expr include_declaration.pincl_mod then + add_parens include_doc + else include_doc); ] -and printValueBindings ~state ~recFlag (vbs : Parsetree.value_binding list) - cmtTbl = - printListi - ~getLoc:(fun vb -> vb.Parsetree.pvb_loc) +and print_value_bindings ~state ~rec_flag (vbs : Parsetree.value_binding list) + cmt_tbl = + print_listi + ~get_loc:(fun vb -> vb.Parsetree.pvb_loc) ~nodes:vbs - ~print:(printValueBinding ~state ~recFlag) - cmtTbl + ~print:(print_value_binding ~state ~rec_flag) + cmt_tbl -and printValueDescription ~state valueDescription cmtTbl = - let isExternal = - match valueDescription.pval_prim with +and print_value_description ~state value_description cmt_tbl = + let is_external = + match value_description.pval_prim with | [] -> false | _ -> true in let attrs = - printAttributes ~state ~loc:valueDescription.pval_name.loc - valueDescription.pval_attributes cmtTbl + print_attributes ~state ~loc:value_description.pval_name.loc + value_description.pval_attributes cmt_tbl in - let header = if isExternal then "external " else "let " in + let header = if is_external then "external " else "let " in Doc.group (Doc.concat [ attrs; Doc.text header; - printComments - (printIdentLike valueDescription.pval_name.txt) - cmtTbl valueDescription.pval_name.loc; + print_comments + (print_ident_like value_description.pval_name.txt) + cmt_tbl value_description.pval_name.loc; Doc.text ": "; - printTypExpr ~state valueDescription.pval_type cmtTbl; - (if isExternal then + print_typ_expr ~state value_description.pval_type cmt_tbl; + (if is_external then Doc.group (Doc.concat [ @@ -1080,18 +1080,18 @@ and printValueDescription ~state valueDescription cmtTbl = (fun s -> Doc.concat [Doc.text "\""; Doc.text s; Doc.text "\""]) - valueDescription.pval_prim); + value_description.pval_prim); ]); ]) else Doc.nil); ]) -and printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl = - printListi - ~getLoc:(fun n -> n.Parsetree.ptype_loc) - ~nodes:typeDeclarations - ~print:(printTypeDeclaration2 ~state ~recFlag) - cmtTbl +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 (* * type_declaration = { @@ -1125,17 +1125,17 @@ and printTypeDeclarations ~state ~recFlag typeDeclarations cmtTbl = * (* Invariant: non-empty list *) * | Ptype_open *) -and printTypeDeclaration ~state ~name ~equalSign ~recFlag i - (td : Parsetree.type_declaration) cmtTbl = +and print_type_declaration ~state ~name ~equal_sign ~rec_flag i + (td : Parsetree.type_declaration) cmt_tbl = let attrs = - printAttributes ~state ~loc:td.ptype_loc td.ptype_attributes cmtTbl + print_attributes ~state ~loc:td.ptype_loc td.ptype_attributes cmt_tbl in let prefix = - if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; recFlag] + if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; rec_flag] in - let typeName = name in - let typeParams = printTypeParams ~state td.ptype_params cmtTbl in - let manifestAndKind = + let type_name = name in + let type_params = print_type_params ~state td.ptype_params cmt_tbl in + let manifest_and_kind = match td.ptype_kind with | Ptype_abstract -> ( match td.ptype_manifest with @@ -1143,15 +1143,15 @@ and printTypeDeclaration ~state ~name ~equalSign ~recFlag i | Some typ -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; - printTypExpr ~state typ cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; + print_typ_expr ~state typ cmt_tbl; ]) | Ptype_open -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; Doc.text ".."; ] | Ptype_record lds -> @@ -1161,16 +1161,16 @@ and printTypeDeclaration ~state ~name ~equalSign ~recFlag i | Some typ -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~state typ cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_typ_expr ~state typ cmt_tbl; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; - printRecordDeclaration ~state lds cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; + print_record_declaration ~state lds cmt_tbl; ] | Ptype_variant cds -> let manifest = @@ -1179,39 +1179,39 @@ and printTypeDeclaration ~state ~name ~equalSign ~recFlag i | Some typ -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~state typ cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_typ_expr ~state typ cmt_tbl; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~state ~privateFlag:td.ptype_private cds - cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign]; + print_constructor_declarations ~state ~private_flag:td.ptype_private cds + cmt_tbl; ] in - let constraints = printTypeDefinitionConstraints ~state td.ptype_cstrs in + let constraints = print_type_definition_constraints ~state td.ptype_cstrs in Doc.group (Doc.concat - [attrs; prefix; typeName; typeParams; manifestAndKind; constraints]) + [attrs; prefix; type_name; type_params; manifest_and_kind; constraints]) -and printTypeDeclaration2 ~state ~recFlag (td : Parsetree.type_declaration) - cmtTbl i = +and print_type_declaration2 ~state ~rec_flag (td : Parsetree.type_declaration) + cmt_tbl i = let name = - let doc = printIdentLike td.Parsetree.ptype_name.txt in - printComments doc cmtTbl td.ptype_name.loc + let doc = print_ident_like td.Parsetree.ptype_name.txt in + print_comments doc cmt_tbl td.ptype_name.loc in - let equalSign = "=" in + let equal_sign = "=" in let attrs = - printAttributes ~state ~loc:td.ptype_loc td.ptype_attributes cmtTbl + print_attributes ~state ~loc:td.ptype_loc td.ptype_attributes cmt_tbl in let prefix = - if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; recFlag] + if i > 0 then Doc.text "and " else Doc.concat [Doc.text "type "; rec_flag] in - let typeName = name in - let typeParams = printTypeParams ~state td.ptype_params cmtTbl in - let manifestAndKind = + let type_name = name in + let type_params = print_type_params ~state td.ptype_params cmt_tbl in + let manifest_and_kind = match td.ptype_kind with | Ptype_abstract -> ( match td.ptype_manifest with @@ -1219,15 +1219,15 @@ and printTypeDeclaration2 ~state ~recFlag (td : Parsetree.type_declaration) | Some typ -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; - printTypExpr ~state typ cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; + print_typ_expr ~state typ cmt_tbl; ]) | Ptype_open -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; Doc.text ".."; ] | Ptype_record lds -> @@ -1235,10 +1235,10 @@ and printTypeDeclaration2 ~state ~recFlag (td : Parsetree.type_declaration) Doc.concat [ Doc.space; - Doc.text equalSign; + Doc.text equal_sign; Doc.space; Doc.lbrace; - printCommentsInside cmtTbl td.ptype_loc; + print_comments_inside cmt_tbl td.ptype_loc; Doc.rbrace; ] else @@ -1248,16 +1248,16 @@ and printTypeDeclaration2 ~state ~recFlag (td : Parsetree.type_declaration) | Some typ -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~state typ cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_typ_expr ~state typ cmt_tbl; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printPrivateFlag td.ptype_private; - printRecordDeclaration ~state lds cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_private_flag td.ptype_private; + print_record_declaration ~state lds cmt_tbl; ] | Ptype_variant cds -> let manifest = @@ -1266,24 +1266,24 @@ and printTypeDeclaration2 ~state ~recFlag (td : Parsetree.type_declaration) | Some typ -> Doc.concat [ - Doc.concat [Doc.space; Doc.text equalSign; Doc.space]; - printTypExpr ~state typ cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign; Doc.space]; + print_typ_expr ~state typ cmt_tbl; ] in Doc.concat [ manifest; - Doc.concat [Doc.space; Doc.text equalSign]; - printConstructorDeclarations ~state ~privateFlag:td.ptype_private cds - cmtTbl; + Doc.concat [Doc.space; Doc.text equal_sign]; + print_constructor_declarations ~state ~private_flag:td.ptype_private cds + cmt_tbl; ] in - let constraints = printTypeDefinitionConstraints ~state td.ptype_cstrs in + let constraints = print_type_definition_constraints ~state td.ptype_cstrs in Doc.group (Doc.concat - [attrs; prefix; typeName; typeParams; manifestAndKind; constraints]) + [attrs; prefix; type_name; type_params; manifest_and_kind; constraints]) -and printTypeDefinitionConstraints ~state cstrs = +and print_type_definition_constraints ~state cstrs = match cstrs with | [] -> Doc.nil | cstrs -> @@ -1294,137 +1294,137 @@ and printTypeDefinitionConstraints ~state cstrs = Doc.line; Doc.group (Doc.join ~sep:Doc.line - (List.map (printTypeDefinitionConstraint ~state) cstrs)); + (List.map (print_type_definition_constraint ~state) cstrs)); ])) -and printTypeDefinitionConstraint ~state +and print_type_definition_constraint ~state ((typ1, typ2, _loc) : Parsetree.core_type * Parsetree.core_type * Location.t) = Doc.concat [ Doc.text "constraint "; - printTypExpr ~state typ1 CommentTable.empty; + print_typ_expr ~state typ1 CommentTable.empty; Doc.text " = "; - printTypExpr ~state typ2 CommentTable.empty; + print_typ_expr ~state typ2 CommentTable.empty; ] -and printPrivateFlag (flag : Asttypes.private_flag) = +and print_private_flag (flag : Asttypes.private_flag) = match flag with | Private -> Doc.text "private " | Public -> Doc.nil -and printTypeParams ~state typeParams cmtTbl = - match typeParams with +and print_type_params ~state type_params cmt_tbl = + match type_params with | [] -> Doc.nil - | typeParams -> + | type_params -> Doc.group (Doc.concat [ - Doc.lessThan; + Doc.less_than; Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typeParam -> - let doc = printTypeParam ~state typeParam cmtTbl in - printComments doc cmtTbl - (fst typeParam).Parsetree.ptyp_loc) - typeParams); + (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); ]); - Doc.trailingComma; - Doc.softLine; - Doc.greaterThan; + Doc.trailing_comma; + Doc.soft_line; + Doc.greater_than; ]) -and printTypeParam ~state (param : Parsetree.core_type * Asttypes.variance) - cmtTbl = +and print_type_param ~state (param : Parsetree.core_type * Asttypes.variance) + cmt_tbl = let typ, variance = param in - let printedVariance = + let printed_variance = match variance with | Covariant -> Doc.text "+" | Contravariant -> Doc.text "-" | Invariant -> Doc.nil in - Doc.concat [printedVariance; printTypExpr ~state typ cmtTbl] + Doc.concat [printed_variance; print_typ_expr ~state typ cmt_tbl] -and printRecordDeclaration ~state (lds : Parsetree.label_declaration list) - cmtTbl = - let forceBreak = +and print_record_declaration ~state (lds : Parsetree.label_declaration list) + cmt_tbl = + let force_break = 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.breakableGroup ~forceBreak + Doc.breakable_group ~force_break (Doc.concat [ Doc.lbrace; Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = printLabelDeclaration ~state ld cmtTbl in - printComments doc cmtTbl ld.Parsetree.pld_loc) + let doc = print_label_declaration ~state ld cmt_tbl in + print_comments doc cmt_tbl ld.Parsetree.pld_loc) lds); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ]) -and printConstructorDeclarations ~state ~privateFlag - (cds : Parsetree.constructor_declaration list) cmtTbl = - let forceBreak = +and print_constructor_declarations ~state ~private_flag + (cds : Parsetree.constructor_declaration list) cmt_tbl = + let force_break = 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 privateFlag = - match privateFlag with + let private_flag = + match private_flag with | Asttypes.Private -> Doc.concat [Doc.text "private"; Doc.line] | Public -> Doc.nil in let rows = - printListi - ~getLoc:(fun cd -> cd.Parsetree.pcd_loc) + print_listi + ~get_loc:(fun cd -> cd.Parsetree.pcd_loc) ~nodes:cds - ~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 + ~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 let bar = - if i > 0 || cd.pcd_attributes <> [] || isDotDotDot then Doc.text "| " - else Doc.ifBreaks (Doc.text "| ") Doc.nil + if i > 0 || cd.pcd_attributes <> [] || is_dot_dot_dot then Doc.text "| " + else Doc.if_breaks (Doc.text "| ") Doc.nil in - let constrName = + let constr_name = let doc = Doc.text cd.pcd_name.txt in - printComments doc cmtTbl cd.pcd_name.loc + print_comments doc cmt_tbl cd.pcd_name.loc in - let constrArgs = - printConstructorArguments ~isDotDotDot ~state ~indent:true cd.pcd_args - cmtTbl + let constr_args = + print_constructor_arguments ~is_dot_dot_dot ~state ~indent:true cd.pcd_args + cmt_tbl in let gadt = match cd.pcd_res with | None -> Doc.nil | Some typ -> - Doc.indent (Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl]) + Doc.indent (Doc.concat [Doc.text ": "; print_typ_expr ~state typ cmt_tbl]) in Doc.concat [ @@ -1434,34 +1434,34 @@ and printConstructorDeclaration2 ~state i [ attrs; (* TODO: fix parsing of attributes, so when can print them above the bar? *) - constrName; - constrArgs; + constr_name; + constr_args; gadt; ]); ] -and printConstructorArguments ?(isDotDotDot = false) ~state ~indent - (cdArgs : Parsetree.constructor_arguments) cmtTbl = - match cdArgs with +and print_constructor_arguments ?(is_dot_dot_dot = false) ~state ~indent + (cd_args : Parsetree.constructor_arguments) cmt_tbl = + match cd_args with | Pcstr_tuple [] -> Doc.nil | Pcstr_tuple types -> let args = Doc.concat [ - (if isDotDotDot then Doc.nil else Doc.lparen); + (if is_dot_dot_dot then Doc.nil else Doc.lparen); Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> printTypExpr ~state typexpr cmtTbl) + (fun typexpr -> print_typ_expr ~state typexpr cmt_tbl) types); ]); - Doc.trailingComma; - Doc.softLine; - (if isDotDotDot then Doc.nil else Doc.rparen); + Doc.trailing_comma; + Doc.soft_line; + (if is_dot_dot_dot then Doc.nil else Doc.rparen); ] in Doc.group (if indent then Doc.indent args else args) @@ -1475,88 +1475,88 @@ and printConstructorArguments ?(isDotDotDot = false) ~state ~indent Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun ld -> - let doc = printLabelDeclaration ~state ld cmtTbl in - printComments doc cmtTbl ld.Parsetree.pld_loc) + let doc = print_label_declaration ~state ld cmt_tbl in + print_comments doc cmt_tbl ld.Parsetree.pld_loc) lds); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; Doc.rparen; ] in if indent then Doc.indent args else args -and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl = +and print_label_declaration ~state (ld : Parsetree.label_declaration) cmt_tbl = let attrs = - printAttributes ~state ~loc:ld.pld_name.loc ld.pld_attributes cmtTbl + print_attributes ~state ~loc:ld.pld_name.loc ld.pld_attributes cmt_tbl in - let mutableFlag = + let mutable_flag = match ld.pld_mutable with | Mutable -> Doc.text "mutable " | Immutable -> Doc.nil in - let name, isDot = - let doc, isDot = + let name, is_dot = + let doc, is_dot = if ld.pld_name.txt = "..." then (Doc.text ld.pld_name.txt, true) - else (printIdentLike ld.pld_name.txt, false) + else (print_ident_like ld.pld_name.txt, false) in - (printComments doc cmtTbl ld.pld_name.loc, isDot) + (print_comments doc cmt_tbl ld.pld_name.loc, is_dot) in - let optional = printOptionalLabel ld.pld_attributes in + let optional = print_optional_label ld.pld_attributes in Doc.group (Doc.concat [ attrs; - mutableFlag; + mutable_flag; name; optional; - (if isDot then Doc.nil else Doc.text ": "); - printTypExpr ~state ld.pld_type cmtTbl; + (if is_dot then Doc.nil else Doc.text ": "); + print_typ_expr ~state ld.pld_type cmt_tbl; ]) -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 +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 in - let dotted, attrsBefore = + let dotted, attrs_before = let dotted = - state.uncurried_config |> Res_uncurried.getDotted ~uncurried + state.uncurried_config |> Res_uncurried.get_dotted ~uncurried in (* Converting .ml code to .res requires processing uncurried attributes *) - let hasBs, attrs = ParsetreeViewer.processBsAttribute attrsBefore in - (dotted || hasBs, attrs) + let has_bs, attrs = ParsetreeViewer.process_bs_attribute attrs_before in + (dotted || has_bs, attrs) in - let returnTypeNeedsParens = - match returnType.ptyp_desc with + let return_type_needs_parens = + match return_type.ptyp_desc with | Ptyp_alias _ -> true | _ -> false in - let returnDoc = - let doc = printTypExpr ~state returnType cmtTbl in - if returnTypeNeedsParens then Doc.concat [Doc.lparen; doc; Doc.rparen] + 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] else doc in match args with | [] -> Doc.nil | [([], Nolabel, n)] when not dotted -> - let hasAttrsBefore = not (attrsBefore = []) in + let has_attrs_before = not (attrs_before = []) in let attrs = - if hasAttrsBefore then - printAttributes ~state ~inline:true attrsBefore cmtTbl + if has_attrs_before then + print_attributes ~state ~inline:true attrs_before cmt_tbl else Doc.nil in - let typDoc = - let doc = printTypExpr ~state n cmtTbl in + let typ_doc = + let doc = print_typ_expr ~state n cmt_tbl in match n.ptyp_desc with - | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> addParens doc - | _ when Ast_uncurried.coreTypeIsUncurriedFun n -> addParens doc + | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> add_parens doc + | _ when Ast_uncurried.core_type_is_uncurried_fun n -> add_parens doc | _ -> doc in Doc.group @@ -1564,21 +1564,21 @@ and printTypExpr ~(state : State.t) (typExpr : Parsetree.core_type) cmtTbl = [ Doc.group attrs; Doc.group - (if hasAttrsBefore then + (if has_attrs_before then Doc.concat [ Doc.lparen; Doc.indent (Doc.concat - [Doc.softLine; typDoc; Doc.text " => "; returnDoc]); - Doc.softLine; + [Doc.soft_line; typ_doc; Doc.text " => "; return_doc]); + Doc.soft_line; Doc.rparen; ] - else Doc.concat [typDoc; Doc.text " => "; returnDoc]); + else Doc.concat [typ_doc; Doc.text " => "; return_doc]); ]) | args -> - let attrs = printAttributes ~state ~inline:true attrsBefore cmtTbl in - let renderedArgs = + let attrs = print_attributes ~state ~inline:true attrs_before cmt_tbl in + let rendered_args = Doc.concat [ attrs; @@ -1586,143 +1586,143 @@ and printTypExpr ~(state : State.t) (typExpr : Parsetree.core_type) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; (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 -> printTypeParameter ~state tp cmtTbl) + (fun tp -> print_type_parameter ~state tp cmt_tbl) args); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.text ")"; ] in - Doc.group (Doc.concat [renderedArgs; Doc.text " => "; returnDoc]) + Doc.group (Doc.concat [rendered_args; Doc.text " => "; return_doc]) in - let renderedType = - match typExpr.ptyp_desc with + let rendered_type = + match typ_expr.ptyp_desc with | Ptyp_any -> Doc.text "_" | Ptyp_var var -> - Doc.concat [Doc.text "'"; printIdentLike ~allowUident:true var] + Doc.concat [Doc.text "'"; print_ident_like ~allow_uident:true var] | Ptyp_extension extension -> - printExtension ~state ~atModuleLvl:false extension cmtTbl + print_extension ~state ~at_module_lvl:false extension cmt_tbl | 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 needsParens = + let needs_parens = match typ.ptyp_desc with | Ptyp_arrow _ -> true - | _ when Ast_uncurried.coreTypeIsUncurriedFun typ -> true + | _ when Ast_uncurried.core_type_is_uncurried_fun typ -> true | _ -> false in - let doc = printTypExpr ~state typ cmtTbl in - if needsParens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc + let doc = print_typ_expr ~state typ cmt_tbl in + if needs_parens then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in Doc.concat - [typ; Doc.text " as "; Doc.concat [Doc.text "'"; printIdentLike alias]] + [typ; Doc.text " as "; Doc.concat [Doc.text "'"; print_ident_like alias]] (* object printings *) - | 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)}]) + | 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)}]) -> (* for foo<{"a": b}>, when the object is long and needs a line break, we want the <{ and }> to stay hugged together *) - let constrName = printLidentPath longidentLoc cmtTbl in + let constr_name = print_lident_path longident_loc cmt_tbl in Doc.concat [ - constrName; - Doc.lessThan; - printObject ~state ~inline:true fields openFlag cmtTbl; - Doc.greaterThan; + constr_name; + Doc.less_than; + print_object ~state ~inline:true fields open_flag cmt_tbl; + Doc.greater_than; ] - | Ptyp_constr (longidentLoc, [{ptyp_desc = Parsetree.Ptyp_tuple tuple}]) -> - let constrName = printLidentPath longidentLoc cmtTbl in + | Ptyp_constr (longident_loc, [{ptyp_desc = Parsetree.Ptyp_tuple tuple}]) -> + let constr_name = print_lident_path longident_loc cmt_tbl in Doc.group (Doc.concat [ - constrName; - Doc.lessThan; - printTupleType ~state ~inline:true tuple cmtTbl; - Doc.greaterThan; + constr_name; + Doc.less_than; + print_tuple_type ~state ~inline:true tuple cmt_tbl; + Doc.greater_than; ]) - | Ptyp_constr (longidentLoc, constrArgs) -> ( - let constrName = printLidentPath longidentLoc cmtTbl in - match constrArgs with - | [] -> constrName + | Ptyp_constr (longident_loc, constr_args) -> ( + let constr_name = print_lident_path longident_loc cmt_tbl in + match constr_args with + | [] -> constr_name | _args -> Doc.group (Doc.concat [ - constrName; - Doc.lessThan; + constr_name; + Doc.less_than; Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> printTypExpr ~state typexpr cmtTbl) - constrArgs); + (fun typexpr -> print_typ_expr ~state typexpr cmt_tbl) + constr_args); ]); - Doc.trailingComma; - Doc.softLine; - Doc.greaterThan; + Doc.trailing_comma; + Doc.soft_line; + Doc.greater_than; ])) - | Ptyp_tuple types -> printTupleType ~state ~inline:false types cmtTbl - | Ptyp_poly ([], typ) -> printTypExpr ~state typ cmtTbl - | Ptyp_poly (stringLocs, typ) -> + | 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) -> Doc.concat [ Doc.join ~sep:Doc.space (List.map (fun {Location.txt; loc} -> let doc = Doc.concat [Doc.text "'"; Doc.text txt] in - printComments doc cmtTbl loc) - stringLocs); + print_comments doc cmt_tbl loc) + string_locs); Doc.dot; Doc.space; - printTypExpr ~state typ cmtTbl; + print_typ_expr ~state typ cmt_tbl; ] - | Ptyp_package packageType -> - printPackageType ~state ~printModuleKeywordAndParens:true packageType - cmtTbl + | Ptyp_package package_type -> + print_package_type ~state ~print_module_keyword_and_parens:true package_type + cmt_tbl | Ptyp_class _ -> Doc.text "classes are not supported in types" - | Ptyp_variant (rowFields, closedFlag, labelsOpt) -> - let forceBreak = - typExpr.ptyp_loc.Location.loc_start.pos_lnum - < typExpr.ptyp_loc.loc_end.pos_lnum + | 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 in - let printRowField = function + let print_row_field = function | Parsetree.Rtag ({txt; loc}, attrs, true, []) -> let doc = Doc.group (Doc.concat [ - printAttributes ~state attrs cmtTbl; - Doc.concat [Doc.text "#"; printPolyVarIdent txt]; + print_attributes ~state attrs cmt_tbl; + Doc.concat [Doc.text "#"; print_poly_var_ident txt]; ]) in - printComments doc cmtTbl loc + print_comments doc cmt_tbl loc | Rtag ({txt}, attrs, truth, types) -> - let doType t = + let do_type t = match t.Parsetree.ptyp_desc with - | Ptyp_tuple _ -> printTypExpr ~state t cmtTbl + | Ptyp_tuple _ -> print_typ_expr ~state t cmt_tbl | _ -> - Doc.concat [Doc.lparen; printTypExpr ~state t cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; print_typ_expr ~state t cmt_tbl; Doc.rparen] in - let printedTypes = List.map doType types in + let printed_types = List.map do_type types in let cases = - Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "& "]) printedTypes + Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "& "]) printed_types in let cases = if truth then Doc.concat [Doc.line; Doc.text "& "; cases] else cases @@ -1730,69 +1730,69 @@ and printTypExpr ~(state : State.t) (typExpr : Parsetree.core_type) cmtTbl = Doc.group (Doc.concat [ - printAttributes ~state attrs cmtTbl; - Doc.concat [Doc.text "#"; printPolyVarIdent txt]; + print_attributes ~state attrs cmt_tbl; + Doc.concat [Doc.text "#"; print_poly_var_ident txt]; cases; ]) - | Rinherit coreType -> printTypExpr ~state coreType cmtTbl + | Rinherit core_type -> print_typ_expr ~state core_type cmt_tbl in - let docs = List.map printRowField rowFields in + let docs = List.map print_row_field row_fields in let cases = Doc.join ~sep:(Doc.concat [Doc.line; Doc.text "| "]) docs in let cases = if docs = [] then cases - else Doc.concat [Doc.ifBreaks (Doc.text "| ") Doc.nil; cases] + else Doc.concat [Doc.if_breaks (Doc.text "| ") Doc.nil; cases] in - 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] + 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] in let labels = - match labelsOpt with + match labels_opt with | None | Some [] -> Doc.nil | Some labels -> Doc.concat (List.map (fun label -> - Doc.concat [Doc.line; Doc.text "#"; printPolyVarIdent label]) + Doc.concat [Doc.line; Doc.text "#"; print_poly_var_ident label]) labels) in - let closingSymbol = - match labelsOpt with + let closing_symbol = + match labels_opt with | None | Some [] -> Doc.nil | _ -> Doc.text " >" in - Doc.breakableGroup ~forceBreak + Doc.breakable_group ~force_break (Doc.concat [ Doc.lbracket; Doc.indent - (Doc.concat [openingSymbol; cases; closingSymbol; labels]); - Doc.softLine; + (Doc.concat [opening_symbol; cases; closing_symbol; labels]); + Doc.soft_line; Doc.rbracket; ]) in - let shouldPrintItsOwnAttributes = - match typExpr.ptyp_desc with + let should_print_its_own_attributes = + match typ_expr.ptyp_desc with | Ptyp_arrow _ (* es6 arrow types print their own attributes *) -> true | _ -> false in let doc = - match typExpr.ptyp_attributes with - | _ :: _ as attrs when not shouldPrintItsOwnAttributes -> - Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; renderedType]) - | _ -> renderedType + 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 in - printComments doc cmtTbl typExpr.ptyp_loc + print_comments doc cmt_tbl typ_expr.ptyp_loc -and printObject ~state ~inline fields openFlag cmtTbl = +and print_object ~state ~inline fields open_flag cmt_tbl = let doc = match fields with | [] -> Doc.concat [ Doc.lbrace; - (match openFlag with + (match open_flag with | Asttypes.Closed -> Doc.dot | Open -> Doc.dotdot); Doc.rbrace; @@ -1801,7 +1801,7 @@ and printObject ~state ~inline fields openFlag cmtTbl = Doc.concat [ Doc.lbrace; - (match openFlag with + (match open_flag with | Asttypes.Closed -> Doc.nil | Open -> ( match fields with @@ -1812,21 +1812,21 @@ and printObject ~state ~inline fields openFlag cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun field -> printObjectField ~state field cmtTbl) + (fun field -> print_object_field ~state field cmt_tbl) fields); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ] in if inline then doc else Doc.group doc -and printTupleType ~state ~inline (types : Parsetree.core_type list) cmtTbl = +and print_tuple_type ~state ~inline (types : Parsetree.core_type list) cmt_tbl = let tuple = Doc.concat [ @@ -1834,58 +1834,58 @@ and printTupleType ~state ~inline (types : Parsetree.core_type list) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> printTypExpr ~state typexpr cmtTbl) + (fun typexpr -> print_typ_expr ~state typexpr cmt_tbl) types); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] in if inline == false then Doc.group tuple else tuple -and printObjectField ~state (field : Parsetree.object_field) cmtTbl = +and print_object_field ~state (field : Parsetree.object_field) cmt_tbl = match field with - | Otag (labelLoc, attrs, typ) -> + | Otag (label_loc, attrs, typ) -> let lbl = - let doc = Doc.text ("\"" ^ labelLoc.txt ^ "\"") in - printComments doc cmtTbl labelLoc.loc + let doc = Doc.text ("\"" ^ label_loc.txt ^ "\"") in + print_comments doc cmt_tbl label_loc.loc in let doc = Doc.concat [ - printAttributes ~state ~loc:labelLoc.loc attrs cmtTbl; + print_attributes ~state ~loc:label_loc.loc attrs cmt_tbl; lbl; Doc.text ": "; - printTypExpr ~state typ cmtTbl; + print_typ_expr ~state typ cmt_tbl; ] in - let cmtLoc = {labelLoc.loc with loc_end = typ.ptyp_loc.loc_end} in - printComments doc cmtTbl cmtLoc + let cmt_loc = {label_loc.loc with loc_end = typ.ptyp_loc.loc_end} in + print_comments doc cmt_tbl cmt_loc | Oinherit typexpr -> - Doc.concat [Doc.dotdotdot; printTypExpr ~state typexpr cmtTbl] + Doc.concat [Doc.dotdotdot; print_typ_expr ~state typexpr cmt_tbl] (* es6 arrow type arg * type t = (~foo: string, ~bar: float=?, unit) => unit * i.e. ~foo: string, ~bar: float *) -and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = +and print_type_parameter ~state (attrs, lbl, typ) cmt_tbl = (* Converting .ml code to .res requires processing uncurried attributes *) - 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 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 label = match lbl with | Asttypes.Nolabel -> Doc.nil | Labelled lbl -> - Doc.concat [Doc.text "~"; printIdentLike lbl; Doc.text ": "] + Doc.concat [Doc.text "~"; print_ident_like lbl; Doc.text ": "] | Optional lbl -> - Doc.concat [Doc.text "~"; printIdentLike lbl; Doc.text ": "] + Doc.concat [Doc.text "~"; print_ident_like lbl; Doc.text ": "] in - let optionalIndicator = + let optional_indicator = match lbl with | Asttypes.Nolabel | Labelled _ -> Doc.nil | Optional _lbl -> Doc.text "=?" @@ -1904,32 +1904,32 @@ and printTypeParameter ~state (attrs, lbl, typ) cmtTbl = dotted; attrs; label; - printTypExpr ~state typ cmtTbl; - optionalIndicator; + print_typ_expr ~state typ cmt_tbl; + optional_indicator; ]) in - printComments doc cmtTbl loc + print_comments doc cmt_tbl loc -and printValueBinding ~state ~recFlag (vb : Parsetree.value_binding) cmtTbl i = +and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl i = let attrs = - printAttributes ~state ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes cmtTbl + print_attributes ~state ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes cmt_tbl in let header = - if i == 0 then Doc.concat [Doc.text "let "; recFlag] else Doc.text "and " + if i == 0 then Doc.concat [Doc.text "let "; rec_flag] else Doc.text "and " in match vb with | { pvb_pat = { ppat_desc = - Ppat_constraint (pattern, ({ptyp_desc = Ptyp_poly _} as patTyp)); + Ppat_constraint (pattern, ({ptyp_desc = Ptyp_poly _} as pat_typ)); }; pvb_expr = {pexp_desc = Pexp_newtype _} as expr; } -> ( - let _uncurried, _attrs, parameters, returnExpr = - ParsetreeViewer.funExpr expr + let _uncurried, _attrs, parameters, return_expr = + ParsetreeViewer.fun_expr expr in - let abstractType = + let abstract_type = match parameters with | [NewTypes {locs = vars}] -> Doc.concat @@ -1941,25 +1941,25 @@ and printValueBinding ~state ~recFlag (vb : Parsetree.value_binding) cmtTbl i = ] | _ -> Doc.nil in - match returnExpr.pexp_desc with + match return_expr.pexp_desc with | Pexp_constraint (expr, typ) -> Doc.group (Doc.concat [ attrs; header; - printPattern ~state pattern cmtTbl; + print_pattern ~state pattern cmt_tbl; Doc.text ":"; Doc.indent (Doc.concat [ Doc.line; - abstractType; + abstract_type; Doc.space; - printTypExpr ~state typ cmtTbl; + print_typ_expr ~state typ cmt_tbl; Doc.text " ="; Doc.concat - [Doc.line; printExpressionWithComments ~state expr cmtTbl]; + [Doc.line; print_expression_with_comments ~state expr cmt_tbl]; ]); ]) | _ -> @@ -1972,30 +1972,30 @@ and printValueBinding ~state ~recFlag (vb : Parsetree.value_binding) cmtTbl i = [ attrs; header; - printPattern ~state pattern cmtTbl; + print_pattern ~state pattern cmt_tbl; Doc.text ":"; Doc.indent (Doc.concat [ Doc.line; - abstractType; + abstract_type; Doc.space; - printTypExpr ~state patTyp cmtTbl; + print_typ_expr ~state pat_typ cmt_tbl; Doc.text " ="; Doc.concat - [Doc.line; printExpressionWithComments ~state expr cmtTbl]; + [Doc.line; print_expression_with_comments ~state expr cmt_tbl]; ]); ])) | _ -> - let optBraces, expr = ParsetreeViewer.processBracesAttr vb.pvb_expr in - let printedExpr = - let doc = printExpressionWithComments ~state vb.pvb_expr cmtTbl in + 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 match Parens.expr vb.pvb_expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in - let patternDoc = printPattern ~state vb.pvb_pat cmtTbl in + let pattern_doc = print_pattern ~state vb.pvb_pat cmt_tbl in (* * we want to optimize the layout of one pipe: * let tbl = data->Js.Array2.reduce((map, curr) => { @@ -2008,77 +2008,77 @@ and printValueBinding ~state ~recFlag (vb : Parsetree.value_binding) cmtTbl i = * ->Belt.Array.map(...) * Multiple pipes chained together lend themselves more towards the last layout. *) - if ParsetreeViewer.isSinglePipeExpr vb.pvb_expr then - Doc.customLayout + if ParsetreeViewer.is_single_pipe_expr vb.pvb_expr then + Doc.custom_layout [ Doc.group (Doc.concat [ - attrs; header; patternDoc; Doc.text " ="; Doc.space; printedExpr; + attrs; header; pattern_doc; Doc.text " ="; Doc.space; printed_expr; ]); Doc.group (Doc.concat [ attrs; header; - patternDoc; + pattern_doc; Doc.text " ="; - Doc.indent (Doc.concat [Doc.line; printedExpr]); + Doc.indent (Doc.concat [Doc.line; printed_expr]); ]); ] else - let shouldIndent = - match optBraces with + let should_indent = + match opt_braces with | Some _ -> false | _ -> ( - ParsetreeViewer.isBinaryExpression expr + ParsetreeViewer.is_binary_expression expr || match vb.pvb_expr with | { pexp_attributes = [({Location.txt = "res.ternary"}, _)]; - pexp_desc = Pexp_ifthenelse (ifExpr, _, _); + pexp_desc = Pexp_ifthenelse (if_expr, _, _); } -> - ParsetreeViewer.isBinaryExpression ifExpr - || ParsetreeViewer.hasAttributes ifExpr.pexp_attributes + ParsetreeViewer.is_binary_expression if_expr + || ParsetreeViewer.has_attributes if_expr.pexp_attributes | {pexp_desc = Pexp_newtype _} -> false | {pexp_attributes = [({Location.txt = "res.taggedTemplate"}, _)]} -> false | e -> - ParsetreeViewer.hasAttributes e.pexp_attributes - || ParsetreeViewer.isArrayAccess e) + ParsetreeViewer.has_attributes e.pexp_attributes + || ParsetreeViewer.is_array_access e) in Doc.group (Doc.concat [ attrs; header; - patternDoc; + pattern_doc; Doc.text " ="; - (if shouldIndent then - Doc.indent (Doc.concat [Doc.line; printedExpr]) - else Doc.concat [Doc.space; printedExpr]); + (if should_indent then + Doc.indent (Doc.concat [Doc.line; printed_expr]) + else Doc.concat [Doc.space; printed_expr]); ]) -and printPackageType ~state ~printModuleKeywordAndParens - (packageType : Parsetree.package_type) cmtTbl = +and print_package_type ~state ~print_module_keyword_and_parens + (package_type : Parsetree.package_type) cmt_tbl = let doc = - match packageType with - | longidentLoc, [] -> - Doc.group (Doc.concat [printLongidentLocation longidentLoc cmtTbl]) - | longidentLoc, packageConstraints -> + match package_type with + | longident_loc, [] -> + Doc.group (Doc.concat [print_longident_location longident_loc cmt_tbl]) + | longident_loc, package_constraints -> Doc.group (Doc.concat [ - printLongidentLocation longidentLoc cmtTbl; - printPackageConstraints ~state packageConstraints cmtTbl; - Doc.softLine; + print_longident_location longident_loc cmt_tbl; + print_package_constraints ~state package_constraints cmt_tbl; + Doc.soft_line; ]) in - if printModuleKeywordAndParens then + if print_module_keyword_and_parens then Doc.concat [Doc.text "module("; doc; Doc.rparen] else doc -and printPackageConstraints ~state packageConstraints cmtTbl = +and print_package_constraints ~state package_constraints cmt_tbl = Doc.concat [ Doc.text " with"; @@ -2090,53 +2090,53 @@ and printPackageConstraints ~state packageConstraints cmtTbl = (List.mapi (fun i pc -> let longident, typexpr = pc in - let cmtLoc = + let cmt_loc = { longident.Asttypes.loc with loc_end = typexpr.Parsetree.ptyp_loc.loc_end; } in - let doc = printPackageConstraint ~state i cmtTbl pc in - printComments doc cmtTbl cmtLoc) - packageConstraints); + let doc = print_package_constraint ~state i cmt_tbl pc in + print_comments doc cmt_tbl cmt_loc) + package_constraints); ]); ] -and printPackageConstraint ~state i cmtTbl (longidentLoc, typ) = +and print_package_constraint ~state i cmt_tbl (longident_loc, typ) = let prefix = if i == 0 then Doc.text "type " else Doc.text "and type " in Doc.concat [ prefix; - printLongidentLocation longidentLoc cmtTbl; + print_longident_location longident_loc cmt_tbl; Doc.text " = "; - printTypExpr ~state typ cmtTbl; + print_typ_expr ~state typ cmt_tbl; ] -and printExtension ~state ~atModuleLvl (stringLoc, payload) cmtTbl = - let txt = stringLoc.Location.txt in - let extName = +and print_extension ~state ~at_module_lvl (string_loc, payload) cmt_tbl = + let txt = string_loc.Location.txt in + let ext_name = let doc = Doc.concat [ Doc.text "%"; - (if atModuleLvl then Doc.text "%" else Doc.nil); + (if at_module_lvl then Doc.text "%" else Doc.nil); Doc.text txt; ] in - printComments doc cmtTbl stringLoc.Location.loc + print_comments doc cmt_tbl string_loc.Location.loc in - Doc.group (Doc.concat [extName; printPayload ~state payload cmtTbl]) + Doc.group (Doc.concat [ext_name; print_payload ~state payload cmt_tbl]) -and printPattern ~state (p : Parsetree.pattern) cmtTbl = - let patternWithoutAttributes = +and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = + let pattern_without_attributes = match p.ppat_desc with | Ppat_any -> Doc.text "_" - | Ppat_var var -> printIdentLike var.txt + | Ppat_var var -> print_ident_like var.txt | Ppat_constant c -> - let templateLiteral = - ParsetreeViewer.hasTemplateLiteralAttr p.ppat_attributes + let template_literal = + ParsetreeViewer.has_template_literal_attr p.ppat_attributes in - printConstant ~templateLiteral c + print_constant ~template_literal c | Ppat_tuple patterns -> Doc.group (Doc.concat @@ -2145,20 +2145,20 @@ and printPattern ~state (p : Parsetree.pattern) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun pat -> printPattern ~state pat cmtTbl) + (fun pat -> print_pattern ~state pat cmt_tbl) patterns); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ]) | Ppat_array [] -> Doc.concat - [Doc.lbracket; printCommentsInside cmtTbl p.ppat_loc; Doc.rbracket] + [Doc.lbracket; print_comments_inside cmt_tbl p.ppat_loc; Doc.rbracket] | Ppat_array patterns -> Doc.group (Doc.concat @@ -2167,47 +2167,47 @@ and printPattern ~state (p : Parsetree.pattern) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun pat -> printPattern ~state pat cmtTbl) + (fun pat -> print_pattern ~state pat cmt_tbl) patterns); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.text "]"; ]) | Ppat_construct ({txt = Longident.Lident "()"}, _) -> - Doc.concat [Doc.lparen; printCommentsInside cmtTbl p.ppat_loc; Doc.rparen] + Doc.concat [Doc.lparen; print_comments_inside cmt_tbl p.ppat_loc; Doc.rparen] | Ppat_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat - [Doc.text "list{"; printCommentsInside cmtTbl p.ppat_loc; Doc.rbrace] + [Doc.text "list{"; print_comments_inside cmt_tbl p.ppat_loc; Doc.rbrace] | Ppat_construct ({txt = Longident.Lident "::"}, _) -> let patterns, tail = - ParsetreeViewer.collectPatternsFromListConstruct [] p + ParsetreeViewer.collect_patterns_from_list_construct [] p in - let shouldHug = + let should_hug = match (patterns, tail) with | [pat], {ppat_desc = Ppat_construct ({txt = Longident.Lident "[]"}, _)} - when ParsetreeViewer.isHuggablePattern pat -> + when ParsetreeViewer.is_huggable_pattern pat -> true | _ -> false in let children = Doc.concat [ - (if shouldHug then Doc.nil else Doc.softLine); + (if should_hug then Doc.nil else Doc.soft_line); Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map (fun pat -> printPattern ~state pat cmtTbl) patterns); + (List.map (fun pat -> print_pattern ~state pat cmt_tbl) patterns); (match tail.Parsetree.ppat_desc with | Ppat_construct ({txt = Longident.Lident "[]"}, _) -> Doc.nil | _ -> let doc = - Doc.concat [Doc.text "..."; printPattern ~state tail cmtTbl] + Doc.concat [Doc.text "..."; print_pattern ~state tail cmt_tbl] in - let tail = printComments doc cmtTbl tail.ppat_loc in + let tail = print_comments doc cmt_tbl tail.ppat_loc in Doc.concat [Doc.text ","; Doc.line; tail]); ] in @@ -2215,20 +2215,20 @@ and printPattern ~state (p : Parsetree.pattern) cmtTbl = (Doc.concat [ Doc.text "list{"; - (if shouldHug then children + (if should_hug then children else Doc.concat [ Doc.indent children; - Doc.ifBreaks (Doc.text ",") Doc.nil; - Doc.softLine; + Doc.if_breaks (Doc.text ",") Doc.nil; + Doc.soft_line; ]); Doc.rbrace; ]) - | Ppat_construct (constrName, constructorArgs) -> - let constrName = printLongidentLocation constrName cmtTbl in - let argsDoc = - match constructorArgs with + | Ppat_construct (constr_name, constructor_args) -> + let constr_name = print_longident_location constr_name cmt_tbl in + let args_doc = + match constructor_args with | None -> Doc.nil | Some { @@ -2236,12 +2236,12 @@ and printPattern ~state (p : Parsetree.pattern) cmtTbl = ppat_desc = Ppat_construct ({txt = Longident.Lident "()"}, _); } -> Doc.concat - [Doc.lparen; printCommentsInside cmtTbl ppat_loc; Doc.rparen] + [Doc.lparen; print_comments_inside cmt_tbl ppat_loc; Doc.rparen] | Some {ppat_desc = Ppat_tuple []; ppat_loc = loc} -> - Doc.concat [Doc.lparen; printCommentsInside cmtTbl loc; Doc.rparen] + Doc.concat [Doc.lparen; print_comments_inside cmt_tbl loc; Doc.rparen] (* Some((1, 2) *) | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} -> - Doc.concat [Doc.lparen; printPattern ~state arg cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; print_pattern ~state arg cmt_tbl; Doc.rparen] | Some {ppat_desc = Ppat_tuple patterns} -> Doc.concat [ @@ -2249,50 +2249,50 @@ and printPattern ~state (p : Parsetree.pattern) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun pat -> printPattern ~state pat cmtTbl) + (fun pat -> print_pattern ~state pat cmt_tbl) patterns); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] | Some arg -> - let argDoc = printPattern ~state arg cmtTbl in - let shouldHug = ParsetreeViewer.isHuggablePattern arg in + let arg_doc = print_pattern ~state arg cmt_tbl in + let should_hug = ParsetreeViewer.is_huggable_pattern arg in Doc.concat [ Doc.lparen; - (if shouldHug then argDoc + (if should_hug then arg_doc else Doc.concat [ - Doc.indent (Doc.concat [Doc.softLine; argDoc]); - Doc.trailingComma; - Doc.softLine; + Doc.indent (Doc.concat [Doc.soft_line; arg_doc]); + Doc.trailing_comma; + Doc.soft_line; ]); Doc.rparen; ] in - Doc.group (Doc.concat [constrName; argsDoc]) + Doc.group (Doc.concat [constr_name; args_doc]) | Ppat_variant (label, None) -> - Doc.concat [Doc.text "#"; printPolyVarIdent label] - | Ppat_variant (label, variantArgs) -> - let variantName = Doc.concat [Doc.text "#"; printPolyVarIdent label] in - let argsDoc = - match variantArgs with + 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 | 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; printCommentsInside cmtTbl loc; Doc.rparen] + Doc.concat [Doc.lparen; print_comments_inside cmt_tbl loc; Doc.rparen] (* Some((1, 2) *) | Some {ppat_desc = Ppat_tuple [({ppat_desc = Ppat_tuple _} as arg)]} -> - Doc.concat [Doc.lparen; printPattern ~state arg cmtTbl; Doc.rparen] + Doc.concat [Doc.lparen; print_pattern ~state arg cmt_tbl; Doc.rparen] | Some {ppat_desc = Ppat_tuple patterns} -> Doc.concat [ @@ -2300,38 +2300,38 @@ and printPattern ~state (p : Parsetree.pattern) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun pat -> printPattern ~state pat cmtTbl) + (fun pat -> print_pattern ~state pat cmt_tbl) patterns); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] | Some arg -> - let argDoc = printPattern ~state arg cmtTbl in - let shouldHug = ParsetreeViewer.isHuggablePattern arg in + let arg_doc = print_pattern ~state arg cmt_tbl in + let should_hug = ParsetreeViewer.is_huggable_pattern arg in Doc.concat [ Doc.lparen; - (if shouldHug then argDoc + (if should_hug then arg_doc else Doc.concat [ - Doc.indent (Doc.concat [Doc.softLine; argDoc]); - Doc.trailingComma; - Doc.softLine; + Doc.indent (Doc.concat [Doc.soft_line; arg_doc]); + Doc.trailing_comma; + Doc.soft_line; ]); Doc.rparen; ] in - Doc.group (Doc.concat [variantName; argsDoc]) + Doc.group (Doc.concat [variant_name; args_doc]) | Ppat_type ident -> - Doc.concat [Doc.text "#..."; printIdentPath ident cmtTbl] - | Ppat_record (rows, openFlag) -> + Doc.concat [Doc.text "#..."; print_ident_path ident cmt_tbl] + | Ppat_record (rows, open_flag) -> Doc.group (Doc.concat [ @@ -2339,126 +2339,126 @@ and printPattern ~state (p : Parsetree.pattern) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> printPatternRecordRow ~state row cmtTbl) + (fun row -> print_pattern_record_row ~state row cmt_tbl) rows); - (match openFlag with + (match open_flag with | Open -> Doc.concat [Doc.text ","; Doc.line; Doc.text "_"] | Closed -> Doc.nil); ]); - Doc.ifBreaks (Doc.text ",") Doc.nil; - Doc.softLine; + Doc.if_breaks (Doc.text ",") Doc.nil; + Doc.soft_line; Doc.rbrace; ]) | Ppat_exception p -> - let needsParens = + let needs_parens = match p.ppat_desc with | Ppat_or (_, _) | Ppat_alias (_, _) -> true | _ -> false in let pat = - let p = printPattern ~state p cmtTbl in - if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p + let p = print_pattern ~state p cmt_tbl in + if needs_parens 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 orChain = ParsetreeViewer.collectOrPatternChain p in + let or_chain = ParsetreeViewer.collect_or_pattern_chain p in let docs = List.mapi (fun i pat -> - let patternDoc = printPattern ~state pat cmtTbl in + let pattern_doc = print_pattern ~state pat cmt_tbl 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 _ -> addParens patternDoc - | _ -> patternDoc); + | Ppat_or _ -> add_parens pattern_doc + | _ -> pattern_doc); ]) - orChain + or_chain in - let isSpreadOverMultipleLines = - match (orChain, List.rev orChain) with + let is_spread_over_multiple_lines = + match (or_chain, List.rev or_chain) with | first :: _, last :: _ -> first.ppat_loc.loc_start.pos_lnum < last.ppat_loc.loc_end.pos_lnum | _ -> false in - Doc.breakableGroup ~forceBreak:isSpreadOverMultipleLines (Doc.concat docs) - | Ppat_extension ext -> printExtension ~state ~atModuleLvl:false ext cmtTbl + 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 | Ppat_lazy p -> - let needsParens = + let needs_parens = match p.ppat_desc with | Ppat_or (_, _) | Ppat_alias (_, _) -> true | _ -> false in let pat = - let p = printPattern ~state p cmtTbl in - if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p + let p = print_pattern ~state p cmt_tbl in + if needs_parens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p in Doc.concat [Doc.text "lazy "; pat] - | Ppat_alias (p, aliasLoc) -> - let needsParens = + | Ppat_alias (p, alias_loc) -> + let needs_parens = match p.ppat_desc with | Ppat_or (_, _) | Ppat_alias (_, _) -> true | _ -> false in - let renderedPattern = - let p = printPattern ~state p cmtTbl in - if needsParens then Doc.concat [Doc.text "("; p; Doc.text ")"] else p + 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 in Doc.concat - [renderedPattern; Doc.text " as "; printStringLoc aliasLoc cmtTbl] + [rendered_pattern; Doc.text " as "; print_string_loc alias_loc cmt_tbl] (* Note: module(P : S) is represented as *) (* Ppat_constraint(Ppat_unpack, Ptyp_package) *) | Ppat_constraint - ( {ppat_desc = Ppat_unpack stringLoc}, - {ptyp_desc = Ptyp_package packageType; ptyp_loc} ) -> + ( {ppat_desc = Ppat_unpack string_loc}, + {ptyp_desc = Ptyp_package package_type; ptyp_loc} ) -> Doc.concat [ Doc.text "module("; - printComments (Doc.text stringLoc.txt) cmtTbl stringLoc.loc; + print_comments (Doc.text string_loc.txt) cmt_tbl string_loc.loc; Doc.text ": "; - printComments - (printPackageType ~state ~printModuleKeywordAndParens:false - packageType cmtTbl) - cmtTbl ptyp_loc; + print_comments + (print_package_type ~state ~print_module_keyword_and_parens:false + package_type cmt_tbl) + cmt_tbl ptyp_loc; Doc.rparen; ] | Ppat_constraint (pattern, typ) -> Doc.concat [ - printPattern ~state pattern cmtTbl; + print_pattern ~state pattern cmt_tbl; Doc.text ": "; - printTypExpr ~state typ cmtTbl; + print_typ_expr ~state typ cmt_tbl; ] (* Note: module(P : S) is represented as *) (* Ppat_constraint(Ppat_unpack, Ptyp_package) *) - | Ppat_unpack stringLoc -> + | Ppat_unpack string_loc -> Doc.concat [ Doc.text "module("; - printComments (Doc.text stringLoc.txt) cmtTbl stringLoc.loc; + print_comments (Doc.text string_loc.txt) cmt_tbl string_loc.loc; Doc.rparen; ] | Ppat_interval (a, b) -> - Doc.concat [printConstant a; Doc.text " .. "; printConstant b] + Doc.concat [print_constant a; Doc.text " .. "; print_constant b] | Ppat_open _ -> Doc.nil in let doc = match p.ppat_attributes with - | [] -> patternWithoutAttributes + | [] -> pattern_without_attributes | attrs -> Doc.group (Doc.concat - [printAttributes ~state attrs cmtTbl; patternWithoutAttributes]) + [print_attributes ~state attrs cmt_tbl; pattern_without_attributes]) in - printComments doc cmtTbl p.ppat_loc + print_comments doc cmt_tbl p.ppat_loc -and printPatternRecordRow ~state row cmtTbl = +and print_pattern_record_row ~state row cmt_tbl = match row with (* punned {x}*) | ( ({Location.txt = Longident.Lident ident} as longident), @@ -2466,139 +2466,139 @@ and printPatternRecordRow ~state row cmtTbl = when ident = txt -> Doc.concat [ - printOptionalLabel ppat_attributes; - printAttributes ~state ppat_attributes cmtTbl; - printLidentPath longident cmtTbl; + print_optional_label ppat_attributes; + print_attributes ~state ppat_attributes cmt_tbl; + print_lident_path longident cmt_tbl; ] | longident, pattern -> - let locForComments = + let loc_for_comments = {longident.loc with loc_end = pattern.Parsetree.ppat_loc.loc_end} in - let rhsDoc = - let doc = printPattern ~state pattern cmtTbl in + let rhs_doc = + let doc = print_pattern ~state pattern cmt_tbl in let doc = - if Parens.patternRecordRowRhs pattern then addParens doc else doc + if Parens.pattern_record_row_rhs pattern then add_parens doc else doc in - Doc.concat [printOptionalLabel pattern.ppat_attributes; doc] + Doc.concat [print_optional_label pattern.ppat_attributes; doc] in let doc = Doc.group (Doc.concat [ - printLidentPath longident cmtTbl; + print_lident_path longident cmt_tbl; Doc.text ":"; - (if ParsetreeViewer.isHuggablePattern pattern then - Doc.concat [Doc.space; rhsDoc] - else Doc.indent (Doc.concat [Doc.line; rhsDoc])); + (if ParsetreeViewer.is_huggable_pattern pattern then + Doc.concat [Doc.space; rhs_doc] + else Doc.indent (Doc.concat [Doc.line; rhs_doc])); ]) in - printComments doc cmtTbl locForComments + print_comments doc cmt_tbl loc_for_comments -and printExpressionWithComments ~state expr cmtTbl : Doc.t = - let doc = printExpression ~state expr cmtTbl in - printComments doc cmtTbl expr.Parsetree.pexp_loc +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 printIfChain ~state pexp_attributes ifs elseExpr cmtTbl = - let ifDocs = +and print_if_chain ~state pexp_attributes ifs else_expr cmt_tbl = + let if_docs = Doc.join ~sep:Doc.space (List.mapi - (fun i (outerLoc, ifExpr, thenExpr) -> - let ifTxt = if i > 0 then Doc.text "else if " else Doc.text "if " in + (fun i (outer_loc, if_expr, then_expr) -> + let if_txt = if i > 0 then Doc.text "else if " else Doc.text "if " in let doc = - match ifExpr with - | ParsetreeViewer.If ifExpr -> + match if_expr with + | ParsetreeViewer.If if_expr -> let condition = - if ParsetreeViewer.isBlockExpr ifExpr then - printExpressionBlock ~state ~braces:true ifExpr cmtTbl + if ParsetreeViewer.is_block_expr if_expr then + print_expression_block ~state ~braces:true if_expr cmt_tbl else - 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 + 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 in Doc.concat [ - ifTxt; + if_txt; Doc.group condition; Doc.space; - (let thenExpr = - match ParsetreeViewer.processBracesAttr thenExpr with + (let then_expr = + match ParsetreeViewer.process_braces_attr then_expr with (* This case only happens when coming from Reason, we strip braces *) | Some _, expr -> expr - | _ -> thenExpr + | _ -> then_expr in - printExpressionBlock ~state ~braces:true thenExpr cmtTbl); + print_expression_block ~state ~braces:true then_expr cmt_tbl); ] - | IfLet (pattern, conditionExpr) -> - let conditionDoc = + | IfLet (pattern, condition_expr) -> + let condition_doc = let doc = - printExpressionWithComments ~state conditionExpr cmtTbl + print_expression_with_comments ~state condition_expr cmt_tbl in - match Parens.expr conditionExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc conditionExpr braces + match Parens.expr condition_expr with + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc condition_expr braces | Nothing -> doc in Doc.concat [ - ifTxt; + if_txt; Doc.text "let "; - printPattern ~state pattern cmtTbl; + print_pattern ~state pattern cmt_tbl; Doc.text " = "; - conditionDoc; + condition_doc; Doc.space; - printExpressionBlock ~state ~braces:true thenExpr cmtTbl; + print_expression_block ~state ~braces:true then_expr cmt_tbl; ] in - printLeadingComments doc cmtTbl.leading outerLoc) + print_leading_comments doc cmt_tbl.leading outer_loc) ifs) in - let elseDoc = - match elseExpr with + let else_doc = + match else_expr with | None -> Doc.nil | Some expr -> Doc.concat [ - Doc.text " else "; printExpressionBlock ~state ~braces:true expr cmtTbl; + Doc.text " else "; print_expression_block ~state ~braces:true expr cmt_tbl; ] in - let attrs = ParsetreeViewer.filterFragileMatchAttributes pexp_attributes in - Doc.concat [printAttributes ~state attrs cmtTbl; ifDocs; elseDoc] + let attrs = ParsetreeViewer.filter_fragile_match_attributes pexp_attributes in + Doc.concat [print_attributes ~state attrs cmt_tbl; if_docs; else_doc] -and printExpression ~state (e : Parsetree.expression) cmtTbl = - let printArrow e = - let uncurried, attrsOnArrow, parameters, returnExpr = - ParsetreeViewer.funExpr e +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 in let ParsetreeViewer.{async; bs; attributes = attrs} = - ParsetreeViewer.processFunctionAttributes attrsOnArrow + ParsetreeViewer.process_function_attributes attrs_on_arrow in let uncurried = uncurried || bs in - let returnExpr, typConstraint = - match returnExpr.pexp_desc with + let return_expr, typ_constraint = + match return_expr.pexp_desc with | Pexp_constraint (expr, typ) -> ( { expr with pexp_attributes = - List.concat [expr.pexp_attributes; returnExpr.pexp_attributes]; + List.concat [expr.pexp_attributes; return_expr.pexp_attributes]; }, Some typ ) - | _ -> (returnExpr, None) + | _ -> (return_expr, None) in - let hasConstraint = - match typConstraint with + let has_constraint = + match typ_constraint with | Some _ -> true | None -> false in - let parametersDoc = - printExprFunParameters ~state ~inCallback:NoCallback ~uncurried ~async - ~hasConstraint parameters cmtTbl + let parameters_doc = + print_expr_fun_parameters ~state ~in_callback:NoCallback ~uncurried ~async + ~has_constraint parameters cmt_tbl in - let returnExprDoc = - let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in - let shouldInline = - match (returnExpr.pexp_desc, optBraces) with + 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 | _, Some _ -> true | ( ( Pexp_array _ | Pexp_tuple _ | Pexp_construct (_, Some _) @@ -2607,46 +2607,46 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = true | _ -> false in - let shouldIndent = - match returnExpr.pexp_desc with + let should_indent = + match return_expr.pexp_desc with | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ -> false | _ -> true in - let returnDoc = - let doc = printExpressionWithComments ~state returnExpr cmtTbl in - match Parens.expr returnExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc returnExpr braces + 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 | Nothing -> doc in - if shouldInline then Doc.concat [Doc.space; returnDoc] + if should_inline then Doc.concat [Doc.space; return_doc] else Doc.group - (if shouldIndent then Doc.indent (Doc.concat [Doc.line; returnDoc]) - else Doc.concat [Doc.space; returnDoc]) + (if should_indent then Doc.indent (Doc.concat [Doc.line; return_doc]) + else Doc.concat [Doc.space; return_doc]) in - let typConstraintDoc = - match typConstraint with + let typ_constraint_doc = + match typ_constraint with | Some typ -> - let typDoc = - let doc = printTypExpr ~state typ cmtTbl in - if Parens.arrowReturnTypExpr typ then addParens doc else doc + 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 in - Doc.concat [Doc.text ": "; typDoc] + Doc.concat [Doc.text ": "; typ_doc] | _ -> Doc.nil in - let attrs = printAttributes ~state attrs cmtTbl in + let attrs = print_attributes ~state attrs cmt_tbl in Doc.group (Doc.concat - [attrs; parametersDoc; typConstraintDoc; Doc.text " =>"; returnExprDoc]) + [attrs; parameters_doc; typ_constraint_doc; Doc.text " =>"; return_expr_doc]) in - let uncurried = Ast_uncurried.exprIsUncurriedFun e in + let uncurried = Ast_uncurried.expr_is_uncurried_fun e in let e_fun = - if uncurried then Ast_uncurried.exprExtractUncurriedFun e else e + if uncurried then Ast_uncurried.expr_extract_uncurried_fun e else e in - let printedExpression = + let printed_expression = match e_fun.pexp_desc with | Pexp_fun ( Nolabel, @@ -2665,21 +2665,21 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = {pexp_desc = Pexp_apply _} ); } ) -> (* (__x) => f(a, __x, c) -----> f(a, _, c) *) - printExpressionWithComments ~state - (ParsetreeViewer.rewriteUnderscoreApply e_fun) - cmtTbl - | Pexp_fun _ | Pexp_newtype _ -> printArrow e + print_expression_with_comments ~state + (ParsetreeViewer.rewrite_underscore_apply e_fun) + cmt_tbl + | Pexp_fun _ | Pexp_newtype _ -> print_arrow e | Parsetree.Pexp_constant c -> - printConstant ~templateLiteral:(ParsetreeViewer.isTemplateLiteral e) c - | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> - printJsxFragment ~state e cmtTbl + 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 | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> Doc.concat - [Doc.text "list{"; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace] + [Doc.text "list{"; print_comments_inside cmt_tbl e.pexp_loc; Doc.rbrace] | Pexp_construct ({txt = Longident.Lident "::"}, _) -> - let expressions, spread = ParsetreeViewer.collectListExpressions e in - let spreadDoc = + let expressions, spread = ParsetreeViewer.collect_list_expressions e in + let spread_doc = match spread with | Some expr -> Doc.concat @@ -2687,10 +2687,10 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = Doc.text ","; Doc.line; Doc.dotdotdot; - (let doc = printExpressionWithComments ~state expr cmtTbl in + (let doc = print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc); ] | None -> Doc.nil @@ -2702,27 +2702,27 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> let doc = - printExpressionWithComments ~state expr cmtTbl + print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc) expressions); - spreadDoc; + spread_doc; ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ]) - | Pexp_construct (longidentLoc, args) -> - let constr = printLongidentLocation longidentLoc cmtTbl in + | Pexp_construct (longident_loc, args) -> + let constr = print_longident_location longident_loc cmt_tbl in let args = match args with | None -> Doc.nil @@ -2734,10 +2734,10 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.lparen; - (let doc = printExpressionWithComments ~state arg cmtTbl in + (let doc = print_expression_with_comments ~state arg cmt_tbl in match Parens.expr arg with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc arg braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc arg braces | Nothing -> doc); Doc.rparen; ] @@ -2748,49 +2748,49 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun expr -> let doc = - printExpressionWithComments ~state expr cmtTbl + print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc) args); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] | Some arg -> - let argDoc = - let doc = printExpressionWithComments ~state arg cmtTbl in + let arg_doc = + let doc = print_expression_with_comments ~state arg cmt_tbl in match Parens.expr arg with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc arg braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc arg braces | Nothing -> doc in - let shouldHug = ParsetreeViewer.isHuggableExpression arg in + let should_hug = ParsetreeViewer.is_huggable_expression arg in Doc.concat [ Doc.lparen; - (if shouldHug then argDoc + (if should_hug then arg_doc else Doc.concat [ - Doc.indent (Doc.concat [Doc.softLine; argDoc]); - Doc.trailingComma; - Doc.softLine; + Doc.indent (Doc.concat [Doc.soft_line; arg_doc]); + Doc.trailing_comma; + Doc.soft_line; ]); Doc.rparen; ] in Doc.group (Doc.concat [constr; args]) - | Pexp_ident path -> printLidentPath path cmtTbl + | Pexp_ident path -> print_lident_path path cmt_tbl | Pexp_tuple exprs -> Doc.group (Doc.concat @@ -2799,27 +2799,27 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> let doc = - printExpressionWithComments ~state expr cmtTbl + print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc) exprs); ]); - Doc.ifBreaks (Doc.text ",") Doc.nil; - Doc.softLine; + Doc.if_breaks (Doc.text ",") Doc.nil; + Doc.soft_line; Doc.rparen; ]) | Pexp_array [] -> Doc.concat - [Doc.lbracket; printCommentsInside cmtTbl e.pexp_loc; Doc.rbracket] + [Doc.lbracket; print_comments_inside cmt_tbl e.pexp_loc; Doc.rbracket] | Pexp_array exprs -> Doc.group (Doc.concat @@ -2828,26 +2828,26 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> let doc = - printExpressionWithComments ~state expr cmtTbl + print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc) exprs); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbracket; ]) | Pexp_variant (label, args) -> - let variantName = Doc.concat [Doc.text "#"; printPolyVarIdent label] in + let variant_name = Doc.concat [Doc.text "#"; print_poly_var_ident label] in let args = match args with | None -> Doc.nil @@ -2859,10 +2859,10 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = Doc.concat [ Doc.lparen; - (let doc = printExpressionWithComments ~state arg cmtTbl in + (let doc = print_expression_with_comments ~state arg cmt_tbl in match Parens.expr arg with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc arg braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc arg braces | Nothing -> doc); Doc.rparen; ] @@ -2873,75 +2873,75 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map (fun expr -> let doc = - printExpressionWithComments ~state expr cmtTbl + print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc) args); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ] | Some arg -> - let argDoc = - let doc = printExpressionWithComments ~state arg cmtTbl in + let arg_doc = + let doc = print_expression_with_comments ~state arg cmt_tbl in match Parens.expr arg with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc arg braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc arg braces | Nothing -> doc in - let shouldHug = ParsetreeViewer.isHuggableExpression arg in + let should_hug = ParsetreeViewer.is_huggable_expression arg in Doc.concat [ Doc.lparen; - (if shouldHug then argDoc + (if should_hug then arg_doc else Doc.concat [ - Doc.indent (Doc.concat [Doc.softLine; argDoc]); - Doc.trailingComma; - Doc.softLine; + Doc.indent (Doc.concat [Doc.soft_line; arg_doc]); + Doc.trailing_comma; + Doc.soft_line; ]); Doc.rparen; ] in - Doc.group (Doc.concat [variantName; args]) - | Pexp_record (rows, spreadExpr) -> + Doc.group (Doc.concat [variant_name; args]) + | Pexp_record (rows, spread_expr) -> if rows = [] then Doc.concat - [Doc.lbrace; printCommentsInside cmtTbl e.pexp_loc; Doc.rbrace] + [Doc.lbrace; print_comments_inside cmt_tbl e.pexp_loc; Doc.rbrace] else let spread = - match spreadExpr with + match spread_expr with | None -> Doc.nil | Some ({pexp_desc} as expr) -> let doc = match pexp_desc with - | Pexp_ident {txt = expr} -> printLident expr - | _ -> printExpression ~state expr cmtTbl + | Pexp_ident {txt = expr} -> print_lident expr + | _ -> print_expression ~state expr cmt_tbl in - let docWithSpread = + let doc_with_spread = Doc.concat [ Doc.dotdotdot; (match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc); ] in Doc.concat [ - printComments docWithSpread cmtTbl expr.Parsetree.pexp_loc; + print_comments doc_with_spread cmt_tbl expr.Parsetree.pexp_loc; Doc.comma; Doc.line; ] @@ -2952,33 +2952,33 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = * a: 1, * b: 2, * }` -> record is written on multiple lines, break the group *) - let forceBreak = + let force_break = e.pexp_loc.loc_start.pos_lnum < e.pexp_loc.loc_end.pos_lnum in - let punningAllowed = - match (spreadExpr, rows) with + let punning_allowed = + match (spread_expr, rows) with | None, [_] -> false (* disallow punning for single-element records *) | _ -> true in - Doc.breakableGroup ~forceBreak + Doc.breakable_group ~force_break (Doc.concat [ Doc.lbrace; Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; spread; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun row -> - printExpressionRecordRow ~state row cmtTbl - punningAllowed) + print_expression_record_row ~state row cmt_tbl + punning_allowed) rows); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ]) | Pexp_extension extension -> ( @@ -2997,65 +2997,65 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = * "a": 1, * "b": 2, * }` -> object is written on multiple lines, break the group *) - let forceBreak = loc.loc_start.pos_lnum < loc.loc_end.pos_lnum in - Doc.breakableGroup ~forceBreak + let force_break = loc.loc_start.pos_lnum < loc.loc_end.pos_lnum in + Doc.breakable_group ~force_break (Doc.concat [ Doc.lbrace; Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> printBsObjectRow ~state row cmtTbl) + (fun row -> print_bs_object_row ~state row cmt_tbl) rows); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ]) - | 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 + | 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 | Pexp_unreachable -> Doc.dot - | Pexp_field (expr, longidentLoc) -> + | Pexp_field (expr, longident_loc) -> let lhs = - let doc = printExpressionWithComments ~state expr cmtTbl in - match Parens.fieldExpr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + 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 | Nothing -> doc in - 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 + 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 | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) - when ParsetreeViewer.isTernaryExpr e -> - let parts, alternate = ParsetreeViewer.collectTernaryParts e in - let ternaryDoc = + when ParsetreeViewer.is_ternary_expr e -> + let parts, alternate = ParsetreeViewer.collect_ternary_parts e in + let ternary_doc = match parts with | (condition1, consequent1) :: rest -> Doc.group (Doc.concat [ - printTernaryOperand ~state condition1 cmtTbl; + print_ternary_operand ~state condition1 cmt_tbl; Doc.indent (Doc.concat [ @@ -3064,7 +3064,7 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = (Doc.concat [ Doc.text "? "; - printTernaryOperand ~state consequent1 cmtTbl; + print_ternary_operand ~state consequent1 cmt_tbl; ]); Doc.concat (List.map @@ -3073,74 +3073,74 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = [ Doc.line; Doc.text ": "; - printTernaryOperand ~state condition cmtTbl; + print_ternary_operand ~state condition cmt_tbl; Doc.line; Doc.text "? "; - printTernaryOperand ~state consequent cmtTbl; + print_ternary_operand ~state consequent cmt_tbl; ]) rest); Doc.line; Doc.text ": "; - Doc.indent (printTernaryOperand ~state alternate cmtTbl); + Doc.indent (print_ternary_operand ~state alternate cmt_tbl); ]); ]) | _ -> Doc.nil in - let attrs = ParsetreeViewer.filterTernaryAttributes e.pexp_attributes in - let needsParens = - match ParsetreeViewer.filterParsingAttrs attrs with + let attrs = ParsetreeViewer.filter_ternary_attributes e.pexp_attributes in + let needs_parens = + match ParsetreeViewer.filter_parsing_attrs attrs with | [] -> false | _ -> true in Doc.concat [ - printAttributes ~state attrs cmtTbl; - (if needsParens then addParens ternaryDoc else ternaryDoc); + print_attributes ~state attrs cmt_tbl; + (if needs_parens then add_parens ternary_doc else ternary_doc); ] | Pexp_ifthenelse (_ifExpr, _thenExpr, _elseExpr) -> - let ifs, elseExpr = ParsetreeViewer.collectIfExpressions e in - printIfChain ~state e.pexp_attributes ifs elseExpr cmtTbl + let ifs, else_expr = ParsetreeViewer.collect_if_expressions e in + print_if_chain ~state e.pexp_attributes ifs else_expr cmt_tbl | Pexp_while (expr1, expr2) -> let condition = - let doc = printExpressionWithComments ~state expr1 cmtTbl in + let doc = print_expression_with_comments ~state expr1 cmt_tbl in match Parens.expr expr1 with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr1 braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr1 braces | Nothing -> doc in - Doc.breakableGroup ~forceBreak:true + Doc.breakable_group ~force_break:true (Doc.concat [ Doc.text "while "; - (if ParsetreeViewer.isBlockExpr expr1 then condition - else Doc.group (Doc.ifBreaks (addParens condition) condition)); + (if ParsetreeViewer.is_block_expr expr1 then condition + else Doc.group (Doc.if_breaks (add_parens condition) condition)); Doc.space; - printExpressionBlock ~state ~braces:true expr2 cmtTbl; + print_expression_block ~state ~braces:true expr2 cmt_tbl; ]) - | Pexp_for (pattern, fromExpr, toExpr, directionFlag, body) -> - Doc.breakableGroup ~forceBreak:true + | Pexp_for (pattern, from_expr, to_expr, direction_flag, body) -> + Doc.breakable_group ~force_break:true (Doc.concat [ Doc.text "for "; - printPattern ~state pattern cmtTbl; + print_pattern ~state pattern cmt_tbl; Doc.text " in "; - (let doc = printExpressionWithComments ~state fromExpr cmtTbl in - match Parens.expr fromExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc fromExpr braces + (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 | Nothing -> doc); - printDirectionFlag directionFlag; - (let doc = printExpressionWithComments ~state toExpr cmtTbl in - match Parens.expr toExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc toExpr braces + 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 | Nothing -> doc); Doc.space; - printExpressionBlock ~state ~braces:true body cmtTbl; + print_expression_block ~state ~braces:true body cmt_tbl; ]) | Pexp_constraint - ( {pexp_desc = Pexp_pack modExpr}, - {ptyp_desc = Ptyp_package packageType; ptyp_loc} ) -> + ( {pexp_desc = Pexp_pack mod_expr}, + {ptyp_desc = Ptyp_package package_type; ptyp_loc} ) -> Doc.group (Doc.concat [ @@ -3148,121 +3148,121 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; - printModExpr ~state modExpr cmtTbl; + Doc.soft_line; + print_mod_expr ~state mod_expr cmt_tbl; Doc.text ": "; - printComments - (printPackageType ~state - ~printModuleKeywordAndParens:false packageType cmtTbl) - cmtTbl ptyp_loc; + print_comments + (print_package_type ~state + ~print_module_keyword_and_parens:false package_type cmt_tbl) + cmt_tbl ptyp_loc; ]); - Doc.softLine; + Doc.soft_line; Doc.rparen; ]) | Pexp_constraint (expr, typ) -> - let exprDoc = - let doc = printExpressionWithComments ~state expr cmtTbl in + let expr_doc = + let doc = print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in - Doc.concat [exprDoc; Doc.text ": "; printTypExpr ~state typ cmtTbl] + Doc.concat [expr_doc; Doc.text ": "; print_typ_expr ~state typ cmt_tbl] | Pexp_letmodule ({txt = _modName}, _modExpr, _expr) -> - printExpressionBlock ~state ~braces:true e cmtTbl + print_expression_block ~state ~braces:true e cmt_tbl | Pexp_letexception (_extensionConstructor, _expr) -> - printExpressionBlock ~state ~braces:true e cmtTbl + print_expression_block ~state ~braces:true e cmt_tbl | Pexp_assert expr -> - let expr = printExpressionWithComments ~state expr cmtTbl in + let expr = print_expression_with_comments ~state expr cmt_tbl in Doc.concat [Doc.text "assert("; expr; Doc.text ")"] | Pexp_lazy expr -> let rhs = - let doc = printExpressionWithComments ~state expr cmtTbl in - match Parens.lazyOrAssertOrAwaitExprRhs expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + 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 | Nothing -> doc in Doc.group (Doc.concat [Doc.text "lazy "; rhs]) | Pexp_open (_overrideFlag, _longidentLoc, _expr) -> - printExpressionBlock ~state ~braces:true e cmtTbl - | Pexp_pack modExpr -> + print_expression_block ~state ~braces:true e cmt_tbl + | Pexp_pack mod_expr -> Doc.group (Doc.concat [ Doc.text "module("; Doc.indent - (Doc.concat [Doc.softLine; printModExpr ~state modExpr cmtTbl]); - Doc.softLine; + (Doc.concat [Doc.soft_line; print_mod_expr ~state mod_expr cmt_tbl]); + Doc.soft_line; Doc.rparen; ]) - | Pexp_sequence _ -> printExpressionBlock ~state ~braces:true e cmtTbl - | Pexp_let _ -> printExpressionBlock ~state ~braces:true e cmtTbl + | Pexp_sequence _ -> print_expression_block ~state ~braces:true e cmt_tbl + | Pexp_let _ -> print_expression_block ~state ~braces:true e cmt_tbl | Pexp_try (expr, cases) -> - let exprDoc = - let doc = printExpressionWithComments ~state expr cmtTbl in + let expr_doc = + let doc = print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in Doc.concat [ Doc.text "try "; - exprDoc; + expr_doc; Doc.text " catch "; - printCases ~state cases cmtTbl; + print_cases ~state cases 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 (_, [_; _]) 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 (expr, cases) -> - let exprDoc = - let doc = printExpressionWithComments ~state expr cmtTbl in + let expr_doc = + let doc = print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in Doc.concat - [Doc.text "switch "; exprDoc; Doc.space; printCases ~state cases cmtTbl] + [Doc.text "switch "; expr_doc; Doc.space; print_cases ~state cases cmt_tbl] | Pexp_function cases -> - 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 + 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 | None -> Doc.nil | Some typ1 -> - Doc.concat [Doc.text ": "; printTypExpr ~state typ1 cmtTbl] + Doc.concat [Doc.text ": "; print_typ_expr ~state typ1 cmt_tbl] in Doc.concat - [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 + [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 | Nothing -> doc in let member = - let memberDoc = printComments (Doc.text label.txt) cmtTbl label.loc in - Doc.concat [Doc.text "\""; memberDoc; Doc.text "\""] + let member_doc = print_comments (Doc.text label.txt) cmt_tbl label.loc in + Doc.concat [Doc.text "\""; member_doc; Doc.text "\""] in - Doc.group (Doc.concat [parentDoc; Doc.lbracket; member; Doc.rbracket]) + Doc.group (Doc.concat [parent_doc; 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 exprWithAwait = - if ParsetreeViewer.hasAwaitAttribute e.pexp_attributes then + let expr_with_await = + if ParsetreeViewer.has_await_attribute e.pexp_attributes then let rhs = match - Parens.lazyOrAssertOrAwaitExprRhs ~inAwait:true + Parens.lazy_or_assert_or_await_expr_rhs ~in_await:true { e with pexp_attributes = @@ -3273,67 +3273,67 @@ and printExpression ~state (e : Parsetree.expression) cmtTbl = e.pexp_attributes; } with - | Parens.Parenthesized -> addParens printedExpression - | Braced braces -> printBraces printedExpression e braces - | Nothing -> printedExpression + | Parens.Parenthesized -> add_parens printed_expression + | Braced braces -> print_braces printed_expression e braces + | Nothing -> printed_expression in Doc.concat [Doc.text "await "; rhs] - else printedExpression + else printed_expression in - let shouldPrintItsOwnAttributes = + let should_print_its_own_attributes = match e.pexp_desc with | Pexp_apply _ | Pexp_fun _ | Pexp_newtype _ | Pexp_setfield _ | Pexp_ifthenelse _ -> true - | Pexp_match _ when ParsetreeViewer.isIfLetExpr e -> true - | Pexp_construct _ when ParsetreeViewer.hasJsxAttribute e.pexp_attributes -> + | Pexp_match _ when ParsetreeViewer.is_if_let_expr e -> true + | Pexp_construct _ when ParsetreeViewer.has_jsx_attribute e.pexp_attributes -> true | _ -> false in match e.pexp_attributes with - | [] -> exprWithAwait - | attrs when not shouldPrintItsOwnAttributes -> - Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; exprWithAwait]) - | _ -> exprWithAwait + | [] -> 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 -and printPexpFun ~state ~inCallback e cmtTbl = - let uncurried, attrsOnArrow, parameters, returnExpr = - ParsetreeViewer.funExpr e +and print_pexp_fun ~state ~in_callback e cmt_tbl = + let uncurried, attrs_on_arrow, parameters, return_expr = + ParsetreeViewer.fun_expr e in let ParsetreeViewer.{async; bs; attributes = attrs} = - ParsetreeViewer.processFunctionAttributes attrsOnArrow + ParsetreeViewer.process_function_attributes attrs_on_arrow in let uncurried = bs || uncurried in - let returnExpr, typConstraint = - match returnExpr.pexp_desc with + let return_expr, typ_constraint = + match return_expr.pexp_desc with | Pexp_constraint (expr, typ) -> ( { expr with pexp_attributes = - List.concat [expr.pexp_attributes; returnExpr.pexp_attributes]; + List.concat [expr.pexp_attributes; return_expr.pexp_attributes]; }, Some typ ) - | _ -> (returnExpr, None) + | _ -> (return_expr, None) in - let parametersDoc = - printExprFunParameters ~state ~inCallback ~async ~uncurried - ~hasConstraint: - (match typConstraint with + let parameters_doc = + print_expr_fun_parameters ~state ~in_callback ~async ~uncurried + ~has_constraint: + (match typ_constraint with | Some _ -> true | None -> false) - parameters cmtTbl + parameters cmt_tbl in - let returnShouldIndent = - match returnExpr.pexp_desc with + let return_should_indent = + match return_expr.pexp_desc with | Pexp_sequence _ | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ -> false | _ -> true in - let returnExprDoc = - let optBraces, _ = ParsetreeViewer.processBracesAttr returnExpr in - let shouldInline = - match (returnExpr.pexp_desc, optBraces) with + 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 | _, Some _ -> true | ( ( Pexp_array _ | Pexp_tuple _ | Pexp_construct (_, Some _) @@ -3342,108 +3342,108 @@ and printPexpFun ~state ~inCallback e cmtTbl = true | _ -> false in - let returnDoc = - let doc = printExpressionWithComments ~state returnExpr cmtTbl in - match Parens.expr returnExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc returnExpr braces + 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 | Nothing -> doc in - if shouldInline then Doc.concat [Doc.space; returnDoc] + if should_inline then Doc.concat [Doc.space; return_doc] else Doc.group - (if returnShouldIndent then + (if return_should_indent then Doc.concat [ - Doc.indent (Doc.concat [Doc.line; returnDoc]); - (match inCallback with - | FitsOnOneLine | ArgumentsFitOnOneLine -> Doc.softLine + Doc.indent (Doc.concat [Doc.line; return_doc]); + (match in_callback with + | FitsOnOneLine | ArgumentsFitOnOneLine -> Doc.soft_line | _ -> Doc.nil); ] - else Doc.concat [Doc.space; returnDoc]) + else Doc.concat [Doc.space; return_doc]) in - let typConstraintDoc = - match typConstraint with - | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] + let typ_constraint_doc = + match typ_constraint with + | Some typ -> Doc.concat [Doc.text ": "; print_typ_expr ~state typ cmt_tbl] | _ -> Doc.nil in Doc.concat [ - printAttributes ~state attrs cmtTbl; - parametersDoc; - typConstraintDoc; + print_attributes ~state attrs cmt_tbl; + parameters_doc; + typ_constraint_doc; Doc.text " =>"; - returnExprDoc; + return_expr_doc; ] -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 +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 | Nothing -> doc -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 +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 | Nothing -> doc in - let lhsDoc = - let doc = printExpressionWithComments ~state lhs cmtTbl in - match Parens.fieldExpr lhs with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc lhs braces + 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 | Nothing -> doc in - let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in + let should_indent = ParsetreeViewer.is_binary_expression rhs in let doc = Doc.group (Doc.concat [ - lhsDoc; + lhs_doc; Doc.dot; - printLidentPath longidentLoc cmtTbl; + print_lident_path longident_loc cmt_tbl; Doc.text " ="; - (if shouldIndent then - Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc])) - else Doc.concat [Doc.space; rhsDoc]); + (if should_indent then + Doc.group (Doc.indent (Doc.concat [Doc.line; rhs_doc])) + else Doc.concat [Doc.space; rhs_doc]); ]) in let doc = match attrs with | [] -> doc - | attrs -> Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) + | attrs -> Doc.group (Doc.concat [print_attributes ~state attrs cmt_tbl; doc]) in - printComments doc cmtTbl loc + print_comments doc cmt_tbl loc -and printTemplateLiteral ~state expr cmtTbl = +and print_template_literal ~state expr cmt_tbl = let tag = ref "js" in - let rec walkExpr expr = + let rec walk_expr 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 = walkExpr arg1 in - let rhs = walkExpr arg2 in + let lhs = walk_expr arg1 in + let rhs = walk_expr arg2 in Doc.concat [lhs; rhs] | Pexp_constant (Pconst_string (txt, Some prefix)) -> tag := prefix; - printStringContents txt + print_string_contents txt | _ -> - let doc = printExpressionWithComments ~state expr cmtTbl in + let doc = print_expression_with_comments ~state expr cmt_tbl in let doc = match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in Doc.group (Doc.concat [Doc.text "${"; Doc.indent doc; Doc.rbrace]) in - let content = walkExpr expr in + let content = walk_expr expr in Doc.concat [ (if !tag = "js" then Doc.nil else Doc.text !tag); @@ -3452,8 +3452,8 @@ and printTemplateLiteral ~state expr cmtTbl = Doc.text "`"; ] -and printTaggedTemplateLiteral ~state callExpr args cmtTbl = - let stringsList, valuesList = +and print_tagged_template_literal ~state call_expr args cmt_tbl = + let strings_list, values_list = match args with | [ (_, {Parsetree.pexp_desc = Pexp_array strings}); @@ -3468,9 +3468,9 @@ and printTaggedTemplateLiteral ~state callExpr args cmtTbl = (fun x -> match x with | {Parsetree.pexp_desc = Pexp_constant (Pconst_string (txt, _))} -> - printStringContents txt + print_string_contents txt | _ -> assert false) - stringsList + strings_list in let values = @@ -3479,10 +3479,10 @@ and printTaggedTemplateLiteral ~state callExpr args cmtTbl = Doc.concat [ Doc.text "${"; - printExpressionWithComments ~state x cmtTbl; + print_expression_with_comments ~state x cmt_tbl; Doc.text "}"; ]) - valuesList + values_list in let process strings values = @@ -3496,11 +3496,11 @@ and printTaggedTemplateLiteral ~state callExpr args cmtTbl = let content : Doc.t = process strings values in - let tag = printExpressionWithComments ~state callExpr cmtTbl in + let tag = print_expression_with_comments ~state call_expr cmt_tbl in Doc.concat [tag; Doc.text "`"; content; Doc.text "`"] -and printUnaryExpression ~state expr cmtTbl = - let printUnaryOperator op = +and print_unary_expression ~state expr cmt_tbl = + let print_unary_operator op = Doc.text (match op with | "~+" -> "+" @@ -3514,20 +3514,20 @@ and printUnaryExpression ~state expr cmtTbl = | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, operand)] ) -> - let printedOperand = - let doc = printExpressionWithComments ~state operand cmtTbl in - match Parens.unaryExprOperand operand with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc operand braces + 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 | Nothing -> doc in - let doc = Doc.concat [printUnaryOperator operator; printedOperand] in - printComments doc cmtTbl expr.pexp_loc + let doc = Doc.concat [print_unary_operator operator; printed_operand] in + print_comments doc cmt_tbl expr.pexp_loc | _ -> assert false -and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = - let printBinaryOperator ~inlineRhs operator = - let operatorTxt = +and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = + let print_binary_operator ~inline_rhs operator = + let operator_txt = match operator with | "|." | "|.u" -> "->" | "^" -> "++" @@ -3537,23 +3537,23 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = | "!=" -> "!==" | txt -> txt in - let spacingBeforeOperator = - if operator = "|." || operator = "|.u" then Doc.softLine + let spacing_before_operator = + if operator = "|." || operator = "|.u" then Doc.soft_line else if operator = "|>" then Doc.line else Doc.space in - let spacingAfterOperator = + let spacing_after_operator = if operator = "|." || operator = "|.u" then Doc.nil else if operator = "|>" then Doc.space - else if inlineRhs then Doc.space + else if inline_rhs then Doc.space else Doc.line in Doc.concat - [spacingBeforeOperator; Doc.text operatorTxt; spacingAfterOperator] + [spacing_before_operator; Doc.text operator_txt; spacing_after_operator] in - let printOperand ~isLhs ~isMultiline expr parentOperator = - let rec flatten ~isLhs ~isMultiline expr parentOperator = - if ParsetreeViewer.isBinaryExpression expr then + 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 match expr with | { pexp_desc = @@ -3562,100 +3562,100 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = [(_, left); (_, right)] ); } -> if - ParsetreeViewer.flattenableOperators parentOperator operator - && not (ParsetreeViewer.hasAttributes expr.pexp_attributes) + ParsetreeViewer.flattenable_operators parent_operator operator + && not (ParsetreeViewer.has_attributes expr.pexp_attributes) then - let leftPrinted = flatten ~isLhs:true ~isMultiline left operator in - let rightPrinted = - let rightPrinteableAttrs, rightInternalAttrs = - ParsetreeViewer.partitionPrintableAttributes + 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 right.pexp_attributes in let doc = - printExpressionWithComments ~state - {right with pexp_attributes = rightInternalAttrs} - cmtTbl + print_expression_with_comments ~state + {right with pexp_attributes = right_internal_attrs} + cmt_tbl in let doc = - if Parens.flattenOperandRhs parentOperator right then + if Parens.flatten_operand_rhs parent_operator right then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in let doc = Doc.concat - [printAttributes ~state rightPrinteableAttrs cmtTbl; doc] + [print_attributes ~state right_printeable_attrs cmt_tbl; doc] in - match rightPrinteableAttrs with + match right_printeable_attrs with | [] -> doc - | _ -> addParens doc + | _ -> add_parens doc in - let isAwait = - ParsetreeViewer.hasAwaitAttribute expr.pexp_attributes + let is_await = + ParsetreeViewer.has_await_attribute expr.pexp_attributes in let doc = - if isAwait then + if is_await then let parens = - Res_parens.binaryOperatorInsideAwaitNeedsParens operator + Res_parens.binary_operator_inside_await_needs_parens operator in Doc.concat [ Doc.lparen; Doc.text "await "; (if parens then Doc.lparen else Doc.nil); - leftPrinted; - printBinaryOperator ~inlineRhs:false operator; - rightPrinted; + left_printed; + print_binary_operator ~inline_rhs:false operator; + right_printed; (if parens then Doc.rparen else Doc.nil); Doc.rparen; ] else match operator with - | ("|." | "|.u") when isMultiline -> + | ("|." | "|.u") when is_multiline -> (* 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.breakableGroup ~forceBreak:true + Doc.breakable_group ~force_break:true (Doc.concat [ - leftPrinted; - printBinaryOperator ~inlineRhs:false operator; - rightPrinted; + left_printed; + print_binary_operator ~inline_rhs:false operator; + right_printed; ]) | _ -> Doc.concat [ - leftPrinted; - printBinaryOperator ~inlineRhs:false operator; - rightPrinted; + left_printed; + print_binary_operator ~inline_rhs:false operator; + right_printed; ] in let doc = - if (not isLhs) && Parens.rhsBinaryExprOperand operator expr then + if (not is_lhs) && Parens.rhs_binary_expr_operand operator expr then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - printComments doc cmtTbl expr.pexp_loc + print_comments doc cmt_tbl expr.pexp_loc else - let printeableAttrs, internalAttrs = - ParsetreeViewer.partitionPrintableAttributes expr.pexp_attributes + let printeable_attrs, internal_attrs = + ParsetreeViewer.partition_printable_attributes expr.pexp_attributes in let doc = - printExpressionWithComments ~state - {expr with pexp_attributes = internalAttrs} - cmtTbl + print_expression_with_comments ~state + {expr with pexp_attributes = internal_attrs} + cmt_tbl in let doc = if - Parens.subBinaryExprOperand parentOperator operator - || printeableAttrs <> [] - && (ParsetreeViewer.isBinaryExpression expr - || ParsetreeViewer.isTernaryExpr expr) + Parens.sub_binary_expr_operand parent_operator operator + || printeable_attrs <> [] + && (ParsetreeViewer.is_binary_expression expr + || ParsetreeViewer.is_ternary_expr expr) then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in - Doc.concat [printAttributes ~state printeableAttrs cmtTbl; doc] + Doc.concat [print_attributes ~state printeable_attrs cmt_tbl; doc] | _ -> assert false else match expr.pexp_desc with @@ -3663,47 +3663,47 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = ( {pexp_desc = Pexp_ident {txt = Longident.Lident "^"; loc}}, [(Nolabel, _); (Nolabel, _)] ) when loc.loc_ghost -> - let doc = printTemplateLiteral ~state expr cmtTbl in - printComments doc cmtTbl expr.Parsetree.pexp_loc + let doc = print_template_literal ~state expr cmt_tbl in + print_comments doc cmt_tbl expr.Parsetree.pexp_loc | Pexp_setfield (lhs, field, rhs) -> let doc = - printSetFieldExpr ~state expr.pexp_attributes lhs field rhs - expr.pexp_loc cmtTbl + print_set_field_expr ~state expr.pexp_attributes lhs field rhs + expr.pexp_loc cmt_tbl in - if isLhs then addParens doc else doc + if is_lhs then add_parens doc else doc | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> - let rhsDoc = printExpressionWithComments ~state rhs cmtTbl in - let lhsDoc = printExpressionWithComments ~state lhs cmtTbl in + let rhs_doc = print_expression_with_comments ~state rhs cmt_tbl in + let lhs_doc = print_expression_with_comments ~state lhs cmt_tbl in (* TODO: unify indentation of "=" *) - let shouldIndent = ParsetreeViewer.isBinaryExpression rhs in + let should_indent = ParsetreeViewer.is_binary_expression rhs in let doc = Doc.group (Doc.concat [ - lhsDoc; + lhs_doc; Doc.text " ="; - (if shouldIndent then - Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc])) - else Doc.concat [Doc.space; rhsDoc]); + (if should_indent then + Doc.group (Doc.indent (Doc.concat [Doc.line; rhs_doc])) + else Doc.concat [Doc.space; rhs_doc]); ]) in let doc = match expr.pexp_attributes with | [] -> doc | attrs -> - Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) + Doc.group (Doc.concat [print_attributes ~state attrs cmt_tbl; doc]) in - if isLhs then addParens doc else doc + if is_lhs then add_parens doc else doc | _ -> ( - let doc = printExpressionWithComments ~state expr cmtTbl in - match Parens.binaryExprOperand ~isLhs expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + 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 | Nothing -> doc) in - flatten ~isLhs ~isMultiline expr parentOperator + flatten ~is_lhs ~is_multiline expr parent_operator in match expr.pexp_desc with | Pexp_apply @@ -3713,115 +3713,115 @@ and printBinaryExpression ~state (expr : Parsetree.expression) cmtTbl = }, [(Nolabel, lhs); (Nolabel, rhs)] ) when not - (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 + (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 Doc.group (Doc.concat [ - printAttributes ~state expr.pexp_attributes cmtTbl; - lhsDoc; - (match (lhsHasCommentBelow, op) with - | true, ("|." | "|.u") -> Doc.concat [Doc.softLine; Doc.text "->"] + 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 "->"] | false, ("|." | "|.u") -> Doc.text "->" | true, "|>" -> Doc.concat [Doc.line; Doc.text "|> "] | false, "|>" -> Doc.text " |> " | _ -> Doc.nil); - rhsDoc; + rhs_doc; ]) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident operator}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> - let isMultiline = + let is_multiline = lhs.pexp_loc.loc_start.pos_lnum < rhs.pexp_loc.loc_start.pos_lnum in let right = - let operatorWithRhs = - let rhsDoc = - printOperand - ~isLhs:(ParsetreeViewer.isRhsBinaryOperator operator) - ~isMultiline rhs operator + let operator_with_rhs = + let rhs_doc = + print_operand + ~is_lhs:(ParsetreeViewer.is_rhs_binary_operator operator) + ~is_multiline rhs operator in Doc.concat [ - printBinaryOperator - ~inlineRhs:(ParsetreeViewer.shouldInlineRhsBinaryExpr rhs) + print_binary_operator + ~inline_rhs:(ParsetreeViewer.should_inline_rhs_binary_expr rhs) operator; - rhsDoc; + rhs_doc; ] in - if ParsetreeViewer.shouldIndentBinaryExpr expr then - Doc.group (Doc.indent operatorWithRhs) - else operatorWithRhs + if ParsetreeViewer.should_indent_binary_expr expr then + Doc.group (Doc.indent operator_with_rhs) + else operator_with_rhs in let doc = Doc.group (Doc.concat [ - printOperand - ~isLhs:(not @@ ParsetreeViewer.isRhsBinaryOperator operator) - ~isMultiline lhs operator; + print_operand + ~is_lhs:(not @@ ParsetreeViewer.is_rhs_binary_operator operator) + ~is_multiline lhs operator; right; ]) in Doc.group (Doc.concat [ - printAttributes ~state expr.pexp_attributes cmtTbl; + print_attributes ~state expr.pexp_attributes cmt_tbl; (match - Parens.binaryExpr + Parens.binary_expr { expr with pexp_attributes = - ParsetreeViewer.filterPrintableAttributes + ParsetreeViewer.filter_printable_attributes expr.pexp_attributes; } with - | Braced bracesLoc -> printBraces doc expr bracesLoc - | Parenthesized -> addParens doc + | Braced braces_loc -> print_braces doc expr braces_loc + | Parenthesized -> add_parens doc | Nothing -> doc); ]) | _ -> Doc.nil -and printBeltArrayConcatApply ~state subLists cmtTbl = - let makeSpreadDoc commaBeforeSpread = function +and print_belt_array_concat_apply ~state sub_lists cmt_tbl = + let make_spread_doc comma_before_spread = function | Some expr -> Doc.concat [ - commaBeforeSpread; + comma_before_spread; Doc.dotdotdot; - (let doc = printExpressionWithComments ~state expr cmtTbl in + (let doc = print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc); ] | None -> Doc.nil in - let makeSubListDoc (expressions, spread) = - let commaBeforeSpread = + let make_sub_list_doc (expressions, spread) = + let comma_before_spread = match expressions with | [] -> Doc.nil | _ -> Doc.concat [Doc.text ","; Doc.line] in - let spreadDoc = makeSpreadDoc commaBeforeSpread spread in + let spread_doc = make_spread_doc comma_before_spread spread in Doc.concat [ Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> - let doc = printExpressionWithComments ~state expr cmtTbl in + let doc = print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc) expressions); - spreadDoc; + spread_doc; ] in Doc.group @@ -3831,52 +3831,52 @@ and printBeltArrayConcatApply ~state subLists cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map makeSubListDoc - (List.map ParsetreeViewer.collectArrayExpressions subLists)); + (List.map make_sub_list_doc + (List.map ParsetreeViewer.collect_array_expressions sub_lists)); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbracket; ]) -and printBeltListConcatApply ~state subLists cmtTbl = - let makeSpreadDoc commaBeforeSpread = function +and print_belt_list_concat_apply ~state sub_lists cmt_tbl = + let make_spread_doc comma_before_spread = function | Some expr -> Doc.concat [ - commaBeforeSpread; + comma_before_spread; Doc.dotdotdot; - (let doc = printExpressionWithComments ~state expr cmtTbl in + (let doc = print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc); ] | None -> Doc.nil in - let makeSubListDoc (expressions, spread) = - let commaBeforeSpread = + let make_sub_list_doc (expressions, spread) = + let comma_before_spread = match expressions with | [] -> Doc.nil | _ -> Doc.concat [Doc.text ","; Doc.line] in - let spreadDoc = makeSpreadDoc commaBeforeSpread spread in + let spread_doc = make_spread_doc comma_before_spread spread in Doc.concat [ Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map (fun expr -> - let doc = printExpressionWithComments ~state expr cmtTbl in + let doc = print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc) expressions); - spreadDoc; + spread_doc; ] in Doc.group @@ -3886,44 +3886,44 @@ and printBeltListConcatApply ~state subLists cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) - (List.map makeSubListDoc - (List.map ParsetreeViewer.collectListExpressions subLists)); + (List.map make_sub_list_doc + (List.map ParsetreeViewer.collect_list_expressions sub_lists)); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rbrace; ]) (* callExpr(arg1, arg2) *) -and printPexpApply ~state expr cmtTbl = +and print_pexp_apply ~state expr cmt_tbl = match expr.pexp_desc with | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "##"}}, - [(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 + [(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 | Nothing -> doc in let member = - let memberDoc = - match memberExpr.pexp_desc with + let member_doc = + match member_expr.pexp_desc with | Pexp_ident lident -> - printComments (printLongident lident.txt) cmtTbl memberExpr.pexp_loc - | _ -> printExpressionWithComments ~state memberExpr cmtTbl + print_comments (print_longident lident.txt) cmt_tbl member_expr.pexp_loc + | _ -> print_expression_with_comments ~state member_expr cmt_tbl in - Doc.concat [Doc.text "\""; memberDoc; Doc.text "\""] + Doc.concat [Doc.text "\""; member_doc; Doc.text "\""] in Doc.group (Doc.concat [ - printAttributes ~state expr.pexp_attributes cmtTbl; - parentDoc; + print_attributes ~state expr.pexp_attributes cmt_tbl; + parent_doc; Doc.lbracket; member; Doc.rbracket; @@ -3931,174 +3931,174 @@ and printPexpApply ~state expr cmtTbl = | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Lident "#="}}, [(Nolabel, lhs); (Nolabel, rhs)] ) -> ( - let rhsDoc = - let doc = printExpressionWithComments ~state rhs cmtTbl in + let rhs_doc = + let doc = print_expression_with_comments ~state rhs cmt_tbl in match Parens.expr rhs with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc rhs braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc rhs braces | Nothing -> doc in (* TODO: unify indentation of "=" *) - let shouldIndent = - (not (ParsetreeViewer.isBracedExpr rhs)) - && ParsetreeViewer.isBinaryExpression rhs + let should_indent = + (not (ParsetreeViewer.is_braced_expr rhs)) + && ParsetreeViewer.is_binary_expression rhs in let doc = Doc.group (Doc.concat [ - printExpressionWithComments ~state lhs cmtTbl; + print_expression_with_comments ~state lhs cmt_tbl; Doc.text " ="; - (if shouldIndent then - Doc.group (Doc.indent (Doc.concat [Doc.line; rhsDoc])) - else Doc.concat [Doc.space; rhsDoc]); + (if should_indent then + Doc.group (Doc.indent (Doc.concat [Doc.line; rhs_doc])) + else Doc.concat [Doc.space; rhs_doc]); ]) in match expr.pexp_attributes with | [] -> doc - | attrs -> Doc.group (Doc.concat [printAttributes ~state attrs cmtTbl; doc]) + | attrs -> Doc.group (Doc.concat [print_attributes ~state attrs cmt_tbl; doc]) ) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "get")}}, - [(Nolabel, parentExpr); (Nolabel, memberExpr)] ) - when not (ParsetreeViewer.isRewrittenUnderscoreApplySugar parentExpr) -> + [(Nolabel, parent_expr); (Nolabel, member_expr)] ) + when not (ParsetreeViewer.is_rewritten_underscore_apply_sugar parent_expr) -> (* Don't print the Array.get(_, 0) sugar a.k.a. (__x) => Array.get(__x, 0) as _[0] *) let member = - let memberDoc = - let doc = printExpressionWithComments ~state memberExpr cmtTbl in - match Parens.expr memberExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc memberExpr braces + 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 | Nothing -> doc in - let shouldInline = - match memberExpr.pexp_desc with + let should_inline = + match member_expr.pexp_desc with | Pexp_constant _ | Pexp_ident _ -> true | _ -> false in - if shouldInline then memberDoc + if should_inline then member_doc else Doc.concat - [Doc.indent (Doc.concat [Doc.softLine; memberDoc]); Doc.softLine] + [Doc.indent (Doc.concat [Doc.soft_line; member_doc]); Doc.soft_line] in - let parentDoc = - let doc = printExpressionWithComments ~state parentExpr cmtTbl in - match Parens.unaryExprOperand parentExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc parentExpr braces + 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 | Nothing -> doc in Doc.group (Doc.concat [ - printAttributes ~state expr.pexp_attributes cmtTbl; - parentDoc; + print_attributes ~state expr.pexp_attributes cmt_tbl; + parent_doc; Doc.lbracket; member; Doc.rbracket; ]) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "set")}}, - [(Nolabel, parentExpr); (Nolabel, memberExpr); (Nolabel, targetExpr)] ) + [(Nolabel, parent_expr); (Nolabel, member_expr); (Nolabel, target_expr)] ) -> let member = - let memberDoc = - let doc = printExpressionWithComments ~state memberExpr cmtTbl in - match Parens.expr memberExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc memberExpr braces + 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 | Nothing -> doc in - let shouldInline = - match memberExpr.pexp_desc with + let should_inline = + match member_expr.pexp_desc with | Pexp_constant _ | Pexp_ident _ -> true | _ -> false in - if shouldInline then memberDoc + if should_inline then member_doc else Doc.concat - [Doc.indent (Doc.concat [Doc.softLine; memberDoc]); Doc.softLine] + [Doc.indent (Doc.concat [Doc.soft_line; member_doc]); Doc.soft_line] in - let shouldIndentTargetExpr = - if ParsetreeViewer.isBracedExpr targetExpr then false + let should_indent_target_expr = + if ParsetreeViewer.is_braced_expr target_expr then false else - ParsetreeViewer.isBinaryExpression targetExpr + ParsetreeViewer.is_binary_expression target_expr || - match targetExpr with + match target_expr with | { pexp_attributes = [({Location.txt = "res.ternary"}, _)]; - pexp_desc = Pexp_ifthenelse (ifExpr, _, _); + pexp_desc = Pexp_ifthenelse (if_expr, _, _); } -> - ParsetreeViewer.isBinaryExpression ifExpr - || ParsetreeViewer.hasAttributes ifExpr.pexp_attributes + ParsetreeViewer.is_binary_expression if_expr + || ParsetreeViewer.has_attributes if_expr.pexp_attributes | {pexp_desc = Pexp_newtype _} -> false | e -> - ParsetreeViewer.hasAttributes e.pexp_attributes - || ParsetreeViewer.isArrayAccess e + ParsetreeViewer.has_attributes e.pexp_attributes + || ParsetreeViewer.is_array_access e in - let targetExpr = - let doc = printExpressionWithComments ~state targetExpr cmtTbl in - match Parens.expr targetExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc targetExpr braces + 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 | Nothing -> doc in - let parentDoc = - let doc = printExpressionWithComments ~state parentExpr cmtTbl in - match Parens.unaryExprOperand parentExpr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc parentExpr braces + 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 | Nothing -> doc in Doc.group (Doc.concat [ - printAttributes ~state expr.pexp_attributes cmtTbl; - parentDoc; + print_attributes ~state expr.pexp_attributes cmt_tbl; + parent_doc; Doc.lbracket; member; Doc.rbracket; Doc.text " ="; - (if shouldIndentTargetExpr then - Doc.indent (Doc.concat [Doc.line; targetExpr]) - else Doc.concat [Doc.space; targetExpr]); + (if should_indent_target_expr then + Doc.indent (Doc.concat [Doc.line; target_expr]) + else Doc.concat [Doc.space; target_expr]); ]) (* TODO: cleanup, are those branches even remotely performant? *) | Pexp_apply ({pexp_desc = Pexp_ident lident}, args) - when ParsetreeViewer.isJsxExpression expr -> - printJsxExpression ~state lident args cmtTbl - | Pexp_apply (callExpr, args) -> + when ParsetreeViewer.is_jsx_expression expr -> + print_jsx_expression ~state lident args cmt_tbl + | Pexp_apply (call_expr, args) -> let args = List.map - (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewriteUnderscoreApply arg)) + (fun (lbl, arg) -> (lbl, ParsetreeViewer.rewrite_underscore_apply arg)) args in let uncurried, attrs = - ParsetreeViewer.processUncurriedAppAttribute expr.pexp_attributes + ParsetreeViewer.process_uncurried_app_attribute expr.pexp_attributes in - let partial, attrs = ParsetreeViewer.processPartialAppAttribute attrs in + let partial, attrs = ParsetreeViewer.process_partial_app_attribute attrs in let args = if partial then let dummy = Ast_helper.Exp.constant (Ast_helper.Const.int 0) in args @ [(Asttypes.Labelled "...", dummy)] else args in - 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 + 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 | Nothing -> doc in - if ParsetreeViewer.requiresSpecialCallbackPrintingFirstArg args then - let argsDoc = - printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl + 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 in - Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] - else if ParsetreeViewer.requiresSpecialCallbackPrintingLastArg args then - let argsDoc = - printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl + 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 in (* * Fixes the following layout (the `[` and `]` should break): @@ -4114,26 +4114,26 @@ and printPexpApply ~state expr cmtTbl = * https://github.com/rescript-lang/syntax/issues/111 * https://github.com/rescript-lang/syntax/issues/166 *) - let maybeBreakParent = - if Doc.willBreak argsDoc then Doc.breakParent else Doc.nil + let maybe_break_parent = + if Doc.will_break args_doc then Doc.break_parent else Doc.nil in Doc.concat [ - maybeBreakParent; - printAttributes ~state attrs cmtTbl; - callExprDoc; - argsDoc; + maybe_break_parent; + print_attributes ~state attrs cmt_tbl; + call_expr_doc; + args_doc; ] else - let argsDoc = printArguments ~state ~dotted ~partial args cmtTbl in - Doc.concat [printAttributes ~state attrs cmtTbl; callExprDoc; argsDoc] + 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] | _ -> assert false -and printJsxExpression ~state lident args cmtTbl = - let name = printJsxName lident in - let formattedProps, children = printJsxProps ~state args cmtTbl in +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 (*
*) - let hasChildren = + let has_children = match children with | Some { @@ -4144,7 +4144,7 @@ and printJsxExpression ~state lident args cmtTbl = | None -> false | _ -> true in - let isSelfClosing = + let is_self_closing = match children with | Some { @@ -4152,14 +4152,14 @@ and printJsxExpression ~state lident args cmtTbl = Pexp_construct ({txt = Longident.Lident "[]"}, None); pexp_loc = loc; } -> - not (hasCommentsInside cmtTbl loc) + not (has_comments_inside cmt_tbl loc) | _ -> false in - let printChildren children = - let lineSep = + let print_children children = + let line_sep = match children with | Some expr -> - if hasNestedJsxOrMoreThanOneChild expr then Doc.hardLine else Doc.line + if has_nested_jsx_or_more_than_one_child expr then Doc.hard_line else Doc.line | None -> Doc.line in Doc.concat @@ -4169,11 +4169,11 @@ and printJsxExpression ~state lident args cmtTbl = [ Doc.line; (match children with - | Some childrenExpression -> - printJsxChildren ~state childrenExpression ~sep:lineSep cmtTbl + | Some children_expression -> + print_jsx_children ~state children_expression ~sep:line_sep cmt_tbl | None -> Doc.nil); ]); - lineSep; + line_sep; ] in Doc.group @@ -4182,17 +4182,17 @@ and printJsxExpression ~state lident args cmtTbl = Doc.group (Doc.concat [ - printComments - (Doc.concat [Doc.lessThan; name]) - cmtTbl lident.Asttypes.loc; - formattedProps; + print_comments + (Doc.concat [Doc.less_than; name]) + cmt_tbl lident.Asttypes.loc; + formatted_props; (match children with | Some { Parsetree.pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, None); } - when isSelfClosing -> + when is_self_closing -> Doc.text "/>" | _ -> (* if tag A has trailing comments then put > on the next line @@ -4201,15 +4201,15 @@ and printJsxExpression ~state lident args cmtTbl = > *) - if hasTrailingComments cmtTbl lident.Asttypes.loc then - Doc.concat [Doc.softLine; Doc.greaterThan] - else Doc.greaterThan); + if has_trailing_comments cmt_tbl lident.Asttypes.loc then + Doc.concat [Doc.soft_line; Doc.greater_than] + else Doc.greater_than); ]); - (if isSelfClosing then Doc.nil + (if is_self_closing then Doc.nil else Doc.concat [ - (if hasChildren then printChildren children + (if has_children then print_children children else match children with | Some @@ -4218,19 +4218,19 @@ and printJsxExpression ~state lident args cmtTbl = Pexp_construct ({txt = Longident.Lident "[]"}, None); pexp_loc = loc; } -> - printCommentsInside cmtTbl loc + print_comments_inside cmt_tbl loc | _ -> Doc.nil); Doc.text "" in let closing = Doc.text "" in - let lineSep = - if hasNestedJsxOrMoreThanOneChild expr then Doc.hardLine else Doc.line + let line_sep = + if has_nested_jsx_or_more_than_one_child expr then Doc.hard_line else Doc.line in Doc.group (Doc.concat @@ -4241,57 +4241,57 @@ and printJsxFragment ~state expr cmtTbl = | _ -> Doc.indent (Doc.concat - [Doc.line; printJsxChildren ~state expr ~sep:lineSep cmtTbl])); - lineSep; + [Doc.line; print_jsx_children ~state expr ~sep:line_sep cmt_tbl])); + line_sep; closing; ]) -and printJsxChildren ~state (childrenExpr : Parsetree.expression) ~sep cmtTbl = - match childrenExpr.pexp_desc with +and print_jsx_children ~state (children_expr : Parsetree.expression) ~sep cmt_tbl = + match children_expr.pexp_desc with | Pexp_construct ({txt = Longident.Lident "::"}, _) -> - let children, _ = ParsetreeViewer.collectListExpressions childrenExpr in + let children, _ = ParsetreeViewer.collect_list_expressions children_expr in Doc.group (Doc.join ~sep (List.map (fun (expr : Parsetree.expression) -> - let leadingLineCommentPresent = - hasLeadingLineComment cmtTbl expr.pexp_loc + let leading_line_comment_present = + has_leading_line_comment cmt_tbl expr.pexp_loc in - let exprDoc = printExpressionWithComments ~state expr cmtTbl in - let addParensOrBraces exprDoc = + let expr_doc = print_expression_with_comments ~state expr cmt_tbl in + let add_parens_or_braces expr_doc = (* {(20: int)} make sure that we also protect the expression inside *) - let innerDoc = - if Parens.bracedExpr expr then addParens exprDoc else exprDoc + let inner_doc = + if Parens.braced_expr expr then add_parens expr_doc else expr_doc in - if leadingLineCommentPresent then addBraces innerDoc - else Doc.concat [Doc.lbrace; innerDoc; Doc.rbrace] + if leading_line_comment_present then add_braces inner_doc + else Doc.concat [Doc.lbrace; inner_doc; Doc.rbrace] in - match Parens.jsxChildExpr expr with - | Nothing -> exprDoc - | Parenthesized -> addParensOrBraces exprDoc - | Braced bracesLoc -> - printComments (addParensOrBraces exprDoc) cmtTbl bracesLoc) + 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) children)) | _ -> - let leadingLineCommentPresent = - hasLeadingLineComment cmtTbl childrenExpr.pexp_loc + let leading_line_comment_present = + has_leading_line_comment cmt_tbl children_expr.pexp_loc in - let exprDoc = printExpressionWithComments ~state childrenExpr cmtTbl in + let expr_doc = print_expression_with_comments ~state children_expr cmt_tbl in Doc.concat [ Doc.dotdotdot; - (match Parens.jsxChildExpr childrenExpr with + (match Parens.jsx_child_expr children_expr with | Parenthesized | Braced _ -> - let innerDoc = - if Parens.bracedExpr childrenExpr then addParens exprDoc - else exprDoc + let inner_doc = + if Parens.braced_expr children_expr then add_parens expr_doc + else expr_doc in - if leadingLineCommentPresent then addBraces innerDoc - else Doc.concat [Doc.lbrace; innerDoc; Doc.rbrace] - | Nothing -> exprDoc); + if leading_line_comment_present then add_braces inner_doc + else Doc.concat [Doc.lbrace; inner_doc; Doc.rbrace] + | Nothing -> expr_doc); ] -and printJsxProps ~state args cmtTbl : Doc.t * Parsetree.expression option = +and print_jsx_props ~state args cmt_tbl : 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 isSelfClosing children = + let is_self_closing children = match children with | { Parsetree.pexp_desc = Pexp_construct ({txt = Longident.Lident "[]"}, None); pexp_loc = loc; } -> - not (hasCommentsInside cmtTbl loc) + not (has_comments_inside cmt_tbl loc) | _ -> false in let rec loop props args = @@ -4324,9 +4324,9 @@ and printJsxProps ~state args cmtTbl : Doc.t * Parsetree.expression option = Pexp_construct ({txt = Longident.Lident "()"}, None); } ); ] -> - let doc = if isSelfClosing children then Doc.line else Doc.nil in + let doc = if is_self_closing children then Doc.line else Doc.nil in (doc, Some children) - | ((_, expr) as lastProp) + | ((_, expr) as last_prop) :: [ (Asttypes.Labelled "children", children); ( Asttypes.Nolabel, @@ -4341,9 +4341,9 @@ and printJsxProps ~state args cmtTbl : Doc.t * Parsetree.expression option = {loc with loc_end = expr.pexp_loc.loc_end} | _ -> expr.pexp_loc in - let trailingCommentsPresent = hasTrailingComments cmtTbl loc in - let propDoc = printJsxProp ~state lastProp cmtTbl in - let formattedProps = + 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 = Doc.concat [ Doc.indent @@ -4351,131 +4351,131 @@ and printJsxProps ~state args cmtTbl : Doc.t * Parsetree.expression option = [ Doc.line; Doc.group - (Doc.join ~sep:Doc.line (propDoc :: props |> List.rev)); + (Doc.join ~sep:Doc.line (prop_doc :: props |> List.rev)); ]); (* print > on new line if the last prop has trailing comments *) - (match (isSelfClosing children, trailingCommentsPresent) with + (match (is_self_closing children, trailing_comments_present) with (* we always put /> on a new line when a self-closing tag breaks *) | true, _ -> Doc.line - | false, true -> Doc.softLine + | false, true -> Doc.soft_line | false, false -> Doc.nil); ] in - (formattedProps, Some children) + (formatted_props, Some children) | arg :: args -> - let propDoc = printJsxProp ~state arg cmtTbl in - loop (propDoc :: props) args + let prop_doc = print_jsx_prop ~state arg cmt_tbl in + loop (prop_doc :: props) args in loop [] args -and printJsxProp ~state arg cmtTbl = +and print_jsx_prop ~state arg cmt_tbl = match arg with - | ( ((Asttypes.Labelled lblTxt | Optional lblTxt) as lbl), + | ( ((Asttypes.Labelled lbl_txt | Optional lbl_txt) as lbl), { Parsetree.pexp_attributes = - [({Location.txt = "res.namedArgLoc"; loc = argLoc}, _)]; + [({Location.txt = "res.namedArgLoc"; loc = arg_loc}, _)]; pexp_desc = Pexp_ident {txt = Longident.Lident ident}; } ) - when lblTxt = ident (* jsx punning *) -> ( + when lbl_txt = ident (* jsx punning *) -> ( match lbl with | Nolabel -> Doc.nil - | Labelled _lbl -> printComments (printIdentLike ident) cmtTbl argLoc + | Labelled _lbl -> print_comments (print_ident_like ident) cmt_tbl arg_loc | Optional _lbl -> - let doc = Doc.concat [Doc.question; printIdentLike ident] in - printComments doc cmtTbl argLoc) - | ( ((Asttypes.Labelled lblTxt | Optional lblTxt) as 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), { Parsetree.pexp_attributes = []; pexp_desc = Pexp_ident {txt = Longident.Lident ident}; } ) - when lblTxt = ident (* jsx punning when printing from Reason *) -> ( + when lbl_txt = ident (* jsx punning when printing from Reason *) -> ( match lbl with | Nolabel -> Doc.nil - | Labelled _lbl -> printIdentLike ident - | Optional _lbl -> Doc.concat [Doc.question; printIdentLike ident]) + | Labelled _lbl -> print_ident_like ident + | Optional _lbl -> Doc.concat [Doc.question; print_ident_like ident]) | Asttypes.Labelled "_spreadProps", expr -> - let doc = printExpressionWithComments ~state expr cmtTbl in + let doc = print_expression_with_comments ~state expr cmt_tbl in Doc.concat [Doc.lbrace; Doc.dotdotdot; doc; Doc.rbrace] | lbl, expr -> - let argLoc, expr = + let arg_loc, expr = match expr.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: attrs -> (loc, {expr with pexp_attributes = attrs}) | _ -> (Location.none, expr) in - let lblDoc = + let lbl_doc = match lbl with | Asttypes.Labelled lbl -> - let lbl = printComments (printIdentLike lbl) cmtTbl argLoc in + let lbl = print_comments (print_ident_like lbl) cmt_tbl arg_loc in Doc.concat [lbl; Doc.equal] | Asttypes.Optional lbl -> - let lbl = printComments (printIdentLike lbl) cmtTbl argLoc in + let lbl = print_comments (print_ident_like lbl) cmt_tbl arg_loc in Doc.concat [lbl; Doc.equal; Doc.question] | Nolabel -> Doc.nil in - let exprDoc = - let leadingLineCommentPresent = - hasLeadingLineComment cmtTbl expr.pexp_loc + let expr_doc = + let leading_line_comment_present = + has_leading_line_comment cmt_tbl expr.pexp_loc in - let doc = printExpressionWithComments ~state expr cmtTbl in - match Parens.jsxPropExpr expr with + let doc = print_expression_with_comments ~state expr cmt_tbl in + match Parens.jsx_prop_expr expr with | Parenthesized | Braced _ -> (* {(20: int)} make sure that we also protect the expression inside *) - 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] + 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] | _ -> doc in - let fullLoc = {argLoc with loc_end = expr.pexp_loc.loc_end} in - printComments (Doc.concat [lblDoc; exprDoc]) cmtTbl fullLoc + 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 (* div -> div. * Navabar.createElement -> Navbar * Staff.Users.createElement -> Staff.Users *) -and printJsxName {txt = lident} = - let printIdent = printIdentLike ~allowUident:true ~allowHyphen:true in +and print_jsx_name {txt = lident} = + let print_ident = print_ident_like ~allow_uident:true ~allow_hyphen:true in let rec flatten acc lident = match lident with - | Longident.Lident txt -> printIdent txt :: acc + | Longident.Lident txt -> print_ident txt :: acc | Ldot (lident, "createElement") -> flatten acc lident - | Ldot (lident, txt) -> flatten (printIdent txt :: acc) lident + | Ldot (lident, txt) -> flatten (print_ident txt :: acc) lident | _ -> acc in match lident with - | Longident.Lident txt -> printIdent txt + | Longident.Lident txt -> print_ident txt | _ as lident -> let segments = flatten [] lident in Doc.join ~sep:Doc.dot segments -and printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl = +and print_arguments_with_callback_in_first_position ~dotted ~state args cmt_tbl = (* 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.nextCustomLayout state in - let cmtTblCopy = CommentTable.copy cmtTbl in - let callback, printedArgs = + let state = State.next_custom_layout state in + let cmt_tbl_copy = CommentTable.copy cmt_tbl in + let callback, printed_args = match args with | (lbl, expr) :: args -> - let lblDoc = + let lbl_doc = match lbl with | Asttypes.Nolabel -> Doc.nil | Asttypes.Labelled txt -> - Doc.concat [Doc.tilde; printIdentLike txt; Doc.equal] + Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal] | Asttypes.Optional txt -> - Doc.concat [Doc.tilde; printIdentLike txt; Doc.equal; Doc.question] + Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal; Doc.question] in let callback = Doc.concat - [lblDoc; printPexpFun ~state ~inCallback:FitsOnOneLine expr cmtTbl] + [lbl_doc; print_pexp_fun ~state ~in_callback:FitsOnOneLine expr cmt_tbl] in - let callback = lazy (printComments callback cmtTbl expr.pexp_loc) in - let printedArgs = + let callback = lazy (print_comments callback cmt_tbl expr.pexp_loc) in + let printed_args = lazy (Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map (fun arg -> printArgument ~state arg cmtTbl) args)) + (List.map (fun arg -> print_argument ~state arg cmt_tbl) args)) in - (callback, printedArgs) + (callback, printed_args) | _ -> assert false in @@ -4484,7 +4484,7 @@ and printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl = * MyModuleBlah.toList(argument) * }, longArgumet, veryLooooongArgument) *) - let fitsOnOneLine = + let fits_on_one_line = lazy (Doc.concat [ @@ -4492,7 +4492,7 @@ and printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl = Lazy.force callback; Doc.comma; Doc.line; - Lazy.force printedArgs; + Lazy.force printed_args; Doc.rparen; ]) in @@ -4504,7 +4504,7 @@ and printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl = * arg3, * ) *) - let breakAllArgs = lazy (printArguments ~state ~dotted args cmtTblCopy) in + let break_all_args = lazy (print_arguments ~state ~dotted args cmt_tbl_copy) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -4521,62 +4521,62 @@ and printArgumentsWithCallbackInFirstPosition ~dotted ~state args cmtTbl = * In this case, we always want the arguments broken over multiple lines, * like a normal function call. *) - 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] + 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] -and printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl = +and print_arguments_with_callback_in_last_position ~state ~dotted args cmt_tbl = (* 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.nextCustomLayout in - let cmtTblCopy = CommentTable.copy cmtTbl in - let cmtTblCopy2 = CommentTable.copy cmtTbl in + 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 rec loop acc args = match args with | [] -> (lazy Doc.nil, lazy Doc.nil, lazy Doc.nil) | [(lbl, expr)] -> - let lblDoc = + let lbl_doc = match lbl with | Asttypes.Nolabel -> Doc.nil | Asttypes.Labelled txt -> - Doc.concat [Doc.tilde; printIdentLike txt; Doc.equal] + Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal] | Asttypes.Optional txt -> - Doc.concat [Doc.tilde; printIdentLike txt; Doc.equal; Doc.question] + Doc.concat [Doc.tilde; print_ident_like txt; Doc.equal; Doc.question] in - let callbackFitsOnOneLine = + let callback_fits_on_one_line = lazy - (let pexpFunDoc = - printPexpFun ~state ~inCallback:FitsOnOneLine expr cmtTbl + (let pexp_fun_doc = + print_pexp_fun ~state ~in_callback:FitsOnOneLine expr cmt_tbl in - let doc = Doc.concat [lblDoc; pexpFunDoc] in - printComments doc cmtTbl expr.pexp_loc) + let doc = Doc.concat [lbl_doc; pexp_fun_doc] in + print_comments doc cmt_tbl expr.pexp_loc) in - let callbackArgumentsFitsOnOneLine = + let callback_arguments_fits_on_one_line = lazy - (let pexpFunDoc = - printPexpFun ~state ~inCallback:ArgumentsFitOnOneLine expr - cmtTblCopy + (let pexp_fun_doc = + print_pexp_fun ~state ~in_callback:ArgumentsFitOnOneLine expr + cmt_tbl_copy in - let doc = Doc.concat [lblDoc; pexpFunDoc] in - printComments doc cmtTblCopy expr.pexp_loc) + let doc = Doc.concat [lbl_doc; pexp_fun_doc] in + print_comments doc cmt_tbl_copy expr.pexp_loc) in ( lazy (Doc.concat (List.rev acc)), - callbackFitsOnOneLine, - callbackArgumentsFitsOnOneLine ) + callback_fits_on_one_line, + callback_arguments_fits_on_one_line ) | arg :: args -> - let argDoc = printArgument ~state arg cmtTbl in - loop (Doc.line :: Doc.comma :: argDoc :: acc) args + let arg_doc = print_argument ~state arg cmt_tbl in + loop (Doc.line :: Doc.comma :: arg_doc :: acc) args in - let printedArgs, callback, callback2 = loop [] args in + let printed_args, callback, callback2 = loop [] args in (* Thing.map(foo, (arg1, arg2) => MyModuleBlah.toList(argument)) *) - let fitsOnOneLine = + let fits_on_one_line = lazy (Doc.concat [ (if dotted then Doc.text "(." else Doc.lparen); - Lazy.force printedArgs; + Lazy.force printed_args; Lazy.force callback; Doc.rparen; ]) @@ -4586,13 +4586,13 @@ and printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl = * MyModuleBlah.toList(argument) * ) *) - let arugmentsFitOnOneLine = + let arugments_fit_on_one_line = lazy (Doc.concat [ (if dotted then Doc.text "(." else Doc.lparen); - Lazy.force printedArgs; - Doc.breakableGroup ~forceBreak:true (Lazy.force callback2); + Lazy.force printed_args; + Doc.breakable_group ~force_break:true (Lazy.force callback2); Doc.rparen; ]) in @@ -4604,7 +4604,7 @@ and printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl = * (param1, parm2) => doStuff(param1, parm2) * ) *) - let breakAllArgs = lazy (printArguments ~state ~dotted args cmtTblCopy2) in + let break_all_args = lazy (print_arguments ~state ~dotted args cmt_tbl_copy2) in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -4621,18 +4621,18 @@ and printArgumentsWithCallbackInLastPosition ~state ~dotted args cmtTbl = * In this case, we always want the arguments broken over multiple lines, * like a normal function call. *) - if state |> State.shouldBreakCallback then Lazy.force breakAllArgs - else if Doc.willBreak (Lazy.force printedArgs) then Lazy.force breakAllArgs + 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.customLayout + Doc.custom_layout [ - Lazy.force fitsOnOneLine; - Lazy.force arugmentsFitOnOneLine; - Lazy.force breakAllArgs; + Lazy.force fits_on_one_line; + Lazy.force arugments_fit_on_one_line; + Lazy.force break_all_args; ] -and printArguments ~state ~dotted ?(partial = false) - (args : (Asttypes.arg_label * Parsetree.expression) list) cmtTbl = +and print_arguments ~state ~dotted ?(partial = false) + (args : (Asttypes.arg_label * Parsetree.expression) list) cmt_tbl = match args with | [ ( Nolabel, @@ -4648,16 +4648,16 @@ and printArguments ~state ~dotted ?(partial = false) | true, true -> Doc.text "(.)" (* arity zero *) | true, false -> Doc.text "(. ())" (* arity one *) | _ -> Doc.text "()") - | [(Nolabel, arg)] when ParsetreeViewer.isHuggableExpression arg -> - let argDoc = - let doc = printExpressionWithComments ~state arg cmtTbl in + | [(Nolabel, arg)] when ParsetreeViewer.is_huggable_expression arg -> + let arg_doc = + let doc = print_expression_with_comments ~state arg cmt_tbl in match Parens.expr arg with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc arg braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc arg braces | Nothing -> doc in Doc.concat - [(if dotted then Doc.text "(. " else Doc.lparen); argDoc; Doc.rparen] + [(if dotted then Doc.text "(. " else Doc.lparen); arg_doc; Doc.rparen] | args -> Doc.group (Doc.concat @@ -4666,13 +4666,13 @@ and printArguments ~state ~dotted ?(partial = false) Doc.indent (Doc.concat [ - (if dotted then Doc.line else Doc.softLine); + (if dotted then Doc.line else Doc.soft_line); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map (fun arg -> printArgument ~state arg cmtTbl) args); + (List.map (fun arg -> print_argument ~state arg cmt_tbl) args); ]); - (if partial then Doc.nil else Doc.trailingComma); - Doc.softLine; + (if partial then Doc.nil else Doc.trailing_comma); + Doc.soft_line; Doc.rparen; ]) @@ -4690,34 +4690,34 @@ and printArguments ~state ~dotted ?(partial = false) * | ~ label-name = ? expr * | ~ label-name = ? _ (* syntax sugar *) * | ~ label-name = ? expr : type *) -and printArgument ~state (argLbl, arg) cmtTbl = - match (argLbl, arg) with +and print_argument ~state (arg_lbl, arg) cmt_tbl = + match (arg_lbl, arg) with (* ~a (punned)*) | ( Labelled lbl, ({ pexp_desc = Pexp_ident {txt = Longident.Lident name}; pexp_attributes = [] | [({Location.txt = "res.namedArgLoc"}, _)]; - } as argExpr) ) - when lbl = name && not (ParsetreeViewer.isBracedExpr argExpr) -> + } as arg_expr) ) + when lbl = name && not (ParsetreeViewer.is_braced_expr arg_expr) -> let loc = match arg.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _ -> loc | _ -> arg.pexp_loc in - let doc = Doc.concat [Doc.tilde; printIdentLike lbl] in - printComments doc cmtTbl loc + let doc = Doc.concat [Doc.tilde; print_ident_like lbl] in + print_comments doc cmt_tbl loc (* ~a: int (punned)*) | ( Labelled lbl, { pexp_desc = Pexp_constraint - ( ({pexp_desc = Pexp_ident {txt = Longident.Lident name}} as argExpr), + ( ({pexp_desc = Pexp_ident {txt = Longident.Lident name}} as arg_expr), typ ); pexp_loc; pexp_attributes = ([] | [({Location.txt = "res.namedArgLoc"}, _)]) as attrs; } ) - when lbl = name && not (ParsetreeViewer.isBracedExpr argExpr) -> + when lbl = name && not (ParsetreeViewer.is_braced_expr arg_expr) -> let loc = match attrs with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _ -> @@ -4728,12 +4728,12 @@ and printArgument ~state (argLbl, arg) cmtTbl = Doc.concat [ Doc.tilde; - printIdentLike lbl; + print_ident_like lbl; Doc.text ": "; - printTypExpr ~state typ cmtTbl; + print_typ_expr ~state typ cmt_tbl; ] in - printComments doc cmtTbl loc + print_comments doc cmt_tbl loc (* ~a? (optional lbl punned)*) | ( Optional lbl, { @@ -4746,78 +4746,78 @@ and printArgument ~state (argLbl, arg) cmtTbl = | ({Location.txt = "res.namedArgLoc"; loc}, _) :: _ -> loc | _ -> arg.pexp_loc in - let doc = Doc.concat [Doc.tilde; printIdentLike lbl; Doc.question] in - printComments doc cmtTbl loc + let doc = Doc.concat [Doc.tilde; print_ident_like lbl; Doc.question] in + print_comments doc cmt_tbl loc | _lbl, expr -> - let argLoc, expr = + let arg_loc, expr = match expr.pexp_attributes with | ({Location.txt = "res.namedArgLoc"; loc}, _) :: attrs -> (loc, {expr with pexp_attributes = attrs}) | _ -> (expr.pexp_loc, expr) in - let printedLbl, dotdotdot = - match argLbl with + let printed_lbl, dotdotdot = + match arg_lbl with | Nolabel -> (Doc.nil, false) | Labelled "..." -> let doc = Doc.text "..." in - (printComments doc cmtTbl argLoc, true) + (print_comments doc cmt_tbl arg_loc, true) | Labelled lbl -> - let doc = Doc.concat [Doc.tilde; printIdentLike lbl; Doc.equal] in - (printComments doc cmtTbl argLoc, false) + let doc = Doc.concat [Doc.tilde; print_ident_like lbl; Doc.equal] in + (print_comments doc cmt_tbl arg_loc, false) | Optional lbl -> let doc = - Doc.concat [Doc.tilde; printIdentLike lbl; Doc.equal; Doc.question] + Doc.concat [Doc.tilde; print_ident_like lbl; Doc.equal; Doc.question] in - (printComments doc cmtTbl argLoc, false) + (print_comments doc cmt_tbl arg_loc, false) in - let printedExpr = - let doc = printExpressionWithComments ~state expr cmtTbl in + let printed_expr = + let doc = print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in - let loc = {argLoc with loc_end = expr.pexp_loc.loc_end} in + let loc = {arg_loc with loc_end = expr.pexp_loc.loc_end} in let doc = - if dotdotdot then printedLbl else Doc.concat [printedLbl; printedExpr] + if dotdotdot then printed_lbl else Doc.concat [printed_lbl; printed_expr] in - printComments doc cmtTbl loc + print_comments doc cmt_tbl loc -and printCases ~state (cases : Parsetree.case list) cmtTbl = - Doc.breakableGroup ~forceBreak:true +and print_cases ~state (cases : Parsetree.case list) cmt_tbl = + Doc.breakable_group ~force_break:true (Doc.concat [ Doc.lbrace; Doc.concat [ Doc.line; - printList - ~getLoc:(fun n -> + print_list + ~get_loc:(fun n -> { n.Parsetree.pc_lhs.ppat_loc with loc_end = - (match ParsetreeViewer.processBracesAttr n.pc_rhs with + (match ParsetreeViewer.process_braces_attr n.pc_rhs with | None, _ -> n.pc_rhs.pexp_loc.loc_end | Some ({loc}, _), _ -> loc.Location.loc_end); }) - ~print:(printCase ~state) ~nodes:cases cmtTbl; + ~print:(print_case ~state) ~nodes:cases cmt_tbl; ]; Doc.line; Doc.rbrace; ]) -and printCase ~state (case : Parsetree.case) cmtTbl = +and print_case ~state (case : Parsetree.case) cmt_tbl = let rhs = match case.pc_rhs.pexp_desc with | Pexp_let _ | Pexp_letmodule _ | Pexp_letexception _ | Pexp_open _ | Pexp_sequence _ -> - printExpressionBlock ~state - ~braces:(ParsetreeViewer.isBracedExpr case.pc_rhs) - case.pc_rhs cmtTbl + print_expression_block ~state + ~braces:(ParsetreeViewer.is_braced_expr case.pc_rhs) + case.pc_rhs cmt_tbl | _ -> ( - let doc = printExpressionWithComments ~state case.pc_rhs cmtTbl in + let doc = print_expression_with_comments ~state case.pc_rhs cmt_tbl in match Parens.expr case.pc_rhs with - | Parenthesized -> addParens doc + | Parenthesized -> add_parens doc | _ -> doc) in @@ -4830,43 +4830,43 @@ and printCase ~state (case : Parsetree.case) cmtTbl = [ Doc.line; Doc.text "if "; - printExpressionWithComments ~state expr cmtTbl; + print_expression_with_comments ~state expr cmt_tbl; ]) in - let shouldInlineRhs = + let should_inline_rhs = match case.pc_rhs.pexp_desc with | Pexp_construct ({txt = Longident.Lident ("()" | "true" | "false")}, _) | Pexp_constant _ | Pexp_ident _ -> true - | _ when ParsetreeViewer.isHuggableRhs case.pc_rhs -> true + | _ when ParsetreeViewer.is_huggable_rhs case.pc_rhs -> true | _ -> false in - let shouldIndentPattern = + let should_indent_pattern = match case.pc_lhs.ppat_desc with | Ppat_or _ -> false | _ -> true in - let patternDoc = - let doc = printPattern ~state case.pc_lhs cmtTbl in + let pattern_doc = + let doc = print_pattern ~state case.pc_lhs cmt_tbl in match case.pc_lhs.ppat_desc with - | Ppat_constraint _ -> addParens doc + | Ppat_constraint _ -> add_parens doc | _ -> doc in let content = Doc.concat [ - (if shouldIndentPattern then Doc.indent patternDoc else patternDoc); + (if should_indent_pattern then Doc.indent pattern_doc else pattern_doc); Doc.indent guard; Doc.text " =>"; Doc.indent - (Doc.concat [(if shouldInlineRhs then Doc.space else Doc.line); rhs]); + (Doc.concat [(if should_inline_rhs then Doc.space else Doc.line); rhs]); ] in Doc.group (Doc.concat [Doc.text "| "; content]) -and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint - parameters cmtTbl = - let dotted = state.uncurried_config |> Res_uncurried.getDotted ~uncurried in +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 match parameters with (* let f = _ => () *) | [ @@ -4874,137 +4874,137 @@ and printExprFunParameters ~state ~inCallback ~async ~uncurried ~hasConstraint { attrs = []; lbl = Asttypes.Nolabel; - defaultExpr = None; + default_expr = None; pat = {Parsetree.ppat_desc = Ppat_any; ppat_loc}; }; ] when not dotted -> let any = - let doc = if hasConstraint then Doc.text "(_)" else Doc.text "_" in - printComments doc cmtTbl ppat_loc + let doc = if has_constraint then Doc.text "(_)" else Doc.text "_" in + print_comments doc cmt_tbl ppat_loc in - if async then addAsync any else any + if async then add_async any else any (* let f = a => () *) | [ ParsetreeViewer.Parameter { attrs = []; lbl = Asttypes.Nolabel; - defaultExpr = None; + default_expr = None; pat = { - Parsetree.ppat_desc = Ppat_var stringLoc; + Parsetree.ppat_desc = Ppat_var string_loc; Parsetree.ppat_attributes = attrs; }; }; ] when not dotted -> - let txtDoc = - let var = printIdentLike stringLoc.txt in + let txt_doc = + let var = print_ident_like string_loc.txt in let var = match attrs with - | [] -> if hasConstraint then addParens var else var + | [] -> if has_constraint then add_parens var else var | attrs -> - let attrs = printAttributes ~state attrs cmtTbl in - addParens (Doc.concat [attrs; var]) + let attrs = print_attributes ~state attrs cmt_tbl in + add_parens (Doc.concat [attrs; var]) in - if async then addAsync var else var + if async then add_async var else var in - printComments txtDoc cmtTbl stringLoc.loc + print_comments txt_doc cmt_tbl string_loc.loc (* let f = () => () *) | [ ParsetreeViewer.Parameter { attrs = []; lbl = Asttypes.Nolabel; - defaultExpr = None; + default_expr = None; pat = {ppat_desc = Ppat_construct ({txt = Longident.Lident "()"; loc}, None)}; }; ] when not dotted -> let doc = - let lparenRparen = Doc.text "()" in - if async then addAsync lparenRparen else lparenRparen + let lparen_rparen = Doc.text "()" in + if async then add_async lparen_rparen else lparen_rparen in - printComments doc cmtTbl loc + print_comments doc cmt_tbl loc (* let f = (~greeting, ~from as hometown, ~x=?) => () *) | parameters -> - let inCallback = - match inCallback with + let in_callback = + match in_callback with | FitsOnOneLine -> true | _ -> false in - let maybeAsyncLparen = + let maybe_async_lparen = let lparen = if dotted then Doc.text "(. " else Doc.lparen in - if async then addAsync lparen else lparen + if async then add_async lparen else lparen in - let shouldHug = ParsetreeViewer.parametersShouldHug parameters in - let printedParamaters = + let should_hug = ParsetreeViewer.parameters_should_hug parameters in + let printed_paramaters = Doc.concat [ - (if shouldHug || inCallback then Doc.nil else Doc.softLine); + (if should_hug || in_callback then Doc.nil else Doc.soft_line); Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun p -> printExpFunParameter ~state p cmtTbl) + (fun p -> print_exp_fun_parameter ~state p cmt_tbl) parameters); ] in Doc.group (Doc.concat [ - maybeAsyncLparen; - (if shouldHug || inCallback then printedParamaters + maybe_async_lparen; + (if should_hug || in_callback then printed_paramaters else Doc.concat - [Doc.indent printedParamaters; Doc.trailingComma; Doc.softLine]); + [Doc.indent printed_paramaters; Doc.trailing_comma; Doc.soft_line]); Doc.rparen; ]) -and printExpFunParameter ~state parameter cmtTbl = +and print_exp_fun_parameter ~state parameter cmt_tbl = match parameter with | ParsetreeViewer.NewTypes {attrs; locs = lbls} -> Doc.group (Doc.concat [ - printAttributes ~state attrs cmtTbl; + print_attributes ~state attrs cmt_tbl; Doc.text "type "; (* XX *) Doc.join ~sep:Doc.space (List.map (fun lbl -> - printComments - (printIdentLike lbl.Asttypes.txt) - cmtTbl lbl.Asttypes.loc) + print_comments + (print_ident_like lbl.Asttypes.txt) + cmt_tbl lbl.Asttypes.loc) lbls); ]) - | 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 + | 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 (* =defaultValue *) - let defaultExprDoc = - match defaultExpr with + let default_expr_doc = + match default_expr with | Some expr -> Doc.concat - [Doc.text "="; printExpressionWithComments ~state expr cmtTbl] + [Doc.text "="; print_expression_with_comments ~state expr cmt_tbl] | None -> Doc.nil in (* ~from as hometown * ~from -> punning *) - let labelWithPattern = + let label_with_pattern = match (lbl, pattern) with - | Asttypes.Nolabel, pattern -> printPattern ~state pattern cmtTbl + | Asttypes.Nolabel, pattern -> print_pattern ~state pattern cmt_tbl | ( (Asttypes.Labelled lbl | Optional lbl), - {ppat_desc = Ppat_var stringLoc; ppat_attributes} ) - when lbl = stringLoc.txt -> + {ppat_desc = Ppat_var string_loc; ppat_attributes} ) + when lbl = string_loc.txt -> (* ~d *) Doc.concat [ - printAttributes ~state ppat_attributes cmtTbl; + print_attributes ~state ppat_attributes cmt_tbl; Doc.text "~"; - printIdentLike lbl; + print_ident_like lbl; ] | ( (Asttypes.Labelled lbl | Optional lbl), { @@ -5015,24 +5015,24 @@ and printExpFunParameter ~state parameter cmtTbl = (* ~d: e *) Doc.concat [ - printAttributes ~state ppat_attributes cmtTbl; + print_attributes ~state ppat_attributes cmt_tbl; Doc.text "~"; - printIdentLike lbl; + print_ident_like lbl; Doc.text ": "; - printTypExpr ~state typ cmtTbl; + print_typ_expr ~state typ cmt_tbl; ] | (Asttypes.Labelled lbl | Optional lbl), pattern -> (* ~b as c *) Doc.concat [ Doc.text "~"; - printIdentLike lbl; + print_ident_like lbl; Doc.text " as "; - printPattern ~state pattern cmtTbl; + print_pattern ~state pattern cmt_tbl; ] in - let optionalLabelSuffix = - match (lbl, defaultExpr) with + let optional_label_suffix = + match (lbl, default_expr) with | Asttypes.Optional _, None -> Doc.text "=?" | _ -> Doc.nil in @@ -5040,117 +5040,117 @@ and printExpFunParameter ~state parameter cmtTbl = Doc.group (Doc.concat [ - dotted; attrs; labelWithPattern; defaultExprDoc; optionalLabelSuffix; + dotted; attrs; label_with_pattern; default_expr_doc; optional_label_suffix; ]) in - let cmtLoc = - match defaultExpr with + let cmt_loc = + match default_expr 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 startPos = + let start_pos = 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 = startPos; + loc_start = start_pos; loc_end = expr.pexp_loc.loc_end; } in - printComments doc cmtTbl cmtLoc + print_comments doc cmt_tbl cmt_loc -and printExpressionBlock ~state ~braces expr cmtTbl = - let rec collectRows acc expr = +and print_expression_block ~state ~braces expr cmt_tbl = + let rec collect_rows acc expr = match expr.Parsetree.pexp_desc with - | Parsetree.Pexp_letmodule (modName, modExpr, expr2) -> + | Parsetree.Pexp_letmodule (mod_name, mod_expr, expr2) -> let name = - let doc = Doc.text modName.txt in - printComments doc cmtTbl modName.loc + let doc = Doc.text mod_name.txt in + print_comments doc cmt_tbl mod_name.loc in - let name, modExpr = - match modExpr.pmod_desc with - | Pmod_constraint (modExpr2, modType) - when not (ParsetreeViewer.hasAwaitAttribute modExpr.pmod_attributes) + 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 = - Doc.concat [name; Doc.text ": "; printModType ~state modType cmtTbl] + Doc.concat [name; Doc.text ": "; print_mod_type ~state mod_type cmt_tbl] in - (name, modExpr2) - | _ -> (name, modExpr) + (name, mod_expr2) + | _ -> (name, mod_expr) in - let letModuleDoc = + let let_module_doc = Doc.concat [ Doc.text "module "; name; Doc.text " = "; - printModExpr ~state modExpr cmtTbl; + print_mod_expr ~state mod_expr cmt_tbl; ] in - 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 = {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 = let loc = - {expr.pexp_loc with loc_end = extensionConstructor.pext_loc.loc_end} + {expr.pexp_loc with loc_end = extension_constructor.pext_loc.loc_end} in - match getFirstLeadingComment cmtTbl loc with + match get_first_leading_comment cmt_tbl loc with | None -> loc | Some comment -> - let cmtLoc = Comment.loc comment in - {cmtLoc with loc_end = loc.loc_end} + let cmt_loc = Comment.loc comment in + {cmt_loc with loc_end = loc.loc_end} in - let letExceptionDoc = - printExceptionDef ~state extensionConstructor cmtTbl + let let_exception_doc = + print_exception_def ~state extension_constructor cmt_tbl in - collectRows ((loc, letExceptionDoc) :: acc) expr2 - | Pexp_open (overrideFlag, longidentLoc, expr2) -> - let openDoc = + collect_rows ((loc, let_exception_doc) :: acc) expr2 + | Pexp_open (override_flag, longident_loc, expr2) -> + let open_doc = Doc.concat [ Doc.text "open"; - printOverrideFlag overrideFlag; + print_override_flag override_flag; Doc.space; - printLongidentLocation longidentLoc cmtTbl; + print_longident_location longident_loc cmt_tbl; ] in - let loc = {expr.pexp_loc with loc_end = longidentLoc.loc.loc_end} in - collectRows ((loc, openDoc) :: acc) expr2 + let loc = {expr.pexp_loc with loc_end = longident_loc.loc.loc_end} in + collect_rows ((loc, open_doc) :: acc) expr2 | Pexp_sequence (expr1, expr2) -> - let exprDoc = - let doc = printExpression ~state expr1 cmtTbl in + let expr_doc = + let doc = print_expression ~state expr1 cmt_tbl in match Parens.expr expr1 with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr1 braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr1 braces | Nothing -> doc in let loc = expr1.pexp_loc in - collectRows ((loc, exprDoc) :: acc) expr2 - | Pexp_let (recFlag, valueBindings, expr2) -> ( + collect_rows ((loc, expr_doc) :: acc) expr2 + | Pexp_let (rec_flag, value_bindings, expr2) -> ( let loc = let loc = - match (valueBindings, List.rev valueBindings) with - | vb :: _, lastVb :: _ -> - {vb.pvb_loc with loc_end = lastVb.pvb_loc.loc_end} + match (value_bindings, List.rev value_bindings) with + | vb :: _, last_vb :: _ -> + {vb.pvb_loc with loc_end = last_vb.pvb_loc.loc_end} | _ -> Location.none in - match getFirstLeadingComment cmtTbl loc with + match get_first_leading_comment cmt_tbl loc with | None -> loc | Some comment -> - let cmtLoc = Comment.loc comment in - {cmtLoc with loc_end = loc.loc_end} + let cmt_loc = Comment.loc comment in + {cmt_loc with loc_end = loc.loc_end} in - let recFlag = - match recFlag with + let rec_flag = + match rec_flag with | Asttypes.Nonrecursive -> Doc.nil | Asttypes.Recursive -> Doc.text "rec " in - let letDoc = printValueBindings ~state ~recFlag valueBindings cmtTbl in + let let_doc = print_value_bindings ~state ~rec_flag value_bindings cmt_tbl in (* let () = { * let () = foo() * () @@ -5159,25 +5159,25 @@ and printExpressionBlock ~state ~braces expr cmtTbl = *) match expr2.pexp_desc with | Pexp_construct ({txt = Longident.Lident "()"}, _) -> - List.rev ((loc, letDoc) :: acc) - | _ -> collectRows ((loc, letDoc) :: acc) expr2) + List.rev ((loc, let_doc) :: acc) + | _ -> collect_rows ((loc, let_doc) :: acc) expr2) | _ -> - let exprDoc = - let doc = printExpression ~state expr cmtTbl in + let expr_doc = + let doc = print_expression ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc in - List.rev ((expr.pexp_loc, exprDoc) :: acc) + List.rev ((expr.pexp_loc, expr_doc) :: acc) in - let rows = collectRows [] expr in + let rows = collect_rows [] expr in let block = - printList ~getLoc:fst ~nodes:rows + print_list ~get_loc:fst ~nodes:rows ~print:(fun (_, doc) _ -> doc) - ~forceBreak:true cmtTbl + ~force_break:true cmt_tbl in - Doc.breakableGroup ~forceBreak:true + Doc.breakable_group ~force_break:true (if braces then Doc.concat [ @@ -5205,10 +5205,10 @@ and printExpressionBlock ~state ~braces expr cmtTbl = * a + b * } *) -and printBraces doc expr bracesLoc = - let overMultipleLines = +and print_braces doc expr braces_loc = + let over_multiple_lines = let open Location in - bracesLoc.loc_end.pos_lnum > bracesLoc.loc_start.pos_lnum + braces_loc.loc_end.pos_lnum > braces_loc.loc_start.pos_lnum in match expr.Parsetree.pexp_desc with | Pexp_letmodule _ | Pexp_letexception _ | Pexp_let _ | Pexp_open _ @@ -5216,80 +5216,80 @@ and printBraces doc expr bracesLoc = (* already has braces *) doc | _ -> - Doc.breakableGroup ~forceBreak:overMultipleLines + Doc.breakable_group ~force_break:over_multiple_lines (Doc.concat [ Doc.lbrace; Doc.indent (Doc.concat [ - Doc.softLine; - (if Parens.bracedExpr expr then addParens doc else doc); + Doc.soft_line; + (if Parens.braced_expr expr then add_parens doc else doc); ]); - Doc.softLine; + Doc.soft_line; Doc.rbrace; ]) -and printOverrideFlag overrideFlag = - match overrideFlag with +and print_override_flag override_flag = + match override_flag with | Asttypes.Override -> Doc.text "!" | Fresh -> Doc.nil -and printDirectionFlag flag = +and print_direction_flag flag = match flag with | Asttypes.Downto -> Doc.text " downto " | Asttypes.Upto -> Doc.text " to " -and printExpressionRecordRow ~state (lbl, expr) cmtTbl punningAllowed = - let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in +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 let doc = Doc.group (match expr.pexp_desc with | Pexp_ident {txt = Lident key; loc = _keyLoc} - when punningAllowed && Longident.last lbl.txt = key -> + when punning_allowed && Longident.last lbl.txt = key -> (* print punned field *) Doc.concat [ - printAttributes ~state expr.pexp_attributes cmtTbl; - printOptionalLabel expr.pexp_attributes; - printLidentPath lbl cmtTbl; + print_attributes ~state expr.pexp_attributes cmt_tbl; + print_optional_label expr.pexp_attributes; + print_lident_path lbl cmt_tbl; ] | _ -> Doc.concat [ - printLidentPath lbl cmtTbl; + print_lident_path lbl cmt_tbl; Doc.text ": "; - 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 + 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 | Nothing -> doc); ]) in - printComments doc cmtTbl cmtLoc + print_comments doc cmt_tbl cmt_loc -and printBsObjectRow ~state (lbl, expr) cmtTbl = - let cmtLoc = {lbl.loc with loc_end = expr.pexp_loc.loc_end} in - let lblDoc = +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 = let doc = - Doc.concat [Doc.text "\""; printLongident lbl.txt; Doc.text "\""] + Doc.concat [Doc.text "\""; print_longident lbl.txt; Doc.text "\""] in - printComments doc cmtTbl lbl.loc + print_comments doc cmt_tbl lbl.loc in let doc = Doc.concat [ - lblDoc; + lbl_doc; Doc.text ": "; - (let doc = printExpressionWithComments ~state expr cmtTbl in + (let doc = print_expression_with_comments ~state expr cmt_tbl in match Parens.expr expr with - | Parens.Parenthesized -> addParens doc - | Braced braces -> printBraces doc expr braces + | Parens.Parenthesized -> add_parens doc + | Braced braces -> print_braces doc expr braces | Nothing -> doc); ] in - printComments doc cmtTbl cmtLoc + print_comments doc cmt_tbl cmt_loc (* The optional loc indicates whether we need to print the attributes in * relation to some location. In practise this means the following: @@ -5297,46 +5297,46 @@ and printBsObjectRow ~state (lbl, expr) cmtTbl = * `@attr * type t = string` -> attr is on prev line, print the attributes * with a line break between, we respect the users' original layout *) -and printAttributes ?loc ?(inline = false) ~state (attrs : Parsetree.attributes) - cmtTbl = - match ParsetreeViewer.filterParsingAttrs attrs with +and print_attributes ?loc ?(inline = false) ~state (attrs : Parsetree.attributes) + cmt_tbl = + match ParsetreeViewer.filter_parsing_attrs attrs with | [] -> Doc.nil | attrs -> - let lineBreak = + let line_break = match loc with | None -> Doc.line | Some loc -> ( match List.rev attrs with - | ({loc = firstLoc}, _) :: _ - when loc.loc_start.pos_lnum > firstLoc.loc_end.pos_lnum -> - Doc.hardLine + | ({loc = first_loc}, _) :: _ + when loc.loc_start.pos_lnum > first_loc.loc_end.pos_lnum -> + Doc.hard_line | _ -> Doc.line) in Doc.concat [ Doc.group - (Doc.joinWithSep - (List.map (fun attr -> printAttribute ~state attr cmtTbl) attrs)); - (if inline then Doc.space else lineBreak); + (Doc.join_with_sep + (List.map (fun attr -> print_attribute ~state attr cmt_tbl) attrs)); + (if inline then Doc.space else line_break); ] -and printPayload ~state (payload : Parsetree.payload) cmtTbl = +and print_payload ~state (payload : Parsetree.payload) cmt_tbl = match payload with | PStr [] -> Doc.nil | PStr [{pstr_desc = Pstr_eval (expr, attrs)}] -> - let exprDoc = printExpressionWithComments ~state expr cmtTbl in - let needsParens = + let expr_doc = print_expression_with_comments ~state expr cmt_tbl in + let needs_parens = match attrs with | [] -> false | _ -> true in - let shouldHug = ParsetreeViewer.isHuggableExpression expr in - if shouldHug then + let should_hug = ParsetreeViewer.is_huggable_expression expr in + if should_hug then Doc.concat [ Doc.lparen; - printAttributes ~state attrs cmtTbl; - (if needsParens then addParens exprDoc else exprDoc); + print_attributes ~state attrs cmt_tbl; + (if needs_parens then add_parens expr_doc else expr_doc); Doc.rparen; ] else @@ -5346,34 +5346,34 @@ and printPayload ~state (payload : Parsetree.payload) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; - printAttributes ~state attrs cmtTbl; - (if needsParens then addParens exprDoc else exprDoc); + Doc.soft_line; + print_attributes ~state attrs cmt_tbl; + (if needs_parens then add_parens expr_doc else expr_doc); ]); - Doc.softLine; + Doc.soft_line; Doc.rparen; ] | PStr [({pstr_desc = Pstr_value (_recFlag, _bindings)} as si)] -> - addParens (printStructureItem ~state si cmtTbl) - | PStr structure -> addParens (printStructure ~state structure cmtTbl) + add_parens (print_structure_item ~state si cmt_tbl) + | PStr structure -> add_parens (print_structure ~state structure cmt_tbl) | PTyp typ -> Doc.concat [ Doc.lparen; Doc.text ":"; - Doc.indent (Doc.concat [Doc.line; printTypExpr ~state typ cmtTbl]); - Doc.softLine; + Doc.indent (Doc.concat [Doc.line; print_typ_expr ~state typ cmt_tbl]); + Doc.soft_line; Doc.rparen; ] - | PPat (pat, optExpr) -> - let whenDoc = - match optExpr with + | PPat (pat, opt_expr) -> + let when_doc = + match opt_expr with | Some expr -> Doc.concat [ Doc.line; Doc.text "if "; - printExpressionWithComments ~state expr cmtTbl; + print_expression_with_comments ~state expr cmt_tbl; ] | None -> Doc.nil in @@ -5383,12 +5383,12 @@ and printPayload ~state (payload : Parsetree.payload) cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.text "? "; - printPattern ~state pat cmtTbl; - whenDoc; + print_pattern ~state pat cmt_tbl; + when_doc; ]); - Doc.softLine; + Doc.soft_line; Doc.rparen; ] | PSig signature -> @@ -5397,13 +5397,13 @@ and printPayload ~state (payload : Parsetree.payload) cmtTbl = Doc.lparen; Doc.text ":"; Doc.indent - (Doc.concat [Doc.line; printSignature ~state signature cmtTbl]); - Doc.softLine; + (Doc.concat [Doc.line; print_signature ~state signature cmt_tbl]); + Doc.soft_line; Doc.rparen; ] -and printAttribute ?(standalone = false) ~state - ((id, payload) : Parsetree.attribute) cmtTbl = +and print_attribute ?(standalone = false) ~state + ((id, payload) : Parsetree.attribute) cmt_tbl = match (id, payload) with | ( {txt = "res.doc"}, PStr @@ -5419,7 +5419,7 @@ and printAttribute ?(standalone = false) ~state Doc.text txt; Doc.text "*/"; ], - Doc.hardLine ) + Doc.hard_line ) | _ -> let id = match id.txt with @@ -5436,34 +5436,34 @@ and printAttribute ?(standalone = false) ~state [ Doc.text (if standalone then "@@" else "@"); Doc.text id.txt; - printPayload ~state payload cmtTbl; + print_payload ~state payload cmt_tbl; ]), Doc.line ) -and printModExpr ~state modExpr cmtTbl = +and print_mod_expr ~state mod_expr cmt_tbl = let doc = - match modExpr.pmod_desc with - | Pmod_ident longidentLoc -> printLongidentLocation longidentLoc cmtTbl + match mod_expr.pmod_desc with + | Pmod_ident longident_loc -> print_longident_location longident_loc cmt_tbl | Pmod_structure [] -> - let shouldBreak = - modExpr.pmod_loc.loc_start.pos_lnum < modExpr.pmod_loc.loc_end.pos_lnum + let should_break = + mod_expr.pmod_loc.loc_start.pos_lnum < mod_expr.pmod_loc.loc_end.pos_lnum in - Doc.breakableGroup ~forceBreak:shouldBreak + Doc.breakable_group ~force_break:should_break (Doc.concat - [Doc.lbrace; printCommentsInside cmtTbl modExpr.pmod_loc; Doc.rbrace]) + [Doc.lbrace; print_comments_inside cmt_tbl mod_expr.pmod_loc; Doc.rbrace]) | Pmod_structure structure -> - Doc.breakableGroup ~forceBreak:true + Doc.breakable_group ~force_break:true (Doc.concat [ Doc.lbrace; Doc.indent (Doc.concat - [Doc.softLine; printStructure ~state structure cmtTbl]); - Doc.softLine; + [Doc.soft_line; print_structure ~state structure cmt_tbl]); + Doc.soft_line; Doc.rbrace; ]) | Pmod_unpack expr -> - let shouldHug = + let should_hug = match expr.pexp_desc with | Pexp_let _ -> true | Pexp_constraint @@ -5472,53 +5472,53 @@ and printModExpr ~state modExpr cmtTbl = true | _ -> false in - let expr, moduleConstraint = + let expr, module_constraint = match expr.pexp_desc with | Pexp_constraint - (expr, {ptyp_desc = Ptyp_package packageType; ptyp_loc}) -> - let packageDoc = + (expr, {ptyp_desc = Ptyp_package package_type; ptyp_loc}) -> + let package_doc = let doc = - printPackageType ~state ~printModuleKeywordAndParens:false - packageType cmtTbl + print_package_type ~state ~print_module_keyword_and_parens:false + package_type cmt_tbl in - printComments doc cmtTbl ptyp_loc + print_comments doc cmt_tbl ptyp_loc in - let typeDoc = + let type_doc = Doc.group (Doc.concat - [Doc.text ":"; Doc.indent (Doc.concat [Doc.line; packageDoc])]) + [Doc.text ":"; Doc.indent (Doc.concat [Doc.line; package_doc])]) in - (expr, typeDoc) + (expr, type_doc) | _ -> (expr, Doc.nil) in - let unpackDoc = + let unpack_doc = Doc.group (Doc.concat - [printExpressionWithComments ~state expr cmtTbl; moduleConstraint]) + [print_expression_with_comments ~state expr cmt_tbl; module_constraint]) in Doc.group (Doc.concat [ Doc.text "unpack("; - (if shouldHug then unpackDoc + (if should_hug then unpack_doc else Doc.concat [ - Doc.indent (Doc.concat [Doc.softLine; unpackDoc]); - Doc.softLine; + Doc.indent (Doc.concat [Doc.soft_line; unpack_doc]); + Doc.soft_line; ]); Doc.rparen; ]) | Pmod_extension extension -> - printExtension ~state ~atModuleLvl:false extension cmtTbl + print_extension ~state ~at_module_lvl:false extension cmt_tbl | Pmod_apply _ -> - let args, callExpr = ParsetreeViewer.modExprApply modExpr in - let isUnitSugar = + let args, call_expr = ParsetreeViewer.mod_expr_apply mod_expr in + let is_unit_sugar = match args with | [{pmod_desc = Pmod_structure []}] -> true | _ -> false in - let shouldHug = + let should_hug = match args with | [{pmod_desc = Pmod_structure _}] -> true | _ -> false @@ -5526,77 +5526,77 @@ and printModExpr ~state modExpr cmtTbl = Doc.group (Doc.concat [ - printModExpr ~state callExpr cmtTbl; - (if isUnitSugar then - printModApplyArg ~state (List.hd args [@doesNotRaise]) cmtTbl + print_mod_expr ~state call_expr cmt_tbl; + (if is_unit_sugar then + print_mod_apply_arg ~state (List.hd args [@doesNotRaise]) cmt_tbl else Doc.concat [ Doc.lparen; - (if shouldHug then - printModApplyArg ~state + (if should_hug then + print_mod_apply_arg ~state (List.hd args [@doesNotRaise]) - cmtTbl + cmt_tbl else Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun modArg -> - printModApplyArg ~state modArg cmtTbl) + (fun mod_arg -> + print_mod_apply_arg ~state mod_arg cmt_tbl) args); ])); - (if not shouldHug then - Doc.concat [Doc.trailingComma; Doc.softLine] + (if not should_hug then + Doc.concat [Doc.trailing_comma; Doc.soft_line] else Doc.nil); Doc.rparen; ]); ]) - | Pmod_constraint (modExpr, modType) -> + | Pmod_constraint (mod_expr, mod_type) -> Doc.concat [ - printModExpr ~state modExpr cmtTbl; + print_mod_expr ~state mod_expr cmt_tbl; Doc.text ": "; - printModType ~state modType cmtTbl; + print_mod_type ~state mod_type cmt_tbl; ] - | Pmod_functor _ -> printModFunctor ~state modExpr cmtTbl + | Pmod_functor _ -> print_mod_functor ~state mod_expr cmt_tbl in let doc = - if ParsetreeViewer.hasAwaitAttribute modExpr.pmod_attributes then - match modExpr.pmod_desc with + if ParsetreeViewer.has_await_attribute mod_expr.pmod_attributes then + match mod_expr.pmod_desc with | Pmod_constraint _ -> Doc.concat [Doc.text "await "; Doc.lparen; doc; Doc.rparen] | _ -> Doc.concat [Doc.text "await "; doc] else doc in - printComments doc cmtTbl modExpr.pmod_loc + print_comments doc cmt_tbl mod_expr.pmod_loc -and printModFunctor ~state modExpr cmtTbl = - let parameters, returnModExpr = ParsetreeViewer.modExprFunctor modExpr in +and print_mod_functor ~state mod_expr cmt_tbl = + let parameters, return_mod_expr = ParsetreeViewer.mod_expr_functor mod_expr in (* let shouldInline = match returnModExpr.pmod_desc with *) (* | Pmod_structure _ | Pmod_ident _ -> true *) (* | Pmod_constraint ({pmod_desc = Pmod_structure _}, _) -> true *) (* | _ -> false *) (* in *) - 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 + 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 in - let modConstraint = Doc.concat [Doc.text ": "; constraintDoc] in - (modConstraint, printModExpr ~state modExpr cmtTbl) - | _ -> (Doc.nil, printModExpr ~state returnModExpr cmtTbl) + 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) in - let parametersDoc = + let parameters_doc = match parameters with | [(attrs, {txt = "*"}, None)] -> Doc.group - (Doc.concat [printAttributes ~state attrs cmtTbl; Doc.text "()"]) + (Doc.concat [print_attributes ~state attrs cmt_tbl; Doc.text "()"]) | [([], {txt = lbl}, None)] -> Doc.text lbl | parameters -> Doc.group @@ -5606,128 +5606,128 @@ and printModFunctor ~state modExpr cmtTbl = Doc.indent (Doc.concat [ - Doc.softLine; + Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun param -> printModFunctorParam ~state param cmtTbl) + (fun param -> print_mod_functor_param ~state param cmt_tbl) parameters); ]); - Doc.trailingComma; - Doc.softLine; + Doc.trailing_comma; + Doc.soft_line; Doc.rparen; ]) in Doc.group (Doc.concat - [parametersDoc; returnConstraint; Doc.text " => "; returnModExpr]) + [parameters_doc; return_constraint; Doc.text " => "; return_mod_expr]) -and printModFunctorParam ~state (attrs, lbl, optModType) cmtTbl = - let cmtLoc = - match optModType with +and print_mod_functor_param ~state (attrs, lbl, opt_mod_type) cmt_tbl = + let cmt_loc = + match opt_mod_type with | None -> lbl.Asttypes.loc - | Some modType -> - {lbl.loc with loc_end = modType.Parsetree.pmty_loc.loc_end} + | Some mod_type -> + {lbl.loc with loc_end = mod_type.Parsetree.pmty_loc.loc_end} in - let attrs = printAttributes ~state attrs cmtTbl in - let lblDoc = + let attrs = print_attributes ~state attrs cmt_tbl in + let lbl_doc = let doc = if lbl.txt = "*" then Doc.text "()" else Doc.text lbl.txt in - printComments doc cmtTbl lbl.loc + print_comments doc cmt_tbl lbl.loc in let doc = Doc.group (Doc.concat [ attrs; - lblDoc; - (match optModType with + lbl_doc; + (match opt_mod_type with | None -> Doc.nil - | Some modType -> - Doc.concat [Doc.text ": "; printModType ~state modType cmtTbl]); + | Some mod_type -> + Doc.concat [Doc.text ": "; print_mod_type ~state mod_type cmt_tbl]); ]) in - printComments doc cmtTbl cmtLoc + print_comments doc cmt_tbl cmt_loc -and printModApplyArg ~state modExpr cmtTbl = - match modExpr.pmod_desc with +and print_mod_apply_arg ~state mod_expr cmt_tbl = + match mod_expr.pmod_desc with | Pmod_structure [] -> Doc.text "()" - | _ -> printModExpr ~state modExpr cmtTbl + | _ -> print_mod_expr ~state mod_expr cmt_tbl -and printExceptionDef ~state (constr : Parsetree.extension_constructor) cmtTbl = +and print_exception_def ~state (constr : Parsetree.extension_constructor) cmt_tbl = let kind = match constr.pext_kind with | Pext_rebind longident -> Doc.indent (Doc.concat - [Doc.text " ="; Doc.line; printLongidentLocation longident cmtTbl]) + [Doc.text " ="; Doc.line; print_longident_location longident cmt_tbl]) | Pext_decl (Pcstr_tuple [], None) -> Doc.nil | Pext_decl (args, gadt) -> - let gadtDoc = + let gadt_doc = match gadt with - | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; print_typ_expr ~state typ cmt_tbl] | None -> Doc.nil in Doc.concat - [printConstructorArguments ~state ~indent:false args cmtTbl; gadtDoc] + [print_constructor_arguments ~state ~indent:false args cmt_tbl; gadt_doc] in let name = - printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc + print_comments (Doc.text constr.pext_name.txt) cmt_tbl constr.pext_name.loc in let doc = Doc.group (Doc.concat [ - printAttributes ~state constr.pext_attributes cmtTbl; + print_attributes ~state constr.pext_attributes cmt_tbl; Doc.text "exception "; name; kind; ]) in - printComments doc cmtTbl constr.pext_loc + print_comments doc cmt_tbl constr.pext_loc -and printExtensionConstructor ~state (constr : Parsetree.extension_constructor) - cmtTbl i = - let attrs = printAttributes ~state constr.pext_attributes cmtTbl in +and print_extension_constructor ~state (constr : Parsetree.extension_constructor) + cmt_tbl i = + let attrs = print_attributes ~state constr.pext_attributes cmt_tbl in let bar = - if i > 0 then Doc.text "| " else Doc.ifBreaks (Doc.text "| ") Doc.nil + if i > 0 then Doc.text "| " else Doc.if_breaks (Doc.text "| ") Doc.nil in let kind = match constr.pext_kind with | Pext_rebind longident -> Doc.indent (Doc.concat - [Doc.text " ="; Doc.line; printLongidentLocation longident cmtTbl]) + [Doc.text " ="; Doc.line; print_longident_location longident cmt_tbl]) | Pext_decl (Pcstr_tuple [], None) -> Doc.nil | Pext_decl (args, gadt) -> - let gadtDoc = + let gadt_doc = match gadt with - | Some typ -> Doc.concat [Doc.text ": "; printTypExpr ~state typ cmtTbl] + | Some typ -> Doc.concat [Doc.text ": "; print_typ_expr ~state typ cmt_tbl] | None -> Doc.nil in Doc.concat - [printConstructorArguments ~state ~indent:false args cmtTbl; gadtDoc] + [print_constructor_arguments ~state ~indent:false args cmt_tbl; gadt_doc] in let name = - printComments (Doc.text constr.pext_name.txt) cmtTbl constr.pext_name.loc + print_comments (Doc.text constr.pext_name.txt) cmt_tbl constr.pext_name.loc in Doc.concat [bar; Doc.group (Doc.concat [attrs; name; kind])] -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_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 printImplementation ~width (s : Parsetree.structure) ~comments = - let cmtTbl = CommentTable.make () in - CommentTable.walkStructure s cmtTbl comments; +let print_implementation ~width (s : Parsetree.structure) ~comments = + let cmt_tbl = CommentTable.make () in + CommentTable.walk_structure s cmt_tbl comments; (* CommentTable.log cmtTbl; *) - let doc = printStructure ~state:(State.init ()) s cmtTbl in + let doc = print_structure ~state:(State.init ()) s cmt_tbl in (* Doc.debug doc; *) - Doc.toString ~width doc ^ "\n" + Doc.to_string ~width doc ^ "\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_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 printStructure = printStructure ~state:(State.init ()) +let print_structure = print_structure ~state:(State.init ()) diff --git a/jscomp/syntax/src/res_printer.mli b/jscomp/syntax/src/res_printer.mli index cf641d8575..9d2255445f 100644 --- a/jscomp/syntax/src/res_printer.mli +++ b/jscomp/syntax/src/res_printer.mli @@ -1,30 +1,30 @@ -val printTypeParams : +val print_type_params : (Parsetree.core_type * Asttypes.variance) list -> Res_comments_table.t -> Res_doc.t -val printLongident : Longident.t -> Res_doc.t +val print_longident : Longident.t -> Res_doc.t -val printTypExpr : Parsetree.core_type -> Res_comments_table.t -> Res_doc.t +val print_typ_expr : Parsetree.core_type -> Res_comments_table.t -> Res_doc.t -val addParens : Res_doc.t -> Res_doc.t +val add_parens : Res_doc.t -> Res_doc.t -val printExpression : Parsetree.expression -> Res_comments_table.t -> Res_doc.t +val print_expression : Parsetree.expression -> Res_comments_table.t -> Res_doc.t -val printPattern : Parsetree.pattern -> Res_comments_table.t -> Res_doc.t +val print_pattern : Parsetree.pattern -> Res_comments_table.t -> Res_doc.t [@@live] -val printStructure : Parsetree.structure -> Res_comments_table.t -> Res_doc.t +val print_structure : Parsetree.structure -> Res_comments_table.t -> Res_doc.t [@@live] -val printImplementation : +val print_implementation : width:int -> Parsetree.structure -> comments:Res_comment.t list -> string -val printInterface : +val print_interface : width:int -> Parsetree.signature -> comments:Res_comment.t list -> string -val printIdentLike : - ?allowUident:bool -> ?allowHyphen:bool -> string -> Res_doc.t +val print_ident_like : + ?allow_uident:bool -> ?allow_hyphen:bool -> string -> Res_doc.t -val printPolyVarIdent : string -> Res_doc.t +val print_poly_var_ident : string -> Res_doc.t -val polyVarIdentToString : string -> string [@@live] +val poly_var_ident_to_string : string -> string [@@live] diff --git a/jscomp/syntax/src/res_reporting.ml b/jscomp/syntax/src/res_reporting.ml index 77d370af08..53a3eedce1 100644 --- a/jscomp/syntax/src/res_reporting.ml +++ b/jscomp/syntax/src/res_reporting.ml @@ -13,4 +13,4 @@ type problem = | Lident [@live] | Unbalanced of Token.t [@live] -type parseError = Lexing.position * problem +type parse_error = Lexing.position * problem diff --git a/jscomp/syntax/src/res_scanner.ml b/jscomp/syntax/src/res_scanner.ml index 94ec7a710f..9dc5a93134 100644 --- a/jscomp/syntax/src/res_scanner.ml +++ b/jscomp/syntax/src/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 hackyEOFChar = Char.unsafe_chr (-1) -type charEncoding = Char.t +let hacky_e_o_f_char = Char.unsafe_chr (-1) +type char_encoding = Char.t type t = { filename: string; src: string; mutable err: - startPos:Lexing.position -> - endPos:Lexing.position -> + start_pos:Lexing.position -> + end_pos:Lexing.position -> Diagnostics.category -> unit; - mutable ch: charEncoding; (* current character *) + mutable ch: char_encoding; (* current character *) mutable offset: int; (* current byte offset *) mutable offset16: int; (* current number of utf16 code units since line start *) - mutable lineOffset: int; (* current line offset *) + mutable line_offset: int; (* current line offset *) mutable lnum: int; (* current line number *) mutable mode: mode list; } -let setDiamondMode scanner = scanner.mode <- Diamond :: scanner.mode +let set_diamond_mode scanner = scanner.mode <- Diamond :: scanner.mode -let setJsxMode scanner = scanner.mode <- Jsx :: scanner.mode +let set_jsx_mode scanner = scanner.mode <- Jsx :: scanner.mode -let popMode scanner mode = +let pop_mode scanner mode = match scanner.mode with | m :: ms when m = mode -> scanner.mode <- ms | _ -> () -let inDiamondMode scanner = +let in_diamond_mode scanner = match scanner.mode with | Diamond :: _ -> true | _ -> false -let inJsxMode scanner = +let in_jsx_mode 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.lineOffset; + pos_bol = scanner.line_offset; (* [pos_cnum - pos_bol] is the number of utf16 code units since line start *) - pos_cnum = scanner.lineOffset + scanner.offset16; + pos_cnum = scanner.line_offset + scanner.offset16; } (* Small debugging util @@ -74,28 +74,28 @@ let position scanner = ^ eof 18-18 let msg = "hello" *) -let _printDebug ~startPos ~endPos scanner token = +let _printDebug ~start_pos ~end_pos scanner token = let open Lexing in print_string scanner.src; - print_string ((String.make [@doesNotRaise]) startPos.pos_cnum ' '); + print_string ((String.make [@doesNotRaise]) start_pos.pos_cnum ' '); print_char '^'; - (match endPos.pos_cnum - startPos.pos_cnum with + (match end_pos.pos_cnum - start_pos.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.toString token); + print_string (Res_token.to_string token); print_char ' '; - print_int startPos.pos_cnum; + print_int start_pos.pos_cnum; print_char '-'; - print_int endPos.pos_cnum; + print_int end_pos.pos_cnum; print_endline "" [@@live] let next scanner = - let nextOffset = scanner.offset + 1 in + let next_offset = 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.lineOffset <- nextOffset; + scanner.line_offset <- next_offset; scanner.offset16 <- 0; scanner.lnum <- scanner.lnum + 1) else scanner.offset16 <- scanner.offset16 + utf16len; - if nextOffset < String.length scanner.src then ( - scanner.offset <- nextOffset; - scanner.ch <- String.unsafe_get scanner.src nextOffset) + if next_offset < String.length scanner.src then ( + scanner.offset <- next_offset; + scanner.ch <- String.unsafe_get scanner.src next_offset) else ( scanner.offset <- String.length scanner.src; - scanner.offset16 <- scanner.offset - scanner.lineOffset; - scanner.ch <- hackyEOFChar) + scanner.offset16 <- scanner.offset - scanner.line_offset; + scanner.ch <- hacky_e_o_f_char) 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 hackyEOFChar + else hacky_e_o_f_char let peek2 scanner = if scanner.offset + 2 < String.length scanner.src then String.unsafe_get scanner.src (scanner.offset + 2) - else hackyEOFChar + else hacky_e_o_f_char let peek3 scanner = if scanner.offset + 3 < String.length scanner.src then String.unsafe_get scanner.src (scanner.offset + 3) - else hackyEOFChar + else hacky_e_o_f_char let make ~filename src = { filename; src; - err = (fun ~startPos:_ ~endPos:_ _ -> ()); - ch = (if src = "" then hackyEOFChar else String.unsafe_get src 0); + err = (fun ~start_pos:_ ~end_pos:_ _ -> ()); + ch = (if src = "" then hacky_e_o_f_char else String.unsafe_get src 0); offset = 0; offset16 = 0; - lineOffset = 0; + line_offset = 0; lnum = 1; mode = []; } (* generic helpers *) -let isWhitespace ch = +let is_whitespace ch = match ch with | ' ' | '\t' | '\n' | '\r' -> true | _ -> false -let rec skipWhitespace scanner = - if isWhitespace scanner.ch then ( +let rec skip_whitespace scanner = + if is_whitespace scanner.ch then ( next scanner; - skipWhitespace scanner) + skip_whitespace scanner) -let digitValue ch = +let digit_value ch = match ch with | '0' .. '9' -> Char.code ch - 48 | 'a' .. 'f' -> Char.code ch - Char.code 'a' + 10 @@ -179,29 +179,29 @@ let digitValue ch = (* scanning helpers *) -let scanIdentifier scanner = - let startOff = scanner.offset in - let rec skipGoodChars scanner = - match (scanner.ch, inJsxMode scanner) with +let scan_identifier scanner = + let start_off = scanner.offset in + let rec skip_good_chars scanner = + match (scanner.ch, in_jsx_mode scanner) with | ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' | '\''), false -> next scanner; - skipGoodChars scanner + skip_good_chars scanner | ('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' | '\'' | '-'), true -> next scanner; - skipGoodChars scanner + skip_good_chars scanner | _ -> () in - skipGoodChars scanner; + skip_good_chars scanner; let str = - (String.sub [@doesNotRaise]) scanner.src startOff (scanner.offset - startOff) + (String.sub [@doesNotRaise]) scanner.src start_off (scanner.offset - start_off) in if '{' == scanner.ch && str = "list" then ( next scanner; (* TODO: this isn't great *) - Token.lookupKeyword "list{") - else Token.lookupKeyword str + Token.lookup_keyword "list{") + else Token.lookup_keyword str -let scanDigits scanner ~base = +let scan_digits scanner ~base = if base <= 10 then let rec loop scanner = match scanner.ch with @@ -223,8 +223,8 @@ let scanDigits scanner ~base = loop scanner (* float: (0…9) { 0…9∣ _ } [. { 0…9∣ _ }] [(e∣ E) [+∣ -] (0…9) { 0…9∣ _ }] *) -let scanNumber scanner = - let startOff = scanner.offset in +let scan_number scanner = + let start_off = scanner.offset in (* integer part *) let base = @@ -245,30 +245,30 @@ let scanNumber scanner = 8) | _ -> 10 in - scanDigits scanner ~base; + scan_digits scanner ~base; (* *) - let isFloat = + let is_float = if '.' == scanner.ch then ( next scanner; - scanDigits scanner ~base; + scan_digits scanner ~base; true) else false in (* exponent part *) - let isFloat = + let is_float = match scanner.ch with | 'e' | 'E' | 'p' | 'P' -> (match peek scanner with | '+' | '-' -> next2 scanner | _ -> next scanner); - scanDigits scanner ~base; + scan_digits scanner ~base; true - | _ -> isFloat + | _ -> is_float in let literal = - (String.sub [@doesNotRaise]) scanner.src startOff (scanner.offset - startOff) + (String.sub [@doesNotRaise]) scanner.src start_off (scanner.offset - start_off) in (* suffix *) @@ -279,12 +279,12 @@ let scanNumber scanner = Some ch | _ -> None in - if isFloat then Token.Float {f = literal; suffix} + if is_float then Token.Float {f = literal; suffix} else Token.Int {i = literal; suffix} -let scanExoticIdentifier scanner = - let startPos = position scanner in - let startOff = scanner.offset in +let scan_exotic_identifier scanner = + let start_pos = position scanner in + let start_off = scanner.offset in next2 scanner; @@ -293,13 +293,13 @@ let scanExoticIdentifier scanner = | '"' -> next scanner | '\n' | '\r' -> (* line break *) - let endPos = position scanner in - scanner.err ~startPos ~endPos + let end_pos = position scanner in + scanner.err ~start_pos ~end_pos (Diagnostics.message "A quoted identifier can't contain line breaks."); next scanner - | ch when ch == hackyEOFChar -> - let endPos = position scanner in - scanner.err ~startPos ~endPos + | ch when ch == hacky_e_o_f_char -> + let end_pos = position scanner in + scanner.err ~start_pos ~end_pos (Diagnostics.message "Did you forget a \" here?") | _ -> next scanner; @@ -308,31 +308,31 @@ let scanExoticIdentifier scanner = scan (); let ident = - (String.sub [@doesNotRaise]) scanner.src startOff (scanner.offset - startOff) + (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 endPos = position scanner in - scanner.err ~startPos ~endPos + 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 scanStringEscapeSequence ~startPos scanner = +let scan_string_escape_sequence ~start_pos scanner = let scan ~n ~base ~max = let rec loop n x = if n == 0 then x else - let d = digitValue scanner.ch in + let d = digit_value scanner.ch in if d >= base then ( let pos = position scanner in let msg = - if scanner.ch == hackyEOFChar then "unclosed escape sequence" + if scanner.ch == hacky_e_o_f_char then "unclosed escape sequence" else "unknown escape sequence" in - scanner.err ~startPos ~endPos:pos (Diagnostics.message msg); + scanner.err ~start_pos ~end_pos:pos (Diagnostics.message msg); -1) else let () = next scanner in @@ -342,7 +342,7 @@ let scanStringEscapeSequence ~startPos 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 ~startPos ~endPos:pos (Diagnostics.message msg) + scanner.err ~start_pos ~end_pos:pos (Diagnostics.message msg) in match scanner.ch with (* \ already consumed *) @@ -369,7 +369,7 @@ let scanStringEscapeSequence ~startPos scanner = | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false do - x := (!x * 16) + digitValue scanner.ch; + x := (!x * 16) + digit_value scanner.ch; next scanner done; (* consume '}' in '\u{7A}' *) @@ -390,95 +390,95 @@ let scanStringEscapeSequence ~startPos scanner = *) () -let scanString scanner = +let scan_string scanner = (* assumption: we've just matched a quote *) - let startPosWithQuote = position scanner in + let start_pos_with_quote = position scanner in next scanner; (* If the text needs changing, a buffer is used *) let buf = Buffer.create 0 in - let firstCharOffset = scanner.offset in - let lastOffsetInBuf = ref firstCharOffset in + let first_char_offset = scanner.offset in + let last_offset_in_buf = ref first_char_offset in - let bringBufUpToDate ~startOffset = - let strUpToNow = - (String.sub scanner.src !lastOffsetInBuf - (startOffset - !lastOffsetInBuf) [@doesNotRaise]) + 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]) in - Buffer.add_string buf strUpToNow; - lastOffsetInBuf := startOffset + Buffer.add_string buf str_up_to_now; + last_offset_in_buf := start_offset in - let result ~firstCharOffset ~lastCharOffset = + let result ~first_char_offset ~last_char_offset = if Buffer.length buf = 0 then - (String.sub [@doesNotRaise]) scanner.src firstCharOffset - (lastCharOffset - firstCharOffset) + (String.sub [@doesNotRaise]) scanner.src first_char_offset + (last_char_offset - first_char_offset) else ( - bringBufUpToDate ~startOffset:lastCharOffset; + bring_buf_up_to_date ~start_offset:last_char_offset; Buffer.contents buf) in let rec scan () = match scanner.ch with | '"' -> - let lastCharOffset = scanner.offset in + let last_char_offset = scanner.offset in next scanner; - result ~firstCharOffset ~lastCharOffset + 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 + 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_e_o_f_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 | _ -> next scanner; scan () - and convertOctalToHex ~startOffset ~endOffset = - let len = endOffset - startOffset in - let isDigit = function + and convert_octal_to_hex ~start_offset ~end_offset = + let len = end_offset - start_offset in + let is_digit = function | '0' .. '9' -> true | _ -> false in let txt = scanner.src in - let isNumericEscape = + let is_numeric_escape = len = 3 - && (isDigit txt.[startOffset] [@doesNotRaise]) - && (isDigit txt.[startOffset + 1] [@doesNotRaise]) - && (isDigit txt.[startOffset + 2] [@doesNotRaise]) + && (is_digit txt.[start_offset] [@doesNotRaise]) + && (is_digit txt.[start_offset + 1] [@doesNotRaise]) + && (is_digit txt.[start_offset + 2] [@doesNotRaise]) in - 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; + 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; scan ()) else scan () in Token.String (scan ()) -let scanEscape scanner = +let scan_escape scanner = (* '\' consumed *) let offset = scanner.offset - 1 in - let convertNumber scanner ~n ~base = + let convert_number scanner ~n ~base = let x = ref 0 in for _ = n downto 1 do - let d = digitValue scanner.ch in + let d = digit_value scanner.ch in x := (!x * base) + d; next scanner done; let c = !x in - if Res_utf8.isValidCodePoint c then c else Res_utf8.repl + if Res_utf8.is_valid_code_point c then c else Res_utf8.repl in let codepoint = match scanner.ch with - | '0' .. '9' -> convertNumber scanner ~n:3 ~base:10 + | '0' .. '9' -> convert_number scanner ~n:3 ~base:10 | 'b' -> next scanner; 8 @@ -493,10 +493,10 @@ let scanEscape scanner = 009 | 'x' -> next scanner; - convertNumber scanner ~n:2 ~base:16 + convert_number scanner ~n:2 ~base:16 | 'o' -> next scanner; - convertNumber scanner ~n:3 ~base:8 + convert_number scanner ~n:3 ~base:8 | 'u' -> ( next scanner; match scanner.ch with @@ -509,7 +509,7 @@ let scanEscape scanner = | '0' .. '9' | 'a' .. 'f' | 'A' .. 'F' -> true | _ -> false do - x := (!x * 16) + digitValue scanner.ch; + x := (!x * 16) + digit_value scanner.ch; next scanner done; (* consume '}' in '\u{7A}' *) @@ -517,10 +517,10 @@ let scanEscape scanner = | '}' -> next scanner | _ -> ()); let c = !x in - if Res_utf8.isValidCodePoint c then c else Res_utf8.repl + if Res_utf8.is_valid_code_point c then c else Res_utf8.repl | _ -> (* unicode escape sequence: '\u007A', exactly 4 hex digits *) - convertNumber scanner ~n:4 ~base:16) + convert_number scanner ~n:4 ~base:16) | ch -> next scanner; Char.code ch @@ -533,33 +533,33 @@ let scanEscape scanner = (* TODO: do we know it's \' ? *) Token.Codepoint {c = codepoint; original = contents} -let scanSingleLineComment scanner = - let startOff = scanner.offset in - let startPos = position scanner in +let scan_single_line_comment scanner = + let start_off = scanner.offset in + let start_pos = position scanner in let rec skip scanner = match scanner.ch with | '\n' | '\r' -> () - | ch when ch == hackyEOFChar -> () + | ch when ch == hacky_e_o_f_char -> () | _ -> next scanner; skip scanner in skip scanner; - let endPos = position scanner in + let end_pos = position scanner in Token.Comment - (Comment.makeSingleLineComment - ~loc:Location.{loc_start = startPos; loc_end = endPos; loc_ghost = false} - ((String.sub [@doesNotRaise]) scanner.src startOff - (scanner.offset - startOff))) + (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))) -let scanMultiLineComment scanner = +let scan_multi_line_comment scanner = (* assumption: we're only ever using this helper in `scan` after detecting a comment *) - 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 + 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 in - let startPos = position scanner in + let start_pos = position scanner in let rec scan ~depth = (* invariant: depth > 0 right after this match. See assumption *) match (scanner.ch, peek scanner) with @@ -569,50 +569,50 @@ let scanMultiLineComment scanner = | '*', '/' -> next2 scanner; if depth > 1 then scan ~depth:(depth - 1) - | ch, _ when ch == hackyEOFChar -> - let endPos = position scanner in - scanner.err ~startPos ~endPos Diagnostics.unclosedComment + | ch, _ when ch == hacky_e_o_f_char -> + let end_pos = position scanner in + scanner.err ~start_pos ~end_pos Diagnostics.unclosed_comment | _ -> next scanner; scan ~depth in scan ~depth:0; - let length = scanner.offset - 2 - contentStartOff in + let length = scanner.offset - 2 - content_start_off in let length = if length < 0 (* in case of EOF *) then 0 else length in Token.Comment - (Comment.makeMultiLineComment ~docComment ~standalone + (Comment.make_multi_line_comment ~doc_comment ~standalone ~loc: Location. - {loc_start = startPos; loc_end = position scanner; loc_ghost = false} - ((String.sub [@doesNotRaise]) scanner.src contentStartOff length)) + {loc_start = start_pos; loc_end = position scanner; loc_ghost = false} + ((String.sub [@doesNotRaise]) scanner.src content_start_off length)) -let scanTemplateLiteralToken scanner = - let startOff = scanner.offset in +let scan_template_literal_token scanner = + let start_off = scanner.offset in (* if starting } here, consume it *) if scanner.ch == '}' then next scanner; - let startPos = position scanner in + let start_pos = position scanner in let rec scan () = - let lastPos = position scanner in + let last_pos = position scanner in match scanner.ch with | '`' -> next scanner; let contents = - (String.sub [@doesNotRaise]) scanner.src startOff - (scanner.offset - 1 - startOff) + (String.sub [@doesNotRaise]) scanner.src start_off + (scanner.offset - 1 - start_off) in - Token.TemplateTail (contents, lastPos) + Token.TemplateTail (contents, last_pos) | '$' -> ( match peek scanner with | '{' -> next2 scanner; let contents = - (String.sub [@doesNotRaise]) scanner.src startOff - (scanner.offset - 2 - startOff) + (String.sub [@doesNotRaise]) scanner.src start_off + (scanner.offset - 2 - start_off) in - Token.TemplatePart (contents, lastPos) + Token.TemplatePart (contents, last_pos) | _ -> next scanner; scan ()) @@ -625,31 +625,31 @@ let scanTemplateLiteralToken scanner = | _ -> next scanner; scan ()) - | ch when ch = hackyEOFChar -> - let endPos = position scanner in - scanner.err ~startPos ~endPos Diagnostics.unclosedTemplate; + | ch when ch = hacky_e_o_f_char -> + let end_pos = position scanner in + scanner.err ~start_pos ~end_pos Diagnostics.unclosed_template; let contents = - (String.sub [@doesNotRaise]) scanner.src startOff - (max (scanner.offset - 1 - startOff) 0) + (String.sub [@doesNotRaise]) scanner.src start_off + (max (scanner.offset - 1 - start_off) 0) in - Token.TemplateTail (contents, lastPos) + Token.TemplateTail (contents, last_pos) | _ -> next scanner; scan () in let token = scan () in - let endPos = position scanner in - (startPos, endPos, token) + let end_pos = position scanner in + (start_pos, end_pos, token) let rec scan scanner = - skipWhitespace scanner; - let startPos = position scanner in + skip_whitespace scanner; + let start_pos = position scanner in let token = match scanner.ch with (* peeking 0 char *) - | 'A' .. 'Z' | 'a' .. 'z' -> scanIdentifier scanner - | '0' .. '9' -> scanNumber scanner + | 'A' .. 'Z' | 'a' .. 'z' -> scan_identifier scanner + | '0' .. '9' -> scan_number scanner | '`' -> next scanner; Token.Backtick @@ -683,11 +683,11 @@ let rec scan scanner = | ',' -> next scanner; Token.Comma - | '"' -> scanString scanner + | '"' -> scan_string scanner (* peeking 1 char *) | '_' -> ( match peek scanner with - | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' -> scanIdentifier scanner + | 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' -> scan_identifier scanner | _ -> next scanner; Token.Underscore) @@ -756,13 +756,13 @@ let rec scan scanner = | _ -> next scanner; Token.Colon) - | '\\' -> scanExoticIdentifier scanner + | '\\' -> scan_exotic_identifier scanner | '/' -> ( match peek scanner with | '/' -> next2 scanner; - scanSingleLineComment scanner - | '*' -> scanMultiLineComment scanner + scan_single_line_comment scanner + | '*' -> scan_multi_line_comment scanner | '.' -> next2 scanner; Token.ForwardslashDot @@ -796,13 +796,13 @@ let rec scan scanner = Token.Plus) | '>' -> ( match peek scanner with - | '=' when not (inDiamondMode scanner) -> + | '=' when not (in_diamond_mode scanner) -> next2 scanner; Token.GreaterEqual | _ -> next scanner; Token.GreaterThan) - | '<' when not (inJsxMode scanner) -> ( + | '<' when not (in_jsx_mode scanner) -> ( match peek scanner with | '=' -> next2 scanner; @@ -820,7 +820,7 @@ let rec scan scanner = * This signals a closing element. To simulate the two-token lookahead, * the next scanner; @@ -850,7 +850,7 @@ let rec scan scanner = SingleQuote | '\\', _ -> next2 scanner; - scanEscape scanner + scan_escape scanner | ch, '\'' -> let offset = scanner.offset + 1 in next3 scanner; @@ -864,7 +864,7 @@ let rec scan scanner = let offset = scanner.offset in let offset16 = scanner.offset16 in let codepoint, length = - Res_utf8.decodeCodePoint scanner.offset scanner.src + Res_utf8.decode_code_point scanner.offset scanner.src (String.length scanner.src) in for _ = 0 to length - 1 do @@ -907,21 +907,21 @@ let rec scan scanner = next scanner; Token.Equal) (* special cases *) - | ch when ch == hackyEOFChar -> + | ch when ch == hacky_e_o_f_char -> 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 endPos = position scanner in - scanner.err ~startPos ~endPos (Diagnostics.unknownUchar ch); + let end_pos = position scanner in + scanner.err ~start_pos ~end_pos (Diagnostics.unknown_uchar ch); let _, _, token = scan scanner in token in - let endPos = position scanner in + let end_pos = position scanner in (* _printDebug ~startPos ~endPos scanner token; *) - (startPos, endPos, token) + (start_pos, end_pos, token) (* misc helpers used elsewhere *) @@ -930,9 +930,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 reconsiderLessThan scanner = +let reconsider_less_than scanner = (* < consumed *) - skipWhitespace scanner; + skip_whitespace scanner; if scanner.ch == '/' then let () = next scanner in Token.LessThanSlash @@ -940,17 +940,17 @@ let reconsiderLessThan scanner = (* If an operator has whitespace around both sides, it's a binary operator *) (* TODO: this helper seems out of place *) -let isBinaryOp src startCnum endCnum = - if startCnum == 0 then false +let is_binary_op src start_cnum end_cnum = + if start_cnum == 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 (endCnum >= 0); - assert (startCnum > 0 && startCnum < String.length src); - let leftOk = isWhitespace (String.unsafe_get src (startCnum - 1)) in + 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 (* we need some stronger confidence that endCnum is ok *) - let rightOk = - endCnum >= String.length src - || isWhitespace (String.unsafe_get src endCnum) + let right_ok = + end_cnum >= String.length src + || is_whitespace (String.unsafe_get src end_cnum) in - leftOk && rightOk) + left_ok && right_ok) diff --git a/jscomp/syntax/src/res_scanner.mli b/jscomp/syntax/src/res_scanner.mli index cc002699fd..5ae40e8128 100644 --- a/jscomp/syntax/src/res_scanner.mli +++ b/jscomp/syntax/src/res_scanner.mli @@ -1,20 +1,20 @@ type mode = Jsx | Diamond -type charEncoding +type char_encoding type t = { filename: string; src: string; mutable err: - startPos:Lexing.position -> - endPos:Lexing.position -> + start_pos:Lexing.position -> + end_pos:Lexing.position -> Res_diagnostics.category -> unit; - mutable ch: charEncoding; (* current character *) + mutable ch: char_encoding; (* current character *) mutable offset: int; (* current byte offset *) mutable offset16: int; (* current number of utf16 code units since line start *) - mutable lineOffset: int; (* current line offset *) + mutable line_offset: 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 isBinaryOp : string -> int -> int -> bool +val is_binary_op : string -> int -> int -> bool -val setJsxMode : t -> unit -val setDiamondMode : t -> unit -val popMode : t -> mode -> unit +val set_jsx_mode : t -> unit +val set_diamond_mode : t -> unit +val pop_mode : t -> mode -> unit -val reconsiderLessThan : t -> Res_token.t +val reconsider_less_than : t -> Res_token.t -val scanTemplateLiteralToken : +val scan_template_literal_token : t -> Lexing.position * Lexing.position * Res_token.t diff --git a/jscomp/syntax/src/res_string.ml b/jscomp/syntax/src/res_string.ml index a4ecba11db..6ef33a29eb 100644 --- a/jscomp/syntax/src/res_string.ml +++ b/jscomp/syntax/src/res_string.ml @@ -1,11 +1,11 @@ -let hexTable = +let hex_table = [| '0'; '1'; '2'; '3'; '4'; '5'; '6'; '7'; '8'; '9'; 'a'; 'b'; 'c'; 'd'; 'e'; 'f'; |] [@ocamlformat "disable"] -let convertDecimalToHex ~strDecimal = +let convert_decimal_to_hex ~str_decimal = try - 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 + 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 "x" ^ String.concat "" [String.make 1 c1; String.make 1 c2] - with Invalid_argument _ | Failure _ -> strDecimal + with Invalid_argument _ | Failure _ -> str_decimal diff --git a/jscomp/syntax/src/res_token.ml b/jscomp/syntax/src/res_token.ml index 27020106f8..16c88e55c4 100644 --- a/jscomp/syntax/src/res_token.ml +++ b/jscomp/syntax/src/res_token.ml @@ -110,7 +110,7 @@ let precedence = function | Dot -> 9 | _ -> 0 -let toString = function +let to_string = function | Await -> "await" | Open -> "open" | True -> "true" @@ -196,7 +196,7 @@ let toString = function | AtAt -> "@@" | Percent -> "%" | PercentPercent -> "%%" - | Comment c -> "Comment" ^ Comment.toString c + | Comment c -> "Comment" ^ Comment.to_string c | List -> "list{" | TemplatePart (text, _) -> text ^ "${" | TemplateTail (text, _) -> "TemplateTail(" ^ text ^ ")" @@ -206,7 +206,7 @@ let toString = function | DocComment (_loc, s) -> "DocComment " ^ s | ModuleComment (_loc, s) -> "ModuleComment " ^ s -let keywordTable = function +let keyword_table = function | "and" -> And | "as" -> As | "assert" -> Assert @@ -237,23 +237,23 @@ let keywordTable = function | _ -> raise Not_found [@@raises Not_found] -let isKeyword = function +let is_keyword = 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 -> true | _ -> false -let lookupKeyword str = - try keywordTable str +let lookup_keyword str = + try keyword_table str with Not_found -> ( match str.[0] [@doesNotRaise] with | 'A' .. 'Z' -> Uident str | _ -> Lident str) -let isKeywordTxt str = +let is_keyword_txt str = try - let _ = keywordTable str in + let _ = keyword_table str in true with Not_found -> false diff --git a/jscomp/syntax/src/res_uncurried.ml b/jscomp/syntax/src/res_uncurried.ml index 1a777e1599..b5d3706c68 100644 --- a/jscomp/syntax/src/res_uncurried.ml +++ b/jscomp/syntax/src/res_uncurried.ml @@ -1,11 +1,11 @@ (* For parsing *) -let fromDotted ~dotted = function +let from_dotted ~dotted = function | Config.Legacy -> dotted | Swap -> not dotted | Uncurried -> true (* For printing *) -let getDotted ~uncurried = function +let get_dotted ~uncurried = function | Config.Legacy -> uncurried | Swap -> not uncurried | Uncurried -> false diff --git a/jscomp/syntax/src/res_utf8.ml b/jscomp/syntax/src/res_utf8.ml index 69c7d234f9..c41621761d 100644 --- a/jscomp/syntax/src/res_utf8.ml +++ b/jscomp/syntax/src/res_utf8.ml @@ -6,8 +6,8 @@ let repl = 0xFFFD (* let min = 0x0000 *) let max = 0x10FFFF -let surrogateMin = 0xD800 -let surrogateMax = 0xDFFF +let surrogate_min = 0xD800 +let surrogate_max = 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 categoryTable = [| +let category_table = [| (* 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 decodeCodePoint i s len = +let decode_code_point 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 decodeCodePoint i s len = let index = Array.unsafe_get categories first in if index = 0 then (repl, 1) else - let cat = Array.unsafe_get categoryTable index in + let cat = Array.unsafe_get category_table 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 decodeCodePoint i s len = let uc = i0 lor i3 lor i2 lor i1 in (uc, 4) -let encodeCodePoint c = +let encode_code_point 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 encodeCodePoint c = (Char.unsafe_chr (0b1000_0000 lor (c land cont_mask))); Bytes.unsafe_to_string bytes -let isValidCodePoint c = - (0 <= c && c < surrogateMin) || (surrogateMax < c && c <= max) +let is_valid_code_point c = + (0 <= c && c < surrogate_min) || (surrogate_max < c && c <= max) diff --git a/jscomp/syntax/src/res_utf8.mli b/jscomp/syntax/src/res_utf8.mli index 7dcb342d68..fc80c8be95 100644 --- a/jscomp/syntax/src/res_utf8.mli +++ b/jscomp/syntax/src/res_utf8.mli @@ -2,8 +2,8 @@ val repl : int val max : int -val decodeCodePoint : int -> string -> int -> int * int +val decode_code_point : int -> string -> int -> int * int -val encodeCodePoint : int -> string +val encode_code_point : int -> string -val isValidCodePoint : int -> bool +val is_valid_code_point : int -> bool diff --git a/jscomp/syntax/testrunner/res_test.ml b/jscomp/syntax/testrunner/res_test.ml index acda80f5ef..88d7c3a98f 100644 --- a/jscomp/syntax/testrunner/res_test.ml +++ b/jscomp/syntax/testrunner/res_test.ml @@ -1,13 +1,13 @@ module IO = Res_io -let dataDir = "jscomp/syntax/tests" +let data_dir = "jscomp/syntax/tests" (* test printing of .res file*) let () = - let filename = Filename.concat dataDir "api/resSyntax.res" in - let prettySource = Res_multi_printer.print `res ~input:filename in + let filename = Filename.concat data_dir "api/resSyntax.res" in + let pretty_source = Res_multi_printer.print `res ~input:filename in assert ( - prettySource + pretty_source = {|// test file if true { @@ -19,19 +19,19 @@ if true { (* test printing of .resi file*) let () = - let filename = Filename.concat dataDir "api/resiSyntax.resi" in - let prettySource = Res_multi_printer.print `res ~input:filename in - assert (prettySource = {|// test interface file + let filename = Filename.concat data_dir "api/resiSyntax.resi" in + let pretty_source = Res_multi_printer.print `res ~input:filename in + assert (pretty_source = {|// test interface file let x: int |}) (* test printing of ocaml .ml file *) let () = - let filename = Filename.concat dataDir "api/mlSyntax.ml" in - let prettySource = Res_multi_printer.print `ml ~input:filename in + let filename = Filename.concat data_dir "api/mlSyntax.ml" in + let pretty_source = Res_multi_printer.print `ml ~input:filename in assert ( - prettySource + pretty_source = {|/* test ml file */ let () = print_endline("hello world") @@ -43,10 +43,10 @@ let d = `Sehr Schön` (* test printing of ocaml .mli file *) let () = - let filename = Filename.concat dataDir "api/mliSyntax.mli" in - let prettySource = Res_multi_printer.print `ml ~input:filename in + let filename = Filename.concat data_dir "api/mliSyntax.mli" in + let pretty_source = Res_multi_printer.print `ml ~input:filename in assert ( - prettySource + pretty_source = {|/* test mli file */ let x: int @@ -58,7 +58,7 @@ let y: float let () = print_endline "✅ multi printer api tests" module OutcomePrinterTests = struct - let signatureToOutcome structure = + let signature_to_outcome structure = Lazy.force Res_outcome_printer.setup; Clflags.include_dirs := @@ -99,36 +99,36 @@ module OutcomePrinterTests = struct * The outcome tree is printed to a string * and stored in a snapshot `tests/oprint/expected/oprint.resi.txt` *) let run () = - let filename = Filename.concat dataDir "oprint/oprint.res" in + let filename = Filename.concat data_dir "oprint/oprint.res" in let result = - Res_driver.parsingEngine.parseImplementation ~forPrinter:false ~filename + Res_driver.parsing_engine.parse_implementation ~for_printer:false ~filename in let signature = if result.Res_driver.invalid then ( - Res_driver.parsingEngine.stringOfDiagnostics ~source:result.source + Res_driver.parsing_engine.string_of_diagnostics ~source:result.source ~filename:result.filename result.diagnostics; exit 1) else result.Res_driver.parsetree in - IO.writeFile - ~filename:(Filename.concat dataDir "oprint/expected/oprint.resi.txt") - ~contents:(signatureToOutcome signature) + IO.write_file + ~filename:(Filename.concat data_dir "oprint/expected/oprint.resi.txt") + ~contents:(signature_to_outcome signature) end module ParserApiTest = struct - let makeDefault () = + let make_default () = let src = " let x = 1\nlet y = 2\nlet z = 3" in let parser = Res_parser.make src "test.res" in assert (parser.scanner.lnum == 1); - assert (parser.scanner.lineOffset == 0); + assert (parser.scanner.line_offset == 0); assert (parser.scanner.offset == 6); assert (parser.token = Res_token.Let); print_endline "✅ Parser make: initializes parser and checking offsets" - let unixLf () = + let unix_lf () = let src = "let x = 1\nlet y = 2\nlet z = 3" in let parser = Res_parser.make src "test.res" in - (match Res_core.parseImplementation parser with + (match Res_core.parse_implementation parser with | [x; y; z] -> assert (x.pstr_loc.loc_start.pos_lnum = 1); assert (y.pstr_loc.loc_start.pos_lnum = 2); @@ -136,10 +136,10 @@ module ParserApiTest = struct | _ -> assert false); print_endline "✅ Parser handles LF correct" - let windowsCrlf () = + let windows_crlf () = let src = "let x = 1\r\nlet y = 2\r\nlet z = 3" in let parser = Res_parser.make src "test.res" in - (match Res_core.parseImplementation parser with + (match Res_core.parse_implementation parser with | [x; y; z] -> assert (x.pstr_loc.loc_start.pos_lnum = 1); assert (y.pstr_loc.loc_start.pos_lnum = 2); @@ -148,9 +148,9 @@ module ParserApiTest = struct print_endline "✅ Parser handles CRLF correct" let run () = - makeDefault (); - unixLf (); - windowsCrlf () + make_default (); + unix_lf (); + windows_crlf () end let () = OutcomePrinterTests.run () diff --git a/jscomp/syntax/testrunner/res_utf8_test.ml b/jscomp/syntax/testrunner/res_utf8_test.ml index 5546ae3fc7..ff961504fc 100644 --- a/jscomp/syntax/testrunner/res_utf8_test.ml +++ b/jscomp/syntax/testrunner/res_utf8_test.ml @@ -1,6 +1,6 @@ -type utf8Test = {codepoint: int; str: string; size: int} +type utf8_test = {codepoint: int; str: string; size: int} -let utf8CodePointTests = +let utf8_code_point_tests = [| {codepoint = 0x00; str = "\x00"; size = 1}; {codepoint = 0x01; str = "\x01"; size = 1}; @@ -36,38 +36,38 @@ let utf8CodePointTests = {codepoint = 0xFFFD; str = "\xef\xbf\xbd"; size = 3}; |] -let surrogateRange = +let surrogate_range = [| {codepoint = 0xFFFD; str = "\xed\xa0\x80"; size = 1}; {codepoint = 0xFFFD; str = "\xed\xbf\xbf"; size = 1}; |] -let testDecode () = +let test_decode () = Array.iter (fun t -> let len = String.length t.str in - let codepoint, size = Res_utf8.decodeCodePoint 0 t.str len in + let codepoint, size = Res_utf8.decode_code_point 0 t.str len in assert (codepoint = t.codepoint); assert (size = t.size)) - utf8CodePointTests + utf8_code_point_tests -let testDecodeSurrogateRange () = +let test_decode_surrogate_range () = Array.iter (fun t -> let len = String.length t.str in - let codepoint, size = Res_utf8.decodeCodePoint 0 t.str len in + let codepoint, size = Res_utf8.decode_code_point 0 t.str len in assert (codepoint = t.codepoint); assert (size = t.size)) - surrogateRange + surrogate_range -let testEncode () = +let test_encode () = Array.iter (fun t -> - let encodedString = Res_utf8.encodeCodePoint t.codepoint in - assert (encodedString = t.str)) - utf8CodePointTests + let encoded_string = Res_utf8.encode_code_point t.codepoint in + assert (encoded_string = t.str)) + utf8_code_point_tests -let validCodePointsTests = +let valid_code_points_tests = [| (0, true); (Char.code 'e', true); @@ -80,14 +80,14 @@ let validCodePointsTests = (-1, false); |] -let testIsValidCodePoint () = +let test_is_valid_code_point () = Array.iter - (fun (codePoint, t) -> assert (Res_utf8.isValidCodePoint codePoint = t)) - validCodePointsTests + (fun (code_point, t) -> assert (Res_utf8.is_valid_code_point code_point = t)) + valid_code_points_tests let run () = - testDecode (); - testDecodeSurrogateRange (); - testEncode (); - testIsValidCodePoint (); + test_decode (); + test_decode_surrogate_range (); + test_encode (); + test_is_valid_code_point (); print_endline "✅ utf8 tests" From a6b01b65d5291060730a403c3312c9f19279a0ed Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 26 May 2024 15:50:45 -0300 Subject: [PATCH 2/6] manual: fix dune build --- jscomp/frontend/ppx_entry.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/jscomp/frontend/ppx_entry.ml b/jscomp/frontend/ppx_entry.ml index 422892310a..4201e1aa33 100644 --- a/jscomp/frontend/ppx_entry.ml +++ b/jscomp/frontend/ppx_entry.ml @@ -30,9 +30,9 @@ let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature = let ast = match !Js_config.jsx_version with | None -> ast - | Some jsx_version -> + | Some jsx_version_ -> let open Js_config in - let jsx_version = int_of_jsx_version jsx_version in + let jsx_version = int_of_jsx_version jsx_version_ in let jsx_module = string_of_jsx_module !jsx_module in let jsx_mode = string_of_jsx_mode !jsx_mode in Jsx_ppx.rewrite_signature ~jsx_version ~jsx_module ~jsx_mode ast @@ -50,9 +50,9 @@ let rewrite_implementation (ast : Parsetree.structure) : Parsetree.structure = let ast = match !Js_config.jsx_version with | None -> ast - | Some jsx_version -> + | Some jsx_version_ -> let open Js_config in - let jsx_version = int_of_jsx_version jsx_version in + let jsx_version = int_of_jsx_version jsx_version_ in let jsx_module = string_of_jsx_module !jsx_module in let jsx_mode = string_of_jsx_mode !jsx_mode in Jsx_ppx.rewrite_implementation ~jsx_version ~jsx_module ~jsx_mode ast From f711ab00203f279938b42f9bd959e5621c5e05d1 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 26 May 2024 16:24:05 -0300 Subject: [PATCH 3/6] manual renames --- jscomp/core/bs_conditional_initial.ml | 2 +- jscomp/gentype/Annotation.ml | 46 ++++++++-------- jscomp/gentype/EmitJs.ml | 12 ++--- jscomp/gentype/EmitType.ml | 18 +++---- jscomp/gentype/ExportModule.ml | 2 +- jscomp/gentype/GenIdent.ml | 2 +- jscomp/gentype/GenTypeCommon.ml | 12 ++--- jscomp/gentype/GenTypeMain.ml | 52 +++++++++---------- jscomp/gentype/TranslateCoreType.ml | 8 +-- jscomp/gentype/TranslateSignature.ml | 2 +- jscomp/gentype/TranslateSignatureFromTypes.ml | 2 +- jscomp/gentype/TranslateStructure.ml | 4 +- jscomp/gentype/TranslateTypeDeclarations.ml | 8 +-- jscomp/gentype/TranslateTypeExprFromTypes.ml | 18 +++---- jscomp/gentype/Translation.ml | 2 +- jscomp/syntax/benchmarks/data/Napkinscript.ml | 38 +++++++------- jscomp/syntax/src/jsx_v4.ml | 16 +++--- jscomp/syntax/src/reactjs_jsx_v3.ml | 16 +++--- jscomp/syntax/src/res_printer.ml | 2 +- jscomp/syntax/src/res_printer.mli | 2 +- jscomp/syntax/src/res_scanner.ml | 26 +++++----- 21 files changed, 145 insertions(+), 145 deletions(-) diff --git a/jscomp/core/bs_conditional_initial.ml b/jscomp/core/bs_conditional_initial.ml index 7bf62e708f..51230157e3 100644 --- a/jscomp/core/bs_conditional_initial.ml +++ b/jscomp/core/bs_conditional_initial.ml @@ -49,7 +49,7 @@ let setup_env () = Rescript_cpp.replace_directive_bool "BS" true; Rescript_cpp.replace_directive_bool "JS" true; - Printtyp.print_res_poly_identifier := Res_printer.poly_var_ident_to_string; + Printtyp.print_res_poly_identifier := Res_printer.polyvar_ident_to_string; Rescript_cpp.replace_directive_string "BS_VERSION" Bs_version.version (*; Switch.cut := 100*) (* tweakable but not very useful *) diff --git a/jscomp/gentype/Annotation.ml b/jscomp/gentype/Annotation.ml index 4c7f691847..74587a1211 100644 --- a/jscomp/gentype/Annotation.ml +++ b/jscomp/gentype/Annotation.ml @@ -17,8 +17,8 @@ let to_string annotation = | GenTypeOpaque -> "GenTypeOpaque" | NoGenType -> "NoGenType" -let tag_is_gen_type s = s = "genType" || s = "gentype" -let tag_is_gen_type_as s = s = "genType.as" || s = "gentype.as" +let tag_is_gentype s = s = "genType" || s = "gentype" +let tag_is_gentype_as s = s = "genType.as" || s = "gentype.as" let tag_is_as s = s = "as" let tag_is_int s = s = "int" let tag_is_string s = s = "string" @@ -26,14 +26,14 @@ let tag_is_string s = s = "string" let tag_is_tag s = s = "tag" let tag_is_unboxed s = s = "unboxed" || s = "ocaml.unboxed" -let tag_is_gen_type_import s = s = "genType.import" || s = "gentype.import" -let tag_is_gen_type_opaque s = s = "genType.opaque" || s = "gentype.opaque" +let tag_is_gentype_import s = s = "genType.import" || s = "gentype.import" +let tag_is_gentype_opaque s = s = "genType.opaque" || s = "gentype.opaque" -let tag_is_one_of_the_gen_type_annotations s = - tag_is_gen_type s || tag_is_gen_type_as s || tag_is_gen_type_import s - || tag_is_gen_type_opaque s +let tag_is_one_of_the_gentype_annotations s = + tag_is_gentype s || tag_is_gentype_as s || tag_is_gentype_import s + || tag_is_gentype_opaque s -let tag_is_gen_type_ignore_interface s = +let tag_is_gentype_ignore_interface s = s = "genType.ignoreInterface" || s = "gentype.ignoreInterface" let tag_is_doc s = @@ -98,17 +98,17 @@ let rec get_attribute_payload check_text (attributes : Typedtree.attributes) = | Some payload -> Some (loc, payload)) | _hd :: tl -> get_attribute_payload check_text tl -let get_gen_type_as_renaming attributes = - match attributes |> get_attribute_payload tag_is_gen_type_as with +let get_gentype_as_renaming attributes = + match attributes |> get_attribute_payload tag_is_gentype_as with | Some (_, StringPayload s) -> Some s | None -> ( - match attributes |> get_attribute_payload tag_is_gen_type with + match attributes |> get_attribute_payload tag_is_gentype with | Some (_, StringPayload s) -> Some s | _ -> None) | _ -> None (* This is not supported anymore: only use to give a warning *) -let check_unsupported_gen_type_as_renaming attributes = +let check_unsupported_gentype_as_renaming attributes = let error ~loc = Log_.Color.setup (); Log_.info ~loc ~name:"Warning genType" (fun ppf () -> @@ -117,10 +117,10 @@ let check_unsupported_gen_type_as_renaming attributes = @genType.as is not supported anymore in type definitions. Use @as \ from the language.") in - match attributes |> get_attribute_payload tag_is_gen_type_as with + match attributes |> get_attribute_payload tag_is_gentype_as with | Some (loc, _) -> error ~loc | None -> ( - match attributes |> get_attribute_payload tag_is_gen_type with + match attributes |> get_attribute_payload tag_is_gentype with | Some (loc, _) -> error ~loc | None -> ()) @@ -136,18 +136,18 @@ let get_as_int attributes = | _ -> None let get_attribute_import_renaming attributes = - let attribute_import = attributes |> get_attribute_payload tag_is_gen_type_import in - let gen_type_as_renaming = attributes |> get_gen_type_as_renaming in - match (attribute_import, gen_type_as_renaming) with + let attribute_import = attributes |> get_attribute_payload tag_is_gentype_import in + let gentype_as_renaming = attributes |> get_gentype_as_renaming in + match (attribute_import, gentype_as_renaming) with | Some (_, StringPayload import_string), _ -> - (Some import_string, gen_type_as_renaming) + (Some import_string, gentype_as_renaming) | ( Some ( _, TuplePayload [StringPayload import_string; StringPayload rename_string] ), _ ) -> (Some import_string, Some rename_string) - | _ -> (None, gen_type_as_renaming) + | _ -> (None, gentype_as_renaming) let get_tag attributes = match attributes |> get_attribute_payload tag_is_tag with @@ -168,10 +168,10 @@ let has_attribute check_text (attributes : Typedtree.attributes) = let from_attributes ~(config : GenTypeConfig.t) ~loc (attributes : Typedtree.attributes) = let default = if config.everything then GenType else NoGenType in - if has_attribute tag_is_gen_type_opaque attributes then GenTypeOpaque - else if has_attribute (fun s -> tag_is_gen_type s || tag_is_gen_type_as s) attributes + if has_attribute tag_is_gentype_opaque attributes then GenTypeOpaque + else if has_attribute (fun s -> tag_is_gentype s || tag_is_gentype_as s) attributes then ( - (match attributes |> get_attribute_payload tag_is_gen_type with + (match attributes |> get_attribute_payload tag_is_gentype with | Some (_, UnrecognizedPayload) -> () | Some _ -> Log_.Color.setup (); @@ -293,6 +293,6 @@ let import_from_string import_string : import = {import_path} let update_config_for_module ~(config : GenTypeConfig.t) attributes = - if attributes |> has_attribute tag_is_gen_type then + if attributes |> has_attribute tag_is_gentype then {config with everything = true} else config diff --git a/jscomp/gentype/EmitJs.ml b/jscomp/gentype/EmitJs.ml index b1607af8a7..87841567f9 100644 --- a/jscomp/gentype/EmitJs.ml +++ b/jscomp/gentype/EmitJs.ml @@ -72,13 +72,13 @@ let emit_export_type ~emitters ~config ~type_name_is_interface {CodeItem.loc; name_as; opaque; type_; type_vars; resolved_type_name; doc_string} = let free_type_vars = TypeVars.free type_ in - let is_g_a_d_t = + let is_gadt = free_type_vars |> List.exists (fun s -> not (List.mem s type_vars)) in let opaque = match opaque with | Some true -> opaque - | _ when is_g_a_d_t -> + | _ when is_gadt -> Log_.Color.setup (); Log_.info ~loc ~name:"Warning genType" (fun ppf () -> Format.fprintf ppf @@ -163,7 +163,7 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name fields |> List.map (fun (field : field) -> match - field.name_j_s = "children" + field.name_js = "children" && field.type_ |> EmitType.is_type_react_element with | true -> {field with type_ = EmitType.type_react_child} @@ -186,7 +186,7 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name (* JSX V3 *) let fields = Ext_list.filter_map fields (fun (field : field) -> - match field.name_j_s with + match field.name_js with | "children" when field.type_ |> EmitType.is_type_react_element -> Some {field with type_ = EmitType.type_react_child} | "key" -> @@ -280,7 +280,7 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name fields |> List.map (fun (field : field) -> match - field.name_j_s = "children" + field.name_js = "children" && field.type_ |> EmitType.is_type_react_element with | true -> {field with type_ = EmitType.type_react_child} @@ -314,7 +314,7 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name let props_type = let fields = Ext_list.filter_map fields (fun (field : field) -> - match field.name_j_s with + match field.name_js with | "children" when field.type_ |> EmitType.is_type_react_element -> Some {field with type_ = EmitType.type_react_child} diff --git a/jscomp/gentype/EmitType.ml b/jscomp/gentype/EmitType.ml index 2a9a845680..1920efd238 100644 --- a/jscomp/gentype/EmitType.ml +++ b/jscomp/gentype/EmitType.ml @@ -44,7 +44,7 @@ let type_react_ref ~type_ = [ { mutable_ = Mutable; - name_j_s = react_ref_current; + name_js = react_ref_current; optional = Mandatory; type_ = Null type_; doc_string = DocString.empty; @@ -53,8 +53,8 @@ let type_react_ref ~type_ = let is_type_react_ref ~fields = match fields with - | [{mutable_ = Mutable; name_j_s; optional = Mandatory}] -> - name_j_s == react_ref_current + | [{mutable_ = Mutable; name_js; optional = Mandatory}] -> + name_js == react_ref_current | _ -> false let is_type_function_component ~fields type_ = @@ -162,11 +162,11 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac |> List.map (fun type_ -> type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) in - let no_payloads_rendered = no_payloads |> List.map label_j_s_to_string in + let no_payloads_rendered = no_payloads |> List.map label_js_to_string in let field ~name value = { mutable_ = Mutable; - name_j_s = name; + name_js = name; optional = Mandatory; type_ = TypeVar value; doc_string = DocString.empty; @@ -182,7 +182,7 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac t |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type in let tag_field = - case |> label_j_s_to_string + case |> label_js_to_string |> field ~name:(Runtime.js_variant_tag ~polymorphic:false ~tag) in match (unboxed, type_) with @@ -197,7 +197,7 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac | false, type_ when polymorphic -> (* poly variant *) [ - case |> label_j_s_to_string + case |> label_js_to_string |> field ~name:(Runtime.js_variant_tag ~polymorphic ~tag); type_ |> render |> field ~name:(Runtime.js_variant_value ~polymorphic); @@ -234,7 +234,7 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac ^ "| ")) and render_field ~config ~indent ~type_name_is_interface ~in_fun_type - {mutable_; name_j_s = lbl; optional; type_; doc_string} = + {mutable_; name_js = lbl; optional; type_; doc_string} = let opt_marker = match optional == Optional with | true -> "?" @@ -246,7 +246,7 @@ and render_field ~config ~indent ~type_name_is_interface ~in_fun_type | false -> "" in let lbl = - match is_j_s_safe_property_name lbl with + match is_js_safe_property_name lbl with | true -> lbl | false -> EmitText.quotes lbl in diff --git a/jscomp/gentype/ExportModule.ml b/jscomp/gentype/ExportModule.ml index b0e8e593b4..e2d5534454 100644 --- a/jscomp/gentype/ExportModule.ml +++ b/jscomp/gentype/ExportModule.ml @@ -40,7 +40,7 @@ and export_module_item_to_fields = let field_for_type = { mutable_ = Mutable; - name_j_s = field_name; + name_js = field_name; optional = Mandatory; type_ = type_for_type; doc_string; diff --git a/jscomp/gentype/GenIdent.ml b/jscomp/gentype/GenIdent.ml index 880742eea3..7a7ef18f9a 100644 --- a/jscomp/gentype/GenIdent.ml +++ b/jscomp/gentype/GenIdent.ml @@ -12,7 +12,7 @@ type type_vars_gen = { let create_type_vars_gen () = {type_name_map = IntMap.empty; type_name_counter = 0} -let js_type_name_for_anonymous_type_i_d ~type_vars_gen id = +let js_type_name_for_anonymous_type_id ~type_vars_gen id = try type_vars_gen.type_name_map |> IntMap.find id with Not_found -> type_vars_gen.type_name_counter <- type_vars_gen.type_name_counter + 1; diff --git a/jscomp/gentype/GenTypeCommon.ml b/jscomp/gentype/GenTypeCommon.ml index d9a14b73bc..e6d14369a1 100644 --- a/jscomp/gentype/GenTypeCommon.ml +++ b/jscomp/gentype/GenTypeCommon.ml @@ -18,7 +18,7 @@ let log_not_implemented x = type optional = Mandatory | Optional type mutable_ = Immutable | Mutable -type label_j_s = +type label_js = | NullLabel | UndefinedLabel | BoolLabel of bool @@ -26,9 +26,9 @@ type label_j_s = | IntLabel of string | StringLabel of string -type case = {label_j_s: label_j_s} +type case = {label_js: label_js} -let is_j_s_safe_property_name name = +let is_js_safe_property_name name = name = "" || (match name.[0] [@doesNotRaise] with | 'A' .. 'z' -> true @@ -53,8 +53,8 @@ let is_number s = done; res.contents -let label_j_s_to_string case = - match case.label_j_s with +let label_js_to_string case = + match case.label_js with | NullLabel -> "null" | UndefinedLabel -> "undefined" | BoolLabel b -> b |> string_of_bool @@ -83,7 +83,7 @@ and arg_type = {a_name: string; a_type: type_} and field = { mutable_: mutable_; - name_j_s: string; + name_js: string; optional: optional; type_: type_; doc_string: DocString.t; diff --git a/jscomp/gentype/GenTypeMain.ml b/jscomp/gentype/GenTypeMain.ml index 7d173e9ce7..f29c97b2ef 100644 --- a/jscomp/gentype/GenTypeMain.ml +++ b/jscomp/gentype/GenTypeMain.ml @@ -1,15 +1,15 @@ module StringSet = Set.Make (String) -let cmt_check_annotations ~check_annotation input_c_m_t = - match input_c_m_t.Cmt_format.cmt_annots with +let cmt_check_annotations ~check_annotation input_cmt = + match input_cmt.Cmt_format.cmt_annots with | Implementation structure -> structure |> Annotation.structure_check_annotation ~check_annotation | Interface signature -> signature |> Annotation.signature_check_annotation ~check_annotation | _ -> false -let cmt_has_type_errors input_c_m_t = - match input_c_m_t.Cmt_format.cmt_annots with +let cmt_has_type_errors input_cmt = + match input_cmt.Cmt_format.cmt_annots with | Partial_implementation _ | Partial_interface _ -> true | _ -> false @@ -24,8 +24,8 @@ let signature_item_is_declaration signature_item = | _ -> false let input_cmt_translate_type_declarations ~config ~output_file_relative ~resolver - input_c_m_t : CodeItem.translation = - let {Cmt_format.cmt_annots} = input_c_m_t in + input_cmt : CodeItem.translation = + let {Cmt_format.cmt_annots} = input_cmt in let type_env = TypeEnv.root () in let translations = match cmt_annots with @@ -50,9 +50,9 @@ let input_cmt_translate_type_declarations ~config ~output_file_relative ~resolve translations |> Translation.combine |> Translation.add_type_declarations_from_module_equations ~type_env -let translate_c_m_t ~config ~output_file_relative ~resolver input_c_m_t : Translation.t +let translate_c_m_t ~config ~output_file_relative ~resolver input_cmt : Translation.t = - let {Cmt_format.cmt_annots} = input_c_m_t in + let {Cmt_format.cmt_annots} = input_cmt in let type_env = TypeEnv.root () in let translations = match cmt_annots with @@ -104,31 +104,31 @@ let process_cmt_file cmt = ~exclude_file:(fun fname -> fname = "React.res" || fname = "ReasonReact.res") in - let input_c_m_t, has_gen_type_annotations = - let input_c_m_t = read_cmt cmt_file in + let input_cmt, has_gentype_annotations = + let input_cmt = read_cmt cmt_file in let ignore_interface = ref false in let check_annotation ~loc:_ attributes = if attributes |> Annotation.get_attribute_payload - Annotation.tag_is_gen_type_ignore_interface + Annotation.tag_is_gentype_ignore_interface <> None then ignore_interface := true; attributes |> Annotation.get_attribute_payload - Annotation.tag_is_one_of_the_gen_type_annotations + Annotation.tag_is_one_of_the_gentype_annotations <> None in - let has_gen_type_annotations = - input_c_m_t |> cmt_check_annotations ~check_annotation + let has_gentype_annotations = + input_cmt |> cmt_check_annotations ~check_annotation in if is_interface then let cmt_file_impl = (cmt_file |> (Filename.chop_extension [@doesNotRaise])) ^ ".cmt" in - let input_c_m_t_impl = read_cmt cmt_file_impl in - let has_gen_type_annotations_impl = - input_c_m_t_impl + let input_cmt_impl = read_cmt cmt_file_impl in + let has_gentype_annotations_impl = + input_cmt_impl |> cmt_check_annotations ~check_annotation:(fun ~loc attributes -> if attributes |> check_annotation ~loc then ( if not !ignore_interface then ( @@ -140,16 +140,16 @@ let process_cmt_file cmt = else false) in ( (match !ignore_interface with - | true -> input_c_m_t_impl - | false -> input_c_m_t), + | true -> input_cmt_impl + | false -> input_cmt), match !ignore_interface with - | true -> has_gen_type_annotations_impl - | false -> has_gen_type_annotations ) - else (input_c_m_t, has_gen_type_annotations) + | true -> has_gentype_annotations_impl + | false -> has_gentype_annotations ) + else (input_cmt, has_gentype_annotations) in - if has_gen_type_annotations then + if has_gentype_annotations then let source_file = - match input_c_m_t.cmt_annots |> FindSourceFile.cmt with + match input_cmt.cmt_annots |> FindSourceFile.cmt with | Some source_file -> source_file | None -> ( (file_name |> ModuleName.to_string) @@ -158,11 +158,11 @@ let process_cmt_file cmt = | true -> ".resi" | false -> ".res") in - input_c_m_t + input_cmt |> translate_c_m_t ~config ~output_file_relative ~resolver |> emit_translation ~config ~file_name ~output_file ~output_file_relative ~resolver ~source_file - else if input_c_m_t |> cmt_has_type_errors then + else if input_cmt |> cmt_has_type_errors then output_file |> GeneratedFiles.log_file_action TypeError else ( output_file |> GeneratedFiles.log_file_action NoMatch; diff --git a/jscomp/gentype/TranslateCoreType.ml b/jscomp/gentype/TranslateCoreType.ml index 3ca4c33e8e..2de07f172d 100644 --- a/jscomp/gentype/TranslateCoreType.ml +++ b/jscomp/gentype/TranslateCoreType.ml @@ -64,7 +64,7 @@ let rec translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependen | Ttyp_arrow (((Labelled lbl | Optional lbl) as label), core_type1, core_type2) -> ( let as_label = - match core_type.ctyp_attributes |> Annotation.get_gen_type_as_renaming with + match core_type.ctyp_attributes |> Annotation.get_gentype_as_renaming with | Some s -> s | None -> "" in @@ -174,7 +174,7 @@ and translateCoreType_ ~config ~type_vars_gen let no_payloads = no_payloads |> List.map (fun (label, attributes) -> - let label_j_s = + let label_js = if as_string then match attributes |> Annotation.get_as_string with | Some label_renamed -> StringLabel label_renamed @@ -192,7 +192,7 @@ and translateCoreType_ ~config ~type_vars_gen else if is_number label then IntLabel label else StringLabel label in - {label_j_s}) + {label_js}) in let payloads_translations = payloads @@ -207,7 +207,7 @@ and translateCoreType_ ~config ~type_vars_gen { case = { - label_j_s = + label_js = (if is_number label then IntLabel label else StringLabel label); }; diff --git a/jscomp/gentype/TranslateSignature.ml b/jscomp/gentype/TranslateSignature.ml index 86bc80933f..21fe5ec90b 100644 --- a/jscomp/gentype/TranslateSignature.ml +++ b/jscomp/gentype/TranslateSignature.ml @@ -110,7 +110,7 @@ and translate_signature_item ~config ~output_file_relative ~resolver ~type_env | {Typedtree.sig_desc = Tsig_value value_description} -> let is_import = value_description.val_attributes - |> Annotation.has_attribute Annotation.tag_is_gen_type_import + |> Annotation.has_attribute Annotation.tag_is_gentype_import in if value_description.val_prim <> [] || is_import then value_description diff --git a/jscomp/gentype/TranslateSignatureFromTypes.ml b/jscomp/gentype/TranslateSignatureFromTypes.ml index f07de09649..65d969fcbe 100644 --- a/jscomp/gentype/TranslateSignatureFromTypes.ml +++ b/jscomp/gentype/TranslateSignatureFromTypes.ml @@ -17,7 +17,7 @@ let translate_type_declaration_from_types ~config ~output_file_relative ~resolve (label_declarations, record_representation) | Type_variant constructor_declarations when not - (TranslateTypeDeclarations.has_some_g_a_d_t_leaf constructor_declarations) + (TranslateTypeDeclarations.has_some_gadt_leaf constructor_declarations) -> VariantDeclarationFromTypes constructor_declarations | Type_abstract -> GeneralDeclarationFromTypes type_manifest diff --git a/jscomp/gentype/TranslateStructure.ml b/jscomp/gentype/TranslateStructure.ml index 066c20453c..b28187e154 100644 --- a/jscomp/gentype/TranslateStructure.ml +++ b/jscomp/gentype/TranslateStructure.ml @@ -51,9 +51,9 @@ and add_annotations_to_fields ~config (expr : Typedtree.expression) in let name = TranslateTypeDeclarations.rename_record_field - ~attributes:expr.exp_attributes ~name:field.name_j_s + ~attributes:expr.exp_attributes ~name:field.name_js in - ({field with name_j_s = name} :: next_fields1, types1) + ({field with name_js = name} :: next_fields1, types1) | _ -> (fields, arg_types) [@@live] diff --git a/jscomp/gentype/TranslateTypeDeclarations.ml b/jscomp/gentype/TranslateTypeDeclarations.ml index 1b03344665..8b49ef7a19 100644 --- a/jscomp/gentype/TranslateTypeDeclarations.ml +++ b/jscomp/gentype/TranslateTypeDeclarations.ml @@ -23,7 +23,7 @@ let create_export_type_from_type_declaration ~annotation ~loc ~name_as ~opaque ~ let create_case (label, attributes) ~poly = { - label_j_s = + label_js = (match attributes |> Annotation.get_attribute_payload Annotation.tag_is_as with @@ -44,7 +44,7 @@ let create_case (label, attributes) ~poly = * the identifier contains characters which are invalid as JS property names. *) let rename_record_field ~attributes ~name = - attributes |> Annotation.check_unsupported_gen_type_as_renaming; + attributes |> Annotation.check_unsupported_gentype_as_renaming; match attributes |> Annotation.get_as_string with | Some s -> s |> String.escaped | None -> name @@ -127,7 +127,7 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver | Option type1 when is_optional name -> (Optional, type1) | _ -> (Mandatory, type_) in - {mutable_; name_j_s = name; optional; type_ = type1; doc_string}) + {mutable_; name_js = name; optional; type_ = type1; doc_string}) in let type_ = match fields with @@ -309,7 +309,7 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver {CodeItem.export_from_type_declaration; import_types} |> return_type_declaration | NoDeclaration, None -> [] -let has_some_g_a_d_t_leaf constructor_declarations = +let has_some_gadt_leaf constructor_declarations = List.exists (fun declaration -> declaration.Types.cd_res != None) constructor_declarations diff --git a/jscomp/gentype/TranslateTypeExprFromTypes.ml b/jscomp/gentype/TranslateTypeExprFromTypes.ml index 6b690ce47f..2344cda345 100644 --- a/jscomp/gentype/TranslateTypeExprFromTypes.ml +++ b/jscomp/gentype/TranslateTypeExprFromTypes.ml @@ -46,7 +46,7 @@ let translate_obj_type closed_flag fields_translations = in { mutable_; - name_j_s = name; + name_js = name; optional; type_; doc_string = DocString.empty; @@ -128,7 +128,7 @@ let translate_constr ~config ~params_translation ~(path : Path.t) ~type_env = [ { mutable_ = Mutable; - name_j_s = "contents"; + name_js = "contents"; optional = Mandatory; type_ = param_translation.type_; doc_string = DocString.empty; @@ -137,7 +137,7 @@ let translate_constr ~config ~params_translation ~(path : Path.t) ~type_env = } | ( (["Pervasives"; "result"] | ["Belt"; "Result"; "t"] | ["result"]), [param_translation1; param_translation2] ) -> - let case name type_ = {case = {label_j_s = StringLabel name}; t = type_} in + let case name type_ = {case = {label_js = StringLabel name}; t = type_} in let variant = create_variant ~inherits:[] ~no_payloads:[] ~payloads: @@ -320,7 +320,7 @@ and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env match type_expr.desc with | Tvar None -> let type_name = - GenIdent.js_type_name_for_anonymous_type_i_d ~type_vars_gen type_expr.id + GenIdent.js_type_name_for_anonymous_type_id ~type_vars_gen type_expr.id in {dependencies = []; type_ = TypeVar type_name} | Tvar (Some s) -> {dependencies = []; type_ = TypeVar s} @@ -382,7 +382,7 @@ and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env no_payloads |> List.map (fun label -> { - label_j_s = + label_js = (if is_number label then IntLabel label else StringLabel label); }) in @@ -397,7 +397,7 @@ and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env t |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env | {no_payloads; payloads; unknowns = []} -> let no_payloads = - no_payloads |> List.map (fun label -> {label_j_s = StringLabel label}) + no_payloads |> List.map (fun label -> {label_js = StringLabel label}) in let payload_translations = payloads @@ -409,7 +409,7 @@ and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env let payloads = payload_translations |> List.map (fun (label, translation) -> - {case = {label_j_s = StringLabel label}; t = translation.type_}) + {case = {label_js = StringLabel label}; t = translation.type_}) in let type_ = create_variant ~inherits:[] ~no_payloads ~payloads ~polymorphic:true @@ -475,7 +475,7 @@ and signature_to_module_runtime_representation ~config ~type_vars_gen ~type_env let field = { mutable_ = Immutable; - name_j_s = id |> Ident.name; + name_js = id |> Ident.name; optional = Mandatory; type_; doc_string = Annotation.doc_string_from_attrs val_attributes; @@ -499,7 +499,7 @@ and signature_to_module_runtime_representation ~config ~type_vars_gen ~type_env let field = { mutable_ = Immutable; - name_j_s = id |> Ident.name; + name_js = id |> Ident.name; optional = Mandatory; type_; doc_string = diff --git a/jscomp/gentype/Translation.ml b/jscomp/gentype/Translation.ml index 658739c9d9..a54c77824e 100644 --- a/jscomp/gentype/Translation.ml +++ b/jscomp/gentype/Translation.ml @@ -75,7 +75,7 @@ let translate_dependencies ~config ~output_file_relative ~resolver dependencies let translate_value ~attributes ~config ~doc_string ~output_file_relative ~resolver ~type_env ~type_expr ~(add_annotations_to_function : type_ -> type_) name : t = let name_as = - match Annotation.get_gen_type_as_renaming attributes with + match Annotation.get_gentype_as_renaming attributes with | Some s -> s | _ -> name in diff --git a/jscomp/syntax/benchmarks/data/Napkinscript.ml b/jscomp/syntax/benchmarks/data/Napkinscript.ml index 8011a18d1f..e6b7a0f5d2 100644 --- a/jscomp/syntax/benchmarks/data/Napkinscript.ml +++ b/jscomp/syntax/benchmarks/data/Napkinscript.ml @@ -2994,7 +2994,7 @@ module ParsetreeViewer : sig Parsetree.module_expr ) - val split_gen_type_attr : Parsetree.attributes -> (bool * Parsetree.attributes) + val split_gentype_attr: Parsetree.attributes -> (bool * Parsetree.attributes) val collect_patterns_from_list_construct: Parsetree.pattern list -> Parsetree.pattern -> @@ -3451,7 +3451,7 @@ end = struct in loop [] mod_expr - let split_gen_type_attr attrs = + let split_gentype_attr attrs = match attrs with | ({Location.txt = "genType"}, _)::attrs -> (true, attrs) | attrs -> (false, attrs) @@ -6877,16 +6877,16 @@ module Printer = struct * | Ptype_open *) and print_type_declaration ~name ~equal_sign ~rec_flag i (td: Parsetree.type_declaration) cmt_tbl = - let (has_gen_type, attrs) = ParsetreeViewer.split_gen_type_attr td.ptype_attributes in + let (has_gentype, attrs) = ParsetreeViewer.split_gentype_attr td.ptype_attributes in let attrs = print_attributes ~loc:td.ptype_loc attrs in let prefix = if i > 0 then Doc.concat [ Doc.text "and "; - if has_gen_type then Doc.text "export " else Doc.nil + if has_gentype then Doc.text "export " else Doc.nil ] else Doc.concat [ - Doc.text (if has_gen_type then "export type " else "type "); + Doc.text (if has_gentype then "export type " else "type "); rec_flag ] in @@ -6954,16 +6954,16 @@ module Printer = struct print_comments doc cmt_tbl td.ptype_name.loc in let equal_sign = "=" in - let (has_gen_type, attrs) = ParsetreeViewer.split_gen_type_attr td.ptype_attributes in + let (has_gentype, attrs) = ParsetreeViewer.split_gentype_attr td.ptype_attributes in let attrs = print_attributes ~loc:td.ptype_loc attrs in let prefix = if i > 0 then Doc.concat [ Doc.text "and "; - if has_gen_type then Doc.text "export " else Doc.nil + if has_gentype then Doc.text "export " else Doc.nil ] else Doc.concat [ - Doc.text (if has_gen_type then "export type " else "type "); + Doc.text (if has_gentype then "export type " else "type "); rec_flag ] in @@ -7608,17 +7608,17 @@ module Printer = struct print_comments doc cmt_tbl typ.ptyp_loc and print_value_binding ~rec_flag vb cmt_tbl i = - let (has_gen_type, attrs) = ParsetreeViewer.split_gen_type_attr vb.pvb_attributes in + let (has_gentype, attrs) = ParsetreeViewer.split_gentype_attr vb.pvb_attributes in let attrs = print_attributes ~loc:vb.pvb_pat.ppat_loc attrs in let header = if i == 0 then Doc.concat [ - if has_gen_type then Doc.text "export " else Doc.text "let "; + if has_gentype then Doc.text "export " else Doc.text "let "; rec_flag ] else Doc.concat [ Doc.text "and "; - if has_gen_type then Doc.text "export " else Doc.nil + if has_gentype then Doc.text "export " else Doc.nil ] in match vb with @@ -11525,8 +11525,8 @@ module JsFfi = struct |> Ast_helper.Exp.constant |> Ast_helper.Str.eval ] in - let gen_type = (Location.mknoloc "genType.import", Parsetree.PStr structure) in - [gen_type] + let gentype = (Location.mknoloc "genType.import", Parsetree.PStr structure) in + [gentype] | Scope longident -> let structure_item = let expr = match Longident.flatten longident |> List.map (fun s -> @@ -14604,8 +14604,8 @@ end | Export -> let export_loc = mk_loc p.start_pos p.end_pos in Parser.next p; - let gen_type_attr = (Location.mkloc "genType" export_loc, Parsetree.PStr []) in - gen_type_attr::attrs + let gentype_attr = (Location.mkloc "genType" export_loc, Parsetree.PStr []) in + gentype_attr::attrs | _ -> attrs in ignore(Parser.optional p Let); (* overparse for fault tolerance *) @@ -17052,8 +17052,8 @@ end | Export -> let export_loc = mk_loc p.start_pos p.end_pos in Parser.next p; - let gen_type_attr = (Location.mkloc "genType" export_loc, Parsetree.PStr []) in - gen_type_attr::attrs + let gentype_attr = (Location.mkloc "genType" export_loc, Parsetree.PStr []) in + gentype_attr::attrs | _ -> attrs in let type_def = parse_type_def ~attrs ~start_pos p in @@ -17261,8 +17261,8 @@ end let export_start = p.Parser.start_pos in Parser.expect Token.Export p; let export_loc = mk_loc export_start p.prev_end_pos in - let gen_type_attr = (Location.mkloc "genType" export_loc, Parsetree.PStr []) in - let attrs = gen_type_attr::attrs in + let gentype_attr = (Location.mkloc "genType" export_loc, Parsetree.PStr []) in + let attrs = gentype_attr::attrs in match p.Parser.token with | Typ -> begin match parse_type_definition_or_extension ~attrs p with diff --git a/jscomp/syntax/src/jsx_v4.ml b/jscomp/syntax/src/jsx_v4.ml index e7ce1d7b04..34ef9844cd 100644 --- a/jscomp/syntax/src/jsx_v4.ml +++ b/jscomp/syntax/src/jsx_v4.ml @@ -1364,17 +1364,17 @@ let expr ~config mapper expression = pexp_attributes; pexp_loc; } -> ( - let jsx_attribute, non_j_s_x_attributes = + let jsx_attribute, non_jsx_attributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - match (jsx_attribute, non_j_s_x_attributes) with + match (jsx_attribute, non_jsx_attributes) with (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression - | _, non_j_s_x_attributes -> + | _, non_jsx_attributes -> transform_jsx_call ~config mapper call_expression call_arguments pexp_loc - non_j_s_x_attributes) + non_jsx_attributes) (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) | { pexp_desc = @@ -1383,15 +1383,15 @@ let expr ~config mapper expression = | Pexp_construct ({txt = Lident "[]"; loc}, None) ); pexp_attributes; } as list_items -> ( - let jsx_attribute, non_j_s_x_attributes = + let jsx_attribute, non_jsx_attributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - match (jsx_attribute, non_j_s_x_attributes) with + match (jsx_attribute, non_jsx_attributes) with (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression - | _, non_j_s_x_attributes -> + | _, non_jsx_attributes -> let loc = {loc with loc_ghost = true} in let fragment = match config.mode with @@ -1440,7 +1440,7 @@ let expr ~config mapper expression = in Exp.apply ~loc (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs:non_j_s_x_attributes + ~attrs:non_jsx_attributes (* ReactDOM.createElement *) (match config.mode with | "automatic" -> diff --git a/jscomp/syntax/src/reactjs_jsx_v3.ml b/jscomp/syntax/src/reactjs_jsx_v3.ml index b2dc1aab44..9817ffb53e 100644 --- a/jscomp/syntax/src/reactjs_jsx_v3.ml +++ b/jscomp/syntax/src/reactjs_jsx_v3.ml @@ -1132,16 +1132,16 @@ let jsx_mapper ~config = (* Does the function application have the @JSX attribute? *) | {pexp_desc = Pexp_apply (call_expression, call_arguments); pexp_attributes} -> ( - let jsx_attribute, non_j_s_x_attributes = + let jsx_attribute, non_jsx_attributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - match (jsx_attribute, non_j_s_x_attributes) with + match (jsx_attribute, non_jsx_attributes) with (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression - | _, non_j_s_x_attributes -> - transform_jsx_call mapper call_expression call_arguments non_j_s_x_attributes) + | _, non_jsx_attributes -> + transform_jsx_call mapper call_expression call_arguments non_jsx_attributes) (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) | { pexp_desc = @@ -1150,15 +1150,15 @@ let jsx_mapper ~config = | Pexp_construct ({txt = Lident "[]"; loc}, None) ); pexp_attributes; } as list_items -> ( - let jsx_attribute, non_j_s_x_attributes = + let jsx_attribute, non_jsx_attributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") pexp_attributes in - match (jsx_attribute, non_j_s_x_attributes) with + match (jsx_attribute, non_jsx_attributes) with (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression - | _, non_j_s_x_attributes -> + | _, non_jsx_attributes -> let loc = {loc with loc_ghost = true} in let fragment = Exp.ident ~loc {loc; txt = Ldot (Lident "ReasonReact", "fragment")} @@ -1174,7 +1174,7 @@ let jsx_mapper ~config = in Exp.apply ~loc (* throw away the [@JSX] attribute and keep the others, if any *) - ~attrs:non_j_s_x_attributes + ~attrs:non_jsx_attributes (* ReactDOMRe.createElement *) (Exp.ident ~loc {loc; txt = Ldot (Lident "ReactDOMRe", "createElement")}) diff --git a/jscomp/syntax/src/res_printer.ml b/jscomp/syntax/src/res_printer.ml index d104464d6b..7d3307a49e 100644 --- a/jscomp/syntax/src/res_printer.ml +++ b/jscomp/syntax/src/res_printer.ml @@ -441,7 +441,7 @@ let print_poly_var_ident txt = | "" -> Doc.concat [Doc.text "\""; Doc.text txt; Doc.text "\""] | _ -> Doc.text txt) -let poly_var_ident_to_string poly_var_ident = +let polyvar_ident_to_string poly_var_ident = Doc.concat [Doc.text "#"; print_poly_var_ident poly_var_ident] |> Doc.to_string ~width:80 diff --git a/jscomp/syntax/src/res_printer.mli b/jscomp/syntax/src/res_printer.mli index 9d2255445f..c3b95b8e24 100644 --- a/jscomp/syntax/src/res_printer.mli +++ b/jscomp/syntax/src/res_printer.mli @@ -27,4 +27,4 @@ val print_ident_like : val print_poly_var_ident : string -> Res_doc.t -val poly_var_ident_to_string : string -> string [@@live] +val polyvar_ident_to_string : string -> string [@@live] diff --git a/jscomp/syntax/src/res_scanner.ml b/jscomp/syntax/src/res_scanner.ml index 9dc5a93134..7aa2cee32b 100644 --- a/jscomp/syntax/src/res_scanner.ml +++ b/jscomp/syntax/src/res_scanner.ml @@ -7,7 +7,7 @@ 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_e_o_f_char = Char.unsafe_chr (-1) +let hacky_eof_char = Char.unsafe_chr (-1) type char_encoding = Char.t type t = { @@ -119,7 +119,7 @@ let next scanner = else ( scanner.offset <- String.length scanner.src; scanner.offset16 <- scanner.offset - scanner.line_offset; - scanner.ch <- hacky_e_o_f_char) + scanner.ch <- hacky_eof_char) let next2 scanner = next scanner; @@ -133,24 +133,24 @@ 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_e_o_f_char + else hacky_eof_char let peek2 scanner = if scanner.offset + 2 < String.length scanner.src then String.unsafe_get scanner.src (scanner.offset + 2) - else hacky_e_o_f_char + else hacky_eof_char let peek3 scanner = if scanner.offset + 3 < String.length scanner.src then String.unsafe_get scanner.src (scanner.offset + 3) - else hacky_e_o_f_char + else hacky_eof_char let make ~filename src = { filename; src; err = (fun ~start_pos:_ ~end_pos:_ _ -> ()); - ch = (if src = "" then hacky_e_o_f_char else String.unsafe_get src 0); + ch = (if src = "" then hacky_eof_char else String.unsafe_get src 0); offset = 0; offset16 = 0; line_offset = 0; @@ -297,7 +297,7 @@ let scan_exotic_identifier scanner = scanner.err ~start_pos ~end_pos (Diagnostics.message "A quoted identifier can't contain line breaks."); next scanner - | ch when ch == hacky_e_o_f_char -> + | ch when ch == hacky_eof_char -> let end_pos = position scanner in scanner.err ~start_pos ~end_pos (Diagnostics.message "Did you forget a \" here?") @@ -329,7 +329,7 @@ let scan_string_escape_sequence ~start_pos scanner = if d >= base then ( let pos = position scanner in let msg = - if scanner.ch == hacky_e_o_f_char then "unclosed escape sequence" + if scanner.ch == hacky_eof_char then "unclosed escape sequence" else "unknown escape sequence" in scanner.err ~start_pos ~end_pos:pos (Diagnostics.message msg); @@ -431,7 +431,7 @@ let scan_string 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_e_o_f_char -> + | 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 @@ -539,7 +539,7 @@ let scan_single_line_comment scanner = let rec skip scanner = match scanner.ch with | '\n' | '\r' -> () - | ch when ch == hacky_e_o_f_char -> () + | ch when ch == hacky_eof_char -> () | _ -> next scanner; skip scanner @@ -569,7 +569,7 @@ let scan_multi_line_comment scanner = | '*', '/' -> next2 scanner; if depth > 1 then scan ~depth:(depth - 1) - | ch, _ when ch == hacky_e_o_f_char -> + | ch, _ when ch == hacky_eof_char -> let end_pos = position scanner in scanner.err ~start_pos ~end_pos Diagnostics.unclosed_comment | _ -> @@ -625,7 +625,7 @@ let scan_template_literal_token scanner = | _ -> next scanner; scan ()) - | ch when ch = hacky_e_o_f_char -> + | ch when ch = hacky_eof_char -> let end_pos = position scanner in scanner.err ~start_pos ~end_pos Diagnostics.unclosed_template; let contents = @@ -907,7 +907,7 @@ let rec scan scanner = next scanner; Token.Equal) (* special cases *) - | ch when ch == hacky_e_o_f_char -> + | ch when ch == hacky_eof_char -> next scanner; Token.Eof | ch -> From b2e8133ab3347c2475d2d273c0348bf610f89c09 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 26 May 2024 16:35:00 -0300 Subject: [PATCH 4/6] dune fmt --- jscomp/frontend/ast_derive_js_mapper.ml | 9 +- jscomp/frontend/ast_tdcls.ml | 8 +- jscomp/gentype/Annotation.ml | 19 +- jscomp/gentype/Converter.ml | 11 +- jscomp/gentype/Dependencies.ml | 12 +- jscomp/gentype/EmitJs.ml | 135 ++++--- jscomp/gentype/EmitType.ml | 95 +++-- jscomp/gentype/Emitters.ml | 5 +- jscomp/gentype/ExportModule.ml | 30 +- jscomp/gentype/GenIdent.ml | 6 +- jscomp/gentype/GenTypeCommon.ml | 6 +- jscomp/gentype/GenTypeConfig.ml | 11 +- jscomp/gentype/GenTypeMain.ml | 20 +- jscomp/gentype/ImportPath.ml | 7 +- jscomp/gentype/ModuleResolver.ml | 24 +- jscomp/gentype/Paths.ml | 3 +- jscomp/gentype/ResolvedName.ml | 3 +- jscomp/gentype/Runtime.ml | 11 +- jscomp/gentype/Runtime.mli | 4 +- jscomp/gentype/TranslateCoreType.ml | 52 ++- jscomp/gentype/TranslateSignature.ml | 16 +- jscomp/gentype/TranslateSignatureFromTypes.ml | 28 +- jscomp/gentype/TranslateStructure.ml | 55 ++- jscomp/gentype/TranslateTypeDeclarations.ml | 49 ++- jscomp/gentype/TranslateTypeExprFromTypes.ml | 59 ++- jscomp/gentype/Translation.ml | 26 +- jscomp/gentype/TypeEnv.ml | 20 +- jscomp/syntax/src/jsx_ppx.ml | 10 +- jscomp/syntax/src/jsx_v4.ml | 103 +++-- jscomp/syntax/src/reactjs_jsx_v3.ml | 70 +++- jscomp/syntax/src/res_ast_conversion.ml | 33 +- jscomp/syntax/src/res_ast_debugger.ml | 46 ++- jscomp/syntax/src/res_comments_table.ml | 157 ++++++-- jscomp/syntax/src/res_core.ml | 240 +++++++---- jscomp/syntax/src/res_diagnostics.ml | 3 +- jscomp/syntax/src/res_doc.ml | 7 +- jscomp/syntax/src/res_driver.ml | 3 +- jscomp/syntax/src/res_driver.mli | 3 +- jscomp/syntax/src/res_driver_ml_parser.ml | 4 +- jscomp/syntax/src/res_outcome_printer.ml | 31 +- jscomp/syntax/src/res_parens.ml | 30 +- jscomp/syntax/src/res_parens.mli | 3 +- jscomp/syntax/src/res_parser.ml | 4 +- jscomp/syntax/src/res_parsetree_viewer.ml | 12 +- jscomp/syntax/src/res_parsetree_viewer.mli | 6 +- jscomp/syntax/src/res_printer.ml | 381 ++++++++++++------ jscomp/syntax/src/res_scanner.ml | 21 +- jscomp/syntax/testrunner/res_test.ml | 3 +- jscomp/syntax/testrunner/res_utf8_test.ml | 3 +- 49 files changed, 1259 insertions(+), 638 deletions(-) diff --git a/jscomp/frontend/ast_derive_js_mapper.ml b/jscomp/frontend/ast_derive_js_mapper.ml index 29827bb70b..337a7001fa 100644 --- a/jscomp/frontend/ast_derive_js_mapper.ml +++ b/jscomp/frontend/ast_derive_js_mapper.ml @@ -219,7 +219,8 @@ let init () = else Exp.constraint_ obj_exp core_type)) in let rest = [to_js; from_js] in - if create_type then erase_type_str :: new_type_str :: rest else rest + if create_type then erase_type_str :: new_type_str :: rest + else rest | Ptype_abstract -> ( match Ast_polyvar.is_enum_polyvar tdcl with | Some row_fields -> @@ -243,7 +244,8 @@ let init () = ( {txt = "raw"; loc}, PStr [ - Str.eval (Exp.constant (Const.string rev_data)); + Str.eval + (Exp.constant (Const.string rev_data)); ] ) else exp_map); to_js_body @@ -303,7 +305,8 @@ let init () = in new_type_str +? [ - to_js_type (if create_type then new_type else obj_type Closed); + to_js_type + (if create_type then new_type else obj_type Closed); Ast_comb.single_non_rec_val pat_from_js ((if create_type then new_type else obj_type Open) ->~ core_type); diff --git a/jscomp/frontend/ast_tdcls.ml b/jscomp/frontend/ast_tdcls.ml index c367cb0c6c..8326c20fd3 100644 --- a/jscomp/frontend/ast_tdcls.ml +++ b/jscomp/frontend/ast_tdcls.ml @@ -51,8 +51,8 @@ let handle_tdcls_in_sigi (self : Bs_ast_mapper.mapper) let kind = Ast_derive_abstract.is_abstract actions in if kind <> Not_abstract then let codes = - Ast_derive_abstract.handle_tdcls_in_sig ~light:(kind = Light_abstract) rf - original_tdcls_new_attrs + Ast_derive_abstract.handle_tdcls_in_sig ~light:(kind = Light_abstract) + rf original_tdcls_new_attrs in Ast_signature.fuse_all ~loc (Sig.include_ ~loc @@ -87,8 +87,8 @@ let handle_tdcls_in_stru (self : Bs_ast_mapper.mapper) let kind = Ast_derive_abstract.is_abstract actions in if kind <> Not_abstract then let codes = - Ast_derive_abstract.handle_tdcls_in_str ~light:(kind = Light_abstract) rf - original_tdcls_new_attrs + Ast_derive_abstract.handle_tdcls_in_str ~light:(kind = Light_abstract) + rf original_tdcls_new_attrs in (* use [tdcls2] avoid nonterminating *) Ast_structure.fuse_all ~loc diff --git a/jscomp/gentype/Annotation.ml b/jscomp/gentype/Annotation.ml index 74587a1211..1e7e3c583d 100644 --- a/jscomp/gentype/Annotation.ml +++ b/jscomp/gentype/Annotation.ml @@ -136,15 +136,17 @@ let get_as_int attributes = | _ -> None let get_attribute_import_renaming attributes = - let attribute_import = attributes |> get_attribute_payload tag_is_gentype_import in + let attribute_import = + attributes |> get_attribute_payload tag_is_gentype_import + in let gentype_as_renaming = attributes |> get_gentype_as_renaming in match (attribute_import, gentype_as_renaming) with | Some (_, StringPayload import_string), _ -> (Some import_string, gentype_as_renaming) | ( Some ( _, - TuplePayload [StringPayload import_string; StringPayload rename_string] - ), + TuplePayload + [StringPayload import_string; StringPayload rename_string] ), _ ) -> (Some import_string, Some rename_string) | _ -> (None, gentype_as_renaming) @@ -169,7 +171,8 @@ let from_attributes ~(config : GenTypeConfig.t) ~loc (attributes : Typedtree.attributes) = let default = if config.everything then GenType else NoGenType in if has_attribute tag_is_gentype_opaque attributes then GenTypeOpaque - else if has_attribute (fun s -> tag_is_gentype s || tag_is_gentype_as s) attributes + else if + has_attribute (fun s -> tag_is_gentype s || tag_is_gentype_as s) attributes then ( (match attributes |> get_attribute_payload tag_is_gentype with | Some (_, UnrecognizedPayload) -> () @@ -226,8 +229,8 @@ and signature_item_check_annotation ~check_annotation | Tsig_include _ | Tsig_class _ | Tsig_class_type _ -> false -and signature_check_annotation ~check_annotation (signature : Typedtree.signature) - = +and signature_check_annotation ~check_annotation + (signature : Typedtree.signature) = signature.sig_items |> List.exists (signature_item_check_annotation ~check_annotation) @@ -283,8 +286,8 @@ and module_binding_check_annotation ~check_annotation mb_attributes |> check_annotation ~loc || mb_expr |> module_expr_check_annotation ~check_annotation -and structure_check_annotation ~check_annotation (structure : Typedtree.structure) - = +and structure_check_annotation ~check_annotation + (structure : Typedtree.structure) = structure.str_items |> List.exists (structure_item_check_annotation ~check_annotation) diff --git a/jscomp/gentype/Converter.ml b/jscomp/gentype/Converter.ml index f9b19509db..11a70fa3ae 100644 --- a/jscomp/gentype/Converter.ml +++ b/jscomp/gentype/Converter.ml @@ -10,9 +10,12 @@ let type_get_inlined ~config ~lookup_id ~type_name_is_interface type0 = Array (t_normalized, mutable_) | Dict _ -> normalized_ | Function ({arg_types; ret_type} as function_) -> - let arg_converted = arg_types |> List.map (arg_type_to_grouped_arg ~visited) in + let arg_converted = + arg_types |> List.map (arg_type_to_grouped_arg ~visited) + in let ret_normalized = ret_type |> visit ~visited in - Function {function_ with arg_types = arg_converted; ret_type = ret_normalized} + Function + {function_ with arg_types = arg_converted; ret_type = ret_normalized} | Ident {builtin = true} -> normalized_ | Ident {builtin = false; name; type_args} -> ( if visited |> StringSet.mem name then ( @@ -37,7 +40,9 @@ let type_get_inlined ~config ~lookup_id ~type_name_is_interface type0 = let inlined = type_ |> TypeVars.substitute ~f |> visit ~visited in inlined | exception Not_found -> - let type_args = type_args |> List.map (fun t -> t |> visit ~visited) in + let type_args = + type_args |> List.map (fun t -> t |> visit ~visited) + in Ident {builtin = false; name; type_args}) | Null t -> let t_normalized = t |> visit ~visited in diff --git a/jscomp/gentype/Dependencies.ml b/jscomp/gentype/Dependencies.ml index d0a1899ee6..e4049c6c00 100644 --- a/jscomp/gentype/Dependencies.ml +++ b/jscomp/gentype/Dependencies.ml @@ -21,15 +21,19 @@ let rec from_path1 ~config ~type_env (path : Path.t) = match type_env1 |> TypeEnv.expand_alias_to_external_module ~name with | Some dep -> (type_env2, dep) | None -> - let resolved_name = name |> TypeEnv.add_module_path ~type_env:type_env1 in + let resolved_name = + name |> TypeEnv.add_module_path ~type_env:type_env1 + in (type_env2, Internal resolved_name))) - | Pdot (Pident id, s, _pos) when id |> ScopedPackage.is_generated_module ~config - -> + | Pdot (Pident id, s, _pos) + when id |> ScopedPackage.is_generated_module ~config -> ( type_env, External (s |> ScopedPackage.add_generated_module ~generated_module:id) ) | Pdot (p, s, _pos) -> ( let type_env_from_p, dep = p |> from_path1 ~config ~type_env in - match type_env_from_p |> TypeEnv.expand_alias_to_external_module ~name:s with + match + type_env_from_p |> TypeEnv.expand_alias_to_external_module ~name:s + with | Some dep -> (type_env_from_p, dep) | None -> (type_env_from_p, Dot (dep, s))) | Papply _ -> diff --git a/jscomp/gentype/EmitJs.ml b/jscomp/gentype/EmitJs.ml index 87841567f9..7a72efa2e1 100644 --- a/jscomp/gentype/EmitJs.ml +++ b/jscomp/gentype/EmitJs.ml @@ -24,16 +24,18 @@ let require_module ~import ~env ~import_path module_name = | false -> {env with requires = requires_new} let create_export_type_map ~config ~file ~from_cmt_read_recursively - (type_declarations : CodeItem.type_declaration list) : CodeItem.export_type_map - = + (type_declarations : CodeItem.type_declaration list) : + CodeItem.export_type_map = if !Debug.code_items then Log_.item "Create Type Map for %s\n" file; let update_export_type_map (export_type_map : CodeItem.export_type_map) - (type_declaration : CodeItem.type_declaration) : CodeItem.export_type_map = + (type_declaration : CodeItem.type_declaration) : CodeItem.export_type_map + = let add_export_type ~annotation ({resolved_type_name; type_; type_vars} : CodeItem.export_type) = let annotation = match annotation with - | Annotation.NoGenType when from_cmt_read_recursively -> Annotation.GenType + | Annotation.NoGenType when from_cmt_read_recursively -> + Annotation.GenType | _ -> annotation in if !Debug.code_items then @@ -58,7 +60,8 @@ let create_export_type_map ~config ~file ~from_cmt_read_recursively in type_declarations |> List.fold_left update_export_type_map StringMap.empty -let code_item_to_string ~config ~type_name_is_interface (code_item : CodeItem.t) = +let code_item_to_string ~config ~type_name_is_interface (code_item : CodeItem.t) + = match code_item with | ExportValue {resolved_name; type_} -> "ExportValue" ^ " resolvedName:" @@ -69,8 +72,15 @@ let code_item_to_string ~config ~type_name_is_interface (code_item : CodeItem.t) "ImportValue " ^ (import_annotation.import_path |> ImportPath.dump) let emit_export_type ~emitters ~config ~type_name_is_interface - {CodeItem.loc; name_as; opaque; type_; type_vars; resolved_type_name; doc_string} - = + { + CodeItem.loc; + name_as; + opaque; + type_; + type_vars; + resolved_type_name; + doc_string; + } = let free_type_vars = TypeVars.free type_ in let is_gadt = free_type_vars |> List.exists (fun s -> not (List.mem s type_vars)) @@ -110,14 +120,15 @@ let type_name_is_interface ~(export_type_map : CodeItem.export_type_map) | {type_} -> type_ |> type_is_interface | exception Not_found -> false) -let emit_export_from_type_declaration ~config ~emitters ~env ~type_name_is_interface +let emit_export_from_type_declaration ~config ~emitters ~env + ~type_name_is_interface (export_from_type_declaration : CodeItem.export_from_type_declaration) = ( env, export_from_type_declaration.export_type |> emit_export_type ~emitters ~config ~type_name_is_interface ) -let emit_export_from_type_declarations ~config ~emitters ~env ~type_name_is_interface - export_from_type_declarations = +let emit_export_from_type_declarations ~config ~emitters ~env + ~type_name_is_interface export_from_type_declarations = export_from_type_declarations |> List.fold_left (fun (env, emitters) -> @@ -126,8 +137,8 @@ let emit_export_from_type_declarations ~config ~emitters ~env ~type_name_is_inte (env, emitters) let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name - ~output_file_relative ~resolver ~inline_one_level ~type_name_is_interface code_item - = + ~output_file_relative ~resolver ~inline_one_level ~type_name_is_interface + code_item = if !Debug.code_items then Log_.item "Code Item: %s\n" (code_item |> code_item_to_string ~config ~type_name_is_interface); @@ -147,16 +158,18 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name let value_name_not_checked = value_name ^ "NotChecked" in let emitters = import_path - |> EmitType.emit_import_value_as_early ~emitters ~name:first_name_in_path - ~name_as:(Some value_name_not_checked) + |> EmitType.emit_import_value_as_early ~emitters + ~name:first_name_in_path ~name_as:(Some value_name_not_checked) in (emitters, value_name_not_checked, env) in let type_ = match type_ with | Function - ({arg_types = [{a_type = Object (closed_flag, fields); a_name}]; ret_type} - as function_) + ({ + arg_types = [{a_type = Object (closed_flag, fields); a_name}]; + ret_type; + } as function_) when ret_type |> EmitType.is_type_function_component ~fields -> (* JSX V3 *) let fields = @@ -177,8 +190,10 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name in Function function_ | Function - ({arg_types = [{a_type = Ident {name} as props_type; a_name}]; ret_type} as - function_) + ({ + arg_types = [{a_type = Ident {name} as props_type; a_name}]; + ret_type; + } as function_) when Filename.check_suffix name "props" && ret_type |> EmitType.is_type_function_component ~fields:[] -> ( match inline_one_level props_type with @@ -187,7 +202,8 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name let fields = Ext_list.filter_map fields (fun (field : field) -> match field.name_js with - | "children" when field.type_ |> EmitType.is_type_react_element -> + | "children" when field.type_ |> EmitType.is_type_react_element + -> Some {field with type_ = EmitType.type_react_child} | "key" -> (* Filter out key, which is added to the props type definition in V4 *) @@ -239,8 +255,8 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name | false -> emitters in ({env with imported_value_or_component = true}, emitters) - | ExportValue {doc_string; module_access_path; original_name; resolved_name; type_} - -> + | ExportValue + {doc_string; module_access_path; original_name; resolved_name; type_} -> let resolved_name_str = ResolvedName.to_string resolved_name in let import_path = file_name @@ -315,8 +331,8 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name let fields = Ext_list.filter_map fields (fun (field : field) -> match field.name_js with - | "children" when field.type_ |> EmitType.is_type_react_element - -> + | "children" + when field.type_ |> EmitType.is_type_react_element -> Some {field with type_ = EmitType.type_react_child} | "key" -> (* Filter out key, which is added to the props type definition in V4 *) @@ -336,7 +352,8 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name in resolved_name - |> ExportModule.extend_export_modules ~doc_string ~module_items_emitter ~type_; + |> ExportModule.extend_export_modules ~doc_string ~module_items_emitter + ~type_; let emitters = match hook_type with | Some {props_type; resolved_type_name; type_vars} -> @@ -371,21 +388,24 @@ let emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name in (env_with_requires, emitters) -let emit_code_items ~config ~output_file_relative ~emitters ~module_items_emitter ~env - ~file_name ~resolver ~type_name_is_interface ~inline_one_level code_items = +let emit_code_items ~config ~output_file_relative ~emitters + ~module_items_emitter ~env ~file_name ~resolver ~type_name_is_interface + ~inline_one_level code_items = code_items |> List.fold_left (fun (env, emitters) -> emit_code_item ~config ~emitters ~module_items_emitter ~env ~file_name - ~output_file_relative ~resolver ~inline_one_level ~type_name_is_interface) + ~output_file_relative ~resolver ~inline_one_level + ~type_name_is_interface) (env, emitters) -let emit_requires ~imported_value_or_component ~early ~config ~requires emitters = +let emit_requires ~imported_value_or_component ~early ~config ~requires emitters + = Config.ModuleNameMap.fold (fun module_name import_path emitters -> import_path - |> EmitType.emit_require ~imported_value_or_component ~early ~emitters ~config - ~module_name) + |> EmitType.emit_require ~imported_value_or_component ~early ~emitters + ~config ~module_name) requires emitters let type_get_inlined ~config ~export_type_map type_ = @@ -396,8 +416,9 @@ let type_get_inlined ~config ~export_type_map type_ = (** Read the cmt file referenced in an import type, and recursively for the import types obtained from reading the cmt file. *) -let rec read_cmt_files_recursively ~config ~env ~input_cmt_translate_type_declarations - ~output_file_relative ~resolver {CodeItem.type_name; as_type_name; import_path} = +let rec read_cmt_files_recursively ~config ~env + ~input_cmt_translate_type_declarations ~output_file_relative ~resolver + {CodeItem.type_name; as_type_name; import_path} = let update_type_map_from_other_files ~as_type ~export_type_map_from_cmt env = match export_type_map_from_cmt |> StringMap.find type_name with | (export_type_item : CodeItem.export_type_item) -> @@ -439,7 +460,8 @@ let rec read_cmt_files_recursively ~config ~env ~input_cmt_translate_type_declar |> (Filename.chop_extension [@doesNotRaise])) in let cmt_to_export_type_map = - env.cmt_to_export_type_map |> StringMap.add cmt_file export_type_map_from_cmt + env.cmt_to_export_type_map + |> StringMap.add cmt_file export_type_map_from_cmt in let env = {env with cmt_to_export_type_map} @@ -461,28 +483,31 @@ let rec read_cmt_files_recursively ~config ~env ~input_cmt_translate_type_declar env) | _ -> env -let emit_import_type ~config ~emitters ~env ~input_cmt_translate_type_declarations - ~output_file_relative ~resolver ~type_name_is_interface +let emit_import_type ~config ~emitters ~env + ~input_cmt_translate_type_declarations ~output_file_relative ~resolver + ~type_name_is_interface ({CodeItem.type_name; as_type_name; import_path} as import_type) = let env = import_type - |> read_cmt_files_recursively ~config ~env ~input_cmt_translate_type_declarations - ~output_file_relative ~resolver + |> read_cmt_files_recursively ~config ~env + ~input_cmt_translate_type_declarations ~output_file_relative ~resolver in let emitters = EmitType.emit_import_type_as ~emitters ~config ~type_name ~as_type_name - ~type_name_is_interface:(type_name_is_interface ~env) ~import_path + ~type_name_is_interface:(type_name_is_interface ~env) + ~import_path in (env, emitters) -let emit_import_types ~config ~emitters ~env ~input_cmt_translate_type_declarations - ~output_file_relative ~resolver ~type_name_is_interface import_types = +let emit_import_types ~config ~emitters ~env + ~input_cmt_translate_type_declarations ~output_file_relative ~resolver + ~type_name_is_interface import_types = import_types |> List.fold_left (fun (env, emitters) -> emit_import_type ~config ~emitters ~env - ~input_cmt_translate_type_declarations ~output_file_relative ~resolver - ~type_name_is_interface) + ~input_cmt_translate_type_declarations ~output_file_relative + ~resolver ~type_name_is_interface) (env, emitters) let get_annotated_typed_declarations ~annotated_set type_declarations = @@ -491,7 +516,8 @@ let get_annotated_typed_declarations ~annotated_set type_declarations = let name_in_annotated_set = annotated_set |> StringSet.mem - (type_declaration.CodeItem.export_from_type_declaration.export_type + (type_declaration.CodeItem.export_from_type_declaration + .export_type .resolved_type_name |> ResolvedName.to_string) in if name_in_annotated_set then @@ -506,11 +532,12 @@ let get_annotated_typed_declarations ~annotated_set type_declarations = else type_declaration) |> List.filter (fun - ({export_from_type_declaration = {annotation}} : CodeItem.type_declaration) + ({export_from_type_declaration = {annotation}} : + CodeItem.type_declaration) -> annotation <> NoGenType) -let propagate_annotation_to_sub_types ~code_items (type_map : CodeItem.export_type_map) - = +let propagate_annotation_to_sub_types ~code_items + (type_map : CodeItem.export_type_map) = let annotated_set = ref StringSet.empty in let initial_annotated_types = type_map |> StringMap.bindings @@ -574,8 +601,9 @@ let propagate_annotation_to_sub_types ~code_items (type_map : CodeItem.export_ty in (new_type_map, !annotated_set) -let emit_translation_as_string ~config ~file_name ~input_cmt_translate_type_declarations - ~output_file_relative ~resolver (translation : Translation.t) = +let emit_translation_as_string ~config ~file_name + ~input_cmt_translate_type_declarations ~output_file_relative ~resolver + (translation : Translation.t) = let initial_env = { requires = Config.ModuleNameMap.empty; @@ -593,7 +621,8 @@ let emit_translation_as_string ~config ~file_name ~input_cmt_translate_type_decl |> propagate_annotation_to_sub_types ~code_items:translation.code_items in let annotated_type_declarations = - translation.type_declarations |> get_annotated_typed_declarations ~annotated_set + translation.type_declarations + |> get_annotated_typed_declarations ~annotated_set in let import_types_from_type_declarations = annotated_type_declarations @@ -621,8 +650,9 @@ let emit_translation_as_string ~config ~file_name ~input_cmt_translate_type_decl (* imports from type declarations go first to build up type tables *) import_types_from_type_declarations @ translation.import_types |> List.sort_uniq Translation.import_type_compare - |> emit_import_types ~config ~emitters ~env ~input_cmt_translate_type_declarations - ~output_file_relative ~resolver ~type_name_is_interface + |> emit_import_types ~config ~emitters ~env + ~input_cmt_translate_type_declarations ~output_file_relative ~resolver + ~type_name_is_interface in let env, emitters = export_from_type_declarations @@ -675,6 +705,7 @@ let emit_translation_as_string ~config ~file_name ~input_cmt_translate_type_decl emitters |> emit_requires ~imported_value_or_component:false ~early:true ~config ~requires:final_env.requires_early - |> emit_requires ~imported_value_or_component:final_env.imported_value_or_component + |> emit_requires + ~imported_value_or_component:final_env.imported_value_or_component ~early:false ~config ~requires:final_env.requires |> Emitters.to_string ~separator:"\n\n" diff --git a/jscomp/gentype/EmitType.ml b/jscomp/gentype/EmitType.ml index 1920efd238..54e5777b8b 100644 --- a/jscomp/gentype/EmitType.ml +++ b/jscomp/gentype/EmitType.ml @@ -60,8 +60,8 @@ let is_type_react_ref ~fields = let is_type_function_component ~fields type_ = type_ |> is_type_react_element && not (is_type_react_ref ~fields) -let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interface - ~in_fun_type type0 = +let rec render_type ~(config : Config.t) ?(indent = None) + ~type_name_is_interface ~in_fun_type type0 = match type0 with | Array (t, array_kind) -> let type_is_simple = @@ -70,7 +70,8 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac | _ -> false in if type_is_simple && array_kind = Mutable then - (t |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ "[]" + (t |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) + ^ "[]" else let array_name = match array_kind = Mutable with @@ -85,7 +86,11 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac ^ (type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ "}" | Function - {arg_types = [{a_type = Object (closed_flag, fields)}]; ret_type; type_vars} + { + arg_types = [{a_type = Object (closed_flag, fields)}]; + ret_type; + type_vars; + } when ret_type |> is_type_function_component ~fields -> let fields = fields @@ -101,18 +106,21 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac let component_type = type_react_component ~props_type:(Object (closed_flag, fields)) in - component_type |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type + component_type + |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type | Function {arg_types; ret_type; type_vars} -> - render_fun_type ~config ~indent ~in_fun_type ~type_name_is_interface ~type_vars - arg_types ret_type + render_fun_type ~config ~indent ~in_fun_type ~type_name_is_interface + ~type_vars arg_types ret_type | Object (_, fields) -> let indent1 = fields |> Indent.heuristic_fields ~indent in fields - |> render_fields ~config ~indent:indent1 ~in_fun_type ~type_name_is_interface + |> render_fields ~config ~indent:indent1 ~in_fun_type + ~type_name_is_interface | Ident {builtin; name; type_args} -> let name = name |> sanitize_type_name in (match - (not builtin) && config.export_interfaces && name |> type_name_is_interface + (not builtin) && config.export_interfaces + && name |> type_name_is_interface with | true -> name |> interface_name ~config | false -> name) @@ -120,7 +128,8 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac ~type_vars: (type_args |> List.map - (render_type ~config ~indent ~type_name_is_interface ~in_fun_type)) + (render_type ~config ~indent ~type_name_is_interface ~in_fun_type) + ) | Null type_ -> "(null | " ^ (type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) @@ -133,7 +142,8 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac in "(null | undefined | " ^ use_parens - (type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) + (type_ + |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ ")" | Option type_ -> let use_parens x = @@ -143,7 +153,8 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac in "(undefined | " ^ use_parens - (type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) + (type_ + |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ ")" | Promise type_ -> "Promise" ^ "<" @@ -152,7 +163,8 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac | Tuple inner_types -> "[" ^ (inner_types - |> List.map (render_type ~config ~indent ~type_name_is_interface ~in_fun_type) + |> List.map + (render_type ~config ~indent ~type_name_is_interface ~in_fun_type) |> String.concat ", ") ^ "]" | TypeVar s -> s @@ -160,7 +172,8 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac let inherits_rendered = inherits |> List.map (fun type_ -> - type_ |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) + type_ + |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) in let no_payloads_rendered = no_payloads |> List.map label_js_to_string in let field ~name value = @@ -173,13 +186,16 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac } in let fields fields = - fields |> render_fields ~config ~indent ~in_fun_type ~type_name_is_interface + fields + |> render_fields ~config ~indent ~in_fun_type ~type_name_is_interface in let payloads_rendered = payloads |> List.map (fun {case; t = type_} -> let render t = - t |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type + t + |> render_type ~config ~indent ~type_name_is_interface + ~in_fun_type in let tag_field = case |> label_js_to_string @@ -221,7 +237,9 @@ let rec render_type ~(config : Config.t) ?(indent = None) ~type_name_is_interfac in flds |> fields) in - let rendered = inherits_rendered @ no_payloads_rendered @ payloads_rendered in + let rendered = + inherits_rendered @ no_payloads_rendered @ payloads_rendered + in let indent1 = rendered |> Indent.heuristic_variants ~indent in (match indent1 = None with | true -> "" @@ -271,14 +289,15 @@ and render_fields ~config ~indent ~in_fun_type ~type_name_is_interface fields = let rendered_fields = fields |> List.map - (render_field ~config ~indent:indent1 ~type_name_is_interface ~in_fun_type) + (render_field ~config ~indent:indent1 ~type_name_is_interface + ~in_fun_type) in ("{" ^ space) ^ String.concat "; " rendered_fields ^ Indent.break ~indent ^ space ^ "}" -and render_fun_type ~config ~indent ~in_fun_type ~type_name_is_interface ~type_vars - arg_types ret_type = +and render_fun_type ~config ~indent ~in_fun_type ~type_name_is_interface + ~type_vars arg_types ret_type = (match in_fun_type with | true -> "(" | false -> "") @@ -295,11 +314,12 @@ and render_fun_type ~config ~indent ~in_fun_type ~type_name_is_interface ~type_v in parameter_name ^ (a_type - |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type:true - )) + |> render_type ~config ~indent ~type_name_is_interface + ~in_fun_type:true)) arg_types) ^ ") => " - ^ (ret_type |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) + ^ (ret_type + |> render_type ~config ~indent ~type_name_is_interface ~in_fun_type) ^ match in_fun_type with | true -> ")" @@ -309,14 +329,14 @@ let type_to_string ~config ~type_name_is_interface type_ = type_ |> render_type ~config ~type_name_is_interface ~in_fun_type:false let emit_export_const ~early ?(comment = "") ~config - ?(doc_string = DocString.empty) ~emitters ~name ~type_ ~type_name_is_interface - line = + ?(doc_string = DocString.empty) ~emitters ~name ~type_ + ~type_name_is_interface line = let type_string = type_ |> type_to_string ~config ~type_name_is_interface in (match comment = "" with | true -> comment | false -> "// " ^ comment ^ "\n") - ^ DocString.render doc_string ^ "export const " ^ name ^ ": " ^ type_string - ^ " = " ^ line ^ " as any;" + ^ DocString.render doc_string + ^ "export const " ^ name ^ ": " ^ type_string ^ " = " ^ line ^ " as any;" |> (match early with | true -> Emitters.export_early | false -> Emitters.export) @@ -351,16 +371,17 @@ let emit_export_type ~(config : Config.t) ~emitters ~name_as ~opaque ~type_ | true -> "any" | false -> type_vars |> String.concat " | " in - doc_string ^ "export abstract class " ^ resolved_type_name ^ type_params_string - ^ " { protected opaque!: " ^ type_of_opaque_field + doc_string ^ "export abstract class " ^ resolved_type_name + ^ type_params_string ^ " { protected opaque!: " ^ type_of_opaque_field ^ " }; /* simulate opaque types */" ^ export_name_as |> Emitters.export ~emitters else (if is_interface && config.export_interfaces then - doc_string ^ "export interface " ^ resolved_type_name ^ type_params_string - ^ " " + doc_string ^ "export interface " ^ resolved_type_name + ^ type_params_string ^ " " else - doc_string ^ "export type " ^ resolved_type_name ^ type_params_string ^ " = ") + doc_string ^ "export type " ^ resolved_type_name ^ type_params_string + ^ " = ") ^ (match type_ with | _ -> type_ |> type_to_string ~config ~type_name_is_interface) ^ ";" ^ export_name_as @@ -376,16 +397,18 @@ let emit_import_value_as_early ~emitters ~name ~name_as import_path = ^ "';" |> Emitters.require_early ~emitters -let emit_require ~imported_value_or_component ~early ~emitters ~(config : Config.t) - ~module_name import_path = +let emit_require ~imported_value_or_component ~early ~emitters + ~(config : Config.t) ~module_name import_path = let module_name_string = ModuleName.to_string module_name in let import_path_string = ImportPath.emit import_path in let output = match config.module_ with | ESModule when not imported_value_or_component -> - "import * as " ^ module_name_string ^ " from '" ^ import_path_string ^ "';" + "import * as " ^ module_name_string ^ " from '" ^ import_path_string + ^ "';" | _ -> - "const " ^ module_name_string ^ " = require('" ^ import_path_string ^ "');" + "const " ^ module_name_string ^ " = require('" ^ import_path_string + ^ "');" in output |> (match early with diff --git a/jscomp/gentype/Emitters.ml b/jscomp/gentype/Emitters.ml index 9002738449..0ae8820655 100644 --- a/jscomp/gentype/Emitters.ml +++ b/jscomp/gentype/Emitters.ml @@ -30,7 +30,10 @@ let export_early ~emitters s = } let require ~emitters s = - {emitters with require_emitter = s |> string ~emitter:emitters.require_emitter} + { + emitters with + require_emitter = s |> string ~emitter:emitters.require_emitter; + } let import ~emitters s = {emitters with import_emitter = s |> string ~emitter:emitters.import_emitter} diff --git a/jscomp/gentype/ExportModule.ml b/jscomp/gentype/ExportModule.ml index e2d5534454..eb3ce62954 100644 --- a/jscomp/gentype/ExportModule.ml +++ b/jscomp/gentype/ExportModule.ml @@ -8,7 +8,11 @@ and export_module_value = type export_module_items = (string, export_module_item) Hashtbl.t -type types = {type_for_value: type_; type_for_type: type_; doc_string: DocString.t} +type types = { + type_for_value: type_; + type_for_type: type_; + doc_string: DocString.t; +} type field_info = {field_for_value: field; field_for_type: field} @@ -17,7 +21,9 @@ let rec export_module_value_to_type ~config export_module_value = | S {name; type_; doc_string} -> {type_for_value = ident name; type_for_type = type_; doc_string} | M {export_module_item} -> - let fields_info = export_module_item |> export_module_item_to_fields ~config in + let fields_info = + export_module_item |> export_module_item_to_fields ~config + in let fields_for_value = fields_info |> List.map (fun {field_for_value} -> field_for_value) in @@ -61,7 +67,8 @@ let rec extend_export_module_item ~doc_string x | field_name :: rest -> let inner_export_module_item = match Hashtbl.find export_module_item field_name with - | M {export_module_item = inner_export_module_item} -> inner_export_module_item + | M {export_module_item = inner_export_module_item} -> + inner_export_module_item | S _ -> assert false | exception Not_found -> let inner_export_module_item = Hashtbl.create 1 in @@ -70,8 +77,8 @@ let rec extend_export_module_item ~doc_string x inner_export_module_item in rest - |> extend_export_module_item ~doc_string ~export_module_item:inner_export_module_item - ~value_name ~type_ + |> extend_export_module_item ~doc_string + ~export_module_item:inner_export_module_item ~value_name ~type_ let extend_export_module_items x ~doc_string ~(export_module_items : export_module_items) ~type_ ~value_name = @@ -88,7 +95,8 @@ let extend_export_module_items x ~doc_string export_module_item in rest - |> extend_export_module_item ~doc_string ~export_module_item ~type_ ~value_name + |> extend_export_module_item ~doc_string ~export_module_item ~type_ + ~value_name let create_module_items_emitter = (fun () -> Hashtbl.create 1 : unit -> export_module_items) @@ -111,13 +119,13 @@ let emit_all_module_items ~config ~emitters ~file_name |> ModuleName.to_string in emitted_module_item - |> EmitType.emit_export_const ~doc_string ~early:false ~config ~emitters - ~name:module_name ~type_:type_for_type ~type_name_is_interface:(fun _ -> - false)) + |> EmitType.emit_export_const ~doc_string ~early:false ~config + ~emitters ~name:module_name ~type_:type_for_type + ~type_name_is_interface:(fun _ -> false)) export_module_items -let extend_export_modules ~(module_items_emitter : export_module_items) ~doc_string - ~type_ resolved_name = +let extend_export_modules ~(module_items_emitter : export_module_items) + ~doc_string ~type_ resolved_name = resolved_name |> ResolvedName.to_list |> extend_export_module_items ~export_module_items:module_items_emitter ~type_ ~doc_string diff --git a/jscomp/gentype/GenIdent.ml b/jscomp/gentype/GenIdent.ml index 7a7ef18f9a..5cdf1fdb7a 100644 --- a/jscomp/gentype/GenIdent.ml +++ b/jscomp/gentype/GenIdent.ml @@ -10,12 +10,14 @@ type type_vars_gen = { mutable type_name_counter: int; } -let create_type_vars_gen () = {type_name_map = IntMap.empty; type_name_counter = 0} +let create_type_vars_gen () = + {type_name_map = IntMap.empty; type_name_counter = 0} let js_type_name_for_anonymous_type_id ~type_vars_gen id = try type_vars_gen.type_name_map |> IntMap.find id with Not_found -> type_vars_gen.type_name_counter <- type_vars_gen.type_name_counter + 1; let name = "T" ^ string_of_int type_vars_gen.type_name_counter in - type_vars_gen.type_name_map <- type_vars_gen.type_name_map |> IntMap.add id name; + type_vars_gen.type_name_map <- + type_vars_gen.type_name_map |> IntMap.add id name; name diff --git a/jscomp/gentype/GenTypeCommon.ml b/jscomp/gentype/GenTypeCommon.ml index e6d14369a1..5839f447b0 100644 --- a/jscomp/gentype/GenTypeCommon.ml +++ b/jscomp/gentype/GenTypeCommon.ml @@ -89,7 +89,11 @@ and field = { doc_string: DocString.t; } -and function_ = {arg_types: arg_type list; ret_type: type_; type_vars: string list} +and function_ = { + arg_types: arg_type list; + ret_type: type_; + type_vars: string list; +} and ident = {builtin: bool; name: string; type_args: type_ list} diff --git a/jscomp/gentype/GenTypeConfig.ml b/jscomp/gentype/GenTypeConfig.ml index 11046212ba..3c0744b5d6 100644 --- a/jscomp/gentype/GenTypeConfig.ml +++ b/jscomp/gentype/GenTypeConfig.ml @@ -56,7 +56,8 @@ let bs_platform_lib ~config = | ESModule -> config.platform_lib ^ "/lib/es6" | CommonJS -> config.platform_lib ^ "/lib/js" -let get_bs_curry_path ~config = Filename.concat (bs_platform_lib ~config) "curry.js" +let get_bs_curry_path ~config = + Filename.concat (bs_platform_lib ~config) "curry.js" type map = Ext_json_types.t Map_string.t @@ -127,7 +128,9 @@ let read_config ~get_config_file ~namespace = in let parse_config ~bsconf ~gtconf = let module_string = gtconf |> get_string_option "module" in - let module_resolution_string = gtconf |> get_string_option "moduleResolution" in + let module_resolution_string = + gtconf |> get_string_option "moduleResolution" + in let export_interfaces_bool = gtconf |> get_bool "exportInterfaces" in let generated_file_extension_string_option = gtconf |> get_string_option "generatedFileExtension" @@ -139,7 +142,9 @@ let read_config ~get_config_file ~namespace = let module_name = (from_module |> ModuleName.from_string_unsafe : ModuleName.t) in - let shim_module_name = to_module |> ModuleName.from_string_unsafe in + let shim_module_name = + to_module |> ModuleName.from_string_unsafe + in ModuleNameMap.add module_name shim_module_name map) ModuleNameMap.empty in diff --git a/jscomp/gentype/GenTypeMain.ml b/jscomp/gentype/GenTypeMain.ml index f29c97b2ef..fc5091d6d8 100644 --- a/jscomp/gentype/GenTypeMain.ml +++ b/jscomp/gentype/GenTypeMain.ml @@ -23,8 +23,8 @@ let signature_item_is_declaration signature_item = | Typedtree.Tsig_type _ | Tsig_modtype _ -> true | _ -> false -let input_cmt_translate_type_declarations ~config ~output_file_relative ~resolver - input_cmt : CodeItem.translation = +let input_cmt_translate_type_declarations ~config ~output_file_relative + ~resolver input_cmt : CodeItem.translation = let {Cmt_format.cmt_annots} = input_cmt in let type_env = TypeEnv.root () in let translations = @@ -50,8 +50,8 @@ let input_cmt_translate_type_declarations ~config ~output_file_relative ~resolve translations |> Translation.combine |> Translation.add_type_declarations_from_module_equations ~type_env -let translate_c_m_t ~config ~output_file_relative ~resolver input_cmt : Translation.t - = +let translate_c_m_t ~config ~output_file_relative ~resolver input_cmt : + Translation.t = let {Cmt_format.cmt_annots} = input_cmt in let type_env = TypeEnv.root () in let translations = @@ -69,12 +69,12 @@ let translate_c_m_t ~config ~output_file_relative ~resolver input_cmt : Translat translations |> Translation.combine |> Translation.add_type_declarations_from_module_equations ~type_env -let emit_translation ~config ~file_name ~output_file ~output_file_relative ~resolver - ~source_file translation = +let emit_translation ~config ~file_name ~output_file ~output_file_relative + ~resolver ~source_file translation = let code_text = translation - |> EmitJs.emit_translation_as_string ~config ~file_name ~output_file_relative - ~resolver ~input_cmt_translate_type_declarations + |> EmitJs.emit_translation_as_string ~config ~file_name + ~output_file_relative ~resolver ~input_cmt_translate_type_declarations in let file_contents = EmitType.file_header ~source_file:(Filename.basename source_file) @@ -100,8 +100,8 @@ let process_cmt_file cmt = let file_name = cmt |> Paths.get_module_name in let is_interface = Filename.check_suffix cmt_file ".cmti" in let resolver = - ModuleResolver.create_lazy_resolver ~config ~extensions:[".res"; ".shim.ts"] - ~exclude_file:(fun fname -> + ModuleResolver.create_lazy_resolver ~config + ~extensions:[".res"; ".shim.ts"] ~exclude_file:(fun fname -> fname = "React.res" || fname = "ReasonReact.res") in let input_cmt, has_gentype_annotations = diff --git a/jscomp/gentype/ImportPath.ml b/jscomp/gentype/ImportPath.ml index 5cc7929297..dcc8d94983 100644 --- a/jscomp/gentype/ImportPath.ml +++ b/jscomp/gentype/ImportPath.ml @@ -6,7 +6,8 @@ let bs_curry_path ~config = ("", Config.get_bs_curry_path ~config) let from_module ~dir ~import_extension module_name = let with_no_path = - (module_name |> ModuleName.to_string |> ScopedPackage.remove_generated_module) + (module_name |> ModuleName.to_string + |> ScopedPackage.remove_generated_module) ^ import_extension in (dir, with_no_path) @@ -20,7 +21,9 @@ let dump (dir, s) = NodeFilename.concat dir s let to_cmt ~(config : Config.t) ~output_file_relative (dir, s) = let open Filename in - concat (output_file_relative |> dirname) ((dir, s) |> chop_extension_safe |> dump) + concat + (output_file_relative |> dirname) + ((dir, s) |> chop_extension_safe |> dump) ^ (match config.namespace with | None -> "" | Some name -> "-" ^ name) diff --git a/jscomp/gentype/ModuleResolver.ml b/jscomp/gentype/ModuleResolver.ml index f876b143a9..3adba146ee 100644 --- a/jscomp/gentype/ModuleResolver.ml +++ b/jscomp/gentype/ModuleResolver.ml @@ -191,7 +191,8 @@ let create_lazy_resolver ~config ~extensions ~exclude_file = module_name |> find ~bs_dependencies:false ~map:module_name_map with | None when use_bs_dependencies -> - module_name |> find ~bs_dependencies:true ~map:bs_dependencies_file_map + module_name + |> find ~bs_dependencies:true ~map:bs_dependencies_file_map | res -> res); } @@ -206,7 +207,9 @@ let resolve_module ~(config : Config.t) ~import_extension ~output_file_relative (* e.g. src if we're generating src/File.bs.js *) Filename.dirname output_file_relative in - let output_file_absolute_dir = config.project_root +++ output_file_relative_dir in + let output_file_absolute_dir = + config.project_root +++ output_file_relative_dir + in let module_name_res_file = (* Check if the module is in the same directory as the file being generated. So if e.g. project_root/src/ModuleName.res exists. *) @@ -248,9 +251,11 @@ let resolve_module ~(config : Config.t) ~import_extension ~output_file_relative (match case = Uppercase with | true -> module_name | false -> module_name |> ModuleName.uncapitalize) - |> ImportPath.from_module ~dir:from_output_dir_to_module_dir ~import_extension + |> ImportPath.from_module ~dir:from_output_dir_to_module_dir + ~import_extension -let resolve_generated_module ~config ~output_file_relative ~resolver module_name = +let resolve_generated_module ~config ~output_file_relative ~resolver module_name + = if !Debug.module_resolution then Log_.item "Resolve Generated Module: %s\n" (module_name |> ModuleName.to_string); @@ -264,15 +269,17 @@ let resolve_generated_module ~config ~output_file_relative ~resolver module_name import_path (** Returns the path to import a given Reason module name. *) -let import_path_for_reason_module_name ~(config : Config.t) ~output_file_relative - ~resolver module_name = +let import_path_for_reason_module_name ~(config : Config.t) + ~output_file_relative ~resolver module_name = if !Debug.module_resolution then Log_.item "Resolve Reason Module: %s\n" (module_name |> ModuleName.to_string); match config.shims_map |> ModuleNameMap.find module_name with | shim_module_name -> if !Debug.module_resolution then Log_.item "ShimModuleName: %s\n" (shim_module_name |> ModuleName.to_string); - let import_extension = ModuleExtension.shim_ts_output_file_extension ~config in + let import_extension = + ModuleExtension.shim_ts_output_file_extension ~config + in let import_path = resolve_module ~config ~import_extension ~output_file_relative ~resolver ~use_bs_dependencies:false shim_module_name @@ -281,4 +288,5 @@ let import_path_for_reason_module_name ~(config : Config.t) ~output_file_relativ Log_.item "Import Path: %s\n" (import_path |> ImportPath.dump); import_path | exception Not_found -> - module_name |> resolve_generated_module ~config ~output_file_relative ~resolver + module_name + |> resolve_generated_module ~config ~output_file_relative ~resolver diff --git a/jscomp/gentype/Paths.ml b/jscomp/gentype/Paths.ml index f7018312f6..5aa23aaada 100644 --- a/jscomp/gentype/Paths.ml +++ b/jscomp/gentype/Paths.ml @@ -9,7 +9,8 @@ let handle_namespace cmt = | exception Not_found -> s in let no_dir = Filename.basename cmt = cmt in - if no_dir then cmt |> (Filename.chop_extension [@doesNotRaise]) |> cut_after_dash + if no_dir then + cmt |> (Filename.chop_extension [@doesNotRaise]) |> cut_after_dash else let dir = cmt |> Filename.dirname in let base = diff --git a/jscomp/gentype/ResolvedName.ml b/jscomp/gentype/ResolvedName.ml index cf56010e44..79e737d35e 100644 --- a/jscomp/gentype/ResolvedName.ml +++ b/jscomp/gentype/ResolvedName.ml @@ -48,7 +48,8 @@ let rec apply_equations_to_elements ~(eqs : eq list) ~seen (elements : t list) : match new_equations = [] with | true -> new_equations | false -> - new_equations @ (new_elements |> apply_equations_to_elements ~eqs ~seen:new_seen) + new_equations + @ (new_elements |> apply_equations_to_elements ~eqs ~seen:new_seen) (* Apply equations of the form e.g. X.Y = A from the alias: module A = X.Y. Return a list of equations on types. diff --git a/jscomp/gentype/Runtime.ml b/jscomp/gentype/Runtime.ml index 7fb3279290..e8b14e21e9 100644 --- a/jscomp/gentype/Runtime.ml +++ b/jscomp/gentype/Runtime.ml @@ -1,5 +1,7 @@ type module_item = string -type module_access_path = Root of string | Dot of module_access_path * module_item +type module_access_path = + | Root of string + | Dot of module_access_path * module_item let new_module_item ~name = name @@ -7,7 +9,9 @@ let rec emit_module_access_path ~config module_access_path = match module_access_path with | Root s -> s | Dot (p, module_item) -> - p |> emit_module_access_path ~config |> EmitText.field_access ~label:module_item + p + |> emit_module_access_path ~config + |> EmitText.field_access ~label:module_item let js_variant_tag ~polymorphic ~tag = match polymorphic with @@ -31,6 +35,7 @@ let is_mutable_object_field name = (** Mutable fields, i.e. fields annotated "[@set]" are represented as extra fields called "fieldName#=" preceding the normal field. *) -let check_mutable_object_field ~previous_name ~name = previous_name = name ^ "#=" +let check_mutable_object_field ~previous_name ~name = + previous_name = name ^ "#=" let default = "$$default" diff --git a/jscomp/gentype/Runtime.mli b/jscomp/gentype/Runtime.mli index c462e9b7c9..d220a0a7b5 100644 --- a/jscomp/gentype/Runtime.mli +++ b/jscomp/gentype/Runtime.mli @@ -1,7 +1,9 @@ open GenTypeCommon type module_item -type module_access_path = Root of string | Dot of module_access_path * module_item +type module_access_path = + | Root of string + | Dot of module_access_path * module_item val check_mutable_object_field : previous_name:string -> name:string -> bool val default : string diff --git a/jscomp/gentype/TranslateCoreType.ml b/jscomp/gentype/TranslateCoreType.ml index 2de07f172d..f9e9ef7174 100644 --- a/jscomp/gentype/TranslateCoreType.ml +++ b/jscomp/gentype/TranslateCoreType.ml @@ -1,8 +1,8 @@ open GenTypeCommon open! TranslateTypeExprFromTypes -let remove_option ~(label : Asttypes.arg_label) (core_type : Typedtree.core_type) - = +let remove_option ~(label : Asttypes.arg_label) + (core_type : Typedtree.core_type) = match (core_type.ctyp_desc, label) with | Ttyp_constr (Path.Pident id, _, [t]), Optional lbl when Ident.name id = "option" -> @@ -48,8 +48,9 @@ let process_variant row_fields = in row_fields |> loop ~no_payloads:[] ~payloads:[] ~inherits:[] -let rec translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependencies - ~type_env ~rev_arg_deps ~rev_args (core_type : Typedtree.core_type) = +let rec translate_arrow_type ~config ~type_vars_gen + ~no_function_return_dependencies ~type_env ~rev_arg_deps ~rev_args + (core_type : Typedtree.core_type) = match core_type.ctyp_desc with | Ttyp_arrow (Nolabel, core_type1, core_type2) -> let {dependencies; type_} = @@ -58,8 +59,8 @@ let rec translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependen in let next_rev_deps = List.rev_append dependencies rev_arg_deps in core_type2 - |> translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependencies - ~type_env ~rev_arg_deps:next_rev_deps + |> translate_arrow_type ~config ~type_vars_gen + ~no_function_return_dependencies ~type_env ~rev_arg_deps:next_rev_deps ~rev_args:((Nolabel, type_) :: rev_args) | Ttyp_arrow (((Labelled lbl | Optional lbl) as label), core_type1, core_type2) -> ( @@ -75,8 +76,9 @@ let rec translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependen in let next_rev_deps = List.rev_append dependencies rev_arg_deps in core_type2 - |> translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependencies - ~type_env ~rev_arg_deps:next_rev_deps + |> translate_arrow_type ~config ~type_vars_gen + ~no_function_return_dependencies ~type_env + ~rev_arg_deps:next_rev_deps ~rev_args: (( Label (match as_label = "" with @@ -90,8 +92,9 @@ let rec translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependen in let next_rev_deps = List.rev_append dependencies rev_arg_deps in core_type2 - |> translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependencies - ~type_env ~rev_arg_deps:next_rev_deps + |> translate_arrow_type ~config ~type_vars_gen + ~no_function_return_dependencies ~type_env + ~rev_arg_deps:next_rev_deps ~rev_args:((OptLabel lbl, type1) :: rev_args)) | _ -> let {dependencies; type_ = ret_type} = @@ -137,21 +140,24 @@ and translateCoreType_ ~config ~type_vars_gen let params_translation = type_params |> translateCoreTypes_ ~config ~type_vars_gen ~type_env in - TranslateTypeExprFromTypes.translate_constr ~config ~params_translation ~path - ~type_env + TranslateTypeExprFromTypes.translate_constr ~config ~params_translation + ~path ~type_env | Ttyp_poly (_, t) -> t - |> translateCoreType_ ~config ~type_vars_gen ~no_function_return_dependencies - ~type_env + |> translateCoreType_ ~config ~type_vars_gen + ~no_function_return_dependencies ~type_env | Ttyp_arrow _ -> core_type - |> translate_arrow_type ~config ~type_vars_gen ~no_function_return_dependencies - ~type_env ~rev_arg_deps:[] ~rev_args:[] + |> translate_arrow_type ~config ~type_vars_gen + ~no_function_return_dependencies ~type_env ~rev_arg_deps:[] + ~rev_args:[] | Ttyp_tuple list_exp -> let inner_types_translation = list_exp |> translateCoreTypes_ ~config ~type_vars_gen ~type_env in - let inner_types = inner_types_translation |> List.map (fun {type_} -> type_) in + let inner_types = + inner_types_translation |> List.map (fun {type_} -> type_) + in let inner_types_deps = inner_types_translation |> List.map (fun {dependencies} -> dependencies) @@ -168,7 +174,8 @@ and translateCoreType_ ~config ~type_vars_gen |> Annotation.has_attribute Annotation.tag_is_string in let as_int = - core_type.ctyp_attributes |> Annotation.has_attribute Annotation.tag_is_int + core_type.ctyp_attributes + |> Annotation.has_attribute Annotation.tag_is_int in let last_bs_int = ref (-1) in let no_payloads = @@ -199,7 +206,8 @@ and translateCoreType_ ~config ~type_vars_gen |> List.map (fun (label, attributes, payload) -> ( label, attributes, - payload |> translateCoreType_ ~config ~type_vars_gen ~type_env )) + payload |> translateCoreType_ ~config ~type_vars_gen ~type_env + )) in let payloads = payloads_translations @@ -256,7 +264,8 @@ and translateCoreType_ ~config ~type_vars_gen ~type_env:type_env1 in { - dependencies = dependencies_from_type_equations @ dependencies_from_record_type; + dependencies = + dependencies_from_type_equations @ dependencies_from_record_type; type_; } | None -> {dependencies = []; type_ = unknown}) @@ -273,5 +282,6 @@ let translate_core_type ~config ~type_env core_type = in if !Debug.dependencies then translation.dependencies - |> List.iter (fun dep -> Log_.item "Dependency: %s\n" (dep |> dep_to_string)); + |> List.iter (fun dep -> + Log_.item "Dependency: %s\n" (dep |> dep_to_string)); translation diff --git a/jscomp/gentype/TranslateSignature.ml b/jscomp/gentype/TranslateSignature.ml index 21fe5ec90b..5c3d835f7b 100644 --- a/jscomp/gentype/TranslateSignature.ml +++ b/jscomp/gentype/TranslateSignature.ml @@ -122,13 +122,16 @@ and translate_signature_item ~config ~output_file_relative ~resolver ~type_env in type_env |> TypeEnv.update_module_item ~module_item; value_description - |> translate_signature_value ~config ~output_file_relative ~resolver ~type_env + |> translate_signature_value ~config ~output_file_relative ~resolver + ~type_env | {Typedtree.sig_desc = Typedtree.Tsig_module module_declaration} -> module_declaration - |> translate_module_declaration ~config ~output_file_relative ~resolver ~type_env + |> translate_module_declaration ~config ~output_file_relative ~resolver + ~type_env | {Typedtree.sig_desc = Typedtree.Tsig_modtype module_type_declaration} -> let module_item = - Runtime.new_module_item ~name:(module_type_declaration.mtd_id |> Ident.name) + Runtime.new_module_item + ~name:(module_type_declaration.mtd_id |> Ident.name) in let config = module_type_declaration.mtd_attributes @@ -163,9 +166,10 @@ and translate_signature_item ~config ~output_file_relative ~resolver ~type_env log_not_implemented ("Tsig_attribute " ^ __LOC__); Translation.empty -and translate_signature ~config ~output_file_relative ~resolver ~type_env signature - : Translation.t list = +and translate_signature ~config ~output_file_relative ~resolver ~type_env + signature : Translation.t list = if !Debug.translation then Log_.item "Translate Signature\n"; signature.Typedtree.sig_items |> List.map - (translate_signature_item ~config ~output_file_relative ~resolver ~type_env) + (translate_signature_item ~config ~output_file_relative ~resolver + ~type_env) diff --git a/jscomp/gentype/TranslateSignatureFromTypes.ml b/jscomp/gentype/TranslateSignatureFromTypes.ml index 65d969fcbe..1b0e4625be 100644 --- a/jscomp/gentype/TranslateSignatureFromTypes.ml +++ b/jscomp/gentype/TranslateSignatureFromTypes.ml @@ -1,8 +1,8 @@ open GenTypeCommon (** Like translateTypeDeclaration but from Types not Typedtree *) -let translate_type_declaration_from_types ~config ~output_file_relative ~resolver - ~type_env ~id +let translate_type_declaration_from_types ~config ~output_file_relative + ~resolver ~type_env ~id ({type_attributes; type_kind; type_loc; type_manifest; type_params} : Types.type_declaration) : CodeItem.type_declaration list = type_env |> TypeEnv.new_type ~name:(id |> Ident.name); @@ -17,16 +17,16 @@ let translate_type_declaration_from_types ~config ~output_file_relative ~resolve (label_declarations, record_representation) | Type_variant constructor_declarations when not - (TranslateTypeDeclarations.has_some_gadt_leaf constructor_declarations) - -> + (TranslateTypeDeclarations.has_some_gadt_leaf + constructor_declarations) -> VariantDeclarationFromTypes constructor_declarations | Type_abstract -> GeneralDeclarationFromTypes type_manifest | _ -> NoDeclaration in declaration_kind |> TranslateTypeDeclarations.traslate_declaration_kind ~config ~loc:type_loc - ~output_file_relative ~resolver ~type_attributes:type_attributes ~type_env - ~type_name ~type_vars + ~output_file_relative ~resolver ~type_attributes ~type_env ~type_name + ~type_vars (** Like translateModuleDeclaration but from Types not Typedtree *) let rec translate_module_declaration_from_types ~config ~output_file_relative @@ -70,15 +70,17 @@ and translate_signature_item_from_types ~config ~output_file_relative ~resolver in type_env |> TypeEnv.update_module_item ~module_item; module_declaration - |> translate_module_declaration_from_types ~config ~output_file_relative ~resolver - ~type_env ~id + |> translate_module_declaration_from_types ~config ~output_file_relative + ~resolver ~type_env ~id | Types.Sig_value (id, {val_attributes; val_loc; val_type}) -> let name = id |> Ident.name in if !Debug.translation then Log_.item "Translate Sig Value %s\n" name; let module_item = Runtime.new_module_item ~name in type_env |> TypeEnv.update_module_item ~module_item; if - val_attributes |> Annotation.from_attributes ~config ~loc:val_loc = GenType + val_attributes + |> Annotation.from_attributes ~config ~loc:val_loc + = GenType then name |> Translation.translate_value ~attributes:val_attributes ~config @@ -100,10 +102,10 @@ and translate_signature_item_from_types ~config ~output_file_relative ~resolver Translation.empty (** Like translateSignature but from Types not Typedtree *) -and translate_signature_from_types ~config ~output_file_relative ~resolver ~type_env - (signature : Types.signature_item list) : Translation.t list = +and translate_signature_from_types ~config ~output_file_relative ~resolver + ~type_env (signature : Types.signature_item list) : Translation.t list = if !Debug.translation then Log_.item "Translate Types.signature\n"; signature |> List.map - (translate_signature_item_from_types ~config ~output_file_relative ~resolver - ~type_env) + (translate_signature_item_from_types ~config ~output_file_relative + ~resolver ~type_env) diff --git a/jscomp/gentype/TranslateStructure.ml b/jscomp/gentype/TranslateStructure.ml index b28187e154..15d24f0731 100644 --- a/jscomp/gentype/TranslateStructure.ml +++ b/jscomp/gentype/TranslateStructure.ml @@ -3,9 +3,12 @@ open GenTypeCommon let rec addAnnotationsToTypes_ ~config ~(expr : Typedtree.expression) (arg_types : arg_type list) = match (expr.exp_desc, expr.exp_type.desc, arg_types) with - | Texp_function {arg_label; param; cases = [{c_rhs}]}, _, {a_type} :: next_types - -> - let next_types1 = next_types |> addAnnotationsToTypes_ ~config ~expr:c_rhs in + | ( Texp_function {arg_label; param; cases = [{c_rhs}]}, + _, + {a_type} :: next_types ) -> + let next_types1 = + next_types |> addAnnotationsToTypes_ ~config ~expr:c_rhs + in let a_name = Ident.name param in let _ = Printtyped.implementation in let a_name = @@ -33,7 +36,10 @@ let rec addAnnotationsToTypes_ ~config ~(expr : Typedtree.expression) and add_annotations_to_types ~config ~(expr : Typedtree.expression) (arg_types : arg_type list) = let arg_types = addAnnotationsToTypes_ ~config ~expr arg_types in - if arg_types |> List.filter (fun {a_name} -> a_name = "param") |> List.length > 1 + if + arg_types + |> List.filter (fun {a_name} -> a_name = "param") + |> List.length > 1 then (* Underscore "_" appears as "param", can occur more than once *) arg_types @@ -62,7 +68,9 @@ let add_annotations_to_function_type ~config (expr : Typedtree.expression) (type_ : type_) = match type_ with | Function function_ -> - let arg_types = function_.arg_types |> add_annotations_to_types ~config ~expr in + let arg_types = + function_.arg_types |> add_annotations_to_types ~config ~expr + in Function {function_ with arg_types} | _ -> type_ @@ -71,7 +79,8 @@ let remove_value_binding_duplicates structure_items = match bindings with | ({vb_pat = {pat_desc = Tpat_var (id, _)}} as binding) :: other_bindings -> let name = Ident.name id in - if !seen |> StringSet.mem name then other_bindings |> process_bindings ~seen + if !seen |> StringSet.mem name then + other_bindings |> process_bindings ~seen else ( seen := !seen |> StringSet.add name; binding :: (other_bindings |> process_bindings ~seen)) @@ -86,10 +95,12 @@ let remove_value_binding_duplicates structure_items = let bindings = value_bindings |> process_bindings ~seen in let item = {item with str_desc = Tstr_value (loc, bindings)} in other_items |> process_items ~acc:(item :: acc) ~seen - | item :: other_items -> other_items |> process_items ~acc:(item :: acc) ~seen + | item :: other_items -> + other_items |> process_items ~acc:(item :: acc) ~seen | [] -> acc in - structure_items |> List.rev |> process_items ~acc:[] ~seen:(ref StringSet.empty) + structure_items |> List.rev + |> process_items ~acc:[] ~seen:(ref StringSet.empty) let translate_value_binding ~config ~output_file_relative ~resolver ~type_env {Typedtree.vb_attributes; vb_expr; vb_pat} : Translation.t = @@ -118,7 +129,9 @@ let rec remove_duplicate_value_bindings match structure_items with | ({Typedtree.str_desc = Tstr_value (loc, value_bindings)} as structure_item) :: rest -> - let bound_in_rest, filtered_rest = rest |> remove_duplicate_value_bindings in + let bound_in_rest, filtered_rest = + rest |> remove_duplicate_value_bindings + in let value_bindings_filtered = value_bindings |> List.filter (fun value_binding -> @@ -141,12 +154,14 @@ let rec remove_duplicate_value_bindings {structure_item with str_desc = Tstr_value (loc, value_bindings_filtered)} :: filtered_rest ) | structure_item :: rest -> - let bound_in_rest, filtered_rest = rest |> remove_duplicate_value_bindings in + let bound_in_rest, filtered_rest = + rest |> remove_duplicate_value_bindings + in (bound_in_rest, structure_item :: filtered_rest) | [] -> (StringSet.empty, []) -let rec translate_module_binding ~(config : GenTypeConfig.t) ~output_file_relative - ~resolver ~type_env +let rec translate_module_binding ~(config : GenTypeConfig.t) + ~output_file_relative ~resolver ~type_env ({mb_id; mb_expr; mb_attributes} : Typedtree.module_binding) : Translation.t = let name = mb_id |> Ident.name in @@ -272,7 +287,8 @@ and translate_structure_item ~config ~output_file_relative ~resolver ~type_env | {str_desc = Tstr_value (_loc, value_bindings)} -> value_bindings |> List.map - (translate_value_binding ~config ~output_file_relative ~resolver ~type_env) + (translate_value_binding ~config ~output_file_relative ~resolver + ~type_env) |> Translation.combine | {str_desc = Tstr_primitive value_description} -> (* external declaration *) @@ -281,7 +297,8 @@ and translate_structure_item ~config ~output_file_relative ~resolver ~type_env ~type_env | {str_desc = Tstr_module module_binding} -> module_binding - |> translate_module_binding ~config ~output_file_relative ~resolver ~type_env + |> translate_module_binding ~config ~output_file_relative ~resolver + ~type_env | {str_desc = Tstr_modtype module_type_declaration} -> module_type_declaration |> TranslateSignature.translate_module_type_declaration ~config @@ -289,7 +306,8 @@ and translate_structure_item ~config ~output_file_relative ~resolver ~type_env | {str_desc = Tstr_recmodule module_bindings} -> module_bindings |> List.map - (translate_module_binding ~config ~output_file_relative ~resolver ~type_env) + (translate_module_binding ~config ~output_file_relative ~resolver + ~type_env) |> Translation.combine | { str_desc = @@ -317,7 +335,8 @@ and translate_structure_item ~config ~output_file_relative ~resolver ~type_env _; } -> struct_item1 - |> translate_structure_item ~config ~output_file_relative ~resolver ~type_env + |> translate_structure_item ~config ~output_file_relative ~resolver + ~type_env | {str_desc = Tstr_include {incl_type = signature}} -> signature |> TranslateSignatureFromTypes.translate_signature_from_types ~config @@ -345,8 +364,8 @@ and translate_structure_item ~config ~output_file_relative ~resolver ~type_env log_not_implemented ("Tstr_attribute " ^ __LOC__); Translation.empty -and translate_structure ~config ~output_file_relative ~resolver ~type_env structure - : Translation.t list = +and translate_structure ~config ~output_file_relative ~resolver ~type_env + structure : Translation.t list = if !Debug.translation then Log_.item "Translate Structure\n"; structure.Typedtree.str_items |> remove_value_binding_duplicates |> List.map (fun struct_item -> diff --git a/jscomp/gentype/TranslateTypeDeclarations.ml b/jscomp/gentype/TranslateTypeDeclarations.ml index 8b49ef7a19..08b8075603 100644 --- a/jscomp/gentype/TranslateTypeDeclarations.ml +++ b/jscomp/gentype/TranslateTypeDeclarations.ml @@ -9,9 +9,9 @@ type declaration_kind = | VariantDeclarationFromTypes of Types.constructor_declaration list | NoDeclaration -let create_export_type_from_type_declaration ~annotation ~loc ~name_as ~opaque ~type_ - ~type_env ~doc_string type_name ~type_vars : CodeItem.export_from_type_declaration - = +let create_export_type_from_type_declaration ~annotation ~loc ~name_as ~opaque + ~type_ ~type_env ~doc_string type_name ~type_vars : + CodeItem.export_from_type_declaration = let resolved_type_name = type_name |> sanitize_type_name |> TypeEnv.add_module_path ~type_env in @@ -76,12 +76,13 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver (translation : TranslateTypeExprFromTypes.translation) = let export_from_type_declaration = type_name - |> create_export_type_from_type_declaration ~annotation ~loc ~name_as ~opaque - ~type_:translation.type_ ~type_env ~doc_string ~type_vars + |> create_export_type_from_type_declaration ~annotation ~loc ~name_as + ~opaque ~type_:translation.type_ ~type_env ~doc_string ~type_vars in let import_types = translation.dependencies - |> Translation.translate_dependencies ~config ~output_file_relative ~resolver + |> Translation.translate_dependencies ~config ~output_file_relative + ~resolver in {CodeItem.import_types; export_from_type_declaration} in @@ -107,8 +108,8 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver ( name, mutability, ld_type - |> TranslateTypeExprFromTypes.translate_type_expr_from_types ~config - ~type_env, + |> TranslateTypeExprFromTypes.translate_type_expr_from_types + ~config ~type_env, Annotation.doc_string_from_attrs ld_attributes )) in let dependencies = @@ -160,8 +161,8 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver let export_from_type_declaration = (* Make the imported type usable from other modules by exporting it too. *) typeName_ - |> create_export_type_from_type_declaration ~doc_string ~annotation:GenType ~loc - ~name_as:None ~opaque:(Some false) + |> create_export_type_from_type_declaration ~doc_string + ~annotation:GenType ~loc ~name_as:None ~opaque:(Some false) ~type_: (as_type_name |> ident ~type_args:(type_vars |> List.map (fun s -> TypeVar s))) @@ -180,7 +181,8 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver | GeneralDeclarationFromTypes (Some type_expr), None -> let translation = type_expr - |> TranslateTypeExprFromTypes.translate_type_expr_from_types ~config ~type_env + |> TranslateTypeExprFromTypes.translate_type_expr_from_types ~config + ~type_env in translation |> handle_general_declaration |> return_type_declaration | GeneralDeclaration (Some core_type), None -> @@ -190,7 +192,9 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver let type_ = match (core_type, translation.type_) with | {ctyp_desc = Ttyp_variant (row_fields, _, _)}, Variant variant -> - let row_fields_variants = row_fields |> TranslateCoreType.process_variant in + let row_fields_variants = + row_fields |> TranslateCoreType.process_variant + in let no_payloads = row_fields_variants.no_payloads |> List.map (create_case ~poly:true) in @@ -219,7 +223,8 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver in let import_types = dependencies - |> Translation.translate_dependencies ~config ~output_file_relative ~resolver + |> Translation.translate_dependencies ~config ~output_file_relative + ~resolver in { CodeItem.import_types; @@ -258,8 +263,8 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver |> List.map (fun {TranslateTypeExprFromTypes.dependencies} -> dependencies) |> List.concat - |> Translation.translate_dependencies ~config ~output_file_relative - ~resolver + |> Translation.translate_dependencies ~config + ~output_file_relative ~resolver in (name, attributes, arg_types, import_types)) in @@ -306,7 +311,8 @@ let traslate_declaration_kind ~config ~loc ~output_file_relative ~resolver |> List.map (fun (_, _, _, import_types) -> import_types) |> List.concat in - {CodeItem.export_from_type_declaration; import_types} |> return_type_declaration + {CodeItem.export_from_type_declaration; import_types} + |> return_type_declaration | NoDeclaration, None -> [] let has_some_gadt_leaf constructor_declarations = @@ -336,18 +342,19 @@ let translate_type_declaration ~config ~output_file_relative ~resolver ~type_env | _ -> NoDeclaration in declaration_kind - |> traslate_declaration_kind ~config ~loc:typ_loc ~output_file_relative ~resolver - ~type_attributes:typ_attributes ~type_env ~type_name ~type_vars + |> traslate_declaration_kind ~config ~loc:typ_loc ~output_file_relative + ~resolver ~type_attributes:typ_attributes ~type_env ~type_name ~type_vars let add_type_declaration_id_to_type_env ~type_env ({typ_id} : Typedtree.type_declaration) = type_env |> TypeEnv.new_type ~name:(typ_id |> Ident.name) -let translate_type_declarations ~config ~output_file_relative ~recursive ~resolver - ~type_env (type_declarations : Typedtree.type_declaration list) : +let translate_type_declarations ~config ~output_file_relative ~recursive + ~resolver ~type_env (type_declarations : Typedtree.type_declaration list) : CodeItem.type_declaration list = if recursive then - type_declarations |> List.iter (add_type_declaration_id_to_type_env ~type_env); + type_declarations + |> List.iter (add_type_declaration_id_to_type_env ~type_env); type_declarations |> List.map (fun type_declaration -> let res = diff --git a/jscomp/gentype/TranslateTypeExprFromTypes.ml b/jscomp/gentype/TranslateTypeExprFromTypes.ml index 2344cda345..f71b3d1ba9 100644 --- a/jscomp/gentype/TranslateTypeExprFromTypes.ml +++ b/jscomp/gentype/TranslateTypeExprFromTypes.ml @@ -2,8 +2,8 @@ open GenTypeCommon type translation = {dependencies: dep list; type_: type_} -let rec remove_option ~(label : Asttypes.arg_label) (type_expr : Types.type_expr) - = +let rec remove_option ~(label : Asttypes.arg_label) + (type_expr : Types.type_expr) = match (type_expr.desc, label) with | Tconstr (Path.Pident id, [t], _), Optional lbl when Ident.name id = "option" -> @@ -167,7 +167,8 @@ let translate_constr ~config ~params_translation ~(path : Path.t) ~type_env = | ( (["React"; "componentLike"] | ["ReactV3"; "React"; "componentLike"]), [props_translation; ret_translation] ) -> { - dependencies = props_translation.dependencies @ ret_translation.dependencies; + dependencies = + props_translation.dependencies @ ret_translation.dependencies; type_ = Function { @@ -255,7 +256,8 @@ let process_variant row_fields = ( Types.Rpresent (* no payload *) None | Reither ((* constant constructor *) true, _, _, _) ) ) :: other_fields -> - other_fields |> loop ~no_payloads:(label :: no_payloads) ~payloads ~unknowns + other_fields + |> loop ~no_payloads:(label :: no_payloads) ~payloads ~unknowns | (label, Rpresent (Some payload)) :: other_fields -> other_fields |> loop ~no_payloads ~payloads:((label, payload) :: payloads) ~unknowns @@ -270,11 +272,12 @@ let process_variant row_fields = in row_fields |> loop ~no_payloads:[] ~payloads:[] ~unknowns:[] -let rec translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps ~rev_args - (type_expr : Types.type_expr) = +let rec translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps + ~rev_args (type_expr : Types.type_expr) = match type_expr.desc with | Tlink t -> - translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps ~rev_args t + translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps + ~rev_args t | Tarrow (Nolabel, type_expr1, type_expr2, _) -> let {dependencies; type_} = type_expr1 |> fun __x -> @@ -282,14 +285,16 @@ let rec translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps ~rev in let next_rev_deps = List.rev_append dependencies rev_arg_deps in type_expr2 - |> translate_arrow_type ~config ~type_vars_gen ~type_env ~rev_arg_deps:next_rev_deps + |> translate_arrow_type ~config ~type_vars_gen ~type_env + ~rev_arg_deps:next_rev_deps ~rev_args:((Nolabel, type_) :: rev_args) | Tarrow (((Labelled lbl | Optional lbl) as label), type_expr1, type_expr2, _) -> ( match type_expr1 |> remove_option ~label with | None -> let {dependencies; type_ = type1} = - type_expr1 |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env + type_expr1 + |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env in let next_rev_deps = List.rev_append dependencies rev_arg_deps in type_expr2 @@ -340,7 +345,8 @@ and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env match name |> Runtime.is_mutable_object_field with | true -> {dependencies = []; type_ = ident ""} | false -> - t1 |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env ) + t1 |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env + ) :: fields ) | Tlink te -> te |> get_field_types | Tvar None -> (Open, []) @@ -353,7 +359,8 @@ and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env | Tconstr (path, type_params, _) -> let params_translation = - type_params |> translateTypeExprsFromTypes_ ~config ~type_vars_gen ~type_env + type_params + |> translateTypeExprsFromTypes_ ~config ~type_vars_gen ~type_env in translate_constr ~config ~params_translation ~path ~type_env | Tpoly (t, []) -> @@ -366,7 +373,9 @@ and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env let inner_types_translation = list_exp |> translateTypeExprsFromTypes_ ~config ~type_vars_gen ~type_env in - let inner_types = inner_types_translation |> List.map (fun {type_} -> type_) in + let inner_types = + inner_types_translation |> List.map (fun {type_} -> type_) + in let inner_types_deps = inner_types_translation |> List.map (fun {dependencies} -> dependencies) @@ -383,7 +392,8 @@ and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env |> List.map (fun label -> { label_js = - (if is_number label then IntLabel label else StringLabel label); + (if is_number label then IntLabel label + else StringLabel label); }) in let type_ = @@ -404,7 +414,8 @@ and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env |> List.map (fun (label, payload) -> ( label, payload - |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env )) + |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env + )) in let payloads = payload_translations @@ -429,7 +440,8 @@ and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env (List.combine ids types [@doesNotRaise]) |> List.map (fun (x, t) -> ( x, - t |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env + t + |> translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env )) in let type_equations = @@ -448,7 +460,8 @@ and translateTypeExprFromTypes_ ~config ~type_vars_gen ~type_env ~type_env:type_env1 in { - dependencies = dependencies_from_type_equations @ dependencies_from_record_type; + dependencies = + dependencies_from_type_equations @ dependencies_from_record_type; type_; } | None -> {dependencies = []; type_ = unknown}) @@ -484,7 +497,9 @@ and signature_to_module_runtime_representation ~config ~type_vars_gen ~type_env (dependencies, [field]) | Types.Sig_module (id, module_declaration, _recStatus) -> let type_env1 = - match type_env |> TypeEnv.get_module ~name:(id |> Ident.name) with + match + type_env |> TypeEnv.get_module ~name:(id |> Ident.name) + with | Some type_env1 -> type_env1 | None -> type_env in @@ -492,8 +507,8 @@ and signature_to_module_runtime_representation ~config ~type_vars_gen ~type_env match module_declaration.md_type with | Mty_signature signature -> signature - |> signature_to_module_runtime_representation ~config ~type_vars_gen - ~type_env:type_env1 + |> signature_to_module_runtime_representation ~config + ~type_vars_gen ~type_env:type_env1 | Mty_ident _ | Mty_functor _ | Mty_alias _ -> ([], unknown) in let field = @@ -503,7 +518,8 @@ and signature_to_module_runtime_representation ~config ~type_vars_gen ~type_env optional = Mandatory; type_; doc_string = - Annotation.doc_string_from_attrs module_declaration.md_attributes; + Annotation.doc_string_from_attrs + module_declaration.md_attributes; } in (dependencies, [field]) @@ -524,7 +540,8 @@ let translate_type_expr_from_types ~config ~type_env type_expr = in if !Debug.dependencies then translation.dependencies - |> List.iter (fun dep -> Log_.item "Dependency: %s\n" (dep |> dep_to_string)); + |> List.iter (fun dep -> + Log_.item "Dependency: %s\n" (dep |> dep_to_string)); translation let translate_type_exprs_from_types ~config ~type_env type_exprs = diff --git a/jscomp/gentype/Translation.ml b/jscomp/gentype/Translation.ml index a54c77824e..c80b413350 100644 --- a/jscomp/gentype/Translation.ml +++ b/jscomp/gentype/Translation.ml @@ -4,7 +4,8 @@ type t = CodeItem.translation let empty = ({import_types = []; code_items = []; type_declarations = []} : t) -let get_import_type_unique_name ({type_name; as_type_name} : CodeItem.import_type) = +let get_import_type_unique_name + ({type_name; as_type_name} : CodeItem.import_type) = type_name ^ match as_type_name with @@ -66,14 +67,15 @@ let dep_to_import_type ~config ~output_file_relative ~resolver (dep : dep) = in [{type_name; as_type_name; import_path}] -let translate_dependencies ~config ~output_file_relative ~resolver dependencies : - CodeItem.import_type list = +let translate_dependencies ~config ~output_file_relative ~resolver dependencies + : CodeItem.import_type list = dependencies |> List.map (dep_to_import_type ~config ~output_file_relative ~resolver) |> List.concat -let translate_value ~attributes ~config ~doc_string ~output_file_relative ~resolver - ~type_env ~type_expr ~(add_annotations_to_function : type_ -> type_) name : t = +let translate_value ~attributes ~config ~doc_string ~output_file_relative + ~resolver ~type_env ~type_expr + ~(add_annotations_to_function : type_ -> type_) name : t = let name_as = match Annotation.get_gentype_as_renaming attributes with | Some s -> s @@ -81,7 +83,8 @@ let translate_value ~attributes ~config ~doc_string ~output_file_relative ~resol in let type_expr_translation = type_expr - |> TranslateTypeExprFromTypes.translate_type_expr_from_types ~config ~type_env + |> TranslateTypeExprFromTypes.translate_type_expr_from_types ~config + ~type_env in let type_vars = type_expr_translation.type_ |> TypeVars.free in let type_ = @@ -99,7 +102,13 @@ let translate_value ~attributes ~config ~doc_string ~output_file_relative ~resol let code_items = [ CodeItem.ExportValue - {doc_string; module_access_path; original_name = name; resolved_name; type_}; + { + doc_string; + module_access_path; + original_name = name; + resolved_name; + type_; + }; ] in { @@ -192,7 +201,8 @@ let add_type_declarations_from_module_equations ~type_env (translation : t) = { CodeItem.export_type = new_export_type; annotation = - type_declaration.export_from_type_declaration.annotation; + type_declaration.export_from_type_declaration + .annotation; }; import_types = []; })) diff --git a/jscomp/gentype/TypeEnv.ml b/jscomp/gentype/TypeEnv.ml index 3875a99497..adbdaa6c48 100644 --- a/jscomp/gentype/TypeEnv.ml +++ b/jscomp/gentype/TypeEnv.ml @@ -98,7 +98,9 @@ let add_type_equations ~type_equations type_env = |> List.fold_left (fun te (long_ident, type_) -> te - |> add_type_equation ~flattened:(long_ident |> Longident.flatten) ~type_) + |> add_type_equation + ~flattened:(long_ident |> Longident.flatten) + ~type_) type_env let apply_type_equations ~config ~path type_env = @@ -110,8 +112,8 @@ let apply_type_equations ~config ~path type_env = Log_.item "Typenv.applyTypeEquations %s name:%s type_:%s\n" (type_env |> to_string) (id |> Ident.name) (type_ - |> EmitType.type_to_string ~config ~type_name_is_interface:(fun _ -> false) - ); + |> EmitType.type_to_string ~config ~type_name_is_interface:(fun _ -> + false)); Some type_ | exception Not_found -> None) | _ -> None @@ -157,11 +159,12 @@ let rec path_to_list path = let lookup_module_type_signature ~path type_env = if !Debug.type_env then - Log_.item "TypeEnv.lookupModuleTypeSignature %s %s\n" (type_env |> to_string) - (path |> Path.name); + Log_.item "TypeEnv.lookupModuleTypeSignature %s %s\n" + (type_env |> to_string) (path |> Path.name); type_env |> lookup_module_type ~path:(path |> path_to_list |> List.rev) -let update_module_item ~module_item type_env = type_env.module_item <- module_item +let update_module_item ~module_item type_env = + type_env.module_item <- module_item let rec add_module_path ~type_env name = match type_env.parent with @@ -181,7 +184,10 @@ let rec get_module_equations type_env : ResolvedName.eq list = match (type_env.module_equation, type_env.parent) with | None, _ | _, None -> sub_equations | Some {dep}, Some parent -> - [(dep |> dep_to_resolved_name, type_env.name |> add_module_path ~type_env:parent)] + [ + ( dep |> dep_to_resolved_name, + type_env.name |> add_module_path ~type_env:parent ); + ] let get_module_access_path ~name type_env = let rec access_path type_env = diff --git a/jscomp/syntax/src/jsx_ppx.ml b/jscomp/syntax/src/jsx_ppx.ml index 7f3f18f67d..baf3da5448 100644 --- a/jscomp/syntax/src/jsx_ppx.ml +++ b/jscomp/syntax/src/jsx_ppx.ml @@ -72,10 +72,16 @@ let process_config_attribute attribute config = if is_jsx_config_attr attribute then update_config config (snd attribute) let get_mapper ~config = - let expr3, module_binding3, transform_signature_item3, transform_structure_item3 = + let ( expr3, + module_binding3, + transform_signature_item3, + transform_structure_item3 ) = Reactjs_jsx_v3.jsx_mapper ~config in - let expr4, module_binding4, transform_signature_item4, transform_structure_item4 = + let ( expr4, + module_binding4, + transform_signature_item4, + transform_structure_item4 ) = Jsx_v4.jsx_mapper ~config in diff --git a/jscomp/syntax/src/jsx_v4.ml b/jscomp/syntax/src/jsx_v4.ml index 34ef9844cd..ad5a99d4f2 100644 --- a/jscomp/syntax/src/jsx_v4.ml +++ b/jscomp/syntax/src/jsx_v4.ml @@ -92,7 +92,8 @@ let transform_children_if_list ~mapper the_list = in transformChildren_ the_list [] -let extract_children ?(remove_last_position_unit = false) ~loc props_and_children = +let extract_children ?(remove_last_position_unit = false) ~loc + props_and_children = let rec allButLast_ lst acc = match lst with | [] -> [] @@ -114,7 +115,8 @@ let extract_children ?(remove_last_position_unit = false) ~loc props_and_childre ( 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) + ( children_expr, + if remove_last_position_unit then all_but_last props else props ) | _ -> Jsx_common.raise_error ~loc "JSX: somehow there's more than one `children` label" @@ -288,11 +290,13 @@ let make_props_type_params ?(strip_explicit_option = false) | {ptyp_desc = Ptyp_any} -> Some (ref_type_var loc) | _ -> (* Strip explicit Js.Nullable.t in case of forwardRef *) - if strip_explicit_js_nullable_of_ref then strip_js_nullable interior_type + if strip_explicit_js_nullable_of_ref then + strip_js_nullable interior_type else Some interior_type (* Strip the explicit option type in implementation *) (* let make = (~x: option=?) => ... *) - else if is_optional && strip_explicit_option then strip_option interior_type + else if is_optional && strip_explicit_option then + strip_option interior_type else Some interior_type) let make_label_decls named_type_list = @@ -343,27 +347,30 @@ let make_type_decls_with_core_type props_name loc core_type typ_vars = ] (* 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 make_props_record_type ~core_type_of_attr ~typ_vars_of_core_type props_name + loc named_type_list = 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) + make_type_decls_with_core_type props_name loc core_type + typ_vars_of_core_type) (* 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 make_props_record_type_sig ~core_type_of_attr ~typ_vars_of_core_type + props_name loc named_type_list = 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) + make_type_decls_with_core_type props_name loc core_type + typ_vars_of_core_type) -let transform_uppercase_call3 ~config module_path mapper jsx_expr_loc call_expr_loc - attrs call_arguments = +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 + extract_children ~remove_last_position_unit:true ~loc:jsx_expr_loc + call_arguments in let args_for_make = args_with_labels in let children_expr = transform_children_if_list_upper ~mapper children in @@ -423,7 +430,8 @@ let transform_uppercase_call3 ~config module_path mapper jsx_expr_loc call_expr_ args |> List.filter (fun (arg_label, _) -> "key" = get_label arg_label) in let make_i_d = - Exp.ident ~loc:call_expr_loc {txt = ident ~suffix:"make"; loc = call_expr_loc} + Exp.ident ~loc:call_expr_loc + {txt = ident ~suffix:"make"; loc = call_expr_loc} in match config.mode with (* The new jsx transform *) @@ -493,7 +501,8 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs in let children, non_children_props = - extract_children ~remove_last_position_unit:true ~loc:jsx_expr_loc call_arguments + extract_children ~remove_last_position_unit:true ~loc:jsx_expr_loc + call_arguments in let args_for_make = non_children_props in let children_expr = transform_children_if_list_upper ~mapper children in @@ -549,7 +558,8 @@ let transform_lowercase_call3 ~config mapper jsx_expr_loc call_expr_loc attrs {loc = Location.none; txt = Ldot (element_binding, "jsxKeyed")}, [key; (nolabel, unit_expr ~loc:Location.none)] ) | None, [] -> - (Exp.ident {loc = Location.none; txt = Ldot (element_binding, "jsx")}, []) + ( Exp.ident {loc = Location.none; txt = Ldot (element_binding, "jsx")}, + [] ) | Some _, key :: _ -> ( Exp.ident {loc = Location.none; txt = Ldot (element_binding, "jsxsKeyed")}, @@ -698,8 +708,8 @@ let rec recursively_transform_named_args_for_make expr args newtypes core_type = "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 + 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) @@ -765,8 +775,9 @@ let modified_binding_old binding = Pexp_apply (_wrapperExpression, [(Nolabel, inner_function_expression)]); } -> spelunk_for_fun_expression inner_function_expression - | {pexp_desc = Pexp_sequence (_wrapperExpression, inner_function_expression)} - -> + | { + pexp_desc = Pexp_sequence (_wrapperExpression, inner_function_expression); + } -> spelunk_for_fun_expression inner_function_expression | {pexp_desc = Pexp_constraint (inner_function_expression, _typ)} -> spelunk_for_fun_expression inner_function_expression @@ -842,7 +853,8 @@ let modified_binding ~binding_loc ~binding_pat_loc ~fn_name binding = {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 (wrapper_expression, [(Nolabel, internal_expression)]); } -> let () = has_application := true in let _, _, exp = spelunk_for_fun_expression internal_expression in @@ -899,7 +911,9 @@ 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 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 @@ -917,7 +931,9 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = 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 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 in @@ -934,8 +950,8 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = let named_type_list = List.fold_left arg_to_type [] named_arg_list 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 + make_props_record_type ~core_type_of_attr ~typ_vars_of_core_type "props" + pstr_loc named_type_list in let inner_expression = Exp.apply @@ -1065,7 +1081,8 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = } ) :: patterns_with_nolabel) expr - | _ -> returned_expression patterns_with_label patterns_with_nolabel expr) + | _ -> + returned_expression patterns_with_label patterns_with_nolabel expr) | _ -> (patterns_with_label, patterns_with_nolabel, expr) in let patterns_with_label, patterns_with_nolabel, expression = @@ -1073,7 +1090,8 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = 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 has_default_value named_arg_list then + vb_match_expr named_arg_list expression else expression in (* (ref) => expr *) @@ -1103,7 +1121,8 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = (match core_type_of_attr with | None -> make_props_type_params ~strip_explicit_option:true - ~strip_explicit_js_nullable_of_ref:has_forward_ref named_type_list + ~strip_explicit_js_nullable_of_ref:has_forward_ref + named_type_list | Some _ -> ( match typ_vars_of_core_type with | [] -> [] @@ -1125,7 +1144,9 @@ let map_binding ~config ~empty_loc ~pstr_loc ~file_name ~rec_flag binding = [make_new_binding binding expression internal_fn_name] (Exp.let_ ~loc:empty_loc Nonrecursive [ - Vb.mk (Pat.var {loc = empty_loc; txt = fn_name}) full_expression; + Vb.mk + (Pat.var {loc = empty_loc; txt = fn_name}) + full_expression; ] (Exp.ident {loc = empty_loc; txt = Lident fn_name}))), None ) @@ -1166,7 +1187,9 @@ let transform_structure_item ~config item = 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 + 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 -> @@ -1188,8 +1211,8 @@ let transform_structure_item ~config item = 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 + make_props_record_type ~core_type_of_attr ~typ_vars_of_core_type "props" + pstr_loc named_type_list in (* can't be an arrow because it will defensively uncurry *) let new_external_type = @@ -1295,8 +1318,8 @@ let transform_signature_item ~config item = | _ -> [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 + make_props_record_type_sig ~core_type_of_attr ~typ_vars_of_core_type + "props" psig_loc named_type_list in (* can't be an arrow because it will defensively uncurry *) let new_external_type = @@ -1322,8 +1345,8 @@ let transform_signature_item ~config item = "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 = +let transform_jsx_call ~config mapper call_expression call_arguments + jsx_expr_loc attrs = match call_expression.pexp_desc with | Pexp_ident caller -> ( match caller with @@ -1332,14 +1355,14 @@ let transform_jsx_call ~config mapper call_expression call_arguments jsx_expr_lo "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 + transform_uppercase_call3 ~config module_path mapper jsx_expr_loc loc + attrs call_arguments (* 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 + 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 "JSX: the JSX attribute should be attached to a \ diff --git a/jscomp/syntax/src/reactjs_jsx_v3.ml b/jscomp/syntax/src/reactjs_jsx_v3.ml index 9817ffb53e..46de98bf4a 100644 --- a/jscomp/syntax/src/reactjs_jsx_v3.ml +++ b/jscomp/syntax/src/reactjs_jsx_v3.ml @@ -80,7 +80,8 @@ let transform_children_if_list ~loc ~mapper the_list = in transformChildren_ the_list [] -let extract_children ?(remove_last_position_unit = false) ~loc props_and_children = +let extract_children ?(remove_last_position_unit = false) ~loc + props_and_children = let rec allButLast_ lst acc = match lst with | [] -> [] @@ -102,7 +103,8 @@ let extract_children ?(remove_last_position_unit = false) ~loc props_and_childre ( 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) + ( children_expr, + if remove_last_position_unit then all_but_last props else props ) | _ -> Jsx_common.raise_error ~loc "JSX: somehow there's more than one `children` label" @@ -291,11 +293,13 @@ let make_props_external fn_name loc named_arg_list_with_key_and_ref props_type = } (* 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 make_props_external_sig fn_name loc named_arg_list_with_key_and_ref + props_type = { psig_loc = loc; psig_desc = - Psig_value (make_props_value fn_name loc named_arg_list_with_key_and_ref props_type); + Psig_value + (make_props_value fn_name loc named_arg_list_with_key_and_ref props_type); } (* Build an AST node for the props name when converted to an object inside the function signature *) @@ -311,7 +315,8 @@ let make_props_type ~loc named_type_list = (Ptyp_object (List.map (make_object_field loc) named_type_list, 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 = +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) @@ -334,7 +339,9 @@ let jsx_mapper ~config = extract_children ~loc ~remove_last_position_unit:true call_arguments in let args_for_make = args_with_labels in - let children_expr = transform_children_if_list_upper ~loc ~mapper children in + let children_expr = + transform_children_if_list_upper ~loc ~mapper children + in let recursively_transformed_args_for_make = args_for_make |> List.map (fun (label, expression) -> @@ -516,7 +523,8 @@ 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) + recursively_transform_named_args_for_make expression args + (label :: newtypes) | Pexp_constraint (expression, _typ) -> recursively_transform_named_args_for_make expression args newtypes | _ -> (args, newtypes, None) @@ -610,7 +618,9 @@ let jsx_mapper ~config = | _ -> (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 in + let named_type_list = + List.fold_left arg_to_concrete_type [] prop_types + in let pluck_label_and_loc (label, loc, type_) = (label, None (* default *), loc, Some type_) in @@ -661,7 +671,9 @@ let jsx_mapper ~config = 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 full_module_name = + make_module_name file_name !nested_modules fn_name + in let modified_binding_old 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 *) @@ -686,7 +698,8 @@ let jsx_mapper ~config = Pexp_sequence (_wrapperExpression, inner_function_expression); } -> spelunk_for_fun_expression inner_function_expression - | {pexp_desc = Pexp_constraint (inner_function_expression, _typ)} -> + | {pexp_desc = Pexp_constraint (inner_function_expression, _typ)} + -> spelunk_for_fun_expression inner_function_expression | {pexp_loc} -> Jsx_common.raise_error ~loc:pexp_loc @@ -700,7 +713,8 @@ let jsx_mapper ~config = 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}) + (Pat.var ~loc:binding_pat_loc + {loc = binding_pat_loc; txt = fn_name}) (expression_fn expression) in let expression = binding.pvb_expr in @@ -784,7 +798,8 @@ let jsx_mapper ~config = (* let make = React.forwardRef((~prop) => ...) *) | { pexp_desc = - Pexp_apply (wrapper_expression, [(Nolabel, internal_expression)]); + Pexp_apply + (wrapper_expression, [(Nolabel, internal_expression)]); } -> let () = has_application := true in let _, has_unit, exp = @@ -794,7 +809,8 @@ let jsx_mapper ~config = has_unit, exp ) | { - pexp_desc = Pexp_sequence (wrapper_expression, internal_expression); + pexp_desc = + Pexp_sequence (wrapper_expression, internal_expression); } -> let wrap, has_unit, exp = spelunk_for_fun_expression internal_expression @@ -812,7 +828,9 @@ let jsx_mapper ~config = in (wrap_expression_with_binding wrap_expression, has_unit, expression) in - let binding_wrapper, has_unit, expression = modified_binding binding in + let binding_wrapper, has_unit, expression = + modified_binding binding + in let react_component_attribute = try Some (List.find Jsx_common.has_attr binding.pvb_attributes) with Not_found -> None @@ -878,7 +896,8 @@ let jsx_mapper ~config = 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 props.props_name; loc} ); (nolabel, Exp.ident ~loc {txt = Lident label_string; loc}); ] ) in @@ -1024,7 +1043,9 @@ let jsx_mapper ~config = match new_bindings with | [] -> [] | new_bindings -> - [{pstr_loc = empty_loc; pstr_desc = Pstr_value (rec_flag, new_bindings)}]) + [ + {pstr_loc = empty_loc; pstr_desc = Pstr_value (rec_flag, new_bindings)}; + ]) | _ -> [item] in @@ -1053,7 +1074,9 @@ let jsx_mapper ~config = | _ -> (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 in + let named_type_list = + List.fold_left arg_to_concrete_type [] prop_types + in let pluck_label_and_loc (label, loc, type_) = (label, None, loc, Some type_) in @@ -1130,8 +1153,10 @@ 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} - -> ( + | { + pexp_desc = Pexp_apply (call_expression, call_arguments); + pexp_attributes; + } -> ( let jsx_attribute, non_jsx_attributes = List.partition (fun (attribute, _) -> attribute.txt = "JSX") @@ -1141,7 +1166,8 @@ let jsx_mapper ~config = (* no JSX attribute *) | [], _ -> default_mapper.expr mapper expression | _, non_jsx_attributes -> - transform_jsx_call mapper call_expression call_arguments non_jsx_attributes) + transform_jsx_call mapper call_expression call_arguments + non_jsx_attributes) (* is it a list with jsx attribute? Reason <>foo desugars to [@JSX][foo]*) | { pexp_desc = @@ -1163,7 +1189,9 @@ let jsx_mapper ~config = 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 children_expr = + transform_children_if_list ~loc ~mapper list_items + in let args = [ (* "div" *) diff --git a/jscomp/syntax/src/res_ast_conversion.ml b/jscomp/syntax/src/res_ast_conversion.ml index e8207d6fc8..910d7e731b 100644 --- a/jscomp/syntax/src/res_ast_conversion.ml +++ b/jscomp/syntax/src/res_ast_conversion.ml @@ -42,13 +42,17 @@ let rec rewrite_ppat_open longident_open pat = pat with ppat_desc = Ppat_construct - ( {longident_loc with txt = concat_longidents longident_open constructor}, + ( { + longident_loc with + txt = concat_longidents longident_open constructor; + }, opt_pattern ); } | Ppat_record ((({txt = lbl} as longident_loc), first_pat) :: rest, flag) -> (* Foo.{x} -> {Foo.x: x} *) let first_row = - ({longident_loc with txt = concat_longidents longident_open lbl}, first_pat) + ( {longident_loc with txt = concat_longidents longident_open lbl}, + first_pat ) in {pat with ppat_desc = Ppat_record (first_row :: rest, flag)} | Ppat_or (pat1, pat2) -> @@ -69,7 +73,10 @@ let rec rewrite_ppat_open longident_open pat = pat with ppat_desc = Ppat_type - {longident_loc with txt = concat_longidents longident_open constructor}; + { + longident_loc with + txt = concat_longidents longident_open constructor; + }; } | Ppat_lazy p -> {pat with ppat_desc = Ppat_lazy (rewrite_ppat_open longident_open p)} @@ -168,7 +175,8 @@ let looks_like_recursive_type_declaration type_declaration = | Ptyp_class _ -> false | Ptyp_package _ -> false | Ptyp_extension _ -> false - | Ptyp_arrow (_lbl, typ1, typ2) -> check_typ_expr typ1 || check_typ_expr typ2 + | Ptyp_arrow (_lbl, typ1, typ2) -> + check_typ_expr typ1 || check_typ_expr typ2 | Ptyp_tuple types -> List.exists check_typ_expr types | Ptyp_constr ({txt = longident}, types) -> (match longident with @@ -301,11 +309,14 @@ let normalize = | Some "" -> Some "js" | tag -> tag in - let s = Parsetree.Pconst_string (escape_template_literal txt, new_tag) in + let s = + Parsetree.Pconst_string (escape_template_literal txt, new_tag) + in { p with ppat_attributes = - template_literal_attr :: mapper.attributes mapper p.ppat_attributes; + template_literal_attr + :: mapper.attributes mapper p.ppat_attributes; ppat_desc = Ppat_constant s; } | _ -> default_mapper.pat mapper p); @@ -332,7 +343,9 @@ let normalize = | Some "" -> Some "js" | tag -> tag in - let s = Parsetree.Pconst_string (escape_template_literal txt, new_tag) in + let s = + Parsetree.Pconst_string (escape_template_literal txt, new_tag) + in { expr with pexp_attributes = @@ -476,7 +489,8 @@ let normalize = let flag = match type_declarations with | [td] -> - if looks_like_recursive_type_declaration td then Asttypes.Recursive + if looks_like_recursive_type_declaration td then + Asttypes.Recursive else Asttypes.Nonrecursive | _ -> rec_flag in @@ -499,7 +513,8 @@ let normalize = let flag = match type_declarations with | [td] -> - if looks_like_recursive_type_declaration td then Asttypes.Recursive + if looks_like_recursive_type_declaration td then + Asttypes.Recursive else Asttypes.Nonrecursive | _ -> rec_flag in diff --git a/jscomp/syntax/src/res_ast_debugger.ml b/jscomp/syntax/src/res_ast_debugger.ml index 2c9b1bca10..569026d621 100644 --- a/jscomp/syntax/src/res_ast_debugger.ml +++ b/jscomp/syntax/src/res_ast_debugger.ml @@ -171,10 +171,12 @@ module SexpAst = struct | Pstr_recmodule mbs -> Sexp.list [ - Sexp.atom "Pstr_recmodule"; Sexp.list (map_empty ~f:module_binding mbs); + Sexp.atom "Pstr_recmodule"; + Sexp.list (map_empty ~f:module_binding mbs); ] | Pstr_modtype mod_typ_decl -> - Sexp.list [Sexp.atom "Pstr_modtype"; module_type_declaration 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_class _ -> Sexp.atom "Pstr_class" @@ -237,7 +239,8 @@ module SexpAst = struct string lbl.Asttypes.txt; (match opt_mod_type with | None -> Sexp.atom "None" - | Some mod_type -> Sexp.list [Sexp.atom "Some"; module_type mod_type]); + | Some mod_type -> + Sexp.list [Sexp.atom "Some"; module_type mod_type]); module_expression mod_expr; ] | Pmod_apply (call_mod_expr, mod_expr_arg) -> @@ -273,7 +276,8 @@ module SexpAst = struct string lbl.Asttypes.txt; (match opt_mod_type with | None -> Sexp.atom "None" - | Some mod_type -> Sexp.list [Sexp.atom "Some"; module_type mod_type]); + | Some mod_type -> + Sexp.list [Sexp.atom "Some"; module_type mod_type]); module_type mod_type; ] | Pmty_alias longident_loc -> @@ -323,12 +327,14 @@ 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 signature_item s) and signature_item si = let descr = match si.psig_desc with - | Psig_value vd -> Sexp.list [Sexp.atom "Psig_value"; value_description vd] + | Psig_value vd -> + Sexp.list [Sexp.atom "Psig_value"; value_description vd] | Psig_type (flag, type_declarations) -> Sexp.list [ @@ -349,7 +355,8 @@ module SexpAst = struct 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] + 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 -> @@ -475,7 +482,8 @@ module SexpAst = struct Sexp.list [ Sexp.atom "ptyext_constructors"; - Sexp.list (map_empty ~f:extension_constructor te.ptyext_constructors); + Sexp.list + (map_empty ~f:extension_constructor te.ptyext_constructors); ]; Sexp.list [Sexp.atom "ptyext_private"; private_flag te.ptyext_private]; attributes te.ptyext_attributes; @@ -521,7 +529,10 @@ module SexpAst = struct [Sexp.atom "Pcstr_tuple"; Sexp.list (map_empty ~f:core_type types)] | Pcstr_record lds -> Sexp.list - [Sexp.atom "Pcstr_record"; Sexp.list (map_empty ~f:label_declaration lds)] + [ + Sexp.atom "Pcstr_record"; + Sexp.list (map_empty ~f:label_declaration lds); + ] and label_declaration ld = Sexp.list @@ -795,7 +806,9 @@ module SexpAst = struct | Ppat_open (longident_loc, p) -> Sexp.list [ - Sexp.atom "Ppat_open"; longident longident_loc.Location.txt; pattern p; + Sexp.atom "Ppat_open"; + longident longident_loc.Location.txt; + pattern p; ] in Sexp.list [Sexp.atom "pattern"; descr] @@ -805,7 +818,10 @@ module SexpAst = struct | Otag (lbl_loc, attrs, typexpr) -> Sexp.list [ - Sexp.atom "Otag"; string lbl_loc.txt; attributes attrs; core_type typexpr; + Sexp.atom "Otag"; + string lbl_loc.txt; + attributes attrs; + core_type typexpr; ] | Oinherit typexpr -> Sexp.list [Sexp.atom "Oinherit"; core_type typexpr] @@ -830,7 +846,8 @@ module SexpAst = struct Sexp.list (map_empty ~f:(fun (mod_name_loc, typexpr) -> - Sexp.list [longident mod_name_loc.Asttypes.txt; core_type typexpr]) + Sexp.list + [longident mod_name_loc.Asttypes.txt; core_type typexpr]) package_constraints); ] @@ -842,7 +859,10 @@ module SexpAst = struct | Ptyp_arrow (arg_lbl, typ1, typ2) -> Sexp.list [ - Sexp.atom "Ptyp_arrow"; arg_label arg_lbl; core_type typ1; core_type typ2; + Sexp.atom "Ptyp_arrow"; + arg_label arg_lbl; + core_type typ1; + core_type typ2; ] | Ptyp_tuple types -> Sexp.list diff --git a/jscomp/syntax/src/res_comments_table.ml b/jscomp/syntax/src/res_comments_table.ml index a8b1e35d55..b531fde329 100644 --- a/jscomp/syntax/src/res_comments_table.ml +++ b/jscomp/syntax/src/res_comments_table.ml @@ -396,8 +396,10 @@ and walk_structure_item si t comments = | _ 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_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 @@ -406,7 +408,8 @@ and walk_structure_item si t comments = walk_list (module_bindings |> List.map (fun mb -> ModuleBinding mb)) t comments - | Pstr_modtype mod_typ_decl -> walk_module_type_declaration mod_typ_decl 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 -> @@ -417,9 +420,13 @@ and walk_structure_item si 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 + let leading, trailing = + partition_leading_trailing 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 + 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 attach t.leading vd.pval_type.ptyp_loc before; @@ -431,7 +438,9 @@ and walk_type_extension te t comments = partition_leading_trailing 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 + let after_path, rest = + partition_adjacent_trailing te.ptyext_path.loc trailing + in attach t.trailing te.ptyext_path.loc after_path; (* type params *) @@ -456,7 +465,9 @@ and walk_include_declaration incl_decl t comments = attach t.trailing incl_decl.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 + let leading, trailing = + partition_leading_trailing 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 @@ -509,7 +520,8 @@ and walk_signature_item (si : Parsetree.signature_item) t comments = 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_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 @@ -554,7 +566,8 @@ and walk_node node 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 = +and walk_list : ?prev_loc:Location.t -> node list -> t -> Comment.t list -> unit + = fun ?prev_loc l t comments -> match l with | _ when comments = [] -> () @@ -572,7 +585,9 @@ and walk_list : ?prev_loc:Location.t -> node list -> t -> Comment.t list -> unit | Some prev_loc -> (* 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 + 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) else @@ -580,7 +595,9 @@ and walk_list : ?prev_loc:Location.t -> node list -> t -> Comment.t list -> unit 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 in + let leading, _inside, _trailing = + partition_by_loc after_prev curr_loc + in attach t.leading curr_loc leading); walk_node node t inside; walk_list ~prev_loc:curr_loc rest t trailing @@ -635,13 +652,15 @@ and visit_list_but_continue_with_remaining_comments : 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 in + let leading, _inside, _trailing = + partition_by_loc after_prev curr_loc + in let () = attach t.leading curr_loc 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 + visit_list_but_continue_with_remaining_comments ~prev_loc:curr_loc ~get_loc + ~walk_node ~newline_delimited rest t trailing and walk_value_bindings vbs t comments = walk_list (vbs |> List.map (fun vb -> ValueBinding vb)) t comments @@ -661,7 +680,9 @@ and walk_type_param (typexpr, _variance) t comments = walk_core_type 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 + let before_name, rest = + partition_leading_trailing comments td.ptype_name.loc + in attach t.leading td.ptype_name.loc before_name; let after_name, rest = partition_adjacent_trailing td.ptype_name.loc rest in @@ -731,7 +752,8 @@ and walk_label_declaration ld t comments = 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 + ~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 @@ -871,7 +893,9 @@ and walk_expression expr t comments = in if is_block_expr expr2 then walk_expression expr2 t comments else - let leading, inside, trailing = partition_by_loc comments expr2.pexp_loc in + let leading, inside, trailing = + partition_by_loc comments expr2.pexp_loc + in attach t.leading expr2.pexp_loc leading; walk_expression expr2 t inside; attach t.trailing expr2.pexp_loc trailing @@ -895,7 +919,9 @@ and walk_expression expr t comments = in if is_block_expr expr2 then walk_expression expr2 t comments else - let leading, inside, trailing = partition_by_loc comments expr2.pexp_loc in + let leading, inside, trailing = + partition_by_loc comments expr2.pexp_loc + in attach t.leading expr2.pexp_loc leading; walk_expression expr2 t inside; attach t.trailing expr2.pexp_loc trailing @@ -906,7 +932,9 @@ and walk_expression expr t comments = leading; let leading, trailing = partition_leading_trailing comments longident.loc in attach t.leading longident.loc leading; - let after_longident, rest = partition_by_on_same_line longident.loc trailing in + 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 else @@ -947,9 +975,13 @@ and walk_expression expr t comments = attach t.leading {expr.pexp_loc with loc_end = mod_expr.pmod_loc.loc_end} leading; - let leading, trailing = partition_leading_trailing comments string_loc.loc in + 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 + 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 @@ -1123,7 +1155,9 @@ and walk_expression expr t comments = attach t.trailing if_expr.pexp_loc after_expr; comments) in - let leading, inside, trailing = partition_by_loc comments then_expr.pexp_loc in + let leading, inside, trailing = + partition_by_loc comments then_expr.pexp_loc + in let comments = if is_block_expr then_expr then ( let after_expr, trailing = @@ -1146,7 +1180,9 @@ and walk_expression expr t comments = if is_block_expr expr || is_if_then_else_expr expr then walk_expression expr t comments else - let leading, inside, trailing = partition_by_loc comments expr.pexp_loc in + let leading, inside, trailing = + partition_by_loc comments expr.pexp_loc + in attach t.leading expr.pexp_loc leading; walk_expression expr t inside; attach t.trailing expr.pexp_loc trailing) @@ -1183,12 +1219,16 @@ and walk_expression expr t comments = let leading, inside, trailing = partition_by_loc 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 + 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 attach t.leading expr2.pexp_loc leading; walk_expression expr2 t inside; - let after_expr, rest = partition_adjacent_trailing expr2.pexp_loc trailing in + 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 else @@ -1203,10 +1243,14 @@ and walk_expression expr t comments = 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 + let before, inside, after = + partition_by_loc 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 + 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 attach t.leading expr1.pexp_loc before; @@ -1251,7 +1295,9 @@ and walk_expression expr t comments = let before, inside, after = partition_by_loc 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 + let after_expr, rest = + partition_adjacent_trailing expr.pexp_loc after + in walk_expression expr t (List.concat [before; inside; after_expr]); rest) else ( @@ -1309,8 +1355,8 @@ and walk_expression expr t comments = walk_list [Expression parent_expr; Expression member_expr] t comments | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "set")}}, - [(Nolabel, parent_expr); (Nolabel, member_expr); (Nolabel, target_expr)] ) - -> + [(Nolabel, parent_expr); (Nolabel, member_expr); (Nolabel, target_expr)] + ) -> walk_list [Expression parent_expr; Expression member_expr; Expression target_expr] t comments @@ -1362,7 +1408,9 @@ and walk_expression expr t comments = walk_list (props |> List.map (fun (_, e) -> ExprArgument e)) t leading; walk_expression children t inside) else - let after_expr, rest = partition_adjacent_trailing call_expr.pexp_loc after in + 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 | Pexp_fun (_, _, _, _) | Pexp_newtype _ -> ( @@ -1400,7 +1448,9 @@ and walk_expression expr t comments = attach t.trailing typ.ptyp_loc after_typ; if is_block_expr expr then walk_expression expr t comments else - let leading, inside, trailing = partition_by_loc comments expr.pexp_loc in + let leading, inside, trailing = + partition_by_loc comments expr.pexp_loc + in attach t.leading expr.pexp_loc leading; walk_expression expr t inside; attach t.trailing expr.pexp_loc trailing @@ -1421,7 +1471,9 @@ and walk_expr_pararameter (_attrs, _argLbl, expr_opt, pattern) t comments = walk_pattern pattern t inside; match expr_opt with | Some expr -> - let _afterPat, rest = partition_adjacent_trailing pattern.ppat_loc trailing in + let _afterPat, rest = + partition_adjacent_trailing pattern.ppat_loc trailing + in attach t.trailing pattern.ppat_loc trailing; if is_block_expr expr then walk_expression expr t rest else @@ -1453,7 +1505,9 @@ and walk_case (case : Parsetree.case) t comments = (* 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 + 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 comments = match case.pc_guard with @@ -1471,7 +1525,9 @@ and walk_case (case : Parsetree.case) t comments = in if is_block_expr case.pc_rhs then walk_expression case.pc_rhs t comments else - let before, inside, after = partition_by_loc comments case.pc_rhs.pexp_loc in + let before, inside, after = + partition_by_loc comments case.pc_rhs.pexp_loc + in attach t.leading case.pc_rhs.pexp_loc before; walk_expression case.pc_rhs t inside; attach t.trailing case.pc_rhs.pexp_loc after @@ -1721,17 +1777,23 @@ and walk_pattern pat t comments = partition_adjacent_trailing pattern.ppat_loc after_pattern in attach t.trailing pattern.ppat_loc after_pattern; - let before_typ, inside_typ, after_typ = partition_by_loc rest typ.ptyp_loc in + 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 | Ppat_lazy pattern | Ppat_exception pattern -> - let leading, inside, trailing = partition_by_loc comments pattern.ppat_loc in + let leading, inside, trailing = + partition_by_loc comments pattern.ppat_loc + in attach t.leading pattern.ppat_loc leading; walk_pattern 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 + 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 @@ -1744,11 +1806,15 @@ and walk_pattern_record_row row t comments = | ( {Location.txt = Longident.Lident ident; loc = longident_loc}, {Parsetree.ppat_desc = Ppat_var {txt; _}} ) when ident = txt -> - let before_lbl, after_lbl = partition_leading_trailing comments longident_loc in + 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 | longident, pattern -> - let before_lbl, after_lbl = partition_leading_trailing comments longident.loc in + 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; @@ -1834,7 +1900,9 @@ and walk_object_field field t comments = 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 + 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 @@ -1872,7 +1940,8 @@ and walk_package_type package_type t comments = and walk_package_constraints package_constraints t comments = walk_list - (package_constraints |> List.map (fun (li, te) -> PackageConstraint (li, te))) + (package_constraints + |> List.map (fun (li, te) -> PackageConstraint (li, te))) t comments and walk_package_constraint package_constraint t comments = @@ -1885,7 +1954,9 @@ and walk_package_constraint package_constraint t comments = partition_adjacent_trailing longident.loc after_longident in attach t.trailing longident.loc after_longident; - let before_typ, inside_typ, after_typ = partition_by_loc rest typexpr.ptyp_loc in + 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 diff --git a/jscomp/syntax/src/res_core.ml b/jscomp/syntax/src/res_core.ml index bbbbf2cd49..ba2adfd594 100644 --- a/jscomp/syntax/src/res_core.ml +++ b/jscomp/syntax/src/res_core.ml @@ -48,7 +48,8 @@ module Recover = struct match breadcrumbs with | [] -> false | (grammar, _) :: rest -> - if Grammar.is_part_of_list grammar p.Parser.token then true else check rest + if Grammar.is_part_of_list grammar p.Parser.token then true + else check rest in check p.breadcrumbs end @@ -327,8 +328,8 @@ let is_es6_arrow_expression ~in_ternary p = * 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.start_pos.pos_lnum == prev_end_pos.pos_lnum -> true | _ -> false))) | _ -> false) @@ -472,7 +473,9 @@ 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 = + mk_loc 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)) @@ -551,7 +554,8 @@ let remove_module_name_from_punned_field_value exp = { exp with pexp_desc = - Pexp_ident {path_ident with txt = Lident (Longident.last path_ident.txt)}; + Pexp_ident + {path_ident with txt = Lident (Longident.last path_ident.txt)}; } | _ -> exp @@ -584,7 +588,8 @@ let rec parse_lident p = let loc = mk_loc start_pos p.prev_end_pos in (ident, loc) | Eof -> - Parser.err ~start_pos p (Diagnostics.unexpected p.Parser.token p.breadcrumbs); + Parser.err ~start_pos p + (Diagnostics.unexpected p.Parser.token p.breadcrumbs); ("_", mk_loc start_pos p.prev_end_pos) | _ -> ( match recover_lident p with @@ -598,8 +603,8 @@ let parse_ident ~msg ~start_pos p = let loc = mk_loc start_pos p.prev_end_pos in (ident, loc) | token - when Token.is_keyword token && p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum - -> + when Token.is_keyword token + && p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> let token_txt = Token.to_string token in let msg = "`" ^ token_txt @@ -694,7 +699,9 @@ let parse_value_path_tail p start_pos ident = 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, "_")) + (mk_loc start_pos p.prev_end_pos) in loop p ident @@ -716,7 +723,9 @@ let parse_module_long_ident_tail ~lowercase p start_pos ident = | _ -> Location.mkloc lident (mk_loc start_pos end_pos)) | 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, "_")) + (mk_loc start_pos p.prev_end_pos) in loop p ident @@ -1095,7 +1104,8 @@ let rec parse_pattern ?(alias = true) ?(or_ = true) p = match suffix with | Some _ -> Parser.err p - (Diagnostics.message (ErrorMessages.poly_var_int_with_suffix i)) + (Diagnostics.message + (ErrorMessages.poly_var_int_with_suffix i)) | None -> () in Parser.next p; @@ -1128,7 +1138,8 @@ let rec parse_pattern ?(alias = true) ?(or_ = true) p = | 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 + skip_tokens_and_maybe_retry p + ~is_start_of_grammar:Grammar.is_atomic_pattern_start with | None -> Recover.default_pattern () | Some () -> parse_pattern p) @@ -1218,7 +1229,8 @@ and parse_constrained_pattern p = and parse_constrained_pattern_region p = match p.Parser.token with - | token when Grammar.is_pattern_start token -> Some (parse_constrained_pattern p) + | token when Grammar.is_pattern_start token -> + Some (parse_constrained_pattern p) | _ -> None and parse_optional_label p = @@ -1307,8 +1319,8 @@ and parse_record_pattern ~attrs p = and parse_tuple_pattern ~attrs ~first ~start_pos p = let patterns = first - :: parse_comma_delimited_region p ~grammar:Grammar.PatternList ~closing:Rparen - ~f:parse_constrained_pattern_region + :: parse_comma_delimited_region p ~grammar:Grammar.PatternList + ~closing:Rparen ~f:parse_constrained_pattern_region in Parser.expect Rparen p; let () = @@ -1389,7 +1401,8 @@ and parse_array_pattern ~attrs p = let start_pos = p.start_pos in Parser.expect Lbracket p; let patterns = - parse_comma_delimited_region p ~grammar:Grammar.PatternList ~closing:Rbracket + parse_comma_delimited_region p ~grammar:Grammar.PatternList + ~closing:Rbracket ~f:(parse_non_spread_pattern ~msg:ErrorMessages.array_pattern_spread) in Parser.expect Rbracket p; @@ -1423,7 +1436,9 @@ and parse_constructor_pattern_args p constr start_pos attrs = | patterns -> Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) patterns) in - Ast_helper.Pat.construct ~loc:(mk_loc start_pos p.prev_end_pos) ~attrs constr args + Ast_helper.Pat.construct + ~loc:(mk_loc start_pos p.prev_end_pos) + ~attrs constr args and parse_variant_pattern_args p ident start_pos attrs = let lparen = p.start_pos in @@ -1452,7 +1467,9 @@ and parse_variant_pattern_args p ident start_pos attrs = Some (Ast_helper.Pat.tuple ~loc:(mk_loc lparen p.end_pos) 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:(mk_loc start_pos p.prev_end_pos) + ~attrs ident args and parse_expr ?(context = OrdinaryExpr) p = let expr = parse_operand_expr ~context p in @@ -1476,12 +1493,12 @@ and parse_ternary_expr left_operand p = loc_end = false_branch.Parsetree.pexp_loc.loc_end; } in - Ast_helper.Exp.ifthenelse ~attrs:[ternary_attr] ~loc left_operand true_branch - (Some false_branch) + 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 = +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; (* Parsing function parameters and attributes: @@ -1504,10 +1521,12 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None) ?co in match parameters with | TermParameter p :: rest -> - TermParameter {p with attrs = update_attrs p.attrs; pos = update_pos p.pos} + TermParameter + {p with attrs = update_attrs p.attrs; pos = update_pos p.pos} :: rest | TypeParameter p :: rest -> - TypeParameter {p with attrs = update_attrs p.attrs; pos = update_pos p.pos} + TypeParameter + {p with attrs = update_attrs p.attrs; pos = update_pos p.pos} :: rest | [] -> parameters in @@ -1520,7 +1539,8 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None) ?co (* 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} + TermParameter + {term_param with dotted = dot_in_type || term_param.dotted} :: rest | [] -> [] in @@ -1596,8 +1616,11 @@ and parse_es6_arrow_expression ?(arrow_attrs = []) ?(arrow_start_pos = None) ?co let uncurried = p.uncurried_config |> Res_uncurried.from_dotted ~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) + 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, @@ -1663,8 +1686,8 @@ and parse_parameter p = 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 + Ast_helper.Pat.constraint_ ~attrs:(prop_loc_attr :: attrs) ~loc + pat typ in ([], Asttypes.Labelled lbl_name, pat) | As -> @@ -1733,8 +1756,8 @@ and parse_parameter p = and parse_parameter_list p = let parameters = - parse_comma_delimited_region ~grammar:Grammar.ParameterList ~f:parse_parameter - ~closing:Rparen p + parse_comma_delimited_region ~grammar:Grammar.ParameterList + ~f:parse_parameter ~closing:Rparen p in Parser.expect Rparen p; parameters @@ -1939,9 +1962,11 @@ and parse_atomic_expr p = Recover.default_expr () | token -> ( let err_pos = p.prev_end_pos in - Parser.err ~start_pos:err_pos p (Diagnostics.unexpected token p.breadcrumbs); + Parser.err ~start_pos:err_pos p + (Diagnostics.unexpected token p.breadcrumbs); match - skip_tokens_and_maybe_retry p ~is_start_of_grammar:Grammar.is_atomic_expr_start + skip_tokens_and_maybe_retry p + ~is_start_of_grammar:Grammar.is_atomic_expr_start with | None -> Recover.default_expr () | Some () -> parse_atomic_expr p) @@ -2066,11 +2091,12 @@ and parse_primary_expr ~operand ?(no_call = false) p = | 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 - -> + | Lparen + when no_call = false && p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> loop p (parse_call_expr p expr) | Backtick - when no_call = false && p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum -> ( + when no_call = false && p.prev_end_pos.pos_lnum == p.start_pos.pos_lnum + -> ( match expr.pexp_desc with | Pexp_ident long_ident -> parse_template_expr ~prefix:long_ident p | _ -> @@ -2122,8 +2148,9 @@ 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 - -> + when is_es6_arrow_expression + ~in_ternary:(context = TernaryTrueBranchExpr) + p -> let arrow_attrs = !attrs in let () = attrs := [] in parse_async_arrow_expression ~arrow_attrs p @@ -2136,7 +2163,9 @@ and parse_operand_expr ~context p = | _ -> if context != WhenExpr - && is_es6_arrow_expression ~in_ternary:(context = TernaryTrueBranchExpr) p + && is_es6_arrow_expression + ~in_ternary:(context = TernaryTrueBranchExpr) + p then let arrow_attrs = !attrs in let () = attrs := [] in @@ -2412,8 +2441,8 @@ and over_parse_constrained_or_coerced_or_arrow_expression p expr = ]) |> Doc.to_string ~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 ~start_pos:expr.pexp_loc.loc_start + ~end_pos: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 @@ -2691,7 +2720,8 @@ and parse_jsx p = Parser.expect LessThan p; let jsx_expr = match p.Parser.token with - | Lident _ | Uident _ -> parse_jsx_opening_or_self_closing_element ~start_pos p + | Lident _ | Uident _ -> + parse_jsx_opening_or_self_closing_element ~start_pos p | GreaterThan -> (* fragment: <> foo *) parse_jsx_fragment p @@ -2860,7 +2890,9 @@ and parse_braced_or_record_expr p = Parser.next p; let field_expr = parse_expr p in Parser.optional p Comma |> ignore; - let expr = parse_record_expr_with_string_keys ~start_pos (field, field_expr) p in + let expr = + parse_record_expr_with_string_keys ~start_pos (field, field_expr) p + in Parser.expect Rbrace p; expr | _ -> ( @@ -2923,7 +2955,8 @@ and parse_braced_or_record_expr p = Parser.next p; let value_or_constructor = match start_token with - | Uident _ -> remove_module_name_from_punned_field_value value_or_constructor + | Uident _ -> + remove_module_name_from_punned_field_value value_or_constructor | _ -> value_or_constructor in let expr = @@ -2943,7 +2976,9 @@ and parse_braced_or_record_expr p = Ast_helper.Exp.record ~loc [(path_ident, field_expr)] None | _ -> Parser.expect Comma p; - let expr = parse_record_expr ~start_pos [(path_ident, field_expr)] p in + let expr = + parse_record_expr ~start_pos [(path_ident, field_expr)] p + in Parser.expect Rbrace p; expr) (* error case *) @@ -2963,7 +2998,9 @@ and parse_braced_or_record_expr p = Parser.expect Rbrace p; expr) | Semicolon -> - let expr = parse_expr_block ~first:(Ast_helper.Exp.ident path_ident) p in + let expr = + parse_expr_block ~first:(Ast_helper.Exp.ident path_ident) p + in Parser.expect Rbrace p; let loc = mk_loc start_pos p.prev_end_pos in let braces = make_braces_attr loc in @@ -3271,7 +3308,8 @@ and parse_async_arrow_expression ?(arrow_attrs = []) p = let start_pos = p.Parser.start_pos 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) + parse_es6_arrow_expression + ~arrow_attrs:(async_attr :: arrow_attrs) ~arrow_start_pos:(Some start_pos) p and parse_await_expression p = @@ -3635,7 +3673,8 @@ and parse_argument2 p ~dotted : argument option = | 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 = parse_constrained_or_coerced_expr p} and parse_call_expr p fun_expr = Parser.expect Lparen p; @@ -3904,8 +3943,8 @@ and parse_list_expr ~start_pos p = make_list_expression (mk_loc start_pos end_pos) 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 + parse_comma_delimited_reversed_list p ~grammar:Grammar.ListExpr + ~closing:Rbrace ~f:parse_spread_expr_region_with_loc in Parser.expect Rbrace p; let loc = mk_loc start_pos p.prev_end_pos in @@ -4003,7 +4042,9 @@ and parse_poly_type_expr p = let typ = Ast_helper.Typ.var ~loc:var.loc var.txt in let return_type = parse_typ_expr ~alias:false p in let loc = mk_loc typ.Parsetree.ptyp_loc.loc_start p.prev_end_pos in - let t_fun = Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ return_type 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 | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt) @@ -4098,7 +4139,8 @@ and parse_atomic_typ_expr ~attrs p = | 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 + skip_tokens_and_maybe_retry p + ~is_start_of_grammar:Grammar.is_atomic_typ_expr_start with | Some () -> parse_atomic_typ_expr ~attrs p | None -> @@ -4135,7 +4177,8 @@ and parse_package_constraints p = (type_constr, typ) in let rest = - parse_region ~grammar:Grammar.PackageConstraint ~f:parse_package_constraint p + parse_region ~grammar:Grammar.PackageConstraint ~f:parse_package_constraint + p in first :: rest @@ -4276,7 +4319,13 @@ and parse_type_parameter p = {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 = typ_with_attributes; + start_pos; + } else None (* (int, ~x:string, float) *) @@ -4292,8 +4341,8 @@ and parse_type_parameters p = [{dotted = false; attrs = []; label = Nolabel; typ; start_pos}] | _ -> let params = - parse_comma_delimited_region ~grammar:Grammar.TypeParameters ~closing:Rparen - ~f:parse_type_parameter p + parse_comma_delimited_region ~grammar:Grammar.TypeParameters + ~closing:Rparen ~f:parse_type_parameter p in Parser.expect Rparen p; params @@ -4342,7 +4391,8 @@ and parse_es6_arrow_type ~attrs p = 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 = arg_lbl; typ; start_pos} + (param_num, t, arity) -> let uncurried = p.uncurried_config |> Res_uncurried.from_dotted ~dotted in @@ -4422,13 +4472,16 @@ and parse_arrow_type_rest ~es6_arrow ~start_pos typ p = Parser.next p; let return_type = parse_typ_expr ~alias:false p in let loc = mk_loc start_pos p.prev_end_pos in - let arrow_typ = Ast_helper.Typ.arrow ~loc Asttypes.Nolabel typ return_type 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 | _ -> typ and parse_typ_expr_region p = - if Grammar.is_typ_expr_start p.Parser.token then Some (parse_typ_expr p) else None + if Grammar.is_typ_expr_start p.Parser.token then Some (parse_typ_expr p) + else None and parse_tuple_type ~attrs ~first ~start_pos p = let typexprs = @@ -4478,7 +4531,10 @@ and parse_type_constructor_args ~constr_name p = Doc.text "Type parameters require angle brackets:"; Doc.indent (Doc.concat - [Doc.line; ResPrinter.print_typ_expr typ CommentTable.empty]); + [ + Doc.line; + ResPrinter.print_typ_expr typ CommentTable.empty; + ]); ]) |> Doc.to_string ~width:80 in @@ -4646,8 +4702,9 @@ 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 + parse_comma_delimited_region + ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace + ~f:parse_string_field_declaration p in Parser.expect Rbrace p; let loc = mk_loc start_pos p.prev_end_pos in @@ -4778,8 +4835,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 + parse_comma_delimited_region ~grammar:Grammar.TypExprList + ~closing:Rparen ~f:parse_typ_expr_region p in Parser.expect Rparen p; Parsetree.Pcstr_tuple args) @@ -4939,8 +4996,8 @@ and parse_type_params ~parent p = Parser.leave_breadcrumb p Grammar.TypeParams; Parser.next p; let params = - parse_comma_delimited_region ~grammar:Grammar.TypeParams ~closing:GreaterThan - ~f:parse_type_param p + parse_comma_delimited_region ~grammar:Grammar.TypeParams + ~closing:GreaterThan ~f:parse_type_param p in let () = match p.token with @@ -4957,7 +5014,8 @@ and parse_type_params ~parent p = Doc.concat [ ResPrinter.print_longident parent.Location.txt; - ResPrinter.print_type_params params CommentTable.empty; + ResPrinter.print_type_params params + CommentTable.empty; ]; ]); ]) @@ -5033,7 +5091,8 @@ and parse_type_equation_or_constr_decl p = in let uncurried = p.uncurried_config <> Legacy in let arrow_type = - if uncurried then Ast_uncurried.uncurried_type ~loc ~arity:1 arrow_type + if uncurried then + Ast_uncurried.uncurried_type ~loc ~arity:1 arrow_type else arrow_type in let typ = parse_type_alias p arrow_type in @@ -5052,7 +5111,8 @@ and parse_type_equation_or_constr_decl p = in ( None, Asttypes.Public, - Parsetree.Ptype_variant (parse_type_constructor_declarations p ?first) )) + Parsetree.Ptype_variant (parse_type_constructor_declarations p ?first) + )) | t -> Parser.err p (Diagnostics.uident t); (* TODO: is this a good idea? *) @@ -5128,7 +5188,9 @@ and parse_record_or_object_decl p = 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 typ_obj = + parse_arrow_type_rest ~es6_arrow:true ~start_pos typ_obj p + in (Some typ_obj, Public, Ptype_abstract) else let kind = Parsetree.Ptype_record (dot_field :: fields) in @@ -5164,8 +5226,9 @@ and parse_record_or_object_decl p = | Oinherit ct -> Oinherit ct in first - :: parse_comma_delimited_region ~grammar:Grammar.StringFieldDeclarations - ~closing:Rbrace ~f:parse_string_field_declaration p + :: parse_comma_delimited_region + ~grammar:Grammar.StringFieldDeclarations ~closing:Rbrace + ~f:parse_string_field_declaration p in Parser.expect Rbrace p; let loc = mk_loc start_pos p.prev_end_pos in @@ -5346,7 +5409,8 @@ and parse_tag_spec_first p = Parser.expect Bar p; [Parsetree.Rinherit typ; parse_tag_spec p]) -and parse_polymorphic_variant_type_spec_hash ~attrs ~full p : Parsetree.row_field = +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 let rec loop p = @@ -5663,7 +5727,9 @@ and parse_structure_item_region p = Some (Ast_helper.Str.include_ ~loc include_statement) | Module -> Parser.begin_region p; - let structure_item = parse_module_or_module_type_impl_or_pack_expr ~attrs p in + 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; @@ -5703,7 +5769,9 @@ and parse_structure_item_region p = (Diagnostics.message (ErrorMessages.attribute_without_node attr)); let expr = parse_expr p in Some - (Ast_helper.Str.eval ~loc:(mk_loc p.start_pos p.prev_end_pos) ~attrs expr) + (Ast_helper.Str.eval + ~loc:(mk_loc p.start_pos p.prev_end_pos) + ~attrs expr) | _ -> None) [@@progress Parser.next, Parser.expect, LoopProgress.list_rest] @@ -5735,7 +5803,8 @@ and parse_atomic_module_expr p = Parser.next p; let mod_expr = match p.token with - | Rparen -> Ast_helper.Mod.structure ~loc:(mk_loc start_pos p.prev_end_pos) [] + | Rparen -> + Ast_helper.Mod.structure ~loc:(mk_loc start_pos p.prev_end_pos) [] | _ -> parse_constrained_mod_expr p in Parser.expect Rparen p; @@ -5840,7 +5909,9 @@ and parse_functor_args p = Parser.expect Rparen p; match args with | [] -> - [([], Location.mkloc "*" (mk_loc start_pos p.prev_end_pos), None, start_pos)] + [ + ([], Location.mkloc "*" (mk_loc start_pos p.prev_end_pos), None, start_pos); + ] | args -> args and parse_functor_module_expr p = @@ -5860,7 +5931,8 @@ and parse_functor_module_expr p = | Some mod_type -> Ast_helper.Mod.constraint_ ~loc: - (mk_loc mod_expr.pmod_loc.loc_start mod_type.Parsetree.pmty_loc.loc_end) + (mk_loc mod_expr.pmod_loc.loc_start + mod_type.Parsetree.pmty_loc.loc_end) mod_expr mod_type | None -> mod_expr in @@ -5904,7 +5976,10 @@ and parse_module_expr p = if is_es6_arrow_functor p then parse_functor_module_expr p else parse_primary_mod_expr p in - {mod_expr with pmod_attributes = List.concat [mod_expr.pmod_attributes; attrs]} + { + mod_expr with + pmod_attributes = List.concat [mod_expr.pmod_attributes; attrs]; + } and parse_constrained_mod_expr p = let mod_expr = parse_module_expr p in @@ -5917,7 +5992,8 @@ and parse_constrained_mod_expr p = | _ -> 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) + if Grammar.is_mod_expr_start p.Parser.token then + Some (parse_constrained_mod_expr p) else None and parse_module_application p mod_expr = @@ -6286,7 +6362,9 @@ and parse_signature_item_region p = 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 + Ast_helper.Incl.mk + ~loc:(mk_loc start_pos p.prev_end_pos) + ~attrs module_type in parse_newline_or_semicolon_signature p; let loc = mk_loc start_pos p.prev_end_pos in diff --git a/jscomp/syntax/src/res_diagnostics.ml b/jscomp/syntax/src/res_diagnostics.ml index 8159321a66..7df65840bb 100644 --- a/jscomp/syntax/src/res_diagnostics.ml +++ b/jscomp/syntax/src/res_diagnostics.ml @@ -145,7 +145,8 @@ 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.start_pos; loc_end = d.end_pos; loc_ghost = false}; msg = explain d; sub = []; if_highlight = ""; diff --git a/jscomp/syntax/src/res_doc.ml b/jscomp/syntax/src/res_doc.ml index fa4ae9ce08..301c0520bd 100644 --- a/jscomp/syntax/src/res_doc.ml +++ b/jscomp/syntax/src/res_doc.ml @@ -315,7 +315,12 @@ let debug t = text "ifBreaks("; indent (concat - [line; to_doc true_doc; concat [text ","; line]; to_doc false_doc]); + [ + line; + to_doc true_doc; + concat [text ","; line]; + to_doc false_doc; + ]); line; text ")"; ]) diff --git a/jscomp/syntax/src/res_driver.ml b/jscomp/syntax/src/res_driver.ml index cd47568ac9..64039e7656 100644 --- a/jscomp/syntax/src/res_driver.ml +++ b/jscomp/syntax/src/res_driver.ml @@ -18,7 +18,8 @@ type 'diagnostics parsing_engine = { for_printer:bool -> filename:string -> (Parsetree.signature, 'diagnostics) parse_result; - string_of_diagnostics: source:string -> filename:string -> 'diagnostics -> unit; + string_of_diagnostics: + source:string -> filename:string -> 'diagnostics -> unit; } type print_engine = { diff --git a/jscomp/syntax/src/res_driver.mli b/jscomp/syntax/src/res_driver.mli index c704a17a08..2b717013cc 100644 --- a/jscomp/syntax/src/res_driver.mli +++ b/jscomp/syntax/src/res_driver.mli @@ -16,7 +16,8 @@ type 'diagnostics parsing_engine = { for_printer:bool -> filename:string -> (Parsetree.signature, 'diagnostics) parse_result; - string_of_diagnostics: source:string -> filename:string -> 'diagnostics -> unit; + string_of_diagnostics: + source:string -> filename:string -> 'diagnostics -> unit; } val parse_implementation_from_source : diff --git a/jscomp/syntax/src/res_driver_ml_parser.ml b/jscomp/syntax/src/res_driver_ml_parser.ml index e58e6fbc77..b910d49fac 100644 --- a/jscomp/syntax/src/res_driver_ml_parser.ml +++ b/jscomp/syntax/src/res_driver_ml_parser.ml @@ -19,7 +19,9 @@ let extract_ocaml_concrete_syntax filename = 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 + let comment = + Res_comment.from_ocaml_comment ~loc ~prev_tok_end_pos ~txt + in comment_data := comment :: !comment_data; next loc.Location.loc_end () | OcamlParser.STRING (_txt, None) -> diff --git a/jscomp/syntax/src/res_outcome_printer.ml b/jscomp/syntax/src/res_outcome_printer.ml index 7fe7eb0644..08f260c368 100644 --- a/jscomp/syntax/src/res_outcome_printer.ml +++ b/jscomp/syntax/src/res_outcome_printer.ml @@ -54,14 +54,17 @@ 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 print_out_ident_doc ?(allow_uident = true) + (ident : Outcometree.out_ident) = match ident with | Oide_ident s -> Printer.print_ident_like ~allow_uident s | Oide_dot (ident, s) -> Doc.concat [print_out_ident_doc 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] + [ + print_out_ident_doc call; Doc.lparen; print_out_ident_doc arg; Doc.rparen; + ] let print_out_attribute_doc (out_attribute : Outcometree.out_attribute) = Doc.concat [Doc.text "@"; Doc.text out_attribute.oattr_name] @@ -72,7 +75,8 @@ let print_out_attributes_doc (attrs : Outcometree.out_attribute list) = | 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 print_out_attribute_doc attrs)); Doc.line; ] @@ -83,7 +87,8 @@ let rec collect_arrow_args (out_type : Outcometree.out_type) args = collect_arrow_args return_type (arg :: args) | _ as return_type -> (List.rev args, return_type) -let rec collect_functor_args (out_module_type : Outcometree.out_module_type) args = +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 @@ -158,9 +163,11 @@ let rec print_out_type_doc (out_type : Outcometree.out_type) = | 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 + | Otyp_constr (out_ident, []) -> + print_out_ident_doc ~allow_uident:false out_ident | Otyp_manifest (typ1, typ2) -> - Doc.concat [print_out_type_doc typ1; Doc.text " = "; print_out_type_doc 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 | Otyp_stuff txt -> Doc.text txt | Otyp_var (ng, s) -> @@ -274,7 +281,8 @@ and print_out_arrow_type ~uncurried typ = (* 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 (lbl_len - 1), + Doc.text "=?" ) | _ -> (lbl, Doc.nil) in Doc.group @@ -495,7 +503,8 @@ and print_record_declaration_doc ~inline rows = 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)) + Format.pp_print_string fmt + (Doc.to_string ~width:80 (print_out_type_doc out_type)) let print_type_parameter_doc (typ, (co, cn)) = Doc.concat @@ -612,7 +621,8 @@ let rec print_out_sig_item_doc ?(print_name_as_is = false) Doc.soft_line; Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) - (List.map print_type_parameter_doc out_type_decl.otype_params); + (List.map print_type_parameter_doc + out_type_decl.otype_params); ]); Doc.trailing_comma; Doc.soft_line; @@ -815,7 +825,8 @@ and print_out_extension_constructor_doc (out_ext.oext_name, out_ext.oext_args, out_ext.oext_ret_type); ]) -and print_out_type_extension_doc (type_extension : Outcometree.out_type_extension) = +and print_out_type_extension_doc + (type_extension : Outcometree.out_type_extension) = let type_params = match type_extension.otyext_params with | [] -> Doc.nil diff --git a/jscomp/syntax/src/res_parens.ml b/jscomp/syntax/src/res_parens.ml index 50ce988e65..bf946c3159 100644 --- a/jscomp/syntax/src/res_parens.ml +++ b/jscomp/syntax/src/res_parens.ml @@ -45,8 +45,8 @@ let call_expr 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.is_underscore_apply_sugar expr -> Nothing | { pexp_desc = @@ -98,8 +98,8 @@ let unary_expr_operand 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.is_underscore_apply_sugar expr -> Nothing | { pexp_desc = @@ -124,8 +124,8 @@ 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.is_underscore_apply_sugar expr -> Nothing | { pexp_desc = @@ -147,7 +147,8 @@ let sub_binary_expr_operand parent_operator child_operator = 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) + && not + (ParsetreeViewer.flattenable_operators parent_operator child_operator) || (* a && b || c, add parens to (a && b) for readability, who knows the difference by heart… *) (parent_operator = "||" && child_operator = "&&") @@ -208,16 +209,16 @@ let lazy_or_assert_or_await_expr_rhs ?(in_await = false) expr = 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 + if in_await && not (binary_operator_inside_await_needs_parens 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.is_underscore_apply_sugar expr -> Nothing | { pexp_desc = @@ -238,7 +239,8 @@ let is_negative_constant constant = 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 is_neg i -> + true | _ -> false let field_expr expr = @@ -262,8 +264,8 @@ let field_expr expr = } -> 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_fun _} + when ParsetreeViewer.is_underscore_apply_sugar expr -> Nothing | { pexp_desc = diff --git a/jscomp/syntax/src/res_parens.mli b/jscomp/syntax/src/res_parens.mli index e36d4f9307..28e35a6345 100644 --- a/jscomp/syntax/src/res_parens.mli +++ b/jscomp/syntax/src/res_parens.mli @@ -11,7 +11,8 @@ val rhs_binary_expr_operand : string -> Parsetree.expression -> bool val flatten_operand_rhs : 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 lazy_or_assert_or_await_expr_rhs : + ?in_await:bool -> Parsetree.expression -> kind val field_expr : Parsetree.expression -> kind diff --git a/jscomp/syntax/src/res_parser.ml b/jscomp/syntax/src/res_parser.ml index 5bc64365f1..4246290921 100644 --- a/jscomp/syntax/src/res_parser.ml +++ b/jscomp/syntax/src/res_parser.ml @@ -98,7 +98,9 @@ let rec next ?prev_end_pos p = let next_unsafe 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 start_pos, end_pos, token = + Scanner.scan_template_literal_token p.scanner + in p.token <- token; p.prev_end_pos <- p.end_pos; p.start_pos <- start_pos; diff --git a/jscomp/syntax/src/res_parsetree_viewer.ml b/jscomp/syntax/src/res_parsetree_viewer.ml index fd0741c156..35e02d8725 100644 --- a/jscomp/syntax/src/res_parsetree_viewer.ml +++ b/jscomp/syntax/src/res_parsetree_viewer.ml @@ -189,7 +189,9 @@ let fun_expr expr = pexp_desc = Pexp_fun (lbl, default_expr, pattern, return_expr); pexp_attributes = []; } -> - let parameter = Parameter {attrs = []; lbl; default_expr; pat = pattern} in + let parameter = + Parameter {attrs = []; lbl; default_expr; pat = pattern} + in collect ~uncurried ~n_fun:(n_fun + 1) attrs_before (parameter :: acc) return_expr (* If a fun has an attribute, then it stops here and makes currying. @@ -349,7 +351,9 @@ 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) + not + (is_equality_operator parent_operator + && is_equality_operator child_operator) else false let rec has_if_let_attribute attrs = @@ -439,7 +443,9 @@ let collect_if_expressions expr = {pc_rhs = else_expr}; ] ) when is_if_let_expr expr -> - collect ((expr_loc, IfLet (pattern, condition), then_expr) :: acc) else_expr + collect + ((expr_loc, IfLet (pattern, condition), then_expr) :: acc) + else_expr | _ -> (List.rev acc, Some expr) in collect [] expr diff --git a/jscomp/syntax/src/res_parsetree_viewer.mli b/jscomp/syntax/src/res_parsetree_viewer.mli index 41fd93e9b0..d270e05e0e 100644 --- a/jscomp/syntax/src/res_parsetree_viewer.mli +++ b/jscomp/syntax/src/res_parsetree_viewer.mli @@ -30,7 +30,8 @@ type function_attributes_info = { } (* determines whether a function is async and/or uncurried based on the given attributes *) -val process_function_attributes : Parsetree.attributes -> function_attributes_info +val process_function_attributes : + Parsetree.attributes -> function_attributes_info val has_await_attribute : Parsetree.attributes -> bool @@ -101,7 +102,8 @@ val collect_ternary_parts : val parameters_should_hug : fun_param_kind list -> bool val filter_ternary_attributes : Parsetree.attributes -> Parsetree.attributes -val filter_fragile_match_attributes : Parsetree.attributes -> Parsetree.attributes +val filter_fragile_match_attributes : + Parsetree.attributes -> Parsetree.attributes val is_jsx_expression : Parsetree.expression -> bool val has_jsx_attribute : Parsetree.attributes -> bool diff --git a/jscomp/syntax/src/res_printer.ml b/jscomp/syntax/src/res_printer.ml index 7d3307a49e..f9d370af46 100644 --- a/jscomp/syntax/src/res_printer.ml +++ b/jscomp/syntax/src/res_printer.ml @@ -133,7 +133,8 @@ let print_multiline_comment_content txt = Doc.text "*/"; ] -let print_trailing_comment (prev_loc : Location.t) (node_loc : Location.t) comment = +let print_trailing_comment (prev_loc : Location.t) (node_loc : Location.t) + comment = let single_line = Comment.is_single_line_comment comment in let content = let txt = Comment.txt comment in @@ -214,7 +215,8 @@ let print_comments_inside cmt_tbl loc = let cmts_doc = Doc.concat (Doc.soft_line :: List.rev (cmt_doc :: acc)) in let doc = Doc.breakable_group ~force_break - (Doc.concat [Doc.if_breaks (Doc.indent cmts_doc) cmts_doc; Doc.soft_line]) + (Doc.concat + [Doc.if_breaks (Doc.indent cmts_doc) cmts_doc; Doc.soft_line]) in doc | comment :: rest -> @@ -592,7 +594,8 @@ and print_structure_item ~state (si : Parsetree.structure_item) cmt_tbl = Doc.concat [ print_attributes ~state attrs cmt_tbl; - Doc.concat [print_extension ~state ~at_module_lvl:true extension cmt_tbl]; + Doc.concat + [print_extension ~state ~at_module_lvl:true extension cmt_tbl]; ] | Pstr_include include_declaration -> print_include_declaration ~state include_declaration cmt_tbl @@ -610,7 +613,8 @@ and print_structure_item ~state (si : Parsetree.structure_item) cmt_tbl = 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_typext type_extension -> + print_type_extension ~state type_extension cmt_tbl | Pstr_class _ | Pstr_class_type _ -> Doc.nil and print_type_extension ~state (te : Parsetree.type_extension) cmt_tbl = @@ -741,13 +745,16 @@ and print_mod_type ~state mod_type cmt_tbl = [ Doc.lbrace; Doc.indent - (Doc.concat [Doc.line; print_signature ~state signature cmt_tbl]); + (Doc.concat + [Doc.line; print_signature ~state signature cmt_tbl]); Doc.line; Doc.rbrace; ]) in Doc.concat - [print_attributes ~state mod_type.pmty_attributes cmt_tbl; signature_doc] + [ + print_attributes ~state mod_type.pmty_attributes cmt_tbl; signature_doc; + ] | Pmty_functor _ -> let parameters, return_type = ParsetreeViewer.functor_type mod_type in let parameters_doc = @@ -758,7 +765,9 @@ and print_mod_type ~state mod_type cmt_tbl = {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] in + let doc = + Doc.concat [attrs; print_mod_type ~state mod_type cmt_tbl] + in print_comments doc cmt_tbl cmt_loc | params -> Doc.group @@ -805,7 +814,8 @@ and print_mod_type ~state mod_type cmt_tbl = [ (if lbl.txt = "_" then Doc.nil else Doc.text ": "); - print_mod_type ~state mod_type cmt_tbl; + print_mod_type ~state mod_type + cmt_tbl; ]); ] in @@ -819,7 +829,8 @@ and print_mod_type ~state mod_type cmt_tbl = 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 + if Parens.mod_type_functor_return return_type then add_parens doc + else doc in Doc.group (Doc.concat @@ -833,7 +844,8 @@ and print_mod_type ~state mod_type cmt_tbl = | Pmty_extension extension -> print_extension ~state ~at_module_lvl:false extension cmt_tbl | Pmty_alias longident -> - Doc.concat [Doc.text "module "; print_longident_location longident cmt_tbl] + Doc.concat + [Doc.text "module "; print_longident_location longident cmt_tbl] | Pmty_with (mod_type, with_constraints) -> let operand = let doc = print_mod_type ~state mod_type cmt_tbl in @@ -845,7 +857,10 @@ 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; + print_with_constraints ~state with_constraints cmt_tbl; + ]); ]) in let attrs_already_printed = @@ -900,7 +915,8 @@ and print_with_constraint ~state (with_constraint : Parsetree.with_constraint) Doc.group (print_type_declaration ~state ~name:(print_lident_path longident cmt_tbl) - ~equal_sign:":=" ~rec_flag:Doc.nil 0 type_declaration CommentTable.empty) + ~equal_sign:":=" ~rec_flag:Doc.nil 0 type_declaration + CommentTable.empty) | Pwith_modsubst ({txt = longident1}, {txt = longident2}) -> Doc.concat [ @@ -931,7 +947,8 @@ and print_signature_item ~state (si : Parsetree.signature_item) cmt_tbl = | 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_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 -> @@ -950,7 +967,8 @@ and print_signature_item ~state (si : Parsetree.signature_item) cmt_tbl = Doc.concat [ print_attributes ~state attrs cmt_tbl; - Doc.concat [print_extension ~state ~at_module_lvl:true extension cmt_tbl]; + Doc.concat + [print_extension ~state ~at_module_lvl:true extension cmt_tbl]; ] | Psig_class _ | Psig_class_type _ -> Doc.nil @@ -987,7 +1005,8 @@ and print_rec_module_declaration ~state md cmt_tbl i = body; ] -and print_module_declaration ~state (md : Parsetree.module_declaration) cmt_tbl = +and print_module_declaration ~state (md : Parsetree.module_declaration) cmt_tbl + = let body = match md.pmd_type.pmty_desc with | Parsetree.Pmty_alias longident -> @@ -1002,8 +1021,8 @@ and print_module_declaration ~state (md : Parsetree.module_declaration) cmt_tbl body; ] -and print_open_description ~state (open_description : Parsetree.open_description) - cmt_tbl = +and print_open_description ~state + (open_description : Parsetree.open_description) cmt_tbl = Doc.concat [ print_attributes ~state open_description.popen_attributes cmt_tbl; @@ -1187,8 +1206,8 @@ and print_type_declaration ~state ~name ~equal_sign ~rec_flag i [ manifest; Doc.concat [Doc.space; Doc.text equal_sign]; - print_constructor_declarations ~state ~private_flag:td.ptype_private cds - cmt_tbl; + print_constructor_declarations ~state ~private_flag:td.ptype_private + cds cmt_tbl; ] in let constraints = print_type_definition_constraints ~state td.ptype_cstrs in @@ -1274,8 +1293,8 @@ and print_type_declaration2 ~state ~rec_flag (td : Parsetree.type_declaration) [ manifest; Doc.concat [Doc.space; Doc.text equal_sign]; - print_constructor_declarations ~state ~private_flag:td.ptype_private cds - cmt_tbl; + print_constructor_declarations ~state ~private_flag:td.ptype_private + cds cmt_tbl; ] in let constraints = print_type_definition_constraints ~state td.ptype_cstrs in @@ -1624,16 +1643,20 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl = if needs_parens 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 "'"; print_ident_like 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 + 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_constr + (longident_loc, [{ptyp_desc = Ptyp_object (fields, open_flag)}]) -> (* 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 @@ -1671,7 +1694,8 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun typexpr -> print_typ_expr ~state typexpr cmt_tbl) + (fun typexpr -> + print_typ_expr ~state typexpr cmt_tbl) constr_args); ]); Doc.trailing_comma; @@ -1694,8 +1718,8 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl = print_typ_expr ~state typ cmt_tbl; ] | Ptyp_package package_type -> - print_package_type ~state ~print_module_keyword_and_parens:true package_type - cmt_tbl + print_package_type ~state ~print_module_keyword_and_parens:true + package_type cmt_tbl | Ptyp_class _ -> Doc.text "classes are not supported in types" | Ptyp_variant (row_fields, closed_flag, labels_opt) -> let force_break = @@ -1718,7 +1742,8 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl = match t.Parsetree.ptyp_desc with | Ptyp_tuple _ -> print_typ_expr ~state t cmt_tbl | _ -> - Doc.concat [Doc.lparen; print_typ_expr ~state t cmt_tbl; Doc.rparen] + Doc.concat + [Doc.lparen; print_typ_expr ~state t cmt_tbl; Doc.rparen] in let printed_types = List.map do_type types in let cases = @@ -1780,7 +1805,8 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl = 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]) + Doc.group + (Doc.concat [print_attributes ~state attrs cmt_tbl; rendered_type]) | _ -> rendered_type in print_comments doc cmt_tbl typ_expr.ptyp_loc @@ -1910,7 +1936,8 @@ and print_type_parameter ~state (attrs, lbl, typ) cmt_tbl = in print_comments doc cmt_tbl loc -and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl i = +and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl + i = let attrs = print_attributes ~state ~loc:vb.pvb_pat.ppat_loc vb.pvb_attributes cmt_tbl in @@ -1959,7 +1986,10 @@ and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl print_typ_expr ~state typ cmt_tbl; Doc.text " ="; Doc.concat - [Doc.line; print_expression_with_comments ~state expr cmt_tbl]; + [ + Doc.line; + print_expression_with_comments ~state expr cmt_tbl; + ]; ]); ]) | _ -> @@ -1983,7 +2013,10 @@ and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl print_typ_expr ~state pat_typ cmt_tbl; Doc.text " ="; Doc.concat - [Doc.line; print_expression_with_comments ~state expr cmt_tbl]; + [ + Doc.line; + print_expression_with_comments ~state expr cmt_tbl; + ]; ]); ])) | _ -> @@ -2014,7 +2047,12 @@ and print_value_binding ~state ~rec_flag (vb : Parsetree.value_binding) cmt_tbl Doc.group (Doc.concat [ - attrs; header; pattern_doc; Doc.text " ="; Doc.space; printed_expr; + attrs; + header; + pattern_doc; + Doc.text " ="; + Doc.space; + printed_expr; ]); Doc.group (Doc.concat @@ -2179,7 +2217,8 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = 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; print_comments_inside cmt_tbl 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] @@ -2281,7 +2320,9 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = | 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 variant_name = + Doc.concat [Doc.text "#"; print_poly_var_ident label] + in let args_doc = match variant_args with | None -> Doc.nil @@ -2343,7 +2384,8 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = Doc.join ~sep:(Doc.concat [Doc.text ","; Doc.line]) (List.map - (fun row -> print_pattern_record_row ~state row cmt_tbl) + (fun row -> + print_pattern_record_row ~state row cmt_tbl) rows); (match open_flag with | Open -> Doc.concat [Doc.text ","; Doc.line; Doc.text "_"] @@ -2387,8 +2429,10 @@ and print_pattern ~state (p : Parsetree.pattern) cmt_tbl = 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.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 | Ppat_lazy p -> let needs_parens = match p.ppat_desc with @@ -2511,7 +2555,9 @@ and print_if_chain ~state pexp_attributes ifs else_expr cmt_tbl = if ParsetreeViewer.is_block_expr if_expr then print_expression_block ~state ~braces:true if_expr cmt_tbl else - let doc = print_expression_with_comments ~state if_expr cmt_tbl in + 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 @@ -2560,7 +2606,8 @@ and print_if_chain ~state pexp_attributes ifs else_expr cmt_tbl = | Some expr -> Doc.concat [ - Doc.text " else "; print_expression_block ~state ~braces:true expr cmt_tbl; + Doc.text " else "; + print_expression_block ~state ~braces:true expr cmt_tbl; ] in let attrs = ParsetreeViewer.filter_fragile_match_attributes pexp_attributes in @@ -2640,7 +2687,13 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = let attrs = print_attributes ~state attrs cmt_tbl in Doc.group (Doc.concat - [attrs; parameters_doc; typ_constraint_doc; Doc.text " =>"; return_expr_doc]) + [ + attrs; + parameters_doc; + typ_constraint_doc; + Doc.text " =>"; + return_expr_doc; + ]) in let uncurried = Ast_uncurried.expr_is_uncurried_fun e in let e_fun = @@ -2671,7 +2724,8 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = | Pexp_fun _ | Pexp_newtype _ -> print_arrow 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 -> + | Pexp_construct _ when ParsetreeViewer.has_jsx_attribute e.pexp_attributes + -> print_jsx_fragment ~state e cmt_tbl | Pexp_construct ({txt = Longident.Lident "()"}, _) -> Doc.text "()" | Pexp_construct ({txt = Longident.Lident "[]"}, _) -> @@ -2847,7 +2901,9 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.rbracket; ]) | Pexp_variant (label, args) -> - let variant_name = Doc.concat [Doc.text "#"; print_poly_var_ident label] in + let variant_name = + Doc.concat [Doc.text "#"; print_poly_var_ident label] + in let args = match args with | None -> Doc.nil @@ -3016,7 +3072,8 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.soft_line; Doc.rbrace; ]) - | extension -> print_extension ~state ~at_module_lvl:false extension cmt_tbl) + | 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 @@ -3073,15 +3130,18 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = [ Doc.line; Doc.text ": "; - print_ternary_operand ~state condition cmt_tbl; + print_ternary_operand ~state condition + cmt_tbl; Doc.line; Doc.text "? "; - print_ternary_operand ~state consequent cmt_tbl; + print_ternary_operand ~state consequent + cmt_tbl; ]) rest); Doc.line; Doc.text ": "; - Doc.indent (print_ternary_operand ~state alternate cmt_tbl); + Doc.indent + (print_ternary_operand ~state alternate cmt_tbl); ]); ]) | _ -> Doc.nil @@ -3124,7 +3184,9 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.text "for "; print_pattern ~state pattern cmt_tbl; Doc.text " in "; - (let doc = print_expression_with_comments ~state from_expr cmt_tbl 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 @@ -3153,7 +3215,8 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = Doc.text ": "; print_comments (print_package_type ~state - ~print_module_keyword_and_parens:false package_type cmt_tbl) + ~print_module_keyword_and_parens:false package_type + cmt_tbl) cmt_tbl ptyp_loc; ]); Doc.soft_line; @@ -3192,7 +3255,8 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = [ Doc.text "module("; Doc.indent - (Doc.concat [Doc.soft_line; print_mod_expr ~state mod_expr cmt_tbl]); + (Doc.concat + [Doc.soft_line; print_mod_expr ~state mod_expr cmt_tbl]); Doc.soft_line; Doc.rparen; ]) @@ -3225,7 +3289,12 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = | Nothing -> doc in Doc.concat - [Doc.text "switch "; expr_doc; Doc.space; print_cases ~state cases cmt_tbl] + [ + Doc.text "switch "; + expr_doc; + Doc.space; + print_cases ~state cases cmt_tbl; + ] | Pexp_function cases -> Doc.concat [Doc.text "x => switch x "; print_cases ~state cases cmt_tbl] | Pexp_coerce (expr, typ_opt, typ) -> @@ -3248,7 +3317,9 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = | Nothing -> doc in let member = - let member_doc = print_comments (Doc.text label.txt) cmt_tbl label.loc in + let member_doc = + print_comments (Doc.text label.txt) cmt_tbl label.loc + in Doc.concat [Doc.text "\""; member_doc; Doc.text "\""] in Doc.group (Doc.concat [parent_doc; Doc.lbracket; member; Doc.rbracket]) @@ -3286,14 +3357,16 @@ and print_expression ~state (e : Parsetree.expression) cmt_tbl = | Pexp_ifthenelse _ -> true | Pexp_match _ when ParsetreeViewer.is_if_let_expr e -> true - | Pexp_construct _ when ParsetreeViewer.has_jsx_attribute e.pexp_attributes -> + | Pexp_construct _ when ParsetreeViewer.has_jsx_attribute 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]) + Doc.group + (Doc.concat [print_attributes ~state attrs cmt_tbl; expr_with_await]) | _ -> expr_with_await and print_pexp_fun ~state ~in_callback e cmt_tbl = @@ -3415,7 +3488,8 @@ and print_set_field_expr ~state attrs lhs longident_loc rhs loc cmt_tbl = let doc = match attrs with | [] -> doc - | attrs -> Doc.group (Doc.concat [print_attributes ~state attrs cmt_tbl; doc]) + | attrs -> + Doc.group (Doc.concat [print_attributes ~state attrs cmt_tbl; doc]) in print_comments doc cmt_tbl loc @@ -3565,7 +3639,9 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = ParsetreeViewer.flattenable_operators parent_operator operator && not (ParsetreeViewer.has_attributes expr.pexp_attributes) then - let left_printed = flatten ~is_lhs:true ~is_multiline left operator in + 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 @@ -3632,14 +3708,15 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = in let doc = - if (not is_lhs) && Parens.rhs_binary_expr_operand operator expr then - Doc.concat [Doc.lparen; doc; Doc.rparen] + if (not is_lhs) && Parens.rhs_binary_expr_operand operator expr + then Doc.concat [Doc.lparen; doc; Doc.rparen] else doc in print_comments doc cmt_tbl expr.pexp_loc else let printeable_attrs, internal_attrs = - ParsetreeViewer.partition_printable_attributes expr.pexp_attributes + ParsetreeViewer.partition_printable_attributes + expr.pexp_attributes in let doc = print_expression_with_comments ~state @@ -3693,7 +3770,8 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = match expr.pexp_attributes with | [] -> doc | attrs -> - Doc.group (Doc.concat [print_attributes ~state attrs cmt_tbl; doc]) + Doc.group + (Doc.concat [print_attributes ~state attrs cmt_tbl; doc]) in if is_lhs then add_parens doc else doc | _ -> ( @@ -3715,7 +3793,8 @@ and print_binary_expression ~state (expr : Parsetree.expression) cmt_tbl = when not (ParsetreeViewer.is_binary_expression lhs || ParsetreeViewer.is_binary_expression rhs - || print_attributes ~state expr.pexp_attributes cmt_tbl <> Doc.nil) -> + || 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 @@ -3835,7 +3914,8 @@ and print_belt_array_concat_apply ~state sub_lists cmt_tbl = 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 ParsetreeViewer.collect_array_expressions + sub_lists)); ]); Doc.trailing_comma; Doc.soft_line; @@ -3890,7 +3970,8 @@ and print_belt_list_concat_apply ~state sub_lists cmt_tbl = 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 ParsetreeViewer.collect_list_expressions + sub_lists)); ]); Doc.trailing_comma; Doc.soft_line; @@ -3914,7 +3995,9 @@ and print_pexp_apply ~state expr cmt_tbl = let member_doc = match member_expr.pexp_desc with | Pexp_ident lident -> - print_comments (print_longident lident.txt) cmt_tbl member_expr.pexp_loc + print_comments + (print_longident lident.txt) + cmt_tbl member_expr.pexp_loc | _ -> print_expression_with_comments ~state member_expr cmt_tbl in Doc.concat [Doc.text "\""; member_doc; Doc.text "\""] @@ -3956,12 +4039,13 @@ and print_pexp_apply ~state expr cmt_tbl = in match expr.pexp_attributes with | [] -> doc - | attrs -> Doc.group (Doc.concat [print_attributes ~state attrs cmt_tbl; doc]) - ) + | attrs -> + Doc.group (Doc.concat [print_attributes ~state attrs cmt_tbl; 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) -> + when not (ParsetreeViewer.is_rewritten_underscore_apply_sugar parent_expr) + -> (* Don't print the Array.get(_, 0) sugar a.k.a. (__x) => Array.get(__x, 0) as _[0] *) let member = let member_doc = @@ -3999,8 +4083,8 @@ and print_pexp_apply ~state expr cmt_tbl = ]) | Pexp_apply ( {pexp_desc = Pexp_ident {txt = Longident.Ldot (Lident "Array", "set")}}, - [(Nolabel, parent_expr); (Nolabel, member_expr); (Nolabel, target_expr)] ) - -> + [(Nolabel, parent_expr); (Nolabel, member_expr); (Nolabel, target_expr)] + ) -> let member = let member_doc = let doc = print_expression_with_comments ~state member_expr cmt_tbl in @@ -4083,7 +4167,9 @@ and print_pexp_apply ~state expr cmt_tbl = args @ [(Asttypes.Labelled "...", dummy)] else args in - let dotted = state.uncurried_config |> Res_uncurried.get_dotted ~uncurried 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 @@ -4093,12 +4179,16 @@ and print_pexp_apply ~state expr cmt_tbl = 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 + print_arguments_with_callback_in_first_position ~dotted ~state args + cmt_tbl 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 + 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 + print_arguments_with_callback_in_last_position ~state ~dotted args + cmt_tbl in (* * Fixes the following layout (the `[` and `]` should break): @@ -4126,7 +4216,8 @@ and print_pexp_apply ~state expr cmt_tbl = ] 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] + Doc.concat + [print_attributes ~state attrs cmt_tbl; call_expr_doc; args_doc] | _ -> assert false and print_jsx_expression ~state lident args cmt_tbl = @@ -4159,7 +4250,8 @@ and print_jsx_expression ~state lident args cmt_tbl = let line_sep = match children with | Some expr -> - if has_nested_jsx_or_more_than_one_child expr then Doc.hard_line else Doc.line + if has_nested_jsx_or_more_than_one_child expr then Doc.hard_line + else Doc.line | None -> Doc.line in Doc.concat @@ -4170,7 +4262,8 @@ 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 + print_jsx_children ~state children_expression ~sep:line_sep + cmt_tbl | None -> Doc.nil); ]); line_sep; @@ -4230,7 +4323,8 @@ and print_jsx_fragment ~state expr cmt_tbl = let opening = 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 + if has_nested_jsx_or_more_than_one_child expr then Doc.hard_line + else Doc.line in Doc.group (Doc.concat @@ -4246,7 +4340,8 @@ and print_jsx_fragment ~state expr cmt_tbl = closing; ]) -and print_jsx_children ~state (children_expr : Parsetree.expression) ~sep cmt_tbl = +and print_jsx_children ~state (children_expr : Parsetree.expression) ~sep + cmt_tbl = match children_expr.pexp_desc with | Pexp_construct ({txt = Longident.Lident "::"}, _) -> let children, _ = ParsetreeViewer.collect_list_expressions children_expr in @@ -4257,11 +4352,14 @@ and print_jsx_children ~state (children_expr : Parsetree.expression) ~sep cmt_tb 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 in + let expr_doc = + print_expression_with_comments ~state expr cmt_tbl + in let add_parens_or_braces expr_doc = (* {(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 + if Parens.braced_expr expr then add_parens expr_doc + else expr_doc in if leading_line_comment_present then add_braces inner_doc else Doc.concat [Doc.lbrace; inner_doc; Doc.rbrace] @@ -4270,13 +4368,17 @@ and print_jsx_children ~state (children_expr : Parsetree.expression) ~sep cmt_tb | 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) + print_comments + (add_parens_or_braces expr_doc) + cmt_tbl braces_loc) 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 in + let expr_doc = + print_expression_with_comments ~state children_expr cmt_tbl + in Doc.concat [ Doc.dotdotdot; @@ -4421,7 +4523,9 @@ and print_jsx_prop ~state arg cmt_tbl = match Parens.jsx_prop_expr 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 + 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] | _ -> doc @@ -4447,7 +4551,8 @@ and print_jsx_name {txt = 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 print_arguments_with_callback_in_first_position ~dotted ~state args cmt_tbl + = (* 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. *) @@ -4466,7 +4571,10 @@ and print_arguments_with_callback_in_first_position ~dotted ~state args cmt_tbl in let callback = Doc.concat - [lbl_doc; print_pexp_fun ~state ~in_callback:FitsOnOneLine expr cmt_tbl] + [ + lbl_doc; + print_pexp_fun ~state ~in_callback:FitsOnOneLine expr cmt_tbl; + ] in let callback = lazy (print_comments callback cmt_tbl expr.pexp_loc) in let printed_args = @@ -4504,7 +4612,9 @@ 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 break_all_args = + lazy (print_arguments ~state ~dotted args cmt_tbl_copy) + in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -4522,8 +4632,10 @@ and print_arguments_with_callback_in_first_position ~dotted ~state args cmt_tbl * 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] + 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] and print_arguments_with_callback_in_last_position ~state ~dotted args cmt_tbl = (* Because the same subtree gets printed twice, we need to copy the cmtTbl. @@ -4604,7 +4716,9 @@ 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 break_all_args = + lazy (print_arguments ~state ~dotted args cmt_tbl_copy2) + in (* Sometimes one of the non-callback arguments will break. * There might be a single line comment in there, or a multiline string etc. @@ -4622,7 +4736,8 @@ and print_arguments_with_callback_in_last_position ~state ~dotted args cmt_tbl = * 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 if Doc.will_break (Lazy.force printed_args) then + Lazy.force break_all_args else Doc.custom_layout [ @@ -4669,7 +4784,9 @@ and print_arguments ~state ~dotted ?(partial = false) (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); + (List.map + (fun arg -> print_argument ~state arg cmt_tbl) + args); ]); (if partial then Doc.nil else Doc.trailing_comma); Doc.soft_line; @@ -4859,13 +4976,14 @@ and print_case ~state (case : Parsetree.case) cmt_tbl = Doc.indent guard; Doc.text " =>"; Doc.indent - (Doc.concat [(if should_inline_rhs then Doc.space else Doc.line); rhs]); + (Doc.concat + [(if should_inline_rhs 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 = +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 match parameters with (* let f = _ => () *) @@ -4958,7 +5076,11 @@ and print_expr_fun_parameters ~state ~in_callback ~async ~uncurried ~has_constra (if should_hug || in_callback then printed_paramaters else Doc.concat - [Doc.indent printed_paramaters; Doc.trailing_comma; Doc.soft_line]); + [ + Doc.indent printed_paramaters; + Doc.trailing_comma; + Doc.soft_line; + ]); Doc.rparen; ]) @@ -5040,7 +5162,11 @@ 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; + label_with_pattern; + default_expr_doc; + optional_label_suffix; ]) in let cmt_loc = @@ -5075,10 +5201,12 @@ and print_expression_block ~state ~braces expr cmt_tbl = 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) + when not + (ParsetreeViewer.has_await_attribute mod_expr.pmod_attributes) -> let name = - Doc.concat [name; Doc.text ": "; print_mod_type ~state mod_type cmt_tbl] + Doc.concat + [name; Doc.text ": "; print_mod_type ~state mod_type cmt_tbl] in (name, mod_expr2) | _ -> (name, mod_expr) @@ -5150,7 +5278,9 @@ and print_expression_block ~state ~braces expr cmt_tbl = | 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 let_doc = + print_value_bindings ~state ~rec_flag value_bindings cmt_tbl + in (* let () = { * let () = foo() * () @@ -5297,8 +5427,8 @@ 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 = +and print_attributes ?loc ?(inline = false) ~state + (attrs : Parsetree.attributes) cmt_tbl = match ParsetreeViewer.filter_parsing_attrs attrs with | [] -> Doc.nil | attrs -> @@ -5446,11 +5576,16 @@ and print_mod_expr ~state mod_expr cmt_tbl = | Pmod_ident longident_loc -> print_longident_location longident_loc cmt_tbl | Pmod_structure [] -> let should_break = - mod_expr.pmod_loc.loc_start.pos_lnum < mod_expr.pmod_loc.loc_end.pos_lnum + mod_expr.pmod_loc.loc_start.pos_lnum + < mod_expr.pmod_loc.loc_end.pos_lnum in Doc.breakable_group ~force_break:should_break (Doc.concat - [Doc.lbrace; print_comments_inside cmt_tbl mod_expr.pmod_loc; Doc.rbrace]) + [ + Doc.lbrace; + print_comments_inside cmt_tbl mod_expr.pmod_loc; + Doc.rbrace; + ]) | Pmod_structure structure -> Doc.breakable_group ~force_break:true (Doc.concat @@ -5494,7 +5629,10 @@ and print_mod_expr ~state mod_expr cmt_tbl = let unpack_doc = Doc.group (Doc.concat - [print_expression_with_comments ~state expr cmt_tbl; module_constraint]) + [ + print_expression_with_comments ~state expr cmt_tbl; + module_constraint; + ]) in Doc.group (Doc.concat @@ -5528,7 +5666,9 @@ and print_mod_expr ~state mod_expr cmt_tbl = [ print_mod_expr ~state call_expr cmt_tbl; (if is_unit_sugar then - print_mod_apply_arg ~state (List.hd args [@doesNotRaise]) cmt_tbl + print_mod_apply_arg ~state + (List.hd args [@doesNotRaise]) + cmt_tbl else Doc.concat [ @@ -5586,7 +5726,8 @@ and print_mod_functor ~state mod_expr cmt_tbl = | 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 + if Parens.mod_expr_functor_constraint mod_type then add_parens doc + else doc in let mod_constraint = Doc.concat [Doc.text ": "; constraint_doc] in (mod_constraint, print_mod_expr ~state mod_expr cmt_tbl) @@ -5610,7 +5751,8 @@ and print_mod_functor ~state mod_expr cmt_tbl = Doc.join ~sep:(Doc.concat [Doc.comma; Doc.line]) (List.map - (fun param -> print_mod_functor_param ~state param cmt_tbl) + (fun param -> + print_mod_functor_param ~state param cmt_tbl) parameters); ]); Doc.trailing_comma; @@ -5653,7 +5795,8 @@ and print_mod_apply_arg ~state mod_expr cmt_tbl = | Pmod_structure [] -> Doc.text "()" | _ -> print_mod_expr ~state mod_expr cmt_tbl -and print_exception_def ~state (constr : Parsetree.extension_constructor) cmt_tbl = +and print_exception_def ~state (constr : Parsetree.extension_constructor) + cmt_tbl = let kind = match constr.pext_kind with | Pext_rebind longident -> @@ -5664,11 +5807,14 @@ and print_exception_def ~state (constr : Parsetree.extension_constructor) cmt_tb | Pext_decl (args, gadt) -> let gadt_doc = match gadt with - | Some typ -> Doc.concat [Doc.text ": "; print_typ_expr ~state typ cmt_tbl] + | Some typ -> + Doc.concat [Doc.text ": "; print_typ_expr ~state typ cmt_tbl] | None -> Doc.nil in Doc.concat - [print_constructor_arguments ~state ~indent:false args cmt_tbl; gadt_doc] + [ + print_constructor_arguments ~state ~indent:false args cmt_tbl; gadt_doc; + ] in let name = print_comments (Doc.text constr.pext_name.txt) cmt_tbl constr.pext_name.loc @@ -5685,8 +5831,8 @@ and print_exception_def ~state (constr : Parsetree.extension_constructor) cmt_tb in print_comments doc cmt_tbl constr.pext_loc -and print_extension_constructor ~state (constr : Parsetree.extension_constructor) - cmt_tbl i = +and print_extension_constructor ~state + (constr : Parsetree.extension_constructor) cmt_tbl i = let attrs = print_attributes ~state constr.pext_attributes cmt_tbl in let bar = if i > 0 then Doc.text "| " else Doc.if_breaks (Doc.text "| ") Doc.nil @@ -5701,11 +5847,14 @@ and print_extension_constructor ~state (constr : Parsetree.extension_constructor | Pext_decl (args, gadt) -> let gadt_doc = match gadt with - | Some typ -> Doc.concat [Doc.text ": "; print_typ_expr ~state typ cmt_tbl] + | Some typ -> + Doc.concat [Doc.text ": "; print_typ_expr ~state typ cmt_tbl] | None -> Doc.nil in Doc.concat - [print_constructor_arguments ~state ~indent:false args cmt_tbl; gadt_doc] + [ + print_constructor_arguments ~state ~indent:false args cmt_tbl; gadt_doc; + ] in let name = print_comments (Doc.text constr.pext_name.txt) cmt_tbl constr.pext_name.loc diff --git a/jscomp/syntax/src/res_scanner.ml b/jscomp/syntax/src/res_scanner.ml index 7aa2cee32b..5d823a7375 100644 --- a/jscomp/syntax/src/res_scanner.ml +++ b/jscomp/syntax/src/res_scanner.ml @@ -193,7 +193,8 @@ let scan_identifier scanner = in skip_good_chars scanner; let str = - (String.sub [@doesNotRaise]) scanner.src start_off (scanner.offset - start_off) + (String.sub [@doesNotRaise]) scanner.src start_off + (scanner.offset - start_off) in if '{' == scanner.ch && str = "list" then ( next scanner; @@ -268,7 +269,8 @@ let scan_number scanner = | _ -> is_float in let literal = - (String.sub [@doesNotRaise]) scanner.src start_off (scanner.offset - start_off) + (String.sub [@doesNotRaise]) scanner.src start_off + (scanner.offset - start_off) in (* suffix *) @@ -308,7 +310,8 @@ let scan_exotic_identifier scanner = scan (); let ident = - (String.sub [@doesNotRaise]) scanner.src start_off (scanner.offset - start_off) + (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 ( @@ -433,7 +436,8 @@ let scan_string scanner = 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; + 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 | _ -> @@ -548,7 +552,8 @@ let scan_single_line_comment scanner = let end_pos = position scanner in Token.Comment (Comment.make_single_line_comment - ~loc:Location.{loc_start = start_pos; loc_end = end_pos; loc_ghost = false} + ~loc: + Location.{loc_start = start_pos; loc_end = end_pos; loc_ghost = false} ((String.sub [@doesNotRaise]) scanner.src start_off (scanner.offset - start_off))) @@ -583,7 +588,11 @@ let scan_multi_line_comment scanner = (Comment.make_multi_line_comment ~doc_comment ~standalone ~loc: Location. - {loc_start = start_pos; loc_end = position scanner; loc_ghost = false} + { + loc_start = start_pos; + loc_end = position scanner; + loc_ghost = false; + } ((String.sub [@doesNotRaise]) scanner.src content_start_off length)) let scan_template_literal_token scanner = diff --git a/jscomp/syntax/testrunner/res_test.ml b/jscomp/syntax/testrunner/res_test.ml index 88d7c3a98f..8dd38b1fcc 100644 --- a/jscomp/syntax/testrunner/res_test.ml +++ b/jscomp/syntax/testrunner/res_test.ml @@ -101,7 +101,8 @@ module OutcomePrinterTests = struct let run () = let filename = Filename.concat data_dir "oprint/oprint.res" in let result = - Res_driver.parsing_engine.parse_implementation ~for_printer:false ~filename + Res_driver.parsing_engine.parse_implementation ~for_printer:false + ~filename in let signature = if result.Res_driver.invalid then ( diff --git a/jscomp/syntax/testrunner/res_utf8_test.ml b/jscomp/syntax/testrunner/res_utf8_test.ml index ff961504fc..da061aa6a7 100644 --- a/jscomp/syntax/testrunner/res_utf8_test.ml +++ b/jscomp/syntax/testrunner/res_utf8_test.ml @@ -82,7 +82,8 @@ let valid_code_points_tests = let test_is_valid_code_point () = Array.iter - (fun (code_point, t) -> assert (Res_utf8.is_valid_code_point code_point = t)) + (fun (code_point, t) -> + assert (Res_utf8.is_valid_code_point code_point = t)) valid_code_points_tests let run () = From c7cff0ba39af4cc793754c6e59b21b48c7320ec2 Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 26 May 2024 16:53:15 -0300 Subject: [PATCH 5/6] update CHANGELOG.md --- CHANGELOG.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.md b/CHANGELOG.md index 4fdc5b2199..1ece6f5026 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -16,6 +16,10 @@ - Allow `@directive` on functions for emitting function level directive code (`let serverAction = @directive("'use server'") (~name) => {...}`). https://github.com/rescript-lang/rescript-compiler/pull/6756 +#### :house: Internal + +- Convert OCaml codebase to snake case style. https://github.com/rescript-lang/rescript-compiler/pull/6702 + #### :boom: Breaking Change - `lazy` syntax is no longer supported. If you're using it, use `Lazy` module or `React.lazy_` instead. https://github.com/rescript-lang/rescript-compiler/pull/6342 From 38561bd5173961cfcbe6c5b6b9cffe82154ef00e Mon Sep 17 00:00:00 2001 From: Pedro Castro Date: Sun, 26 May 2024 16:53:37 -0300 Subject: [PATCH 6/6] update CONTRIBUTING.md --- CONTRIBUTING.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index c9f37de8be..f1f2d7c0d2 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -92,6 +92,11 @@ make test-syntax-roundtrip make artifacts ``` +## Coding Style + +- OCaml Code: snake case format is used, e.g, `to_string` +- ReScript Code: the camel case format is used, e.g `toString` + ## Adding new Files to the Npm Package To make sure that no files are added to or removed from the npm package inadvertently, an artifact list is kept at `packages/artifacts.txt`. During CI build, it is verified that only the files that are listed there are actually included in the npm package.