Files
mercury/compiler/exprn_aux.m
Zoltan Somogyi a1f326f4e9 Add an alternative to code_exprn that does eager code generation (code_exprn
Estimated hours taken: 140

Add an alternative to code_exprn that does eager code generation (code_exprn
always does lazy code generation). Its main advantages are that the new code
is significantly simpler, and that it does not generate unnecessary shuffling
code. Its main disadvantage, which is that it does not eliminate the creation
of unneeded cells, can be eliminated by switching on --unneeded-code.

For now, you can select the use of the new code generator with the
--no-lazy-code option (which was previously present but unused).
This will be made the default later, after I do more performance tests.

Var_locn contains stricter self-checks than code_exprn does. This required
modifications to some other parts of the code generator to ensure that the
self-checks do not fail unnecessarily. (This mostly took the form of explicitly
killing off dead variables before calling code_info__clear_all_registers, which
would complain about losing the last record of the value of a variable that was
alive as far as it knew.) To make my changes simpler, also took the opportunity
to simplify parts of the code generator which were handing around rvals that
in fact had to be wrappers around lvals, by handing around the lvals directly.

Testing this change also required fixing an old bug which prevented compiling
the library with -O1 --trace deep, together with the usual intermodule
optimization. The bug is that a library module reads predicates from
builtin.opt or private_builtin.opt, does not eliminate them because of the -O1,
and then tries to generate traced code for them. However, this fails because
the builtin modules contain some predicates that cannot be made to conform to
typeinfo-liveness, which is required by tracing.

compiler/var_locn.m:
	The new module that implements eager code generation.

compiler/follow_vars.m:
	Improve the follow_vars pass, since eager code generation requires
	better follow_vars information. We now generate correct information
	for generic calls, and record not only where some vars (e.g. those
	which appear as input arguments of following calls) should be put,
	but also which registers are not reserved for those variables and
	are thus available for other variables.

compiler/hlds_goal.m:
	Modify the follow_vars field of the goal_info to record the number
	of the first non-reserved register.

compiler/code_info.m:
 	Replace the general-purpose predicate code_info__cache_exprn, which
	associated a variable with an rval without generating code, with a set
	of special-purpose predicates such as code_info__assign_const_to_var
	and code_info__assign_cell_to_var, some of which can generate code.

	These new predicates and some older ones (e.g. code_info__setup_call)
	now choose at runtime whether to call code_exprn or var_locn. The
	basis for the decision is checking whether the code_info structure
	contains an exprn_info or a var_locn_info. This is decided in
	code_info__init based on the value of the lazy_code option, and
	maintained unchanged from then on.

	Rename some predicates to better reflect their current possible
	behaviors.

compiler/unify_gen.m:
	Call the new special-purpose predicates in code_info instead of
	code_info__cache_exprn.

	Replace an incorrect clause with a call to error, since that clause
	could never be invoked.

compiler/call_gen.m:
	Hand over the task of generating the args of generic calls to
	code_info, since it already has code to do the right thing, which
	includes reserving the registers to be used for the input args.

	Notify the rest of the code generator after the last use of
	non-forward-live variables, in order to avoid spurious calls to error
	(it is an error to clobber the last location of a live variable).

	Notify the rest of the code generator when generic calls overwrite
	registers, to allow the proper consistency checks to be made.

	If an output variable is singleton, then do not make it known to the
	code generator. It never will never become dead, and may thus cause a
	spurious compiler abort if its storage is ever clobbered.

	Export a predicate for use by follow_vars.

	Factor out some common code.

	Call the new preds in code_info where necessary.

compiler/pragma_c_gen.m:
	Notify the rest of the code generator after the last use of
	non-forward-live variables, in order to avoid spurious calls to error
	(it is an error to clobber the last location of a live variable).

	If an output variable is singleton, then do not make it known to the
	code generator. It never will never become dead, and may thus cause a
	spurious compiler abort if its storage is ever clobbered.

	When using var_locn, ensure that none of the input arguments of a
	model_semi pragma_c_code is assigned to r1. If we did, and the last
	reference to the value of that argument was after an assignment to
	SUCCESS_INDICATOR, the C compiler would be forced to generate code
	to shuffle the value of the argument out of the way.

compiler/code_exprn.m:
	Minor changes to return lvals directly instead of lvals wrapped inside
	rvals and to conform the new format of follow_vars.

	Do not include the registers reserved by follow_vars in the
	search for a spare register.

compiler/lookup_switch.m:
compiler/switch_gen.m:
	Fix an old bug that did not matter with code_exprn but does matter with
	var_locn: the branch end structure was being computed in the wrong
	place.

compiler/disj_gen.m:
	At the ends of non-last disjuncts, kill off the variables that we
	needed to know inside the disjunct but won't need to know after the
	disjunct, in order to avoid error messages about throwing away their
	state. The variables affected are those which are needed only by the
	resumption point of the next disjunct, not by enclosing resumption
	points or forward execution.

compiler/arg_info.m:
	Associate an lval, not an rval, with each argument.

compiler/*.m:
	Minor changes to conform to (a) the new format of follow_vars, (b)
	the replacement of rvals containing lvals by lvals.

compiler/code_util.m:
	Add some utility predicates for var_locn.m.

compiler/exprn_aux.m:
	Add some utility functions for var_locn.m.

	Export a predicate for var_locn.m.

compiler/handle_options.m:
	If --no-lazy-code is set, switch on the "optimizations" on whose
	presence it depends.

compiler/mercury_compile.m:
compiler/code_gen.m:
	Turn off tracing for predicates that don't obey typeinfo liveness
	for backend_by_preds and backend_by_phases respectively.

	Look up options in the globals structure in the module_info, not in the
	globals structure in the I/O state, since this is where we turn off
	tracing. (We should later make sure that other parts of the compiler
	are also consistent on this issue.)

compiler/stack_layout.m:
	Throw away any continuation_info structures that belong to predicates
	that don't obey typeinfo liveness.
2000-09-16 00:08:27 +00:00

947 lines
30 KiB
Mathematica

%-----------------------------------------------------------------------------%
% Copyright (C) 1995-2000 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 exprn_aux.
:- interface.
:- import_module llds, options, prog_data.
:- import_module list, std_util, bool, assoc_list.
:- type exprn_opts
---> nlg_asm_sgt_ubf(
bool, % --use-non-local-gotos
bool, % --use-asm-labels
bool, % --static-ground-terms
bool % --unboxed-float
).
:- pred exprn_aux__init_exprn_opts(option_table, exprn_opts).
:- mode exprn_aux__init_exprn_opts(in, out) is det.
% Determine whether an rval_const can be used as the initializer
% of a C static constant.
:- pred exprn_aux__const_is_constant(rval_const, exprn_opts, bool).
:- mode exprn_aux__const_is_constant(in, in, out) is det.
% exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst)
% figures out whether an imported label address is a constant.
% This depends on how we treat labels.
:- pred exprn_aux__imported_is_constant(bool, bool, bool).
:- mode exprn_aux__imported_is_constant(in, in, out) is det.
:- pred exprn_aux__rval_contains_lval(rval, lval).
:- mode exprn_aux__rval_contains_lval(in, in) is semidet.
:- pred exprn_aux__rval_contains_rval(rval, rval).
:- mode exprn_aux__rval_contains_rval(in, in) is semidet.
:- mode exprn_aux__rval_contains_rval(in, out) is multidet.
:- pred exprn_aux__args_contain_rval(list(maybe(rval)), rval).
:- mode exprn_aux__args_contain_rval(in, in) is semidet.
:- mode exprn_aux__args_contain_rval(in, out) is nondet.
:- pred exprn_aux__substitute_lval_in_lval(lval, lval, lval, lval).
:- mode exprn_aux__substitute_lval_in_lval(in, in, in, out) is det.
:- pred exprn_aux__substitute_lval_in_rval(lval, lval, rval, rval).
:- mode exprn_aux__substitute_lval_in_rval(in, in, in, out) is det.
:- pred exprn_aux__substitute_rval_in_rval(rval, rval, rval, rval).
:- mode exprn_aux__substitute_rval_in_rval(in, in, in, out) is det.
:- pred exprn_aux__substitute_vars_in_rval(assoc_list(prog_var, rval),
rval, rval).
:- mode exprn_aux__substitute_vars_in_rval(in, in, out) is det.
:- pred exprn_aux__substitute_rvals_in_rval(assoc_list(rval, rval), rval, rval).
:- mode exprn_aux__substitute_rvals_in_rval(in, in, out) is det.
:- pred exprn_aux__vars_in_lval(lval, list(prog_var)).
:- mode exprn_aux__vars_in_lval(in, out) is det.
:- pred exprn_aux__vars_in_rval(rval, list(prog_var)).
:- mode exprn_aux__vars_in_rval(in, out) is det.
:- pred exprn_aux__simplify_rval(rval, rval).
:- mode exprn_aux__simplify_rval(in, out) is det.
% the following predicates take an lval/rval (list)
% and return a list of the code and data addresses that it references.
:- pred exprn_aux__rval_list_addrs(list(rval),
list(code_addr), list(data_addr)).
:- mode exprn_aux__rval_list_addrs(in, out, out) is det.
:- pred exprn_aux__lval_list_addrs(list(lval),
list(code_addr), list(data_addr)).
:- mode exprn_aux__lval_list_addrs(in, out, out) is det.
:- pred exprn_aux__rval_addrs(rval, list(code_addr), list(data_addr)).
:- mode exprn_aux__rval_addrs(in, out, out) is det.
:- pred exprn_aux__lval_addrs(lval, list(code_addr), list(data_addr)).
:- mode exprn_aux__lval_addrs(in, out, out) is det.
:- pred exprn_aux__maybe_rval_list_addrs(list(maybe(rval)),
list(code_addr), list(data_addr)).
:- mode exprn_aux__maybe_rval_list_addrs(in, out, out) is det.
:- func exprn_aux__var_lval_to_rval(prog_var, lval) = rval.
:- func exprn_aux__lval_to_rval(lval) = rval.
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
:- implementation.
:- import_module int, require, getopt, options.
exprn_aux__init_exprn_opts(Options, ExprnOpts) :-
getopt__lookup_bool_option(Options, gcc_non_local_gotos, NLG),
getopt__lookup_bool_option(Options, asm_labels, ASM),
getopt__lookup_bool_option(Options, static_ground_terms, SGT),
getopt__lookup_bool_option(Options, unboxed_float, UBF),
ExprnOpts = nlg_asm_sgt_ubf(NLG, ASM, SGT, UBF).
% Determine whether a const (well, what _we_ consider to be a const)
% is constant as far as the C compiler is concerned -- specifically,
% determine whether it can be used as the initializer of a C static
% constant.
exprn_aux__const_is_constant(true, _, yes).
exprn_aux__const_is_constant(false, _, yes).
exprn_aux__const_is_constant(int_const(_), _, yes).
exprn_aux__const_is_constant(float_const(_), ExprnOpts, IsConst) :-
ExprnOpts = nlg_asm_sgt_ubf(_NLG, _ASM, StaticGroundTerms,
UnboxedFloat),
( UnboxedFloat = yes ->
%
% If we're using unboxed (single-precision) floats,
% floating point values are always constants
%
IsConst = yes
;
%
% If we're using boxed floats, then we can generate a static
% constant variable to hold a float constant, and gcc
% doesn't mind us converting from its address to word
% in a static initializer. However, we only do this if
% --static-ground-terms is enabled.
%
IsConst = StaticGroundTerms
).
exprn_aux__const_is_constant(string_const(_), _, yes).
exprn_aux__const_is_constant(multi_string_const(_, _), _, yes).
exprn_aux__const_is_constant(code_addr_const(CodeAddr), ExprnOpts, IsConst) :-
exprn_aux__addr_is_constant(CodeAddr, ExprnOpts, IsConst).
exprn_aux__const_is_constant(data_addr_const(_), _, yes).
exprn_aux__const_is_constant(label_entry(Label), ExprnOpts, IsConst) :-
exprn_aux__addr_is_constant(label(Label), ExprnOpts, IsConst).
:- pred exprn_aux__addr_is_constant(code_addr, exprn_opts, bool).
:- mode exprn_aux__addr_is_constant(in, in, out) is det.
exprn_aux__addr_is_constant(label(Label), ExprnOpts, IsConst) :-
ExprnOpts = nlg_asm_sgt_ubf(NonLocalGotos, AsmLabels, _SGT, _UBF),
exprn_aux__label_is_constant(Label, NonLocalGotos, AsmLabels, IsConst).
exprn_aux__addr_is_constant(imported(_), ExprnOpts, IsConst) :-
ExprnOpts = nlg_asm_sgt_ubf(NonLocalGotos, AsmLabels, _SGT, _UBF),
exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst).
exprn_aux__addr_is_constant(succip, _, no).
exprn_aux__addr_is_constant(do_succeed(_), _, no).
exprn_aux__addr_is_constant(do_redo, _, no).
exprn_aux__addr_is_constant(do_fail, _, no).
exprn_aux__addr_is_constant(do_trace_redo_fail_shallow, _, no).
exprn_aux__addr_is_constant(do_trace_redo_fail_deep, _, no).
exprn_aux__addr_is_constant(do_call_closure, _, no).
exprn_aux__addr_is_constant(do_call_class_method, _, no).
exprn_aux__addr_is_constant(do_det_aditi_call, _, no).
exprn_aux__addr_is_constant(do_semidet_aditi_call, _, no).
exprn_aux__addr_is_constant(do_nondet_aditi_call, _, no).
exprn_aux__addr_is_constant(do_aditi_insert, _, no).
exprn_aux__addr_is_constant(do_aditi_delete, _, no).
exprn_aux__addr_is_constant(do_aditi_bulk_insert, _, no).
exprn_aux__addr_is_constant(do_aditi_bulk_delete, _, no).
exprn_aux__addr_is_constant(do_aditi_bulk_modify, _, no).
exprn_aux__addr_is_constant(do_not_reached, _, no).
:- pred exprn_aux__label_is_constant(label, bool, bool, bool).
:- mode exprn_aux__label_is_constant(in, in, in, out) is det.
exprn_aux__label_is_constant(exported(_), NonLocalGotos, AsmLabels, IsConst) :-
exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst).
exprn_aux__label_is_constant(local(_), NonLocalGotos, AsmLabels, IsConst) :-
exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst).
exprn_aux__label_is_constant(c_local(_), _NonLocalGotos, _AsmLabels, yes).
exprn_aux__label_is_constant(local(_, _), _NonLocalGotos, _AsmLabels, yes).
% The logic of this function and how it is used in globals.m to
% select the default type_info method must agree with the code in
% runtime/typeinfo.h.
exprn_aux__imported_is_constant(NonLocalGotos, AsmLabels, IsConst) :-
(
NonLocalGotos = yes,
AsmLabels = no
->
%
% with non-local gotos but no asm labels, jumps to code
% addresses in different c_modules must be done via global
% variables; the value of these global variables is not
% constant (i.e. not computable at load time), since they
% can't be initialized until we call init_modules().
%
IsConst = no
;
IsConst = yes
).
%------------------------------------------------------------------------------%
exprn_aux__rval_contains_lval(lval(Lval0), Lval) :-
exprn_aux__lval_contains_lval(Lval0, Lval).
exprn_aux__rval_contains_lval(create(_, Rvals, _, _, _, _, Reuse), Lval) :-
exprn_aux__args_contain_lval([Reuse | Rvals], Lval).
exprn_aux__rval_contains_lval(mkword(_, Rval), Lval) :-
exprn_aux__rval_contains_lval(Rval, Lval).
exprn_aux__rval_contains_lval(unop(_, Rval), Lval) :-
exprn_aux__rval_contains_lval(Rval, Lval).
exprn_aux__rval_contains_lval(binop(_, Rval0, Rval1), Lval) :-
(
exprn_aux__rval_contains_lval(Rval0, Lval)
;
exprn_aux__rval_contains_lval(Rval1, Lval)
).
:- pred exprn_aux__lval_contains_lval(lval, lval).
:- mode exprn_aux__lval_contains_lval(in, in) is semidet.
exprn_aux__lval_contains_lval(Lval0, Lval) :-
(
Lval0 = Lval
->
true
;
Lval0 = field(_, Rval0, Rval1)
->
(
exprn_aux__rval_contains_lval(Rval0, Lval)
;
exprn_aux__rval_contains_lval(Rval1, Lval)
)
;
Lval0 = lvar(_Var)
->
error("exprn_aux__lval_contains_lval: var! I can't tell")
;
fail
).
:- pred exprn_aux__args_contain_lval(list(maybe(rval)), lval).
:- mode exprn_aux__args_contain_lval(in, in) is semidet.
exprn_aux__args_contain_lval([M | Ms], Lval) :-
(
M = yes(Rval),
exprn_aux__rval_contains_lval(Rval, Lval)
->
true
;
exprn_aux__args_contain_lval(Ms, Lval)
).
%------------------------------------------------------------------------------%
exprn_aux__rval_contains_rval(Rval0, Rval) :-
(
Rval0 = Rval
;
(
Rval0 = lval(Lval),
exprn_aux__lval_contains_rval(Lval, Rval)
;
Rval0 = create(_, Rvals, _, _, _, _, Reuse),
exprn_aux__args_contain_rval([Reuse | Rvals], Rval)
;
Rval0 = mkword(_, Rval1),
exprn_aux__rval_contains_rval(Rval1, Rval)
;
Rval0 = unop(_, Rval1),
exprn_aux__rval_contains_rval(Rval1, Rval)
;
Rval0 = binop(_, Rval1, Rval2),
(
exprn_aux__rval_contains_rval(Rval1, Rval)
;
exprn_aux__rval_contains_rval(Rval2, Rval)
)
)
).
:- pred exprn_aux__lval_contains_rval(lval, rval).
:- mode exprn_aux__lval_contains_rval(in, in) is semidet.
:- mode exprn_aux__lval_contains_rval(in, out) is nondet.
exprn_aux__lval_contains_rval(field(_, Rval0, Rval1), Rval) :-
(
exprn_aux__rval_contains_rval(Rval0, Rval)
;
exprn_aux__rval_contains_rval(Rval1, Rval)
).
exprn_aux__args_contain_rval([M | Ms], Rval) :-
(
M = yes(Rval0),
exprn_aux__rval_contains_rval(Rval0, Rval)
;
exprn_aux__args_contain_rval(Ms, Rval)
).
%------------------------------------------------------------------------------%
exprn_aux__vars_in_rval(lval(Lval), Vars) :-
exprn_aux__vars_in_lval(Lval, Vars).
exprn_aux__vars_in_rval(var(Var), [Var]).
exprn_aux__vars_in_rval(create(_, Rvals, _, _, _, _, Reuse), Vars) :-
exprn_aux__vars_in_args([Reuse | Rvals], Vars).
exprn_aux__vars_in_rval(mkword(_, Rval), Vars) :-
exprn_aux__vars_in_rval(Rval, Vars).
exprn_aux__vars_in_rval(const(_Conts), []).
exprn_aux__vars_in_rval(unop(_, Rval), Vars) :-
exprn_aux__vars_in_rval(Rval, Vars).
exprn_aux__vars_in_rval(binop(_, Rval0, Rval1), Vars) :-
exprn_aux__vars_in_rval(Rval0, Vars0),
exprn_aux__vars_in_rval(Rval1, Vars1),
list__append(Vars0, Vars1, Vars).
exprn_aux__vars_in_rval(mem_addr(MemRef), Vars) :-
exprn_aux__vars_in_mem_ref(MemRef, Vars).
exprn_aux__vars_in_lval(reg(_, _), []).
exprn_aux__vars_in_lval(temp(_, _), []).
exprn_aux__vars_in_lval(succip, []).
exprn_aux__vars_in_lval(maxfr, []).
exprn_aux__vars_in_lval(curfr, []).
exprn_aux__vars_in_lval(hp, []).
exprn_aux__vars_in_lval(sp, []).
exprn_aux__vars_in_lval(stackvar(_), []).
exprn_aux__vars_in_lval(framevar(_), []).
exprn_aux__vars_in_lval(succip(Rval), Vars) :-
exprn_aux__vars_in_rval(Rval, Vars).
exprn_aux__vars_in_lval(redoip(Rval), Vars) :-
exprn_aux__vars_in_rval(Rval, Vars).
exprn_aux__vars_in_lval(redofr(Rval), Vars) :-
exprn_aux__vars_in_rval(Rval, Vars).
exprn_aux__vars_in_lval(succfr(Rval), Vars) :-
exprn_aux__vars_in_rval(Rval, Vars).
exprn_aux__vars_in_lval(prevfr(Rval), Vars) :-
exprn_aux__vars_in_rval(Rval, Vars).
exprn_aux__vars_in_lval(field(_, Rval0, Rval1), Vars) :-
exprn_aux__vars_in_rval(Rval0, Vars0),
exprn_aux__vars_in_rval(Rval1, Vars1),
list__append(Vars0, Vars1, Vars).
exprn_aux__vars_in_lval(mem_ref(Rval), Vars) :-
exprn_aux__vars_in_rval(Rval, Vars).
exprn_aux__vars_in_lval(lvar(Var), [Var]).
:- pred exprn_aux__vars_in_mem_ref(mem_ref, list(prog_var)).
:- mode exprn_aux__vars_in_mem_ref(in, out) is det.
exprn_aux__vars_in_mem_ref(stackvar_ref(_), []).
exprn_aux__vars_in_mem_ref(framevar_ref(_), []).
exprn_aux__vars_in_mem_ref(heap_ref(Rval, _, _), Vars) :-
exprn_aux__vars_in_rval(Rval, Vars).
:- pred exprn_aux__vars_in_args(list(maybe(rval)), list(prog_var)).
:- mode exprn_aux__vars_in_args(in, out) is det.
exprn_aux__vars_in_args([], []).
exprn_aux__vars_in_args([M | Ms], Vars) :-
exprn_aux__vars_in_args(Ms, Vars0),
(
M = yes(Rval)
->
exprn_aux__vars_in_rval(Rval, Vars1),
list__append(Vars1, Vars0, Vars)
;
Vars = Vars0
).
%------------------------------------------------------------------------------%
exprn_aux__substitute_lval_in_rval(OldLval, NewLval, Rval0, Rval) :-
(
Rval0 = lval(Lval0),
exprn_aux__substitute_lval_in_lval(OldLval, NewLval,
Lval0, Lval),
Rval = lval(Lval)
;
Rval0 = var(_Var),
Rval = Rval0
;
Rval0 = create(Tag, Rvals0, ArgTypes, StatDyn,
Num, Msg, Reuse0),
exprn_aux__substitute_lval_in_args(OldLval, NewLval,
Rvals0, Rvals),
exprn_aux__substitute_lval_in_arg(OldLval, NewLval,
Reuse0, Reuse),
Rval = create(Tag, Rvals, ArgTypes, StatDyn, Num, Msg, Reuse)
;
Rval0 = mkword(Tag, Rval1),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval1, Rval2),
Rval = mkword(Tag, Rval2)
;
Rval0 = const(_Const),
Rval = Rval0
;
Rval0 = unop(Unop, Rval1),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval1, Rval2),
Rval = unop(Unop, Rval2)
;
Rval0 = binop(Binop, Rval1, Rval2),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval1, Rval3),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval2, Rval4),
Rval = binop(Binop, Rval3, Rval4)
;
Rval0 = mem_addr(MemRef0),
exprn_aux__substitute_lval_in_mem_ref(OldLval, NewLval,
MemRef0, MemRef),
Rval = mem_addr(MemRef)
).
:- pred exprn_aux__substitute_lval_in_mem_ref(lval, lval, mem_ref, mem_ref).
:- mode exprn_aux__substitute_lval_in_mem_ref(in, in, in, out) is det.
exprn_aux__substitute_lval_in_mem_ref(OldLval, NewLval, MemRef0, MemRef) :-
(
MemRef0 = stackvar_ref(N),
MemRef = stackvar_ref(N)
;
MemRef0 = framevar_ref(N),
MemRef = framevar_ref(N)
;
MemRef0 = heap_ref(Rval0, Tag, N),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval0, Rval),
MemRef = heap_ref(Rval, Tag, N)
).
exprn_aux__substitute_lval_in_lval(OldLval, NewLval, Lval0, Lval) :-
(
Lval0 = OldLval
->
Lval = NewLval
;
exprn_aux__substitute_lval_in_lval_2(OldLval, NewLval,
Lval0, Lval)
).
:- pred exprn_aux__substitute_lval_in_lval_2(lval, lval, lval, lval).
:- mode exprn_aux__substitute_lval_in_lval_2(in, in, in, out) is det.
exprn_aux__substitute_lval_in_lval_2(OldLval, NewLval, Lval0, Lval) :-
(
Lval0 = reg(T, N),
Lval = reg(T, N)
;
Lval0 = succip,
Lval = succip
;
Lval0 = maxfr,
Lval = maxfr
;
Lval0 = curfr,
Lval = curfr
;
Lval0 = hp,
Lval = hp
;
Lval0 = sp,
Lval = sp
;
Lval0 = temp(T, N),
Lval = temp(T, N)
;
Lval0 = stackvar(N),
Lval = stackvar(N)
;
Lval0 = framevar(N),
Lval = framevar(N)
;
Lval0 = succip(Rval0),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval0, Rval),
Lval = succip(Rval)
;
Lval0 = redoip(Rval0),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval0, Rval),
Lval = redoip(Rval)
;
Lval0 = redofr(Rval0),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval0, Rval),
Lval = redofr(Rval)
;
Lval0 = succfr(Rval0),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval0, Rval),
Lval = succfr(Rval)
;
Lval0 = prevfr(Rval0),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval0, Rval),
Lval = prevfr(Rval)
;
Lval0 = field(Tag, Rval1, Rval2),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval1, Rval3),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval2, Rval4),
Lval = field(Tag, Rval3, Rval4)
;
Lval0 = mem_ref(Rval0),
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval0, Rval),
Lval = mem_ref(Rval)
;
Lval0 = lvar(N),
Lval = lvar(N)
).
:- pred exprn_aux__substitute_lval_in_args(lval, lval,
list(maybe(rval)), list(maybe(rval))).
:- mode exprn_aux__substitute_lval_in_args(in, in, in, out) is det.
exprn_aux__substitute_lval_in_args(_OldLval, _NewLval, [], []).
exprn_aux__substitute_lval_in_args(OldLval, NewLval, [M0 | Ms0], [M | Ms]) :-
exprn_aux__substitute_lval_in_arg(OldLval, NewLval, M0, M),
exprn_aux__substitute_lval_in_args(OldLval, NewLval, Ms0, Ms).
:- pred exprn_aux__substitute_lval_in_arg(lval, lval,
maybe(rval), maybe(rval)).
:- mode exprn_aux__substitute_lval_in_arg(in, in, in, out) is det.
exprn_aux__substitute_lval_in_arg(OldLval, NewLval, M0, M) :-
(
M0 = yes(Rval0)
->
exprn_aux__substitute_lval_in_rval(OldLval, NewLval,
Rval0, Rval),
M = yes(Rval)
;
M = M0
).
exprn_aux__substitute_rval_in_rval(OldRval, NewRval, Rval0, Rval) :-
(
Rval0 = OldRval
->
Rval = NewRval
;
(
Rval0 = lval(Lval0),
exprn_aux__substitute_rval_in_lval(OldRval, NewRval,
Lval0, Lval),
Rval = lval(Lval)
;
Rval0 = var(_),
Rval = Rval0
;
Rval0 = create(Tag, Rvals0, ATs, StatDyn,
Num, Msg, Reuse0),
exprn_aux__substitute_rval_in_args(OldRval, NewRval,
Rvals0, Rvals),
exprn_aux__substitute_rval_in_arg(OldRval, NewRval,
Reuse0, Reuse),
Rval = create(Tag, Rvals, ATs, StatDyn,
Num, Msg, Reuse)
;
Rval0 = mkword(Tag, Rval1),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval1, Rval2),
Rval = mkword(Tag, Rval2)
;
Rval0 = const(_Const),
Rval = Rval0
;
Rval0 = unop(Unop, Rval1),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval1, Rval2),
Rval = unop(Unop, Rval2)
;
Rval0 = binop(Binop, Rval1, Rval2),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval1, Rval3),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval2, Rval4),
Rval = binop(Binop, Rval3, Rval4)
;
Rval0 = mem_addr(MemRef1),
exprn_aux__substitute_rval_in_mem_ref(OldRval, NewRval,
MemRef1, MemRef2),
Rval = mem_addr(MemRef2)
)
).
:- pred exprn_aux__substitute_rval_in_mem_ref(rval, rval, mem_ref, mem_ref).
:- mode exprn_aux__substitute_rval_in_mem_ref(in, in, in, out) is det.
exprn_aux__substitute_rval_in_mem_ref(OldRval, NewRval, MemRef0, MemRef) :-
(
MemRef0 = stackvar_ref(N),
MemRef = stackvar_ref(N)
;
MemRef0 = framevar_ref(N),
MemRef = framevar_ref(N)
;
MemRef0 = heap_ref(Rval0, Tag, N),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval0, Rval),
MemRef = heap_ref(Rval, Tag, N)
).
:- pred exprn_aux__substitute_rval_in_lval(rval, rval, lval, lval).
:- mode exprn_aux__substitute_rval_in_lval(in, in, in, out) is det.
exprn_aux__substitute_rval_in_lval(OldRval, NewRval, Lval0, Lval) :-
(
Lval0 = reg(T, N),
Lval = reg(T, N)
;
Lval0 = succip,
Lval = succip
;
Lval0 = maxfr,
Lval = maxfr
;
Lval0 = curfr,
Lval = curfr
;
Lval0 = hp,
Lval = hp
;
Lval0 = sp,
Lval = sp
;
Lval0 = temp(T, N),
Lval = temp(T, N)
;
Lval0 = stackvar(N),
Lval = stackvar(N)
;
Lval0 = framevar(N),
Lval = framevar(N)
;
Lval0 = succip(Rval0),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval0, Rval),
Lval = succip(Rval)
;
Lval0 = redoip(Rval0),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval0, Rval),
Lval = redoip(Rval)
;
Lval0 = redofr(Rval0),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval0, Rval),
Lval = redofr(Rval)
;
Lval0 = succfr(Rval0),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval0, Rval),
Lval = succfr(Rval)
;
Lval0 = prevfr(Rval0),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval0, Rval),
Lval = prevfr(Rval)
;
Lval0 = field(Tag, Rval1, Rval2),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval1, Rval3),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval2, Rval4),
Lval = field(Tag, Rval3, Rval4)
;
Lval0 = mem_ref(Rval0),
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval0, Rval),
Lval = mem_ref(Rval)
;
Lval0 = lvar(N),
Lval = lvar(N)
).
:- pred exprn_aux__substitute_rval_in_args(rval, rval,
list(maybe(rval)), list(maybe(rval))).
:- mode exprn_aux__substitute_rval_in_args(in, in, in, out) is det.
exprn_aux__substitute_rval_in_args(_OldRval, _NewRval, [], []).
exprn_aux__substitute_rval_in_args(OldRval, NewRval, [M0 | Ms0], [M | Ms]) :-
exprn_aux__substitute_rval_in_arg(OldRval, NewRval, M0, M),
exprn_aux__substitute_rval_in_args(OldRval, NewRval, Ms0, Ms).
:- pred exprn_aux__substitute_rval_in_arg(rval, rval,
maybe(rval), maybe(rval)).
:- mode exprn_aux__substitute_rval_in_arg(in, in, in, out) is det.
exprn_aux__substitute_rval_in_arg(OldRval, NewRval, M0, M) :-
(
M0 = yes(Rval0)
->
exprn_aux__substitute_rval_in_rval(OldRval, NewRval,
Rval0, Rval),
M = yes(Rval)
;
M = M0
).
%------------------------------------------------------------------------------%
exprn_aux__substitute_vars_in_rval([], Rval, Rval).
exprn_aux__substitute_vars_in_rval([Var - Sub | Rest], Rval0, Rval) :-
exprn_aux__substitute_rval_in_rval(var(Var), Sub, Rval0, Rval1),
exprn_aux__substitute_vars_in_rval(Rest, Rval1, Rval).
% When we substitute a one set of rvals for another, we face the problem
% that the substitution may not be idempotent. We finesse this problem by
% substituting unique new rvals for the original rvals, and then substituting
% the replacement rvals for these unique rvals. We guarantee the uniqueness
% of these rvals by using framevars with negative numbers for them.
exprn_aux__substitute_rvals_in_rval(RvalPairs, Rval0, Rval) :-
exprn_aux__substitute_rvals_in_rval_1(RvalPairs, 0,
RvalUniqPairs, UniqRvalPairs),
exprn_aux__substitute_rvals_in_rval_2(RvalUniqPairs, Rval0, Rval1),
exprn_aux__substitute_rvals_in_rval_2(UniqRvalPairs, Rval1, Rval).
:- pred exprn_aux__substitute_rvals_in_rval_1(assoc_list(rval, rval), int,
assoc_list(rval, rval), assoc_list(rval, rval)).
:- mode exprn_aux__substitute_rvals_in_rval_1(in, in, out, out) is det.
exprn_aux__substitute_rvals_in_rval_1([], _, [], []).
exprn_aux__substitute_rvals_in_rval_1([Rval1 - Rval2 | RvalPairList], N0,
[Rval1 - Uniq | RvalUniqList], [Uniq - Rval2 | UniqRvalList]) :-
N1 is N0 - 1,
Uniq = lval(framevar(N1)),
exprn_aux__substitute_rvals_in_rval_1(RvalPairList, N1,
RvalUniqList, UniqRvalList).
:- pred exprn_aux__substitute_rvals_in_rval_2(assoc_list(rval, rval),
rval, rval).
:- mode exprn_aux__substitute_rvals_in_rval_2(in, in, out) is det.
exprn_aux__substitute_rvals_in_rval_2([], Rval, Rval).
exprn_aux__substitute_rvals_in_rval_2([Left - Right | Rest], Rval0, Rval2) :-
exprn_aux__substitute_rval_in_rval(Left, Right, Rval0, Rval1),
exprn_aux__substitute_rvals_in_rval_2(Rest, Rval1, Rval2).
%---------------------------------------------------------------------------%
exprn_aux__simplify_rval(Rval0, Rval) :-
(
exprn_aux__simplify_rval_2(Rval0, Rval1)
->
exprn_aux__simplify_rval(Rval1, Rval)
;
Rval = Rval0
).
:- pred exprn_aux__simplify_rval_2(rval, rval).
:- mode exprn_aux__simplify_rval_2(in, out) is semidet.
exprn_aux__simplify_rval_2(Rval0, Rval) :-
(
Rval0 = lval(field(MaybeTag, Base, Field)),
Base = create(Tag, Args, _, _, _, _, _),
(
MaybeTag = yes(Tag)
;
MaybeTag = no
),
Field = const(int_const(FieldNum))
->
list__index0_det(Args, FieldNum, yes(Rval))
;
Rval0 = lval(field(MaybeTag, Rval1, Num)),
exprn_aux__simplify_rval_2(Rval1, Rval2)
->
Rval = lval(field(MaybeTag, Rval2, Num))
;
Rval0 = create(Tag, Args0, ArgTypes, StatDyn,
CNum, Msg, Reuse0),
exprn_aux__simplify_args(Args0, Args),
exprn_aux__simplify_arg(Reuse0, Reuse),
( Args \= Args0
; Reuse \= Reuse0
)
->
Rval = create(Tag, Args, ArgTypes, StatDyn, CNum, Msg, Reuse)
;
Rval0 = unop(UnOp, Rval1),
exprn_aux__simplify_rval_2(Rval1, Rval2)
->
Rval = unop(UnOp, Rval2)
;
Rval0 = binop(BinOp, Rval1, Rval2),
exprn_aux__simplify_rval_2(Rval1, Rval3)
->
Rval = binop(BinOp, Rval3, Rval2)
;
Rval0 = binop(BinOp, Rval1, Rval2),
exprn_aux__simplify_rval_2(Rval2, Rval3)
->
Rval = binop(BinOp, Rval1, Rval3)
;
fail
).
:- pred exprn_aux__simplify_args(list(maybe(rval)), list(maybe(rval))).
:- mode exprn_aux__simplify_args(in, out) is det.
exprn_aux__simplify_args([], []).
exprn_aux__simplify_args([MR0 | Ms0], [MR | Ms]) :-
exprn_aux__simplify_args(Ms0, Ms),
exprn_aux__simplify_arg(MR0, MR).
:- pred exprn_aux__simplify_arg(maybe(rval), maybe(rval)).
:- mode exprn_aux__simplify_arg(in, out) is det.
exprn_aux__simplify_arg(MR0, MR) :-
(
MR0 = yes(Rval0),
exprn_aux__simplify_rval_2(Rval0, Rval)
->
MR = yes(Rval)
;
MR = MR0
).
%-----------------------------------------------------------------------------%
% give an rval, return a list of the code and data addresses
% that are referenced by that rval
exprn_aux__rval_addrs(lval(Lval), CodeAddrs, DataAddrs) :-
exprn_aux__lval_addrs(Lval, CodeAddrs, DataAddrs).
exprn_aux__rval_addrs(var(_), [], []).
exprn_aux__rval_addrs(create(_, MaybeRvals, _,_,_,_, Reuse),
CodeAddrs, DataAddrs) :-
exprn_aux__maybe_rval_list_addrs([Reuse | MaybeRvals],
CodeAddrs, DataAddrs).
exprn_aux__rval_addrs(mkword(_Tag, Rval), CodeAddrs, DataAddrs) :-
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
exprn_aux__rval_addrs(const(Const), CodeAddrs, DataAddrs) :-
( Const = code_addr_const(CodeAddress) ->
CodeAddrs = [CodeAddress],
DataAddrs = []
; Const = data_addr_const(DataAddress) ->
CodeAddrs = [],
DataAddrs = [DataAddress]
;
CodeAddrs = [],
DataAddrs = []
).
exprn_aux__rval_addrs(unop(_, Rval), CodeAddrs, DataAddrs) :-
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
exprn_aux__rval_addrs(binop(_, Rval1, Rval2), CodeAddrs, DataAddrs) :-
exprn_aux__rval_addrs(Rval1, CodeAddrs1, DataAddrs1),
exprn_aux__rval_addrs(Rval2, CodeAddrs2, DataAddrs2),
list__append(CodeAddrs1, CodeAddrs2, CodeAddrs),
list__append(DataAddrs1, DataAddrs2, DataAddrs).
exprn_aux__rval_addrs(mem_addr(Rval), CodeAddrs, DataAddrs) :-
exprn_aux__mem_ref_addrs(Rval, CodeAddrs, DataAddrs).
% give an lval, return a list of the code and data addresses
% that are referenced by that lval
exprn_aux__lval_addrs(reg(_, _), [], []).
exprn_aux__lval_addrs(stackvar(_Int), [], []).
exprn_aux__lval_addrs(framevar(_Int), [], []).
exprn_aux__lval_addrs(succip, [], []).
exprn_aux__lval_addrs(maxfr, [], []).
exprn_aux__lval_addrs(curfr, [], []).
exprn_aux__lval_addrs(prevfr(Rval), CodeAddrs, DataAddrs) :-
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
exprn_aux__lval_addrs(succfr(Rval), CodeAddrs, DataAddrs) :-
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
exprn_aux__lval_addrs(redofr(Rval), CodeAddrs, DataAddrs) :-
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
exprn_aux__lval_addrs(redoip(Rval), CodeAddrs, DataAddrs) :-
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
exprn_aux__lval_addrs(succip(Rval), CodeAddrs, DataAddrs) :-
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
exprn_aux__lval_addrs(hp, [], []).
exprn_aux__lval_addrs(sp, [], []).
exprn_aux__lval_addrs(field(_Tag, Rval1, Rval2), CodeAddrs, DataAddrs) :-
exprn_aux__rval_addrs(Rval1, CodeAddrs1, DataAddrs1),
exprn_aux__rval_addrs(Rval2, CodeAddrs2, DataAddrs2),
list__append(CodeAddrs1, CodeAddrs2, CodeAddrs),
list__append(DataAddrs1, DataAddrs2, DataAddrs).
exprn_aux__lval_addrs(lvar(_Var), [], []).
exprn_aux__lval_addrs(temp(_, _), [], []).
exprn_aux__lval_addrs(mem_ref(Rval), CodeAddrs, DataAddrs) :-
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
% give a list of rvals, return a list of the code and data addresses
% that are referenced by those rvals
exprn_aux__rval_list_addrs([], [], []).
exprn_aux__rval_list_addrs([Rval | Rvals], CodeAddrs, DataAddrs) :-
exprn_aux__rval_addrs(Rval, CodeAddrs0, DataAddrs0),
exprn_aux__rval_list_addrs(Rvals, CodeAddrs1, DataAddrs1),
list__append(CodeAddrs0, CodeAddrs1, CodeAddrs),
list__append(DataAddrs0, DataAddrs1, DataAddrs).
% give a list of lvals, return a list of the code and data addresses
% that are referenced by those lvals
exprn_aux__lval_list_addrs([], [], []).
exprn_aux__lval_list_addrs([Lval | Lvals], CodeAddrs, DataAddrs) :-
exprn_aux__lval_addrs(Lval, CodeAddrs0, DataAddrs0),
exprn_aux__lval_list_addrs(Lvals, CodeAddrs1, DataAddrs1),
list__append(CodeAddrs0, CodeAddrs1, CodeAddrs),
list__append(DataAddrs0, DataAddrs1, DataAddrs).
:- pred exprn_aux__mem_ref_addrs(mem_ref, list(code_addr), list(data_addr)).
:- mode exprn_aux__mem_ref_addrs(in, out, out) is det.
exprn_aux__mem_ref_addrs(stackvar_ref(_), [], []).
exprn_aux__mem_ref_addrs(framevar_ref(_), [], []).
exprn_aux__mem_ref_addrs(heap_ref(Rval, _, _), CodeAddrs, DataAddrs) :-
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
% give a list of maybe(rval), return a list of the code and data
% addresses that are reference by that list
exprn_aux__maybe_rval_list_addrs([], [], []).
exprn_aux__maybe_rval_list_addrs([MaybeRval | MaybeRvals],
CodeAddrs, DataAddrs) :-
( MaybeRval = yes(Rval) ->
exprn_aux__rval_addrs(Rval, CodeAddrs0, DataAddrs0),
exprn_aux__maybe_rval_list_addrs(MaybeRvals,
CodeAddrs1, DataAddrs1),
list__append(CodeAddrs0, CodeAddrs1, CodeAddrs),
list__append(DataAddrs0, DataAddrs1, DataAddrs)
;
exprn_aux__maybe_rval_list_addrs(MaybeRvals,
CodeAddrs, DataAddrs)
).
exprn_aux__var_lval_to_rval(_, Lval) = lval(Lval).
exprn_aux__lval_to_rval(Lval) = lval(Lval).
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%