diff --git a/runtime/mercury_conf_param.h b/runtime/mercury_conf_param.h index b2ed9d8d2..886e50ef8 100644 --- a/runtime/mercury_conf_param.h +++ b/runtime/mercury_conf_param.h @@ -1,5 +1,5 @@ /* -** Copyright (C) 1997-2004 The University of Melbourne. +** Copyright (C) 1997-2005 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. */ @@ -119,6 +119,13 @@ ** Add extra backwards compatibility with C code using obsolete low-level ** constructs, e.g. referring to variables and macros without their MR_ ** prefixes. +** +** MR_CHECK_DU_EQ +** When unifying or comparing two values of discriminated union types, +** check first whether the values (which are usually pointers) are equal. +** +** MR_DISABLE_CHECK_DU_EQ +** MR_CHECK_DU_EQ is turned on by default; this macro prevents this. */ /* @@ -512,6 +519,10 @@ #undef MR_DEEP_PROFILING_MEMORY #endif +#ifndef MR_DISABLE_CHECK_DU_EQ + #define MR_CHECK_DU_EQ +#endif + /*---------------------------------------------------------------------------*/ /* ** Configuration parameters whose values are determined by the settings diff --git a/runtime/mercury_unify_compare_body.h b/runtime/mercury_unify_compare_body.h index b83b200da..0fa9b4c43 100644 --- a/runtime/mercury_unify_compare_body.h +++ b/runtime/mercury_unify_compare_body.h @@ -2,7 +2,7 @@ ** vim:ts=4 sw=4 expandtab */ /* -** Copyright (C) 2000-2004 The University of Melbourne. +** Copyright (C) 2000-2005 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. */ @@ -181,6 +181,19 @@ start_label: int arity; int i; + #ifdef MR_CHECK_DU_EQ + #ifdef select_compare_code + if (x == y) { + return_compare_answer(builtin, user_by_rtti, 0, + MR_COMPARE_EQUAL); + } + #else + if (x == y) { + return_unify_answer(builtin, user_by_rtti, 0, MR_TRUE); + } + #endif + #endif + #ifdef select_compare_code #define MR_find_du_functor_desc(data, data_value, functor_desc) \ @@ -237,7 +250,7 @@ start_label: y_ptag = MR_tag(y); if (x_ptag != y_ptag) { - return_unify_answer(user, MR_FALSE); + return_unify_answer(builtin, user_by_rtti, 0, MR_FALSE); } ptaglayout = &MR_type_ctor_layout(type_ctor_info). @@ -251,7 +264,8 @@ start_label: y_sectag = MR_unmkbody(y_data_value); if (x_sectag != y_sectag) { - return_unify_answer(user, MR_FALSE); + return_unify_answer(builtin, user_by_rtti, 0, + MR_FALSE); } break; @@ -261,7 +275,8 @@ start_label: y_sectag = y_data_value[0]; if (x_sectag != y_sectag) { - return_unify_answer(user, MR_FALSE); + return_unify_answer(builtin, user_by_rtti, 0, + MR_FALSE); } break; @@ -407,6 +422,19 @@ start_label: case MR_TYPECTOR_REP_FOREIGN: case MR_TYPECTOR_REP_STABLE_FOREIGN: + #ifdef MR_CHECK_DU_EQ + #ifdef select_compare_code + if (x == y) { + return_compare_answer(builtin, user_by_rtti, 0, + MR_COMPARE_EQUAL); + } + #else + if (x == y) { + return_unify_answer(builtin, user_by_rtti, 0, MR_TRUE); + } + #endif + #endif + /* ** We call the type-specific compare routine as ** `CompPred(...ArgTypeInfos..., Result, X, Y)' is det. @@ -475,8 +503,8 @@ start_label: MR_TypeInfo arg_type_info; /* type_infos are counted from one */ - arg_type_info = MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR( - type_info)[i + 1]; + arg_type_info = + MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[i + 1]; #ifdef select_compare_code MR_save_transient_registers();