[m-rev.] for review: comparison of preds/funcs
Mark Brown
dougl at cs.mu.OZ.AU
Mon Apr 22 19:57:44 AEST 2002
On 18-Apr-2002, Mark Brown <dougl at cs.mu.OZ.AU> wrote:
> Ok. For the moment, I will not commit the NEWS entry and I'll move the
> declarations of compare_representation into the non-documented part of
> std_util's interface, along with an XXX. I'll post the relative diff
> after the rest of the change is reviewed.
>
Actually, here is the absolute diff of the current state of the change,
as per request made off this list.
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. For this reason, it is not officially part of the standard
library yet.
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.
runtime/mercury.c:
runtime/mercury.h:
Supply a HIGHLEVEL_CODE version of the new predicate. This just
gives a "Sorry, not implemented" message and aborts.
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.
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.265
diff -u -r1.265 std_util.m
--- library/std_util.m 15 Mar 2002 07:32:15 -0000 1.265
+++ library/std_util.m 22 Apr 2002 09:35:57 -0000
@@ -721,6 +721,18 @@
%
:- pred dynamic_cast(T1::in, T2::out) is semidet.
+ % compare_representation(Result, X, Y)
+ %
+ % compare_representation is similar to the builtin predicate
+ % compare/3, except that it attempts to compare non-canonical
+ % terms by comparing their representations.
+ %
+ % XXX This predicate is not implemented for highlevel code. This
+ % is the reason it is not in the official part of the interface.
+ %
+:- pred compare_representation(comparison_result, T, T).
+:- mode compare_representation(uo, in, in) is cc_multi.
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1619,6 +1631,8 @@
det_named_argument_cc(Type, Name, ArgumentUniv) :-
deconstruct__det_named_arg(Type, include_details_cc, Name, Argument),
type_to_univ(Argument, ArgumentUniv).
+
+:- external(compare_representation/3).
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.87
diff -u -r1.87 Mmakefile
--- runtime/Mmakefile 20 Mar 2002 12:37:53 -0000 1.87
+++ runtime/Mmakefile 22 Apr 2002 09:35: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
#-----------------------------------------------------------------------------#
Index: runtime/mercury.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.c,v
retrieving revision 1.40
diff -u -r1.40 mercury.c
--- runtime/mercury.c 12 Apr 2002 01:24:22 -0000 1.40
+++ runtime/mercury.c 22 Apr 2002 09:36:03 -0000
@@ -327,6 +327,13 @@
mercury__builtin__compare_3_p_0(type_info, res, x, y);
}
+void MR_CALL
+mercury__std_util__compare_representation_3_p_0(MR_Mercury_Type_Info ti,
+ MR_Comparison_Result *res, MR_Box x, MR_Box y)
+{
+ SORRY("compare_representation/3 for HIGHLEVEL_CODE");
+}
+
/*---------------------------------------------------------------------------*/
/*---------------------------------------------------------------------------*/
/*
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.56
diff -u -r1.56 mercury.h
--- runtime/mercury.h 14 Apr 2002 17:56:45 -0000 1.56
+++ runtime/mercury.h 22 Apr 2002 09:36:07 -0000
@@ -682,6 +682,8 @@
MR_Comparison_Result *, MR_Box, MR_Box);
void MR_CALL mercury__builtin__compare_3_p_3(MR_Mercury_Type_Info,
MR_Comparison_Result *, MR_Box, MR_Box);
+void MR_CALL mercury__std_util__compare_representation_3_p_0(
+ MR_Mercury_Type_Info, MR_Comparison_Result *, MR_Box, MR_Box);
MR_bool MR_CALL mercury__builtin____Unify____int_0_0(MR_Integer x,
MR_Integer y);
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.53
diff -u -r1.53 mercury_ho_call.c
--- runtime/mercury_ho_call.c 12 Apr 2002 04:45:36 -0000 1.53
+++ runtime/mercury_ho_call.c 22 Apr 2002 09:36:13 -0000
@@ -24,6 +24,7 @@
#include "mercury_type_desc.h"
#include "mercury_deep_profiling.h"
#include "mercury_deep_profiling_hand.h"
+#include "mercury_layout_util.h"
#ifdef MR_DEEP_PROFILING
#ifdef MR_DEEP_PROFILING_STATISTICS
@@ -117,6 +118,9 @@
#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_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
@@ -169,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);
@@ -178,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
/*
@@ -415,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
@@ -504,6 +564,122 @@
#undef type_stat_struct
#undef attempt_msg
#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_closures(MR_Closure *x, MR_Closure *y)
+{
+ MR_Closure_Layout *x_layout;
+ MR_Closure_Layout *y_layout;
+ MR_Proc_Id *x_proc_id;
+ MR_Proc_Id *y_proc_id;
+ MR_TypeInfo *x_type_params;
+ MR_TypeInfo *y_type_params;
+ int x_num_args;
+ int y_num_args;
+ int num_args;
+ int i;
+ int result;
+
+ /*
+ ** Optimize the simple case.
+ */
+ if (x == y) {
+ return MR_COMPARE_EQUAL;
+ }
+
+ x_layout = x->MR_closure_layout;
+ y_layout = y->MR_closure_layout;
+
+ x_proc_id = &x_layout->MR_closure_id->MR_closure_proc_id;
+ y_proc_id = &y_layout->MR_closure_id->MR_closure_proc_id;
+ if (x_proc_id < y_proc_id) {
+ return MR_COMPARE_LESS;
+ } else if (x_proc_id > y_proc_id) {
+ return MR_COMPARE_GREATER;
+ }
+
+ x_num_args = x->MR_closure_num_hidden_args;
+ y_num_args = y->MR_closure_num_hidden_args;
+ if (x_num_args < y_num_args) {
+ return MR_COMPARE_LESS;
+ } else if (x_num_args > y_num_args) {
+ return MR_COMPARE_GREATER;
+ }
+
+ num_args = x_num_args;
+ x_type_params = MR_materialize_closure_type_params(x);
+ y_type_params = MR_materialize_closure_type_params(y);
+ for (i = 0; i < num_args; i++) {
+ MR_TypeInfo x_arg_type_info;
+ MR_TypeInfo y_arg_type_info;
+ MR_TypeInfo arg_type_info;
+
+ x_arg_type_info = MR_create_type_info(x_type_params,
+ x_layout->MR_closure_arg_pseudo_type_info[i]);
+ y_arg_type_info = MR_create_type_info(y_type_params,
+ y_layout->MR_closure_arg_pseudo_type_info[i]);
+ result = MR_compare_type_info(x_arg_type_info, y_arg_type_info);
+ if (result != MR_COMPARE_EQUAL) {
+ goto finish_closure_compare;
+ }
+
+ arg_type_info = x_arg_type_info;
+ result = MR_generic_compare(arg_type_info,
+ x->MR_closure_hidden_args_0[i],
+ y->MR_closure_hidden_args_0[i]);
+ if (result != MR_COMPARE_EQUAL) {
+ goto finish_closure_compare;
+ }
+ }
+
+ result = MR_COMPARE_EQUAL;
+
+finish_closure_compare:
+ if (x_type_params != NULL) {
+ MR_free(x_type_params);
+ }
+ if (y_type_params != NULL) {
+ MR_free(y_type_params);
+ }
+ return result;
}
#endif /* not MR_HIGHLEVEL_CODE */
Index: runtime/mercury_unify_compare_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_unify_compare_body.h,v
retrieving revision 1.23
diff -u -r1.23 mercury_unify_compare_body.h
--- runtime/mercury_unify_compare_body.h 14 Apr 2002 04:03:48 -0000 1.23
+++ runtime/mercury_unify_compare_body.h 22 Apr 2002 09:36:15 -0000
@@ -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:
@@ -674,7 +710,19 @@
case MR_TYPECTOR_REP_FUNC:
case MR_TYPECTOR_REP_PRED:
- MR_fatal_error(attempt_msg "higher-order terms");
+ {
+#ifdef include_compare_rep_code
+ int 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
+ }
case MR_TYPECTOR_REP_TYPECLASSINFO:
MR_fatal_error(attempt_msg "typeclass_infos");
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.147
diff -u -r1.147 Mmakefile
--- tests/hard_coded/Mmakefile 16 Apr 2002 03:33:19 -0000 1.147
+++ tests/hard_coded/Mmakefile 22 Apr 2002 09:36:20 -0000
@@ -142,7 +142,7 @@
write_reg1 \
write_reg2
-# These test require the implementation to support closure layouts
+# These tests require the implementation to support closure layouts
CLOSURE_LAYOUT_PROGS = \
copy_pred \
copy_pred_2
@@ -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,11 +172,13 @@
EXCEPTION_PROGS =
endif
+# 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 (e.g. hlc.gc),
-# because the code for nondet fact tables assumes that
-# we're using the LLDS back-end. Also, fact tables and deep profiling do not
-# (yet) mix.
+# 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
+# and deep profiling do not (yet) mix.
#
# type_tables does not work in the hl* grades because the test itself
# is a quick hack that assumes the use of the LLDS backend; it should
@@ -182,13 +187,17 @@
ifeq "$(findstring hl,$(GRADE))" ""
ifeq "$(findstring profdeep,$(GRADE))" ""
- BACKEND_PROGS = \
- factt_non \
- type_tables
+ BACKEND_PROGS_2 = \
+ factt_non
else
- BACKEND_PROGS = \
- type_tables
+ BACKEND_PROGS_2 =
endif
+
+ BACKEND_PROGS = \
+ $(BACKEND_PROGS_2) \
+ compare_representation \
+ compare_rep_usereq \
+ type_tables
else
BACKEND_PROGS =
endif
Index: tests/hard_coded/compare_rep_array.m
===================================================================
RCS file: tests/hard_coded/compare_rep_array.m
diff -N tests/hard_coded/compare_rep_array.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/compare_rep_array.m 22 Apr 2002 09:36:20 -0000
@@ -0,0 +1,39 @@
+:- module compare_rep_array.
+:- interface.
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+:- implementation.
+:- import_module array, list, std_util.
+
+main -->
+ test(d1, d2),
+ test(d2, d3),
+ test(d3, d3).
+
+:- type val == pair(string, univ).
+
+:- func d1 = val.
+d1 = "{1, 2, 3} : array(int)" - univ(array([1, 2, 3])).
+
+:- func d2 = val.
+d2 = "{1, 4, 9} : array(int)" - univ(array([1, 4, 9])).
+
+:- func d3 = val.
+d3 = "{1.0, 1.1, 1.2} : array(float)" - univ(array([1.0, 1.1, 1.2])).
+
+:- 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("not ")
+ ),
+ io__write_string("equal\n\n").
+
Index: tests/hard_coded/compare_rep_usereq.exp
===================================================================
RCS file: tests/hard_coded/compare_rep_usereq.exp
diff -N tests/hard_coded/compare_rep_usereq.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/compare_rep_usereq.exp 22 Apr 2002 09:36:20 -0000
@@ -0,0 +1,8 @@
+aa : foo
+aa : foo
+equal
+
+aa : foo
+bb : foo
+maybe not equal
+
Index: tests/hard_coded/compare_rep_usereq.m
===================================================================
RCS file: tests/hard_coded/compare_rep_usereq.m
diff -N tests/hard_coded/compare_rep_usereq.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/compare_rep_usereq.m 22 Apr 2002 09:36:22 -0000
@@ -0,0 +1,42 @@
+:- module compare_rep_usereq.
+:- interface.
+:- import_module io.
+:- pred main(io__state::di, io__state::uo) is cc_multi.
+:- implementation.
+:- import_module std_util.
+
+main -->
+ test(da, da),
+ test(da, db).
+
+:- type val == pair(string, univ).
+
+:- func da = val.
+da = "aa : foo" - univ(aa).
+
+:- func db = val.
+db = "bb : foo" - univ(bb).
+
+:- type foo ---> aa ; bb
+ where equality is foo_eq.
+
+:- pred foo_eq(foo::in, foo::in) is semidet.
+foo_eq(_, _) :-
+ semidet_succeed.
+
+:- 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").
+
Index: tests/hard_coded/compare_representation.exp
===================================================================
RCS file: tests/hard_coded/compare_representation.exp
diff -N tests/hard_coded/compare_representation.exp
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/compare_representation.exp 22 Apr 2002 09:36:22 -0000
@@ -0,0 +1,20 @@
+1 : int
+1 : int
+equal
+
+1 : int
+main : pred(io__state, io__state)
+maybe 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)
+maybe not equal
+
+foo(1) : func(int) = int
+foo(2) : func(int) = int
+maybe not equal
+
Index: tests/hard_coded/compare_representation.m
===================================================================
RCS file: tests/hard_coded/compare_representation.m
diff -N tests/hard_coded/compare_representation.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ tests/hard_coded/compare_representation.m 22 Apr 2002 09:36:22 -0000
@@ -0,0 +1,50 @@
+:- 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").
+
--------------------------------------------------------------------------
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