mirror of
https://github.com/Mercury-Language/mercury.git
synced 2025-12-20 00:15:27 +00:00
79dcbbef15
Estimated hours taken: 60 User-guided type specialization. compiler/prog_data.m: compiler/prog_io_pragma.m: compiler/modules.m: compiler/module_qual.m: compiler/mercury_to_mercury.m: Handle `:- pragma type_spec'. compiler/prog_io_pragma.m: Factor out some common code to parse predicate names with arguments. compiler/hlds_module.m: Added a field to the module_sub_info to hold information about user-requested type specializations, filled in by make_hlds.m and not used by anything after higher_order.m. compiler/make_hlds.m: For each `:- pragma type_spec' declaration, introduce a new predicate which just calls the predicate to be specialized with the specified argument types. This forces higher_order.m to produce the specialized versions. compiler/higher_order.m: Process the user-requested type specializations first to ensure that they get the correct names. Allow partial matches against user-specified versions, e.g. map__lookup(map(int, list(int)), int, list(int)) matches map__lookup(map(int, V), int, V). Perform specialization where a typeclass constraint matches a known instance, but the construction of the typeclass_info is done in the calling module. Give slightly more informative progress messages. compiler/dead_proc_elim.m: Remove specializations for dead procedures. compiler/prog_io_util.m: Change the definition of the `maybe1' and `maybe_functor' types to avoid the need for copying to convert between `maybe1' and `maybe1(generic)'. Changed the interface of `make_pred_name_with_context' to allow creation of predicate names for type specializations which describe the type substitution. compiler/make_hlds.m: compiler/prog_io_pragma.m: Make the specification of pragma declarations in error messages consistent. (There are probably some more to be fixed elsewhere for termination and tabling). compiler/intermod.m: Write type specialization pragmas for predicates declared in `.opt' files. compiler/mercury_to_mercury.m: Export `mercury_output_item' for use by intermod.m. compiler/options.m: Add an option `--user-guided-type-specialization' enabled with `-O2' or higher. compiler/handle_options.m: `--type-specialization' implies `--user-guided-type-specialization'. compiler/hlds_goal.m: Add predicates to construct constants. These are duplicated in several other places, I'll fix that as a separate change. compiler/type_util.m: Added functions `int_type/0', `string_type/0', `float_type/0' and `char_type/0' which return the builtin types. These are duplicated in several other places, I'll fix that as a separate change. library/private_builtin.m: Added `instance_constraint_from_typeclass_info/3' to extract the typeclass_infos for a constraint on an instance declaration. This is useful for specializing class method calls. Added `thread_safe' to various `:- pragma c_code's. Added `:- pragma inline' declarations for `builtin_compare_*', which are important for user-guided type specialization. (`builtin_unify_*' are simple enough to go in the `.opt' files automatically). compiler/polymorphism.m: `instance_constraint_from_typeclass_info/3' does not need type_infos. Add `instance_constraint_from_typeclass_info/3' to the list of `typeclass_info_manipulator's which higher_order.m can interpret. NEWS: doc/reference_manual.texi: doc/user_guide.texi Document the new pragma and option. tests/invalid/Mmakefile: tests/invalid/type_spec.m: tests/invalid/type_spec.err_exp: Test error reporting for invalid type specializations. tests/hard_coded/Mmakefile: tests/invalid/type_spec.m: tests/invalid/type_spec.exp: Test type specialization.
413 lines
15 KiB
Mathematica
413 lines
15 KiB
Mathematica
%---------------------------------------------------------------------------%
|
|
% Copyright (C) 1997-1999 The University of Melbourne.
|
|
% This file may only be copied under the terms of the GNU General
|
|
% Public License - see the file COPYING in the Mercury distribution.
|
|
%---------------------------------------------------------------------------%
|
|
%
|
|
% file: 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.
|
|
%
|
|
% XXX We should check for overflow.
|
|
% XXX Some of this code should be shared with vn_util__simplify_vnrval.
|
|
%
|
|
%------------------------------------------------------------------------------%
|
|
|
|
:- module const_prop.
|
|
|
|
:- interface.
|
|
|
|
:- import_module hlds_module, hlds_goal, hlds_pred, prog_data, instmap.
|
|
:- import_module list.
|
|
|
|
:- pred evaluate_builtin(pred_id, proc_id, list(prog_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_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.
|
|
|
|
%------------------------------------------------------------------------------%
|
|
|
|
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(prog_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 actually used at the moment.
|
|
|
|
evaluate_builtin_2(Module, Pred, ModeNum, Args, GoalInfo0, Goal, GoalInfo,
|
|
ModuleInfo, ModuleInfo) :-
|
|
% -- not yet:
|
|
% Module = qualified(unqualified("std"), Mod),
|
|
Module = unqualified(Mod),
|
|
(
|
|
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(prog_var, (inst)), pair(prog_var, (inst)),
|
|
pair(prog_var, (inst)), cons_id).
|
|
:- mode evaluate_builtin_bi(in, in, in, in, in, out, out) is semidet.
|
|
|
|
% Integer arithmetic
|
|
|
|
evaluate_builtin_bi("int", "+", 0, X, Z, Z, int_const(ZVal)) :-
|
|
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
|
|
ZVal is XVal.
|
|
|
|
evaluate_builtin_bi("int", "-", 0, X, Z, Z, int_const(ZVal)) :-
|
|
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
|
|
ZVal is -XVal.
|
|
|
|
evaluate_builtin_bi("int", "\\", 0, X, Z, Z, int_const(ZVal)) :-
|
|
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
|
|
ZVal is \ XVal.
|
|
|
|
% Floating point arithmetic
|
|
|
|
evaluate_builtin_bi("float", "+", 0, X, Z, Z, int_const(ZVal)) :-
|
|
X = _XVar - bound(_XUniq, [functor(int_const(XVal), [])]),
|
|
ZVal is XVal.
|
|
|
|
evaluate_builtin_bi("float", "-", 0, 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(prog_var, (inst)), pair(prog_var, (inst)),
|
|
pair(prog_var, (inst)), pair(prog_var, (inst)), cons_id).
|
|
:- mode evaluate_builtin_tri(in, in, in, in, in, in, out, out) is semidet.
|
|
|
|
%
|
|
% Integer arithmetic
|
|
%
|
|
evaluate_builtin_tri("int", "+", 0, 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", "+", 1, 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", "+", 2, 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", "-", 0, 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", "-", 1, 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", "-", 2, 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", "*", 0, 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", "*", 1, 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", "*", 2, 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", "//", 0, 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", "//", 1, 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", "//", 2, 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.
|
|
****/
|
|
|
|
% This isn't actually a builtin.
|
|
evaluate_builtin_tri("int", "mod", 0, 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 mod YVal.
|
|
|
|
evaluate_builtin_tri("int", "rem", 0, 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 rem YVal.
|
|
|
|
evaluate_builtin_tri("int", "unchecked_left_shift",
|
|
0, 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 unchecked_left_shift(XVal, YVal).
|
|
|
|
% This isn't actually a builtin.
|
|
evaluate_builtin_tri("int", "<<", 0, 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", "unchecked_right_shift",
|
|
0, 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 unchecked_right_shift(XVal, YVal).
|
|
|
|
% This isn't actually a builtin.
|
|
evaluate_builtin_tri("int", ">>", 0, 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", "/\\", 0, 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", "\\/", 0, 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", "^", 0, 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", "+", 0, 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", "+", 1, 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", "+", 2, 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", "-", 0, 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", "-", 1, 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", "-", 2, 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", "*", 0, 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", "*", 1, 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", "*", 2, 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", "//", 0, 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", "//", 1, 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", "//", 2, 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(prog_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
|
|
).
|
|
|
|
%------------------------------------------------------------------------------%
|
|
|
|
% recompute_instmap_delta is run by simplify.m if anything changes,
|
|
% so the insts are not important here.
|
|
:- pred make_construction(pair(prog_var, inst), cons_id, hlds_goal_expr).
|
|
:- mode make_construction(in, in, out) is det.
|
|
|
|
make_construction(Var - _, ConsId, Goal) :-
|
|
make_const_construction(Var, ConsId, Goal - _).
|
|
|
|
%------------------------------------------------------------------------------%
|
|
|
|
:- 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).
|
|
|
|
%------------------------------------------------------------------------------%
|