[m-rev.] for review: C# backend
Peter Wang
novalazy at gmail.com
Mon Sep 13 13:15:48 AEST 2010
Branches: main
Start a C# backend, adapted from mlds_to_java.m.
Some `pragma foreign_*' declarations are commented out in this change because
no bootstrap compiler will yet accept "C#" in the language specification.
The compiler already supported C# foreign_procs for the IL backend, but the IL
backend and this new backend do not agree on naming and calling conventions so
the changes to the existing C# foreign_procs will further break the IL backend.
Nobody cares.
Only tested so far with Mono on Linux.
compiler/mlds_to_cs.m:
New module. In the CVS Attic there exists an obsolete file named
mlds_to_csharp.m (replaced by mlds_to_managed.m) which we don't want to
conflict with.
For C# we need to know if a `pragma foreign_type' is a value or
reference type. Currently this is done by accepting a fake keyword
`valuetype' before the type name, like for IL.
compiler/ml_backend.m:
compiler/mercury_compile.m:
compiler/mercury_compile_mlds_back_end.m:
Hook up the C# backend.
compiler/globals.m:
Add `target_csharp' as a target language.
compiler/options.m:
Add `--csharp' and `--csharp-only' options and their synonyms.
compiler/handle_options.m:
Handle `target_csharp' like `target_java', except for features which
are still to be implemented.
compiler/add_pragma.m:
Allow C# as a `pragma foreign_export' language.
Allow C# for `pragma foreign_export_enum'.
Conform to changes.
compiler/hlds_data.m:
compiler/prog_data.m:
compiler/prog_io_pragma.m:
Accept C# as a language for `pragma foreign_type'.
Accept `csharp' as the name of a grade in trace parameters.
compiler/make_hlds_passes.m:
Reuse most of the code for implementing mutables on Java for C#.
compiler/mlds.m:
Add a new MLDS target language, `ml_target_csharp'.
Conform to changes.
compiler/ml_foreign_proc_gen.m:
Generate foreign_procs for C#.
compiler/foreign.m:
Update predicates to support C# targets.
compiler/c_util.m:
Make `quote_string' use hexadecimal escapes in C# string literals.
compiler/parse_tree.m:
compiler/java_names.m:
Add C# equivalents for predicates in this module. `java_names' is a
misleading module name, but the predicates for C# and Java share some
code and may possibly be combined in the future.
compiler/rtti.m:
Add predicates to return the names of RTTI structures in C#.
compiler/simplify.m:
Handle the trace parameter `grade(csharp)'.
compiler/compile_target_code.m:
compiler/make.dependencies.m:
compiler/make.m:
compiler/make.module_target.m:
compiler/make.program_target.m:
compiler/make.util.m:
Add some support for building of executables and libraries with
`--target csharp'.
compiler/ml_global_data.m:
compiler/ml_optimize.m:
compiler/ml_proc_gen.m:
compiler/ml_switch_gen.m:
compiler/ml_type_gen.m:
compiler/ml_unify_gen.m:
compiler/add_pred.m:
compiler/add_type.m:
compiler/granularity.m:
compiler/inlining.m:
compiler/intermod.m:
compiler/lambda.m:
compiler/mercury_compile_middle_passes.m:
compiler/mercury_to_mercury.m:
compiler/ml_code_util.m:
compiler/ml_disj_gen.m:
compiler/mlds_to_c.m:
compiler/mlds_to_il.m:
compiler/mlds_to_java.m:
compiler/modules.m:
compiler/pragma_c_gen.m:
compiler/prog_foreign.m:
compiler/special_pred.m:
compiler/write_deps_file.m:
Conform to changes.
library/builtin.m:
library/rtti_implementation.m:
library/type_desc.m:
Implement RTTI procedures for the new backend, which uses a high-level
data representation (like the Java backend). The existing C# code was
designed for the IL backend, which used a low-level representation of
the RTTI data structures.
Most (if not all) of the the "new" code is exactly the same as the Java
versions, with only syntactic changes.
Rename the C# class `void_0' to `Void_0' to match the naming convention
used by mlds_to_cs.m.
library/array.m:
Update the existing C# code to work with the new backend.
Use `object[]' as the type of all arrays, rather than trying to use
specific types. The problem is one we encountered on the Java backend:
when creating a new array based on the type of a single element, we
don't know whether the new array should contain elements of the class
or superclass.
library/bool.m:
Export `bool' constants to C#.
library/exception.m:
Update the existing C# code to work with the new backend.
Move the `mercury.runtime.Exception' C# class to mercury_dotnet.cs.
library/float.m:
Add C# implementations of `is_nan' and `is_inf'.
library/list.m:
Add methods for manipulating lists from hand-written C# code.
library/string.m:
Add C# implementations of string procedures which were missing.
library/dir.m:
library/io.m:
library/library.m:
Update the existing C# code to work with the new backend.
library/private_builtin.m:
Update the existing C# code to work with the new backend.
Delete the static constants which are duplicated in mercury_dotnet.cs.
The mlds_to_cs.m will emit references to the constants in the latter
only.
library/backjump.m:
library/bitmap.m:
library/mutvar.m:
library/par_builtin.m:
library/region_builtin.m:
library/store.m:
library/thread.m:
library/thread.semaphore.m:
library/time.m:
library/univ.m:
Make these modules compile with the C# backend.
runtime/mercury_dotnet.cs.in:
Add RTTI classes to the `mercury.runtime' namespace, equivalent to
those on the Java backend.
Use enumerations `MR_TYPECTOR_REP_*' and `MR_SECTAG_*' constants so we
can switch on them.
Add the `UnreachableDefault' exception class.
Hide old classes which are unused with the new backend behind
#ifdef !MR_HIGHLEVEL_DATA.
diff --git a/compiler/add_pragma.m b/compiler/add_pragma.m
index 522f14a..2f91748 100644
--- a/compiler/add_pragma.m
+++ b/compiler/add_pragma.m
@@ -488,49 +488,16 @@ add_pragma_foreign_export_2(Arity, PredTable, Origin, Lang, Name, PredId,
[Msg]),
!:Specs = [Spec | !.Specs]
;
- % Emit a warning about using pragma foreign_export with
- % a foreign language that is not supported.
- % XXX That's currently C#.
- (
- Lang = lang_csharp,
- Pieces = [words("Warning:"),
- fixed("`:- pragma foreign_export' declarations"),
- words("are not yet implemented for language"),
- words(foreign_language_string(Lang)), suffix("."), nl],
- Msg = simple_msg(Context, [always(Pieces)]),
- Spec = error_spec(severity_warning,
- phase_parse_tree_to_hlds, [Msg]),
- !:Specs = [Spec | !.Specs]
- ;
- ( Lang = lang_c
- ; Lang = lang_il
- ; Lang = lang_java
- ; Lang = lang_erlang
- )
- ),
-
% Only add the foreign export if the specified language matches
% one of the foreign languages available for this backend.
- module_info_get_globals(!.ModuleInfo, Globals),
- globals.get_backend_foreign_languages(Globals, ForeignLanguages),
- (
- % XXX C# exports currently cause an
- % assertion failure in the MLDS->IL code generator.
-
- Lang \= lang_csharp,
- list.member(Lang, ForeignLanguages)
- ->
- module_info_get_pragma_exported_procs(!.ModuleInfo,
- PragmaExportedProcs0),
- NewExportedProc = pragma_exported_proc(Lang,
- PredId, ProcId, ExportedName, Context),
- PragmaExportedProcs =
- [NewExportedProc | PragmaExportedProcs0],
- module_info_set_pragma_exported_procs(PragmaExportedProcs,
- !ModuleInfo)
- ;
- true
- )
+ module_info_get_pragma_exported_procs(!.ModuleInfo,
+ PragmaExportedProcs0),
+ NewExportedProc = pragma_exported_proc(Lang,
+ PredId, ProcId, ExportedName, Context),
+ PragmaExportedProcs =
+ [NewExportedProc | PragmaExportedProcs0],
+ module_info_set_pragma_exported_procs(PragmaExportedProcs,
+ !ModuleInfo)
)
;
% We do not warn about errors in export pragmas created by the
@@ -997,17 +964,16 @@ add_ctor_to_name_map(Lang, Prefix, MakeUpperCase, _TypeModQual, Ctor,
),
ForeignName = Prefix ++ ForeignNameTail,
(
- Lang = lang_c,
- IsValidForeignName = pred_to_bool(is_valid_c_identifier(ForeignName))
- ;
- Lang = lang_java,
+ ( Lang = lang_c
+ ; Lang = lang_java
+ ; Lang = lang_csharp
+ ),
IsValidForeignName = pred_to_bool(is_valid_c_identifier(ForeignName))
;
- ( Lang = lang_csharp
- ; Lang = lang_il
+ ( Lang = lang_il
; Lang = lang_erlang
),
- sorry(this_file, "foreign_export_enum for language other than C")
+ sorry(this_file, "foreign_export_enum for target language")
),
(
IsValidForeignName = yes,
@@ -1240,6 +1206,7 @@ fixup_foreign_tag_val_qualification(TypeModuleName, !NamesAndTags,
target_lang_to_foreign_enum_lang(target_c) = lang_c.
target_lang_to_foreign_enum_lang(target_il) = lang_il.
+target_lang_to_foreign_enum_lang(target_csharp) = lang_csharp.
target_lang_to_foreign_enum_lang(target_java) = lang_java.
target_lang_to_foreign_enum_lang(target_asm) =
sorry(this_file, "pragma foreign_enum and --target `asm'.").
@@ -2894,6 +2861,9 @@ create_tabling_reset_pred(ProcId, Context, SimpleCallId, SingleProc,
TargetLang = target_il,
ForeignLang = lang_csharp
;
+ TargetLang = target_csharp,
+ ForeignLang = lang_csharp
+ ;
TargetLang = target_java,
ForeignLang = lang_java
;
diff --git a/compiler/add_pred.m b/compiler/add_pred.m
index ba5168d..97d92e6 100644
--- a/compiler/add_pred.m
+++ b/compiler/add_pred.m
@@ -259,6 +259,7 @@ add_builtin(PredId, Types, CompilationTarget, !PredInfo) :-
; Name = "store_at_ref"
),
( CompilationTarget = target_java
+ ; CompilationTarget = target_csharp
; CompilationTarget = target_erlang
)
)
diff --git a/compiler/add_type.m b/compiler/add_type.m
index 69399d4..dbd802d 100644
--- a/compiler/add_type.m
+++ b/compiler/add_type.m
@@ -447,6 +447,7 @@ check_foreign_type(TypeCtor, ForeignTypeBody, Context, FoundError, !ModuleInfo,
;
( Target = target_c, LangStr = "C"
; Target = target_il, LangStr = "IL"
+ ; Target = target_csharp, LangStr = "C#"
; Target = target_java, LangStr = "Java"
; Target = target_asm, LangStr = "C"
; Target = target_x86_64, LangStr = "C"
@@ -483,7 +484,7 @@ merge_foreign_type_bodies(Target, MakeOptInterface,
MaybeForeignTypeBody1 = yes(ForeignTypeBody1)
;
MaybeForeignTypeBody1 = no,
- ForeignTypeBody1 = foreign_type_body(no, no, no, no)
+ ForeignTypeBody1 = foreign_type_body(no, no, no, no, no)
),
merge_foreign_type_bodies_2(ForeignTypeBody0, ForeignTypeBody1,
ForeignTypeBody),
@@ -506,14 +507,18 @@ merge_foreign_type_bodies(_, _, hlds_foreign_type(Body0),
:- pred merge_foreign_type_bodies_2(foreign_type_body::in,
foreign_type_body::in, foreign_type_body::out) is semidet.
-merge_foreign_type_bodies_2(
- foreign_type_body(MaybeILA, MaybeCA, MaybeJavaA, MaybeErlangA),
- foreign_type_body(MaybeILB, MaybeCB, MaybeJavaB, MaybeErlangB),
- foreign_type_body(MaybeIL, MaybeC, MaybeJava, MaybeErlang)) :-
+merge_foreign_type_bodies_2(TypeBodyA, TypeBodyB, TypeBody) :-
+ TypeBodyA = foreign_type_body(MaybeILA, MaybeCA, MaybeJavaA, MaybeCSharpA,
+ MaybeErlangA),
+ TypeBodyB = foreign_type_body(MaybeILB, MaybeCB, MaybeJavaB, MaybeCSharpB,
+ MaybeErlangB),
merge_maybe(MaybeILA, MaybeILB, MaybeIL),
merge_maybe(MaybeCA, MaybeCB, MaybeC),
merge_maybe(MaybeJavaA, MaybeJavaB, MaybeJava),
- merge_maybe(MaybeErlangA, MaybeErlangB, MaybeErlang).
+ merge_maybe(MaybeCSharpA, MaybeCSharpB, MaybeCSharp),
+ merge_maybe(MaybeErlangA, MaybeErlangB, MaybeErlang),
+ TypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava, MaybeCSharp,
+ MaybeErlang).
:- pred merge_maybe(maybe(T)::in, maybe(T)::in, maybe(T)::out) is semidet.
@@ -654,22 +659,27 @@ convert_type_defn(parse_tree_foreign_type(ForeignType, MaybeUserEqComp,
ForeignType = il(ILForeignType),
Data = foreign_type_lang_data(ILForeignType, MaybeUserEqComp,
Assertions),
- Body = foreign_type_body(yes(Data), no, no, no)
+ Body = foreign_type_body(yes(Data), no, no, no, no)
;
ForeignType = c(CForeignType),
Data = foreign_type_lang_data(CForeignType, MaybeUserEqComp,
Assertions),
- Body = foreign_type_body(no, yes(Data), no, no)
+ Body = foreign_type_body(no, yes(Data), no, no, no)
;
ForeignType = java(JavaForeignType),
Data = foreign_type_lang_data(JavaForeignType, MaybeUserEqComp,
Assertions),
- Body = foreign_type_body(no, no, yes(Data), no)
+ Body = foreign_type_body(no, no, yes(Data), no, no)
+ ;
+ ForeignType = csharp(CSharpForeignType),
+ Data = foreign_type_lang_data(CSharpForeignType, MaybeUserEqComp,
+ Assertions),
+ Body = foreign_type_body(no, no, no, yes(Data), no)
;
ForeignType = erlang(ErlangForeignType),
Data = foreign_type_lang_data(ErlangForeignType, MaybeUserEqComp,
Assertions),
- Body = foreign_type_body(no, no, no, yes(Data))
+ Body = foreign_type_body(no, no, no, no, yes(Data))
).
:- pred ctors_add(list(constructor)::in, type_ctor::in, module_name::in,
diff --git a/compiler/c_util.m b/compiler/c_util.m
index 7f0c1de..07b8e86 100644
--- a/compiler/c_util.m
+++ b/compiler/c_util.m
@@ -68,7 +68,8 @@
%
:- type literal_language
---> literal_c
- ; literal_java.
+ ; literal_java
+ ; literal_csharp.
% Print out a string suitably escaped for use as a C string literal.
% This doesn't actually print out the enclosing double quotes --
@@ -421,7 +422,16 @@ quote_one_char(Lang, Char, RevChars0, RevChars) :-
->
RevChars = ['0', '\\' | RevChars0]
;
- escape_any_char(Char, EscapeChars),
+ (
+ Lang = literal_c,
+ octal_escape_any_char(Char, EscapeChars)
+ ;
+ Lang = literal_java,
+ octal_escape_any_char(Char, EscapeChars)
+ ;
+ Lang = literal_csharp,
+ hex_escape_any_char(Char, EscapeChars)
+ ),
reverse_append(EscapeChars, RevChars0, RevChars)
).
@@ -483,18 +493,29 @@ reverse_append([], L, L).
reverse_append([X | Xs], L0, L) :-
reverse_append(Xs, [X | L0], L).
-:- pred escape_any_char(char::in, list(char)::out) is det.
+:- pred octal_escape_any_char(char::in, list(char)::out) is det.
% Convert a character to the corresponding C octal escape code.
% XXX This assumes that the target language compiler's representation
% of characters is the same as the Mercury compiler's.
%
-escape_any_char(Char, EscapeCodeChars) :-
+octal_escape_any_char(Char, EscapeCodeChars) :-
char.to_int(Char, Int),
string.int_to_base_string(Int, 8, OctalString0),
string.pad_left(OctalString0, '0', 3, OctalString),
EscapeCodeChars = ['\\' | string.to_char_list(OctalString)].
+:- pred hex_escape_any_char(char::in, list(char)::out) is det.
+
+ % Convert a character to the corresponding hexadeciaml escape code.
+ % XXX This assumes that the target language compiler's representation
+ % of characters is the same as the Mercury compiler's.
+ %
+hex_escape_any_char(Char, EscapeCodeChars) :-
+ char.to_int(Char, Int),
+ string.format("\\x%04x", [i(Int)], HexString),
+ string.to_char_list(HexString, EscapeCodeChars).
+
%-----------------------------------------------------------------------------%
%
% Floating point literals
diff --git a/compiler/compile_target_code.m b/compiler/compile_target_code.m
index 62ce638..2b6881f 100644
--- a/compiler/compile_target_code.m
+++ b/compiler/compile_target_code.m
@@ -119,6 +119,7 @@
---> executable
; static_library
; shared_library
+ ; csharp_library
; java_archive
; erlang_archive.
@@ -1330,6 +1331,7 @@ link_module_list(Modules, ExtraObjFiles, Globals, Succeeded, !IO) :-
;
( Target = target_c
; Target = target_java
+ ; Target = target_csharp
; Target = target_il
; Target = target_x86_64
; Target = target_erlang
@@ -1695,6 +1697,11 @@ link(ErrorStream, LinkTargetType, ModuleName, ObjectsList, Globals, Succeeded,
create_archive(Globals, ErrorStream, OutputFileName, yes, ObjectsList,
LinkSucceeded, !IO)
;
+ LinkTargetType = csharp_library,
+ % XXX C# see also older predicate compile_csharp_file
+ create_csharp_exe_or_lib(Globals, ErrorStream, LinkTargetType,
+ OutputFileName, ObjectsList, LinkSucceeded, !IO)
+ ;
LinkTargetType = java_archive,
create_java_archive(Globals, ErrorStream, OutputFileName, ObjectsList,
LinkSucceeded, !IO)
@@ -1711,6 +1718,10 @@ link(ErrorStream, LinkTargetType, ModuleName, ObjectsList, Globals, Succeeded,
Target = target_java,
create_java_shell_script(Globals, ModuleName, LinkSucceeded, !IO)
;
+ Target = target_csharp,
+ create_csharp_exe_or_lib(Globals, ErrorStream, LinkTargetType,
+ OutputFileName, ObjectsList, LinkSucceeded, !IO)
+ ;
( Target = target_c
; Target = target_il
; Target = target_asm
@@ -1750,6 +1761,11 @@ link_output_filename(Globals, LinkTargetType, ModuleName, Ext, OutputFileName,
module_name_to_lib_file_name(Globals, "lib", ModuleName, Ext,
do_create_dirs, OutputFileName, !IO)
;
+ LinkTargetType = csharp_library,
+ Ext = ".dll",
+ module_name_to_file_name(Globals, ModuleName, Ext,
+ do_create_dirs, OutputFileName, !IO)
+ ;
LinkTargetType = java_archive,
Ext = ".jar",
module_name_to_file_name(Globals, ModuleName, Ext,
@@ -1769,6 +1785,9 @@ link_output_filename(Globals, LinkTargetType, ModuleName, Ext, OutputFileName,
% These are shell scripts.
Ext = ""
;
+ Target = target_csharp,
+ Ext = ".exe"
+ ;
( Target = target_c
; Target = target_il
; Target = target_asm
@@ -2012,6 +2031,9 @@ get_mercury_std_libs(Globals, TargetType, StdLibs) :-
),
globals.lookup_string_option(Globals, library_extension, LibExt)
;
+ TargetType = csharp_library,
+ unexpected(this_file, "get_mercury_std_libs: csharp_library")
+ ;
TargetType = java_archive,
unexpected(this_file, "get_mercury_std_libs: java_archive")
;
@@ -2196,6 +2218,9 @@ make_link_lib(Globals, TargetType, LibName, LinkOpt) :-
globals.lookup_string_option(Globals, LinkLibSuffix, Suffix),
LinkOpt = quote_arg(LinkLibOpt ++ LibName ++ Suffix)
;
+ TargetType = csharp_library,
+ unexpected(this_file, "make_link_lib: csharp_library")
+ ;
TargetType = java_archive,
unexpected(this_file, "make_link_lib: java_archive")
;
@@ -2280,6 +2305,9 @@ get_system_libs(Globals, TargetType, SystemLibs) :-
TargetType = static_library,
unexpected(this_file, "get_std_libs: static library")
;
+ TargetType = csharp_library,
+ unexpected(this_file, "get_std_libs: csharp library")
+ ;
TargetType = java_archive,
unexpected(this_file, "get_std_libs: java archive")
;
@@ -2319,6 +2347,7 @@ post_link_make_symlink_or_copy(ErrorStream, LinkTargetType, ModuleName,
;
( LinkTargetType = static_library
; LinkTargetType = shared_library
+ ; LinkTargetType = csharp_library
; LinkTargetType = java_archive
; LinkTargetType = erlang_archive
),
@@ -2448,6 +2477,42 @@ create_archive(Globals, ErrorStream, LibFileName, Quote, ObjectList,
RanLibCmd, Succeeded, !IO)
).
+:- pred create_csharp_exe_or_lib(globals::in, io.output_stream::in,
+ linked_target_type::in, file_name::in, list(file_name)::in, bool::out,
+ io::di, io::uo) is det.
+
+create_csharp_exe_or_lib(Globals, ErrorStream, LinkTargetType, OutputFileName,
+ SourceList, Succeeded, !IO) :-
+ globals.lookup_string_option(Globals, csharp_compiler, CSharpCompiler),
+ globals.lookup_bool_option(Globals, highlevel_data, HighLevelData),
+ (
+ HighLevelData = yes,
+ HighLevelDataOpt = "/define:MR_HIGHLEVEL_DATA"
+ ;
+ HighLevelData = no,
+ HighLevelDataOpt = ""
+ ),
+ globals.lookup_accumulating_option(Globals, csharp_flags, CSCFlagsList),
+ (
+ LinkTargetType = executable,
+ TargetOption = "/target:exe"
+ ;
+ LinkTargetType = csharp_library,
+ TargetOption = "/target:library"
+ ;
+ ( LinkTargetType = static_library
+ ; LinkTargetType = shared_library
+ ; LinkTargetType = java_archive
+ ; LinkTargetType = erlang_archive
+ ),
+ unexpected(this_file, "create_csharp_exe_or_lib: wrong target type")
+ ),
+ Cmd = string.join_list(" ", [CSharpCompiler, HighLevelDataOpt,
+ TargetOption, "/out:" ++ OutputFileName
+ | CSCFlagsList ++ SourceList]),
+ invoke_system_command(Globals, ErrorStream, cmd_verbose_commands, Cmd,
+ Succeeded, !IO).
+
:- pred create_java_archive(globals::in, io.output_stream::in, file_name::in,
list(file_name)::in, bool::out, io::di, io::uo) is det.
@@ -2588,6 +2653,7 @@ get_object_code_type(Globals, FileType, ObjectCodeType) :-
PIC = no,
(
( FileType = static_library
+ ; FileType = csharp_library
; FileType = java_archive
; FileType = erlang_archive
),
diff --git a/compiler/foreign.m b/compiler/foreign.m
index 6e16d8b..18423c5 100644
--- a/compiler/foreign.m
+++ b/compiler/foreign.m
@@ -522,6 +522,8 @@ have_foreign_type_for_backend(target_il, ForeignTypeBody,
( ForeignTypeBody ^ il = yes(_) -> yes ; no )).
have_foreign_type_for_backend(target_java, ForeignTypeBody,
( ForeignTypeBody ^ java = yes(_) -> yes ; no )).
+have_foreign_type_for_backend(target_csharp, ForeignTypeBody,
+ ( ForeignTypeBody ^ csharp = yes(_) -> yes ; no )).
have_foreign_type_for_backend(target_erlang, ForeignTypeBody,
( ForeignTypeBody ^ erlang = yes(_) -> yes ; no )).
have_foreign_type_for_backend(target_asm, ForeignTypeBody, Result) :-
@@ -576,7 +578,7 @@ foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody, Name,
% Any changes here may require changes there as well.
ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava,
- MaybeErlang),
+ MaybeCSharp, MaybeErlang),
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
(
@@ -601,6 +603,17 @@ foreign_type_body_to_exported_type(ModuleInfo, ForeignTypeBody, Name,
unexpected(this_file, "to_exported_type: no IL type")
)
;
+ Target = target_csharp,
+ (
+ MaybeCSharp = yes(Data),
+ Data = foreign_type_lang_data(csharp_type(NameStr),
+ MaybeUserEqComp, Assertions),
+ Name = unqualified(NameStr)
+ ;
+ MaybeCSharp = no,
+ unexpected(this_file, "to_exported_type: no C# type")
+ )
+ ;
Target = target_java,
(
MaybeJava = yes(Data),
@@ -721,10 +734,33 @@ exported_type_to_string(Lang, ExportedType) = Result :-
)
;
Lang = lang_csharp,
- sorry(this_file, "exported_type_to_string for csharp")
- ;
- Lang = lang_il,
- sorry(this_file, "exported_type_to_string for il")
+ (
+ Type = builtin_type(BuiltinType),
+ (
+ BuiltinType = builtin_type_int,
+ Result = "int"
+ ;
+ BuiltinType = builtin_type_float,
+ Result = "double"
+ ;
+ BuiltinType = builtin_type_string,
+ Result = "string"
+ ;
+ BuiltinType = builtin_type_char,
+ Result = "char"
+ )
+ ;
+ ( Type = tuple_type(_, _)
+ ; Type = defined_type(_, _, _)
+ ; Type = higher_order_type(_, _, _, _)
+ ; Type = apply_n_type(_, _, _)
+ ; Type = type_variable(_, _)
+ ; Type = kinded_type(_, _)
+ ),
+ % This is here so we can share some code between C/C#/Java
+ % backends. This is not the correct type to use in general.
+ Result = "object"
+ )
;
Lang = lang_java,
(
@@ -750,11 +786,14 @@ exported_type_to_string(Lang, ExportedType) = Result :-
; Type = type_variable(_, _)
; Type = kinded_type(_, _)
),
- % This is here so we can share some code between C and Java
+ % This is here so we can share some code between C/C#/Java
% backends. This is not the correct type to use in general.
Result = "java.lang.Object"
)
;
+ Lang = lang_il,
+ sorry(this_file, "exported_type_to_string for il")
+ ;
Lang = lang_erlang,
sorry(this_file, "exported_type_to_string for erlang")
)
diff --git a/compiler/globals.m b/compiler/globals.m
index 1aae549..7b1aabc 100644
--- a/compiler/globals.m
+++ b/compiler/globals.m
@@ -41,8 +41,8 @@
---> target_c % Generate C code (including GNU C).
; target_il % Generate IL assembler code.
% IL is the Microsoft .NET Intermediate Language.
+ ; target_csharp % Generate C#.
; target_java % Generate Java.
- % (Work in progress)
; target_asm % Compile directly to assembler via the GCC
% back-end. Do not go via C, instead generate GCC's
% internal `tree' data structure.
@@ -50,7 +50,6 @@
; target_x86_64 % Compile directly to x86_64 assembler.
% (Work in progress.)
; target_erlang. % Generate Erlang.
- % (Work in progress)
:- type foreign_language
---> lang_c
@@ -309,6 +308,7 @@ convert_target(String, Target) :-
:- pred convert_target_2(string::in, compilation_target::out) is semidet.
+convert_target_2("csharp", target_csharp).
convert_target_2("java", target_java).
convert_target_2("asm", target_asm).
convert_target_2("il", target_il).
@@ -440,6 +440,7 @@ convert_reuse_strategy("within_n_cells_difference", NCells,
within_n_cells_difference(NCells)).
compilation_target_string(target_c) = "C".
+compilation_target_string(target_csharp) = "C#".
compilation_target_string(target_il) = "IL".
compilation_target_string(target_java) = "Java".
compilation_target_string(target_asm) = "asm".
@@ -658,13 +659,14 @@ current_grade_supports_concurrency(Globals, ThreadsSupported) :-
;
( Target = target_erlang
; Target = target_il
+ ; Target = target_java
+ ; Target = target_csharp
),
ThreadsSupported = yes
;
- % Threads are not yet supported in the Java or x86_64 backends.
+ % Threads are not yet supported in the x86_64 backend.
% XXX I'm not sure what their status in the gcc backend is.
- ( Target = target_java
- ; Target = target_asm
+ ( Target = target_asm
; Target = target_x86_64
),
ThreadsSupported = no
diff --git a/compiler/granularity.m b/compiler/granularity.m
index 827b6f6..c00c73e 100644
--- a/compiler/granularity.m
+++ b/compiler/granularity.m
@@ -152,6 +152,7 @@ runtime_granularity_test_in_goal(Goal0, Goal, !Changed, SCC, ModuleInfo) :-
)
;
( Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_asm
; Target = target_x86_64
diff --git a/compiler/handle_options.m b/compiler/handle_options.m
index 0057c71..3120c7e 100644
--- a/compiler/handle_options.m
+++ b/compiler/handle_options.m
@@ -250,7 +250,8 @@ check_option_values(!OptionTable, Target, GC_Method, TagsMethod,
Target = target_c, % dummy
% XXX When the x86_64 backend is documented modify the line below.
add_error("Invalid target option " ++
- "(must be `c', `asm', `il', `java', or `erlang')", !Errors)
+ "(must be `c', `asm', `il', `java', 'csharp', or `erlang')",
+ !Errors)
),
map.lookup(!.OptionTable, gc, GC_Method0),
@@ -670,6 +671,7 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0,
)
;
( Target = target_c
+ ; Target = target_csharp
; Target = target_java
; Target = target_asm
; Target = target_x86_64
@@ -728,9 +730,13 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0,
% - cross compiling
% Because ints in Java are 32-bits wide which may be different to
% that of the host compiler.
+ %
+ % C# should be the same as Java.
(
- Target = target_java,
+ ( Target = target_java
+ ; Target = target_csharp
+ ),
globals.set_gc_method(gc_automatic, !Globals),
globals.set_option(gc, string("automatic"), !Globals),
globals.set_option(reclaim_heap_on_nondet_failure, bool(no),
@@ -748,7 +754,14 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0,
globals.set_option(pretest_equality_cast_pointers, bool(yes),
!Globals),
globals.set_option(libgrade_install_check, bool(no), !Globals),
- globals.set_option(cross_compiling, bool(yes), !Globals)
+ globals.set_option(cross_compiling, bool(yes), !Globals),
+ % XXX C# static data support not yet implemented
+ (
+ Target = target_csharp,
+ globals.set_option(static_ground_cells, bool(no), !Globals)
+ ;
+ Target = target_java
+ )
;
( Target = target_c
; Target = target_il
@@ -795,6 +808,7 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0,
; Target = target_asm
; Target = target_x86_64
; Target = target_java
+ ; Target = target_csharp
)
),
@@ -807,6 +821,7 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0,
;
( Target = target_c
; Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_x86_64
; Target = target_erlang
@@ -835,6 +850,7 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0,
( Target = target_asm
; Target = target_c
; Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_erlang
)
@@ -1228,6 +1244,7 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0,
% it is generating C or Java code.
(
( Target = target_c
+ ; Target = target_csharp
; Target = target_java
)
;
@@ -1380,6 +1397,7 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0,
globals.set_option(optimize_peep, bool(no), !Globals)
;
( Target = target_c
+ ; Target = target_csharp
; Target = target_java
; Target = target_asm
; Target = target_x86_64
@@ -2051,6 +2069,9 @@ convert_options_to_globals(OptionTable0, Target, GC_Method, TagsMethod0,
BackendForeignLanguages = ["il", "csharp"],
set_option(optimize_constructor_last_call, bool(no), !Globals)
;
+ Target = target_csharp,
+ BackendForeignLanguages = ["csharp"]
+ ;
Target = target_asm,
% XXX This is wrong! It should be asm.
BackendForeignLanguages = ["c"]
@@ -2762,6 +2783,14 @@ grade_component_table("java", comp_gcc_ext, [
highlevel_code - bool(yes),
highlevel_data - bool(yes)],
yes([string("java")]), yes).
+grade_component_table("csharp", comp_gcc_ext, [
+ asm_labels - bool(no),
+ gcc_non_local_gotos - bool(no),
+ gcc_global_registers - bool(no),
+ gcc_nested_functions - bool(no),
+ highlevel_code - bool(yes),
+ highlevel_data - bool(yes)],
+ yes([string("csharp")]), yes).
grade_component_table("erlang", comp_gcc_ext, [],
yes([string("erlang")]), yes).
diff --git a/compiler/hlds_data.m b/compiler/hlds_data.m
index bc6abf6..a8e621b 100644
--- a/compiler/hlds_data.m
+++ b/compiler/hlds_data.m
@@ -272,6 +272,7 @@
il :: foreign_type_lang_body(il_foreign_type),
c :: foreign_type_lang_body(c_foreign_type),
java :: foreign_type_lang_body(java_foreign_type),
+ csharp :: foreign_type_lang_body(csharp_foreign_type),
erlang :: foreign_type_lang_body(erlang_foreign_type)
).
diff --git a/compiler/inlining.m b/compiler/inlining.m
index b628891..9a46529 100644
--- a/compiler/inlining.m
+++ b/compiler/inlining.m
@@ -1051,6 +1051,7 @@ can_inline_proc_2(PredId, ProcId, BuiltinState, HighLevelCode,
ok_to_inline_language(lang_c, target_c).
ok_to_inline_language(lang_erlang, target_erlang).
ok_to_inline_language(lang_java, target_java).
+ok_to_inline_language(lang_csharp, target_csharp).
% ok_to_inline_language(il, il). %
% XXX we need to fix the handling of parameter marshalling for inlined code
diff --git a/compiler/intermod.m b/compiler/intermod.m
index 481f1ab..54864a4 100644
--- a/compiler/intermod.m
+++ b/compiler/intermod.m
@@ -1096,9 +1096,9 @@ gather_types_2(TypeCtor, TypeDefn0, !Info) :-
intermod_info::in, intermod_info::out) is det.
resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
- foreign_type_body(MaybeIL0, MaybeC0, MaybeJava0, MaybeErlang0),
- foreign_type_body(MaybeIL, MaybeC, MaybeJava, MaybeErlang),
- !Info) :-
+ ForeignTypeBody0, ForeignTypeBody, !Info) :-
+ ForeignTypeBody0 = foreign_type_body(MaybeIL0, MaybeC0, MaybeJava0,
+ MaybeCSharp0, MaybeErlang0),
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
@@ -1119,6 +1119,7 @@ resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
MaybeC0, MaybeC, !Info)
;
( Target = target_il
+ ; Target = target_csharp
; Target = target_java
),
MaybeC = MaybeC0
@@ -1130,6 +1131,7 @@ resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
;
( Target = target_c
; Target = target_asm
+ ; Target = target_csharp
; Target = target_java
; Target = target_x86_64
; Target = target_erlang
@@ -1137,6 +1139,20 @@ resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
MaybeIL = MaybeIL0
),
(
+ Target = target_csharp,
+ resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor,
+ MaybeCSharp0, MaybeCSharp, !Info)
+ ;
+ ( Target = target_c
+ ; Target = target_asm
+ ; Target = target_il
+ ; Target = target_java
+ ; Target = target_x86_64
+ ; Target = target_erlang
+ ),
+ MaybeCSharp = MaybeCSharp0
+ ),
+ (
Target = target_java,
resolve_foreign_type_body_overloading_2(ModuleInfo, TypeCtor,
MaybeJava0, MaybeJava, !Info)
@@ -1144,6 +1160,7 @@ resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
( Target = target_c
; Target = target_asm
; Target = target_il
+ ; Target = target_csharp
; Target = target_x86_64
; Target = target_erlang
),
@@ -1157,11 +1174,14 @@ resolve_foreign_type_body_overloading(ModuleInfo, TypeCtor,
( Target = target_c
; Target = target_asm
; Target = target_il
+ ; Target = target_csharp
; Target = target_x86_64
; Target = target_java
),
MaybeErlang = MaybeErlang0
- ).
+ ),
+ ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava,
+ MaybeCSharp, MaybeErlang).
:- pred resolve_foreign_type_body_overloading_2(module_info::in, type_ctor::in,
foreign_type_lang_body(T)::in, foreign_type_lang_body(T)::out,
@@ -1368,7 +1388,7 @@ write_type(OutInfo, TypeCtor - TypeDefn, !IO) :-
; Body ^ du_type_is_foreign_type = yes(ForeignTypeBody)
),
ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava,
- MaybeErlang)
+ MaybeCSharp, MaybeErlang)
->
(
MaybeIL = yes(DataIL),
@@ -1410,6 +1430,19 @@ write_type(OutInfo, TypeCtor - TypeDefn, !IO) :-
MaybeJava = no
),
(
+ MaybeCSharp = yes(DataCSharp),
+ DataCSharp = foreign_type_lang_data(CSharpForeignType,
+ CSharpMaybeUserEqComp, AssertionsCSharp),
+ CSharpItemTypeDefn = item_type_defn_info(VarSet, Name, Args,
+ parse_tree_foreign_type(csharp(CSharpForeignType),
+ CSharpMaybeUserEqComp, AssertionsCSharp),
+ cond_true, Context, -1),
+ CSharpItem = item_type_defn(CSharpItemTypeDefn),
+ mercury_output_item(MercInfo, CSharpItem, !IO)
+ ;
+ MaybeCSharp = no
+ ),
+ (
MaybeErlang = yes(DataErlang),
DataErlang = foreign_type_lang_data(ErlangForeignType,
ErlangMaybeUserEqComp, AssertionsErlang),
diff --git a/compiler/java_names.m b/compiler/java_names.m
index a7cafd4..60c316e 100644
--- a/compiler/java_names.m
+++ b/compiler/java_names.m
@@ -9,7 +9,7 @@
% File: java_names.m.
% Main authors: juliensf, mjwybrow, wangp.
%
-% This module contains utility routines related to naming things in Java,
+% This module contains utility routines related to naming things in Java/C#
% which are also required in the frontend.
%
%-----------------------------------------------------------------------------%
@@ -21,20 +21,20 @@
%-----------------------------------------------------------------------------%
- % For the Java back-end, we need to distinguish between module qualifiers
- % and type qualifiers, because type names get the case of their initial
- % letter inverted (i.e. lowercase => uppercase).
+ % For the C# and Java back-ends, we need to distinguish between module
+ % qualifiers and type qualifiers, because type names get the case of their
+ % initial letter inverted (i.e. lowercase => uppercase).
%
% This duplicates mlds_qual_kind so as not to introduce unwanted
% dependencies in either direction.
%
-:- type java_qual_kind
+:- type csj_qual_kind
---> module_qual
; type_qual.
% Mangle a name so that it is suitable for Java.
%
-:- pred mangle_sym_name_for_java(sym_name::in, java_qual_kind::in,
+:- pred mangle_sym_name_for_java(sym_name::in, csj_qual_kind::in,
string::in, string::out) is det.
% If the given name conficts with a reserved Java word we must add a
@@ -46,6 +46,32 @@
%
:- pred java_is_keyword(string::in) is semidet.
+ % The package containing the Mercury Java runtime classes.
+ %
+:- func java_mercury_runtime_package_name = sym_name.
+
+%-----------------------------------------------------------------------------%
+
+ % Mangle a name so that it is suitable for C#.
+ %
+:- pred mangle_sym_name_for_csharp(sym_name::in, csj_qual_kind::in,
+ string::in, string::out) is det.
+
+ % If the given name conficts with a reserved C# word we must add a
+ % prefix to it to avoid compilation errors.
+ %
+:- func valid_csharp_symbol_name(string) = string.
+
+ % Succeeds iff the given string matches a reserved word in C#.
+ %
+:- pred csharp_is_keyword(string::in) is semidet.
+
+ % The package containing the Mercury C# runtime classes.
+ %
+:- func csharp_mercury_runtime_package_name = sym_name.
+
+%-----------------------------------------------------------------------------%
+
% Invert the case of the first letter of the string.
%
:- func flip_initial_case(string) = string.
@@ -55,10 +81,6 @@
%
:- func flip_initial_case_of_final_part(sym_name) = sym_name.
- % The package containing the Mercury Java runtime classes.
- %
-:- func mercury_runtime_package_name = sym_name.
-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -71,6 +93,9 @@
:- import_module string.
%-----------------------------------------------------------------------------%
+%
+% Java naming
+%
mangle_sym_name_for_java(SymName0, QualKind, QualifierOp, JavaSafeName) :-
% Modules in the Mercury standard library get a `mercury' prefix when
@@ -84,7 +109,7 @@ mangle_sym_name_for_java(SymName0, QualKind, QualifierOp, JavaSafeName) :-
mangle_sym_name_for_java_2(SymName, QualKind, MangledSymName),
JavaSafeName = sym_name_to_string_sep(MangledSymName, QualifierOp).
-:- pred mangle_sym_name_for_java_2(sym_name::in, java_qual_kind::in,
+:- pred mangle_sym_name_for_java_2(sym_name::in, csj_qual_kind::in,
sym_name::out) is det.
mangle_sym_name_for_java_2(SymName, QualKind, MangledSymName) :-
@@ -100,7 +125,7 @@ mangle_sym_name_for_java_2(SymName, QualKind, MangledSymName) :-
MangledSymName = qualified(MangledModuleName, JavaSafePlainName)
).
-:- func java_safe_name_component(java_qual_kind, string) = string.
+:- func java_safe_name_component(csj_qual_kind, string) = string.
java_safe_name_component(QualKind, Name) = JavaSafeName :-
MangledName = name_mangle_no_leading_digit(Name),
@@ -113,8 +138,6 @@ java_safe_name_component(QualKind, Name) = JavaSafeName :-
),
JavaSafeName = valid_java_symbol_name(FlippedName).
-%-----------------------------------------------------------------------------%
-
valid_java_symbol_name(SymName) = ValidSymName :-
Prefix = "mr_",
( java_is_keyword(SymName) ->
@@ -129,8 +152,6 @@ valid_java_symbol_name(SymName) = ValidSymName :-
ValidSymName = SymName
).
-%-----------------------------------------------------------------------------%
-
java_is_keyword("abstract").
java_is_keyword("boolean").
java_is_keyword("break").
@@ -184,6 +205,144 @@ java_is_keyword("void").
java_is_keyword("volatile").
java_is_keyword("while").
+java_mercury_runtime_package_name =
+ qualified(unqualified("jmercury"), "runtime").
+
+%-----------------------------------------------------------------------------%
+%
+% C# naming
+%
+
+% XXX Reduce code duplication between C# and Java routines.
+
+mangle_sym_name_for_csharp(SymName, QualKind, QualifierOp, SafeName) :-
+ mangle_sym_name_for_csharp_2(SymName, QualKind, MangledSymName),
+ SafeName = sym_name_to_string_sep(MangledSymName, QualifierOp).
+
+:- pred mangle_sym_name_for_csharp_2(sym_name::in, csj_qual_kind::in,
+ sym_name::out) is det.
+
+mangle_sym_name_for_csharp_2(SymName, QualKind, MangledSymName) :-
+ (
+ SymName = unqualified(Name),
+ SafeName = csharp_safe_name_component(QualKind, Name),
+ MangledSymName = unqualified(SafeName)
+ ;
+ SymName = qualified(ModuleName0, PlainName),
+ mangle_sym_name_for_csharp_2(ModuleName0, module_qual,
+ MangledModuleName),
+ SafePlainName = csharp_safe_name_component(QualKind, PlainName),
+ MangledSymName = qualified(MangledModuleName, SafePlainName)
+ ).
+
+:- func csharp_safe_name_component(csj_qual_kind, string) = string.
+
+csharp_safe_name_component(QualKind, Name) = SafeName :-
+ MangledName = name_mangle_no_leading_digit(Name),
+ (
+ QualKind = module_qual,
+ FlippedName = MangledName
+ ;
+ QualKind = type_qual,
+ FlippedName = flip_initial_case(MangledName)
+ ),
+ SafeName = valid_csharp_symbol_name(FlippedName).
+
+valid_csharp_symbol_name(SymName) = ValidSymName :-
+ Prefix = "mr_",
+ ( csharp_is_keyword(SymName) ->
+ % This is a reserved word, add the above prefix.
+ ValidSymName = Prefix ++ SymName
+ ; string.append(Prefix, Suffix, SymName) ->
+ % This name already contains the prefix we are adding to
+ % variables to avoid conficts, so add an additional '_'.
+ ValidSymName = Prefix ++ "_" ++ Suffix
+ ;
+ % Normal name; do nothing.
+ ValidSymName = SymName
+ ).
+
+csharp_is_keyword("abstract").
+csharp_is_keyword("as").
+csharp_is_keyword("base").
+csharp_is_keyword("bool").
+csharp_is_keyword("break").
+csharp_is_keyword("byte").
+csharp_is_keyword("case").
+csharp_is_keyword("catch").
+csharp_is_keyword("char").
+csharp_is_keyword("checked").
+csharp_is_keyword("class").
+csharp_is_keyword("const").
+csharp_is_keyword("continue").
+csharp_is_keyword("decimal").
+csharp_is_keyword("default").
+csharp_is_keyword("delegate").
+csharp_is_keyword("do").
+csharp_is_keyword("double").
+csharp_is_keyword("else").
+csharp_is_keyword("enum").
+csharp_is_keyword("event").
+csharp_is_keyword("explicit").
+csharp_is_keyword("extern").
+csharp_is_keyword("false").
+csharp_is_keyword("finally").
+csharp_is_keyword("fixed").
+csharp_is_keyword("float").
+csharp_is_keyword("for").
+csharp_is_keyword("foreach").
+csharp_is_keyword("goto").
+csharp_is_keyword("if").
+csharp_is_keyword("implicit").
+csharp_is_keyword("in").
+csharp_is_keyword("int").
+csharp_is_keyword("interface").
+csharp_is_keyword("internal").
+csharp_is_keyword("is").
+csharp_is_keyword("lock").
+csharp_is_keyword("long").
+csharp_is_keyword("namespace").
+csharp_is_keyword("new").
+csharp_is_keyword("null").
+csharp_is_keyword("object").
+csharp_is_keyword("operator").
+csharp_is_keyword("out").
+csharp_is_keyword("override").
+csharp_is_keyword("params").
+csharp_is_keyword("private").
+csharp_is_keyword("protected").
+csharp_is_keyword("public").
+csharp_is_keyword("readonly").
+csharp_is_keyword("ref").
+csharp_is_keyword("return").
+csharp_is_keyword("sbyte").
+csharp_is_keyword("sealed").
+csharp_is_keyword("short").
+csharp_is_keyword("sizeof").
+csharp_is_keyword("stackalloc").
+csharp_is_keyword("static").
+csharp_is_keyword("string").
+csharp_is_keyword("struct").
+csharp_is_keyword("switch").
+csharp_is_keyword("this").
+csharp_is_keyword("throw").
+csharp_is_keyword("true").
+csharp_is_keyword("try").
+csharp_is_keyword("typeof").
+csharp_is_keyword("uint").
+csharp_is_keyword("ulong").
+csharp_is_keyword("unchecked").
+csharp_is_keyword("unsafe").
+csharp_is_keyword("ushort").
+csharp_is_keyword("using").
+csharp_is_keyword("virtual").
+csharp_is_keyword("volatile").
+csharp_is_keyword("void").
+csharp_is_keyword("while").
+
+csharp_mercury_runtime_package_name =
+ qualified(unqualified("mercury"), "runtime").
+
%-----------------------------------------------------------------------------%
flip_initial_case(S0) = S :-
@@ -207,10 +366,6 @@ flip_initial_case_of_final_part(qualified(Qual, Name)) =
%-----------------------------------------------------------------------------%
-mercury_runtime_package_name = qualified(unqualified("jmercury"), "runtime").
-
-%-----------------------------------------------------------------------------%
-
:- func this_file = string.
this_file = "java_names.m".
diff --git a/compiler/lambda.m b/compiler/lambda.m
index b537434..d5cc934 100644
--- a/compiler/lambda.m
+++ b/compiler/lambda.m
@@ -445,6 +445,7 @@ expand_lambda(Purity, _Groundness, PredOrFunc, EvalMethod, Vars, Modes,
(
( Target = target_c
; Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_asm
; Target = target_x86_64
diff --git a/compiler/make.dependencies.m b/compiler/make.dependencies.m
index 2b1ca18..2486959 100644
--- a/compiler/make.dependencies.m
+++ b/compiler/make.dependencies.m
@@ -410,6 +410,8 @@ target_dependencies(_, module_target_il_asm) =
combine_deps_list([
module_target_il_code `of` self
]).
+target_dependencies(Globals, module_target_csharp_code) =
+ compiled_code_dependencies(Globals).
target_dependencies(Globals, module_target_java_code) =
compiled_code_dependencies(Globals).
target_dependencies(_, module_target_java_class_code) =
@@ -514,6 +516,7 @@ target_to_module_target_code(CompilationTarget, PIC) = TargetCode :-
;
( CompilationTarget = target_c
; CompilationTarget = target_il
+ ; CompilationTarget = target_csharp
; CompilationTarget = target_java
; CompilationTarget = target_x86_64
; CompilationTarget = target_erlang
diff --git a/compiler/make.m b/compiler/make.m
index eb6375a..0fa71de 100644
--- a/compiler/make.m
+++ b/compiler/make.m
@@ -222,6 +222,7 @@
; module_target_c_code
; module_target_il_code
; module_target_il_asm
+ ; module_target_csharp_code
; module_target_java_code
; module_target_java_class_code
; module_target_erlang_header
diff --git a/compiler/make.module_target.m b/compiler/make.module_target.m
index c11a859..a4ead91 100644
--- a/compiler/make.module_target.m
+++ b/compiler/make.module_target.m
@@ -537,6 +537,9 @@ build_object_code(Globals, ModuleName, Target, PIC, ErrorStream, Imports,
JavaFile, !IO),
compile_java_files(ErrorStream, [JavaFile], Globals, Succeeded, !IO)
;
+ Target = target_csharp,
+ sorry(this_file, "NYI mmc --make and target csharp")
+ ;
Target = target_il,
il_assemble(ErrorStream, ModuleName, Imports ^ mai_has_main,
Globals, Succeeded, !IO)
@@ -636,6 +639,9 @@ get_object_extension(Globals, PIC) = Ext :-
CompilationTarget = target_il,
Ext = ".dll"
;
+ CompilationTarget = target_csharp,
+ sorry(this_file, "object extension for csharp")
+ ;
CompilationTarget = target_java,
sorry(this_file, "object extension for java")
;
@@ -836,6 +842,8 @@ compilation_task(_, module_target_il_code) =
process_module(task_compile_to_target_code) - ["--il-only"].
compilation_task(_, module_target_il_asm) =
target_code_to_object_code(non_pic) - [].
+compilation_task(_, module_target_csharp_code) =
+ process_module(task_compile_to_target_code) - ["--csharp-only"].
compilation_task(_, module_target_java_code) =
process_module(task_compile_to_target_code) - ["--java-only"].
compilation_task(_, module_target_java_class_code) =
@@ -990,6 +998,7 @@ touched_files_process_module(Globals, TargetFile, Task, TouchedTargetFiles,
module_target_c_header(header_mih))
;
( CompilationTarget = target_il
+ ; CompilationTarget = target_csharp
; CompilationTarget = target_java
),
HeaderTargets0 = []
@@ -1014,6 +1023,7 @@ touched_files_process_module(Globals, TargetFile, Task, TouchedTargetFiles,
++ HeaderTargets0
;
( CompilationTarget = target_il
+ ; CompilationTarget = target_csharp
; CompilationTarget = target_java
; CompilationTarget = target_erlang
),
@@ -1108,6 +1118,7 @@ external_foreign_code_files(Globals, PIC, Imports, ForeignFiles, !IO) :-
ForeignFiles = ForeignFiles0 ++ FactTableForeignFiles
;
( CompilationTarget = target_java
+ ; CompilationTarget = target_csharp
; CompilationTarget = target_il
; CompilationTarget = target_x86_64
; CompilationTarget = target_erlang
@@ -1158,6 +1169,7 @@ target_type_to_pic(TargetType) = Result :-
; TargetType = module_target_c_code
; TargetType = module_target_il_code
; TargetType = module_target_il_asm
+ ; TargetType = module_target_csharp_code
; TargetType = module_target_java_code
; TargetType = module_target_java_class_code
; TargetType = module_target_erlang_header
diff --git a/compiler/make.program_target.m b/compiler/make.program_target.m
index adaa07d..f046684 100644
--- a/compiler/make.program_target.m
+++ b/compiler/make.program_target.m
@@ -68,6 +68,7 @@ make_linked_target(Globals, LinkedTargetFile, LinkedTargetSucceeded,
ExtraOptions = ["--compile-to-shared-lib"]
;
( FileType = executable
+ ; FileType = csharp_library
; FileType = java_archive
; FileType = erlang_archive
; FileType = static_library
@@ -171,6 +172,10 @@ make_linked_target_2(LinkedTargetFile, Globals, _, Succeeded, !Info, !IO) :-
IntermediateTargetType = module_target_il_code,
ObjectTargetType = module_target_il_asm
;
+ CompilationTarget = target_csharp,
+ IntermediateTargetType = module_target_csharp_code,
+ ObjectTargetType = module_target_csharp_code
+ ;
CompilationTarget = target_java,
IntermediateTargetType = module_target_java_code,
ObjectTargetType = module_target_java_class_code
@@ -412,6 +417,7 @@ get_foreign_object_targets(Globals, PIC, ModuleName, ObjectTargets,
ObjectTargets = FactObjectTargets ++ ForeignObjectTargets
;
( CompilationTarget = target_java
+ ; CompilationTarget = target_csharp
; CompilationTarget = target_il
; CompilationTarget = target_x86_64
; CompilationTarget = target_erlang
@@ -485,6 +491,7 @@ build_linked_target_2(Globals, MainModuleName, FileType, OutputFileName,
MaybeInitObjectResult = yes(InitObjectResult)
;
( CompilationTarget = target_il
+ ; CompilationTarget = target_csharp
; CompilationTarget = target_java
; CompilationTarget = target_x86_64
),
@@ -513,6 +520,7 @@ build_linked_target_2(Globals, MainModuleName, FileType, OutputFileName,
;
( FileType = static_library
; FileType = shared_library
+ ; FileType = csharp_library
; FileType = java_archive
; FileType = erlang_archive
),
@@ -619,6 +627,10 @@ build_linked_target_2(Globals, MainModuleName, FileType, OutputFileName,
CompilationTarget = target_il,
ObjExtToUse = ".dll"
;
+ CompilationTarget = target_csharp,
+ % There is no separate object code step.
+ ObjExtToUse = ".cs"
+ ;
CompilationTarget = target_java,
globals.lookup_string_option(NoLinkObjsGlobals,
java_object_file_extension, ObjExtToUse)
@@ -641,6 +653,7 @@ build_linked_target_2(Globals, MainModuleName, FileType, OutputFileName,
; CompilationTarget = target_asm
; CompilationTarget = target_erlang
; CompilationTarget = target_java
+ ; CompilationTarget = target_csharp
),
% Run the link in a separate process so it can be killed
% if an interrupt is received.
@@ -1229,6 +1242,9 @@ build_library(MainModuleName, AllModules, Globals, Succeeded, !Info, !IO) :-
Target = target_il,
sorry(this_file, "build_library: target IL not supported yet")
;
+ Target = target_csharp,
+ build_csharp_library(Globals, MainModuleName, Succeeded, !Info, !IO)
+ ;
Target = target_java,
build_java_library(Globals, MainModuleName, Succeeded, !Info, !IO)
;
@@ -1276,6 +1292,14 @@ build_c_library(Globals, MainModuleName, AllModules, Succeeded, !Info, !IO) :-
Succeeded = no
).
+:- pred build_csharp_library(globals::in, module_name::in, bool::out,
+ make_info::in, make_info::out, io::di, io::uo) is det.
+
+build_csharp_library(Globals, MainModuleName, Succeeded, !Info, !IO) :-
+ make_linked_target(Globals,
+ linked_target_file(MainModuleName, csharp_library),
+ Succeeded, !Info, !IO).
+
:- pred build_java_library(globals::in, module_name::in, bool::out,
make_info::in, make_info::out, io::di, io::uo) is det.
@@ -1407,6 +1431,7 @@ install_ints_and_headers(Globals, SubdirLinkSucceeded, ModuleName, Succeeded,
install_file(Globals, FileName, LibDir/"inc", HeaderSucceeded, !IO)
;
( Target = target_java
+ ; Target = target_csharp
; Target = target_il
; Target = target_x86_64
),
@@ -2006,6 +2031,7 @@ make_module_clean(Globals, ModuleName, !Info, !IO) :-
module_target_c_code,
module_target_c_header(header_mih),
module_target_il_code,
+ module_target_csharp_code,
module_target_java_code,
module_target_java_class_code,
module_target_erlang_code,
diff --git a/compiler/make.util.m b/compiler/make.util.m
index f2d565d..2c9c4d3 100644
--- a/compiler/make.util.m
+++ b/compiler/make.util.m
@@ -1385,6 +1385,7 @@ target_extension(_, module_target_il_code) = yes(".il").
% XXX ".exe" if the module contains main.
target_extension(_, module_target_il_asm) = yes(".dll").
+target_extension(_, module_target_csharp_code) = yes(".cs").
target_extension(_, module_target_java_code) = yes(".java").
target_extension(_, module_target_java_class_code) = yes(".class").
target_extension(_, module_target_erlang_header) = yes(".hrl").
@@ -1415,6 +1416,7 @@ linked_target_file_name(Globals, ModuleName, TargetType, FileName, !IO) :-
;
( Target = target_c
; Target = target_il
+ ; Target = target_csharp
; Target = target_asm
; Target = target_x86_64
),
@@ -1434,6 +1436,10 @@ linked_target_file_name(Globals, ModuleName, TargetType, FileName, !IO) :-
module_name_to_lib_file_name(Globals, "lib", ModuleName, Ext,
do_not_create_dirs, FileName, !IO)
;
+ TargetType = csharp_library,
+ module_name_to_file_name(Globals, ModuleName, ".dll",
+ do_not_create_dirs, FileName, !IO)
+ ;
TargetType = java_archive,
module_name_to_file_name(Globals, ModuleName, ".jar",
do_not_create_dirs, FileName, !IO)
@@ -1521,6 +1527,7 @@ module_target_to_file_name_maybe_search(Globals, ModuleName, TargetType,
; TargetType = make.module_target_il_asm
; TargetType = module_target_il_code
; TargetType = module_target_intermodule_interface
+ ; TargetType = module_target_csharp_code
; TargetType = module_target_java_code
; TargetType = module_target_java_class_code
; TargetType = module_target_long_interface
@@ -1566,6 +1573,7 @@ timestamp_extension(Globals, module_target_c_header(_)) = Ext :-
( Target = target_c
; Target = target_x86_64
; Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_erlang
),
@@ -1573,6 +1581,7 @@ timestamp_extension(Globals, module_target_c_header(_)) = Ext :-
),
Ext = timestamp_extension(Globals, ModuleTargetType).
timestamp_extension(_, module_target_il_code) = ".il_date".
+timestamp_extension(_, module_target_csharp_code) = ".cs_date".
timestamp_extension(_, module_target_java_code) = ".java_date".
timestamp_extension(_, module_target_erlang_code) = ".erl_date".
timestamp_extension(Globals, module_target_erlang_header) =
@@ -1600,6 +1609,7 @@ search_for_file_type(module_target_c_header(_)) = yes(c_include_directory).
search_for_file_type(module_target_c_code) = no.
search_for_file_type(module_target_il_code) = no.
search_for_file_type(module_target_il_asm) = no.
+search_for_file_type(module_target_csharp_code) = no.
search_for_file_type(module_target_java_code) = no.
search_for_file_type(module_target_java_class_code) = no.
search_for_file_type(module_target_erlang_header) =
@@ -1638,6 +1648,7 @@ is_target_grade_or_arch_dependent(Target) = IsDependent :-
; Target = module_target_c_code
; Target = module_target_il_code
; Target = module_target_il_asm
+ ; Target = module_target_csharp_code
; Target = module_target_java_code
; Target = module_target_java_class_code
; Target = module_target_erlang_code
@@ -1924,6 +1935,9 @@ module_target_type_to_nonce(Type) = X :-
;
Type = module_target_java_class_code,
X = 25
+ ;
+ Type = module_target_csharp_code,
+ X = 26
).
:- func pic_to_nonce(pic) = int.
diff --git a/compiler/make_hlds_passes.m b/compiler/make_hlds_passes.m
index 338472a..36938ed 100644
--- a/compiler/make_hlds_passes.m
+++ b/compiler/make_hlds_passes.m
@@ -541,7 +541,9 @@ add_pass_1_mutable(Item, Status, !ModuleInfo, !Specs) :-
WantLockDecls = yes,
WantUnsafeAccessDecls = yes
;
- CompilationTarget = target_java,
+ ( CompilationTarget = target_java
+ ; CompilationTarget = target_csharp
+ ),
WantPreInitDecl = no,
WantLockDecls = no,
WantUnsafeAccessDecls = yes
@@ -886,6 +888,9 @@ add_pass_2_mutable(ItemMutable, Status, !ModuleInfo, !Specs) :-
CompilationTarget = target_java,
ForeignLanguage = lang_java
;
+ CompilationTarget = target_csharp,
+ ForeignLanguage = lang_csharp
+ ;
CompilationTarget = target_erlang,
ForeignLanguage = lang_erlang
),
@@ -1454,6 +1459,9 @@ add_pass_3_initialise(ItemInitialise, Status, !ModuleInfo, !QualInfo,
CompilationTarget = target_java,
MaybeExportLang = yes(lang_java)
;
+ CompilationTarget = target_csharp,
+ MaybeExportLang = yes(lang_csharp)
+ ;
CompilationTarget = target_erlang,
MaybeExportLang = yes(lang_erlang)
;
@@ -1624,6 +1632,9 @@ target_lang_to_foreign_export_lang(CompilationTarget) = ExportLang :-
CompilationTarget = target_il,
ExportLang = lang_il
;
+ CompilationTarget = target_csharp,
+ ExportLang = lang_csharp
+ ;
CompilationTarget = target_java,
ExportLang = lang_java
).
@@ -1668,21 +1679,27 @@ add_pass_3_mutable(ItemMutable, Status, !ModuleInfo, !QualInfo, !Specs) :-
add_c_mutable_preds(ItemMutable, TargetMutableName,
Status, _, !ModuleInfo, !QualInfo, !Specs)
;
- CompilationTarget = target_java,
+ (
+ CompilationTarget = target_java,
+ Lang = lang_java
+ ;
+ CompilationTarget = target_csharp,
+ Lang = lang_csharp
+ ),
% Work out what name to give the global in the target language.
decide_mutable_target_var_name(!.ModuleInfo, MutAttrs,
- ModuleName, MercuryMutableName, lang_java, Context,
+ ModuleName, MercuryMutableName, Lang, Context,
TargetMutableName, !Specs),
% Add foreign_code item that defines the global variable used to
% implement the mutable.
IsThreadLocal = mutable_var_thread_local(MutAttrs),
- add_java_mutable_defn(TargetMutableName, Type, IsThreadLocal,
- Context, !ModuleInfo, !QualInfo, !Specs),
+ add_csharp_java_mutable_defn(Lang, TargetMutableName, Type,
+ IsThreadLocal, Context, !ModuleInfo, !QualInfo, !Specs),
% Add all the predicates related to mutables.
- add_java_mutable_preds(ItemMutable, TargetMutableName,
+ add_csharp_java_mutable_preds(ItemMutable, Lang, TargetMutableName,
Status, _, !ModuleInfo, !QualInfo, !Specs)
;
CompilationTarget = target_erlang,
@@ -1910,7 +1927,7 @@ add_c_mutable_preds(ItemMutableInfo, TargetMutableName, !Status, !ModuleInfo,
IsConstant = yes,
InitSetPredName = mutable_secret_set_pred_sym_name(ModuleName,
MercuryMutableName),
- add_c_java_constant_mutable_access_preds(TargetMutableName,
+ add_ccsj_constant_mutable_access_preds(TargetMutableName,
ModuleName, MercuryMutableName, Attrs, Inst, BoxPolicy,
Context, !Status, !ModuleInfo, !QualInfo, !Specs)
;
@@ -1922,8 +1939,8 @@ add_c_mutable_preds(ItemMutableInfo, TargetMutableName, !Status, !ModuleInfo,
add_c_mutable_primitive_preds(TargetMutableName, ModuleName,
MercuryMutableName, MutAttrs, Attrs, Inst, BoxPolicy, TypeName,
Context, !Status, !ModuleInfo, !QualInfo, !Specs),
- add_c_java_mutable_user_access_preds(ModuleName, MercuryMutableName,
- MutAttrs, for_c, Context, !Status, !ModuleInfo, !QualInfo, !Specs)
+ add_ccsj_mutable_user_access_preds(ModuleName, MercuryMutableName,
+ MutAttrs, lang_c, Context, !Status, !ModuleInfo, !QualInfo, !Specs)
),
add_c_mutable_initialisation(IsConstant, IsThreadLocal,
TargetMutableName, ModuleName, MercuryMutableName, MutVarset,
@@ -1931,15 +1948,15 @@ add_c_mutable_preds(ItemMutableInfo, TargetMutableName, !Status, !ModuleInfo,
Context, !Status, !ModuleInfo, !QualInfo, !Specs).
% Add the access predicates for constant mutables.
- % Shared between C and Java.
+ % Shared between C, C# and Java.
%
-:- pred add_c_java_constant_mutable_access_preds(string::in, module_name::in,
+:- pred add_ccsj_constant_mutable_access_preds(string::in, module_name::in,
string::in, pragma_foreign_proc_attributes::in, mer_inst::in,
box_policy::in, prog_context::in, import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_c_java_constant_mutable_access_preds(TargetMutableName,
+add_ccsj_constant_mutable_access_preds(TargetMutableName,
ModuleName, MutableName, Attrs, Inst, BoxPolicy, Context,
!Status, !ModuleInfo, !QualInfo, !Specs) :-
varset.new_named_var(varset.init, "X", X, ProgVarSet),
@@ -2127,23 +2144,24 @@ add_c_mutable_primitive_preds(TargetMutableName, ModuleName, MutableName,
UnsafeSetItem = item_pragma(UnsafeSetItemPragma),
add_item_pass_3(UnsafeSetItem, !Status, !ModuleInfo, !QualInfo, !Specs).
-:- type for_c_or_java
- ---> for_c
- ; for_java.
+:- inst lang_ccsj
+ ---> lang_c
+ ; lang_csharp
+ ; lang_java.
% Add the access predicates for a non-constant mutable.
% If the mutable has the `attach_to_io_state' attribute then add the
% versions of the access preds that take the I/O state as well.
- % Shared between C and Java.
+ % Shared between C, C# and Java.
%
-:- pred add_c_java_mutable_user_access_preds(module_name::in, string::in,
- mutable_var_attributes::in, for_c_or_java::in, prog_context::in,
- import_status::in, import_status::out,
+:- pred add_ccsj_mutable_user_access_preds(module_name::in, string::in,
+ mutable_var_attributes::in, foreign_language::in(lang_ccsj),
+ prog_context::in, import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_c_java_mutable_user_access_preds(ModuleName, MutableName, MutAttrs,
- ForLang, Context, !Status, !ModuleInfo, !QualInfo, !Specs) :-
+add_ccsj_mutable_user_access_preds(ModuleName, MutableName, MutAttrs,
+ Lang, Context, !Status, !ModuleInfo, !QualInfo, !Specs) :-
varset.new_named_var(varset.init, "X", X, ProgVarSet0),
LockPredName = mutable_lock_pred_sym_name(ModuleName, MutableName),
@@ -2162,15 +2180,18 @@ add_c_java_mutable_user_access_preds(ModuleName, MutableName, MutAttrs,
SetPredName = mutable_set_pred_sym_name(ModuleName, MutableName),
(
- ForLang = for_c,
+ Lang = lang_c,
GetBody = goal_list_to_conj(Context, [CallLock, CallGetter,
CallUnlock]),
StdSetBody = goal_list_to_conj(Context, [CallLock, CallSetter,
CallUnlock])
;
- ForLang = for_java,
+ ( Lang = lang_java
+ ; Lang = lang_csharp
+ ),
% There are no separate lock predicates for Java; the synchronisation
% is performed within the "unsafe" predicates.
+ % XXX C# needs investigation
GetBody = CallGetter,
StdSetBody = CallSetter
),
@@ -2303,30 +2324,53 @@ add_c_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
%-----------------------------------------------------------------------------%
%
-% Java mutables
+% C#/Java mutables
%
+:- inst lang_csharp_java
+ ---> lang_csharp
+ ; lang_java.
+
% Add foreign_code item that defines the global variable used to hold the
% mutable.
%
-:- pred add_java_mutable_defn(string::in, mer_type::in,
- mutable_thread_local::in, prog_context::in,
+:- pred add_csharp_java_mutable_defn(foreign_language::in(lang_csharp_java),
+ string::in, mer_type::in, mutable_thread_local::in, prog_context::in,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_java_mutable_defn(TargetMutableName, Type, IsThreadLocal, Context,
- !ModuleInfo, !QualInfo, !Specs) :-
- get_java_mutable_global_foreign_defn(!.ModuleInfo, Type,
- TargetMutableName, IsThreadLocal, Context, ForeignDefn),
+add_csharp_java_mutable_defn(Lang, TargetMutableName, _Type, IsThreadLocal,
+ Context, !ModuleInfo, !QualInfo, !Specs) :-
+ get_csharp_java_mutable_global_foreign_defn(Lang, TargetMutableName,
+ IsThreadLocal, Context, DefnBody),
+ DefnPragma = pragma_foreign_code(Lang, DefnBody),
+ DefnItemPragma = item_pragma_info(compiler(mutable_decl), DefnPragma,
+ Context, -1),
+ ForeignDefn = item_pragma(DefnItemPragma),
ItemStatus0 = item_status(status_local, may_be_unqualified),
add_item_decl_pass_2(ForeignDefn, ItemStatus0, _, !ModuleInfo, !Specs).
-:- pred get_java_mutable_global_foreign_defn(module_info::in, mer_type::in,
- string::in, mutable_thread_local::in, prog_context::in, item::out) is det.
+:- pred get_csharp_java_mutable_global_foreign_defn(
+ foreign_language::in(lang_csharp_java), string::in,
+ mutable_thread_local::in, prog_context::in, string::out) is det.
-get_java_mutable_global_foreign_defn(_ModuleInfo, _Type, TargetMutableName,
- IsThreadLocal, Context, DefnItem) :-
+get_csharp_java_mutable_global_foreign_defn(Lang, TargetMutableName,
+ IsThreadLocal, _Context, DefnBody) :-
(
+ Lang = lang_csharp,
+ (
+ IsThreadLocal = mutable_not_thread_local,
+ ThreadStaticAttribute = ""
+ ;
+ IsThreadLocal = mutable_thread_local,
+ % XXX C#: This does not inherit the value from the parent thread.
+ % We will probably need to use the ThreadLocal<T> class instead.
+ ThreadStaticAttribute = "[System.ThreadStatic] "
+ ),
+ DefnBody = string.append_list([ThreadStaticAttribute,
+ "static object ", TargetMutableName, ";\n"])
+ ;
+ Lang = lang_java,
IsThreadLocal = mutable_not_thread_local,
% Synchronization is only required for double and long values, which
% Mercury does not expose. We could also use the volatile keyword.
@@ -2334,31 +2378,28 @@ get_java_mutable_global_foreign_defn(_ModuleInfo, _Type, TargetMutableName,
DefnBody = string.append_list([
"static java.lang.Object ", TargetMutableName, ";\n"])
;
+ Lang = lang_java,
IsThreadLocal = mutable_thread_local,
DefnBody = string.append_list([
"static java.lang.ThreadLocal<java.lang.Object> ",
TargetMutableName,
" = new java.lang.InheritableThreadLocal<java.lang.Object>();\n"
])
- ),
-
- DefnPragma = pragma_foreign_code(lang_java, DefnBody),
- DefnItemPragma = item_pragma_info(compiler(mutable_decl), DefnPragma,
- Context, -1),
- DefnItem = item_pragma(DefnItemPragma).
+ ).
-:- pred add_java_mutable_preds(item_mutable_info::in, string::in,
+:- pred add_csharp_java_mutable_preds(item_mutable_info::in,
+ foreign_language::in(lang_csharp_java), string::in,
import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_java_mutable_preds(ItemMutable, TargetMutableName,
+add_csharp_java_mutable_preds(ItemMutable, Lang, TargetMutableName,
!Status, !ModuleInfo, !QualInfo, !Specs) :-
module_info_get_name(!.ModuleInfo, ModuleName),
ItemMutable = item_mutable_info(MercuryMutableName, _Type, InitTerm, Inst,
MutAttrs, MutVarset, Context, _SeqNum),
IsConstant = mutable_var_constant(MutAttrs),
- Attrs0 = default_attributes(lang_java),
+ Attrs0 = default_attributes(Lang),
% The mutable variable name is not module-qualified so cannot be exported
% to `.opt' files. We could add the qualification but it would be better
% to move the mutable code generation into the backends first.
@@ -2376,36 +2417,37 @@ add_java_mutable_preds(ItemMutable, TargetMutableName,
IsConstant = yes,
InitSetPredName = mutable_secret_set_pred_sym_name(ModuleName,
MercuryMutableName),
- add_c_java_constant_mutable_access_preds(TargetMutableName,
+ add_ccsj_constant_mutable_access_preds(TargetMutableName,
ModuleName, MercuryMutableName, Attrs, Inst, BoxPolicy,
Context, !Status, !ModuleInfo, !QualInfo, !Specs)
;
IsConstant = no,
InitSetPredName = mutable_set_pred_sym_name(ModuleName,
MercuryMutableName),
- add_java_mutable_primitive_preds(TargetMutableName, ModuleName,
- MercuryMutableName, MutAttrs, Attrs, Inst, BoxPolicy,
+ add_csharp_java_mutable_primitive_preds(Lang, TargetMutableName,
+ ModuleName, MercuryMutableName, MutAttrs, Attrs, Inst, BoxPolicy,
Context, !Status, !ModuleInfo, !QualInfo, !Specs),
- add_c_java_mutable_user_access_preds(ModuleName, MercuryMutableName,
- MutAttrs, for_java,
+ add_ccsj_mutable_user_access_preds(ModuleName, MercuryMutableName,
+ MutAttrs, Lang,
Context, !Status, !ModuleInfo, !QualInfo, !Specs)
),
- add_java_mutable_initialisation(ModuleName, MercuryMutableName, MutVarset,
- InitSetPredName, InitTerm,
+ add_csharp_java_mutable_initialisation(ModuleName, MercuryMutableName,
+ MutVarset, InitSetPredName, InitTerm,
Context, !Status, !ModuleInfo, !QualInfo, !Specs).
% Add the foreign clauses for the mutable's primitive access and
% locking predicates.
%
-:- pred add_java_mutable_primitive_preds(string::in, module_name::in,
+:- pred add_csharp_java_mutable_primitive_preds(
+ foreign_language::in(lang_csharp_java), string::in, module_name::in,
string::in, mutable_var_attributes::in, pragma_foreign_proc_attributes::in,
mer_inst::in, box_policy::in,
prog_context::in, import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_java_mutable_primitive_preds(TargetMutableName, ModuleName, MutableName,
- MutAttrs, Attrs, Inst, BoxPolicy,
+add_csharp_java_mutable_primitive_preds(Lang, TargetMutableName, ModuleName,
+ MutableName, MutAttrs, Attrs, Inst, BoxPolicy,
Context, !Status, !ModuleInfo, !QualInfo, !Specs) :-
IsThreadLocal = mutable_var_thread_local(MutAttrs),
@@ -2415,9 +2457,14 @@ add_java_mutable_primitive_preds(TargetMutableName, ModuleName, MutableName,
set_thread_safe(proc_thread_safe, GetAttrs0, GetAttrs),
varset.new_named_var(varset.init, "X", X, ProgVarSet),
(
+ Lang = lang_csharp,
+ GetCode = "\tX = " ++ TargetMutableName ++ ";\n"
+ ;
+ Lang = lang_java,
IsThreadLocal = mutable_not_thread_local,
GetCode = "\tX = " ++ TargetMutableName ++ ";\n"
;
+ Lang = lang_java,
IsThreadLocal = mutable_thread_local,
GetCode = "\tX = " ++ TargetMutableName ++ ".get();\n"
),
@@ -2443,7 +2490,7 @@ add_java_mutable_primitive_preds(TargetMutableName, ModuleName, MutableName,
TrailCode = ""
;
TrailMutableUpdates = mutable_trailed,
- Pieces = [words("Error: trailed mutable in Java grade."), nl],
+ Pieces = [words("Error: trailed mutable in non-trailed grade."), nl],
Msg = simple_msg(Context, [always(Pieces)]),
Spec = error_spec(severity_error, phase_parse_tree_to_hlds, [Msg]),
!:Specs = [Spec | !.Specs],
@@ -2451,9 +2498,14 @@ add_java_mutable_primitive_preds(TargetMutableName, ModuleName, MutableName,
TrailCode = ""
),
(
+ Lang = lang_csharp,
+ SetCode = "\t" ++ TargetMutableName ++ " = X;\n"
+ ;
+ Lang = lang_java,
IsThreadLocal = mutable_not_thread_local,
SetCode = "\t" ++ TargetMutableName ++ " = X;\n"
;
+ Lang = lang_java,
IsThreadLocal = mutable_thread_local,
SetCode = "\t" ++ TargetMutableName ++ ".set(X);\n"
),
@@ -2472,13 +2524,13 @@ add_java_mutable_primitive_preds(TargetMutableName, ModuleName, MutableName,
% Add the code required to initialise a mutable.
%
-:- pred add_java_mutable_initialisation(module_name::in, string::in,
+:- pred add_csharp_java_mutable_initialisation(module_name::in, string::in,
prog_varset::in, sym_name::in, prog_term::in,
prog_context::in, import_status::in, import_status::out,
module_info::in, module_info::out, qual_info::in, qual_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
-add_java_mutable_initialisation(ModuleName, MutableName, MutVarset,
+add_csharp_java_mutable_initialisation(ModuleName, MutableName, MutVarset,
InitSetPredName, InitTerm,
Context, !Status, !ModuleInfo, !QualInfo, !Specs) :-
% Add the `:- initialise' declaration for the mutable initialisation
diff --git a/compiler/mercury_compile.m b/compiler/mercury_compile.m
index 478b02d..c25a2e4 100644
--- a/compiler/mercury_compile.m
+++ b/compiler/mercury_compile.m
@@ -395,6 +395,7 @@ main_after_setup(OptionVariables, OptionArgs, Args, Link, Globals, !IO) :-
globals.get_target(Globals, Target),
(
( Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_erlang
),
@@ -439,6 +440,7 @@ main_after_setup(OptionVariables, OptionArgs, Args, Link, Globals, !IO) :-
Succeeded, !IO)
;
( Target = target_c
+ ; Target = target_csharp
; Target = target_il
; Target = target_asm
; Target = target_x86_64
@@ -1382,6 +1384,7 @@ find_smart_recompilation_target_files(TopLevelModuleName,
globals.get_target(Globals, CompilationTarget),
( CompilationTarget = target_c, TargetSuffix = ".c"
; CompilationTarget = target_il, TargetSuffix = ".il"
+ ; CompilationTarget = target_csharp, TargetSuffix = ".cs"
; CompilationTarget = target_java, TargetSuffix = ".java"
; CompilationTarget = target_asm, TargetSuffix = ".s"
; CompilationTarget = target_x86_64, TargetSuffix = ".s"
@@ -1423,6 +1426,9 @@ find_timestamp_files(TopLevelModuleName, Globals, FindTimestampFiles) :-
CompilationTarget = target_il,
TimestampSuffix = ".il_date"
;
+ CompilationTarget = target_csharp,
+ TimestampSuffix = ".cs_date"
+ ;
CompilationTarget = target_java,
TimestampSuffix = ".java_date"
;
@@ -1679,6 +1685,7 @@ mercury_compile_after_front_end(NestedSubModules, FindTimestampFiles,
export.produce_header_file(!.HLDS, ExportDecls, ModuleName, !IO)
;
( Target = target_java
+ ; Target = target_csharp
; Target = target_il
; Target = target_erlang
)
@@ -1700,6 +1707,11 @@ mercury_compile_after_front_end(NestedSubModules, FindTimestampFiles,
),
ExtraObjFiles = []
;
+ Target = target_csharp,
+ mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
+ mlds_to_csharp(!.HLDS, MLDS, !IO),
+ ExtraObjFiles = []
+ ;
Target = target_java,
mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
mlds_to_java(!.HLDS, MLDS, !IO),
diff --git a/compiler/mercury_compile_middle_passes.m b/compiler/mercury_compile_middle_passes.m
index 8176c8d..28e752b 100644
--- a/compiler/mercury_compile_middle_passes.m
+++ b/compiler/mercury_compile_middle_passes.m
@@ -1210,6 +1210,7 @@ maybe_control_granularity(Verbose, Stats, !HLDS, !IO) :-
maybe_report_stats(Stats, !IO)
;
( Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_asm
; Target = target_x86_64
@@ -1257,6 +1258,7 @@ maybe_control_distance_granularity(Verbose, Stats, !HLDS, !IO) :-
maybe_report_stats(Stats, !IO)
;
( Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_asm
; Target = target_x86_64
diff --git a/compiler/mercury_compile_mlds_back_end.m b/compiler/mercury_compile_mlds_back_end.m
index be7f483..a96b8c8 100644
--- a/compiler/mercury_compile_mlds_back_end.m
+++ b/compiler/mercury_compile_mlds_back_end.m
@@ -42,6 +42,8 @@
:- pred mlds_to_java(module_info::in, mlds::in, io::di, io::uo) is det.
+:- pred mlds_to_csharp(module_info::in, mlds::in, io::di, io::uo) is det.
+
:- pred maybe_mlds_to_gcc(globals::in, mlds::in, bool::out, io::di, io::uo)
is det.
@@ -70,6 +72,7 @@
:- import_module ml_backend.ml_optimize. % MLDS -> MLDS
:- import_module ml_backend.mlds_to_c. % MLDS -> C
:- import_module ml_backend.mlds_to_java. % MLDS -> Java
+:- import_module ml_backend.mlds_to_cs. % MLDS -> C#
:- import_module ml_backend.mlds_to_ilasm. % MLDS -> IL assembler
:- import_module ml_backend.maybe_mlds_to_gcc. % MLDS -> GCC back-end
:- import_module ml_backend.ml_util. % MLDS utility predicates
@@ -301,6 +304,7 @@ maybe_add_trail_ops(Verbose, Stats, !HLDS, !IO) :-
% the C backends.
%
( Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_asm
; Target = target_x86_64
@@ -398,6 +402,16 @@ mlds_to_java(HLDS, MLDS, !IO) :-
maybe_write_string(Verbose, "% Finished converting MLDS to Java.\n", !IO),
maybe_report_stats(Stats, !IO).
+mlds_to_csharp(HLDS, MLDS, !IO) :-
+ module_info_get_globals(HLDS, Globals),
+ globals.lookup_bool_option(Globals, verbose, Verbose),
+ globals.lookup_bool_option(Globals, statistics, Stats),
+
+ maybe_write_string(Verbose, "% Converting MLDS to C#...\n", !IO),
+ output_csharp_mlds(HLDS, MLDS, !IO),
+ maybe_write_string(Verbose, "% Finished converting MLDS to C#.\n", !IO),
+ maybe_report_stats(Stats, !IO).
+
maybe_mlds_to_gcc(Globals, MLDS, ContainsCCode, !IO) :-
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, statistics, Stats),
diff --git a/compiler/mercury_to_mercury.m b/compiler/mercury_to_mercury.m
index fa28fa3..38bd8a3 100644
--- a/compiler/mercury_to_mercury.m
+++ b/compiler/mercury_to_mercury.m
@@ -1966,6 +1966,9 @@ mercury_output_type_defn(Info, TVarSet, Name, TParams, TypeDefn, Context,
ForeignType = java(_),
io.write_string("java, ", !IO)
;
+ ForeignType = csharp(_),
+ io.write_string("csharp, ", !IO)
+ ;
ForeignType = erlang(_),
io.write_string("erlang, ", !IO)
),
@@ -1991,6 +1994,8 @@ mercury_output_type_defn(Info, TVarSet, Name, TParams, TypeDefn, Context,
;
ForeignType = java(java_type(ForeignTypeStr))
;
+ ForeignType = csharp(csharp_type(ForeignTypeStr))
+ ;
ForeignType = erlang(erlang_type),
ForeignTypeStr = ""
),
diff --git a/compiler/ml_backend.m b/compiler/ml_backend.m
index 85b16f0..6d31745 100644
--- a/compiler/ml_backend.m
+++ b/compiler/ml_backend.m
@@ -76,6 +76,9 @@
:- include_module mlds_to_java.
:- include_module java_util.
+% MLDS->C# back-end.
+:- include_module mlds_to_cs.
+
% MLDS->.NET CLR back-end
:- include_module il_peephole.
:- include_module ilasm.
diff --git a/compiler/ml_code_util.m b/compiler/ml_code_util.m
index 603bc97..0fe0deb 100644
--- a/compiler/ml_code_util.m
+++ b/compiler/ml_code_util.m
@@ -826,13 +826,13 @@ ml_make_boxed_types(Arity) = BoxedTypes :-
ml_java_mercury_type_interface = TypeInterfaceDefn :-
InterfaceModuleName = mercury_module_name_to_mlds(
- java_names.mercury_runtime_package_name),
+ java_mercury_runtime_package_name),
TypeInterface = qual(InterfaceModuleName, module_qual, "MercuryType"),
TypeInterfaceDefn = mlds_class_type(TypeInterface, 0, mlds_interface).
ml_java_mercury_enum_class = EnumClassDefn :-
InterfaceModuleName = mercury_module_name_to_mlds(
- java_names.mercury_runtime_package_name),
+ java_mercury_runtime_package_name),
EnumClass = qual(InterfaceModuleName, module_qual, "MercuryEnum"),
EnumClassDefn = mlds_class_type(EnumClass, 0, mlds_class).
@@ -1393,6 +1393,7 @@ ml_must_box_field_type(ModuleInfo, Type) :-
globals.get_target(Globals, Target),
(
( Target = target_c
+ ; Target = target_csharp
; Target = target_il
; Target = target_asm
; Target = target_x86_64
diff --git a/compiler/ml_disj_gen.m b/compiler/ml_disj_gen.m
index 3d0daac..5f4245d 100644
--- a/compiler/ml_disj_gen.m
+++ b/compiler/ml_disj_gen.m
@@ -200,6 +200,7 @@ ml_gen_disj(Disjuncts, GoalInfo, CodeModel, Context, Statements, !Info) :-
allow_lookup_disj(target_c) = yes.
allow_lookup_disj(target_il) = no.
+allow_lookup_disj(target_csharp) = yes.
allow_lookup_disj(target_java) = yes.
allow_lookup_disj(target_asm) = no.
allow_lookup_disj(target_x86_64) = no.
diff --git a/compiler/ml_foreign_proc_gen.m b/compiler/ml_foreign_proc_gen.m
index c54fae3..13f9f30 100644
--- a/compiler/ml_foreign_proc_gen.m
+++ b/compiler/ml_foreign_proc_gen.m
@@ -245,6 +245,7 @@ ml_gen_nondet_pragma_foreign_proc(CodeModel, Attributes, PredId, _ProcId,
;
( Target = target_c
; Target = target_java
+ ; Target = target_csharp
; Target = target_asm
),
ml_gen_call_current_success_cont(Context, CallCont, !Info)
@@ -330,9 +331,27 @@ ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes, PredId, ProcId,
Foreign_Code, Context, Decls, Statements, !Info)
;
Lang = lang_csharp,
- ml_gen_ordinary_pragma_managed_proc(OrdinaryKind, Attributes,
- PredId, ProcId, Args, ExtraArgs,
- Foreign_Code, Context, Decls, Statements, !Info)
+ ml_gen_info_get_target(!.Info, Target),
+ (
+ Target = target_csharp,
+ ml_gen_ordinary_pragma_csharp_java_proc(ml_target_csharp,
+ OrdinaryKind, Attributes, PredId, ProcId, Args, ExtraArgs,
+ Foreign_Code, Context, Decls, Statements, !Info)
+ ;
+ Target = target_il,
+ ml_gen_ordinary_pragma_managed_proc(OrdinaryKind, Attributes,
+ PredId, ProcId, Args, ExtraArgs,
+ Foreign_Code, Context, Decls, Statements, !Info)
+ ;
+ ( Target = target_c
+ ; Target = target_java
+ ; Target = target_asm
+ ; Target = target_x86_64
+ ; Target = target_erlang
+ ),
+ unexpected(this_file,
+ "C# foreign code not supported for compilation target")
+ )
;
Lang = lang_il,
% XXX should pass OrdinaryKind
@@ -341,8 +360,8 @@ ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes, PredId, ProcId,
Foreign_Code, Context, Decls, Statements, !Info)
;
Lang = lang_java,
- ml_gen_ordinary_pragma_java_proc(OrdinaryKind, Attributes,
- PredId, ProcId, Args, ExtraArgs,
+ ml_gen_ordinary_pragma_csharp_java_proc(ml_target_java, OrdinaryKind,
+ Attributes, PredId, ProcId, Args, ExtraArgs,
Foreign_Code, Context, Decls, Statements, !Info)
;
Lang = lang_erlang,
@@ -350,14 +369,20 @@ ml_gen_ordinary_pragma_foreign_proc(CodeModel, Attributes, PredId, ProcId,
"ml_gen_ordinary_pragma_foreign_proc: unexpected language Erlang")
).
-:- pred ml_gen_ordinary_pragma_java_proc(ordinary_pragma_kind::in,
+:- inst java_or_csharp
+ ---> ml_target_java
+ ; ml_target_csharp.
+
+:- pred ml_gen_ordinary_pragma_csharp_java_proc(
+ mlds_target_lang::in(java_or_csharp), ordinary_pragma_kind::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
list(foreign_arg)::in, list(foreign_arg)::in, string::in,
prog_context::in, list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_ordinary_pragma_java_proc(OrdinaryKind, Attributes, PredId, _ProcId,
- Args, ExtraArgs, JavaCode, Context, Decls, Statements, !Info) :-
+ml_gen_ordinary_pragma_csharp_java_proc(TargetLang, OrdinaryKind, Attributes,
+ PredId, _ProcId, Args, ExtraArgs, JavaCode, Context, Decls, Statements,
+ !Info) :-
Lang = get_foreign_language(Attributes),
ml_gen_info_get_module_info(!.Info, ModuleInfo),
@@ -372,13 +397,13 @@ ml_gen_ordinary_pragma_java_proc(OrdinaryKind, Attributes, PredId, _ProcId,
% Generate <declaration of one local variable for each arg>
ml_gen_pragma_java_decls(!.Info, MutableSpecial, Args, ArgDeclsList),
expect(unify(ExtraArgs, []), this_file,
- "ml_gen_ordinary_pragma_java_proc: extra args"),
+ "ml_gen_ordinary_pragma_csharp_java_proc: extra args"),
% Generate code to set the values of the input variables.
ml_gen_pragma_c_java_input_arg_list(Lang, Args, AssignInputsList, !Info),
% Generate MLDS statements to assign the values of the output variables.
- ml_gen_pragma_java_output_arg_list(MutableSpecial, Args, Context,
+ ml_gen_pragma_csharp_java_output_arg_list(MutableSpecial, Args, Context,
AssignOutputsList, ConvDecls, ConvStatements, !Info),
% Put it all together.
@@ -390,8 +415,15 @@ ml_gen_ordinary_pragma_java_proc(OrdinaryKind, Attributes, PredId, _ProcId,
;
OrdinaryKind = kind_semi,
ml_success_lval(!.Info, SucceededLval),
+ (
+ TargetLang = ml_target_java,
+ BoolType = "boolean"
+ ;
+ TargetLang = ml_target_csharp,
+ BoolType = "bool"
+ ),
SucceededDecl = [
- raw_target_code("\tboolean SUCCESS_INDICATOR;\n", [])],
+ raw_target_code("\t" ++ BoolType ++ " SUCCESS_INDICATOR;\n", [])],
AssignSucceeded = [
raw_target_code("\t", []),
target_code_output(SucceededLval),
@@ -415,7 +447,7 @@ ml_gen_ordinary_pragma_java_proc(OrdinaryKind, Attributes, PredId, _ProcId,
AssignInputsList,
[user_target_code(JavaCode, yes(Context), [])]
]),
- Starting_Code_Stmt = inline_target_code(ml_target_java, Starting_Code),
+ Starting_Code_Stmt = inline_target_code(TargetLang, Starting_Code),
Starting_Code_Statement = statement(ml_stmt_atomic(Starting_Code_Stmt),
mlds_make_context(Context)),
@@ -423,7 +455,7 @@ ml_gen_ordinary_pragma_java_proc(OrdinaryKind, Attributes, PredId, _ProcId,
AssignSucceeded,
[raw_target_code("\t}\n", [])]
]),
- Ending_Code_Stmt = inline_target_code(ml_target_java, Ending_Code),
+ Ending_Code_Stmt = inline_target_code(TargetLang, Ending_Code),
Ending_Code_Statement = statement(ml_stmt_atomic(Ending_Code_Stmt),
mlds_make_context(Context)),
@@ -1187,39 +1219,41 @@ input_arg_assignable_with_cast(Lang, HighLevelData, OrigType, ExportedType,
% and the generated code.
Cast = ""
;
- ( Lang = lang_csharp
- ; Lang = lang_il
+ Lang = lang_csharp,
+ Cast = ""
+ ;
+ ( Lang = lang_il
; Lang = lang_erlang
),
unexpected(this_file,
"input_arg_assignable_with_cast: unexpected language")
).
-:- pred ml_gen_pragma_java_output_arg_list(mutable_special_case::in,
+:- pred ml_gen_pragma_csharp_java_output_arg_list(mutable_special_case::in,
list(foreign_arg)::in, prog_context::in, list(statement)::out,
list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_pragma_java_output_arg_list(_, [], _, [], [], [], !Info).
-ml_gen_pragma_java_output_arg_list(MutableSpecial, [JavaArg | JavaArgs],
+ml_gen_pragma_csharp_java_output_arg_list(_, [], _, [], [], [], !Info).
+ml_gen_pragma_csharp_java_output_arg_list(MutableSpecial, [JavaArg | JavaArgs],
Context, Statements, ConvDecls, ConvStatements, !Info) :-
- ml_gen_pragma_java_output_arg(MutableSpecial, JavaArg, Context,
+ ml_gen_pragma_csharp_java_output_arg(MutableSpecial, JavaArg, Context,
Statements1, ConvDecls1, ConvStatements1, !Info),
- ml_gen_pragma_java_output_arg_list(MutableSpecial, JavaArgs, Context,
- Statements2, ConvDecls2, ConvStatements2, !Info),
+ ml_gen_pragma_csharp_java_output_arg_list(MutableSpecial, JavaArgs,
+ Context, Statements2, ConvDecls2, ConvStatements2, !Info),
Statements = Statements1 ++ Statements2,
ConvDecls = ConvDecls1 ++ ConvDecls2,
ConvStatements = ConvStatements1 ++ ConvStatements2.
- % ml_gen_pragma_java_output_arg generates MLDS statements to assign the
+ % ml_gen_pragma_csharp_java_output_arg generates MLDS statements to assign the
% value of an output arg for a `pragma foreign_proc' declaration.
%
-:- pred ml_gen_pragma_java_output_arg(mutable_special_case::in,
+:- pred ml_gen_pragma_csharp_java_output_arg(mutable_special_case::in,
foreign_arg::in, prog_context::in, list(statement)::out,
list(mlds_defn)::out, list(statement)::out,
ml_gen_info::in, ml_gen_info::out) is det.
-ml_gen_pragma_java_output_arg(MutableSpecial, ForeignArg, Context,
+ml_gen_pragma_csharp_java_output_arg(MutableSpecial, ForeignArg, Context,
AssignOutput, ConvDecls, ConvOutputStatements, !Info) :-
ForeignArg = foreign_arg(Var, MaybeNameAndMode, OrigType, BoxPolicy),
ml_gen_info_get_module_info(!.Info, ModuleInfo),
diff --git a/compiler/ml_global_data.m b/compiler/ml_global_data.m
index 8ba7d57..efc3d15 100644
--- a/compiler/ml_global_data.m
+++ b/compiler/ml_global_data.m
@@ -481,6 +481,7 @@ ml_gen_static_vector_type(MLDS_ModuleName, MLDS_Context, Target, ArgTypes,
;
( Target = target_asm
; Target = target_il
+ ; Target = target_csharp
; Target = target_erlang
; Target = target_x86_64
),
diff --git a/compiler/ml_optimize.m b/compiler/ml_optimize.m
index c18994d..e6cdf39 100644
--- a/compiler/ml_optimize.m
+++ b/compiler/ml_optimize.m
@@ -478,6 +478,7 @@ target_supports_break_and_continue_2(target_c) = yes.
target_supports_break_and_continue_2(target_asm) = no.
% asm means via gnu back-end
target_supports_break_and_continue_2(target_il) = no.
+target_supports_break_and_continue_2(target_csharp) = yes.
target_supports_break_and_continue_2(target_java) = yes.
% target_supports_break_and_continue_2(target_c_sharp) = yes.
target_supports_break_and_continue_2(target_x86_64) = _ :-
diff --git a/compiler/ml_proc_gen.m b/compiler/ml_proc_gen.m
index d8c4463..e9a009f 100644
--- a/compiler/ml_proc_gen.m
+++ b/compiler/ml_proc_gen.m
@@ -152,6 +152,7 @@ foreign_type_required_imports(Target, _TypeCtor - TypeDefn) = Imports :-
(
( Target = target_c
; Target = target_java
+ ; Target = target_csharp
; Target = target_asm
),
Imports = []
@@ -161,7 +162,7 @@ foreign_type_required_imports(Target, _TypeCtor - TypeDefn) = Imports :-
(
TypeBody = hlds_foreign_type(ForeignTypeBody),
ForeignTypeBody = foreign_type_body(MaybeIL,
- _MaybeC, _MaybeJava, _MaybeErlang),
+ _MaybeC, _MaybeJava, _MaybeCSharp, _MaybeErlang),
(
MaybeIL = yes(Data),
Data = foreign_type_lang_data(il_type(_, Location, _), _, _)
@@ -266,6 +267,7 @@ ml_gen_preds(!ModuleInfo, PredDefns, GlobalData) :-
module_info_get_globals(!.ModuleInfo, Globals),
globals.get_target(Globals, Target),
(
+ % XXX common cells not yet implemented for C#
( Target = target_c
; Target = target_java
),
@@ -273,6 +275,7 @@ ml_gen_preds(!ModuleInfo, PredDefns, GlobalData) :-
;
( Target = target_asm
; Target = target_il
+ ; Target = target_csharp
; Target = target_erlang
; Target = target_x86_64
),
diff --git a/compiler/ml_switch_gen.m b/compiler/ml_switch_gen.m
index cef55a5..6098339 100644
--- a/compiler/ml_switch_gen.m
+++ b/compiler/ml_switch_gen.m
@@ -301,6 +301,7 @@ target_supports_computed_goto(Globals) :-
target_supports_int_switch_2(target_c) = yes.
target_supports_int_switch_2(target_asm) = yes.
target_supports_int_switch_2(target_il) = no.
+target_supports_int_switch_2(target_csharp) = yes.
target_supports_int_switch_2(target_java) = yes.
% target_supports_int_switch_2(c_sharp) = yes.
target_supports_int_switch_2(target_x86_64) =
@@ -311,6 +312,7 @@ target_supports_int_switch_2(target_erlang) =
target_supports_string_switch_2(target_c) = no.
target_supports_string_switch_2(target_asm) = no.
target_supports_string_switch_2(target_il) = no.
+target_supports_string_switch_2(target_csharp) = yes.
target_supports_string_switch_2(target_java) = no.
% target_supports_string_switch_2(c_sharp) = yes.
target_supports_string_switch_2(target_x86_64) =
@@ -323,6 +325,7 @@ target_supports_computed_goto_2(target_asm) = no.
% XXX for asm, it should be `yes', but currently
% computed gotos are not yet implemented in gcc.m.
target_supports_computed_goto_2(target_il) = yes.
+target_supports_computed_goto_2(target_csharp) = yes.
target_supports_computed_goto_2(target_java) = no.
% target_supports_computed_goto_2(c_sharp) = no.
target_supports_computed_goto_2(target_x86_64) =
@@ -333,6 +336,7 @@ target_supports_computed_goto_2(target_erlang) =
target_supports_goto_2(target_c) = yes.
target_supports_goto_2(target_asm) = yes.
target_supports_goto_2(target_il) = yes.
+target_supports_goto_2(target_csharp) = yes.
target_supports_goto_2(target_java) = no.
% target_supports_goto_2(c_sharp) = yes.
target_supports_goto_2(target_x86_64) =
diff --git a/compiler/ml_type_gen.m b/compiler/ml_type_gen.m
index 5a47572..fe9473b 100644
--- a/compiler/ml_type_gen.m
+++ b/compiler/ml_type_gen.m
@@ -272,6 +272,7 @@ ml_gen_enum_type(Target, TypeCtor, TypeDefn, Ctors, TagValues,
;
( Target = target_c
; Target = target_il
+ ; Target = target_csharp
; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
@@ -516,6 +517,7 @@ ml_gen_du_parent_type(ModuleInfo, TypeCtor, TypeDefn, Ctors, TagValues,
;
( Target = target_c
; Target = target_il
+ ; Target = target_csharp
; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
@@ -881,6 +883,7 @@ ml_tag_uses_base_class(Tag) = UsesBaseClass :-
ml_target_uses_constructors(target_c) = no.
ml_target_uses_constructors(target_il) = yes.
+ml_target_uses_constructors(target_csharp) = yes.
ml_target_uses_constructors(target_java) = yes.
ml_target_uses_constructors(target_asm) = no.
ml_target_uses_constructors(target_x86_64) =
@@ -892,6 +895,7 @@ ml_target_uses_constructors(target_erlang) =
target_uses_empty_base_classes(target_c) = no.
target_uses_empty_base_classes(target_il) = yes.
+target_uses_empty_base_classes(target_csharp) = no.
target_uses_empty_base_classes(target_java) = yes.
target_uses_empty_base_classes(target_asm) = no.
target_uses_empty_base_classes(target_x86_64) =
@@ -911,6 +915,7 @@ target_uses_empty_base_classes(target_erlang) =
target_requires_module_qualified_params(target_c) = no.
target_requires_module_qualified_params(target_il) = no.
+target_requires_module_qualified_params(target_csharp) = yes.
target_requires_module_qualified_params(target_java) = yes.
target_requires_module_qualified_params(target_asm) = no.
target_requires_module_qualified_params(target_x86_64) =
diff --git a/compiler/ml_unify_gen.m b/compiler/ml_unify_gen.m
index 572164a..67374d9 100644
--- a/compiler/ml_unify_gen.m
+++ b/compiler/ml_unify_gen.m
@@ -542,6 +542,7 @@ ml_gen_reserved_address(ModuleInfo, ResAddr, MLDS_Type) = Rval :-
target_supports_inheritence(target_c) = no.
target_supports_inheritence(target_il) = yes.
+target_supports_inheritence(target_csharp) = yes.
target_supports_inheritence(target_java) = yes.
target_supports_inheritence(target_asm) = no.
target_supports_inheritence(target_x86_64) =
diff --git a/compiler/mlds.m b/compiler/mlds.m
index 5721717..2f6a5ef 100644
--- a/compiler/mlds.m
+++ b/compiler/mlds.m
@@ -1416,6 +1416,7 @@
% ; ml_target_c_minus_minus
; ml_target_asm
; ml_target_il
+ ; ml_target_csharp
; ml_target_java.
% ; ml_target_java_asm
% ; ml_target_java_bytecode.
@@ -1933,7 +1934,7 @@ foreign_type_to_mlds_type(ModuleInfo, ForeignTypeBody) = MLDSType :-
% Any changes here may require changes there as well.
ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC, MaybeJava,
- _MaybeErlang),
+ MaybeCSharp, _MaybeErlang),
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
(
@@ -1961,6 +1962,18 @@ foreign_type_to_mlds_type(ModuleInfo, ForeignTypeBody) = MLDSType :-
"mercury_type_to_mlds_type: No IL foreign type")
)
;
+ Target = target_csharp,
+ (
+ MaybeCSharp = yes(Data),
+ Data = foreign_type_lang_data(CSharpForeignType, _, _),
+ ForeignType = csharp(CSharpForeignType)
+ ;
+ MaybeCSharp = no,
+ % This is checked by check_foreign_type in make_hlds.
+ unexpected(this_file,
+ "mercury_type_to_mlds_type: no C# foreign type")
+ )
+ ;
Target = target_java,
(
MaybeJava = yes(Data),
diff --git a/compiler/mlds_to_c.m b/compiler/mlds_to_c.m
index bce951b..c31b2e2 100644
--- a/compiler/mlds_to_c.m
+++ b/compiler/mlds_to_c.m
@@ -308,6 +308,7 @@ mlds_output_src_imports(Opts, Indent, Imports, !IO) :-
list.foldl(mlds_output_src_import(Opts, Indent), Imports, !IO)
;
( Target = target_java
+ ; Target = target_csharp
; Target = target_il
; Target = target_x86_64
; Target = target_erlang
@@ -500,6 +501,7 @@ mlds_output_hdr_start(Opts, Indent, ModuleName, !IO) :-
;
( Target = target_il
; Target = target_java
+ ; Target = target_csharp
; Target = target_asm
; Target = target_x86_64
; Target = target_erlang
@@ -611,6 +613,7 @@ mlds_output_hdr_end(Opts, Indent, ModuleName, !IO) :-
io.nl(!IO)
;
( Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_asm
; Target = target_x86_64
@@ -1100,6 +1103,10 @@ mlds_output_pragma_export_type(PrefixSuffix, MLDS_Type, !IO) :-
unexpected(this_file,
"mlds_output_type_prefix: java foreign_type")
;
+ ForeignType = csharp(_),
+ unexpected(this_file,
+ "mlds_output_type_prefix: csharp foreign_type")
+ ;
ForeignType = erlang(_),
unexpected(this_file,
"mlds_output_type_prefix: erlang foreign_type")
@@ -3803,6 +3810,7 @@ mlds_output_atomic_stmt(Opts, Indent, FuncInfo, Statement, Context, !IO) :-
( TargetLang = ml_target_gnu_c
; TargetLang = ml_target_asm
; TargetLang = ml_target_il
+ ; TargetLang = ml_target_csharp
; TargetLang = ml_target_java
),
sorry(this_file, "inline_target_code only works for language C")
diff --git a/compiler/mlds_to_cs.m b/compiler/mlds_to_cs.m
new file mode 100644
index 0000000..15dacb2
--- /dev/null
+++ b/compiler/mlds_to_cs.m
@@ -0,0 +1,3600 @@
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sw=4 et
+%-----------------------------------------------------------------------------%
+% Copyright (C) 2010 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.
+%-----------------------------------------------------------------------------%
+%
+% File: mlds_to_cs.m.
+% Main authors: wangp.
+%
+% Convert MLDS to C# code.
+%
+%-----------------------------------------------------------------------------%
+
+:- module ml_backend.mlds_to_cs.
+:- interface.
+
+:- import_module hlds.hlds_module.
+:- import_module ml_backend.mlds.
+
+:- import_module io.
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_csharp_mlds(module_info::in, mlds::in, io::di, io::uo) is det.
+
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
+
+:- implementation.
+
+ % XXX needed for c_util.output_quoted_string,
+ % c_util.output_quoted_multi_string, and
+ % c_util.make_float_literal.
+:- import_module backend_libs.builtin_ops.
+:- import_module backend_libs.c_util.
+:- import_module backend_libs.rtti.
+:- import_module hlds.hlds_pred. % for pred_proc_id.
+:- import_module libs.compiler_util.
+:- import_module libs.file_util.
+:- import_module libs.globals.
+:- import_module libs.options.
+:- import_module mdbcomp.prim_data.
+:- use_module ml_backend.java_util.
+:- import_module ml_backend.ml_global_data.
+:- import_module ml_backend.ml_type_gen. % for ml_gen_type_name
+:- import_module ml_backend.ml_util.
+:- import_module ml_backend.mlds.
+:- import_module ml_backend.rtti_to_mlds.
+:- import_module parse_tree.builtin_lib_types.
+:- import_module parse_tree.file_names. % for mercury_std_library_name.
+:- import_module parse_tree.java_names.
+:- import_module parse_tree.prog_data.
+:- import_module parse_tree.prog_foreign.
+:- import_module parse_tree.prog_out.
+:- import_module parse_tree.prog_type.
+
+:- import_module assoc_list.
+:- import_module bool.
+:- import_module cord.
+:- import_module digraph.
+:- import_module int.
+:- import_module library.
+:- import_module list.
+:- import_module map.
+:- import_module maybe.
+:- import_module pair.
+:- import_module set.
+:- import_module string.
+:- import_module svmap.
+:- import_module term.
+:- import_module varset.
+
+%-----------------------------------------------------------------------------%
+
+output_csharp_mlds(ModuleInfo, MLDS, !IO) :-
+ module_info_get_globals(ModuleInfo, Globals),
+ ModuleName = mlds_get_module_name(MLDS),
+ module_name_to_file_name(Globals, ModuleName, ".cs", do_create_dirs,
+ SourceFile, !IO),
+ Indent = 0,
+ output_to_file(Globals, SourceFile,
+ output_csharp_src_file(ModuleInfo, Indent, MLDS), !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Utility predicates for various purposes.
+%
+
+ % Succeeds iff this definition is a data definition which defines RTTI.
+ %
+:- pred defn_is_rtti_data(mlds_defn::in) is semidet.
+
+defn_is_rtti_data(Defn) :-
+ Defn = mlds_defn(_Name, _Context, _Flags, Body),
+ Body = mlds_data(Type, _, _),
+ Type = mlds_rtti_type(_).
+
+ % Succeeds iff this definition is a data definition.
+ %
+:- pred defn_is_data(mlds_defn::in) is semidet.
+
+defn_is_data(Defn) :-
+ Defn = mlds_defn(_Name, _Context, _Flags, Body),
+ Body = mlds_data(_, _, _).
+
+ % Succeeds iff a given string matches the unqualified interface name
+ % of a interface in Mercury's C# runtime system.
+ %
+:- pred interface_is_special(string::in) is semidet.
+
+interface_is_special("MercuryType").
+
+%-----------------------------------------------------------------------------%
+%
+% Code to generate the `.cs' file.
+%
+
+:- pred output_csharp_src_file(module_info::in, indent::in, mlds::in,
+ io::di, io::uo) is det.
+
+output_csharp_src_file(ModuleInfo, Indent, MLDS, !IO) :-
+ % Run further transformations on the MLDS.
+ MLDS = mlds(ModuleName, AllForeignCode, Imports, GlobalData, Defns0,
+ InitPreds, _FinalPreds, ExportedEnums),
+ ml_global_data_get_all_global_defns(GlobalData,
+ _ScalarCellGroupMap, _VectorCellGroupMap, GlobalDefns),
+ Defns = GlobalDefns ++ Defns0,
+
+ % Get the foreign code for C#
+ % XXX We should not ignore _RevImports.
+ ForeignCode = mlds_get_csharp_foreign_code(AllForeignCode),
+ ForeignCode = mlds_foreign_code(RevForeignDecls, _RevImports,
+ RevBodyCode, ExportDefns),
+ ForeignDecls = list.reverse(RevForeignDecls),
+ ForeignBodyCode = list.reverse(RevBodyCode),
+
+ % Output transformed MLDS as C# source.
+ module_info_get_globals(ModuleInfo, Globals),
+ Info = init_csharp_out_info(ModuleInfo),
+ output_src_start(Globals, Info, Indent, ModuleName, Imports, ForeignDecls,
+ Defns, !IO),
+ io.write_list(ForeignBodyCode, "\n", output_csharp_body_code(Info, Indent),
+ !IO),
+
+ list.filter(defn_is_rtti_data, Defns, RttiDefns, NonRttiDefns),
+
+ io.write_string("\n// RttiDefns\n", !IO),
+ output_defns(Info, Indent + 1, alloc_only, RttiDefns, !IO),
+ output_rtti_assignments(Info, Indent + 1, RttiDefns, !IO),
+
+ list.filter(defn_is_data, NonRttiDefns, DataDefns, NonDataDefns),
+ io.write_string("\n// DataDefns\n", !IO),
+ output_data_decls(Info, Indent + 1, DataDefns, !IO),
+ output_init_data_method(Info, Indent + 1, DataDefns, !IO),
+
+ % Scalar common data must appear after the previous data definitions,
+ % and the vector common data after that.
+ io.write_string("\n// Scalar common data\n", !IO),
+ % output_scalar_common_data(Info, Indent + 1, ScalarCellGroupMap, !IO),
+
+ io.write_string("\n// Vector common data\n", !IO),
+ % output_vector_common_data(Info, Indent + 1, VectorCellGroupMap, !IO),
+
+ io.write_string("\n// NonDataDefns\n", !IO),
+ output_defns(Info, Indent + 1, none, NonDataDefns, !IO),
+
+ io.write_string("\n// ExportDefns\n", !IO),
+ output_exports(Info, Indent + 1, ExportDefns, !IO),
+
+ io.write_string("\n// ExportedEnums\n", !IO),
+ output_exported_enums(Info, Indent + 1, ExportedEnums, !IO),
+
+ % io.write_string("\n// FinalPreds\n", !IO),
+ % output_finals(Indent + 1, FinalPreds, !IO),
+
+ io.write_string("\n// EnvVarNames\n", !IO),
+ output_env_vars(Indent + 1, NonRttiDefns, !IO),
+
+ StaticCtorCalls = ["MR_init_rtti", "MR_init_data" | InitPreds],
+ output_static_constructor(ModuleName, Indent + 1, StaticCtorCalls, !IO),
+
+ output_src_end(Indent, ModuleName, !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for working with `foreign_code'.
+%
+
+:- pred output_csharp_decl(csharp_out_info::in, indent::in,
+ foreign_decl_code::in, io::di, io::uo) is det.
+
+output_csharp_decl(Info, Indent, DeclCode, !IO) :-
+ DeclCode = foreign_decl_code(Lang, _IsLocal, Code, Context),
+ (
+ Lang = lang_csharp,
+ indent_line(Info, mlds_make_context(Context), Indent, !IO),
+ io.write_string(Code, !IO),
+ io.nl(!IO)
+ ;
+ ( Lang = lang_c
+ ; Lang = lang_java
+ ; Lang = lang_il
+ ; Lang = lang_erlang
+ ),
+ sorry(this_file, "foreign decl other than C#")
+ ).
+
+:- pred output_csharp_body_code(csharp_out_info::in, indent::in,
+ user_foreign_code::in, io::di, io.state::uo) is det.
+
+output_csharp_body_code(Info, Indent, UserForeignCode, !IO) :-
+ UserForeignCode = user_foreign_code(Lang, Code, Context),
+ % Only output C# code.
+ (
+ Lang = lang_csharp,
+ indent_line(Info, mlds_make_context(Context), Indent, !IO),
+ io.write_string(Code, !IO),
+ io.nl(!IO)
+ ;
+ ( Lang = lang_c
+ ; Lang = lang_java
+ ; Lang = lang_il
+ ; Lang = lang_erlang
+ ),
+ sorry(this_file, "foreign code other than C#")
+ ).
+
+:- func mlds_get_csharp_foreign_code(map(foreign_language, mlds_foreign_code))
+ = mlds_foreign_code.
+
+mlds_get_csharp_foreign_code(AllForeignCode) = ForeignCode :-
+ ( map.search(AllForeignCode, lang_csharp, ForeignCode0) ->
+ ForeignCode = ForeignCode0
+ ;
+ ForeignCode = mlds_foreign_code([], [], [], [])
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for handling `pragma foreign_export'.
+%
+
+ % Exports are converted into forwarding methods that are given the
+ % specified name. These simply call the exported procedure.
+ %
+ % NOTE: the forwarding methods must be declared public as they might
+ % be referred to within foreign_procs that are inlined across module
+ % boundaries.
+ %
+:- pred output_exports(csharp_out_info::in, indent::in,
+ list(mlds_pragma_export)::in, io::di, io::uo) is det.
+
+output_exports(Info, Indent, Exports, !IO) :-
+ list.foldl(output_export(Info, Indent), Exports, !IO).
+
+:- pred output_export(csharp_out_info::in, indent::in, mlds_pragma_export::in,
+ io::di, io::uo) is det.
+
+output_export(Info0, Indent, Export, !IO) :-
+ Export = ml_pragma_export(Lang, ExportName, _, MLDS_Signature,
+ _UnivQTVars, _),
+ expect(unify(Lang, lang_csharp), this_file,
+ "foreign_export for language other than C#."),
+
+ indent_line(Indent, !IO),
+ io.write_string("public static ", !IO),
+ % XXX C# has generics
+ % output_generic_tvars(UnivQTVars, !IO),
+ io.nl(!IO),
+ indent_line(Indent, !IO),
+
+ MLDS_Signature = mlds_func_params(_Parameters, ReturnTypes),
+ Info = Info0,
+ (
+ ReturnTypes = [],
+ io.write_string("void", !IO)
+ ;
+ ReturnTypes = [RetType],
+ output_type(Info, RetType, !IO)
+ ;
+ ReturnTypes = [_, _ | _],
+ % For multiple outputs, we return an array of objects.
+ % XXX C# has output parameters
+ io.write_string("object []", !IO)
+ ),
+ io.write_string(" " ++ ExportName, !IO),
+ output_export_no_ref_out(Info, Indent, Export, !IO).
+
+:- pred output_export_no_ref_out(csharp_out_info::in, indent::in,
+ mlds_pragma_export::in, io::di, io::uo) is det.
+
+output_export_no_ref_out(Info, Indent, Export, !IO) :-
+ Export = ml_pragma_export(_Lang, _ExportName, MLDS_Name, MLDS_Signature,
+ _UnivQTVars, _MLDS_Context),
+ MLDS_Signature = mlds_func_params(Parameters, ReturnTypes),
+ output_params(Info, Indent + 1, Parameters, !IO),
+ io.nl(!IO),
+ indent_line(Indent, !IO),
+ io.write_string("{\n", !IO),
+ indent_line(Indent + 1, !IO),
+ (
+ ReturnTypes = []
+ ;
+ ReturnTypes = [RetType],
+ % The cast is required when the exported method uses generics but the
+ % underlying method does not use generics (i.e. returns Object).
+ io.write_string("return (", !IO),
+ output_type(Info, RetType, !IO),
+ io.write_string(") ", !IO)
+ ;
+ ReturnTypes = [_, _ | _],
+ io.write_string("return ", !IO)
+ ),
+ write_export_call(MLDS_Name, Parameters, !IO),
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO).
+
+:- pred write_export_call(mlds_qualified_entity_name::in,
+ list(mlds_argument)::in, io::di, io::uo) is det.
+
+write_export_call(MLDS_Name, Parameters, !IO) :-
+ output_fully_qualified_thing(MLDS_Name, output_name, !IO),
+ io.write_char('(', !IO),
+ io.write_list(Parameters, ", ", write_argument_name, !IO),
+ io.write_string(");\n", !IO).
+
+:- pred write_argument_name(mlds_argument::in, io::di, io::uo) is det.
+
+write_argument_name(Arg, !IO) :-
+ Arg = mlds_argument(Name, _, _),
+ output_name(Name, !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for handling `pragma foreign_export_enum'.
+%
+
+:- pred output_exported_enums(csharp_out_info::in, indent::in,
+ list(mlds_exported_enum)::in, io::di, io::uo) is det.
+
+output_exported_enums(Info, Indent, ExportedEnums, !IO) :-
+ list.foldl(output_exported_enum(Info, Indent), ExportedEnums, !IO).
+
+:- pred output_exported_enum(csharp_out_info::in, indent::in,
+ mlds_exported_enum::in, io::di, io::uo) is det.
+
+output_exported_enum(Info, Indent, ExportedEnum, !IO) :-
+ ExportedEnum = mlds_exported_enum(Lang, _, TypeCtor, ExportedConstants0),
+ (
+ Lang = lang_csharp,
+ ml_gen_type_name(TypeCtor, ClassName, ClassArity),
+ MLDS_Type = mlds_class_type(ClassName, ClassArity, mlds_enum),
+ % We reverse the list so the constants are printed out in order.
+ list.reverse(ExportedConstants0, ExportedConstants),
+ list.foldl(output_exported_enum_constant(Info, Indent, MLDS_Type),
+ ExportedConstants, !IO)
+ ;
+ ( Lang = lang_c
+ ; Lang = lang_java
+ ; Lang = lang_il
+ ; Lang = lang_erlang
+ )
+ ).
+
+:- pred output_exported_enum_constant(csharp_out_info::in, indent::in,
+ mlds_type::in, mlds_exported_enum_constant::in, io::di, io::uo) is det.
+
+output_exported_enum_constant(Info, Indent, MLDS_Type, ExportedConstant,
+ !IO) :-
+ ExportedConstant = mlds_exported_enum_constant(Name, Initializer),
+ indent_line(Indent, !IO),
+ io.write_string("public static readonly ", !IO),
+ output_type(Info, MLDS_Type, !IO),
+ io.write_string(" ", !IO),
+ io.write_string(Name, !IO),
+ io.write_string(" = ", !IO),
+ output_initializer_body(Info, Initializer, no, !IO),
+ io.write_string(";\n", !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output globals for environment variables.
+%
+
+:- pred output_env_vars(indent::in, list(mlds_defn)::in, io::di, io::uo)
+ is det.
+
+output_env_vars(Indent, NonRttiDefns, !IO) :-
+ list.foldl(collect_env_var_names, NonRttiDefns, set.init, EnvVarNamesSet),
+ EnvVarNames = set.to_sorted_list(EnvVarNamesSet),
+ (
+ EnvVarNames = []
+ ;
+ EnvVarNames = [_ | _],
+ list.foldl(output_env_var_definition(Indent), EnvVarNames, !IO)
+ ).
+
+:- pred collect_env_var_names(mlds_defn::in,
+ set(string)::in, set(string)::out) is det.
+
+collect_env_var_names(Defn, !EnvVarNames) :-
+ Defn = mlds_defn(_, _, _, EntityDefn),
+ (
+ EntityDefn = mlds_data(_, _, _)
+ ;
+ EntityDefn = mlds_function(_, _, _, _, EnvVarNames),
+ set.union(EnvVarNames, !EnvVarNames)
+ ;
+ EntityDefn = mlds_class(_)
+ ).
+
+:- pred output_env_var_definition(indent::in, string::in, io::di, io::uo)
+ is det.
+
+output_env_var_definition(Indent, EnvVarName, !IO) :-
+ % We use int because the generated code compares against zero, and changing
+ % that is more trouble than it's worth as it affects the C backends.
+ indent_line(Indent, !IO),
+ io.write_string("private static int mercury_envvar_", !IO),
+ io.write_string(EnvVarName, !IO),
+ io.write_string(" =\n", !IO),
+ indent_line(Indent + 1, !IO),
+ io.write_string("System.Environment.GetEnvironmentVariable(\"", !IO),
+ io.write_string(EnvVarName, !IO),
+ io.write_string("\") == null ? 0 : 1;\n", !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output the start and end of a source file.
+%
+
+:- pred output_src_start(globals::in, csharp_out_info::in, indent::in,
+ mercury_module_name::in, mlds_imports::in, list(foreign_decl_code)::in,
+ list(mlds_defn)::in, io::di, io::uo) is det.
+
+output_src_start(Globals, Info, Indent, MercuryModuleName, _Imports,
+ ForeignDecls, Defns, !IO) :-
+ output_auto_gen_comment(Globals, MercuryModuleName, !IO),
+ indent_line(Indent, !IO),
+ io.write_string("/* :- module ", !IO),
+ prog_out.write_sym_name(MercuryModuleName, !IO),
+ io.write_string(". */\n", !IO),
+ indent_line(Indent, !IO),
+ io.write_string("namespace mercury {\n\n", !IO),
+
+ io.write_list(ForeignDecls, "\n", output_csharp_decl(Info, Indent), !IO),
+ io.write_string("public static class ", !IO),
+ mangle_sym_name_for_csharp(MercuryModuleName, module_qual, "__",
+ ClassName),
+ io.write_string(ClassName, !IO),
+ io.write_string(" {\n", !IO),
+
+ % output_debug_class_init(MercuryModuleName, "start", !IO),
+
+ % Check if this module contains a `main' predicate and if it does insert
+ % a `main' method in the resulting source file that calls the `main'
+ % predicate.
+ ( defns_contain_main(Defns) ->
+ write_main_driver(Indent + 1, ClassName, !IO)
+ ;
+ true
+ ).
+
+ % C# only allows a single static constructor so we just call the real
+ % methods that we generated earlier.
+ %
+:- pred output_static_constructor(mercury_module_name::in, indent::in,
+ list(string)::in, io::di, io::uo) is det.
+
+output_static_constructor(MercuryModuleName, Indent, StaticConstructors,
+ !IO) :-
+ indent_line(Indent, !IO),
+ io.write_string("static ", !IO),
+ mangle_sym_name_for_csharp(MercuryModuleName, module_qual, "__",
+ ClassName),
+ io.write_string(ClassName, !IO),
+ io.write_string("() {\n", !IO),
+ WriteCall = (pred(MethodName::in, !.IO::di, !:IO::uo) is det :-
+ indent_line(Indent + 1, !IO),
+ io.write_string(MethodName, !IO),
+ io.write_string("();\n", !IO)
+ ),
+ list.foldl(WriteCall, StaticConstructors, !IO),
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO).
+
+:- pred write_main_driver(indent::in, string::in, io::di, io::uo) is det.
+
+write_main_driver(Indent, ClassName, !IO) :-
+ indent_line(Indent, !IO),
+ io.write_string("public static void Main", !IO),
+ io.write_string("(string[] args)\n", !IO),
+ indent_line(Indent, !IO),
+ io.write_string("{\n", !IO),
+
+ % XXX handle command line arguments and exit status
+ Body = [
+ " " ++ ClassName ++ ".main_2_p_0();"
+ ],
+ list.foldl(write_indented_line(Indent + 1), Body, !IO),
+
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO).
+
+:- pred write_indented_line(indent::in, string::in, io::di, io::uo) is det.
+
+write_indented_line(Indent, Line, !IO) :-
+ indent_line(Indent, !IO),
+ io.write_string(Line, !IO),
+ io.nl(!IO).
+
+:- pred output_src_end(indent::in, mercury_module_name::in, io::di, io::uo)
+ is det.
+
+output_src_end(Indent, ModuleName, !IO) :-
+ io.write_string("}\n\n", !IO),
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO),
+ indent_line(Indent, !IO),
+ io.write_string("// :- end_module ", !IO),
+ prog_out.write_sym_name(ModuleName, !IO),
+ io.write_string(".\n", !IO).
+
+ % Output a comment saying that the file was automatically
+ % generated and give details such as the compiler version.
+ %
+:- pred output_auto_gen_comment(globals::in, mercury_module_name::in,
+ io::di, io::uo) is det.
+
+output_auto_gen_comment(Globals, ModuleName, !IO) :-
+ library.version(Version),
+ module_name_to_file_name(Globals, ModuleName, ".m", do_not_create_dirs,
+ SourceFileName, !IO),
+ io.write_string("//\n//\n// Automatically generated from ", !IO),
+ io.write_string(SourceFileName, !IO),
+ io.write_string(" by the Mercury Compiler,\n", !IO),
+ io.write_string("// version ", !IO),
+ io.write_string(Version, !IO),
+ io.nl(!IO),
+ io.write_string("//\n", !IO),
+ io.write_string("//\n", !IO),
+ io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output declarations and definitions.
+%
+
+ % Options to adjust the behaviour of the output predicates.
+ %
+:- type output_aux
+ ---> none
+ % Nothing special.
+
+ ; cname(mlds_entity_name)
+ % Pass down the class name if a definition is a constructor; this
+ % is needed since the class name is not available for a constructor
+ % in the MLDS.
+
+ ; alloc_only
+ % When writing out RTTI structure definitions, initialise members
+ % with allocated top-level structures but don't fill in the fields
+ % yet.
+
+ ; force_init.
+ % Used to force local variables to be initialised even if an
+ % initialiser is not provided.
+
+:- pred output_defns(csharp_out_info::in, indent::in, output_aux::in,
+ list(mlds_defn)::in, io::di, io::uo) is det.
+
+output_defns(Info, Indent, OutputAux, Defns, !IO) :-
+ list.foldl(output_defn(Info, Indent, OutputAux), Defns, !IO).
+
+:- pred output_defn(csharp_out_info::in, indent::in, output_aux::in,
+ mlds_defn::in, io::di, io::uo) is det.
+
+output_defn(Info, Indent, OutputAux, Defn, !IO) :-
+ Defn = mlds_defn(Name, Context, Flags, DefnBody),
+ indent_line(Info, Context, Indent, !IO),
+ ( DefnBody = mlds_function(_, _, body_external, _, _) ->
+ % This is just a function declaration, with no body.
+ % C# doesn't support separate declarations and definitions,
+ % so just output the declaration as a comment.
+ % (Note that the actual definition of an external procedure
+ % must be given in `pragma foreign_code' in the same module.)
+ io.write_string("/* external:\n", !IO),
+ output_decl_flags(Info, Flags, !IO),
+ output_defn_body(Info, Indent, Name, OutputAux, Context, DefnBody,
+ !IO),
+ io.write_string("*/\n", !IO)
+ ;
+ (
+ DefnBody = mlds_class(ClassDefn),
+ Kind = ClassDefn ^ mcd_kind,
+ (
+ % `static' keyword not allowed on enumerations.
+ Kind = mlds_enum
+ ;
+ % `static' not wanted on classes generated for Mercury types.
+ Kind = mlds_class
+ )
+ ->
+ OverrideFlags = set_per_instance(Flags, per_instance)
+ ;
+ OverrideFlags = Flags
+ ),
+ output_decl_flags(Info, OverrideFlags, !IO),
+ output_defn_body(Info, Indent, Name, OutputAux, Context, DefnBody,
+ !IO)
+ ).
+
+:- pred output_defn_body(csharp_out_info::in, indent::in, mlds_entity_name::in,
+ output_aux::in, mlds_context::in, mlds_entity_defn::in, io::di, io::uo)
+ is det.
+
+output_defn_body(Info, Indent, UnqualName, OutputAux, Context, Entity, !IO) :-
+ (
+ Entity = mlds_data(Type, Initializer, _),
+ output_data_defn(Info, UnqualName, OutputAux, Type, Initializer,
+ !IO)
+ ;
+ Entity = mlds_function(MaybePredProcId, Signature, MaybeBody,
+ _Attributes, _EnvVarNames),
+ output_maybe(MaybePredProcId, output_pred_proc_id(Info), !IO),
+ output_func(Info, Indent, UnqualName, OutputAux, Context,
+ Signature, MaybeBody, !IO)
+ ;
+ Entity = mlds_class(ClassDefn),
+ output_class(Info, Indent, UnqualName, ClassDefn, !IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output classes.
+%
+
+:- pred output_class(csharp_out_info::in, indent::in, mlds_entity_name::in,
+ mlds_class_defn::in, io::di, io::uo) is det.
+
+output_class(!.Info, Indent, UnqualName, ClassDefn, !IO) :-
+ (
+ UnqualName = entity_type(ClassNamePrime, ArityPrime),
+ ClassName = ClassNamePrime,
+ Arity = ArityPrime
+ ;
+ ( UnqualName = entity_data(_)
+ ; UnqualName = entity_function(_, _, _, _)
+ ; UnqualName = entity_export(_)
+ ),
+ unexpected(this_file, "output_class: name is not entity_type.")
+ ),
+ ClassDefn = mlds_class_defn(Kind, _Imports, BaseClasses, Implements,
+ TypeParams, Ctors, AllMembers),
+
+ !Info ^ oi_univ_tvars := TypeParams,
+
+ output_class_kind(Kind, !IO),
+ output_unqual_class_name(ClassName, Arity, !IO),
+ OutputGenerics = !.Info ^ oi_output_generics,
+ (
+ OutputGenerics = do_output_generics,
+ output_generic_tvars(TypeParams, !IO)
+ ;
+ OutputGenerics = do_not_output_generics
+ ),
+ io.nl(!IO),
+
+ output_supers_list(!.Info, Indent + 1, BaseClasses, Implements, !IO),
+ indent_line(Indent, !IO),
+ io.write_string("{\n", !IO),
+ output_class_body(!.Info, Indent + 1, Kind, UnqualName, AllMembers, !IO),
+ io.nl(!IO),
+ output_defns(!.Info, Indent + 1, cname(UnqualName), Ctors, !IO),
+ indent_line(Indent, !IO),
+ io.write_string("}\n\n", !IO).
+
+:- pred output_class_kind(mlds_class_kind::in, io::di, io::uo) is det.
+
+output_class_kind(Kind, !IO) :-
+ (
+ Kind = mlds_interface,
+ io.write_string("interface ", !IO)
+ ;
+ ( Kind = mlds_class
+ ; Kind = mlds_package
+ ; Kind = mlds_struct
+ ),
+ io.write_string("class ", !IO)
+ ;
+ Kind = mlds_enum,
+ io.write_string("enum ", !IO)
+ ).
+
+:- pred output_generic_tvars(list(tvar)::in, io::di, io::uo) is det.
+
+output_generic_tvars(Vars, !IO) :-
+ (
+ Vars = []
+ ;
+ Vars = [_ | _],
+ io.write_string("<", !IO),
+ io.write_list(Vars, ", ", output_generic_tvar, !IO),
+ io.write_string(">", !IO)
+ ).
+
+:- pred output_generic_tvar(tvar::in, io::di, io::uo) is det.
+
+output_generic_tvar(Var, !IO) :-
+ generic_tvar_to_string(Var, VarName),
+ io.write_string(VarName, !IO).
+
+:- pred generic_tvar_to_string(tvar::in, string::out) is det.
+
+generic_tvar_to_string(Var, VarName) :-
+ varset.lookup_name(varset.init, Var, "MR_tvar_", VarName).
+
+ % Output superclass that this class extends and interfaces implemented.
+ % C# does not support multiple inheritance, so more than one superclass is
+ % an error.
+ %
+:- pred output_supers_list(csharp_out_info::in, indent::in,
+ list(mlds_class_id)::in, list(mlds_interface_id)::in,
+ io::di, io::uo) is det.
+
+output_supers_list(Info, Indent, BaseClasses, Interfaces, !IO) :-
+ list.map(interface_to_string, Interfaces, Strings0),
+ (
+ BaseClasses = [],
+ Strings = Strings0
+ ;
+ BaseClasses = [BaseClass],
+ type_to_string(Info, BaseClass, BaseClassString, _ArrayDims),
+ Strings = [BaseClassString | Strings0]
+ ;
+ BaseClasses = [_, _ | _],
+ unexpected(this_file,
+ "output_supers_list: multiple inheritance not supported")
+ ),
+ (
+ Strings = []
+ ;
+ Strings = [_ | _],
+ indent_line(Indent, !IO),
+ io.write_string(": ", !IO),
+ io.write_list(Strings, ", ", io.write_string, !IO),
+ io.nl(!IO)
+ ).
+
+:- pred interface_to_string(mlds_interface_id::in, string::out) is det.
+
+interface_to_string(Interface, String) :-
+ (
+ Interface = mlds_class_type(qual(ModuleQualifier, _QualKind, Name),
+ Arity, _)
+ ->
+ SymName = mlds_module_name_to_sym_name(ModuleQualifier),
+ mangle_sym_name_for_csharp(SymName, module_qual, ".", ModuleName),
+
+ % Check if the interface is one of the ones in the runtime system.
+ % If it is, we don't need to output the arity.
+ ( interface_is_special(Name) ->
+ String = string.format("%s.%s", [s(ModuleName), s(Name)])
+ ;
+ String = string.format("%s.%s%d", [s(ModuleName), s(Name),
+ i(Arity)])
+ )
+ ;
+ unexpected(this_file, "interface_to_string: interface was not a class")
+ ).
+
+:- pred output_class_body(csharp_out_info::in, indent::in, mlds_class_kind::in,
+ mlds_entity_name::in, list(mlds_defn)::in, io::di, io::uo) is det.
+
+output_class_body(Info, Indent, Kind, UnqualName, AllMembers, !IO) :-
+ (
+ Kind = mlds_class,
+ output_defns(Info, Indent, none, AllMembers, !IO)
+ ;
+ Kind = mlds_package,
+ unexpected(this_file, "cannot use package as a type.")
+ ;
+ Kind = mlds_interface,
+ output_defns(Info, Indent, none, AllMembers, !IO)
+ ;
+ Kind = mlds_struct,
+ % XXX C# is not Java
+ unexpected(this_file,
+ "output_class_body: structs not supported in Java.")
+ ;
+ Kind = mlds_enum,
+ list.filter(defn_is_const, AllMembers, EnumConsts),
+ output_enum_constants(Info, Indent + 1, UnqualName, EnumConsts, !IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Additional code for generating enumerations.
+%
+
+:- pred defn_is_const(mlds_defn::in) is semidet.
+
+defn_is_const(Defn) :-
+ Defn = mlds_defn(_Name, _Context, Flags, _DefnBody),
+ constness(Flags) = const.
+
+:- pred output_enum_constants(csharp_out_info::in, indent::in,
+ mlds_entity_name::in, list(mlds_defn)::in, io::di, io::uo) is det.
+
+output_enum_constants(Info, Indent, EnumName, EnumConsts, !IO) :-
+ io.write_list(EnumConsts, "\n",
+ output_enum_constant(Info, Indent, EnumName), !IO),
+ io.nl(!IO).
+
+:- pred output_enum_constant(csharp_out_info::in, indent::in,
+ mlds_entity_name::in, mlds_defn::in, io::di, io::uo) is det.
+
+output_enum_constant(_Info, Indent, _EnumName, Defn, !IO) :-
+ Defn = mlds_defn(Name, _Context, _Flags, DefnBody),
+ ( DefnBody = mlds_data(_Type, Initializer, _GCStatement) ->
+ (
+ Initializer = init_obj(Rval),
+ ( Rval = ml_const(mlconst_enum(N, _)) ->
+ % The name might require mangling.
+ indent_line(Indent, !IO),
+ output_name(Name, !IO),
+ io.format(" = %d,", [i(N)], !IO)
+ ;
+ unexpected(this_file, "output_enum_constant: not mlconst_enum")
+ )
+ ;
+ ( Initializer = no_initializer
+ ; Initializer = init_struct(_, _)
+ ; Initializer = init_array(_)
+ ),
+ unexpected(this_file, "output_enum_constant: not mlconst_enum")
+ )
+ ;
+ unexpected(this_file,
+ "output_enum_constant: definition body was not data.")
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output data declarations/definitions.
+%
+
+:- pred output_data_decls(csharp_out_info::in, indent::in, list(mlds_defn)::in,
+ io::di, io::uo) is det.
+
+output_data_decls(_, _, [], !IO).
+output_data_decls(Info, Indent, [Defn | Defns], !IO) :-
+ Defn = mlds_defn(Name, _Context, Flags, DefnBody),
+ ( DefnBody = mlds_data(Type, _Initializer, _GCStatement) ->
+ indent_line(Indent, !IO),
+ % We can't honour `final' here as the variable is assigned separately.
+ % XXX does this make any sense for C#?
+ NonFinalFlags = set_finality(Flags, overridable),
+ output_decl_flags(Info, NonFinalFlags, !IO),
+ output_data_decl(Info, Name, Type, !IO),
+ io.write_string(";\n", !IO)
+ ;
+ unexpected(this_file, "output_data_decls: not data")
+ ),
+ output_data_decls(Info, Indent, Defns, !IO).
+
+:- pred output_data_decl(csharp_out_info::in, mlds_entity_name::in,
+ mlds_type::in, io::di, io::uo) is det.
+
+output_data_decl(Info, Name, Type, !IO) :-
+ output_type(Info, Type, !IO),
+ io.write_char(' ', !IO),
+ output_name(Name, !IO).
+
+:- pred output_init_data_method(csharp_out_info::in, indent::in,
+ list(mlds_defn)::in, io::di, io::uo) is det.
+
+output_init_data_method(Info, Indent, Defns, !IO) :-
+ indent_line(Indent, !IO),
+ io.write_string("private static void MR_init_data() {\n", !IO),
+ output_init_data_statements(Info, Indent + 1, Defns, !IO),
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO).
+
+:- pred output_init_data_statements(csharp_out_info::in, indent::in,
+ list(mlds_defn)::in, io::di, io::uo) is det.
+
+output_init_data_statements(_, _, [], !IO).
+output_init_data_statements(Info, Indent, [Defn | Defns], !IO) :-
+ Defn = mlds_defn(Name, _Context, _Flags, DefnBody),
+ ( DefnBody = mlds_data(Type, Initializer, _GCStatement) ->
+ indent_line(Indent, !IO),
+ output_name(Name, !IO),
+ output_initializer(Info, none, Type, Initializer, !IO),
+ io.write_string(";\n", !IO)
+ ;
+ unexpected(this_file, "output_init_data_statements: not mlds_data")
+ ),
+ output_init_data_statements(Info, Indent, Defns, !IO).
+
+:- pred output_data_defn(csharp_out_info::in, mlds_entity_name::in,
+ output_aux::in, mlds_type::in, mlds_initializer::in, io::di, io::uo)
+ is det.
+
+output_data_defn(Info, Name, OutputAux, Type, Initializer, !IO) :-
+ output_data_decl(Info, Name, Type, !IO),
+ output_initializer(Info, OutputAux, Type, Initializer, !IO),
+ io.write_string(";\n", !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output common data.
+%
+
+:- pred output_scalar_common_data(csharp_out_info::in, indent::in,
+ ml_scalar_cell_map::in, io::di, io::uo) is det.
+
+output_scalar_common_data(Info, Indent, ScalarCellGroupMap, !IO) :-
+ % Elements of scalar data arrays may reference elements in higher-numbered
+ % arrays, or elements of the same array, so we must initialise them
+ % separately in a static initialisation block, and we must ensure that
+ % elements which are referenced by other elements are initialised first.
+ map.foldl3(output_scalar_defns(Info, Indent), ScalarCellGroupMap,
+ digraph.init, Graph, map.init, Map, !IO),
+
+ ( digraph.tsort(Graph, SortedScalars0) ->
+ indent_line(Indent, !IO),
+ io.write_string("static {\n", !IO),
+ list.reverse(SortedScalars0, SortedScalars),
+ list.foldl(output_scalar_init(Info, Indent + 1, Map),
+ SortedScalars, !IO),
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO)
+ ;
+ unexpected(this_file,
+ "output_scalar_common_data: digraph.tsort failed")
+ ).
+
+:- pred output_scalar_defns(csharp_out_info::in, indent::in,
+ ml_scalar_common_type_num::in, ml_scalar_cell_group::in,
+ digraph(mlds_scalar_common)::in, digraph(mlds_scalar_common)::out,
+ map(mlds_scalar_common, mlds_initializer)::in,
+ map(mlds_scalar_common, mlds_initializer)::out, io::di, io::uo) is det.
+
+output_scalar_defns(Info, Indent, TypeNum, CellGroup, !Graph, !Map, !IO) :-
+ TypeNum = ml_scalar_common_type_num(TypeRawNum),
+ CellGroup = ml_scalar_cell_group(Type, _InitArraySize, _Counter, _Members,
+ RowInitsCord),
+ ArrayType = mlds_array_type(Type),
+ RowInits = cord.list(RowInitsCord),
+
+ indent_line(Indent, !IO),
+ io.write_string("private static final ", !IO),
+ output_type(Info, Type, !IO),
+ io.format("[] MR_scalar_common_%d = ", [i(TypeRawNum)], !IO),
+ output_initializer_alloc_only(Info, init_array(RowInits), yes(ArrayType),
+ !IO),
+ io.write_string(";\n", !IO),
+
+ MLDS_ModuleName = Info ^ oi_module_name,
+ list.foldl3(add_scalar_inits(MLDS_ModuleName, Type, TypeNum),
+ RowInits, 0, _, !Graph, !Map).
+
+:- pred add_scalar_inits(mlds_module_name::in, mlds_type::in,
+ ml_scalar_common_type_num::in, mlds_initializer::in, int::in, int::out,
+ digraph(mlds_scalar_common)::in, digraph(mlds_scalar_common)::out,
+ map(mlds_scalar_common, mlds_initializer)::in,
+ map(mlds_scalar_common, mlds_initializer)::out) is det.
+
+add_scalar_inits(MLDS_ModuleName, Type, TypeNum, Initializer,
+ RowNum, RowNum + 1, !Graph, !Map) :-
+ Scalar = ml_scalar_common(MLDS_ModuleName, Type, TypeNum, RowNum),
+ svmap.det_insert(Scalar, Initializer, !Map),
+ digraph.add_vertex(Scalar, _Key, !Graph),
+ add_scalar_deps(Scalar, Initializer, !Graph).
+
+:- pred add_scalar_deps(mlds_scalar_common::in, mlds_initializer::in,
+ digraph(mlds_scalar_common)::in, digraph(mlds_scalar_common)::out) is det.
+
+add_scalar_deps(FromScalar, Initializer, !Graph) :-
+ (
+ Initializer = init_obj(Rval),
+ add_scalar_deps_rval(FromScalar, Rval, !Graph)
+ ;
+ Initializer = init_struct(_Type, Initializers),
+ list.foldl(add_scalar_deps(FromScalar), Initializers, !Graph)
+ ;
+ Initializer = init_array(Initializers),
+ list.foldl(add_scalar_deps(FromScalar), Initializers, !Graph)
+ ;
+ Initializer = no_initializer
+ ).
+
+:- pred add_scalar_deps_rval(mlds_scalar_common::in, mlds_rval::in,
+ digraph(mlds_scalar_common)::in, digraph(mlds_scalar_common)::out) is det.
+
+add_scalar_deps_rval(FromScalar, Rval, !Graph) :-
+ (
+ ( Rval = ml_mkword(_, RvalA)
+ ; Rval = ml_unop(_, RvalA)
+ ; Rval = ml_vector_common_row(_, RvalA)
+ ),
+ add_scalar_deps_rval(FromScalar, RvalA, !Graph)
+ ;
+ Rval = ml_binop(_, RvalA, RvalB),
+ add_scalar_deps_rval(FromScalar, RvalA, !Graph),
+ add_scalar_deps_rval(FromScalar, RvalB, !Graph)
+ ;
+ Rval = ml_const(RvalConst),
+ add_scalar_deps_rval_const(FromScalar, RvalConst, !Graph)
+ ;
+ Rval = ml_scalar_common(ToScalar),
+ digraph.add_vertices_and_edge(FromScalar, ToScalar, !Graph)
+ ;
+ Rval = ml_self(_)
+ ;
+ ( Rval = ml_lval(_Lval)
+ ; Rval = ml_mem_addr(_Lval)
+ ),
+ unexpected(this_file, "add_scalar_deps_rval: lval")
+ ).
+
+:- pred add_scalar_deps_rval_const(mlds_scalar_common::in, mlds_rval_const::in,
+ digraph(mlds_scalar_common)::in, digraph(mlds_scalar_common)::out) is det.
+
+add_scalar_deps_rval_const(FromScalar, RvalConst, !Graph) :-
+ (
+ RvalConst = mlconst_data_addr(data_addr(_, DataName)),
+ (
+ DataName = mlds_scalar_common_ref(ToScalar),
+ digraph.add_vertices_and_edge(FromScalar, ToScalar, !Graph)
+ ;
+ ( DataName = mlds_data_var(_)
+ ; DataName = mlds_rtti(_)
+ ; DataName = mlds_module_layout
+ ; DataName = mlds_proc_layout(_)
+ ; DataName = mlds_internal_layout(_, _)
+ ; DataName = mlds_tabling_ref(_, _)
+ )
+ )
+ ;
+ ( RvalConst = mlconst_true
+ ; RvalConst = mlconst_false
+ ; RvalConst = mlconst_int(_)
+ ; RvalConst = mlconst_enum(_, _)
+ ; RvalConst = mlconst_char(_)
+ ; RvalConst = mlconst_float(_)
+ ; RvalConst = mlconst_string(_)
+ ; RvalConst = mlconst_multi_string(_)
+ ; RvalConst = mlconst_foreign(_, _, _)
+ ; RvalConst = mlconst_named_const(_)
+ ; RvalConst = mlconst_code_addr(_)
+ ; RvalConst = mlconst_null(_)
+ )
+ ).
+
+:- pred output_scalar_init(csharp_out_info::in, indent::in,
+ map(mlds_scalar_common, mlds_initializer)::in, mlds_scalar_common::in,
+ io::di, io::uo) is det.
+
+output_scalar_init(Info, Indent, Map, Scalar, !IO) :-
+ map.lookup(Map, Scalar, Initializer),
+ Scalar = ml_scalar_common(_, Type, TypeNum, RowNum),
+ TypeNum = ml_scalar_common_type_num(TypeRawNum),
+ indent_line(Indent, !IO),
+ io.format("MR_scalar_common_%d[%d] = ", [i(TypeRawNum), i(RowNum)], !IO),
+ output_initializer_body(Info, Initializer, yes(Type), !IO),
+ io.write_string(";\n", !IO).
+
+:- pred output_vector_common_data(csharp_out_info::in, indent::in,
+ ml_vector_cell_map::in, io::di, io::uo) is det.
+
+output_vector_common_data(Info, Indent, VectorCellGroupMap, !IO) :-
+ map.foldl(output_vector_cell_group(Info, Indent), VectorCellGroupMap, !IO).
+
+:- pred output_vector_cell_group(csharp_out_info::in, indent::in,
+ ml_vector_common_type_num::in, ml_vector_cell_group::in,
+ io::di, io::uo) is det.
+
+output_vector_cell_group(Info, Indent, TypeNum, CellGroup, !IO) :-
+ TypeNum = ml_vector_common_type_num(TypeRawNum),
+ CellGroup = ml_vector_cell_group(Type, ClassDefn, _FieldIds, _NextRow,
+ RowInits),
+ output_defn(Info, Indent, none, ClassDefn, !IO),
+
+ indent_line(Indent, !IO),
+ io.write_string("private static final ", !IO),
+ output_type(Info, Type, !IO),
+ io.format(" MR_vector_common_%d[] = {\n", [i(TypeRawNum)], !IO),
+ indent_line(Indent + 1, !IO),
+ output_initializer_body_list(Info, cord.list(RowInits), !IO),
+ io.nl(!IO),
+ indent_line(Indent, !IO),
+ io.write_string("};\n", !IO).
+
+%-----------------------------------------------------------------------------%
+
+ % We need to provide initializers for local variables to avoid problems
+ % with undefined variables.
+ %
+:- func get_type_initializer(mlds_type) = string.
+
+get_type_initializer(Type) = Initializer :-
+ (
+ Type = mercury_type(_, CtorCat, _),
+ (
+ ( CtorCat = ctor_cat_builtin(cat_builtin_int)
+ ; CtorCat = ctor_cat_builtin(cat_builtin_float)
+ ; CtorCat = ctor_cat_enum(_)
+ ; CtorCat = ctor_cat_user(cat_user_direct_dummy)
+ ),
+ Initializer = "0"
+ ;
+ CtorCat = ctor_cat_builtin(cat_builtin_char),
+ Initializer = "'\\u0000'"
+ ;
+ ( CtorCat = ctor_cat_builtin(cat_builtin_string)
+ ; CtorCat = ctor_cat_system(_)
+ ; CtorCat = ctor_cat_higher_order
+ ; CtorCat = ctor_cat_tuple
+ ; CtorCat = ctor_cat_builtin_dummy % XXX might need to be 0
+ ; CtorCat = ctor_cat_variable
+ ; CtorCat = ctor_cat_void
+ ; CtorCat = ctor_cat_user(cat_user_notag)
+ ; CtorCat = ctor_cat_user(cat_user_general)
+ ),
+ Initializer = "null"
+ )
+ ;
+ ( Type = mlds_native_int_type
+ ; Type = mlds_native_float_type
+ ),
+ Initializer = "0"
+ ;
+ Type = mlds_native_char_type,
+ Initializer = "'\\u0000'"
+ ;
+ Type = mlds_native_bool_type,
+ Initializer = "false"
+ ;
+ ( Type = mlds_mercury_array_type(_)
+ ; Type = mlds_cont_type(_)
+ ; Type = mlds_commit_type
+ ; Type = mlds_class_type(_, _, _)
+ ; Type = mlds_array_type(_)
+ ; Type = mlds_ptr_type(_)
+ ; Type = mlds_func_type(_)
+ ; Type = mlds_generic_type
+ ; Type = mlds_generic_env_ptr_type
+ ; Type = mlds_type_info_type
+ ; Type = mlds_pseudo_type_info_type
+ ; Type = mlds_rtti_type(_)
+ ; Type = mlds_tabling_type(_)
+ ),
+ Initializer = "/*x2*/ null"
+ ;
+ Type = mlds_foreign_type(ForeignType),
+ (
+ % XXX Value types must be initialised differently to reference
+ % types. Here we support a "valuetype" prefix in foreign types,
+ % even though it is not valid C# syntax. In the future, we may
+ % want to introduce a foreign_type attribute instead.
+ ForeignType = csharp(csharp_type(CsharpType)),
+ ( string.append("valuetype ", Name, CsharpType) ->
+ Initializer = "new " ++ Name ++ "()"
+ ;
+ Initializer = "null"
+ )
+ ;
+ ( ForeignType = il(_)
+ ; ForeignType = c(_)
+ ; ForeignType = java(_)
+ ; ForeignType = erlang(_)
+ ),
+ unexpected(this_file,
+ "get_type_initializer: wrong foreign language type")
+ )
+ ;
+ Type = mlds_unknown_type,
+ unexpected(this_file,
+ "get_type_initializer: variable has unknown_type")
+ ).
+
+:- pred output_maybe(maybe(T)::in,
+ pred(T, io, io)::pred(in, di, uo) is det, io::di, io::uo) is det.
+
+output_maybe(MaybeValue, OutputAction, !IO) :-
+ (
+ MaybeValue = yes(Value),
+ OutputAction(Value, !IO)
+ ;
+ MaybeValue = no
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_initializer(csharp_out_info::in, output_aux::in, mlds_type::in,
+ mlds_initializer::in, io::di, io::uo) is det.
+
+output_initializer(Info, OutputAux, Type, Initializer, !IO) :-
+ NeedsInit = needs_initialization(Initializer),
+ (
+ NeedsInit = yes,
+ io.write_string(" = ", !IO),
+ % Due to cyclic references, we need to separate the allocation and
+ % initialisation steps of RTTI structures. If InitStyle is alloc_only
+ % then we output an initializer to allocate a structure without filling
+ % in the fields.
+ (
+ ( OutputAux = none
+ ; OutputAux = cname(_)
+ ; OutputAux = force_init
+ ),
+ output_initializer_body(Info, Initializer, yes(Type), !IO)
+ ;
+ OutputAux = alloc_only,
+ output_initializer_alloc_only(Info, Initializer, yes(Type), !IO)
+ )
+ ;
+ NeedsInit = no,
+ (
+ OutputAux = force_init,
+ % Local variables need to be initialised to avoid warnings.
+ io.write_string(" = ", !IO),
+ io.write_string(get_type_initializer(Type), !IO)
+ ;
+ ( OutputAux = none
+ ; OutputAux = cname(_)
+ ; OutputAux = alloc_only
+ )
+ )
+ ).
+
+:- func needs_initialization(mlds_initializer) = bool.
+
+needs_initialization(no_initializer) = no.
+needs_initialization(init_obj(_)) = yes.
+needs_initialization(init_struct(_, _)) = yes.
+needs_initialization(init_array(_)) = yes.
+
+:- pred output_initializer_alloc_only(csharp_out_info::in, mlds_initializer::in,
+ maybe(mlds_type)::in, io::di, io::uo) is det.
+
+output_initializer_alloc_only(Info, Initializer, MaybeType, !IO) :-
+ (
+ Initializer = no_initializer,
+ unexpected(this_file, "output_initializer_alloc_only: no_initializer")
+ ;
+ Initializer = init_obj(_),
+ unexpected(this_file, "output_initializer_alloc_only: init_obj")
+ ;
+ Initializer = init_struct(StructType, FieldInits),
+ io.write_string("new ", !IO),
+ (
+ StructType = mercury_type(_Type, CtorCat, _),
+ type_category_is_array(CtorCat) = is_array
+ ->
+ Size = list.length(FieldInits),
+ io.format("object[%d]", [i(Size)], !IO)
+ ;
+ output_type(Info, StructType, !IO),
+ io.write_string("()", !IO)
+ )
+ ;
+ Initializer = init_array(ElementInits),
+ Size = list.length(ElementInits),
+ io.write_string("new ", !IO),
+ (
+ MaybeType = yes(Type),
+ type_to_string(Info, Type, String, ArrayDims),
+ io.write_string(String, !IO),
+ % Replace the innermost array dimension by the known size.
+ ( list.split_last(ArrayDims, Heads, 0) ->
+ output_array_dimensions(Heads ++ [Size], !IO)
+ ;
+ unexpected(this_file,
+ "output_initializer_alloc_only: missing array dimension")
+ )
+ ;
+ MaybeType = no,
+ % XXX we need to know the type here
+ io.format("/* XXX init_array */ object[%d]", [i(Size)], !IO)
+ )
+ ).
+
+:- pred output_initializer_body(csharp_out_info::in, mlds_initializer::in,
+ maybe(mlds_type)::in, io::di, io::uo) is det.
+
+output_initializer_body(Info, Initializer, MaybeType, !IO) :-
+ (
+ Initializer = no_initializer,
+ unexpected(this_file, "output_initializer_body: no_initializer")
+ ;
+ Initializer = init_obj(Rval),
+ output_rval(Info, Rval, !IO)
+ ;
+ Initializer = init_struct(StructType, FieldInits),
+ io.write_string("new ", !IO),
+ output_type(Info, StructType, !IO),
+ IsArray = type_is_array(StructType),
+ io.write_string(if IsArray = is_array then " {" else "(", !IO),
+ output_initializer_body_list(Info, FieldInits, !IO),
+ io.write_char(if IsArray = is_array then '}' else ')', !IO)
+ ;
+ Initializer = init_array(ElementInits),
+ io.write_string("new ", !IO),
+ (
+ MaybeType = yes(Type),
+ output_type(Info, Type, !IO)
+ ;
+ MaybeType = no,
+ % XXX we need to know the type here
+ io.write_string("/* XXX init_array */ object[]", !IO)
+ ),
+ io.write_string(" {\n\t\t", !IO),
+ output_initializer_body_list(Info, ElementInits, !IO),
+ io.write_string("}", !IO)
+ ).
+
+:- pred output_initializer_body_list(csharp_out_info::in,
+ list(mlds_initializer)::in, io::di, io::uo) is det.
+
+output_initializer_body_list(Info, Inits, !IO) :-
+ io.write_list(Inits, ",\n\t\t",
+ (pred(Init::in, !.IO::di, !:IO::uo) is det :-
+ output_initializer_body(Info, Init, no, !IO)),
+ !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output RTTI data assignments.
+%
+
+:- pred output_rtti_assignments(csharp_out_info::in, indent::in,
+ list(mlds_defn)::in, io::di, io::uo) is det.
+
+output_rtti_assignments(Info, Indent, Defns, !IO) :-
+ indent_line(Indent, !IO),
+ io.write_string("static void MR_init_rtti() {\n", !IO),
+ OrderedDefns = order_mlds_rtti_defns(Defns),
+ list.foldl(output_rtti_defns_assignments(Info, Indent + 1),
+ OrderedDefns, !IO),
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO).
+
+:- pred output_rtti_defns_assignments(csharp_out_info::in, indent::in,
+ list(mlds_defn)::in, io::di, io::uo) is det.
+
+output_rtti_defns_assignments(Info, Indent, Defns, !IO) :-
+ % Separate cliques.
+ indent_line(Indent, !IO),
+ io.write_string("//\n", !IO),
+ list.foldl(output_rtti_defn_assignments(Info, Indent),
+ Defns, !IO).
+
+:- pred output_rtti_defn_assignments(csharp_out_info::in, indent::in,
+ mlds_defn::in, io::di, io::uo) is det.
+
+output_rtti_defn_assignments(Info, Indent, Defn, !IO) :-
+ Defn = mlds_defn(Name, _Context, _Flags, DefnBody),
+ (
+ DefnBody = mlds_data(_Type, Initializer, _),
+ output_rtti_defn_assignments_2(Info, Indent, Name, Initializer, !IO)
+ ;
+ ( DefnBody = mlds_function(_, _, _, _, _)
+ ; DefnBody = mlds_class(_)
+ ),
+ unexpected(this_file,
+ "output_rtti_defn_assignments: expected mlds_data")
+ ).
+
+:- pred output_rtti_defn_assignments_2(csharp_out_info::in, indent::in,
+ mlds_entity_name::in, mlds_initializer::in, io::di, io::uo) is det.
+
+output_rtti_defn_assignments_2(Info, Indent, Name, Initializer, !IO) :-
+ (
+ Initializer = no_initializer
+ ;
+ Initializer = init_obj(_),
+ % Not encountered in practice.
+ unexpected(this_file, "output_rtti_defn_assignments_2: init_obj")
+ ;
+ Initializer = init_struct(StructType, FieldInits),
+ IsArray = type_is_array(StructType),
+ (
+ IsArray = not_array,
+ indent_line(Indent, !IO),
+ output_name(Name, !IO),
+ io.write_string(".init(", !IO),
+ output_initializer_body_list(Info, FieldInits, !IO),
+ io.write_string(");\n", !IO)
+ ;
+ IsArray = is_array,
+ % Not encountered in practice.
+ unexpected(this_file, "output_rtti_defn_assignments_2: is_array")
+ )
+ ;
+ Initializer = init_array(ElementInits),
+ list.foldl2(output_rtti_array_assignments(Info, Indent, Name),
+ ElementInits, 0, _Index, !IO)
+ ).
+
+:- pred output_rtti_array_assignments(csharp_out_info::in, indent::in,
+ mlds_entity_name::in, mlds_initializer::in, int::in, int::out,
+ io::di, io::uo) is det.
+
+output_rtti_array_assignments(Info, Indent, Name, ElementInit,
+ Index, Index + 1, !IO) :-
+ indent_line(Indent, !IO),
+ output_name(Name, !IO),
+ io.write_string("[", !IO),
+ io.write_int(Index, !IO),
+ io.write_string("] = ", !IO),
+ output_initializer_body(Info, ElementInit, no, !IO),
+ io.write_string(";\n", !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output function declarations/definitions.
+%
+
+:- pred output_pred_proc_id(csharp_out_info::in, pred_proc_id::in,
+ io::di, io::uo) is det.
+
+output_pred_proc_id(Info, proc(PredId, ProcId), !IO) :-
+ AutoComments = Info ^ oi_auto_comments,
+ (
+ AutoComments = yes,
+ io.write_string("// pred_id: ", !IO),
+ pred_id_to_int(PredId, PredIdNum),
+ io.write_int(PredIdNum, !IO),
+ io.write_string(", proc_id: ", !IO),
+ proc_id_to_int(ProcId, ProcIdNum),
+ io.write_int(ProcIdNum, !IO),
+ io.nl(!IO)
+ ;
+ AutoComments = no
+ ).
+
+:- pred output_func(csharp_out_info::in, indent::in, mlds_entity_name::in,
+ output_aux::in, mlds_context::in,
+ mlds_func_params::in, mlds_function_body::in, io::di, io::uo) is det.
+
+output_func(Info, Indent, Name, OutputAux, Context, Signature, MaybeBody,
+ !IO) :-
+ (
+ MaybeBody = body_defined_here(Body),
+ output_func_decl(Info, Indent, Name, OutputAux, Signature, !IO),
+ io.write_string("\n", !IO),
+ indent_line(Info, Context, Indent, !IO),
+ io.write_string("{\n", !IO),
+ FuncInfo = func_info(Signature),
+ output_statement(Info, Indent + 1, FuncInfo, Body, _ExitMethods, !IO),
+ indent_line(Info, Context, Indent, !IO),
+ io.write_string("}\n", !IO) % end the function
+ ;
+ MaybeBody = body_external
+ ).
+
+:- pred output_func_decl(csharp_out_info::in, indent::in, mlds_entity_name::in,
+ output_aux::in, mlds_func_params::in, io::di, io::uo) is det.
+
+output_func_decl(Info, Indent, Name, OutputAux, Signature, !IO) :-
+ Signature = mlds_func_params(Parameters, RetTypes),
+ (
+ OutputAux = cname(CtorName),
+ Name = entity_export("<constructor>")
+ ->
+ output_name(CtorName, !IO)
+ ;
+ output_return_types(Info, RetTypes, !IO),
+ io.write_char(' ', !IO),
+ output_name(Name, !IO)
+ ),
+ output_params(Info, Indent, Parameters, !IO).
+
+:- pred output_return_types(csharp_out_info::in, mlds_return_types::in,
+ io::di, io::uo) is det.
+
+output_return_types(Info, RetTypes, !IO) :-
+ (
+ RetTypes = [],
+ io.write_string("void", !IO)
+ ;
+ RetTypes = [RetType],
+ output_type(Info, RetType, !IO)
+ ;
+ RetTypes = [_, _ | _],
+ % For multiple outputs, we return an array of objects.
+ % XXX C# has output parameters
+ io.write_string("object []", !IO)
+ ).
+
+:- pred output_params(csharp_out_info::in, indent::in, mlds_arguments::in,
+ io::di, io::uo) is det.
+
+output_params(Info, Indent, Parameters, !IO) :-
+ io.write_char('(', !IO),
+ (
+ Parameters = []
+ ;
+ Parameters = [_ | _],
+ io.nl(!IO),
+ io.write_list(Parameters, ",\n", output_param(Info, Indent + 1), !IO)
+ ),
+ io.write_char(')', !IO).
+
+:- pred output_param(csharp_out_info::in, indent::in, mlds_argument::in,
+ io::di, io::uo) is det.
+
+output_param(Info, Indent, Arg, !IO) :-
+ Arg = mlds_argument(Name, Type, _GCStatement),
+ indent_line(Indent, !IO),
+ output_type(Info, Type, !IO),
+ io.write_char(' ', !IO),
+ output_name(Name, !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output names of various entities.
+%
+% XXX Much of the code in this section will not work when we start enforcing
+% names properly.
+%
+
+:- pred output_maybe_qualified_name(csharp_out_info::in,
+ mlds_qualified_entity_name::in, io::di, io::uo) is det.
+
+output_maybe_qualified_name(Info, QualifiedName, !IO) :-
+ % Don't module qualify names which are defined in the current module.
+ % This avoids unnecessary verbosity, and is also necessary in the case
+ % of local variables and function parameters, which must not be qualified.
+ QualifiedName = qual(ModuleName, _QualKind, Name),
+ CurrentModuleName = Info ^ oi_module_name,
+ ( ModuleName = CurrentModuleName ->
+ output_name(Name, !IO)
+ ;
+ output_fully_qualified_thing(QualifiedName, output_name, !IO)
+ ).
+
+:- pred output_fully_qualified_thing(mlds_fully_qualified_name(T)::in,
+ pred(T, io, io)::pred(in, di, uo) is det, io::di, io::uo) is det.
+
+output_fully_qualified_thing(QualName, OutputFunc, !IO) :-
+ QualName = qual(MLDS_ModuleName, QualKind, UnqualName),
+ qualifier_to_string(MLDS_ModuleName, QualKind, QualifierString),
+ io.write_string(QualifierString, !IO),
+ io.write_string(".", !IO),
+ OutputFunc(UnqualName, !IO).
+
+:- pred qualifier_to_string(mlds_module_name::in, mlds_qual_kind::in,
+ string::out) is det.
+
+qualifier_to_string(MLDS_ModuleName, QualKind, String) :-
+ mlds_module_name_to_package_name(MLDS_ModuleName) = OuterName,
+ mlds_module_name_to_sym_name(MLDS_ModuleName) = InnerName,
+
+ % The part of the qualifier that corresponds to a top-level class.
+ % Remove the outermost mercury qualifier.
+ ( strip_outermost_qualifier(OuterName, "mercury", StrippedOuterName) ->
+ mangle_sym_name_for_csharp(StrippedOuterName, module_qual, "__",
+ MangledOuterName)
+ ;
+ mangle_sym_name_for_csharp(OuterName, module_qual, "__",
+ MangledOuterName)
+ ),
+
+ % The later parts of the qualifier correspond to nested classes.
+ ( OuterName = InnerName ->
+ MangledSuffix = ""
+ ;
+ remove_sym_name_prefixes(InnerName, OuterName, Suffix),
+ mangle_sym_name_for_csharp(Suffix, convert_qual_kind(QualKind), ".",
+ MangledSuffix0),
+ MangledSuffix = "." ++ MangledSuffix0
+ ),
+
+ String = MangledOuterName ++ MangledSuffix.
+
+:- pred remove_sym_name_prefixes(sym_name::in, sym_name::in, sym_name::out)
+ is det.
+
+remove_sym_name_prefixes(SymName0, Prefix, SymName) :-
+ (
+ SymName0 = qualified(Qual, Name),
+ ( Qual = Prefix ->
+ SymName = unqualified(Name)
+ ;
+ remove_sym_name_prefixes(Qual, Prefix, SymName1),
+ SymName = qualified(SymName1, Name)
+ )
+ ;
+ SymName0 = unqualified(_),
+ unexpected(this_file, "remove_sym_name_prefixes: prefix not found")
+ ).
+
+:- func convert_qual_kind(mlds_qual_kind) = csj_qual_kind.
+
+convert_qual_kind(module_qual) = module_qual.
+convert_qual_kind(type_qual) = type_qual.
+
+:- pred output_module_name(mercury_module_name::in, io::di, io::uo) is det.
+
+output_module_name(ModuleName, !IO) :-
+ io.write_string(sym_name_mangle(ModuleName), !IO).
+
+:- pred output_unqual_class_name(mlds_class_name::in, arity::in,
+ io::di, io::uo) is det.
+
+output_unqual_class_name(Name, Arity, !IO) :-
+ unqual_class_name_to_string(Name, Arity, String),
+ io.write_string(String, !IO).
+
+:- pred unqual_class_name_to_string(mlds_class_name::in, arity::in,
+ string::out) is det.
+
+unqual_class_name_to_string(Name, Arity, String) :-
+ MangledName = name_mangle_no_leading_digit(Name),
+ % By convention, class names should start with a capital letter.
+ UppercaseMangledName = flip_initial_case(MangledName),
+ String = UppercaseMangledName ++ "_" ++ string.from_int(Arity).
+
+:- pred qual_class_name_to_string(mlds_class::in, arity::in, string::out)
+ is det.
+
+qual_class_name_to_string(QualName, Arity, String) :-
+ QualName = qual(MLDS_ModuleName, QualKind, ClassName),
+ (
+ SymName = mlds_module_name_to_sym_name(MLDS_ModuleName),
+ SymName = csharp_mercury_runtime_package_name
+ ->
+ % Don't mangle runtime class names.
+ String = "runtime." ++ ClassName
+ ;
+ qualifier_to_string(MLDS_ModuleName, QualKind, QualString),
+ unqual_class_name_to_string(ClassName, Arity, UnqualString),
+ String = QualString ++ "." ++ UnqualString
+ ).
+
+:- pred output_name(mlds_entity_name::in, io::di, io::uo) is det.
+
+output_name(entity_type(Name, Arity), !IO) :-
+ output_unqual_class_name(Name, Arity, !IO).
+output_name(entity_data(DataName), !IO) :-
+ output_data_name(DataName, !IO).
+output_name(entity_function(PredLabel, ProcId, MaybeSeqNum, _PredId), !IO) :-
+ output_pred_label(PredLabel, !IO),
+ proc_id_to_int(ProcId, ModeNum),
+ io.format("_%d", [i(ModeNum)], !IO),
+ (
+ MaybeSeqNum = yes(SeqNum),
+ io.format("_%d", [i(SeqNum)], !IO)
+ ;
+ MaybeSeqNum = no
+ ).
+output_name(entity_export(Name), !IO) :-
+ io.write_string(Name, !IO).
+
+:- pred output_pred_label(mlds_pred_label::in, io::di, io::uo) is det.
+
+output_pred_label(mlds_user_pred_label(PredOrFunc, MaybeDefiningModule, Name,
+ PredArity, _, _), !IO) :-
+ (
+ PredOrFunc = pf_predicate,
+ Suffix = "p",
+ OrigArity = PredArity
+ ;
+ PredOrFunc = pf_function,
+ Suffix = "f",
+ OrigArity = PredArity - 1
+ ),
+ MangledName = name_mangle_no_leading_digit(Name),
+ io.format("%s_%d_%s", [s(MangledName), i(OrigArity), s(Suffix)], !IO),
+ (
+ MaybeDefiningModule = yes(DefiningModule),
+ io.write_string("_in__", !IO),
+ output_module_name(DefiningModule, !IO)
+ ;
+ MaybeDefiningModule = no
+ ).
+
+output_pred_label(mlds_special_pred_label(PredName, MaybeTypeModule, TypeName,
+ TypeArity), !IO) :-
+ MangledPredName = name_mangle_no_leading_digit(PredName),
+ MangledTypeName = name_mangle(TypeName),
+ io.write_string(MangledPredName, !IO),
+ io.write_string("__", !IO),
+ (
+ MaybeTypeModule = yes(TypeModule),
+ output_module_name(TypeModule, !IO),
+ io.write_string("__", !IO)
+ ;
+ MaybeTypeModule = no
+ ),
+ io.format("%s_%d", [s(MangledTypeName), i(TypeArity)], !IO).
+
+:- pred output_data_name(mlds_data_name::in, io::di, io::uo) is det.
+
+output_data_name(mlds_data_var(VarName), !IO) :-
+ output_mlds_var_name(VarName, !IO).
+
+output_data_name(mlds_scalar_common_ref(Common), !IO) :-
+ Common = ml_scalar_common(_ModuleName, _Type,
+ ml_scalar_common_type_num(TypeNum), RowNum),
+ io.format("MR_scalar_common_%d[%d]", [i(TypeNum), i(RowNum)], !IO).
+
+output_data_name(mlds_rtti(RttiId), !IO) :-
+ rtti.id_to_c_identifier(RttiId, RttiAddrName),
+ io.write_string(RttiAddrName, !IO).
+output_data_name(mlds_module_layout, !IO) :-
+ unexpected(this_file, "NYI: mlds_module_layout").
+output_data_name(mlds_proc_layout(_ProcLabel), !IO) :-
+ unexpected(this_file, "NYI: mlds_proc_layout").
+output_data_name(mlds_internal_layout(_ProcLabel, _FuncSeqNum), !IO) :-
+ unexpected(this_file, "NYI: mlds_internal_layout").
+output_data_name(mlds_tabling_ref(ProcLabel, Id), !IO) :-
+ Prefix = tabling_info_id_str(Id) ++ "_",
+ io.write_string(Prefix, !IO),
+ mlds_output_proc_label(mlds_std_tabling_proc_label(ProcLabel), !IO).
+
+:- pred output_mlds_var_name(mlds_var_name::in, io::di, io::uo) is det.
+
+output_mlds_var_name(mlds_var_name(Name, no), !IO) :-
+ output_valid_mangled_name(Name, !IO).
+output_mlds_var_name(mlds_var_name(Name, yes(Num)), !IO) :-
+ output_mangled_name(string.format("%s_%d", [s(Name), i(Num)]), !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output types.
+%
+
+:- pred output_type(csharp_out_info::in, mlds_type::in, io::di, io::uo) is det.
+
+output_type(Info, MLDS_Type, !IO) :-
+ output_type(Info, MLDS_Type, [], !IO).
+
+:- pred output_type(csharp_out_info::in, mlds_type::in, list(int)::in,
+ io::di, io::uo) is det.
+
+output_type(Info, MLDS_Type, ArrayDims0, !IO) :-
+ type_to_string(Info, MLDS_Type, String, ArrayDims),
+ io.write_string(String, !IO),
+ output_array_dimensions(ArrayDims ++ ArrayDims0, !IO).
+
+:- pred output_array_dimensions(list(int)::in, io::di, io::uo) is det.
+
+output_array_dimensions(ArrayDims, !IO) :-
+ list.map(array_dimension_to_string, ArrayDims, Strings),
+ list.foldr(io.write_string, Strings, !IO).
+
+ % type_to_string(Info, MLDS_Type, String, ArrayDims)
+ %
+ % Generate the Java name for a type. ArrayDims are the array dimensions to
+ % be written after the type name, if any, in reverse order to that of Java
+ % syntax where a non-zero integer represents a known array size and zero
+ % represents an unknown array size.
+ %
+ % e.g. ArrayDims = [0, 3] represents the Java array `Object[3][]',
+ % which should be read as `(Object[])[3]'.
+ %
+ % XXX yet to check this for C#
+ %
+:- pred type_to_string(csharp_out_info::in, mlds_type::in,
+ string::out, list(int)::out) is det.
+
+type_to_string(Info, MLDS_Type, String, ArrayDims) :-
+ (
+ MLDS_Type = mercury_type(Type, CtorCat, _),
+ (
+ % We need to handle type_info (etc.) types specially --
+ % they get mapped to types in the runtime rather than
+ % in private_builtin.
+ hand_defined_type(Type, CtorCat, SubstituteName, ArrayDims0)
+ ->
+ String = SubstituteName,
+ ArrayDims = ArrayDims0
+ ;
+ % io.state and store.store
+ CtorCat = ctor_cat_builtin_dummy
+ ->
+ String = "/* builtin_dummy */ object",
+ ArrayDims = []
+ ;
+ Type = c_pointer_type
+ ->
+ % The c_pointer type is used in the c back-end as a generic way
+ % to pass foreign types to automatically generated Compare and
+ % Unify code. When compiling to C# we must instead use
+ % object.
+ String = "/* c_pointer */ object",
+ ArrayDims = []
+ ;
+ mercury_type_to_string(Info, Type, CtorCat, String, ArrayDims)
+ )
+ ;
+ MLDS_Type = mlds_mercury_array_type(ElementType),
+ ( ElementType = mercury_type(_, ctor_cat_variable, _) ->
+ String = "System.Array",
+ ArrayDims = []
+ ;
+ % For primitive element types we use arrays of the primitive type.
+ % For non-primitive element types, we just use
+ % `object []'. We used to use more specific types,
+ % but then to create an array of the right type we need to use
+ % reflection to determine the class of a representative element.
+ % That doesn't work if the representative element is of a foreign
+ % type, and has the value null.
+ ( csharp_builtin_type(ElementType, _) ->
+ type_to_string(Info, ElementType, String, ArrayDims0),
+ ArrayDims = [0 | ArrayDims0]
+ ;
+ String = "object",
+ ArrayDims = [0]
+ )
+ )
+ ;
+ MLDS_Type = mlds_native_int_type,
+ String = "int",
+ ArrayDims = []
+ ;
+ MLDS_Type = mlds_native_float_type,
+ String = "double",
+ ArrayDims = []
+ ;
+ MLDS_Type = mlds_native_bool_type,
+ String = "bool",
+ ArrayDims = []
+ ;
+ MLDS_Type = mlds_native_char_type,
+ String = "char",
+ ArrayDims = []
+ ;
+ MLDS_Type = mlds_foreign_type(ForeignType),
+ (
+ ForeignType = csharp(csharp_type(CsharpType)),
+ ( string.append("valuetype ", Name, CsharpType) ->
+ String = Name
+ ;
+ String = CsharpType
+ ),
+ ArrayDims = []
+ ;
+ ForeignType = c(_),
+ unexpected(this_file, "output_type: c foreign_type")
+ ;
+ ForeignType = il(_),
+ unexpected(this_file, "output_type: il foreign_type")
+ ;
+ ForeignType = java(_),
+ unexpected(this_file, "output_type: java foreign_type")
+ ;
+ ForeignType = erlang(_),
+ unexpected(this_file, "output_type: erlang foreign_type")
+ )
+ ;
+ MLDS_Type = mlds_class_type(Name, Arity, _ClassKind),
+ qual_class_name_to_string(Name, Arity, String),
+ ArrayDims = []
+ ;
+ MLDS_Type = mlds_ptr_type(Type),
+ % XXX Should we report an error here, if the type pointed to
+ % is not a class type?
+ type_to_string(Info, Type, String, ArrayDims)
+ ;
+ MLDS_Type = mlds_array_type(Type),
+ type_to_string(Info, Type, String, ArrayDims0),
+ ArrayDims = [0 | ArrayDims0]
+ ;
+ MLDS_Type = mlds_func_type(mlds_func_params(Args, RetTypes)),
+ ArgTypes = list.map(func(mlds_argument(_, Type, _)) = Type, Args),
+ String = method_ptr_type_to_string(Info, ArgTypes, RetTypes),
+ ArrayDims = []
+ ;
+ MLDS_Type = mlds_generic_type,
+ String = "/* generic_type */ object",
+ ArrayDims = []
+ ;
+ MLDS_Type = mlds_generic_env_ptr_type,
+ String = "/* env_ptr */ object",
+ ArrayDims = []
+ ;
+ MLDS_Type = mlds_type_info_type,
+ String = "runtime.TypeInfo",
+ ArrayDims = []
+ ;
+ MLDS_Type = mlds_pseudo_type_info_type,
+ String = "runtime.PseudoTypeInfo",
+ ArrayDims = []
+ ;
+ MLDS_Type = mlds_cont_type(_),
+ % XXX can we do better than this for C#?
+ String = "/* cont_type */ object",
+ ArrayDims = []
+ ;
+ MLDS_Type = mlds_commit_type,
+ String = "runtime.Commit",
+ ArrayDims = []
+ ;
+ MLDS_Type = mlds_rtti_type(RttiIdMaybeElement),
+ rtti_id_maybe_element_csharp_type(RttiIdMaybeElement, String, IsArray),
+ (
+ IsArray = is_array,
+ ArrayDims = [0]
+ ;
+ IsArray = not_array,
+ ArrayDims = []
+ )
+ ;
+ MLDS_Type = mlds_tabling_type(TablingId),
+ % XXX C# is not Java
+ tabling_id_java_type(TablingId, String, IsArray),
+ (
+ IsArray = is_array,
+ ArrayDims = [0]
+ ;
+ IsArray = not_array,
+ ArrayDims = []
+ )
+ ;
+ MLDS_Type = mlds_unknown_type,
+ unexpected(this_file, "output_type: unknown type")
+ ).
+
+:- pred mercury_type_to_string(csharp_out_info::in, mer_type::in,
+ type_ctor_category::in, string::out, list(int)::out) is det.
+
+mercury_type_to_string(Info, Type, CtorCat, String, ArrayDims) :-
+ (
+ CtorCat = ctor_cat_builtin(cat_builtin_char),
+ String = "char",
+ ArrayDims = []
+ ;
+ CtorCat = ctor_cat_builtin(cat_builtin_int),
+ String = "int",
+ ArrayDims = []
+ ;
+ CtorCat = ctor_cat_builtin(cat_builtin_string),
+ String = "string",
+ ArrayDims = []
+ ;
+ CtorCat = ctor_cat_builtin(cat_builtin_float),
+ String = "double",
+ ArrayDims = []
+ ;
+ CtorCat = ctor_cat_void,
+ String = "builtin.Void_0",
+ ArrayDims = []
+ ;
+ CtorCat = ctor_cat_variable,
+ % XXX C# has generics
+ String = "object",
+ ArrayDims = []
+ ;
+ CtorCat = ctor_cat_tuple,
+ String = "/* tuple */ object",
+ ArrayDims = [0]
+ ;
+ CtorCat = ctor_cat_higher_order,
+ String = "/* closure */ object",
+ ArrayDims = [0]
+ ;
+ CtorCat = ctor_cat_system(_),
+ mercury_type_to_string(Info, Type, ctor_cat_user(cat_user_general),
+ String, ArrayDims)
+ ;
+ ( CtorCat = ctor_cat_enum(_)
+ ; CtorCat = ctor_cat_user(_)
+ ; CtorCat = ctor_cat_builtin_dummy
+ ),
+ mercury_user_type_to_string(Info, Type, CtorCat, String, ArrayDims)
+ ).
+
+:- pred mercury_user_type_to_string(csharp_out_info::in, mer_type::in,
+ type_ctor_category::in, string::out, list(int)::out) is det.
+
+mercury_user_type_to_string(Info, Type, CtorCat, String, ArrayDims) :-
+ ( type_to_ctor_and_args(Type, TypeCtor, ArgsTypes) ->
+ ml_gen_type_name(TypeCtor, ClassName, ClassArity),
+ ( CtorCat = ctor_cat_enum(_) ->
+ MLDS_Type = mlds_class_type(ClassName, ClassArity, mlds_enum)
+ ;
+ MLDS_Type = mlds_class_type(ClassName, ClassArity, mlds_class)
+ ),
+ type_to_string(Info, MLDS_Type, TypeString, ArrayDims),
+ OutputGenerics = Info ^ oi_output_generics,
+ (
+ OutputGenerics = do_output_generics,
+ generic_args_types_to_string(Info, ArgsTypes, GenericsString),
+ String = TypeString ++ GenericsString
+ ;
+ OutputGenerics = do_not_output_generics,
+ String = TypeString
+ )
+ ;
+ unexpected(this_file, "output_mercury_user_type: not a user type")
+ ).
+
+:- pred generic_args_types_to_string(csharp_out_info::in, list(mer_type)::in,
+ string::out) is det.
+
+generic_args_types_to_string(Info, ArgsTypes, String) :-
+ (
+ ArgsTypes = [],
+ String = ""
+ ;
+ ArgsTypes = [_ | _],
+ ToString = (pred(ArgType::in, ArgTypeString::out) is det :-
+ ModuleInfo = Info ^ oi_module_info,
+ MLDS_ArgType = mercury_type_to_mlds_type(ModuleInfo, ArgType),
+ boxed_type_to_string(Info, MLDS_ArgType, ArgTypeString)
+ ),
+ list.map(ToString, ArgsTypes, ArgsTypesStrings),
+ ArgsTypesString = string.join_list(", ", ArgsTypesStrings),
+ String = "<" ++ ArgsTypesString ++ ">"
+ ).
+
+ % Return is_array if the corresponding C# type is an array type.
+ %
+:- func type_is_array(mlds_type) = is_array.
+
+type_is_array(Type) = IsArray :-
+ ( Type = mlds_array_type(_) ->
+ IsArray = is_array
+ ; Type = mlds_mercury_array_type(_) ->
+ IsArray = is_array
+ ; Type = mercury_type(_, CtorCat, _) ->
+ IsArray = type_category_is_array(CtorCat)
+ ; Type = mlds_rtti_type(RttiIdMaybeElement) ->
+ rtti_id_maybe_element_csharp_type(RttiIdMaybeElement,
+ _TypeName, IsArray)
+ ;
+ IsArray = not_array
+ ).
+
+ % Return is_array if the corresponding C# type is an array type.
+ %
+:- func type_category_is_array(type_ctor_category) = is_array.
+
+type_category_is_array(CtorCat) = IsArray :-
+ (
+ ( CtorCat = ctor_cat_builtin(_)
+ ; CtorCat = ctor_cat_enum(_)
+ ; CtorCat = ctor_cat_builtin_dummy
+ ; CtorCat = ctor_cat_variable
+ ; CtorCat = ctor_cat_system(cat_system_type_info)
+ ; CtorCat = ctor_cat_system(cat_system_type_ctor_info)
+ ; CtorCat = ctor_cat_void
+ ; CtorCat = ctor_cat_user(_)
+ ),
+ IsArray = not_array
+ ;
+ ( CtorCat = ctor_cat_higher_order
+ ; CtorCat = ctor_cat_tuple
+ ; CtorCat = ctor_cat_system(cat_system_typeclass_info)
+ ; CtorCat = ctor_cat_system(cat_system_base_typeclass_info)
+ ),
+ IsArray = is_array
+ ).
+
+ % hand_defined_type(Type, CtorCat, SubstituteName, ArrayDims):
+ %
+ % We need to handle type_info (etc.) types specially -- they get mapped
+ % to types in the runtime rather than in private_builtin.
+ %
+:- pred hand_defined_type(mer_type::in, type_ctor_category::in, string::out,
+ list(int)::out) is semidet.
+
+hand_defined_type(Type, CtorCat, SubstituteName, ArrayDims) :-
+ (
+ CtorCat = ctor_cat_system(cat_system_type_info),
+ SubstituteName = "runtime.TypeInfo_Struct",
+ ArrayDims = []
+ ;
+ CtorCat = ctor_cat_system(cat_system_type_ctor_info),
+ SubstituteName = "runtime.TypeCtorInfo_Struct",
+ ArrayDims = []
+ ;
+ CtorCat = ctor_cat_system(cat_system_typeclass_info),
+ SubstituteName = "/* typeclass_info */ object",
+ ArrayDims = [0]
+ ;
+ CtorCat = ctor_cat_system(cat_system_base_typeclass_info),
+ SubstituteName = "/* base_typeclass_info */ object",
+ ArrayDims = [0]
+ ;
+ CtorCat = ctor_cat_user(cat_user_general),
+ ( Type = type_desc_type ->
+ SubstituteName = "runtime.TypeInfo_Struct"
+ ; Type = pseudo_type_desc_type ->
+ SubstituteName = "runtime.PseudoTypeInfo"
+ ; Type = type_ctor_desc_type ->
+ SubstituteName = "runtime.TypeCtorInfo_Struct"
+ ;
+ fail
+ ),
+ ArrayDims = []
+ ).
+
+:- pred boxed_type_to_string(csharp_out_info::in, mlds_type::in, string::out)
+ is det.
+
+boxed_type_to_string(Info, Type, String) :-
+ type_to_string(Info, Type, String0, ArrayDims),
+ list.map(array_dimension_to_string, ArrayDims, RevBrackets),
+ list.reverse(RevBrackets, Brackets),
+ string.append_list([String0 | Brackets], String).
+
+:- pred array_dimension_to_string(int::in, string::out) is det.
+
+array_dimension_to_string(N, String) :-
+ ( N = 0 ->
+ String = "[]"
+ ;
+ String = string.format("[%d]", [i(N)])
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output declaration specifiers.
+%
+
+:- pred output_decl_flags(csharp_out_info::in, mlds_decl_flags::in,
+ io::di, io::uo) is det.
+
+output_decl_flags(Info, Flags, !IO) :-
+ output_access(Info, access(Flags), !IO),
+ output_per_instance(per_instance(Flags), !IO),
+ output_virtuality(Info, virtuality(Flags), !IO),
+ output_finality(finality(Flags), !IO),
+ output_constness(Info, constness(Flags), !IO),
+ output_abstractness(abstractness(Flags), !IO).
+
+:- pred output_access(csharp_out_info::in, access::in, io::di, io::uo) is det.
+
+output_access(Info, Access, !IO) :-
+ (
+ Access = acc_public,
+ io.write_string("public ", !IO)
+ ;
+ Access = acc_private,
+ io.write_string("private ", !IO)
+ ;
+ Access = acc_protected,
+ io.write_string("protected ", !IO)
+ ;
+ Access = acc_default,
+ maybe_output_comment(Info, "default", !IO)
+ ;
+ Access = acc_local
+ ).
+
+:- pred output_per_instance(per_instance::in, io::di, io::uo) is det.
+
+output_per_instance(PerInstance, !IO) :-
+ (
+ PerInstance = per_instance
+ ;
+ PerInstance = one_copy,
+ io.write_string("static ", !IO)
+ ).
+
+:- pred output_virtuality(csharp_out_info::in, virtuality::in,
+ io::di, io::uo) is det.
+
+output_virtuality(Info, Virtual, !IO) :-
+ (
+ Virtual = virtual,
+ maybe_output_comment(Info, "virtual", !IO)
+ ;
+ Virtual = non_virtual
+ ).
+
+:- pred output_finality(finality::in, io::di, io::uo) is det.
+
+output_finality(Finality, !IO) :-
+ (
+ Finality = final,
+ io.write_string("readonly ", !IO)
+ ;
+ Finality = overridable
+ ).
+
+:- pred output_constness(csharp_out_info::in, constness::in,
+ io::di, io::uo) is det.
+
+output_constness(Info, Constness, !IO) :-
+ (
+ Constness = const,
+ maybe_output_comment(Info, "const", !IO)
+ ;
+ Constness = modifiable
+ ).
+
+:- pred output_abstractness(abstractness::in, io::di, io::uo) is det.
+
+output_abstractness(Abstractness, !IO) :-
+ (
+ Abstractness = abstract,
+ io.write_string("abstract ", !IO)
+ ;
+ Abstractness = concrete
+ ).
+
+:- pred maybe_output_comment(csharp_out_info::in, string::in,
+ io::di, io::uo) is det.
+
+maybe_output_comment(Info, Comment, !IO) :-
+ AutoComments = Info ^ oi_auto_comments,
+ (
+ AutoComments = yes,
+ io.write_string("/* ", !IO),
+ io.write_string(Comment, !IO),
+ io.write_string(" */", !IO)
+ ;
+ AutoComments = no
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output statements.
+%
+
+ % These types are used by many of the output_stmt style predicates to
+ % return information about the statement's control flow,
+ % i.e. about the different ways in which the statement can exit.
+ % In general we only output the current statement if the previous
+ % statement could complete normally (fall through).
+ % We keep a set of exit methods since some statements (like an
+ % if-then-else) could potentially break, and also fall through.
+:- type exit_methods == set.set(exit_method).
+
+:- type exit_method
+ ---> can_break
+ ; can_continue
+ ; can_return
+ ; can_throw
+ ; can_fall_through. % Where the instruction can complete
+ % normally and execution can continue
+ % with the following statement.
+
+:- type code_addr_wrapper
+ ---> code_addr_wrapper(
+ caw_class :: string,
+ caw_ptr_num :: maybe(int)
+ ).
+
+:- type func_info
+ ---> func_info(
+ func_info_params :: mlds_func_params
+ ).
+
+:- pred output_statements(csharp_out_info::in, indent::in, func_info::in,
+ list(statement)::in, exit_methods::out, io::di, io::uo) is det.
+
+output_statements(_, _, _, [], ExitMethods, !IO) :-
+ ExitMethods = set.make_singleton_set(can_fall_through).
+output_statements(Info, Indent, FuncInfo, [Statement | Statements],
+ ExitMethods, !IO) :-
+ output_statement(Info, Indent, FuncInfo, Statement,
+ StmtExitMethods, !IO),
+ ( set.member(can_fall_through, StmtExitMethods) ->
+ output_statements(Info, Indent, FuncInfo, Statements,
+ StmtsExitMethods, !IO),
+ ExitMethods0 = StmtExitMethods `set.union` StmtsExitMethods,
+ ( set.member(can_fall_through, StmtsExitMethods) ->
+ ExitMethods = ExitMethods0
+ ;
+ % If the last statement could not complete normally
+ % the current block can no longer complete normally.
+ ExitMethods = ExitMethods0 `set.delete` can_fall_through
+ )
+ ;
+ % Don't output any more statements from the current list since
+ % the preceeding statement cannot complete.
+ ExitMethods = StmtExitMethods
+ ).
+
+:- pred output_statement(csharp_out_info::in, indent::in,
+ func_info::in, statement::in, exit_methods::out, io::di, io::uo) is det.
+
+output_statement(Info, Indent, FuncInfo,
+ statement(Statement, Context), ExitMethods, !IO) :-
+ output_context(Info, Context, !IO),
+ output_stmt(Info, Indent, FuncInfo, Statement, Context,
+ ExitMethods, !IO).
+
+:- pred output_stmt(csharp_out_info::in, indent::in, func_info::in,
+ mlds_stmt::in, mlds_context::in, exit_methods::out, io::di, io::uo) is det.
+
+output_stmt(Info, Indent, FuncInfo, Statement, Context, ExitMethods, !IO) :-
+ (
+ Statement = ml_stmt_block(Defns, Statements),
+ indent_line(Indent, !IO),
+ io.write_string("{\n", !IO),
+ (
+ Defns = [_ | _],
+ output_defns(Info, Indent + 1, force_init, Defns, !IO),
+ io.write_string("\n", !IO)
+ ;
+ Defns = []
+ ),
+ output_statements(Info, Indent + 1, FuncInfo, Statements,
+ ExitMethods, !IO),
+ indent_line(Info, Context, Indent, !IO),
+ io.write_string("}\n", !IO)
+ ;
+ Statement = ml_stmt_while(Kind, Cond, BodyStatement),
+ Kind = may_loop_zero_times,
+ indent_line(Indent, !IO),
+ io.write_string("while (", !IO),
+ output_rval(Info, Cond, !IO),
+ io.write_string(")\n", !IO),
+ % The contained statement is reachable iff the while statement is
+ % reachable and the condition expression is not a constant expression
+ % whose value is false.
+ ( Cond = ml_const(mlconst_false) ->
+ indent_line(Indent, !IO),
+ io.write_string("{ /* Unreachable code */ }\n", !IO),
+ ExitMethods = set.make_singleton_set(can_fall_through)
+ ;
+ output_statement(Info, Indent + 1, FuncInfo, BodyStatement,
+ StmtExitMethods, !IO),
+ ExitMethods = while_exit_methods(Cond, StmtExitMethods)
+ )
+ ;
+ Statement = ml_stmt_while(Kind, Cond, BodyStatement),
+ Kind = loop_at_least_once,
+ indent_line(Indent, !IO),
+ io.write_string("do\n", !IO),
+ output_statement(Info, Indent + 1, FuncInfo, BodyStatement,
+ StmtExitMethods, !IO),
+ indent_line(Info, Context, Indent, !IO),
+ io.write_string("while (", !IO),
+ output_rval(Info, Cond, !IO),
+ io.write_string(");\n", !IO),
+ ExitMethods = while_exit_methods(Cond, StmtExitMethods)
+ ;
+ Statement = ml_stmt_if_then_else(Cond, Then0, MaybeElse),
+ % We need to take care to avoid problems caused by the dangling else
+ % ambiguity.
+ (
+ % For examples of the form
+ %
+ % if (...)
+ % if (...)
+ % ...
+ % else
+ % ...
+ %
+ % we need braces around the inner `if', otherwise they wouldn't
+ % parse they way we want them to.
+
+ MaybeElse = yes(_),
+ Then0 = statement(ml_stmt_if_then_else(_, _, no), ThenContext)
+ ->
+ Then = statement(ml_stmt_block([], [Then0]), ThenContext)
+ ;
+ Then = Then0
+ ),
+
+ indent_line(Indent, !IO),
+ io.write_string("if (", !IO),
+ output_rval(Info, Cond, !IO),
+ io.write_string(")\n", !IO),
+ output_statement(Info, Indent + 1, FuncInfo, Then,
+ ThenExitMethods, !IO),
+ (
+ MaybeElse = yes(Else),
+ indent_line(Info, Context, Indent, !IO),
+ io.write_string("else\n", !IO),
+ output_statement(Info, Indent + 1, FuncInfo, Else,
+ ElseExitMethods, !IO),
+ % An if-then-else statement can complete normally iff the
+ % then-statement can complete normally or the else-statement
+ % can complete normally.
+ ExitMethods = ThenExitMethods `set.union` ElseExitMethods
+ ;
+ MaybeElse = no,
+ % An if-then statement can complete normally iff it is reachable.
+ ExitMethods = ThenExitMethods `set.union`
+ set.make_singleton_set(can_fall_through)
+ )
+ ;
+ Statement = ml_stmt_switch(_Type, Val, _Range, Cases, Default),
+ indent_line(Info, Context, Indent, !IO),
+ io.write_string("switch (", !IO),
+ output_rval(Info, Val, !IO),
+ io.write_string(") {\n", !IO),
+ output_switch_cases(Info, Indent + 1, FuncInfo, Context, Cases,
+ Default, ExitMethods, !IO),
+ indent_line(Info, Context, Indent, !IO),
+ io.write_string("}\n", !IO)
+ ;
+ Statement = ml_stmt_label(_),
+ % XXX C# is not Java
+ unexpected(this_file, "output_stmt: labels not supported in Java.")
+ ;
+ Statement = ml_stmt_goto(goto_label(_)),
+ % XXX C# is not Java
+ unexpected(this_file, "output_stmt: gotos not supported in Java.")
+ ;
+ Statement = ml_stmt_goto(goto_break),
+ indent_line(Indent, !IO),
+ io.write_string("break;\n", !IO),
+ ExitMethods = set.make_singleton_set(can_break)
+ ;
+ Statement = ml_stmt_goto(goto_continue),
+ indent_line(Indent, !IO),
+ io.write_string("continue;\n", !IO),
+ ExitMethods = set.make_singleton_set(can_continue)
+ ;
+ Statement = ml_stmt_computed_goto(_, _),
+ % XXX C# is not Java
+ unexpected(this_file,
+ "output_stmt: computed gotos not supported in Java.")
+ ;
+ Statement = ml_stmt_call(Signature, FuncRval, MaybeObject, CallArgs,
+ Results, IsTailCall),
+ Signature = mlds_func_signature(ArgTypes, RetTypes),
+ indent_line(Indent, !IO),
+ io.write_string("{\n", !IO),
+ indent_line(Info, Context, Indent + 1, !IO),
+ (
+ Results = []
+ ;
+ Results = [Lval],
+ output_lval(Info, Lval, !IO),
+ io.write_string(" = ", !IO)
+ ;
+ Results = [_, _ | _],
+ % for multiple return values,
+ % we generate the following code:
+ % { object [] result = <func>(<args>);
+ % <output1> = (<type1>) result[0];
+ % <output2> = (<type2>) result[1];
+ % ...
+ % }
+ %
+ io.write_string("object [] result = ", !IO)
+ ),
+ ( FuncRval = ml_const(mlconst_code_addr(_)) ->
+ % This is a standard method call.
+ (
+ MaybeObject = yes(Object),
+ output_bracketed_rval(Info, Object, !IO),
+ io.write_string(".", !IO)
+ ;
+ MaybeObject = no
+ ),
+ % This is a standard function call.
+ output_call_rval(Info, FuncRval, !IO),
+ io.write_string("(", !IO),
+ io.write_list(CallArgs, ", ", output_rval(Info), !IO),
+ io.write_string(")", !IO)
+ ;
+ % This is a call using a method pointer.
+ %
+ % Here we do downcasting, as a call will always return
+ % something of type object
+ %
+ % XXX This is a hack, I can't see any way to do this downcasting
+ % nicely, as it needs to effectively be wrapped around the method
+ % call itself, so it acts before this predicate's solution to
+ % multiple return values, see above.
+
+ (
+ RetTypes = []
+ ;
+ RetTypes = [RetType],
+ boxed_type_to_string(Info, RetType, RetTypeString),
+ io.format("((%s) ", [s(RetTypeString)], !IO)
+ ;
+ RetTypes = [_, _ | _],
+ io.write_string("((object[]) ", !IO)
+ ),
+ (
+ MaybeObject = yes(Object),
+ output_bracketed_rval(Info, Object, !IO),
+ io.write_string(".", !IO)
+ ;
+ MaybeObject = no
+ ),
+
+% list.length(CallArgs, Arity),
+% list.length(RetTypes, NumRetTypes),
+ io.format("((%s) ", [s(method_ptr_type_to_string(Info, ArgTypes, RetTypes))], !IO),
+ output_bracketed_rval(Info, FuncRval, !IO),
+ io.write_string(")(", !IO),
+ output_boxed_args(Info, CallArgs, ArgTypes, !IO),
+ % Closes brackets, and calls unbox methods for downcasting.
+ % XXX This is a hack, see the above comment.
+ io.write_string(")", !IO),
+ (
+ RetTypes = []
+ ;
+ RetTypes = [_RetType2],
+ io.write_string(")", !IO)
+ ;
+ RetTypes = [_, _ | _],
+ io.write_string(")", !IO)
+ )
+ ),
+ io.write_string(";\n", !IO),
+
+ ( Results = [_, _ | _] ->
+ % Copy the results from the "result" array into the Result
+ % lvals (unboxing them as we go).
+ output_assign_results(Info, Results, RetTypes, 0, Indent + 1,
+ Context, !IO)
+ ;
+ true
+ ),
+ % XXX Is this needed? If present, it causes compiler errors for a
+ % couple of files in the benchmarks directory. -mjwybrow
+ %
+ % ( IsTailCall = tail_call, Results = [] ->
+ % indent_line(Context, Indent + 1, !IO),
+ % io.write_string("return;\n", !IO)
+ % ;
+ % true
+ % ),
+
+ % This is to tell the C# compiler that a call to an erroneous procedure
+ % will not fall through. --pw
+ (
+ IsTailCall = ordinary_call
+ ;
+ IsTailCall = tail_call
+ ;
+ IsTailCall = no_return_call,
+ indent_line(Indent + 1, !IO),
+ io.write_string("throw new runtime.UnreachableDefault();\n", !IO)
+ ),
+
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO),
+ ExitMethods = set.make_singleton_set(can_fall_through)
+ ;
+ Statement = ml_stmt_return(Results),
+ (
+ Results = [],
+ indent_line(Indent, !IO),
+ io.write_string("return;\n", !IO)
+ ;
+ Results = [Rval],
+ indent_line(Indent, !IO),
+ io.write_string("return ", !IO),
+ output_rval(Info, Rval, !IO),
+ io.write_string(";\n", !IO)
+ ;
+ Results = [_, _ | _],
+ FuncInfo = func_info(Params),
+ Params = mlds_func_params(_Args, ReturnTypes),
+ TypesAndResults = assoc_list.from_corresponding_lists(
+ ReturnTypes, Results),
+ io.write_string("return new object[] {\n", !IO),
+ indent_line(Indent + 1, !IO),
+ Separator = ",\n" ++ duplicate_char(' ', (Indent + 1) * 2),
+ io.write_list(TypesAndResults, Separator,
+ (pred((Type - Result)::in, !.IO::di, !:IO::uo) is det :-
+ output_boxed_rval(Info, Type, Result, !IO)),
+ !IO),
+ io.write_string("\n", !IO),
+ indent_line(Indent, !IO),
+ io.write_string("};\n", !IO)
+ ),
+ ExitMethods = set.make_singleton_set(can_return)
+ ;
+ Statement = ml_stmt_do_commit(Ref),
+ indent_line(Indent, !IO),
+ output_rval(Info, Ref, !IO),
+ io.write_string(" = new runtime.Commit();\n", !IO),
+ indent_line(Indent, !IO),
+ io.write_string("throw ", !IO),
+ output_rval(Info, Ref, !IO),
+ io.write_string(";\n", !IO),
+ ExitMethods = set.make_singleton_set(can_throw)
+ ;
+ Statement = ml_stmt_try_commit(_Ref, Stmt, Handler),
+ indent_line(Indent, !IO),
+ io.write_string("try\n", !IO),
+ indent_line(Indent, !IO),
+ io.write_string("{\n", !IO),
+ output_statement(Info, Indent + 1, FuncInfo, Stmt,
+ TryExitMethods0, !IO),
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO),
+ indent_line(Indent, !IO),
+ io.write_string("catch (runtime.Commit commit_variable)\n",
+ !IO),
+ indent_line(Indent, !IO),
+ io.write_string("{\n", !IO),
+ indent_line(Indent + 1, !IO),
+ output_statement(Info, Indent + 1, FuncInfo, Handler,
+ CatchExitMethods, !IO),
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO),
+ ExitMethods = (TryExitMethods0 `set.delete` can_throw)
+ `set.union` CatchExitMethods
+ ;
+ Statement = ml_stmt_atomic(AtomicStatement),
+ output_atomic_stmt(Info, Indent, AtomicStatement, Context, !IO),
+ ExitMethods = set.make_singleton_set(can_fall_through)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Extra code for handling while-loops.
+%
+
+:- func while_exit_methods(mlds_rval, exit_methods) = exit_methods.
+
+while_exit_methods(Cond, BlockExitMethods) = ExitMethods :-
+ % A while statement cannot complete normally if its condition
+ % expression is a constant expression with value true, and it
+ % doesn't contain a reachable break statement that exits the
+ % while statement.
+ (
+ % XXX This is not a sufficient way of testing for a Java
+ % "constant expression", though determining these accurately
+ % is a little difficult to do here.
+ Cond = ml_const(mlconst_true),
+ not set.member(can_break, BlockExitMethods)
+ ->
+ % Cannot complete normally
+ ExitMethods0 = BlockExitMethods `set.delete` can_fall_through
+ ;
+ ExitMethods0 = BlockExitMethods `set.insert` can_fall_through
+ ),
+ ExitMethods = (ExitMethods0 `set.delete` can_continue)
+ `set.delete` can_break.
+
+%-----------------------------------------------------------------------------%
+%
+% Extra code for handling function calls/returns.
+%
+
+:- pred output_boxed_args(csharp_out_info::in, list(mlds_rval)::in,
+ list(mlds_type)::in, io::di, io::uo) is det.
+
+output_boxed_args(_, [], [], !IO).
+output_boxed_args(_, [_ | _], [], !IO) :-
+ unexpected(this_file, "output_boxed_args: length mismatch.").
+output_boxed_args(_, [], [_ | _], !IO) :-
+ unexpected(this_file, "output_boxed_args: length mismatch.").
+output_boxed_args(Info, [CallArg | CallArgs], [CallArgType | CallArgTypes],
+ !IO) :-
+ output_boxed_rval(Info, CallArgType, CallArg, !IO),
+ (
+ CallArgs = []
+ ;
+ CallArgs = [_ | _],
+ io.write_string(", ", !IO),
+ output_boxed_args(Info, CallArgs, CallArgTypes, !IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for handling multiple return values.
+%
+
+% When returning multiple values,
+% we generate the following code:
+% { object [] result = <func>(<args>);
+% <output1> = (<type1>) result[0];
+% <output2> = (<type2>) result[1];
+% ...
+% }
+%
+
+ % This procedure generates the assignments to the outputs.
+ %
+:- pred output_assign_results(csharp_out_info::in, list(mlds_lval)::in,
+ list(mlds_type)::in, int::in, indent::in, mlds_context::in,
+ io::di, io::uo) is det.
+
+output_assign_results(_, [], [], _, _, _, !IO).
+output_assign_results(Info, [Lval | Lvals], [Type | Types], ResultIndex,
+ Indent, Context, !IO) :-
+ indent_line(Info, Context, Indent, !IO),
+ output_lval(Info, Lval, !IO),
+ io.write_string(" = ", !IO),
+ output_unboxed_result(Info, Type, ResultIndex, !IO),
+ io.write_string(";\n", !IO),
+ output_assign_results(Info, Lvals, Types, ResultIndex + 1,
+ Indent, Context, !IO).
+output_assign_results(_, [_ | _], [], _, _, _, _, _) :-
+ unexpected(this_file, "output_assign_results: list length mismatch.").
+output_assign_results(_, [], [_ | _], _, _, _, _, _) :-
+ unexpected(this_file, "output_assign_results: list length mismatch.").
+
+:- pred output_unboxed_result(csharp_out_info::in, mlds_type::in, int::in,
+ io::di, io::uo) is det.
+
+output_unboxed_result(Info, Type, ResultIndex, !IO) :-
+ io.write_string("(", !IO),
+ output_type(Info, Type, !IO),
+ io.write_string(") ", !IO),
+ io.format("result[%d]", [i(ResultIndex)], !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Extra code for outputting switch statements.
+%
+
+:- pred output_switch_cases(csharp_out_info::in, indent::in, func_info::in,
+ mlds_context::in, list(mlds_switch_case)::in, mlds_switch_default::in,
+ exit_methods::out, io::di, io::uo) is det.
+
+output_switch_cases(Info, Indent, FuncInfo, Context,
+ [], Default, ExitMethods, !IO) :-
+ output_switch_default(Info, Indent, FuncInfo, Context, Default,
+ ExitMethods, !IO).
+output_switch_cases(Info, Indent, FuncInfo, Context,
+ [Case | Cases], Default, ExitMethods, !IO) :-
+ output_switch_case(Info, Indent, FuncInfo, Context, Case,
+ CaseExitMethods0, !IO),
+ output_switch_cases(Info, Indent, FuncInfo, Context, Cases, Default,
+ CasesExitMethods, !IO),
+ ( set.member(can_break, CaseExitMethods0) ->
+ CaseExitMethods = (CaseExitMethods0 `set.delete` can_break)
+ `set.insert` can_fall_through
+ ;
+ CaseExitMethods = CaseExitMethods0
+ ),
+ ExitMethods = CaseExitMethods `set.union` CasesExitMethods.
+
+:- pred output_switch_case(csharp_out_info::in, indent::in, func_info::in,
+ mlds_context::in, mlds_switch_case::in, exit_methods::out,
+ io::di, io::uo) is det.
+
+output_switch_case(Info, Indent, FuncInfo, Context, Case, ExitMethods, !IO) :-
+ Case = mlds_switch_case(FirstCond, LaterConds, Statement),
+ output_case_cond(Info, Indent, Context, FirstCond, !IO),
+ list.foldl(output_case_cond(Info, Indent, Context), LaterConds, !IO),
+ output_statement(Info, Indent + 1, FuncInfo, Statement,
+ StmtExitMethods, !IO),
+ ( set.member(can_fall_through, StmtExitMethods) ->
+ indent_line(Info, Context, Indent + 1, !IO),
+ io.write_string("break;\n", !IO),
+ ExitMethods = (StmtExitMethods `set.insert` can_break)
+ `set.delete` can_fall_through
+ ;
+ % Don't output `break' since it would be unreachable.
+ ExitMethods = StmtExitMethods
+ ).
+
+:- pred output_case_cond(csharp_out_info::in, indent::in, mlds_context::in,
+ mlds_case_match_cond::in, io::di, io::uo) is det.
+
+output_case_cond(Info, Indent, Context, Match, !IO) :-
+ (
+ Match = match_value(Val),
+ indent_line(Info, Context, Indent, !IO),
+ io.write_string("case ", !IO),
+ output_rval(Info, Val, !IO),
+ io.write_string(":\n", !IO)
+ ;
+ Match = match_range(_, _),
+ unexpected(this_file,
+ "output_case_cond: cannot match ranges in C# cases")
+ ).
+
+:- pred output_switch_default(csharp_out_info::in, indent::in, func_info::in,
+ mlds_context::in, mlds_switch_default::in, exit_methods::out,
+ io::di, io::uo) is det.
+
+output_switch_default(Info, Indent, FuncInfo, Context, Default,
+ ExitMethods, !IO) :-
+ (
+ Default = default_do_nothing,
+ ExitMethods = set.make_singleton_set(can_fall_through)
+ ;
+ Default = default_case(Statement),
+ indent_line(Info, Context, Indent, !IO),
+ io.write_string("default:\n", !IO),
+ output_statement(Info, Indent + 1, FuncInfo, Statement, ExitMethods,
+ !IO),
+ indent_line(Info, Context, Indent, !IO),
+ io.write_string("break;\n", !IO)
+ ;
+ Default = default_is_unreachable,
+ indent_line(Info, Context, Indent, !IO),
+ io.write_string("default: /*NOTREACHED*/\n", !IO),
+ indent_line(Info, Context, Indent + 1, !IO),
+ io.write_string("throw new runtime.UnreachableDefault();\n",
+ !IO),
+ ExitMethods = set.make_singleton_set(can_throw)
+ ).
+
+%-----------------------------------------------------------------------------%
+%
+% Code for outputting atomic statements.
+%
+
+:- pred output_atomic_stmt(csharp_out_info::in, indent::in,
+ mlds_atomic_statement::in, mlds_context::in, io::di, io::uo) is det.
+
+output_atomic_stmt(Info, Indent, AtomicStmt, Context, !IO) :-
+ (
+ AtomicStmt = comment(Comment),
+ % XXX We should escape any "*/"'s in the Comment. We should also split
+ % the comment into lines and indent each line appropriately.
+ indent_line(Indent, !IO),
+ io.write_string("/* ", !IO),
+ io.write_string(Comment, !IO),
+ io.write_string(" */\n", !IO)
+ ;
+ AtomicStmt = assign(Lval, Rval),
+ indent_line(Indent, !IO),
+ output_lval(Info, Lval, !IO),
+ io.write_string(" = ", !IO),
+ output_rval(Info, Rval, !IO),
+ io.write_string(";\n", !IO)
+ ;
+ AtomicStmt = assign_if_in_heap(_, _),
+ sorry(this_file, "output_atomic_stmt: assign_if_in_heap")
+ ;
+ AtomicStmt = delete_object(_Lval),
+ unexpected(this_file, "delete_object not supported in C#.")
+ ;
+ AtomicStmt = new_object(Target, _MaybeTag, ExplicitSecTag, Type,
+ _MaybeSize, MaybeCtorName, Args, ArgTypes, _MayUseAtomic),
+ (
+ ExplicitSecTag = yes,
+ unexpected(this_file, "output_atomic_stmt: explicit secondary tag")
+ ;
+ ExplicitSecTag = no
+ ),
+
+ indent_line(Indent, !IO),
+ io.write_string("{\n", !IO),
+ indent_line(Info, Context, Indent + 1, !IO),
+ output_lval(Info, Target, !IO),
+ io.write_string(" = new ", !IO),
+ % Generate class constructor name.
+ (
+ MaybeCtorName = yes(QualifiedCtorId),
+ \+ (
+ Type = mercury_type(MerType, CtorCat, _),
+ hand_defined_type(MerType, CtorCat, _, _)
+ )
+ ->
+ output_type(Info, Type, !IO),
+ io.write_char('.', !IO),
+ QualifiedCtorId = qual(_ModuleName, _QualKind, CtorDefn),
+ CtorDefn = ctor_id(CtorName, CtorArity),
+ output_unqual_class_name(CtorName, CtorArity, !IO)
+ ;
+ output_type(Info, Type, !IO)
+ ),
+ IsArray = type_is_array(Type),
+ (
+ IsArray = is_array,
+ % The new object will be an array, so we need to initialise it
+ % using array literals syntax.
+ io.write_string(" {", !IO),
+ output_init_args(Info, Args, ArgTypes, !IO),
+ io.write_string("};\n", !IO)
+ ;
+ IsArray = not_array,
+ % Generate constructor arguments.
+ io.write_string("(", !IO),
+ output_init_args(Info, Args, ArgTypes, !IO),
+ io.write_string(");\n", !IO)
+ ),
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO)
+ ;
+ AtomicStmt = gc_check,
+ unexpected(this_file, "gc_check not implemented.")
+ ;
+ AtomicStmt = mark_hp(_Lval),
+ unexpected(this_file, "mark_hp not implemented.")
+ ;
+ AtomicStmt = restore_hp(_Rval),
+ unexpected(this_file, "restore_hp not implemented.")
+ ;
+ AtomicStmt = trail_op(_TrailOp),
+ unexpected(this_file, "trail_ops not implemented.")
+ ;
+ AtomicStmt = inline_target_code(TargetLang, Components),
+ (
+ TargetLang = ml_target_csharp,
+ indent_line(Indent, !IO),
+ list.foldl(output_target_code_component(Info), Components, !IO)
+ ;
+ ( TargetLang = ml_target_c
+ ; TargetLang = ml_target_gnu_c
+ ; TargetLang = ml_target_asm
+ ; TargetLang = ml_target_il
+ ; TargetLang = ml_target_java
+ ),
+ unexpected(this_file,
+ "inline_target_code only works for lang_java")
+ )
+ ;
+ AtomicStmt = outline_foreign_proc(_TargetLang, _Vs, _Lvals, _Code),
+ unexpected(this_file, "foreign language interfacing not implemented")
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_target_code_component(csharp_out_info::in,
+ target_code_component::in, io::di, io::uo) is det.
+
+output_target_code_component(Info, TargetCode, !IO) :-
+ (
+ TargetCode = user_target_code(CodeString, MaybeUserContext, _Attrs),
+ (
+ MaybeUserContext = yes(ProgContext),
+ output_context(Info, mlds_make_context(ProgContext), !IO)
+ ;
+ MaybeUserContext = no
+ ),
+ io.write_string(CodeString, !IO)
+ ;
+ TargetCode = raw_target_code(CodeString, _Attrs),
+ io.write_string(CodeString, !IO)
+ ;
+ TargetCode = target_code_input(Rval),
+ output_rval(Info, Rval, !IO)
+ ;
+ TargetCode = target_code_output(Lval),
+ output_lval(Info, Lval, !IO)
+ ;
+ TargetCode = target_code_type(Type),
+ % XXX enable generics here
+ output_type(Info, Type, !IO)
+ ;
+ TargetCode = target_code_name(Name),
+ output_maybe_qualified_name(Info, Name, !IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+ % Output initial values of an object's fields as arguments for the
+ % object's class constructor.
+ %
+:- pred output_init_args(csharp_out_info::in, list(mlds_rval)::in,
+ list(mlds_type)::in, io::di, io::uo) is det.
+
+output_init_args(_, [], [], !IO).
+output_init_args(_, [_ | _], [], _, _) :-
+ unexpected(this_file, "output_init_args: length mismatch.").
+output_init_args(_, [], [_ | _], _, _) :-
+ unexpected(this_file, "output_init_args: length mismatch.").
+output_init_args(Info, [Arg | Args], [_ArgType | ArgTypes], !IO) :-
+ output_rval(Info, Arg, !IO),
+ (
+ Args = []
+ ;
+ Args = [_ | _],
+ io.write_string(", ", !IO)
+ ),
+ output_init_args(Info, Args, ArgTypes, !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Code to output expressions.
+%
+
+:- pred output_lval(csharp_out_info::in, mlds_lval::in, io::di, io::uo) is det.
+
+output_lval(Info, Lval, !IO) :-
+ (
+ Lval = ml_field(_MaybeTag, PtrRval, FieldId, FieldType, _),
+ (
+ FieldId = ml_field_offset(OffsetRval),
+ (
+ ( FieldType = mlds_generic_type
+ ; FieldType = mercury_type(type_variable(_, _), _, _)
+ )
+ ->
+ true
+ ;
+ % The field type for field(_, _, offset(_), _, _) lvals
+ % must be something that maps to MR_Box.
+ unexpected(this_file, "unexpected field type.")
+ ),
+ % XXX We shouldn't need this cast here, but there are cases where
+ % it is needed and the MLDS doesn't seem to generate it.
+ io.write_string("((object[]) ", !IO),
+ output_rval(Info, PtrRval, !IO),
+ io.write_string(")[", !IO),
+ output_rval(Info, OffsetRval, !IO),
+ io.write_string("]", !IO)
+ ;
+ FieldId = ml_field_named(FieldName, CtorType),
+ (
+ FieldName = qual(_, _, UnqualFieldName),
+ UnqualFieldName = "data_tag"
+ ->
+ % If the field we are trying to access is just a `data_tag'
+ % then it is a member of the base class.
+ output_bracketed_rval(Info, PtrRval, !IO),
+ io.write_string(".", !IO)
+ ;
+ PtrRval = ml_self(_)
+ ->
+ % Suppress type cast on `this' keyword. This makes a
+ % difference when assigning to `final' member variables in
+ % constructor functions.
+ output_rval(Info, PtrRval, !IO),
+ io.write_string(".", !IO)
+ ;
+ % Otherwise the field we are trying to access may be
+ % in a derived class. Objects are manipulated as instances
+ % of their base class, so we need to downcast to the derived
+ % class to access some fields.
+ io.write_string("((", !IO),
+ output_type(Info, CtorType, !IO),
+ io.write_string(") ", !IO),
+ output_bracketed_rval(Info, PtrRval, !IO),
+ io.write_string(").", !IO)
+ ),
+ FieldName = qual(_, _, UnqualFieldName),
+ output_valid_mangled_name(UnqualFieldName, !IO)
+ )
+ ;
+ Lval = ml_mem_ref(Rval, _Type),
+ output_bracketed_rval(Info, Rval, !IO)
+ ;
+ Lval = ml_global_var_ref(GlobalVarRef),
+ GlobalVarRef = env_var_ref(EnvVarName),
+ io.write_string("mercury_envvar_", !IO),
+ io.write_string(EnvVarName, !IO)
+ ;
+ Lval = ml_var(qual(ModName, QualKind, Name), _),
+ % Rewrite references to constants in private_builtin.m to the
+ % mercury_dotnet.cs file.
+ Name = mlds_var_name(NameStr, _),
+ (
+ SymName = mlds_module_name_to_sym_name(ModName),
+ strip_outermost_qualifier(SymName, "mercury",
+ mercury_private_builtin_module)
+ ->
+ ( string.prefix(NameStr, "MR_TYPECTOR_REP_") ->
+ io.write_string("runtime.TypeCtorRep.", !IO),
+ io.write_string(NameStr, !IO)
+ ; string.prefix(NameStr, "MR_SECTAG_") ->
+ io.write_string("runtime.Sectag_Locn.", !IO),
+ io.write_string(NameStr, !IO)
+ ; NameStr = "MR_PREDICATE" ->
+ io.write_string("runtime.Constants.MR_PREDICATE", !IO)
+ ; NameStr = "MR_FUNCTION" ->
+ io.write_string("runtime.Constants.MR_FUNCTION", !IO)
+ ;
+ QualName = qual(ModName, QualKind,
+ entity_data(mlds_data_var(Name))),
+ output_maybe_qualified_name(Info, QualName, !IO)
+ )
+ ;
+ QualName = qual(ModName, QualKind,
+ entity_data(mlds_data_var(Name))),
+ output_maybe_qualified_name(Info, QualName, !IO)
+ )
+ ).
+
+:- pred output_mangled_name(string::in, io::di, io::uo) is det.
+
+output_mangled_name(Name, !IO) :-
+ MangledName = name_mangle(Name),
+ io.write_string(MangledName, !IO).
+
+:- pred output_valid_mangled_name(string::in, io::di, io::uo) is det.
+
+output_valid_mangled_name(Name, !IO) :-
+ MangledName = name_mangle(Name),
+ JavaSafeName = valid_csharp_symbol_name(MangledName),
+ io.write_string(JavaSafeName, !IO).
+
+:- pred output_call_rval(csharp_out_info::in, mlds_rval::in, io::di, io::uo)
+ is det.
+
+output_call_rval(Info, Rval, !IO) :-
+ (
+ Rval = ml_const(Const),
+ Const = mlconst_code_addr(CodeAddr)
+ ->
+ IsCall = yes,
+ mlds_output_code_addr(Info, CodeAddr, IsCall, !IO)
+ ;
+ output_bracketed_rval(Info, Rval, !IO)
+ ).
+
+:- pred output_bracketed_rval(csharp_out_info::in, mlds_rval::in, io::di, io::uo)
+ is det.
+
+output_bracketed_rval(Info, Rval, !IO) :-
+ (
+ % If it's just a variable name, then we don't need parentheses.
+ ( Rval = ml_lval(ml_var(_,_))
+ ; Rval = ml_const(mlconst_code_addr(_))
+ )
+ ->
+ output_rval(Info, Rval, !IO)
+ ;
+ io.write_char('(', !IO),
+ output_rval(Info, Rval, !IO),
+ io.write_char(')', !IO)
+ ).
+
+:- pred output_rval(csharp_out_info::in, mlds_rval::in, io::di, io::uo) is det.
+
+output_rval(Info, Rval, !IO) :-
+ (
+ Rval = ml_lval(Lval),
+ output_lval(Info, Lval, !IO)
+ ;
+ Rval = ml_mkword(_, _),
+ unexpected(this_file, "output_rval: tags not supported in C#")
+ ;
+ Rval = ml_const(Const),
+ output_rval_const(Info, Const, !IO)
+ ;
+ Rval = ml_unop(Op, RvalA),
+ output_unop(Info, Op, RvalA, !IO)
+ ;
+ Rval = ml_binop(Op, RvalA, RvalB),
+ output_binop(Info, Op, RvalA, RvalB, !IO)
+ ;
+ Rval = ml_mem_addr(_Lval),
+ unexpected(this_file, "output_rval: mem_addr(_) not supported")
+ ;
+ Rval = ml_scalar_common(_),
+ % This reference is not the same as a mlds_data_addr const.
+ unexpected(this_file, "output_rval: ml_scalar_common")
+ ;
+ Rval = ml_vector_common_row(VectorCommon, RowRval),
+ output_vector_common_row_rval(Info, VectorCommon, RowRval, !IO)
+ ;
+ Rval = ml_self(_),
+ io.write_string("this", !IO)
+ ).
+
+:- pred output_unop(csharp_out_info::in, mlds_unary_op::in, mlds_rval::in,
+ io::di, io::uo) is det.
+
+output_unop(Info, Unop, Expr, !IO) :-
+ (
+ Unop = cast(Type),
+ output_cast_rval(Info, Type, Expr, !IO)
+ ;
+ Unop = box(Type),
+ output_boxed_rval(Info, Type, Expr, !IO)
+ ;
+ Unop = unbox(Type),
+ output_unboxed_rval(Info, Type, Expr, !IO)
+ ;
+ Unop = std_unop(StdUnop),
+ output_std_unop(Info, StdUnop, Expr, !IO)
+ ).
+
+:- pred output_cast_rval(csharp_out_info::in, mlds_type::in, mlds_rval::in,
+ io::di, io::uo) is det.
+
+output_cast_rval(Info, Type, Expr, !IO) :-
+ % rtti_to_mlds.m generates casts from int to runtime.PseudoTypeInfo, but
+ % for C# we need to treat these as constructions, not casts.
+ % Similarly for conversions from TypeCtorInfo to TypeInfo.
+ (
+ Type = mlds_pseudo_type_info_type,
+ Expr = ml_const(mlconst_int(N))
+ ->
+ maybe_output_comment(Info, "cast", !IO),
+ ( have_preallocated_pseudo_type_var(N) ->
+ io.write_string("runtime.PseudoTypeInfo.K", !IO),
+ io.write_int(N, !IO)
+ ;
+ io.write_string("new runtime.PseudoTypeInfo(", !IO),
+ output_rval(Info, Expr, !IO),
+ io.write_string(")", !IO)
+ )
+ ;
+ ( Type = mercury_type(_, ctor_cat_system(cat_system_type_info), _)
+ ; Type = mlds_type_info_type
+ )
+ ->
+ % XXX We really should be able to tell if we are casting a
+ % TypeCtorInfo or a TypeInfo. Julien says that's probably going to
+ % be rather difficult as the compiler doesn't keep track of where
+ % type_ctor_infos are acting as type_infos properly.
+ maybe_output_comment(Info, "cast", !IO),
+ io.write_string("runtime.TypeInfo_Struct.maybe_new(",
+ !IO),
+ output_rval(Info, Expr, !IO),
+ io.write_string(")", !IO)
+ ;
+ csharp_builtin_type(Type, "int")
+ ->
+ io.write_string("(int) ", !IO),
+ output_rval(Info, Expr, !IO)
+ ;
+ io.write_string("(", !IO),
+ output_type(Info, Type, !IO),
+ io.write_string(") ", !IO),
+ output_rval(Info, Expr, !IO)
+ ).
+
+:- pred have_preallocated_pseudo_type_var(int::in) is semidet.
+
+have_preallocated_pseudo_type_var(N) :-
+ % Corresponds to static members in class PseudoTypeInfo.
+ N >= 1,
+ N =< 5.
+
+:- pred output_boxed_rval(csharp_out_info::in, mlds_type::in, mlds_rval::in,
+ io::di, io::uo) is det.
+
+output_boxed_rval(Info, _Type, Expr, !IO) :-
+ % C# does implicit boxing.
+ output_rval(Info, Expr, !IO).
+ /*
+ ( csharp_builtin_type(Type, _JavaName, JavaBoxedName, _) ->
+ % valueOf may return cached instances instead of creating new objects.
+ io.write_string(JavaBoxedName, !IO),
+ io.write_string(".valueOf(", !IO),
+ output_rval(Info, Expr, !IO),
+ io.write_string(")", !IO)
+ ;
+ io.write_string("((object) (", !IO),
+ output_rval(Info, Expr, !IO),
+ io.write_string("))", !IO)
+ ).
+ */
+
+:- pred output_unboxed_rval(csharp_out_info::in, mlds_type::in, mlds_rval::in,
+ io::di, io::uo) is det.
+
+output_unboxed_rval(Info, Type, Expr, !IO) :-
+ io.write_string("((", !IO),
+ output_type(Info, Type, !IO),
+ io.write_string(") ", !IO),
+ output_rval(Info, Expr, !IO),
+ io.write_string(")", !IO).
+
+:- pred csharp_builtin_type(mlds_type::in, string::out) is semidet.
+
+csharp_builtin_type(Type, "int") :-
+ Type = mlds_native_int_type.
+csharp_builtin_type(Type, "int") :-
+ Type = mercury_type(builtin_type(builtin_type_int), _, _).
+csharp_builtin_type(Type, "double") :-
+ Type = mlds_native_float_type.
+csharp_builtin_type(Type, "double") :-
+ Type = mercury_type(builtin_type(builtin_type_float), _, _).
+csharp_builtin_type(Type, "char") :-
+ Type = mlds_native_char_type.
+csharp_builtin_type(Type, "char") :-
+ Type = mercury_type(builtin_type(builtin_type_char), _, _).
+csharp_builtin_type(Type, "bool") :-
+ Type = mlds_native_bool_type.
+csharp_builtin_type(Type, "int") :-
+ % The test for defined/3 is logically redundant since all dummy
+ % types are defined types, but enables the compiler to infer that
+ % this disjunction is a switch.
+ Type = mercury_type(defined_type(_, _, _), TypeCtorCat, _),
+ TypeCtorCat = ctor_cat_builtin_dummy.
+
+:- pred output_std_unop(csharp_out_info::in, builtin_ops.unary_op::in,
+ mlds_rval::in, io::di, io::uo) is det.
+
+ % There are no tags, so all the tagging operators are no-ops, except for
+ % `tag', which always returns zero (a tag of zero means there's no tag).
+ %
+output_std_unop(Info, UnaryOp, Expr, !IO) :-
+ ( UnaryOp = tag ->
+ io.write_string("/* tag */ 0", !IO)
+ ;
+ % XXX C# is not Java
+ java_util.java_unary_prefix_op(UnaryOp, UnaryOpString),
+ io.write_string(UnaryOpString, !IO),
+ io.write_string("(", !IO),
+ output_rval(Info, Expr, !IO),
+ io.write_string(")", !IO)
+ ).
+
+:- pred output_binop(csharp_out_info::in, binary_op::in, mlds_rval::in,
+ mlds_rval::in, io::di, io::uo) is det.
+
+output_binop(Info, Op, X, Y, !IO) :-
+ ( Op = array_index(_Type) ->
+ output_bracketed_rval(Info, X, !IO),
+ io.write_string("[", !IO),
+ output_rval(Info, Y, !IO),
+ io.write_string("]", !IO)
+ % XXX C# is not Java
+ ; java_util.java_string_compare_op(Op, OpStr) ->
+ ( OpStr = "==" ->
+ output_rval(Info, X, !IO),
+ io.write_string(".Equals(", !IO),
+ output_rval(Info, Y, !IO),
+ io.write_string(")", !IO)
+ ;
+ io.write_string("(", !IO),
+ output_rval(Info, X, !IO),
+ io.write_string(".CompareTo(", !IO),
+ output_rval(Info, Y, !IO),
+ io.write_string(") ", !IO),
+ io.write_string(OpStr, !IO),
+ io.write_string(" 0)", !IO)
+ )
+ ;
+ io.write_string("(", !IO),
+ output_rval(Info, X, !IO),
+ io.write_string(" ", !IO),
+ output_binary_op(Op, !IO),
+ io.write_string(" ", !IO),
+ output_rval(Info, Y, !IO),
+ io.write_string(")", !IO)
+ ).
+
+:- pred output_binary_op(binary_op::in, io::di, io::uo) is det.
+
+output_binary_op(Op, !IO) :-
+ % XXX why are these separated into three predicates?
+ % XXX C# is not Java
+ ( java_util.java_binary_infix_op(Op, OpStr) ->
+ io.write_string(OpStr, !IO)
+ ; java_util.java_float_compare_op(Op, OpStr) ->
+ io.write_string(OpStr, !IO)
+ ; java_util.java_float_op(Op, OpStr) ->
+ io.write_string(OpStr, !IO)
+ ;
+ unexpected(this_file, "output_binary_op: invalid binary operator")
+ ).
+
+:- pred output_rval_const(csharp_out_info::in, mlds_rval_const::in,
+ io::di, io::uo) is det.
+
+output_rval_const(Info, Const, !IO) :-
+ (
+ Const = mlconst_true,
+ io.write_string("true", !IO)
+ ;
+ Const = mlconst_false,
+ io.write_string("false", !IO)
+ ;
+ Const = mlconst_int(N),
+ output_int_const(N, !IO)
+ ;
+ Const = mlconst_char(N),
+ io.write_string("((char) ", !IO),
+ output_int_const(N, !IO),
+ io.write_string(")", !IO)
+ ;
+ Const = mlconst_enum(N, EnumType),
+ % Explicit cast required.
+ output_cast_rval(Info, EnumType, ml_const(mlconst_int(N)), !IO)
+ ;
+ Const = mlconst_foreign(Lang, Value, _Type),
+ expect(unify(Lang, lang_csharp), this_file,
+ "output_rval_const: language other than C#."),
+ % XXX Should we parenthesize this?
+ io.write_string(Value, !IO)
+ ;
+ Const = mlconst_float(FloatVal),
+ c_util.output_float_literal(FloatVal, !IO)
+ ;
+ Const = mlconst_string(String),
+ io.write_string("""", !IO),
+ c_util.output_quoted_string_lang(literal_csharp, String, !IO),
+ io.write_string("""", !IO)
+ ;
+ Const = mlconst_multi_string(String),
+ io.write_string("""", !IO),
+ c_util.output_quoted_multi_string_lang(literal_csharp, String, !IO),
+ io.write_string("""", !IO)
+ ;
+ Const = mlconst_named_const(NamedConst),
+ io.write_string(NamedConst, !IO)
+ ;
+ Const = mlconst_code_addr(CodeAddr),
+ IsCall = no,
+ mlds_output_code_addr(Info, CodeAddr, IsCall, !IO)
+ ;
+ Const = mlconst_data_addr(DataAddr),
+ mlds_output_data_addr(DataAddr, !IO)
+ ;
+ Const = mlconst_null(Type),
+ Initializer = get_type_initializer(Type),
+ io.write_string(Initializer, !IO)
+ ).
+
+:- pred output_int_const(int::in, io::di, io::uo) is det.
+
+output_int_const(N, !IO) :-
+ % The Mercury compiler could be using 64-bit integers but Java has 32-bit
+ % ints. A literal 0xffffffff in a source file would be interpreted by a
+ % 64-bit Mercury compiler as 4294967295. If it is written out in decimal a
+ % Java compiler would rightly complain because the integer is too large to
+ % fit in a 32-bit int. However, it won't complain if the literal is
+ % expressed in hexadecimal (nor as the negative decimal -1).
+ % XXX check this for C#
+ ( N < 0 ->
+ io.write_int(N, !IO)
+ ;
+ N >> 32 = 0,
+ N /\ 0x80000000 = 0x80000000
+ ->
+ % The bit pattern fits in 32 bits, but is too large to write as a
+ % positive decimal. This branch is unreachable on a 32-bit compiler.
+ io.format("0x%x", [i(N /\ 0xffffffff)], !IO)
+ ;
+ io.write_int(N, !IO)
+ ).
+
+:- pred output_vector_common_row_rval(csharp_out_info::in,
+ mlds_vector_common::in, mlds_rval::in, io::di, io::uo) is det.
+
+output_vector_common_row_rval(Info, VectorCommon, RowRval, !IO) :-
+ VectorCommon = ml_vector_common(_ModuleName, _Type,
+ ml_vector_common_type_num(TypeNum), StartRowNum, _NumRows),
+ io.format("MR_vector_common_%d[%d + ", [i(TypeNum), i(StartRowNum)], !IO),
+ output_rval(Info, RowRval, !IO),
+ io.write_string("]", !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred mlds_output_code_addr(csharp_out_info::in, mlds_code_addr::in, bool::in,
+ io::di, io::uo) is det.
+
+mlds_output_code_addr(Info, CodeAddr, IsCall, !IO) :-
+ ( CodeAddr = code_addr_proc(_, Sig)
+ ; CodeAddr = code_addr_internal(_, _, Sig)
+ ),
+ Sig = mlds_func_signature(ArgTypes, RetTypes),
+ (
+ IsCall = no,
+ % Not a function call, so we are taking the address of the
+ % wrapper for that function (method).
+ TypeString = method_ptr_type_to_string(Info, ArgTypes, RetTypes),
+ io.format("(%s) ", [s(TypeString)], !IO)
+ ;
+ IsCall = yes
+ ),
+ (
+ CodeAddr = code_addr_proc(Label, _Sig),
+ output_fully_qualified_thing(Label, mlds_output_proc_label, !IO)
+ ;
+ CodeAddr = code_addr_internal(Label, SeqNum, _Sig),
+ output_fully_qualified_thing(Label, mlds_output_proc_label, !IO),
+ io.write_string("_", !IO),
+ io.write_int(SeqNum, !IO)
+ ).
+
+:- func method_ptr_type_to_string(csharp_out_info, mlds_arg_types,
+ mlds_return_types) = string.
+
+method_ptr_type_to_string(Info, ArgTypes, RetTypes) = String :-
+ Arity = list.length(ArgTypes),
+ (
+ RetTypes = [],
+ VoidRet = "_r0",
+ RetTypesStrings = []
+ ;
+ RetTypes = [R1 | Rs],
+ VoidRet = "",
+ (
+ Rs = [],
+ boxed_type_to_string(Info, R1, R1_string),
+ RetTypesStrings = [R1_string]
+ ;
+ Rs = [_ | _],
+ RetTypesStrings = ["object[]"] % for now
+ )
+ ),
+ list.map(boxed_type_to_string(Info), ArgTypes, ArgTypesStrings),
+ TypesString = string.join_list(", ", ArgTypesStrings ++ RetTypesStrings),
+ String = "runtime.MethodPtr" ++ string.from_int(Arity) ++
+ VoidRet ++ "<" ++ TypesString ++ ">".
+
+:- pred mlds_output_proc_label(mlds_proc_label::in, io::di, io::uo) is det.
+
+mlds_output_proc_label(mlds_proc_label(PredLabel, ProcId), !IO) :-
+ output_pred_label(PredLabel, !IO),
+ proc_id_to_int(ProcId, ModeNum),
+ io.format("_%d", [i(ModeNum)], !IO).
+
+:- pred mlds_output_data_addr(mlds_data_addr::in, io::di, io::uo) is det.
+
+mlds_output_data_addr(data_addr(ModuleQualifier, DataName), !IO) :-
+ SymName = mlds_module_name_to_sym_name(ModuleQualifier),
+ % XXX could use global::mercury. instead of stripping it
+ ( strip_outermost_qualifier(SymName, "mercury", StrippedSymName) ->
+ mangle_sym_name_for_csharp(StrippedSymName, module_qual, "__",
+ ModuleName)
+ ;
+ mangle_sym_name_for_csharp(SymName, module_qual, "__", ModuleName)
+ ),
+ io.write_string(ModuleName, !IO),
+ io.write_string(".", !IO),
+ output_data_name(DataName, !IO).
+
+%-----------------------------------------------------------------------------%
+%
+% Miscellaneous stuff to handle indentation and generation of
+% source context annotations.
+%
+
+:- mutable(last_context, prog_context, context_init, ground,
+ [untrailed, attach_to_io_state]).
+
+:- pred output_context(csharp_out_info::in, mlds_context::in,
+ io::di, io::uo) is det.
+
+output_context(Info, Context, !IO) :-
+ LineNumbers = Info ^ oi_line_numbers,
+ (
+ LineNumbers = yes,
+ ProgContext = mlds_get_prog_context(Context),
+ get_last_context(LastContext, !IO),
+ term.context_file(ProgContext, File),
+ term.context_line(ProgContext, Line),
+ (
+ ProgContext \= LastContext,
+ Line > 0,
+ File \= ""
+ ->
+ % Java doesn't have an equivalent of #line directives.
+ % \u is treated as a Unicode escape even with comments.
+ % XXX update for C#
+ io.write_string("// ", !IO),
+ string.replace_all(File, "\\u", "\\\\u", SafePath),
+ io.write_string(SafePath, !IO),
+ io.write_string(":", !IO),
+ io.write_int(Line, !IO),
+ io.nl(!IO),
+ set_last_context(ProgContext, !IO)
+ ;
+ true
+ )
+ ;
+ LineNumbers = no
+ ).
+
+:- pred indent_line(csharp_out_info::in, mlds_context::in, indent::in,
+ io::di, io::uo) is det.
+
+indent_line(Info, Context, N, !IO) :-
+ output_context(Info, Context, !IO),
+ indent_line(N, !IO).
+
+ % A value of type `indent' records the number of levels of indentation
+ % to indent the next piece of code. Currently we output two spaces
+ % for each level of indentation.
+ % XXX There is a small amount of code duplication with mlds_to_c.m here.
+:- type indent == int.
+
+:- pred indent_line(indent::in, io::di, io::uo) is det.
+
+indent_line(N, !IO) :-
+ ( N =< 0 ->
+ true
+ ;
+ io.write_string(" ", !IO),
+ indent_line(N - 1, !IO)
+ ).
+
+%-----------------------------------------------------------------------------%
+
+:- type csharp_out_info
+ ---> csharp_out_info(
+ % These are static.
+ oi_module_info :: module_info,
+ oi_auto_comments :: bool,
+ oi_line_numbers :: bool,
+ oi_module_name :: mlds_module_name,
+
+ % These are dynamic.
+ oi_output_generics :: output_generics,
+ oi_univ_tvars :: list(tvar)
+ ).
+
+:- type output_generics
+ ---> do_output_generics
+ ; do_not_output_generics.
+
+:- func init_csharp_out_info(module_info) = csharp_out_info.
+
+init_csharp_out_info(ModuleInfo) = Info :-
+ module_info_get_globals(ModuleInfo, Globals),
+ globals.lookup_bool_option(Globals, auto_comments, AutoComments),
+ globals.lookup_bool_option(Globals, line_numbers, LineNumbers),
+ module_info_get_name(ModuleInfo, ModuleName),
+ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
+ Info = csharp_out_info(ModuleInfo, AutoComments, LineNumbers,
+ MLDS_ModuleName, do_not_output_generics, []).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+
+this_file = "mlds_to_cs.m".
+
+%-----------------------------------------------------------------------------%
diff --git a/compiler/mlds_to_il.m b/compiler/mlds_to_il.m
index 157154e..45d8c10 100644
--- a/compiler/mlds_to_il.m
+++ b/compiler/mlds_to_il.m
@@ -1988,6 +1988,9 @@ atomic_statement_to_il(inline_target_code(ml_target_il, Code), Instrs,
atomic_statement_to_il(inline_target_code(ml_target_c, _Code), _Instrs,
!Info) :-
unexpected(this_file, "ml_target_c").
+atomic_statement_to_il(inline_target_code(ml_target_csharp, _Code), _Instrs,
+ !Info) :-
+ unexpected(this_file, "ml_target_csharp").
atomic_statement_to_il(inline_target_code(ml_target_java, _Code), _Instrs,
!Info) :-
unexpected(this_file, "ml_target_java").
@@ -3168,6 +3171,9 @@ mlds_type_to_ilds_type(_, mlds_foreign_type(ForeignType))
ForeignType = java(_),
unexpected(this_file, "java foreign type")
;
+ ForeignType = csharp(_),
+ unexpected(this_file, "csharp foreign type")
+ ;
ForeignType = erlang(_),
unexpected(this_file, "erlang foreign type")
).
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index 95abf7a..415159a 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -1079,7 +1079,7 @@ generate_addr_wrapper_class(MLDS_ModuleName, Arity - CodeAddrs, ClassDefn,
InterfaceName = "MethodPtrN"
),
InterfaceModuleName = mercury_module_name_to_mlds(
- mercury_runtime_package_name),
+ java_mercury_runtime_package_name),
Interface = qual(InterfaceModuleName, module_qual, InterfaceName),
% Create class components.
@@ -1693,6 +1693,7 @@ rename_class_names_atomic(Renaming, !Statement) :-
; Lang = ml_target_gnu_c
; Lang = ml_target_asm
; Lang = ml_target_il
+ ; Lang = ml_target_csharp
)
)
;
@@ -3189,7 +3190,7 @@ remove_sym_name_prefixes(SymName0, Prefix, SymName) :-
unexpected(this_file, "remove_sym_name_prefixes: prefix not found")
).
-:- func convert_qual_kind(mlds_qual_kind) = java_qual_kind.
+:- func convert_qual_kind(mlds_qual_kind) = csj_qual_kind.
convert_qual_kind(module_qual) = module_qual.
convert_qual_kind(type_qual) = type_qual.
@@ -3222,7 +3223,7 @@ qual_class_name_to_string(QualName, Arity, String) :-
QualName = qual(MLDS_ModuleName, QualKind, ClassName),
(
SymName = mlds_module_name_to_sym_name(MLDS_ModuleName),
- SymName = mercury_runtime_package_name
+ SymName = java_mercury_runtime_package_name
->
% Don't mangle runtime class names.
String = "jmercury.runtime." ++ ClassName
@@ -3440,6 +3441,9 @@ type_to_string(Info, MLDS_Type, String, ArrayDims) :-
ForeignType = il(_),
unexpected(this_file, "output_type: il foreign_type")
;
+ ForeignType = csharp(_),
+ unexpected(this_file, "output_type: csharp foreign_type")
+ ;
ForeignType = erlang(_),
unexpected(this_file, "output_type: erlang foreign_type")
)
@@ -4507,6 +4511,7 @@ output_atomic_stmt(Info, Indent, AtomicStmt, Context, !IO) :-
; TargetLang = ml_target_gnu_c
; TargetLang = ml_target_asm
; TargetLang = ml_target_il
+ ; TargetLang = ml_target_csharp
),
unexpected(this_file,
"inline_target_code only works for lang_java")
diff --git a/compiler/modules.m b/compiler/modules.m
index c973be1..8d615db 100644
--- a/compiler/modules.m
+++ b/compiler/modules.m
@@ -2603,6 +2603,7 @@ generate_dependencies_write_d_files(Globals, [Dep | Deps],
( Target = target_c, Lang = lang_c
; Target = target_asm, Lang = lang_c
; Target = target_java, Lang = lang_java
+ ; Target = target_csharp, Lang = lang_csharp
; Target = target_il, Lang = lang_il
; Target = target_x86_64, Lang = lang_c
; Target = target_erlang, Lang = lang_erlang
diff --git a/compiler/options.m b/compiler/options.m
index 9f3147b..20abf4f 100644
--- a/compiler/options.m
+++ b/compiler/options.m
@@ -292,6 +292,8 @@
; compile_to_c % target c + target_code_only
; java % target java
; java_only % target java + target_code_only
+ ; csharp % target csharp
+ ; csharp_only % target csharp + target_code_only
% XXX The following options need to be documented.
; x86_64 % target x86_64
; x86_64_only % target x86_64 + target_code_only
@@ -1209,6 +1211,8 @@ option_defaults_2(compilation_model_option, [
il - special,
il_only - special,
compile_to_c - special,
+ csharp - special,
+ csharp_only - special,
java - special,
java_only - special,
x86_64 - special,
@@ -2061,6 +2065,10 @@ long_option("java", java).
long_option("Java", java).
long_option("java-only", java_only).
long_option("Java-only", java_only).
+long_option("csharp", csharp).
+long_option("C#", csharp).
+long_option("csharp-only", csharp_only).
+long_option("C#-only", csharp_only).
long_option("x86_64", x86_64).
long_option("x86-64", x86_64).
long_option("x86_64-only", x86_64_only).
@@ -2765,6 +2773,11 @@ special_handler(java, none, OptionTable0, ok(OptionTable)) :-
special_handler(java_only, none, OptionTable0, ok(OptionTable)) :-
map.set(OptionTable0, target, string("java"), OptionTable1),
map.set(OptionTable1, target_code_only, bool(yes), OptionTable).
+special_handler(csharp, none, OptionTable0, ok(OptionTable)) :-
+ map.set(OptionTable0, target, string("csharp"), OptionTable).
+special_handler(csharp_only, none, OptionTable0, ok(OptionTable)) :-
+ map.set(OptionTable0, target, string("csharp"), OptionTable1),
+ map.set(OptionTable1, target_code_only, bool(yes), OptionTable).
special_handler(x86_64, none, OptionTable0, ok(OptionTable)) :-
map.set(OptionTable0, target, string("x86_64"), OptionTable).
special_handler(x86_64_only, none, OptionTable0, ok(OptionTable)) :-
diff --git a/compiler/parse_tree.m b/compiler/parse_tree.m
index e642402..f5b8247 100644
--- a/compiler/parse_tree.m
+++ b/compiler/parse_tree.m
@@ -69,7 +69,7 @@
:- include_module source_file_map.
:- include_module write_deps_file.
-% Java-related utilities.
+% Java and C# related utilities.
:- include_module java_names.
% (Note that intermod and trans_opt also contain routines that
diff --git a/compiler/pragma_c_gen.m b/compiler/pragma_c_gen.m
index f13af7a..cd79668 100644
--- a/compiler/pragma_c_gen.m
+++ b/compiler/pragma_c_gen.m
@@ -1445,7 +1445,8 @@ get_maybe_foreign_type_info(CI, Type) = MaybeForeignTypeInfo :-
search_type_ctor_defn(TypeTable, TypeCtor, TypeDefn),
hlds_data.get_type_defn_body(TypeDefn, TypeBody),
TypeBody = hlds_foreign_type(
- foreign_type_body(_MaybeIL, MaybeC, _MaybeJava, _MaybeErlang))
+ foreign_type_body(_MaybeIL, MaybeC, _MaybeJava, _MaybeCSharp,
+ _MaybeErlang))
->
(
MaybeC = yes(Data),
diff --git a/compiler/prog_data.m b/compiler/prog_data.m
index 6f69b26..4f2c05d 100644
--- a/compiler/prog_data.m
+++ b/compiler/prog_data.m
@@ -378,6 +378,7 @@ det_negation_det(detism_failure, yes(detism_det)).
---> il(il_foreign_type)
; c(c_foreign_type)
; java(java_foreign_type)
+ ; csharp(csharp_foreign_type)
; erlang(erlang_foreign_type).
:- type il_foreign_type
@@ -398,6 +399,11 @@ det_negation_det(detism_failure, yes(detism_det)).
string % The Java type name
).
+:- type csharp_foreign_type
+ ---> csharp_type(
+ string % The C# type name
+ ).
+
:- type erlang_foreign_type
---> erlang_type. % Erlang is untyped.
@@ -1362,6 +1368,7 @@ add_extra_attribute(NewAttribute, !Attrs) :-
; trace_grade_mlds
; trace_grade_c
; trace_grade_il
+ ; trace_grade_csharp
; trace_grade_java
; trace_grade_erlang.
@@ -1420,6 +1427,7 @@ parse_trace_grade_name("llds", trace_grade_llds).
parse_trace_grade_name("mlds", trace_grade_mlds).
parse_trace_grade_name("c", trace_grade_c).
parse_trace_grade_name("il", trace_grade_il).
+parse_trace_grade_name("csharp", trace_grade_csharp).
parse_trace_grade_name("java", trace_grade_java).
parse_trace_grade_name("erlang", trace_grade_erlang).
diff --git a/compiler/prog_foreign.m b/compiler/prog_foreign.m
index 4aece91..e83813b 100644
--- a/compiler/prog_foreign.m
+++ b/compiler/prog_foreign.m
@@ -326,6 +326,8 @@ prefer_foreign_language(_Globals, target_il, Lang1, Lang2) = Comp :-
Comp = no
).
+prefer_foreign_language(_Globals, target_csharp, _Lang1, _Lang2) = no.
+
prefer_foreign_language(_Globals, target_java, _Lang1, _Lang2) = no.
% Nothing useful to do here, but when we add Java as a foreign language,
% we should add it here.
@@ -364,6 +366,7 @@ valid_foreign_language(lang_erlang).
foreign_type_language(il(_)) = lang_il.
foreign_type_language(c(_)) = lang_c.
foreign_type_language(java(_)) = lang_java.
+foreign_type_language(csharp(_)) = lang_csharp.
foreign_type_language(erlang(_)) = lang_erlang.
%-----------------------------------------------------------------------------%
diff --git a/compiler/prog_io_pragma.m b/compiler/prog_io_pragma.m
index b658c05..21377c0 100644
--- a/compiler/prog_io_pragma.m
+++ b/compiler/prog_io_pragma.m
@@ -1540,6 +1540,18 @@ parse_foreign_language_type(InputTerm, VarSet, Language,
MaybeForeignLangType = error1([Spec])
)
;
+ Language = lang_csharp,
+ ( InputTerm = term.functor(term.string(CSharpTypeName), [], _) ->
+ MaybeForeignLangType = ok1(csharp(csharp_type(CSharpTypeName)))
+ ;
+ InputTermStr = describe_error_term(VarSet, InputTerm),
+ Pieces = [words("Error: invalid backend specification"),
+ quote(InputTermStr), suffix("."), nl],
+ Spec = error_spec(severity_error, phase_term_to_parse_tree,
+ [simple_msg(get_term_context(InputTerm), [always(Pieces)])]),
+ MaybeForeignLangType = error1([Spec])
+ )
+ ;
Language = lang_erlang,
( InputTerm = term.functor(term.string(_ErlangTypeName), [], _) ->
% XXX should we check if the type is blank?
@@ -1552,13 +1564,6 @@ parse_foreign_language_type(InputTerm, VarSet, Language,
[simple_msg(get_term_context(InputTerm), [always(Pieces)])]),
MaybeForeignLangType = error1([Spec])
)
- ;
- Language = lang_csharp,
- Pieces = [words("Error: unsupported language specified,"),
- words("unable to parse backend type."), nl],
- Spec = error_spec(severity_error, phase_term_to_parse_tree,
- [simple_msg(get_term_context(InputTerm), [always(Pieces)])]),
- MaybeForeignLangType = error1([Spec])
).
:- pred parse_il_type_name(string::in, term::in, varset::in,
diff --git a/compiler/rtti.m b/compiler/rtti.m
index d4de7fc..c868937 100644
--- a/compiler/rtti.m
+++ b/compiler/rtti.m
@@ -848,6 +848,16 @@
:- pred tc_rtti_name_java_type(tc_rtti_name::in, string::out, is_array::out)
is det.
+ % Analogous to rtti_id_c_type.
+ %
+:- pred rtti_id_maybe_element_csharp_type(rtti_id_maybe_element::in, string::out,
+ is_array::out) is det.
+:- pred rtti_id_csharp_type(rtti_id::in, string::out, is_array::out) is det.
+:- pred ctor_rtti_name_csharp_type(ctor_rtti_name::in, string::out,
+ is_array::out) is det.
+:- pred tc_rtti_name_csharp_type(tc_rtti_name::in, string::out, is_array::out)
+ is det.
+
% Given a type in a type vector in a type class instance declaration,
% return its string encoding for use in RTTI data structures, e.g. as
% part of C identifiers.
@@ -1932,6 +1942,58 @@ tc_rtti_name_java_type(TCRttiName, JavaTypeName, IsArray) :-
JavaTypeName = "jmercury.runtime." ++ GenTypeName
).
+rtti_id_maybe_element_csharp_type(item_type(RttiId), CTypeName, IsArray) :-
+ rtti_id_csharp_type(RttiId, CTypeName, IsArray).
+rtti_id_maybe_element_csharp_type(element_type(RttiId), CTypeName, IsArray) :-
+ rtti_id_csharp_type(RttiId, CTypeName, IsArray0),
+ (
+ IsArray0 = not_array,
+ unexpected(this_file,
+ "rtti_id_maybe_element_csharp_type: base is not array")
+ ;
+ IsArray0 = is_array,
+ IsArray = not_array
+ ).
+
+rtti_id_csharp_type(ctor_rtti_id(_, RttiName), CsharpTypeName, IsArray) :-
+ ctor_rtti_name_csharp_type(RttiName, CsharpTypeName, IsArray).
+rtti_id_csharp_type(tc_rtti_id(_, TCRttiName), CsharpTypeName, IsArray) :-
+ tc_rtti_name_csharp_type(TCRttiName, CsharpTypeName, IsArray).
+
+ctor_rtti_name_csharp_type(RttiName, CsharpTypeName, IsArray) :-
+ ctor_rtti_name_type(RttiName, GenTypeName0, IsArray),
+ ( GenTypeName0 = "ConstString" ->
+ CsharpTypeName = "string"
+ ; GenTypeName0 = "Integer" ->
+ CsharpTypeName = "int"
+ ; string.remove_suffix(GenTypeName0, "Ptr", GenTypeName1) ->
+ CsharpTypeName = "runtime." ++ GenTypeName1
+ ; string.prefix(GenTypeName0, "TypeClassConstraint_") ->
+ CsharpTypeName = "runtime.TypeClassConstraint"
+ ;
+ ( string.prefix(GenTypeName0, "FA_PseudoTypeInfo_Struct")
+ ; string.prefix(GenTypeName0, "FA_TypeInfo_Struct")
+ ; string.prefix(GenTypeName0, "VA_PseudoTypeInfo_Struct")
+ ; string.prefix(GenTypeName0, "VA_TypeInfo_Struct")
+ )
+ ->
+ CsharpTypeName = "runtime.TypeInfo_Struct"
+ ;
+ CsharpTypeName = "runtime." ++ GenTypeName0
+ ).
+
+tc_rtti_name_csharp_type(TCRttiName, CsharpTypeName, IsArray) :-
+ tc_rtti_name_type(TCRttiName, GenTypeName, IsArray),
+ ( GenTypeName = "BaseTypeclassInfo" ->
+ CsharpTypeName = "object" /* & IsArray = yes */
+ ; GenTypeName = "ConstString" ->
+ CsharpTypeName = "string"
+ ; string.prefix(GenTypeName, "TypeClassConstraint_") ->
+ CsharpTypeName = "runtime.TypeClassConstraint"
+ ;
+ CsharpTypeName = "runtime." ++ GenTypeName
+ ).
+
% ctor_rtti_name_type(RttiName, Type, IsArray)
%
:- pred ctor_rtti_name_type(ctor_rtti_name::in, string::out, is_array::out)
diff --git a/compiler/simplify.m b/compiler/simplify.m
index 5275817..5421a94 100644
--- a/compiler/simplify.m
+++ b/compiler/simplify.m
@@ -2011,6 +2011,9 @@ simplify_goal_trace_goal(MaybeCompiletimeExpr, MaybeRuntimeExpr, SubGoal,
Target = target_java,
!:EvalAttributes = default_attributes(lang_java)
;
+ Target = target_csharp,
+ !:EvalAttributes = default_attributes(lang_csharp)
+ ;
( Target = target_il
; Target = target_asm
; Target = target_x86_64
@@ -2168,6 +2171,14 @@ evaluate_compile_time_condition(trace_base(Base), Info) = Result :-
Result = no
)
;
+ Grade = trace_grade_csharp,
+ globals.get_target(Globals, Target),
+ ( Target = target_csharp ->
+ Result = yes
+ ;
+ Result = no
+ )
+ ;
Grade = trace_grade_java,
globals.get_target(Globals, Target),
( Target = target_java ->
diff --git a/compiler/special_pred.m b/compiler/special_pred.m
index 6f120f2..6668258 100644
--- a/compiler/special_pred.m
+++ b/compiler/special_pred.m
@@ -302,6 +302,7 @@ compiler_generated_rtti_for_builtins(ModuleInfo) :-
module_info_get_globals(ModuleInfo, Globals),
globals.get_target(Globals, Target),
( Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_erlang
).
diff --git a/compiler/write_deps_file.m b/compiler/write_deps_file.m
index 95faed7..505bca8 100644
--- a/compiler/write_deps_file.m
+++ b/compiler/write_deps_file.m
@@ -566,6 +566,11 @@ write_dependency_file(Globals, Module, AllDepsSet, MaybeTransOptDeps, !IO) :-
ForeignImportTargets = [DllFileName],
ForeignImportExt = ".dll"
;
+ Target = target_csharp,
+ % XXX don't know enough about C# yet
+ ForeignImportTargets = [],
+ ForeignImportExt = ".cs"
+ ;
Target = target_java,
ForeignImportTargets = [ClassFileName],
ForeignImportExt = ".java"
@@ -1132,6 +1137,7 @@ generate_dv_file(Globals, SourceFileName, ModuleName, DepsMap, DepStream,
ForeignModulesAndExts = foreign_modules(Modules, DepsMap)
;
( Target = target_c
+ ; Target = target_csharp
; Target = target_java
; Target = target_asm
; Target = target_x86_64
@@ -1472,6 +1478,7 @@ generate_dv_file(Globals, SourceFileName, ModuleName, DepsMap, DepStream,
% For the IL and Java targets, currently we don't generate
% `.mih' files at all; although perhaps we should...
( Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_erlang
)
@@ -1496,6 +1503,7 @@ generate_dv_file(Globals, SourceFileName, ModuleName, DepsMap, DepStream,
DepStream, !IO)
;
( Target = target_il
+ ; Target = target_csharp
; Target = target_java
; Target = target_erlang
)
@@ -1844,6 +1852,10 @@ generate_dep_file_exec_library_targets(Globals, DepStream, ModuleName,
Target = target_il,
Rules = ILMainRule
;
+ Target = target_csharp,
+ % XXX not yet
+ Rules = []
+ ;
Target = target_java,
Rules = JavaMainRule
;
@@ -1937,6 +1949,10 @@ generate_dep_file_exec_library_targets(Globals, DepStream, ModuleName,
Target = target_il,
LibRules = ILLibRule
;
+ Target = target_csharp,
+ % XXX not done yet
+ LibRules = []
+ ;
Target = target_java,
LibRules = JavaLibRule
;
diff --git a/library/array.m b/library/array.m
index 684c3ba..5ac3d33 100644
--- a/library/array.m
+++ b/library/array.m
@@ -482,7 +482,11 @@
where equality is array.array_equal,
comparison is array.array_compare.
-:- pragma foreign_type(il, array(T), "class [mscorlib]System.Array")
+% :- pragma foreign_type("C#", array(T), "System.Array")
+% where equality is array.array_equal,
+% comparison is array.array_compare.
+
+:- pragma foreign_type("IL", array(T), "class [mscorlib]System.Array")
where equality is array.array_equal,
comparison is array.array_compare.
@@ -490,7 +494,7 @@
% that is capable of holding any kind of array, including e.g. `int []'.
% Java doesn't have any equivalent of .NET's System.Array class,
% so we just use the universal base `java.lang.Object'.
-:- pragma foreign_type(java, array(T), "/* Array */ java.lang.Object")
+:- pragma foreign_type("Java", array(T), "/* Array */ java.lang.Object")
where equality is array.array_equal,
comparison is array.array_compare.
@@ -823,7 +827,10 @@ array.init(Size, Item, Array) :-
array.init_2(Size::in, Item::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
- Array = System.Array.CreateInstance(Item.GetType(), Size);
+ // This does not work because Item.GetType() may return the subtype
+ // rather than the type we intended.
+ // Array = System.Array.CreateInstance(Item.GetType(), Size);
+ Array = new object[Size];
for (int i = 0; i < Size; i++) {
Array.SetValue(Item, i);
}
@@ -1191,7 +1198,8 @@ ML_resize_array(MR_ArrayPtr array, MR_ArrayPtr old_array,
[will_not_call_mercury, promise_pure, thread_safe],
"
if (Array0 == null) {
- Array = System.Array.CreateInstance(Item.GetType(), Size);
+ // Array = System.Array.CreateInstance(Item.GetType(), Size);
+ Array = new object[Size];
for (int i = 0; i < Size; i++) {
Array.SetValue(Item, i);
}
@@ -1199,10 +1207,12 @@ ML_resize_array(MR_ArrayPtr array, MR_ArrayPtr old_array,
else if (Array0.Length == Size) {
Array = Array0;
} else if (Array0.Length > Size) {
- Array = System.Array.CreateInstance(Item.GetType(), Size);
+ // Array = System.Array.CreateInstance(Item.GetType(), Size);
+ Array = new object[Size];
System.Array.Copy(Array0, Array, Size);
} else {
- Array = System.Array.CreateInstance(Item.GetType(), Size);
+ // Array = System.Array.CreateInstance(Item.GetType(), Size);
+ Array = new object[Size];
System.Array.Copy(Array0, Array, Array0.Length);
for (int i = Array0.Length; i < Size; i++) {
Array.SetValue(Item, i);
@@ -1298,8 +1308,9 @@ array.shrink(Array0, Size, Array) :-
array.shrink_2(Array0::array_di, Size::in, Array::array_uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
- Array = System.Array.CreateInstance(Array0.GetType().GetElementType(),
- Size);
+ // Array = System.Array.CreateInstance(Array0.GetType().GetElementType(),
+ // Size);
+ Array = new object[Size];
System.Array.Copy(Array0, Array, Size);
").
@@ -1382,8 +1393,9 @@ ML_copy_array(MR_ArrayPtr array, MR_ConstArrayPtr old_array)
"
// XXX we implement the same as ML_copy_array, which doesn't appear
// to deep copy the array elements
- Array = System.Array.CreateInstance(Array0.GetType().GetElementType(),
- Array0.Length);
+ // Array = System.Array.CreateInstance(Array0.GetType().GetElementType(),
+ // Array0.Length);
+ Array = new object[Array0.Length];
System.Array.Copy(Array0, Array, Array0.Length);
").
diff --git a/library/backjump.m b/library/backjump.m
index f5b1cf7..ec0fca4 100644
--- a/library/backjump.m
+++ b/library/backjump.m
@@ -425,6 +425,24 @@ mercury_sys_init_backjumps_write_out_proc_statics(FILE *deep_fp,
%-----------------------------------------------------------------------------%
+:- pragma foreign_code("C#", "
+
+ public static void
+ builtin_choice_id_1_p_0(object cont, /* env_ptr */ object cont_env_ptr)
+ {
+ throw new System.Exception(""builtin_choice_id/1 not implemented"");
+ }
+
+ public static void
+ builtin_backjump_1_p_0(int Id_2)
+ {
+ throw new System.Exception(""builtin_backjump/1 not implemented"");
+ }
+
+").
+
+%-----------------------------------------------------------------------------%
+
:- pragma foreign_code("Java", "
public static void
diff --git a/library/bitmap.m b/library/bitmap.m
index f8cbb15..1e0d7b2 100644
--- a/library/bitmap.m
+++ b/library/bitmap.m
@@ -1568,6 +1568,8 @@ public class MercuryBitmap {
where equality is bitmap_equal, comparison is bitmap_compare.
:- pragma foreign_type("Java", bitmap, "bitmap.MercuryBitmap")
where equality is bitmap_equal, comparison is bitmap_compare.
+% :- pragma foreign_type("C#", bitmap, "bitmap.MercuryBitmap")
+% where equality is bitmap_equal, comparison is bitmap_compare.
:- pragma foreign_type("IL", bitmap,
"class [mercury]mercury.bitmap__csharp_code.mercury_code.MercuryBitmap")
where equality is bitmap_equal, comparison is bitmap_compare.
diff --git a/library/bool.m b/library/bool.m
index 944b9ba..02d17da 100644
--- a/library/bool.m
+++ b/library/bool.m
@@ -77,6 +77,12 @@
% The representation of bool values should correspond with the definitions of
% MR_TRUE and MR_FALSE in runtime/mercury_std.h.
+% :- pragma foreign_export_enum("C#", bool/0, [],
+% [
+% no - "NO",
+% yes - "YES"
+% ]).
+
:- pragma foreign_export_enum("Java", bool/0, [],
[
no - "NO",
diff --git a/library/builtin.m b/library/builtin.m
index 61a9272..52d8743 100644
--- a/library/builtin.m
+++ b/library/builtin.m
@@ -642,30 +642,54 @@ call_rtti_generic_compare(Res, X, Y) :-
rtti_implementation.generic_compare(Res, X, Y).
:- pragma foreign_code("C#", "
-public static void compare_3(object[] TypeInfo_for_T, ref object[] Res,
- object X, object Y)
-{
- mercury.builtin.mercury_code.call_rtti_generic_compare_3(TypeInfo_for_T,
- ref Res, X, Y);
-}
+ //
+ // Generic unification/comparison routines
+ //
-public static void compare_3_m1(object[] TypeInfo_for_T, ref object[] Res,
- object X, object Y)
-{
- compare_3(TypeInfo_for_T, ref Res, X, Y);
-}
+ public static bool
+ unify_2_p_0(runtime.TypeInfo_Struct ti,
+ object x, object y)
+ {
+ return rtti_implementation.generic_unify_2_p_0(ti, x, y);
+ }
-public static void compare_3_m2(object[] TypeInfo_for_T, ref object[] Res,
- object X, object Y)
-{
- compare_3(TypeInfo_for_T, ref Res, X, Y);
-}
+ public static Comparison_result_0
+ compare_3_p_0(runtime.TypeInfo_Struct ti,
+ object x, object y)
+ {
+ return rtti_implementation.generic_compare_3_p_0(ti, x, y);
+ }
-public static void compare_3_m3(object[] TypeInfo_for_T, ref object[] Res,
- object X, object Y)
-{
- compare_3(TypeInfo_for_T, ref Res, X, Y);
-}
+ public static Comparison_result_0
+ compare_3_p_1(runtime.TypeInfo_Struct ti,
+ object x, object y)
+ {
+ return compare_3_p_0(ti, x, y);
+ }
+
+ public static Comparison_result_0
+ compare_3_p_2(runtime.TypeInfo_Struct ti,
+ object x, object y)
+ {
+ return compare_3_p_0(ti, x, y);
+ }
+
+ public static Comparison_result_0
+ compare_3_p_3(runtime.TypeInfo_Struct ti,
+ object x, object y)
+ {
+ return compare_3_p_0(ti, x, y);
+ }
+
+ public static Comparison_result_0
+ compare_representation_3_p_0(runtime.TypeInfo_Struct ti,
+ object x, object y)
+ {
+ // stub only
+ runtime.Errors.SORRY(
+ ""compare_representation_3_p_0/3 not implemented"");
+ return Comparison_result_0.f_equal;
+ }
").
:- pragma foreign_code("C#", "
@@ -723,68 +747,62 @@ public static void deep_copy_fields(System.Reflection.FieldInfo[] fields,
").
:- pragma foreign_code("C#", "
-public static bool unify_2_p(object[] ti, object X, object Y)
-{
- return mercury.builtin.mercury_code.call_rtti_generic_unify_2_p(ti, X, Y);
-}
-
-").
-
-:- pragma foreign_code("C#", "
public static bool
-special__Unify____void_0_0(object[] x, object[] y)
+__Unify____void_0_0(object x, object y)
{
- mercury.runtime.Errors.fatal_error(""called unify for type `void'"");
+ runtime.Errors.fatal_error(""called unify for type `void'"");
return false;
}
public static bool
-special__Unify____c_pointer_0_0(object[] x, object[] y)
+__Unify____c_pointer_0_0(object x, object y)
{
- mercury.runtime.Errors.fatal_error(""called unify for type `c_pointer'"");
+ runtime.Errors.fatal_error(""called unify for type `c_pointer'"");
return false;
}
public static bool
-special__Unify____func_0_0(object[] x, object[] y)
+__Unify____func_0_0(object[] x, object[] y)
{
- mercury.runtime.Errors.fatal_error(""called unify for `func' type"");
+ runtime.Errors.fatal_error(""called unify for `func' type"");
return false;
}
public static bool
-special__Unify____tuple_0_0(object[] x, object[] y)
+__Unify____tuple_0_0(object[] x, object[] y)
{
- mercury.runtime.Errors.fatal_error(""called unify for `tuple' type"");
+ runtime.Errors.fatal_error(""called unify for `tuple' type"");
return false;
}
-public static void
-special__Compare____void_0_0(ref object[] result, object[] x, object[] y)
+public static Comparison_result_0
+__Compare____void_0_0(object x, object y)
{
- mercury.runtime.Errors.fatal_error(""called compare/3 for type `void'"");
+ runtime.Errors.fatal_error(""called compare for type `void'"");
+ return Comparison_result_0.f_equal;
}
-public static void
-special__Compare____c_pointer_0_0(
- ref object[] result, object[] x, object[] y)
+public static Comparison_result_0
+__Compare____c_pointer_0_0(object x, object y)
{
- mercury.runtime.Errors.fatal_error(
+ runtime.Errors.fatal_error(
""called compare/3 for type `c_pointer'"");
+ return Comparison_result_0.f_equal;
}
-public static void
-special__Compare____func_0_0(ref object[] result, object[] x, object[] y)
+public static Comparison_result_0
+__Compare____func_0_0(object x, object y)
{
- mercury.runtime.Errors.fatal_error(""called compare/3 for `func' type"");
+ runtime.Errors.fatal_error(""called compare for `func' type"");
+ return Comparison_result_0.f_equal;
}
-public static void
-special__Compare____tuple_0_0(ref object[] result,
- object[] x, object[] y)
+public static Comparison_result_0
+__Compare____tuple_0_0(object x, object y)
{
- mercury.runtime.Errors.fatal_error(""called compare/3 for `tuple' type"");
+ runtime.Errors.fatal_error(""called compare for `tuple' type"");
+ return Comparison_result_0.f_equal;
}
").
@@ -989,17 +1007,15 @@ special__Compare____tuple_0_0(ref object[] result,
% references to it in code. See tests/hard_coded/nullary_ho_func.m for an
% example of code which does.
%
-:- pragma foreign_decl("C#", "
-namespace mercury.builtin {
- public class void_0
+:- pragma foreign_code("C#", "
+ public class Void_0
{
// Make the constructor private to ensure that we can
// never create an instance of this class.
- private void_0()
+ private Void_0()
{
}
}
-}
").
:- pragma foreign_code("Java", "
public static class Void_0
diff --git a/library/dir.m b/library/dir.m
index 3af1280..1c3b14a 100644
--- a/library/dir.m
+++ b/library/dir.m
@@ -323,6 +323,8 @@ use_windows_paths :- dir.directory_separator = ('\\').
"ML_dir_this_directory").
:- pragma foreign_export("IL", (dir.this_directory = out),
"ML_dir_this_directory").
+% :- pragma foreign_export("C#", (dir.this_directory = out),
+% "ML_dir_this_directory").
dir.this_directory = ".".
@@ -770,6 +772,8 @@ dir.make_path_name(DirName, FileName) = DirName/FileName.
"ML_make_path_name").
:- pragma foreign_export("IL", dir.make_path_name(in, in) = out,
"ML_make_path_name").
+% :- pragma foreign_export("C#", dir.make_path_name(in, in) = out,
+% "ML_make_path_name").
DirName0/FileName0 = PathName :-
DirName = string.from_char_list(canonicalize_path_chars(
@@ -947,18 +951,16 @@ dir.make_directory(PathName, Result, !IO) :-
// CreateDirectory doesn't fail if a file with the same
// name as the directory being created already exists.
if (System.IO.File.Exists(DirName)) {
- mercury.dir.mercury_code.ML_make_mkdir_res_error(
- new System.Exception(""a file with that name already exists""),
- ref Res);
+ Res = dir.ML_make_mkdir_res_error(
+ new System.Exception(""a file with that name already exists""));
} else if (System.IO.Directory.Exists(DirName)) {
- mercury.dir.mercury_code.ML_check_dir_accessibility(DirName,
- ref Res);
+ Res = dir.ML_check_dir_accessibility(DirName);
} else {
System.IO.Directory.CreateDirectory(DirName);
- Res = mercury.dir.mercury_code.ML_make_mkdir_res_ok();
+ Res = dir.ML_make_mkdir_res_ok();
}
} catch (System.Exception e) {
- mercury.dir.mercury_code.ML_make_mkdir_res_error(e, ref Res);
+ Res = dir.ML_make_mkdir_res_error(e);
}
}").
@@ -1097,34 +1099,30 @@ dir.make_single_directory(DirName, Result, !IO) :-
// CreateDirectory doesn't fail if a file with the same
// name as the directory being created already exists.
if (System.IO.File.Exists(DirName)) {
- mercury.dir.mercury_code.ML_make_mkdir_res_error(
+ Result = dir.ML_make_mkdir_res_error(
new System.Exception(
- ""a file with that name already exists""),
- ref Result);
+ ""a file with that name already exists""));
} else {
System.IO.DirectoryInfo info =
new System.IO.DirectoryInfo(DirName);
System.IO.DirectoryInfo parent_info = info.Parent;
if (parent_info == null) {
- mercury.dir.mercury_code.ML_make_mkdir_res_error(
- new System.Exception(""can't create root directory""),
- ref Result);
+ Result = dir.ML_make_mkdir_res_error(
+ new System.Exception(""can't create root directory""));
} else if (!info.Parent.Exists) {
- mercury.dir.mercury_code.ML_make_mkdir_res_error(
- new System.Exception(""parent directory does not exist""),
- ref Result);
+ Result = dir.ML_make_mkdir_res_error(
+ new System.Exception(""parent directory does not exist""));
} else if (ErrorIfExists == 1 && info.Exists) {
- mercury.dir.mercury_code.ML_make_mkdir_res_error(
- new System.Exception(""directory already exists""),
- ref Result);
+ Result = dir.ML_make_mkdir_res_error(
+ new System.Exception(""directory already exists""));
} else {
info.Create();
- Result = mercury.dir.mercury_code.ML_make_mkdir_res_ok();
+ Result = dir.ML_make_mkdir_res_ok();
}
}
} catch (System.Exception e) {
- mercury.dir.mercury_code.ML_make_mkdir_res_error(e, ref Result);
+ Result = dir.ML_make_mkdir_res_error(e);
}
}").
@@ -1181,6 +1179,8 @@ dir.make_single_directory(DirName, Result, !IO) :-
"ML_make_mkdir_res_ok").
:- pragma foreign_export("IL", (dir.make_mkdir_res_ok = out),
"ML_make_mkdir_res_ok").
+% :- pragma foreign_export("C#", (dir.make_mkdir_res_ok = out),
+% "ML_make_mkdir_res_ok").
:- pragma foreign_export("Java", (dir.make_mkdir_res_ok = out),
"ML_make_mkdir_res_ok").
:- pragma foreign_export("Erlang", (dir.make_mkdir_res_ok = out),
@@ -1194,6 +1194,8 @@ dir.make_mkdir_res_ok = ok.
"ML_make_mkdir_res_error").
:- pragma foreign_export("IL", dir.make_mkdir_res_error(in, out, di, uo),
"ML_make_mkdir_res_error").
+% :- pragma foreign_export("C#", dir.make_mkdir_res_error(in, out, di, uo),
+% "ML_make_mkdir_res_error").
:- pragma foreign_export("Java", dir.make_mkdir_res_error(in, out, di, uo),
"ML_make_mkdir_res_error").
:- pragma foreign_export("Erlang", dir.make_mkdir_res_error(in, out, di, uo),
@@ -1211,6 +1213,9 @@ dir.make_mkdir_res_error(Error, error(make_io_error(Msg)), !IO) :-
:- pragma foreign_export("IL",
dir.make_mkdir_res_exists(in, in, out, di, uo),
"ML_make_mkdir_res_exists").
+% :- pragma foreign_export("C#",
+% dir.make_mkdir_res_exists(in, in, out, di, uo),
+% "ML_make_mkdir_res_exists").
:- pragma foreign_export("Java",
dir.make_mkdir_res_exists(in, in, out, di, uo),
"ML_make_mkdir_res_exists").
@@ -1232,6 +1237,8 @@ dir.make_mkdir_res_exists(Error, DirName, Res, !IO) :-
"ML_check_dir_accessibility").
:- pragma foreign_export("IL", dir.check_dir_accessibility(in, out, di, uo),
"ML_check_dir_accessibility").
+% :- pragma foreign_export("C#", dir.check_dir_accessibility(in, out, di, uo),
+% "ML_check_dir_accessibility").
:- pragma foreign_export("Java", dir.check_dir_accessibility(in, out, di, uo),
"ML_check_dir_accessibility").
:- pragma foreign_export("Erlang", dir.check_dir_accessibility(in, out, di, uo),
@@ -1526,8 +1533,9 @@ check_for_symlink_loop(SymLinkParent, DirName, LoopRes, !ParentIds, !IO) :-
% dir.streams must be closed to avoid resource leaks.
:- type dir.stream ---> dir.stream.
:- pragma foreign_type("C", dir.stream, "ML_DIR_STREAM").
-:- pragma foreign_type("il", dir.stream,
+:- pragma foreign_type("IL", dir.stream,
"class [mscorlib]System.Collections.IEnumerator").
+% :- pragma foreign_type("C#", dir.stream, "System.Collections.IEnumerator").
:- pragma foreign_type("Java", dir.stream, "java.util.Iterator").
:- pragma foreign_type("Erlang", dir.stream, "").
@@ -1637,9 +1645,9 @@ dir.open(DirName, Res, !IO) :-
try {
System.Collections.IEnumerator Dir =
System.IO.Directory.GetFileSystemEntries(DirName).GetEnumerator();
- mercury.dir.mercury_code.ML_dir_read_first_entry(Dir, ref Result);
+ Result = dir.ML_dir_read_first_entry(Dir);
} catch (System.Exception e) {
- mercury.dir.mercury_code.ML_make_dir_open_result_error(e, ref Result);
+ Result = dir.ML_make_dir_open_result_error(e);
}
}").
@@ -1722,6 +1730,8 @@ dir.check_dir_readable(DirName, IsReadable, Result, !IO) :-
"ML_dir_read_first_entry").
:- pragma foreign_export("IL", dir.read_first_entry(in, out, di, uo),
"ML_dir_read_first_entry").
+% :- pragma foreign_export("C#", dir.read_first_entry(in, out, di, uo),
+% "ML_dir_read_first_entry").
:- pragma foreign_export("Java", dir.read_first_entry(in, out, di, uo),
"ML_dir_read_first_entry").
:- pragma foreign_export("Erlang", dir.read_first_entry(in, out, di, uo),
@@ -1738,6 +1748,9 @@ dir.read_first_entry(Dir, Result, !IO) :-
:- pragma foreign_export("IL",
make_win32_dir_open_result_ok(in, in, out, di, uo),
"ML_make_win32_dir_open_result_ok").
+% :- pragma foreign_export("C#",
+% make_win32_dir_open_result_ok(in, in, out, di, uo),
+% "ML_make_win32_dir_open_result_ok").
:- pragma foreign_export("Java",
make_win32_dir_open_result_ok(in, in, out, di, uo),
"ML_make_win32_dir_open_result_ok").
@@ -1794,6 +1807,8 @@ copy_c_string(_) = _ :-
"ML_make_dir_open_result_eof").
:- pragma foreign_export("IL", (make_dir_open_result_eof = out),
"ML_make_dir_open_result_eof").
+% :- pragma foreign_export("C#", (make_dir_open_result_eof = out),
+% "ML_make_dir_open_result_eof").
:- pragma foreign_export("Java", (make_dir_open_result_eof = out),
"ML_make_dir_open_result_eof").
@@ -1805,6 +1820,8 @@ make_dir_open_result_eof = eof.
"ML_make_dir_open_result_error").
:- pragma foreign_export("IL", make_dir_open_result_error(in, out, di, uo),
"ML_make_dir_open_result_error").
+% :- pragma foreign_export("C#", make_dir_open_result_error(in, out, di, uo),
+% "ML_make_dir_open_result_error").
:- pragma foreign_export("Java", make_dir_open_result_error(in, out, di, uo),
"ML_make_dir_open_result_error").
:- pragma foreign_export("Erlang", make_dir_open_result_error(in, out, di, uo),
diff --git a/library/exception.m b/library/exception.m
index 5115c3b..e7d349b 100644
--- a/library/exception.m
+++ b/library/exception.m
@@ -1441,29 +1441,13 @@ mercury__exception__builtin_catch_model_non(MR_Mercury_Type_Info type_info,
#endif /* MR_HIGHLEVEL_CODE */
").
- % For the .NET backend we override throw_impl as it is easier to
- % implement these things using foreign_proc.
-
-:- pragma foreign_decl("C#", "
-namespace mercury {
- namespace runtime {
- public class Exception : System.Exception
- {
- public Exception(object[] data)
- {
- mercury_exception = data;
- }
- public object[] mercury_exception;
- };
- }
-}
-").
+%-----------------------------------------------------------------------------%
:- pragma foreign_proc("C#",
throw_impl(T::in),
[will_not_call_mercury, promise_pure],
"
- throw new mercury.runtime.Exception(T);
+ throw new runtime.Exception(T);
").
:- pragma foreign_proc("C#",
@@ -1471,12 +1455,11 @@ namespace mercury {
[will_not_call_mercury, promise_pure],
"
try {
- mercury.exception.mercury_code.ML_call_goal_det(
- TypeInfo_for_T, Pred, ref T);
+ T = exception.ML_call_goal_det(TypeInfo_for_T, Pred);
}
- catch (mercury.runtime.Exception ex) {
- mercury.exception.mercury_code.ML_call_handler_det(
- TypeInfo_for_T, Handler, ex.mercury_exception, ref T);
+ catch (runtime.Exception ex) {
+ T = exception.ML_call_handler_det(TypeInfo_for_T, Handler,
+ (univ.Univ_0) ex.exception);
}
").
:- pragma foreign_proc("C#",
@@ -1484,57 +1467,49 @@ namespace mercury {
[will_not_call_mercury, promise_pure],
"
try {
- mercury.exception.mercury_code.ML_call_goal_det(
- TypeInfo_for_T, Pred, ref T);
+ T = exception.ML_call_goal_det(TypeInfo_for_T, Pred);
}
- catch (mercury.runtime.Exception ex) {
- mercury.exception.mercury_code.ML_call_handler_det(
- TypeInfo_for_T, Handler, ex.mercury_exception, ref T);
+ catch (runtime.Exception ex) {
+ T = exception.ML_call_handler_det(TypeInfo_for_T, Handler,
+ (univ.Univ_0) ex.exception);
}
").
-/*
- % We can't implement these until we implement semidet procedures
- % for the C# interface.
-
:- pragma foreign_proc("C#",
- catch_impl(Pred::pred(out) is semidet, Handler::in(handler), T::out),
+ catch_impl(_Pred::pred(out) is semidet, _Handler::in(handler), T::out),
[will_not_call_mercury, promise_pure],
"
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
+ runtime.Errors.SORRY(""foreign code for this function"");
+ T = null;
+ SUCCESS_INDICATOR = false;
").
:- pragma foreign_proc("C#",
- catch_impl(Pred::pred(out) is cc_nondet, Handler::in(handler), T::out),
+ catch_impl(_Pred::pred(out) is cc_nondet, _Handler::in(handler), T::out),
[will_not_call_mercury, promise_pure],
"
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
+ runtime.Errors.SORRY(""foreign code for this function"");
+ T = null;
+ SUCCESS_INDICATOR = false;
").
- % We can't implement these because nondet C# foreign_proc for C#
- % is not possible.
-
:- pragma foreign_proc("C#",
catch_impl(_Pred::pred(out) is multi, _Handler::in(handler), _T::out),
[will_not_call_mercury, promise_pure, ordinary_despite_detism],
- local_vars(""),
- first_code(""),
- retry_code(""),
- common_code("
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
- ")
-).
+"
+ runtime.Errors.SORRY(""foreign code for this function"");
+ SUCCESS_INDICATOR = false;
+").
+
:- pragma foreign_proc("C#",
catch_impl(_Pred::pred(out) is nondet, _Handler::in(handler), _T::out),
[will_not_call_mercury, promise_pure, ordinary_despite_detism],
- local_vars(""),
- first_code(""),
- retry_code(""),
- common_code("
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
- ")
-).
-*/
+"
+ runtime.Errors.SORRY(""foreign code for this function"");
+ SUCCESS_INDICATOR = false;
+").
+
+%-----------------------------------------------------------------------------%
:- pragma foreign_proc("Erlang",
throw_impl(T::in),
@@ -1596,6 +1571,8 @@ namespace mercury {
end.
").
+%-----------------------------------------------------------------------------%
+
:- pred call_goal(pred(T), T).
:- mode call_goal(pred(out) is det, out) is det.
:- mode call_goal(pred(out) is semidet, out) is semidet.
@@ -1614,12 +1591,16 @@ call_handler(Handler, Exception, Result) :- Handler(Exception, Result).
"ML_call_goal_det").
:- pragma foreign_export("IL", call_goal(pred(out) is det, out),
"ML_call_goal_det").
+% :- pragma foreign_export("C#", call_goal(pred(out) is det, out),
+% "ML_call_goal_det").
:- pragma foreign_export("Java", call_goal(pred(out) is det, out),
"ML_call_goal_det").
:- pragma foreign_export("C", call_goal(pred(out) is semidet, out),
"ML_call_goal_semidet").
:- pragma foreign_export("IL", call_goal(pred(out) is semidet, out),
"ML_call_goal_semidet").
+% :- pragma foreign_export("C#", call_goal(pred(out) is semidet, out),
+% "ML_call_goal_semidet").
:- pragma foreign_export("Java", call_goal(pred(out) is semidet, out),
"ML_call_goal_semidet").
@@ -1638,9 +1619,13 @@ call_handler(Handler, Exception, Result) :- Handler(Exception, Result).
"ML_call_handler_det").
:- pragma foreign_export("IL", call_handler(pred(in, out) is det, in, out),
"ML_call_handler_det").
+% :- pragma foreign_export("C#", call_handler(pred(in, out) is det, in, out),
+% "ML_call_handler_det").
:- pragma foreign_export("Java", call_handler(pred(in, out) is det, in, out),
"ML_call_handler_det").
+%-----------------------------------------------------------------------------%
+
:- pragma foreign_code("Java", "
/*
* The ssdb module may supply its implementation of these methods at runtime.
@@ -2788,6 +2773,8 @@ mercury_sys_init_exceptions_write_out_proc_statics(FILE *deep_fp,
"ML_report_uncaught_exception").
:- pragma foreign_export("IL", report_uncaught_exception(in, di, uo),
"ML_report_uncaught_exception").
+% :- pragma foreign_export("C#", report_uncaught_exception(in, di, uo),
+% "ML_report_uncaught_exception").
:- pragma foreign_export("Java", report_uncaught_exception(in, di, uo),
"ML_report_uncaught_exception").
:- pragma foreign_export("Erlang", report_uncaught_exception(in, di, uo),
diff --git a/library/float.m b/library/float.m
index ef78efb..4106921 100644
--- a/library/float.m
+++ b/library/float.m
@@ -620,7 +620,7 @@ is_nan_or_inf(Float) :-
"
SUCCESS_INDICATOR = MR_is_nan(Flt);
").
-:- pragma foreign_proc(il,
+:- pragma foreign_proc("IL",
is_nan(Flt::in),
[will_not_call_mercury, promise_pure, thread_safe, max_stack_size(1)],
"
@@ -628,6 +628,12 @@ is_nan_or_inf(Float) :-
call bool [mscorlib]System.Double::IsNaN(float64)
stloc 'succeeded'
").
+:- pragma foreign_proc("C#",
+ is_nan(Flt::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ SUCCESS_INDICATOR = System.Double.IsNaN(Flt);
+").
:- pragma foreign_proc("Java",
is_nan(Flt::in),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -650,7 +656,7 @@ is_nan_or_inf(Float) :-
"
SUCCESS_INDICATOR = MR_is_inf(Flt);
").
-:- pragma foreign_proc(il,
+:- pragma foreign_proc("IL",
is_inf(Flt::in),
[will_not_call_mercury, promise_pure, thread_safe, max_stack_size(1)],
"
@@ -658,6 +664,12 @@ is_nan_or_inf(Float) :-
call bool [mscorlib]System.Double::IsInfinity(float64)
stloc 'succeeded'
").
+:- pragma foreign_proc("C#",
+ is_inf(Flt::in),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ SUCCESS_INDICATOR = System.Double.IsInfinity(Flt);
+").
:- pragma foreign_proc("Java",
is_inf(Flt::in),
[will_not_call_mercury, promise_pure, thread_safe],
diff --git a/library/io.m b/library/io.m
index cf3a5d9..43089a3 100644
--- a/library/io.m
+++ b/library/io.m
@@ -1512,6 +1512,7 @@
:- pragma foreign_type(c, io.system_error, "MR_Integer").
:- pragma foreign_type(il, io.system_error,
"class [mscorlib]System.Exception").
+% :- pragma foreign_type("C#", io.system_error, "System.Exception").
:- pragma foreign_type(java, io.system_error, "java.lang.Exception").
:- pragma foreign_type(erlang, io.system_error, "").
@@ -1699,6 +1700,7 @@
:- type io.state.
:- pragma foreign_type("C", io.state, "MR_Word", [can_pass_as_mercury_type]).
:- pragma foreign_type("IL", io.state, "int32", [can_pass_as_mercury_type]).
+% :- pragma foreign_type("C#", io.state, "int", [can_pass_as_mercury_type]).
:- pragma foreign_type("Java", io.state, "java.lang.Object",
[can_pass_as_mercury_type]).
:- pragma foreign_type("Erlang", io.state, "", [can_pass_as_mercury_type]).
@@ -1742,8 +1744,9 @@
// but we keep them for consistency with the C code.
#if MR_HIGHLEVEL_DATA
- static mercury.tree234.tree234_2 ML_io_stream_db;
- static object[] ML_io_user_globals;
+ static tree234.Tree234_2 ML_io_stream_db
+ = new tree234.Tree234_2.Empty_0();
+ static univ.Univ_0 ML_io_user_globals;
#else
static object[] ML_io_stream_db;
static object[] ML_io_user_globals;
@@ -1782,8 +1785,9 @@
---> stream(c_pointer).
:- pragma foreign_type("C", io.stream, "MercuryFilePtr",
[can_pass_as_mercury_type]).
-:- pragma foreign_type("il", io.stream,
+:- pragma foreign_type("IL", io.stream,
"class [mercury]mercury.io__csharp_code.MR_MercuryFileStruct").
+% :- pragma foreign_type("C#", io.stream, "io.MR_MercuryFileStruct").
:- pragma foreign_type("Java", io.stream, "io.MR_MercuryFileStruct").
:- pragma foreign_type("Erlang", io.stream, "").
@@ -2623,6 +2627,8 @@ io.make_err_msg(Msg0, Msg, !IO) :-
"ML_make_err_msg").
:- pragma foreign_export("IL", make_err_msg(in, in, out, di, uo),
"ML_make_err_msg").
+:- pragma foreign_export("C#", make_err_msg(in, in, out, di, uo),
+ "ML_make_err_msg").
:- pragma foreign_proc("C",
make_err_msg(Error::in, Msg0::in, Msg::out, IO0::di, IO::uo),
@@ -2705,6 +2711,8 @@ have_dotnet :-
"ML_make_win32_err_msg").
:- pragma foreign_export("IL", make_win32_err_msg(in, in, out, di, uo),
"ML_make_win32_err_msg").
+:- pragma foreign_export("C#", make_win32_err_msg(in, in, out, di, uo),
+ "ML_make_win32_err_msg").
make_win32_err_msg(_, _, "", !IO) :-
( semidet_succeed ->
@@ -2869,12 +2877,13 @@ io.file_modification_time(File, Result, !IO) :-
"{
try {
System.DateTime t = System.IO.File.GetLastWriteTime(FileName);
- Time = mercury.time.mercury_code.ML_construct_time_t(t);
+ Time = time.ML_construct_time_t(t);
Msg = """";
Status = 1;
} catch (System.Exception e) {
Msg = ""GetLastWriteTime() failed: "" + e.Message;
+ Time = null;
Status = 0;
}
}").
@@ -3117,25 +3126,25 @@ file_type_implemented :-
if ((attrs & System.IO.FileAttributes.Directory) ==
System.IO.FileAttributes.Directory)
{
- Result = mercury.io.mercury_code.ML_make_io_res_1_ok_file_type(
- mercury.io.mercury_code.ML_file_type_directory());
+ Result = io.ML_make_io_res_1_ok_file_type(
+ io.ML_file_type_directory());
}
else if ((attrs & System.IO.FileAttributes.Device) ==
System.IO.FileAttributes.Device)
{
// XXX It may be a block device, but .NET doesn't
// distinguish between character and block devices.
- Result = mercury.io.mercury_code.ML_make_io_res_1_ok_file_type(
- mercury.io.mercury_code.ML_file_type_character_device());
+ Result = io.ML_make_io_res_1_ok_file_type(
+ io.ML_file_type_character_device());
}
else
{
- Result = mercury.io.mercury_code.ML_make_io_res_1_ok_file_type(
- mercury.io.mercury_code.ML_file_type_regular());
+ Result = io.ML_make_io_res_1_ok_file_type(
+ io.ML_file_type_regular());
}
} catch (System.Exception e) {
- mercury.io.mercury_code.ML_make_io_res_1_error_file_type(e,
- ""can't find file type: "", ref Result);
+ Result = io.ML_make_io_res_1_error_file_type(e,
+ ""can't find file type: "");
}
").
@@ -3229,20 +3238,28 @@ file_type_unknown = unknown.
"ML_file_type_character_device").
:- pragma foreign_export("IL", file_type_character_device = out,
"ML_file_type_character_device").
+:- pragma foreign_export("C#", file_type_character_device = out,
+ "ML_file_type_character_device").
:- pragma foreign_export("Erlang", file_type_character_device = out,
"ML_file_type_character_device").
:- pragma foreign_export("C", file_type_block_device = out,
"ML_file_type_block_device").
:- pragma foreign_export("IL", file_type_block_device = out,
"ML_file_type_block_device").
+:- pragma foreign_export("C#", file_type_block_device = out,
+ "ML_file_type_block_device").
:- pragma foreign_export("C", file_type_fifo = out,
"ML_file_type_fifo").
:- pragma foreign_export("IL", file_type_fifo = out,
"ML_file_type_fifo").
+:- pragma foreign_export("C#", file_type_fifo = out,
+ "ML_file_type_fifo").
:- pragma foreign_export("C", file_type_directory = out,
"ML_file_type_directory").
:- pragma foreign_export("IL", file_type_directory = out,
"ML_file_type_directory").
+:- pragma foreign_export("C#", file_type_directory = out,
+ "ML_file_type_directory").
:- pragma foreign_export("Java", file_type_directory = out,
"ML_file_type_directory").
:- pragma foreign_export("Erlang", file_type_directory = out,
@@ -3251,16 +3268,22 @@ file_type_unknown = unknown.
"ML_file_type_socket").
:- pragma foreign_export("IL", file_type_socket = out,
"ML_file_type_socket").
+:- pragma foreign_export("C#", file_type_socket = out,
+ "ML_file_type_socket").
:- pragma foreign_export("C", file_type_symbolic_link = out,
"ML_file_type_symbolic_link").
:- pragma foreign_export("IL", file_type_symbolic_link = out,
"ML_file_type_symbolic_link").
+:- pragma foreign_export("C#", file_type_symbolic_link = out,
+ "ML_file_type_symbolic_link").
:- pragma foreign_export("Erlang", file_type_symbolic_link = out,
"ML_file_type_symbolic_link").
:- pragma foreign_export("C", file_type_regular = out,
"ML_file_type_regular").
:- pragma foreign_export("IL", file_type_regular = out,
"ML_file_type_regular").
+:- pragma foreign_export("C#", file_type_regular = out,
+ "ML_file_type_regular").
:- pragma foreign_export("Java", file_type_regular = out,
"ML_file_type_regular").
:- pragma foreign_export("Erlang", file_type_regular = out,
@@ -3269,18 +3292,26 @@ file_type_unknown = unknown.
"ML_file_type_message_queue").
:- pragma foreign_export("IL", file_type_message_queue = out,
"ML_file_type_message_queue").
+:- pragma foreign_export("C#", file_type_message_queue = out,
+ "ML_file_type_message_queue").
:- pragma foreign_export("C", file_type_semaphore = out,
"ML_file_type_semaphore").
:- pragma foreign_export("IL", file_type_semaphore = out,
"ML_file_type_semaphore").
+:- pragma foreign_export("C#", file_type_semaphore = out,
+ "ML_file_type_semaphore").
:- pragma foreign_export("C", file_type_shared_memory = out,
"ML_file_type_shared_memory").
:- pragma foreign_export("IL", file_type_shared_memory = out,
"ML_file_type_shared_memory").
+:- pragma foreign_export("C#", file_type_shared_memory = out,
+ "ML_file_type_shared_memory").
:- pragma foreign_export("C", file_type_unknown = out,
"ML_file_type_unknown").
:- pragma foreign_export("IL", file_type_unknown = out,
"ML_file_type_unknown").
+:- pragma foreign_export("C#", file_type_unknown = out,
+ "ML_file_type_unknown").
:- pragma foreign_export("Java", file_type_unknown = out,
"ML_file_type_unknown").
:- pragma foreign_export("Erlang", file_type_unknown = out,
@@ -3539,10 +3570,10 @@ have_dotnet_exec_permission(Res, !IO) :-
(new System.Security.Permissions.SecurityPermission(
System.Security.Permissions.SecurityPermissionFlag.
AllFlags)).Demand();
- Result = mercury.io.mercury_code.ML_make_io_res_0_ok();
+ Result = io.ML_make_io_res_0_ok();
} catch (System.Exception e) {
- mercury.io.mercury_code.ML_make_io_res_0_error(e,
- ""execute permission check failed: "", ref Result);
+ Result = io.ML_make_io_res_0_error(e,
+ ""execute permission check failed: "");
}
}").
@@ -3594,10 +3625,9 @@ check_directory_accessibility_dotnet(_, _, _, Res, !IO) :-
throw (new System.Exception(""file is read-only""));
}
}
- Result = mercury.io.mercury_code.ML_make_io_res_0_ok();
+ Result = io.ML_make_io_res_0_ok();
} catch (System.Exception e) {
- mercury.io.mercury_code.ML_make_io_res_0_error(e,
- ""permission check failed: "", ref Result);
+ Result = io.ML_make_io_res_0_error(e, ""permission check failed: "");
}
}").
@@ -3606,6 +3636,8 @@ check_directory_accessibility_dotnet(_, _, _, Res, !IO) :-
"ML_access_types_includes_read").
:- pragma foreign_export("IL", access_types_includes_read(in),
"ML_access_types_includes_read").
+:- pragma foreign_export("C#", access_types_includes_read(in),
+ "ML_access_types_includes_read").
:- pragma foreign_export("Java", access_types_includes_read(in),
"ML_access_types_includes_read").
:- pragma foreign_export("Erlang", access_types_includes_read(in),
@@ -3619,6 +3651,8 @@ access_types_includes_read(Access) :-
"ML_access_types_includes_write").
:- pragma foreign_export("IL", access_types_includes_write(in),
"ML_access_types_includes_write").
+:- pragma foreign_export("C#", access_types_includes_write(in),
+ "ML_access_types_includes_write").
:- pragma foreign_export("Java", access_types_includes_write(in),
"ML_access_types_includes_write").
:- pragma foreign_export("Erlang", access_types_includes_write(in),
@@ -3632,6 +3666,8 @@ access_types_includes_write(Access) :-
"ML_access_types_includes_execute").
:- pragma foreign_export("IL", access_types_includes_execute(in),
"ML_access_types_includes_execute").
+:- pragma foreign_export("C#", access_types_includes_execute(in),
+ "ML_access_types_includes_execute").
:- pragma foreign_export("Java", access_types_includes_execute(in),
"ML_access_types_includes_execute").
:- pragma foreign_export("Erlang", access_types_includes_execute(in),
@@ -3645,6 +3681,8 @@ access_types_includes_execute(Access) :-
"ML_make_io_res_0_ok").
:- pragma foreign_export("IL", (make_io_res_0_ok = out),
"ML_make_io_res_0_ok").
+:- pragma foreign_export("C#", (make_io_res_0_ok = out),
+ "ML_make_io_res_0_ok").
:- pragma foreign_export("Java", (make_io_res_0_ok = out),
"ML_make_io_res_0_ok").
:- pragma foreign_export("Erlang", (make_io_res_0_ok = out),
@@ -3658,6 +3696,8 @@ make_io_res_0_ok = ok.
"ML_make_io_res_0_error").
:- pragma foreign_export("IL", make_io_res_0_error(in, in, out, di, uo),
"ML_make_io_res_0_error").
+:- pragma foreign_export("C#", make_io_res_0_error(in, in, out, di, uo),
+ "ML_make_io_res_0_error").
:- pragma foreign_export("Java", make_io_res_0_error(in, in, out, di, uo),
"ML_make_io_res_0_error").
:- pragma foreign_export("Erlang", make_io_res_0_error(in, in, out, di, uo),
@@ -3671,6 +3711,8 @@ make_io_res_0_error(Error, Msg0, error(make_io_error(Msg)), !IO) :-
"ML_make_io_res_0_error_msg").
:- pragma foreign_export("IL", (make_io_res_0_error_msg(in) = out),
"ML_make_io_res_0_error_msg").
+:- pragma foreign_export("C#", (make_io_res_0_error_msg(in) = out),
+ "ML_make_io_res_0_error_msg").
:- pragma foreign_export("Java", (make_io_res_0_error_msg(in) = out),
"ML_make_io_res_0_error_msg").
@@ -3681,6 +3723,8 @@ make_io_res_0_error_msg(Msg) = error(make_io_error(Msg)).
"ML_make_io_res_1_ok_file_type").
:- pragma foreign_export("IL", (make_io_res_1_ok_file_type(in) = out),
"ML_make_io_res_1_ok_file_type").
+:- pragma foreign_export("C#", (make_io_res_1_ok_file_type(in) = out),
+ "ML_make_io_res_1_ok_file_type").
:- pragma foreign_export("Java", (make_io_res_1_ok_file_type(in) = out),
"ML_make_io_res_1_ok_file_type").
:- pragma foreign_export("Erlang", (make_io_res_1_ok_file_type(in) = out),
@@ -3696,6 +3740,9 @@ make_io_res_1_ok_file_type(FileType) = ok(FileType).
:- pragma foreign_export("IL",
make_io_res_1_error_file_type(in, in, out, di, uo),
"ML_make_io_res_1_error_file_type").
+:- pragma foreign_export("C#",
+ make_io_res_1_error_file_type(in, in, out, di, uo),
+ "ML_make_io_res_1_error_file_type").
:- pragma foreign_export("Java",
make_io_res_1_error_file_type(in, in, out, di, uo),
"ML_make_io_res_1_error_file_type").
@@ -4586,6 +4633,8 @@ io.write_many(Stream, [f(F) | Rest], !IO) :-
"ML_io_print_to_cur_stream").
:- pragma foreign_export("IL", io.print(in, di, uo),
"ML_io_print_to_cur_stream").
+:- pragma foreign_export("C#", io.print(in, di, uo),
+ "ML_io_print_to_cur_stream").
:- pragma foreign_export("Java", io.print(in, di, uo),
"ML_io_print_to_cur_stream").
@@ -5648,10 +5697,8 @@ void mercury_close(MercuryFilePtr mf);
int ML_fprintf(MercuryFilePtr mf, const char *format, ...);
").
-:- pragma foreign_decl("C#", "
+:- pragma foreign_code("C#", "
-namespace mercury {
- namespace io__csharp_code {
public enum ML_file_encoding_kind {
ML_OS_text_encoding, // file stores characters,
// using the operating system's
@@ -5687,8 +5734,6 @@ namespace mercury {
public int line_number;
public int id;
};
- }
-}
").
:- pragma foreign_code("Java",
@@ -6813,7 +6858,7 @@ static MR_MercuryFileStruct mercury_open(string filename, string openmode,
mode = System.IO.FileMode.Append;
access = System.IO.FileAccess.Write;
} else {
- mercury.runtime.Errors.SORRY(System.String.Concat(
+ runtime.Errors.SORRY(System.String.Concat(
""foreign code for this function, open mode:"",
openmode));
// Needed to convince the C# compiler that mode and
@@ -7001,7 +7046,7 @@ mercury_print_binary_string(MR_MercuryFileStruct mf, string s)
{
// sanity check
if (mf.file_encoding != ML_file_encoding_kind.ML_raw_binary) {
- mercury.runtime.Errors.fatal_error(
+ runtime.Errors.fatal_error(
""mercury_print_binary_string: file encoding is not raw binary"");
}
@@ -7042,7 +7087,7 @@ mercury_print_binary_string(MR_MercuryFileStruct mf, string s)
for (int i = 0; i < len; i++) {
byte_array[i] = (byte) s[i];
if (byte_array[i] != s[i]) {
- mercury.runtime.Errors.SORRY(
+ runtime.Errors.SORRY(
""write_bytes: Unicode char does not fit in a byte"");
}
}
@@ -7117,7 +7162,7 @@ mercury_getc(MR_MercuryFileStruct mf)
}
break;
default:
- mercury.runtime.Errors.SORRY(
+ runtime.Errors.SORRY(
""mercury_getc: Environment.NewLine.Length"" +
""is neither 1 nor 2"");
break;
@@ -7132,7 +7177,7 @@ static void
mercury_ungetc(MR_MercuryFileStruct mf, int code)
{
if (mf.putback != -1) {
- mercury.runtime.Errors.SORRY(
+ runtime.Errors.SORRY(
""mercury_ungetc: max one character of putback"");
}
mf.putback = code;
@@ -7445,7 +7490,7 @@ io.putback_byte(binary_input_stream(Stream), Character, !IO) :-
"{
MR_MercuryFileStruct mf = File;
if (mf.putback != -1) {
- mercury.runtime.Errors.SORRY(
+ runtime.Errors.SORRY(
""io.putback_byte: max one character of putback"");
}
mf.putback = Byte;
@@ -9631,10 +9676,10 @@ io.handle_system_command_exit_code(Status0::in) = (Status::out) :-
"
string[] arg_vector = System.Environment.GetCommandLineArgs();
int i = arg_vector.Length;
- Args = mercury.list.mercury_code.ML_empty_list(null);
+ Args = list.empty_list();
// We don't get the 0th argument: it is the executable name.
while (--i > 0) {
- Args = mercury.list.mercury_code.ML_cons(null, arg_vector[i], Args);
+ Args = list.cons(arg_vector[i], Args);
}
").
@@ -9922,7 +9967,9 @@ io.setenv(Var, Value) :-
** Currently we use the Posix function putenv(), which is also supported
** on Windows.
*/
- SUCCESS_INDICATOR = (mercury.runtime.PInvoke._putenv(VarAndValue) == 0);
+ // XXX C# todo
+ // SUCCESS_INDICATOR = (runtime.PInvoke._putenv(VarAndValue) == 0);
+ SUCCESS_INDICATOR = false;
").
:- pragma foreign_proc("Java",
diff --git a/library/library.m b/library/library.m
index 99f4bb1..fa403a9 100644
--- a/library/library.m
+++ b/library/library.m
@@ -192,8 +192,8 @@
library.version(Version::out),
[will_not_call_mercury, promise_pure],
"
- Version = mercury.runtime.Constants.MR_VERSION + "" configured for ""
- + mercury.runtime.Constants.MR_FULLARCH;
+ Version = runtime.Constants.MR_VERSION + "" configured for ""
+ + runtime.Constants.MR_FULLARCH;
").
:- pragma foreign_proc("Java",
diff --git a/library/list.m b/library/list.m
index a112c37..2af5c27 100644
--- a/library/list.m
+++ b/library/list.m
@@ -2945,4 +2945,33 @@ public static class ListIterator<E>
").
%-----------------------------------------------------------------------------%
+
+:- pragma foreign_code("C#", "
+public static List_1 empty_list()
+{
+ return new List_1.F_nil_0();
+}
+
+public static List_1 cons(object head, List_1 tail)
+{
+ return new List_1.F_cons_2(head, tail);
+}
+
+public static bool is_empty(List_1 lst)
+{
+ return (lst is List_1.F_nil_0);
+}
+
+public static object det_head(List_1 lst)
+{
+ return ((List_1.F_cons_2) lst).F1;
+}
+
+public static List_1 det_tail(List_1 lst)
+{
+ return ((List_1.F_cons_2) lst).F2;
+}
+").
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
diff --git a/library/mutvar.m b/library/mutvar.m
index a70360b..b972a85 100644
--- a/library/mutvar.m
+++ b/library/mutvar.m
@@ -112,6 +112,8 @@ new_mutvar(X, Ref) :-
% C# implementation
%
+% :- pragma foreign_type("C#", mutvar(T), "object[]").
+
:- pragma foreign_proc("C#",
new_mutvar0(Ref::uo),
[will_not_call_mercury, thread_safe],
diff --git a/library/par_builtin.m b/library/par_builtin.m
index a1b6939..8db43e0 100644
--- a/library/par_builtin.m
+++ b/library/par_builtin.m
@@ -122,6 +122,7 @@
% Placeholder only.
:- pragma foreign_type(il, future(T), "class [mscorlib]System.Object").
:- pragma foreign_type("Erlang", future(T), "").
+% :- pragma foreign_type("C#", future(T), "object").
:- pragma foreign_type("Java", future(T), "java.lang.Object").
%-----------------------------------------------------------------------------%
diff --git a/library/private_builtin.m b/library/private_builtin.m
index 41973c9..3ebf43a 100644
--- a/library/private_builtin.m
+++ b/library/private_builtin.m
@@ -409,20 +409,22 @@ typed_compare(R, X, Y) :-
:- pragma foreign_code("C#", "
-public static object[] MR_typeclass_info_param_type_info(object[] tcinfo,
- int index)
+public static runtime.TypeInfo_Struct
+MR_typeclass_info_param_type_info(object[] tcinfo, int index)
{
object[] tmp;
int t1;
tmp = (object[]) tcinfo[0];
t1 = System.Convert.ToInt32(tmp[0]) + index;
- return (object[]) tcinfo[t1];
+ return (runtime.TypeInfo_Struct) tcinfo[t1];
}
-public static object[] MR_typeclass_info_instance_tvar_type_info(
+
+public static runtime.TypeInfo_Struct
+MR_typeclass_info_instance_tvar_type_info(
object[] tcinfo, int index)
{
- return (object[]) tcinfo[index];
+ return (runtime.TypeInfo_Struct) tcinfo[index];
}
public static object[] MR_typeclass_info_superclass_info(
@@ -488,131 +490,182 @@ MR_typeclass_info_arg_typeclass_info(
:- pragma foreign_code("C#", "
- // XXX These static constants are duplicated both here and in
- // mercury_dotnet.cs.in.
-
- // This is because other library modules reference them
- // from .NET code (so they depend on the versions in the runtime to
- // make the dependencies simple) whereas the compiler generates
- // references to the ones here.
-
- // See runtime/mercury_dotnet.cs.in for discussion of why we aren't
- // using enums or const static ints here.
-
-public static int MR_TYPECTOR_REP_ENUM = 0;
-public static int MR_TYPECTOR_REP_ENUM_USEREQ = 1;
-public static int MR_TYPECTOR_REP_DU = 2;
-public static int MR_TYPECTOR_REP_DU_USEREQ = 3;
-public static int MR_TYPECTOR_REP_NOTAG = 4;
-public static int MR_TYPECTOR_REP_NOTAG_USEREQ = 5;
-public static int MR_TYPECTOR_REP_EQUIV = 6;
-public static int MR_TYPECTOR_REP_FUNC = 7;
-public static int MR_TYPECTOR_REP_INT = 8;
-public static int MR_TYPECTOR_REP_CHAR = 9;
-public static int MR_TYPECTOR_REP_FLOAT =10;
-public static int MR_TYPECTOR_REP_STRING =11;
-public static int MR_TYPECTOR_REP_PRED =12;
-public static int MR_TYPECTOR_REP_SUBGOAL =13;
-public static int MR_TYPECTOR_REP_VOID =14;
-public static int MR_TYPECTOR_REP_C_POINTER =15;
-public static int MR_TYPECTOR_REP_TYPEINFO =16;
-public static int MR_TYPECTOR_REP_TYPECLASSINFO =17;
-public static int MR_TYPECTOR_REP_ARRAY =18;
-public static int MR_TYPECTOR_REP_SUCCIP =19;
-public static int MR_TYPECTOR_REP_HP =20;
-public static int MR_TYPECTOR_REP_CURFR =21;
-public static int MR_TYPECTOR_REP_MAXFR =22;
-public static int MR_TYPECTOR_REP_REDOFR =23;
-public static int MR_TYPECTOR_REP_REDOIP =24;
-public static int MR_TYPECTOR_REP_TRAIL_PTR =25;
-public static int MR_TYPECTOR_REP_TICKET =26;
-public static int MR_TYPECTOR_REP_NOTAG_GROUND =27;
-public static int MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ =28;
-public static int MR_TYPECTOR_REP_EQUIV_GROUND =29;
-public static int MR_TYPECTOR_REP_TUPLE =30;
-public static int MR_TYPECTOR_REP_RESERVED_ADDR =31;
-public static int MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ =32;
-public static int MR_TYPECTOR_REP_TYPECTORINFO =33;
-public static int MR_TYPECTOR_REP_BASETYPECLASSINFO =34;
-public static int MR_TYPECTOR_REP_TYPEDESC =35;
-public static int MR_TYPECTOR_REP_TYPECTORDESC =36;
-public static int MR_TYPECTOR_REP_FOREIGN =37;
-public static int MR_TYPECTOR_REP_REFERENCE =38;
-public static int MR_TYPECTOR_REP_STABLE_C_POINTER =39;
-public static int MR_TYPECTOR_REP_STABLE_FOREIGN =40;
-public static int MR_TYPECTOR_REP_PSEUDOTYPEDESC =41;
-public static int MR_TYPECTOR_REP_DUMMY =42;
-public static int MR_TYPECTOR_REP_BITMAP =43;
-public static int MR_TYPECTOR_REP_FOREIGN_ENUM =44;
-public static int MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ =45;
-public static int MR_TYPECTOR_REP_UNKNOWN =46;
-
-public static int MR_SECTAG_NONE = 0;
-public static int MR_SECTAG_LOCAL = 1;
-public static int MR_SECTAG_REMOTE = 2;
-public static int MR_SECTAG_VARIABLE = 3;
-
-public static int MR_PREDICATE = 0;
-public static int MR_FUNCTION = 1;
+public class Ref_1
+{
+ // XXX stub only
+}
+
+public class Heap_pointer_0
+{
+ // XXX stub only
+}
public static bool
-special__Unify____type_info_1_0(
- object[] type_info, object[] x, object[] y)
+__Unify____ref_1_0(runtime.TypeInfo_Struct ti,
+ private_builtin.Ref_1 x, private_builtin.Ref_1 y)
+{
+ runtime.Errors.SORRY(""unify for ref"");
+ return false;
+}
+
+public static builtin.Comparison_result_0
+__Compare____ref_1_0(runtime.TypeInfo_Struct ti,
+ private_builtin.Ref_1 x, private_builtin.Ref_1 y)
+{
+ runtime.Errors.SORRY(""compare for ref"");
+ return builtin.Comparison_result_0.f_equal;
+}
+
+public static bool
+__Unify____heap_pointer_0_0(
+ private_builtin.Heap_pointer_0 x, private_builtin.Heap_pointer_0 y)
+{
+ runtime.Errors.SORRY(""unify for heap_pointer"");
+ return false;
+}
+
+public static builtin.Comparison_result_0
+__Compare____heap_pointer_0_0(
+ private_builtin.Heap_pointer_0 x, private_builtin.Heap_pointer_0 y)
+{
+ runtime.Errors.SORRY(""unify for heap_pointer"");
+ return builtin.Comparison_result_0.f_equal;
+}
+
+public static bool
+__Unify____type_info_0_0(
+ runtime.TypeInfo_Struct x,
+ runtime.TypeInfo_Struct y)
+{
+ runtime.Errors.SORRY(""unify for type_info"");
+ return false;
+}
+
+public static bool
+__Unify____type_info_1_0(
+ object[] type_info,
+ runtime.TypeInfo_Struct x,
+ runtime.TypeInfo_Struct y)
+{
+ runtime.Errors.SORRY(""unify for type_info"");
+ return false;
+}
+
+public static bool
+__Unify____typeclass_info_0_0(
+ object[] x, object[] y)
{
- mercury.runtime.Errors.SORRY(""unify for type_info"");
+ runtime.Errors.SORRY(""unify for typeclass_info"");
return false;
}
public static bool
-special__Unify____typeclass_info_1_0(
+__Unify____typeclass_info_1_0(
object[] type_info, object[] x, object[] y)
{
- mercury.runtime.Errors.SORRY(""unify for typeclass_info"");
+ runtime.Errors.SORRY(""unify for typeclass_info"");
return false;
}
public static bool
-special__Unify____base_typeclass_info_1_0(
+__Unify____base_typeclass_info_0_0(
+ object[] x, object[] y)
+{
+ runtime.Errors.SORRY(""unify for base_typeclass_info"");
+ return false;
+}
+
+public static bool
+__Unify____base_typeclass_info_1_0(
object[] type_info, object[] x, object[] y)
{
- mercury.runtime.Errors.SORRY(""unify for base_typeclass_info"");
+ runtime.Errors.SORRY(""unify for base_typeclass_info"");
+ return false;
+}
+
+public static bool
+__Unify____type_ctor_info_0_0(
+ runtime.TypeCtorInfo_Struct x,
+ runtime.TypeCtorInfo_Struct y)
+{
+ runtime.Errors.SORRY(""unify for type_ctor_info"");
return false;
}
public static bool
-special__Unify____type_ctor_info_1_0(
+__Unify____type_ctor_info_1_0(
object[] type_info, object[] x, object[] y)
{
- mercury.runtime.Errors.SORRY(""unify for type_ctor_info"");
+ runtime.Errors.SORRY(""unify for type_ctor_info"");
return false;
}
-public static void
-special__Compare____type_ctor_info_1_0(
- object[] type_info, ref object[] result, object[] x, object[] y)
+public static builtin.Comparison_result_0
+__Compare____type_ctor_info_0_0(
+ runtime.TypeCtorInfo_Struct x,
+ runtime.TypeCtorInfo_Struct y)
{
- mercury.runtime.Errors.SORRY(""compare for type_ctor_info"");
+ runtime.Errors.SORRY(""compare for type_ctor_info"");
+ return builtin.Comparison_result_0.f_equal;
}
-public static void
-special__Compare____type_info_1_0(
- object[] type_info, ref object[] result, object[] x, object[] y)
+public static builtin.Comparison_result_0
+__Compare____type_ctor_info_1_0(
+ object[] type_info, object[] x, object[] y)
{
- mercury.runtime.Errors.SORRY(""compare for type_info"");
+ runtime.Errors.SORRY(""compare for type_ctor_info"");
+ return builtin.Comparison_result_0.f_equal;
}
-public static void
-special__Compare____typeclass_info_1_0(
- object[] type_info, ref object[] result, object[] x, object[] y)
+public static builtin.Comparison_result_0
+__Compare____type_info_0_0(
+ runtime.TypeInfo_Struct x,
+ runtime.TypeInfo_Struct y)
{
- mercury.runtime.Errors.SORRY(""compare for typeclass_info"");
+ runtime.Errors.SORRY(""compare for type_info"");
+ return builtin.Comparison_result_0.f_equal;
}
-public static void
-special__Compare____base_typeclass_info_1_0(
- object[] type_info, ref object[] result, object[] x, object[] y)
+public static builtin.Comparison_result_0
+__Compare____type_info_1_0(
+ object[] type_info,
+ runtime.TypeInfo_Struct x,
+ runtime.TypeInfo_Struct y)
+{
+ runtime.Errors.SORRY(""compare for type_info"");
+ return builtin.Comparison_result_0.f_equal;
+}
+
+public static builtin.Comparison_result_0
+__Compare____typeclass_info_0_0(
+ object[] x, object[] y)
+{
+ runtime.Errors.SORRY(""compare for typeclass_info"");
+ return builtin.Comparison_result_0.f_equal;
+}
+
+public static builtin.Comparison_result_0
+__Compare____typeclass_info_1_0(
+ object[] type_info, object[] x, object[] y)
+{
+ runtime.Errors.SORRY(""compare for typeclass_info"");
+ return builtin.Comparison_result_0.f_equal;
+}
+
+public static builtin.Comparison_result_0
+__Compare____base_typeclass_info_0_0(
+ object[] x, object[] y)
+{
+ runtime.Errors.SORRY(""compare for base_typeclass_info"");
+ return builtin.Comparison_result_0.f_equal;
+}
+
+public static builtin.Comparison_result_0
+__Compare____base_typeclass_info_1_0(
+ object[] type_info, object[] x, object[] y)
{
- mercury.runtime.Errors.SORRY(""compare for base_typeclass_info"");
+ runtime.Errors.SORRY(""compare for base_typeclass_info"");
+ return builtin.Comparison_result_0.f_equal;
}
").
@@ -912,7 +965,7 @@ special__Compare____base_typeclass_info_1_0(
[will_not_call_mercury, thread_safe],
"
#if MR_USE_TRAIL
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
+ runtime.Errors.SORRY(""foreign code for this function"");
// MR_store_ticket(Ticket);
#else
Ticket = null;
@@ -924,7 +977,7 @@ special__Compare____base_typeclass_info_1_0(
[will_not_call_mercury, thread_safe],
"
#if MR_USE_TRAIL
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
+ runtime.Errors.SORRY(""foreign code for this function"");
// MR_reset_ticket(Ticket, MR_undo);
#endif
").
@@ -934,7 +987,7 @@ special__Compare____base_typeclass_info_1_0(
[will_not_call_mercury, thread_safe],
"
#if MR_USE_TRAIL
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
+ runtime.Errors.SORRY(""foreign code for this function"");
// MR_reset_ticket(Ticket, MR_commit);
#endif
").
@@ -944,7 +997,7 @@ special__Compare____base_typeclass_info_1_0(
[will_not_call_mercury, thread_safe],
"
#if MR_USE_TRAIL
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
+ runtime.Errors.SORRY(""foreign code for this function"");
// MR_reset_ticket(Ticket, MR_solve);
#endif
").
@@ -954,7 +1007,7 @@ special__Compare____base_typeclass_info_1_0(
[will_not_call_mercury, thread_safe],
"
#if MR_USE_TRAIL
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
+ runtime.Errors.SORRY(""foreign code for this function"");
// MR_discard_ticket();
#endif
").
@@ -964,7 +1017,7 @@ special__Compare____base_typeclass_info_1_0(
[will_not_call_mercury, thread_safe],
"
#if MR_USE_TRAIL
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
+ runtime.Errors.SORRY(""foreign code for this function"");
// MR_prune_ticket();
#endif
").
@@ -974,7 +1027,7 @@ special__Compare____base_typeclass_info_1_0(
[will_not_call_mercury, thread_safe],
"
#if MR_USE_TRAIL
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
+ runtime.Errors.SORRY(""foreign code for this function"");
// MR_mark_ticket_stack(TicketCounter);
#else
TicketCounter = null;
@@ -986,7 +1039,7 @@ special__Compare____base_typeclass_info_1_0(
[will_not_call_mercury, thread_safe],
"
#if MR_USE_TRAIL
- mercury.runtime.Errors.SORRY(""foreign code for this function"");
+ runtime.Errors.SORRY(""foreign code for this function"");
// MR_prune_tickets_to(TicketCounter);
#endif
").
@@ -1341,33 +1394,33 @@ reclaim_heap_nondet_pragma_foreign_code :-
:- pragma foreign_code("C#", "
public static bool
-special__Unify__private_builtin__heap_pointer_0_0(object[] x, object[] y)
+__Unify__private_builtin__heap_pointer_0_0(object[] x, object[] y)
{
- mercury.runtime.Errors.fatal_error(
+ runtime.Errors.fatal_error(
""called unify for type `private_builtin:heap_pointer'"");
return false;
}
public static void
-special__Compare__private_builtin__heap_pointer_0_0(
+__Compare__private_builtin__heap_pointer_0_0(
ref object[] result, object[] x, object[] y)
{
- mercury.runtime.Errors.fatal_error(
+ runtime.Errors.fatal_error(
""called compare/3 for type `private_builtin:heap_pointer'"");
}
public static bool
-special__Unify__private_builtin__ref_1_0(
+__Unify__private_builtin__ref_1_0(
object[] type_info, object[] x, object[] y)
{
return x == y;
}
public static void
-special__Compare__private_builtin__ref_1_0(
+__Compare__private_builtin__ref_1_0(
object[] type_info, ref object[] result, object[] x, object[] y)
{
- mercury.runtime.Errors.fatal_error(
+ runtime.Errors.fatal_error(
""called compare/3 for type `private_builtin.ref'"");
}
diff --git a/library/region_builtin.m b/library/region_builtin.m
index 5399e97..2dc408e 100644
--- a/library/region_builtin.m
+++ b/library/region_builtin.m
@@ -52,6 +52,8 @@
:- pragma foreign_type("C", region, "MR_RegionHeader *",
[can_pass_as_mercury_type]).
+% :- pragma foreign_type("C#", region, "object"). % dummy
+
:- pragma foreign_type("Java", region, "java.lang.Object"). % dummy
:- pragma foreign_type("Erlang", region, ""). % dummy
diff --git a/library/rtti_implementation.m b/library/rtti_implementation.m
index 743bb07..83519c7 100644
--- a/library/rtti_implementation.m
+++ b/library/rtti_implementation.m
@@ -183,25 +183,37 @@
% We keep all the other types abstract.
:- type type_ctor_info ---> type_ctor_info(c_pointer).
+% :- pragma foreign_type("C#", type_ctor_info,
+% "runtime.TypeCtorInfo_Struct").
:- pragma foreign_type("Java", type_ctor_info,
"jmercury.runtime.TypeCtorInfo_Struct").
:- type type_info ---> type_info(c_pointer).
+% :- pragma foreign_type("C#", type_info, "runtime.TypeInfo_Struct").
:- pragma foreign_type("Java", type_info, "jmercury.runtime.TypeInfo_Struct").
:- type type_layout ---> type_layout(c_pointer).
+% :- pragma foreign_type("C#", type_layout, "runtime.TypeLayout").
:- pragma foreign_type("Java", type_layout, "jmercury.runtime.TypeLayout").
:- type pseudo_type_info ---> pseudo_type_info(int).
% This should be a dummy type. The non-dummy definition is a workaround
% for a bug in the Erlang backend that generates invalid code for the
% dummy type.
+% :- pragma foreign_type("C#", pseudo_type_info,
+% "runtime.PseudoTypeInfo").
:- pragma foreign_type("Java", pseudo_type_info,
"jmercury.runtime.PseudoTypeInfo").
:- type typeclass_info ---> typeclass_info(c_pointer).
+% :- pragma foreign_type("C#", typeclass_info, "object[]").
:- pragma foreign_type("Java", typeclass_info, "java.lang.Object[]").
+:- pragma foreign_decl("C#", local,
+"
+ using mercury.runtime;
+").
+
:- pragma foreign_decl("Java", local,
"
import java.lang.reflect.Constructor;
@@ -445,6 +457,23 @@ create_pseudo_type_info(TypeInfo, PseudoTypeInfo) = ArgPseudoTypeInfo :-
:- func make_type_info(type_ctor_info, int, list(pseudo_type_info)) =
type_info.
+:- pragma foreign_proc("C#",
+ make_type_info(TypeCtorInfo::in, Arity::in, Args::in) = (TypeInfo::out),
+ [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
+"
+ PseudoTypeInfo[] args = new PseudoTypeInfo[Arity];
+ int i = 0;
+ list.List_1 lst = Args;
+ while (!list.is_empty(lst)) {
+ args[i] = (PseudoTypeInfo) list.det_head(lst);
+ lst = list.det_tail(lst);
+ i++;
+ }
+
+ TypeInfo = new TypeInfo_Struct();
+ TypeInfo.init(TypeCtorInfo, Arity, args);
+").
+
:- pragma foreign_proc("Java",
make_type_info(TypeCtorInfo::in, Arity::in, Args::in) = (TypeInfo::out),
[will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
@@ -626,7 +655,11 @@ get_type_info(_) = _ :-
get_var_arity_typeinfo_arity(TypeInfo::in) = (Arity::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ Arity = TypeInfo.args.Length;
+#else
Arity = (int) TypeInfo[(int) var_arity_ti.arity];
+#endif
").
get_var_arity_typeinfo_arity(_) = _ :-
@@ -810,6 +843,7 @@ compare_tuple_pos(Loc, TupleArity, TypeInfo, Result, TermA, TermB) :-
:- type unify_or_compare_pred
---> unify_or_compare_pred.
+% :- pragma foreign_type("C#", unify_or_compare_pred, "object").
:- pragma foreign_type("Java", unify_or_compare_pred,
"jmercury.runtime.MethodPtr").
@@ -879,84 +913,113 @@ result_call_9(_::in, (=)::out, _::in, _::in, _::in, _::in, _::in,
semidet_call_3(Pred::in, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
- SUCCESS_INDICATOR =
- mercury.runtime.GenericCall.semidet_call_3(Pred, X, Y);
+ runtime.MethodPtr2<object, object, bool> pred
+ = (runtime.MethodPtr2<object, object, bool>) Pred;
+ SUCCESS_INDICATOR = pred(X, Y);
").
:- pragma foreign_proc("C#",
semidet_call_4(Pred::in, A::in, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
- SUCCESS_INDICATOR =
- mercury.runtime.GenericCall.semidet_call_4(Pred, A, X, Y);
+ runtime.MethodPtr3<object, object, object, bool> pred
+ = (runtime.MethodPtr3<object, object, object, bool>) Pred;
+ SUCCESS_INDICATOR = pred(A, X, Y);
").
:- pragma foreign_proc("C#",
semidet_call_5(Pred::in, A::in, B::in, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
- SUCCESS_INDICATOR =
- mercury.runtime.GenericCall.semidet_call_5(Pred, A, B, X, Y);
+ runtime.MethodPtr4<object, object, object, object, bool> pred
+ = (runtime.MethodPtr4<object, object, object, object, bool>) Pred;
+ SUCCESS_INDICATOR = pred(A, B, X, Y);
").
:- pragma foreign_proc("C#",
semidet_call_6(Pred::in, A::in, B::in, C::in, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
- SUCCESS_INDICATOR =
- mercury.runtime.GenericCall.semidet_call_6(Pred, A, B, C, X, Y);
+ runtime.MethodPtr5<object, object, object, object, object, bool> pred
+ = (runtime.MethodPtr5<object, object, object, object, object, bool>)
+ Pred;
+ SUCCESS_INDICATOR = pred(A, B, C, X, Y);
").
:- pragma foreign_proc("C#",
semidet_call_7(Pred::in, A::in, B::in, C::in, D::in, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
- SUCCESS_INDICATOR =
- mercury.runtime.GenericCall.semidet_call_7(Pred, A, B, C, D, X, Y);
+ runtime.MethodPtr6<object, object, object, object, object, object, bool>
+ pred
+ = (runtime.MethodPtr6<object, object, object, object, object, object,
+ bool>) Pred;
+ SUCCESS_INDICATOR = pred(A, B, C, D, X, Y);
").
:- pragma foreign_proc("C#",
semidet_call_8(Pred::in, A::in, B::in, C::in, D::in, E::in,
X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
- SUCCESS_INDICATOR =
- mercury.runtime.GenericCall.semidet_call_8(Pred, A, B, C, D, E, X, Y);
+ runtime.MethodPtr7<object, object, object, object, object, object, object,
+ bool> pred =
+ (runtime.MethodPtr7<object, object, object, object, object, object,
+ object, bool>) Pred;
+ SUCCESS_INDICATOR = pred(A, B, C, D, E, X, Y);
").
:- pragma foreign_proc("C#",
result_call_4(Pred::in, Res::out, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
- mercury.runtime.GenericCall.result_call_4(Pred, ref Res, X, Y);
+ // XXX C# should the return type be object of Comparison_result_0?
+ runtime.MethodPtr2<object, object, object> pred
+ = (runtime.MethodPtr2<object, object, object>) Pred;
+ Res = (builtin.Comparison_result_0) pred(X, Y);
").
:- pragma foreign_proc("C#",
result_call_5(Pred::in, Res::out, A::in, X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
- mercury.runtime.GenericCall.result_call_5(Pred, A, ref Res, X, Y);
+ runtime.MethodPtr3<object, object, object, object> pred
+ = (runtime.MethodPtr3<object, object, object, object>) Pred;
+ Res = (builtin.Comparison_result_0) pred(A, 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],
"
- mercury.runtime.GenericCall.result_call_6(Pred, A, B, ref Res, X, Y);
+ runtime.MethodPtr4<object, object, object, object, object> pred
+ = (runtime.MethodPtr4<object, object, object, object, object>) Pred;
+ Res = (builtin.Comparison_result_0) pred(A, B, 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],
"
- mercury.runtime.GenericCall.result_call_7(Pred, A, B, C, ref Res, X, Y);
+ runtime.MethodPtr5<object, object, object, object, object, object> pred
+ = (runtime.MethodPtr5<object, object, object, object, object, object>)
+ Pred;
+ Res = (builtin.Comparison_result_0) pred(A, B, C, 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],
"
- mercury.runtime.GenericCall.result_call_8(Pred, A, B, C, D, ref Res, X, Y);
+ runtime.MethodPtr6<object, object, object, object, object, object,
+ object> pred
+ = (runtime.MethodPtr6<object, object, object, object, object, object,
+ object>) Pred;
+ Res = (builtin.Comparison_result_0) pred(A, B, C, D, X, Y);
+
").
:- pragma foreign_proc("C#",
result_call_9(Pred::in, Res::out, A::in, B::in, C::in, D::in, E::in,
X::in, Y::in),
[will_not_call_mercury, promise_pure, thread_safe],
"
- mercury.runtime.GenericCall.result_call_9(Pred, A, B, C, D, E, ref Res,
- X, Y);
+ runtime.MethodPtr7<object, object, object, object, object, object,
+ object, object> pred
+ = (runtime.MethodPtr7<object, object, object, object, object, object,
+ object, object>) Pred;
+ Res = (builtin.Comparison_result_0) pred(A, B, C, D, E, X, Y);
").
%-----------------------------------------------------------------------------%
@@ -1055,6 +1118,8 @@ result_call_9(_::in, (=)::out, _::in, _::in, _::in, _::in, _::in,
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+% :- pragma foreign_export("C#", compare_type_infos(out, in, in),
+% "ML_compare_type_infos").
:- pragma foreign_export("Java", compare_type_infos(out, in, in),
"ML_compare_type_infos").
@@ -1120,6 +1185,8 @@ compare_collapsed_type_infos(Res, TypeInfo1, TypeInfo2) :-
:- pred compare_type_ctor_infos(comparison_result::out,
type_ctor_info::in, type_ctor_info::in) is det.
+% :- pragma foreign_export("C#", compare_type_ctor_infos(out, in, in),
+% "ML_compare_type_ctor_infos").
:- pragma foreign_export("Java", compare_type_ctor_infos(out, in, in),
"ML_compare_type_ctor_infos").
@@ -1187,6 +1254,8 @@ type_ctor_is_variable_arity(TypeCtorInfo) :-
%-----------------------------------------------------------------------------%
:- func collapse_equivalences(type_info) = type_info.
+% :- pragma foreign_export("C#", collapse_equivalences(in) = out,
+% "ML_collapse_equivalences").
:- pragma foreign_export("Java", collapse_equivalences(in) = out,
"ML_collapse_equivalences").
@@ -1210,6 +1279,14 @@ collapse_equivalences(TypeInfo) = NewTypeInfo :-
:- func get_layout_equiv(type_layout) = type_info.
+:- pragma foreign_proc("C#",
+ get_layout_equiv(TypeLayout::in) = (TypeInfo::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ runtime.PseudoTypeInfo pti = TypeLayout.layout_equiv();
+ TypeInfo = runtime.TypeInfo_Struct.maybe_new(pti);
+").
+
:- pragma foreign_proc("Java",
get_layout_equiv(TypeLayout::in) = (TypeInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -1255,6 +1332,36 @@ iterate(Start, Max, Func) = Results :-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+:- pragma foreign_proc("C#",
+ pseudo_type_ctor_and_args(PseudoTypeInfo::in, TypeCtorInfo::out,
+ ArgPseudoTypeInfos::out),
+ [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
+"
+ if (PseudoTypeInfo.variable_number == -1) {
+ if (PseudoTypeInfo is TypeCtorInfo_Struct) {
+ TypeCtorInfo = (TypeCtorInfo_Struct) PseudoTypeInfo;
+ ArgPseudoTypeInfos = list.empty_list();
+ } else {
+ TypeInfo_Struct ti = (TypeInfo_Struct) PseudoTypeInfo;
+ TypeCtorInfo = ti.type_ctor;
+
+ list.List_1 lst = list.empty_list();
+ if (ti.args != null) {
+ for (int i = ti.args.Length - 1; i >= 0; i--) {
+ lst = list.cons(ti.args[i], lst);
+ }
+ }
+ ArgPseudoTypeInfos = lst;
+ }
+ SUCCESS_INDICATOR = true;
+ } else {
+ /* Fail if input is a variable. */
+ TypeCtorInfo = null;
+ ArgPseudoTypeInfos = null;
+ SUCCESS_INDICATOR = false;
+ }
+").
+
:- pragma foreign_proc("Java",
pseudo_type_ctor_and_args(PseudoTypeInfo::in, TypeCtorInfo::out,
ArgPseudoTypeInfos::out),
@@ -1288,6 +1395,15 @@ iterate(Start, Max, Func) = Results :-
pseudo_type_ctor_and_args(_, _, _) :-
private_builtin.sorry("pseudo_type_ctor_and_args/3").
+:- pragma foreign_proc("C#",
+ is_univ_pseudo_type_info(PseudoTypeInfo::in, VarNum::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ VarNum = PseudoTypeInfo.variable_number;
+ SUCCESS_INDICATOR =
+ (VarNum >= 0 && VarNum <= rtti_implementation.last_univ_quant_varnum);
+").
+
:- pragma foreign_proc("Java",
is_univ_pseudo_type_info(PseudoTypeInfo::in, VarNum::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -1300,6 +1416,15 @@ pseudo_type_ctor_and_args(_, _, _) :-
is_univ_pseudo_type_info(_, _) :-
private_builtin.sorry("is_univ_pseudo_type_info/2").
+:- pragma foreign_proc("C#",
+ is_exist_pseudo_type_info(PseudoTypeInfo::in, VarNum::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ VarNum = PseudoTypeInfo.variable_number;
+ SUCCESS_INDICATOR =
+ (VarNum >= rtti_implementation.first_exist_quant_varnum);
+").
+
:- pragma foreign_proc("Java",
is_exist_pseudo_type_info(PseudoTypeInfo::in, VarNum::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -1315,6 +1440,369 @@ is_exist_pseudo_type_info(_, _) :-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
+:- pragma foreign_code("C#",
+"
+ private static bool
+ ML_construct(runtime.TypeInfo_Struct TypeInfo, int FunctorNumber,
+ list.List_1 ArgList,
+ out univ.Univ_0 Term)
+ {
+ /* If type_info is an equivalence type, expand it. */
+ TypeInfo = ML_collapse_equivalences(TypeInfo);
+
+ object new_data = null;
+
+ // XXX catch exceptions
+ {
+ runtime.TypeCtorInfo_Struct tc = TypeInfo.type_ctor;
+
+ switch (tc.type_ctor_rep) {
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_ENUM:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_ENUM_USEREQ:
+ runtime.EnumFunctorDesc[] functors_enum =
+ tc.type_functors.functors_enum();
+ if (FunctorNumber >= 0 && FunctorNumber < functors_enum.Length)
+ {
+ new_data = ML_construct_static_member(tc,
+ functors_enum[FunctorNumber].enum_functor_ordinal);
+ }
+ break;
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_FOREIGN_ENUM:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_NOTAG:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_NOTAG_USEREQ:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_NOTAG_GROUND:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_RESERVED_ADDR:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ:
+ /* These don't exist in the C# backend yet. */
+ break;
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_DU:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_DU_USEREQ:
+ runtime.DuFunctorDesc[] functor_desc =
+ tc.type_functors.functors_du();
+ if (FunctorNumber >= 0 && FunctorNumber < functor_desc.Length)
+ {
+ new_data = ML_construct_du(tc, functor_desc[FunctorNumber],
+ ArgList);
+ }
+ break;
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_TUPLE:
+ int arity = TypeInfo.args.Length;
+ new_data = ML_univ_list_to_array(ArgList, arity);
+ break;
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_DUMMY:
+ if (FunctorNumber == 0 && ArgList is list.List_1.F_nil_0) {
+ new_data = ML_construct_static_member(tc, 0);
+ }
+ break;
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_INT:
+ /* ints don't have functor ordinals. */
+ throw new System.Exception(
+ ""cannot construct int with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_FLOAT:
+ /* floats don't have functor ordinals. */
+ throw new System.Exception(
+ ""cannot construct float with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_CHAR:
+ /* chars don't have functor ordinals. */
+ throw new System.Exception(
+ ""cannot construct chars with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_STRING:
+ /* strings don't have functor ordinals. */
+ throw new System.Exception(
+ ""cannot construct strings with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_BITMAP:
+ /* bitmaps don't have functor ordinals. */
+ throw new System.Exception(
+ ""cannot construct bitmaps with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_EQUIV:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_EQUIV_GROUND:
+ /* These should be eliminated above. */
+ throw new System.Exception(""equiv type in construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_VOID:
+ /* These should be eliminated above. */
+ throw new System.Exception(
+ ""cannot construct void values with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_FUNC:
+ throw new System.Exception(
+ ""cannot construct functions with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_PRED:
+ throw new System.Exception(
+ ""cannot construct predicates with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_SUBGOAL:
+ throw new System.Exception(
+ ""cannot construct subgoals with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_TYPEDESC:
+ throw new System.Exception(
+ ""cannot construct type_descs with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_TYPECTORDESC:
+ throw new System.Exception(
+ ""cannot construct type_descs with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_PSEUDOTYPEDESC:
+ throw new System.Exception(
+ ""cannot construct pseudotype_descs with "" +
+ ""construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_TYPEINFO:
+ throw new System.Exception(
+ ""cannot construct type_infos with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_TYPECTORINFO:
+ throw new System.Exception(
+ ""cannot construct type_ctor_infos with "" +
+ ""construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_TYPECLASSINFO:
+ throw new System.Exception(
+ ""cannot construct type_class_infos with "" +
+ ""construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_BASETYPECLASSINFO:
+ throw new System.Exception(
+ ""cannot construct base_type_class_infos "" +
+ ""with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_SUCCIP:
+ throw new System.Exception(
+ ""cannot construct succips with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_HP:
+ throw new System.Exception(
+ ""cannot construct hps with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_CURFR:
+ throw new System.Exception(
+ ""cannot construct curfrs with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_MAXFR:
+ throw new System.Exception(
+ ""cannot construct maxfrs with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_REDOFR:
+ throw new System.Exception(
+ ""cannot construct redofrs with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_REDOIP:
+ throw new System.Exception(
+ ""cannot construct redoips with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_TRAIL_PTR:
+ throw new System.Exception(
+ ""cannot construct trail_ptrs with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_TICKET:
+ throw new System.Exception(
+ ""cannot construct tickets with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_C_POINTER:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_STABLE_C_POINTER:
+ throw new System.Exception(
+ ""cannot construct c_pointers with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_ARRAY:
+ throw new System.Exception(
+ ""cannot construct arrays with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_REFERENCE:
+ throw new System.Exception(
+ ""cannot construct references with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_FOREIGN:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_STABLE_FOREIGN:
+ throw new System.Exception(
+ ""cannot construct values of foreign types "" +
+ ""with construct.construct"");
+
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_UNKNOWN:
+ throw new System.Exception(
+ ""cannot construct values of unknown types "" +
+ ""with construct.construct"");
+
+ default:
+ throw new System.Exception(
+ ""bad type_ctor_rep in construct.construct"");
+ }
+ }
+
+ if (new_data != null) {
+ Term = new univ.Univ_0(TypeInfo, new_data);
+ return true;
+ } else {
+ Term = null;
+ return false;
+ }
+ }
+
+ private static object
+ ML_construct_du(runtime.TypeCtorInfo_Struct tc,
+ runtime.DuFunctorDesc functor_desc, list.List_1 arg_list)
+ {
+ System.Type type;
+
+ if (tc.type_ctor_num_functors == 1) {
+ type = System.Type.GetType(
+ ""mercury."" + ML_name_mangle(tc.type_ctor_module_name)
+ + ""+"" + ML_flipInitialCase(ML_name_mangle(tc.type_ctor_name))
+ + ""_"" + tc.arity);
+ } else {
+ type = System.Type.GetType(
+ ""mercury."" + ML_name_mangle(tc.type_ctor_module_name)
+ + ""+"" + ML_flipInitialCase(ML_name_mangle(tc.type_ctor_name))
+ + ""_"" + tc.arity
+ + ""+"" + ML_flipInitialCase(ML_name_mangle(
+ functor_desc.du_functor_name))
+ + ""_"" + functor_desc.du_functor_orig_arity);
+ }
+
+ int arity = functor_desc.du_functor_orig_arity;
+ object[] args = ML_univ_list_to_array(arg_list, arity);
+
+ if (args == null) {
+ /* Argument list length doesn't match arity. */
+ return null;
+ }
+
+ // XXX C# catch exceptions
+ return System.Activator.CreateInstance(type, args);
+ }
+
+ private static object[]
+ ML_univ_list_to_array(list.List_1 lst, int arity)
+ {
+ object[] args = new object[arity];
+
+ for (int i = 0; i < arity; i++) {
+ object[] rc;
+ rc = univ.ML_unravel_univ((univ.Univ_0) list.det_head(lst));
+ args[i] = rc[1];
+ lst = list.det_tail(lst);
+ }
+
+ if (list.is_empty(lst)) {
+ return args;
+ } else {
+ return null;
+ }
+ }
+
+ private static object
+ ML_construct_static_member(runtime.TypeCtorInfo_Struct tc, int i)
+ {
+ System.Type type = System.Type.GetType(
+ ""mercury."" + ML_name_mangle(tc.type_ctor_module_name)
+ + ""+"" + ML_flipInitialCase(ML_name_mangle(tc.type_ctor_name))
+ + ""_"" + tc.arity);
+ return System.Enum.ToObject(type, i);
+ }
+
+ private static string
+ ML_flipInitialCase(string s)
+ {
+ if (s.Length > 0) {
+ char first = s[0];
+ string rest = s.Substring(1);
+ if (System.Char.IsLower(first)) {
+ return System.Char.ToUpper(first) + rest;
+ }
+ if (System.Char.IsUpper(first)) {
+ return System.Char.ToLower(first) + rest;
+ }
+ }
+ return s;
+ }
+
+ // Duplicated and modified from Java version.
+ private static string
+ ML_name_mangle(string s)
+ {
+ bool all_ok = true;
+ if (s.Length < 1) {
+ all_ok = false;
+ }
+ if (all_ok && System.Char.IsDigit(s, 0)) {
+ all_ok = false;
+ }
+ if (all_ok) {
+ foreach (char c in s) {
+ if ((c >= 'A' && c <= 'Z') ||
+ (c >= 'a' && c <= 'z') ||
+ (c >= '0' && c <= '9') ||
+ (c == '_'))
+ {
+ // do nothing
+ } else {
+ all_ok = false;
+ break;
+ }
+ }
+ }
+ if (all_ok) {
+ if (s.StartsWith(""f_"")) {
+ return ""f__"" + s.Substring(2);
+ } else {
+ return s;
+ }
+ }
+
+ /* This is from prog_foreign.name_conversion_table. */
+ if (s.Equals(""\\\\="")) return ""f_not_equal"";
+ if (s.Equals("">="")) return ""f_greater_or_equal"";
+ if (s.Equals(""=<"")) return ""f_less_or_equal"";
+ if (s.Equals(""="")) return ""f_equal"";
+ if (s.Equals(""<"")) return ""f_less_than"";
+ if (s.Equals("">"")) return ""f_greater_than"";
+ if (s.Equals(""-"")) return ""f_minus"";
+ if (s.Equals(""+"")) return ""f_plus"";
+ if (s.Equals(""*"")) return ""f_times"";
+ if (s.Equals(""/"")) return ""f_slash"";
+ if (s.Equals("","")) return ""f_comma"";
+ if (s.Equals("";"")) return ""f_semicolon"";
+ if (s.Equals(""!"")) return ""f_cut"";
+ if (s.Equals(""{}"")) return ""f_tuple"";
+ if (s.Equals(""[|]"")) return ""f_cons"";
+ if (s.Equals(""[]"")) return ""f_nil"";
+
+ System.Text.StringBuilder sb = new System.Text.StringBuilder(""f"");
+ foreach (char c in s.ToCharArray()) {
+ sb.Append('_');
+ sb.Append((int) c);
+ }
+ return sb.ToString();
+ }
+
+ private static object[]
+ ML_list_to_array(list.List_1 lst, int arity)
+ {
+ object[] array = new object[arity];
+
+ for (int i = 0; i < arity; i++) {
+ array[i] = list.det_head(lst);
+ lst = list.det_tail(lst);
+ }
+
+ return array;
+ }
+").
+
:- pragma foreign_code("Java", "
private static Object[]
@@ -1693,6 +2181,14 @@ is_exist_pseudo_type_info(_, _) :-
").
+:- pragma foreign_proc("C#",
+ construct(TypeInfo::in, FunctorNumber::in, ArgList::in) = (Term::out),
+ [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
+"
+ SUCCESS_INDICATOR = ML_construct(TypeInfo, FunctorNumber, ArgList,
+ out Term);
+").
+
:- pragma foreign_proc("Java",
construct(TypeInfo::in, FunctorNumber::in, ArgList::in) = (Term::out),
[will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
@@ -1707,6 +2203,28 @@ construct(_, _, _) = _ :-
%-----------------------------------------------------------------------------%
+:- pragma foreign_proc("C#",
+ construct_tuple_2(Args::in, ArgTypes::in, Arity::in) = (Tuple::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ may_not_duplicate],
+"
+ list.List_1 args_list = Args;
+ object[] args_array = new object[Arity];
+
+ for (int i = 0; i < Arity; i++) {
+ object[] rc = univ.ML_unravel_univ(
+ (univ.Univ_0) list.det_head(args_list));
+ args_array[i] = rc[1];
+ args_list = list.det_tail(args_list);
+ }
+
+ object[] args = ML_list_to_array(ArgTypes, Arity);
+ runtime.TypeInfo_Struct ti = new TypeInfo_Struct();
+ ti.init(builtin.builtin__type_ctor_info_tuple_0, args);
+
+ Tuple = univ.ML_construct_univ(ti, args_array);
+").
+
:- pragma foreign_proc("Java",
construct_tuple_2(Args::in, ArgTypes::in, Arity::in) = (Tuple::out),
[will_not_call_mercury, promise_pure, thread_safe,
@@ -2431,6 +2949,14 @@ get_arg_type_info_2(TypeInfoParams, TypeInfo, Term, FunctorDesc,
:- func type_info_get_higher_order_arity(type_info) = int.
+:- pragma foreign_proc("C#",
+ type_info_get_higher_order_arity(PseudoTypeInfo::in) = (Arity::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ runtime.TypeInfo_Struct ti = (runtime.TypeInfo_Struct) PseudoTypeInfo;
+ Arity = ti.args.Length;
+").
+
:- pragma foreign_proc("Java",
type_info_get_higher_order_arity(PseudoTypeInfo::in) = (Arity::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -2456,8 +2982,12 @@ new_type_info(TypeInfo, _) = NewTypeInfo :-
new_type_info(OldTypeInfo::in, Arity::in) = (NewTypeInfo::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ NewTypeInfo = OldTypeInfo.copy();
+#else
NewTypeInfo = new object[Arity + 1];
System.Array.Copy(OldTypeInfo, NewTypeInfo, OldTypeInfo.Length);
+#endif
").
:- pragma foreign_proc("Java",
@@ -2501,7 +3031,11 @@ get_pti_from_type_info_index(_, _, _, _) :-
PTI::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ PTI = TypeInfo.args[Index];
+#else
PTI = TypeInfo[Offset + Index];
+#endif
").
:- pragma foreign_proc("Java",
@@ -2550,6 +3084,19 @@ get_type_info_for_var(TypeInfo, VarNum, Term, FunctorDesc, ArgTypeInfo) :-
type_info_from_pseudo_type_info(PseudoTypeInfo) = TypeInfo :-
private_builtin.unsafe_type_cast(PseudoTypeInfo, TypeInfo).
+:- pragma foreign_proc("C#",
+ type_info_from_pseudo_type_info(PseudoTypeInfo::in) = (TypeInfo::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ runtime.TypeCtorInfo_Struct tci =
+ PseudoTypeInfo as runtime.TypeCtorInfo_Struct;
+ if (tci != null) {
+ TypeInfo = new runtime.TypeInfo_Struct(tci);
+ } else {
+ TypeInfo = (runtime.TypeInfo_Struct) PseudoTypeInfo;
+ }
+").
+
:- pragma foreign_proc("Java",
type_info_from_pseudo_type_info(PseudoTypeInfo::in) = (TypeInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -2571,12 +3118,36 @@ get_subterm(_, _, _, _, _) = -1 :-
det_unimplemented("get_subterm").
:- pragma foreign_proc("C#",
- get_subterm(_FunctorDesc::in, SubTermTypeInfo::in, Term::in,
+ get_subterm(FunctorDesc::in, SubTermTypeInfo::in, Term::in,
Index::in, ExtraArgs::in) = (Arg::out),
- [will_not_call_mercury, promise_pure, thread_safe],
+ [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
"
// Mention TypeInfo_for_U to avoid a warning.
+#if MR_HIGHLEVEL_DATA
+ if (Term is object[]) {
+ int i = Index + ExtraArgs;
+ Arg = ((object[]) Term)[i];
+ } else {
+ string fieldName = null;
+ if (FunctorDesc.du_functor_arg_names != null) {
+ fieldName = FunctorDesc.du_functor_arg_names[Index];
+ }
+ if (fieldName != null) {
+ fieldName = ML_name_mangle(fieldName);
+ } else {
+ // The F<i> field variables are numbered from 1.
+ int i = 1 + Index + ExtraArgs;
+ fieldName = ""F"" + i;
+ }
+
+ System.Reflection.FieldInfo f = Term.GetType().GetField(fieldName);
+ if (f == null) {
+ throw new System.Exception(""no such field: "" + fieldName);
+ }
+ Arg = f.GetValue(Term);
+ }
+#else
int i = Index + ExtraArgs;
try {
// try low level data
@@ -2585,6 +3156,8 @@ get_subterm(_, _, _, _, _) = -1 :-
// try high level data
Arg = Term.GetType().GetFields()[i].GetValue(Term);
}
+#endif
+
TypeInfo_for_T = SubTermTypeInfo;
").
@@ -2678,13 +3251,19 @@ pseudo_type_info_is_variable(_, -1) :-
pseudo_type_info_is_variable(TypeInfo::in, VarNum::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ VarNum = TypeInfo.variable_number;
+ SUCCESS_INDICATOR = (VarNum != -1);
+#else
try {
VarNum = System.Convert.ToInt32(TypeInfo);
SUCCESS_INDICATOR = true;
}
catch (System.Exception e) {
+ VarNum = -1;
SUCCESS_INDICATOR = false;
}
+#endif
").
:- pragma foreign_proc("Java",
@@ -2716,6 +3295,11 @@ last_univ_quant_varnum = 512.
first_exist_quant_varnum = 513.
+:- pragma foreign_code("C#", "
+public const int last_univ_quant_varnum = 512;
+public const int first_exist_quant_varnum = 513;
+").
+
:- pragma foreign_code("Java", "
public static final int last_univ_quant_varnum = 512;
public static final int first_exist_quant_varnum = 513;
@@ -2727,6 +3311,7 @@ public static final int first_exist_quant_varnum = 513;
% XXX we have only implemented the .NET backend for the low-level data case.
:- pragma foreign_code("C#", "
+#if !MR_HIGHLEVEL_DATA
// The field numbers of the contents of type_infos.
enum fixed_arity_ti {
@@ -2789,17 +3374,22 @@ public static final int first_exist_quant_varnum = 513;
exist_offset_in_tci = 1
}
+#endif
").
:- pragma foreign_proc("C#",
get_type_ctor_info(TypeInfo::in) = (TypeCtorInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ TypeCtorInfo = TypeInfo.type_ctor;
+#else
try {
TypeCtorInfo = (object[]) TypeInfo[0];
} catch (System.InvalidCastException) {
TypeCtorInfo = TypeInfo;
}
+#endif
").
:- pragma foreign_proc("Java",
@@ -2878,6 +3468,9 @@ get_remote_secondary_tag(_::in) = (0::out) :-
get_remote_secondary_tag(X::in) = (Tag::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ Tag = (int) X.GetType().GetField(""data_tag"").GetValue(X);
+#else
try {
// try the low-level data representation
object[] data = (object[]) X;
@@ -2886,6 +3479,7 @@ get_remote_secondary_tag(_::in) = (0::out) :-
// try the high-level data representation
Tag = (int) X.GetType().GetField(""data_tag"").GetValue(X);
}
+#endif
").
:- pragma foreign_proc("Java",
@@ -2922,22 +3516,29 @@ get_remote_secondary_tag(_::in) = (0::out) :-
% :- pragma foreign_type("Java", sectag_locn, "jmercury.runtime.Sectag_Locn").
:- type du_sectag_alternatives ---> du_sectag_alternatives(c_pointer).
+% :- pragma foreign_type("C#", du_sectag_alternatives,
+% "runtime.DuFunctorDesc[]").
:- pragma foreign_type("Java", du_sectag_alternatives,
"jmercury.runtime.DuFunctorDesc[]").
:- type ptag_entry ---> ptag_entry(c_pointer).
+% :- pragma foreign_type("C#", ptag_entry, "runtime.DuPtagLayout").
:- pragma foreign_type("Java", ptag_entry, "jmercury.runtime.DuPtagLayout").
:- type arg_types ---> arg_types(c_pointer).
+% :- pragma foreign_type("C#", arg_types, "runtime.PseudoTypeInfo[]").
:- pragma foreign_type("Java", arg_types, "jmercury.runtime.PseudoTypeInfo[]").
:- type arg_names ---> arg_names(c_pointer).
+% :- pragma foreign_type("C#", arg_names, "string[]").
:- pragma foreign_type("Java", arg_names, "java.lang.String[]").
:- type exist_info ---> exist_info(c_pointer).
+% :- pragma foreign_type("C#", exist_info, "runtime.DuExistInfo").
:- pragma foreign_type("Java", exist_info, "jmercury.runtime.DuExistInfo").
:- type typeinfo_locn ---> typeinfo_locn(c_pointer).
+% :- pragma foreign_type("C#", typeinfo_locn, "runtime.DuExistLocn").
:- pragma foreign_type("Java", typeinfo_locn, "jmercury.runtime.DuExistLocn").
:- func ptag_index(int, type_layout) = ptag_entry.
@@ -2952,7 +3553,11 @@ ptag_index(_, _) = _ :-
ptag_index(X::in, TypeLayout::in) = (PtagEntry::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ PtagEntry = TypeLayout.layout_du()[X];
+#else
PtagEntry = (object[]) TypeLayout[X];
+#endif
").
:- pragma foreign_proc("Java",
@@ -2971,8 +3576,12 @@ sectag_locn(_) = _ :-
sectag_locn(PTagEntry::in) = (SectagLocn::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ SectagLocn = (Sectag_locn_0) PTagEntry.sectag_locn;
+#else
SectagLocn = mercury.runtime.LowLevelData.make_enum((int)
PTagEntry[(int) ptag_layout_field_nums.sectag_locn]);
+#endif
").
:- pragma foreign_proc("Java",
@@ -2993,10 +3602,14 @@ du_sectag_alternatives(_, _) = _ :-
du_sectag_alternatives(X::in, PTagEntry::in) = (FunctorDescriptor::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ FunctorDescriptor = PTagEntry.sectag_alternatives[X];
+#else
object[] sectag_alternatives;
sectag_alternatives = (object [])
PTagEntry[(int) ptag_layout_field_nums.sectag_alternatives];
FunctorDescriptor = (object []) sectag_alternatives[X];
+#endif
").
:- pragma foreign_proc("Java",
@@ -3012,11 +3625,16 @@ typeinfo_locns_index(_, _) = _ :-
private_builtin.sorry("typeinfo_locns_index").
:- pragma foreign_proc("C#",
- typeinfo_locns_index(X::in, ExistInfo::in) = (TypeInfoLocn::out),
+ typeinfo_locns_index(VarNum::in, ExistInfo::in) = (TypeInfoLocn::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ // Variables count from one.
+ TypeInfoLocn = ExistInfo.exist_typeinfo_locns[VarNum - 1];
+#else
TypeInfoLocn = (object[]) ((object[]) ExistInfo[(int)
- exist_info_field_nums.typeinfo_locns])[X];
+ exist_info_field_nums.typeinfo_locns])[VarNum];
+#endif
").
:- pragma foreign_proc("Java",
@@ -3036,8 +3654,12 @@ exist_info_typeinfos_plain(_) = -1 :-
exist_info_typeinfos_plain(ExistInfo::in) = (TypeInfosPlain::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ TypeInfosPlain = ExistInfo.exist_typeinfos_plain;
+#else
TypeInfosPlain = (int)
ExistInfo[(int) exist_info_field_nums.typeinfos_plain];
+#endif
").
:- pragma foreign_proc("Java",
@@ -3056,7 +3678,11 @@ exist_info_tcis(_) = -1 :-
exist_info_tcis(ExistInfo::in) = (TCIs::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ TCIs = ExistInfo.exist_tcis;
+#else
TCIs = (int) ExistInfo[(int) exist_info_field_nums.tcis];
+#endif
").
:- pragma foreign_proc("Java",
@@ -3075,7 +3701,11 @@ exist_arg_num(_) = -1 :-
exist_arg_num(TypeInfoLocn::in) = (ArgNum::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ ArgNum = TypeInfoLocn.exist_arg_num;
+#else
ArgNum = (int) TypeInfoLocn[(int) exist_locn_field_nums.exist_arg_num];
+#endif
").
:- pragma foreign_proc("Java",
@@ -3094,8 +3724,12 @@ exist_offset_in_tci(_) = -1 :-
exist_offset_in_tci(TypeInfoLocn::in) = (ArgNum::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ ArgNum = TypeInfoLocn.exist_offset_in_tci;
+#else
ArgNum = (int)
TypeInfoLocn[(int) exist_locn_field_nums.exist_offset_in_tci];
+#endif
").
:- pragma foreign_proc("Java",
@@ -3114,12 +3748,26 @@ get_type_info_from_term(_, _) = _ :-
get_type_info_from_term(Term::in, Index::in) = (TypeInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ if (Term is object[]) {
+ TypeInfo = (runtime.TypeInfo_Struct) ((object[]) Term)[Index];
+ } else {
+ // The F<i> field variables are numbered from 1.
+ string fieldName = ""F"" + (1 + Index);
+ System.Reflection.FieldInfo f = Term.GetType().GetField(fieldName);
+ if (f == null) {
+ throw new System.Exception(""no such field: "" + fieldName);
+ }
+ TypeInfo = (runtime.TypeInfo_Struct) f.GetValue(Term);
+ }
+#else
try {
TypeInfo = (object[]) ((object[]) Term)[Index];
} catch (System.InvalidCastException) {
// try high level data
TypeInfo = (object[]) Term.GetType().GetFields()[Index].GetValue(Term);
}
+#endif
").
:- pragma foreign_proc("Java",
@@ -3193,6 +3841,13 @@ var_arity_type_info_index_as_pti(TypeInfo, Index) =
%
% Keep this in sync with the Java version of type_info_index_as_ti/pti.
%
+:- pragma foreign_proc("C#",
+ var_arity_type_info_index_as_ti(TypeInfo::in, VarNum::in)
+ = (TypeInfoAtIndex::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ TypeInfoAtIndex = (runtime.TypeInfo_Struct) TypeInfo.args[VarNum - 1];
+").
:- pragma foreign_proc("Java",
var_arity_type_info_index_as_ti(TypeInfo::in, VarNum::in)
= (TypeInfoAtIndex::out),
@@ -3206,6 +3861,13 @@ var_arity_type_info_index_as_pti(TypeInfo, Index) =
(jmercury.runtime.TypeInfo_Struct) TypeInfo.args[VarNum - 1];
").
+:- pragma foreign_proc("C#",
+ var_arity_type_info_index_as_pti(TypeInfo::in, VarNum::in)
+ = (PseudoTypeInfoAtIndex::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ PseudoTypeInfoAtIndex = TypeInfo.args[VarNum - 1];
+").
:- pragma foreign_proc("Java",
var_arity_type_info_index_as_pti(TypeInfo::in, VarNum::in)
= (PseudoTypeInfoAtIndex::out),
@@ -3231,17 +3893,25 @@ type_info_index_as_pti(TypeInfo, _) = PseudoTypeInfo :-
private_builtin.unsafe_type_cast(TypeInfo, PseudoTypeInfo).
:- pragma foreign_proc("C#",
- type_info_index_as_ti(TypeInfo::in, Index::in) = (TypeInfoAtIndex::out),
+ type_info_index_as_ti(TypeInfo::in, VarNum::in) = (TypeInfoAtIndex::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- TypeInfoAtIndex = (object[]) TypeInfo[Index];
+#if MR_HIGHLEVEL_DATA
+ TypeInfoAtIndex = (runtime.TypeInfo_Struct) TypeInfo.args[VarNum - 1];
+#else
+ TypeInfoAtIndex = (object[]) TypeInfo[VarNum];
+#endif
").
:- pragma foreign_proc("C#",
- type_info_index_as_pti(TypeInfo::in, Index::in) = (TypeInfoAtIndex::out),
+ type_info_index_as_pti(TypeInfo::in, VarNum::in) = (PseudoTypeInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
- TypeInfoAtIndex = (object[]) TypeInfo[Index];
+#if MR_HIGHLEVEL_DATA
+ PseudoTypeInfo = TypeInfo.args[VarNum - 1];
+#else
+ PseudoTypeInfo = (object[]) TypeInfo[VarNum];
+#endif
").
% Keep this in sync with the Java version of
@@ -3283,7 +3953,11 @@ set_type_info_index(_, _, _, !TypeInfo) :-
TypeInfo0::di, TypeInfo::uo),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ TypeInfo0.args[Index] = Value;
+#else
TypeInfo0[Offset + Index] = Value;
+#endif
TypeInfo = TypeInfo0;
").
@@ -3322,8 +3996,12 @@ det_unimplemented(S) :-
type_ctor_arity(TypeCtorInfo::in) = (Arity::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ Arity = TypeCtorInfo.arity;
+#else
Arity = (int) TypeCtorInfo[
(int) type_ctor_info_field_nums.type_ctor_arity];
+#endif
").
:- pragma foreign_proc("Java",
type_ctor_arity(TypeCtorInfo::in) = (Arity::out),
@@ -3348,8 +4026,12 @@ type_ctor_arity(_) = _ :-
type_ctor_unify_pred(TypeCtorInfo::in) = (UnifyPred::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ UnifyPred = TypeCtorInfo.unify_pred;
+#else
UnifyPred = TypeCtorInfo[
(int) type_ctor_info_field_nums.type_ctor_unify_pred];
+#endif
").
:- pragma foreign_proc("C",
type_ctor_unify_pred(TypeCtorInfo::in) = (UnifyPred::out),
@@ -3376,8 +4058,12 @@ type_ctor_unify_pred(_) = unify_or_compare_pred :-
type_ctor_compare_pred(TypeCtorInfo::in) = (ComparePred::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ ComparePred = TypeCtorInfo.compare_pred;
+#else
ComparePred = TypeCtorInfo[
(int) type_ctor_info_field_nums.type_ctor_compare_pred];
+#endif
").
:- pragma foreign_proc("C",
@@ -3407,9 +4093,13 @@ type_ctor_compare_pred(_) = unify_or_compare_pred :-
get_type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ TypeCtorRep = (Type_ctor_rep_0) TypeCtorInfo.type_ctor_rep;
+#else
int rep;
rep = (int) TypeCtorInfo[(int) type_ctor_info_field_nums.type_ctor_rep];
TypeCtorRep = mercury.runtime.LowLevelData.make_enum(rep);
+#endif
").
:- pragma foreign_proc("Java",
get_type_ctor_rep(TypeCtorInfo::in) = (TypeCtorRep::out),
@@ -3436,8 +4126,12 @@ get_type_ctor_rep(_) = _ :-
type_ctor_module_name(TypeCtorInfo::in) = (Name::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ Name = TypeCtorInfo.type_ctor_module_name;
+#else
Name = (string)
TypeCtorInfo[(int) type_ctor_info_field_nums.type_ctor_module_name];
+#endif
").
:- pragma foreign_proc("Java",
@@ -3466,8 +4160,12 @@ type_ctor_module_name(_) = _ :-
type_ctor_name(TypeCtorInfo::in) = (Name::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ Name = TypeCtorInfo.type_ctor_name;
+#else
Name = (string)
TypeCtorInfo[(int) type_ctor_info_field_nums.type_ctor_name];
+#endif
").
:- pragma foreign_proc("Java",
type_ctor_name(TypeCtorInfo::in) = (Name::out),
@@ -3494,8 +4192,12 @@ type_ctor_name(_) = _ :-
get_type_ctor_functors(TypeCtorInfo::in) = (Functors::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ Functors = TypeCtorInfo.type_functors;
+#else
Functors = (object[])
TypeCtorInfo[(int) type_ctor_info_field_nums.type_functors];
+#endif
").
:- pragma foreign_proc("Java",
@@ -3512,6 +4214,13 @@ get_type_ctor_functors(_) = _ :-
:- func get_type_functors(type_ctor_info) = type_functors.
+:- pragma foreign_proc("C#",
+ get_type_functors(TypeCtorInfo::in) = (TypeFunctors::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ TypeFunctors = TypeCtorInfo.type_functors;
+").
+
:- pragma foreign_proc("Java",
get_type_functors(TypeCtorInfo::in) = (TypeFunctors::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3528,8 +4237,12 @@ get_type_functors(_) = _ :-
get_type_layout(TypeCtorInfo::in) = (TypeLayout::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ TypeLayout = TypeCtorInfo.type_layout;
+#else
TypeLayout = (object[])
TypeCtorInfo[(int) type_ctor_info_field_nums.type_layout];
+#endif
").
:- pragma foreign_proc("Java",
get_type_layout(TypeCtorInfo::in) = (TypeLayout::out),
@@ -3556,8 +4269,12 @@ get_type_layout(_) = _ :-
type_ctor_num_functors(TypeCtorInfo::in) = (NumFunctors::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
+#if MR_HIGHLEVEL_DATA
+ NumFunctors = TypeCtorInfo.type_ctor_num_functors;
+#else
NumFunctors = (int) TypeCtorInfo[(int)
type_ctor_info_field_nums.type_ctor_num_functors];
+#endif
").
:- pragma foreign_proc("Java",
@@ -3575,6 +4292,24 @@ type_ctor_num_functors(_) = _ :-
:- pred type_ctor_search_functor_number_map(type_ctor_info::in,
int::in, int::out) is semidet.
+:- pragma foreign_proc("C#",
+ type_ctor_search_functor_number_map(TypeCtorInfo::in, Ordinal::in,
+ FunctorNumber::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ if (Ordinal >= 0 && Ordinal < TypeCtorInfo.type_ctor_num_functors) {
+ FunctorNumber = TypeCtorInfo.type_functor_number_map[Ordinal];
+ SUCCESS_INDICATOR = true;
+ } else if (Ordinal == 0 && TypeCtorInfo.type_ctor_num_functors == -1) {
+ /* This is for tuples. */
+ FunctorNumber = 0;
+ SUCCESS_INDICATOR = true;
+ } else {
+ FunctorNumber = -1;
+ SUCCESS_INDICATOR = false;
+ }
+").
+
:- pragma foreign_proc("Java",
type_ctor_search_functor_number_map(TypeCtorInfo::in, Ordinal::in,
FunctorNumber::out),
@@ -3602,22 +4337,32 @@ type_ctor_search_functor_number_map(_, _, _) :-
%
:- type type_functors ---> type_functors(c_pointer).
+% :- pragma foreign_type("C#", type_functors,
+% "runtime.TypeFunctors").
:- pragma foreign_type("Java", type_functors,
"jmercury.runtime.TypeFunctors").
:- type du_functor_desc ---> du_functor_desc(c_pointer).
+% :- pragma foreign_type("C#", du_functor_desc,
+% "runtime.DuFunctorDesc").
:- pragma foreign_type("Java", du_functor_desc,
"jmercury.runtime.DuFunctorDesc").
:- type enum_functor_desc ---> enum_functor_desc(c_pointer).
+% :- pragma foreign_type("C#", enum_functor_desc,
+% "runtime.EnumFunctorDesc").
:- pragma foreign_type("Java", enum_functor_desc,
"jmercury.runtime.EnumFunctorDesc").
:- type foreign_enum_functor_desc ---> foreign_enum_functor_desc(c_pointer).
+% :- pragma foreign_type("C#", foreign_enum_functor_desc,
+% "runtime.ForeignEnumFunctorDesc").
:- pragma foreign_type("Java", foreign_enum_functor_desc,
"jmercury.runtime.ForeignEnumFunctorDesc").
:- type notag_functor_desc ---> notag_functor_desc(c_pointer).
+% :- pragma foreign_type("C#", notag_functor_desc,
+% "runtime.NotagFunctorDesc").
:- pragma foreign_type("Java", notag_functor_desc,
"jmercury.runtime.NotagFunctorDesc").
@@ -3634,6 +4379,14 @@ type_ctor_search_functor_number_map(_, _, _) :-
du_functor_desc(_, Num, TypeFunctors) = DuFunctorDesc :-
DuFunctorDesc = TypeFunctors ^ unsafe_index(Num).
+:- pragma foreign_proc("C#",
+ du_functor_desc(_TypeCtorRep::in(du), X::in, TypeFunctors::in) =
+ (DuFunctorDesc::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ DuFunctorDesc = TypeFunctors.functors_du()[X];
+").
+
:- pragma foreign_proc("Java",
du_functor_desc(_TypeCtorRep::in(du), X::in, TypeFunctors::in) =
(DuFunctorDesc::out),
@@ -3646,6 +4399,13 @@ du_functor_desc(_, Num, TypeFunctors) = DuFunctorDesc :-
du_functor_name(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(0).
+:- pragma foreign_proc("C#",
+ du_functor_name(DuFunctorDesc::in) = (Name::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Name = DuFunctorDesc.du_functor_name;
+").
+
:- pragma foreign_proc("Java",
du_functor_name(DuFunctorDesc::in) = (Name::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3657,6 +4417,13 @@ du_functor_name(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(0).
du_functor_arity(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(1).
+:- pragma foreign_proc("C#",
+ du_functor_arity(DuFunctorDesc::in) = (Arity::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Arity = DuFunctorDesc.du_functor_orig_arity;
+").
+
:- pragma foreign_proc("Java",
du_functor_arity(DuFunctorDesc::in) = (Arity::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3669,6 +4436,13 @@ du_functor_arity(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(1).
du_functor_arg_type_contains_var(DuFunctorDesc) =
DuFunctorDesc ^ unsafe_index(2).
+:- pragma foreign_proc("C#",
+ du_functor_arg_type_contains_var(DuFunctorDesc::in) = (Contains::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Contains = DuFunctorDesc.du_functor_arg_type_contains_var;
+").
+
:- pragma foreign_proc("Java",
du_functor_arg_type_contains_var(DuFunctorDesc::in) = (Contains::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3681,6 +4455,13 @@ du_functor_arg_type_contains_var(DuFunctorDesc) =
du_functor_sectag_locn(DuFunctorDesc) =
unsafe_make_enum(DuFunctorDesc ^ unsafe_index(3)).
+:- pragma foreign_proc("C#",
+ du_functor_sectag_locn(DuFunctorDesc::in) = (SectagLocn::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ SectagLocn = DuFunctorDesc.du_functor_sectag_locn;
+").
+
:- pragma foreign_proc("Java",
du_functor_sectag_locn(DuFunctorDesc::in) = (SectagLocn::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3692,6 +4473,13 @@ du_functor_sectag_locn(DuFunctorDesc) =
du_functor_primary(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(4).
+:- pragma foreign_proc("C#",
+ du_functor_primary(DuFunctorDesc::in) = (Primary::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Primary = DuFunctorDesc.du_functor_primary;
+").
+
:- pragma foreign_proc("Java",
du_functor_primary(DuFunctorDesc::in) = (Primary::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3703,6 +4491,13 @@ du_functor_primary(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(4).
du_functor_secondary(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(5).
+:- pragma foreign_proc("C#",
+ du_functor_secondary(DuFunctorDesc::in) = (Secondary::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Secondary = DuFunctorDesc.du_functor_secondary;
+").
+
:- pragma foreign_proc("Java",
du_functor_secondary(DuFunctorDesc::in) = (Secondary::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3714,6 +4509,13 @@ du_functor_secondary(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(5).
du_functor_ordinal(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(6).
+:- pragma foreign_proc("C#",
+ du_functor_ordinal(DuFunctorDesc::in) = (Ordinal::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Ordinal = DuFunctorDesc.du_functor_ordinal;
+").
+
:- pragma foreign_proc("Java",
du_functor_ordinal(DuFunctorDesc::in) = (Ordinal::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3725,6 +4527,13 @@ du_functor_ordinal(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(6).
du_functor_arg_types(DuFunctorDesc) = DuFunctorDesc ^ unsafe_index(7).
+:- pragma foreign_proc("C#",
+ du_functor_arg_types(DuFunctorDesc::in) = (ArgTypes::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ ArgTypes = DuFunctorDesc.du_functor_arg_types;
+").
+
:- pragma foreign_proc("Java",
du_functor_arg_types(DuFunctorDesc::in) = (ArgTypes::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3739,6 +4548,15 @@ get_du_functor_arg_names(DuFunctorDesc, ArgNames) :-
ArgNames = DuFunctorDesc ^ unsafe_index(8),
not null(ArgNames).
+:- pragma foreign_proc("C#",
+ get_du_functor_arg_names(DuFunctorDesc::in, ArgNames::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ ArgNames = DuFunctorDesc.du_functor_arg_names;
+
+ SUCCESS_INDICATOR = (ArgNames != null);
+").
+
:- pragma foreign_proc("Java",
get_du_functor_arg_names(DuFunctorDesc::in, ArgNames::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3750,6 +4568,13 @@ get_du_functor_arg_names(DuFunctorDesc, ArgNames) :-
:- func arg_names_index(arg_names, int) = string.
+:- pragma foreign_proc("C#",
+ arg_names_index(ArgNames::in, Index::in) = (Name::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Name = ArgNames[Index];
+").
+
:- pragma foreign_proc("Java",
arg_names_index(ArgNames::in, Index::in) = (Name::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3778,6 +4603,15 @@ get_du_functor_exist_info(DuFunctorDesc, ExistInfo) :-
ExistInfo = DuFunctorDesc ^ unsafe_index(9),
not null(ExistInfo).
+:- pragma foreign_proc("C#",
+ get_du_functor_exist_info(DuFunctorDesc::in, ExistInfo::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ ExistInfo = DuFunctorDesc.du_functor_exist_info;
+
+ SUCCESS_INDICATOR = (ExistInfo != null);
+").
+
:- pragma foreign_proc("Java",
get_du_functor_exist_info(DuFunctorDesc::in, ExistInfo::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3795,6 +4629,14 @@ get_du_functor_exist_info(DuFunctorDesc, ExistInfo) :-
get_enum_functor_desc(_, Num, TypeFunctors) = EnumFunctorDesc :-
EnumFunctorDesc = TypeFunctors ^ unsafe_index(Num).
+:- pragma foreign_proc("C#",
+ get_enum_functor_desc(_TypeCtorRep::in(enum), X::in, TypeFunctors::in) =
+ (EnumFunctorDesc::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ EnumFunctorDesc = (TypeFunctors.functors_enum())[X];
+").
+
:- pragma foreign_proc("Java",
get_enum_functor_desc(_TypeCtorRep::in(enum), X::in, TypeFunctors::in) =
(EnumFunctorDesc::out),
@@ -3809,6 +4651,14 @@ get_enum_functor_desc(_, Num, TypeFunctors) = EnumFunctorDesc :-
get_enum_functor_desc_from_layout_enum(_, Num, TypeLayout) = EnumFunctorDesc :-
EnumFunctorDesc = TypeLayout ^ unsafe_index(Num).
+:- pragma foreign_proc("C#",
+ get_enum_functor_desc_from_layout_enum(_TypeCtorRep::in(enum), X::in,
+ TypeLayout::in) = (EnumFunctorDesc::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ EnumFunctorDesc = (TypeLayout.layout_enum())[X];
+").
+
:- pragma foreign_proc("Java",
get_enum_functor_desc_from_layout_enum(_TypeCtorRep::in(enum), X::in,
TypeLayout::in) = (EnumFunctorDesc::out),
@@ -3821,6 +4671,13 @@ get_enum_functor_desc_from_layout_enum(_, Num, TypeLayout) = EnumFunctorDesc :-
enum_functor_name(EnumFunctorDesc) = EnumFunctorDesc ^ unsafe_index(0).
+:- pragma foreign_proc("C#",
+ enum_functor_name(EnumFunctorDesc::in) = (Name::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Name = EnumFunctorDesc.enum_functor_name;
+").
+
:- pragma foreign_proc("Java",
enum_functor_name(EnumFunctorDesc::in) = (Name::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3832,6 +4689,13 @@ enum_functor_name(EnumFunctorDesc) = EnumFunctorDesc ^ unsafe_index(0).
enum_functor_ordinal(EnumFunctorDesc) = EnumFunctorDesc ^ unsafe_index(1).
+:- pragma foreign_proc("C#",
+ enum_functor_ordinal(EnumFunctorDesc::in) = (Ordinal::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Ordinal = EnumFunctorDesc.enum_functor_ordinal;
+").
+
:- pragma foreign_proc("Java",
enum_functor_ordinal(EnumFunctorDesc::in) = (Ordinal::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3848,6 +4712,14 @@ enum_functor_ordinal(EnumFunctorDesc) = EnumFunctorDesc ^ unsafe_index(1).
foreign_enum_functor_desc(_, Num, TypeFunctors) = ForeignEnumFunctorDesc :-
ForeignEnumFunctorDesc = TypeFunctors ^ unsafe_index(Num).
+:- pragma foreign_proc("C#",
+ foreign_enum_functor_desc(_TypeCtorRep::in(foreign_enum), X::in,
+ TypeFunctors::in) = (ForeignEnumFunctorDesc::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ ForeignEnumFunctorDesc = (TypeFunctors.functors_foreign_enum())[X];
+").
+
:- pragma foreign_proc("Java",
foreign_enum_functor_desc(_TypeCtorRep::in(foreign_enum), X::in,
TypeFunctors::in) = (ForeignEnumFunctorDesc::out),
@@ -3861,13 +4733,20 @@ foreign_enum_functor_desc(_, Num, TypeFunctors) = ForeignEnumFunctorDesc :-
foreign_enum_functor_name(ForeignEnumFunctorDesc) =
ForeignEnumFunctorDesc ^ unsafe_index(0).
+:- pragma foreign_proc("C#",
+ foreign_enum_functor_name(ForeignEnumFunctorDesc::in) = (Name::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Name = ForeignEnumFunctorDesc.foreign_enum_functor_name;
+").
+
:- pragma foreign_proc("Java",
foreign_enum_functor_name(ForeignEnumFunctorDesc::in) = (Name::out),
[will_not_call_mercury, promise_pure, thread_safe],
"
Name = ForeignEnumFunctorDesc.foreign_enum_functor_name;
").
-
+
%-----------------------------------------------------------------------------%
:- func notag_functor_desc(type_ctor_rep, int, type_functors)
@@ -3878,6 +4757,14 @@ foreign_enum_functor_name(ForeignEnumFunctorDesc) =
notag_functor_desc(_, Num, TypeFunctors) = NoTagFunctorDesc :-
NoTagFunctorDesc = TypeFunctors ^ unsafe_index(Num).
+:- pragma foreign_proc("C#",
+ notag_functor_desc(_TypeCtorRep::in(notag), _X::in, TypeFunctors::in) =
+ (NotagFunctorDesc::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ NotagFunctorDesc = TypeFunctors.functors_notag();
+").
+
:- pragma foreign_proc("Java",
notag_functor_desc(_TypeCtorRep::in(notag), _X::in, TypeFunctors::in) =
(NotagFunctorDesc::out),
@@ -3890,6 +4777,13 @@ notag_functor_desc(_, Num, TypeFunctors) = NoTagFunctorDesc :-
notag_functor_name(NoTagFunctorDesc) = NoTagFunctorDesc ^ unsafe_index(0).
+:- pragma foreign_proc("C#",
+ notag_functor_name(NotagFunctorDesc::in) = (Name::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ Name = NotagFunctorDesc.no_tag_functor_name;
+").
+
:- pragma foreign_proc("Java",
notag_functor_name(NotagFunctorDesc::in) = (Name::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3901,6 +4795,13 @@ notag_functor_name(NoTagFunctorDesc) = NoTagFunctorDesc ^ unsafe_index(0).
notag_functor_arg_type(NoTagFunctorDesc) = NoTagFunctorDesc ^ unsafe_index(1).
+:- pragma foreign_proc("C#",
+ notag_functor_arg_type(NotagFunctorDesc::in) = (ArgType::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ ArgType = NotagFunctorDesc.no_tag_functor_arg_type;
+").
+
:- pragma foreign_proc("Java",
notag_functor_arg_type(NotagFunctorDesc::in) = (ArgType::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3912,6 +4813,13 @@ notag_functor_arg_type(NoTagFunctorDesc) = NoTagFunctorDesc ^ unsafe_index(1).
notag_functor_arg_name(NoTagFunctorDesc) = NoTagFunctorDesc ^ unsafe_index(2).
+:- pragma foreign_proc("C#",
+ notag_functor_arg_name(NotagFunctorDesc::in) = (ArgName::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ ArgName = NotagFunctorDesc.no_tag_functor_arg_name;
+").
+
:- pragma foreign_proc("Java",
notag_functor_arg_name(NotagFunctorDesc::in) = (ArgName::out),
[will_not_call_mercury, promise_pure, thread_safe],
@@ -3928,7 +4836,11 @@ notag_functor_arg_name(NoTagFunctorDesc) = NoTagFunctorDesc ^ unsafe_index(2).
unsafe_index(Num::in, Array::in) = (Item::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
+#if MR_HIGHLEVEL_DATA
+ Item = null;
+#else
Item = ((object []) Array)[Num];
+#endif
").
unsafe_index(_, _) = _ :-
private_builtin.sorry("rtti_implementation.unsafe_index").
@@ -4001,6 +4913,13 @@ null_string = _ :-
:- func unsafe_get_enum_value(T) = int.
+:- pragma foreign_proc("C#",
+ unsafe_get_enum_value(Enum::in) = (Value::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ Value = (int) Enum;
+").
+
:- pragma foreign_proc("Java",
unsafe_get_enum_value(Enum::in) = (Value::out),
[will_not_call_mercury, thread_safe, promise_pure],
diff --git a/library/store.m b/library/store.m
index 45e3794..a5de36a 100644
--- a/library/store.m
+++ b/library/store.m
@@ -248,6 +248,8 @@
where equality is store_equal, comparison is store_compare.
:- pragma foreign_type("IL", store(S), "int32", [can_pass_as_mercury_type])
where equality is store_equal, comparison is store_compare.
+% :- pragma foreign_type("C#", store(S), "int32", [can_pass_as_mercury_type])
+% where equality is store_equal, comparison is store_compare.
:- pragma foreign_type("Java", store(S), "int", [can_pass_as_mercury_type])
where equality is store_equal, comparison is store_compare.
:- pragma foreign_type("Erlang", store(S), "", [can_pass_as_mercury_type])
@@ -284,7 +286,7 @@ store.new(S) :-
store.do_init(_S0::uo),
[will_not_call_mercury, promise_pure],
"
- // TypeInfo_for_S
+ TypeInfo_for_S = null;
").
:- pragma foreign_proc("Java",
store.do_init(_S0::uo),
diff --git a/library/string.m b/library/string.m
index 817a67a..d3e619f 100644
--- a/library/string.m
+++ b/library/string.m
@@ -1358,6 +1358,19 @@ string.to_char_list(Str::uo, CharList::in) :-
}
}").
+:- pragma foreign_proc("C#",
+ string.to_char_list_2(Str::in, CharList::out),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+ does_not_affect_liveness, no_sharing],
+"
+ list.List_1 lst = list.empty_list();
+ for (int i = Str.Length - 1; i >= 0; i--) {
+ char c = Str[i];
+ lst = list.cons(c, lst);
+ }
+ CharList = lst;
+").
+
:- pragma foreign_proc("Java",
string.to_char_list_2(Str::in, CharList::out),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
@@ -1456,6 +1469,20 @@ string.from_char_list(Chars::in, Str::uo) :-
Str[size] = '\\0';
}").
+:- pragma foreign_proc("C#",
+ string.semidet_from_char_list(CharList::in, Str::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+ does_not_affect_liveness],
+"
+ System.Text.StringBuilder sb = new System.Text.StringBuilder();
+ while (!list.is_empty(CharList)) {
+ sb.Append((char) list.det_head(CharList));
+ CharList = list.det_tail(CharList);
+ }
+ Str = sb.ToString();
+ SUCCESS_INDICATOR = true;
+").
+
:- pragma foreign_proc("Java",
string.semidet_from_char_list(CharList::in, Str::uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
@@ -1811,6 +1838,19 @@ string.append_list(Lists, string.append_list(Lists)).
Str[len] = '\\0';
}").
+:- pragma foreign_proc("C#",
+ string.append_list(Strs::in) = (Str::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+ does_not_affect_liveness],
+"
+ System.Text.StringBuilder sb = new System.Text.StringBuilder();
+ while (!list.is_empty(Strs)) {
+ sb.Append((string) list.det_head(Strs));
+ Strs = list.det_tail(Strs);
+ }
+ Str = sb.ToString();
+").
+
:- pragma foreign_proc("Java",
string.append_list(Strs::in) = (Str::uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
@@ -1894,6 +1934,26 @@ string.append_list(Strs::in) = (Str::uo) :-
Str[len] = '\\0';
}").
+:- pragma foreign_proc("C#",
+ string.join_list(Sep::in, Strs::in) = (Str::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+ does_not_affect_liveness],
+"
+ System.Text.StringBuilder sb = new System.Text.StringBuilder();
+ bool add_sep = false;
+
+ while (!list.is_empty(Strs)) {
+ if (add_sep) {
+ sb.Append(Sep);
+ }
+ sb.Append((string) list.det_head(Strs));
+ add_sep = true;
+ Strs = list.det_tail(Strs);
+ }
+
+ Str = sb.ToString();
+").
+
:- pragma foreign_proc("Java",
string.join_list(Sep::in, Strs::in) = (Str::uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
@@ -3490,6 +3550,26 @@ string.from_float(Flt) = string.float_to_string(Flt).
MR_float_to_string(Flt, Str);
}").
+:- pragma foreign_proc("C#",
+ string.float_to_string(Flt::in, Str::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+ does_not_affect_liveness, no_sharing],
+"
+ Str = Flt.ToString(""R"");
+
+ /* Append '.0' if there is no 'e' or '.' in the string. */
+ bool contains = false;
+ foreach (char c in Str) {
+ if (c == 'e' || c == 'E' || c == '.') {
+ contains = true;
+ break;
+ }
+ }
+ if (!contains) {
+ Str = Str + "".0"";
+ }
+").
+
:- pragma foreign_proc("Java",
string.float_to_string(Flt::in, Str::uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
@@ -3617,6 +3697,9 @@ string.det_to_float(FloatString) =
string.to_float(FloatString::in, FloatVal::out),
[will_not_call_mercury, promise_pure, thread_safe],
"{
+ FloatVal = 0.0; // FloatVal must be initialized to suppress
+ // error messages when the predicate fails.
+
// leading or trailing whitespace is not allowed
if (FloatString.Length == 0 ||
System.Char.IsWhiteSpace(FloatString, 0) ||
@@ -3630,7 +3713,7 @@ string.det_to_float(FloatString) =
try {
FloatVal = System.Convert.ToDouble(FloatString);
SUCCESS_INDICATOR = true;
- } catch (System.FormatException e) {
+ } catch (System.FormatException) {
SUCCESS_INDICATOR = false;
}
}
@@ -3919,6 +4002,7 @@ string.set_char(Char, Index, !Str) :-
[will_not_call_mercury, promise_pure, thread_safe],
"
if (Index >= Str0.Length) {
+ Str = null;
SUCCESS_INDICATOR = false;
} else {
Str = System.String.Concat(Str0.Substring(0, Index),
@@ -4200,9 +4284,11 @@ string.append_iii(X, Y, Z) :-
[will_not_call_mercury, promise_pure, thread_safe],
"{
if (S3.StartsWith(S1)) {
+ // .Substring() better?
S2 = S3.Remove(0, S1.Length);
SUCCESS_INDICATOR = true;
} else {
+ S2 = null;
SUCCESS_INDICATOR = false;
}
}").
@@ -4386,6 +4472,26 @@ strchars(I, End, Str) = Chars :-
}
}").
+:- pragma foreign_proc("C#",
+ string.substring(Str::in, Start::in, Count::in, SubString::uo),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
+ does_not_affect_liveness, may_not_duplicate, no_sharing],
+"
+ if (Start < 0) Start = 0;
+ if (Count <= 0) {
+ SubString = """";
+ } else {
+ int len = Str.Length;
+ if (Start > len) {
+ Start = len;
+ }
+ if (Count > len - Start) {
+ Count = len - Start;
+ }
+ SubString = Str.Substring(Start, Start + Count);
+ }
+").
+
:- pragma foreign_proc("Java",
string.substring(Str::in, Start::in, Count::in, SubString::uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail,
@@ -4624,6 +4730,7 @@ string.split(Str, Count, Left, Right) :-
First = Str[0];
} else {
SUCCESS_INDICATOR = false;
+ First = (char) 0;
}
").
:- pragma foreign_proc("Java",
@@ -4680,6 +4787,7 @@ string.split(Str, Count, Left, Right) :-
Rest = Str.Substring(1);
} else {
SUCCESS_INDICATOR = false;
+ Rest = null;
}
}").
:- pragma foreign_proc("Java",
@@ -4734,6 +4842,8 @@ string.split(Str, Count, Left, Right) :-
"{
if (Str.Length == 0) {
SUCCESS_INDICATOR = false;
+ First = (char) 0;
+ Rest = null;
} else {
First = Str[0];
Rest = Str.Substring(1);
diff --git a/library/thread.m b/library/thread.m
index 68b041a..2e16afb 100644
--- a/library/thread.m
+++ b/library/thread.m
@@ -389,6 +389,9 @@ INIT mercury_sys_init_thread_modules
:- pragma foreign_export("IL",
call_back_to_mercury(pred(di, uo) is cc_multi, di, uo),
"ML_call_back_to_mercury_cc_multi").
+% :- pragma foreign_export("C#",
+% call_back_to_mercury(pred(di, uo) is cc_multi, di, uo),
+% "ML_call_back_to_mercury_cc_multi").
:- pragma foreign_export("Java",
call_back_to_mercury(pred(di, uo) is cc_multi, di, uo),
"ML_call_back_to_mercury_cc_multi").
@@ -409,7 +412,7 @@ public class MercuryThread {
public void execute_goal()
{
- mercury.thread.mercury_code.ML_call_back_to_mercury_cc_multi(Goal);
+ thread.ML_call_back_to_mercury_cc_multi(Goal);
}
}").
diff --git a/library/thread.semaphore.m b/library/thread.semaphore.m
index db9239f..709ac12 100644
--- a/library/thread.semaphore.m
+++ b/library/thread.semaphore.m
@@ -95,6 +95,7 @@ public class ML_Semaphore {
[can_pass_as_mercury_type]).
:- pragma foreign_type("IL", semaphore,
"class [mercury]mercury.thread.semaphore__csharp_code.mercury_code.ML_Semaphore").
+% :- pragma foreign_type("C#", semaphore, "thread__semaphore.ML_Semaphore").
:- pragma foreign_type("Erlang", semaphore, "").
:- pragma foreign_type("Java", semaphore, "java.util.concurrent.Semaphore").
diff --git a/library/time.m b/library/time.m
index d119e02..7a5fca1 100644
--- a/library/time.m
+++ b/library/time.m
@@ -234,9 +234,12 @@
where comparison is compare_time_t_reps.
% The System.DateTime will hold the value in UTC.
-:- pragma foreign_type(il, time_t_rep, "valuetype [mscorlib]System.DateTime")
+:- pragma foreign_type("IL", time_t_rep, "valuetype [mscorlib]System.DateTime")
where comparison is compare_time_t_reps.
+% :- pragma foreign_type("C#", time_t_rep, "valuetype System.DateTime")
+% where comparison is compare_time_t_reps.
+
:- pragma foreign_type("Java", time_t_rep, "java.util.Date")
where comparison is compare_time_t_reps.
@@ -1007,6 +1010,8 @@ time.ctime(Time) = asctime(localtime(Time)).
"ML_construct_time_t").
:- pragma foreign_export("IL", construct_time_t(in) = out,
"ML_construct_time_t").
+% :- pragma foreign_export("C#", construct_time_t(in) = out,
+% "ML_construct_time_t").
:- pragma foreign_export("Java", construct_time_t(in) = out,
"ML_construct_time_t").
diff --git a/library/type_desc.m b/library/type_desc.m
index 6f76fa7..e4f119a 100644
--- a/library/type_desc.m
+++ b/library/type_desc.m
@@ -329,69 +329,6 @@ type_info_desc_same_representation :-
call_rtti_compare_type_infos(Res, T1, T2) :-
rtti_implementation.compare_type_infos(Res, T1, T2).
-:- pragma foreign_code("C#", "
-
-public static int MR_compare_type_info(object[] t1, object[] t2) {
- object[] res = null;
-
- mercury.type_desc.mercury_code.ML_call_rtti_compare_type_infos(
- ref res, t1, t2);
-// currently comparison_results are always built using low-level data.
-//#ifdef MR_HIGHLEVEL_DATA
-// return res.data_tag;
-//#else
- return System.Convert.ToInt32(res[0]);
-// #endif
-}
-
-public static void
-special___Compare___type_ctor_desc_0_0(
- ref object[] result, object[] x, object[] y)
-{
- mercury.runtime.Errors.SORRY(
- ""foreign code for comparing type_ctor_descs"");
-}
-
-public static bool
-special___Unify___type_ctor_desc_0_0(object[] x, object[] y)
-{
- mercury.runtime.Errors.SORRY(
- ""foreign code for unifying type_ctor_descs"");
- return false;
-}
-
-public static void
-special___Compare___type_desc_0_0(
- ref object[] result, object[] x, object[] y)
-{
- mercury.type_desc.mercury_code.ML_call_rtti_compare_type_infos(
- ref result, x, y);
-}
-
-public static bool
-special___Unify___type_desc_0_0(object[] x, object[] y)
-{
- return (MR_compare_type_info(x, y) == 0);
-}
-
-public static void
-special___Compare___pseudo_type_desc_0_0(
- ref object[] result, object[] x, object[] y)
-{
- mercury.runtime.Errors.SORRY(
- ""foreign code for comparing pseudo_type_desc"");
-}
-
-public static bool
-special___Unify___pseudo_type_desc_0_0(object[] x, object[] y)
-{
- mercury.runtime.Errors.SORRY(
- ""foreign code for unifying pseudo_type_desc"");
- return false;
-}
-
-").
-
%-----------------------------------------------------------------------------%
%
% Code for type manipulation
@@ -475,6 +412,13 @@ is_exist_pseudo_type_desc(PTD, N) :-
PseudoTypeDesc = TypeDesc;
").
+:- pragma foreign_proc("C#",
+ type_desc_to_pseudo_type_desc(TypeDesc::in) = (PseudoTypeDesc::out),
+ [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
+"
+ PseudoTypeDesc = TypeDesc;
+").
+
:- pragma foreign_proc("Java",
type_desc_to_pseudo_type_desc(TypeDesc::in) = (PseudoTypeDesc::out),
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
@@ -808,6 +752,27 @@ pseudo_type_ctor_and_args(PseudoTypeDesc, TypeCtorDesc, ArgPseudoTypeDescs) :-
:- pred make_type_ctor_desc(rtti_implementation.type_info::in,
rtti_implementation.type_ctor_info::in, type_ctor_desc::out) is det.
+:- pragma foreign_proc("C#",
+ make_type_ctor_desc(TypeInfo::in, TypeCtorInfo::in, TypeCtorDesc::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ may_not_duplicate],
+"
+ runtime.TypeCtorInfo_Struct tci = TypeCtorInfo;
+
+ /* Handle variable arity types. */
+ switch (tci.type_ctor_rep) {
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_PRED:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_FUNC:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_TUPLE:
+ tci = new runtime.TypeCtorInfo_Struct(tci, TypeInfo.args.Length);
+ break;
+ default:
+ break;
+ }
+
+ TypeCtorDesc = tci;
+").
+
:- pragma foreign_proc("Java",
make_type_ctor_desc(TypeInfo::in, TypeCtorInfo::in, TypeCtorDesc::out),
[will_not_call_mercury, promise_pure, thread_safe,
@@ -835,6 +800,28 @@ make_type_ctor_desc(_, _, _) :-
:- pred make_type_ctor_desc_with_arity(int::in,
rtti_implementation.type_ctor_info::in, type_ctor_desc::out) is det.
+:- pragma foreign_proc("C#",
+ make_type_ctor_desc_with_arity(Arity::in, TypeCtorInfo::in,
+ TypeCtorDesc::out),
+ [will_not_call_mercury, promise_pure, thread_safe,
+ may_not_duplicate],
+"
+ runtime.TypeCtorInfo_Struct tci = TypeCtorInfo;
+
+ /* Handle variable arity types. */
+ switch (tci.type_ctor_rep) {
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_PRED:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_FUNC:
+ case runtime.TypeCtorRep.MR_TYPECTOR_REP_TUPLE:
+ tci = new runtime.TypeCtorInfo_Struct(tci, Arity);
+ break;
+ default:
+ break;
+ }
+
+ TypeCtorDesc = tci;
+").
+
:- pragma foreign_proc("Java",
make_type_ctor_desc_with_arity(Arity::in, TypeCtorInfo::in,
TypeCtorDesc::out),
@@ -1029,6 +1016,58 @@ get_type_info_for_type_info = TypeDesc :-
%-----------------------------------------------------------------------------%
+:- pragma foreign_code("C#", "
+ public static bool
+ __Unify____type_desc_0_0(
+ runtime.TypeInfo_Struct x,
+ runtime.TypeInfo_Struct y)
+ {
+ return x.Equals(y);
+ }
+
+ public static bool
+ __Unify____type_ctor_desc_0_0(
+ runtime.TypeCtorInfo_Struct x,
+ runtime.TypeCtorInfo_Struct y)
+ {
+ return x.Equals(y);
+ }
+
+ public static builtin.Comparison_result_0
+ __Compare____type_desc_0_0(
+ runtime.TypeInfo_Struct x,
+ runtime.TypeInfo_Struct y)
+ {
+ return rtti_implementation.ML_compare_type_infos(x, y);
+ }
+
+ public static builtin.Comparison_result_0
+ __Compare____type_ctor_desc_0_0(
+ runtime.TypeCtorInfo_Struct x,
+ runtime.TypeCtorInfo_Struct y)
+ {
+ return rtti_implementation.ML_compare_type_ctor_infos(x, y);
+ }
+
+ public static bool
+ __Unify____pseudo_type_desc_0_0(
+ runtime.PseudoTypeInfo x,
+ runtime.PseudoTypeInfo y)
+ {
+ return x.Equals(y);
+ }
+
+ public static builtin.Comparison_result_0
+ __Compare____pseudo_type_desc_0_0(
+ runtime.PseudoTypeInfo x,
+ runtime.PseudoTypeInfo y)
+ {
+ runtime.Errors.SORRY(
+ ""foreign code for comparing pseudo_type_desc"");
+ return builtin.Comparison_result_0.f_equal;
+ }
+").
+
:- pragma foreign_code("Java", "
public static boolean
__Unify____type_desc_0_0(TypeInfo_Struct x, TypeInfo_Struct y)
diff --git a/library/univ.m b/library/univ.m
index 3b0fc1c..7373209 100644
--- a/library/univ.m
+++ b/library/univ.m
@@ -127,6 +127,7 @@ univ_type(Univ) = type_of(univ_value(Univ)).
:- pred construct_univ(T::in, univ::out) is det.
:- pragma foreign_export("C", construct_univ(in, out), "ML_construct_univ").
:- pragma foreign_export("IL", construct_univ(in, out), "ML_construct_univ").
+% :- pragma foreign_export("C#", construct_univ(in, out), "ML_construct_univ").
:- pragma foreign_export("Java", construct_univ(in, out), "ML_construct_univ").
construct_univ(X, Univ) :-
@@ -135,6 +136,7 @@ construct_univ(X, Univ) :-
:- some [T] pred unravel_univ(univ::in, T::out) is det.
:- pragma foreign_export("C", unravel_univ(in, out), "ML_unravel_univ").
:- pragma foreign_export("IL", unravel_univ(in, out), "ML_unravel_univ").
+% :- pragma foreign_export("C#", unravel_univ(in, out), "ML_unravel_univ").
:- pragma foreign_export("Java", unravel_univ(in, out), "ML_unravel_univ").
unravel_univ(Univ, X) :-
diff --git a/runtime/mercury_dotnet.cs.in b/runtime/mercury_dotnet.cs.in
index 7df3dcc..78046c3 100644
--- a/runtime/mercury_dotnet.cs.in
+++ b/runtime/mercury_dotnet.cs.in
@@ -1,5 +1,5 @@
//
-// Copyright (C) 2003-2004 The University of Melbourne.
+// Copyright (C) 2003-2004, 2010 The University of Melbourne.
// This file may only be copied under the terms of the GNU Library General
// Public License - see the file COPYING.LIB in the Mercury distribution.
//
@@ -11,9 +11,561 @@
// C# compiler
using System.Runtime.InteropServices;
-namespace mercury {
+namespace mercury.runtime {
-namespace runtime {
+/*---------------------------------------------------------------------------*/
+
+public delegate void MethodPtr1_r0<A>(A a1);
+public delegate Z MethodPtr1<A, Z>(A a1);
+
+public delegate void MethodPtr2_r0<A,B>(A a1, B a2);
+public delegate Z MethodPtr2<A,B, Z>(A a1, B a2);
+
+public delegate void MethodPtr3_r0<A,B,C>(A a1, B a2, C a3);
+public delegate Z MethodPtr3<A,B,C, Z>(A a1, B a2, C a3);
+
+public delegate void MethodPtr4_r0<A,B,C,D>(A a1, B a2, C a3, D a4);
+public delegate Z MethodPtr4<A,B,C,D, Z>(A a1, B a2, C a3, D a4);
+
+public delegate void MethodPtr5_r0<A,B,C,D,E>(A a1, B a2, C a3, D a4, E a5);
+public delegate Z MethodPtr5<A,B,C,D,E, Z>(A a1, B a2, C a3, D a4, E a5);
+
+public delegate void MethodPtr6_r0<A,B,C,D,E,F>(A a1, B a2, C a3, D a4, E a5,
+ F a6);
+public delegate Z MethodPtr6<A,B,C,D,E,F, Z>(A a1, B a2, C a3, D a4, E a5,
+ F a6);
+
+public delegate void MethodPtr7_r0<A,B,C,D,E,F,G>(A a1, B a2, C a3, D a4,
+ E a5, F a6, G a7);
+public delegate Z MethodPtr7<A,B,C,D,E,F,G, Z>(A a1, B a2, C a3, D a4,
+ E a5, F a6, G a7);
+
+public delegate void MethodPtr8_r0<A,B,C,D,E,F,G,H>(A a1, B a2, C a3, D a4,
+ E a5, F a6, G a7, H a8);
+public delegate Z MethodPtr8<A,B,C,D,E,F,G,H, Z>(A a1, B a2, C a3, D a4,
+ E a5, F a6, G a7, H a8);
+
+public delegate void MethodPtr9_r0<A,B,C,D,E,F,G,H,I>(A a1, B a2, C a3, D a4,
+ E a5, F a6, G a7, H a8, I a9);
+public delegate Z MethodPtr9<A,B,C,D,E,F,G,H,I, Z>(A a1, B a2, C a3, D a4,
+ E a5, F a6, G a7, H a8, I a9);
+
+public delegate void MethodPtr10_r0<A,B,C,D,E,F,G,H,I,J>(A a1, B a2, C a3,
+ D a4, E a5, F a6, G a7, H a8, I a9, J a10);
+public delegate Z MethodPtr10<A,B,C,D,E,F,G,H,I,J, Z>(A a1, B a2, C a3,
+ D a4, E a5, F a6, G a7, H a8, I a9, J a10);
+
+/*---------------------------------------------------------------------------*/
+
+public enum TypeCtorRep {
+ MR_TYPECTOR_REP_ENUM = 0,
+ MR_TYPECTOR_REP_ENUM_USEREQ = 1,
+ MR_TYPECTOR_REP_DU = 2,
+ MR_TYPECTOR_REP_DU_USEREQ = 3,
+ MR_TYPECTOR_REP_NOTAG = 4,
+ MR_TYPECTOR_REP_NOTAG_USEREQ = 5,
+ MR_TYPECTOR_REP_EQUIV = 6,
+ MR_TYPECTOR_REP_FUNC = 7,
+ MR_TYPECTOR_REP_INT = 8,
+ MR_TYPECTOR_REP_CHAR = 9,
+ MR_TYPECTOR_REP_FLOAT = 10,
+ MR_TYPECTOR_REP_STRING = 11,
+ MR_TYPECTOR_REP_PRED = 12,
+ MR_TYPECTOR_REP_SUBGOAL = 13,
+ MR_TYPECTOR_REP_VOID = 14,
+ MR_TYPECTOR_REP_C_POINTER = 15,
+ MR_TYPECTOR_REP_TYPEINFO = 16,
+ MR_TYPECTOR_REP_TYPECLASSINFO = 17,
+ MR_TYPECTOR_REP_ARRAY = 18,
+ MR_TYPECTOR_REP_SUCCIP = 19,
+ MR_TYPECTOR_REP_HP = 20,
+ MR_TYPECTOR_REP_CURFR = 21,
+ MR_TYPECTOR_REP_MAXFR = 22,
+ MR_TYPECTOR_REP_REDOFR = 23,
+ MR_TYPECTOR_REP_REDOIP = 24,
+ MR_TYPECTOR_REP_TRAIL_PTR = 25,
+ MR_TYPECTOR_REP_TICKET = 26,
+ MR_TYPECTOR_REP_NOTAG_GROUND = 27,
+ MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ = 28,
+ MR_TYPECTOR_REP_EQUIV_GROUND = 29,
+ MR_TYPECTOR_REP_TUPLE = 30,
+ MR_TYPECTOR_REP_RESERVED_ADDR = 31,
+ MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ = 32,
+ MR_TYPECTOR_REP_TYPECTORINFO = 33,
+ MR_TYPECTOR_REP_BASETYPECLASSINFO = 34,
+ MR_TYPECTOR_REP_TYPEDESC = 35,
+ MR_TYPECTOR_REP_TYPECTORDESC = 36,
+ MR_TYPECTOR_REP_FOREIGN = 37,
+ MR_TYPECTOR_REP_REFERENCE = 38,
+ MR_TYPECTOR_REP_STABLE_C_POINTER = 39,
+ MR_TYPECTOR_REP_STABLE_FOREIGN = 40,
+ MR_TYPECTOR_REP_PSEUDOTYPEDESC = 41,
+ MR_TYPECTOR_REP_DUMMY = 42,
+ MR_TYPECTOR_REP_BITMAP = 43,
+ MR_TYPECTOR_REP_FOREIGN_ENUM = 44,
+ MR_TYPECTOR_REP_FOREIGN_ENUM_USEREQ = 45,
+ MR_TYPECTOR_REP_UNKNOWN = 46,
+ MR_TYPECTOR_REP_MAX = 47
+}
+
+public class PseudoTypeInfo {
+ public readonly int variable_number;
+
+ public static PseudoTypeInfo K1 = new PseudoTypeInfo(1);
+ public static PseudoTypeInfo K2 = new PseudoTypeInfo(2);
+ public static PseudoTypeInfo K3 = new PseudoTypeInfo(3);
+ public static PseudoTypeInfo K4 = new PseudoTypeInfo(4);
+ public static PseudoTypeInfo K5 = new PseudoTypeInfo(5);
+
+ public PseudoTypeInfo() {
+ this.variable_number = -1;
+ }
+ public PseudoTypeInfo(int variable_number) {
+ this.variable_number = variable_number;
+ }
+}
+
+public class TypeCtorInfo_Struct : PseudoTypeInfo {
+ public int arity;
+ public int type_ctor_version;
+ public int type_ctor_num_ptags;
+ public TypeCtorRep type_ctor_rep;
+ public object unify_pred;
+ public object compare_pred;
+ public string type_ctor_module_name;
+ public string type_ctor_name;
+ public TypeFunctors type_functors;
+ public TypeLayout type_layout;
+ public int type_ctor_num_functors;
+ public short type_ctor_flags;
+ public int[] type_functor_number_map;
+
+ public TypeCtorInfo_Struct() {
+ }
+
+ public TypeCtorInfo_Struct(TypeCtorInfo_Struct other, int arity) {
+ this.init(
+ arity,
+ other.type_ctor_version,
+ other.type_ctor_num_ptags,
+ other.type_ctor_rep,
+ other.unify_pred,
+ other.compare_pred,
+ other.type_ctor_module_name,
+ other.type_ctor_name,
+ other.type_functors,
+ other.type_layout,
+ other.type_ctor_num_functors,
+ other.type_ctor_flags,
+ other.type_functor_number_map
+ );
+ }
+
+ public void init(
+ int type_arity,
+ int version,
+ int num_ptags,
+ TypeCtorRep rep,
+ object unify_proc,
+ object compare_proc,
+ string module,
+ string name,
+ object name_ordered_functor_descs, // TypeFunctors
+ object value_ordered_functor_descs, // TypeLayout
+ int num_functors,
+ short flags,
+ int[] functor_number_map)
+ {
+ arity = type_arity;
+ type_ctor_version = version;
+ type_ctor_num_ptags = num_ptags;
+ type_ctor_rep = rep;
+ unify_pred = unify_proc;
+ compare_pred = compare_proc;
+ type_ctor_module_name = module;
+ type_ctor_name = name;
+ type_functors = (TypeFunctors) name_ordered_functor_descs;
+ type_layout = (TypeLayout) value_ordered_functor_descs;
+ type_ctor_num_functors = num_functors;
+ type_ctor_flags = flags;
+ type_functor_number_map = functor_number_map;
+ }
+
+ public bool Equals(TypeCtorInfo_Struct tci) {
+ if (this == tci) {
+ return true;
+ }
+ return type_ctor_module_name.Equals(tci.type_ctor_module_name)
+ && type_ctor_name.Equals(tci.type_ctor_name)
+ && arity == tci.arity;
+ }
+}
+
+public class TypeInfo_Struct : PseudoTypeInfo {
+ public TypeCtorInfo_Struct type_ctor;
+ public PseudoTypeInfo[] args;
+
+ public TypeInfo_Struct() {
+ }
+
+ public TypeInfo_Struct(TypeCtorInfo_Struct tc) {
+ type_ctor = tc;
+ }
+
+ public TypeInfo_Struct(TypeInfo_Struct ti, int arity, params object[] args)
+ {
+ init(ti.type_ctor, arity, args);
+ }
+
+ public TypeInfo_Struct(TypeInfo_Struct ti, params object[] args) {
+ init(ti.type_ctor, args.Length, args);
+ }
+
+ public static TypeInfo_Struct maybe_new(object obj) {
+ if (obj == null) {
+ return null;
+ }
+ TypeCtorInfo_Struct tc = obj as TypeCtorInfo_Struct;
+ if (tc != null) {
+ return new TypeInfo_Struct(tc);
+ }
+ TypeInfo_Struct ti = obj as TypeInfo_Struct;
+ if (ti != null) {
+ return ti;
+ }
+ // XXX throw exception
+ return null;
+ }
+
+ public void init(TypeCtorInfo_Struct tc, PseudoTypeInfo[] args) {
+ this.type_ctor = tc;
+ this.args = args;
+ }
+
+ // XXX "as" should have type PseudoTypeInfo[],
+ // but because init_array/1 does not store the type.
+ public void init(TypeCtorInfo_Struct tc, object[] os) {
+ init(tc, os.Length, os);
+ }
+
+ // XXX "as" should have type PseudoTypeInfo[],
+ // but because init_array/1 does not store the type.
+ public void init(TypeCtorInfo_Struct tc, int arity, object[] os) {
+ PseudoTypeInfo[] ptis = new PseudoTypeInfo[arity];
+ for (int i = 0; i < arity; i++) {
+ ptis[i] = (PseudoTypeInfo) os[i];
+ }
+ init(tc, ptis);
+ }
+
+ public TypeInfo_Struct copy() {
+ TypeInfo_Struct ti = new TypeInfo_Struct(type_ctor);
+ if (args != null) {
+ ti.args = (PseudoTypeInfo[]) args.Clone();
+ }
+ return ti;
+ }
+
+ public bool Equals(TypeInfo_Struct ti) {
+ if (this == ti) {
+ return true;
+ }
+ if (!type_ctor.Equals(ti.type_ctor)) {
+ return false;
+ }
+
+ int len1 = 0;
+ int len2 = 0;
+ if (args != null) {
+ len1 = args.Length;
+ }
+ if (ti.args != null) {
+ len2 = ti.args.Length;
+ }
+ if (len1 != len2) {
+ return false;
+ }
+
+ for (int i = 0; i < len1; i++) {
+ if (!args[i].Equals(ti.args[i])) {
+ return false;
+ }
+ }
+ return true;
+ }
+}
+
+public class TypeLayout {
+ private readonly object layout_init;
+ public TypeLayout(object init) {
+ layout_init = init;
+ }
+ public DuPtagLayout[] layout_du() {
+ return (DuPtagLayout[]) layout_init;
+ }
+ public EnumFunctorDesc[] layout_enum() {
+ return (EnumFunctorDesc[]) layout_init;
+ }
+ public NotagFunctorDesc[] layout_notag() {
+ return (NotagFunctorDesc[]) layout_init;
+ }
+ public PseudoTypeInfo layout_equiv() {
+ return (PseudoTypeInfo) layout_init;
+ }
+}
+
+public class TypeFunctors {
+ private readonly object functors_init;
+ public TypeFunctors(object init) {
+ functors_init = init;
+ }
+ public DuFunctorDesc[] functors_du() {
+ return (DuFunctorDesc[]) functors_init;
+ }
+ public EnumFunctorDesc[] functors_enum() {
+ return (EnumFunctorDesc[]) functors_init;
+ }
+ public ForeignEnumFunctorDesc[] functors_foreign_enum() {
+ return (ForeignEnumFunctorDesc[]) functors_init;
+ }
+ public NotagFunctorDesc functors_notag() {
+ return (NotagFunctorDesc) functors_init;
+ }
+}
+
+public class DuFunctorDesc {
+ public string du_functor_name;
+ public int du_functor_orig_arity;
+ public int du_functor_arg_type_contains_var;
+ public Sectag_Locn du_functor_sectag_locn;
+ public int du_functor_primary;
+ public int du_functor_secondary;
+ public int du_functor_ordinal;
+ public PseudoTypeInfo[] du_functor_arg_types;
+ public string[] du_functor_arg_names;
+ public DuExistInfo du_functor_exist_info;
+
+ public DuFunctorDesc() {
+ }
+
+ public void init(
+ string functor_name,
+ int orig_arity,
+ int arg_type_contains_var,
+ Sectag_Locn sectag_locn,
+ int primary,
+ int secondary,
+ int ordinal,
+ // XXX why do we need to use object here?
+ object arg_types,
+ object arg_names,
+ object exist_info)
+ {
+ du_functor_name = functor_name;
+ du_functor_orig_arity = orig_arity;
+ du_functor_ordinal = ordinal;
+ du_functor_arg_type_contains_var = arg_type_contains_var;
+ du_functor_sectag_locn = sectag_locn;
+ du_functor_primary = primary;
+ du_functor_secondary = secondary;
+ du_functor_ordinal = ordinal;
+ du_functor_arg_types = (PseudoTypeInfo []) arg_types;
+ du_functor_arg_names = (string[]) arg_names;
+ du_functor_exist_info = (DuExistInfo) exist_info;
+ }
+}
+
+public enum Sectag_Locn {
+ MR_SECTAG_NONE = 0,
+ MR_SECTAG_LOCAL = 1,
+ MR_SECTAG_REMOTE = 2
+}
+
+public class DuPtagLayout {
+ public int sectag_sharers;
+ public Sectag_Locn sectag_locn;
+ public /* final */ DuFunctorDesc[] sectag_alternatives;
+
+ public DuPtagLayout(int sharers, Sectag_Locn locn, DuFunctorDesc[] alts) {
+ sectag_sharers = sharers;
+ sectag_locn = locn;
+ sectag_alternatives = alts;
+ }
+
+ public DuPtagLayout(int sharers, int locn, DuFunctorDesc[] alts)
+ : this(sharers, (Sectag_Locn)locn, alts)
+ {
+ }
+}
+
+public class DuExistInfo {
+ public int exist_typeinfos_plain;
+ public int exist_typeinfos_in_tci;
+ public int exist_tcis;
+ public /* final */ DuExistLocn[] exist_typeinfo_locns;
+ public /* final */ TypeClassConstraint[] exist_constraints;
+
+ public DuExistInfo() {
+ }
+
+ public void init(
+ int typeinfos_plain,
+ int typeinfos_in_tci,
+ int tcis,
+ DuExistLocn[] typeinfo_locns,
+ TypeClassConstraint[] constraints)
+ {
+ exist_typeinfos_plain = typeinfos_plain;
+ exist_typeinfos_in_tci = typeinfos_in_tci;
+ exist_tcis = tcis;
+ exist_typeinfo_locns = typeinfo_locns;
+ exist_constraints = constraints;
+ }
+}
+
+public class DuExistLocn {
+ public int exist_arg_num;
+ public int exist_offset_in_tci;
+
+ public DuExistLocn(int arg_num, int offset_in_tci) {
+ exist_arg_num = arg_num;
+ exist_offset_in_tci = offset_in_tci;
+ }
+}
+
+public class TypeClassConstraint {
+ public TypeClassDeclStruct tc_constr_type_class;
+ public PseudoTypeInfo[] tc_constr_arg_ptis;
+
+ public TypeClassConstraint() {
+ }
+
+ public void init(
+ TypeClassDeclStruct type_class,
+ // XXX object[] should be PseudoTypeInfo[],
+ // but mlds_to_csharp.m generates Object[] since
+ // init_array/1 doesn't give type info
+ object[] ptis)
+ {
+ tc_constr_type_class = type_class;
+ tc_constr_arg_ptis = new PseudoTypeInfo[ptis.Length];
+ for (int i = 0; i < ptis.Length; i++) {
+ tc_constr_arg_ptis[i] = (PseudoTypeInfo) ptis[i];
+ }
+ }
+}
+
+public class TypeClassDeclStruct {
+ public TypeClassId tc_decl_id;
+ public int tc_decl_version_number;
+ public int tc_decl_num_supers; // redundant
+ public TypeClassConstraint tc_decl_supers;
+
+ public TypeClassDeclStruct() {
+ }
+
+ public void init(
+ TypeClassId id,
+ int version_number,
+ int num_supers,
+ TypeClassConstraint supers)
+ {
+ tc_decl_id = id;
+ tc_decl_version_number = version_number;
+ tc_decl_num_supers = num_supers;
+ tc_decl_supers = supers;
+ }
+}
+
+public class TypeClassId {
+ public string tc_id_module_name;
+ public string tc_id_name;
+ public int tc_id_arity;
+ public int tc_id_num_type_vars; // XXX redundant
+ public int tc_id_num_methods; // XXX redundant
+ public string[] tc_id_var_names;
+ public TypeClassMethod[] tc_id_methods;
+
+ public TypeClassId() {
+ }
+
+ public void init(
+ string module_name,
+ string name,
+ int arity,
+ int num_type_vars,
+ int num_methods,
+ string[] var_names,
+ TypeClassMethod[] methods)
+ {
+ tc_id_module_name = module_name;
+ tc_id_name = name;
+ tc_id_arity = arity;
+ tc_id_num_type_vars = num_type_vars;
+ tc_id_num_methods = num_methods;
+ tc_id_var_names = var_names;
+ tc_id_methods = methods;
+ }
+}
+
+public class TypeClassMethod {
+ public string tc_method_name;
+ public int tc_method_arity;
+ public int /* PredFunc */ tc_method_pred_func;
+
+ public TypeClassMethod(string name, int arity, int pred_func) {
+ tc_method_name = name;
+ tc_method_arity = arity;
+ tc_method_pred_func = pred_func;
+ }
+}
+
+public class EnumFunctorDesc {
+ public string enum_functor_name;
+ public int enum_functor_ordinal;
+
+ public EnumFunctorDesc() {
+ }
+
+ public void init(string name, int ordinal) {
+ enum_functor_name = name;
+ enum_functor_ordinal = ordinal;
+ }
+}
+
+public class NotagFunctorDesc {
+ public string no_tag_functor_name;
+ public PseudoTypeInfo no_tag_functor_arg_type;
+ public string no_tag_functor_arg_name;
+
+ public NotagFunctorDesc(
+ string functor_name,
+ PseudoTypeInfo functor_arg_type,
+ object functor_arg_name)
+ {
+ no_tag_functor_name = functor_name;
+ no_tag_functor_arg_type = functor_arg_type;
+ // XXX cast might fail
+ no_tag_functor_arg_name = (string) functor_arg_name;
+ }
+}
+
+public class ForeignEnumFunctorDesc {
+ public string foreign_enum_functor_name;
+ public int foreign_enum_functor_ordinal;
+ public int foreign_enum_functor_value;
+
+ public ForeignEnumFunctorDesc() {
+ }
+
+ public void init(string name, int ordinal, int val) {
+ foreign_enum_functor_name = name;
+ foreign_enum_functor_ordinal = ordinal;
+ foreign_enum_functor_value = val;
+ }
+}
+
+/*---------------------------------------------------------------------------*/
public class SystemException : System.Exception
{
@@ -40,72 +592,42 @@ public class Errors
}
}
-public class Environment
+public class Exception : System.Exception
{
-}
+ private object _exception; // univ.Univ_0
+
+ public Exception(object exception) {
+ this._exception = exception;
+ }
+
+ public object exception {
+ get { return _exception; }
+ }
+};
public class Commit : System.Exception
{
}
+public class UnreachableDefault : System.Exception {
+}
+
+/*---------------------------------------------------------------------------*/
+
public class Constants
{
- // These constants are duplicated in library/private_builtin.m.
- // They must be kept sychronized.
-
- // XXX It would be nice if these could be const or an enum, but
- // there are some problems with accessing the values from IL if we do
- // that because neither alternatives seem to define field names we
- // can reference from IL.
-
- public static int MR_TYPECTOR_REP_ENUM = 0;
- public static int MR_TYPECTOR_REP_ENUM_USEREQ = 1;
- public static int MR_TYPECTOR_REP_DU = 2;
- public static int MR_TYPECTOR_REP_DU_USEREQ = 3;
- public static int MR_TYPECTOR_REP_NOTAG = 4;
- public static int MR_TYPECTOR_REP_NOTAG_USEREQ = 5;
- public static int MR_TYPECTOR_REP_EQUIV = 6;
- public static int MR_TYPECTOR_REP_FUNC = 7;
- public static int MR_TYPECTOR_REP_INT = 8;
- public static int MR_TYPECTOR_REP_CHAR = 9;
- public static int MR_TYPECTOR_REP_FLOAT =10;
- public static int MR_TYPECTOR_REP_STRING =11;
- public static int MR_TYPECTOR_REP_PRED =12;
- public static int MR_TYPECTOR_REP_SUBGOAL =13;
- public static int MR_TYPECTOR_REP_VOID =14;
- public static int MR_TYPECTOR_REP_C_POINTER =15;
- public static int MR_TYPECTOR_REP_TYPEINFO =16;
- public static int MR_TYPECTOR_REP_TYPECLASSINFO =17;
- public static int MR_TYPECTOR_REP_ARRAY =18;
- public static int MR_TYPECTOR_REP_SUCCIP =19;
- public static int MR_TYPECTOR_REP_HP =20;
- public static int MR_TYPECTOR_REP_CURFR =21;
- public static int MR_TYPECTOR_REP_MAXFR =22;
- public static int MR_TYPECTOR_REP_REDOFR =23;
- public static int MR_TYPECTOR_REP_REDOIP =24;
- public static int MR_TYPECTOR_REP_TRAIL_PTR =25;
- public static int MR_TYPECTOR_REP_TICKET =26;
- public static int MR_TYPECTOR_REP_NOTAG_GROUND =27;
- public static int MR_TYPECTOR_REP_NOTAG_GROUND_USEREQ =28;
- public static int MR_TYPECTOR_REP_EQUIV_GROUND =29;
- public static int MR_TYPECTOR_REP_TUPLE =30;
- public static int MR_TYPECTOR_REP_RESERVED_ADDR =31;
- public static int MR_TYPECTOR_REP_RESERVED_ADDR_USEREQ =32;
- public static int MR_TYPECTOR_REP_TYPECTORINFO =33;
- public static int MR_TYPECTOR_REP_BASETYPECLASSINFO =34;
- public static int MR_TYPECTOR_REP_TYPEDESC =35;
- public static int MR_TYPECTOR_REP_TYPECTORDESC =36;
- public static int MR_TYPECTOR_REP_FOREIGN =37;
- public static int MR_TYPECTOR_REP_REFERENCE =38;
- public static int MR_TYPECTOR_REP_STABLE_C_POINTER =39;
- public static int MR_TYPECTOR_REP_UNKNOWN =40;
-
- public static int MR_SECTAG_NONE = 0;
- public static int MR_SECTAG_LOCAL = 1;
- public static int MR_SECTAG_REMOTE = 2;
-
- public static string MR_VERSION = "@VERSION@";
- public static string MR_FULLARCH = "@FULLARCH@";
+ public static readonly int MR_PREDICATE = 0;
+ public static readonly int MR_FUNCTION = 1;
+
+ public static readonly string MR_VERSION = "@VERSION@";
+ public static readonly string MR_FULLARCH = "@FULLARCH@";
+}
+
+/*---------------------------------------------------------------------------*/
+
+#if !MR_HIGHLEVEL_DATA
+public class Environment
+{
}
public class LowLevelData
@@ -155,6 +677,7 @@ public class LowLevelData
return ((object[]) w[2]);
}
}
+#endif
class PInvoke {
[System.Runtime.InteropServices.DllImport("msvcrt.dll")]
@@ -162,4 +685,5 @@ class PInvoke {
}
}
-}
+
+/* vim: set sts=4 sw=4 et: */
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list