[m-dev.] diff: MLDS back-end: more bug fixes

[Fergus Henderson]

Estimated hours taken: 3

Some more fixes for the MLDS back-end.

compiler/mlds.m:
	Add "gc", "time", and "exception" to the list of
	standard library modules.

compiler/mlds_to_c.m:
	- Make sure we name the header files based on the MLDS
	  package name (e.g. mercury.float) rather than on the
	  Mercury module name (e.g. float), to avoid name clashes
	  with standard C header files.
	- Don't module-qualify main/2.
	- Avoid gcc warnings about "suggest braces to avoid
	  dangling else ambiguity".

compiler/ml_code_gen.m:
	Fix a bug in the module qualification of compiler-generated
	unify/compare/index procedures.

Workspace: /d-drive/home/hg/fjh/mercury
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.21
diff -u -d -r1.21 ml_code_gen.m
--- compiler/ml_code_gen.m	1999/12/03 17:01:09	1.21
+++ compiler/ml_code_gen.m	1999/12/03 19:20:58
@@ -184,7 +184,7 @@
 %	model_non in semi context: (using GNU C nested functions,
 %				GNU C local labels, and exiting
 %				the nested function by a goto
-%				to a lable in the containing function)
+%				to a label in the containing function)
 %		<succeeded = Goal>
 % 	===>
 %		bool succeeded;
@@ -214,7 +214,7 @@
 %	model_non in det context (using GNU C nested functions,
 %				GNU C local labels, and exiting
 %				the nested function by a goto
-%				to a lable in the containing function)
+%				to a label in the containing function)
 %		<do Goal>
 %	===>
 %		__label__ done;
@@ -593,9 +593,12 @@
 :- pred ml_code_gen(module_info, mlds, io__state, io__state).
 :- mode ml_code_gen(in, out, di, uo) is det.
 
-	% Generate the mlds__pred_label for a given procedure.
+	% Generate the mlds__pred_label and module name
+	% for a given procedure.
 	%
-:- func ml_gen_pred_label(module_info, pred_id, proc_id) = mlds__pred_label.
+:- pred ml_gen_pred_label(module_info, pred_id, proc_id,
+		mlds__pred_label, mlds_module_name).
+:- mode ml_gen_pred_label(in, in, in, out, out) is det.
 
 	% Generate the function prototype for a given procedure.
 	%
@@ -1627,11 +1631,9 @@
 ml_gen_proc_addr_rval(PredId, ProcId, CodeAddrRval) -->
 	=(MLDSGenInfo),
 	{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
-	{ PredLabel = ml_gen_pred_label(ModuleInfo, PredId, ProcId) },
-	{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
-	{ pred_info_module(PredInfo, PredModule) },
-	{ MLDS_Module = mercury_module_name_to_mlds(PredModule) },
-	{ QualifiedProcLabel = qual(MLDS_Module, PredLabel - ProcId) },
+	{ ml_gen_pred_label(ModuleInfo, PredId, ProcId,
+		PredLabel, PredModule) },
+	{ QualifiedProcLabel = qual(PredModule, PredLabel - ProcId) },
 	{ CodeAddrRval = const(code_addr_const(proc(QualifiedProcLabel))) }.
 
 %
@@ -2510,10 +2512,9 @@
 	{ ml_gen_info_get_module_info(Info, ModuleInfo) },
 	{ ml_gen_info_get_pred_id(Info, PredId) },
 	{ ml_gen_info_get_proc_id(Info, ProcId) },
-	{ PredLabel = ml_gen_pred_label(ModuleInfo, PredId, ProcId) },
-	{ module_info_name(ModuleInfo, ModuleName) },
-	{ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName) },
-	{ ProcLabel = qual(MLDS_ModuleName, PredLabel - ProcId) },
+	{ ml_gen_pred_label(ModuleInfo, PredId, ProcId,
+		PredLabel, PredModule) },
+	{ ProcLabel = qual(PredModule, PredLabel - ProcId) },
 	{ FuncLabelRval = const(code_addr_const(internal(ProcLabel,
 		FuncLabel))) }.
 
@@ -2944,10 +2945,9 @@
 	ml_gen_var(Var, VarLval),
 	=(Info),
 	{ ml_gen_info_get_module_info(Info, ModuleInfo) },
-	{ PredLabel = ml_gen_pred_label(ModuleInfo, PredId, ProcId) },
-	{ module_info_name(ModuleInfo, ModuleName) },
-	{ MLDS_Module = mercury_module_name_to_mlds(ModuleName) },
-	{ DataAddr = data_addr(MLDS_Module,
+	{ ml_gen_pred_label(ModuleInfo, PredId, ProcId,
+		PredLabel, PredModule) },
+	{ DataAddr = data_addr(PredModule,
 			tabling_pointer(PredLabel - ProcId)) },
 	{ MLDS_Statement = ml_gen_assign(VarLval, 
 		const(data_addr_const(DataAddr)), Context) }.
@@ -4024,10 +4024,10 @@
 :- func ml_gen_func_label(module_info, pred_id, proc_id,
 		maybe(ml_label_func)) = mlds__entity_name.
 ml_gen_func_label(ModuleInfo, PredId, ProcId, MaybeSeqNum) = MLDS_Name :-
-	MLDS_PredLabel = ml_gen_pred_label(ModuleInfo, PredId, ProcId),
+	ml_gen_pred_label(ModuleInfo, PredId, ProcId, MLDS_PredLabel, _),
 	MLDS_Name = function(MLDS_PredLabel, ProcId, MaybeSeqNum, PredId).
 
-ml_gen_pred_label(ModuleInfo, PredId, ProcId) = MLDS_PredLabel :-
+ml_gen_pred_label(ModuleInfo, PredId, ProcId, MLDS_PredLabel, MLDS_Module) :-
 	module_info_pred_info(ModuleInfo, PredId, PredInfo),
 	pred_info_module(PredInfo, PredModule),
 	pred_info_name(PredInfo, PredName),
@@ -4056,7 +4056,8 @@
 				DeclaringModule = no
 			),
 			MLDS_PredLabel = special_pred(PredName,
-				DeclaringModule, TypeName, Arity)
+				DeclaringModule, TypeName, Arity),
+			MLDS_Module = mercury_module_name_to_mlds(TypeModule)
 		;
 			string__append_list(["ml_gen_pred_label:\n",
 				"cannot make label for special pred `",
@@ -4081,7 +4082,8 @@
 		pred_info_get_is_pred_or_func(PredInfo, PredOrFunc),
 		pred_info_arity(PredInfo, Arity),
 		MLDS_PredLabel = pred(PredOrFunc, MaybeDeclaringModule,
-				PredName, Arity)
+				PredName, Arity),
+		MLDS_Module = mercury_module_name_to_mlds(PredModule)
 	).
 
 %-----------------------------------------------------------------------------%
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.14
diff -u -d -r1.14 mlds.m
--- compiler/mlds.m	1999/12/02 05:42:25	1.14
+++ compiler/mlds.m	1999/12/03 18:16:12
@@ -1189,7 +1189,9 @@
 mercury_std_library_module("char").
 mercury_std_library_module("dir").
 mercury_std_library_module("eqvclass").
+mercury_std_library_module("exception").
 mercury_std_library_module("float").
+mercury_std_library_module("gc").
 mercury_std_library_module("getopt").
 mercury_std_library_module("graph").
 mercury_std_library_module("group").
@@ -1224,6 +1226,7 @@
 mercury_std_library_module("string").
 mercury_std_library_module("term").
 mercury_std_library_module("term_io").
+mercury_std_library_module("time").
 mercury_std_library_module("tree234").
 mercury_std_library_module("varset").
 
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.18
diff -u -d -r1.18 mlds_to_c.m
--- compiler/mlds_to_c.m	1999/12/03 17:01:10	1.18
+++ compiler/mlds_to_c.m	1999/12/03 20:11:57
@@ -43,9 +43,26 @@
 %-----------------------------------------------------------------------------%
 
 mlds_to_c__output_mlds(MLDS) -->
+	%
+	% We need to use the MLDS package name to compute the header file
+	% names, giving e.g. `mercury.io.h', `mercury.time.h' etc.,
+	% rather than using just the Mercury module name, which would give
+	% just `io.h', `time.h', etc.  The reason for this is that if we
+	% don't, then we get name clashes with the standard C header files.
+	% For example, `time.h' clashes with the standard <time.h> header.
+	%
+	% But to keep the Mmake auto-dependencies working (or at least
+	% _mostly_ working!), we still want to name the `.c' file based
+	% on just the Mercury module name, giving e.g. `time.c', not
+	% `mercury.time.c'.
+	%
+	% Hence the different treatment of SourceFile and HeaderFile below.
+	%
 	{ ModuleName = mlds__get_module_name(MLDS) },
-	module_name_to_file_name(ModuleName, ".h", yes, HeaderFile),
 	module_name_to_file_name(ModuleName, ".c", yes, SourceFile),
+	{ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName) },
+	{ ModuleSymName = mlds_module_name_to_sym_name(MLDS_ModuleName) },
+	module_name_to_file_name(ModuleSymName, ".h", yes, HeaderFile),
 	{ Indent = 0 },
 	mlds_output_to_file(HeaderFile, mlds_output_hdr_file(Indent, MLDS)),
 	mlds_output_to_file(SourceFile, mlds_output_src_file(Indent, MLDS)).
@@ -190,10 +207,8 @@
 	mlds_indent(Indent),
 	io__write_string("/* :- implementation. */\n"),
 	io__nl,
-	module_name_to_file_name(ModuleName, ".h", no, HeaderFile),
-	io__write_string("#include """),
-	io__write_string(HeaderFile),
-	io__write_string("""\n"),
+	mlds_output_hdr_import(Indent,
+		mercury_module_name_to_mlds(ModuleName)),
 	io__nl.
 
 :- pred mlds_output_hdr_end(indent, mercury_module_name,
@@ -362,7 +377,7 @@
 
 mlds_output_class_decl(_Indent, Name, _ClassDefn) -->
 	io__write_string("struct "),
-	mlds_output_fully_qualified_name(Name, mlds_output_name).
+	mlds_output_fully_qualified_name(Name).
 
 :- pred mlds_output_class(indent, mlds__qualified_entity_name, mlds__context,
 		mlds__class_defn, io__state, io__state).
@@ -390,7 +405,7 @@
 mlds_output_data_decl(Name, Type) -->
 	mlds_output_type(Type),
 	io__write_char(' '),
-	mlds_output_fully_qualified_name(Name, mlds_output_name).
+	mlds_output_fully_qualified_name(Name).
 
 :- pred mlds_output_data_defn(mlds__qualified_entity_name, mlds__type,
 			maybe(mlds__initializer), io__state, io__state).
@@ -538,7 +553,7 @@
 		{ error("mlds_output_func: multiple return types") }
 	),
 	io__write_char(' '),
-	mlds_output_fully_qualified_name(Name, mlds_output_name),
+	mlds_output_fully_qualified_name(Name),
 	mlds_output_params(Indent, Name, Parameters).
 
 :- pred mlds_output_params(indent, qualified_entity_name, mlds__arguments,
@@ -562,8 +577,7 @@
 mlds_output_param(_Indent, qual(ModuleName, _FuncName), Name - Type) -->
 	mlds_output_type(Type),
 	io__write_char(' '),
-	mlds_output_fully_qualified_name(qual(ModuleName, Name),
-		mlds_output_name).
+	mlds_output_fully_qualified_name(qual(ModuleName, Name)).
 
 :- pred mlds_output_func_type(func_params, io__state, io__state).
 :- mode mlds_output_func_type(in, di, uo) is det.
@@ -604,12 +618,30 @@
 % Code to output names of various entities
 %
 
-:- pred mlds_output_fully_qualified_name(mlds__fully_qualified_name(T),
+:- pred mlds_output_fully_qualified_name(mlds__qualified_entity_name,
+		io__state, io__state).
+:- mode mlds_output_fully_qualified_name(in, di, uo) is det.
+
+mlds_output_fully_qualified_name(QualifiedName) -->
+	(
+		%
+		% don't module-qualify main/2
+		%
+		{ QualifiedName = qual(_ModuleName, Name) },
+		{ Name = function(PredLabel, _, _, _) },
+		{ PredLabel = pred(predicate, no, "main", 2) }
+	->
+		mlds_output_name(Name)
+	;
+		mlds_output_fully_qualified(QualifiedName, mlds_output_name)
+	).
+
+:- pred mlds_output_fully_qualified(mlds__fully_qualified_name(T),
 		pred(T, io__state, io__state), io__state, io__state).
-:- mode mlds_output_fully_qualified_name(in, pred(in, di, uo) is det,
+:- mode mlds_output_fully_qualified(in, pred(in, di, uo) is det,
 		di, uo) is det.
 
-mlds_output_fully_qualified_name(qual(ModuleName, Name), OutputFunc) -->
+mlds_output_fully_qualified(qual(ModuleName, Name), OutputFunc) -->
 	{ SymName = mlds_module_name_to_sym_name(ModuleName) },
 	{ llds_out__sym_name_mangle(SymName, MangledModuleName) },
 	io__write_string(MangledModuleName),
@@ -733,7 +765,7 @@
 mlds_output_type(mlds__char_type)  --> io__write_string("char").
 mlds_output_type(mlds__class_type(Name, Arity)) -->
 	io__write_string("struct "),
-	mlds_output_fully_qualified_name(Name, io__write_string),
+	mlds_output_fully_qualified(Name, io__write_string),
 	io__format("_%d", [i(Arity)]).
 mlds_output_type(mlds__ptr_type(Type)) -->
 	mlds_output_type(Type),
@@ -903,13 +935,46 @@
 	% dangling else ambiguity
 	%
 	{
+		%
+		% For examples of the form
+		%
+		%	if (...)
+		%		if (...)
+		%			...
+		%	else
+		%		...
+		%
+		% we need braces around the inner `if', otherwise
+		% they wouldn't parse they way we want them to:
+		% C would match the `else' with the inner `if'
+		% rather than the outer `if'.
+		%
 		MaybeElse = yes(_),
-		Then0 = statement(if_then_else(_, _, no), Context)
+		Then0 = statement(if_then_else(_, _, no), ThenContext)
 	->
-		Then = statement(block([], [Then0]), Context)
+		Then = statement(block([], [Then0]), ThenContext)
+	;
+		%
+		% For examples of the form
+		%
+		%	if (...)
+		%		if (...)
+		%			...
+		%		else
+		%			...
+		%
+		% we don't _need_ braces around the inner `if',
+		% since C will match the else with the inner `if',
+		% but we add braces anyway, to avoid a warning from gcc.
+		%
+		MaybeElse = no,
+		Then0 = statement(if_then_else(_, _, yes(_)), ThenContext)
+	->
+		Then = statement(block([], [Then0]), ThenContext)
 	;
 		Then = Then0
 	},
+
 	mlds_indent(Indent),
 	io__write_string("if ("),
 	mlds_output_rval(Cond),
@@ -1225,8 +1290,7 @@
 		[]
 	;
 		mlds_indent(Context, Indent),
-		mlds_output_fully_qualified_name(qual(ModuleName, Name),
-			mlds_output_name),
+		mlds_output_fully_qualified_name(qual(ModuleName, Name)),
 		io__write_string(" = "),
 		mlds_output_rval(Arg),
 		io__write_string(";\n")
@@ -1420,7 +1484,7 @@
 		io__write_string(")"),
 		io__write_string("->")
 	),
-	mlds_output_fully_qualified_name(FieldId, io__write_string).
+	mlds_output_fully_qualified(FieldId, io__write_string).
 mlds_output_lval(mem_ref(Rval)) -->
 	io__write_string("*"),
 	mlds_output_bracketed_rval(Rval).
@@ -1431,7 +1495,7 @@
 :- mode mlds_output_var(in, di, uo) is det.
 
 mlds_output_var(VarName) -->
-	mlds_output_fully_qualified_name(VarName, io__write_string).
+	mlds_output_fully_qualified(VarName, io__write_string).
 
 :- pred mlds_output_bracketed_lval(mlds__lval, io__state, io__state).
 :- mode mlds_output_bracketed_lval(in, di, uo) is det.
@@ -1702,9 +1766,9 @@
 :- mode mlds_output_code_addr(in, di, uo) is det.
 
 mlds_output_code_addr(proc(Label)) -->
-	mlds_output_fully_qualified_name(Label, mlds_output_proc_label).
+	mlds_output_fully_qualified(Label, mlds_output_proc_label).
 mlds_output_code_addr(internal(Label, SeqNum)) -->
-	mlds_output_fully_qualified_name(Label, mlds_output_proc_label),
+	mlds_output_fully_qualified(Label, mlds_output_proc_label),
 	io__write_string("_"),
 	io__write_int(SeqNum).
 

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