[m-rev.] for review: automatically generate all type_ctor_infos on non C backends

[Peter Ross]

On Fri, Nov 21, 2003 at 01:35:05AM +1100, Simon Taylor wrote:
> I think the use of "abstract" definitions of the builtin types 
> to force generation of RTTI is a bit of a kludge (for a start,
> the type name should be `int', not `builtin.int').  It would be
> better to handle the builtin types explicitly as a special case
> in make_hlds.m.
> 
It turns out that it is easier to do it that way, because transitive
intermodule optimization and may changes didn't interact well with
these abstract types.


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


Estimated hours taken: 4
Branches: main

Rather than declare the builtin types as abstract types in builtin.m
special case their handling in the compiler to ensure that the
special preds and the type_ctor_infos are generated when needed.


compiler/type_util.m:
	Add a utility predicate which returns the list of type_ctors
	which represent types which are special builtins (ie they have no type
	declaration, even an abstract one).

compiler/make_hlds.m:
	Add the special preds for the special builtins if we are generating
	the rtti for the builtins.
	
compiler/type_ctor_info.m:
	Add type_ctor_infos for the special builtins if we are generating
	the rtti for the builtins.

compiler/typecheck.m:
	The special predicates for the special builtins don't require
	typechecking.
	
library/builtin.m:
	Remove the special builtins as they are no longer needed for
	generating the type_ctor_infos for a type.


Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.452
diff -u -r1.452 make_hlds.m
--- compiler/make_hlds.m	20 Nov 2003 11:35:40 -0000	1.452
+++ compiler/make_hlds.m	20 Nov 2003 21:21:42 -0000
@@ -161,11 +161,30 @@
 		InvalidTypes1 = no,
 		module_info_types(Module2, Types),
 		map__foldl3(process_type_defn, Types,
-			no, InvalidTypes2, Module2, Module3, !IO)
+			no, InvalidTypes2, Module2, Module3a, !IO)
 	;
 		InvalidTypes1 = yes,
 		InvalidTypes2 = yes,
-		Module3 = Module2
+		Module3a = Module2
+	),
+
+	% Add the special preds for the builtins
+	(
+		Name = mercury_public_builtin_module,
+		compiler_generated_rtti_for_the_builtins(Module3a)
+	->
+		varset__init(TVarSet),
+		Body = abstract_type(non_solver_type),
+		term__context_init(Context),
+		Status = local,
+		list__foldl(
+			(pred(TypeCtor::in, M0::in, M::out) is det :-
+				construct_type(TypeCtor, [], Type),
+				add_special_preds(TVarSet, Type, TypeCtor,
+						Body, Context, Status, M0, M)
+			), builtin_type_ctors, Module3a, Module3)
+	;
+		Module3 = Module3a
 	),
 
 	maybe_report_stats(Statistics, !IO),
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.47
diff -u -r1.47 type_ctor_info.m
--- compiler/type_ctor_info.m	20 Nov 2003 11:35:41 -0000	1.47
+++ compiler/type_ctor_info.m	20 Nov 2003 21:21:42 -0000
@@ -79,14 +79,22 @@
 :- import_module parse_tree__prog_util.
 
 :- import_module bool, string, int, map, std_util, assoc_list, require.
-:- import_module set, term.
+:- import_module set, term, varset.
 
 %---------------------------------------------------------------------------%
 
 type_ctor_info__generate_hlds(!ModuleInfo) :-
 	module_info_name(!.ModuleInfo, ModuleName),
 	module_info_types(!.ModuleInfo, TypeTable),
-	map__keys(TypeTable, TypeCtors),
+	map__keys(TypeTable, TypeCtors0),
+	(
+		ModuleName = mercury_public_builtin_module,
+		compiler_generated_rtti_for_the_builtins(!.ModuleInfo)
+	->
+		TypeCtors = builtin_type_ctors ++ TypeCtors0
+	;
+		TypeCtors = TypeCtors0
+	),
 	type_ctor_info__gen_type_ctor_gen_infos(TypeCtors, TypeTable,
 		ModuleName, !.ModuleInfo, TypeCtorGenInfos),
 	module_info_set_type_ctor_gen_infos(TypeCtorGenInfos, !ModuleInfo).
@@ -106,45 +114,62 @@
 		ModuleName, ModuleInfo, TypeCtorGenInfos1),
 	TypeCtor = SymName - TypeArity,
 	(
-		SymName = qualified(TypeModuleName, TypeName),
-		( 
-			TypeModuleName = ModuleName,
-			map__lookup(TypeTable, TypeCtor, TypeDefn),
-			hlds_data__get_type_defn_body(TypeDefn, TypeBody),
-			(
-				TypeBody \= abstract_type(_)
-			->
-				\+ type_ctor_has_hand_defined_rtti(TypeCtor,
-					TypeBody),
-				( are_equivalence_types_expanded(ModuleInfo)
-					=> TypeBody \= eqv_type(_) )
-			;
-				% type_ctor_infos need be generated for the
-				% builtin types (which are declared as abstract
-				% types)
-				compiler_generated_rtti_for_the_builtins(
-					ModuleInfo),
-				TypeModuleName = unqualified(ModuleNameString),
-				( builtin_type_ctor(ModuleNameString,
+	    SymName = qualified(TypeModuleName, TypeName),
+	    ( 
+		TypeModuleName = ModuleName,
+		( list__member(TypeCtor, builtin_type_ctors) ->
+		    compiler_generated_rtti_for_the_builtins(ModuleInfo),
+		    TypeModuleName = unqualified(ModuleNameString),
+		    TypeDefn = builtin_type_defn,
+		    builtin_type_ctor(ModuleNameString, TypeName, TypeArity, _)
+		;
+		    map__lookup(TypeTable, TypeCtor, TypeDefn),
+		    hlds_data__get_type_defn_body(TypeDefn, TypeBody),
+		    (
+			TypeBody \= abstract_type(_)
+		    ->
+			\+ type_ctor_has_hand_defined_rtti(TypeCtor, TypeBody),
+			( are_equivalence_types_expanded(ModuleInfo)
+				=> TypeBody \= eqv_type(_) )
+		    ;
+			% type_ctor_infos need be generated for the builtin
+			% types (which are declared as abstract types)
+			compiler_generated_rtti_for_the_builtins(ModuleInfo),
+			TypeModuleName = unqualified(ModuleNameString),
+			( builtin_type_ctor(ModuleNameString,
 					TypeName, TypeArity, _)
-				; impl_type_ctor(ModuleNameString,
+			; impl_type_ctor(ModuleNameString,
 					TypeName, TypeArity, _)
-				)
 			)
-		->
-			type_ctor_info__gen_type_ctor_gen_info(TypeCtor,
-				TypeName, TypeArity, TypeDefn,
-				ModuleName, ModuleInfo, TypeCtorGenInfo),
-			TypeCtorGenInfos = [TypeCtorGenInfo | TypeCtorGenInfos1]
-		;
-			TypeCtorGenInfos = TypeCtorGenInfos1
+		    )
 		)
+	    ->
+		type_ctor_info__gen_type_ctor_gen_info(TypeCtor,
+			    TypeName, TypeArity, TypeDefn,
+			    ModuleName, ModuleInfo, TypeCtorGenInfo),
+		TypeCtorGenInfos = [TypeCtorGenInfo | TypeCtorGenInfos1]
+	    ;
+		TypeCtorGenInfos = TypeCtorGenInfos1
+	    )
 	;
-		SymName = unqualified(TypeName),
-		string__append_list(["unqualified type ", TypeName,
+	    SymName = unqualified(TypeName),
+	    string__append_list(["unqualified type ", TypeName,
 			"found in type_ctor_info"], Msg),
-		error(Msg)
+	    error(Msg)
 	).
+
+:- func builtin_type_defn = hlds_type_defn.
+
+builtin_type_defn = TypeDefn :-
+	varset__init(TVarSet),
+	Params = [],
+	Body = abstract_type(non_solver_type),
+	ImportStatus = local,
+	NeedQualifier = may_be_unqualified,
+	term__context_init(Context),
+	hlds_data__set_type_defn(TVarSet, Params, Body,
+			ImportStatus, NeedQualifier, Context, TypeDefn).
+
 
 :- pred type_ctor_info__gen_type_ctor_gen_info(type_ctor::in, string::in,
 	int::in, hlds_type_defn::in, module_name::in, module_info::in,
Index: compiler/type_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_util.m,v
retrieving revision 1.130
diff -u -r1.130 type_util.m
--- compiler/type_util.m	5 Nov 2003 03:17:44 -0000	1.130
+++ compiler/type_util.m	20 Nov 2003 21:21:43 -0000
@@ -69,6 +69,9 @@
 :- pred type_ctor_is_tuple(type_ctor).
 :- mode type_ctor_is_tuple(in) is semidet.
 
+	% The list of type_ctors which are builtins.
+:- func builtin_type_ctors = list(type_ctor).
+
 	% Succeed iff there was either a `where equality is <predname>' or a
 	% `where comparison is <predname>' declaration for the principal type
 	% constructor of the specified type, and return the ids of the declared
@@ -2054,5 +2057,18 @@
 
 cell_type_name(type_info_cell) = "type_info".
 cell_type_name(typeclass_info_cell) = "typeclass_info".
+
+%-----------------------------------------------------------------------------%
+
+builtin_type_ctors =
+	[ qualified(mercury_public_builtin_module, "int") - 0,
+	  qualified(mercury_public_builtin_module, "string") - 0,
+	  qualified(mercury_public_builtin_module, "character") - 0,
+	  qualified(mercury_public_builtin_module, "float") - 0,
+	  qualified(mercury_public_builtin_module, "pred") - 0,
+	  qualified(mercury_public_builtin_module, "func") - 0,
+	  qualified(mercury_public_builtin_module, "void") - 0,
+	  qualified(mercury_public_builtin_module, "tuple") - 0
+	].
 
 %-----------------------------------------------------------------------------%
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.345
diff -u -r1.345 typecheck.m
--- compiler/typecheck.m	5 Nov 2003 03:14:28 -0000	1.345
+++ compiler/typecheck.m	20 Nov 2003 21:21:47 -0000
@@ -859,6 +859,11 @@
 	pred_info_get_maybe_special_pred(PredInfo, MaybeSpecial),
 	MaybeSpecial = yes(_SpecialId - TypeCtor),
 	%
+	% check that the special pred isn't one of the builtin
+	% types
+	%
+	\+ list__member(TypeCtor, builtin_type_ctors),
+	%
 	% check whether that type is a type for which there is
 	% a user-defined equality predicate, or which is existentially typed.
 	%
Index: library/builtin.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/builtin.m,v
retrieving revision 1.96
diff -u -r1.96 builtin.m
--- library/builtin.m	20 Nov 2003 11:35:42 -0000	1.96
+++ library/builtin.m	20 Nov 2003 21:21:49 -0000
@@ -550,17 +550,6 @@
 
 ").
 
-% These abstract type declarations are needed so that the type_ctor
-% is generated for these types.
-:- type int.
-:- type string.
-:- type character.
-:- type float.
-:- type (pred).
-:- type (func).
-:- type void.
-:- type tuple.
-
 :- pragma foreign_code("C#", "
 	
 public static bool

--------------------------------------------------------------------------
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
--------------------------------------------------------------------------