[m-rev.] for review: RTTI/unify/compare for builtin types in the runtime
Zoltan Somogyi
zs at cs.mu.OZ.AU
Wed Aug 7 17:55:23 AEST 2002
For review by Fergus.
Harmonize the treatment of the builtin types by the runtime system across
the MLDS and LLDS C backends. (Their treatment by the .NET and Java backends
is unchanged, at least for now.)
Previously, the RTTI data structures and unify and compare predicates for the
builtin types were defined in runtime/mercury.c for the MLDS backend but in
library/{builtin,private_builtin,type_desc}.m for the LLDS backend. This
make several kinds of maintenance difficult, and more likely to be forgotten.
The two backends also had their generic unify/compare code in different modules
(mercury.c and mercuy_ho_call.c) and used distinct macros for defining RTTI
data structures. This change fixes those problems by defining a consistent
set of macros (with backend-specific implementations but backend-independent
semantics), concentrating the definitions of all the RTTI structures and of all
the unify and compare predicates for builtin types in a new module in the
runtime, mercury_builtin_types.[ch], and concentrating all the generic
unify/compare predicates in mercury_ho_call.[ch].
This change also makes the runtime use consistently module qualified names
for the RTTI data structures for the builtin types. Since they are not module
qualified by the Mercury compiler, we module qualify them by macros that map
the mmc-generated names to the ones expected by the runtime system. This makes
it easier to use the same macros in LLDS and MLDS grades.
runtime/mercury_builtin_types.[ch]:
New module to contain all the C code for the implementation of
unify and compare predicates for the builtin types. Its contents
comes from mercury.c in the runtime (for the MLDS C backend) and
builtin.m, private_builtin.m and type_desc.m in the library (for the
LLDS C backend).
The unify/compare predicates for tuples now report errors. This is
necessary because the tuple is a variable arity constructor. Their
previous implementations for the MLDS backend relied on only being
called from the generic unify/compare routines with a nonstandard
interface, being passed a typeinfo for the tuple type, rather than
the typeinfos for the arguments of the type constructor. This worked
because we don't currently specialize unifies/compares of tuple types,
but was a potential problem if we ever started to do such
specialization. The fix is to handle tuples in the generic
unify/compare routines, just as in the LLDS backend.
runtime/mercury_ho_call.c:
Move the generic unify/compare routines for the MLDS backend here
from mercury.c.
Conform to the coding standard wrt indentation.
runtime/mercury_ho_call.h:
Declare the generic unify/compare routines for both backends.
Delete a typedef that now needs to be in mercury_types.h to avoid
circular dependencies.
runtime/mercury_type_info.h:
Use the same macros for defining type_ctor_info structures for the MLDS
and LLDS backends.
This required moving the definitions of MR_UnifyFunc_N and
MR_CompareFunc_N here from mercury.c.
runtime/mercury_hlc_types.h:
A new file containing definitions of types needed by the MLDS C
backend. These definitions used to be in mercury.h, but now they are
needed in mercury_type_info.h, a header file that doesn't and shouldn't
include mercury.h. They can't easily be put in mercury_types.h because
they depend on mercury_std.h, and we are not allowed to include
mercury_std.h in mercury_types.h.
runtime/mercury.h:
Delete the definitions of the C types representing type_info and
pseudo_type_infos, since these are now in mercury_type_info.h.
#include mercury_type_info.h.
Delete the definitions now in mercury_hlc_types.h.
runtime/mercury.c:
Delete the definitions of the C types representing unify and compare
predicates, since these are now in mercury_ho_call.h. XXX
runtime/mercury_bootstrap.h:
Module qualify the RTTI data structures of the builtin types, since
it makes it easier to use the same macros to define RTTI structures
in the LLDS and MLDS backend. (Previously, mercury_bootstrap.h had
macros to delete such module qualification for the variable arity
types.)
runtime/mercury_types.h:
Move some type definitions from XXX
to mercury_types.h to prevent problems with circular dependencies
between header files.
runtime/mercury_debug.h:
Delete a #include to prevent a circular dependency.
runtime/mercury_profiling_builtin.[ch]:
A new module containing the {call,exit,redo,fail} port predicates
for deep profiling, moved here from library/profiling_builtin.m.
They are referred to by the implementations of the unify and compare
predicates of builtin types, and thus they need to be in the runtime
directory to avoid references from the runtime to the library.
runtime/Mmakefile:
Add the new files.
tools/make_port_code:
A script to generate runtime/mercury_profiling_builtin.[ch] fully
automatically.
library/array.m:
Use the new backend-independent macros to reduce the amount of code
that was duplicated for the two backends.
library/builtin.m:
library/private_builtin.m:
library/type_desc.m:
Delete RTTI structures and unify and compare predicates
that are now in runtime/mercury_builtin_types.c.
library/profiling_builtin.m:
Replace the definitions of the predicates implementing the
{call,exit,redo,fail} port predicates with external declarations.
trace/mercury_trace_vars.c:
Use a now backend-independent macro to refer to a type_ctor_info.
trace/Mmakefile:
Do not define MERCURY_BOOTSTRAP_H, since mercury_bootstrap.h now
contains some definitions needed by code in the trace directory.
util/mkinit.c:
Module qualify the references to the RTTI structures of builtin types,
since the generated _init.c files don't include mercury_bootstrap.h.
Note that after this change has bootstrapped, we should be able to
delete those references, since they were only needed to give the
runtime access to the addresses of RTTI structures that used to be
defined in the library, but are now defined in the runtime.
cvs diff: Diffing .
cvs diff: Diffing bench
cvs diff: Diffing bench/progs
cvs diff: Diffing bench/progs/compress
cvs diff: Diffing bench/progs/icfp2000
cvs diff: Diffing bench/progs/icfp2001
cvs diff: Diffing bench/progs/nuc
cvs diff: Diffing bench/progs/ray
cvs diff: Diffing bench/progs/tree234
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
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/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
Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.110
diff -u -b -r1.110 array.m
--- library/array.m 2002/07/23 08:26:22 1.110
+++ library/array.m 2002/07/26 16:51:25
@@ -425,14 +425,17 @@
#include ""mercury_deep_profiling_hand.h""
-#ifdef MR_HIGHLEVEL_CODE
+
+#ifdef MR_DEEP_PROFILING
+MR_proc_static_compiler_plain(array, __Unify__, array, 1, 0,
+ array, array_equal, 2, 0, ""array.m"", 99, MR_TRUE);
+MR_proc_static_compiler_plain(array, __Compare__, array, 1, 0,
+ array, array_compare, 3, 0, ""array.m"", 99, MR_TRUE);
+#endif
-MR_define_type_ctor_info(array, array, 1, MR_TYPECTOR_REP_ARRAY);
+MR_DEFINE_TYPE_CTOR_INFO(array, array, 1, ARRAY);
-/* forward decl, to suppress gcc -Wmissing-decl warning */
-void sys_init_array_module_builtins(void);
-void sys_init_array_module_builtins_init(void);
-void sys_init_array_module_builtins_init_type_tables(void);
+#ifdef MR_HIGHLEVEL_CODE
MR_bool MR_CALL
mercury__array__do_unify__array_1_0(MR_Mercury_Type_Info type_info,
@@ -468,15 +471,6 @@
#else
-#ifdef MR_DEEP_PROFILING
-MR_proc_static_compiler_plain(array, __Unify__, array, 1, 0,
- array, array_equal, 2, 0, ""array.m"", 99, MR_TRUE);
-MR_proc_static_compiler_plain(array, __Compare__, array, 1, 0,
- array, array_compare, 3, 0, ""array.m"", 99, MR_TRUE);
-#endif
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(array, array, 1, MR_TYPECTOR_REP_ARRAY);
-
MR_declare_entry(mercury__array__array_equal_2_0);
MR_declare_entry(mercury__array__array_compare_3_0);
@@ -556,6 +550,10 @@
MR_END_MODULE
+MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc array_module_builtins;
+
+#endif /* ! MR_HIGHLEVEL_CODE */
+
/* Ensure that the initialization code for the above module gets run. */
/*
INIT sys_init_array_module_builtins
@@ -567,10 +565,6 @@
#ifdef MR_DEEP_PROFILING
void sys_init_array_module_builtins_write_out_proc_statics(FILE *fp);
#endif
-
-MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc array_module_builtins;
-
-#endif /* ! MR_HIGHLEVEL_CODE */
void
sys_init_array_module_builtins_init(void)
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.77
diff -u -b -r1.77 builtin.m
--- library/builtin.m 2002/08/05 02:46:08 1.77
+++ library/builtin.m 2002/08/06 00:55:42
@@ -314,157 +314,6 @@
:- pragma foreign_decl("C", "#include ""mercury_type_info.h""").
-:- pragma foreign_code("C", "
-
-/* forward decls, to suppress gcc -Wmissing-decl warning */
-void sys_init_builtin_types_module_init(void);
-void sys_init_builtin_types_module_init_type_tables(void);
-#ifdef MR_DEEP_PROFILING
-void sys_init_builtin_types_module_write_out_proc_statics(FILE *fp);
-#endif
-
-#ifndef MR_HIGHLEVEL_CODE
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(builtin, int, 0,
- MR_TYPECTOR_REP_INT,
- mercury__builtin_unify_int_2_0,
- mercury__builtin_compare_int_3_0);
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(builtin, character, 0,
- MR_TYPECTOR_REP_CHAR,
- mercury__builtin_unify_character_2_0,
- mercury__builtin_compare_character_3_0);
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(builtin, string, 0,
- MR_TYPECTOR_REP_STRING,
- mercury__builtin_unify_string_2_0,
- mercury__builtin_compare_string_3_0);
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(builtin, float, 0,
- MR_TYPECTOR_REP_FLOAT,
- mercury__builtin_unify_float_2_0,
- mercury__builtin_compare_float_3_0);
-
- /*
- ** One of the following two is used for all higher-order types.
- ** Note that they use the same unify and compare predicates.
- */
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(builtin, func, 0,
- MR_TYPECTOR_REP_FUNC,
- mercury__builtin_unify_pred_2_0,
- mercury__builtin_compare_pred_3_0);
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(builtin, pred, 0,
- MR_TYPECTOR_REP_PRED,
- mercury__builtin_unify_pred_2_0,
- mercury__builtin_compare_pred_3_0);
-
- /*
- ** All tuple types use the following type_ctor_info.
- */
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(builtin, tuple, 0,
- MR_TYPECTOR_REP_TUPLE,
- mercury__builtin_unify_tuple_2_0,
- mercury__builtin_compare_tuple_3_0);
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(void, 0, MR_TYPECTOR_REP_VOID);
-
-#ifdef MR_NATIVE_GC
-
-/*
-** The following type_ctor_infos are used only by accurate gc.
-*/
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(succip, 0, MR_TYPECTOR_REP_SUCCIP);
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(hp, 0, MR_TYPECTOR_REP_HP);
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(curfr, 0, MR_TYPECTOR_REP_CURFR);
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(maxfr, 0, MR_TYPECTOR_REP_MAXFR);
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(redofr, 0, MR_TYPECTOR_REP_REDOFR);
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(redoip, 0, MR_TYPECTOR_REP_REDOIP);
-
-#endif /* MR_NATIVE_GC */
-
-/*
-** The following type_ctor_infos are used both accurate gc and by the debugger.
-*/
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(trailptr, 0, MR_TYPECTOR_REP_TRAIL_PTR);
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_UNUSED(ticket, 0, MR_TYPECTOR_REP_TICKET);
-
-/*
-INIT sys_init_builtin_types_module
-*/
-MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc builtin_types_module;
-extern void mercury__private_builtin__init(void);
-
-#endif /* ! HIGHLEVEL_CODE */
-
-void
-sys_init_builtin_types_module_init(void)
-{
-#ifndef MR_HIGHLEVEL_CODE
- /*
- ** We had better call this init() because we use the
- ** labels for the special preds of int, float, pred,
- ** character and string. If they aren't initialized,
- ** we might initialize the type_ctor_info with
- ** garbage.
- */
- mercury__private_builtin__init();
-
- MR_INIT_BUILTIN_TYPE_CTOR_INFO(
- mercury_data___type_ctor_info_int_0, _int_);
- MR_INIT_BUILTIN_TYPE_CTOR_INFO(
- mercury_data___type_ctor_info_float_0, _float_);
- MR_INIT_BUILTIN_TYPE_CTOR_INFO(
- mercury_data___type_ctor_info_character_0, _character_);
- MR_INIT_BUILTIN_TYPE_CTOR_INFO(
- mercury_data___type_ctor_info_string_0, _string_);
- MR_INIT_BUILTIN_TYPE_CTOR_INFO(
- mercury_data___type_ctor_info_pred_0, _pred_);
- MR_INIT_BUILTIN_TYPE_CTOR_INFO(
- mercury_data___type_ctor_info_func_0, _pred_);
- MR_INIT_BUILTIN_TYPE_CTOR_INFO(
- mercury_data___type_ctor_info_tuple_0, _tuple_);
- MR_INIT_TYPE_CTOR_INFO_WITH_PRED(
- mercury_data___type_ctor_info_void_0, mercury__unused_0_0);
-#endif
-}
-
-void
-sys_init_builtin_types_module_init_type_tables(void)
-{
-#ifndef MR_HIGHLEVEL_CODE
- MR_register_type_ctor_info(
- &mercury_data___type_ctor_info_int_0);
- MR_register_type_ctor_info(
- &mercury_data___type_ctor_info_float_0);
- MR_register_type_ctor_info(
- &mercury_data___type_ctor_info_character_0);
- MR_register_type_ctor_info(
- &mercury_data___type_ctor_info_string_0);
- MR_register_type_ctor_info(
- &mercury_data___type_ctor_info_pred_0);
- MR_register_type_ctor_info(
- &mercury_data___type_ctor_info_func_0);
- MR_register_type_ctor_info(
- &mercury_data___type_ctor_info_tuple_0);
- MR_register_type_ctor_info(
- &mercury_data___type_ctor_info_void_0);
-#endif
-}
-
-#ifdef MR_DEEP_PROFILING
-void
-sys_init_builtin_types_module_write_out_proc_statics(FILE *fp)
-{
- /* no proc_statics to write out */
-}
-#endif
-
-").
-
-
:- interface.
:- pred call_rtti_generic_unify(T::in, T::in) is semidet.
:- pred call_rtti_generic_compare(comparison_result::out, T::in, T::in) is det.
@@ -852,7 +701,6 @@
""called compare/3 for tuple type"");
}
-
").
%-----------------------------------------------------------------------------%
@@ -1045,133 +893,6 @@
&mercury_data__proc_static__mercury__copy_2_0);
MR_write_out_proc_static(fp, (MR_ProcStatic *)
&mercury_data__proc_static__mercury__copy_2_1);
-}
-#endif
-
-").
-
-%-----------------------------------------------------------------------------%
-
-% The type c_pointer can be used by predicates which use the C interface.
-
-:- pragma foreign_code("C", "
-
-#include ""mercury_deep_profiling_hand.h""
-
-/* Ensure that the initialization code for the above module gets run. */
-/*
-INIT sys_init_c_pointer_module
-*/
-
-/* duplicate declarations to suppress gcc -Wmissing-decl warning */
-void sys_init_c_pointer_module_init(void);
-void sys_init_c_pointer_module_init_type_tables(void);
-#ifdef MR_DEEP_PROFILING
-void sys_init_c_pointer_module_write_out_proc_statics(FILE *fp);
-#endif
-
-#ifndef MR_HIGHLEVEL_CODE
-
-#ifdef MR_DEEP_PROFILING
-MR_proc_static_compiler_empty(builtin, __Unify__, c_pointer,
- 0, 0, ""builtin.m"", 0, MR_TRUE);
-MR_proc_static_compiler_empty(builtin, __Compare__, c_pointer,
- 0, 0, ""builtin.m"", 0, MR_TRUE);
-#endif
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(builtin, c_pointer, 0,
- MR_TYPECTOR_REP_C_POINTER,
- mercury____Unify___builtin__c_pointer_0_0,
- mercury____Compare___builtin__c_pointer_0_0);
-
-MR_declare_entry(mercury____Unify___builtin__c_pointer_0_0);
-MR_declare_entry(mercury____Index___builtin__c_pointer_0_0);
-MR_declare_entry(mercury____Compare___builtin__c_pointer_0_0);
-
-MR_BEGIN_MODULE(c_pointer_module)
- MR_init_entry(mercury____Unify___builtin__c_pointer_0_0);
- MR_init_entry(mercury____Compare___builtin__c_pointer_0_0);
-#ifdef MR_DEEP_PROFILING
- MR_init_label(mercury____Unify___builtin__c_pointer_0_0_i1);
- MR_init_label(mercury____Unify___builtin__c_pointer_0_0_i2);
- MR_init_label(mercury____Unify___builtin__c_pointer_0_0_i3);
- MR_init_label(mercury____Unify___builtin__c_pointer_0_0_i4);
- MR_init_label(mercury____Compare___builtin__c_pointer_0_0_i1);
- MR_init_label(mercury____Compare___builtin__c_pointer_0_0_i2);
-#endif
-MR_BEGIN_CODE
-
- /*
- ** For c_pointer, we assume that equality and comparison
- ** can be based on object identity (i.e. using address comparisons).
- ** This is correct for types like io__stream, and necessary since
- ** the io__state contains a map(io__stream, filename).
- ** However, it might not be correct in general...
- */
-
-#define proc_label mercury____Unify___builtin__c_pointer_0_0
-#define proc_static MR_proc_static_compiler_name(builtin, __Unify__, \
- c_pointer, 0, 0)
-#define body_code do { MR_r1 = (MR_r1 == MR_r2); } while(0)
-
-#include ""mercury_hand_unify_body.h""
-
-#undef body_code
-#undef proc_static
-#undef proc_label
-
-#define proc_label mercury____Compare___builtin__c_pointer_0_0
-#define proc_static MR_proc_static_compiler_name(builtin, __Compare__, \
- c_pointer, 0, 0)
-#define body_code do { \
- MR_r1 = (MR_r1 == MR_r2 ? MR_COMPARE_EQUAL : \
- MR_r1 < MR_r2 ? MR_COMPARE_LESS : \
- MR_COMPARE_GREATER); \
- } while (0)
-
-#include ""mercury_hand_compare_body.h""
-
-#undef body_code
-#undef proc_static
-#undef proc_label
-
-MR_END_MODULE
-
-MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc c_pointer_module;
-
-#endif /* ! MR_HIGHLEVEL_CODE */
-
-void
-sys_init_c_pointer_module_init(void)
-{
-#ifndef MR_HIGHLEVEL_CODE
- c_pointer_module();
-
- MR_INIT_TYPE_CTOR_INFO(
- mercury_data_builtin__type_ctor_info_c_pointer_0,
- builtin__c_pointer_0_0);
-#endif
-}
-
-void
-sys_init_c_pointer_module_init_type_tables(void)
-{
-#ifndef MR_HIGHLEVEL_CODE
- MR_register_type_ctor_info(
- &mercury_data_builtin__type_ctor_info_c_pointer_0);
-#endif
-}
-
-#ifdef MR_DEEP_PROFILING
-void
-sys_init_c_pointer_module_write_out_proc_statics(FILE *fp)
-{
- MR_write_out_proc_static(fp, (MR_ProcStatic *)
- &MR_proc_static_compiler_name(builtin, __Unify__, c_pointer,
- 0, 0));
- MR_write_out_proc_static(fp, (MR_ProcStatic *)
- &MR_proc_static_compiler_name(builtin, __Compare__, c_pointer,
- 0, 0));
}
#endif
Index: library/private_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/private_builtin.m,v
retrieving revision 1.107
diff -u -b -r1.107 private_builtin.m
--- library/private_builtin.m 2002/08/07 03:18:49 1.107
+++ library/private_builtin.m 2002/08/07 03:42:24
@@ -12,8 +12,8 @@
% module. It is intended for builtins that are just implementation details,
% such as procedures that the compiler generates implicit calls to when
% implementing polymorphism, unification, compare/3, etc.
-% Note that the builtins used for tabling are in a separate module
-% (table_builtin.m).
+% Note that the builtins used for tabling and deep profiling are in separate
+% modules (table_builtin.m and profiling_builtin.m).
% This module is a private part of the Mercury implementation;
% user modules should never explicitly import this module.
@@ -262,7 +262,6 @@
R = R0
).
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -348,215 +347,14 @@
:- implementation.
% The definitions for type_ctor_info/1 and type_info/1.
-
-:- pragma c_header_code("
-#ifdef MR_DEEP_PROFILING
-#include ""mercury_deep_profiling.h""
-#endif
-").
-
-:- pragma foreign_code("C", "
-/* forward decls, to suppress gcc -Wmissing-decl warnings */
-void sys_init_type_info_module_init(void);
-void sys_init_type_info_module_init_type_tables(void);
-#ifdef MR_DEEP_PROFILING
-void sys_init_type_info_module_write_out_proc_statics(FILE *fp);
-#endif
-
-#ifndef MR_HIGHLEVEL_CODE
+ % XXX probably redundant
+% :- pragma c_header_code("
+% #ifdef MR_DEEP_PROFILING
+% #include ""mercury_deep_profiling.h""
+% #endif
+% ").
- /*
- ** For most purposes, type_ctor_info can be treated just like
- ** type_info. The code that handles type_infos can also handle
- ** type_ctor_infos.
- */
-
-#ifdef MR_DEEP_PROFILING
-MR_proc_static_compiler_empty(private_builtin, __Unify__, type_info,
- 1, 0, ""private_builtin.m"", 0, MR_TRUE);
-MR_proc_static_compiler_empty(private_builtin, __Compare__, type_info,
- 1, 0, ""private_builtin.m"", 0, MR_TRUE);
-MR_proc_static_compiler_empty(private_builtin, __Unify__, typeclass_info,
- 1, 0, ""private_builtin.m"", 0, MR_TRUE);
-MR_proc_static_compiler_empty(private_builtin, __Compare__, typeclass_info,
- 1, 0, ""private_builtin.m"", 0, MR_TRUE);
-#endif
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(private_builtin, type_ctor_info, 1,
- MR_TYPECTOR_REP_TYPECTORINFO,
- mercury____Unify___private_builtin__type_info_1_0,
- mercury____Compare___private_builtin__type_info_1_0);
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, type_info, 1,
- MR_TYPECTOR_REP_TYPEINFO);
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(private_builtin, base_typeclass_info, 1,
- MR_TYPECTOR_REP_BASETYPECLASSINFO,
- mercury____Unify___private_builtin__typeclass_info_1_0,
- mercury____Compare___private_builtin__typeclass_info_1_0);
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(private_builtin, typeclass_info, 1,
- MR_TYPECTOR_REP_TYPECLASSINFO);
-
-MR_define_extern_entry(mercury____Unify___private_builtin__type_info_1_0);
-MR_define_extern_entry(mercury____Compare___private_builtin__type_info_1_0);
-MR_define_extern_entry(mercury____Unify___private_builtin__typeclass_info_1_0);
-MR_define_extern_entry(mercury____Compare___private_builtin__typeclass_info_1_0);
-
-MR_BEGIN_MODULE(type_info_module)
- MR_init_entry(mercury____Unify___private_builtin__type_info_1_0);
- MR_init_entry(mercury____Compare___private_builtin__type_info_1_0);
- MR_init_entry(mercury____Unify___private_builtin__typeclass_info_1_0);
- MR_init_entry(mercury____Compare___private_builtin__typeclass_info_1_0);
-#ifdef MR_DEEP_PROFILING
- MR_init_label(mercury____Unify___private_builtin__type_info_1_0_i1);
- MR_init_label(mercury____Unify___private_builtin__type_info_1_0_i2);
- MR_init_label(mercury____Unify___private_builtin__type_info_1_0_i3);
- MR_init_label(mercury____Unify___private_builtin__type_info_1_0_i4);
- MR_init_label(mercury____Compare___private_builtin__type_info_1_0_i1);
- MR_init_label(mercury____Compare___private_builtin__type_info_1_0_i2);
- MR_init_label(mercury____Unify___private_builtin__typeclass_info_1_0_i1);
- MR_init_label(mercury____Unify___private_builtin__typeclass_info_1_0_i2);
- MR_init_label(mercury____Unify___private_builtin__typeclass_info_1_0_i3);
- MR_init_label(mercury____Unify___private_builtin__typeclass_info_1_0_i4);
- MR_init_label(mercury____Compare___private_builtin__typeclass_info_1_0_i1);
- MR_init_label(mercury____Compare___private_builtin__typeclass_info_1_0_i2);
-#endif
-MR_BEGIN_CODE
-
-#define proc_label mercury____Unify___private_builtin__type_info_1_0
-#define proc_static MR_proc_static_compiler_name(private_builtin, \
- __Unify__, type_info, 1, 0)
-#define body_code do { \
- int comp; \
- \
- MR_save_transient_registers(); \
- comp = MR_compare_type_info( \
- (MR_TypeInfo) MR_r1, \
- (MR_TypeInfo) MR_r2); \
- MR_restore_transient_registers(); \
- MR_r1 = (comp == MR_COMPARE_EQUAL); \
- } while (0)
-
-#include ""mercury_hand_unify_body.h""
-
-#undef proc_label
-#undef proc_static
-#undef body_code
-
-#define proc_label mercury____Compare___private_builtin__type_info_1_0
-#define proc_static MR_proc_static_compiler_name(private_builtin, \
- __Compare__, type_info, 1, 0)
-#define body_code do { \
- int comp; \
- \
- MR_save_transient_registers(); \
- comp = MR_compare_type_info( \
- (MR_TypeInfo) MR_r1, \
- (MR_TypeInfo) MR_r2); \
- MR_restore_transient_registers(); \
- MR_r1 = comp; \
- } while (0)
-
-#include ""mercury_hand_compare_body.h""
-
-#undef proc_label
-#undef proc_static
-#undef body_code
-
-#define proc_label mercury____Unify___private_builtin__typeclass_info_1_0
-#define proc_static MR_proc_static_compiler_name(private_builtin, \
- __Unify__, typeclass_info, 1, 0)
-#define body_code do { \
- MR_fatal_error(""attempt to unify typeclass_info""); \
- } while (0)
-
-#include ""mercury_hand_unify_body.h""
-
-#undef proc_label
-#undef proc_static
-#undef body_code
-
-#define proc_label mercury____Compare___private_builtin__typeclass_info_1_0
-#define proc_static MR_proc_static_compiler_name(private_builtin, \
- __Compare__, typeclass_info, 1, 0)
-#define body_code do { \
- MR_fatal_error(""attempt to compare typeclass_info""); \
- } while (0)
-
-#include ""mercury_hand_compare_body.h""
-
-#undef proc_label
-#undef proc_static
-#undef body_code
-
-MR_END_MODULE
-
-/* Ensure that the initialization code for the above module gets run. */
-/*
-INIT sys_init_type_info_module
-*/
-MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc type_info_module;
-
-#endif /* ! MR_HIGHLEVEL_CODE */
-
-void
-sys_init_type_info_module_init(void)
-{
-#ifndef MR_HIGHLEVEL_CODE
- type_info_module();
-
- MR_INIT_TYPE_CTOR_INFO(
- mercury_data_private_builtin__type_ctor_info_type_ctor_info_1,
- private_builtin__type_info_1_0);
- MR_INIT_TYPE_CTOR_INFO(
- mercury_data_private_builtin__type_ctor_info_type_info_1,
- private_builtin__type_info_1_0);
- MR_INIT_TYPE_CTOR_INFO(
- mercury_data_private_builtin__type_ctor_info_base_typeclass_info_1,
- private_builtin__typeclass_info_1_0);
- MR_INIT_TYPE_CTOR_INFO(
- mercury_data_private_builtin__type_ctor_info_typeclass_info_1,
- private_builtin__typeclass_info_1_0);
-#endif
-}
-
-void
-sys_init_type_info_module_init_type_tables(void)
-{
-#ifndef MR_HIGHLEVEL_CODE
- MR_register_type_ctor_info(
- &mercury_data_private_builtin__type_ctor_info_type_ctor_info_1);
- MR_register_type_ctor_info(
- &mercury_data_private_builtin__type_ctor_info_type_info_1);
- MR_register_type_ctor_info(
- &mercury_data_private_builtin__type_ctor_info_base_typeclass_info_1);
- MR_register_type_ctor_info(
- &mercury_data_private_builtin__type_ctor_info_typeclass_info_1);
-#endif
-}
-
-#ifdef MR_DEEP_PROFILING
-void
-sys_init_type_info_module_write_out_proc_statics(FILE *fp)
-{
- MR_write_out_proc_static(fp, (MR_ProcStatic *)
- &MR_proc_static_compiler_name(private_builtin,
- __Unify__, type_info, 1, 0));
- MR_write_out_proc_static(fp, (MR_ProcStatic *)
- &MR_proc_static_compiler_name(private_builtin,
- __Compare__, type_info, 1, 0));
- MR_write_out_proc_static(fp, (MR_ProcStatic *)
- &MR_proc_static_compiler_name(private_builtin,
- __Unify__, typeclass_info, 1, 0));
- MR_write_out_proc_static(fp, (MR_ProcStatic *)
- &MR_proc_static_compiler_name(private_builtin,
- __Compare__, typeclass_info, 1, 0));
-}
-#endif
-
-").
-
-
:- pragma foreign_code("MC++", "
static MR_TypeInfo MR_typeclass_info_type_info(
@@ -663,7 +461,6 @@
static int MR_SECTAG_REMOTE = 2;
static int MR_SECTAG_VARIABLE = 3;
-
static int
__Unify____type_info_1_0(
MR_Word type_info, MR_Word x, MR_Word y)
@@ -902,7 +699,6 @@
% matching foreign_proc version.
sorry("instance_constraint_from_typeclass_info").
-
%-----------------------------------------------------------------------------%
% This section of the module contains predicates that are used
@@ -1113,7 +909,6 @@
#endif
").
-
trailed_nondet_pragma_foreign_code :-
Msg = string__append_list([
"Sorry, not implemented:\n",
@@ -1279,123 +1074,9 @@
error(Msg).
%-----------------------------------------------------------------------------%
-
-% Code to define the `heap_pointer' type for the LLDS and .NET back-ends.
-% (For the MLDS->C back-end, this type is defined in runtime/mercury.c.)
-
-:- pragma foreign_code("C", "
-
-#include ""mercury_deep_profiling_hand.h""
-
-/* Ensure that the initialization code for the module below gets run. */
-/*
-INIT sys_init_heap_pointer_module
-*/
-
-/* duplicate declarations to suppress gcc -Wmissing-decl warning */
-void sys_init_heap_pointer_module_init(void);
-void sys_init_heap_pointer_module_init_type_tables(void);
-#ifdef MR_DEEP_PROFILING
-void sys_init_heap_pointer_module_write_out_proc_statics(FILE *fp);
-#endif
-
-#ifndef MR_HIGHLEVEL_CODE
-
-#ifdef MR_DEEP_PROFILING
-MR_proc_static_compiler_empty(private_builtin, __Unify__, heap_pointer,
- 0, 0, ""private_builtin.m"", 0, MR_TRUE);
-MR_proc_static_compiler_empty(private_builtin, __Compare__, heap_pointer,
- 0, 0, ""private_builtin.m"", 0, MR_TRUE);
-#endif
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(private_builtin, heap_pointer, 0,
- MR_TYPECTOR_REP_HP,
- mercury____Unify___private_builtin__heap_pointer_0_0,
- mercury____Compare___private_builtin__heap_pointer_0_0);
-
-MR_declare_entry(mercury____Unify___private_builtin__heap_pointer_0_0);
-MR_declare_entry(mercury____Index___private_builtin__heap_pointer_0_0);
-MR_declare_entry(mercury____Compare___private_builtin__heap_pointer_0_0);
-
-MR_BEGIN_MODULE(heap_pointer_module)
- MR_init_entry(mercury____Unify___private_builtin__heap_pointer_0_0);
- MR_init_entry(mercury____Compare___private_builtin__heap_pointer_0_0);
-#ifdef MR_DEEP_PROFILING
- MR_init_label(mercury____Unify___private_builtin__heap_pointer_0_0_i1);
- MR_init_label(mercury____Unify___private_builtin__heap_pointer_0_0_i2);
- MR_init_label(mercury____Unify___private_builtin__heap_pointer_0_0_i3);
- MR_init_label(mercury____Unify___private_builtin__heap_pointer_0_0_i4);
- MR_init_label(mercury____Compare___private_builtin__heap_pointer_0_0_i1);
- MR_init_label(mercury____Compare___private_builtin__heap_pointer_0_0_i2);
-#endif
-MR_BEGIN_CODE
-
-#define proc_label mercury____Unify___private_builtin__heap_pointer_0_0
-#define proc_static MR_proc_static_compiler_name(private_builtin, \
- __Unify__, heap_pointer, 0, 0)
-#define body_code MR_fatal_error( \
- ""called unify for type `private_builtin:heap_pointer'"")
-
-#include ""mercury_hand_unify_body.h""
-
-#undef body_code
-#undef proc_static
-#undef proc_label
-
-#define proc_label mercury____Compare___private_builtin__heap_pointer_0_0
-#define proc_static MR_proc_static_compiler_name(private_builtin, \
- __Compare__, heap_pointer, 0, 0)
-#define body_code MR_fatal_error( \
- ""called compare/3 for type `private_builtin:heap_pointer'"")
-
-#include ""mercury_hand_compare_body.h""
-
-#undef body_code
-#undef proc_static
-#undef proc_label
-
-MR_END_MODULE
-
-MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc heap_pointer_module;
-
-#endif /* ! MR_HIGHLEVEL_CODE */
-
-void
-sys_init_heap_pointer_module_init(void)
-{
-#ifndef MR_HIGHLEVEL_CODE
- heap_pointer_module();
-
- MR_INIT_TYPE_CTOR_INFO(
- mercury_data_private_builtin__type_ctor_info_heap_pointer_0,
- private_builtin__heap_pointer_0_0);
-#endif
-}
-
-void
-sys_init_heap_pointer_module_init_type_tables(void)
-{
-#ifndef MR_HIGHLEVEL_CODE
- MR_register_type_ctor_info(
- &mercury_data_private_builtin__type_ctor_info_heap_pointer_0);
-#endif
-}
-
-#ifdef MR_DEEP_PROFILING
-void
-sys_init_heap_pointer_module_write_out_proc_statics(FILE *fp)
-{
- MR_write_out_proc_static(fp, (MR_ProcStatic *)
- &MR_proc_static_compiler_name(private_builtin, __Unify__,
- heap_pointer, 0, 0));
- MR_write_out_proc_static(fp, (MR_ProcStatic *)
- &MR_proc_static_compiler_name(private_builtin, __Compare__,
- heap_pointer, 0, 0));
-}
-#endif
-
-").
+% Code to define the `heap_pointer' type for the .NET back-end.
+% (For the C back-ends, it is defined in runtime/mercury_builtin_types.[ch].)
:- pragma foreign_code("MC++", "
Index: library/profiling_builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/profiling_builtin.m,v
retrieving revision 1.9
diff -u -b -r1.9 profiling_builtin.m
--- library/profiling_builtin.m 2002/08/07 03:18:50 1.9
+++ library/profiling_builtin.m 2002/08/07 03:41:19
@@ -252,260 +252,30 @@
").
%---------------------------------------------------------------------------%
-% Call port procedures
+% Port procedures
%---------------------------------------------------------------------------%
-:- pragma foreign_proc("C", det_call_port_code_ac(ProcStatic::in, TopCSD::out,
- MiddleCSD::out),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: ProcStatic, TopCSD, MiddleCSD */
-#define MR_PROCNAME ""det_call_port_code_ac""
-#define MR_VERSION_AC
-#undef MR_NEED_NEW_OUTERMOST
-#include ""mercury_deep_call_port_body.h""
-#undef MR_PROCNAME
-#undef MR_VERSION_AC
-}").
+% These are all implemented in runtime/mercury_profiling_builtin.c,
+% which is generated by tools/make_port_code.
-:- pragma foreign_proc("C", semi_call_port_code_ac(ProcStatic::in, TopCSD::out,
- MiddleCSD::out),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: ProcStatic, TopCSD, MiddleCSD */
-#define MR_PROCNAME ""semi_call_port_code_ac""
-#define MR_VERSION_AC
-#undef MR_NEED_NEW_OUTERMOST
-#include ""mercury_deep_call_port_body.h""
-#undef MR_PROCNAME
-#undef MR_VERSION_AC
-}").
-
-:- pragma foreign_proc("C", non_call_port_code_ac(ProcStatic::in, TopCSD::out,
- MiddleCSD::out, NewOutermostActivationPtr::out),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: ProcStatic, TopCSD, MiddleCSD */
-/* shut up warning: NewOutermostActivationPtr */
-#define MR_PROCNAME ""non_call_port_code_ac""
-#define MR_VERSION_AC
-#define MR_NEED_NEW_OUTERMOST
-#include ""mercury_deep_call_port_body.h""
-#undef MR_PROCNAME
-#undef MR_VERSION_AC
-#undef MR_NEED_NEW_OUTERMOST
-}").
-
-:- pragma foreign_proc("C", det_call_port_code_sr(ProcStatic::in, TopCSD::out,
- MiddleCSD::out, OldOutermostActivationPtr::out),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: ProcStatic, TopCSD, MiddleCSD */
-/* shut up warning: OldOutermostActivationPtr */
-#define MR_PROCNAME ""det_call_port_code_sr""
-#define MR_VERSION_SR
-#undef MR_NEED_NEW_OUTERMOST
-#include ""mercury_deep_call_port_body.h""
-#undef MR_PROCNAME
-#undef MR_VERSION_SR
-}").
-
-:- pragma foreign_proc("C", semi_call_port_code_sr(ProcStatic::in, TopCSD::out,
- MiddleCSD::out, OldOutermostActivationPtr::out),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: ProcStatic, TopCSD, MiddleCSD */
-/* shut up warning: OldOutermostActivationPtr */
-#define MR_PROCNAME ""semi_call_port_code_sr""
-#define MR_VERSION_SR
-#undef MR_NEED_NEW_OUTERMOST
-#include ""mercury_deep_call_port_body.h""
-#undef MR_PROCNAME
-#undef MR_VERSION_SR
-}").
-
-:- pragma foreign_proc("C", non_call_port_code_sr(ProcStatic::in, TopCSD::out,
- MiddleCSD::out, OldOutermostActivationPtr::out,
- NewOutermostActivationPtr::out),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: ProcStatic, TopCSD, MiddleCSD */
-/* shut up warning: OldOutermostActivationPtr, NewOutermostActivationPtr */
-#define MR_PROCNAME ""non_call_port_code_sr""
-#define MR_VERSION_SR
-#define MR_NEED_NEW_OUTERMOST
-#include ""mercury_deep_call_port_body.h""
-#undef MR_PROCNAME
-#undef MR_VERSION_SR
-#undef MR_NEED_NEW_OUTERMOST
-}").
-
-%---------------------------------------------------------------------------%
-% Exit/Fail port procedures
-%---------------------------------------------------------------------------%
-
-:- pragma foreign_proc("C", det_exit_port_code_ac(TopCSD::in, MiddleCSD::in),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: TopCSD, MiddleCSD */
-#define MR_PROCNAME ""det_exit_port_code_ac""
-#define MR_EXIT_PORT
-#define MR_VERSION_AC
-#include ""mercury_deep_leave_port_body.h""
-#undef MR_PROCNAME
-#undef MR_EXIT_PORT
-#undef MR_VERSION_AC
-}").
-
-:- pragma foreign_proc("C", det_exit_port_code_sr(TopCSD::in, MiddleCSD::in,
- OldOutermostActivationPtr::in),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: TopCSD, MiddleCSD, OldOutermostActivationPtr */
-#define MR_PROCNAME ""det_exit_port_code_sr""
-#define MR_EXIT_PORT
-#define MR_VERSION_SR
-#include ""mercury_deep_leave_port_body.h""
-#undef MR_PROCNAME
-#undef MR_EXIT_PORT
-#undef MR_VERSION_SR
-}").
-
-:- pragma foreign_proc("C", semi_exit_port_code_ac(TopCSD::in, MiddleCSD::in),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: TopCSD, MiddleCSD */
-#define MR_PROCNAME ""semi_exit_port_code_ac""
-#define MR_EXIT_PORT
-#define MR_VERSION_AC
-#include ""mercury_deep_leave_port_body.h""
-#undef MR_PROCNAME
-#undef MR_EXIT_PORT
-#undef MR_VERSION_AC
-}").
-
-:- pragma foreign_proc("C", semi_exit_port_code_sr(TopCSD::in, MiddleCSD::in,
- OldOutermostActivationPtr::in),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: TopCSD, MiddleCSD, OldOutermostActivationPtr */
-#define MR_PROCNAME ""semi_exit_port_code_sr""
-#define MR_EXIT_PORT
-#define MR_VERSION_SR
-#include ""mercury_deep_leave_port_body.h""
-#undef MR_PROCNAME
-#undef MR_EXIT_PORT
-#undef MR_VERSION_SR
-}").
-
-:- pragma foreign_proc("C", semi_fail_port_code_ac(TopCSD::in, MiddleCSD::in),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: TopCSD, MiddleCSD */
-#define MR_PROCNAME ""semi_exit_port_code_ac""
-#define MR_FAIL_PORT
-#define MR_VERSION_AC
-#include ""mercury_deep_leave_port_body.h""
-#undef MR_PROCNAME
-#undef MR_FAIL_PORT
-#undef MR_VERSION_AC
-}").
-
-:- pragma foreign_proc("C", semi_fail_port_code_sr(TopCSD::in, MiddleCSD::in,
- OldOutermostActivationPtr::in),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: TopCSD, MiddleCSD, OldOutermostActivationPtr */
-#define MR_PROCNAME ""semi_fail_port_code_sr""
-#define MR_FAIL_PORT
-#define MR_VERSION_SR
-#include ""mercury_deep_leave_port_body.h""
-#undef MR_PROCNAME
-#undef MR_FAIL_PORT
-#undef MR_VERSION_SR
-}").
-
-:- pragma foreign_proc("C", non_exit_port_code_ac(TopCSD::in, MiddleCSD::in),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: TopCSD, MiddleCSD */
-#define MR_PROCNAME ""non_exit_port_code_ac""
-#define MR_EXIT_PORT
-#define MR_VERSION_AC
-#include ""mercury_deep_leave_port_body.h""
-#undef MR_PROCNAME
-#undef MR_EXIT_PORT
-#undef MR_VERSION_AC
-}").
-
-:- pragma foreign_proc("C", non_exit_port_code_sr(TopCSD::in, MiddleCSD::in,
- OldOutermostActivationPtr::in),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: TopCSD, MiddleCSD, OldOutermostActivationPtr */
-#define MR_PROCNAME ""non_exit_port_code_sr""
-#define MR_EXIT_PORT
-#define MR_VERSION_SR
-#include ""mercury_deep_leave_port_body.h""
-#undef MR_PROCNAME
-#undef MR_EXIT_PORT
-#undef MR_VERSION_SR
-}").
-
-:- pragma foreign_proc("C", non_fail_port_code_ac(TopCSD::in, MiddleCSD::in),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: TopCSD, MiddleCSD */
-#define MR_PROCNAME ""non_exit_port_code_ac""
-#define MR_FAIL_PORT
-#define MR_VERSION_AC
-#include ""mercury_deep_leave_port_body.h""
-#undef MR_PROCNAME
-#undef MR_FAIL_PORT
-#undef MR_VERSION_AC
-}").
-
-:- pragma foreign_proc("C", non_fail_port_code_sr(TopCSD::in, MiddleCSD::in,
- OldOutermostActivationPtr::in),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: TopCSD, MiddleCSD, OldOutermostActivationPtr */
-#define MR_PROCNAME ""non_fail_port_code_sr""
-#define MR_FAIL_PORT
-#define MR_VERSION_SR
-#include ""mercury_deep_leave_port_body.h""
-#undef MR_PROCNAME
-#undef MR_FAIL_PORT
-#undef MR_VERSION_SR
-}").
-
-%---------------------------------------------------------------------------%
-% Redo port procedures
-%---------------------------------------------------------------------------%
-
-:- pragma foreign_proc("C", non_redo_port_code_ac(MiddleCSD::in,
- NewOutermostActivationPtr::in),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: MiddleCSD, NewOutermostActivationPtr */
-#define MR_PROCNAME ""non_redo_port_code_ac""
-#define MR_VERSION_AC
-#include ""mercury_deep_redo_port_body.h""
-#undef MR_PROCNAME
-#undef MR_VERSION_AC
-}").
-
-:- pragma foreign_proc("C", non_redo_port_code_sr(MiddleCSD::in,
- NewOutermostActivationPtr::in),
- [thread_safe, will_not_call_mercury],
-"{
-/* shut up warning: MiddleCSD, NewOutermostActivationPtr */
-#define MR_PROCNAME ""non_redo_port_code_sr""
-#define MR_VERSION_SR
-#include ""mercury_deep_redo_port_body.h""
-#undef MR_PROCNAME
-#undef MR_VERSION_SR
-}").
+:- external(det_call_port_code_ac/3).
+:- external(det_call_port_code_sr/4).
+:- external(det_exit_port_code_ac/2).
+:- external(det_exit_port_code_sr/3).
+:- external(semi_call_port_code_ac/3).
+:- external(semi_call_port_code_sr/4).
+:- external(semi_exit_port_code_ac/2).
+:- external(semi_exit_port_code_sr/3).
+:- external(semi_fail_port_code_ac/2).
+:- external(semi_fail_port_code_sr/3).
+:- external(non_call_port_code_ac/4).
+:- external(non_call_port_code_sr/5).
+:- external(non_exit_port_code_ac/2).
+:- external(non_exit_port_code_sr/3).
+:- external(non_redo_port_code_ac/2).
+:- external(non_redo_port_code_sr/2).
+:- external(non_fail_port_code_ac/2).
+:- external(non_fail_port_code_sr/3).
%---------------------------------------------------------------------------%
% Procedures that prepare for calls
Index: library/type_desc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/type_desc.m,v
retrieving revision 1.13
diff -u -b -r1.13 type_desc.m
--- library/type_desc.m 2002/07/23 08:26:29 1.13
+++ library/type_desc.m 2002/07/26 16:51:25
@@ -168,199 +168,6 @@
call_rtti_compare_type_infos(Res, T1, T2) :-
rtti_implementation__compare_type_infos(Res, T1, T2).
-:- pragma foreign_code("C", "
-
-#include ""mercury_deep_profiling_hand.h""
-
-/* Ensure that the initialization code for the above module gets run. */
-/*
-INIT sys_init_type_desc_module
-*/
-
-/* suppress gcc -Wmissing-decl warnings */
-void sys_init_type_desc_module_init(void);
-void sys_init_type_desc_module_init_type_tables(void);
-#ifdef MR_DEEP_PROFILING
-void sys_init_type_desc_module_write_out_proc_statics(FILE *);
-#endif
-
-#ifndef MR_HIGHLEVEL_CODE
-
-#ifdef MR_DEEP_PROFILING
-MR_proc_static_compiler_empty(type_desc, __Unify__, type_ctor_desc, 0, 0,
- ""type_desc.m"", 0, MR_TRUE);
-MR_proc_static_compiler_empty(type_desc, __Compare__, type_ctor_desc, 0, 0,
- ""type_desc.m"", 0, MR_TRUE);
-MR_proc_static_compiler_empty(type_desc, __Unify__, type_desc, 0, 0,
- ""type_desc.m"", 0, MR_TRUE);
-MR_proc_static_compiler_empty(type_desc, __Compare__, type_desc, 0, 0,
- ""type_desc.m"", 0, MR_TRUE);
-#endif
-
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(type_desc, type_ctor_desc, 0,
- MR_TYPECTOR_REP_TYPECTORDESC);
-MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(type_desc, type_desc, 0,
- MR_TYPECTOR_REP_TYPEDESC);
-
-MR_define_extern_entry(mercury____Unify___type_desc__type_ctor_desc_0_0);
-MR_define_extern_entry(mercury____Compare___type_desc__type_ctor_desc_0_0);
-MR_define_extern_entry(mercury____Unify___type_desc__type_desc_0_0);
-MR_define_extern_entry(mercury____Compare___type_desc__type_desc_0_0);
-
-MR_BEGIN_MODULE(type_desc_unify_compare_module)
- MR_init_entry(mercury____Unify___type_desc__type_ctor_desc_0_0);
- MR_init_entry(mercury____Compare___type_desc__type_ctor_desc_0_0);
- MR_init_entry(mercury____Unify___type_desc__type_desc_0_0);
- MR_init_entry(mercury____Compare___type_desc__type_desc_0_0);
-#ifdef MR_DEEP_PROFILING
- MR_init_label(mercury____Unify___type_desc__type_ctor_desc_0_0_i1);
- MR_init_label(mercury____Unify___type_desc__type_ctor_desc_0_0_i2);
- MR_init_label(mercury____Unify___type_desc__type_ctor_desc_0_0_i3);
- MR_init_label(mercury____Unify___type_desc__type_ctor_desc_0_0_i4);
- MR_init_label(mercury____Compare___type_desc__type_ctor_desc_0_0_i1);
- MR_init_label(mercury____Compare___type_desc__type_ctor_desc_0_0_i2);
- MR_init_label(mercury____Unify___type_desc__type_desc_0_0_i1);
- MR_init_label(mercury____Unify___type_desc__type_desc_0_0_i2);
- MR_init_label(mercury____Unify___type_desc__type_desc_0_0_i3);
- MR_init_label(mercury____Unify___type_desc__type_desc_0_0_i4);
- MR_init_label(mercury____Compare___type_desc__type_desc_0_0_i1);
- MR_init_label(mercury____Compare___type_desc__type_desc_0_0_i2);
-#endif
-MR_BEGIN_CODE
-
-#define proc_label mercury____Unify___type_desc__type_ctor_desc_0_0
-#define proc_static MR_proc_static_compiler_name(type_desc, __Unify__, \
- type_ctor_desc, 0, 0)
-#define body_code do { \
- int comp; \
- \
- MR_save_transient_registers(); \
- comp = MR_compare_type_ctor_desc( \
- (MR_TypeCtorDesc) MR_r1, \
- (MR_TypeCtorDesc) MR_r2); \
- MR_restore_transient_registers(); \
- MR_r1 = (comp == MR_COMPARE_EQUAL); \
- } while (0)
-
-#include ""mercury_hand_unify_body.h""
-
-#undef body_code
-#undef proc_static
-#undef proc_label
-
-#define proc_label mercury____Compare___type_desc__type_ctor_desc_0_0
-#define proc_static MR_proc_static_compiler_name(type_desc, __Compare__, \
- type_ctor_desc, 0, 0)
-#define body_code do { \
- int comp; \
- \
- MR_save_transient_registers(); \
- comp = MR_compare_type_ctor_desc( \
- (MR_TypeCtorDesc) MR_r1, \
- (MR_TypeCtorDesc) MR_r2); \
- MR_restore_transient_registers(); \
- MR_r1 = comp; \
- } while (0)
-
-#include ""mercury_hand_compare_body.h""
-
-#undef body_code
-#undef proc_static
-#undef proc_label
-
-#define proc_label mercury____Unify___type_desc__type_desc_0_0
-#define proc_static MR_proc_static_compiler_name(type_desc, __Unify__, \
- type_desc, 0, 0)
-#define body_code do { \
- int comp; \
- \
- MR_save_transient_registers(); \
- comp = MR_compare_type_info( \
- (MR_TypeInfo) MR_r1, \
- (MR_TypeInfo) MR_r2); \
- MR_restore_transient_registers(); \
- MR_r1 = (comp == MR_COMPARE_EQUAL); \
- } while (0)
-
-#include ""mercury_hand_unify_body.h""
-
-#undef body_code
-#undef proc_static
-#undef proc_label
-
-#define proc_label mercury____Compare___type_desc__type_desc_0_0
-#define proc_static MR_proc_static_compiler_name(type_desc, __Compare__, \
- type_desc, 0, 0)
-#define body_code do { \
- int comp; \
- \
- MR_save_transient_registers(); \
- comp = MR_compare_type_info( \
- (MR_TypeInfo) MR_r1, \
- (MR_TypeInfo) MR_r2); \
- MR_restore_transient_registers(); \
- MR_r1 = comp; \
- } while (0)
-
-#include ""mercury_hand_compare_body.h""
-
-#undef body_code
-#undef proc_static
-#undef proc_label
-
-MR_END_MODULE
-
-MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc type_desc_unify_compare_module;
-
-#endif /* ! MR_HIGHLEVEL_CODE */
-
-void
-sys_init_type_desc_module_init(void)
-{
-#ifndef MR_HIGHLEVEL_CODE
- type_desc_unify_compare_module();
-
- MR_INIT_TYPE_CTOR_INFO(
- mercury_data_type_desc__type_ctor_info_type_ctor_desc_0,
- type_desc__type_desc_0_0);
- MR_INIT_TYPE_CTOR_INFO(
- mercury_data_type_desc__type_ctor_info_type_desc_0,
- type_desc__type_desc_0_0);
-#endif
-}
-
-void
-sys_init_type_desc_module_init_type_tables(void)
-{
-#ifndef MR_HIGHLEVEL_CODE
- MR_register_type_ctor_info(
- &mercury_data_type_desc__type_ctor_info_type_ctor_desc_0);
- MR_register_type_ctor_info(
- &mercury_data_type_desc__type_ctor_info_type_desc_0);
-#endif
-}
-
-#ifdef MR_DEEP_PROFILING
-void
-sys_init_type_desc_module_write_out_proc_statics(FILE *fp)
-{
- MR_write_out_proc_static(fp, (MR_ProcStatic *)
- &MR_proc_static_compiler_name(type_desc, __Compare__,
- type_ctor_desc, 0, 0));
- MR_write_out_proc_static(fp, (MR_ProcStatic *)
- &MR_proc_static_compiler_name(type_desc, __Unify__,
- type_ctor_desc, 0, 0));
- MR_write_out_proc_static(fp, (MR_ProcStatic *)
- &MR_proc_static_compiler_name(type_desc, __Compare__,
- type_desc, 0, 0));
- MR_write_out_proc_static(fp, (MR_ProcStatic *)
- &MR_proc_static_compiler_name(type_desc, __Unify__,
- type_desc, 0, 0));
-}
-#endif
-
-").
-
:- pragma foreign_code("MC++", "
MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(type_desc, type_ctor_desc, 0,
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.90
diff -u -b -r1.90 Mmakefile
--- runtime/Mmakefile 2002/06/22 19:16:08 1.90
+++ runtime/Mmakefile 2002/08/04 14:31:09
@@ -33,6 +33,7 @@
mercury_accurate_gc.h \
mercury_agc_debug.h \
mercury_array_macros.h \
+ mercury_builtin_types.h \
mercury_bootstrap.h \
mercury_calls.h \
mercury_conf.h \
@@ -58,6 +59,7 @@
mercury_hash_table.h \
mercury_heap.h \
mercury_heap_profile.h \
+ mercury_hlc_types.h \
mercury_ho_call.h \
mercury_imp.h \
mercury_init.h \
@@ -72,6 +74,7 @@
mercury_prof.h \
mercury_prof_mem.h \
mercury_prof_time.h \
+ mercury_profiling_builtin.h \
mercury_reg_workarounds.h \
mercury_regorder.h \
mercury_regs.h \
@@ -139,6 +142,7 @@
mercury_accurate_gc.c \
mercury_agc_debug.c \
mercury_bootstrap.c \
+ mercury_builtin_types.c \
mercury_construct.c \
mercury_context.c \
mercury_debug.c \
@@ -159,12 +163,13 @@
mercury_label.c \
mercury_layout_util.c \
mercury_memory.c \
- mercury_memory_zones.c \
mercury_memory_handlers.c \
+ mercury_memory_zones.c \
mercury_misc.c \
mercury_prof.c \
mercury_prof_mem.c \
mercury_prof_time.c \
+ mercury_profiling_builtin.c \
mercury_reg_workarounds.c \
mercury_regs.c \
mercury_runtime_util.c \
@@ -228,15 +233,29 @@
$(OBJS) $(PIC_OBJS): $(HDRS) $(MACHHDRS)
+mercury_builtin_types.$(O): mercury_hand_unify_compare_body.h
+mercury_builtin_types.(O): mercury_hand_unify_body.h mercury_hand_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_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
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
+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.
+mercury_profiling_builtin.h: mercury_deep_call_port_body.h \
+ mercury_deep_redo_port_body.h \
+ mercury_deep_leave_port_body.h \
+ ../tools/make_port_code
+ ../tools/make_port_code
#-----------------------------------------------------------------------------#
Index: runtime/mercury.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.c,v
retrieving revision 1.41
diff -u -b -r1.41 mercury.c
--- runtime/mercury.c 2002/04/25 09:31:56 1.41
+++ runtime/mercury.c 2002/08/02 07:15:48
@@ -19,6 +19,7 @@
#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_builtin_types.h"
#ifdef MR_HIGHLEVEL_CODE
@@ -34,875 +35,8 @@
MR_Word mercury__private_builtin__dummy_var;
/*---------------------------------------------------------------------------*/
-/*
-** Type definitions
-*/
-
-/* Types for the wrapper versions of type-specific unify/compare procedures. */
-
-typedef MR_bool MR_CALL MR_UnifyFunc_0(MR_Box, MR_Box);
-typedef MR_bool MR_CALL MR_UnifyFunc_1(MR_Mercury_Type_Info, MR_Box, MR_Box);
-typedef MR_bool MR_CALL MR_UnifyFunc_2(MR_Mercury_Type_Info,
- MR_Mercury_Type_Info, MR_Box, MR_Box);
-typedef MR_bool MR_CALL MR_UnifyFunc_3(MR_Mercury_Type_Info,
- MR_Mercury_Type_Info, MR_Mercury_Type_Info,
- MR_Box, MR_Box);
-typedef MR_bool MR_CALL MR_UnifyFunc_4(MR_Mercury_Type_Info,
- MR_Mercury_Type_Info, MR_Mercury_Type_Info,
- MR_Mercury_Type_Info, MR_Box, MR_Box);
-typedef MR_bool MR_CALL MR_UnifyFunc_5(MR_Mercury_Type_Info,
- MR_Mercury_Type_Info, MR_Mercury_Type_Info,
- MR_Mercury_Type_Info, MR_Mercury_Type_Info,
- MR_Box, MR_Box);
-
-typedef void MR_CALL MR_CompareFunc_0(MR_Comparison_Result *, MR_Box, MR_Box);
-typedef void MR_CALL MR_CompareFunc_1(MR_Mercury_Type_Info,
- MR_Comparison_Result *, MR_Box, MR_Box);
-typedef void MR_CALL MR_CompareFunc_2(MR_Mercury_Type_Info,
- MR_Mercury_Type_Info, MR_Comparison_Result *,
- MR_Box, MR_Box);
-typedef void MR_CALL MR_CompareFunc_3(MR_Mercury_Type_Info,
- MR_Mercury_Type_Info, MR_Mercury_Type_Info,
- MR_Comparison_Result *, MR_Box, MR_Box);
-typedef void MR_CALL MR_CompareFunc_4(MR_Mercury_Type_Info,
- MR_Mercury_Type_Info, MR_Mercury_Type_Info,
- MR_Mercury_Type_Info, MR_Comparison_Result *,
- MR_Box, MR_Box);
-typedef void MR_CALL MR_CompareFunc_5(MR_Mercury_Type_Info,
- MR_Mercury_Type_Info, MR_Mercury_Type_Info,
- MR_Mercury_Type_Info, MR_Mercury_Type_Info,
- MR_Comparison_Result *, MR_Box, MR_Box);
-
-/*---------------------------------------------------------------------------*/
-/*
-** Forward declarations of static functions.
-** These functions are used in the initializers
-** for the type_ctor_info constants defined below.
-*/
-
-static MR_UnifyFunc_0
- mercury__builtin__do_unify__int_0_0,
- mercury__builtin__do_unify__string_0_0,
- mercury__builtin__do_unify__float_0_0,
- mercury__builtin__do_unify__character_0_0,
- mercury__builtin__do_unify__void_0_0,
- mercury__builtin__do_unify__c_pointer_0_0,
- mercury__private_builtin__do_unify__heap_pointer_0_0,
- mercury__builtin__do_unify__func_0_0,
- mercury__builtin__do_unify__pred_0_0,
- mercury__type_desc__do_unify__type_ctor_desc_0_0,
- mercury__type_desc__do_unify__type_desc_0_0;
-
-static MR_UnifyFunc_1
- mercury__builtin__do_unify__tuple_0_0,
- mercury__private_builtin__do_unify__type_ctor_info_1_0,
- mercury__private_builtin__do_unify__type_info_1_0,
- mercury__private_builtin__do_unify__typeclass_info_1_0,
- mercury__private_builtin__do_unify__base_typeclass_info_1_0;
-
-static MR_CompareFunc_0
- mercury__builtin__do_compare__int_0_0,
- mercury__builtin__do_compare__string_0_0,
- mercury__builtin__do_compare__float_0_0,
- mercury__builtin__do_compare__character_0_0,
- mercury__builtin__do_compare__void_0_0,
- mercury__builtin__do_compare__c_pointer_0_0,
- mercury__private_builtin__do_compare__heap_pointer_0_0,
- mercury__builtin__do_compare__func_0_0,
- mercury__builtin__do_compare__pred_0_0,
- mercury__type_desc__do_compare__type_ctor_desc_0_0,
- mercury__type_desc__do_compare__type_desc_0_0;
-
-static MR_CompareFunc_1
- mercury__builtin__do_compare__tuple_0_0,
- mercury__private_builtin__do_compare__type_ctor_info_1_0,
- mercury__private_builtin__do_compare__type_info_1_0,
- mercury__private_builtin__do_compare__typeclass_info_1_0,
- mercury__private_builtin__do_compare__base_typeclass_info_1_0;
-
-/*---------------------------------------------------------------------------*/
-/*
-** Constant definitions
-*/
-
-/*
-** Define MR_TypeCtorInfos for the builtin types
-*/
-
-MR_define_type_ctor_info(builtin, int, 0, MR_TYPECTOR_REP_INT);
-MR_define_type_ctor_info(builtin, character, 0, MR_TYPECTOR_REP_CHAR);
-MR_define_type_ctor_info(builtin, string, 0, MR_TYPECTOR_REP_STRING);
-MR_define_type_ctor_info(builtin, float, 0, MR_TYPECTOR_REP_FLOAT);
-MR_define_type_ctor_info(builtin, func, 0, MR_TYPECTOR_REP_FUNC);
-MR_define_type_ctor_info(builtin, pred, 0, MR_TYPECTOR_REP_PRED);
-MR_define_type_ctor_info(builtin, tuple, 0, MR_TYPECTOR_REP_TUPLE);
-MR_define_type_ctor_info(builtin, void, 0, MR_TYPECTOR_REP_VOID);
-MR_define_type_ctor_info(builtin, c_pointer, 0, MR_TYPECTOR_REP_C_POINTER);
-MR_define_type_ctor_info(private_builtin, heap_pointer, 0, MR_TYPECTOR_REP_HP);
-MR_define_type_ctor_info(type_desc, type_ctor_desc,
- 0, MR_TYPECTOR_REP_TYPECTORDESC);
-MR_define_type_ctor_info(type_desc, type_desc,
- 0, MR_TYPECTOR_REP_TYPEDESC);
-MR_define_type_ctor_info(private_builtin, type_ctor_info, 1,
- MR_TYPECTOR_REP_TYPECTORINFO);
-MR_define_type_ctor_info(private_builtin, type_info, 1,
- MR_TYPECTOR_REP_TYPEINFO);
-MR_define_type_ctor_info(private_builtin, base_typeclass_info, 1,
- MR_TYPECTOR_REP_BASETYPECLASSINFO);
-MR_define_type_ctor_info(private_builtin, typeclass_info, 1,
- MR_TYPECTOR_REP_TYPECLASSINFO);
-
-/*---------------------------------------------------------------------------*/
-
-#define SORRY(msg) MR_fatal_error("Sorry, not yet implemented: " msg);
-
-/*---------------------------------------------------------------------------*/
-/*---------------------------------------------------------------------------*/
-/*
-** Function definitions
-*/
-
-/*
-** Define the generic unify/2 and compare/3 functions.
-*/
-
-MR_bool MR_CALL
-mercury__builtin__unify_2_p_0(MR_Mercury_Type_Info ti, MR_Box x, MR_Box y)
-{
- MR_TypeInfo type_info;
- MR_TypeCtorInfo type_ctor_info;
- MR_TypeCtorRep type_ctor_rep;
- int arity;
- MR_TypeInfoParams params;
- MR_Mercury_Type_Info *args;
-
- type_info = (MR_TypeInfo) ti;
- type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
-
- /*
- ** Tuple and higher-order types do not have a fixed arity,
- ** so they need to be special cased here.
- */
- type_ctor_rep = MR_type_ctor_rep(type_ctor_info);
- if (type_ctor_rep == MR_TYPECTOR_REP_TUPLE) {
- return mercury__builtin____Unify____tuple_0_0(ti,
- (MR_Tuple) x, (MR_Tuple) y);
- } else if (type_ctor_rep == MR_TYPECTOR_REP_PRED) {
- return mercury__builtin____Unify____pred_0_0((MR_Pred) x,
- (MR_Pred) y);
- } else if (type_ctor_rep == MR_TYPECTOR_REP_FUNC) {
- return mercury__builtin____Unify____pred_0_0((MR_Pred) x,
- (MR_Pred) y);
- }
-
- arity = type_ctor_info->MR_type_ctor_arity;
- params = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
- args = (MR_Mercury_Type_Info *) params;
-
- switch(arity) {
- /*
- ** cast type_ctor_info->unify_pred to the right type
- ** and then call it, passing the right number of
- ** type_info arguments
- */
- case 0: return ((MR_UnifyFunc_0 *)
- type_ctor_info->MR_type_ctor_unify_pred)
- (x, y);
- case 1: return ((MR_UnifyFunc_1 *)
- type_ctor_info->MR_type_ctor_unify_pred)
- (args[1], x, y);
- case 2: return ((MR_UnifyFunc_2 *)
- type_ctor_info->MR_type_ctor_unify_pred)
- (args[1], args[2], x, y);
- case 3: return ((MR_UnifyFunc_3 *)
- type_ctor_info->MR_type_ctor_unify_pred)
- (args[1], args[2], args[3],
- x, y);
- case 4: return ((MR_UnifyFunc_4 *)
- type_ctor_info->MR_type_ctor_unify_pred)
- (args[1], args[2], args[3],
- args[4], x, y);
- case 5: return ((MR_UnifyFunc_5 *)
- type_ctor_info->MR_type_ctor_unify_pred)
- (args[1], args[2], args[3],
- args[4], args[5], x, y);
- default:
- MR_fatal_error(
- "unify/2: type arity > 5 not supported");
- }
-}
-
-void MR_CALL
-mercury__builtin__compare_3_p_0(MR_Mercury_Type_Info ti,
- MR_Comparison_Result *res, MR_Box x, MR_Box y)
-{
- MR_TypeInfo type_info;
- MR_TypeCtorInfo type_ctor_info;
- MR_TypeCtorRep type_ctor_rep;
- int arity;
- MR_TypeInfoParams params;
- MR_Mercury_Type_Info *args;
-
- type_info = (MR_TypeInfo) ti;
- type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
-
- /*
- ** Tuple and higher-order types do not have a fixed arity,
- ** so they need to be special cased here.
- */
- type_ctor_rep = MR_type_ctor_rep(type_ctor_info);
- if (type_ctor_rep == MR_TYPECTOR_REP_TUPLE) {
- mercury__builtin____Compare____tuple_0_0(ti,
- res, (MR_Tuple) x, (MR_Tuple) y);
- return;
- } else if (type_ctor_rep == MR_TYPECTOR_REP_PRED) {
- mercury__builtin____Compare____pred_0_0(res,
- (MR_Pred) x, (MR_Pred) y);
- } else if (type_ctor_rep == MR_TYPECTOR_REP_FUNC) {
- mercury__builtin____Compare____pred_0_0(res,
- (MR_Pred) x, (MR_Pred) y);
- return;
- }
-
- arity = type_ctor_info->MR_type_ctor_arity;
- params = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
- args = (MR_Mercury_Type_Info *) params;
-
- switch(arity) {
- /*
- ** cast type_ctor_info->compare to the right type
- ** and then call it, passing the right number of
- ** type_info arguments
- */
- case 0: ((MR_CompareFunc_0 *)
- type_ctor_info->MR_type_ctor_compare_pred)
- (res, x, y);
- break;
- case 1: ((MR_CompareFunc_1 *)
- type_ctor_info->MR_type_ctor_compare_pred)
- (args[1], res, x, y);
- break;
- case 2: ((MR_CompareFunc_2 *)
- type_ctor_info->MR_type_ctor_compare_pred)
- (args[1], args[2], res, x, y);
- break;
- case 3: ((MR_CompareFunc_3 *)
- type_ctor_info->MR_type_ctor_compare_pred)
- (args[1], args[2], args[3], res, x, y);
- break;
- case 4: ((MR_CompareFunc_4 *)
- type_ctor_info->MR_type_ctor_compare_pred)
- (args[1], args[2], args[3],
- args[4], res, x, y);
- break;
- case 5: ((MR_CompareFunc_5 *)
- type_ctor_info->MR_type_ctor_compare_pred)
- (args[1], args[2], args[3],
- args[4], args[5], res, x, y);
- break;
- default:
- MR_fatal_error(
- "index/2: type arity > 5 not supported");
- }
-}
-
-void MR_CALL
-mercury__builtin__compare_3_p_1(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *res, MR_Box x, MR_Box y)
-{
- mercury__builtin__compare_3_p_0(type_info, res, x, y);
-}
-
-void MR_CALL
-mercury__builtin__compare_3_p_2(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *res, MR_Box x, MR_Box y)
-{
- mercury__builtin__compare_3_p_0(type_info, res, x, y);
-}
-
-void MR_CALL
-mercury__builtin__compare_3_p_3(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *res, MR_Box x, MR_Box y)
-{
- 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");
-}
-
-/*---------------------------------------------------------------------------*/
-/*---------------------------------------------------------------------------*/
-/*
-** Definitions of the type-specific __Unify__ and __Compare__ procedures
-** for the builtin types.
-**
-** There are two versions of each of these. The first version, __Unify__,
-** which is called when the type is known at compile time,
-** has the arguments unboxed. The second version, do_unify_, which is
-** stored in the type_ctor_info and called from the generic
-** unify/2 or compare/3, is a wrapper that has the arguments boxed,
-** and just calls the first version.
-*/
-
-/*---------------------------------------------------------------------------*/
-/*
-** Unification procedures with the arguments unboxed.
-*/
-
-MR_bool MR_CALL
-mercury__builtin____Unify____int_0_0(MR_Integer x, MR_Integer y)
-{
- return x == y;
-}
-
-MR_bool MR_CALL
-mercury__builtin____Unify____string_0_0(MR_String x, MR_String y)
-{
- return strcmp(x, y) == 0;
-}
-
-MR_bool MR_CALL
-mercury__builtin____Unify____float_0_0(MR_Float x, MR_Float y)
-{
- /* XXX what should this function do when x and y are both NaNs? */
- return x == y;
-}
-
-MR_bool MR_CALL
-mercury__builtin____Unify____character_0_0(MR_Char x, MR_Char y)
-{
- return x == y;
-}
-
-MR_bool MR_CALL
-mercury__builtin____Unify____void_0_0(MR_Void x, MR_Void y)
-{
- MR_fatal_error("called unify for type `void'");
-}
-
-MR_bool MR_CALL
-mercury__builtin____Unify____c_pointer_0_0(MR_C_Pointer x, MR_C_Pointer y)
-{
- return (void *) x == (void *) y;
-}
-
-MR_bool MR_CALL
-mercury__private_builtin____Unify____heap_pointer_0_0(MR_Heap_Pointer x,
- MR_Heap_Pointer y)
-{
- MR_fatal_error("called unify for type `private_builtin:heap_pointer'");
-}
-
-MR_bool MR_CALL
-mercury__builtin____Unify____func_0_0(MR_Func x, MR_Func y)
-{
- MR_fatal_error("called unify for `func' type");
-}
-
-MR_bool MR_CALL
-mercury__builtin____Unify____pred_0_0(MR_Pred x, MR_Pred y)
-{
- MR_fatal_error("called unify for `pred' type");
-}
-
-MR_bool MR_CALL
-mercury__builtin____Unify____tuple_0_0(MR_Mercury_Type_Info ti,
- MR_Tuple x, MR_Tuple y)
-{
- int i, arity;
- MR_bool result;
- MR_TypeInfo type_info;
- MR_TypeInfo arg_type_info;
-
- type_info = (MR_TypeInfo) ti;
- arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
-
- for (i = 0; i < arity; i++) {
- /* type_infos are counted starting at one. */
- arg_type_info =
- MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[i + 1];
- result = mercury__builtin__unify_2_p_0(
- (MR_Mercury_Type_Info) arg_type_info, x[i], y[i]);
- if (result == MR_FALSE) {
- return MR_FALSE;
- }
- }
- return MR_TRUE;
-}
-
-MR_bool MR_CALL
-mercury__type_desc____Unify____type_ctor_desc_0_0(
- MR_Type_Ctor_Desc x, MR_Type_Ctor_Desc y)
-{
- return MR_unify_type_ctor_desc((MR_TypeCtorDesc) x,
- (MR_TypeCtorDesc) y);
-}
-
-MR_bool MR_CALL
-mercury__type_desc____Unify____type_desc_0_0(MR_Type_Desc x, MR_Type_Desc y)
-{
- return MR_unify_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
-}
-
-MR_bool MR_CALL
-mercury__private_builtin____Unify____type_ctor_info_1_0(
- MR_Mercury_Type_Info type_info,
- MR_Mercury_Type_Ctor_Info x, MR_Mercury_Type_Ctor_Info y)
-{
- return MR_unify_type_ctor_info((MR_TypeCtorInfo) x,
- (MR_TypeCtorInfo) y);
-}
-
-MR_bool MR_CALL
-mercury__private_builtin____Unify____type_info_1_0(
- MR_Mercury_Type_Info type_info,
- MR_Mercury_Type_Info x, MR_Mercury_Type_Info y)
-{
- return MR_unify_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
-}
-
-MR_bool MR_CALL
-mercury__private_builtin____Unify____typeclass_info_1_0(
- MR_Mercury_Type_Info type_info,
- MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y)
-{
- MR_fatal_error("attempt to unify typeclass_info");
-}
-
-MR_bool MR_CALL
-mercury__private_builtin____Unify____base_typeclass_info_1_0(
- MR_Mercury_Type_Info type_info,
- MR_Mercury_Base_TypeClass_Info x, MR_Mercury_Base_TypeClass_Info y)
-{
- SORRY("unify for base_typeclass_info");
-}
-
-/*---------------------------------------------------------------------------*/
-/*
-** Comparison procedures with the arguments unboxed.
-*/
-
-void MR_CALL
-mercury__builtin____Compare____int_0_0(
- MR_Comparison_Result *result, MR_Integer x, MR_Integer y)
-{
- *result = (x > y ? MR_COMPARE_GREATER :
- x == y ? MR_COMPARE_EQUAL :
- MR_COMPARE_LESS);
-}
-
-void MR_CALL
-mercury__builtin____Compare____string_0_0(MR_Comparison_Result *result,
- MR_String x, MR_String y)
-{
- int res = strcmp(x, y);
- *result = (res > 0 ? MR_COMPARE_GREATER :
- res == 0 ? MR_COMPARE_EQUAL :
- MR_COMPARE_LESS);
-}
-
-void MR_CALL
-mercury__builtin____Compare____float_0_0(
- MR_Comparison_Result *result, MR_Float x, MR_Float y)
-{
- /* XXX what should this function do when x and y are both NaNs? */
- *result = (x > y ? MR_COMPARE_GREATER :
- x == y ? MR_COMPARE_EQUAL :
- x < y ? MR_COMPARE_LESS :
- (MR_fatal_error("incomparable floats in compare/3"),
- MR_COMPARE_EQUAL));
-}
-
-void MR_CALL
-mercury__builtin____Compare____character_0_0(
- MR_Comparison_Result *result, MR_Char x, MR_Char y)
-{
- *result = (x > y ? MR_COMPARE_GREATER :
- x == y ? MR_COMPARE_EQUAL :
- MR_COMPARE_LESS);
-}
-
-void MR_CALL
-mercury__builtin____Compare____void_0_0(MR_Comparison_Result *result,
- MR_Void x, MR_Void y)
-{
- MR_fatal_error("called compare/3 for type `void'");
-}
-
-void MR_CALL
-mercury__builtin____Compare____c_pointer_0_0(
- MR_Comparison_Result *result, MR_C_Pointer x, MR_C_Pointer y)
-{
- *result =
- ( (void *) x == (void *) y ? MR_COMPARE_EQUAL
- : (void *) x < (void *) y ? MR_COMPARE_LESS
- : MR_COMPARE_GREATER
- );
-}
-
-void MR_CALL
-mercury__private_builtin____Compare____heap_pointer_0_0(
- MR_Comparison_Result *result, MR_Heap_Pointer x, MR_Heap_Pointer y)
-{
- MR_fatal_error(
- "called compare/3 for type `private_builtin:heap_pointer'");
-}
-
-void MR_CALL
-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");
-}
-
-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");
-}
-
-void MR_CALL
-mercury__builtin____Compare____tuple_0_0(MR_Mercury_Type_Info ti,
- MR_Comparison_Result *result, MR_Tuple x, MR_Tuple y)
-{
- int i, arity;
- MR_TypeInfo type_info;
- MR_TypeInfo arg_type_info;
-
- type_info = (MR_TypeInfo) ti;
- arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
-
- for (i = 0; i < arity; i++) {
- /* type_infos are counted starting at one. */
- arg_type_info =
- MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[i + 1];
- mercury__builtin__compare_3_p_0((MR_Mercury_Type_Info) arg_type_info,
- result, x[i], y[i]);
- if (*result != MR_COMPARE_EQUAL) {
- return;
- }
- }
- *result = MR_COMPARE_EQUAL;
-}
-
-void MR_CALL
-mercury__type_desc____Compare____type_ctor_desc_0_0(
- MR_Comparison_Result *result, MR_Type_Ctor_Desc x, MR_Type_Ctor_Desc y)
-{
- *result = MR_compare_type_ctor_desc((MR_TypeCtorDesc) x,
- (MR_TypeCtorDesc) y);
-}
-
-void MR_CALL
-mercury__type_desc____Compare____type_desc_0_0(
- MR_Comparison_Result *result, MR_Type_Desc x, MR_Type_Desc y)
-{
- *result = MR_compare_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
-}
-
-void MR_CALL
-mercury__private_builtin____Compare____type_ctor_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Mercury_Type_Ctor_Info x, MR_Mercury_Type_Ctor_Info y)
-{
- *result = MR_compare_type_ctor_info((MR_TypeCtorInfo) x,
- (MR_TypeCtorInfo) y);
-}
-
-void MR_CALL
-mercury__private_builtin____Compare____type_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Mercury_Type_Info x, MR_Mercury_Type_Info y)
-{
- *result = MR_compare_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
-}
-void MR_CALL
-mercury__private_builtin____Compare____typeclass_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y)
-{
- MR_fatal_error("attempt to compare typeclass_info");
-}
-
-void MR_CALL
-mercury__private_builtin____Compare____base_typeclass_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Mercury_Base_TypeClass_Info x, MR_Mercury_Base_TypeClass_Info y)
-{
- SORRY("compare for base_typeclass_info");
-}
-
-/*---------------------------------------------------------------------------*/
/*
-** Unification procedures with the arguments boxed.
-** These are just wrappers which call the unboxed version.
-*/
-
-static MR_bool MR_CALL
-mercury__builtin__do_unify__int_0_0(MR_Box x, MR_Box y)
-{
- return mercury__builtin____Unify____int_0_0(
- (MR_Integer) x, (MR_Integer) y);
-}
-
-static MR_bool MR_CALL
-mercury__builtin__do_unify__string_0_0(MR_Box x, MR_Box y)
-{
- return mercury__builtin____Unify____string_0_0(
- (MR_String) x, (MR_String) y);
-}
-
-static MR_bool MR_CALL
-mercury__builtin__do_unify__float_0_0(MR_Box x, MR_Box y)
-{
- return mercury__builtin____Unify____float_0_0(
- MR_unbox_float(x), MR_unbox_float(y));
-}
-
-static MR_bool MR_CALL
-mercury__builtin__do_unify__character_0_0(MR_Box x, MR_Box y)
-{
- return mercury__builtin____Unify____character_0_0(
- (MR_Char) (MR_Word) x, (MR_Char) (MR_Word) y);
-}
-
-static MR_bool MR_CALL
-mercury__builtin__do_unify__void_0_0(MR_Box x, MR_Box y)
-{
- MR_fatal_error("called unify for type `void'");
-}
-
-static MR_bool MR_CALL
-mercury__builtin__do_unify__c_pointer_0_0(MR_Box x, MR_Box y)
-{
- return mercury__builtin____Unify____c_pointer_0_0(
- (MR_C_Pointer) x, (MR_C_Pointer) y);
-}
-
-static MR_bool MR_CALL
-mercury__private_builtin__do_unify__heap_pointer_0_0(MR_Box x, MR_Box y)
-{
- return mercury__private_builtin____Unify____heap_pointer_0_0(
- (MR_Heap_Pointer) x, (MR_Heap_Pointer) y);
-}
-
-static MR_bool MR_CALL
-mercury__builtin__do_unify__func_0_0(MR_Box x, MR_Box y)
-{
- MR_fatal_error("called unify for `func' type");
-}
-
-static MR_bool MR_CALL
-mercury__builtin__do_unify__pred_0_0(MR_Box x, MR_Box y)
-{
- MR_fatal_error("called unify for `pred' type");
-}
-
-static MR_bool MR_CALL
-mercury__builtin__do_unify__tuple_0_0(MR_Mercury_Type_Info type_info,
- MR_Box x, MR_Box y)
-{
- return mercury__builtin____Unify____tuple_0_0(
- type_info, (MR_Tuple) x, (MR_Tuple) y);
-}
-
-static MR_bool MR_CALL
-mercury__type_desc__do_unify__type_ctor_desc_0_0(MR_Box x, MR_Box y)
-{
- return mercury__type_desc____Unify____type_ctor_desc_0_0(
- (MR_Type_Ctor_Desc) x, (MR_Type_Ctor_Desc) y);
-}
-
-static MR_bool MR_CALL
-mercury__type_desc__do_unify__type_desc_0_0(MR_Box x, MR_Box y)
-{
- return mercury__type_desc____Unify____type_desc_0_0(
- (MR_Type_Desc) x, (MR_Type_Desc) y);
-}
-
-static MR_bool MR_CALL
-mercury__private_builtin__do_unify__type_ctor_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Box x, MR_Box y)
-{
- return mercury__private_builtin____Unify____type_ctor_info_1_0(
- type_info, (MR_Mercury_Type_Ctor_Info) x, (MR_Mercury_Type_Ctor_Info) y);
-}
-
-static MR_bool MR_CALL
-mercury__private_builtin__do_unify__type_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Box x, MR_Box y)
-{
- return mercury__private_builtin____Unify____type_info_1_0(
- type_info, (MR_Mercury_Type_Info) x, (MR_Mercury_Type_Info) y);
-}
-
-static MR_bool MR_CALL
-mercury__private_builtin__do_unify__typeclass_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Box x, MR_Box y)
-{
- return mercury__private_builtin____Unify____typeclass_info_1_0(
- type_info, (MR_Mercury_TypeClass_Info) x, (MR_Mercury_TypeClass_Info) y);
-}
-
-static MR_bool MR_CALL
-mercury__private_builtin__do_unify__base_typeclass_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Box x, MR_Box y)
-{
- return mercury__private_builtin____Unify____base_typeclass_info_1_0(
- type_info,
- (MR_Mercury_Base_TypeClass_Info) x,
- (MR_Mercury_Base_TypeClass_Info) y);
-}
-
-/*---------------------------------------------------------------------------*/
-/*
-** Comparison procedures with the arguments boxed.
-** These are just wrappers which call the unboxed version.
-*/
-
-static void MR_CALL
-mercury__builtin__do_compare__int_0_0(
- MR_Comparison_Result *result, MR_Box x, MR_Box y)
-{
- mercury__builtin____Compare____int_0_0(result,
- (MR_Integer) x, (MR_Integer) y);
-}
-
-static void MR_CALL
-mercury__builtin__do_compare__string_0_0(
- MR_Comparison_Result *result, MR_Box x, MR_Box y)
-{
- mercury__builtin____Compare____string_0_0(result,
- (MR_String) x, (MR_String) y);
-}
-
-static void MR_CALL
-mercury__builtin__do_compare__float_0_0(
- MR_Comparison_Result *result, MR_Box x, MR_Box y)
-{
- mercury__builtin____Compare____float_0_0(result,
- MR_unbox_float(x), MR_unbox_float(y));
-}
-
-static void MR_CALL
-mercury__builtin__do_compare__character_0_0(
- MR_Comparison_Result *result, MR_Box x, MR_Box y)
-{
- mercury__builtin____Compare____character_0_0(
- result, (MR_Char) (MR_Word) x, (MR_Char) (MR_Word) y);
-}
-
-static void MR_CALL
-mercury__builtin__do_compare__void_0_0(
- MR_Comparison_Result *result, MR_Box x, MR_Box y)
-{
- MR_fatal_error("called compare/3 for type `void'");
-}
-
-static void MR_CALL
-mercury__builtin__do_compare__c_pointer_0_0(
- MR_Comparison_Result *result, MR_Box x, MR_Box y)
-{
- mercury__builtin____Compare____c_pointer_0_0(
- result, (MR_C_Pointer) x, (MR_C_Pointer) y);
-}
-
-static void MR_CALL
-mercury__private_builtin__do_compare__heap_pointer_0_0(
- MR_Comparison_Result *result, MR_Box x, MR_Box y)
-{
- MR_fatal_error(
- "called compare/3 for type `private_builtin:heap_pointer'");
-}
-
-static void MR_CALL
-mercury__builtin__do_compare__func_0_0(
- MR_Comparison_Result *result, MR_Box x, MR_Box y)
-{
- MR_fatal_error("called compare/3 for func type");
-}
-
-static void MR_CALL
-mercury__builtin__do_compare__pred_0_0(MR_Comparison_Result *result,
- MR_Box x, MR_Box y)
-{
- MR_fatal_error("called compare/3 for pred type");
-}
-
-static void MR_CALL
-mercury__builtin__do_compare__tuple_0_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Box x, MR_Box y)
-{
- mercury__builtin____Compare____tuple_0_0(
- type_info, result, (MR_Tuple) x, (MR_Tuple) y);
-}
-
-static void MR_CALL
-mercury__type_desc__do_compare__type_ctor_desc_0_0(
- MR_Comparison_Result *result, MR_Box x, MR_Box y)
-{
- mercury__type_desc____Compare____type_ctor_desc_0_0(
- result, (MR_Type_Ctor_Desc) x, (MR_Type_Ctor_Desc) y);
-}
-
-static void MR_CALL
-mercury__type_desc__do_compare__type_desc_0_0(
- MR_Comparison_Result *result, MR_Box x, MR_Box y)
-{
- mercury__type_desc____Compare____type_desc_0_0(
- result, (MR_Type_Desc) x, (MR_Type_Desc) y);
-}
-
-static void MR_CALL
-mercury__private_builtin__do_compare__type_ctor_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Box x, MR_Box y)
-{
- mercury__private_builtin____Compare____type_ctor_info_1_0(
- type_info, result,
- (MR_Mercury_Type_Ctor_Info) x, (MR_Mercury_Type_Ctor_Info) y);
-}
-
-static void MR_CALL
-mercury__private_builtin__do_compare__type_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Box x, MR_Box y)
-{
- mercury__private_builtin____Compare____type_info_1_0(
- type_info, result, (MR_Mercury_Type_Info) x, (MR_Mercury_Type_Info) y);
-}
-
-static void MR_CALL
-mercury__private_builtin__do_compare__typeclass_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Box x, MR_Box y)
-{
- mercury__private_builtin____Compare____typeclass_info_1_0(
- type_info, result,
- (MR_Mercury_TypeClass_Info) x, (MR_Mercury_TypeClass_Info) y);
-}
-
-static void MR_CALL
-mercury__private_builtin__do_compare__base_typeclass_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Box x, MR_Box y)
-{
- mercury__private_builtin____Compare____base_typeclass_info_1_0(
- type_info, result,
- (MR_Mercury_Base_TypeClass_Info) x,
- (MR_Mercury_Base_TypeClass_Info) y);
-}
-
-/*---------------------------------------------------------------------------*/
-
-/*
** Provide definitions for functions declared `extern inline'.
** Note that this code duplicates the code in mercury.h/mercury_heap.h.
*/
@@ -996,63 +130,5 @@
}
#endif /* ! MR_HIGHLEVEL_CODE */
-
-/*---------------------------------------------------------------------------*/
-
-/*
-INIT mercury_sys_init_mercury_hlc
-ENDINIT
-*/
-
-/* forward decls, to suppress gcc -Wmissing-decl warnings. */
-void mercury_sys_init_mercury_hlc_init(void);
-void mercury_sys_init_mercury_hlc_init_type_tables(void);
-#ifdef MR_DEEP_PROFILING
-void mercury_sys_init_mercury_hlc_write_out_proc_statics(FILE *fp);
-#endif
-
-void
-mercury_sys_init_mercury_hlc_init(void)
-{
-#ifdef MR_HIGHLEVEL_CODE
- /*
- ** We need to call MR_init_entry() for the unification and comparison
- ** predicates for builtin types. Note that we don't need to do this
- ** for types such as `c_pointer' which are declared in the library;
- ** this is only needed for types which are automatically predefined
- ** by the type checker.
- */
-
- MR_init_entry(mercury__builtin____Unify____int_0_0);
- MR_init_entry(mercury__builtin____Unify____string_0_0);
- MR_init_entry(mercury__builtin____Unify____float_0_0);
- MR_init_entry(mercury__builtin____Unify____character_0_0);
- MR_init_entry(mercury__builtin____Unify____void_0_0);
- MR_init_entry(mercury__builtin____Unify____func_0_0);
- MR_init_entry(mercury__builtin____Unify____pred_0_0);
-
- MR_init_entry(mercury__builtin____Compare____int_0_0);
- MR_init_entry(mercury__builtin____Compare____string_0_0);
- MR_init_entry(mercury__builtin____Compare____float_0_0);
- MR_init_entry(mercury__builtin____Compare____character_0_0);
- MR_init_entry(mercury__builtin____Compare____void_0_0);
- MR_init_entry(mercury__builtin____Compare____func_0_0);
- MR_init_entry(mercury__builtin____Compare____pred_0_0);
-#else
- /* no initialization needed */
-#endif
-}
-
-void mercury_sys_init_mercury_hlc_init_type_tables(void)
-{
- /* no types to register */
-}
-
-#ifdef MR_DEEP_PROFILING
-void mercury_sys_init_mercury_hlc_write_out_proc_statics(FILE *fp)
-{
- /* no proc_statics to write out */
-}
-#endif
/*---------------------------------------------------------------------------*/
Index: runtime/mercury.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.h,v
retrieving revision 1.58
diff -u -b -r1.58 mercury.h
--- runtime/mercury.h 2002/08/01 11:52:25 1.58
+++ runtime/mercury.h 2002/08/02 07:10:51
@@ -71,13 +71,6 @@
*/
/*
-** The continuation function types used for implementing
-** nondeterministic procedures.
-*/
-typedef void MR_CALL (*MR_NestedCont) (void); /* for --gcc-nested-functions */
-typedef void MR_CALL (*MR_Cont) (void *); /* for --no-gcc-nested-functions */
-
-/*
** The jmp_buf type used by MR_builtin_setjmp()
** to save the stack context when implementing commits.
*/
@@ -94,82 +87,6 @@
#endif
/*
-** The types uses to represent the Mercury builtin types,
-** MR_Char, MR_Float, MR_Integer, MR_String, and MR_ConstString,
-** are defined in mercury_types.h and mercury_float.h.
-*/
-
-/*
-** The MR_Word type, which is used for representing user-defined
-** types when we're using the low-level data representation,
-** is defined in runtime/mercury_types.h.
-*/
-
-/*
-** The MR_Box type, which is used for representing polymorphic
-** types, is defined in runtime/mercury_types.h.
-*/
-
-/*
-** The MR_ClosurePtr type is used for representing higher-order types.
-*/
-typedef const MR_Closure *MR_ClosurePtr;
-
-/*
-** Define some names for types that differ depending
-** on whether --high-level-data is enabled.
-** These types all correspond to Mercury data types.
-** Some of the have `Mercury_' in their name, to distinguish
-** them from the corresponding C data type.
-** E.g. `MR_Mercury_Type_Info' (below) is the abstract type that the
-** Mercury compiler generates for a type_info argument, whereas
-** `MR_TypeInfo' (defined in runtime/mercury_type_info.h) is the
-** concrete C type that is used by the C code in the runtime.
-*/
-#ifdef MR_HIGHLEVEL_DATA
- typedef MR_Integer /* really `enum mercury__builtin__comparison_result_0' */
- MR_Comparison_Result;
- typedef struct mercury__builtin__void_0_s * MR_Void;
- typedef struct mercury__builtin__c_pointer_0_s * MR_C_Pointer;
- typedef struct mercury__private_builtin__heap_pointer_0_s * MR_Heap_Pointer;
- typedef MR_ClosurePtr MR_Pred;
- typedef MR_ClosurePtr MR_Func;
- typedef struct mercury__array__array_1_s * MR_Array;
- typedef struct mercury__std_util__univ_0_s * MR_Univ;
- typedef struct mercury__type_desc__type_desc_0_s * MR_Type_Desc;
- typedef struct mercury__type_desc__type_ctor_desc_0_s * MR_Type_Ctor_Desc;
- typedef struct mercury__private_builtin__type_info_1_s *
- MR_Mercury_Type_Info;
- typedef struct mercury__private_builtin__type_ctor_info_1_s *
- MR_Mercury_Type_Ctor_Info;
- typedef struct mercury__private_builtin__typeclass_info_1_s *
- MR_Mercury_TypeClass_Info;
- typedef struct mercury__private_builtin__base_typeclass_info_1_s *
- MR_Mercury_Base_TypeClass_Info;
-#else
- /* for --no-high-level-data, they're all just `MR_Word' */
- typedef MR_Word MR_Comparison_Result;
- typedef MR_Word MR_Void;
- typedef MR_Word MR_C_Pointer;
- typedef MR_Word MR_Heap_Pointer;
- typedef MR_Word MR_Pred;
- typedef MR_Word MR_Func;
- typedef MR_Word MR_Array;
- typedef MR_Word MR_Univ;
- typedef MR_Word MR_Type_Desc;
- typedef MR_Word MR_Type_Ctor_Desc;
- typedef MR_Word MR_Mercury_Type_Info;
- typedef MR_Word MR_Mercury_Type_Ctor_Info;
- typedef MR_Word MR_Mercury_TypeClass_Info;
- typedef MR_Word MR_Mercury_Base_TypeClass_Info;
-#endif
-
-/*
-** Tuples are always just arrays of polymorphic terms.
-*/
-typedef MR_Box *MR_Tuple;
-
-/*
** The chain of stack frames, used for accurate GC.
**
** Any changes to this struct may require changes to
@@ -416,95 +333,6 @@
MR_restore_registers(); \
} \
} while (0)
-
-/*---------------------------------------------------------------------------*/
-/*
-** Function declarations
-*/
-
-MR_bool MR_CALL mercury__builtin__unify_2_p_0(MR_Mercury_Type_Info,
- MR_Box, MR_Box);
-void MR_CALL mercury__builtin__compare_3_p_0(MR_Mercury_Type_Info,
- MR_Comparison_Result *, MR_Box, MR_Box);
-void MR_CALL mercury__builtin__compare_3_p_1(MR_Mercury_Type_Info,
- MR_Comparison_Result *, MR_Box, MR_Box);
-void MR_CALL mercury__builtin__compare_3_p_2(MR_Mercury_Type_Info,
- 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);
-MR_bool MR_CALL mercury__builtin____Unify____string_0_0(MR_String x,
- MR_String y);
-MR_bool MR_CALL mercury__builtin____Unify____float_0_0(MR_Float x, MR_Float y);
-MR_bool MR_CALL mercury__builtin____Unify____character_0_0(MR_Char x, MR_Char);
-MR_bool MR_CALL mercury__builtin____Unify____void_0_0(MR_Void x, MR_Void y);
-MR_bool MR_CALL mercury__builtin____Unify____c_pointer_0_0(
- MR_C_Pointer x, MR_C_Pointer y);
-MR_bool MR_CALL mercury__private_builtin____Unify____heap_pointer_0_0(
- MR_Heap_Pointer x, MR_Heap_Pointer y);
-MR_bool MR_CALL mercury__builtin____Unify____func_0_0(MR_Func x, MR_Func y);
-MR_bool MR_CALL mercury__builtin____Unify____pred_0_0(MR_Pred x, MR_Pred y);
-MR_bool MR_CALL mercury__builtin____Unify____tuple_0_0(
- MR_Mercury_Type_Info type_info, MR_Tuple x, MR_Tuple y);
-MR_bool MR_CALL mercury__type_desc____Unify____type_ctor_desc_0_0(
- MR_Type_Ctor_Desc x, MR_Type_Ctor_Desc y);
-MR_bool MR_CALL mercury__type_desc____Unify____type_desc_0_0(
- MR_Type_Desc x, MR_Type_Desc y);
-MR_bool MR_CALL mercury__private_builtin____Unify____type_ctor_info_1_0(
- MR_Mercury_Type_Info type_info,
- MR_Mercury_Type_Ctor_Info x, MR_Mercury_Type_Ctor_Info y);
-MR_bool MR_CALL mercury__private_builtin____Unify____type_info_1_0(
- MR_Mercury_Type_Info type_info,
- MR_Mercury_Type_Info x, MR_Mercury_Type_Info y);
-MR_bool MR_CALL mercury__private_builtin____Unify____typeclass_info_1_0(
- MR_Mercury_Type_Info type_info,
- MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y);
-MR_bool MR_CALL mercury__private_builtin____Unify____base_typeclass_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Mercury_Base_TypeClass_Info x,
- MR_Mercury_Base_TypeClass_Info y);
-
-void MR_CALL mercury__builtin____Compare____int_0_0(
- MR_Comparison_Result *result, MR_Integer x, MR_Integer y);
-void MR_CALL mercury__builtin____Compare____string_0_0(
- MR_Comparison_Result *result, MR_String x, MR_String y);
-void MR_CALL mercury__builtin____Compare____float_0_0(
- MR_Comparison_Result *result, MR_Float x, MR_Float y);
-void MR_CALL mercury__builtin____Compare____character_0_0(
- MR_Comparison_Result *result, MR_Char x, MR_Char y);
-void MR_CALL mercury__builtin____Compare____void_0_0(
- MR_Comparison_Result *result, MR_Void x, MR_Void y);
-void MR_CALL mercury__builtin____Compare____c_pointer_0_0(
- MR_Comparison_Result *result, MR_C_Pointer x, MR_C_Pointer y);
-void MR_CALL mercury__private_builtin____Compare____heap_pointer_0_0(
- MR_Comparison_Result *result, MR_Heap_Pointer x, MR_Heap_Pointer y);
-void MR_CALL mercury__builtin____Compare____func_0_0(
- MR_Comparison_Result *result, MR_Func x, MR_Func y);
-void MR_CALL mercury__builtin____Compare____pred_0_0(
- MR_Comparison_Result *result, MR_Pred x, MR_Pred y);
-void MR_CALL mercury__builtin____Compare____tuple_0_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Tuple x, MR_Tuple y);
-void MR_CALL mercury__type_desc____Compare____type_ctor_desc_0_0(
- MR_Comparison_Result *result,
- MR_Type_Ctor_Desc x, MR_Type_Ctor_Desc y);
-void MR_CALL mercury__type_desc____Compare____type_desc_0_0(
- MR_Comparison_Result *result, MR_Type_Desc x, MR_Type_Desc y);
-void MR_CALL mercury__private_builtin____Compare____type_ctor_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Mercury_Type_Ctor_Info x, MR_Mercury_Type_Ctor_Info y);
-void MR_CALL mercury__private_builtin____Compare____type_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Mercury_Type_Info x, MR_Mercury_Type_Info y);
-void MR_CALL mercury__private_builtin____Compare____typeclass_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y);
-void MR_CALL mercury__private_builtin____Compare____base_typeclass_info_1_0(
- MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
- MR_Mercury_Base_TypeClass_Info x, MR_Mercury_Base_TypeClass_Info y);
/*---------------------------------------------------------------------------*/
Index: runtime/mercury_bootstrap.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_bootstrap.h,v
retrieving revision 1.30
diff -u -b -r1.30 mercury_bootstrap.h
--- runtime/mercury_bootstrap.h 2002/08/01 11:52:25 1.30
+++ runtime/mercury_bootstrap.h 2002/08/02 02:12:25
@@ -108,12 +108,38 @@
** of builtin types.
*/
-#define mercury_data_builtin__type_ctor_info_func_0 \
- mercury_data___type_ctor_info_func_0
-#define mercury_data_builtin__type_ctor_info_pred_0 \
- mercury_data___type_ctor_info_pred_0
-#define mercury_data_builtin__type_ctor_info_tuple_0 \
- mercury_data___type_ctor_info_tuple_0
+#define mercury_data___type_ctor_info_int_0 \
+ mercury_data_builtin__type_ctor_info_int_0
+#define mercury_data___type_ctor_info_string_0 \
+ mercury_data_builtin__type_ctor_info_string_0
+#define mercury_data___type_ctor_info_float_0 \
+ mercury_data_builtin__type_ctor_info_float_0
+#define mercury_data___type_ctor_info_character_0 \
+ mercury_data_builtin__type_ctor_info_character_0
+#define mercury_data___type_ctor_info_void_0 \
+ mercury_data_builtin__type_ctor_info_void_0
+#define mercury_data___type_ctor_info_c_pointer_0 \
+ mercury_data_builtin__type_ctor_info_c_pointer_0
+#define mercury_data___type_ctor_info_func_0 \
+ mercury_data_builtin__type_ctor_info_func_0
+#define mercury_data___type_ctor_info_pred_0 \
+ mercury_data_builtin__type_ctor_info_pred_0
+#define mercury_data___type_ctor_info_tuple_0 \
+ mercury_data_builtin__type_ctor_info_tuple_0
+#define mercury_data___type_ctor_info_hp_0 \
+ mercury_data_builtin__type_ctor_info_hp_0
+#define mercury_data___type_ctor_info_curfr_0 \
+ mercury_data_builtin__type_ctor_info_curfr_0
+#define mercury_data___type_ctor_info_maxfr_0 \
+ mercury_data_builtin__type_ctor_info_maxfr_0
+#define mercury_data___type_ctor_info_redofr_0 \
+ mercury_data_builtin__type_ctor_info_redofr_0
+#define mercury_data___type_ctor_info_redoip_0 \
+ mercury_data_builtin__type_ctor_info_redoip_0
+#define mercury_data___type_ctor_info_trailptr_0 \
+ mercury_data_builtin__type_ctor_info_trailptr_0
+#define mercury_data___type_ctor_info_ticket_0 \
+ mercury_data_builtin__type_ctor_info_ticket_0
/*
** This stuff is enabled by default,
Index: runtime/mercury_builtin_types.c
===================================================================
RCS file: mercury_builtin_types.c
diff -N mercury_builtin_types.c
--- /dev/null Tue Aug 6 19:10:00 2002
+++ mercury_builtin_types.c Sat Aug 3 20:49:28 2002
@@ -0,0 +1,1332 @@
+/*
+** Copyright (C) 2002 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.
+*/
+
+/*
+** mercury_builtin_types.c
+**
+** This file defines the operations on the builtin types of Mercury.
+** It has separate implementations for the high level and low level C back
+** ends.
+*/
+
+#ifdef MR_HIGHLEVEL_CODE
+ #include "mercury.h"
+#else
+ #include "mercury_imp.h"
+#endif
+
+#include "mercury_type_info.h" /* for MR_TYPECTOR_REP* */
+#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_deep_profiling.h"
+#include "mercury_deep_profiling_hand.h"
+#include "mercury_profiling_builtin.h"
+#include "mercury_builtin_types.h"
+
+/*---------------------------------------------------------------------------*/
+
+#ifdef MR_DEEP_PROFILING
+
+MR_DEFINE_PROC_STATICS(builtin, int, 0);
+MR_DEFINE_PROC_STATICS(builtin, string, 0);
+MR_DEFINE_PROC_STATICS(builtin, float, 0);
+MR_DEFINE_PROC_STATICS(builtin, character, 0);
+MR_DEFINE_PROC_STATICS(builtin, void, 0);
+MR_DEFINE_PROC_STATICS(builtin, c_pointer, 0);
+MR_DEFINE_PROC_STATICS(builtin, pred, 0);
+MR_DEFINE_PROC_STATICS(builtin, func, 0);
+MR_DEFINE_PROC_STATICS(builtin, tuple, 0);
+MR_DEFINE_PROC_STATICS(builtin, succip, 0);
+MR_DEFINE_PROC_STATICS(builtin, hp, 0);
+MR_DEFINE_PROC_STATICS(builtin, curfr, 0);
+MR_DEFINE_PROC_STATICS(builtin, maxfr, 0);
+MR_DEFINE_PROC_STATICS(builtin, redofr, 0);
+MR_DEFINE_PROC_STATICS(builtin, redoip, 0);
+MR_DEFINE_PROC_STATICS(builtin, trailptr, 0);
+MR_DEFINE_PROC_STATICS(builtin, ticket, 0);
+MR_DEFINE_PROC_STATICS(private_builtin, heap_pointer, 0);
+MR_DEFINE_PROC_STATICS(private_builtin, type_ctor_info, 1);
+MR_DEFINE_PROC_STATICS(private_builtin, type_info, 1);
+MR_DEFINE_PROC_STATICS(private_builtin, base_typeclass_info, 1);
+MR_DEFINE_PROC_STATICS(private_builtin, typeclass_info, 1);
+MR_DEFINE_PROC_STATICS(type_desc, type_ctor_desc, 0);
+MR_DEFINE_PROC_STATICS(type_desc, type_desc, 0);
+
+#endif
+
+/*
+** Define MR_TypeCtorInfos for the builtin types
+*/
+
+MR_DEFINE_TYPE_CTOR_INFO(builtin, int, 0, INT);
+MR_DEFINE_TYPE_CTOR_INFO(builtin, character, 0, CHAR);
+MR_DEFINE_TYPE_CTOR_INFO(builtin, string, 0, STRING);
+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);
+#ifndef MR_HIGHLEVEL_CODE
+MR_DEFINE_TYPE_CTOR_INFO(builtin, succip, 0, SUCCIP);
+MR_DEFINE_TYPE_CTOR_INFO(builtin, hp, 0, HP);
+MR_DEFINE_TYPE_CTOR_INFO(builtin, curfr, 0, CURFR);
+MR_DEFINE_TYPE_CTOR_INFO(builtin, maxfr, 0, MAXFR);
+MR_DEFINE_TYPE_CTOR_INFO(builtin, redofr, 0, REDOFR);
+MR_DEFINE_TYPE_CTOR_INFO(builtin, redoip, 0, REDOIP);
+MR_DEFINE_TYPE_CTOR_INFO(builtin, trailptr, 0, TRAIL_PTR);
+MR_DEFINE_TYPE_CTOR_INFO(builtin, ticket, 0, TICKET);
+#endif
+
+MR_DEFINE_TYPE_CTOR_INFO(private_builtin, heap_pointer, 0, HP);
+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(type_desc, type_ctor_desc, 0, TYPECTORDESC);
+MR_DEFINE_TYPE_CTOR_INFO(type_desc, type_desc, 0, TYPEDESC);
+
+/*---------------------------------------------------------------------------*/
+
+#ifdef MR_HIGHLEVEL_CODE
+
+/*---------------------------------------------------------------------------*/
+/*---------------------------------------------------------------------------*/
+/*
+** Definitions of the type-specific __Unify__ and __Compare__ procedures
+** for the builtin types.
+**
+** There are two versions of each of these. The first version, __Unify__,
+** which is called when the type is known at compile time,
+** has the arguments unboxed. The second version, do_unify_, which is
+** stored in the type_ctor_info and called from the generic
+** unify/2 or compare/3, is a wrapper that has the arguments boxed,
+** and just calls the first version.
+*/
+
+/*---------------------------------------------------------------------------*/
+/*
+** Unification procedures with the arguments unboxed.
+*/
+
+MR_bool MR_CALL
+mercury__builtin____Unify____int_0_0(MR_Integer x, MR_Integer y)
+{
+ return x == y;
+}
+
+MR_bool MR_CALL
+mercury__builtin____Unify____string_0_0(MR_String x, MR_String y)
+{
+ return strcmp(x, y) == 0;
+}
+
+MR_bool MR_CALL
+mercury__builtin____Unify____float_0_0(MR_Float x, MR_Float y)
+{
+ /* XXX what should this function do when x and y are both NaNs? */
+ return x == y;
+}
+
+MR_bool MR_CALL
+mercury__builtin____Unify____character_0_0(MR_Char x, MR_Char y)
+{
+ return x == y;
+}
+
+MR_bool MR_CALL
+mercury__builtin____Unify____void_0_0(MR_Void x, MR_Void y)
+{
+ MR_fatal_error("called unify/2 for `void' type");
+}
+
+MR_bool MR_CALL
+mercury__builtin____Unify____c_pointer_0_0(MR_C_Pointer x, MR_C_Pointer y)
+{
+ return (void *) x == (void *) y;
+}
+
+MR_bool MR_CALL
+mercury__private_builtin____Unify____heap_pointer_0_0(MR_Heap_Pointer x,
+ MR_Heap_Pointer y)
+{
+ MR_fatal_error(
+ "called unify/2 for `private_builtin:heap_pointer' type");
+}
+
+MR_bool MR_CALL
+mercury__builtin____Unify____func_0_0(MR_Func x, MR_Func y)
+{
+ MR_fatal_error("called unify/2 for `func' type");
+}
+
+MR_bool MR_CALL
+mercury__builtin____Unify____pred_0_0(MR_Pred x, MR_Pred y)
+{
+ MR_fatal_error("called unify/2 for `pred' type");
+}
+
+MR_bool MR_CALL
+mercury__builtin____Unify____tuple_0_0(MR_Tuple x, MR_Tuple y)
+{
+ MR_fatal_error("called unify/2 for `tuple' type");
+}
+
+MR_bool MR_CALL
+mercury__type_desc____Unify____type_ctor_desc_0_0(
+ MR_Type_Ctor_Desc x, MR_Type_Ctor_Desc y)
+{
+ return MR_unify_type_ctor_desc((MR_TypeCtorDesc) x,
+ (MR_TypeCtorDesc) y);
+}
+
+MR_bool MR_CALL
+mercury__type_desc____Unify____type_desc_0_0(MR_Type_Desc x, MR_Type_Desc y)
+{
+ return MR_unify_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
+}
+
+MR_bool MR_CALL
+mercury__private_builtin____Unify____type_ctor_info_1_0(
+ MR_Mercury_Type_Info type_info,
+ MR_Mercury_Type_Ctor_Info x, MR_Mercury_Type_Ctor_Info y)
+{
+ return MR_unify_type_ctor_info((MR_TypeCtorInfo) x,
+ (MR_TypeCtorInfo) y);
+}
+
+MR_bool MR_CALL
+mercury__private_builtin____Unify____type_info_1_0(
+ MR_Mercury_Type_Info type_info,
+ MR_Mercury_Type_Info x, MR_Mercury_Type_Info y)
+{
+ return MR_unify_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
+}
+
+MR_bool MR_CALL
+mercury__private_builtin____Unify____typeclass_info_1_0(
+ MR_Mercury_Type_Info type_info,
+ MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y)
+{
+ MR_fatal_error("called unify/2 for `typeclass_info' type");
+}
+
+MR_bool MR_CALL
+mercury__private_builtin____Unify____base_typeclass_info_1_0(
+ MR_Mercury_Type_Info type_info,
+ MR_Mercury_Base_TypeClass_Info x, MR_Mercury_Base_TypeClass_Info y)
+{
+ MR_SORRY("unify for base_typeclass_info");
+}
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** Comparison procedures with the arguments unboxed.
+*/
+
+void MR_CALL
+mercury__builtin____Compare____int_0_0(
+ MR_Comparison_Result *result, MR_Integer x, MR_Integer y)
+{
+ *result = (x > y ? MR_COMPARE_GREATER :
+ x == y ? MR_COMPARE_EQUAL :
+ MR_COMPARE_LESS);
+}
+
+void MR_CALL
+mercury__builtin____Compare____string_0_0(MR_Comparison_Result *result,
+ MR_String x, MR_String y)
+{
+ int res = strcmp(x, y);
+ *result = (res > 0 ? MR_COMPARE_GREATER :
+ res == 0 ? MR_COMPARE_EQUAL :
+ MR_COMPARE_LESS);
+}
+
+void MR_CALL
+mercury__builtin____Compare____float_0_0(
+ MR_Comparison_Result *result, MR_Float x, MR_Float y)
+{
+ /* XXX what should this function do when x and y are both NaNs? */
+ *result = (x > y ? MR_COMPARE_GREATER :
+ x == y ? MR_COMPARE_EQUAL :
+ x < y ? MR_COMPARE_LESS :
+ (MR_fatal_error("incomparable floats in compare/3"),
+ MR_COMPARE_EQUAL));
+}
+
+void MR_CALL
+mercury__builtin____Compare____character_0_0(
+ MR_Comparison_Result *result, MR_Char x, MR_Char y)
+{
+ *result = (x > y ? MR_COMPARE_GREATER :
+ x == y ? MR_COMPARE_EQUAL :
+ MR_COMPARE_LESS);
+}
+
+void MR_CALL
+mercury__builtin____Compare____void_0_0(MR_Comparison_Result *result,
+ MR_Void x, MR_Void y)
+{
+ MR_fatal_error("called compare/3 for `void' type");
+}
+
+void MR_CALL
+mercury__builtin____Compare____c_pointer_0_0(
+ MR_Comparison_Result *result, MR_C_Pointer x, MR_C_Pointer y)
+{
+ *result =
+ ( (void *) x == (void *) y ? MR_COMPARE_EQUAL
+ : (void *) x < (void *) y ? MR_COMPARE_LESS
+ : MR_COMPARE_GREATER
+ );
+}
+
+void MR_CALL
+mercury__private_builtin____Compare____heap_pointer_0_0(
+ MR_Comparison_Result *result, MR_Heap_Pointer x, MR_Heap_Pointer y)
+{
+ MR_fatal_error(
+ "called compare/3 for `private_builtin:heap_pointer' type");
+}
+
+void MR_CALL
+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");
+}
+
+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");
+}
+
+void MR_CALL
+mercury__builtin____Compare____tuple_0_0(MR_Comparison_Result *result,
+ MR_Tuple x, MR_Tuple y)
+{
+ MR_fatal_error("called compare/3 for `tuple' type");
+}
+
+void MR_CALL
+mercury__type_desc____Compare____type_ctor_desc_0_0(
+ MR_Comparison_Result *result, MR_Type_Ctor_Desc x, MR_Type_Ctor_Desc y)
+{
+ *result = MR_compare_type_ctor_desc((MR_TypeCtorDesc) x,
+ (MR_TypeCtorDesc) y);
+}
+
+void MR_CALL
+mercury__type_desc____Compare____type_desc_0_0(
+ MR_Comparison_Result *result, MR_Type_Desc x, MR_Type_Desc y)
+{
+ *result = MR_compare_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
+}
+
+void MR_CALL
+mercury__private_builtin____Compare____type_ctor_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Mercury_Type_Ctor_Info x, MR_Mercury_Type_Ctor_Info y)
+{
+ *result = MR_compare_type_ctor_info((MR_TypeCtorInfo) x,
+ (MR_TypeCtorInfo) y);
+}
+
+void MR_CALL
+mercury__private_builtin____Compare____type_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Mercury_Type_Info x, MR_Mercury_Type_Info y)
+{
+ *result = MR_compare_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
+}
+
+void MR_CALL
+mercury__private_builtin____Compare____typeclass_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y)
+{
+ MR_fatal_error("called compare/3 for `typeclass_info' type");
+}
+
+void MR_CALL
+mercury__private_builtin____Compare____base_typeclass_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Mercury_Base_TypeClass_Info x, MR_Mercury_Base_TypeClass_Info y)
+{
+ MR_SORRY("compare for base_typeclass_info");
+}
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** Unification procedures with the arguments boxed.
+** These are just wrappers which call the unboxed version.
+*/
+
+static MR_bool MR_CALL
+mercury__builtin__do_unify__int_0_0(MR_Box x, MR_Box y)
+{
+ return mercury__builtin____Unify____int_0_0(
+ (MR_Integer) x, (MR_Integer) y);
+}
+
+static MR_bool MR_CALL
+mercury__builtin__do_unify__string_0_0(MR_Box x, MR_Box y)
+{
+ return mercury__builtin____Unify____string_0_0(
+ (MR_String) x, (MR_String) y);
+}
+
+static MR_bool MR_CALL
+mercury__builtin__do_unify__float_0_0(MR_Box x, MR_Box y)
+{
+ return mercury__builtin____Unify____float_0_0(
+ MR_unbox_float(x), MR_unbox_float(y));
+}
+
+static MR_bool MR_CALL
+mercury__builtin__do_unify__character_0_0(MR_Box x, MR_Box y)
+{
+ return mercury__builtin____Unify____character_0_0(
+ (MR_Char) (MR_Word) x, (MR_Char) (MR_Word) y);
+}
+
+static MR_bool MR_CALL
+mercury__builtin__do_unify__void_0_0(MR_Box x, MR_Box y)
+{
+ MR_fatal_error("called unify/2 for `void' type");
+}
+
+static MR_bool MR_CALL
+mercury__builtin__do_unify__c_pointer_0_0(MR_Box x, MR_Box y)
+{
+ return mercury__builtin____Unify____c_pointer_0_0(
+ (MR_C_Pointer) x, (MR_C_Pointer) y);
+}
+
+static MR_bool MR_CALL
+mercury__private_builtin__do_unify__heap_pointer_0_0(MR_Box x, MR_Box y)
+{
+ return mercury__private_builtin____Unify____heap_pointer_0_0(
+ (MR_Heap_Pointer) x, (MR_Heap_Pointer) y);
+}
+
+static MR_bool MR_CALL
+mercury__builtin__do_unify__func_0_0(MR_Box x, MR_Box y)
+{
+ MR_fatal_error("called unify/2 for `func' type");
+}
+
+static MR_bool MR_CALL
+mercury__builtin__do_unify__pred_0_0(MR_Box x, MR_Box y)
+{
+ MR_fatal_error("called unify/2 for `pred' type");
+}
+
+static MR_bool MR_CALL
+mercury__builtin__do_unify__tuple_0_0(MR_Box x, MR_Box y)
+{
+ return mercury__builtin____Unify____tuple_0_0(
+ (MR_Tuple) x, (MR_Tuple) y);
+}
+
+static MR_bool MR_CALL
+mercury__type_desc__do_unify__type_ctor_desc_0_0(MR_Box x, MR_Box y)
+{
+ return mercury__type_desc____Unify____type_ctor_desc_0_0(
+ (MR_Type_Ctor_Desc) x, (MR_Type_Ctor_Desc) y);
+}
+
+static MR_bool MR_CALL
+mercury__type_desc__do_unify__type_desc_0_0(MR_Box x, MR_Box y)
+{
+ return mercury__type_desc____Unify____type_desc_0_0(
+ (MR_Type_Desc) x, (MR_Type_Desc) y);
+}
+
+static MR_bool MR_CALL
+mercury__private_builtin__do_unify__type_ctor_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Box x, MR_Box y)
+{
+ return mercury__private_builtin____Unify____type_ctor_info_1_0(
+ type_info, (MR_Mercury_Type_Ctor_Info) x, (MR_Mercury_Type_Ctor_Info) y);
+}
+
+static MR_bool MR_CALL
+mercury__private_builtin__do_unify__type_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Box x, MR_Box y)
+{
+ return mercury__private_builtin____Unify____type_info_1_0(
+ type_info, (MR_Mercury_Type_Info) x, (MR_Mercury_Type_Info) y);
+}
+
+static MR_bool MR_CALL
+mercury__private_builtin__do_unify__typeclass_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Box x, MR_Box y)
+{
+ return mercury__private_builtin____Unify____typeclass_info_1_0(
+ type_info, (MR_Mercury_TypeClass_Info) x, (MR_Mercury_TypeClass_Info) y);
+}
+
+static MR_bool MR_CALL
+mercury__private_builtin__do_unify__base_typeclass_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Box x, MR_Box y)
+{
+ return mercury__private_builtin____Unify____base_typeclass_info_1_0(
+ type_info,
+ (MR_Mercury_Base_TypeClass_Info) x,
+ (MR_Mercury_Base_TypeClass_Info) y);
+}
+
+/*---------------------------------------------------------------------------*/
+
+/*
+** Comparison procedures with the arguments boxed.
+** These are just wrappers which call the unboxed version.
+*/
+
+static void MR_CALL
+mercury__builtin__do_compare__int_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ mercury__builtin____Compare____int_0_0(result,
+ (MR_Integer) x, (MR_Integer) y);
+}
+
+static void MR_CALL
+mercury__builtin__do_compare__string_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ mercury__builtin____Compare____string_0_0(result,
+ (MR_String) x, (MR_String) y);
+}
+
+static void MR_CALL
+mercury__builtin__do_compare__float_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ mercury__builtin____Compare____float_0_0(result,
+ MR_unbox_float(x), MR_unbox_float(y));
+}
+
+static void MR_CALL
+mercury__builtin__do_compare__character_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ mercury__builtin____Compare____character_0_0(
+ result, (MR_Char) (MR_Word) x, (MR_Char) (MR_Word) y);
+}
+
+static void MR_CALL
+mercury__builtin__do_compare__void_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ MR_fatal_error("called compare/3 for `void' type");
+}
+
+static void MR_CALL
+mercury__builtin__do_compare__c_pointer_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ mercury__builtin____Compare____c_pointer_0_0(
+ result, (MR_C_Pointer) x, (MR_C_Pointer) y);
+}
+
+static void MR_CALL
+mercury__private_builtin__do_compare__heap_pointer_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ MR_fatal_error(
+ "called compare/3 for `private_builtin:heap_pointer' type");
+}
+
+static void MR_CALL
+mercury__builtin__do_compare__func_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ MR_fatal_error("called compare/3 for `func' type");
+}
+
+static void MR_CALL
+mercury__builtin__do_compare__pred_0_0(MR_Comparison_Result *result,
+ MR_Box x, MR_Box y)
+{
+ MR_fatal_error("called compare/3 for `pred' type");
+}
+
+static void MR_CALL
+mercury__builtin__do_compare__tuple_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ mercury__builtin____Compare____tuple_0_0(
+ result, (MR_Tuple) x, (MR_Tuple) y);
+}
+
+static void MR_CALL
+mercury__type_desc__do_compare__type_ctor_desc_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ mercury__type_desc____Compare____type_ctor_desc_0_0(
+ result, (MR_Type_Ctor_Desc) x, (MR_Type_Ctor_Desc) y);
+}
+
+static void MR_CALL
+mercury__type_desc__do_compare__type_desc_0_0(
+ MR_Comparison_Result *result, MR_Box x, MR_Box y)
+{
+ mercury__type_desc____Compare____type_desc_0_0(
+ result, (MR_Type_Desc) x, (MR_Type_Desc) y);
+}
+
+static void MR_CALL
+mercury__private_builtin__do_compare__type_ctor_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Box x, MR_Box y)
+{
+ mercury__private_builtin____Compare____type_ctor_info_1_0(
+ type_info, result,
+ (MR_Mercury_Type_Ctor_Info) x, (MR_Mercury_Type_Ctor_Info) y);
+}
+
+static void MR_CALL
+mercury__private_builtin__do_compare__type_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Box x, MR_Box y)
+{
+ mercury__private_builtin____Compare____type_info_1_0(
+ type_info, result, (MR_Mercury_Type_Info) x, (MR_Mercury_Type_Info) y);
+}
+
+static void MR_CALL
+mercury__private_builtin__do_compare__typeclass_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Box x, MR_Box y)
+{
+ mercury__private_builtin____Compare____typeclass_info_1_0(
+ type_info, result,
+ (MR_Mercury_TypeClass_Info) x, (MR_Mercury_TypeClass_Info) y);
+}
+
+static void MR_CALL
+mercury__private_builtin__do_compare__base_typeclass_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Box x, MR_Box y)
+{
+ mercury__private_builtin____Compare____base_typeclass_info_1_0(
+ type_info, result,
+ (MR_Mercury_Base_TypeClass_Info) x,
+ (MR_Mercury_Base_TypeClass_Info) y);
+}
+
+#else /* ! MR_HIGHLEVEL_CODE */
+
+MR_MODULE_STATIC_OR_EXTERN MR_ModuleFunc mercury_builtin_types;
+
+MR_UNIFY_COMPARE_DEFNS(builtin, int, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, string, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, float, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, character, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, void, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, c_pointer, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, pred, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, func, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, tuple, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, succip, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, hp, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, curfr, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, maxfr, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, redofr, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, redoip, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, trailptr, 0)
+MR_UNIFY_COMPARE_DEFNS(builtin, ticket, 0)
+MR_UNIFY_COMPARE_DEFNS(private_builtin, heap_pointer, 0)
+MR_UNIFY_COMPARE_DEFNS(private_builtin, type_ctor_info, 1)
+MR_UNIFY_COMPARE_DEFNS(private_builtin, type_info, 1)
+MR_UNIFY_COMPARE_DEFNS(private_builtin, base_typeclass_info, 1)
+MR_UNIFY_COMPARE_DEFNS(private_builtin, typeclass_info, 1)
+MR_UNIFY_COMPARE_DEFNS(type_desc, type_ctor_desc, 0)
+MR_UNIFY_COMPARE_DEFNS(type_desc, type_desc, 0)
+
+MR_BEGIN_MODULE(mercury_builtin_types)
+ MR_UNIFY_COMPARE_LABELS(builtin, int, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, string, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, float, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, character, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, void, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, c_pointer, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, pred, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, func, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, tuple, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, succip, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, hp, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, curfr, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, maxfr, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, redofr, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, trailptr, 0)
+ MR_UNIFY_COMPARE_LABELS(builtin, ticket, 0)
+ MR_UNIFY_COMPARE_LABELS(private_builtin, heap_pointer, 0)
+ MR_UNIFY_COMPARE_LABELS(private_builtin, type_ctor_info, 1)
+ MR_UNIFY_COMPARE_LABELS(private_builtin, type_info, 1)
+ MR_UNIFY_COMPARE_LABELS(private_builtin, base_typeclass_info, 1)
+ MR_UNIFY_COMPARE_LABELS(private_builtin, typeclass_info, 1)
+MR_BEGIN_CODE
+
+/*****************************************************************************/
+
+#define module builtin
+#define type int
+#define arity 0
+#define unify_code MR_r1 = ((MR_Integer) MR_r1 == (MR_Integer) MR_r2);
+#define compare_code MR_r1 = ((MR_Integer) MR_r1 == (MR_Integer) MR_r2 ? \
+ MR_COMPARE_EQUAL : \
+ (MR_Integer) MR_r1 < (MR_Integer) MR_r2 ? \
+ MR_COMPARE_LESS : \
+ MR_COMPARE_GREATER);
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+#define module builtin
+#define type string
+#define arity 0
+#define unify_code MR_r1 = strcmp((char *) MR_r1, (char *) MR_r2) == 0;
+#define compare_code int result = strcmp((char *) MR_r1, (char *) MR_r2); \
+ MR_r1 = (result > 0) ? MR_COMPARE_GREATER : \
+ (result < 0 ? MR_COMPARE_LESS : \
+ MR_COMPARE_EQUAL);
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+#define module builtin
+#define type float
+#define arity 0
+#define unify_code MR_r1 = (MR_word_to_float(MR_r1) == MR_word_to_float(MR_r2));
+#define compare_code MR_Float f1 = MR_word_to_float(MR_r1); \
+ MR_Float f2 = MR_word_to_float(MR_r2); \
+ MR_r1 = ((f1 > f2) ? MR_COMPARE_GREATER : \
+ (f1 < f2) ? MR_COMPARE_LESS : \
+ MR_COMPARE_EQUAL);
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+#define module builtin
+#define type character
+#define arity 0
+#define unify_code MR_r1 = ((MR_Char) MR_r1 == (MR_Char) MR_r2);
+#define compare_code MR_r1 = ((MR_Char) MR_r1 > (MR_Char) MR_r2 ? \
+ MR_COMPARE_GREATER : \
+ (MR_Char) MR_r1 < (MR_Char) MR_r2 ? \
+ MR_COMPARE_LESS : \
+ MR_COMPARE_EQUAL);
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+#define module builtin
+#define type void
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `void' type");
+#define compare_code MR_fatal_error("called compare/3 for `void' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+ /*
+ ** For c_pointer, we assume that equality and comparison
+ ** can be based on object identity (i.e. using address comparisons).
+ ** This is correct for types like io__stream, and necessary since
+ ** the io__state contains a map(io__stream, filename).
+ ** However, it might not be correct in general...
+ */
+
+#define module builtin
+#define type c_pointer
+#define arity 0
+#define unify_code MR_r1 = (MR_r1 == MR_r2);
+#define compare_code MR_r1 = (MR_r1 > MR_r2 ? MR_COMPARE_GREATER : \
+ MR_r1 < MR_r2 ? MR_COMPARE_LESS : \
+ MR_COMPARE_EQUAL);
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* Predicates cannot be unified or compared */
+
+#define module builtin
+#define type pred
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `pred' type");
+#define compare_code MR_fatal_error("called compare/3 for `pred' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* Functions cannot be unified or compared */
+
+#define module builtin
+#define type func
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `func' type");
+#define compare_code MR_fatal_error("called compare/3 for `func' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* Unifications and comparisons of tuples are handled by the generic code */
+
+#define module builtin
+#define type tuple
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `tuple' type");
+#define compare_code MR_fatal_error("called compare/3 for `tuple' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of succips are handled by the generic code */
+
+#define module builtin
+#define type succip
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `succip' type");
+#define compare_code MR_fatal_error("called compare/3 for `succip' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of hps are handled by the generic code */
+
+#define module builtin
+#define type hp
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `hp' type");
+#define compare_code MR_fatal_error("called compare/3 for `hp' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of curfrs are handled by the generic code */
+
+#define module builtin
+#define type curfr
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `curfr' type");
+#define compare_code MR_fatal_error("called compare/3 for `curfr' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of maxfrs are handled by the generic code */
+
+#define module builtin
+#define type maxfr
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `maxfr' type");
+#define compare_code MR_fatal_error("called compare/3 for `maxfr' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of redofrs are handled by the generic code */
+
+#define module builtin
+#define type redofr
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `redofr' type");
+#define compare_code MR_fatal_error("called compare/3 for `redofr' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of redoips are handled by the generic code */
+
+#define module builtin
+#define type redoip
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `redoip' type");
+#define compare_code MR_fatal_error("called compare/3 for `redoip' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of trailptrs are handled by the generic code */
+
+#define module builtin
+#define type trailptr
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `trailptr' type");
+#define compare_code MR_fatal_error("called compare/3 for `trailptr' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of tickets are handled by the generic code */
+
+#define module builtin
+#define type ticket
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `ticket' type");
+#define compare_code MR_fatal_error("called compare/3 for `ticket' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of heap_pointers are handled by the generic code */
+
+#define module private_builtin
+#define type heap_pointer
+#define arity 0
+#define unify_code MR_fatal_error("called unify/2 for `heap_pointer' type");
+#define compare_code MR_fatal_error("called compare/3 for `heap_pointer' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of type_ctor_infos are usually handled by generic code */
+
+#define module private_builtin
+#define type type_ctor_info
+#define arity 1
+#define unify_code int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_ctor_info( \
+ (MR_TypeCtorInfo) MR_r1, \
+ (MR_TypeCtorInfo) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = (comp == MR_COMPARE_EQUAL);
+#define compare_code int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_ctor_info( \
+ (MR_TypeCtorInfo) MR_r1, \
+ (MR_TypeCtorInfo) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = comp;
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of type_ctor_infos are usually handled by generic code */
+
+#define module private_builtin
+#define type type_info
+#define arity 1
+#define unify_code int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_info( \
+ (MR_TypeInfo) MR_r1, \
+ (MR_TypeInfo) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = (comp == MR_COMPARE_EQUAL);
+#define compare_code int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_info( \
+ (MR_TypeInfo) MR_r1, \
+ (MR_TypeInfo) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = comp;
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+#define module private_builtin
+#define type base_typeclass_info
+#define arity 1
+#define unify_code MR_fatal_error("called unify/2 for `base_typeclass_info' type");
+#define compare_code MR_fatal_error("called compare/3 for `base_typeclass_info' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+#define module private_builtin
+#define type typeclass_info
+#define arity 1
+#define unify_code MR_fatal_error("called unify/2 for `base_typeclass_info' type");
+#define compare_code MR_fatal_error("called compare/3 for `base_typeclass_info' type");
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of type_ctor_descs are usually handled by generic code */
+
+#define module type_desc
+#define type type_ctor_desc
+#define arity 0
+
+#define unify_code int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_ctor_desc( \
+ (MR_TypeCtorDesc) MR_r1, \
+ (MR_TypeCtorDesc) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = (comp == MR_COMPARE_EQUAL);
+
+#define compare_code int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_ctor_desc( \
+ (MR_TypeCtorDesc) MR_r1, \
+ (MR_TypeCtorDesc) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = comp;
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+/* unify and compare of type_ctor_descs are usually handled by generic code */
+
+#define module type_desc
+#define type type_desc
+#define arity 0
+
+#define unify_code int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_info( \
+ (MR_TypeInfo) MR_r1, \
+ (MR_TypeInfo) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = (comp == MR_COMPARE_EQUAL);
+
+#define compare_code int comp; \
+ \
+ MR_save_transient_registers(); \
+ comp = MR_compare_type_info( \
+ (MR_TypeInfo) MR_r1, \
+ (MR_TypeInfo) MR_r2); \
+ MR_restore_transient_registers(); \
+ MR_r1 = comp;
+
+#include "mercury_hand_unify_compare_body.h"
+
+#undef module
+#undef type
+#undef arity
+#undef unify_code
+#undef compare_code
+
+/*****************************************************************************/
+
+MR_END_MODULE
+
+#endif /* ! MR_HIGHLEVEL_CODE */
+
+/*---------------------------------------------------------------------------*/
+
+/*
+INIT mercury_sys_init_mercury_builtin_types
+ENDINIT
+*/
+
+/* forward decls, to suppress gcc -Wmissing-decl warnings. */
+void mercury_sys_init_mercury_builtin_types_init(void);
+void mercury_sys_init_mercury_builtin_types_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_mercury_builtin_types_write_out_proc_statics(FILE *fp);
+#endif
+
+void
+mercury_sys_init_mercury_builtin_types_init(void)
+{
+#ifdef MR_HIGHLEVEL_CODE
+
+ /*
+ ** We need to call MR_init_entry() for the unification and comparison
+ ** predicates for the types that are automatically predefined
+ ** by the type checker.
+ */
+
+ MR_init_entry(mercury__builtin____Unify____int_0_0);
+ MR_init_entry(mercury__builtin____Unify____string_0_0);
+ MR_init_entry(mercury__builtin____Unify____float_0_0);
+ MR_init_entry(mercury__builtin____Unify____character_0_0);
+ MR_init_entry(mercury__builtin____Unify____void_0_0);
+ MR_init_entry(mercury__builtin____Unify____c_pointer_0_0);
+ MR_init_entry(mercury__builtin____Unify____pred_0_0);
+ MR_init_entry(mercury__builtin____Unify____func_0_0);
+ MR_init_entry(mercury__builtin____Unify____tuple_0_0);
+
+ MR_init_entry(mercury__builtin____Compare____int_0_0);
+ MR_init_entry(mercury__builtin____Compare____float_0_0);
+ MR_init_entry(mercury__builtin____Compare____string_0_0);
+ MR_init_entry(mercury__builtin____Compare____character_0_0);
+ MR_init_entry(mercury__builtin____Compare____void_0_0);
+ MR_init_entry(mercury__builtin____Compare____c_pointer_0_0);
+ MR_init_entry(mercury__builtin____Compare____pred_0_0);
+ MR_init_entry(mercury__builtin____Compare____func_0_0);
+ MR_init_entry(mercury__builtin____Compare____tuple_0_0);
+
+#else /* ! MR_HIGHLEVEL_CODE */
+
+ mercury_builtin_types();
+
+#endif /* MR_HIGHLEVEL_CODE */
+
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, int, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, string, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, float, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, character, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, void, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, c_pointer, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, pred, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, func, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, tuple, 0);
+#ifndef MR_HIGHLEVEL_CODE
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, succip, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, hp, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, curfr, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, maxfr, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, redofr, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, redoip, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, trailptr, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(builtin, ticket, 0);
+#endif
+ MR_INIT_TYPE_CTOR_INFO_MNA(private_builtin, heap_pointer, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(private_builtin, type_ctor_info, 1);
+ MR_INIT_TYPE_CTOR_INFO_MNA(private_builtin, type_info, 1);
+ MR_INIT_TYPE_CTOR_INFO_MNA(private_builtin, base_typeclass_info, 1);
+ MR_INIT_TYPE_CTOR_INFO_MNA(private_builtin, typeclass_info, 1);
+ MR_INIT_TYPE_CTOR_INFO_MNA(type_desc, type_ctor_desc, 0);
+ MR_INIT_TYPE_CTOR_INFO_MNA(type_desc, type_desc, 0);
+}
+
+void
+mercury_sys_init_mercury_builtin_types_init_type_tables(void)
+{
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, int, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, string, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, float, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, character, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, void, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, c_pointer, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, pred, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, func, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, tuple, 0);
+#ifndef MR_HIGHLEVEL_CODE
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, succip, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, hp, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, curfr, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, maxfr, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, redofr, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, redoip, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, trailptr, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(builtin, ticket, 0);
+#endif
+ MR_REGISTER_TYPE_CTOR_INFO(private_builtin, heap_pointer, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(private_builtin, type_ctor_info, 1);
+ MR_REGISTER_TYPE_CTOR_INFO(private_builtin, type_info, 1);
+ MR_REGISTER_TYPE_CTOR_INFO(private_builtin, base_typeclass_info, 1);
+ MR_REGISTER_TYPE_CTOR_INFO(private_builtin, typeclass_info, 1);
+ MR_REGISTER_TYPE_CTOR_INFO(type_desc, type_ctor_desc, 0);
+ MR_REGISTER_TYPE_CTOR_INFO(type_desc, type_desc, 0);
+}
+
+#ifdef MR_DEEP_PROFILING
+void
+mercury_sys_init_mercury_builtin_types_write_out_proc_statics(FILE *fp)
+{
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, int, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, string, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, float, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, character, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, void, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, c_pointer, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, pred, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, func, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, tuple, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, succip, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, hp, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, curfr, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, maxfr, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, redofr, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, redoip, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, trailptr, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, builtin, ticket, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, private_builtin, heap_pointer, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, private_builtin, type_ctor_info, 1);
+ MR_WRITE_OUT_PROC_STATICS(fp, private_builtin, type_info, 1);
+ MR_WRITE_OUT_PROC_STATICS(fp, private_builtin, base_typeclass_info, 1);
+ MR_WRITE_OUT_PROC_STATICS(fp, private_builtin, typeclass_info, 1);
+ MR_WRITE_OUT_PROC_STATICS(fp, type_desc, type_ctor_desc, 0);
+ MR_WRITE_OUT_PROC_STATICS(fp, type_desc, type_desc, 0);
+}
+#endif
+
+/*---------------------------------------------------------------------------*/
Index: runtime/mercury_builtin_types.h
===================================================================
RCS file: mercury_builtin_types.h
diff -N mercury_builtin_types.h
--- /dev/null Tue Aug 6 19:10:00 2002
+++ mercury_builtin_types.h Sat Aug 3 20:42:03 2002
@@ -0,0 +1,128 @@
+/*
+** Copyright (C) 2002 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.
+*/
+
+/*
+** mercury_builtin_types.h
+**
+*/
+
+#ifndef MERCURY_BUILTIN_H
+#define MERCURY_BUILTIN_H
+
+/* Everything in this file is specific to the high-level-code back-end */
+#ifdef MR_HIGHLEVEL_CODE
+
+#include "mercury_types.h"
+#include "mercury_std.h" /* for MR_CALL */
+#include "mercury_float.h" /* for MR_Float etc */
+#include "mercury_hlc_types.h" /* for MR_Mercury_Type_Info etc */
+#include "mercury_type_info.h" /* for MR_TypeCtorInfo_Struct */
+
+/*---------------------------------------------------------------------------*/
+/*
+** Declarations of constants
+*/
+
+/* declare MR_TypeCtorInfo_Structs for the builtin types */
+extern const MR_TypeCtorInfo_Struct
+ mercury__builtin__builtin__type_ctor_info_int_0,
+ mercury__builtin__builtin__type_ctor_info_string_0,
+ mercury__builtin__builtin__type_ctor_info_float_0,
+ mercury__builtin__builtin__type_ctor_info_character_0,
+ mercury__builtin__builtin__type_ctor_info_void_0,
+ mercury__builtin__builtin__type_ctor_info_c_pointer_0,
+ mercury__builtin__builtin__type_ctor_info_pred_0,
+ mercury__builtin__builtin__type_ctor_info_func_0,
+ mercury__builtin__builtin__type_ctor_info_tuple_0,
+ mercury__private_builtin__private_builtin__type_ctor_info_heap_pointer_0,
+ mercury__private_builtin__private_builtin__type_ctor_info_type_ctor_info_1,
+ mercury__private_builtin__private_builtin__type_ctor_info_type_info_1,
+ mercury__private_builtin__private_builtin__type_ctor_info_typeclass_info_1,
+ mercury__private_builtin__private_builtin__type_ctor_info_base_typeclass_info_1,
+ mercury__array__array__type_ctor_info_array_1,
+ mercury__std_util__std_util__type_ctor_info_univ_0,
+ mercury__type_desc__type_desc__type_ctor_info_type_ctor_desc_0,
+ mercury__type_desc__type_desc__type_ctor_info_type_desc_0;
+
+/*---------------------------------------------------------------------------*/
+/*
+** Function declarations
+*/
+
+MR_bool MR_CALL mercury__builtin____Unify____int_0_0(MR_Integer x,
+ MR_Integer y);
+MR_bool MR_CALL mercury__builtin____Unify____string_0_0(MR_String x,
+ MR_String y);
+MR_bool MR_CALL mercury__builtin____Unify____float_0_0(MR_Float x, MR_Float y);
+MR_bool MR_CALL mercury__builtin____Unify____character_0_0(MR_Char x, MR_Char);
+MR_bool MR_CALL mercury__builtin____Unify____void_0_0(MR_Void x, MR_Void y);
+MR_bool MR_CALL mercury__builtin____Unify____c_pointer_0_0(
+ MR_C_Pointer x, MR_C_Pointer y);
+MR_bool MR_CALL mercury__private_builtin____Unify____heap_pointer_0_0(
+ MR_Heap_Pointer x, MR_Heap_Pointer y);
+MR_bool MR_CALL mercury__builtin____Unify____func_0_0(MR_Func x, MR_Func y);
+MR_bool MR_CALL mercury__builtin____Unify____pred_0_0(MR_Pred x, MR_Pred y);
+MR_bool MR_CALL mercury__builtin____Unify____tuple_0_0(MR_Tuple x, MR_Tuple y);
+MR_bool MR_CALL mercury__type_desc____Unify____type_ctor_desc_0_0(
+ MR_Type_Ctor_Desc x, MR_Type_Ctor_Desc y);
+MR_bool MR_CALL mercury__type_desc____Unify____type_desc_0_0(
+ MR_Type_Desc x, MR_Type_Desc y);
+MR_bool MR_CALL mercury__private_builtin____Unify____type_ctor_info_1_0(
+ MR_Mercury_Type_Info type_info,
+ MR_Mercury_Type_Ctor_Info x, MR_Mercury_Type_Ctor_Info y);
+MR_bool MR_CALL mercury__private_builtin____Unify____type_info_1_0(
+ MR_Mercury_Type_Info type_info,
+ MR_Mercury_Type_Info x, MR_Mercury_Type_Info y);
+MR_bool MR_CALL mercury__private_builtin____Unify____typeclass_info_1_0(
+ MR_Mercury_Type_Info type_info,
+ MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y);
+MR_bool MR_CALL mercury__private_builtin____Unify____base_typeclass_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Mercury_Base_TypeClass_Info x,
+ MR_Mercury_Base_TypeClass_Info y);
+
+void MR_CALL mercury__builtin____Compare____int_0_0(
+ MR_Comparison_Result *result, MR_Integer x, MR_Integer y);
+void MR_CALL mercury__builtin____Compare____string_0_0(
+ MR_Comparison_Result *result, MR_String x, MR_String y);
+void MR_CALL mercury__builtin____Compare____float_0_0(
+ MR_Comparison_Result *result, MR_Float x, MR_Float y);
+void MR_CALL mercury__builtin____Compare____character_0_0(
+ MR_Comparison_Result *result, MR_Char x, MR_Char y);
+void MR_CALL mercury__builtin____Compare____void_0_0(
+ MR_Comparison_Result *result, MR_Void x, MR_Void y);
+void MR_CALL mercury__builtin____Compare____c_pointer_0_0(
+ MR_Comparison_Result *result, MR_C_Pointer x, MR_C_Pointer y);
+void MR_CALL mercury__private_builtin____Compare____heap_pointer_0_0(
+ MR_Comparison_Result *result, MR_Heap_Pointer x, MR_Heap_Pointer y);
+void MR_CALL mercury__builtin____Compare____func_0_0(
+ MR_Comparison_Result *result, MR_Func x, MR_Func y);
+void MR_CALL mercury__builtin____Compare____pred_0_0(
+ MR_Comparison_Result *result, MR_Pred x, MR_Pred y);
+void MR_CALL mercury__builtin____Compare____tuple_0_0(
+ MR_Comparison_Result *result, MR_Tuple x, MR_Tuple y);
+void MR_CALL mercury__type_desc____Compare____type_ctor_desc_0_0(
+ MR_Comparison_Result *result,
+ MR_Type_Ctor_Desc x, MR_Type_Ctor_Desc y);
+void MR_CALL mercury__type_desc____Compare____type_desc_0_0(
+ MR_Comparison_Result *result, MR_Type_Desc x, MR_Type_Desc y);
+void MR_CALL mercury__private_builtin____Compare____type_ctor_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Mercury_Type_Ctor_Info x, MR_Mercury_Type_Ctor_Info y);
+void MR_CALL mercury__private_builtin____Compare____type_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Mercury_Type_Info x, MR_Mercury_Type_Info y);
+void MR_CALL mercury__private_builtin____Compare____typeclass_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y);
+void MR_CALL mercury__private_builtin____Compare____base_typeclass_info_1_0(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+ MR_Mercury_Base_TypeClass_Info x, MR_Mercury_Base_TypeClass_Info y);
+
+/*---------------------------------------------------------------------------*/
+
+#endif /* MR_HIGHLEVEL_CODE */
+
+#endif /* not MERCURY_BUILTIN_H */
Index: runtime/mercury_debug.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_debug.h,v
retrieving revision 1.13
diff -u -b -r1.13 mercury_debug.h
--- runtime/mercury_debug.h 2002/08/07 03:18:55 1.13
+++ runtime/mercury_debug.h 2002/08/07 03:43:31
@@ -10,7 +10,6 @@
#define MERCURY_DEBUG_H
#include "mercury_types.h" /* for MR_Word and MR_Code */
-#include "mercury_deep_profiling.h" /* for MR_CallSiteDynamic */
#include <stdio.h> /* for FILE */
/*---------------------------------------------------------------------------*/
Index: runtime/mercury_deep_profiling.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_deep_profiling.h,v
retrieving revision 1.7
diff -u -b -r1.7 mercury_deep_profiling.h
--- runtime/mercury_deep_profiling.h 2002/08/07 03:18:55 1.7
+++ runtime/mercury_deep_profiling.h 2002/08/07 03:37:07
@@ -23,16 +23,6 @@
MR_callback
} MR_CallSite_Kind;
-typedef struct MR_CallSiteStatic_Struct MR_CallSiteStatic;
-typedef struct MR_CallSiteDynamic_Struct MR_CallSiteDynamic;
-typedef struct MR_User_ProcStatic_Struct MR_User_ProcStatic;
-typedef struct MR_Compiler_ProcStatic_Struct MR_Compiler_ProcStatic;
-typedef struct MR_ProcStatic_Struct MR_ProcStatic;
-typedef struct MR_ProcDynamic_Struct MR_ProcDynamic;
-typedef struct MR_ProfilingMetrics_Struct MR_ProfilingMetrics;
-
-typedef struct MR_CallSiteDynList_Struct MR_CallSiteDynList;
-
struct MR_ProfilingMetrics_Struct {
#ifdef MR_DEEP_PROFILING_PORT_COUNTS
#ifdef MR_DEEP_PROFILING_EXPLICIT_CALL_COUNTS
Index: runtime/mercury_hlc_types.h
===================================================================
RCS file: mercury_hlc_types.h
diff -N mercury_hlc_types.h
--- /dev/null Tue Aug 6 19:10:00 2002
+++ mercury_hlc_types.h Sat Aug 3 09:44:49 2002
@@ -0,0 +1,100 @@
+/*
+** Copyright (C) 2002 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.
+*/
+
+/*
+** mercury_hlc_types.h -
+** Definitions of types needed by the high level C back end.
+*/
+
+#ifndef MERCURY_HLC_TYPES_H
+#define MERCURY_HLC_TYPES_H
+
+#ifdef MR_HIGHLEVEL_CODE
+
+#include "mercury_types.h"
+#include "mercury_std.h" /* for MR_CALL */
+
+/*
+** The continuation function types used for implementing
+** nondeterministic procedures.
+*/
+typedef void MR_CALL (*MR_NestedCont) (void); /* for --gcc-nested-functions */
+typedef void MR_CALL (*MR_Cont) (void *); /* for --no-gcc-nested-functions */
+
+/*
+** The types uses to represent the Mercury builtin types,
+** MR_Char, MR_Float, MR_Integer, MR_String, and MR_ConstString,
+** are defined in mercury_types.h and mercury_float.h.
+*/
+
+/*
+** The MR_Word type, which is used for representing user-defined
+** types when we're using the low-level data representation,
+** is defined in runtime/mercury_types.h.
+*/
+
+/*
+** The MR_Box type, which is used for representing polymorphic
+** types, is defined in runtime/mercury_types.h.
+*/
+
+/*
+** Define some names for types that differ depending
+** on whether --high-level-data is enabled.
+** These types all correspond to Mercury data types.
+** Some of the have `Mercury_' in their name, to distinguish
+** them from the corresponding C data type.
+** E.g. `MR_Mercury_Type_Info' (below) is the abstract type that the
+** Mercury compiler generates for a type_info argument, whereas
+** `MR_TypeInfo' (defined in runtime/mercury_type_info.h) is the
+** concrete C type that is used by the C code in the runtime.
+*/
+#ifdef MR_HIGHLEVEL_DATA
+ typedef MR_Integer /* really `enum mercury__builtin__comparison_result_0' */
+ MR_Comparison_Result;
+ typedef struct mercury__builtin__void_0_s * MR_Void;
+ typedef struct mercury__builtin__c_pointer_0_s * MR_C_Pointer;
+ typedef struct mercury__private_builtin__heap_pointer_0_s * MR_Heap_Pointer;
+ typedef MR_ClosurePtr MR_Pred;
+ typedef MR_ClosurePtr MR_Func;
+ typedef struct mercury__array__array_1_s * MR_Array;
+ typedef struct mercury__std_util__univ_0_s * MR_Univ;
+ typedef struct mercury__type_desc__type_desc_0_s * MR_Type_Desc;
+ typedef struct mercury__type_desc__type_ctor_desc_0_s * MR_Type_Ctor_Desc;
+ typedef struct mercury__private_builtin__type_info_1_s *
+ MR_Mercury_Type_Info;
+ typedef struct mercury__private_builtin__type_ctor_info_1_s *
+ MR_Mercury_Type_Ctor_Info;
+ typedef struct mercury__private_builtin__typeclass_info_1_s *
+ MR_Mercury_TypeClass_Info;
+ typedef struct mercury__private_builtin__base_typeclass_info_1_s *
+ MR_Mercury_Base_TypeClass_Info;
+#else
+ /* for --no-high-level-data, they're all just `MR_Word' */
+ typedef MR_Word MR_Comparison_Result;
+ typedef MR_Word MR_Void;
+ typedef MR_Word MR_C_Pointer;
+ typedef MR_Word MR_Heap_Pointer;
+ typedef MR_Word MR_Pred;
+ typedef MR_Word MR_Func;
+ typedef MR_Word MR_Array;
+ typedef MR_Word MR_Univ;
+ typedef MR_Word MR_Type_Desc;
+ typedef MR_Word MR_Type_Ctor_Desc;
+ typedef MR_Word MR_Mercury_Type_Info;
+ typedef MR_Word MR_Mercury_Type_Ctor_Info;
+ typedef MR_Word MR_Mercury_TypeClass_Info;
+ typedef MR_Word MR_Mercury_Base_TypeClass_Info;
+#endif
+
+/*
+** Tuples are always just arrays of polymorphic terms.
+*/
+typedef MR_Box *MR_Tuple;
+
+#endif /* MR_HIGHLEVEL_CODE */
+
+#endif /* MERCURY_HLC_TYPES_H */
Index: runtime/mercury_ho_call.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.c,v
retrieving revision 1.56
diff -u -b -r1.56 mercury_ho_call.c
--- runtime/mercury_ho_call.c 2002/05/15 09:00:50 1.56
+++ runtime/mercury_ho_call.c 2002/08/02 07:22:26
@@ -22,6 +22,7 @@
#include "mercury_deep_profiling.h"
#include "mercury_deep_profiling_hand.h"
#include "mercury_layout_util.h"
+#include "mercury_builtin_types.h" /* for unify/compare of pred/func */
#ifdef MR_DEEP_PROFILING
#ifdef MR_DEEP_PROFILING_STATISTICS
@@ -77,45 +78,271 @@
MR_proc_static_user_builtin_name(predname, 3, 0), \
MR_own_exits)
-MR_proc_static_user_builtin_empty(integer_unify, 2, 0,
+ MR_proc_static_user_builtin_empty(integer_unify, 2, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(integer_compare, 3, 0,
+ MR_proc_static_user_builtin_empty(integer_compare, 3, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(float_unify, 2, 0,
+ MR_proc_static_user_builtin_empty(float_unify, 2, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(float_compare, 3, 0,
+ MR_proc_static_user_builtin_empty(float_compare, 3, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(string_unify, 2, 0,
+ MR_proc_static_user_builtin_empty(string_unify, 2, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(string_compare, 3, 0,
+ MR_proc_static_user_builtin_empty(string_compare, 3, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(c_pointer_unify, 2, 0,
+ MR_proc_static_user_builtin_empty(c_pointer_unify, 2, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(c_pointer_compare, 3, 0,
+ MR_proc_static_user_builtin_empty(c_pointer_compare, 3, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(typeinfo_unify, 2, 0,
+ MR_proc_static_user_builtin_empty(typeinfo_unify, 2, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(typeinfo_compare, 3, 0,
+ MR_proc_static_user_builtin_empty(typeinfo_compare, 3, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(typectorinfo_unify, 2, 0,
+ MR_proc_static_user_builtin_empty(typectorinfo_unify, 2, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(typectorinfo_compare, 3, 0,
+ MR_proc_static_user_builtin_empty(typectorinfo_compare, 3, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(typedesc_unify, 2, 0,
+ MR_proc_static_user_builtin_empty(typedesc_unify, 2, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(typedesc_compare, 3, 0,
+ MR_proc_static_user_builtin_empty(typedesc_compare, 3, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(typectordesc_unify, 2, 0,
+ MR_proc_static_user_builtin_empty(typectordesc_unify, 2, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_builtin_empty(typectordesc_compare, 3, 0,
+ MR_proc_static_user_builtin_empty(typectordesc_compare, 3, 0,
"mercury_ho_call.c", 0, MR_TRUE);
-MR_proc_static_user_empty(std_util, compare_representation, 3, 0,
+ MR_proc_static_user_empty(std_util, compare_representation, 3, 0,
"mercury_ho_call.c", 0, MR_TRUE);
#endif
-#ifndef MR_HIGHLEVEL_CODE
+#ifdef MR_HIGHLEVEL_CODE
+
+static MR_bool MR_CALL
+unify_tuples(MR_Mercury_Type_Info ti, MR_Tuple x, MR_Tuple y)
+{
+ int i, arity;
+ MR_bool result;
+ MR_TypeInfo type_info;
+ MR_TypeInfo arg_type_info;
+
+ type_info = (MR_TypeInfo) ti;
+ arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
+
+ for (i = 0; i < arity; i++) {
+ /* type_infos are counted starting at one. */
+ arg_type_info =
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[i + 1];
+ result = mercury__builtin__unify_2_p_0(
+ (MR_Mercury_Type_Info) arg_type_info, x[i], y[i]);
+ if (result == MR_FALSE) {
+ return MR_FALSE;
+ }
+ }
+ return MR_TRUE;
+}
+
+static void MR_CALL
+compare_tuples(MR_Mercury_Type_Info ti, MR_Comparison_Result *result,
+ MR_Tuple x, MR_Tuple y)
+{
+ int i, arity;
+ MR_TypeInfo type_info;
+ MR_TypeInfo arg_type_info;
+
+ type_info = (MR_TypeInfo) ti;
+ arity = MR_TYPEINFO_GET_VAR_ARITY_ARITY(type_info);
+
+ for (i = 0; i < arity; i++) {
+ /* type_infos are counted starting at one. */
+ arg_type_info =
+ MR_TYPEINFO_GET_VAR_ARITY_ARG_VECTOR(type_info)[i + 1];
+ mercury__builtin__compare_3_p_0(
+ (MR_Mercury_Type_Info) arg_type_info,
+ result, x[i], y[i]);
+ if (*result != MR_COMPARE_EQUAL) {
+ return;
+ }
+ }
+ *result = MR_COMPARE_EQUAL;
+}
+
+/*
+** Define the generic unify/2 and compare/3 functions.
+*/
+
+MR_bool MR_CALL
+mercury__builtin__unify_2_p_0(MR_Mercury_Type_Info ti, MR_Box x, MR_Box y)
+{
+ MR_TypeInfo type_info;
+ MR_TypeCtorInfo type_ctor_info;
+ MR_TypeCtorRep type_ctor_rep;
+ int arity;
+ MR_TypeInfoParams params;
+ MR_Mercury_Type_Info *args;
+
+ type_info = (MR_TypeInfo) ti;
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+
+ /*
+ ** Tuple and higher-order types do not have a fixed arity,
+ ** so they need to be special cased here.
+ */
+ type_ctor_rep = MR_type_ctor_rep(type_ctor_info);
+ if (type_ctor_rep == MR_TYPECTOR_REP_TUPLE) {
+ return unify_tuples(ti, (MR_Tuple) x, (MR_Tuple) y);
+ } else if (type_ctor_rep == MR_TYPECTOR_REP_PRED) {
+ return mercury__builtin____Unify____pred_0_0((MR_Pred) x,
+ (MR_Pred) y);
+ } else if (type_ctor_rep == MR_TYPECTOR_REP_FUNC) {
+ return mercury__builtin____Unify____pred_0_0((MR_Pred) x,
+ (MR_Pred) y);
+ }
+
+ arity = type_ctor_info->MR_type_ctor_arity;
+ params = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
+ args = (MR_Mercury_Type_Info *) params;
+
+ switch(arity) {
+ /*
+ ** cast type_ctor_info->unify_pred to the right type
+ ** and then call it, passing the right number of
+ ** type_info arguments
+ */
+ case 0: return ((MR_UnifyFunc_0 *)
+ type_ctor_info->MR_type_ctor_unify_pred)
+ (x, y);
+ case 1: return ((MR_UnifyFunc_1 *)
+ type_ctor_info->MR_type_ctor_unify_pred)
+ (args[1], x, y);
+ case 2: return ((MR_UnifyFunc_2 *)
+ type_ctor_info->MR_type_ctor_unify_pred)
+ (args[1], args[2], x, y);
+ case 3: return ((MR_UnifyFunc_3 *)
+ type_ctor_info->MR_type_ctor_unify_pred)
+ (args[1], args[2], args[3],
+ x, y);
+ case 4: return ((MR_UnifyFunc_4 *)
+ type_ctor_info->MR_type_ctor_unify_pred)
+ (args[1], args[2], args[3],
+ args[4], x, y);
+ case 5: return ((MR_UnifyFunc_5 *)
+ type_ctor_info->MR_type_ctor_unify_pred)
+ (args[1], args[2], args[3],
+ args[4], args[5], x, y);
+ default:
+ MR_fatal_error(
+ "unify/2: type arity > 5 not supported");
+ }
+}
+
+void MR_CALL
+mercury__builtin__compare_3_p_0(MR_Mercury_Type_Info ti,
+ MR_Comparison_Result *res, MR_Box x, MR_Box y)
+{
+ MR_TypeInfo type_info;
+ MR_TypeCtorInfo type_ctor_info;
+ MR_TypeCtorRep type_ctor_rep;
+ int arity;
+ MR_TypeInfoParams params;
+ MR_Mercury_Type_Info *args;
+
+ type_info = (MR_TypeInfo) ti;
+ type_ctor_info = MR_TYPEINFO_GET_TYPE_CTOR_INFO(type_info);
+
+ /*
+ ** Tuple and higher-order types do not have a fixed arity,
+ ** so they need to be special cased here.
+ */
+ type_ctor_rep = MR_type_ctor_rep(type_ctor_info);
+ if (type_ctor_rep == MR_TYPECTOR_REP_TUPLE) {
+ compare_tuples(ti, res, (MR_Tuple) x, (MR_Tuple) y);
+ return;
+ } else if (type_ctor_rep == MR_TYPECTOR_REP_PRED) {
+ mercury__builtin____Compare____pred_0_0(res,
+ (MR_Pred) x, (MR_Pred) y);
+ return;
+ } else if (type_ctor_rep == MR_TYPECTOR_REP_FUNC) {
+ mercury__builtin____Compare____pred_0_0(res,
+ (MR_Pred) x, (MR_Pred) y);
+ return;
+ }
+
+ arity = type_ctor_info->MR_type_ctor_arity;
+ params = MR_TYPEINFO_GET_FIXED_ARITY_ARG_VECTOR(type_info);
+ args = (MR_Mercury_Type_Info *) params;
+
+ switch(arity) {
+ /*
+ ** cast type_ctor_info->compare to the right type
+ ** and then call it, passing the right number of
+ ** type_info arguments
+ */
+ case 0: ((MR_CompareFunc_0 *)
+ type_ctor_info->MR_type_ctor_compare_pred)
+ (res, x, y);
+ break;
+ case 1: ((MR_CompareFunc_1 *)
+ type_ctor_info->MR_type_ctor_compare_pred)
+ (args[1], res, x, y);
+ break;
+ case 2: ((MR_CompareFunc_2 *)
+ type_ctor_info->MR_type_ctor_compare_pred)
+ (args[1], args[2], res, x, y);
+ break;
+ case 3: ((MR_CompareFunc_3 *)
+ type_ctor_info->MR_type_ctor_compare_pred)
+ (args[1], args[2], args[3], res, x, y);
+ break;
+ case 4: ((MR_CompareFunc_4 *)
+ type_ctor_info->MR_type_ctor_compare_pred)
+ (args[1], args[2], args[3],
+ args[4], res, x, y);
+ break;
+ case 5: ((MR_CompareFunc_5 *)
+ type_ctor_info->MR_type_ctor_compare_pred)
+ (args[1], args[2], args[3],
+ args[4], args[5], res, x, y);
+ break;
+ default:
+ MR_fatal_error(
+ "index/2: type arity > 5 not supported");
+ }
+}
+
+void MR_CALL
+mercury__builtin__compare_3_p_1(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *res,
+ MR_Box x, MR_Box y)
+{
+ mercury__builtin__compare_3_p_0(type_info, res, x, y);
+}
+
+void MR_CALL
+mercury__builtin__compare_3_p_2(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *res,
+ MR_Box x, MR_Box y)
+{
+ mercury__builtin__compare_3_p_0(type_info, res, x, y);
+}
+
+void MR_CALL
+mercury__builtin__compare_3_p_3(
+ MR_Mercury_Type_Info type_info, MR_Comparison_Result *res,
+ MR_Box x, MR_Box y)
+{
+ 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)
+{
+ MR_SORRY("compare_representation/3 for HIGHLEVEL_CODE");
+}
+
+#else /* ! 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,
Index: runtime/mercury_ho_call.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_ho_call.h,v
retrieving revision 1.6
diff -u -b -r1.6 mercury_ho_call.h
--- runtime/mercury_ho_call.h 2002/02/24 11:53:32 1.6
+++ runtime/mercury_ho_call.h 2002/08/02 10:02:02
@@ -20,6 +20,9 @@
#include "mercury_stack_layout.h" /* for MR_Closure_Id etc */
#include "mercury_type_info.h" /* for MR_PseudoTypeInfo */
+#ifndef MR_HIGHLEVEL_CODE
+ #include "mercury_goto.h" /* for MR_declare_entry */
+#endif
/*
** A closure layout structure identifies a procedure, and contains
@@ -105,13 +108,45 @@
** the arguments from one.
*/
-typedef struct MR_Closure_Struct {
+struct MR_Closure_Struct {
MR_Closure_Layout *MR_closure_layout;
MR_Code *MR_closure_code;
MR_Unsigned MR_closure_num_hidden_args;
MR_Word MR_closure_hidden_args_0[MR_VARIABLE_SIZED];
-} MR_Closure;
+};
+/* in mercury_types.h: typedef struct MR_Closure_Struct MR_Closure; */
+
#define MR_closure_hidden_args(i) MR_closure_hidden_args_0[(i) - 1]
+#ifdef MR_HIGHLEVEL_CODE
+
+/*
+** Function declarations
+*/
+
+MR_bool MR_CALL mercury__builtin__unify_2_p_0(MR_Mercury_Type_Info,
+ MR_Box, MR_Box);
+void MR_CALL mercury__builtin__compare_3_p_0(MR_Mercury_Type_Info,
+ MR_Comparison_Result *, MR_Box, MR_Box);
+void MR_CALL mercury__builtin__compare_3_p_1(MR_Mercury_Type_Info,
+ MR_Comparison_Result *, MR_Box, MR_Box);
+void MR_CALL mercury__builtin__compare_3_p_2(MR_Mercury_Type_Info,
+ 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);
+
+#else /* ! MR_HIGHLEVEL_CODE */
+
+MR_declare_entry(mercury__unify_2_0);
+MR_declare_entry(mercury__compare_3_0);
+MR_declare_entry(mercury__compare_3_1);
+MR_declare_entry(mercury__compare_3_2);
+MR_declare_entry(mercury__compare_3_3);
+MR_declare_entry(mercury__std_util__compare_representation_3_0);
+
+#endif /* MR_HIGHLEVEL_CODE */
+
#endif /* not MERCURY_HO_CALL_H */
Index: runtime/mercury_profiling_builtin.h
===================================================================
RCS file: mercury_profiling_builtin.h
diff -N mercury_profiling_builtin.h
--- /dev/null Tue Aug 6 19:10:00 2002
+++ mercury_profiling_builtin.h Wed Aug 7 13:43:51 2002
@@ -0,0 +1,38 @@
+/*
+** Copyright (C) 2002 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.
+*/
+
+/*
+** The contents of this file were generated by the make_port_code script
+** in the tools directory. Do not edit.
+*/
+
+#ifndef MR_MERCURY_PROFILING_BUILTIN_H
+#define MR_MERCURY_PROFILING_BUILTIN_H
+
+#include "mercury_goto.h"
+
+#ifdef MR_DEEP_PROFILING
+
+MR_declare_entry(mercury__profiling_builtin__det_call_port_code_ac_3_0);
+MR_declare_entry(mercury__profiling_builtin__det_exit_port_code_ac_2_0);
+MR_declare_entry(mercury__profiling_builtin__semi_call_port_code_ac_3_0);
+MR_declare_entry(mercury__profiling_builtin__semi_exit_port_code_ac_2_0);
+MR_declare_entry(mercury__profiling_builtin__semi_fail_port_code_ac_2_0);
+MR_declare_entry(mercury__profiling_builtin__non_call_port_code_ac_4_0);
+MR_declare_entry(mercury__profiling_builtin__non_exit_port_code_ac_2_0);
+MR_declare_entry(mercury__profiling_builtin__non_redo_port_code_ac_2_0);
+MR_declare_entry(mercury__profiling_builtin__non_fail_port_code_ac_2_0);
+MR_declare_entry(mercury__profiling_builtin__det_call_port_code_sr_4_0);
+MR_declare_entry(mercury__profiling_builtin__det_exit_port_code_sr_3_0);
+MR_declare_entry(mercury__profiling_builtin__semi_call_port_code_sr_4_0);
+MR_declare_entry(mercury__profiling_builtin__semi_exit_port_code_sr_3_0);
+MR_declare_entry(mercury__profiling_builtin__semi_fail_port_code_sr_3_0);
+MR_declare_entry(mercury__profiling_builtin__non_call_port_code_sr_5_0);
+MR_declare_entry(mercury__profiling_builtin__non_exit_port_code_sr_3_0);
+MR_declare_entry(mercury__profiling_builtin__non_redo_port_code_sr_2_0);
+MR_declare_entry(mercury__profiling_builtin__non_fail_port_code_sr_3_0);
+#endif /* MR_DEEP_PROFILING */
+#endif /* MR_MERCURY_PROFILING_BUILTIN_H */
Index: runtime/mercury_std.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_std.h,v
retrieving revision 1.20
diff -u -b -r1.20 mercury_std.h
--- runtime/mercury_std.h 2002/02/18 07:01:19 1.20
+++ runtime/mercury_std.h 2002/08/02 07:22:33
@@ -262,4 +262,8 @@
/*---------------------------------------------------------------------------*/
+#define MR_SORRY(msg) MR_fatal_error("Sorry, not yet implemented: " msg);
+
+/*---------------------------------------------------------------------------*/
+
#endif /* not MERCURY_STD_H */
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.94
diff -u -b -r1.94 mercury_type_info.h
--- runtime/mercury_type_info.h 2002/08/01 11:52:28 1.94
+++ runtime/mercury_type_info.h 2002/08/03 11:16:36
@@ -55,9 +55,10 @@
#ifndef MERCURY_TYPE_INFO_H
#define MERCURY_TYPE_INFO_H
-#include "mercury_std.h" /* for `MR_STRINGIFY' and `MR_PASTEn' */
+#include "mercury_std.h" /* for `MR_STRINGIFY', `MR_PASTEn' and MR_CALL */
#include "mercury_types.h" /* for `MR_Word' */
#include "mercury_tags.h" /* for `MR_CONVERT_C_ENUM_CONSTANT' */
+#include "mercury_hlc_types.h" /* for `MR_UnifyFunc*' */
/*---------------------------------------------------------------------------*/
@@ -929,7 +930,6 @@
const void * const *MR_ra_res_symbolic_addrs;
MR_ReservedAddrFunctorDescPtr const *MR_ra_constants;
MR_DuTypeLayout MR_ra_other_functors;
-
} MR_ReservedAddrTypeDesc;
typedef MR_ReservedAddrTypeDesc *MR_ReservedAddrTypeLayout;
@@ -1059,8 +1059,8 @@
/*
** The following fields will be added later, once we can exploit them:
-** MR_TrieNodePtr type_std_table;
-** MR_ProcAddr prettyprinter;
+** MR_TrieNodePtr MR_type_ctor_std_table;
+** MR_ProcAddr MR_type_ctor_prettyprinter;
*/
};
@@ -1087,124 +1087,206 @@
/*---------------------------------------------------------------------------*/
+#ifdef MR_HIGHLEVEL_CODE
+
+/* Types for the wrapper versions of type-specific unify/compare procedures. */
+
+typedef MR_bool MR_CALL MR_UnifyFunc_0(MR_Box, MR_Box);
+typedef MR_bool MR_CALL MR_UnifyFunc_1(MR_Mercury_Type_Info, MR_Box, MR_Box);
+typedef MR_bool MR_CALL MR_UnifyFunc_2(MR_Mercury_Type_Info,
+ MR_Mercury_Type_Info, MR_Box, MR_Box);
+typedef MR_bool MR_CALL MR_UnifyFunc_3(MR_Mercury_Type_Info,
+ MR_Mercury_Type_Info, MR_Mercury_Type_Info,
+ MR_Box, MR_Box);
+typedef MR_bool MR_CALL MR_UnifyFunc_4(MR_Mercury_Type_Info,
+ MR_Mercury_Type_Info, MR_Mercury_Type_Info,
+ MR_Mercury_Type_Info, MR_Box, MR_Box);
+typedef MR_bool MR_CALL MR_UnifyFunc_5(MR_Mercury_Type_Info,
+ MR_Mercury_Type_Info, MR_Mercury_Type_Info,
+ MR_Mercury_Type_Info, MR_Mercury_Type_Info,
+ MR_Box, MR_Box);
+
+typedef void MR_CALL MR_CompareFunc_0(MR_Comparison_Result *, MR_Box, MR_Box);
+typedef void MR_CALL MR_CompareFunc_1(MR_Mercury_Type_Info,
+ MR_Comparison_Result *, MR_Box, MR_Box);
+typedef void MR_CALL MR_CompareFunc_2(MR_Mercury_Type_Info,
+ MR_Mercury_Type_Info, MR_Comparison_Result *,
+ MR_Box, MR_Box);
+typedef void MR_CALL MR_CompareFunc_3(MR_Mercury_Type_Info,
+ MR_Mercury_Type_Info, MR_Mercury_Type_Info,
+ MR_Comparison_Result *, MR_Box, MR_Box);
+typedef void MR_CALL MR_CompareFunc_4(MR_Mercury_Type_Info,
+ MR_Mercury_Type_Info, MR_Mercury_Type_Info,
+ MR_Mercury_Type_Info, MR_Comparison_Result *,
+ MR_Box, MR_Box);
+typedef void MR_CALL MR_CompareFunc_5(MR_Mercury_Type_Info,
+ MR_Mercury_Type_Info, MR_Mercury_Type_Info,
+ MR_Mercury_Type_Info, MR_Mercury_Type_Info,
+ MR_Comparison_Result *, MR_Box, MR_Box);
+
+#endif /* MR_HIGHLEVEL_CODE */
+
+/*---------------------------------------------------------------------------*/
+
/*
** Macros to help the runtime and the library create type_ctor_info
** structures for builtin and special types.
*/
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(m, cm, n, a, cr, u, c) \
- MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_DECLARE_ADDRS(u, c) \
- MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_TYPE \
- MR_PASTE6(mercury_data_, cm, __type_ctor_info_, n, _, a) = \
- MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_BODY(m, n, a, cr, u, c)
-
- /* MSVC CPP doesn't like having an empty CM field. */
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(m, n, a, cr, u, c) \
- MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_DECLARE_ADDRS(u, c) \
- MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_TYPE \
- MR_PASTE5(mercury_data_, __type_ctor_info_, n, _, a) = \
- MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_BODY(m, n, a, cr, u, c)
+#ifdef MR_HIGHLEVEL_CODE
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_DECLARE_ADDRS(u, c) \
- MR_declare_entry(u); \
- MR_declare_entry(c);
+ #define MR_DEFINE_TYPE_CTOR_INFO_TYPE \
+ const struct MR_TypeCtorInfo_Struct
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_TYPE \
- MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_Struct
+ #define MR_NONSTD_TYPE_CTOR_INFO_NAME(m, n, a) \
+ MR_PASTE2(m, \
+ MR_PASTE2(__, \
+ MR_PASTE2(m, \
+ MR_PASTE2(__type_ctor_info_, \
+ MR_PASTE2(n, \
+ MR_PASTE2(_, a))))))
+
+ #define MR_TYPE_CTOR_INFO_NAME(m, n, a) \
+ MR_PASTE2(mercury__, MR_NONSTD_TYPE_CTOR_INFO_NAME(m, n, a))
+
+ #define MR_TYPE_CTOR_INFO_FUNC_NAME(m, n, a, f) \
+ MR_PASTE2(mercury__, \
+ MR_PASTE2(m, \
+ MR_PASTE2(__, \
+ MR_PASTE2(f, \
+ MR_PASTE2(__, \
+ MR_PASTE2(n, \
+ MR_PASTE2(_, \
+ MR_PASTE2(a, _0))))))))
+
+ #define MR_TYPE_UNIFY_FUNC(m, n, a) \
+ MR_TYPE_CTOR_INFO_FUNC_NAME(m, n, a, do_unify)
+
+ #define MR_TYPE_COMPARE_FUNC(m, n, a) \
+ MR_TYPE_CTOR_INFO_FUNC_NAME(m, n, a, do_compare)
+
+ #define MR_SPECIAL_FUNC_TYPE(NAME, ARITY) \
+ MR_PASTE2(MR_, MR_PASTE2(NAME, MR_PASTE2(Func_, ARITY)))
+
+ #define MR_DEFINE_TYPE_CTOR_INFO_DECLARE_ADDRS(u, c, a) \
+ static MR_PASTE2(MR_UnifyFunc_, a) u; \
+ static MR_PASTE2(MR_CompareFunc_, a) c;
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_BODY(m, n, a, cr, u, c) \
+ #define MR_DEFINE_TYPE_CTOR_INFO_BODY(m, n, a, cr, u, c) \
{ \
a, \
- MR_RTTI_VERSION__REP, \
+ MR_RTTI_VERSION__COMPACT, \
-1, \
- 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), \
+ MR_PASTE2(MR_TYPECTOR_REP_, cr), \
+ (MR_Box) u, \
+ (MR_Box) c, \
+ MR_STRINGIFY(m), \
+ MR_STRINGIFY(n), \
{ 0 }, \
{ 0 }, \
-1 \
}
-
-#define MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_PRED(m, n, a, cr, u, c) \
- MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_FULL(m, 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, m, n, a, cr, \
- MR_PASTE7(mercury____Unify___, m, __, n, _, a, _0), \
- MR_PASTE7(mercury____Compare___, m, __, n, _, a, _0))
+ #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(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_BUILTIN_TYPE_CTOR_INFO_UNUSED(n, a, cr) \
- MR_DEFINE_BUILTIN_TYPE_CTOR_INFO_NOCM(builtin, n, a, cr, \
- mercury__unused_0_0, \
- mercury__unused_0_0)
+#else /* ! MR_HIGHLEVEL_CODE */
-/*
-** Used to define MR_TypeCtorInfos for the builtin types in the hlc grades.
-** This needs to be exported for use by the array type in the library.
-*/
+ #define MR_DEFINE_TYPE_CTOR_INFO_TYPE \
+ MR_STATIC_CODE_CONST struct MR_TypeCtorInfo_Struct
-#ifdef MR_HIGHLEVEL_CODE
+ #define MR_NONSTD_TYPE_CTOR_INFO_NAME(m, n, a) \
+ MR_PASTE2(mercury_data_, \
+ MR_PASTE2(m, \
+ MR_PASTE2(__type_ctor_info_, \
+ MR_PASTE2(n, \
+ MR_PASTE2(_, a)))))
- #define MR_builtin_type_ctor_info_name(TYPE, ARITY) \
- MR_type_ctor_info_name(builtin, TYPE, ARITY)
+ #define MR_TYPE_CTOR_INFO_NAME(m, n, a) \
+ MR_NONSTD_TYPE_CTOR_INFO_NAME(m, n, a)
- #define MR_type_ctor_info_name(MODULE, TYPE, ARITY) \
- MR_PASTE2(mercury__, \
- MR_PASTE2(MODULE, \
- MR_PASTE2(__, \
- MR_PASTE2(MODULE, \
- MR_PASTE2(__type_ctor_info_, \
- MR_PASTE2(TYPE, \
- MR_PASTE2(_, ARITY)))))))
+ #define MR_TYPE_UNIFY_FUNC(m, n, a) \
+ MR_PASTE7(mercury____Unify___, m, __, n, _, a, _0)
- #define MR_type_ctor_info_func_name(MODULE, TYPE, ARITY, FUNC) \
- MR_PASTE2(mercury__, \
- MR_PASTE2(MODULE, \
- MR_PASTE2(__, \
- MR_PASTE2(FUNC, \
- MR_PASTE2(__, \
- MR_PASTE2(TYPE, \
- MR_PASTE2(_, \
- MR_PASTE2(ARITY, _0))))))))
+ #define MR_TYPE_COMPARE_FUNC(m, n, a) \
+ MR_PASTE7(mercury____Compare___, m, __, n, _, a, _0)
- #define MR_special_func_type(NAME, ARITY) \
- MR_PASTE2(MR_, MR_PASTE2(NAME, MR_PASTE2(Func_, ARITY)))
+ #define MR_DEFINE_TYPE_CTOR_INFO_DECLARE_ADDRS(u, c) \
+ MR_declare_entry(u); \
+ MR_declare_entry(c);
- #define MR_define_type_ctor_info(module, type, arity, type_rep) \
- const struct MR_TypeCtorInfo_Struct \
- MR_type_ctor_info_name(module, type, arity) = \
+ #define MR_DEFINE_TYPE_CTOR_INFO_BODY(m, n, a, cr, u, c) \
{ \
- arity, \
+ a, \
MR_RTTI_VERSION__REP, \
-1, \
- type_rep, \
- (MR_Box) MR_type_ctor_info_func_name(module, type, arity, \
- do_unify), \
- (MR_Box) MR_type_ctor_info_func_name(module, type, arity, \
- do_compare), \
- MR_STRINGIFY(module), \
- MR_STRINGIFY(type), \
+ 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 \
}
-#else /* ! MR_HIGHLEVEL_CODE */
+ #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_builtin_type_ctor_info_name(TYPE, ARITY) \
- MR_PASTE2(mercury_data_, \
- MR_PASTE2(__type_ctor_info_, \
- MR_PASTE2(TYPE, \
- MR_PASTE2(_, ARITY))))
+ #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_type_ctor_info_name(MODULE, TYPE, ARITY) \
- MR_PASTE2(mercury_data_, \
- MR_PASTE2(MODULE, \
- MR_PASTE2(__type_ctor_info_, \
- MR_PASTE2(TYPE, \
- MR_PASTE2(_, ARITY)))))
+ #define MR_UNIFY_COMPARE_DECLS(m, n, a) \
+ MR_declare_entry(MR_TYPE_UNIFY_FUNC(m, n, a)); \
+ MR_declare_entry(MR_TYPE_COMPARE_FUNC(m, n, a));
+
+ #define MR_UNIFY_COMPARE_DEFNS(m, n, a) \
+ MR_define_extern_entry(MR_TYPE_UNIFY_FUNC(m, n, a)); \
+ MR_define_extern_entry(MR_TYPE_COMPARE_FUNC(m, n, a));
+
+ #ifdef MR_DEEP_PROFILING
+
+ #define MR_UNIFY_COMPARE_LABELS(m, n, a) \
+ MR_init_entry(MR_TYPE_UNIFY_FUNC(m, n, a)); \
+ MR_init_entry(MR_TYPE_COMPARE_FUNC(m, n, a)); \
+ MR_init_label(MR_PASTE2(MR_TYPE_UNIFY_FUNC(m, n, a), _i1)); \
+ MR_init_label(MR_PASTE2(MR_TYPE_UNIFY_FUNC(m, n, a), _i2)); \
+ MR_init_label(MR_PASTE2(MR_TYPE_UNIFY_FUNC(m, n, a), _i3)); \
+ MR_init_label(MR_PASTE2(MR_TYPE_UNIFY_FUNC(m, n, a), _i4)); \
+ MR_init_label(MR_PASTE2(MR_TYPE_COMPARE_FUNC(m, n, a), _i1)); \
+ MR_init_label(MR_PASTE2(MR_TYPE_COMPARE_FUNC(m, n, a), _i2));
+
+ #else /* ! MR_DEEP_PROFILING */
+
+ #define MR_UNIFY_COMPARE_LABELS(m, n, a) \
+ MR_init_entry(MR_TYPE_UNIFY_FUNC(m, n, a)); \
+ MR_init_entry(MR_TYPE_COMPARE_FUNC(m, n, a));
+
+ #endif /* MR_DEEP_PROFILING */
#endif /* MR_HIGHLEVEL_CODE */
@@ -1223,17 +1305,10 @@
/*
** Macros are provided here to initialize type_ctor_infos, both for
-** builtin types (such as in library/builtin.m) and user
+** builtin types (such as in runtime/mercury_builtin_types.c) and user
** defined C types (like library/array.m). Also, the automatically
** generated code uses these initializers.
**
-** Examples of use:
-**
-** MR_INIT_BUILTIN_TYPE_CTOR_INFO(
-** mercury_data__type_ctor_info_string_0, _string_);
-**
-** note we use _string_ to avoid the redefinition of string via #define
-**
** MR_INIT_TYPE_CTOR_INFO(
** mercury_data_group__type_ctor_info_group_1, group__group_1_0);
**
@@ -1249,22 +1324,28 @@
#define MR_STATIC_CODE_CONST
- #define MR_INIT_BUILTIN_TYPE_CTOR_INFO(B, T) \
+ #define MR_INIT_TYPE_CTOR_INFO(B, T) \
do { \
- (B).new_unify_pred = MR_ENTRY(mercury__builtin_unify##T##2_0); \
- (B).compare_pred = MR_ENTRY(mercury__builtin_compare##T##3_0); \
+ (B).MR_type_ctor_unify_pred = \
+ MR_ENTRY(mercury____##Unify##___##T); \
+ (B).MR_type_ctor_compare_pred = \
+ MR_ENTRY(mercury____##Compare##___##T); \
} while (0)
- #define MR_INIT_TYPE_CTOR_INFO_WITH_PRED(B, P) \
+ #define MR_INIT_TYPE_CTOR_INFO_MNA(m, n, a) \
do { \
- (B).new_unify_pred = MR_ENTRY(P); \
- (B).compare_pred = MR_ENTRY(P); \
+ MR_TYPE_CTOR_INFO_NAME(m, n, a).MR_type_ctor_unify_pred = \
+ MR_ENTRY(MR_TYPE_UNIFY_FUNC(m, n, a)); \
+ MR_TYPE_CTOR_INFO_NAME(m, n, a).MR_type_ctor_compare_pred = \
+ MR_ENTRY(MR_TYPE_COMPARE_FUNC(m, n, a)); \
} while (0)
- #define MR_INIT_TYPE_CTOR_INFO(B, T) \
+ #define MR_INIT_TYPE_CTOR_INFO_MNA_WITH_PRED(m, n, a, p) \
do { \
- (B).new_unify_pred = MR_ENTRY(mercury____##Unify##___##T); \
- (B).compare_pred = MR_ENTRY(mercury____##Compare##___##T); \
+ MR_TYPE_CTOR_INFO_NAME(m, n, a).MR_type_ctor_unify_pred = \
+ MR_ENTRY(p); \
+ MR_TYPE_CTOR_INFO_NAME(m, n, a).MR_type_ctor_compare_pred = \
+ MR_ENTRY(p); \
} while (0)
#else /* MR_STATIC_CODE_ADDRESSES */
@@ -1273,16 +1354,33 @@
#define MR_STATIC_CODE_CONST const
- #define MR_INIT_BUILTIN_TYPE_CTOR_INFO(B, T) \
+ #define MR_INIT_TYPE_CTOR_INFO(B, T) \
do { } while (0)
- #define MR_INIT_TYPE_CTOR_INFO_WITH_PRED(B, P) \
+ #define MR_INIT_TYPE_CTOR_INFO_MNA(m, n, a) \
do { } while (0)
- #define MR_INIT_TYPE_CTOR_INFO(B, T) \
+ #define MR_INIT_TYPE_CTOR_INFO_MNA_WITH_PRED(m, n, a, p) \
do { } while (0)
#endif /* MR_STATIC_CODE_ADDRESSES */
+
+#define MR_REGISTER_TYPE_CTOR_INFO(m, n, a) \
+ MR_register_type_ctor_info(&MR_TYPE_CTOR_INFO_NAME(m, n, a))
+
+#define MR_DEFINE_PROC_STATICS(mod, n, a) \
+ MR_proc_static_compiler_empty(mod, __Unify__, n, a, 0, \
+ MR_STRINGIFY(MR_PASTE2(mod, .m)), 0, MR_TRUE); \
+ MR_proc_static_compiler_empty(mod, __Compare__, n, a, 0, \
+ MR_STRINGIFY(MR_PASTE2(mod, .m)), 0, MR_TRUE);
+
+#define MR_WRITE_OUT_PROC_STATICS(fp, m, n, a) \
+ do { \
+ MR_write_out_proc_static(fp, (MR_ProcStatic *) \
+ &MR_proc_static_compiler_name(m, __Unify__, n, a, 0)); \
+ MR_write_out_proc_static(fp, (MR_ProcStatic *) \
+ &MR_proc_static_compiler_name(m, __Compare__, n, a, 0)); \
+ } while (0)
/*---------------------------------------------------------------------------*/
Index: runtime/mercury_types.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_types.h,v
retrieving revision 1.28
diff -u -b -r1.28 mercury_types.h
--- runtime/mercury_types.h 2002/02/20 05:26:50 1.28
+++ runtime/mercury_types.h 2002/08/03 11:06:25
@@ -1,4 +1,7 @@
/*
+** vim: ts=4 sw=4 expandtab
+*/
+/*
** Copyright (C) 1995-2002 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.
@@ -108,6 +111,24 @@
#endif
/*
+** These typedefs are forward declarations, used to avoid circular dependencies
+** between header files.
+*/
+
+typedef struct MR_Closure_Struct MR_Closure;
+typedef const MR_Closure *MR_ClosurePtr;
+
+typedef struct MR_CallSiteStatic_Struct MR_CallSiteStatic;
+typedef struct MR_CallSiteDynamic_Struct MR_CallSiteDynamic;
+typedef struct MR_User_ProcStatic_Struct MR_User_ProcStatic;
+typedef struct MR_Compiler_ProcStatic_Struct MR_Compiler_ProcStatic;
+typedef struct MR_ProcStatic_Struct MR_ProcStatic;
+typedef struct MR_ProcDynamic_Struct MR_ProcDynamic;
+typedef struct MR_ProfilingMetrics_Struct MR_ProfilingMetrics;
+
+typedef struct MR_CallSiteDynList_Struct MR_CallSiteDynList;
+
+/*
** The MR_Box type is used for representing polymorphic types.
** Currently this is only used in the MLDS C backend.
**
@@ -116,9 +137,9 @@
*/
#ifdef MR_HIGHLEVEL_CODE
-typedef void *MR_Box;
+ typedef void *MR_Box;
#else
-typedef MR_Word MR_Box;
+ typedef MR_Word MR_Box;
#endif
#endif /* not MERCURY_TYPES_H */
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
cvs diff: Diffing tests/dppd
cvs diff: Diffing tests/general
cvs diff: Diffing tests/general/accumulator
cvs diff: Diffing tests/general/structure_reuse
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/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
Index: tools/make_port_code
===================================================================
RCS file: make_port_code
diff -N make_port_code
--- /dev/null Tue Aug 6 19:10:00 2002
+++ make_port_code Sun Aug 4 13:35:53 2002
@@ -0,0 +1,251 @@
+#!/bin/sh
+# vim: ts=4 sw=4 expandtab
+#---------------------------------------------------------------------------#
+# Copyright (C) 2002 The University of Melbourne.
+# This file may only be copied under the terms of the GNU General
+# Public License - see the file COPYING in the Mercury distribution.
+#---------------------------------------------------------------------------#
+#
+# This script generates the files mercury_profiling_builtin.[ch] in the
+# runtime directory, files which contain the C declarations and code of the
+# primitives needed for the deep profiling of the unify and operations
+# on builtin types. (The Mercury declarations are in profiling_builtin.m
+# in the library.)
+#
+# It should be executed in the runtime directory.
+
+prefix="mercury__profiling_builtin__"
+tmp_code="/tmp/make_port_code_$$"
+tmp_prolog="/tmp/make_port_code_prolog$$"
+tmp_declare_entry="/tmp/make_port_code_decl_$$"
+tmp_define_entry="/tmp/make_port_code_defn_$$"
+tmp_init_entry="/tmp/make_port_code_init_$$"
+trap "/bin/rm $tmp_code $tmp_prolog $tmp_declare_entry $tmp_define_entry $tmp_init_entry" 0 1 2 3 15
+> ${tmp_code}
+> ${tmp_declare_entry}
+> ${tmp_define_entry}
+> ${tmp_init_entry}
+
+cat > ${tmp_prolog} << END
+/*
+** Copyright (C) 2002 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.
+*/
+
+/*
+** The contents of this file were generated by the make_port_code script
+** in the tools directory. Do not edit.
+*/
+
+END
+
+source="mercury_profiling_builtin.c"
+header="mercury_profiling_builtin.h"
+module="runtime_profiling_builtin_module"
+protect="MR_MERCURY_PROFILING_BUILTIN_H"
+
+for impl in ac sr
+do
+ case $impl in
+ ac) IMPL=AC
+ ;;
+ sr) IMPL=SR
+ ;;
+ esac
+
+ for detism in det semi non
+ do
+ case $detism in
+ det) ports="call exit"
+ ;;
+ semi) ports="call exit fail"
+ ;;
+ non) ports="call exit redo fail"
+ ;;
+ esac
+
+ for port in $ports
+ do
+ case $port in
+ call)
+ file="mercury_deep_call_port_body.h"
+ portdef="MR_CALL_PORT"
+ return="MR_proceed();"
+ if test $detism = non
+ then
+ outermost_define="#define"
+ else
+ outermost_define="#undef "
+ fi
+ decls=
+ inputs="ProcStatic"
+ outputs="TopCSD MiddleCSD"
+ if test $impl = sr
+ then
+ outputs="$outputs OldOutermostActivationPtr"
+ fi
+ if test $detism = non
+ then
+ outputs="$outputs NewOutermostActivationPtr"
+ fi
+ ;;
+
+ exit|fail)
+ file="mercury_deep_leave_port_body.h"
+ if test $port = exit
+ then
+ portdef="MR_EXIT_PORT"
+ return="MR_proceed();"
+ else
+ portdef="MR_FAIL_PORT"
+ return="MR_r1 = MR_FALSE; MR_proceed();"
+ fi
+ outermost_define="#undef "
+ inputs="TopCSD MiddleCSD"
+ outputs=""
+ if test $impl = sr
+ then
+ inputs="$inputs OldOutermostActivationPtr"
+ fi
+ ;;
+
+ redo)
+ file="mercury_deep_redo_port_body.h"
+ portdef="MR_REDO_PORT"
+ return="MR_r1 = MR_FALSE; MR_proceed();"
+ outermost_define="#undef "
+ inputs="MiddleCSD NewOutermostActivationPtr"
+ outputs=""
+ ;;
+ esac
+
+ arity=0
+ for arg in ${inputs} ${outputs}
+ do
+ arity=`expr ${arity} + 1`
+ done
+
+ name="${detism}_${port}_port_code_${impl}_${arity}_0"
+ msgname="${detism}_${port}_port_code_${impl}"
+ (
+ echo ""
+ echo "MR_define_entry(${prefix}${name});"
+ echo "{"
+ for arg in ${inputs} ${outputs}
+ do
+ echo "MR_Word ${arg};"
+ done
+ echo ""
+ n=1
+ for arg in ${inputs}
+ do
+ echo "${arg} = MR_r${n};"
+ n=`expr $n + 1`
+ done
+ echo ""
+ echo "#define MR_PROCNAME \"${msgname}\""
+ echo "#define MR_VERSION_${IMPL}"
+ echo "#define ${portdef}"
+ echo "${outermost_define} MR_NEED_NEW_OUTERMOST"
+ cat ${file}
+ echo "#undef MR_PROCNAME"
+ echo "#undef MR_VERSION_${IMPL}"
+ echo "#undef ${portdef}"
+ echo "#undef MR_NEED_NEW_OUTERMOST"
+ echo ""
+ n=1
+ for arg in ${outputs}
+ do
+ echo "MR_r${n} = ${arg};"
+ n=`expr $n + 1`
+ done
+ echo "}"
+ echo ${return}
+ ) >> ${tmp_code}
+
+ decl="MR_declare_entry(${prefix}${name});"
+ echo ${decl} >> ${tmp_declare_entry}
+
+ defn="MR_define_extern_entry(${prefix}${name});"
+ echo ${defn} >> ${tmp_define_entry}
+
+ init="MR_init_entry_an(${prefix}${name});"
+ echo ${init} >> ${tmp_init_entry}
+ done
+ done
+done
+
+#---------------------------------------------------------------------------#
+# assembler the header file
+
+cat ${tmp_prolog} > ${header}
+cat >> ${header} << END
+#ifndef ${protect}
+#define ${protect}
+
+#include "mercury_goto.h"
+
+#ifdef MR_DEEP_PROFILING
+
+END
+cat ${tmp_declare_entry} >> ${header}
+cat >> ${header} << END
+#endif /* MR_DEEP_PROFILING */
+#endif /* ${protect} */
+END
+
+#---------------------------------------------------------------------------#
+# assembler the source file
+
+cat ${tmp_prolog} > ${source}
+cat >> ${source} << END
+#include "mercury_imp.h"
+
+#ifdef MR_DEEP_PROFILING
+#include "mercury_deep_profiling_hand.h"
+#include "${header}"
+
+END
+cat ${tmp_define_entry} >> ${source}
+echo "MR_BEGIN_MODULE(${module})" >> ${source}
+cat ${tmp_init_entry} >> ${source}
+echo "MR_BEGIN_CODE" >> ${source}
+cat ${tmp_code} >> ${source}
+cat >> ${source} << END
+MR_END_MODULE
+#endif /* MR_DEEP_PROFILING */
+
+/* Ensure that the initialization code for the above module gets to run. */
+/*
+INIT mercury_sys_init_${module}
+*/
+
+/* forward declarations to suppress gcc -Wmissing-decl warnings */
+void mercury_sys_init_${module}_init(void);
+void mercury_sys_init_${module}_init_type_tables(void);
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_${module}_write_out_proc_statics(FILE *fp);
+#endif
+
+void mercury_sys_init_${module}_init(void)
+{
+#ifdef MR_DEEP_PROFILING
+ ${module}();
+#endif
+}
+
+void mercury_sys_init_${module}_init_type_tables(void)
+{
+ /* no types to register */
+}
+
+#ifdef MR_DEEP_PROFILING
+void mercury_sys_init_${module}_write_out_proc_statics(FILE *fp)
+{
+ /* no proc_statics to write out */
+}
+#endif
+END
+
+exit 0
cvs diff: Diffing trace
Index: trace/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/Mmakefile,v
retrieving revision 1.31
diff -u -b -r1.31 Mmakefile
--- trace/Mmakefile 2002/06/22 19:16:15 1.31
+++ trace/Mmakefile 2002/08/03 11:07:24
@@ -20,7 +20,7 @@
#-----------------------------------------------------------------------------#
CFLAGS += -I$(BROWSER_DIR) -g $(DLL_CFLAGS) \
- -DMERCURY_BOOTSTRAP_H -DMERCURY_CONF_BOOTSTRAP_H
+ -DMERCURY_CONF_BOOTSTRAP_H
MGNUCFLAGS += --no-ansi
#-----------------------------------------------------------------------------#
Index: trace/mercury_trace_vars.c
===================================================================
RCS file: /home/mercury1/repository/mercury/trace/mercury_trace_vars.c,v
retrieving revision 1.47
diff -u -b -r1.47 mercury_trace_vars.c
--- trace/mercury_trace_vars.c 2002/07/22 07:13:14 1.47
+++ trace/mercury_trace_vars.c 2002/08/02 07:53:46
@@ -747,11 +747,7 @@
** current typeinfo optimization scheme.
*/
-#ifdef MR_HIGHLEVEL_CODE
- #define unbound_ctor_name mdb__util__mdb__util__type_ctor_info_unbound_0
-#else
- #define unbound_ctor_name MR_type_ctor_info_name(mdb__util, unbound, 0)
-#endif
+#define unbound_ctor_name MR_NONSTD_TYPE_CTOR_INFO_NAME(mdb__util, unbound, 0)
MR_DECLARE_TYPE_CTOR_INFO_STRUCT(unbound_ctor_name);
cvs diff: Diffing util
Index: util/mkinit.c
===================================================================
RCS file: /home/mercury1/repository/mercury/util/mkinit.c,v
retrieving revision 1.86
diff -u -b -r1.86 mkinit.c
--- util/mkinit.c 2002/02/18 07:01:33 1.86
+++ util/mkinit.c 2002/07/26 02:37:38
@@ -258,11 +258,11 @@
" mercury__builtin__builtin__type_ctor_info_tuple_0;\n"
"#else\n"
"extern const struct MR_TypeCtorInfo_Struct\n"
- " mercury_data___type_ctor_info_func_0;\n"
+ " mercury_data_builtin__type_ctor_info_func_0;\n"
"extern const struct MR_TypeCtorInfo_Struct\n"
- " mercury_data___type_ctor_info_pred_0;\n"
+ " mercury_data_builtin__type_ctor_info_pred_0;\n"
"extern const struct MR_TypeCtorInfo_Struct\n"
- " mercury_data___type_ctor_info_tuple_0;\n"
+ " mercury_data_builtin__type_ctor_info_tuple_0;\n"
"#endif\n"
"\n"
"void\n"
@@ -313,11 +313,11 @@
" &mercury__builtin__builtin__type_ctor_info_tuple_0;\n"
"#else\n"
" MR_address_of_type_ctor_info_for_func ="
- " &mercury_data___type_ctor_info_func_0;\n"
+ " &mercury_data_builtin__type_ctor_info_func_0;\n"
" MR_address_of_type_ctor_info_for_pred ="
- " &mercury_data___type_ctor_info_pred_0;\n"
+ " &mercury_data_builtin__type_ctor_info_pred_0;\n"
" MR_address_of_type_ctor_info_for_tuple ="
- " &mercury_data___type_ctor_info_tuple_0;\n"
+ " &mercury_data_builtin__type_ctor_info_tuple_0;\n"
"#endif\n"
"#ifdef MR_CONSERVATIVE_GC\n"
" MR_address_of_init_gc = init_gc;\n"
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