[m-rev.] Handle polymorphic inequality goals
Ralph Becket
rafe at cs.mu.OZ.AU
Thu Oct 24 16:31:27 AEST 2002
Estimated hours taken: 32
Branches: main
Simplification now applies the following transformations on the
builtin inequalities:
X < Y ---> some [R] (compare(R, X, Y), R = (<))
X =< Y ---> some [R] (compare(R, X, Y), R \= (>))
X > Y ---> some [R] (compare(R, X, Y), R = (>))
X >= Y ---> some [R] (compare(R, X, Y), R \= (<))
compiler/add_heap_ops.m:
compiler/add_trail_ops.m:
compiler/table_gen.m:
Added `only_mode' argument to calls to
goal_util__generate_simple_call which now has an extra parameter.
compiler/builtin_ops.m:
Removed builtin translations for int and float inequalities, since
these should now be handled by specialisation of calls to compare/3.
compiler/goal_util.m:
Added a new parameter, ModeNo, to goal_util__generate_simple_call.
ModeNo is either
- `only_mode' in which case the predicate in question is expected to
have exactly one mode or
- `mode_no(N)' in which case mode number N (counting from 0) is
used.
The inequality transformation uses this to handle calls to compare/3
with unique arguments (even though the builtin inequality modes don't
yet handle ui arguments...)
compiler/simplify.m:
simplify__goal_2 for calls now makes a decision as to whether to
call simplify__call_goal or simplify__inequality_goal. The bulk
of simplify__goal_2 is now in simplify__call_goal. The
inequality transformation is handled in simplify__inequality_goal.
compiler/type_util.m:
Added comparison_result_type constant.
library/builtin.m:
Added the inequalities as built-ins.
library/float.m:
library/int.m:
Removed the declarations for the int and float inequalities.
library/integer.m:
library/rational.m:
Fully qualified calls to the integer and rational inequalities.
Index: compiler/add_heap_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_heap_ops.m,v
retrieving revision 1.5
diff -u -r1.5 add_heap_ops.m
--- compiler/add_heap_ops.m 28 Mar 2002 03:42:41 -0000 1.5
+++ compiler/add_heap_ops.m 3 Oct 2002 08:58:20 -0000
@@ -345,7 +345,8 @@
generate_call(PredName, Args, Detism, MaybeFeature, InstMap, Module, Context,
CallGoal) :-
mercury_private_builtin_module(BuiltinModule),
- goal_util__generate_simple_call(BuiltinModule, PredName, Args, Detism,
- MaybeFeature, InstMap, Module, Context, CallGoal).
+ goal_util__generate_simple_call(BuiltinModule, PredName, Args,
+ only_mode, Detism, MaybeFeature, InstMap, Module,
+ Context, CallGoal).
%-----------------------------------------------------------------------------%
Index: compiler/add_trail_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/add_trail_ops.m,v
retrieving revision 1.8
diff -u -r1.8 add_trail_ops.m
--- compiler/add_trail_ops.m 28 Mar 2002 03:42:41 -0000 1.8
+++ compiler/add_trail_ops.m 3 Oct 2002 08:58:20 -0000
@@ -140,7 +140,8 @@
% will call error/1) rather than `fail' for the "then" part.
mercury_private_builtin_module(PrivateBuiltin),
generate_simple_call(PrivateBuiltin, "unused",
- [], det, no, [], ModuleInfo, Context, ThenGoal)
+ [], only_mode, det,
+ no, [], ModuleInfo, Context, ThenGoal)
;
ThenGoal = Fail
},
@@ -468,7 +469,8 @@
generate_call(PredName, Args, Detism, MaybeFeature, InstMap, Module, Context,
CallGoal) :-
mercury_private_builtin_module(BuiltinModule),
- goal_util__generate_simple_call(BuiltinModule, PredName, Args, Detism,
- MaybeFeature, InstMap, Module, Context, CallGoal).
+ goal_util__generate_simple_call(BuiltinModule, PredName, Args,
+ only_mode, Detism, MaybeFeature, InstMap, Module,
+ Context, CallGoal).
%-----------------------------------------------------------------------------%
Index: compiler/builtin_ops.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/builtin_ops.m,v
retrieving revision 1.11
diff -u -r1.11 builtin_ops.m
--- compiler/builtin_ops.m 20 Mar 2002 12:35:51 -0000 1.11
+++ compiler/builtin_ops.m 3 Oct 2002 08:58:20 -0000
@@ -213,14 +213,6 @@
assign(Y, binary((-), int_const(0), leaf(X)))).
builtin_translation("int", "\\", 0, [X, Y],
assign(Y, unary(bitwise_complement, leaf(X)))).
-builtin_translation("int", ">", 0, [X, Y],
- test(binary((>), leaf(X), leaf(Y)))).
-builtin_translation("int", "<", 0, [X, Y],
- test(binary((<), leaf(X), leaf(Y)))).
-builtin_translation("int", ">=", 0, [X, Y],
- test(binary((>=), leaf(X), leaf(Y)))).
-builtin_translation("int", "=<", 0, [X, Y],
- test(binary((<=), leaf(X), leaf(Y)))).
builtin_translation("float", "+", 0, [X, Y, Z],
assign(Z, binary(float_plus, leaf(X), leaf(Y)))).
@@ -234,12 +226,4 @@
assign(Y, leaf(X))).
builtin_translation("float", "-", 0, [X, Y],
assign(Y, binary(float_minus, float_const(0.0), leaf(X)))).
-builtin_translation("float", ">", 0, [X, Y],
- test(binary(float_gt, leaf(X), leaf(Y)))).
-builtin_translation("float", "<", 0, [X, Y],
- test(binary(float_lt, leaf(X), leaf(Y)))).
-builtin_translation("float", ">=", 0, [X, Y],
- test(binary(float_ge, leaf(X), leaf(Y)))).
-builtin_translation("float", "=<", 0, [X, Y],
- test(binary(float_le, leaf(X), leaf(Y)))).
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.77
diff -u -r1.77 goal_util.m
--- compiler/goal_util.m 22 Jul 2002 06:29:28 -0000 1.77
+++ compiler/goal_util.m 3 Oct 2002 08:58:20 -0000
@@ -199,7 +199,7 @@
% - the goals are independent
% - the goals are not impure
% - any possible change in termination behaviour is allowed
- % according to the semantics options.
+ % according to the semantics options.
%
:- pred goal_util__can_reorder_goals(module_info::in, vartypes::in, bool::in,
instmap::in, hlds_goal::in, instmap::in, hlds_goal::in) is semidet.
@@ -215,21 +215,28 @@
:- pred goal_util__reordering_maintains_termination(module_info::in, bool::in,
hlds_goal::in, hlds_goal::in) is semidet.
- % generate_simple_call(ModuleName, PredName, Args,
+ % generate_simple_call(ModuleName, PredName, Args, ModeNo,
% Detism, MaybeFeature, InstMapDelta,
% ModuleInfo, Context, CallGoal):
% Generate a call to a builtin procedure (e.g.
% from the private_builtin or table_builtin module).
% This is used by HLDS->HLDS transformation passes that introduce
- % calls to builtin procedures. This is restricted in various ways,
- % e.g. the called procedure must have exactly one mode,
- % and at most one type parameter. So it should only be used
- % for generating calls to known builtin procedures.
+ % calls to builtin procedures.
+ %
+ % If ModeNo = only_mode then the predicate must have exactly one
+ % procedure (an error is raised if this is not the case.)
+ %
+ % If ModeNo = mode_no(N) then the Nth procedure is used, counting
+ % from 0.
%
:- pred goal_util__generate_simple_call(module_name::in, string::in,
- list(prog_var)::in, determinism::in, maybe(goal_feature)::in,
- assoc_list(prog_var, inst)::in, module_info::in, term__context::in,
- hlds_goal::out) is det.
+ list(prog_var)::in, mode_no::in, determinism::in,
+ maybe(goal_feature)::in, assoc_list(prog_var, inst)::in,
+ module_info::in, term__context::in, hlds_goal::out) is det.
+
+:- type mode_no
+ ---> only_mode % The pred must have exactly one mode.
+ ; mode_no(int). % The Nth mode, counting from 0.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -445,10 +452,10 @@
goal_util__rename_var_list(ArgVars0, Must, Subn, ArgVars).
goal_util__rename_unify_rhs(
lambda_goal(PredOrFunc, EvalMethod, FixModes, NonLocals0,
- Vars0, Modes, Det, Goal0),
+ Vars0, Modes, Det, Goal0),
Must, Subn,
lambda_goal(PredOrFunc, EvalMethod, FixModes, NonLocals,
- Vars, Modes, Det, Goal)) :-
+ Vars, Modes, Det, Goal)) :-
goal_util__rename_var_list(NonLocals0, Must, Subn, NonLocals),
goal_util__rename_var_list(Vars0, Must, Subn, Vars),
goal_util__rename_vars_in_goal(Goal0, Must, Subn, Goal).
@@ -930,9 +937,9 @@
goal_expr_contains_reconstruction(switch(_, _, Cases)) :-
list__member(Case, Cases),
Case = case(_, Goal),
- goal_contains_reconstruction(Goal).
+ goal_contains_reconstruction(Goal).
goal_expr_contains_reconstruction(if_then_else(_, Cond, Then, Else)) :-
- goals_contain_reconstruction([Cond, Then, Else]).
+ goals_contain_reconstruction([Cond, Then, Else]).
goal_expr_contains_reconstruction(not(Goal)) :-
goal_contains_reconstruction(Goal).
goal_expr_contains_reconstruction(some(_, _, Goal)) :-
@@ -1206,7 +1213,7 @@
%-----------------------------------------------------------------------------%
-goal_util__generate_simple_call(ModuleName, PredName, Args, Detism,
+goal_util__generate_simple_call(ModuleName, PredName, Args, ModeNo, Detism,
MaybeFeature, InstMap, Module, Context, CallGoal) :-
list__length(Args, Arity),
module_info_get_predicate_table(Module, PredTable),
@@ -1232,16 +1239,29 @@
error(ErrorMessage)
),
module_info_pred_info(Module, PredId, PredInfo),
+ pred_info_procids(PredInfo, ProcIds),
(
- pred_info_procids(PredInfo, [ProcId0])
- ->
- ProcId = ProcId0
+ ModeNo = only_mode,
+ (
+ ProcIds = [ProcId0]
+ ->
+ ProcId = ProcId0
+ ;
+ error(string__format(
+ "expected single mode for %s/%d",
+ [s(PredName), i(Arity)]))
+ )
;
- string__int_to_string(Arity, ArityS),
- string__append_list(["too many modes for pred ",
- PredName, "/", ArityS], ErrorMessage),
- error(ErrorMessage)
-
+ ModeNo = mode_no(N),
+ (
+ list__index0(ProcIds, N, ProcId0)
+ ->
+ ProcId = ProcId0
+ ;
+ error(string__format(
+ "there is no mode %d for %s/%d",
+ [i(N), s(PredName), i(Arity)]))
+ )
),
Call = call(PredId, ProcId, Args, not_builtin, no,
qualified(ModuleName, PredName)),
Index: compiler/simplify.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/simplify.m,v
retrieving revision 1.105
diff -u -r1.105 simplify.m
--- compiler/simplify.m 22 Jul 2002 06:29:48 -0000 1.105
+++ compiler/simplify.m 24 Oct 2002 04:42:50 -0000
@@ -31,6 +31,7 @@
:- import_module hlds__hlds_goal, hlds__hlds_module, hlds__hlds_pred.
:- import_module check_hlds__det_report, check_hlds__det_util.
:- import_module check_hlds__common, hlds__instmap, libs__globals.
+:- import_module check_hlds__det_util.
:- import_module io, bool, list, map.
:- pred simplify__pred(list(simplification), pred_id, module_info, module_info,
@@ -746,141 +747,27 @@
simplify__goal_2(Goal0, GoalInfo0, Goal, GoalInfo, Info0, Info) :-
Goal0 = call(PredId, ProcId, Args, IsBuiltin, _, _),
simplify_info_get_module_info(Info0, ModuleInfo),
- module_info_pred_proc_info(ModuleInfo, PredId, ProcId, PredInfo,
- ProcInfo),
-
- %
- % check for calls to predicates with `pragma obsolete' declarations
- %
- (
- simplify_do_warn(Info0),
- pred_info_get_markers(PredInfo, Markers),
- check_marker(Markers, obsolete),
- %
- % Don't warn about directly recursive calls.
- % (That would cause spurious warnings, particularly
- % with builtin predicates, or preds defined using
- % pragma foreign.)
- %
- simplify_info_get_det_info(Info0, DetInfo0),
- det_info_get_pred_id(DetInfo0, ThisPredId),
- PredId \= ThisPredId
- ->
-
- goal_info_get_context(GoalInfo0, Context1),
- simplify_info_add_msg(Info0, warn_obsolete(PredId, Context1),
- Info1)
- ;
- Info1 = Info0
- ),
-
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
%
- % Check for recursive calls with the same input arguments,
- % and warn about them (since they will lead to infinite loops).
+ % Convert calls to builtin:{(=<),(<),(>=),(>)} into the corresponding
+ % calls to builtin:compare/3.
%
(
- simplify_do_warn(Info1),
-
- %
- % Is this a (directly) recursive call,
- % i.e. is the procedure being called the same as the
- % procedure we're analyzing?
- %
- simplify_info_get_det_info(Info1, DetInfo),
- det_info_get_pred_id(DetInfo, PredId),
- det_info_get_proc_id(DetInfo, ProcId),
-
- %
- % Don't count inline builtins.
- % (The compiler generates code for builtins that looks
- % recursive, so that you can take their address, but since
- % the recursive call actually expands into inline
- % instructions, so it's not infinite recursion.)
- %
- IsBuiltin \= inline_builtin,
-
- %
- % Don't warn if we're inside a lambda goal, because the
- % recursive call may not be executed.
- %
- \+ simplify_info_inside_lambda(Info1),
-
- %
- % Are the input arguments the same (or equivalent)?
- %
- simplify_info_get_module_info(Info1, ModuleInfo1),
- module_info_pred_proc_info(ModuleInfo1, PredId, ProcId,
- PredInfo1, ProcInfo1),
- proc_info_headvars(ProcInfo1, HeadVars),
- proc_info_argmodes(ProcInfo1, ArgModes),
- simplify_info_get_common_info(Info1, CommonInfo1),
- simplify__input_args_are_equiv(Args, HeadVars, ArgModes,
- CommonInfo1, ModuleInfo1),
-
- %
- % Don't count procs using minimal evaluation as they
- % should always terminate if they have a finite number
- % of answers.
- %
- \+ proc_info_eval_method(ProcInfo, eval_minimal),
-
- % Don't warn about Aditi relations.
- \+ hlds_pred__pred_info_is_aditi_relation(PredInfo1)
- ->
- goal_info_get_context(GoalInfo0, Context2),
- simplify_info_add_msg(Info1, warn_infinite_recursion(Context2),
- Info2)
- ;
- Info2 = Info1
- ),
-
- %
- % check for duplicate calls to the same procedure
- %
- ( simplify_do_calls(Info2),
- goal_info_is_pure(GoalInfo0)
- ->
- common__optimise_call(PredId, ProcId, Args, Goal0, GoalInfo0,
- Goal1, Info2, Info3)
- ; simplify_do_warn_calls(Info0),
- goal_info_is_pure(GoalInfo0)
- ->
- % 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, GoalInfo0,
- _Goal1, Info2, Info3),
- Goal1 = Goal0
- ;
- 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
+ Args = [TI, X, Y],
+ prog_util__mercury_public_builtin_module(BuiltinModule),
+ hlds_pred__pred_info_module(PredInfo, BuiltinModule),
+ hlds_pred__pred_info_name(PredInfo, Name),
+ ( Name = "<", Inequality = "<", Invert = no
+ ; Name = "=<", Inequality = ">", Invert = yes
+ ; Name = ">=", Inequality = "<", Invert = yes
+ ; Name = ">", Inequality = ">", Invert = no
)
+ ->
+ simplify__inequality_goal(TI, X, Y, Inequality, Invert,
+ GoalInfo0, Goal, GoalInfo, Info0, Info)
;
- Goal = Goal1,
- GoalInfo = GoalInfo0,
- Info = Info3
+ simplify__call_goal(PredId, ProcId, Args, IsBuiltin,
+ Goal0, GoalInfo0, Goal, GoalInfo, Info0, Info)
).
simplify__goal_2(Goal0, GoalInfo0, Goal, GoalInfo, Info0, Info) :-
@@ -1220,6 +1107,229 @@
simplify__goal_2(shorthand(_), _, _, _, _, _) :-
% these should have been expanded out by now
error("simplify__goal_2: unexpected shorthand").
+
+%-----------------------------------------------------------------------------%
+
+:- pred simplify__inequality_goal(
+ prog_var, prog_var, prog_var, string, bool, hlds_goal_info,
+ hlds_goal_expr, hlds_goal_info, simplify_info, simplify_info).
+:- mode simplify__inequality_goal(
+ in, in, in, in, in, in,
+ out, out, in, out) is det.
+
+simplify__inequality_goal(TI, X, Y, Inequality, Invert,
+ GoalInfo, GoalExpr, GoalInfo, Info0, Info) :-
+
+ % Construct the variable to hold the comparison result.
+ %
+ VarSet0 = Info0 ^ varset,
+ varset__new_var(VarSet0, R, VarSet),
+ Info1 = Info0 ^ varset := VarSet,
+
+ % We have to add the type of R to the var_types.
+ %
+ simplify_info_get_var_types(Info1, VarTypes0),
+ VarTypes = VarTypes0 ^ elem(R) := comparison_result_type,
+ simplify_info_set_var_types(Info1, VarTypes, Info),
+
+ % Construct the call to compare/3.
+ %
+ prog_util__mercury_public_builtin_module(BuiltinModule),
+ hlds_goal__goal_info_get_context(GoalInfo, Context),
+ Args = [TI, R, X, Y],
+
+ simplify_info_get_instmap(Info, InstMap),
+ instmap__lookup_var(InstMap, X, XInst),
+ instmap__lookup_var(InstMap, Y, YInst),
+ simplify_info_get_module_info(Info1, ModuleInfo),
+ ModeNo = ( if inst_is_unique(ModuleInfo, XInst) then
+ ( if inst_is_unique(ModuleInfo, YInst) then 1
+ else 2 )
+ else
+ ( if inst_is_unique(ModuleInfo, YInst) then 3
+ else 0 )
+ ),
+
+ Unique = ground(unique, none),
+ ArgInsts = [R - Unique],
+ goal_util__generate_simple_call(BuiltinModule, "compare", Args,
+ mode_no(ModeNo), det, no, ArgInsts, ModuleInfo, Context,
+ CmpGoal0),
+ CmpGoal0 = CmpExpr - CmpInfo0,
+ goal_info_get_nonlocals(CmpInfo0, CmpNonLocals0),
+ goal_info_set_nonlocals(CmpInfo0, CmpNonLocals0 `insert` R, CmpInfo),
+ CmpGoal = CmpExpr - CmpInfo,
+
+ % Construct the unification R = Inequality.
+ %
+ ConsId = cons(qualified(BuiltinModule, Inequality), 0),
+ Bound = bound(shared, [functor(ConsId, [])]),
+ UMode = ((Unique -> Bound) - (Bound -> Bound)),
+ RHS = functor(ConsId, no, []),
+ UKind = deconstruct(R, ConsId, [], [], can_fail, no),
+ UContext = unify_context(
+ implicit(
+ "replacment of inequality with call to compare/3"),
+ []),
+ UfyExpr = unify(R, RHS, UMode, UKind, UContext),
+ goal_info_get_nonlocals(GoalInfo, UfyNonLocals0),
+ goal_info_set_nonlocals(GoalInfo, UfyNonLocals0 `insert` R, UfyInfo),
+ UfyGoal = UfyExpr - UfyInfo,
+
+ (
+ Invert = no,
+ GoalExpr = conj([CmpGoal, UfyGoal])
+ ;
+ Invert = yes,
+ GoalExpr = conj([CmpGoal, not(UfyGoal) - UfyInfo])
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred simplify__call_goal(
+ pred_id, proc_id, list(prog_var), builtin_state,
+ hlds_goal_expr, hlds_goal_info, hlds_goal_expr, hlds_goal_info,
+ simplify_info, simplify_info).
+:- mode simplify__call_goal(in, in, in, in, in, in, out, out, in, out) is det.
+
+simplify__call_goal(PredId, ProcId, Args, IsBuiltin,
+ Goal0, GoalInfo0, Goal, GoalInfo, Info0, Info) :-
+ simplify_info_get_module_info(Info0, ModuleInfo),
+ module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
+ PredInfo, ProcInfo),
+ %
+ % check for calls to predicates with `pragma obsolete' declarations
+ %
+ (
+ simplify_do_warn(Info0),
+ pred_info_get_markers(PredInfo, Markers),
+ check_marker(Markers, obsolete),
+ %
+ % Don't warn about directly recursive calls.
+ % (That would cause spurious warnings, particularly
+ % with builtin predicates, or preds defined using
+ % pragma foreign.)
+ %
+ simplify_info_get_det_info(Info0, DetInfo0),
+ det_info_get_pred_id(DetInfo0, ThisPredId),
+ PredId \= ThisPredId
+ ->
+
+ goal_info_get_context(GoalInfo0, Context1),
+ simplify_info_add_msg(Info0, warn_obsolete(PredId, Context1),
+ Info1)
+ ;
+ Info1 = Info0
+ ),
+
+ %
+ % Check for recursive calls with the same input arguments,
+ % and warn about them (since they will lead to infinite loops).
+ %
+ (
+ simplify_do_warn(Info1),
+
+ %
+ % Is this a (directly) recursive call,
+ % i.e. is the procedure being called the same as the
+ % procedure we're analyzing?
+ %
+ simplify_info_get_det_info(Info1, DetInfo),
+ det_info_get_pred_id(DetInfo, PredId),
+ det_info_get_proc_id(DetInfo, ProcId),
+
+ %
+ % Don't count inline builtins.
+ % (The compiler generates code for builtins that looks
+ % recursive, so that you can take their address, but since
+ % the recursive call actually expands into inline
+ % instructions, so it's not infinite recursion.)
+ %
+ IsBuiltin \= inline_builtin,
+
+ %
+ % Don't warn if we're inside a lambda goal, because the
+ % recursive call may not be executed.
+ %
+ \+ simplify_info_inside_lambda(Info1),
+
+ %
+ % Are the input arguments the same (or equivalent)?
+ %
+ simplify_info_get_module_info(Info1, ModuleInfo1),
+ module_info_pred_proc_info(ModuleInfo1, PredId, ProcId,
+ PredInfo1, ProcInfo1),
+ proc_info_headvars(ProcInfo1, HeadVars),
+ proc_info_argmodes(ProcInfo1, ArgModes),
+ simplify_info_get_common_info(Info1, CommonInfo1),
+ simplify__input_args_are_equiv(Args, HeadVars, ArgModes,
+ CommonInfo1, ModuleInfo1),
+
+ %
+ % Don't count procs using minimal evaluation as they
+ % should always terminate if they have a finite number
+ % of answers.
+ %
+ \+ proc_info_eval_method(ProcInfo, eval_minimal),
+
+ % Don't warn about Aditi relations.
+ \+ hlds_pred__pred_info_is_aditi_relation(PredInfo1)
+ ->
+ goal_info_get_context(GoalInfo0, Context2),
+ simplify_info_add_msg(Info1, warn_infinite_recursion(Context2),
+ Info2)
+ ;
+ Info2 = Info1
+ ),
+
+ %
+ % check for duplicate calls to the same procedure
+ %
+ ( simplify_do_calls(Info2),
+ goal_info_is_pure(GoalInfo0)
+ ->
+ common__optimise_call(PredId, ProcId, Args, Goal0, GoalInfo0,
+ Goal1, Info2, Info3)
+ ; simplify_do_warn_calls(Info0),
+ goal_info_is_pure(GoalInfo0)
+ ->
+ % 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, GoalInfo0,
+ _Goal1, Info2, Info3),
+ Goal1 = Goal0
+ ;
+ 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
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/table_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/table_gen.m,v
retrieving revision 1.40
diff -u -r1.40 table_gen.m
--- compiler/table_gen.m 22 Oct 2002 04:35:58 -0000 1.40
+++ compiler/table_gen.m 24 Oct 2002 04:07:09 -0000
@@ -1743,8 +1743,9 @@
generate_call(PredName, Args, Detism, MaybeFeature, InstMap,
ModuleInfo, Context, CallGoal) :-
mercury_table_builtin_module(BuiltinModule),
- goal_util__generate_simple_call(BuiltinModule, PredName, Args, Detism,
- MaybeFeature, InstMap, ModuleInfo, Context, CallGoal).
+ goal_util__generate_simple_call(BuiltinModule, PredName, Args,
+ only_mode, Detism, MaybeFeature, InstMap, ModuleInfo,
+ Context, CallGoal).
:- pred append_fail(hlds_goal::in, hlds_goal::out) is det.
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.108
diff -u -r1.108 type_util.m
--- compiler/type_util.m 30 Jun 2002 17:06:41 -0000 1.108
+++ compiler/type_util.m 23 Oct 2002 04:31:56 -0000
@@ -177,6 +177,7 @@
:- func heap_pointer_type = (type).
:- func sample_type_info_type = (type).
:- func sample_typeclass_info_type = (type).
+:- func comparison_result_type = (type).
% Given a constant and an arity, return a type_ctor.
% Fails if the constant is not an atom.
@@ -822,6 +823,11 @@
mercury_private_builtin_module(BuiltinModule),
construct_type(qualified(BuiltinModule,
"sample_typeclass_info") - 0, [], Type).
+
+comparison_result_type = Type :-
+ mercury_public_builtin_module(BuiltinModule),
+ construct_type(qualified(BuiltinModule,
+ "comparison_result") - 0, [], Type).
%-----------------------------------------------------------------------------%
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.80
diff -u -r1.80 builtin.m
--- library/builtin.m 24 Sep 2002 06:55:16 -0000 1.80
+++ library/builtin.m 23 Oct 2002 07:28:52 -0000
@@ -184,13 +184,42 @@
% depending on wheither X is =, <, or > Y in the
% standard ordering.
:- pred compare(comparison_result, T, T).
- % Note to implementors: this mode must be first --
- % compiler/higher_order.m depends on it.
+ % Note to implementors: the modes must appear in this order:
+ % compiler/higher_order.m depends on it, as does
+ % compiler/simplify.m (for the inequality simplification.)
:- mode compare(uo, in, in) is det.
:- mode compare(uo, ui, ui) is det.
:- mode compare(uo, ui, in) is det.
:- mode compare(uo, in, ui) is det.
+ % The standard inequalities defined in terms of compare/3.
+ % XXX The ui modes are commented out because they don't yet
+ % work properly.
+ %
+:- pred T < T.
+:- mode in < in is semidet.
+% :- mode ui < in is semidet.
+% :- mode in < ui is semidet.
+% :- mode ui < ui is semidet.
+
+:- pred T =< T.
+:- mode in =< in is semidet.
+% :- mode ui =< in is semidet.
+% :- mode in =< ui is semidet.
+% :- mode ui =< ui is semidet.
+
+:- pred T > T.
+:- mode in > in is semidet.
+% :- mode ui > in is semidet.
+% :- mode in > ui is semidet.
+% :- mode ui > ui is semidet.
+
+:- pred T >= T.
+:- mode in >= in is semidet.
+% :- mode ui >= in is semidet.
+% :- mode in >= ui is semidet.
+% :- mode ui >= ui is semidet.
+
% Values of types comparison_pred/1 and comparison_func/1 are used
% by predicates and functions which depend on an ordering on a given
% type, where this ordering is not necessarily the standard ordering.
@@ -334,6 +363,13 @@
:- external(unify/2).
:- external(compare/3).
+
+ % simplify__goal automatically inlines these definitions.
+ %
+X < Y :- compare((<), X, Y).
+X =< Y :- not compare((>), X, Y).
+X > Y :- compare((>), X, Y).
+X >= Y :- not compare((<), X, Y).
%-----------------------------------------------------------------------------%
Index: library/float.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/float.m,v
retrieving revision 1.48
diff -u -r1.48 float.m
--- library/float.m 19 Oct 2002 19:09:39 -0000 1.48
+++ library/float.m 21 Oct 2002 05:22:04 -0000
@@ -79,26 +79,6 @@
:- mode - in = uo is det.
%
-% Comparison predicates
-%
-
- % less than
-:- pred <(float, float).
-:- mode <(in, in) is semidet.
-
- % greater than
-:- pred >(float, float).
-:- mode >(in, in) is semidet.
-
- % less than or equal
-:- pred =<(float, float).
-:- mode =<(in, in) is semidet.
-
- % greater than or equal
-:- pred >=(float, float).
-:- mode >=(in, in) is semidet.
-
-%
% Conversion functions
%
Index: library/int.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/int.m,v
retrieving revision 1.88
diff -u -r1.88 int.m
--- library/int.m 28 Jun 2002 01:36:40 -0000 1.88
+++ library/int.m 3 Oct 2002 08:58:20 -0000
@@ -26,22 +26,6 @@
:- instance enum(int).
- % less than
-:- pred int < int.
-:- mode in < in is semidet.
-
- % greater than
-:- pred int > int.
-:- mode in > in is semidet.
-
- % less than or equal
-:- pred int =< int.
-:- mode in =< in is semidet.
-
- % greater than or equal
-:- pred int >= int.
-:- mode in >= in is semidet.
-
% absolute value
:- func int__abs(int) = int.
:- pred int__abs(int, int).
Index: library/integer.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/integer.m,v
retrieving revision 1.9
diff -u -r1.9 integer.m
--- library/integer.m 29 Aug 2002 10:09:07 -0000 1.9
+++ library/integer.m 3 Oct 2002 08:58:20 -0000
@@ -1054,7 +1054,9 @@
%:- func integer__int(integer) = int.
integer__int(Integer) = Int :-
- ( Integer >= integer(int__min_int), Integer =< integer(int__max_int) ->
+ ( integer:'>='(Integer, integer(int__min_int)),
+ integer:'=<'(Integer, integer(int__max_int))
+ ->
Integer = i(_Sign, List),
Int = int_list(List, 0)
;
Index: library/rational.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rational.m,v
retrieving revision 1.4
diff -u -r1.4 rational.m
--- library/rational.m 29 Aug 2002 10:09:07 -0000 1.4
+++ library/rational.m 3 Oct 2002 08:58:20 -0000
@@ -187,9 +187,9 @@
:- func signum(integer) = integer.
signum(N) =
- ( N = izero -> izero
- ; N < izero -> -ione
- ; ione
+ ( N = izero -> izero
+ ; integer:'<'(N, izero) -> -ione
+ ; ione
).
:- type comparison
@@ -216,6 +216,5 @@
:- pred is_negative(rational).
:- mode is_negative(in) is semidet.
is_negative(r(Num, _)) :-
- Zero = izero,
- Num < Zero.
+ integer:'<'(Num, izero).
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list