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

[Simon Taylor]

> This looks much better this time.
> However, I have some suggestions about the library documentation.
 
> The comment about tests/hard_coded/shift_test.m is 
> a dangling comment, since tests/hard_coded/shift_test.m
> does not exist and is not added by this change.

See below.



Estimated hours taken: 1

Change the bit shift functions 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.

tests/hard_coded/Mmakefile:
tests/hard_coded/shift_test.m:
tests/hard_coded/shift_test.exp:
	Test the shift functions.

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/19 03:41:38
@@ -1,14 +1,18 @@
 %---------------------------------------------------------------------------%
-% Copyright (C) 1994-1997 The University of Melbourne.
+% Copyright (C) 1994-1999 The University of Melbourne.
 % This file may only be copied under the terms of the GNU Library General
 % Public License - see the file COPYING.LIB in the Mercury distribution.
 %---------------------------------------------------------------------------%
 %
-% int - some predicates for dealing with machine-size integer numbers.
-%
+% File: int.m.
 % Main authors: conway, fjh.
 % Stability: medium.
 %
+% Predicates and functions for dealing with machine-size integer numbers.
+%
+% The predicates and functions in this module do not check for overflow.
+% The behaviour of a computation for which overflow occurs is undefined.
+%
 %-----------------------------------------------------------------------------%
 
 :- module int.
@@ -106,14 +110,34 @@
 :- func int rem int = int.
 :- mode in rem in = uo is det.
 
-	% left shift
+	% Left shift.
+	% X << Y returns X "left shifted" by Y bits. 
+	% To be precise, if Y is negative, the result is
+	% X div (2^(-Y)), otherwise the result is X * (2^Y).
 :- func int << int = int.
 :- mode in  << in  = uo  is det.
 
-	% (arithmetic) right shift
+	% unchecked_left_shift(X, Y) is the same as X << Y
+	% except that the behaviour is undefined if Y is negative,
+	% or greater than or equal to the result of `int__bits_per_int/1'.
+	% It will typically be implemented more efficiently than X << Y.
+:- func unchecked_left_shift(int, int) = int.
+:- mode unchecked_left_shift(in, in) = uo is det.
+
+	% Right shift.
+	% X >> Y returns X "arithmetic right shifted" by Y bits.
+	% To be precise, if Y is negative, the result is
+	% X * (2^(-Y)), otherwise the result is X div (2^Y).
 :- func int >> int = int.
 :- mode in  >> in  = uo  is det.
 
+	% unchecked_right_shift(X, Y) is the same as X >> Y
+	% except that the behaviour is undefined if Y is negative,
+	% or greater than or equal to the result of `int__bits_per_int/1'.
+	% It will typically be implemented more efficiently than X >> Y.
+:- 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 +244,51 @@
 	).
 
 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.
+
+	% Note: this assumes two's complement arithmetic.
+	% tests/hard_coded/shift_test.m will fail if this is not the case.
+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: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/tests/hard_coded/Mmakefile,v
retrieving revision 1.51
diff -u -u -r1.51 Mmakefile
--- Mmakefile	1999/02/08 23:36:46	1.51
+++ Mmakefile	1999/03/16 00:55:43
@@ -80,6 +80,7 @@
 	reverse_arith \
 	rnd \
 	rtc_bug \
+	shift_test \
 	space \
 	string_alignment \
 	string_loop \
Index: tests/hard_coded/shift_test.exp
===================================================================
RCS file: shift_test.exp
diff -N shift_test.exp
--- /dev/null	Fri Mar 19 14:39:39 1999
+++ shift_test.exp	Thu Mar 18 12:14:00 1999
@@ -0,0 +1,18 @@
+64 << 2 = 256 (256)
+-64 << 2 = -256 (-256)
+64 << -2 = 16 (16)
+-64 << -2 = -16 (-16)
+64 << 256 = 0 (0)
+64 << -256 = 0 (0)
+-64 << 256 = 0 (0)
+-64 << -256 = -1 (-1)
+64 >> 2 = 16 (16)
+-64 >> 2 = -16 (-16)
+64 >> -2 = 256 (256)
+-64 >> -2 = -256 (-256)
+64 >> 256 = 0 (0)
+64 >> -256 = 0 (0)
+-64 >> 256 = -1 (-1)
+-64 >> -256 = 0 (0)
+64 unchecked_left_shift 2 = 256 (256)
+-64 unchecked_right_shift 2 = -16 (-16)
Index: tests/hard_coded/shift_test.m
===================================================================
RCS file: shift_test.m
diff -N shift_test.m
--- /dev/null	Fri Mar 19 14:39:39 1999
+++ shift_test.m	Thu Mar 18 12:15:40 1999
@@ -0,0 +1,45 @@
+% test the handling of `>>', `<<', unchecked_left_shift
+% and unchecked_right_shift.  
+
+:- module shift_test.
+:- interface.
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+:- import_module int, list, string.
+
+main -->
+	shift_test((<<), "<<", 64, 2, 256),
+	shift_test((<<), "<<", -64, 2, -256),
+	shift_test((<<), "<<", 64, -2, 16),
+	shift_test((<<), "<<", -64, -2, -16),
+	shift_test((<<), "<<", 64, 256, 0),
+	shift_test((<<), "<<", 64, -256, 0),
+	shift_test((<<), "<<", -64, 256, 0),
+	shift_test((<<), "<<", -64, -256, -1),
+
+	shift_test((>>), ">>", 64, 2, 16),
+	shift_test((>>), ">>", -64, 2, -16),
+	shift_test((>>), ">>", 64, -2, 256),
+	shift_test((>>), ">>", -64, -2, -256),
+	shift_test((>>), ">>", 64, 256, 0),
+	shift_test((>>), ">>", 64, -256, 0),
+	shift_test((>>), ">>", -64, 256, -1),
+	shift_test((>>), ">>", -64, -256, 0),
+
+	shift_test(unchecked_left_shift, "unchecked_left_shift",
+		64, 2, 256),
+	shift_test(unchecked_right_shift, "unchecked_right_shift",
+		-64, 2, -16).
+
+:- pred shift_test((func(int, int) = int)::(func(in, in) = out is det),
+	string::in, int::in, int::in, int::in,
+	io__state::di, io__state::uo) is det.
+
+shift_test(Func, FuncName, Left, Right, Result) -->
+	io__format("%d %s %d = %d (%d)\n",
+		[i(Left), s(FuncName), i(Right),
+		i(Func(Left, Right)), i(Result)]).
+