mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-17 23:05:21 +00:00
Code Issues Projects Releases Wiki Activity
Files
11d81616926a51f900b8d8efd27435c4019f49dd
mercury/compiler/code_util.m
Fergus Henderson 11d8161692 Add support for nested modules. 
Estimated hours taken: 50

Add support for nested modules.

- module names may themselves be module-qualified
- modules may contain `:- include_module' declarations
  which name sub-modules
- a sub-module has access to all the declarations in the
  parent module (including its implementation section).

This support is not yet complete; see the BUGS and LIMITATIONS below.

LIMITATIONS
- source file names must match module names
	(just as they did previously)
- mmc doesn't allow path names on the command line any more
	(e.g. `mmc --make-int ../library/foo.m').
- import_module declarations must use the fully-qualified module name
- module qualifiers must use the fully-qualified module name
- no support for root-qualified module names
	(e.g. `:parent:child' instead of `parent:child').
- modules may not be physically nested (only logical nesting, via
  `include_module').

BUGS
- doesn't check that the parent module is imported/used before allowing
	import/use of its sub-modules.
- doesn't check that there is an include_module declaration in the
	parent for each module claiming to be a child of that parent
- privacy of private modules is not enforced

-------------------

NEWS:
	Mention that we support nested modules.

library/ops.m:
library/nc_builtin.nl:
library/sp_builtin.nl:
compiler/mercury_to_mercury.m:
	Add `include_module' as a new prefix operator.
	Change the associativity of `:' from xfy to yfx
	(since this made parsing module qualifiers slightly easier).

compiler/prog_data.m:
	Add new `include_module' declaration.
	Change the `module_name' and `module_specifier' types
	from strings to sym_names, so that module names can
	themselves be module qualified.

compiler/modules.m:
	Add predicates module_name_to_file_name/2 and
	file_name_to_module_name/2.
	Lots of changes to handle parent module dependencies,
	to create parent interface (`.int0') files, to read them in,
	to output correct dependencies information for them to the
	`.d' and `.dep' files, etc.
	Rewrite a lot of the code to improve the readability
	(add comments, use subroutines, better variable names).
	Also fix a couple of bugs:
	- generate_dependencies was using the transitive implementation
	  dependencies rather than the transitive interface dependencies
	  to compute the `.int3' dependencies when writing `.d' files
	  (this bug was introduced during crs's changes to support
	  `.trans_opt' files)
	- when creating the `.int' file, it was reading in the
	  interfaces for modules imported in the implementation section,
	  not just those in the interface section.
	  This meant that the compiler missed a lot of errors.

library/graph.m:
library/lexer.m:
library/term.m:
library/term_io.m:
library/varset.m:
compiler/*.m:
	Add `:- import_module' declarations to the interface needed
	by declarations in the interface.  (The previous version
	of the compiler did not detect these missing interface imports,
	due to the above-mentioned bug in modules.m.)

compiler/mercury_compile.m:
compiler/intermod.m:
	Change mercury_compile__maybe_grab_optfiles and
	intermod__grab_optfiles so that they grab the opt files for
	parent modules as well as the ones for imported modules.

compiler/mercury_compile.m:
	Minor changes to handle parent module dependencies.
	(Also improve the wording of the warning about trans-opt
	dependencies.)

compiler/make_hlds.m:
compiler/module_qual.m:
	Ignore `:- include_module' declarations.

compiler/module_qual.m:
	A couple of small changes to handle nested module names.

compiler/prog_out.m:
compiler/prog_util.m:
	Add new predicates string_to_sym_name/3 (prog_util.m) and
	sym_name_to_string/{2,3} (prog_out.m).

compiler/*.m:
	Replace many occurrences of `string' with `module_name'.
	Change code that prints out module names or converts
	them to strings or filenames to handle the fact that
	module names are now sym_names intead of strings.
	Also change a few places (e.g. in intermod.m, hlds_module.m)
	where the code assumed that any qualified symbol was
	fully-qualified.

compiler/prog_io.m:
compiler/prog_io_goal.m:
	Move sym_name_and_args/3, parse_qualified_term/4 and
	parse_qualified_term/5 preds from prog_io_goal.m to prog_io.m,
	since they are very similar to the parse_symbol_name/2 predicate
	already in prog_io.m.  Rewrite these predicates, both
	to improve maintainability, and to handle the newly
	allowed syntax (module-qualified module names).
	Rename parse_qualified_term/5 as `parse_implicit_qualified_term'.

compiler/prog_io.m:
	Rewrite the handling of `:- module' and `:- end_module'
	declarations, so that it can handle nested modules.
	Add code to parse `include_module' declarations.

compiler/prog_util.m:
compiler/*.m:
	Add new predicates mercury_public_builtin_module/1 and
	mercury_private_builtin_module/1 in prog_util.m.
	Change most of the hard-coded occurrences of "mercury_builtin"
	to call mercury_private_builtin_module/1 or
	mercury_public_builtin_module/1 or both.

compiler/llds_out.m:
	Add llds_out__sym_name_mangle/2, for mangling module names.

compiler/special_pred.m:
compiler/mode_util.m:
compiler/clause_to_proc.m:
compiler/prog_io_goal.m:
compiler/lambda.m:
compiler/polymorphism.m:
	Move the predicates in_mode/1, out_mode/1, and uo_mode/1
	from special_pred.m to mode_util.m, and change various
	hard-coded definitions to instead call these predicates.

compiler/polymorphism.m:
	Ensure that the type names `type_info' and `typeclass_info' are
	module-qualified in the generated code.  This avoids a problem
	where the code generated by polymorphism.m was not considered
	type-correct, due to the type `type_info' not matching
	`mercury_builtin:type_info'.

compiler/check_typeclass.m:
	Simplify the code for check_instance_pred and
	get_matching_instance_pred_ids.

compiler/mercury_compile.m:
compiler/modules.m:
	Disallow directory names in command-line arguments.

compiler/options.m:
compiler/handle_options.m:
compiler/mercury_compile.m:
compiler/modules.m:
	Add a `--make-private-interface' option.
	The private interface file `<module>.int0' contains
	all the declarations in the module; it is used for
	compiling sub-modules.

scripts/Mmake.rules:
scripts/Mmake.vars.in:
	Add support for creating `.int0' and `.date0' files
	by invoking mmc with `--make-private-interface'.

doc/user_guide.texi:
	Document `--make-private-interface' and the `.int0'
	and `.date0' file extensions.

doc/reference_manual.texi:
	Document nested modules.

util/mdemangle.c:
profiler/demangle.m:
	Demangle names with multiple module qualifiers.

tests/general/Mmakefile:
tests/general/string_format_test.m:
tests/general/string_format_test.exp:
tests/general/string__format_test.m:
tests/general/string__format_test.exp:
tests/general/.cvsignore:
	Change the `:- module string__format_test' declaration in
	`string__format_test.m' to `:- module string_format_test',
	because with the original declaration the `__' was taken
	as a module qualifier, which lead to an error message.
	Hence rename the file accordingly, to avoid the warning
	about file name not matching module name.

tests/invalid/Mmakefile:
tests/invalid/missing_interface_import.m:
tests/invalid/missing_interface_import.err_exp:
	Regression test to check that the compiler reports
	errors for missing `import_module' in the interface section.

tests/invalid/*.err_exp:
tests/warnings/unused_args_test.exp:
tests/warnings/unused_import.exp:
	Update the expected diagnostics output for the test cases to
	reflect a few minor changes to the warning messages.

tests/hard_coded/Mmakefile:
tests/hard_coded/parent.m:
tests/hard_coded/parent.child.m:
tests/hard_coded/parent.exp:
tests/hard_coded/parent2.m:
tests/hard_coded/parent2.child.m:
tests/hard_coded/parent2.exp:
	Two simple tests case for the use of nested modules with
	separate compilation.
1998-03-03 17:48:14 +00:00

871 lines
34 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% Copyright (C) 1994-1998 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: code_util.m.
%
% various utilities routines for code generation and recognition
% of builtins.
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- module code_util.
:- interface.
:- import_module hlds_module, hlds_pred, hlds_goal, hlds_data, prog_data, llds.
:- import_module list, std_util, term.
% Create a code address which holds the address of the specified
% procedure.
% The fourth argument should be `no' if the the caller wants the
% returned address to be valid from everywhere in the program.
% If being valid from within the current procedure is enough,
% this argument should be `yes' wrapped around the value of the
% --procs-per-c-function option and the current procedure id.
% Using an address that is only valid from within the current
% procedure may make jumps more efficient.
:- pred code_util__make_entry_label(module_info, pred_id, proc_id,
maybe(pair(int, pred_proc_id)), code_addr).
:- mode code_util__make_entry_label(in, in, in, in, out) is det.
% Create a label which holds the address of the specified procedure,
% which must be defined in the current module (procedures that are
% imported from other modules have representations only as code_addrs,
% not as labels, since their address is not known at C compilation
% time).
% The fourth argument has the same meaning as for
% code_util__make_entry_label.
:- pred code_util__make_local_entry_label(module_info, pred_id, proc_id,
maybe(pair(int, pred_proc_id)), label).
:- mode code_util__make_local_entry_label(in, in, in, in, out) is det.
% Create a label internal to a Mercury procedure.
:- pred code_util__make_internal_label(module_info, pred_id, proc_id, int,
label).
:- mode code_util__make_internal_label(in, in, in, in, out) is det.
:- pred code_util__make_proc_label(module_info, pred_id, proc_id, proc_label).
:- mode code_util__make_proc_label(in, in, in, out) is det.
:- pred code_util__make_uni_label(module_info, type_id, proc_id, proc_label).
:- mode code_util__make_uni_label(in, in, in, out) is det.
:- pred code_util__arg_loc_to_register(arg_loc, lval).
:- mode code_util__arg_loc_to_register(in, out) is det.
% Determine whether a goal might allocate some heap space,
% i.e. whether it contains any construction unifications
% or predicate calls. BEWARE that this predicate is only
% an approximation, used to decide whether or not to try to
% reclaim the heap space; currently it fails even for some
% goals which do allocate heap space, such as construction
% of boxed constants.
:- pred code_util__goal_may_allocate_heap(hlds_goal).
:- mode code_util__goal_may_allocate_heap(in) is semidet.
:- pred code_util__goal_list_may_allocate_heap(list(hlds_goal)).
:- mode code_util__goal_list_may_allocate_heap(in) is semidet.
% Negate a condition.
% This is used mostly just to make the generated code more readable.
:- pred code_util__neg_rval(rval, rval).
:- mode code_util__neg_rval(in, out) is det.
:- pred code_util__negate_the_test(list(instruction), list(instruction)).
:- mode code_util__negate_the_test(in, out) is det.
:- pred code_util__compiler_generated(pred_info).
:- mode code_util__compiler_generated(in) is semidet.
:- pred code_util__predinfo_is_builtin(pred_info).
:- mode code_util__predinfo_is_builtin(in) is semidet.
:- pred code_util__builtin_state(module_info, pred_id, proc_id, builtin_state).
:- mode code_util__builtin_state(in, in, in, out) is det.
% Given a module name, a predicate name, a proc_id and a list of
% variables as the arguments, find out if that procedure of that
% predicate is an inline builtin. If yes, the last two arguments
% return two things:
%
% - an rval to execute as a test if the builtin is semidet; and
%
% - an rval to assign to a variable if the builtin calls for this.
%
% At least one of these will be present.
%
% Each test rval returned is guaranteed to be either a unop or a binop,
% applied to arguments that are either variables (from the argument
% list) or constants.
%
% Each to be assigned rval is guaranteed to be either in a form
% acceptable for a test rval, or in the form of a variable.
:- pred code_util__translate_builtin(module_name, string, proc_id, list(var),
maybe(rval), maybe(pair(var, rval))).
:- mode code_util__translate_builtin(in, in, in, in, out, out) is semidet.
% Find out how a function symbol (constructor) is represented
% in the given type.
:- pred code_util__cons_id_to_tag(cons_id, type, module_info, cons_tag).
:- mode code_util__cons_id_to_tag(in, in, in, out) is det.
% Succeed if the given goal cannot encounter a context
% that causes any variable to be flushed to its stack slot.
% If such a goal needs a resume point, and that resume point cannot
% be backtracked to once control leaves the goal, then the only entry
% point we need for the resume point is the one with the resume
% variables in their original locations.
:- pred code_util__cannot_stack_flush(hlds_goal).
:- mode code_util__cannot_stack_flush(in) is semidet.
% Succeed if the given goal cannot fail before encountering a context
% that forces all variables to be flushed to their stack slots.
% If such a goal needs a resume point, the only entry point we need
% is the stack entry point.
:- pred code_util__cannot_fail_before_stack_flush(hlds_goal).
:- mode code_util__cannot_fail_before_stack_flush(in) is semidet.
% code_util__count_recursive_calls(Goal, PredId, ProcId, Min, Max)
% Given that we are in predicate PredId and procedure ProcId,
% return the minimum and maximum number of recursive calls that
% an execution of Goal may encounter.
:- pred code_util__count_recursive_calls(hlds_goal, pred_id, proc_id,
int, int).
:- mode code_util__count_recursive_calls(in, in, in, out, out) is det.
%---------------------------------------------------------------------------%
:- implementation.
:- import_module prog_data, type_util, special_pred.
:- import_module bool, char, int, string, map, term, varset, require, std_util.
%---------------------------------------------------------------------------%
code_util__make_entry_label(ModuleInfo, PredId, ProcId, Immed, PredAddress) :-
module_info_preds(ModuleInfo, Preds),
map__lookup(Preds, PredId, PredInfo),
(
(
pred_info_is_imported(PredInfo)
;
pred_info_is_pseudo_imported(PredInfo),
% only the (in, in) mode of unification is imported
hlds_pred__in_in_unification_proc_id(ProcId)
)
->
code_util__make_proc_label(ModuleInfo, PredId, ProcId,
ProcLabel),
PredAddress = imported(ProcLabel)
;
code_util__make_local_entry_label(ModuleInfo, PredId, ProcId,
Immed, Label),
PredAddress = label(Label)
).
code_util__make_local_entry_label(ModuleInfo, PredId, ProcId, Immed, Label) :-
code_util__make_proc_label(ModuleInfo, PredId, ProcId, ProcLabel),
module_info_preds(ModuleInfo, Preds),
map__lookup(Preds, PredId, PredInfo),
(
(
pred_info_is_exported(PredInfo)
;
pred_info_is_pseudo_exported(PredInfo),
% only the (in, in) mode of a unification is exported
hlds_pred__in_in_unification_proc_id(ProcId)
)
->
(
Immed = no,
Label = exported(ProcLabel)
;
Immed = yes(ProcsPerFunc - proc(CurPredId, CurProcId)),
choose_local_label_type(ProcsPerFunc, CurPredId,
CurProcId, PredId, ProcId, ProcLabel, Label)
)
;
(
% If we want to define the label or use it to put it
% into a data structure, a label that is usable only
% within the current C module won't do.
Immed = no,
Label = local(ProcLabel)
;
Immed = yes(ProcsPerFunc - proc(CurPredId, CurProcId)),
choose_local_label_type(ProcsPerFunc, CurPredId,
CurProcId, PredId, ProcId, ProcLabel, Label)
)
).
:- pred choose_local_label_type(int, pred_id, proc_id,
pred_id, proc_id, proc_label, label).
:- mode choose_local_label_type(in, in, in, in, in, in, out) is det.
choose_local_label_type(ProcsPerFunc, CurPredId, CurProcId,
PredId, ProcId, ProcLabel, Label) :-
(
% If we want to branch to the label now,
% we prefer a form that are usable only within
% the current C module, since it is likely
% to be faster.
(
ProcsPerFunc = 0
;
PredId = CurPredId,
ProcId = CurProcId
)
->
Label = c_local(ProcLabel)
;
Label = local(ProcLabel)
).
%-----------------------------------------------------------------------------%
code_util__make_internal_label(ModuleInfo, PredId, ProcId, LabelNum, Label) :-
code_util__make_proc_label(ModuleInfo, PredId, ProcId, ProcLabel),
Label = local(ProcLabel, LabelNum).
code_util__make_proc_label(ModuleInfo, PredId, ProcId, ProcLabel) :-
module_info_pred_info(ModuleInfo, PredId, PredInfo),
pred_info_module(PredInfo, PredModule),
pred_info_name(PredInfo, PredName),
module_info_name(ModuleInfo, ThisModule),
(
code_util__compiler_generated(PredInfo)
->
pred_info_arg_types(PredInfo, _TypeVarSet, ArgTypes),
(
special_pred_get_type(PredName, ArgTypes, Type),
type_to_type_id(Type, TypeId, _),
% All type_ids here should be module qualified,
% since builtin types are handled separately in
% polymorphism.m.
TypeId = qualified(TypeModule, TypeName) - Arity
->
(
ThisModule \= TypeModule,
PredName = "__Unify__",
\+ hlds_pred__in_in_unification_proc_id(ProcId)
->
DefiningModule = ThisModule
;
DefiningModule = TypeModule
),
ProcLabel = special_proc(DefiningModule, PredName,
TypeModule, TypeName, Arity, ProcId)
;
string__append_list(["code_util__make_proc_label:\n",
"cannot make label for special pred `",
PredName, "'"], ErrorMessage),
error(ErrorMessage)
)
;
(
% Work out which module supplies the code for
% the predicate.
ThisModule \= PredModule,
\+ pred_info_is_imported(PredInfo)
->
% This predicate is a specialized version of
% a pred from a `.opt' file.
DefiningModule = ThisModule
;
DefiningModule = PredModule
),
pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
pred_info_arity(PredInfo, Arity),
ProcLabel = proc(DefiningModule, PredOrFunc,
PredModule, PredName, Arity, ProcId)
).
code_util__make_uni_label(ModuleInfo, TypeId, UniModeNum, ProcLabel) :-
module_info_name(ModuleInfo, ModuleName),
( TypeId = qualified(TypeModule, TypeName) - Arity ->
( hlds_pred__in_in_unification_proc_id(UniModeNum) ->
Module = TypeModule
;
Module = ModuleName
),
ProcLabel = special_proc(Module, "__Unify__", TypeModule,
TypeName, Arity, UniModeNum)
;
error("code_util__make_uni_label: unqualified type_id")
).
%-----------------------------------------------------------------------------%
code_util__arg_loc_to_register(ArgLoc, reg(r, ArgLoc)).
%-----------------------------------------------------------------------------%
code_util__predinfo_is_builtin(PredInfo) :-
pred_info_module(PredInfo, ModuleName),
pred_info_name(PredInfo, PredName),
% code_util__translate_builtin(ModuleName, PredName, _, _, _, _).
pred_info_arity(PredInfo, Arity),
ProcId = 0,
code_util__inline_builtin(ModuleName, PredName, ProcId, Arity).
code_util__builtin_state(ModuleInfo, PredId0, ProcId, BuiltinState) :-
predicate_module(ModuleInfo, PredId0, ModuleName),
predicate_name(ModuleInfo, PredId0, PredName),
predicate_arity(ModuleInfo, PredId0, Arity),
proc_id_to_int(ProcId, ProcInt),
( code_util__inline_builtin(ModuleName, PredName, ProcInt, Arity) ->
BuiltinState = inline_builtin
;
BuiltinState = not_builtin
).
:- pred code_util__inline_builtin(module_name, string, int, int).
:- mode code_util__inline_builtin(in, in, in, in) is semidet.
code_util__inline_builtin(FullyQualifiedModule, PredName, ProcId, Arity) :-
Arity =< 3,
varset__init(VarSet),
varset__new_vars(VarSet, Arity, Args, _),
% --- not yet:
% FullyQualifiedModule = qualified(unqualified("std"), ModuleName),
FullyQualifiedModule = unqualified(ModuleName),
code_util__translate_builtin_2(ModuleName, PredName, ProcId, Args, _, _).
code_util__translate_builtin(FullyQualifiedModule, PredName, ProcId, Args,
BinOp, AsgOp) :-
proc_id_to_int(ProcId, ProcInt),
% -- not yet:
% FullyQualifiedModule = qualified(unqualified("std"), ModuleName),
FullyQualifiedModule = unqualified(ModuleName),
code_util__translate_builtin_2(ModuleName, PredName, ProcInt, Args,
BinOp, AsgOp).
:- pred code_util__translate_builtin_2(string, string, int, list(var),
maybe(rval), maybe(pair(var, rval))).
:- mode code_util__translate_builtin_2(in, in, in, in, out, out) is semidet.
code_util__translate_builtin_2("mercury_builtin", "unsafe_type_cast", 0,
[X, Y], no, yes(Y - var(X))).
code_util__translate_builtin_2("mercury_builtin", "unsafe_promise_unique", 0,
[X, Y], no, yes(Y - var(X))).
code_util__translate_builtin_2("mercury_builtin", "builtin_int_gt", 0, [X, Y],
yes(binop((>), var(X), var(Y))), no).
code_util__translate_builtin_2("mercury_builtin", "builtin_int_lt", 0, [X, Y],
yes(binop((<), var(X), var(Y))), no).
code_util__translate_builtin_2("int", "builtin_plus", 0, [X, Y, Z],
no, yes(Z - binop((+), var(X), var(Y)))).
code_util__translate_builtin_2("int", "builtin_plus", 1, [X, Y, Z],
no, yes(X - binop((-), var(Z), var(Y)))).
code_util__translate_builtin_2("int", "builtin_plus", 2, [X, Y, Z],
no, yes(Y - binop((-), var(Z), var(X)))).
code_util__translate_builtin_2("int", "+", 0, [X, Y, Z],
no, yes(Z - binop((+), var(X), var(Y)))).
code_util__translate_builtin_2("int", "+", 1, [X, Y, Z],
no, yes(X - binop((-), var(Z), var(Y)))).
code_util__translate_builtin_2("int", "+", 2, [X, Y, Z],
no, yes(Y - binop((-), var(Z), var(X)))).
code_util__translate_builtin_2("int", "builtin_minus", 0, [X, Y, Z],
no, yes(Z - binop((-), var(X), var(Y)))).
code_util__translate_builtin_2("int", "builtin_minus", 1, [X, Y, Z],
no, yes(X - binop((+), var(Y), var(Z)))).
code_util__translate_builtin_2("int", "builtin_minus", 2, [X, Y, Z],
no, yes(Y - binop((-), var(X), var(Z)))).
code_util__translate_builtin_2("int", "-", 0, [X, Y, Z],
no, yes(Z - binop((-), var(X), var(Y)))).
code_util__translate_builtin_2("int", "-", 1, [X, Y, Z],
no, yes(X - binop((+), var(Y), var(Z)))).
code_util__translate_builtin_2("int", "-", 2, [X, Y, Z],
no, yes(Y - binop((-), var(X), var(Z)))).
code_util__translate_builtin_2("int", "builtin_times", 0, [X, Y, Z],
no, yes(Z - binop((*), var(X), var(Y)))).
code_util__translate_builtin_2("int", "builtin_times", 1, [X, Y, Z],
no, yes(X - binop((/), var(Z), var(Y)))).
code_util__translate_builtin_2("int", "builtin_times", 2, [X, Y, Z],
no, yes(Y - binop((/), var(Z), var(X)))).
code_util__translate_builtin_2("int", "*", 0, [X, Y, Z],
no, yes(Z - binop((*), var(X), var(Y)))).
code_util__translate_builtin_2("int", "*", 1, [X, Y, Z],
no, yes(X - binop((/), var(Z), var(Y)))).
code_util__translate_builtin_2("int", "*", 2, [X, Y, Z],
no, yes(Y - binop((/), var(Z), var(X)))).
code_util__translate_builtin_2("int", "builtin_div", 0, [X, Y, Z],
no, yes(Z - binop((/), var(X), var(Y)))).
code_util__translate_builtin_2("int", "builtin_div", 1, [X, Y, Z],
no, yes(X - binop((*), var(Y), var(Z)))).
code_util__translate_builtin_2("int", "builtin_div", 2, [X, Y, Z],
no, yes(Y - binop((/), var(X), var(Z)))).
code_util__translate_builtin_2("int", "//", 0, [X, Y, Z],
no, yes(Z - binop((/), var(X), var(Y)))).
code_util__translate_builtin_2("int", "//", 1, [X, Y, Z],
no, yes(X - binop((*), var(Y), var(Z)))).
code_util__translate_builtin_2("int", "//", 2, [X, Y, Z],
no, yes(Y - binop((/), var(X), var(Z)))).
code_util__translate_builtin_2("int", "builtin_mod", 0, [X, Y, Z],
no, yes(Z - binop((mod), var(X), var(Y)))).
code_util__translate_builtin_2("int", "rem", 0, [X, Y, Z],
no, yes(Z - binop((mod), var(X), var(Y)))).
code_util__translate_builtin_2("int", "builtin_left_shift", 0, [X, Y, Z],
no, yes(Z - binop((<<), var(X), var(Y)))).
code_util__translate_builtin_2("int", "<<", 0, [X, Y, Z],
no, yes(Z - binop((<<), var(X), var(Y)))).
code_util__translate_builtin_2("int", "builtin_right_shift", 0, [X, Y, Z],
no, yes(Z - binop((>>), var(X), var(Y)))).
code_util__translate_builtin_2("int", ">>", 0, [X, Y, Z],
no, yes(Z - binop((>>), var(X), var(Y)))).
code_util__translate_builtin_2("int", "builtin_bit_and", 0, [X, Y, Z],
no, yes(Z - binop((&), var(X), var(Y)))).
code_util__translate_builtin_2("int", "/\\", 0, [X, Y, Z],
no, yes(Z - binop((&), var(X), var(Y)))).
code_util__translate_builtin_2("int", "builtin_bit_or", 0, [X, Y, Z],
no, yes(Z - binop(('|'), var(X), var(Y)))).
code_util__translate_builtin_2("int", "\\/", 0, [X, Y, Z],
no, yes(Z - binop(('|'), var(X), var(Y)))).
code_util__translate_builtin_2("int", "builtin_bit_xor", 0, [X, Y, Z],
no, yes(Z - binop((^), var(X), var(Y)))).
code_util__translate_builtin_2("int", "^", 0, [X, Y, Z],
no, yes(Z - binop((^), var(X), var(Y)))).
code_util__translate_builtin_2("int", "builtin_unary_plus", 0, [X, Y],
no, yes(Y - var(X))).
code_util__translate_builtin_2("int", "+", 0, [X, Y],
no, yes(Y - var(X))).
code_util__translate_builtin_2("int", "builtin_unary_minus", 0, [X, Y],
no, yes(Y - binop((-), const(int_const(0)), var(X)))).
code_util__translate_builtin_2("int", "-", 0, [X, Y],
no, yes(Y - binop((-), const(int_const(0)), var(X)))).
code_util__translate_builtin_2("int", "builtin_bit_neg", 0, [X, Y],
no, yes(Y - unop(bitwise_complement, var(X)))).
code_util__translate_builtin_2("int", "\\", 0, [X, Y],
no, yes(Y - unop(bitwise_complement, var(X)))).
code_util__translate_builtin_2("int", ">", 0, [X, Y],
yes(binop((>), var(X), var(Y))), no).
code_util__translate_builtin_2("int", "<", 0, [X, Y],
yes(binop((<), var(X), var(Y))), no).
code_util__translate_builtin_2("int", ">=", 0, [X, Y],
yes(binop((>=), var(X), var(Y))), no).
code_util__translate_builtin_2("int", "=<", 0, [X, Y],
yes(binop((<=), var(X), var(Y))), no).
code_util__translate_builtin_2("float", "builtin_float_plus", 0, [X, Y, Z],
no, yes(Z - binop(float_plus, var(X), var(Y)))).
code_util__translate_builtin_2("float", "builtin_float_plus", 1, [X, Y, Z],
no, yes(X - binop(float_minus, var(Z), var(Y)))).
code_util__translate_builtin_2("float", "builtin_float_plus", 2, [X, Y, Z],
no, yes(Y - binop(float_minus, var(Z), var(X)))).
code_util__translate_builtin_2("float", "+", 0, [X, Y, Z],
no, yes(Z - binop(float_plus, var(X), var(Y)))).
code_util__translate_builtin_2("float", "+", 1, [X, Y, Z],
no, yes(X - binop(float_minus, var(Z), var(Y)))).
code_util__translate_builtin_2("float", "+", 2, [X, Y, Z],
no, yes(Y - binop(float_minus, var(Z), var(X)))).
code_util__translate_builtin_2("float", "builtin_float_minus", 0, [X, Y, Z],
no, yes(Z - binop(float_minus, var(X), var(Y)))).
code_util__translate_builtin_2("float", "builtin_float_minus", 1, [X, Y, Z],
no, yes(X - binop(float_plus, var(Y), var(Z)))).
code_util__translate_builtin_2("float", "builtin_float_minus", 2, [X, Y, Z],
no, yes(Y - binop(float_minus, var(X), var(Z)))).
code_util__translate_builtin_2("float", "-", 0, [X, Y, Z],
no, yes(Z - binop(float_minus, var(X), var(Y)))).
code_util__translate_builtin_2("float", "-", 1, [X, Y, Z],
no, yes(X - binop(float_plus, var(Y), var(Z)))).
code_util__translate_builtin_2("float", "-", 2, [X, Y, Z],
no, yes(Y - binop(float_minus, var(X), var(Z)))).
code_util__translate_builtin_2("float", "builtin_float_times", 0, [X, Y, Z],
no, yes(Z - binop(float_times, var(X), var(Y)))).
code_util__translate_builtin_2("float", "builtin_float_times", 1, [X, Y, Z],
no, yes(X - binop(float_divide, var(Z), var(Y)))).
code_util__translate_builtin_2("float", "builtin_float_times", 2, [X, Y, Z],
no, yes(Y - binop(float_divide, var(Z), var(X)))).
code_util__translate_builtin_2("float", "*", 0, [X, Y, Z],
no, yes(Z - binop(float_times, var(X), var(Y)))).
code_util__translate_builtin_2("float", "*", 1, [X, Y, Z],
no, yes(X - binop(float_divide, var(Z), var(Y)))).
code_util__translate_builtin_2("float", "*", 2, [X, Y, Z],
no, yes(Y - binop(float_divide, var(Z), var(X)))).
code_util__translate_builtin_2("float", "builtin_float_divide", 0, [X, Y, Z],
no, yes(Z - binop(float_divide, var(X), var(Y)))).
code_util__translate_builtin_2("float", "builtin_float_divide", 1, [X, Y, Z],
no, yes(X - binop(float_times, var(Y), var(Z)))).
code_util__translate_builtin_2("float", "builtin_float_divide", 2, [X, Y, Z],
no, yes(Y - binop(float_divide, var(X), var(Z)))).
code_util__translate_builtin_2("float", "/", 0, [X, Y, Z],
no, yes(Z - binop(float_divide, var(X), var(Y)))).
code_util__translate_builtin_2("float", "/", 1, [X, Y, Z],
no, yes(X - binop(float_times, var(Y), var(Z)))).
code_util__translate_builtin_2("float", "/", 2, [X, Y, Z],
no, yes(Y - binop(float_divide, var(X), var(Z)))).
code_util__translate_builtin_2("float", "+", 0, [X, Y],
no, yes(Y - var(X))).
code_util__translate_builtin_2("float", "-", 0, [X, Y],
no, yes(Y - binop(float_minus, const(float_const(0.0)), var(X)))).
code_util__translate_builtin_2("float", "builtin_float_gt", 0, [X, Y],
yes(binop(float_gt, var(X), var(Y))), no).
code_util__translate_builtin_2("float", ">", 0, [X, Y],
yes(binop(float_gt, var(X), var(Y))), no).
code_util__translate_builtin_2("float", "builtin_float_lt", 0, [X, Y],
yes(binop(float_lt, var(X), var(Y))), no).
code_util__translate_builtin_2("float", "<", 0, [X, Y],
yes(binop(float_lt, var(X), var(Y))), no).
code_util__translate_builtin_2("float", "builtin_float_ge", 0, [X, Y],
yes(binop(float_ge, var(X), var(Y))), no).
code_util__translate_builtin_2("float", ">=", 0, [X, Y],
yes(binop(float_ge, var(X), var(Y))), no).
code_util__translate_builtin_2("float", "builtin_float_le", 0, [X, Y],
yes(binop(float_le, var(X), var(Y))), no).
code_util__translate_builtin_2("float", "=<", 0, [X, Y],
yes(binop(float_le, var(X), var(Y))), no).
%-----------------------------------------------------------------------------%
% code_util__compiler_generated(PredInfo) should succeed iff
% the PredInfo is for a compiler generated predicate.
code_util__compiler_generated(PredInfo) :-
pred_info_name(PredInfo, PredName),
pred_info_arity(PredInfo, PredArity),
special_pred_name_arity(_, _, PredName, PredArity).
%-----------------------------------------------------------------------------%
% This code may _look_ nondeterministic, but it's really semidet,
% and Mercury is smart enough to know this.
code_util__goal_may_allocate_heap(Goal - _GoalInfo) :-
code_util__goal_may_allocate_heap_2(Goal).
:- pred code_util__goal_may_allocate_heap_2(hlds_goal_expr).
:- mode code_util__goal_may_allocate_heap_2(in) is semidet.
code_util__goal_may_allocate_heap_2(higher_order_call(_, _, _, _, _, _)).
code_util__goal_may_allocate_heap_2(call(_, _, _, Builtin, _, _)) :-
Builtin \= inline_builtin.
code_util__goal_may_allocate_heap_2(unify(_, _, _, construct(_,_,Args,_), _)) :-
Args = [_|_].
code_util__goal_may_allocate_heap_2(some(_Vars, Goal)) :-
code_util__goal_may_allocate_heap(Goal).
code_util__goal_may_allocate_heap_2(not(Goal)) :-
code_util__goal_may_allocate_heap(Goal).
code_util__goal_may_allocate_heap_2(conj(Goals)) :-
code_util__goal_list_may_allocate_heap(Goals).
code_util__goal_may_allocate_heap_2(disj(Goals, _)) :-
code_util__goal_list_may_allocate_heap(Goals).
code_util__goal_may_allocate_heap_2(switch(_Var, _Det, Cases, _)) :-
code_util__cases_may_allocate_heap(Cases).
code_util__goal_may_allocate_heap_2(if_then_else(_Vars, A, B, C, _)) :-
(
code_util__goal_may_allocate_heap(A)
;
code_util__goal_may_allocate_heap(B)
;
code_util__goal_may_allocate_heap(C)
).
:- pred code_util__cases_may_allocate_heap(list(case)).
:- mode code_util__cases_may_allocate_heap(in) is semidet.
code_util__cases_may_allocate_heap([case(_, Goal) | _]) :-
code_util__goal_may_allocate_heap(Goal).
code_util__cases_may_allocate_heap([_ | Cases]) :-
code_util__cases_may_allocate_heap(Cases).
code_util__goal_list_may_allocate_heap([Goal | _]) :-
code_util__goal_may_allocate_heap(Goal).
code_util__goal_list_may_allocate_heap([_ | Goals]) :-
code_util__goal_list_may_allocate_heap(Goals).
%-----------------------------------------------------------------------------%
% Negate a condition.
% This is used mostly just to make the generated code more readable.
code_util__neg_rval(Rval, NegRval) :-
( code_util__neg_rval_2(Rval, NegRval0) ->
NegRval = NegRval0
;
NegRval = unop(not, Rval)
).
:- pred code_util__neg_rval_2(rval, rval).
:- mode code_util__neg_rval_2(in, out) is semidet.
code_util__neg_rval_2(const(Const), const(NegConst)) :-
(
Const = true, NegConst = false
;
Const = false, NegConst = true
).
code_util__neg_rval_2(unop(not, Rval), Rval).
code_util__neg_rval_2(binop(Op, X, Y), binop(NegOp, X, Y)) :-
code_util__neg_op(Op, NegOp).
:- pred code_util__neg_op(binary_op, binary_op).
:- mode code_util__neg_op(in, out) is semidet.
code_util__neg_op(eq, ne).
code_util__neg_op(ne, eq).
code_util__neg_op(<, >=).
code_util__neg_op(<=, >).
code_util__neg_op(>, <=).
code_util__neg_op(>=, <).
code_util__neg_op(str_eq, str_ne).
code_util__neg_op(str_ne, str_eq).
code_util__neg_op(str_lt, str_ge).
code_util__neg_op(str_le, str_gt).
code_util__neg_op(str_gt, str_le).
code_util__neg_op(str_ge, str_lt).
code_util__neg_op(float_eq, float_ne).
code_util__neg_op(float_ne, float_eq).
code_util__neg_op(float_lt, float_ge).
code_util__neg_op(float_le, float_gt).
code_util__neg_op(float_gt, float_le).
code_util__neg_op(float_ge, float_lt).
code_util__negate_the_test([], _) :-
error("code_util__negate_the_test on empty list").
code_util__negate_the_test([Instr0 | Instrs0], Instrs) :-
( Instr0 = if_val(Test, Target) - Comment ->
code_util__neg_rval(Test, NewTest),
Instrs = [if_val(NewTest, Target) - Comment]
;
code_util__negate_the_test(Instrs0, Instrs1),
Instrs = [Instr0 | Instrs1]
).
%-----------------------------------------------------------------------------%
code_util__cons_id_to_tag(int_const(X), _, _, int_constant(X)).
code_util__cons_id_to_tag(float_const(X), _, _, float_constant(X)).
code_util__cons_id_to_tag(string_const(X), _, _, string_constant(X)).
code_util__cons_id_to_tag(code_addr_const(P,M), _, _, code_addr_constant(P,M)).
code_util__cons_id_to_tag(pred_const(P,M), _, _, pred_closure_tag(P,M)).
code_util__cons_id_to_tag(base_type_info_const(M,T,A), _, _,
base_type_info_constant(M,T,A)).
code_util__cons_id_to_tag(base_typeclass_info_const(M,C,N), _, _,
base_typeclass_info_constant(M,C,N)).
code_util__cons_id_to_tag(cons(Name, Arity), Type, ModuleInfo, Tag) :-
(
% handle the `character' type specially
Type = term__functor(term__atom("character"), [], _),
Name = unqualified(ConsName),
string__char_to_string(Char, ConsName)
->
char__to_int(Char, CharCode),
Tag = int_constant(CharCode)
;
% Use the type to determine the type_id
( type_to_type_id(Type, TypeId0, _) ->
TypeId = TypeId0
;
% the type-checker should ensure that this never happens
error("code_util__cons_id_to_tag: invalid type")
),
% Given the type_id, lookup up the constructor tag
% table for that type
module_info_types(ModuleInfo, TypeTable),
map__lookup(TypeTable, TypeId, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, TypeBody),
(
TypeBody = du_type(_, ConsTable0, _, _)
->
ConsTable = ConsTable0
;
% this should never happen
error(
"code_util__cons_id_to_tag: type is not d.u. type?"
)
),
% Finally look up the cons_id in the table
map__lookup(ConsTable, cons(Name, Arity), Tag)
).
%-----------------------------------------------------------------------------%
code_util__cannot_stack_flush(GoalExpr - _) :-
code_util__cannot_stack_flush_2(GoalExpr).
:- pred code_util__cannot_stack_flush_2(hlds_goal_expr).
:- mode code_util__cannot_stack_flush_2(in) is semidet.
code_util__cannot_stack_flush_2(unify(_, _, _, Unify, _)) :-
Unify \= complicated_unify(_, _).
code_util__cannot_stack_flush_2(call(_, _, _, BuiltinState, _, _)) :-
BuiltinState = inline_builtin.
code_util__cannot_stack_flush_2(conj(Goals)) :-
code_util__cannot_stack_flush_goals(Goals).
code_util__cannot_stack_flush_2(switch(_, _, Cases, _)) :-
code_util__cannot_stack_flush_cases(Cases).
:- pred code_util__cannot_stack_flush_goals(list(hlds_goal)).
:- mode code_util__cannot_stack_flush_goals(in) is semidet.
code_util__cannot_stack_flush_goals([]).
code_util__cannot_stack_flush_goals([Goal | Goals]) :-
code_util__cannot_stack_flush(Goal),
code_util__cannot_stack_flush_goals(Goals).
:- pred code_util__cannot_stack_flush_cases(list(case)).
:- mode code_util__cannot_stack_flush_cases(in) is semidet.
code_util__cannot_stack_flush_cases([]).
code_util__cannot_stack_flush_cases([case(_, Goal) | Cases]) :-
code_util__cannot_stack_flush(Goal),
code_util__cannot_stack_flush_cases(Cases).
%-----------------------------------------------------------------------------%
code_util__cannot_fail_before_stack_flush(GoalExpr - GoalInfo) :-
goal_info_get_determinism(GoalInfo, Detism),
determinism_components(Detism, CanFail, _),
( CanFail = cannot_fail ->
true
;
code_util__cannot_fail_before_stack_flush_2(GoalExpr)
).
:- pred code_util__cannot_fail_before_stack_flush_2(hlds_goal_expr).
:- mode code_util__cannot_fail_before_stack_flush_2(in) is semidet.
code_util__cannot_fail_before_stack_flush_2(conj(Goals)) :-
code_util__cannot_fail_before_stack_flush_conj(Goals).
:- pred code_util__cannot_fail_before_stack_flush_conj(list(hlds_goal)).
:- mode code_util__cannot_fail_before_stack_flush_conj(in) is semidet.
code_util__cannot_fail_before_stack_flush_conj([]).
code_util__cannot_fail_before_stack_flush_conj([Goal | Goals]) :-
Goal = GoalExpr - GoalInfo,
(
(
GoalExpr = call(_, _, _, BuiltinState, _, _),
BuiltinState \= inline_builtin
;
GoalExpr = higher_order_call(_, _, _, _, _, _)
)
->
true
;
goal_info_get_determinism(GoalInfo, Detism),
determinism_components(Detism, cannot_fail, _)
->
code_util__cannot_fail_before_stack_flush_conj(Goals)
;
fail
).
%-----------------------------------------------------------------------------%
code_util__count_recursive_calls(Goal - _, PredId, ProcId, Min, Max) :-
code_util__count_recursive_calls_2(Goal, PredId, ProcId, Min, Max).
:- pred code_util__count_recursive_calls_2(hlds_goal_expr, pred_id, proc_id,
int, int).
:- mode code_util__count_recursive_calls_2(in, in, in, out, out) is det.
code_util__count_recursive_calls_2(not(Goal), PredId, ProcId, Min, Max) :-
code_util__count_recursive_calls(Goal, PredId, ProcId, Min, Max).
code_util__count_recursive_calls_2(some(_, Goal), PredId, ProcId, Min, Max) :-
code_util__count_recursive_calls(Goal, PredId, ProcId, Min, Max).
code_util__count_recursive_calls_2(unify(_, _, _, _, _), _, _, 0, 0).
code_util__count_recursive_calls_2(higher_order_call(_, _,_, _, _, _), _, _,
0, 0).
code_util__count_recursive_calls_2(class_method_call(_, _,_, _, _, _), _, _,
0, 0).
code_util__count_recursive_calls_2(pragma_c_code(_,_,_, _, _, _, _), _, _,
0, 0).
code_util__count_recursive_calls_2(call(CallPredId, CallProcId, _, _, _, _),
PredId, ProcId, Count, Count) :-
(
PredId = CallPredId,
ProcId = CallProcId
->
Count = 1
;
Count = 0
).
code_util__count_recursive_calls_2(conj(Goals), PredId, ProcId, Min, Max) :-
code_util__count_recursive_calls_conj(Goals, PredId, ProcId, 0, 0,
Min, Max).
code_util__count_recursive_calls_2(disj(Goals, _), PredId, ProcId, Min, Max) :-
code_util__count_recursive_calls_disj(Goals, PredId, ProcId, Min, Max).
code_util__count_recursive_calls_2(switch(_, _, Cases, _), PredId, ProcId,
Min, Max) :-
code_util__count_recursive_calls_cases(Cases, PredId, ProcId, Min, Max).
code_util__count_recursive_calls_2(if_then_else(_, Cond, Then, Else, _),
PredId, ProcId, Min, Max) :-
code_util__count_recursive_calls(Cond, PredId, ProcId, CMin, CMax),
code_util__count_recursive_calls(Then, PredId, ProcId, TMin, TMax),
code_util__count_recursive_calls(Else, PredId, ProcId, EMin, EMax),
CTMin is CMin + TMin,
CTMax is CMax + TMax,
int__min(CTMin, EMin, Min),
int__max(CTMax, EMax, Max).
:- pred code_util__count_recursive_calls_conj(list(hlds_goal),
pred_id, proc_id, int, int, int, int).
:- mode code_util__count_recursive_calls_conj(in, in, in, in, in, out, out)
is det.
code_util__count_recursive_calls_conj([], _, _, Min, Max, Min, Max).
code_util__count_recursive_calls_conj([Goal | Goals], PredId, ProcId,
Min0, Max0, Min, Max) :-
code_util__count_recursive_calls(Goal, PredId, ProcId, Min1, Max1),
Min2 is Min0 + Min1,
Max2 is Max0 + Max1,
code_util__count_recursive_calls_conj(Goals, PredId, ProcId,
Min2, Max2, Min, Max).
:- pred code_util__count_recursive_calls_disj(list(hlds_goal),
pred_id, proc_id, int, int).
:- mode code_util__count_recursive_calls_disj(in, in, in, out, out) is det.
code_util__count_recursive_calls_disj([], _, _, 0, 0).
code_util__count_recursive_calls_disj([Goal | Goals], PredId, ProcId,
Min, Max) :-
( Goals = [] ->
code_util__count_recursive_calls(Goal, PredId, ProcId,
Min, Max)
;
code_util__count_recursive_calls(Goal, PredId, ProcId,
Min0, Max0),
code_util__count_recursive_calls_disj(Goals, PredId, ProcId,
Min1, Max1),
int__min(Min0, Min1, Min),
int__max(Max0, Max1, Max)
).
:- pred code_util__count_recursive_calls_cases(list(case),
pred_id, proc_id, int, int).
:- mode code_util__count_recursive_calls_cases(in, in, in, out, out) is det.
code_util__count_recursive_calls_cases([], _, _, _, _) :-
error("empty cases in code_util__count_recursive_calls_cases").
code_util__count_recursive_calls_cases([case(_, Goal) | Cases], PredId, ProcId,
Min, Max) :-
( Cases = [] ->
code_util__count_recursive_calls(Goal, PredId, ProcId,
Min, Max)
;
code_util__count_recursive_calls(Goal, PredId, ProcId,
Min0, Max0),
code_util__count_recursive_calls_cases(Cases, PredId, ProcId,
Min1, Max1),
int__min(Min0, Min1, Min),
int__max(Max0, Max1, Max)
).
Reference in New Issue View Git Blame Copy Permalink