From 94e4c3cb5c83612caed1644d1b38324d957b1307 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 22 Sep 2023 15:47:53 +0200 Subject: [PATCH] More permissive is_trivial for strings String of a length less than 30 are trivial. This is still more restrictive than on main. --- lib/Ast.ml | 12 ++------ lib/Cmts.ml | 4 +-- lib/Conf_decl.ml | 4 +-- lib/Fmt_ast.ml | 37 +++++++++--------------- lib/Params.ml | 3 +- test/passing/tests/infix_arg_grouping.ml | 9 +++--- test/passing/tests/issue77.ml | 3 +- test/rpc/rpc_test.ml | 5 +--- test/rpc/rpc_test_fail.ml | 5 +--- test/unit/test_literal_lexer.ml | 5 ++-- 10 files changed, 29 insertions(+), 58 deletions(-) diff --git a/lib/Ast.ml b/lib/Ast.ml index d4a06c9e4e..a1c0f7ed86 100644 --- a/lib/Ast.ml +++ b/lib/Ast.ml @@ -140,21 +140,13 @@ module Exp = struct false | _ -> List.exists pexp_attributes ~f:(Fn.non Attr.is_doc) - let is_string_const_trivial str = - let is_char_trivial = function - | ' ' | '\t' | '\n' | '\x00' .. '\x1f' | '\x7f' .. '\xff' -> false - | _ -> true - in - let len = String.length str in - len < 5 || (len < 20 && String.for_all ~f:is_char_trivial str) - let rec is_trivial exp = match exp.pexp_desc with (* String literals using the heavy syntax are not trivial. *) | Pexp_constant {pconst_desc= Pconst_string (_, _, Some _); _} -> false - (* Some short strings are trivial. *) + (* Short strings are trivial. *) | Pexp_constant {pconst_desc= Pconst_string (str, _, None); _} -> - is_string_const_trivial str + String.length str < 30 | Pexp_constant _ | Pexp_field _ | Pexp_ident _ | Pexp_send _ -> true | Pexp_construct (_, exp) -> Option.for_all exp ~f:is_trivial | Pexp_prefix (_, e) -> is_trivial e diff --git a/lib/Cmts.ml b/lib/Cmts.ml index 25b7353e81..1c104e2609 100644 --- a/lib/Cmts.ml +++ b/lib/Cmts.ml @@ -303,8 +303,8 @@ let rec place t loc_tree ?prev_loc ?deep_loc locs cmts = (** Relocate comments, for Ast transformations such as sugaring. *) let relocate (t : t) ~src ~before ~after = if t.debug then - Format.eprintf "relocate %a to %a and %a@\n%!" - Location.fmt src Location.fmt before Location.fmt after ; + Format.eprintf "relocate %a to %a and %a@\n%!" Location.fmt src + Location.fmt before Location.fmt after ; let merge_and_sort x y = List.rev_append x y |> List.sort ~compare:(Comparable.lift Location.compare_start ~f:Cmt.loc) diff --git a/lib/Conf_decl.ml b/lib/Conf_decl.ml index a4d6a12e1c..4b1050689f 100644 --- a/lib/Conf_decl.ml +++ b/lib/Conf_decl.ml @@ -187,8 +187,8 @@ let rec pp_from fs = function | `Profile (s, p) -> Format.fprintf fs " (profile %s%a)" s pp_from_src p | `Updated (x, None) -> pp_from_src fs x | `Updated (x, Some r) -> - Format.fprintf fs "%a -- Warning (redundant): %a" - pp_from_src x pp_from r + Format.fprintf fs "%a -- Warning (redundant): %a" pp_from_src x pp_from + r let loc_udapted_from = function | `Commandline -> Location.in_file "" diff --git a/lib/Fmt_ast.ml b/lib/Fmt_ast.ml index b6418f3b5a..08050d663b 100644 --- a/lib/Fmt_ast.ml +++ b/lib/Fmt_ast.ml @@ -1282,8 +1282,7 @@ and fmt_fun_args c args = cbox 0 (wrap "?(" ")" ( fmt_pattern c ~parens:false ~box:true xpat - $ fmt " =@;<1 2>" - $ fmt_expression c xexp ) ) + $ fmt " =@;<1 2>" $ fmt_expression c xexp ) ) | Val (Optional l, xpat, Some xexp) -> let parens = match xpat.ast.ppat_desc with @@ -1294,8 +1293,7 @@ and fmt_fun_args c args = ( str "?" $ str l.txt $ wrap_k (fmt ":@,(") (str ")") ( fmt_pattern c ?parens ~box:true xpat - $ fmt " =@;<1 2>" - $ fmt_expression c xexp ) ) + $ fmt " =@;<1 2>" $ fmt_expression c xexp ) ) | Val ((Labelled _ | Nolabel), _, Some _) -> impossible "not accepted by parser" | Newtypes [] -> impossible "not accepted by parser" @@ -1717,8 +1715,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0) (wrap "[" "]" ( str "%" $ hovbox 2 - ( fmt_str_loc c name - $ str " fun " + ( fmt_str_loc c name $ str " fun " $ fmt_attributes c ~suf:" " call.pexp_attributes $ fmt_fun_args c xargs $ fmt_opt fmt_cstr $ fmt "@ ->" ) @@ -1747,8 +1744,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0) (wrap "[" "]" ( str "%" $ hovbox 2 - ( fmt_str_loc c name - $ str " fun " + ( fmt_str_loc c name $ str " fun " $ fmt_attributes c ~suf:" " retn.pexp_attributes $ fmt_fun_args c xargs $ fmt_opt fmt_cstr $ fmt "@ ->" ) @@ -1778,8 +1774,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0) hvbox 0 ( hvbox 0 (fmt_expression c (sub_exp ~ctx r) $ cmts_before) $ str " :=" ) - $ fmt "@;<1 2>" - $ cmts_after + $ fmt "@;<1 2>" $ cmts_after $ hvbox 2 (fmt_expression c (sub_exp ~ctx v)) ) ) | Pexp_prefix ({txt= ("~-" | "~-." | "~+" | "~+.") as op; loc}, e1) -> let op = @@ -2372,8 +2367,7 @@ and fmt_expression c ?(box = true) ?pro ?epi ?eol ?parens ?(indent_wrap = 0) $ break 1 (-2) $ hvbox 0 ( hvbox 0 - ( fmt "with@ " - $ leading_cmt + ( fmt "with@ " $ leading_cmt $ hvbox 0 ( fmt_pattern c ~pro:(if_newline "| ") (sub_pat ~ctx pc_lhs) @@ -3540,9 +3534,7 @@ and fmt_module_type c ?(rec_ = false) ({ast= mty; _} as xmty) = pro= Some ( Cmts.fmt_before c pmty_loc - $ fmt_if parens "(" - $ str "module type of " - $ pro ) + $ fmt_if parens "(" $ str "module type of " $ pro ) ; epi= Some epi } | _ -> { blk with @@ -3900,17 +3892,14 @@ and fmt_with_constraint c ctx ~pre = function | Pwith_type (lid, td) -> fmt_type_declaration ~pre:(pre ^ " type") c ~name:lid (sub_td ~ctx td) | Pwith_module (m1, m2) -> - str pre - $ str " module " - $ fmt_longident_loc c m1 $ str " = " $ fmt_longident_loc c m2 + str pre $ str " module " $ fmt_longident_loc c m1 $ str " = " + $ fmt_longident_loc c m2 | Pwith_typesubst (lid, td) -> - fmt_type_declaration - ~pre:(pre ^ " type") - c ~eq:":=" ~name:lid (sub_td ~ctx td) + fmt_type_declaration ~pre:(pre ^ " type") c ~eq:":=" ~name:lid + (sub_td ~ctx td) | Pwith_modsubst (m1, m2) -> - str pre - $ str " module " - $ fmt_longident_loc c m1 $ str " := " $ fmt_longident_loc c m2 + str pre $ str " module " $ fmt_longident_loc c m1 $ str " := " + $ fmt_longident_loc c m2 | Pwith_modtype (m1, m2) -> let m1 = {m1 with txt= Some (str_longident m1.txt)} in let m2 = Some (sub_mty ~ctx m2) in diff --git a/lib/Params.ml b/lib/Params.ml index 79e101063a..080282b903 100644 --- a/lib/Params.ml +++ b/lib/Params.ml @@ -403,8 +403,7 @@ let collection_expr (c : Conf.t) ~space_around opn cls = else box_collec c 0 (wrap_collec c ~space_around opn cls k) ) ; sep_before= noop ; sep_after_non_final= - fmt_or_k dock - (fmt ";@;<1 0>") + fmt_or_k dock (fmt ";@;<1 0>") (char ';' $ break 1 (String.length opn + 1)) ; sep_after_final= fmt_if_k dock (fits_breaks ~level:1 "" ";") } diff --git a/test/passing/tests/infix_arg_grouping.ml b/test/passing/tests/infix_arg_grouping.ml index ed72582109..a083ab05d7 100644 --- a/test/passing/tests/infix_arg_grouping.ml +++ b/test/passing/tests/infix_arg_grouping.ml @@ -57,11 +57,10 @@ hvbox 0 $ wrap "(" ")" ( str txt $ opt mt (fun _ -> - fmt "@ : " $ Option.call ~f:pro_t $ psp_t - $ fmt "@;<1 2>" - $ bdy_t $ esp_t $ Option.call ~f:epi_t ) ) - $ fmt " ->@ " - $ Option.call ~f:pro_e $ psp_e $ bdy_e $ esp_e $ Option.call ~f:epi_e ) + fmt "@ : " $ Option.call ~f:pro_t $ psp_t $ fmt "@;<1 2>" $ bdy_t + $ esp_t $ Option.call ~f:epi_t ) ) + $ fmt " ->@ " $ Option.call ~f:pro_e $ psp_e $ bdy_e $ esp_e + $ Option.call ~f:epi_e ) let to_json {integers; floats; strings} = `Assoc diff --git a/test/passing/tests/issue77.ml b/test/passing/tests/issue77.ml index 668c08e25a..33348811c5 100644 --- a/test/passing/tests/issue77.ml +++ b/test/passing/tests/issue77.ml @@ -2,8 +2,7 @@ let div = [ div ~a: [ Reactive.a_style - (React.S.map - (sprintf "height: %dpx") + (React.S.map (sprintf "height: %dpx") (State.player_height_signal app_state) ) (* ksprintf a_style "%s" (if_smth "min-height: 300px;" ""); *) ] content ] diff --git a/test/rpc/rpc_test.ml b/test/rpc/rpc_test.ml index 86b5bfe300..c91a73be3c 100644 --- a/test/rpc/rpc_test.ml +++ b/test/rpc/rpc_test.ml @@ -100,10 +100,7 @@ let close_client () = | Errored -> () let config c = - get_client () - >>= fun cl -> - log "[ocf] Config\n%!" ; - Ocf.config c cl + get_client () >>= fun cl -> log "[ocf] Config\n%!" ; Ocf.config c cl let format ?(format_args = empty_args) ?versions x = get_client ?versions () diff --git a/test/rpc/rpc_test_fail.ml b/test/rpc/rpc_test_fail.ml index a97d005283..683446e7dc 100644 --- a/test/rpc/rpc_test_fail.ml +++ b/test/rpc/rpc_test_fail.ml @@ -98,10 +98,7 @@ let close_client () = | Errored -> () let config c = - get_client () - >>= fun cl -> - log "[ocf] Config\n%!" ; - Ocf.config c cl + get_client () >>= fun cl -> log "[ocf] Config\n%!" ; Ocf.config c cl let format x = get_client () diff --git a/test/unit/test_literal_lexer.ml b/test/unit/test_literal_lexer.ml index 99a307dc63..279fb5185c 100644 --- a/test/unit/test_literal_lexer.ml +++ b/test/unit/test_literal_lexer.ml @@ -25,9 +25,8 @@ let tests_string = in let test name s ~expected_preserve ~expected_normalize = [ test_one (name ^ " (preserve)") s `Preserve ~expected:expected_preserve - ; test_one - (name ^ " (normalize)") - s `Normalize ~expected:expected_normalize ] + ; test_one (name ^ " (normalize)") s `Normalize + ~expected:expected_normalize ] in List.concat [ [test_opt "string: not a string" {|hello|} `Preserve ~expected:None]