[m-rev.] for review: improvements to bitmap.m [2]
Simon Taylor
staylr at gmail.com
Sun Feb 11 12:04:14 AEDT 2007
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.128
diff -u -u -r1.128 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 19 Jan 2007 07:04:21 -0000 1.128
+++ compiler/mlds_to_gcc.m 8 Feb 2007 12:18:04 -0000
@@ -2511,7 +2511,8 @@
rtti_enum_const("MR_TYPECTOR_REP_STABLE_FOREIGN", 40).
rtti_enum_const("MR_TYPECTOR_REP_PSEUDOTYPEDESC", 41).
rtti_enum_const("MR_TYPECTOR_REP_DUMMY", 42).
-rtti_enum_const("MR_TYPECTOR_REP_UNKNOWN", 43).
+rtti_enum_const("MR_TYPECTOR_REP_BITMAP", 43).
+rtti_enum_const("MR_TYPECTOR_REP_UNKNOWN", 44).
rtti_enum_const("MR_SECTAG_NONE", 0).
rtti_enum_const("MR_SECTAG_LOCAL", 1).
rtti_enum_const("MR_SECTAG_REMOTE", 2).
Index: compiler/prog_type.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_type.m,v
retrieving revision 1.32
diff -u -u -r1.32 prog_type.m
--- compiler/prog_type.m 19 Jan 2007 07:04:28 -0000 1.32
+++ compiler/prog_type.m 8 Feb 2007 12:18:04 -0000
@@ -215,6 +215,8 @@
:- pred type_ctor_is_array(type_ctor::in) is semidet.
+:- pred type_ctor_is_bitmap(type_ctor::in) is semidet.
+
% A test for type_info-related types that are introduced by
% polymorphism.m. These need to be handled specially in certain
% places. For example, mode inference never infers unique modes
@@ -761,6 +763,9 @@
type_ctor_is_array(type_ctor(qualified(unqualified("array"), "array"), 1)).
+type_ctor_is_bitmap(
+ type_ctor(qualified(unqualified("bitmap"), "bitmap"), 0)).
+
is_introduced_type_info_type(Type) :-
type_to_ctor_and_args(Type, TypeCtor, _),
is_introduced_type_info_type_ctor(TypeCtor).
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.79
diff -u -u -r1.79 rtti.m
--- compiler/rtti.m 19 Jan 2007 07:04:30 -0000 1.79
+++ compiler/rtti.m 8 Feb 2007 12:18:04 -0000
@@ -1616,6 +1616,9 @@
% We should allow users to provide tracing functions for
% foreign types.
RepStr = "MR_TYPECTOR_REP_ARRAY"
+ ; type_ctor_is_bitmap(TypeCtor) ->
+ % bitmaps are handled much like strings.
+ RepStr = "MR_TYPECTOR_REP_BITMAP"
;
(
IsStable = is_stable,
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.87
diff -u -u -r1.87 type_ctor_info.m
--- compiler/type_ctor_info.m 19 Jan 2007 07:04:33 -0000 1.87
+++ compiler/type_ctor_info.m 8 Feb 2007 12:18:04 -0000
@@ -474,7 +474,7 @@
%
:- func type_ctor_info_rtti_version = int.
-type_ctor_info_rtti_version = 12.
+type_ctor_info_rtti_version = 13.
% Construct an rtti_data for a pseudo_type_info, and also construct
% rtti_data definitions for all of the pseudo_type_infos that it references
Index: library/Mercury.options
===================================================================
RCS file: /home/mercury1/repository/mercury/library/Mercury.options,v
retrieving revision 1.22
diff -u -u -r1.22 Mercury.options
--- library/Mercury.options 1 Feb 2007 08:07:59 -0000 1.22
+++ library/Mercury.options 8 Feb 2007 12:18:04 -0000
@@ -48,6 +48,7 @@
# insts for foreign types.
#
MCFLAGS-array += --no-warn-insts-without-matching-type
+MCFLAGS-bitmap += --no-warn-insts-without-matching-type
MCFLAGS-io += --no-warn-insts-without-matching-type
# Avoid warnings about unused imports.
Index: library/char.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/char.m,v
retrieving revision 1.55
diff -u -u -r1.55 char.m
--- library/char.m 15 Jan 2007 02:23:59 -0000 1.55
+++ library/char.m 8 Feb 2007 12:18:04 -0000
@@ -133,6 +133,14 @@
%
:- pred char.is_hex_digit(char::in) is semidet.
+:- pred char.is_hex_digit(char, int).
+:- mode char.is_hex_digit(in, out) is semidet.
+
+ % Convert an integer 0-15 to a hexadecimal digit 0-9, A-F.
+ %
+:- pred char.int_to_hex_char(int, char).
+:- mode char.int_to_hex_char(in, out) is semidet.
+
% Succeeds if char is a decimal digit (0-9) or letter (a-z or A-Z).
% Returns the character's value as a digit (0-9 or 10-35).
%
@@ -328,28 +336,47 @@
char.is_digit('8').
char.is_digit('9').
-char.is_hex_digit('0').
-char.is_hex_digit('1').
-char.is_hex_digit('2').
-char.is_hex_digit('3').
-char.is_hex_digit('4').
-char.is_hex_digit('5').
-char.is_hex_digit('6').
-char.is_hex_digit('7').
-char.is_hex_digit('8').
-char.is_hex_digit('9').
-char.is_hex_digit('a').
-char.is_hex_digit('b').
-char.is_hex_digit('c').
-char.is_hex_digit('d').
-char.is_hex_digit('e').
-char.is_hex_digit('f').
-char.is_hex_digit('A').
-char.is_hex_digit('B').
-char.is_hex_digit('C').
-char.is_hex_digit('D').
-char.is_hex_digit('E').
-char.is_hex_digit('F').
+char.is_hex_digit(X) :- char.is_hex_digit(X, _).
+
+char.is_hex_digit('0', 0).
+char.is_hex_digit('1', 1).
+char.is_hex_digit('2', 2).
+char.is_hex_digit('3', 3).
+char.is_hex_digit('4', 4).
+char.is_hex_digit('5', 5).
+char.is_hex_digit('6', 6).
+char.is_hex_digit('7', 7).
+char.is_hex_digit('8', 8).
+char.is_hex_digit('9', 9).
+char.is_hex_digit('a', 10).
+char.is_hex_digit('b', 11).
+char.is_hex_digit('c', 12).
+char.is_hex_digit('d', 13).
+char.is_hex_digit('e', 14).
+char.is_hex_digit('f', 15).
+char.is_hex_digit('A', 10).
+char.is_hex_digit('B', 11).
+char.is_hex_digit('C', 12).
+char.is_hex_digit('D', 13).
+char.is_hex_digit('E', 14).
+char.is_hex_digit('F', 15).
+
+char.int_to_hex_char(0, '0').
+char.int_to_hex_char(1, '1').
+char.int_to_hex_char(2, '2').
+char.int_to_hex_char(3, '3').
+char.int_to_hex_char(4, '4').
+char.int_to_hex_char(5, '5').
+char.int_to_hex_char(6, '6').
+char.int_to_hex_char(7, '7').
+char.int_to_hex_char(8, '8').
+char.int_to_hex_char(9, '9').
+char.int_to_hex_char(10, 'A').
+char.int_to_hex_char(11, 'B').
+char.int_to_hex_char(12, 'C').
+char.int_to_hex_char(13, 'D').
+char.int_to_hex_char(14, 'E').
+char.int_to_hex_char(15, 'F').
%-----------------------------------------------------------------------------%
Index: library/construct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/construct.m,v
retrieving revision 1.34
diff -u -u -r1.34 construct.m
--- library/construct.m 5 Jan 2007 07:16:33 -0000 1.34
+++ library/construct.m 9 Feb 2007 01:58:53 -0000
@@ -394,6 +394,7 @@
case MR_TYPECTOR_REP_FLOAT:
case MR_TYPECTOR_REP_CHAR:
case MR_TYPECTOR_REP_STRING:
+ case MR_TYPECTOR_REP_BITMAP:
case MR_TYPECTOR_REP_SUBGOAL:
case MR_TYPECTOR_REP_VOID:
case MR_TYPECTOR_REP_C_POINTER:
@@ -449,7 +450,7 @@
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
if (Ordinal < 0 || Ordinal >= num_functors
|| type_ctor_info->MR_type_ctor_version
- != MR_RTTI_VERSION__FUNCTOR_NUMBERS
+ < MR_RTTI_VERSION__FUNCTOR_NUMBERS
|| !type_ctor_info->MR_type_ctor_functor_number_map)
{
SUCCESS_INDICATOR = MR_FALSE;
@@ -721,6 +722,12 @@
""cannot construct strings with construct.construct"");
break;
+ case MR_TYPECTOR_REP_BITMAP:
+ /* bitmaps don't have functor ordinals. */
+ MR_fatal_error(
+ ""cannot construct bitmaps with construct.construct"");
+ break;
+
case MR_TYPECTOR_REP_EQUIV:
case MR_TYPECTOR_REP_EQUIV_GROUND:
/* These should be eliminated by MR_collapse_equivalences above. */
Index: library/deconstruct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/deconstruct.m,v
retrieving revision 1.42
diff -u -u -r1.42 deconstruct.m
--- library/deconstruct.m 5 Jan 2007 02:19:41 -0000 1.42
+++ library/deconstruct.m 8 Feb 2007 12:18:04 -0000
@@ -84,6 +84,9 @@
% - for arrays, the string <<array>>.
% - for c_pointers, the string ptr(0xXXXX) where XXXX is the
% hexadecimal representation of the pointer.
+ % - for bitmaps, the bitmap converted to a a length and a
+ % hexadecimal string inside angle brackets and quotes of the
+ % form """<[0-9]:[0-9A-F]*>""".
%
% The arity that these predicates return is:
%
@@ -102,6 +105,7 @@
% - for tuples, the number of elements in the tuple.
% - for arrays, the number of elements in the array.
% - for c_pointers, zero.
+ % - for bitmaps, zero.
%
% Note that in the current University of Melbourne implementation,
% the implementations of these predicates depart from the above
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.368
diff -u -u -r1.368 io.m
--- library/io.m 18 Jan 2007 07:33:03 -0000 1.368
+++ library/io.m 8 Feb 2007 12:18:04 -0000
@@ -28,6 +28,7 @@
:- module io.
:- interface.
+:- import_module bitmap.
:- import_module bool.
:- import_module char.
:- import_module deconstruct.
@@ -87,6 +88,10 @@
---> ok(T)
; error(T, io.error).
+:- inst io.maybe_partial_res(T)
+ ---> ok(T)
+ ; error(T, ground).
+
:- type io.result
---> ok
; eof
@@ -751,6 +756,42 @@
:- pred io.read_byte(io.binary_input_stream::in, io.result(int)::out,
io::di, io::uo) is det.
+ % XXX The bitmap returned is actually unique.
+:- inst read_bitmap == io.maybe_partial_res(bound({bitmap, ground})).
+
+ % Fill a bitmap from the current binary input stream.
+ % Returns the number of bytes read.
+ %
+:- pred io.read_bitmap(bitmap::bitmap_di,
+ io.maybe_partial_res({bitmap, int})::out(read_bitmap),
+ io::di, io::uo) is det.
+
+ % Fill a bitmap from the specified binary input stream.
+ % Returns the number of bytes read.
+ %
+:- pred io.read_bitmap(io.binary_input_stream::in,
+ bitmap::bitmap_di, io.maybe_partial_res({bitmap, int})::out(read_bitmap),
+ io::di, io::uo) is det.
+
+ % io.read_bitmap(Bitmap, StartByte, NumBytes, ok({Bitmap, BytesRead}), !IO)
+ % Read NumBytes bytes into a bitmap starting at StartByte
+ % from the current binary input stream.
+ % Returns the number of bytes read.
+ %
+:- pred io.read_bitmap(bitmap::bitmap_di, int::in, int::in,
+ io.maybe_partial_res({bitmap, int})::out(read_bitmap),
+ io::di, io::uo) is det.
+
+ % io.read_bitmap(Stream, Bitmap, StartByte, NumBytes,
+ % ok({Bitmap, BytesRead}), !IO)
+ % Read NumBytes bytes into a bitmap starting at StartByte
+ % from the specified binary input stream.
+ % Returns the number of bytes read.
+ %
+:- pred io.read_bitmap(io.binary_input_stream::in, bitmap::bitmap_di,
+ int::in, int::in, io.maybe_partial_res({bitmap, int})::out(read_bitmap),
+ io::di, io::uo) is det.
+
% Reads all the bytes from the current binary input stream
% until eof or error.
%
@@ -902,12 +943,42 @@
% The bytes are taken from a string.
%
:- pred io.write_bytes(string::in, io::di, io::uo) is det.
+ % A string is not a suitable structure to hold a sequence of bytes.
% Writes several bytes to the specified binary output stream.
% The bytes are taken from a string.
%
:- pred io.write_bytes(io.binary_output_stream::in, string::in,
io::di, io::uo) is det.
+ % A string is not a suitable structure to hold a sequence of bytes.
+
+ % Write a bitmap to the current binary output stream.
+ % The bitmap must not contain a partial final byte.
+ %
+:- pred io.write_bitmap(bitmap, io, io).
+%:- mode io.write_bitmap(bitmap_ui, di, uo) is det.
+:- mode io.write_bitmap(in, di, uo) is det.
+
+ % io.write_bitmap(BM, StartByte, NumBytes, !IO).
+ % Write part of a bitmap to the current binary output stream.
+ %
+:- pred io.write_bitmap(bitmap, int, int, io, io).
+%:- mode io.write_bitmap(bitmap_ui, in, in, di, uo) is det.
+:- mode io.write_bitmap(in, in, in, di, uo) is det.
+
+ % Write a bitmap to the specified binary output stream.
+ % The bitmap must not contain a partial final byte.
+ %
+:- pred io.write_bitmap(io.binary_output_stream, bitmap, io, io).
+%:- mode io.write_bitmap(in, bitmap_ui, di, uo) is det.
+:- mode io.write_bitmap(in, in, di, uo) is det.
+
+ % io.write_bitmap(Stream, BM, StartByte, NumBytes, !IO).
+ % Write part of a bitmap to the specified binary output stream.
+ %
+:- pred io.write_bitmap(io.binary_output_stream, bitmap, int, int, io, io).
+%:- mode io.write_bitmap(in, bitmap_ui, in, in, di, uo) is det.
+:- mode io.write_bitmap(in, in, in, in, di, uo) is det.
% Flush the output buffer of the current binary output stream.
%
@@ -1772,6 +1843,76 @@
Result = error(io_error(Msg))
).
+io.read_bitmap(Bitmap, Result, !IO) :-
+ io.binary_input_stream(Stream, !IO),
+ io.read_bitmap(Stream, Bitmap, Result, !IO).
+
+io.read_bitmap(Bitmap, StartByte, NumBytes, Result, !IO) :-
+ io.binary_input_stream(Stream, !IO),
+ io.read_bitmap(Stream, Bitmap, StartByte, NumBytes, Result, !IO).
+
+io.read_bitmap(Stream, Bitmap, Result, !IO) :-
+ ( NumBytes = Bitmap ^ num_bytes ->
+ io.read_bitmap(Stream, Bitmap, 0, NumBytes, Result, !IO)
+ ;
+ error("io.read_bitmap: bitmap contains partial final byte")
+ ).
+
+io.read_bitmap(binary_input_stream(Stream), Bitmap0, Start, NumBytes,
+ Result, !IO) :-
+ (
+ byte_in_range(Bitmap0, Start),
+ byte_in_range(Bitmap0, Start + NumBytes - 1)
+ ->
+ io.do_read_bitmap(Stream, Start, NumBytes,
+ Bitmap0, Bitmap, 0, BytesRead, !IO),
+ io.ferror(Stream, ErrInt, ErrMsg, !IO),
+ ( ErrInt = 0 ->
+ Result = ok({Bitmap, BytesRead})
+ ;
+ Result = error({Bitmap, BytesRead}, io_error(ErrMsg))
+ )
+ ;
+ error("io.read_bitmap: bitmap index out of range")
+ ).
+
+:- pred io.do_read_bitmap(io.stream::in, int::in, int::in,
+ bitmap::bitmap_di, bitmap::bitmap_uo, int::in, int::out,
+ io::di, io::uo) is det.
+:- pragma promise_pure(io.do_read_bitmap/9).
+
+ % Default implementation for C# and Java.
+io.do_read_bitmap(Stream, Start, NumBytes, !Bitmap, !BytesRead, !IO) :-
+ ( NumBytes > 0 ->
+ io.read_byte(binary_input_stream(Stream), ByteResult, !IO),
+ (
+ ByteResult = ok(Byte),
+ !:Bitmap = !.Bitmap ^ unsafe_byte(Start) := Byte,
+ !:BytesRead = !.BytesRead + 1,
+ io.do_read_bitmap(Stream, Start + 1, NumBytes - 1,
+ !Bitmap, !BytesRead, !IO)
+ ;
+ ByteResult = eof
+ ;
+ ByteResult = error(_)
+ )
+ ;
+ true
+ ).
+:- pragma foreign_proc("C",
+ io.do_read_bitmap(Stream::in, StartByte::in, NumBytes::in,
+ Bitmap0::bitmap_di, Bitmap::bitmap_uo, BytesRead0::in, BytesRead::out,
+ IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure, tabled_for_io, thread_safe],
+"
+ MR_update_io(IO0, IO);
+ Bitmap = Bitmap0,
+ BytesRead = BytesRead0 +
+ MR_READ(*Stream, Bitmap->elements + StartByte, NumBytes);
+").
+
+%-----------------------------------------------------------------------------%
+
io.read_word(Result, !IO) :-
io.input_stream(Stream, !IO),
io.read_word(Stream, Result, !IO).
@@ -4841,7 +4982,7 @@
public System.IO.Stream stream; // The stream itself
public System.IO.TextReader reader; // The stream reader for it
- public System.IO.TextWriter writer; // The stream write for it
+ public System.IO.TextWriter writer; // The stream writer for it
public int putback;
// the next character or byte to read,
// or -1 if no putback char/byte is stored
@@ -6347,6 +6488,15 @@
MR_update_io(IO0, IO);
}").
+
+io.write_bitmap(Bitmap, !IO) :-
+ io.binary_output_stream(Stream, !IO),
+ io.write_bitmap(Stream, Bitmap, !IO).
+
+io.write_bitmap(Bitmap, Start, NumBytes, !IO) :-
+ io.binary_output_stream(Stream, !IO),
+ io.write_bitmap(Stream, Bitmap, Start, NumBytes, !IO).
+
:- pragma foreign_proc("C",
io.flush_output(IO0::di, IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
@@ -6675,6 +6825,48 @@
mercury_print_binary_string(Stream, Message);
MR_update_io(IO0, IO);
").
+
+io.write_bitmap(binary_output_stream(Stream), Bitmap, !IO) :-
+ ( NumBytes = Bitmap ^ num_bytes ->
+ io.do_write_bitmap(Stream, Bitmap, 0, NumBytes, !IO)
+ ;
+ error("io.write_bitmap: bitmap contains partial final byte")
+ ).
+
+io.write_bitmap(binary_output_stream(Stream), Bitmap, Start, NumBytes, !IO) :-
+ (
+ byte_in_range(Bitmap, Start),
+ byte_in_range(Bitmap, Start + NumBytes - 1)
+ ->
+ io.do_write_bitmap(Stream, Bitmap, Start, NumBytes, !IO)
+ ;
+ error("io.write_bitmap: out of range")
+ ).
+
+:- pred io.do_write_bitmap(io.stream, bitmap, int, int, io, io).
+%:- mode io.do_write_bitmap(in, bitmap_ui, in, in, di, uo) is det.
+:- mode io.do_write_bitmap(in, in, in, in, di, uo) is det.
+:- pragma promise_pure(io.do_write_bitmap/6).
+
+ % Default implementation for C# and Java.
+io.do_write_bitmap(Stream, Bitmap, Start, Length, !IO) :-
+ ( Length > 0 ->
+ io.write_byte(binary_output_stream(Stream),
+ Bitmap ^ unsafe_byte(Start), !IO),
+ io.do_write_bitmap(Stream, Bitmap, Start + 1, Length - 1, !IO)
+ ;
+ true
+ ).
+
+:- pragma foreign_proc("C",
+ io.do_write_bitmap(Stream::in, Bitmap::in, Start::in, Length::in,
+ IO0::di, IO::uo),
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates],
+"{
+ MR_WRITE(*Stream, Bitmap->elements + Start, Length);
+ MR_update_io(IO0, IO);
+}").
+
io.flush_output(output_stream(Stream), !IO) :-
io.flush_output_2(Stream, !IO).
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.165
diff -u -u -r1.165 private_builtin.m
--- library/private_builtin.m 15 Jan 2007 02:24:00 -0000 1.165
+++ library/private_builtin.m 8 Feb 2007 12:18:04 -0000
@@ -478,7 +478,8 @@
public static int MR_TYPECTOR_REP_STABLE_FOREIGN =40;
public static int MR_TYPECTOR_REP_PSEUDOTYPEDESC =41;
public static int MR_TYPECTOR_REP_DUMMY =42;
-public static int MR_TYPECTOR_REP_UNKNOWN =43;
+public static int MR_TYPECTOR_REP_BITMAP =43;
+public static int MR_TYPECTOR_REP_UNKNOWN =44;
public static int MR_SECTAG_NONE = 0;
public static int MR_SECTAG_LOCAL = 1;
@@ -1404,7 +1405,8 @@
public static final int MR_TYPECTOR_REP_STABLE_FOREIGN = 40;
public static final int MR_TYPECTOR_REP_PSEUDOTYPEDESC = 41;
public static final int MR_TYPECTOR_REP_DUMMY = 42;
- public static final int MR_TYPECTOR_REP_UNKNOWN = 43;
+ public static final int MR_TYPECTOR_REP_BITMAP = 43;
+ public static final int MR_TYPECTOR_REP_UNKNOWN = 44;
public static final int MR_SECTAG_NONE = 0;
public static final int MR_SECTAG_LOCAL = 1;
Index: library/rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.73
diff -u -u -r1.73 rtti_implementation.m
--- library/rtti_implementation.m 23 Jan 2007 02:49:50 -0000 1.73
+++ library/rtti_implementation.m 8 Feb 2007 12:18:04 -0000
@@ -99,6 +99,7 @@
:- implementation.
:- import_module array.
+:- import_module bitmap.
:- import_module bool.
:- import_module int.
:- import_module maybe.
@@ -155,6 +156,7 @@
; tcr_stable_foreign
; tcr_pseudo_type_desc
; tcr_dummy
+ ; tcr_bitmap
; tcr_unknown.
% We keep all the other types abstract.
@@ -215,6 +217,7 @@
; TypeCtorRep = tcr_char
; TypeCtorRep = tcr_float
; TypeCtorRep = tcr_string
+ ; TypeCtorRep = tcr_bitmap
; TypeCtorRep = tcr_func
; TypeCtorRep = tcr_pred
; TypeCtorRep = tcr_void
@@ -310,6 +313,7 @@
; TypeCtorRep = tcr_char
; TypeCtorRep = tcr_float
; TypeCtorRep = tcr_string
+ ; TypeCtorRep = tcr_bitmap
; TypeCtorRep = tcr_func
; TypeCtorRep = tcr_pred
; TypeCtorRep = tcr_void
@@ -1068,6 +1072,13 @@
Arity = 0,
Arguments = []
;
+ TypeCtorRep = tcr_bitmap,
+ det_dynamic_cast(Term, Bitmap),
+ String = bitmap.to_string(Bitmap),
+ Functor = "\"" ++ String ++ "\"",
+ Arity = 0,
+ Arguments = []
+ ;
% XXX noncanonical term
TypeCtorRep = tcr_pred,
Functor = "<<predicate>>",
Index: library/stream.string_writer.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/stream.string_writer.m,v
retrieving revision 1.3
diff -u -u -r1.3 stream.string_writer.m
--- library/stream.string_writer.m 9 Jan 2007 13:03:38 -0000 1.3
+++ library/stream.string_writer.m 8 Feb 2007 12:18:04 -0000
@@ -177,6 +177,7 @@
:- implementation.
:- import_module array.
+:- import_module bitmap.
:- import_module int.
:- import_module require.
:- import_module rtti_implementation.
@@ -353,6 +354,11 @@
put_int(Stream, Int, !State)
; univ_to_type(Univ, Float) ->
put_float(Stream, Float, !State)
+ ; univ_to_type(Univ, Bitmap) ->
+ % Bitmaps are converted to strings of hex digits.
+ put_char(Stream, '"', !State),
+ put(Stream, bitmap.to_string(Bitmap), !State),
+ put_char(Stream, '"', !State)
; univ_to_type(Univ, TypeDesc) ->
write_type_desc(Stream, TypeDesc, !State)
; univ_to_type(Univ, TypeCtorDesc) ->
Index: library/term.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/term.m,v
retrieving revision 1.126
diff -u -u -r1.126 term.m
--- library/term.m 5 Jan 2007 02:19:41 -0000 1.126
+++ library/term.m 8 Feb 2007 12:18:04 -0000
@@ -457,6 +457,7 @@
:- implementation.
:- import_module array.
+:- import_module bitmap.
:- import_module construct.
:- import_module deconstruct.
:- import_module int.
@@ -557,6 +558,11 @@
term_to_univ_special_case("builtin", "float", [], Term, _, _, ok(Univ)) :-
Term = functor(float(Float), [], _),
type_to_univ(Float, Univ).
+term_to_univ_special_case("bitmap", "bitmap", [],
+ Term, _Type, _PrevContext, ok(Univ)) :-
+ % Bitmaps are represented as hex strings.
+ Term = functor(string(String), [], _),
+ type_to_univ(bitmap.from_string(String), Univ).
term_to_univ_special_case("array", "array", [ElemType],
Term, _Type, PrevContext, Result) :-
%
@@ -733,6 +739,10 @@
type_info_to_term(Context, univ_type(NestedUniv), TypeTerm),
NestedUnivValue = univ_value(NestedUniv),
type_to_term(NestedUnivValue, ValueTerm).
+univ_to_term_special_case("bitmap", "bitmap", [], Univ, Context,
+ functor(string(BitmapStr), [], Context)) :-
+ det_univ_to_type(Univ, Bitmap),
+ BitmapStr = bitmap.to_string(Bitmap).
univ_to_term_special_case("array", "array", [ElemType], Univ, Context, Term) :-
Term = functor(atom("array"), [ArgsTerm], Context),
Index: library/version_array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/version_array.m,v
retrieving revision 1.13
diff -u -u -r1.13 version_array.m
--- library/version_array.m 15 Jan 2007 02:24:01 -0000 1.13
+++ library/version_array.m 8 Feb 2007 12:18:04 -0000
@@ -263,21 +263,27 @@
version_array(T)::in, version_array(T)::in) is det.
cmp_version_array(R, VAa, VAb) :-
- N = min(max(VAa), max(VAb)),
- cmp_version_array_2(N, VAa, VAb, R).
+ SizeA = VAa ^ size,
+ SizeB = VAb ^ size,
+ compare(SizeResult, SizeA, SizeB),
+ ( SizeResult = (=) ->
+ cmp_version_array_2(0, SizeA, VAa, VAb, R)
+ ;
+ R = SizeResult
+ ).
-:- pred cmp_version_array_2(int::in, version_array(T)::in,
+:- pred cmp_version_array_2(int::in, int::in, version_array(T)::in,
version_array(T)::in, comparison_result::uo) is det.
-cmp_version_array_2(I, VAa, VAb, R) :-
- ( if I >= 0 then
+cmp_version_array_2(I, Size, VAa, VAb, R) :-
+ ( if I >= Size then
+ R = (=)
+ else
compare(R0, VAa ^ elem(I), VAb ^ elem(I)),
( if R0 = (=)
- then cmp_version_array_2(I - 1, VAa, VAb, R)
+ then cmp_version_array_2(I + 1, Size, VAa, VAb, R)
else R = R0
)
- else
- R = (=)
).
:- pragma foreign_proc("C",
Index: library/version_bitmap.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/version_bitmap.m,v
retrieving revision 1.6
diff -u -u -r1.6 version_bitmap.m
--- library/version_bitmap.m 27 Sep 2006 06:16:45 -0000 1.6
+++ library/version_bitmap.m 8 Feb 2007 12:18:04 -0000
@@ -59,9 +59,13 @@
:- pred is_set(version_bitmap::in, int::in) is semidet.
:- pred is_clear(version_bitmap::in, int::in) is semidet.
- % get(BM, I) returns `yes' if is_set(BM, I) and `no' otherwise.
+ % Get the given bit.
%
-:- func get(version_bitmap, int) = bool.
+:- func version_bitmap ^ bit(int) = bool.
+
+ % Set the given bit.
+ %
+:- func (version_bitmap ^ bit(int) := bool) = version_bitmap.
% Create a new copy of a version_bitmap.
%
@@ -77,6 +81,8 @@
:- func difference(version_bitmap, version_bitmap) = version_bitmap.
+:- func xor(version_bitmap, version_bitmap) = version_bitmap.
+
% resize(BM, N, B) resizes version_bitmap BM to have N bits; if N is
% smaller than the current number of bits in BM then the excess
% are discarded. If N is larger than the current number of bits
@@ -107,6 +113,15 @@
:- implementation.
+:- interface.
+
+ % get(BM, I) returns `yes' if is_set(BM, I) and `no' otherwise.
+ % Replaced by `BM ^ bit(I)'.
+:- func get(version_bitmap, int) = bool.
+:- pragma obsolete(get/2).
+
+:- implementation.
+
:- import_module exception.
:- import_module int.
:- import_module require.
@@ -192,6 +207,13 @@
%-----------------------------------------------------------------------------%
+BM ^ bit(I) = ( if is_set(BM, I) then yes else no ).
+
+(BM ^ bit(I) := yes) = set(BM, I).
+(BM ^ bit(I) := no) = clear(BM, I).
+
+%-----------------------------------------------------------------------------%
+
set(BM, I) =
( if in_range(BM, I)
then BM ^ elem(int_offset(I)) :=
@@ -259,31 +281,42 @@
%-----------------------------------------------------------------------------%
union(BMa, BMb) =
- ( if num_bits(BMa) > num_bits(BMb) then
- zip(int_offset(num_bits(BMb) - 1), (\/), BMb, version_bitmap.copy(BMa))
+ ( if num_bits(BMa) = num_bits(BMb) then
+ zip(int_offset(num_bits(BMb) - 1), (\/), BMa, BMb)
else
- zip(int_offset(num_bits(BMa) - 1), (\/), BMa, BMb)
+ throw(software_error(
+ "version_bitmap.union: version_bitmaps not the same size"))
).
%-----------------------------------------------------------------------------%
intersect(BMa, BMb) =
- ( if num_bits(BMa) > num_bits(BMb) then
- zip(int_offset(num_bits(BMb) - 1), (/\), BMb, version_bitmap.copy(BMa))
+ ( if num_bits(BMa) = num_bits(BMb) then
+ zip(int_offset(num_bits(BMb) - 1), (/\), BMa, BMb)
else
- zip(int_offset(num_bits(BMa) - 1), (/\), BMa, BMb)
+ throw(software_error(
+ "version_bitmap.intersect: version_bitmaps not the same size"))
).
%-----------------------------------------------------------------------------%
difference(BMa, BMb) =
- ( if num_bits(BMa) > num_bits(BMb) then
- zip(int_offset(num_bits(BMb) - 1), Xor, BMb, version_bitmap.copy(BMa))
+ ( if num_bits(BMa) = num_bits(BMb) then
+ zip(int_offset(num_bits(BMb) - 1), (func(X, Y) = X /\ \Y), BMa, BMb)
+ else
+ throw(software_error(
+ "version_bitmap.difference: version_bitmaps not the same size"))
+ ).
+
+%-----------------------------------------------------------------------------%
+
+xor(BMa, BMb) =
+ ( if num_bits(BMa) = num_bits(BMb) then
+ zip(int_offset(num_bits(BMb) - 1), (func(X, Y) = X `xor` Y), BMa, BMb)
else
- zip(int_offset(num_bits(BMa) - 1), Xor, BMa, BMb)
- )
- :-
- Xor = ( func(X, Y) = (X `xor` Y) ).
+ throw(software_error(
+ "version_bitmap.xor: version_bitmaps not the same size"))
+ ).
%-----------------------------------------------------------------------------%
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.137
diff -u -u -r1.137 Mmakefile
--- runtime/Mmakefile 3 Jan 2007 05:17:15 -0000 1.137
+++ runtime/Mmakefile 8 Feb 2007 12:18:04 -0000
@@ -28,6 +28,7 @@
mercury_bootstrap.h \
mercury_builtin_types.h \
mercury_builtin_types_proc_layouts.h \
+ mercury_bitmap.h \
mercury_calls.h \
mercury_complexity.h \
mercury_conf_bootstrap.h \
@@ -150,6 +151,7 @@
mercury_agc_debug.c \
mercury_bootstrap.c \
mercury_builtin_types.c \
+ mercury_bitmap.c \
mercury_construct.c \
mercury_context.c \
mercury_debug.c \
Index: runtime/mercury_bitmap.c
===================================================================
RCS file: runtime/mercury_bitmap.c
diff -N runtime/mercury_bitmap.c
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_bitmap.c 8 Feb 2007 12:18:04 -0000
@@ -0,0 +1,165 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2007 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.
+*/
+
+/* mercury_bitmap.c - bitmap handling */
+
+#include "mercury_imp.h"
+#include "mercury_bitmap.h"
+
+#include <stdio.h>
+
+static int MR_hex_char_to_int(char digit);
+static MR_String MR_do_bitmap_to_string(MR_ConstBitmapPtr, MR_bool, MR_bool);
+
+/*
+** Note that MR_bitmap_cmp and MR_hash_bitmap are actually defined
+** as macros in mercury_bitmap.h, if we're using GNU C.
+** We define them here whether or not we're using gcc, so that users
+** can easily switch between gcc and cc without rebuilding the libraries.
+*/
+
+#undef MR_bitmap_cmp
+
+MR_Integer
+MR_bitmap_cmp(MR_ConstBitmapPtr b1, MR_ConstBitmapPtr b2)
+{
+ MR_BITMAP_CMP_FUNC_BODY
+}
+
+#undef MR_hash_bitmap
+
+MR_Integer
+MR_hash_bitmap(MR_ConstBitmapPtr b)
+{
+ MR_HASH_BITMAP_FUNC_BODY
+}
+
+static const char hex_digits[] =
+ {'0', '1', '2', '3', '4', '5', '6', '7', '8', '9',
+ 'A', 'B', 'C', 'D', 'E', 'F'};
+
+static int
+MR_hex_char_to_int(char digit)
+{
+ switch (digit) {
+ case '0': return 0;
+ case '1': return 1;
+ case '2': return 2;
+ case '3': return 3;
+ case '4': return 4;
+ case '5': return 5;
+ case '6': return 6;
+ case '7': return 7;
+ case '8': return 8;
+ case '9': return 9;
+ case 'A': return 10;
+ case 'B': return 11;
+ case 'C': return 12;
+ case 'D': return 13;
+ case 'E': return 14;
+ case 'F': return 15;
+ default : return -1;
+ }
+}
+
+MR_String
+MR_bitmap_to_string(MR_ConstBitmapPtr b)
+{
+ return MR_do_bitmap_to_string(b, MR_FALSE, MR_TRUE);
+}
+
+MR_String
+MR_bitmap_to_quoted_string_saved_hp(MR_ConstBitmapPtr b)
+{
+ return MR_do_bitmap_to_string(b, MR_TRUE, MR_TRUE);
+}
+
+static MR_String
+MR_do_bitmap_to_string(MR_ConstBitmapPtr b,
+ MR_bool quote, MR_bool use_saved_hp)
+{
+ MR_String result;
+ int i;
+ int len;
+ int num_bytes;
+ int num_bits_len;
+ int start;
+ char num_bits_str[100];
+
+ sprintf(num_bits_str, "%d", b->num_bits);
+ num_bits_len = strlen(num_bits_str);
+ num_bytes = MR_bitmap_length_in_bytes(b->num_bits);
+ len = 1 + num_bits_len + 1 + num_bytes * 2 + 1;
+ if (quote) {
+ len += 2;
+ }
+
+ if (use_saved_hp) {
+ MR_allocate_aligned_string_saved_hp(result, len);
+ } else {
+ MR_allocate_aligned_string_msg(result, len, NULL);
+ }
+
+ if (quote) {
+ result[0] = '"';
+ result[1] = '<';
+ result[len - 2] = '>';
+ result[len - 1] = '"';
+ start = 2;
+ } else {
+ result[0] = '<';
+ result[len - 1] = '>';
+ start = 1;
+ }
+ strcpy(result + start, num_bits_str);
+ start += num_bits_len;
+ result[start++] = ':';
+ for (i = 0; i < num_bytes; i++) {
+ result[start++] = hex_digits[(b->elements[i] >> 4) & 0xf];
+ result[start++] = hex_digits[b->elements[i] & 0xf];
+ }
+ result[len] = '\0';
+ return result;
+}
+
+MR_BitmapPtr
+MR_string_to_bitmap(MR_ConstString s)
+{
+ MR_BitmapPtr result;
+ int i;
+ int len;
+ int start;
+ int res;
+ unsigned int result_bits;
+
+ len = strlen(s);
+ if (len < 4 || s[0] != '<' || s[len - 1] != '>') {
+ return NULL;
+ }
+ res = sscanf(s, "<%u:%n", &result_bits, &start);
+ if (res != 1) {
+ return NULL;
+ }
+ MR_allocate_bitmap_msg(result, (MR_Integer) result_bits, NULL);
+ result->num_bits = result_bits;
+ for (i = 0; i < MR_bitmap_length_in_bytes(result_bits); i++) {
+ int h1, h2;
+ if (start + 1 >= len - 1) {
+ return NULL;
+ }
+ h1 = MR_hex_char_to_int(s[start++]);
+ h2 = MR_hex_char_to_int(s[start++]);
+ if (h1 < 0 || h2 < 0) {
+ return NULL;
+ }
+ result->elements[i] = (MR_uint_least8_t) (h1 << 4) | h2;
+ }
+ return result;
+}
+
Index: runtime/mercury_bitmap.h
===================================================================
RCS file: runtime/mercury_bitmap.h
diff -N runtime/mercury_bitmap.h
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ runtime/mercury_bitmap.h 8 Feb 2007 12:18:04 -0000
@@ -0,0 +1,211 @@
+/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
+** Copyright (C) 2007 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.
+*/
+
+/* mercury_bitmap.h - bitmap handling */
+
+#ifndef MERCURY_BITMAP_H
+#define MERCURY_BITMAP_H
+
+#include "mercury_tags.h"
+#include <string.h> /* for memcmp() */
+
+/*
+** The actual typedefs are in mercury_types.h to avoid problems with
+** circular #includes.
+*/
+
+/*
+** Like memcpy, but for bitmaps.
+** The destination must already have been allocated.
+*/
+#define MR_copy_bitmap(dest, src) \
+ do { \
+ MR_BitmapPtr copy_dest = dest; \
+ MR_ConstBitmapPtr copy_src = src; \
+ memcpy(copy_dest->elements, copy_src->elements, \
+ MR_bitmap_length_in_bytes(copy_src->num_bits)); \
+ } while (0)
+
+/*
+** Like memcmp, but for bitmaps.
+*/
+
+#define MR_do_bitmap_cmp(res,p1,p2) \
+ do { \
+ MR_ConstBitmapPtr cmp_b1 = (p1); \
+ MR_ConstBitmapPtr cmp_b2 = (p2); \
+ MR_Integer cmp_size1 = cmp_b1->num_bits; \
+ MR_Integer cmp_size2 = cmp_b2->num_bits; \
+ if (cmp_size1 < cmp_size2) { \
+ (res) = -1; \
+ } else if (cmp_size1 > cmp_size2) { \
+ (res) = 1; \
+ } else { \
+ (res) = memcmp(cmp_b1, cmp_b2, \
+ MR_bitmap_length_in_bytes(cmp_size1)); \
+ } \
+ } while (0)
+
+
+int MR_bitmap_cmp(MR_ConstBitmapPtr, MR_ConstBitmapPtr);
+
+#ifdef __GNUC__
+#define MR_bitmap_cmp(b1, b2) \
+ ({ \
+ MR_Integer bitmap_cmp_result; \
+ MR_do_bitmap_cmp(bitmap_cmp_result, b1, b2); \
+ bitmap_cmp_result; \
+ })
+#endif
+
+/*
+** If we're not using gcc, the actual definition of MR_bitmap_cmp is in
+** runtime/mercury_bitmap.c;
+** it uses the macro MR_BITMAP_CMP_FUNC_BODY below.
+*/
+
+#define MR_BITMAP_CMP_FUNC_BODY \
+ MR_Integer bitmap_cmp_result; \
+ MR_do_bitmap_cmp(bitmap_cmp_result, b1, b2); \
+ return bitmap_cmp_result;
+
+#define MR_bitmap_eq(b1, b2) (MR_bitmap_cmp((b1), (b2)) == 0)
+
+/*
+** MR_do_hash_bitmap(int & hash, MR_Word bitmap):
+** Given a Mercury bitmap `bitmap', set `hash' to the hash value
+** for that bitmap. (`hash' must be an lvalue.)
+**
+** This is an implementation detail used to implement MR_hash_bitmap().
+** It should not be used directly. Use MR_hash_bitmap() instead.
+**
+** Note that hash_bitmap is also defined in library/bitmap.m.
+** The definition here and the definition in bitmap.m
+** must be kept equivalent.
+*/
+
+#define MR_do_hash_bitmap(hash, b) \
+ { \
+ int len = 0; \
+ MR_ConstBitmapPtr hash_bm = (b); \
+ MR_CHECK_EXPR_TYPE((hash), int); \
+ (hash) = 0; \
+ while (len < MR_bitmap_length_in_bytes(hash_bm->num_bits)) { \
+ (hash) ^= ((hash) << 5); \
+ (hash) ^= hash_bm->elements[len]; \
+ len++; \
+ } \
+ (hash) ^= hash_bm->num_bits; \
+ }
+
+/*
+** MR_hash_bitmap(b):
+** Given a Mercury bitmap `b', return a hash value for that array.
+*/
+
+MR_Integer MR_hash_bitmap(MR_ConstBitmapPtr);
+
+#ifdef __GNUC__
+#define MR_hash_bitmap(b) \
+ ({ \
+ MR_Integer hash_bitmap_result; \
+ MR_CHECK_EXPR_TYPE(b, MR_ConstBitmapPtr); \
+ MR_do_hash_bitmap(hash_bitmap_result, (b)); \
+ hash_bitmap_result; \
+ })
+#endif
+
+/*
+** If we're not using gcc, the actual definition of MR_hash_bitmap is in
+** runtime/mercury_bitmap.c;
+** it uses the macro MR_HASH_BITMAP_FUNC_BODY below.
+*/
+
+#define MR_HASH_BITMAP_FUNC_BODY \
+ MR_Integer hash_bitmap_result; \
+ MR_do_hash_bitmap(hash_bitmap_result, b); \
+ return hash_bitmap_result;
+
+/*
+** Convert a bitmap to a string consisting of a length followed by a colon
+** and a string of hexadecimal digits surrounded by angle brackets
+** (e.g. "<24:12A>").
+**
+*/
+MR_String MR_bitmap_to_string(MR_ConstBitmapPtr);
+
+/*
+** Convert a bitmap to a string consisting of a length followed by a colon
+** and a string of hexadecimal digits surrounded by angle brackets and
+** double quotes (e.g. "\"<24:12A>\""). Used by `deconstruct.functor/3'.
+**
+*/
+MR_String MR_bitmap_to_quoted_string_saved_hp(MR_ConstBitmapPtr);
+
+/*
+** Convert the output of MR_bitmap_to_string back into a bitmap.
+** Returns NULL if the string can't be converted.
+*/
+MR_BitmapPtr MR_string_to_bitmap(MR_ConstString);
+
+/*
+** Return the length of the element array in words.
+*/
+#define MR_bitmap_length_in_words(bits) \
+ (((bits) / MR_WORDBITS) + (((bits) % MR_WORDBITS) != 0))
+
+/*
+** We assume MR_uint_least8_t is 8 bits, which will be true on
+** all sane machines.
+*/
+#define MR_BITS_PER_BYTE 8
+
+/*
+** Return the length of the element array in bytes.
+*/
+#define MR_bitmap_length_in_bytes(bits) \
+ (((bits) / MR_BITS_PER_BYTE) + (((bits) % MR_BITS_PER_BYTE) != 0))
+
+/*
+** void MR_allocate_bitmap_msg(MR_String ptr, size_t bytes,
+** int bits_in_last_byte, MR_Code *proclabel):
+** Allocate enough word aligned memory to hold `bytes' bytes. Also
+** record for memory profiling purposes the location, proclabel, of the
+** allocation if profiling is enabled.
+**
+** BEWARE: this may modify `MR_hp', so it must only be called from
+** places where `MR_hp' is valid. If calling it from inside a C function,
+** rather than inside Mercury code, you may need to call
+** MR_{save/restore}_transient_hp().
+*/
+
+#define MR_allocate_bitmap_msg(ptr, bits, proclabel) \
+ do { \
+ MR_Word make_bitmap_tmp; \
+ MR_BitmapPtr make_bitmap_ptr; \
+ MR_offset_incr_hp_atomic_msg(make_bitmap_tmp, 0, \
+ MR_bitmap_length_in_words(bits) + 1, proclabel, \
+ "bitmap:bitmap/0"); \
+ make_bitmap_ptr = (MR_BitmapPtr) make_bitmap_tmp; \
+ make_bitmap_ptr->num_bits = bits; \
+ (ptr) = make_bitmap_ptr; \
+ } while(0)
+
+#define MR_allocate_bitmap_saved_hp(ptr, bits) \
+ do { \
+ MR_Word make_bitmap_tmp; \
+ MR_BitmapPtr make_bitmap_ptr; \
+ MR_offset_incr_saved_hp_atomic(make_bitmap_tmp, 0, \
+ MR_bitmap_length_in_words(bits) + 1); \
+ make_bitmap_ptr = (MR_BitmapPtr) make_bitmap_tmp; \
+ make_bitmap_ptr->num_bits = bits; \
+ (ptr) = make_bitmap_ptr; \
+ } while(0)
+
+#endif /* not MERCURY_BITMAP_H */
Index: runtime/mercury_construct.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_construct.c,v
retrieving revision 1.15
diff -u -u -r1.15 mercury_construct.c
--- runtime/mercury_construct.c 5 Oct 2005 06:34:20 -0000 1.15
+++ runtime/mercury_construct.c 8 Feb 2007 12:18:04 -0000
@@ -146,6 +146,7 @@
case MR_TYPECTOR_REP_CHAR:
case MR_TYPECTOR_REP_FLOAT:
case MR_TYPECTOR_REP_STRING:
+ case MR_TYPECTOR_REP_BITMAP:
case MR_TYPECTOR_REP_FUNC:
case MR_TYPECTOR_REP_PRED:
case MR_TYPECTOR_REP_SUBGOAL:
@@ -309,6 +310,7 @@
case MR_TYPECTOR_REP_CHAR:
case MR_TYPECTOR_REP_FLOAT:
case MR_TYPECTOR_REP_STRING:
+ case MR_TYPECTOR_REP_BITMAP:
case MR_TYPECTOR_REP_FUNC:
case MR_TYPECTOR_REP_PRED:
case MR_TYPECTOR_REP_SUBGOAL:
Index: runtime/mercury_deconstruct.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deconstruct.c,v
retrieving revision 1.20
diff -u -u -r1.20 mercury_deconstruct.c
--- runtime/mercury_deconstruct.c 20 Aug 2006 05:41:44 -0000 1.20
+++ runtime/mercury_deconstruct.c 8 Feb 2007 12:18:04 -0000
@@ -271,6 +271,7 @@
case MR_TYPECTOR_REP_FLOAT:
case MR_TYPECTOR_REP_CHAR:
case MR_TYPECTOR_REP_STRING:
+ case MR_TYPECTOR_REP_BITMAP:
case MR_TYPECTOR_REP_FUNC:
case MR_TYPECTOR_REP_PRED:
case MR_TYPECTOR_REP_SUBGOAL:
Index: runtime/mercury_deep_copy.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy.h,v
retrieving revision 1.17
diff -u -u -r1.17 mercury_deep_copy.h
--- runtime/mercury_deep_copy.h 7 Jun 2004 09:07:20 -0000 1.17
+++ runtime/mercury_deep_copy.h 8 Feb 2007 12:18:04 -0000
@@ -10,6 +10,7 @@
#define MERCURY_DEEP_COPY_H
#include "mercury_types.h" /* for `MR_Word' */
+#include "mercury_bitmap.h"
#include "mercury_type_info.h" /* for `MR_TypeInfo' */
#include "mercury_conf.h" /* for `MR_MIGHT_RECLAIM_HP_ON_FAILURE' */
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.71
diff -u -u -r1.71 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 5 Oct 2005 06:34:20 -0000 1.71
+++ runtime/mercury_deep_copy_body.h 8 Feb 2007 12:18:04 -0000
@@ -551,6 +551,29 @@
}
return new_data;
+ case MR_TYPECTOR_REP_BITMAP:
+ {
+ MR_Word *data_value;
+ int i;
+
+ assert(MR_tag(data) == 0);
+ data_value = (MR_Word *) MR_body(data, MR_mktag(0));
+
+ RETURN_IF_OUT_OF_RANGE(data, data_value, 0, MR_Word);
+
+ {
+ MR_BitmapPtr new_array;
+ MR_BitmapPtr old_array;
+
+ old_array = (MR_BitmapPtr) data_value;
+ MR_allocate_bitmap_saved_hp(new_array, old_array->num_bits);
+ MR_copy_bitmap(new_array, old_array);
+ new_data = (MR_Word) new_array;
+ leave_forwarding_pointer(data, 0, new_data);
+ }
+ }
+ return new_data;
+
case MR_TYPECTOR_REP_TYPEINFO:
case MR_TYPECTOR_REP_TYPEDESC:
return (MR_Word) copy_type_info((MR_TypeInfo) data,
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.80
diff -u -u -r1.80 mercury_ho_call.c
--- runtime/mercury_ho_call.c 11 Dec 2006 03:03:14 -0000 1.80
+++ runtime/mercury_ho_call.c 8 Feb 2007 12:18:04 -0000
@@ -36,6 +36,8 @@
#include "mercury_builtin_types.h"
#include "mercury_builtin_types_proc_layouts.h"
/* for unify/compare of pred/func and for proc_layout structures */
+#include "mercury_types.h"
+#include "mercury_bitmap.h"
#ifdef MR_DEEP_PROFILING
#ifdef MR_DEEP_PROFILING_STATISTICS
Index: runtime/mercury_mcpp.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_mcpp.h,v
retrieving revision 1.34
diff -u -u -r1.34 mercury_mcpp.h
--- runtime/mercury_mcpp.h 5 Jan 2007 02:19:43 -0000 1.34
+++ runtime/mercury_mcpp.h 8 Feb 2007 12:18:04 -0000
@@ -127,7 +127,7 @@
#define MR_TYPECTOR_REP(a) MR_BOX_INT(mercury::runtime::Constants::a)
// XXX This is hardcoded
-#define MR_RTTI_VERSION MR_BOX_INT(12)
+#define MR_RTTI_VERSION MR_BOX_INT(13)
// XXX It is intended that we eventually define the constants in
// private_builtin.m and mercury_mcpp.cpp in terms of these #defines
@@ -175,7 +175,8 @@
#define MR_TYPECTOR_REP_STABLE_FOREIGN_val 40
#define MR_TYPECTOR_REP_PSEUDOTYPEDESC_val 41
#define MR_TYPECTOR_REP_DUMMY_val 42
-#define MR_TYPECTOR_REP_UNKNOWN_val 43
+#define MR_TYPECTOR_REP_BITMAP_val 43
+#define MR_TYPECTOR_REP_UNKNOWN_val 44
// XXX we should integrate this macro in with the version in
// mercury_typeinfo.h
Index: runtime/mercury_ml_expand_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ml_expand_body.h,v
retrieving revision 1.39
diff -u -u -r1.39 mercury_ml_expand_body.h
--- runtime/mercury_ml_expand_body.h 5 Jan 2007 02:19:43 -0000 1.39
+++ runtime/mercury_ml_expand_body.h 8 Feb 2007 12:18:04 -0000
@@ -755,6 +755,22 @@
handle_zero_arity_args();
return;
+ case MR_TYPECTOR_REP_BITMAP:
+#ifdef EXPAND_FUNCTOR_FIELD
+ {
+ MR_Word data_word;
+ MR_String str;
+
+ data_word = *data_word_ptr;
+ str = MR_bitmap_to_quoted_string_saved_hp(
+ (MR_ConstBitmapPtr) data_word);
+ expand_info->EXPAND_FUNCTOR_FIELD = str;
+ }
+#endif /* EXPAND_FUNCTOR_FIELD */
+
+ handle_zero_arity_args();
+ return;
+
case MR_TYPECTOR_REP_FUNC:
if (noncanon == MR_NONCANON_ABORT) {
/* XXX should throw an exception */
Index: runtime/mercury_string.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_string.h,v
retrieving revision 1.32
diff -u -u -r1.32 mercury_string.h
--- runtime/mercury_string.h 20 Jun 2005 02:16:44 -0000 1.32
+++ runtime/mercury_string.h 8 Feb 2007 12:18:04 -0000
@@ -169,6 +169,18 @@
(ptr) = make_aligned_string_ptr; \
} while(0)
+#define MR_allocate_aligned_string_saved_hp(ptr, len) \
+ do { \
+ MR_Word make_aligned_string_tmp; \
+ char *make_aligned_string_ptr; \
+ \
+ MR_offset_incr_saved_hp_atomic(make_aligned_string_tmp, 0,\
+ ((len) + sizeof(MR_Word)) / sizeof(MR_Word)); \
+ make_aligned_string_ptr = \
+ (char *) make_aligned_string_tmp; \
+ (ptr) = make_aligned_string_ptr; \
+ } while(0)
+
/*
** MR_do_hash_string(int & hash, MR_Word string):
** Given a Mercury string `string', set `hash' to the hash value
Index: runtime/mercury_table_type_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_table_type_body.h,v
retrieving revision 1.3
diff -u -u -r1.3 mercury_table_type_body.h
--- runtime/mercury_table_type_body.h 30 Nov 2006 05:22:42 -0000 1.3
+++ runtime/mercury_table_type_body.h 8 Feb 2007 12:18:04 -0000
@@ -290,6 +290,12 @@
table = table_next;
return table;
+ case MR_TYPECTOR_REP_BITMAP:
+ MR_TABLE_BITMAP(STATS, DEBUG, BACK, table_next, table,
+ (MR_ConstBitmapPtr) data);
+ table = table_next;
+ return table;
+
case MR_TYPECTOR_REP_FUNC:
case MR_TYPECTOR_REP_PRED:
{
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.72
diff -u -u -r1.72 mercury_tabling.c
--- runtime/mercury_tabling.c 29 Nov 2006 05:18:26 -0000 1.72
+++ runtime/mercury_tabling.c 8 Feb 2007 12:18:04 -0000
@@ -37,6 +37,7 @@
typedef struct MR_IntHashTableSlot_Struct MR_IntHashTableSlot;
typedef struct MR_FloatHashTableSlot_Struct MR_FloatHashTableSlot;
typedef struct MR_StringHashTableSlot_Struct MR_StringHashTableSlot;
+typedef struct MR_BitmapHashTableSlot_Struct MR_BitmapHashTableSlot;
typedef struct MR_WordHashTableSlot_Struct MR_WordHashTableSlot;
typedef struct MR_AllocRecord_Struct MR_AllocRecord;
@@ -59,6 +60,12 @@
MR_ConstString key;
};
+struct MR_BitmapHashTableSlot_Struct {
+ MR_BitmapHashTableSlot *next;
+ MR_TableNode data;
+ MR_ConstBitmapPtr key;
+};
+
struct MR_WordHashTableSlot_Struct {
MR_WordHashTableSlot *next;
MR_TableNode data;
@@ -69,6 +76,7 @@
MR_IntHashTableSlot *int_slot_ptr;
MR_FloatHashTableSlot *float_slot_ptr;
MR_StringHashTableSlot *string_slot_ptr;
+ MR_BitmapHashTableSlot *bitmap_slot_ptr;
MR_WordHashTableSlot *word_slot_ptr;
} MR_HashTableSlotPtr;
@@ -508,6 +516,73 @@
}
MR_TrieNode
+MR_bitmap_hash_lookup_or_add(MR_TrieNode t, MR_ConstBitmapPtr key)
+{
+#define key_format "%d"
+#define key_cast void *
+#define table_type MR_BitmapHashTableSlot
+#define table_field bitmap_slot_ptr
+#define hash(key) (MR_hash_bitmap(key))
+#define equal_keys(k1, k2) (MR_bitmap_cmp((k1), (k2)) == 0)
+#define lookup_only MR_FALSE
+#include "mercury_tabling_stats_nodefs.h"
+#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
+#undef key_format
+#undef key_cast
+#undef table_type
+#undef table_field
+#undef hash
+#undef equal_keys
+#undef lookup_only
+}
+
+MR_TrieNode
+MR_bitmap_hash_lookup_or_add_stats(MR_TableStepStats *stats,
+ MR_TrieNode t, MR_ConstBitmapPtr key)
+{
+#define key_format "%d"
+#define key_cast MR_Word
+#define table_type MR_BitmapHashTableSlot
+#define table_field bitmap_slot_ptr
+#define hash(key) (MR_hash_bitmap(key))
+#define equal_keys(k1, k2) (MR_bitmap_cmp((k1), (k2)) == 0)
+#define lookup_only MR_FALSE
+#include "mercury_tabling_stats_defs.h"
+#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
+#undef key_format
+#undef key_cast
+#undef table_type
+#undef table_field
+#undef hash
+#undef equal_keys
+#undef lookup_only
+}
+
+MR_TrieNode
+MR_bitmap_hash_lookup(MR_TrieNode t, MR_ConstBitmapPtr key)
+{
+#define key_format "%d"
+#define key_cast MR_Word
+#define table_type MR_BitmapHashTableSlot
+#define table_field bitmap_slot_ptr
+#define hash(key) (MR_hash_bitmap(key))
+#define equal_keys(k1, k2) (MR_bitmap_cmp((k1), (k2)) == 0)
+#define lookup_only MR_FALSE
+#include "mercury_tabling_stats_nodefs.h"
+#include "mercury_hash_lookup_or_add_body.h"
+#include "mercury_tabling_stats_undefs.h"
+#undef key_format
+#undef key_cast
+#undef table_type
+#undef table_field
+#undef hash
+#undef equal_keys
+#undef lookup_only
+}
+
+MR_TrieNode
MR_word_hash_lookup_or_add(MR_TrieNode t, MR_Word key)
{
#define key_format "%d"
@@ -613,6 +688,15 @@
return strcmp(s1, s2);
}
+static int
+MR_cmp_bitmaps(const void *p1, const void *p2)
+{
+ MR_ConstBitmapPtr s1 = * (MR_ConstBitmapPtr *) p1;
+ MR_ConstBitmapPtr s2 = * (MR_ConstBitmapPtr *) p2;
+
+ return MR_bitmap_cmp(s1, s2);
+}
+
/*
** The MR_HASH_CONTENTS_FUNC_BODY macro implements the bodies of the
** following functions:
@@ -698,6 +782,18 @@
#undef table_field
#undef comp_func
+#define func_name MR_get_bitmap_hash_table_contents
+#define type_name MR_ConstBitmapPtr
+#define table_type MR_BitmapHashTableSlot
+#define table_field bitmap_slot_ptr
+#define comp_func MR_cmp_bitmaps
+MR_HASH_CONTENTS_FUNC_BODY
+#undef func_name
+#undef type_name
+#undef table_type
+#undef table_field
+#undef comp_func
+
/*---------------------------------------------------------------------------*/
/*
Index: runtime/mercury_tabling.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling.h,v
retrieving revision 1.42
diff -u -u -r1.42 mercury_tabling.h
--- runtime/mercury_tabling.h 29 Nov 2006 05:18:26 -0000 1.42
+++ runtime/mercury_tabling.h 8 Feb 2007 12:18:04 -0000
@@ -16,6 +16,7 @@
#define MERCURY_TABLING_H
#include "mercury_types.h"
+#include "mercury_bitmap.h"
#include "mercury_type_info.h"
#include "mercury_float.h"
#include "mercury_reg_workarounds.h"
@@ -360,6 +361,11 @@
extern MR_TrieNode MR_string_hash_lookup_or_add_stats(
MR_TableStepStats *stats, MR_TrieNode table,
MR_ConstString key);
+extern MR_TrieNode MR_bitmap_hash_lookup_or_add(MR_TrieNode table,
+ MR_ConstBitmapPtr key);
+extern MR_TrieNode MR_bitmap_hash_lookup_or_add_stats(
+ MR_TableStepStats *stats, MR_TrieNode table,
+ MR_ConstBitmapPtr key);
extern MR_TrieNode MR_word_hash_lookup_or_add(MR_TrieNode table,
MR_Word key);
extern MR_TrieNode MR_word_hash_lookup_or_add_stats(
@@ -451,6 +457,8 @@
MR_Float key);
extern MR_TrieNode MR_string_hash_lookup(MR_TrieNode table,
MR_ConstString key);
+extern MR_TrieNode MR_bitmap_hash_lookup(MR_TrieNode table,
+ MR_ConstBitmapPtr key);
extern MR_TrieNode MR_word_hash_lookup(MR_TrieNode table,
MR_Word data_value);
@@ -467,6 +475,9 @@
extern MR_bool MR_get_string_hash_table_contents(MR_TrieNode t,
MR_ConstString **values_ptr,
int *value_next_ptr);
+extern MR_bool MR_get_bitmap_hash_table_contents(MR_TrieNode t,
+ MR_ConstBitmapPtr **values_ptr,
+ int *value_next_ptr);
/*
** This function prints statistics about the operation of tabling, if the
Index: runtime/mercury_tabling_macros.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_tabling_macros.h,v
retrieving revision 1.14
diff -u -u -r1.14 mercury_tabling_macros.h
--- runtime/mercury_tabling_macros.h 30 Nov 2006 04:13:53 -0000 1.14
+++ runtime/mercury_tabling_macros.h 8 Feb 2007 12:18:04 -0000
@@ -88,6 +88,12 @@
#define MR_RAW_TABLE_STRING_STATS(stats, table, value) \
MR_string_hash_lookup_or_add_stats((stats), (table), (value));
+#define MR_RAW_TABLE_BITMAP(table, value) \
+ MR_bitmap_hash_lookup_or_add((table), (value));
+
+#define MR_RAW_TABLE_BITMAP_STATS(stats, table, value) \
+ MR_bitmap_hash_lookup_or_add_stats((stats), (table), (value));
+
#define MR_RAW_TABLE_TYPEINFO(table, type_info) \
MR_type_info_lookup_or_add((table), (type_info))
@@ -235,6 +241,20 @@
} \
} while (0)
+#define MR_TABLE_BITMAP(stats, debug, back, t, t0, value) \
+ do { \
+ if (stats != NULL) { \
+ (t) = MR_RAW_TABLE_BITMAP_STATS((stats), (t0), (value)); \
+ } else { \
+ (t) = MR_RAW_TABLE_BITMAP((t0), (value)); \
+ } \
+ if (debug && MR_tabledebug) { \
+ /* XXX print value */ \
+ printf("TABLE %p: bitmap => %p\n", \
+ (t0), (t)); \
+ } \
+ } while (0)
+
#define MR_TABLE_TYPEINFO(stats, debug, back, t, t0, value) \
do { \
if (stats != NULL) { \
Index: runtime/mercury_term_size.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_term_size.c,v
retrieving revision 1.4
diff -u -u -r1.4 mercury_term_size.c
--- runtime/mercury_term_size.c 15 Feb 2005 05:22:32 -0000 1.4
+++ runtime/mercury_term_size.c 8 Feb 2007 12:18:04 -0000
@@ -211,6 +211,14 @@
#endif
return 0;
+ case MR_TYPECTOR_REP_BITMAP:
+#ifdef MR_DEBUG_TERM_SIZES
+ if (MR_heapdebug && MR_lld_print_enabled) {
+ printf("MR_term_size: bitmap %p\n", (void *) term);
+ }
+#endif
+ return 0;
+
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_ENUM_USEREQ:
#ifdef MR_DEBUG_TERM_SIZES
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.123
diff -u -u -r1.123 mercury_type_info.h
--- runtime/mercury_type_info.h 5 Jan 2007 02:19:43 -0000 1.123
+++ runtime/mercury_type_info.h 8 Feb 2007 12:18:04 -0000
@@ -75,7 +75,7 @@
** compiler/type_ctor_info.m and with MR_RTTI_VERSION in mercury_mcpp.h.
*/
-#define MR_RTTI_VERSION MR_RTTI_VERSION__FUNCTOR_NUMBERS
+#define MR_RTTI_VERSION MR_RTTI_VERSION__BITMAP
#define MR_RTTI_VERSION__INITIAL 2
#define MR_RTTI_VERSION__USEREQ 3
#define MR_RTTI_VERSION__CLEAN_LAYOUT 4
@@ -87,6 +87,7 @@
#define MR_RTTI_VERSION__TYPE_INFO_ZERO 10
#define MR_RTTI_VERSION__DUMMY 11
#define MR_RTTI_VERSION__FUNCTOR_NUMBERS 12
+#define MR_RTTI_VERSION__BITMAP 13
/*
** Check that the RTTI version is in a sensible range.
@@ -665,6 +666,7 @@
MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_STABLE_FOREIGN),
MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_PSEUDOTYPEDESC),
MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_DUMMY),
+ MR_DEFINE_BUILTIN_ENUM_CONST(MR_TYPECTOR_REP_BITMAP),
/*
** MR_TYPECTOR_REP_UNKNOWN should remain the last alternative;
** MR_TYPE_CTOR_STATS depends on this.
@@ -735,6 +737,7 @@
"STABLE_FOREIGN", \
"PSEUDO_TYPE_DESC", \
"DUMMY", \
+ "BITMAP", \
"UNKNOWN"
extern MR_ConstString MR_ctor_rep_name[];
Index: runtime/mercury_types.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_types.h,v
retrieving revision 1.48
diff -u -u -r1.48 mercury_types.h
--- runtime/mercury_types.h 14 Dec 2006 04:35:59 -0000 1.48
+++ runtime/mercury_types.h 8 Feb 2007 12:18:04 -0000
@@ -147,6 +147,14 @@
typedef MR_ArrayType *MR_ArrayPtr;
typedef const MR_ArrayType *MR_ConstArrayPtr;
+typedef struct {
+ MR_Integer num_bits;
+ MR_uint_least8_t elements[MR_VARIABLE_SIZED];
+} MR_BitmapType;
+
+typedef MR_BitmapType *MR_BitmapPtr;
+typedef const MR_BitmapType *MR_ConstBitmapPtr;
+
#ifndef MR_HIGHLEVEL_CODE
/*
** Semidet predicates indicate success or failure by leaving nonzero or zero
Index: runtime/mercury_unify_compare_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_unify_compare_body.h,v
retrieving revision 1.42
diff -u -u -r1.42 mercury_unify_compare_body.h
--- runtime/mercury_unify_compare_body.h 5 Oct 2005 06:34:21 -0000 1.42
+++ runtime/mercury_unify_compare_body.h 8 Feb 2007 12:18:04 -0000
@@ -610,6 +610,30 @@
#endif
}
+ case MR_TYPECTOR_REP_BITMAP:
+ {
+ int result;
+ MR_BitmapPtr bx = (MR_BitmapPtr) x;
+ MR_BitmapPtr by = (MR_BitmapPtr) y;
+
+ result = MR_bitmap_cmp(bx, by);
+
+#ifdef select_compare_code
+ if (result == 0) {
+ return_compare_answer(bitmap, bitmap, 0,
+ MR_COMPARE_EQUAL);
+ } else if (result < 0) {
+ return_compare_answer(bitmap, bitmap, 0,
+ MR_COMPARE_LESS);
+ } else {
+ return_compare_answer(bitmap, bitmap, 0,
+ MR_COMPARE_GREATER);
+ }
+#else
+ return_unify_answer(bitmap, bitmap, 0, result == 0);
+#endif
+ }
+
/*
** We use the c_pointer statistics for stable_c_pointer
** until the stable_c_pointer type is actually added,
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list