[m-rev.] for review: fix a bug caused by fake type_ctor arities

Zoltan Somogyi zs at cs.mu.OZ.AU
Mon Mar 10 15:22:47 AEDT 2003


For review by anyone.

Zoltan.

Fix a bug caused by the fake arities of the types defining typeinfos:
the debugger was trying to construct a typeinfo describing the types of
variables such as TypeInfo_for_K. The problem occured whenever the debugger
tried to do anything with such variables: either with print_optionals,
or via the node-creation function of the declarative debugger.

runtime/mercury_make_tyoe_info_body.h:
	Special case the typeinfo-like fake-arity types.

runtime/mercury_type_info.h:
	Add a flag for identifying typeinfo-like fake-arity types.

	Also add flags for identifying variable-arity type constructors
	and discriminated union type constructors. These flags cannot be
	used until the compiler part of this change has been installed.

	Make the flag field unconditionally part of type_ctor_infos,
	now that all installed compilers generate it.

	Factor out the macros for defining type_ctor_infos so that one
	definition serves both backends. This also fixes a bug: the
	MR_HIGHLEVEL_CODE version was using an obsolete version number.

	Delete some obsolete forms of these macros.

runtime/mercury_mcpp.h:
	Delete the obsolete forms of these macros from here too. They were
	never used.

runtime/mercury_builtin_types.c:
	Add the relevant flags to the definitions of the type_ctor_infos
	of builtin types.

runtime/mercury_type_info.c:
	Import a header now needed by mercury_make_type_info_body.h, which
	is #included in this file.

runtime/Mmakefile:
	Delete some redundant dependencies.

compiler/rtti.m:
	Extend the type of type_ctor_info flags to include the new flags.

compiler/type_ctor_info.m:
	Generate the new type_ctor_info flags, the ones that can be set
	in type_ctor_infos generated by the compiler.

tests/debugger/declarative/mapinit.{m,inp,exp,exp2}:
	New test case that exhibits the problem.

tests/debugger/declarative/Mmakefile:
	Turn on the test case.

cvs diff: Diffing .
cvs diff: Diffing analysis
cvs diff: Diffing bindist
cvs diff: Diffing boehm_gc
cvs diff: Diffing boehm_gc/Mac_files
cvs diff: Diffing boehm_gc/cord
cvs diff: Diffing boehm_gc/cord/private
cvs diff: Diffing boehm_gc/doc
cvs diff: Diffing boehm_gc/include
cvs diff: Diffing boehm_gc/include/private
cvs diff: Diffing boehm_gc/tests
cvs diff: Diffing browser
cvs diff: Diffing bytecode
cvs diff: Diffing compiler
Index: compiler/rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.24
diff -u -b -r1.24 rtti.m
--- compiler/rtti.m	28 Feb 2003 06:40:43 -0000	1.24
+++ compiler/rtti.m	8 Mar 2003 05:35:24 -0000
@@ -109,7 +109,10 @@
 		).
 
 :- type type_ctor_flag
-	--->	reserve_tag_flag.
+	--->	reserve_tag_flag
+	;	variable_arity_flag
+	;	kind_of_du_flag
+	;	typeinfo_fake_arity_flag.
 
 	% A type_ctor_details structure contains all the information that the
 	% runtime system needs to know about the data representation scheme
@@ -637,6 +640,9 @@
 
 	% The encoding here must match the one in runtime/mercury_type_info.h.
 encode_type_ctor_flag(reserve_tag_flag, N) = N + 1.
+encode_type_ctor_flag(variable_arity_flag, N)		= N + 2.
+encode_type_ctor_flag(kind_of_du_flag, N)		= N + 4.
+encode_type_ctor_flag(typeinfo_fake_arity_flag, N)	= N + 8.
 
 rtti_data_to_name(type_ctor_info(TypeCtorData), RttiTypeCtor,
 		type_ctor_info) :-
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.34
diff -u -b -r1.34 type_ctor_info.m
--- compiler/type_ctor_info.m	26 Feb 2003 06:36:25 -0000	1.34
+++ compiler/type_ctor_info.m	8 Mar 2003 04:04:51 -0000
@@ -253,8 +253,13 @@
 		)
 	),
 	Flags0 = set__init,
+	( TypeBody = du_type(_, _, _, _, _, _) ->
+		Flags1 = set__insert(Flags0, kind_of_du_flag),
 	( TypeBody ^ du_type_reserved_tag = yes ->
-		Flags = set__insert(Flags0, reserve_tag_flag)
+			Flags = set__insert(Flags1, reserve_tag_flag)
+		;
+			Flags = Flags1
+		)
 	;
 		Flags = Flags0
 	),
cvs diff: Diffing compiler/notes
cvs diff: Diffing debian
cvs diff: Diffing deep_profiler
cvs diff: Diffing deep_profiler/notes
cvs diff: Diffing doc
cvs diff: Diffing extras
cvs diff: Diffing extras/aditi
cvs diff: Diffing extras/cgi
cvs diff: Diffing extras/complex_numbers
cvs diff: Diffing extras/complex_numbers/samples
cvs diff: Diffing extras/complex_numbers/tests
cvs diff: Diffing extras/concurrency
cvs diff: Diffing extras/curs
cvs diff: Diffing extras/curs/samples
cvs diff: Diffing extras/curses
cvs diff: Diffing extras/curses/sample
cvs diff: Diffing extras/dynamic_linking
cvs diff: Diffing extras/graphics
cvs diff: Diffing extras/graphics/mercury_opengl
cvs diff: Diffing extras/graphics/mercury_tcltk
cvs diff: Diffing extras/graphics/samples
cvs diff: Diffing extras/graphics/samples/calc
cvs diff: Diffing extras/graphics/samples/maze
cvs diff: Diffing extras/graphics/samples/pent
cvs diff: Diffing extras/lazy_evaluation
cvs diff: Diffing extras/lex
cvs diff: Diffing extras/lex/samples
cvs diff: Diffing extras/lex/tests
cvs diff: Diffing extras/logged_output
cvs diff: Diffing extras/moose
cvs diff: Diffing extras/moose/samples
cvs diff: Diffing extras/morphine
cvs diff: Diffing extras/morphine/non-regression-tests
cvs diff: Diffing extras/morphine/scripts
cvs diff: Diffing extras/morphine/source
cvs diff: Diffing extras/odbc
cvs diff: Diffing extras/posix
cvs diff: Diffing extras/quickcheck
cvs diff: Diffing extras/quickcheck/tutes
cvs diff: Diffing extras/references
cvs diff: Diffing extras/references/samples
cvs diff: Diffing extras/references/tests
cvs diff: Diffing extras/stream
cvs diff: Diffing extras/trailed_update
cvs diff: Diffing extras/trailed_update/samples
cvs diff: Diffing extras/trailed_update/tests
cvs diff: Diffing extras/xml
cvs diff: Diffing extras/xml/samples
cvs diff: Diffing java
cvs diff: Diffing java/library
cvs diff: Diffing java/runtime
cvs diff: Diffing library
cvs diff: Diffing profiler
cvs diff: Diffing robdd
cvs diff: Diffing runtime
Index: runtime/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/Mmakefile,v
retrieving revision 1.100
diff -u -b -r1.100 Mmakefile
--- runtime/Mmakefile	5 Mar 2003 15:55:22 -0000	1.100
+++ runtime/Mmakefile	8 Mar 2003 05:35:08 -0000
@@ -245,7 +245,6 @@
 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_type_info.$(O):		mercury_make_type_info_body.h
 
 mercury_builtin_types.$(EXT_FOR_PIC_OBJECTS):	mercury_hand_unify_compare_body.h
 mercury_builtin_types.(EXT_FOR_PIC_OBJECTS):	mercury_hand_unify_body.h mercury_hand_compare_body.h
@@ -253,7 +252,6 @@
 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
-mercury_type_info.$(EXT_FOR_PIC_OBJECTS):	mercury_make_type_info_body.h
 
 # ../tools/make_port_code makes both the .c and the .h file of the
 # mercury_profiling_builtin module.
Index: runtime/mercury_builtin_types.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_builtin_types.c,v
retrieving revision 1.8
diff -u -b -r1.8 mercury_builtin_types.c
--- runtime/mercury_builtin_types.c	23 Feb 2003 12:51:58 -0000	1.8
+++ runtime/mercury_builtin_types.c	8 Mar 2003 12:00:55 -0000
@@ -71,9 +71,14 @@
 MR_DEFINE_TYPE_CTOR_INFO(builtin, float, 0, FLOAT);
 MR_DEFINE_TYPE_CTOR_INFO(builtin, void, 0, VOID);
 MR_DEFINE_TYPE_CTOR_INFO(builtin, c_pointer, 0, C_POINTER);
-MR_DEFINE_TYPE_CTOR_INFO(builtin, pred, 0, PRED);
-MR_DEFINE_TYPE_CTOR_INFO(builtin, func, 0, FUNC);
-MR_DEFINE_TYPE_CTOR_INFO(builtin, tuple, 0, TUPLE);
+
+MR_DEFINE_TYPE_CTOR_INFO_FLAG(builtin, pred, 0, PRED,
+	MR_TYPE_CTOR_FLAG_VARIABLE_ARITY);
+MR_DEFINE_TYPE_CTOR_INFO_FLAG(builtin, func, 0, FUNC,
+	MR_TYPE_CTOR_FLAG_VARIABLE_ARITY);
+MR_DEFINE_TYPE_CTOR_INFO_FLAG(builtin, tuple, 0, TUPLE,
+	MR_TYPE_CTOR_FLAG_VARIABLE_ARITY);
+
 #ifndef MR_HIGHLEVEL_CODE
 MR_DEFINE_TYPE_CTOR_INFO(builtin, succip, 0, SUCCIP);
 MR_DEFINE_TYPE_CTOR_INFO(builtin, hp, 0, HP);
@@ -87,11 +92,15 @@
 
 MR_DEFINE_TYPE_CTOR_INFO(private_builtin, heap_pointer, 0, HP);
 MR_DEFINE_TYPE_CTOR_INFO(private_builtin, ref, 1, REFERENCE);
-MR_DEFINE_TYPE_CTOR_INFO(private_builtin, type_ctor_info, 1, TYPECTORINFO);
-MR_DEFINE_TYPE_CTOR_INFO(private_builtin, type_info, 1, TYPEINFO);
-MR_DEFINE_TYPE_CTOR_INFO(private_builtin, base_typeclass_info, 1,
-	BASETYPECLASSINFO);
-MR_DEFINE_TYPE_CTOR_INFO(private_builtin, typeclass_info, 1, TYPECLASSINFO);
+
+MR_DEFINE_TYPE_CTOR_INFO_FLAG(private_builtin, type_ctor_info, 1,
+	TYPECTORINFO, MR_TYPE_CTOR_FLAG_TYPEINFO_FAKE_ARITY);
+MR_DEFINE_TYPE_CTOR_INFO_FLAG(private_builtin, type_info, 1,
+	TYPEINFO, MR_TYPE_CTOR_FLAG_TYPEINFO_FAKE_ARITY);
+MR_DEFINE_TYPE_CTOR_INFO_FLAG(private_builtin, base_typeclass_info, 1,
+	BASETYPECLASSINFO, MR_TYPE_CTOR_FLAG_TYPEINFO_FAKE_ARITY);
+MR_DEFINE_TYPE_CTOR_INFO_FLAG(private_builtin, typeclass_info, 1,
+	TYPECLASSINFO, MR_TYPE_CTOR_FLAG_TYPEINFO_FAKE_ARITY);
 
 MR_DEFINE_TYPE_CTOR_INFO(type_desc, type_ctor_desc, 0, TYPECTORDESC);
 MR_DEFINE_TYPE_CTOR_INFO(type_desc, type_desc, 0, TYPEDESC);
Index: runtime/mercury_make_type_info_body.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_make_type_info_body.h,v
retrieving revision 1.9
diff -u -b -r1.9 mercury_make_type_info_body.h
--- runtime/mercury_make_type_info_body.h	12 Apr 2002 01:24:23 -0000	1.9
+++ runtime/mercury_make_type_info_body.h	8 Mar 2003 05:34:48 -0000
@@ -16,8 +16,7 @@
 	const MR_PseudoTypeInfo pseudo_type_info
 	MAYBE_DECLARE_ALLOC_ARG)
 {
-	return exist_func(type_info_params, 
-		pseudo_type_info, NULL, NULL
+	return exist_func(type_info_params, pseudo_type_info, NULL, NULL
 		MAYBE_PASS_ALLOC_ARG);
 }
 
@@ -39,8 +38,8 @@
 	** The pseudo_type_info might be a polymorphic variable.
 	** If so, substitute its value, and we are done.
 	*/
-	if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pseudo_type_info)) {
 
+	if (MR_PSEUDO_TYPEINFO_IS_VARIABLE(pseudo_type_info)) {
 		expanded_type_info = MR_get_arg_type_info(type_info_params, 
 			pseudo_type_info, data_value, functor_desc);
 
@@ -60,6 +59,24 @@
 	/* no arguments - optimise common case */
 	if ((MR_Word) type_ctor_info == (MR_Word) pseudo_type_info) {
 		return MR_pseudo_type_info_is_ground(pseudo_type_info);
+	}
+
+	if (MR_type_ctor_is_typeinfo_fake_arity(type_ctor_info)) {
+		/*
+		** These types have to be treated specially, because their
+		** arity is a lie. They do not actually take a type as an
+		** argument, and looking for the typeinfo of that nonexistent
+		** type can lead to core dumps.
+		**
+		** The proper fix would be to avoid making their arities lie.
+		** We use void as a space filler until that can be done.
+		*/
+
+		ALLOCATE_WORDS(type_info_arena, 2);
+		type_info_arena[0] = (MR_Word) type_ctor_info;
+		type_info_arena[1] = (MR_Word)
+			&MR_TYPE_CTOR_INFO_NAME(builtin, void, 0);
+		return (MR_TypeInfo) type_info_arena;
 	}
 
 	if (MR_type_ctor_rep_is_variable_arity(
Index: runtime/mercury_mcpp.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_mcpp.h,v
retrieving revision 1.27
diff -u -b -r1.27 mercury_mcpp.h
--- runtime/mercury_mcpp.h	28 Feb 2003 10:02:19 -0000	1.27
+++ runtime/mercury_mcpp.h	8 Mar 2003 06:16:53 -0000
@@ -204,19 +204,10 @@
     MR_STRUCT_INIT_END(})						\
     MR_CLASS_INIT_END(m, MR_PASTE5(__, type_ctor_info_, n, _, a), MR_PASTE4(type_ctor_init_, n, _, a))
 
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(m, n, a, cr, u, c)	\
-    MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(m, n, a, cr, u, c)
-
 #define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(m, n, a, cr)		\
     MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(m, n, a, cr,		\
 	MR_PASTE7(mercury::, m, ::do_unify__, n, _, a, _0),     \
 	MR_PASTE7(mercury::, m, ::do_compare__, n, _, a, _0))  
-
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(n, a, cr)       \
-    MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(builtin, n, a, cr,  \
-	mercury__unused_0_0,					\
-	mercury__unused_0_0)
-
 
 // Some definitions for writing code by hand that constructs lists.
 // Note that this is very dependent on the data representation chosen
Index: runtime/mercury_type_info.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.c,v
retrieving revision 1.54
diff -u -b -r1.54 mercury_type_info.c
--- runtime/mercury_type_info.c	21 Nov 2002 15:14:39 -0000	1.54
+++ runtime/mercury_type_info.c	8 Mar 2003 05:37:11 -0000
@@ -1,5 +1,5 @@
 /*
-** Copyright (C) 1995-2002 The University of Melbourne.
+** Copyright (C) 1995-2003 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.
 */
@@ -17,6 +17,7 @@
 #include "mercury_type_info.h"
 #include "mercury_misc.h"	/* for MR_fatal_error() */
 #include "mercury_heap.h"	/* for incr_saved_hp() */
+#include "mercury_builtin_types.h"	/* for void/0's type_ctor_info */
 
 /*---------------------------------------------------------------------------*/
 
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.99
diff -u -b -r1.99 mercury_type_info.h
--- runtime/mercury_type_info.h	26 Feb 2003 06:37:01 -0000	1.99
+++ runtime/mercury_type_info.h	8 Mar 2003 05:31:18 -0000
@@ -1061,9 +1061,7 @@
     MR_TypeFunctors     MR_type_ctor_functors;
     MR_TypeLayout       MR_type_ctor_layout;
     MR_int_least32_t    MR_type_ctor_num_functors;
-#ifdef  MR_TYPE_CTOR_INFO_HAS_FLAG
     MR_int_least16_t    MR_type_ctor_flags;
-#endif
 
 /*
 ** The following fields will be added later, once we can exploit them:
@@ -1096,10 +1094,34 @@
 /*
 ** The flag bits here must agree with the ones in encode_type_ctor_flag
 ** in compiler/rtti.m.
+**
+** The reserve tag flag is set iff the type constructor has reserved the
+** standard primary tag value for representing a variable.
+**
+** The variable arity flag is set for builting constructors whose arity is
+** variable: at moment, this means functions, predicates and tuples.
+**
+** The kind of du flag is set for all discriminated union types, even if
+** their representation is specialized (as enumerations, notag types, reserved
+** address types etc).
+**
+** The typeinfo fake arity flag is set for types whose arity *should* be zero,
+** but whose declared arity is one.
 */
 
+#define MR_TYPE_CTOR_FLAG_RESERVE_TAG           0x1
+#define MR_TYPE_CTOR_FLAG_VARIABLE_ARITY        0x2
+#define MR_TYPE_CTOR_FLAG_KIND_OF_DU            0x4
+#define MR_TYPE_CTOR_FLAG_TYPEINFO_FAKE_ARITY   0x8
+
 #define MR_type_ctor_has_reserve_tag(tci)                                   \
-    ((tci)->MR_type_ctor_flags & 0x1)
+    ((tci)->MR_type_ctor_flags & MR_TYPE_CTOR_FLAG_RESERVE_TAG)
+#define MR_type_ctor_has_variable_arity(tci)                                \
+    ((tci)->MR_type_ctor_flags & MR_TYPE_CTOR_FLAG_VARIABLE_ARITY)
+#define MR_type_ctor_is_kind_of_du(tci)                                     \
+    ((tci)->MR_type_ctor_flags & MR_TYPE_CTOR_FLAG_KIND_OF_DU)
+#define MR_type_ctor_is_typeinfo_fake_arity(tci)                            \
+    ((tci)->MR_type_ctor_flags & MR_TYPE_CTOR_FLAG_TYPEINFO_FAKE_ARITY)
 
 /*---------------------------------------------------------------------------*/
 
@@ -1149,12 +1171,6 @@
 ** structures for builtin and special types.
 */
 
-#ifdef  MR_TYPE_CTOR_INFO_HAS_FLAG
-  #define MR_INIT_TYPE_CTOR_FLAG    , 0
-#else
-  #define MR_INIT_TYPE_CTOR_FLAG
-#endif
-
 #ifdef MR_HIGHLEVEL_CODE
 
   #define MR_DEFINE_TYPE_CTOR_INFO_TYPE                                 \
@@ -1194,35 +1210,11 @@
     extern MR_PASTE2(MR_UnifyFunc_, a) u;                               \
     extern MR_PASTE2(MR_CompareFunc_, a) c;
 
-  #define MR_DEFINE_TYPE_CTOR_INFO_BODY(m, n, a, cr, u, c)              \
-    {                                                                   \
-        a,                                                              \
-        MR_RTTI_VERSION__COMPACT,                                       \
-        -1,                                                             \
-        MR_PASTE2(MR_TYPECTOR_REP_, cr),                                \
-        (MR_Box) u,                                                     \
-        (MR_Box) c,                                                     \
-        MR_STRINGIFY(m),                                                \
-        MR_STRINGIFY(n),                                                \
-        { 0 },                                                          \
-        { 0 },                                                          \
-        -1                                                              \
-        MR_INIT_TYPE_CTOR_FLAG                                          \
-    }
-
-  #define MR_DEFINE_TYPE_CTOR_INFO_FULL(m, n, a, cr, u, c)              \
-    MR_DEFINE_TYPE_CTOR_INFO_DECLARE_ADDRS(u, c, a)                     \
-    MR_DEFINE_TYPE_CTOR_INFO_TYPE                                       \
-    MR_TYPE_CTOR_INFO_NAME(m, n, a) =                                   \
-    MR_DEFINE_TYPE_CTOR_INFO_BODY(m, n, a, cr, u, c)
-
-  #define MR_DEFINE_TYPE_CTOR_INFO_PRED(m, n, a, cr, lu, lc, mu, mc)    \
-        MR_DEFINE_TYPE_CTOR_INFO_FULL(m, n, a, cr, mu, mc)
+  #define MR_DEFINE_TYPE_CTOR_INFO_CODE(p)                              \
+        (MR_Box) p
 
-  #define MR_DEFINE_TYPE_CTOR_INFO(m, n, a, cr)                         \
-    MR_DEFINE_TYPE_CTOR_INFO_FULL(m, n, a, cr,                          \
-        MR_TYPE_UNIFY_FUNC(m, n, a),                                    \
-        MR_TYPE_COMPARE_FUNC(m, n, a))                                  \
+  #define MR_DEFINE_TYPE_CTOR_INFO_STRING(s)                            \
+        MR_STRINGIFY(s)
 
 #else /* ! MR_HIGHLEVEL_CODE */
 
@@ -1245,44 +1237,15 @@
   #define MR_TYPE_COMPARE_FUNC(m, n, a)                                 \
     MR_PASTE7(mercury____Compare___, m, __, n, _, a, _0)
 
-  #define MR_DEFINE_TYPE_CTOR_INFO_DECLARE_ADDRS(u, c)                  \
+  #define MR_DEFINE_TYPE_CTOR_INFO_DECLARE_ADDRS(u, c, a)               \
     MR_declare_entry(u);                                                \
     MR_declare_entry(c);
 
-  #define MR_DEFINE_TYPE_CTOR_INFO_BODY(m, n, a, cr, u, c)              \
-    {                                                                   \
-        a,                                                              \
-        MR_RTTI_VERSION__REP,                                           \
-        -1,                                                             \
-        MR_PASTE2(MR_TYPECTOR_REP_, cr),                                \
-        MR_MAYBE_STATIC_CODE(MR_ENTRY(u)),                              \
-        MR_MAYBE_STATIC_CODE(MR_ENTRY(c)),                              \
-        MR_string_const(MR_STRINGIFY(m), sizeof(MR_STRINGIFY(m))-1),    \
-        MR_string_const(MR_STRINGIFY(n), sizeof(MR_STRINGIFY(n))-1),    \
-        { 0 },                                                          \
-        { 0 },                                                          \
-        -1                                                              \
-        MR_INIT_TYPE_CTOR_FLAG                                          \
-    }
+  #define MR_DEFINE_TYPE_CTOR_INFO_CODE(p)                              \
+        MR_MAYBE_STATIC_CODE(MR_ENTRY(p))
 
-  #define MR_DEFINE_TYPE_CTOR_INFO_FULL(m, n, a, cr, u, c)              \
-    MR_DEFINE_TYPE_CTOR_INFO_DECLARE_ADDRS(u, c)                        \
-    MR_DEFINE_TYPE_CTOR_INFO_TYPE                                       \
-    MR_TYPE_CTOR_INFO_NAME(m, n, a) =                                   \
-    MR_DEFINE_TYPE_CTOR_INFO_BODY(m, n, a, cr, u, c)
-
-  #define MR_DEFINE_TYPE_CTOR_INFO_PRED(m, n, a, cr, lu, lc, mu, mc)    \
-    MR_DEFINE_TYPE_CTOR_INFO_FULL(m, n, a, cr, lu, lc)
-
-  #define MR_DEFINE_TYPE_CTOR_INFO(m, n, a, cr)                         \
-    MR_DEFINE_TYPE_CTOR_INFO_FULL(m, n, a, cr,                          \
-        MR_TYPE_UNIFY_FUNC(m, n, a),                                    \
-        MR_TYPE_COMPARE_FUNC(m, n, a))                                  \
-
-  #define MR_DEFINE_TYPE_CTOR_INFO_UNUSED(m, n, a, cr)                  \
-    MR_DEFINE_TYPE_CTOR_INFO_FULL(m, m, n, a, cr,                       \
-        mercury__unused_0_0,                                            \
-        mercury__unused_0_0)
+  #define MR_DEFINE_TYPE_CTOR_INFO_STRING(s)                            \
+        MR_string_const(MR_STRINGIFY(s), sizeof(MR_STRINGIFY(s))-1)
 
   #define MR_UNIFY_COMPARE_DECLS(m, n, a)                               \
         MR_declare_entry(MR_TYPE_UNIFY_FUNC(m, n, a));                  \
@@ -1313,6 +1276,42 @@
   #endif /* MR_DEEP_PROFILING */
 
 #endif /* MR_HIGHLEVEL_CODE */
+
+#define MR_DEFINE_TYPE_CTOR_INFO_BODY_FLAG(m, n, a, cr, u, c, f)        \
+    {                                                                   \
+        a,                                                              \
+        MR_RTTI_VERSION__FLAG,                                          \
+        -1,                                                             \
+        MR_PASTE2(MR_TYPECTOR_REP_, cr),                                \
+        MR_DEFINE_TYPE_CTOR_INFO_CODE(u),                               \
+        MR_DEFINE_TYPE_CTOR_INFO_CODE(c),                               \
+        MR_DEFINE_TYPE_CTOR_INFO_STRING(m),                             \
+        MR_DEFINE_TYPE_CTOR_INFO_STRING(n),                             \
+        { 0 },                                                          \
+        { 0 },                                                          \
+        -1,                                                             \
+        f                                                               \
+    }
+
+#define MR_DEFINE_TYPE_CTOR_INFO_FULL_FLAG(m, n, a, cr, u, c, f)        \
+    MR_DEFINE_TYPE_CTOR_INFO_DECLARE_ADDRS(u, c, a)                     \
+    MR_DEFINE_TYPE_CTOR_INFO_TYPE                                       \
+    MR_TYPE_CTOR_INFO_NAME(m, n, a) =                                   \
+    MR_DEFINE_TYPE_CTOR_INFO_BODY_FLAG(m, n, a, cr, u, c, f)
+
+#define MR_DEFINE_TYPE_CTOR_INFO_FLAG(m, n, a, cr, f)                   \
+    MR_DEFINE_TYPE_CTOR_INFO_FULL_FLAG(m, n, a, cr,                     \
+        MR_TYPE_UNIFY_FUNC(m, n, a), MR_TYPE_COMPARE_FUNC(m, n, a), f)
+
+#define MR_DEFAULT_TYPE_CTOR_INFO_FLAG  0
+
+#define MR_DEFINE_TYPE_CTOR_INFO_FULL(m, n, a, cr, u, c)                \
+    MR_DEFINE_TYPE_CTOR_INFO_FULL_FLAG(m, n, a, cr, u, c,               \
+        MR_DEFAULT_TYPE_CTOR_INFO_FLAG)
+
+#define MR_DEFINE_TYPE_CTOR_INFO(m, n, a, cr)                           \
+    MR_DEFINE_TYPE_CTOR_INFO_FLAG(m, n, a, cr,                          \
+        MR_DEFAULT_TYPE_CTOR_INFO_FLAG)
 
 /*---------------------------------------------------------------------------*/
 
cvs diff: Diffing runtime/GETOPT
cvs diff: Diffing runtime/machdeps
cvs diff: Diffing samples
cvs diff: Diffing samples/c_interface
cvs diff: Diffing samples/c_interface/c_calls_mercury
cvs diff: Diffing samples/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/c_interface/mercury_calls_c
cvs diff: Diffing samples/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/diff
cvs diff: Diffing samples/muz
cvs diff: Diffing samples/rot13
cvs diff: Diffing samples/solutions
cvs diff: Diffing samples/tests
cvs diff: Diffing samples/tests/c_interface
cvs diff: Diffing samples/tests/c_interface/c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/cplusplus_calls_mercury
cvs diff: Diffing samples/tests/c_interface/mercury_calls_c
cvs diff: Diffing samples/tests/c_interface/mercury_calls_cplusplus
cvs diff: Diffing samples/tests/c_interface/mercury_calls_fortran
cvs diff: Diffing samples/tests/c_interface/simpler_c_calls_mercury
cvs diff: Diffing samples/tests/c_interface/simpler_cplusplus_calls_mercury
cvs diff: Diffing samples/tests/diff
cvs diff: Diffing samples/tests/muz
cvs diff: Diffing samples/tests/rot13
cvs diff: Diffing samples/tests/solutions
cvs diff: Diffing samples/tests/toplevel
cvs diff: Diffing scripts
cvs diff: Diffing tests
cvs diff: Diffing tests/benchmarks
cvs diff: Diffing tests/debugger
cvs diff: Diffing tests/debugger/declarative
Index: tests/debugger/declarative/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/debugger/declarative/Mmakefile,v
retrieving revision 1.55
diff -u -b -r1.55 Mmakefile
--- tests/debugger/declarative/Mmakefile	3 Feb 2003 05:19:31 -0000	1.55
+++ tests/debugger/declarative/Mmakefile	7 Mar 2003 07:53:09 -0000
@@ -31,6 +31,7 @@
 	input_term_dep		\
 	ite_2			\
 	lpe_example		\
+	mapinit			\
 	neg_conj		\
 	negation		\
 	oracle_db		\
@@ -197,6 +198,9 @@
 
 lpe_example.out: lpe_example lpe_example.inp
 	$(MDB) ./lpe_example < lpe_example.inp > lpe_example.out 2>&1
+
+mapinit.out: mapinit mapinit.inp
+	$(MDB) ./mapinit < mapinit.inp > mapinit.out 2>&1
 
 neg_conj.out: neg_conj neg_conj.inp
 	$(MDB) ./neg_conj < neg_conj.inp > neg_conj.out 2>&1
Index: tests/debugger/declarative/mapinit.exp
===================================================================
RCS file: tests/debugger/declarative/mapinit.exp
diff -N tests/debugger/declarative/mapinit.exp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/mapinit.exp	8 Mar 2003 13:45:41 -0000
@@ -0,0 +1,14 @@
+       1:      1  1 CALL pred mapinit.main/2-0 (det) mapinit.m:28
+mdb> echo on
+Command echo enabled.
+mdb> step
+       2:      2  2 CALL pred mapinit.xmap_init/1-0 (det) mapinit.m:37 (mapinit.m:29)
+mdb> finish
+       3:      2  2 EXIT pred mapinit.xmap_init/1-0 (det) mapinit.m:37 (mapinit.m:29)
+mdb> dd
+xmap_init(empty)
+Valid? y
+No bug found.
+       3:      2  2 EXIT pred mapinit.xmap_init/1-0 (det) mapinit.m:37 (mapinit.m:29)
+mdb> c
+two(0, "zero", empty, empty)
Index: tests/debugger/declarative/mapinit.exp2
===================================================================
RCS file: tests/debugger/declarative/mapinit.exp2
diff -N tests/debugger/declarative/mapinit.exp2
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/mapinit.exp2	8 Mar 2003 13:45:05 -0000
@@ -0,0 +1,14 @@
+       1:      1  1 CALL pred mapinit.main/2-0 (det) mapinit.m:28
+mdb> echo on
+Command echo enabled.
+mdb> step
+       2:      2  2 CALL pred mapinit.xmap_init/1-0 (det) mapinit.m:37 (mapinit.m:29)
+mdb> finish
+       5:      2  2 EXIT pred mapinit.xmap_init/1-0 (det) mapinit.m:37 (mapinit.m:29)
+mdb> dd
+xmap_init(empty)
+Valid? y
+No bug found.
+       5:      2  2 EXIT pred mapinit.xmap_init/1-0 (det) mapinit.m:37 (mapinit.m:29)
+mdb> c
+two(0, "zero", empty, empty)
Index: tests/debugger/declarative/mapinit.inp
===================================================================
RCS file: tests/debugger/declarative/mapinit.inp
diff -N tests/debugger/declarative/mapinit.inp
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/mapinit.inp	7 Mar 2003 07:53:06 -0000
@@ -0,0 +1,6 @@
+echo on
+step
+finish
+dd
+y
+c
Index: tests/debugger/declarative/mapinit.m
===================================================================
RCS file: tests/debugger/declarative/mapinit.m
diff -N tests/debugger/declarative/mapinit.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ tests/debugger/declarative/mapinit.m	7 Mar 2003 08:36:04 -0000
@@ -0,0 +1,42 @@
+% This is a regression test. The 17-Nov-2002 version of the compiler got
+% a runtime abort in the declarative debugger for the associated input script.
+% The bug occurred during the conversion to typeinfos of the pseudotypeinfos
+% describing xmap__init's two input arguments, TypeInfo_for_K and
+% TypeInfo_for_V.
+%
+% The problem was caused by the type private_builtin:typeinfo being declared
+% to have arity 1, when its true arity is variable, with the actual argument
+% values being unused by the runtime system. At the call event of xmap_init,
+% the types of the typeinfos include unbound type variables (K and V); the
+% runtime system tried to follow a NULL pointer when attempting to look up
+% the identities of the typeinfos bound to these type variables.
+
+:- module mapinit.
+
+:- interface.
+
+:- import_module io.
+
+:- pred main(io__state::di, io__state::uo) is det.
+
+:- implementation.
+
+:- import_module tree234.
+
+:- type xmap(K, V) == tree234(K, V).
+
+main -->
+	{ xmap_init(Init) }, 
+	{ xmap_set(Init, 0, "zero", Map) },
+	io__write(Map),
+	io__nl.
+
+:- pred xmap_init(xmap(K, V)::out) is det.
+
+xmap_init(Init) :-
+	tree234__init(Init).
+
+:- pred xmap_set(xmap(K, V)::in, K::in, V::in, xmap(K, V)::out) is det.
+
+xmap_set(Map0, Key, Value, Map) :-
+	tree234__set(Map0, Key, Value, Map).
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/string_format
cvs diff: Diffing tests/general/structure_reuse
cvs diff: Diffing tests/grade_subdirs
cvs diff: Diffing tests/hard_coded
cvs diff: Diffing tests/hard_coded/exceptions
cvs diff: Diffing tests/hard_coded/purity
cvs diff: Diffing tests/hard_coded/sub-modules
cvs diff: Diffing tests/hard_coded/typeclasses
cvs diff: Diffing tests/invalid
cvs diff: Diffing tests/invalid/purity
cvs diff: Diffing tests/misc_tests
cvs diff: Diffing tests/mmc_make
cvs diff: Diffing tests/mmc_make/lib
cvs diff: Diffing tests/recompilation
cvs diff: Diffing tests/tabling
cvs diff: Diffing tests/term
cvs diff: Diffing tests/valid
cvs diff: Diffing tests/warnings
cvs diff: Diffing tools
cvs diff: Diffing trace
cvs diff: Diffing util
cvs diff: Diffing vim
cvs diff: Diffing vim/after
cvs diff: Diffing vim/ftplugin
cvs diff: Diffing vim/syntax
--------------------------------------------------------------------------
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