[m-rev.] for review: improve MC++ support
Peter Ross
pro at missioncriticalit.com
Thu Jun 13 02:07:28 AEST 2002
Hi,
Here is the updated diff.
Could Tyson and/or Fergus please review it?
===================================================================
Estimated hours taken: 40
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.m:
Add a new field to outline_foreign_proc. This field has
information which links the mlds variables with the variable
names used in the foreign code.
compiler/ml_code_gen.m:
Generate a foreign proc for MC++ the same way we generate a
foreign proc for C#.
Generate the data for the new field in outline_foreign_proc.
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.
compiler/mlds_to_il.m:
Add to the list of foreign languages defined in the module to
include those which don't have a foreign_proc defined in them.
Move the relevant code from atomic_statement_to_il to
generate_method so that we handle external procedures correctly.
compiler/mlds_to_ilasm.m:
Call mlds_to_managed.
compiler/ml_backend.m:
Add the new module and remove mlds_to_mcpp and mlds_to_csharp.
compiler/ml_elim_nested.m:
compiler/ml_optimize.m:
compiler/ml_util.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_java.m:
Minor changes to handling the new field in outline_foreign_proc.
compiler/mlds_to_csharp.m:
compiler/mlds_to_mcpp.m:
Removed files whose functionality has been subsumed by
mlds_to_managed.
library/construct.m:
library/float.m:
library/io.m:
library/std_util.m:
library/type_desc.m:
Changes required to get the library to be able compile in the
ilc grade.
diff -u compiler/ml_code_gen.m compiler/ml_code_gen.m
--- compiler/ml_code_gen.m
+++ compiler/ml_code_gen.m
@@ -2384,15 +2384,19 @@
% the user's code.
ml_gen_ordinary_pragma_managed_proc(CodeModel, Attributes,
- _PredId, _ProcId, _ArgVars, _ArgDatas, _OrigArgTypes,
+ _PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes,
ForeignCode, Context, MLDS_Decls, MLDS_Statements) -->
+
+ { ml_make_c_arg_list(ArgVars, ArgDatas, OrigArgTypes, ArgList) },
+ ml_gen_outline_args(ArgList, OutlineArgs),
+
{ 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_foreign_proc(ForeignLang, OutputVarLvals,
- ForeignCode) },
+ { OutlineStmt = outline_foreign_proc(ForeignLang, OutlineArgs,
+ OutputVarLvals, ForeignCode) },
{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
{ module_info_name(ModuleInfo, ModuleName) },
@@ -2426,5 +2430,34 @@
] },
{ MLDS_Decls = SuccessVarLocals }.
+:- pred ml_gen_outline_args(list(ml_c_arg)::in,
+ list(outline_arg)::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_outline_args([], []) --> [].
+ml_gen_outline_args([ml_c_arg(Var, MaybeVarMode, OrigType) | Args],
+ [OutlineArg | OutlineArgs]) -->
+ ml_gen_outline_args(Args, OutlineArgs),
+ =(MLDSGenInfo),
+ { ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
+ ml_gen_var(Var, VarLval),
+ ml_gen_type(OrigType, MldsType),
+ {
+ MaybeVarMode = yes(ArgName - Mode),
+ \+ type_util__is_dummy_argument_type(OrigType),
+ \+ var_is_singleton(ArgName)
+ ->
+ mode_to_arg_mode(ModuleInfo, Mode, OrigType, ArgMode),
+ ( ArgMode = top_in,
+ OutlineArg = in(MldsType, ArgName, lval(VarLval))
+ ; ArgMode = top_out,
+ OutlineArg = out(MldsType, ArgName, VarLval)
+ ; ArgMode = top_unused,
+ OutlineArg = unused
+ )
+ ;
+ OutlineArg = unused
+ }.
+
:- pred ml_gen_ordinary_pragma_il_proc(code_model,
pragma_foreign_proc_attributes, pred_id, proc_id, list(prog_var),
diff -u compiler/mlds_to_il.m compiler/mlds_to_il.m
--- compiler/mlds_to_il.m
+++ compiler/mlds_to_il.m
@@ -241,7 +241,7 @@
generate_il(MLDS, Version, ILAsm, ForeignLangs, IO0, IO) :-
- mlds(MercuryModuleName, _ForeignCode, Imports, Defns) =
+ mlds(MercuryModuleName, ForeignCode, Imports, Defns) =
transform_mlds(MLDS),
ModuleName = mercury_module_name_to_mlds(MercuryModuleName),
@@ -268,7 +268,11 @@
list__map_foldl(mlds_defn_to_ilasm_decl, Defns, ILDecls,
IlInfo0, IlInfo),
- ForeignLangs = IlInfo ^ file_foreign_langs,
+ list__filter(has_foreign_code_defined(ForeignCode),
+ [managed_cplusplus, csharp], ForeignCodeLangs),
+
+ ForeignLangs = IlInfo ^ file_foreign_langs `union`
+ set__list_to_set(ForeignCodeLangs),
ClassName = mlds_module_name_to_class_name(ModuleName),
ClassName = structured_name(_, NamespaceName, _),
@@ -323,6 +327,20 @@
ILEnvPtrType = choose_il_envptr_type(Globals),
ILDataRep = il_data_rep(HighLevelData, ILEnvPtrType).
+
+:- pred has_foreign_code_defined(
+ map(foreign_language, mlds__foreign_code)::in,
+ foreign_language::in) is semidet.
+
+has_foreign_code_defined(ForeignCodeMap, Lang) :-
+ ForeignCode = map__search(ForeignCodeMap, Lang),
+ ForeignCode = mlds__foreign_code(Decls, Imports, Codes, Exports),
+ ( Decls \= []
+ ; Imports \= []
+ ; Codes \= []
+ ; Exports \= []
+ ).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -471,7 +489,8 @@
rename_atomic(restore_hp(R)) = restore_hp(rename_rval(R)).
rename_atomic(trail_op(T)) = trail_op(T).
rename_atomic(inline_target_code(L, Cs)) = inline_target_code(L, Cs).
-rename_atomic(outline_foreign_proc(F, Ls, S)) = outline_foreign_proc(F, Ls, S).
+rename_atomic(outline_foreign_proc(F, Vs, Ls, S))
+ = outline_foreign_proc(F, Vs, Ls, S).
:- func rename_rval(mlds__rval) = mlds__rval.
@@ -994,28 +1013,23 @@
statement_to_il(Statement, InstrsTree1)
;
{ MaybeStatement = external },
- % If there is no function body, generate
- % forwarding code instead. This can happen with
- % :- external
- atomic_statement_to_il(inline_target_code(lang_C, []),
- InstrsTree0),
-
- % The code might reference locals...
- il_info_add_locals(["succeeded" - mlds__native_bool_type]),
- ( { Returns = [_] } ->
- % XXX Bug!
- % We assume that if there is a return value,
- % then it must be a semidet procedure, so
- % we return `succeeded'.
- % This is wrong for functions!
- { InstrsTree1 = tree__list([
- InstrsTree0,
- instr_node(ldloc(name("succeeded"))),
- instr_node(ret)
+
+ { mangle_dataname_module(no, ModuleName, NewModuleName) },
+ { ClassName = mlds_module_name_to_class_name(NewModuleName) },
+
+ { ILSignature = signature(_, ILRetType, ILParams) },
+
+ { assoc_list__keys(ILParams, TypeParams) },
+ { list__map_foldl(
+ (pred(_::in, Instr::out, Num::in, Num+1::out) is det :-
+ Instr = ldarg(index(Num))
+ ), TypeParams, LoadInstrs, 0, _) },
+ { InstrsTree1 = tree__list([
+ comment_node("external -- call handwritten version"),
+ node(LoadInstrs),
+ instr_node(call(get_static_methodref(ClassName,
+ MemberName, ILRetType, TypeParams)))
]) }
- ;
- { InstrsTree1 = InstrsTree0 }
- )
),
% Need to insert a ret for functions returning
@@ -1839,7 +1853,7 @@
{ Instrs = [comment(
"restore hp -- not relevant for this backend")] }.
-atomic_statement_to_il(outline_foreign_proc(Lang, ReturnLvals, _Code),
+atomic_statement_to_il(outline_foreign_proc(Lang, _, ReturnLvals, _Code),
Instrs) -->
il_info_get_module_name(ModuleName),
( no =^ method_foreign_lang ->
@@ -1892,47 +1906,10 @@
"outline foreign proc -- already called") }
).
- % XXX we assume lang_C is MC++
-atomic_statement_to_il(inline_target_code(lang_C, _Code), Instrs) -->
- il_info_get_module_name(ModuleName),
- ( no =^ method_foreign_lang ->
- % XXX we hardcode managed C++ here
- =(Info),
- ^ method_foreign_lang := yes(managed_cplusplus),
- ^ file_foreign_langs :=
- set__insert(Info ^ file_foreign_langs,
- managed_cplusplus),
- { mangle_dataname_module(no, ModuleName, NewModuleName) },
- { ClassName = mlds_module_name_to_class_name(NewModuleName) },
- signature(_, RetType, Params) =^ signature,
- % If there is a return value, put it in succeeded.
- % XXX this is incorrect for functions, which might
- % return a useful value.
- { RetType = void ->
- StoreReturnInstr = empty
- ; RetType = simple_type(bool) ->
- StoreReturnInstr = instr_node(stloc(name("succeeded")))
- ;
- sorry(this_file, "functions in MC++")
- },
- 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, LoadInstrs, 0, _) },
- { Instrs = tree__list([
- comment_node("inline target code -- call handwritten version"),
- node(LoadInstrs),
- instr_node(call(get_static_methodref(ClassName,
- MethodName, RetType, TypeParams))),
- StoreReturnInstr
- ]) }
- ;
- { Instrs = comment_node("inline target code -- already called") }
- ).
atomic_statement_to_il(inline_target_code(lang_il, Code), Instrs) -->
{ Instrs = inline_code_to_il_asm(Code) }.
+atomic_statement_to_il(inline_target_code(lang_C, _Code), _Instrs) -->
+ { unexpected(this_file, "lang_C") }.
atomic_statement_to_il(inline_target_code(lang_java_bytecode, _), _) -->
{ unexpected(this_file, "lang_java_bytecode") }.
atomic_statement_to_il(inline_target_code(lang_java_asm, _), _) -->
diff -u library/construct.m library/construct.m
--- library/construct.m
+++ library/construct.m
@@ -588,10 +588,6 @@
MR_new_univ_on_hp(Term, type_info, new_data);
}").
-:- pragma foreign_proc("C#",
- construct_tuple_2(_Args::in, _ArgTypes::in, _Arity::in) = (_Term::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"{
- mercury.runtime.Errors.SORRY(""construct_tuple_2"");
- _Term = null;
-}").
+construct_tuple_2(_, _, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("construct_tuple_2").
reverted:
--- library/exception.m 20 May 2002 14:17:58 -0000
+++ library/exception.m 28 Mar 2002 03:44:40 -0000 1.60
@@ -1003,7 +1003,6 @@
:- 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);
@@ -1016,7 +1015,6 @@
:- 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);
diff -u library/io.m library/io.m
--- library/io.m
+++ library/io.m
@@ -4159,7 +4159,7 @@
""io__seek_binary_2: unseekable stream"");
}
- IO = IO0;
+ update_io(IO0, IO);
}").
:- pragma foreign_proc("C",
@@ -4177,7 +4177,7 @@
mercury_io_error(stream,
""io__binary_stream_offset: untellable stream"");
}
- IO = IO0;
+ update_io(IO0, IO);
}").
:- pragma foreign_proc("MC++",
reverted:
--- library/rtti_implementation.m 20 May 2002 14:18:06 -0000
+++ library/rtti_implementation.m 24 Apr 2002 07:37:37 -0000 1.16
@@ -385,7 +385,6 @@
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);
").
@@ -393,28 +392,24 @@
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);
").
@@ -423,7 +418,6 @@
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);
").
@@ -908,7 +902,6 @@
:- pragma foreign_proc("C#",
get_pti_from_arg_types(ArgTypes::in, Index::in) =
(ArgTypeInfo::out), [promise_pure], "
- TypeInfo_for_T = null;
ArgTypeInfo = ArgTypes[Index];
").
@@ -923,7 +916,6 @@
:- pragma foreign_proc("C#",
get_pti_from_type_info(TypeInfo::in, Index::in) = (PTI::out),
[promise_pure], "
- TypeInfo_for_T = null;
PTI = TypeInfo[Index];
").
@@ -1409,7 +1401,6 @@
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];
").
@@ -1426,7 +1417,6 @@
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];
").
only in patch2:
--- library/type_desc.m 12 Jun 2002 06:46:46 -0000 1.11
+++ library/type_desc.m 12 Jun 2002 15:53:36 -0000
@@ -627,13 +627,9 @@
TypeCtor = (MR_Word) MR_make_type_ctor_desc(type_info, type_ctor_info);
}").
-:- pragma foreign_proc("C#",
- type_ctor(_TypeInfo::in) = (_TypeCtor::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"{
- mercury.runtime.Errors.SORRY(""foreign code for type_ctor"");
- _TypeCtor = null;
-}").
+type_ctor(_) = _ :-
+ % This version is only for if there is not a foreign_proc version
+ private_builtin__sorry("type_ctor").
:- pragma foreign_proc("C",
type_ctor_and_args(TypeDesc::in, TypeCtorDesc::out, ArgTypes::out),
only in patch2:
--- library/float.m 12 Jun 2002 06:46:33 -0000 1.46
+++ library/float.m 12 Jun 2002 15:53:31 -0000
@@ -458,21 +458,17 @@
:- pragma foreign_proc("C", float__radix = (Radix::out),
[will_not_call_mercury, promise_pure, thread_safe],
"Radix = ML_FLOAT_RADIX;").
-:- pragma foreign_proc("C#", float__radix = (_Radix::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
- _Radix = 0;
-").
+float__radix = _ :-
+ % This version is only for if there is not a foreign_proc version
+ private_builtin__sorry("float__radix").
% The number of base-radix digits in the mantissa.
:- pragma foreign_proc("C", float__mantissa_digits = (MantDig::out),
[will_not_call_mercury, promise_pure, thread_safe],
"MantDig = ML_FLOAT_MANT_DIG;").
-:- pragma foreign_proc("C#", float__mantissa_digits = (_MantDig::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
- _MantDig = 0;
-").
+float__mantissa_digits = _ :-
+ % This version is only for if there is not a foreign_proc version
+ private_builtin__sorry("float__mantissa_digits").
% Minimum negative integer such that:
% radix ** (min_exponent - 1)
@@ -480,11 +476,9 @@
:- pragma foreign_proc("C", float__min_exponent = (MinExp::out),
[will_not_call_mercury, promise_pure, thread_safe],
"MinExp = ML_FLOAT_MIN_EXP;").
-:- pragma foreign_proc("C#", float__min_exponent = (_MinExp::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
- _MinExp = 0;
-").
+float__min_exponent = _ :-
+ % This version is only for if there is not a foreign_proc version
+ private_builtin__sorry("float__min_exponent").
% Maximum integer such that:
% radix ** (max_exponent - 1)
@@ -492,13 +486,9 @@
:- pragma foreign_proc("C", float__max_exponent = (MaxExp::out),
[will_not_call_mercury, promise_pure, thread_safe],
"MaxExp = ML_FLOAT_MAX_EXP;").
-
-:- pragma foreign_proc("C#", float__max_exponent = (_MaxExp::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
- _MaxExp = 0;
-").
-
+float__max_exponent = _ :-
+ % This version is only for if there is not a foreign_proc version
+ private_builtin__sorry("float__max_exponent").
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
only in patch2:
--- compiler/mlds_to_java.m 30 May 2002 12:55:09 -0000 1.30
+++ compiler/mlds_to_java.m 12 Jun 2002 15:53:22 -0000
@@ -2540,7 +2540,8 @@
{ error("mlds_to_java.m: sorry, foreign language interfacing not implemented") }.
output_atomic_stmt(_Indent, _FuncInfo,
- outline_foreign_proc(_TargetLang, _Lvals, _Code), _Context) -->
+ outline_foreign_proc(_TargetLang, _Vs, _Lvals, _Code),
+ _Context) -->
{ error("mlds_to_java.m: sorry, foreign language interfacing not implemented") }.
%------------------------------------------------------------------------------%
only in patch2:
--- compiler/mlds_to_ilasm.m 20 Mar 2002 12:36:52 -0000 1.17
+++ compiler/mlds_to_ilasm.m 12 Jun 2002 15:53:17 -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, _, _) :-
only in patch2:
--- compiler/mlds_to_gcc.m 7 May 2002 11:03:06 -0000 1.71
+++ compiler/mlds_to_gcc.m 12 Jun 2002 15:53:15 -0000
@@ -2870,7 +2870,7 @@
_Context) -->
% XXX we should support inserting inline asm code fragments
{ sorry(this_file, "target_code (for `--target asm')") }.
-gen_atomic_stmt(_DefnInfo, outline_foreign_proc(_, _, _), _Context) -->
+gen_atomic_stmt(_DefnInfo, outline_foreign_proc(_, _, _, _), _Context) -->
% XXX I'm not sure if we need to handle this case
{ sorry(this_file, "outline_foreign_proc (for `--target asm')") }.
only in patch2:
--- compiler/mlds_to_c.m 7 Jun 2002 00:48:45 -0000 1.131
+++ compiler/mlds_to_c.m 12 Jun 2002 15:53:14 -0000
@@ -2829,7 +2829,7 @@
).
mlds_output_atomic_stmt(_Indent, _FuncInfo,
- outline_foreign_proc(_ForeignLang, _Lvals, _Code), _Context) -->
+ outline_foreign_proc(_Lang, _Vs, _Lvals, _Code), _Context) -->
{ error("mlds_to_c.m: outline_foreign_proc is not used in C backend") }.
:- pred mlds_output_target_code_component(mlds__context, target_code_component,
only in patch2:
--- compiler/mlds.m 30 May 2002 12:55:05 -0000 1.92
+++ compiler/mlds.m 12 Jun 2002 15:53:13 -0000
@@ -1247,6 +1247,7 @@
foreign_language,
% the foreign language this code is
% written in.
+ list(outline_arg),
list(mlds__lval),
% where to store return value(s)
string
@@ -1267,6 +1268,33 @@
% where the input values come from, and use
.
+ % Is the argument an input, output or unused argument?
+ % If it is an input or output argument, record the type and the name of
+ % the argument in the foreign code.
+ % For input arguments record the rval which holds the initial
+ % value of the argument.
+ % For output argu
+:- type outline_arg
+ ---> in(
+ mlds__type,
+ % The type of the argument.
+ string,
+ % The name of the argument in the foreign code.
+ mlds__rval
+ % The rval which holds the value of this
+ % argument.
+ )
+ ; out(
+ mlds__type,
+ % The type of the argument.
+ string,
+ % The name of the argument in the foreign code.
+ mlds__lval
+ % The lval where we are to place the result
+ % calculated by the foreign code into.
+ )
+ ; unused.
+
%
% This is just a random selection of possible languages
% that we might want to target...
only in patch2:
--- compiler/ml_util.m 2 Apr 2002 16:36:12 -0000 1.19
+++ compiler/ml_util.m 12 Jun 2002 15:53:12 -0000
@@ -445,7 +445,7 @@
GetTargetCode = (pred(Lang::out) is nondet :-
statement_contains_statement(Statement, SubStatement),
SubStatement = statement(atomic(
- outline_foreign_proc(Lang, _, _)), _)
+ outline_foreign_proc(Lang, _, _, _)), _)
),
solutions(GetTargetCode, Langs).
@@ -463,7 +463,7 @@
Stmt = atomic(inline_target_code(TargetLang, _)),
TargetLang \= NativeTargetLang
;
- Stmt = atomic(outline_foreign_proc(_, _, _))
+ Stmt = atomic(outline_foreign_proc(_, _, _, _))
).
defn_contains_outline_foreign_proc(ForeignLang, Defn) :-
@@ -471,7 +471,7 @@
Body = function(_, _, defined_here(FunctionBody), _),
statement_contains_statement(FunctionBody, Statement),
Statement = mlds__statement(Stmt, _),
- Stmt = atomic(outline_foreign_proc(ForeignLang, _, _)).
+ Stmt = atomic(outline_foreign_proc(ForeignLang, _, _, _)).
defn_is_type(Defn) :-
Defn = mlds__defn(Name, _Context, _Flags, _Body),
only in patch2:
--- compiler/ml_optimize.m 18 Apr 2002 12:50:56 -0000 1.20
+++ compiler/ml_optimize.m 12 Jun 2002 15:53:12 -0000
@@ -1174,8 +1174,8 @@
inline_target_code(Lang, Components)) -->
list__map_foldl(eliminate_var_in_target_code_component,
Components0, Components).
-eliminate_var_in_atomic_stmt(outline_foreign_proc(Lang, Lvals0, Code),
- outline_foreign_proc(Lang, Lvals, Code)) -->
+eliminate_var_in_atomic_stmt(outline_foreign_proc(Lang, Vs, Lvals0, Code),
+ outline_foreign_proc(Lang, Vs, Lvals, Code)) -->
eliminate_var_in_lvals(Lvals0, Lvals).
:- pred eliminate_var_in_case_cond(
only in patch2:
--- compiler/ml_elim_nested.m 6 Jun 2002 11:43:58 -0000 1.58
+++ compiler/ml_elim_nested.m 12 Jun 2002 15:53:11 -0000
@@ -1810,8 +1810,8 @@
inline_target_code(Lang, Components)) -->
list__map_foldl(fixup_target_code_component,
Components0, Components).
-fixup_atomic_stmt(outline_foreign_proc(Lang, Lvals0, Code),
- outline_foreign_proc(Lang, Lvals, Code)) -->
+fixup_atomic_stmt(outline_foreign_proc(Lang, Vs, Lvals0, Code),
+ outline_foreign_proc(Lang, Vs, Lvals, Code)) -->
list__map_foldl(fixup_lval, Lvals0, Lvals).
:- pred fixup_case_cond(mlds__case_match_cond, mlds__case_match_cond,
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 12 Jun 2002 15:53:09 -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.118
diff -u -r1.118 ml_code_gen.m
--- compiler/ml_code_gen.m 4 Jun 2002 14:56:02 -0000 1.118
+++ compiler/ml_code_gen.m 12 Jun 2002 15:53:10 -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.
@@ -2095,10 +2094,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(
@@ -2354,11 +2357,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 },
@@ -2367,29 +2370,33 @@
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,
- _PredId, _ProcId, _ArgVars, _ArgDatas, _OrigArgTypes,
+ml_gen_ordinary_pragma_managed_proc(CodeModel, Attributes,
+ _PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes,
ForeignCode, Context, MLDS_Decls, MLDS_Statements) -->
+
+ { ml_make_c_arg_list(ArgVars, ArgDatas, OrigArgTypes, ArgList) },
+ ml_gen_outline_args(ArgList, OutlineArgs),
+
{ 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_foreign_proc(ForeignLang, OutputVarLvals,
- ForeignCode) },
+ { OutlineStmt = outline_foreign_proc(ForeignLang, OutlineArgs,
+ OutputVarLvals, ForeignCode) },
{ ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
{ module_info_name(ModuleInfo, ModuleName) },
@@ -2422,6 +2429,35 @@
SuccessIndicatorStatements
] },
{ MLDS_Decls = SuccessVarLocals }.
+
+:- pred ml_gen_outline_args(list(ml_c_arg)::in,
+ list(outline_arg)::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_outline_args([], []) --> [].
+ml_gen_outline_args([ml_c_arg(Var, MaybeVarMode, OrigType) | Args],
+ [OutlineArg | OutlineArgs]) -->
+ ml_gen_outline_args(Args, OutlineArgs),
+ =(MLDSGenInfo),
+ { ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
+ ml_gen_var(Var, VarLval),
+ ml_gen_type(OrigType, MldsType),
+ {
+ MaybeVarMode = yes(ArgName - Mode),
+ \+ type_util__is_dummy_argument_type(OrigType),
+ \+ var_is_singleton(ArgName)
+ ->
+ mode_to_arg_mode(ModuleInfo, Mode, OrigType, ArgMode),
+ ( ArgMode = top_in,
+ OutlineArg = in(MldsType, ArgName, lval(VarLval))
+ ; ArgMode = top_out,
+ OutlineArg = out(MldsType, ArgName, VarLval)
+ ; ArgMode = top_unused,
+ OutlineArg = unused
+ )
+ ;
+ OutlineArg = unused
+ }.
:- pred ml_gen_ordinary_pragma_il_proc(code_model,
pragma_foreign_proc_attributes, pred_id, proc_id, list(prog_var),
Index: compiler/ml_elim_nested.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_elim_nested.m,v
retrieving revision 1.58
diff -u -r1.58 ml_elim_nested.m
--- compiler/ml_elim_nested.m 6 Jun 2002 11:43:58 -0000 1.58
+++ compiler/ml_elim_nested.m 12 Jun 2002 15:53:11 -0000
@@ -1810,8 +1810,8 @@
inline_target_code(Lang, Components)) -->
list__map_foldl(fixup_target_code_component,
Components0, Components).
-fixup_atomic_stmt(outline_foreign_proc(Lang, Lvals0, Code),
- outline_foreign_proc(Lang, Lvals, Code)) -->
+fixup_atomic_stmt(outline_foreign_proc(Lang, Vs, Lvals0, Code),
+ outline_foreign_proc(Lang, Vs, Lvals, Code)) -->
list__map_foldl(fixup_lval, Lvals0, Lvals).
:- pred fixup_case_cond(mlds__case_match_cond, mlds__case_match_cond,
Index: compiler/ml_optimize.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_optimize.m,v
retrieving revision 1.20
diff -u -r1.20 ml_optimize.m
--- compiler/ml_optimize.m 18 Apr 2002 12:50:56 -0000 1.20
+++ compiler/ml_optimize.m 12 Jun 2002 15:53:12 -0000
@@ -1174,8 +1174,8 @@
inline_target_code(Lang, Components)) -->
list__map_foldl(eliminate_var_in_target_code_component,
Components0, Components).
-eliminate_var_in_atomic_stmt(outline_foreign_proc(Lang, Lvals0, Code),
- outline_foreign_proc(Lang, Lvals, Code)) -->
+eliminate_var_in_atomic_stmt(outline_foreign_proc(Lang, Vs, Lvals0, Code),
+ outline_foreign_proc(Lang, Vs, Lvals, Code)) -->
eliminate_var_in_lvals(Lvals0, Lvals).
:- pred eliminate_var_in_case_cond(
Index: compiler/ml_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_util.m,v
retrieving revision 1.19
diff -u -r1.19 ml_util.m
--- compiler/ml_util.m 2 Apr 2002 16:36:12 -0000 1.19
+++ compiler/ml_util.m 12 Jun 2002 15:53:12 -0000
@@ -445,7 +445,7 @@
GetTargetCode = (pred(Lang::out) is nondet :-
statement_contains_statement(Statement, SubStatement),
SubStatement = statement(atomic(
- outline_foreign_proc(Lang, _, _)), _)
+ outline_foreign_proc(Lang, _, _, _)), _)
),
solutions(GetTargetCode, Langs).
@@ -463,7 +463,7 @@
Stmt = atomic(inline_target_code(TargetLang, _)),
TargetLang \= NativeTargetLang
;
- Stmt = atomic(outline_foreign_proc(_, _, _))
+ Stmt = atomic(outline_foreign_proc(_, _, _, _))
).
defn_contains_outline_foreign_proc(ForeignLang, Defn) :-
@@ -471,7 +471,7 @@
Body = function(_, _, defined_here(FunctionBody), _),
statement_contains_statement(FunctionBody, Statement),
Statement = mlds__statement(Stmt, _),
- Stmt = atomic(outline_foreign_proc(ForeignLang, _, _)).
+ Stmt = atomic(outline_foreign_proc(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.92
diff -u -r1.92 mlds.m
--- compiler/mlds.m 30 May 2002 12:55:05 -0000 1.92
+++ compiler/mlds.m 12 Jun 2002 15:53:13 -0000
@@ -1247,6 +1247,7 @@
foreign_language,
% the foreign language this code is
% written in.
+ list(outline_arg),
list(mlds__lval),
% where to store return value(s)
string
@@ -1267,6 +1268,33 @@
% where the input values come from, and use
.
+ % Is the argument an input, output or unused argument?
+ % If it is an input or output argument, record the type and the name of
+ % the argument in the foreign code.
+ % For input arguments record the rval which holds the initial
+ % value of the argument.
+ % For output argu
+:- type outline_arg
+ ---> in(
+ mlds__type,
+ % The type of the argument.
+ string,
+ % The name of the argument in the foreign code.
+ mlds__rval
+ % The rval which holds the value of this
+ % argument.
+ )
+ ; out(
+ mlds__type,
+ % The type of the argument.
+ string,
+ % The name of the argument in the foreign code.
+ mlds__lval
+ % The lval where we are to place the result
+ % calculated by the foreign code into.
+ )
+ ; unused.
+
%
% This is just a random selection of possible languages
% that we might want to target...
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.131
diff -u -r1.131 mlds_to_c.m
--- compiler/mlds_to_c.m 7 Jun 2002 00:48:45 -0000 1.131
+++ compiler/mlds_to_c.m 12 Jun 2002 15:53:14 -0000
@@ -2829,7 +2829,7 @@
).
mlds_output_atomic_stmt(_Indent, _FuncInfo,
- outline_foreign_proc(_ForeignLang, _Lvals, _Code), _Context) -->
+ outline_foreign_proc(_Lang, _Vs, _Lvals, _Code), _Context) -->
{ error("mlds_to_c.m: outline_foreign_proc is not used in C backend") }.
:- pred mlds_output_target_code_component(mlds__context, target_code_component,
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_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.71
diff -u -r1.71 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 7 May 2002 11:03:06 -0000 1.71
+++ compiler/mlds_to_gcc.m 12 Jun 2002 15:53:15 -0000
@@ -2870,7 +2870,7 @@
_Context) -->
% XXX we should support inserting inline asm code fragments
{ sorry(this_file, "target_code (for `--target asm')") }.
-gen_atomic_stmt(_DefnInfo, outline_foreign_proc(_, _, _), _Context) -->
+gen_atomic_stmt(_DefnInfo, outline_foreign_proc(_, _, _, _), _Context) -->
% XXX I'm not sure if we need to handle this case
{ sorry(this_file, "outline_foreign_proc (for `--target asm')") }.
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.115
diff -u -r1.115 mlds_to_il.m
--- compiler/mlds_to_il.m 30 May 2002 12:55:07 -0000 1.115
+++ compiler/mlds_to_il.m 12 Jun 2002 15:53:17 -0000
@@ -241,7 +241,7 @@
generate_il(MLDS, Version, ILAsm, ForeignLangs, IO0, IO) :-
- mlds(MercuryModuleName, _ForeignCode, Imports, Defns) =
+ mlds(MercuryModuleName, ForeignCode, Imports, Defns) =
transform_mlds(MLDS),
ModuleName = mercury_module_name_to_mlds(MercuryModuleName),
@@ -268,7 +268,11 @@
list__map_foldl(mlds_defn_to_ilasm_decl, Defns, ILDecls,
IlInfo0, IlInfo),
- ForeignLangs = IlInfo ^ file_foreign_langs,
+ list__filter(has_foreign_code_defined(ForeignCode),
+ [managed_cplusplus, csharp], ForeignCodeLangs),
+
+ ForeignLangs = IlInfo ^ file_foreign_langs `union`
+ set__list_to_set(ForeignCodeLangs),
ClassName = mlds_module_name_to_class_name(ModuleName),
ClassName = structured_name(_, NamespaceName, _),
@@ -323,6 +327,20 @@
ILEnvPtrType = choose_il_envptr_type(Globals),
ILDataRep = il_data_rep(HighLevelData, ILEnvPtrType).
+
+:- pred has_foreign_code_defined(
+ map(foreign_language, mlds__foreign_code)::in,
+ foreign_language::in) is semidet.
+
+has_foreign_code_defined(ForeignCodeMap, Lang) :-
+ ForeignCode = map__search(ForeignCodeMap, Lang),
+ ForeignCode = mlds__foreign_code(Decls, Imports, Codes, Exports),
+ ( Decls \= []
+ ; Imports \= []
+ ; Codes \= []
+ ; Exports \= []
+ ).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -471,7 +489,8 @@
rename_atomic(restore_hp(R)) = restore_hp(rename_rval(R)).
rename_atomic(trail_op(T)) = trail_op(T).
rename_atomic(inline_target_code(L, Cs)) = inline_target_code(L, Cs).
-rename_atomic(outline_foreign_proc(F, Ls, S)) = outline_foreign_proc(F, Ls, S).
+rename_atomic(outline_foreign_proc(F, Vs, Ls, S))
+ = outline_foreign_proc(F, Vs, Ls, S).
:- func rename_rval(mlds__rval) = mlds__rval.
@@ -994,28 +1013,23 @@
statement_to_il(Statement, InstrsTree1)
;
{ MaybeStatement = external },
- % If there is no function body, generate
- % forwarding code instead. This can happen with
- % :- external
- atomic_statement_to_il(inline_target_code(lang_C, []),
- InstrsTree0),
-
- % The code might reference locals...
- il_info_add_locals(["succeeded" - mlds__native_bool_type]),
- ( { Returns = [_] } ->
- % XXX Bug!
- % We assume that if there is a return value,
- % then it must be a semidet procedure, so
- % we return `succeeded'.
- % This is wrong for functions!
- { InstrsTree1 = tree__list([
- InstrsTree0,
- instr_node(ldloc(name("succeeded"))),
- instr_node(ret)
+
+ { mangle_dataname_module(no, ModuleName, NewModuleName) },
+ { ClassName = mlds_module_name_to_class_name(NewModuleName) },
+
+ { ILSignature = signature(_, ILRetType, ILParams) },
+
+ { assoc_list__keys(ILParams, TypeParams) },
+ { list__map_foldl(
+ (pred(_::in, Instr::out, Num::in, Num+1::out) is det :-
+ Instr = ldarg(index(Num))
+ ), TypeParams, LoadInstrs, 0, _) },
+ { InstrsTree1 = tree__list([
+ comment_node("external -- call handwritten version"),
+ node(LoadInstrs),
+ instr_node(call(get_static_methodref(ClassName,
+ MemberName, ILRetType, TypeParams)))
]) }
- ;
- { InstrsTree1 = InstrsTree0 }
- )
),
% Need to insert a ret for functions returning
@@ -1839,7 +1853,7 @@
{ Instrs = [comment(
"restore hp -- not relevant for this backend")] }.
-atomic_statement_to_il(outline_foreign_proc(Lang, ReturnLvals, _Code),
+atomic_statement_to_il(outline_foreign_proc(Lang, _, ReturnLvals, _Code),
Instrs) -->
il_info_get_module_name(ModuleName),
( no =^ method_foreign_lang ->
@@ -1892,47 +1906,10 @@
"outline foreign proc -- already called") }
).
- % XXX we assume lang_C is MC++
-atomic_statement_to_il(inline_target_code(lang_C, _Code), Instrs) -->
- il_info_get_module_name(ModuleName),
- ( no =^ method_foreign_lang ->
- % XXX we hardcode managed C++ here
- =(Info),
- ^ method_foreign_lang := yes(managed_cplusplus),
- ^ file_foreign_langs :=
- set__insert(Info ^ file_foreign_langs,
- managed_cplusplus),
- { mangle_dataname_module(no, ModuleName, NewModuleName) },
- { ClassName = mlds_module_name_to_class_name(NewModuleName) },
- signature(_, RetType, Params) =^ signature,
- % If there is a return value, put it in succeeded.
- % XXX this is incorrect for functions, which might
- % return a useful value.
- { RetType = void ->
- StoreReturnInstr = empty
- ; RetType = simple_type(bool) ->
- StoreReturnInstr = instr_node(stloc(name("succeeded")))
- ;
- sorry(this_file, "functions in MC++")
- },
- 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, LoadInstrs, 0, _) },
- { Instrs = tree__list([
- comment_node("inline target code -- call handwritten version"),
- node(LoadInstrs),
- instr_node(call(get_static_methodref(ClassName,
- MethodName, RetType, TypeParams))),
- StoreReturnInstr
- ]) }
- ;
- { Instrs = comment_node("inline target code -- already called") }
- ).
atomic_statement_to_il(inline_target_code(lang_il, Code), Instrs) -->
{ Instrs = inline_code_to_il_asm(Code) }.
+atomic_statement_to_il(inline_target_code(lang_C, _Code), _Instrs) -->
+ { unexpected(this_file, "lang_C") }.
atomic_statement_to_il(inline_target_code(lang_java_bytecode, _), _) -->
{ unexpected(this_file, "lang_java_bytecode") }.
atomic_statement_to_il(inline_target_code(lang_java_asm, _), _) -->
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 12 Jun 2002 15:53:17 -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_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.30
diff -u -r1.30 mlds_to_java.m
--- compiler/mlds_to_java.m 30 May 2002 12:55:09 -0000 1.30
+++ compiler/mlds_to_java.m 12 Jun 2002 15:53:22 -0000
@@ -2540,7 +2540,8 @@
{ error("mlds_to_java.m: sorry, foreign language interfacing not implemented") }.
output_atomic_stmt(_Indent, _FuncInfo,
- outline_foreign_proc(_TargetLang, _Lvals, _Code), _Context) -->
+ outline_foreign_proc(_TargetLang, _Vs, _Lvals, _Code),
+ _Context) -->
{ error("mlds_to_java.m: sorry, foreign language interfacing not implemented") }.
%------------------------------------------------------------------------------%
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.5
diff -u -r1.5 construct.m
--- library/construct.m 12 Jun 2002 06:46:32 -0000 1.5
+++ library/construct.m 12 Jun 2002 15:53:31 -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;
}").
@@ -589,10 +588,6 @@
MR_new_univ_on_hp(Term, type_info, new_data);
}").
-:- pragma foreign_proc("C#",
- construct_tuple_2(_Args::in, _ArgTypes::in, _Arity::in) = (_Term::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"{
- mercury.runtime.Errors.SORRY(""construct_tuple_2"");
- _Term = null;
-}").
+construct_tuple_2(_, _, _) = _ :-
+ % This version is only for if there is not a foreign_proc version.
+ private_builtin__sorry("construct_tuple_2").
Index: library/float.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/float.m,v
retrieving revision 1.46
diff -u -r1.46 float.m
--- library/float.m 12 Jun 2002 06:46:33 -0000 1.46
+++ library/float.m 12 Jun 2002 15:53:31 -0000
@@ -458,21 +458,17 @@
:- pragma foreign_proc("C", float__radix = (Radix::out),
[will_not_call_mercury, promise_pure, thread_safe],
"Radix = ML_FLOAT_RADIX;").
-:- pragma foreign_proc("C#", float__radix = (_Radix::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
- _Radix = 0;
-").
+float__radix = _ :-
+ % This version is only for if there is not a foreign_proc version
+ private_builtin__sorry("float__radix").
% The number of base-radix digits in the mantissa.
:- pragma foreign_proc("C", float__mantissa_digits = (MantDig::out),
[will_not_call_mercury, promise_pure, thread_safe],
"MantDig = ML_FLOAT_MANT_DIG;").
-:- pragma foreign_proc("C#", float__mantissa_digits = (_MantDig::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
- _MantDig = 0;
-").
+float__mantissa_digits = _ :-
+ % This version is only for if there is not a foreign_proc version
+ private_builtin__sorry("float__mantissa_digits").
% Minimum negative integer such that:
% radix ** (min_exponent - 1)
@@ -480,11 +476,9 @@
:- pragma foreign_proc("C", float__min_exponent = (MinExp::out),
[will_not_call_mercury, promise_pure, thread_safe],
"MinExp = ML_FLOAT_MIN_EXP;").
-:- pragma foreign_proc("C#", float__min_exponent = (_MinExp::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
- _MinExp = 0;
-").
+float__min_exponent = _ :-
+ % This version is only for if there is not a foreign_proc version
+ private_builtin__sorry("float__min_exponent").
% Maximum integer such that:
% radix ** (max_exponent - 1)
@@ -492,13 +486,9 @@
:- pragma foreign_proc("C", float__max_exponent = (MaxExp::out),
[will_not_call_mercury, promise_pure, thread_safe],
"MaxExp = ML_FLOAT_MAX_EXP;").
-
-:- pragma foreign_proc("C#", float__max_exponent = (_MaxExp::out),
- [will_not_call_mercury, promise_pure, thread_safe], "
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
- _MaxExp = 0;
-").
-
+float__max_exponent = _ :-
+ % This version is only for if there is not a foreign_proc version
+ private_builtin__sorry("float__max_exponent").
%---------------------------------------------------------------------------%
%---------------------------------------------------------------------------%
Index: library/io.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/io.m,v
retrieving revision 1.258
diff -u -r1.258 io.m
--- library/io.m 12 Jun 2002 06:46:34 -0000 1.258
+++ library/io.m 12 Jun 2002 15:53:32 -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)
@@ -4159,7 +4159,7 @@
""io__seek_binary_2: unseekable stream"");
}
- IO = IO0;
+ update_io(IO0, IO);
}").
:- pragma foreign_proc("C",
@@ -4177,7 +4177,7 @@
mercury_io_error(stream,
""io__binary_stream_offset: untellable stream"");
}
- IO = IO0;
+ update_io(IO0, IO);
}").
:- pragma foreign_proc("MC++",
@@ -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/std_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/std_util.m,v
retrieving revision 1.270
diff -u -r1.270 std_util.m
--- library/std_util.m 12 Jun 2002 06:46:40 -0000 1.270
+++ library/std_util.m 12 Jun 2002 15:53:36 -0000
@@ -1059,9 +1059,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.
Index: library/type_desc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/library/type_desc.m,v
retrieving revision 1.11
diff -u -r1.11 type_desc.m
--- library/type_desc.m 12 Jun 2002 06:46:46 -0000 1.11
+++ library/type_desc.m 12 Jun 2002 15:53:36 -0000
@@ -627,13 +627,9 @@
TypeCtor = (MR_Word) MR_make_type_ctor_desc(type_info, type_ctor_info);
}").
-:- pragma foreign_proc("C#",
- type_ctor(_TypeInfo::in) = (_TypeCtor::out),
- [will_not_call_mercury, thread_safe, promise_pure],
-"{
- mercury.runtime.Errors.SORRY(""foreign code for type_ctor"");
- _TypeCtor = null;
-}").
+type_ctor(_) = _ :-
+ % This version is only for if there is not a foreign_proc version
+ private_builtin__sorry("type_ctor").
:- pragma foreign_proc("C",
type_ctor_and_args(TypeDesc::in, TypeCtorDesc::out, ArgTypes::out),
--------------------------------------------------------------------------
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