[m-rev.] diff: clean up extras/trailed_update
Julien Fischer
juliensf at cs.mu.OZ.AU
Wed Mar 2 00:19:52 AEDT 2005
Estimated hours taken: 2.5
Branches: main, release
extras/trailed_update/tr_array.m:
extras/trailed_update/tr_store.m:
extras/trailed_update/var.m:
extras/trailed_update/unsafe.m:
extras/trailed_update/samples/vqueens.m:
Use more recent syntax and make this modules
conform more closely to our coding standard.
Use the new foreign language interface.
Replace deprecated mode and inst syntax.
extras/trailed_update/samples/interpreter.m:
extras/trailed_update/samples/interpreter.exp:
s/mutvar/generic_mutvar/
Julien.
Index: tr_array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/trailed_update/tr_array.m,v
retrieving revision 1.9
diff -u -r1.9 tr_array.m
--- tr_array.m 4 Jun 2002 14:28:52 -0000 1.9
+++ tr_array.m 1 Mar 2005 10:51:32 -0000
@@ -18,22 +18,23 @@
:- import_module array, list, std_util.
%-----------------------------------------------------------------------------%
-
%
% Operations that perform backtrackable destructive update.
%
- % tr_array__set sets the nth element of an array, and returns the
+ % tr_array.set sets the nth element of an array, and returns the
% resulting array (good opportunity for destructive update ;-).
% It is an error if the index is out of bounds.
-:- pred tr_array__set(array(T), int, T, array(T)).
-:- mode tr_array__set(array_mdi, in, in, array_muo) is det.
+ %
+:- pred tr_array.set(array(T)::array_mdi, int::in, T::in,
+ array(T)::array_muo) is det.
- % tr_array__semidet_set sets the nth element of an array,
+ % tr_array.semidet_set sets the nth element of an array,
% and returns the resulting array.
% It fails if the index is out of bounds.
-:- pred tr_array__semidet_set(array(T), int, T, array(T)).
-:- mode tr_array__semidet_set(array_mdi, in, in, array_muo) is semidet.
+ %
+:- pred tr_array.semidet_set(array(T)::array_mdi, int::in, T::in,
+ array(T)::array_muo) is semidet.
%-----------------------------------------------------------------------------%
@@ -44,114 +45,129 @@
% "mostly_unique"-ness.
%
- % tr_array__min returns the lower bound of the array.
- % Note: in this implementation, the lower bound is always zero.
-:- pred tr_array__min(array(_T), int).
-:- mode tr_array__min(array_mui, out) is det.
-:- mode tr_array__min(in, out) is det.
-
- % tr_array__max returns the upper bound of the array.
-:- pred tr_array__max(array(_T), int).
-:- mode tr_array__max(array_mui, out) is det.
-:- mode tr_array__max(in, out) is det.
+ % tr_array.min returns the lower bound of the array.
+ % NOTE: in this implementation, the lower bound is always zero.
+ %
+:- pred tr_array.min(array(_T), int).
+:- mode tr_array.min(array_mui, out) is det.
+:- mode tr_array.min(in, out) is det.
+
+ % tr_array.max returns the upper bound of the array.
+ %
+:- pred tr_array.max(array(_T), int).
+:- mode tr_array.max(array_mui, out) is det.
+:- mode tr_array.max(in, out) is det.
- % tr_array__size returns the length of the array,
+ % tr_array.size returns the length of the array,
% i.e. upper bound - lower bound + 1.
-:- pred tr_array__size(array(_T), int).
-:- mode tr_array__size(array_mui, out) is det.
-:- mode tr_array__size(in, out) is det.
+ %
+:- pred tr_array.size(array(_T), int).
+:- mode tr_array.size(array_mui, out) is det.
+:- mode tr_array.size(in, out) is det.
- % tr_array__bounds returns the upper and lower bounds of an array.
+ % tr_array.bounds returns the upper and lower bounds of an array.
% Note: in this implementation, the lower bound is always zero.
-:- pred tr_array__bounds(array(_T), int, int).
-:- mode tr_array__bounds(array_mui, out, out) is det.
-:- mode tr_array__bounds(in, out, out) is det.
+ %
+:- pred tr_array.bounds(array(_T), int, int).
+:- mode tr_array.bounds(array_mui, out, out) is det.
+:- mode tr_array.bounds(in, out, out) is det.
- % tr_array__in_bounds checks whether an index is in the bounds
+ % tr_array.bounds checks whether an index is in the bounds
% of an array.
-:- pred tr_array__in_bounds(array(_T), int).
-:- mode tr_array__in_bounds(array_mui, in) is semidet.
-:- mode tr_array__in_bounds(in, in) is semidet.
+ %
+:- pred tr_array.in_bounds(array(_T), int).
+:- mode tr_array.in_bounds(array_mui, in) is semidet.
+:- mode tr_array.in_bounds(in, in) is semidet.
%-----------------------------------------------------------------------------%
- % tr_array__lookup returns the Nth element of an array.
+ % tr_array.lookup returns the Nth element of an array.
% It is an error if the index is out of bounds.
-:- pred tr_array__lookup(array(T), int, T).
-:- mode tr_array__lookup(array_mui, in, out) is det.
-:- mode tr_array__lookup(in, in, out) is det.
+ %
+:- pred tr_array.lookup(array(T), int, T).
+:- mode tr_array.lookup(array_mui, in, out) is det.
+:- mode tr_array.lookup(in, in, out) is det.
- % tr_array__semidet_lookup returns the Nth element of an array.
+ % tr_array.semidet_lookup returns the Nth element of an array.
% It fails if the index is out of bounds.
-:- pred tr_array__semidet_lookup(array(T), int, T).
-:- mode tr_array__semidet_lookup(array_mui, in, out) is semidet.
-:- mode tr_array__semidet_lookup(in, in, out) is semidet.
+ %
+:- pred tr_array.semidet_lookup(array(T), int, T).
+:- mode tr_array.semidet_lookup(array_mui, in, out) is semidet.
+:- mode tr_array.semidet_lookup(in, in, out) is semidet.
- % tr_array__slow_set sets the nth element of an array,
+ % tr_array.slow_set sets the nth element of an array,
% and returns the resulting array. The initial array is not
% required to be unique, so the implementation may not be able to use
% destructive update.
% It is an error if the index is out of bounds.
-:- pred tr_array__slow_set(array(T), int, T, array(T)).
-:- mode tr_array__slow_set(array_mui, in, in, array_uo) is det.
-:- mode tr_array__slow_set(in, in, in, array_uo) is det.
+ %
+:- pred tr_array.slow_set(array(T), int, T, array(T)).
+:- mode tr_array.slow_set(array_mui, in, in, array_uo) is det.
+:- mode tr_array.slow_set(in, in, in, array_uo) is det.
- % tr_array__semidet_slow_set sets the nth element of an array,
+ % tr_array.semidet_slow_set sets the nth element of an array,
% and returns the resulting array. The initial array is not
% required to be unique, so the implementation may not be able to use
% destructive update.
% It fails if the index is out of bounds.
-:- pred tr_array__semidet_slow_set(array(T), int, T, array(T)).
-:- mode tr_array__semidet_slow_set(array_mui, in, in, array_uo) is semidet.
-:- mode tr_array__semidet_slow_set(in, in, in, array_uo) is semidet.
+ %
+:- pred tr_array.semidet_slow_set(array(T), int, T, array(T)).
+:- mode tr_array.semidet_slow_set(array_mui, in, in, array_uo) is semidet.
+:- mode tr_array.semidet_slow_set(in, in, in, array_uo) is semidet.
- % tr_array__copy(Array0, Array):
+ % tr_array.copy(Array0, Array):
% Makes a new unique copy of an array.
-:- pred tr_array__copy(array(T), array(T)).
-:- mode tr_array__copy(array_mui, array_uo) is det.
-:- mode tr_array__copy(in, array_uo) is det.
+ %
+:- pred tr_array.copy(array(T), array(T)).
+:- mode tr_array.copy(array_mui, array_uo) is det.
+:- mode tr_array.copy(in, array_uo) is det.
- % tr_array__resize(Array0, Size, Init, Array):
+ % tr_array.resize(Array0, Size, Init, Array):
% The array is expanded or shrunk to make it fit
% the new size `Size'. Any new entries are filled
% with `Init'.
-:- pred tr_array__resize(array(T), int, T, array(T)).
-:- mode tr_array__resize(array_mui, in, in, array_uo) is det.
-:- mode tr_array__resize(in, in, in, array_uo) is det.
+ %
+:- pred tr_array.resize(array(T), int, T, array(T)).
+:- mode tr_array.resize(array_mui, in, in, array_uo) is det.
+:- mode tr_array.resize(in, in, in, array_uo) is det.
- % tr_array__shrink(Array0, Size, Array):
+ % tr_array.shrink(Array0, Size, Array):
% The array is shrunk to make it fit the new size `Size'.
% It is an error if `Size' is larger than the size of `Array0'.
-:- pred tr_array__shrink(array(T), int, array(T)).
-:- mode tr_array__shrink(array_mui, in, array_uo) is det.
-:- mode tr_array__shrink(in, in, array_uo) is det.
+ %
+:- pred tr_array.shrink(array(T), int, array(T)).
+:- mode tr_array.shrink(array_mui, in, array_uo) is det.
+:- mode tr_array.shrink(in, in, array_uo) is det.
- % tr_array__to_list takes an array and returns a list containing
+ % tr_array.to_list takes an array and returns a list containing
% the elements of the array in the same order that they
% occurred in the array.
-:- pred tr_array__to_list(array(T), list(T)).
-:- mode tr_array__to_list(array_mui, out) is det.
-:- mode tr_array__to_list(in, out) is det.
+ %
+:- pred tr_array.to_list(array(T), list(T)).
+:- mode tr_array.to_list(array_mui, out) is det.
+:- mode tr_array.to_list(in, out) is det.
- % tr_array__fetch_items takes an array and a lower and upper
+ % tr_array.fetch_items takes an array and a lower and upper
% index, and places those items in the array between these
% indices into a list. It is an error if either index is
% out of bounds.
-:- pred tr_array__fetch_items(array(T), int, int, list(T)).
-:- mode tr_array__fetch_items(array_mui, in, in, out) is det.
-:- mode tr_array__fetch_items(in, in, in, out) is det.
+ %
+:- pred tr_array.fetch_items(array(T), int, int, list(T)).
+:- mode tr_array.fetch_items(array_mui, in, in, out) is det.
+:- mode tr_array.fetch_items(in, in, in, out) is det.
- % tr_array__bsearch takes an array, an element to be found
+ % tr_array.bsearch takes an array, an element to be found
% and a comparison predicate and returns the position of
% the element in the array. Assumes the array is in sorted
% order. Fails if the element is not present. If the
% element to be found appears multiple times, the index of
% the first occurrence is returned.
-:- pred tr_array__bsearch(array(T), T, pred(T, T, comparison_result),
- maybe(int)).
-:- mode tr_array__bsearch(array_mui, in, pred(in, in, out) is det, out)
- is det.
-:- mode tr_array__bsearch(in, in, pred(in, in, out) is det, out) is det.
+ %
+:- pred tr_array.bsearch(array(T), T, pred(T, T, comparison_result),
+ maybe(int)).
+:- mode tr_array.bsearch(array_mui, in, pred(in, in, out) is det, out)
+ is det.
+:- mode tr_array.bsearch(in, in, pred(in, in, out) is det, out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -161,11 +177,11 @@
/****
lower bounds other than zero are not supported
- % tr_array__resize takes an array and new lower and upper bounds.
+ % tr_array.resize takes an array and new lower and upper bounds.
% the array is expanded or shrunk at each end to make it fit
% the new bounds.
-:- pred tr_array__resize(array(T), int, int, array(T)).
-:- mode tr_array__resize(in, in, in, out) is det.
+:- pred tr_array.resize(array(T), int, int, array(T)).
+:- mode tr_array.resize(in, in, in, out) is det.
****/
%-----------------------------------------------------------------------------%
@@ -175,121 +191,128 @@
% The C type which defines the representation of arrays is
% MR_ArrayType; it is defined in runtime/mercury_library_types.h.
-:- pragma c_header_code("
- #include ""mercury_library_types.h""
-").
+:- pragma foreign_decl("C", "#include ""mercury_library_types.h""").
%-----------------------------------------------------------------------------%
-:- pragma c_code(tr_array__set(Array0::array_mdi, Index::in, Item::in,
- Array::array_muo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ tr_array.set(Array0::array_mdi, Index::in, Item::in, Array::array_muo),
+ [promise_pure, will_not_call_mercury],
"{
MR_ArrayType *array = (MR_ArrayType *) Array0;
if ((MR_Unsigned) Index >= (MR_Unsigned) array->size) {
- MR_fatal_error(""tr_array__set: array index out of bounds"");
+ MR_fatal_error(""tr_array.set: array index out of bounds"");
}
MR_trail_current_value(&array->elements[Index]);
array->elements[Index] = Item; /* destructive update! */
Array = Array0;
}").
-tr_array__semidet_set(Array0, Index, Item, Array) :-
- tr_array__in_bounds(Array0, Index),
- tr_array__set(Array0, Index, Item, Array).
+tr_array.semidet_set(Array0, Index, Item, Array) :-
+ tr_array.in_bounds(Array0, Index),
+ tr_array.set(Array0, Index, Item, Array).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-:- pragma c_code(tr_array__min(Array::array_mui, Min::out),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ tr_array.min(Array::array_mui, Min::out),
+ [promise_pure, will_not_call_mercury],
"
/* Array not used */
Min = 0;
").
-:- pragma c_code(tr_array__min(Array::in, Min::out),
- will_not_call_mercury,
+
+:- pragma foreign_proc("C",
+ tr_array.min(Array::in, Min::out),
+ [promise_pure, will_not_call_mercury],
"
/* Array not used */
Min = 0;
").
-:- pragma c_code(tr_array__max(Array::array_mui, Max::out),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ tr_array.max(Array::array_mui, Max::out),
+ [promise_pure, will_not_call_mercury],
"
Max = ((MR_ArrayType *)Array)->size - 1;
").
-:- pragma c_code(tr_array__max(Array::in, Max::out),
- will_not_call_mercury,
+
+:- pragma foreign_proc("C",
+ tr_array.max(Array::in, Max::out),
+ [promise_pure, will_not_call_mercury],
"
Max = ((MR_ArrayType *)Array)->size - 1;
").
-tr_array__bounds(Array, Min, Max) :-
- tr_array__min(Array, Min),
- tr_array__max(Array, Max).
+tr_array.bounds(Array, Min, Max) :-
+ tr_array.min(Array, Min),
+ tr_array.max(Array, Max).
%-----------------------------------------------------------------------------%
-:- pragma c_code(tr_array__size(Array::array_mui, Max::out),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ tr_array.size(Array::array_mui, Max::out),
+ [promise_pure, will_not_call_mercury],
"
Max = ((MR_ArrayType *)Array)->size;
").
-:- pragma c_code(tr_array__size(Array::in, Max::out),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ tr_array.size(Array::in, Max::out),
+ [promise_pure, will_not_call_mercury],
"
Max = ((MR_ArrayType *)Array)->size;
").
%-----------------------------------------------------------------------------%
-tr_array__in_bounds(Array, Index) :-
- tr_array__bounds(Array, Min, Max),
+tr_array.in_bounds(Array, Index) :-
+ tr_array.bounds(Array, Min, Max),
Min =< Index, Index =< Max.
-tr_array__semidet_lookup(Array, Index, Item) :-
- tr_array__in_bounds(Array, Index),
- tr_array__lookup(Array, Index, Item).
+tr_array.semidet_lookup(Array, Index, Item) :-
+ tr_array.in_bounds(Array, Index),
+ tr_array.lookup(Array, Index, Item).
-tr_array__semidet_slow_set(Array0, Index, Item, Array) :-
- tr_array__in_bounds(Array0, Index),
- tr_array__slow_set(Array0, Index, Item, Array).
+tr_array.semidet_slow_set(Array0, Index, Item, Array) :-
+ tr_array.in_bounds(Array0, Index),
+ tr_array.slow_set(Array0, Index, Item, Array).
-tr_array__slow_set(Array0, Index, Item, Array) :-
- tr_array__copy(Array0, Array1),
- array__set(Array1, Index, Item, Array).
+tr_array.slow_set(Array0, Index, Item, Array) :-
+ tr_array.copy(Array0, Array1),
+ array.set(Array1, Index, Item, Array).
%-----------------------------------------------------------------------------%
-:- pragma c_code(tr_array__lookup(Array::array_mui, Index::in, Item::out),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ tr_array.lookup(Array::array_mui, Index::in, Item::out),
+ [promise_pure, will_not_call_mercury],
"{
MR_ArrayType *array = (MR_ArrayType *) Array;
if ((MR_Unsigned) Index >= (MR_Unsigned) array->size) {
- MR_fatal_error(""tr_array__lookup: ""
- ""array index out of bounds"");
+ MR_fatal_error(""tr_array.lookup: array index out of bounds"");
}
Item = array->elements[Index];
}").
-:- pragma c_code(tr_array__lookup(Array::in, Index::in, Item::out),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ tr_array.lookup(Array::in, Index::in, Item::out),
+ [promise_pure, will_not_call_mercury],
"{
MR_ArrayType *array = (MR_ArrayType *) Array;
if ((MR_Unsigned) Index >= (MR_Unsigned) array->size) {
- MR_fatal_error(""tr_array__lookup: array index out of bounds"");
+ MR_fatal_error(""tr_array.lookup: array index out of bounds"");
}
Item = array->elements[Index];
}").
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
void ML_tr_resize_array(MR_ArrayType *array, const MR_ArrayType *old_array,
- MR_Integer array_size, MR_Word item);
+ MR_Integer array_size, MR_Word item);
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
void
ML_tr_resize_array(MR_ArrayType *array, const MR_ArrayType *old_array,
MR_Integer array_size, MR_Word item)
@@ -317,35 +340,33 @@
}
").
-:- pragma c_code(
- tr_array__resize(Array0::array_mui, Size::in, Item::in,
+:- pragma foreign_proc("C",
+ tr_array.resize(Array0::array_mui, Size::in, Item::in,
Array::array_uo),
- will_not_call_mercury,
+ [promise_pure, will_not_call_mercury],
"
MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
ML_tr_resize_array((MR_ArrayType *)Array, (const MR_ArrayType *)Array0,
Size, Item);
").
-:- pragma c_code(
- tr_array__resize(Array0::in, Size::in, Item::in,
- Array::array_uo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ tr_array.resize(Array0::in, Size::in, Item::in, Array::array_uo),
+ [promise_pure, will_not_call_mercury],
"
MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
ML_tr_resize_array((MR_ArrayType *)Array, (const MR_ArrayType *)Array0,
Size, Item);
").
-
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
void ML_tr_shrink_array(MR_ArrayType *, const MR_ArrayType *old_array,
- MR_Integer array_size);
+ MR_Integer array_size);
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
void
ML_tr_shrink_array(MR_ArrayType *array, const MR_ArrayType *old_array,
MR_Integer array_size)
@@ -356,7 +377,7 @@
old_array_size = old_array->size;
if (old_array_size < array_size) {
MR_fatal_error(
- ""tr_array__shrink: can't shrink to a larger size"");
+ ""tr_array.shrink: can't shrink to a larger size"");
}
array->size = array_size;
@@ -371,18 +392,18 @@
}
").
-:- pragma c_code(
- tr_array__shrink(Array0::array_mui, Size::in, Array::array_uo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ tr_array.shrink(Array0::array_mui, Size::in, Array::array_uo),
+ [promise_pure, will_not_call_mercury],
"
MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
ML_tr_shrink_array((MR_ArrayType *) Array,
(const MR_ArrayType *) Array0, Size);
").
-:- pragma c_code(
- tr_array__shrink(Array0::in, Size::in, Array::array_uo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ tr_array.shrink(Array0::in, Size::in, Array::array_uo),
+ [promise_pure, will_not_call_mercury],
"
MR_incr_hp_msg(Array, Size + 1, MR_PROC_LABEL, ""array:array/1"");
ML_tr_shrink_array((MR_ArrayType *) Array,
@@ -391,11 +412,11 @@
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
void ML_tr_copy_array(MR_ArrayType *array, const MR_ArrayType *old_array);
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
void
ML_tr_copy_array(MR_ArrayType *array, const MR_ArrayType *old_array)
{
@@ -415,18 +436,18 @@
}
").
-:- pragma c_code(
- tr_array__copy(Array0::array_mui, Array::array_uo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ tr_array.copy(Array0::array_mui, Array::array_uo),
+ [promise_pure, will_not_call_mercury],
"
MR_incr_hp_msg(Array, ((const MR_ArrayType *)Array0)->size + 1,
MR_PROC_LABEL, ""array:array/1"");
ML_tr_copy_array((MR_ArrayType *)Array, (const MR_ArrayType *)Array0);
").
-:- pragma c_code(
- tr_array__copy(Array0::in, Array::array_uo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ tr_array.copy(Array0::in, Array::array_uo),
+ [promise_pure, will_not_call_mercury],
"
MR_incr_hp_msg(Array, ((const MR_ArrayType *)Array0)->size + 1,
MR_PROC_LABEL, ""array:array/1"");
@@ -435,36 +456,36 @@
%-----------------------------------------------------------------------------%
-tr_array__to_list(Array, List) :-
- tr_array__bounds(Array, Low, High),
- tr_array__fetch_items(Array, Low, High, List).
+tr_array.to_list(Array, List) :-
+ tr_array.bounds(Array, Low, High),
+ tr_array.fetch_items(Array, Low, High, List).
%-----------------------------------------------------------------------------%
-tr_array__fetch_items(Array, Low, High, List) :-
+tr_array.fetch_items(Array, Low, High, List) :-
(
Low > High
->
List = []
;
- Low1 is Low + 1,
- tr_array__fetch_items(Array, Low1, High, List0),
- tr_array__lookup(Array, Low, Item),
+ Low1 = Low + 1,
+ tr_array.fetch_items(Array, Low1, High, List0),
+ tr_array.lookup(Array, Low, Item),
List = [Item|List0]
).
%-----------------------------------------------------------------------------%
-tr_array__bsearch(A, El, Compare, Result) :-
- tr_array__bounds(A, Lo, Hi),
- tr_array__bsearch_2(A, Lo, Hi, El, Compare, Result).
+tr_array.bsearch(A, El, Compare, Result) :-
+ tr_array.bounds(A, Lo, Hi),
+ tr_array.bsearch_2(A, Lo, Hi, El, Compare, Result).
-:- pred tr_array__bsearch_2(array(T), int, int, T,
+:- pred tr_array.bsearch_2(array(T), int, int, T,
pred(T, T, comparison_result), maybe(int)).
-:- mode tr_array__bsearch_2(in, in, in, in, pred(in, in, out) is det,
+:- mode tr_array.bsearch_2(in, in, in, in, pred(in, in, out) is det,
out) is det.
-tr_array__bsearch_2(Array, Lo, Hi, El, Compare, Result) :-
- Width is Hi - Lo,
+tr_array.bsearch_2(Array, Lo, Hi, El, Compare, Result) :-
+ Width = Hi - Lo,
% If Width < 0, there is no range left.
( Width < 0 ->
@@ -473,8 +494,8 @@
% If Width == 0, we may just have found our element.
% Do a Compare to check.
( Width = 0 ->
- tr_array__lookup(Array, Lo, X),
- ( call(Compare, El, X, (=)) ->
+ tr_array.lookup(Array, Lo, X),
+ ( Compare(El, X, (=)) ->
Result = yes(Lo)
;
Result = no
@@ -482,20 +503,24 @@
;
% Otherwise find the middle element of the range
% and check against that.
- Mid is (Lo + Hi) >> 1, % `>> 1' is hand-optimized `div 2'.
- tr_array__lookup(Array, Mid, XMid),
- call(Compare, XMid, El, Comp),
- ( Comp = (<),
- Mid1 is Mid + 1,
- tr_array__bsearch_2(Array, Mid1, Hi, El, Compare, Result)
- ; Comp = (=),
- tr_array__bsearch_2(Array, Lo, Mid, El, Compare, Result)
- ; Comp = (>),
- Mid1 is Mid - 1,
- tr_array__bsearch_2(Array, Lo, Mid1, El, Compare, Result)
+ Mid = (Lo + Hi) >> 1, % `>> 1' is hand-optimized `div 2'.
+ tr_array.lookup(Array, Mid, XMid),
+ Compare(XMid, El, Comp),
+ (
+ Comp = (<),
+ Mid1 = Mid + 1,
+ tr_array.bsearch_2(Array, Mid1, Hi, El, Compare, Result)
+ ;
+ Comp = (=),
+ tr_array.bsearch_2(Array, Lo, Mid, El, Compare, Result)
+ ;
+ Comp = (>),
+ Mid1 = Mid - 1,
+ tr_array.bsearch_2(Array, Lo, Mid1, El, Compare, Result)
)
)
).
%-----------------------------------------------------------------------------%
+:- end_module tr_array.
%-----------------------------------------------------------------------------%
Index: tr_store.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/trailed_update/tr_store.m,v
retrieving revision 1.12.2.1
diff -u -r1.12.2.1 tr_store.m
--- tr_store.m 1 Mar 2005 06:06:57 -0000 1.12.2.1
+++ tr_store.m 1 Mar 2005 11:45:36 -0000
@@ -10,7 +10,7 @@
%
% This file provides facilities for manipulating mutable backtrackable stores.
% This is a backtrackable version of the standard library module `store.m';
-% the interface and implementation are almost identifical to store.m,
+% the interface and implementation are almost identical to store.m,
% the only difference is that destructive updates are recorded on a trail
% so that updates can be undone on backtracking.
%
@@ -31,24 +31,27 @@
% create a new mutable variable,
% initialized with the specified value
-:- pred tr_store__new_mutvar(T, generic_mutvar(T, S), store(S), store(S)).
-:- mode tr_store__new_mutvar(in, out, mdi, muo) is det.
+ %
+:- pred tr_store.new_mutvar(T::in, generic_mutvar(T, S)::out,
+ store(S)::mdi, store(S)::muo) is det.
% copy_mutvar(Mutvar, Copy, S0, S)
% is equivalent to
% get_mutvar(Mutvar, Value, S0, S1),
% new_mutvar(Value, Copy, S1, S )
-:- pred tr_store__copy_mutvar(generic_mutvar(T, S), generic_mutvar(T, S),
- store(S), store(S)).
-:- mode tr_store__copy_mutvar(in, out, mdi, muo) is det.
+ %
+:- pred tr_store.copy_mutvar(generic_mutvar(T, S)::in,
+ generic_mutvar(T, S)::out, store(S)::mdi, store(S)::muo) is det.
% lookup the value stored in a given mutable variable
-:- pred tr_store__get_mutvar(generic_mutvar(T, S), T, store(S), store(S)).
-:- mode tr_store__get_mutvar(in, out, mdi, muo) is det.
+ %
+:- pred tr_store.get_mutvar(generic_mutvar(T, S)::in, T::out,
+ store(S)::mdi, store(S)::muo) is det.
% replace the value stored in a given mutable variable
-:- pred tr_store__set_mutvar(generic_mutvar(T, S), T, store(S), store(S)).
-:- mode tr_store__set_mutvar(in, in, mdi, muo) is det.
+ %
+:- pred tr_store.set_mutvar(generic_mutvar(T, S)::in, T::in,
+ store(S)::mdi, store(S)::muo) is det.
%-----------------------------------------------------------------------------%
%
@@ -63,15 +66,16 @@
% of the representation of that value.
% It does however allocate one cell to hold the reference;
% you can use new_arg_ref to avoid that.)
-:- pred tr_store__new_ref(T, generic_ref(T, S), store(S), store(S)).
-:- mode tr_store__new_ref(mdi, out, mdi, muo) is det.
+ %
+:- pred tr_store.new_ref(T::mdi, generic_ref(T, S)::out,
+ store(S)::mdi, store(S)::muo) is det.
- % ref_functor(Ref, Functor, Arity):
+ % tr_store.ref_functor(Ref, Functor, Arity):
% Given a reference to a term, return the functor and arity
% of that term.
-:- pred tr_store__ref_functor(generic_ref(T, S), string, int,
- store(S), store(S)).
-:- mode tr_store__ref_functor(in, out, out, mdi, muo) is det.
+ %
+:- pred tr_store.ref_functor(generic_ref(T, S)::in, string::out, int::out,
+ store(S)::mdi, store(S)::muo) is det.
% arg_ref(Ref, ArgNum, ArgRef):
% /* Psuedo-C code: ArgRef = &Ref[ArgNum]; */
@@ -80,9 +84,9 @@
% (argument numbers start from zero).
% It is an error if the argument number is out of range,
% or if the argument reference has the wrong type.
-:- pred tr_store__arg_ref(generic_ref(T, S), int, generic_ref(ArgT, S),
- store(S), store(S)).
-:- mode tr_store__arg_ref(in, in, out, mdi, muo) is det.
+ %
+:- pred tr_store.arg_ref(generic_ref(T, S)::in, int::in,
+ generic_ref(ArgT, S)::out, store(S)::mdi, store(S)::muo) is det.
% new_arg_ref(Val, ArgNum, ArgRef):
% /* Psuedo-C code: ArgRef = &Val[ArgNum]; */
@@ -90,9 +94,9 @@
% except that it is more efficient.
% It is an error if the argument number is out of range,
% or if the argument reference has the wrong type.
-:- pred tr_store__new_arg_ref(T, int, generic_ref(ArgT, S),
- store(S), store(S)).
-:- mode tr_store__new_arg_ref(mdi, in, out, mdi, muo) is det.
+ %
+:- pred tr_store.new_arg_ref(T::mdi, int::in, generic_ref(ArgT, S)::out,
+ store(S)::mdi, store(S)::muo) is det.
% set_ref(Ref, ValueRef):
% /* Pseudo-C code: *Ref = *ValueRef; */
@@ -100,29 +104,32 @@
% a reference to another term (ValueRef),
% update the store so that the term referred to by Ref
% is replaced with the term referenced by ValueRef.
-:- pred tr_store__set_ref(generic_ref(T, S), generic_ref(T, S),
- store(S), store(S)).
-:- mode tr_store__set_ref(in, in, mdi, muo) is det.
+ %
+:- pred tr_store.set_ref(generic_ref(T, S)::in, generic_ref(T, S)::in,
+ store(S)::mdi, store(S)::muo) is det.
% set_ref_value(Ref, Value):
% /* Pseudo-C code: *Ref = Value; */
% Given a reference to a term (Ref), and a value (Value),
% update the store so that the term referred to by Ref
% is replaced with Value.
-:- pred tr_store__set_ref_value(generic_ref(T, S), T, store(S), store(S)).
-:- mode tr_store__set_ref_value(in, mdi, mdi, muo) is det.
+ %
+:- pred tr_store.set_ref_value(generic_ref(T, S)::in, T::mdi,
+ store(S)::mdi, store(S)::muo) is det.
% Given a reference to a term, return that term.
- % Note that this requires making a copy, so this pred may
+ % NOTE: this requires making a copy, so this pred may
% be inefficient if used to return large terms; it
% is most efficient with atomic terms.
-:- pred tr_store__copy_ref_value(generic_ref(T, S), T, store(S), store(S)).
-:- mode tr_store__copy_ref_value(in, uo, mdi, muo) is det.
+ %
+:- pred tr_store.copy_ref_value(generic_ref(T, S)::in, T::uo,
+ store(S)::mdi, store(S)::muo) is det.
% Same as above, but without making a copy.
% Destroys the store.
-:- pred tr_store__extract_ref_value(store(S), generic_ref(T, S), T).
-:- mode tr_store__extract_ref_value(mdi, in, out) is det.
+ %
+:- pred tr_store.extract_ref_value(store(S)::mdi, generic_ref(T, S)::in,
+ T::out) is det.
%-----------------------------------------------------------------------------%
%
@@ -145,14 +152,12 @@
% or if the argument reference has the wrong type,
% or if the argument is a `no_tag' type,
% then the behaviour is undefined, and probably harmful.
+ %
+:- pred tr_store.unsafe_arg_ref(generic_ref(T, S)::in, int::in,
+ generic_ref(ArgT, S)::out, store(S)::mdi, store(S)::muo) is det.
-:- pred tr_store__unsafe_arg_ref(generic_ref(T, S), int, generic_ref(ArgT, S),
- store(S), store(S)).
-:- mode tr_store__unsafe_arg_ref(in, in, out, mdi, muo) is det.
-
-:- pred tr_store__unsafe_new_arg_ref(T, int, generic_ref(ArgT, S),
- store(S), store(S)).
-:- mode tr_store__unsafe_new_arg_ref(mdi, in, out, mdi, muo) is det.
+:- pred tr_store.unsafe_new_arg_ref(T::mdi, int::in,
+ generic_ref(ArgT, S)::out, store(S)::mdi, store(S)::muo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -160,27 +165,30 @@
:- implementation.
:- import_module std_util.
-:- pragma c_code(new_mutvar(Val::in, Mutvar::out, S0::mdi, S::muo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ new_mutvar(Val::in, Mutvar::out, S0::mdi, S::muo),
+ [promise_pure, will_not_call_mercury],
"
MR_incr_hp(Mutvar, 1);
*(MR_Word *)Mutvar = Val;
S = S0;
").
-copy_mutvar(Mutvar, Copy) -->
- tr_store__get_mutvar(Mutvar, Val),
- tr_store__new_mutvar(Val, Copy).
-
-:- pragma c_code(get_mutvar(Mutvar::in, Val::out, S0::mdi, S::muo),
- will_not_call_mercury,
+copy_mutvar(Mutvar, Copy, !S) :-
+ tr_store.get_mutvar(Mutvar, Val, !S),
+ tr_store.new_mutvar(Val, Copy, !S).
+
+:- pragma foreign_proc("C",
+ get_mutvar(Mutvar::in, Val::out, S0::mdi, S::muo),
+ [promise_pure, will_not_call_mercury],
"
Val = *(MR_Word *)Mutvar;
S = S0;
").
-:- pragma c_code(set_mutvar(Mutvar::in, Val::in, S0::mdi, S::muo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ set_mutvar(Mutvar::in, Val::in, S0::mdi, S::muo),
+ [promise_pure, will_not_call_mercury],
"
MR_trail_current_value((MR_Word *) Mutvar);
*(MR_Word *)Mutvar = Val;
@@ -189,8 +197,9 @@
%-----------------------------------------------------------------------------%
-:- pragma c_code(new_ref(Val::mdi, Ref::out, S0::mdi, S::muo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ new_ref(Val::mdi, Ref::out, S0::mdi, S::muo),
+ [promise_pure, will_not_call_mercury],
"
MR_incr_hp(Ref, 1);
*(MR_Word *)Ref = Val;
@@ -201,29 +210,29 @@
/* XXX need to deep-copy non-atomic types */
unsafe_ref_value(Ref, Val).
- % unsafe_ref_value extracts the value that a reference
- % refers to, without making a copy; it is unsafe because
- % the store could later be modified, changing the returned
- % value.
-:- pred tr_store__unsafe_ref_value(generic_ref(T, S), T, store(S), store(S)).
-:- mode tr_store__unsafe_ref_value(in, uo, mdi, muo) is det.
-:- pragma c_code(unsafe_ref_value(Ref::in, Val::uo, S0::mdi, S::muo),
- will_not_call_mercury,
+ % unsafe_ref_value extracts the value that a reference refers
+ % to, without making a copy; it is unsafe because the store
+ % could later be modified, changing the returned value.
+ %
+:- pred tr_store.unsafe_ref_value(generic_ref(T, S)::in, T::uo,
+ store(S)::mdi, store(S)::muo) is det.
+:- pragma foreign_proc("C",
+ unsafe_ref_value(Ref::in, Val::uo, S0::mdi, S::muo),
+ [promise_pure, will_not_call_mercury],
"
Val = *(MR_Word *)Ref;
S = S0;
").
-ref_functor(Ref, Functor, Arity) -->
- unsafe_ref_value(Ref, Val),
- { functor(Val, Functor, Arity) }.
-
-:- pragma c_header_code("
-#include ""mercury_deconstruct.h""
-").
-
-:- pragma c_code(arg_ref(Ref::in, ArgNum::in, ArgRef::out, S0::mdi, S::muo),
- will_not_call_mercury,
+ref_functor(Ref, Functor, Arity, !S) :-
+ unsafe_ref_value(Ref, Val, !S),
+ functor(Val, Functor, Arity).
+
+:- pragma foreign_decl("C", "#include ""mercury_deconstruct.h""").
+
+:- pragma foreign_proc("C",
+ arg_ref(Ref::in, ArgNum::in, ArgRef::out, S0::mdi, S::muo),
+ [promise_pure, will_not_call_mercury],
"{
MR_TypeInfo arg_type_info;
MR_Word* arg_ref;
@@ -233,14 +242,14 @@
if (!MR_arg((MR_TypeInfo) TypeInfo_for_T, (MR_Word *) Ref, ArgNum,
&arg_type_info, &arg_ref, MR_NONCANON_ALLOW))
{
- MR_fatal_error(""tr_store__arg_ref: ""
- ""argument number out of range"");
+ MR_fatal_error(
+ ""tr_store.arg_ref: argument number out of range"");
}
if (MR_compare_type_info(arg_type_info,
(MR_TypeInfo) TypeInfo_for_ArgT) != MR_COMPARE_EQUAL)
{
- MR_fatal_error(""tr_store__arg_ref: argument has wrong type"");
+ MR_fatal_error(""tr_store.arg_ref: argument has wrong type"");
}
MR_restore_transient_registers();
@@ -249,9 +258,9 @@
S = S0;
}").
-:- pragma c_code(new_arg_ref(Val::mdi, ArgNum::in, ArgRef::out,
- S0::mdi, S::muo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ new_arg_ref(Val::mdi, ArgNum::in, ArgRef::out, S0::mdi, S::muo),
+ [promise_pure, will_not_call_mercury],
"{
MR_TypeInfo arg_type_info;
MR_Word* arg_ref;
@@ -261,15 +270,15 @@
if (!MR_arg((MR_TypeInfo) TypeInfo_for_T, (MR_Word *) &Val, ArgNum,
&arg_type_info, &arg_ref, MR_NONCANON_ALLOW))
{
- MR_fatal_error(""tr_store__new_arg_ref: ""
- ""argument number out of range"");
+ MR_fatal_error(
+ ""tr_store.new_arg_ref: argument number out of range"");
}
if (MR_compare_type_info(arg_type_info,
(MR_TypeInfo) TypeInfo_for_ArgT) != MR_COMPARE_EQUAL)
{
- MR_fatal_error(""tr_store__new_arg_ref: ""
- ""argument has wrong type"");
+ MR_fatal_error(
+ ""tr_store.new_arg_ref: argument has wrong type"");
}
MR_restore_transient_registers();
@@ -289,33 +298,36 @@
S = S0;
}").
-:- pragma c_code(set_ref(Ref::in, ValRef::in, S0::mdi, S::muo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ set_ref(Ref::in, ValRef::in, S0::mdi, S::muo),
+ [promise_pure, will_not_call_mercury],
"
MR_trail_current_value((MR_Word *) Ref);
*(MR_Word *)Ref = *(MR_Word *)ValRef;
S = S0;
").
-:- pragma c_code(set_ref_value(Ref::in, Val::mdi, S0::mdi, S::muo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ set_ref_value(Ref::in, Val::mdi, S0::mdi, S::muo),
+ [promise_pure, will_not_call_mercury],
"
MR_trail_current_value((MR_Word *) Ref);
*(MR_Word *)Ref = Val;
S = S0;
").
-:- pragma c_code(extract_ref_value(_S::mdi, Ref::in, Val::out),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ extract_ref_value(_S::mdi, Ref::in, Val::out),
+ [promise_pure, will_not_call_mercury],
"
Val = *(MR_Word *)Ref;
").
%-----------------------------------------------------------------------------%
-:- pragma c_code(unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out,
- S0::mdi, S::muo),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, S0::mdi, S::muo),
+ [promise_pure, will_not_call_mercury],
"{
/* unsafe - does not check type & arity, won't handle no_tag types */
MR_Word *Ptr = (MR_Word *) MR_strip_tag(Ref);
@@ -323,8 +335,9 @@
S = S0;
}").
-:- pragma c_code(unsafe_new_arg_ref(Val::mdi, Arg::in, ArgRef::out,
- S0::mdi, S::muo), will_not_call_mercury,
+:- pragma foreign_proc("C",
+ unsafe_new_arg_ref(Val::mdi, Arg::in, ArgRef::out, S0::mdi, S::muo),
+ [promise_pure, will_not_call_mercury],
"{
/* unsafe - does not check type & arity, won't handle no_tag types */
MR_Word *Ptr = (MR_Word *) MR_strip_tag(Val);
@@ -332,4 +345,6 @@
S = S0;
}").
+%-----------------------------------------------------------------------------%
+:- end_module tr_store.
%-----------------------------------------------------------------------------%
Index: unsafe.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/trailed_update/unsafe.m,v
retrieving revision 1.4
diff -u -r1.4 unsafe.m
--- unsafe.m 13 Aug 2002 13:44:56 -0000 1.4
+++ unsafe.m 1 Mar 2005 12:38:05 -0000
@@ -1,5 +1,5 @@
%-----------------------------------------------------------------------------%
-% Copyright (C) 1997 The University of Melbourne.
+% Copyright (C) 1997, 2004 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.
%-----------------------------------------------------------------------------%
@@ -53,19 +53,24 @@
%-----------------------------------------------------------------------------%
-:- pragma c_code(unsafe_promise_ground(X::in(any)) = (Y::out), "Y = X;").
+:- pragma foreign_proc("C",
+ unsafe_promise_ground(X::in(any)) = (Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ Y = X;
+").
%-----------------------------------------------------------------------------%
-:- pragma c_code(
-unsafe_perform_io(P::(pred(di, uo) is det)),
- may_call_mercury,
+:- pragma foreign_proc("C",
+ unsafe_perform_io(P::(pred(di, uo) is det)),
+ [may_call_mercury],
"{
call_io_pred_det(P);
}").
-:- pragma c_code(
-unsafe_perform_io(P::(pred(di, uo) is cc_multi)),
- may_call_mercury,
+:- pragma foreign_proc("C",
+ unsafe_perform_io(P::(pred(di, uo) is cc_multi)),
+ [may_call_mercury],
"{
call_io_pred_cc_multi(P);
}").
Index: var.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/trailed_update/var.m,v
retrieving revision 1.22.2.1
diff -u -r1.22.2.1 var.m
--- var.m 1 Mar 2005 06:06:58 -0000 1.22.2.1
+++ var.m 1 Mar 2005 12:03:20 -0000
@@ -12,7 +12,7 @@
% in other words, it provides Prolog-style variables.
%
% It also provides some features for delaying (a.k.a dynamic scheduling,
-% or corouting), specifically freeze/2 and freeze/3. However, this
+% or coroutining), specifically freeze/2 and freeze/3. However, this
% interface is not yet stable; it may undergo significant changes,
% or even be removed, in future releases. (The reason for this is
% that there are some problems with mode checking higher-order terms
@@ -24,44 +24,45 @@
% for cyclic terms; if you attempt to do anything much with cyclic terms,
% your program will probably not terminate.
%
-% NOTE: The current implementation of this module makes some assumptions
-% about the representation of Mercury terms which mean that it does not work
-% in ".rt" (--reserve-tag) grades.
-%
%-----------------------------------------------------------------------------%
+
:- module var.
:- interface.
:- import_module io, std_util.
% A `var(T)' is a Prolog-style variable that holds a value of type T.
+ %
:- solver type var(T).
% `init(Var)' can be used to initialize
% the inst of a variable to `any'.
-:- pred init(var(T)::out(any)) is det.
+ %
+:- pred init(var(T)::oa) is det.
% `Var = var(Value)' unifies a variable with its value.
% This can be used in several ways:
% to bind a variable to a particular value, `X = var(42)';
% to extract the value of that variable, `X = var(Y)';
% or (NYI) to initialize the inst of a variable to any, `X = var(_)'.
+ %
:- func var(T) = var(T).
:- mode var(in) = out is det.
-:- mode var(in) = in(any) is semidet.
+:- mode var(in) = ia is semidet.
:- mode var(in) = in is semidet.
:- mode var(out) = in is det.
% `Var1 == Var2' can be used to unify two variables.
% Alternatively, you can just use `=' rather than `==',
- % but `=' doesn't support the `out(any) = out(any)' mode yet.
+ % but `=' doesn't support the `oa = oa' mode yet.
+ %
:- pred var(T) == var(T).
-:- mode in == in is semidet.
-:- mode in == out is det.
+:- mode in == in is semidet.
+:- mode in == out is det.
:- mode out == in is det.
-:- mode in(any) == in(any) is semidet.
-:- mode in(any) == out(any) is det.
-:- mode out(any) == in(any) is det.
-:- mode out(any) == out(any) is det.
+:- mode ia == ia is semidet.
+:- mode ia == oa is det.
+:- mode oa == ia is det.
+:- mode oa == oa is det.
% `freeze(Var, Pred)' can be used to delay execution of a goal
% until a variable is ground.
@@ -73,9 +74,10 @@
% and then calls Pred(Var).
% Warning: the interface to this predicate may be modified in
% future releases.
+ %
:- pred freeze(var(T), pred(T)).
-:- mode freeze(in(any), pred(in) is semidet) is semidet.
-:- mode freeze(out(any), pred(in) is semidet) is semidet.
+:- mode freeze(ia, pred(in) is semidet) is semidet.
+:- mode freeze(oa, pred(in) is semidet) is semidet.
% `freeze(Var1, Pred, Var2)' can be used to delay
% execution of a goal until a variable is ground.
@@ -86,35 +88,38 @@
% and then calls Pred(X, Y).
% Warning: the interface to this predicate may be modified in
% future releases.
+ %
:- pred freeze(var(T1), pred(T1, T2), var(T2)).
:- mode freeze(in, pred(in, out) is det, out) is semidet. % really det
:- mode freeze(in, pred(in, out) is semidet, out) is semidet.
-:- mode freeze(out(any), pred(in, out) is det, out(any)) is semidet.
-:- mode freeze(out(any), pred(in, out) is semidet, out(any)) is semidet.
+:- mode freeze(oa, pred(in, out) is det, oa) is semidet.
+:- mode freeze(oa, pred(in, out) is semidet, oa) is semidet.
:- pred freeze_var(var(T1), pred(T1, var(T2)), var(T2)).
-:- mode freeze_var(out(any), pred(in, in(any)) is semidet, out(any)) is semidet.
+:- mode freeze_var(oa, pred(in, ia) is semidet, oa) is semidet.
% `debug_freeze(Message, Var, Pred)'
% is the same as `freeze(Var, Pred)' except
% that it also prints out some debugging information.
% WARNING: this is a non-logical hack, use only for debugging!
+ %
:- impure pred debug_freeze(string, var(T), pred(T)).
-:- mode debug_freeze(in, in(any), pred(in) is semidet) is semidet.
-:- mode debug_freeze(in, out(any), pred(in) is semidet) is semidet.
+:- mode debug_freeze(in, ia, pred(in) is semidet) is semidet.
+:- mode debug_freeze(in, oa, pred(in) is semidet) is semidet.
:- impure pred debug_freeze(string, var(T1), pred(T1, T2), var(T2)).
-:- mode debug_freeze(in, in, pred(in, out) is semidet, out) is semidet.
-:- mode debug_freeze(in, out(any), pred(in, out) is semidet, out(any))
- is semidet.
+:- mode debug_freeze(in, in, pred(in, out) is semidet, out) is semidet.
+:- mode debug_freeze(in, oa, pred(in, out) is semidet, oa) is semidet.
% dump_var prints out a representation of a variable.
-:- pred dump_var(var(T)::in(any), io__state::di, io__state::uo) is cc_multi.
+ %
+:- pred dump_var(var(T)::ia, io::di, io::uo) is cc_multi.
% unsafe_dump_var/1: an impure version of dump_var/3.
-:- impure pred unsafe_dump_var(var(T)::in(any)) is det.
+ %
+:- impure pred unsafe_dump_var(var(T)::ia) is det.
- % var__is_ground/2 can be used to test if a variable is ground.
+ % var.is_ground/2 can be used to test if a variable is ground.
%
% Declaratively, is_ground(Var, Result) is true iff
% either Result = no or Var = var(Value) and Result = yes(Value);
@@ -130,18 +135,19 @@
%
% Beware that is_ground is, and must be, `cc_multi';
% making it `det' would not be safe.
-
-:- pred is_ground(var(T)::in(any), maybe(T)::out) is cc_multi.
+ %
+:- pred is_ground(var(T)::ia, maybe(T)::out) is cc_multi.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+
:- implementation.
-%-----------------------------------------------------------------------------%
+
:- import_module bool.
:- import_module unsafe, io.
:- import_module require.
-:- pragma c_header_code("#include <stdio.h>").
+:- pragma foreign_decl("C", "#include <stdio.h>").
%-----------------------------------------------------------------------------%
%
@@ -163,7 +169,8 @@
%---------------------------------------------------------------------------%
% (Note that the representation can be printed out, if you call
- % io__write(Var), so this is not entirely hidden from the user.)
+ % io.write(Var), so this is not entirely hidden from the user.)
+ %
:- solver type var(T)
where representation is var_rep(T),
initialisation is init,
@@ -177,22 +184,19 @@
; alias(var_rep(T))
; ground(T).
-:- inst var_rep_any =
- bound( free
+:- inst var_rep_any
+ ---> free
; free(delayed_conj)
; alias(var_rep_any)
- ; ground(ground)
- ).
-:- inst var_rep_ground =
- bound( alias(var_rep_ground)
- ; ground(ground)
- ).
-:- inst var_rep_deref_ground =
- bound( ground(ground)
- ).
-:- inst var_rep_deref_delayed =
- bound( free(delayed_conj)
- ).
+ ; ground(ground).
+
+:- inst var_rep_ground
+ ---> alias(var_rep_ground)
+ ; ground(ground).
+
+:- inst var_rep_deref_ground ---> ground(ground).
+
+:- inst var_rep_deref_delayed ---> free(delayed_conj).
% We use an extra level of indirection so that we can do
% (backtrackable) destructive update on variable representations
@@ -202,8 +206,8 @@
% ought to be unique, because the lack of support for aliasing
% makes `unique-input' modes impossible.
-:- inst ptr(I) = bound(alias(I)).
-:- inst uniq_ptr(I) = unique(alias(I)).
+:- inst ptr(I) == bound(alias(I)).
+:- inst uniq_ptr(I) == unique(alias(I)).
% The type `delayed_conj(T)' represents a conjunction of delayed goals
% that are delayed on a variable of type T.
@@ -214,11 +218,11 @@
% the goal, `yes' if the goal has been woken,
% and a pointer to the previous and next delayed goals
; (delayed_conj(T), delayed_conj(T)).
-:- inst delayed_conj =
+:- inst delayed_conj ==
bound( goal(delayed_goal, ground, delayed_goal_list, delayed_goal_list)
; (delayed_conj, delayed_conj)
).
-:- inst delayed_goal_list =
+:- inst delayed_goal_list ==
bound( goal(delayed_goal, ground, delayed_goal_list, delayed_goal_list)
).
@@ -254,19 +258,16 @@
:- inst delayed_goal
---> unary_pred(pred(in) is semidet)
- ; binary_det_pred(
- pred(in, out) is det,
- ground, any)
- ; binary_semidet_pred(
- pred(in, out) is semidet,
- ground, any)
- ; binary_semidet_pred_any(
- pred(in, in(any)) is semidet,
- ground, any).
+ ; binary_det_pred(pred(in, out) is det, ground, any)
+ ; binary_semidet_pred(pred(in, out) is semidet, ground, any)
+ ; binary_semidet_pred_any(pred(in, ia) is semidet, ground, any).
%-----------------------------------------------------------------------------%
-:- pragma c_code(init(Var::out(any)), may_call_mercury, "
+:- pragma foreign_proc("C",
+ var.init(Var::oa),
+ [promise_pure, may_call_mercury],
+"
Var = ML_var_alias(TypeInfo_for_T, ML_var_free(TypeInfo_for_T));
").
@@ -275,25 +276,25 @@
% the output is not unique, even thought we declared it to be unique.
% It puts the `alias(free)' term in read-only memory. Hence, to avoid this,
% we use separate calls to functions for alias/1 and free/0.
-:- pred var__rep_init(var_rep(T)::out(uniq_ptr(var_rep_any))) is det.
-:- pragma export(var__rep_init(out(uniq_ptr(var_rep_any))), "ML_var_init").
-var__rep_init(alias(free)).
+:- pred var.rep_init(var_rep(T)::out(uniq_ptr(var_rep_any))) is det.
+:- pragma export(var.rep_init(out(uniq_ptr(var_rep_any))), "ML_var_init").
+var.rep_init(alias(free)).
*/
-:- func var__rep_free = (var_rep(T)::out(var_rep_any)) is det.
-:- pragma export(var__rep_free = out(var_rep_any), "ML_var_free").
-var__rep_free = free.
+:- func var.rep_free = (var_rep(T)::out(var_rep_any)) is det.
+:- pragma export(var.rep_free = out(var_rep_any), "ML_var_free").
+var.rep_free = free.
-:- func var__rep_alias(var_rep(T)::in(var_rep_any)) =
+:- func var.rep_alias(var_rep(T)::in(var_rep_any)) =
(var_rep(T)::out(var_rep_any)) is det.
-:- pragma export(var__rep_alias(in(var_rep_any)) = out(var_rep_any),
+:- pragma export(var.rep_alias(in(var_rep_any)) = out(var_rep_any),
"ML_var_alias").
-var__rep_alias(T) = alias(T).
+var.rep_alias(T) = alias(T).
%-----------------------------------------------------------------------------%
/****
-:- pragma c_code( var(Value::(free -> clobbered_any)) = (Var::out(any)), % det
+:- pragma c_code( var(Value::(free -> clobbered_any)) = (Var::oa), % det
may_call_mercury,
"
* Value unused *
@@ -301,58 +302,63 @@
").
****/
-:- pragma c_code( var(Value::in) = (Var::out) /* det */,
- may_call_mercury,
+:- pragma foreign_proc("C",
+ var(Value::in) = (Var::out) /* det */,
+ [promise_pure, may_call_mercury],
"
ML_var_init_with_value(TypeInfo_for_T, Value, &Var);
").
-:- pred var__rep_init_with_value(T::in, var_rep(T)::out(ptr(var_rep_ground)))
- is det.
-:- pragma export(var__rep_init_with_value(in, out(ptr(var_rep_ground))),
+:- pragma export(var.rep_init_with_value(in, out(ptr(var_rep_ground))),
"ML_var_init_with_value").
-var__rep_init_with_value(Value, alias(ground(Value))).
+:- pred var.rep_init_with_value(T::in, var_rep(T)::out(ptr(var_rep_ground)))
+ is det.
+var.rep_init_with_value(Value, alias(ground(Value))).
-:- pragma c_code( var(Value::out) = (Var::in) /* det */, may_call_mercury,
+:- pragma foreign_proc("C",
+ var(Value::out) = (Var::in) /* det */,
+ [promise_pure, may_call_mercury],
"
ML_var_get_value(TypeInfo_for_T, Var, &Value);
").
-:- pred var__rep_get_value(var_rep(T)::in(var_rep_ground), T::out) is det.
-:- pragma export(var__rep_get_value(in(var_rep_ground), out),
+:- pragma export(var.rep_get_value(in(var_rep_ground), out),
"ML_var_get_value").
-var__rep_get_value(ground(Value), Value).
-var__rep_get_value(alias(Var), Value) :-
- var__rep_get_value(Var, Value).
-
-:- pragma c_code( var(Value::in) = (Var::in) /* semidet */,
- may_call_mercury,
+:- pred var.rep_get_value(var_rep(T)::in(var_rep_ground), T::out) is det.
+var.rep_get_value(ground(Value), Value).
+var.rep_get_value(alias(Var), Value) :-
+ var.rep_get_value(Var, Value).
+
+:- pragma foreign_proc("C",
+ var(Value::in) = (Var::in) /* semidet */,
+ [promise_pure, may_call_mercury],
"
SUCCESS_INDICATOR = ML_var_test_value(TypeInfo_for_T, Var, Value);
").
-:- pred var__rep_test_value(var_rep(T)::in(var_rep_ground), T::in) is semidet.
-:- pragma export(var__rep_test_value(in(var_rep_ground), in),
+:- pred var.rep_test_value(var_rep(T)::in(var_rep_ground), T::in) is semidet.
+:- pragma export(var.rep_test_value(in(var_rep_ground), in),
"ML_var_test_value").
-var__rep_test_value(Var, Value) :-
- var__rep_get_value(Var, VarValue),
+var.rep_test_value(Var, Value) :-
+ var.rep_get_value(Var, VarValue),
Value = VarValue.
-:- pragma c_code( var(Value::in) = (Var::in(any)) /* semidet */,
- may_call_mercury,
+:- pragma foreign_proc("C",
+ var(Value::in) = (Var::ia) /* semidet */,
+ [promise_pure, may_call_mercury],
"
SUCCESS_INDICATOR = ML_var_unify_with_val(TypeInfo_for_T, Value, Var);
").
-:- impure pred var__rep_unify_with_val(T, var_rep(T)).
-:- mode var__rep_unify_with_val(in, in(ptr(var_rep_any))) is semidet.
-:- pragma export(var__rep_unify_with_val(in, in(ptr(var_rep_any))),
+:- pragma export(var.rep_unify_with_val(in, in(ptr(var_rep_any))),
"ML_var_unify_with_val").
-var__rep_unify_with_val(Value, VarPtr) :-
+:- impure pred var.rep_unify_with_val(T, var_rep(T)).
+:- mode var.rep_unify_with_val(in, in(ptr(var_rep_any))) is semidet.
+var.rep_unify_with_val(Value, VarPtr) :-
VarPtr = alias(Var),
(
Var = alias(_),
- impure var__rep_unify_with_val(Value, Var)
+ impure var.rep_unify_with_val(Value, Var)
;
Var = ground(OldValue),
Value = OldValue
@@ -365,21 +371,23 @@
impure wakeup_delayed_goals(DelayedGoals, Value)
).
-:- pragma c_code( is_ground(Var::in(any), Result::out) /* cc_multi */,
- may_call_mercury,
+:- pragma foreign_proc("C",
+ is_ground(Var::ia, Result::out) /* cc_multi */,
+ [promise_pure, may_call_mercury],
"
ML_var_is_ground(TypeInfo_for_T, Var, &Result);
").
-:- pred var__rep_is_ground(var_rep(T), maybe(T)).
-:- mode var__rep_is_ground(in(ptr(var_rep_any)), out) is det.
-:- pragma export(var__rep_is_ground(in(ptr(var_rep_any)), out),
+:- pragma export(var.rep_is_ground(in(ptr(var_rep_any)), out),
"ML_var_is_ground").
-var__rep_is_ground(VarPtr, Result) :-
+:- pred var.rep_is_ground(var_rep(T)::in(ptr(var_rep_any)), maybe(T)::out)
+ is det.
+
+var.rep_is_ground(VarPtr, Result) :-
VarPtr = alias(Var),
(
Var = alias(_),
- var__rep_is_ground(Var, Result)
+ var.rep_is_ground(Var, Result)
;
Var = ground(Value),
Result = yes(Value)
@@ -401,7 +409,7 @@
% we keep two dummy nodes, one for the start and one for the end of the list.
%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
/* Warning: the layout of this type must match its layout in Mercury */
typedef struct ML_var_delayed_conj_struct {
MR_Word goal;
@@ -412,7 +420,7 @@
extern ML_var_delayed_conj ML_var_first_goal, ML_var_last_goal;
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
ML_var_delayed_conj ML_var_first_goal = {
0,
MR_FALSE,
@@ -427,20 +435,20 @@
};
").
-:- semipure
- pred get_last_delayed_goal(delayed_conj(_)::out(delayed_goal_list))
+:- semipure pred get_last_delayed_goal(delayed_conj(_)::out(delayed_goal_list))
is det.
-:- pragma c_code(get_last_delayed_goal(Ptr::out(delayed_goal_list)),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ get_last_delayed_goal(Ptr::out(delayed_goal_list)),
+ [promise_semipure, will_not_call_mercury],
"
Ptr = (MR_Word) &ML_var_last_goal;
").
-:- impure
- pred set_last_delayed_goal_prev(delayed_conj(_)::in(delayed_goal_list))
+:- impure pred set_last_delayed_goal_prev(delayed_conj(_)::in(delayed_goal_list))
is det.
-:- pragma c_code(set_last_delayed_goal_prev(Ptr::in(delayed_goal_list)),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ set_last_delayed_goal_prev(Ptr::in(delayed_goal_list)),
+ [will_not_call_mercury],
"
MR_trail_function(ML_var_untrail_func, ML_var_last_goal.prev);
ML_var_last_goal.prev = (void *) Ptr;
@@ -484,7 +492,7 @@
%-----------------------------------------------------------------------------%
-:- pragma c_header_code("
+:- pragma foreign_decl("C", "
#include ""mercury_trail.h""
void ML_var_untrail_func(
@@ -492,7 +500,7 @@
MR_untrail_reason reason);
").
-:- pragma c_code("
+:- pragma foreign_code("C", "
static void
ML_var_report_goal_floundered(ML_var_delayed_conj *old_goal);
@@ -566,14 +574,13 @@
:- pred call_delayed_goal(delayed_goal(T), T).
:- mode call_delayed_goal(in(delayed_goal), in) is semidet.
-call_delayed_goal(unary_pred(Pred), Value) :-
- call(Pred, Value).
+call_delayed_goal(unary_pred(Pred), Value) :- Pred(Value).
call_delayed_goal(binary_det_pred(Pred, _TypeInfo2, var(Arg2)), Value) :-
- call(Pred, Value, Arg2).
+ Pred(Value, Arg2).
call_delayed_goal(binary_semidet_pred(Pred, _TypeInfo2, var(Arg2)), Value) :-
- call(Pred, Value, Arg2).
+ Pred(Value, Arg2).
call_delayed_goal(binary_semidet_pred_any(Pred, _TypeInfo2, Arg2), Value) :-
- call(Pred, Value, Arg2).
+ Pred(Value, Arg2).
%-----------------------------------------------------------------------------%
@@ -581,48 +588,48 @@
do_freeze(Var, unary_pred(Pred)).
:- pred do_freeze(var(T), delayed_goal(T)).
-:- mode do_freeze(in(any), in(delayed_goal)) is semidet.
-:- mode do_freeze(out(any), in(delayed_goal)) is semidet.
+:- mode do_freeze(ia, in(delayed_goal)) is semidet.
+:- mode do_freeze(oa, in(delayed_goal)) is semidet.
-:- pragma c_code(
- do_freeze(Var::in(any), Pred::in(delayed_goal)) /* semidet */,
- may_call_mercury,
+:- pragma foreign_proc("C",
+ do_freeze(Var::ia, Pred::in(delayed_goal)) /* semidet */,
+ [promise_pure, may_call_mercury],
"
ML_var_freeze_in(TypeInfo_for_T, Var, Pred);
SUCCESS_INDICATOR = MR_TRUE;
").
-:- pragma c_code(
- do_freeze(Var::out(any), Pred::in(delayed_goal)) /* semidet */,
- may_call_mercury,
+
+:- pragma foreign_proc("C",
+ do_freeze(Var::oa, Pred::in(delayed_goal)) /* semidet */,
+ [promise_pure, may_call_mercury],
"
ML_var_freeze_out(TypeInfo_for_T, &Var, Pred);
SUCCESS_INDICATOR = MR_TRUE;
").
-
-:- impure pred var__rep_freeze_out(var_rep(T), delayed_goal(T)).
-:- mode var__rep_freeze_out(out(ptr(var_rep_any)), in(delayed_goal))
+:- impure pred var.rep_freeze_out(var_rep(T), delayed_goal(T)).
+:- mode var.rep_freeze_out(out(ptr(var_rep_any)), in(delayed_goal))
is det.
:- pragma export(
- var__rep_freeze_out(out(ptr(var_rep_any)), in(delayed_goal)),
+ var.rep_freeze_out(out(ptr(var_rep_any)), in(delayed_goal)),
"ML_var_freeze_out").
-var__rep_freeze_out(Var, Pred) :-
+var.rep_freeze_out(Var, Pred) :-
impure new_delayed_goal(Pred, Goal),
Var = alias(free(Goal)).
:- impure
- pred var__rep_freeze_in(var_rep(T), delayed_goal(T)).
-:- mode var__rep_freeze_in(in(ptr(var_rep_any)), in(delayed_goal)) is semidet.
+ pred var.rep_freeze_in(var_rep(T), delayed_goal(T)).
+:- mode var.rep_freeze_in(in(ptr(var_rep_any)), in(delayed_goal)) is semidet.
:- pragma export(
- var__rep_freeze_in(in(ptr(var_rep_any)), in(delayed_goal)),
+ var.rep_freeze_in(in(ptr(var_rep_any)), in(delayed_goal)),
"ML_var_freeze_in").
-var__rep_freeze_in(VarPtr, Pred) :-
+var.rep_freeze_in(VarPtr, Pred) :-
VarPtr = alias(Var),
(
Var = alias(_),
- impure var__rep_freeze_in(Var, Pred)
+ impure var.rep_freeze_in(Var, Pred)
;
Var = ground(Value),
call_delayed_goal(Pred, Value)
@@ -642,13 +649,13 @@
:- pred freeze(var(T1), pred(T1, T2), var(T2)).
:- mode freeze(in, pred(in, out) is det, out) is semidet. % no delay
:- mode freeze(in, pred(in, out) is semidet, out) is semidet. % no delay
-:- mode freeze(out(any), pred(in, out) is det, out(any)) is semidet.
-:- mode freeze(out(any), pred(in, out) is semidet, out(any)) is semidet.
-:- mode freeze_var(out(any), pred(in, in(any)) is semidet, out(any)) is semidet.
+:- mode freeze(oa, pred(in, out) is det, oa) is semidet.
+:- mode freeze(oa, pred(in, out) is semidet, oa) is semidet.
+:- mode freeze_var(oa, pred(in, ia) is semidet, oa) is semidet.
*/
-:- pragma c_code(
+:- pragma foreign_proc("C",
freeze(X::in, Pred::(pred(in, out) is det), Y::out), % det
- may_call_mercury,
+ [promise_pure, may_call_mercury],
"{
MR_Word XVal, YVal;
@@ -658,9 +665,10 @@
Pred, XVal, &YVal);
ML_var_init_with_value(TypeInfo_for_T2, YVal, &Y);
}").
-:- pragma c_code(
+
+:- pragma foreign_proc("C",
freeze(X::in, Pred::(pred(in, out) is semidet), Y::out), % semidet
- may_call_mercury,
+ [promise_pure, may_call_mercury],
"{
MR_Word XVal, YVal;
@@ -675,10 +683,10 @@
SUCCESS_INDICATOR = MR_FALSE;
}
}").
-:- pragma c_code(
- freeze(X::out(any), Pred::(pred(in, out) is det), Y::out(any)),
- % semidet
- may_call_mercury,
+
+:- pragma foreign_proc("C",
+ freeze(X::oa, Pred::(pred(in, out) is det), Y::oa), % semidet
+ [promise_pure, may_call_mercury],
"{
MR_Word p;
@@ -687,10 +695,10 @@
ML_var_freeze_out(TypeInfo_for_T1, &X, p);
SUCCESS_INDICATOR = MR_TRUE;
}").
-:- pragma c_code(
- freeze(X::out(any), Pred::(pred(in, out) is semidet), Y::out(any)),
- % semidet
- may_call_mercury,
+
+:- pragma foreign_proc("C",
+ freeze(X::oa, Pred::(pred(in, out) is semidet), Y::oa), % semidet
+ [promise_pure, may_call_mercury],
"{
MR_Word p;
@@ -701,10 +709,9 @@
SUCCESS_INDICATOR = MR_TRUE;
}").
-:- pragma c_code(
- freeze_var(X::out(any), Pred::(pred(in, in(any)) is semidet),
- Y::out(any)), % semidet
- may_call_mercury,
+:- pragma foreign_proc("C",
+ freeze_var(X::oa, Pred::(pred(in, ia) is semidet), Y::oa), % semidet
+ [promise_pure, may_call_mercury],
"{
MR_Word p;
@@ -722,33 +729,30 @@
:- func var_binary_det_pred(pred(T, t2), type_info_for_t2, var(t2))
= delayed_goal(T).
-:- mode var_binary_det_pred(pred(in, out) is det, in, in(any)) =
+:- mode var_binary_det_pred(pred(in, out) is det, in, ia) =
out(delayed_goal) is det.
:- pragma export(
- var_binary_det_pred(pred(in, out) is det, in, in(any)) =
+ var_binary_det_pred(pred(in, out) is det, in, ia) =
out(delayed_goal), "ML_var_binary_det_pred").
var_binary_det_pred(Pred, TypeInfo, SecondArg) =
binary_det_pred(Pred, TypeInfo, SecondArg).
:- func var_binary_semidet_pred(pred(T, t2), type_info_for_t2, var(t2))
= delayed_goal(T).
-:- mode var_binary_semidet_pred(pred(in, out) is semidet, in, in(any)) =
+:- mode var_binary_semidet_pred(pred(in, out) is semidet, in, ia) =
out(delayed_goal) is det.
:- pragma export(
- var_binary_semidet_pred(pred(in, out) is semidet, in, in(any)) =
+ var_binary_semidet_pred(pred(in, out) is semidet, in, ia) =
out(delayed_goal), "ML_var_binary_semidet_pred").
var_binary_semidet_pred(Pred, TypeInfo, SecondArg) =
binary_semidet_pred(Pred, TypeInfo, SecondArg).
:- func var_binary_semidet_pred_any(
- pred(T, var(t2)),
- type_info_for_t2, var(t2)) = delayed_goal(T).
+ pred(T, var(t2)), type_info_for_t2, var(t2)) = delayed_goal(T).
:- mode var_binary_semidet_pred_any(
- pred(in, in(any)) is semidet, in, in(any)) =
- out(delayed_goal) is det.
+ pred(in, ia) is semidet, in, ia) = out(delayed_goal) is det.
:- pragma export(
- var_binary_semidet_pred_any(
- pred(in, in(any)) is semidet, in, in(any)) =
+ var_binary_semidet_pred_any(pred(in, ia) is semidet, in, ia) =
out(delayed_goal), "ML_var_binary_semidet_pred_any").
var_binary_semidet_pred_any(Pred, TypeInfo, SecondArg) =
binary_semidet_pred_any(Pred, TypeInfo, SecondArg).
@@ -757,19 +761,15 @@
:- pred call_det_pred(pred(T1, T2), T1, T2).
:- mode call_det_pred(pred(in, out) is det, in, out) is det.
-:- pragma export(
- call_det_pred(pred(in, out) is det, in, out),
+:- pragma export(call_det_pred(pred(in, out) is det, in, out),
"ML_var_call_det_pred").
-call_det_pred(Pred, X, Y) :-
- call(Pred, X, Y).
+call_det_pred(Pred, X, Y) :- Pred(X, Y).
+:- pragma export(call_semidet_pred(pred(in, out) is semidet, in, out),
+ "ML_var_call_semidet_pred").
:- pred call_semidet_pred(pred(T1, T2), T1, T2).
:- mode call_semidet_pred(pred(in, out) is semidet, in, out) is semidet.
-:- pragma export(
- call_semidet_pred(pred(in, out) is semidet, in, out),
- "ML_var_call_semidet_pred").
-call_semidet_pred(Pred, X, Y) :-
- call(Pred, X, Y).
+call_semidet_pred(Pred, X, Y) :- Pred(X, Y).
%-----------------------------------------------------------------------------%
@@ -779,37 +779,65 @@
:- mode in == in is semidet.
:- mode in == out is det.
:- mode out == in is det.
-:- mode in(any) == in(any) is semidet.
-:- mode in(any) == out(any) is det.
-:- mode out(any) == out(any) is det.
-:- mode out(any) == in(any) is det.
+:- mode ia == ia is semidet.
+:- mode ia == oa is det.
+:- mode oa == oa is det.
+:- mode oa == ia is det.
*/
-:- pragma c_code((X::in) == (Y::out) /* det */, may_call_mercury,
- "Y = X;").
-:- pragma c_code((X::out) == (Y::in) /* det */, may_call_mercury,
- "X = Y;").
-:- pragma c_code((X::in(any)) == (Y::out(any)) /* det */, may_call_mercury,
- "Y = X;").
-:- pragma c_code((X::out(any)) == (Y::in(any)) /* det */, may_call_mercury,
- "X = Y;").
-:- pragma c_code((X::in) == (Y::in) /* semidet */, may_call_mercury,
- "SUCCESS_INDICATOR = ML_var_unify(TypeInfo_for_T, X, Y);").
-:- pragma c_code((X::in(any)) == (Y::in(any)) /* semidet */, may_call_mercury,
- "SUCCESS_INDICATOR = ML_var_unify(TypeInfo_for_T, X, Y);").
-:- pragma c_code((X::out(any)) == (Y::out(any)) /* semidet */, may_call_mercury,
- "X = Y = ML_var_alias(TypeInfo_for_T, ML_var_free(TypeInfo_for_T));").
+:- pragma foreign_proc("C",
+ (X::in) == (Y::out) /* det */,
+ [promise_pure, may_call_mercury],
+"
+ Y = X;
+").
+:- pragma foreign_proc("C",
+ (X::out) == (Y::in) /* det */,
+ [promise_pure, may_call_mercury],
+"
+ X = Y;
+").
+:- pragma foreign_proc("C",
+ (X::ia) == (Y::oa) /* det */,
+ [promise_pure, may_call_mercury],
+"
+ Y = X;
+").
+:- pragma foreign_proc("C",
+ (X::oa) == (Y::ia) /* det */,
+ [promise_pure, may_call_mercury],
+"
+ X = Y;
+").
+:- pragma foreign_proc("C",
+ (X::in) == (Y::in) /* semidet */,
+ [promise_pure, may_call_mercury],
+"
+ SUCCESS_INDICATOR = ML_var_unify(TypeInfo_for_T, X, Y);
+").
+:- pragma foreign_proc("C",
+ (X::ia) == (Y::ia) /* semidet */,
+ [promise_pure, may_call_mercury],
+"
+ SUCCESS_INDICATOR = ML_var_unify(TypeInfo_for_T, X, Y);
+").
+:- pragma foreign_proc("C",
+ (X::oa) == (Y::oa) /* semidet */,
+ [promise_pure, may_call_mercury],
+"
+ X = Y = ML_var_alias(TypeInfo_for_T, ML_var_free(TypeInfo_for_T));
+").
-:- impure
- pred var__rep_unify(var_rep(T), var_rep(T)).
-:- mode var__rep_unify(in(ptr(var_rep_any)), in(ptr(var_rep_any))) is semidet.
-:- pragma export(var__rep_unify(in(ptr(var_rep_any)), in(ptr(var_rep_any))),
+:- pragma export(var.rep_unify(in(ptr(var_rep_any)), in(ptr(var_rep_any))),
"ML_var_unify").
-var__rep_unify(XPtr, YPtr) :-
+:- impure pred var.rep_unify(var_rep(T), var_rep(T)).
+:- mode var.rep_unify(in(ptr(var_rep_any)), in(ptr(var_rep_any))) is semidet.
+
+var.rep_unify(XPtr, YPtr) :-
XPtr = alias(X),
(
X = alias(_),
- impure var__rep_unify(X, YPtr)
+ impure var.rep_unify(X, YPtr)
;
X = free,
( impure identical(XPtr, YPtr) ->
@@ -819,22 +847,23 @@
)
;
X = ground(_),
- impure var__rep_unify_gr(X, YPtr)
+ impure var.rep_unify_gr(X, YPtr)
;
X = free(_),
- impure var__rep_unify_fr(XPtr, YPtr, X)
+ impure var.rep_unify_fr(XPtr, YPtr, X)
).
- % This is the case when the first var is ground
-:- impure
- pred var__rep_unify_gr(var_rep(T), var_rep(T)).
-:- mode var__rep_unify_gr(in(var_rep_deref_ground), in(ptr(var_rep_any)))
+ % This is the case when the first var is ground.
+ %
+:- impure pred var.rep_unify_gr(var_rep(T), var_rep(T)).
+:- mode var.rep_unify_gr(in(var_rep_deref_ground), in(ptr(var_rep_any)))
is semidet.
-var__rep_unify_gr(X, YPtr) :-
+
+var.rep_unify_gr(X, YPtr) :-
YPtr = alias(Y),
(
Y = alias(_),
- impure var__rep_unify_gr(X, Y)
+ impure var.rep_unify_gr(X, Y)
;
Y = ground(Value),
X = ground(Value)
@@ -849,16 +878,17 @@
).
% This is the case when the first var is free(DelayedGoals).
-:- impure
- pred var__rep_unify_fr(var_rep(T), var_rep(T), var_rep(T)).
-:- mode var__rep_unify_fr(in(ptr(var_rep_any)), % really deref_delayed
+ %
+:- impure pred var.rep_unify_fr(var_rep(T), var_rep(T), var_rep(T)).
+:- mode var.rep_unify_fr(in(ptr(var_rep_any)), % really deref_delayed
in(ptr(var_rep_any)),
in(var_rep_deref_delayed)) is semidet.
-var__rep_unify_fr(XPtr, YPtr, X) :-
+
+var.rep_unify_fr(XPtr, YPtr, X) :-
YPtr = alias(Y),
(
Y = alias(_),
- impure var__rep_unify_fr(XPtr, Y, X)
+ impure var.rep_unify_fr(XPtr, Y, X)
;
Y = free,
impure destructively_update_binding(YPtr, X)
@@ -884,8 +914,9 @@
:- impure pred identical(var_rep(T), var_rep(T)).
:- mode identical(in(ptr(var_rep_any)), in(ptr(var_rep_any))) is semidet.
-:- pragma c_code(identical(X::in(ptr(var_rep_any)), Y::in(ptr(var_rep_any))),
- will_not_call_mercury,
+:- pragma foreign_proc("C",
+ identical(X::in(ptr(var_rep_any)), Y::in(ptr(var_rep_any))),
+ [will_not_call_mercury],
"{
SUCCESS_INDICATOR = (X == Y);
}").
@@ -918,12 +949,10 @@
** or with other Mercury implementations.
** Use only with great care!
*/
-:- impure pred setarg(T1, int, T2).
-:- mode setarg(in(any), in, in(any)) is det.
-
-:- pragma c_code(
- setarg(MercuryTerm::in(any), ArgNum::in, NewValue::in(any)),
- will_not_call_mercury,
+:- impure pred setarg(T1::ia, int::in, T2::ia) is det.
+:- pragma foreign_proc("C",
+ setarg(MercuryTerm::ia, ArgNum::in, NewValue::ia),
+ [will_not_call_mercury],
"{
/* strip off tag bits */
MR_Word *ptr = (MR_Word *) MR_strip_tag(MercuryTerm);
@@ -931,14 +960,13 @@
ptr[ArgNum - 1] = NewValue;
}").
-% untrailed_setarg/3 is similar to setarg/3 except the update is not
-% trailed, so it will not be undone on backtracking.
-:- pred untrailed_setarg(T1, int, T2).
-:- mode untrailed_setarg(in(any), in, in(any)) is det.
-
-:- pragma c_code(
- untrailed_setarg(MercuryTerm::in(any), ArgNum::in, NewValue::in(any)),
- will_not_call_mercury,
+ % untrailed_setarg/3 is similar to setarg/3 except the update is
+ % not trailed, so it will not be undone on backtracking.
+ %
+:- pred untrailed_setarg(T1::ia, int::in, T2::ia) is det.
+:- pragma foreign_proc("C",
+ untrailed_setarg(MercuryTerm::ia, ArgNum::in, NewValue::ia),
+ [promise_pure, will_not_call_mercury],
"{
/* strip off tag bits */
MR_Word *ptr = (MR_Word *) MR_strip_tag(MercuryTerm);
@@ -952,25 +980,25 @@
debug_freeze(Msg, Var, Pred) :-
init(Var),
(
- impure unsafe_perform_io(print("freezing: ")),
- impure unsafe_perform_io(print(Msg)),
- impure unsafe_perform_io(print(": ")),
+ impure unsafe_perform_io(io.print("freezing: ")),
+ impure unsafe_perform_io(io.print(Msg)),
+ impure unsafe_perform_io(io.print(": ")),
impure unsafe_dump_var(Var),
- impure unsafe_perform_io(nl),
+ impure unsafe_perform_io(io.nl),
freeze(Var, debug_pred(Msg, Pred)),
- impure unsafe_perform_io(print("frozen: ")),
- impure unsafe_perform_io(print(Msg)),
- impure unsafe_perform_io(print(": ")),
+ impure unsafe_perform_io(io.print("frozen: ")),
+ impure unsafe_perform_io(io.print(Msg)),
+ impure unsafe_perform_io(io.print(": ")),
impure unsafe_dump_var(Var),
- impure unsafe_perform_io(nl)
+ impure unsafe_perform_io(io.nl)
;
- impure unsafe_perform_io(print("freeze failed: ")),
- impure unsafe_perform_io(print(Msg)),
- impure unsafe_perform_io(print(": ")),
+ impure unsafe_perform_io(io.print("freeze failed: ")),
+ impure unsafe_perform_io(io.print(Msg)),
+ impure unsafe_perform_io(io.print(": ")),
impure unsafe_dump_var(Var),
- impure unsafe_perform_io(nl),
+ impure unsafe_perform_io(io.nl),
fail
).
@@ -1020,7 +1048,7 @@
impure unsafe_perform_io(print(": ")),
impure unsafe_perform_io(print(Var)),
impure unsafe_perform_io(nl),
- ( call(Pred, Var) ->
+ ( Pred(Var) ->
impure unsafe_perform_io(print("succeeded: ")),
impure unsafe_perform_io(print(Msg)),
impure unsafe_perform_io(print(": ")),
@@ -1071,37 +1099,56 @@
fail
).
-:- pragma c_code(dump_var(Var::in(any), IO0::di, IO::uo), may_call_mercury, "
+:- pragma foreign_proc("C",
+ dump_var(Var::ia, IO0::di, IO::uo),
+ [promise_pure, may_call_mercury],
+"
ML_var_print(TypeInfo_for_T, Var);
IO = IO0;
").
-:- pragma c_code(unsafe_dump_var(Var::in(any)), may_call_mercury, "
+:- pragma foreign_proc("C",
+ unsafe_dump_var(Var::ia),
+ [promise_pure, may_call_mercury],
+"
ML_var_print(TypeInfo_for_T, Var);
").
-:- pred dump_var_rep(var_rep(T)::in(var_rep_any),
- io__state::di, io__state::uo) is det.
:- pragma export(dump_var_rep(in(var_rep_any), di, uo), "ML_var_print").
+:- pred dump_var_rep(var_rep(T)::in(var_rep_any), io::di, io::uo) is det.
-dump_var_rep(alias(Var)) -->
- print("alias("), dump_var_rep(Var), print(")").
-dump_var_rep(ground(Val)) -->
- print("ground("), print(Val), print(")").
-dump_var_rep(free) -->
- print("free").
-dump_var_rep(free(Goals)) -->
- print("free("), dump_goals(Goals), print(")").
-
-:- pred dump_goals(delayed_conj(T)::in(delayed_conj),
- io__state::di, io__state::uo) is det.
-dump_goals((A,B)) -->
- print("("), dump_goals(A), print(", "), dump_goals(B), print(")").
-dump_goals(goal(_, Woken, _, _)) -->
- ( { Woken = yes } ->
- print("<woken goal>")
+dump_var_rep(alias(Var), !IO) :-
+ io.print("alias(", !IO),
+ dump_var_rep(Var, !IO),
+ io.print(")", !IO).
+dump_var_rep(ground(Val), !IO) :-
+ io.print("ground(", !IO),
+ io.print(Val, !IO),
+ io.print(")", !IO).
+dump_var_rep(free, !IO) :-
+ io.print("free", !IO).
+dump_var_rep(free(Goals), !IO) :-
+ io.print("free(", !IO),
+ dump_goals(Goals, !IO),
+ io.print(")", !IO).
+
+:- pred dump_goals(delayed_conj(T)::in(delayed_conj), io::di, io::uo) is det.
+
+dump_goals((A, B), !IO) :-
+ io.print("(", !IO),
+ dump_goals(A, !IO),
+ io.print(", ", !IO),
+ dump_goals(B, !IO),
+ io.print(")", !IO).
+dump_goals(goal(_, Woken, _, _), !IO) :-
+ (
+ Woken = yes,
+ io.print("<woken goal>", !IO)
;
- print("<delayed goal>")
+ Woken = no,
+ print("<delayed goal>", !IO)
).
+%-----------------------------------------------------------------------------%
+:- end_module var.
%-----------------------------------------------------------------------------%
Index: samples/interpreter.exp
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/trailed_update/samples/interpreter.exp,v
retrieving revision 1.5
diff -u -r1.5 interpreter.exp
--- samples/interpreter.exp 19 Feb 2003 06:51:34 -0000 1.5
+++ samples/interpreter.exp 1 Mar 2005 13:15:00 -0000
@@ -82,7 +82,7 @@
:- type db_pred ---> db_pred(list(clause), multi_map(string / int, clause)).
:- type database ---> database(list(clause), map(string / int, db_pred)).
:- type my_term(_2) ---> var(my_var(_2)) ; free ; functor(const, list(my_term(_2))).
-:- type my_var(_2) == mutvar(my_term(_2), _2).
+:- type my_var(_2) == generic_mutvar(my_term(_2), _2).
No (more) solutions.
?- No (more) solutions.
?- print_solutions(_3, _4, _5, _6, _7) --> unsorted_aggregate((pred (_8 :: muo)) is nondet :- solve(_7, _5, unsafe_promise_unique(_6), _8), write_solution(_3, _4, _5)), io__write_string("No (more) solutions.\n").
@@ -133,4 +133,4 @@
unify_list([], []) --> [].
write_solution(_3, _4, _5, _6) --> { map__keys(_4, _7) }, { map__values(_4, _8) }, { assoc_list__from_corresponding_lists(_8, _7, _9) }, { my_term_to_term(_5, _10, _3, _11, _9, _12, _6, _13) }, term_io__write_term_nl(_11, _10).
No (more) solutions.
-?-
\ No newline at end of file
+?-
Index: samples/interpreter.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/trailed_update/samples/interpreter.m,v
retrieving revision 1.7
diff -u -r1.7 interpreter.m
--- samples/interpreter.m 19 Feb 2003 06:51:34 -0000 1.7
+++ samples/interpreter.m 1 Mar 2005 12:21:09 -0000
@@ -171,7 +171,7 @@
% using the tr_store module.
:- type my_var(S)
- == mutvar(my_term(S), S).
+ == generic_mutvar(my_term(S), S).
:- type my_term(S)
---> var(my_var(S))
Index: samples/vqueens.m
===================================================================
RCS file: /home/mercury1/repository/mercury/extras/trailed_update/samples/vqueens.m,v
retrieving revision 1.1
diff -u -r1.1 vqueens.m
--- samples/vqueens.m 20 Sep 1997 18:28:06 -0000 1.1
+++ samples/vqueens.m 1 Mar 2005 12:26:39 -0000
@@ -6,33 +6,31 @@
:- import_module list, int, io.
-:- pred main1(list(int)).
-:- mode main1(out) is nondet.
+:- pred main(io::di, io::uo) is cc_multi.
-:- pred main(io__state, io__state).
-:- mode main(di, uo) is cc_multi.
+:- pred main1(list(int)::out) is nondet.
+
+%----------------------------------------------------------------------------%
+%----------------------------------------------------------------------------%
:- implementation.
:- import_module var, unsafe, std_util.
+main(!IO) :-
+ ( if data(Data), queen(Data, Out)
+ then io.print(Out, !IO), io.nl(!IO)
+ else io.write_string("No solution\n", !IO)
+ ).
+
main1(Out) :-
data(Data),
queen(Data, Out).
-main -->
- ( { data(Data), queen(Data, Out) } ->
- print(Out), nl
- ;
- io__write_string("No solution\n")
- ).
+:- pred data(list(int)::out) is det.
-:- pred data(list(int)).
-:- mode data(out) is det.
+data([1, 2, 3, 4, 5, 6, 7, 8, 9, 10]).
-data([1,2,3,4,5,6,7,8,9,10]).
-
-:- pred queen(list(int), list(int)).
-:- mode queen(in, out) is nondet.
+:- pred queen(list(int)::in, list(int)::out) is nondet.
queen(Data, Out) :-
same_len(Data, Posn),
@@ -40,42 +38,44 @@
qperm(Data, Posn, Posn2),
conv_posn(Posn2, Out).
-:- pred same_len(list(int)::in, list(var(int))::out(list_skel(any))) is det.
+:- pred same_len(list(int)::in, list(var(int))::out(list(any))) is det.
+
same_len([], []).
-same_len([_|Xs], [N|Ys]) :- init(N), same_len(Xs, Ys).
+same_len([_ | Xs], [N | Ys]) :- init(N), same_len(Xs, Ys).
:- pred conv_posn(list(var(int))::in, list(int)::out) is det.
+
conv_posn([], []).
-conv_posn([var(N)|Xs], [N|Ys]) :- conv_posn(Xs, Ys).
+conv_posn([var(N) | Xs], [N | Ys]) :- conv_posn(Xs, Ys).
-:- pred qperm(list(int), list(var(int)), list(var(int))).
-:- mode qperm(in, in(list_skel(any)), out) is nondet.
+:- pred qperm(list(int)::in, list(var(int))::in(list(any)),
+ list(var(int))::out) is nondet.
qperm([], [], []).
-qperm([X|Y], [var(U)|V], [var(U)|V2]) :-
+qperm([X | Y], [var(U) | V], [var(U) | V2]) :-
qdelete(U, [X|Y], Z),
qperm(Z, V, V2).
-:- pred qdelete(int, list(int), list(int)).
-:- mode qdelete(out, in, out) is nondet.
+:- pred qdelete(int::out, list(int)::in, list(int)::out) is nondet.
-qdelete(A, [A|L], L).
-qdelete(X, [A|Z], [A|R]) :-
+qdelete(A, [A | L], L).
+qdelete(X, [A | Z], [A | R]) :-
qdelete(X, Z, R).
-:- pred safe(list(var(int))).
-:- mode safe(in(list_skel(any))) is semidet.
+:- pred safe(list(var(int))::in(list(any))) is semidet.
safe([]).
-safe([NVar|L]) :-
+safe([NVar | L]) :-
freeze(NVar, (pred(N::in) is semidet :- nodiag(N, 1, L))),
safe(L).
-:- pred nodiag(int, int, list(var(int))).
-:- mode nodiag(in, in, in(list_skel(any))) is semidet.
+:- pred nodiag(int::in, int::in, list(var(int))::in(list(any))) is semidet.
nodiag(_, _, []).
-nodiag(B, D, [NVar|L]) :-
+nodiag(B, D, [NVar | L]) :-
freeze(NVar, (pred(N::in) is semidet :- D \= N - B, D \= B - N)),
nodiag(B, D + 1, L).
+%----------------------------------------------------------------------------%
+:- end_module vqueens.
+%----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list