[m-dev.] diff: fix bug with io__write(type_ctor_desc)

[Fergus Henderson]

On 21-Dec-2000, Fergus Henderson <fjh at cs.mu.OZ.AU> wrote:
> Estimated hours taken: 1.5
> 
> Fix a bug where io__write was crashing with a bus error
> if you tried to write out a `type_ctor_desc'.
> 
> library/std_util.m:
> 	Delete the type definition `type_ctor_desc == type_desc',
> 	since that is wrong -- `type_ctor_desc's for higher-order
> 	types do not have the same representation as `type_desc's.
> 	Instead use `type_ctor_desc ---> type_ctor_desc(c_pointer)',
> 	like we do for `io__state', etc.
> 
> library/io.m:
> 	Treat std_util__type_ctor_desc as a special case in
> 	io__write, so that we print a proper string for it,
> 	rather than just printing `type_ctor_desc(<<c_pointer>>)'.

I forgot to add a regression test.  Also I decided that `io__write'
should not output module qualifiers for builtin type_ctor_descs,
to match the behaviour of `std_util__type_name'.

So here's an addition to the log message and a new diff.
I'll go ahead and commit this on both the release and main branches.

tests/hard_coded/Mmakefile:
tests/hard_coded/type_ctor_desc.m:
tests/hard_coded/type_ctor_desc.exp:
	A regression test.

Workspace: /home/pgrad/fjh/ws/hg
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.216
diff -u -d -r1.216 io.m
--- library/io.m	2000/12/12 14:02:46	1.216
+++ library/io.m	2000/12/21 06:15:54
@@ -1956,6 +1956,8 @@
 		io__write_float(Float)
 	; { univ_to_type(Univ, TypeDesc) } ->
 		io__write_type_desc(TypeDesc)
+	; { univ_to_type(Univ, TypeCtorDesc) } ->
+		io__write_type_ctor_desc(TypeCtorDesc)
 	; { univ_to_type(Univ, OrigUniv) } ->
 		io__write_univ_as_univ(OrigUniv)
 	; { univ_to_type(Univ, C_Pointer) } ->
@@ -2208,6 +2210,25 @@
 
 io__write_type_desc(TypeDesc) -->
 	io__write_string(type_name(TypeDesc)).
+
+:- pred io__write_type_ctor_desc(type_ctor_desc, io__state, io__state).
+:- mode io__write_type_ctor_desc(in, di, uo) is det.
+
+io__write_type_ctor_desc(TypeCtorDesc) -->
+        { type_ctor_name_and_arity(TypeCtorDesc, ModuleName, Name, Arity0) },
+	{ ModuleName = "builtin", Name = "func" ->
+		% The type ctor that we call `builtin:func/N' takes N + 1
+		% type parameters: N arguments plus one return value.
+		% So we need to subtract one from the arity here.
+		Arity = Arity0 - 1
+	;
+		Arity = Arity0
+	},
+	( { ModuleName = "builtin" } ->
+		io__format("%s/%d", [s(Name), i(Arity)])
+	;
+		io__format("%s:%s/%d", [s(ModuleName), s(Name), i(Arity)])
+	).
 
 :- pred io__write_univ_as_univ(univ, io__state, io__state).
 :- mode io__write_univ_as_univ(in, di, uo) is det.
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.214
diff -u -d -r1.214 std_util.m
--- library/std_util.m	2000/12/18 07:42:53	1.214
+++ library/std_util.m	2000/12/21 06:13:14
@@ -1315,7 +1315,7 @@
 ** tuple, plus one encodes a predicate, plus two encodes a function.
 ** The maximum arity that can be encoded is given by MR_MAX_VARIABLE_ARITY
 ** (see below).
-** The C type corresponding to std_util:type_ctor_desc is `MR_TypeCtorInfo'.
+** The C type corresponding to std_util:type_ctor_desc is `MR_TypeCtorDesc'.
 */
 
 /*
@@ -1441,10 +1441,9 @@
 				             MR_Word arg_type_list);
 ").
 
-	% A type_ctor_desc is really just a subtype of type_desc,
-	% but we hide this from users, since it is an implementation
-	% detail.
-:- type type_ctor_desc == type_desc.
+	% A type_ctor_desc is not (quite) a subtype of type_desc,
+	% so we use a separate type for it.
+:- type type_ctor_desc ---> type_ctor_desc(c_pointer).
 
 :- pragma c_code(type_of(_Value::unused) = (TypeInfo::out),
 	will_not_call_mercury, "
Index: tests/hard_coded/Mmakefile
===================================================================
RCS file: /home/mercury1/repository/tests/hard_coded/Mmakefile,v
retrieving revision 1.106
diff -u -d -r1.106 Mmakefile
--- tests/hard_coded/Mmakefile	2000/12/15 07:41:26	1.106
+++ tests/hard_coded/Mmakefile	2000/12/21 06:18:13
@@ -113,6 +113,7 @@
 	tim_qual1 \
 	tuple_test \
 	tuple_test \
+	type_ctor_desc \
 	type_qual \
 	type_spec_modes \
 	type_to_term_bug \
Index: tests/hard_coded/type_ctor_desc.exp
===================================================================
RCS file: type_ctor_desc.exp
diff -N type_ctor_desc.exp
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ type_ctor_desc.exp	Thu Dec 21 17:17:36 2000
@@ -0,0 +1 @@
+func/1 [int, int]
Index: tests/hard_coded/type_ctor_desc.m
===================================================================
RCS file: type_ctor_desc.m
diff -N type_ctor_desc.m
--- /dev/null	Thu Mar 30 14:06:13 2000
+++ type_ctor_desc.m	Thu Dec 21 17:17:26 2000
@@ -0,0 +1,27 @@
+% A regression test for a bug with the printing
+% of type_ctor_descs via io__write.
+
+:- module type_ctor_desc.
+
+:- interface.
+:- use_module io.
+
+:- pred main(io__state, io__state).
+:- mode main(di, uo) is det.
+
+:- implementation.
+:- import_module int, integer, std_util.
+
+main -->
+	{ Type = std_util__type_of(test) },
+	{ std_util__type_ctor_and_args(Type, TypeCtor, TypeArgs) },
+	io__write(TypeCtor),
+	io__print(" "),
+	io__write(TypeArgs),
+	io__nl.
+
+:- func test(int) = int.
+:- mode test(in) = out is det.
+test(X) = Y :-
+	Y = X + 1.
+ 

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  |  "I have always known that the pursuit
                                    |  of excellence is a lethal habit"
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- the last words of T. S. Garp.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------