[m-rev.] Java: Foreign language interface support
Michael Wybrow
mjwybrow at cs.mu.OZ.AU
Mon Feb 10 14:49:28 AEDT 2003
Probably for review by Fergus.
I'll add the corresponding reference manual documentation as a seperate
change.
===================================================================
Estimated hours taken: 70
Branches: main
Add Java support to the foreign language interface.
mercury/compiler/compile_target_code.m:
mercury/compiler/make.module_target.m:
mercury/compiler/mercury_compile.m:
Pass `compile_java_file' a Java filename rather than a module name.
mercury/compiler/globals.m:
Add `java' as a `foreign_language'.
mercury/compiler/handle_options.m:
Allow Java as a back-end foreign language if the target language
is Java.
mercury/compiler/hlds_data.m:
Allow Java foreign_types.
mercury/compiler/intermod.m:
mercury/compiler/foreign.m:
mercury/compiler/make.util.m:
mercury/compiler/make_hlds.m:
mercury/compiler/mercury_compile.m:
mercury/compiler/mercury_to_mercury.m:
mercury/compiler/ml_code_gen.m:
mercury/compiler/mlds.m:
mercury/compiler/mlds_to_c.m:
mercury/compiler/mlds_to_il.m:
mercury/compiler/mlds_to_ilasm.m:
mercury/compiler/mlds_to_java.m:
mercury/compiler/pragma_c_gen.m:
mercury/compiler/prog_data.m:
mercury/compiler/prog_io_pragma.m:
Add or modify existing code to support `java' as a `foreign_language'
and Java `foreign_type's.
mercury/compiler/mlds_to_java.m:
Nicely indent the generated code that unboxes arguments from
return-argument arrays which are used for methods with multiple
return arguments.
Index: compile_target_code.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/compile_target_code.m,v
retrieving revision 1.36
diff -u -r1.36 compile_target_code.m
--- compile_target_code.m 5 Feb 2003 14:41:11 -0000 1.36
+++ compile_target_code.m 5 Feb 2003 22:36:30 -0000
@@ -45,8 +45,8 @@
bool, io__state, io__state).
:- mode assemble(in, in, in, out, di, uo) is det.
- % compile_java_file(ErrorStream, ModuleName, Succeeded).
-:- pred compile_java_file(io__output_stream, module_name, bool,
+ % compile_java_file(ErrorStream, JavaFile, Succeeded).
+:- pred compile_java_file(io__output_stream, string, bool,
io__state, io__state).
:- mode compile_java_file(in, in, out, di, uo) is det.
@@ -626,8 +626,7 @@
%-----------------------------------------------------------------------------%
-compile_java_file(ErrorStream, ModuleName, Succeeded) -->
- module_name_to_file_name(ModuleName, ".java", no, JavaFile),
+compile_java_file(ErrorStream, JavaFile, Succeeded) -->
globals__io_lookup_bool_option(verbose, Verbose),
maybe_write_string(Verbose, "% Compiling `"),
maybe_write_string(Verbose, JavaFile),
Index: foreign.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/foreign.m,v
retrieving revision 1.23
diff -u -r1.23 foreign.m
--- foreign.m 23 Dec 2002 12:32:56 -0000 1.23
+++ foreign.m 4 Feb 2003 04:32:32 -0000
@@ -343,6 +343,9 @@
extrude_pragma_implementation_2(c, il, _, _, _, _) :-
unimplemented_combination(c, il).
+extrude_pragma_implementation_2(c, java, _, _, _, _) :-
+ unimplemented_combination(c, java).
+
extrude_pragma_implementation_2(c, c, ModuleInfo, Impl, ModuleInfo, Impl).
@@ -360,6 +363,8 @@
extrude_pragma_implementation_2(managed_cplusplus, il, _, _, _, _) :-
unimplemented_combination(managed_cplusplus, il).
+extrude_pragma_implementation_2(managed_cplusplus, java, _, _, _, _) :-
+ unimplemented_combination(managed_cplusplus, java).
extrude_pragma_implementation_2(csharp, csharp,
@@ -374,6 +379,8 @@
extrude_pragma_implementation_2(csharp, il, _, _, _, _) :-
unimplemented_combination(csharp, il).
+extrude_pragma_implementation_2(csharp, java, _, _, _, _) :-
+ unimplemented_combination(csharp, java).
extrude_pragma_implementation_2(il, il,
ModuleInfo, Impl, ModuleInfo, Impl).
@@ -387,7 +394,24 @@
extrude_pragma_implementation_2(il, csharp, _, _, _, _) :-
unimplemented_combination(il, csharp).
+extrude_pragma_implementation_2(il, java, _, _, _, _) :-
+ unimplemented_combination(il, java).
+
+
+extrude_pragma_implementation_2(java, java,
+ ModuleInfo, Impl, ModuleInfo, Impl).
+
+extrude_pragma_implementation_2(java, c, _, _, _, _) :-
+ unimplemented_combination(java, c).
+extrude_pragma_implementation_2(java, managed_cplusplus, _, _, _, _) :-
+ unimplemented_combination(java, managed_cplusplus).
+
+extrude_pragma_implementation_2(java, csharp, _, _, _, _) :-
+ unimplemented_combination(java, csharp).
+
+extrude_pragma_implementation_2(java, il, _, _, _, _) :-
+ unimplemented_combination(java, il).
:- pred unimplemented_combination(foreign_language::in, foreign_language::in)
is erroneous.
@@ -411,6 +435,7 @@
make_pred_name_rest(managed_cplusplus, unqualified(Name)) = Name.
make_pred_name_rest(csharp, _SymName) = "some_csharp_name".
make_pred_name_rest(il, _SymName) = "some_il_name".
+make_pred_name_rest(java, _SymName) = "some_java_name".
make_pragma_import(PredInfo, ProcInfo, C_Function, Context,
@@ -589,15 +614,18 @@
foreign_language_string(managed_cplusplus) = "Managed C++".
foreign_language_string(csharp) = "C#".
foreign_language_string(il) = "IL".
+foreign_language_string(java) = "Java".
simple_foreign_language_string(c) = "c".
simple_foreign_language_string(managed_cplusplus) = "cpp". % XXX mcpp is better
simple_foreign_language_string(csharp) = "csharp".
simple_foreign_language_string(il) = "il".
+simple_foreign_language_string(java) = "java".
foreign_language_file_extension(c) = ".c".
foreign_language_file_extension(managed_cplusplus) = ".cpp".
foreign_language_file_extension(csharp) = ".cs".
+foreign_language_file_extension(java) = ".java".
foreign_language_file_extension(il) = _ :- fail.
foreign_language_module_name(M, L) = FM :-
@@ -630,7 +658,8 @@
map__search(Types, TypeCtor, TypeDefn)
->
hlds_data__get_type_defn_body(TypeDefn, Body),
- ( Body = foreign_type(foreign_type_body(MaybeIL, MaybeC)) ->
+ ( Body = foreign_type(foreign_type_body(MaybeIL, MaybeC,
+ MaybeJava)) ->
( Target = c,
( MaybeC = yes(c(NameStr)),
Name = unqualified(NameStr)
@@ -645,7 +674,12 @@
"to_exported_type: no IL type")
)
; Target = java,
- sorry(this_file, "to_exported_type for java")
+ ( MaybeJava = yes(java(NameStr)),
+ Name = unqualified(NameStr)
+ ; MaybeJava = no,
+ unexpected(this_file,
+ "to_exported_type: no Java type")
+ )
; Target = asm,
( MaybeC = yes(c(NameStr)),
Name = unqualified(NameStr)
@@ -680,6 +714,8 @@
sym_name_to_string(ForeignType, "::", Result).
to_type_string(il, foreign(ForeignType)) = Result :-
sym_name_to_string(ForeignType, ".", Result).
+to_type_string(java, 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 :-
@@ -706,6 +742,18 @@
).
to_type_string(il, mercury(_Type)) = _ :-
sorry(this_file, "to_type_string for il").
+to_type_string(java, mercury(Type)) = Result :-
+ ( Type = term__functor(term__atom("int"), [], _) ->
+ Result = "int"
+ ; Type = term__functor(term__atom("float"), [], _) ->
+ Result = "double"
+ ; Type = term__functor(term__atom("string"), [], _) ->
+ Result = "java.lang.String"
+ ; Type = term__functor(term__atom("character"), [], _) ->
+ Result = "char"
+ ;
+ Result = "java.lang.Object"
+ ).
%-----------------------------------------------------------------------------%
@@ -716,6 +764,8 @@
ModuleName = ForeignImportModule
; Lang = il,
ModuleName = ForeignImportModule
+ ; Lang = java,
+ ModuleName = ForeignImportModule
; Lang = managed_cplusplus,
ModuleName = foreign_language_module_name(ForeignImportModule,
Lang)
@@ -738,6 +788,9 @@
ImportedForeignCodeModuleName = handle_std_library(
CurrentModule, ImportedForeignCodeModuleName1)
; Lang = csharp,
+ ImportedForeignCodeModuleName = handle_std_library(
+ CurrentModule, ImportedForeignCodeModuleName1)
+ ; Lang = java,
ImportedForeignCodeModuleName = handle_std_library(
CurrentModule, ImportedForeignCodeModuleName1)
).
Index: globals.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/globals.m,v
retrieving revision 1.52
diff -u -r1.52 globals.m
--- globals.m 6 Nov 2002 06:38:16 -0000 1.52
+++ globals.m 21 Jan 2003 00:25:35 -0000
@@ -38,7 +38,7 @@
% ; cplusplus
; csharp
; managed_cplusplus
-% ; java
+ ; java
; il
.
@@ -246,6 +246,7 @@
convert_foreign_language_2("csharp", csharp).
convert_foreign_language_2("c sharp", csharp).
convert_foreign_language_2("il", il).
+convert_foreign_language_2("java", java).
convert_gc_method("none", none).
convert_gc_method("conservative", boehm).
Index: handle_options.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/handle_options.m,v
retrieving revision 1.167
diff -u -r1.167 handle_options.m
--- handle_options.m 5 Feb 2003 14:41:12 -0000 1.167
+++ handle_options.m 5 Feb 2003 22:36:30 -0000
@@ -1131,10 +1137,8 @@
% XXX This is wrong! It should be asm.
{ BackendForeignLanguages = ["c"] }
;
- % XXX We don't generate java or handle it as a foreign
- % language just yet, but if we did, we should fix this
{ Target = java },
- { BackendForeignLanguages = [] }
+ { BackendForeignLanguages = ["java"] }
),
% only set the backend foreign languages if they are unset
Index: hlds_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/hlds_data.m,v
retrieving revision 1.72
diff -u -r1.72 hlds_data.m
--- hlds_data.m 14 Jan 2003 16:42:26 -0000 1.72
+++ hlds_data.m 20 Jan 2003 01:56:25 -0000
@@ -324,7 +324,8 @@
:- type foreign_type_body
---> foreign_type_body(
il :: maybe(il_foreign_type),
- c :: maybe(c_foreign_type)
+ c :: maybe(c_foreign_type),
+ java :: maybe(java_foreign_type)
).
% The `cons_tag_values' type stores the information on how
Index: intermod.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/intermod.m,v
retrieving revision 1.127
diff -u -r1.127 intermod.m
--- intermod.m 27 Jan 2003 09:20:46 -0000 1.127
+++ intermod.m 28 Jan 2003 00:04:59 -0000
@@ -1203,7 +1203,8 @@
{ Body = foreign_type(ForeignTypeBody)
; Body = du_type(_, _, _, _, _, yes(ForeignTypeBody))
},
- { ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC) }
+ { ForeignTypeBody = foreign_type_body(MaybeIL, MaybeC,
+ MaybeJava) }
->
( { MaybeIL = yes(ILForeignType) },
mercury_output_item(pragma(
@@ -1219,6 +1220,14 @@
Name, Args)),
Context)
; { MaybeC = no },
+ []
+ ),
+ ( { MaybeJava = yes(JavaForeignType) },
+ mercury_output_item(pragma(
+ foreign_type(java(JavaForeignType), VarSet,
+ Name, Args)),
+ Context)
+ ; { MaybeJava = no },
[]
)
;
Index: make.module_target.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.module_target.m,v
retrieving revision 1.21
diff -u -r1.21 make.module_target.m
--- make.module_target.m 23 Jan 2003 00:24:05 -0000 1.21
+++ make.module_target.m 4 Feb 2003 05:38:20 -0000
@@ -379,8 +379,9 @@
compile_target_code__assemble(ErrorStream, PIC, ModuleName,
Succeeded).
build_object_code(ModuleName, java, _, ErrorStream, _Imports, Succeeded) -->
- compile_target_code__compile_java_file(ErrorStream,
- ModuleName, Succeeded).
+ module_name_to_file_name(ModuleName, ".java", no, JavaFile),
+ compile_target_code__compile_java_file(ErrorStream, JavaFile,
+ Succeeded).
build_object_code(ModuleName, il, _, ErrorStream, Imports, Succeeded) -->
compile_target_code__il_assemble(ErrorStream, ModuleName,
Imports ^ has_main, Succeeded).
@@ -397,6 +398,10 @@
foreign_code_file(il, ILFile, DLLFile), Succeeded) -->
compile_target_code__il_assemble(ErrorStream, ILFile, DLLFile,
no_main, Succeeded).
+compile_foreign_code_file(ErrorStream, _, _Imports,
+ foreign_code_file(java, JavaFile, _ClassFile), Succeeded) -->
+ compile_target_code__compile_java_file(ErrorStream, JavaFile,
+ Succeeded).
compile_foreign_code_file(ErrorStream, _, _Imports,
foreign_code_file(managed_cplusplus, MCPPFile, DLLFile),
Succeeded) -->
Index: make.util.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make.util.m,v
retrieving revision 1.12
diff -u -r1.12 make.util.m
--- make.util.m 23 Jan 2003 00:24:05 -0000 1.12
+++ make.util.m 23 Jan 2003 01:09:06 -0000
@@ -647,8 +647,16 @@
; PIC = non_pic
),
unexpected(this_file, "il foreign_object").
+target_extension(_, foreign_object(PIC, java)) = "bogus ext" :-
+ ( PIC = pic
+ ; PIC = link_with_pic
+ ; PIC = non_pic
+ ),
+ unexpected(this_file, "Java foreign_object").
target_extension(_, foreign_il_asm(c)) = "bogus ext" :-
unexpected(this_file, "C foreign_il_asm").
+target_extension(_, foreign_il_asm(java)) = "bogus ext" :-
+ unexpected(this_file, "Java foreign_il_asm").
target_extension(_, foreign_il_asm(csharp)) = ".dll".
target_extension(_, foreign_il_asm(managed_cplusplus)) = ".dll".
Index: make_hlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/make_hlds.m,v
retrieving revision 1.431
diff -u -r1.431 make_hlds.m
--- make_hlds.m 27 Jan 2003 09:20:46 -0000 1.431
+++ make_hlds.m 28 Jan 2003 00:05:00 -0000
@@ -953,9 +953,14 @@
add_pragma_foreign_type(Context, item_status(ImportStatus, NeedQual),
ForeignType, TVarSet, Name, Args, Module0, Module) -->
{ ForeignType = il(ILForeignType),
- Body = foreign_type(foreign_type_body(yes(ILForeignType), no))
+ Body = foreign_type(foreign_type_body(yes(ILForeignType),
+ no, no))
; ForeignType = c(CForeignType),
- Body = foreign_type(foreign_type_body(no, yes(CForeignType)))
+ Body = foreign_type(foreign_type_body(no, yes(CForeignType),
+ no))
+ ; ForeignType = java(JavaForeignType),
+ Body = foreign_type(foreign_type_body(no, no,
+ yes(JavaForeignType)))
},
{ Cond = true },
@@ -2406,8 +2411,7 @@
{ Target = c, LangStr = "C"
; Target = il, LangStr = "IL"
- % Foreign types aren't yet supported for Java.
- ; Target = java, LangStr = "Mercury"
+ ; Target = java, LangStr = "Java"
; Target = asm, LangStr = "C"
},
{ ErrorPieces = [
@@ -2435,7 +2439,8 @@
( ForeignTypeBody ^ c = yes(_) -> yes ; no )).
have_foreign_type_for_backend(il, ForeignTypeBody,
( ForeignTypeBody ^ il = yes(_) -> yes ; no )).
-have_foreign_type_for_backend(java, _, no).
+have_foreign_type_for_backend(java, ForeignTypeBody,
+ ( ForeignTypeBody ^ java = yes(_) -> yes ; no )).
have_foreign_type_for_backend(asm, ForeignTypeBody, Result) :-
have_foreign_type_for_backend(c, ForeignTypeBody, Result).
@@ -2475,7 +2480,7 @@
Body1 @ du_type(_, _, _, _, _, MaybeForeignTypeBody1), Body) :-
( MaybeForeignTypeBody1 = yes(ForeignTypeBody1)
; MaybeForeignTypeBody1 = no,
- ForeignTypeBody1 = foreign_type_body(no, no)
+ ForeignTypeBody1 = foreign_type_body(no, no, no)
),
merge_foreign_type_bodies_2(ForeignTypeBody0,
ForeignTypeBody1, ForeignTypeBody),
@@ -2498,11 +2503,12 @@
:- pred merge_foreign_type_bodies_2(foreign_type_body::in,
foreign_type_body::in, foreign_type_body::out) is semidet.
-merge_foreign_type_bodies_2(foreign_type_body(MaybeILA, MaybeCA),
- foreign_type_body(MaybeILB, MaybeCB),
- foreign_type_body(MaybeIL, MaybeC)) :-
+merge_foreign_type_bodies_2(foreign_type_body(MaybeILA, MaybeCA, MaybeJavaA),
+ foreign_type_body(MaybeILB, MaybeCB, MaybeJavaB),
+ foreign_type_body(MaybeIL, MaybeC, MaybeJava)) :-
merge_maybe(MaybeILA, MaybeILB, MaybeIL),
- merge_maybe(MaybeCA, MaybeCB, MaybeC).
+ merge_maybe(MaybeCA, MaybeCB, MaybeC),
+ merge_maybe(MaybeJavaA, MaybeJavaB, MaybeJava).
:- pred merge_maybe(maybe(T)::in, maybe(T)::in, maybe(T)::out) is semidet.
merge_maybe(no, no, no).
Index: mercury_compile.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_compile.m,v
retrieving revision 1.271
diff -u -r1.271 mercury_compile.m
--- mercury_compile.m 5 Feb 2003 14:41:12 -0000 1.271
+++ mercury_compile.m 5 Feb 2003 22:36:31 -0000
@@ -1196,8 +1196,10 @@
[]
;
io__output_stream(OutputStream),
+ module_name_to_file_name(ModuleName,
+ ".java", no, JavaFile),
compile_target_code__compile_java_file(
- OutputStream, ModuleName, Succeeded),
+ OutputStream, JavaFile, Succeeded),
maybe_set_exit_status(Succeeded)
)
; { Target = asm } ->
@@ -3435,6 +3437,10 @@
{ Lang = il },
{ error("sorry.
:- import_module not yet implemented: `:- pragma foreign_import_module' for IL") }
+ ;
+ { Lang = java },
+ { error("sorry.
+:- import_module not yet implemented: `:- pragma foreign_import_module' for Java") }
).
:- pred get_c_body_code(foreign_body_info, list(user_foreign_code)).
Index: mercury_to_mercury.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mercury_to_mercury.m,v
retrieving revision 1.223
diff -u -r1.223 mercury_to_mercury.m
--- mercury_to_mercury.m 17 Jan 2003 05:56:47 -0000 1.223
+++ mercury_to_mercury.m 20 Jan 2003 04:04:40 -0000
@@ -542,6 +542,8 @@
io__write_string("il, ")
; { ForeignType = c(_) },
io__write_string("c, ")
+ ; { ForeignType = java(_) },
+ io__write_string("java, ")
),
{ construct_qualified_term(MercuryTypeSymName,
MercuryTypeArgs, MercuryType) },
@@ -558,6 +560,7 @@
ForeignTypeStr = RefOrValStr ++ "[" ++ ForeignLocStr ++
"]" ++ NameStr
; ForeignType = c(c(ForeignTypeStr))
+ ; ForeignType = java(java(ForeignTypeStr))
},
io__write_string(ForeignTypeStr),
io__write_string("\").\n")
Index: ml_code_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/ml_code_gen.m,v
retrieving revision 1.122
diff -u -r1.122 ml_code_gen.m
--- ml_code_gen.m 23 Dec 2002 12:32:57 -0000 1.122
+++ ml_code_gen.m 5 Feb 2003 02:11:28 -0000
@@ -878,7 +878,7 @@
foreign_type_required_imports(c, _) = [].
foreign_type_required_imports(il, TypeDefn) = Imports :-
hlds_data__get_type_defn_body(TypeDefn, Body),
- ( Body = foreign_type(foreign_type_body(MaybeIL, _MaybeC)) ->
+ ( Body = foreign_type(foreign_type_body(MaybeIL, _MaybeC, _MaybeJava)) ->
( MaybeIL = yes(il(_, Location, _)) ->
Name = il_assembly_name(mercury_module_name_to_mlds(
unqualified(Location))),
@@ -2370,8 +2370,65 @@
ml_gen_ordinary_pragma_il_proc(CodeModel, Attributes,
PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
+ ; { Lang = java },
+ ml_gen_ordinary_pragma_java_proc(CodeModel, Attributes,
+ PredId, ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ Foreign_Code, Context, MLDS_Decls, MLDS_Statements)
).
+:- pred ml_gen_ordinary_pragma_java_proc(code_model::in,
+ pragma_foreign_proc_attributes::in,
+ pred_id::in, proc_id::in, list(prog_var)::in,
+ list(maybe(pair(string, mode)))::in, list(prog_type)::in,
+ string::in, prog_context::in, mlds__defns::out,
+ mlds__statements::out, ml_gen_info::in, ml_gen_info::out)
+ is det.
+
+ % For ordinary (not model_non) pragma foreign_code in Java.
+ %
+ml_gen_ordinary_pragma_java_proc(_CodeModel, Attributes,
+ _PredId, _ProcId, ArgVars, ArgDatas, OrigArgTypes,
+ JavaCode, Context, MLDS_Decls, MLDS_Statements) -->
+
+ { foreign_language(Attributes, Lang) },
+ %
+ % Combine all the information about the each arg
+ %
+ { ml_make_c_arg_list(ArgVars, ArgDatas, OrigArgTypes, ArgList) },
+ %
+ % Generate <declaration of one local variable for each arg>
+ %
+ ml_gen_pragma_c_decls(Lang, ArgList, ArgDeclsList),
+ %
+ % Generate code to set the values of the input variables.
+ %
+ ml_gen_pragma_c_input_arg_list(Lang, ArgList, AssignInputsList),
+ %
+ % Generate MLDS statements to assign the values of the output
+ % variables.
+ %
+ ml_gen_pragma_java_output_arg_list(Lang, ArgList, Context,
+ AssignOutputsList, ConvDecls, ConvStatements),
+ %
+ % Put it all together
+ %
+ { Java_Code = list__condense([
+ ArgDeclsList,
+ AssignInputsList,
+ [user_target_code(JavaCode, yes(Context), [])]
+ ]) },
+ { Java_Code_Stmt = inline_target_code(lang_java, Java_Code) },
+ { Java_Code_Statement = mlds__statement(
+ atomic(Java_Code_Stmt),
+ mlds__make_context(Context)) },
+ { MLDS_Statements = list__condense([
+ [Java_Code_Statement],
+ AssignOutputsList,
+ ConvStatements
+ ]) },
+ { MLDS_Decls = ConvDecls }.
+
+
:- pred ml_gen_ordinary_pragma_managed_proc(code_model,
pragma_foreign_proc_attributes,
pred_id, proc_id, list(prog_var),
@@ -2859,6 +2916,9 @@
list(maybe(pair(string, mode)))::in, list(prog_type)::in,
list(ml_c_arg)::out) is det.
+ % XXX Maybe this ought to be renamed as it works for, and
+ % is used by the Java back-end as well.
+ %
ml_make_c_arg_list(Vars, ArgDatas, Types, ArgList) :-
( Vars = [], ArgDatas = [], Types = [] ->
ArgList = []
@@ -2879,6 +2939,9 @@
list(target_code_component)::out,
ml_gen_info::in, ml_gen_info::out) is det.
+ % XXX Maybe this ought to be renamed as it works for, and
+ % is used by the Java back-end as well.
+ %
ml_gen_pragma_c_decls(_, [], []) --> [].
ml_gen_pragma_c_decls(Lang, [Arg|Args], [Decl|Decls]) -->
ml_gen_pragma_c_decl(Lang, Arg, Decl),
@@ -2932,6 +2995,9 @@
list(ml_c_arg)::in, list(target_code_component)::out,
ml_gen_info::in, ml_gen_info::out) is det.
+ % XXX Maybe this ought to be renamed as it works for, and
+ % is used by the Java back-end as well.
+ %
ml_gen_pragma_c_input_arg_list(Lang, ArgList, AssignInputs) -->
list__map_foldl(ml_gen_pragma_c_input_arg(Lang), ArgList,
AssignInputsList),
@@ -2974,7 +3040,10 @@
{ ExportedType = foreign__to_exported_type(ModuleInfo,
OrigType) },
{ TypeString = foreign__to_type_string(Lang, ExportedType) },
- ( { foreign__is_foreign_type(ExportedType) = yes } ->
+ (
+ { foreign__is_foreign_type(ExportedType) = yes },
+ { Lang \= java }
+ ->
% For foreign types,
% we need to call MR_MAYBE_UNBOX_FOREIGN_TYPE
{ AssignInput = [
@@ -3028,6 +3097,81 @@
% it can't be used, so we just ignore it
{ AssignInput = [] }
).
+
+:- pred ml_gen_pragma_java_output_arg_list(foreign_language::in,
+ list(ml_c_arg)::in, prog_context::in,
+ mlds__statements::out,
+ mlds__defns::out, mlds__statements::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_pragma_java_output_arg_list(_, [], _, [], [], []) --> [].
+ml_gen_pragma_java_output_arg_list(Lang, [Java_Arg | Java_Args], Context,
+ Statements, ConvDecls, ConvStatements) -->
+ ml_gen_pragma_java_output_arg(Lang, Java_Arg, Context, Statements1,
+ ConvDecls1, ConvStatements1),
+ ml_gen_pragma_java_output_arg_list(Lang, Java_Args, Context,
+ Statements2, ConvDecls2, ConvStatements2),
+ { Statements = Statements1 ++ Statements2 },
+ { ConvDecls = ConvDecls1 ++ ConvDecls2 },
+ { ConvStatements = ConvStatements1 ++ ConvStatements2 }.
+
+
+% ml_gen_pragma_java_output_arg generates MLDS statements to
+% assign the value of an output arg for a `pragma foreign_proc'
+% declaration.
+%
+:- pred ml_gen_pragma_java_output_arg(foreign_language::in,
+ ml_c_arg::in, prog_context::in,
+ mlds__statements::out,
+ mlds__defns::out, mlds__statements::out,
+ ml_gen_info::in, ml_gen_info::out) is det.
+
+ml_gen_pragma_java_output_arg(_Lang, ml_c_arg(Var, MaybeNameAndMode, OrigType),
+ Context, AssignOutput, ConvDecls, ConvOutputStatements) -->
+ =(MLDSGenInfo),
+ { ml_gen_info_get_module_info(MLDSGenInfo, ModuleInfo) },
+ (
+ { MaybeNameAndMode = yes(ArgName - Mode) },
+ { not var_is_singleton(ArgName) },
+ { not type_util__is_dummy_argument_type(OrigType) },
+ { mode_to_arg_mode(ModuleInfo, Mode, OrigType, top_out) }
+ ->
+ % Create a target lval with the right type for *internal*
+ % use in the code generated by the Mercury compiler's
+ % MLDS back-end.
+ ml_variable_type(Var, VarType),
+ ml_gen_var(Var, VarLval),
+ ml_gen_box_or_unbox_lval(VarType, OrigType, VarLval,
+ mlds__var_name(ArgName, no), Context, no, 0,
+ ArgLval, ConvDecls, _ConvInputStatements,
+ ConvOutputStatements),
+ % This is the MLDS type of the original argument, which
+ % we need to cast the local (Java) representation of
+ % the argument back to.
+ { MLDSType = mercury_type_to_mlds_type(ModuleInfo, OrigType) },
+ % Construct an MLDS lval for the local Java representation
+ % of the argument.
+ { module_info_name(ModuleInfo, ModuleName) },
+ { MLDSModuleName = mercury_module_name_to_mlds(ModuleName) },
+ { NonMangledVarName = mlds__var_name(ArgName, no) },
+ { QualLocalVarName = qual(MLDSModuleName, NonMangledVarName) },
+ % XXX MLDSType is the incorrect type for this variable.
+ % It should have the Java foreign language
+ % representation of that type. Unfortunately this
+ % is not easily expressed as an mlds__type.
+ { LocalVarLval = var(QualLocalVarName, MLDSType) },
+ % We cast this variable back to the corresponding
+ % MLDS type before assigning it to the lval
+ { Rval = unop(cast(MLDSType), lval(LocalVarLval)) },
+ { AssignOutput = [ml_gen_assign(ArgLval, Rval, Context)] }
+ ;
+ % if the variable doesn't occur in the ArgNames list,
+ % it can't be used, so we just ignore it
+ { AssignOutput = [] },
+ { ConvDecls = [] },
+ { ConvOutputStatements = [] }
+ ).
+
:- pred ml_gen_pragma_c_output_arg_list(foreign_language::in,
list(ml_c_arg)::in, prog_context::in,
Index: mlds.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds.m,v
retrieving revision 1.96
diff -u -r1.96 mlds.m
--- mlds.m 1 Jul 2002 09:03:52 -0000 1.96
+++ mlds.m 3 Feb 2003 06:06:12 -0000
@@ -1304,6 +1304,7 @@
; lang_C_minus_minus
; lang_asm
; lang_il
+ ; lang_java
; lang_java_asm
; lang_java_bytecode
.
@@ -1694,7 +1695,7 @@
module_info_types(ModuleInfo, Types),
map__search(Types, TypeCtor, TypeDefn),
hlds_data__get_type_defn_body(TypeDefn, Body),
- Body = foreign_type(foreign_type_body(MaybeIL, MaybeC))
+ Body = foreign_type(foreign_type_body(MaybeIL, MaybeC, MaybeJava))
->
module_info_globals(ModuleInfo, Globals),
globals__get_target(Globals, Target),
@@ -1717,7 +1718,14 @@
"mercury_type_to_mlds_type: No IL foreign type")
)
; Target = java,
- sorry(this_file, "foreign types on the java backend")
+ ( MaybeJava = yes(JavaForeignType),
+ ForeignType = java(JavaForeignType)
+ ; MaybeJava = no,
+ % This is checked by check_foreign_type
+ % in make_hlds.
+ unexpected(this_file,
+ "mercury_type_to_mlds_type: No Java foreign type")
+ )
; Target = asm,
( MaybeC = yes(CForeignType),
ForeignType = c(CForeignType)
Index: mlds_to_c.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_c.m,v
retrieving revision 1.141
diff -u -r1.141 mlds_to_c.m
--- mlds_to_c.m 24 Nov 2002 03:57:25 -0000 1.141
+++ mlds_to_c.m 20 Jan 2003 04:02:07 -0000
@@ -642,6 +642,8 @@
{ sorry(this_file, "foreign code other than C") }.
mlds_output_c_defn(_Indent, user_foreign_code(il, _, _)) -->
{ sorry(this_file, "foreign code other than C") }.
+mlds_output_c_defn(_Indent, user_foreign_code(java, _, _)) -->
+ { sorry(this_file, "foreign code other than C") }.
:- pred mlds_output_pragma_export_defn(mlds_module_name, indent,
mlds__pragma_export, io__state, io__state).
@@ -709,6 +711,9 @@
; { ForeignType = il(_) },
{ unexpected(this_file,
"mlds_output_type_prefix: il foreign_type") }
+ ; { ForeignType = java(_) },
+ { unexpected(this_file,
+ "mlds_output_type_prefix: java foreign_type") }
).
mlds_output_pragma_export_type(prefix, mlds__class_type(_, _, _)) -->
io__write_string("MR_Word").
Index: mlds_to_il.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_il.m,v
retrieving revision 1.124
diff -u -r1.124 mlds_to_il.m
--- mlds_to_il.m 10 Jan 2003 10:39:04 -0000 1.124
+++ mlds_to_il.m 20 Jan 2003 04:03:14 -0000
@@ -1911,6 +1911,8 @@
{ Instrs = inline_code_to_il_asm(Code) }.
atomic_statement_to_il(inline_target_code(lang_C, _Code), _Instrs) -->
{ unexpected(this_file, "lang_C") }.
+atomic_statement_to_il(inline_target_code(lang_java, _Code), _Instrs) -->
+ { unexpected(this_file, "lang_java") }.
atomic_statement_to_il(inline_target_code(lang_java_bytecode, _), _) -->
{ unexpected(this_file, "lang_java_bytecode") }.
atomic_statement_to_il(inline_target_code(lang_java_asm, _), _) -->
@@ -3031,6 +3033,8 @@
)
; ForeignType = c(_),
error("mlds_to_il: c foreign type")
+ ; ForeignType = java(_),
+ error("mlds_to_il: java foreign type")
).
mlds_type_to_ilds_type(ILDataRep, mlds__ptr_type(MLDSType)) =
Index: mlds_to_ilasm.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_ilasm.m,v
retrieving revision 1.19
diff -u -r1.19 mlds_to_ilasm.m
--- mlds_to_ilasm.m 29 Oct 2002 07:01:09 -0000 1.19
+++ mlds_to_ilasm.m 20 Jan 2003 04:03:21 -0000
@@ -96,6 +96,8 @@
sorry(this_file, "language C foreign code not supported").
handle_foreign_lang(il, _) :-
sorry(this_file, "language IL foreign code not supported").
+handle_foreign_lang(java, _) :-
+ sorry(this_file, "language Java foreign code not supported").
%
% Generate the `.il' file.
Index: mlds_to_java.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/mlds_to_java.m,v
retrieving revision 1.35
diff -u -r1.35 mlds_to_java.m
--- mlds_to_java.m 23 Jan 2003 04:26:36 -0000 1.35
+++ mlds_to_java.m 10 Feb 2003 03:17:14 -0000
@@ -20,13 +20,14 @@
% multidet and nondet predicates
% test tests/benchmarks/*.m
% generate optimized tailcalls
+% handle foreign code written in Java
+%
% TODO:
% General code cleanup
% handle static ground terms
% RTTI (requires static ground terms)
% generate names of classes etc. correctly (mostly same as IL backend)
%
-% handle foreign code written in Java
% handle foreign code written in C
%
% NOTES:
@@ -78,8 +79,9 @@
:- import_module backend_libs__builtin_ops.
:- import_module parse_tree__prog_data, parse_tree__prog_out.
:- import_module check_hlds__type_util, hlds__error_util.
+:- import_module backend_libs__foreign.
-:- import_module bool, int, string, library, list, set.
+:- import_module bool, int, string, library, list, map, set.
:- import_module assoc_list, term, std_util, require.
%-----------------------------------------------------------------------------%
@@ -363,7 +365,7 @@
%
% Run further transformations on the MLDS.
%
- { MLDS = mlds(ModuleName, _ForeignCode, Imports, Defns0) },
+ { MLDS = mlds(ModuleName, AllForeignCode, Imports, Defns0) },
{ MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName) },
%
% Find and build list of all methods which would have their addresses
@@ -376,13 +378,22 @@
%
{ generate_code_addr_wrappers(Indent + 1, CodeAddrs, [],
WrapperDefns) },
- { Defns = WrapperDefns ++ Defns0 },
+ { Defns = WrapperDefns ++ Defns0 },
+ %
+ % Get the foreign code for Java
+ %
+ { ForeignCode = mlds_get_java_foreign_code(AllForeignCode) },
+ { ForeignCode = mlds__foreign_code(RevForeignDecls, _RevImports,
+ _RevBodyCode, _ExportDefns) },
+ { ForeignDecls = list__reverse(RevForeignDecls) },
%
% Output transformed MLDS as Java source.
%
output_src_start(Indent, ModuleName, Imports, Defns),
{ list__filter(defn_is_rtti_data, Defns, _RttiDefns, NonRttiDefns) },
% XXX Need to output RTTI data at this point.
+ % Output Java foreign code declarations.
+ io__write_list(ForeignDecls, "\n", output_java_decl(Indent)),
{ CtorData = none }, % Not a constructor.
output_defns(Indent + 1, MLDS_ModuleName, CtorData, NonRttiDefns),
output_src_end(Indent, ModuleName).
@@ -390,6 +401,38 @@
%-----------------------------------------------------------------------------%
+%
+% Code for working with Java `foreign_code'.
+%
+
+:- pred output_java_decl(indent, foreign_decl_code, io__state, io__state).
+:- mode output_java_decl(in, in, di, uo) is det.
+
+output_java_decl(Indent, foreign_decl_code(Lang, Code, Context)) -->
+ % only output Java code
+ ( { Lang = java } ->
+ indent_line(make_context(Context), Indent),
+ io__write_string(Code), io__nl
+ ;
+ { sorry(this_file, "foreign code other than Java") }
+ ).
+
+
+:- func mlds_get_java_foreign_code(map(foreign_language, mlds__foreign_code))
+ = mlds__foreign_code.
+
+ % Get the foreign code for Java
+mlds_get_java_foreign_code(AllForeignCode) = ForeignCode :-
+ ( map__search(AllForeignCode, java, ForeignCode0) ->
+ ForeignCode = ForeignCode0
+ ;
+ % This can occur when compiling to a non-C target
+ % using "--mlds-dump all"
+ ForeignCode = foreign_code([], [], [], [])
+ ).
+
+
+%-----------------------------------------------------------------------------%
%
% Code to search MLDS for all uses of function pointers.
%
@@ -1274,9 +1317,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(_)) = _ :-
- unexpected(this_file,
- "get_type_initializer: variable has foreign_type").
+get_java_type_initializer(mlds__foreign_type(_)) = "null".
get_java_type_initializer(mlds__class_type(_, _, _)) = "null".
get_java_type_initializer(mlds__array_type(_)) = "null".
get_java_type_initializer(mlds__ptr_type(_)) = "null".
@@ -1633,7 +1674,15 @@
:- mode output_type(in, di, uo) is det.
output_type(mercury_type(Type, TypeCategory, _)) -->
- output_mercury_type(Type, TypeCategory).
+ ( { Type = c_pointer_type } ->
+ % The c_pointer type is used in the c back-end as a
+ % generic way to pass foreign types to automatically
+ % generated Compare and Unify code. When compiling to
+ % Java we must instead use java.lang.Object.
+ io__write_string("java.lang.Object")
+ ;
+ output_mercury_type(Type, TypeCategory)
+ ).
output_type(mercury_array_type(MLDSType)) -->
output_type(MLDSType),
@@ -1642,8 +1691,14 @@
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(_)) -->
- { unexpected(this_file, "output_type: foreign_type NYI.") }.
+output_type(mlds__foreign_type(ForeignType)) -->
+ ( { ForeignType = java(java(Name)) },
+ io__write_string(Name)
+ ; { ForeignType = c(_) },
+ { unexpected(this_file, "output_type: c foreign_type") }
+ ; { ForeignType = il(_) },
+ { unexpected(this_file, "output_type: il foreign_type") }
+ ).
output_type(mlds__class_type(Name, Arity, ClassKind)) -->
( { ClassKind = mlds__enum } ->
output_fully_qualified(Name, output_mangled_name, "."),
@@ -2235,10 +2290,14 @@
{ Params = mlds__func_params(_Args, ReturnTypes) },
{ TypesAndResults = assoc_list__from_corresponding_lists(
ReturnTypes, Results) },
- io__write_string("return new java.lang.Object[] { "),
- io__write_list(TypesAndResults, ",\n ",
+ io__write_string("return new java.lang.Object[] {\n"),
+ indent_line(Indent + 1),
+ { Separator = ",\n" ++ duplicate_char(' ', (Indent + 1) * 2) },
+ io__write_list(TypesAndResults, Separator,
(pred((Type - Result)::in, di, uo) is det -->
output_boxed_rval(Type, Result))),
+ io__write_string("\n"),
+ indent_line(Indent),
io__write_string("};\n")
),
{ ExitMethods = set__make_singleton_set(can_return) }.
@@ -2550,14 +2609,38 @@
%
% foreign language interfacing
%
-output_atomic_stmt(_Indent, _FuncInfo,
- inline_target_code(_TargetLang, _Components), _Context) -->
- { error("mlds_to_java.m: sorry, foreign language interfacing not implemented") }.
+output_atomic_stmt(Indent, _FuncInfo,
+ inline_target_code(TargetLang, Components), Context) -->
+ ( { TargetLang = lang_java } ->
+ indent_line(Indent),
+ list__foldl(output_target_code_component(Context), Components)
+ ;
+ { unexpected(this_file, "inline_target_code only works for lang_java") }
+ ).
output_atomic_stmt(_Indent, _FuncInfo,
outline_foreign_proc(_TargetLang, _Vs, _Lvals, _Code),
_Context) -->
- { error("mlds_to_java.m: sorry, foreign language interfacing not implemented") }.
+ { unexpected(this_file, "foreign language interfacing not implemented") }.
+
+%------------------------------------------------------------------------------%
+
+:- pred output_target_code_component(mlds__context, target_code_component,
+ io__state, io__state).
+:- mode output_target_code_component(in, in, di, uo) is det.
+
+output_target_code_component(_Context, user_target_code(CodeString,
+ _MaybeUserContext, _Attrs), !IO) :-
+ io__write_string(CodeString, !IO).
+output_target_code_component(_Context, raw_target_code(CodeString,
+ _Attrs), !IO) :-
+ io__write_string(CodeString, !IO).
+output_target_code_component(_Context, target_code_input(Rval), !IO) :-
+ output_rval(Rval, !IO).
+output_target_code_component(_Context, target_code_output(Lval), !IO) :-
+ output_lval(Lval, !IO).
+output_target_code_component(_Context, name(Name), !IO) :-
+ output_fully_qualified_name(Name, !IO).
%------------------------------------------------------------------------------%
Index: pragma_c_gen.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/pragma_c_gen.m,v
retrieving revision 1.53
diff -u -r1.53 pragma_c_gen.m
--- pragma_c_gen.m 30 Jun 2002 17:06:36 -0000 1.53
+++ pragma_c_gen.m 20 Jan 2003 02:27:01 -0000
@@ -1207,7 +1207,7 @@
type_to_ctor_and_args(Type, TypeId, _SubTypes),
map__search(Types, TypeId, Defn),
hlds_data__get_type_defn_body(Defn, Body),
- Body = foreign_type(foreign_type_body(_MaybeIL, MaybeC))
+ Body = foreign_type(foreign_type_body(_MaybeIL, MaybeC, _MaybeJava))
->
( MaybeC = yes(c(Name)),
MaybeForeignType = yes(Name)
Index: prog_data.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_data.m,v
retrieving revision 1.89
diff -u -r1.89 prog_data.m
--- prog_data.m 14 Jan 2003 16:42:29 -0000 1.89
+++ prog_data.m 20 Jan 2003 02:01:43 -0000
@@ -349,6 +349,7 @@
:- type foreign_language_type
---> il(il_foreign_type)
; c(c_foreign_type)
+ ; java(java_foreign_type)
.
:- type il_foreign_type
@@ -363,6 +364,11 @@
:- type c_foreign_type
---> c(
string % The C type name
+ ).
+
+:- type java_foreign_type
+ ---> java(
+ string % The Java type name
).
:- type ref_or_val
Index: prog_io_pragma.m
===================================================================
RCS file: /home/mercury1/repository/mercury/compiler/prog_io_pragma.m,v
retrieving revision 1.54
diff -u -r1.54 prog_io_pragma.m
--- prog_io_pragma.m 14 Jan 2003 16:42:29 -0000 1.54
+++ prog_io_pragma.m 20 Jan 2003 04:09:22 -0000
@@ -229,6 +229,18 @@
InputTerm)
)
;
+ Language = java
+ ->
+ (
+ InputTerm = term__functor(term__string(JavaTypeName),
+ [], _)
+ ->
+ Result = ok(java(java(JavaTypeName)))
+ ;
+ Result = error("invalid backend specification term",
+ InputTerm)
+ )
+ ;
Result = error("unsupported language specified, unable to parse backend type", InputTerm)
).
@@ -1261,6 +1273,7 @@
;
Res = ok(Attrs)
).
+check_required_attributes(java, Attrs, _Term) = ok(Attrs).
:- pred parse_pragma_foreign_proc_attributes_term0(term,
list(collected_pragma_foreign_proc_attribute)).
--------------------------------------------------------------------------
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