[m-rev.] diff: MLDS->C back-end: fix bug with --high-level-data

[Fergus Henderson]

Branches: main
Estimated hours taken: 0.45

compiler/ml_type_gen.m:
	Fix a bug in one of my earlier changes that
	broke `--high-level-data' for the C back-end:
	don't generate constructors for back-ends that don't use them.

Workspace: /home/earth/fjh/ws-earth3/mercury
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.14
diff -u -d -r1.14 ml_type_gen.m
--- compiler/ml_type_gen.m	24 Oct 2001 07:09:53 -0000	1.14
+++ compiler/ml_type_gen.m	24 Oct 2001 07:41:15 -0000
@@ -578,16 +578,25 @@
 		Inherits = [ParentClassId],
 		Implements = [],
 
-		% generate a constructor function to initialize the fields
+		% generate a constructor function to initialize the fields,
+		% if needed (not all back-ends use constructor functions)
 		%
-		CtorClassType = mlds__class_type(qual(BaseClassQualifier,
-				UnqualCtorName), CtorArity, mlds__class),
-		CtorClassQualifier = mlds__append_class_qualifier(
+		module_info_globals(ModuleInfo, Globals),
+		globals__get_target(Globals, Target),
+		( target_uses_constructors(Target) = yes ->
+			CtorClassType = mlds__class_type(
+				qual(BaseClassQualifier, UnqualCtorName),
+				CtorArity, mlds__class),
+			CtorClassQualifier = mlds__append_class_qualifier(
 				BaseClassQualifier, UnqualCtorName, CtorArity),
-		CtorFunction = gen_constructor_function(BaseClassId,
-			CtorClassType, CtorClassQualifier, SecondaryTagClassId,
-			MaybeTagVal, Members, MLDS_Context),
-		Ctors = [CtorFunction],
+			CtorFunction = gen_constructor_function(BaseClassId,
+				CtorClassType, CtorClassQualifier,
+				SecondaryTagClassId, MaybeTagVal, Members,
+				MLDS_Context),
+			Ctors = [CtorFunction]
+		;
+			Ctors = []
+		),
 
 		% put it all together
 		MLDS_TypeName = type(UnqualCtorName, CtorArity),
@@ -598,6 +607,12 @@
 			MLDS_TypeFlags, MLDS_TypeDefnBody),
 		MLDS_Defns = [MLDS_TypeDefn | MLDS_Defns0]
 	).
+
+:- func target_uses_constructors(compilation_target) = bool.
+target_uses_constructors(c)	= no.
+target_uses_constructors(il)	= yes.
+target_uses_constructors(java)	= yes.
+target_uses_constructors(asm)	= no.
 
 :- func gen_constructor_function(mlds__class_id, mlds__type, mlds_module_name,
 		mlds__class_id, maybe(int), mlds__defns, mlds__context) =

-- 
Fergus Henderson <fjh at cs.mu.oz.au>  | "... it seems to me that 15 years of
The University of Melbourne         | email is plenty for one lifetime."
WWW: <http://www.cs.mu.oz.au/~fjh>  |     -- Prof. Donald E. Knuth
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------