Merge branch 'hasse/stdlib/optimize_io_format/OTP-15705'

* hasse/stdlib/optimize_io_format/OTP-15705:
  stdlib: Optimize pretty printing of strings with chars_limit
  stdlib: Optimize printing of maps a bit
  stdlib: Optimize pretty printing of lists slightly

4 files changed, 143 insertions, 77 deletions

diff --git a/lib/stdlib/src/io_lib.erl b/lib/stdlib/src/io_lib.erl
index 2b5a374cf2..21d66c5529 100644
--- a/lib/stdlib/src/io_lib.erl
+++ b/lib/stdlib/src/io_lib.erl
@@ -412,14 +412,25 @@ write_port(Port) ->
 write_ref(Ref) ->
     erlang:ref_to_list(Ref).
 
+write_map(_, 1, _E) -> "#{}";
 write_map(Map, D, E) when is_integer(D) ->
-    [$#,${,write_map_body(maps:to_list(Map), D, D - 1, E),$}].
+    I = maps:iterator(Map),
+    case maps:next(I) of
+        {K, V, NextI} ->
+            D0 = D - 1,
+            W = write_map_assoc(K, V, D0, E),
+            [$#,${,[W | write_map_body(NextI, D0, D0, E)],$}];
+        none -> "#{}"
+    end.
 
-write_map_body(_, 1, _D0, _E) -> "...";
-write_map_body([], _, _D0, _E) -> [];
-write_map_body([{K,V}], _D, D0, E) -> write_map_assoc(K, V, D0, E);
-write_map_body([{K,V}|KVs], D, D0, E) ->
-    [write_map_assoc(K, V, D0, E),$, | write_map_body(KVs, D - 1, D0, E)].
+write_map_body(_, 1, _D0, _E) -> ",...";
+write_map_body(I, D, D0, E) ->
+    case maps:next(I) of
+        {K, V, NextI} ->
+            W = write_map_assoc(K, V, D0, E),
+            [$,,W|write_map_body(NextI, D - 1, D0, E)];
+        none -> ""
+    end.
 
 write_map_assoc(K, V, D, E) ->
     [write1(K, D, E)," => ",write1(V, D, E)].
diff --git a/lib/stdlib/src/io_lib_format.erl b/lib/stdlib/src/io_lib_format.erl
index d1aa4cd157..157cc07e19 100644
--- a/lib/stdlib/src/io_lib_format.erl
+++ b/lib/stdlib/src/io_lib_format.erl
@@ -327,11 +327,11 @@ indentation([], I) -> I.
 %%                 PadChar, Encoding, StringP, ChrsLim, Indentation) -> String
 %%  These are the dispatch functions for the various formatting controls.
 
-control_small($s, [A], F, Adj, P, Pad, latin1) when is_atom(A) ->
+control_small($s, [A], F, Adj, P, Pad, latin1=Enc) when is_atom(A) ->
     L = iolist_to_chars(atom_to_list(A)),
-    string(L, F, Adj, P, Pad);
-control_small($s, [A], F, Adj, P, Pad, unicode) when is_atom(A) ->
-    string(atom_to_list(A), F, Adj, P, Pad);
+    string(L, F, Adj, P, Pad, Enc);
+control_small($s, [A], F, Adj, P, Pad, unicode=Enc) when is_atom(A) ->
+    string(atom_to_list(A), F, Adj, P, Pad, Enc);
 control_small($e, [A], F, Adj, P, Pad, _Enc) when is_float(A) ->
     fwrite_e(A, F, Adj, P, Pad);
 control_small($f, [A], F, Adj, P, Pad, _Enc) when is_float(A) ->
@@ -371,12 +371,12 @@ control_small($n, [], F, Adj, P, Pad, _Enc) -> newline(F, Adj, P, Pad);
 control_small($i, [_A], _F, _Adj, _P, _Pad, _Enc) -> [];
 control_small(_C, _As, _F, _Adj, _P, _Pad, _Enc) -> not_small.
 
-control_limited($s, [L0], F, Adj, P, Pad, latin1, _Str, CL, _I) ->
-    L = iolist_to_chars(L0),
-    string(limit_string(L, F, CL), limit_field(F, CL), Adj, P, Pad);
-control_limited($s, [L0], F, Adj, P, Pad, unicode, _Str, CL, _I) ->
-    L = cdata_to_chars(L0),
-    uniconv(string(limit_string(L, F, CL), limit_field(F, CL), Adj, P, Pad));
+control_limited($s, [L0], F, Adj, P, Pad, latin1=Enc, _Str, CL, _I) ->
+    L = iolist_to_chars(L0, F, CL),
+    string(L, limit_field(F, CL), Adj, P, Pad, Enc);
+control_limited($s, [L0], F, Adj, P, Pad, unicode=Enc, _Str, CL, _I) ->
+    L = cdata_to_chars(L0, F, CL),
+    uniconv(string(L, limit_field(F, CL), Adj, P, Pad, Enc));
 control_limited($w, [A], F, Adj, P, Pad, Enc, _Str, CL, _I) ->
     Chars = io_lib:write(A, [{depth, -1}, {encoding, Enc}, {chars_limit, CL}]),
     term(Chars, F, Adj, P, Pad);
@@ -718,7 +718,10 @@ fwrite_g(Fl, F, Adj, P, Pad) when P >= 1 ->
     end.
 
 
-%% iolist_to_chars(iolist()) -> io_lib:chars()
+iolist_to_chars(Cs, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F ->
+    iolist_to_chars(Cs);
+iolist_to_chars(Cs, _, CharsLimit) ->
+    limit_iolist_to_chars(Cs, sub(CharsLimit, 3), [], normal). % three dots
 
 iolist_to_chars([C|Cs]) when is_integer(C), C >= $\000, C =< $\377 ->
     [C | iolist_to_chars(Cs)];
@@ -729,12 +732,34 @@ iolist_to_chars([]) ->
 iolist_to_chars(B) when is_binary(B) ->
     binary_to_list(B).
 
-%% cdata() :: clist() | cbinary()
-%% clist() ::  maybe_improper_list(char() | cbinary() | clist(),
-%%                                 cbinary() | nil())
-%% cbinary() :: unicode:unicode_binary() | unicode:latin1_binary()
+limit_iolist_to_chars(Cs, 0, S, normal) ->
+    L = limit_iolist_to_chars(Cs, 4, S, final),
+    case iolist_size(L) of
+        N when N < 4 -> L;
+        4 -> "..."
+    end;
+limit_iolist_to_chars(_Cs, 0, _S, final) -> [];
+limit_iolist_to_chars([C|Cs], Limit, S, Mode) when C >= $\000, C =< $\377 ->
+    [C | limit_iolist_to_chars(Cs, Limit - 1, S, Mode)];
+limit_iolist_to_chars([I|Cs], Limit, S, Mode) ->
+    limit_iolist_to_chars(I, Limit, [Cs|S], Mode);
+limit_iolist_to_chars([], _Limit, [], _Mode) ->
+    [];
+limit_iolist_to_chars([], Limit, [Cs|S], Mode) ->
+    limit_iolist_to_chars(Cs, Limit, S, Mode);
+limit_iolist_to_chars(B, Limit, S, Mode) when is_binary(B) ->
+    case byte_size(B) of
+        Sz when Sz > Limit ->
+            {B1, B2} = split_binary(B, Limit),
+            [binary_to_list(B1) | limit_iolist_to_chars(B2, 0, S, Mode)];
+        Sz ->
+            [binary_to_list(B) | limit_iolist_to_chars([], Limit-Sz, S, Mode)]
+    end.
 
-%% cdata_to_chars(cdata()) -> io_lib:chars()
+cdata_to_chars(Cs, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F ->
+    cdata_to_chars(Cs);
+cdata_to_chars(Cs, _, CharsLimit) ->
+    limit_cdata_to_chars(Cs, sub(CharsLimit, 3), normal). % three dots
 
 cdata_to_chars([C|Cs]) when is_integer(C), C >= $\000 ->
     [C | cdata_to_chars(Cs)];
@@ -748,11 +773,25 @@ cdata_to_chars(B) when is_binary(B) ->
         _ -> binary_to_list(B)
     end.
 
-limit_string(S, F, CharsLimit) when CharsLimit < 0; CharsLimit >= F -> S;
-limit_string(S, _F, CharsLimit) ->
-    case io_lib:chars_length(S) =< CharsLimit of
-        true -> S;
-        false -> [string:slice(S, 0, sub(CharsLimit, 3)), "..."]
+limit_cdata_to_chars(Cs, 0, normal) ->
+    L = limit_cdata_to_chars(Cs, 4, final),
+    case string:length(L) of
+        N when N < 4 -> L;
+        4 -> "..."
+    end;
+limit_cdata_to_chars(_Cs, 0, final) -> [];
+limit_cdata_to_chars(Cs, Limit, Mode) ->
+    case string:next_grapheme(Cs) of
+        {error, <<C,Cs1/binary>>} ->
+            %% This is how ~ts handles Latin1 binaries with option
+            %% chars_limit.
+            [C | limit_cdata_to_chars(Cs1, Limit - 1, Mode)];
+        {error, [C|Cs1]} -> % not all versions of module string return this
+            [C | limit_cdata_to_chars(Cs1, Limit - 1, Mode)];
+        [] ->
+            [];
+        [GC|Cs1] ->
+            [GC | limit_cdata_to_chars(Cs1, Limit - 1, Mode)]
     end.
 
 limit_field(F, CharsLimit) when CharsLimit < 0; F =:= none ->
@@ -762,30 +801,30 @@ limit_field(F, CharsLimit) ->
 
 %% string(String, Field, Adjust, Precision, PadChar)
 
-string(S, none, _Adj, none, _Pad) -> S;
-string(S, F, Adj, none, Pad) ->
-    string_field(S, F, Adj, io_lib:chars_length(S), Pad);
-string(S, none, _Adj, P, Pad) ->
-    string_field(S, P, left, io_lib:chars_length(S), Pad);
-string(S, F, Adj, P, Pad) when F >= P ->
+string(S, none, _Adj, none, _Pad, _Enc) -> S;
+string(S, F, Adj, none, Pad, Enc) ->
+    string_field(S, F, Adj, io_lib:chars_length(S), Pad, Enc);
+string(S, none, _Adj, P, Pad, Enc) ->
+    string_field(S, P, left, io_lib:chars_length(S), Pad, Enc);
+string(S, F, Adj, P, Pad, Enc) when F >= P ->
     N = io_lib:chars_length(S),
     if F > P ->
 	    if N > P ->
-		    adjust(flat_trunc(S, P), chars(Pad, F-P), Adj);
+		    adjust(flat_trunc(S, P, Enc), chars(Pad, F-P), Adj);
 	       N < P ->
 		    adjust([S|chars(Pad, P-N)], chars(Pad, F-P), Adj);
 	       true -> % N == P
 		    adjust(S, chars(Pad, F-P), Adj)
 	    end;
        true -> % F == P
-	    string_field(S, F, Adj, N, Pad)
+	    string_field(S, F, Adj, N, Pad, Enc)
     end.
 
-string_field(S, F, _Adj, N, _Pad) when N > F ->
-    flat_trunc(S, F);
-string_field(S, F, Adj, N, Pad) when N < F ->
+string_field(S, F, _Adj, N, _Pad, Enc) when N > F ->
+    flat_trunc(S, F, Enc);
+string_field(S, F, Adj, N, Pad, _Enc) when N < F ->
     adjust(S, chars(Pad, F-N), Adj);
-string_field(S, _, _, _, _) -> % N == F
+string_field(S, _, _, _, _, _) -> % N == F
     S.
 
 %% unprefixed_integer(Int, Field, Adjust, Base, PadChar, Lowercase)
@@ -837,7 +876,10 @@ adjust(Data, Pad, right) -> [Pad|Data].
 
 %% Flatten and truncate a deep list to at most N elements.
 
-flat_trunc(List, N) when is_integer(N), N >= 0 ->
+flat_trunc(List, N, latin1) when is_integer(N), N >= 0 ->
+    {S, _} = lists:split(N, lists:flatten(List)),
+    S;
+flat_trunc(List, N, unicode) when is_integer(N), N >= 0 ->
     string:slice(List, 0, N).
 
 %% A deep version of lists:duplicate/2
diff --git a/lib/stdlib/src/io_lib_pretty.erl b/lib/stdlib/src/io_lib_pretty.erl
index 8f2fd7ea8f..b1a5991bf0 100644
--- a/lib/stdlib/src/io_lib_pretty.erl
+++ b/lib/stdlib/src/io_lib_pretty.erl
@@ -720,55 +720,40 @@ printable_list(_L, 1, _T, _Enc) ->
     false;
 printable_list(L, _D, T, latin1) when T < 0 ->
     io_lib:printable_latin1_list(L);
-printable_list(L, _D, T, Enc) when T >= 0 ->
-    case slice(L, tsub(T, 2), Enc) of
-        false ->
-            false;
-        {prefix, Prefix} when Enc =:= latin1 ->
-            io_lib:printable_latin1_list(Prefix) andalso {true, Prefix};
-        {prefix, Prefix} ->
-            %% Probably an overestimation.
-            io_lib:printable_list(Prefix) andalso {true, Prefix};
-        all when Enc =:= latin1 ->
-            io_lib:printable_latin1_list(L);
+printable_list(L, _D, T, latin1) when T >= 0 ->
+    N = tsub(T, 2),
+    case printable_latin1_list(L, N) of
         all ->
-            io_lib:printable_list(L)
-    end;
-printable_list(L, _D, T, _Uni) when T < 0->
-    io_lib:printable_list(L).
-
-slice(L, N, latin1) ->
-    try lists:split(N, L) of
-        {_, []} ->
-            all;
-        {[], _} ->
-            false;
-        {L1, _} ->
-            {prefix, L1}
-    catch
-        _:_ ->
-            all
+            true;
+        0 ->
+            {L1, _} = lists:split(N, L),
+            {true, L1};
+        _NC ->
+            false
     end;
-slice(L, N, _Uni) ->
+printable_list(L, _D, T, _Unicode) when T >= 0 ->
+    N = tsub(T, 2),
     %% Be careful not to traverse more of L than necessary.
     try string:slice(L, 0, N) of
         "" ->
             false;
         Prefix ->
-            %% Assume no binaries are introduced by string:slice().
             case is_flat(L, lists:flatlength(Prefix)) of
                 true ->
                     case string:equal(Prefix, L) of
                         true ->
-                            all;
+                            io_lib:printable_list(L);
                         false ->
-                            {prefix, Prefix}
+                            io_lib:printable_list(Prefix)
+                            andalso {true, Prefix}
                     end;
                 false ->
                     false
             end
     catch _:_ -> false
-    end.
+    end;
+printable_list(L, _D, T, _Uni) when T < 0->
+    io_lib:printable_list(L).
 
 is_flat(_L, 0) ->
     true;
@@ -845,7 +830,7 @@ printable_bin1(Bin, Start, Len) ->
     end.
 
 %% -> all | integer() >=0. Adopted from io_lib.erl.
-% printable_latin1_list([_ | _], 0) -> 0;
+printable_latin1_list([_ | _], 0) -> 0;
 printable_latin1_list([C | Cs], N) when C >= $\s, C =< $~ ->
     printable_latin1_list(Cs, N - 1);
 printable_latin1_list([C | Cs], N) when C >= $\240, C =< $\377 ->
diff --git a/lib/stdlib/test/io_SUITE.erl b/lib/stdlib/test/io_SUITE.erl
index 824f5d19f2..9b6d8d7401 100644
--- a/lib/stdlib/test/io_SUITE.erl
+++ b/lib/stdlib/test/io_SUITE.erl
@@ -32,7 +32,7 @@
          io_with_huge_message_queue/1, format_string/1,
 	 maps/1, coverage/1, otp_14178_unicode_atoms/1, otp_14175/1,
          otp_14285/1, limit_term/1, otp_14983/1, otp_15103/1, otp_15076/1,
-         otp_15159/1, otp_15639/1]).
+         otp_15159/1, otp_15639/1, otp_15705/1]).
 
 -export([pretty/2, trf/3]).
 
@@ -65,7 +65,7 @@ all() ->
      io_lib_width_too_small, io_with_huge_message_queue,
      format_string, maps, coverage, otp_14178_unicode_atoms, otp_14175,
      otp_14285, limit_term, otp_14983, otp_15103, otp_15076, otp_15159,
-     otp_15639].
+     otp_15639, otp_15705].
 
 %% Error cases for output.
 error_1(Config) when is_list(Config) ->
@@ -2504,9 +2504,11 @@ otp_14983(_Config) ->
 
 trunc_string() ->
     "str " = trf("str ", [], 10),
-    "str ..." = trf("str ~s", ["str"], 6),
+    "str str" = trf("str ~s", ["str"], 6),
+    "str ..." = trf("str ~s", ["str1"], 6),
     "str str" = trf("str ~s", ["str"], 7),
-    "str ..." = trf("str ~8s", ["str"], 6),
+    "str str" = trf("str ~8s", ["str"], 6),
+    "str ..." = trf("str ~8s", ["str1"], 6),
     Pa = filename:dirname(code:which(?MODULE)),
     {ok, UNode} = test_server:start_node(printable_range_unicode, slave,
 					 [{args, " +pc unicode -pa " ++ Pa}]),
@@ -2680,3 +2682,29 @@ otp_15639(_Config) ->
     "\"12345678\"..." = pretty("123456789"++[x], UOpts),
     "[[...]|...]" = pretty(["1","2","3","4","5","6","7","8"], UOpts),
     ok.
+
+otp_15705(_Config) ->
+    L = [<<"an">>,["at"],[["om"]]],
+    "..." = trf("~s", [L], 0),
+    "..." = trf("~s", [L], 1),
+    "..." = trf("~s", [L], 2),
+    "..." = trf("~s", [L], 3),
+    "a..." = trf("~s", [L], 4),
+    "an..." = trf("~s", [L], 5),
+    "anatom" = trf("~s", [L], 6),
+    L2 = ["a",[<<"na">>],[["tom"]]],
+    "..." = trf("~s", [L2], 3),
+    "a..." = trf("~s", [L2], 4),
+    "an..." = trf("~s", [L2], 5),
+    "anatom" = trf("~s", [L2], 6),
+
+    A = [[<<"äpple"/utf8>>, "plus", <<"äpple">>]],
+    "äp..." = trf("~ts", [A], 5),
+    "äppleplusäpple" = trf("~ts", [A], 14),
+    U = [["ки"],"рилл","и́ческий атом"],
+    "ки..." = trf("~ts", [U], 5),
+    "кирилли́ческий..." = trf("~ts", [U], 16),
+    "кирилли́ческий атом" = trf("~ts", [U], 20),
+
+    "|кирилли́чес|" = trf("|~10ts|", [U], -1),
+    ok.