[m-rev.] for review: multiple foreign language support
Tyson Dowd
trd at cs.mu.OZ.AU
Wed Jul 18 03:00:02 AEST 2001
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.
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).
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.
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.
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/assertion.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/assertion.m,v
retrieving revision 1.13
diff -u -r1.13 assertion.m
--- compiler/assertion.m 2001/04/07 14:04:31 1.13
+++ compiler/assertion.m 2001/07/17 16:51:24
@@ -469,7 +469,7 @@
pred_info_clauses_info(PredInfo, ClausesInfo),
clauses_info_clauses(ClausesInfo, Clauses),
(
- Clauses = [clause(_ProcIds, Goal0, _Context)]
+ Clauses = [clause(_ProcIds, Goal0, _Lang, _Context)]
->
assertion__normalise_goal(Goal0, Goal)
;
Index: compiler/clause_to_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/clause_to_proc.m,v
retrieving revision 1.29
diff -u -r1.29 clause_to_proc.m
--- compiler/clause_to_proc.m 2001/01/17 01:41:50 1.29
+++ compiler/clause_to_proc.m 2001/07/17 16:51:24
@@ -207,7 +207,7 @@
select_matching_clauses([], _, []).
select_matching_clauses([Clause | Clauses], ProcId, MatchingClauses) :-
- Clause = clause(ProcIds, _, _),
+ Clause = clause(ProcIds, _, _, _),
% an empty list here means that the clause applies to all procs
( ProcIds = [] ->
MatchingClauses = [Clause | MatchingClauses1]
@@ -222,7 +222,7 @@
get_clause_goals([], []).
get_clause_goals([Clause | Clauses], Goals) :-
- Clause = clause(_, Goal, _),
+ Clause = clause(_, Goal, _, _),
goal_to_disj_list(Goal, GoalList),
list__append(GoalList, Goals1, Goals),
get_clause_goals(Clauses, Goals1).
Index: compiler/dead_proc_elim.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/dead_proc_elim.m,v
retrieving revision 1.65
diff -u -r1.65 dead_proc_elim.m
--- compiler/dead_proc_elim.m 2001/04/07 14:04:33 1.65
+++ compiler/dead_proc_elim.m 2001/07/17 16:51:24
@@ -854,7 +854,7 @@
:- pred dead_pred_elim_process_clause(clause::in, dead_pred_info::in,
dead_pred_info::out) is det.
-dead_pred_elim_process_clause(clause(_, Goal, _)) -->
+dead_pred_elim_process_clause(clause(_, Goal, _, _)) -->
pre_modecheck_examine_goal(Goal).
:- pred pre_modecheck_examine_goal(hlds_goal::in,
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
@@ -18,7 +18,7 @@
:- interface.
-:- import_module prog_data.
+:- import_module prog_data, globals.
:- import_module hlds_module, hlds_pred.
:- import_module llds.
@@ -39,7 +39,7 @@
:- mode foreign__filter_bodys(in, in, out, out) is det.
% Given some foreign code, generate some suitable proxy code for
- % calling the code via the given language.
+ % calling the code via one of the given languages.
% This might mean, for example, generating a call to a
% forwarding function in C.
% The foreign language argument specifies which language is the
@@ -49,7 +49,7 @@
% code.
% XXX This implementation is currently incomplete, so in future
% this interface may change.
-:- pred foreign__extrude_pragma_implementation(foreign_language,
+:- pred foreign__extrude_pragma_implementation(list(foreign_language),
list(pragma_var), sym_name, pred_or_func, prog_context,
module_info, pragma_foreign_proc_attributes,
pragma_foreign_code_impl,
@@ -71,6 +71,20 @@
:- mode foreign__make_pragma_import(in, in, in, in, in,
out, out, out, out, out, out) is det.
+
+ % It is possible that more than one foreign language could be used to
+ % implement a particular piece of code.
+ % Therefore, foreign languages have an order of preference, from most
+ % preferred to least perferred.
+ % prefer_foreign_language(Globals, Target, Lang1, Lang2) returns the
+ % result of comparison of Lang1 and Lang2 (given the supplied globals
+ % and compilation target).
+ %
+ % If neither language is preferred over the other, (=) will be
+ % returned. This may be considered an error for many purposes.
+:- func foreign__compare_foreign_language(globals, compilation_target,
+ foreign_language, foreign_language) = comparison_result.
+
:- implementation.
:- import_module list, map, assoc_list, std_util, string, varset, int.
@@ -79,6 +93,44 @@
:- import_module hlds_pred, hlds_module, type_util, mode_util.
:- import_module code_model.
+ % Currently we don't use the globals to compare foreign language
+ % interfaces, but if we added appropriate options we might want
+ % to do this later.
+
+ % C is always preferred over any other language.
+compare_foreign_language(_Globals, c, Lang1, Lang2) =
+ ( Lang1 = c ->
+ (>)
+ ; Lang2 = c ->
+ (<)
+ ;
+ (=)
+ ).
+
+ % Same as for C
+compare_foreign_language(Globals, asm, Lang1, Lang2) =
+ compare_foreign_language(Globals, c, Lang1, Lang2).
+
+ % First prefer csharp, then prefer managed_cplusplus, after
+ % that we don't care.
+compare_foreign_language(_Globals, il, Lang1, Lang2) =
+ ( Lang1 = csharp ->
+ (>)
+ ; Lang2 = csharp ->
+ (<)
+ ; Lang1 = managed_cplusplus ->
+ (>)
+ ; Lang1 = managed_cplusplus ->
+ (<)
+ ;
+ (=)
+ ).
+
+ % Nothing useful to do here, but when we add Java as a
+ % foreign language, we should add it here.
+compare_foreign_language(_Globals, java, _Lang1, _Lang2) = (=).
+
+
foreign__filter_decls(WantedLang, Decls0, LangDecls, NotLangDecls) :-
list__filter((pred(foreign_decl_code(Lang, _, _)::in) is semidet :-
WantedLang = Lang),
@@ -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.").
+
+ % We just use the first target language for now, it might be nice
+ % to try a few others if the backend supports multiple ones.
+foreign__extrude_pragma_implementation([TargetLang | TargetLangs],
+ _PragmaVars, _PredName, _PredOrFunc, _Context,
ModuleInfo0, Attributes, Impl0,
ModuleInfo, NewAttributes, Impl) :-
foreign_language(Attributes, ForeignLanguage),
- set_foreign_language(Attributes, TargetLang, NewAttributes),
- ( TargetLang = c ->
- ( ForeignLanguage = managed_cplusplus,
- % This isn't finished yet, and we probably won't
- % implement it for C calling MC++.
- % For C calling normal C++ we would generate a proxy
- % function in C++ (implemented in a piece of C++
- % body code) with C linkage, and import that
- % function.
- % The backend would spit the C++ body code into
- % a separate file.
- % The code would look a little like this:
- /*
- NewName = make_pred_name(ForeignLanguage, PredName),
- ( PredOrFunc = predicate ->
- ReturnCode = ""
- ;
- ReturnCode = "ReturnVal = "
- ),
- C_ExtraCode = "Some Extra Code To Run",
- create_pragma_import_c_code(PragmaVars, ModuleInfo0,
- "", VarString),
- module_add_foreign_body_code(cplusplus,
- C_ExtraCode, Context, ModuleInfo0, ModuleInfo),
- Impl = import(NewName, ReturnCode, VarString, no)
- */
- error("unimplemented: calling MC++ foreign code from C backend")
-
-
- ; ForeignLanguage = csharp,
- error("unimplemented: calling C# foreign code from C backend")
- ; ForeignLanguage = c,
- Impl = Impl0,
- ModuleInfo = ModuleInfo0
- )
- ; TargetLang = managed_cplusplus ->
- % Don't do anything - C and MC++ are embedded
- % inside MC++ without any changes.
- ( ForeignLanguage = managed_cplusplus,
- Impl = Impl0,
- ModuleInfo = ModuleInfo0
- ; ForeignLanguage = csharp,
- error("unimplemented: calling C# foreign code from MC++ backend")
- ; ForeignLanguage = c,
- Impl = Impl0,
- ModuleInfo = ModuleInfo0
- )
- ; TargetLang = csharp ->
- ( ForeignLanguage = managed_cplusplus,
- error("unimplemented: calling MC++ foreign code from MC++ backend")
- ; ForeignLanguage = csharp,
- Impl = Impl0,
- ModuleInfo = ModuleInfo0
- ; ForeignLanguage = c,
- error("unimplemented: calling C foreign code from MC++ backend")
- )
+
+ % If the foreign language is available as a target language,
+ % we don't need to do anything.
+ ( list__member(ForeignLanguage, [TargetLang | TargetLangs]) ->
+ Impl = Impl0,
+ ModuleInfo = ModuleInfo0,
+ NewAttributes = Attributes
;
- error("extrude_pragma_implementation: unsupported foreign language")
+ set_foreign_language(Attributes, TargetLang, NewAttributes),
+ ( TargetLang = c ->
+ ( ForeignLanguage = managed_cplusplus,
+ % This isn't finished yet, and we probably won't
+ % implement it for C calling MC++.
+ % For C calling normal C++ we would generate a proxy
+ % function in C++ (implemented in a piece of C++
+ % body code) with C linkage, and import that
+ % function.
+ % The backend would spit the C++ body code into
+ % a separate file.
+ % The code would look a little like this:
+ /*
+ NewName = make_pred_name(ForeignLanguage, PredName),
+ ( PredOrFunc = predicate ->
+ ReturnCode = ""
+ ;
+ ReturnCode = "ReturnVal = "
+ ),
+ C_ExtraCode = "Some Extra Code To Run",
+ create_pragma_import_c_code(PragmaVars, ModuleInfo0,
+ "", VarString),
+ module_add_foreign_body_code(cplusplus,
+ C_ExtraCode, Context, ModuleInfo0, ModuleInfo),
+ Impl = import(NewName, ReturnCode, VarString, no)
+ */
+ error("unimplemented: calling MC++ foreign code from C backend")
+
+
+ ; ForeignLanguage = csharp,
+ error("unimplemented: calling C# foreign code from C backend")
+ ; ForeignLanguage = c,
+ Impl = Impl0,
+ ModuleInfo = ModuleInfo0
+ )
+ ; TargetLang = managed_cplusplus ->
+ % Don't do anything - C and MC++ are embedded
+ % inside MC++ without any changes.
+ ( ForeignLanguage = managed_cplusplus,
+ Impl = Impl0,
+ ModuleInfo = ModuleInfo0
+ ; ForeignLanguage = csharp,
+ error("unimplemented: calling C# foreign code from MC++ backend")
+ ; ForeignLanguage = c,
+ Impl = Impl0,
+ ModuleInfo = ModuleInfo0
+ )
+ ; TargetLang = csharp ->
+ ( ForeignLanguage = managed_cplusplus,
+ error("unimplemented: calling C# foreign code from MC++ backend")
+ ; ForeignLanguage = csharp,
+ Impl = Impl0,
+ ModuleInfo = ModuleInfo0
+ ; ForeignLanguage = c,
+ error("unimplemented: calling C foreign code from MC++ backend")
+ )
+ ;
+ error("extrude_pragma_implementation: unsupported foreign language")
+ )
).
% XXX we haven't implemented these functions yet.
Index: compiler/globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.43
diff -u -r1.43 globals.m
--- compiler/globals.m 2001/05/24 06:07:03 1.43
+++ compiler/globals.m 2001/07/17 16:51:25
@@ -124,6 +124,9 @@
:- pred globals__io_get_target(compilation_target::out,
io__state::di, io__state::uo) is det.
+
+:- pred globals__io_get_backend_foreign_languages(list(foreign_language)::out,
+ io__state::di, io__state::uo) is det.
:- pred globals__io_lookup_foreign_language_option(option::in,
foreign_language::out, io__state::di, io__state::uo) is det.
@@ -422,6 +425,17 @@
ForeignLang = ForeignLang0
;
error("globals__io_lookup_foreign_language_option: invalid foreign_language option")
+ }.
+
+globals__io_get_backend_foreign_languages(ForeignLangs) -->
+ globals__io_lookup_accumulating_option(backend_foreign_languages,
+ LangStrs),
+ { ForeignLangs = list__map(func(String) = ForeignLang :-
+ (convert_foreign_language(String, ForeignLang0) ->
+ ForeignLang = ForeignLang0
+ ;
+ error("globals__io_get_backend_foreign_languages: invalid foreign_language string")
+ ), LangStrs)
}.
globals__io_lookup_bool_option(Option, Value) -->
Index: compiler/goal_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/goal_util.m,v
retrieving revision 1.69
diff -u -r1.69 goal_util.m
--- compiler/goal_util.m 2001/04/07 14:04:37 1.69
+++ compiler/goal_util.m 2001/07/17 16:51:25
@@ -726,7 +726,7 @@
clause_list_size(Clauses, GoalSize) :-
GetClauseSize =
(pred(Clause::in, Size0::in, Size::out) is det :-
- Clause = clause(_, ClauseGoal, _),
+ Clause = clause(_, ClauseGoal, _, _),
goal_size(ClauseGoal, ClauseSize),
Size = Size0 + ClauseSize
),
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.112
diff -u -r1.112 handle_options.m
--- compiler/handle_options.m 2001/06/27 05:04:03 1.112
+++ compiler/handle_options.m 2001/07/17 16:51:26
@@ -701,42 +701,46 @@
% The preferred backend foreign language depends on the target.
(
{ Target = c },
- { BackendForeignLanguage = foreign_language_string(c) }
+ { BackendForeignLanguages = ["c"] },
+ { DefaultForeignLanguage = foreign_language_string(c) }
;
{ Target = il },
- { BackendForeignLanguage =
+ { BackendForeignLanguages = ["csharp", "mc++"] },
+ { DefaultForeignLanguage =
foreign_language_string(managed_cplusplus) }
;
{ Target = asm },
+ % Should add asm here too when it becomes available.
+ { BackendForeignLanguages = ["c"] },
% XXX This is wrong! It should be asm.
- { BackendForeignLanguage = foreign_language_string(c) }
+ { DefaultForeignLanguage = foreign_language_string(c) }
;
% XXX We don't generate java or handle it as a foreign
% language just yet, but if we did, we should fix this
{ Target = java },
- { BackendForeignLanguage = foreign_language_string(c) }
+ { BackendForeignLanguages = [] },
+ { DefaultForeignLanguage = foreign_language_string(c) }
),
- % only set the backend foreign language if it is unset
- globals__io_lookup_string_option(backend_foreign_language,
+ % only set the backend foreign languages if they are unset
+ globals__io_lookup_accumulating_option(backend_foreign_languages,
CurrentBackendForeignLanguage),
(
- { CurrentBackendForeignLanguage = "" }
+ { CurrentBackendForeignLanguage = [] }
->
- globals__io_set_option(backend_foreign_language,
- string(BackendForeignLanguage))
+ globals__io_set_option(backend_foreign_languages,
+ accumulating(BackendForeignLanguages))
;
[]
),
- % The default foreign language we use is the same as the backend.
globals__io_lookup_string_option(use_foreign_language,
UseForeignLanguage),
(
{ UseForeignLanguage = "" }
->
globals__io_set_option(use_foreign_language,
- string(BackendForeignLanguage))
+ string(DefaultForeignLanguage))
;
{ convert_foreign_language(UseForeignLanguage, FL) }
->
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.263
diff -u -r1.263 hlds_out.m
--- compiler/hlds_out.m 2001/07/10 10:45:23 1.263
+++ compiler/hlds_out.m 2001/07/17 16:51:27
@@ -917,7 +917,7 @@
io__write_list(HeadVars, ", ", PrintVar),
io__write_string("] (\n"),
- { Clause = clause(_Modes, Goal, _Context) },
+ { Clause = clause(_Modes, Goal, _Lang, _Context) },
hlds_out__write_goal_a(Goal, ModuleInfo, VarSet, AppendVarnums,
Indent+1, ").\n", TypeQual).
@@ -944,6 +944,7 @@
Clause = clause(
Modes,
Goal,
+ Lang,
Context
),
Indent1 is Indent + 1
@@ -959,6 +960,9 @@
;
[]
),
+ io__write_string("% Language of implementation: "),
+ io__write(Lang),
+ io__nl,
{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
{ pred_info_procids(PredInfo, ProcIds) },
( { Modes = [] ; Modes = ProcIds } ->
Index: compiler/hlds_pred.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_pred.m,v
retrieving revision 1.97
diff -u -r1.97 hlds_pred.m
--- compiler/hlds_pred.m 2001/07/10 12:51:02 1.97
+++ compiler/hlds_pred.m 2001/07/17 16:51:28
@@ -217,10 +217,17 @@
% it applies to all
% clauses)
hlds_goal, % Body
+ implementation_language,
+ % implementation
+ % language
prog_context
).
%-----------------------------------------------------------------------------%
+
+:- type implementation_language ---> mercury
+ ; foreign_language(foreign_language).
+
% The type of goals that have been given for a pred.
Index: compiler/inlining.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/inlining.m,v
retrieving revision 1.100
diff -u -r1.100 inlining.m
--- compiler/inlining.m 2001/04/07 14:04:41 1.100
+++ compiler/inlining.m 2001/07/17 16:51:28
@@ -311,7 +311,7 @@
(
Size < SimpleThreshold
;
- Clauses = [clause(_, Goal, _)],
+ Clauses = [clause(_, Goal, _, _)],
Size < SimpleThreshold * 3,
%
% For flat goals, we are more likely to be able to
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.102
diff -u -r1.102 intermod.m
--- compiler/intermod.m 2001/07/16 08:20:59 1.102
+++ compiler/intermod.m 2001/07/17 16:51:29
@@ -358,8 +358,8 @@
bool::out, intermod_info::in, intermod_info::out) is det.
intermod__traverse_clauses([], [], yes) --> [].
-intermod__traverse_clauses([clause(P, Goal0, C) | Clauses0],
- [clause(P, Goal, C) | Clauses], DoWrite) -->
+intermod__traverse_clauses([clause(P, Goal0, L, C) | Clauses0],
+ [clause(P, Goal, L, C) | Clauses], DoWrite) -->
intermod__traverse_goal(Goal0, Goal, DoWrite1),
( { DoWrite1 = yes } ->
intermod__traverse_clauses(Clauses0, Clauses, DoWrite)
@@ -397,14 +397,14 @@
clause_list_is_deforestable(PredId, Clauses) :-
some [Clause1] (
list__member(Clause1, Clauses),
- Clause1 = clause(_, Goal1, _),
+ Clause1 = clause(_, Goal1, _, _),
goal_calls_pred_id(Goal1, PredId)
),
(
Clauses = [_, _ | _]
;
Clauses = [Clause2],
- Clause2 = clause(_, Goal2, _),
+ Clause2 = clause(_, Goal2, _, _),
goal_to_conj_list(Goal2, GoalList),
goal_contains_one_branched_goal(GoalList)
).
@@ -1449,8 +1449,8 @@
:- pred strip_headvar_unifications(list(prog_var)::in,
clause::in, list(prog_term)::out, clause::out) is det.
-strip_headvar_unifications(HeadVars, clause(ProcIds, Goal0, Context),
- HeadTerms, clause(ProcIds, Goal, Context)) :-
+strip_headvar_unifications(HeadVars, clause(ProcIds, Goal0, Lang, Context),
+ HeadTerms, clause(ProcIds, Goal, Lang, Context)) :-
Goal0 = _ - GoalInfo0,
goal_to_conj_list(Goal0, Goals0),
map__init(HeadVarMap0),
@@ -1622,7 +1622,7 @@
intermod__write_foreign_code(_, _, _, _, [], _) --> [].
intermod__write_foreign_code(SymName, PredOrFunc, HeadVars, Varset,
[Clause | Clauses], Procs) -->
- { Clause = clause(ProcIds, Goal, _) },
+ { Clause = clause(ProcIds, Goal, _, _) },
(
(
% Pull the foreign code out of the goal.
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.
+ 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/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.95
diff -u -r1.95 ml_code_gen.m
--- compiler/ml_code_gen.m 2001/07/16 09:49:38 1.95
+++ compiler/ml_code_gen.m 2001/07/17 16:51:33
@@ -798,25 +798,41 @@
ml_gen_defns(ModuleInfo, Defns),
{ MLDS = mlds(ModuleName, ForeignCode, Imports, Defns) }.
-:- pred ml_gen_foreign_code(module_info, mlds__foreign_code,
- io__state, io__state).
+:- pred ml_gen_foreign_code(module_info, map(foreign_language,
+ mlds__foreign_code), io__state, io__state).
:- mode ml_gen_foreign_code(in, out, di, uo) is det.
-ml_gen_foreign_code(ModuleInfo, MLDS_ForeignCode) -->
+ml_gen_foreign_code(ModuleInfo, All_MLDS_ForeignCode) -->
{ module_info_get_foreign_decl(ModuleInfo, ForeignDecls) },
{ module_info_get_foreign_body_code(ModuleInfo, ForeignBodys) },
- globals__io_lookup_foreign_language_option(use_foreign_language,
- UseForeignLanguage),
- { foreign__filter_decls(UseForeignLanguage, ForeignDecls,
- WantedForeignDecls, _OtherForeignDecls) },
- { foreign__filter_bodys(UseForeignLanguage, ForeignBodys,
- WantedForeignBodys, _OtherForeignBodys) },
- { ConvBody = (func(foreign_body_code(L, S, C)) =
- user_foreign_code(L, S, C)) },
- { MLDSWantedForeignBodys = list__map(ConvBody, WantedForeignBodys) },
- { ml_gen_pragma_export(ModuleInfo, MLDS_PragmaExports) },
- { MLDS_ForeignCode = mlds__foreign_code(WantedForeignDecls,
- MLDSWantedForeignBodys, MLDS_PragmaExports) }.
+ globals__io_get_backend_foreign_languages(BackendForeignLanguages),
+
+ { list__foldl((pred(Lang::in, Map0::in, Map::out) is det :-
+ foreign__filter_decls(Lang,
+ ForeignDecls, WantedForeignDecls,
+ _OtherForeignDecls),
+ foreign__filter_bodys(Lang,
+ ForeignBodys, WantedForeignBodys,
+ _OtherForeignBodys),
+ ConvBody = (func(foreign_body_code(L, S, C)) =
+ user_foreign_code(L, S, C)),
+ MLDSWantedForeignBodys = list__map(ConvBody,
+ WantedForeignBodys),
+ % XXX exports are only implemented for
+ % C at the moment
+ ( Lang = c ->
+ ml_gen_pragma_export(ModuleInfo,
+ MLDS_PragmaExports)
+ ;
+ MLDS_PragmaExports = []
+ ),
+ MLDS_ForeignCode = mlds__foreign_code(
+ WantedForeignDecls, MLDSWantedForeignBodys,
+ MLDS_PragmaExports),
+ map__det_insert(Map0, Lang,
+ MLDS_ForeignCode, Map)
+ ), BackendForeignLanguages, map__init, All_MLDS_ForeignCode) }.
+
:- pred ml_gen_imports(module_info, mlds__imports).
:- mode ml_gen_imports(in, out) is det.
@@ -2002,10 +2018,11 @@
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes, PragmaImpl),
CodeModel, OuterContext, MLDS_Decls, MLDS_Statements) -->
(
- { PragmaImpl = ordinary(C_Code, _MaybeContext) },
+ { PragmaImpl = ordinary(Foreign_Code, _MaybeContext) },
ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- C_Code, OuterContext, MLDS_Decls, MLDS_Statements)
+ Foreign_Code, OuterContext, MLDS_Decls,
+ MLDS_Statements)
;
{ PragmaImpl = nondet(
LocalVarsDecls, LocalVarsContext,
@@ -2018,11 +2035,11 @@
SharedCode, SharedContext, MLDS_Decls, MLDS_Statements)
;
{ PragmaImpl = import(Name, HandleReturn, Vars, _Context) },
- { C_Code = string__append_list([HandleReturn, " ",
+ { ForeignCode = string__append_list([HandleReturn, " ",
Name, "(", Vars, ");"]) },
ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- C_Code, OuterContext, MLDS_Decls, MLDS_Statements)
+ ForeignCode, OuterContext, MLDS_Decls, MLDS_Statements)
).
ml_gen_goal_expr(shorthand(_), _, _, _, _) -->
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.63
diff -u -r1.63 mlds.m
--- compiler/mlds.m 2001/07/13 10:27:44 1.63
+++ compiler/mlds.m 2001/07/17 16:51:34
@@ -286,7 +286,7 @@
% It would be nice to avoid this dependency...
:- import_module llds.
-:- import_module bool, list, assoc_list, std_util.
+:- import_module bool, list, assoc_list, std_util, map.
%-----------------------------------------------------------------------------%
@@ -303,7 +303,7 @@
% Code defined in some other language, e.g. for
% `pragma c_header_code', etc.
- foreign_code :: mlds__foreign_code,
+ foreign_code :: map(foreign_language, mlds__foreign_code),
% The MLDS code itself
% Packages/classes to import
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.97
diff -u -r1.97 mlds_to_c.m
--- compiler/mlds_to_c.m 2001/07/12 23:22:53 1.97
+++ compiler/mlds_to_c.m 2001/07/17 16:51:35
@@ -61,7 +61,7 @@
:- import_module builtin_ops, c_util, modules.
:- import_module prog_data, prog_out, type_util, error_util, code_model.
-:- import_module bool, int, string, library, list.
+:- import_module bool, int, string, library, list, map.
:- import_module assoc_list, term, std_util, require.
%-----------------------------------------------------------------------------%
@@ -120,9 +120,11 @@
:- mode mlds_output_hdr_file(in, in, di, uo) is det.
mlds_output_hdr_file(Indent, MLDS) -->
- { MLDS = mlds(ModuleName, ForeignCode, Imports, Defns) },
+ { MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns) },
mlds_output_hdr_start(Indent, ModuleName), io__nl,
mlds_output_hdr_imports(Indent, Imports), io__nl,
+ % Get the foreign code for C
+ { ForeignCode = map__lookup(AllForeignCode, c) },
mlds_output_c_hdr_decls(MLDS_ModuleName, Indent, ForeignCode), io__nl,
%
% The header file must contain _definitions_ of all public types,
@@ -190,9 +192,12 @@
:- mode mlds_output_src_file(in, in, di, uo) is det.
mlds_output_src_file(Indent, MLDS) -->
- { MLDS = mlds(ModuleName, ForeignCode, Imports, Defns) },
+ { MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns) },
mlds_output_src_start(Indent, ModuleName), io__nl,
mlds_output_src_imports(Indent, Imports), io__nl,
+
+ % Get the foreign code for C
+ { ForeignCode = map__lookup(AllForeignCode, c) },
mlds_output_c_decls(Indent, ForeignCode), io__nl,
%
% The public types have already been defined in the
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
@@ -89,7 +89,7 @@
:- mode generate_csharp_code(in, di, uo) is det.
generate_csharp_code(MLDS) -->
- { MLDS = mlds(ModuleName, ForeignCode, _Imports, Defns) },
+ { MLDS = mlds(ModuleName, AllForeignCode, _Imports, Defns) },
{ ClassName = class_name(mercury_module_name_to_mlds(ModuleName),
wrapper_class_name) },
@@ -101,6 +101,8 @@
"using mercury;\n",
"\n"]),
+ % Get the foreign code for C#
+ { ForeignCode = map__lookup(AllForeignCode, csharp) },
generate_foreign_header_code(mercury_module_name_to_mlds(ModuleName),
ForeignCode),
@@ -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 "),
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.46
diff -u -r1.46 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 2001/07/12 22:19:59 1.46
+++ compiler/mlds_to_gcc.m 2001/07/17 16:51:36
@@ -216,8 +216,11 @@
).
mlds_to_gcc__compile_to_asm(MLDS, ContainsCCode) -->
- { MLDS = mlds(ModuleName, ForeignCode, Imports, Defns0) },
+ { MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns0) },
+ % We only handle C currently, so we just look up C
+ { ForeignCode = map__lookup(AllForeignCode, c) },
+
%
% Handle output of any foreign code (C, Ada, Fortran, etc.)
% to appropriate files.
@@ -259,7 +262,7 @@
% create a new MLDS containing just the foreign code
% (with all definitions made public, so we can use
% them from the asm file!) and pass that to mlds_to_c.m
- { ForeignMLDS = mlds(ModuleName, ForeignCode, Imports,
+ { ForeignMLDS = mlds(ModuleName, AllForeignCode, Imports,
list__map(make_public, ForeignDefns)) },
mlds_to_c__output_mlds(ForeignMLDS, ""),
% XXX currently the only foreign code we handle is C;
Index: compiler/mlds_to_mcpp.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_mcpp.m,v
retrieving revision 1.11
diff -u -r1.11 mlds_to_mcpp.m
--- compiler/mlds_to_mcpp.m 2001/07/12 15:44:58 1.11
+++ compiler/mlds_to_mcpp.m 2001/07/17 16:51:37
@@ -91,7 +91,7 @@
:- mode generate_mcplusplus_code(in, di, uo) is det.
generate_mcplusplus_code(MLDS) -->
- { MLDS = mlds(ModuleName, ForeignCode, _Imports, Defns) },
+ { MLDS = mlds(ModuleName, AllForeignCode, _Imports, Defns) },
{ prog_out__sym_name_to_string(ModuleName, ModuleNameStr) },
{ ClassName = class_name(mercury_module_name_to_mlds(ModuleName),
wrapper_class_name) },
@@ -128,6 +128,8 @@
io__format("namespace %s {", [s(N)])
)),
+ % Get the foreign code for MC++
+ { ForeignCode = map__lookup(AllForeignCode, managed_cplusplus) },
generate_foreign_header_code(mercury_module_name_to_mlds(ModuleName),
ForeignCode),
Index: compiler/modes.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/modes.m,v
retrieving revision 1.253
diff -u -r1.253 modes.m
--- compiler/modes.m 2001/04/07 14:04:51 1.253
+++ compiler/modes.m 2001/07/17 16:51:38
@@ -792,7 +792,7 @@
pred_info_clauses_info(PredInfo, ClausesInfo),
clauses_info_clauses(ClausesInfo, ClauseList),
( ClauseList = [FirstClause | _] ->
- FirstClause = clause(_, _, Context)
+ FirstClause = clause(_, _, _, Context)
;
proc_info_context(ProcInfo0, Context)
),
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.327
diff -u -r1.327 options.m
--- compiler/options.m 2001/07/12 22:20:01 1.327
+++ compiler/options.m 2001/07/17 16:51:39
@@ -209,10 +209,9 @@
% Options for internal use only
% (the values of these options are implied by the
% settings of other options)
- % The language that this backend can
- % interface to most easily (probably the
- % target language of the backend).
- ; backend_foreign_language
+ % The foreign programming languages that this
+ % backend can interface to.
+ ; backend_foreign_languages
% Stack layout information required to do
% a stack trace.
; basic_stack_layout
@@ -623,7 +622,7 @@
% ridden by a value from configure.
type_layout - bool(yes),
use_foreign_language - string(""),
- backend_foreign_language- string(""),
+ backend_foreign_languages- accumulating([]),
% The previous two options
% depend on the target and are
% set in handle_options.
@@ -1032,7 +1031,8 @@
long_option("conf-low-tag-bits", conf_low_tag_bits).
long_option("type-layout", type_layout).
long_option("use-foreign-language", use_foreign_language).
-long_option("backend-foreign-language", backend_foreign_language).
+long_option("backend-foreign-languages",
+ backend_foreign_languages).
long_option("agc-stack-layout", agc_stack_layout).
long_option("basic-stack-layout", basic_stack_layout).
long_option("procid-stack-layout", procid_stack_layout).
Index: compiler/polymorphism.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/polymorphism.m,v
retrieving revision 1.214
diff -u -r1.214 polymorphism.m
--- compiler/polymorphism.m 2001/07/12 16:30:44 1.214
+++ compiler/polymorphism.m 2001/07/17 16:51:40
@@ -583,7 +583,7 @@
->
{ Clause = Clause0 }
;
- { Clause0 = clause(ProcIds, Goal0, Context) },
+ { Clause0 = clause(ProcIds, Goal0, Lang, Context) },
%
% process any polymorphic calls inside the goal
%
@@ -602,7 +602,7 @@
{ pred_info_get_exist_quant_tvars(PredInfo0, ExistQVars) },
polymorphism__fixup_quantification(NewHeadVars, ExistQVars,
Goal2, Goal),
- { Clause = clause(ProcIds, Goal, Context) }
+ { Clause = clause(ProcIds, Goal, Lang, Context) }
).
:- pred polymorphism__process_procs(list(proc_id), proc_table,
Index: compiler/purity.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/purity.m,v
retrieving revision 1.34
diff -u -r1.34 purity.m
--- compiler/purity.m 2001/07/13 17:34:56 1.34
+++ compiler/purity.m 2001/07/17 16:51:40
@@ -562,7 +562,7 @@
compute_purity([], [], _, Purity, Purity) --> [].
compute_purity([Clause0|Clauses0], [Clause|Clauses], ProcIds,
Purity0, Purity) -->
- { Clause0 = clause(Ids, Body0 - Info0, Context) },
+ { Clause0 = clause(Ids, Body0 - Info0, Lang, Context) },
compute_expr_purity(Body0, Body, Info0, no, Bodypurity0),
% If this clause doesn't apply to all modes of this procedure,
% i.e. the procedure has different clauses for different modes,
@@ -577,12 +577,12 @@
{ worst_purity(Bodypurity0, Clausepurity, Bodypurity) },
{ add_goal_info_purity_feature(Info0, Bodypurity, Info) },
{ worst_purity(Purity0, Bodypurity, Purity1) },
- { Clause = clause(Ids, Body - Info, Context) },
+ { Clause = clause(Ids, Body - Info, Lang, Context) },
compute_purity(Clauses0, Clauses, ProcIds, Purity1, Purity).
:- pred applies_to_all_modes(clause::in, list(proc_id)::in) is semidet.
-applies_to_all_modes(clause(ClauseProcIds, _, _), ProcIds) :-
+applies_to_all_modes(clause(ClauseProcIds, _, _, _), ProcIds) :-
(
% an empty list here means that the clause applies
% to *all* procedures
Index: compiler/typecheck.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/typecheck.m,v
retrieving revision 1.305
diff -u -r1.305 typecheck.m
--- compiler/typecheck.m 2001/07/16 08:21:05 1.305
+++ compiler/typecheck.m 2001/07/17 16:51:43
@@ -820,7 +820,7 @@
goal_info_set_nonlocals(GoalInfo0, NonLocals, GoalInfo),
Goal = GoalExpr - GoalInfo,
ProcIds = [], % the clause applies to all procedures.
- Clause = clause(ProcIds, Goal, Context),
+ Clause = clause(ProcIds, Goal, mercury, Context),
clauses_info_set_clauses(ClausesInfo0, [Clause], ClausesInfo),
pred_info_set_clauses_info(PredInfo0, ClausesInfo, PredInfo)
;
@@ -871,14 +871,14 @@
typecheck_clause(Clause0, HeadVars, ArgTypes, Clause) -->
% XXX abstract clause/3
- { Clause0 = clause(Modes, Body0, Context) },
+ { Clause0 = clause(Modes, Body0, Lang, Context) },
typecheck_info_set_context(Context),
% typecheck the clause - first the head unification, and
% then the body
typecheck_var_has_type_list(HeadVars, ArgTypes, 1),
typecheck_goal(Body0, Body),
checkpoint("end of clause"),
- { Clause = clause(Modes, Body, Context) },
+ { Clause = clause(Modes, Body, Lang, Context) },
typecheck_info_set_context(Context),
typecheck_check_for_ambiguity(clause_only, HeadVars).
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.93
diff -u -r1.93 unify_proc.m
--- compiler/unify_proc.m 2001/06/27 05:04:33 1.93
+++ compiler/unify_proc.m 2001/07/17 16:51:45
@@ -901,7 +901,7 @@
Body, Varset, Types, _Warnings) },
unify_proc__info_set_varset(Varset),
unify_proc__info_set_types(Types),
- { Clause = clause([], Body, Context) }.
+ { Clause = clause([], Body, mercury, Context) }.
%-----------------------------------------------------------------------------%
--
Tyson Dowd #
# Surreal humour isn't everyone's cup of fur.
trd at cs.mu.oz.au #
http://www.cs.mu.oz.au/~trd #
--------------------------------------------------------------------------
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
--------------------------------------------------------------------------
More information about the reviews
mailing list