for review: constant propagation
Thomas Charles CONWAY
conway at cs.mu.oz.au
Fri Aug 22 13:00:57 AEST 1997
Hi
For review - a change to the compiler that adds constant propagation.
I've been using this change for some time on hydra, and its impact on
compile time isn't noticable, and for some programs, it can lead to
a healthy speed increase.
--
ZZ:wq!
^X^C
Thomas Conway conway at cs.mu.oz.au
AD DEUM ET VINUM Every sword has two edges.
Add constant propagation within modules. This occurs during simplification
and simply attempts to evaluate "known" calls that have all their inputs
bound to constants and replaces the call with constructions of the outputs.
Currently the "known" calls are (most) of the arithmetic predicates, and
the comparison of ints and floats.
compiler/instmap.m:
add merge_instmap_deltas which merges a list of intmap deltas
rather than just two of them.
compiler/mercury_compile.m:
compiler/options.m:
add (and use) the option --optimize-constant-propagation
compiler/simplify.m:
add a bool to the simplify struct to turn on/off constant
propagation.
in the simplification of calls, check to see if all the inputs
are bound to constants. If we know how to evaluate this call
at compile time, then do so. This may change the instmap delta.
For branched goals, we merge the instmap deltas to recompute the
instmap delta for the goal as a whole so that we know when every
branch binds a variable to the same constant.
compiler/notes/compiler_design.html:
mention constant propagation.
doc/user_guide.texi:
mention constant propagation.
compiler/const_prop.m:
code that attempts to evaluate calls at compile time.
It contains tables of calls that we know how to evaluate.
cvs diff: Diffing .
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/instmap.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/instmap.m,v
retrieving revision 1.14
diff -u -r1.14 instmap.m
--- instmap.m 1997/08/21 07:29:06 1.14
+++ instmap.m 1997/08/21 22:00:28
@@ -220,6 +220,15 @@
instmap_delta, module_info, module_info).
:- mode merge_instmap_delta(in, in, in, in, out, in, out) is det.
+ % merge_instmap_deltas(Vars, InstMapDeltas,
+ % MergedInstMapDelta, ModuleInfo0, ModuleInfo)
+ % takes a list of instmap deltas from the branches of an if-then-else,
+ % switch, or disj and merges them. This is used in situations
+ % where the bindings are known to be compatible.
+:- pred merge_instmap_deltas(instmap, set(var), list(instmap_delta),
+ instmap_delta, module_info, module_info).
+:- mode merge_instmap_deltas(in, in, in, out, in, out) is det.
+
%-----------------------------------------------------------------------------%
% `instmap_delta_apply_sub(InstmapDelta0, Must, Sub, InstmapDelta)'
@@ -597,6 +606,32 @@
ModuleInfo = ModuleInfo1,
Inst = not_reached
).
+
+%-----------------------------------------------------------------------------%
+
+merge_instmap_deltas(InstMap, NonLocals, InstMapDeltaList, MergedDelta,
+ ModuleInfo0, ModuleInfo) :-
+ (
+ InstMapDeltaList = [],
+ error("merge_instmap_deltas: empty instmap_delta list.")
+ ;
+ InstMapDeltaList = [Delta|Deltas],
+ merge_instmap_deltas(InstMap, NonLocals, Delta, Deltas,
+ MergedDelta, ModuleInfo0, ModuleInfo)
+ ).
+
+:- pred merge_instmap_deltas(instmap, set(var), instmap_delta,
+ list(instmap_delta), instmap_delta, module_info, module_info).
+:- mode merge_instmap_deltas(in, in, in, in, out, in, out) is det.
+
+merge_instmap_deltas(_InstMap, _NonLocals, MergedDelta, [], MergedDelta,
+ ModuleInfo, ModuleInfo).
+merge_instmap_deltas(InstMap, NonLocals, MergedDelta0, [Delta|Deltas],
+ MergedDelta, ModuleInfo0, ModuleInfo) :-
+ merge_instmap_delta(InstMap, NonLocals, MergedDelta0, Delta,
+ MergedDelta1, ModuleInfo0, ModuleInfo1),
+ merge_instmap_deltas(InstMap, NonLocals, MergedDelta1, Deltas,
+ MergedDelta, ModuleInfo1, ModuleInfo).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: compiler/mercury_compile.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/mercury_compile.m,v
retrieving revision 1.51
diff -u -r1.51 mercury_compile.m
--- mercury_compile.m 1997/07/29 01:03:38 1.51
+++ mercury_compile.m 1997/08/04 02:15:39
@@ -791,7 +791,9 @@
globals__io_lookup_bool_option(excess_assign, ExcessAssign),
globals__io_lookup_bool_option(common_struct, Common),
globals__io_lookup_bool_option(optimize_duplicate_calls, Calls),
- simplify__proc(simplify(no, no, yes, yes, Common, ExcessAssign, Calls),
+ globals__io_lookup_bool_option(constant_propagation, Prop),
+ simplify__proc(
+ simplify(no, no, yes, yes, Common, ExcessAssign, Calls, Prop),
PredId, ProcId, ModuleInfo1, ModuleInfo2,
ProcInfo1, ProcInfo2, _, _),
globals__io_lookup_bool_option(optimize_saved_vars, SavedVars),
@@ -968,6 +970,7 @@
globals__io_lookup_bool_option(common_struct, Common),
globals__io_lookup_bool_option(excess_assign, Excess),
globals__io_lookup_bool_option(optimize_duplicate_calls, Calls),
+ globals__io_lookup_bool_option(constant_propagation, Prop),
( { Warn = yes } ->
globals__io_lookup_bool_option(warn_duplicate_calls,
WarnCalls)
@@ -975,7 +978,7 @@
{ WarnCalls = no }
),
{ Simplify = simplify(Warn, WarnCalls, Once,
- yes, Common, Excess, Calls) },
+ yes, Common, Excess, Calls, Prop) },
process_all_nonimported_procs(
update_proc_error(simplify__proc(Simplify)),
HLDS0, HLDS),
Index: compiler/options.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/options.m,v
retrieving revision 1.201
diff -u -r1.201 options.m
--- options.m 1997/07/27 15:01:18 1.201
+++ options.m 1997/08/06 01:08:42
@@ -164,6 +164,7 @@
; optimize_higher_order
; optimize_constructor_last_call
; optimize_duplicate_calls
+ ; constant_propagation
; excess_assign
; optimize_saved_vars
; follow_code
@@ -411,6 +412,7 @@
% it affects the semantics
constraint_propagation - bool(no),
optimize_duplicate_calls - bool(no),
+ constant_propagation - bool(no),
excess_assign - bool(no),
optimize_saved_vars - bool(no),
prev_code - bool(no),
@@ -659,6 +661,8 @@
long_option("excess-assign", excess_assign).
long_option("optimize-duplicate-calls", optimize_duplicate_calls).
long_option("optimise-duplicate-calls", optimize_duplicate_calls).
+long_option("optimise-constant-propagation", constant_propagation).
+long_option("optimize-constant-propagation", constant_propagation).
long_option("optimize-saved-vars", optimize_saved_vars).
long_option("optimise-saved-vars", optimize_saved_vars).
long_option("prev-code", prev_code).
@@ -919,6 +923,7 @@
optimize_saved_vars - bool(yes),
optimize_unused_args - bool(yes),
optimize_higher_order - bool(yes),
+ constant_propagation - bool(yes),
optimize_repeat - int(4)
]).
Index: compiler/simplify.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/simplify.m,v
retrieving revision 1.44
diff -u -r1.44 simplify.m
--- simplify.m 1997/08/09 01:49:39 1.44
+++ simplify.m 1997/08/11 23:33:00
@@ -52,7 +52,8 @@
bool, % attempt to merge adjacent switches
bool, % common subexpression elimination
bool, % remove excess assignment unifications
- bool % optimize duplicate calls
+ bool, % optimize duplicate calls
+ bool % partially evaluate calls
).
%-----------------------------------------------------------------------------%
@@ -61,7 +62,7 @@
:- import_module hlds_out.
-:- import_module code_aux, det_analysis, follow_code, goal_util.
+:- import_module code_aux, det_analysis, follow_code, goal_util, const_prop.
:- import_module hlds_module, hlds_goal, hlds_data, (inst), inst_match.
:- import_module globals, options, passes_aux, prog_data, mode_util, type_util.
:- import_module code_util, quantification, modes.
@@ -80,20 +81,21 @@
VarSet0, VarTypes0, Info0),
write_pred_progress_message("% Simplifying ", PredId, ModuleInfo0,
State1, State2),
- Simplify = simplify(Warn, WarnCalls, Once, Switch, _, Excess, Calls),
+ Simplify = simplify(Warn, WarnCalls, Once, Switch, _,
+ Excess, Calls, Prop),
( simplify_do_common(Info0) ->
% On the first pass do common structure elimination and
% branch merging.
simplify_info_set_simplify(Info0,
- simplify(Warn, WarnCalls, no, Switch, yes, no, Calls),
- Info1),
+ simplify(Warn, WarnCalls, no, Switch, yes, no,
+ Calls, Prop), Info1),
simplify__proc_2(Proc0, Proc1, Info1, Info2, State2, State3),
simplify_info_get_msgs(Info2, Msgs1),
simplify_info_get_det_info(Info2, DetInfo1),
proc_info_variables(Proc1, VarSet1),
proc_info_vartypes(Proc1, VarTypes1),
simplify_info_init(DetInfo1,
- simplify(no, no, Once, no, no, Excess, no),
+ simplify(no, no, Once, no, no, Excess, no, Prop),
InstMap0, VarSet1, VarTypes1, Info3),
simplify_info_set_msgs(Info3, Msgs1, Info4),
%simplify_info_get_module_info(Info4, ModuleInfo1),
@@ -300,9 +302,10 @@
GoalInfo = GoalInfo0
)
;
+ simplify_info_get_instmap(Info0, InstMap0),
simplify__disj(Disjuncts0, Disjuncts, [], InstMaps,
Info0, Info0, Info1),
- simplify_info_create_branch_info(Info0, Info1, InstMaps, Info),
+ simplify_info_create_branch_info(Info0, Info1, InstMaps, Info2),
(
/****
XXX This optimization is not correct, see comment below
@@ -327,16 +330,22 @@
;
****/
Goal = disj(Disjuncts, SM),
- GoalInfo = GoalInfo0
+ simplify_info_get_module_info(Info2, ModuleInfo1),
+ goal_info_get_nonlocals(GoalInfo0, NonLocals),
+ merge_instmap_deltas(InstMap0, NonLocals, InstMaps,
+ NewDelta, ModuleInfo1, ModuleInfo2),
+ simplify_info_set_module_info(Info2, ModuleInfo2, Info),
+ goal_info_set_instmap_delta(GoalInfo0, NewDelta,
+ GoalInfo)
)
).
simplify__goal_2(switch(Var, SwitchCanFail, Cases0, SM),
GoalInfo0, Goal, GoalInfo, Info0, Info) :-
simplify_info_get_instmap(Info0, InstMap0),
- simplify_info_get_module_info(Info0, ModuleInfo),
+ simplify_info_get_module_info(Info0, ModuleInfo0),
instmap__lookup_var(InstMap0, Var, VarInst),
- ( inst_is_bound_to_functors(ModuleInfo, VarInst, Functors) ->
+ ( inst_is_bound_to_functors(ModuleInfo0, VarInst, Functors) ->
functors_to_cons_ids(Functors, ConsIds0),
list__sort(ConsIds0, ConsIds),
delete_unreachable_cases(Cases0, ConsIds, Cases1),
@@ -383,11 +392,16 @@
),
simplify__goal(Goal1, Goal - GoalInfo, Info2, Info)
;
- GoalInfo = GoalInfo0,
simplify__switch(Var, Cases1, Cases, [], InstMaps,
Info0, Info0, Info1),
- simplify_info_create_branch_info(Info0, Info1, InstMaps, Info),
- Goal = switch(Var, SwitchCanFail, Cases, SM)
+ simplify_info_create_branch_info(Info0, Info1, InstMaps, Info2),
+ Goal = switch(Var, SwitchCanFail, Cases, SM),
+ simplify_info_get_module_info(Info2, ModuleInfo1),
+ goal_info_get_nonlocals(GoalInfo0, NonLocals),
+ merge_instmap_deltas(InstMap0, NonLocals, InstMaps, NewDelta,
+ ModuleInfo1, ModuleInfo2),
+ simplify_info_set_module_info(Info2, ModuleInfo2, Info),
+ goal_info_set_instmap_delta(GoalInfo0, NewDelta, GoalInfo)
).
simplify__goal_2(Goal0, GoalInfo, Goal, GoalInfo, Info0, Info) :-
@@ -406,7 +420,7 @@
Info = Info0
).
-simplify__goal_2(Goal0, GoalInfo, Goal, GoalInfo, Info0, Info) :-
+simplify__goal_2(Goal0, GoalInfo0, Goal, GoalInfo, Info0, Info) :-
Goal0 = call(PredId, ProcId, Args, IsBuiltin, _, _),
%
@@ -429,7 +443,7 @@
PredId \= ThisPredId
->
- goal_info_get_context(GoalInfo, Context1),
+ goal_info_get_context(GoalInfo0, Context1),
simplify_info_add_msg(Info0, warn_obsolete(PredId, Context1),
Info1)
;
@@ -479,7 +493,7 @@
simplify__input_args_are_equiv(Args, HeadVars, ArgModes,
CommonInfo1, ModuleInfo1)
->
- goal_info_get_context(GoalInfo, Context2),
+ goal_info_get_context(GoalInfo0, Context2),
simplify_info_add_msg(Info1, warn_infinite_recursion(Context2),
Info2)
;
@@ -490,17 +504,45 @@
% check for duplicate calls to the same procedure
%
( simplify_do_calls(Info2) ->
- common__optimise_call(PredId, ProcId, Args, Goal0, GoalInfo,
- Goal, Info2, Info)
+ common__optimise_call(PredId, ProcId, Args, Goal0, GoalInfo0,
+ Goal1, Info2, Info3)
; simplify_do_warn_calls(Info0) ->
% we need to do the pass, for the warnings, but we ignore
% the optimized goal and instead use the original one
- common__optimise_call(PredId, ProcId, Args, Goal0, GoalInfo,
- _Goal1, Info2, Info),
- Goal = Goal0
+ common__optimise_call(PredId, ProcId, Args, Goal0, GoalInfo0,
+ _Goal1, Info2, Info3),
+ Goal1 = Goal0
;
- Goal = Goal0,
- Info = Info2
+ Goal1 = Goal0,
+ Info3 = Info2
+ ),
+
+ %
+ % Try to evaluate the call at compile-time.
+ %
+
+ ( simplify_do_const_prop(Info3) ->
+ simplify_info_get_instmap(Info3, Instmap0),
+ simplify_info_get_module_info(Info3, ModuleInfo2),
+ (
+ Goal1 = call(_, _, _, _, _, _),
+ evaluate_builtin(PredId, ProcId, Args, GoalInfo0,
+ Goal2, GoalInfo2, Instmap0,
+ ModuleInfo2, ModuleInfo3)
+ ->
+ Goal = Goal2,
+ GoalInfo = GoalInfo2,
+ simplify_info_set_module_info(Info3, ModuleInfo3, Info4),
+ simplify_info_set_requantify(Info4, Info)
+ ;
+ Goal = Goal1,
+ GoalInfo = GoalInfo0,
+ Info = Info3
+ )
+ ;
+ Goal = Goal1,
+ GoalInfo = GoalInfo0,
+ Info = Info3
).
simplify__goal_2(Goal0, GoalInfo0, Goal, GoalInfo, Info0, Info) :-
@@ -632,6 +674,7 @@
simplify__goal(conj(List) - GoalInfo0, Goal - GoalInfo,
Info0, Info)
;
+ simplify_info_get_instmap(Info0, InstMap0),
simplify__goal(Cond0, Cond, Info0, Info1),
simplify_info_update_instmap(Info1, Cond, Info2),
simplify__goal(Then0, Then, Info2, Info3),
@@ -647,7 +690,14 @@
Else = _ - ElseInfo,
goal_info_get_instmap_delta(ElseInfo, ElseDelta),
simplify_info_create_branch_info(Info0, Info6,
- [ElseDelta, CondThenDelta], Info),
+ [ElseDelta, CondThenDelta], Info7),
+ goal_info_get_nonlocals(GoalInfo0, NonLocals),
+ simplify_info_get_module_info(Info7, ModuleInfo0),
+ merge_instmap_deltas(InstMap0, NonLocals,
+ [CondThenDelta, ElseDelta], NewDelta,
+ ModuleInfo0, ModuleInfo1),
+ simplify_info_set_module_info(Info7, ModuleInfo1, Info),
+ goal_info_set_instmap_delta(GoalInfo0, NewDelta, GoalInfo1),
IfThenElse = if_then_else(Vars, Cond, Then, Else, SM),
%
% If-then-elses that are det or semidet may nevertheless
@@ -666,13 +716,13 @@
->
determinism_components(InnerDetism, IfThenElseCanFail,
at_most_many),
- goal_info_set_determinism(GoalInfo0, InnerDetism,
+ goal_info_set_determinism(GoalInfo1, InnerDetism,
InnerInfo),
Goal = some([], IfThenElse - InnerInfo)
;
Goal = IfThenElse
),
- GoalInfo = GoalInfo0
+ GoalInfo = GoalInfo1
).
simplify__goal_2(not(Goal0), GoalInfo, Goal, GoalInfo, Info0, Info) :-
@@ -1102,7 +1152,7 @@
simplify__goal(Goal0, Goal, Info3, Info4),
simplify_info_post_branch_update(Info0, Info4, Info5),
Case = case(ConsId, Goal),
- Goal0 = _ - GoalInfo,
+ Goal = _ - GoalInfo,
goal_info_get_instmap_delta(GoalInfo, InstMapDelta),
simplify__switch(Var, Cases0, Cases, [InstMapDelta | InstMaps0],
InstMaps, Info0, Info5, Info).
@@ -1466,30 +1516,34 @@
:- pred simplify_do_common(simplify_info::in) is semidet.
:- pred simplify_do_excess_assigns(simplify_info::in) is semidet.
:- pred simplify_do_calls(simplify_info::in) is semidet.
+:- pred simplify_do_const_prop(simplify_info::in) is semidet.
:- implementation.
simplify_do_warn(Info) :-
simplify_info_get_simplify(Info, Simplify),
- Simplify = simplify(yes, _, _, _, _, _, _).
+ Simplify = simplify(yes, _, _, _, _, _, _, _).
simplify_do_warn_calls(Info) :-
simplify_info_get_simplify(Info, Simplify),
- Simplify = simplify(_, yes, _, _, _, _, _).
+ Simplify = simplify(_, yes, _, _, _, _, _, _).
simplify_do_once(Info) :-
simplify_info_get_simplify(Info, Simplify),
- Simplify = simplify(_, _, yes, _, _, _, _).
+ Simplify = simplify(_, _, yes, _, _, _, _, _).
simplify_do_switch(Info) :-
simplify_info_get_simplify(Info, Simplify),
- Simplify = simplify(_, _, _, yes, _, _, _).
+ Simplify = simplify(_, _, _, yes, _, _, _, _).
simplify_do_common(Info) :-
simplify_info_get_simplify(Info, Simplify),
- Simplify = simplify(_, _, _, _, yes, _, _).
+ Simplify = simplify(_, _, _, _, yes, _, _, _).
simplify_do_excess_assigns(Info) :-
simplify_info_get_simplify(Info, Simplify),
- Simplify = simplify(_, _, _, _, _, yes, _).
+ Simplify = simplify(_, _, _, _, _, yes, _, _).
simplify_do_calls(Info) :-
simplify_info_get_simplify(Info, Simplify),
- Simplify = simplify(_, _, _, _, _, _, yes).
+ Simplify = simplify(_, _, _, _, _, _, yes, _).
+simplify_do_const_prop(Info) :-
+ simplify_info_get_simplify(Info, Simplify),
+ Simplify = simplify(_, _, _, _, _, _, _, yes).
:- pred simplify_info_update_instmap(simplify_info::in, hlds_goal::in,
simplify_info::out) is det.
cvs diff: Diffing compiler/notes
Index: compiler/notes/compiler_design.html
===================================================================
RCS file: /home/staff/zs/imp/mercury/compiler/notes/compiler_design.html,v
retrieving revision 1.5
diff -u -r1.5 compiler_design.html
--- compiler_design.html 1997/07/24 03:41:14 1.5
+++ compiler_design.html 1997/08/04 01:48:15
@@ -311,6 +311,8 @@
that construct a term that is the same as one that already exists,
or (b) repeated calls to a predicate with the same inputs, and replaces
them with assignment unifications.
+ simplify.m also attempts to partially evaluate calls to builtin
+ procedures if the inputs are all constants (see const_prop.m).
</dl>
cvs diff: Diffing doc
Index: doc/user_guide.texi
===================================================================
RCS file: /home/staff/zs/imp/mercury/doc/user_guide.texi,v
retrieving revision 1.95
diff -u -r1.95 user_guide.texi
--- user_guide.texi 1997/08/20 07:43:10 1.95
+++ user_guide.texi 1997/08/21 22:04:50
@@ -1839,6 +1839,10 @@
the higher-order arguments are known.
@sp 1
+ at item --optimize-constant-propagation
+Evaluate constant expressions at compile time.
+
+ at sp 1
@item --optimize-constructor-last-call
Enable the optimization of ``last'' calls that are followed by
constructor application.
cvs diff: Diffing extras
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/Togl-1.2
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing library
cvs diff: Diffing lp_solve
cvs diff: Diffing lp_solve/lp_examples
cvs diff: Diffing profiler
cvs diff: Diffing runtime
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing scripts
cvs diff: Diffing tools
cvs diff: Diffing trial
cvs diff: Diffing util
%------------------------------------------------------------------------------%
%
% file: const_prop.m
% main author: conway.
%
% This module provides the facility to evaluate calls at compile time -
% transforming them to simpler goals such as construction unifications.
%
%------------------------------------------------------------------------------%
:- module const_prop.
:- interface.
:- import_module hlds_goal, hlds_pred, instmap.
:- import_module list, term.
:- pred evaluate_builtin(pred_id, proc_id, list(var), hlds_goal_info,
hlds_goal_expr, hlds_goal_info, instmap,
module_info, module_info).
:- mode evaluate_builtin(in, in, in, in, out, out, in, in, out) is semidet.
%------------------------------------------------------------------------------%
:- implementation.
:- import_module code_aux, det_analysis, follow_code, goal_util.
:- import_module hlds_module, hlds_goal, hlds_data, instmap, inst_match.
:- import_module globals, options, passes_aux, prog_data, mode_util, type_util.
:- import_module code_util, quantification, modes.
:- import_module bool, list, int, float, map, require.
:- import_module (inst), hlds_out, std_util, term, varset.
%------------------------------------------------------------------------------%
evaluate_builtin(PredId, ProcId, Args, GoalInfo0, Goal, GoalInfo,
InstMap, ModuleInfo0, ModuleInfo) :-
predicate_module(ModuleInfo0, PredId, ModuleName),
predicate_name(ModuleInfo0, PredId, PredName),
proc_id_to_int(ProcId, ProcInt),
LookupVarInsts = lambda([V::in, J::out] is det, (
instmap__lookup_var(InstMap, V, VInst),
J = V - VInst
)),
list__map(LookupVarInsts, Args, ArgInsts),
evaluate_builtin_2(ModuleName, PredName, ProcInt, ArgInsts, GoalInfo0,
Goal, GoalInfo, ModuleInfo0, ModuleInfo).
:- pred evaluate_builtin_2(module_name, string, int, list(pair(var, (inst))),
hlds_goal_info, hlds_goal_expr, hlds_goal_info,
module_info, module_info).
:- mode evaluate_builtin_2(in, in, in, in, in, out, out, in, out) is semidet.
% Module_info is not acutally used at the moment.
evaluate_builtin_2(Mod, Pred, ModeNum, Args, GoalInfo0, Goal, GoalInfo,
ModuleInfo, ModuleInfo) :-
(
Args = [X, Y],
evaluate_builtin_bi(Mod, Pred, ModeNum, X, Y, W, Cons)
->
make_construction(W, Cons, Goal),
goal_info_get_instmap_delta(GoalInfo0, Delta0),
W = Var - _WInst,
instmap_delta_set(Delta0, Var,
bound(unique, [functor(Cons, [])]), Delta),
goal_info_set_instmap_delta(GoalInfo0, Delta, GoalInfo)
;
Args = [X, Y, Z],
evaluate_builtin_tri(Mod, Pred, ModeNum, X, Y, Z, W, Cons)
->
make_construction(W, Cons, Goal),
goal_info_get_instmap_delta(GoalInfo0, Delta0),
W = Var - _WInst,
instmap_delta_set(Delta0, Var,
bound(unique, [functor(Cons, [])]), Delta),
goal_info_set_instmap_delta(GoalInfo0, Delta, GoalInfo)
;
evaluate_builtin_test(Mod, Pred, ModeNum, Args, Result)
->
make_true_or_fail(Result, GoalInfo0, Goal, GoalInfo)
;
fail
).
%------------------------------------------------------------------------------%
:- pred evaluate_builtin_bi(string, string, int,
pair(var, (inst)), pair(var, (inst)),
pair(var, (inst)), cons_id).
:- mode evaluate_builtin_bi(in, in, in, in, in, out, out) is semidet.
% Integer arithmetic
evaluate_builtin_bi("int", "+", 10000, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
ZVal is XVal.
evaluate_builtin_bi("int", "-", 10000, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
ZVal is -XVal.
evaluate_builtin_bi("int", "\\", 10000, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
ZVal is \ XVal.
% Floating point arithmetic
evaluate_builtin_bi("float", "+", 10000, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
ZVal is XVal.
evaluate_builtin_bi("float", "-", 10000, X, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
ZVal is -XVal.
%------------------------------------------------------------------------------%
:- pred evaluate_builtin_tri(string, string, int,
pair(var, (inst)), pair(var, (inst)), pair(var, (inst)),
pair(var, (inst)), cons_id).
:- mode evaluate_builtin_tri(in, in, in, in, in, in, out, out) is semidet.
%
% Integer arithmetic
%
evaluate_builtin_tri("int", "+", 10000, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal + YVal.
evaluate_builtin_tri("int", "+", 10001, X, Y, Z, X, int_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
XVal is ZVal - YVal.
evaluate_builtin_tri("int", "+", 10002, X, Y, Z, Y, int_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
YVal is ZVal - XVal.
evaluate_builtin_tri("int", "-", 10000, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal - YVal.
evaluate_builtin_tri("int", "-", 10001, X, Y, Z, X, int_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
XVal is YVal + ZVal.
evaluate_builtin_tri("int", "-", 10002, X, Y, Z, Y, int_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
YVal is XVal - ZVal.
evaluate_builtin_tri("int", "*", 10000, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal * YVal.
/****
evaluate_builtin_tri("int", "*", 10001, X, Y, Z, X, int_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
XVal is ZVal // YVal.
evaluate_builtin_tri("int", "*", 10002, X, Y, Z, Y, int_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
XVal \= 0,
YVal is ZVal // XVal.
****/
evaluate_builtin_tri("int", "//", 10000, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
YVal \= 0,
ZVal is XVal // YVal.
/****
evaluate_builtin_tri("int", "//", 10001, X, Y, Z, X, int_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
XVal is ZVal * YVal.
evaluate_builtin_tri("int", "//", 10002, X, Y, Z, Y, int_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(int_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
ZVal \= 0,
YVal is XVal // ZVal.
****/
evaluate_builtin_tri("int", "mod", 10000, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal mod YVal.
evaluate_builtin_tri("int", "<<", 10000, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal << YVal.
evaluate_builtin_tri("int", ">>", 10000, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal >> YVal.
evaluate_builtin_tri("int", "/\\", 10000, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal /\ YVal.
evaluate_builtin_tri("int", "\\/", 10000, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal \/ YVal.
evaluate_builtin_tri("int", "^", 10000, X, Y, Z, Z, int_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
ZVal is XVal ^ YVal.
%
% float arithmetic
%
evaluate_builtin_tri("float", "+", 10000, X, Y, Z, Z, float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
ZVal is XVal + YVal.
evaluate_builtin_tri("float", "+", 10001, X, Y, Z, X, float_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
XVal is ZVal - YVal.
evaluate_builtin_tri("float", "+", 10002, X, Y, Z, Y, float_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
YVal is ZVal - XVal.
evaluate_builtin_tri("float", "-", 10000, X, Y, Z, Z, float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
ZVal is XVal - YVal.
evaluate_builtin_tri("float", "-", 10001, X, Y, Z, X, float_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
XVal is YVal + ZVal.
evaluate_builtin_tri("float", "-", 10002, X, Y, Z, Y, float_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
YVal is XVal - ZVal.
evaluate_builtin_tri("float", "*", 10000, X, Y, Z, Z, float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
ZVal is XVal * YVal.
evaluate_builtin_tri("float", "*", 10001, X, Y, Z, X, float_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
YVal \= 0.0,
XVal is ZVal / YVal.
evaluate_builtin_tri("float", "*", 10002, X, Y, Z, Y, float_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
XVal \= 0.0,
YVal is ZVal / XVal.
evaluate_builtin_tri("float", "//", 10000, X, Y, Z, Z, float_const(ZVal)) :-
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
YVal \= 0.0,
ZVal is XVal / YVal.
evaluate_builtin_tri("float", "//", 10001, X, Y, Z, X, float_const(XVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
XVal is ZVal * YVal.
evaluate_builtin_tri("float", "//", 10002, X, Y, Z, Y, float_const(YVal)) :-
Z = _ZVar - bound(_ZUniq, [functor(float_const(ZVal), [])]),
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
ZVal \= 0.0,
YVal is XVal / ZVal.
%------------------------------------------------------------------------------%
:- pred evaluate_builtin_test(string, string, int, list(pair(var, inst)), bool).
:- mode evaluate_builtin_test(in, in, in, in, out) is semidet.
% Integer comparisons
evaluate_builtin_test("int", "<", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
( XVal < YVal ->
Result = yes
;
Result = no
).
evaluate_builtin_test("int", "=<", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
( XVal =< YVal ->
Result = yes
;
Result = no
).
evaluate_builtin_test("int", ">", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
( XVal > YVal ->
Result = yes
;
Result = no
).
evaluate_builtin_test("int", ">=", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(int_const(YVal), [])]),
( XVal >= YVal ->
Result = yes
;
Result = no
).
% Float comparisons
evaluate_builtin_test("float", "<", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
( XVal < YVal ->
Result = yes
;
Result = no
).
evaluate_builtin_test("float", "=<", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
( XVal =< YVal ->
Result = yes
;
Result = no
).
evaluate_builtin_test("float", ">", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
( XVal > YVal ->
Result = yes
;
Result = no
).
evaluate_builtin_test("float", ">=", 0, Args, Result) :-
Args = [X, Y],
X = _XVar - bound(_XUniq, [functor(float_const(XVal), [])]),
Y = _YVar - bound(_YUniq, [functor(float_const(YVal), [])]),
( XVal >= YVal ->
Result = yes
;
Result = no
).
%------------------------------------------------------------------------------%
:- pred make_construction(pair(var, inst), cons_id, hlds_goal_expr).
:- mode make_construction(in, in, out) is det.
make_construction(Var - VarInst, ConsId, Goal) :-
RHS = functor(ConsId, []),
CInst = bound(unique, [functor(ConsId, [])]),
Mode = (VarInst -> CInst) - (CInst -> CInst),
Unification = construct(Var, ConsId, [], []),
Context = unify_context(explicit, []),
Goal = unify(Var, RHS, Mode, Unification, Context).
%------------------------------------------------------------------------------%
:- pred make_true_or_fail(bool, hlds_goal_info, hlds_goal_expr, hlds_goal_info).
:- mode make_true_or_fail(in, in, out, out) is det.
make_true_or_fail(yes, GoalInfo, conj([]), GoalInfo).
make_true_or_fail(no, GoalInfo, disj([], SM), GoalInfo) :-
map__init(SM).
%------------------------------------------------------------------------------%
More information about the developers
mailing list