for review: type_info/X switcheroo.

[Tyson Dowd]

Hi,

Here's the other half of the type_info fiasco. 

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


Estimated hours taken: 3

Allow private_builtin:type_info/1 to be printed using io__write.

library/io.m:
	Use another horrible hack to find private_builtin:type_info/1
	to be detected and handled as if it were std_util:type_info/0
	for printing.

library/private_builtin.m:
	Add a hand-written type defintion for
	private_builtin:type_info/1.  (Much the same definition that
	was previously used for std_util:type_info/0.

library/std_util.m:
	Define std_util:type_info/0 as an abstract equivalence to
	private_builtin:type_info/1.
	Remove the old type defintions for std_util:type_info/0.



Index: library/io.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/io.m,v
retrieving revision 1.159
diff -u -r1.159 io.m
--- io.m	1998/07/22 07:41:32	1.159
+++ io.m	1998/07/31 00:37:33
@@ -1708,6 +1708,12 @@
 		io__write_univ_as_univ(OrigUniv)
 	; { univ_to_type(Univ, C_Pointer) } ->
 		io__write_c_pointer(C_Pointer)
+	; { type_ctor_name(type_ctor(univ_type(Univ))) = "type_info" },
+	  { type_ctor_module_name(type_ctor(univ_type(Univ))) =
+			"private_builtin" } ->
+	  	% XXX Horrible hack!
+		{ TypeInfo = unsafe_cast(univ_value_as_type_any(Univ)) },
+		io__write_string(type_name(TypeInfo))
 	; { type_ctor_name(type_ctor(univ_type(Univ))) = "array" },
 	  { type_ctor_module_name(type_ctor(univ_type(Univ))) = "array" } ->
 		%
@@ -1725,6 +1731,25 @@
 	;
 		io__write_ordinary_term(Univ, Priority)
 	).
+
+	% XXX These two functions and the type definition 
+	% are just temporary, they are used for the
+	% horrible hack above.
+
+:- func unsafe_cast(T1::in) = (T2::out) is det.
+:- pragma c_code(unsafe_cast(VarIn::in) = (VarOut::out),
+	will_not_call_mercury, "
+	VarOut = VarIn;
+").
+
+:- type any == c_pointer.
+
+:- func univ_value_as_type_any(univ) = any.
+:- pragma c_code(univ_value_as_type_any(Univ::in) = (Val::out),
+	will_not_call_mercury, "
+	Val = field(mktag(0), Univ, UNIV_OFFSET_FOR_DATA);
+").
+
 
 :- pred io__write_univ_as_univ(univ, io__state, io__state).
 :- mode io__write_univ_as_univ(in, di, uo) is det.
Index: library/private_builtin.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/private_builtin.m,v
retrieving revision 1.4
diff -u -r1.4 private_builtin.m
--- private_builtin.m	1998/07/27 21:14:00	1.4
+++ private_builtin.m	1998/08/02 07:49:41
@@ -1219,6 +1219,115 @@
 ").
 
 
+:- pragma c_code("
+
+
+Define_extern_entry(mercury____Unify___private_builtin__type_info_1_0);
+Define_extern_entry(mercury____Index___private_builtin__type_info_1_0);
+Define_extern_entry(mercury____Compare___private_builtin__type_info_1_0);
+
+extern const struct
+	mercury_data_private_builtin__base_type_layout_type_info_1_struct 
+	mercury_data_private_builtin__base_type_layout_type_info_1;
+extern const struct
+	mercury_data_private_builtin__base_type_functors_type_info_1_struct
+	mercury_data_private_builtin__base_type_functors_type_info_1;
+
+MR_STATIC_CODE_CONST struct
+mercury_data_private_builtin__base_type_info_type_info_1_struct {
+	Integer f1;
+	Code *f2;
+	Code *f3;
+	Code *f4;
+	const Word *f5;
+	const Word *f6;
+	const Word *f7;
+	const Word *f8;
+} mercury_data_private_builtin__base_type_info_type_info_1 = {
+	((Integer) 1),
+	MR_MAYBE_STATIC_CODE(ENTRY(
+		mercury____Unify___private_builtin__type_info_1_0)),
+	MR_MAYBE_STATIC_CODE(ENTRY(
+		mercury____Index___private_builtin__type_info_1_0)),
+	MR_MAYBE_STATIC_CODE(ENTRY(
+		mercury____Compare___private_builtin__type_info_1_0)),
+	(const Word *) &
+		mercury_data_private_builtin__base_type_layout_type_info_1,
+	(const Word *) &
+		mercury_data_private_builtin__base_type_functors_type_info_1,
+	(const Word *) string_const(""private_builtin"", 15),
+	(const Word *) string_const(""type_info"", 9)
+};
+
+
+const struct mercury_data_private_builtin__base_type_layout_type_info_1_struct {
+	TYPE_LAYOUT_FIELDS
+} mercury_data_private_builtin__base_type_layout_type_info_1 = {
+	make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG, 
+		mkbody(TYPELAYOUT_TYPEINFO_VALUE))
+};
+
+const struct mercury_data_private_builtin__base_type_functors_type_info_1_struct {
+	Integer f1;
+} mercury_data_private_builtin__base_type_functors_type_info_1 = {
+	MR_TYPEFUNCTORS_SPECIAL
+};
+
+
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Unify___private_builtin__type_info_1_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Index___private_builtin__type_info_1_0);
+MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Compare___private_builtin__type_info_1_0);
+BEGIN_MODULE(type_info_module)
+Define_entry(mercury____Unify___private_builtin__type_info_1_0);
+{
+	/*
+	** Unification for type_info.
+	**
+	** The two inputs are in the registers named by unify_input[12].
+	** The success/failure indication should go in unify_output.
+	*/
+	int comp;
+	save_transient_registers();
+	comp = MR_compare_type_info(unify_input1, unify_input2);
+	restore_transient_registers();
+	unify_output = (comp == COMPARE_EQUAL);
+	proceed();
+}
+
+Define_entry(mercury____Index___private_builtin__type_info_1_0);
+	index_output = -1;
+	proceed();
+
+Define_entry(mercury____Compare___private_builtin__type_info_1_0);
+{
+	/*
+	** Comparison for type_info:
+	**
+	** The two inputs are in the registers named by compare_input[12].
+	** The result should go in compare_output.
+	*/
+	int comp;
+	save_transient_registers();
+	comp = MR_compare_type_info(unify_input1, unify_input2);
+	restore_transient_registers();
+	compare_output = comp;
+	proceed();
+}
+END_MODULE
+
+/* Ensure that the initialization code for the above module gets run. */
+/*
+INIT sys_init_type_info_module
+*/
+extern ModuleFunc unify_univ_module;
+void sys_init_type_info_module(void); /* suppress gcc -Wmissing-decl warning */
+void sys_init_type_info_module(void) {
+	extern ModuleFunc type_info_module;
+	type_info_module();
+}
+
+").
+
 :- end_module private_builtin.
 
 %-----------------------------------------------------------------------------%
Index: library/std_util.m
===================================================================
RCS file: /home/staff/zs/imp/mercury/library/std_util.m,v
retrieving revision 1.124
diff -u -r1.124 std_util.m
--- std_util.m	1998/07/22 07:42:06	1.124
+++ std_util.m	1998/07/31 05:31:32
@@ -943,6 +943,13 @@
 		"Y = X;").
 %-----------------------------------------------------------------------------%
 
+	% We define type_info as the same as the private_builtin
+	% defintion of type_info.  `unit' is just used as a placeholder.
+	% type_info/1 is defined internally, and the type parameter
+	% is really some sort of existential type.
+	
+:- type type_info == private_builtin:type_info(unit). 
+
 univ_to_type(Univ, X) :- type_to_univ(X, Univ).
 
 univ(X) = Univ :- type_to_univ(X, Univ).
@@ -1056,19 +1063,6 @@
 	MR_TYPEFUNCTORS_UNIV
 };
 
-const struct mercury_data_std_util__base_type_layout_type_info_0_struct {
-	TYPE_LAYOUT_FIELDS
-} mercury_data_std_util__base_type_layout_type_info_0 = {
-	make_typelayout_for_all_tags(TYPELAYOUT_CONST_TAG, 
-		mkbody(TYPELAYOUT_TYPEINFO_VALUE))
-};
-
-const struct mercury_data_std_util__base_type_functors_type_info_0_struct {
-	Integer f1;
-} mercury_data_std_util__base_type_functors_type_info_0 = {
-	MR_TYPEFUNCTORS_SPECIAL
-};
-
 #endif
 
 Define_extern_entry(mercury____Unify___std_util__univ_0_0);
@@ -1080,22 +1074,12 @@
 MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Compare___std_util__univ_0_0);
 MR_MAKE_STACK_LAYOUT_INTERNAL(mercury____Compare___std_util__univ_0_0, 1);
 
-Define_extern_entry(mercury____Unify___std_util__type_info_0_0);
-Define_extern_entry(mercury____Index___std_util__type_info_0_0);
-Define_extern_entry(mercury____Compare___std_util__type_info_0_0);
-MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Unify___std_util__type_info_0_0);
-MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Index___std_util__type_info_0_0);
-MR_MAKE_STACK_LAYOUT_ENTRY(mercury____Compare___std_util__type_info_0_0);
 
 BEGIN_MODULE(unify_univ_module)
 	init_entry_sl(mercury____Unify___std_util__univ_0_0);
 	init_entry_sl(mercury____Index___std_util__univ_0_0);
 	init_entry_sl(mercury____Compare___std_util__univ_0_0);
 	init_label_sl(mercury____Compare___std_util__univ_0_0_i1);
-
-	init_entry_sl(mercury____Unify___std_util__type_info_0_0);
-	init_entry_sl(mercury____Index___std_util__type_info_0_0);
-	init_entry_sl(mercury____Compare___std_util__type_info_0_0);
 BEGIN_CODE
 Define_entry(mercury____Unify___std_util__univ_0_0);
 {
@@ -1205,42 +1189,6 @@
 	r1 = r2;
 	proceed();
 #endif
-
-Define_entry(mercury____Unify___std_util__type_info_0_0);
-{
-	/*
-	** Unification for type_info.
-	**
-	** The two inputs are in the registers named by unify_input[12].
-	** The success/failure indication should go in unify_output.
-	*/
-	int comp;
-	save_transient_registers();
-	comp = MR_compare_type_info(unify_input1, unify_input2);
-	restore_transient_registers();
-	unify_output = (comp == COMPARE_EQUAL);
-	proceed();
-}
-
-Define_entry(mercury____Index___std_util__type_info_0_0);
-	index_output = -1;
-	proceed();
-
-Define_entry(mercury____Compare___std_util__type_info_0_0);
-{
-	/*
-	** Comparison for type_info:
-	**
-	** The two inputs are in the registers named by compare_input[12].
-	** The result should go in compare_output.
-	*/
-	int comp;
-	save_transient_registers();
-	comp = MR_compare_type_info(unify_input1, unify_input2);
-	restore_transient_registers();
-	compare_output = comp;
-	proceed();
-}
 
 END_MODULE
 


-- 
       Tyson Dowd           # There isn't any reason why Linux can't be
                            # implemented as an enterprise computing solution.
     trd at cs.mu.oz.au        # Find out what you've been missing while you've
http://www.cs.mu.oz.au/~trd # been rebooting Windows NT. -- InfoWorld, 1998.