[m-rev.] for review: C foreign types
Peter Ross
peter.ross at miscrit.be
Tue Mar 5 23:29:47 AEDT 2002
Hi,
For Fergus or Tyson to review.
===================================================================
Estimated hours taken: 8
Branches: main
Get pragma foreign_type working for the C backend.
XXX Note that pragma export is broken for exporting predicates which
take a foreign_type as their argument on the asm_fast.gc backend. This
is because pragma foreign_decl are not placed in the header files, and
hence you get parse errors.
doc/reference_manual.texi:
Document C pragma foreign_types.
compiler/prog_data.m:
Add il_foreign_type and c_foreign_type which contain all the
necessary data to output a foreign_type on the respective backends.
Change foreign_language_type to refer to these new types.
compiler/prog_io_pragma.m:
Handle the changes to foreign_language_type, and parse C
foreign_type declarations.
compiler/hlds_data.m:
Change the hlds_data__foreign_type type so that it records both the
C and IL foreign types. This will allow one to output both foreign
type declarations when doing intermodule optimization.
compiler/make_hlds.m:
Changes so that we store both the IL and C foreign types in
hlds_data__foreign_type.
Also add an error checking pass where we check that there is a
foreign type for the back-end we are currently compiling to.
compiler/foreign.m:
Change to_exported_type so that it works for both the C and IL
backends by getting either the C or IL foreign_type definition.
compiler/llds.m:
compiler/pragma_c_gen.m:
Change pragma_c_input and pragma_c_output so that they record
whether or not a type is a foreign_type and if so what is the string
which represents that foreign_type.
compiler/llds_out.m:
When outputting pragma c_code variables that represent foreign_types
get the casts correct. Note that this adds the constraint on C
foreign types that they are word sized, as all we are doing is
casts, not boxing and unboxing.
compiler/mlds.m:
Change mlds__foreign_type so that we store whether a type is an IL
type or a C type. It is the responsibility of the code generator
that we never create a reference to a IL foreign type when on the C
back-end, and vice versa.
compiler/mercury_to_mercury.m:
Handle changes to prog_data__foreign_type.
compiler/hlds_out.m:
compiler/intermod.m:
compiler/magic_util.m:
compiler/ml_code_gen.m:
compiler/ml_type_gen.m:
compiler/recompilation_usage.m:
compiler/term_util.m:
compiler/type_ctor_info.m:
compiler/unify_proc.m:
Handle changes to hlds_data__foreign_type.
compiler/exprn_aux.m:
compiler/livemap.m:
compiler/middle_rec.m:
compiler/opt_util.m:
Handle changes to the pragma_c_input and pragma_c_output types.
compiler/ml_code_util.m:
compiler/mlds_to_gcc.m:
compiler/mlds_to_il.m:
compiler/mlds_to_java.m:
compiler/mlds_to_c.m:
Handle changes to mlds__foreign_type.
Index: compiler/exprn_aux.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/exprn_aux.m,v
retrieving revision 1.41
diff -u -r1.41 exprn_aux.m
--- compiler/exprn_aux.m 24 Apr 2001 03:58:55 -0000 1.41
+++ compiler/exprn_aux.m 5 Mar 2002 12:05:20 -0000
@@ -599,20 +599,20 @@
exprn_aux__substitute_lval_in_pragma_c_input(OldLval, NewLval, Out0, Out,
N0, N) :-
- Out0 = pragma_c_input(Name, Type, Rval0),
+ Out0 = pragma_c_input(Name, Type, Rval0, MaybeForeign),
exprn_aux__substitute_lval_in_rval_count(OldLval, NewLval, Rval0, Rval,
N0, N),
- Out = pragma_c_input(Name, Type, Rval).
+ Out = pragma_c_input(Name, Type, Rval, MaybeForeign).
:- pred exprn_aux__substitute_lval_in_pragma_c_output(lval::in, lval::in,
pragma_c_output::in, pragma_c_output::out, int::in, int::out) is det.
exprn_aux__substitute_lval_in_pragma_c_output(OldLval, NewLval, Out0, Out,
N0, N) :-
- Out0 = pragma_c_output(Lval0, Type, Name),
+ Out0 = pragma_c_output(Lval0, Type, Name, MaybeForeign),
exprn_aux__substitute_lval_in_lval_count(OldLval, NewLval, Lval0, Lval,
N0, N),
- Out = pragma_c_output(Lval, Type, Name).
+ Out = pragma_c_output(Lval, Type, Name, MaybeForeign).
:- pred exprn_aux__substitute_lval_in_rval_count(lval::in, lval::in,
rval::in, rval::out, int::in, int::out) is det.
Index: compiler/foreign.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.10
diff -u -r1.10 foreign.m
--- compiler/foreign.m 16 Jan 2002 01:13:18 -0000 1.10
+++ compiler/foreign.m 5 Mar 2002 12:05:21 -0000
@@ -71,7 +71,7 @@
:- func foreign__non_foreign_type((type)) = exported_type.
% Given an arbitary mercury type, get the exported_type representation
- % of that type.
+ % of that type on the current backend.
:- func foreign__to_exported_type(module_info, (type)) = exported_type.
% Given a representation of a type determine the string which
@@ -576,13 +576,35 @@
to_exported_type(ModuleInfo, Type) = ExportType :-
module_info_types(ModuleInfo, Types),
+ module_info_globals(ModuleInfo, Globals),
+ globals__get_target(Globals, Target),
(
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)
+ ( Body = foreign_type(MaybeIL, MaybeC) ->
+ ( Target = c,
+ ( MaybeC = yes(c(NameStr)),
+ Name = unqualified(NameStr)
+ ; MaybeC = no,
+ error("to_exported_type: no C type")
+ )
+ ; Target = il,
+ ( MaybeIL = yes(il(_, _, Name))
+ ; MaybeIL = no,
+ error("to_exported_type: no IL type")
+ )
+ ; Target = java,
+ error("to_exported_type: java NYI")
+ ; Target = asm,
+ ( MaybeC = yes(c(NameStr)),
+ Name = unqualified(NameStr)
+ ; MaybeC = no,
+ error("to_exported_type: no C type")
+ )
+ ),
+ ExportType = foreign(Name)
;
ExportType = mercury(Type)
)
@@ -593,8 +615,12 @@
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(c, foreign(ForeignType)) = Result :-
+ ( ForeignType = unqualified(Result0) ->
+ Result = Result0
+ ;
+ error("to_type_string: qualifed C type")
+ ).
to_type_string(csharp, foreign(ForeignType)) = Result :-
sym_name_to_string(ForeignType, ".", Result).
to_type_string(managed_cplusplus, foreign(ForeignType)) = Result ++ " *":-
Index: compiler/hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.66
diff -u -r1.66 hlds_data.m
--- compiler/hlds_data.m 26 Feb 2002 02:45:36 -0000 1.66
+++ compiler/hlds_data.m 5 Mar 2002 12:05:21 -0000
@@ -299,12 +299,8 @@
)
; eqv_type(type)
; foreign_type(
- bool, % is the type already boxed
- sym_name, % structured name of foreign type
- % which represents the mercury type.
- string % Location of the definition for this
- % type (such as assembly or
- % library name)
+ il :: maybe(il_foreign_type),
+ c :: maybe(c_foreign_type)
)
; abstract_type.
Index: compiler/hlds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_out.m,v
retrieving revision 1.276
diff -u -r1.276 hlds_out.m
--- compiler/hlds_out.m 27 Feb 2002 17:41:06 -0000 1.276
+++ compiler/hlds_out.m 5 Mar 2002 12:05:22 -0000
@@ -2722,7 +2722,7 @@
hlds_out__write_type_body(_Indent, _Tvarset, abstract_type) -->
io__write_string(".\n").
-hlds_out__write_type_body(_Indent, _Tvarset, foreign_type(_, _, _)) -->
+hlds_out__write_type_body(_Indent, _Tvarset, foreign_type(_, _)) -->
{ error("hlds_out__write_type_body: foreign type body found") }.
:- pred hlds_out__write_constructors(int, tvarset, list(constructor),
Index: compiler/intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.113
diff -u -r1.113 intermod.m
--- compiler/intermod.m 26 Feb 2002 02:45:39 -0000 1.113
+++ compiler/intermod.m 5 Mar 2002 12:05:23 -0000
@@ -1215,7 +1215,7 @@
{ Body = abstract_type },
{ TypeBody = abstract_type }
;
- { Body = foreign_type(_, _, _) },
+ { Body = foreign_type(_, _) },
{ TypeBody = abstract_type },
% XXX trd
% Also here we need to output the pragma
Index: compiler/livemap.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/livemap.m,v
retrieving revision 1.51
diff -u -r1.51 livemap.m
--- compiler/livemap.m 24 Apr 2001 03:58:56 -0000 1.51
+++ compiler/livemap.m 5 Mar 2002 12:05:23 -0000
@@ -424,7 +424,7 @@
livemap__build_livemap_pragma_inputs([], Livevals, Livevals).
livemap__build_livemap_pragma_inputs([Input | Inputs], Livevals0, Livevals) :-
- Input = pragma_c_input(_, _, Rval),
+ Input = pragma_c_input(_, _, Rval, _),
( Rval = lval(Lval) ->
livemap__insert_proper_liveval(Lval, Livevals0, Livevals1)
;
Index: compiler/llds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds.m,v
retrieving revision 1.280
diff -u -r1.280 llds.m
--- compiler/llds.m 6 Nov 2001 15:20:46 -0000 1.280
+++ compiler/llds.m 5 Mar 2002 12:05:24 -0000
@@ -551,15 +551,17 @@
% A pragma_c_input represents the code that initializes one
% of the input variables for a pragma_c instruction.
:- type pragma_c_input
- ---> pragma_c_input(string, type, rval).
- % variable name, type, variable value.
+ ---> pragma_c_input(string, type, rval, maybe(string)).
+ % variable name, type, variable value,
+ % maybe C type if foreign type.
% A pragma_c_output represents the code that stores one of
% of the outputs for a pragma_c instruction.
:- type pragma_c_output
- ---> pragma_c_output(lval, type, string).
+ ---> pragma_c_output(lval, type, string, maybe(string)).
% where to put the output val, type and name
% of variable containing the output val
+ % followed by maybe C type if foreign type.
% see runtime/mercury_trail.h
:- type reset_trail_reason
Index: compiler/llds_out.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/llds_out.m,v
retrieving revision 1.186
diff -u -r1.186 llds_out.m
--- compiler/llds_out.m 20 Feb 2002 03:14:07 -0000 1.186
+++ compiler/llds_out.m 5 Mar 2002 12:05:25 -0000
@@ -1945,7 +1945,7 @@
output_pragma_input_rval_decls([], DeclSet, DeclSet) --> [].
output_pragma_input_rval_decls([I | Inputs], DeclSet0, DeclSet) -->
- { I = pragma_c_input(_VarName, _Type, Rval) },
+ { I = pragma_c_input(_VarName, _Type, Rval, _) },
output_rval_decls(Rval, "\t", "\t", 0, _N, DeclSet0, DeclSet1),
output_pragma_input_rval_decls(Inputs, DeclSet1, DeclSet).
@@ -1956,7 +1956,7 @@
output_pragma_inputs([]) --> [].
output_pragma_inputs([I|Inputs]) -->
- { I = pragma_c_input(VarName, Type, Rval) },
+ { I = pragma_c_input(VarName, Type, Rval, MaybeForeignType) },
io__write_string("\t"),
io__write_string(VarName),
io__write_string(" = "),
@@ -1970,6 +1970,11 @@
->
output_rval_as_type(Rval, float)
;
+ ( { MaybeForeignType = yes(ForeignTypeStr) } ->
+ io__write_string("(" ++ ForeignTypeStr ++ ") ")
+ ;
+ []
+ ),
output_rval_as_type(Rval, word)
),
io__write_string(";\n"),
@@ -1982,7 +1987,7 @@
output_pragma_output_lval_decls([], DeclSet, DeclSet) --> [].
output_pragma_output_lval_decls([O | Outputs], DeclSet0, DeclSet) -->
- { O = pragma_c_output(Lval, _Type, _VarName) },
+ { O = pragma_c_output(Lval, _Type, _VarName, _) },
output_lval_decls(Lval, "\t", "\t", 0, _N, DeclSet0, DeclSet1),
output_pragma_output_lval_decls(Outputs, DeclSet1, DeclSet).
@@ -1993,7 +1998,7 @@
output_pragma_outputs([]) --> [].
output_pragma_outputs([O|Outputs]) -->
- { O = pragma_c_output(Lval, Type, VarName) },
+ { O = pragma_c_output(Lval, Type, VarName, MaybeForeignType) },
io__write_string("\t"),
output_lval_as_word(Lval),
io__write_string(" = "),
@@ -2009,6 +2014,11 @@
io__write_string(VarName),
io__write_string(")")
;
+ ( { MaybeForeignType = yes(_) } ->
+ output_llds_type_cast(word)
+ ;
+ []
+ ),
io__write_string(VarName)
),
io__write_string(";\n"),
Index: compiler/magic_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/magic_util.m,v
retrieving revision 1.18
diff -u -r1.18 magic_util.m
--- compiler/magic_util.m 26 Feb 2002 02:45:40 -0000 1.18
+++ compiler/magic_util.m 5 Mar 2002 12:05:26 -0000
@@ -1377,7 +1377,7 @@
{ error("magic_util__check_type_defn: eqv_type") }.
magic_util__check_type_defn(abstract_type, _, Errors0, Errors) -->
{ set__insert(Errors0, abstract, Errors) }.
-magic_util__check_type_defn(foreign_type(_, _, _), _, _, _) -->
+magic_util__check_type_defn(foreign_type(_, _), _, _, _) -->
{ error("magic_util__check_type_defn: foreign_type") }.
:- pred magic_util__check_ctor(set(type_id)::in, constructor::in,
Index: compiler/make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.401
diff -u -r1.401 make_hlds.m
--- compiler/make_hlds.m 26 Feb 2002 02:45:41 -0000 1.401
+++ compiler/make_hlds.m 5 Mar 2002 12:05:30 -0000
@@ -396,21 +396,18 @@
{ Pragma = foreign_proc(_, _, _, _, _, _) },
{ Module = Module0 }
;
+ % Note that we check during add_item_clause that we have
+ % defined a foreign_type which is usable by the back-end
+ % we are compiling on.
{ Pragma = foreign_type(ForeignType, _MercuryType, Name) },
- { ForeignType = il(RefOrVal,
- ForeignTypeLocation, ForeignTypeName) },
-
- { RefOrVal = reference,
- IsBoxed = yes
- ; RefOrVal = value,
- IsBoxed = no
- },
-
{ varset__init(VarSet) },
{ Args = [] },
- { Body = foreign_type(IsBoxed,
- ForeignTypeName, ForeignTypeLocation) },
+ { ForeignType = il(ILForeignType),
+ Body = foreign_type(yes(ILForeignType), no)
+ ; ForeignType = c(CForeignType),
+ Body = foreign_type(no, yes(CForeignType))
+ },
{ Cond = true },
{ TypeId = Name - 0 },
@@ -794,6 +791,61 @@
add_pragma_type_spec(Pragma, Context, Module0, Module,
Info0, Info)
;
+ { Pragma = foreign_type(_, _, Name) }
+ ->
+ { TypeId = Name - 0 },
+ { module_info_types(Module0, Types) },
+ { TypeStr = error_util__describe_sym_name_and_arity(
+ Name / 0) },
+ (
+ { map__search(Types, TypeId, Defn) },
+ { hlds_data__get_type_defn_body(Defn, Body) },
+ { Body = foreign_type(MaybeIL, MaybeC) }
+ ->
+ { module_info_globals(Module0, Globals) },
+ { globals__lookup_bool_option(Globals, target_code_only,
+ TargetCode) },
+ ( { TargetCode = yes } ->
+ { globals__get_target(Globals, Target) },
+ ( { Target = c },
+ ( { MaybeC = yes(_) },
+ { Module = Module0 }
+ ; { MaybeC = no },
+ { ErrorPieces = [
+ words("Error: No C pragma"),
+ words("foreign_type for"),
+ fixed(TypeStr)
+ ] },
+ error_util__write_error_pieces(Context,
+ 0, ErrorPieces),
+ { module_info_incr_errors(Module0, Module) }
+ )
+ ; { Target = il },
+ ( { MaybeIL = yes(_) },
+ { Module = Module0 }
+ ; { MaybeIL = no },
+ { ErrorPieces = [
+ words("Error: No IL pragma"),
+ words("foreign_type for"),
+ fixed(TypeStr)
+ ] },
+ error_util__write_error_pieces(Context,
+ 0, ErrorPieces),
+ { module_info_incr_errors(Module0, Module) }
+ )
+ ; { Target = java },
+ { Module = Module0 }
+ ; { Target = asm },
+ { Module = Module0 }
+ )
+ ;
+ { Module = Module0 }
+ )
+ ;
+ { error("add_item_clause: unable to find foreign type") }
+ ),
+ { Info = Info0 }
+ ;
% don't worry about any pragma decs but c_code, tabling,
% type_spec and fact_table here
{ Module = Module0 },
@@ -1916,7 +1968,13 @@
module_info_set_types(Module0, Types, Module)
}
;
-
+ { merge_foreign_type_bodies(Body, Body_2, NewBody) }
+ ->
+ { hlds_data__set_type_defn(TVarSet_2, Params_2,
+ NewBody, Status, Context, T3) },
+ { map__det_update(Types0, TypeId, T3, Types) },
+ { module_info_set_types(Module0, Types, Module) }
+ ;
% otherwise issue an error message if the second
% definition wasn't read while reading .opt files.
{ Status = opt_imported }
@@ -2003,6 +2061,19 @@
[]
)
).
+
+:- pred merge_foreign_type_bodies(hlds_type_body::in,
+ hlds_type_body::in, hlds_type_body::out) is semidet.
+
+merge_foreign_type_bodies(foreign_type(MaybeILA, MaybeCA),
+ foreign_type(MaybeILB, MaybeCB),
+ foreign_type(MaybeIL, MaybeC)) :-
+ merge_maybe(MaybeILA, MaybeILB, MaybeIL),
+ merge_maybe(MaybeCA, MaybeCB, MaybeC).
+
+:- pred merge_maybe(maybe(T)::in, maybe(T)::in, maybe(T)::out) is semidet.
+merge_maybe(yes(T), no, yes(T)).
+merge_maybe(no, yes(T), yes(T)).
:- pred make_status_abstract(import_status, import_status).
:- mode make_status_abstract(in, out) is det.
Index: compiler/mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.206
diff -u -r1.206 mercury_to_mercury.m
--- compiler/mercury_to_mercury.m 26 Feb 2002 02:45:45 -0000 1.206
+++ compiler/mercury_to_mercury.m 5 Mar 2002 12:05:31 -0000
@@ -496,20 +496,28 @@
;
{ Pragma = foreign_type(ForeignType, _MercuryType,
MercuryTypeSymName) },
- { ForeignType = il(RefOrVal, ForeignLocStr, ForeignTypeName) },
io__write_string(":- pragma foreign_type("),
- io__write_string("il, "),
+ ( { ForeignType = il(_) },
+ io__write_string("il, ")
+ ; { ForeignType = c(_) },
+ io__write_string("c, ")
+ ),
mercury_output_sym_name(MercuryTypeSymName),
io__write_string(", "),
- ( { RefOrVal = reference },
- io__write_string("\"class [")
- ; { RefOrVal = value },
- io__write_string("\"valuetype [")
- ),
- io__write_string(ForeignLocStr),
- io__write_string("]"),
- { sym_name_to_string(ForeignTypeName, ".", ForeignTypeStr) },
+ io__write_string(", \""),
+ { ForeignType = il(il(RefOrVal,
+ ForeignLocStr, ForeignTypeName)),
+ ( RefOrVal = reference,
+ RefOrValStr = "class "
+ ; RefOrVal = value,
+ RefOrValStr = "valuetype "
+ ),
+ sym_name_to_string(ForeignTypeName, ".", NameStr),
+ ForeignTypeStr = RefOrValStr ++ "[" ++ ForeignLocStr ++
+ "]" ++ NameStr
+ ; ForeignType = c(c(ForeignTypeStr))
+ },
io__write_string(ForeignTypeStr),
io__write_string("\").\n")
;
Index: compiler/middle_rec.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/middle_rec.m,v
retrieving revision 1.87
diff -u -r1.87 middle_rec.m
--- compiler/middle_rec.m 24 Apr 2001 03:58:59 -0000 1.87
+++ compiler/middle_rec.m 5 Mar 2002 12:05:31 -0000
@@ -545,7 +545,7 @@
insert_pragma_c_input_registers([], Used, Used).
insert_pragma_c_input_registers([Input|Inputs], Used0, Used) :-
- Input = pragma_c_input(_, _, Rval),
+ Input = pragma_c_input(_, _, Rval, _),
middle_rec__find_used_registers_rval(Rval, Used0, Used1),
insert_pragma_c_input_registers(Inputs, Used1, Used).
@@ -555,7 +555,7 @@
insert_pragma_c_output_registers([], Used, Used).
insert_pragma_c_output_registers([Output|Outputs], Used0, Used) :-
- Output = pragma_c_output(Lval, _, _),
+ Output = pragma_c_output(Lval, _, _, _),
middle_rec__find_used_registers_lval(Lval, Used0, Used1),
insert_pragma_c_output_registers(Outputs, Used1, Used).
Index: compiler/ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.110
diff -u -r1.110 ml_code_gen.m
--- compiler/ml_code_gen.m 5 Mar 2002 10:59:19 -0000 1.110
+++ compiler/ml_code_gen.m 5 Mar 2002 12:05:32 -0000
@@ -850,6 +850,8 @@
ml_gen_imports(ModuleInfo, MLDS_ImportList) :-
% Determine all the mercury imports.
+ module_info_globals(ModuleInfo, Globals),
+ globals__get_target(Globals, Target),
module_info_get_all_deps(ModuleInfo, AllImports),
P = (func(Name) = mercury_import(mercury_module_name_to_mlds(Name))),
@@ -858,7 +860,16 @@
module_info_types(ModuleInfo, Types),
list__filter_map((pred(TypeDefn::in, Import::out) is semidet :-
hlds_data__get_type_defn_body(TypeDefn, Body),
- Body = foreign_type(_, _, Location),
+ Body = foreign_type(MaybeIL, _MaybeC),
+ ( Target = c,
+ fail
+ ; Target = il,
+ MaybeIL = yes(il(_, Location, _))
+ ; Target = java,
+ fail
+ ; Target = asm,
+ fail
+ ),
Name = il_assembly_name(mercury_module_name_to_mlds(
unqualified(Location))),
Import = foreign_import(Name)
Index: compiler/ml_code_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_util.m,v
retrieving revision 1.57
diff -u -r1.57 ml_code_util.m
--- compiler/ml_code_util.m 4 Mar 2002 07:31:35 -0000 1.57
+++ compiler/ml_code_util.m 5 Mar 2002 12:05:33 -0000
@@ -2113,14 +2113,11 @@
ml_type_might_contain_pointers(mlds__native_float_type) = no.
ml_type_might_contain_pointers(mlds__native_bool_type) = no.
ml_type_might_contain_pointers(mlds__native_char_type) = no.
-ml_type_might_contain_pointers(mlds__foreign_type(_, _, _)) = _ :-
- % It might contain pointers, so it's not safe to return `no',
- % but it also might not be word-sized, so it's not safe to
- % return `yes'. Currently this case should not occur, since
- % currently `foreign_type' is only used for the IL back-end,
- % where GC is handled by the target language.
- unexpected(this_file, "--gc accurate and foreign_type").
-
+ % Due to constraints from the LLDS back-end this type must be
+ % word sized and on all other backends where this type is
+ % supported garbage collection is handled by the target
+ % language, so it is safe to return yes.
+ml_type_might_contain_pointers(mlds__foreign_type(_)) = yes.
ml_type_might_contain_pointers(mlds__class_type(_, _, Category)) =
(if Category = mlds__enum then no else yes).
ml_type_might_contain_pointers(mlds__ptr_type(_)) = yes.
Index: compiler/ml_type_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_type_gen.m,v
retrieving revision 1.24
diff -u -r1.24 ml_type_gen.m
--- compiler/ml_type_gen.m 26 Feb 2002 02:45:48 -0000 1.24
+++ compiler/ml_type_gen.m 5 Mar 2002 12:05:34 -0000
@@ -124,7 +124,7 @@
Ctors, TagValues, MaybeEqualityMembers)
).
% XXX Fixme! Same issues here as for eqv_type/1.
-ml_gen_type_2(foreign_type(_, _, _), _, _, _) --> [].
+ml_gen_type_2(foreign_type(_, _), _, _, _) --> [].
%-----------------------------------------------------------------------------%
%
Index: compiler/mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.85
diff -u -r1.85 mlds.m
--- compiler/mlds.m 3 Mar 2002 17:27:08 -0000 1.85
+++ compiler/mlds.m 5 Mar 2002 12:05:34 -0000
@@ -628,12 +628,9 @@
; mlds__native_float_type
; mlds__native_char_type
- % This is a type of the MLDS target language. Currently
- % this is only used by the il backend.
+ % This is a type of the MLDS target language.
; mlds__foreign_type(
- bool, % is type already boxed?
- sym_name, % structured name representing the type
- string % location of the type (ie assembly)
+ foreign_language_type
)
% MLDS types defined using mlds__class_defn
@@ -1596,7 +1593,7 @@
%-----------------------------------------------------------------------------%
:- implementation.
-:- import_module foreign, modules.
+:- import_module error_util, globals, foreign, modules.
:- import_module int, term, string, require.
%-----------------------------------------------------------------------------%
@@ -1634,10 +1631,28 @@
module_info_types(ModuleInfo, Types),
map__search(Types, TypeId, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, Body),
- Body = foreign_type(IsBoxed, ForeignType, ForeignLocation)
+ Body = foreign_type(MaybeIL, MaybeC)
->
- MLDSType = mlds__foreign_type(IsBoxed,
- ForeignType, ForeignLocation)
+ module_info_globals(ModuleInfo, Globals),
+ globals__get_target(Globals, Target),
+ ( Target = c,
+ ( MaybeC = yes(CForeignType),
+ ForeignType = c(CForeignType)
+ ; MaybeC = no,
+ error("mercury_type_to_mlds_type: No C foreign type")
+ )
+ ; Target = il,
+ ( MaybeIL = yes(ILForeignType),
+ ForeignType = il(ILForeignType)
+ ; MaybeIL = no,
+ error("mercury_type_to_mlds_type: No IL foreign type")
+ )
+ ; Target = java,
+ sorry(this_file, "foreign types on the java backend")
+ ; Target = asm,
+ sorry(this_file, "foreign types on the asm backend")
+ ),
+ MLDSType = mlds__foreign_type(ForeignType)
;
classify_type(Type, ModuleInfo, Category),
ExportedType = to_exported_type(ModuleInfo, Type),
@@ -1846,5 +1861,10 @@
finality_bits(Finality) \/
constness_bits(Constness) \/
abstractness_bits(Abstractness).
+
+%-----------------------------------------------------------------------------%
+
+:- func this_file = string.
+this_file = "mlds.m".
%-----------------------------------------------------------------------------%
Index: compiler/mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.121
diff -u -r1.121 mlds_to_c.m
--- compiler/mlds_to_c.m 27 Feb 2002 13:56:58 -0000 1.121
+++ compiler/mlds_to_c.m 5 Mar 2002 12:05:36 -0000
@@ -661,8 +661,12 @@
io__write_string("MR_Float").
mlds_output_pragma_export_type(prefix, mlds__native_char_type) -->
io__write_string("MR_Char").
-mlds_output_pragma_export_type(prefix, mlds__foreign_type(_, _, _)) -->
- { error("mlds_output_pragma_export_type: foreign_type") }.
+mlds_output_pragma_export_type(prefix, mlds__foreign_type(ForeignType)) -->
+ ( { ForeignType = c(c(Name)) },
+ io__write_string(Name)
+ ; { ForeignType = il(_) },
+ { error("mlds_output_pragma_export_type: il foreign_type") }
+ ).
mlds_output_pragma_export_type(prefix, mlds__class_type(_, _, _)) -->
io__write_string("MR_Word").
mlds_output_pragma_export_type(prefix, mlds__array_type(_)) -->
@@ -1635,8 +1639,12 @@
mlds_output_type_prefix(mlds__native_bool_type) -->
io__write_string("MR_bool").
mlds_output_type_prefix(mlds__native_char_type) --> io__write_string("char").
-mlds_output_type_prefix(mlds__foreign_type(_, _, _)) -->
- { error("mlds_output_type_prefix: foreign_type") }.
+mlds_output_type_prefix(mlds__foreign_type(ForeignType)) -->
+ ( { ForeignType = c(c(Name)) },
+ io__write_string(Name)
+ ; { ForeignType = il(_) },
+ { error("mlds_output_type_prefix: il foreign_type") }
+ ).
mlds_output_type_prefix(mlds__class_type(Name, Arity, ClassKind)) -->
( { ClassKind = mlds__enum } ->
%
@@ -1803,7 +1811,8 @@
mlds_output_type_suffix(mlds__native_float_type, _) --> [].
mlds_output_type_suffix(mlds__native_bool_type, _) --> [].
mlds_output_type_suffix(mlds__native_char_type, _) --> [].
-mlds_output_type_suffix(mlds__foreign_type(_, _, _), _) --> [].
+ % XXX Currently we can't output a type suffix.
+mlds_output_type_suffix(mlds__foreign_type(_), _) --> [].
mlds_output_type_suffix(mlds__class_type(_, _, _), _) --> [].
mlds_output_type_suffix(mlds__ptr_type(_), _) --> [].
mlds_output_type_suffix(mlds__array_type(_), ArraySize) -->
Index: compiler/mlds_to_gcc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_gcc.m,v
retrieving revision 1.63
diff -u -r1.63 mlds_to_gcc.m
--- compiler/mlds_to_gcc.m 18 Feb 2002 07:00:57 -0000 1.63
+++ compiler/mlds_to_gcc.m 5 Mar 2002 12:05:37 -0000
@@ -1685,7 +1685,7 @@
).
build_type(mercury_type(Type, TypeCategory, _), _, _, GCC_Type) -->
build_mercury_type(Type, TypeCategory, GCC_Type).
-build_type(mlds__foreign_type(_, _, _), _, _, _) -->
+build_type(mlds__foreign_type(_), _, _, _) -->
{ sorry(this_file, "foreign_type not implemented") }.
build_type(mlds__native_int_type, _, _, gcc__integer_type_node) --> [].
build_type(mlds__native_float_type, _, _, gcc__double_type_node) --> [].
Index: compiler/mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.106
diff -u -r1.106 mlds_to_il.m
--- compiler/mlds_to_il.m 3 Mar 2002 12:12:49 -0000 1.106
+++ compiler/mlds_to_il.m 5 Mar 2002 12:05:38 -0000
@@ -2976,15 +2976,19 @@
mlds_type_to_ilds_type(_, mlds__native_float_type) = ilds__type([], float64).
-mlds_type_to_ilds_type(_, mlds__foreign_type(IsBoxed, ForeignType, Assembly))
+mlds_type_to_ilds_type(_, mlds__foreign_type(ForeignType))
= ilds__type([], Class) :-
- sym_name_to_class_name(ForeignType, ForeignClassName),
- ( IsBoxed = yes,
- Class = class(structured_name(assembly(Assembly),
- ForeignClassName, []))
- ; IsBoxed = no,
- Class = valuetype(structured_name(assembly(Assembly),
- ForeignClassName, []))
+ ( ForeignType = il(il(RefOrVal, Assembly, Type)),
+ sym_name_to_class_name(Type, ForeignClassName),
+ ( RefOrVal = reference,
+ Class = class(structured_name(assembly(Assembly),
+ ForeignClassName, []))
+ ; RefOrVal = value,
+ Class = valuetype(structured_name(assembly(Assembly),
+ ForeignClassName, []))
+ )
+ ; ForeignType = c(_),
+ error("mlds_to_il: c foreign type")
).
mlds_type_to_ilds_type(ILDataRep, mlds__ptr_type(MLDSType)) =
Index: compiler/mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.24
diff -u -r1.24 mlds_to_java.m
--- compiler/mlds_to_java.m 22 Feb 2002 01:51:09 -0000 1.24
+++ compiler/mlds_to_java.m 5 Mar 2002 12:05:39 -0000
@@ -1250,7 +1250,7 @@
get_java_type_initializer(mlds__native_int_type) = "0".
get_java_type_initializer(mlds__native_float_type) = "0".
get_java_type_initializer(mlds__native_char_type) = "0".
-get_java_type_initializer(mlds__foreign_type(_, _, _)) = _ :-
+get_java_type_initializer(mlds__foreign_type(_)) = _ :-
unexpected(this_file,
"get_type_initializer: variable has foreign_type").
get_java_type_initializer(mlds__class_type(_, _, _)) = "null".
@@ -1618,7 +1618,7 @@
output_type(mlds__native_float_type) --> io__write_string("double").
output_type(mlds__native_bool_type) --> io__write_string("boolean").
output_type(mlds__native_char_type) --> io__write_string("char").
-output_type(mlds__foreign_type(_, _, _)) -->
+output_type(mlds__foreign_type(_)) -->
{ unexpected(this_file, "output_type: foreign_type NYI.") }.
output_type(mlds__class_type(Name, Arity, ClassKind)) -->
( { ClassKind = mlds__enum } ->
Index: compiler/opt_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/opt_util.m,v
retrieving revision 1.113
diff -u -r1.113 opt_util.m
--- compiler/opt_util.m 18 Feb 2002 07:00:58 -0000 1.113
+++ compiler/opt_util.m 5 Mar 2002 12:05:40 -0000
@@ -1340,7 +1340,7 @@
pragma_c_inputs_get_rvals([], []).
pragma_c_inputs_get_rvals([I|Inputs], [R|Rvals]) :-
- I = pragma_c_input(_Name, _Type, R),
+ I = pragma_c_input(_Name, _Type, R, _),
pragma_c_inputs_get_rvals(Inputs, Rvals).
% extract the lvals from the pragma_c_output
@@ -1349,7 +1349,7 @@
pragma_c_outputs_get_lvals([], []).
pragma_c_outputs_get_lvals([O|Outputs], [L|Lvals]) :-
- O = pragma_c_output(L, _Type, _Name),
+ O = pragma_c_output(L, _Type, _Name, _),
pragma_c_outputs_get_lvals(Outputs, Lvals).
% determine all the rvals and lvals referenced by a list of instructions
Index: compiler/pragma_c_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.48
diff -u -r1.48 pragma_c_gen.m
--- compiler/pragma_c_gen.m 13 Feb 2002 09:56:25 -0000 1.48
+++ compiler/pragma_c_gen.m 5 Mar 2002 12:05:41 -0000
@@ -44,6 +44,7 @@
:- import_module hlds_module, hlds_pred, llds_out, trace, tree.
:- import_module code_util, foreign.
:- import_module options, globals.
+:- import_module type_util, hlds_data, prog_out.
:- import_module bool, string, int, assoc_list, set, map, require, term.
@@ -668,8 +669,8 @@
{ make_pragma_decls(Args, ModuleInfo, Decls) },
{ make_pragma_decls(OutArgs, ModuleInfo, OutDecls) },
- { input_descs_from_arg_info(InArgs, InputDescs) },
- { output_descs_from_arg_info(OutArgs, OutputDescs) },
+ input_descs_from_arg_info(InArgs, InputDescs),
+ output_descs_from_arg_info(OutArgs, OutputDescs),
{ module_info_pred_info(ModuleInfo, PredId, PredInfo) },
{ pred_info_module(PredInfo, ModuleName) },
@@ -1177,7 +1178,8 @@
code_info__produce_variable(Var, FirstCode, Rval),
% code_info__produce_variable_in_reg(Var, FirstCode, Lval),
% { Rval = lval(Lval) },
- { Input = pragma_c_input(Name, Type, Rval) },
+ get_maybe_foreign_type_name(Type, MaybeForeign),
+ { Input = pragma_c_input(Name, Type, Rval, MaybeForeign) },
get_pragma_input_vars(Args, Inputs1, RestCode),
{ Inputs = [Input | Inputs1] },
{ Code = tree(FirstCode, RestCode) }
@@ -1187,6 +1189,27 @@
get_pragma_input_vars(Args, Inputs, Code)
).
+:- pred get_maybe_foreign_type_name((type)::in, maybe(string)::out,
+ code_info::in, code_info::out) is det.
+
+get_maybe_foreign_type_name(Type, MaybeForeignType) -->
+ code_info__get_module_info(Module),
+ { module_info_types(Module, Types) },
+ {
+ type_to_type_id(Type, TypeId, _SubTypes),
+ map__search(Types, TypeId, Defn),
+ hlds_data__get_type_defn_body(Defn, Body),
+ Body = foreign_type(_MaybeIL, MaybeC)
+ ->
+ ( MaybeC = yes(c(Name)),
+ MaybeForeignType = yes(Name)
+ ; MaybeC = no,
+ error("get_maybe_foreign_type_name: no c foreigm type")
+ )
+ ;
+ MaybeForeignType = no
+ }.
+
%---------------------------------------------------------------------------%
% pragma_acquire_regs acquires a list of registers in which to place each
@@ -1217,10 +1240,12 @@
code_info__release_reg(Reg),
( code_info__variable_is_forward_live(Var) ->
code_info__set_var_location(Var, Reg),
+ get_maybe_foreign_type_name(OrigType, MaybeForeign),
{
var_is_not_singleton(MaybeName, Name)
->
- PragmaCOutput = pragma_c_output(Reg, OrigType, Name),
+ PragmaCOutput = pragma_c_output(Reg, OrigType,
+ Name, MaybeForeign),
Outputs = [PragmaCOutput | Outputs0]
;
Outputs = Outputs0
@@ -1238,22 +1263,24 @@
% input_descs_from_arg_info returns a list of pragma_c_inputs, which
% are pairs of rvals and (C) variables which receive the input value.
-:- pred input_descs_from_arg_info(list(c_arg)::in, list(pragma_c_input)::out)
- is det.
+:- pred input_descs_from_arg_info(list(c_arg)::in, list(pragma_c_input)::out,
+ code_info::in, code_info::out) is det.
-input_descs_from_arg_info([], []).
-input_descs_from_arg_info([Arg | Args], Inputs) :-
+input_descs_from_arg_info([], [], CodeInfo, CodeInfo).
+input_descs_from_arg_info([Arg | Args], Inputs, CodeInfo0, CodeInfo) :-
Arg = c_arg(_Var, MaybeName, OrigType, ArgInfo),
(
var_is_not_singleton(MaybeName, Name)
->
ArgInfo = arg_info(N, _),
Reg = reg(r, N),
- Input = pragma_c_input(Name, OrigType, lval(Reg)),
+ get_maybe_foreign_type_name(OrigType, MaybeForeign,
+ CodeInfo0, CodeInfo1),
+ Input = pragma_c_input(Name, OrigType, lval(Reg), MaybeForeign),
Inputs = [Input | Inputs1],
- input_descs_from_arg_info(Args, Inputs1)
+ input_descs_from_arg_info(Args, Inputs1, CodeInfo1, CodeInfo)
;
- input_descs_from_arg_info(Args, Inputs)
+ input_descs_from_arg_info(Args, Inputs, CodeInfo0, CodeInfo)
).
%---------------------------------------------------------------------------%
@@ -1262,22 +1289,26 @@
% are pairs of names of output registers and (C) variables which hold the
% output value.
-:- pred output_descs_from_arg_info(list(c_arg)::in, list(pragma_c_output)::out)
- is det.
+:- pred output_descs_from_arg_info(list(c_arg)::in, list(pragma_c_output)::out,
+ code_info::in, code_info::out) is det.
-output_descs_from_arg_info([], []).
-output_descs_from_arg_info([Arg | Args], Outputs) :-
+output_descs_from_arg_info([], [], CodeInfo, CodeInfo).
+output_descs_from_arg_info([Arg | Args], Outputs, CodeInfo0, CodeInfo) :-
Arg = c_arg(_Var, MaybeName, OrigType, ArgInfo),
+ output_descs_from_arg_info(Args, Outputs0, CodeInfo0, CodeInfo1),
(
var_is_not_singleton(MaybeName, Name)
->
ArgInfo = arg_info(N, _),
Reg = reg(r, N),
- Outputs = [pragma_c_output(Reg, OrigType, Name) | Outputs0]
+ get_maybe_foreign_type_name(OrigType, MaybeForeign,
+ CodeInfo1, CodeInfo),
+ Outputs = [pragma_c_output(Reg, OrigType, Name, MaybeForeign) |
+ Outputs0]
;
- Outputs = Outputs0
- ),
- output_descs_from_arg_info(Args, Outputs0).
+ Outputs = Outputs0,
+ CodeInfo = CodeInfo1
+ ).
%---------------------------------------------------------------------------%
Index: compiler/prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.79
diff -u -r1.79 prog_data.m
--- compiler/prog_data.m 26 Feb 2002 02:45:49 -0000 1.79
+++ compiler/prog_data.m 5 Mar 2002 12:05:41 -0000
@@ -314,11 +314,12 @@
% for each of these cases.
%
-:- type ref_or_val
- ---> reference
- ; value.
-
:- type foreign_language_type
+ ---> il(il_foreign_type)
+ ; c(c_foreign_type)
+ .
+
+:- type il_foreign_type
---> il(
ref_or_val, % An indicator of whether the type is a
% reference of value type.
@@ -326,6 +327,15 @@
% assembly)
sym_name % The .NET type name
).
+
+:- type c_foreign_type
+ ---> c(
+ string % The C type name
+ ).
+
+:- type ref_or_val
+ ---> reference
+ ; value.
%
% Stuff for tabling pragmas
Index: compiler/prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.47
diff -u -r1.47 prog_io_pragma.m
--- compiler/prog_io_pragma.m 19 Feb 2002 09:48:21 -0000 1.47
+++ compiler/prog_io_pragma.m 5 Mar 2002 12:05:41 -0000
@@ -224,6 +224,19 @@
InputTerm)
)
;
+ Language = c
+ ->
+ (
+ InputTerm = term__functor(term__string(CTypeName),
+ [], _)
+ ->
+ Result = ok(c(c(CTypeName)))
+ ;
+ Result = error("invalid backend specification term",
+ InputTerm)
+ )
+ ;
+
Result = error("unsupported language specified, unable to parse backend type", InputTerm)
).
@@ -234,7 +247,7 @@
(
parse_special_il_type_name(String0, ForeignTypeResult)
->
- ForeignType = ok(ForeignTypeResult)
+ ForeignType = ok(il(ForeignTypeResult))
;
string__append("class [", String1, String0),
string__sub_string_search(String1, "]", Index)
@@ -242,7 +255,7 @@
string__left(String1, Index, AssemblyName),
string__split(String1, Index + 1, _, TypeNameStr),
string_to_sym_name(TypeNameStr, ".", TypeSymName),
- ForeignType = ok(il(reference, AssemblyName, TypeSymName))
+ ForeignType = ok(il(il(reference, AssemblyName, TypeSymName)))
;
string__append("valuetype [", String1, String0),
string__sub_string_search(String1, "]", Index)
@@ -250,7 +263,7 @@
string__left(String1, Index, AssemblyName),
string__split(String1, Index + 1, _, TypeNameStr),
string_to_sym_name(TypeNameStr, ".", TypeSymName),
- ForeignType = ok(il(value, AssemblyName, TypeSymName))
+ ForeignType = ok(il(il(value, AssemblyName, TypeSymName)))
;
ForeignType = error(
"invalid foreign language type description", ErrorTerm)
@@ -259,8 +272,7 @@
% Parse all the special assembler names for all the builtin types.
% See Parition I 'Built-In Types' (Section 8.2.2) for the list
% of all builtin types.
-:- pred parse_special_il_type_name(string::in,
- foreign_language_type::out) is semidet.
+:- pred parse_special_il_type_name(string::in, il_foreign_type::out) is semidet.
parse_special_il_type_name("bool", il(value, "mscorlib",
qualified(unqualified("System"), "Boolean"))).
Index: compiler/recompilation_usage.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/recompilation_usage.m,v
retrieving revision 1.5
diff -u -r1.5 recompilation_usage.m
--- compiler/recompilation_usage.m 26 Feb 2002 02:45:53 -0000 1.5
+++ compiler/recompilation_usage.m 5 Mar 2002 12:05:42 -0000
@@ -1024,7 +1024,7 @@
recompilation_usage__find_items_used_by_type_body(eqv_type(Type)) -->
recompilation_usage__find_items_used_by_type(Type).
recompilation_usage__find_items_used_by_type_body(abstract_type) --> [].
-recompilation_usage__find_items_used_by_type_body(foreign_type(_, _, _)) --> [].
+recompilation_usage__find_items_used_by_type_body(foreign_type(_, _)) --> [].
:- pred recompilation_usage__find_items_used_by_mode_defn(hlds_mode_defn::in,
recompilation_usage_info::in, recompilation_usage_info::out) is det.
Index: compiler/term_util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/term_util.m,v
retrieving revision 1.17
diff -u -r1.17 term_util.m
--- compiler/term_util.m 26 Feb 2002 02:45:53 -0000 1.17
+++ compiler/term_util.m 5 Mar 2002 12:05:42 -0000
@@ -267,7 +267,7 @@
Weights = Weights0
;
% This type does not introduce any functors
- TypeBody = foreign_type(_, _, _),
+ TypeBody = foreign_type(_, _),
Weights = Weights0
).
Index: compiler/type_ctor_info.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/type_ctor_info.m,v
retrieving revision 1.21
diff -u -r1.21 type_ctor_info.m
--- compiler/type_ctor_info.m 26 Feb 2002 02:45:54 -0000 1.21
+++ compiler/type_ctor_info.m 5 Mar 2002 12:05:43 -0000
@@ -252,7 +252,7 @@
TypeTables = [],
NumPtags = -1
;
- TypeBody = foreign_type(_, _, _),
+ TypeBody = foreign_type(_, _),
TypeCtorRep = unknown,
NumFunctors = -1,
FunctorsInfo = no_functors,
Index: compiler/unify_proc.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/unify_proc.m,v
retrieving revision 1.104
diff -u -r1.104 unify_proc.m
--- compiler/unify_proc.m 26 Feb 2002 02:45:54 -0000 1.104
+++ compiler/unify_proc.m 5 Mar 2002 12:05:43 -0000
@@ -755,7 +755,7 @@
unify_proc__quantify_clauses_body([H1, H2], Goal, Context,
Clauses)
;
- { TypeBody = foreign_type(_, _, _) },
+ { TypeBody = foreign_type(_, _) },
unify_proc__build_call("nyi_foreign_type_unify", [H1, H2],
Context, Goal),
unify_proc__quantify_clauses_body([H1, H2], Goal, Context,
@@ -811,7 +811,7 @@
% invoked.
{ error("trying to create index proc for eqv type") }
;
- { TypeBody = foreign_type(_, _, _) },
+ { TypeBody = foreign_type(_, _) },
{ error("trying to create index proc for a foreign type") }
;
{ TypeBody = abstract_type },
@@ -888,7 +888,7 @@
unify_proc__quantify_clauses_body([Res, H1, H2], Goal, Context,
Clauses)
;
- { TypeBody = foreign_type(_, _, _) },
+ { TypeBody = foreign_type(_, _) },
unify_proc__build_call("nyi_foreign_type_compare",
[Res, H1, H2], Context, Goal),
unify_proc__quantify_clauses_body([Res, H1, H2], Goal, Context,
Index: doc/reference_manual.texi
===================================================================
RCS file: /home/mercury1/repository/mercury/doc/reference_manual.texi,v
retrieving revision 1.242
diff -u -r1.242 reference_manual.texi
--- doc/reference_manual.texi 21 Feb 2002 14:20:44 -0000 1.242
+++ doc/reference_manual.texi 5 Mar 2002 12:05:48 -0000
@@ -5378,9 +5378,28 @@
@node Using pragma foreign_type for C
@subsubsection Using pragma foreign_type for C
-This pragma is currently not supported for C.
+The C @samp{pragma foreign_type} declaration is of the form:
-See the section on using C pointers (@pxref{Using C pointers}) for
+ at example
+:- pragma foreign_type(c, @var{MercuryTypeName}, @var{CForeignType}).
+ at end example
+
+The @var{CForeignType} can be any C type name that obeys the following
+restrictions.
+The type must fit into a machine word.
+The type must be contain no parts that would have to be output after a
+variable name in the generated C code.
+
+If the @var{MercuryTypeName} is the type of a parameter of a procedure
+defined using @samp{pragma foreign_proc},
+it will be passed to the foreign_proc's foreign language code
+as @var{CForeignType}.
+
+Furthermore, any Mercury procedure exported with @samp{pragma export}
+will use @var{CForeignType} as the type for any
+parameters whose Mercury type is @var{MercuryTypeName}.
+
+Also see the section on using C pointers (@pxref{Using C pointers}) for
information on how to use the c_pointer type with the C interface.
@c XXX we should eventually just move that section to here,
@c presenting it as an alternative to pragma foreign_type.
--------------------------------------------------------------------------
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