Files
mercury/compiler/opt_format_call.m
Zoltan Somogyi d7f2d23018 Rename three modules.
compiler/fact_table_gen.m:
compiler/opt_format_call.m:
    "fact_table" and "format_call" are both the names of pragmas. Rename

    - fact_table.m to fact_table_gen.m, and
    - format_call.m to opt_format_call.m

    to avoid having their module names being syntax-highlighted.

compiler/opt_format_call_errors.m:
    Rename format_call_errors.m to conform to the second rename above.

compiler/simplify.m:
    Conform to the changes above, and delete redundant module qualifiers.

compiler/add_pragma.m:
compiler/det_infer_goal.m:
compiler/ll_backend.m:
compiler/notes/compiler_design.html:
compiler/simplify_proc.m:
    Conform to the changes above.
2025-10-20 11:34:48 +11:00

2602 lines
112 KiB
Mathematica

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2006-2012 The University of Melbourne.
% Copyright (C) 2014-2025 The Mercury team.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%---------------------------------------------------------------------------%
%
% File: opt_format_call.m.
% Author: zs.
%
% This module has two related jobs.
%
% - The first job is to check calls to
%
% - the Mercury library predicates and functions string.format,
% string.builder.format, io.format and stream.string_writer.format, and
%
% - any user-written predicates or functions which have a format_call pragma
%
% to see whether the format string and the supplied lists of values agree,
% and to generate warnings for calls in which they do not.
%
% The difficult part of this job is actually finding the values of the
% variables representing the format string and the list of values to be
% printed.
%
% - The second job is to try to transform well formed calls to string.format,
% string.builder.format, io.format and stream.string_writer.format into code
% that interprets the format string at compile time, rather than runtime.
% (We cannot do the same for user-written predicates or functions with
% format_call pragmas, because we don't know what the callee intends to do
% with the checked arguments.)
%
% Our general approach to the first job is a backwards traversal of the
% procedure body. During this traversal, we assign an id to every conjunction
% (considering the cond and then parts of an if-then-else to be a conjunction).
% When we find a call to a recognized format predicate or function, we remember
% the call site together with the identities of the variables holding the
% format string and the values to be printed, and include both variables
% in the set of variables whose values we want to track. As we traverse
% unifications that bind variables we want to track, we record their value
% in a map specific to the conjunction containing the unification. Actually,
% we keep four such maps. Three record information about bindings to function
% symbols: one for format strings, one for the skeletons of the lists of
% values, and one for the elements of those lists. The fourth map is
% for variable equivalences.
%
% We also record relationships between the conjunctions. Consider the code
% structure below, which contains two relevant conjunctions: the outer one,
% and the one containing the cond and then parts of the inner if-then-else.
% Any attempt to trace the value of V2 requires also knowing the value of V1.
% We therefore record that if you can't find the value of a variable such as
% V1 in the inner conjunction, you should continue the search in the outer
% conjunction. We call this relationship "predecessor", since the only
% relevant part of the outer conjunction is the one that appears before
% the inner one. This is enforced by the mode system.
%
% (
% ...,
% V1 = ...,
% ...,
% ( if
% ...
% then
% V2 = ... V1 ...,
% string.format(..., V2, ...)
% else
% V3 = ... V1 ...,
% string.format(..., V3, ...)
% ),
% ...
% )
%
% This design is about as cheap in terms of compilation time as we can make it.
% Its cost has two components. The first component is the traversal, and its
% cost is roughly proportional to the size of the procedure body. The second
% cost is the checking of each call to string.format, io.format and similar
% predicates. The expected complexity of this part is proportional to the
% number of such calls multiplied by the average number of arguments
% they print. In the worst case, this can be multiplied again by the number
% of conjunctions in the procedure body, but I expect that in most cases
% the variables involved in the relevant calls will be found in the same
% conjunction as the call itself, so the typical number of conjunctions
% that has to be searched will in fact be one.
%
% Note that if the value of e.g. a format string is an input to the procedure,
% we won't be able to check whether the values match the format string.
% Whether we give a warning in such cases is controlled by a separate option,
% which is consulted in det_check_goal.m.
%
% Likewise, we cannot do our checks if the value of a format string
% is computed by a call to an unknown procedure rather than a unification
% or one of a small number of known procedures (such as string.append).
% The same option governs whether we give a warning in this case as well.
%
% The second job (optimizing the calls) starts by processing the information
% gathered by the first pass through the code. For each call site, we
% systematically convert each component of the format string and its
% associated value to be printed (if any) to a string, and then either append
% the resulting strings together (if the original call was to string.format),
% record the resulting strings (if the call was to string.builder.format)
% or print the resulting strings as they are produced (if the call was to
% io.format). We optimize calls to stream.string_writer.format by constructing
% the string to be written the same way as we do for string.format, and then
% printing the result. For each call site that we could optimize, we record
% its replacement in a map.
%
% If there are any such replacements, we perform a second backward traversal
% of the procedure body, looking for the goals to be replaced (which we
% identify by goal_id), and replace them.
%
% For each call we want to optimize, we also want to delete the code that
% constructs the format string and the lists of poly_types. The first pass
% records the identities of the variables involved, so that we can delete the
% construct unifications that produce them (if they were produced by calls,
% we would not have been able to know at compile time *what* they produce).
% Of course, some of these variables may be used elsewhere, both before and
% after the format call we are optimizing. That is why this second backwards
% traversal passes along two sets of variables: the set of variables we want
% to remove (ToDeleteVars), and the set of variables known to be needed later
% (NeededVars). Construction unifications that create one of the ToDeleteVars
% are deleted, unless the variable is also in NeededVars.
%
%---------------------------------------------------------------------------%
:- module check_hlds.simplify.opt_format_call.
:- interface.
:- import_module hlds.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
:- import_module parse_tree.
:- import_module parse_tree.error_spec.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.var_table.
:- import_module io.
:- import_module list.
:- import_module maybe.
%---------------------------------------------------------------------------%
:- pred is_format_call(pred_info::in, list(prog_var)::in) is semidet.
%---------------------------------------------------------------------------%
:- type maybe_generate_implicit_stream_warnings
---> do_not_generate_implicit_stream_warnings
; generate_implicit_stream_warnings.
:- pred analyze_and_optimize_format_calls(io.text_output_stream::in,
maybe_generate_implicit_stream_warnings::in,
module_info::in, pred_info::in, proc_info::in,
hlds_goal::in, maybe(hlds_goal)::out, list(error_spec)::out,
var_table::in, var_table::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.simplify.opt_format_call_errors.
:- import_module check_hlds.simplify.parse_string_format.
:- import_module check_hlds.simplify.simplify_goal_call.
:- import_module hlds.goal_path.
:- import_module hlds.goal_util.
:- import_module hlds.hlds_markers.
:- import_module hlds.hlds_out.
:- import_module hlds.hlds_out.hlds_out_goal.
:- import_module hlds.hlds_out.hlds_out_util.
:- import_module hlds.instmap.
:- import_module hlds.make_goal.
:- import_module hlds.pred_name.
:- import_module hlds.pred_table.
:- import_module libs.
:- import_module libs.globals.
:- import_module libs.optimization_options.
:- import_module libs.options.
:- import_module mdbcomp.
:- import_module mdbcomp.builtin_modules.
:- import_module mdbcomp.goal_path.
:- import_module mdbcomp.prim_data.
:- import_module mdbcomp.sym_name.
:- import_module parse_tree.builtin_lib_types.
:- import_module parse_tree.maybe_error.
:- import_module parse_tree.parse_tree_out_info.
:- import_module parse_tree.prog_data_pragma.
:- import_module parse_tree.prog_type.
:- import_module parse_tree.set_of_var.
:- import_module parse_tree.var_db.
:- import_module bool.
:- import_module counter.
:- import_module getopt.
:- import_module int.
:- import_module map.
:- import_module one_or_more.
:- import_module pair.
:- import_module require.
:- import_module set_tree234.
:- import_module string.
:- import_module string.parse_util.
:- import_module term.
%---------------------------------------------------------------------------%
:- type format_call_site
---> format_call_site(
fcs_goal_id :: goal_id,
fcs_goal_info :: hlds_goal_info,
fcs_call_kind :: format_call_kind,
fcs_called_pred_id :: pred_id,
fcs_call_context :: prog_context,
fcs_containing_conj :: conj_id,
fcs_warn_unknown_format :: maybe_warn_unknown_format
).
%---------------------------------------------------------------------------%
:- type conj_id
---> conj_id(int).
% Maps each conjunction to its predecessor (if any) in the sense
% documented above.
%
:- type conj_pred_map == map(conj_id, conj_id).
%---------------------------------------------------------------------------%
:- type string_state
---> string_const(string)
; string_append(goal_id, prog_var, prog_var)
% The string variables being appended together,
% and the id of the goal that does the appending.
; string_append_list(goal_id, prog_var).
% The variable holding the list skeleton of the list of string
% variables being appended together,
% and the id of the goal that does the appending.
% Maps each variable representing a format string
% - either to the format string itself,
% - or to the method of its construction.
:- type string_map == map(prog_var, string_state).
:- type list_skeleton_state
---> list_skeleton_nil
; list_skeleton_cons(
head :: prog_var,
tail :: prog_var
).
% Maps each variable participating in the skeleton of the list of values
% to be printed to its value.
:- type list_skeleton_map == map(prog_var, list_skeleton_state).
% Maps each variable representing a polytype in the list of values to be
% printed to an abstract representation of that polytype, with the
% actual value to be printed replaced by the variable that will hold
% that value at runtime.
%
% For example, when we find the unification X = string.poly_type.s(Y),
% we add to the list_element_map an entry mapping X to apt_s(Y).
:- type list_element_map == map(prog_var, abstract_poly_type).
% Maps each variable defined in terms of another variable to the variable
% it is assigned from.
:- type fc_eqv_map == map(prog_var, prog_var).
% The knowledge we have recorded from assign and construct unifications
% in a given conjunction.
%
:- type conj_map
---> conj_map(
cm_string_map :: string_map,
cm_list_skeleton_map :: list_skeleton_map,
cm_list_element_map :: list_element_map,
cm_eqv_map :: fc_eqv_map
).
% Maps the id of each conjunction to the knowledge we have derived from
% unifications in that conjunction.
%
:- type conj_maps == map(conj_id, conj_map).
%---------------------------------------------------------------------------%
% Records the information about each call site that is not common
% to all calls to recognized predicates and function.
%
:- type format_call_kind
---> kind_string_format(
sf_context :: prog_context,
sf_fmt_str_values :: fmt_str_val_vars,
sf_result_var :: prog_var
)
; kind_string_builder(
sb_context :: prog_context,
sb_fmt_str_values :: fmt_str_val_vars,
sb_state_in_var :: prog_var,
sb_state_out_var :: prog_var
)
; kind_io_format_nostream(
iofns_context :: prog_context,
iofns_fmt_str_values :: fmt_str_val_vars,
iofns_io_in_var :: prog_var,
iofns_io_out_var :: prog_var
)
; kind_io_format_stream(
iofs_context :: prog_context,
iofs_stream_var :: prog_var,
iofs_fmt_str_values :: fmt_str_val_vars,
iofs_io_in_var :: prog_var,
iofs_io_out_var :: prog_var
)
; kind_stream_string_writer(
ssw_context :: prog_context,
ssw_tc_info_var :: prog_var,
ssw_stream_var :: prog_var,
ssw_fmt_str_values :: fmt_str_val_vars,
ssw_in_var :: prog_var,
ssw_out_var :: prog_var
)
; kind_pragma(
p_context :: prog_context,
p_fmt_str_values :: one_or_more(fmt_str_val_vars)
).
:- inst format_call_kind_opt for format_call_kind/0
---> kind_string_format(ground, ground, ground)
; kind_string_builder(ground, ground, ground, ground)
; kind_io_format_nostream(ground, ground, ground, ground)
; kind_io_format_stream(ground, ground, ground, ground, ground)
; kind_stream_string_writer(ground, ground, ground,
ground, ground, ground).
:- type fmt_str_val_vars
---> fmt_str_val_vars(
% If this is a call to a predicate or function that has
% a format_call pragma that specifies more than one pair
% of <format string, values list> argument positions,
% this field will contain yes({N, ArgNumFS, ArgNumVL})
% if this structure corresponds to the Nth such pair containing
% <ArgNumFS, ArgNumVL>. Otherwise, this field will contain no.
maybe({int, int, int}),
% The variable holding a format string, and the associated
% variable holding the values list.
prog_var,
prog_var
).
:- pred get_fmt_str_val_vars_from_format_call_kind(format_call_kind::in,
fmt_str_val_vars::out, list(fmt_str_val_vars)::out) is det.
get_fmt_str_val_vars_from_format_call_kind(Kind, FmtStrVal, FmtStrVals) :-
(
( Kind = kind_string_format(_, FmtStrVal, _)
; Kind = kind_string_builder(_, FmtStrVal, _, _)
; Kind = kind_io_format_nostream(_, FmtStrVal, _, _)
; Kind = kind_io_format_stream(_, _, FmtStrVal, _, _)
; Kind = kind_stream_string_writer(_, _, _, FmtStrVal, _, _)
),
FmtStrVals = []
;
Kind = kind_pragma(_, OoMFmtStrVals),
OoMFmtStrVals = one_or_more(FmtStrVal, FmtStrVals)
).
:- func get_relevant_vars_from_format_call_kind(format_call_kind)
= set_of_progvar.
get_relevant_vars_from_format_call_kind(Kind) = Vars :-
get_fmt_str_val_vars_from_format_call_kind(Kind, FmtStrVal, FmtStrVals),
BaseSet = get_relevant_vars_from_fmt_str_val_vars(FmtStrVal),
AddedSets = list.map(get_relevant_vars_from_fmt_str_val_vars, FmtStrVals),
set_of_var.union_list([BaseSet | AddedSets], Vars).
:- func get_relevant_vars_from_fmt_str_val_vars(fmt_str_val_vars)
= set_of_progvar.
get_relevant_vars_from_fmt_str_val_vars(FmtStrVal) = Vars :-
FmtStrVal = fmt_str_val_vars(_, VarFS, VarVL),
set_of_var.list_to_set([VarFS, VarVL], Vars).
%---------------------------------------------------------------------------%
%
% This section contains two predicates that both recognize whether a call
% is to a predicate that this module is interested in, both because we
% want to check the call for errors, and because (in the absence of errors)
% we want to replace the call with faster code.
%
% The two are different because of their different requirements.
%
% - is_format_call is used by determinism analysis, acting as a pre-pass
% for the simplification pass, to determine whether a predicate contains
% a call that this module is interested in, which in turn controls
% whether this module's main predicate, analyze_and_optimize_format_calls,
% should even be invoked. Since very few calls are format calls, most
% invocations of is_format_call will fail, so the key is make it fail fast.
%
% - is_format_call_kind_and_vars is used by analyze_and_optimize_format_calls
% itself to gather the info that that predicate needs to do its job.
% Since it is only ever invoked on predicates that *do* contain a format
% call, its performance is not as important.
%
% There is a third predicate that also needs to know which predicates
% this module considers to be format predicates, and that is
% is_possible_format_call in get_dependencies.m. This differs from both
% the predicates above in that
%
% - it operates on the data structures of the module's parse_tree, NOT on
% the HLDS that we will later construct from it, and
%
% - since it operates before module qualification, the names it operates on
% may be unqualified or only partially qualified, so the best we can do
% is report whether a callee *may* be a format predicate.
%
% The first of these reasons is why is_possible_format_call cannot be moved
% to this module; since its caller is in the parse_tree package, it cannot
% call anything in the check_hlds package (which format_call.m is in).
%
% NOTE If you want to modify the set of format predicates, you must update
% *all three* of these predicates.
%
is_format_call(PredInfo, ArgVars) :-
ModuleName = pred_info_module(PredInfo),
Name = pred_info_name(PredInfo),
( if is_builtin_format_call(ModuleName, Name, ArgVars) then
true
else
pred_info_get_format_call_info(PredInfo, MaybeFormatCall),
(
MaybeFormatCall = yes(_FormatCall)
;
MaybeFormatCall = no,
fail
)
).
:- pred is_builtin_format_call(module_name::in, string::in, list(prog_var)::in)
is semidet.
is_builtin_format_call(WrappedModuleName, Name, ArgVars) :-
% NOTE The logic here must match the test logic of the
% is_builtin_format_call_kind_and_vars predicate below.
Name = "format",
maybe_remove_stdlib_wrapper(WrappedModuleName, ModuleName),
(
ModuleName = unqualified("string"),
ArgVars = [_FmtStrVar, _FmtValuesVar, _ResultVar]
;
ModuleName = unqualified("io"),
(
ArgVars = [_FmtStrVar, _FmtValuesVar, _StateInVar, _StateOutVar]
;
ArgVars = [_StreamVar, _FmtStrVar, _FmtValuesVar,
_StateInVar, _StateOutVar]
)
;
ModuleName = qualified(unqualified("string"), "builder"),
ArgVars = [_FmtStrVar, _FmtValuesVar, _StateInVar, _StateOutVar]
;
ModuleName = qualified(unqualified("stream"), "string_writer"),
ArgVars = [_TypeClassInfoVarForStream, _StreamVar, _FmtStrVar,
_FmtValuesVar, _StateInVar, _StateOutVar]
).
%---------------------%
:- pred is_format_call_kind_and_vars(pred_info::in,
module_name::in, string::in, list(prog_var)::in, hlds_goal_info::in,
format_call_kind::out) is semidet.
is_format_call_kind_and_vars(PredInfo, ModuleName, Name, ArgVars, GoalInfo,
Kind) :-
( if
is_builtin_format_call_kind_and_vars(ModuleName, Name, ArgVars,
GoalInfo, KindPrime)
then
Kind = KindPrime
else
pred_info_get_format_call_info(PredInfo, MaybeFormatCall),
(
MaybeFormatCall = yes(FormatCall),
FormatCall = format_call_info(Context, OoMFmtStrValArgs),
one_or_more.length(OoMFmtStrValArgs, NumFmtStrValArgs),
one_or_more.map_foldl(arg_nums_to_vars(ArgVars, NumFmtStrValArgs),
OoMFmtStrValArgs, OoMFmtStrValVars, 1, _),
Kind = kind_pragma(Context, OoMFmtStrValVars)
;
MaybeFormatCall = no,
fail
)
).
:- pred arg_nums_to_vars(list(prog_var)::in, int::in,
format_string_values::in, fmt_str_val_vars::out, int::in, int::out) is det.
arg_nums_to_vars(ArgVars, NumFormatStringValues,
FormatStringValues, FmtStrVal, !Pos) :-
FormatStringValues = format_string_values(OrigArgNumFS, OrigArgNumVL,
CurArgNumFS, CurArgNumVL),
list.det_index1(ArgVars, CurArgNumFS, VarFS),
list.det_index1(ArgVars, CurArgNumVL, VarVL),
( if NumFormatStringValues = 1 then
MaybePos = no
else
MaybePos = yes({!.Pos, OrigArgNumFS, OrigArgNumVL})
),
FmtStrVal = fmt_str_val_vars(MaybePos, VarFS, VarVL),
!:Pos = !.Pos + 1.
:- pred is_builtin_format_call_kind_and_vars(module_name::in, string::in,
list(prog_var)::in, hlds_goal_info::in, format_call_kind::out) is semidet.
is_builtin_format_call_kind_and_vars(WrappedModuleName, Name, ArgVars,
GoalInfo, Kind) :-
Name = "format",
maybe_remove_stdlib_wrapper(WrappedModuleName, ModuleName),
% NOTE The test logic here must be duplicated in the is_builtin_format_call
% predicate above, and it the is_possible_format_call predicate in
% get_dependencies.m.
(
ModuleName = unqualified("string"),
% We have these arguments regardless of whether we call the
% predicate or function version of string.format.
ArgVars = [FmtStrVar, FmtValuesVar, ResultVar],
Context = goal_info_get_context(GoalInfo),
FmtStrValVars = fmt_str_val_vars(no, FmtStrVar, FmtValuesVar),
Kind = kind_string_format(Context, FmtStrValVars, ResultVar)
;
ModuleName = unqualified("io"),
(
ArgVars = [FmtStrVar, FmtValuesVar, StateInVar, StateOutVar],
Context = goal_info_get_context(GoalInfo),
FmtStrValVars = fmt_str_val_vars(no, FmtStrVar, FmtValuesVar),
Kind = kind_io_format_nostream(Context, FmtStrValVars,
StateInVar, StateOutVar)
;
ArgVars = [StreamVar, FmtStrVar, FmtValuesVar,
StateInVar, StateOutVar],
Context = goal_info_get_context(GoalInfo),
FmtStrValVars = fmt_str_val_vars(no, FmtStrVar, FmtValuesVar),
Kind = kind_io_format_stream(Context, StreamVar, FmtStrValVars,
StateInVar, StateOutVar)
)
;
ModuleName = qualified(unqualified("string"), "builder"),
ArgVars = [FmtStrVar, FmtValuesVar, StateInVar, StateOutVar],
Context = goal_info_get_context(GoalInfo),
FmtStrValVars = fmt_str_val_vars(no, FmtStrVar, FmtValuesVar),
Kind = kind_string_builder(Context, FmtStrValVars,
StateInVar, StateOutVar)
;
ModuleName = qualified(unqualified("stream"), "string_writer"),
% Since we do this check after polymorphism, there will have been
% a typeclassinfo inserted at the front of the argument list.
ArgVars = [TypeClassInfoVarForStream, StreamVar,
FmtStrVar, FmtValuesVar, StateInVar, StateOutVar],
Context = goal_info_get_context(GoalInfo),
FmtStrValVars = fmt_str_val_vars(no, FmtStrVar, FmtValuesVar),
Kind = kind_stream_string_writer(Context, TypeClassInfoVarForStream,
StreamVar, FmtStrValVars, StateInVar, StateOutVar)
).
%---------------------------------------------------------------------------%
analyze_and_optimize_format_calls(ProgressStream, GenImplicitStreamWarnings,
ModuleInfo, PredInfo, ProcInfo, Goal0, MaybeGoal, Specs, !VarTable) :-
map.init(ConjMaps0),
counter.init(0, Counter0),
fill_goal_id_slots_in_proc_body(ModuleInfo, !.VarTable, _, Goal0, Goal1),
module_info_get_globals(ModuleInfo, Globals0),
globals.set_option(dump_hlds_options, string("vxP"), Globals0, Globals),
OutInfo = init_hlds_out_info(Globals, output_debug),
pred_info_get_typevarset(PredInfo, TVarSet),
proc_info_get_inst_varset(ProcInfo, InstVarSet),
trace [io(!IO), compiletime(flag("debug_format_call"))] (
VarNameSrc = vns_var_table(!.VarTable),
io.write_string(ProgressStream, "\n\nBEFORE TRANSFORM:\n", !IO),
write_goal(OutInfo, ProgressStream, ModuleInfo, VarNameSrc,
print_name_and_num, TVarSet, InstVarSet, 0u, "\n", Goal1, !IO)
),
globals.lookup_bool_option(Globals, warn_unknown_format_calls,
WarnUnknownFormatBool),
pred_info_get_origin(PredInfo, Origin),
% Generate warnings about unknown formats only if
%
% - such warnings have not been disabled, and
% - if the predicate is itself written by the user.
%
% We need the latter test when we type-specialize e.g.
% stream.string_writer.format. The way we implement type specialization
% is that we create a fresh new predicate with the specialized types
% that simply calls the old predicate. When the old predicate is
% stream.string_writer.format, this would yield an error without
% this test here.
( if
WarnUnknownFormatBool = yes,
Origin = origin_user(_)
then
WarnUnknownFormat = warn_unknown_format
else
WarnUnknownFormat = do_not_warn_unknown_format
),
Params = format_call_traverse_params(ModuleInfo, ProgressStream,
WarnUnknownFormat),
format_call_traverse_goal(Params, Goal1, _, [], FormatCallSites,
Counter0, _Counter, ConjMaps0, ConjMaps, map.init, PredMap,
set_of_var.init, _),
globals.get_opt_tuple(Globals, OptTuple),
OptFormatCalls = OptTuple ^ ot_opt_format_calls,
globals.lookup_bool_option(Globals, exec_trace, ExecTrace),
% If users write a call to e.g. to string.format, they expect the debugger
% to show them calls to string.format. Showing a sequence of calls to
% lower level predicates instead of that higher level call would probably
% confuse debugger users.
( if
OptFormatCalls = opt_format_calls,
ExecTrace = no
then
ShouldOptFormatCalls = opt_format_calls
else
ShouldOptFormatCalls = do_not_opt_format_calls
),
list.foldl3(
check_format_call_site(ModuleInfo, PredInfo, ProcInfo,
GenImplicitStreamWarnings, ShouldOptFormatCalls,
ConjMaps, PredMap),
FormatCallSites, map.init, GoalIdMap, [], Specs, !VarTable),
( if map.is_empty(GoalIdMap) then
% We have not found anything to improve in Goal1.
MaybeGoal = no
else
% We want to set NeededVars0 to be the set of the procedure's
% output arguments, but it is ok to add into it some non-output
% arguments whose insts happen to change as well.
Goal1 = hlds_goal(_, GoalInfo1),
InstMapDelta = goal_info_get_instmap_delta(GoalInfo1),
instmap_delta_changed_vars(InstMapDelta, NeededVars0),
ToDeleteVars0 = set_of_var.init,
ToDeleteGoals0 = set_tree234.init,
opt_format_call_sites_in_goal(Goal1, Goal, GoalIdMap, _,
NeededVars0, _NeededVars, ToDeleteVars0, _ToDeleteVars,
ToDeleteGoals0, _ToDeleteGoals),
trace [io(!IO), compiletime(flag("debug_format_call"))] (
VarNameSrc = vns_var_table(!.VarTable),
io.write_string(ProgressStream, "\n\nAFTER TRANSFORM:\n", !IO),
write_goal(OutInfo, ProgressStream, ModuleInfo, VarNameSrc,
print_name_and_num, TVarSet, InstVarSet, 0u, "\n", Goal, !IO)
),
MaybeGoal = yes(Goal)
).
:- pred check_format_call_site(module_info::in, pred_info::in, proc_info::in,
maybe_generate_implicit_stream_warnings::in, maybe_opt_format_calls::in,
conj_maps::in, conj_pred_map::in, format_call_site::in,
fc_goal_id_map::in, fc_goal_id_map::out,
list(error_spec)::in, list(error_spec)::out,
var_table::in, var_table::out) is det.
check_format_call_site(ModuleInfo, PredInfo, ProcInfo, ImplicitStreamWarnings,
OptFormatCalls, ConjMaps, PredMap, FormatCallSite,
!GoalIdMap, !Specs, !VarTable) :-
FormatCallSite = format_call_site(GoalId, GoalInfo, Kind, CalleePredId,
_Context, _CurId, _WarnUnknownFormat),
(
ImplicitStreamWarnings = do_not_generate_implicit_stream_warnings
;
ImplicitStreamWarnings = generate_implicit_stream_warnings,
module_info_pred_info(ModuleInfo, CalleePredId, CalleePredInfo),
maybe_generate_warning_for_implicit_stream_predicate(ModuleInfo,
CalleePredId, CalleePredInfo, GoalInfo, MaybeImplicitStreamSpec),
(
MaybeImplicitStreamSpec = no
;
MaybeImplicitStreamSpec = yes(ImplicitStreamSpec),
!:Specs = [ImplicitStreamSpec | !.Specs]
)
),
(
( Kind = kind_string_format(_, FmtStrVal, _)
; Kind = kind_string_builder(_, FmtStrVal, _, _)
; Kind = kind_io_format_nostream(_, FmtStrVal, _, _)
; Kind = kind_io_format_stream(_, _, FmtStrVal, _, _)
; Kind = kind_stream_string_writer(_, _, _, FmtStrVal, _, _)
),
check_fmt_str_val_vars(ModuleInfo, PredInfo, ProcInfo,
ConjMaps, PredMap, FormatCallSite, FmtStrVal, CheckResult),
(
CheckResult = ok3(FormatSpecs, ToDeleteVars, ToDeleteGoals),
(
OptFormatCalls = do_not_opt_format_calls
;
OptFormatCalls = opt_format_calls,
merge_adjacent_const_strs(FormatSpecs, FormatSpecsOpt),
create_replacement_goal(ModuleInfo, GoalId, Kind,
FormatSpecsOpt, ToDeleteVars, ToDeleteGoals,
!GoalIdMap, !VarTable)
)
;
CheckResult = error3(CheckSpecs),
!:Specs = CheckSpecs ++ !.Specs
)
;
Kind = kind_pragma(_, OoMFmtStrVars),
OoMFmtStrVars = one_or_more(HeadFmtStrVal, TailFmtStrVals),
check_fmt_str_val_vars(ModuleInfo, PredInfo, ProcInfo,
ConjMaps, PredMap, FormatCallSite, HeadFmtStrVal, HeadCheckResult),
list.map(
check_fmt_str_val_vars(ModuleInfo, PredInfo, ProcInfo,
ConjMaps, PredMap, FormatCallSite),
TailFmtStrVals, TailCheckResults),
HeadCheckSpecs = get_any_errors3(HeadCheckResult),
TailCheckSpecLists = list.map(get_any_errors3, TailCheckResults),
CheckSpecs = HeadCheckSpecs ++ list.condense(TailCheckSpecLists),
!:Specs = CheckSpecs ++ !.Specs
).
:- pred check_fmt_str_val_vars(module_info::in, pred_info::in, proc_info::in,
conj_maps::in, conj_pred_map::in, format_call_site::in,
fmt_str_val_vars::in,
maybe3(list(compiler_format_spec), list(prog_var), list(goal_id))::out)
is det.
check_fmt_str_val_vars(ModuleInfo, PredInfo, ProcInfo, ConjMaps, PredMap,
FormatCallSite, FmtStrValVars, Result) :-
FormatCallSite = format_call_site(_GoalId, _GoalInfo, _Kind, PredId,
Context, _CurId, _WarnUnknownFormat),
FmtStrValVars = fmt_str_val_vars(MaybePos, StringVar, ValuesVar),
follow_format_string_handle_unknown(ModuleInfo, ConjMaps, PredMap,
FormatCallSite, StringVar, FormatStringResult),
follow_values_handle_unknown(ModuleInfo, ConjMaps, PredMap,
FormatCallSite, ValuesVar, ValuesResult),
( if
FormatStringResult = ok3(FormatString, ToDeleteVarsFS, ToDeleteGoals),
ValuesResult = ok2(AbstractPolyTypes, ToDeleteVarsVL)
then
string.to_char_list(FormatString, FormatStringChars),
parse_format_string_abstract(FormatStringChars, AbstractPolyTypes,
Context, MaybeFormatSpecs),
(
MaybeFormatSpecs = error(HeadError, TailErrors),
Specs = report_format_mismatch(ModuleInfo, PredId, MaybePos,
HeadError, TailErrors, Context),
Result = error3(Specs)
;
MaybeFormatSpecs = ok(FormatSpecs),
ToDeleteVars = ToDeleteVarsFS ++ ToDeleteVarsVL,
Result = ok3(FormatSpecs, ToDeleteVars, ToDeleteGoals)
)
else
( if
FormatStringResult = error3(_),
ValuesResult = error2(_),
format_call_is_checked_in_parent(PredInfo, ProcInfo,
StringVar, ValuesVar)
then
Specs = []
else
Specs =
get_any_errors3(FormatStringResult) ++
get_any_errors2(ValuesResult)
),
Result = error3(Specs)
).
:- pred project_all_yes(list(maybe(T))::in, list(T)::out) is semidet.
project_all_yes([], []).
project_all_yes([yes(Value) | TailMaybes], [Value | Tail]) :-
project_all_yes(TailMaybes, Tail).
%---------------------------------------------------------------------------%
:- pred follow_format_string_handle_unknown(module_info::in,
conj_maps::in, conj_pred_map::in, format_call_site::in, prog_var::in,
maybe3(string, list(prog_var), list(goal_id))::out) is det.
follow_format_string_handle_unknown(ModuleInfo, ConjMaps, PredMap,
FormatCallSite, StringVar, Result) :-
FormatCallSite = format_call_site(_GoalId, _GoalInfo, _Kind, PredId,
Context, CurId, WarnUnknownFormat),
follow_format_string(ConjMaps, PredMap, CurId, StringVar,
FormatStringResult),
(
FormatStringResult = follow_string_result(FormatString,
ToDeleteVars0, ToDeleteGoals),
ToDeleteVars = [StringVar | ToDeleteVars0],
Result = ok3(FormatString, ToDeleteVars, ToDeleteGoals)
;
FormatStringResult = no_follow_string_result,
Specs = report_unknown_format_string(ModuleInfo, PredId,
WarnUnknownFormat, Context),
Result = error3(Specs)
).
:- type follow_string_result
---> no_follow_string_result
; follow_string_result(
% The string variable is known to be bound to this string.
fsr_string :: string,
% The string variables that hold this string, and if it was
% constructed using string append or append list operations,
% the variables holding the pieces that were glued together
% as well as any list skeletons holding those pieces.
fsr_to_delete_vars :: list(prog_var),
% The identities of the calls to string append or append list
% predicates that do the gluing. Does not list unification
% goals, since those are deleted solely based on whether
% they construct a to-delete variable.
fsr_to_delete_goals :: list(goal_id)
).
:- pred follow_format_string(conj_maps::in, conj_pred_map::in, conj_id::in,
prog_var::in, follow_string_result::out) is det.
follow_format_string(ConjMaps, PredMap, CurId, StringVar, Result) :-
ConjMap = get_conj_map(ConjMaps, CurId),
ConjMap = conj_map(StringMap, _, _, EqvMap),
( if map.search(EqvMap, StringVar, EqvVar) then
follow_format_string(ConjMaps, PredMap, CurId, EqvVar, Result)
else if map.search(StringMap, StringVar, StringState) then
(
StringState = string_const(String),
Result = follow_string_result(String, [StringVar], [])
;
StringState = string_append(AppendGoalId, StringVarA, StringVarB),
follow_format_string(ConjMaps, PredMap, CurId, StringVarA,
ResultA),
follow_format_string(ConjMaps, PredMap, CurId, StringVarB,
ResultB),
( if
ResultA = follow_string_result(StringA,
ToDeleteVarsA, ToDeleteGoalsA),
ResultB = follow_string_result(StringB,
ToDeleteVarsB, ToDeleteGoalsB)
then
Result = follow_string_result(StringA ++ StringB,
ToDeleteVarsA ++ ToDeleteVarsB,
[AppendGoalId] ++ ToDeleteGoalsA ++ ToDeleteGoalsB)
else
Result = no_follow_string_result
)
;
StringState = string_append_list(AppendListGoalId, SkeletonVar),
follow_list_skeleton(ConjMaps, PredMap, CurId, SkeletonVar,
SkeletonResult),
(
SkeletonResult = no_follow_skeleton_result,
Result = no_follow_string_result
;
SkeletonResult = follow_skeleton_result(SubStringVars,
SkeletonVars),
list.map(follow_format_string(ConjMaps, PredMap, CurId),
SubStringVars, SubStringResults),
( if
project_all_follow_string_results(SubStringResults,
String, SubStringToDeleteVars, SubStringToDeleteGoals)
then
Result = follow_string_result(String,
SkeletonVars ++ SubStringToDeleteVars,
[AppendListGoalId | SubStringToDeleteGoals])
else
Result = no_follow_string_result
)
)
)
else if map.search(PredMap, CurId, PredId) then
follow_format_string(ConjMaps, PredMap, PredId, StringVar, Result)
else
Result = no_follow_string_result
).
:- pred project_all_follow_string_results(list(follow_string_result)::in,
string::out, list(prog_var)::out, list(goal_id)::out) is semidet.
project_all_follow_string_results([], "", [], []).
project_all_follow_string_results([HeadResult | TailResults],
String, ToDeleteVars, ToDeleteGoals) :-
HeadResult = follow_string_result(HeadString,
HeadToDeleteVars, HeadToDeleteGoals),
project_all_follow_string_results(TailResults,
TailString, TailToDeleteVars, TailToDeleteGoals),
String = HeadString ++ TailString,
ToDeleteVars = HeadToDeleteVars ++ TailToDeleteVars,
ToDeleteGoals = HeadToDeleteGoals ++ TailToDeleteGoals.
%---------------------%
:- pred follow_values_handle_unknown(module_info::in, conj_maps::in,
conj_pred_map::in, format_call_site::in, prog_var::in,
maybe2(list(abstract_poly_type), list(prog_var))::out) is det.
follow_values_handle_unknown(ModuleInfo, ConjMaps, PredMap, FormatCallSite,
ValuesVar, Result) :-
FormatCallSite = format_call_site(_GoalId, _GoalInfo, _Kind, PredId,
Context, CurId, WarnUnknownFormat),
follow_list_skeleton(ConjMaps, PredMap, CurId, ValuesVar, SkeletonResult),
( if
SkeletonResult = follow_skeleton_result(PolyTypeVars, SkeletonVars),
list.map(follow_poly_type(ConjMaps, PredMap, CurId), PolyTypeVars,
MaybeAbstractPolyTypes),
project_all_yes(MaybeAbstractPolyTypes, AbstractPolyTypes)
then
PolyTypesToDeleteVars = [ValuesVar | SkeletonVars] ++ PolyTypeVars,
Result = ok2(AbstractPolyTypes, PolyTypesToDeleteVars)
else
Specs = report_unknown_format_values(ModuleInfo, PredId,
WarnUnknownFormat, Context),
Result = error2(Specs)
).
:- type follow_skeleton_result
---> no_follow_skeleton_result
; follow_skeleton_result(
fsr_element_vars :: list(prog_var),
fsr_skeleton_vars :: list(prog_var)
).
:- pred follow_list_skeleton(conj_maps::in, conj_pred_map::in, conj_id::in,
prog_var::in, follow_skeleton_result::out) is det.
follow_list_skeleton(ConjMaps, PredMap, CurId, ListVar, Result) :-
ConjMap = get_conj_map(ConjMaps, CurId),
ConjMap = conj_map(_, ListMap, _, EqvMap),
( if map.search(EqvMap, ListVar, EqvVar) then
follow_list_skeleton(ConjMaps, PredMap, CurId, EqvVar, Result)
else if map.search(ListMap, ListVar, ListState) then
(
ListState = list_skeleton_nil,
Result = follow_skeleton_result([], [ListVar])
;
ListState = list_skeleton_cons(HeadVar, TailVar),
follow_list_skeleton(ConjMaps, PredMap, CurId, TailVar,
TailResult),
(
TailResult = no_follow_skeleton_result,
Result = no_follow_skeleton_result
;
TailResult = follow_skeleton_result(TailElementVars,
TailSkeletonVars),
ElementVars = [HeadVar | TailElementVars],
( if list.member(TailVar, TailSkeletonVars) then
true
else
unexpected($pred, "TailVar not in TailSkeletonVars")
),
SkeletonVars = [ListVar | TailSkeletonVars],
Result = follow_skeleton_result(ElementVars, SkeletonVars)
)
)
else if map.search(PredMap, CurId, PredId) then
follow_list_skeleton(ConjMaps, PredMap, PredId, ListVar, Result)
else
Result = no_follow_skeleton_result
).
:- pred follow_poly_type(conj_maps::in, conj_pred_map::in,
conj_id::in, prog_var::in, maybe(abstract_poly_type)::out) is det.
follow_poly_type(ConjMaps, PredMap, CurId, PolyTypeVar,
MaybeAbstractPolyType) :-
ConjMap = get_conj_map(ConjMaps, CurId),
ConjMap = conj_map(_, _, ElementMap, EqvMap),
( if map.search(EqvMap, PolyTypeVar, EqvVar) then
follow_poly_type(ConjMaps, PredMap, CurId, EqvVar,
MaybeAbstractPolyType)
else if map.search(ElementMap, PolyTypeVar, AbstractPolyType) then
MaybeAbstractPolyType = yes(AbstractPolyType)
else if map.search(PredMap, CurId, PredId) then
follow_poly_type(ConjMaps, PredMap, PredId, PolyTypeVar,
MaybeAbstractPolyType)
else
MaybeAbstractPolyType = no
).
%---------------------%
:- pred format_call_is_checked_in_parent(pred_info::in, proc_info::in,
prog_var::in, prog_var::in) is semidet.
format_call_is_checked_in_parent(PredInfo, ProcInfo, VarFS, VarVL) :-
pred_info_get_format_call_info(PredInfo, MaybeFormatCall),
MaybeFormatCall = yes(FormatCall),
FormatCall = format_call_info(_Context, OoMFormatStringsValues),
FormatStringsValues = one_or_more_to_list(OoMFormatStringsValues),
proc_info_get_headvars(ProcInfo, HeadVars),
format_call_is_checked_in_parent_loop(HeadVars, FormatStringsValues,
VarFS, VarVL).
:- pred format_call_is_checked_in_parent_loop(list(prog_var)::in,
list(format_string_values)::in, prog_var::in, prog_var::in) is semidet.
format_call_is_checked_in_parent_loop(_, [], _, _) :-
fail.
format_call_is_checked_in_parent_loop(HeadVars, [FSV | FSVs], VarFS, VarVL) :-
FSV = format_string_values(_OrigArgNumFS, _OrigArgNumVL,
CurArgNumFS, CurArgNumVL),
list.det_index1(HeadVars, CurArgNumFS, HeadArgVarFS),
list.det_index1(HeadVars, CurArgNumVL, HeadArgVarVL),
( if
HeadArgVarFS = VarFS,
HeadArgVarVL = VarVL
then
true
else
format_call_is_checked_in_parent_loop(HeadVars, FSVs, VarFS, VarVL)
).
%---------------------------------------------------------------------------%
%
% This is the backwards traversal described at the top of this module.
%
:- type format_call_traverse_params
---> format_call_traverse_params(
fctp_module_info :: module_info,
fctp_progress_stream :: io.text_output_stream,
fctp_warn_unknown_format :: maybe_warn_unknown_format
).
:- pred format_call_traverse_goal(format_call_traverse_params::in,
hlds_goal::in, conj_id::out,
list(format_call_site)::in, list(format_call_site)::out,
counter::in, counter::out, conj_maps::in, conj_maps::out,
conj_pred_map::in, conj_pred_map::out,
set_of_progvar::in, set_of_progvar::out) is det.
format_call_traverse_goal(Params, Goal, CurId, !FormatCallSites, !Counter,
!ConjMaps, !PredMap, !RelevantVars) :-
alloc_id(CurId, !Counter),
goal_to_conj_list(Goal, GoalConj),
format_call_traverse_conj(Params, GoalConj, CurId, !FormatCallSites,
!Counter, !ConjMaps, !PredMap, !RelevantVars).
:- pred format_call_traverse_conj(format_call_traverse_params::in,
list(hlds_goal)::in, conj_id::in,
list(format_call_site)::in, list(format_call_site)::out,
counter::in, counter::out, conj_maps::in, conj_maps::out,
conj_pred_map::in, conj_pred_map::out,
set_of_progvar::in, set_of_progvar::out) is det.
format_call_traverse_conj(_, [], _CurId, !FormatCallSites,
!Counter, !ConjMaps, !PredMap, !RelevantVars).
format_call_traverse_conj(Params, [Goal | Goals], CurId, !FormatCallSites,
!Counter, !ConjMaps, !PredMap, !RelevantVars) :-
format_call_traverse_conj(Params, Goals, CurId, !FormatCallSites,
!Counter, !ConjMaps, !PredMap, !RelevantVars),
Goal = hlds_goal(GoalExpr, GoalInfo),
(
GoalExpr = conj(_, Conjuncts),
format_call_traverse_conj(Params, Conjuncts, CurId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap, !RelevantVars)
;
GoalExpr = disj(Disjuncts),
format_call_traverse_disj(Params, Disjuncts, CurId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap, !RelevantVars)
;
GoalExpr = switch(_, _, Cases),
Disjuncts = list.map(project_case_goal, Cases),
format_call_traverse_disj(Params, Disjuncts, CurId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap, !RelevantVars)
;
GoalExpr = if_then_else(_, Cond, Then, Else),
format_call_traverse_goal(Params, Else, ElseId, !FormatCallSites,
!Counter, !ConjMaps, !PredMap, !RelevantVars),
map.det_insert(ElseId, CurId, !PredMap),
alloc_id(CondThenId, !Counter),
goal_to_conj_list(Then, ThenConj),
goal_to_conj_list(Cond, CondConj),
format_call_traverse_conj(Params, CondConj ++ ThenConj, CondThenId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap, !RelevantVars),
map.det_insert(CondThenId, CurId, !PredMap)
;
GoalExpr = negation(SubGoal),
format_call_traverse_goal(Params, SubGoal, SubGoalId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap, !RelevantVars),
map.det_insert(SubGoalId, CurId, !PredMap)
;
GoalExpr = scope(Reason, SubGoal),
(
Reason = from_ground_term(TermVar, FromGroundTermKind),
( if
FromGroundTermKind = from_ground_term_construct,
% These scopes cannot build the format string (since that is
% either a single constant, or the result of an operation on
% strings, neither of which are things for which we build fgt
% scopes). However, it can build the term to print. That will
% happen only in degenerate cases, but we do have some
% degenerate cases in the test suite.
not set_of_var.member(!.RelevantVars, TermVar)
then
% It is ok not to traverse the subgoal. The scope cannot
% contain any calls, and the unifications it does contain
% are apparently not of interest to any later format call.
true
else
format_call_traverse_conj(Params, [SubGoal], CurId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap,
!RelevantVars)
)
;
Reason = disable_warnings(HeadWarning, TailWarnings),
Warnings = [HeadWarning | TailWarnings],
( if list.member(goal_warning_unknown_format_calls, Warnings) then
NewParams = Params ^ fctp_warn_unknown_format :=
do_not_warn_unknown_format,
format_call_traverse_conj(NewParams, [SubGoal], CurId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap,
!RelevantVars)
else
format_call_traverse_conj(Params, [SubGoal], CurId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap,
!RelevantVars)
)
;
( Reason = exist_quant(_, _)
; Reason = promise_solutions(_, _)
; Reason = promise_purity(_)
; Reason = require_detism(_)
; Reason = require_complete_switch(_)
; Reason = require_switch_arms_detism(_, _)
; Reason = commit(_)
; Reason = barrier(_)
; Reason = trace_goal(_, _, _, _, _)
; Reason = loop_control(_, _, _)
),
format_call_traverse_conj(Params, [SubGoal], CurId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap, !RelevantVars)
)
;
GoalExpr = generic_call(_, _, _, _, _)
;
GoalExpr = call_foreign_proc(_, _, _, _, _, _, _)
;
GoalExpr = plain_call(PredId, _ProcId, ArgVars, _, _, _),
Params = format_call_traverse_params(ModuleInfo, _, WarnUnknownFormat),
module_info_pred_info(ModuleInfo, PredId, PredInfo),
ModuleName = pred_info_module(PredInfo),
Name = pred_info_name(PredInfo),
( if
is_format_call_kind_and_vars(PredInfo, ModuleName, Name, ArgVars,
GoalInfo, Kind)
then
GoalId = goal_info_get_goal_id(GoalInfo),
Context = goal_info_get_context(GoalInfo),
FormatCallSite = format_call_site(GoalId, GoalInfo, Kind, PredId,
Context, CurId, WarnUnknownFormat),
!:FormatCallSites = [FormatCallSite | !.FormatCallSites],
set_of_var.union(get_relevant_vars_from_format_call_kind(Kind),
!RelevantVars)
else if
ModuleName = mercury_string_module
then
( if
( Name = "append"
; Name = "++"
),
ArgVars = [ArgVarA, ArgVarB, ResultVar],
set_of_var.member(!.RelevantVars, ResultVar)
then
set_of_var.delete(ResultVar, !RelevantVars),
set_of_var.insert(ArgVarA, !RelevantVars),
set_of_var.insert(ArgVarB, !RelevantVars),
GoalId = goal_info_get_goal_id(GoalInfo),
StringState = string_append(GoalId, ArgVarA, ArgVarB),
add_to_string_map(Params, CurId, ResultVar, StringState,
!ConjMaps)
else if
Name = "append_list",
ArgVars = [ListSkeletonVar, ResultVar],
set_of_var.member(!.RelevantVars, ResultVar)
then
set_of_var.delete(ResultVar, !RelevantVars),
set_of_var.insert(ListSkeletonVar, !RelevantVars),
GoalId = goal_info_get_goal_id(GoalInfo),
StringState = string_append_list(GoalId, ListSkeletonVar),
add_to_string_map(Params, CurId, ResultVar, StringState,
!ConjMaps)
else
true
)
else
true
)
;
GoalExpr = unify(_, RHS, _, Unification, _),
format_call_traverse_unify(Params, Unification, GoalInfo,
CurId, !ConjMaps, !RelevantVars),
(
RHS = rhs_lambda_goal(_Purity, _HOGroundness, _PredFunc,
_LambdaNonLocals, _LambdaArgVarsModes,
_LambdaDetism, LambdaGoal),
format_call_traverse_goal(Params, LambdaGoal, LambdaGoalId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap,
!RelevantVars),
map.det_insert(LambdaGoalId, CurId, !PredMap)
;
( RHS = rhs_var(_)
; RHS = rhs_functor(_, _, _)
)
)
;
GoalExpr = shorthand(ShortHand),
(
ShortHand = atomic_goal(_, _, _, _, MainGoal, OrElseGoals, _),
format_call_traverse_disj(Params, [MainGoal | OrElseGoals],
CurId, !FormatCallSites, !Counter, !ConjMaps, !PredMap,
!RelevantVars)
;
ShortHand = try_goal(_, _, SubGoal),
format_call_traverse_goal(Params, SubGoal, SubGoalId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap,
!RelevantVars),
map.det_insert(SubGoalId, CurId, !PredMap)
;
ShortHand = bi_implication(_, _),
% These should have been expanded by now.
unexpected($pred, "bi_implication")
)
).
:- pred format_call_traverse_unify(format_call_traverse_params::in,
unification::in, hlds_goal_info::in, conj_id::in,
conj_maps::in, conj_maps::out,
set_of_progvar::in, set_of_progvar::out) is det.
format_call_traverse_unify(Params, Unification, GoalInfo, CurId,
!ConjMaps, !RelevantVars) :-
(
Unification = assign(TargetVar, SourceVar),
( if set_of_var.member(!.RelevantVars, TargetVar) then
set_of_var.delete(TargetVar, !RelevantVars),
set_of_var.insert(SourceVar, !RelevantVars),
add_to_fc_eqv_map(CurId, TargetVar, SourceVar, !ConjMaps)
else
true
)
;
Unification = construct(CellVar, ConsId, ArgVars, _, _, _, _),
( if set_of_var.member(!.RelevantVars, CellVar) then
( if
ConsId = string_const(StringConst)
then
expect(unify(ArgVars, []), $pred, "string constant with args"),
set_of_var.delete(CellVar, !RelevantVars),
add_to_string_map(Params, CurId,
CellVar, string_const(StringConst), !ConjMaps)
else if
ConsId = du_data_ctor(du_ctor(SymName, Arity, TypeCtor)),
TypeCtor = list_type_ctor
then
Functor = unqualify_name(SymName),
( if
(
Functor = "[|]",
Arity = 2,
ArgVars = [ArgVar1, ArgVar2],
ListPrime = list_skeleton_cons(ArgVar1, ArgVar2)
;
Functor = "[]",
Arity = 0,
ArgVars = [],
ListPrime = list_skeleton_nil
)
then
List = ListPrime
else
unexpected($pred, "unexpected list functor")
),
set_of_var.delete(CellVar, !RelevantVars),
set_of_var.insert_list(ArgVars, !RelevantVars),
add_to_list_map(Params, CurId, CellVar, List, !ConjMaps)
else if
ConsId = du_data_ctor(du_ctor(SymName, Arity, TypeCtor)),
TypeCtor = poly_type_type_ctor
then
( if
Arity = 1,
ArgVars = [ArgVar]
then
Context = goal_info_get_context(GoalInfo),
Functor = unqualify_name(SymName),
( if
(
Functor = "f",
VarPolyTypePrime = apt_f(ArgVar, Context)
;
Functor = "i",
VarPolyTypePrime = apt_i(ArgVar, Context)
;
Functor = "i8",
VarPolyTypePrime = apt_i8(ArgVar, Context)
;
Functor = "i16",
VarPolyTypePrime = apt_i16(ArgVar, Context)
;
Functor = "i32",
VarPolyTypePrime = apt_i32(ArgVar, Context)
;
Functor = "i64",
VarPolyTypePrime = apt_i64(ArgVar, Context)
;
Functor = "u",
VarPolyTypePrime = apt_u(ArgVar, Context)
;
Functor = "u8",
VarPolyTypePrime = apt_u8(ArgVar, Context)
;
Functor = "u16",
VarPolyTypePrime = apt_u16(ArgVar, Context)
;
Functor = "u32",
VarPolyTypePrime = apt_u32(ArgVar, Context)
;
Functor = "u64",
VarPolyTypePrime = apt_u64(ArgVar, Context)
;
Functor = "s",
VarPolyTypePrime = apt_s(ArgVar, Context)
;
Functor = "c",
VarPolyTypePrime = apt_c(ArgVar, Context)
)
then
VarPolyType = VarPolyTypePrime
else
unexpected($pred, "unexpected poly_type functor")
)
else
unexpected($pred, "poly_type arity mismatch")
),
set_of_var.delete(CellVar, !RelevantVars),
add_to_element_map(Params, CurId, CellVar, VarPolyType,
!ConjMaps)
else
true
)
else
true
)
;
( Unification = deconstruct(_, _, _, _, _, _)
; Unification = simple_test(_, _)
; Unification = complicated_unify(_, _, _)
)
).
:- func project_case_goal(case) = hlds_goal.
project_case_goal(case(_, _, Goal)) = Goal.
:- pred format_call_traverse_disj(format_call_traverse_params::in,
list(hlds_goal)::in, conj_id::in,
list(format_call_site)::in, list(format_call_site)::out,
counter::in, counter::out, conj_maps::in, conj_maps::out,
conj_pred_map::in, conj_pred_map::out,
set_of_progvar::in, set_of_progvar::out) is det.
format_call_traverse_disj(Params, Disjuncts, CurId, !FormatCallSites,
!Counter, !ConjMaps, !PredMap, !RelevantVars) :-
format_call_traverse_disj_arms(Params, Disjuncts, CurId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap, DisjRelevantVarSets),
DisjRelevantVars = set_of_var.union_list(DisjRelevantVarSets),
set_of_var.union(DisjRelevantVars, !RelevantVars).
:- pred format_call_traverse_disj_arms(format_call_traverse_params::in,
list(hlds_goal)::in, conj_id::in,
list(format_call_site)::in, list(format_call_site)::out,
counter::in, counter::out, conj_maps::in, conj_maps::out,
conj_pred_map::in, conj_pred_map::out, list(set_of_progvar)::out) is det.
format_call_traverse_disj_arms(_, [], _,
!FormatCallSites, !Counter, !ConjMaps, !PredMap, []).
format_call_traverse_disj_arms(Params, [Goal | Goals], ContainingId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap, GoalRelevantVars) :-
format_call_traverse_goal(Params, Goal, DisjId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap,
set_of_var.init, HeadRelevantVars),
map.det_insert(DisjId, ContainingId, !PredMap),
format_call_traverse_disj_arms(Params, Goals, ContainingId,
!FormatCallSites, !Counter, !ConjMaps, !PredMap, TailRelevantVars),
GoalRelevantVars = [HeadRelevantVars | TailRelevantVars].
%---------------------------------------------------------------------------%
:- pred alloc_id(conj_id::out, counter::in, counter::out) is det.
alloc_id(ConjId, !Counter) :-
counter.allocate(N, !Counter),
ConjId = conj_id(N).
:- func get_conj_map(conj_maps, conj_id) = conj_map.
get_conj_map(ConjMaps, ConjId) = ConjMap :-
( if map.search(ConjMaps, ConjId, ConjMapPrime) then
ConjMap = ConjMapPrime
else
ConjMap = conj_map(map.init, map.init, map.init, map.init)
).
:- pred add_to_string_map(format_call_traverse_params::in, conj_id::in,
prog_var::in, string_state::in, conj_maps::in, conj_maps::out) is det.
add_to_string_map(Params, ConjId, Var, StringState, !ConjMaps) :-
trace [io(!IO), compiletime(flag("debug_format_call"))] (
ProgressStream = Params ^ fctp_progress_stream,
VarStr = string.string(Var),
StateStr = string.string(StringState),
io.format(ProgressStream, "adding to string map: %s -> %s\n",
[s(VarStr), s(StateStr)], !IO)
),
( if map.search(!.ConjMaps, ConjId, ConjMap0) then
ConjMap0 = conj_map(StringMap0, ListMap, ElementMap, EqvMap),
map.det_insert(Var, StringState, StringMap0, StringMap),
ConjMap = conj_map(StringMap, ListMap, ElementMap, EqvMap),
map.det_update(ConjId, ConjMap, !ConjMaps)
else
StringMap = map.singleton(Var, StringState),
ConjMap = conj_map(StringMap, map.init, map.init, map.init),
map.det_insert(ConjId, ConjMap, !ConjMaps)
).
:- pred add_to_list_map(format_call_traverse_params::in, conj_id::in,
prog_var::in, list_skeleton_state::in,
conj_maps::in, conj_maps::out) is det.
add_to_list_map(Params, ConjId, Var, ListState, !ConjMaps) :-
trace [io(!IO), compiletime(flag("debug_format_call"))] (
ProgressStream = Params ^ fctp_progress_stream,
VarStr = string.string(Var),
ListStateStr = string.string(ListState),
io.format(ProgressStream, "adding to list map: %s -> %s\n",
[s(VarStr), s(ListStateStr)], !IO)
),
( if map.search(!.ConjMaps, ConjId, ConjMap0) then
ConjMap0 = conj_map(StringMap, ListMap0, ElementMap, EqvMap),
map.det_insert(Var, ListState, ListMap0, ListMap),
ConjMap = conj_map(StringMap, ListMap, ElementMap, EqvMap),
map.det_update(ConjId, ConjMap, !ConjMaps)
else
ListMap = map.singleton(Var, ListState),
ConjMap = conj_map(map.init, ListMap, map.init, map.init),
map.det_insert(ConjId, ConjMap, !ConjMaps)
).
:- pred add_to_element_map(format_call_traverse_params::in, conj_id::in,
prog_var::in, abstract_poly_type::in,
conj_maps::in, conj_maps::out) is det.
add_to_element_map(Params, ConjId, Var, Element, !ConjMaps) :-
trace [io(!IO), compiletime(flag("debug_format_call"))] (
ProgressStream = Params ^ fctp_progress_stream,
VarStr = string.string(Var),
ElementStr = string.string(Element),
io.format(ProgressStream, "adding to element map: %s -> %s\n",
[s(VarStr), s(ElementStr)], !IO)
),
( if map.search(!.ConjMaps, ConjId, ConjMap0) then
ConjMap0 = conj_map(StringMap, ListMap, ElementMap0, EqvMap),
map.det_insert(Var, Element, ElementMap0, ElementMap),
ConjMap = conj_map(StringMap, ListMap, ElementMap, EqvMap),
map.det_update(ConjId, ConjMap, !ConjMaps)
else
ElementMap = map.singleton(Var, Element),
ConjMap = conj_map(map.init, map.init, ElementMap, map.init),
map.det_insert(ConjId, ConjMap, !ConjMaps)
).
:- pred add_to_fc_eqv_map(conj_id::in, prog_var::in, prog_var::in,
conj_maps::in, conj_maps::out) is det.
add_to_fc_eqv_map(ConjId, Var, EqvVar, !ConjMaps) :-
( if map.search(!.ConjMaps, ConjId, ConjMap0) then
ConjMap0 = conj_map(StringMap, ListMap, ElementMap, EqvMap0),
map.det_insert(Var, EqvVar, EqvMap0, EqvMap),
ConjMap = conj_map(StringMap, ListMap, ElementMap, EqvMap),
map.det_update(ConjId, ConjMap, !ConjMaps)
else
EqvMap = map.singleton(Var, EqvVar),
ConjMap = conj_map(map.init, map.init, map.init, EqvMap),
map.det_insert(ConjId, ConjMap, !ConjMaps)
).
%---------------------------------------------------------------------------%
:- type fc_opt_goal_info
---> fc_opt_goal_info(
% The goal identified by the key that lead us here
% should be replaced by this replacement goal.
fcogi_replacement_goal :: hlds_goal,
fcogi_unneeded_vars :: list(prog_var),
fcogi_unneeded_goals :: list(goal_id)
).
:- type fc_goal_id_map == map(goal_id, fc_opt_goal_info).
% Traverse the goal, looking for call sites in !.GoalIdMap. If we
% find them, we replace them with the corresponding goal.
%
:- pred opt_format_call_sites_in_goal(hlds_goal::in, hlds_goal::out,
fc_goal_id_map::in, fc_goal_id_map::out,
set_of_progvar::in, set_of_progvar::out,
set_of_progvar::in, set_of_progvar::out,
set_tree234(goal_id)::in, set_tree234(goal_id)::out) is det.
opt_format_call_sites_in_goal(Goal0, Goal, !GoalIdMap,
!NeededVars, !ToDeleteVars, !ToDeleteGoals) :-
Goal0 = hlds_goal(GoalExpr0, GoalInfo),
(
GoalExpr0 = plain_call(_, _, _, _, _, _),
GoalId = goal_info_get_goal_id(GoalInfo),
( if map.remove(GoalId, OptGoalInfo, !GoalIdMap) then
OptGoalInfo = fc_opt_goal_info(ReplacementGoal,
GoalToDeleteVars, GoalToDeleteGoals),
Goal = ReplacementGoal,
set_of_var.insert_list(GoalToDeleteVars, !ToDeleteVars),
set_tree234.insert_list(GoalToDeleteGoals, !ToDeleteGoals)
else
NonLocals = goal_info_get_nonlocals(GoalInfo),
( if
set_tree234.remove(GoalId, !.ToDeleteGoals, NewToDeleteGoals),
set_of_var.intersect(NonLocals, !.NeededVars, NeededNonLocals),
set_of_var.is_empty(NeededNonLocals)
then
!:ToDeleteGoals = NewToDeleteGoals,
Goal = true_goal
else
Goal = Goal0,
% Assume that all nonlocals are needed.
set_of_var.union(NonLocals, !NeededVars),
set_of_var.difference(!.ToDeleteVars, NonLocals,
!:ToDeleteVars)
)
)
;
( GoalExpr0 = generic_call(_, _, _, _, _)
; GoalExpr0 = call_foreign_proc(_, _, _, _, _, _, _)
),
Goal = Goal0,
NonLocals = goal_info_get_nonlocals(GoalInfo),
% Assume that all nonlocals are needed.
set_of_var.union(!.NeededVars, NonLocals, !:NeededVars),
set_of_var.difference(!.ToDeleteVars, NonLocals, !:ToDeleteVars)
;
GoalExpr0 = unify(_LHS, _RHS, _UnifyModes, Unification, _UnifyContext),
( if
Unification = construct(LHSVar, _ConsId, _RHSVars, _ArgModes,
_How, _Unique, _SubInfo),
not set_of_var.member(!.NeededVars, LHSVar),
% If this succeeds, then the backward traversal cannot encounter
% any more producers of LHSVar.
set_of_var.remove(LHSVar, !ToDeleteVars)
then
% This effectively deletes the unification.
Goal = true_goal
else
% If _RHS = rhs_lambda_goal, we should optimize any occurrences
% of format calls inside the lambda goal. Unfortunately,
% some of the fields of rhs_lambda_goal, specifically the lambda
% nonlocals, the lambda quantified variables and the lambda modes,
% can be affected by that optimization, and it is not at all clear
% how those fields should be updated. Our normal course of action,
% calling requantify and rebuilding instmap deltas, does not work,
% because quantification.m generates a compiler abort.
Goal = Goal0,
NonLocals = goal_info_get_nonlocals(GoalInfo),
% Assume that all nonlocals are needed.
set_of_var.union(!.NeededVars, NonLocals, !:NeededVars),
set_of_var.difference(!.ToDeleteVars, NonLocals, !:ToDeleteVars)
)
;
% XXX Check that this works for parallel conjunctions.
GoalExpr0 = conj(ConjType, Conjuncts0),
opt_format_call_sites_in_conj(Conjuncts0, Conjuncts,
!GoalIdMap, !NeededVars, !ToDeleteVars, !ToDeleteGoals),
GoalExpr = conj(ConjType, Conjuncts),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
GoalExpr0 = disj(Disjuncts0),
opt_format_call_sites_in_disj(Disjuncts0, Disjuncts, !GoalIdMap,
!.NeededVars, [], NeededVarsSets,
!.ToDeleteVars, [], ToDeleteVarsSets,
!.ToDeleteGoals, [], ToDeleteGoalsSets),
!:NeededVars = set_of_var.union_list(NeededVarsSets),
!:ToDeleteVars = set_of_var.intersect_list(ToDeleteVarsSets),
!:ToDeleteGoals = set_tree234.union_list(ToDeleteGoalsSets),
GoalExpr = disj(Disjuncts),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
GoalExpr0 = switch(SwitchVar, CanFail, Cases0),
opt_format_call_sites_in_switch(Cases0, Cases, !GoalIdMap,
!.NeededVars, [], NeededVarsSets,
!.ToDeleteVars, [], ToDeleteVarsSets,
!.ToDeleteGoals, [], ToDeleteGoalsSets),
!:NeededVars = set_of_var.union_list(NeededVarsSets),
!:ToDeleteVars = set_of_var.intersect_list(ToDeleteVarsSets),
!:ToDeleteGoals = set_tree234.union_list(ToDeleteGoalsSets),
GoalExpr = switch(SwitchVar, CanFail, Cases),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
GoalExpr0 = if_then_else(Vars, Cond0, Then0, Else0),
opt_format_call_sites_in_goal(Else0, Else, !GoalIdMap,
!.NeededVars, NeededVarsBeforeElse,
!.ToDeleteVars, ToDeleteVarsBeforeElse,
!.ToDeleteGoals, ToDeleteGoalsBeforeElse),
opt_format_call_sites_in_goal(Then0, Then, !GoalIdMap,
!.NeededVars, NeededVarsBeforeThen,
!.ToDeleteVars, ToDeleteVarsBeforeThen,
!.ToDeleteGoals, ToDeleteGoalsBeforeThen),
opt_format_call_sites_in_goal(Cond0, Cond, !GoalIdMap,
NeededVarsBeforeThen, NeededVarsBeforeCond,
ToDeleteVarsBeforeThen, ToDeleteVarsBeforeCond,
ToDeleteGoalsBeforeThen, ToDeleteGoalsBeforeCond),
set_of_var.union(NeededVarsBeforeCond, NeededVarsBeforeElse,
!:NeededVars),
set_of_var.intersect(ToDeleteVarsBeforeCond, ToDeleteVarsBeforeElse,
!:ToDeleteVars),
set_tree234.union(ToDeleteGoalsBeforeCond, ToDeleteGoalsBeforeElse,
!:ToDeleteGoals),
GoalExpr = if_then_else(Vars, Cond, Then, Else),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
GoalExpr0 = negation(SubGoal0),
% SubGoal0 cannot generate anything in !.ToDeleteVars, but it can add
% to all of !:NeededVars, !:ToDeleteVars and !:ToDeleteGoals.
opt_format_call_sites_in_goal(SubGoal0, SubGoal,
!GoalIdMap, !NeededVars, !ToDeleteVars, !ToDeleteGoals),
GoalExpr = negation(SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo)
;
GoalExpr0 = scope(Reason, SubGoal0),
( if
Reason = from_ground_term(TermVar, from_ground_term_construct),
not set_of_var.member(!.NeededVars, TermVar),
% If this succeeds, then the backward traversal cannot encounter
% any more producers of LHSVar.
set_of_var.remove(TermVar, !ToDeleteVars)
then
% We cannot guarantee that the modified version of SubGoal0
% meets the invariants required of a goal in a
% from_ground_term_construct scope, so we remove the scope.
opt_format_call_sites_in_goal(SubGoal0, Goal,
!GoalIdMap, !NeededVars, !ToDeleteVars, !ToDeleteGoals)
else
opt_format_call_sites_in_goal(SubGoal0, SubGoal,
!GoalIdMap, !NeededVars, !ToDeleteVars, !ToDeleteGoals),
GoalExpr = scope(Reason, SubGoal),
Goal = hlds_goal(GoalExpr, GoalInfo)
)
;
GoalExpr0 = shorthand(ShortHand0),
(
ShortHand0 = atomic_goal(AtomicType, OuterVars, InnerVars,
OutputVars, MainGoal0, OrElseGoals0, OrElseInners),
opt_format_call_sites_in_goal(MainGoal0, MainGoal,
!GoalIdMap, !.NeededVars, NeededVarsMain,
!.ToDeleteVars, ToDeleteVarsMain,
!.ToDeleteGoals, ToDeleteGoalsMain),
opt_format_call_sites_in_disj(OrElseGoals0, OrElseGoals,
!GoalIdMap, !.NeededVars, [], NeededVarsSets,
!.ToDeleteVars, [], ToDeleteVarsSets,
!.ToDeleteGoals, [], ToDeleteGoalsSets),
!:NeededVars =
set_of_var.union_list([NeededVarsMain | NeededVarsSets]),
!:ToDeleteVars =
set_of_var.intersect_list(
[ToDeleteVarsMain | ToDeleteVarsSets]),
!:ToDeleteGoals =
set_tree234.union_list(
[ToDeleteGoalsMain | ToDeleteGoalsSets]),
ShortHand = atomic_goal(AtomicType, OuterVars, InnerVars,
OutputVars, MainGoal, OrElseGoals, OrElseInners),
GoalExpr = shorthand(ShortHand)
;
ShortHand0 = try_goal(MaybeIO, ResultVar, SubGoal0),
opt_format_call_sites_in_goal(SubGoal0, SubGoal,
!GoalIdMap, !NeededVars, !ToDeleteVars, !ToDeleteGoals),
ShortHand = try_goal(MaybeIO, ResultVar, SubGoal),
GoalExpr = shorthand(ShortHand)
;
ShortHand0 = bi_implication(_, _),
% These should have been expanded by now.
unexpected($pred, "bi_implication")
),
Goal = hlds_goal(GoalExpr, GoalInfo)
).
:- pred opt_format_call_sites_in_conj(
list(hlds_goal)::in, list(hlds_goal)::out,
fc_goal_id_map::in, fc_goal_id_map::out,
set_of_progvar::in, set_of_progvar::out,
set_of_progvar::in, set_of_progvar::out,
set_tree234(goal_id)::in, set_tree234(goal_id)::out) is det.
opt_format_call_sites_in_conj([], [], !GoalIdMap,
!NeededVars, !ToDeleteVars, !ToDeleteGoals).
opt_format_call_sites_in_conj([HeadGoal0 | TailGoals0], Goals, !GoalIdMap,
!NeededVars, !ToDeleteVars, !ToDeleteGoals) :-
% We traverse conjunctions backwards.
opt_format_call_sites_in_conj(TailGoals0, TailGoals, !GoalIdMap,
!NeededVars, !ToDeleteVars, !ToDeleteGoals),
opt_format_call_sites_in_goal(HeadGoal0, HeadGoal, !GoalIdMap,
!NeededVars, !ToDeleteVars, !ToDeleteGoals),
HeadGoal = hlds_goal(HeadGoalExpr, _),
( if HeadGoalExpr = conj(plain_conj, HeadSubGoals) then
% Flatten out nested conjunctions. This will improve the HLDS
% - when HeadSubGoals is an empty list, i.e. when we simply
% deleted HeadGoal0, and
% - when HeadSubGoals is a non-empty list, i.e. when we
% replaced HeadGoal0 with its optimized version.
Goals = HeadSubGoals ++ TailGoals
else
Goals = [HeadGoal | TailGoals]
).
:- pred opt_format_call_sites_in_disj(
list(hlds_goal)::in, list(hlds_goal)::out,
fc_goal_id_map::in, fc_goal_id_map::out,
set_of_progvar::in, list(set_of_progvar)::in, list(set_of_progvar)::out,
set_of_progvar::in, list(set_of_progvar)::in, list(set_of_progvar)::out,
set_tree234(goal_id)::in,
list(set_tree234(goal_id))::in, list(set_tree234(goal_id))::out) is det.
opt_format_call_sites_in_disj([], [], !GoalIdMap,
_, !NeededVarsSets, _, !ToDeleteVarsSets, _, !ToDeleteGoalSets).
opt_format_call_sites_in_disj([Goal0 | Goals0], [Goal | Goals], !GoalIdMap,
NeededVars0, !NeededVarsSets, ToDeleteVars0, !ToDeleteVarsSets,
ToDeleteGoals0, !ToDeleteGoalSets) :-
% The order of traversal does not matter for disjunctions, since the
% disjuncts are independent. This order is more efficient.
opt_format_call_sites_in_goal(Goal0, Goal, !GoalIdMap,
NeededVars0, NeededVars, ToDeleteVars0, ToDeleteVars,
ToDeleteGoals0, ToDeleteGoals),
!:NeededVarsSets = [NeededVars | !.NeededVarsSets],
!:ToDeleteVarsSets = [ToDeleteVars | !.ToDeleteVarsSets],
!:ToDeleteGoalSets = [ToDeleteGoals | !.ToDeleteGoalSets],
opt_format_call_sites_in_disj(Goals0, Goals, !GoalIdMap,
NeededVars0, !NeededVarsSets, ToDeleteVars0, !ToDeleteVarsSets,
ToDeleteGoals0, !ToDeleteGoalSets).
:- pred opt_format_call_sites_in_switch(list(case)::in, list(case)::out,
fc_goal_id_map::in, fc_goal_id_map::out,
set_of_progvar::in, list(set_of_progvar)::in, list(set_of_progvar)::out,
set_of_progvar::in, list(set_of_progvar)::in, list(set_of_progvar)::out,
set_tree234(goal_id)::in,
list(set_tree234(goal_id))::in, list(set_tree234(goal_id))::out) is det.
opt_format_call_sites_in_switch([], [], !GoalIdMap,
_, !NeededVarsSets, _, !ToDeleteVarsSets, _, !ToDeleteGoalSets).
opt_format_call_sites_in_switch([Case0 | Cases0], [Case | Cases], !GoalIdMap,
NeededVars0, !NeededVarsSets, ToDeleteVars0, !ToDeleteVarsSets,
ToDeleteGoals0, !ToDeleteGoalSets) :-
% The order of traversal does not matter for switches, since the
% switch arms are independent. This order is more efficient.
Case0 = case(FirstConsId, LaterConsIds, Goal0),
opt_format_call_sites_in_goal(Goal0, Goal, !GoalIdMap,
NeededVars0, NeededVars, ToDeleteVars0, ToDeleteVars,
ToDeleteGoals0, ToDeleteGoals),
!:NeededVarsSets = [NeededVars | !.NeededVarsSets],
!:ToDeleteVarsSets = [ToDeleteVars | !.ToDeleteVarsSets],
!:ToDeleteGoalSets = [ToDeleteGoals | !.ToDeleteGoalSets],
Case = case(FirstConsId, LaterConsIds, Goal),
opt_format_call_sites_in_switch(Cases0, Cases, !GoalIdMap,
NeededVars0, !NeededVarsSets, ToDeleteVars0, !ToDeleteVarsSets,
ToDeleteGoals0, !ToDeleteGoalSets).
%---------------------------------------------------------------------------%
:- pred create_replacement_goal(module_info::in, goal_id::in,
format_call_kind::in(format_call_kind_opt), list(compiler_format_spec)::in,
list(prog_var)::in, list(goal_id)::in,
fc_goal_id_map::in, fc_goal_id_map::out,
var_table::in, var_table::out) is det.
create_replacement_goal(ModuleInfo, GoalId, CallKind, Specs,
ToDeleteVars, ToDeleteGoals, !GoalIdMap, !VarTable) :-
% Note that every predicate or function that this code generates calls to
% must be listed in simplify_may_introduce_calls, in order to prevent
% its definition from being thrown away by dead_pred_elim before execution
% gets here.
(
CallKind = kind_string_format(Context, _FmtStrValVars, ResultVar),
create_string_format_replacement(ModuleInfo, Specs, Context,
ResultVar, ReplacementGoal, !VarTable)
;
(
CallKind = kind_string_builder(Context, _FmtStrValVars,
StateInVar, StateOutVar),
StateUpdate = string_builder_state
;
CallKind = kind_io_format_nostream(Context, _FmtStrValVars,
StateInVar, StateOutVar),
StateUpdate = io_state_no_stream
;
CallKind = kind_io_format_stream(Context, StreamVar,
_FmtStrValVars, StateInVar, StateOutVar),
StateUpdate = io_state_stream(StreamVar)
),
create_state_update_replacement(ModuleInfo, Specs, Context,
StateUpdate, StateInVar, StateOutVar, ReplacementGoal, !VarTable)
;
CallKind = kind_stream_string_writer(Context,
TypeClassInfoVarForStream, StreamVar, _FmtStrValVars,
StateInVar, StateOutVar),
create_stream_string_writer_format_replacement(ModuleInfo, Specs,
Context, TypeClassInfoVarForStream, StreamVar,
StateInVar, StateOutVar, ReplacementGoal, !VarTable)
),
FCOptGoalInfo = fc_opt_goal_info(ReplacementGoal,
list.sort(ToDeleteVars), list.sort(ToDeleteGoals)),
map.det_insert(GoalId, FCOptGoalInfo, !GoalIdMap).
%---------------------------------------------------------------------------%
% For optimizing e.g. string.format("%3d_%.5x", [i(X), i(Y)], Result),
% generate code that looks like this:
%
% format_cast_int_to_uint(Y, YUInt),
% ... set up Flags1 ...
% Prec2 = 5,
% Base8 = base_hex_lc,
% format_uint_component_nowidth_prec(Flags1, Prec2, Base8, YUint, Str3),
% Str4 = "_",
% Str5 = Str4 ++ Str3,
% ... set up Flags5 ...
% Width7 = 3,
% format_signed_int_component_width_noprec(Flags5, Width7, X, Str9),
% Result = Str9 ++ Str5
%
% We build the string back to front to minimize the amount of
% re-re-recopying that the calls to append (++) have to do.
% Since we execute the appends back-to-front, we create their
% arguments back-to-front as well. This way, each component's
% variable is used immediately after it is constructed, so
% it shouldn't need to be stored on the stack.
%
:- pred create_string_format_replacement(module_info::in,
list(compiler_format_spec)::in, prog_context::in, prog_var::in,
hlds_goal::out, var_table::in, var_table::out) is det.
create_string_format_replacement(ModuleInfo, Specs, Context, ResultVar,
ReplacementGoal, !VarTable) :-
replace_string_format(ModuleInfo, Specs, Context, yes(ResultVar),
ActualResultVar, Goals, ValueVars, !VarTable),
( if ActualResultVar = ResultVar then
AllGoals = Goals
else
% Since replace_string_format can always put the result
% in the desired variable, this code point is never actually reached.
% This code is here just in case that ever changes.
make_simple_assign(ResultVar, ActualResultVar,
umc_implicit("replace_string_format"), [], AssignGoal),
AllGoals = Goals ++ [AssignGoal]
),
set_of_var.insert(ResultVar, ValueVars, NonLocals),
InstMapDelta = instmap_delta_bind_var(ResultVar),
goal_info_init(NonLocals, InstMapDelta, detism_det, purity_pure,
Context, GoalInfo),
conj_list_to_goal(AllGoals, GoalInfo, ReplacementGoal).
:- pred replace_string_format(module_info::in, list(compiler_format_spec)::in,
prog_context::in, maybe(prog_var)::in, prog_var::out, list(hlds_goal)::out,
set_of_progvar::out, var_table::in, var_table::out) is det.
replace_string_format(ModuleInfo, Specs, Context, MaybeResultVar, ResultVar,
Goals, !:ValueVars, !VarTable) :-
set_of_var.init(!:ValueVars),
(
Specs = [],
make_result_var_if_needed(MaybeResultVar, ResultVar, !VarTable),
make_string_const_construction(Context, ResultVar, "", Goal),
Goals = [Goal]
;
Specs = [HeadSpec | TailSpecs],
replace_string_format_nonempty(ModuleInfo,
HeadSpec, TailSpecs, Context, MaybeResultVar, ResultVar, Goals,
!ValueVars, !VarTable)
).
:- pred replace_string_format_nonempty(module_info::in,
compiler_format_spec::in, list(compiler_format_spec)::in,
prog_context::in, maybe(prog_var)::in, prog_var::out, list(hlds_goal)::out,
set_of_progvar::in, set_of_progvar::out,
var_table::in, var_table::out) is det.
replace_string_format_nonempty(ModuleInfo, HeadSpec, TailSpecs,
Context, MaybeResultVar, ResultVar, Goals, !ValueVars, !VarTable) :-
(
TailSpecs = [],
represent_spec(ModuleInfo, HeadSpec, MaybeResultVar,
ResultVar, Goals, _HeadSpecContext, !ValueVars, !VarTable)
;
TailSpecs = [FirstTailSpec | LaterTailSpecs],
replace_string_format_nonempty(ModuleInfo,
FirstTailSpec, LaterTailSpecs, Context,
no, TailSpecsVar, TailSpecsGoals, !ValueVars, !VarTable),
represent_spec(ModuleInfo, HeadSpec, no, HeadSpecVar, HeadSpecGoals,
_HeadSpecContext, !ValueVars, !VarTable),
make_result_var_if_needed(MaybeResultVar, ResultVar, !VarTable),
generate_plain_call(ModuleInfo, pf_function,
mercury_string_module, "++",
[], [HeadSpecVar, TailSpecsVar, ResultVar],
instmap_delta_from_assoc_list(
[ResultVar - ground(unique, none_or_default_func)]),
only_mode, detism_det, purity_pure, [], Context, AppendGoal),
Goals = TailSpecsGoals ++ HeadSpecGoals ++ [AppendGoal]
).
%---------------------------------------------------------------------------%
:- type state_format
---> io_state_stream(prog_var)
; io_state_no_stream
; string_builder_state.
% For optimizing e.g. io.format(Stream, "%3d_%.5x", [i(X), i(Y)], IO0, IO),
% generate code that looks like this:
%
% ... set up Flags1 ...
% Width2 = 3,
% format_signed_int_component_width_noprec(Flags1, Width2, X, Str4),
% io.write_string(Stream, Str4, IO0, IO5),
% Str5 = "_",
% io.write_string(Stream, Str5, IO5, IO6),
% format_cast_int_to_uint(Y, YUint),
% ... set up Flags7 ...
% Prec8 = 5,
% Base3 = base_hex_lc,
% format_uint_component_nowidth_prec(Flags7, Prec2, Base3, YUInt, Str9),
% io.write_string(Stream, Str9, IO5, IO),
%
% We convert the components in the original order, and print each string
% resulting from converting a component as soon as it is ready.
% These strings should therefore never need to be stored in stack slots.
%
% If the original call was to io.format/4 instead of io.format/5,
% i.e. if the stream to be printed on was implicit, then the calls
% to io.write_string that we generate will also have the stream to be
% printed on implicit. The runtime system will retrieve the current
% output stream in each of those calls to io.write_string/3. Factoring out
% this hidden repetition could be worthwhile, but if it is, then
% it should also be worth doing for code explicitly written by the user,
% so this is not the place to worry about it; instead, it could be done
% by a later optimization pass.
%
% Passing streams explicitly makes the code more robust against changes
% anyway, which is another reason why the --warn-implicit-stream-calls
% option encourages programmers to do that.
%
:- pred create_state_update_replacement(module_info::in,
list(compiler_format_spec)::in, prog_context::in,
state_format::in, prog_var::in, prog_var::in, hlds_goal::out,
var_table::in, var_table::out) is det.
create_state_update_replacement(ModuleInfo, Specs, Context, StateFormat,
StateInVar, StateOutVar, ReplacementGoal, !VarTable) :-
replace_state_format(ModuleInfo, Specs, StateFormat,
StateInVar, StateOutVar, Goals, ValueVars, !VarTable),
make_di_uo_instmap_delta(StateInVar, StateOutVar, InstMapDelta),
set_of_var.insert_list([StateInVar, StateOutVar], ValueVars, NonLocals),
goal_info_init(NonLocals, InstMapDelta, detism_det, purity_pure,
Context, GoalInfo),
conj_list_to_goal(Goals, GoalInfo, ReplacementGoal).
:- pred replace_state_format(module_info::in, list(compiler_format_spec)::in,
state_format::in, prog_var::in, prog_var::in, list(hlds_goal)::out,
set_of_progvar::out, var_table::in, var_table::out) is det.
replace_state_format(ModuleInfo, Specs, StateFormat, StateInVar, StateOutVar,
Goals, !:ValueVars, !VarTable) :-
set_of_var.init(!:ValueVars),
(
Specs = [],
Unification = assign(StateOutVar, StateInVar),
Uniq = ground(unique, none_or_default_func),
Clobbered = ground(clobbered, none_or_default_func),
UnifyMode = unify_modes_li_lf_ri_rf(free, Uniq, Uniq, Clobbered),
UnifyMainContext = umc_implicit("replace_io_format"),
UnifyContext = unify_context(UnifyMainContext, []),
GoalExpr = unify(StateOutVar, rhs_var(StateInVar), UnifyMode,
Unification, UnifyContext),
make_di_uo_instmap_delta(StateInVar, StateOutVar, InstMapDelta),
goal_info_init(set_of_var.list_to_set([StateInVar, StateOutVar]),
InstMapDelta, detism_det, purity_pure, GoalInfo),
Goal = hlds_goal(GoalExpr, GoalInfo),
Goals = [Goal]
;
Specs = [HeadSpec | TailSpecs],
replace_state_format_nonempty(ModuleInfo, HeadSpec, TailSpecs,
StateFormat, StateInVar, StateOutVar, Goals,
!ValueVars, !VarTable)
).
:- pred replace_state_format_nonempty(module_info::in,
compiler_format_spec::in, list(compiler_format_spec)::in,
state_format::in, prog_var::in, prog_var::in, list(hlds_goal)::out,
set_of_progvar::in, set_of_progvar::out,
var_table::in, var_table::out) is det.
replace_state_format_nonempty(ModuleInfo, HeadSpec, TailSpecs, StateFormat,
StateInVar, StateOutVar, Goals, !ValueVars, !VarTable) :-
(
TailSpecs = [],
replace_one_state_format(ModuleInfo, HeadSpec, StateFormat,
StateInVar, StateOutVar, Goals, !ValueVars, !VarTable)
;
TailSpecs = [FirstTailSpec | LaterTailSpecs],
(
( StateFormat = io_state_no_stream
; StateFormat = io_state_stream(_)
),
StateMidVarEntry = vte("", io_state_type, is_dummy_type)
;
StateFormat = string_builder_state,
StateMidVarEntry =
vte("", string_builder_state_type, is_not_dummy_type)
),
add_var_entry(StateMidVarEntry, StateMidVar, !VarTable),
replace_one_state_format(ModuleInfo, HeadSpec, StateFormat,
StateInVar, StateMidVar, HeadSpecGoals, !ValueVars, !VarTable),
replace_state_format_nonempty(ModuleInfo,
FirstTailSpec, LaterTailSpecs, StateFormat,
StateMidVar, StateOutVar, TailSpecsGoals, !ValueVars, !VarTable),
Goals = HeadSpecGoals ++ TailSpecsGoals
).
:- pred replace_one_state_format(module_info::in, compiler_format_spec::in,
state_format::in, prog_var::in, prog_var::in, list(hlds_goal)::out,
set_of_progvar::in, set_of_progvar::out,
var_table::in, var_table::out) is det.
replace_one_state_format(ModuleInfo, Spec, StateFormat,
StateInVar, StateOutVar, Goals, !ValueVars, !VarTable) :-
represent_spec(ModuleInfo, Spec, no, SpecVar, SpecGoals, SpecContext,
!ValueVars, !VarTable),
make_di_uo_instmap_delta(StateInVar, StateOutVar, InstMapDelta),
ArgVars = [SpecVar, StateInVar, StateOutVar],
(
(
StateFormat = io_state_stream(StreamVar),
ArgVarsIO = [StreamVar | ArgVars]
;
StateFormat = io_state_no_stream,
ArgVarsIO = ArgVars
),
generate_plain_call(ModuleInfo, pf_predicate,
mercury_io_module, "write_string", [], ArgVarsIO,
InstMapDelta, only_mode, detism_det, purity_pure,
[feature_do_not_warn_implicit_stream], SpecContext, CallGoal)
;
StateFormat = string_builder_state,
generate_plain_call(ModuleInfo, pf_predicate,
mercury_string_builder_module, "append_string", [], ArgVars,
InstMapDelta, only_mode, detism_det, purity_pure,
[], SpecContext, CallGoal)
),
Goals = SpecGoals ++ [CallGoal].
%---------------------------------------------------------------------------%
% For optimizing e.g.
% stream.string_writer.format(Stream, "%3d_%.5x",
% [i(X), i(Y)], State0, State),
% generate code that looks like this:
%
% ... optimized code for string.format("%dd_%.5x", [i(X), i(Y)], FS) ...
% stream.put(Stream, FS, State0, State)
%
% This mimics the current implementation of stream.string_writer.format
% in the runtime.
%
% XXX We should investigate whether switching to an approach similar
% to the one we follow for io.format, which in this case would mean
% invoking put on each component as soon as it is formatted, would
% yield faster code. We can answer that question only with access
% to a representative sample of code that uses stream.string_writer.format.
%
:- pred create_stream_string_writer_format_replacement(module_info::in,
list(compiler_format_spec)::in, prog_context::in,
prog_var::in, prog_var::in, prog_var::in, prog_var::in, hlds_goal::out,
var_table::in, var_table::out) is det.
create_stream_string_writer_format_replacement(ModuleInfo, Specs, Context,
TC_InfoVarForStream, StreamVar, StateInVar, StateOutVar,
ReplacementGoal, !VarTable) :-
replace_string_format(ModuleInfo, Specs, Context, no, ResultVar,
StringFormatGoals, ValueVars, !VarTable),
make_di_uo_instmap_delta(StateInVar, StateOutVar, InstMapDelta),
generate_plain_call(ModuleInfo, pf_predicate, mercury_stream_module, "put",
[TC_InfoVarForStream], [StreamVar, ResultVar, StateInVar, StateOutVar],
InstMapDelta, only_mode, detism_det, purity_pure,
[feature_do_not_warn_implicit_stream], Context, CallGoal),
Goals = StringFormatGoals ++ [CallGoal],
set_of_var.insert_list([TC_InfoVarForStream, StreamVar,
StateInVar, StateOutVar], ValueVars, NonLocals),
goal_info_init(NonLocals, InstMapDelta, detism_det, purity_pure,
Context, GoalInfo),
conj_list_to_goal(Goals, GoalInfo, ReplacementGoal).
%---------------------------------------------------------------------------%
:- pred represent_spec(module_info::in, compiler_format_spec::in,
maybe(prog_var)::in, prog_var::out, list(hlds_goal)::out,
prog_context::out, set_of_progvar::in, set_of_progvar::out,
var_table::in, var_table::out) is det.
represent_spec(ModuleInfo, Spec, MaybeResultVar, ResultVar, Goals, Context,
!ValueVars, !VarTable) :-
(
Spec = compiler_const_string(Context, StringConstant),
make_result_var_if_needed(MaybeResultVar, ResultVar, !VarTable),
make_string_const_construction(Context, ResultVar, StringConstant,
Goal),
Goals = [Goal]
;
Spec = compiler_spec_char(Context, Flags, MaybeWidth, ValueVar),
set_of_var.insert(ValueVar, !ValueVars),
make_result_var_if_needed(MaybeResultVar, ResultVar, !VarTable),
build_flags_arg(Context, Flags, FlagsVar, FlagsGoals, !VarTable),
maybe_build_width_arg(MaybeWidth, WidthSuffix, WidthVars, WidthGoals,
!VarTable),
generate_plain_call(ModuleInfo, pf_predicate,
mercury_string_format_module,
"format_char_component" ++ WidthSuffix,
[], [FlagsVar] ++ WidthVars ++ [ValueVar, ResultVar],
instmap_delta_bind_var(ResultVar), only_mode,
detism_det, purity_pure, [], Context, CallGoal),
Goals = FlagsGoals ++ WidthGoals ++ [CallGoal]
;
Spec = compiler_spec_string(Context, Flags,
MaybeWidth, MaybePrec, ValueVar),
set_of_var.insert(ValueVar, !ValueVars),
( if
% Optimize a common case, "%s", which can be handled *without*
% invoking the component formatter on the string value at all.
Flags = string_format_flags(flag_hash_clear, flag_space_clear,
flag_zero_clear, flag_minus_clear, flag_plus_clear),
MaybeWidth = compiler_no_specified_width,
MaybePrec = compiler_no_specified_prec
then
(
MaybeResultVar = no,
ResultVar = ValueVar,
Goals = []
;
MaybeResultVar = yes(ResultVar),
make_simple_assign(ResultVar, ValueVar,
umc_implicit("represent_spec"), [], AssignGoal),
Goals = [AssignGoal]
)
else
make_result_var_if_needed(MaybeResultVar, ResultVar, !VarTable),
build_flags_arg(Context, Flags, FlagsVar, FlagsGoals, !VarTable),
maybe_build_width_arg(MaybeWidth, WidthSuffix, WidthVars,
WidthGoals, !VarTable),
maybe_build_prec_arg(MaybePrec, PrecSuffix, PrecVars, PrecGoals,
!VarTable),
generate_plain_call(ModuleInfo, pf_predicate,
mercury_string_format_module,
"format_string_component" ++ WidthSuffix ++ PrecSuffix, [],
[FlagsVar] ++ WidthVars ++ PrecVars ++ [ValueVar, ResultVar],
instmap_delta_bind_var(ResultVar), only_mode,
detism_det, purity_pure, [], Context, CallGoal),
Goals = FlagsGoals ++ WidthGoals ++ PrecGoals ++ [CallGoal]
)
;
(
Spec = compiler_spec_signed_int(Context, Flags,
MaybeWidth, MaybePrec, IntSize, OrigValueVar),
% Format a signed int as signed int.
BaseVars = [],
BaseGoals = [],
cast_int_value_var_if_needed(ModuleInfo, Context, IntSize,
OrigValueVar, FormatPredBase, ValueVar, ValueCastGoals,
!VarTable)
;
Spec = compiler_spec_unsigned_int(Context, Flags,
MaybeWidth, MaybePrec, Base, IntSize, OrigValueVar),
% Format a signed int as unsigned int.
build_int_base_arg(Base, BaseVars, BaseGoals, !VarTable),
cast_int_value_var_to_uint_if_needed(ModuleInfo, Context, IntSize,
OrigValueVar, FormatPredBase, ValueVar, ValueCastGoals,
!VarTable)
;
Spec = compiler_spec_uint(Context, Flags,
MaybeWidth, MaybePrec, Base, UIntSize, OrigValueVar),
% Format an unsigned int as unsigned int.
build_int_base_arg(Base, BaseVars, BaseGoals, !VarTable),
cast_uint_value_var_if_needed(ModuleInfo, Context, UIntSize,
OrigValueVar, FormatPredBase, ValueVar, ValueCastGoals,
!VarTable)
),
set_of_var.insert(OrigValueVar, !ValueVars),
make_result_var_if_needed(MaybeResultVar, ResultVar, !VarTable),
build_flags_arg(Context, Flags, FlagsVar, FlagsGoals, !VarTable),
maybe_build_width_arg(MaybeWidth, WidthSuffix, WidthVars, WidthGoals,
!VarTable),
maybe_build_prec_arg(MaybePrec, PrecSuffix, PrecVars, PrecGoals,
!VarTable),
generate_plain_call(ModuleInfo, pf_predicate,
mercury_string_format_module,
FormatPredBase ++ WidthSuffix ++ PrecSuffix,
[], [FlagsVar] ++ WidthVars ++ PrecVars ++ BaseVars ++
[ValueVar, ResultVar],
instmap_delta_bind_var(ResultVar), only_mode,
detism_det, purity_pure, [], Context, CallGoal),
Goals = ValueCastGoals ++ FlagsGoals ++ WidthGoals ++ PrecGoals ++
BaseGoals ++ [CallGoal]
;
Spec = compiler_spec_float(Context, Flags,
MaybeWidth, MaybePrec, Kind, ValueVar),
set_of_var.insert(ValueVar, !ValueVars),
make_result_var_if_needed(MaybeResultVar, ResultVar, !VarTable),
build_flags_arg(Context, Flags, FlagsVar, FlagsGoals, !VarTable),
maybe_build_width_arg(MaybeWidth, WidthSuffix, WidthVars, WidthGoals,
!VarTable),
maybe_build_prec_arg(MaybePrec, PrecSuffix, PrecVars, PrecGoals,
!VarTable),
build_float_kind_arg(Kind, KindVar, KindGoal, !VarTable),
generate_plain_call(ModuleInfo, pf_predicate,
mercury_string_format_module,
"format_float_component" ++ WidthSuffix ++ PrecSuffix,
[], [FlagsVar] ++ WidthVars ++ PrecVars ++
[KindVar, ValueVar, ResultVar],
instmap_delta_bind_var(ResultVar), only_mode,
detism_det, purity_pure, [], Context, CallGoal),
Goals = FlagsGoals ++ WidthGoals ++ PrecGoals ++ [KindGoal, CallGoal]
).
:- pred cast_int_value_var_if_needed(module_info::in, prog_context::in,
int_size::in, prog_var::in, string::out, prog_var::out,
list(hlds_goal)::out, var_table::in, var_table::out) is det.
cast_int_value_var_if_needed(ModuleInfo, Context, IntSize,
OrigValueVar, FormatPredBase, ValueVar, ValueCastGoals, !VarTable) :-
(
IntSize = int_size_word,
FormatPredBase = "format_signed_int_component",
ValueVar = OrigValueVar,
ValueCastGoals = []
;
IntSize = int_size_64,
FormatPredBase = "format_signed_int64_component",
ValueVar = OrigValueVar,
ValueCastGoals = []
;
( IntSize = int_size_8, CastPred = "format_cast_int8_to_int"
; IntSize = int_size_16, CastPred = "format_cast_int16_to_int"
; IntSize = int_size_32, CastPred = "format_cast_int32_to_int"
),
FormatPredBase = "format_signed_int_component",
ValueVarEntry = vte("", int_type, is_not_dummy_type),
add_var_entry(ValueVarEntry, ValueVar, !VarTable),
generate_plain_call(ModuleInfo, pf_predicate,
mercury_string_format_module, CastPred,
[], [OrigValueVar, ValueVar],
instmap_delta_bind_var(ValueVar), only_mode,
detism_det, purity_pure, [], Context, ValueCastGoal),
ValueCastGoals = [ValueCastGoal]
).
:- pred cast_int_value_var_to_uint_if_needed(module_info::in, prog_context::in,
int_size::in, prog_var::in, string::out, prog_var::out,
list(hlds_goal)::out, var_table::in, var_table::out) is det.
cast_int_value_var_to_uint_if_needed(ModuleInfo, Context, IntSize,
OrigValueVar, FormatPredBase, ValueVar, ValueCastGoals, !VarTable) :-
(
IntSize = int_size_64,
FormatPredBase = "format_unsigned_int64_component",
ValueVar = OrigValueVar,
ValueCastGoals = []
;
( IntSize = int_size_word, CastPred = "format_cast_int_to_uint"
; IntSize = int_size_8, CastPred = "format_cast_int8_to_uint"
; IntSize = int_size_16, CastPred = "format_cast_int16_to_uint"
; IntSize = int_size_32, CastPred = "format_cast_int32_to_uint"
),
FormatPredBase = "format_uint_component",
ValueVarEntry = vte("", uint_type, is_not_dummy_type),
add_var_entry(ValueVarEntry, ValueVar, !VarTable),
generate_plain_call(ModuleInfo, pf_predicate,
mercury_string_format_module, CastPred,
[], [OrigValueVar, ValueVar],
instmap_delta_bind_var(ValueVar), only_mode,
detism_det, purity_pure, [], Context, ValueCastGoal),
ValueCastGoals = [ValueCastGoal]
).
:- pred cast_uint_value_var_if_needed(module_info::in, prog_context::in,
uint_size::in, prog_var::in, string::out, prog_var::out,
list(hlds_goal)::out, var_table::in, var_table::out) is det.
cast_uint_value_var_if_needed(ModuleInfo, Context, UIntSize,
OrigValueVar, FormatPredBase, ValueVar, ValueCastGoals, !VarTable) :-
(
UIntSize = uint_size_word,
FormatPredBase = "format_uint_component",
ValueVar = OrigValueVar,
ValueCastGoals = []
;
UIntSize = uint_size_64,
FormatPredBase = "format_uint64_component",
ValueVar = OrigValueVar,
ValueCastGoals = []
;
( UIntSize = uint_size_8, CastPred = "format_cast_uint8_to_uint"
; UIntSize = uint_size_16, CastPred = "format_cast_uint16_to_uint"
; UIntSize = uint_size_32, CastPred = "format_cast_uint32_to_uint"
),
FormatPredBase = "format_uint_component",
ValueVarEntry = vte("", uint_type, is_not_dummy_type),
add_var_entry(ValueVarEntry, ValueVar, !VarTable),
generate_plain_call(ModuleInfo, pf_predicate,
mercury_string_format_module, CastPred,
[], [OrigValueVar, ValueVar],
instmap_delta_bind_var(ValueVar), only_mode,
detism_det, purity_pure, [], Context, ValueCastGoal),
ValueCastGoals = [ValueCastGoal]
).
% This predicate generates code of the form
%
% VarHash = flag_hash_clear,
% VarSpace = flag_hash_set,
% VarZero = flag_hash_clear,
% VarMinus = flag_hash_clear,
% VarPlus = flag_hash_clear,
% Flags = string_format_flags(VarHash, VarSpace, VarZero, VarMinus,
% VarPlus)
%
% While this looks like a lot, it should actually compile down into
% a single machine instruction, due to the packing of enums inside
% structures.
%
:- pred build_flags_arg(prog_context::in, string_format_flags::in,
prog_var::out, list(hlds_goal)::out, var_table::in, var_table::out) is det.
build_flags_arg(Context, Flags, Var, Goals, !VarTable) :-
Flags = string_format_flags(FlagHash, FlagSpace, FlagZero,
FlagMinus, FlagPlus),
ParseUtil = mercury_string_parse_util_module,
TypeSymNameHash = qualified(ParseUtil, "string_format_flag_hash"),
TypeSymNameSpace = qualified(ParseUtil, "string_format_flag_space"),
TypeSymNameZero = qualified(ParseUtil, "string_format_flag_zero"),
TypeSymNameMinus = qualified(ParseUtil, "string_format_flag_minus"),
TypeSymNamePlus = qualified(ParseUtil, "string_format_flag_plus"),
TypeCtorHash = type_ctor(TypeSymNameHash, 0),
TypeCtorSpace = type_ctor(TypeSymNameSpace, 0),
TypeCtorZero = type_ctor(TypeSymNameZero, 0),
TypeCtorMinus = type_ctor(TypeSymNameMinus, 0),
TypeCtorPlus = type_ctor(TypeSymNamePlus, 0),
TypeHash = defined_type(TypeSymNameHash, [], kind_star) : mer_type,
TypeSpace = defined_type(TypeSymNameSpace, [], kind_star) : mer_type,
TypeZero = defined_type(TypeSymNameZero, [], kind_star) : mer_type,
TypeMinus = defined_type(TypeSymNameMinus, [], kind_star) : mer_type,
TypePlus = defined_type(TypeSymNamePlus, [], kind_star) : mer_type,
EntryHash = vte("", TypeHash, is_not_dummy_type),
EntrySpace = vte("", TypeSpace, is_not_dummy_type),
EntryZero = vte("", TypeZero, is_not_dummy_type),
EntryMinus = vte("", TypeMinus, is_not_dummy_type),
EntryPlus = vte("", TypePlus, is_not_dummy_type),
add_var_entry(EntryHash, VarHash, !VarTable),
add_var_entry(EntrySpace, VarSpace, !VarTable),
add_var_entry(EntryZero, VarZero, !VarTable),
add_var_entry(EntryMinus, VarMinus, !VarTable),
add_var_entry(EntryPlus, VarPlus, !VarTable),
(
FlagHash = flag_hash_clear,
ConsNameHash = "flag_hash_clear"
;
FlagHash = flag_hash_set,
ConsNameHash = "flag_hash_set"
),
(
FlagSpace = flag_space_clear,
ConsNameSpace = "flag_space_clear"
;
FlagSpace = flag_space_set,
ConsNameSpace = "flag_space_set"
),
(
FlagZero = flag_zero_clear,
ConsNameZero = "flag_zero_clear"
;
FlagZero = flag_zero_set,
ConsNameZero = "flag_zero_set"
),
(
FlagMinus = flag_minus_clear,
ConsNameMinus = "flag_minus_clear"
;
FlagMinus = flag_minus_set,
ConsNameMinus = "flag_minus_set"
),
(
FlagPlus = flag_plus_clear,
ConsNamePlus = "flag_plus_clear"
;
FlagPlus = flag_plus_set,
ConsNamePlus = "flag_plus_set"
),
SymNameHash = qualified(ParseUtil, ConsNameHash),
SymNameSpace = qualified(ParseUtil, ConsNameSpace),
SymNameZero = qualified(ParseUtil, ConsNameZero),
SymNameMinus = qualified(ParseUtil, ConsNameMinus),
SymNamePlus = qualified(ParseUtil, ConsNamePlus),
DuCtorHash = du_ctor(SymNameHash, 0, TypeCtorHash),
DuCtorSpace = du_ctor(SymNameSpace, 0, TypeCtorSpace),
DuCtorZero = du_ctor(SymNameZero, 0, TypeCtorZero),
DuCtorMinus = du_ctor(SymNameMinus, 0, TypeCtorMinus),
DuCtorPlus = du_ctor(SymNamePlus, 0, TypeCtorPlus),
ConsIdHash = du_data_ctor(DuCtorHash),
ConsIdSpace = du_data_ctor(DuCtorSpace),
ConsIdZero = du_data_ctor(DuCtorZero),
ConsIdMinus = du_data_ctor(DuCtorMinus),
ConsIdPlus = du_data_ctor(DuCtorPlus),
make_const_construction(Context, VarHash, ConsIdHash, GoalHash),
make_const_construction(Context, VarSpace, ConsIdSpace, GoalSpace),
make_const_construction(Context, VarZero, ConsIdZero, GoalZero),
make_const_construction(Context, VarMinus, ConsIdMinus, GoalMinus),
make_const_construction(Context, VarPlus, ConsIdPlus, GoalPlus),
TypeNameCombine = qualified(ParseUtil, "string_format_flags"),
TypeCombine = defined_type(TypeNameCombine, [], kind_star),
CombineVarEntry = vte("", TypeCombine, is_not_dummy_type),
add_var_entry(CombineVarEntry, Var, !VarTable),
TypeCtorCombine = type_ctor(TypeNameCombine, 0),
ConsSymNameCombine = qualified(ParseUtil, "string_format_flags"),
DuCtorCombine =
du_ctor(ConsSymNameCombine, 5, TypeCtorCombine),
ConsIdCombine = du_data_ctor(DuCtorCombine),
SpecVars = [VarHash, VarSpace, VarZero, VarMinus, VarPlus],
construct_functor(Var, ConsIdCombine, SpecVars, GoalCombine),
Goals = [GoalHash, GoalSpace, GoalZero, GoalMinus, GoalPlus, GoalCombine].
% Decide whether we have a specified width.
%
% If yes, return both the variable that represents the specified width
% and the goals that construct it.
%
:- pred maybe_build_width_arg(compiler_format_maybe_width::in,
string::out, list(prog_var)::out, list(hlds_goal)::out,
var_table::in, var_table::out) is det.
maybe_build_width_arg(MaybeWidth, PredNameSuffix, MaybeWidthVar,
MaybeWidthGoals, !VarTable) :-
(
MaybeWidth = compiler_no_specified_width,
PredNameSuffix = "_nowidth",
MaybeWidthVar = [],
MaybeWidthGoals = []
;
MaybeWidth = compiler_manifest_width(WidthInt),
PredNameSuffix = "_width",
make_int_const_construction_alloc(WidthInt, "", WidthGoal, WidthVar,
!VarTable),
MaybeWidthVar = [WidthVar],
MaybeWidthGoals = [WidthGoal]
;
MaybeWidth = compiler_var_width(WidthVar),
PredNameSuffix = "_width",
MaybeWidthVar = [WidthVar],
MaybeWidthGoals = []
).
% Decide whether we have a specified precision.
%
% If yes, return both the variable that represents the specified precision
% and the goals that construct it.
%
:- pred maybe_build_prec_arg(compiler_format_maybe_prec::in,
string::out, list(prog_var)::out, list(hlds_goal)::out,
var_table::in, var_table::out) is det.
maybe_build_prec_arg(MaybePrec, PredNameSuffix, MaybePrecVar,
MaybePrecGoals, !VarTable) :-
(
MaybePrec = compiler_no_specified_prec,
PredNameSuffix = "_noprec",
MaybePrecVar = [],
MaybePrecGoals = []
;
MaybePrec = compiler_manifest_prec(PrecInt),
PredNameSuffix = "_prec",
make_int_const_construction_alloc(PrecInt, "", PrecGoal, PrecVar,
!VarTable),
MaybePrecVar = [PrecVar],
MaybePrecGoals = [PrecGoal]
;
MaybePrec = compiler_var_prec(PrecVar),
PredNameSuffix = "_prec",
MaybePrecVar = [PrecVar],
MaybePrecGoals = []
).
:- pred build_int_base_arg(string_format_int_base::in,
list(prog_var)::out, list(hlds_goal)::out,
var_table::in, var_table::out) is det.
build_int_base_arg(Base, [Var], [Goal], !VarTable) :-
ParseUtil = mercury_string_parse_util_module,
TypeName = qualified(ParseUtil, "string_format_int_base"),
TypeCtor = type_ctor(TypeName, 0),
Type = defined_type(TypeName, [], kind_star),
(
Base = base_octal,
ConsName = "base_octal"
;
Base = base_decimal,
ConsName = "base_decimal"
;
Base = base_hex_lc,
ConsName = "base_hex_lc"
;
Base = base_hex_uc,
ConsName = "base_hex_uc"
;
Base = base_hex_p,
ConsName = "base_hex_p"
),
ConsId = du_data_ctor(du_ctor(qualified(ParseUtil, ConsName),
0, TypeCtor)),
make_const_construction_alloc(ConsId, Type, is_not_dummy_type, "",
Goal, Var, !VarTable).
:- pred build_float_kind_arg(string_format_float_kind::in,
prog_var::out, hlds_goal::out, var_table::in, var_table::out) is det.
build_float_kind_arg(Kind, Var, Goal, !VarTable) :-
ParseUtil = mercury_string_parse_util_module,
TypeName = qualified(ParseUtil, "string_format_float_kind"),
TypeCtor = type_ctor(TypeName, 0),
Type = defined_type(TypeName, [], kind_star),
(
Kind = kind_e_scientific_lc,
ConsName = "kind_e_scientific_lc"
;
Kind = kind_e_scientific_uc,
ConsName = "kind_e_scientific_uc"
;
Kind = kind_f_plain_lc,
ConsName = "kind_f_plain_lc"
;
Kind = kind_f_plain_uc,
ConsName = "kind_f_plain_uc"
;
Kind = kind_g_flexible_lc,
ConsName = "kind_g_flexible_lc"
;
Kind = kind_g_flexible_uc,
ConsName = "kind_g_flexible_uc"
),
ConsId = du_data_ctor(du_ctor(qualified(ParseUtil, ConsName),
0, TypeCtor)),
make_const_construction_alloc(ConsId, Type, is_not_dummy_type, "",
Goal, Var, !VarTable).
:- pred make_result_var_if_needed(maybe(prog_var)::in, prog_var::out,
var_table::in, var_table::out) is det.
make_result_var_if_needed(MaybeResultVar, ResultVar, !VarTable) :-
(
MaybeResultVar = yes(ResultVar)
;
MaybeResultVar = no,
Entry = vte("", string_type, is_not_dummy_type),
add_var_entry(Entry, ResultVar, !VarTable)
).
:- pred make_di_uo_instmap_delta(prog_var::in, prog_var::in,
instmap_delta::out) is det.
make_di_uo_instmap_delta(InVar, OutVar, InstMapDelta) :-
Uniq = ground(unique, none_or_default_func),
Clobbered = ground(clobbered, none_or_default_func),
InstMapDelta = instmap_delta_from_assoc_list(
[InVar - Clobbered, OutVar - Uniq]).
%---------------------------------------------------------------------------%
:- end_module check_hlds.simplify.opt_format_call.
%---------------------------------------------------------------------------%