[m-rev.] for review: improve MC++ support
Peter Ross
pro at missioncriticalit.com
Tue May 21 00:41:10 AEST 2002
Hi,
For Fergus or Tyson to review.
===================================================================
Estimated hours taken: 16
Branches: main
Output Managed C++ code using the same mechanisms as we do for C# code,
rather than using pragma_c_gen to generate MC++ code. This fixes the
problem that functions couldn't be defined in MC++, and also should make
the code more maintainable in the future as MC++ is much more similar to
C# than to C.
compiler/mlds_to_managed.m:
Generalise mlds_to_csharp so that it can also output valid MC++
code.
compiler/ml_code_gen.m:
Use the context of the string which contains the pragma foreign
proc body for the context of the foreign proc. This ensures that
error messages refer to the correct line number.
Generate a foreign proc for MC++ the same way we generate a foreign
proc for C#.
compiler/mlds_to_il.m:
Allow functions in MC++.
compiler/mlds_to_ilasm.m:
Changes required to move to using mlds_to_managed.
Delete some now unnecessary imports from the llds backend.
compiler/ml_backend.m:
Add the new module and remove mlds_to_mcpp and mlds_to_csharp.
compiler/mlds_to_csharp.m:
compiler/mlds_to_mcpp.m:
Deleted files whose functionality has been subsumed by
mlds_to_managed.
library/construct.m:
library/exception.m:
library/io.m:
library/rtti_implementation.m:
library/std_util.m:
Changes required to get the library to be able compile in the ilc
grade. These consist of
- getting rid of references to anonymous variables
- giving variables which are passed by reference an initial value
- adding a missing ; in std_util.
Index: compiler/ml_backend.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_backend.m,v
retrieving revision 1.1
diff -u -r1.1 ml_backend.m
--- compiler/ml_backend.m 20 Mar 2002 12:36:44 -0000 1.1
+++ compiler/ml_backend.m 20 May 2002 14:17:36 -0000
@@ -64,8 +64,7 @@
% MLDS->.NET CLR back-end
:- include_module mlds_to_il.
:- include_module mlds_to_ilasm.
-:- include_module mlds_to_csharp.
-:- include_module mlds_to_mcpp.
+:- include_module mlds_to_managed.
:- include_module ilds.
:- include_module ilasm.
:- include_module il_peephole.
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.114
diff -u -r1.114 ml_code_gen.m
--- compiler/ml_code_gen.m 7 May 2002 11:03:02 -0000 1.114
+++ compiler/ml_code_gen.m 20 May 2002 14:17:41 -0000
@@ -783,7 +783,6 @@
:- import_module ml_backend__ml_type_gen, ml_backend__ml_call_gen.
:- import_module ml_backend__ml_unify_gen, ml_backend__ml_switch_gen.
:- import_module ml_backend__ml_code_util.
-:- import_module ll_backend__llds. % XXX needed for pragma backend_libs__foreign code
:- import_module backend_libs__export.
:- import_module backend_libs__foreign. % XXX needed for pragma foreign code
:- import_module hlds__hlds_pred, hlds__hlds_data.
@@ -2093,10 +2092,14 @@
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes, PragmaImpl),
CodeModel, OuterContext, MLDS_Decls, MLDS_Statements) -->
(
- { PragmaImpl = ordinary(Foreign_Code, _MaybeContext) },
+ { PragmaImpl = ordinary(Foreign_Code, MaybeContext) },
+ { MaybeContext = yes(Context)
+ ; MaybeContext = no,
+ Context = OuterContext
+ },
ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
- Foreign_Code, OuterContext, MLDS_Decls,
+ Foreign_Code, Context, MLDS_Decls,
MLDS_Statements)
;
{ PragmaImpl = nondet(
@@ -2350,11 +2353,11 @@
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
; { Lang = managed_cplusplus },
- ml_gen_ordinary_pragma_c_proc(CodeModel, Attributes,
+ ml_gen_ordinary_pragma_managed_proc(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
; { Lang = csharp },
- ml_gen_ordinary_pragma_csharp_proc(CodeModel, Attributes,
+ ml_gen_ordinary_pragma_managed_proc(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
; { Lang = il },
@@ -2363,20 +2366,20 @@
Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
).
-:- pred ml_gen_ordinary_pragma_csharp_proc(code_model,
+:- pred ml_gen_ordinary_pragma_managed_proc(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_proc(in, in, in, in, in, in,
+:- mode ml_gen_ordinary_pragma_managed_proc(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#,
+ % For ordinary (not model_non) pragma foreign_code in C# or MC++,
% we generate a call to an out-of-line procedure that contains
% the user's code.
-ml_gen_ordinary_pragma_csharp_proc(CodeModel, Attributes,
+ml_gen_ordinary_pragma_managed_proc(CodeModel, Attributes,
_PredId, _ProcId, _ArgVars, _ArgDatas, _OrigArgTypes,
ForeignCode, Context, MLDS_Decls, MLDS_Statements) -->
{ foreign_language(Attributes, ForeignLang) },
Index: compiler/mlds_to_csharp.m
===================================================================
RCS file: compiler/mlds_to_csharp.m
diff -N compiler/mlds_to_csharp.m
--- compiler/mlds_to_csharp.m 20 Mar 2002 12:36:50 -0000 1.22
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,568 +0,0 @@
-%-----------------------------------------------------------------------------%
-% Copyright (C) 2001-2002 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 ml_backend__mlds_to_csharp.
-:- interface.
-
-:- import_module ml_backend__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 libs__globals, libs__options, hlds__passes_aux.
-:- import_module backend_libs__builtin_ops, backend_libs__c_util.
-:- import_module parse_tree__modules, libs__tree.
-:- import_module hlds__hlds_pred. % for `pred_proc_id'.
-:- import_module parse_tree__prog_data, parse_tree__prog_out.
-:- import_module backend_libs__foreign, backend_libs__rtti.
-:- import_module check_hlds__type_util, hlds__error_util.
-
-:- import_module ml_backend__ilds, ml_backend__ilasm, ml_backend__il_peephole.
-:- import_module ml_backend__ml_util, ml_backend__ml_code_util.
-
-:- import_module bool, int, map, string, list, assoc_list, term, std_util.
-:- import_module library, require, counter.
-
-:- import_module ml_backend__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_csharp_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").
-
-%-----------------------------------------------------------------------------%
-
- % XXX we don't output contexts for any of this.
-:- pred generate_csharp_code(mlds, io__state, io__state).
-:- mode generate_csharp_code(in, di, uo) is det.
-generate_csharp_code(MLDS) -->
-
- { MLDS = mlds(ModuleName, AllForeignCode, _Imports, Defns) },
- { ClassName = class_name(mercury_module_name_to_mlds(ModuleName),
- wrapper_class_name) },
-
- io__nl,
- io__write_strings([
- % XXX We may be able to drop the mercury namespace soon,
- % as there doesn't appear to be any llds generated code in
- % the C# code anymore.
- "using mercury;\n",
- "\n"]),
-
- % Get the foreign code for C#
- { ForeignCode = map__lookup(AllForeignCode, csharp) },
- generate_foreign_header_code(mercury_module_name_to_mlds(ModuleName),
- ForeignCode),
-
- globals__io_lookup_bool_option(sign_assembly, SignAssembly),
- ( { SignAssembly = yes },
- io__write_string("[assembly:System.Reflection.AssemblyKeyFileAttribute(\"mercury.sn\")]\n")
- ; { SignAssembly = no },
- []
- ),
-
- { Namespace0 = get_class_namespace(ClassName) },
- { list__reverse(Namespace0) = [Head | Tail] ->
- Namespace = list__reverse([Head ++ "__csharp_code" | Tail])
- ;
- Namespace = Namespace0
- },
-
- % XXX we should consider what happens if we need to mangle
- % the namespace name.
- io__write_list(Namespace, "\n",
- (pred(N::in, di, uo) is det -->
- io__format("namespace @%s {", [s(N)])
- )),
-
- io__write_strings([
- "\npublic class " ++ wrapper_class_name,
- "{\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_csharp_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 or
- % `:- pragma foreign_import_module'.
-:- 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, _RevImports, RevBodyCode,
- _ExportDefns)) -->
- { BodyCode = list__reverse(RevBodyCode) },
- io__write_list(BodyCode, "\n",
- (pred(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 or
- % `:- pragma foreign_import_module'.
-:- 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, _RevImports, _RevBodyCode,
- _ExportDefns)) -->
- { HeaderCode = list__reverse(RevHeaderCode) },
- io__write_list(HeaderCode, "\n",
- (pred(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_csharp_code(mlds_module_name, mlds__defn,
- io__state, io__state).
-:- mode generate_method_csharp_code(in, in, di, uo) is det.
-
- % XXX we don't handle export
-generate_method_csharp_code(_, defn(export(_), _, _, _)) --> [].
-generate_method_csharp_code(_, defn(data(_), _, _, _)) --> [].
-generate_method_csharp_code(_, defn(type(_, _), _, _, _)) --> [].
-generate_method_csharp_code(_ModuleName,
- defn(function(PredLabel, ProcId, MaybeSeqNum, _PredId),
- _Context, _DeclFlags, Entity)) -->
-
- (
- % XXX we ignore the attributes
- { Entity = mlds__function(_, Params, defined_here(Statement),
- _Attributes) },
- { has_foreign_languages(Statement, Langs) },
- { list__member(csharp, Langs) }
- ->
- get_il_data_rep(DataRep),
- { 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)
- ;
- % C# and IL don'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_foreign_proc(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") }
- )
- ;
- { Statement = atomic(assign(LVal, RVal)) }
- ->
- write_csharp_lval(LVal),
- io__write_string(" = "),
- write_csharp_rval(RVal),
- io__write_string(";\n")
- ;
- { functor(Statement, SFunctor, _Arity) },
- { sorry(this_file, "csharp output for " ++ SFunctor) }
- ).
-
-%-------------------------------------------------------------------
-% 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, _Attrrs)) -->
- io__write_string(Code).
-write_csharp_code_component(raw_target_code(Code, _Attrs)) -->
- 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)) -->
- { sorry(this_file, "mkword rval") }.
-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)
- ;
- { sorry(this_file, "box or unbox unop") }
- ).
-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(")")
- ;
- { sorry(this_file, "binop rval") }
- ).
-
-write_csharp_rval(mem_addr(_)) -->
- { sorry(this_file, "mem_addr rval") }.
-
-write_csharp_rval(self(_)) -->
- { sorry(this_file, "self rval") }.
-
-:- 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(""""),
- c_util__output_quoted_string(S),
- io__write_string("""").
-write_csharp_rval_const(multi_string_const(L, S)) -->
- io__write_string(""""),
- c_util__output_quoted_multi_string(L, S),
- io__write_string("""").
-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(_)) -->
- { sorry(this_file, "data_addr_const rval") }.
-write_csharp_rval_const(null(_)) -->
- io__write_string("null").
-
-:- 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, _GC_TraceCode) },
- { Name = data(var(VarName)) }
- ->
- write_csharp_parameter_type(Type),
- io__write_string(" "),
- write_mlds_var_name_for_parameter(VarName),
- io__write_string(";\n")
- ;
- % XXX we should implement others
- { sorry(this_file, "data_addr_const rval") }
- ).
-
-:- 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) -->
- get_il_data_rep(DataRep),
- { 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("sbyte").
-write_il_simple_type_as_csharp_type(int16) -->
- io__write_string("short").
-write_il_simple_type_as_csharp_type(int32) -->
- io__write_string("int").
-write_il_simple_type_as_csharp_type(int64) -->
- io__write_string("long").
-write_il_simple_type_as_csharp_type(uint8) -->
- io__write_string("byte").
-write_il_simple_type_as_csharp_type(uint16) -->
- io__write_string("ushort").
-write_il_simple_type_as_csharp_type(uint32) -->
- io__write_string("uint").
-write_il_simple_type_as_csharp_type(uint64) -->
- io__write_string("ulong").
-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("uint").
-write_il_simple_type_as_csharp_type(float32) -->
- io__write_string("float").
-write_il_simple_type_as_csharp_type(float64) -->
- io__write_string("double").
-write_il_simple_type_as_csharp_type(native_float) -->
- io__write_string("float").
-write_il_simple_type_as_csharp_type(bool) -->
- io__write_string("bool").
-write_il_simple_type_as_csharp_type(char) -->
- io__write_string("char").
-write_il_simple_type_as_csharp_type(string) -->
- io__write_string("string").
-write_il_simple_type_as_csharp_type(object) -->
- io__write_string("object").
-write_il_simple_type_as_csharp_type(refany) -->
- io__write_string("mercury.MR_RefAny").
-write_il_simple_type_as_csharp_type(class(ClassName)) -->
- write_csharp_class_name(ClassName).
-write_il_simple_type_as_csharp_type(valuetype(_ClassName)) -->
- { sorry(this_file, "value classes") }.
-write_il_simple_type_as_csharp_type(interface(_ClassName)) -->
- { sorry(this_file, "interfaces") }.
-write_il_simple_type_as_csharp_type('[]'(Type, Bounds)) -->
- write_il_type_as_csharp_type(Type),
- io__write_string("[]"),
- ( { Bounds = [] } ->
- []
- ;
- { sorry(this_file, "arrays with bounds") }
- ).
-write_il_simple_type_as_csharp_type('&'(Type)) -->
- % XXX is this always right?
- io__write_string("ref "),
- 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, NestedClasses)) -->
- io__write_list(DottedName ++ NestedClasses, ".", 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(mlds__argument::in,
- io__state::di, io__state::uo) is det.
-write_input_arg_as_csharp_type(Arg) -->
- { Arg = mlds__argument(EntityName, Type, _GC_TraceCode) },
- get_il_data_rep(DataRep),
- 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.114
diff -u -r1.114 mlds_to_il.m
--- compiler/mlds_to_il.m 7 May 2002 11:03:07 -0000 1.114
+++ compiler/mlds_to_il.m 20 May 2002 14:17:47 -0000
@@ -1912,7 +1912,9 @@
; RetType = simple_type(bool) ->
StoreReturnInstr = instr_node(stloc(name("succeeded")))
;
- sorry(this_file, "functions in MC++")
+ StoreReturnInstr = empty
},
MethodName =^ method_name,
{ assoc_list__keys(Params, TypeParams) },
Index: compiler/mlds_to_ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
retrieving revision 1.17
diff -u -r1.17 mlds_to_ilasm.m
--- compiler/mlds_to_ilasm.m 20 Mar 2002 12:36:52 -0000 1.17
+++ compiler/mlds_to_ilasm.m 20 May 2002 14:17:47 -0000
@@ -33,14 +33,11 @@
:- import_module parse_tree__modules, libs__tree.
:- import_module hlds__hlds_pred. % for `pred_proc_id'.
:- import_module parse_tree__prog_data, parse_tree__prog_out.
-:- import_module ll_backend__llds_out.
:- import_module backend_libs__rtti, check_hlds__type_util, hlds__error_util.
:- import_module ml_backend__ilds, ml_backend__ilasm, ml_backend__il_peephole.
:- import_module ml_backend__ml_util, ml_backend__ml_code_util.
-:- import_module ml_backend__mlds_to_csharp. /* to output C sharp code */
-:- import_module ml_backend__mlds_to_mcpp. /* to output MC++ code */
-:- use_module ll_backend__llds. /* for user_c_code */
+:- import_module ml_backend__mlds_to_managed.
:- import_module bool, int, map, string, set, list, assoc_list, term, std_util.
:- import_module library, require, counter.
@@ -81,8 +78,9 @@
pred(mlds, io__state, io__state)::out(pred(in, di, uo) is det))
is det.
-handle_foreign_lang(managed_cplusplus, "__cpp_code.cpp", output_mcpp_code).
-handle_foreign_lang(csharp, "__csharp_code.cs", output_csharp_code).
+handle_foreign_lang(managed_cplusplus, "__cpp_code.cpp",
+ output_managed_code(managed_cplusplus)).
+handle_foreign_lang(csharp, "__csharp_code.cs", output_managed_code(csharp)).
handle_foreign_lang(c, _, _) :-
sorry(this_file, "language C foreign code not supported").
handle_foreign_lang(il, _, _) :-
Index: compiler/mlds_to_managed.m
===================================================================
RCS file: compiler/mlds_to_managed.m
diff -N compiler/mlds_to_managed.m
--- /dev/null 1 Jan 1970 00:00:00 -0000
+++ compiler/mlds_to_managed.m 20 May 2002 14:17:47 -0000
@@ -0,0 +1,787 @@
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2002 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.
+%-----------------------------------------------------------------------------%
+%
+% Module: mlds_to_managed
+% Main author: trd, petdr.
+%
+% Generate code for the foreign language interface to C# and managed C++.
+%
+
+:- module ml_backend__mlds_to_managed.
+:- interface.
+
+:- import_module ml_backend__mlds.
+:- import_module libs__globals.
+:- import_module io.
+
+:- inst managed_lang == bound(csharp; managed_cplusplus).
+
+ % Convert the MLDS to the specified foreign language and write
+ % it to a file.
+:- pred output_managed_code(foreign_language, mlds, io__state, io__state).
+:- mode output_managed_code(in(managed_lang), 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 libs__globals, libs__options, hlds__passes_aux.
+:- import_module backend_libs__builtin_ops, backend_libs__c_util.
+:- import_module parse_tree__modules, libs__tree.
+:- import_module hlds__hlds_pred. % for `pred_proc_id'.
+:- import_module parse_tree__prog_data, parse_tree__prog_out.
+:- import_module backend_libs__foreign, backend_libs__rtti.
+:- import_module check_hlds__type_util, hlds__error_util.
+
+:- import_module ml_backend__ilds, ml_backend__ilasm, ml_backend__il_peephole.
+:- import_module ml_backend__ml_util, ml_backend__ml_code_util.
+
+:- import_module bool, int, map, string, list, assoc_list, term, std_util.
+:- import_module library, require, counter.
+
+:- import_module ml_backend__mlds_to_il.
+
+output_managed_code(Lang, MLDS) -->
+ { MLDS = mlds(ModuleName, _ForeignCode, _Imports, _Defns) },
+ output_src_start(ModuleName),
+ io__nl,
+
+ generate_code(Lang, 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").
+
+%-----------------------------------------------------------------------------%
+
+:- pred generate_code(foreign_language, mlds, io__state, io__state).
+:- mode generate_code(in(managed_lang), in, di, uo) is det.
+
+generate_code(Lang, MLDS) -->
+
+ { MLDS = mlds(ModuleName, AllForeignCode, _Imports, Defns) },
+ { ClassName = class_name(mercury_module_name_to_mlds(ModuleName),
+ wrapper_class_name) },
+
+ io__nl,
+
+ % Output any generic header code specific to the target
+ % language.
+ output_language_specific_header_code(Lang, ModuleName),
+
+ % Get the foreign code for the required language.
+ { ForeignCode = map__lookup(AllForeignCode, Lang) },
+ generate_foreign_header_code(Lang,
+ mercury_module_name_to_mlds(ModuleName), ForeignCode),
+
+ % Output the namespace.
+ { generate_namespace_details(Lang, ClassName,
+ NameSpaceFmtStr, Namespace) },
+ io__write_list(Namespace, "\n",
+ (pred(N::in, di, uo) is det -->
+ io__format(NameSpaceFmtStr, [s(N)])
+ )),
+
+ ( { Lang = csharp },
+ io__write_strings([
+ "\npublic class " ++ wrapper_class_name,
+ "{\n"])
+ ; { Lang = managed_cplusplus },
+ io__write_strings([
+ "\n__gc public class " ++ wrapper_class_name,
+ "{\n",
+ "public:\n"])
+ ),
+
+ % Output the contents of pragma foreign_code declarations.
+ generate_foreign_code(Lang,
+ 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_code(Lang,
+ 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.
+
+:- pred output_language_specific_header_code(foreign_language::in(managed_lang),
+ mercury_module_name::in, io::di, io::uo) is det.
+
+output_language_specific_header_code(csharp, _ModuleName) -->
+ io__write_strings([
+ % XXX We may be able to drop the mercury namespace soon,
+ % as there doesn't appear to be any llds generated code
+ % in the C# code anymore.
+ "using mercury;\n",
+ "\n"]),
+
+ globals__io_lookup_bool_option(sign_assembly, SignAssembly),
+ ( { SignAssembly = yes },
+ io__write_string(
+"[assembly:System.Reflection.AssemblyKeyFileAttribute(\"mercury.sn\")]\n")
+ ; { SignAssembly = no },
+ []
+ ).
+output_language_specific_header_code(managed_cplusplus, ModuleName) -->
+ { prog_out__sym_name_to_string(ModuleName, ModuleNameStr) },
+ 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"]),
+
+ globals__io_lookup_bool_option(sign_assembly, SignAssembly),
+ ( { SignAssembly = yes },
+ io__write_string(
+"[assembly:System::Reflection::AssemblyKeyFileAttribute(\"mercury.sn\")];\n")
+ ; { SignAssembly = no },
+ []
+ ).
+
+
+ % XXX we don't handle `:- pragma foreign_import_module'.
+:- pred generate_foreign_header_code(foreign_language::in(managed_lang),
+ mlds_module_name::in, mlds__foreign_code::in,
+ io__state::di, io__state::uo) is det.
+
+generate_foreign_header_code(Lang, _ModuleName,
+ mlds__foreign_code(RevHeaderCode, _RevImports, _RevBodyCode,
+ _ExportDefns)) -->
+ { HeaderCode = list__reverse(RevHeaderCode) },
+ io__write_list(HeaderCode, "\n",
+ (pred(foreign_decl_code(CodeLang, Code, Context)::in,
+ di, uo) is det -->
+ output_context(Lang, Context),
+ ( { CodeLang = Lang } ->
+ io__write_string(Code)
+ ;
+ { sorry(this_file, "wrong foreign code") }
+ ),
+ output_reset_context(Lang)
+ )).
+
+:- pred generate_namespace_details(foreign_language::in(managed_lang),
+ ilds__class_name::in,
+ string::out, list(string)::out) is det.
+
+generate_namespace_details(Lang, ClassName, NameSpaceFmtStr, Namespace) :-
+ % XXX we should consider what happens if we need to mangle
+ % the namespace name.
+ ( Lang = csharp,
+ NameExt = "__csharp_code",
+ NameSpaceFmtStr = "namespace @%s {"
+ ; Lang = managed_cplusplus,
+ NameExt = "__cpp_code",
+ NameSpaceFmtStr = "namespace %s {"
+ ),
+
+ Namespace0 = get_class_namespace(ClassName),
+ ( list__reverse(Namespace0) = [Head | Tail] ->
+ Namespace = list__reverse([Head ++ NameExt | Tail])
+ ;
+ Namespace = Namespace0
+ ).
+
+ % XXX we don't handle `:- pragma foreign_import_module'.
+:- pred generate_foreign_code(foreign_language::in(managed_lang),
+ mlds_module_name::in, mlds__foreign_code::in,
+ io__state::di, io__state::uo) is det.
+
+generate_foreign_code(Lang, _ModuleName,
+ mlds__foreign_code(_RevHeaderCode, _RevImports, RevBodyCode,
+ _ExportDefns)) -->
+ { BodyCode = list__reverse(RevBodyCode) },
+ io__write_list(BodyCode, "\n",
+ (pred(user_foreign_code(CodeLang, Code, Context)::in,
+ di, uo) is det -->
+ output_context(Lang, Context),
+ ( { Lang = CodeLang } ->
+ io__write_string(Code)
+ ;
+ { sorry(this_file, "wrong foreign code") }
+ ),
+ output_reset_context(Lang)
+ )).
+
+:- pred generate_method_code(foreign_language::in(managed_lang),
+ mlds_module_name::in, mlds__defn::in,
+ io__state::di, io__state::uo) is det.
+
+generate_method_code(_, _, defn(export(_), _, _, _)) --> [].
+generate_method_code(_, _, defn(data(_), _, _, _)) --> [].
+generate_method_code(_, _, defn(type(_, _), _, _, _)) --> [].
+generate_method_code(Lang, _ModuleName,
+ defn(function(PredLabel, ProcId, MaybeSeqNum, _PredId),
+ _Context, _DeclFlags, Entity)) -->
+
+ (
+ % XXX we ignore the attributes
+ { Entity = mlds__function(_, Params, defined_here(Statement),
+ _Attributes) },
+ { has_foreign_languages(Statement, Langs) },
+ { list__member(Lang, Langs) }
+ ->
+ get_il_data_rep(DataRep),
+ { 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)
+ ;
+ % C# and MC++ don't support multiple return values
+ sorry(this_file, "multiple return values")
+ },
+
+
+ { predlabel_to_id(PredLabel, ProcId, MaybeSeqNum, Id) },
+ ( { Lang = csharp },
+ io__write_string("public static ")
+ ; { Lang = managed_cplusplus },
+ io__write_string("static ")
+ ),
+ write_il_ret_type_as_foreign_type(Lang, ReturnType),
+
+ io__write_string(" "),
+
+ io__write_string(Id),
+ io__write_string("("),
+ io__write_list(Inputs, ", ",
+ write_input_arg_as_foreign_type(Lang)),
+ io__write_string(")"),
+ io__nl,
+
+ io__write_string("{\n"),
+ write_statement(Lang, Inputs, Statement),
+ io__write_string("}\n")
+ ;
+ []
+ ).
+
+:- pred write_statement(foreign_language::in(managed_lang),
+ mlds__arguments::in, mlds__statement::in,
+ io__state::di, io__state::uo) is det.
+write_statement(Lang, Args, statement(Statement, Context)) -->
+ (
+ { Statement = atomic(outline_foreign_proc(Lang, _Lvals, Code)) }
+ ->
+ list__foldl(write_declare_and_assign_local(Lang), Args),
+ output_context(Lang, get_prog_context(Context)),
+ io__write_string(Code),
+ io__nl,
+ output_reset_context(Lang),
+ list__foldl(write_assign_local_to_output(Lang), Args)
+ ;
+ { Statement = block(Defns, Statements) }
+ ->
+ io__write_list(Defns, "", write_defn_decl(Lang)),
+ io__write_string("{\n"),
+ io__write_list(Statements, "", write_statement(Lang, Args)),
+ io__write_string("\n}\n")
+ ;
+ { Statement = return(Rvals) }
+ ->
+ ( { Rvals = [Rval] } ->
+ io__write_string("return "),
+ write_rval(Lang, Rval),
+ io__write_string(";\n")
+ ;
+ { sorry(this_file, "multiple return values") }
+ )
+ ;
+ { Statement = atomic(assign(LVal, RVal)) }
+ ->
+ write_lval(Lang, LVal),
+ io__write_string(" = "),
+ write_rval(Lang, RVal),
+ io__write_string(";\n")
+ ;
+ { functor(Statement, SFunctor, _Arity) },
+ { sorry(this_file, "foreign code output for " ++ SFunctor) }
+ ).
+
+:- pred write_declare_and_assign_local(foreign_language::in(managed_lang),
+ mlds__argument::in, io::di, io::uo) is det.
+
+write_declare_and_assign_local(Lang, argument(Name, Type, _GcCode)) -->
+ { Name = data(var(VarName0)) ->
+ VarName = VarName0
+ ;
+ unexpected(this_file, "not a variable name")
+ },
+
+ % A pointer type is an output type.
+ ( { Type = mlds__ptr_type(OutputType) } ->
+ ( { is_anonymous_variable(VarName) } ->
+ []
+ ;
+ write_parameter_type(Lang, OutputType),
+ io__write_string(" "),
+ write_mlds_var_name_for_local(VarName),
+ io__write_string(";\n")
+ )
+ ;
+ write_parameter_type(Lang, Type),
+ io__write_string(" "),
+ write_mlds_var_name_for_local(VarName),
+ io__write_string(" = "),
+ write_mlds_var_name_for_parameter(VarName),
+ io__write_string(";\n")
+ ).
+
+:- pred write_assign_local_to_output(foreign_language::in(managed_lang),
+ mlds__argument::in, io::di, io::uo) is det.
+
+write_assign_local_to_output(Lang, argument(Name, Type, _GcCode)) -->
+ { Name = data(var(VarName0)) ->
+ VarName = VarName0
+ ;
+ unexpected(this_file, "not a variable name")
+ },
+
+ % A pointer type is an output type.
+ (
+ { Type = mlds__ptr_type(_OutputType) },
+ { not is_anonymous_variable(VarName) }
+ ->
+ ( { Lang = csharp },
+ []
+ ; { Lang = managed_cplusplus },
+ io__write_string("*")
+ ),
+ write_mlds_var_name_for_parameter(VarName),
+ io__write_string(" = "),
+ write_mlds_var_name_for_local(VarName),
+ io__write_string(";\n")
+ ;
+ []
+ ).
+
+:- pred is_anonymous_variable(var_name::in) is semidet.
+
+is_anonymous_variable(var_name(Name, _)) :-
+ string__prefix(Name, "_").
+
+%------------------------------------------------------------------------------%
+
+:- pred output_context(foreign_language::in(managed_lang), prog_context::in,
+ io__state::di, io__state::uo) is det.
+
+output_context(_Lang, Context) -->
+ { term__context_file(Context, File) },
+ { term__context_line(Context, Line) },
+ c_util__set_line_num(File, Line).
+
+:- pred output_reset_context(foreign_language::in(managed_lang),
+ io__state::di, io__state::uo) is det.
+
+output_reset_context(_) -->
+ c_util__reset_line_num.
+
+
+:- pred write_rval(foreign_language, mlds__rval, io__state, io__state).
+:- mode write_rval(in(managed_lang), in, di, uo) is det.
+
+write_rval(Lang, lval(Lval)) -->
+ write_lval(Lang, Lval).
+write_rval(_Lang, mkword(_Tag, _Rval)) -->
+ { sorry(this_file, "mkword rval") }.
+write_rval(Lang, const(RvalConst)) -->
+ write_rval_const(Lang, RvalConst).
+write_rval(Lang, unop(Unop, Rval)) -->
+ (
+ { Unop = std_unop(StdUnop) },
+ { c_util__unary_prefix_op(StdUnop, UnopStr) }
+ ->
+ io__write_string(UnopStr),
+ io__write_string("("),
+ write_rval(Lang, Rval),
+ io__write_string(")")
+ ;
+ { Unop = cast(Type) }
+ ->
+ io__write_string("("),
+ write_parameter_type(Lang, Type),
+ io__write_string(") "),
+ write_rval(Lang, Rval)
+ ;
+ { sorry(this_file, "box or unbox unop") }
+ ).
+write_rval(Lang, binop(Binop, Rval1, Rval2)) -->
+ (
+ { c_util__binary_infix_op(Binop, BinopStr) }
+ ->
+ io__write_string("("),
+ write_rval(Lang, Rval1),
+ io__write_string(") "),
+ io__write_string(BinopStr),
+ io__write_string(" ("),
+ write_rval(Lang, Rval2),
+ io__write_string(")")
+ ;
+ { sorry(this_file, "binop rval") }
+ ).
+
+write_rval(_Lang, mem_addr(_)) -->
+ { sorry(this_file, "mem_addr rval") }.
+
+write_rval(_Lang, self(_)) -->
+ { sorry(this_file, "self rval") }.
+
+:- pred write_rval_const(foreign_language, mlds__rval_const, io, io).
+:- mode write_rval_const(in(managed_lang), in, di, uo) is det.
+
+write_rval_const(_Lang, true) --> io__write_string("1").
+write_rval_const(_Lang, false) --> io__write_string("0").
+write_rval_const(_Lang, int_const(I)) --> io__write_int(I).
+write_rval_const(_Lang, float_const(F)) --> io__write_float(F).
+ % XXX We don't quote this correctly.
+write_rval_const(_Lang, string_const(S)) -->
+ io__write_string(""""),
+ c_util__output_quoted_string(S),
+ io__write_string("""").
+write_rval_const(_Lang, multi_string_const(L, S)) -->
+ io__write_string(""""),
+ c_util__output_quoted_multi_string(L, S),
+ io__write_string("""").
+write_rval_const(Lang, code_addr_const(CodeAddrConst)) -->
+ (
+ { CodeAddrConst = proc(ProcLabel, _FuncSignature) },
+ { mangle_mlds_proc_label(ProcLabel, no, ClassName,
+ MangledName) },
+ write_class_name(Lang, ClassName),
+ write_field_selector(Lang),
+ io__write_string(MangledName)
+ ;
+ { CodeAddrConst = internal(ProcLabel, SeqNum,
+ _FuncSignature) },
+ { mangle_mlds_proc_label(ProcLabel, yes(SeqNum), ClassName,
+ MangledName) },
+ write_class_name(Lang, ClassName),
+ write_field_selector(Lang),
+ io__write_string(MangledName)
+ ).
+write_rval_const(_Lang, data_addr_const(_)) -->
+ { sorry(this_file, "data_addr_const rval") }.
+write_rval_const(Lang, null(_)) -->
+ ( { Lang = csharp },
+ io__write_string("null")
+ ; { Lang = managed_cplusplus },
+ io__write_string("NULL")
+ ).
+
+:- pred write_lval(foreign_language, mlds__lval, io__state, io__state).
+:- mode write_lval(in(managed_lang), in, di, uo) is det.
+
+write_lval(Lang, field(_, Rval, named_field(FieldId, _Type), _, _)) -->
+ io__write_string("("),
+ write_rval(Lang, Rval),
+ io__write_string(")"),
+ write_field_selector(Lang),
+ { FieldId = qual(_, FieldName) },
+ io__write_string(FieldName).
+write_lval(Lang, field(_, Rval, offset(OffSet), _, _)) -->
+ io__write_string("("),
+ write_rval(Lang, Rval),
+ io__write_string(")"),
+ io__write_string("["),
+ write_rval(Lang, OffSet),
+ io__write_string("]").
+write_lval(Lang, mem_ref(Rval, _)) -->
+ % XXX This looks wrong for C#
+ io__write_string("*"),
+ write_rval(Lang, Rval).
+write_lval(_Lang, var(Var, _VarType)) -->
+ { Var = qual(_, VarName) },
+ write_mlds_var_name_for_local(VarName).
+
+:- pred write_field_selector(foreign_language::in(managed_lang),
+ io__state::di, io__state::uo) is det.
+
+write_field_selector(csharp) -->
+ io__write_string(".").
+write_field_selector(managed_cplusplus) -->
+ io__write_string("->").
+
+:- pred write_defn_decl(foreign_language, mlds__defn, io__state, io__state).
+:- mode write_defn_decl(in(managed_lang), in, di, uo) is det.
+
+write_defn_decl(Lang, Defn) -->
+ { Defn = mlds__defn(Name, _Context, _Flags, DefnBody) },
+ (
+ { DefnBody = data(Type, _Initializer, _GC_TraceCode) },
+ { Name = data(var(VarName)) }
+ ->
+ write_parameter_type(Lang, Type),
+ io__write_string(" "),
+ write_mlds_var_name_for_local(VarName),
+ io__write_string(";\n")
+ ;
+ % XXX we should implement others
+ { sorry(this_file, "data_addr_const rval") }
+ ).
+
+:- pred write_parameter_type(foreign_language, mlds__type, io, io).
+:- mode write_parameter_type(in(managed_lang), in, di, uo) is det.
+
+write_parameter_type(Lang, Type) -->
+ get_il_data_rep(DataRep),
+ { ILType = mlds_type_to_ilds_type(DataRep, Type) },
+ write_il_type_as_foreign_type(Lang, ILType).
+
+:- pred write_input_arg_as_foreign_type(foreign_language::in(managed_lang),
+ mlds__argument::in, io__state::di, io__state::uo) is det.
+write_input_arg_as_foreign_type(Lang, Arg) -->
+ { Arg = mlds__argument(EntityName, Type, _GC_TraceCode) },
+ get_il_data_rep(DataRep),
+ write_il_type_as_foreign_type(Lang,
+ 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_il_ret_type_as_foreign_type(foreign_language::in(managed_lang),
+ ret_type::in, io__state::di, io__state::uo) is det.
+
+write_il_ret_type_as_foreign_type(_Lang, void) -->
+ io__write_string("void").
+write_il_ret_type_as_foreign_type(Lang, simple_type(T)) -->
+ write_il_simple_type_as_foreign_type(Lang, T).
+
+:- pred write_il_type_as_foreign_type(foreign_language::in(managed_lang),
+ ilds__type::in, io__state::di, io__state::uo) is det.
+
+write_il_type_as_foreign_type(Lang, ilds__type(Modifiers, SimpleType)) -->
+ io__write_list(Modifiers, " ",
+ write_il_type_modifier_as_foreign_type(Lang)),
+ write_il_simple_type_as_foreign_type(Lang, SimpleType).
+
+:- pred write_il_type_modifier_as_foreign_type(
+ foreign_language::in(managed_lang), ilds__type_modifier::in,
+ io__state::di, io__state::uo) is det.
+
+write_il_type_modifier_as_foreign_type(_Lang, const) -->
+ io__write_string("const").
+write_il_type_modifier_as_foreign_type(_Lang, readonly) -->
+ io__write_string("readonly").
+write_il_type_modifier_as_foreign_type(_Lang, volatile) -->
+ io__write_string("volatile").
+
+ % XXX need to revisit this and choose types appropriately
+:- pred write_il_simple_type_as_foreign_type(foreign_language::in(managed_lang),
+ simple_type::in, io__state::di, io__state::uo) is det.
+
+write_il_simple_type_as_foreign_type(csharp, int8) -->
+ io__write_string("sbyte").
+write_il_simple_type_as_foreign_type(csharp, int16) -->
+ io__write_string("short").
+write_il_simple_type_as_foreign_type(csharp, int32) -->
+ io__write_string("int").
+write_il_simple_type_as_foreign_type(csharp, int64) -->
+ io__write_string("long").
+write_il_simple_type_as_foreign_type(csharp, uint8) -->
+ io__write_string("byte").
+write_il_simple_type_as_foreign_type(csharp, uint16) -->
+ io__write_string("ushort").
+write_il_simple_type_as_foreign_type(csharp, uint32) -->
+ io__write_string("uint").
+write_il_simple_type_as_foreign_type(csharp, uint64) -->
+ io__write_string("ulong").
+write_il_simple_type_as_foreign_type(csharp, native_int) -->
+ io__write_string("int").
+write_il_simple_type_as_foreign_type(csharp, native_uint) -->
+ io__write_string("uint").
+write_il_simple_type_as_foreign_type(csharp, float32) -->
+ io__write_string("float").
+write_il_simple_type_as_foreign_type(csharp, float64) -->
+ io__write_string("double").
+write_il_simple_type_as_foreign_type(csharp, native_float) -->
+ io__write_string("float").
+write_il_simple_type_as_foreign_type(csharp, bool) -->
+ io__write_string("bool").
+write_il_simple_type_as_foreign_type(csharp, char) -->
+ io__write_string("char").
+write_il_simple_type_as_foreign_type(csharp, string) -->
+ io__write_string("string").
+write_il_simple_type_as_foreign_type(csharp, object) -->
+ io__write_string("object").
+write_il_simple_type_as_foreign_type(csharp, refany) -->
+ io__write_string("mercury.MR_RefAny").
+write_il_simple_type_as_foreign_type(csharp, class(ClassName)) -->
+ write_class_name(csharp, ClassName).
+write_il_simple_type_as_foreign_type(csharp, valuetype(ClassName)) -->
+ write_class_name(csharp, ClassName).
+write_il_simple_type_as_foreign_type(csharp, interface(_ClassName)) -->
+ { sorry(this_file, "interfaces") }.
+write_il_simple_type_as_foreign_type(csharp, '[]'(Type, Bounds)) -->
+ write_il_type_as_foreign_type(csharp, Type),
+ io__write_string("[]"),
+ ( { Bounds = [] } ->
+ []
+ ;
+ { sorry(this_file, "arrays with bounds") }
+ ).
+write_il_simple_type_as_foreign_type(csharp, '&'(Type)) -->
+ % XXX is this always right?
+ io__write_string("ref "),
+ write_il_type_as_foreign_type(csharp, Type).
+write_il_simple_type_as_foreign_type(csharp, '*'(Type)) -->
+ write_il_type_as_foreign_type(csharp, Type),
+ io__write_string(" *").
+
+write_il_simple_type_as_foreign_type(managed_cplusplus, int8) -->
+ io__write_string("mercury::MR_Integer8").
+write_il_simple_type_as_foreign_type(managed_cplusplus, int16) -->
+ io__write_string("mercury::MR_Integer16").
+write_il_simple_type_as_foreign_type(managed_cplusplus, int32) -->
+ io__write_string("mercury::MR_Integer").
+write_il_simple_type_as_foreign_type(managed_cplusplus, int64) -->
+ io__write_string("mercury::MR_Integer64").
+write_il_simple_type_as_foreign_type(managed_cplusplus, uint8) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_foreign_type(managed_cplusplus, uint16) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_foreign_type(managed_cplusplus, uint32) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_foreign_type(managed_cplusplus, uint64) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_foreign_type(managed_cplusplus, native_int) -->
+ io__write_string("mercury::MR_Integer").
+write_il_simple_type_as_foreign_type(managed_cplusplus, native_uint) -->
+ io__write_string("unsigned int").
+write_il_simple_type_as_foreign_type(managed_cplusplus, float32) -->
+ io__write_string("float").
+write_il_simple_type_as_foreign_type(managed_cplusplus, float64) -->
+ io__write_string("mercury::MR_Float").
+write_il_simple_type_as_foreign_type(managed_cplusplus, native_float) -->
+ io__write_string("mercury::MR_Float").
+write_il_simple_type_as_foreign_type(managed_cplusplus, bool) -->
+ io__write_string("mercury::MR_Bool").
+write_il_simple_type_as_foreign_type(managed_cplusplus, char) -->
+ io__write_string("mercury::MR_Char").
+write_il_simple_type_as_foreign_type(managed_cplusplus, string) -->
+ io__write_string("mercury::MR_String").
+write_il_simple_type_as_foreign_type(managed_cplusplus, object) -->
+ io__write_string("mercury::MR_Box").
+write_il_simple_type_as_foreign_type(managed_cplusplus, refany) -->
+ io__write_string("mercury::MR_RefAny").
+write_il_simple_type_as_foreign_type(managed_cplusplus, class(ClassName)) -->
+ ( { ClassName = il_generic_class_name } ->
+ io__write_string("mercury::MR_Box")
+ ;
+ io__write_string("public class "),
+ write_class_name(managed_cplusplus, ClassName),
+ io__write_string(" *")
+ ).
+write_il_simple_type_as_foreign_type(managed_cplusplus,
+ valuetype(ClassName)) -->
+ io__write_string("__value class "),
+ write_class_name(managed_cplusplus, ClassName).
+ % XXX this is not the right syntax
+write_il_simple_type_as_foreign_type(managed_cplusplus,
+ interface(ClassName)) -->
+ io__write_string("interface "),
+ write_class_name(managed_cplusplus, ClassName),
+ io__write_string(" *").
+ % XXX this needs more work
+write_il_simple_type_as_foreign_type(managed_cplusplus,
+ '[]'(_Type, _Bounds)) -->
+ io__write_string("mercury::MR_Word").
+write_il_simple_type_as_foreign_type(managed_cplusplus, '&'(Type)) -->
+ io__write_string("MR_Ref("),
+ write_il_type_as_foreign_type(managed_cplusplus, Type),
+ io__write_string(")").
+write_il_simple_type_as_foreign_type(managed_cplusplus, '*'(Type)) -->
+ write_il_type_as_foreign_type(managed_cplusplus, Type),
+ io__write_string(" *").
+
+:- pred write_class_name(foreign_language::in(managed_lang),
+ structured_name::in, io__state::di, io__state::uo) is det.
+write_class_name(Lang, structured_name(_Asm, DottedName, NestedClasses)) -->
+ { Lang = csharp,
+ Sep = "."
+ ; Lang = managed_cplusplus,
+ Sep = "::"
+ },
+ io__write_list(DottedName ++ NestedClasses, Sep, io__write_string).
+
+:- 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).
+
+:- 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, MaybeNum)) -->
+ io__write_string(Name),
+ ( { MaybeNum = yes(Num) } ->
+ io__write_string("_"),
+ io__write_int(Num)
+ ;
+ []
+ ).
+
+:- func this_file = string.
+this_file = "mlds_to_managed.m".
+
+:- end_module ml_backend__mlds_to_managed.
Index: compiler/mlds_to_mcpp.m
===================================================================
RCS file: compiler/mlds_to_mcpp.m
diff -N compiler/mlds_to_mcpp.m
--- compiler/mlds_to_mcpp.m 20 Mar 2002 12:36:53 -0000 1.26
+++ /dev/null 1 Jan 1970 00:00:00 -0000
@@ -1,662 +0,0 @@
-%-----------------------------------------------------------------------------%
-% Copyright (C) 2001-2002 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.
-%
-% To-do:
-%
-% [ ] Fix the output of contexts so that the context gets reset after the
-% user code.
-% [ ] Output contexts in more places, currently we don't do all of them.
-%
-% This code converts the MLDS representation of foreign language code into MC++
-
-:- module ml_backend__mlds_to_mcpp.
-:- interface.
-
-:- import_module ml_backend__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 libs__globals, libs__options, hlds__passes_aux.
-:- import_module backend_libs__builtin_ops, backend_libs__c_util.
-:- import_module parse_tree__modules, libs__tree.
-:- import_module hlds__hlds_pred. % for `pred_proc_id'.
-:- import_module parse_tree__prog_data, parse_tree__prog_out.
-:- import_module ll_backend__llds_out.
-:- import_module backend_libs__foreign, backend_libs__rtti.
-:- import_module check_hlds__type_util, hlds__error_util.
-
-:- import_module ml_backend__ilds, ml_backend__ilasm, ml_backend__il_peephole.
-:- import_module ml_backend__ml_util, ml_backend__ml_code_util.
-:- import_module ml_backend__mlds_to_c. /* to output C code for .cpp files */
-:- use_module ll_backend__llds. /* for user_c_code */
-
-:- import_module bool, int, map, string, list, assoc_list, term, std_util.
-:- import_module library, require, counter.
-
-:- import_module ml_backend__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").
-
-%-----------------------------------------------------------------------------%
-
-:- 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, AllForeignCode, _Imports, Defns) },
- { prog_out__sym_name_to_string(ModuleName, ModuleNameStr) },
- { ClassName = class_name(mercury_module_name_to_mlds(ModuleName),
- wrapper_class_name) },
-
- 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"]),
-
- globals__io_lookup_bool_option(sign_assembly, SignAssembly),
- ( { SignAssembly = yes },
- io__write_string("[assembly:System::Reflection::AssemblyKeyFileAttribute(\"mercury.sn\")];\n")
- ; { SignAssembly = no },
- []
- ),
-
- { Namespace0 = get_class_namespace(ClassName) },
- { list__reverse(Namespace0) = [Head | Tail] ->
- Namespace = list__reverse([Head ++ "__cpp_code" | Tail])
- ;
- Namespace = Namespace0
- },
-
- io__write_list(Namespace, "\n",
- (pred(N::in, di, uo) is det -->
- io__format("namespace %s {", [s(N)])
- )),
-
- % Get the foreign code for MC++
- { ForeignCode = map__lookup(AllForeignCode, managed_cplusplus) },
- generate_foreign_header_code(mercury_module_name_to_mlds(ModuleName),
- ForeignCode),
-
- io__write_strings([
- "\n__gc public class " ++ wrapper_class_name,
- "{\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_mcpp_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, _RevImports, RevBodyCode,
- _ExportDefns)) -->
- { BodyCode = list__reverse(RevBodyCode) },
- io__write_list(BodyCode, "\n",
- (pred(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, _RevImports, _RevBodyCode,
- _ExportDefns)) -->
- { HeaderCode = list__reverse(RevHeaderCode) },
- io__write_list(HeaderCode, "\n",
- (pred(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_mcpp_code(mlds_module_name, mlds__defn,
- io__state, io__state).
-:- mode generate_method_mcpp_code(in, in, di, uo) is det.
-
- % XXX we don't handle export
-generate_method_mcpp_code(_, defn(export(_), _, _, _)) --> [].
-generate_method_mcpp_code(_, defn(data(_), _, _, _)) --> [].
-generate_method_mcpp_code(_, defn(type(_, _), _, _, _)) --> [].
-generate_method_mcpp_code(ModuleName,
- defn(function(PredLabel, ProcId, MaybeSeqNum, _PredId),
- _Context, _DeclFlags, Entity)) -->
- (
- % XXX we ignore the attributes
- { Entity = mlds__function(_, Params,
- defined_here(Statement), _) },
- (
- { has_inline_target_code_statement(Statement) }
- ;
- { has_foreign_languages(Statement, Langs) },
- { list__member(managed_cplusplus, Langs) }
- )
- ->
- get_il_data_rep(DataRep),
- { 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) -->
- get_il_data_rep(ILDataRep),
- (
- % 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, _HasSecTag, Type,
- _MaybeSize, _MaybeCtorName,
- _Args, _ArgTypes)), _) },
- { ClassName = mlds_type_to_ilds_class_name(ILDataRep, 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,
- _Attrs)) -->
- io__write_string(Code).
-write_managed_cpp_code_component(raw_target_code(Code, _Attrs)) -->
- 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 */ ").
-
-write_managed_cpp_rval(self(_)) -->
- io__write_string(" /* self 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, _GC_TraceCode) },
- { 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) -->
- get_il_data_rep(DataRep),
- 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_Bool").
-write_il_simple_type_as_managed_cpp_type(char) -->
- io__write_string("mercury::MR_Char").
-write_il_simple_type_as_managed_cpp_type(string) -->
- io__write_string("mercury::MR_String").
-write_il_simple_type_as_managed_cpp_type(object) -->
- io__write_string("mercury::MR_Box").
-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(valuetype(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,
- NestedClasses)) -->
- io__write_list(DottedName ++ NestedClasses, "::", 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: library/construct.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/construct.m,v
retrieving revision 1.3
diff -u -r1.3 construct.m
--- library/construct.m 12 Apr 2002 01:24:21 -0000 1.3
+++ library/construct.m 20 May 2002 14:17:57 -0000
@@ -537,7 +537,6 @@
[will_not_call_mercury, thread_safe, promise_pure],
"{
mercury.runtime.Errors.SORRY(""foreign code for construct"");
- _Term = null;
// XXX this is required to keep the C# compiler quiet
SUCCESS_INDICATOR = false;
}").
Index: library/exception.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.60
diff -u -r1.60 exception.m
--- library/exception.m 28 Mar 2002 03:44:40 -0000 1.60
+++ library/exception.m 20 May 2002 14:17:58 -0000
@@ -1003,6 +1003,7 @@
:- pragma foreign_proc("C#",
catch_impl(Pred::pred(out) is det, Handler::in(handler), T::out),
[will_not_call_mercury, promise_pure], "
+ T = null;
try {
mercury.exception.mercury_code.ML_call_goal_det(
TypeInfo_for_T, Pred, ref T);
@@ -1015,6 +1016,7 @@
:- pragma foreign_proc("C#",
catch_impl(Pred::pred(out) is cc_multi, Handler::in(handler), T::out),
[will_not_call_mercury, promise_pure], "
+ T = null;
try {
mercury.exception.mercury_code.ML_call_goal_det(
TypeInfo_for_T, Pred, ref T);
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.256
diff -u -r1.256 io.m
--- library/io.m 16 May 2002 09:08:57 -0000 1.256
+++ library/io.m 20 May 2002 14:17:59 -0000
@@ -3385,7 +3385,7 @@
#define ML_UpCast(Cast, Expr) ((Cast) (Expr))
#define initial_io_state() 0 /* some random number */
-#define update_io(r_src, r_dest) ((r_dest) = (r_src))
+#define update_io(r_src, r_dest) (0)
#define final_io_state(r)
@@ -4187,7 +4187,7 @@
tabled_for_io],
"{
mercury::runtime::Errors::SORRY(""foreign code for this function"");
- IO = IO0;
+ update_io(IO0, IO);
}").
:- pragma foreign_proc("MC++",
@@ -4197,7 +4197,7 @@
tabled_for_io],
"{
mercury::runtime::Errors::SORRY(""foreign code for this function"");
- IO = IO0;
+ update_io(IO0, IO);
}").
Index: library/rtti_implementation.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/rtti_implementation.m,v
retrieving revision 1.16
diff -u -r1.16 rtti_implementation.m
--- library/rtti_implementation.m 24 Apr 2002 07:37:37 -0000 1.16
+++ library/rtti_implementation.m 20 May 2002 14:18:06 -0000
@@ -385,6 +385,7 @@
result_call_4(Pred::in, Res::out, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
+ Res = null;
mercury.runtime.GenericCall.result_call_4(Pred, ref Res, X, Y);
").
@@ -392,24 +393,28 @@
result_call_5(Pred::in, Res::out, A::in, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
+ Res = null;
mercury.runtime.GenericCall.result_call_5(Pred, A, ref Res, X, Y);
").
:- pragma foreign_proc("C#",
result_call_6(Pred::in, Res::out, A::in, B::in, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
+ Res = null;
mercury.runtime.GenericCall.result_call_6(Pred, A, B, ref Res, X, Y);
").
:- pragma foreign_proc("C#",
result_call_7(Pred::in, Res::out, A::in, B::in, C::in, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
+ Res = null;
mercury.runtime.GenericCall.result_call_7(Pred, A, B, C, ref Res, X, Y);
").
:- pragma foreign_proc("C#",
result_call_8(Pred::in, Res::out, A::in, B::in, C::in, D::in, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
+ Res = null;
mercury.runtime.GenericCall.result_call_8(Pred, A, B, C, D,
ref Res, X, Y);
").
@@ -418,6 +423,7 @@
X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
+ Res = null;
mercury.runtime.GenericCall.result_call_9(Pred,
A, B, C, D, E, ref Res, X, Y);
").
@@ -902,6 +908,7 @@
:- pragma foreign_proc("C#",
get_pti_from_arg_types(ArgTypes::in, Index::in) =
(ArgTypeInfo::out), [promise_pure], "
+ TypeInfo_for_T = null;
ArgTypeInfo = ArgTypes[Index];
").
@@ -916,6 +923,7 @@
:- pragma foreign_proc("C#",
get_pti_from_type_info(TypeInfo::in, Index::in) = (PTI::out),
[promise_pure], "
+ TypeInfo_for_T = null;
PTI = TypeInfo[Index];
").
@@ -1401,6 +1409,7 @@
type_ctor_unify_pred(TypeCtorInfo::in) = (UnifyPred::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+ TypeInfo_for_P = null;
UnifyPred = TypeCtorInfo[
(int) type_ctor_info_field_nums.type_ctor_unify_pred];
").
@@ -1417,6 +1426,7 @@
type_ctor_compare_pred(TypeCtorInfo::in) = (UnifyPred::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+ TypeInfo_for_P = null;
UnifyPred = TypeCtorInfo[
(int) type_ctor_info_field_nums.type_ctor_compare_pred];
").
Index: library/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.266
diff -u -r1.266 std_util.m
--- library/std_util.m 25 Apr 2002 09:31:52 -0000 1.266
+++ library/std_util.m 20 May 2002 14:18:07 -0000
@@ -1052,9 +1052,8 @@
/* XXX trailing not yet implemented for the MLDS back-end */
mercury::runtime::Errors::SORRY(""foreign code for get_registers"");
#else
- TrailPtr = 0
+ TrailPtr = 0;
#endif
-
").
:- impure pred check_for_floundering(trail_ptr::in) is det.
--------------------------------------------------------------------------
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