[m-rev.] diff: C# interface for .NET backend.
Tyson Dowd
trd at cs.mu.OZ.AU
Tue May 1 00:41:44 AEST 2001
Hi,
This is the new C# interface. If it bootstraps in hlc.gc, I plan to
commit it to the main branch pretty soon. If it works out well (some
more testing is needed) I will probably migrate the MC++ interface to
use a similar technique.
I'm keen to commit soon because:
- this change is on petdr's critical path
- this change splits a module apart, which is hard to maintain
across branches
- there are quite a few useful code clean-ups in this code that
I find myself re-doing in other workspaces.
The main change that will affect other people is the change to the
mlds__var_name type.
===================================================================
Estimated hours taken: 45
Branches: main
Implement a C# interface for the .NET backend.
To use it, you currently need to set
--backend-foreign-language csharp --use-foreign-language csharp
in your MCFLAGS.
The C# foreign language interface works by introducing a new sort of
MLDS statement called outline_target_code. outline_target_code is expected
to be turned into a separate procedure in a separate file. This is
quite different to normal foreign code which has been renamed as inline
target code, as it is really intended to be generated inline, inside the
generated code.
Because outline_target_code is expected to be generated outside the
normal code, we don't need to generate variable renamings,
initializations, casts and other complicated interfacing code.
Any marshalling is done by the backend, which knows how to marshall
arguments across the boundary into the outline code and back. In the
case of marshalling to C# from the .NET backend, we currently don't do
anything special (part of the point of .NET is that data
representation don't have to change very often just because you are
using different languages, so this is a property we should try to
preserve).
The actual implementation of the foreign code is therefore very simple.
Simply generate an appropriate procedure, and insert the user's code in
the middle.
The bulk of this change to delay the mangling of MLDS var names, so we
can still use the original user's var name when we output the outline
procedure (since the user's foreign code will refer to these var names,
it's important to keep them around).
compiler/foreign.m:
Handle the csharp foreign language.
compiler/globals.m:
Fix an XXX about converting to lowercase to do language name
comparisons.
Add new predicates to make conversion of foreign languages
to strings more uniform.
compiler/handle_options.m:
Don't set backend_foreign_language to the default if it has
already been set by hand.
compiler/ml_call_gen.m:
compiler/ml_code_gen.m:
compiler/ml_code_util.m:
Delay the mangling of MLDS var names by keeping the variable
number around until the output phase.
Slightly generalize the handling of foreign language interfacing.
Handle C# foreign language interfacing.
Add value_output_vars to the ml_gen_info, which are the variables
returned rather than passed by reference. We need to know
these variables for C# interfacing so that we can handle the return
value of the forwarding function.
Mark the beginning and end of the MLDS foreign language processing as
a "sub-module" (in comments at least). Later I may put this code
into a separate module.
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_string_switch.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/ml_util.m:
compiler/rtti_to_mlds.m:
Handle the new var_name type, and the new target_code constructors.
compiler/mlds.m:
Add outline_target_code which is handled differently to the old
target_code (which has been renamed inline_target_code).
Change the definiton for mlds__var_name.
compiler/mlds_to_c.m:
Factor out mlds_output_to_file.
compiler/mlds_to_csharp.m:
A new module to generate C# code suitable for foreign language
interfacing. This is largely lifted from the MC++ code, with a few
changes to the output syntax.
compiler/mlds_to_il.m:
Return the set of foreign languages processed instead of a bool
saying wither MC++ was present. This is so we can generate the
appropriate output .cs or .cpp files, and because we need to keep
track of all the external assembly references we need to put in the
.il file.
Handle the inline_target_code and mlds__var_name changes.
compiler/mlds_to_ilasm.m:
Output .cpp and .cs files conditionally.
Factor out output_to_file.
Move MC++ output code to mlds_to_mcpp.m
compiler/mlds_to_java.m:
Factor out output_to_file.
Handle the new var_name type, and the new target_code constructors.
compiler/mlds_to_mcpp.m:
New file to handle generating MC++ code suitable for foreign language
interfacing.
compiler/options.m:
Add a way of setting the backend-foreign-language option.
compiler/passes_aux.m:
Add output_to_file which is used by the MLDS backend to generate
output files.
compiler/prog_data.m:
Uncomment csharp as a foreign language.
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.3
diff -u -r1.3 foreign.m
--- compiler/foreign.m 2001/04/03 03:19:34 1.3
+++ compiler/foreign.m 2001/04/30 13:50:33
@@ -121,6 +121,10 @@
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
@@ -131,10 +135,21 @@
( 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")
+ )
;
error("extrude_pragma_implementation: unsupported foreign language")
).
@@ -146,12 +161,15 @@
"mercury_c__" ++ make_pred_name_rest(c, SymName).
make_pred_name(managed_cplusplus, SymName) =
"mercury_cpp__" ++ make_pred_name_rest(managed_cplusplus, SymName).
+make_pred_name(csharp, SymName) =
+ "mercury_csharp__" ++ make_pred_name_rest(managed_cplusplus, SymName).
:- func make_pred_name_rest(foreign_language, sym_name) = string.
make_pred_name_rest(c, _SymName) = "some_c_name".
make_pred_name_rest(managed_cplusplus, qualified(ModuleSpec, Name)) =
make_pred_name_rest(managed_cplusplus, ModuleSpec) ++ "__" ++ Name.
make_pred_name_rest(managed_cplusplus, unqualified(Name)) = Name.
+make_pred_name_rest(csharp, _SymName) = "some_csharp_name".
make_pragma_import(PredInfo, ProcInfo, C_Function, Context,
Index: compiler/globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.41
diff -u -r1.41 globals.m
--- compiler/globals.m 2001/02/08 11:37:46 1.41
+++ compiler/globals.m 2001/04/30 13:50:33
@@ -59,8 +59,14 @@
:- pred convert_prolog_dialect(string::in, prolog_dialect::out) is semidet.
:- pred convert_termination_norm(string::in, termination_norm::out) is semidet.
+ % A string representation of the foreign language suitable
+ % for use in human-readable error messages
:- func foreign_language_string(foreign_language) = string.
+ % A string representation of the foreign language suitable
+ % for use in machine-readable name mangling.
+:- func simple_foreign_language_string(foreign_language) = string.
+
%-----------------------------------------------------------------------------%
% Access predicates for the `globals' structure.
@@ -183,31 +189,38 @@
:- implementation.
:- import_module exprn_aux.
-:- import_module map, std_util, require.
+:- import_module map, std_util, require, string.
+
+convert_target(String, Target) :-
+ convert_target_2(string__to_lower(String), Target).
- % XXX we should probably just convert to lower case and then
- % test against known strings.
-convert_target("java", java).
-convert_target("Java", java).
-convert_target("asm", asm).
-convert_target("Asm", asm).
-convert_target("ASM", asm).
-convert_target("il", il).
-convert_target("IL", il).
-convert_target("c", c).
-convert_target("C", c).
-
- % XXX we should probably just convert to lower case and then
- % test against known strings.
-convert_foreign_language("C", c).
-convert_foreign_language("c", c).
-convert_foreign_language("MC++", managed_cplusplus).
-convert_foreign_language("mc++", managed_cplusplus).
-convert_foreign_language("Managed C++", managed_cplusplus).
-convert_foreign_language("ManagedC++", managed_cplusplus).
+:- pred convert_target_2(string::in, compilation_target::out) is semidet.
+convert_target_2("java", java).
+convert_target_2("asm", asm).
+convert_target_2("il", il).
+convert_target_2("c", c).
+
+convert_foreign_language(String, ForeignLanguage) :-
+ convert_foreign_language_2(string__to_lower(String), ForeignLanguage).
+
+:- pred convert_foreign_language_2(string::in, foreign_language::out)
+ is semidet.
+
+convert_foreign_language_2("c", c).
+convert_foreign_language_2("mc++", managed_cplusplus).
+convert_foreign_language_2("managedc++", managed_cplusplus).
+convert_foreign_language_2("c#", csharp).
+convert_foreign_language_2("csharp", csharp).
+convert_foreign_language_2("c sharp", csharp).
+
foreign_language_string(c) = "C".
foreign_language_string(managed_cplusplus) = "ManagedC++".
+foreign_language_string(csharp) = "C#".
+
+simple_foreign_language_string(c) = "c".
+simple_foreign_language_string(managed_cplusplus) = "cpp". % XXX mcpp is better
+simple_foreign_language_string(csharp) = "csharp".
convert_gc_method("none", none).
convert_gc_method("conservative", conservative).
Index: compiler/handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.106
diff -u -r1.106 handle_options.m
--- compiler/handle_options.m 2001/04/14 04:51:48 1.106
+++ compiler/handle_options.m 2001/04/30 13:50:33
@@ -648,8 +648,19 @@
{ Target = java },
{ BackendForeignLanguage = foreign_language_string(c) }
),
- globals__io_set_option(backend_foreign_language,
- string(BackendForeignLanguage)),
+
+ % only set the backend foreign language if it is unset
+ globals__io_lookup_string_option(backend_foreign_language,
+ CurrentBackendForeignLanguage),
+ (
+ { CurrentBackendForeignLanguage = "" }
+ ->
+ globals__io_set_option(backend_foreign_language,
+ string(BackendForeignLanguage))
+ ;
+ []
+ ),
+
% The default foreign language we use is the same as the backend.
globals__io_lookup_string_option(use_foreign_language,
UseForeignLanguage),
Index: compiler/ml_call_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_call_gen.m,v
retrieving revision 1.20
diff -u -r1.20 ml_call_gen.m
--- compiler/ml_call_gen.m 2001/02/20 07:52:17 1.20
+++ compiler/ml_call_gen.m 2001/04/30 13:50:33
@@ -143,7 +143,8 @@
% insert the `closure_arg' parameter
%
{ ClosureArgType = mlds__generic_type },
- { ClosureArg = data(var("closure_arg")) - ClosureArgType },
+ { ClosureArg = data(var(var_name("closure_arg", no))) -
+ ClosureArgType },
{ Params0 = mlds__func_params(ArgParams0, RetParam) },
{ Params = mlds__func_params([ClosureArg | ArgParams0], RetParam) },
{ Signature = mlds__get_func_signature(Params) },
@@ -203,10 +204,10 @@
% pointer types in casts.
%
ml_gen_info_new_conv_var(ConvVarNum),
- { string__format("func_%d", [i(ConvVarNum)],
- FuncVarName) },
- { FuncVarDecl = ml_gen_mlds_var_decl(var(FuncVarName), FuncType,
- mlds__make_context(Context)) },
+ { FuncVarName = var_name(
+ string__format("func_%d", [i(ConvVarNum)]), no) },
+ { FuncVarDecl = ml_gen_mlds_var_decl(var(FuncVarName),
+ FuncType, mlds__make_context(Context)) },
ml_gen_var_lval(FuncVarName, FuncType, FuncVarLval),
{ AssignFuncVar = ml_gen_assign(FuncVarLval, FuncRval, Context) },
{ FuncVarRval = lval(FuncVarLval) },
@@ -541,8 +542,8 @@
ml_gen_copy_args_to_locals_2([_|_], [], _, _, _) -->
{ error("ml_gen_copy_args_to_locals_2: list length mismatch") }.
-:- func ml_gen_arg_name(int) = string.
-ml_gen_arg_name(ArgNum) = ArgName :-
+:- func ml_gen_arg_name(int) = mlds__var_name.
+ml_gen_arg_name(ArgNum) = mlds__var_name(ArgName, no) :-
string__format("arg%d", [i(ArgNum)], ArgName).
%
@@ -786,8 +787,10 @@
% generate a declaration for the fresh variable
ml_gen_info_new_conv_var(ConvVarNum),
- { string__format("conv%d_%s", [i(ConvVarNum), s(VarName)],
- ArgVarName) },
+ { VarName = mlds__var_name(VarNameStr, MaybeNum) },
+ { ArgVarName = mlds__var_name(string__format(
+ "conv%d_%s", [i(ConvVarNum), s(VarNameStr)]),
+ MaybeNum) },
=(Info),
{ ml_gen_info_get_module_info(Info, ModuleInfo) },
{ ArgVarDecl = ml_gen_var_decl(ArgVarName, CalleeType,
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.82
diff -u -r1.82 ml_code_gen.m
--- compiler/ml_code_gen.m 2001/04/18 15:15:25 1.82
+++ compiler/ml_code_gen.m 2001/04/30 13:50:33
@@ -1166,7 +1166,9 @@
ByRefOutputVars = OutputVars
),
ml_gen_info_set_byref_output_vars(ByRefOutputVars,
- MLDSGenInfo0, MLDSGenInfo).
+ MLDSGenInfo0, MLDSGenInfo1),
+ ml_gen_info_set_value_output_vars(CopiedOutputVars,
+ MLDSGenInfo1, MLDSGenInfo).
% for model_non procedures,
% figure out which output variables are returned by
@@ -1192,6 +1194,7 @@
;
{ NondetCopiedOutputVars = [] }
),
+ ml_gen_info_set_value_output_vars(NondetCopiedOutputVars),
ml_gen_var_list(NondetCopiedOutputVars, OutputVarLvals),
ml_variable_types(NondetCopiedOutputVars, OutputVarTypes),
ml_initial_cont(OutputVarLvals, OutputVarTypes, InitialCont),
@@ -1610,8 +1613,9 @@
/* push nesting level */
{ MLDS_Context = mlds__make_context(Context) },
ml_gen_info_new_commit_label(CommitLabelNum),
- { string__format("commit_%d", [i(CommitLabelNum)],
- CommitRef) },
+ { CommitRef = mlds__var_name(
+ string__format("commit_%d", [i(CommitLabelNum)]),
+ no) },
ml_gen_var_lval(CommitRef, mlds__commit_type, CommitRefLval),
{ CommitRefDecl = ml_gen_commit_var_decl(MLDS_Context,
CommitRef) },
@@ -1695,8 +1699,9 @@
/* push nesting level */
{ MLDS_Context = mlds__make_context(Context) },
ml_gen_info_new_commit_label(CommitLabelNum),
- { string__format("commit_%d", [i(CommitLabelNum)],
- CommitRef) },
+ { CommitRef = mlds__var_name(
+ string__format("commit_%d", [i(CommitLabelNum)]),
+ no) },
ml_gen_var_lval(CommitRef, mlds__commit_type, CommitRefLval),
{ CommitRefDecl = ml_gen_commit_var_decl(MLDS_Context,
CommitRef) },
@@ -1890,7 +1895,9 @@
%
% Generate a declaration for a corresponding local variable.
- { string__append("local_", OutputVarName, LocalVarName) },
+ { OutputVarName = mlds__var_name(OutputVarNameStr, MaybeNum) },
+ { LocalVarName = mlds__var_name(
+ string__append("local_", OutputVarNameStr), MaybeNum) },
ml_gen_type(Type, MLDS_Type),
{ LocalVarDefn = ml_gen_mlds_var_decl(var(LocalVarName), MLDS_Type,
@@ -2017,7 +2024,7 @@
CodeModel, OuterContext, MLDS_Decls, MLDS_Statements) -->
(
{ PragmaImpl = ordinary(C_Code, _MaybeContext) },
- ml_gen_ordinary_pragma_c_code(CodeModel, Attributes,
+ ml_gen_ordinary_pragma_foreign_code(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
C_Code, OuterContext, MLDS_Decls, MLDS_Statements)
;
@@ -2034,7 +2041,7 @@
{ PragmaImpl = import(Name, HandleReturn, Vars, _Context) },
{ C_Code = string__append_list([HandleReturn, " ",
Name, "(", Vars, ");"]) },
- ml_gen_ordinary_pragma_c_code(CodeModel, Attributes,
+ ml_gen_ordinary_pragma_foreign_code(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
C_Code, OuterContext, MLDS_Decls, MLDS_Statements)
).
@@ -2043,6 +2050,12 @@
% these should have been expanded out by now
{ error("ml_gen_goal_expr: unexpected shorthand") }.
+% :- module ml_foreign.
+%
+% ml_foreign creates MLDS code to execute foreign language code.
+%
+%
+
:- pred ml_gen_nondet_pragma_c_code(code_model, pragma_foreign_proc_attributes,
pred_id, proc_id, list(prog_var),
list(maybe(pair(string, mode))), list(prog_type), prog_context,
@@ -2225,10 +2238,10 @@
raw_target_code(HashUndefs),
raw_target_code("}\n")
] },
- { Starting_C_Code_Stmt = target_code(lang_C, Starting_C_Code) },
+ { Starting_C_Code_Stmt = inline_target_code(lang_C, Starting_C_Code) },
{ Starting_C_Code_Statement = mlds__statement(
atomic(Starting_C_Code_Stmt), mlds__make_context(Context)) },
- { Ending_C_Code_Stmt = target_code(lang_C, Ending_C_Code) },
+ { Ending_C_Code_Stmt = inline_target_code(lang_C, Ending_C_Code) },
{ Ending_C_Code_Statement = mlds__statement(
atomic(Ending_C_Code_Stmt), mlds__make_context(Context)) },
{ MLDS_Statements = list__condense([
@@ -2239,6 +2252,63 @@
]) },
{ MLDS_Decls = ConvDecls }.
+:- pred ml_gen_ordinary_pragma_foreign_code(code_model,
+ pragma_foreign_proc_attributes,
+ pred_id, proc_id, list(prog_var),
+ list(maybe(pair(string, mode))), list(prog_type),
+ string, prog_context,
+ mlds__defns, mlds__statements, ml_gen_info, ml_gen_info).
+:- mode ml_gen_ordinary_pragma_foreign_code(in, in, in, in, in, in,
+ in, in, in, out, out, in, out) is det.
+
+ml_gen_ordinary_pragma_foreign_code(CodeModel, Attributes,
+ PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ Foreign_Code, Context, MLDS_Decls, MLDS_Statements) -->
+ { foreign_language(Attributes, Lang) },
+ ( { Lang = c },
+ ml_gen_ordinary_pragma_c_code(CodeModel, Attributes,
+ PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
+ ; { Lang = managed_cplusplus },
+ ml_gen_ordinary_pragma_c_code(CodeModel, Attributes,
+ PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
+ ; { Lang = csharp },
+ ml_gen_ordinary_pragma_csharp_code(CodeModel, Attributes,
+ PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
+ ).
+
+:- pred ml_gen_ordinary_pragma_csharp_code(code_model,
+ pragma_foreign_proc_attributes,
+ pred_id, proc_id, list(prog_var),
+ list(maybe(pair(string, mode))), list(prog_type),
+ string, prog_context,
+ mlds__defns, mlds__statements, ml_gen_info, ml_gen_info).
+:- mode ml_gen_ordinary_pragma_csharp_code(in, in, in, in, in, in,
+ in, in, in, out, out, in, out) is det.
+
+ % For ordinary (not model_non) pragma foreign_code in C#,
+ % we generate a call to an out-of-line procedure that contains
+ % the user's code.
+
+ml_gen_ordinary_pragma_csharp_code(_CodeModel, Attributes,
+ _PredId, _ProcId, _ArgVars, _ArgDatas, _OrigArgTypes,
+ ForeignCode, Context, MLDS_Decls, MLDS_Statements) -->
+ { foreign_language(Attributes, ForeignLang) },
+ { MLDSContext = mlds__make_context(Context) },
+ =(MLDSGenInfo),
+ { ml_gen_info_get_value_output_vars(MLDSGenInfo, OutputVars) },
+ ml_gen_var_list(OutputVars, OutputVarLvals),
+ { OutlineStmt = outline_target_code(ForeignLang, OutputVarLvals,
+ ForeignCode) },
+
+ { MLDS_Statements = [
+ mlds__statement(atomic(OutlineStmt), MLDSContext)
+ ] },
+ { MLDS_Decls = [] }.
+
+
:- pred ml_gen_ordinary_pragma_c_code(code_model,
pragma_foreign_proc_attributes,
pred_id, proc_id, list(prog_var),
@@ -2389,8 +2459,8 @@
;
{ error("ml_gen_ordinary_pragma_c_code: unexpected code model") }
),
- { Starting_C_Code_Stmt = target_code(lang_C, Starting_C_Code) },
- { Ending_C_Code_Stmt = target_code(lang_C, Ending_C_Code) },
+ { Starting_C_Code_Stmt = inline_target_code(lang_C, Starting_C_Code) },
+ { Ending_C_Code_Stmt = inline_target_code(lang_C, Ending_C_Code) },
{ Starting_C_Code_Statement = mlds__statement(
atomic(Starting_C_Code_Stmt), mlds__make_context(Context)) },
{ Ending_C_Code_Statement = mlds__statement(atomic(Ending_C_Code_Stmt),
@@ -2646,7 +2716,8 @@
->
ml_variable_type(Var, VarType),
ml_gen_var(Var, VarLval),
- ml_gen_box_or_unbox_lval(VarType, OrigType, VarLval, ArgName,
+ ml_gen_box_or_unbox_lval(VarType, OrigType, VarLval,
+ mlds__var_name(ArgName, no),
Context, ArgLval, ConvDecls, _ConvInputStatements,
ConvOutputStatements),
{ module_info_globals(ModuleInfo, Globals) },
@@ -2691,6 +2762,8 @@
{ ConvDecls = [] },
{ ConvOutputStatements = [] }
).
+
+% :- end_module ml_foreign.
%-----------------------------------------------------------------------------%
%
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.33
diff -u -r1.33 ml_code_util.m
--- compiler/ml_code_util.m 2001/02/20 07:52:17 1.33
+++ compiler/ml_code_util.m 2001/04/30 13:50:33
@@ -121,7 +121,7 @@
% Generate the function prototype for a procedure with the
% given argument types, modes, and code model.
%
-:- func ml_gen_params(module_info, list(string), list(prog_type),
+:- func ml_gen_params(module_info, list(mlds__var_name), list(prog_type),
list(mode), pred_or_func, code_model) = mlds__func_params.
% Given a list of variables and their corresponding modes,
@@ -251,6 +251,10 @@
% of a class.
%
:- func ml_gen_public_field_decl_flags = mlds__decl_flags.
+
+ % Apply the usual %s_%d formatting to a MLDS variable name.
+:- func ml_var_name_to_string(mlds__var_name) = string.
+
%-----------------------------------------------------------------------------%
%
% Routines for dealing with static constants
@@ -495,6 +499,13 @@
ml_gen_info, ml_gen_info).
:- mode ml_gen_info_set_byref_output_vars(in, in, out) is det.
+:- pred ml_gen_info_get_value_output_vars(ml_gen_info, list(prog_var)).
+:- mode ml_gen_info_get_value_output_vars(in, out) is det.
+
+:- pred ml_gen_info_set_value_output_vars(list(prog_var),
+ ml_gen_info, ml_gen_info).
+:- mode ml_gen_info_set_value_output_vars(in, in, out) is det.
+
:- pred ml_gen_info_get_globals(globals, ml_gen_info, ml_gen_info).
:- mode ml_gen_info_get_globals(out, in, out) is det.
@@ -963,7 +974,7 @@
FuncParams = ml_gen_params_base(ModuleInfo, HeadVarNames,
HeadTypes, ArgModes, PredOrFunc, CodeModel).
-:- func ml_gen_params_base(module_info, list(string), list(prog_type),
+:- func ml_gen_params_base(module_info, list(mlds__var_name), list(prog_type),
list(arg_mode), pred_or_func, code_model) = mlds__func_params.
ml_gen_params_base(ModuleInfo, HeadVarNames, HeadTypes, HeadModes,
@@ -1017,10 +1028,10 @@
ContType = mlds__cont_type([]),
RetTypes = RetTypes0
),
- ContName = data(var("cont")),
+ ContName = data(var(var_name("cont", no))),
ContArg = ContName - ContType,
ContEnvType = mlds__generic_env_ptr_type,
- ContEnvName = data(var("cont_env_ptr")),
+ ContEnvName = data(var(var_name("cont_env_ptr", no))),
ContEnvArg = ContEnvName - ContEnvType,
globals__lookup_bool_option(Globals, gcc_nested_functions,
NestedFunctions),
@@ -1289,7 +1300,8 @@
{ mercury_private_builtin_module(PrivateBuiltin) },
{ MLDS_Module = mercury_module_name_to_mlds(PrivateBuiltin) },
ml_gen_type(Type, MLDS_Type),
- { Lval = var(qual(MLDS_Module, "dummy_var"), MLDS_Type) }
+ { Lval = var(qual(MLDS_Module, var_name("dummy_var", no)),
+ MLDS_Type) }
;
=(MLDSGenInfo),
{ ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
@@ -1330,7 +1342,7 @@
ml_gen_var_name(VarSet, Var) = UniqueVarName :-
varset__lookup_name(VarSet, Var, VarName),
term__var_to_int(Var, VarNumber),
- string__format("%s_%d", [s(VarName), i(VarNumber)], UniqueVarName).
+ UniqueVarName = mlds__var_name(VarName, yes(VarNumber)).
% Generate a name for a local static constant.
%
@@ -1344,8 +1356,9 @@
{ ml_gen_info_get_proc_id(MLDSGenInfo, ProcId) },
{ pred_id_to_int(PredId, PredIdNum) },
{ proc_id_to_int(ProcId, ProcIdNum) },
- { string__format("const_%d_%d_%d_%s", [i(PredIdNum), i(ProcIdNum),
- i(SequenceNum), s(BaseName)], ConstName) }.
+ { ConstName = mlds__var_name(
+ string__format("const_%d_%d_%d_%s", [i(PredIdNum),
+ i(ProcIdNum), i(SequenceNum), s(BaseName)]), no) }.
% Qualify the name of the specified variable
% with the current module name.
@@ -1425,6 +1438,11 @@
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
Virtuality, Finality, Constness, Abstractness).
+ml_var_name_to_string(var_name(Var, yes(Num))) =
+ string__format("%s_%d", [s(Var), i(Num)]).
+ml_var_name_to_string(var_name(Var, no)) = Var.
+
+
%-----------------------------------------------------------------------------%
%
% Code for dealing with fields
@@ -1515,13 +1533,15 @@
% Generate the declaration for the built-in `succeeded' variable.
%
ml_gen_succeeded_var_decl(Context) =
- ml_gen_mlds_var_decl(var("succeeded"), mlds__native_bool_type, Context).
+ ml_gen_mlds_var_decl(var(var_name("succeeded", no)),
+ mlds__native_bool_type, Context).
% Return the lval for the `succeeded' flag.
% (`succeeded' is a boolean variable used to record
% the success or failure of model_semi procedures.)
ml_success_lval(SucceededLval) -->
- ml_gen_var_lval("succeeded", mlds__native_bool_type, SucceededLval).
+ ml_gen_var_lval(var_name("succeeded", no),
+ mlds__native_bool_type, SucceededLval).
% Return an rval which will test the value of the `succeeded' flag.
% (`succeeded' is a boolean variable used to record
@@ -1542,9 +1562,10 @@
% Generate the name for the specified `cond_<N>' variable.
%
-:- func ml_gen_cond_var_name(cond_seq) = string.
+:- func ml_gen_cond_var_name(cond_seq) = mlds__var_name.
ml_gen_cond_var_name(CondVar) =
- string__append("cond_", string__int_to_string(CondVar)).
+ mlds__var_name(string__append("cond_", string__int_to_string(CondVar)),
+ no).
ml_gen_cond_var_decl(CondVar, Context) =
ml_gen_mlds_var_decl(var(ml_gen_cond_var_name(CondVar)),
@@ -1572,9 +1593,10 @@
% We expect OutputVarlvals0 and OutputVarTypes0 to be empty if
% `--nondet-copy-out' is not enabled.
%
- ml_gen_var_lval("cont", mlds__cont_type(MLDS_OutputVarTypes), ContLval),
- ml_gen_var_lval("cont_env_ptr", mlds__generic_env_ptr_type,
- ContEnvLval),
+ ml_gen_var_lval(mlds__var_name("cont", no),
+ mlds__cont_type(MLDS_OutputVarTypes), ContLval),
+ ml_gen_var_lval(mlds__var_name("cont_env_ptr", no),
+ mlds__generic_env_ptr_type, ContEnvLval),
{ Cont = success_cont(lval(ContLval), lval(ContEnvLval),
MLDS_OutputVarTypes, OutputVarLvals) }.
@@ -1676,10 +1698,11 @@
),
InnerArgs0) },
{ InnerFuncArgType = mlds__cont_type(ArgTypes0) },
- { InnerFuncRval = lval(var(qual(MLDS_Module, "passed_cont"),
+ { PassedContVarName = mlds__var_name("passed_cont", no) },
+ { InnerFuncRval = lval(var(qual(MLDS_Module, PassedContVarName),
InnerFuncArgType)) },
{ InnerFuncParams = func_params(
- [data(var("passed_cont")) - InnerFuncArgType | InnerArgs0],
+ [data(var(PassedContVarName)) - InnerFuncArgType | InnerArgs0],
Rets) },
{ InnerMLDS_Stmt = call(Signature, InnerFuncRval, ObjectRval,
@@ -1727,12 +1750,13 @@
% is `mlds__unknown_type'.
%
ml_get_env_ptr(lval(EnvPtrLval)) -->
- ml_gen_var_lval("env_ptr", mlds__unknown_type, EnvPtrLval).
+ ml_gen_var_lval(mlds__var_name("env_ptr", no),
+ mlds__unknown_type, EnvPtrLval).
% Return an rval for a pointer to the current environment
% (the set of local variables in the containing procedure).
ml_declare_env_ptr_arg(Name - mlds__generic_env_ptr_type) -->
- { Name = data(var("env_ptr_arg")) }.
+ { Name = data(var(mlds__var_name("env_ptr_arg", no))) }.
%-----------------------------------------------------------------------------%
%
@@ -1763,6 +1787,8 @@
byref_output_vars :: list(prog_var),
% output arguments that are passed by
% reference
+ value_output_vars :: list(prog_var),
+ % output arguments that are returned as values
%
% these fields get updated as we traverse
@@ -1799,6 +1825,7 @@
proc_info_argmodes(ProcInfo, HeadModes),
ByRefOutputVars = select_output_vars(ModuleInfo, HeadVars, HeadModes,
VarTypes),
+ ValueOutputVars = [],
LabelCounter = 0,
FuncLabelCounter = 0,
@@ -1818,6 +1845,7 @@
VarSet,
VarTypes,
ByRefOutputVars,
+ ValueOutputVars,
LabelCounter,
FuncLabelCounter,
CommitLabelCounter,
@@ -1841,8 +1869,11 @@
ml_gen_info_get_varset(Info, Info^varset).
ml_gen_info_get_var_types(Info, Info^var_types).
ml_gen_info_get_byref_output_vars(Info, Info^byref_output_vars).
+ml_gen_info_get_value_output_vars(Info, Info^value_output_vars).
ml_gen_info_set_byref_output_vars(OutputVars, Info,
Info^byref_output_vars := OutputVars).
+ml_gen_info_set_value_output_vars(OutputVars, Info,
+ Info^value_output_vars := OutputVars).
ml_gen_info_use_gcc_nested_functions(UseNestedFuncs) -->
ml_gen_info_get_globals(Globals),
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.23
diff -u -r1.23 ml_elim_nested.m
--- compiler/ml_elim_nested.m 2001/02/26 06:19:30 1.23
+++ compiler/ml_elim_nested.m 2001/04/30 14:05:49
@@ -326,10 +326,12 @@
%
QualVarName = qual(ModuleName, VarName),
EnvModuleName = ml_env_module_name(ClassType),
- FieldName = named_field(qual(EnvModuleName, VarName),
+ FieldNameString = ml_var_name_to_string(VarName),
+ FieldName = named_field(qual(EnvModuleName, FieldNameString),
EnvPtrTypeName),
Tag = yes(0),
- EnvPtr = lval(var(qual(ModuleName, "env_ptr"),
+ EnvPtr = lval(var(qual(ModuleName,
+ mlds__var_name("env_ptr", no)),
EnvPtrTypeName)),
EnvArgLval = field(Tag, EnvPtr, FieldName, FieldType,
EnvPtrTypeName),
@@ -386,7 +388,7 @@
%
% struct <EnvClassName> env;
%
- EnvVarName = data(var("env")),
+ EnvVarName = data(var(var_name("env", no))),
EnvVarFlags = ml_gen_local_var_decl_flags,
EnvVarDefnBody = mlds__data(EnvTypeName, no_initializer),
EnvVarDecl = mlds__defn(EnvVarName, Context, EnvVarFlags,
@@ -396,7 +398,7 @@
% declare the `env_ptr' var, and
% initialize the `env_ptr' with the address of `env'
%
- EnvVar = qual(ModuleName, "env"),
+ EnvVar = qual(ModuleName, mlds__var_name("env", no)),
globals__get_target(Globals, Target),
% IL uses classes instead of structs, so the code
% generated needs to be a little different.
@@ -464,10 +466,12 @@
Defn0 = mlds__defn(Name, Context, Flags, DefnBody0),
(
DefnBody0 = mlds__function(PredProcId, Params, yes(FuncBody0)),
- statement_contains_var(FuncBody0, qual(ModuleName, "env_ptr"))
+ statement_contains_var(FuncBody0, qual(ModuleName,
+ mlds__var_name("env_ptr", no)))
->
- EnvPtrVal = lval(var(qual(ModuleName, "env_ptr_arg"),
- mlds__generic_env_ptr_type)),
+ EnvPtrVal = lval(var(qual(ModuleName,
+ mlds__var_name("env_ptr_arg", no)),
+ mlds__generic_env_ptr_type)),
ml_init_env(TypeName, EnvPtrVal, Context, ModuleName, Globals,
EnvPtrDecl, InitEnvPtr),
FuncBody = mlds__statement(block([EnvPtrDecl],
@@ -497,7 +501,7 @@
%
% <EnvTypeName> *env_ptr;
%
- EnvPtrVarName = data(var("env_ptr")),
+ EnvPtrVarName = data(var(mlds__var_name("env_ptr", no))),
EnvPtrVarFlags = ml_gen_local_var_decl_flags,
globals__get_target(Globals, Target),
% IL uses classes instead of structs, so the type
@@ -520,7 +524,7 @@
%
%
- EnvPtrVar = qual(ModuleName, "env_ptr"),
+ EnvPtrVar = qual(ModuleName, mlds__var_name("env_ptr", no)),
AssignEnvPtr = assign(var(EnvPtrVar, EnvPtrVarType),
unop(cast(EnvPtrVarType), EnvPtrVal)),
InitEnvPtr = mlds__statement(atomic(AssignEnvPtr), Context).
@@ -925,10 +929,12 @@
fixup_rval(Rval0, Rval).
fixup_atomic_stmt(trail_op(TrailOp0), trail_op(TrailOp)) -->
fixup_trail_op(TrailOp0, TrailOp).
-fixup_atomic_stmt(target_code(Lang, Components0),
- target_code(Lang, Components)) -->
+fixup_atomic_stmt(inline_target_code(Lang, Components0),
+ inline_target_code(Lang, Components)) -->
list__map_foldl(fixup_target_code_component,
Components0, Components).
+fixup_atomic_stmt(outline_target_code(Lang, Lvals, Code),
+ outline_target_code(Lang, Lvals, Code)) --> [].
:- pred fixup_case_cond(mlds__case_match_cond, mlds__case_match_cond,
elim_info, elim_info).
@@ -1053,10 +1059,12 @@
),
solutions(IsLocalVar, [FieldType])
->
- EnvPtr = lval(var(qual(ModuleName, "env_ptr"),
+ EnvPtr = lval(var(qual(ModuleName,
+ mlds__var_name("env_ptr", no)),
EnvPtrVarType)),
EnvModuleName = ml_env_module_name(ClassType),
- FieldName = named_field(qual(EnvModuleName, ThisVarName),
+ ThisVarFieldName = ml_var_name_to_string(ThisVarName),
+ FieldName = named_field(qual(EnvModuleName, ThisVarFieldName),
EnvPtrVarType),
Tag = yes(0),
Lval = field(Tag, EnvPtr, FieldName, FieldType, ClassType)
@@ -1427,7 +1435,7 @@
rval_contains_var(Rval, Name).
atomic_stmt_contains_var(trail_op(TrailOp), Name) :-
trail_op_contains_var(TrailOp, Name).
-atomic_stmt_contains_var(target_code(_Lang, Components), Name) :-
+atomic_stmt_contains_var(inline_target_code(_Lang, Components), Name) :-
list__member(Component, Components),
target_code_component_contains_var(Component, Name).
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.7
diff -u -r1.7 ml_optimize.m
--- compiler/ml_optimize.m 2001/02/20 07:52:18 1.7
+++ compiler/ml_optimize.m 2001/04/30 13:50:33
@@ -264,7 +264,9 @@
% value of a parameter after it has already been
% clobbered by the new value.
- string__append(VarName, "__tmp_copy", TempName),
+ VarName = mlds__var_name(VarNameStr, MaybeNum),
+ TempName = mlds__var_name(VarNameStr ++ "__tmp_copy",
+ MaybeNum),
QualTempName = qual(OptInfo ^ module_name,
TempName),
Initializer = init_obj(Arg),
Index: compiler/ml_string_switch.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_string_switch.m,v
retrieving revision 1.5
diff -u -r1.5 ml_string_switch.m
--- compiler/ml_string_switch.m 2001/02/20 07:52:18 1.5
+++ compiler/ml_string_switch.m 2001/04/30 13:50:33
@@ -54,13 +54,15 @@
% MR_String str;
%
ml_gen_info_new_cond_var(SlotVarSeq),
- { SlotVarName = string__format("slot_%d", [i(SlotVarSeq)]) },
+ { SlotVarName = mlds__var_name(
+ string__format("slot_%d", [i(SlotVarSeq)]), no) },
{ SlotVarDefn = ml_gen_mlds_var_decl(var(SlotVarName),
mlds__native_int_type, MLDS_Context) },
ml_gen_var_lval(SlotVarName, mlds__native_int_type, SlotVarLval),
ml_gen_info_new_cond_var(StringVarSeq),
- { StringVarName = string__format("str_%d", [i(StringVarSeq)]) },
+ { StringVarName = mlds__var_name(
+ string__format("str_%d", [i(StringVarSeq)]), no) },
{ StringVarDefn = ml_gen_mlds_var_decl(var(StringVarName),
ml_string_type, MLDS_Context) },
ml_gen_var_lval(StringVarName, ml_string_type, StringVarLval),
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.5
diff -u -r1.5 ml_type_gen.m
--- compiler/ml_type_gen.m 2001/02/20 07:52:17 1.5
+++ compiler/ml_type_gen.m 2001/04/30 13:50:33
@@ -162,7 +162,7 @@
:- func ml_gen_enum_value_member(prog_context) = mlds__defn.
ml_gen_enum_value_member(Context) =
- mlds__defn(data(var("value")),
+ mlds__defn(data(var(mlds__var_name("value", no))),
mlds__make_context(Context),
ml_gen_member_decl_flags,
mlds__data(mlds__native_int_type, no_initializer)).
@@ -189,7 +189,7 @@
% generate an MLDS definition for this enumeration constant.
%
unqualify_name(Name, UnqualifiedName),
- MLDS_Defn = mlds__defn(data(var(UnqualifiedName)),
+ MLDS_Defn = mlds__defn(data(var(mlds__var_name(UnqualifiedName, no))),
mlds__make_context(Context),
ml_gen_enum_constant_decl_flags,
mlds__data(mlds__native_int_type, init_obj(ConstValue))).
@@ -345,9 +345,9 @@
%
% Generate the declaration for the field that holds the secondary tag.
%
-:- func ml_gen_tag_member(mlds__var_name, prog_context) = mlds__defn.
+:- func ml_gen_tag_member(string, prog_context) = mlds__defn.
ml_gen_tag_member(Name, Context) =
- mlds__defn(data(var(Name)),
+ mlds__defn(data(var(mlds__var_name(Name, no))),
mlds__make_context(Context),
ml_gen_member_decl_flags,
mlds__data(mlds__native_int_type, no_initializer)).
@@ -371,7 +371,8 @@
Ctor = ctor(_ExistQTVars, _Constraints, Name, _Args),
unqualify_name(Name, UnqualifiedName),
ConstValue = const(int_const(SecondaryTag)),
- MLDS_Defn = mlds__defn(data(var(UnqualifiedName)),
+ MLDS_Defn = mlds__defn(data(var(mlds__var_name(
+ UnqualifiedName, no))),
mlds__make_context(Context),
ml_gen_enum_constant_decl_flags,
mlds__data(mlds__native_int_type,
@@ -543,8 +544,8 @@
MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type)
),
FieldName = ml_gen_field_name(MaybeFieldName, ArgNum0),
- MLDS_Defn = ml_gen_mlds_field_decl(var(FieldName), MLDS_Type,
- mlds__make_context(Context)),
+ MLDS_Defn = ml_gen_mlds_field_decl(var(mlds__var_name(FieldName, no)),
+ MLDS_Type, mlds__make_context(Context)),
ArgNum = ArgNum0 + 1.
Index: compiler/ml_unify_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_unify_gen.m,v
retrieving revision 1.32
diff -u -r1.32 ml_unify_gen.m
--- compiler/ml_unify_gen.m 2001/03/13 12:40:16 1.32
+++ compiler/ml_unify_gen.m 2001/04/30 13:50:33
@@ -619,7 +619,8 @@
% then insert the `closure_arg' parameter
{ ClosureArgType = mlds__generic_type },
- { ClosureArg = data(var("closure_arg")) - ClosureArgType },
+ { ClosureArg = data(var(
+ var_name("closure_arg", no))) - ClosureArgType },
{ WrapperParams0 = mlds__func_params(WrapperArgs0, WrapperRetType) },
{ WrapperParams = mlds__func_params([ClosureArg | WrapperArgs0],
WrapperRetType) },
@@ -643,8 +644,8 @@
% #endif
% closure = closure_arg;
%
- { ClosureName = "closure" },
- { ClosureArgName = "closure_arg" },
+ { ClosureName = mlds__var_name("closure", no) },
+ { ClosureArgName = mlds__var_name("closure_arg", no) },
{ MLDS_Context = mlds__make_context(Context) },
{ ClosureType = mlds__generic_type },
{ ClosureDecl = ml_gen_mlds_var_decl(var(ClosureName),
@@ -747,14 +748,14 @@
{ WrapperFuncType = mlds__func_type(WrapperParams) },
ml_gen_info_add_extra_defn(WrapperFunc).
-:- func ml_gen_wrapper_head_var_names(int, int) = list(string).
+:- func ml_gen_wrapper_head_var_names(int, int) = list(mlds__var_name).
ml_gen_wrapper_head_var_names(Num, Max) = Names :-
( Num > Max ->
Names = []
;
Name = string__format("wrapper_arg_%d", [i(Num)]),
Names1 = ml_gen_wrapper_head_var_names(Num + 1, Max),
- Names = [Name | Names1]
+ Names = [mlds__var_name(Name, no) | Names1]
).
% ml_gen_wrapper_arg_lvals(HeadVarNames, Types, ArgModes,
@@ -1157,9 +1158,8 @@
{ ml_gen_info_get_proc_id(MLDSGenInfo, ProcId) },
{ pred_id_to_int(PredId, PredIdNum) },
{ proc_id_to_int(ProcId, ProcIdNum) },
- { string__format("float_%d_%d_%d",
- [i(PredIdNum), i(ProcIdNum), i(SequenceNum)],
- ConstName) },
+ { ConstName = mlds__var_name(string__format("float_%d_%d_%d",
+ [i(PredIdNum), i(ProcIdNum), i(SequenceNum)]), no) },
{ Initializer = init_obj(Rval) },
{ ConstDefn = ml_gen_static_const_defn(ConstName, Type,
Initializer, Context) },
@@ -1202,7 +1202,8 @@
=(MLDSGenInfo),
{ ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
{ VarName = ml_gen_var_name(VarSet, Var) },
- ml_format_static_const_name(VarName, SequenceNum, ConstName).
+ ml_format_static_const_name(ml_var_name_to_string(VarName),
+ SequenceNum, ConstName).
:- pred ml_lookup_static_const_name(prog_var, mlds__var_name,
ml_gen_info, ml_gen_info).
@@ -1212,7 +1213,8 @@
=(MLDSGenInfo),
{ ml_gen_info_get_varset(MLDSGenInfo, VarSet) },
{ VarName = ml_gen_var_name(VarSet, Var) },
- ml_format_static_const_name(VarName, SequenceNum, ConstName).
+ ml_format_static_const_name(ml_var_name_to_string(VarName),
+ SequenceNum, ConstName).
% Generate an rval containing the address of the local static constant
% for a given variable.
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.7
diff -u -r1.7 ml_util.m
--- compiler/ml_util.m 2001/02/20 07:52:15 1.7
+++ compiler/ml_util.m 2001/04/30 13:50:33
@@ -16,6 +16,7 @@
:- import_module mlds.
:- import_module list, std_util.
+:- import_module prog_data. % for foreign_language
%-----------------------------------------------------------------------------%
% succeeds iff the definitions contain the entry point to
@@ -46,18 +47,31 @@
:- pred stmt_contains_statement(mlds__stmt, mlds__statement).
:- mode stmt_contains_statement(in, out) is nondet.
+:- pred has_foreign_languages(mlds__statement, list(foreign_language)).
+:- mode has_foreign_languages(in, out) is det.
+
%-----------------------------------------------------------------------------%
%
% routines that deal with definitions
%
% defn_contains_foreign_code(NativeTargetLang, Defn):
- % Succeeds iff this definition contains target_code
- % statements in a target language other than the
- % specified native target language.
+ % Succeeds iff this definition contains outline_target_code
+ % statements, or inline_target_code statements in a target
+ % language other than the specified native target language.
+ % XXX perhaps we should eliminate the need to check for
+ % inline_target_code, because it shouldn't be generated
+ % with target language different to the native target
+ % language in the long run.
:- pred defn_contains_foreign_code(target_lang, mlds__defn).
:- mode defn_contains_foreign_code(in, in) is semidet.
+ % defn_contains_foreign_code(ForeignLang, Defn):
+ % Succeeds iff this definition contains outline_target_code
+ % statements for the given foreign language.
+:- pred defn_contains_outline_foreign_code(foreign_language, mlds__defn).
+:- mode defn_contains_outline_foreign_code(in, in) is semidet.
+
% Succeeds iff this definition is a type definition.
:- pred defn_is_type(mlds__defn).
:- mode defn_is_type(in) is semidet.
@@ -250,6 +264,14 @@
default_contains_statement(default_case(Statement), SubStatement) :-
statement_contains_statement(Statement, SubStatement).
+has_foreign_languages(Statement, Langs) :-
+ GetTargetCode = (pred(Lang::out) is nondet :-
+ statement_contains_statement(Statement, SubStatement),
+ SubStatement = statement(atomic(
+ outline_target_code(Lang, _, _)), _)
+ ),
+ solutions(GetTargetCode, Langs).
+
%-----------------------------------------------------------------------------%
%
% routines that deal with definitions
@@ -259,9 +281,22 @@
Defn = mlds__defn(_Name, _Context, _Flags, Body),
Body = function(_, _, yes(FunctionBody)),
statement_contains_statement(FunctionBody, Statement),
+ Statement = mlds__statement(Stmt, _),
+ (
+ Stmt = atomic(inline_target_code(TargetLang, _)),
+ TargetLang \= NativeTargetLang
+ ;
+ Stmt = atomic(outline_target_code(_, _, _))
+ ).
+
+defn_contains_outline_foreign_code(ForeignLang, Defn) :-
+ Defn = mlds__defn(_Name, _Context, _Flags, Body),
+ Body = function(_, _, yes(FunctionBody)),
+ statement_contains_statement(FunctionBody, Statement),
Statement = mlds__statement(Stmt, _),
- Stmt = atomic(target_code(TargetLang, _)),
- TargetLang \= NativeTargetLang.
+ (
+ Stmt = atomic(outline_target_code(ForeignLang, _, _))
+ ).
defn_is_type(Defn) :-
Defn = mlds__defn(Name, _Context, _Flags, _Body),
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.49
diff -u -r1.49 mlds.m
--- compiler/mlds.m 2001/02/28 15:59:18 1.49
+++ compiler/mlds.m 2001/04/30 13:50:33
@@ -1011,7 +1011,6 @@
; mark_hp(mlds__lval)
% Tell the heap sub-system to store a marker
% (for later use in restore_hp/1 instructions)
- % in the specified lval
%
% It's OK for the target to treat this as a no-op,
% and probably that is what most targets will do.
@@ -1034,12 +1033,31 @@
% foreign language interfacing
%
- ; target_code(target_lang, list(target_code_component))
+ ; inline_target_code(target_lang, list(target_code_component))
% Do whatever is specified by the
% target_code_components, which can be any piece
% of code in the specified target language (C,
% assembler, or whatever) that does not have any
% non-local flow of control.
+ % This is implemented by embedding the target
+ % code in the output stream of instructions or
+ % statements.
+ ; outline_target_code(
+ foreign_language,
+ % the foreign language of this code
+ list(mlds__lval),
+ % where to store return value(s)
+ string
+ % the user's foreign language code
+ )
+ % Do whatever is specified by the string, which
+ % can be any piece of code in the specified
+ % foreign language (C#, managed C++, or
+ % whatever).
+ % This is implemented by calling an externally
+ % defined function, which the backend must
+ % generate the definition for (in some other
+ % file perhaps) and calling it.
.
%
@@ -1125,7 +1143,10 @@
% An mlds__var represents a variable or constant.
%
:- type mlds__var == mlds__fully_qualified_name(mlds__var_name).
-:- type mlds__var_name == string.
+:- type mlds__var_name --->
+ mlds__var_name(string, maybe(int)).
+ % var name and perhaps a unique number to be added as a
+ % suffix where necessary.
%
% An lval represents a data location or variable that can be used
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.84
diff -u -r1.84 mlds_to_c.m
--- compiler/mlds_to_c.m 2001/04/11 10:10:13 1.84
+++ compiler/mlds_to_c.m 2001/04/30 13:50:34
@@ -96,37 +96,13 @@
module_name_to_file_name(ModuleSymName, ".h.tmp", yes, TmpHeaderFile),
module_name_to_file_name(ModuleSymName, ".h", yes, HeaderFile),
{ Indent = 0 },
- mlds_output_to_file(SourceFile, mlds_output_src_file(Indent, MLDS)),
- mlds_output_to_file(TmpHeaderFile, mlds_output_hdr_file(Indent, MLDS)),
+ output_to_file(SourceFile, mlds_output_src_file(Indent, MLDS)),
+ output_to_file(TmpHeaderFile, mlds_output_hdr_file(Indent, MLDS)),
update_interface(HeaderFile).
%
% XXX at some point we should also handle output of any non-C
% foreign code (Ada, Fortran, etc.) to appropriate files.
-:- pred mlds_output_to_file(string, pred(io__state, io__state),
- io__state, io__state).
-:- mode mlds_output_to_file(in, pred(di, uo) is det, di, uo) is det.
-
-mlds_output_to_file(FileName, Action) -->
- globals__io_lookup_bool_option(verbose, Verbose),
- globals__io_lookup_bool_option(statistics, Stats),
- maybe_write_string(Verbose, "% Writing to file `"),
- maybe_write_string(Verbose, FileName),
- maybe_write_string(Verbose, "'...\n"),
- maybe_flush_output(Verbose),
- io__tell(FileName, Res),
- ( { Res = ok } ->
- Action,
- io__told,
- maybe_write_string(Verbose, "% done.\n"),
- maybe_report_stats(Stats)
- ;
- maybe_write_string(Verbose, "\n"),
- { string__append_list(["can't open file `",
- FileName, "' for output."], ErrorMessage) },
- report_error(ErrorMessage)
- ).
-
%
% Generate the header file
%
@@ -561,6 +537,8 @@
io__write_string(Code).
mlds_output_c_defn(_Indent, user_foreign_code(managed_cplusplus, _, _)) -->
{ sorry(this_file, "foreign code other than C") }.
+mlds_output_c_defn(_Indent, user_foreign_code(csharp, _, _)) -->
+ { sorry(this_file, "foreign code other than C") }.
:- pred mlds_output_pragma_export_decl(mlds_module_name, indent,
mlds__pragma_export, io__state, io__state).
@@ -1035,7 +1013,8 @@
:- mode mlds_make_base_class(in, in, out, in, out) is det.
mlds_make_base_class(Context, ClassId, MLDS_Defn, BaseNum0, BaseNum) :-
- BaseName = string__format("base_%d", [i(BaseNum0)]),
+ BaseName = mlds__var_name(string__format("base_%d", [i(BaseNum0)]),
+ no),
Type = ClassId,
MLDS_Defn = mlds__defn(data(var(BaseName)), Context,
ml_gen_public_field_decl_flags, data(Type, no_initializer)),
@@ -1475,7 +1454,7 @@
:- mode mlds_output_data_name(in, di, uo) is det.
mlds_output_data_name(var(Name)) -->
- mlds_output_mangled_name(Name).
+ mlds_output_mangled_name(ml_var_name_to_string(Name)).
mlds_output_data_name(common(Num)) -->
io__write_string("common_"),
io__write_int(Num).
@@ -2481,16 +2460,20 @@
%
% foreign language interfacing
%
-mlds_output_atomic_stmt(_Indent, _FuncInfo, target_code(TargetLang, Components),
- Context) -->
+mlds_output_atomic_stmt(_Indent, _FuncInfo,
+ inline_target_code(TargetLang, Components), Context) -->
( { TargetLang = lang_C } ->
list__foldl(
mlds_output_target_code_component(Context),
Components)
;
- { error("mlds_to_c.m: sorry, target_code only works for lang_C") }
+ { error("mlds_to_c.m: sorry, inline_target_code only works for lang_C") }
).
+mlds_output_atomic_stmt(_Indent, _FuncInfo,
+ outline_target_code(_ForeignLang, _Lvals, _Code), _Context) -->
+ { error("mlds_to_c.m: outline_target_code is not used in C backend") }.
+
:- pred mlds_output_target_code_component(mlds__context, target_code_component,
io__state, io__state).
:- mode mlds_output_target_code_component(in, in, di, uo) is det.
@@ -2626,7 +2609,12 @@
:- mode mlds_output_var(in, di, uo) is det.
mlds_output_var(VarName) -->
- mlds_output_fully_qualified(VarName, mlds_output_mangled_name).
+ mlds_output_fully_qualified(VarName, mlds_output_var_name).
+
+:- pred mlds_output_var_name(mlds__var_name, io__state, io__state).
+:- mode mlds_output_var_name(in, di, uo) is det.
+mlds_output_var_name(VarName) -->
+ mlds_output_mangled_name(ml_var_name_to_string(VarName)).
:- pred mlds_output_mangled_name(string, io__state, io__state).
:- mode mlds_output_mangled_name(in, di, uo) is det.
Index: compiler/mlds_to_csharp.m
===================================================================
RCS file: mlds_to_csharp.m
diff -N mlds_to_csharp.m
--- /dev/null Mon Apr 16 11:57:05 2001
+++ mlds_to_csharp.m Mon Apr 30 23:50:34 2001
@@ -0,0 +1,554 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% mlds_to_csharp - Generate C# code for the foreign language interface.
+% Main author: trd.
+%
+% This code converts the MLDS representation of foreign language code into C#
+
+:- module mlds_to_csharp.
+:- interface.
+
+:- import_module mlds.
+:- import_module io.
+
+ % Convert the MLDS to C# and write it to a file.
+
+:- pred mlds_to_csharp__output_csharp_code(mlds, io__state, io__state).
+:- mode mlds_to_csharp__output_csharp_code(in, di, uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module globals, options, passes_aux.
+:- import_module builtin_ops, c_util, modules, tree.
+:- import_module hlds_pred. % for `pred_proc_id'.
+:- import_module prog_data, prog_out, llds_out.
+:- import_module rtti, type_util, error_util.
+
+:- import_module ilds, ilasm, il_peephole.
+:- import_module ml_util, ml_code_util.
+:- import_module mlds_to_c. /* to output C code for .cpp files */
+:- use_module llds. /* for user_c_code */
+
+:- import_module bool, int, map, string, list, assoc_list, term, std_util.
+:- import_module library, require, counter.
+
+:- import_module mlds_to_il.
+
+%-----------------------------------------------------------------------------%
+
+
+%-----------------------------------------------------------------------------%
+
+ %
+ % Generate the `__csharp_code.cs' file which contains the c sharp
+ % code.
+ %
+output_csharp_code(MLDS) -->
+ { MLDS = mlds(ModuleName, _ForeignCode, _Imports, _Defns) },
+ output_src_start(ModuleName),
+ io__nl,
+
+ generate_c_code(MLDS),
+
+ output_src_end(ModuleName).
+
+:- pred output_src_start(mercury_module_name, io__state, io__state).
+:- mode output_src_start(in, di, uo) is det.
+
+output_src_start(ModuleName) -->
+ { library__version(Version) },
+ { prog_out__sym_name_to_string(ModuleName, ModuleNameStr) },
+ io__write_strings(
+ ["//\n// Automatically generated from `",
+ ModuleNameStr,
+ ".m' by the\n",
+ "// Mercury compiler, version ",
+ Version,
+ ".\n",
+ "// Do not edit.\n",
+ "\n\n"]).
+
+:- pred output_src_end(mercury_module_name, io__state, io__state).
+:- mode output_src_end(in, di, uo) is det.
+
+output_src_end(ModuleName) -->
+ io__write_string("// End of module: "),
+ prog_out__write_sym_name(ModuleName),
+ io__write_string(". \n").
+
+%-----------------------------------------------------------------------------%
+
+ % This section could very nearly be turned into a
+ % mlds_to_csharp module, which turns MLDS into managed C++.
+ % Note that it relies on quite a few predicates in mlds_to_il.
+ % XXX we should clean up the dependencies.
+ % XXX we don't output contexts for any of this.
+:- pred generate_c_code(mlds, io__state, io__state).
+:- mode generate_c_code(in, di, uo) is det.
+generate_c_code(MLDS) -->
+
+ { MLDS = mlds(ModuleName, ForeignCode, _Imports, Defns) },
+ { prog_out__sym_name_to_string(ModuleName, ModuleNameStr) },
+ { ClassName = mlds_module_name_to_class_name(
+ mercury_module_name_to_mlds(ModuleName)) },
+
+ io__nl,
+ io__write_strings([
+ "// #using ""mercury_mcpp.dll""\n",
+ "// #using ""mercury_il.dll""\n",
+ "// #using """, ModuleNameStr, ".dll""\n",
+
+ % XXX We have to use the mercury namespace, as
+ % llds_out still generates some of the code used in the
+ % C sharp interface, and so it doesn't have "mercury::"
+ % namespace qualifiers.
+ "using mercury;\n",
+ "\n"]),
+
+ generate_foreign_header_code(mercury_module_name_to_mlds(ModuleName),
+ ForeignCode),
+
+ { Namespace0 = get_class_namespace(ClassName) },
+ { list__reverse(Namespace0) = [Head | Tail] ->
+ Namespace = list__reverse([Head ++ "__csharp_code" | Tail])
+ ;
+ Namespace = Namespace0
+ },
+
+ io__write_list(Namespace, "\n",
+ (pred(N::in, di, uo) is det -->
+ io__format("namespace %s {", [s(N)])
+ )),
+
+ io__write_strings([
+ "\nclass mercury_code",
+ "{\n"]),
+
+ % Output the contents of pragma foreign_code declarations.
+ generate_foreign_code(mercury_module_name_to_mlds(ModuleName),
+ ForeignCode),
+
+ io__write_string("\n"),
+
+ % Output the contents of foreign_proc declarations.
+ % Put each one inside a method.
+ list__foldl(generate_method_c_code(
+ mercury_module_name_to_mlds(ModuleName)), Defns),
+
+ io__write_string("};\n"),
+
+ % Close the namespace braces.
+ io__write_list(Namespace, "\n",
+ (pred(_N::in, di, uo) is det -->
+ io__write_string("}")
+ )),
+
+ io__nl.
+
+
+ % XXX we don't handle export decls.
+:- pred generate_foreign_code(mlds_module_name, mlds__foreign_code,
+ io__state, io__state).
+:- mode generate_foreign_code(in, in, di, uo) is det.
+generate_foreign_code(_ModuleName,
+ mlds__foreign_code(_RevHeaderCode, RevBodyCode,
+ _ExportDefns)) -->
+ { BodyCode = list__reverse(RevBodyCode) },
+ io__write_list(BodyCode, "\n",
+ (pred(llds__user_foreign_code(Lang, Code, _Context)::in,
+ di, uo) is det -->
+ ( { Lang = csharp } ->
+ io__write_string(Code)
+ ;
+ { sorry(this_file,
+ "foreign code other than MC++") }
+ )
+ )).
+
+ % XXX we don't handle export decls.
+:- pred generate_foreign_header_code(mlds_module_name, mlds__foreign_code,
+ io__state, io__state).
+:- mode generate_foreign_header_code(in, in, di, uo) is det.
+generate_foreign_header_code(_ModuleName,
+ mlds__foreign_code(RevHeaderCode, _RevBodyCode,
+ _ExportDefns)) -->
+ { HeaderCode = list__reverse(RevHeaderCode) },
+ io__write_list(HeaderCode, "\n",
+ (pred(llds__foreign_decl_code(Lang, Code, _Context)::in,
+ di, uo) is det -->
+ ( { Lang = csharp } ->
+ io__write_string(Code)
+ ;
+ { sorry(this_file,
+ "foreign code other than MC++") }
+ )
+ )).
+
+:- pred generate_method_c_code(mlds_module_name, mlds__defn,
+ io__state, io__state).
+:- mode generate_method_c_code(in, in, di, uo) is det.
+
+ % XXX we don't handle export
+generate_method_c_code(_, defn(export(_), _, _, _)) --> [].
+generate_method_c_code(_, defn(data(_), _, _, _)) --> [].
+generate_method_c_code(_, defn(type(_, _), _, _, _)) --> [].
+generate_method_c_code(_ModuleName,
+ defn(function(PredLabel, ProcId, MaybeSeqNum, _PredId),
+ _Context, _DeclFlags, Entity)) -->
+
+ (
+ { Entity = mlds__function(_, Params, yes(Statement)) },
+ { has_foreign_languages(Statement, Langs) },
+ { list__member(csharp, Langs) }
+ ->
+ globals__io_lookup_bool_option(highlevel_data, HighLevelData),
+ { DataRep = il_data_rep(HighLevelData) },
+ { Params = mlds__func_params(Inputs, Outputs) },
+ { Outputs = [] ->
+ ReturnType = void
+ ; Outputs = [MLDSReturnType] ->
+ mlds_type_to_ilds_type(DataRep, MLDSReturnType) =
+ ilds__type(_, SimpleType),
+ ReturnType = simple_type(SimpleType)
+ ;
+ % IL doesn't support multiple return values
+ sorry(this_file, "multiple return values")
+ },
+
+
+ { predlabel_to_id(PredLabel, ProcId, MaybeSeqNum, Id) },
+ io__write_string("public static "),
+ write_il_ret_type_as_csharp_type(ReturnType),
+
+ io__write_string(" "),
+
+ io__write_string(Id),
+ io__write_string("("),
+ io__write_list(Inputs, ", ", write_input_arg_as_csharp_type),
+ io__write_string(")"),
+ io__nl,
+
+ io__write_string("{\n"),
+ write_csharp_statement(Statement),
+ io__write_string("}\n")
+ ;
+ []
+ ).
+
+:- pred write_csharp_statement(mlds__statement, io__state, io__state).
+:- mode write_csharp_statement(in, di, uo) is det.
+write_csharp_statement(statement(Statement, _Context)) -->
+ (
+ { Statement = atomic(outline_target_code(csharp,
+ _Lvals, Code)) }
+ ->
+ io__write_string(Code),
+ io__nl
+ ;
+ { Statement = block(Defns, Statements) }
+ ->
+ io__write_list(Defns, "", write_csharp_defn_decl),
+ io__write_string("{\n"),
+ io__write_list(Statements, "", write_csharp_statement),
+ io__write_string("\n}\n")
+ ;
+ { Statement = return(Rvals) }
+ ->
+ ( { Rvals = [Rval] } ->
+ io__write_string("return "),
+ write_csharp_rval(Rval),
+ io__write_string(";\n")
+ ;
+ { sorry(this_file, "multiple return values") }
+ )
+ ;
+ { functor(Statement, SFunctor, Arity) },
+ io__write_string("// unimplemented: "),
+ io__write_string(SFunctor),
+ io__write_string("/"),
+ io__write(Arity),
+ io__nl
+ ).
+
+%-------------------------------------------------------------------
+% code below here is not used.
+%-------------------------------------------------------------------
+
+ % XXX we ignore contexts
+:- pred write_csharp_code_component(mlds__target_code_component,
+ io__state, io__state).
+:- mode write_csharp_code_component(in, di, uo) is det.
+write_csharp_code_component(user_target_code(Code, _MaybeContext)) -->
+ io__write_string(Code).
+write_csharp_code_component(raw_target_code(Code)) -->
+ io__write_string(Code).
+ % XXX we don't handle name yet.
+write_csharp_code_component(name(_)) --> [].
+write_csharp_code_component(target_code_input(Rval)) -->
+ write_csharp_rval(Rval).
+write_csharp_code_component(target_code_output(Lval)) -->
+ write_csharp_lval(Lval).
+
+:- pred write_csharp_rval(mlds__rval, io__state, io__state).
+:- mode write_csharp_rval(in, di, uo) is det.
+write_csharp_rval(lval(Lval)) -->
+ write_csharp_lval(Lval).
+write_csharp_rval(mkword(_Tag, _Rval)) -->
+ io__write_string(" /* mkword rval -- unimplemented */ ").
+write_csharp_rval(const(RvalConst)) -->
+ write_csharp_rval_const(RvalConst).
+write_csharp_rval(unop(Unop, Rval)) -->
+ (
+ { Unop = std_unop(StdUnop) },
+ { c_util__unary_prefix_op(StdUnop, UnopStr) }
+ ->
+ io__write_string(UnopStr),
+ io__write_string("("),
+ write_csharp_rval(Rval),
+ io__write_string(")")
+ ;
+ { Unop = cast(Type) }
+ ->
+ io__write_string("("),
+ write_csharp_parameter_type(Type),
+ io__write_string(") "),
+ write_csharp_rval(Rval)
+ ;
+ io__write_string(" /* XXX box or unbox unop -- unimplemented */ "),
+ write_csharp_rval(Rval)
+ ).
+write_csharp_rval(binop(Binop, Rval1, Rval2)) -->
+ (
+ { c_util__binary_infix_op(Binop, BinopStr) }
+ ->
+ io__write_string("("),
+ write_csharp_rval(Rval1),
+ io__write_string(") "),
+ io__write_string(BinopStr),
+ io__write_string(" ("),
+ write_csharp_rval(Rval2),
+ io__write_string(")")
+ ;
+ io__write_string(" /* binop rval -- unimplemented */ ")
+ ).
+
+write_csharp_rval(mem_addr(_)) -->
+ io__write_string(" /* mem_addr rval -- unimplemented */ ").
+
+:- pred write_csharp_rval_const(mlds__rval_const, io__state, io__state).
+:- mode write_csharp_rval_const(in, di, uo) is det.
+write_csharp_rval_const(true) --> io__write_string("1").
+write_csharp_rval_const(false) --> io__write_string("0").
+write_csharp_rval_const(int_const(I)) --> io__write_int(I).
+write_csharp_rval_const(float_const(F)) --> io__write_float(F).
+ % XXX We don't quote this correctly.
+write_csharp_rval_const(string_const(S)) -->
+ io__write_string(""""),
+ io__write_string(S),
+ io__write_string("""").
+write_csharp_rval_const(multi_string_const(_L, _S)) -->
+ io__write_string(" /* multi_string_const rval -- unimplemented */ ").
+write_csharp_rval_const(code_addr_const(CodeAddrConst)) -->
+ (
+ { CodeAddrConst = proc(ProcLabel, _FuncSignature) },
+ { mangle_mlds_proc_label(ProcLabel, no, ClassName,
+ MangledName) },
+ write_csharp_class_name(ClassName),
+ io__write_string("."),
+ io__write_string(MangledName)
+ ;
+ { CodeAddrConst = internal(ProcLabel, SeqNum,
+ _FuncSignature) },
+ { mangle_mlds_proc_label(ProcLabel, yes(SeqNum), ClassName,
+ MangledName) },
+ write_csharp_class_name(ClassName),
+ io__write_string("."),
+ io__write_string(MangledName)
+ ).
+
+
+
+write_csharp_rval_const(data_addr_const(_)) -->
+ io__write_string(" /* data_addr_const rval -- unimplemented */ ").
+write_csharp_rval_const(null(_)) -->
+ io__write_string("0").
+
+:- pred write_csharp_lval(mlds__lval, io__state, io__state).
+:- mode write_csharp_lval(in, di, uo) is det.
+write_csharp_lval(field(_, Rval, named_field(FieldId, _Type), _, _)) -->
+ io__write_string("("),
+ write_csharp_rval(Rval),
+ io__write_string(")"),
+ io__write_string("."),
+ { FieldId = qual(_, FieldName) },
+ io__write_string(FieldName).
+
+write_csharp_lval(field(_, Rval, offset(OffSet), _, _)) -->
+ io__write_string("("),
+ write_csharp_rval(Rval),
+ io__write_string(")"),
+ io__write_string("["),
+ write_csharp_rval(OffSet),
+ io__write_string("]").
+
+write_csharp_lval(mem_ref(Rval, _)) -->
+ io__write_string("*"),
+ write_csharp_rval(Rval).
+write_csharp_lval(var(Var, _VarType)) -->
+ { Var = qual(_, VarName) },
+ write_mlds_var_name_for_parameter(VarName).
+
+:- pred write_csharp_defn_decl(mlds__defn, io__state, io__state).
+:- mode write_csharp_defn_decl(in, di, uo) is det.
+write_csharp_defn_decl(Defn) -->
+ { Defn = mlds__defn(Name, _Context, _Flags, DefnBody) },
+ ( { DefnBody = data(Type, _Initializer) },
+ { Name = data(var(VarName)) }
+ ->
+ write_csharp_parameter_type(Type),
+ io__write_string(" "),
+ write_mlds_var_name_for_parameter(VarName),
+ io__write_string(";\n")
+ ;
+ io__write_string("// unimplemented defn decl\n")
+ ).
+
+:- pred write_csharp_parameter_type(mlds__type, io__state, io__state).
+:- mode write_csharp_parameter_type(in, di, uo) is det.
+write_csharp_parameter_type(Type) -->
+ globals__io_lookup_bool_option(highlevel_data, HighLevelData),
+ { DataRep = il_data_rep(HighLevelData) },
+ { ILType = mlds_type_to_ilds_type(DataRep, Type) },
+ write_il_type_as_csharp_type(ILType).
+
+:- pred type_is_byref_type(mlds__type, mlds__type).
+:- mode type_is_byref_type(in, out) is semidet.
+type_is_byref_type(Type, InnerType) :-
+ Type = mlds__ptr_type(InnerType).
+
+:- pred write_il_ret_type_as_csharp_type(ret_type::in,
+ io__state::di, io__state::uo) is det.
+write_il_ret_type_as_csharp_type(void) --> io__write_string("void").
+write_il_ret_type_as_csharp_type(simple_type(T)) -->
+ write_il_simple_type_as_csharp_type(T).
+
+ % XXX need to revisit this and choose types appropriately
+:- pred write_il_simple_type_as_csharp_type(simple_type::in,
+ io__state::di, io__state::uo) is det.
+write_il_simple_type_as_csharp_type(int8) -->
+ io__write_string("int").
+write_il_simple_type_as_csharp_type(int16) -->
+ io__write_string("int").
+write_il_simple_type_as_csharp_type(int32) -->
+ io__write_string("int").
+write_il_simple_type_as_csharp_type(int64) -->
+ io__write_string("int").
+write_il_simple_type_as_csharp_type(uint8) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_csharp_type(uint16) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_csharp_type(uint32) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_csharp_type(uint64) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_csharp_type(native_int) -->
+ io__write_string("int").
+write_il_simple_type_as_csharp_type(native_uint) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_csharp_type(float32) -->
+ io__write_string("float").
+write_il_simple_type_as_csharp_type(float64) -->
+ io__write_string("float").
+write_il_simple_type_as_csharp_type(native_float) -->
+ io__write_string("float").
+write_il_simple_type_as_csharp_type(bool) -->
+ io__write_string("int").
+write_il_simple_type_as_csharp_type(char) -->
+ io__write_string("char").
+write_il_simple_type_as_csharp_type(refany) -->
+ io__write_string("mercury.MR_RefAny").
+write_il_simple_type_as_csharp_type(class(ClassName)) -->
+ ( { ClassName = il_generic_class_name } ->
+ io__write_string("mercury.MR_Box")
+ ;
+ write_csharp_class_name(ClassName)
+ ).
+ % XXX this is not the right syntax
+write_il_simple_type_as_csharp_type(value_class(ClassName)) -->
+ write_csharp_class_name(ClassName).
+ % XXX this is not the right syntax
+write_il_simple_type_as_csharp_type(interface(ClassName)) -->
+ write_csharp_class_name(ClassName).
+ % XXX this needs more work
+write_il_simple_type_as_csharp_type('[]'(_Type, _Bounds)) -->
+ io__write_string("object[]").
+write_il_simple_type_as_csharp_type('&'(Type)) -->
+ % XXX is this always right?
+ io__write_string("ref "),
+ write_il_type_as_csharp_type(Type).
+write_il_simple_type_as_csharp_type('*'(Type)) -->
+ write_il_type_as_csharp_type(Type),
+ io__write_string(" *").
+
+:- pred write_csharp_class_name(structured_name::in, io__state::di,
+ io__state::uo) is det.
+write_csharp_class_name(structured_name(_Assembly, DottedName)) -->
+ io__write_list(DottedName, ".", io__write_string).
+
+:- pred write_il_type_as_csharp_type(ilds__type::in,
+ io__state::di, io__state::uo) is det.
+write_il_type_as_csharp_type(ilds__type(Modifiers, SimpleType)) -->
+ io__write_list(Modifiers, " ",
+ write_il_type_modifier_as_csharp_type),
+ write_il_simple_type_as_csharp_type(SimpleType).
+
+:- pred write_il_type_modifier_as_csharp_type(ilds__type_modifier::in,
+ io__state::di, io__state::uo) is det.
+write_il_type_modifier_as_csharp_type(const) -->
+ io__write_string("const").
+write_il_type_modifier_as_csharp_type(readonly) -->
+ io__write_string("readonly").
+write_il_type_modifier_as_csharp_type(volatile) -->
+ io__write_string("volatile").
+
+:- pred write_input_arg_as_csharp_type(
+ pair(mlds__entity_name, mlds__type)::in,
+ io__state::di, io__state::uo) is det.
+write_input_arg_as_csharp_type(EntityName - Type) -->
+ globals__io_lookup_bool_option(highlevel_data, HighLevelData),
+ { DataRep = il_data_rep(HighLevelData) },
+ write_il_type_as_csharp_type(mlds_type_to_ilds_type(DataRep, Type)),
+ io__write_string(" "),
+ ( { EntityName = data(var(VarName)) } ->
+ write_mlds_var_name_for_parameter(VarName)
+ ;
+ { error("found a variable in a list") }
+ ).
+
+:- pred write_mlds_var_name_for_local(mlds__var_name::in,
+ io__state::di, io__state::uo) is det.
+write_mlds_var_name_for_local(var_name(Name, MaybeNum)) -->
+ io__write_string(Name),
+ ( { MaybeNum = yes(Num) } ->
+ io__write_string("_"),
+ io__write_int(Num)
+ ;
+ []
+ ).
+
+:- pred write_mlds_var_name_for_parameter(mlds__var_name::in,
+ io__state::di, io__state::uo) is det.
+write_mlds_var_name_for_parameter(var_name(Name, _)) -->
+ io__write_string(Name).
+
+:- func this_file = string.
+this_file = "mlds_to_csharp.m".
+
+:- end_module mlds_to_csharp.
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.20
diff -u -r1.20 mlds_to_il.m
--- compiler/mlds_to_il.m 2001/04/24 13:05:06 1.20
+++ compiler/mlds_to_il.m 2001/04/30 13:50:34
@@ -64,8 +64,9 @@
:- interface.
:- import_module mlds, ilasm, ilds.
-:- import_module io, list, bool, std_util.
+:- import_module io, list, bool, std_util, set.
:- import_module hlds_pred. % for `pred_proc_id'.
+:- import_module prog_data. % for `foreign_language'.
%-----------------------------------------------------------------------------%
@@ -74,7 +75,8 @@
%
% This is where all the action is for the IL backend.
%
-:- pred generate_il(mlds, list(ilasm:decl), bool, io__state, io__state).
+:- pred generate_il(mlds, list(ilasm:decl), set(foreign_language),
+ io__state, io__state).
:- mode generate_il(in, out, out, di, uo) is det.
@@ -142,7 +144,7 @@
:- import_module ml_type_gen.
:- use_module llds. /* for user_c_code */
-:- import_module bool, int, map, string, list, assoc_list, term.
+:- import_module bool, int, map, string, set, list, assoc_list, term.
:- import_module library, require, counter.
% We build up lists of instructions using a tree to make
@@ -155,20 +157,21 @@
module_name :: mlds_module_name, % the module name
assembly_name :: assembly_name, % the assembly name
imports :: mlds__imports, % the imports
- file_c_code :: bool, % file contains c_code
+ file_c_code :: set(foreign_language), % file foreign code
il_data_rep :: il_data_rep, % data representation.
% class-wide attributes (all accumulate)
alloc_instrs :: instr_tree, % .cctor allocation instructions
init_instrs :: instr_tree, % .cctor init instructions
classdecls :: list(classdecl), % class methods and fields
has_main :: bool, % class contains main
- class_c_code :: bool, % class contains c_code
+ class_c_code :: set(foreign_language),% class foreign code
% method-wide attributes (accumulating)
locals :: locals_map, % The current locals
instr_tree :: instr_tree, % The instruction tree (unused)
label_counter :: counter, % the label counter
block_counter :: counter, % the block counter
- method_c_code :: bool, % method contains c_code
+ method_c_code :: maybe(foreign_language),
+ % method contains foreign code
% method-wide attributes (static)
arguments :: arguments_map, % The arguments
method_name :: member_name, % current method name
@@ -182,7 +185,7 @@
%-----------------------------------------------------------------------------%
-generate_il(MLDS, ILAsm, ContainsCCode, IO0, IO) :-
+generate_il(MLDS, ILAsm, ForeignLangs, IO0, IO) :-
MLDS = mlds(MercuryModuleName, _ForeignCode, Imports, Defns),
ModuleName = mercury_module_name_to_mlds(MercuryModuleName),
SymName = mlds_module_name_to_sym_name(ModuleName),
@@ -193,8 +196,12 @@
% Generate code for all the methods in this module.
list__foldl(generate_method_defn, Defns, Info0, Info1),
- bool__or(Info1 ^ file_c_code, Info1 ^ method_c_code, ContainsCCode),
- Info2 = Info1 ^ file_c_code := ContainsCCode,
+ ( Info1 ^ method_c_code = yes(SomeLang) ->
+ Info2 = Info1 ^ file_c_code :=
+ set__insert(Info1 ^ file_c_code, SomeLang)
+ ;
+ Info2 = Info1
+ ),
ClassDecls = Info2 ^ classdecls,
InitInstrs = list__condense(tree__flatten(Info2 ^ init_instrs)),
AllocInstrs = list__condense(tree__flatten(Info2 ^ alloc_instrs)),
@@ -213,6 +220,7 @@
% assembly in a separate step during the build (using
% AL.EXE).
+ Info3 ^ file_c_code = ForeignLangs,
(
SymName = qualified(unqualified("mercury"), _)
->
@@ -223,14 +231,10 @@
% If not in the library, but we have C code,
% declare the __c_code module as an assembly we
% reference
- (
- Info3 ^ file_c_code = yes,
- mangle_dataname_module(no, ModuleName, CCodeModuleName),
- AssemblerRefs = [CCodeModuleName | Imports]
- ;
- Info3 ^ file_c_code = no,
- AssemblerRefs = Imports
- )
+ list__map(mangle_foreign_code_module(ModuleName),
+ set__to_sorted_list(ForeignLangs),
+ ForeignCodeAssemblerRefs),
+ AssemblerRefs = list__append(ForeignCodeAssemblerRefs, Imports)
),
% Turn the MLDS module names we import into a list of
@@ -310,7 +314,7 @@
% If there is no function body,
% generate forwarding code instead.
% This can happen with :- external
- atomic_statement_to_il(target_code(lang_C, []),
+ atomic_statement_to_il(inline_target_code(lang_C, []),
InstrsTree0),
% The code might reference locals...
il_info_add_locals(["succeeded" -
@@ -543,7 +547,7 @@
MLDSType) },
get_load_store_lval_instrs(Lval,
LoadMemRefInstrs, StoreLvalInstrs),
- { NameString = VarName }
+ { NameString = mangle_mlds_var_name(VarName) }
;
{ LoadMemRefInstrs = throw_unimplemented(
"initializer_for_non_var_data_name") },
@@ -957,11 +961,61 @@
atomic_statement_to_il(restore_hp(_), node(Instrs)) -->
{ Instrs = [comment(
"restore hp -- not relevant for this backend")] }.
+
+atomic_statement_to_il(outline_target_code(Lang, ReturnLvals, _Code),
+ Instrs) -->
+ il_info_get_module_name(ModuleName),
+ ( no =^ method_c_code ->
+ ^ method_c_code := yes(Lang),
+ { mangle_foreign_code_module(ModuleName, Lang,
+ OutlineLangModuleName) },
+ { ClassName = mlds_module_name_to_class_name(
+ OutlineLangModuleName) },
+ signature(_, RetType, Params) =^ signature,
+
+ ( { ReturnLvals = [] } ->
+ % If there is a return type, but no return value, it
+ % must be a semidet predicate so put it in succeeded.
+ % XXX it would be better to get the code generator
+ % to tell us this is the case directly
+ { LoadInstrs = empty },
+ { RetType = void ->
+ StoreInstrs = empty
+ ;
+ StoreInstrs = instr_node(
+ stloc(name("succeeded")))
+ }
+ ; { ReturnLvals = [ReturnLval] } ->
+ get_load_store_lval_instrs(ReturnLval,
+ LoadInstrs, StoreInstrs)
+ ;
+ { sorry(this_file, "multiple return values") }
+ ),
+ MethodName =^ method_name,
+ { assoc_list__keys(Params, TypeParams) },
+ { list__map_foldl((pred(_::in, Instr::out,
+ Num::in, Num + 1::out) is det :-
+ Instr = ldarg(index(Num))),
+ TypeParams, LoadArgInstrs, 0, _) },
+ { Instrs = tree__list([
+ comment_node(
+ "outline target code -- call handwritten version"),
+ LoadInstrs,
+ node(LoadArgInstrs),
+ instr_node(call(get_static_methodref(
+ ClassName, MethodName, RetType, TypeParams))),
+ StoreInstrs
+ ]) }
+ ;
+ { Instrs = comment_node(
+ "outline target code -- already called") }
+ ).
-atomic_statement_to_il(target_code(_Lang, _Code), node(Instrs)) -->
+atomic_statement_to_il(inline_target_code(_Lang, _Code), node(Instrs)) -->
il_info_get_module_name(ModuleName),
( no =^ method_c_code ->
- ^ method_c_code := yes,
+ % XXX we hardcode managed C++ here
+ ^ method_c_code := yes(managed_cplusplus),
{ mangle_dataname_module(no, ModuleName, NewModuleName) },
{ ClassName = mlds_module_name_to_class_name(NewModuleName) },
signature(_, RetType, Params) =^ signature,
@@ -980,14 +1034,14 @@
Instr = ldarg(index(Num))),
TypeParams, LoadInstrs, 0, _) },
{ list__condense(
- [[comment("target code -- call handwritten version")],
+ [[comment("inline target code -- call handwritten version")],
LoadInstrs,
[call(get_static_methodref(ClassName, MethodName,
RetType, TypeParams))],
StoreReturnInstr
], Instrs) }
;
- { Instrs = [comment("target code -- already called")] }
+ { Instrs = [comment("inline target code -- already called")] }
).
@@ -1189,7 +1243,7 @@
=(Info),
{ is_local(MangledVarStr, Info) ->
Instrs = instr_node(ldloc(name(MangledVarStr)))
- ; is_argument(Var, Info) ->
+ ; is_argument(MangledVarStr, Info) ->
Instrs = instr_node(ldarg(name(MangledVarStr)))
;
FieldRef = make_fieldref_for_handdefined_var(DataRep,
@@ -1275,7 +1329,7 @@
=(Info),
{ is_local(MangledVarStr, Info) ->
Instrs = instr_node(ldloca(name(MangledVarStr)))
- ; is_argument(Var, Info) ->
+ ; is_argument(MangledVarStr, Info) ->
Instrs = instr_node(ldarga(name(MangledVarStr)))
;
FieldRef = make_fieldref_for_handdefined_var(DataRep,
@@ -1316,7 +1370,7 @@
=(Info),
{ is_local(MangledVarStr, Info) ->
Instrs = instr_node(stloc(name(MangledVarStr)))
- ; is_argument(Var, Info) ->
+ ; is_argument(MangledVarStr, Info) ->
Instrs = instr_node(starg(name(MangledVarStr)))
;
FieldRef = make_fieldref_for_handdefined_var(DataRep, Var,
@@ -1792,12 +1846,10 @@
:- func input_param_to_ilds_type(il_data_rep, mlds_module_name,
pair(entity_name, mlds__type)) = ilds__param.
-input_param_to_ilds_type(DataRep, ModuleName, EntityName - MldsType)
+input_param_to_ilds_type(DataRep, _ModuleName, EntityName - MldsType)
= ILType - yes(Id) :-
- mangle_entity_name(EntityName, VarName),
- mangle_mlds_var(qual(ModuleName, VarName), Id),
+ mangle_entity_name(EntityName, Id),
ILType = mlds_type_to_ilds_type(DataRep, MldsType).
-
:- func mlds_type_to_ilds_simple_type(il_data_rep, mlds__type) =
ilds__simple_type.
@@ -1974,6 +2026,24 @@
mlds_type_to_ilds_type(DataRep, VarType), ClassName,
MangledVarStr).
+:- pred mangle_foreign_code_module(mlds_module_name, foreign_language,
+ mlds_module_name).
+:- mode mangle_foreign_code_module(in, in, out) is det.
+
+mangle_foreign_code_module(ModuleName0, Lang, ModuleName) :-
+ LangStr = globals__simple_foreign_language_string(Lang),
+ SymName0 = mlds_module_name_to_sym_name(ModuleName0),
+ (
+ SymName0 = qualified(Q, M0),
+ M = string__format("%s__%s_code", [s(M0), s(LangStr)]),
+ SymName = qualified(Q, M)
+ ;
+ SymName0 = unqualified(M0),
+ M = string__format("%s__%s_code", [s(M0), s(LangStr)]),
+ SymName = unqualified(M)
+ ),
+ ModuleName = mercury_module_name_to_mlds(SymName).
+
% When generating references to RTTI, we need to mangle the
% module name if the RTTI is defined in C code by hand.
% If no data_name is provided, always do the mangling.
@@ -2042,7 +2112,8 @@
:- pred mangle_dataname(mlds__data_name, string).
:- mode mangle_dataname(in, out) is det.
-mangle_dataname(var(Name), Name).
+mangle_dataname(var(MLDSVarName), Name) :-
+ Name = mangle_mlds_var_name(MLDSVarName).
mangle_dataname(common(Int), MangledName) :-
string__format("common_%s", [i(Int)], MangledName).
mangle_dataname(rtti(RttiTypeId, RttiName), MangledName) :-
@@ -2080,8 +2151,14 @@
% We quote all identifiers before we output them, so
% even funny characters should be fine.
mangle_mlds_var(qual(_ModuleName, VarName), Str) :-
- Str = VarName.
+ Str = mangle_mlds_var_name(VarName).
+
+:- func mangle_mlds_var_name(mlds__var_name) = string.
+mangle_mlds_var_name(mlds__var_name(Name, yes(Num))) =
+ string__format("%s_%d", [s(Name), i(Num)]).
+mangle_mlds_var_name(mlds__var_name(Name, no)) = Name.
+
:- pred mlds_to_il__sym_name_to_string(sym_name, string).
:- mode mlds_to_il__sym_name_to_string(in, out) is det.
mlds_to_il__sym_name_to_string(SymName, String) :-
@@ -2133,12 +2210,12 @@
%
-:- pred is_argument(mlds__var, il_info).
+:- pred is_argument(ilds__id, il_info).
:- mode is_argument(in, in) is semidet.
-is_argument(qual(_, VarName), Info) :-
+is_argument(VarName, Info) :-
list__member(VarName - _, Info ^ arguments).
-:- pred is_local(string, il_info).
+:- pred is_local(ilds__id, il_info).
:- mode is_local(in, in) is semidet.
is_local(VarName, Info) :-
map__contains(Info ^ locals, VarName).
@@ -2299,7 +2376,8 @@
( Name = data(DataName),
Entity = mlds__data(MLDSType0, _Initializer) ->
mangle_dataname(DataName, MangledDataName),
- mangle_mlds_var(qual(ModuleName, MangledDataName), Id),
+ mangle_mlds_var(qual(ModuleName,
+ var_name(MangledDataName, no)), Id),
MLDSType0 = MLDSType
;
error("definition name was not data/1")
@@ -2476,8 +2554,6 @@
%-----------------------------------------------------------------------------
-%-----------------------------------------------------------------------------
-
% qualifiy a name with "[mscorlib]System."
:- func il_system_name(ilds__namespace_qual_name) = ilds__class_name.
il_system_name(Name) = structured_name(il_system_assembly_name,
@@ -2667,8 +2743,8 @@
il_data_rep) = il_info.
il_info_init(ModuleName, AssemblyName, Imports, ILDataRep) =
- il_info(ModuleName, AssemblyName, Imports, no, ILDataRep,
- empty, empty, [], no, no,
+ il_info(ModuleName, AssemblyName, Imports, set__init, ILDataRep,
+ empty, empty, [], no, set__init,
map__init, empty, counter__init(1), counter__init(1), no,
Args, MethodName, DefaultSignature) :-
Args = [],
@@ -2680,18 +2756,25 @@
il_info, il_info).
:- mode il_info_new_method(in, in, in, in, out) is det.
-il_info_new_method(ILArgs, ILSignature, MethodName,
- % XXX TYSE: fixme to use accessors.
- il_info(ModuleName, AssemblyName,Imports, FileCCode, ILDataRep,
- AllocInstrs, InitInstrs, ClassDecls, HasMain, ClassCCode,
- __Locals, _InstrTree, _LabelCounter, _BlockCounter, MethodCCode,
- _Args, _Name, _Signature),
- il_info(ModuleName, AssemblyName,Imports, NewFileCCode, ILDataRep,
- AllocInstrs, InitInstrs, ClassDecls, HasMain, NewClassCCode,
- map__init, empty, counter__init(1), counter__init(1), no,
- ILArgs, MethodName, ILSignature)) :-
- bool__or(ClassCCode, MethodCCode, NewClassCCode),
- bool__or(FileCCode, MethodCCode, NewFileCCode).
+il_info_new_method(ILArgs, ILSignature, MethodName) -->
+ =(Info),
+ ( yes(SomeLang) =^ method_c_code ->
+ ^ file_c_code :=
+ set__insert(Info ^ file_c_code, SomeLang),
+ ^ class_c_code :=
+ set__insert(Info ^ class_c_code, SomeLang)
+ ;
+ []
+ ),
+ ^ locals := map__init,
+ ^ instr_tree := empty,
+ ^ label_counter := counter__init(1),
+ ^ block_counter := counter__init(1),
+ ^ method_c_code := no,
+ ^ arguments := ILArgs,
+ ^ method_name := MethodName,
+ ^ signature := ILSignature.
+
:- pred il_info_set_arguments(assoc_list(ilds__id, mlds__type),
il_info, il_info).
Index: compiler/mlds_to_ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
retrieving revision 1.11
diff -u -r1.11 mlds_to_ilasm.m
--- compiler/mlds_to_ilasm.m 2001/04/24 13:05:06 1.11
+++ compiler/mlds_to_ilasm.m 2001/04/30 13:54:33
@@ -36,10 +36,11 @@
:- import_module ilds, ilasm, il_peephole.
:- import_module ml_util, ml_code_util.
-:- import_module mlds_to_c. /* to output C code for .cpp files */
+:- import_module mlds_to_csharp. /* to output C sharp code */
+:- import_module mlds_to_mcpp. /* to output MC++ code */
:- use_module llds. /* for user_c_code */
-:- import_module bool, int, map, string, list, assoc_list, term, std_util.
+:- import_module bool, int, map, string, set, list, assoc_list, term, std_util.
:- import_module library, require, counter.
:- import_module mlds_to_il.
@@ -58,46 +59,26 @@
% This is temporary, when we have pragma foreign
% we should just put managed C++ foreign code into
% this file.
- ( { Result = yes } ->
- module_name_to_file_name(ModuleName, "__c_code.cpp", yes,
- CPPFile),
- output_to_file(CPPFile, output_c_code(MLDS),
- _Result)
+ ( { Result = yes(ForeignLangs) } ->
+ ( { set__member(managed_cplusplus, ForeignLangs) } ->
+ module_name_to_file_name(ModuleName,
+ "__c_code.cpp", yes, CPPFile),
+ output_to_file(CPPFile, output_mcpp_code(MLDS))
+ ; { set__member(csharp, ForeignLangs) } ->
+ module_name_to_file_name(ModuleName,
+ "__csharp_code.cs", yes, CSFile),
+ output_to_file(CSFile, output_csharp_code(MLDS))
+ ;
+ []
+ )
;
[]
).
-:- pred output_to_file(string, pred(bool, io__state, io__state),
- bool, io__state, io__state).
-:- mode output_to_file(in, pred(out, di, uo) is det, out, di, uo) is det.
-
-output_to_file(FileName, Action, Result) -->
- globals__io_lookup_bool_option(verbose, Verbose),
- globals__io_lookup_bool_option(statistics, Stats),
- maybe_write_string(Verbose, "% Writing to file `"),
- maybe_write_string(Verbose, FileName),
- maybe_write_string(Verbose, "'...\n"),
- maybe_flush_output(Verbose),
- io__tell(FileName, Res),
- ( { Res = ok } ->
- Action(Result),
- io__told,
- maybe_write_string(Verbose, "% done.\n"),
- maybe_report_stats(Stats)
- ;
- maybe_write_string(Verbose, "\n"),
- { string__append_list(["can't open file `",
- FileName, "' for output."], ErrorMessage) },
- report_error(ErrorMessage),
- { Result = no }
- ).
-
%
% Generate the `.il' file
- % Also, return whether there is any C code in this file so we
- % know whether to generate a <modulename>__c_code.cpp file.
%
-:- pred output_assembler(mlds, bool, io__state, io__state).
+:- pred output_assembler(mlds, set(foreign_language), io__state, io__state).
:- mode output_assembler(in, out, di, uo) is det.
output_assembler(MLDS, ContainsCCode) -->
@@ -118,586 +99,6 @@
ilasm__output(ILAsm),
output_src_end(ModuleName).
-
- %
- % Generate the `__c_code.cpp' file which contains the pragma C
- % code.
- %
-:- pred output_c_code(mlds, bool, io__state, io__state).
-:- mode output_c_code(in, out, di, uo) is det.
-
-output_c_code(MLDS, yes) -->
- { MLDS = mlds(ModuleName, _ForeignCode, _Imports, _Defns) },
- output_src_start(ModuleName),
- io__nl,
-
- generate_c_code(MLDS),
-
- output_src_end(ModuleName).
-
-:- pred output_src_start(mercury_module_name, io__state, io__state).
-:- mode output_src_start(in, di, uo) is det.
-
-output_src_start(ModuleName) -->
- { library__version(Version) },
- { prog_out__sym_name_to_string(ModuleName, ModuleNameStr) },
- io__write_strings(
- ["//\n// Automatically generated from `",
- ModuleNameStr,
- ".m' by the\n",
- "// Mercury compiler, version ",
- Version,
- ".\n",
- "// Do not edit.\n",
- "\n\n"]).
-
-:- pred output_src_end(mercury_module_name, io__state, io__state).
-:- mode output_src_end(in, di, uo) is det.
-
-output_src_end(ModuleName) -->
- io__write_string("// End of module: "),
- prog_out__write_sym_name(ModuleName),
- io__write_string(". \n").
-
-%-----------------------------------------------------------------------------%
-
- % This section could very nearly be turned into a
- % mlds_to_managed_cpp module, which turns MLDS into managed C++.
- % Note that it relies on quite a few predicates in mlds_to_il.
- % XXX we should clean up the dependencies.
- % XXX we don't output contexts for any of this.
-:- pred generate_c_code(mlds, io__state, io__state).
-:- mode generate_c_code(in, di, uo) is det.
-generate_c_code(MLDS) -->
-
- { MLDS = mlds(ModuleName, ForeignCode, _Imports, Defns) },
- { prog_out__sym_name_to_string(ModuleName, ModuleNameStr) },
- { ClassName = mlds_module_name_to_class_name(
- mercury_module_name_to_mlds(ModuleName)) },
-
- io__nl,
- io__write_strings([
- "#using <mscorlib.dll>\n",
- "#include ""mercury_mcpp.h""\n",
- "#using ""mercury_mcpp.dll""\n",
- "#using ""mercury_il.dll""\n",
- "#using """, ModuleNameStr, ".dll""\n",
-
- % XXX We have to use the mercury namespace, as
- % llds_out still generates some of the code used in the
- % MC++ interface, and so it doesn't have "mercury::"
- % namespace qualifiers.
- "using namespace mercury;\n",
-
- % XXX this supresses problems caused by references to
- % float. If you don't do this, you'll get link errors.
- % Revisit this when the .NET implementation has matured.
- "extern ""C"" int _fltused=0;\n",
- "\n"]),
-
- { Namespace = get_class_namespace(ClassName) },
-
- io__write_list(Namespace, "\n",
- (pred(N::in, di, uo) is det -->
- io__format("namespace %s {", [s(N)])
- )),
-
- generate_foreign_header_code(mercury_module_name_to_mlds(ModuleName),
- ForeignCode),
-
- io__write_strings([
- "\n__gc public class ", ModuleNameStr, "__c_code\n",
- "{\n",
- "public:\n"]),
-
- % Output the contents of
- % :- pragma foreign_code(Language, Code
- % declarations.
- generate_foreign_code(mercury_module_name_to_mlds(ModuleName),
- ForeignCode),
-
- % Output the contents of
- % :- pragma foreign_code(Language, Pred, Flags, Code)
- % declarations. Put each one inside a method.
- list__foldl(generate_method_c_code(
- mercury_module_name_to_mlds(ModuleName)), Defns),
-
- io__write_string("};\n"),
-
- % Close the namespace braces.
- io__write_list(Namespace, "\n",
- (pred(_N::in, di, uo) is det -->
- io__write_string("}")
- )),
-
-
- io__nl.
-
-
- % XXX we don't handle export decls.
-:- pred generate_foreign_code(mlds_module_name, mlds__foreign_code,
- io__state, io__state).
-:- mode generate_foreign_code(in, in, di, uo) is det.
-generate_foreign_code(_ModuleName,
- mlds__foreign_code(_RevHeaderCode, RevBodyCode,
- _ExportDefns)) -->
- { BodyCode = list__reverse(RevBodyCode) },
- io__write_list(BodyCode, "\n",
- (pred(llds__user_foreign_code(Lang, Code, Context)::in,
- di, uo) is det -->
- ( { Lang = managed_cplusplus } ->
- mlds_to_c__output_context(mlds__make_context(
- Context)),
- io__write_string(Code)
- ;
- { sorry(this_file,
- "foreign code other than MC++") }
- )
- )).
-
- % XXX we don't handle export decls.
-:- pred generate_foreign_header_code(mlds_module_name, mlds__foreign_code,
- io__state, io__state).
-:- mode generate_foreign_header_code(in, in, di, uo) is det.
-generate_foreign_header_code(_ModuleName,
- mlds__foreign_code(RevHeaderCode, _RevBodyCode,
- _ExportDefns)) -->
- { HeaderCode = list__reverse(RevHeaderCode) },
- io__write_list(HeaderCode, "\n",
- (pred(llds__foreign_decl_code(Lang, Code, _Context)::in,
- di, uo) is det -->
- ( { Lang = managed_cplusplus } ->
- io__write_string(Code)
- ;
- { sorry(this_file,
- "foreign code other than MC++") }
- )
- )).
-
-:- pred generate_method_c_code(mlds_module_name, mlds__defn,
- io__state, io__state).
-:- mode generate_method_c_code(in, in, di, uo) is det.
-
- % XXX we don't handle export
-generate_method_c_code(_, defn(export(_), _, _, _)) --> [].
-generate_method_c_code(_, defn(data(_), _, _, _)) --> [].
-generate_method_c_code(_, defn(type(_, _), _, _, _)) --> [].
-generate_method_c_code(ModuleName,
- defn(function(PredLabel, ProcId, MaybeSeqNum, _PredId),
- _Context, _DeclFlags, Entity)) -->
- (
- { Entity = mlds__function(_, Params, yes(Statement)) },
- { has_target_code_statement(Statement) }
- ->
- globals__io_lookup_bool_option(highlevel_data, HighLevelData),
- { DataRep = il_data_rep(HighLevelData) },
- { ILSignature = params_to_il_signature(DataRep,
- ModuleName, Params) },
- { predlabel_to_id(PredLabel, ProcId, MaybeSeqNum, Id) },
- io__write_string("static "),
- { ILSignature = signature(_CallConv, ReturnType, ILArgs) },
- write_il_ret_type_as_managed_cpp_type(ReturnType),
-
- io__write_string(" "),
-
- io__write_string(Id),
- io__write_string("("),
- io__write_list(ILArgs, ", ", write_il_arg_as_managed_cpp_type),
- io__write_string(")"),
- io__nl,
-
- io__write_string("{\n"),
- write_managed_cpp_statement(Statement),
- io__write_string("}\n")
- ;
- []
- ).
-
- % In order to implement the C interface, you need to
- % implement:
- % call/6 (for calling continuations)
- % return/1 (for returning succeeded)
- % block/2 (because the code is wrapped in a block, and
- % because local variables are declared for
- % "succeeded")
- % target_code/2 (where the actual code is put)
- % assign/2 (to assign to the environment)
- % newobj/7 (to create an environment)
- %
- % Unfortunately currently some of the "raw_target_code" is
- % C specific and won't translate well into managed C++.
- % Probably the best solution to this is to introduce some new
- % code components.
- %
- % Note that for the managed C++ backend there is a problem.
- % #import doesn't import classes in namespaces properly (yet), so we
- % can't #import .dlls that define environments. So even if we
- % implement newobj/7, we will get errors.
- % The work-around for this is to make sure ml_elim_nested
- % doesn't introduce environments where they aren't needed,
- % so we don't generally have to allocate anything but the local
- % environment (which is defined locally).
-
-:- pred write_managed_cpp_statement(mlds__statement,
- io__state, io__state).
-:- mode write_managed_cpp_statement(in, di, uo) is det.
-write_managed_cpp_statement(Statement) -->
- globals__io_lookup_bool_option(highlevel_data, HighLevelData),
- (
- % XXX this ignores the language target.
- { Statement = statement(atomic(target_code(
- _Lang, CodeComponents)), _) }
- ->
- io__write_list(CodeComponents, "\n",
- write_managed_cpp_code_component)
- ;
- { Statement = statement(block(Defns, Statements), _) }
- ->
- io__write_list(Defns, "", write_managed_cpp_defn_decl),
- io__write_string("{\n"),
- io__write_list(Statements, "", write_managed_cpp_statement),
- io__write_string("}\n")
- ;
- { Statement = statement(
- call(_Sig, Function, _This, Args, Results, _IsTail),
- _Context) }
- ->
- % XXX this doesn't work for continuations because
- % a) I don't know how to call a function pointer in
- % managed C++.
- % b) Function pointers are represented as integers,
- % and we don't do any casting for them.
- % The nondet interface might need to be reworked in
- % this case.
- % The workaround at the moment is to make sure we don't
- % actually generate calls to continuations in managed
- % C++, instead we generate a nested function that is
- % implemented in IL that does the continuation call, and
- % just call the nested function instead. Sneaky, eh?
- ( { Results = [] } ->
- []
- ; { Results = [Lval] } ->
- write_managed_cpp_lval(Lval),
- io__write_string(" = ")
- ;
- { sorry(this_file, "multiple return values") }
- ),
- write_managed_cpp_rval(Function),
- io__write_string("("),
- io__write_list(Args, ", ", write_managed_cpp_rval),
- io__write_string(");\n")
- ;
- { Statement = statement(return(Rvals), _) }
- ->
- ( { Rvals = [Rval] } ->
- io__write_string("return "),
- write_managed_cpp_rval(Rval),
- io__write_string(";\n")
- ;
- { sorry(this_file, "multiple return values") }
- )
- ;
- { Statement = statement(atomic(assign(Lval, Rval)), _) }
- ->
- write_managed_cpp_lval(Lval),
- io__write_string(" = "),
- write_managed_cpp_rval(Rval),
- io__write_string(";\n")
- ;
-
- % XXX This is not fully implemented
- { Statement = statement(atomic(
- new_object(Target, _MaybeTag, Type, _MaybeSize,
- _MaybeCtorName, _Args, _ArgTypes)), _) },
- { ClassName = mlds_type_to_ilds_class_name(
- il_data_rep(HighLevelData), Type) }
- ->
- write_managed_cpp_lval(Target),
- io__write_string(" = new "),
- write_managed_cpp_class_name(ClassName),
- io__write_string("();\n")
- ;
- { Statement = statement(atomic(Atomic), _) }
- ->
- { functor(Atomic, AtomicFunctor, Arity) },
- io__write_string("// unimplemented: atomic "),
- io__write_string(AtomicFunctor),
- io__write_string("/"),
- io__write(Arity),
- io__nl
-
- ;
- { Statement = statement(S, _) },
- { functor(S, SFunctor, Arity) },
- io__write_string("// unimplemented: "),
- io__write_string(SFunctor),
- io__write_string("/"),
- io__write(Arity),
- io__nl
- ).
-
- % XXX we ignore contexts
-:- pred write_managed_cpp_code_component(mlds__target_code_component,
- io__state, io__state).
-:- mode write_managed_cpp_code_component(in, di, uo) is det.
-write_managed_cpp_code_component(user_target_code(Code, _MaybeContext)) -->
- io__write_string(Code).
-write_managed_cpp_code_component(raw_target_code(Code)) -->
- io__write_string(Code).
- % XXX we don't handle name yet.
-write_managed_cpp_code_component(name(_)) --> [].
-write_managed_cpp_code_component(target_code_input(Rval)) -->
- write_managed_cpp_rval(Rval).
-write_managed_cpp_code_component(target_code_output(Lval)) -->
- write_managed_cpp_lval(Lval).
-
-:- pred write_managed_cpp_rval(mlds__rval, io__state, io__state).
-:- mode write_managed_cpp_rval(in, di, uo) is det.
-write_managed_cpp_rval(lval(Lval)) -->
- write_managed_cpp_lval(Lval).
-write_managed_cpp_rval(mkword(_Tag, _Rval)) -->
- io__write_string(" /* mkword rval -- unimplemented */ ").
-write_managed_cpp_rval(const(RvalConst)) -->
- write_managed_cpp_rval_const(RvalConst).
-write_managed_cpp_rval(unop(Unop, Rval)) -->
- (
- { Unop = std_unop(StdUnop) },
- { c_util__unary_prefix_op(StdUnop, UnopStr) }
- ->
- io__write_string(UnopStr),
- io__write_string("("),
- write_managed_cpp_rval(Rval),
- io__write_string(")")
- ;
- { Unop = cast(Type) }
- ->
- io__write_string("("),
- write_managed_cpp_type(Type),
- io__write_string(") "),
- write_managed_cpp_rval(Rval)
- ;
- io__write_string(" /* XXX box or unbox unop -- unimplemented */ "),
- write_managed_cpp_rval(Rval)
- ).
-write_managed_cpp_rval(binop(Binop, Rval1, Rval2)) -->
- (
- { c_util__binary_infix_op(Binop, BinopStr) }
- ->
- io__write_string("("),
- write_managed_cpp_rval(Rval1),
- io__write_string(") "),
- io__write_string(BinopStr),
- io__write_string(" ("),
- write_managed_cpp_rval(Rval2),
- io__write_string(")")
- ;
- io__write_string(" /* binop rval -- unimplemented */ ")
- ).
-
-write_managed_cpp_rval(mem_addr(_)) -->
- io__write_string(" /* mem_addr rval -- unimplemented */ ").
-
-:- pred write_managed_cpp_rval_const(mlds__rval_const, io__state, io__state).
-:- mode write_managed_cpp_rval_const(in, di, uo) is det.
-write_managed_cpp_rval_const(true) --> io__write_string("1").
-write_managed_cpp_rval_const(false) --> io__write_string("0").
-write_managed_cpp_rval_const(int_const(I)) --> io__write_int(I).
-write_managed_cpp_rval_const(float_const(F)) --> io__write_float(F).
- % XXX We don't quote this correctly.
-write_managed_cpp_rval_const(string_const(S)) -->
- io__write_string(""""),
- io__write_string(S),
- io__write_string("""").
-write_managed_cpp_rval_const(multi_string_const(_L, _S)) -->
- io__write_string(" /* multi_string_const rval -- unimplemented */ ").
-write_managed_cpp_rval_const(code_addr_const(CodeAddrConst)) -->
- (
- { CodeAddrConst = proc(ProcLabel, _FuncSignature) },
- { mangle_mlds_proc_label(ProcLabel, no, ClassName,
- MangledName) },
- write_managed_cpp_class_name(ClassName),
- io__write_string("::"),
- io__write_string(MangledName)
- ;
- { CodeAddrConst = internal(ProcLabel, SeqNum,
- _FuncSignature) },
- { mangle_mlds_proc_label(ProcLabel, yes(SeqNum), ClassName,
- MangledName) },
- write_managed_cpp_class_name(ClassName),
- io__write_string("::"),
- io__write_string(MangledName)
- ).
-
-
-
-write_managed_cpp_rval_const(data_addr_const(_)) -->
- io__write_string(" /* data_addr_const rval -- unimplemented */ ").
-write_managed_cpp_rval_const(null(_)) -->
- io__write_string("0").
-
-:- pred write_managed_cpp_lval(mlds__lval, io__state, io__state).
-:- mode write_managed_cpp_lval(in, di, uo) is det.
-write_managed_cpp_lval(field(_, Rval, named_field(FieldId, _Type), _, _)) -->
- io__write_string("("),
- write_managed_cpp_rval(Rval),
- io__write_string(")"),
- io__write_string("->"),
- { FieldId = qual(_, FieldName) },
- io__write_string(FieldName).
-
-write_managed_cpp_lval(field(_, Rval, offset(OffSet), _, _)) -->
- io__write_string("("),
- write_managed_cpp_rval(Rval),
- io__write_string(")"),
- io__write_string("["),
- write_managed_cpp_rval(OffSet),
- io__write_string("]").
-
-write_managed_cpp_lval(mem_ref(Rval, _)) -->
- io__write_string("*"),
- write_managed_cpp_rval(Rval).
-write_managed_cpp_lval(var(Var, _VarType)) -->
- { mangle_mlds_var(Var, Id) },
- io__write_string(Id).
-
-:- pred write_managed_cpp_defn_decl(mlds__defn, io__state, io__state).
-:- mode write_managed_cpp_defn_decl(in, di, uo) is det.
-write_managed_cpp_defn_decl(Defn) -->
- { Defn = mlds__defn(Name, _Context, _Flags, DefnBody) },
- ( { DefnBody = data(Type, _Initializer) },
- { Name = data(var(VarName)) }
- ->
- write_managed_cpp_type(Type),
- io__write_string(" "),
- io__write_string(VarName),
- io__write_string(";\n")
- ;
- io__write_string("// unimplemented defn decl\n")
- ).
-
-:- pred write_managed_cpp_type(mlds__type, io__state, io__state).
-:- mode write_managed_cpp_type(in, di, uo) is det.
-write_managed_cpp_type(Type) -->
- globals__io_lookup_bool_option(highlevel_data, HighLevelData),
- { DataRep = il_data_rep(HighLevelData) },
- write_il_type_as_managed_cpp_type(
- mlds_type_to_ilds_type(DataRep, Type)).
-
- % XXX this could be more efficient
-:- pred has_target_code_statement(mlds__statement).
-:- mode has_target_code_statement(in) is semidet.
-has_target_code_statement(Statement) :-
- GetTargetCode = (pred(SubStatement::out) is nondet :-
- statement_contains_statement(Statement, SubStatement),
- SubStatement = statement(atomic(target_code(_, _)), _)
- ),
- solutions(GetTargetCode, [_|_]).
-
-
-
-:- pred write_il_ret_type_as_managed_cpp_type(ret_type::in,
- io__state::di, io__state::uo) is det.
-write_il_ret_type_as_managed_cpp_type(void) --> io__write_string("void").
-write_il_ret_type_as_managed_cpp_type(simple_type(T)) -->
- write_il_simple_type_as_managed_cpp_type(T).
-
- % XXX need to revisit this and choose types appropriately
-:- pred write_il_simple_type_as_managed_cpp_type(simple_type::in,
- io__state::di, io__state::uo) is det.
-write_il_simple_type_as_managed_cpp_type(int8) -->
- io__write_string("mercury::MR_Integer8").
-write_il_simple_type_as_managed_cpp_type(int16) -->
- io__write_string("mercury::MR_Integer16").
-write_il_simple_type_as_managed_cpp_type(int32) -->
- io__write_string("mercury::MR_Integer").
-write_il_simple_type_as_managed_cpp_type(int64) -->
- io__write_string("mercury::MR_Integer64").
-write_il_simple_type_as_managed_cpp_type(uint8) -->
- io__write_string("unsigned int").
-write_il_simple_type_as_managed_cpp_type(uint16) -->
- io__write_string("unsigned int").
-write_il_simple_type_as_managed_cpp_type(uint32) -->
- io__write_string("unsigned int").
-write_il_simple_type_as_managed_cpp_type(uint64) -->
- io__write_string("unsigned int").
-write_il_simple_type_as_managed_cpp_type(native_int) -->
- io__write_string("mercury::MR_Integer").
-write_il_simple_type_as_managed_cpp_type(native_uint) -->
- io__write_string("unsigned int").
-write_il_simple_type_as_managed_cpp_type(float32) -->
- io__write_string("float").
-write_il_simple_type_as_managed_cpp_type(float64) -->
- io__write_string("mercury::MR_Float").
-write_il_simple_type_as_managed_cpp_type(native_float) -->
- io__write_string("mercury::MR_Float").
-write_il_simple_type_as_managed_cpp_type(bool) -->
- io__write_string("mercury::MR_Integer").
-write_il_simple_type_as_managed_cpp_type(char) -->
- io__write_string("mercury::MR_Char").
-write_il_simple_type_as_managed_cpp_type(refany) -->
- io__write_string("mercury::MR_RefAny").
-write_il_simple_type_as_managed_cpp_type(class(ClassName)) -->
- ( { ClassName = il_generic_class_name } ->
- io__write_string("mercury::MR_Box")
- ;
- io__write_string("public class "),
- write_managed_cpp_class_name(ClassName),
- io__write_string(" *")
- ).
- % XXX this is not the right syntax
-write_il_simple_type_as_managed_cpp_type(value_class(ClassName)) -->
- io__write_string("value class "),
- write_managed_cpp_class_name(ClassName),
- io__write_string(" *").
- % XXX this is not the right syntax
-write_il_simple_type_as_managed_cpp_type(interface(ClassName)) -->
- io__write_string("interface "),
- write_managed_cpp_class_name(ClassName),
- io__write_string(" *").
- % XXX this needs more work
-write_il_simple_type_as_managed_cpp_type('[]'(_Type, _Bounds)) -->
- io__write_string("mercury::MR_Word").
-write_il_simple_type_as_managed_cpp_type('&'(Type)) -->
- io__write_string("MR_Ref("),
- write_il_type_as_managed_cpp_type(Type),
- io__write_string(")").
-write_il_simple_type_as_managed_cpp_type('*'(Type)) -->
- write_il_type_as_managed_cpp_type(Type),
- io__write_string(" *").
-
-:- pred write_managed_cpp_class_name(structured_name::in, io__state::di,
- io__state::uo) is det.
-write_managed_cpp_class_name(structured_name(_Assembly, DottedName)) -->
- io__write_list(DottedName, "::", io__write_string).
-
-:- pred write_il_type_as_managed_cpp_type(ilds__type::in,
- io__state::di, io__state::uo) is det.
-write_il_type_as_managed_cpp_type(ilds__type(Modifiers, SimpleType)) -->
- io__write_list(Modifiers, " ",
- write_il_type_modifier_as_managed_cpp_type),
- write_il_simple_type_as_managed_cpp_type(SimpleType).
-
-:- pred write_il_type_modifier_as_managed_cpp_type(ilds__type_modifier::in,
- io__state::di, io__state::uo) is det.
-write_il_type_modifier_as_managed_cpp_type(const) -->
- io__write_string("const").
-write_il_type_modifier_as_managed_cpp_type(readonly) -->
- io__write_string("readonly").
-write_il_type_modifier_as_managed_cpp_type(volatile) -->
- io__write_string("volatile").
-
-:- pred write_il_arg_as_managed_cpp_type(pair(ilds__type,
- maybe(ilds__id))::in, io__state::di, io__state::uo) is det.
-write_il_arg_as_managed_cpp_type(Type - MaybeId) -->
- write_il_type_as_managed_cpp_type(Type),
- ( { MaybeId = yes(Id) } ->
- io__write_string(" "),
- io__write_string(Id)
- ;
- % XXX should make up a name!
- { sorry(this_file, "unnamed arguments in method parameters") }
- ).
-
:- func this_file = string.
this_file = "mlds_to_ilasm.m".
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.2
diff -u -r1.2 mlds_to_java.m
--- compiler/mlds_to_java.m 2001/03/01 15:52:35 1.2
+++ compiler/mlds_to_java.m 2001/04/30 13:50:34
@@ -77,33 +77,6 @@
{ Indent = 0 },
output_to_file(JavaSourceFile, output_java_src_file(Indent, MLDS)).
-:- pred output_to_file(string, pred(io__state, io__state),
- io__state, io__state).
-:- mode output_to_file(in, pred(di, uo) is det, di, uo) is det.
-
-output_to_file(FileName, Action) -->
- %
- % XXX This duplicates some code in the high level C backend.
- %
- globals__io_lookup_bool_option(verbose, Verbose),
- globals__io_lookup_bool_option(statistics, Stats),
- maybe_write_string(Verbose, "% Writing to file `"),
- maybe_write_string(Verbose, FileName),
- maybe_write_string(Verbose, "'...\n"),
- maybe_flush_output(Verbose),
- io__tell(FileName, Res),
- ( { Res = ok } ->
- Action,
- io__told,
- maybe_write_string(Verbose, "% done.\n"),
- maybe_report_stats(Stats)
- ;
- maybe_write_string(Verbose, "\n"),
- { string__append_list(["can't open file `",
- FileName, "' for output."], ErrorMessage) },
- report_error(ErrorMessage)
- ).
-
%-----------------------------------------------------------------------------%
%
% Utility predicates for various purposes.
@@ -461,7 +434,8 @@
% Create new argument.
% There is only one as "call" takes an array of Object.
%
- Arg = data(var("args")) - mlds__array_type(mlds__generic_type),
+ Arg = data(var(var_name("args", no))) -
+ mlds__array_type(mlds__generic_type),
Args = [Arg],
%
% Create new declarations for old arguments and assign
@@ -506,7 +480,8 @@
Arg = Name - Type,
Flags = ml_gen_local_var_decl_flags,
ArrayIndex = const(int_const(Count)),
- NewVarName = qual(mercury_module_name_to_mlds(ModuleName), "args"),
+ NewVarName = qual(mercury_module_name_to_mlds(ModuleName),
+ var_name("args", no)),
NewArgLval = var(NewVarName, mlds__generic_type),
%
% Package everything together.
@@ -1174,11 +1149,20 @@
:- pred output_data_name(mlds__data_name, io__state, io__state).
:- mode output_data_name(in, di, uo) is det.
-output_data_name(var(Name)) -->
- output_mangled_name(Name).
+output_data_name(var(VarName)) -->
+ output_mlds_var_name(VarName).
+
output_data_name(common(Num)) -->
io__write_string("common_"),
io__write_int(Num).
+
+:- pred output_mlds_var_name(mlds__var_name, io__state, io__state).
+:- mode output_mlds_var_name(in, di, uo) is det.
+output_mlds_var_name(var_name(Name, no)) -->
+ output_mangled_name(Name).
+output_mlds_var_name(var_name(Name, yes(Num))) -->
+ output_mangled_name(string__format("%s_%d", [s(Name), i(Num)])).
+
%==============================================================================%
% XXX Most of this code doesn't yet work/hasn't been implemented in the Java
% backend.
@@ -1584,7 +1568,7 @@
{ Rval = mlds__lval(Lval) },
{ Lval = var(VarName, _) },
{ VarName = qual(_, UnqualName) },
- { UnqualName = "dummy_var" }
+ { UnqualName = var_name("dummy_var", no) }
->
[]
;
@@ -1817,9 +1801,13 @@
% foreign language interfacing
%
output_atomic_stmt(_Indent, _FuncInfo,
- target_code(_TargetLang, _Components), _Context) -->
+ inline_target_code(_TargetLang, _Components), _Context) -->
{ error("mlds_to_java.m: sorry, foreign language interfacing not implemented") }.
+output_atomic_stmt(_Indent, _FuncInfo,
+ outline_target_code(_TargetLang, _Lvals, _Code), _Context) -->
+ { error("mlds_to_java.m: sorry, foreign language interfacing not implemented") }.
+
%------------------------------------------------------------------------------%
% Output initial values of an object's fields.
@@ -1954,7 +1942,7 @@
output_bracketed_rval(Rval).
output_lval(var(qual(_ModuleName, Name), _VarType)) -->
- io__write_string(Name).
+ output_mlds_var_name(Name).
:- pred output_mangled_name(string, io__state, io__state).
:- mode output_mangled_name(in, di, uo) is det.
Index: compiler/mlds_to_mcpp.m
===================================================================
RCS file: mlds_to_mcpp.m
diff -N mlds_to_mcpp.m
--- /dev/null Mon Apr 16 11:57:05 2001
+++ mlds_to_mcpp.m Mon Apr 30 23:55:59 2001
@@ -0,0 +1,634 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2001 The University of Melbourne.
+% This file may only be copied under the terms of the GNU General
+% Public License - see the file COPYING in the Mercury distribution.
+%-----------------------------------------------------------------------------%
+%
+% mlds_to_mcpp - Generate Managed C++ code for the foreign language
+% interface.
+% Main author: trd.
+%
+% This code converts the MLDS representation of foreign language code into MC++
+
+:- module mlds_to_mcpp.
+:- interface.
+
+:- import_module mlds.
+:- import_module io.
+
+ % Convert the MLDS to MC++ and write it to a file.
+:- pred mlds_to_mcpp__output_mcpp_code(mlds, io__state, io__state).
+:- mode mlds_to_mcpp__output_mcpp_code(in, di, uo) is det.
+
+ % Print the header comments of the output module
+:- pred output_src_start(mercury_module_name, io__state, io__state).
+:- mode output_src_start(in, di, uo) is det.
+
+ % Print the footer commments of the output module
+:- pred output_src_end(mercury_module_name, io__state, io__state).
+:- mode output_src_end(in, di, uo) is det.
+
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+:- import_module globals, options, passes_aux.
+:- import_module builtin_ops, c_util, modules, tree.
+:- import_module hlds_pred. % for `pred_proc_id'.
+:- import_module prog_data, prog_out, llds_out.
+:- import_module rtti, type_util, error_util.
+
+:- import_module ilds, ilasm, il_peephole.
+:- import_module ml_util, ml_code_util.
+:- import_module mlds_to_c. /* to output C code for .cpp files */
+:- use_module llds. /* for user_c_code */
+
+:- import_module bool, int, map, string, list, assoc_list, term, std_util.
+:- import_module library, require, counter.
+
+:- import_module mlds_to_il.
+
+%-----------------------------------------------------------------------------%
+
+output_mcpp_code(MLDS) -->
+ { MLDS = mlds(ModuleName, _ForeignCode, _Imports, _Defns) },
+ output_src_start(ModuleName),
+ io__nl,
+
+ generate_mcplusplus_code(MLDS),
+
+ output_src_end(ModuleName).
+
+output_src_start(ModuleName) -->
+ { library__version(Version) },
+ { prog_out__sym_name_to_string(ModuleName, ModuleNameStr) },
+ io__write_strings(
+ ["//\n// Automatically generated from `",
+ ModuleNameStr,
+ ".m' by the\n",
+ "// Mercury compiler, version ",
+ Version,
+ ".\n",
+ "// Do not edit.\n",
+ "\n\n"]).
+
+output_src_end(ModuleName) -->
+ io__write_string("// End of module: "),
+ prog_out__write_sym_name(ModuleName),
+ io__write_string(". \n").
+
+%-----------------------------------------------------------------------------%
+
+ % This section could very nearly be turned into a
+ % mlds_to_managed_cpp module, which turns MLDS into managed C++.
+ % Note that it relies on quite a few predicates in mlds_to_il.
+ % XXX we should clean up the dependencies.
+ % XXX we don't output contexts for any of this.
+:- pred generate_mcplusplus_code(mlds, io__state, io__state).
+:- mode generate_mcplusplus_code(in, di, uo) is det.
+generate_mcplusplus_code(MLDS) -->
+
+ { MLDS = mlds(ModuleName, ForeignCode, _Imports, Defns) },
+ { prog_out__sym_name_to_string(ModuleName, ModuleNameStr) },
+ { ClassName = mlds_module_name_to_class_name(
+ mercury_module_name_to_mlds(ModuleName)) },
+
+ io__nl,
+ io__write_strings([
+ "#using <mscorlib.dll>\n",
+ "#include ""mercury_mcpp.h""\n",
+ "#using ""mercury_mcpp.dll""\n",
+ "#using ""mercury_il.dll""\n",
+ "#using """, ModuleNameStr, ".dll""\n",
+
+ % XXX We have to use the mercury namespace, as
+ % llds_out still generates some of the code used in the
+ % MC++ interface, and so it doesn't have "mercury::"
+ % namespace qualifiers.
+ "using namespace mercury;\n",
+
+ % XXX this supresses problems caused by references to
+ % float. If you don't do this, you'll get link errors.
+ % Revisit this when the .NET implementation has matured.
+ "extern ""C"" int _fltused=0;\n",
+ "\n"]),
+
+ { Namespace = get_class_namespace(ClassName) },
+
+ io__write_list(Namespace, "\n",
+ (pred(N::in, di, uo) is det -->
+ io__format("namespace %s {", [s(N)])
+ )),
+
+ generate_foreign_header_code(mercury_module_name_to_mlds(ModuleName),
+ ForeignCode),
+
+ io__write_strings([
+ "\n__gc public class ", ModuleNameStr, "__c_code\n",
+ "{\n",
+ "public:\n"]),
+
+
+ % Output the contents of foreign_code declarations.
+ generate_foreign_code(mercury_module_name_to_mlds(ModuleName),
+ ForeignCode),
+
+ % Output the contents of foreign_proc declarations.
+ % Put each one inside a method.
+ list__foldl(generate_method_c_code(
+ mercury_module_name_to_mlds(ModuleName)), Defns),
+
+ io__write_string("};\n"),
+
+ % Close the namespace braces.
+ io__write_list(Namespace, "\n",
+ (pred(_N::in, di, uo) is det -->
+ io__write_string("}")
+ )),
+
+
+ io__nl.
+
+
+ % XXX we don't handle export decls.
+:- pred generate_foreign_code(mlds_module_name, mlds__foreign_code,
+ io__state, io__state).
+:- mode generate_foreign_code(in, in, di, uo) is det.
+generate_foreign_code(_ModuleName,
+ mlds__foreign_code(_RevHeaderCode, RevBodyCode,
+ _ExportDefns)) -->
+ { BodyCode = list__reverse(RevBodyCode) },
+ io__write_list(BodyCode, "\n",
+ (pred(llds__user_foreign_code(Lang, Code, Context)::in,
+ di, uo) is det -->
+ ( { Lang = managed_cplusplus } ->
+ mlds_to_c__output_context(mlds__make_context(
+ Context)),
+ io__write_string(Code)
+ ;
+ % ignore it if it isn't MC++
+ []
+ )
+ )).
+
+ % XXX we don't handle export decls.
+:- pred generate_foreign_header_code(mlds_module_name, mlds__foreign_code,
+ io__state, io__state).
+:- mode generate_foreign_header_code(in, in, di, uo) is det.
+generate_foreign_header_code(_ModuleName,
+ mlds__foreign_code(RevHeaderCode, _RevBodyCode,
+ _ExportDefns)) -->
+ { HeaderCode = list__reverse(RevHeaderCode) },
+ io__write_list(HeaderCode, "\n",
+ (pred(llds__foreign_decl_code(Lang, Code, _Context)::in,
+ di, uo) is det -->
+ ( { Lang = managed_cplusplus } ->
+ io__write_string(Code)
+ ;
+ % ignore it if it isn't MC++
+ []
+ )
+ )).
+
+:- pred generate_method_c_code(mlds_module_name, mlds__defn,
+ io__state, io__state).
+:- mode generate_method_c_code(in, in, di, uo) is det.
+
+ % XXX we don't handle export
+generate_method_c_code(_, defn(export(_), _, _, _)) --> [].
+generate_method_c_code(_, defn(data(_), _, _, _)) --> [].
+generate_method_c_code(_, defn(type(_, _), _, _, _)) --> [].
+generate_method_c_code(ModuleName,
+ defn(function(PredLabel, ProcId, MaybeSeqNum, _PredId),
+ _Context, _DeclFlags, Entity)) -->
+ (
+ { Entity = mlds__function(_, Params, yes(Statement)) },
+ (
+ { has_inline_target_code_statement(Statement) }
+ ;
+ { has_foreign_languages(Statement, Langs) },
+ { list__member(managed_cplusplus, Langs) }
+ )
+ ->
+ globals__io_lookup_bool_option(highlevel_data, HighLevelData),
+ { DataRep = il_data_rep(HighLevelData) },
+ { ILSignature = params_to_il_signature(DataRep, ModuleName,
+ Params) },
+ { predlabel_to_id(PredLabel, ProcId, MaybeSeqNum, Id) },
+ io__write_string("static "),
+ { ILSignature = signature(_CallConv, ReturnType, ILArgs) },
+ write_il_ret_type_as_managed_cpp_type(ReturnType),
+
+ io__write_string(" "),
+
+ io__write_string(Id),
+ io__write_string("("),
+ io__write_list(ILArgs, ", ", write_il_arg_as_managed_cpp_type),
+ io__write_string(")"),
+ io__nl,
+
+ io__write_string("{\n"),
+ write_managed_cpp_statement(Statement),
+ io__write_string("}\n")
+ ;
+ []
+ ).
+
+ % In order to implement the C interface, you need to
+ % implement:
+ % call/6 (for calling continuations)
+ % return/1 (for returning succeeded)
+ % block/2 (because the code is wrapped in a block, and
+ % because local variables are declared for
+ % "succeeded")
+ % target_code/2 (where the actual code is put)
+ % assign/2 (to assign to the environment)
+ % newobj/7 (to create an environment)
+ %
+ % Unfortunately currently some of the "raw_target_code" is
+ % C specific and won't translate well into managed C++.
+ % Probably the best solution to this is to introduce some new
+ % code components.
+ %
+ % Note that for the managed C++ backend there is a problem.
+ % #import doesn't import classes in namespaces properly (yet), so we
+ % can't #import .dlls that define environments. So even if we
+ % implement newobj/7, we will get errors.
+ % The work-around for this is to make sure ml_elim_nested
+ % doesn't introduce environments where they aren't needed,
+ % so we don't generally have to allocate anything but the local
+ % environment (which is defined locally).
+
+:- pred write_managed_cpp_statement(mlds__statement,
+ io__state, io__state).
+:- mode write_managed_cpp_statement(in, di, uo) is det.
+write_managed_cpp_statement(Statement) -->
+ globals__io_lookup_bool_option(highlevel_data, HighLevelData),
+ (
+ % XXX this ignores the language target.
+ { Statement = statement(atomic(inline_target_code(
+ _Lang, CodeComponents)), _) }
+ ->
+ io__write_list(CodeComponents, "\n",
+ write_managed_cpp_code_component)
+ ;
+ { Statement = statement(block(Defns, Statements), _) }
+ ->
+ io__write_list(Defns, "", write_managed_cpp_defn_decl),
+ io__write_string("{\n"),
+ io__write_list(Statements, "", write_managed_cpp_statement),
+ io__write_string("}\n")
+ ;
+ { Statement = statement(
+ call(_Sig, Function, _This, Args, Results, _IsTail),
+ _Context) }
+ ->
+ % XXX this doesn't work for continuations because
+ % a) I don't know how to call a function pointer in
+ % managed C++.
+ % b) Function pointers are represented as integers,
+ % and we don't do any casting for them.
+ % The nondet interface might need to be reworked in
+ % this case.
+ % The workaround at the moment is to make sure we don't
+ % actually generate calls to continuations in managed
+ % C++, instead we generate a nested function that is
+ % implemented in IL that does the continuation call, and
+ % just call the nested function instead. Sneaky, eh?
+ ( { Results = [] } ->
+ []
+ ; { Results = [Lval] } ->
+ write_managed_cpp_lval(Lval),
+ io__write_string(" = ")
+ ;
+ { sorry(this_file, "multiple return values") }
+ ),
+ write_managed_cpp_rval(Function),
+ io__write_string("("),
+ io__write_list(Args, ", ", write_managed_cpp_rval),
+ io__write_string(");\n")
+ ;
+ { Statement = statement(return(Rvals), _) }
+ ->
+ ( { Rvals = [Rval] } ->
+ io__write_string("return "),
+ write_managed_cpp_rval(Rval),
+ io__write_string(";\n")
+ ;
+ { sorry(this_file, "multiple return values") }
+ )
+ ;
+ { Statement = statement(atomic(assign(Lval, Rval)), _) }
+ ->
+ write_managed_cpp_lval(Lval),
+ io__write_string(" = "),
+ write_managed_cpp_rval(Rval),
+ io__write_string(";\n")
+ ;
+
+ % XXX This is not fully implemented
+ { Statement = statement(atomic(
+ new_object(Target, _MaybeTag, Type, _MaybeSize,
+ _MaybeCtorName, _Args, _ArgTypes)), _) },
+ { ClassName = mlds_type_to_ilds_class_name(
+ il_data_rep(HighLevelData), Type) }
+ ->
+ write_managed_cpp_lval(Target),
+ io__write_string(" = new "),
+ write_managed_cpp_class_name(ClassName),
+ io__write_string("();\n")
+ ;
+ { Statement = statement(atomic(Atomic), _) }
+ ->
+ { functor(Atomic, AtomicFunctor, Arity) },
+ io__write_string("// unimplemented: atomic "),
+ io__write_string(AtomicFunctor),
+ io__write_string("/"),
+ io__write(Arity),
+ io__nl
+
+ ;
+ { Statement = statement(S, _) },
+ { functor(S, SFunctor, Arity) },
+ io__write_string("// unimplemented: "),
+ io__write_string(SFunctor),
+ io__write_string("/"),
+ io__write(Arity),
+ io__nl
+ ).
+
+ % XXX we ignore contexts
+:- pred write_managed_cpp_code_component(mlds__target_code_component,
+ io__state, io__state).
+:- mode write_managed_cpp_code_component(in, di, uo) is det.
+write_managed_cpp_code_component(user_target_code(Code, _MaybeContext)) -->
+ io__write_string(Code).
+write_managed_cpp_code_component(raw_target_code(Code)) -->
+ io__write_string(Code).
+ % XXX we don't handle name yet.
+write_managed_cpp_code_component(name(_)) --> [].
+write_managed_cpp_code_component(target_code_input(Rval)) -->
+ write_managed_cpp_rval(Rval).
+write_managed_cpp_code_component(target_code_output(Lval)) -->
+ write_managed_cpp_lval(Lval).
+
+:- pred write_managed_cpp_rval(mlds__rval, io__state, io__state).
+:- mode write_managed_cpp_rval(in, di, uo) is det.
+write_managed_cpp_rval(lval(Lval)) -->
+ write_managed_cpp_lval(Lval).
+write_managed_cpp_rval(mkword(_Tag, _Rval)) -->
+ io__write_string(" /* mkword rval -- unimplemented */ ").
+write_managed_cpp_rval(const(RvalConst)) -->
+ write_managed_cpp_rval_const(RvalConst).
+write_managed_cpp_rval(unop(Unop, Rval)) -->
+ (
+ { Unop = std_unop(StdUnop) },
+ { c_util__unary_prefix_op(StdUnop, UnopStr) }
+ ->
+ io__write_string(UnopStr),
+ io__write_string("("),
+ write_managed_cpp_rval(Rval),
+ io__write_string(")")
+ ;
+ { Unop = cast(Type) }
+ ->
+ io__write_string("("),
+ write_managed_cpp_type(Type),
+ io__write_string(") "),
+ write_managed_cpp_rval(Rval)
+ ;
+ io__write_string(" /* XXX box or unbox unop -- unimplemented */ "),
+ write_managed_cpp_rval(Rval)
+ ).
+write_managed_cpp_rval(binop(Binop, Rval1, Rval2)) -->
+ (
+ { c_util__binary_infix_op(Binop, BinopStr) }
+ ->
+ io__write_string("("),
+ write_managed_cpp_rval(Rval1),
+ io__write_string(") "),
+ io__write_string(BinopStr),
+ io__write_string(" ("),
+ write_managed_cpp_rval(Rval2),
+ io__write_string(")")
+ ;
+ io__write_string(" /* binop rval -- unimplemented */ ")
+ ).
+
+write_managed_cpp_rval(mem_addr(_)) -->
+ io__write_string(" /* mem_addr rval -- unimplemented */ ").
+
+:- pred write_managed_cpp_rval_const(mlds__rval_const, io__state, io__state).
+:- mode write_managed_cpp_rval_const(in, di, uo) is det.
+write_managed_cpp_rval_const(true) --> io__write_string("1").
+write_managed_cpp_rval_const(false) --> io__write_string("0").
+write_managed_cpp_rval_const(int_const(I)) --> io__write_int(I).
+write_managed_cpp_rval_const(float_const(F)) --> io__write_float(F).
+ % XXX We don't quote this correctly.
+write_managed_cpp_rval_const(string_const(S)) -->
+ io__write_string(""""),
+ io__write_string(S),
+ io__write_string("""").
+write_managed_cpp_rval_const(multi_string_const(_L, _S)) -->
+ io__write_string(" /* multi_string_const rval -- unimplemented */ ").
+write_managed_cpp_rval_const(code_addr_const(CodeAddrConst)) -->
+ (
+ { CodeAddrConst = proc(ProcLabel, _FuncSignature) },
+ { mangle_mlds_proc_label(ProcLabel, no, ClassName,
+ MangledName) },
+ write_managed_cpp_class_name(ClassName),
+ io__write_string("::"),
+ io__write_string(MangledName)
+ ;
+ { CodeAddrConst = internal(ProcLabel, SeqNum,
+ _FuncSignature) },
+ { mangle_mlds_proc_label(ProcLabel, yes(SeqNum), ClassName,
+ MangledName) },
+ write_managed_cpp_class_name(ClassName),
+ io__write_string("::"),
+ io__write_string(MangledName)
+ ).
+
+
+
+write_managed_cpp_rval_const(data_addr_const(_)) -->
+ io__write_string(" /* data_addr_const rval -- unimplemented */ ").
+write_managed_cpp_rval_const(null(_)) -->
+ io__write_string("0").
+
+:- pred write_managed_cpp_lval(mlds__lval, io__state, io__state).
+:- mode write_managed_cpp_lval(in, di, uo) is det.
+write_managed_cpp_lval(field(_, Rval, named_field(FieldId, _Type), _, _)) -->
+ io__write_string("("),
+ write_managed_cpp_rval(Rval),
+ io__write_string(")"),
+ io__write_string("->"),
+ { FieldId = qual(_, FieldName) },
+ io__write_string(FieldName).
+
+write_managed_cpp_lval(field(_, Rval, offset(OffSet), _, _)) -->
+ io__write_string("("),
+ write_managed_cpp_rval(Rval),
+ io__write_string(")"),
+ io__write_string("["),
+ write_managed_cpp_rval(OffSet),
+ io__write_string("]").
+
+write_managed_cpp_lval(mem_ref(Rval, _)) -->
+ io__write_string("*"),
+ write_managed_cpp_rval(Rval).
+write_managed_cpp_lval(var(Var, _VarType)) -->
+ { mangle_mlds_var(Var, Id) },
+ io__write_string(Id).
+
+:- pred write_managed_cpp_defn_decl(mlds__defn, io__state, io__state).
+:- mode write_managed_cpp_defn_decl(in, di, uo) is det.
+write_managed_cpp_defn_decl(Defn) -->
+ { Defn = mlds__defn(Name, _Context, _Flags, DefnBody) },
+ ( { DefnBody = data(Type, _Initializer) },
+ { Name = data(var(VarName)) }
+ ->
+ write_managed_cpp_type(Type),
+ io__write_string(" "),
+ write_mlds_varname(VarName),
+ io__write_string(";\n")
+ ;
+ io__write_string("// unimplemented defn decl\n")
+ ).
+
+:- pred write_mlds_varname(mlds__var_name, io__state, io__state).
+:- mode write_mlds_varname(in, di, uo) is det.
+write_mlds_varname(var_name(Var, yes(Num))) -->
+ io__format("%s_%d", [s(Var), i(Num)]).
+write_mlds_varname(var_name(Var, no)) -->
+ io__write_string(Var).
+
+:- pred write_managed_cpp_type(mlds__type, io__state, io__state).
+:- mode write_managed_cpp_type(in, di, uo) is det.
+write_managed_cpp_type(Type) -->
+ globals__io_lookup_bool_option(highlevel_data, HighLevelData),
+ { DataRep = il_data_rep(HighLevelData) },
+ write_il_type_as_managed_cpp_type(
+ mlds_type_to_ilds_type(DataRep, Type)).
+
+ % XXX this could be more efficient
+:- pred has_inline_target_code_statement(mlds__statement).
+:- mode has_inline_target_code_statement(in) is semidet.
+has_inline_target_code_statement(Statement) :-
+ GetTargetCode = (pred(SubStatement::out) is nondet :-
+ statement_contains_statement(Statement, SubStatement),
+ SubStatement = statement(atomic(inline_target_code(_, _)), _)
+ ),
+ solutions(GetTargetCode, [_|_]).
+
+
+
+:- pred write_il_ret_type_as_managed_cpp_type(ret_type::in,
+ io__state::di, io__state::uo) is det.
+write_il_ret_type_as_managed_cpp_type(void) --> io__write_string("void").
+write_il_ret_type_as_managed_cpp_type(simple_type(T)) -->
+ write_il_simple_type_as_managed_cpp_type(T).
+
+ % XXX need to revisit this and choose types appropriately
+:- pred write_il_simple_type_as_managed_cpp_type(simple_type::in,
+ io__state::di, io__state::uo) is det.
+write_il_simple_type_as_managed_cpp_type(int8) -->
+ io__write_string("mercury::MR_Integer8").
+write_il_simple_type_as_managed_cpp_type(int16) -->
+ io__write_string("mercury::MR_Integer16").
+write_il_simple_type_as_managed_cpp_type(int32) -->
+ io__write_string("mercury::MR_Integer").
+write_il_simple_type_as_managed_cpp_type(int64) -->
+ io__write_string("mercury::MR_Integer64").
+write_il_simple_type_as_managed_cpp_type(uint8) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_managed_cpp_type(uint16) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_managed_cpp_type(uint32) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_managed_cpp_type(uint64) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_managed_cpp_type(native_int) -->
+ io__write_string("mercury::MR_Integer").
+write_il_simple_type_as_managed_cpp_type(native_uint) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_managed_cpp_type(float32) -->
+ io__write_string("float").
+write_il_simple_type_as_managed_cpp_type(float64) -->
+ io__write_string("mercury::MR_Float").
+write_il_simple_type_as_managed_cpp_type(native_float) -->
+ io__write_string("mercury::MR_Float").
+write_il_simple_type_as_managed_cpp_type(bool) -->
+ io__write_string("mercury::MR_Integer").
+write_il_simple_type_as_managed_cpp_type(char) -->
+ io__write_string("mercury::MR_Char").
+write_il_simple_type_as_managed_cpp_type(refany) -->
+ io__write_string("mercury::MR_RefAny").
+write_il_simple_type_as_managed_cpp_type(class(ClassName)) -->
+ ( { ClassName = il_generic_class_name } ->
+ io__write_string("mercury::MR_Box")
+ ;
+ io__write_string("public class "),
+ write_managed_cpp_class_name(ClassName),
+ io__write_string(" *")
+ ).
+ % XXX this is not the right syntax
+write_il_simple_type_as_managed_cpp_type(value_class(ClassName)) -->
+ io__write_string("value class "),
+ write_managed_cpp_class_name(ClassName),
+ io__write_string(" *").
+ % XXX this is not the right syntax
+write_il_simple_type_as_managed_cpp_type(interface(ClassName)) -->
+ io__write_string("interface "),
+ write_managed_cpp_class_name(ClassName),
+ io__write_string(" *").
+ % XXX this needs more work
+write_il_simple_type_as_managed_cpp_type('[]'(_Type, _Bounds)) -->
+ io__write_string("mercury::MR_Word").
+write_il_simple_type_as_managed_cpp_type('&'(Type)) -->
+ io__write_string("MR_Ref("),
+ write_il_type_as_managed_cpp_type(Type),
+ io__write_string(")").
+write_il_simple_type_as_managed_cpp_type('*'(Type)) -->
+ write_il_type_as_managed_cpp_type(Type),
+ io__write_string(" *").
+
+:- pred write_managed_cpp_class_name(structured_name::in, io__state::di,
+ io__state::uo) is det.
+write_managed_cpp_class_name(structured_name(_Assembly, DottedName)) -->
+ io__write_list(DottedName, "::", io__write_string).
+
+:- pred write_il_type_as_managed_cpp_type(ilds__type::in,
+ io__state::di, io__state::uo) is det.
+write_il_type_as_managed_cpp_type(ilds__type(Modifiers, SimpleType)) -->
+ io__write_list(Modifiers, " ",
+ write_il_type_modifier_as_managed_cpp_type),
+ write_il_simple_type_as_managed_cpp_type(SimpleType).
+
+:- pred write_il_type_modifier_as_managed_cpp_type(ilds__type_modifier::in,
+ io__state::di, io__state::uo) is det.
+write_il_type_modifier_as_managed_cpp_type(const) -->
+ io__write_string("const").
+write_il_type_modifier_as_managed_cpp_type(readonly) -->
+ io__write_string("readonly").
+write_il_type_modifier_as_managed_cpp_type(volatile) -->
+ io__write_string("volatile").
+
+:- pred write_il_arg_as_managed_cpp_type(pair(ilds__type,
+ maybe(ilds__id))::in, io__state::di, io__state::uo) is det.
+write_il_arg_as_managed_cpp_type(Type - MaybeId) -->
+ write_il_type_as_managed_cpp_type(Type),
+ ( { MaybeId = yes(Id) } ->
+ io__write_string(" "),
+ io__write_string(Id)
+ ;
+ % XXX should make up a name!
+ { sorry(this_file, "unnamed arguments in method parameters") }
+ ).
+
+
+:- func this_file = string.
+this_file = "mlds_to_mcpp.m".
+
Index: compiler/options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/options.m,v
retrieving revision 1.319
diff -u -r1.319 options.m
--- compiler/options.m 2001/04/27 03:41:15 1.319
+++ compiler/options.m 2001/04/30 13:50:34
@@ -1014,6 +1014,7 @@
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("agc-stack-layout", agc_stack_layout).
long_option("basic-stack-layout", basic_stack_layout).
long_option("procid-stack-layout", procid_stack_layout).
Index: compiler/passes_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/passes_aux.m,v
retrieving revision 1.39
diff -u -r1.39 passes_aux.m
--- compiler/passes_aux.m 2001/03/08 06:54:31 1.39
+++ compiler/passes_aux.m 2001/04/30 13:50:34
@@ -156,7 +156,20 @@
:- pred report_pred_name_mode(pred_or_func, string, list((mode)),
io__state, io__state).
:- mode report_pred_name_mode(in, in, in, di, uo) is det.
-
+
+ % Write to a given filename, giving appropriate status
+ % messages and error messages if the file cannot be opened.
+:- pred output_to_file(string, pred(io__state, io__state),
+ io__state, io__state).
+:- mode output_to_file(in, pred(di, uo) is det, di, uo) is det.
+
+ % Same as output_to_file/4 above, but allow the writing predicate
+ % to generate some output.
+:- pred output_to_file(string, pred(T, io__state, io__state),
+ maybe(T), io__state, io__state).
+:- mode output_to_file(in, pred(out, di, uo) is det, out, di, uo) is det.
+
+
%-----------------------------------------------------------------------------%
:- type quote_char
@@ -552,5 +565,33 @@
),
io__write_string(" = "),
mercury_output_mode(FuncRetMode, InstVarSet).
+
+%-----------------------------------------------------------------------------%
+
+output_to_file(FileName, Action) -->
+ { NewAction = (pred(0::out, di, uo) is det --> Action ) },
+ output_to_file(FileName, NewAction, _Result).
+
+output_to_file(FileName, Action, Result) -->
+ globals__io_lookup_bool_option(verbose, Verbose),
+ globals__io_lookup_bool_option(statistics, Stats),
+ maybe_write_string(Verbose, "% Writing to file `"),
+ maybe_write_string(Verbose, FileName),
+ maybe_write_string(Verbose, "'...\n"),
+ maybe_flush_output(Verbose),
+ io__tell(FileName, Res),
+ ( { Res = ok } ->
+ Action(ActionResult),
+ io__told,
+ maybe_write_string(Verbose, "% done.\n"),
+ maybe_report_stats(Stats),
+ { Result = yes(ActionResult) }
+ ;
+ maybe_write_string(Verbose, "\n"),
+ { string__append_list(["can't open file `",
+ FileName, "' for output."], ErrorMessage) },
+ report_error(ErrorMessage),
+ { Result = no }
+ ).
%-----------------------------------------------------------------------------%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.65
diff -u -r1.65 prog_data.m
--- compiler/prog_data.m 2001/04/03 03:20:15 1.65
+++ compiler/prog_data.m 2001/04/30 13:50:34
@@ -107,7 +107,7 @@
:- type foreign_language
---> c
% ; cplusplus
-% ; csharp
+ ; csharp
; managed_cplusplus
% ; java
% ; il
Index: compiler/rtti_to_mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/rtti_to_mlds.m,v
retrieving revision 1.12
diff -u -r1.12 rtti_to_mlds.m
--- compiler/rtti_to_mlds.m 2001/02/20 07:52:19 1.12
+++ compiler/rtti_to_mlds.m 2001/04/30 13:50:34
@@ -568,7 +568,7 @@
% Perhaps we should be using an enumeration type here,
% rather than `mlds__native_int_type'.
Type = mlds__native_int_type,
- Rval = lval(var(qual(MLDS_Module, Name), Type)).
+ Rval = lval(var(qual(MLDS_Module, var_name(Name, no)), Type)).
%-----------------------------------------------------------------------------%
%
--
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