mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-15 17:33:38 +00:00
4cd5c17f61
... and other minor fixes.
library/*.m:
library/LIB_FLAGS.in:
compiler/*.m:
mdbcomp/*.m:
Fix and update copyright notices.
Fix spelling.
Delete trailing whitespace.
1949 lines
87 KiB
Mathematica
1949 lines
87 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 2009-2012 The University of Melbourne.
|
|
% Copyright (C) 2013-2018, 2020-2024 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: ml_proc_gen.m.
|
|
% Main author: fjh.
|
|
%
|
|
|
|
:- module ml_backend.ml_proc_gen.
|
|
:- interface.
|
|
|
|
:- import_module hlds.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module ml_backend.ml_gen_info.
|
|
:- import_module ml_backend.ml_global_data.
|
|
:- import_module ml_backend.mlds.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.error_spec.
|
|
|
|
:- import_module io.
|
|
:- import_module list.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Generate MLDS definitions for all the non-imported predicates
|
|
% (and functions) in the HLDS.
|
|
%
|
|
:- pred ml_gen_preds(io.text_output_stream::in, mlds_target_lang::in,
|
|
ml_const_struct_map::in, list(mlds_function_defn)::out,
|
|
ml_global_data::in, ml_global_data::out,
|
|
module_info::in, module_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module hlds.code_model.
|
|
:- import_module hlds.hlds_dependency_graph.
|
|
:- import_module hlds.hlds_desc.
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.hlds_proc_util.
|
|
:- import_module hlds.mark_tail_calls.
|
|
:- import_module hlds.passes_aux.
|
|
:- import_module hlds.quantification.
|
|
:- import_module hlds.status.
|
|
:- import_module libs.
|
|
:- import_module libs.dependency_graph.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.optimization_options.
|
|
:- import_module ml_backend.ml_args_util.
|
|
:- import_module ml_backend.ml_code_gen.
|
|
:- import_module ml_backend.ml_code_util.
|
|
:- import_module ml_backend.ml_unused_assign.
|
|
:- import_module ml_backend.ml_util.
|
|
:- import_module parse_tree.prog_data.
|
|
:- import_module parse_tree.prog_data_foreign.
|
|
:- import_module parse_tree.prog_data_pragma.
|
|
:- import_module parse_tree.prog_type.
|
|
:- import_module parse_tree.prog_type_unify.
|
|
:- import_module parse_tree.set_of_var.
|
|
:- import_module parse_tree.var_table.
|
|
|
|
:- import_module assoc_list.
|
|
:- import_module bool.
|
|
:- import_module int.
|
|
:- import_module map.
|
|
:- import_module maybe.
|
|
:- import_module pair.
|
|
:- import_module require.
|
|
:- import_module set.
|
|
:- import_module string.
|
|
:- import_module term_context.
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%---------------------------------------------------------------------------%
|
|
|
|
ml_gen_preds(ProgressStream, Target, ConstStructMap, FuncDefns,
|
|
!GlobalData, !ModuleInfo, !Specs) :-
|
|
module_info_get_pred_id_table(!.ModuleInfo, PredIdTable0),
|
|
map.to_sorted_assoc_list(PredIdTable0, PredIdInfos0),
|
|
% For the reason documented by the comment on requantify_codegen_proc,
|
|
% we must requantify the body of every procedure we intend to generate
|
|
% code for. We don't *have* to put the requantified proc_infos back
|
|
% into !ModuleInfo; we *could* call requantify_proc_general from
|
|
% the initial part of ml_gen_proc. That would work in every way but one:
|
|
% it would make it harder to debug the MLDS code generator. This is
|
|
% because the MLDS code we generate for a procedure *has* to be for
|
|
% the requantified version of the procedure body, but unless we put
|
|
% that version back into !ModuleInfo, neither any pre-code-gen nor
|
|
% any post-code-gen HLDS dumps would contain that version. Putting
|
|
% the requantified proc_infos back into !ModuleInfo here makes them
|
|
% available in the post-code-gen HLDS dump.
|
|
ml_find_and_requantify_procs_for_code_gen(PredIdInfos0, [], RevPredIdInfos,
|
|
[], PredProcIds),
|
|
map.from_rev_sorted_assoc_list(RevPredIdInfos, PredIdTable),
|
|
module_info_set_pred_id_table(PredIdTable, !ModuleInfo),
|
|
|
|
set.list_to_set(PredProcIds, CodeGenPredProcIds),
|
|
DepInfo = build_proc_dependency_graph(!.ModuleInfo, CodeGenPredProcIds,
|
|
only_all_calls),
|
|
get_bottom_up_sccs_with_entry_points(!.ModuleInfo, DepInfo,
|
|
BottomUpSCCsWithEntryPoints),
|
|
|
|
% Optimize tail calls only if asked.
|
|
module_info_get_globals(!.ModuleInfo, Globals),
|
|
globals.get_opt_tuple(Globals, OptTuple),
|
|
TailCalls = OptTuple ^ ot_opt_mlds_tailcalls,
|
|
(
|
|
TailCalls = opt_mlds_tailcalls,
|
|
OptTailCalls = tail_call_opt_in_code_gen
|
|
;
|
|
TailCalls = do_not_opt_mlds_tailcalls,
|
|
OptTailCalls = no_tail_call_opt_in_code_gen
|
|
),
|
|
get_default_warn_parms(Globals, DefaultWarnParams),
|
|
ml_gen_sccs(ProgressStream, !.ModuleInfo, OptTailCalls, DefaultWarnParams,
|
|
Target, ConstStructMap, BottomUpSCCsWithEntryPoints,
|
|
[], FuncDefns, !GlobalData, !Specs).
|
|
|
|
:- pred ml_find_and_requantify_procs_for_code_gen(
|
|
assoc_list(pred_id, pred_info)::in,
|
|
assoc_list(pred_id, pred_info)::in, assoc_list(pred_id, pred_info)::out,
|
|
list(pred_proc_id)::in, list(pred_proc_id)::out) is det.
|
|
|
|
ml_find_and_requantify_procs_for_code_gen([],
|
|
!RevPredIdInfos, !CodeGenPredProcIds).
|
|
ml_find_and_requantify_procs_for_code_gen([PredIdInfo0 | PredIdInfos0],
|
|
!RevPredIdInfos, !CodeGenPredProcIds) :-
|
|
PredIdInfo0 = PredId - PredInfo0,
|
|
pred_info_get_status(PredInfo0, PredStatus),
|
|
( if
|
|
(
|
|
PredStatus = pred_status(status_imported(_))
|
|
;
|
|
% We generate incorrect and unnecessary code for the external
|
|
% special preds which are pseudo_imported, so just ignore them.
|
|
is_unify_index_or_compare_pred(PredInfo0),
|
|
PredStatus =
|
|
pred_status(status_external(status_pseudo_imported))
|
|
)
|
|
then
|
|
PredIdInfo = PredIdInfo0
|
|
else
|
|
% Generate MLDS definitions for all the non-imported procedures
|
|
% of a given predicate (or function).
|
|
%
|
|
% If a type is imported, the compiler will generate the (in,in) mode
|
|
% of its unify and compare predicates in its home module, but if this
|
|
% module needs one of these predicates in a more specialize mode
|
|
% (e.g. one in which an input argument is known to be bound to one
|
|
% of a small subset of the possible function symbols), it has to create
|
|
% code for it itself. Such procedures are pseudo imported, which means
|
|
% that their procedure 0 (the procedure implementing the (in,in) mode)
|
|
% is imported, but any other procedures are not.
|
|
|
|
( if PredStatus = pred_status(status_external(_)) then
|
|
ProcIds = pred_info_all_procids(PredInfo0)
|
|
else
|
|
ProcIds = pred_info_all_non_imported_procids(PredInfo0)
|
|
),
|
|
pred_info_get_proc_table(PredInfo0, ProcTable0),
|
|
list.foldl(requantify_codegen_proc, ProcIds, ProcTable0, ProcTable),
|
|
pred_info_set_proc_table(ProcTable, PredInfo0, PredInfo),
|
|
PredIdInfo = PredId - PredInfo,
|
|
|
|
PredProcIds = list.map((func(ProcId) = proc(PredId, ProcId)), ProcIds),
|
|
!:CodeGenPredProcIds = PredProcIds ++ !.CodeGenPredProcIds
|
|
),
|
|
!:RevPredIdInfos = [PredIdInfo | !.RevPredIdInfos],
|
|
ml_find_and_requantify_procs_for_code_gen(PredIdInfos0,
|
|
!RevPredIdInfos, !CodeGenPredProcIds).
|
|
|
|
% The specification of the HLDS allows goal_infos to overestimate
|
|
% the set of non-locals. Such overestimates are bad for us for two reasons:
|
|
%
|
|
% - If the non-locals of the top-level goal contained any variables other
|
|
% than head vars, those variables would not be declared.
|
|
%
|
|
% - The code of goal_expr_find_subgoal_nonlocals depends on the nonlocals
|
|
% sets of goals being exactly correct, since this is the only way it can
|
|
% avoid traversing the entirety of the goals themselves. Such traversals
|
|
% can be very expensive on large goals, since it would have to be done
|
|
% repeatedly, once for each containing goal. Quantification does just one
|
|
% traversal.
|
|
%
|
|
:- pred requantify_codegen_proc(proc_id::in, proc_table::in, proc_table::out)
|
|
is det.
|
|
|
|
requantify_codegen_proc(ProcId, !ProcTable) :-
|
|
map.lookup(!.ProcTable, ProcId, ProcInfo0),
|
|
requantify_proc_general(ord_nl_no_lambda, ProcInfo0, ProcInfo),
|
|
map.det_update(ProcId, ProcInfo, !ProcTable).
|
|
|
|
:- type maybe_tail_call_opt_in_code_gen
|
|
---> no_tail_call_opt_in_code_gen
|
|
; tail_call_opt_in_code_gen.
|
|
|
|
:- pred ml_gen_sccs(io.text_output_stream::in, module_info::in,
|
|
maybe_tail_call_opt_in_code_gen::in, warn_non_tail_rec_params::in,
|
|
mlds_target_lang::in, ml_const_struct_map::in,
|
|
list(scc_with_entry_points)::in,
|
|
list(mlds_function_defn)::in, list(mlds_function_defn)::out,
|
|
ml_global_data::in, ml_global_data::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
ml_gen_sccs(_, _, _, _, _, _, [], !FuncDefns, !GlobalData, !Specs).
|
|
ml_gen_sccs(ProgressStream, ModuleInfo, OptTailCalls, DefaultWarnParams,
|
|
Target, ConstStructMap, [SCCE | SCCEs],
|
|
!FuncDefns, !GlobalData, !Specs) :-
|
|
ml_gen_scc(ProgressStream, ModuleInfo, OptTailCalls, DefaultWarnParams,
|
|
Target, ConstStructMap, SCCE, !FuncDefns, !GlobalData, !Specs),
|
|
ml_gen_sccs(ProgressStream, ModuleInfo, OptTailCalls, DefaultWarnParams,
|
|
Target, ConstStructMap, SCCEs, !FuncDefns, !GlobalData, !Specs).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred ml_gen_scc(io.text_output_stream::in, module_info::in,
|
|
maybe_tail_call_opt_in_code_gen::in, warn_non_tail_rec_params::in,
|
|
mlds_target_lang::in, ml_const_struct_map::in, scc_with_entry_points::in,
|
|
list(mlds_function_defn)::in, list(mlds_function_defn)::out,
|
|
ml_global_data::in, ml_global_data::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
ml_gen_scc(ProgressStream, ModuleInfo, OptTailCalls, DefaultWarnParams, Target,
|
|
ConstStructMap, SCCE, !FuncDefns, !GlobalData, !Specs) :-
|
|
ml_gen_scc_code(ProgressStream, ModuleInfo, OptTailCalls, Target,
|
|
ConstStructMap, SCCE, InSccMap, !FuncDefns, !GlobalData),
|
|
map.foldl_values(gather_nontail_rec_calls, InSccMap, [], NonTailRecCalls),
|
|
( if
|
|
% If we were trying to implement recursive calls as tail calls, ...
|
|
OptTailCalls = tail_call_opt_in_code_gen,
|
|
% ... but some recursive calls turned out NOT to be implementable
|
|
% as tail calls, ...
|
|
NonTailRecCalls = [_ | _]
|
|
then
|
|
% ... then generate messages for them, if the appropriate settings
|
|
% call for such messages.
|
|
%
|
|
% Having a list of all the non-tail recursive calls in the SCC
|
|
% in one place should allow a future diff to report, in cases
|
|
% where the caller and callee are in different TSCCs, exactly
|
|
% which recursive calls being non-tail calls prevent them from
|
|
% being in the same TSCC.
|
|
list.foldl(report_nontail_rec_call(ModuleInfo, DefaultWarnParams),
|
|
NonTailRecCalls, !Specs)
|
|
else
|
|
true
|
|
).
|
|
|
|
:- pred gather_nontail_rec_calls(in_scc_info::in,
|
|
list(nontail_rec_call)::in, list(nontail_rec_call)::out) is det.
|
|
|
|
gather_nontail_rec_calls(InSccInfo, !NonTailRecCalls) :-
|
|
!:NonTailRecCalls =
|
|
InSccInfo ^ isi_is_target_of_non_tail_rec ++ !.NonTailRecCalls.
|
|
|
|
:- pred report_nontail_rec_call(module_info::in,
|
|
warn_non_tail_rec_params::in, nontail_rec_call::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
report_nontail_rec_call(ModuleInfo, DefaultWarnParams, NonTailRecCall,
|
|
!Specs) :-
|
|
NonTailRecCall = nontail_rec_call(Caller, Callee, Context,
|
|
Reason, Obviousness, Status),
|
|
(
|
|
Status = nontail_rec_call_warn_disabled
|
|
;
|
|
Status = nontail_rec_call_warn_enabled,
|
|
module_info_pred_proc_info(ModuleInfo, Caller, _PredInfo, ProcInfo),
|
|
maybe_override_warn_params_for_proc(ProcInfo,
|
|
DefaultWarnParams, ProcWarnParams),
|
|
maybe_report_nontail_recursive_call(ModuleInfo, Caller, Callee,
|
|
Context, Reason, Obviousness, ProcWarnParams, !Specs)
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred ml_gen_scc_code(io.text_output_stream::in, module_info::in,
|
|
maybe_tail_call_opt_in_code_gen::in, mlds_target_lang::in,
|
|
ml_const_struct_map::in, scc_with_entry_points::in, in_scc_map::out,
|
|
list(mlds_function_defn)::in, list(mlds_function_defn)::out,
|
|
ml_global_data::in, ml_global_data::out) is det.
|
|
|
|
ml_gen_scc_code(ProgressStream, ModuleInfo, OptTailCalls, Target,
|
|
ConstStructMap, SCCE, !:InSccMap, !FuncDefns, !GlobalData) :-
|
|
SCCE = scc_with_entry_points(PredProcIds, CalledFromHigherSCCs,
|
|
ExportedProcs),
|
|
set.union(CalledFromHigherSCCs, ExportedProcs, SCCEntryProcs),
|
|
|
|
set.fold(add_to_in_scc_map, PredProcIds, map.init, !:InSccMap),
|
|
(
|
|
OptTailCalls = no_tail_call_opt_in_code_gen,
|
|
set.foldl3(
|
|
ml_gen_proc_lookup(ProgressStream, ModuleInfo, Target,
|
|
ConstStructMap, no_tail_rec),
|
|
PredProcIds, !FuncDefns, !GlobalData, !InSccMap)
|
|
;
|
|
OptTailCalls = tail_call_opt_in_code_gen,
|
|
partition_scc_procs(ModuleInfo, set.to_sorted_list(PredProcIds),
|
|
NonePredProcIdInfos, SelfPredProcIdInfos0,
|
|
MutualDetPredProcIdInfos0, MutualSemiPredProcIdInfos0),
|
|
|
|
% The predicates called by ml_gen_tscc always generate gc_no_stmt
|
|
% as the gc annotation on MLDS function parameters. Until this
|
|
% limitation is fixed, don't give any work to ml_gen_tscc in
|
|
% circumstances where it would bite.
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.get_gc_method(Globals, GC),
|
|
( if GC = gc_accurate then
|
|
SelfPredProcIdInfos = SelfPredProcIdInfos0 ++
|
|
MutualDetPredProcIdInfos0 ++ MutualSemiPredProcIdInfos0,
|
|
MutualDetPredProcIdInfos = [],
|
|
MutualSemiPredProcIdInfos = []
|
|
else
|
|
SelfPredProcIdInfos = SelfPredProcIdInfos0,
|
|
MutualDetPredProcIdInfos = MutualDetPredProcIdInfos0,
|
|
MutualSemiPredProcIdInfos = MutualSemiPredProcIdInfos0
|
|
),
|
|
|
|
% Translate the procedures we cannot apply tail call optimization to.
|
|
list.foldl3(
|
|
ml_gen_proc(ProgressStream, ModuleInfo, Target, ConstStructMap,
|
|
no_tail_rec),
|
|
NonePredProcIdInfos, !FuncDefns, !GlobalData, !InSccMap),
|
|
|
|
% Translate the procedures to which we can apply only self-tail-call
|
|
% optimization.
|
|
list.foldl3(
|
|
ml_gen_proc(ProgressStream, ModuleInfo, Target, ConstStructMap,
|
|
self_tail_rec),
|
|
SelfPredProcIdInfos, !FuncDefns, !GlobalData, !InSccMap),
|
|
|
|
% Translate the procedures to which we can apply mutual-tail-call
|
|
% optimization as well.
|
|
DetTSCCDepInfo = build_proc_dependency_graph(ModuleInfo,
|
|
set.list_to_set(
|
|
list.map(project_pred_proc_id_info_id,
|
|
MutualDetPredProcIdInfos)),
|
|
only_tail_calls),
|
|
SemiTSCCDepInfo = build_proc_dependency_graph(ModuleInfo,
|
|
set.list_to_set(
|
|
list.map(project_pred_proc_id_info_id,
|
|
MutualSemiPredProcIdInfos)),
|
|
only_tail_calls),
|
|
get_bottom_up_sccs_with_entry_points(ModuleInfo, DetTSCCDepInfo,
|
|
DetTSCCEntries),
|
|
get_bottom_up_sccs_with_entry_points(ModuleInfo, SemiTSCCDepInfo,
|
|
SemiTSCCEntries),
|
|
partition_tsccs(DetTSCCEntries,
|
|
DetLonePredProcIds, DetNonTrivialTSCCEntries),
|
|
partition_tsccs(SemiTSCCEntries,
|
|
SemiLonePredProcIds, SemiNonTrivialTSCCEntries),
|
|
list.foldl3(
|
|
ml_gen_proc_lookup(ProgressStream, ModuleInfo, Target,
|
|
ConstStructMap, self_tail_rec),
|
|
DetLonePredProcIds, !FuncDefns, !GlobalData, !InSccMap),
|
|
list.foldl3(
|
|
ml_gen_proc_lookup(ProgressStream, ModuleInfo, Target,
|
|
ConstStructMap, self_tail_rec),
|
|
SemiLonePredProcIds, !FuncDefns, !GlobalData, !InSccMap),
|
|
list.foldl3(
|
|
ml_gen_tscc(ProgressStream, ModuleInfo, Target, ConstStructMap,
|
|
SCCEntryProcs, tscc_det),
|
|
DetNonTrivialTSCCEntries, !FuncDefns, !GlobalData, !InSccMap),
|
|
list.foldl3(
|
|
ml_gen_tscc(ProgressStream, ModuleInfo, Target, ConstStructMap,
|
|
SCCEntryProcs, tscc_semi),
|
|
SemiNonTrivialTSCCEntries, !FuncDefns, !GlobalData, !InSccMap)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
:- pred add_to_in_scc_map(pred_proc_id::in, in_scc_map::in, in_scc_map::out)
|
|
is det.
|
|
|
|
add_to_in_scc_map(PredProcId, !InSccMap) :-
|
|
InSccInfo = in_scc_info(not_in_tscc,
|
|
is_not_target_of_self_trcall, is_not_target_of_mutual_trcall, []),
|
|
map.det_insert(PredProcId, InSccInfo, !InSccMap).
|
|
|
|
:- pred reset_in_scc_map(in_scc_map::in, in_scc_map::out) is det.
|
|
|
|
reset_in_scc_map(!InSccMap) :-
|
|
map.map_values_only(reset_scc_info, !InSccMap).
|
|
|
|
:- pred reset_scc_info(in_scc_info::in, in_scc_info::out) is det.
|
|
|
|
reset_scc_info(!InSccInfo) :-
|
|
!InSccInfo ^ isi_maybe_in_tscc := not_in_tscc.
|
|
|
|
%---------------------%
|
|
|
|
:- type pred_proc_id_info
|
|
---> pred_proc_id_info(
|
|
pred_proc_id,
|
|
pred_info,
|
|
proc_info,
|
|
prog_context
|
|
).
|
|
|
|
:- func project_pred_proc_id_info_id(pred_proc_id_info) = pred_proc_id.
|
|
|
|
project_pred_proc_id_info_id(PredProcIdInfo) = PredProcId :-
|
|
PredProcIdInfo = pred_proc_id_info(PredProcId, _, _, _).
|
|
|
|
%---------------------%
|
|
|
|
% Partition the procedures in an SCC into the following four categories.
|
|
%
|
|
% - Those that don't contain any tail calls (NoneIdInfos).
|
|
% - Those that in which we can only optimize self recursive tail calls,
|
|
% either because they don't contain any mutually tail recursive calls,
|
|
% or because we can't (yet) optimize the mutually tail recursive calls
|
|
% they do contain (SelfIdInfos).
|
|
% - Those model_det procedures in which we can optimize mutually tail
|
|
% recursive calls (MutualDetIdInfos).
|
|
% - Those model_semi procedures in which we can optimize mutually tail
|
|
% recursive calls (MutualSemiIdInfos).
|
|
%
|
|
:- pred partition_scc_procs(module_info::in, list(pred_proc_id)::in,
|
|
list(pred_proc_id_info)::out, list(pred_proc_id_info)::out,
|
|
list(pred_proc_id_info)::out, list(pred_proc_id_info)::out) is det.
|
|
|
|
partition_scc_procs(_ModuleInfo, [], [], [], [], []).
|
|
partition_scc_procs(ModuleInfo, [PredProcId | PredProcIds],
|
|
!:NoneIdInfos, !:SelfIdInfos,
|
|
!:MutualDetIdInfos, !:MutualSemiIdInfos) :-
|
|
partition_scc_procs(ModuleInfo, PredProcIds,
|
|
!:NoneIdInfos, !:SelfIdInfos, !:MutualDetIdInfos, !:MutualSemiIdInfos),
|
|
module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, ProcInfo),
|
|
proc_info_get_goal(ProcInfo, Goal),
|
|
Goal = hlds_goal(_GoalExpr, GoalInfo),
|
|
ProcContext = goal_info_get_context(GoalInfo),
|
|
IdInfo = pred_proc_id_info(PredProcId, PredInfo, ProcInfo, ProcContext),
|
|
proc_info_get_has_tail_rec_call(ProcInfo, HasTailRecCall),
|
|
HasTailRecCall =
|
|
has_tail_rec_call(HasSelfTailRecCall, HasMutualTailRecCall),
|
|
CodeModel = proc_info_interface_code_model(ProcInfo),
|
|
(
|
|
( CodeModel = model_det
|
|
; CodeModel = model_semi
|
|
),
|
|
proc_info_interface_determinism(ProcInfo, Detism),
|
|
determinism_components(Detism, _CanFail, SolnCount),
|
|
( if
|
|
HasMutualTailRecCall = has_mutual_tail_rec_call,
|
|
% To prevent control just falling through to the next procedure
|
|
% body once it reaches the end of the previous procedure body
|
|
% in the TSCC, we put a goto or break statement at the end of each
|
|
% procedure body. This will generate an error from some target
|
|
% language compilers (e.g. Java) if its knows that this statement
|
|
% is not reachable.
|
|
SolnCount \= at_most_zero
|
|
then
|
|
(
|
|
CodeModel = model_det,
|
|
!:MutualDetIdInfos = [IdInfo | !.MutualDetIdInfos]
|
|
;
|
|
CodeModel = model_semi,
|
|
!:MutualSemiIdInfos = [IdInfo | !.MutualSemiIdInfos]
|
|
)
|
|
else
|
|
(
|
|
HasSelfTailRecCall = has_self_tail_rec_call,
|
|
!:SelfIdInfos = [IdInfo | !.SelfIdInfos]
|
|
;
|
|
HasSelfTailRecCall = has_no_self_tail_rec_call,
|
|
!:NoneIdInfos = [IdInfo | !.NoneIdInfos]
|
|
)
|
|
)
|
|
;
|
|
CodeModel = model_non,
|
|
% Mutual tail recursion optimization does not apply to model_non
|
|
% procedures (at least not yet). It would be nice to teach this module
|
|
% how to exploit such opportunities, but applying mutual tail recursion
|
|
% optimization to only det and semidet procedures does capture
|
|
% *almost all* of the available benefit.
|
|
(
|
|
HasSelfTailRecCall = has_self_tail_rec_call,
|
|
!:SelfIdInfos = [IdInfo | !.SelfIdInfos]
|
|
;
|
|
HasSelfTailRecCall = has_no_self_tail_rec_call,
|
|
!:NoneIdInfos = [IdInfo | !.NoneIdInfos]
|
|
)
|
|
).
|
|
|
|
:- pred partition_tsccs(list(scc_with_entry_points)::in,
|
|
list(pred_proc_id)::out, list(scc_with_entry_points)::out) is det.
|
|
|
|
partition_tsccs([], [], []).
|
|
partition_tsccs([TSCC | TSCCs], !:LonePredProcIds, !:NonTrivialTSCCS) :-
|
|
partition_tsccs(TSCCs, !:LonePredProcIds, !:NonTrivialTSCCS),
|
|
TSCC = scc_with_entry_points(TSCCPredProcIdsSet, _, _),
|
|
set.to_sorted_list(TSCCPredProcIdsSet, TSCCPredProcIds),
|
|
(
|
|
TSCCPredProcIds = [],
|
|
unexpected($pred, "empty TSCC")
|
|
;
|
|
TSCCPredProcIds = [TSCCPredProcId],
|
|
!:LonePredProcIds = [TSCCPredProcId | !.LonePredProcIds]
|
|
;
|
|
TSCCPredProcIds = [_, _ | _],
|
|
!:NonTrivialTSCCS = [TSCC | !.NonTrivialTSCCS]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Code for handling individual procedures.
|
|
%
|
|
|
|
:- pred ml_gen_proc_lookup(io.text_output_stream::in, module_info::in,
|
|
mlds_target_lang::in, ml_const_struct_map::in,
|
|
none_or_self_tail_rec::in, pred_proc_id::in,
|
|
list(mlds_function_defn)::in, list(mlds_function_defn)::out,
|
|
ml_global_data::in, ml_global_data::out,
|
|
in_scc_map::in, in_scc_map::out) is det.
|
|
|
|
ml_gen_proc_lookup(ProgressStream, ModuleInfo, Target, ConstStructMap,
|
|
NoneOrSelf, PredProcId, !FuncDefns, !GlobalData, !InSccMap) :-
|
|
module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, ProcInfo),
|
|
proc_info_get_goal(ProcInfo, Goal),
|
|
Goal = hlds_goal(_GoalExpr, GoalInfo),
|
|
ProcContext = goal_info_get_context(GoalInfo),
|
|
PredProcIdInfo =
|
|
pred_proc_id_info(PredProcId, PredInfo, ProcInfo, ProcContext),
|
|
ml_gen_proc(ProgressStream, ModuleInfo, Target, ConstStructMap,
|
|
NoneOrSelf, PredProcIdInfo, !FuncDefns, !GlobalData, !InSccMap).
|
|
|
|
%---------------------%
|
|
|
|
:- type none_or_self_tail_rec
|
|
---> no_tail_rec
|
|
; self_tail_rec.
|
|
|
|
:- pred ml_gen_proc(io.text_output_stream::in, module_info::in,
|
|
mlds_target_lang::in, ml_const_struct_map::in,
|
|
none_or_self_tail_rec::in, pred_proc_id_info::in,
|
|
list(mlds_function_defn)::in, list(mlds_function_defn)::out,
|
|
ml_global_data::in, ml_global_data::out,
|
|
in_scc_map::in, in_scc_map::out) is det.
|
|
|
|
ml_gen_proc(ProgressStream, ModuleInfo, Target, ConstStructMap, NoneOrSelf,
|
|
PredProcIdInfo, !FuncDefns, !GlobalData, !InSccMap) :-
|
|
PredProcIdInfo =
|
|
pred_proc_id_info(PredProcId, PredInfo, ProcInfo, ProcContext),
|
|
trace [io(!IO)] (
|
|
maybe_write_proc_progress_message(ProgressStream, ModuleInfo,
|
|
"Generating MLDS code for", PredProcId, !IO)
|
|
),
|
|
|
|
some [!Info] (
|
|
reset_in_scc_map(!InSccMap),
|
|
compute_initial_tail_rec_map_for_none_or_self(ModuleInfo, NoneOrSelf,
|
|
PredProcId, !InSccMap),
|
|
init_ml_gen_tscc_info(ModuleInfo, !.InSccMap, tscc_self_rec_only,
|
|
TsccInfo0),
|
|
!:Info = ml_gen_info_init(ModuleInfo, Target, ConstStructMap,
|
|
PredProcId, ProcInfo, !.GlobalData, TsccInfo0),
|
|
|
|
pred_info_get_status(PredInfo, PredStatus),
|
|
( if PredStatus = pred_status(status_external(_)) then
|
|
% For Mercury procedures declared `:- pragma external_{pred/func}',
|
|
% we generate an MLDS definition with no function body.
|
|
% The MLDS -> target code pass can treat this accordingly.
|
|
% For example, for C it outputs a function declaration with no
|
|
% corresponding definition, making sure that the function is
|
|
% declared as `extern' rather than `static'.
|
|
ml_gen_info_proc_params(PredProcId, _Tuples, FuncParams,
|
|
_ByRefOutputVars, _CopiedOutputVars, !.Info, _Info),
|
|
FuncBody = body_external,
|
|
set.init(EnvVarNames),
|
|
ClosureWrapperFuncDefns = []
|
|
else
|
|
% Set up the initial success continuation, if any.
|
|
% Also figure out which output variables are returned by value
|
|
% (rather than being passed by reference) and remove them from
|
|
% the byref_output_vars field in the ml_gen_info.
|
|
CodeModel = proc_info_interface_code_model(ProcInfo),
|
|
ml_gen_info_proc_params(PredProcId, ArgTuples, FuncParams,
|
|
ByRefOutputVars, CopiedOutputVars, !.Info, _Info),
|
|
set_of_var.list_to_set(ByRefOutputVars, ByRefOutputVarsSet),
|
|
ml_gen_info_set_byref_output_vars(ByRefOutputVarsSet, !Info),
|
|
(
|
|
( CodeModel = model_det
|
|
; CodeModel = model_semi
|
|
)
|
|
;
|
|
CodeModel = model_non,
|
|
list.map(get_var_mlds_lval_and_type(!.Info),
|
|
CopiedOutputVars, OutputVarLvalTypes),
|
|
ml_initial_cont(!.Info, OutputVarLvalTypes, InitialCont),
|
|
ml_gen_info_push_success_cont(InitialCont, !Info)
|
|
),
|
|
|
|
proc_info_get_goal(ProcInfo, Goal),
|
|
ml_gen_info_get_tail_rec_info(!.Info, TailRecInfo1),
|
|
TailRecInfo1 = tail_rec_info(InSccMap1, LoopKind1, TsccKind1),
|
|
map.lookup(InSccMap1, PredProcId, InSccInfo1),
|
|
MaybeInScc1 = InSccInfo1 ^ isi_maybe_in_tscc,
|
|
(
|
|
MaybeInScc1 = not_in_tscc,
|
|
map.init(SeenAtLabelMap)
|
|
;
|
|
MaybeInScc1 = in_tscc(IdInTscc, Args),
|
|
(
|
|
LoopKind1 = tail_rec_loop_while_continue,
|
|
(
|
|
TsccKind1 = tscc_self_rec_only,
|
|
map.init(SeenAtLabelMap)
|
|
;
|
|
TsccKind1 = tscc_self_and_mutual_rec,
|
|
unexpected($pred, "tscc_self_and_mutual_rec")
|
|
)
|
|
;
|
|
LoopKind1 = tail_rec_loop_label_goto,
|
|
StartLabel = generate_tail_rec_start_label(TsccKind1,
|
|
IdInTscc),
|
|
LocalVars = list.map(project_mlds_argument_name, Args),
|
|
SeenAtLabelMap =
|
|
map.singleton(StartLabel, set.list_to_set(LocalVars))
|
|
)
|
|
),
|
|
ml_gen_proc_body(CodeModel, ArgTuples, CopiedOutputVars, Goal,
|
|
SeenAtLabelMap, LocalVarDefns0, FuncDefns, GoalStmts0, !Info),
|
|
list.map(get_var_rval(!.Info),
|
|
CopiedOutputVars, CopiedOutputVarRvals),
|
|
ml_append_return_statement(CodeModel, ProcContext,
|
|
CopiedOutputVarRvals, GoalStmts0, GoalStmts),
|
|
ml_gen_local_var_defns_for_copied_output_vars(!.Info, ProcContext,
|
|
ArgTuples, CopiedOutputVars, OutputVarLocalDefns, !Info),
|
|
ml_gen_maybe_local_var_defn_for_succeeded(!.Info, ProcContext,
|
|
SucceededVarDefns),
|
|
LocalVarDefns = SucceededVarDefns ++ OutputVarLocalDefns ++
|
|
LocalVarDefns0,
|
|
|
|
ml_gen_info_final(!.Info, EnvVarNames,
|
|
ClosureWrapperFuncDefns, !:GlobalData, TsccInfo),
|
|
TailRecInfo = TsccInfo ^ mgti_tail_rec_info,
|
|
!:InSccMap = TailRecInfo ^ tri_in_scc_map,
|
|
construct_func_body_maybe_wrap_in_loop(PredProcId, CodeModel,
|
|
ProcContext, LocalVarDefns, FuncDefns, GoalStmts,
|
|
TailRecInfo, FuncBody)
|
|
)
|
|
),
|
|
|
|
construct_func_defn(ModuleInfo, PredProcIdInfo, FuncParams, FuncBody,
|
|
EnvVarNames, FuncDefn),
|
|
!:FuncDefns = ClosureWrapperFuncDefns ++ [FuncDefn | !.FuncDefns].
|
|
|
|
:- pred get_var_mlds_lval_and_type(ml_gen_info::in, prog_var::in,
|
|
pair(mlds_lval, mer_type)::out) is det.
|
|
|
|
get_var_mlds_lval_and_type(Info, Var, VarLval - VarType) :-
|
|
ml_gen_info_get_var_table(Info, VarTable),
|
|
lookup_var_entry(VarTable, Var, VarEntry),
|
|
ml_gen_var(Info, Var, VarEntry, VarLval),
|
|
VarType = VarEntry ^ vte_type.
|
|
|
|
:- pred get_var_rval(ml_gen_info::in, prog_var::in, mlds_rval::out) is det.
|
|
|
|
get_var_rval(Info, Var, VarRval) :-
|
|
ml_gen_var_direct(Info, Var, VarLval),
|
|
VarRval = ml_lval(VarLval).
|
|
|
|
:- pred compute_initial_tail_rec_map_for_none_or_self(module_info::in,
|
|
none_or_self_tail_rec::in, pred_proc_id::in,
|
|
in_scc_map::in, in_scc_map::out) is det.
|
|
|
|
compute_initial_tail_rec_map_for_none_or_self(ModuleInfo, NoneOrSelf,
|
|
PredProcId, !InSccMap) :-
|
|
(
|
|
NoneOrSelf = no_tail_rec
|
|
% Nothing to do.
|
|
;
|
|
NoneOrSelf = self_tail_rec,
|
|
InputParams =
|
|
ml_gen_proc_params_inputs_only_no_gc_stmts(ModuleInfo, PredProcId),
|
|
map.lookup(!.InSccMap, PredProcId, InSccInfo0),
|
|
InSccInfo = InSccInfo0 ^ isi_maybe_in_tscc :=
|
|
in_tscc(proc_id_in_tscc(1), InputParams),
|
|
map.det_update(PredProcId, InSccInfo, !InSccMap)
|
|
).
|
|
|
|
:- pred construct_func_body_maybe_wrap_in_loop(pred_proc_id::in,
|
|
code_model::in, prog_context::in, list(mlds_local_var_defn)::in,
|
|
list(mlds_function_defn)::in, list(mlds_stmt)::in, tail_rec_info::in,
|
|
mlds_function_body::out) is det.
|
|
|
|
construct_func_body_maybe_wrap_in_loop(PredProcId, CodeModel, Context,
|
|
LocalVarDefns, FuncDefns, GoalStmts, TailRecInfo, FuncBody) :-
|
|
TailRecInfo = tail_rec_info(InSccMap, LoopKind, TsccKind),
|
|
expect(unify(TsccKind, tscc_self_rec_only), $pred,
|
|
"TsccKind != tscc_self_rec_only"),
|
|
map.lookup(InSccMap, PredProcId, InSccInfo),
|
|
InSccInfo = in_scc_info(MaybeInTscc,
|
|
IsTargetOfSelfTRCall, _IsTargetOfMutualTRCall, _IsTargetOfNonTailRec),
|
|
( if
|
|
IsTargetOfSelfTRCall = is_target_of_self_trcall,
|
|
% We cannot have done self-tail-recursion if MaybeInTscc = not_in_tscc,
|
|
% though the compiler doesn't know that.
|
|
MaybeInTscc = in_tscc(IdInTscc, TsccInArgs)
|
|
then
|
|
( CodeModel = model_det, CodeModelStr = "model_det"
|
|
; CodeModel = model_semi, CodeModelStr = "model_semi"
|
|
; CodeModel = model_non, CodeModelStr = "model_non"
|
|
),
|
|
string.format("setup for %s tailcalls optimized into a loop",
|
|
[s(CodeModelStr)], CommentStr),
|
|
Comment = comment(CommentStr),
|
|
CommentStmt = ml_stmt_atomic(Comment, Context),
|
|
(
|
|
LoopKind = tail_rec_loop_while_continue,
|
|
BreakStmt = ml_stmt_goto(goto_break_loop, Context),
|
|
LoopBodyStmt = ml_stmt_block(LocalVarDefns, FuncDefns,
|
|
[CommentStmt] ++ GoalStmts ++ [BreakStmt], Context),
|
|
% Since TsccKind = tscc_self_rec_only, we don't need to include
|
|
% the procedure selector variable in the loop local vars.
|
|
InputArgLocalVars =
|
|
list.map(project_mlds_argument_name, TsccInArgs),
|
|
FuncBodyStmt = ml_stmt_while(may_loop_zero_times,
|
|
ml_const(mlconst_true), LoopBodyStmt,
|
|
InputArgLocalVars, Context)
|
|
;
|
|
LoopKind = tail_rec_loop_label_goto,
|
|
StartLabel = generate_tail_rec_start_label(TsccKind, IdInTscc),
|
|
LoopTopLabelStmt = ml_stmt_label(StartLabel, Context),
|
|
FuncBodyStmt = ml_stmt_block(LocalVarDefns, FuncDefns,
|
|
[CommentStmt, LoopTopLabelStmt] ++ GoalStmts, Context)
|
|
)
|
|
else
|
|
FuncBodyStmt =
|
|
ml_gen_block(LocalVarDefns, FuncDefns, GoalStmts, Context)
|
|
),
|
|
FuncBody = body_defined_here(FuncBodyStmt).
|
|
|
|
:- pred construct_func_defn(module_info::in, pred_proc_id_info::in,
|
|
mlds_func_params::in, mlds_function_body::in, set(string)::in,
|
|
mlds_function_defn::out) is det.
|
|
|
|
construct_func_defn(ModuleInfo, PredProcIdInfo, FuncParams, FuncBody,
|
|
EnvVarNames, FuncDefn) :-
|
|
PredProcIdInfo = pred_proc_id_info(PredProcId, _PredInfo, ProcInfo,
|
|
_ProcContext),
|
|
PredProcId = proc(PredId, ProcId),
|
|
ml_gen_proc_label(ModuleInfo, PredProcId, _ModuleName, PlainFuncName),
|
|
proc_info_get_context(ProcInfo, ProcContext),
|
|
DeclFlags = ml_gen_proc_decl_flags(ModuleInfo, PredId, ProcId),
|
|
Source = mlds_func_source_proc(PredProcId),
|
|
MaybeRequireTailrecInfoFD = no,
|
|
FuncDefn = mlds_function_defn(mlds_function_name(PlainFuncName),
|
|
ProcContext, DeclFlags, Source, FuncParams, FuncBody,
|
|
EnvVarNames, MaybeRequireTailrecInfoFD).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% Code for handling TSCCs (shorthand for via-tail-call SCCs, i.e. SCCs
|
|
% computed by taking only *tail* calls into account).
|
|
%
|
|
% The scheme followed by ml_gen_tscc and its subcontractors is documented
|
|
% in notes/mlds_tail_recursion.html.
|
|
%
|
|
|
|
:- type tscc_code_model
|
|
---> tscc_det
|
|
; tscc_semi.
|
|
|
|
:- pred ml_gen_tscc(io.text_output_stream::in, module_info::in,
|
|
mlds_target_lang::in, ml_const_struct_map::in, set(pred_proc_id)::in,
|
|
tscc_code_model::in, scc_with_entry_points::in,
|
|
list(mlds_function_defn)::in, list(mlds_function_defn)::out,
|
|
ml_global_data::in, ml_global_data::out,
|
|
in_scc_map::in, in_scc_map::out) is det.
|
|
|
|
ml_gen_tscc(ProgressStream, ModuleInfo, Target, ConstStructMap,
|
|
_SCCEntryPredProcIds, TsccCodeModel, TSCCE,
|
|
!FuncDefns, !GlobalData, !InSccMap) :-
|
|
TSCCE = scc_with_entry_points(PredProcIds, _CalledFromHigherTSCCs,
|
|
_ExportedTSCCPredProcIds),
|
|
PredProcIdList = set.to_sorted_list(PredProcIds),
|
|
(
|
|
PredProcIdList = [],
|
|
unexpected($pred, "empty TSCC")
|
|
;
|
|
PredProcIdList = [SinglePredProcId],
|
|
% For a TSCC containing just one procedure, we neither need nor want
|
|
% the extra overhead required for managing *mutual* tail recursion.
|
|
ml_gen_proc_lookup(ProgressStream, ModuleInfo, Target, ConstStructMap,
|
|
self_tail_rec, SinglePredProcId, !FuncDefns, !GlobalData,
|
|
!InSccMap)
|
|
;
|
|
PredProcIdList = [_, _ | _],
|
|
% Try to compile each procedure in the TSCC into the MLDS code
|
|
% fragment that will go under "top_of_proc_i" for each i.
|
|
%
|
|
% Caveat 1:
|
|
% By definition, every procedure in the TSCC has at least one
|
|
% mutually-tail-recursive call to it from another procedure
|
|
% in the TSCC. However, the TSCC is computed from the HLDS.
|
|
% Some calls that look like tail calls in the HLDS turn out
|
|
% *not* to be tail calls in the MLDS, because they pass as input
|
|
% arguments the addresses of local variables in the caller's stack
|
|
% frame, addresses that would become dangling references if the
|
|
% call were made a tail call. If it turns out that *none* of the
|
|
% mutually-tail-recursive calls in the HLDS to a procedure
|
|
% turn out to be mutually-tail-recursive calls in the MLDS,
|
|
% then including that procedure in the scheme we use above
|
|
% would be a waste; it would just incur overhead for no gain
|
|
% in either stack usage or speed. ml_gen_tscc_trial will return
|
|
% the identities of such procedures in NoMutualPredProcIds.
|
|
% All the procedures in MutualPredProcIds will have mutually-tail-
|
|
% recursive calls to them in the *M*LDS. (Therefore MutualPredProcIds
|
|
% may have 0 elements, or 2, or 3, or any other number except 1.)
|
|
%
|
|
% Caveat 2:
|
|
% If the MLDS code we generated for any of MutualPredProcIds contained
|
|
% any function definitions nested inside of them, then we have
|
|
% a problem. The scheme shown above would create M copies of each
|
|
% such nested function definition, with M > 1. In the usual case of
|
|
% us generating non-nested code, ml_elim_nested.m would hoist out
|
|
% such nested definitions M times, leading to the M copies of the
|
|
% hoisted-out definitions. Therefore, until we teach ml_elim_nested.m
|
|
% not to do that, we abandon the optimization of mutually recursive
|
|
% tail calls in the presence of such nested function definitions.
|
|
%
|
|
% Caveat 3.
|
|
% The code in mark_tail_calls.m looks for tail calls by looking
|
|
% at the argument lists of procedures. These argument lists treat
|
|
% a variable representing the result of functions the same as
|
|
% a variable representing the last argument of a predicate.
|
|
% On the other hand, on the C backend, the MLDS uses two *different*
|
|
% mechanisms to return these arguments; it returns function results
|
|
% via return statements, while it uses pass-by-reference for all
|
|
% other output arguments. Currently, ml_gen_tscc_trial handles this
|
|
% by returning CanGenerateTscc = can_not_generate_code_for_tscc
|
|
% if the procedures in the TSCC it is given don't all have the same
|
|
% vector of return values.
|
|
% XXX When a TSCC contains both predicates and functions, the two
|
|
% must present different signatures to their callers *outside* the
|
|
% TSCC, because those callers expect those different signatures.
|
|
% However, *inside* the TSCC, we could generate code that ignores
|
|
% the distinction, the obvious way of doing that being to use
|
|
% the tail call version of the calling convention intended for
|
|
% predicates for all intra-TSCC tail calls. However, using different
|
|
% conventions for intra- and inter-TSCC parameter passing would
|
|
% complicate the code both here and in ml_args_util.m, and for now
|
|
% at least, I (zs) don't see that the potential benefits justify
|
|
% the costs.
|
|
%
|
|
ml_gen_tscc_trial(ProgressStream, ModuleInfo, Target, ConstStructMap,
|
|
TsccCodeModel, PredProcIds, _NonTailEntryPredProcIds,
|
|
NoMutualPredProcIds, MutualPredProcIds, MutualPredProcCodes,
|
|
CanGenerateTscc, MutualEnvVarNames, MutualClosureWrapperFuncDefns,
|
|
LoopKind, !.InSccMap, TrialInSccMap,
|
|
!.GlobalData, TrialGlobalData),
|
|
(
|
|
CanGenerateTscc = can_not_generate_code_for_tscc,
|
|
OutsideTsccPredProcIds = PredProcIds
|
|
;
|
|
CanGenerateTscc = can_generate_code_for_tscc,
|
|
OutsideTsccPredProcIds = NoMutualPredProcIds,
|
|
!:InSccMap = TrialInSccMap,
|
|
!:GlobalData = TrialGlobalData,
|
|
|
|
% Caveat 4:
|
|
% XXX We SHOULD add to TSCCEntryPredProcIds the procedures in
|
|
% PredProcIds that are called from the procedures in SCC that are
|
|
% NOT in this TSCC. We do that for procedures that are in the
|
|
% SAME SET of TSCCs, but that leaves out the procedures that are
|
|
% in the OTHER set of TSCCs (one model_det, one model_semi),
|
|
% and the procedures that are not candidates for mutual tail
|
|
% recursion optimization. Until we fix that, we can't intersect
|
|
% MutualPredProcIds with MutualEntryPredProcIds before passing
|
|
% its list form to list.map below.
|
|
%
|
|
% This means that the commented-out code below calculating
|
|
% the various kinds of entry procedures can't (yet) be used.
|
|
% TSCCEntryPredProcIds =
|
|
% set.union(CalledFromHigherTSCCs, ExportedTSCCPredProcIds),
|
|
% SCCEntryPredProcIdsInTSCC =
|
|
% set.intersect(PredProcIds, SCCEntryPredProcIds),
|
|
% ExternalEntryPredProcIds =
|
|
% set.union(SCCEntryPredProcIdsInTSCC, TSCCEntryPredProcIds),
|
|
%
|
|
% MutualEntryPredProcIds =
|
|
% set.difference(
|
|
% set.union(ExternalEntryPredProcIds,
|
|
% NonTailEntryPredProcIds),
|
|
% NoMutualPredProcIds),
|
|
% some [!StartCommentStmts] (
|
|
% !:StartCommentStmts = [],
|
|
% describe_pred_proc_ids(ModuleInfo,
|
|
% "TSCC PredProcIds", PredProcIds,
|
|
% !StartCommentStmts),
|
|
% describe_pred_proc_ids(ModuleInfo,
|
|
% "TSCCEntryPredProcIds", TSCCEntryPredProcIds,
|
|
% !StartCommentStmts),
|
|
% describe_pred_proc_ids(ModuleInfo,
|
|
% "ExternalEntryPredProcIds", ExternalEntryPredProcIds,
|
|
% !StartCommentStmts),
|
|
% describe_pred_proc_ids(ModuleInfo,
|
|
% "NonTailEntryPredProcIds", NonTailEntryPredProcIds,
|
|
% !StartCommentStmts),
|
|
% describe_pred_proc_ids(ModuleInfo,
|
|
% "MutualEntryPredProcIds", MutualEntryPredProcIds,
|
|
% !StartCommentStmts),
|
|
% BlankStmt = ml_stmt_atomic(comment(""), term.context_init),
|
|
% !:StartCommentStmts = !.StartCommentStmts ++ [BlankStmt],
|
|
% StartCommentStmts = !.StartCommentStmts
|
|
% ),
|
|
StartCommentStmts = [],
|
|
|
|
list.map(
|
|
construct_tscc_entry_proc(ProgressStream, ModuleInfo, LoopKind,
|
|
MutualPredProcCodes, MutualEnvVarNames, StartCommentStmts),
|
|
set.to_sorted_list(MutualPredProcIds), TSCCFuncDefns),
|
|
!:FuncDefns = MutualClosureWrapperFuncDefns ++ TSCCFuncDefns ++
|
|
!.FuncDefns
|
|
),
|
|
|
|
list.foldl3(
|
|
ml_gen_proc_lookup(ProgressStream, ModuleInfo, Target,
|
|
ConstStructMap, self_tail_rec),
|
|
set.to_sorted_list(OutsideTsccPredProcIds),
|
|
!FuncDefns, !GlobalData, !InSccMap)
|
|
).
|
|
|
|
:- type can_we_generate_code_for_tscc
|
|
---> can_not_generate_code_for_tscc
|
|
; can_generate_code_for_tscc.
|
|
|
|
% Generate a representation of the codes to go under each "top_of_proc_i"
|
|
% label in the scheme above, but also return the information our caller
|
|
% needs to prepare for handling caveats 1 and 2.
|
|
%
|
|
:- pred ml_gen_tscc_trial(io.text_output_stream::in, module_info::in,
|
|
mlds_target_lang::in, ml_const_struct_map::in, tscc_code_model::in,
|
|
set(pred_proc_id)::in, set(pred_proc_id)::out,
|
|
set(pred_proc_id)::out, set(pred_proc_id)::out, list(pred_proc_code)::out,
|
|
can_we_generate_code_for_tscc::out, set(string)::out,
|
|
list(mlds_function_defn)::out, tail_rec_loop_kind::out,
|
|
in_scc_map::in, in_scc_map::out,
|
|
ml_global_data::in, ml_global_data::out) is det.
|
|
|
|
ml_gen_tscc_trial(ProgressStream, ModuleInfo, Target, ConstStructMap,
|
|
TsccCodeModel, PredProcIds, NonTailEntryPredProcIds,
|
|
NoMutualPredProcIds, MutualPredProcIds, MutualPredProcCodes,
|
|
CanGenerateTscc, MutualEnvVarNames,
|
|
MutualClosureWrapperFuncDefns, LoopKind, !InSccMap, !GlobalData) :-
|
|
% Compute the information we need for generating tail calls
|
|
% to any of the procedures in the TSCC.
|
|
reset_in_scc_map(!InSccMap),
|
|
list.map_foldl6(compute_initial_tail_rec_map_for_mutual(ModuleInfo),
|
|
set.to_sorted_list(PredProcIds), PredProcIdArgsInfos,
|
|
1, _, maybe.no, _, can_generate_code_for_tscc, CanGenerateTscc0,
|
|
map.init, _OutArgNames, !InSccMap, map.init, SeenAtLabelMap),
|
|
|
|
% Translate each procedure in the TSCC into a representation of the
|
|
% code that will go under "top_of_proc_i".
|
|
init_ml_gen_tscc_info(ModuleInfo, !.InSccMap, tscc_self_and_mutual_rec,
|
|
TsccInfo0),
|
|
list.map_foldl2(
|
|
ml_gen_tscc_proc_code(ProgressStream, ModuleInfo, Target,
|
|
ConstStructMap, TsccCodeModel, SeenAtLabelMap),
|
|
PredProcIdArgsInfos, PredProcCodes,
|
|
!GlobalData, TsccInfo0, TsccInfo),
|
|
|
|
TailRecInfo = TsccInfo ^ mgti_tail_rec_info,
|
|
!:InSccMap = TailRecInfo ^ tri_in_scc_map,
|
|
LoopKind = TailRecInfo ^ tri_loop_kind,
|
|
map.foldl2(accumulate_entry_procs, !.InSccMap,
|
|
set.init, NonTailEntryPredProcIds, set.init, NoMutualPredProcIds0),
|
|
% Returning NoMutualPredProcIds separately from MutualPredProcIds
|
|
% handles caveat 1.
|
|
separate_mutually_recursive_procs(NoMutualPredProcIds0, PredProcCodes,
|
|
NoMutualPredProcIds, MutualPredProcIds, MutualPredProcCodes,
|
|
MutualContainsNestedFuncs, MutualClosureWrapperFuncDefns,
|
|
MutualEnvVarNames),
|
|
|
|
( if
|
|
% Handle caveat 2.
|
|
MutualContainsNestedFuncs = does_not_contain_nested_funcs,
|
|
% Handle caveat 3.
|
|
CanGenerateTscc0 = can_generate_code_for_tscc
|
|
then
|
|
CanGenerateTscc = can_generate_code_for_tscc
|
|
else
|
|
CanGenerateTscc = can_not_generate_code_for_tscc
|
|
).
|
|
|
|
:- pred accumulate_entry_procs(pred_proc_id::in, in_scc_info::in,
|
|
set(pred_proc_id)::in, set(pred_proc_id)::out,
|
|
set(pred_proc_id)::in, set(pred_proc_id)::out) is det.
|
|
|
|
accumulate_entry_procs(PredProcId, InSccInfo,
|
|
!NonTailEntryPredProcIds, !NoMutualTailRecPredProcIds) :-
|
|
IsTargetOfNonTRCalls = InSccInfo ^ isi_is_target_of_non_tail_rec,
|
|
(
|
|
IsTargetOfNonTRCalls = []
|
|
;
|
|
IsTargetOfNonTRCalls = [_ | _],
|
|
set.insert(PredProcId, !NonTailEntryPredProcIds)
|
|
),
|
|
IsTargetOfMutualTRCall = InSccInfo ^ isi_is_target_of_mutual_tr,
|
|
(
|
|
IsTargetOfMutualTRCall = is_not_target_of_mutual_trcall,
|
|
set.insert(PredProcId, !NoMutualTailRecPredProcIds)
|
|
;
|
|
IsTargetOfMutualTRCall = is_target_of_mutual_trcall
|
|
).
|
|
|
|
% separate_mutually_recursive_procs(NoMutualTailRecProcs, PredProcCodes,
|
|
% NoMutualPredProcIds, MutualPredProcIds, MutualPredProcCodes,
|
|
% MutualContainsNestedFuncs, MutualClosureWrapperFuncDefns,
|
|
% MutualEnvVarNames, MutualTailRecSpecs):
|
|
%
|
|
% Given a list of procedures we have generated code for (PredProcCodes),
|
|
% divide the procedures in it into two partitions: those whose ids
|
|
% occur in NoMutualTailRecProcs, whose ids are returned in
|
|
% NoMutualPredProcIds, and those whose ids do not occur there
|
|
% whose ids are returned in MutualPredProcIds, and whose other info
|
|
% is returned in the other output arguments whose names start with Mutual.
|
|
%
|
|
:- pred separate_mutually_recursive_procs(set(pred_proc_id)::in,
|
|
list(pred_proc_code)::in,
|
|
set(pred_proc_id)::out, set(pred_proc_id)::out, list(pred_proc_code)::out,
|
|
maybe_contains_nested_funcs::out, list(mlds_function_defn)::out,
|
|
set(string)::out) is det.
|
|
|
|
separate_mutually_recursive_procs(_NoMutualTailRecProcs, [],
|
|
set.init, set.init, [], does_not_contain_nested_funcs, [], set.init).
|
|
separate_mutually_recursive_procs(NoMutualTailRecProcs,
|
|
[PredProcCode | PredProcCodes],
|
|
!:NoMutualPredProcIds, !:MutualPredProcIds, !:MutualPredProcCodes,
|
|
!:MutualContainsNestedFuncs, !:MutualClosureWrapperFuncDefns,
|
|
!:MutualEnvVarNames) :-
|
|
separate_mutually_recursive_procs(NoMutualTailRecProcs, PredProcCodes,
|
|
!:NoMutualPredProcIds, !:MutualPredProcIds, !:MutualPredProcCodes,
|
|
!:MutualContainsNestedFuncs, !:MutualClosureWrapperFuncDefns,
|
|
!:MutualEnvVarNames),
|
|
PredProcCode = pred_proc_code(PredProcIdArgsInfo,
|
|
_FuncParams, _LocalVarDefns, FuncDefns, DescCommentStmt, GoalStmts,
|
|
ProcClosureWrapperFuncDefns, ProcEnvVarNames),
|
|
PredProcId = PredProcIdArgsInfo ^ ppiai_pred_proc_id,
|
|
( if set.member(PredProcId, NoMutualTailRecProcs) then
|
|
set.insert(PredProcId, !NoMutualPredProcIds)
|
|
else
|
|
( if
|
|
(
|
|
FuncDefns = [_ | _]
|
|
;
|
|
list.foldl(does_stmt_contain_nested_func_defn,
|
|
[DescCommentStmt | GoalStmts],
|
|
does_not_contain_nested_funcs, ContainsNestedFuncs),
|
|
ContainsNestedFuncs = contains_nested_funcs
|
|
)
|
|
then
|
|
!:MutualContainsNestedFuncs = contains_nested_funcs
|
|
else
|
|
true
|
|
),
|
|
set.insert(PredProcId, !MutualPredProcIds),
|
|
!:MutualPredProcCodes = [PredProcCode | !.MutualPredProcCodes],
|
|
!:MutualClosureWrapperFuncDefns =
|
|
ProcClosureWrapperFuncDefns ++ !.MutualClosureWrapperFuncDefns,
|
|
set.union(ProcEnvVarNames, !MutualEnvVarNames)
|
|
).
|
|
|
|
% The pred_proc_id_args_info structure contains the information we generate
|
|
% about a procedure's arguments. We set this up *before* we generate code
|
|
% for any procedure in the TSCC, because any procedure may contain tail
|
|
% recursive calls to any other procedure in the TSCC, and to generate
|
|
% the right code for such tail recursive calls, we need to know the
|
|
% sequence of the *input* arguments of the callee.
|
|
%
|
|
% That sequence is not stored here; since it is needed *only* for
|
|
% generating code for tail calls, it is stored in the data structure
|
|
% used for that purpose (the tail_rec_info slot of the ml_gen_info).
|
|
% However, when we compute this sequence, it is convenient to compute,
|
|
% at the same time, all the *other* information we will need later
|
|
% about the procedure's arguments, and that is what is stored here.
|
|
:- type pred_proc_id_args_info
|
|
---> pred_proc_id_args_info(
|
|
% Various aspects of the identity of this procedure.
|
|
ppiai_pred_proc_id :: pred_proc_id,
|
|
ppiai_pred_info :: pred_info,
|
|
ppiai_proc_info :: proc_info,
|
|
ppiai_proc_context :: prog_context,
|
|
ppiai_id_in_tscc :: proc_id_in_tscc,
|
|
|
|
% The variable names of the procedure's arguments,
|
|
% their types and modes.
|
|
ppiai_arg_tuples :: list(var_mvar_type_mode),
|
|
|
|
% Argument definitions for the TSCC variables for all
|
|
% the arguments of the procedure, both input and output,
|
|
% in their original order, and the types of the returned
|
|
% arguments.
|
|
ppiai_tscc_func_params :: mlds_func_params,
|
|
|
|
% The vector of rvals to return in the procedure's return
|
|
% statement, together with their types.
|
|
ppiai_return_rvals_types :: assoc_list(mlds_rval,
|
|
mlds_type),
|
|
|
|
% The lvn_tscc_proc_input_var variables for the input arguments
|
|
% of procedure i in the TSCC will be defined
|
|
%
|
|
% - in the argument list of the MLDS function,
|
|
% if the MLDS function is for procedure j with i = j; and
|
|
%
|
|
% - at the top of the body of the MLDS function,
|
|
% if the MLDS function is for procedure j with i != j.
|
|
%
|
|
% The lvn_tscc_output_var variables for the byref output
|
|
% arguments will always be defined in the argument list
|
|
% of the MLDS function. The tscc variables for the copied-out
|
|
% output arguments will always be defined at the top of
|
|
% the body of the MLDS function.
|
|
|
|
% Local variable definitions of the own variables for
|
|
% all the arguments of the procedure. These go at the top
|
|
% of the wrapped procedure.
|
|
ppiai_own_local_var_defns :: list(mlds_local_var_defn),
|
|
|
|
% Local variable definitions of the tscc variables
|
|
% for the input arguments of the procedure only.
|
|
% These go at the top of the container function
|
|
% for every procedure *other* than this one.
|
|
% (In the container function for this procedure,
|
|
% the variables that these would define are defined
|
|
% in the function's signature instead.)
|
|
ppiai_tscc_in_local_var_defns :: list(mlds_local_var_defn),
|
|
|
|
% The names of the variables defined in the previous field.
|
|
% Needed in some cases for transmission to ml_unused_assign.m.
|
|
ppiai_tscc_in_local_vars :: list(mlds_local_var_name),
|
|
|
|
% Local variable definitions of the tscc out variables
|
|
% for the output arguments of the procedure only.
|
|
% These go at the top of this procedure's container function.
|
|
% (The container procedure of every other function
|
|
% will have its own identical list of definitions.)
|
|
ppiai_tscc_out_value_local_var_defns
|
|
:: list(mlds_local_var_defn),
|
|
|
|
% Statements that, for each input argument of the procedure,
|
|
% assign the tscc in variable for that argument to the own
|
|
% variable for that argument. These statements go at the
|
|
% top of the wrapped procedure.
|
|
ppiai_copy_tscc_in_to_own_copy :: list(mlds_stmt),
|
|
|
|
% Statements that, for each output argument of the procedure
|
|
% (including the implicit argument for success indication
|
|
% in model semi procedures), assign the own variable for that
|
|
% argument to the tscc out variable for that argument.
|
|
% These statements go at the end of the wrapped procedure.
|
|
ppiai_copy_own_to_tscc_out_copy :: list(mlds_stmt),
|
|
|
|
% Statements that, for each output argument of the procedure
|
|
% that is returned by reference, store the value computed
|
|
% for the argument (in the argument's tscc out variable)
|
|
% in the memory location that the argument's tscc out ptr
|
|
% variable indicates is where that argument should be put.
|
|
% These statements go at the end of the container procedure.
|
|
ppiai_copy_out_through_ptr :: list(mlds_stmt)
|
|
).
|
|
|
|
% Compute the map that tells the code generator how to translate
|
|
% tail recursive calls to any procedure in the TSCC, and return
|
|
% the other information about the argument lists of the procedures in the
|
|
% TSCC that is convenient to compute at the same time.
|
|
%
|
|
:- pred compute_initial_tail_rec_map_for_mutual(module_info::in,
|
|
pred_proc_id::in, pred_proc_id_args_info::out, int::in, int::out,
|
|
maybe(assoc_list(mlds_local_var_name, mlds_type))::in,
|
|
maybe(assoc_list(mlds_local_var_name, mlds_type))::out,
|
|
can_we_generate_code_for_tscc::in, can_we_generate_code_for_tscc::out,
|
|
map(int, string)::in, map(int, string)::out,
|
|
in_scc_map::in, in_scc_map::out,
|
|
seen_at_label_map::in, seen_at_label_map::out) is det.
|
|
|
|
compute_initial_tail_rec_map_for_mutual(ModuleInfo,
|
|
PredProcId, PredProcIdArgsInfo, !ProcNum, !MaybeOutVarsTypes,
|
|
!CanGenerateTscc, !OutArgNames, !InSccMap, !SeenAtLabelMap) :-
|
|
ThisProcNum = !.ProcNum,
|
|
IdInTscc = proc_id_in_tscc(ThisProcNum),
|
|
!:ProcNum = !.ProcNum + 1,
|
|
|
|
module_info_pred_proc_info(ModuleInfo, PredProcId, PredInfo, ProcInfo),
|
|
pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
|
|
CodeModel = proc_info_interface_code_model(ProcInfo),
|
|
proc_info_get_var_table(ProcInfo, VarTable),
|
|
proc_info_get_headvars(ProcInfo, HeadVars),
|
|
pred_info_get_arg_types(PredInfo, HeadTypes),
|
|
proc_info_get_argmodes(ProcInfo, HeadModes),
|
|
|
|
proc_info_get_goal(ProcInfo, Goal),
|
|
Goal = hlds_goal(_GoalExpr, GoalInfo),
|
|
ProcContext = goal_info_get_context(GoalInfo),
|
|
|
|
ml_gen_tscc_arg_params(ModuleInfo, PredOrFunc, CodeModel,
|
|
ProcContext, IdInTscc, VarTable, HeadVars, HeadTypes, HeadModes,
|
|
ArgTuples, !OutArgNames,
|
|
TsccInArgs, FuncParams, ReturnRvalsTypes, OutVarsTypes,
|
|
OwnLocalVarDefns, TsccInLocalVarDefns, TsccValueLocalVarDefns,
|
|
CopyTsccToOwnStmts, CopyOwnToTsccStmts, CopyOutValThroughPtrStmts),
|
|
TsccInLocalVars = list.map(
|
|
(func(LocalVarDefn) = LocalVarDefn ^ mlvd_name), TsccInLocalVarDefns),
|
|
(
|
|
!.MaybeOutVarsTypes = no,
|
|
!:MaybeOutVarsTypes = yes(OutVarsTypes)
|
|
;
|
|
!.MaybeOutVarsTypes = yes(OldOutVarsTypes),
|
|
( if OutVarsTypes = OldOutVarsTypes then
|
|
true
|
|
else
|
|
% The different procedures in the TSCC have different vectors of
|
|
% output arguments.
|
|
!:CanGenerateTscc = can_not_generate_code_for_tscc
|
|
)
|
|
),
|
|
PredProcIdArgsInfo = pred_proc_id_args_info(PredProcId, PredInfo, ProcInfo,
|
|
ProcContext, IdInTscc, ArgTuples, FuncParams, ReturnRvalsTypes,
|
|
OwnLocalVarDefns, TsccInLocalVarDefns, TsccInLocalVars,
|
|
TsccValueLocalVarDefns, CopyTsccToOwnStmts, CopyOwnToTsccStmts,
|
|
CopyOutValThroughPtrStmts),
|
|
map.lookup(!.InSccMap, PredProcId, InSccInfo0),
|
|
InSccInfo = InSccInfo0 ^ isi_maybe_in_tscc :=
|
|
in_tscc(IdInTscc, TsccInArgs),
|
|
map.det_update(PredProcId, InSccInfo, !InSccMap),
|
|
TsccKind = tscc_self_and_mutual_rec,
|
|
StartLabel = generate_tail_rec_start_label(TsccKind, IdInTscc),
|
|
map.det_insert(StartLabel, set.list_to_set(TsccInLocalVars),
|
|
!SeenAtLabelMap).
|
|
|
|
% Each value of this type records the results of invoking the code
|
|
% generator on the body of procedure in a TSCC.
|
|
%
|
|
:- type pred_proc_code
|
|
---> pred_proc_code(
|
|
ppc_id_args_info :: pred_proc_id_args_info,
|
|
ppc_func_params :: mlds_func_params,
|
|
ppc_local_var_defns :: list(mlds_local_var_defn),
|
|
ppc_local_func_defns :: list(mlds_function_defn),
|
|
ppc_desc_comment_stmt :: mlds_stmt,
|
|
ppc_goal_stmts :: list(mlds_stmt),
|
|
ppc_closure_wrapper_funcs :: list(mlds_function_defn),
|
|
ppc_env_var_names :: set(string)
|
|
).
|
|
|
|
% Translate the body of the given procedure to MLDS, and return the
|
|
% results in a form that our caller can join together with the MLDS code
|
|
% we get for the *other* procedures in the TSCC.
|
|
%
|
|
:- pred ml_gen_tscc_proc_code(io.text_output_stream::in, module_info::in,
|
|
mlds_target_lang::in, ml_const_struct_map::in, tscc_code_model::in,
|
|
seen_at_label_map::in, pred_proc_id_args_info::in, pred_proc_code::out,
|
|
ml_global_data::in, ml_global_data::out,
|
|
ml_gen_tscc_info::in, ml_gen_tscc_info::out) is det.
|
|
|
|
ml_gen_tscc_proc_code(ProgressStream, ModuleInfo, Target, ConstStructMap,
|
|
TsccCodeModel, SeenAtLabelMap, PredProcIdArgsInfo, PredProcCode,
|
|
!GlobalData, !TsccInfo) :-
|
|
PredProcIdArgsInfo = pred_proc_id_args_info(PredProcId, PredInfo, ProcInfo,
|
|
ProcContext, ProcIdInTscc, ArgTuples, _FuncParams, _ReturnRvalsTypes,
|
|
_OwnLocalVarDefns, _TsscInLocalVarDefns, _TsscInLocalVars,
|
|
_TsccOutLocalVarDefns, _CopyTsccInToOwnStmts, _CopyOwnToTsccOutStmts,
|
|
_CopyOutValThroughPtrStmts),
|
|
|
|
trace [io(!IO)] (
|
|
maybe_write_proc_progress_message(ProgressStream, ModuleInfo,
|
|
"Generating in-TSCC MLDS code for", PredProcId, !IO)
|
|
),
|
|
|
|
some [!Info] (
|
|
!:Info = ml_gen_info_init(ModuleInfo, Target, ConstStructMap,
|
|
PredProcId, ProcInfo, !.GlobalData, !.TsccInfo),
|
|
|
|
pred_info_get_status(PredInfo, PredStatus),
|
|
( if PredStatus = pred_status(status_external(_)) then
|
|
% External predicates don't have bodies, so they can't contain
|
|
% tail calls (or any other kind of calls), so they cannot be
|
|
% in a non-singleton TSCC.
|
|
unexpected($pred, "status_external")
|
|
else
|
|
true
|
|
),
|
|
|
|
PredProcId = proc(_PredId, ProcId),
|
|
ProcDesc = describe_proc(include_module_name, PredInfo, ProcId),
|
|
ProcIdInTscc = proc_id_in_tscc(ProcNumInTscc),
|
|
ProcDescComment = string.format("proc %d in TSCC: %s",
|
|
[i(ProcNumInTscc), s(ProcDesc)]),
|
|
CommentStmt = ml_stmt_atomic(comment(ProcDescComment), ProcContext),
|
|
|
|
ml_gen_info_proc_params(PredProcId, ProcArgTuples, FuncParams,
|
|
ByRefOutputVars, CopiedOutputVars0, !Info),
|
|
expect(unify(ArgTuples, ProcArgTuples), $pred,
|
|
"ArgTuples != ProcArgTuples"),
|
|
% The container procedure will take care of any output arguments
|
|
% returned by reference. The wrapped procedures return the values
|
|
% of all output arguments to the container functions by value,
|
|
% so set up the code generator state accordingly.
|
|
CopiedOutputVars = ByRefOutputVars ++ CopiedOutputVars0,
|
|
set_of_var.init(ByRefOutputVarsSet),
|
|
ml_gen_info_set_byref_output_vars(ByRefOutputVarsSet, !Info),
|
|
(
|
|
TsccCodeModel = tscc_det,
|
|
CodeModel = model_det,
|
|
InitSucceededStmts = []
|
|
;
|
|
TsccCodeModel = tscc_semi,
|
|
CodeModel = model_semi,
|
|
% In some model_semi predicates, the only goal in their body
|
|
% that can fail is a tail recursive call. The InitSucceededStmt
|
|
% ensures that the success indicator variable (a) gets declared,
|
|
% and (b) contains a meaningful and correct value on execution
|
|
% paths that don't include the tail recursive call.
|
|
ml_gen_set_success(ml_const(mlconst_true), ProcContext,
|
|
InitSucceededStmt, !Info),
|
|
InitSucceededStmts = [InitSucceededStmt]
|
|
),
|
|
proc_info_get_goal(ProcInfo, Goal),
|
|
ml_gen_proc_body(CodeModel, ArgTuples, CopiedOutputVars, Goal,
|
|
SeenAtLabelMap, LocalVarDefns0, FuncDefns, GoalStmts0, !Info),
|
|
GoalStmts = InitSucceededStmts ++ GoalStmts0,
|
|
ml_gen_maybe_local_var_defn_for_succeeded(!.Info, ProcContext,
|
|
SucceededVarDefns),
|
|
LocalVarDefns = SucceededVarDefns ++ LocalVarDefns0,
|
|
|
|
ml_gen_info_final(!.Info, EnvVarNames,
|
|
ClosureWrapperFuncDefns, !:GlobalData, !:TsccInfo),
|
|
|
|
PredProcCode = pred_proc_code(PredProcIdArgsInfo, FuncParams,
|
|
LocalVarDefns, FuncDefns, CommentStmt, GoalStmts,
|
|
ClosureWrapperFuncDefns, EnvVarNames)
|
|
).
|
|
|
|
% Given the results of translating each procedure in a TSCC into MLDS code,
|
|
% wrap them up in an MLDS function that implements EntryProc.
|
|
%
|
|
:- pred construct_tscc_entry_proc(io.text_output_stream::in, module_info::in,
|
|
tail_rec_loop_kind::in, list(pred_proc_code)::in, set(string)::in,
|
|
list(mlds_stmt)::in, pred_proc_id::in, mlds_function_defn::out) is det.
|
|
|
|
construct_tscc_entry_proc(ProgressStream, ModuleInfo, LoopKind, PredProcCodes,
|
|
EnvVarNames, EntryProcDescComments, EntryProc, FuncDefn) :-
|
|
trace [io(!IO)] (
|
|
maybe_write_proc_progress_message(ProgressStream, ModuleInfo,
|
|
"Generating MLDS code for", EntryProc, !IO)
|
|
),
|
|
|
|
list.map_foldl2(construct_func_body_for_tscc(EntryProc),
|
|
PredProcCodes, ProcStmtInfos,
|
|
no, MaybeEntryProcInfo, [], NonEntryTsccInLocalVarDefns),
|
|
(
|
|
MaybeEntryProcInfo = no,
|
|
unexpected($pred, "MaybeEntryProcInfo = no")
|
|
;
|
|
MaybeEntryProcInfo = yes(EntryProcInfo),
|
|
EntryProcInfo = entry_proc_info(EntryIdInTscc, EntryPredProcIdInfo,
|
|
EntryProcParams, EntryReturnRvalsTypes,
|
|
EntryTsccOutLocalVarDefns, EntryCopyOutValThroughPtrStmts),
|
|
assoc_list.keys(EntryReturnRvalsTypes, EntryReturnRvals)
|
|
),
|
|
EntryPredProcIdInfo = pred_proc_id_info(_EntryPredProcId,
|
|
_EntryPredInfo, _EntryProcInfo, EntryProcContext),
|
|
make_container_proc(LoopKind, EntryCopyOutValThroughPtrStmts,
|
|
EntryReturnRvals, EntryIdInTscc, EntryProcContext, ProcStmtInfos,
|
|
ContainerVarDefns, Stmts),
|
|
FuncBodyLocalVarDefns = ContainerVarDefns ++
|
|
NonEntryTsccInLocalVarDefns ++ EntryTsccOutLocalVarDefns,
|
|
|
|
EntryIdInTscc = proc_id_in_tscc(EntryIdInTsccNum),
|
|
EntryProcDesc = describe_proc_from_id(include_module_name,
|
|
ModuleInfo, EntryProc),
|
|
Comment0 = string.format("The code for TSCC PROC %d: %s.",
|
|
[i(EntryIdInTsccNum), s(EntryProcDesc)]),
|
|
CommentStmt0 = ml_stmt_atomic(comment(Comment0), EntryProcContext),
|
|
Comment1 = "Setup for mutual tailcalls optimized into a loop.",
|
|
CommentStmt1 = ml_stmt_atomic(comment(Comment1), EntryProcContext),
|
|
Comment2 = "The mutually recursive procedures are:",
|
|
CommentStmt2 = ml_stmt_atomic(comment(Comment2), EntryProcContext),
|
|
EmptyComment = comment(""),
|
|
EmptyCommentStmt = ml_stmt_atomic(EmptyComment, EntryProcContext),
|
|
ProcDescCommentStmts =
|
|
list.map(func(PPC) = PPC ^ ppc_desc_comment_stmt, PredProcCodes),
|
|
|
|
FuncBodyStmts =
|
|
[CommentStmt0, CommentStmt1, CommentStmt2, EmptyCommentStmt
|
|
| ProcDescCommentStmts]
|
|
++ [EmptyCommentStmt | EntryProcDescComments] ++ Stmts,
|
|
|
|
FuncBodyStmt = ml_stmt_block(FuncBodyLocalVarDefns, [],
|
|
FuncBodyStmts, EntryProcContext),
|
|
FuncBody = body_defined_here(FuncBodyStmt),
|
|
construct_func_defn(ModuleInfo, EntryPredProcIdInfo, EntryProcParams,
|
|
FuncBody, EnvVarNames, FuncDefn).
|
|
|
|
:- type entry_proc_info
|
|
---> entry_proc_info(
|
|
proc_id_in_tscc,
|
|
pred_proc_id_info,
|
|
mlds_func_params,
|
|
assoc_list(mlds_rval, mlds_type),
|
|
list(mlds_local_var_defn),
|
|
list(mlds_stmt)
|
|
).
|
|
|
|
:- type proc_stmt_info
|
|
---> proc_stmt_info(
|
|
proc_id_in_tscc,
|
|
list(mlds_local_var_name), % The TSCC input arguments.
|
|
mlds_stmt,
|
|
prog_context
|
|
).
|
|
|
|
% Given PredProcCode, the results of translating procedure PredProcId
|
|
% in a TSCC into MLDS code, stitch these results together in a way
|
|
% that is appropriate to go under the "top_of_proc_i" for PredProcId
|
|
% in the MLDS function that implements EntryProc.
|
|
%
|
|
% Some aspects of the appropriate form depend on whether PredProcId =
|
|
% EntryProc, so we cannot put the same code under "top_of_proc_i"
|
|
% in *all* the MLDS functions we generate for a TSCC.
|
|
%
|
|
:- pred construct_func_body_for_tscc(pred_proc_id::in,
|
|
pred_proc_code::in, proc_stmt_info::out,
|
|
maybe(entry_proc_info)::in, maybe(entry_proc_info)::out,
|
|
list(mlds_local_var_defn)::in, list(mlds_local_var_defn)::out) is det.
|
|
|
|
construct_func_body_for_tscc(EntryProc, PredProcCode,
|
|
ProcStmtInfo, !MaybeEntryProcInfo, !NonEntryTsccInLocalVarDefns) :-
|
|
PredProcCode = pred_proc_code(PredProcIdArgsInfo, _FuncParams,
|
|
GoalLocalVarDefns, GoalFuncDefns, _DescCommentStmt, GoalStmts,
|
|
_ClosureWrapperFuncDefns, _EnvVarNames),
|
|
PredProcIdArgsInfo = pred_proc_id_args_info(PredProcId,
|
|
PredInfo, ProcInfo, ProcContext, IdInTscc, _ArgTuples,
|
|
FuncParams, ReturnRvalsTypes, OwnLocalVarDefns,
|
|
TsccInLocalVarDefns, TsccInLocalVars, TsccOutLocalVarDefns,
|
|
CopyTsccInToOwnStmts, CopyOwnToTsccOutStmts,
|
|
CopyOutValThroughPtrStmts),
|
|
( if PredProcId = EntryProc then
|
|
expect(unify(!.MaybeEntryProcInfo, no), $pred,
|
|
"!.MaybeEntryProcInfo != no"),
|
|
PredProcIdInfo = pred_proc_id_info(PredProcId, PredInfo, ProcInfo,
|
|
ProcContext),
|
|
EntryProcInfo = entry_proc_info(IdInTscc, PredProcIdInfo,
|
|
FuncParams, ReturnRvalsTypes,
|
|
TsccOutLocalVarDefns, CopyOutValThroughPtrStmts),
|
|
!:MaybeEntryProcInfo = yes(EntryProcInfo)
|
|
else
|
|
!:NonEntryTsccInLocalVarDefns = !.NonEntryTsccInLocalVarDefns ++
|
|
TsccInLocalVarDefns
|
|
),
|
|
AllLocalVarDefns = OwnLocalVarDefns ++ GoalLocalVarDefns,
|
|
AllStmts = CopyTsccInToOwnStmts ++ GoalStmts ++ CopyOwnToTsccOutStmts,
|
|
ProcStmt = ml_stmt_block(AllLocalVarDefns, GoalFuncDefns, AllStmts,
|
|
ProcContext),
|
|
ProcStmtInfo = proc_stmt_info(IdInTscc, TsccInLocalVars, ProcStmt,
|
|
ProcContext).
|
|
|
|
%---------------------%
|
|
|
|
% Take the codes that go under each "top_of_proc_i", and join them
|
|
% together to yield the body of the MLDS function for EntryProc.
|
|
% Use whiles and continues instead of labels and gotos if requested.
|
|
%
|
|
:- pred make_container_proc(tail_rec_loop_kind::in, list(mlds_stmt)::in,
|
|
list(mlds_rval)::in, proc_id_in_tscc::in, prog_context::in,
|
|
list(proc_stmt_info)::in,
|
|
list(mlds_local_var_defn)::out, list(mlds_stmt)::out) is det.
|
|
|
|
make_container_proc(LoopKind, CopyOutValThroughPtrStmts, ReturnRvals,
|
|
EntryProc, EntryProcContext, ProcStmtInfos, ContainerVarDefns,
|
|
Stmts) :-
|
|
ReturnStmt = ml_stmt_return(ReturnRvals, EntryProcContext),
|
|
(
|
|
LoopKind = tail_rec_loop_label_goto,
|
|
make_container_proc_with_label_goto(CopyOutValThroughPtrStmts,
|
|
ReturnStmt, EntryProc, EntryProcContext, ProcStmtInfos, Stmts),
|
|
ContainerVarDefns = []
|
|
;
|
|
LoopKind = tail_rec_loop_while_continue,
|
|
make_container_proc_with_while_continue(CopyOutValThroughPtrStmts,
|
|
ReturnStmt, EntryProc, EntryProcContext, ProcStmtInfos,
|
|
ContainerVarDefns, Stmts)
|
|
).
|
|
|
|
%---------------------%
|
|
|
|
% We wrap the statements we generate for each TSCC procedure like this:
|
|
%
|
|
% goto top_of_proc_<entry_proc>;
|
|
%
|
|
% top_of_proc_1:
|
|
% <copy tscc args 1 to own args 1>
|
|
% <body of TSCC proc 1>
|
|
% <copy own output args 1 to tscc output args>
|
|
% goto EndLabel;
|
|
% ...
|
|
% top_of_proc_N:
|
|
% <copy tscc args N to own args N>
|
|
% <body of TSCC proc N>
|
|
% <copy own output args N to tscc output args>
|
|
% goto EndLabel;
|
|
% EndLabel:
|
|
% <for tscc byref output args, copy value to *ptr>
|
|
% return <tscc copied output args>;
|
|
%
|
|
% A tail call to TSCC proc i can just
|
|
%
|
|
% - assign the actual parameters to tscc args i, and
|
|
% - goto `top_of_proc_i'.
|
|
%
|
|
:- pred make_container_proc_with_label_goto(list(mlds_stmt)::in, mlds_stmt::in,
|
|
proc_id_in_tscc::in, prog_context::in, list(proc_stmt_info)::in,
|
|
list(mlds_stmt)::out) is det.
|
|
|
|
make_container_proc_with_label_goto(CopyOutValThroughPtrStmts, ReturnStmt,
|
|
EntryProc, EntryProcContext, ProcStmtInfos, WrappedStmts) :-
|
|
EndLabel = mlds_label("tscc_end"),
|
|
EndLabelStmt = ml_stmt_label(EndLabel, EntryProcContext),
|
|
GotoEndStmt = ml_stmt_goto(goto_label(EndLabel), EntryProcContext),
|
|
list.map(make_wrapped_proc_with_label_goto(GotoEndStmt), ProcStmtInfos,
|
|
ProcWrappedStmtLists),
|
|
list.condense(ProcWrappedStmtLists, ProcWrappedStmts),
|
|
EntryStartLabel =
|
|
generate_tail_rec_start_label(tscc_self_and_mutual_rec, EntryProc),
|
|
GotoEntryStmt =
|
|
ml_stmt_goto(goto_label(EntryStartLabel), EntryProcContext),
|
|
WrappedStmts = [GotoEntryStmt | ProcWrappedStmts] ++
|
|
[EndLabelStmt | CopyOutValThroughPtrStmts] ++ [ReturnStmt].
|
|
|
|
:- pred make_wrapped_proc_with_label_goto(mlds_stmt::in, proc_stmt_info::in,
|
|
list(mlds_stmt)::out) is det.
|
|
|
|
make_wrapped_proc_with_label_goto(GotoEndStmt, ProcStmtInfo, LabelProcStmts) :-
|
|
ProcStmtInfo = proc_stmt_info(IdInTscc, _LoopLocalVars, ProcStmt,
|
|
ProcContext),
|
|
StartLabel =
|
|
generate_tail_rec_start_label(tscc_self_and_mutual_rec, IdInTscc),
|
|
StartLabelStmt = ml_stmt_label(StartLabel, ProcContext),
|
|
LabelProcStmts =
|
|
[StartLabelStmt | append_to_stmt(ProcStmt, [GotoEndStmt])].
|
|
|
|
%---------------------%
|
|
|
|
% We wrap the statements we generate for each TSCC procedure like this:
|
|
%
|
|
% proc_selector = <entry_proc>;
|
|
% while (TRUE) {
|
|
% switch (proc_selector) {
|
|
% case 1:
|
|
% <copy tscc input args 1 to own input args 1>
|
|
% <body of TSCC proc 1>
|
|
% <copy own output args 1 to tscc output args>
|
|
% break;
|
|
% ...
|
|
% case N:
|
|
% <copy tscc args N to own args N>
|
|
% <body of TSCC proc N>
|
|
% <copy own output args N to tscc output args>
|
|
% break;
|
|
% }
|
|
% break;
|
|
% }
|
|
% <for tscc byref output args, copy value to *ptr>
|
|
% return <tscc copied output args>;
|
|
%
|
|
% A tail call to TSCC proc i can just
|
|
%
|
|
% - assign the actual parameters to tscc args i,
|
|
% - set proc_selector to i, and
|
|
% - execute `continue'.
|
|
%
|
|
:- pred make_container_proc_with_while_continue(list(mlds_stmt)::in,
|
|
mlds_stmt::in, proc_id_in_tscc::in, prog_context::in,
|
|
list(proc_stmt_info)::in,
|
|
list(mlds_local_var_defn)::out, list(mlds_stmt)::out) is det.
|
|
|
|
make_container_proc_with_while_continue(CopyOutValThroughPtrStmts, ReturnStmt,
|
|
EntryProc, EntryProcContext, ProcStmtInfos,
|
|
ContainerVarDefns, WrappedStmts) :-
|
|
GotoEndStmts = [ml_stmt_goto(goto_break_switch, EntryProcContext)],
|
|
list.map_foldl2(make_wrapped_proc_with_while_continue(GotoEndStmts),
|
|
ProcStmtInfos, SwitchCases,
|
|
set.init, PossibleSwitchValues, [], AllTsccInLocalVars),
|
|
|
|
SelectorVar = lvn_comp_var(lvnc_tscc_proc_selector),
|
|
SelectorType = mlds_builtin_type_int(int_type_int),
|
|
SelectorVarDefn = mlds_local_var_defn(SelectorVar, EntryProcContext,
|
|
SelectorType, no_initializer, gc_no_stmt),
|
|
ContainerVarDefns = [SelectorVarDefn],
|
|
|
|
EntryProc = proc_id_in_tscc(EntryProcNum),
|
|
SelectorVarLval = ml_local_var(SelectorVar, SelectorType),
|
|
SetSelectorStmt = ml_stmt_atomic(
|
|
assign(SelectorVarLval, ml_const(mlconst_int(EntryProcNum))),
|
|
EntryProcContext),
|
|
|
|
set.to_sorted_list(PossibleSwitchValues, PossibleSwitchValuesList),
|
|
SwitchMin = list.det_head(PossibleSwitchValuesList),
|
|
SwitchMax = list.det_last(PossibleSwitchValuesList),
|
|
SwitchRange = mlds_switch_range(SwitchMin, SwitchMax),
|
|
Default = default_is_unreachable,
|
|
SwitchStmt = ml_stmt_switch(SelectorType, ml_lval(SelectorVarLval),
|
|
SwitchRange, SwitchCases, Default, EntryProcContext),
|
|
BreakStmt = ml_stmt_goto(goto_break_loop, EntryProcContext),
|
|
SwitchBreakStmt = ml_stmt_block([], [], [SwitchStmt, BreakStmt],
|
|
EntryProcContext),
|
|
LoopLocalVars = [SelectorVar | AllTsccInLocalVars],
|
|
LoopStmt = ml_stmt_while(may_loop_zero_times, ml_const(mlconst_true),
|
|
SwitchBreakStmt, LoopLocalVars, EntryProcContext),
|
|
WrappedStmts = [SetSelectorStmt, LoopStmt] ++
|
|
CopyOutValThroughPtrStmts ++ [ReturnStmt].
|
|
|
|
:- pred make_wrapped_proc_with_while_continue(list(mlds_stmt)::in,
|
|
proc_stmt_info::in, mlds_switch_case::out, set(int)::in, set(int)::out,
|
|
list(mlds_local_var_name)::in, list(mlds_local_var_name)::out) is det.
|
|
|
|
make_wrapped_proc_with_while_continue(GotoEndStmts, ProcStmtInfo, SwitchCase,
|
|
!PossibleSwitchValues, !AllLoopLocalVars) :-
|
|
ProcStmtInfo = proc_stmt_info(IdInTscc, LoopLocalVars, ProcStmt,
|
|
ProcContext),
|
|
IdInTscc = proc_id_in_tscc(IdInTsccNum),
|
|
MatchCond = match_value(ml_const(mlconst_int(IdInTsccNum))),
|
|
SwitchStmt = ml_gen_block([], [], append_to_stmt(ProcStmt, GotoEndStmts),
|
|
ProcContext),
|
|
SwitchCase = mlds_switch_case(MatchCond, [], SwitchStmt),
|
|
set.insert(IdInTsccNum, !PossibleSwitchValues),
|
|
!:AllLoopLocalVars = LoopLocalVars ++ !.AllLoopLocalVars.
|
|
|
|
%---------------------%
|
|
|
|
:- func append_to_stmt(mlds_stmt, list(mlds_stmt)) = list(mlds_stmt).
|
|
|
|
append_to_stmt(BaseStmt, EndStmts) = Stmts :-
|
|
( if
|
|
BaseStmt = ml_stmt_block(LocalVarDefns, FuncDefns, BaseStmts, Context)
|
|
then
|
|
Stmts = [ml_stmt_block(LocalVarDefns, FuncDefns,
|
|
BaseStmts ++ EndStmts, Context)]
|
|
else
|
|
Stmts = [BaseStmt | EndStmts]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
% Return the declaration flags appropriate for a procedure definition.
|
|
%
|
|
:- func ml_gen_proc_decl_flags(module_info, pred_id, proc_id)
|
|
= mlds_function_decl_flags.
|
|
|
|
ml_gen_proc_decl_flags(ModuleInfo, PredId, ProcId) = DeclFlags :-
|
|
module_info_pred_info(ModuleInfo, PredId, PredInfo),
|
|
( if procedure_is_exported(ModuleInfo, PredInfo, ProcId) then
|
|
Access = func_public
|
|
else
|
|
Access = func_private
|
|
),
|
|
DeclFlags = mlds_function_decl_flags(Access, one_copy).
|
|
|
|
% Generate the code for a procedure body.
|
|
%
|
|
:- pred ml_gen_proc_body(code_model::in, list(var_mvar_type_mode)::in,
|
|
list(prog_var)::in, hlds_goal::in, seen_at_label_map::in,
|
|
list(mlds_local_var_defn)::out, list(mlds_function_defn)::out,
|
|
list(mlds_stmt)::out, ml_gen_info::in, ml_gen_info::out) is det.
|
|
|
|
ml_gen_proc_body(CodeModel, ArgTuples, CopiedOutputVars, Goal, SeenAtLabelMap,
|
|
LocalVarDefns, FuncDefns, Stmts, !Info) :-
|
|
Goal = hlds_goal(_, GoalInfo),
|
|
Context = goal_info_get_context(GoalInfo),
|
|
|
|
% First just generate the code for the procedure's goal.
|
|
|
|
% In certain cases -- for example existentially typed procedures,
|
|
% or unification/compare procedures for equivalence types --
|
|
% the parameters types may not match the types of the head variables.
|
|
% In such cases, we need to box/unbox/cast them to the right type.
|
|
% We also grab the original (uncast) lvals for the copied output
|
|
% variables (if any) here, since for the return statement that
|
|
% we append below, we want the original vars, not their cast versions.
|
|
|
|
ml_gen_convert_headvars(ArgTuples, CopiedOutputVars, Context,
|
|
ConvLocalVarDefns, ConvInputStmts, ConvOutputStmts, !Info),
|
|
( if
|
|
ConvLocalVarDefns = [],
|
|
ConvInputStmts = [],
|
|
ConvOutputStmts = []
|
|
then
|
|
% No boxing/unboxing/casting required.
|
|
ml_gen_goal(CodeModel, Goal, LocalVarDefns1, FuncDefns0, Stmts1, !Info)
|
|
else
|
|
DoGenGoal = ml_gen_goal(CodeModel, Goal),
|
|
|
|
% Boxing/unboxing/casting required. We need to convert the input
|
|
% arguments, generate the goal, convert the output arguments,
|
|
% and then succeed.
|
|
DoConvOutputs =
|
|
( pred(NewLocalVarDefns::out, NewFuncDefns::out,
|
|
NewStmts::out, Info0::in, Info::out) is det :-
|
|
ml_gen_success(CodeModel, Context, SuccStmts, Info0, Info),
|
|
NewLocalVarDefns = [],
|
|
NewFuncDefns = [],
|
|
NewStmts = ConvOutputStmts ++ SuccStmts
|
|
),
|
|
ml_combine_conj(CodeModel, Context, DoGenGoal, DoConvOutputs,
|
|
LocalVarDefns0, FuncDefns0, Stmts0, !Info),
|
|
Stmts1 = ConvInputStmts ++ Stmts0,
|
|
LocalVarDefns1 = ConvLocalVarDefns ++ LocalVarDefns0
|
|
),
|
|
ml_gen_info_get_globals(!.Info, Globals),
|
|
globals.get_opt_tuple(Globals, OptTuple),
|
|
EliminateUnusedAssigns = OptTuple ^ ot_elim_unused_mlds_assigns,
|
|
(
|
|
EliminateUnusedAssigns = do_not_elim_unused_mlds_assigns,
|
|
LocalVarDefns = LocalVarDefns1,
|
|
FuncDefns = FuncDefns0,
|
|
Stmts = Stmts1
|
|
;
|
|
EliminateUnusedAssigns = elim_unused_mlds_assigns,
|
|
list.map((func(var_mvar_type_mode(_, LocalVar, _, _)) = LocalVar),
|
|
ArgTuples) = ArgLocalVars,
|
|
(
|
|
( CodeModel = model_det
|
|
; CodeModel = model_non
|
|
),
|
|
OutsideVars = ArgLocalVars
|
|
;
|
|
CodeModel = model_semi,
|
|
OutsideVars = [lvn_comp_var(lvnc_succeeded) | ArgLocalVars]
|
|
),
|
|
optimize_away_unused_assigns_in_proc_body(OutsideVars,
|
|
SeenAtLabelMap, LocalVarDefns1, LocalVarDefns,
|
|
FuncDefns0, FuncDefns, Stmts1, Stmts)
|
|
).
|
|
|
|
% In certain cases -- for example existentially typed procedures,
|
|
% or unification/compare procedures for equivalence types --
|
|
% the parameter types may not match the types of the head variables.
|
|
% In such cases, we need to box/unbox/cast them to the right type.
|
|
% This procedure handles that.
|
|
%
|
|
:- pred ml_gen_convert_headvars(list(var_mvar_type_mode)::in,
|
|
list(prog_var)::in, prog_context::in,
|
|
list(mlds_local_var_defn)::out, list(mlds_stmt)::out, list(mlds_stmt)::out,
|
|
ml_gen_info::in, ml_gen_info::out) is det.
|
|
|
|
ml_gen_convert_headvars([], _CopiedOutputVars, _Context, [], [], [], !Info).
|
|
ml_gen_convert_headvars([ArgTuple | ArgTuples], CopiedOutputVars, Context,
|
|
LocalVarDefns, InputStmts, OutputStmts, !Info) :-
|
|
ArgTuple = var_mvar_type_mode(Var, MLDSVarName, HeadType, TopFunctorMode),
|
|
ml_variable_type_direct(!.Info, Var, BodyType),
|
|
( if
|
|
% An argument doesn't need any conversion ...
|
|
(
|
|
% ... if its type is the same in the head as in the body
|
|
% (modulo contexts), or ...
|
|
map.init(Subst0),
|
|
type_unify(HeadType, BodyType, [], Subst0, Subst),
|
|
map.is_empty(Subst)
|
|
;
|
|
% ... if it is unused.
|
|
TopFunctorMode = top_unused
|
|
)
|
|
then
|
|
ml_gen_convert_headvars(ArgTuples, CopiedOutputVars, Context,
|
|
LocalVarDefns, InputStmts, OutputStmts, !Info)
|
|
else
|
|
% Generate the lval for the head variable.
|
|
ml_gen_var_with_type(!.Info, Var, HeadType, HeadVarLval),
|
|
|
|
% Generate code to box or unbox that head variable,
|
|
% to convert its type from HeadType to BodyType.
|
|
ml_gen_box_or_unbox_lval(HeadType, BodyType, bp_native_if_possible,
|
|
HeadVarLval, MLDSVarName, Context, no, 0, BodyLval,
|
|
ConvLocalVarDefns, ConvInputStmts, ConvOutputStmts, !Info),
|
|
|
|
% Ensure that for any uses of this variable in the procedure body,
|
|
% we use the BodyLval (which has type BodyType) rather than the
|
|
% HeadVarLval (which has type HeadType).
|
|
ml_gen_info_set_var_lval(Var, BodyLval, !Info),
|
|
|
|
ml_gen_convert_headvars(ArgTuples, CopiedOutputVars, Context,
|
|
LocalVarDefnsTail, InputStmtsTail, OutputStmtsTail, !Info),
|
|
|
|
% Add the code to convert this input or output.
|
|
ml_gen_info_get_byref_output_vars(!.Info, ByRefOutputVars),
|
|
( if
|
|
( set_of_var.member(ByRefOutputVars, Var)
|
|
; list.member(Var, CopiedOutputVars)
|
|
)
|
|
then
|
|
InputStmts = InputStmtsTail,
|
|
OutputStmts = OutputStmtsTail ++ ConvOutputStmts
|
|
else
|
|
InputStmts = ConvInputStmts ++ InputStmtsTail,
|
|
OutputStmts = OutputStmtsTail
|
|
),
|
|
LocalVarDefns = ConvLocalVarDefns ++ LocalVarDefnsTail
|
|
).
|
|
|
|
:- pred ml_gen_local_var_defns_for_copied_output_vars(ml_gen_info::in,
|
|
prog_context::in, list(var_mvar_type_mode)::in, list(prog_var)::in,
|
|
list(mlds_local_var_defn)::out, ml_gen_info::in, ml_gen_info::out) is det.
|
|
|
|
ml_gen_local_var_defns_for_copied_output_vars(Info, Context, ArgTuples,
|
|
CopiedOutputVars, OutputVarLocalDefns, !Info) :-
|
|
% We could generate all the local variables at the top of the function.
|
|
% But instead, we now generate them locally for each goal.
|
|
% We just declare the `succeeded' var here, plus locals
|
|
% for any output arguments that are returned by value
|
|
% (e.g. if --nondet-copy-out is enabled, or for det function
|
|
% return values).
|
|
(
|
|
CopiedOutputVars = [],
|
|
% Optimize common case.
|
|
OutputVarLocalDefns = []
|
|
;
|
|
CopiedOutputVars = [_ | _],
|
|
ml_gen_info_get_var_table(Info, VarTable0),
|
|
% Note that for headvars, we must use the types from
|
|
% the procedure interface, not from the procedure body.
|
|
OverrideHeadVarType =
|
|
( pred(AT::in, Table0::in, Table::out) is det :-
|
|
AT = var_mvar_type_mode(HV, _, HT, _),
|
|
lookup_var_entry(Table0, HV, Entry0),
|
|
Entry = Entry0 ^ vte_type := HT,
|
|
update_var_entry(HV, Entry, Table0, Table)
|
|
),
|
|
list.foldl(OverrideHeadVarType, ArgTuples, VarTable0, VarTable1),
|
|
ml_gen_local_var_decls(VarTable1, Context,
|
|
CopiedOutputVars, OutputVarLocalDefns, !Info)
|
|
).
|
|
|
|
:- pred ml_gen_maybe_local_var_defn_for_succeeded(ml_gen_info::in,
|
|
prog_context::in, list(mlds_local_var_defn)::out) is det.
|
|
|
|
ml_gen_maybe_local_var_defn_for_succeeded(Info, Context, SucceededVarDefns) :-
|
|
ml_gen_info_get_used_succeeded_var(Info, UsedSucceededVar),
|
|
(
|
|
UsedSucceededVar = no,
|
|
SucceededVarDefns = []
|
|
;
|
|
UsedSucceededVar = yes,
|
|
SucceededVarDefns = [ml_gen_succeeded_var_decl(Context)]
|
|
).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- type maybe_contains_nested_funcs
|
|
---> does_not_contain_nested_funcs
|
|
; contains_nested_funcs.
|
|
|
|
:- pred does_stmt_contain_nested_func_defn(mlds_stmt::in,
|
|
maybe_contains_nested_funcs::in, maybe_contains_nested_funcs::out) is det.
|
|
|
|
does_stmt_contain_nested_func_defn(Stmt, !ContainsNestedFuncs) :-
|
|
(
|
|
Stmt = ml_stmt_block(_LocalVarDefns, FuncDefns, SubStmts, _Context),
|
|
(
|
|
FuncDefns = [],
|
|
list.foldl(does_stmt_contain_nested_func_defn, SubStmts,
|
|
!ContainsNestedFuncs)
|
|
;
|
|
FuncDefns = [_ | _],
|
|
!:ContainsNestedFuncs = contains_nested_funcs
|
|
)
|
|
;
|
|
Stmt = ml_stmt_while(_LoopKind, _CondRval, SubStmt, _LoopLocalVars,
|
|
_Context),
|
|
does_stmt_contain_nested_func_defn(SubStmt, !ContainsNestedFuncs)
|
|
;
|
|
Stmt = ml_stmt_if_then_else(_CondRval, ThenStmt, MaybeElseStmt,
|
|
_Context),
|
|
does_stmt_contain_nested_func_defn(ThenStmt, !ContainsNestedFuncs),
|
|
(
|
|
MaybeElseStmt = no
|
|
;
|
|
MaybeElseStmt = yes(ElseStmt),
|
|
does_stmt_contain_nested_func_defn(ElseStmt, !ContainsNestedFuncs)
|
|
)
|
|
;
|
|
Stmt = ml_stmt_switch(_Type, _Rval, _Range, Cases, Default, _Context),
|
|
list.foldl(does_case_contain_nested_func_defn, Cases,
|
|
!ContainsNestedFuncs),
|
|
(
|
|
Default = default_is_unreachable
|
|
;
|
|
Default = default_do_nothing
|
|
;
|
|
Default = default_case(DefaultStmt),
|
|
does_stmt_contain_nested_func_defn(DefaultStmt,
|
|
!ContainsNestedFuncs)
|
|
)
|
|
;
|
|
Stmt = ml_stmt_try_commit(_Lval, GoalStmt, HandlerStmt, _Context),
|
|
does_stmt_contain_nested_func_defn(GoalStmt, !ContainsNestedFuncs),
|
|
does_stmt_contain_nested_func_defn(HandlerStmt, !ContainsNestedFuncs)
|
|
;
|
|
( Stmt = ml_stmt_label(_Label, _Context)
|
|
; Stmt = ml_stmt_goto(_Target, _Context)
|
|
; Stmt = ml_stmt_computed_goto(_Rval, _Targets, _Context)
|
|
; Stmt = ml_stmt_call(_Sig, _Callee, _Args, _Ret, _Kind, _Context)
|
|
; Stmt = ml_stmt_return(_RetVals, _Context)
|
|
; Stmt = ml_stmt_do_commit(_Rval, _Context)
|
|
; Stmt = ml_stmt_atomic(_Atomic, _Context)
|
|
)
|
|
).
|
|
|
|
:- pred does_case_contain_nested_func_defn(mlds_switch_case::in,
|
|
maybe_contains_nested_funcs::in, maybe_contains_nested_funcs::out) is det.
|
|
|
|
does_case_contain_nested_func_defn(Case, !ContainsNestedFuncs) :-
|
|
Case = mlds_switch_case(_FirstCond, _LaterConds, Stmt),
|
|
does_stmt_contain_nested_func_defn(Stmt, !ContainsNestedFuncs).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
|
|
:- pred describe_pred_proc_ids(module_info::in, string::in,
|
|
set(pred_proc_id)::in, list(mlds_stmt)::in, list(mlds_stmt)::out) is det.
|
|
:- pragma consider_used(pred(describe_pred_proc_ids/5)).
|
|
|
|
describe_pred_proc_ids(ModuleInfo, Msg, PredProcIds, !StartCommentStmts) :-
|
|
MsgStmt = ml_stmt_atomic(comment(Msg), dummy_context),
|
|
DescStmts = list.map(pred_proc_id_desc(ModuleInfo),
|
|
set.to_sorted_list(PredProcIds)),
|
|
!:StartCommentStmts = !.StartCommentStmts ++ [MsgStmt | DescStmts].
|
|
|
|
:- func pred_proc_id_desc(module_info, pred_proc_id) = mlds_stmt.
|
|
|
|
pred_proc_id_desc(ModuleInfo, PredProcId) = DescStmt :-
|
|
Comment = " " ++ describe_proc_from_id(include_module_name,
|
|
ModuleInfo, PredProcId),
|
|
DescStmt = ml_stmt_atomic(comment(Comment), dummy_context).
|
|
|
|
%---------------------------------------------------------------------------%
|
|
:- end_module ml_backend.ml_proc_gen.
|
|
%---------------------------------------------------------------------------%
|