1%% -*- erlang-indent-level: 2 -*-
2%%
3%% Licensed under the Apache License, Version 2.0 (the "License");
4%% you may not use this file except in compliance with the License.
5%% You may obtain a copy of the License at
6%%
7%%     http://www.apache.org/licenses/LICENSE-2.0
8%%
9%% Unless required by applicable law or agreed to in writing, software
10%% distributed under the License is distributed on an "AS IS" BASIS,
11%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
12%% See the License for the specific language governing permissions and
13%% limitations under the License.
14
15%%%-------------------------------------------------------------------
16%%% File        : dialyzer.erl
17%%% Authors     : Tobias Lindahl <tobiasl@it.uu.se>
18%%%               Kostis Sagonas <kostis@it.uu.se>
19%%% Description : This is the interface for the Dialyzer tool.
20%%%
21%%% Created     : 27 Apr 2004 by Tobias Lindahl <tobiasl@it.uu.se>
22%%%-------------------------------------------------------------------
23
24-module(dialyzer).
25
26%%--------------------------------------------------------------------
27%% NOTE: Only functions exported by this module are available to
28%%       other applications.
29%%--------------------------------------------------------------------
30-export([plain_cl/0,
31	 run/1,
32	 gui/0,
33	 gui/1,
34	 plt_info/1,
35	 format_warning/1,
36	 format_warning/2]).
37
38-include("dialyzer.hrl").
39
40%%--------------------------------------------------------------------
41%% Interfaces:
42%%  - plain_cl/0 :      to be used ONLY by the dialyzer C program.
43%%  - run/1:            Erlang interface for a command line-like analysis
44%%  - gui/0/1:          Erlang interface for the gui.
45%%  - format_warning/1: Get the string representation of a warning.
46%%  - format_warning/2: Likewise, but with an option whether
47%%			to display full path names or not
48%%  - plt_info/1:       Get information of the specified plt.
49%%--------------------------------------------------------------------
50
51-spec plain_cl() -> no_return().
52
53plain_cl() ->
54  case dialyzer_cl_parse:start() of
55    {check_init, Opts} ->
56      cl_halt(cl_check_init(Opts), Opts);
57    {plt_info, Opts} ->
58      cl_halt(cl_print_plt_info(Opts), Opts);
59    {gui, Opts} ->
60      try check_gui_options(Opts)
61      catch throw:{dialyzer_error, Msg} -> cl_error(Msg)
62      end,
63      case Opts#options.check_plt of
64	true ->
65	  case cl_check_init(Opts#options{get_warnings = false}) of
66	    {ok, _} -> gui_halt(internal_gui(Opts), Opts);
67	    {error, _} = Error -> cl_halt(Error, Opts)
68	  end;
69	false ->
70	  gui_halt(internal_gui(Opts), Opts)
71      end;
72    {cl, Opts} ->
73      case Opts#options.check_plt of
74	true ->
75	  case cl_check_init(Opts#options{get_warnings = false}) of
76	    {error, _} = Error -> cl_halt(Error, Opts);
77	    {ok, _} -> cl_halt(cl(Opts), Opts)
78	  end;
79	false ->
80	  cl_halt(cl(Opts), Opts)
81      end;
82    {error, Msg} ->
83      cl_error(Msg)
84  end.
85
86cl_check_init(#options{analysis_type = AnalType} = Opts) ->
87  case AnalType of
88    plt_build ->  {ok, ?RET_NOTHING_SUSPICIOUS};
89    plt_add ->    {ok, ?RET_NOTHING_SUSPICIOUS};
90    plt_remove -> {ok, ?RET_NOTHING_SUSPICIOUS};
91    Other when Other =:= succ_typings; Other =:= plt_check ->
92      F = fun() ->
93	      NewOpts = Opts#options{analysis_type = plt_check},
94	      {Ret, _Warnings} = dialyzer_cl:start(NewOpts),
95	      Ret
96	  end,
97      doit(F)
98  end.
99
100cl_print_plt_info(Opts) ->
101  F = fun() ->
102	  print_plt_info(Opts)
103      end,
104  doit(F).
105
106print_plt_info(#options{init_plts = PLTs, output_file = OutputFile}) ->
107  PLTInfo = get_plt_info(PLTs),
108  do_print_plt_info(PLTInfo, OutputFile).
109
110get_plt_info([PLT|PLTs]) ->
111  String =
112    case dialyzer_plt:included_files(PLT) of
113      {ok, Files} ->
114	io_lib:format("The PLT ~ts includes the following files:\n~tp\n\n",
115		      [PLT, Files]);
116      {error, read_error} ->
117	Msg = io_lib:format("Could not read the PLT file ~tp\n\n", [PLT]),
118	throw({dialyzer_error, Msg});
119      {error, no_such_file} ->
120	Msg = io_lib:format("The PLT file ~tp does not exist\n\n", [PLT]),
121	throw({dialyzer_error, Msg})
122    end,
123  String ++ get_plt_info(PLTs);
124get_plt_info([]) -> "".
125
126do_print_plt_info(PLTInfo, OutputFile) ->
127  case OutputFile =:= none of
128    true ->
129      io:format("~ts", [PLTInfo]),
130      ?RET_NOTHING_SUSPICIOUS;
131    false ->
132      case file:open(OutputFile, [write]) of
133	{ok, FileDesc} ->
134	  io:format(FileDesc, "~ts", [PLTInfo]),
135	  ok = file:close(FileDesc),
136	  ?RET_NOTHING_SUSPICIOUS;
137	{error, Reason} ->
138	  Msg1 = io_lib:format("Could not open output file ~tp, Reason: ~p\n",
139			       [OutputFile, Reason]),
140	  throw({dialyzer_error, Msg1})
141      end
142  end.
143
144cl(Opts) ->
145  F = fun() ->
146	  {Ret, _Warnings} = dialyzer_cl:start(Opts),
147	  Ret
148      end,
149  doit(F).
150
151-spec run(Options) -> Warnings when
152    Options :: [dial_option()],
153    Warnings :: [dial_warning()].
154
155run(Opts) ->
156  try dialyzer_options:build([{report_mode, quiet},
157			      {erlang_mode, true}|Opts]) of
158    {error, Msg} ->
159      throw({dialyzer_error, Msg});
160    OptsRecord ->
161      ok = check_init(OptsRecord),
162      case dialyzer_cl:start(OptsRecord) of
163        {?RET_DISCREPANCIES, Warnings} -> Warnings;
164        {?RET_NOTHING_SUSPICIOUS, _}  -> []
165      end
166  catch
167    throw:{dialyzer_error, ErrorMsg} ->
168      erlang:error({dialyzer_error, lists:flatten(ErrorMsg)})
169  end.
170
171check_init(#options{analysis_type = plt_check}) ->
172    ok;
173check_init(#options{check_plt = true} = OptsRecord) ->
174    case cl_check_init(OptsRecord) of
175	{ok, _} -> ok;
176	{error, Msg} -> throw({dialyzer_error, Msg})
177    end;
178check_init(#options{check_plt = false}) ->
179    ok.
180
181internal_gui(OptsRecord) ->
182  F = fun() ->
183	  dialyzer_gui_wx:start(OptsRecord),
184	  ?RET_NOTHING_SUSPICIOUS
185      end,
186  doit(F).
187
188-spec gui() -> 'ok'.
189
190gui() ->
191  gui([]).
192
193-spec gui(Options) -> 'ok' when
194    Options :: [dial_option()].
195
196gui(Opts) ->
197  try dialyzer_options:build([{report_mode, quiet}|Opts]) of
198    {error, Msg} ->
199      throw({dialyzer_error, Msg});
200    OptsRecord ->
201      ok = check_gui_options(OptsRecord),
202      ok = check_init(OptsRecord),
203      F = fun() ->
204          dialyzer_gui_wx:start(OptsRecord)
205      end,
206      case doit(F) of
207	  {ok, _} -> ok;
208	  {error, Msg} -> throw({dialyzer_error, Msg})
209      end
210  catch
211    throw:{dialyzer_error, ErrorMsg} ->
212      erlang:error({dialyzer_error, lists:flatten(ErrorMsg)})
213  end.
214
215check_gui_options(#options{analysis_type = succ_typings}) ->
216  ok;
217check_gui_options(#options{analysis_type = Mode}) ->
218  Msg = io_lib:format("Analysis mode ~w is illegal in GUI mode", [Mode]),
219  throw({dialyzer_error, Msg}).
220
221-spec plt_info(Plt) ->
222     {'ok', Result} | {'error', Reason} when
223    Plt :: file:filename(),
224    Result :: [{'files', [file:filename()]}],
225    Reason :: 'not_valid' | 'no_such_file' | 'read_error'.
226
227plt_info(Plt) ->
228  case dialyzer_plt:included_files(Plt) of
229    {ok, Files} -> {ok, [{files, Files}]};
230    Error -> Error
231  end.
232
233
234%%-----------
235%% Machinery
236%%-----------
237
238-type doit_ret() :: {'ok', dial_ret()} | {'error', string()}.
239
240doit(F) ->
241  try
242    {ok, F()}
243  catch
244    throw:{dialyzer_error, Msg} ->
245      {error, lists:flatten(Msg)}
246  end.
247
248-spec cl_error(string()) -> no_return().
249
250cl_error(Msg) ->
251  cl_halt({error, Msg}, #options{}).
252
253-spec gui_halt(doit_ret(), #options{}) -> no_return().
254
255gui_halt(R, Opts) ->
256  cl_halt(R, Opts#options{report_mode = quiet}).
257
258-spec cl_halt(doit_ret(), #options{}) -> no_return().
259
260cl_halt({ok, R = ?RET_NOTHING_SUSPICIOUS}, #options{report_mode = quiet}) ->
261  halt(R);
262cl_halt({ok, R = ?RET_DISCREPANCIES}, #options{report_mode = quiet}) ->
263  halt(R);
264cl_halt({ok, R = ?RET_NOTHING_SUSPICIOUS}, #options{}) ->
265  io:put_chars("done (passed successfully)\n"),
266  halt(R);
267cl_halt({ok, R = ?RET_DISCREPANCIES}, #options{output_file = Output}) ->
268  io:put_chars("done (warnings were emitted)\n"),
269  cl_check_log(Output),
270  halt(R);
271cl_halt({error, Msg1}, #options{output_file = Output}) ->
272  %% Msg2 = "dialyzer: Internal problems were encountered in the analysis",
273  io:format("\ndialyzer: ~ts\n", [Msg1]),
274  cl_check_log(Output),
275  halt(?RET_INTERNAL_ERROR).
276
277-spec cl_check_log('none' | file:filename()) -> 'ok'.
278
279cl_check_log(none) ->
280  ok;
281cl_check_log(Output) ->
282  io:format("  Check output file `~ts' for details\n", [Output]).
283
284-spec format_warning(Warnings) -> string() when
285    %% raw_warning() | % not documented
286    Warnings :: dial_warning().
287
288format_warning(W) ->
289  format_warning(W, basename).
290
291-type format_option()  :: {'indent_opt', boolean()}
292                        | {'filename_opt', filename_opt()}
293                        | {'error_location', error_location()}.
294
295-spec format_warning(Warnings, Options) -> string() when
296    %% raw_warning() | % not documented
297    Warnings :: dial_warning(),
298    Options :: filename_opt() | [format_option()].
299
300format_warning(RawWarning, FOpt) when is_atom(FOpt) ->
301  format_warning(RawWarning, [{filename_opt, FOpt}]);
302format_warning({Tag, {File, Location, _MFA}, Msg}, Opts) ->
303  format_warning({Tag, {File, Location}, Msg}, Opts);
304format_warning({_Tag, {File, Location}, Msg}, Opts) when is_list(File) ->
305  F = case proplists:get_value(filename_opt, Opts, basename) of
306	fullpath -> File;
307	basename -> filename:basename(File)
308      end,
309  Indent = proplists:get_value(indent_opt, Opts, ?INDENT_OPT),
310  ErrorLocation =
311    proplists:get_value(error_location, Opts, ?ERROR_LOCATION),
312  String = message_to_string(Msg, Indent, ErrorLocation),
313  PosString = pos(Location, ErrorLocation),
314  lists:flatten(io_lib:format("~ts:~s: ~ts", [F, PosString, String])).
315
316pos({Line, _Column}, line) ->
317  pos(Line);
318pos(Location, _ErrorLocation) ->
319  pos(Location).
320
321pos({Line, Column}) when is_integer(Line), is_integer(Column) ->
322    io_lib:format("~w:~w", [Line, Column]);
323pos(Line) when is_integer(Line) ->
324    io_lib:format("~w", [Line]).
325
326%%-----------------------------------------------------------------------------
327%% Message classification and pretty-printing below. Messages appear in
328%% categories and in more or less alphabetical ordering within each category.
329%%-----------------------------------------------------------------------------
330
331%%----- Warnings for general discrepancies ----------------
332message_to_string({apply, [Args, ArgNs, FailReason,
333			   SigArgs, SigRet, Contract]}, I, _E) ->
334  io_lib:format("Fun application with arguments ~ts ", [a(Args, I)]) ++
335    call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, Contract, I);
336message_to_string({app_call, [M, F, Args, Culprit, ExpectedType, FoundType]},
337                  I, _E) ->
338  io_lib:format("The call ~s:~ts~ts requires that ~ts is of type ~ts not ~ts\n",
339		[M, F, a(Args, I), c(Culprit, I),
340                 t(ExpectedType, I), t(FoundType, I)]);
341message_to_string({bin_construction, [Culprit, Size, Seg, Type]}, I, _E) ->
342  io_lib:format("Binary construction will fail since the ~s field ~s in"
343		" segment ~s has type ~s\n",
344                [Culprit, c(Size, I), c(Seg, I), t(Type, I)]);
345message_to_string({call, [M, F, Args, ArgNs, FailReason,
346			  SigArgs, SigRet, Contract]}, I, _E) ->
347  io_lib:format("The call ~w:~tw~ts ", [M, F, a(Args, I)]) ++
348    call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet, Contract, I);
349message_to_string({call_to_missing, [M, F, A]}, _I, _E) ->
350  io_lib:format("Call to missing or unexported function ~w:~tw/~w\n",
351                [M, F, A]);
352message_to_string({exact_eq, [Type1, Op, Type2]}, I, _E) ->
353  io_lib:format("The test ~ts ~s ~ts can never evaluate to 'true'\n",
354		[t(Type1, I), Op, t(Type2, I)]);
355message_to_string({fun_app_args, [ArgNs, Args, Type]}, I, _E) ->
356  PositionString = form_position_string(ArgNs),
357  io_lib:format("Fun application with arguments ~ts will fail"
358		" since the function has type ~ts,"
359                " which differs in the ~s argument\n",
360                [a(Args, I), t(Type, I), PositionString]);
361message_to_string({fun_app_no_fun, [Op, Type, Arity]}, I, _E) ->
362  io_lib:format("Fun application will fail since ~ts :: ~ts"
363		" is not a function of arity ~w\n", [Op, t(Type, I), Arity]);
364message_to_string({guard_fail, []}, _I, _E) ->
365  "Clause guard cannot succeed.\n";
366message_to_string({guard_fail, [Arg1, Infix, Arg2]}, I, _E) ->
367  io_lib:format("Guard test ~ts ~s ~ts can never succeed\n",
368                [a(Arg1, I), Infix, a(Arg2, I)]); % a/2 rather than c/2
369message_to_string({map_update, [Type, Key]}, I, _E) ->
370  io_lib:format("A key of type ~ts cannot exist "
371		"in a map of type ~ts\n", [t(Key, I), t(Type, I)]);
372message_to_string({neg_guard_fail, [Arg1, Infix, Arg2]}, I, _E) ->
373  io_lib:format("Guard test not(~ts ~s ~ts) can never succeed\n",
374		[a(Arg1, I), Infix, a(Arg2, I)]); % a/2 rather than c/2
375message_to_string({guard_fail, [Guard, Args]}, I, _E) ->
376  io_lib:format("Guard test ~s~ts can never succeed\n", [Guard, a(Args, I)]);
377message_to_string({neg_guard_fail, [Guard, Args]}, I, _E) ->
378  io_lib:format("Guard test not(~s~ts) can never succeed\n",
379                [Guard, a(Args, I)]);
380message_to_string({guard_fail_pat, [Pat, Type]}, I, _E) ->
381  io_lib:format("Clause guard cannot succeed. The ~ts was matched"
382		" against the type ~ts\n", [ps(Pat, I), t(Type, I)]);
383message_to_string({improper_list_constr, [TlType]}, I, _E) ->
384  io_lib:format("Cons will produce an improper list"
385		" since its 2nd argument is ~ts\n", [t(TlType, I)]);
386message_to_string({no_return, [Type|Name]}, _I, _E) ->
387  NameString =
388    case Name of
389      [] -> "The created fun ";
390      [F, A] -> io_lib:format("Function ~tw/~w ", [F, A])
391    end,
392  case Type of
393    no_match -> NameString ++ "has no clauses that will ever match\n";
394    only_explicit -> NameString ++ "only terminates with explicit exception\n";
395    only_normal -> NameString ++ "has no local return\n";
396    both -> NameString ++ "has no local return\n"
397  end;
398message_to_string({record_constr, [RecConstr, FieldDiffs]}, I, _E) ->
399  io_lib:format("Record construction ~ts violates the"
400		" declared type of field ~ts\n",
401                [t(RecConstr, I), field_diffs(FieldDiffs, I)]);
402message_to_string({record_constr, [Name, Field, Type]}, I, _E) ->
403  io_lib:format("Record construction violates the declared type for #~tw{}"
404		" since ~ts cannot be of type ~ts\n",
405                [Name, ps(Field, I), t(Type, I)]);
406message_to_string({record_matching, [String, Name]}, I, _E) ->
407  io_lib:format("The ~ts violates the"
408		" declared type for #~tw{}\n", [rec_type(String, I), Name]);
409message_to_string({record_match, [Pat, Type]}, I, _E) ->
410  io_lib:format("Matching of ~ts tagged with a record name violates"
411                " the declared type of ~ts\n", [ps(Pat, I), t(Type, I)]);
412message_to_string({pattern_match, [Pat, Type]}, I, _E) ->
413  io_lib:format("The ~ts can never match the type ~ts\n",
414                [ps(Pat, I), t(Type, I)]);
415message_to_string({pattern_match_cov, [Pat, Type]}, I, _E) ->
416  io_lib:format("The ~ts can never match since previous"
417		" clauses completely covered the type ~ts\n",
418		[ps(Pat, I), t(Type, I)]);
419message_to_string({unmatched_return, [Type]}, I, _E) ->
420  io_lib:format("Expression produces a value of type ~ts,"
421		" but this value is unmatched\n", [t(Type, I)]);
422message_to_string({unused_fun, [F, A]}, _I, _E) ->
423  io_lib:format("Function ~tw/~w will never be called\n", [F, A]);
424%%----- Warnings for specs and contracts -------------------
425message_to_string({contract_diff, [M, F, _A, Contract, Sig]}, I, _E) ->
426  io_lib:format("Type specification ~ts"
427		" is not equal to the success typing: ~ts\n",
428		[con(M, F, Contract, I), con(M, F, Sig, I)]);
429message_to_string({contract_subtype, [M, F, _A, Contract, Sig]}, I, _E) ->
430  io_lib:format("Type specification ~ts"
431		" is a subtype of the success typing: ~ts\n",
432		[con(M, F, Contract, I), con(M, F, Sig, I)]);
433message_to_string({contract_supertype, [M, F, _A, Contract, Sig]}, I, _E) ->
434  io_lib:format("Type specification ~ts"
435		" is a supertype of the success typing: ~ts\n",
436		[con(M, F, Contract, I), con(M, F, Sig, I)]);
437message_to_string({contract_range, [Contract, M, F, ArgStrings,
438                                    Location, CRet]}, I, E) ->
439  io_lib:format("The contract ~ts cannot be right because the inferred"
440		" return for ~tw~ts on position ~s is ~ts\n",
441		[con(M, F, Contract, I), F, a(ArgStrings, I),
442                 pos(Location, E), t(CRet, I)]);
443message_to_string({invalid_contract, [M, F, A, Sig]}, I, _E) ->
444  io_lib:format("Invalid type specification for function ~w:~tw/~w."
445		" The success typing is ~ts\n", [M, F, A, sig(Sig, I)]);
446message_to_string({contract_with_opaque, [M, F, A, OpaqueType, SigType]},
447                 I, _E) ->
448  io_lib:format("The specification for ~w:~tw/~w"
449                " has an opaque subtype ~ts which is violated by the"
450                " success typing ~ts\n",
451                [M, F, A, t(OpaqueType, I), sig(SigType, I)]);
452message_to_string({extra_range, [M, F, A, ExtraRanges, SigRange]}, I, _E) ->
453  io_lib:format("The specification for ~w:~tw/~w states that the function"
454		" might also return ~ts but the inferred return is ~ts\n",
455		[M, F, A, t(ExtraRanges, I), t(SigRange, I)]);
456message_to_string({missing_range, [M, F, A, ExtraRanges, ContrRange]}, I, _E) ->
457  io_lib:format("The success typing for ~w:~tw/~w implies that the function"
458		" might also return ~ts but the specification return is ~ts\n",
459		[M, F, A, t(ExtraRanges, I), t(ContrRange, I)]);
460message_to_string({overlapping_contract, [M, F, A]}, _I, _E) ->
461  io_lib:format("Overloaded contract for ~w:~tw/~w has overlapping domains;"
462		" such contracts are currently unsupported and are simply ignored\n",
463		[M, F, A]);
464message_to_string({spec_missing_fun, [M, F, A]}, _I, _E) ->
465  io_lib:format("Contract for function that does not exist: ~w:~tw/~w\n",
466		[M, F, A]);
467%%----- Warnings for opaque type violations -------------------
468message_to_string({call_with_opaque, [M, F, Args, ArgNs, ExpArgs]}, I, _E) ->
469  io_lib:format("The call ~w:~tw~ts contains ~ts when ~ts\n",
470		[M, F, a(Args, I), form_positions(ArgNs),
471                 form_expected(ExpArgs, I)]);
472message_to_string({call_without_opaque, [M, F, Args, ExpectedTriples]}, I, _E) ->
473  io_lib:format("The call ~w:~tw~ts does not have ~ts\n",
474		[M, F, a(Args, I),
475                 form_expected_without_opaque(ExpectedTriples, I)]);
476message_to_string({opaque_eq, [Type, _Op, OpaqueType]}, I, _E) ->
477  io_lib:format("Attempt to test for equality between a term of type ~ts"
478		" and a term of opaque type ~ts\n",
479                [t(Type, I), t(OpaqueType, I)]);
480message_to_string({opaque_guard, [Arg1, Infix, Arg2, ArgNs]}, I, _E) ->
481  io_lib:format("Guard test ~ts ~s ~ts contains ~s\n",
482		[a(Arg1, I), Infix, a(Arg2, I), form_positions(ArgNs)]);
483message_to_string({opaque_guard, [Guard, Args]}, I, _E) ->
484  io_lib:format("Guard test ~w~ts breaks the opacity of its argument\n",
485		[Guard, a(Args, I)]);
486message_to_string({opaque_match, [Pat, OpaqueType, OpaqueTerm]}, I, _E) ->
487  Term = if OpaqueType =:= OpaqueTerm -> "the term";
488	    true -> t(OpaqueTerm, I)
489	 end,
490  io_lib:format("The attempt to match a term of type ~ts against the ~ts"
491		" breaks the opacity of ~ts\n",
492                [t(OpaqueType, I), ps(Pat, I), Term]);
493message_to_string({opaque_neq, [Type, _Op, OpaqueType]}, I, _E) ->
494  io_lib:format("Attempt to test for inequality between a term of type ~ts"
495		" and a term of opaque type ~ts\n",
496                [t(Type, I), t(OpaqueType, I)]);
497message_to_string({opaque_type_test, [Fun, Args, Arg, ArgType]}, I, _E) ->
498  io_lib:format("The type test ~ts~ts breaks the opacity of the term ~ts~ts\n",
499                [Fun, a(Args, I), Arg, t(ArgType, I)]);
500message_to_string({opaque_size, [SizeType, Size]}, I, _E) ->
501  io_lib:format("The size ~ts breaks the opacity of ~ts\n",
502                [t(SizeType, I), c(Size, I)]);
503message_to_string({opaque_call, [M, F, Args, Culprit, OpaqueType]}, I, _E) ->
504  io_lib:format("The call ~s:~ts~ts breaks the opacity of the term ~ts :: ~ts\n",
505                [M, F, a(Args, I), c(Culprit, I), t(OpaqueType, I)]);
506%%----- Warnings for concurrency errors --------------------
507message_to_string({race_condition, [M, F, Args, Reason]}, I, _E) ->
508  %% There is a possibly huge type in Reason.
509  io_lib:format("The call ~w:~tw~ts ~ts\n", [M, F, a(Args, I), Reason]);
510%%----- Warnings for behaviour errors --------------------
511message_to_string({callback_type_mismatch, [B, F, A, ST, CT]}, I, _E) ->
512  io_lib:format("The inferred return type of ~tw/~w ~ts has nothing in"
513                " common with ~ts, which is the expected return type for"
514                " the callback of the ~w behaviour\n",
515                [F, A, t("("++ST++")", I), t(CT, I), B]);
516message_to_string({callback_arg_type_mismatch, [B, F, A, N, ST, CT]}, I, _E) ->
517  io_lib:format("The inferred type for the ~s argument of ~tw/~w (~ts) is"
518		" not a supertype of ~ts, which is expected type for this"
519		" argument in the callback of the ~w behaviour\n",
520		[ordinal(N), F, A, t(ST, I), t(CT, I), B]);
521message_to_string({callback_spec_type_mismatch, [B, F, A, ST, CT]}, I, _E) ->
522  io_lib:format("The return type ~ts in the specification of ~tw/~w is not a"
523		" subtype of ~ts, which is the expected return type for the"
524		" callback of the ~w behaviour\n",
525                [t(ST, I), F, A, t(CT, I), B]);
526message_to_string({callback_spec_arg_type_mismatch, [B, F, A, N, ST, CT]},
527                  I, _E) ->
528  io_lib:format("The specified type for the ~ts argument of ~tw/~w (~ts) is"
529		" not a supertype of ~ts, which is expected type for this"
530		" argument in the callback of the ~w behaviour\n",
531		[ordinal(N), F, A, t(ST, I), t(CT, I), B]);
532message_to_string({callback_missing, [B, F, A]}, _I, _E) ->
533  io_lib:format("Undefined callback function ~tw/~w (behaviour ~w)\n",
534		[F, A, B]);
535message_to_string({callback_info_missing, [B]}, _I, _E) ->
536  io_lib:format("Callback info about the ~w behaviour is not available\n", [B]);
537%%----- Warnings for unknown functions, types, and behaviours -------------
538message_to_string({unknown_type, {M, F, A}}, _I, _E) ->
539  io_lib:format("Unknown type ~w:~tw/~w", [M, F, A]);
540message_to_string({unknown_function, {M, F, A}}, _I, _E) ->
541  io_lib:format("Unknown function ~w:~tw/~w", [M, F, A]);
542message_to_string({unknown_behaviour, B}, _I, _E) ->
543  io_lib:format("Unknown behaviour ~w", [B]).
544
545%%-----------------------------------------------------------------------------
546%% Auxiliary functions below
547%%-----------------------------------------------------------------------------
548
549call_or_apply_to_string(ArgNs, FailReason, SigArgs, SigRet,
550			{IsOverloaded, Contract}, I) ->
551  PositionString = form_position_string(ArgNs),
552  case FailReason of
553    only_sig ->
554      case ArgNs =:= [] of
555	true ->
556	  %% We do not know which argument(s) caused the failure
557	  io_lib:format("will never return since the success typing arguments"
558			" are ~ts\n", [t(SigArgs, I)]);
559        false ->
560	  io_lib:format("will never return since it differs in the ~s argument"
561			" from the success typing arguments: ~ts\n",
562			[PositionString, t(SigArgs, I)])
563      end;
564    only_contract ->
565      case (ArgNs =:= []) orelse IsOverloaded of
566	true ->
567	  %% We do not know which arguments caused the failure
568	  io_lib:format("breaks the contract ~ts\n", [sig(Contract, I)]);
569	false ->
570	  io_lib:format("breaks the contract ~ts in the ~s argument\n",
571			[sig(Contract, I), PositionString])
572      end;
573    both ->
574      io_lib:format("will never return since the success typing is ~ts -> ~ts"
575		    " and the contract is ~ts\n",
576                    [t(SigArgs, I), t(SigRet, I), sig(Contract, I)])
577  end.
578
579form_positions(ArgNs) ->
580  case ArgNs of
581    [_] -> "an opaque term as ";
582    [_,_|_] -> "opaque terms as "
583 end ++ form_position_string(ArgNs) ++
584  case ArgNs of
585    [_] -> " argument";
586    [_,_|_] -> " arguments"
587  end.
588
589%% We know which positions N are to blame;
590%% the list of triples will never be empty.
591form_expected_without_opaque([{N, T, TStr}], I) ->
592  case erl_types:t_is_opaque(T) of
593    true  ->
594      io_lib:format("an opaque term of type ~ts as ", [t(TStr, I)]);
595    false ->
596      io_lib:format("a term of type ~ts (with opaque subterms) as ",
597                    [t(TStr, I)])
598  end ++ form_position_string([N]) ++ " argument";
599form_expected_without_opaque(ExpectedTriples, _I) -> %% TODO: can do much better here
600  {ArgNs, _Ts, _TStrs} = lists:unzip3(ExpectedTriples),
601  "opaque terms as " ++ form_position_string(ArgNs) ++ " arguments".
602
603form_expected(ExpectedArgs, I) ->
604  case ExpectedArgs of
605    [T] ->
606      TS = erl_types:t_to_string(T),
607      case erl_types:t_is_opaque(T) of
608	true  -> io_lib:format("an opaque term of type ~ts is expected",
609                               [t(TS, I)]);
610	false -> io_lib:format("a structured term of type ~ts is expected",
611                               [t(TS, I)])
612      end;
613    [_,_|_] -> "terms of different types are expected in these positions"
614  end.
615
616form_position_string(ArgNs) ->
617  case ArgNs of
618    [] -> "";
619    [N1] -> ordinal(N1);
620    [_,_|_] ->
621      [Last|Prevs] = lists:reverse(ArgNs),
622      ", " ++ Head = lists:flatten([io_lib:format(", ~s",[ordinal(N)]) ||
623				     N <- lists:reverse(Prevs)]),
624      Head ++ " and " ++ ordinal(Last)
625  end.
626
627ordinal(1) -> "1st";
628ordinal(2) -> "2nd";
629ordinal(3) -> "3rd";
630ordinal(N) when is_integer(N) -> io_lib:format("~wth", [N]).
631
632%% Functions that parse type strings, literal strings, and contract
633%% strings. Return strings formatted by erl_pp.
634
635%% Note we always have to catch any error when trying to parse
636%% the syntax because other BEAM languages may not emit an
637%% Erlang AST that transforms into valid Erlang Source Code.
638
639-define(IND, 10).
640
641con(M, F, Src, I) ->
642  S = sig(Src, I),
643  io_lib:format("~w:~tw~ts", [M, F, S]).
644
645sig(Src, false) ->
646  Src;
647sig(Src, true) ->
648  try
649    Str = lists:flatten(io_lib:format("-spec ~w:~tw~ts.", [a, b, Src])),
650    {ok, Tokens, _EndLocation} = erl_scan:string(Str),
651    {ok, {attribute, _, spec, {_MFA, Types}}} =
652      erl_parse:parse_form(Tokens),
653    indentation(?IND) ++ pp_spec(Types)
654  catch
655    _:_ -> Src
656  end.
657
658%% Argument(list)s are a mix of types and Erlang code. Note: sometimes
659%% (contract_range, call_without_opaque, opaque_type_test), the initial
660%% newline is a bit out of place.
661a(""=Args, _I) ->
662  Args;
663a(Args, I) ->
664  t(Args, I).
665
666c(Cerl, _I) ->
667  Cerl.
668
669field_diffs(Src, false) ->
670  Src;
671field_diffs(Src, true) ->
672  Fields = string:split(Src, " and ", all),
673  lists:join(" and ", [field_diff(Field) || Field <- Fields]).
674
675field_diff(Field) ->
676  [F | Ts] = string:split(Field, "::", all),
677  F ++ " ::" ++ t(lists:flatten(lists:join("::", Ts)), true).
678
679rec_type("record "++Src, I) ->
680  "record " ++ t(Src, I).
681
682%% "variable"/"pattern" ++ cerl
683ps("pattern "++Src, I) ->
684  "pattern " ++ t(Src, I);
685ps("variable "++_=Src, _I) ->
686  Src;
687ps("record field"++Rest, I) ->
688  [S, TypeStr] = string:split(Rest, "of type ", all),
689  "record field" ++ S ++ "of type " ++ t(TypeStr, I).
690
691%% Scan and parse a type or a literal, and pretty-print it using erl_pp.
692t(Src, false) ->
693  Src;
694t("("++_=Src, true) ->
695  ts(Src);
696t(Src, true) ->
697  %% Binary types and products both start with a $<.
698  try parse_type_or_literal(Src) of
699    TypeOrLiteral ->
700      indentation(?IND) ++ pp_type(TypeOrLiteral)
701  catch
702    _:_ ->
703      ts(Src)
704  end.
705
706ts(Src) ->
707  Ind = indentation(?IND),
708  [C1|Src1] = Src, % $< (product) or $( (arglist)
709  [C2|RevSrc2] = lists:reverse(Src1),
710  Src2 = lists:reverse(RevSrc2),
711  try
712    Types = parse_types_and_literals(Src2),
713    CommaInd = [$, | Ind],
714    (indentation(?IND-1) ++
715     [C1 | lists:join(CommaInd, [pp_type(Type) || Type <- Types])] ++
716     [C2])
717  catch
718    _:_ -> Src
719  end.
720
721indentation(I) ->
722  [$\n | lists:duplicate(I, $\s)].
723
724pp_type(Type) ->
725  Form = {attribute, erl_anno:new(0), type, {t, Type, []}},
726  TypeDef = erl_pp:form(Form, [{quote_singleton_atom_types, true}]),
727  {match, [S]} = re:run(TypeDef, <<"::\\s*(.*)\\.\\n*">>,
728                        [{capture, all_but_first, list}, dotall]),
729  S.
730
731pp_spec(Spec) ->
732  Form = {attribute, erl_anno:new(0), spec, {{a,b,0}, Spec}},
733  Sig = erl_pp:form(Form, [{quote_singleton_atom_types, true}]),
734  {match, [S]} = re:run(Sig, <<"-spec a:b\\s*(.*)\\.\\n*">>,
735                        [{capture, all_but_first, list}, dotall]),
736  S.
737
738parse_types_and_literals(Src) ->
739  {ok, Tokens, _EndLocation} = erl_scan:string(Src),
740  [parse_a_type_or_literal(Ts) || Ts <- types(Tokens)].
741
742parse_type_or_literal(Src) ->
743  {ok, Tokens, _EndLocation} = erl_scan:string(Src),
744  parse_a_type_or_literal(Tokens).
745
746parse_a_type_or_literal(Ts0) ->
747  L = erl_anno:new(1),
748  Ts = Ts0 ++ [{dot,L}],
749  Tokens = [{'-',L}, {atom,L,type}, {atom,L,t}, {'(',L}, {')',L},
750            {'::',L}] ++ Ts,
751  case erl_parse:parse_form(Tokens) of
752      {ok, {attribute, _, type, {t, Type, []}}} ->
753          Type;
754      {error, _} ->
755          %% literal
756          {ok, [T]} = erl_parse:parse_exprs(Ts),
757          T
758  end.
759
760types([]) -> [];
761types(Ts) ->
762    {Ts0, Ts1} = one_type(Ts, [], []),
763    [Ts0 | types(Ts1)].
764
765one_type([], [], Ts) ->
766    {lists:reverse(Ts), []};
767one_type([{',', _Lc}|Toks], [], Ts0) ->
768    {lists:reverse(Ts0), Toks};
769one_type([{')', Lrp}|Toks], [], Ts0) ->
770    {lists:reverse(Ts0), [{')', Lrp}|Toks]};
771one_type([{'(', Llp}|Toks], E, Ts0) ->
772    one_type(Toks, [')'|E], [{'(', Llp}|Ts0]);
773one_type([{'<<', Lls}|Toks], E, Ts0) ->
774    one_type(Toks, ['>>'|E], [{'<<', Lls}|Ts0]);
775one_type([{'[', Lls}|Toks], E, Ts0) ->
776    one_type(Toks, [']'|E], [{'[', Lls}|Ts0]);
777one_type([{'{', Llc}|Toks], E, Ts0) ->
778    one_type(Toks, ['}'|E], [{'{', Llc}|Ts0]);
779one_type([{Rb, Lrb}|Toks], [Rb|E], Ts0) ->
780    one_type(Toks, E, [{Rb, Lrb}|Ts0]);
781one_type([T|Toks], E, Ts0) ->
782    one_type(Toks, E, [T|Ts0]).
783