[m-rev.] for review: merge foreign_type pragma on to the main branch
Peter Ross
peter.ross at miscrit.be
Wed Oct 24 21:14:17 AEST 2001
Ok, here is the interdiff.
--- zzlog.foreign_type Wed Oct 24 12:14:14 2001
+++ zzlog.foreign_type3 Wed Oct 24 13:05:43 2001
@@ -1,16 +1,16 @@
-
-Estimated hours taken: 8
+Estimated hours taken: 10
Branches: main
Merge the foreign_type pragma changes from the dotnet branch to the main
-branch.
+branch, plus do some more development work to generalise the change.
compiler/prog_data.m:
Add a type to hold the data from parsing a pragma foreign_type decl.
compiler/prog_io_pragma.m:
- Parse the pragma foreign_type.
+ Parse the pragma foreign_type. This code is currently commented
+ out, while we decide on the syntax.
compiler/hlds_data.m:
Add a new alternative to hlds_type_body where the body of the type
@@ -19,40 +19,48 @@
compiler/make_hlds.m:
Place the foreign_type pragmas into the HLDS.
+compiler/foreign.m:
+ Implement to_type_string which replaces export__type_to_type_string,
+ unlike export__type_to_type_string foreign__to_type_string takes an
+ argument specifying which language the representation is meant to be
+ in. to_type_string also needs to take a module_info to handle
+ foreign_types correctly. To avoid the need for the module_info to
+ be passed around the MLDS backend we provide a new type
+ exported_type which provides enough information for an alternate
+ version of to_type_string to be called.
+
compiler/export.m:
- Change export__type_to_type_string so that we return the
- foreign type representation if it exists.
+ Delete export__type_to_type_string.
compiler/llds.m:
- Since export__type_to_type_string needs a module_info, we add a new
+ Since foreign__to_type_string needs a module_info, we add a new
field to pragma_c_arg_decl which is the result of calling
- export__type_to_type_string. This avoids threading the module_info
+ foreign__to_type_string. This avoids threading the module_info
around various llds passes.
compiler/mlds.m:
- Table the result of export__type_to_type_string so as to avoid
+ Record with in the mercury_type the exported_type, this avoids
passing the module_info around the MLDS backend.
Also add the foreign_type alternative to mlds__type.
- Update mercury_type_to_mlds_type so that handles types which are
+ Update mercury_type_to_mlds_type so that it handles types which are
foreign types.
compiler/mlds_to_il.m:
- Convert a mlds__foreign_type into an ilds__type. Note that the
- basic types aren't allowed to appear in the assembler in their
- System.* form so we detect all these cases and convert to the basic
- type instead.
+ Convert a mlds__foreign_type into an ilds__type.
compiler/ilds.m:
The CLR spec requires that System.Object and System.String be
- treated specially in the IL assembly (you have to use the name
- object and string instead of the System.* names), so add them as
- base types.
+ treated specially in the IL assembly so add them as simple types.
compiler/ilasm.m:
- Changes to handle the additions to the simple ilds types.
+ Before outputting a class name into the IL assembly check whether it
+ it can be simplified to a builtin type, and if so output that name
+ instead as required by the ECMA spec.
+ Changes for the addition of string and object as simple types.
doc/reference_manual.texi:
- Document the new pragma.
+ Document the new pragma, this is currently commented out because it
+ refers to syntax that has not yet been finalised.
compiler/fact_table.m:
compiler/llds_out.m:
@@ -68,7 +76,7 @@
compiler/mlds_to_mcpp.m:
compiler/pragma_c_gen.m:
compiler/rtti_to_mlds.m:
- Changes to handle the tabling of calls to export__type_to_string.
+ Changes to handle using foreign__to_type_string.
compiler/hlds_out.m:
compiler/intermod.m:
@@ -79,7 +87,7 @@
compiler/term_util.m:
compiler/type_ctor_info.m:
compiler/unify_proc.m:
- Changes to hanlde the new hlds_type_body.
+ Changes to handle the new hlds_type_body.
compiler/mercury_to_mercury.m:
Output the pragma foreign_type declaration.
@@ -89,5 +97,3 @@
compiler/modules.m:
Pragma foreign_type is allowed in the interface.
-
-
diff -u compiler/export.m compiler/export.m
--- compiler/export.m
+++ compiler/export.m
@@ -48,11 +48,6 @@
% Utilities for generating C code which interfaces with Mercury.
% The {MLDS,LLDS}->C backends and fact tables use this code.
- % Convert the type to a string corresponding to its C type.
- % (Defaults to MR_Word).
-:- pred export__type_to_type_string(module_info, type, string).
-:- mode export__type_to_type_string(in, in, out) is det.
-
% Generate C code to convert an rval (represented as a string), from
% a C type to a mercury C type (ie. convert strings and floats to
% words) and return the resulting C code as a string.
@@ -70,8 +65,9 @@
:- implementation.
+:- import_module foreign.
:- import_module modules.
-:- import_module hlds_data, hlds_pred, type_util.
+:- import_module hlds_pred, type_util.
:- import_module code_model.
:- import_module code_gen, code_util, llds_out.
:- import_module globals, options.
@@ -336,7 +332,7 @@
RetArgMode = top_out,
\+ type_util__is_dummy_argument_type(RetType)
->
- export__type_to_type_string(Module, RetType, C_RetType),
+ C_RetType = to_type_string(c, Module, RetType),
argloc_to_string(RetArgLoc, RetArgString0),
convert_type_from_mercury(RetArgString0, RetType,
RetArgString),
@@ -436,7 +432,7 @@
;
ArgName = ""
),
- export__type_to_type_string(Module, Type, TypeString0),
+ TypeString0 = to_type_string(c, Module, Type),
(
Mode = top_out
->
@@ -629,42 +625,5 @@
{ error("export__produce_header_file_2: foreign languages other than C unimplemented") }
),
export__produce_header_file_2(ExportedProcs).
-
- % Convert a term representation of a variable type to a string which
- % represents the C type of the variable
- % Apart from special cases, local variables become MR_Words
-export__type_to_type_string(ModuleInfo, Type, Result) :-
- ( Type = term__functor(term__atom("int"), [], _) ->
- Result = "MR_Integer"
- ; Type = term__functor(term__atom("float"), [], _) ->
- Result = "MR_Float"
- ; Type = term__functor(term__atom("string"), [], _) ->
- Result = "MR_String"
- ; Type = term__functor(term__atom("character"), [], _) ->
- Result = "MR_Char"
- ;
- module_info_types(ModuleInfo, Types),
- (
- type_to_type_id(Type, TypeId, _),
- map__search(Types, TypeId, TypeDefn)
- ->
- % XXX how we output the type depends on
- % which foreign language we are using.
- hlds_data__get_type_defn_body(TypeDefn, Body),
- ( Body = foreign_type(ForeignType, _) ->
- Result = sym_name_to_string(ForeignType) ++ " *"
- ;
- Result = "MR_Word"
- )
- ;
- Result = "MR_Word"
- )
- ).
-
-:- func sym_name_to_string(sym_name) = string.
-
-sym_name_to_string(unqualified(Name)) = Name.
-sym_name_to_string(qualified(ModuleSpec, Name))
- = sym_name_to_string(ModuleSpec) ++ ("::" ++ Name).
%-----------------------------------------------------------------------------%
diff -u compiler/fact_table.m compiler/fact_table.m
--- compiler/fact_table.m
+++ compiler/fact_table.m
@@ -96,7 +96,7 @@
% HLDS modules
:- import_module hlds_out, hlds_data, mode_util, inst_match.
% LLDS back-end modules
-:- import_module arg_info, llds, llds_out, code_util, export.
+:- import_module arg_info, llds, llds_out, code_util, export, foreign.
% Modules shared between different back-ends.
:- import_module passes_aux, code_model.
% Misc
@@ -3251,7 +3251,7 @@
string::out) is det.
generate_arg_decl_code(Name, Type, Module, DeclCode) :-
- export__type_to_type_string(Module, Type, C_Type),
+ C_Type = to_type_string(c, Module, Type),
string__format("\t\t%s %s;\n", [s(C_Type), s(Name)], DeclCode).
:- pred generate_arg_input_code(string::in, (type)::in, int::in, int::in,
diff -u compiler/hlds_data.m compiler/hlds_data.m
--- compiler/hlds_data.m
+++ compiler/hlds_data.m
@@ -294,8 +294,9 @@
; foreign_type(
sym_name, % structured name of foreign type
% which represents the mercury type.
- string % String which represents where I can
- % find a definition for this type.
+ string % Location of the definition for this
+ % type (such as assembly or
+ % library name)
)
; abstract_type.
diff -u compiler/ilasm.m compiler/ilasm.m
--- compiler/ilasm.m
+++ compiler/ilasm.m
@@ -701,8 +701,57 @@
output_simple_type(string, I, I) --> io__write_string("string").
output_simple_type(refany, I, I) --> io__write_string("refany").
output_simple_type(class(Name), Info0, Info) -->
- io__write_string("class "),
- output_structured_name(Name, Info0, Info).
+ { Name = structured_name(AssemblyName, QualifiedName, _) },
+ % Parition II section 'Built-in Types' (7.2 in Beta2) states
+ % that all builtin types *must* be rereferenced by their
+ % special encoding. See Parition I 'Built-In Types'
+ % (8.2.2 in Beta2) for the list of all builtin types.
+ (
+ { AssemblyName = assembly("mscorlib") },
+ { QualifiedName = ["System", TypeName] }
+ ->
+ ( { TypeName = "Boolean" } ->
+ output_simple_type(bool, Info0, Info)
+ ; { TypeName = "Char" } ->
+ output_simple_type(char, Info0, Info)
+ ; { TypeName = "Object" } ->
+ output_simple_type(object, Info0, Info)
+ ; { TypeName = "String" } ->
+ output_simple_type(string, Info0, Info)
+ ; { TypeName = "Single" } ->
+ output_simple_type(float32, Info0, Info)
+ ; { TypeName = "Double" } ->
+ output_simple_type(float64, Info0, Info)
+ ; { TypeName = "SByte" } ->
+ output_simple_type(int8, Info0, Info)
+ ; { TypeName = "Int16" } ->
+ output_simple_type(int16, Info0, Info)
+ ; { TypeName = "Int32" } ->
+ output_simple_type(int32, Info0, Info)
+ ; { TypeName = "Int64" } ->
+ output_simple_type(int64, Info0, Info)
+ ; { TypeName = "IntPtr" } ->
+ output_simple_type(native_int, Info0, Info)
+ ; { TypeName = "UIntPtr" } ->
+ output_simple_type(native_uint, Info0, Info)
+ ; { TypeName = "TypedReference" } ->
+ output_simple_type(refany, Info0, Info)
+ ; { TypeName = "Byte" } ->
+ output_simple_type(uint8, Info0, Info)
+ ; { TypeName = "UInt16" } ->
+ output_simple_type(uint16, Info0, Info)
+ ; { TypeName = "UInt32" } ->
+ output_simple_type(uint32, Info0, Info)
+ ; { TypeName = "UInt64" } ->
+ output_simple_type(uint64, Info0, Info)
+ ;
+ io__write_string("class "),
+ output_structured_name(Name, Info0, Info)
+ )
+ ;
+ io__write_string("class "),
+ output_structured_name(Name, Info0, Info)
+ ).
output_simple_type(value_class(Name), Info0, Info) -->
io__write_string("valuetype "),
output_structured_name(Name, Info0, Info).
diff -u compiler/intermod.m compiler/intermod.m
--- compiler/intermod.m
+++ compiler/intermod.m
@@ -1177,7 +1177,13 @@
{ TypeBody = abstract_type }
;
{ Body = foreign_type(_, _) },
- { error("foreign types not implemented") }
+ { TypeBody = abstract_type },
+ % XXX trd
+ % Also here we need to output the pragma
+ % for the type body, we output a abstract type for
+ % the type definition which is fine.
+ { error("foreign_type not yet implemented") }
+
),
mercury_output_item(type_defn(VarSet, Name, Args, TypeBody, true),
Context).
diff -u compiler/ml_code_gen.m compiler/ml_code_gen.m
--- compiler/ml_code_gen.m
+++ compiler/ml_code_gen.m
@@ -2773,8 +2773,7 @@
MaybeNameAndMode = yes(ArgName - _Mode),
\+ var_is_singleton(ArgName)
->
- TypeString = foreign_type_to_type_string(ModuleInfo,
- Lang, Type),
+ TypeString = to_type_string(Lang, ModuleInfo, Type),
string__format("\t%s %s;\n", [s(TypeString), s(ArgName)],
DeclString)
;
@@ -2784,18 +2783,6 @@
},
{ Decl = raw_target_code(DeclString, []) }.
-:- func foreign_type_to_type_string(module_info,
- foreign_language, prog_data__type) = string.
-foreign_type_to_type_string(ModuleInfo, Lang, Type) = TypeString :-
- (
- type_util__var(Type, _),
- Lang = managed_cplusplus
- ->
- TypeString = "MR_Box"
- ;
- export__type_to_type_string(ModuleInfo, Type, TypeString)
- ).
-
%-----------------------------------------------------------------------------%
% var_is_singleton determines whether or not a given pragma_c variable
@@ -2863,8 +2850,7 @@
% --high-level-data, so we always use a cast here.
% (Strictly speaking the cast is not needed for
% a few cases like `int', but it doesn't do any harm.)
- TypeString = foreign_type_to_type_string(ModuleInfo,
- Lang, OrigType),
+ TypeString = to_type_string(Lang, ModuleInfo, OrigType),
string__format("(%s)", [s(TypeString)], Cast)
;
% For --no-high-level-data, we only need to use
@@ -2950,8 +2936,7 @@
% Note that we can't easily obtain the type string
% for the RHS of the assignment, so instead we
% cast the LHS.
- TypeString = foreign_type_to_type_string(ModuleInfo,
- Lang, OrigType),
+ TypeString = to_type_string(Lang, ModuleInfo, OrigType),
string__format("*(%s *)&", [s(TypeString)], LHS_Cast),
RHS_Cast = ""
;
diff -u compiler/ml_code_util.m compiler/ml_code_util.m
--- compiler/ml_code_util.m
+++ compiler/ml_code_util.m
@@ -699,6 +699,7 @@
:- implementation.
:- import_module ml_call_gen.
+:- import_module foreign.
:- import_module prog_util, type_util, mode_util, special_pred, error_util.
:- import_module code_util. % XXX for `code_util__compiler_generated'.
:- import_module globals, options.
@@ -956,7 +957,8 @@
ml_gen_array_elem_type(elem_type_int) = mlds__native_int_type.
ml_gen_array_elem_type(elem_type_generic) = mlds__generic_type.
-ml_string_type = mercury_type(string_type, str_type, "MR_String").
+ml_string_type = mercury_type(string_type, str_type,
+ non_foreign_type(string_type)).
%-----------------------------------------------------------------------------%
%
diff -u compiler/ml_switch_gen.m compiler/ml_switch_gen.m
--- compiler/ml_switch_gen.m
+++ compiler/ml_switch_gen.m
@@ -99,7 +99,7 @@
:- import_module ml_tag_switch, ml_string_switch.
:- import_module ml_code_gen, ml_unify_gen, ml_code_util, ml_simplify_switch.
:- import_module switch_util, type_util.
-:- import_module export, options.
+:- import_module foreign, options.
:- import_module bool, int, string, map, tree, std_util, require.
@@ -396,8 +396,8 @@
=(MLGenInfo),
{
ml_gen_info_get_module_info(MLGenInfo, ModuleInfo),
- export__type_to_type_string(ModuleInfo, Type, TypeString),
- MLDS_Type = mercury_type(Type, TypeCategory, TypeString),
+ ExportedType = to_exported_type(ModuleInfo, Type),
+ MLDS_Type = mercury_type(Type, TypeCategory, ExportedType),
switch_util__type_range(TypeCategory, Type, ModuleInfo,
MinRange, MaxRange)
->
diff -u compiler/mlds.m compiler/mlds.m
--- compiler/mlds.m
+++ compiler/mlds.m
@@ -280,7 +280,7 @@
:- import_module hlds_module, hlds_pred, hlds_data.
:- import_module prog_data, builtin_ops, rtti, code_model.
-:- import_module type_util.
+:- import_module foreign, type_util.
% To avoid duplication, we use a few things from the LLDS
% (specifically stuff for the C interface).
@@ -537,8 +537,11 @@
prog_data__type, % the exact Mercury type
builtin_type, % what kind of type it is:
% enum, float, etc.
- string % the result of
- % export__type_to_type_string
+ exported_type % a representation of the type
+ % which can be used to
+ % determine the foreign
+ % language representation of
+ % the type.
)
% The Mercury array type is treated specially, some backends
@@ -1508,7 +1511,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module export, modules.
+:- import_module foreign, modules.
:- import_module int, term, string, require.
%-----------------------------------------------------------------------------%
@@ -1551,8 +1554,8 @@
MLDSType = mlds__foreign_type(ForeignType, ForeignLocation)
;
classify_type(Type, ModuleInfo, Category),
- export__type_to_type_string(ModuleInfo, Type, TypeString),
- MLDSType = mercury_type(Type, Category, TypeString)
+ ExportedType = to_exported_type(ModuleInfo, Type),
+ MLDSType = mercury_type(Type, Category, ExportedType)
).
%-----------------------------------------------------------------------------%
diff -u compiler/mlds_to_c.m compiler/mlds_to_c.m
--- compiler/mlds_to_c.m
+++ compiler/mlds_to_c.m
@@ -60,7 +60,7 @@
:- import_module ml_code_util. % for ml_gen_public_field_decl_flags, which is
% used by the code that handles derived classes
:- import_module ml_type_gen. % for ml_gen_type_name
-:- import_module export. % for export__type_to_type_string
+:- import_module foreign.
:- import_module globals, options, passes_aux.
:- import_module builtin_ops, c_util, modules.
:- import_module prog_data, prog_out, type_util, error_util, code_model.
@@ -622,8 +622,8 @@
% Array types are exported as MR_Word
mlds_output_pragma_export_type(prefix, mercury_array_type(_ElemType)) -->
io__write_string("MR_Word").
-mlds_output_pragma_export_type(prefix, mercury_type(_, _, TypeString)) -->
- io__write_string(TypeString).
+mlds_output_pragma_export_type(prefix, mercury_type(_, _, ExportedType)) -->
+ io__write_string(to_type_string(c, ExportedType)).
mlds_output_pragma_export_type(prefix, mlds__cont_type(_)) -->
io__write_string("MR_Word").
mlds_output_pragma_export_type(prefix, mlds__commit_type) -->
diff -u compiler/mlds_to_il.m compiler/mlds_to_il.m
--- compiler/mlds_to_il.m
+++ compiler/mlds_to_il.m
@@ -143,6 +143,7 @@
:- import_module ilasm, il_peephole.
:- import_module ml_util, ml_code_util, error_util.
:- import_module ml_type_gen.
+:- import_module foreign.
:- use_module llds. /* for user_foreign_code */
:- import_module bool, int, map, string, set, list, assoc_list, term.
@@ -1017,7 +1018,7 @@
{ UnivMercuryType = term__functor(term__atom("univ"), [],
context("", 0)) },
{ UnivMLDSType = mercury_type(UnivMercuryType,
- user_type, "XXX") },
+ user_type, non_foreign_type(UnivMercuryType)) },
{ UnivType = mlds_type_to_ilds_type(DataRep, UnivMLDSType) },
{ RenameNode = (func(N) = list__map(RenameRets, N)) },
@@ -2903,45 +2904,9 @@
mlds_type_to_ilds_type(_, mlds__foreign_type(ForeignType, Assembly))
= ilds__type([], Class) :-
- ( ForeignType = qualified(unqualified("System"), "Boolean") ->
- Class = bool
- ; ForeignType = qualified(unqualified("System"), "Char") ->
- Class = char
- ; ForeignType = qualified(unqualified("System"), "Object") ->
- Class = object
- ; ForeignType = qualified(unqualified("System"), "String") ->
- Class = string
- ; ForeignType = qualified(unqualified("System"), "Single") ->
- Class = float32
- ; ForeignType = qualified(unqualified("System"), "Double") ->
- Class = float64
- ; ForeignType = qualified(unqualified("System"), "SByte") ->
- Class = int8
- ; ForeignType = qualified(unqualified("System"), "Int16") ->
- Class = int16
- ; ForeignType = qualified(unqualified("System"), "Int32") ->
- Class = int32
- ; ForeignType = qualified(unqualified("System"), "Int64") ->
- Class = int64
- ; ForeignType = qualified(unqualified("System"), "IntPtr") ->
- Class = native_int
- ; ForeignType = qualified(unqualified("System"), "UIntPtr") ->
- Class = native_uint
- ; ForeignType = qualified(unqualified("System"), "TypedReference") ->
- Class = refany
- ; ForeignType = qualified(unqualified("System"), "Byte") ->
- Class = uint8
- ; ForeignType = qualified(unqualified("System"), "UInt16") ->
- Class = uint16
- ; ForeignType = qualified(unqualified("System"), "UInt32") ->
- Class = uint32
- ; ForeignType = qualified(unqualified("System"), "UInt64") ->
- Class = uint64
- ;
- sym_name_to_class_name(ForeignType, ForeignClassName),
- Class = class(structured_name(assembly(Assembly),
- ForeignClassName, []))
- ).
+ sym_name_to_class_name(ForeignType, ForeignClassName),
+ Class = class(structured_name(assembly(Assembly),
+ ForeignClassName, [])).
mlds_type_to_ilds_type(ILDataRep, mlds__ptr_type(MLDSType)) =
ilds__type([], '&'(mlds_type_to_ilds_type(ILDataRep, MLDSType))).
@@ -3466,21 +3431,19 @@
rval_const_to_type(code_addr_const(_)) = mlds__func_type(
mlds__func_params([], [])).
rval_const_to_type(int_const(_))
- = mercury_type(term__functor(term__atom("int"), [], context("", 0)),
- int_type, "MR_Integer").
-rval_const_to_type(float_const(_))
- = mercury_type(term__functor(term__atom("float"), [], context("", 0)),
- float_type, "MR_Float").
+ = mercury_type(IntType, int_type, non_foreign_type(IntType)) :-
+ IntType = term__functor(term__atom("int"), [], context("", 0)).
+rval_const_to_type(float_const(_))
+ = mercury_type(FloatType, float_type, non_foreign_type(FloatType)) :-
+ FloatType = term__functor(term__atom("float"), [], context("", 0)).
rval_const_to_type(false) = mlds__native_bool_type.
rval_const_to_type(true) = mlds__native_bool_type.
-rval_const_to_type(string_const(_))
- = mercury_type(
- term__functor(term__atom("string"), [], context("", 0)),
- str_type, "MR_String").
-rval_const_to_type(multi_string_const(_, _))
- = mercury_type(term__functor(term__atom("string"), [], context("", 0)),
- % XXX Should this be MR_Word instead?
- str_type, "MR_String").
+rval_const_to_type(string_const(_))
+ = mercury_type(StrType, str_type, non_foreign_type(StrType)) :-
+ StrType = term__functor(term__atom("string"), [], context("", 0)).
+rval_const_to_type(multi_string_const(_, _))
+ = mercury_type(StrType, str_type, non_foreign_type(StrType)) :-
+ StrType = term__functor(term__atom("string"), [], context("", 0)).
rval_const_to_type(null(MldsType)) = MldsType.
%-----------------------------------------------------------------------------%
diff -u compiler/pragma_c_gen.m compiler/pragma_c_gen.m
--- compiler/pragma_c_gen.m
+++ compiler/pragma_c_gen.m
@@ -42,7 +42,7 @@
:- implementation.
:- import_module hlds_module, hlds_pred, llds_out, trace, tree.
-:- import_module code_util, export.
+:- import_module code_util, foreign.
:- import_module options, globals.
:- import_module bool, string, int, assoc_list, set, map, require, term.
@@ -1136,7 +1136,7 @@
(
var_is_not_singleton(ArgName, Name)
->
- export__type_to_type_string(Module, OrigType, OrigTypeString),
+ OrigTypeString = to_type_string(c, Module, OrigType),
Decl = pragma_c_arg_decl(OrigType, OrigTypeString, Name),
make_pragma_decls(Args, Module, Decls1),
Decls = [Decl | Decls1]
diff -u compiler/prog_io_pragma.m compiler/prog_io_pragma.m
--- compiler/prog_io_pragma.m
+++ compiler/prog_io_pragma.m
@@ -70,6 +70,7 @@
ErrorTerm)
).
+/*
parse_pragma_type(ModuleName, "foreign_type", PragmaTerms,
ErrorTerm, _VarSet, Result) :-
( PragmaTerms = [MercuryName, ForeignName, Target] ->
@@ -114,6 +115,7 @@
"wrong number of arguments in `:- pragma foreign_type' declaration",
ErrorTerm)
).
+*/
parse_pragma_type(ModuleName, "foreign_decl", PragmaTerms,
ErrorTerm, VarSet, Result) :-
diff -u compiler/rtti_to_mlds.m compiler/rtti_to_mlds.m
--- compiler/rtti_to_mlds.m
+++ compiler/rtti_to_mlds.m
@@ -30,7 +30,7 @@
:- func mlds_rtti_type_name(rtti_name) = string.
:- implementation.
-:- import_module prog_data.
+:- import_module foreign, prog_data.
:- import_module pseudo_type_info, prog_util, prog_out, type_util.
:- import_module ml_code_util, ml_unify_gen.
:- import_module bool, list, std_util, string, term, require.
@@ -133,10 +133,12 @@
]).
gen_init_rtti_data_defn(field_names(_RttiTypeId, _Ordinal, MaybeNames), _, _,
Init, []) :-
+ StrType = term__functor(term__atom("string"), [], context("", 0)),
Init = gen_init_array(gen_init_maybe(
- mercury_type(functor(atom("string"), [],
- context("", 0)), str_type, "MR_String"),
+ mercury_type(StrType, str_type,
+ non_foreign_type(StrType)),
gen_init_string), MaybeNames).
+
gen_init_rtti_data_defn(field_types(_RttiTypeId, _Ordinal, Types),
ModuleName, _, Init, []) :-
Init = gen_init_array(
diff -u doc/reference_manual.texi doc/reference_manual.texi
--- doc/reference_manual.texi
+++ doc/reference_manual.texi
@@ -6656,8 +6656,6 @@
@samp{#@var{line}} directives provide support
for preprocessors and other tools that
generate Mercury code.
-* Interfacing:: Pragmas can be used to ease interfacing
- with other languages.
@end menu
@node Inlining
@@ -6835,31 +6833,34 @@
generated file for the automatically generated text, as in the above
example.
- at node Interfacing
- at section Interfacing
+ at c * Interfacing:: Pragmas can be used to ease interfacing
+ at c with other languages.
-A declaration of the form
-
- at example
-:- pragma foreign_type(xmldoc, 'System__Xml__XmlDocument', il("System.Xml")).
- at end example
-
-ensures that on the IL backend the mercury type @samp{xmldoc} is
-represented by the backend as a @samp{System.Xml.XmlDocument}. This
-avoids the need to marshall values when interfacing with libraries
-written in other languages. The following example shows how to do this
-interfacing.
-
- at example
-:- pred loadxml(string::in, xmldoc::di, xmldoc::uo) is det.
-
-:- pragma foreign_proc("C#", load(String::in, XML0::di, XML::uo),
- [will_not_call_mercury],
-"
- XML0.LoadXml(String);
- XML = XML0;
-").
- at end example
+ at c @node Interfacing
+ at c @section Interfacing
+ at c
+ at c A declaration of the form
+ at c
+ at c @example
+ at c :- pragma foreign_type(xmldoc, 'System__Xml__XmlDocument', il("System.Xml")).
+ at c @end example
+ at c
+ at c ensures that on the IL backend the mercury type @samp{xmldoc} is
+ at c represented by the backend as a @samp{System.Xml.XmlDocument}. This
+ at c avoids the need to marshall values when interfacing with libraries
+ at c written in other languages. The following example shows how to do this
+ at c interfacing.
+ at c
+ at c @example
+ at c :- pred loadxml(string::in, xmldoc::di, xmldoc::uo) is det.
+ at c
+ at c :- pragma foreign_proc("C#", load(String::in, XML0::di, XML::uo),
+ at c [will_not_call_mercury],
+ at c "
+ at c XML0.LoadXml(String);
+ at c XML = XML0;
+ at c ").
+ at c @end example
@node Implementation-dependent extensions
@chapter Implementation-dependent extensions
only in patch2:
--- compiler/foreign.m 23 Jul 2001 12:22:04 -0000 1.7
+++ compiler/foreign.m 24 Oct 2001 11:00:14 -0000
@@ -22,7 +22,23 @@
:- import_module hlds_module, hlds_pred.
:- import_module llds.
-:- import_module list, bool.
+:- import_module bool, list, string.
+ % A type which is used to determine the string representation of a
+ % mercury type for various foreign languages.
+:- type exported_type.
+
+ % Given a type which is not defined as a foreign type, get the
+ % exported_type representation of that type.
+:- func foreign__non_foreign_type((type)) = exported_type.
+
+ % Given an arbitary mercury type, get the exported_type representation
+ % of that type.
+:- func foreign__to_exported_type(module_info, (type)) = exported_type.
+
+ % Given a representation of a type determine the string which
+ % corresponds to that type in the specified foreign language.
+:- func foreign__to_type_string(foreign_language, exported_type) = string.
+:- func foreign__to_type_string(foreign_language, module_info, (type)) = string.
% Filter the decls for the given foreign language.
% The first return value is the list of matches, the second is
@@ -107,10 +123,11 @@
:- implementation.
-:- import_module list, map, assoc_list, std_util, string, varset, int.
+:- import_module list, map, assoc_list, std_util, string, varset, int, term.
:- import_module require.
:- import_module hlds_pred, hlds_module, type_util, mode_util, error_util.
+:- import_module hlds_data, prog_out.
:- import_module code_model, globals.
% Currently we don't use the globals to compare foreign language
@@ -496,9 +513,74 @@
FM = qualified(Module, Name ++ Ending)
).
+%-----------------------------------------------------------------------------%
+:- type exported_type
+ ---> foreign(sym_name) % A type defined by a
+ % pragma foreign_type.
+ ; mercury((type)). % Any other mercury type.
+
+non_foreign_type(Type) = mercury(Type).
+
+to_exported_type(ModuleInfo, Type) = ExportType :-
+ module_info_types(ModuleInfo, Types),
+ (
+ type_to_type_id(Type, TypeId, _),
+ map__search(Types, TypeId, TypeDefn)
+ ->
+ hlds_data__get_type_defn_body(TypeDefn, Body),
+ ( Body = foreign_type(ForeignType, _) ->
+ ExportType = foreign(ForeignType)
+ ;
+ ExportType = mercury(Type)
+ )
+ ;
+ ExportType = mercury(Type)
+ ).
+to_type_string(Lang, ModuleInfo, Type) =
+ to_type_string(Lang, to_exported_type(ModuleInfo, Type)).
+
+to_type_string(c, foreign(_ForeignType)) = _ :-
+ sorry(this_file, "foreign types on a C backend").
+to_type_string(csharp, foreign(ForeignType)) = Result :-
+ sym_name_to_string(ForeignType, ".", Result).
+to_type_string(managed_cplusplus, foreign(ForeignType)) = Result ++ " *":-
+ sym_name_to_string(ForeignType, "::", Result).
+to_type_string(il, foreign(ForeignType)) = Result :-
+ sym_name_to_string(ForeignType, ".", Result).
+
+ % XXX does this do the right thing for high level data?
+to_type_string(c, mercury(Type)) = Result :-
+ ( Type = term__functor(term__atom("int"), [], _) ->
+ Result = "MR_Integer"
+ ; Type = term__functor(term__atom("float"), [], _) ->
+ Result = "MR_Float"
+ ; Type = term__functor(term__atom("string"), [], _) ->
+ Result = "MR_String"
+ ; Type = term__functor(term__atom("character"), [], _) ->
+ Result = "MR_Char"
+ ;
+ Result = "MR_Word"
+ ).
+to_type_string(csharp, mercury(_Type)) = _ :-
+ sorry(this_file, "to_type_string for csharp").
+to_type_string(managed_cplusplus, mercury(Type)) = TypeString :-
+ (
+ type_util__var(Type, _)
+ ->
+ TypeString = "MR_Box"
+ ;
+ TypeString = to_type_string(c, mercury(Type))
+ ).
+to_type_string(il, mercury(_Type)) = _ :-
+ sorry(this_file, "to_type_string for il").
+
+%-----------------------------------------------------------------------------%
:- func this_file = string.
+
this_file = "foreign.m".
+%-----------------------------------------------------------------------------%
+%-----------------------------------------------------------------------------%
--------------------------------------------------------------------------
mercury-reviews mailing list
post: mercury-reviews at cs.mu.oz.au
administrative address: owner-mercury-reviews at cs.mu.oz.au
unsubscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: unsubscribe
subscribe: Address: mercury-reviews-request at cs.mu.oz.au Message: subscribe
--------------------------------------------------------------------------
More information about the reviews
mailing list