mercurylang/mercury
1
0
Fork 0
mirror of https://github.com/Mercury-Language/mercury.git synced 2026-04-17 18:33:58 +00:00
Code Issues Projects Releases Wiki Activity
Files
083d376e6598628362ee91c2da170febd83590f4
mercury/library/uint.m
Zoltan Somogyi 5cbcfaa0ed Move X_to_doc functions to pretty_printer.m. 
library/array.m:
library/char.m:
library/float.m:
library/int.m:
library/int16.m:
library/int32.m:
library/int64.m:
library/int8.m:
library/list.m:
library/one_or_more.m:
library/string.m:
library/tree234.m:
library/uint.m:
library/uint16.m:
library/uint32.m:
library/uint64.m:
library/uint8.m:
library/version_array.m:
    Mark the X_to_doc function in each of these modules as obsolete,
    and make it a forwarding function to the actual implementation
    in pretty_printer.m. The intention is that when these forwarding
    functions are eventually removed, this will also remove the dependency
    of these modules on pretty_printer.m. This should help at least some
    of these modules escape the giant SCC in the library's dependency graph.
    (It does not make sense that a library module that adds code to increment
    an int thereby becomes dependent on pretty_printer.m through int.m.)

library/pretty_printer.m:
    Move all the X_to_doc functions from the above modules here.

    Fix the one_or_more_to_doc function, which was

    - missing the comma between the two arguments of the one_or_more
      function symbol, and

    - would print "..., ...]" instead of just "...]" at the end of the
      tail list when that list exceeded the limits of the specified pp_params.

    Rename one of the moved types along with its function symbols,
    to reduce ambiguity.

    Put arrays before their indexes in the argument lists of some of
    the moved functions.

    Some of the moved X_to_doc functions for compound types returned
    a doc that had an indent wrapper. These indents differed between the
    various X_to_doc functions without any visible reason, but they are
    also redundant. The callers can trivially add such wrappers if they
    want to, but taking them off, if they want them off, is harder.
    Eliminate the problem by deleting all such indent wrappers.

    Add formatters for the intN, uintN and one_or_more types to the
    default formatter map. Their previous absence was an oversight.

    Add a function, get_formatter_map_entry_types, that returns the ids
    of the types in the formatter_map given to the function. It is intended
    for tests/hard_coded/test_pretty_printer_defaults.m, but is exported
    for anyone to use.

tests/hard_coded/test_pretty_printer_defaults.{m,exp}:
    Use get_formatter_map_entry_types to print the default formatter map
    in a format that is much more easily readable.

NEWS:
    Announce all the user-visible changes above.
2022-12-27 18:27:52 +11:00

510 lines
13 KiB
Mathematica
Raw Blame History

%---------------------------------------------------------------------------%
% vim: ft=mercury ts=4 sw=4 et
%---------------------------------------------------------------------------%
% Copyright (C) 2016-2021 The Mercury team.
% This file is distributed under the terms specified in COPYING.LIB.
%---------------------------------------------------------------------------%
%
% File: uint.m
% Main author: juliensf
% Stability: low.
%
% Predicates and functions for dealing with unsigned machine sized integer
% numbers.
%
%---------------------------------------------------------------------------%
:- module uint.
:- interface.
:- import_module enum.
:- import_module pretty_printer.
%---------------------------------------------------------------------------%
:- instance uenum(uint).
%---------------------------------------------------------------------------%
% Convert an int to a uint.
% Fails if the int is less than zero.
%
:- pred from_int(int::in, uint::out) is semidet.
% As above, but throw an exception instead of failing.
%
:- func det_from_int(int) = uint.
:- func cast_from_int(int) = uint.
:- func cast_to_int(uint) = int.
% Less than.
%
:- pred (uint::in) < (uint::in) is semidet.
% Greater than.
%
:- pred (uint::in) > (uint::in) is semidet.
% Less than or equal.
%
:- pred (uint::in) =< (uint::in) is semidet.
% Greater than or equal.
%
:- pred (uint::in) >= (uint::in) is semidet.
% Maximum.
%
:- func max(uint, uint) = uint.
% Minimum.
%
:- func min(uint, uint) = uint.
% Addition.
%
:- func uint + uint = uint.
:- mode in + in = uo is det.
:- mode uo + in = in is det.
:- mode in + uo = in is det.
:- func plus(uint, uint) = uint.
% Subtraction.
%
:- func uint - uint = uint.
:- mode in - in = uo is det.
:- mode uo - in = in is det.
:- mode in - uo = in is det.
:- func minus(uint, uint) = uint.
% Multiplication.
%
:- func (uint::in) * (uint::in) = (uint::uo) is det.
:- func times(uint, uint) = uint.
% Truncating integer division.
%
% Throws a `domain_error' exception if the right operand is zero.
%
:- func (uint::in) div (uint::in) = (uint::uo) is det.
% Truncating integer division.
%
% Throws a `domain_error' exception if the right operand is zero.
%
:- func (uint::in) // (uint::in) = (uint::uo) is det.
% (/)/2 is a synonym for (//)/2.
%
:- func (uint::in) / (uint::in) = (uint::uo) is det.
% unchecked_quotient(X, Y) is the same as X // Y, but the behaviour
% is undefined if the right operand is zero.
%
:- func unchecked_quotient(uint::in, uint::in) = (uint::uo) is det.
% Modulus.
% X mod Y = X - (X div Y) * Y
%
% Throws a `domain_error' exception if the right operand is zero.
%
:- func (uint::in) mod (uint::in) = (uint::uo) is det.
% Remainder.
% X rem Y = X - (X // Y) * Y.
%
% Throws a `domain_error/` exception if the right operand is zero.
%
:- func (uint::in) rem (uint::in) = (uint::uo) is det.
% unchecked_rem(X, Y) is the same as X rem Y, but the behaviour is
% undefined if the right operand is zero.
%
:- func unchecked_rem(uint::in, uint::in) = (uint::uo) is det.
% Left shift.
% X << Y returns X "left shifted" by Y bits.
% The bit positions vacated by the shift are filled by zeros.
% Throws an exception if Y is not in [0, bits_per_uint).
%
:- func (uint::in) << (int::in) = (uint::uo) is det.
:- func (uint::in) <<u (uint::in) = (uint::uo) is det.
% unchecked_left_shift(X, Y) is the same as X << Y except that the
% behaviour is undefined if Y is not in [0, bits_per_uint).
% It will typically be implemented more efficiently than X << Y.
%
:- func unchecked_left_shift(uint::in, int::in) = (uint::uo) is det.
:- func unchecked_left_ushift(uint::in, uint::in) = (uint::uo) is det.
% Right shift.
% X >> Y returns X "right shifted" by Y bits.
% The bit positions vacated by the shift are filled by zeros.
% Throws an exception if Y is not in [0, bits_per_uint).
%
:- func (uint::in) >> (int::in) = (uint::uo) is det.
:- func (uint::in) >>u (uint::in) = (uint::uo) is det.
% unchecked_right_shift(X, Y) is the same as X >> Y except that the
% behaviour is undefined if Y is not in [0, bits_per_uint).
% It will typically be implemented more efficiently than X >> Y.
%
:- func unchecked_right_shift(uint::in, int::in) = (uint::uo) is det.
:- func unchecked_right_ushift(uint::in, uint::in) = (uint::uo) is det.
% even(X) is equivalent to (X mod 2 = 0).
%
:- pred even(uint::in) is semidet.
% odd(X) is equivalent to (not even(X)), i.e. (X mod 2 = 1).
%
:- pred odd(uint::in) is semidet.
% Bitwise and.
%
:- func (uint::in) /\ (uint::in) = (uint::uo) is det.
% Bitwise or.
%
:- func (uint::in) \/ (uint::in) = (uint::uo) is det.
% Bitwise exclusive or (xor).
%
:- func xor(uint, uint) = uint.
:- mode xor(in, in) = uo is det.
:- mode xor(in, uo) = in is det.
:- mode xor(uo, in) = in is det.
% Bitwise complement.
%
:- func \ (uint::in) = (uint::uo) is det.
% max_uint is the maximum value of a uint on this machine.
%
:- func max_uint = uint.
% [u]bits_per_uint is the number of bits in a uint on this machine.
%
:- func bits_per_uint = int.
:- func ubits_per_uint = uint.
% Convert a uint to a pretty_printer.doc for formatting.
%
:- func uint_to_doc(uint) = pretty_printer.doc.
:- pragma obsolete(func(uint_to_doc/1), [pretty_printer.uint_to_doc/1]).
%---------------------------------------------------------------------------%
%
% Computing hashes of uints.
%
% Compute a hash value for a uint.
%
:- func hash(uint) = int.
:- pred hash(uint::in, int::out) is det.
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
:- implementation.
:- import_module exception.
:- import_module require.
%---------------------------------------------------------------------------%
:- instance uenum(uint) where [
to_uint(X) = X,
from_uint(X, X)
].
%---------------------------------------------------------------------------%
:- pragma foreign_proc("C",
from_int(I::in, U::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
"
if (I < 0) {
SUCCESS_INDICATOR = MR_FALSE;
} else {
U = (MR_Unsigned) I;
SUCCESS_INDICATOR = MR_TRUE;
}
").
:- pragma foreign_proc("C#",
from_int(I::in, U::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
U = (uint) I;
SUCCESS_INDICATOR = (I < 0) ? false : true;
").
:- pragma foreign_proc("Java",
from_int(I::in, U::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
U = I;
SUCCESS_INDICATOR = (I < 0) ? false : true;
").
det_from_int(I) = U :-
( if from_int(I, UPrime) then
U = UPrime
else
error($pred, "cannot convert int to uint")
).
%---------------------------------------------------------------------------%
:- pragma foreign_proc("C",
cast_from_int(I::in) = (U::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness],
"
U = (MR_Unsigned) I;
").
:- pragma foreign_proc("C#",
cast_from_int(I::in) = (U::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
U = (uint) I;
").
:- pragma foreign_proc("Java",
cast_from_int(I::in) = (U::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
U = I;
").
%---------------------------------------------------------------------------%
:- pragma foreign_proc("C",
cast_to_int(U::in) = (I::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness],
"
I = (MR_Integer) U;
").
:- pragma foreign_proc("C#",
cast_to_int(U::in) = (I::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
I = (int) U;
").
:- pragma foreign_proc("Java",
cast_to_int(U::in) = (I::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
I = U;
").
%---------------------------------------------------------------------------%
max(X, Y) =
( if X > Y then X else Y ).
min(X, Y) =
( if X < Y then X else Y ).
%---------------------------------------------------------------------------%
X div Y = X // Y.
:- pragma inline(func('//'/2)).
X // Y = Div :-
( if Y = 0u then
throw(domain_error("uint.'//': division by zero"))
else
Div = unchecked_quotient(X, Y)
).
:- pragma inline(func('/'/2)).
X / Y = X // Y.
X mod Y = X rem Y.
:- pragma inline(func(rem/2)).
X rem Y = Rem :-
( if Y = 0u then
throw(domain_error("uint.rem: division by zero"))
else
Rem = unchecked_rem(X, Y)
).
%---------------------------------------------------------------------------%
X << Y = Result :-
( if cast_from_int(Y) < ubits_per_uint then
Result = unchecked_left_shift(X, Y)
else
Msg = "uint.(<<): second operand is out of range",
throw(domain_error(Msg))
).
X <<u Y = Result :-
( if Y < ubits_per_uint then
Result = unchecked_left_ushift(X, Y)
else
Msg = "uint.(<<u): second operand is out of range",
throw(domain_error(Msg))
).
X >> Y = Result :-
( if cast_from_int(Y) < ubits_per_uint then
Result = unchecked_right_shift(X, Y)
else
Msg = "uint.(>>): second operand is out of range",
throw(domain_error(Msg))
).
X >>u Y = Result :-
( if Y < ubits_per_uint then
Result = unchecked_right_ushift(X, Y)
else
Msg = "uint.(>>u): second operand is out of range",
throw(domain_error(Msg))
).
%---------------------------------------------------------------------------%
:- pragma inline(pred(even/1)).
even(X) :-
(X /\ 1u) = 0u.
:- pragma inline(pred(odd/1)).
odd(X) :-
(X /\ 1u) \= 0u.
%---------------------------------------------------------------------------%
:- pragma foreign_decl("C", "
#include <limits.h>
#define ML_BITS_PER_UINT (sizeof(MR_Unsigned) * CHAR_BIT)
").
:- pragma foreign_proc("C",
max_uint = (Max::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
if (sizeof(MR_Unsigned) == sizeof(unsigned int)) {
Max = UINT_MAX;
} else if (sizeof(MR_Unsigned) == sizeof(unsigned long)) {
Max = (MR_Unsigned) ULONG_MAX;
#if defined(ULLONG_MAX)
} else if (sizeof(MR_Unsigned) == sizeof(unsigned long long)) {
Max = (MR_Unsigned) ULLONG_MAX;
#endif
} else {
MR_fatal_error(""Unable to figure out max uint size"");
}
").
:- pragma foreign_proc("C#",
max_uint = (U::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
U = uint.MaxValue;
").
:- pragma foreign_proc("Java",
max_uint = (U::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
U = 0xffffffff;
").
:- pragma foreign_proc("C",
bits_per_uint = (Bits::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness],
"
Bits = ML_BITS_PER_UINT;
").
:- pragma foreign_proc("Java",
bits_per_uint = (Bits::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Bits = 32;
").
:- pragma foreign_proc("C#",
bits_per_uint = (Bits::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Bits = 32;
").
:- pragma foreign_proc("C",
ubits_per_uint = (Bits::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness],
"
Bits = (MR_Unsigned) ML_BITS_PER_UINT;
").
:- pragma foreign_proc("Java",
ubits_per_uint = (Bits::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Bits = 32;
").
:- pragma foreign_proc("C#",
ubits_per_uint = (Bits::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Bits = 32;
").
%---------------------------------------------------------------------------%
uint_to_doc(U) = pretty_printer.uint_to_doc(U).
%---------------------------------------------------------------------------%
% The integer hash functions below are originally from:
%
% http://www.concentric.net/~Ttwang/tech/inthash.htm
%
% The above link is now dead; the last version can be found at:
%
% https://web.archive.org/web/20121102023700/http://www.concentric.net/~Ttwang/tech/inthash.htm
%
% The algorithms from that page that we use are:
%
% public int hash32shiftmult(int key)
% public long hash64shift(long key)
hash(!.Key) = Hash :-
C2 = 0x_27d4_eb2d_u, % A prime or odd constant.
( if ubits_per_uint = 32u then
!:Key = (!.Key `xor` 61_u) `xor` (!.Key >> 16),
!:Key = !.Key + (!.Key << 3),
!:Key = !.Key `xor` (!.Key >> 4),
!:Key = !.Key * C2,
!:Key = !.Key `xor` (!.Key >> 15)
else
!:Key = (\ !.Key) + (!.Key << 21), % !:Key = (!.Key << 21) - !.Key - 1
!:Key = !.Key `xor` (!.Key >> 24),
!:Key = (!.Key + (!.Key << 3)) + (!.Key << 8), % !.Key * 265
!:Key = !.Key `xor` (!.Key >> 14),
!:Key = (!.Key + (!.Key << 2)) + (!.Key << 4), % !.Key * 21
!:Key = !.Key `xor` (!.Key >> 28),
!:Key = !.Key + (!.Key << 31)
),
Hash = uint.cast_to_int(!.Key).
hash(UInt, Hash) :-
Hash = hash(UInt).
%---------------------------------------------------------------------------%
:- end_module uint.
%---------------------------------------------------------------------------%
Reference in New Issue View Git Blame Copy Permalink