[m-rev.] diff: implement integer-to-uint and uint-to-integer conversion

Julien Fischer jfischer at opturion.com
Mon Apr 17 00:53:13 AEST 2017


Implement integer-to-uint and uint-to-integer conversion.

library/integer.m:
      As above -- I have upcoming changes that require this.
      (There's a bunch places marked XXX UINT that will need
      to revisited once more uint support is available.)

tests/Mmakefile:
tests/hard_coded/integer_uint_conv.{m,exp,exp2}:
       Add test for the conversions.

Julien.

diff --git a/library/integer.m b/library/integer.m
index 9f612de..3315bc2 100644
--- a/library/integer.m
+++ b/library/integer.m
@@ -2,6 +2,7 @@
  % vim: ts=4 sw=4 et ft=mercury
  %---------------------------------------------------------------------------%
  % Copyright (C) 1997-2000, 2003-2007, 2011-2012 The University of Melbourne.
+% Copyright (C) 2014-2017 The Mercury team.
  % 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.
  %---------------------------------------------------------------------------%
@@ -50,6 +51,10 @@
      %
  :- func integer(int) = integer.

+    % Convert a uint to an integer.
+    %
+:- func from_uint(uint) = integer.
+
      % Convert an integer to a string (in base 10).
      %
  :- func to_string(integer) = string.
@@ -186,6 +191,15 @@
      %
  :- func det_to_int(integer) = int.

+    % Convert an integer to a uint.
+    % Fails if the integer is not in the range [0, max_uint].
+    %
+:- pred to_uint(integer::in, uint::out) is semidet.
+
+    % As above, but throws an exception rather than failing.
+    %
+:- func det_to_uint(integer) = uint.
+
  :- func int(integer) = int.
  :- pragma obsolete(int/1).

@@ -231,6 +245,7 @@
  :- import_module math.
  :- import_module require.
  :- import_module string.
+:- import_module uint.

  %---------------------------------------------------------------------------%

@@ -750,6 +765,16 @@ int_to_integer(D) = Int :-
          )
      ).

+from_uint(U) = Integer :-
+    % XXX UINT use uint literals here when we have them.
+    ( if U = cast_from_int(0) then
+        Integer = integer.zero
+    else if U < cast_from_int(base) then
+        Integer = i(1, [cast_to_int(U)])
+    else
+        Integer = uint_to_digits(U)
+    ).
+
  :- func shortint_to_integer(int) = integer.

  shortint_to_integer(D) = Result :-
@@ -791,6 +816,21 @@ pos_int_to_digits_2(D, Tail) = Result :-
          Result = pos_int_to_digits_2(Div, i(Length + 1, [Mod | Digits]))
      ).

+:- func uint_to_digits(uint) = integer.
+
+uint_to_digits(U) = uint_to_digits_2(U, integer.zero).
+
+:- func uint_to_digits_2(uint, integer) = integer.
+
+uint_to_digits_2(U, Tail) = Result :-
+    ( if U = cast_from_int(0) then
+        Result = Tail
+    else
+        Tail = i(Length, Digits),
+        chop_uint(U, Div, Mod),
+        Result = uint_to_digits_2(Div, i(Length + 1, [cast_to_int(Mod) | Digits]))
+    ).
+
  :- func mul_base(integer) = integer.

  mul_base(i(Len, Digits)) = Result :-
@@ -831,6 +871,41 @@ chop(N, Div, Mod) :-
      Div = N >> log2base,    % i.e. Div = N div base
      Mod = N /\ basemask.    % i.e. Mod = N mod base

+:- pred chop_uint(uint::in, uint::out, uint::out) is det.
+
+chop_uint(N, Div, Mod) :-
+    Div = N `uint_right_shift` log2base,
+    Mod = N /\ cast_from_int(basemask).
+
+    % XXX UINT - we define right shift for uints locally until the support for
+    % unchecked_right_shift has bootstrapped.
+    %
+:- func uint_right_shift(uint, int) = uint.
+
+:- pragma foreign_proc("C",
+    uint_right_shift(A::in, B::in) = (C::out),
+    [promise_pure, will_not_call_mercury, thread_safe, will_not_modify_trail],
+"
+    C = A >> B;
+").
+
+:- pragma foreign_proc("C#",
+    uint_right_shift(A::in, B::in) = (C::out),
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    C = A >> B;
+").
+
+:- pragma foreign_proc("Java",
+    uint_right_shift(A::in, B::in) = (C::out),
+    [promise_pure, will_not_call_mercury, thread_safe],
+"
+    C = A >>> B;
+").
+
+uint_right_shift(_, _) = _ :-
+    sorry($module, "uint_right_shift/1 for Erlang NYI").
+
  :- func pos_plus(integer, integer) = integer.

  pos_plus(i(L1, D1), i(L2, D2)) = Out :-
@@ -1240,6 +1315,28 @@ int_list([H | T], Accum) = int_list(T, Accum * base + H).

  %---------------------------------------------------------------------------%

+to_uint(Integer, UInt) :-
+    Integer >= integer.zero,
+    Integer =< integer.from_uint(uint.max_uint),
+    Integer = i(_Sign, Digits),
+    UInt = uint_list(Digits, cast_from_int(0)).
+
+:- func uint_list(list(int), uint) = uint.
+
+uint_list([], Accum) = Accum.
+uint_list([H | T], Accum) =
+    uint_list(T, Accum * cast_from_int(base) + cast_from_int(H)).
+
+det_to_uint(Integer) = UInt :-
+    ( if integer.to_uint(Integer, UIntPrime) then
+        UInt = UIntPrime
+    else
+        throw(math.domain_error(
+            "integer.det_to_uint: domain error (conversion would overflow)"))
+    ).
+
+%---------------------------------------------------------------------------%
+
  is_zero(i(0, [])).

  %---------------------------------------------------------------------------%
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 7074954..4393750 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -166,6 +166,7 @@ ORDINARY_PROGS =	\
  	int_fold_up_down \
  	int_range_ops \
  	integer_test \
+	integer_uint_conv \
  	intermod_c_code \
  	intermod_foreign_type \
  	intermod_multimode_main \
diff --git a/tests/hard_coded/integer_uint_conv.exp b/tests/hard_coded/integer_uint_conv.exp
index e69de29..cc80124 100644
--- a/tests/hard_coded/integer_uint_conv.exp
+++ b/tests/hard_coded/integer_uint_conv.exp
@@ -0,0 +1,41 @@
+*** Testing uint -> integer conversion ***
+
+uint = 0, integer = 0
+uint = 1, integer = 1
+uint = 2, integer = 2
+uint = 4, integer = 4
+uint = 8, integer = 8
+uint = 10, integer = 10
+uint = 16, integer = 16
+uint = 32, integer = 32
+uint = 64, integer = 64
+uint = 16383, integer = 16383
+uint = 16384, integer = 16384
+uint = 16385, integer = 16385
+uint = 32768, integer = 32768
+uint = 65536, integer = 65536
+uint = 9223372036854775807, integer = 9223372036854775807
+uint = 9223372036854775808, integer = 9223372036854775808
+uint = 18446744073709551615, integer = 18446744073709551615
+
+*** Testing integer -> uint conversion ***
+
+integer = -9223372036854775808, uint = <<OUT-OF-RANGE>>
+integer = -4294967296, uint = <<OUT-OF-RANGE>>
+integer = -2147483648, uint = <<OUT-OF-RANGE>>
+integer = -2, uint = <<OUT-OF-RANGE>>
+integer = -1, uint = <<OUT-OF-RANGE>>
+integer = 0, uint = 0
+integer = 1, uint = 1
+integer = 2, uint = 2
+integer = 16383, uint = 16383
+integer = 16384, uint = 16384
+integer = 16385, uint = 16385
+integer = 1073741824, uint = 1073741824
+integer = 2147483648, uint = 2147483648
+integer = 4294967295, uint = 4294967295
+integer = 4294967296, uint = 4294967296
+integer = 4294967297, uint = 4294967297
+integer = 9223372036854775808, uint = 9223372036854775808
+integer = 18446744073709551615, uint = 18446744073709551615
+integer = 18446744073709551616, uint = <<OUT-OF-RANGE>>
diff --git a/tests/hard_coded/integer_uint_conv.exp2 b/tests/hard_coded/integer_uint_conv.exp2
index e69de29..103d1ea 100644
--- a/tests/hard_coded/integer_uint_conv.exp2
+++ b/tests/hard_coded/integer_uint_conv.exp2
@@ -0,0 +1,41 @@
+*** Testing uint -> integer conversion ***
+
+uint = 0, integer = 0
+uint = 1, integer = 1
+uint = 2, integer = 2
+uint = 4, integer = 4
+uint = 8, integer = 8
+uint = 10, integer = 10
+uint = 16, integer = 16
+uint = 32, integer = 32
+uint = 64, integer = 64
+uint = 16383, integer = 16383
+uint = 16384, integer = 16384
+uint = 16385, integer = 16385
+uint = 32768, integer = 32768
+uint = 65536, integer = 65536
+uint = 2147483647, integer = 2147483647
+uint = 2147483648, integer = 2147483648
+uint = 4294967295, integer = 4294967295
+
+*** Testing integer -> uint conversion ***
+
+integer = -9223372036854775808, uint = <<OUT-OF-RANGE>>
+integer = -4294967296, uint = <<OUT-OF-RANGE>>
+integer = -2147483648, uint = <<OUT-OF-RANGE>>
+integer = -2, uint = <<OUT-OF-RANGE>>
+integer = -1, uint = <<OUT-OF-RANGE>>
+integer = 0, uint = 0
+integer = 1, uint = 1
+integer = 2, uint = 2
+integer = 16383, uint = 16383
+integer = 16384, uint = 16384
+integer = 16385, uint = 16385
+integer = 1073741824, uint = 1073741824
+integer = 2147483648, uint = 2147483648
+integer = 4294967295, uint = 4294967295
+integer = 4294967296, uint = <<OUT-OF-RANGE>>
+integer = 4294967297, uint = <<OUT-OF-RANGE>>
+integer = 9223372036854775808, uint = <<OUT-OF-RANGE>>
+integer = 18446744073709551615, uint = <<OUT-OF-RANGE>>
+integer = 18446744073709551616, uint = <<OUT-OF-RANGE>>
diff --git a/tests/hard_coded/integer_uint_conv.m b/tests/hard_coded/integer_uint_conv.m
index e69de29..aa69eeb 100644
--- a/tests/hard_coded/integer_uint_conv.m
+++ b/tests/hard_coded/integer_uint_conv.m
@@ -0,0 +1,100 @@
+%---------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et wm=0 tw=0
+%---------------------------------------------------------------------------%
+
+% Test conversion of uints to integers and integers to uints.
+
+:- module integer_uint_conv.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module int.
+:- import_module list.
+:- import_module integer.
+:- import_module uint.
+
+%---------------------------------------------------------------------------%
+
+main(!IO) :-
+    io.write_string("*** Testing uint -> integer conversion ***\n\n", !IO),
+    list.foldl(do_to_integer_test, test_uints, !IO),
+    io.nl(!IO),
+    io.write_string("*** Testing integer -> uint conversion ***\n\n", !IO),
+    list.foldl(do_from_integer_test, test_integers, !IO).
+
+:- pred do_to_integer_test(uint::in, io::di, io::uo) is det.
+
+do_to_integer_test(U, !IO) :-
+    Integer = integer.from_uint(U),
+    io.write_string("uint = ", !IO),
+    io.write_uint(U, !IO),
+    io.write_string(", integer = ", !IO),
+    io.print(Integer, !IO),
+    io.nl(!IO).
+
+:- pred do_from_integer_test(integer::in, io::di, io::uo) is det.
+
+do_from_integer_test(Integer, !IO) :-
+    io.write_string("integer = ", !IO),
+    io.print(Integer, !IO),
+    io.write_string(", uint = ", !IO),
+    ( if integer.to_uint(Integer, U) then
+        io.write_uint(U, !IO)
+    else
+        io.write_string("<<OUT-OF-RANGE>>", !IO)
+    ),
+    io.nl(!IO).
+
+:- func test_uints = list(uint).
+
+test_uints = [
+    cast_from_int(0),
+    cast_from_int(1),
+    cast_from_int(2),
+    cast_from_int(4),
+    cast_from_int(8),
+    cast_from_int(10),
+    cast_from_int(16),
+    cast_from_int(32),
+    cast_from_int(64),
+    cast_from_int(16383),  % i.e. integer.base - 1
+    cast_from_int(16384),  % i.e. integer.base
+    cast_from_int(16385),  % i.e. integer.base + 1,
+    cast_from_int(32768),
+    cast_from_int(65536),
+    cast_from_int(int.max_int),
+    cast_from_int(int.max_int) + cast_from_int(1),
+    uint.max_uint
+].
+
+:- func test_integers = list(integer).
+
+test_integers = [
+    det_from_string("-9223372036854775808"),
+    det_from_string("-4294967296"),
+    det_from_string("-2147483648"),
+    det_from_string("-2"),
+    det_from_string("-1"),
+    det_from_string("0"),
+    det_from_string("1"),
+    det_from_string("2"),
+    det_from_string("16383"),
+    det_from_string("16384"),
+    det_from_string("16385"),
+    det_from_string("1073741824"),
+    det_from_string("2147483648"),
+    det_from_string("4294967295"),
+    det_from_string("4294967296"),
+    det_from_string("4294967297"),
+    det_from_string("9223372036854775808"),
+    det_from_string("18446744073709551615"),
+    det_from_string("18446744073709551616")
+].


More information about the reviews mailing list