[m-rev.] diff: support io__write for `il' grade

[Fergus Henderson]

Estimated hours taken: 2
Branches: main

Support io__write for `il' grade.
With this patch, tests/hard_coded/write now works
up to the point where it tries to write out a tuple.

library/type_desc.m:
	Implement type_ctor_name_and_arity in Mercury code,
	by calling the corresponding routine in rtti_implementation.m.

library/rtti_implementation.m:
	Modify the C# implementations of get_subterm and get_secondary_tag
	to support --high-level-data, using the facilities in
	System.Reflection.

Workspace: /c/fjh/ws/2/mercury
Index: library/rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.21
diff -u -d -r1.21 rtti_implementation.m
--- library/rtti_implementation.m	1 Aug 2002 11:52:24 -0000	1.21
+++ library/rtti_implementation.m	24 Oct 2002 17:03:58 -0000
@@ -971,8 +971,13 @@
 :- pragma foreign_proc("C#",
 	get_subterm(TypeInfo::in, Term::in, Index::in,
 		TagOffset::in) = (Arg::out), [promise_pure], "
-	// XXX This will not work for high level data.
-	Arg = ((object[]) Term)[Index + TagOffset];
+	try {
+		// try low level data
+		Arg = ((object[]) Term)[Index + TagOffset];
+	} catch (System.InvalidCastException) {
+		// try high level data
+		Arg = Term.GetType().GetFields()[Index].GetValue(Term);
+	}
 	TypeInfo_for_T = TypeInfo;
 ").
 
@@ -1133,8 +1138,14 @@
 
 :- pragma foreign_proc("C#",
 	get_remote_secondary_tag(X::in) = (Tag::out), [promise_pure], "
-	object[] data = (object[]) X;
-	Tag = (int) data[0];
+	try {
+		// try the low-level data representation
+		object[] data = (object[]) X;
+		Tag = (int) data[0];
+	} catch (System.InvalidCastException) {
+		// try the high-level data representation
+		Tag = (int) X.GetType().GetField(""data_tag"").GetValue(X);
+	}
 ").
 
 :- type sectag_locn ---> none ; local ; remote ; variable.
Index: library/type_desc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/type_desc.m,v
retrieving revision 1.14
diff -u -d -r1.14 type_desc.m
--- library/type_desc.m	9 Aug 2002 05:26:43 -0000	1.14
+++ library/type_desc.m	24 Oct 2002 17:03:58 -0000
@@ -591,11 +591,11 @@
         }
 }").
 
-type_ctor_name_and_arity(_TypeCtorDesc::in, _ModuleName::out,
-		_TypeCtorName::out, _TypeCtorArity::out) :-
-	% This version is only used for back-ends for which there is no
-	% matching foreign_proc version.
-	private_builtin__sorry("type_ctor_name_and_arity/4").
+type_ctor_name_and_arity(TypeCtorDesc::in, ModuleName::out,
+		TypeCtorName::out, TypeCtorArity::out) :-
+	rtti_implementation__type_ctor_name_and_arity(
+		rtti_implementation__unsafe_cast(TypeCtorDesc),
+		ModuleName, TypeCtorName, TypeCtorArity).
 
 %-----------------------------------------------------------------------------%
 
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------