dialyzer: Fix pretty printing of binaries

Notice the comment in dialyzer_utils:

%% Copied from core_pp. The function cerl:binary_segments/2 should/could
%% be extended to handle literals, but then the cerl module cannot be
%% HiPE-compiled as of Erlang/OTP 22.0 (due to <<I:N>>).

When at it: simplify some common cases like "/binary-unit:8".

6 files changed, 70 insertions, 21 deletions

diff --git a/lib/dialyzer/src/dialyzer_utils.erl b/lib/dialyzer/src/dialyzer_utils.erl
index 3fe026b096..245c099fef 100644
--- a/lib/dialyzer/src/dialyzer_utils.erl
+++ b/lib/dialyzer/src/dialyzer_utils.erl
@@ -46,6 +46,7 @@
 	]).
 
 -include("dialyzer.hrl").
+-include("../../compiler/src/core_parse.hrl").
 
 %%-define(DEBUG, true).
 
@@ -751,9 +752,13 @@ pp_hook(Node, Ctxt, Cont) ->
     map ->
       pp_map(Node, Ctxt, Cont);
     literal ->
-      case is_map(cerl:concrete(Node)) of
-	true -> pp_map(Node, Ctxt, Cont);
-	false -> Cont(Node, Ctxt)
+      case cerl:concrete(Node) of
+        Map when is_map(Map) ->
+          pp_map(Node, Ctxt, Cont);
+        Bitstr when is_bitstring(Bitstr) ->
+          pp_binary(Node, Ctxt, Cont);
+        _ ->
+          Cont(Node, Ctxt)
       end;
     _ ->
       Cont(Node, Ctxt)
@@ -761,7 +766,7 @@ pp_hook(Node, Ctxt, Cont) ->
 
 pp_binary(Node, Ctxt, Cont) ->
   prettypr:beside(prettypr:text("<<"),
-		  prettypr:beside(pp_segments(cerl:binary_segments(Node),
+		  prettypr:beside(pp_segments(cerl_binary_segments(Node),
 					      Ctxt, Cont),
 				  prettypr:text(">>"))).
 
@@ -780,10 +785,29 @@ pp_segment(Node, Ctxt, Cont) ->
   Unit = cerl:bitstr_unit(Node),
   Type = cerl:bitstr_type(Node),
   Flags = cerl:bitstr_flags(Node),
-  prettypr:beside(Cont(Val, Ctxt),
-		  prettypr:beside(pp_size(Size, Ctxt, Cont),
-				  prettypr:beside(pp_opts(Type, Flags),
-						  pp_unit(Unit, Ctxt, Cont)))).
+  RestPP =
+    case {concrete(Unit), concrete(Type), concrete(Flags)} of
+      {1, integer, [unsigned, big]} -> % Simplify common cases.
+        case concrete(Size) of
+          8 -> prettypr:text("");
+          _ -> pp_size(Size, Ctxt, Cont)
+        end;
+      {8, binary, [unsigned, big]} ->
+        SizePP = pp_size(Size, Ctxt, Cont),
+        prettypr:beside(SizePP,
+                        prettypr:beside(prettypr:text("/"), pp_atom(Type)));
+      _What ->
+        SizePP = pp_size(Size, Ctxt, Cont),
+        UnitPP = pp_unit(Unit, Ctxt, Cont),
+        OptsPP = pp_opts(Type, Flags),
+        prettypr:beside(SizePP, prettypr:beside(OptsPP, UnitPP))
+    end,
+  prettypr:beside(Cont(Val, Ctxt), RestPP).
+
+concrete(Cerl) ->
+  try cerl:concrete(Cerl)
+  catch _:_ -> anything_unexpected
+  end.
 
 pp_size(Size, Ctxt, Cont) ->
   case cerl:is_c_atom(Size) of
@@ -859,6 +883,31 @@ seq([H | T], Separator, Ctxt, Fun) ->
 seq([], _, _, _) ->
   [prettypr:empty()].
 
+cerl_binary_segments(#c_literal{val = B}) when is_bitstring(B) ->
+  segs_from_bitstring(B);
+cerl_binary_segments(CBinary) ->
+  cerl:binary_segments(CBinary).
+
+%% Copied from core_pp. The function cerl:binary_segments/2 should/could
+%% be extended to handle literals, but then the cerl module cannot be
+%% HiPE-compiled as of Erlang/OTP 22.0 (due to <<I:N>>).
+segs_from_bitstring(<<H,T/bitstring>>) ->
+    [#c_bitstr{val=#c_literal{val=H},
+	       size=#c_literal{val=8},
+	       unit=#c_literal{val=1},
+	       type=#c_literal{val=integer},
+	       flags=#c_literal{val=[unsigned,big]}}|segs_from_bitstring(T)];
+segs_from_bitstring(<<>>) ->
+    [];
+segs_from_bitstring(Bitstring) ->
+    N = bit_size(Bitstring),
+    <<I:N>> = Bitstring,
+    [#c_bitstr{val=#c_literal{val=I},
+	      size=#c_literal{val=N},
+	      unit=#c_literal{val=1},
+	      type=#c_literal{val=integer},
+	      flags=#c_literal{val=[unsigned,big]}}].
+
 %%------------------------------------------------------------------------------
 
 -spec refold_pattern(cerl:cerl()) -> cerl:cerl().
diff --git a/lib/dialyzer/test/opaque_SUITE_data/results/simple b/lib/dialyzer/test/opaque_SUITE_data/results/simple
index 5cd8916aee..0e1bb934e9 100644
--- a/lib/dialyzer/test/opaque_SUITE_data/results/simple
+++ b/lib/dialyzer/test/opaque_SUITE_data/results/simple
@@ -63,9 +63,9 @@ simple1_api.erl:381: Invalid type specification for function simple1_api:bool_ad
 simple1_api.erl:407: The size simple1_adt:i1() breaks the opacity of A
 simple1_api.erl:418: The attempt to match a term of type non_neg_integer() against the variable A breaks the opacity of simple1_adt:i1()
 simple1_api.erl:425: The attempt to match a term of type non_neg_integer() against the variable B breaks the opacity of simple1_adt:i1()
-simple1_api.erl:432: The pattern <<_:B/integer-unit:1>> can never match the type any()
+simple1_api.erl:432: The pattern <<_:B>> can never match the type any()
 simple1_api.erl:448: The attempt to match a term of type non_neg_integer() against the variable Sz breaks the opacity of simple1_adt:i1()
-simple1_api.erl:460: The attempt to match a term of type simple1_adt:bit1() against the pattern <<_/binary-unit:8>> breaks the opacity of the term
+simple1_api.erl:460: The attempt to match a term of type simple1_adt:bit1() against the pattern <<_/binary>> breaks the opacity of the term
 simple1_api.erl:478: The call 'foo':A(A::simple1_adt:a()) breaks the opacity of the term A :: simple1_adt:a()
 simple1_api.erl:486: The call A:'foo'(A::simple1_adt:a()) breaks the opacity of the term A :: simple1_adt:a()
 simple1_api.erl:499: The call 'foo':A(A::simple1_api:i()) requires that A is of type atom() not simple1_api:i()
diff --git a/lib/dialyzer/test/r9c_SUITE_data/results/asn1 b/lib/dialyzer/test/r9c_SUITE_data/results/asn1
index 1cf03346ee..6e51b972af 100644
--- a/lib/dialyzer/test/r9c_SUITE_data/results/asn1
+++ b/lib/dialyzer/test/r9c_SUITE_data/results/asn1
@@ -87,7 +87,7 @@ asn1rt_per_bin.erl:2127: Cons will produce an improper list since its 2nd argume
 asn1rt_per_bin.erl:2129: Cons will produce an improper list since its 2nd argument is integer()
 asn1rt_per_bin.erl:446: The variable _ can never match since previous clauses completely covered the type integer()
 asn1rt_per_bin.erl:467: The variable _ can never match since previous clauses completely covered the type integer()
-asn1rt_per_bin.erl:474: The pattern <{_N, <<_:8/integer-unit:1,Bs/binary-unit:8>>}, C> can never match since previous clauses completely covered the type <{0,_},integer()>
+asn1rt_per_bin.erl:474: The pattern <{_N, <<_,Bs/binary>>}, C> can never match since previous clauses completely covered the type <{0,_},integer()>
 asn1rt_per_bin.erl:487: The variable _ can never match since previous clauses completely covered the type integer()
 asn1rt_per_bin.erl:498: The variable _ can never match since previous clauses completely covered the type integer()
 asn1rt_per_bin_rt2ct.erl:152: The call asn1rt_per_bin_rt2ct:getbit({0,maybe_improper_list()}) will never return since it differs in the 1st argument from the success typing arguments: (<<_:8,_:_*8>> | {non_neg_integer(),<<_:1,_:_*1>>})
@@ -95,7 +95,7 @@ asn1rt_per_bin_rt2ct.erl:1533: The pattern {'BMPString', {'octets', Ol}} can nev
 asn1rt_per_bin_rt2ct.erl:1875: The pattern {Name, Val} can never match since previous clauses completely covered the type any()
 asn1rt_per_bin_rt2ct.erl:443: The variable _ can never match since previous clauses completely covered the type integer()
 asn1rt_per_bin_rt2ct.erl:464: The variable _ can never match since previous clauses completely covered the type integer()
-asn1rt_per_bin_rt2ct.erl:471: The pattern <{_N, <<_B:8/integer-unit:1,Bs/binary-unit:8>>}, C> can never match since previous clauses completely covered the type <{0,_},integer()>
+asn1rt_per_bin_rt2ct.erl:471: The pattern <{_N, <<_B,Bs/binary>>}, C> can never match since previous clauses completely covered the type <{0,_},integer()>
 asn1rt_per_bin_rt2ct.erl:484: The variable _ can never match since previous clauses completely covered the type integer()
 asn1rt_per_bin_rt2ct.erl:495: The variable _ can never match since previous clauses completely covered the type integer()
 asn1rt_per_v1.erl:1209: The pattern <_, 'true', _> can never match the type <_,'false',_>
diff --git a/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr b/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr
index dbc8241971..797f83956d 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr
+++ b/lib/dialyzer/test/small_SUITE_data/results/bs_fail_constr
@@ -1,9 +1,9 @@
 
 bs_fail_constr.erl:11: Function w3/1 has no local return
-bs_fail_constr.erl:12: Binary construction will fail since the size field S in segment 42:S/integer-unit:1 has type neg_integer()
+bs_fail_constr.erl:12: Binary construction will fail since the size field S in segment 42:S has type neg_integer()
 bs_fail_constr.erl:14: Function w4/1 has no local return
 bs_fail_constr.erl:15: Binary construction will fail since the value field V in segment V/utf32 has type float()
 bs_fail_constr.erl:5: Function w1/1 has no local return
-bs_fail_constr.erl:6: Binary construction will fail since the value field V in segment V:8/integer-unit:1 has type float()
+bs_fail_constr.erl:6: Binary construction will fail since the value field V in segment V has type float()
 bs_fail_constr.erl:8: Function w2/1 has no local return
-bs_fail_constr.erl:9: Binary construction will fail since the value field V in segment V/binary-unit:8 has type atom()
+bs_fail_constr.erl:9: Binary construction will fail since the value field V in segment V/binary has type atom()
diff --git a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring
index e148e5cf22..dc3620fcf0 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring
+++ b/lib/dialyzer/test/small_SUITE_data/results/pretty_bitstring
@@ -1,3 +1,3 @@
 
 pretty_bitstring.erl:7: Function t/0 has no local return
-pretty_bitstring.erl:8: The call binary:copy(#{#<1>(8, 1, 'integer', ['unsigned', 'big']), #<2>(8, 1, 'integer', ['unsigned', 'big']), #<3>(3, 1, 'integer', ['unsigned', 'big'])}#,2) breaks the contract (Subject,N) -> binary() when Subject :: binary(), N :: non_neg_integer()
+pretty_bitstring.erl:8: The call binary:copy(<<1,2,3:3>>,2) breaks the contract (Subject,N) -> binary() when Subject :: binary(), N :: non_neg_integer()
diff --git a/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash b/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash
index 8c9df56a4b..7fd1f304cb 100644
--- a/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash
+++ b/lib/dialyzer/test/small_SUITE_data/results/tuple_set_crash
@@ -3,12 +3,12 @@ tuple_set_crash.erl:103: Invalid type specification for function tuple_set_crash
 tuple_set_crash.erl:123: Invalid type specification for function tuple_set_crash:parse_video_target_info/1. The success typing is (<<_:48>>) -> [{'status',byte()} | {'target_id',non_neg_integer()},...]
 tuple_set_crash.erl:127: Invalid type specification for function tuple_set_crash:parse_audio_target_info/1. The success typing is (<<_:48>>) -> [{'master_volume',char()} | {'status',byte()} | {'target_id',non_neg_integer()},...]
 tuple_set_crash.erl:138: Invalid type specification for function tuple_set_crash:parse_av_device_info/1. The success typing is (<<_:48>>) -> [{'address',byte()} | {'device_id',non_neg_integer()} | {'model',binary()} | {'status',byte()},...]
-tuple_set_crash.erl:143: The pattern <<TargetId:32/integer-little-unit:1,Rest1/binary-unit:8>> can never match the type <<_:8>>
+tuple_set_crash.erl:143: The pattern <<TargetId:32/integer-little-unit:1,Rest1/binary>> can never match the type <<_:8>>
 tuple_set_crash.erl:155: Invalid type specification for function tuple_set_crash:parse_video_output_info/1. The success typing is (<<_:48>>) -> [{'audio_volume',char()} | {'display_type',binary()} | {'output_id',non_neg_integer()},...]
-tuple_set_crash.erl:160: The pattern <<DeviceId:32/integer-little-unit:1,Rest1/binary-unit:8>> can never match the type <<_:8>>
+tuple_set_crash.erl:160: The pattern <<DeviceId:32/integer-little-unit:1,Rest1/binary>> can never match the type <<_:8>>
 tuple_set_crash.erl:171: Invalid type specification for function tuple_set_crash:parse_audio_output_info/1. The success typing is (<<_:48>>) -> [{'output_id',non_neg_integer()},...]
-tuple_set_crash.erl:176: The pattern <<DeviceId:32/integer-little-unit:1,Rest1/binary-unit:8>> can never match the type <<_:8>>
-tuple_set_crash.erl:179: The pattern <<AudioVolume:16/integer-little-unit:1,Rest2/binary-unit:8>> can never match the type <<_:8>>
-tuple_set_crash.erl:182: The pattern <<Delay:16/integer-little-unit:1,_Padding/binary-unit:8>> can never match the type <<_:8>>
+tuple_set_crash.erl:176: The pattern <<DeviceId:32/integer-little-unit:1,Rest1/binary>> can never match the type <<_:8>>
+tuple_set_crash.erl:179: The pattern <<AudioVolume:16/integer-little-unit:1,Rest2/binary>> can never match the type <<_:8>>
+tuple_set_crash.erl:182: The pattern <<Delay:16/integer-little-unit:1,_Padding/binary>> can never match the type <<_:8>>
 tuple_set_crash.erl:62: The pattern {'play_list', _Playlist} can never match the type 'ok' | {'device_properties',[{atom(),_}]} | {'error',[{atom(),_}]}
 tuple_set_crash.erl:64: The pattern {'error', 17} can never match the type 'ok' | {'device_properties',[{atom(),_}]} | {'error',[{atom(),_}]}