[m-dev.] for review: change semantics of integer shifts

[Simon Taylor]

Estimated hours taken: 1

Change the bit shift operators to perform checking to avoid
implementation defined 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.

Index: NEWS
===================================================================
RCS file: /home/mercury1/repository/mercury/NEWS,v
retrieving revision 1.136
diff -u -u -r1.136 NEWS
--- NEWS	1999/03/18 01:27:38	1.136
+++ NEWS	1999/03/18 01:36:08
@@ -51,6 +51,14 @@
 	float__min_exponent/1,
 	float__max_exponent/1.
 
+* The implementations of `int:>>/2' and `int:<</2' have been changed to define
+  the results for negative shift counts and shift counts greater than the
+  word size.
+
+  For efficiency, we also provide the functions `int:unchecked_left_shift/2'
+  and `int:unchecked_right_shift/2' that, like the previous implementations
+  of `int:>>/2' and `int:<</2', do not check for these cases.
+
 * The extras distribution now includes support for dynamic linking.
 
   The interface is based on the C functions dlopen(), dlsym(), and co.,
Index: library/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/18 01:47:02
@@ -106,14 +106,50 @@
 :- func int rem int = int.
 :- mode in rem in = uo is det.
 
-	% left shift
+	% X << Y returns X left shifted by Y bits. 
+	%
+	% If Y is negative, X >> -Y is returned.
+	%
+	% If Y is greater than or equal to the
+	% result of `int__bits_per_int/1', 0 is returned.
+	% Vacated bit positions are filled with 0-bits.
 :- func int << int = int.
 :- mode in  << in  = uo  is det.
 
-	% (arithmetic) right shift
+	% unchecked_left_shift(X, Y) returns X left shifted by Y bits 
+	% using the C `<<' operator.
+	%
+	% Vacated bit positions are filled with 0-bits.
+	% 
+	% The result is implementation defined if Y is negative,
+	% or 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.
+
+	% X >> Y returns X (arithmetic) right shifted by Y bits.
+	%
+	% If Y is negative, X << -Y is returned.
+	%
+	% Otherwise, the vacated bit positions are filled with 1-bits if
+	% X is negative or 0-bits if X is positive.
+	% Note: this assumes two's complement arithmetic.
+	% tests/hard_coded/shift_test.m will fail if this is not the case.
 :- func int >> int = int.
 :- mode in  >> in  = uo  is det.
 
+	% unchecked_right_shift(X, Y) returns X (arithmetic) right shifted
+	% by Y bits using the C '>>' operator.
+	%
+	% Vacated bit positions are filled with 1-bits if
+	% X is negative or 0-bits if X is positive.
+	% Note: this assumes two's complement arithmetic.
+	% tests/hard_coded/shift_test.m will fail if this is not the case.
+	%
+	% The result is implementation defined if Y is negative,
+	% or 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 +256,49 @@
 	).
 
 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 will 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 >= 0 ->
+		( Y >= IntBits ->
+			Z = 0
+		;
+			Z = unchecked_left_shift(X, Y)
+		)
+	;
+		( Y =< -IntBits ->
+			Z = (if X >= 0 then 0 else -1)
+		;
+			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 >= 0 ->
+		( Y >= IntBits ->
+			Z = (if X >= 0 then 0 else -1)
+		;
+			Z = unchecked_right_shift(X, Y)
+		)
+	;
+		( Y =< -IntBits ->
+			Z = 0
+		;
+			Z = unchecked_left_shift(X, -Y)
+		)
+	).
 
 int__abs(Num, Abs) :-
 	(
Index: compiler/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)))).