[m-rev.] for review: comparison of preds/funcs
Mark Brown
dougl at cs.mu.OZ.AU
Tue Apr 16 07:03:53 AEST 2002
On 14-Apr-2002, Zoltan Somogyi <zs at cs.mu.OZ.AU> wrote:
> On 14-Apr-2002, Mark Brown <dougl at cs.mu.OZ.AU> wrote:
> > Well, MR_COMPARE_BY_RTTI is undocumented, and enabling it results in a
> > compilation error. I can address both of these issues if you like.
>
> The compilation errors are easily fixed: the diff, which I will commit,
> follows this mail. I will do the documentation as well, but later.
>
> > But
> > another problem is that, even with MR_COMPARE_BY_RTTI enabled, comparison
> > is still done through the type_ctor_info for arrays, so comparing by RTTI
> > will need to be implemented for arrays. Is there a technical reason why
> > this hasn't been done yet, or is it just a case of "not yet implemented"?
>
> Not yet implemented. I can do this too; don't worry about it.
>
Here's the updated log message and relative diff. interdiff got slightly
confused by the changes in the tests directory, but those changes are fairly
straightforward anyway.
Cheers,
Mark.
Estimated hours taken: 5
Branches: main
Implement compare_representation/3, which is like compare except that it
is cc_multi, and it doesn't abort on pred and func types. The implementation
only works for the LLDS backend; in other cases, the behaviour is the same as
compare/3.
NEWS:
Mention the new addition to the library.
library/std_util.m:
Add the new predicate, which is implemented via "external".
runtime/mercury_ho_call.c:
Implement compare_representation/3, and also a C version.
runtime/mercury_unify_compare_body.h:
Implement the body of compare_representation/3. When the macro
include_compare_rep_code is defined comparison of preds and
funcs doesn't abort, the code that is used for MR_COMPARE_BY_RTTI
is enabled, and usereq types are treated as normal types.
runtime/Mmakefile:
Bug fix: add missing pic_o versions of the explicit dependencies.
Use variables for the suffixes in these dependencies.
tests/hard_coded/Mmakefile:
tests/hard_coded/compare_rep_usereq.exp:
tests/hard_coded/compare_rep_usereq.m:
tests/hard_coded/compare_representation.exp:
tests/hard_coded/compare_representation.m:
Test cases.
tests/hard_coded/compare_rep_array.m:
A test case which doesn't work yet.
diff -u library/std_util.m library/std_util.m
--- library/std_util.m
+++ library/std_util.m
@@ -708,14 +708,14 @@
:- pred limited_deconstruct_cc(T::in, int::in, string::out,
int::out, list(univ)::out) is cc_nondet.
- % compare_approx(Result, X, Y)
+ % compare_representation(Result, X, Y)
%
- % compare_approx is similar to the builtin predicate compare/3,
- % except that it attempts to compare non-canonical terms by
- % comparing their representations.
+ % compare_representation is similar to the builtin predicate
+ % compare/3, except that it attempts to compare non-canonical
+ % terms by comparing their representations.
%
-:- pred compare_approx(comparison_result, T, T).
-:- mode compare_approx(uo, in, in) is cc_multi.
+:- pred compare_representation(comparison_result, T, T).
+:- mode compare_representation(uo, in, in) is cc_multi.
%-----------------------------------------------------------------------------%
@@ -1629,26 +1629,7 @@
deconstruct__det_named_arg(Type, include_details_cc, Name, Argument),
type_to_univ(Argument, ArgumentUniv).
-:- pragma promise_pure(compare_approx/3).
-
-compare_approx(Result, X, Y) :-
- impure set_compare_approx_flag(1),
- compare(Result0, X, Y),
- impure set_compare_approx_flag(0),
- cc_multi_equal(Result0, Result).
-
-:- pragma foreign_decl("C", "extern MR_bool MR_generic_compare_approx;").
-
-:- impure pred set_compare_approx_flag(int).
-:- mode set_compare_approx_flag(in) is det.
-
-:- pragma foreign_proc("C",
- set_compare_approx_flag(Flag::in),
- [will_not_call_mercury],
- "MR_generic_compare_approx = (MR_bool) Flag;").
-
-set_compare_approx_flag(_::in) :-
- private_builtin__sorry("std_util__set_compare_approx_flag/1").
+:- external(compare_representation/3).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
reverted:
--- runtime/mercury.c 12 Apr 2002 09:19:22 -0000
+++ runtime/mercury.c 12 Apr 2002 01:24:22 -0000 1.40
@@ -19,7 +19,6 @@
#include "mercury_type_desc.h" /* for MR_TypeCtorDesc */
#include "mercury_misc.h" /* for MR_fatal_error() */
#include "mercury_heap.h" /* for MR_create[1-3]() prototypes */
-#include "mercury_ho_call.h" /* for MR_generic_compare_approx */
#ifdef MR_HIGHLEVEL_CODE
@@ -550,22 +549,14 @@
mercury__builtin____Compare____func_0_0(MR_Comparison_Result *result,
MR_Func x, MR_Func y)
{
+ MR_fatal_error("called compare/3 for `func' type");
- if (!MR_generic_compare_approx) {
- MR_fatal_error("called compare/3 for `func' type");
- } else {
- SORRY("compare_approx/3 for `func' type");
- }
}
void MR_CALL
mercury__builtin____Compare____pred_0_0(MR_Comparison_Result *result,
MR_Pred x, MR_Pred y)
{
+ MR_fatal_error("called compare/3 for `pred' type");
- if (!MR_generic_compare_approx) {
- MR_fatal_error("called compare/3 for `pred' type");
- } else {
- SORRY("compare_approx/3 for `pred' type");
- }
}
void MR_CALL
diff -u runtime/mercury_ho_call.c runtime/mercury_ho_call.c
--- runtime/mercury_ho_call.c
+++ runtime/mercury_ho_call.c
@@ -115,12 +115,12 @@
#endif
-MR_bool MR_generic_compare_approx = MR_FALSE;
-
#ifndef MR_HIGHLEVEL_CODE
static MR_Word MR_generic_compare(MR_TypeInfo type_info, MR_Word x, MR_Word y);
static MR_Word MR_generic_unify(MR_TypeInfo type_info, MR_Word x, MR_Word y);
-static MR_Word MR_compare_closure_approx(MR_Closure *x, MR_Closure *y);
+static MR_Word MR_generic_compare_representation(MR_TypeInfo type_info,
+ MR_Word x, MR_Word y);
+static MR_Word MR_compare_closures(MR_Closure *x, MR_Closure *y);
/*
** The called closure may contain only input arguments. The extra arguments
@@ -173,6 +173,7 @@
MR_define_extern_entry(mercury__compare_3_2);
MR_define_extern_entry(mercury__compare_3_3);
MR_declare_label(mercury__compare_3_0_i1);
+MR_define_extern_entry(mercury__std_util__compare_representation_3_0);
MR_BEGIN_MODULE(call_module)
MR_init_entry_an(mercury__do_call_closure);
@@ -182,6 +183,7 @@
MR_init_entry_an(mercury__compare_3_1);
MR_init_entry_an(mercury__compare_3_2);
MR_init_entry_an(mercury__compare_3_3);
+ MR_init_entry_an(mercury__std_util__compare_representation_3_0);
MR_BEGIN_CODE
/*
@@ -419,6 +421,60 @@
#undef entry_point_is_mercury
}
+
+/*
+** mercury__std_util__compare_representation_3_0 is called as
+** `compare_representation(TypeInfo, Result, X, Y)' in the mode
+** `compare_representation(in, uo, in, in) is cc_multi'.
+*/
+
+MR_define_entry(mercury__std_util__compare_representation_3_0);
+{
+
+#define DECLARE_LOCALS \
+ MR_TypeCtorInfo type_ctor_info; \
+ MR_TypeInfo type_info; \
+ MR_Word x, y; \
+ MR_Code *saved_succip;
+
+#define initialize() \
+ do { \
+ type_info = (MR_TypeInfo) MR_r1; \
+ x = MR_r2; \
+ y = MR_r3; \
+ saved_succip = MR_succip; \
+ } while(0)
+
+#define return_answer(answer) \
+ do { \
+ MR_r1 = (answer); \
+ MR_succip = saved_succip; \
+ MR_proceed(); \
+ } while(0)
+
+#define start_label compare_rep_start
+#define call_user_code_label call_compare_rep_in_proc
+#define type_stat_struct MR_type_stat_mer_compare
+#define attempt_msg "attempt to compare representation "
+#define select_compare_code
+#define include_compare_rep_code
+#define entry_point_is_mercury
+
+#include "mercury_unify_compare_body.h"
+
+#undef DECLARE_LOCALS
+#undef initialize
+#undef return_answer
+#undef start_label
+#undef call_user_code_label
+#undef type_stat_struct
+#undef attempt_msg
+#undef select_compare_code
+#undef include_compare_rep_code
+#undef entry_point_is_mercury
+
+}
+
MR_END_MODULE
static MR_Word
@@ -510,8 +566,45 @@
#undef select_compare_code
}
+static MR_Word
+MR_generic_compare_representation(MR_TypeInfo type_info, MR_Word x, MR_Word y)
+{
+#define DECLARE_LOCALS \
+ MR_TypeCtorInfo type_ctor_info;
+
+#define initialize() \
+ do { \
+ MR_restore_transient_registers(); \
+ } while (0)
+
+#define return_answer(answer) \
+ do { \
+ MR_save_transient_registers(); \
+ return (answer); \
+ } while (0)
+
+#define start_label compare_rep_func_start
+#define call_user_code_label call_compare_rep_in_func
+#define type_stat_struct MR_type_stat_c_compare
+#define attempt_msg "attempt to compare representation"
+#define select_compare_code
+#define include_compare_rep_code
+
+#include "mercury_unify_compare_body.h"
+
+#undef DECLARE_LOCALS
+#undef initialize
+#undef return_answer
+#undef start_label
+#undef call_user_code_label
+#undef type_stat_struct
+#undef attempt_msg
+#undef select_compare_code
+#undef include_compare_rep_code
+}
+
static MR_Word
-MR_compare_closure_approx(MR_Closure *x, MR_Closure *y)
+MR_compare_closures(MR_Closure *x, MR_Closure *y)
{
MR_Closure_Layout *x_layout;
MR_Closure_Layout *y_layout;
reverted:
--- runtime/mercury_ho_call.h 12 Apr 2002 09:19:27 -0000
+++ runtime/mercury_ho_call.h 24 Feb 2002 11:53:32 -0000 1.6
@@ -114,18 +114,4 @@
#define MR_closure_hidden_args(i) MR_closure_hidden_args_0[(i) - 1]
-/*
-** Comparison of noncanonical types such as preds or funcs normally results
-** in a runtime abort. If MR_generic_compare_approx is set to MR_TRUE, the
-** generic comparison routine will approximate the correct answer by
-** comparing the internal representations of the values. This operation is
-** non-deterministic, in the sense that the same value may have different
-** representations and so give different answers, so when calling the builtin
-** predicate compare/3 (which is det) this variable should always be set to
-** MR_FALSE.
-**
-** This is intended to be used by compare_approx/3 in library/std_util.m.
-*/
-extern MR_bool MR_generic_compare_approx;
-
#endif /* not MERCURY_HO_CALL_H */
diff -u runtime/mercury_unify_compare_body.h runtime/mercury_unify_compare_body.h
--- runtime/mercury_unify_compare_body.h
+++ runtime/mercury_unify_compare_body.h
@@ -9,12 +9,14 @@
/*
** This file contains a piece of code that is included by mercury_ho_call.c
-** four times:
+** six times:
**
** - as the body of the mercury__unify_2_0 Mercury procedure,
-** - as the body of the mercury__compare_3_3 Mercury procedure, and
-** - as the body of the MR_generic_unify C function.
-** - as the body of the MR_generic_compare C function.
+** - as the body of the mercury__compare_3_3 Mercury procedure,
+** - as the body of the mercury__compare_representation_3_0 Mercury procedure,
+** - as the body of the MR_generic_unify C function,
+** - as the body of the MR_generic_compare C function, and
+** - as the body of the MR_generic_compare_representation C function.
**
** The inclusions are surrounded by #defines and #undefs of the macros
** that personalize each copy of the code.
@@ -22,7 +24,8 @@
** The reason why the unify and compare Mercury procedures share code is
** that unify is mostly just a special case of comparison; it differs only
** by treating "less than" and "greater than" the same way, and returning
-** its result slightly differently.
+** its result slightly differently. Likewise, compare_representation
+** is mostly the same as compare.
**
** The reason why there is both a Mercury procedure and a C function for
** unifications and comparisons is that the Mercury procedure needs a
@@ -53,7 +56,7 @@
switch (MR_type_ctor_rep(type_ctor_info)) {
-#ifdef MR_COMPARE_BY_RTTI
+#if defined(MR_COMPARE_BY_RTTI) || defined(include_compare_rep_code)
case MR_TYPECTOR_REP_EQUIV:
MR_save_transient_hp();
@@ -68,6 +71,10 @@
MR_type_ctor_layout(type_ctor_info).layout_equiv;
goto start_label;
+ #ifdef include_compare_rep_code
+ case MR_TYPECTOR_REP_NOTAG_USEREQ:
+ /* fall through */
+ #endif
case MR_TYPECTOR_REP_NOTAG:
MR_save_transient_hp();
type_info = MR_create_type_info(
@@ -77,15 +84,33 @@
MR_restore_transient_hp();
goto start_label;
+ #ifdef include_compare_rep_code
+ case MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
+ /* fall through */
+ #endif
case MR_TYPECTOR_REP_NOTAG_GROUND:
type_info = (MR_TypeInfo) MR_type_ctor_layout(type_ctor_info).
layout_notag->MR_notag_functor_arg_type;
goto start_label;
+ #ifdef include_compare_rep_code
+ case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
+ /* fall through */
+ #endif
case MR_TYPECTOR_REP_RESERVED_ADDR:
MR_fatal_error("sorry, not implemented: "
"MR_COMPARE_BY_RTTI for RESERVED_ADDR");
+ #ifdef include_compare_rep_code
+ case MR_TYPECTOR_REP_ARRAY:
+ MR_fatal_error("sorry, not implemented: "
+ "compare_representation for arrays");
+ #endif
+
+ #ifdef include_compare_rep_code
+ case MR_TYPECTOR_REP_DU_USEREQ:
+ /* fall through */
+ #endif
case MR_TYPECTOR_REP_DU:
{
const MR_DuFunctorDesc *functor_desc;
@@ -272,8 +297,13 @@
}
#ifdef select_compare_code
MR_save_transient_registers();
+ #ifdef include_compare_rep_code
+ result = MR_generic_compare_representation(arg_type_info,
+ x_data_value[cur_slot], y_data_value[cur_slot]);
+ #else
result = MR_generic_compare(arg_type_info,
x_data_value[cur_slot], y_data_value[cur_slot]);
+ #endif
MR_restore_transient_registers();
if (result != MR_COMPARE_EQUAL) {
return_answer(result);
@@ -299,8 +329,10 @@
break;
-#else /* ! MR_COMPARE_BY_RTTI */
+#endif /* defined(MR_COMPARE_BY_RTTI) || defined(include_compare_rep_code) */
+#ifndef include_compare_rep_code
+ #ifndef MR_COMPARE_BY_RTTI
case MR_TYPECTOR_REP_EQUIV:
case MR_TYPECTOR_REP_EQUIV_GROUND:
case MR_TYPECTOR_REP_NOTAG:
@@ -308,8 +340,7 @@
case MR_TYPECTOR_REP_RESERVED_ADDR:
case MR_TYPECTOR_REP_DU:
/* fall through */
-
-#endif
+ #endif
case MR_TYPECTOR_REP_ENUM_USEREQ:
case MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
@@ -380,6 +411,7 @@
}
tailcall_user_pred();
+#endif /* !include_compare_rep_code */
case MR_TYPECTOR_REP_TUPLE:
{
@@ -421,6 +453,10 @@
#endif
}
+#ifdef include_compare_rep_code
+ case MR_TYPECTOR_REP_ENUM_USEREQ:
+ /* fall through */
+#endif
case MR_TYPECTOR_REP_ENUM:
case MR_TYPECTOR_REP_INT:
case MR_TYPECTOR_REP_CHAR:
@@ -675,18 +711,14 @@
case MR_TYPECTOR_REP_FUNC:
case MR_TYPECTOR_REP_PRED:
{
-#ifdef select_compare_code
- if (!MR_generic_compare_approx) {
- MR_fatal_error(attempt_msg "higher-order terms");
- } else {
- int result;
+#ifdef include_compare_rep_code
+ int result;
- MR_save_transient_registers();
- result = MR_compare_closure_approx((MR_Closure *) x,
- (MR_Closure *) y);
- MR_restore_transient_registers();
- return_answer(result);
- }
+ MR_save_transient_registers();
+ result = MR_compare_closures((MR_Closure *) x,
+ (MR_Closure *) y);
+ MR_restore_transient_registers();
+ return_answer(result);
#else
MR_fatal_error(attempt_msg "higher-order terms");
#endif
diff -u tests/hard_coded/Mmakefile tests/hard_coded/Mmakefile
--- tests/hard_coded/Mmakefile
+++ tests/hard_coded/Mmakefile
@@ -156,6 +156,9 @@
# XXX csharp_test doesn't work yet (not even in il* grades)
#
# XXX needs_init doesn't work yet in profiling grades.
+#
+# XXX compare_rep_array doesn't work because MR_COMPARE_BY_RTTI is
+# not yet implemented for arrays.
# The following tests are passed only in some grades.
@@ -169,9 +172,9 @@
EXCEPTION_PROGS =
endif
-# compare_approx does not work in the hl* grades (e.g. hlc.gc), because
-# comparison of closures gives "Sorry, not implemented" when HIGHLEVEL_CODE
-# is set.
+# compare_representation does not work in the hl* grades (e.g. hlc.gc),
+# because comparison of closures gives "Sorry, not implemented" when
+# HIGHLEVEL_CODE is set.
#
# factt_non does not work in the hl* grades because the code for nondet
# fact tables assumes that we're using the LLDS back-end. Also, fact tables
@@ -184,15 +187,17 @@
ifeq "$(findstring hl,$(GRADE))" ""
ifeq "$(findstring profdeep,$(GRADE))" ""
- BACKEND_PROGS = \
- compare_approx \
- factt_non \
- type_tables
+ BACKEND_PROGS_2 = \
+ factt_non
else
- BACKEND_PROGS = \
- compare_approx \
- type_tables
+ BACKEND_PROGS_2 =
endif
+
+ BACKEND_PROGS = \
+ $(BACKEND_PROGS_2) \
+ compare_representation \
+ compare_rep_usereq \
+ type_tables
else
BACKEND_PROGS =
endif
diff -u tests/hard_coded/compare_approx.exp tests/hard_coded/compare_representation.m
--- tests/hard_coded/compare_approx.exp
+++ tests/hard_coded/compare_representation.m
@@ -1,20 +1,50 @@
-1 : int
-1 : int
-equal
-
-1 : int
-main : pred(io__state, io__state)
-not equal
-
-main : pred(io__state, io__state)
-main : pred(io__state, io__state)
-equal
-
-main : pred(io__state, io__state)
-test(d1, dm) : pred(io__state, io__state)
-not equal
-
-foo(1) : func(int) = int
-foo(2) : func(int) = int
-not equal
+:- module compare_representation.
+:- interface.
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+:- implementation.
+:- import_module std_util.
+
+main -->
+ test(d1, d1),
+ test(d1, dm),
+ test(dm, dm),
+ test(dm, dt),
+ test(df1, df2).
+
+:- type val == pair(string, univ).
+
+:- func d1 = val.
+d1 = "1 : int" - univ(1).
+
+:- func dm = val.
+dm = "main : pred(io__state, io__state)" - univ(main).
+
+:- func dt = val.
+dt = "test(d1, dm) : pred(io__state, io__state)" - univ(test(d1, dm)).
+
+:- func df1 = val.
+df1 = "foo(1) : func(int) = int" - univ(foo(1)).
+
+:- func df2 = val.
+df2 = "foo(2) : func(int) = int" - univ(foo(2)).
+
+:- func foo(int, int) = int.
+foo(_, Z) = Z.
+
+:- pred test(val::in, val::in, io__state::di, io__state::uo) is cc_multi.
+test(SA - A, SB - B) -->
+ io__write_string(SA),
+ io__nl,
+ io__write_string(SB),
+ io__nl,
+ { std_util__compare_representation(Res, A, B) },
+ (
+ { Res = (=) }
+ ->
+ []
+ ;
+ io__write_string("maybe not ")
+ ),
+ io__write_string("equal\n\n").
diff -u tests/hard_coded/compare_approx.m tests/hard_coded/compare_representation.m
--- tests/hard_coded/compare_approx.m
+++ tests/hard_coded/compare_representation.m
@@ -1,4 +1,4 @@
-:- module compare_approx.
+:- module compare_representation.
:- interface.
:- import_module io.
:- pred main(io__state::di, io__state::uo) is cc_multi.
@@ -38,13 +38,13 @@
io__nl,
io__write_string(SB),
io__nl,
- { std_util__compare_approx(Res, A, B) },
+ { std_util__compare_representation(Res, A, B) },
(
{ Res = (=) }
->
[]
;
- io__write_string("not ")
+ io__write_string("maybe not ")
),
io__write_string("equal\n\n").
only in patch2:
--- runtime/Mmakefile 20 Mar 2002 12:37:53 -0000 1.87
+++ runtime/Mmakefile 15 Apr 2002 19:02:59 -0000
@@ -238,10 +238,15 @@
$(OBJS) $(PIC_OBJS): $(HDRS) $(MACHHDRS)
-mercury_deconstruct.o: mercury_ml_expand_body.h
-mercury_deep_copy.o: mercury_deep_copy_body.h
-mercury_type_info.o: mercury_make_type_info_body.h
-mercury_ho_call.o: mercury_unify_compare_body.h
+mercury_deconstruct.$(O): mercury_ml_expand_body.h
+mercury_deep_copy.$(O): mercury_deep_copy_body.h
+mercury_type_info.$(O): mercury_make_type_info_body.h
+mercury_ho_call.$(O): mercury_unify_compare_body.h
+
+mercury_deconstruct.$(EXT_FOR_PIC_OBJECTS): mercury_ml_expand_body.h
+mercury_deep_copy.$(EXT_FOR_PIC_OBJECTS): mercury_deep_copy_body.h
+mercury_type_info.$(EXT_FOR_PIC_OBJECTS): mercury_make_type_info_body.h
+mercury_ho_call.$(EXT_FOR_PIC_OBJECTS): mercury_unify_compare_body.h
#-----------------------------------------------------------------------------#
only in patch2:
--- NEWS 15 Apr 2002 05:03:58 -0000 1.255
+++ NEWS 15 Apr 2002 19:02:22 -0000
@@ -211,6 +211,10 @@
existing versions in that they do not abort when called upon to deconstruct
non-canonical terms, such as values of types with user-defined equality.
+* We've added a new predicate `compare_representation' which is a committed
+ choice version of the builtin predicate `compare', but which does not
+ always abort when called upon to compare non-canonical terms.
+
* We've added a new predicate `intersect_list' in each of the modules
implementing sets in the Mercury standard library.
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list