mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-19 15:54:18 +00:00
8e4e537a38
Estimated hours taken: 3
These changes have 2 parts:
* Fix a bug in unify_gen triggered by zoltans fix to a
bug triggered by dmo's graphics project and add a test
case for it.
* Fix a couple of small bugs in the testing procedures where
they required you to have . in your path.
mercury/compiler/code_exprn.m,
mercury/compiler/code_info.m:
add the predicate
code_{exprn,info}__materialize_vars_in_rval/5
which generates code to materialize the vars in an rval and
updates the exprn info appropriately.
This predicate was added because it is needed for generating
the sub-unifications where a deconstruction has assignments
into the term (ie field(....) = var; rather than the other
way around).
mercury/compiler/exprn_aux.m:
export exprn_aux__vars_in_rval.
mercury/compiler/follow_vars.m:
fix a singleton variable warning.
mercury/compiler/unify_gen.m:
When generating code to assign into the fields of a term
within a deconstruction, materialize any variables in the
the field expression (into which you are going to assign)
before doing the assignment. Before this fix, the code generator
was emitting code that contained var(M), which with certain
combinations of opt flags was causing an abort in llds_out.
tests/runtests:
tiny bugfix so that runtests works for people who don't have `.'
in their path.
tests/valid/Mmake:
enable `two_way_unif' which tests the bugfix in unify_gen shown above
mercury/tools/bootcheck:
tiny bugfix so that runtests works for people who don't have `.'
in their path.
685 lines
22 KiB
Mathematica
685 lines
22 KiB
Mathematica
%-----------------------------------------------------------------------------%
|
|
% Copyright (C) 1995 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.
|
|
:- 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_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(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(var)).
|
|
:- mode exprn_aux__vars_in_lval(in, out) is det.
|
|
|
|
:- pred exprn_aux__vars_in_rval(rval, list(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.
|
|
|
|
%------------------------------------------------------------------------------%
|
|
%------------------------------------------------------------------------------%
|
|
|
|
:- 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 cannot be considered constants because
|
|
% gcc doesn't allow type punning from float to word in
|
|
% static initializers.
|
|
%
|
|
IsConst = no
|
|
;
|
|
%
|
|
% 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(code_addr_const(CodeAddr), ExprnOpts, IsConst) :-
|
|
exprn_aux__addr_is_constant(CodeAddr, ExprnOpts, IsConst).
|
|
exprn_aux__const_is_constant(data_addr_const(_), _, yes).
|
|
|
|
:- 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_det_closure, _, no).
|
|
exprn_aux__addr_is_constant(do_semidet_closure, _, no).
|
|
exprn_aux__addr_is_constant(do_nondet_closure, _, 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, _, _), Lval) :-
|
|
exprn_aux__args_contain_lval(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, _, _),
|
|
exprn_aux__args_contain_rval(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, _, _), Vars) :-
|
|
exprn_aux__vars_in_args(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_lval(Lval, Vars) :-
|
|
(
|
|
Lval = lvar(Var)
|
|
->
|
|
Vars = [Var]
|
|
;
|
|
Lval = field(_, Rval0, Rval1)
|
|
->
|
|
exprn_aux__vars_in_rval(Rval0, Vars0),
|
|
exprn_aux__vars_in_rval(Rval1, Vars1),
|
|
list__append(Vars0, Vars1, Vars)
|
|
;
|
|
Vars = []
|
|
).
|
|
|
|
:- pred exprn_aux__vars_in_args(list(maybe(rval)), list(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, Unique, Num),
|
|
exprn_aux__substitute_lval_in_args(OldLval, NewLval,
|
|
Rvals0, Rvals),
|
|
Rval = create(Tag, Rvals, Unique, Num)
|
|
;
|
|
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)
|
|
).
|
|
|
|
:- pred exprn_aux__substitute_lval_in_lval(lval, lval, lval, lval).
|
|
:- mode exprn_aux__substitute_lval_in_lval(in, in, in, out) is det.
|
|
|
|
exprn_aux__substitute_lval_in_lval(OldLval, NewLval, Lval0, Lval) :-
|
|
(
|
|
Lval0 = OldLval
|
|
->
|
|
Lval = NewLval
|
|
;
|
|
Lval0 = field(Tag, Rval0, Rval1)
|
|
->
|
|
exprn_aux__substitute_lval_in_rval(OldLval, NewLval, Rval0,
|
|
Rval2),
|
|
exprn_aux__substitute_lval_in_rval(OldLval, NewLval, Rval1,
|
|
Rval3),
|
|
Lval = field(Tag, Rval2, Rval3)
|
|
;
|
|
Lval = Lval0
|
|
).
|
|
|
|
:- 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]) :-
|
|
(
|
|
M0 = yes(Rval0)
|
|
->
|
|
exprn_aux__substitute_lval_in_rval(OldLval, NewLval, Rval0,
|
|
Rval),
|
|
M = yes(Rval)
|
|
;
|
|
M = M0
|
|
),
|
|
exprn_aux__substitute_lval_in_args(OldLval, NewLval, Ms0, Ms).
|
|
|
|
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, Unique, Num),
|
|
exprn_aux__substitute_rval_in_args(OldRval, NewRval,
|
|
Rvals0, Rvals),
|
|
Rval = create(Tag, Rvals, Unique, Num)
|
|
;
|
|
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)
|
|
)
|
|
).
|
|
|
|
:- 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 = field(Tag, Rval0, Rval1)
|
|
->
|
|
exprn_aux__substitute_rval_in_rval(OldRval, NewRval, Rval0,
|
|
Rval2),
|
|
exprn_aux__substitute_rval_in_rval(OldRval, NewRval, Rval1,
|
|
Rval3),
|
|
Lval = field(Tag, Rval2, Rval3)
|
|
;
|
|
Lval = Lval0
|
|
).
|
|
|
|
:- 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]) :-
|
|
(
|
|
M0 = yes(Rval0)
|
|
->
|
|
exprn_aux__substitute_rval_in_rval(OldRval, NewRval, Rval0,
|
|
Rval),
|
|
M = yes(Rval)
|
|
;
|
|
M = M0
|
|
),
|
|
exprn_aux__substitute_rval_in_args(OldRval, NewRval, Ms0, Ms).
|
|
|
|
%------------------------------------------------------------------------------%
|
|
|
|
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(Tag, create(Tag, Args, _, _), Field)),
|
|
Field = const(int_const(FieldNum))
|
|
->
|
|
list__index0_det(Args, FieldNum, yes(Rval))
|
|
;
|
|
Rval0 = lval(field(Tag, Rval1, Num)),
|
|
exprn_aux__simplify_rval_2(Rval1, Rval2)
|
|
->
|
|
Rval = lval(field(Tag, Rval2, Num))
|
|
;
|
|
Rval0 = create(Tag, Args0, Unique, CNum),
|
|
exprn_aux__simplify_args(Args0, Args),
|
|
Args \= Args0
|
|
->
|
|
Rval = create(Tag, Args, Unique, CNum)
|
|
;
|
|
Rval0 = unop(UOp, Rval1),
|
|
exprn_aux__simplify_rval_2(Rval1, Rval2)
|
|
->
|
|
Rval = unop(UOp, Rval2)
|
|
;
|
|
Rval0 = binop(BOp, Rval1, Rval2),
|
|
exprn_aux__simplify_rval_2(Rval1, Rval3)
|
|
->
|
|
Rval = binop(BOp, Rval3, Rval2)
|
|
;
|
|
Rval0 = binop(BOp, Rval1, Rval2),
|
|
exprn_aux__simplify_rval_2(Rval2, Rval3)
|
|
->
|
|
Rval = binop(BOp, 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),
|
|
(
|
|
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, _, _), CodeAddrs, DataAddrs) :-
|
|
exprn_aux__maybe_rval_list_addrs(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(_Op, Rval), CodeAddrs, DataAddrs) :-
|
|
exprn_aux__rval_addrs(Rval, CodeAddrs, DataAddrs).
|
|
exprn_aux__rval_addrs(binop(_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).
|
|
|
|
% give an lval, return a list of the code and data addresses
|
|
% that are referenced by that lval
|
|
|
|
exprn_aux__lval_addrs(reg(_Int), [], []).
|
|
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(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(_Int), [], []).
|
|
|
|
% 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).
|
|
|
|
% 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)
|
|
).
|
|
|
|
%------------------------------------------------------------------------------%
|
|
%------------------------------------------------------------------------------%
|