[m-rev.] diff: preparing to generate type_ctor_infos for builtin types

[Zoltan Somogyi]

This diff changes the behavior of the compiler only in the presence of type
declarations for builtin types, which don't exist yet, but will soon.

Zoltan.

Allow the compiler to generate type_ctor_infos for builtin and implementation
artifact types if they are declared as foreign types with user-defined unify
and compare preds.

compiler/rtti.m:
	Define the full list of builtin and implementation artifact types
	(including robdds, which should be added shortly, and subgoals, which
	already exist, but don't yet have their own type_ctor_rep).
	Map them to their respective (possibly future) type_ctor_reps.

compiler/type_ctor_info.m:
	Recognize builtin and implementation artifact types if we encounter a
	foreign type declaration for them.

compiler/rtti_out.m:
compiler/rtti_to_mlds.m:
	Add code to generate type_ctor_infos for builtin and implementation
	artifact types, if they are declared as foreign types.

cvs diff: Diffing .
Index: rtti.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti.m,v
retrieving revision 1.30
diff -u -b -r1.30 rtti.m
--- rtti.m	9 May 2003 00:45:10 -0000	1.30
+++ rtti.m	13 May 2003 07:37:58 -0000
@@ -359,27 +359,39 @@
 	;	self.
 
 	% The list of type constructors for types that are built into the
-	% Mercury language. The compiler never creates type_ctor_datas for
-	% these, but RTTI predicates implemented in Mercury will need to
-	% know about them.
+	% Mercury language or the Mercury standard library.
 :- type builtin_ctor
 	--->	int
 	;	float
 	;	char
 	;	string
-	;	univ
 	;	void
-	;	c_pointer.	% maybe more to come later
+	;	c_pointer
+	;	stable_c_pointer
+	;	pred_ctor
+	;	func_ctor
+	;	tuple
+	;	array
+	;	ref
+	;	type_desc
+	;	type_ctor_desc.
 
 	% The list of type constructors that are used behind the scenes by
-	% the Mercury implementation. The compiler never creates
-	% type_ctor_datas for these, but RTTI predicates implemented
-	% in Mercury will need to know about them.
+	% the Mercury implementation.
 :- type impl_ctor
-	--->	sp
-	;	hp
+	--->	hp
+	;	succip
 	;	maxfr
-	;	curfr.		% maybe more to come later
+	;	curfr
+	;	redofr
+	;	redoip
+	;	ticket
+	;	trail_ptr
+	;	type_info
+	;	type_ctor_info
+	;	typeclass_info
+	;	base_typeclass_info
+	;	subgoal.			% coming soon
 
 %-----------------------------------------------------------------------------%
 %
@@ -1094,15 +1106,50 @@
 			RepStr = "MR_TYPECTOR_REP_EQUIV_GROUND"
 		)
 	;
-		TypeCtorDetails = builtin(_),
-		error("rtti__type_ctor_rep_to_string: builtin")
+		TypeCtorDetails = builtin(BuiltinCtor),
+		builtin_ctor_rep_to_string(BuiltinCtor, RepStr)
 	;
-		TypeCtorDetails = impl_artifact(_),
-		error("rtti__type_ctor_rep_to_string: impl_artifact")
+		TypeCtorDetails = impl_artifact(ImplCtor),
+		impl_ctor_rep_to_string(ImplCtor, RepStr)
 	;
 		TypeCtorDetails = foreign,
 		RepStr = "MR_TYPECTOR_REP_FOREIGN"
 	).
+
+:- pred builtin_ctor_rep_to_string(builtin_ctor::in, string::out) is det.
+
+builtin_ctor_rep_to_string(array, "MR_TYPECTOR_REP_ARRAY").
+builtin_ctor_rep_to_string(int, "MR_TYPECTOR_REP_INT").
+builtin_ctor_rep_to_string(string, "MR_TYPECTOR_REP_STRING").
+builtin_ctor_rep_to_string(float, "MR_TYPECTOR_REP_FLOAT").
+builtin_ctor_rep_to_string(char, "MR_TYPECTOR_REP_CHAR").
+builtin_ctor_rep_to_string(void, "MR_TYPECTOR_REP_VOID").
+builtin_ctor_rep_to_string(c_pointer, "MR_TYPECTOR_REP_C_POINTER").
+builtin_ctor_rep_to_string(stable_c_pointer,
+	"MR_TYPECTOR_REP_STABLE_C_POINTER").
+builtin_ctor_rep_to_string(pred_ctor, "MR_TYPECTOR_REP_PRED").
+builtin_ctor_rep_to_string(func_ctor, "MR_TYPECTOR_REP_FUNC").
+builtin_ctor_rep_to_string(tuple, "MR_TYPECTOR_REP_TUPLE").
+builtin_ctor_rep_to_string(ref, "MR_TYPECTOR_REP_REFERENCE").
+builtin_ctor_rep_to_string(type_ctor_desc, "MR_TYPECTOR_REP_TYPECTORDESC").
+builtin_ctor_rep_to_string(type_desc, "MR_TYPECTOR_REP_TYPEDESC").
+
+:- pred impl_ctor_rep_to_string(impl_ctor::in, string::out) is det.
+
+impl_ctor_rep_to_string(type_ctor_info, "MR_TYPECTOR_REP_TYPECTORINFO").
+impl_ctor_rep_to_string(type_info, "MR_TYPECTOR_REP_TYPEINFO").
+impl_ctor_rep_to_string(typeclass_info, "MR_TYPECTOR_REP_TYPECLASSINFO").
+impl_ctor_rep_to_string(base_typeclass_info,
+	"MR_TYPECTOR_REP_BASETYPECLASSINFO").
+impl_ctor_rep_to_string(hp, "MR_TYPECTOR_REP_HP").
+impl_ctor_rep_to_string(succip, "MR_TYPECTOR_REP_SUCCIP").
+impl_ctor_rep_to_string(curfr, "MR_TYPECTOR_REP_CURFR").
+impl_ctor_rep_to_string(maxfr, "MR_TYPECTOR_REP_MAXFR").
+impl_ctor_rep_to_string(redofr, "MR_TYPECTOR_REP_REDOFR").
+impl_ctor_rep_to_string(redoip, "MR_TYPECTOR_REP_REDOIP").
+impl_ctor_rep_to_string(trail_ptr, "MR_TYPECTOR_REP_TRAIL_PTR").
+impl_ctor_rep_to_string(ticket, "MR_TYPECTOR_REP_TICKET").
+impl_ctor_rep_to_string(subgoal, "MR_TYPECTOR_REP_SUBGOAL").
 
 type_info_to_rtti_data(TypeInfo) = type_info(TypeInfo).
 
Index: rtti_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_out.m,v
retrieving revision 1.36
diff -u -b -r1.36 rtti_out.m
--- rtti_out.m	9 May 2003 00:45:11 -0000	1.36
+++ rtti_out.m	13 May 2003 04:13:29 -0000
@@ -418,10 +418,12 @@
 		MaybeFunctorsName = no
 	;
 		TypeCtorDetails = builtin(_),
-		error("output_type_ctor_details_defn: builtin")
+		MaybeLayoutName = no,
+		MaybeFunctorsName = no
 	;
 		TypeCtorDetails = impl_artifact(_),
-		error("output_type_ctor_details_defn: impl_artifact")
+		MaybeLayoutName = no,
+		MaybeFunctorsName = no
 	;
 		TypeCtorDetails = foreign,
 		MaybeLayoutName = no,
Index: rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.39
diff -u -b -r1.39 rtti_to_mlds.m
--- rtti_to_mlds.m	9 May 2003 00:45:11 -0000	1.39
+++ rtti_to_mlds.m	13 May 2003 01:22:24 -0000
@@ -358,10 +358,14 @@
 		FunctorInit = gen_init_null_pointer(mlds__generic_type)
 	;
 		TypeCtorDetails = builtin(_),
-		error("gen_functors_layout_info: builtin")
+		Defns = [],
+		LayoutInit = gen_init_null_pointer(mlds__generic_type),
+		FunctorInit = gen_init_null_pointer(mlds__generic_type)
 	;
 		TypeCtorDetails = impl_artifact(_),
-		error("gen_functors_layout_info: impl_artifact")
+		Defns = [],
+		LayoutInit = gen_init_null_pointer(mlds__generic_type),
+		FunctorInit = gen_init_null_pointer(mlds__generic_type)
 	;
 		TypeCtorDetails = foreign,
 		Defns = [],
Index: type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.38
diff -u -b -r1.38 type_ctor_info.m
--- type_ctor_info.m	9 May 2003 00:45:13 -0000	1.38
+++ type_ctor_info.m	13 May 2003 09:07:36 -0000
@@ -223,7 +223,21 @@
 		error("type_ctor_info__gen_type_ctor_data: abstract_type")
 	;
 		TypeBody = foreign_type(_),
+		(
+			ModuleName = unqualified(ModuleStr),
+			builtin_type_ctor(ModuleStr, TypeName, TypeArity,
+				BuiltinCtor)
+		->
+			Details = builtin(BuiltinCtor)
+		;
+			ModuleName = unqualified(ModuleStr),
+			impl_type_ctor(ModuleStr, TypeName, TypeArity,
+				ImplCtor)
+		->
+			Details = impl_artifact(ImplCtor)
+		;
 		Details = foreign
+		)
 	;
 		TypeBody = eqv_type(Type),
 			% There can be no existentially typed args to an
@@ -278,6 +292,41 @@
 	TypeCtorData = type_ctor_data(Version, ModuleName, TypeName, TypeArity,
 		UnifyUniv, CompareUniv, Flags, Details),
 	RttiData = type_ctor_info(TypeCtorData).
+
+:- pred builtin_type_ctor(string::in, string::in, int::in, builtin_ctor::out)
+	is semidet.
+
+builtin_type_ctor("array", "array", 1, array).
+builtin_type_ctor("builtin", "int", 0, int).
+builtin_type_ctor("builtin", "string", 0, string).
+builtin_type_ctor("builtin", "float", 0, float).
+builtin_type_ctor("builtin", "character", 0, char).
+builtin_type_ctor("builtin", "void", 0, void).
+builtin_type_ctor("builtin", "c_pointer", 0, c_pointer).
+builtin_type_ctor("builtin", "stable_c_pointer", 0, stable_c_pointer).
+builtin_type_ctor("builtin", "pred", 0, pred_ctor).
+builtin_type_ctor("builtin", "func", 0, func_ctor).
+builtin_type_ctor("builtin", "tuple", 0, tuple).
+builtin_type_ctor("private_builtin", "ref", 1, ref).
+builtin_type_ctor("type_desc", "type_ctor_desc", 0, type_ctor_desc).
+builtin_type_ctor("type_desc", "type_desc", 0, type_desc).
+
+:- pred impl_type_ctor(string::in, string::in, int::in, impl_ctor::out)
+	is semidet.
+
+impl_type_ctor("private_builtin", "type_ctor_info", 1, type_ctor_info).
+impl_type_ctor("private_builtin", "type_info", 1, type_info).
+impl_type_ctor("private_builtin", "typeclass_info", 1, typeclass_info).
+impl_type_ctor("private_builtin", "base_typeclass_info", 1,
+	base_typeclass_info).
+impl_type_ctor("private_builtin", "heap_pointer", 0, hp).
+impl_type_ctor("private_builtin", "succip", 0, succip).
+impl_type_ctor("private_builtin", "curfr", 0, curfr).
+impl_type_ctor("private_builtin", "maxfr", 0, maxfr).
+impl_type_ctor("private_builtin", "redofr", 0, redofr).
+impl_type_ctor("private_builtin", "trail_ptr", 0, trail_ptr).
+impl_type_ctor("private_builtin", "ticket", 0, ticket).
+impl_type_ctor("table_builtin", "ml_subgoal", 0, subgoal).
 
 :- pred type_ctor_info__make_rtti_proc_label(pred_proc_id::in, module_info::in,
 	rtti_proc_label::out) is det.
cvs diff: Diffing notes
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------