new version of `store.m'

[Fergus Henderson]

Hi,

Anyone want to review this?
Comments on the new store.m are particularly welcome.

library/store.m:
	Complete rewrite.  Renamed everything in the existing interface,
	added lots to the interface, and implemented it efficiently.
	This file now contains preliminary support for my idea of
	"declaring an imperative data structure".

	Missing:
		- a ref_construct pred
		- a way to use functors rather than
		  ref_functor & ref_arg_ref or ref_construct
		  (this would be a language extensions --
		  it would require compiler support)

library/std_util.m:
	Factor out the code for argument/2 into a C function ML_arg()
	so that it can also be used in store__arg_ref.
	Change ML_expand so that it takes a pointer to the term to expand,
	so that it can be used for store__arg_ref on no_tag types.

	Add arg/2 and det_arg/2: similar to argument/2 and det_argument/2,
	except they take any argument type and fail if the type doesn't
	match, rather than returning a univ.  (Hmm... is this a good idea?)

library/tags.h:
	Add strip_tag() macro (used in var.m and store.m).

library/store.m:

%-----------------------------------------------------------------------------%
% Copyright (C) 1994-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: store.m. 
% Main author: fjh.
% Stability: low.
%
% This file provides facilities for manipulating mutable stores.
% A store can be consider a mapping from abstract keys to their values.
% A store holds a set of nodes, each of which may contain a value of any
% type.
%
% Stores may be used to implement cyclic data structures such as
% circular linked lists, etc.
%
% Stores can have two different sorts of keys:
% mutable variables (mutvars) and references (refs).
% The difference between mutvars and refs is that
% mutvars can only be updated atomically,
% whereas it is possible to update individual fields of a reference
% one at a time (presuming the reference refers to a structured term).
%
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- module store.
:- interface.

% Stores and keys are indexed by a type S that is used to distinguish between
% different stores.  The idea is to use an existential type declaration
% for store__init:
%	:- some [S] pred store__init(store(S)).
% That way, we could use the type system to ensure at compile time
% that you never attempt to use a key from one store to access a
% different store.
% However, Mercury doesn't yet support existential types :-(
% For the moment we just use a type `some_store_type'
% instead of `some [S] ... S'. 
% So currently this check is not done --
% if you attempt to use a key from one store to access a
% different store, the behaviour is undefined.
% This will hopefully be rectified in some future version when
% Mercury does support existential types.

:- type store(S).

:- type some_store_type.

	% initialize a store
:- pred store__init(store(some_store_type)).
:- mode store__init(uo) is det.

%-----------------------------------------------------------------------------%
%
% mutvars
%

	% mutvar(T, S):
	% a mutable variable holding a value of type T in store S
:- type mutvar(T, S).

	% create a new mutable variable,
	% initialized with the specified value
:- pred store__new_mutvar(T, mutvar(T, S), store(S), store(S)).
:- mode store__new_mutvar(in, out, di, uo) is det.

	% lookup the value stored in a given mutable variable
:- pred store__get_mutvar(mutvar(T, S), T, store(S), store(S)).
:- mode store__get_mutvar(in, out, di, uo) is det.

	% replace the value stored in a given mutable variable
:- pred store__set_mutvar(mutvar(T, S), T, store(S), store(S)).
:- mode store__set_mutvar(in, in, di, uo) is det.

/* 
The syntax might be nicer if we used some new operators

	:- op(.., xfx, ('<-')).
	:- op(.., fy, ('!')).
	:- op(.., xfx, (':=')).

Then we could do something like this:

	Ptr <- new(Val)	  -->	new_mutvar(Val, Ptr).
	Val <- !Ptr 	  -->	get_mutvar(Ptr, Val).
	!Ptr := Val	  -->	set_mutvar(Ptr, Val).

I wonder whether it is worth it?
*/

%-----------------------------------------------------------------------------%
%
% references
%

	% mutvar(T, S):
	% a reference to value of type T in store S
:- type ref(T, S).

	% 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 store__new_ref(T, ref(T, S), store(S), store(S)).
:- mode store__new_ref(di, out, di, uo) is det.

	% ref_functor(Ref, Functor, Arity):
	% Given a reference to a term, return the functor and arity
	% of that term.
:- pred store__ref_functor(ref(T, S), string, int, store(S), store(S)).
:- mode store__ref_functor(in, out, out, di, uo) 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 store__arg_ref(ref(T, S), int, ref(ArgT, S), store(S), store(S)).
:- mode store__arg_ref(in, in, out, di, uo) 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 store__new_arg_ref(T, int, ref(ArgT, S), store(S), store(S)).
:- mode store__new_arg_ref(di, in, out, di, uo) 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 store__set_ref(ref(T, S), ref(T, S), store(S), store(S)).
:- mode store__set_ref(in, in, di, uo) 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 store__set_ref_value(ref(T, S), ArgT, store(S), store(S)).
:- mode store__set_ref_value(in, di, di, uo) 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 store__copy_ref_value(ref(T, S), T, store(S), store(S)).
:- mode store__copy_ref_value(in, uo, di, uo) is det.

	% Same as above, but without making a copy.
	% Destroys the store.
:- pred store__extract_ref_value(store(S), ref(T, S), T).
:- mode store__extract_ref_value(di, 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 store__unsafe_arg_ref(ref(T, S), int, ref(ArgT, S), store(S), store(S)).
:- mode store__unsafe_arg_ref(in, in, out, di, uo) is det.

:- pred store__unsafe_new_arg_ref(T, int, ref(ArgT, S), store(S), store(S)).
:- mode store__unsafe_new_arg_ref(di, in, out, di, uo) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.
:- import_module std_util.

:- type mutvar(T, S).

:- type store(S).

:- pragma c_code(init(_S0::uo), will_not_call_mercury, "").

:- pragma c_code(new_mutvar(Val::in, Mutvar::out, S0::di, S::uo),
		will_not_call_mercury,
"
	incr_hp(Mutvar, 1);
	*(Word *)Mutvar = Val;
	S = S0;
").

:- pragma c_code(get_mutvar(Mutvar::in, Val::out, S0::di, S::uo),
		will_not_call_mercury,
"
	Val = *(Word *)Mutvar;
	S = S0;
").

:- pragma c_code(set_mutvar(Mutvar::in, Val::in, S0::di, S::uo),
		will_not_call_mercury,
"
	*(Word *)Mutvar = Val;
	S = S0;
").

%-----------------------------------------------------------------------------%

:- pragma c_code(new_ref(Val::di, Ref::out, S0::di, S::uo),
		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 store__unsafe_ref_value(ref(T, S), T, store(S), store(S)).
:- mode store__unsafe_ref_value(in, uo, di, uo) is det.
:- pragma c_code(unsafe_ref_value(Ref::in, Val::uo, S0::di, S::uo),
		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::di, S::uo),
		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(""store__arg_ref: argument number out of range"");
	}

	if (ML_compare_type_info(arg_type_info, TypeInfo_for_ArgT) !=
		COMPARE_EQUAL)
	{
		fatal_error(""store__arg_ref: argument has wrong type"");
	}

	restore_transient_registers();

	ArgRef = (Word) arg_ref;
	S = S0;
}").

:- pragma c_code(new_arg_ref(Val::di, ArgNum::in, ArgRef::out, S0::di, S::uo),
		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(""store__new_arg_ref: argument number out of range"");
	}

	if (ML_compare_type_info(arg_type_info, TypeInfo_for_ArgT) !=
		COMPARE_EQUAL)
	{
	      fatal_error(""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::di, S::uo),
		will_not_call_mercury,
"
	*(Word *)Ref = *(Word *)ValRef;
	S = S0;
").

:- pragma c_code(set_ref_value(Ref::in, Val::di, S0::di, S::uo),
		will_not_call_mercury,
"
	*(Word *)Ref = Val;
	S = S0;
").

:- pragma c_code(extract_ref_value(_S::di, Ref::in, Val::out),
		will_not_call_mercury,
"
	Val = *(Word *)Ref;
").

%-----------------------------------------------------------------------------%

:- pragma c_code(unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, S0::di, S::uo),
		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::di, Arg::in, ArgRef::out,
				S0::di, S::uo), 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 .
Index: std_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/std_util.m,v
retrieving revision 1.102
diff -u -r1.102 std_util.m
--- 1.102	1997/09/14 09:21:28
+++ std_util.m	1997/09/21 15:55:34
@@ -1,8 +1,8 @@
-%---------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
 % Copyright (C) 1994-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: std_util.m.
 % Main author: fjh.
@@ -366,32 +366,32 @@
 	%
 :- pred functor(T::in, string::out, int::out) is det.
 
-	% argument(Data, ArgumentIndex) = Argument
+	% arg(Data, ArgumentIndex) = Argument
+	% argument(Data, ArgumentIndex) = ArgumentUniv
 	% 
 	% Given a data item (Data) and an argument index
 	% (ArgumentIndex), starting at 0 for the first argument, binds
 	% Argument to that argument of the functor of the data item. If
 	% the argument index is out of range -- that is, greater than or
 	% equal to the arity of the functor or lower than 0 -- then
-	% argument/2 fails.  The argument returned has the type univ. 
-	% (Also aborts if the type of Data is a type with a non-canonical
+	% the call fails.  For argument/1 the argument returned has the
+	% type univ, which can store any type.  For arg/1, if the
+	% argument has the wrong type, then the call fails.
+	% (Both abort if the type of Data is a type with a non-canonical
 	% representation, i.e. one for which there is a user-defined
 	% equality predicate.)
 	%
+:- func arg(T::in, int::in) = (ArgT::out) is semidet.
 :- func argument(T::in, int::in) = (univ::out) is semidet.
 
-	% det_argument(ArgumentIndex, Data, Argument)
+	% det_arg(Data, ArgumentIndex) = Argument
+	% det_argument(Data, ArgumentIndex) = ArgumentUniv
 	% 
-	% Given a data item (Data) and an argument index
-	% (ArgumentIndex), starting at 0 for the first argument, binds
-	% Argument to that argument of the functor of the data item. If
-	% the argument index is out of range -- that is, greater than or
-	% equal to the arity of the functor or lower than 0 -- then
-	% det_argument/2 aborts. 
-	% (Also aborts if the type of Data is a type with a non-canonical
-	% representation, i.e. one for which there is a user-defined
-	% equality predicate.)
+	% Same as arg/2 and argument/2 respectively, except that
+	% for cases where arg/2 or argument/2 would fail,
+	% det_arg/2 or det_argument/2 will abort.
 	%
+:- func det_arg(T::in, int::in) = (ArgT::out) is det.
 :- func det_argument(T::in, int::in) = (univ::out) is det.
 
 	% deconstruct(Data, Functor, Arity, Arguments) 
@@ -2041,10 +2041,14 @@
 
 	/* Prototypes */
 
-void ML_expand(Word* type_info, Word data_word, ML_Expand_Info *info);
+void ML_expand(Word* type_info, Word *data_word_ptr, ML_Expand_Info *info);
 
 Word * ML_create_type_info(Word *term_type_info, Word *arg_pseudo_type_info);
 
+	/* NB. ML_arg() is also used by store__arg_ref in store.m */
+bool ML_arg(Word term_type_info, Word *term, Word argument_index,
+		Word *arg_type_info, Word **argument_ptr);
+
 ").
 
 :- pragma c_code("
@@ -2088,12 +2092,13 @@
 */
 
 void 
-ML_expand(Word* type_info, Word data_word, ML_Expand_Info *info)
+ML_expand(Word* type_info, Word *data_word_ptr, ML_Expand_Info *info)
 {
 	Code *compare_pred;
 	Word *base_type_info, *arg_type_info;
 	Word data_value, entry_value, base_type_layout_entry;
 	int entry_tag, data_tag; 
+	Word data_word;
 
 	base_type_info = MR_TYPEINFO_GET_BASE_TYPEINFO(type_info);
 
@@ -2101,6 +2106,7 @@
 	info->non_canonical_type = ( compare_pred ==
 		ENTRY(mercury__builtin_compare_non_canonical_type_3_0) );
 
+	data_word = *data_word_ptr;
 	data_tag = tag(data_word);
 	data_value = body(data_word, data_tag);
 	
@@ -2159,16 +2165,13 @@
 		if (TYPEINFO_IS_VARIABLE(entry_value)) {
 			arg_type_info = ML_create_type_info(type_info, 
 				(Word *) entry_value);
-			ML_expand(arg_type_info, data_word, info);
+			ML_expand(arg_type_info, data_word_ptr, info);
 		}
 			/* 
 			** is it a no_tag type?
 			*/
 		else if (MR_TYPELAYOUT_NO_TAG_VECTOR_IS_NO_TAG(entry_value)) {
-			Word new_arg_vector; 
-			incr_saved_hp(new_arg_vector, 1);
-			field(0, new_arg_vector, 0) = data_word;
-			ML_expand_simple(new_arg_vector, 
+			ML_expand_simple(data_word_ptr,
 				(Word *) entry_value, type_info, info);
 		}
 			/* 
@@ -2178,7 +2181,7 @@
 			arg_type_info = ML_create_type_info(type_info, 
 				(Word *) MR_TYPELAYOUT_EQUIV_TYPE(
 					entry_value));
-			ML_expand(arg_type_info, data_word, info);
+			ML_expand(arg_type_info, data_word_ptr, info);
 		}
 
 		break;
@@ -2387,7 +2390,7 @@
 
 		ML_expand((Word *) 
 			((Word *) data_value)[UNIV_OFFSET_FOR_TYPEINFO], 
-			((Word *) data_value)[UNIV_OFFSET_FOR_DATA], info);
+			&((Word *) data_value)[UNIV_OFFSET_FOR_DATA], info);
 		break;
 
 	case TYPELAYOUT_PREDICATE_VALUE:
@@ -2540,13 +2543,69 @@
 	}
 }
 
+/*
+** ML_arg() is a subroutine used to implement arg/2, argument/2,
+** and also store__arg_ref/5 in store.m.
+** It takes a term (& its type), and an argument index,
+** and returns a
+*/
+bool
+ML_arg(Word term_type_info, Word *term_ptr, Word argument_index,
+	Word *arg_type_info, Word **argument_ptr)
+{
+	ML_Expand_Info info;
+	Word arg_pseudo_type_info;
+	bool success;
+
+	info.need_functor = FALSE;
+	info.need_args = TRUE;
+
+	ML_expand((Word *) term_type_info, term_ptr, &info);
+
+		/*
+		** Check for attempts to deconstruct a non-canonical type:
+		** such deconstructions must be cc_multi, and since
+		** arg/2 is det, we must treat violations of this
+		** as runtime errors.
+		** (There ought to be a cc_multi version of arg/2
+		** that allows this.)
+		*/
+	if (info.non_canonical_type) {
+		fatal_error(""called argument/2 for a type with a ""
+			""user-defined equality predicate"");
+	}
+
+		/* Check range */
+	success = (argument_index >= 0 && argument_index < info.arity);
+	if (success) {
+			/* figure out the type of the argument */
+		arg_pseudo_type_info = info.type_info_vector[argument_index];
+		if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info)) {
+			*arg_type_info =
+				((Word *) term_type_info)[arg_pseudo_type_info];
+		} else {
+			*arg_type_info = arg_pseudo_type_info;
+		}
+
+		*argument_ptr = &info.argument_vector[argument_index];
+	}
+
+	/*
+	** Free the allocated type_info_vector, since we just copied
+	** the stuff we want out of it.
+	*/
+	free(info.type_info_vector);
+
+	return success;
+}
+
 ").
 
 %-----------------------------------------------------------------------------%
 
 	% Code for functor, arg and deconstruct.
 
-:- pragma c_code(functor(Type::in, Functor::out, Arity::out),
+:- pragma c_code(functor(Term::in, Functor::out, Arity::out),
 		will_not_call_mercury, " 
 {
 	ML_Expand_Info info;
@@ -2556,7 +2615,7 @@
 
 	save_transient_registers();
 
-	ML_expand((Word *) TypeInfo_for_T, Type, &info);
+	ML_expand((Word *) TypeInfo_for_T, &Term, &info);
 
 	restore_transient_registers();
 
@@ -2579,64 +2638,79 @@
 	Arity = info.arity;
 }").
 
-:- pragma c_code(argument(Type::in, ArgumentIndex::in) = (Argument::out),
+/*
+** N.B. any modifications to arg/2 might also require similar
+** changes to store__arg_ref in store.m.
+*/
+
+:- pragma c_code(arg(Term::in, ArgumentIndex::in) = (Argument::out),
 		will_not_call_mercury, " 
 {
-	ML_Expand_Info info;
-	Word arg_pseudo_type_info;
+	Word arg_type_info;
+	Word *argument_ptr;
 	bool success;
-
-	info.need_functor = FALSE;
-	info.need_args = TRUE;
+	int comparison_result;
 
 	save_transient_registers();
 
-	ML_expand((Word *) TypeInfo_for_T, Type, &info);
-
-	restore_transient_registers();
-
-		/*
-		** Check for attempts to deconstruct a non-canonical type:
-		** such deconstructions must be cc_multi, and since
-		** argument/2 is det, we must treat violations of this
-		** as runtime errors.
-		** (There ought to be a cc_multi version of argument/2
-		** that allows this.)
-		*/
-	if (info.non_canonical_type) {
-		fatal_error(""called argument/2 for a type with a ""
-			""user-defined equality predicate"");
-	}
+	success = ML_arg(TypeInfo_for_T, &Term, ArgumentIndex, &arg_type_info,
+			&argument_ptr);
 
-		/* Check range */
-	success = (ArgumentIndex >= 0 && ArgumentIndex < info.arity);
 	if (success) {
+		/* compare the actual type with the expected type */
+		comparison_result =
+			ML_compare_type_info(arg_type_info, TypeInfo_for_ArgT);
+		success = (comparison_result == COMPARE_EQUAL);
 
-			/* Allocate enough room for a univ */
-		incr_hp(Argument, 2);
-		arg_pseudo_type_info = info.type_info_vector[ArgumentIndex];
-		if (TYPEINFO_IS_VARIABLE(arg_pseudo_type_info)) {
-			field(0, Argument, UNIV_OFFSET_FOR_TYPEINFO) = 
-				((Word *) TypeInfo_for_T)[arg_pseudo_type_info];
+		if (success) {
+			Argument = *argument_ptr;
 		}
-		else {
-			field(0, Argument, UNIV_OFFSET_FOR_TYPEINFO) = 
-				arg_pseudo_type_info;
-		}
-		field(0, Argument, UNIV_OFFSET_FOR_DATA) = 
-			info.argument_vector[ArgumentIndex];
 	}
 
-	/* Free the allocated type_info_vector, since we just copied
-	 * the argument we want onto the heap. 
-	 */
+	restore_transient_registers();
 
-	free(info.type_info_vector);
+	SUCCESS_INDICATOR = success;
+}").
+
+:- pragma c_code(argument(Term::in, ArgumentIndex::in) = (ArgumentUniv::out),
+		will_not_call_mercury, " 
+{
+	Word arg_type_info;
+	Word *argument_ptr;
+	bool success;
+
+	save_transient_registers();
+
+	success = ML_arg(TypeInfo_for_T, &Term, ArgumentIndex, &arg_type_info,
+			&argument_ptr);
+
+	restore_transient_registers();
+
+	if (success) {
+		/* Allocate enough room for a univ */
+		incr_hp(ArgumentUniv, 2);
+		field(0, ArgumentUniv, UNIV_OFFSET_FOR_TYPEINFO) =
+			arg_type_info;
+		field(0, ArgumentUniv, UNIV_OFFSET_FOR_DATA) = *argument_ptr;
+	}
 
 	SUCCESS_INDICATOR = success;
 
 }").
 
+det_arg(Type, ArgumentIndex) = Argument :-
+	(
+		arg(Type, ArgumentIndex) = Argument0
+	->
+		Argument = Argument0
+	;
+		( argument(Type, ArgumentIndex) = _ArgumentUniv ->
+			error("det_arg: argument number out of range")
+		;
+			error("det_arg: argument had wrong type")
+		)
+	).
+
 det_argument(Type, ArgumentIndex) = Argument :-
 	(
 		argument(Type, ArgumentIndex) = Argument0
@@ -2646,7 +2720,7 @@
 		error("det_argument: argument out of range")
 	).
 
-:- pragma c_code(deconstruct(Type::in, Functor::out, Arity::out, 
+:- pragma c_code(deconstruct(Term::in, Functor::out, Arity::out, 
 		Arguments::out), will_not_call_mercury, " 
 {
 	ML_Expand_Info info;
@@ -2659,7 +2733,7 @@
 
 	save_transient_registers();
 
-	ML_expand((Word *) TypeInfo_for_T, Type, &info);
+	ML_expand((Word *) TypeInfo_for_T, &Term, &info);
 	
 	restore_transient_registers();
 
 %-----------------------------------------------------------------------------%

-- 
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.