[m-rev.] for review: C# backend
Peter Wang
novalazy at gmail.com
Wed Sep 22 17:16:03 AEST 2010
Branches: main
Improve the C# backend.
C# foreign types remain commented out so as not to force an upgrade of the
bootstrap compiler yet.
compiler/handle_options.m:
Enable static ground cells for C# backend.
compiler/ml_global_data.m:
Make fields of static vector structures have `public' access.
Local access doesn't make sense.
Use structs to hold vector common data in C#.
Conform to changes.
compiler/ml_proc_gen.m:
Enable use_common_cells on C#.
Conform to changes.
compiler/mlds.m:
Rename `finality' to `overridability'. The `final' keyword in Java
has multiple meanings, so avoid that word. Use the word `sealed'
to describe classes or virtual methods which cannot be overridden,
which is the keyword in C#.
compiler/ml_switch_gen.m:
Remember the types of mlconst_foreign constants. In the C# backend a
foreign enum value needs to be cast to the right type. For some
reason, there was a field already which could be used for this purpose
but was only ever set to mlds_native_int_type.
compiler/ml_type_gen.m:
Replace ml_gen_final_member_decl_flags with
ml_gen_const_member_decl_flags. Return flags with the `sealed' flag
unset, as that wouldn't make sense for member variables.
Remember the type in mlconst_foreign.
compiler/ml_unify_gen.m:
Remember the type in mlconst_foreign.
compiler/mlds_to_cs.m:
Support static data in C#.
Support foreign enumerations.
Use the `default(T)' operator to initialise certain types of variables,
particularly user-defined types, which the Mercury compiler may not
know enumeration defined in another module, i.e. a value type, which
cannot be initialised with `null'.
Remove the requirement to add mark foreign types which are of value
types with the "valuetype" prefix.
compiler/mlds_to_java.m:
Write out the `final' keyword when either the `sealed' or `const' flags
are set.
Conform to changes.
compiler/rtti_to_mlds.m:
RTTI data doesn't need the `sealed' flag set.
compiler/ml_code_util.m:
compiler/mlds_to_c.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/ml_elim_nested.m:
Conform to changes.
library/builtin.m:
Export `comparison_result' to C# foreign code.
Fix `deep_copy' for arrays.
library/bitmap.m:
library/pretty_printer.m:
library/store.m:
library/version_array.m:
library/version_hash_table.m:
Implement these modules for C#.
library/io.m:
library/dir.m:
Implement `dir.current_directory' for C#.
library/exception.m:
Implement `catch_impl' for multi and nondet predicates.
library/rtti_implementation.m:
Implement `get_typeclass_info_from_term' for C#.
library/string.m:
Fix `string.set_char' for C#.
library/time.m:
Delete now-unnecessary "valuetype" prefix on foreign type.
library/type_desc.m:
Implement `make_type' for C#.
runtime/mercury_dotnet.cs.in:
Collapse equivalences when comparing TypeInfo_Structs for equality.
tests/hard_coded/Mmakefile:
Disable some tests in C# grade.
tests/hard_coded/ee_dummy.m:
tests/hard_coded/ee_valid_test.m:
tests/hard_coded/equality_pred_which_requires_boxing.m:
tests/hard_coded/exported_foreign_enum.m:
tests/hard_coded/export_test.m:
tests/hard_coded/external_unification_pred.m:
tests/hard_coded/float_gv.m:
tests/hard_coded/foreign_enum_dummy.m:
tests/hard_coded/foreign_import_module_2.m:
tests/hard_coded/foreign_name_mutable.m:
tests/hard_coded/foreign_type2.m:
tests/hard_coded/foreign_type3.m:
tests/hard_coded/foreign_type.m:
tests/hard_coded/hash_table_test.m:
tests/hard_coded/impure_init_and_final.m:
tests/hard_coded/intermod_poly_mode_2.m:
tests/hard_coded/loop_inv_test1.m:
tests/hard_coded/loop_inv_test.m:
tests/hard_coded/multimode.m:
tests/hard_coded/pragma_export.m:
tests/hard_coded/pragma_foreign_export.m:
tests/hard_coded/redoip_clobber.m:
tests/hard_coded/trace_goal_4.m:
tests/hard_coded/uc_export_enum.m:
tests/hard_coded/user_compare.m:
tests/hard_coded/write_xml.m:
Make these test cases work on C#.
tests/hard_coded/deep_copy.exp3:
tests/hard_coded/expand.exp3:
tests/hard_coded/float_reg.exp3:
Add expected results for C#.
tests/hard_coded/string_strip.exp2:
Update this result, which was not updated when the test case changed
previously.
diff --git a/compiler/handle_options.m b/compiler/handle_options.m
index bc78832..f333de3 100644
--- a/compiler/handle_options.m
+++ b/compiler/handle_options.m
@@ -754,14 +754,7 @@ 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),
- % XXX C# static data support not yet implemented
- (
- Target = target_csharp,
- globals.set_option(static_ground_cells, bool(no), !Globals)
- ;
- Target = target_java
- )
+ globals.set_option(cross_compiling, bool(yes), !Globals)
;
( Target = target_c
; Target = target_il
diff --git a/compiler/ml_code_util.m b/compiler/ml_code_util.m
index 5cdd338..0cbd8bc 100644
--- a/compiler/ml_code_util.m
+++ b/compiler/ml_code_util.m
@@ -761,11 +761,11 @@ ml_gen_label_func_decl_flags = DeclFlags :-
Access = acc_local,
PerInstance = per_instance,
Virtuality = non_virtual,
- Finality = overridable,
+ Overridability = overridable,
Constness = modifiable,
Abstractness = concrete,
- DeclFlags = init_decl_flags(Access, PerInstance, Virtuality, Finality,
- Constness, Abstractness).
+ DeclFlags = init_decl_flags(Access, PerInstance, Virtuality,
+ Overridability, Constness, Abstractness).
%-----------------------------------------------------------------------------%
%
@@ -1342,21 +1342,21 @@ ml_gen_public_field_decl_flags = DeclFlags :-
Access = acc_public,
PerInstance = per_instance,
Virtuality = non_virtual,
- Finality = overridable,
+ Overridability = overridable,
Constness = modifiable,
Abstractness = concrete,
DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
ml_gen_local_var_decl_flags = DeclFlags :-
Access = acc_local,
PerInstance = per_instance,
Virtuality = non_virtual,
- Finality = overridable,
+ Overridability = overridable,
Constness = modifiable,
Abstractness = concrete,
DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
ml_var_name_to_string(mlds_var_name(Var, yes(Num))) =
Var ++ "_" ++ string.int_to_string(Num).
diff --git a/compiler/ml_elim_nested.m b/compiler/ml_elim_nested.m
index f5d9af3..7b92014 100644
--- a/compiler/ml_elim_nested.m
+++ b/compiler/ml_elim_nested.m
@@ -1048,11 +1048,11 @@ ml_gen_gc_trace_func_decl_flags = MLDS_DeclFlags :-
Access = acc_private,
PerInstance = one_copy,
Virtuality = non_virtual,
- Finality = overridable,
+ Overridability = overridable,
Constness = modifiable,
Abstractness = concrete,
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
:- pred extract_gc_statements(mlds_defn::in, mlds_defn::out,
list(statement)::out, list(statement)::out) is det.
@@ -1234,11 +1234,11 @@ env_type_decl_flags = MLDS_DeclFlags :-
Access = acc_private,
PerInstance = one_copy,
Virtuality = non_virtual,
- Finality = overridable,
+ Overridability = overridable,
Constness = modifiable,
Abstractness = concrete,
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
% Generate a block statement, i.e. `{ <Decls>; <Statements>; }'.
% But if the block consists only of a single statement with no
diff --git a/compiler/ml_global_data.m b/compiler/ml_global_data.m
index 95e01fb..66709e1 100644
--- a/compiler/ml_global_data.m
+++ b/compiler/ml_global_data.m
@@ -461,8 +461,8 @@ ml_gen_static_vector_type(MLDS_ModuleName, MLDS_Context, Target, ArgTypes,
map.det_insert(TypeNumMap0, ArgTypes, TypeNum, TypeNumMap),
!GlobalData ^ mgd_vector_type_num_map := TypeNumMap,
- FieldFlags = init_decl_flags(acc_local, per_instance, non_virtual,
- final, const, concrete),
+ FieldFlags = init_decl_flags(acc_public, per_instance, non_virtual,
+ overridable, const, concrete),
FieldNamePrefix = "vct_" ++ TypeRawNumStr,
ml_gen_vector_cell_field_types(MLDS_Context, FieldFlags,
FieldNamePrefix, 0, ArgTypes, FieldNames, FieldDefns),
@@ -472,8 +472,13 @@ ml_gen_static_vector_type(MLDS_ModuleName, MLDS_Context, Target, ArgTypes,
ClassKind = mlds_struct,
CtorDefns = []
;
- Target = target_java,
- ClassKind = mlds_class,
+ (
+ Target = target_java,
+ ClassKind = mlds_class
+ ;
+ Target = target_csharp,
+ ClassKind = mlds_struct
+ ),
CtorDefn = ml_gen_constructor_function(Target, StructType,
StructType, MLDS_ModuleName, StructType, no, FieldDefns,
MLDS_Context),
@@ -481,7 +486,6 @@ 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
),
@@ -497,7 +501,7 @@ ml_gen_static_vector_type(MLDS_ModuleName, MLDS_Context, Target, ArgTypes,
% The "modifiable" is only to shut up a gcc warning about constant
% fields.
StructTypeFlags = init_decl_flags(acc_private, one_copy,
- non_virtual, final, modifiable, concrete),
+ non_virtual, sealed, modifiable, concrete),
StructTypeDefn = mlds_defn(StructTypeEntityName, MLDS_Context,
StructTypeFlags, StructTypeEntityDefn),
QualStructTypeName =
diff --git a/compiler/ml_proc_gen.m b/compiler/ml_proc_gen.m
index e9a009f..371e9ed 100644
--- a/compiler/ml_proc_gen.m
+++ b/compiler/ml_proc_gen.m
@@ -267,15 +267,14 @@ 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_csharp
; Target = target_java
),
UseCommonCells = use_common_cells
;
( Target = target_asm
; Target = target_il
- ; Target = target_csharp
; Target = target_erlang
; Target = target_x86_64
),
@@ -494,11 +493,11 @@ ml_gen_proc_decl_flags(ModuleInfo, PredId, ProcId) = DeclFlags :-
),
PerInstance = one_copy,
Virtuality = non_virtual,
- Finality = overridable,
+ Overridability = overridable,
Constness = modifiable,
Abstractness = concrete,
DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
% For model_det and model_semi procedures, figure out which output
% variables are returned by value (rather than being passed by reference)
@@ -977,10 +976,10 @@ tabling_data_decl_flags(Constness) = MLDS_DeclFlags :-
Access = acc_private,
PerInstance = one_copy,
Virtuality = non_virtual,
- Finality = final,
+ Overridability = sealed,
Abstractness = concrete,
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
%-----------------------------------------------------------------------------%
%
diff --git a/compiler/ml_switch_gen.m b/compiler/ml_switch_gen.m
index af90435..2108815 100644
--- a/compiler/ml_switch_gen.m
+++ b/compiler/ml_switch_gen.m
@@ -566,8 +566,7 @@ ml_tagged_cons_id_to_match_cond(MLDS_Type, TaggedConsId, MatchCond) :-
Rval = ml_const(mlconst_string(String))
;
Tag = foreign_tag(ForeignLang, ForeignTag),
- Rval = ml_const(mlconst_foreign(ForeignLang, ForeignTag,
- mlds_native_int_type))
+ Rval = ml_const(mlconst_foreign(ForeignLang, ForeignTag, MLDS_Type))
;
( Tag = float_tag(_)
; Tag = closure_tag(_, _, _)
diff --git a/compiler/ml_type_gen.m b/compiler/ml_type_gen.m
index 5643a39..d6c90be 100644
--- a/compiler/ml_type_gen.m
+++ b/compiler/ml_type_gen.m
@@ -71,9 +71,9 @@
:- func ml_gen_member_decl_flags = mlds_decl_flags.
% Return the declaration flags appropriate for a member variable
- % with finality `final'.
+ % which is read-only after initialisation.
%
-:- func ml_gen_final_member_decl_flags = mlds_decl_flags.
+:- func ml_gen_const_member_decl_flags = mlds_decl_flags.
% ml_uses_secondary_tag(TypeCtor, ConsTagValues, Ctor, SecondaryTag):
% Check if this constructor uses a secondary tag,
@@ -316,7 +316,7 @@ ml_gen_enum_constant(Context, TypeCtor, ConsTagValues, MLDS_Type, Ctor)
;
TagVal = foreign_tag(ForeignLang, ForeignTagValue),
ConstValue = ml_const(mlconst_foreign(ForeignLang, ForeignTagValue,
- mlds_native_int_type))
+ MLDS_Type))
;
( TagVal = string_tag(_)
; TagVal = float_tag(_)
@@ -1148,41 +1148,41 @@ ml_gen_type_decl_flags = MLDS_DeclFlags :-
Access = acc_public,
PerInstance = one_copy,
Virtuality = non_virtual,
- Finality = overridable,
+ Overridability = overridable,
Constness = modifiable,
Abstractness = concrete,
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
ml_gen_member_decl_flags = MLDS_DeclFlags :-
Access = acc_public,
PerInstance = per_instance,
Virtuality = non_virtual,
- Finality = overridable,
+ Overridability = overridable,
Constness = modifiable,
Abstractness = concrete,
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
-ml_gen_final_member_decl_flags = MLDS_DeclFlags :-
+ml_gen_const_member_decl_flags = MLDS_DeclFlags :-
Access = acc_public,
PerInstance = per_instance,
Virtuality = non_virtual,
- Finality = final,
+ Overridability = overridable,
Constness = const,
Abstractness = concrete,
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
ml_gen_enum_constant_decl_flags = MLDS_DeclFlags :-
Access = acc_public,
PerInstance = one_copy,
Virtuality = non_virtual,
- Finality = final,
+ Overridability = overridable,
Constness = const,
Abstractness = concrete,
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
%----------------------------------------------------------------------------%
@@ -1238,8 +1238,7 @@ generate_foreign_enum_constant(TypeCtor, Mapping, TagValues, MLDS_Type, Ctor,
ConstValue = ml_const(mlconst_enum(Int, MLDS_Type))
;
TagVal = foreign_tag(Lang, String),
- ConstValue = ml_const(mlconst_foreign(Lang, String,
- mlds_native_int_type))
+ ConstValue = ml_const(mlconst_foreign(Lang, String, MLDS_Type))
;
( TagVal = string_tag(_)
; TagVal = float_tag(_)
diff --git a/compiler/ml_unify_gen.m b/compiler/ml_unify_gen.m
index 5956676..f1a187e 100644
--- a/compiler/ml_unify_gen.m
+++ b/compiler/ml_unify_gen.m
@@ -414,8 +414,7 @@ ml_gen_constant(Tag, VarType, MLDS_VarType, Rval, !Info) :-
Rval = ml_const(mlconst_string(String))
;
Tag = foreign_tag(ForeignLang, ForeignTag),
- Rval = ml_const(mlconst_foreign(ForeignLang, ForeignTag,
- mlds_native_int_type))
+ Rval = ml_const(mlconst_foreign(ForeignLang, ForeignTag, MLDS_VarType))
;
Tag = shared_local_tag(Bits1, Num1),
Rval = ml_unop(cast(MLDS_VarType), ml_mkword(Bits1,
@@ -1797,8 +1796,8 @@ ml_gen_tag_test_rval(Tag, Type, ModuleInfo, Rval) = TagTestRval :-
TagTestRval = ml_binop(eq, Rval, ConstRval)
;
Tag = foreign_tag(ForeignLang, ForeignVal),
- Const = ml_const(mlconst_foreign(ForeignLang, ForeignVal,
- mlds_native_int_type)),
+ MLDS_Type = mercury_type_to_mlds_type(ModuleInfo, Type),
+ Const = ml_const(mlconst_foreign(ForeignLang, ForeignVal, MLDS_Type)),
TagTestRval = ml_binop(eq, Rval, Const)
;
( Tag = closure_tag(_, _, _)
@@ -2107,7 +2106,7 @@ ml_gen_ground_term_conjunct_tag(ModuleInfo, Target, HighLevelData, VarTypes,
;
ConsTag = foreign_tag(ForeignLang, ForeignTag),
ConstRval = ml_const(mlconst_foreign(ForeignLang, ForeignTag,
- mlds_native_int_type))
+ MLDS_Type))
),
expect(unify(Args, []), this_file,
"ml_gen_ground_term_conjunct_tag: constant tag with args"),
diff --git a/compiler/mlds.m b/compiler/mlds.m
index fac6adc..09c2a9a 100644
--- a/compiler/mlds.m
+++ b/compiler/mlds.m
@@ -500,7 +500,7 @@
% access, % public/private/protected
% member_type, % static/per_instance
% virtuality, % virtual/non_virtual
- % finality, % final/overridable (funcs only)
+ % overridability, % sealed/overridable (class/funcs only)
% constness, % const/modifiable (data only)
% is_abstract, % abstract/concrete
% etc.
@@ -899,9 +899,10 @@
---> non_virtual
; virtual.
-:- type finality
+:- type overridability
---> overridable
- ; final.
+ ; sealed. % i.e. the class cannot be inherited from,
+ % or the virtual method is not overridable.
:- type constness
---> modifiable
@@ -914,18 +915,18 @@
:- func access(mlds_decl_flags) = access.
:- func per_instance(mlds_decl_flags) = per_instance.
:- func virtuality(mlds_decl_flags) = virtuality.
-:- func finality(mlds_decl_flags) = finality.
+:- func overridability(mlds_decl_flags) = overridability.
:- func constness(mlds_decl_flags) = constness.
:- func abstractness(mlds_decl_flags) = abstractness.
:- func set_access(mlds_decl_flags, access) = mlds_decl_flags.
:- func set_per_instance(mlds_decl_flags, per_instance) = mlds_decl_flags.
:- func set_virtuality(mlds_decl_flags, virtuality) = mlds_decl_flags.
-:- func set_finality(mlds_decl_flags, finality) = mlds_decl_flags.
+:- func set_overridability(mlds_decl_flags, overridability) = mlds_decl_flags.
:- func set_constness(mlds_decl_flags, constness) = mlds_decl_flags.
:- func set_abstractness(mlds_decl_flags, abstractness) = mlds_decl_flags.
-:- func init_decl_flags(access, per_instance, virtuality, finality,
+:- func init_decl_flags(access, per_instance, virtuality, overridability,
constness, abstractness) = mlds_decl_flags.
% Return the declaration flags appropriate for an initialized
@@ -2165,14 +2166,14 @@ virtuality_bits(virtual) = 0x10.
:- func virtuality_mask = int.
virtuality_mask = virtuality_bits(virtual).
-:- func finality_bits(finality) = int.
-:- mode finality_bits(in) = out is det.
-:- mode finality_bits(out) = in is semidet.
-finality_bits(overridable) = 0x00.
-finality_bits(final) = 0x20.
+:- func overridability_bits(overridability) = int.
+:- mode overridability_bits(in) = out is det.
+:- mode overridability_bits(out) = in is semidet.
+overridability_bits(overridable) = 0x00.
+overridability_bits(sealed) = 0x20.
-:- func finality_mask = int.
-finality_mask = finality_bits(final).
+:- func overridability_mask = int.
+overridability_mask = overridability_bits(sealed).
:- func constness_bits(constness) = int.
:- mode constness_bits(in) = out is det.
@@ -2217,9 +2218,9 @@ virtuality(Flags) = Virtuality :-
unexpected(this_file, "virtuality: unknown bits")
).
-finality(Flags) = Finality :-
- ( Flags /\ finality_mask = finality_bits(FinalityPrime) ->
- Finality = FinalityPrime
+overridability(Flags) = Overridability :-
+ ( Flags /\ overridability_mask = overridability_bits(Overridability0) ->
+ Overridability = Overridability0
;
unexpected(this_file, "per_instance: unknown bits")
).
@@ -2251,8 +2252,8 @@ set_per_instance(Flags, PerInstance) =
set_virtuality(Flags, Virtuality) =
Flags /\ \virtuality_mask \/ virtuality_bits(Virtuality).
-set_finality(Flags, Finality) =
- Flags /\ \finality_mask \/ finality_bits(Finality).
+set_overridability(Flags, Overridability) =
+ Flags /\ \overridability_mask \/ overridability_bits(Overridability).
set_constness(Flags, Constness) =
Flags /\ \constness_mask \/ constness_bits(Constness).
@@ -2260,12 +2261,12 @@ set_constness(Flags, Constness) =
set_abstractness(Flags, Abstractness) =
Flags /\ \abstractness_mask \/ abstractness_bits(Abstractness).
-init_decl_flags(Access, PerInstance, Virtuality, Finality, Constness,
+init_decl_flags(Access, PerInstance, Virtuality, Overridability, Constness,
Abstractness) =
access_bits(Access) \/
per_instance_bits(PerInstance) \/
virtuality_bits(Virtuality) \/
- finality_bits(Finality) \/
+ overridability_bits(Overridability) \/
constness_bits(Constness) \/
abstractness_bits(Abstractness).
@@ -2275,11 +2276,11 @@ ml_static_const_decl_flags = DeclFlags :-
Access = acc_local,
PerInstance = one_copy,
Virtuality = non_virtual,
- Finality = final,
+ Overridability = overridable,
Constness = const,
Abstractness = concrete,
DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
%-----------------------------------------------------------------------------%
diff --git a/compiler/mlds_to_c.m b/compiler/mlds_to_c.m
index c31b2e2..af14c85 100644
--- a/compiler/mlds_to_c.m
+++ b/compiler/mlds_to_c.m
@@ -1405,8 +1405,7 @@ mlds_output_exported_enum_constant(ExportedConstant, !IO) :-
->
io.write_int(Value, !IO)
;
- Initializer = init_obj(ml_const(mlconst_foreign(Lang, Value,
- mlds_native_int_type)))
+ Initializer = init_obj(ml_const(mlconst_foreign(Lang, Value, _)))
->
expect(unify(Lang, lang_c), this_file,
"mlconst_foreign for language other than C."),
@@ -2948,7 +2947,7 @@ mlds_output_decl_flags(Opts, Flags, DeclOrDefn, Name, DefnBody, !IO) :-
mlds_output_extern_or_static(access(Flags), per_instance(Flags),
DeclOrDefn, Name, DefnBody, !IO),
mlds_output_virtuality(virtuality(Flags), !IO),
- mlds_output_finality(finality(Flags), !IO),
+ mlds_output_overridability(overridability(Flags), !IO),
mlds_output_constness(constness(Flags), !IO),
mlds_output_abstractness(abstractness(Flags), !IO).
@@ -3014,11 +3013,11 @@ mlds_output_virtuality(virtual, !IO) :-
io.write_string("virtual ", !IO).
mlds_output_virtuality(non_virtual, !IO).
-:- pred mlds_output_finality(finality::in, io::di, io::uo) is det.
+:- pred mlds_output_overridability(overridability::in, io::di, io::uo) is det.
-mlds_output_finality(final, !IO) :-
- io.write_string("/* final */ ", !IO).
-mlds_output_finality(overridable, !IO).
+mlds_output_overridability(sealed, !IO) :-
+ io.write_string("/* sealed */ ", !IO).
+mlds_output_overridability(overridable, !IO).
:- pred mlds_output_constness(constness::in, io::di, io::uo) is det.
@@ -4428,7 +4427,7 @@ mlds_output_binop(Opts, Op, X, Y, !IO) :-
:- pred mlds_output_rval_const(mlds_to_c_opts::in, mlds_rval_const::in,
io::di, io::uo) is det.
-mlds_output_rval_const(Opts, Const, !IO) :-
+mlds_output_rval_const(_Opts, Const, !IO) :-
(
Const = mlconst_true,
io.write_string("MR_TRUE", !IO)
@@ -4448,12 +4447,10 @@ mlds_output_rval_const(Opts, Const, !IO) :-
io.write_string("(MR_Char) ", !IO),
io.write_int(C, !IO)
;
- Const = mlconst_foreign(Lang, Value, Type),
+ Const = mlconst_foreign(Lang, Value, _Type),
expect(unify(Lang, lang_c), this_file,
"output_rval_const - mlconst_foreign for language other than C."),
- io.write_string("((", !IO),
- mlds_output_type(Opts, Type, !IO),
- io.write_string(") ", !IO),
+ io.write_string("((int) ", !IO),
io.write_string(Value, !IO),
io.write_string(")", !IO)
;
diff --git a/compiler/mlds_to_cs.m b/compiler/mlds_to_cs.m
index 3c5e9af..e932438 100644
--- a/compiler/mlds_to_cs.m
+++ b/compiler/mlds_to_cs.m
@@ -125,7 +125,7 @@ output_csharp_src_file(ModuleInfo, Indent, MLDS, !IO) :-
MLDS = mlds(ModuleName, AllForeignCode, Imports, GlobalData, Defns0,
InitPreds, _FinalPreds, ExportedEnums),
ml_global_data_get_all_global_defns(GlobalData,
- _ScalarCellGroupMap, _VectorCellGroupMap, GlobalDefns),
+ ScalarCellGroupMap, VectorCellGroupMap, GlobalDefns),
Defns = GlobalDefns ++ Defns0,
% Get the foreign code for C#
@@ -158,10 +158,10 @@ output_csharp_src_file(ModuleInfo, Indent, MLDS, !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),
+ 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),
+ output_vector_common_data(Info, Indent + 1, VectorCellGroupMap, !IO),
io.write_string("\n// NonDataDefns\n", !IO),
output_defns(Info, Indent + 1, none, NonDataDefns, !IO),
@@ -178,7 +178,13 @@ output_csharp_src_file(ModuleInfo, Indent, MLDS, !IO) :-
io.write_string("\n// EnvVarNames\n", !IO),
output_env_vars(Indent + 1, NonRttiDefns, !IO),
- StaticCtorCalls = ["MR_init_rtti", "MR_init_data" | InitPreds],
+ StaticCtorCalls = [
+ "MR_init_rtti",
+ "MR_init_data",
+ "MR_init_scalar_common_data",
+ "MR_init_vector_common_data"
+ | InitPreds
+ ],
output_static_constructor(ModuleName, Indent + 1, StaticCtorCalls, !IO),
output_src_end(Indent, ModuleName, !IO).
@@ -605,6 +611,14 @@ output_defn(Info, Indent, OutputAux, Defn, !IO) :-
->
OverrideFlags = set_per_instance(Flags, per_instance)
;
+ % `static' and `sealed' not wanted or allowed on structs.
+ DefnBody = mlds_class(ClassDefn),
+ Kind = ClassDefn ^ mcd_kind,
+ Kind = mlds_struct
+ ->
+ OverrideFlags0 = set_per_instance(Flags, per_instance),
+ OverrideFlags = set_overridability(OverrideFlags0, overridable)
+ ;
OverrideFlags = Flags
),
output_decl_flags(Info, OverrideFlags, !IO),
@@ -686,10 +700,12 @@ output_class_kind(Kind, !IO) :-
;
( Kind = mlds_class
; Kind = mlds_package
- ; Kind = mlds_struct
),
io.write_string("class ", !IO)
;
+ Kind = mlds_struct,
+ io.write_string("struct ", !IO)
+ ;
Kind = mlds_enum,
io.write_string("enum ", !IO)
).
@@ -776,20 +792,15 @@ interface_to_string(Interface, String) :-
output_class_body(Info, Indent, Kind, UnqualName, AllMembers, !IO) :-
(
- Kind = mlds_class,
+ ( Kind = mlds_class
+ ; Kind = mlds_interface
+ ; Kind = mlds_struct
+ ),
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)
@@ -817,25 +828,34 @@ output_enum_constants(Info, Indent, EnumName, EnumConsts, !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) :-
+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),
+ % The name might require mangling.
+ indent_line(Indent, !IO),
+ output_name(Name, !IO),
+ io.write_string(" = ", !IO),
( 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)
+ io.write_int(N, !IO)
+ ; Rval = ml_const(mlconst_foreign(lang_csharp, String, Type)) ->
+ io.write_string("(", !IO),
+ output_type(Info, Type, !IO),
+ io.write_string(") ", !IO),
+ io.write_string(String, !IO)
;
- unexpected(this_file, "output_enum_constant: not mlconst_enum")
- )
+ unexpected(this_file,
+ "output_enum_constant: " ++ string(Rval))
+ ),
+ io.write_string(",", !IO)
;
( Initializer = no_initializer
; Initializer = init_struct(_, _)
; Initializer = init_array(_)
),
- unexpected(this_file, "output_enum_constant: not mlconst_enum")
+ unexpected(this_file,
+ "output_enum_constant: " ++ string(Initializer))
)
;
unexpected(this_file,
@@ -855,10 +875,9 @@ 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),
+ % We can't honour `readonly' here as the variable is assigned separately.
+ NonReadonlyFlags = set_constness(Flags, modifiable),
+ output_decl_flags(Info, NonReadonlyFlags, !IO),
output_data_decl(Info, Name, Type, !IO),
io.write_string(";\n", !IO)
;
@@ -927,7 +946,8 @@ output_scalar_common_data(Info, Indent, ScalarCellGroupMap, !IO) :-
( digraph.tsort(Graph, SortedScalars0) ->
indent_line(Indent, !IO),
- io.write_string("static {\n", !IO),
+ io.write_string("private static void MR_init_scalar_common_data() {\n",
+ !IO),
list.reverse(SortedScalars0, SortedScalars),
list.foldl(output_scalar_init(Info, Indent + 1, Map),
SortedScalars, !IO),
@@ -952,7 +972,7 @@ output_scalar_defns(Info, Indent, TypeNum, CellGroup, !Graph, !Map, !IO) :-
RowInits = cord.list(RowInitsCord),
indent_line(Indent, !IO),
- io.write_string("private static final ", !IO),
+ io.write_string("private static readonly ", !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),
@@ -1073,22 +1093,43 @@ output_scalar_init(Info, Indent, Map, Scalar, !IO) :-
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).
+ map.foldl(output_vector_cell_decl(Info, Indent), VectorCellGroupMap, !IO),
+ indent_line(Indent, !IO),
+ io.write_string("private static void MR_init_vector_common_data() {\n",
+ !IO),
+ map.foldl(output_vector_cell_init(Info, Indent + 1), VectorCellGroupMap,
+ !IO),
+ indent_line(Indent, !IO),
+ io.write_string("}\n", !IO).
-:- pred output_vector_cell_group(csharp_out_info::in, indent::in,
+:- pred output_vector_cell_decl(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) :-
+output_vector_cell_decl(Info, Indent, TypeNum, CellGroup, !IO) :-
TypeNum = ml_vector_common_type_num(TypeRawNum),
CellGroup = ml_vector_cell_group(Type, ClassDefn, _FieldIds, _NextRow,
- RowInits),
+ _RowInits),
output_defn(Info, Indent, none, ClassDefn, !IO),
indent_line(Indent, !IO),
- io.write_string("private static final ", !IO),
+ io.write_string("private static /* readonly */ ", !IO),
+ output_type(Info, Type, !IO),
+ io.format("[] MR_vector_common_%d;\n", [i(TypeRawNum)], !IO).
+
+:- pred output_vector_cell_init(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_init(Info, Indent, TypeNum, CellGroup, !IO) :-
+ TypeNum = ml_vector_common_type_num(TypeRawNum),
+ CellGroup = ml_vector_cell_group(Type, _ClassDefn, _FieldIds, _NextRow,
+ RowInits),
+
+ indent_line(Indent, !IO),
+ io.format("MR_vector_common_%d = new ", [i(TypeRawNum)], !IO),
output_type(Info, Type, !IO),
- io.format(" MR_vector_common_%d[] = {\n", [i(TypeRawNum)], !IO),
+ io.write_string("[] {\n", !IO),
indent_line(Indent + 1, !IO),
output_initializer_body_list(Info, cord.list(RowInits), !IO),
io.nl(!IO),
@@ -1100,16 +1141,14 @@ output_vector_cell_group(Info, Indent, TypeNum, CellGroup, !IO) :-
% We need to provide initializers for local variables to avoid problems
% with undefined variables.
%
-:- func get_type_initializer(mlds_type) = string.
+:- func get_type_initializer(csharp_out_info, mlds_type) = string.
-get_type_initializer(Type) = Initializer :-
+get_type_initializer(Info, 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"
;
@@ -1120,13 +1159,17 @@ get_type_initializer(Type) = Initializer :-
; 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"
+ ;
+ ( CtorCat = ctor_cat_enum(_)
+ ; CtorCat = ctor_cat_user(_)
+ ; CtorCat = ctor_cat_builtin_dummy
+ ),
+ type_to_string(Info, Type, TypeString, _),
+ Initializer = "default(" ++ TypeString ++ ")"
)
;
( Type = mlds_native_int_type
@@ -1158,16 +1201,8 @@ get_type_initializer(Type) = Initializer :-
;
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"
- )
+ Initializer = "default(" ++ CsharpType ++ ")"
;
( ForeignType = il(_)
; ForeignType = c(_)
@@ -1224,7 +1259,7 @@ output_initializer(Info, OutputAux, Type, Initializer, !IO) :-
OutputAux = force_init,
% Local variables need to be initialised to avoid warnings.
io.write_string(" = ", !IO),
- io.write_string(get_type_initializer(Type), !IO)
+ io.write_string(get_type_initializer(Info, Type), !IO)
;
( OutputAux = none
; OutputAux = cname(_)
@@ -1835,12 +1870,7 @@ type_to_string(Info, MLDS_Type, String, ArrayDims) :-
;
MLDS_Type = mlds_foreign_type(ForeignType),
(
- ForeignType = csharp(csharp_type(CsharpType)),
- ( string.append("valuetype ", Name, CsharpType) ->
- String = Name
- ;
- String = CsharpType
- ),
+ ForeignType = csharp(csharp_type(String)),
ArrayDims = []
;
ForeignType = c(_),
@@ -2128,9 +2158,9 @@ array_dimension_to_string(N, String) :-
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_virtuality(virtuality(Flags), !IO),
+ output_overridability(overridability(Flags), !IO),
+ output_constness(constness(Flags), !IO),
output_abstractness(abstractness(Flags), !IO).
:- pred output_access(csharp_out_info::in, access::in, io::di, io::uo) is det.
@@ -2162,34 +2192,33 @@ output_per_instance(PerInstance, !IO) :-
io.write_string("static ", !IO)
).
-:- pred output_virtuality(csharp_out_info::in, virtuality::in,
- io::di, io::uo) is det.
+:- pred output_virtuality(virtuality::in, io::di, io::uo) is det.
-output_virtuality(Info, Virtual, !IO) :-
+output_virtuality(Virtual, !IO) :-
(
Virtual = virtual,
- maybe_output_comment(Info, "virtual", !IO)
+ % In C#, methods are non-virtual by default.
+ io.write_string("virtual ", !IO)
;
Virtual = non_virtual
).
-:- pred output_finality(finality::in, io::di, io::uo) is det.
+:- pred output_overridability(overridability::in, io::di, io::uo) is det.
-output_finality(Finality, !IO) :-
+output_overridability(Overridability, !IO) :-
(
- Finality = final,
- io.write_string("readonly ", !IO)
+ Overridability = sealed,
+ io.write_string("sealed ", !IO)
;
- Finality = overridable
+ Overridability = overridable
).
-:- pred output_constness(csharp_out_info::in, constness::in,
- io::di, io::uo) is det.
+:- pred output_constness(constness::in, io::di, io::uo) is det.
-output_constness(Info, Constness, !IO) :-
+output_constness(Constness, !IO) :-
(
Constness = const,
- maybe_output_comment(Info, "const", !IO)
+ io.write_string("readonly ", !IO)
;
Constness = modifiable
).
@@ -3352,10 +3381,13 @@ output_rval_const(Info, Const, !IO) :-
% Explicit cast required.
output_cast_rval(Info, EnumType, ml_const(mlconst_int(N)), !IO)
;
- Const = mlconst_foreign(Lang, Value, _Type),
+ 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("(", !IO),
+ output_type(Info, Type, !IO),
+ io.write_string(") ", !IO),
io.write_string(Value, !IO)
;
Const = mlconst_float(FloatVal),
@@ -3382,7 +3414,7 @@ output_rval_const(Info, Const, !IO) :-
mlds_output_data_addr(DataAddr, !IO)
;
Const = mlconst_null(Type),
- Initializer = get_type_initializer(Type),
+ Initializer = get_type_initializer(Info, Type),
io.write_string(Initializer, !IO)
).
diff --git a/compiler/mlds_to_gcc.m b/compiler/mlds_to_gcc.m
index de044a4..337039c 100644
--- a/compiler/mlds_to_gcc.m
+++ b/compiler/mlds_to_gcc.m
@@ -893,7 +893,7 @@ add_var_decl_flags(Flags, GCC_Defn, !IO) :-
% note that the per_instance flag is handled separately,
% by calling build_local_var or build_static_var
add_var_virtuality_flag(virtuality(Flags), GCC_Defn, !IO),
- add_var_finality_flag(finality(Flags), GCC_Defn, !IO),
+ add_var_overridability_flag(overridability(Flags), GCC_Defn, !IO),
add_var_constness_flag(constness(Flags), GCC_Defn, !IO),
add_var_abstractness_flag(abstractness(Flags), GCC_Defn, !IO).
@@ -929,12 +929,12 @@ add_var_constness_flag(const, GCC_Defn, !IO) :-
add_var_constness_flag(modifiable, _GCC_Defn, !IO).
% This is the default.
-:- pred add_var_finality_flag(finality::in, gcc.var_decl::in,
+:- pred add_var_overridability_flag(overridability::in, gcc.var_decl::in,
io::di, io::uo) is det.
-add_var_finality_flag(final, GCC_Defn, !IO) :-
- gcc.set_var_decl_readonly(GCC_Defn, !IO).
-add_var_finality_flag(overridable, _GCC_Defn, !IO).
+add_var_overridability_flag(sealed, _GCC_Defn, !IO) :-
+ unexpected(this_file, "`sealed' variable").
+add_var_overridability_flag(overridable, _GCC_Defn, !IO).
% This is the default.
:- pred add_var_abstractness_flag(mlds.abstractness::in, gcc.var_decl::in,
@@ -957,7 +957,7 @@ add_field_decl_flags(Flags, GCC_Defn, !IO) :-
add_field_access_flag(access(Flags), GCC_Defn, !IO),
add_field_per_instance_flag(per_instance(Flags), GCC_Defn, !IO),
add_field_virtuality_flag(virtuality(Flags), GCC_Defn, !IO),
- add_field_finality_flag(finality(Flags), GCC_Defn, !IO),
+ add_field_overridability_flag(overridability(Flags), GCC_Defn, !IO),
add_field_constness_flag(constness(Flags), GCC_Defn, !IO),
add_field_abstractness_flag(abstractness(Flags), GCC_Defn, !IO).
@@ -1000,12 +1000,12 @@ add_field_constness_flag(const, _GCC_Defn, !IO) :-
add_field_constness_flag(modifiable, _GCC_Defn, !IO).
% This is the default.
-:- pred add_field_finality_flag(finality::in, gcc.field_decl::in,
+:- pred add_field_overridability_flag(overridability::in, gcc.field_decl::in,
io::di, io::uo) is det.
-add_field_finality_flag(final, _GCC_Defn, !IO) :-
- sorry(this_file, "`final' field").
-add_field_finality_flag(overridable, _GCC_Defn, !IO).
+add_field_overridability_flag(sealed, _GCC_Defn, !IO) :-
+ sorry(this_file, "`sealed' field").
+add_field_overridability_flag(overridable, _GCC_Defn, !IO).
% This is the default.
:- pred add_field_abstractness_flag(mlds.abstractness::in, gcc.field_decl::in,
@@ -1027,7 +1027,7 @@ add_func_decl_flags(Flags, GCC_Defn, !IO) :-
add_func_access_flag(access(Flags), GCC_Defn, !IO),
add_func_per_instance_flag(per_instance(Flags), GCC_Defn, !IO),
add_func_virtuality_flag(virtuality(Flags), GCC_Defn, !IO),
- add_func_finality_flag(finality(Flags), GCC_Defn, !IO),
+ add_func_overridability_flag(overridability(Flags), GCC_Defn, !IO),
add_func_constness_flag(constness(Flags), GCC_Defn, !IO),
add_func_abstractness_flag(abstractness(Flags), GCC_Defn, !IO).
@@ -1072,12 +1072,12 @@ add_func_constness_flag(const, _GCC_Defn, !IO) :-
add_func_constness_flag(modifiable, _GCC_Defn, !IO).
% This is the default.
-:- pred add_func_finality_flag(finality::in, gcc.func_decl::in,
+:- pred add_func_overridability_flag(overridability::in, gcc.func_decl::in,
io::di, io::uo) is det.
-add_func_finality_flag(final, _GCC_Defn, !IO) :-
- sorry(this_file, "`final' function").
-add_func_finality_flag(overridable, _GCC_Defn, !IO).
+add_func_overridability_flag(sealed, _GCC_Defn, !IO) :-
+ sorry(this_file, "`sealed' function").
+add_func_overridability_flag(overridable, _GCC_Defn, !IO).
% This is the default.
:- pred add_func_abstractness_flag(mlds.abstractness::in, gcc.func_decl::in,
diff --git a/compiler/mlds_to_il.m b/compiler/mlds_to_il.m
index 970f040..3171f9f 100644
--- a/compiler/mlds_to_il.m
+++ b/compiler/mlds_to_il.m
@@ -842,14 +842,14 @@ decl_flags_to_nestedclassattrs(Flags)
:- func decl_flags_to_classattrs_2(mlds_decl_flags) = list(ilasm.classattr).
-decl_flags_to_classattrs_2(Flags) = list.condense([Finality, Abstractness]) :-
- FinalityFlag = finality(Flags),
+decl_flags_to_classattrs_2(Flags) = ClassAttrs :-
+ OverridabilityFlag = overridability(Flags),
(
- FinalityFlag = overridable,
- Finality = []
+ OverridabilityFlag = overridable,
+ Overridability = []
;
- FinalityFlag = final,
- Finality = [sealed]
+ OverridabilityFlag = sealed,
+ Overridability = [sealed]
),
AbstractnessFlag = abstractness(Flags),
(
@@ -858,13 +858,14 @@ decl_flags_to_classattrs_2(Flags) = list.condense([Finality, Abstractness]) :-
;
AbstractnessFlag = abstract,
Abstractness = [abstract]
- ).
+ ),
+ ClassAttrs = list.condense([Overridability, Abstractness]).
:- func decl_flags_to_methattrs(mlds_decl_flags) = list(ilasm.methattr).
decl_flags_to_methattrs(Flags)
= list.condense([Access, PerInstance, Virtuality,
- Finality, Abstractness]) :-
+ Overridability, Abstractness]) :-
AccessFlag = access(Flags),
(
AccessFlag = acc_public,
@@ -899,13 +900,13 @@ decl_flags_to_methattrs(Flags)
VirtualityFlag = virtual,
Virtuality = [virtual]
),
- FinalityFlag = finality(Flags),
+ OverridabilityFlag = overridability(Flags),
(
- FinalityFlag = overridable,
- Finality = []
+ OverridabilityFlag = overridable,
+ Overridability = []
;
- FinalityFlag = final,
- Finality = [final]
+ OverridabilityFlag = sealed,
+ Overridability = [final]
),
AbstractnessFlag = abstractness(Flags),
(
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index 415159a..6bd9186 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -1031,7 +1031,7 @@ generate_addr_wrapper_class(MLDS_ModuleName, Arity - CodeAddrs, ClassDefn,
% Create the member variable.
DataDefn = mlds_defn(
entity_data(mlds_data_var(mlds_var_name("ptr_num", no))),
- Context, ml_gen_final_member_decl_flags,
+ Context, ml_gen_const_member_decl_flags,
mlds_data(mlds_native_int_type, no_initializer, gc_no_stmt)),
DataDefns = [DataDefn],
@@ -1176,7 +1176,7 @@ generate_call_method(MLDS_ModuleName, Arity, CodeAddrs, MethodDefn) :-
MethodEnvVarNames = set.init,
MethodBody = mlds_function(MethodMaybeID, MethodParams,
body_defined_here(Statement), MethodAttribs, MethodEnvVarNames),
- MethodFlags = ml_gen_final_member_decl_flags,
+ MethodFlags = ml_gen_member_decl_flags,
MethodDefn = mlds_defn(MethodName, Context, MethodFlags, MethodBody).
:- pred create_generic_arg(int::in, mlds_var_name::out, mlds_argument::out)
@@ -1294,11 +1294,11 @@ addr_wrapper_decl_flags = MLDS_DeclFlags :-
Access = acc_private,
PerInstance = one_copy,
Virtuality = non_virtual,
- Finality = final,
+ Overridability = sealed,
Constness = const,
Abstractness = concrete,
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
:- pred add_to_address_map(string::in, list(mlds_code_addr)::in,
map(mlds_code_addr, code_addr_wrapper)::in,
@@ -2450,9 +2450,7 @@ 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.
- NonFinalFlags = set_finality(Flags, overridable),
- output_decl_flags(Info, NonFinalFlags, !IO),
+ output_decl_flags(Info, Flags, !IO),
output_data_decl(Info, Name, Type, !IO),
io.write_string(";\n", !IO)
;
@@ -3730,8 +3728,8 @@ 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_overridability_constness(overridability(Flags), constness(Flags),
+ !IO),
output_abstractness(abstractness(Flags), !IO).
:- pred output_access(java_out_info::in, access::in, io::di, io::uo) is det.
@@ -3774,25 +3772,18 @@ output_virtuality(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("final ", !IO)
- ;
- Finality = overridable
- ).
-
-:- pred output_constness(java_out_info::in, constness::in,
+:- pred output_overridability_constness(overridability::in, constness::in,
io::di, io::uo) is det.
-output_constness(Info, Constness, !IO) :-
+output_overridability_constness(Overridability, Constness, !IO) :-
(
- Constness = const,
- maybe_output_comment(Info, "const", !IO)
+ ( Overridability = sealed
+ ; Constness = const
+ )
+ ->
+ io.write_string("final ", !IO)
;
- Constness = modifiable
+ true
).
:- pred output_abstractness(abstractness::in, io::di, io::uo) is det.
diff --git a/compiler/rtti_to_mlds.m b/compiler/rtti_to_mlds.m
index 38377c8..406c48d 100644
--- a/compiler/rtti_to_mlds.m
+++ b/compiler/rtti_to_mlds.m
@@ -147,11 +147,11 @@ rtti_data_decl_flags(Exported) = MLDS_DeclFlags :-
),
PerInstance = one_copy,
Virtuality = non_virtual,
- Finality = final,
+ Overridability = overridable,
Constness = const,
Abstractness = concrete,
MLDS_DeclFlags = init_decl_flags(Access, PerInstance,
- Virtuality, Finality, Constness, Abstractness).
+ Virtuality, Overridability, Constness, Abstractness).
%-----------------------------------------------------------------------------%
diff --git a/library/array.m b/library/array.m
index 320b9e4..6409ad3 100644
--- a/library/array.m
+++ b/library/array.m
@@ -482,9 +482,9 @@
where equality is array.array_equal,
comparison is array.array_compare.
-:- pragma foreign_type("C#", array(T), "System.Array")
- where equality is array.array_equal,
- comparison is array.array_compare.
+% :- 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,
diff --git a/library/bitmap.m b/library/bitmap.m
index 8f4a6af..38c7b60 100644
--- a/library/bitmap.m
+++ b/library/bitmap.m
@@ -1125,6 +1125,17 @@ copy_bytes(SameBM, SrcBM, SrcStartByte, DestBM, DestStartByte, NumBytes) =
}
").
+:- pragma foreign_proc("C#",
+ unsafe_copy_bytes(_SameBM::in, SrcBM::in, SrcFirstByteIndex::in,
+ DestBM0::bitmap_di, DestFirstByteIndex::in,
+ NumBytes::in) = (DestBM::bitmap_uo),
+ [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
+"
+ DestBM = DestBM0;
+ System.Array.Copy(SrcBM.elements, SrcFirstByteIndex,
+ DestBM.elements, DestFirstByteIndex, NumBytes);
+").
+
:- pragma foreign_proc("Java",
unsafe_copy_bytes(_SameBM::in, SrcBM::in, SrcFirstByteIndex::in,
DestBM0::bitmap_di, DestFirstByteIndex::in,
@@ -1560,6 +1571,26 @@ public class MercuryBitmap {
num_bits = numBits;
elements = new byte[numBits / 8 + (((numBits % 8) != 0) ? 1: 0)];
}
+
+ public override bool Equals(object that) {
+ MercuryBitmap other = that as MercuryBitmap;
+ if (other == null) {
+ return false;
+ }
+ if (num_bits != other.num_bits) {
+ return false;
+ }
+ for (int i = 0; i < elements.Length; i++) {
+ if (elements[i] != other.elements[i]) {
+ return false;
+ }
+ }
+ return true;
+ }
+
+ public override int GetHashCode() {
+ return num_bits ^ elements.GetHashCode();
+ }
}
").
@@ -1568,8 +1599,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("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.
@@ -1587,6 +1618,13 @@ public class MercuryBitmap {
SUCCESS_INDICATOR = MR_bitmap_eq(BM1, BM2);
").
+:- pragma foreign_proc("C#",
+ bitmap_equal(BM1::in, BM2::in),
+ [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
+"
+ SUCCESS_INDICATOR = BM1.Equals(BM2);
+").
+
:- pragma foreign_proc("Java",
bitmap_equal(BM1::in, BM2::in),
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
@@ -1658,6 +1696,33 @@ bytes_equal(Index, MaxIndex, BM1, BM2) :-
}
").
+:- pragma foreign_proc("C#",
+ bitmap_compare(Result::uo, BM1::in, BM2::in),
+ [will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail,
+ may_not_duplicate],
+"
+ if (BM1.num_bits < BM2.num_bits) {
+ Result = builtin.COMPARE_LESS;
+ } else if (BM1.num_bits > BM2.num_bits) {
+ Result = builtin.COMPARE_GREATER;
+ } else {
+ Result = builtin.COMPARE_EQUAL;
+ for (int i = 0; i < BM1.elements.Length; i++) {
+ // Mask off sign bits.
+ int b1 = ((int) BM1.elements[i]) & 0xff;
+ int b2 = ((int) BM2.elements[i]) & 0xff;
+ if (b1 < b2) {
+ Result = builtin.COMPARE_LESS;
+ break;
+ }
+ if (b1 > b2) {
+ Result = builtin.COMPARE_GREATER;
+ break;
+ }
+ }
+ }
+").
+
:- pragma foreign_proc("Erlang",
bitmap_compare(Result::uo, BM1::in, BM2::in),
[will_not_call_mercury, thread_safe, promise_pure, will_not_modify_trail],
@@ -1927,6 +1992,14 @@ resize_bitmap(OldBM, N) =
MR_copy_bitmap(BM, BM0);
").
+:- pragma foreign_proc("C#",
+ copy(BM0::in) = (BM::bitmap_uo),
+ [will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
+"
+ BM = new bitmap.MercuryBitmap(BM0.num_bits);
+ System.Array.Copy(BM0.elements, 0, BM.elements, 0, BM0.elements.Length);
+").
+
:- pragma foreign_proc("Java",
copy(BM0::in) = (BM::bitmap_uo),
[will_not_call_mercury, promise_pure, thread_safe, will_not_modify_trail],
diff --git a/library/bool.m b/library/bool.m
index 384a5dc..99269ec 100644
--- a/library/bool.m
+++ b/library/bool.m
@@ -77,11 +77,11 @@
% 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("C#", bool/0, [],
+% [
+% no - "NO",
+% yes - "YES"
+% ]).
:- pragma foreign_export_enum("Java", bool/0, [],
[
diff --git a/library/builtin.m b/library/builtin.m
index ecc44fb..b022cc4 100644
--- a/library/builtin.m
+++ b/library/builtin.m
@@ -602,6 +602,13 @@ get_one_solution_io(Pred, X, !IO) :-
:- external(compare/3).
:- external(compare_representation/3).
+:- pragma foreign_export_enum("C#", comparison_result/0, [],
+ [
+ (=) - "COMPARE_EQUAL",
+ (<) - "COMPARE_LESS",
+ (>) - "COMPARE_GREATER"
+ ]).
+
:- pragma foreign_export_enum("Java", comparison_result/0, [],
[
(=) - "COMPARE_EQUAL",
@@ -696,6 +703,7 @@ call_rtti_generic_compare(Res, X, Y) :-
public static object deep_copy(object o)
{
System.Type t = o.GetType();
+ System.Array arr;
if (t.IsValueType) {
return o;
@@ -706,6 +714,8 @@ public static object deep_copy(object o)
string s;
s = (string) o;
return s;
+ } else if ((arr = o as System.Array) != null) {
+ return arr.Clone();
} else {
object n;
diff --git a/library/dir.m b/library/dir.m
index 3cd5a91..84f6000 100644
--- a/library/dir.m
+++ b/library/dir.m
@@ -323,8 +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").
+% :- pragma foreign_export("C#", (dir.this_directory = out),
+% "ML_dir_this_directory").
dir.this_directory = ".".
@@ -772,8 +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").
+% :- 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(
@@ -876,6 +876,20 @@ dir.relative_path_name_from_components(Components) = PathName :-
IO = IO0;
").
+:- pragma foreign_proc("C#",
+ dir.current_directory(Res::out, _IO0::di, _IO::uo),
+ [may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
+ may_not_duplicate],
+"
+ try {
+ string dir = System.IO.Directory.GetCurrentDirectory();
+ Res = io.ML_make_io_res_1_ok_string(dir);
+ } catch (System.Exception e) {
+ Res = io.ML_make_io_res_1_error_string(e,
+ ""dir.current_directory failed: "");
+ }
+").
+
:- pragma foreign_proc("Java",
dir.current_directory(Res::out, _IO0::di, _IO::uo),
[may_call_mercury, promise_pure, tabled_for_io, thread_safe, terminates,
@@ -1179,8 +1193,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("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,8 +1208,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("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),
@@ -1213,9 +1227,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("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").
@@ -1237,8 +1251,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("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),
@@ -1535,7 +1549,7 @@ check_for_symlink_loop(SymLinkParent, DirName, LoopRes, !ParentIds, !IO) :-
:- pragma foreign_type("C", dir.stream, "ML_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("C#", dir.stream, "System.Collections.IEnumerator").
:- pragma foreign_type("Java", dir.stream, "java.util.Iterator").
:- pragma foreign_type("Erlang", dir.stream, "").
@@ -1730,8 +1744,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("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),
@@ -1748,9 +1762,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("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").
@@ -1807,8 +1821,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("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").
@@ -1820,8 +1834,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("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 81cfe3a..79d3c69 100644
--- a/library/exception.m
+++ b/library/exception.m
@@ -1479,7 +1479,7 @@ mercury__exception__builtin_catch_model_non(MR_Mercury_Type_Info type_info,
catch_impl(_Pred::pred(out) is semidet, _Handler::in(handler), T::out),
[will_not_call_mercury, promise_pure],
"
- runtime.Errors.SORRY(""foreign code for this function"");
+ runtime.Errors.SORRY(""catch_impl(semidet)"");
T = null;
SUCCESS_INDICATOR = false;
").
@@ -1488,24 +1488,46 @@ mercury__exception__builtin_catch_model_non(MR_Mercury_Type_Info type_info,
catch_impl(_Pred::pred(out) is cc_nondet, _Handler::in(handler), T::out),
[will_not_call_mercury, promise_pure],
"
- runtime.Errors.SORRY(""foreign code for this function"");
+ runtime.Errors.SORRY(""catch_impl(cc_nondet)"");
T = null;
SUCCESS_INDICATOR = false;
").
:- pragma foreign_proc("C#",
- catch_impl(_Pred::pred(out) is multi, _Handler::in(handler), _T::out),
+ catch_impl(Pred::pred(out) is multi, Handler::in(handler), _T::out),
[will_not_call_mercury, promise_pure, ordinary_despite_detism],
"
- runtime.Errors.SORRY(""foreign code for this function"");
+ try {
+ runtime.MethodPtr3_r0<object, object, object> pred =
+ (runtime.MethodPtr3_r0<object, object, object>) Pred[1];
+ pred(Pred, cont, cont_env_ptr);
+ }
+ catch (runtime.Exception ex) {
+ object T = exception.ML_call_handler_det(TypeInfo_for_T, Handler,
+ (univ.Univ_0) ex.exception);
+ ((runtime.MethodPtr2_r0<object, object>) cont)(T, cont_env_ptr);
+ }
+
+ // Not really used.
SUCCESS_INDICATOR = false;
").
:- pragma foreign_proc("C#",
- catch_impl(_Pred::pred(out) is nondet, _Handler::in(handler), _T::out),
+ catch_impl(Pred::pred(out) is nondet, Handler::in(handler), _T::out),
[will_not_call_mercury, promise_pure, ordinary_despite_detism],
"
- runtime.Errors.SORRY(""foreign code for this function"");
+ try {
+ runtime.MethodPtr3_r0<object, object, object> pred =
+ (runtime.MethodPtr3_r0<object, object, object>) Pred[1];
+ pred(Pred, cont, cont_env_ptr);
+ }
+ catch (runtime.Exception ex) {
+ object T = exception.ML_call_handler_det(TypeInfo_for_T, Handler,
+ (univ.Univ_0) ex.exception);
+ ((runtime.MethodPtr2_r0<object, object>) cont)(T, cont_env_ptr);
+ }
+
+ // Not really used.
SUCCESS_INDICATOR = false;
").
@@ -1591,16 +1613,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("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("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").
@@ -1619,8 +1641,8 @@ 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("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").
@@ -2773,8 +2795,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("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/io.m b/library/io.m
index a475401..fa59f3d 100644
--- a/library/io.m
+++ b/library/io.m
@@ -1512,7 +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("C#", io.system_error, "System.Exception").
:- pragma foreign_type(java, io.system_error, "java.lang.Exception").
:- pragma foreign_type(erlang, io.system_error, "").
@@ -1700,7 +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("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]).
@@ -1787,7 +1787,7 @@
[can_pass_as_mercury_type]).
:- 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("C#", io.stream, "io.MR_MercuryFileStruct").
:- pragma foreign_type("Java", io.stream, "io.MR_MercuryFileStruct").
:- pragma foreign_type("Erlang", io.stream, "").
@@ -2627,8 +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_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),
@@ -2711,8 +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").
+% :- 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 ->
@@ -3238,28 +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("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_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_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("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,
@@ -3268,22 +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_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("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("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,
@@ -3292,26 +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_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_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_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("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,
@@ -3636,8 +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("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),
@@ -3651,8 +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("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),
@@ -3666,8 +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("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),
@@ -3681,8 +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("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),
@@ -3696,8 +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("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),
@@ -3711,8 +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("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").
@@ -3723,8 +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("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),
@@ -3740,9 +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("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").
@@ -3756,6 +3756,8 @@ make_io_res_1_error_file_type(Error, Msg0, error(make_io_error(Msg)), !IO) :-
:- func make_io_res_1_ok_string(string) = io.res(string).
:- pragma foreign_export("C", (make_io_res_1_ok_string(in) = out),
"ML_make_io_res_1_ok_string").
+:- pragma foreign_export("C#", (make_io_res_1_ok_string(in) = out),
+ "ML_make_io_res_1_ok_string").
:- pragma foreign_export("Java", (make_io_res_1_ok_string(in) = out),
"ML_make_io_res_1_ok_string").
:- pragma foreign_export("Erlang", (make_io_res_1_ok_string(in) = out),
@@ -3768,6 +3770,9 @@ make_io_res_1_ok_string(String) = ok(String).
:- pragma foreign_export("C",
make_io_res_1_error_string(in, in, out, di, uo),
"ML_make_io_res_1_error_string").
+:- pragma foreign_export("C#",
+ make_io_res_1_error_string(in, in, out, di, uo),
+ "ML_make_io_res_1_error_string").
:- pragma foreign_export("Java",
make_io_res_1_error_string(in, in, out, di, uo),
"ML_make_io_res_1_error_string").
@@ -4633,8 +4638,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("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").
@@ -7894,6 +7899,9 @@ io.binary_output_stream_offset(binary_output_stream(Stream), Offset, !IO) :-
MR_update_io(IO0, IO);
").
+% XXX C# - binary_stream_offset_2
+% XXX Java - binary_stream_offset_2
+
%-----------------------------------------------------------------------------%
%
% Output predicates (with output to the specified stream)
diff --git a/library/mutvar.m b/library/mutvar.m
index 491d74d..49cca64 100644
--- a/library/mutvar.m
+++ b/library/mutvar.m
@@ -112,7 +112,7 @@ new_mutvar(X, Ref) :-
% C# implementation
%
-:- pragma foreign_type("C#", mutvar(T), "object[]").
+% :- pragma foreign_type("C#", mutvar(T), "object[]").
:- pragma foreign_proc("C#",
new_mutvar0(Ref::uo),
diff --git a/library/par_builtin.m b/library/par_builtin.m
index e87e604..6f583a7 100644
--- a/library/par_builtin.m
+++ b/library/par_builtin.m
@@ -122,7 +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("C#", future(T), "object").
:- pragma foreign_type("Java", future(T), "java.lang.Object").
%-----------------------------------------------------------------------------%
diff --git a/library/pretty_printer.m b/library/pretty_printer.m
index 73bfea2..ac624d0 100644
--- a/library/pretty_printer.m
+++ b/library/pretty_printer.m
@@ -912,6 +912,12 @@ decrement_limit(triangular(N), triangular(N - 1)).
MR_Word ML_pretty_printer_default_formatter_map = 0;
").
+:- pragma foreign_code("C#",
+"
+ static mr_bool.Bool_0 isInitialised = mr_bool.NO;
+ static tree234.Tree234_2 defaultFormatterMap = null;
+").
+
:- pragma foreign_code("Java",
"
static bool.Bool_0 isInitialised = bool.NO;
@@ -933,6 +939,13 @@ decrement_limit(triangular(N), triangular(N - 1)).
Okay = ML_pretty_printer_is_initialised;
").
+:- pragma foreign_proc("C#",
+ pretty_printer_is_initialised(Okay::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, thread_safe, may_not_duplicate],
+"
+ Okay = pretty_printer.isInitialised;
+").
+
:- pragma foreign_proc("Java",
pretty_printer_is_initialised(Okay::out, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, thread_safe, may_not_duplicate],
@@ -968,6 +981,13 @@ decrement_limit(triangular(N), triangular(N - 1)).
FMap = ML_pretty_printer_default_formatter_map;
").
+:- pragma foreign_proc("C#",
+ unsafe_get_default_formatter_map(FMap::out, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, thread_safe, may_not_duplicate],
+"
+ FMap = pretty_printer.defaultFormatterMap;
+").
+
:- pragma foreign_proc("Java",
unsafe_get_default_formatter_map(FMap::out, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, thread_safe, may_not_duplicate],
@@ -1009,6 +1029,14 @@ get_default_formatter_map(FMap, !IO) :-
ML_pretty_printer_is_initialised = MR_TRUE;
").
+:- pragma foreign_proc("C#",
+ set_default_formatter_map(FMap::in, _IO0::di, _IO::uo),
+ [promise_pure, will_not_call_mercury, may_not_duplicate],
+"
+ pretty_printer.isInitialised = mr_bool.YES;
+ pretty_printer.defaultFormatterMap = FMap;
+").
+
:- pragma foreign_proc("Java",
set_default_formatter_map(FMap::in, _IO0::di, _IO::uo),
[promise_pure, will_not_call_mercury, may_not_duplicate],
diff --git a/library/region_builtin.m b/library/region_builtin.m
index f575d48..20083e2 100644
--- a/library/region_builtin.m
+++ b/library/region_builtin.m
@@ -52,7 +52,7 @@
:- pragma foreign_type("C", region, "MR_RegionHeader *",
[can_pass_as_mercury_type]).
-:- pragma foreign_type("C#", region, "object"). % dummy
+% :- pragma foreign_type("C#", region, "object"). % dummy
:- pragma foreign_type("Java", region, "java.lang.Object"). % dummy
diff --git a/library/rtti_implementation.m b/library/rtti_implementation.m
index 6b7d52e..804c081 100644
--- a/library/rtti_implementation.m
+++ b/library/rtti_implementation.m
@@ -183,30 +183,30 @@
% 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("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("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("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("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("C#", typeclass_info, "object[]").
:- pragma foreign_type("Java", typeclass_info, "java.lang.Object[]").
:- pragma foreign_decl("C#", local,
@@ -843,7 +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("C#", unify_or_compare_pred, "object").
:- pragma foreign_type("Java", unify_or_compare_pred,
"jmercury.runtime.MethodPtr").
@@ -1118,8 +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("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").
@@ -1185,8 +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("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").
@@ -1254,8 +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("C#", collapse_equivalences(in) = out,
+% "ML_collapse_equivalences").
:- pragma foreign_export("Java", collapse_equivalences(in) = out,
"ML_collapse_equivalences").
@@ -3516,29 +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("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("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("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("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("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("C#", typeinfo_locn, "runtime.DuExistLocn").
:- pragma foreign_type("Java", typeinfo_locn, "jmercury.runtime.DuExistLocn").
:- func ptag_index(int, type_layout) = ptag_entry.
@@ -3795,6 +3795,23 @@ get_type_info_from_term(_, _) = _ :-
get_typeclass_info_from_term(_, _) = _ :-
private_builtin.sorry("get_type_info_from_term").
+:- pragma foreign_proc("C#",
+ get_typeclass_info_from_term(Term::in, Index::in) = (TypeClassInfo::out),
+ [will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
+"
+ if (Term is object[]) {
+ TypeClassInfo = /*typeclass_info*/ (object[]) ((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);
+ }
+ TypeClassInfo = /*typeclass_info*/ (object[]) f.GetValue(Term);
+ }
+").
+
:- pragma foreign_proc("Java",
get_typeclass_info_from_term(Term::in, Index::in) = (TypeClassInfo::out),
[will_not_call_mercury, promise_pure, thread_safe, may_not_duplicate],
@@ -4337,32 +4354,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("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("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("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("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("C#", notag_functor_desc,
+% "runtime.NotagFunctorDesc").
:- pragma foreign_type("Java", notag_functor_desc,
"jmercury.runtime.NotagFunctorDesc").
diff --git a/library/store.m b/library/store.m
index 15ec136..92e9131 100644
--- a/library/store.m
+++ b/library/store.m
@@ -248,8 +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("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])
@@ -343,7 +343,30 @@ store.new(S) :-
S = S0;
").
-:- pragma foreign_type(java, generic_mutvar(T, S), "mutvar.Mutvar").
+:- pragma foreign_type("C#", generic_mutvar(T, S), "object[]").
+
+:- pragma foreign_proc("C#",
+ new_mutvar(Val::in, Mutvar::out, _S0::di, _S::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Mutvar = new object[] { Val };
+").
+
+:- pragma foreign_proc("C#",
+ get_mutvar(Mutvar::in, Val::out, _S0::di, _S::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Val = Mutvar[0];
+").
+
+:- pragma foreign_proc("C#",
+ set_mutvar(Mutvar::in, Val::in, _S0::di, _S::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Mutvar[0] = Val;
+").
+
+:- pragma foreign_type("Java", generic_mutvar(T, S), "mutvar.Mutvar").
:- pragma foreign_proc("Java",
new_mutvar(Val::in, Mutvar::out, _S0::di, _S::uo),
@@ -427,6 +450,50 @@ store.new_cyclic_mutvar(Func, MutVar, !Store) :-
%-----------------------------------------------------------------------------%
+:- pragma foreign_type("C#", generic_ref(T, S), "store.Ref").
+:- pragma foreign_code("C#",
+"
+ public class Ref {
+ // Object referenced.
+ public object obj;
+
+ // Specific field of object referenced, or null to
+ // specify the object itself.
+ // XXX GetFields does not return fields in any particular order so
+ // this is not really usable.
+ public System.Reflection.FieldInfo field;
+
+ // Constructors
+ public Ref(object init) {
+ obj = init;
+ field = null;
+ }
+ public Ref(object init, int num) {
+ obj = init;
+ setField(num);
+ }
+
+ // Set the field according to a given index.
+ public void setField(int num) {
+ field = obj.GetType().GetFields()[num];
+ }
+
+ // Return the value of the reference.
+ public object getValue() {
+ if (field == null) {
+ return obj;
+ } else {
+ return field.GetValue(obj);
+ }
+ }
+
+ // Update the value of the reference.
+ public void setValue(object value) {
+ field.SetValue(obj, value);
+ }
+ } // class Ref
+").
+
:- pragma foreign_type(java, generic_ref(T, S), "store.Ref").
:- pragma foreign_code("Java",
"
@@ -436,6 +503,8 @@ store.new_cyclic_mutvar(Func, MutVar, !Store) :-
// Specific field of object referenced, or null to
// specify the object itself.
+ // XXX getDeclaredFields does not return fields in any particular
+ // order so this is not really usable.
public java.lang.reflect.Field field;
// Constructors
@@ -518,6 +587,13 @@ store.new_cyclic_mutvar(Func, MutVar, !Store) :-
S = S0;
").
+:- pragma foreign_proc("C#",
+ new_ref(Val::di, Ref::out, _S0::di, _S::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Ref = new store.Ref(Val);
+").
+
:- pragma foreign_proc("Java",
new_ref(Val::di, Ref::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
@@ -553,6 +629,13 @@ copy_ref_value(Ref, Val) -->
S = S0;
").
+:- pragma foreign_proc("C#",
+ unsafe_ref_value(Ref::in, Val::uo, _S0::di, _S::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Val = Ref.getValue();
+").
+
:- pragma foreign_proc("Java",
unsafe_ref_value(Ref::in, Val::uo, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
@@ -612,6 +695,19 @@ ref_functor(Ref, Functor, Arity, !Store) :-
S = S0;
}").
+:- pragma foreign_proc("C#",
+ arg_ref(Ref::in, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ /*
+ ** XXX Some dynamic type-checking should be done here to check that
+ ** the type of the specified Arg matches the type supplied by the caller.
+ ** This will require RTTI.
+ */
+
+ ArgRef = new store.Ref(Ref.getValue(), ArgNum);
+").
+
:- pragma foreign_proc("Java",
arg_ref(Ref::in, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
@@ -671,6 +767,19 @@ ref_functor(Ref, Functor, Arity, !Store) :-
S = S0;
}").
+:- pragma foreign_proc("C#",
+ new_arg_ref(Val::di, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ /*
+ ** XXX Some dynamic type-checking should be done here to check that
+ ** the type of the specified Arg matches the type supplied by the caller.
+ ** This will require RTTI.
+ */
+
+ ArgRef = new store.Ref(Val, ArgNum);
+").
+
:- pragma foreign_proc("Java",
new_arg_ref(Val::di, ArgNum::in, ArgRef::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
@@ -692,6 +801,13 @@ ref_functor(Ref, Functor, Arity, !Store) :-
S = S0;
").
+:- pragma foreign_proc("C#",
+ set_ref(Ref::in, ValRef::in, _S0::di, _S::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Ref.setValue(ValRef.getValue());
+").
+
:- pragma foreign_proc("Java",
set_ref(Ref::in, ValRef::in, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
@@ -721,6 +837,13 @@ ref_functor(Ref, Functor, Arity, !Store) :-
Val = * (MR_Word *) Ref;
").
+:- pragma foreign_proc("C#",
+ extract_ref_value(_S::di, Ref::in, Val::out),
+ [will_not_call_mercury, promise_pure],
+"
+ Val = Ref.getValue();
+").
+
:- pragma foreign_proc("Java",
extract_ref_value(_S::di, Ref::in, Val::out),
[will_not_call_mercury, promise_pure],
@@ -742,6 +865,13 @@ ref_functor(Ref, Functor, Arity, !Store) :-
S = S0;
}").
+:- pragma foreign_proc("C#",
+ unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, _S0::di, _S::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ ArgRef = new store.Ref(Ref.getValue(), Arg);
+").
+
:- pragma foreign_proc("Java",
unsafe_arg_ref(Ref::in, Arg::in, ArgRef::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
@@ -761,6 +891,13 @@ ref_functor(Ref, Functor, Arity, !Store) :-
S = S0;
}").
+:- pragma foreign_proc("C#",
+ unsafe_new_arg_ref(Val::di, Arg::in, ArgRef::out, _S0::di, _S::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ ArgRef = new store.Ref(Val, Arg);
+").
+
:- pragma foreign_proc("Java",
unsafe_new_arg_ref(Val::di, Arg::in, ArgRef::out, _S0::di, _S::uo),
[will_not_call_mercury, promise_pure],
diff --git a/library/string.m b/library/string.m
index 91c7b0d..344db75 100644
--- a/library/string.m
+++ b/library/string.m
@@ -4005,9 +4005,9 @@ string.set_char(Char, Index, !Str) :-
Str = null;
SUCCESS_INDICATOR = false;
} else {
- Str = System.String.Concat(Str0.Substring(0, Index),
- System.Convert.ToString(Ch),
- Str0.Substring(Index + 1));
+ System.Text.StringBuilder sb = new System.Text.StringBuilder(Str0);
+ sb[Index] = Ch;
+ Str = sb.ToString();
SUCCESS_INDICATOR = true;
}
").
diff --git a/library/thread.m b/library/thread.m
index 3a07c33..ee3b223 100644
--- a/library/thread.m
+++ b/library/thread.m
@@ -389,9 +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("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").
diff --git a/library/thread.semaphore.m b/library/thread.semaphore.m
index 51f9497..d71b297 100644
--- a/library/thread.semaphore.m
+++ b/library/thread.semaphore.m
@@ -95,7 +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("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 dc425f7..58620d2 100644
--- a/library/time.m
+++ b/library/time.m
@@ -237,8 +237,8 @@
:- 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("C#", time_t_rep, "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.
@@ -1010,8 +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("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 ef87500..73d2e9d 100644
--- a/library/type_desc.m
+++ b/library/type_desc.m
@@ -890,6 +890,33 @@ make_type_ctor_desc_with_arity(_, _, _) :-
}
}").
+:- pragma foreign_proc("C#",
+ make_type(TypeCtorDesc::in, ArgTypes::in) = (TypeDesc::out),
+ [will_not_call_mercury, thread_safe, will_not_modify_trail,
+ may_not_duplicate],
+"{
+ runtime.PseudoTypeInfo[] args =
+ new runtime.PseudoTypeInfo[TypeCtorDesc.arity];
+
+ SUCCESS_INDICATOR = true;
+ list.List_1 arg_types = ArgTypes;
+ for (int i = 0; i < TypeCtorDesc.arity; i++) {
+ if (list.is_empty(arg_types)) {
+ SUCCESS_INDICATOR = false;
+ break;
+ }
+ args[i] = (runtime.PseudoTypeInfo) list.det_head(arg_types);
+ arg_types = list.det_tail(arg_types);
+ }
+
+ if (SUCCESS_INDICATOR) {
+ TypeDesc = new runtime.TypeInfo_Struct();
+ TypeDesc.init(TypeCtorDesc, args);
+ } else {
+ TypeDesc = null;
+ }
+}").
+
:- pragma foreign_proc("Java",
make_type(TypeCtorDesc::in, ArgTypes::in) = (TypeDesc::out),
[will_not_call_mercury, thread_safe, will_not_modify_trail,
diff --git a/library/univ.m b/library/univ.m
index c61308c..cfc547d 100644
--- a/library/univ.m
+++ b/library/univ.m
@@ -127,7 +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("C#", construct_univ(in, out), "ML_construct_univ").
:- pragma foreign_export("Java", construct_univ(in, out), "ML_construct_univ").
construct_univ(X, Univ) :-
@@ -136,7 +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("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/library/version_array.m b/library/version_array.m
index e5a5e8e..7f6c237 100644
--- a/library/version_array.m
+++ b/library/version_array.m
@@ -285,6 +285,11 @@ unsafe_rewind(VA, unsafe_rewind(VA)).
equality is eq_version_array,
comparison is cmp_version_array.
+:- pragma foreign_type("C#", version_array(T), "version_array.ML_va")
+ where
+ equality is eq_version_array,
+ comparison is cmp_version_array.
+
:- pragma foreign_type("Java", version_array(T),
"jmercury.version_array.ML_va")
where
@@ -371,6 +376,14 @@ cmp_version_array_2(I, Size, VAa, VAb, R) :-
#endif
").
+:- pragma foreign_proc("C#",
+ version_array.empty = (VA::out),
+ [will_not_call_mercury, promise_pure, will_not_modify_trail,
+ does_not_affect_liveness],
+"
+ VA = new version_array.ML_sva(version_array.ML_uva.empty());
+").
+
:- pragma foreign_proc("Java",
version_array.empty = (VA::out),
[will_not_call_mercury, promise_pure, will_not_modify_trail,
@@ -396,6 +409,14 @@ cmp_version_array_2(I, Size, VAa, VAb, R) :-
#endif
").
+:- pragma foreign_proc("C#",
+ version_array.unsafe_empty = (VA::out),
+ [will_not_call_mercury, promise_pure, will_not_modify_trail,
+ does_not_affect_liveness],
+"
+ VA = version_array.ML_uva.empty();
+").
+
:- pragma foreign_proc("Java",
version_array.unsafe_empty = (VA::out),
[will_not_call_mercury, promise_pure, will_not_modify_trail,
@@ -427,6 +448,14 @@ cmp_version_array_2(I, Size, VAa, VAb, R) :-
#endif
").
+:- pragma foreign_proc("C#",
+ version_array.new(N::in, X::in) = (VA::out),
+ [will_not_call_mercury, promise_pure, will_not_modify_trail,
+ does_not_affect_liveness, may_not_duplicate],
+"
+ VA = new version_array.ML_sva(version_array.ML_uva.init(N, X));
+").
+
:- pragma foreign_proc("Java",
version_array.new(N::in, X::in) = (VA::out),
[will_not_call_mercury, promise_pure, will_not_modify_trail,
@@ -457,6 +486,14 @@ cmp_version_array_2(I, Size, VAa, VAb, R) :-
#endif
").
+:- pragma foreign_proc("C#",
+ version_array.unsafe_new(N::in, X::in) = (VA::out),
+ [will_not_call_mercury, promise_pure, will_not_modify_trail,
+ does_not_affect_liveness, may_not_duplicate],
+"
+ VA = version_array.ML_uva.init(N, X);
+").
+
:- pragma foreign_proc("Java",
version_array.unsafe_new(N::in, X::in) = (VA::out),
[will_not_call_mercury, promise_pure, will_not_modify_trail,
@@ -473,6 +510,14 @@ cmp_version_array_2(I, Size, VAa, VAb, R) :-
VA = ML_va_resize_dolock(VA0, N, X);
").
+:- pragma foreign_proc("C#",
+ resize(VA0::in, N::in, X::in) = (VA::out),
+ [will_not_call_mercury, promise_pure, will_not_modify_trail,
+ does_not_affect_liveness, may_not_duplicate],
+"
+ VA = VA0.resize(N, X);
+").
+
:- pragma foreign_proc("Java",
resize(VA0::in, N::in, X::in) = (VA::out),
[will_not_call_mercury, promise_pure, will_not_modify_trail,
@@ -491,6 +536,14 @@ resize(N, X, VA, resize(VA, N, X)).
N = ML_va_size_dolock(VA);
").
+:- pragma foreign_proc("C#",
+ size(VA::in) = (N::out),
+ [will_not_call_mercury, promise_pure, will_not_modify_trail,
+ does_not_affect_liveness],
+"
+ N = VA.size();
+").
+
:- pragma foreign_proc("Java",
size(VA::in) = (N::out),
[will_not_call_mercury, promise_pure, will_not_modify_trail,
@@ -509,6 +562,20 @@ resize(N, X, VA, resize(VA, N, X)).
SUCCESS_INDICATOR = ML_va_get_dolock(VA, I, &X);
").
+:- pragma foreign_proc("C#",
+ get_if_in_range(VA::in, I::in, X::out),
+ [will_not_call_mercury, promise_pure, will_not_modify_trail,
+ does_not_affect_liveness],
+"
+ try {
+ X = VA.get(I);
+ SUCCESS_INDICATOR = true;
+ } catch (System.IndexOutOfRangeException) {
+ X = null;
+ SUCCESS_INDICATOR = false;
+ }
+").
+
:- pragma foreign_proc("Java",
get_if_in_range(VA::in, I::in, X::out),
[will_not_call_mercury, promise_pure, will_not_modify_trail,
@@ -534,6 +601,20 @@ resize(N, X, VA, resize(VA, N, X)).
SUCCESS_INDICATOR = ML_va_set_dolock(VA0, I, X, &VA);
").
+:- pragma foreign_proc("C#",
+ set_if_in_range(VA0::in, I::in, X::in, VA::out),
+ [will_not_call_mercury, promise_pure, will_not_modify_trail,
+ does_not_affect_liveness],
+"
+ try {
+ VA = VA0.set(I, X);
+ SUCCESS_INDICATOR = true;
+ } catch (System.IndexOutOfRangeException) {
+ VA = null;
+ SUCCESS_INDICATOR = false;
+ }
+").
+
:- pragma foreign_proc("Java",
set_if_in_range(VA0::in, I::in, X::in, VA::out),
[will_not_call_mercury, promise_pure, will_not_modify_trail,
@@ -556,6 +637,14 @@ resize(N, X, VA, resize(VA, N, X)).
VA = ML_va_rewind_dolock(VA0);
").
+:- pragma foreign_proc("C#",
+ unsafe_rewind(VA0::in) = (VA::out),
+ [will_not_call_mercury, promise_pure, will_not_modify_trail,
+ does_not_affect_liveness],
+"
+ VA = VA0.rewind();
+").
+
:- pragma foreign_proc("Java",
unsafe_rewind(VA0::in) = (VA::out),
[will_not_call_mercury, promise_pure, will_not_modify_trail,
@@ -938,6 +1027,290 @@ ML_va_resize(ML_va_ptr VA0, MR_Integer N, MR_Word X)
").
+:- pragma foreign_code("C#", "
+
+public interface ML_va {
+ object get(int I);
+ ML_va set(int I, object X);
+ ML_va resize(int N, object X);
+ ML_va rewind();
+ int size();
+}
+
+// An implementation of version arrays that is safe when used in multiple
+// threads.
+//
+// It just wraps the unsafe version is some synchronization logic so
+// that only one thread can be accessing the array at one instant.
+public class ML_sva : ML_va {
+ private ML_uva version_array;
+ private object va_lock;
+
+ public ML_sva(ML_uva va) {
+ version_array = va;
+ va_lock = new object();
+ }
+
+ private ML_sva() {}
+
+ public object get(int I) {
+ lock (va_lock) {
+ return version_array.get(I);
+ }
+ }
+
+ public ML_va set(int I, object X) {
+ lock (va_lock) {
+ ML_sva result = new ML_sva();
+
+ result.version_array = version_array.set_uva(I, X);
+
+ if (result.version_array.isClone()) {
+ result.version_array.resetIsClone();
+ result.va_lock = new object();
+ } else {
+ result.va_lock = this.va_lock;
+ }
+
+ return result;
+ }
+ }
+
+ public ML_va resize(int N, object X) {
+ lock (va_lock) {
+ ML_sva result = new ML_sva();
+ result.version_array = version_array.resize_uva(N, X);
+ result.va_lock = new object();
+ return result;
+ }
+ }
+
+ public ML_va rewind()
+ {
+ lock (va_lock) {
+ ML_sva result = new ML_sva();
+ result.version_array = version_array.rewind_uva();
+ result.va_lock = this.va_lock;
+ return result;
+ }
+ }
+
+ public int size()
+ {
+ lock (va_lock) {
+ return version_array.size();
+ }
+ }
+}
+
+// An implementation of version arrays that is only safe when used from
+// a single thread, but *much* faster than the synchronized version.
+public class ML_uva : ML_va {
+ private int index; /* -1 for latest, >= 0 for older */
+ private object value; /* Valid if index >= 0 */
+ private object rest; /* array if index == -1 */
+ /* next if index >= 0 */
+
+ private bool clone = false;
+
+ public ML_uva() {}
+
+ public static ML_uva empty() {
+ ML_uva va = new ML_uva();
+ va.index = -1;
+ va.value = null;
+ va.rest = new object[0];
+ return va;
+ }
+
+ public static ML_uva init(int N, object X) {
+ ML_uva va = new ML_uva();
+ va.index = -1;
+ va.value = null;
+ va.rest = new object[N];
+ for (int i = 0; i < N; i++) {
+ va.array()[i] = X;
+ }
+ return va;
+ }
+
+ public ML_va resize(int N, object X) {
+ return resize_uva(N, X);
+ }
+
+ public ML_uva resize_uva(int N, object X) {
+ ML_uva VA0 = this;
+ ML_uva latest;
+ int size_VA0;
+ int min;
+
+ latest = VA0.latest();
+
+ size_VA0 = latest.size();
+ min = (N <= size_VA0 ? N : size_VA0);
+ ML_uva VA = new ML_uva();
+
+ VA.index = -1;
+ VA.value = null;
+ VA.rest = new object[N];
+
+ System.Array.Copy(latest.array(), 0, VA.array(), 0, min);
+
+ VA0.rewind_into(VA);
+
+ for (int i = min; i < N; i++) {
+ VA.array()[i] = X;
+ }
+ return VA;
+ }
+
+ private bool is_latest()
+ {
+ return index == -1;
+ }
+
+ private ML_uva latest()
+ {
+ ML_uva VA = this;
+ while (!VA.is_latest()) {
+ VA = VA.next();
+ }
+ return VA;
+ }
+
+ private object[] array()
+ {
+ return (object[]) rest;
+ }
+
+ private ML_uva next()
+ {
+ return (ML_uva) rest;
+ }
+
+ public int size()
+ {
+ return latest().array().Length;
+ }
+
+ public object get(int I)
+ {
+ ML_uva VA = this;
+
+ while (!VA.is_latest()) {
+ if (I == VA.index) {
+ return VA.value;
+ }
+
+ VA = VA.next();
+ }
+
+ return VA.array()[I];
+ }
+
+ public ML_va set(int I, object X)
+ {
+ return set_uva(I, X);
+ }
+
+ public ML_uva set_uva(int I, object X)
+ {
+ ML_uva VA0 = this;
+ ML_uva VA1;
+
+ if (VA0.is_latest()) {
+ VA1 = new ML_uva();
+ VA1.index = -1;
+ VA1.value = null;
+ VA1.rest = VA0.array();
+
+ VA0.index = I;
+ VA0.value = VA0.array()[I];
+ VA0.rest = VA1;
+
+ VA1.array()[I] = X;
+ } else {
+ VA1 = VA0.flat_copy();
+
+ VA1.array()[I] = X;
+ }
+
+ return VA1;
+ }
+
+ private ML_uva flat_copy()
+ {
+ ML_uva VA0 = this;
+ ML_uva latest;
+ ML_uva VA;
+ int N;
+
+ latest = VA0.latest();
+ N = latest.size();
+
+ VA = new ML_uva();
+ VA.index = -1;
+ VA.value = null;
+ VA.rest = latest.array().Clone();
+ VA.clone = true;
+
+ VA0.rewind_into(VA);
+
+ return VA;
+ }
+
+ public bool isClone() {
+ return clone;
+ }
+
+ public void resetIsClone() {
+ this.clone = false;
+ }
+
+ private void rewind_into(ML_uva VA)
+ {
+ int I;
+ object X;
+
+ if (this.is_latest()) {
+ return;
+ }
+
+ this.next().rewind_into(VA);
+
+ I = this.index;
+ X = this.value;
+ if (I < VA.size()) {
+ VA.array()[I] = X;
+ }
+ }
+
+ public ML_va rewind()
+ {
+ return rewind_uva();
+ }
+
+ public ML_uva rewind_uva()
+ {
+ ML_uva VA = this;
+ int I;
+ object X;
+
+ if (VA.is_latest()) {
+ return VA;
+ }
+
+ I = VA.index;
+ X = VA.value;
+ VA = VA.next().rewind_uva();
+ VA.array()[I] = X;
+
+ return VA;
+ }
+}
+
+").
+
:- pragma foreign_code("Java", "
public interface ML_va {
diff --git a/library/version_hash_table.m b/library/version_hash_table.m
index 22de6e1..dc9c94f 100644
--- a/library/version_hash_table.m
+++ b/library/version_hash_table.m
@@ -278,6 +278,13 @@ find_slot_2(HashPred, K, NumBuckets, H) :-
HashPred = HashPred0;
").
+:- pragma foreign_proc("C#",
+ unsafe_hash_pred_cast(HashPred0::in, HashPred::out(hash_pred)),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ HashPred = HashPred0;
+").
+
:- pragma foreign_proc("Java",
unsafe_hash_pred_cast(HashPred0::in, HashPred::out(hash_pred)),
[will_not_call_mercury, promise_pure, thread_safe],
diff --git a/runtime/mercury_dotnet.cs.in b/runtime/mercury_dotnet.cs.in
index 78046c3..3c1e2cd 100644
--- a/runtime/mercury_dotnet.cs.in
+++ b/runtime/mercury_dotnet.cs.in
@@ -270,14 +270,22 @@ public class TypeInfo_Struct : PseudoTypeInfo {
if (this == ti) {
return true;
}
- if (!type_ctor.Equals(ti.type_ctor)) {
+
+ TypeInfo_Struct self = this.collapse_equivalences();
+ ti = ti.collapse_equivalences();
+
+ if (self == ti) {
+ return true;
+ }
+
+ if (!self.type_ctor.Equals(ti.type_ctor)) {
return false;
}
int len1 = 0;
int len2 = 0;
- if (args != null) {
- len1 = args.Length;
+ if (self.args != null) {
+ len1 = self.args.Length;
}
if (ti.args != null) {
len2 = ti.args.Length;
@@ -287,12 +295,28 @@ public class TypeInfo_Struct : PseudoTypeInfo {
}
for (int i = 0; i < len1; i++) {
- if (!args[i].Equals(ti.args[i])) {
+ if (!self.args[i].Equals(ti.args[i])) {
return false;
}
}
return true;
}
+
+ private TypeInfo_Struct collapse_equivalences() {
+ TypeInfo_Struct ti = this;
+
+ /* Look past equivalences */
+ while (ti.type_ctor.type_ctor_rep ==
+ TypeCtorRep.MR_TYPECTOR_REP_EQUIV_GROUND
+ || ti.type_ctor.type_ctor_rep ==
+ TypeCtorRep.MR_TYPECTOR_REP_EQUIV)
+ {
+ ti = TypeInfo_Struct.maybe_new(
+ ti.type_ctor.type_layout.layout_equiv());
+ }
+
+ return ti;
+ }
}
public class TypeLayout {
diff --git a/tests/hard_coded/Mmakefile b/tests/hard_coded/Mmakefile
index 513690a..167222e 100644
--- a/tests/hard_coded/Mmakefile
+++ b/tests/hard_coded/Mmakefile
@@ -353,7 +353,7 @@ JAVA_PASS_PROGS= \
value_enum
# Solver types only work in C grades
-ifeq "$(filter il% java% erlang%,$(GRADE))" ""
+ifeq "$(filter il% csharp% java% erlang%,$(GRADE))" ""
SOLVER_PROGS = \
any_call_hoist_bug \
any_free_unify \
@@ -444,7 +444,7 @@ endif
# The foreign_type_assertion test is currently meaningful only in C grades.
# Tests of the C foreign language interface only work in C grades.
# Runtime options are specific to the C backend.
-ifeq "$(filter il% java% erlang%,$(GRADE))" ""
+ifeq "$(filter il% csharp% java% erlang%,$(GRADE))" ""
C_ONLY_PROGS = \
factt \
factt_sort_test \
@@ -504,7 +504,7 @@ CLOSURE_LAYOUT_PROGS = \
# This test requires the implementation's representation of characters
# to be the same as their representation in files, which is not true
# for the IL and Java back-ends, which use Unicode internally.
-ifeq "$(filter il% java%,$(GRADE))" ""
+ifeq "$(filter il% csharp% java%,$(GRADE))" ""
CHAR_REP_PROGS = special_char
else
CHAR_REP_PROGS =
@@ -602,7 +602,7 @@ endif
# be replaced by a test that exercises functionality enabled by type tables.
# However, this must wait for the implementation of that functionality.
-ifeq "$(filter hl% il% java% erlang%,$(GRADE))" ""
+ifeq "$(filter hl% il% csharp% java% erlang%,$(GRADE))" ""
ifeq "$(findstring profdeep,$(GRADE))" ""
BACKEND_PROGS_2 = \
factt_non
@@ -641,7 +641,7 @@ ifneq "$(findstring apple-darwin,$(FULLARCH))" "apple-darwin"
ifneq "$(findstring solaris,$(FULLARCH))" "solaris"
# The `parse' test also links with the debug libraries,
# so it only works in LLDS grades.
- ifeq "$(filter hl% java% il% erlang%,$(GRADE))" ""
+ ifeq "$(filter hl% csharp% java% il% erlang%,$(GRADE))" ""
STATIC_LINK_PROGS = parse
endif
endif
diff --git a/tests/hard_coded/deep_copy.exp3 b/tests/hard_coded/deep_copy.exp3
new file mode 100644
index 0000000..f037d1c
--- /dev/null
+++ b/tests/hard_coded/deep_copy.exp3
@@ -0,0 +1,113 @@
+TESTING DISCRIMINATED UNIONS
+two
+two
+two
+one
+one
+one
+three
+three
+three
+apple([9, 5, 1])
+apple([9, 5, 1])
+apple([9, 5, 1])
+banana([three, one, two])
+banana([three, one, two])
+banana([three, one, two])
+zop(3.3, 2.03)
+zop(3.3, 2.03)
+zop(3.3, 2.03)
+zip(3, 2)
+zip(3, 2)
+zip(3, 2)
+zap(3, -2.111)
+zap(3, -2.111)
+zap(3, -2.111)
+wombat
+wombat
+wombat
+foo
+foo
+foo
+tuple_a(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ["a", "b", "c"], 16, 17)
+tuple_a(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ["a", "b", "c"], 16, 17)
+tuple_a(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ["a", "b", "c"], 16, 17)
+tuple_b(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ["a", "b", "c"], 16, ["x", "y", "z"])
+tuple_b(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ["a", "b", "c"], 16, ["x", "y", "z"])
+tuple_b(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, ["a", "b", "c"], 16, ["x", "y", "z"])
+tuple_c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ["p", "q"], 17)
+tuple_c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ["p", "q"], 17)
+tuple_c(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, ["p", "q"], 17)
+tuple_d(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, ["d", "e", "f"], 15, ["u", "v", "w"], 17)
+tuple_d(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, ["d", "e", "f"], 15, ["u", "v", "w"], 17)
+tuple_d(0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, ["d", "e", "f"], 15, ["u", "v", "w"], 17)
+
+TESTING POLYMORPHISM
+poly_three(3.33, 4, poly_one(9.11))
+poly_three(3.33, 4, poly_one(9.11))
+poly_three(3.33, 4, poly_one(9.11))
+poly_two(3)
+poly_two(3)
+poly_two(3)
+poly_one([2399.3])
+poly_one([2399.3])
+poly_one([2399.3])
+
+TESTING BUILTINS
+""
+""
+""
+"Hello, world\n"
+"Hello, world\n"
+"Hello, world\n"
+"Foo%sFoo"
+"Foo%sFoo"
+"Foo%sFoo"
+"\""
+"\""
+"\""
+'a'
+'a'
+'a'
+'&'
+'&'
+'&'
+3.14159
+3.14159
+3.14159
+1.128324983E-21
+1.128324983E-21
+1.128324983E-21
+2.23954899E+23
+2.23954899E+23
+2.23954899E+23
+-65
+-65
+-65
+4
+4
+4
+univ_cons(["hi! I\'m a univ!"])
+univ_cons(["hi! I\'m a univ!"])
+univ_cons(["hi! I\'m a univ!"])
+{1, "two", '3', {4, '5', "6"}}
+{1, "two", '3', {4, '5', "6"}}
+{1, "two", '3', {4, '5', "6"}}
+
+TESTING OTHER TYPES
+var(1)
+var(1)
+var(1)
+var_supply(0)
+var_supply(0)
+var_supply(0)
+var_supply(1)
+var_supply(1)
+var_supply(1)
+empty
+empty
+empty
+qwerty(4)
+qwerty(4)
+qwerty(4)
+
diff --git a/tests/hard_coded/ee_dummy.m b/tests/hard_coded/ee_dummy.m
index 0428ed2..0729b16 100644
--- a/tests/hard_coded/ee_dummy.m
+++ b/tests/hard_coded/ee_dummy.m
@@ -19,6 +19,9 @@
:- pragma foreign_export_enum("C", dummy_type/0, [prefix("FOO_")]).
:- pragma foreign_export_enum("C", poly_dummy_type/1, [prefix("BAR_")]).
+:- pragma foreign_export_enum("C#", dummy_type/0, [prefix("FOO_")]).
+:- pragma foreign_export_enum("C#", poly_dummy_type/1, [prefix("BAR_")]).
+
:- pragma foreign_export_enum("Java", dummy_type/0, [prefix("FOO_")]).
:- pragma foreign_export_enum("Java", poly_dummy_type/1, [prefix("BAR_")]).
@@ -48,6 +51,13 @@ main(!IO) :-
Result = (X == FOO_dummy_type) ? MR_YES : MR_NO;
IO = IO0;
").
+:- pragma foreign_proc("C#",
+ check_dummy_type(X::in, Result::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Result = (X == FOO_dummy_type) ? mr_bool.YES : mr_bool.NO;
+ IO = IO0;
+").
:- pragma foreign_proc("Java",
check_dummy_type(X::in, Result::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure],
@@ -65,6 +75,13 @@ main(!IO) :-
Result = (X == BAR_poly_dummy_type) ? MR_YES : MR_NO;
IO = IO0;
").
+:- pragma foreign_proc("C#",
+ check_poly_dummy_type(X::in, Result::out, IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ Result = (X == BAR_poly_dummy_type) ? mr_bool.YES : mr_bool.NO;
+ IO = IO0;
+").
:- pragma foreign_proc("Java",
check_poly_dummy_type(X::in, Result::out, IO0::di, IO::uo),
[will_not_call_mercury, promise_pure],
diff --git a/tests/hard_coded/ee_valid_test.m b/tests/hard_coded/ee_valid_test.m
index 5dcf4d6..4e41f96 100644
--- a/tests/hard_coded/ee_valid_test.m
+++ b/tests/hard_coded/ee_valid_test.m
@@ -38,11 +38,13 @@ main(!IO) :-
% Default mapping.
%
:- pragma foreign_export_enum("C", fruit/0).
+:- pragma foreign_export_enum("C#", fruit/0).
:- pragma foreign_export_enum("Java", fruit/0).
% Default mapping with prefix.
%
:- pragma foreign_export_enum("C", fruit/0, [prefix("PREFIX_")]).
+:- pragma foreign_export_enum("C#", fruit/0, [prefix("PREFIX_")]).
:- pragma foreign_export_enum("Java", fruit/0, [prefix("PREFIX_")]).
% User-specified mapping.
@@ -56,6 +58,14 @@ main(!IO) :-
ee_valid_test.lemon - "LEMON"
]).
+:- pragma foreign_export_enum("C#", fruit/0, [prefix("USER_")],
+ [
+ ee_valid_test.apple - "APPLE",
+ orange - "ORANGE",
+ ee_valid_test.pear - "PEAR",
+ ee_valid_test.lemon - "LEMON"
+ ]).
+
:- pragma foreign_export_enum("Java", fruit/0, [prefix("USER_")],
[
ee_valid_test.apple - "APPLE",
@@ -67,6 +77,7 @@ main(!IO) :-
% Default mapping for quoted Mercury names.
%
:- pragma foreign_export_enum("C", foo/0).
+:- pragma foreign_export_enum("C#", foo/0).
:- pragma foreign_export_enum("Java", foo/0).
:- func get_default_apple = fruit.
@@ -76,6 +87,12 @@ main(!IO) :-
"
X = apple;
").
+:- pragma foreign_proc("C#",
+ get_default_apple = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = apple;
+").
:- pragma foreign_proc("Java",
get_default_apple = (X::out),
[will_not_call_mercury, promise_pure],
@@ -90,6 +107,12 @@ main(!IO) :-
"
X = orange;
").
+:- pragma foreign_proc("C#",
+ get_default_orange = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = orange;
+").
:- pragma foreign_proc("Java",
get_default_orange = (X::out),
[will_not_call_mercury, promise_pure],
@@ -104,6 +127,12 @@ main(!IO) :-
"
X = PREFIX_pear;
").
+:- pragma foreign_proc("C#",
+ get_prefix_pear = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = PREFIX_pear;
+").
:- pragma foreign_proc("Java",
get_prefix_pear = (X::out),
[will_not_call_mercury, promise_pure],
@@ -118,6 +147,12 @@ main(!IO) :-
"
X = USER_LEMON;
").
+:- pragma foreign_proc("C#",
+ get_user_lemon = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = USER_LEMON;
+").
:- pragma foreign_proc("Java",
get_user_lemon = (X::out),
[will_not_call_mercury, promise_pure],
@@ -132,6 +167,12 @@ main(!IO) :-
"
X = BAR;
").
+:- pragma foreign_proc("C#",
+ get_bar = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = BAR;
+").
:- pragma foreign_proc("Java",
get_bar = (X::out),
[will_not_call_mercury, promise_pure],
diff --git a/tests/hard_coded/equality_pred_which_requires_boxing.m b/tests/hard_coded/equality_pred_which_requires_boxing.m
index 68243ae..eee9a62 100644
--- a/tests/hard_coded/equality_pred_which_requires_boxing.m
+++ b/tests/hard_coded/equality_pred_which_requires_boxing.m
@@ -18,6 +18,8 @@
where equality is unify_ft.
:- pragma foreign_type(il, type_which_needs_boxing,
"valuetype [mscorlib]System.Double") where equality is unify_ft.
+:- pragma foreign_type("C#", type_which_needs_boxing,
+ "System.Double") where equality is unify_ft.
:- pragma foreign_type(java, type_which_needs_boxing,
"Double") where equality is unify_ft.
:- pragma foreign_type(erlang, type_which_needs_boxing,
@@ -29,6 +31,9 @@
:- pragma foreign_type(il, type_which_needs_boxing(T),
"valuetype [mscorlib]System.Double")
where equality is unify_ft_T.
+:- pragma foreign_type("C#", type_which_needs_boxing(T),
+ "System.Double")
+ where equality is unify_ft_T.
:- pragma foreign_type(java, type_which_needs_boxing(T), "Double")
where equality is unify_ft_T.
:- pragma foreign_type(erlang, type_which_needs_boxing(T), "")
diff --git a/tests/hard_coded/expand.exp3 b/tests/hard_coded/expand.exp3
new file mode 100644
index 0000000..b8aa082
--- /dev/null
+++ b/tests/hard_coded/expand.exp3
@@ -0,0 +1,202 @@
+TESTING DISCRIMINATED UNIONS
+one/0
+0/0
+no arguments
+expand: functor one arity 0 arguments []
+expand: functor 0 arity 0 arguments []
+
+two/0
+2/0
+no arguments
+expand: functor two arity 0 arguments []
+expand: functor 2 arity 0 arguments []
+
+three/0
+1/0
+no arguments
+expand: functor three arity 0 arguments []
+expand: functor 1 arity 0 arguments []
+
+apple/1
+0/1
+argument 1 of functor apple was:[9, 5, 1]
+expand: functor apple arity 1 arguments [[9, 5, 1]]
+expand: functor 0 arity 1 arguments [[9, 5, 1]]
+
+banana/1
+1/1
+argument 1 of functor banana was:[three, one, two]
+expand: functor banana arity 1 arguments [[three, one, two]]
+expand: functor 1 arity 1 arguments [[three, one, two]]
+
+zop/2
+10/2
+argument 2 of functor zop was:2.03
+expand: functor zop arity 2 arguments [3.3, 2.03]
+expand: functor 10 arity 2 arguments [3.3, 2.03]
+
+zip/2
+8/2
+argument 2 of functor zip was:2
+expand: functor zip arity 2 arguments [3, 2]
+expand: functor 8 arity 2 arguments [3, 2]
+
+zap/2
+7/2
+argument 2 of functor zap was:-2.111
+expand: functor zap arity 2 arguments [3, -2.111]
+expand: functor 7 arity 2 arguments [3, -2.111]
+
+wombat/0
+6/0
+no arguments
+expand: functor wombat arity 0 arguments []
+expand: functor 6 arity 0 arguments []
+
+foo/0
+2/0
+no arguments
+expand: functor foo arity 0 arguments []
+expand: functor 2 arity 0 arguments []
+
+
+TESTING POLYMORPHISM
+poly_two/1
+2/1
+argument 1 of functor poly_two was:3
+expand: functor poly_two arity 1 arguments [3]
+expand: functor 2 arity 1 arguments [3]
+
+poly_three/3
+1/3
+argument 3 of functor poly_three was:poly_one(9.11)
+expand: functor poly_three arity 3 arguments [3.33, 4, poly_one(9.11)]
+expand: functor 1 arity 3 arguments [3.33, 4, poly_one(9.11)]
+
+poly_one/1
+0/1
+argument 1 of functor poly_one was:[2399.3]
+expand: functor poly_one arity 1 arguments [[2399.3]]
+expand: functor 0 arity 1 arguments [[2399.3]]
+
+
+TESTING BUILTINS
+""/0
+functor_number_cc failed
+no arguments
+expand: functor "" arity 0 arguments []
+deconstruct_du failed
+
+"Hello, world
+"/0
+functor_number_cc failed
+no arguments
+expand: functor "Hello, world
+" arity 0 arguments []
+deconstruct_du failed
+
+"Foo%sFoo"/0
+functor_number_cc failed
+no arguments
+expand: functor "Foo%sFoo" arity 0 arguments []
+deconstruct_du failed
+
+"""/0
+functor_number_cc failed
+no arguments
+expand: functor """ arity 0 arguments []
+deconstruct_du failed
+
+'a'/0
+functor_number_cc failed
+no arguments
+expand: functor 'a' arity 0 arguments []
+deconstruct_du failed
+
+'&'/0
+functor_number_cc failed
+no arguments
+expand: functor '&' arity 0 arguments []
+deconstruct_du failed
+
+3.14159/0
+functor_number_cc failed
+no arguments
+expand: functor 3.14159 arity 0 arguments []
+deconstruct_du failed
+
+1.128324983E-21/0
+functor_number_cc failed
+no arguments
+expand: functor 1.128324983E-21 arity 0 arguments []
+deconstruct_du failed
+
+2.23954899E+23/0
+functor_number_cc failed
+no arguments
+expand: functor 2.23954899E+23 arity 0 arguments []
+deconstruct_du failed
+
+-65/0
+functor_number_cc failed
+no arguments
+expand: functor -65 arity 0 arguments []
+deconstruct_du failed
+
+4/0
+functor_number_cc failed
+no arguments
+expand: functor 4 arity 0 arguments []
+deconstruct_du failed
+
+univ_cons/1
+0/1
+argument 1 of functor univ_cons was:["hi! I\'m a univ!"]
+expand: functor univ_cons arity 1 arguments [["hi! I\'m a univ!"]]
+expand: functor 0 arity 1 arguments [["hi! I\'m a univ!"]]
+
+<<predicate>>/0
+functor_number_cc failed
+no arguments
+expand: functor <<predicate>> arity 0 arguments []
+deconstruct_du failed
+
+{}/4
+0/4
+argument 4 of functor {} was:{1, 2, 3, 4}
+expand: functor {} arity 4 arguments [1, 'b', "third", {1, 2, 3, 4}]
+expand: functor 0 arity 4 arguments [1, 'b', "third", {1, 2, 3, 4}]
+
+
+TESTING OTHER TYPES
+var/1
+0/1
+argument 1 of functor var was:1
+expand: functor var arity 1 arguments [1]
+expand: functor 0 arity 1 arguments [1]
+
+var_supply/1
+0/1
+argument 1 of functor var_supply was:0
+expand: functor var_supply arity 1 arguments [0]
+expand: functor 0 arity 1 arguments [0]
+
+var_supply/1
+0/1
+argument 1 of functor var_supply was:1
+expand: functor var_supply arity 1 arguments [1]
+expand: functor 0 arity 1 arguments [1]
+
+empty/0
+0/0
+no arguments
+expand: functor empty arity 0 arguments []
+expand: functor 0 arity 0 arguments []
+
+qwerty/1
+0/1
+argument 1 of functor qwerty was:4
+expand: functor qwerty arity 1 arguments [4]
+expand: functor 0 arity 1 arguments [4]
+
+
diff --git a/tests/hard_coded/export_test.m b/tests/hard_coded/export_test.m
index f3420c1..244223a 100644
--- a/tests/hard_coded/export_test.m
+++ b/tests/hard_coded/export_test.m
@@ -24,6 +24,7 @@ main -->
foo(X, X+1).
:- pragma foreign_export("C", foo(in, out), "foo").
+:- pragma foreign_export("C#", foo(in, out), "foo").
:- pragma foreign_export("Java", foo(in, out), "foo").
:- pragma foreign_proc("C",
@@ -34,7 +35,7 @@ foo(X, X+1).
").
:- pragma foreign_proc("C#", bar(X::in, Y::out),
[may_call_mercury, promise_pure], "
- export_test.mercury_code.foo(X, ref Y);
+ Y = export_test.foo(X);
").
:- pragma foreign_proc("Java", bar(X::in, Y::out),
[may_call_mercury, promise_pure], "
diff --git a/tests/hard_coded/exported_foreign_enum.m b/tests/hard_coded/exported_foreign_enum.m
index e84209f..9fa9712 100644
--- a/tests/hard_coded/exported_foreign_enum.m
+++ b/tests/hard_coded/exported_foreign_enum.m
@@ -28,7 +28,19 @@ main(!IO) :-
}
").
+:- pragma foreign_proc("C#",
+ test(X::in),
+ [will_not_call_mercury, promise_pure],
+"
+ if (X == FOO_bar) {
+ SUCCESS_INDICATOR = true;
+ } else {
+ SUCCESS_INDICATOR = false;
+ }
+").
+
:- pragma foreign_export_enum("C", foo/0, [prefix("FOO_")]).
+:- pragma foreign_export_enum("C#", foo/0, [prefix("FOO_")]).
:- type foo
---> foo
@@ -40,3 +52,9 @@ main(!IO) :-
bar - "500",
baz - "600"
]).
+
+:- pragma foreign_enum("C#", foo/0, [
+ foo - "400",
+ bar - "500",
+ baz - "600"
+]).
diff --git a/tests/hard_coded/external_unification_pred.m b/tests/hard_coded/external_unification_pred.m
index 4be0c90..2f32fa1 100644
--- a/tests/hard_coded/external_unification_pred.m
+++ b/tests/hard_coded/external_unification_pred.m
@@ -22,6 +22,7 @@
:- pragma foreign_type(c, ft, "int") where equality is unify_ft.
:- pragma foreign_type(il, ft, "valuetype [mscorlib]System.Int32")
where equality is unify_ft.
+ :- pragma foreign_type("C#", ft, "int") where equality is unify_ft.
:- pragma foreign_type(java, ft, "Integer") where equality is unify_ft.
:- pragma foreign_type(erlang, ft, "") where equality is unify_ft.
diff --git a/tests/hard_coded/float_gv.m b/tests/hard_coded/float_gv.m
index 42d72bb..dfc696b 100644
--- a/tests/hard_coded/float_gv.m
+++ b/tests/hard_coded/float_gv.m
@@ -19,6 +19,7 @@
:- type coord.
:- pragma foreign_type(c, coord, "coord *").
+:- pragma foreign_type("C#", coord, "Coord").
:- pragma foreign_type("Java", coord, "Coord").
:- pragma foreign_type("Erlang", coord, "").
@@ -28,6 +29,12 @@ typedef struct {
} coord;
").
+:- pragma foreign_decl("C#", "
+class Coord {
+ public int x, y;
+}
+").
+
:- pragma foreign_decl("Java", "
class Coord {
public int x, y;
@@ -62,6 +69,29 @@ class Coord {
Y = C->y;
").
+:- pragma foreign_proc("C#",
+ new_coord(X::in, Y::in) = (C::out),
+ [will_not_call_mercury, promise_pure],
+"
+ C = new Coord();
+ C.x = X;
+ C.y = Y;
+").
+
+:- pragma foreign_proc("C#",
+ x(C::in) = (X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = C.x;
+").
+
+:- pragma foreign_proc("C#",
+ y(C::in) = (Y::out),
+ [will_not_call_mercury, promise_pure],
+"
+ Y = C.y;
+").
+
:- pragma foreign_proc("Java",
new_coord(X::in, Y::in) = (C::out),
[will_not_call_mercury, promise_pure],
diff --git a/tests/hard_coded/float_reg.exp3 b/tests/hard_coded/float_reg.exp3
new file mode 100644
index 0000000..bc1bd6c
--- /dev/null
+++ b/tests/hard_coded/float_reg.exp3
@@ -0,0 +1,3 @@
+2.88E+32
+1E+32
+10000000000.0
diff --git a/tests/hard_coded/foreign_enum_dummy.m b/tests/hard_coded/foreign_enum_dummy.m
index 11df826..7e50f8c 100644
--- a/tests/hard_coded/foreign_enum_dummy.m
+++ b/tests/hard_coded/foreign_enum_dummy.m
@@ -28,6 +28,17 @@ main(!IO) :-
SUCCESS_INDICATOR = MR_FALSE;
}
").
+:- pragma foreign_proc("C#",
+ test(FOO::in),
+ [will_not_call_mercury, promise_pure],
+"
+ if (FOO == 561) {
+ SUCCESS_INDICATOR = true;
+ } else {
+ SUCCESS_INDICATOR = false;
+ }
+").
:- type foo ---> foo.
:- pragma foreign_enum("C", foo/0, [foo - "561"]).
+:- pragma foreign_enum("C#", foo/0, [foo - "561"]).
diff --git a/tests/hard_coded/foreign_import_module_2.m b/tests/hard_coded/foreign_import_module_2.m
index 5049ada..2a1a7f2 100644
--- a/tests/hard_coded/foreign_import_module_2.m
+++ b/tests/hard_coded/foreign_import_module_2.m
@@ -10,6 +10,7 @@
:- pragma foreign_export("C", foo(in, out), "foo").
:- pragma foreign_export("IL", foo(in, out), "foo").
+:- pragma foreign_export("C#", foo(in, out), "foo").
:- pragma foreign_export("Java", foo(in, out), "foo").
:- pragma foreign_export("Erlang", foo(in, out), "foo").
diff --git a/tests/hard_coded/foreign_name_mutable.m b/tests/hard_coded/foreign_name_mutable.m
index c066fff..39fb70f 100644
--- a/tests/hard_coded/foreign_name_mutable.m
+++ b/tests/hard_coded/foreign_name_mutable.m
@@ -11,6 +11,7 @@
:- mutable(foo, int, 42, ground, [
untrailed,
foreign_name("C", "FOO"),
+ foreign_name("C#", "FOO"),
foreign_name("Java", "FOO")
]).
@@ -33,6 +34,15 @@ main(!IO) :-
IO = IO0;
").
+:- pragma foreign_proc("C#",
+ increment_global(IO0::di, IO::uo),
+ [will_not_call_mercury, promise_pure],
+"
+ int x = (int) FOO;
+ FOO = (object) (x + 1);
+ IO = IO0;
+").
+
:- pragma foreign_proc("Java",
increment_global(IO0::di, IO::uo),
[will_not_call_mercury, promise_pure],
diff --git a/tests/hard_coded/foreign_type.m b/tests/hard_coded/foreign_type.m
index 3d5b43a..2a24186 100644
--- a/tests/hard_coded/foreign_type.m
+++ b/tests/hard_coded/foreign_type.m
@@ -60,6 +60,8 @@ main -->
:- pragma foreign_type(il, coord,
"class [foreign_type__csharp_code]coord").
+:- pragma foreign_type("C#", coord, "coord").
+
:- pragma foreign_decl("C#", "
public class coord {
public int x;
diff --git a/tests/hard_coded/foreign_type2.m b/tests/hard_coded/foreign_type2.m
index 855df91..51f4dc6 100644
--- a/tests/hard_coded/foreign_type2.m
+++ b/tests/hard_coded/foreign_type2.m
@@ -39,6 +39,8 @@ main -->
:- pragma foreign_type(il, coord(T),
"class [foreign_type2__csharp_code]coord").
+:- pragma foreign_type("C#", coord(T), "coord").
+
:- pragma foreign_decl("C#", "
public class coord {
public int x;
diff --git a/tests/hard_coded/foreign_type3.m b/tests/hard_coded/foreign_type3.m
index bf05311..0098026 100644
--- a/tests/hard_coded/foreign_type3.m
+++ b/tests/hard_coded/foreign_type3.m
@@ -62,6 +62,7 @@ class coord {
:- pragma foreign_type(c, dir, "dirs").
:- pragma foreign_type(il, dir,
"valuetype [foreign_type3__csharp_code]dirs").
+:- pragma foreign_type("C#", dir, "dirs").
:- pragma foreign_type(java, dir, "dirs").
:- pragma foreign_type(erlang, dir, "").
@@ -69,12 +70,14 @@ class coord {
:- pragma foreign_type(c, coord, "coord").
:- pragma foreign_type(il, coord,
"valuetype [foreign_type3__csharp_code]coord").
+:- pragma foreign_type("C#", coord, "coord").
:- pragma foreign_type(java, coord, "coord").
:- pragma foreign_type(erlang, coord, "").
:- type double.
:- pragma foreign_type(c, double, "double").
:- pragma foreign_type(il, double, "valuetype [mscorlib]System.Double").
+:- pragma foreign_type("C#", double, "double").
:- pragma foreign_type(java, double, "Double").
:- pragma foreign_type(erlang, double, "").
diff --git a/tests/hard_coded/hash_table_test.m b/tests/hard_coded/hash_table_test.m
index eac963c..98c449c 100644
--- a/tests/hard_coded/hash_table_test.m
+++ b/tests/hard_coded/hash_table_test.m
@@ -147,6 +147,13 @@ do_replace_neg(I, !HT) :-
HT = HT0;
").
+:- pragma foreign_proc("C#",
+ unsafe_hash_table_cast(HT0::in, HT::out(hash_table)),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ HT = HT0;
+").
+
:- pragma foreign_proc("Java",
unsafe_hash_table_cast(HT0::in, HT::out(hash_table)),
[will_not_call_mercury, promise_pure, thread_safe],
diff --git a/tests/hard_coded/impure_init_and_final.m b/tests/hard_coded/impure_init_and_final.m
index b059184..61e7cea 100644
--- a/tests/hard_coded/impure_init_and_final.m
+++ b/tests/hard_coded/impure_init_and_final.m
@@ -22,6 +22,12 @@ main(!IO) :- io.write_string("This is main...\n", !IO).
"
puts(S);
").
+:- pragma foreign_proc("C#",
+ puts(S::in),
+ [will_not_call_mercury],
+"
+ System.Console.WriteLine(S);
+").
:- pragma foreign_proc("Java",
puts(S::in),
[will_not_call_mercury],
diff --git a/tests/hard_coded/intermod_poly_mode_2.m b/tests/hard_coded/intermod_poly_mode_2.m
index 675da49..28ecfa0 100644
--- a/tests/hard_coded/intermod_poly_mode_2.m
+++ b/tests/hard_coded/intermod_poly_mode_2.m
@@ -12,6 +12,12 @@
"
R = X;
").
+:- pragma foreign_proc("C#",
+ new(X::in(I)) = (R::out(I)),
+ [promise_pure, will_not_call_mercury],
+"
+ R = X;
+").
:- pragma foreign_proc("Java",
new(X::in(I)) = (R::out(I)),
[promise_pure, will_not_call_mercury],
diff --git a/tests/hard_coded/loop_inv_test.m b/tests/hard_coded/loop_inv_test.m
index 865a9b0..8e071c4 100644
--- a/tests/hard_coded/loop_inv_test.m
+++ b/tests/hard_coded/loop_inv_test.m
@@ -77,12 +77,12 @@ loop2(N, Inv, Acc0, Acc) :-
X = Inv + 42;
").
+:- pragma foreign_code("C#", "static int p_num_calls = 0;").
:- pragma foreign_proc("C#", p(Inv::in, X::out),
[will_not_call_mercury, promise_pure],
"
/* Test that p/1 only gets called once. */
- static int num_calls = 0;
- if (num_calls++) {
+ if (p_num_calls++) {
mercury.runtime.Errors.fatal_error(""p/1 called more than once"");
}
@@ -125,12 +125,12 @@ loop2(N, Inv, Acc0, Acc) :-
X = Inv + 53;
").
+:- pragma foreign_code("C#", "static int q_num_calls = 0;").
:- pragma foreign_proc("C#", q(Inv::in, X::out),
[will_not_call_mercury, promise_pure],
"
/* Test that q/1 only gets called once. */
- static int num_calls = 0;
- if (num_calls++) {
+ if (q_num_calls++) {
mercury.runtime.Errors.fatal_error(""q/1 called more than once"");
}
diff --git a/tests/hard_coded/loop_inv_test1.m b/tests/hard_coded/loop_inv_test1.m
index a9fe844..7677fdd 100644
--- a/tests/hard_coded/loop_inv_test1.m
+++ b/tests/hard_coded/loop_inv_test1.m
@@ -76,12 +76,12 @@ loop2(N, Acc0, Acc) :-
X = 42;
").
+:- pragma foreign_code("C#", "static int p_num_calls = 0;").
:- pragma foreign_proc("C#", p(X::out),
[will_not_call_mercury, promise_pure],
"
/* Test that p/1 only gets called once. */
- static int num_calls = 0;
- if (num_calls++) {
+ if (p_num_calls++) {
mercury.runtime.Errors.fatal_error(""p/1 called more than once"");
}
@@ -124,12 +124,12 @@ loop2(N, Acc0, Acc) :-
X = 53;
").
+:- pragma foreign_code("C#", "static int q_num_calls = 0;").
:- pragma foreign_proc("C#", q(X::out),
[will_not_call_mercury, promise_pure],
"
/* Test that q/1 only gets called once. */
- static int num_calls = 0;
- if (num_calls++) {
+ if (q_num_calls++) {
mercury.runtime.Errors.fatal_error(""q/1 called more than once"");
}
diff --git a/tests/hard_coded/multimode.m b/tests/hard_coded/multimode.m
index 176d2b6..329f1b2 100644
--- a/tests/hard_coded/multimode.m
+++ b/tests/hard_coded/multimode.m
@@ -92,8 +92,12 @@ test2(0::out, 0::out) :-
"
puts(S)
").
-:- pragma foreign_proc("C#", puts(S::in),
- [promise_pure], "System.Console.WriteLine(S);").
+:- pragma foreign_proc("C#",
+ puts(S::in),
+ [will_not_call_mercury],
+"
+ System.Console.WriteLine(S);
+").
:- pragma foreign_proc("Java",
puts(S::in),
[will_not_call_mercury],
diff --git a/tests/hard_coded/pragma_export.m b/tests/hard_coded/pragma_export.m
index b56e127..7008f18 100644
--- a/tests/hard_coded/pragma_export.m
+++ b/tests/hard_coded/pragma_export.m
@@ -22,4 +22,12 @@ main -->
write_str(Str);
").
+:- pragma foreign_proc("C#",
+ my_write_string(Str::in, _IO0::di, _IO::uo),
+ [promise_pure, may_call_mercury, thread_safe],
+"
+ write_str(Str);
+").
+
:- pragma foreign_export("C", io__write_string(in, di, uo), "write_str").
+:- pragma foreign_export("C#", io__write_string(in, di, uo), "write_str").
diff --git a/tests/hard_coded/pragma_foreign_export.m b/tests/hard_coded/pragma_foreign_export.m
index 5377625..e5f90e7 100644
--- a/tests/hard_coded/pragma_foreign_export.m
+++ b/tests/hard_coded/pragma_foreign_export.m
@@ -16,6 +16,8 @@ main(!IO) :-
:- pred hello_world(io::di, io::uo) is det.
:- pragma foreign_export("C", hello_world(di, uo),
"exported_hello_world").
+:- pragma foreign_export("C#", hello_world(di, uo),
+ "exported_hello_world").
:- pragma foreign_export("Java", hello_world(di, uo),
"exported_hello_world").
:- pragma foreign_export("Erlang", hello_world(di, uo),
@@ -32,6 +34,14 @@ hello_world(!IO) :-
IO = IO0;
").
+:- pragma foreign_proc("C#",
+ call_foreign(IO0::di, IO::uo),
+ [promise_pure, may_call_mercury],
+"
+ exported_hello_world();
+ IO = IO0;
+").
+
:- pragma foreign_proc("Java",
call_foreign(_IO0::di, _IO::uo),
[promise_pure, may_call_mercury],
diff --git a/tests/hard_coded/redoip_clobber.m b/tests/hard_coded/redoip_clobber.m
index 350f839..5058128 100644
--- a/tests/hard_coded/redoip_clobber.m
+++ b/tests/hard_coded/redoip_clobber.m
@@ -63,7 +63,7 @@ bar(X) :- X = 1.
:- pragma foreign_proc("C#", use(_X::in),
[will_not_call_mercury, promise_pure],
"
- SUCCESS_INDICATOR = false
+ SUCCESS_INDICATOR = false;
").
:- pragma foreign_proc("Java", use(_X::in),
[will_not_call_mercury, promise_pure],
diff --git a/tests/hard_coded/string_strip.exp2 b/tests/hard_coded/string_strip.exp2
index 7e5e89e..f226576 100644
--- a/tests/hard_coded/string_strip.exp2
+++ b/tests/hard_coded/string_strip.exp2
@@ -190,102 +190,102 @@ strip("foo") = "foo"
strip("\n\nfoo") = "foo"
strip("foo\n\n") = "foo"
strip("\n\nfoo\n\n") = "foo"
-lstrip(is_alpha)("foo") = ""
-lstrip(is_alpha)("\ foo") = "\ foo"
-lstrip(is_alpha)("foo\ ") = "\ "
-lstrip(is_alpha)("\ foo\ ") = "\ foo\ "
-lstrip(is_alpha)("foo") = ""
-lstrip(is_alpha)("\tfoo") = "\tfoo"
-lstrip(is_alpha)("foo\t") = "\t"
-lstrip(is_alpha)("\tfoo\t") = "\tfoo\t"
-lstrip(is_alpha)("foo") = ""
-lstrip(is_alpha)("\nfoo") = "\nfoo"
-lstrip(is_alpha)("foo\n") = "\n"
-lstrip(is_alpha)("\nfoo\n") = "\nfoo\n"
-lstrip(is_alpha)("foo") = ""
-lstrip(is_alpha)("\ \ foo") = "\ \ foo"
-lstrip(is_alpha)("foo\ \ ") = "\ \ "
-lstrip(is_alpha)("\ \ foo\ \ ") = "\ \ foo\ \ "
-lstrip(is_alpha)("foo") = ""
-lstrip(is_alpha)("\ \tfoo") = "\ \tfoo"
-lstrip(is_alpha)("foo\ \t") = "\ \t"
-lstrip(is_alpha)("\ \tfoo\ \t") = "\ \tfoo\ \t"
-lstrip(is_alpha)("foo") = ""
-lstrip(is_alpha)("\ \nfoo") = "\ \nfoo"
-lstrip(is_alpha)("foo\ \n") = "\ \n"
-lstrip(is_alpha)("\ \nfoo\ \n") = "\ \nfoo\ \n"
-lstrip(is_alpha)("foo") = ""
-lstrip(is_alpha)("\t\ foo") = "\t\ foo"
-lstrip(is_alpha)("foo\t\ ") = "\t\ "
-lstrip(is_alpha)("\t\ foo\t\ ") = "\t\ foo\t\ "
-lstrip(is_alpha)("foo") = ""
-lstrip(is_alpha)("\t\tfoo") = "\t\tfoo"
-lstrip(is_alpha)("foo\t\t") = "\t\t"
-lstrip(is_alpha)("\t\tfoo\t\t") = "\t\tfoo\t\t"
-lstrip(is_alpha)("foo") = ""
-lstrip(is_alpha)("\t\nfoo") = "\t\nfoo"
-lstrip(is_alpha)("foo\t\n") = "\t\n"
-lstrip(is_alpha)("\t\nfoo\t\n") = "\t\nfoo\t\n"
-lstrip(is_alpha)("foo") = ""
-lstrip(is_alpha)("\n\ foo") = "\n\ foo"
-lstrip(is_alpha)("foo\n\ ") = "\n\ "
-lstrip(is_alpha)("\n\ foo\n\ ") = "\n\ foo\n\ "
-lstrip(is_alpha)("foo") = ""
-lstrip(is_alpha)("\n\tfoo") = "\n\tfoo"
-lstrip(is_alpha)("foo\n\t") = "\n\t"
-lstrip(is_alpha)("\n\tfoo\n\t") = "\n\tfoo\n\t"
-lstrip(is_alpha)("foo") = ""
-lstrip(is_alpha)("\n\nfoo") = "\n\nfoo"
-lstrip(is_alpha)("foo\n\n") = "\n\n"
-lstrip(is_alpha)("\n\nfoo\n\n") = "\n\nfoo\n\n"
-rstrip(is_alpha)("foo") = ""
-rstrip(is_alpha)("\ foo") = "\ "
-rstrip(is_alpha)("foo\ ") = "foo\ "
-rstrip(is_alpha)("\ foo\ ") = "\ foo\ "
-rstrip(is_alpha)("foo") = ""
-rstrip(is_alpha)("\tfoo") = "\t"
-rstrip(is_alpha)("foo\t") = "foo\t"
-rstrip(is_alpha)("\tfoo\t") = "\tfoo\t"
-rstrip(is_alpha)("foo") = ""
-rstrip(is_alpha)("\nfoo") = "\n"
-rstrip(is_alpha)("foo\n") = "foo\n"
-rstrip(is_alpha)("\nfoo\n") = "\nfoo\n"
-rstrip(is_alpha)("foo") = ""
-rstrip(is_alpha)("\ \ foo") = "\ \ "
-rstrip(is_alpha)("foo\ \ ") = "foo\ \ "
-rstrip(is_alpha)("\ \ foo\ \ ") = "\ \ foo\ \ "
-rstrip(is_alpha)("foo") = ""
-rstrip(is_alpha)("\ \tfoo") = "\ \t"
-rstrip(is_alpha)("foo\ \t") = "foo\ \t"
-rstrip(is_alpha)("\ \tfoo\ \t") = "\ \tfoo\ \t"
-rstrip(is_alpha)("foo") = ""
-rstrip(is_alpha)("\ \nfoo") = "\ \n"
-rstrip(is_alpha)("foo\ \n") = "foo\ \n"
-rstrip(is_alpha)("\ \nfoo\ \n") = "\ \nfoo\ \n"
-rstrip(is_alpha)("foo") = ""
-rstrip(is_alpha)("\t\ foo") = "\t\ "
-rstrip(is_alpha)("foo\t\ ") = "foo\t\ "
-rstrip(is_alpha)("\t\ foo\t\ ") = "\t\ foo\t\ "
-rstrip(is_alpha)("foo") = ""
-rstrip(is_alpha)("\t\tfoo") = "\t\t"
-rstrip(is_alpha)("foo\t\t") = "foo\t\t"
-rstrip(is_alpha)("\t\tfoo\t\t") = "\t\tfoo\t\t"
-rstrip(is_alpha)("foo") = ""
-rstrip(is_alpha)("\t\nfoo") = "\t\n"
-rstrip(is_alpha)("foo\t\n") = "foo\t\n"
-rstrip(is_alpha)("\t\nfoo\t\n") = "\t\nfoo\t\n"
-rstrip(is_alpha)("foo") = ""
-rstrip(is_alpha)("\n\ foo") = "\n\ "
-rstrip(is_alpha)("foo\n\ ") = "foo\n\ "
-rstrip(is_alpha)("\n\ foo\n\ ") = "\n\ foo\n\ "
-rstrip(is_alpha)("foo") = ""
-rstrip(is_alpha)("\n\tfoo") = "\n\t"
-rstrip(is_alpha)("foo\n\t") = "foo\n\t"
-rstrip(is_alpha)("\n\tfoo\n\t") = "\n\tfoo\n\t"
-rstrip(is_alpha)("foo") = ""
-rstrip(is_alpha)("\n\nfoo") = "\n\n"
-rstrip(is_alpha)("foo\n\n") = "foo\n\n"
-rstrip(is_alpha)("\n\nfoo\n\n") = "\n\nfoo\n\n"
+lstrip_pred(is_alpha)("foo") = ""
+lstrip_pred(is_alpha)("\ foo") = "\ foo"
+lstrip_pred(is_alpha)("foo\ ") = "\ "
+lstrip_pred(is_alpha)("\ foo\ ") = "\ foo\ "
+lstrip_pred(is_alpha)("foo") = ""
+lstrip_pred(is_alpha)("\tfoo") = "\tfoo"
+lstrip_pred(is_alpha)("foo\t") = "\t"
+lstrip_pred(is_alpha)("\tfoo\t") = "\tfoo\t"
+lstrip_pred(is_alpha)("foo") = ""
+lstrip_pred(is_alpha)("\nfoo") = "\nfoo"
+lstrip_pred(is_alpha)("foo\n") = "\n"
+lstrip_pred(is_alpha)("\nfoo\n") = "\nfoo\n"
+lstrip_pred(is_alpha)("foo") = ""
+lstrip_pred(is_alpha)("\ \ foo") = "\ \ foo"
+lstrip_pred(is_alpha)("foo\ \ ") = "\ \ "
+lstrip_pred(is_alpha)("\ \ foo\ \ ") = "\ \ foo\ \ "
+lstrip_pred(is_alpha)("foo") = ""
+lstrip_pred(is_alpha)("\ \tfoo") = "\ \tfoo"
+lstrip_pred(is_alpha)("foo\ \t") = "\ \t"
+lstrip_pred(is_alpha)("\ \tfoo\ \t") = "\ \tfoo\ \t"
+lstrip_pred(is_alpha)("foo") = ""
+lstrip_pred(is_alpha)("\ \nfoo") = "\ \nfoo"
+lstrip_pred(is_alpha)("foo\ \n") = "\ \n"
+lstrip_pred(is_alpha)("\ \nfoo\ \n") = "\ \nfoo\ \n"
+lstrip_pred(is_alpha)("foo") = ""
+lstrip_pred(is_alpha)("\t\ foo") = "\t\ foo"
+lstrip_pred(is_alpha)("foo\t\ ") = "\t\ "
+lstrip_pred(is_alpha)("\t\ foo\t\ ") = "\t\ foo\t\ "
+lstrip_pred(is_alpha)("foo") = ""
+lstrip_pred(is_alpha)("\t\tfoo") = "\t\tfoo"
+lstrip_pred(is_alpha)("foo\t\t") = "\t\t"
+lstrip_pred(is_alpha)("\t\tfoo\t\t") = "\t\tfoo\t\t"
+lstrip_pred(is_alpha)("foo") = ""
+lstrip_pred(is_alpha)("\t\nfoo") = "\t\nfoo"
+lstrip_pred(is_alpha)("foo\t\n") = "\t\n"
+lstrip_pred(is_alpha)("\t\nfoo\t\n") = "\t\nfoo\t\n"
+lstrip_pred(is_alpha)("foo") = ""
+lstrip_pred(is_alpha)("\n\ foo") = "\n\ foo"
+lstrip_pred(is_alpha)("foo\n\ ") = "\n\ "
+lstrip_pred(is_alpha)("\n\ foo\n\ ") = "\n\ foo\n\ "
+lstrip_pred(is_alpha)("foo") = ""
+lstrip_pred(is_alpha)("\n\tfoo") = "\n\tfoo"
+lstrip_pred(is_alpha)("foo\n\t") = "\n\t"
+lstrip_pred(is_alpha)("\n\tfoo\n\t") = "\n\tfoo\n\t"
+lstrip_pred(is_alpha)("foo") = ""
+lstrip_pred(is_alpha)("\n\nfoo") = "\n\nfoo"
+lstrip_pred(is_alpha)("foo\n\n") = "\n\n"
+lstrip_pred(is_alpha)("\n\nfoo\n\n") = "\n\nfoo\n\n"
+rstrip_pred(is_alpha)("foo") = ""
+rstrip_pred(is_alpha)("\ foo") = "\ "
+rstrip_pred(is_alpha)("foo\ ") = "foo\ "
+rstrip_pred(is_alpha)("\ foo\ ") = "\ foo\ "
+rstrip_pred(is_alpha)("foo") = ""
+rstrip_pred(is_alpha)("\tfoo") = "\t"
+rstrip_pred(is_alpha)("foo\t") = "foo\t"
+rstrip_pred(is_alpha)("\tfoo\t") = "\tfoo\t"
+rstrip_pred(is_alpha)("foo") = ""
+rstrip_pred(is_alpha)("\nfoo") = "\n"
+rstrip_pred(is_alpha)("foo\n") = "foo\n"
+rstrip_pred(is_alpha)("\nfoo\n") = "\nfoo\n"
+rstrip_pred(is_alpha)("foo") = ""
+rstrip_pred(is_alpha)("\ \ foo") = "\ \ "
+rstrip_pred(is_alpha)("foo\ \ ") = "foo\ \ "
+rstrip_pred(is_alpha)("\ \ foo\ \ ") = "\ \ foo\ \ "
+rstrip_pred(is_alpha)("foo") = ""
+rstrip_pred(is_alpha)("\ \tfoo") = "\ \t"
+rstrip_pred(is_alpha)("foo\ \t") = "foo\ \t"
+rstrip_pred(is_alpha)("\ \tfoo\ \t") = "\ \tfoo\ \t"
+rstrip_pred(is_alpha)("foo") = ""
+rstrip_pred(is_alpha)("\ \nfoo") = "\ \n"
+rstrip_pred(is_alpha)("foo\ \n") = "foo\ \n"
+rstrip_pred(is_alpha)("\ \nfoo\ \n") = "\ \nfoo\ \n"
+rstrip_pred(is_alpha)("foo") = ""
+rstrip_pred(is_alpha)("\t\ foo") = "\t\ "
+rstrip_pred(is_alpha)("foo\t\ ") = "foo\t\ "
+rstrip_pred(is_alpha)("\t\ foo\t\ ") = "\t\ foo\t\ "
+rstrip_pred(is_alpha)("foo") = ""
+rstrip_pred(is_alpha)("\t\tfoo") = "\t\t"
+rstrip_pred(is_alpha)("foo\t\t") = "foo\t\t"
+rstrip_pred(is_alpha)("\t\tfoo\t\t") = "\t\tfoo\t\t"
+rstrip_pred(is_alpha)("foo") = ""
+rstrip_pred(is_alpha)("\t\nfoo") = "\t\n"
+rstrip_pred(is_alpha)("foo\t\n") = "foo\t\n"
+rstrip_pred(is_alpha)("\t\nfoo\t\n") = "\t\nfoo\t\n"
+rstrip_pred(is_alpha)("foo") = ""
+rstrip_pred(is_alpha)("\n\ foo") = "\n\ "
+rstrip_pred(is_alpha)("foo\n\ ") = "foo\n\ "
+rstrip_pred(is_alpha)("\n\ foo\n\ ") = "\n\ foo\n\ "
+rstrip_pred(is_alpha)("foo") = ""
+rstrip_pred(is_alpha)("\n\tfoo") = "\n\t"
+rstrip_pred(is_alpha)("foo\n\t") = "foo\n\t"
+rstrip_pred(is_alpha)("\n\tfoo\n\t") = "\n\tfoo\n\t"
+rstrip_pred(is_alpha)("foo") = ""
+rstrip_pred(is_alpha)("\n\nfoo") = "\n\n"
+rstrip_pred(is_alpha)("foo\n\n") = "foo\n\n"
+rstrip_pred(is_alpha)("\n\nfoo\n\n") = "\n\nfoo\n\n"
prefix_length(is_whitespace)("foo") = "0"
prefix_length(is_whitespace)("\ foo") = "1"
prefix_length(is_whitespace)("foo\ ") = "0"
diff --git a/tests/hard_coded/trace_goal_4.m b/tests/hard_coded/trace_goal_4.m
index 32f395a..106c774 100644
--- a/tests/hard_coded/trace_goal_4.m
+++ b/tests/hard_coded/trace_goal_4.m
@@ -29,6 +29,13 @@ main(!IO) :-
printf(""Progress reported %d\\n"", X);
").
+:- pragma foreign_proc("C#",
+ progress_report(X::in),
+ [will_not_call_mercury, thread_safe, tabled_for_io],
+"
+ System.Console.WriteLine(""Progress reported "" + X);
+").
+
:- pragma foreign_proc("Java",
progress_report(X::in),
[will_not_call_mercury, thread_safe, tabled_for_io],
diff --git a/tests/hard_coded/uc_export_enum.m b/tests/hard_coded/uc_export_enum.m
index b2391a7..06c397f 100644
--- a/tests/hard_coded/uc_export_enum.m
+++ b/tests/hard_coded/uc_export_enum.m
@@ -39,6 +39,12 @@ main(!IO) :-
"
X = UC_foo_FOO;
").
+:- pragma foreign_proc("C#",
+ test_uc(X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = UC_foo_FOO;
+").
:- pragma foreign_proc("Java",
test_uc(X::out),
[will_not_call_mercury, promise_pure],
@@ -53,6 +59,12 @@ main(!IO) :-
"
X = LC_foo_foo;
").
+:- pragma foreign_proc("C#",
+ test_lc(X::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = LC_foo_foo;
+").
:- pragma foreign_proc("Java",
test_lc(X::out),
[will_not_call_mercury, promise_pure],
@@ -69,6 +81,14 @@ main(!IO) :-
Y = OR_foo_mixed1234_bAr;
Z = OR_foo_BAZ;
").
+:- pragma foreign_proc("C#",
+ test_or(X::out, Y::out, Z::out),
+ [will_not_call_mercury, promise_pure],
+"
+ X = OR_foo_lowercase_foo;
+ Y = OR_foo_mixed1234_bAr;
+ Z = OR_foo_BAZ;
+").
:- pragma foreign_proc("Java",
test_or(X::out, Y::out, Z::out),
[will_not_call_mercury, promise_pure],
@@ -88,11 +108,13 @@ main(!IO) :-
% Check that uppercase applies only the constructors and not to the prefix.
%
:- pragma foreign_export_enum("C", foo/0, [prefix("UC_foo_"), uppercase]).
+:- pragma foreign_export_enum("C#", foo/0, [prefix("UC_foo_"), uppercase]).
:- pragma foreign_export_enum("Java", foo/0, [prefix("UC_foo_"), uppercase]).
% Check that uppercase applies only when the uppercase attribute is specified.
%
:- pragma foreign_export_enum("C", foo/0, [prefix("LC_foo_")]).
+:- pragma foreign_export_enum("C#", foo/0, [prefix("LC_foo_")]).
:- pragma foreign_export_enum("Java", foo/0, [prefix("LC_foo_")]).
% Check that the uppercase attribute does not apply to user supplied foreign
@@ -102,6 +124,10 @@ main(!IO) :-
foo - "lowercase_foo",
bar - "mixed1234_bAr"
]).
+:- pragma foreign_export_enum("C#", foo/0, [prefix("OR_foo_"), uppercase], [
+ foo - "lowercase_foo",
+ bar - "mixed1234_bAr"
+]).
:- pragma foreign_export_enum("Java", foo/0, [prefix("OR_foo_"), uppercase], [
foo - "lowercase_foo",
bar - "mixed1234_bAr"
diff --git a/tests/hard_coded/user_compare.m b/tests/hard_coded/user_compare.m
index 5bade26..87a08a9 100644
--- a/tests/hard_coded/user_compare.m
+++ b/tests/hard_coded/user_compare.m
@@ -55,6 +55,8 @@ compare_foo(Res, Foo1, Foo2) :-
equality is foreign_equals, comparison is foreign_compare.
:- pragma foreign_type(il, foreign, "int32") where
equality is foreign_equals, comparison is foreign_compare.
+:- pragma foreign_type("C#", foreign, "int") where
+ equality is foreign_equals, comparison is foreign_compare.
:- pragma foreign_type("Java", foreign, "Integer") where
equality is foreign_equals, comparison is foreign_compare.
:- pragma foreign_type(erlang, foreign, "") where
diff --git a/tests/hard_coded/write_xml.m b/tests/hard_coded/write_xml.m
index b2e5cba..0d90c7a 100644
--- a/tests/hard_coded/write_xml.m
+++ b/tests/hard_coded/write_xml.m
@@ -44,6 +44,7 @@
:- pred make_ftype(ftype::out) is det.
:- pragma foreign_type("C", ftype, "int").
+:- pragma foreign_type("C#", ftype, "object").
:- pragma foreign_type("Java", ftype, "Integer").
:- pragma foreign_type("Erlang", ftype, "").
@@ -53,6 +54,12 @@
F = 1;
").
+:- pragma foreign_proc("C#", make_ftype(F::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ F = 1;
+").
+
:- pragma foreign_proc("Java", make_ftype(F::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
@@ -73,6 +80,12 @@
P = (MR_Word) NULL;
").
+:- pragma foreign_proc("C#", make_pointer(P::out),
+ [will_not_call_mercury, thread_safe, promise_pure],
+"
+ P = null;
+").
+
:- pragma foreign_proc("Java", make_pointer(P::out),
[will_not_call_mercury, thread_safe, promise_pure],
"
--------------------------------------------------------------------------
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