[m-rev.] for review: start implementing RTTI in Mercury

[Tyson Dowd]

Hi,

This change allows us to pass the tests/general/univ.m test case.

===================================================================


Estimated hours taken: 10
Branches: main

Begin to implement RTTI functionality in Mercury.
(Currently we just implement type_info comparisons for the .NET backend).

compiler/modules.m:
	Add rtti_implementation to the list of library modules.

library/rtti_implementation.m:
        Add a new module to implement RTTI for the .NET (and possibly
        Java) backend.  This module tries to do most of the RTTI tasks
        in Mercury rather than in C.  Hopefully it will be easier to
        port this implementation in future.

library/std_util.m:
        Call into rtti.m to compare type_infos.

runtime/mercury_il.il:
        Add some IL code to get the type_ctor_info from a type_info.
        (It's hard to write this code in MC++ or C#, and there seems to
        be a bug in the IL interface that stops me writing IL
        foreign_proc for it at the moment).

runtime/mercury_il.il:
	Add helper functions to get the function pointers for tuple
	compare and unify procedures.

runtime/mercury_mcpp.cpp:
runtime/mercury_mcpp.h:
	Add tuple to the type_ctor_rep.

runtime/mercury_type_info.h:
	Mention that changes in the type_ctor_rep might require changes
	in rtti_implementation and mercury_mcpp.{h,cpp}.


Index: compiler/modules.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.193
diff -u -r1.193 modules.m
--- compiler/modules.m	15 Aug 2001 07:58:17 -0000	1.193
+++ compiler/modules.m	16 Aug 2001 14:10:24 -0000
@@ -669,6 +669,7 @@
 mercury_std_library_module("rbtree").
 mercury_std_library_module("relation").
 mercury_std_library_module("require").
+mercury_std_library_module("rtti_implementation").
 mercury_std_library_module("set").
 mercury_std_library_module("set_bbbtree").
 mercury_std_library_module("set_ordlist").
Index: library/rtti_implementation.m
===================================================================
RCS file: library/rtti_implementation.m
diff -N library/rtti_implementation.m
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ library/rtti_implementation.m	16 Aug 2001 14:10:25 -0000
@@ -0,0 +1,272 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 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.
+%-----------------------------------------------------------------------------%
+
+% File: rtti_implementation.m.
+% Main author: trd.
+% Stability: low.
+
+% This file is intended to provide portable RTTI functionality by implementing
+% most of Mercury's RTTI functionality in Mercury.
+%
+% This is simpler writing large amounts of low-level C code, and is much
+% easier to maintain and port to new platforms.
+%
+% This module is not complete, currently only enough functionality is
+% present to implement type_info comparisons and unifications (which is enough
+% to get univ working).
+%
+% The plan is to have RTTI functions in std_util.m call into this module
+% as they are implemented in Mercury.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- module rtti_implementation.
+
+:- interface.
+
+	% Our type_info and type_ctor_info implementations are both
+	% abstract types.
+:- type type_info.
+:- type type_ctor_info.
+
+:- func get_type_info(T::unused) = (type_info::out) is det.
+
+:- pred compare_type_infos(comparison_result::out,
+		type_info::in, type_info::in) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module require.
+
+	% std_util has a lot of types and functions with the same names,
+	% so we prefer to keep the namespace separate.
+:- use_module std_util.
+
+	% It is convenient to represent the type_ctor_rep as a Mercury 
+	% enumeration, so 
+	%
+	% The type_ctor_rep needs to be kept up to date with the real
+	% definition in runtime/mercury_type_info.h.
+:- type type_ctor_rep 
+	---> 	enum 
+	; 	enum_usereq
+	;	du
+	;	du_usereq
+	;	notag
+	;	notag_usereq
+	;	equiv
+	;	equiv_var
+	;	int
+	;	char
+	;	float
+	;	string
+	;	(pred)
+	;	univ
+	;	void
+	;	c_pointer
+	;	typeinfo
+	;	typeclassinfo
+	;	array
+	;	succip
+	;	hp
+	;	currfr
+	;	maxfr
+	;	redofr
+	;	redoip
+	;	trail_ptr
+	;	ticket
+	;	notag_ground
+	;	notag_ground_usereq
+	;	equiv_ground
+	;	tuple
+	;	unknown.
+
+
+	% We keep all the other types abstract.
+
+:- type type_ctor_info ---> type_ctor_info(c_pointer).
+:- type type_info ---> type_info(c_pointer).
+:- type compare_pred ---> compare_pred(c_pointer).
+:- type type_functors ---> type_functors(c_pointer).
+:- type type_layout ---> type_layout(c_pointer).
+:- type pred_type ---> pred_type(c_pointer).
+:- type pseudo_type_info ---> pred_type(c_pointer).
+
+:- pragma foreign_proc("C#",
+	get_type_info(_T::unused) = (TypeInfo::out), [], " 
+	TypeInfo = TypeInfo_for_T;
+").
+
+:- pragma foreign_proc("C",
+	get_type_info(_T::unused) = (TypeInfo::out), [], "
+	TypeInfo = TypeInfo_for_T;
+").
+
+compare_type_infos(Res, TypeInfo1, TypeInfo2) :-
+	( same_pointer_value(TypeInfo1, TypeInfo2) ->
+		Res = (=)
+	;
+		NewTypeInfo1 = collapse_equivalences(TypeInfo1),
+		NewTypeInfo2 = collapse_equivalences(TypeInfo2),
+		( same_pointer_value(NewTypeInfo1, NewTypeInfo2) ->
+			Res = (=)
+		;
+			compare_collapsed_type_infos(Res, TypeInfo1, TypeInfo2)
+		)
+	).
+
+:- pred compare_collapsed_type_infos(comparison_result::out,
+		type_info::in, type_info::in) is det.
+compare_collapsed_type_infos(Res, TypeInfo1, TypeInfo2) :-
+	get_type_ctor_info(TypeInfo1, TypeCtorInfo1),
+	get_type_ctor_info(TypeInfo2, TypeCtorInfo2),
+
+		% The comparison here is arbitrary.
+		% In the past we just compared pointers of the type_c
+	compare(NameRes, TypeCtorInfo1 ^ type_ctor_name,
+		TypeCtorInfo2 ^ type_ctor_name),
+	( NameRes = (=) ->
+		compare(Res, 
+			TypeCtorInfo1 ^ type_ctor_module_name,
+			TypeCtorInfo2 ^ type_ctor_module_name),
+		( 
+			Res = (=),
+			TypeCtorInfo1 ^ type_ctor_module_name = "builtin",
+			( TypeCtorInfo1 ^ type_ctor_name = "tuple" 
+			; TypeCtorInfo1 ^ type_ctor_name = "pred" 
+			; TypeCtorInfo1 ^ type_ctor_name = "func" 
+			)
+		->
+			error("rtti_implementation.m: unimplemented: tuples and higher order type comparisons")
+		;
+			true
+		)
+
+		% XXX code to handle tuples and higher order
+	;
+		Res = NameRes
+	).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+	% In the .NET backend, we don't generally have to collapse equivalences
+	% because they are already collapsed (this is why il grades require
+	% intermodule optimization).
+	% 
+	% XXX For other backends this code may have to be completed.
+
+:- func collapse_equivalences(type_info) = type_info.
+collapse_equivalences(TypeInfo) = NewTypeInfo :-
+	get_type_ctor_info(TypeInfo, TypeCtorInfo),
+	( 
+		( 
+		  TypeCtorInfo ^ type_ctor_rep = equiv_ground 
+		;
+		  TypeCtorInfo ^ type_ctor_rep = equiv 
+		)
+	->
+		error("rtti_implementation.m: unimplemented: collapsing equivalence types")
+	;
+		NewTypeInfo = TypeInfo
+	).
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- pred get_type_ctor_info(type_info::in, type_ctor_info::out) is det.
+
+	% XXX Some bug in the handling of foreign_proc IL stopped me
+	% implementing this in IL directly, so for the moment I will just work
+	% around it by calling the IL from C#. -- trd.
+
+:- pragma foreign_proc("C#",
+	get_type_ctor_info(TypeInfo::in, TypeCtorInfo::out), [],
+"
+	TypeCtorInfo = mercury.runtime.RuntimeHelperFunctions.get_type_ctor_info(TypeInfo);
+").
+
+:- pragma foreign_proc("C",
+	get_type_ctor_info(TypeInfo::in, TypeCtorInfo::out), [],
+"
+	TypeCtorInfo = (MR_Word) MR_TYPEINFO_GET_TYPE_CTOR_INFO(
+		(MR_TypeInfo) TypeInfo);
+").
+
+
+:- pred same_pointer_value(T::in, T::in) is semidet.
+
+:- pragma foreign_proc("MC++",
+	same_pointer_value(T1::in, T2::in), [], "
+	SUCCESS_INDICATOR = (T1 == T2);
+").
+:- pragma foreign_proc("C",
+	same_pointer_value(T1::in, T2::in), [], "
+	SUCCESS_INDICATOR = (T1 == T2);
+").
+
+%-----------------------------------------------------------------------------%
+
+:- func type_ctor_rep(type_ctor_info) = type_ctor_rep.
+:- pragma foreign_proc("C#",
+	type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out), [], "
+	int rep;
+	rep = (int) TypeCtorInfo[4];
+	TypeCtorRep = mercury.runtime.LowLevelData.make_enum(rep);
+").
+:- pragma foreign_proc("C",
+	type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out), [], "
+	MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
+	TypeCtorRep = tci->type_ctor_rep;
+").
+
+
+:- func type_ctor_module_name(type_ctor_info) = string.
+
+:- pragma foreign_proc("C#",
+	type_ctor_module_name(TypeCtorInfo::in) = (Name::out), [], "
+	Name = (string) TypeCtorInfo[7];
+").
+
+:- pragma foreign_proc("C",
+	type_ctor_module_name(TypeCtorInfo::in) = (Name::out), [], "
+	MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
+	Name = (MR_String) tci->type_ctor_module_name;
+").
+
+
+
+:- func type_ctor_name(type_ctor_info) = string.
+
+:- pragma foreign_proc("C#",
+	type_ctor_name(TypeCtorInfo::in) = (Name::out), [], "
+	Name = (string) TypeCtorInfo[8];
+").
+:- pragma foreign_proc("C",
+	type_ctor_name(TypeCtorInfo::in) = (Name::out), [], "
+	MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
+	Name = (MR_String) tci->type_ctor_name;
+").
+
+
+:- func type_layout(type_ctor_info) = type_layout.
+
+:- pragma foreign_proc("C#",
+	type_layout(TypeCtorInfo::in) = (TypeLayout::out), [], "
+	TypeLayout = (object[]) TypeCtorInfo[11];
+").
+:- pragma foreign_proc("C",
+	type_layout(TypeCtorInfo::in) = (TypeLayout::out), [], "
+	MR_TypeCtorInfo tci = (MR_TypeCtorInfo) TypeCtorInfo;
+	TypeLayout = tci->type_layout;
+").
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.237
diff -u -r1.237 std_util.m
--- library/std_util.m	14 Aug 2001 10:18:47 -0000	1.237
+++ library/std_util.m	16 Aug 2001 14:10:26 -0000
@@ -1411,28 +1411,57 @@
 
 ").
 
+	% We need to call the rtti_implementation module -- so that we get the
+	% dependencies right it's easiest to do it from Mercury.
+:- interface.
+:- use_module rtti_implementation.
+:- pred call_rtti_compare_type_infos(comparison_result::out, 
+	rtti_implementation__type_info::in, rtti_implementation__type_info::in) is det.
+:- implementation.
+
+call_rtti_compare_type_infos(Res, T1, T2) :-
+	rtti_implementation__compare_type_infos(Res, T1, T2).
+
+
 :- pragma foreign_code("MC++", "
 
 MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(std_util, type_desc, 0, 
         MR_TYPECTOR_REP_TYPEINFO)
 
-static int MR_compare_type_info(MR_TypeInfo x, MR_TypeInfo y) {
-	mercury::runtime::Errors::SORRY(""foreign code for this function"");
-	return 0;
+static int MR_compare_type_info(MR_Word t1, MR_Word t2) {
+	MR_Word res;
+
+	mercury::std_util::mercury_code::call_rtti_compare_type_infos_3(
+		&res, t1, t2);
+	return System::Convert::ToInt32(res[0]);
+}
+
+static void
+__Compare____type_desc_0_0(
+    MR_Word_Ref result, MR_Word x, MR_Word y)
+{
+	mercury::std_util::mercury_code::call_rtti_compare_type_infos_3(
+		result, x, y);
 }
 
 static int
 __Unify____type_desc_0_0(MR_Word x, MR_Word y)
 {
-	mercury::runtime::Errors::SORRY(""unify for type_desc"");
-	return 0;
+	return (MR_compare_type_info(x, y) == MR_COMPARE_EQUAL);
 }
 
 static void
-__Compare____type_desc_0_0(
+special___Compare___type_desc_0_0(
     MR_Word_Ref result, MR_Word x, MR_Word y)
 {
-	mercury::runtime::Errors::SORRY(""compare for type_desc"");
+	mercury::std_util::mercury_code::call_rtti_compare_type_infos_3(
+		result, x, y);
+}
+
+static int
+special___Unify___type_desc_0_0(MR_Word x, MR_Word y)
+{
+	return (MR_compare_type_info(x, y) == MR_COMPARE_EQUAL);
 }
 
 static int
Index: runtime/mercury_il.il
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_il.il,v
retrieving revision 1.10
diff -u -r1.10 mercury_il.il
--- runtime/mercury_il.il	31 Jul 2001 10:08:01 -0000	1.10
+++ runtime/mercury_il.il	16 Aug 2001 14:10:27 -0000
@@ -42,6 +42,26 @@
 // MC++ used to handle this, and then it stopped working, so now it's just
 // not supported at all.  I hope it will make a comeback.
 
+.class public RuntimeHelperFunctions {
+
+.method public static default class [mscorlib]System.Object[]
+get_type_ctor_info(class [mscorlib]System.Object[] TypeInfo) {
+        ldarg TypeInfo
+	ldc.i4.0
+	ldelem.ref
+	isinst class [mscorlib]System.Object[]
+	brfalse isnull
+	ldarg TypeInfo
+	ldc.i4.0
+	ldelem.ref
+	castclass class [mscorlib]System.Object[]
+	ret
+isnull:
+	ldarg TypeInfo
+	ret
+}
+} // end class RuntimeHelperFunctions
+
 .class public TempHack {
 
 .method public static default int32 
Index: runtime/mercury_type_info.h
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury_type_info.h,v
retrieving revision 1.72
diff -u -r1.72 mercury_type_info.h
--- runtime/mercury_type_info.h	29 Jun 2001 03:22:19 -0000	1.72
+++ runtime/mercury_type_info.h	16 Aug 2001 14:10:28 -0000
@@ -514,6 +514,9 @@
 ** MR_TYPE_CTOR_REP_DU_USEREQ, the exact representation depends on the tag
 ** value -- lookup the tag value in type_ctor_layout to find out this
 ** information.
+**
+** Any changes in this definition might also require changes in
+** library/rtti_implementation.m and runtime/mercury_mcpp.{h,cpp}
 */
 
 typedef enum {


-- 
       Tyson Dowd           # 
                            #  Surreal humour isn't everyone's cup of fur.
     trd at cs.mu.oz.au        # 
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------