[m-dev.] for review: make univ a user defined type.
Thomas Conway
conway at cs.mu.OZ.AU
Mon Jan 8 15:58:25 AEDT 2001
For Tyson, Fergus or Zoltan to review.
--
Thomas Conway Mercurian )O+
<conway at cs.mu.oz.au> Every sword has two edges.
This change makes univ a user-defined type (in std_util.m) rather than
a builtin type.
The rationale for this is that the code for builtin types needs to be
maintained by hand when the execution model is changed (eg introducing
a new backend), but code for user defined types is modified implicitly.
Note that the semantics of deconstruct/4 have changed. See the NEWS file
for details.
NEWS:
Document the changed semantics of deconstruct/4.
browser/browse.m:
Fix the calls to deconstruct/4 to reflect the changed semantics
of deconstruct.
library/io.m:
Remove the special handling of univ for io__write.
Fix the calls to deconstruct/4 to reflect the changed semantics
of deconstruct.
library/private_builtin.m:
Implement typed_unify and typed_compare in terms of type_of and
unsafe_type_cast instead of univ, so that preds/funcs operating
on univs can be implemented in terms of typed_unify.
Add a new impure predicate var/1 which succeeds/fails depending on the
instantiation of its argument. This is used to implement bidirectional
predicates that require different code for different modes
(cf type_to_univ/2).
This is *not* mentioned in the NEWS file because it should only
be used by implementors. (Well, actually, anyone who wants to do
bidirectional code involving existential types may need it, but
we don't exactly want to encourage its use ;-).
library/std_util.m:
Implement univ/0 as a user-defined type rather than a hand coded
builtin type.
Removed the foreign language code to implement the operations on
univs (include unify/2 and compare/3).
The implementations of deconstruct, et al, now call back to Mercury
to construct/deconstruct univs, so the code of these has changed.
Note that there has been an implicit change in the semantics of
deconstruct/4, which had non-orthogonal handling of univ inputs.
It now handles them orthogonally: deconstruct of a univ yields the
functor "univ_cons" and its one argument which will be the wrapped
value. The non-orthogonal behaviour wasn't documented before, so
deconstruct/4 now behaves as its documentation describes it.
runtime/mercury.c:
runtime/mercury_deep_copy_body.h:
runtime/mercury_mcpp.h:
runtime/mercury_tabling.c:
runtime/mercury_type_info.h:
runtime/mercury_unify_compare_body.h:
Remove declarations and definitions for univ since it is now a
user level type rather than a builtin type.
trace/mercury_trace_declarative.h:
trace/mercury_trace_external.h:
trace/mercury_trace_internal.h:
Replace the hand-coded constructions of univs with call backs
to ML_construct_univ.
Index: NEWS
===================================================================
RCS file: /home/staff/zs/imp/mercury/NEWS,v
retrieving revision 1.185
diff -u -r1.185 NEWS
--- NEWS 2000/12/23 11:56:37 1.185
+++ NEWS 2001/01/08 01:39:01
@@ -71,6 +71,17 @@
Changes to the standard library:
+* We've changed the semantics of deconstruct/4, in light of the introduction
+ of existentially quantified types. Previously, if deconstruct/4 was given
+ a value of type `univ' it automagically unwrapped it and gave back the
+ functor, arity and arguments of the unwrapped value. This behaviour was
+ not documented, but made sense because there was no way to unwrap a
+ univ without knowing (or guessing) its type. Now that univ is defined
+ as a normal (existentially quantified) type, this behaviour is unnecessary,
+ and a wart besides, so has been removed. If you have a univ and you want
+ to get the unwrapped value's functor, arity and arguments, then you can
+ call "univ_value(Univ)" to extract the value before calling deconstruct.
+
* We've added new predicates map__foldl2, tree234__foldl2 and
std_util__aggregate2, and builtin__promise_only_solution_io.
Index: browser/browse.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/browser/browse.m,v
retrieving revision 1.16
diff -u -r1.16 browse.m
--- browser/browse.m 2000/10/27 08:38:48 1.16
+++ browser/browse.m 2001/01/08 01:27:07
@@ -409,7 +409,7 @@
( MaxSize < 0 ->
RemainingSize = MaxSize
;
- deconstruct(Univ, Functor, Arity, Args),
+ deconstruct(univ_value(Univ), Functor, Arity, Args),
string__length(Functor, FunctorSize),
PrincipalSize = FunctorSize + Arity * 2,
MaxArgsSize = MaxSize - PrincipalSize,
@@ -441,7 +441,7 @@
term_compress(Univ, Str),
NewSize = CurSize
;
- deconstruct(Univ, Functor, _Arity, Args),
+ deconstruct(univ_value(Univ), Functor, _Arity, Args),
CurSize1 is CurSize + 1,
CurDepth1 is CurDepth + 1,
term_to_string_list(Args, MaxSize, CurSize1, NewSize,
@@ -493,7 +493,7 @@
:- pred term_compress(univ, string).
:- mode term_compress(in, out) is det.
term_compress(Univ, Str) :-
- deconstruct(Univ, Functor, Arity, _Args),
+ deconstruct(univ_value(Univ), Functor, Arity, _Args),
( Arity = 0 ->
Str = Functor
;
@@ -542,7 +542,7 @@
Frame = [Line],
NewSize = CurSize
;
- deconstruct(Univ, Functor, _Arity, Args),
+ deconstruct(univ_value(Univ), Functor, _Arity, Args),
CurSize1 is CurSize + 1,
CurDepth1 is CurDepth + 1,
ArgNum = 1,
@@ -670,7 +670,7 @@
Univ = SubUniv
;
Path = [N | Ns],
- deconstruct(Univ, _Functor, _Arity, Args),
+ deconstruct(univ_value(Univ), _Functor, _Arity, Args),
list__index1(Args, N, ArgN),
deref_subterm_2(ArgN, Ns, SubUniv)
).
Index: library/io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.m,v
retrieving revision 1.219
diff -u -r1.219 io.m
--- library/io.m 2001/01/01 04:03:50 1.219
+++ library/io.m 2001/01/08 01:48:37
@@ -2049,8 +2049,6 @@
io__write_type_desc(TypeDesc)
; { univ_to_type(Univ, TypeCtorDesc) } ->
io__write_type_ctor_desc(TypeCtorDesc)
- ; { univ_to_type(Univ, OrigUniv) } ->
- io__write_univ_as_univ(OrigUniv)
; { univ_to_type(Univ, C_Pointer) } ->
io__write_c_pointer(C_Pointer)
;
@@ -2115,7 +2113,8 @@
:- pred io__write_ordinary_term(univ, ops__priority, io__state, io__state).
:- mode io__write_ordinary_term(in, in, di, uo) is det.
-io__write_ordinary_term(Term, Priority) -->
+io__write_ordinary_term(Univ, Priority) -->
+ { univ_value(Univ) = Term },
{ deconstruct(Term, Functor, _Arity, Args) },
io__get_op_table(OpTable),
(
@@ -2320,17 +2319,6 @@
;
io__format("%s:%s/%d", [s(ModuleName), s(Name), i(Arity)])
).
-
-:- pred io__write_univ_as_univ(univ, io__state, io__state).
-:- mode io__write_univ_as_univ(in, di, uo) is det.
-
-io__write_univ_as_univ(Univ) -->
- io__write_string("univ("),
- io__write_univ(Univ),
- % XXX what is the right TYPE_QUAL_OP to use here?
- io__write_string(" : "),
- io__write_string(type_name(univ_type(Univ))),
- io__write_string(")").
:- pred io__write_c_pointer(c_pointer, io__state, io__state).
:- mode io__write_c_pointer(in, di, uo) is det.
Index: library/private_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/private_builtin.m,v
retrieving revision 1.63
diff -u -r1.63 private_builtin.m
--- library/private_builtin.m 2001/01/01 04:03:51 1.63
+++ library/private_builtin.m 2001/01/07 23:32:27
@@ -100,6 +100,7 @@
% the types are equal it unifies the values.
:- pred typed_unify(T1, T2).
:- mode typed_unify(in, in) is semidet.
+:- mode typed_unify(in, out) is semidet.
% A "typed" version of compare/3 -- i.e. one that can handle arguments
% of different types. It first compares the types, and then if the
@@ -242,12 +243,25 @@
compare_error :-
error("internal error in compare/3").
- % XXX These could be implemented more efficiently using
- % `pragma foreign_code' -- the implementation below does some
- % unnecessary memory allocatation.
-typed_unify(X, Y) :- univ(X) = univ(Y).
-typed_compare(R, X, Y) :- compare(R, univ(X), univ(Y)).
+%-----------------------------------------------------------------------------%
+typed_unify(X, Y) :-
+ ( type_of(X) = type_of(Y) ->
+ unsafe_type_cast(X, Y)
+ ;
+ fail
+ ).
+
+typed_compare(R, X, Y) :-
+ compare(R0, type_of(X), type_of(Y)),
+ ( R0 = (=) ->
+ unsafe_type_cast(X, Z),
+ compare(R, Z, Y)
+ ;
+ R = R0
+ ).
+
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -895,6 +909,47 @@
mercury::runtime::Errors::SORRY(""foreign code for this predicate"");
}
+").
+
+%-----------------------------------------------------------------------------%
+
+:- interface.
+
+% var/1 is intended to make it possible to write code that effectively
+% has different implementations for different modes (see type_to_univ
+% in std_util.m as an example).
+% It has to be impure to ensure that reordering doesn't cause the wrong
+% mode to be selected.
+
+:- impure pred var(T).
+:- mode var(ui) is failure.
+:- mode var(in) is failure.
+:- mode var(unused) is det.
+
+:- impure pred nonvar(T).
+:- mode nonvar(ui) is det.
+:- mode nonvar(in) is det.
+:- mode nonvar(unused) is failure.
+
+:- implementation.
+
+:- pragma c_code(var(X::ui), [thread_safe, will_not_call_mercury], "
+ /* X */
+ SUCCESS_INDICATOR = FALSE;
+").
+:- pragma c_code(var(X::in), [thread_safe, will_not_call_mercury], "
+ /* X */
+ SUCCESS_INDICATOR = FALSE;
+").
+:- pragma c_code(var(X::unused), [thread_safe, will_not_call_mercury], "
+ /* X */
+").
+
+:- pragma c_code(nonvar(X::ui), [thread_safe, will_not_call_mercury], "/*X*/").
+:- pragma c_code(nonvar(X::in), [thread_safe, will_not_call_mercury], "/*X*/").
+:- pragma c_code(nonvar(X::unused), [thread_safe, will_not_call_mercury], "
+ /* X */
+ SUCCESS_INDICATOR = FALSE;
").
%-----------------------------------------------------------------------------%
Index: library/std_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/std_util.m,v
retrieving revision 1.216
diff -u -r1.216 std_util.m
--- library/std_util.m 2001/01/01 04:03:52 1.216
+++ library/std_util.m 2001/01/08 00:32:48
@@ -1173,6 +1173,11 @@
% The type `std_util:type_desc/0' happens to use much the same
% representation as `private_builtin:type_info/1'.
+ % We call the constructor for univs `univ_cons' to avoid ambiguity
+ % with the univ/1 function which returns a univ.
+:- type univ --->
+ some [T] univ_cons(T).
+
univ_to_type(Univ, X) :- type_to_univ(X, Univ).
univ(X) = Univ :- type_to_univ(X, Univ).
@@ -1189,229 +1194,59 @@
error(ErrorString)
).
-:- pragma foreign_code("C", univ_value(Univ::in) = (Value::out), will_not_call_mercury, "
- MR_TypeInfo typeinfo;
+univ_value(univ_cons(X)) = X.
- MR_unravel_univ(Univ, typeinfo, Value);
- TypeInfo_for_T = (MR_Word) typeinfo;
-").
+:- pragma promise_pure(type_to_univ/2).
+type_to_univ(T, Univ) :-
+ (
+ impure private_builtin__var(T),
+ Univ = univ_cons(T0),
+ private_builtin__typed_unify(T0, T)
+ ;
+ impure private_builtin__var(Univ),
+ Univ0 = 'new univ_cons'(T),
+ unsafe_promise_unique(Univ0, Univ)
+ ).
-:- pragma foreign_code("MC++",
- univ_value(_Univ::in) = (_Value::out), will_not_call_mercury,
-"
- mercury::runtime::Errors::SORRY(""foreign code for this function"");
-").
+univ_type(Univ) = type_of(univ_value(Univ)).
+:- pred construct_univ(T, univ).
+:- mode construct_univ(in, out) is det.
+:- pragma export(construct_univ(in, out), "ML_construct_univ").
-:- pragma foreign_decl("C", "
-/*
-** `univ' is represented as a two word structure.
-** One word contains the address of a type_info for the type.
-** The other word contains the data.
-** The offsets MR_UNIV_OFFSET_FOR_TYPEINFO and MR_UNIV_OFFSET_FOR_DATA
-** are defined in runtime/mercury_type_info.h.
-*/
+construct_univ(X, Univ) :-
+ Univ = univ(X).
+
+:- some [T] pred unravel_univ(univ, T).
+:- mode unravel_univ(in, out) is det.
+:- pragma export(unravel_univ(in, out), "ML_unravel_univ").
+
+unravel_univ(Univ, X) :-
+ univ_value(Univ) = X.
-#include ""mercury_type_info.h""
+:- pragma foreign_decl("C", "
#include ""mercury_heap.h"" /* for MR_incr_hp_msg() etc. */
#include ""mercury_misc.h"" /* for MR_fatal_error() */
#include ""mercury_string.h"" /* for MR_make_aligned_string() */
-
").
-% :- pred type_to_univ(T, univ).
-% :- mode type_to_univ(di, uo) is det.
-% :- mode type_to_univ(in, out) is det.
-% :- mode type_to_univ(out, in) is semidet.
-
- % Forward mode - convert from type to univ.
- % Allocate heap space, set the first field to contain the address
- % of the type_info for this type, and then store the input argument
- % in the second field.
-:- pragma foreign_code("C",
- type_to_univ(Value::di, Univ::uo), will_not_call_mercury,
-"
- MR_incr_hp_msg(Univ, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(Univ, TypeInfo_for_T, Value);
-").
-:- pragma foreign_code("C",
- type_to_univ(Value::in, Univ::out), will_not_call_mercury,
-"
- MR_incr_hp_msg(Univ, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(Univ, TypeInfo_for_T, Value);
-").
-
- % Backward mode - convert from univ to type.
- % We check that type_infos compare equal.
- % The variable `TypeInfo_for_T' used in the C code
- % is the compiler-introduced type-info variable.
-:- pragma foreign_code("C",
- type_to_univ(Value::out, Univ::in), will_not_call_mercury,
-"{
- MR_Word univ_type_info;
- int comp;
-
- univ_type_info = MR_field(MR_mktag(0), Univ,
- MR_UNIV_OFFSET_FOR_TYPEINFO);
- MR_save_transient_registers();
- comp = MR_compare_type_info((MR_TypeInfo) univ_type_info,
- (MR_TypeInfo) TypeInfo_for_T);
- MR_restore_transient_registers();
- if (comp == MR_COMPARE_EQUAL) {
- Value = MR_field(MR_mktag(0), Univ,
- MR_UNIV_OFFSET_FOR_DATA);
- SUCCESS_INDICATOR = TRUE;
- } else {
- SUCCESS_INDICATOR = FALSE;
- }
-}").
-
-:- pragma foreign_code("C", univ_type(Univ::in) = (TypeInfo::out),
- will_not_call_mercury,
-"
- TypeInfo = MR_field(MR_mktag(0), Univ, MR_UNIV_OFFSET_FOR_TYPEINFO);
-").
-
-:- pragma foreign_code("MC++",
- type_to_univ(Value::di, Univ::uo), will_not_call_mercury,
-"
- MR_untagged_newobj(Univ, 2);
- MR_objset(Univ, 0, TypeInfo_for_T);
- MR_objset(Univ, 1, Value);
-").
-:- pragma foreign_code("MC++",
- type_to_univ(Value::in, Univ::out), will_not_call_mercury,
-"
- MR_untagged_newobj(Univ, 2);
- MR_objset(Univ, 0, TypeInfo_for_T);
- MR_objset(Univ, 1, Value);
-").
-
- % Backward mode - convert from univ to type.
- % We check that type_infos compare equal.
- % The variable `TypeInfo_for_T' used in the C code
- % is the compiler-introduced type-info variable.
-:- pragma foreign_code("MC++",
- type_to_univ(Value::out, Univ::in), will_not_call_mercury, "
-{
- MR_Word univ_type_info = Value->GetValue(0);
- if (MR_compare_type_info(TypeInfo_for_T, univ_type_info)
- == MR_COMPARE_EQUAL) {
- MR_Box UnivValue = Univ->GetValue(1);
- Value = UnivValue;
- SUCCESS_INDICATOR = TRUE;
- } else {
- SUCCESS_INDICATOR = FALSE;
- }
-}").
-
-:- pragma foreign_code("MC++", univ_type(Univ::in) = (TypeInfo::out),
- will_not_call_mercury,
-"
- TypeInfo = Univ->GetValue(0);
-").
-
-
:- pragma foreign_code("C", "
#ifdef MR_HIGHLEVEL_CODE
-void sys_init_unify_univ_module(void); /* suppress gcc -Wmissing-decl warning */
-void sys_init_unify_univ_module(void) { return; }
+void sys_init_unify_type_desc_module(void); /* suppress gcc -Wmissing-decl warning */
+void sys_init_unify_type_desc_module(void) { return; }
#else
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(std_util, type_desc, 0,
MR_TYPECTOR_REP_C_POINTER);
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(std_util, univ, 0,
- MR_TYPECTOR_REP_UNIV);
MR_define_extern_entry(mercury____Unify___std_util__type_desc_0_0);
MR_define_extern_entry(mercury____Compare___std_util__type_desc_0_0);
-MR_BEGIN_MODULE(unify_univ_module)
- MR_init_entry(mercury____Unify___std_util__univ_0_0);
- MR_init_entry(mercury____Compare___std_util__univ_0_0);
+MR_BEGIN_MODULE(unify_type_desc_module)
MR_init_entry(mercury____Unify___std_util__type_desc_0_0);
MR_init_entry(mercury____Compare___std_util__type_desc_0_0);
MR_BEGIN_CODE
-MR_define_entry(mercury____Unify___std_util__univ_0_0);
-{
- /*
- ** Unification for univ.
- */
-
- MR_Word univ1, univ2;
- MR_Word typeinfo1, typeinfo2;
- int comp;
-
- univ1 = r1;
- univ2 = r2;
-
- /* First check the type_infos compare equal */
- typeinfo1 = MR_field(MR_mktag(0), univ1, MR_UNIV_OFFSET_FOR_TYPEINFO);
- typeinfo2 = MR_field(MR_mktag(0), univ2, MR_UNIV_OFFSET_FOR_TYPEINFO);
- MR_save_transient_registers();
- comp = MR_compare_type_info((MR_TypeInfo) typeinfo1,
- (MR_TypeInfo) typeinfo2);
- MR_restore_transient_registers();
- if (comp != MR_COMPARE_EQUAL) {
- r1 = FALSE;
- MR_proceed();
- }
-
- /*
- ** Then invoke the generic unification predicate on the
- ** unwrapped args
- */
- r1 = typeinfo1;
- r2 = MR_field(MR_mktag(0), univ1, MR_UNIV_OFFSET_FOR_DATA);
- r3 = MR_field(MR_mktag(0), univ2, MR_UNIV_OFFSET_FOR_DATA);
- {
- MR_declare_entry(mercury__unify_2_0);
- MR_tailcall(MR_ENTRY(mercury__unify_2_0),
- MR_LABEL(mercury____Unify___std_util__univ_0_0));
- }
-}
-
-MR_define_entry(mercury____Compare___std_util__univ_0_0);
-{
- /*
- ** Comparison for univ:
- */
-
- MR_Word univ1, univ2;
- MR_Word typeinfo1, typeinfo2;
- int comp;
-
- univ1 = r1;
- univ2 = r2;
-
- /* First compare the type_infos */
- typeinfo1 = MR_field(MR_mktag(0), univ1, MR_UNIV_OFFSET_FOR_TYPEINFO);
- typeinfo2 = MR_field(MR_mktag(0), univ2, MR_UNIV_OFFSET_FOR_TYPEINFO);
- MR_save_transient_registers();
- comp = MR_compare_type_info((MR_TypeInfo) typeinfo1,
- (MR_TypeInfo) typeinfo2);
- MR_restore_transient_registers();
- if (comp != MR_COMPARE_EQUAL) {
- r1 = comp;
- MR_proceed();
- }
-
- /*
- ** If the types are the same, then invoke the generic compare/3
- ** predicate on the unwrapped args.
- */
-
- r1 = typeinfo1;
- r2 = MR_field(MR_mktag(0), univ1, MR_UNIV_OFFSET_FOR_DATA);
- r3 = MR_field(MR_mktag(0), univ2, MR_UNIV_OFFSET_FOR_DATA);
- {
- MR_declare_entry(mercury__compare_3_0);
- MR_tailcall(MR_ENTRY(mercury__compare_3_0),
- MR_LABEL(mercury____Compare___std_util__univ_0_0));
- }
-}
-
MR_define_entry(mercury____Unify___std_util__type_desc_0_0);
{
/*
@@ -1444,23 +1279,18 @@
/* Ensure that the initialization code for the above module gets run. */
/*
-INIT sys_init_unify_univ_module
+INIT sys_init_unify_type_desc_module
*/
-MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc unify_univ_module;
-void sys_init_unify_univ_module(void); /* suppress gcc -Wmissing-decl warning */
-void sys_init_unify_univ_module(void) {
- unify_univ_module();
+MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc unify_type_desc_module;
+void sys_init_unify_type_desc_module(void); /* suppress gcc -Wmissing-decl warning */
+void sys_init_unify_type_desc_module(void) {
+ unify_type_desc_module();
MR_INIT_TYPE_CTOR_INFO(
- mercury_data_std_util__type_ctor_info_univ_0,
- std_util__univ_0_0);
- MR_INIT_TYPE_CTOR_INFO(
mercury_data_std_util__type_ctor_info_type_desc_0,
std_util__type_desc_0_0);
MR_register_type_ctor_info(
- &mercury_data_std_util__type_ctor_info_univ_0);
- MR_register_type_ctor_info(
&mercury_data_std_util__type_ctor_info_type_desc_0);
}
@@ -1470,7 +1300,6 @@
:- pragma foreign_code("MC++", "
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(std_util, univ, 0, MR_TYPECTOR_REP_UNIV)
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(std_util, type_desc, 0,
MR_TYPECTOR_REP_C_POINTER)
@@ -1480,13 +1309,6 @@
}
static int
-__Unify____univ_0_0(MR_Word x, MR_Word y)
-{
- mercury::runtime::Errors::SORRY(""unify for univ"");
- return 0;
-}
-
-static int
__Unify____type_desc_0_0(MR_Word x, MR_Word y)
{
mercury::runtime::Errors::SORRY(""unify for type_desc"");
@@ -1494,13 +1316,6 @@
}
static void
-__Compare____univ_0_0(MR_Word_Ref result,
-MR_Word x, MR_Word y)
-{
- mercury::runtime::Errors::SORRY(""compare for univ"");
-}
-
-static void
__Compare____type_desc_0_0(
MR_Word_Ref result, MR_Word x, MR_Word y)
{
@@ -1508,14 +1323,6 @@
}
static int
-do_unify__univ_0_0(MR_Box x, MR_Box y)
-{
- return mercury::std_util__c_code::__Unify____univ_0_0(
- dynamic_cast<MR_Word>(x),
- dynamic_cast<MR_Word>(y));
-}
-
-static int
do_unify__type_desc_0_0(MR_Box x, MR_Box y)
{
return mercury::std_util__c_code::__Unify____type_desc_0_0(
@@ -1524,16 +1331,6 @@
}
static void
-do_compare__univ_0_0(MR_Word_Ref result,
- MR_Box x, MR_Box y)
-{
- mercury::std_util__c_code::__Compare____univ_0_0(
- result,
- dynamic_cast<MR_Word>(x),
- dynamic_cast<MR_Word>(y));
-}
-
-static void
do_compare__type_desc_0_0(
MR_Word_Ref result, MR_Box x, MR_Box y)
{
@@ -2187,7 +1984,7 @@
:- pragma foreign_code("C",
construct(TypeDesc::in, FunctorNumber::in, ArgList::in) = (Term::out),
- will_not_call_mercury, "
+ may_call_mercury, "
{
MR_TypeInfo type_info;
MR_TypeCtorInfo type_ctor_info;
@@ -2239,8 +2036,12 @@
MR_fatal_error(""notag arg list is too long"");
}
- new_data = MR_field(MR_mktag(0), MR_list_head(ArgList),
- MR_UNIV_OFFSET_FOR_DATA);
+ {
+ MR_Word unused;
+ MR_save_transient_registers();
+ ML_unravel_univ(&unused, MR_list_head(ArgList), &new_data);
+ MR_restore_transient_registers();
+ }
break;
case MR_TYPECTOR_REP_DU:
@@ -2276,9 +2077,14 @@
MR_field(ptag, new_data, 0) =
functor_desc->MR_du_functor_secondary;
for (i = 0; i < arity; i++) {
- MR_field(ptag, new_data, i + 1) =
- MR_field(MR_mktag(0), MR_list_head(arg_list),
- MR_UNIV_OFFSET_FOR_DATA);
+ {
+ MR_Word unused;
+ MR_save_transient_registers();
+ ML_unravel_univ(&unused,
+ MR_list_head(arg_list),
+ &MR_field(ptag, new_data, i + 1));
+ MR_restore_transient_registers();
+ }
arg_list = MR_list_tail(arg_list);
}
@@ -2291,9 +2097,14 @@
MR_PROC_LABEL, ""<created by std_util:construct/3>"");
for (i = 0; i < arity; i++) {
- MR_field(ptag, new_data, i) =
- MR_field(MR_mktag(0), MR_list_head(arg_list),
- MR_UNIV_OFFSET_FOR_DATA);
+ {
+ MR_Word unused;
+ MR_save_transient_registers();
+ ML_unravel_univ(&unused,
+ MR_list_head(arg_list),
+ &MR_field(ptag, new_data, i));
+ MR_restore_transient_registers();
+ }
arg_list = MR_list_tail(arg_list);
}
@@ -2321,9 +2132,14 @@
arg_list = ArgList;
for (i = 0; i < arity; i++) {
- MR_field(MR_mktag(0), new_data, i) =
- MR_field(MR_mktag(0), MR_list_head(arg_list),
- MR_UNIV_OFFSET_FOR_DATA);
+ {
+ MR_Word unused;
+ MR_save_transient_registers();
+ ML_unravel_univ(&unused,
+ MR_list_head(arg_list),
+ &MR_field(MR_mktag(0), new_data, i));
+ MR_restore_transient_registers();
+ }
arg_list = MR_list_tail(arg_list);
}
@@ -2343,8 +2159,9 @@
** Create a univ.
*/
- MR_incr_hp_msg(Term, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(Term, type_info, new_data);
+ MR_save_transient_registers();
+ ML_construct_univ((MR_Word)type_info, new_data, &Term);
+ MR_restore_transient_registers();
}
SUCCESS_INDICATOR = success;
@@ -2408,7 +2225,7 @@
:- pragma foreign_code("C",
construct_tuple_2(Args::in, ArgTypes::in, Arity::in) = (Term::out),
- will_not_call_mercury, "
+ may_call_mercury, "
{
MR_TypeInfo type_info;
MR_Word new_data;
@@ -2432,8 +2249,10 @@
MR_incr_hp_msg(new_data, Arity, MR_PROC_LABEL,
""<created by std_util:construct_tuple/1>"");
for (i = 0; i < Arity; i++) {
- arg_value = MR_field(MR_mktag(0), MR_list_head(Args),
- MR_UNIV_OFFSET_FOR_DATA);
+ MR_Word uu;
+ MR_save_transient_registers();
+ ML_unravel_univ(&uu, MR_list_head(Args), &arg_value);
+ MR_restore_transient_registers();
MR_field(MR_mktag(0), new_data, i) = arg_value;
Args = MR_list_tail(Args);
}
@@ -2442,8 +2261,9 @@
/*
** Create a univ.
*/
- MR_incr_hp_msg(Term, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(Term, type_info, new_data);
+ MR_save_transient_registers();
+ ML_construct_univ((MR_Word) type_info, new_data, &Term);
+ MR_restore_transient_registers();
}
").
@@ -2580,7 +2400,6 @@
case MR_TYPECTOR_REP_FLOAT:
case MR_TYPECTOR_REP_STRING:
case MR_TYPECTOR_REP_PRED:
- case MR_TYPECTOR_REP_UNIV:
case MR_TYPECTOR_REP_VOID:
case MR_TYPECTOR_REP_C_POINTER:
case MR_TYPECTOR_REP_TYPEINFO:
@@ -2635,8 +2454,13 @@
return FALSE;
}
- list_arg_type_info = (MR_TypeInfo) MR_field(MR_mktag(0),
- MR_list_head(arg_list), MR_UNIV_OFFSET_FOR_TYPEINFO);
+ {
+ Word unused;
+ MR_save_transient_registers();
+ ML_unravel_univ((MR_Word *)&list_arg_type_info,
+ MR_list_head(arg_list), &unused);
+ MR_restore_transient_registers();
+ }
if (MR_TYPE_CTOR_INFO_IS_TUPLE(
MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info)))
@@ -2675,9 +2499,12 @@
int i;
for (i = 0; i < arity; i++) {
- MR_field(MR_mktag(0), term_vector, i) =
- MR_field(MR_mktag(0), MR_list_head(arg_list),
- MR_UNIV_OFFSET_FOR_DATA);
+ MR_Word uu;
+ MR_Word arg_value;
+ MR_save_transient_registers();
+ ML_unravel_univ(&uu, MR_list_head(arg_list), &arg_value);
+ MR_restore_transient_registers();
+ MR_field(MR_mktag(0), term_vector, i) = arg_value;
arg_list = MR_list_tail(arg_list);
}
}
@@ -2899,7 +2726,6 @@
case MR_TYPECTOR_REP_FLOAT:
case MR_TYPECTOR_REP_STRING:
case MR_TYPECTOR_REP_PRED:
- case MR_TYPECTOR_REP_UNIV:
case MR_TYPECTOR_REP_VOID:
case MR_TYPECTOR_REP_C_POINTER:
case MR_TYPECTOR_REP_TYPEINFO:
@@ -3328,19 +3154,6 @@
}
break;
- case MR_TYPECTOR_REP_UNIV: {
- MR_Word data_word;
- /*
- * Univ is a two word structure, containing
- * type_info and data.
- */
- data_word = *data_word_ptr;
- ML_expand((MR_TypeInfo)
- ((MR_Word *) data_word)[MR_UNIV_OFFSET_FOR_TYPEINFO],
- &((MR_Word *) data_word)[MR_UNIV_OFFSET_FOR_DATA], expand_info);
- break;
- }
-
case MR_TYPECTOR_REP_VOID:
/*
** There's no way to create values of type `void',
@@ -3724,7 +3537,7 @@
:- pragma foreign_code("C",
argument(Term::in, ArgumentIndex::in) = (ArgumentUniv::out),
- will_not_call_mercury, "
+ may_call_mercury, "
{
MR_TypeInfo type_info;
MR_TypeInfo arg_type_info;
@@ -3739,9 +3552,9 @@
MR_restore_transient_registers();
if (success) {
- /* Allocate enough room for a univ */
- MR_incr_hp_msg(ArgumentUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(ArgumentUniv, arg_type_info, *argument_ptr);
+ MR_save_transient_registers();
+ ML_construct_univ((MR_Word)arg_type_info, *argument_ptr, &ArgumentUniv);
+ MR_restore_transient_registers();
}
SUCCESS_INDICATOR = success;
@@ -3796,7 +3609,7 @@
:- pragma foreign_code("C",
deconstruct(Term::in, Functor::out, Arity::out,
- Arguments::out), will_not_call_mercury, "
+ Arguments::out), may_call_mercury, "
{
ML_Expand_Info expand_info;
MR_TypeInfo type_info;
@@ -3839,10 +3652,11 @@
while (--i >= 0) {
/* Create an argument on the heap */
- MR_incr_hp_msg(Argument, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(Argument,
- expand_info.arg_type_infos[i],
- expand_info.arg_values[i + expand_info.num_extra_args]);
+ MR_save_transient_registers();
+ ML_construct_univ((MR_Word)expand_info.arg_type_infos[i],
+ expand_info.arg_values[i + expand_info.num_extra_args],
+ &Argument);
+ MR_restore_transient_registers();
/* Join the argument to the front of the list */
Arguments = MR_list_cons_msg(Argument, Arguments, MR_PROC_LABEL);
@@ -3898,7 +3712,7 @@
:- pragma foreign_code("C",
get_notag_functor_info(Univ::in, ExpUniv::out),
- will_not_call_mercury, "
+ may_call_mercury, "
{
MR_TypeInfo type_info;
MR_TypeInfo exp_type_info;
@@ -3906,7 +3720,9 @@
MR_NotagFunctorDesc *functor_desc;
MR_Word value;
- MR_unravel_univ(Univ, type_info, value);
+ MR_save_transient_registers();
+ ML_unravel_univ((MR_Word *)&type_info, Univ, &value);
+ MR_restore_transient_registers();
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
switch (type_ctor_info->type_ctor_rep) {
case MR_TYPECTOR_REP_NOTAG:
@@ -3914,8 +3730,9 @@
functor_desc = type_ctor_info->type_functors.functors_notag;
exp_type_info = MR_pseudo_type_info_is_ground(
functor_desc->MR_notag_functor_arg_type);
- MR_incr_hp_msg(ExpUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(ExpUniv, exp_type_info, value);
+ MR_save_transient_registers();
+ ML_construct_univ((MR_Word)exp_type_info, value, &ExpUniv);
+ MR_restore_transient_registers();
SUCCESS_INDICATOR = TRUE;
break;
@@ -3925,8 +3742,9 @@
exp_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
functor_desc->MR_notag_functor_arg_type);
- MR_incr_hp_msg(ExpUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(ExpUniv, exp_type_info, value);
+ MR_save_transient_registers();
+ ML_construct_univ((MR_Word)exp_type_info, value, &ExpUniv);
+ MR_restore_transient_registers();
SUCCESS_INDICATOR = TRUE;
break;
@@ -3951,21 +3769,24 @@
:- pragma foreign_code("C",
get_equiv_functor_info(Univ::in, ExpUniv::out),
- will_not_call_mercury, "
+ may_call_mercury, "
{
MR_TypeInfo type_info;
MR_TypeInfo exp_type_info;
MR_TypeCtorInfo type_ctor_info;
MR_Word value;
- MR_unravel_univ(Univ, type_info, value);
+ MR_save_transient_registers();
+ ML_unravel_univ((MR_Word *)&type_info, Univ, &value);
+ MR_restore_transient_registers();
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
switch (type_ctor_info->type_ctor_rep) {
case MR_TYPECTOR_REP_EQUIV:
exp_type_info = MR_pseudo_type_info_is_ground(
type_ctor_info->type_layout.layout_equiv);
- MR_incr_hp_msg(ExpUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(ExpUniv, exp_type_info, value);
+ MR_save_transient_registers();
+ ML_construct_univ((MR_Word)exp_type_info, value, &ExpUniv);
+ MR_restore_transient_registers();
SUCCESS_INDICATOR = TRUE;
break;
@@ -3973,8 +3794,9 @@
exp_type_info = MR_create_type_info(
MR_TYPEINFO_GET_FIRST_ORDER_ARG_VECTOR(type_info),
type_ctor_info->type_layout.layout_equiv);
- MR_incr_hp_msg(ExpUniv, 2, MR_PROC_LABEL, ""std_util:univ/0"");
- MR_define_univ_fields(ExpUniv, exp_type_info, value);
+ MR_save_transient_registers();
+ ML_construct_univ((MR_Word)exp_type_info, value, &ExpUniv);
+ MR_restore_transient_registers();
SUCCESS_INDICATOR = TRUE;
break;
@@ -4003,7 +3825,9 @@
MR_TypeCtorInfo type_ctor_info;
MR_Word value;
- MR_unravel_univ(Univ, type_info, value);
+ MR_save_transient_registers();
+ ML_unravel_univ((MR_Word *)&type_info, Univ, &value);
+ MR_restore_transient_registers();
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
switch (type_ctor_info->type_ctor_rep) {
case MR_TYPECTOR_REP_ENUM:
@@ -4036,7 +3860,7 @@
list(univ)::out) is semidet.
:- pragma foreign_code("C", get_du_functor_info(Univ::in, Where::out,
- Ptag::out, Sectag::out, Args::out), will_not_call_mercury, "
+ Ptag::out, Sectag::out, Args::out), may_call_mercury, "
{
MR_TypeInfo type_info;
MR_TypeCtorInfo type_ctor_info;
@@ -4046,7 +3870,9 @@
MR_Word *arg_vector;
int i;
- MR_unravel_univ(Univ, type_info, value);
+ MR_save_transient_registers();
+ ML_unravel_univ((MR_Word *)&type_info, Univ, &value);
+ MR_restore_transient_registers();
type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
switch (type_ctor_info->type_ctor_rep) {
case MR_TYPECTOR_REP_DU:
@@ -4100,10 +3926,10 @@
functor_desc->MR_du_functor_arg_types[i]);
}
- MR_incr_hp_msg(arg, 2, MR_PROC_LABEL,
- ""std_util:univ/0"");
- MR_define_univ_fields(arg,
- arg_type_info, arg_vector[i]);
+ MR_save_transient_registers();
+ ML_construct_univ((MR_Word)arg_type_info,
+ arg_vector[i], &arg);
+ MR_restore_transient_registers();
Args = MR_list_cons_msg(arg, Args, MR_PROC_LABEL);
}
break;
Index: runtime/mercury.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury.c,v
retrieving revision 1.18
diff -u -r1.18 mercury.c
--- runtime/mercury.c 2000/12/03 02:22:51 1.18
+++ runtime/mercury.c 2001/01/07 23:36:23
@@ -179,7 +179,6 @@
MR_define_type_ctor_info(builtin, func, 0, MR_TYPECTOR_REP_PRED);
MR_define_type_ctor_info(builtin, tuple, 0, MR_TYPECTOR_REP_TUPLE);
MR_define_type_ctor_info(array, array, 1, MR_TYPECTOR_REP_ARRAY);
-MR_define_type_ctor_info(std_util, univ, 0, MR_TYPECTOR_REP_UNIV);
MR_define_type_ctor_info(std_util, type_desc, 0, MR_TYPECTOR_REP_TYPEINFO);
MR_define_type_ctor_info(private_builtin, type_ctor_info, 1,
MR_TYPECTOR_REP_TYPEINFO);
Index: runtime/mercury_deep_copy_body.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_deep_copy_body.h,v
retrieving revision 1.34
diff -u -r1.34 mercury_deep_copy_body.h
--- runtime/mercury_deep_copy_body.h 2000/12/04 18:28:38 1.34
+++ runtime/mercury_deep_copy_body.h 2001/01/07 23:37:07
@@ -502,53 +502,6 @@
}
break;
- case MR_TYPECTOR_REP_UNIV:
- {
- MR_Word *data_value;
-
- assert(MR_tag(data) == 0);
- data_value = (MR_Word *) MR_body(data, MR_mktag(0));
-
- /* if the univ is stored in range, copy it */
- if (in_range(data_value)) {
- MR_Word *new_data_ptr;
-
- /* allocate space for a univ */
- MR_incr_saved_hp(new_data, 2);
- new_data_ptr = (MR_Word *) new_data;
- /*
- ** Copy the fields across.
- ** Note: we must copy the data before the type_info,
- ** because when copying the data, we need the type_info
- ** to still contain the type rather than just holding
- ** a forwarding pointer.
- */
- new_data_ptr[MR_UNIV_OFFSET_FOR_DATA] = copy(
- &data_value[MR_UNIV_OFFSET_FOR_DATA],
- (const MR_TypeInfo)
- data_value[MR_UNIV_OFFSET_FOR_TYPEINFO],
- lower_limit, upper_limit);
- new_data_ptr[MR_UNIV_OFFSET_FOR_TYPEINFO] =
- (MR_Word) copy_type_info((MR_TypeInfo *)
- &data_value[MR_UNIV_OFFSET_FOR_TYPEINFO],
- lower_limit, upper_limit);
- leave_forwarding_pointer(data_ptr, new_data);
- } else if (in_traverse_range(data_value)) {
- copy(&data_value[MR_UNIV_OFFSET_FOR_DATA],
- (const MR_TypeInfo)
- data_value[MR_UNIV_OFFSET_FOR_TYPEINFO],
- lower_limit, upper_limit);
- copy_type_info((MR_TypeInfo *)
- &data_value[MR_UNIV_OFFSET_FOR_TYPEINFO],
- lower_limit, upper_limit);
- new_data = data;
- } else {
- new_data = data;
- found_forwarding_pointer(data);
- }
- }
- break;
-
case MR_TYPECTOR_REP_VOID:
MR_fatal_error("Cannot copy a void type");
break;
Index: runtime/mercury_mcpp.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_mcpp.h,v
retrieving revision 1.2
diff -u -r1.2 mercury_mcpp.h
--- runtime/mercury_mcpp.h 2001/01/01 15:05:40 1.2
+++ runtime/mercury_mcpp.h 2001/01/07 23:37:21
@@ -132,7 +132,6 @@
#define MR_TYPECTOR_REP_FLOAT_val 10
#define MR_TYPECTOR_REP_STRING_val 11
#define MR_TYPECTOR_REP_PRED_val 12
-#define MR_TYPECTOR_REP_UNIV_val 13
#define MR_TYPECTOR_REP_VOID_val 14
#define MR_TYPECTOR_REP_C_POINTER_val 15
#define MR_TYPECTOR_REP_TYPEINFO_val 16
Index: runtime/mercury_tabling.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_tabling.c,v
retrieving revision 1.36
diff -u -r1.36 mercury_tabling.c
--- runtime/mercury_tabling.c 2000/12/21 03:42:49 1.36
+++ runtime/mercury_tabling.c 2001/01/07 23:36:35
@@ -839,19 +839,6 @@
break;
}
- case MR_TYPECTOR_REP_UNIV:
- {
- MR_Word *data_value;
-
- data_value = (MR_Word *) data;
- MR_DEBUG_TABLE_TYPEINFO(table,
- (MR_TypeInfo) data_value[MR_UNIV_OFFSET_FOR_TYPEINFO]);
- MR_DEBUG_TABLE_ANY(table,
- (MR_TypeInfo) data_value[MR_UNIV_OFFSET_FOR_TYPEINFO],
- data_value[MR_UNIV_OFFSET_FOR_DATA]);
- break;
- }
-
case MR_TYPECTOR_REP_VOID:
MR_fatal_error("Cannot table a void type");
break;
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.61
diff -u -r1.61 mercury_type_info.h
--- runtime/mercury_type_info.h 2000/12/18 07:42:58 1.61
+++ runtime/mercury_type_info.h 2001/01/07 23:38:09
@@ -332,36 +332,6 @@
/*---------------------------------------------------------------------------*/
-
-/*
-** Offsets for dealing with `univ' types.
-**
-** `univ' is represented as a two word structure.
-** The first word contains the address of a type_info for the type.
-** The second word contains the data.
-*/
-
-#define MR_UNIV_OFFSET_FOR_TYPEINFO 0
-#define MR_UNIV_OFFSET_FOR_DATA 1
-
-#define MR_unravel_univ(univ, typeinfo, value) \
- do { \
- typeinfo = (MR_TypeInfo) MR_field(MR_mktag(0), (univ), \
- MR_UNIV_OFFSET_FOR_TYPEINFO); \
- value = MR_field(MR_mktag(0), (univ), \
- MR_UNIV_OFFSET_FOR_DATA); \
- } while (0)
-
-#define MR_define_univ_fields(univ, typeinfo, value) \
- do { \
- MR_field(MR_mktag(0), (univ), MR_UNIV_OFFSET_FOR_TYPEINFO) \
- = (MR_Word) (typeinfo); \
- MR_field(MR_mktag(0), (univ), MR_UNIV_OFFSET_FOR_DATA) \
- = (MR_Word) (value); \
- } while (0)
-
-/*---------------------------------------------------------------------------*/
-
/*
** Definitions for accessing the representation of the
** Mercury typeclass_info.
@@ -443,7 +413,6 @@
MR_DEFINE_ENUM_CONST(MR_TYPECTOR_REP_FLOAT),
MR_DEFINE_ENUM_CONST(MR_TYPECTOR_REP_STRING),
MR_DEFINE_ENUM_CONST(MR_TYPECTOR_REP_PRED),
- MR_DEFINE_ENUM_CONST(MR_TYPECTOR_REP_UNIV),
MR_DEFINE_ENUM_CONST(MR_TYPECTOR_REP_VOID),
MR_DEFINE_ENUM_CONST(MR_TYPECTOR_REP_C_POINTER),
MR_DEFINE_ENUM_CONST(MR_TYPECTOR_REP_TYPEINFO),
@@ -488,7 +457,6 @@
"FLOAT", \
"STRING", \
"PRED", \
- "UNIV", \
"VOID", \
"C_POINTER", \
"TYPEINFO", \
Index: runtime/mercury_unify_compare_body.h
===================================================================
RCS file: /home/staff/zs/imp/mercury/runtime/mercury_unify_compare_body.h,v
retrieving revision 1.7
diff -u -r1.7 mercury_unify_compare_body.h
--- runtime/mercury_unify_compare_body.h 2000/12/04 18:35:09 1.7
+++ runtime/mercury_unify_compare_body.h 2001/01/07 23:38:27
@@ -448,38 +448,6 @@
#endif
}
- case MR_TYPECTOR_REP_UNIV:
- {
- MR_TypeInfo type_info_x, type_info_y;
- int result;
-
- /* First compare the type_infos */
- type_info_x = (MR_TypeInfo) MR_field(MR_mktag(0), x,
- MR_UNIV_OFFSET_FOR_TYPEINFO);
- type_info_y = (MR_TypeInfo) MR_field(MR_mktag(0), y,
- MR_UNIV_OFFSET_FOR_TYPEINFO);
- MR_save_transient_registers();
- result = MR_compare_type_info(type_info_x, type_info_y);
- MR_restore_transient_registers();
- if (result != MR_COMPARE_EQUAL) {
-#ifdef select_compare_code
- return_answer(result);
-#else
- return_answer(FALSE);
-#endif
- }
-
- /*
- ** If the types are the same, then recurse on
- ** the unwrapped args.
- */
-
- type_info = type_info_x;
- x = MR_field(MR_mktag(0), x, MR_UNIV_OFFSET_FOR_DATA);
- y = MR_field(MR_mktag(0), y, MR_UNIV_OFFSET_FOR_DATA);
- goto start_label;
- }
-
case MR_TYPECTOR_REP_C_POINTER:
#ifdef select_compare_code
if ((void *) x == (void *) y) {
Index: trace/mercury_trace_declarative.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/trace/mercury_trace_declarative.c,v
retrieving revision 1.36
diff -u -r1.36 mercury_trace_declarative.c
--- trace/mercury_trace_declarative.c 2000/12/06 06:06:05 1.36
+++ trace/mercury_trace_declarative.c 2001/01/08 02:19:52
@@ -29,6 +29,7 @@
#include "mercury_imp.h"
#include "mercury_trace_declarative.h"
+#include "std_util.h"
#ifdef MR_USE_DECLARATIVE_DEBUGGER
@@ -1095,13 +1096,7 @@
MR_fatal_error(problem);
}
- MR_TRACE_USE_HP(
- MR_tag_incr_hp(arg, MR_mktag(0), 2);
- );
- MR_field(MR_mktag(0), arg, MR_UNIV_OFFSET_FOR_TYPEINFO) =
- (MR_Word) arg_type;
- MR_field(MR_mktag(0), arg, MR_UNIV_OFFSET_FOR_DATA) =
- arg_value;
+ ML_construct_univ((MR_Word) arg_type, arg_value, &arg);
MR_TRACE_CALL_MERCURY(
atom = MR_DD_add_trace_atom_arg(atom,
Index: trace/mercury_trace_external.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/trace/mercury_trace_external.c,v
retrieving revision 1.49
diff -u -r1.49 mercury_trace_external.c
--- trace/mercury_trace_external.c 2000/12/06 06:06:05 1.49
+++ trace/mercury_trace_external.c 2001/01/08 02:21:09
@@ -20,6 +20,7 @@
*/
#include "mercury_imp.h"
+#include "std_util.h"
#ifdef MR_USE_EXTERNAL_DEBUGGER
@@ -1112,13 +1113,7 @@
MR_fatal_error(problem);
}
- MR_TRACE_USE_HP(
- MR_incr_hp(univ, 2);
- );
-
- MR_field(MR_mktag(0), univ, MR_UNIV_OFFSET_FOR_TYPEINFO)
- = (MR_Word) type_info;
- MR_field(MR_mktag(0), univ, MR_UNIV_OFFSET_FOR_DATA) = value;
+ ML_construct_univ((MR_Word) type_info, value, &univ);
MR_TRACE_USE_HP(
var_list = MR_list_cons(univ, var_list);
@@ -1226,16 +1221,11 @@
var_number = MR_get_var_number(debugger_request);
/* debugger_request should be of the form:
current_nth_var(var_number) */
- MR_TRACE_USE_HP(
- MR_incr_hp(univ, 2);
- );
problem = MR_trace_return_var_info(var_number, NULL,
&type_info, &value);
if (problem == NULL) {
- MR_field(MR_mktag(0), univ, MR_UNIV_OFFSET_FOR_TYPEINFO)
- = (MR_Word) type_info;
- MR_field(MR_mktag(0), univ, MR_UNIV_OFFSET_FOR_DATA) = value;
+ ML_construct_univ((MR_Word) type_info, value, &univ);
} else {
/*
** Should never occur since we check in the external debugger
Index: trace/mercury_trace_internal.c
===================================================================
RCS file: /home/staff/zs/imp/mercury/trace/mercury_trace_internal.c,v
retrieving revision 1.91
diff -u -r1.91 mercury_trace_internal.c
--- trace/mercury_trace_internal.c 2000/12/18 05:16:57 1.91
+++ trace/mercury_trace_internal.c 2001/01/08 02:22:23
@@ -27,6 +27,7 @@
#include "mercury_trace_vars.h"
#include "mercury_trace_readline.h"
+#include "std_util.h"
#include "mdb.browse.h"
#include "mdb.program_representation.h"
@@ -478,10 +479,7 @@
return "missing exception value";
}
- type_info = MR_field(MR_mktag(0), exception,
- MR_UNIV_OFFSET_FOR_TYPEINFO);
- value = MR_field(MR_mktag(0), exception,
- MR_UNIV_OFFSET_FOR_DATA);
+ ML_unravel_univ(&type_info, exception, &value);
(*browser)(type_info, value, caller, format);
--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to: mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions: mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------
More information about the developers
mailing list