[m-dev.] for review: implement more compare/unify of builtins for MLDS

[Peter Ross]

Hi,

For Fergus to review.

I have no idea about the correctness of my changes, I just tried to find
out what the equivalent code in the LLDS backend did and port it across.

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


Estimated hours taken: 1

library/array.m:
runtime/mercury.c:
    Implement some NYI in mercury.c

Index: library/array.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/array.m,v
retrieving revision 1.75
diff -u -r1.75 array.m
--- library/array.m	2000/10/31 07:53:59	1.75
+++ library/array.m	2000/11/14 13:56:27
@@ -276,6 +276,22 @@
 void sys_init_array_module_builtins(void) {
 	return;
 }
+
+bool
+mercury__array____Unify____array_1_0(MR_Mercury_Type_Info type_info,
+	MR_Array x, MR_Array y)
+{
+	return mercury__array__array_equal_2_p_0(type_info, x, y);
+}
+
+void
+mercury__array____Compare____array_1_0(
+	MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+	MR_Array x, MR_Array y)
+{
+	mercury__array__array_compare_3_p_0(type_info, result, x, y);
+}
+
 #else
 
 MR_DEFINE_BUILTIN_TYPE_CTOR_INFO(array, array, 1, MR_TYPECTOR_REP_ARRAY);
Index: runtime/mercury.c
===================================================================
RCS file: /home/mercury1/repository/mercury/runtime/mercury.c,v
retrieving revision 1.14
diff -u -r1.14 mercury.c
--- runtime/mercury.c	2000/11/09 10:41:54	1.14
+++ runtime/mercury.c	2000/11/14 13:56:28
@@ -439,13 +439,6 @@
 }
 
 bool
-mercury__array____Unify____array_1_0(MR_Mercury_Type_Info type_info,
-	MR_Array x, MR_Array y)
-{
-	mercury__array__array_equal_2_p_0(type_info, x, y);
-}
-
-bool
 mercury__std_util____Unify____univ_0_0(MR_Univ x, MR_Univ y)
 {
 	MR_TypeInfo     typeinfo_x, typeinfo_y;
@@ -468,7 +461,16 @@
 bool
 mercury__std_util____Unify____type_desc_0_0(MR_Type_Desc x, MR_Type_Desc y)
 {
-	SORRY("unify for type_desc");
+	int             comp;
+
+		/* XXX this is what std_util does */
+	comp = MR_compare_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
+
+	if (comp == MR_COMPARE_EQUAL) {
+		return TRUE;
+	} else {
+		return FALSE;
+	}
 }
 
 bool
@@ -484,7 +486,15 @@
 	MR_Mercury_Type_Info type_info,
 	MR_Mercury_Type_Info x, MR_Mercury_Type_Info y)
 {
-	SORRY("unify for type_info");
+	int             comp;
+
+	comp = MR_compare_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
+
+	if (comp == MR_COMPARE_EQUAL) {
+		return TRUE;
+	} else {
+		return FALSE;
+	}
 }
 
 bool
@@ -492,7 +502,7 @@
 	MR_Mercury_Type_Info type_info,
 	MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y)
 {
-	SORRY("unify for typeclass_info");
+	MR_fatal_error("attempt to unify typeclass_info");
 }
 
 bool
@@ -605,14 +615,6 @@
 }
 
 void
-mercury__array____Compare____array_1_0(
-	MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
-	MR_Array x, MR_Array y)
-{
-	mercury__array__array_compare_3_p_0(type_info, result, x, y);
-}
-
-void
 mercury__std_util____Compare____univ_0_0(MR_Comparison_Result *result,
 	MR_Univ x, MR_Univ y)
 {
@@ -638,7 +640,11 @@
 mercury__std_util____Compare____type_desc_0_0(
 	MR_Comparison_Result *result, MR_Type_Desc x, MR_Type_Desc y)
 {
-	SORRY("compare for type_desc");
+	int             comp;
+
+		/* XXX this is just what the code in std_util does */
+	comp = MR_compare_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
+	*result = comp;
 }
 
 void
@@ -651,10 +657,13 @@
 
 void
 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)
+	MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
+	MR_Mercury_Type_Info x, MR_Mercury_Type_Info y)
 {
-	SORRY("compare for type_info");
+	int             comp;
+
+	comp = MR_compare_type_info((MR_TypeInfo) x, (MR_TypeInfo) y);
+	*result = comp;
 }
 
 void
@@ -662,7 +671,7 @@
 	MR_Mercury_Type_Info type_info, MR_Comparison_Result *result,
 	MR_Mercury_TypeClass_Info x, MR_Mercury_TypeClass_Info y)
 {
-	SORRY("compare for typeclass_info");
+	MR_fatal_error("attempt to compare typeclass_info");
 }
 
 void

--------------------------------------------------------------------------
mercury-developers mailing list
Post messages to:       mercury-developers at cs.mu.oz.au
Administrative Queries: owner-mercury-developers at cs.mu.oz.au
Subscriptions:          mercury-developers-request at cs.mu.oz.au
--------------------------------------------------------------------------