[m-dev.] for review: handle `:- external' in MLDS back-end

[Fergus Henderson]

----------

Estimated hours taken: 3

Fix the handling of procedures declared `:- external' for the MLDS back-end.
This change fixes some problems that broke many of the test cases in
tests/valid in the hl*prof* grades.

compiler/hlds_pred.m:
	Add `external' as a new import_status, rather than using
	`imported'.

compiler/assertion.m:
compiler/higher_order.m:
compiler/hlds_out.m:
compiler/hlds_pred.m:
compiler/intermod.m:
compiler/make_hlds.m:
	Minor changes to handle the new import_status.

compiler/mlds.m:
	Add a comment about the handling of procedures declared
	`:- external'.

compiler/ml_code_gen.m:
	Generate MLDS function definitions, with no function body,
	for procedures declared `external'.

compiler/mlds_to_c.m:
	Declare private functions with no function body as `extern'
	rather than `static'.

Workspace: /home/pgrad/fjh/ws/hg
Index: compiler/assertion.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.9
diff -u -d -r1.9 assertion.m
--- compiler/assertion.m	2000/11/17 17:46:53	1.9
+++ compiler/assertion.m	2000/12/09 10:44:56
@@ -830,8 +830,10 @@
 is_defined_in_implementation_section(exported_to_submodules, yes).
 is_defined_in_implementation_section(local, yes).
 is_defined_in_implementation_section(imported(implementation), yes).
+is_defined_in_implementation_section(external(implementation), yes).
 
 is_defined_in_implementation_section(imported(interface), no).
+is_defined_in_implementation_section(external(interface), no).
 is_defined_in_implementation_section(opt_imported, no).
 is_defined_in_implementation_section(abstract_imported, no).
 is_defined_in_implementation_section(pseudo_imported, no).
Index: compiler/higher_order.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/higher_order.m,v
retrieving revision 1.82
diff -u -d -r1.82 higher_order.m
--- compiler/higher_order.m	2000/11/17 17:47:15	1.82
+++ compiler/higher_order.m	2000/12/09 10:48:18
@@ -1202,6 +1202,7 @@
 			% specialize any higher-order arguments. We may be
 			% able to do user guided type specialization.
 			CalleeStatus \= imported(_),
+			CalleeStatus \= external(_),
 			type_is_higher_order(CalleeArgType, _, _, _)
 		;
 			true
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.252
diff -u -d -r1.252 hlds_out.m
--- compiler/hlds_out.m	2000/12/06 06:05:01	1.252
+++ compiler/hlds_out.m	2000/12/09 10:49:41
@@ -2282,6 +2282,10 @@
 	io__write_string("imported in the interface").
 hlds_out__write_import_status(imported(implementation)) -->
 	io__write_string("imported in the implementation").
+hlds_out__write_import_status(external(interface)) -->
+	io__write_string("external (and exported)").
+hlds_out__write_import_status(external(implementation)) -->
+	io__write_string("external (and local)").
 hlds_out__write_import_status(abstract_imported) -->
 	io__write_string("abstract_imported").
 hlds_out__write_import_status(opt_imported) -->
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.88
diff -u -d -r1.88 hlds_pred.m
--- compiler/hlds_pred.m	2000/12/06 06:05:04	1.88
+++ compiler/hlds_pred.m	2000/12/09 10:41:16
@@ -258,9 +258,11 @@
 	% Only types can have status abstract_exported or abstract_imported.
 
 :- type import_status
-	--->	imported(section)
+	--->	external(section)
+				% declared `external',
+				% i.e. defined in some other language
+	;	imported(section)
 				% defined in the interface of some other module
-				% or `external' (in some other language)
 	;	opt_imported	% defined in the optimization
 				% interface of another module
 	;	abstract_imported % describes a type with only an abstract
@@ -747,6 +749,7 @@
 invalid_proc_id(-1).
 
 status_is_exported(imported(_),			no).
+status_is_exported(external(_),			no).
 status_is_exported(abstract_imported,		no).
 status_is_exported(pseudo_imported,		no).
 status_is_exported(opt_imported,		no).
@@ -761,6 +764,7 @@
 	bool__not(InThisModule, Imported).
 
 status_defined_in_this_module(imported(_),		no).
+status_defined_in_this_module(external(_),		no).
 status_defined_in_this_module(abstract_imported,	no).
 status_defined_in_this_module(pseudo_imported,		no).
 status_defined_in_this_module(opt_imported,		no).
@@ -916,6 +920,8 @@
 	pred_info_import_status(PredInfo, ImportStatus),
 	( ImportStatus = imported(_) ->
 		ProcIds = []
+	; ImportStatus = external(_) ->
+		ProcIds = []
 	; ImportStatus = pseudo_imported ->
 		pred_info_procids(PredInfo, ProcIds0),
 		% for pseduo_imported preds, procid 0 is imported
@@ -972,7 +978,10 @@
 pred_info_import_status(PredInfo, PredInfo^import_status).
 
 pred_info_is_imported(PredInfo) :-
-	pred_info_import_status(PredInfo, imported(_)).
+	pred_info_import_status(PredInfo, Status),
+	( Status = imported(_)
+	; Status = external(_)
+	).
 
 pred_info_is_pseudo_imported(PredInfo) :-
 	pred_info_import_status(PredInfo, ImportStatus),
@@ -1004,10 +1013,10 @@
 	status_is_exported(PredInfo0^import_status, Exported),
 	(
 		Exported = yes,
-		PredInfo = PredInfo0^import_status := imported(interface)
+		PredInfo = PredInfo0^import_status := external(interface)
 	;
 		Exported = no,
-		PredInfo = PredInfo0^import_status := imported(implementation)
+		PredInfo = PredInfo0^import_status := external(implementation)
 	).
 
 pred_info_set_import_status(PredInfo, X, PredInfo^import_status := X).
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.89
diff -u -d -r1.89 intermod.m
--- compiler/intermod.m	2000/11/17 17:47:28	1.89
+++ compiler/intermod.m	2000/12/09 10:54:34
@@ -651,7 +651,7 @@
 		% calls a predicate which is exported, then we don't
 		% need to do anything special.
 		%
-		{ Status = exported }
+		{ Status = exported ; Status = external(interface) }
 	->
 		{ DoWrite = yes }
 	;
@@ -672,7 +672,7 @@
 		% we need to put the declaration for the called predicate
 		% in the `.opt' file.
 		%
-		{ Status = local }
+		{ Status = local ; Status = external(implementation) }
 	->
 		{ DoWrite = yes },
 		intermod_info_get_pred_decls(PredDecls0),
@@ -683,31 +683,14 @@
 		; Status = opt_imported
 		}
 	->
+		%
+		% imported pred - add import for module
+		%
 		{ DoWrite = yes },
-		{ module_info_name(ModuleInfo, ThisModule) },
 		{ pred_info_module(PredInfo, PredModule) },
-		(
-			{ PredModule = ThisModule }
-		->
-			%
-			% This can happen in the case of a local predicate
-			% which has been declared as external using a
-			% `:- external(Name/Arity)' declaration, e.g.
-			% because it is implemented as low-level C code.
-			%
-			% We treat these the same as local predicates.
-			%
-			intermod_info_get_pred_decls(PredDecls0),
-			{ set__insert(PredDecls0, PredId, PredDecls) },
-			intermod_info_set_pred_decls(PredDecls)
-		;	
-			%
-			% imported pred - add import for module
-			%
-			intermod_info_get_modules(Modules0),
-			{ set__insert(Modules0, PredModule, Modules) },
-			intermod_info_set_modules(Modules)
-		)
+		intermod_info_get_modules(Modules0),
+		{ set__insert(Modules0, PredModule, Modules) },
+		intermod_info_set_modules(Modules)
 	;
 		{ error("intermod__add_proc: unexpected status") }
 	).
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.359
diff -u -d -r1.359 make_hlds.m
--- compiler/make_hlds.m	2000/11/17 17:47:42	1.359
+++ compiler/make_hlds.m	2000/12/09 10:59:30
@@ -1911,7 +1911,7 @@
 	( combine_status_2(StatusA, StatusB, CombinedStatus) ->
 		Status = CombinedStatus
 	;
-		error("pseudo_imported or pseudo_exported type definition")
+		error("unexpected status for type definition")
 	).
 
 :- pred combine_status_2(import_status, import_status, import_status).
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.68
diff -u -d -r1.68 ml_code_gen.m
--- compiler/ml_code_gen.m	2000/11/23 04:32:43	1.68
+++ compiler/ml_code_gen.m	2000/12/09 14:09:03
@@ -876,10 +876,11 @@
 		{ PredIds0 = [PredId|PredIds] }
 	->
 		{ map__lookup(PredTable, PredId, PredInfo) },
-		( { pred_info_is_imported(PredInfo) } ->
+		{ pred_info_import_status(PredInfo, ImportStatus) },
+		( { ImportStatus = imported(_) } ->
 			{ MLDS_Defns1 = MLDS_Defns0 }
 		;
-			ml_gen_pred(ModuleInfo, PredId, PredInfo,
+			ml_gen_pred(ModuleInfo, PredId, PredInfo, ImportStatus,
 				MLDS_Defns0, MLDS_Defns1)
 		),
 		ml_gen_preds_2(ModuleInfo, PredIds, PredTable,
@@ -891,12 +892,17 @@
 	% Generate MLDS definitions for all the non-imported
 	% procedures of a given predicate (or function).
 	%
-:- pred ml_gen_pred(module_info, pred_id, pred_info,
-				mlds__defns, mlds__defns, io__state, io__state).
-:- mode ml_gen_pred(in, in, in, in, out, di, uo) is det.
+:- pred ml_gen_pred(module_info, pred_id, pred_info, import_status,
+			mlds__defns, mlds__defns, io__state, io__state).
+:- mode ml_gen_pred(in, in, in, in, in, out, di, uo) is det.
 
-ml_gen_pred(ModuleInfo, PredId, PredInfo, MLDS_Defns0, MLDS_Defns) -->
-	{ pred_info_non_imported_procids(PredInfo, ProcIds) },
+ml_gen_pred(ModuleInfo, PredId, PredInfo, ImportStatus,
+		MLDS_Defns0, MLDS_Defns) -->
+	( { ImportStatus = external(_) } ->
+		{ pred_info_procids(PredInfo, ProcIds) }
+	;
+		{ pred_info_non_imported_procids(PredInfo, ProcIds) }
+	),
 	( { ProcIds = [] } ->
 		{ MLDS_Defns = MLDS_Defns0 }
 	;
@@ -993,6 +999,7 @@
 ml_gen_proc_defn(ModuleInfo, PredId, ProcId, MLDS_ProcDefnBody, ExtraDefns) :-
 	module_info_pred_proc_info(ModuleInfo, PredId, ProcId,
 			PredInfo, ProcInfo),
+	pred_info_import_status(PredInfo, ImportStatus),
 	pred_info_arg_types(PredInfo, ArgTypes),
 	proc_info_interface_code_model(ProcInfo, CodeModel),
 	proc_info_headvars(ProcInfo, HeadVars),
@@ -1018,65 +1025,83 @@
 	MLDSGenInfo0 = ml_gen_info_init(ModuleInfo, PredId, ProcId),
 	MLDS_Params = ml_gen_proc_params(ModuleInfo, PredId, ProcId),
 
-	% Set up the initial success continuation, if any.
-	% Also figure out which output variables are returned by
-	% value (rather than being passed by reference) and remove
-	% them from the byref_output_vars field in the ml_gen_info.
-	( CodeModel = model_non ->
-		ml_set_up_initial_succ_cont(ModuleInfo, CopiedOutputVars,
-			MLDSGenInfo0, MLDSGenInfo1)
+	( ImportStatus = external(_) ->
+		%
+		% For Mercury procedures declared `:- external', we generate 
+		% an MLDS definition for them with no function body.
+		% The MLDS -> target code pass can treat this accordingly,
+		% e.g. for C it outputs a function declaration with no
+		% corresponding definition, making sure that the function
+		% is declared as `extern' rather than `static'.
+		%
+		MaybeStatement = no,
+		ExtraDefns = []
 	;
-		(
-			is_output_det_function(ModuleInfo, PredId, ProcId,
-				ResultVar)
-		->
-			CopiedOutputVars = [ResultVar],
-			ml_gen_info_get_byref_output_vars(MLDSGenInfo0,
-				ByRefOutputVars0),
-			list__delete_all(ByRefOutputVars0,
-				ResultVar, ByRefOutputVars),
-			ml_gen_info_set_byref_output_vars(ByRefOutputVars,	
-				MLDSGenInfo0, MLDSGenInfo1)
+		% XXX FIXME wrap long lines
+		% Set up the initial success continuation, if any.
+		% Also figure out which output variables are returned by
+		% value (rather than being passed by reference) and remove
+		% them from the byref_output_vars field in the ml_gen_info.
+		( CodeModel = model_non ->
+			ml_set_up_initial_succ_cont(ModuleInfo,
+				CopiedOutputVars, MLDSGenInfo0, MLDSGenInfo1)
 		;
-			CopiedOutputVars = [],
-			MLDSGenInfo1 = MLDSGenInfo0
-		)
-	),
+			(
+				is_output_det_function(ModuleInfo, PredId,
+					ProcId, ResultVar)
+			->
+				CopiedOutputVars = [ResultVar],
+				ml_gen_info_get_byref_output_vars(MLDSGenInfo0,
+					ByRefOutputVars0),
+				list__delete_all(ByRefOutputVars0,
+					ResultVar, ByRefOutputVars),
+				ml_gen_info_set_byref_output_vars(
+					ByRefOutputVars,
+					MLDSGenInfo0, MLDSGenInfo1)
+			;
+				CopiedOutputVars = [],
+				MLDSGenInfo1 = MLDSGenInfo0
+			)
+		),
 
-	% This would generate all the local variables at the top of the
-	% function:
-	%	MLDS_LocalVars = ml_gen_all_local_var_decls(Goal, VarSet,
-	% 		VarTypes, HeadVars, ModuleInfo),
-	% But instead we now generate them locally for each goal.
-	% We just declare the `succeeded' var here,
-	% plus locals for any output arguments that are returned by value
-	% (e.g. if --nondet-copy-out is enabled, or for det function return
-	% values).
-	MLDS_Context = mlds__make_context(Context),
-	( CopiedOutputVars = [] ->
-		% optimize common case
-		OutputVarLocals = []
-	;
-		proc_info_varset(ProcInfo, VarSet),
-		proc_info_vartypes(ProcInfo, VarTypes),
-		% note that for headvars we must use the types from
-		% the procedure interface, not from the procedure body
-		HeadVarTypes = map__from_corresponding_lists(HeadVars,
-			ArgTypes),
-		OutputVarLocals = ml_gen_local_var_decls(VarSet,
-			map__overlay(VarTypes, HeadVarTypes),
-			MLDS_Context, ModuleInfo, CopiedOutputVars)
+		% This would generate all the local variables at the top of
+		% the function:
+		%	MLDS_LocalVars = ml_gen_all_local_var_decls(Goal,
+		% 		VarSet, VarTypes, HeadVars, ModuleInfo),
+		% But instead we now generate them locally for each goal.
+		% We just declare the `succeeded' var here, plus locals
+		% for any output arguments that are returned by value
+		% (e.g. if --nondet-copy-out is enabled, or for det function
+		% return values).
+		MLDS_Context = mlds__make_context(Context),
+		( CopiedOutputVars = [] ->
+			% optimize common case
+			OutputVarLocals = []
+		;
+			proc_info_varset(ProcInfo, VarSet),
+			proc_info_vartypes(ProcInfo, VarTypes),
+			% note that for headvars we must use the types from
+			% the procedure interface, not from the procedure body
+			HeadVarTypes = map__from_corresponding_lists(HeadVars,
+				ArgTypes),
+			OutputVarLocals = ml_gen_local_var_decls(VarSet,
+				map__overlay(VarTypes, HeadVarTypes),
+				MLDS_Context, ModuleInfo, CopiedOutputVars)
+		),
+		MLDS_LocalVars = [ml_gen_succeeded_var_decl(MLDS_Context) |
+				OutputVarLocals],
+		ml_gen_proc_body(CodeModel, HeadVars, ArgTypes,
+				CopiedOutputVars, Goal,
+				MLDS_Decls0, MLDS_Statements,
+				MLDSGenInfo1, MLDSGenInfo),
+		ml_gen_info_get_extra_defns(MLDSGenInfo, ExtraDefns),
+		MLDS_Decls = list__append(MLDS_LocalVars, MLDS_Decls0),
+		MLDS_Statement = ml_gen_block(MLDS_Decls, MLDS_Statements,
+			Context),
+		MaybeStatement = yes(MLDS_Statement)
 	),
-	MLDS_LocalVars = [ml_gen_succeeded_var_decl(MLDS_Context) |
-			OutputVarLocals],
-	ml_gen_proc_body(CodeModel, HeadVars, ArgTypes, CopiedOutputVars, Goal,
-			MLDS_Decls0, MLDS_Statements,
-			MLDSGenInfo1, MLDSGenInfo),
-	ml_gen_info_get_extra_defns(MLDSGenInfo, ExtraDefns),
-	MLDS_Decls = list__append(MLDS_LocalVars, MLDS_Decls0),
-	MLDS_Statement = ml_gen_block(MLDS_Decls, MLDS_Statements, Context),
 	MLDS_ProcDefnBody = mlds__function(yes(proc(PredId, ProcId)),
-			MLDS_Params, yes(MLDS_Statement)).
+			MLDS_Params, MaybeStatement).
 
 :- pred ml_set_up_initial_succ_cont(module_info, list(prog_var),
 		ml_gen_info, ml_gen_info).
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.43
diff -u -d -r1.43 mlds.m
--- compiler/mlds.m	2000/11/21 13:37:41	1.43
+++ compiler/mlds.m	2000/12/09 11:29:47
@@ -404,6 +404,10 @@
 			mlds__func_params,	% the arguments & return types
 			maybe(mlds__statement)	% the function body, or `no'
 						% if the function is abstract
+						% or if the function is defined
+						% externally (i.e. the original
+						% Mercury procedure was declared
+						% `:- external').
 		)
 		% packages, classes, interfaces, structs, enums
 	;	mlds__class(
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.72
diff -u -d -r1.72 mlds_to_c.m
--- compiler/mlds_to_c.m	2000/12/03 02:22:38	1.72
+++ compiler/mlds_to_c.m	2000/12/09 13:55:41
@@ -827,7 +827,7 @@
 		% Now output the declaration for this mlds__defn.
 		%
 		mlds_indent(Context, Indent),
-		mlds_output_decl_flags(Flags, forward_decl, Name),
+		mlds_output_decl_flags(Flags, forward_decl, Name, DefnBody),
 		mlds_output_decl_body(Indent, qual(ModuleName, Name), Context,
 			DefnBody)
 	).
@@ -907,7 +907,7 @@
 		[]
 	),
 	mlds_indent(Context, Indent),
-	mlds_output_decl_flags(Flags, definition, Name),
+	mlds_output_decl_flags(Flags, definition, Name, DefnBody),
 	mlds_output_defn_body(Indent, qual(ModuleName, Name), Context,
 			DefnBody).
 
@@ -1753,10 +1753,10 @@
 	;	definition.
 
 :- pred mlds_output_decl_flags(mlds__decl_flags, decl_or_defn,
-		mlds__entity_name, io__state, io__state).
-:- mode mlds_output_decl_flags(in, in, in, di, uo) is det.
+		mlds__entity_name, mlds__entity_defn, io__state, io__state).
+:- mode mlds_output_decl_flags(in, in, in, in, di, uo) is det.
 
-mlds_output_decl_flags(Flags, DeclOrDefn, Name) -->
+mlds_output_decl_flags(Flags, DeclOrDefn, Name, DefnBody) -->
 	%
 	% mlds_output_extern_or_static handles both the
 	% `access' and the `per_instance' fields of the mlds__decl_flags.
@@ -1770,7 +1770,7 @@
 	mlds_output_access_comment(access(Flags)),
 	mlds_output_per_instance_comment(per_instance(Flags)),
 	mlds_output_extern_or_static(access(Flags), per_instance(Flags),
-		DeclOrDefn, Name),
+		DeclOrDefn, Name, DefnBody),
 	mlds_output_virtuality(virtuality(Flags)),
 	mlds_output_finality(finality(Flags)),
 	mlds_output_constness(constness(Flags)),
@@ -1813,13 +1813,17 @@
 mlds_output_per_instance_comment_2(one_copy)     --> io__write_string("/* one_copy */ ").
 
 :- pred mlds_output_extern_or_static(access, per_instance, decl_or_defn,
-		mlds__entity_name, io__state, io__state).
-:- mode mlds_output_extern_or_static(in, in, in, in, di, uo) is det.
+		mlds__entity_name, mlds__entity_defn, io__state, io__state).
+:- mode mlds_output_extern_or_static(in, in, in, in, in, di, uo) is det.
 
-mlds_output_extern_or_static(Access, PerInstance, DeclOrDefn, Name) -->
-	(
+mlds_output_extern_or_static(Access, PerInstance, DeclOrDefn, Name, DefnBody)
+		-->
+	( 
 		{ Access = private ; PerInstance = one_copy },
-		{ Name \= type(_, _) }
+		{ Name \= type(_, _) },
+		% Don't output "static" for functions that don't have a body.
+		% This can happen for Mercury procedures declared `:- external'
+		{ DefnBody \= mlds__function(_, _, no) }
 	->
 		io__write_string("static ")
 	;

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