More permissive is_trivial for strings

String of a length less than 30 are trivial. This is still more restrictive than on main.
ocaml-ppx · Sep 22, 2023 · 94e4c3c · 94e4c3c
1 parent 6547720
commit 94e4c3c
Show file tree

Hide file tree

Showing 10 changed files with 29 additions and 58 deletions.
diff --git 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
@@ -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
@@ -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 "<command-line>"

diff --git 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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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
@@ -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]