[m-rev.] for review: multiple foreign language support

[Peter Ross]

On Wed, Jul 18, 2001 at 03:00:02AM +1000, Tyson Dowd wrote:
> Hi,
> 
> There is a small outstanding bug in this change that you can write
> multiple foreign_procs in a single language and the compiler won't
> complain.
> 
> Apart than that, it seems to work pretty well.
> 
> (there is no support for "il" as a foreign language because that change
> isn't commited yet).
> 
> ===================================================================
> 
> 
> Estimated hours taken: 8
> Branches: main
> 
> Support multiple language foreign_proc in the one file.
> 
> If there is more then one applicable foreign_proc for a
> given clause, select the most "preferred" programming
> language to use as the implementation.
> 
> Currently only the IL backend has multiple languages
> supported by the backend, and C# is preferred over MC++.
> 
> compiler/assertion.m:
> compiler/clause_to_proc.m:
> compiler/dead_proc_elim.m:
> compiler/goal_util.m:
> compiler/hlds_out.m:
> compiler/inlining.m:
> compiler/intermod.m:
> compiler/modes.m:
> compiler/polymorphism.m:
> compiler/purity.m:
> compiler/typecheck.m:
> compiler/unify_proc.m:
> 	Handle the extra field in clause.
> 
Place this comment after the comment to hlds_pred.

> compiler/hlds_pred.m:
> 	Add an extra field to clause which records which language this
> 	clause has been implemented in.
> 
> compiler/options.m:
> compiler/handle_options.m:
> 	Rename backend_foreign_language as backend_foreign_languages,
> 	and use it to record the list of foreign languages the selected
> 	backend can handle.
> 
> compiler/foreign.m:
> 	Update code to use the list of backend foreing languages.
> 	Add compare_Foreign_language function, to compute the preferred
> 	foreign language ordering for each backend.
> 	(much of the rest of the code in this module is intended to deal with
> 	the case where the backend *doesn't* handle the foreign
> 	language, but we don't have any working support for that at the
> 	moment).
> 
s/foreing/foreign/
s/_Foreign/_foreign/

> compiler/globals.m:
> 	Add globals__io_get_backend_foreign_languages.
> 
> compiler/make_hlds.m:
> 	Handle selection foreign_proc code depending upon the preferred
> 	language.
> 	Rename a few *_foreign_code predicates as *_foreign_proc
> 	predicates.
> 	Handle the extra field in clause.
> 
s/Handle selection/Handle selection of/

> 
> compiler/ml_code_gen.m:
> compiler/mlds.m:
> 	Generate different mlds__foreign_code for each language, put
> 	them in a map which is indexed on foreign language.
> 
I think you should make clear that only one foreign code version of a 
predicate is generated.  ie if you have a predicate implemented in two
languages only foreign code for the preferred one is generated.

> 
> compiler/mlds_to_c.m:
> compiler/mlds_to_csharp.m:
> compiler/mlds_to_gcc.m:
> compiler/mlds_to_mcpp.m:
> 	Select the appropriate mlds__foreign code from the map and
> 	generate code for it.
> 
> Index: compiler/foreign.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/foreign.m,v
> retrieving revision 1.4
> diff -u -r1.4 foreign.m
> --- compiler/foreign.m	2001/05/02 11:36:34	1.4
> +++ compiler/foreign.m	2001/07/17 16:51:25
> @@ -89,69 +141,86 @@
>  			WantedLang = Lang),
>  		Bodys0, LangBodys, NotLangBodys).
>  	
> -foreign__extrude_pragma_implementation(TargetLang, _PragmaVars,
> -		_PredName, _PredOrFunc, _Context,
> +foreign__extrude_pragma_implementation([], _PragmaVars,
> +	_PredName, _PredOrFunc, _Context, _ModuleInfo0, _Attributes, _Impl0, 
> +	_ModuleInfo, _NewAttributes, _Impl) :-
> +	error("foreign__extrude_pragma_implementation:"
> +		++ "no target languages available.").
> +
I would use unexpected here instead.

> Index: compiler/make_hlds.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
> retrieving revision 1.375
> diff -u -r1.375 make_hlds.m
> --- compiler/make_hlds.m	2001/07/07 09:05:19	1.375
> +++ compiler/make_hlds.m	2001/07/17 16:51:31
> @@ -694,7 +694,7 @@
>  		{ Pragma = foreign_proc(Attributes, Pred, PredOrFunc,
>  			Vars, VarSet, PragmaImpl) }
>  	->
> -		module_add_pragma_foreign_code(Attributes, 
> +		module_add_pragma_foreign_proc(Attributes, 
>  			Pred, PredOrFunc, Vars, VarSet, PragmaImpl,
>  			Status, Context, Module0, Module, Info0, Info)
>  	;
> @@ -981,7 +981,7 @@
>  		%
>  		do_construct_pred_or_func_call(PredId, PredOrFunc, SymName,
>  			Args, GoalInfo, Goal),
> -		Clause = clause(ProcIds, Goal, Context),
> +		Clause = clause(ProcIds, Goal, mercury, Context),
>  		map__init(TI_VarMap),
>  		map__init(TCI_VarMap),
>  		map__init(TVarNameMap),
> @@ -2938,7 +2938,7 @@
>  	set__list_to_set(HeadVars, NonLocals),
>  	goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo),
>  	Goal = Call - GoalInfo,
> -	Clause = clause([], Goal, Context),
> +	Clause = clause([], Goal, mercury, Context),
>  
>  		%
>  		% put the clause we just built into the pred_info,
> @@ -3863,7 +3863,7 @@
>  		InstancePredName, HeadVars, GoalInfo, IntroducedGoal,
>  		transform_info(ModuleInfo0, QualInfo0),
>  		transform_info(ModuleInfo, QualInfo)),
> -	IntroducedClause = clause([], IntroducedGoal, Context),
> +	IntroducedClause = clause([], IntroducedGoal, mercury, Context),
>  
>  	map__from_corresponding_lists(HeadVars, ArgTypes, VarTypes),
>  	map__init(TVarNameMap),
> @@ -4079,7 +4079,7 @@
>  	%
>  	% Add the code for this `pragma import' to the clauses_info
>  	%
> -	clauses_info_add_pragma_foreign_code(Clauses0, Purity, Attributes,
> +	clauses_info_add_pragma_foreign_proc(Clauses0, Purity, Attributes,
>  		PredId, ProcId, VarSet, PragmaVars, ArgTypes, PragmaImpl,
>  		Context, PredOrFunc, qualified(PredModule, PredName),
>  		Arity, Clauses, ModuleInfo0, ModuleInfo, Info0, Info),
> @@ -4091,15 +4091,15 @@
>  
>  %-----------------------------------------------------------------------------%
>  
> -:- pred module_add_pragma_foreign_code(pragma_foreign_proc_attributes,
> +:- pred module_add_pragma_foreign_proc(pragma_foreign_proc_attributes,
>  	sym_name, pred_or_func, list(pragma_var), prog_varset,
>  	pragma_foreign_code_impl, import_status, prog_context,
>  	module_info, module_info, qual_info, qual_info, io__state,
>  	io__state).
> -:- mode module_add_pragma_foreign_code(in, in, in, in, in, in, in, in,
> +:- mode module_add_pragma_foreign_proc(in, in, in, in, in, in, in, in,
>  	in, out, in, out, di, uo) is det.  
>  
> -module_add_pragma_foreign_code(Attributes, PredName, PredOrFunc,
> +module_add_pragma_foreign_proc(Attributes, PredName, PredOrFunc,
>  		PVars, VarSet, PragmaImpl, Status, Context,
>  		ModuleInfo0, ModuleInfo, Info0, Info) --> 
>  	{ module_info_name(ModuleInfo0, ModuleName) },
> @@ -4117,8 +4117,7 @@
>  		[]
>  	),
>  
> -	globals__io_lookup_foreign_language_option(use_foreign_language,
> -		UseForeignLang),
> +	globals__io_get_backend_foreign_languages(BackendForeignLangs),
>  
>  		% Lookup the pred declaration in the predicate table.
>  		% (If it's not there, print an error message and insert
> @@ -4175,9 +4174,10 @@
>  		io__write_string("  with preceding clauses.\n"),
>  		{ Info = Info0 }
>  	;
> +
>  			% Don't add clauses for foreign languages other
> -			% than the one we are using.
> -		{ UseForeignLang \= PragmaForeignLanguage }
> +			% than the ones we can generate code for.
> +		{ not list__member(PragmaForeignLanguage, BackendForeignLangs) }
>  	->
>  		{ ModuleInfo = ModuleInfo1 },
>  		{ Info = Info0 }
> @@ -4191,9 +4191,10 @@
>  						ModuleInfo1, ProcId) }
>  		->
>  			{ pred_info_clauses_info(PredInfo1, Clauses0) },
> +
>  			{ pred_info_arg_types(PredInfo1, ArgTypes) },
>  			{ pred_info_get_purity(PredInfo1, Purity) },
> -			clauses_info_add_pragma_foreign_code(
> +			clauses_info_add_pragma_foreign_proc(
>  				Clauses0, Purity, Attributes, PredId,
>  				ProcId, VarSet, PVars, ArgTypes,
>  				PragmaImpl, Context, PredOrFunc,
> @@ -4734,7 +4735,7 @@
>  		PragmaImpl), GoalInfo, _QuantVars, _VarSet, PredCallId, MI) --> 
>  	{ goal_info_get_context(GoalInfo, Context) },
>  	{ foreign_language(Attrs, Lang) },
> -	warn_singletons_in_pragma_foreign_code(PragmaImpl, Lang,
> +	warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang,
>  		ArgInfo, Context, PredCallId, MI).
>  
>  warn_singletons_in_goal_2(shorthand(ShorthandGoal), GoalInfo, QuantVars,
> @@ -4829,13 +4830,13 @@
>  maybe_warn_pragma_singletons(PragmaImpl, Lang, ArgInfo, Context, CallId, MI) -->
>  	globals__io_lookup_bool_option(warn_singleton_vars, WarnSingletonVars),
>  	( { WarnSingletonVars = yes } ->
> -		warn_singletons_in_pragma_foreign_code(PragmaImpl, Lang,
> +		warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang,
>  			ArgInfo, Context, CallId, MI)
>  	;	
>  		[]
>  	).
>  
> -	% warn_singletons_in_pragma_foreign_code checks to see if each
> +	% warn_singletons_in_pragma_foreign_proc checks to see if each
>  	% variable is mentioned at least once in the foreign code
>  	% fragments that ought to mention it. If not, it gives a
>  	% warning.
> @@ -4843,13 +4844,13 @@
>  	% appropriate to do this check, or you may need to add a
>  	% transformation to map Mercury variable names into identifiers
>  	% for that foreign language).
> -:- pred warn_singletons_in_pragma_foreign_code(pragma_foreign_code_impl,
> +:- pred warn_singletons_in_pragma_foreign_proc(pragma_foreign_code_impl,
>  	foreign_language, list(maybe(pair(string, mode))), prog_context,
>  	simple_call_id, module_info, io__state, io__state).
> -:- mode warn_singletons_in_pragma_foreign_code(in, in, in, in, in, in,
> +:- mode warn_singletons_in_pragma_foreign_proc(in, in, in, in, in, in,
>  	di, uo) is det.
>  
> -warn_singletons_in_pragma_foreign_code(PragmaImpl, Lang, ArgInfo, 
> +warn_singletons_in_pragma_foreign_proc(PragmaImpl, Lang, ArgInfo, 
>  		Context, PredOrFuncCallId, ModuleInfo) -->
>  	{ LangStr = foreign_language_string(Lang) },
>  	(
> @@ -5209,8 +5210,8 @@
>  		{ Goal = Goal0 },
>  
>  			% XXX we should avoid append - this gives O(N*N)
> -		{ list__append(ClauseList0, [clause(ModeIds, Goal, Context)],
> -								ClauseList) },
> +		{ list__append(ClauseList0, [clause(ModeIds, Goal, mercury,
> +			Context)], ClauseList) },
>  		{ qual_info_get_var_types(Info, ExplicitVarTypes) },
>  		{ ClausesInfo = clauses_info(VarSet, ExplicitVarTypes,
>  				TVarNameMap, InferredVarTypes, HeadVars,
> @@ -5219,12 +5220,12 @@
>  
>  %-----------------------------------------------------------------------------
>  
> -% Add the pragma_foreign_code goal to the clauses_info for this procedure.
> +% Add the pragma_foreign_proc goal to the clauses_info for this procedure.
>  % To do so, we must also insert unifications between the variables in the
> -% pragma foreign_code declaration and the head vars of the pred. Also
> +% pragma foreign_proc declaration and the head vars of the pred. Also
>  % return the hlds_goal.
>  
> -:- pred clauses_info_add_pragma_foreign_code(
> +:- pred clauses_info_add_pragma_foreign_proc(
>  	clauses_info::in, purity::in, pragma_foreign_proc_attributes::in,
>  	pred_id::in, proc_id::in, prog_varset::in, list(pragma_var)::in,
>  	list(type)::in, pragma_foreign_code_impl::in, prog_context::in,
> @@ -5232,24 +5233,102 @@
>  	module_info::in, module_info::out, qual_info::in,
>  	qual_info::out, io__state::di, io__state::uo) is det.
>  
> -clauses_info_add_pragma_foreign_code(ClausesInfo0, Purity, Attributes0, PredId,
> -		ModeId, PVarSet, PVars, OrigArgTypes, PragmaImpl0, Context,
> +clauses_info_add_pragma_foreign_proc(ClausesInfo0, Purity, Attributes0, PredId,
> +		ProcId, PVarSet, PVars, OrigArgTypes, PragmaImpl0, Context,
>  		PredOrFunc, PredName, Arity, ClausesInfo, ModuleInfo0,
>  		ModuleInfo, Info0, Info) -->
> -	globals__io_lookup_foreign_language_option(backend_foreign_language,
> -		BackendForeignLanguage),
> -	{
> -	ClausesInfo0 = clauses_info(VarSet0, VarTypes, TVarNameMap, VarTypes1,
> -				 HeadVars, ClauseList, TI_VarMap, TCI_VarMap),
> +
> +	{ ClausesInfo0 = clauses_info(VarSet0, VarTypes, TVarNameMap,
> +		VarTypes1, HeadVars, ClauseList, TI_VarMap, TCI_VarMap) },
> +
> +
> +		% Find all the exising clauses for this mode, and
> +		% extract their implementation language and clause number
> +		% (that is, their index in the list).
> +	{ foreign_language(Attributes0, NewLang) },
> +	{ list__foldl2(
> +		(pred(C::in, Res0::in, Res::out, N0::in, N::out) is det :-
> +			( 
> +				C = clause(ProcIds, _, ClauseLang, _),
> +				list__member(ProcId, ProcIds)
> +			->
> +				Res = [ClauseLang - N0 | Res0],
> +				N = N0 + 1
> +			;
> +				Res = Res0,
> +				N = N0 + 1
> +			)
> +		), ClauseList, [], LangClauses, 0, _) },
> +
> +	globals__io_get_globals(Globals),
> +	globals__io_get_target(Target),
> +
> +		% Figure out what to do with this new clause.
> +		% We can either add it to the list of clauses, ignore it,
> +		% or replace the existing clause with it.
> +		%
> +		% We create a closure called UpdateClauses which does the
> +		% appropriate action at the end of this predicate.
> +		%
> +		% In the rare case of multiple foreign language
> +		% implementations we might do some unnecessary work only
> +		% to ignore the new clause.
> +	{ 
> +		% no clauses -- add it
> +		LangClauses = [],
> +		UpdateClauses = (pred(NewCl::in, Cs::out) is det :- 
> +			Cs = [NewCl|ClauseList])
> +	;
> +		% was implemented in Mercury, do nothing
> +		% XXX if we want to make Mercury implementations a fallback
> +		% we should consider making this a replace instead of an
> +		% ignore.

I don't think this XXX is correct.  You already have a suitable
foreign_proc to use, so you would never want to use the mercury code.
What you want to do is ignore attempts to add mercury clauses when you
already have a foreign_code implementation.

> +		LangClauses = [mercury - _ | Rest],
> +		( Rest = [] ->
> +			UpdateClauses = (pred(_NewCl::in, Cs::out) is det :- 
> +				Cs = ClauseList)
> +		;
> +			error("unexpected: multiple matches for foreign " ++
> +				"language clauses")
> +		)
> +
> +	; 
> +		LangClauses = [ForeignLang - ClauseNumber | Rest], 
> +		ForeignLang = foreign_language(OldLang),
> +		( Rest = [] ->
> +			Compare = foreign__compare_foreign_language(Globals,
> +				Target, OldLang, NewLang),
> +			( 
> +				% This language is preferred to the old
> +				% language, so we should replace it
> +				Compare = (<) ->
> +				UpdateClauses = 
> +					(pred(NewCl::in, Cs::out) is det :-
> +					list__replace_nth_det(ClauseList,
> +						ClauseNumber, NewCl, Cs))
> +			;
> +				% Just ignore it.
> +				UpdateClauses = 
> +					(pred(_NewCl::in, Cs::out) is det :- 
> +						Cs = ClauseList)
> +			)
> +		;
> +			error("unexpected: multiple matches for foreign " ++
> +				"language clauses")
> +		)
> +	},
> +	
> +	globals__io_get_backend_foreign_languages(BackendForeignLanguages),
> +	{ 
>  	pragma_get_vars(PVars, Args0),
>  	pragma_get_var_infos(PVars, ArgInfo),
>  
>  	%
> -	% If the foreign language is different to the backend 
> -	% language, we will have to generate an interface to it in the
> +	% If the foreign language not one of the backend 
> +	% languages, we will have to generate an interface to it in a
>  	% backend language.
>  	%
> -	foreign__extrude_pragma_implementation(BackendForeignLanguage,
> +	foreign__extrude_pragma_implementation(BackendForeignLanguages,
>  		PVars, PredName, PredOrFunc, Context,
>  		ModuleInfo0, Attributes0, PragmaImpl0,
>  		ModuleInfo1, Attributes, PragmaImpl),
> @@ -5274,7 +5353,7 @@
>  		{ Info = Info0 },
>  		prog_out__write_context(Context),
>  		io__write_string(
> -			"In `:- pragma foreign_code' declaration for "),
> +			"In `:- pragma foreign_proc' declaration for "),
>  		{ adjust_func_arity(PredOrFunc, OrigArity, Arity) },
>  		hlds_out__write_simple_call_id(
>  			PredOrFunc - PredName/OrigArity),
> @@ -5310,7 +5389,7 @@
>  		% this foreign code is inlined
>  		add_goal_info_purity_feature(GoalInfo1, Purity, GoalInfo),
>  		HldsGoal0 = foreign_proc(Attributes, PredId, 
> -			ModeId, Args, ArgInfo, OrigArgTypes, PragmaImpl)
> +			ProcId, Args, ArgInfo, OrigArgTypes, PragmaImpl)
>  			- GoalInfo
>  		}, 
>  			% Apply unifications with the head args.
> @@ -5327,9 +5406,11 @@
>  		implicitly_quantify_clause_body(HeadVars,
>  			HldsGoal1, VarSet2, EmptyVarTypes,
>  			HldsGoal, VarSet, _, _Warnings),
> -		NewClause = clause([ModeId], HldsGoal, Context),
> +		NewClause = clause([ProcId], HldsGoal,
> +			foreign_language(NewLang), Context),
> +		UpdateClauses(NewClause, NewClauseList),
>  		ClausesInfo =  clauses_info(VarSet, VarTypes, TVarNameMap,
> -			VarTypes1, HeadVars, [NewClause|ClauseList],
> +			VarTypes1, HeadVars, NewClauseList,
>  			TI_VarMap, TCI_VarMap)
>  		}
>  	).
> @@ -8118,7 +8199,7 @@
>  	{ default_attributes(c, Attrs0) },
>  	{ set_may_call_mercury(Attrs0, will_not_call_mercury, Attrs1) },
>  	{ set_thread_safe(Attrs1, thread_safe, Attrs) },
> -	module_add_pragma_foreign_code(Attrs, SymName, PredOrFunc, 
> +	module_add_pragma_foreign_proc(Attrs, SymName, PredOrFunc, 
>  		PragmaVars, VarSet, ordinary(C_ProcCode, no),
>  		Status, Context, Module0, Module1, Info0, Info),
>  	{
> Index: compiler/mlds_to_csharp.m
> ===================================================================
> RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_csharp.m,v
> retrieving revision 1.10
> diff -u -r1.10 mlds_to_csharp.m
> --- compiler/mlds_to_csharp.m	2001/07/12 15:44:55	1.10
> +++ compiler/mlds_to_csharp.m	2001/07/17 16:51:35
> @@ -473,8 +475,14 @@
>  	{ sorry(this_file, "value classes") }.
>  write_il_simple_type_as_csharp_type(interface(_ClassName)) --> 
>  	{ sorry(this_file, "interfaces") }.
> -write_il_simple_type_as_csharp_type('[]'(_Type, _Bounds)) --> 
> -	{ sorry(this_file, "arrays") }.
> +write_il_simple_type_as_csharp_type('[]'(Type, Bounds)) --> 
> +	write_il_type_as_csharp_type(Type),
> +	io__write_string("[]"),
> +	( { Bounds = [] } ->
> +		[]
> +	;
> +		{ sorry(this_file, "arrays with bounds") }
> +	).
>  write_il_simple_type_as_csharp_type('&'(Type)) --> 
>  		% XXX is this always right?
>  	io__write_string("ref "),

This change is not mentioned in the log file.

Otherwise this diff looks fine.
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------