mirror of
https://github.com/Mercury-Language/mercury.git
synced 2026-04-24 05:43:53 +00:00
5f50259d16
Right now, most parts of the compiler write to the "current output stream".
This was a pragmatic choice at the time, but has not aged well. The problem
is that the answer to the question "where is the current output stream going?"
is not obvious in *all* places in the compiler (although it is obvious in
most). When using such implicit streams, finding where the output is going
to in a given predicate requires inspecting not just the ancestors of that
predicate, but also all their older siblings (since any of them could have
changed the current stream), *including* their entire call trees. This is
usually an infeasible task. By constrast, if we explicitly pass streams
to all output operations, we need only follow the places where the variable
representing that stream is bound, which the mode system makes easy.
This diff switches large parts of the compiler over to doing output only
to explicitly passed streams, never to the implicit "current output stream".
The parts it switches over are the parts that rely to a significant degree
on the innermost change, which is to the "output" typeclass in
parse_tree_out_info.m. This is the part that has to be switched over to
explicit streams first, because (a) many modules such as mercury_to_mercury.m
rely on the output typeclass, and (b) most other modules that do output
call predicates in these modules. Starting anywhere else would be like
building a skyscraper starting at the top.
This typeclass, output(U), has two instances: output(io), and output(string),
so you could output either to the current output stream, or to a string.
To allow the specification of the destination stream in the first case,
this diff changes the typeclass to output(S, U) with a functional dependency
from U to S, with the two instances being output(io.text_output_stream, io)
and output(unit, string). (The unit arg is ignored in the second case.)
There is a complication with the output typeclass method, add_list, that
outputs a list of items. The complication is that each item is output
by a predicate supplied by the caller, but the separator between the items
(usually a comma) is output by add_list itself. We don't want to give
callers of this method the opportunity to screw up by specifying (possibly
implicitly) two different output streams for these two purposes, so we want
(a) the caller to tell add_list where to put the separators, and then
(b) for add_list, not its caller, tell the user-supplied predicate what
stream to write to. This works only if the stream argument is just before
the di,uo pair of I/O state arguments, which differs from our usual practice
of passing the stream at or near the left edge of the argument list,
not near the right. The result of this complication is that two categories
of predicates that are and are not used to print items in a list differ
in where they put the stream in their argument lists. This makes it easy
to pass the stream in the wrong argument position if you call a predicate
without looking up its signature, and may require *changing* the argument
order when a predicate is used to print an item in a list for the first time.
A complete switch over to always passing the stream just before !IO
would fix this inconsistency, but is far to big a change to make all at once.
compiler/parse_tree_out_info.m:
Make the changes described above.
Add write_out_list, which is a variant of io.write_list specifically
designed to address the "complication" described above. It also has
the arguments in an order that is better suited for higher-order use.
Make the same change to argument order in the class method add_list
as well.
Almost all of the following changes consist of passing an extra stream
argument to output predicates. In some places, where I thought this would
aid readability, I replaced sequences of calls to output predicates
with a single io.format.
compiler/prog_out.m:
This module had many predicates that wrote things to the current output
stream. This diff adds versions of these predicates that take an
explicit stream argument.
If the originals are still needed after the changes to the other modules,
keep them, but add "_to_cur_stream" to the end of their names.
Otherwise, delete them. (Many of the changes below replace
write_xyz(..., !IO) with io.write_string(Stream, xyz_to_string(...), !IO),
especially when write_xyz did nothing except call xyz_to_string
and wrote out the result.)
compiler/c_util.m:
Add either an explicit stream argument to the argument list, or a
"_current_stream" suffix to the name, of every predicate defined
in this module that does output.
Add a new predicate to print out the block comment containing
input for mkinit. This factors out common code in the LLDS and MLDS
backends.
compiler/name_mangle.m:
Delete all predicates that used to write to the current output stream,
after replacing them if necessary with functions that return a string,
which the caller can print to wherever it wants. (The "if necessary"
part is there because some of the "replacement" functions already
existed.)
When converting a proc_label to a string, *always* require the caller
to say whether the label prefix should be added to the string,
instead of silently assuming "yes, add it", as calls to one of the old,
now deleted predicates had it.
compiler/file_util.m:
Add output_to_file_stream, a version of output_to_file which
simply passes the output file stream it opens to the predicate
that is intended to define the contents of the newly created or
updated file. The existing output_to_file, which instead sets
and resets the current output stream around the equivalent
predicate call, is still needed e.g. by the MLDS backend,
but hopefully for not too long.
compiler/mercury_to_mercury.m:
compiler/parse_tree_out.m:
compiler/parse_tree_out_clause.m:
compiler/parse_tree_out_inst.m:
compiler/parse_tree_out_pragma.m:
compiler/parse_tree_out_pred_decl.m:
compiler/parse_tree_out_term.m:
compiler/parse_tree_out_type_repn.m:
Change the code writing out parse trees to explicitly pass a stream
to every predicate that does output.
In some places, this allows us to avoid changing the identity
of the current output stream.
compiler/hlds_out.m:
compiler/hlds_out_goal.m:
compiler/hlds_out_mode.m:
compiler/hlds_out_module.m:
compiler/hlds_out_pred.m:
compiler/hlds_out_util.m:
compiler/intermod.m:
Change the code writing out HLDS code to explicitly pass a stream
to every predicate that does output. (The changes to these modules
belong in this diff because these modules call many of the output
predicates in the parse tree package.)
In hlds_out_util.m, delete some write_to_xyz(...) predicates that wrote
the result of xyz_to_string(...) to the current output stream.
Replace calls to the deleted predicates with calls to io.write_string
with the string being written being computed by xyz_to_string.
Add a predicate to hlds_out_util.m that outputs a comment containing
the current context, if it is valid. This factors out code that used
to be common to several of the other modules.
In a few places in hlds_out_module.m, the new code generates a
slighly different set of blank lines, but this should not be a problem.
compiler/layout_out.m:
compiler/llds_out_code_addr.m:
compiler/llds_out_data.m:
compiler/llds_out_file.m:
compiler/llds_out_global.m:
compiler/llds_out_instr.m:
compiler/llds_out_util.m:
compiler/opt_debug.m:
compiler/rtti_out.m:
Change the code writing out the LLDS to explicitly pass a stream
to every predicate that does output. (The changes to these modules
belong in this diff because layout_out.m and rtti_out.m call
many of the output predicates in the parse tree package,
and through them, the rest of the LLDS backend is affected as well.)
compiler/make.module_dep_file.m:
compiler/mercury_compile_main.m:
compiler/mercury_compile_middle_passes.m:
Replace code that sets and resets the current output stream
with code that simply passes an explicit output stream to a
predicate that now *takes* an explicit stream as an argument.
compiler/accumulator.m:
compiler/add_clause.m:
compiler/code_gen.m:
compiler/code_loc_dep.m:
compiler/cse_detection.m:
compiler/delay_partial_inst.m:
compiler/dep_par_conj.m:
compiler/det_analysis.m:
compiler/error_msg_inst.m:
compiler/export.m:
compiler/format_call.m:
compiler/goal_expr_to_goal.m:
compiler/ite_gen.m:
compiler/lco.m:
compiler/liveness.m:
compiler/lp_rational.m:
compiler/mercury_compile_front_end.m:
compiler/mercury_compile_llds_back_end.m:
compiler/mlds_to_c_file.m:
compiler/mlds_to_c_global.m:
compiler/mode_debug.m:
compiler/mode_errors.m:
compiler/modes.m:
compiler/optimize.m:
compiler/passes_aux.m:
compiler/pd_debug.m:
compiler/pragma_c_gen.m:
compiler/proc_gen.m:
compiler/prog_ctgc.m:
compiler/push_goals_together.m:
compiler/rat.m:
compiler/recompilation.m:
compiler/recompilation.usage.m:
compiler/recompilation.version.m:
compiler/rtti.m:
compiler/saved_vars.m:
compiler/simplify_goal_conj.m:
compiler/stack_opt.m:
compiler/structure_reuse.analysis.m:
compiler/structure_reuse.domain.m:
compiler/structure_reuse.indirect.m:
compiler/structure_sharing.analysis.m:
compiler/superhomogeneous.m:
compiler/term_constr_build.m:
compiler/term_constr_data.m:
compiler/term_constr_fixpoint.m:
compiler/term_constr_pass2.m:
compiler/term_constr_util.m:
compiler/tupling.m:
compiler/type_assign.m:
compiler/unneeded_code.m:
compiler/write_deps_file.m:
Conform to the changes above, mostly by passing streams explicitly.
compiler/hlds_dependency_graph.m:
Conform to the changes above, mostly by passing streams explicitly.
Move a predicate's definition next it only use.
compiler/Mercury.options:
Specify --warn-implicit-stream-calls for all the modules in which
this diff has replaced all implicit streams with explicit streams.
(Unfortunately, debugging this diff has shown that --warn-implicit-
stream-calls detects only *some*, and not *all*, uses of implicit
streams.)
library/term_io.m:
Fix documentation.
844 lines
37 KiB
Mathematica
844 lines
37 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% vim: ft=mercury ts=4 sw=4 et
|
|
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1993-2012,2014 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- module hlds.make_hlds.add_clause.
|
|
:- interface.
|
|
|
|
:- import_module hlds.hlds_goal.
|
|
:- import_module hlds.hlds_module.
|
|
:- import_module hlds.hlds_pred.
|
|
:- import_module hlds.make_hlds.qual_info.
|
|
:- import_module hlds.quantification.
|
|
:- import_module mdbcomp.
|
|
:- import_module mdbcomp.sym_name.
|
|
:- import_module parse_tree.
|
|
:- import_module parse_tree.error_util.
|
|
:- import_module parse_tree.maybe_error.
|
|
:- import_module parse_tree.prog_data.
|
|
|
|
:- import_module list.
|
|
:- import_module maybe.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- pred module_add_clause(prog_varset::in, pred_or_func::in, sym_name::in,
|
|
list(prog_term)::in, maybe2(goal, list(warning_spec))::in,
|
|
pred_status::in, prog_context::in, maybe(int)::in, goal_type::in,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
:- pred clauses_info_add_clause(clause_applicable_modes::in, list(proc_id)::in,
|
|
prog_varset::in, tvarset::in, list(prog_term)::in, goal::in,
|
|
prog_context::in, maybe(int)::in, pred_status::in, pred_or_func::in,
|
|
arity::in, goal_type::in, hlds_goal::out, prog_varset::out, tvarset::out,
|
|
list(quant_warning)::out, clauses_info::in, clauses_info::out,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
:- implementation.
|
|
|
|
:- import_module check_hlds.
|
|
:- import_module check_hlds.mode_errors.
|
|
:- import_module hlds.add_pred.
|
|
:- import_module hlds.default_func_mode.
|
|
:- import_module hlds.goal_util.
|
|
:- import_module hlds.hlds_args.
|
|
:- import_module hlds.hlds_code_util.
|
|
:- import_module hlds.hlds_error_util.
|
|
:- import_module hlds.hlds_out.
|
|
:- import_module hlds.hlds_out.hlds_out_goal.
|
|
:- import_module hlds.hlds_out.hlds_out_util.
|
|
:- import_module hlds.hlds_rtti.
|
|
:- import_module hlds.make_goal.
|
|
:- import_module hlds.make_hlds.goal_expr_to_goal.
|
|
:- import_module hlds.make_hlds.make_hlds_warn.
|
|
:- import_module hlds.make_hlds.state_var.
|
|
:- import_module hlds.make_hlds.superhomogeneous.
|
|
:- import_module hlds.pre_quantification.
|
|
:- import_module hlds.pred_table.
|
|
:- import_module libs.
|
|
:- import_module libs.globals.
|
|
:- import_module libs.options.
|
|
:- import_module parse_tree.module_qual.
|
|
:- import_module parse_tree.parse_inst_mode_name.
|
|
:- import_module parse_tree.parse_tree_out_info.
|
|
:- import_module parse_tree.parse_tree_out_pred_decl.
|
|
:- import_module parse_tree.prog_mode.
|
|
:- import_module parse_tree.prog_out.
|
|
:- import_module parse_tree.prog_rename.
|
|
:- import_module parse_tree.prog_util.
|
|
|
|
:- import_module bool.
|
|
:- import_module cord.
|
|
:- import_module int.
|
|
:- import_module io.
|
|
:- import_module map.
|
|
:- import_module require.
|
|
:- import_module string.
|
|
:- import_module varset.
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
|
|
module_add_clause(ClauseVarSet, PredOrFunc, PredName, ArgTerms0, MaybeBodyGoal,
|
|
Status, Context, MaybeSeqNum, GoalType,
|
|
!ModuleInfo, !QualInfo, !Specs) :-
|
|
( if
|
|
illegal_state_var_func_result(PredOrFunc, ArgTerms0, SVar, SVarCtxt)
|
|
then
|
|
IllegalSVarResult = yes({SVar, SVarCtxt})
|
|
else
|
|
IllegalSVarResult = no
|
|
),
|
|
ArityAdjustment = ( if IllegalSVarResult = yes(_) then -1 else 0 ),
|
|
expand_bang_state_pairs_in_terms(ArgTerms0, ArgTerms),
|
|
|
|
% Lookup the pred declaration in the predicate table.
|
|
% (If it's not there, call maybe_undefined_pred_error and insert
|
|
% an implicit declaration for the predicate.)
|
|
module_info_get_name(!.ModuleInfo, ModuleName),
|
|
list.length(ArgTerms, Arity0),
|
|
Arity = Arity0 + ArityAdjustment,
|
|
some [!PredInfo] (
|
|
module_info_get_predicate_table(!.ModuleInfo, PredicateTable),
|
|
predicate_table_lookup_pf_sym_arity(PredicateTable,
|
|
is_fully_qualified, PredOrFunc, PredName, Arity, PredIds),
|
|
( if PredIds = [PredIdPrime] then
|
|
MaybePredId = yes(PredIdPrime),
|
|
( if GoalType = goal_type_promise(_) then
|
|
NameString = sym_name_to_string(PredName),
|
|
string.format("%s %s %s (%s).\n",
|
|
[s("Attempted to introduce a predicate"),
|
|
s("for a promise with an identical"),
|
|
s("name to an existing predicate"),
|
|
s(NameString)], UnexpectedMsg),
|
|
unexpected($pred, UnexpectedMsg)
|
|
else
|
|
true
|
|
)
|
|
else if unqualify_name(PredName) = ",", Arity = 2 then
|
|
MaybePredId = no,
|
|
SNA = sym_name_arity(unqualified(","), 2),
|
|
Pieces = [words("Attempt to define a clause for"),
|
|
unqual_sym_name_arity(SNA), suffix("."),
|
|
words("This is usually caused by"),
|
|
words("inadvertently writing a period instead of a comma"),
|
|
words("at the end of the preceding line."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_parse_tree_to_hlds, Context, Pieces),
|
|
!:Specs = [Spec | !.Specs]
|
|
else
|
|
% A promise will not have a corresponding pred declaration.
|
|
( if GoalType = goal_type_promise(_) then
|
|
HeadVars = term.term_list_to_var_list(ArgTerms),
|
|
preds_add_implicit_for_assertion(!ModuleInfo, ModuleName,
|
|
PredName, Arity, PredOrFunc, HeadVars, Status, Context,
|
|
NewPredId)
|
|
else
|
|
preds_add_implicit_report_error(!ModuleInfo, ModuleName,
|
|
PredName, Arity, PredOrFunc, Status, is_not_a_class_method,
|
|
Context, origin_user(PredName), [words("clause")],
|
|
NewPredId, !Specs)
|
|
),
|
|
MaybePredId = yes(NewPredId)
|
|
),
|
|
(
|
|
MaybePredId = yes(PredId),
|
|
module_add_clause_2(ClauseVarSet, PredOrFunc, PredName, PredId,
|
|
ArgTerms, Arity, ArityAdjustment, MaybeBodyGoal,
|
|
Status, Context, MaybeSeqNum, GoalType, IllegalSVarResult,
|
|
!ModuleInfo, !QualInfo, !Specs)
|
|
;
|
|
MaybePredId = no
|
|
)
|
|
).
|
|
|
|
:- pred module_add_clause_2(prog_varset::in, pred_or_func::in, sym_name::in,
|
|
pred_id::in, list(prog_term)::in, int::in, int::in,
|
|
maybe2(goal, list(warning_spec))::in, pred_status::in, prog_context::in,
|
|
maybe(int)::in, goal_type::in, maybe({prog_var, prog_context})::in,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
module_add_clause_2(ClauseVarSet, PredOrFunc, PredName, PredId,
|
|
MaybeAnnotatedArgTerms, Arity, ArityAdjustment, MaybeBodyGoal,
|
|
PredStatus, Context, MaybeSeqNum, GoalType, IllegalSVarResult,
|
|
!ModuleInfo, !QualInfo, !Specs) :-
|
|
some [!PredInfo, !PredicateTable, !PredSpecs] (
|
|
% Lookup the pred_info for this pred, add the clause to the
|
|
% clauses_info in the pred_info, if there are no modes add an
|
|
% `infer_modes' marker, and then save the pred_info.
|
|
module_info_get_predicate_table(!.ModuleInfo, !:PredicateTable),
|
|
predicate_table_get_preds(!.PredicateTable, PredMap0),
|
|
map.lookup(PredMap0, PredId, !:PredInfo),
|
|
|
|
trace [io(!IO)] (
|
|
add_clause_progress_msg(!.ModuleInfo, !.PredInfo, PredOrFunc,
|
|
PredName, MaybeAnnotatedArgTerms, ArityAdjustment, !IO)
|
|
),
|
|
|
|
% Opt_imported preds are initially tagged as imported, and are tagged
|
|
% as opt_imported only if/when we see a clause for them.
|
|
( if PredStatus = pred_status(status_opt_imported) then
|
|
pred_info_set_status(pred_status(status_opt_imported), !PredInfo),
|
|
pred_info_get_markers(!.PredInfo, InitMarkers0),
|
|
add_marker(marker_calls_are_fully_qualified,
|
|
InitMarkers0, InitMarkers),
|
|
pred_info_set_markers(InitMarkers, !PredInfo)
|
|
else
|
|
true
|
|
),
|
|
|
|
!:PredSpecs = [],
|
|
(
|
|
IllegalSVarResult = yes({StateVar, StateVarContext}),
|
|
report_illegal_func_svar_result(StateVarContext, ClauseVarSet,
|
|
StateVar, !PredSpecs)
|
|
;
|
|
IllegalSVarResult = no
|
|
),
|
|
|
|
( if
|
|
% User-supplied clauses for field access functions are not
|
|
% allowed -- the clauses are always generated by the compiler.
|
|
PredOrFunc = pf_function,
|
|
adjust_func_arity(pf_function, FuncArity, Arity),
|
|
is_field_access_function_name(!.ModuleInfo, PredName,
|
|
FuncArity, _, _),
|
|
|
|
% Don't report errors for clauses for field access function clauses
|
|
% in `.opt' files.
|
|
PredStatus \= pred_status(status_opt_imported)
|
|
then
|
|
FieldPFSymNameArity =
|
|
pf_sym_name_arity(PredOrFunc, PredName, Arity),
|
|
FieldAccessMainPieces =
|
|
[words("Error: clause for"),
|
|
words("automatically generated field access"),
|
|
unqual_pf_sym_name_orig_arity(FieldPFSymNameArity),
|
|
suffix("."), nl],
|
|
FieldAccessVerbosePieces =
|
|
[words("Clauses for field access functions"),
|
|
words("are automatically generated by the compiler."),
|
|
words("To supply your own definition for a field access"),
|
|
words("function, for example to check the input"),
|
|
words("to a field update, give the field"),
|
|
words("of the constructor a different name.")],
|
|
FieldAccessMsg = simple_msg(Context,
|
|
[always(FieldAccessMainPieces),
|
|
verbose_only(verbose_always, FieldAccessVerbosePieces)]),
|
|
FieldAccessSpec = error_spec($pred, severity_error,
|
|
phase_parse_tree_to_hlds, [FieldAccessMsg]),
|
|
!:PredSpecs = [FieldAccessSpec | !.PredSpecs]
|
|
else
|
|
true
|
|
),
|
|
|
|
( if pred_info_is_builtin(!.PredInfo) then
|
|
% When bootstrapping a change that defines a builtin using
|
|
% normal Mercury code, we need to disable the generation
|
|
% of the error message, and just ignore the definition.
|
|
some [Globals] (
|
|
module_info_get_globals(!.ModuleInfo, Globals),
|
|
globals.lookup_bool_option(Globals, allow_defn_of_builtins,
|
|
AllowDefnOfBuiltin)
|
|
),
|
|
(
|
|
AllowDefnOfBuiltin = no,
|
|
BuiltinSpec = simplest_spec($pred, severity_error,
|
|
phase_parse_tree_to_hlds, Context,
|
|
[words("Error: clause for builtin.")]),
|
|
!:PredSpecs = [BuiltinSpec | !.PredSpecs]
|
|
;
|
|
AllowDefnOfBuiltin = yes
|
|
)
|
|
else
|
|
true
|
|
),
|
|
|
|
maybe_add_default_func_mode(!PredInfo, _),
|
|
(
|
|
!.PredSpecs = [_ | _ ],
|
|
!:Specs = !.PredSpecs ++
|
|
get_any_errors_warnings2(MaybeBodyGoal) ++ !.Specs
|
|
;
|
|
!.PredSpecs = [],
|
|
(
|
|
MaybeBodyGoal = error2(BodyGoalSpecs),
|
|
!:Specs = BodyGoalSpecs ++ !.Specs,
|
|
pred_info_get_clauses_info(!.PredInfo, Clauses0),
|
|
Clauses = Clauses0 ^ cli_had_syntax_errors :=
|
|
some_clause_syntax_errors,
|
|
pred_info_set_clauses_info(Clauses, !PredInfo)
|
|
;
|
|
MaybeBodyGoal = ok2(BodyGoal, BodyGoalWarningSpecs),
|
|
!:Specs = BodyGoalWarningSpecs ++ !.Specs,
|
|
pred_info_get_clauses_info(!.PredInfo, Clauses0),
|
|
pred_info_get_typevarset(!.PredInfo, TVarSet0),
|
|
select_applicable_modes(MaybeAnnotatedArgTerms, ClauseVarSet,
|
|
PredStatus, Context, PredId, !.PredInfo, ArgTerms,
|
|
ProcIdsForThisClause, AllProcIds,
|
|
!ModuleInfo, !QualInfo, !Specs),
|
|
clauses_info_add_clause(ProcIdsForThisClause, AllProcIds,
|
|
ClauseVarSet, TVarSet0, ArgTerms, BodyGoal,
|
|
Context, MaybeSeqNum, PredStatus, PredOrFunc, Arity,
|
|
GoalType, Goal, VarSet, TVarSet, Warnings,
|
|
Clauses0, Clauses, !ModuleInfo, !QualInfo, !Specs),
|
|
pred_info_set_clauses_info(Clauses, !PredInfo),
|
|
( if GoalType = goal_type_promise(PromiseType) then
|
|
pred_info_set_goal_type(goal_type_promise(PromiseType),
|
|
!PredInfo)
|
|
else
|
|
pred_info_update_goal_type(goal_type_clause, !PredInfo)
|
|
),
|
|
pred_info_set_typevarset(TVarSet, !PredInfo),
|
|
pred_info_get_arg_types(!.PredInfo, _ArgTVarSet, ExistQVars,
|
|
ArgTypes),
|
|
pred_info_set_arg_types(TVarSet, ExistQVars, ArgTypes,
|
|
!PredInfo),
|
|
|
|
% Check if there are still no modes for the predicate, and
|
|
% if so, set the `infer_modes' marker for that predicate.
|
|
% Predicates representing promises do not need mode inference.
|
|
|
|
ProcIds = pred_info_all_procids(!.PredInfo),
|
|
( if
|
|
ProcIds = [],
|
|
GoalType \= goal_type_promise(_)
|
|
then
|
|
pred_info_get_markers(!.PredInfo, EndMarkers0),
|
|
add_marker(marker_infer_modes, EndMarkers0, EndMarkers),
|
|
pred_info_set_markers(EndMarkers, !PredInfo)
|
|
else
|
|
true
|
|
),
|
|
( if
|
|
(
|
|
% Any singleton warnings should be generated
|
|
% for the original code, not for the copy
|
|
% in a .opt or .trans_opt file.
|
|
PredStatus = pred_status(status_opt_imported)
|
|
;
|
|
% Part of the parser's recovery from syntax errors
|
|
% (e.g. when they occur in lambda expressions' clause
|
|
% heads) may have included not translating parts
|
|
% of the original term into the parsed clause body,
|
|
% so any singleton warnings we generate for such
|
|
% "truncated" clauses could be misleading.
|
|
%
|
|
% We could try to record the set of variables
|
|
% in the parts of the original goal term that we don't
|
|
% include in the clause, but (a) this is not trivial
|
|
% to do, and (b) the payoff is questionable, because
|
|
% some of those variables could have been the result
|
|
% of typos affecting a word that the programmer meant
|
|
% to be something else.
|
|
Clauses ^ cli_had_syntax_errors =
|
|
some_clause_syntax_errors
|
|
)
|
|
then
|
|
true
|
|
else
|
|
% Warn about singleton variables.
|
|
WarnPFSymNameArity =
|
|
pf_sym_name_arity(PredOrFunc, PredName, Arity),
|
|
warn_singletons(!.ModuleInfo, WarnPFSymNameArity, VarSet,
|
|
Goal, !Specs),
|
|
% Warn about variables with overlapping scopes.
|
|
add_quant_warnings(WarnPFSymNameArity, VarSet, Warnings,
|
|
!Specs)
|
|
)
|
|
),
|
|
map.det_update(PredId, !.PredInfo, PredMap0, PredMap),
|
|
predicate_table_set_preds(PredMap, !PredicateTable),
|
|
module_info_set_predicate_table(!.PredicateTable, !ModuleInfo)
|
|
)
|
|
).
|
|
|
|
:- pred add_clause_progress_msg(module_info::in, pred_info::in,
|
|
pred_or_func::in, sym_name::in, list(prog_term)::in, int::in,
|
|
io::di, io::uo) is det.
|
|
|
|
add_clause_progress_msg(ModuleInfo, PredInfo, PredOrFunc, PredName,
|
|
MaybeAnnotatedArgTerms, ArityAdjustment, !IO) :-
|
|
module_info_get_globals(ModuleInfo, Globals),
|
|
globals.lookup_bool_option(Globals, very_verbose, VeryVerbose),
|
|
(
|
|
VeryVerbose = yes,
|
|
pred_info_get_clauses_info(PredInfo, MsgClauses),
|
|
NumClauses = num_clauses_in_clauses_rep(MsgClauses ^ cli_rep),
|
|
io.format("%% Processing clause %d for ",
|
|
[i(NumClauses + 1)], !IO),
|
|
write_pred_or_func_to_cur_stream(PredOrFunc, !IO),
|
|
io.write_string(" `", !IO),
|
|
list.length(MaybeAnnotatedArgTerms, PredArity0),
|
|
PredArity = PredArity0 + ArityAdjustment,
|
|
adjust_func_arity(PredOrFunc, OrigArity, PredArity),
|
|
SNA = sym_name_arity(PredName, OrigArity),
|
|
prog_out.write_sym_name_arity_to_cur_stream(SNA, !IO),
|
|
io.write_string("'...\n", !IO)
|
|
;
|
|
VeryVerbose = no
|
|
).
|
|
|
|
% Extract the mode annotations (if any) from the clause arguments,
|
|
% and determine which mode(s) this clause should apply to.
|
|
%
|
|
:- pred select_applicable_modes(list(prog_term)::in, prog_varset::in,
|
|
pred_status::in, prog_context::in, pred_id::in, pred_info::in,
|
|
list(prog_term)::out, clause_applicable_modes::out, list(proc_id)::out,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
select_applicable_modes(MaybeAnnotatedArgTerms, VarSet, PredStatus, Context,
|
|
PredId, PredInfo, ArgTerms, ApplProcIds, AllProcIds,
|
|
!ModuleInfo, !QualInfo, !Specs) :-
|
|
AllProcIds = pred_info_all_procids(PredInfo),
|
|
PredIdStr = pred_id_to_string(!.ModuleInfo, PredId),
|
|
ContextPieces = cord.from_list([words("In the head of a clause for"),
|
|
fixed(PredIdStr), suffix(":"), nl]),
|
|
get_mode_annotations(VarSet, ContextPieces, MaybeAnnotatedArgTerms, 1,
|
|
ArgTerms, ma_empty, ModeAnnotations, [], ModeAnnotationSpecs),
|
|
(
|
|
ModeAnnotationSpecs = [_ | _],
|
|
!:Specs = ModeAnnotationSpecs ++ !.Specs,
|
|
% Apply the clause to all modes.
|
|
% XXX Would it be better to apply it to none?
|
|
ApplProcIds = selected_modes(AllProcIds)
|
|
;
|
|
ModeAnnotationSpecs = [],
|
|
(
|
|
ModeAnnotations = ma_modes(ModeList0),
|
|
|
|
% The user specified some mode annotations on this clause.
|
|
% First module-qualify the mode annotations. The annotations on
|
|
% clauses from `.opt' files will already be fully module qualified.
|
|
|
|
( if PredStatus = pred_status(status_opt_imported) then
|
|
ModeList = ModeList0
|
|
else
|
|
Exported =
|
|
pred_status_is_exported_to_non_submodules(PredStatus),
|
|
(
|
|
Exported = yes,
|
|
InInt = mq_used_in_interface
|
|
;
|
|
Exported = no,
|
|
InInt = mq_not_used_in_interface
|
|
),
|
|
qual_info_get_mq_info(!.QualInfo, MQInfo0),
|
|
qualify_clause_mode_list(InInt, Context,
|
|
ModeList0, ModeList, MQInfo0, MQInfo, !Specs),
|
|
qual_info_set_mq_info(MQInfo, !QualInfo)
|
|
),
|
|
|
|
% Now find the procedure which matches these mode annotations.
|
|
pred_info_get_proc_table(PredInfo, Procs),
|
|
map.to_assoc_list(Procs, ExistingProcs),
|
|
( if
|
|
get_procedure_matching_declmodes_with_renaming(!.ModuleInfo,
|
|
ExistingProcs, ModeList, ProcId)
|
|
then
|
|
ApplProcIds = selected_modes([ProcId])
|
|
else
|
|
undeclared_mode_error(ModeList, VarSet, PredId, PredInfo,
|
|
!.ModuleInfo, Context, !Specs),
|
|
% Apply the clause to all modes.
|
|
% XXX Would it be better to apply it to none?
|
|
ApplProcIds = selected_modes(AllProcIds)
|
|
)
|
|
;
|
|
( ModeAnnotations = ma_empty
|
|
; ModeAnnotations = ma_none
|
|
),
|
|
( if pred_info_pragma_goal_type(PredInfo) then
|
|
% We are only allowed to mix foreign procs and
|
|
% mode specific clauses, so make this clause
|
|
% mode specific but apply to all modes.
|
|
ApplProcIds = selected_modes(AllProcIds)
|
|
else
|
|
ApplProcIds = all_modes
|
|
)
|
|
;
|
|
ModeAnnotations = ma_mixed,
|
|
Pieces = [words("In the head of a clause for"),
|
|
fixed(PredIdStr), suffix(":"), nl,
|
|
words("syntax error: some but not all arguments"),
|
|
words("have mode annotations."), nl],
|
|
Spec = simplest_spec($pred, severity_error,
|
|
phase_parse_tree_to_hlds, Context, Pieces),
|
|
!:Specs = [Spec | !.Specs],
|
|
|
|
% Apply the clause to all modes.
|
|
% XXX Would it be better to apply it to none?
|
|
ApplProcIds = selected_modes(AllProcIds)
|
|
)
|
|
).
|
|
|
|
:- pred undeclared_mode_error(list(mer_mode)::in, prog_varset::in,
|
|
pred_id::in, pred_info::in, module_info::in, prog_context::in,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
undeclared_mode_error(ModeList, VarSet, PredId, PredInfo, ModuleInfo, Context,
|
|
!Specs) :-
|
|
PredIdPieces = describe_one_pred_name(ModuleInfo,
|
|
should_not_module_qualify, PredId),
|
|
strip_builtin_qualifiers_from_mode_list(ModeList, StrippedModeList),
|
|
PredOrFunc = pred_info_is_pred_or_func(PredInfo),
|
|
Name = pred_info_name(PredInfo),
|
|
MaybeDet = no,
|
|
SubDeclStr = mercury_mode_subdecl_to_string(output_debug, PredOrFunc,
|
|
varset.coerce(VarSet), unqualified(Name), StrippedModeList, MaybeDet),
|
|
|
|
MainPieces = [words("In clause for")] ++ PredIdPieces ++ [suffix(":"), nl,
|
|
words("error: mode annotation specifies undeclared mode"),
|
|
quote(SubDeclStr), suffix("."), nl],
|
|
ProcIds = pred_info_all_procids(PredInfo),
|
|
(
|
|
ProcIds = [],
|
|
VerbosePieces = [words("(There are no declared modes for this"),
|
|
p_or_f(PredOrFunc), suffix(".)"), nl]
|
|
;
|
|
ProcIds = [ProcIdsHead | ProcIdsTail],
|
|
(
|
|
ProcIdsTail = [],
|
|
VerbosePieces = [words("The declared mode for this"),
|
|
p_or_f(PredOrFunc), words("is:"),
|
|
nl_indent_delta(1)] ++
|
|
mode_decl_for_pred_info_to_pieces(PredInfo, ProcIdsHead) ++
|
|
[nl_indent_delta(-1)]
|
|
;
|
|
ProcIdsTail = [_ | _],
|
|
VerbosePieces = [words("The declared modes for this"),
|
|
p_or_f(PredOrFunc), words("are the following:"),
|
|
nl_indent_delta(1)] ++
|
|
component_list_to_line_pieces(
|
|
list.map(mode_decl_for_pred_info_to_pieces(PredInfo),
|
|
ProcIds),
|
|
[]) ++
|
|
[nl_indent_delta(-1)]
|
|
)
|
|
),
|
|
Msg = simple_msg(Context,
|
|
[always(MainPieces), verbose_only(verbose_always, VerbosePieces)]),
|
|
Spec = error_spec($pred, severity_error, phase_parse_tree_to_hlds, [Msg]),
|
|
!:Specs = [Spec | !.Specs].
|
|
|
|
:- func mode_decl_for_pred_info_to_pieces(pred_info, proc_id)
|
|
= list(format_component).
|
|
|
|
mode_decl_for_pred_info_to_pieces(PredInfo, ProcId) =
|
|
[words(":- mode"),
|
|
words(mode_decl_to_string(output_debug, ProcId, PredInfo)),
|
|
suffix(".")].
|
|
|
|
% Clauses can have mode annotations on them, to indicate that the
|
|
% clause should only be used for particular modes of a predicate.
|
|
% This type specifies the mode annotations on a clause.
|
|
:- type mode_annotations
|
|
---> ma_empty
|
|
% No arguments.
|
|
|
|
; ma_none
|
|
% One or more arguments, each without any mode annotations.
|
|
|
|
; ma_modes(list(mer_mode))
|
|
% One or more arguments, each with a mode annotation.
|
|
|
|
; ma_mixed.
|
|
% Two or more arguments, including some with mode annotations
|
|
% and some without. (This is not allowed.)
|
|
|
|
% Extract the mode annotations (if any) from a list of arguments.
|
|
%
|
|
:- pred get_mode_annotations(prog_varset::in, cord(format_component)::in,
|
|
list(prog_term)::in, int::in, list(prog_term)::out,
|
|
mode_annotations::in, mode_annotations::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
get_mode_annotations(_, _, [], _, [], !Annotations, !Specs).
|
|
get_mode_annotations(VarSet, ContextPieces,
|
|
[MAArgTerm | MAArgTerms], ArgNum, [ArgTerm | ArgTerms],
|
|
!Annotations, !Specs) :-
|
|
ArgContextPieces = ContextPieces ++
|
|
cord.from_list([words("in the"), nth_fixed(ArgNum),
|
|
words("argument:"), nl]),
|
|
get_mode_annotation(VarSet, ArgContextPieces, MAArgTerm, ArgTerm,
|
|
MaybeMaybeMode),
|
|
(
|
|
MaybeMaybeMode = ok1(MaybeMode),
|
|
add_annotation(MaybeMode, !Annotations)
|
|
;
|
|
MaybeMaybeMode = error1(MaybeModeSpecs),
|
|
!:Specs = !.Specs ++ MaybeModeSpecs
|
|
),
|
|
get_mode_annotations(VarSet, ContextPieces,
|
|
MAArgTerms, ArgNum + 1, ArgTerms, !Annotations, !Specs).
|
|
|
|
:- pred add_annotation(maybe(mer_mode)::in,
|
|
mode_annotations::in, mode_annotations::out) is det.
|
|
|
|
add_annotation(no, ma_empty, ma_none).
|
|
add_annotation(yes(Mode), ma_empty, ma_modes([Mode])).
|
|
add_annotation(no, ma_modes(_ : list(mer_mode)), ma_mixed).
|
|
add_annotation(yes(Mode), ma_modes(Modes), ma_modes(Modes ++ [Mode])).
|
|
add_annotation(no, ma_none, ma_none).
|
|
add_annotation(yes(_), ma_none, ma_mixed).
|
|
add_annotation(_, ma_mixed, ma_mixed).
|
|
|
|
% Extract the mode annotations (if any) from a single argument.
|
|
%
|
|
:- pred get_mode_annotation(prog_varset::in, cord(format_component)::in,
|
|
prog_term::in, prog_term::out, maybe1(maybe(mer_mode))::out) is det.
|
|
|
|
get_mode_annotation(VarSet, ContextPieces, MaybeAnnotatedArgTerm, ArgTerm,
|
|
MaybeMaybeAnnotation) :-
|
|
( if
|
|
MaybeAnnotatedArgTerm = term.functor(term.atom("::"),
|
|
[ArgTermPrime, ModeTerm], _)
|
|
then
|
|
ArgTerm = ArgTermPrime,
|
|
|
|
varset.coerce(VarSet, GenVarSet),
|
|
term.coerce(ModeTerm, GenModeTerm),
|
|
parse_mode(allow_constrained_inst_var, GenVarSet, ContextPieces,
|
|
GenModeTerm, MaybeMode),
|
|
(
|
|
MaybeMode = ok1(Mode),
|
|
MaybeMaybeAnnotation = ok1(yes(Mode))
|
|
;
|
|
MaybeMode = error1(Specs),
|
|
MaybeMaybeAnnotation = error1(Specs)
|
|
)
|
|
else
|
|
ArgTerm = MaybeAnnotatedArgTerm,
|
|
MaybeMaybeAnnotation = ok1(no)
|
|
).
|
|
|
|
clauses_info_add_clause(ApplModeIds0, AllModeIds, CVarSet, TVarSet0, ArgTerms,
|
|
BodyGoal, Context, MaybeSeqNum, PredStatus, PredOrFunc, Arity,
|
|
GoalType, Goal, VarSet, TVarSet, QuantWarnings,
|
|
!ClausesInfo, !ModuleInfo, !QualInfo, !Specs) :-
|
|
!.ClausesInfo = clauses_info(VarSet0, TVarNameMap0,
|
|
ExplicitVarTypes0, InferredVarTypes, HeadVars,
|
|
ClausesRep0, ItemNumbers0, RttiVarMaps,
|
|
HasForeignClauses, HadSyntaxError0),
|
|
IsEmpty = clause_list_is_empty(ClausesRep0),
|
|
(
|
|
IsEmpty = yes,
|
|
% Create the mapping from type variable name, used to rename
|
|
% type variables occurring in explicit type qualifications.
|
|
% The version of this mapping stored in the clauses_info should
|
|
% only contain type variables which occur in the argument types
|
|
% of the predicate. Type variables which only occur in explicit type
|
|
% qualifications are local to the clause in which they appear.
|
|
varset.create_name_var_map(TVarSet0, TVarNameMap)
|
|
;
|
|
IsEmpty = no,
|
|
TVarNameMap = TVarNameMap0
|
|
),
|
|
( if PredStatus = pred_status(status_opt_imported) then
|
|
MaybeOptImported = is_opt_imported
|
|
else
|
|
MaybeOptImported = is_not_opt_imported
|
|
),
|
|
update_qual_info(TVarNameMap, TVarSet0, ExplicitVarTypes0,
|
|
MaybeOptImported, !QualInfo),
|
|
varset.merge_renaming(VarSet0, CVarSet, VarSet1, Renaming),
|
|
add_clause_transform(Renaming, HeadVars, ArgTerms, BodyGoal, Context,
|
|
PredOrFunc, Arity, GoalType, Goal0, VarSet1, VarSet,
|
|
QuantWarnings, StateVarWarnings, StateVarErrors,
|
|
!ModuleInfo, !QualInfo, !Specs),
|
|
qual_info_get_tvarset(!.QualInfo, TVarSet),
|
|
qual_info_get_found_syntax_error(!.QualInfo, FoundError),
|
|
qual_info_set_found_syntax_error(no, !QualInfo),
|
|
( if
|
|
( FoundError = yes
|
|
; StateVarErrors = [_ | _]
|
|
)
|
|
then
|
|
% Don't insert clauses containing syntax errors into the
|
|
% clauses_info, because doing that would cause typecheck.m
|
|
% to report spurious type errors. Don't report singleton variable
|
|
% warnings if there were syntax errors.
|
|
!:Specs = StateVarErrors ++ !.Specs,
|
|
Goal = true_goal,
|
|
!ClausesInfo ^ cli_had_syntax_errors := some_clause_syntax_errors
|
|
else
|
|
Goal = Goal0,
|
|
% If we have foreign clauses, we should only add this clause
|
|
% for modes *not* covered by the foreign clauses.
|
|
(
|
|
HasForeignClauses = some_foreign_lang_clauses,
|
|
get_clause_list(Clauses0, ClausesRep0, ClausesRep1),
|
|
ForeignModeIds = list.condense(list.filter_map(
|
|
( func(C) = ProcIds is semidet :-
|
|
C ^ clause_lang = impl_lang_foreign(_),
|
|
ApplProcIds = C ^ clause_applicable_procs,
|
|
(
|
|
ApplProcIds = all_modes,
|
|
unexpected($pred, "all_modes foreign_proc")
|
|
;
|
|
ApplProcIds = selected_modes(ProcIds)
|
|
;
|
|
( ApplProcIds = unify_in_in_modes
|
|
; ApplProcIds = unify_non_in_in_modes
|
|
),
|
|
unexpected($pred, "unify modes for foreign_proc")
|
|
)
|
|
),
|
|
Clauses0)),
|
|
(
|
|
ApplModeIds0 = all_modes,
|
|
ModeIds0 = AllModeIds
|
|
;
|
|
ApplModeIds0 = selected_modes(ModeIds0)
|
|
;
|
|
( ApplModeIds0 = unify_in_in_modes
|
|
; ApplModeIds0 = unify_non_in_in_modes
|
|
),
|
|
unexpected($pred, "unify modes for user defined predicate")
|
|
),
|
|
ModeIds = list.delete_elems(ModeIds0, ForeignModeIds),
|
|
(
|
|
ModeIds = [],
|
|
ClausesRep = ClausesRep1
|
|
;
|
|
ModeIds = [_ | _],
|
|
ApplicableModeIds = selected_modes(ModeIds),
|
|
Clause = clause(ApplicableModeIds, Goal, impl_lang_mercury,
|
|
Context, StateVarWarnings),
|
|
add_clause(Clause, ClausesRep1, ClausesRep)
|
|
)
|
|
;
|
|
HasForeignClauses = no_foreign_lang_clauses,
|
|
Clause = clause(ApplModeIds0, Goal, impl_lang_mercury, Context,
|
|
StateVarWarnings),
|
|
add_clause(Clause, ClausesRep0, ClausesRep)
|
|
),
|
|
qual_info_get_var_types(!.QualInfo, ExplicitVarTypes),
|
|
add_clause_item_number(MaybeSeqNum, Context, item_is_clause,
|
|
ItemNumbers0, ItemNumbers),
|
|
!:ClausesInfo = clauses_info(VarSet, TVarNameMap,
|
|
ExplicitVarTypes, InferredVarTypes, HeadVars,
|
|
ClausesRep, ItemNumbers, RttiVarMaps,
|
|
HasForeignClauses, HadSyntaxError0)
|
|
).
|
|
|
|
% ArgTerms0 has already had !S arguments replaced by
|
|
% !.S, !:S argument pairs.
|
|
%
|
|
:- pred add_clause_transform(prog_var_renaming::in,
|
|
proc_arg_vector(prog_var)::in, list(prog_term)::in, goal::in,
|
|
prog_context::in, pred_or_func::in, arity::in, goal_type::in,
|
|
hlds_goal::out, prog_varset::in, prog_varset::out,
|
|
list(quant_warning)::out, list(error_spec)::out, list(error_spec)::out,
|
|
module_info::in, module_info::out, qual_info::in, qual_info::out,
|
|
list(error_spec)::in, list(error_spec)::out) is det.
|
|
|
|
add_clause_transform(Renaming, HeadVars, ArgTerms0, ParseTreeBodyGoal, Context,
|
|
PredOrFunc, Arity, GoalType, Goal, !VarSet,
|
|
QuantWarnings, StateVarWarnings, StateVarErrors,
|
|
!ModuleInfo, !QualInfo, !Specs) :-
|
|
some [!SInfo, !SVarState, !SVarStore] (
|
|
HeadVarList = proc_arg_vector_to_list(HeadVars),
|
|
rename_vars_in_term_list(need_not_rename, Renaming,
|
|
ArgTerms0, ArgTerms1),
|
|
svar_prepare_for_clause_head(ArgTerms1, ArgTerms, !VarSet,
|
|
FinalSVarMap, !:SVarState, !:SVarStore, !Specs),
|
|
InitialSVarState = !.SVarState,
|
|
( if GoalType = goal_type_promise(_) then
|
|
HeadGoal = true_goal
|
|
else
|
|
ArgContext = ac_head(PredOrFunc, Arity),
|
|
HeadGoal0 = true_goal,
|
|
pair_vars_with_terms(HeadVarList, ArgTerms, HeadVarsArgTerms),
|
|
insert_arg_unifications(HeadVarsArgTerms, Context, ArgContext,
|
|
HeadGoal0, HeadGoal1, !SVarState, !SVarStore, !VarSet,
|
|
!ModuleInfo, !QualInfo, !Specs),
|
|
% The only pass that pays attention to the from_head feature,
|
|
% switch_detection, only does so on kinds of hlds_goal_exprs
|
|
% that do not occur in from_ground_term scopes, which we have
|
|
% just marked as from_ground_term_initial. Those scopes will be
|
|
% converted to one of from_ground_term_{construct,deconstruct,
|
|
% other} by mode analysis, if type analysis hasn't done it first.
|
|
% Type analysis will do this if it finds that some of the
|
|
% "unifications" inside these scopes are actually calls.
|
|
% Switch detection *does* care about from_head features on calls,
|
|
% and it looks inside all scopes except those of the
|
|
% from_ground_term_construct kind. Therefore any code that can be
|
|
% executed between now and switch detection that converts a
|
|
% from_ground_term_initial or from_ground_term_construct scope
|
|
% to another kind of scope should attach any from_head feature
|
|
% present on the scope to all its subgoals.
|
|
attach_features_to_all_goals([feature_from_head],
|
|
do_not_attach_in_from_ground_term, HeadGoal1, HeadGoal)
|
|
),
|
|
transform_parse_tree_goal_to_hlds(loc_whole_goal, ParseTreeBodyGoal,
|
|
Renaming, BodyGoal, !SVarState, !SVarStore, !VarSet,
|
|
!ModuleInfo, !QualInfo, !Specs),
|
|
|
|
trace [compiletime(flag("debug-statevar-lambda")), io(!IO)] (
|
|
io.output_stream(Stream, !IO),
|
|
io.write_string(Stream, "\nCLAUSE HEAD\n", !IO),
|
|
io.write_string(Stream, "arg terms before:\n", !IO),
|
|
list.foldl(io.write_line(Stream), ArgTerms0, !IO),
|
|
io.write_string(Stream, "arg terms renamed:\n", !IO),
|
|
list.foldl(io.write_line(Stream), ArgTerms1, !IO),
|
|
io.write_string(Stream, "arg terms after:\n", !IO),
|
|
list.foldl(io.write_line(Stream), ArgTerms, !IO),
|
|
io.write_string(Stream, "head vars:\n", !IO),
|
|
io.write(Stream, HeadVarList, !IO),
|
|
io.nl(Stream, !IO),
|
|
io.write_string(Stream, "arg unifies:\n", !IO),
|
|
dump_goal(Stream, !.ModuleInfo, !.VarSet, HeadGoal, !IO),
|
|
io.nl(Stream, !IO),
|
|
io.write_string(Stream, "clause body:\n", !IO),
|
|
dump_goal(Stream, !.ModuleInfo, !.VarSet, BodyGoal, !IO),
|
|
io.nl(Stream, !IO),
|
|
some [FinalSVarList] (
|
|
map.to_assoc_list(FinalSVarMap, FinalSVarList),
|
|
io.write_string(Stream, "FinalSVarMap:\n", !IO),
|
|
io.write(Stream, FinalSVarList, !IO),
|
|
io.nl(Stream, !IO)
|
|
)
|
|
),
|
|
|
|
FinalSVarState = !.SVarState,
|
|
module_info_get_globals(!.ModuleInfo, Globals),
|
|
svar_finish_clause_body(Globals, Context, FinalSVarMap,
|
|
HeadGoal, BodyGoal, Goal0, InitialSVarState, FinalSVarState,
|
|
!.SVarStore, StateVarWarnings, StateVarErrors),
|
|
|
|
qual_info_get_found_trace_goal(!.QualInfo, FoundTraceGoal),
|
|
(
|
|
FoundTraceGoal = no,
|
|
Goal1 = Goal0
|
|
;
|
|
FoundTraceGoal = yes,
|
|
separate_trace_goal_only_locals(Goal0, Goal1)
|
|
),
|
|
qual_info_get_var_types(!.QualInfo, VarTypes0),
|
|
% The RTTI varmaps here are just a dummy value, because the real ones
|
|
% are not introduced until polymorphism.
|
|
rtti_varmaps_init(EmptyRttiVarmaps),
|
|
% XXX It should be possible to exploit the fact that lambda expressions
|
|
% are not yet recognized as such inside from_ground_term scopes.
|
|
implicitly_quantify_clause_body_general(
|
|
ordinary_nonlocals_maybe_lambda,
|
|
HeadVarList, QuantWarnings, Goal1, Goal,
|
|
!VarSet, VarTypes0, VarTypes, EmptyRttiVarmaps, _),
|
|
qual_info_set_var_types(VarTypes, !QualInfo)
|
|
).
|
|
|
|
%-----------------------------------------------------------------------------%
|
|
:- end_module hlds.make_hlds.add_clause.
|
|
%-----------------------------------------------------------------------------%
|