mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-14 21:35:49 +00:00
Code Issues Projects Releases Wiki Activity
Files
1c3bc03415740d648e99d0a34389767d76f8808a
mercury/compiler/error_util.m
Zoltan Somogyi e77bcdc4ba Add two new kinds of scopes to the language: one that requires the goal inside 
Estimated hours taken: 12
Branches: main

Add two new kinds of scopes to the language: one that requires the goal inside
the scope to have a given determinism, and one that requires it
to be complete, i.e. to have arms for all the function symbols in the type of
the switched-on variable.

The first kind of scope adds the keywords

	require_det require_semidet
	require_multi require_nondet
	require_cc_multi require_cc_nondet
	require_erroneous require_failure

to the language. They are intended to be used like this:

	test_detism_scope(A, !IO) :-
	    (
		A > 10,
		require_det (
		    B = A * 2,
		    C = B mod 3
		),
		C = 1
	    ->
		X = C
	    ;
		X = A
	    ),
	    io.format("test_detism_scope(%d) = %d\n", [i(A), i(X)], !IO).

The second kind of scope adds the keyword require_complete_switch to
the language. They are intended to be used like this:

	do_test_switch_scope(A, X) :-
	    require_complete_switch [A] (
		(
		    A = f1,
		    fail
		;
		    A = f2,
		    ( X = 1
		    ; X = 2
		    )
		;
		    A = f3(B),
		    ( X = 3
		    ; X = B
		    ; X = B + 1
		    )
		)
	    ).

NEWS:
	Announce the new scopes.

doc/reference_manual.texi:
	Document the new scopes.

library/ops.m:
	Add the new keywords as operators.

compiler/hlds_goal.m:
	Add the new kinds of scopes to the HLDS.

compiler/prog_item.m:
	Add the new kinds of scopes to the parse tree type.

compiler/prog_io_goal.m:
	Recognize the new keywords. When we find a term with one of these
	keywords as the function symbol, generate the corresponding parse tree
	goal expression.

compiler/add_clause.m:
	Convert these goal expressions to HLDS.

compiler/simplify.m:
	Check the requirements expressed by the new scopes. If the requirement
	is met, delete the scope wrapper. If the requirement is not met,
	generate an error message and then delete the scope wrapper.

compiler/error_util.m:
	Add a new format_component, words_qoute, which is like quote, but
	yields words, not fixed, after quoting.

compiler/constraint.m:
compiler/det_analysis.m:
compiler/erl_code_gen.m:
compiler/goal_util.m:
compiler/hlds_desc.m:
compiler/hlds_out_goal.m:
compiler/interval.m:
compiler/lambda.m:
compiler/make_hlds_warn.m:
compiler/mercury_to_mercury.m:
compiler/mode_errors.m:
compiler/modecheck_goal.m:
compiler/module_imports.m:
compiler/module_qual.m:
compiler/polymorphism.m:
compiler/prog_util.m:
compiler/purity.m:
compiler/quantification.m:
compiler/saved_vars.m:
compiler/stm_expand.m:
compiler/try_expand.m:
compiler/typecheck.m:
	Conform to the changes to the parse tree and HLDS goal types.
	In one module, take advantage of the new format_component.

tests/hard_coded/require_scopes.{m,exp}:
	A new test case to test the handling of the new scopes when their
	requirements are met.

tests/hard_coded/Mmakefile:
	Add the new test.

tests/invalid/require_scopes.{m,err_exp}:
	A new test case to test the handling of the new scopes when their
	requirements are NOT met.

tests/invalid/Mmakefile:
	Add the new test.
2010-12-29 04:52:23 +00:00

1528 lines
55 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 1997-2010 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%-----------------------------------------------------------------------------%
%
% File: error_util.m.
% Main author: zs.
%
% This module contains code that can be helpful in the formatting of
% error messages.
%
% Given a context, a starting indentation level and a list of words,
% print an error message that looks like this:
%
% module.m:10: first line of error message blah blah blah
% module.m:10: second line of error message blah blah blah
% module.m:10: third line of error message blah blah blah
%
% The words will be packed into lines as tightly as possible,
% with spaces between each pair of words, subject to the constraints
% that every line starts with a context, followed by Indent+1 spaces
% on the first line and Indent+3 spaces on later lines, and that every
% line contains at most <n> characters (unless a long single word
% forces the line over this limit) where --max-error-line-width <n>.
%
% The caller supplies the list of words to be printed in the form
% of a list of error message components. Each component may specify
% a string to printed exactly as it is, or it may specify a string
% containing a list of words, which may be broken at white space.
%
%-----------------------------------------------------------------------------%
:- module parse_tree.error_util.
:- interface.
:- import_module libs.globals.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.prog_data.
:- import_module bool.
:- import_module io.
:- import_module list.
:- import_module maybe.
%-----------------------------------------------------------------------------%
% Every distinct problem should generate a single error specification. This
% specification should state the severity of the problem (so that we can update
% the exit status of the compiler accordingly), which phase of the compiler
% found the problem (since later phases may wish to suppress some problem
% reports if some specific earlier phases found problems, e.g. when a missing
% clause could be caused by a syntax error), and a specification of what to
% print.
%
% In most cases, the "what to print" will be a single message for a single
% context. However, we may want to print messages for several contexts.
% For example, when reporting a duplicate declaration, we want to report
% this fact in the duplicate declaration's context, while printing another
% message giving the original declaration's context.
:- type error_spec
---> error_spec(
error_severity :: error_severity,
error_phase :: error_phase,
error_msgs :: list(error_msg)
).
:- type error_severity
---> severity_error
% Always set the exit status to indicate an error.
; severity_warning
% Only set the exit status to indicate an error if --halt-at-warn
% is enabled.
; severity_informational
% Don't set the exit status to indicate an error.
; severity_conditional(
% If the given boolean option has the given value, then the actual
% severity is given by the third argument; if it has the other
% value, then the actual severity is given by the fourth argument.
% If the fourth argument is `no', then the error_spec shouldn't
% actually print anything if cond_option doesn't have the value
% in cond_option_value.
cond_option :: option,
cond_option_value :: bool,
cond_if_match :: error_severity,
cond_if_no_match :: maybe(error_severity)
).
:- type actual_severity
---> actual_severity_error
; actual_severity_warning
; actual_severity_informational.
:- type mode_report_control
---> report_in_any_mode
; report_only_if_in_all_modes.
:- type error_phase
---> phase_read_files
; phase_term_to_parse_tree
; phase_parse_tree_to_hlds
; phase_expand_types
; phase_type_check
; phase_inst_check
; phase_mode_check(mode_report_control)
; phase_purity_check
; phase_detism_check
; phase_simplify(mode_report_control)
; phase_dead_code
; phase_termination_analysis
; phase_accumulator_intro
; phase_auto_parallelism
; phase_interface_gen
; phase_code_gen.
% An error message may have several components that may be printed under
% different circumstances. Some components are always printed; some are
% printed only if specific options have specific values. When an error
% specification is printed, we concatenate the list of all the
% format_components that should be printed. If this yields the empty list,
% we print nothing. Otherwise, we give them all to write_error_pieces to print
% out.
%
% When we print an error message in a list of error messages, we normally
% treat the first line of the first message differently than the rest:
% we separate it from the context by one space, whereas following lines
% are separate by three spaces. You can request that the first line of
% a message be treated as it were the first by setting the error_treat_as_first
% field to "treat_as_first". You can also request that the pieces in a message
% be given extra indentation by setting the error_extra_indent field
% to a nonzero value.
%
% The term simple_msg(Context, Components) is a shorthand for (and equivalent
% in every respect to) the term error_msg(yes(Context), no, 0, Components).
:- type maybe_treat_as_first
---> treat_as_first
; do_not_treat_as_first.
:- type error_msg
---> simple_msg(
simple_context :: prog_context,
simple_components :: list(error_msg_component)
)
; error_msg(
error_context :: maybe(prog_context),
error_treat_as_first :: maybe_treat_as_first,
error_extra_indent :: int,
error_components :: list(error_msg_component)
).
:- type error_msg_component
---> always(format_components)
% Print these components under all circumstances.
; option_is_set(option, bool, list(error_msg_component))
% Print the embedded components only if the specified boolean
% option has the specified value.
; verbose_only(format_components)
% Print these components only if --verbose-errors is specified.
% If it is not specified, set the flag that triggers the printing
% of the message reminding the user about --verbose-errors.
; verbose_and_nonverbose(format_components, format_components)
% If --verbose-errors is specified, print the first set of
% components. If it is not specified, print the second set,
% and set the flag that triggers the printing of the message
% reminding the user about --verbose-errors.
; some [T] ( print_anything(T) => print_anything(T) ).
% This alternative allows the caller to specify an arbitrary thing
% to be printed at any point in the sequence. Since things printed
% this way aren't formatted as error messages should be (context
% at start etc), this capability is intended only for messages
% that help debug the compiler itself.
:- typeclass print_anything(T) where [
pred print_anything(T::in, io::di, io::uo) is det
].
%-----------------------------------------------------------------------------%
% Return the worst of two actual severities.
%
:- func worst_severity(actual_severity, actual_severity)
= actual_severity.
% Compute the actual severity of a message with the given severity
% (if it actually prints anything).
%
:- func actual_error_severity(globals, error_severity)
= maybe(actual_severity).
% Compute the worst actual severity (if any) occurring in a list of
% error_specs.
%
:- func worst_severity_in_specs(globals, list(error_spec))
= maybe(actual_severity).
% Return `yes' if the given list contains error_specs whose actual severity
% is actual_severity_error.
%
:- func contains_errors(globals, list(error_spec)) = bool.
% Return `yes' if the given list contains error_specs whose actual severity
% is actual_severity_error or actual_severity_warning.
%
:- func contains_errors_and_or_warnings(globals, list(error_spec)) = bool.
%-----------------------------------------------------------------------------%
:- pred sort_error_msgs(list(error_msg)::in, list(error_msg)::out) is det.
%-----------------------------------------------------------------------------%
%
% The error_spec_accumulator type can be used to accumulate errors for
% multiple modes of a predicate. accumulate_error_specs_for_proc will
% eliminate warnings that should only be reported if they occur in every mode,
% but don't occur in every mode.
:- type error_spec_accumulator.
:- func init_error_spec_accumulator = error_spec_accumulator.
:- pred accumulate_error_specs_for_proc(list(error_spec)::in,
error_spec_accumulator::in, error_spec_accumulator::out) is det.
:- func error_spec_accumulator_to_list(error_spec_accumulator) =
list(error_spec).
%-----------------------------------------------------------------------------%
:- pred maybe_write_out_errors_no_module(bool::in, globals::in,
list(error_spec)::in, list(error_spec)::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
% write_error_spec(Spec, Globals, !NumWarnings, !NumErrors, !IO):
% write_error_specs(Specs, Globals, !NumWarnings, !NumErrors, !IO):
%
% Write out the error message(s) specified by Spec or Specs, minus the
% parts whose conditions are false. Increment !NumWarnings by the number
% of printed warnings and !NumErrors by the number of printed errors.
% Set the exit status to 1 if we found any errors, or if we found any
% warnings and --halt-at-warn is set. If some error specs have verbose
% components but they aren't being printed out, set the flag for reminding
% the user about --verbose-errors.
%
% Look up option values in the supplied Globals.
%
% If an error spec contains only conditional messages and those conditions
% are all false, then nothing will be printed out and the exit status
% will not be changed. This will happen even if the severity means
% that something should have been printed out.
%
:- pred write_error_spec(error_spec::in, globals::in, int::in, int::out,
int::in, int::out, io::di, io::uo) is det.
:- pred write_error_specs(list(error_spec)::in, globals::in, int::in, int::out,
int::in, int::out, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
:- type format_component
---> fixed(string)
% This string should appear in the output in one piece, as it is.
; quote(string)
% Surround the string with `' quotes, then treat as fixed.
; int_fixed(int)
% Convert the integer to a string, then treat as fixed.
; nth_fixed(int)
% Convert the integer to a string, such as "first", "second",
% "third", "4th", "5th" and then treat as fixed.
; lower_case_next_if_not_first
% If this is the first component, ignore it. If this is not
% the first component, lower case the initial letter of the
% next component. There is no effect if the next component
% does not exist or does not start with an upper case letter.
; prefix(string)
% This string should appear in the output in one piece, as it is,
% inserted directly before the next format_component, without
% any intervening space.
; suffix(string)
% This string should appear in the output in one piece, as it is,
% appended directly after the previous format_component, without
% any intervening space.
; words(string)
% This string contains words separated by white space. The words
% should appear in the output in the given order, but the white
% space may be rearranged and line breaks may be inserted.
; words_quote(string)
% Surround the string with `' quotes, then treat as words.
; sym_name(sym_name)
% The output should contain the string form of the sym_name,
% surrounded by `' quotes.
; sym_name_and_arity(sym_name_and_arity)
% The output should contain the string form of the sym_name,
% followed by '/' and the arity, all surrounded by `' quotes.
; top_ctor_of_type(mer_type)
% The top level type constructor of the given type,
% which must have one (i.e. must not be a variable).
; p_or_f(pred_or_func)
% Output the string "predicate" or "function" as appropriate.
; simple_call(simple_call_id)
% Output the identity of the given call.
; nl
% Insert a line break if there has been text output since
% the last line break.
; nl_indent_delta(int)
% Act as nl, but also add the given integer (which should be a
% small positive or negative integer) to the current indent level.
; blank_line.
% Create a blank line.
:- type format_components == list(format_component).
% Wrap words() around a string.
%
:- func string_to_words_piece(string) = format_component.
% Convert a list of strings into a list of format_components
% separated by commas, with the last two elements separated by `and'.
%
:- func list_to_pieces(list(string)) = list(format_component).
% Convert a list of lists of format_components into a list of
% format_components separated by commas, with the last two elements
% separated by `and'.
%
:- func component_lists_to_pieces(list(list(format_component))) =
list(format_component).
% Convert a list of format_components into a list of format_components
% separated by commas, with the last two elements separated by `and'.
%
:- func component_list_to_pieces(list(format_component)) =
list(format_component).
% component_list_to_line_pieces(Lines, Final):
%
% Convert Lines, a list of lines (each given by a list of format_components
% *without* a final nl) into a condensed list of format_components
% in which adjacent lines are separated by commas and newlines.
% What goes between the last line and the newline ending is not
% a comma but the value of Final.
%
:- func component_list_to_line_pieces(list(list(format_component)),
list(format_component)) = list(format_component).
% choose_number(List, Singular, Plural) = Form
%
% Choose between a singular version and a plural version of something,
% based on the length of a list. Chooses the plural if the list is empty.
%
:- func choose_number(list(T), U, U) = U.
% is_or_are(List) throws an exception if the list is empty, returns "is"
% if the list is a singleton, and otherwise returns "are".
%
:- func is_or_are(list(T)) = string.
%-----------------------------------------------------------------------------%
% XXX The predicates below should not be called in new code. New code should
% create error specifications, and then call write_error_spec to print them.
% Display the given error message, without a context and with standard
% indentation.
%
:- pred write_error_pieces_plain(globals::in, list(format_component)::in,
io::di, io::uo) is det.
% write_error_plain_with_progname(ProgName, Msg):
%
% Display Msg as the error string, with ProgName as a context
% and with standard indentation.
%
:- pred write_error_plain_with_progname(string::in, string::in,
io::di, io::uo) is det.
% write_error_pieces(Globals, Context, Indent, Components):
%
% Display `Components' as the error message, with `Context' as a context
% and indent by `Indent'.
%
:- pred write_error_pieces(globals::in, prog_context::in, int::in,
list(format_component)::in, io::di, io::uo) is det.
:- pred write_error_pieces_maybe_with_context(globals::in,
maybe(prog_context)::in, int::in, list(format_component)::in,
io::di, io::uo) is det.
:- func error_pieces_to_string(list(format_component)) = string.
%-----------------------------------------------------------------------------%
:- func describe_sym_name(sym_name) = string.
:- func describe_sym_name_and_arity(sym_name_and_arity) = string.
:- func pred_or_func_to_string(pred_or_func) = string.
% Put `' quotes around the given string.
%
:- func add_quotes(string) = string.
% Ensure that the first character of the input string is not a lower case
% letter.
%
:- func capitalize(string) = string.
% Report a warning, and set the exit status to error if the
% --halt-at-warn option is set.
%
:- pred report_warning(globals::in, prog_context::in, int::in,
list(format_component)::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
% Report why the file is not able to be opened,
% and set the exit status to be 1.
%
:- pred unable_to_open_file(string::in, io.error::in, io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
:- import_module libs.compiler_util.
:- import_module char.
:- import_module cord.
:- import_module int.
:- import_module list.
:- import_module pair.
:- import_module require.
:- import_module set.
:- import_module string.
:- import_module term.
%-----------------------------------------------------------------------------%
worst_severity(actual_severity_error, actual_severity_error) =
actual_severity_error.
worst_severity(actual_severity_error, actual_severity_warning) =
actual_severity_error.
worst_severity(actual_severity_error, actual_severity_informational) =
actual_severity_error.
worst_severity(actual_severity_warning, actual_severity_error) =
actual_severity_error.
worst_severity(actual_severity_warning, actual_severity_warning) =
actual_severity_warning.
worst_severity(actual_severity_warning, actual_severity_informational) =
actual_severity_warning.
worst_severity(actual_severity_informational, actual_severity_error) =
actual_severity_error.
worst_severity(actual_severity_informational, actual_severity_warning) =
actual_severity_warning.
worst_severity(actual_severity_informational, actual_severity_informational) =
actual_severity_informational.
actual_error_severity(Globals, Severity) = MaybeActual :-
(
Severity = severity_error,
MaybeActual = yes(actual_severity_error)
;
Severity = severity_warning,
MaybeActual = yes(actual_severity_warning)
;
Severity = severity_informational,
MaybeActual = yes(actual_severity_informational)
;
Severity = severity_conditional(Option, MatchValue,
Match, MaybeNoMatch),
globals.lookup_bool_option(Globals, Option, Value),
( Value = MatchValue ->
MaybeActual = actual_error_severity(Globals, Match)
;
(
MaybeNoMatch = no,
MaybeActual = no
;
MaybeNoMatch = yes(NoMatch),
MaybeActual = actual_error_severity(Globals, NoMatch)
)
)
).
worst_severity_in_specs(Globals, Specs) = MaybeWorst :-
worst_severity_in_specs_2(Globals, Specs, no, MaybeWorst).
:- pred worst_severity_in_specs_2(globals::in, list(error_spec)::in,
maybe(actual_severity)::in, maybe(actual_severity)::out) is det.
worst_severity_in_specs_2(_Globals, [], !MaybeWorst).
worst_severity_in_specs_2(Globals, [Spec | Specs], !MaybeWorst) :-
Spec = error_spec(Severity, _, _),
MaybeThis = actual_error_severity(Globals, Severity),
(
!.MaybeWorst = no,
!:MaybeWorst = MaybeThis
;
!.MaybeWorst = yes(_Worst),
MaybeThis = no
;
!.MaybeWorst = yes(Worst),
MaybeThis = yes(This),
!:MaybeWorst = yes(worst_severity(Worst, This))
),
worst_severity_in_specs_2(Globals, Specs, !MaybeWorst).
contains_errors(Globals, Specs) = Errors :-
MaybeWorstActual = worst_severity_in_specs(Globals, Specs),
(
MaybeWorstActual = no,
Errors = no
;
MaybeWorstActual = yes(WorstActual),
(
WorstActual = actual_severity_error,
Errors = yes
;
( WorstActual = actual_severity_warning
; WorstActual = actual_severity_informational
),
Errors = no
)
).
contains_errors_and_or_warnings(Globals, Specs) = ErrorsOrWarnings :-
MaybeWorstActual = worst_severity_in_specs(Globals, Specs),
(
MaybeWorstActual = no,
ErrorsOrWarnings = no
;
MaybeWorstActual = yes(WorstActual),
(
( WorstActual = actual_severity_error
; WorstActual = actual_severity_warning
),
ErrorsOrWarnings = yes
;
WorstActual = actual_severity_informational,
ErrorsOrWarnings = no
)
).
%-----------------------------------------------------------------------------%
sort_error_msgs(Msgs0, Msgs) :-
list.sort_and_remove_dups(compare_error_msgs, Msgs0, Msgs).
:- func project_msgs_contexts(list(error_msg)) = list(prog_context).
project_msgs_contexts([]) = [].
project_msgs_contexts([Msg | Msgs]) = Contexts :-
TailContexts = project_msgs_contexts(Msgs),
MaybeContext = project_msg_context(Msg),
(
MaybeContext = yes(Context),
Contexts = [Context | TailContexts]
;
MaybeContext = no,
Contexts = TailContexts
).
:- pred compare_error_msgs(error_msg::in, error_msg::in,
comparison_result::out) is det.
compare_error_msgs(MsgA, MsgB, Result) :-
MaybeContextA = project_msg_context(MsgA),
MaybeContextB = project_msg_context(MsgB),
compare(ContextResult, MaybeContextA, MaybeContextB),
(
ContextResult = (=),
compare(Result, MsgA, MsgB)
;
( ContextResult = (>)
; ContextResult = (<)
),
Result = ContextResult
).
:- func project_msg_context(error_msg) = maybe(prog_context).
project_msg_context(Msg) = MaybeContext :-
(
Msg = simple_msg(Context, _),
MaybeContext = yes(Context)
;
Msg = error_msg(yes(Context), _, _, _),
MaybeContext = yes(Context)
;
Msg = error_msg(no, _, _, __),
MaybeContext = no
).
%-----------------------------------------------------------------------------%
:- type error_spec_accumulator == maybe(pair(set(error_spec))).
init_error_spec_accumulator = no.
accumulate_error_specs_for_proc(ProcSpecs, !MaybeSpecs) :-
list.filter((pred(error_spec(_, Phase, _)::in) is semidet :-
ModeReportControl = get_maybe_mode_report_control(Phase),
ModeReportControl = yes(report_only_if_in_all_modes)
), ProcSpecs, ProcAllModeSpecs, ProcAnyModeSpecs),
ProcAnyModeSpecSet = set.from_list(ProcAnyModeSpecs),
ProcAllModeSpecSet = set.from_list(ProcAllModeSpecs),
(
!.MaybeSpecs = yes(AnyModeSpecSet0 - AllModeSpecSet0),
set.union(AnyModeSpecSet0, ProcAnyModeSpecSet, AnyModeSpecSet),
set.intersect(AllModeSpecSet0, ProcAllModeSpecSet, AllModeSpecSet),
!:MaybeSpecs = yes(AnyModeSpecSet - AllModeSpecSet)
;
!.MaybeSpecs = no,
!:MaybeSpecs = yes(ProcAnyModeSpecSet - ProcAllModeSpecSet)
).
error_spec_accumulator_to_list(no) = [].
error_spec_accumulator_to_list(yes(AnyModeSpecSet - AllModeSpecSet)) =
set.to_sorted_list(set.union(AnyModeSpecSet, AllModeSpecSet)).
:- func get_maybe_mode_report_control(error_phase) =
maybe(mode_report_control).
get_maybe_mode_report_control(phase_read_files) = no.
get_maybe_mode_report_control(phase_term_to_parse_tree) = no.
get_maybe_mode_report_control(phase_parse_tree_to_hlds) = no.
get_maybe_mode_report_control(phase_expand_types) = no.
get_maybe_mode_report_control(phase_type_check) = no.
get_maybe_mode_report_control(phase_inst_check) = no.
get_maybe_mode_report_control(phase_mode_check(Control)) = yes(Control).
get_maybe_mode_report_control(phase_purity_check) = no.
get_maybe_mode_report_control(phase_detism_check) = no.
get_maybe_mode_report_control(phase_simplify(Control)) = yes(Control).
get_maybe_mode_report_control(phase_dead_code) = no.
get_maybe_mode_report_control(phase_termination_analysis) = no.
get_maybe_mode_report_control(phase_accumulator_intro) = no.
get_maybe_mode_report_control(phase_auto_parallelism) = no.
get_maybe_mode_report_control(phase_interface_gen) = no.
get_maybe_mode_report_control(phase_code_gen) = no.
%-----------------------------------------------------------------------------%
:- pred sort_error_specs(list(error_spec)::in, list(error_spec)::out) is det.
sort_error_specs(Specs0, Specs) :-
list.sort_and_remove_dups(compare_error_specs, Specs0, Specs).
:- pred compare_error_specs(error_spec::in, error_spec::in,
comparison_result::out) is det.
compare_error_specs(SpecA, SpecB, Result) :-
SpecA = error_spec(_, _, MsgsA),
SpecB = error_spec(_, _, MsgsB),
ContextsA = project_msgs_contexts(MsgsA),
ContextsB = project_msgs_contexts(MsgsB),
compare(ContextResult, ContextsA, ContextsB),
( ContextResult = (=) ->
compare(Result, SpecA, SpecB)
;
Result = ContextResult
).
%-----------------------------------------------------------------------------%
maybe_write_out_errors_no_module(Verbose, Globals, !Specs, !IO) :-
% maybe_write_out_errors in hlds_error_util.m is a HLDS version
% of this predicate. The documentstion is in that file.
(
Verbose = no
;
Verbose = yes,
% XXX _NumErrors
write_error_specs(!.Specs, Globals,
0, _NumWarnings, 0, _NumErrors, !IO),
!:Specs = []
).
%-----------------------------------------------------------------------------%
write_error_spec(Spec, Globals, !NumWarnings, !NumErrors, !IO) :-
do_write_error_spec(Globals, Spec, !NumWarnings, !NumErrors, !IO).
write_error_specs(Specs0, Globals, !NumWarnings, !NumErrors, !IO) :-
sort_error_specs(Specs0, Specs),
list.foldl3(do_write_error_spec(Globals), Specs,
!NumWarnings, !NumErrors, !IO).
:- pred do_write_error_spec(globals::in, error_spec::in,
int::in, int::out, int::in, int::out, io::di, io::uo) is det.
do_write_error_spec(Globals, Spec, !NumWarnings, !NumErrors, !IO) :-
Spec = error_spec(Severity, _, Msgs),
do_write_error_msgs(Msgs, Globals, treat_as_first,
have_not_printed_anything, PrintedSome, !IO),
MaybeActual = actual_error_severity(Globals, Severity),
(
PrintedSome = have_not_printed_anything
% XXX The following assertion is commented out because the compiler
% can generate error specs that consist only of conditional error
% messages whose conditions can all be false (in which case nothing
% will be printed). Such specs will cause the assertion to fail if
% they have a severity that means something *should* have been
% printed out. Error specs like this are generated by --debug-modes.
% expect(unify(MaybeActual, no), this_file,
% "do_write_error_spec: MaybeActual isn't no")
;
PrintedSome = printed_something,
(
MaybeActual = yes(Actual),
(
Actual = actual_severity_error,
!:NumErrors = !.NumErrors + 1,
io.set_exit_status(1, !IO)
;
Actual = actual_severity_warning,
!:NumWarnings = !.NumWarnings + 1,
record_warning(Globals, !IO)
;
Actual = actual_severity_informational
)
;
MaybeActual = no,
unexpected(this_file, "do_write_error_spec: MaybeActual is no")
)
).
:- type maybe_printed_something
---> printed_something
; have_not_printed_anything.
:- type maybe_lower_next_initial
---> lower_next_initial
; do_not_lower_next_initial.
:- pred do_write_error_msgs(list(error_msg)::in, globals::in,
maybe_treat_as_first::in,
maybe_printed_something::in, maybe_printed_something::out,
io::di, io::uo) is det.
do_write_error_msgs([], _Globals, _First, !PrintedSome, !IO).
do_write_error_msgs([Msg | Msgs], Globals, !.First, !PrintedSome, !IO) :-
(
Msg = simple_msg(SimpleContext, Components),
MaybeContext = yes(SimpleContext),
TreatAsFirst = do_not_treat_as_first,
ExtraIndentLevel = 0
;
Msg = error_msg(MaybeContext, TreatAsFirst, ExtraIndentLevel,
Components)
),
(
TreatAsFirst = treat_as_first,
!:First = treat_as_first
;
TreatAsFirst = do_not_treat_as_first
% Leave !:First as it is, even if it is treat_as_first.
),
Indent = ExtraIndentLevel * indent_increment,
write_msg_components(Components, MaybeContext, Indent, Globals,
!First, !PrintedSome, !IO),
do_write_error_msgs(Msgs, Globals, !.First, !PrintedSome, !IO).
:- pred write_msg_components(list(error_msg_component)::in,
maybe(prog_context)::in, int::in, globals::in,
maybe_treat_as_first::in, maybe_treat_as_first::out,
maybe_printed_something::in, maybe_printed_something::out,
io::di, io::uo) is det.
write_msg_components([], _, _, _, !First, !PrintedSome, !IO).
write_msg_components([Component | Components], MaybeContext, Indent, Globals,
!First, !PrintedSome, !IO) :-
(
Component = always(ComponentPieces),
globals.lookup_int_option(Globals, max_error_line_width, MaxWidth),
do_write_error_pieces(!.First, MaybeContext, Indent, MaxWidth,
ComponentPieces, !IO),
!:First = do_not_treat_as_first,
!:PrintedSome = printed_something
;
Component = option_is_set(Option, RequiredValue, EmbeddedComponents),
globals.lookup_bool_option(Globals, Option, OptionValue),
( OptionValue = RequiredValue ->
write_msg_components(EmbeddedComponents, MaybeContext, Indent,
Globals, !First, !PrintedSome, !IO)
;
true
)
;
Component = verbose_only(ComponentPieces),
globals.lookup_bool_option(Globals, verbose_errors, VerboseErrors),
(
VerboseErrors = yes,
globals.lookup_int_option(Globals, max_error_line_width,
MaxWidth),
do_write_error_pieces(!.First, MaybeContext, Indent, MaxWidth,
ComponentPieces, !IO),
!:First = do_not_treat_as_first,
!:PrintedSome = printed_something
;
VerboseErrors = no,
globals.io_set_extra_error_info(yes, !IO)
)
;
Component = verbose_and_nonverbose(VerbosePieces, NonVerbosePieces),
globals.lookup_bool_option(Globals, verbose_errors, VerboseErrors),
globals.lookup_int_option(Globals, max_error_line_width, MaxWidth),
(
VerboseErrors = yes,
do_write_error_pieces(!.First, MaybeContext, Indent, MaxWidth,
VerbosePieces, !IO)
;
VerboseErrors = no,
do_write_error_pieces(!.First, MaybeContext, Indent, MaxWidth,
NonVerbosePieces, !IO),
globals.io_set_extra_error_info(yes, !IO)
),
!:First = do_not_treat_as_first,
!:PrintedSome = printed_something
;
Component = print_anything(Anything),
print_anything(Anything, !IO),
!:First = do_not_treat_as_first,
!:PrintedSome = printed_something
),
write_msg_components(Components, MaybeContext, Indent, Globals,
!First, !PrintedSome, !IO).
:- pred unsafe_cast_to_io_pred(pred(io, io)::in,
pred(io, io)::out(pred(di, uo) is det)) is det.
:- pragma foreign_proc("C",
unsafe_cast_to_io_pred(Anything::in, Pred::out(pred(di, uo) is det)),
[will_not_call_mercury, promise_pure, thread_safe],
"
Pred = Anything;
").
unsafe_cast_to_io_pred(_, _) :-
unexpected(this_file, "unsafe_cast_to_io_pred").
%-----------------------------------------------------------------------------%
:- type maybe_first_in_msg
---> first_in_msg
; not_first_in_msg.
string_to_words_piece(Str) = words(Str).
list_to_pieces([]) = [].
list_to_pieces([Elem]) = [words(Elem)].
list_to_pieces([Elem1, Elem2]) = [fixed(Elem1), words("and"), fixed(Elem2)].
list_to_pieces([Elem1, Elem2, Elem3 | Elems]) =
[fixed(Elem1 ++ ",") | list_to_pieces([Elem2, Elem3 | Elems])].
component_lists_to_pieces([]) = [].
component_lists_to_pieces([Comps]) = Comps.
component_lists_to_pieces([Comps1, Comps2]) =
Comps1 ++ [words("and")] ++ Comps2.
component_lists_to_pieces([Comps1, Comps2, Comps3 | Comps]) =
Comps1 ++ [suffix(",")]
++ component_lists_to_pieces([Comps2, Comps3 | Comps]).
component_list_to_pieces([]) = [].
component_list_to_pieces([Comp]) = [Comp].
component_list_to_pieces([Comp1, Comp2]) = [Comp1, words("and"), Comp2].
component_list_to_pieces([Comp1, Comp2, Comp3 | Comps]) =
[Comp1, suffix(",")]
++ component_list_to_pieces([Comp2, Comp3 | Comps]).
component_list_to_line_pieces([], _) = [].
component_list_to_line_pieces([Comps], Final) = Comps ++ Final ++ [nl].
component_list_to_line_pieces([Comps1, Comps2 | CompLists], Final) =
Comps1 ++ [suffix(","), nl]
++ component_list_to_line_pieces([Comps2 | CompLists], Final).
choose_number([], _Singular, Plural) = Plural.
choose_number([_], Singular, _Plural) = Singular.
choose_number([_, _ | _], _Singular, Plural) = Plural.
is_or_are([]) = "" :-
unexpected(this_file, "error_util.is_or_are").
is_or_are([_]) = "is".
is_or_are([_, _ | _]) = "are".
write_error_pieces_plain(Globals, Components, !IO) :-
globals.lookup_int_option(Globals, max_error_line_width, MaxWidth),
do_write_error_pieces(treat_as_first, no, 0, MaxWidth, Components, !IO).
write_error_plain_with_progname(ProgName, Msg, !IO) :-
MaxWidth = 79,
Components = [fixed(ProgName ++ ":"), words(Msg)],
do_write_error_pieces(treat_as_first, no, 0, MaxWidth, Components, !IO).
write_error_pieces(Globals, Context, Indent, Components, !IO) :-
globals.lookup_int_option(Globals, max_error_line_width, MaxWidth),
do_write_error_pieces(treat_as_first, yes(Context), Indent, MaxWidth,
Components, !IO).
write_error_pieces_maybe_with_context(Globals, MaybeContext, Indent,
Components, !IO) :-
globals.lookup_int_option(Globals, max_error_line_width, MaxWidth),
do_write_error_pieces(treat_as_first, MaybeContext, Indent, MaxWidth,
Components, !IO).
:- pred do_write_error_pieces(maybe_treat_as_first::in,
maybe(prog_context)::in, int::in, int::in, list(format_component)::in,
io::di, io::uo) is det.
do_write_error_pieces(TreatAsFirst, MaybeContext, FixedIndent, MaxWidth,
Components, !IO) :-
% The fixed characters at the start of the line are:
% filename
% :
% line number (min 3 chars)
% :
% space
% indent
(
MaybeContext = yes(Context),
term.context_file(Context, FileName),
term.context_line(Context, LineNumber),
string.length(FileName, FileNameLength),
string.int_to_string(LineNumber, LineNumberStr),
string.length(LineNumberStr, LineNumberStrLength0),
( LineNumberStrLength0 < 3 ->
LineNumberStrLength = 3
;
LineNumberStrLength = LineNumberStrLength0
),
ContextLength = FileNameLength + 1 + LineNumberStrLength + 2
;
MaybeContext = no,
ContextLength = 0
),
convert_components_to_paragraphs(Components, Paragraphs),
FirstIndent = (TreatAsFirst = treat_as_first -> 0 ; 1),
Remain = MaxWidth - (ContextLength + FixedIndent),
group_words(TreatAsFirst, FirstIndent, Paragraphs, Remain, Lines),
write_lines(Lines, MaybeContext, FixedIndent, !IO).
:- func indent_increment = int.
indent_increment = 2.
:- pred write_lines(list(error_line)::in, maybe(prog_context)::in, int::in,
io::di, io::uo) is det.
write_lines([], _, _, !IO).
write_lines([Line | Lines], MaybeContext, FixedIndent, !IO) :-
(
MaybeContext = yes(Context),
prog_out.write_context(Context, !IO)
;
MaybeContext = no
),
Line = error_line(LineIndent, LineWords),
Indent = FixedIndent + LineIndent * indent_increment,
string.pad_left("", ' ', Indent, IndentStr),
io.write_string(IndentStr, !IO),
write_line(LineWords, !IO),
write_lines(Lines, MaybeContext, FixedIndent, !IO).
:- pred write_line(list(string)::in, io::di, io::uo) is det.
write_line([], !IO) :-
io.write_char('\n', !IO).
write_line([Word | Words], !IO) :-
io.write_string(Word, !IO),
write_line_rest(Words, !IO),
io.write_char('\n', !IO).
:- pred write_line_rest(list(string)::in, io::di, io::uo) is det.
write_line_rest([], !IO).
write_line_rest([Word | Words], !IO) :-
io.write_char(' ', !IO),
io.write_string(Word, !IO),
write_line_rest(Words, !IO).
error_pieces_to_string(Components) =
error_pieces_to_string_2(first_in_msg, Components).
:- func error_pieces_to_string_2(maybe_first_in_msg, list(format_component))
= string.
error_pieces_to_string_2(_, []) = "".
error_pieces_to_string_2(FirstInMsg, [Component | Components]) = Str :-
TailStr = error_pieces_to_string_2(not_first_in_msg, Components),
(
Component = words(Words),
Str = join_string_and_tail(Words, Components, TailStr)
;
Component = words_quote(Words),
Str = join_string_and_tail(add_quotes(Words), Components, TailStr)
;
Component = fixed(Word),
Str = join_string_and_tail(Word, Components, TailStr)
;
Component = quote(Word),
Str = join_string_and_tail(add_quotes(Word), Components, TailStr)
;
Component = int_fixed(Int),
Str = join_string_and_tail(int_to_string(Int), Components, TailStr)
;
Component = nth_fixed(Int),
Str = join_string_and_tail(nth_fixed_str(Int), Components, TailStr)
;
Component = lower_case_next_if_not_first,
(
FirstInMsg = first_in_msg,
Str = TailStr
;
FirstInMsg = not_first_in_msg,
Str = lower_initial(TailStr)
)
;
Component = prefix(Prefix),
Str = Prefix ++ TailStr
;
Component = suffix(Suffix),
Str = join_string_and_tail(Suffix, Components, TailStr)
;
Component = sym_name(SymName),
Word = sym_name_to_word(SymName),
Str = join_string_and_tail(Word, Components, TailStr)
;
Component = sym_name_and_arity(SymNameAndArity),
Word = sym_name_and_arity_to_word(SymNameAndArity),
Str = join_string_and_tail(Word, Components, TailStr)
;
Component = p_or_f(PredOrFunc),
Word = pred_or_func_to_string(PredOrFunc),
Str = join_string_and_tail(Word, Components, TailStr)
;
Component = simple_call(SimpleCallId),
Word = simple_call_id_to_string(SimpleCallId),
Str = join_string_and_tail(Word, Components, TailStr)
;
Component = top_ctor_of_type(Type),
( type_to_ctor_and_args(Type, TypeCtor, _) ->
TypeCtor = type_ctor(TypeCtorName, TypeCtorArity),
SymName = TypeCtorName / TypeCtorArity,
Word = sym_name_and_arity_to_word(SymName),
Str = join_string_and_tail(Word, Components, TailStr)
;
error("error_pieces_to_string: type is variable")
)
;
Component = nl,
Str = "\n" ++ TailStr
;
Component = nl_indent_delta(_),
% There is nothing we can do about the indent delta.
Str = "\n" ++ TailStr
;
Component = blank_line,
Str = "\n\n" ++ TailStr
).
:- func nth_fixed_str(int) = string.
nth_fixed_str(N) =
( N = 1 ->
"first"
; N = 2 ->
"second"
; N = 3 ->
"third"
;
int_to_string(N) ++ "th"
).
:- func join_string_and_tail(string, list(format_component), string) = string.
join_string_and_tail(Word, Components, TailStr) = Str :-
( TailStr = "" ->
Str = Word
; Components = [suffix(_) | _] ->
Str = Word ++ TailStr
;
Str = Word ++ " " ++ TailStr
).
%----------------------------------------------------------------------------%
:- type paragraph
---> paragraph(
list(string), % The list of words to print in the paragraph.
% It should not be empty.
int, % The number of blank lines to print after
% the paragraph.
int % The indent delta to apply for the next
% paragraph.
).
:- pred convert_components_to_paragraphs(list(format_component)::in,
list(paragraph)::out) is det.
convert_components_to_paragraphs(Components, Paras) :-
convert_components_to_paragraphs_acc(first_in_msg, Components,
[], cord.empty, ParasCord),
Paras = cord.list(ParasCord).
:- type word
---> plain_word(string)
; prefix_word(string)
; suffix_word(string)
; lower_next_word.
:- pred convert_components_to_paragraphs_acc(maybe_first_in_msg::in,
list(format_component)::in, list(word)::in,
cord(paragraph)::in, cord(paragraph)::out) is det.
convert_components_to_paragraphs_acc(_, [], RevWords0, !Paras) :-
Strings = rev_words_to_strings(RevWords0),
!:Paras = snoc(!.Paras, paragraph(Strings, 0, 0)).
convert_components_to_paragraphs_acc(FirstInMsg, [Component | Components],
RevWords0, !Paras) :-
(
Component = words(WordsStr),
break_into_words(WordsStr, RevWords0, RevWords1)
;
Component = words_quote(WordsStr),
break_into_words(add_quotes(WordsStr), RevWords0, RevWords1)
;
Component = fixed(Word),
RevWords1 = [plain_word(Word) | RevWords0]
;
Component = quote(Word),
RevWords1 = [plain_word(add_quotes(Word)) | RevWords0]
;
Component = int_fixed(Int),
RevWords1 = [plain_word(int_to_string(Int)) | RevWords0]
;
Component = nth_fixed(Int),
RevWords1 = [plain_word(nth_fixed_str(Int)) | RevWords0]
;
Component = lower_case_next_if_not_first,
(
FirstInMsg = first_in_msg,
RevWords1 = RevWords0
;
FirstInMsg = not_first_in_msg,
RevWords1 = [lower_next_word | RevWords0]
)
;
Component = prefix(Word),
RevWords1 = [prefix_word(Word) | RevWords0]
;
Component = suffix(Word),
RevWords1 = [suffix_word(Word) | RevWords0]
;
Component = sym_name(SymName),
RevWords1 = [plain_word(sym_name_to_word(SymName)) | RevWords0]
;
Component = sym_name_and_arity(SymNameAndArity),
Word = sym_name_and_arity_to_word(SymNameAndArity),
RevWords1 = [plain_word(Word) | RevWords0]
;
Component = top_ctor_of_type(Type),
( type_to_ctor_and_args(Type, TypeCtor, _) ->
TypeCtor = type_ctor(TypeCtorName, TypeCtorArity),
SymName = TypeCtorName / TypeCtorArity,
NewWord = plain_word(sym_name_and_arity_to_word(SymName)),
RevWords1 = [NewWord | RevWords0]
;
error("convert_components_to_paragraphs_acc: type is variable")
)
;
Component = p_or_f(PredOrFunc),
Word = pred_or_func_to_string(PredOrFunc),
RevWords1 = [plain_word(Word) | RevWords0]
;
Component = simple_call(SimpleCallId),
WordsStr = simple_call_id_to_string(SimpleCallId),
break_into_words(WordsStr, RevWords0, RevWords1)
;
Component = nl,
Strings = rev_words_to_strings(RevWords0),
!:Paras = snoc(!.Paras, paragraph(Strings, 0, 0)),
RevWords1 = []
;
Component = nl_indent_delta(IndentDelta),
Strings = rev_words_to_strings(RevWords0),
!:Paras = snoc(!.Paras, paragraph(Strings, 0, IndentDelta)),
RevWords1 = []
;
Component = blank_line,
Strings = rev_words_to_strings(RevWords0),
!:Paras = snoc(!.Paras, paragraph(Strings, 1, 0)),
RevWords1 = []
),
convert_components_to_paragraphs_acc(not_first_in_msg, Components,
RevWords1, !Paras).
:- type plain_or_prefix
---> plain(string)
; prefix(string)
; lower_next.
:- func rev_words_to_strings(list(word)) = list(string).
rev_words_to_strings(RevWords) = Strings :-
PorPs = list.reverse(rev_words_to_rev_plain_or_prefix(RevWords)),
Strings = join_prefixes(PorPs).
:- func rev_words_to_rev_plain_or_prefix(list(word)) = list(plain_or_prefix).
rev_words_to_rev_plain_or_prefix([]) = [].
rev_words_to_rev_plain_or_prefix([Word | Words]) = PorPs :-
(
Word = plain_word(String),
PorPs = [plain(String) | rev_words_to_rev_plain_or_prefix(Words)]
;
Word = lower_next_word,
PorPs = [lower_next | rev_words_to_rev_plain_or_prefix(Words)]
;
Word = prefix_word(Prefix),
PorPs = [prefix(Prefix) | rev_words_to_rev_plain_or_prefix(Words)]
;
Word = suffix_word(Suffix),
(
Words = [],
PorPs = [plain(Suffix)]
;
Words = [plain_word(String) | Tail],
PorPs = [plain(String ++ Suffix)
| rev_words_to_rev_plain_or_prefix(Tail)]
;
Words = [lower_next_word | Tail],
% Convert the lower_next_word/suffix combination into just the
% suffix after lowercasing the suffix (which will probably have
% no effect, since the initial character of a suffix is usually
% not a letter).
NewWords = [suffix_word(lower_initial(Suffix)) | Tail],
PorPs = rev_words_to_rev_plain_or_prefix(NewWords)
;
Words = [prefix_word(Prefix) | Tail],
% Convert the prefix/suffix combination into a plain word.
% We could convert it into a prefix, but since prefix/suffix
% combinations shouldn't come up at all, what we do here probably
% doesn't matter.
PorPs = [plain(Prefix ++ Suffix)
| rev_words_to_rev_plain_or_prefix(Tail)]
;
Words = [suffix_word(MoreSuffix) | Tail],
PorPs = rev_words_to_rev_plain_or_prefix(
[suffix_word(MoreSuffix ++ Suffix) | Tail])
)
).
:- func join_prefixes(list(plain_or_prefix)) = list(string).
join_prefixes([]) = [].
join_prefixes([Head | Tail]) = Strings :-
TailStrings = join_prefixes(Tail),
(
Head = plain(String),
Strings = [String | TailStrings]
;
Head = prefix(Prefix),
(
TailStrings = [First | Later],
Strings = [Prefix ++ First | Later]
;
TailStrings = [],
Strings = [Prefix | TailStrings]
)
;
Head = lower_next,
(
TailStrings = [],
Strings = TailStrings
;
TailStrings = [FirstTailString | LaterTailStrings],
Strings = [lower_initial(FirstTailString) | LaterTailStrings]
)
).
:- func lower_initial(string) = string.
lower_initial(Str0) = Str :-
(
string.first_char(Str0, First, Rest),
char.is_upper(First)
->
char.to_lower(First, LoweredFirst),
string.first_char(Str, LoweredFirst, Rest)
;
Str = Str0
).
:- func sym_name_to_word(sym_name) = string.
sym_name_to_word(SymName) =
"`" ++ sym_name_to_string(SymName) ++ "'".
:- func sym_name_and_arity_to_word(sym_name_and_arity) = string.
sym_name_and_arity_to_word(SymName / Arity) =
"`" ++ sym_name_to_string(SymName) ++ "'" ++ "/" ++ int_to_string(Arity).
:- pred break_into_words(string::in, list(word)::in, list(word)::out) is det.
break_into_words(String, Words0, Words) :-
break_into_words_from(String, 0, Words0, Words).
:- pred break_into_words_from(string::in, int::in, list(word)::in,
list(word)::out) is det.
break_into_words_from(String, Cur, Words0, Words) :-
( find_word_start(String, Cur, Start) ->
find_word_end(String, Start, End),
Length = End - Start + 1,
string.substring(String, Start, Length, WordStr),
Next = End + 1,
break_into_words_from(String, Next, [plain_word(WordStr) | Words0],
Words)
;
Words = Words0
).
:- pred find_word_start(string::in, int::in, int::out) is semidet.
find_word_start(String, Cur, WordStart) :-
string.index(String, Cur, Char),
( char.is_whitespace(Char) ->
Next = Cur + 1,
find_word_start(String, Next, WordStart)
;
WordStart = Cur
).
:- pred find_word_end(string::in, int::in, int::out) is det.
find_word_end(String, Cur, WordEnd) :-
Next = Cur + 1,
( string.index(String, Next, Char) ->
( char.is_whitespace(Char) ->
WordEnd = Cur
;
find_word_end(String, Next, WordEnd)
)
;
WordEnd = Cur
).
%----------------------------------------------------------------------------%
:- type error_line
---> error_line(
int, % Indent level; multiply by indent_increment
% to get number of spaces of indentation.
list(string) % The words on the line.
).
% Groups the given words into lines. The first line can have up to Max
% characters on it; the later lines (if any) up to Max-2 characters.
% The given list of paragraphs must be nonempty, since we always return
% at least one line.
%
:- pred group_words(maybe_treat_as_first::in, int::in, list(paragraph)::in,
int::in, list(error_line)::out) is det.
group_words(TreatAsFirst, CurIndent, Paras, Max, Lines) :-
(
Paras = [],
Lines = []
;
Paras = [FirstPara | LaterParas],
FirstPara = paragraph(FirstParaWords, NumBlankLines, FirstIndentDelta),
(
TreatAsFirst = treat_as_first,
RestIndent = CurIndent + 1
;
TreatAsFirst = do_not_treat_as_first,
RestIndent = CurIndent
),
NextIndent = RestIndent + FirstIndentDelta,
BlankLine = error_line(CurIndent, []),
list.duplicate(NumBlankLines, BlankLine, BlankLines),
(
FirstParaWords = [],
group_words(TreatAsFirst, NextIndent, LaterParas, Max, RestLines),
Lines = BlankLines ++ RestLines
;
FirstParaWords = [FirstWord | LaterWords],
get_line_of_words(FirstWord, LaterWords, CurIndent, Max,
LineWords, RestWords),
CurLine = error_line(CurIndent, LineWords),
group_nonfirst_line_words(RestWords, RestIndent, Max,
ParaRestLines),
ParaLines = [CurLine | ParaRestLines],
group_words(do_not_treat_as_first, NextIndent, LaterParas,
Max, RestLines),
Lines = ParaLines ++ BlankLines ++ RestLines
)
).
:- pred group_nonfirst_line_words(list(string)::in, int::in, int::in,
list(error_line)::out) is det.
group_nonfirst_line_words(Words, Indent, Max, Lines) :-
(
Words = [],
Lines = []
;
Words = [FirstWord | LaterWords],
get_line_of_words(FirstWord, LaterWords, Indent, Max,
LineWords, RestWords),
Line = error_line(Indent, LineWords),
group_nonfirst_line_words(RestWords, Indent, Max, RestLines),
Lines = [Line | RestLines]
).
:- pred get_line_of_words(string::in, list(string)::in, int::in, int::in,
list(string)::out, list(string)::out) is det.
get_line_of_words(FirstWord, LaterWords, Indent, Max, Line, RestWords) :-
string.length(FirstWord, FirstWordLen),
Avail = Max - Indent * indent_increment,
get_later_words(LaterWords, FirstWordLen, Avail, [FirstWord],
Line, RestWords).
:- pred get_later_words(list(string)::in, int::in, int::in,
list(string)::in, list(string)::out, list(string)::out) is det.
get_later_words([], _, _, Line, Line, []).
get_later_words([Word | Words], OldLen, Avail, Line0, Line, RestWords) :-
string.length(Word, WordLen),
NewLen = OldLen + 1 + WordLen,
( NewLen =< Avail ->
list.append(Line0, [Word], Line1),
get_later_words(Words, NewLen, Avail, Line1, Line, RestWords)
;
Line = Line0,
RestWords = [Word | Words]
).
%-----------------------------------------------------------------------------%
describe_sym_name_and_arity(SymName / Arity) =
string.append_list(["`", sym_name_to_string(SymName), "/",
string.int_to_string(Arity), "'"]).
describe_sym_name(SymName) =
string.append_list(["`", sym_name_to_string(SymName), "'"]).
pred_or_func_to_string(pf_predicate) = "predicate".
pred_or_func_to_string(pf_function) = "function".
add_quotes(Str) = "`" ++ Str ++ "'".
capitalize(Str0) = Str :-
Chars0 = string.to_char_list(Str0),
(
Chars0 = [Char0 | TailChars],
char.is_lower(Char0),
Char = char.to_upper(Char0)
->
Chars = [Char | TailChars],
Str = string.from_char_list(Chars)
;
Str = Str0
).
%-----------------------------------------------------------------------------%
report_warning(Globals, Context, Indent, Components, !IO) :-
record_warning(Globals, !IO),
write_error_pieces(Globals, Context, Indent, Components, !IO).
%-----------------------------------------------------------------------------%
unable_to_open_file(FileName, IOErr, !IO) :-
io.stderr_stream(StdErr, !IO),
io.write_string(StdErr, "Unable to open file: '", !IO),
io.write_string(StdErr, FileName, !IO),
io.write_string(StdErr, "' because\n", !IO),
io.write_string(StdErr, io.error_message(IOErr), !IO),
io.nl(StdErr, !IO),
io.set_exit_status(1, !IO).
%-----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "error_util.m".
%-----------------------------------------------------------------------------%
:- end_module error_util.
%-----------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink