tr_store.m

[Fergus Henderson]

extras/trailed_update/tr_store.m:
	New file.  A backtrackable version of library/store.m.

extras/trailed_update/tr_array.m:
	Delete the `mui_' and `mdi_' prefixes on predicate names.
	This was done for consistency with tr_store.m.

extras/trailed_update/trailed_update.m:
	Add tr_store.m to the list of modules in the `trailed_update'
	library.

extras/trailed_update/.cvsignore:
	Ignore .c and .h files.

cvs diff: Diffing .
Index: .cvsignore
===================================================================
RCS file: .cvsignore
diff -N .cvsignore
--- /dev/null	Sat Sep 27 01:08:06 1997
+++ .cvsignore	Thu Sep 18 19:00:05 1997
@@ -0,0 +1,2 @@
+*.c
+*.h
Index: Mmakefile
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/Mmakefile,v
retrieving revision 1.1
diff -u -u -r1.1 Mmakefile
--- 1.1	1997/09/11 06:55:04
+++ Mmakefile	1997/09/19 08:06:31
@@ -1,5 +1,9 @@
 GRADE = asm_fast.gc.tr
-RM_C = :
+MCFLAGS=-O6 --intermodule-optimization
+MLFLAGS=--static
+# RM_C = :
+# MLFLAGS=-g
+# MGNUCFLAGS=-g
 
 MAIN_TARGET = libtrailed_update
 
Index: tr_array.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/extras/trailed_update/tr_array.m,v
retrieving revision 1.2
diff -u -u -r1.2 tr_array.m
--- 1.2	1997/09/20 06:46:22
+++ tr_array.m	1997/09/26 15:17:36
@@ -23,17 +23,17 @@
 % Operations that perform backtrackable destructive update.
 %
 
-	% tr_array__mdi_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__mdi_set(array(T), int, T, array(T)).
-:- mode tr_array__mdi_set(array_mdi, in, in, array_muo) is det.
+:- pred tr_array__set(array(T), int, T, array(T)).
+:- mode tr_array__set(array_mdi, in, in, array_muo) is det.
 
-	% tr_array__mdi_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__mdi_semidet_set(array(T), int, T, array(T)).
-:- mode tr_array__mdi_semidet_set(array_mdi, in, in, array_muo) is semidet.
+:- pred tr_array__semidet_set(array(T), int, T, array(T)).
+:- mode tr_array__semidet_set(array_mdi, in, in, array_muo) is semidet.
 
 %-----------------------------------------------------------------------------%
 
@@ -44,114 +44,114 @@
 % "mostly_unique"-ness.
 %
 
-	% tr_array__mui_min returns the lower bound of the array.
+	% tr_array__min returns the lower bound of the array.
 	% Note: in this implementation, the lower bound is always zero.
-:- pred tr_array__mui_min(array(_T), int).
-:- mode tr_array__mui_min(array_mui, out) is det.
-:- mode tr_array__mui_min(in, out) is det.
-
-	% tr_array__mui_max returns the upper bound of the array.
-:- pred tr_array__mui_max(array(_T), int).
-:- mode tr_array__mui_max(array_mui, out) is det.
-:- mode tr_array__mui_max(in, out) is det.
+:- 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__mui_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__mui_size(array(_T), int).
-:- mode tr_array__mui_size(array_mui, out) is det.
-:- mode tr_array__mui_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__mui_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__mui_bounds(array(_T), int, int).
-:- mode tr_array__mui_bounds(array_mui, out, out) is det.
-:- mode tr_array__mui_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__mui_in_bounds checks whether an index is in the bounds
+	% tr_array__in_bounds checks whether an index is in the bounds
 	% of an array.
-:- pred tr_array__mui_in_bounds(array(_T), int).
-:- mode tr_array__mui_in_bounds(array_mui, in) is semidet.
-:- mode tr_array__mui_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__mui_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__mui_lookup(array(T), int, T).
-:- mode tr_array__mui_lookup(array_mui, in, out) is det.
-:- mode tr_array__mui_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__mui_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__mui_semidet_lookup(array(T), int, T).
-:- mode tr_array__mui_semidet_lookup(array_mui, in, out) is semidet.
-:- mode tr_array__mui_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__mui_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__mui_slow_set(array(T), int, T, array(T)).
-:- mode tr_array__mui_slow_set(array_mui, in, in, array_uo) is det.
-:- mode tr_array__mui_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__mui_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__mui_semidet_slow_set(array(T), int, T, array(T)).
-:- mode tr_array__mui_semidet_slow_set(array_mui, in, in, array_uo) is semidet.
-:- mode tr_array__mui_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__mui_copy(Array0, Array):
+	% tr_array__copy(Array0, Array):
 	% Makes a new unique copy of an array.
-:- pred tr_array__mui_copy(array(T), array(T)).
-:- mode tr_array__mui_copy(array_mui, array_uo) is det.
-:- mode tr_array__mui_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__mui_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__mui_resize(array(T), int, T, array(T)).
-:- mode tr_array__mui_resize(array_mui, in, in, array_uo) is det.
-:- mode tr_array__mui_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__mui_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__mui_shrink(array(T), int, array(T)).
-:- mode tr_array__mui_shrink(array_mui, in, array_uo) is det.
-:- mode tr_array__mui_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__mui_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__mui_to_list(array(T), list(T)).
-:- mode tr_array__mui_to_list(array_mui, out) is det.
-:- mode tr_array__mui_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__mui_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__mui_fetch_items(array(T), int, int, list(T)).
-:- mode tr_array__mui_fetch_items(array_mui, in, in, out) is det.
-:- mode tr_array__mui_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__mui_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__mui_bsearch(array(T), T, pred(T, T, comparison_result),
+:- pred tr_array__bsearch(array(T), T, pred(T, T, comparison_result),
 			maybe(int)).
-:- mode tr_array__mui_bsearch(array_mui, in, pred(in, in, out) is det, out)
+:- mode tr_array__bsearch(array_mui, in, pred(in, in, out) is det, out)
 			is det.
-:- mode tr_array__mui_bsearch(in, 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 +161,11 @@
 
 /****
 lower bounds other than zero are not supported
-	% tr_array__mui_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__mui_resize(array(T), int, int, array(T)).
-:- mode tr_array__mui_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.
 ****/
 
 %-----------------------------------------------------------------------------%
@@ -177,62 +177,62 @@
 
 %-----------------------------------------------------------------------------%
 
-:- pragma c_code(tr_array__mdi_set(Array0::array_mdi, Index::in, Item::in,
+:- pragma c_code(tr_array__set(Array0::array_mdi, Index::in, Item::in,
 		Array::array_muo),
 	will_not_call_mercury,
 "{
 	MR_ArrayType *array = (MR_ArrayType *) Array0;
 	if ((Unsigned) Index >= (Unsigned) array->size) {
-		fatal_error(""tr_array__mdi_set: array index out of bounds"");
+		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__mdi_semidet_set(Array0, Index, Item, Array) :-
-	tr_array__mui_in_bounds(Array0, Index),
-	tr_array__mdi_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__mui_min(Array::array_mui, Min::out),
+:- pragma c_code(tr_array__min(Array::array_mui, Min::out),
 	will_not_call_mercury,
 "
 	/* Array not used */
 	Min = 0;
 ").
-:- pragma c_code(tr_array__mui_min(Array::in, Min::out),
+:- pragma c_code(tr_array__min(Array::in, Min::out),
 	will_not_call_mercury,
 "
 	/* Array not used */
 	Min = 0;
 ").
 
-:- pragma c_code(tr_array__mui_max(Array::array_mui, Max::out),
+:- pragma c_code(tr_array__max(Array::array_mui, Max::out),
 	will_not_call_mercury,
 "
 	Max = ((MR_ArrayType *)Array)->size - 1;
 ").
-:- pragma c_code(tr_array__mui_max(Array::in, Max::out),
+:- pragma c_code(tr_array__max(Array::in, Max::out),
 	will_not_call_mercury,
 "
 	Max = ((MR_ArrayType *)Array)->size - 1;
 ").
 
-tr_array__mui_bounds(Array, Min, Max) :-
-	tr_array__mui_min(Array, Min),
-	tr_array__mui_max(Array, Max).
+tr_array__bounds(Array, Min, Max) :-
+	tr_array__min(Array, Min),
+	tr_array__max(Array, Max).
 
 %-----------------------------------------------------------------------------%
 
-:- pragma c_code(tr_array__mui_size(Array::array_mui, Max::out),
+:- pragma c_code(tr_array__size(Array::array_mui, Max::out),
 	will_not_call_mercury,
 "
 	Max = ((MR_ArrayType *)Array)->size;
 ").
-:- pragma c_code(tr_array__mui_size(Array::in, Max::out),
+:- pragma c_code(tr_array__size(Array::in, Max::out),
 	will_not_call_mercury,
 "
 	Max = ((MR_ArrayType *)Array)->size;
@@ -240,40 +240,40 @@
 
 %-----------------------------------------------------------------------------%
 
-tr_array__mui_in_bounds(Array, Index) :-
-	tr_array__mui_bounds(Array, Min, Max),
+tr_array__in_bounds(Array, Index) :-
+	tr_array__bounds(Array, Min, Max),
 	Min =< Index, Index =< Max.
 
-tr_array__mui_semidet_lookup(Array, Index, Item) :-
-	tr_array__mui_in_bounds(Array, Index),
-	tr_array__mui_lookup(Array, Index, Item).
-
-tr_array__mui_semidet_slow_set(Array0, Index, Item, Array) :-
-	tr_array__mui_in_bounds(Array0, Index),
-	tr_array__mui_slow_set(Array0, Index, Item, Array).
+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__mui_slow_set(Array0, Index, Item, Array) :-
-	tr_array__mui_copy(Array0, Array1),
+tr_array__slow_set(Array0, Index, Item, Array) :-
+	tr_array__copy(Array0, Array1),
 	array__set(Array1, Index, Item, Array).
 
 %-----------------------------------------------------------------------------%
 
-:- pragma c_code(tr_array__mui_lookup(Array::array_mui, Index::in, Item::out),
+:- pragma c_code(tr_array__lookup(Array::array_mui, Index::in, Item::out),
 	will_not_call_mercury,
 "{
 	MR_ArrayType *array = (MR_ArrayType *) Array;
 	if ((Unsigned) Index >= (Unsigned) array->size) {
-		fatal_error(""tr_array__mui_lookup: ""
+		fatal_error(""tr_array__lookup: ""
 			""array index out of bounds"");
 	}
 	Item = array->elements[Index];
 }").
-:- pragma c_code(tr_array__mui_lookup(Array::in, Index::in, Item::out),
+:- pragma c_code(tr_array__lookup(Array::in, Index::in, Item::out),
 	will_not_call_mercury,
 "{
 	MR_ArrayType *array = (MR_ArrayType *) Array;
 	if ((Unsigned) Index >= (Unsigned) array->size) {
-		fatal_error(""tr_array__mui_lookup: array index out of bounds"");
+		fatal_error(""tr_array__lookup: array index out of bounds"");
 	}
 	Item = array->elements[Index];
 }").
@@ -319,7 +319,7 @@
 ").
 
 :- pragma c_code(
-	tr_array__mui_resize(Array0::array_mui, Size::in, Item::in,
+	tr_array__resize(Array0::array_mui, Size::in, Item::in,
 		Array::array_uo),
 	will_not_call_mercury,
 "
@@ -327,7 +327,7 @@
 ").
 
 :- pragma c_code(
-	tr_array__mui_resize(Array0::in, Size::in, Item::in,
+	tr_array__resize(Array0::in, Size::in, Item::in,
 		Array::array_uo),
 	will_not_call_mercury,
 "
@@ -353,7 +353,7 @@
 	old_array_size = old_array->size;
 	if (old_array_size == array_size) return old_array;
 	if (old_array_size < array_size) {
-		fatal_error(""tr_array__mui_shrink: can't shrink to a larger size"");
+		fatal_error(""tr_array__shrink: can't shrink to a larger size"");
 	}
 
 	array = (MR_ArrayType *) make_many(Word, array_size + 1);
@@ -372,7 +372,7 @@
 ").
 
 :- pragma c_code(
-	tr_array__mui_shrink(Array0::array_mui, Size::in, Array::array_uo),
+	tr_array__shrink(Array0::array_mui, Size::in, Array::array_uo),
 	will_not_call_mercury,
 "
 	Array = (Word) ML_tr_shrink_array(
@@ -380,7 +380,7 @@
 ").
 
 :- pragma c_code(
-	tr_array__mui_shrink(Array0::in, Size::in, Array::array_uo),
+	tr_array__shrink(Array0::in, Size::in, Array::array_uo),
 	will_not_call_mercury,
 "
 	Array = (Word) ML_tr_shrink_array(
@@ -417,14 +417,14 @@
 ").
 
 :- pragma c_code(
-	tr_array__mui_copy(Array0::array_mui, Array::array_uo),
+	tr_array__copy(Array0::array_mui, Array::array_uo),
 	will_not_call_mercury,
 "
 	Array = (Word) ML_tr_copy_array((MR_ArrayType *) Array0);
 ").
 
 :- pragma c_code(
-	tr_array__mui_copy(Array0::in, Array::array_uo),
+	tr_array__copy(Array0::in, Array::array_uo),
 	will_not_call_mercury,
 "
 	Array = (Word) ML_tr_copy_array((MR_ArrayType *) Array0);
@@ -432,35 +432,35 @@
 
 %-----------------------------------------------------------------------------%
 
-tr_array__mui_to_list(Array, List) :-
-        tr_array__mui_bounds(Array, Low, High),
-        tr_array__mui_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__mui_fetch_items(Array, Low, High, List) :-
+tr_array__fetch_items(Array, Low, High, List) :-
         (
                 Low > High
         ->
                 List = []
         ;
                 Low1 is Low + 1,
-                tr_array__mui_fetch_items(Array, Low1, High, List0),
-                tr_array__mui_lookup(Array, Low, Item),
+                tr_array__fetch_items(Array, Low1, High, List0),
+                tr_array__lookup(Array, Low, Item),
                 List = [Item|List0]
         ).
 
 %-----------------------------------------------------------------------------%
 
-tr_array__mui_bsearch(A, El, Compare, Result) :-
-	tr_array__mui_bounds(A, Lo, Hi),
-	tr_array__mui_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__mui_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__mui_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__mui_bsearch_2(Array, Lo, Hi, El, Compare, Result) :-
+tr_array__bsearch_2(Array, Lo, Hi, El, Compare, Result) :-
 	Width is Hi - Lo,
 
 	% If Width < 0, there is no range left.
@@ -470,7 +470,7 @@
 	    % If Width == 0, we may just have found our element.
 	    % Do a Compare to check.
 	    ( Width = 0 ->
-	        tr_array__mui_lookup(Array, Lo, X),
+	        tr_array__lookup(Array, Lo, X),
 	        ( call(Compare, El, X, (=)) ->
 		    Result = yes(Lo)
 	        ;
@@ -480,16 +480,16 @@
 	        % 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__mui_lookup(Array, Mid, XMid),
+	        tr_array__lookup(Array, Mid, XMid),
 	        call(Compare, XMid, El, Comp),
 	        ( Comp = (<),
 		    Mid1 is Mid + 1,
-		    tr_array__mui_bsearch_2(Array, Mid1, Hi, El, Compare, Result)
+		    tr_array__bsearch_2(Array, Mid1, Hi, El, Compare, Result)
 	        ; Comp = (=),
-		    tr_array__mui_bsearch_2(Array, Lo, Mid, El, Compare, Result)
+		    tr_array__bsearch_2(Array, Lo, Mid, El, Compare, Result)
 	        ; Comp = (>),
 		    Mid1 is Mid - 1,
-		    tr_array__mui_bsearch_2(Array, Lo, Mid1, El, Compare, Result)
+		    tr_array__bsearch_2(Array, Lo, Mid1, El, Compare, Result)
 	        )
 	    )
 	).
Index: tr_store.m
===================================================================
RCS file: tr_store.m
diff -N tr_store.m
--- /dev/null	Sat Sep 27 01:08:06 1997
+++ tr_store.m	Sat Sep 27 01:15:00 1997
@@ -0,0 +1,322 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 1997 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.
+%-----------------------------------------------------------------------------%
+%
+% File: tr_store.m. 
+% Main author: fjh.
+% Stability: low.
+%
+% 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 only difference is that destructive updates are recorded on a trail
+% so that updates can be undone on backtracking.
+%
+% See store.m for documentation, and for the definition of the types
+% `store', `mutvar', and `ref'.
+%
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module tr_store.
+:- interface.
+:- import_module store.
+
+%-----------------------------------------------------------------------------%
+%
+% mutvars
+%
+
+	% create a new mutable variable,
+	% initialized with the specified value
+:- pred tr_store__new_mutvar(T, mutvar(T, S), store(S), store(S)).
+:- mode tr_store__new_mutvar(in, out, mdi, muo) is det.
+
+	% lookup the value stored in a given mutable variable
+:- pred tr_store__get_mutvar(mutvar(T, S), T, store(S), store(S)).
+:- mode tr_store__get_mutvar(in, out, mdi, muo) is det.
+
+	% replace the value stored in a given mutable variable
+:- pred tr_store__set_mutvar(mutvar(T, S), T, store(S), store(S)).
+:- mode tr_store__set_mutvar(in, in, mdi, muo) is det.
+
+%-----------------------------------------------------------------------------%
+%
+% references
+%
+
+	% new_ref(Val, Ref):	
+	%	/* In C: Ref = malloc(...); *Ref = Val; */
+	% Given a value of any type `T', insert a copy of the term
+	% into the store and return a new reference to that term.
+	% (This does not actually perform a copy, it just returns a view
+	% 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, ref(T, S), store(S), store(S)).
+:- mode tr_store__new_ref(mdi, out, mdi, muo) is det.
+
+	% ref_functor(Ref, Functor, Arity):
+	% Given a reference to a term, return the functor and arity
+	% of that term.
+:- pred tr_store__ref_functor(ref(T, S), string, int, store(S), store(S)).
+:- mode tr_store__ref_functor(in, out, out, mdi, muo) is det.
+
+	% arg_ref(Ref, ArgNum, ArgRef):	     
+	%	/* Psuedo-C code: ArgRef = &Ref[ArgNum]; */
+	% Given a reference to a term, return a reference to
+	% the specified argument (field) of that term
+	% (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(ref(T, S), int, ref(ArgT, S), store(S), store(S)).
+:- mode tr_store__arg_ref(in, in, out, mdi, muo) is det.
+
+	% new_arg_ref(Val, ArgNum, ArgRef):
+	%	/* Psuedo-C code: ArgRef = &Val[ArgNum]; */
+	% Equivalent to `new_ref(Val, Ref), arg_ref(Ref, ArgNum, ArgRef)',
+	% 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, ref(ArgT, S), store(S), store(S)).
+:- mode tr_store__new_arg_ref(mdi, in, out, mdi, muo) is det.
+
+	% set_ref(Ref, ValueRef):
+	%	/* Pseudo-C code: *Ref = *ValueRef; */
+	% Given a reference to a term (Ref), 
+	% 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(ref(T, S), ref(T, S), store(S), store(S)).
+:- mode tr_store__set_ref(in, in, mdi, 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.
+	% (Argument numbers start from zero).
+:- pred tr_store__set_ref_value(ref(T, S), ArgT, store(S), store(S)).
+:- mode tr_store__set_ref_value(in, mdi, mdi, muo) is det.
+
+	% Given a reference to a term, return that term.
+	% Note that 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(ref(T, S), T, store(S), store(S)).
+:- mode tr_store__copy_ref_value(in, uo, mdi, muo) is det.
+
+	% Same as above, but without making a copy.
+	% Destroys the store.
+:- pred tr_store__extract_ref_value(store(S), ref(T, S), T).
+:- mode tr_store__extract_ref_value(mdi, in, out) is det.
+
+%-----------------------------------------------------------------------------%
+%
+% Nasty performance hacks
+%
+% WARNING: use of these procedures is dangerous!
+% Use them only only as a last resort, only if performance
+% is critical, and only if profiling shows that using the
+% safe versions is a bottleneck.
+%
+% These procedures may vanish in some future version of Mercury.
+
+	% `unsafe_arg_ref' is the same as `arg_ref',
+	% and `unsafe_new_arg_ref' is the same as `new_arg_ref'
+	% except that they doesn't check for errors,
+	% and they don't work for `no_tag' types (types with
+	% exactly one functor which has exactly one argument),
+	% and they don't work for types with >4 functors.
+	% If the argument number is out of range,
+	% 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(ref(T, S), int, 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, ref(ArgT, S), store(S), store(S)).
+:- mode tr_store__unsafe_new_arg_ref(mdi, in, out, mdi, muo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+:- import_module std_util.
+
+:- type mutvar(T, S).
+
+:- type store(S).
+
+:- pragma c_code(init(_S0::muo), will_not_call_mercury, "").
+
+:- pragma c_code(new_mutvar(Val::in, Mutvar::out, S0::mdi, S::muo),
+		will_not_call_mercury,
+"
+	incr_hp(Mutvar, 1);
+	*(Word *)Mutvar = Val;
+	S = S0;
+").
+
+:- pragma c_code(get_mutvar(Mutvar::in, Val::out, S0::mdi, S::muo),
+		will_not_call_mercury,
+"
+	Val = *(Word *)Mutvar;
+	S = S0;
+").
+
+:- pragma c_code(set_mutvar(Mutvar::in, Val::in, S0::mdi, S::muo),
+		will_not_call_mercury,
+"
+	MR_trail_current_value((Word *) Mutvar);
+	*(Word *)Mutvar = Val;
+	S = S0;
+").
+
+%-----------------------------------------------------------------------------%
+
+:- pragma c_code(new_ref(Val::mdi, Ref::out, S0::mdi, S::muo),
+		will_not_call_mercury,
+"
+	incr_hp(Ref, 1);
+	*(Word *)Ref = Val;
+	S = S0;
+").
+
+copy_ref_value(Ref, Val) -->
+	/* 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(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,
+"
+	Val = *(Word *)Ref;
+	S = S0;
+").
+
+ref_functor(Ref, Functor, Arity) -->
+	unsafe_ref_value(Ref, Val),
+	{ functor(Val, Functor, Arity) }.
+
+:- pragma c_header_code("
+	/* ML_arg() is defined in std_util.m */
+	bool ML_arg(Word term_type_info, Word *term, Word argument_index,
+			Word *arg_type_info, Word **argument_ptr);
+").
+
+:- pragma c_code(arg_ref(Ref::in, ArgNum::in, ArgRef::out, S0::mdi, S::muo),
+		will_not_call_mercury,
+"{
+	Word arg_type_info;
+	Word* arg_ref;
+
+	save_transient_registers();
+
+	if (!ML_arg(TypeInfo_for_T, (Word *) Ref, ArgNum,
+			&arg_type_info, &arg_ref))
+	{
+		fatal_error(""tr_store__arg_ref: argument number out of range"");
+	}
+
+	if (ML_compare_type_info(arg_type_info, TypeInfo_for_ArgT) !=
+		COMPARE_EQUAL)
+	{
+		fatal_error(""tr_store__arg_ref: argument has wrong type"");
+	}
+
+	restore_transient_registers();
+
+	ArgRef = (Word) arg_ref;
+	S = S0;
+}").
+
+:- pragma c_code(new_arg_ref(Val::mdi, ArgNum::in, ArgRef::out, S0::mdi, S::muo),
+		will_not_call_mercury,
+"{
+	Word arg_type_info;
+	Word* arg_ref;
+
+	save_transient_registers();
+
+	if (!ML_arg(TypeInfo_for_T, (Word *) &Val, ArgNum,
+			&arg_type_info, &arg_ref))
+	{
+	      fatal_error(""tr_store__new_arg_ref: argument number out of range"");
+	}
+
+	if (ML_compare_type_info(arg_type_info, TypeInfo_for_ArgT) !=
+		COMPARE_EQUAL)
+	{
+	      fatal_error(""tr_store__new_arg_ref: argument has wrong type"");
+	}
+
+	restore_transient_registers();
+
+	/*
+	** For no_tag types, the argument may have the same address as the
+	** term.  Since the term (Val) is currently on the C stack, we can't
+	** return a pointer to it; so if that is the case, then we need
+	** to copy it to the heap before returning.
+	*/
+	if (arg_ref == &Val) {
+		incr_hp(ArgRef, 1);
+		*(Word *)ArgRef = Val;
+	} else {
+		ArgRef = (Word) arg_ref;
+	}
+	S = S0;
+}").
+
+:- pragma c_code(set_ref(Ref::in, ValRef::in, S0::mdi, S::muo),
+		will_not_call_mercury,
+"
+	MR_trail_current_value((Word *) Ref);
+	*(Word *)Ref = *(Word *)ValRef;
+	S = S0;
+").
+
+:- pragma c_code(set_ref_value(Ref::in, Val::mdi, S0::mdi, S::muo),
+		will_not_call_mercury,
+"
+	MR_trail_current_value((Word *) Ref);
+	*(Word *)Ref = Val;
+	S = S0;
+").
+
+:- pragma c_code(extract_ref_value(_S::mdi, Ref::in, Val::out),
+		will_not_call_mercury,
+"
+	Val = *(Word *)Ref;
+").
+
+%-----------------------------------------------------------------------------%
+
+:- pragma c_code(unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, S0::mdi, S::muo),
+		will_not_call_mercury,
+"{
+	/* unsafe - does not check type & arity, won't handle no_tag types */
+	Word *Ptr = (Word *) strip_tag(Ref);
+	ArgRef = (Word) &Ptr[Arg];
+	S = S0;
+}").
+
+:- pragma c_code(unsafe_new_arg_ref(Val::mdi, Arg::in, ArgRef::out,
+				S0::mdi, S::muo), will_not_call_mercury,
+"{
+	/* unsafe - does not check type & arity, won't handle no_tag types */
+	Word *Ptr = (Word *) strip_tag(Val);
+	ArgRef = (Word) &Ptr[Arg];
+	S = S0;
+}").
+
+%-----------------------------------------------------------------------------%
cvs diff: Diffing samples
-- 
Fergus Henderson <fjh at cs.mu.oz.au>   |  "I have always known that the pursuit
WWW: <http://www.cs.mu.oz.au/~fjh>   |  of excellence is a lethal habit"
PGP: finger fjh at 128.250.37.3         |     -- the last words of T. S. Garp.