Files
mercury/compiler/term_constr_initial.m
Zoltan Somogyi d609181cb9 Consider types of the form
Estimated hours taken: 30
Branches: main

Consider types of the form

	:- type x ---> f.

to be dummy types, since they contain no information. Optimize them the same
way we currently optimize io.state and store.store.

runtime/mercury_type_info.h:
	Add a new type_ctor_rep for dummy types.

runtime/mercury_tabling.h:
	Add a representation for "tabled" dummy types, which don't actually
	have a level in the trie, so that the runtime system can handle that
	fact.

runtime/mercury_ml_expand_body.h:
	When deconstructing a value of a dummy type, ignore the actual value
	(since it will contain garbage) and instead return the only possible
	value of the type.

runtime/mercury_construct.c:
runtime/mercury_deconstruct.c:
runtime/mercury_deep_copy_body.c:
runtime/mercury_tabling.c:
runtime/mercury_unify_compare_body.h:
library/rtti_implementation.m:
	Handle the type_ctor_rep of dummy types.

runtime/mercury_builtin_types.c:
	Provide a place to record profiling information about unifications and
	comparisons for dummy types.

runtime/mercury_mcpp.h:
java/runtime/TypeCtorRep.java:
library/private_builtin.m:
	Add a new type_ctor_rep for dummy types, and fix some previous
	discrepancies in type_ctor_reps.

mdbcomp/prim_data.m:
	Move a bunch of predicates for manipulating special_pred_ids here from
	the browser and compiler directories.

	Rename the function symbols of the special_pred_id type to avoid the
	need to parenthesize the old `initialise' function symbol.

	Convert to four-space indentation.

mdbcomp/rtti_access.m:
	Don't hardcode the names of special preds: use the predicates in
	prim_data.m.

	Convert to four-space indentation.

browser/declarative_execution.m:
	Delete some predicates whose functionality is now in
	mdbcomp/prim_data.m.

compiler/hlds_data.m:
	Replace the part of du type that says whether a type an enum, which
	used to be a bool, with something that also says whether the type is a
	dummy type.

	Convert to four-space indentation.

compiler/make_tags.m:
	Compute the value for the new field of du type definitions.

compiler/hlds_out.m:
	Write out the new field of du type definitions.

compiler/rtti.m:
	Modify the data structures we use to create type_ctor_infos to allow
	for dummy types.

	Convert to four-space indentation.

compiler/type_ctor_info.m:
	Modify the code that generates type_ctor_infos to handle dummy types.

compiler/type_util.m:
	Provide predicates for recognizing dummy types.

	Convert to four-space indentation.

compiler/unify_proc.m:
	Generate the unify and compare predicates of dummy types using a new
	code scheme that avoids referencing arguments that contain garbage.

	When generating code for unifying or comparing other types, ignore
	any arguments of function symbols that are dummy types.

	Don't use DCG style access predicates.

compiler/higher_order.m:
	Specialize the unification and comparison of values of dummy types.

	Break up an excessively large predicate, and factor out common code
	from the conditions of a chain of if-then-elses.

compiler/llds.m:
	For each input and output of a foreign_proc, include a field saying
	whether the value is of a dummy type.

compiler/pragma_c_gen.m:
	Fill in the new fields in foreign_proc arguments.

compiler/hlds_goal.m:
	Rename some predicates for constructing unifications to avoid
	unnecessary ad-hoc overloading. Clarify their documentation.

	Rename a predicate to make clear the restriction on its use,
	and document the restriction.

	Add a predicate for creating simple tests.

	Add a utility predicate for setting the context of a goal directly.

compiler/modules.m:
	Include dummy types interface files, even if they are private to the
	module. This is necessary because with the MLDS backend, the generated
	code inside the module and outside the module must agree whether a
	function returning a value of the type returns a real value or a void
	value, and this requires them to agree on whether the type is dummy
	or not.

	The impact on interface files is minimal, since very few types are
	dummy types, and changing a type from a dummy type to a non-dummy type
	or vice versa is an ever rarer change.

compiler/hlds_pred.m:
	Provide a representation in the compiler of the trie step for dummy
	types.

compiler/layout_out.m:
	Print the trie step for dummy types.

compiler/table_gen.m:
	Don't table values of dummy types, and record the fact that we don't
	by including a dummy trie step in the list of trie steps.

compiler/add_pragma.m:
compiler/add_special_pred.m:
compiler/add_type.m:
compiler/aditi_builtin_ops.m:
compiler/bytecode.m:
compiler/bytecode_gen.m:
compiler/code_gen.m:
compiler/code_info.m:
compiler/continuation_info.m:
compiler/cse_detection.m:
compiler/det_report.m:
compiler/exception_analysis.m:
compiler/inst_match.m:
compiler/livemap.m:
compiler/llds_out.m:
compiler/llds_out.m:
compiler/middle_rec.m:
compiler/ml_call_gen.m:
compiler/ml_closure_gen.m:
compiler/ml_code_gen.m:
compiler/ml_code_util.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_il.m:
compiler/modecheck_unify.m:
compiler/modes.m:
compiler/opt_util.m:
compiler/post_term_analysis.m:
compiler/post_typecheck.m:
compiler/qual_info.m:
compiler/rl.m:
compiler/rl_exprn.m:
compiler/rl_key.m:
compiler/rtti_out.m:
compiler/simplify.m:
compiler/size_prof.m:
compiler/term_constr_initial.m:
compiler/term_constr_util.m:
compiler/term_norm.m:
compiler/termination.m:
compiler/trace.m:
compiler/typecheck.m:
compiler/unify_gen.m:
	Conform to the changes above.

compiler/export.m:
compiler/exprn_aux.m:
compiler/foreign.m:
compiler/polymorphism.m:
compiler/proc_label.m:
compiler/rtti_to_mlds.m:
compiler/special_pred.m:
compiler/stack_alloc.m:
compiler/stack_layout.m:
compiler/state_var.m:
compiler/switch_util.m:
compiler/trace_params.m:
	Conform to the changes above.

	Convert to four-space indentation.

compiler/mlds_to_java.m:
compiler/var_locn.m:
	Conform to the changes above, which requires threading the module_info
	through the module.

	Convert to four-space indentation.

compiler/mercury_compile.m:
	Pass the module_info to mlds_to_java.m.

compiler/ml_util.m:
compiler/polymorphism.m:
compiler/type_ctor_info.m:
compiler/type_util.m:
	Delete some previously missed references to the temporary types used
	to bootstrap the change to the type_info type's arity.

compiler/polymorphism.m:
	Turn back on an optimization that avoids passing parameters (such as
	type_infos) to foreign_procs if they are not actually referred to.

compiler/prog_data.m:
	Convert to four-space indentation.

library/svvarset.m:
	Add a missing predicate.

trace/mercury_trace.c:
	Delete the unused function that used to check for dummy types.

tests/debugger/field_names.{m,inp,exp}:
	Add to this test case a test of the handling of dummy types. Check that
	their values can be printed out during normal execution, and that the
	debugger doesn't consider them live nondummy variables, just as it
	doesn't consider I/O states live nondummy variables.
2005-10-05 06:34:27 +00:00

607 lines
24 KiB
Mathematica

%-----------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%----------------------------------------------------------------------------%
% Copyright (C) 2003, 2005 The University of Melbourne.
% This file may only be copied under the terms of the GNU General
% Public License - see the file COPYING in the Mercury distribution.
%----------------------------------------------------------------------------%
%
% file: term_constr_initial.m
% main author: juliensf
%
% This module fills in the appropriate argument size information and
% termination property for builtin and compiler generated predicates.
% It also handles the processing of termination pragmas and sets
% the termination properties for foreign procedures.
% Handling of pragma terminates/does_not_terminate
%
% At the moment we set the termination status as appropriate, set the arg
% size information to true and fill in the size_var_map with dummy values
% (because intermodule optimization requires these values to be in place).
% If we ever support user specified arg size constraints this scheme
% will need modifying - in particular we will need to make sure that
% the identity of the variables in the size_var_map matches those
% in the constraints.
% A lot of this code is based on that in termination.m that does the
% equivalent jobs for the old termination analyser.
%----------------------------------------------------------------------------%
:- module transform_hlds.term_constr_initial.
:- interface.
:- import_module hlds.hlds_module.
:- import_module io.
% Prepare a module for running the main termination pass.
% This involves setting up argument size and termination information
% for builtin and compiler-generated predicates and also setting
% the termination status of those predicates that have termination
% pragmas attached to them.
%
% XXX Fix handling of terminates/does_not_terminate foreign proc.
% attributes.
%
:- pred term_constr_initial.preprocess_module(module_info::in,
module_info::out, io::di, io::uo) is det.
%----------------------------------------------------------------------------%
%----------------------------------------------------------------------------%
:- implementation.
:- import_module check_hlds.inst_match.
:- import_module check_hlds.mode_util.
:- import_module check_hlds.type_util.
:- import_module hlds.hlds_data.
:- import_module hlds.hlds_goal.
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_out.
:- import_module hlds.passes_aux.
:- import_module hlds.special_pred.
:- import_module libs.globals.
:- import_module libs.lp_rational.
:- import_module libs.options.
:- import_module libs.polyhedron.
:- import_module libs.rat.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.error_util.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.modules.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_util.
:- import_module transform_hlds.term_constr_main.
:- import_module transform_hlds.dependency_graph.
:- import_module transform_hlds.term_constr_util.
:- import_module transform_hlds.term_constr_errors.
:- import_module transform_hlds.term_constr_data.
:- import_module transform_hlds.term_norm.
:- import_module bool.
:- import_module bag.
:- import_module char.
:- import_module int.
:- import_module list.
:- import_module map.
:- import_module relation.
:- import_module require.
:- import_module set.
:- import_module std_util.
:- import_module string.
:- import_module svmap.
:- import_module svvarset.
:- import_module term.
:- import_module varset.
%----------------------------------------------------------------------------%
%
% Process each predicate and set the termination property
%
% Sets termination to `cannot_loop' if:
% - there is a `terminates' pragma defined for the predicate.
% - there is a `check_termination' pragma defined for the predicate
% *and* the compiler is not currently generating the intermodule
% optimization file.
% - the predicate is builtin or compiler generated. (These are assumed
% to terminate.)
%
% Set the termination to `can_loop' if:
% - there is a `does_not_terminate' pragma defined for this predicate.
% - the predicate is imported and there is no other source of information
% - about it (termination_info pragmas, terminates pragmas, builtin).
%
% XXX This does the wrong thing for copy/2 & typed_unify/2. In both
% cases the constraints should that |HeadVar__1| = |HeadVar__2|.
preprocess_module(!ModuleInfo, !IO) :-
module_info_predids(!.ModuleInfo, PredIds),
process_builtin_preds(PredIds, !ModuleInfo, !IO),
process_imported_preds(PredIds, !ModuleInfo).
%----------------------------------------------------------------------------%
%
% Set the argument size constraints for imported procedures.
%
% When interargument size constraints are imported from other modules there
% are two parts. The first of the these is a list of ints. Each int
% represents one of a procedure's arguments (including typeinfo related ones).
%
% XXX Since typeinfos all became zero sized we don't actually need this list.
% (I forget the reason we did need it, I think it was something to do with
% the fact that the compiler cannot (presently) distinguish between typeinfos
% it has introduced and ones that were there anyway - in some of the library
% modules).
%
% The second piece of information here is the constraints themselves which
% have been using the integer variable ids to represent actual variables.
%
% We now know the actual head_vars so we create size_vars and substitute
% these into the actual constraints.
%
:- pred process_imported_preds(list(pred_id)::in,
module_info::in, module_info::out) is det.
process_imported_preds(PredIds, !ModuleInfo) :-
list.foldl(process_imported_pred, PredIds, !ModuleInfo).
:- pred process_imported_pred(pred_id::in, module_info::in, module_info::out)
is det.
process_imported_pred(PredId, !ModuleInfo) :-
some [!PredTable] (
module_info_preds(!.ModuleInfo, !:PredTable),
module_info_get_type_spec_info(!.ModuleInfo, TypeSpecInfo),
TypeSpecInfo = type_spec_info(_, TypeSpecPredIds, _, _),
( not set.member(PredId, TypeSpecPredIds) ->
PredInfo0 = !.PredTable ^ det_elem(PredId),
process_imported_procs(PredInfo0, PredInfo),
svmap.det_update(PredId, PredInfo, !PredTable),
module_info_set_preds(!.PredTable, !ModuleInfo)
;
true
)
).
:- pred process_imported_procs(pred_info::in, pred_info::out) is det.
process_imported_procs(!PredInfo) :-
some [!ProcTable] (
pred_info_procedures(!.PredInfo, !:ProcTable),
ProcIds = pred_info_procids(!.PredInfo),
list.foldl(process_imported_proc, ProcIds, !ProcTable),
pred_info_set_procedures(!.ProcTable, !PredInfo)
).
:- pred process_imported_proc(proc_id::in, proc_table::in, proc_table::out)
is det.
process_imported_proc(ProcId, !ProcTable) :-
some [!ProcInfo] (
!:ProcInfo = !.ProcTable ^ det_elem(ProcId),
proc_info_get_termination2_info(!.ProcInfo, TermInfo0),
(
% Check that there is something to import.
TermInfo0 ^ import_success = yes(_)
->
process_imported_term_info(!.ProcInfo, TermInfo0, TermInfo),
proc_info_set_termination2_info(TermInfo, !ProcInfo),
svmap.det_update(ProcId, !.ProcInfo, !ProcTable)
;
true
)
).
:- pred process_imported_term_info(proc_info::in,
termination2_info::in, termination2_info::out) is det.
process_imported_term_info(ProcInfo, !TermInfo) :-
proc_info_headvars(ProcInfo, HeadVars),
make_size_var_map(HeadVars, _SizeVarset, SizeVarMap),
list.length(HeadVars, NumHeadVars),
HeadVarIds = 0 .. NumHeadVars - 1,
map.from_corresponding_lists(HeadVarIds, HeadVars, IdsToProgVars),
create_substitution_map(HeadVarIds, IdsToProgVars, SizeVarMap, SubstMap),
create_arg_size_polyhedron(SubstMap, !.TermInfo ^ import_success,
MaybeSuccessPoly),
create_arg_size_polyhedron(SubstMap, !.TermInfo ^ import_failure,
MaybeFailurePoly),
SizeVars = prog_vars_to_size_vars(SizeVarMap, HeadVars),
!:TermInfo = !.TermInfo ^ size_var_map := SizeVarMap,
!:TermInfo = !.TermInfo ^ head_vars := SizeVars,
!:TermInfo = !.TermInfo ^ success_constrs := MaybeSuccessPoly,
!:TermInfo = !.TermInfo ^ failure_constrs := MaybeFailurePoly,
%
% We don't use these fields after this point.
%
!:TermInfo = !.TermInfo ^ import_success := no,
!:TermInfo = !.TermInfo ^ import_failure := no.
:- pred create_substitution_map(list(int)::in, map(int, prog_var)::in,
size_var_map::in, map(int, size_var)::out) is det.
create_substitution_map(Ids, IdToProgVar, SizeVarMap, IdToSizeVar) :-
list.foldl((pred(Id::in, !.Map::in, !:Map::out) is det :-
ProgVar = IdToProgVar ^ det_elem(Id),
SizeVar = map.lookup(SizeVarMap, ProgVar),
svmap.set(Id, SizeVar, !Map)
), Ids, map.init, IdToSizeVar).
:- pred create_arg_size_polyhedron(map(int, var)::in,
maybe(pragma_constr_arg_size_info)::in, maybe(polyhedron)::out) is det.
create_arg_size_polyhedron(_, no, no).
create_arg_size_polyhedron(SubstMap, yes(PragmaArgSizeInfo),
yes(Polyhedron)) :-
list.map(create_arg_size_constraint(SubstMap), PragmaArgSizeInfo,
Constraints),
Polyhedron = polyhedron.from_constraints(Constraints).
:- pred create_arg_size_constraint(map(int, var)::in, arg_size_constr::in,
constraint::out) is det.
create_arg_size_constraint(SubstMap, le(Terms0, Constant), Constraint) :-
list.map(create_lp_term(SubstMap), Terms0, Terms),
Constraint = constraint(Terms, (=<), Constant).
create_arg_size_constraint(SubstMap, eq(Terms0, Constant), Constraint) :-
list.map(create_lp_term(SubstMap), Terms0, Terms),
Constraint = constraint(Terms, (=), Constant).
:- pred create_lp_term(map(int, var)::in, pair(int, rat)::in, lp_term::out)
is det.
create_lp_term(SubstMap, VarId - Coefficient, Var - Coefficient) :-
Var = SubstMap ^ det_elem(VarId).
%----------------------------------------------------------------------------%
%
% Set up information for builtins.
%
:- pred process_builtin_preds(list(pred_id)::in,
module_info::in, module_info::out, io::di, io::uo) is det.
process_builtin_preds([], !ModuleInfo, !IO).
process_builtin_preds([PredId | PredIds], !ModuleInfo, !IO) :-
write_pred_progress_message("% Termination checking ", PredId,
!.ModuleInfo, !IO),
globals.io_lookup_bool_option(make_optimization_interface, MakeOptInt,
!IO),
some [!PredTable] (
module_info_preds(!.ModuleInfo, !:PredTable),
PredInfo0 = !.PredTable ^ det_elem(PredId),
process_builtin_procs(MakeOptInt, PredId, !.ModuleInfo,
PredInfo0, PredInfo),
svmap.det_update(PredId, PredInfo, !PredTable),
module_info_set_preds(!.PredTable, !ModuleInfo)
),
process_builtin_preds(PredIds, !ModuleInfo, !IO).
% It is possible for compiler generated/mercury builtin
% predicates to be imported or locally defined, so they
% must be covered here separately.
%
:- pred process_builtin_procs(bool::in, pred_id::in, module_info::in,
pred_info::in, pred_info::out) is det.
process_builtin_procs(MakeOptInt, PredId, ModuleInfo, !PredInfo) :-
pred_info_import_status(!.PredInfo, ImportStatus),
pred_info_get_markers(!.PredInfo, Markers),
pred_info_context(!.PredInfo, Context),
some [!ProcTable] (
pred_info_procedures(!.PredInfo, !:ProcTable),
ProcIds = pred_info_procids(!.PredInfo),
(
set_compiler_gen_terminates(!.PredInfo, ProcIds, PredId,
ModuleInfo, !ProcTable)
->
true
;
status_defined_in_this_module(ImportStatus, yes)
->
% XXX At the moment if a procedure has a pragma terminates
% declaration its argument size information is set to true.
% If we allow the user to specify the arg size info this
% will need to change. This also means that the
% size_var_map for the procedure is never created. This
% causes problems with intermodule optimization. The
% current workaround is to set up a dummy size_var_map for
% each procedure.
%
( check_marker(Markers, terminates) ->
TermStatus = cannot_loop(pragma_supplied),
change_procs_constr_termination_info(ProcIds,
yes, TermStatus, !ProcTable),
ArgSizeInfo = polyhedron.universe,
change_procs_constr_arg_size_info(ProcIds, yes,
ArgSizeInfo, !ProcTable),
initialise_size_var_maps(ProcIds, !ProcTable)
;
true
)
;
% Not defined in this module.
% All of the predicates that are processed in this section
% are imported in some way. With imported predicates, any
% 'check_termination' pragmas will be checked by the
% compiler when it compiles the relevant source file (that
% the predicate was imported from). When making the
% intermodule optimization interfaces, the check_termination
% will not be checked when the relevant source file is compiled,
% so it cannot be depended upon.
(
(
check_marker(Markers, terminates)
;
MakeOptInt = no,
check_marker(Markers, check_termination)
)
->
change_procs_constr_termination_info(ProcIds, yes,
cannot_loop(pragma_supplied), !ProcTable)
;
change_procs_constr_termination_info(ProcIds, no,
can_loop([]), !ProcTable)
),
ArgSizeInfo = polyhedron.universe,
change_procs_constr_arg_size_info(ProcIds, yes, ArgSizeInfo,
!ProcTable)
),
( check_marker(Markers, does_not_terminate) ->
TerminationInfo =
can_loop([Context - does_not_term_pragma(PredId)]),
NonTermArgSizeInfo = polyhedron.universe,
change_procs_constr_termination_info(ProcIds, yes,
TerminationInfo, !ProcTable),
change_procs_constr_arg_size_info(ProcIds, yes,
NonTermArgSizeInfo, !ProcTable),
initialise_size_var_maps(ProcIds, !ProcTable)
;
true
),
pred_info_set_procedures(!.ProcTable, !PredInfo)
).
:- pred set_compiler_gen_terminates(pred_info::in, list(proc_id)::in,
pred_id::in, module_info::in, proc_table::in, proc_table::out)
is semidet.
set_compiler_gen_terminates(PredInfo, ProcIds, PredId, ModuleInfo,
!ProcTable) :-
( hlds_pred.pred_info_is_builtin(PredInfo) ->
set_builtin_terminates(ProcIds, PredId, PredInfo, ModuleInfo,
!ProcTable)
;
(
Name = pred_info_name(PredInfo),
Arity = pred_info_orig_arity(PredInfo),
special_pred_name_arity(SpecPredId0, Name, _, Arity),
ModuleName = pred_info_module(PredInfo),
any_mercury_builtin_module(ModuleName)
->
SpecialPredId = SpecPredId0
;
pred_info_get_origin(PredInfo, PredOrigin),
PredOrigin = special_pred(SpecialPredId - _)
)
->
set_generated_terminates(ProcIds, SpecialPredId, ModuleInfo,
!ProcTable)
;
fail
).
:- pred set_generated_terminates(list(proc_id)::in, special_pred_id::in,
module_info::in, proc_table::in, proc_table::out) is det.
set_generated_terminates([], _, _, !ProcTable).
set_generated_terminates([ProcId | ProcIds], SpecialPredId, ModuleInfo,
!ProcTable) :-
%
% We don't need to do anything special for solver type initialisation
% predicates. Leaving it up to the analyser may result in better
% argument size information anyway.
%
( SpecialPredId \= spec_pred_init ->
ProcInfo0 = !.ProcTable ^ det_elem(ProcId),
proc_info_headvars(ProcInfo0, HeadVars),
proc_info_vartypes(ProcInfo0, VarTypes),
special_pred_id_to_termination(SpecialPredId, HeadVars, ModuleInfo,
VarTypes, ArgSize, Termination, VarMap, HeadSizeVars),
some [!TermInfo] (
proc_info_get_termination2_info(ProcInfo0, !:TermInfo),
!:TermInfo = !.TermInfo ^ success_constrs := yes(ArgSize),
!:TermInfo = !.TermInfo ^ term_status := yes(Termination),
IntermodStatus = yes(not_mutually_recursive),
!:TermInfo = !.TermInfo ^ intermod_status := IntermodStatus,
!:TermInfo = !.TermInfo ^ size_var_map := VarMap,
!:TermInfo = !.TermInfo ^ head_vars := HeadSizeVars,
proc_info_set_termination2_info(!.TermInfo, ProcInfo0, ProcInfo)
),
svmap.det_update(ProcId, ProcInfo, !ProcTable)
;
true
),
set_generated_terminates(ProcIds, SpecialPredId, ModuleInfo, !ProcTable).
% Handle the generation of constraints for special predicates.
% XXX argument size constraints for unify predicates for types
% with user-defined equality may not be correct.
%
:- pred special_pred_id_to_termination(special_pred_id::in, prog_vars::in,
module_info::in, vartypes::in, constr_arg_size_info::out,
constr_termination_info::out, size_var_map::out, size_vars::out) is det.
special_pred_id_to_termination(spec_pred_compare, HeadProgVars, ModuleInfo,
VarTypes, ArgSizeInfo, Termination, SizeVarMap, HeadSizeVars) :-
make_info(HeadProgVars, ModuleInfo, VarTypes, ArgSizeInfo, Termination,
SizeVarMap, HeadSizeVars).
special_pred_id_to_termination(spec_pred_unify, HeadProgVars, ModuleInfo,
VarTypes, ArgSizeInfo, Termination, SizeVarMap, HeadSizeVars) :-
make_size_var_map(HeadProgVars, _SizeVarset, SizeVarMap),
HeadSizeVars = prog_vars_to_size_vars(SizeVarMap, HeadProgVars),
Zeros = find_zero_size_vars(ModuleInfo, SizeVarMap, VarTypes),
NonZeroHeadSizeVars = list.filter(isnt(is_zero_size_var(Zeros)),
HeadSizeVars),
%
% unify may have more than two input arguments if one of them is a
% type-info related arg, or some such thing. Since all these have
% zero size type, after removing them there are two possibilities.
% The list of non-zero size type head_vars is empty (if the
% arguments are zero sized) or it contains two elements.
%
( NonZeroHeadSizeVars = [] ->
Constrs = []
; NonZeroHeadSizeVars = [VarA, VarB] ->
Constrs = [make_vars_eq_constraint(VarA, VarB)]
;
unexpected(this_file, "special_pred_id_to_termination/7: " ++
"wrong number of args for unify.")
),
Polyhedron = polyhedron.from_constraints(Constrs),
ArgSizeInfo = Polyhedron,
Termination = cannot_loop(builtin).
special_pred_id_to_termination(spec_pred_index, HeadProgVars, ModuleInfo,
VarTypes, ArgSize, Termination, SizeVarMap, HeadSizeVars) :-
NumToDrop = list.length(HeadProgVars) - 2,
( list.drop(NumToDrop, HeadProgVars, _ZeroSizeHeadVars) ->
make_info(HeadProgVars, ModuleInfo, VarTypes, ArgSize,
Termination, SizeVarMap, HeadSizeVars)
;
unexpected(this_file,
"Less than two arguments to builtin index.")
).
special_pred_id_to_termination(spec_pred_init, _, _, _, _, _, _, _) :-
unexpected(this_file, "special_pred_id_to_termination/8 " ++
"initialise predicate").
% Sets the termination status and argument size information for
% those special_preds (compare and index) where the arguments
% are either zero sized or unconstrained in size.
%
:- pred make_info(list(prog_var)::in, module_info::in, vartypes::in,
constr_arg_size_info::out, constr_termination_info::out,
size_var_map::out, size_vars::out) is det.
make_info(HeadProgVars, ModuleInfo, VarTypes, ArgSize, Termination, SizeVarMap,
HeadSizeVars) :-
make_size_var_map(HeadProgVars, _SizeVarset, SizeVarMap),
Zeros = find_zero_size_vars(ModuleInfo, SizeVarMap, VarTypes),
Constraints = create_nonneg_constraints(SizeVarMap, Zeros),
Polyhedron = polyhedron.from_constraints(Constraints),
ArgSize = Polyhedron,
Termination = cannot_loop(builtin),
HeadSizeVars = prog_vars_to_size_vars(SizeVarMap, HeadProgVars).
% Set the termination information for builtin
% predicates. The list of proc_ids must refer to builtin predicates.
%
:- pred set_builtin_terminates(list(proc_id)::in, pred_id::in, pred_info::in,
module_info::in, proc_table::in, proc_table::out) is det.
set_builtin_terminates([], _, _, _, !ProcTable).
set_builtin_terminates([ProcId | ProcIds], PredId, PredInfo, ModuleInfo,
!ProcTable) :-
ProcInfo0 = !.ProcTable ^ det_elem(ProcId),
proc_info_headvars(ProcInfo0, HeadVars),
PredModule = pred_info_module(PredInfo),
PredName = pred_info_name(PredInfo),
PredArity = pred_info_orig_arity(PredInfo),
make_size_var_map(HeadVars, _SizeVarset, SizeVarMap),
(
hlds_pred.no_type_info_builtin(PredModule, PredName, PredArity)
->
Constrs = process_no_type_info_builtin(PredName, HeadVars,
SizeVarMap)
;
all_args_input_or_zero_size(ModuleInfo, PredInfo, ProcInfo0)
->
Constrs = []
;
unexpected(this_file, "builtin with non-zero size args.")
),
Polyhedron = polyhedron.from_constraints(Constrs),
ArgSizeInfo = yes(Polyhedron),
HeadSizeVars = prog_vars_to_size_vars(SizeVarMap, HeadVars),
some [!TermInfo] (
proc_info_get_termination2_info(ProcInfo0, !:TermInfo),
!:TermInfo = !.TermInfo ^ success_constrs := ArgSizeInfo,
!:TermInfo = !.TermInfo ^ term_status := yes(cannot_loop(builtin)),
!:TermInfo = !.TermInfo ^ intermod_status :=
yes(not_mutually_recursive),
!:TermInfo = !.TermInfo ^ size_var_map := SizeVarMap,
!:TermInfo = !.TermInfo ^ head_vars := HeadSizeVars,
proc_info_set_termination2_info(!.TermInfo, ProcInfo0, ProcInfo)
),
svmap.det_update(ProcId, ProcInfo, !ProcTable),
set_builtin_terminates(ProcIds, PredId, PredInfo, ModuleInfo,
!ProcTable).
:- func process_no_type_info_builtin(string, prog_vars, size_var_map)
= constraints.
process_no_type_info_builtin(PredName, HeadVars, SizeVarMap) = Constraints :-
(
HeadVars = [HVar1, HVar2],
(
(
PredName = "unsafe_type_cast"
;
PredName = "unsafe_promise_unique"
)
->
SizeVar1 = prog_var_to_size_var(SizeVarMap, HVar1),
SizeVar2 = prog_var_to_size_var(SizeVarMap, HVar2),
ConstraintsPrime = [make_vars_eq_constraint(SizeVar1, SizeVar2)]
;
PredName = "store_at_ref"
->
ConstraintsPrime = []
;
fail
)
->
Constraints = ConstraintsPrime
;
unexpected(this_file,
"Unrecognised predicate passed to process_special_builtin.")
).
%----------------------------------------------------------------------------%
:- pred initialise_size_var_maps(list(proc_id)::in,
proc_table::in, proc_table::out) is det.
initialise_size_var_maps([], !ProcTable).
initialise_size_var_maps([ProcId | ProcIds], !ProcTable) :-
ProcInfo0 = !.ProcTable ^ det_elem(ProcId),
proc_info_get_termination2_info(ProcInfo0, TermInfo0),
proc_info_headvars(ProcInfo0, HeadVars),
make_size_var_map(HeadVars, _SizeVarset, SizeVarMap),
TermInfo = TermInfo0 ^ size_var_map := SizeVarMap,
proc_info_set_termination2_info(TermInfo, ProcInfo0, ProcInfo),
svmap.det_update(ProcId, ProcInfo, !ProcTable),
initialise_size_var_maps(ProcIds, !ProcTable).
%----------------------------------------------------------------------------%
:- func this_file = string.
this_file = "term_constr_initial.m".
%----------------------------------------------------------------------------%
:- end_module term_constr_initial.
%----------------------------------------------------------------------------%