[m-rev.] for review: add a builtin unsigned word sized integer type -- Part 2.
jfischer at opturion.com
jfischer at opturion.com
Thu Oct 27 01:17:44 AEDT 2016
Part 1 has now been committed and is available in rotd-2016-10-26. I will
wait until next week before committing anything that depends on it.
----------------
For review by anyone.
Add a builtin unsigned word sized integer type -- Part 2.
Being implementing library support for uints.
Update the compiler to use the uint type.
library/uint.m:
Begin filling this module in.
library/private_builtin.m:
Use the proper argument type for builtin_{unify,compare}_uint
and provide actual implementations for them.
library/table_builtin.m:
Add tabling builtins for uints.
library/string.m:
Add a function to convert a uint to a decimal string.
(XXX NYI for Erlang).
library/io.m:
Add write_uint/[45].
Add the stream instance for uints and text output streams.
library/stream.string_writer.m:
Add put_uint/4.
Support uints in string_writer.write etc.
library/pprint.m:
Make uint an instance of the doc/1 type class.
library/pretty_printer.m:
Add a default formatter for uints.
library/int.m:
Unrelated change: fix formatting.
compiler/builtin_ops.m:
compiler/elds.m:
compiler/elds_to_erlang.m:
compiler/hlds_data.m:
compiler/llds.m:
compiler/llds_out_data.m:
compiler/mercury_to_mercury.m:
compiler/ml_lookup_switch.m:
compiler/mlds.m:
compiler/mlds_to_c.m:
compiler/mlds_to_cs.m:
compiler/opt_debug.m
compiler/parse_tree_out.m:
compiler/parse_tree_out_info.m:
compiler/prog_data.m:
compiler/prog_out.m:
compiler/prog_rep.m:
compiler/hlds_out_util.m:
Use the uint type in places where we should.
compiler/mlds_to_java.m:
Fix a bug that causes us to generate badly typed Java.
For div and mod we need to cast the entire expression to
an int, not just the first operand.
compiler/c_util.m:
compiler/mlds_to_cs.m:
Add predicates for outputting unsigned integers in C and C#.
tests/hard_coded/test_pretty_printer_defaults.exp:
Conform to the above change to the pretty_printer module.
Julien.
diff --git a/compiler/builtin_ops.m b/compiler/builtin_ops.m
index ee57c0f..356f0b8 100644
--- a/compiler/builtin_ops.m
+++ b/compiler/builtin_ops.m
@@ -182,7 +182,7 @@
:- type simple_expr(T)
---> leaf(T)
; int_const(int)
- ; uint_const(int) % XXX until uint is recognised.
+ ; uint_const(uint)
; float_const(float)
; unary(unary_op, simple_expr(T))
; binary(binary_op, simple_expr(T), simple_expr(T)).
diff --git a/compiler/c_util.m b/compiler/c_util.m
index 3d13d0e..90fb6a1 100644
--- a/compiler/c_util.m
+++ b/compiler/c_util.m
@@ -178,6 +178,12 @@
io::di, io::uo) is det.
:- pred output_int_expr_cur_stream(int::in, io::di, io::uo) is det.
+ % Write out a uint as a C expression.
+ %
+:- pred output_uint_expr(io.text_output_stream::in, uint::in,
+ io::di, io::uo) is det.
+:- pred output_uint_expr_cur_stream(uint::in, io::di, io::uo) is det.
+
%---------------------------------------------------------------------------%
%
% Float literals.
@@ -760,6 +766,19 @@ output_int_expr_cur_stream(N, !IO) :-
%---------------------------------------------------------------------------%
%
+% Unsigned integer literals.
+%
+
+output_uint_expr(Stream, N, !IO) :-
+ io.write_uint(Stream, N, !IO),
+ io.write_string(Stream, "U", !IO).
+
+output_uint_expr_cur_stream(N, !IO) :-
+ io.output_stream(Stream, !IO),
+ output_uint_expr(Stream, N, !IO).
+
+%---------------------------------------------------------------------------%
+%
% Floating point literals.
%
% XXX These routines do not yet handle infinities and NaNs properly.
diff --git a/compiler/elds.m b/compiler/elds.m
index b01e4a5..4c84090 100644
--- a/compiler/elds.m
+++ b/compiler/elds.m
@@ -214,7 +214,7 @@
:- type elds_term
---> elds_char(char)
; elds_int(int)
- ; elds_uint(int) % XXX UINT.
+ ; elds_uint(uint)
; elds_float(float)
; elds_binary(string)
diff --git a/compiler/elds_to_erlang.m b/compiler/elds_to_erlang.m
index 2993540..ce00778 100644
--- a/compiler/elds_to_erlang.m
+++ b/compiler/elds_to_erlang.m
@@ -779,7 +779,7 @@ output_term(ModuleInfo, VarSet, Indent, Term, !IO) :-
space(!IO)
;
Term = elds_uint(UInt),
- io.write_int(UInt, !IO), % XXX UINT.
+ io.write_uint(UInt, !IO),
space(!IO)
;
Term = elds_float(Float),
diff --git a/compiler/hlds_data.m b/compiler/hlds_data.m
index a33fa31..f1b62a0 100644
--- a/compiler/hlds_data.m
+++ b/compiler/hlds_data.m
@@ -597,7 +597,7 @@ cons_table_optimize(!ConsTable) :-
% the specified integer value. This is used for enumerations and
% character constants as well as for int constants.
- ; uint_tag(int) % XXX UINT
+ ; uint_tag(uint)
% This means the constant is represented just as a word containing
% the specified unsigned integer value. This is used for uint
% constants.
diff --git a/compiler/hlds_out_util.m b/compiler/hlds_out_util.m
index 13e3ff4..3e0140f 100644
--- a/compiler/hlds_out_util.m
+++ b/compiler/hlds_out_util.m
@@ -673,9 +673,11 @@ functor_cons_id_to_string(ModuleInfo, VarSet, VarNamePrint, ConsId, ArgVars)
Str = functor_to_string(VarSet, VarNamePrint,
term.integer(Int), ArgVars)
;
- ConsId = uint_const(UInt), % XXX UINT.
- Str = functor_to_string(VarSet, VarNamePrint,
- term.integer(UInt), ArgVars)
+ ConsId = uint_const(UInt),
+ Str = uint_to_string(UInt)
+ % XXX UINT - need to extend term module to handle uints.
+ %Str = functor_to_string(VarSet, VarNamePrint,
+ % term.integer(UInt), ArgVars)
;
ConsId = float_const(Float),
Str = functor_to_string(VarSet, VarNamePrint,
@@ -832,7 +834,7 @@ cons_id_and_vars_or_arity_to_string(VarSet, Qual, ConsId, MaybeArgVars)
string.int_to_string(Int, String)
;
ConsId = uint_const(UInt),
- string.int_to_string(UInt, String) % XXX UINT.
+ String = uint_to_string(UInt)
;
ConsId = float_const(Float),
String = float_to_string(Float)
diff --git a/compiler/llds.m b/compiler/llds.m
index 503c59a..a6366eb 100644
--- a/compiler/llds.m
+++ b/compiler/llds.m
@@ -1202,7 +1202,7 @@
---> llconst_true
; llconst_false
; llconst_int(int)
- ; llconst_uint(int) % XXX UINT.
+ ; llconst_uint(uint)
; llconst_foreign(string, llds_type)
% A constant in the target language.
% It may be a #defined constant in C which is why
diff --git a/compiler/llds_out_data.m b/compiler/llds_out_data.m
index cc1d60b..f214136 100644
--- a/compiler/llds_out_data.m
+++ b/compiler/llds_out_data.m
@@ -1198,8 +1198,8 @@ output_rval_const(Info, Const, !IO) :-
Const = llconst_int(N),
c_util.output_int_expr_cur_stream(N, !IO)
;
- Const = llconst_uint(N), % XXX UINT.
- c_util.output_int_expr_cur_stream(N, !IO)
+ Const = llconst_uint(N),
+ c_util.output_uint_expr_cur_stream(N, !IO)
;
Const = llconst_foreign(Value, Type),
io.write_char('(', !IO),
diff --git a/compiler/mercury_to_mercury.m b/compiler/mercury_to_mercury.m
index 8889a8a..b8ff0f7 100644
--- a/compiler/mercury_to_mercury.m
+++ b/compiler/mercury_to_mercury.m
@@ -265,7 +265,7 @@ mercury_format_cons_id(NeedsBrackets, ConsId, !U) :-
add_int(Int, !U)
;
ConsId = uint_const(UInt),
- add_int(UInt, !U) % XXX UINT.
+ add_uint(UInt, !U)
;
ConsId = float_const(Float),
add_float(Float, !U)
diff --git a/compiler/ml_lookup_switch.m b/compiler/ml_lookup_switch.m
index b8c99f5..4a8007c 100644
--- a/compiler/ml_lookup_switch.m
+++ b/compiler/ml_lookup_switch.m
@@ -138,6 +138,7 @@
:- import_module int.
:- import_module pair.
:- import_module require.
+:- import_module uint.
%-----------------------------------------------------------------------------%
@@ -825,7 +826,8 @@ ml_default_value_for_type(MLDS_Type) = DefaultRval :-
DefaultRval = ml_const(mlconst_int(0))
;
MLDS_Type = mlds_native_uint_type,
- DefaultRval = ml_const(mlconst_uint(0))
+ % XXX UINT - replace the cast when we have uint literals.
+ DefaultRval = ml_const(mlconst_uint(cast_from_int(0)))
;
MLDS_Type = mlds_native_char_type,
DefaultRval = ml_const(mlconst_char(0))
diff --git a/compiler/mlds.m b/compiler/mlds.m
index f9238b9..483a232 100644
--- a/compiler/mlds.m
+++ b/compiler/mlds.m
@@ -1679,7 +1679,7 @@
---> mlconst_true
; mlconst_false
; mlconst_int(int)
- ; mlconst_uint(int) % XXX UINT.
+ ; mlconst_uint(uint)
; mlconst_enum(int, mlds_type)
; mlconst_char(int)
; mlconst_float(float)
diff --git a/compiler/mlds_to_c.m b/compiler/mlds_to_c.m
index 903821e..7a110d1 100644
--- a/compiler/mlds_to_c.m
+++ b/compiler/mlds_to_c.m
@@ -4686,7 +4686,7 @@ mlds_output_rval_const(_Opts, Const, !IO) :-
c_util.output_int_expr_cur_stream(N, !IO)
;
Const = mlconst_uint(U),
- c_util.output_int_expr_cur_stream(U, !IO) % XXX UINT.
+ c_util.output_uint_expr_cur_stream(U, !IO)
;
Const = mlconst_char(C),
io.write_string("(MR_Char) ", !IO),
diff --git a/compiler/mlds_to_cs.m b/compiler/mlds_to_cs.m
index bb09c3c..7fd4649 100644
--- a/compiler/mlds_to_cs.m
+++ b/compiler/mlds_to_cs.m
@@ -3812,7 +3812,7 @@ output_rval_const(Info, Const, !IO) :-
output_int_const(N, !IO)
;
Const = mlconst_uint(U),
- output_int_const(U, !IO) % XXX UINT.
+ output_uint_const(U, !IO)
;
Const = mlconst_char(N),
io.write_string("( ", !IO),
@@ -3881,6 +3881,12 @@ output_int_const(N, !IO) :-
io.write_int(N, !IO)
).
+:- pred output_uint_const(uint::in, io::di, io::uo) is det.
+
+output_uint_const(U, !IO) :-
+ io.write_uint(U, !IO),
+ io.write_string("U", !IO).
+
:- pred output_vector_common_row_rval(csharp_out_info::in,
mlds_vector_common::in, mlds_rval::in, io::di, io::uo) is det.
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index 9aae840..283b071 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -127,6 +127,7 @@
:- import_module set.
:- import_module string.
:- import_module term.
+:- import_module uint.
:- import_module varset.
%-----------------------------------------------------------------------------%
@@ -5159,13 +5160,13 @@ output_binop(Info, Op, X, Y, !IO) :-
( Op = uint_div
; Op = uint_mod
),
- io.write_string("((int)((", !IO),
+ io.write_string("((int)(((", !IO),
output_rval(Info, X, !IO),
io.write_string(") & 0xffffffffL) ", !IO),
output_binary_op(Op, !IO),
io.write_string(" ((", !IO),
output_rval(Info, Y, !IO),
- io.write_string(") & 0xffffffffL))", !IO)
+ io.write_string(") & 0xffffffffL)))", !IO)
).
% Output an Rval and if the Rval is an enumeration object append the string
@@ -5285,7 +5286,9 @@ output_rval_const(Info, Const, !IO) :-
output_int_const(N, !IO)
;
Const = mlconst_uint(U),
- output_int_const(U, !IO) % XXX UINT.
+ % Java does not have unsigned integer literals.
+ % XXX perhaps we should output this in hexadecimal?
+ output_int_const(uint.cast_to_int(U), !IO)
;
Const = mlconst_char(N),
io.write_string("(", !IO),
diff --git a/compiler/opt_debug.m b/compiler/opt_debug.m
index efad811..1458e8a 100644
--- a/compiler/opt_debug.m
+++ b/compiler/opt_debug.m
@@ -442,7 +442,7 @@ dump_const(MaybeProcLabel, Const) = Str :-
Str = int_to_string(I)
;
Const = llconst_uint(U),
- Str = int_to_string(U) % XXX UINT.
+ Str = uint_to_string(U)
;
Const = llconst_foreign(F, _),
Str = F
diff --git a/compiler/parse_tree_out_info.m b/compiler/parse_tree_out_info.m
index e61532b..2ffc617 100644
--- a/compiler/parse_tree_out_info.m
+++ b/compiler/parse_tree_out_info.m
@@ -106,6 +106,7 @@
pred add_strings(list(string)::in, U::di, U::uo) is det,
pred add_char(char::in, U::di, U::uo) is det,
pred add_int(int::in, U::di, U::uo) is det,
+ pred add_uint(uint::in, U::di, U::uo) is det,
pred add_float(float::in, U::di, U::uo) is det,
pred add_purity_prefix(purity::in, U::di, U::uo) is det,
pred add_quoted_atom(string::in, U::di, U::uo) is det,
@@ -190,6 +191,7 @@ maybe_unqualify_sym_name(Info, SymName, OutSymName) :-
pred(add_strings/3) is io.write_strings,
pred(add_char/3) is io.write_char,
pred(add_int/3) is io.write_int,
+ pred(add_uint/3) is io.write_uint, % XXX UINT - literal syntax.
pred(add_float/3) is io.write_float,
pred(add_purity_prefix/3) is prog_out.write_purity_prefix,
pred(add_quoted_atom/3) is term_io.quote_atom,
@@ -207,6 +209,7 @@ maybe_unqualify_sym_name(Info, SymName, OutSymName) :-
pred(add_strings/3) is output_strings,
pred(add_char/3) is output_char,
pred(add_int/3) is output_int,
+ pred(add_uint/3) is output_uint,
pred(add_float/3) is output_float,
pred(add_purity_prefix/3) is output_purity_prefix,
pred(add_quoted_atom/3) is output_quoted_atom,
@@ -258,6 +261,13 @@ output_int(I, Str0, Str) :-
string.int_to_string(I, S),
string.append(Str0, S, Str).
+:- pred output_uint(uint::in, string::di, string::uo) is det.
+
+output_uint(U, Str0, Str) :-
+ % XXX UINT - literal syntax.
+ S = uint_to_string(U),
+ string.append(Str0, S, Str).
+
:- pred output_float(float::in, string::di, string::uo) is det.
output_float(F, Str0, Str) :-
diff --git a/compiler/prog_data.m b/compiler/prog_data.m
index b926045..6ec7923 100644
--- a/compiler/prog_data.m
+++ b/compiler/prog_data.m
@@ -106,7 +106,7 @@
% XXX We should have a pred_or_func field as well.
; int_const(int)
- ; uint_const(int) % XXX until uint is bootstrapped.
+ ; uint_const(uint)
; float_const(float)
; char_const(char)
; string_const(string)
diff --git a/compiler/prog_out.m b/compiler/prog_out.m
index 282862e..b2f533a 100644
--- a/compiler/prog_out.m
+++ b/compiler/prog_out.m
@@ -339,8 +339,8 @@ cons_id_and_arity_to_string_maybe_quoted(QuoteCons, ConsId) = String :-
ConsId = int_const(Int),
string.int_to_string(Int, String)
;
- ConsId = uint_const(UInt), % XXX UINT.
- string.int_to_string(UInt, String)
+ ConsId = uint_const(UInt),
+ String = uint_to_string(UInt)
;
ConsId = float_const(Float),
String = float_to_string(Float)
diff --git a/compiler/prog_rep.m b/compiler/prog_rep.m
index e9c95ab..2417e4f 100644
--- a/compiler/prog_rep.m
+++ b/compiler/prog_rep.m
@@ -870,7 +870,7 @@ cons_id_rep(cons(SymName, _, _)) =
prog_rep.sym_base_name_to_string(SymName).
cons_id_rep(tuple_cons(_)) = "{}".
cons_id_rep(int_const(Int)) = string.int_to_string(Int).
-cons_id_rep(uint_const(UInt)) = string.int_to_string(UInt). % XXX UINT.
+cons_id_rep(uint_const(UInt)) = string.uint_to_string(UInt).
cons_id_rep(float_const(Float)) = string.float_to_string(Float).
cons_id_rep(char_const(Char)) = string.char_to_string(Char).
cons_id_rep(string_const(String)) = """" ++ String ++ """".
diff --git a/library/int.m b/library/int.m
index ae28d7b..b523043 100644
--- a/library/int.m
+++ b/library/int.m
@@ -620,11 +620,11 @@ X >> Y = Z :-
).
:- pragma inline(even/1).
-even(X):-
+even(X) :-
(X /\ 1) = 0.
:- pragma inline(odd/1).
-odd(X):-
+odd(X) :-
(X /\ 1) \= 0.
abs(Num) = Abs :-
diff --git a/library/io.m b/library/io.m
index 8d4517a..c39b863 100644
--- a/library/io.m
+++ b/library/io.m
@@ -497,6 +497,12 @@
:- pred write_int(int::in, io::di, io::uo) is det.
:- pred write_int(io.text_output_stream::in, int::in, io::di, io::uo) is det.
+ % Writes an unsigned integer to the current output stream
+ % or to the specified output stream.
+ %
+:- pred write_uint(uint::in, io::di, io::uo) is det.
+:- pred write_uint(io.text_output_stream::in, uint::in, io::di, io::uo) is det.
+
% Writes a floating point number to the current output stream
% or to the specified output stream.
%
@@ -1516,6 +1522,7 @@
:- instance stream.writer(text_output_stream, char, io).
:- instance stream.writer(text_output_stream, float, io).
:- instance stream.writer(text_output_stream, int, io).
+:- instance stream.writer(text_output_stream, uint, io).
:- instance stream.writer(text_output_stream, string, io).
:- instance stream.writer(text_output_stream, univ, io).
:- instance stream.line_oriented(text_output_stream, io).
@@ -7754,6 +7761,10 @@ write_int(Val, !IO) :-
output_stream(Stream, !IO),
write_int(Stream, Val, !IO).
+write_uint(Val, !IO) :-
+ output_stream(Stream, !IO),
+ write_uint(Stream, Val, !IO).
+
write_float(Val, !IO) :-
output_stream(Stream, !IO),
write_float(Stream, Val, !IO).
@@ -7930,6 +7941,24 @@ write_int(output_stream(Stream), Val, !IO) :-
}
").
+write_uint(output_stream(Stream), Val, !IO) :-
+ write_uint_2(Stream, Val, Error, !IO),
+ throw_on_output_error(Error, !IO).
+
+:- pred write_uint_2(stream::in, uint::in, system_error::out, io::di, io::uo)
+ is det.
+:- pragma foreign_proc("C",
+ write_uint_2(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe,
+ does_not_affect_liveness, no_sharing],
+"
+ if (ML_fprintf(Stream, ""%"" MR_INTEGER_LENGTH_MODIFIER ""u"", Val) < 0) {
+ Error = errno;
+ } else {
+ Error = 0;
+ }
+").
+
write_float(output_stream(Stream), Val, !IO) :-
write_float_2(Stream, Val, Error, !IO),
throw_on_output_error(Error, !IO).
@@ -8148,6 +8177,18 @@ flush_binary_output(binary_output_stream(Stream), !IO) :-
").
:- pragma foreign_proc("C#",
+ write_uint_2(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
+"
+ try {
+ io.mercury_print_string(Stream, Val.ToString());
+ Error = null;
+ } catch (System.SystemException e) {
+ Error = e;
+ }
+").
+
+:- pragma foreign_proc("C#",
write_byte_2(Stream::in, Byte::in, Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
"
@@ -8250,6 +8291,19 @@ flush_binary_output(binary_output_stream(Stream), !IO) :-
").
:- pragma foreign_proc("Java",
+ write_uint_2(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"
+ try {
+ ((io.MR_TextOutputFile) Stream).write(
+ java.lang.Long.toString(Val & 0xffffffffL));
+ Error = null;
+ } catch (java.io.IOException e) {
+ Error = e;
+ }
+").
+
+:- pragma foreign_proc("Java",
write_float_2(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
"
@@ -8361,6 +8415,15 @@ flush_binary_output(binary_output_stream(Stream), !IO) :-
").
:- pragma foreign_proc("Erlang",
+ write_uint_2(Stream::in, Val::in, Error::out, _IO0::di, _IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"
+ mercury__io:mercury_write_int(Stream, Val),
+ % mercury_write_int does not return errors yet.
+ Error = ok
+").
+
+:- pragma foreign_proc("Erlang",
write_string_2(Stream::in, Message::in, Error::out, _IO0::di, _IO::uo),
[will_not_call_mercury, promise_pure, thread_safe, tabled_for_io],
"
@@ -11178,6 +11241,12 @@ result_to_stream_result(error(Error)) = error(Error).
pred(put/4) is write_int
].
+:- instance stream.writer(output_stream, uint, io)
+ where
+[
+ pred(put/4) is write_uint
+].
+
:- instance stream.writer(output_stream, string, io)
where
[
diff --git a/library/pprint.m b/library/pprint.m
index a215737..99e4716 100644
--- a/library/pprint.m
+++ b/library/pprint.m
@@ -186,6 +186,7 @@
:- instance doc(doc).
:- instance doc(string).
:- instance doc(int).
+:- instance doc(uint).
:- instance doc(float).
:- instance doc(char).
@@ -412,11 +413,12 @@ doc(X) = doc(int.max_int, X).
%---------------------------------------------------------------------------%
-:- instance doc(doc) where [ doc(_, Doc) = Doc ].
-:- instance doc(string) where [ doc(_, String) = text(String) ].
-:- instance doc(int) where [ doc(_, Int) = poly(i(Int)) ].
-:- instance doc(float) where [ doc(_, Float) = poly(f(Float)) ].
-:- instance doc(char) where [ doc(_, Char) = poly(c(Char)) ].
+:- instance doc(doc) where [ doc(_, Doc) = Doc ].
+:- instance doc(string) where [ doc(_, String) = text(String) ].
+:- instance doc(uint) where [ doc(_, UInt) = text(uint_to_string(UInt))].
+:- instance doc(int) where [ doc(_, Int) = poly(i(Int)) ].
+:- instance doc(float) where [ doc(_, Float) = poly(f(Float)) ].
+:- instance doc(char) where [ doc(_, Char) = poly(c(Char)) ].
%---------------------------------------------------------------------------%
diff --git a/library/pretty_printer.m b/library/pretty_printer.m
index 46df96b..320d361 100644
--- a/library/pretty_printer.m
+++ b/library/pretty_printer.m
@@ -302,6 +302,7 @@
:- import_module string.
:- import_module term_io.
:- import_module tree234. % For tree234_to_doc.
+:- import_module uint. % For uint_to_doc.
:- import_module version_array. % For version_array_to_doc.
%---------------------------------------------------------------------------%
@@ -1114,6 +1115,7 @@ initial_formatter_map = !:Formatters :-
set_formatter("builtin", "character", 0, fmt_char, !Formatters),
set_formatter("builtin", "float", 0, fmt_float, !Formatters),
set_formatter("builtin", "int", 0, fmt_int, !Formatters),
+ set_formatter("builtin", "uint", 0, fmt_uint, !Formatters),
set_formatter("builtin", "string", 0, fmt_string, !Formatters),
set_formatter("array", "array", 1, fmt_array, !Formatters),
set_formatter("list", "list", 1, fmt_list, !Formatters),
@@ -1138,6 +1140,11 @@ fmt_float(Univ, _ArgDescs) =
fmt_int(Univ, _ArgDescs) =
( if Univ = univ(X) then int_to_doc(X) else str("?int?") ).
+:- func fmt_uint(univ, list(type_desc)) = doc.
+
+fmt_uint(Univ, _ArgDescs) =
+ ( if Univ = univ(X) then uint_to_doc(X) else str("?uint?") ).
+
:- func fmt_string(univ, list(type_desc)) = doc.
fmt_string(Univ, _ArgDescs) =
diff --git a/library/private_builtin.m b/library/private_builtin.m
index ad73dcc..d70f60b 100644
--- a/library/private_builtin.m
+++ b/library/private_builtin.m
@@ -48,8 +48,8 @@
:- pred builtin_unify_int(int::in, int::in) is semidet.
:- pred builtin_compare_int(comparison_result::uo, int::in, int::in) is det.
-:- pred builtin_unify_uint(T::in, T::in) is semidet.
-:- pred builtin_compare_uint(comparison_result::uo, T::in, T::in) is det.
+:- pred builtin_unify_uint(uint::in, uint::in) is semidet.
+:- pred builtin_compare_uint(comparison_result::uo, uint::in, uint::in) is det.
:- pred builtin_unify_character(character::in, character::in) is semidet.
:- pred builtin_compare_character(comparison_result::uo, character::in,
@@ -136,6 +136,7 @@
:- import_module char.
:- import_module float.
:- import_module int.
+:- import_module uint.
:- import_module require.
:- import_module string.
:- import_module type_desc.
@@ -152,6 +153,7 @@ public static object dummy_var;
").
:- pragma inline(builtin_compare_int/3).
+:- pragma inline(builtin_compare_uint/3).
:- pragma inline(builtin_compare_character/3).
:- pragma inline(builtin_compare_string/3).
:- pragma inline(builtin_compare_float/3).
@@ -167,18 +169,15 @@ builtin_compare_int(R, X, Y) :-
R = (>)
).
-builtin_unify_uint(_, _) :-
- ( if semidet_succeed then
- sorry("unify for uint")
- else
- semidet_succeed
- ).
+builtin_unify_uint(X, X).
-builtin_compare_uint(Result, _, _) :-
- ( if semidet_succeed then
- sorry("compare for uint")
+builtin_compare_uint(R, X, Y) :-
+ ( if X < Y then
+ R = (<)
+ else if X = Y then
+ R = (=)
else
- Result = (=)
+ R = (>)
).
builtin_unify_character(C, C).
diff --git a/library/stream.string_writer.m b/library/stream.string_writer.m
index e572b08..515c460 100644
--- a/library/stream.string_writer.m
+++ b/library/stream.string_writer.m
@@ -29,6 +29,9 @@
:- pred put_int(Stream::in, int::in, State::di, State::uo) is det
<= stream.writer(Stream, string, State).
+:- pred put_uint(Stream::in, uint::in, State::di, State::uo) is det
+ <= stream.writer(Stream, string, State).
+
:- pred put_float(Stream::in, float::in, State::di, State::uo) is det
<= stream.writer(Stream, string, State).
@@ -173,6 +176,7 @@
:- pragma type_spec(write_univ/5,
(Stream = io.output_stream, State = io.state)).
:- pragma type_spec(put_int/4, (Stream = io.output_stream, State = io.state)).
+:- pragma type_spec(put_uint/4, (Stream = io.output_stream, State = io.state)).
:- pragma type_spec(put_float/4, (Stream = io.output_stream, State = io.state)).
:- pragma type_spec(put_char/4, (Stream = io.output_stream, State = io.state)).
@@ -207,6 +211,22 @@ put_int(Stream, Int, !State) :-
put(Stream, string.int_to_string(Int), !State)
).
+put_uint(Stream, UInt, !State) :-
+ ( if
+ % Handle the common I/O case more efficiently.
+ dynamic_cast(!.State, IOState0),
+ dynamic_cast(Stream, IOStream)
+ then
+ io.write_uint(IOStream, UInt, unsafe_promise_unique(IOState0), IOState),
+ ( if dynamic_cast(IOState, !:State) then
+ !:State = unsafe_promise_unique(!.State)
+ else
+ error("stream.string_writer.put_uint: unexpected type error")
+ )
+ else
+ put(Stream, string.uint_to_string(UInt), !State)
+ ).
+
put_float(Stream, Float, !State) :-
( if
% Handle the common I/O case more efficiently.
@@ -365,6 +385,10 @@ do_write_univ_prio(Stream, NonCanon, Univ, Priority, !State) :-
term_io.quote_char(Stream, Char, !State)
else if univ_to_type(Univ, Int) then
put_int(Stream, Int, !State)
+ else if univ_to_type(Univ, UInt) then
+ % XXX UINT -- write should emit an unsigned literal
+ % print should just emit a decimal
+ put_uint(Stream, UInt, !State)
else if univ_to_type(Univ, Float) then
put_float(Stream, Float, !State)
else if univ_to_type(Univ, Bitmap) then
diff --git a/library/string.m b/library/string.m
index 890b743..8b10948 100644
--- a/library/string.m
+++ b/library/string.m
@@ -1232,6 +1232,8 @@
:- func int_to_base_string_group(int, int, int, string) = string.
:- mode int_to_base_string_group(in, in, in, in) = uo is det.
+:- func uint_to_string(uint::in) = (string::uo) is det.
+
% Convert a float to a string.
% In the current implementation, the resulting float will be in the form
% that it was printed using the format string "%#.<prec>g".
@@ -5725,6 +5727,36 @@ int_to_base_string_group_2(NegN, Base, Curr, GroupLength, Sep, Str) :-
%---------------------%
:- pragma foreign_proc("C",
+ uint_to_string(U::in) = (Str::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+ does_not_affect_liveness, no_sharing],
+"
+ char buffer[100];
+ sprintf(buffer, ""%"" MR_INTEGER_LENGTH_MODIFIER ""u"", U);
+ MR_allocate_aligned_string_msg(Str, strlen(buffer), MR_ALLOC_ID);
+ strcpy(Str, buffer);
+").
+
+:- pragma foreign_proc("C#",
+ uint_to_string(U::in) = (Str::uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Str = U.ToString();
+").
+
+:- pragma foreign_proc("Java",
+ uint_to_string(U::in) = (Str::uo),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Str = java.lang.Long.toString(U & 0xffffffffL);
+").
+
+uint_to_string(_) = _ :-
+ sorry($module, "string.uint_to_string/1").
+
+%---------------------%
+
+:- pragma foreign_proc("C",
float_to_string(Flt::in, Str::uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
does_not_affect_liveness, no_sharing],
diff --git a/library/table_builtin.m b/library/table_builtin.m
index 84a066c..a6f6674 100644
--- a/library/table_builtin.m
+++ b/library/table_builtin.m
@@ -1234,6 +1234,11 @@ pretend_to_generate_value(Bogus) :-
:- impure pred table_lookup_insert_int(ml_trie_node::in, int::in,
ml_trie_node::out) is det.
+ % Lookup or insert an unsigned integer in the given table.
+ %
+:- impure pred table_lookup_insert_uint(ml_trie_node::in, uint::in,
+ ml_trie_node::out) is det.
+
% Lookup or insert an integer in the given table.
%
:- impure pred table_lookup_insert_start_int(ml_trie_node::in, int::in,
@@ -1306,6 +1311,12 @@ pretend_to_generate_value(Bogus) :-
:- impure pred table_save_int_answer(ml_answer_block::in, int::in, int::in)
is det.
+ % Save an unsigned integer answer in the given answer block at the given
+ % offset.
+ %
+:- impure pred table_save_uint_answer(ml_answer_block::in, int::in, uint::in)
+ is det.
+
% Save a character answer in the given answer block at the given
% offset.
%
@@ -1341,6 +1352,12 @@ pretend_to_generate_value(Bogus) :-
:- semipure pred table_restore_int_answer(ml_answer_block::in, int::in,
int::out) is det.
+ % Restore an unsigned integer answer from the given answer block at
+ % the given offset.
+ %
+:- semipure pred table_restore_uint_answer(ml_answer_block::in, int::in,
+ uint::out) is det.
+
% Restore a character answer from the given answer block at the
% given offset.
%
@@ -1405,6 +1422,13 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_NAME(io, state, 0));
").
:- pragma foreign_proc("C",
+ table_lookup_insert_uint(T0::in, V::in, T::out),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_lookup_insert_uint(NULL, MR_TABLE_DEBUG_BOOL, MR_FALSE, T0, V, T);
+").
+
+:- pragma foreign_proc("C",
table_lookup_insert_start_int(T0::in, S::in, V::in, T::out),
[will_not_call_mercury, does_not_affect_liveness],
"
@@ -1507,6 +1531,13 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_NAME(io, state, 0));
").
:- pragma foreign_proc("C",
+ table_save_uint_answer(AB::in, Offset::in, V::in),
+ [will_not_call_mercury, does_not_affect_liveness],
+"
+ MR_tbl_save_uint_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
table_save_char_answer(AB::in, Offset::in, V::in),
[will_not_call_mercury, does_not_affect_liveness],
"
@@ -1550,6 +1581,13 @@ MR_DECLARE_TYPE_CTOR_INFO_STRUCT(MR_TYPE_CTOR_INFO_NAME(io, state, 0));
").
:- pragma foreign_proc("C",
+ table_restore_uint_answer(AB::in, Offset::in, V::out),
+ [will_not_call_mercury, promise_semipure, does_not_affect_liveness],
+"
+ MR_tbl_restore_uint_answer(MR_TABLE_DEBUG_BOOL, AB, Offset, V);
+").
+
+:- pragma foreign_proc("C",
table_restore_char_answer(AB::in, Offset::in, V::out),
[will_not_call_mercury, promise_semipure, does_not_affect_liveness],
"
@@ -1600,6 +1638,12 @@ table_lookup_insert_int(_, _, _) :-
impure private_builtin.imp,
private_builtin.sorry("table_lookup_insert_int").
+table_lookup_insert_uint(_, _, _) :-
+ % This version is only used for back-ends for which there is no
+ % matching foreign_proc version.
+ impure private_builtin.imp,
+ private_builtin.sorry("table_lookup_insert_uint").
+
table_lookup_insert_start_int(_, _, _, _) :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
@@ -1660,6 +1704,12 @@ table_save_int_answer(_, _, _) :-
impure private_builtin.imp,
private_builtin.sorry("table_save_int_answer").
+table_save_uint_answer(_, _, _) :-
+ % This version is only used for back-ends for which there is no
+ % matching foreign_proc version.
+ impure private_builtin.imp,
+ private_builtin.sorry("table_save_uint_answer").
+
table_save_char_answer(_, _, _) :-
% This version is only used for back-ends for which there is no
% matching foreign_proc version.
diff --git a/library/uint.m b/library/uint.m
index a89ea25..995a5f6 100644
--- a/library/uint.m
+++ b/library/uint.m
@@ -5,14 +5,298 @@
% 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.
%---------------------------------------------------------------------------%
+%
+% File: uint.m
+% Main author: juliensf
+% Stability: low.
+%
+% Predicates and functions for dealing with unsigned machine sized integer
+% numbers.
+%
+%---------------------------------------------------------------------------%
:- module uint.
:- interface.
- % uints are NYI -- this module is just a placeholder for their
- % library support.
+:- import_module pretty_printer.
+
+%---------------------------------------------------------------------------%
+
+ % 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.
%
-:- type placeholder_uint ---> placeholder_uint.
+:- 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.
+
+ % Addition.
+ %
+:- func (uint::in) + (uint::in) = (uint::uo) is det.
+
+ % Subtraction.
+ %
+:- func (uint::in) - (uint::in) = (uint::uo) is det.
+
+ % Multiplication.
+ %
+:- func (uint::in) * (uint::in) = (uint::uo) is det.
+
+ % Maximum.
+ %
+:- func max(uint, uint) = uint.
+
+ % Minimum.
+ %
+:- func min(uint, uint) = uint.
+
+:- func unchecked_quotient(uint::in, uint::in) = (uint::uo) is det.
+
+:- func unchecked_rem(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::in, uint::in) = (uint::uo) 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.
+
+ % bits_per_uint is the number of bits in a uint on this machine.
+ %
+:- func bits_per_uint = int.
+
+ % Convert a uint to a pretty_printer.doc for formatting.
+ %
+:- func uint_to_doc(uint) = pretty_printer.doc.
+
+%---------------------------------------------------------------------------%
+%---------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module require.
+:- import_module string.
+
+%---------------------------------------------------------------------------%
+
+:- 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, U0)
+ then U = U0
+ else error("uint.det_from_int: 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("Java",
+ cast_from_int(I::in) = (U::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ U = I;
+").
+
+:- pragma foreign_proc("C#",
+ cast_from_int(I::in) = (U::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ U = (uint) I;
+").
+
+cast_from_int(_) = _ :-
+ sorry($module, "uint.cast_from_int/1 NYI for Erlang").
+
+:- 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("Java",
+ cast_to_int(U::in) = (I::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ I = U;
+").
+
+:- pragma foreign_proc("C#",
+ cast_to_int(U::in) = (I::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ I = (int) U;
+").
+
+cast_to_int(_) = _ :-
+ sorry($module, "uint.cast_to_int/1 NYI for Erlang").
+
+%---------------------------------------------------------------------------%
+
+max(X, Y) =
+ ( if X > Y then X else Y ).
+
+min(X, Y) =
+ ( if X < Y then X else Y ).
+
+%---------------------------------------------------------------------------%
+
+:- pragma inline(even/1).
+even(X) :-
+ (X /\ cast_from_int(1)) = cast_from_int(0).
+
+:- pragma inline(odd/1).
+odd(X) :-
+ (X /\ cast_from_int(1)) \= cast_from_int(0).
+
+%---------------------------------------------------------------------------%
+
+:- 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_Integer) == sizeof(int)) {
+ Max = UINT_MAX;
+ } else if (sizeof(MR_Integer) == sizeof(long)) {
+ Max = (MR_Integer) ULONG_MAX;
+ #if defined(ULLONG_MAX)
+ } else if (sizeof(MR_Integer) == sizeof(long long)) {
+ Max = (MR_Integer) 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("Erlang",
+ bits_per_uint = (Bits::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ % XXX Erlang ints are actually arbitrary precision.
+ Bits = 32
+").
+
+%---------------------------------------------------------------------------%
+
+uint_to_doc(X) = str(string.uint_to_string(X)).
%---------------------------------------------------------------------------%
:- end_module uint.
diff --git a/tests/hard_coded/test_pretty_printer_defaults.exp b/tests/hard_coded/test_pretty_printer_defaults.exp
index ee85122..021e08c 100644
--- a/tests/hard_coded/test_pretty_printer_defaults.exp
+++ b/tests/hard_coded/test_pretty_printer_defaults.exp
@@ -1,4 +1,4 @@
-two("builtin", two("float", two(0, '<<function>>', empty, empty), two("character", two(0, '<<function>>', empty, empty), empty, empty), three("int", two(0, '<<function>>', empty, empty), "string", two(0, '<<function>>', empty, empty), empty, empty, empty)), two("array", two("array", two(1, '<<function>>', empty, empty), empty, empty), empty, empty), four("list", two("list", two(1, '<<function>>', empty, empty), empty, empty), "tree234", two("tree234", two(2, '<<function>>', empty, empty), empty, empty), "version_array", two("version_array", two(1, '<<function>>', empty, empty), empty, empty), empty, empty, empty, empty))
+two("builtin", two("float", two(0, '<<function>>', empty, empty), two("character", two(0, '<<function>>', empty, empty), empty, empty), four("int", two(0, '<<function>>', empty, empty), "string", two(0, '<<function>>', empty, empty), "uint", two(0, '<<function>>', empty, empty), empty, empty, empty, empty)), two("array", two("array", two(1, '<<function>>', empty, empty), empty, empty), empty, empty), four("list", two("list", two(1, '<<function>>', empty, empty), empty, empty), "tree234", two("tree234", two(2, '<<function>>', empty, empty), empty, empty), "version_array", two("version_array", two(1, '<<function>>', empty, empty), empty, empty), empty, empty, empty, empty))
list: [1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38,
39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, ...]
More information about the reviews
mailing list