(New diff) Re: [m-rev.] Handle polymorphic inequality goals

[Ralph Becket]

Estimated hours taken: 32
Branches: main

Make the Prolog term comparison operators (@<, @=<, @>, @>=) 
builtin since they're often useful and calling compare/3
can look a little awkward.

Simplification now applies the following transformations on the
new builtin operators:

	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/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.

compiler/NEWS:
	Mention these changes.

library/builtin.m:
	Added the inequalities as built-ins.
	Added the function ordering/2.

library/prolog.m:
	Removed the definitions for @< etc.

Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.274
diff -u -r1.274 NEWS
--- NEWS	22 Oct 2002 13:10:33 -0000	1.274
+++ NEWS	28 Oct 2002 05:07:28 -0000
@@ -12,6 +12,7 @@
 * Support for defining predicates or functions
   using different clauses for different modes.
 * Support for Haskell-like "@" expressions.
+* Prolog-style term comparison operators, @<, @=<, @>, @>=, are now builtin.
 
 Changes to the Mercury compiler:
 * A new `--make' option, for simpler building of programs.
@@ -120,6 +121,11 @@
   extensions which are unlikely to be implemented.
 
 Changes to the Mercury standard library:
+
+* The Prolog-style term comparison operators @<, @=<, @>, @>= are now
+  builtin.
+
+* A new builtin function ordering/2 has been added.
 
 * We've added a function to io.m to construct io__error codes from error
   messages: `io__make_io_error'.
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/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	25 Oct 2002 07:36:19 -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	28 Oct 2002 06:47:28 -0000
@@ -184,13 +184,46 @@
 	% 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.
 
+	% ordering(X, Y) = R  <=>  compare(R, X, Y)
+	%
+:- func ordering(T, T) = comparison_result.
+
+	% 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 +367,16 @@
 
 :- external(unify/2).
 :- external(compare/3).
+
+ordering(X, Y) = R :-
+	compare(R, X, Y).
+
+	% 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/prolog.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/prolog.m,v
retrieving revision 1.11
diff -u -r1.11 prolog.m
--- library/prolog.m	9 Jul 2002 01:30:16 -0000	1.11
+++ library/prolog.m	25 Oct 2002 07:38:55 -0000
@@ -40,18 +40,6 @@
 :- pred T \== T.			% In Mercury, just use \=
 :- mode in \== in is semidet.
 
-:- pred T @< T.
-:- mode in @< in is semidet.
-
-:- pred T @=< T.
-:- mode in @=< in is semidet.
-
-:- pred T @> T.
-:- mode in @> in is semidet.
-
-:- pred T @>= T.
-:- mode in @>= in is semidet.
-
 % Prolog's so-called "univ" operator, `=..'.
 % Note: this is not related to Mercury's "univ" type!
 % In Mercury, use `expand' (defined in module `std_util') instead.
@@ -90,11 +78,6 @@
 
 'prolog__=:='(X, X).
 'prolog__=\\='(X, Y) :- X \= Y.
-
-'prolog__@<'(X, Y) :- compare(<, X, Y).
-'prolog__@>'(X, Y) :- compare(>, X, Y).
-'prolog__@=<'(X, Y) :- compare(R, X, Y), R \= (>).
-'prolog__@>='(X, Y) :- compare(R, X, Y), R \= (<).
 
 'prolog__=..'(Term, Functor - Args) :-
 	deconstruct(Term, Functor, _Arity, Args).
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------