for review: change semantics of integer shifts

[Simon Taylor]

Estimated hours taken: 1

Change the bit shift operators to perform checking to avoid
undefined behaviour.

library/int.m:
	Add checking to `int:<<' and `int:>>'.

compiler/code_util.m:
	Replace `int:<<' and `int:>>' with `int:unchecked_left_shift' and
	`int:unchecked_right_shift' in the builtin table.

NEWS:
	Mention the changes to int.m.



--- NEWS	1999/03/14 23:31:32	1.2
+++ NEWS	1999/03/14 23:51:24
@@ -34,3 +34,11 @@
   See the "Interactive query commands" subsection of the "Debugger commands"
   section of the "Debugging" chapter of the Mercury User's Guide for details.
 
+* The semantics of `int:>>/2' and `int:<</2' has changed.
+  The results are undefined only if the left operand of
+  `int:>>/2' is negative, or if both operands of `int:<</2' are negative.
+
+  The new functions `int:unchecked_left_shift/2' and
+  `int:unchecked_right_shift/2' implement the old semantics,
+  using the C shift operators.
+

Index: code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/code_util.m,v
retrieving revision 1.104
diff -u -u -r1.104 code_util.m
--- code_util.m	1998/11/24 03:56:57	1.104
+++ code_util.m	1999/03/12 00:29:53
@@ -434,11 +434,11 @@
 	no, yes(Z - binop((mod), var(X), var(Y)))).
 code_util__translate_builtin_2("int", "builtin_left_shift", 0, [X, Y, Z],
 	no, yes(Z - binop((<<), var(X), var(Y)))).
-code_util__translate_builtin_2("int", "<<", 0, [X, Y, Z],
+code_util__translate_builtin_2("int", "unchecked_left_shift", 0, [X, Y, Z],
 	no, yes(Z - binop((<<), var(X), var(Y)))).
 code_util__translate_builtin_2("int", "builtin_right_shift", 0, [X, Y, Z],
 	no, yes(Z - binop((>>), var(X), var(Y)))).
-code_util__translate_builtin_2("int", ">>", 0, [X, Y, Z],
+code_util__translate_builtin_2("int", "unchecked_right_shift", 0, [X, Y, Z],
 	no, yes(Z - binop((>>), var(X), var(Y)))).
 code_util__translate_builtin_2("int", "builtin_bit_and", 0, [X, Y, Z],
 	no, yes(Z - binop((&), var(X), var(Y)))).

Index: int.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/int.m,v
retrieving revision 1.52
diff -u -u -r1.52 int.m
--- int.m	1998/01/23 12:33:19	1.52
+++ int.m	1999/03/14 23:48:11
@@ -107,13 +107,34 @@
 :- mode in rem in = uo is det.
 
 	% left shift
+	% The result is undefined if both operands are negative.
+	% If the right operand is negative, a right shift is performed.
+	% If the right operand is greater than or equal to the result of
+	% `int__bits_per_int/1', 0 is returned.
 :- func int << int = int.
 :- mode in  << in  = uo  is det.
 
+	% left shift
+	% The result is undefined if the right operand is greater
+	% than or equal to the result of `int__bits_per_int/1'.
+:- func unchecked_left_shift(int, int) = int.
+:- mode unchecked_left_shift(in, in) = uo is det.
+
 	% (arithmetic) right shift
+	% The result is undefined if the left operand is negative.
+	% if the right operand is negative, a left shift is performed.
+	% If the right operand is greater than or equal to the result of
+	% `int__bits_per_int/1', 0 is returned.
 :- func int >> int = int.
 :- mode in  >> in  = uo  is det.
 
+	% (arithmetic) right shift
+	% The result is undefined if either operand is negative,
+	% or if the right operand is greater than or equal to the
+	% result of `int__bits_per_int/1'.
+:- func unchecked_right_shift(int, int) = int.
+:- mode unchecked_right_shift(in, in) = uo is det.
+
 	% bitwise and
 :- func int /\ int = int.
 :- mode in  /\ in  = uo  is det.
@@ -220,6 +241,46 @@
 	).
 
 X mod Y = X - (X div Y) * Y.
+
+	% XXX This definition is here for bootstrapping.
+	% After the corresponding change to the compiler is installed,
+	% the compiler ignore this clause, and will internally replace
+	% the body of unchecked_left_shift with a `recursive' call.
+	% See make_hlds:add_builtin.
+unchecked_left_shift(X, Y) = X << Y.
+
+X << Y = Z :-
+	(
+		int__bits_per_int(IntBits),
+		Y > IntBits
+	->
+		Z = 0
+	;
+		Y >= 0
+	->
+		Z = unchecked_left_shift(X, Y)
+	;
+		Z = unchecked_right_shift(X, - Y)
+	).
+
+	% XXX This definition is here for bootstrapping.
+	% See the comment for unchecked_left_shift.
+unchecked_right_shift(X, Y) = X >> Y.
+
+X >> Y = Z :-
+	(
+		int__bits_per_int(IntBits),
+		Y > IntBits
+	->
+		Z = 0
+	;
+		Y >= 0
+	->
+		Z = unchecked_right_shift(X, Y)
+	;
+		Z = unchecked_left_shift(X, - Y)
+	).
+
 
 int__abs(Num, Abs) :-
 	(