mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2025-12-15 05:44:58 +00:00
Code Issues Projects Releases Wiki Activity
Files
c5a69daae35aacf16d477f902970da15806d1ec4
mercury/compiler/exprn_aux.m
Simon Taylor 18430aaef1 Aditi compilation. 
Estimated hours taken: 1200

Aditi compilation.

compiler/options.m:
	The documentation for these is commented out because the Aditi
	system is not currently useful to the general public.
	--aditi: enable Aditi compilation.
	--dump-rl: write the intermediate RL to `<module>.rl_dump'.
	--dump-rl-bytecode: write a text version of the bytecodes
		to `<module>.rla'
	--aditi-only: don't produce a `.c' file.
	--filenames-from-stdin: accept a list of filenames to compile
		from stdin. This is used by the query shell.
	--optimize-rl, --optimize-rl-cse, --optimize-rl-invariants,
	--optimize-rl-index, --detect-rl-streams:
		Options to control RL optimization passes.
	--aditi-user:
		Default owner of any Aditi procedures,
		defaults to $USER or "guest".
	--generate-schemas:
		write schemas for base relations to `<module>'.base_schema
		and schemas for derived relations to `<module>'.derived_schema.
		This is used by the query shell.

compiler/handle_options.m:
	Handle the default for --aditi-user.

compiler/hlds_pred.m:
compiler/prog_data.m:
compiler/prog_io_pragma.m:
compiler/make_hlds.m:
	Add some Aditi pragma declarations - `aditi', `supp_magic', `context',
	`naive', `psn' (predicate semi-naive), `aditi_memo', `aditi_no_memo',
	`base_relation', `owner' and `index'.
	Separate out code to parse a predicate name and arity.

compiler/hlds_pred.m:
	Add predicates to identify Aditi procedures.
	Added markers `generate_inline' and `aditi_interface', which
	are used internally for Aditi code generation.
	Add an `owner' field to pred_infos, which is used for database
	security checks.
	Add a field to pred_infos to hold the list of indexes for a base
	relation.

compiler/make_hlds.m:
	Some pragmas must be exported if the corresponding predicates
	are exported, check this.
	Make sure stratification of Aditi procedures is checked.
	Predicates with a mode declaration but no type declaration
	are no longer assumed to be local.
	Set the `do_aditi_compilation' field of the module_info if there
	are any local Aditi procedures or base relations.
	Check that `--aditi' is set if Aditi compilation is required.

compiler/post_typecheck.m:
	Check that every Aditi predicate has an `aditi__state' argument,
	which is used to ensure sequencing of updates and that Aditi
	procedures are only called within transactions.

compiler/dnf.m:
	Changed the definition of disjunctive normal form slightly
	so that a call followed by some atomic goals not including
	any database calls is considered atomic. magic.m can handle
	this kind of goal, and it results in more efficient RL code.

compiler/hlds_module.m:
compiler/dependency_graph.m:
	Added dependency_graph__get_scc_entry_points which finds
	the procedures in an SCC which could be called from outside.
	Added a new field to the dependency_info, the
	aditi_dependency_ordering. This contains all Aditi SCCs of
	the original program, with multiple SCCs merged where
	possible to improve the effectiveness of differential evaluation
	and the low level RL optimizations.

compiler/hlds_module.m:
	Add a field to record whether there are any local Aditi procedures
	in the current module.
	Added versions of module_info_pred_proc_info and
	module_info_set_pred_proc_info which take a pred_proc_id,
	not a separate pred_id and proc_id.

compiler/polymorphism.m:
compiler/lambda.m:
	Make sure that predicates created for closures in Aditi procedures
	have the correct markers.

compiler/goal_util.m:
	Added goal_util__switch_to_disjunction,
	goal_util__case_to_disjunct (factored out from simplify.m)
	and goal_util__if_then_else_to_disjunction. These are
	require because supplementary magic sets can't handle
	if-then-elses or switches.

compiler/type_util.m:
	Added type_is_aditi_state/1.

compiler/mode_util.m:
	Added partition_args/5 which partitions a list of arguments
	into inputs and others.

compiler/inlining.m:
	Don't inline memoed procedures.
	Don't inline Aditi procedures into non-Aditi procedures.

compiler/intermod.m:
	Handle Aditi markers.
	Clean up handling of markers which should not appear in `.opt' files.

compiler/simplify.m:
	Export a slightly different interface for use by magic.m.
	Remove explicit quantifications where possible.
	Merge multiple nested quantifications.
	Don't report infinite recursion warnings for Aditi procedures.

compiler/prog_out.m:
	Generalised the code to output a module list to write any list.

compiler/code_gen.m:
compiler/arg_info.m:
	Don't process Aditi procedures.

compiler/mercury_compile.m:
	Call magic.m and rl_gen.m.
	Don't perform the low-level annotation passes on Aditi procedures.
	Remove calls to constraint.m - sometime soon a rewritten version
	will be called directly from deforestation.

compiler/passes_aux.m:
	Add predicates to process only non-Aditi procedures.

compiler/llds.m:
compiler/llds_out.m:
	Added new `code_addr' enum members, do_{det,semidet,nondet}_aditi_call,
	which are defined in extras/aditi/aditi.m.

compiler/call_gen.m:
	Handle generation of do_*_aditi_call.

compiler/llds_out.m:
	Write the RL code for the module as a constant char array
	in the `.c' file.

compiler/term_errors.m:
compiler/error_util.m:
	Move code to describe predicates into error_util.m
	Allow the caller to explicitly add line breaks.
	Added error_util:list_to_pieces to format a list of
	strings.
	Reordered some arguments for currying.

compiler/hlds_out.m:
	Don't try to print clauses if there are none.

runtime/mercury_init.h:
util/mkinit.c:
scripts/c2init.in:
	Added a function `mercury__load_aditi_rl_code()' to the generated
	`<module>_init.c' file which throws all the RL code for the program
	at the database. This should be called at connection time by
	`aditi__connect'.
	Added an option `--aditi' which controls the output
	`mercury__load_aditi_rl_code()'.

compiler/notes/compiler_design.html:
	Document the new files.

Mmakefile:
bindist/Mmakefile:
	Don't distribute extras/aditi yet.

New files:

compiler/magic.m:
compiler/magic_util.m:
	Supplementary magic sets transformation. Report errors
	for constructs that Aditi can't handle.

compiler/context.m:
	Supplementary context transformation.

compiler/rl_gen.m:
compiler/rl_relops.m:
	Aditi code generation.

compiler/rl_info.m:
	Code generator state.

compiler/rl.m:
	Intermediate RL representation.

compiler/rl_util:
	Predicates to collect information about RL instructions.

compiler/rl_dump.m:
	Print out the representation in rl.m.

compiler/rl_opt.m:
	Control low-level RL optimizations.

compiler/rl_block.m:
	Break a procedure into basic blocks.

compiler/rl_analyse.m:
	Generic dataflow analysis for RL procedures.

compiler/rl_liveness.m:
	Make sure all relations are initialised before used, clear
	references to relations that are no longer required.

compiler/rl_loop.m:
	Loop invariant removal.

compiler/rl_block_opt.m:
	CSE and instruction merging on basic blocks.

compiler/rl_key.m:
	Detect upper/lower bounds for which a goal could succeed.

compiler/rl_sort.m:
	Use indexing for joins and projections.
	Optimize away unnecessary sorting and indexing.

compiler/rl_stream.m:
	Detect relations which don't need to be materialised.

compiler/rl_code.m:
	RL bytecode definitions. Automatically generated from the Aditi
	header files.

compiler/rl_out.m:
compiler/rl_file.m:
	Output the RL bytecodes in binary to <module>.rlo (for use by Aditi)
	and in text to <module>.rla (for use by the RL interpreter).
	Also output the schema information if --generate-schemas is set.

compiler/rl_exprn.m:
	Generate bytecodes for join conditions.

extras/aditi/Mmakefile:
extras/aditi/aditi.m:
	Definitions of some Aditi library predicates and the
	interfacing and transaction processing code.
1998-12-06 23:49:14 +00:00

903 lines
28 KiB
Mathematica
Raw Blame History

%-----------------------------------------------------------------------------%
% Copyright (C) 1995-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.
%------------------------------------------------------------------------------%
:- 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_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.
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
:- 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(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, _, 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).
exprn_aux__addr_is_constant(do_det_class_method, _, no).
exprn_aux__addr_is_constant(do_semidet_class_method, _, no).
exprn_aux__addr_is_constant(do_nondet_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_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, _, _, _), 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_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, Unique, Num, Msg),
exprn_aux__substitute_lval_in_args(OldLval, NewLval,
Rvals0, Rvals),
Rval = create(Tag, Rvals, Unique, Num, Msg)
;
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)
).
:- 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
;
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]) :-
(
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, Msg),
exprn_aux__substitute_rval_in_args(OldRval, NewRval,
Rvals0, Rvals),
Rval = create(Tag, Rvals, Unique, Num, Msg)
;
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]) :-
(
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(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, Unique, CNum, Msg),
exprn_aux__simplify_args(Args0, Args),
Args \= Args0
->
Rval = create(Tag, Args, Unique, CNum, Msg)
;
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),
(
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(_, 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)
).
%------------------------------------------------------------------------------%
%------------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink