[m-rev.] for review: Allow external files to be included in foreign_decl and foreign_code.
Peter Wang
novalazy at gmail.com
Thu Mar 13 15:28:17 AEDT 2014
(diff -b)
Allow external files to be included in pragma foreign_decl and pragma
foreign_code declarations:
:- pragma foreign_decl("Lang", include_file("Path")).
:- pragma foreign_decl("Lang", local, include_file("Path")).
:- pragma foreign_code("Lang", include_file("Path")).
where Path may be an absolute path to a file or a path relative to the
directory that contains the source file of the module containing the
declaration.
mmc --make takes include_file into account when computing dependencies.
Mmake is unchanged yet.
compiler/prog_data.m:
Add types foreign_literal_or_include and foreign_include_file_info.
Rename "foreign_code" where "foreign_proc" is meant.
compiler/prog_foreign.m:
Use foreign_literal_or_include where we now want to allow include_file
directives.
compiler/prog_io_pragma.m:
Parse include_file forms of pragma foreign_decl and pragma
foreign_code declarations.
Rename "foreign_code" where "foreign_proc" is meant.
compiler/prog_io_typeclass.m:
Use foreign_literal_or_include where we want to allow include_file.
Make get_item_list_foreign_code return a list of foreign include
files.
Rename "foreign_code" where "foreign_proc" is meant.
compiler/file_names.m:
Add a convenience to get a module's source file name.
Add make_include_file_path.
Reorder a predicate.
compiler/file_util.m:
Add write_include_file_contents, a common predicate for copying
the contents of an included file into the output.
Make output_to_file catch and report exceptions from
write_include_file_contents, and return a success code.
compiler/export.m:
compiler/llds_out_file.m:
compiler/llds_out_util.m:
compiler/mercury_compile_llds_back_end.m:
Handle include_file directives when generating target code.
Make output_llds use output_to_file, and propagate its success code.
Conform to changes.
compiler/mercury_compile_mlds_back_end.m:
compiler/mlds_to_c.m:
compiler/mlds_to_cs.m:
compiler/mlds_to_ilasm.m:
compiler/mlds_to_java.m:
compiler/mlds_to_managed.m:
Handle include_file directives when generating target code.
Propagate success codes from output_to_file.
compiler/elds_to_erlang.m:
compiler/mercury_compile_erl_back_end.m:
Handle include_file directives when generating target code.
Propagate success code from output_to_file.
Fix a tiny bug: the "do not edit" comment names the .erl file
as the source file.
compiler/mercury_compile.m:
Take account of the success codes now returned by target code
generators, stopping on failure.
compiler/mercury_to_mercury.m:
Print out include_file directives.
compiler/module_imports.m:
Record in module_imports the list of included files.
compiler/make.dependencies.m:
Add files referenced by include_file directives as dependencies of
the module's compiled-code target.
compiler/make.module_dep_file.m:
Introduce .module_dep file format version 2, which has an additional
field: the list of included files that the module depends on.
Refactor the .module_dep file parsing code.
compiler/add_pragma.m:
compiler/add_solver.m:
compiler/coverage_profiling.m:
compiler/det_analysis.m:
compiler/erl_call_gen.m:
compiler/erl_code_gen.m:
compiler/foreign.m:
compiler/goal_util.m:
compiler/hlds_goal.m:
compiler/hlds_module.m:
compiler/hlds_out_goal.m:
compiler/intermod.m:
compiler/make_hlds_passes.m:
compiler/make_hlds_warn.m:
compiler/ml_code_gen.m:
compiler/modecheck_goal.m:
compiler/modules.m:
compiler/polymorphism.m:
compiler/pragma_c_gen.m:
compiler/prog_item.m:
compiler/typecheck.m:
compiler/unique_modes.m:
compiler/write_deps_file.m:
Conform to changes.
Rename "foreign_code" where "foreign_proc" is meant.
doc/reference_manual.texi:
Document include_file as a lanaguage extension.
tests/invalid/Mmakefile:
tests/invalid/foreign_include_file_missing.err_exp:
tests/invalid/foreign_include_file_missing.m:
tests/mmc_make/Mmakefile:
tests/mmc_make/inc/code.c:
tests/mmc_make/inc/code.cs:
tests/mmc_make/inc/code.erl:
tests/mmc_make/inc/code.java:
tests/mmc_make/inc/decl.cs:
tests/mmc_make/inc/decl.erl:
tests/mmc_make/inc/decl.h:
tests/mmc_make/inc/decl.java:
tests/mmc_make/include_file.exp:
tests/mmc_make/include_file.m:
Add test cases.
NEWS:
Announce the change.
---
diff --git a/NEWS b/NEWS
index bc6b8f6..c444d88 100644
--- a/NEWS
+++ b/NEWS
@@ -1,6 +1,11 @@
NEWS since Mercury 14.01
------------------------
+Changes to the Mercury language:
+
+* We have added an extension to include external files
+ in pragma foreign_decl and pragma foreign_code declarations.
+
Changes to the Mercury standard library:
* We have added the print_line and write_line family of predicates to the
diff --git a/compiler/add_pragma.m b/compiler/add_pragma.m
index e5219d6..3b631f0 100644
--- a/compiler/add_pragma.m
+++ b/compiler/add_pragma.m
@@ -482,8 +482,6 @@ add_pragma_foreign_export_2(Arity, PredTable, Origin, Lang, Name, PredId,
% Only add the foreign export if the specified language matches
% one of the foreign languages available for this backend.
%
-
-
module_info_get_globals(!.ModuleInfo, Globals),
globals.get_backend_foreign_languages(Globals, ForeignLanguages),
( list.member(Lang, ForeignLanguages) ->
@@ -2738,7 +2736,7 @@ create_tabling_statistics_pred(ProcId, Context, SimpleCallId, SingleProc,
Global = table_info_c_global_var_name(!.ModuleInfo, SimpleCallId,
ProcId),
StatsCode = "MR_get_tabling_stats(&" ++ Global ++ ", &Stats);",
- StatsImpl = fc_impl_ordinary(StatsCode, yes(Context)),
+ StatsImpl = fp_impl_ordinary(StatsCode, yes(Context)),
StatsPragmaFCInfo = pragma_info_foreign_proc(!.Attrs, StatsPredSymName,
pf_predicate, [Arg1, Arg2, Arg3], !.VarSet, InstVarSet, StatsImpl),
StatsPragma = pragma_foreign_proc(StatsPragmaFCInfo),
@@ -2822,7 +2820,7 @@ create_tabling_reset_pred(ProcId, Context, SimpleCallId, SingleProc,
IsTablingSupported = no,
ResetCode = ""
),
- ResetImpl = fc_impl_ordinary(ResetCode, yes(Context)),
+ ResetImpl = fp_impl_ordinary(ResetCode, yes(Context)),
ResetPragmaFCInfo = pragma_info_foreign_proc(!.Attrs, ResetPredSymName,
pf_predicate, [Arg1, Arg2], !.VarSet, InstVarSet, ResetImpl),
ResetPragma = pragma_foreign_proc(ResetPragmaFCInfo),
@@ -3240,7 +3238,7 @@ add_pragma_fact_table(FTInfo, Status, Context, !ModuleInfo, !Specs) :-
% Create foreign_decls to declare extern variables.
module_add_foreign_decl(lang_c, foreign_decl_is_local,
- C_HeaderCode, Context, !ModuleInfo),
+ literal(C_HeaderCode), Context, !ModuleInfo),
module_add_fact_table_file(FileName, !ModuleInfo),
@@ -3315,13 +3313,14 @@ add_fact_table_proc(ProcId, PrimaryProcId, ProcTable, SymName,
add_extra_attribute(refers_to_llds_stack, Attrs3, Attrs),
MaybeItemNumber = no,
FCInfo = pragma_info_foreign_proc(Attrs, SymName, PredOrFunc, PragmaVars,
- ProgVarSet, InstVarSet, fc_impl_ordinary(C_ProcCode, no)),
+ ProgVarSet, InstVarSet, fp_impl_ordinary(C_ProcCode, no)),
add_pragma_foreign_proc(FCInfo, Status, Context, MaybeItemNumber,
!ModuleInfo, !Specs),
( C_ExtraCode = "" ->
true
;
- module_add_foreign_body_code(lang_c, C_ExtraCode, Context, !ModuleInfo)
+ module_add_foreign_body_code(lang_c, literal(C_ExtraCode), Context,
+ !ModuleInfo)
),
% The C code for fact tables includes C labels; we cannot inline this code,
@@ -3359,7 +3358,7 @@ fact_table_pragma_vars(Vars0, Modes0, VarSet, PragmaVars0) :-
:- pred clauses_info_add_pragma_foreign_proc(purity::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
prog_varset::in, list(pragma_var)::in, list(mer_type)::in,
- pragma_foreign_code_impl::in, prog_context::in,
+ pragma_foreign_proc_impl::in, prog_context::in,
pred_or_func::in, sym_name::in, arity::in, pred_markers::in,
clauses_info::in, clauses_info::out, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
@@ -3396,7 +3395,7 @@ clauses_info_add_pragma_foreign_proc(Purity, Attributes0,
:- pred clauses_info_do_add_pragma_foreign_proc(purity::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
list(proc_id)::in, prog_varset::in, list(pragma_var)::in,
- list(mer_type)::in, pragma_foreign_code_impl::in, prog_context::in,
+ list(mer_type)::in, pragma_foreign_proc_impl::in, prog_context::in,
pred_or_func::in, sym_name::in, arity::in, pred_markers::in,
clauses_info::in, clauses_info::out, module_info::in, module_info::out,
list(error_spec)::in, list(error_spec)::out) is det.
diff --git a/compiler/add_solver.m b/compiler/add_solver.m
index f0d6aaa..52641c2 100644
--- a/compiler/add_solver.m
+++ b/compiler/add_solver.m
@@ -237,10 +237,10 @@ add_solver_type_clause_items(TypeSymName, TypeParams, SolverTypeDetails,
; Lang = lang_csharp
; Lang = lang_java
),
- Impl = fc_impl_ordinary("Y = X;", yes(Context))
+ Impl = fp_impl_ordinary("Y = X;", yes(Context))
;
Lang = lang_erlang,
- Impl = fc_impl_ordinary("Y = X", yes(Context))
+ Impl = fp_impl_ordinary("Y = X", yes(Context))
),
% The `func(in) = out(<i_ground>) is det' mode.
diff --git a/compiler/coverage_profiling.m b/compiler/coverage_profiling.m
index 87284c9..ca10974 100644
--- a/compiler/coverage_profiling.m
+++ b/compiler/coverage_profiling.m
@@ -1185,9 +1185,9 @@ make_coverage_point(CPOptions, CoveragePointInfo, Goals, !CoverageInfo) :-
UseCalls = no,
get_deep_profile_builtin_ppid(ModuleInfo, PredName, PredArity,
PredId, ProcId),
- coverage_point_ll_code(DataType, ForeignCallAttrs, ForeignCode),
+ coverage_point_ll_code(DataType, ForeignCallAttrs, ForeignProc),
CallGoalExpr = call_foreign_proc(ForeignCallAttrs, PredId, ProcId,
- ForeignArgVars, [], no, ForeignCode),
+ ForeignArgVars, [], no, ForeignProc),
NonLocals = set_of_var.list_to_set(ArgVars),
InstMapDelta = instmap_delta_from_assoc_list([]),
CallGoalInfo = impure_init_goal_info(NonLocals, InstMapDelta,
@@ -1242,9 +1242,9 @@ proc_static_cons_id(CoverageInfo, ProcStaticConsId) :-
% Returns a string containing the Low Level C code for a coverage point.
%
:- pred coverage_point_ll_code(coverage_data_type::in,
- pragma_foreign_proc_attributes::out, pragma_foreign_code_impl::out) is det.
+ pragma_foreign_proc_attributes::out, pragma_foreign_proc_impl::out) is det.
-coverage_point_ll_code(CoverageDataType, ForeignProcAttrs, ForeignCodeImpl) :-
+coverage_point_ll_code(CoverageDataType, ForeignProcAttrs, ForeignProcImpl) :-
some [!ForeignProcAttrs] (
% XXX When running this code in a parallel grade, the contention for
% the foreign code mutex may be very expensive. To improve this, we
@@ -1261,7 +1261,7 @@ coverage_point_ll_code(CoverageDataType, ForeignProcAttrs, ForeignCodeImpl) :-
!ForeignProcAttrs),
ForeignProcAttrs = !.ForeignProcAttrs
),
- ForeignCodeImpl = fc_impl_ordinary(Code, no),
+ ForeignProcImpl = fp_impl_ordinary(Code, no),
Code = coverage_point_ll_code(CoverageDataType).
:- func coverage_point_ll_code(coverage_data_type) = string.
diff --git a/compiler/det_analysis.m b/compiler/det_analysis.m
index 75ac381..122e7b2 100644
--- a/compiler/det_analysis.m
+++ b/compiler/det_analysis.m
@@ -1134,7 +1134,7 @@ det_infer_generic_call(GenericCall, CallDetism, GoalInfo,
).
:- pred det_infer_foreign_proc(pragma_foreign_proc_attributes::in,
- pred_id::in, proc_id::in, pragma_foreign_code_impl::in,
+ pred_id::in, proc_id::in, pragma_foreign_proc_impl::in,
hlds_goal_info::in, soln_context::in,
list(failing_context)::in, determinism::out, list(failing_context)::out,
det_info::in, det_info::out) is det.
diff --git a/compiler/elds_to_erlang.m b/compiler/elds_to_erlang.m
index c91151b..3a9b808 100644
--- a/compiler/elds_to_erlang.m
+++ b/compiler/elds_to_erlang.m
@@ -19,6 +19,7 @@
:- import_module erl_backend.elds.
:- import_module hlds.hlds_module.
+:- import_module bool.
:- import_module io.
%-----------------------------------------------------------------------------%
@@ -29,7 +30,8 @@
% and exported foreign_decls to the corresponding .hrl file.
% The file names are determined by the module name.
%
-:- pred output_elds(module_info::in, elds::in, io::di, io::uo) is det.
+:- pred output_elds(module_info::in, elds::in, bool::out, io::di, io::uo)
+ is det.
% Output a Erlang function definition to the current output stream.
% This is exported for debugging purposes.
@@ -56,7 +58,6 @@
:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_type.
-:- import_module bool.
:- import_module char.
:- import_module int.
:- import_module library.
@@ -71,20 +72,34 @@
%-----------------------------------------------------------------------------%
-output_elds(ModuleInfo, ELDS, !IO) :-
+output_elds(ModuleInfo, ELDS, Succeeded, !IO) :-
Name = ELDS ^ elds_name,
module_info_get_globals(ModuleInfo, Globals),
+ module_source_filename(Globals, Name, SourceFileName, !IO),
module_name_to_file_name(Globals, Name, ".erl", do_create_dirs,
- SourceFileName, !IO),
+ TargetFileName, !IO),
module_name_to_file_name(Globals, Name, ".hrl", do_create_dirs,
HeaderFileName, !IO),
- output_to_file(Globals, SourceFileName, output_erl_file(ModuleInfo, ELDS,
- SourceFileName), !IO),
+ output_to_file(Globals, TargetFileName,
+ output_erl_file(ModuleInfo, ELDS, SourceFileName),
+ TargetCodeSucceeded, !IO),
+ (
+ TargetCodeSucceeded = yes,
% Avoid updating the timestamp on the `.hrl' file if it hasn't changed.
TmpHeaderFileName = HeaderFileName ++ ".tmp",
- output_to_file(Globals, TmpHeaderFileName, output_hrl_file(Name, ELDS,
- SourceFileName), !IO),
- update_interface(Globals, HeaderFileName, !IO).
+ output_to_file(Globals, TmpHeaderFileName,
+ output_hrl_file(Name, ELDS, SourceFileName),
+ Succeeded, !IO),
+ (
+ Succeeded = yes,
+ update_interface(Globals, HeaderFileName, !IO)
+ ;
+ Succeeded = no
+ )
+ ;
+ TargetCodeSucceeded = no,
+ Succeeded = no
+ ).
:- pred output_erl_file(module_info::in, elds::in, string::in,
io::di, io::uo) is det.
@@ -119,7 +134,7 @@ output_erl_file(ModuleInfo, ELDS, SourceFileName, !IO) :-
set.fold(output_include_header_ann(Globals), Imports, !IO),
% Output foreign declarations.
- list.foldl(output_foreign_decl_code, ForeignDecls, !IO),
+ list.foldl(output_foreign_decl_code(SourceFileName), ForeignDecls, !IO),
% Write directives for mkinit_erl.
ErlangModuleNameStr = erlang_module_name_to_str(ModuleName),
@@ -146,7 +161,7 @@ output_erl_file(ModuleInfo, ELDS, SourceFileName, !IO) :-
io.write_string("% ENDINIT\n", !IO),
% Output foreign code written in Erlang.
- list.foldl(output_foreign_body_code, ForeignBodies, !IO),
+ list.foldl(output_foreign_body_code(SourceFileName), ForeignBodies, !IO),
% Output the main wrapper, if any.
(
@@ -390,20 +405,38 @@ output_include_header_ann(Globals, Import, !IO) :-
%-----------------------------------------------------------------------------%
-:- pred output_foreign_decl_code(foreign_decl_code::in, io::di, io::uo) is det.
+:- pred output_foreign_decl_code(string::in, foreign_decl_code::in,
+ io::di, io::uo) is det.
-output_foreign_decl_code(foreign_decl_code(_Lang, _IsLocal, Code, Context),
- !IO) :-
- output_file_directive(Context, !IO),
- io.write_string(Code, !IO),
- io.nl(!IO),
- reset_file_directive(!IO).
+output_foreign_decl_code(SourceFileName, ForeignDecl, !IO) :-
+ ForeignDecl = foreign_decl_code(_Lang, _IsLocal, LiteralOrInclude,
+ Context),
+ output_foreign_literal_or_include(SourceFileName, LiteralOrInclude,
+ Context, !IO).
+
+:- pred output_foreign_body_code(string::in, foreign_body_code::in,
+ io::di, io::uo) is det.
+
+output_foreign_body_code(SourceFileName, ForeignBody, !IO) :-
+ ForeignBody = foreign_body_code(_Lang, LiteralOrInclude, Context),
+ output_foreign_literal_or_include(SourceFileName, LiteralOrInclude,
+ Context, !IO).
-:- pred output_foreign_body_code(foreign_body_code::in, io::di, io::uo) is det.
+:- pred output_foreign_literal_or_include(string::in,
+ foreign_literal_or_include::in, context::in, io::di, io::uo) is det.
-output_foreign_body_code(foreign_body_code(_Lang, Code, Context), !IO) :-
+output_foreign_literal_or_include(SourceFileName, LiteralOrInclude, Context,
+ !IO) :-
+ (
+ LiteralOrInclude = literal(Code),
output_file_directive(Context, !IO),
- io.write_string(Code, !IO),
+ io.write_string(Code, !IO)
+ ;
+ LiteralOrInclude = include_file(IncludeFileName),
+ make_include_file_path(SourceFileName, IncludeFileName, IncludePath),
+ output_file_directive(context(IncludePath, 1), !IO),
+ write_include_file_contents(IncludePath, !IO)
+ ),
io.nl(!IO),
reset_file_directive(!IO).
@@ -1291,20 +1324,21 @@ output_hrl_file(ModuleName, ELDS, SourceFileName, !IO) :-
], !IO),
ForeignDecls = ELDS ^ elds_foreign_decls,
- list.foldl(output_exported_foreign_decl_code, ForeignDecls, !IO),
+ list.foldl(output_exported_foreign_decl_code(SourceFileName), ForeignDecls,
+ !IO),
io.write_string("-endif.\n", !IO).
-:- pred output_exported_foreign_decl_code(foreign_decl_code::in,
+:- pred output_exported_foreign_decl_code(string::in, foreign_decl_code::in,
io::di, io::uo) is det.
-output_exported_foreign_decl_code(ForeignDecl, !IO) :-
+output_exported_foreign_decl_code(SourceFileName, ForeignDecl, !IO) :-
IsLocal = ForeignDecl ^ fdecl_is_local,
(
IsLocal = foreign_decl_is_local
;
IsLocal = foreign_decl_is_exported,
- output_foreign_decl_code(ForeignDecl, !IO)
+ output_foreign_decl_code(SourceFileName, ForeignDecl, !IO)
).
%-----------------------------------------------------------------------------%
diff --git a/compiler/erl_call_gen.m b/compiler/erl_call_gen.m
index 75ea29c..b1d4249 100644
--- a/compiler/erl_call_gen.m
+++ b/compiler/erl_call_gen.m
@@ -70,10 +70,10 @@
:- pred erl_gen_cast(prog_context::in, prog_vars::in, maybe(elds_expr)::in,
elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
- % Generate ELDS code for a call to foreign code.
+ % Generate ELDS code for a call to foreign proc.
%
-:- pred erl_gen_foreign_code_call(list(foreign_arg)::in,
- maybe(trace_expr(trace_runtime))::in, pragma_foreign_code_impl::in,
+:- pred erl_gen_foreign_proc_call(list(foreign_arg)::in,
+ maybe(trace_expr(trace_runtime))::in, pragma_foreign_proc_impl::in,
code_model::in, prog_context::in, maybe(elds_expr)::in,
elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
@@ -525,7 +525,7 @@ std_binop_to_elds(compound_lt, elds.(<)).
%-----------------------------------------------------------------------------%
%
-% Code for foreign code calls
+% Code for foreign proc calls
%
% Currently dummy arguments do not exist at all. The writer of the foreign
@@ -537,10 +537,10 @@ std_binop_to_elds(compound_lt, elds.(<)).
% Materialising dummy input variables would not be a good idea unless
% unused variable warnings were switched off in the Erlang compiler.
-erl_gen_foreign_code_call(ForeignArgs, MaybeTraceRuntimeCond,
+erl_gen_foreign_proc_call(ForeignArgs, MaybeTraceRuntimeCond,
PragmaImpl, CodeModel, OuterContext, MaybeSuccessExpr, Statement,
!Info) :-
- PragmaImpl = fc_impl_ordinary(ForeignCode, MaybeContext),
+ PragmaImpl = fp_impl_ordinary(ForeignCode, MaybeContext),
(
MaybeTraceRuntimeCond = no,
(
@@ -549,7 +549,7 @@ erl_gen_foreign_code_call(ForeignArgs, MaybeTraceRuntimeCond,
MaybeContext = no,
Context = OuterContext
),
- erl_gen_ordinary_pragma_foreign_code(ForeignArgs, ForeignCode,
+ erl_gen_ordinary_pragma_foreign_proc(ForeignArgs, ForeignCode,
CodeModel, Context, MaybeSuccessExpr, Statement, !Info)
;
MaybeTraceRuntimeCond = yes(TraceRuntimeCond),
@@ -558,11 +558,11 @@ erl_gen_foreign_code_call(ForeignArgs, MaybeTraceRuntimeCond,
%-----------------------------------------------------------------------------%
-:- pred erl_gen_ordinary_pragma_foreign_code(list(foreign_arg)::in,
+:- pred erl_gen_ordinary_pragma_foreign_proc(list(foreign_arg)::in,
string::in, code_model::in, prog_context::in, maybe(elds_expr)::in,
elds_expr::out, erl_gen_info::in, erl_gen_info::out) is det.
-erl_gen_ordinary_pragma_foreign_code(ForeignArgs, ForeignCode,
+erl_gen_ordinary_pragma_foreign_proc(ForeignArgs, ForeignCode,
CodeModel, OuterContext, MaybeSuccessExpr, Statement, !Info) :-
%
% In the following, F<n> are input variables to the foreign code (with
diff --git a/compiler/erl_code_gen.m b/compiler/erl_code_gen.m
index 19eed87..5da43f9 100644
--- a/compiler/erl_code_gen.m
+++ b/compiler/erl_code_gen.m
@@ -716,7 +716,7 @@ erl_gen_goal_expr(GoalExpr, CodeModel, Detism, InstMap, Context,
;
GoalExpr = call_foreign_proc(_Attributes, _PredId, _ProcId,
Args, _ExtraArgs, MaybeTraceRuntimeCond, PragmaImpl),
- erl_gen_foreign_code_call(Args, MaybeTraceRuntimeCond, PragmaImpl,
+ erl_gen_foreign_proc_call(Args, MaybeTraceRuntimeCond, PragmaImpl,
CodeModel, Context, MaybeSuccessExpr, Statement, !Info)
;
GoalExpr = shorthand(_),
diff --git a/compiler/export.m b/compiler/export.m
index 45365f9..a8e5337 100644
--- a/compiler/export.m
+++ b/compiler/export.m
@@ -92,6 +92,7 @@
:- import_module hlds.hlds_llds.
:- import_module hlds.pred_table.
:- import_module libs.
+:- import_module libs.file_util.
:- import_module libs.globals.
:- import_module parse_tree.file_names.
:- import_module parse_tree.module_cmds.
@@ -735,8 +736,8 @@ produce_header_file(ModuleInfo, ForeignExportDecls, ModuleName, !IO) :-
"#ifndef ", decl_guard(ModuleName), "\n",
"#define ", decl_guard(ModuleName), "\n"], !IO),
list.foldl(output_exported_enum(ModuleInfo), ExportedEnums, !IO),
- list.foldl(output_foreign_decl(Globals, yes(foreign_decl_is_exported)),
- ForeignDecls, !IO),
+ list.foldl(output_foreign_decl(Globals, SourceFileName,
+ yes(foreign_decl_is_exported)), ForeignDecls, !IO),
io.write_string("\n#endif\n", !IO),
produce_header_file_2(C_ExportDecls, !IO),
@@ -787,11 +788,13 @@ produce_header_file_2([E | ExportedProcs], !IO) :-
),
produce_header_file_2(ExportedProcs, !IO).
-:- pred output_foreign_decl(globals::in, maybe(foreign_decl_is_local)::in,
- foreign_decl_code::in, io::di, io::uo) is det.
+:- pred output_foreign_decl(globals::in, string::in,
+ maybe(foreign_decl_is_local)::in, foreign_decl_code::in, io::di, io::uo)
+ is det.
-output_foreign_decl(Globals, MaybeDesiredIsLocal, DeclCode, !IO) :-
- DeclCode = foreign_decl_code(Lang, IsLocal, Code, Context),
+output_foreign_decl(Globals, SourceFileName, MaybeDesiredIsLocal, DeclCode,
+ !IO) :-
+ DeclCode = foreign_decl_code(Lang, IsLocal, LiteralOrInclude, Context),
(
Lang = lang_c,
(
@@ -801,16 +804,32 @@ output_foreign_decl(Globals, MaybeDesiredIsLocal, DeclCode, !IO) :-
DesiredIsLocal = IsLocal
)
->
- term.context_file(Context, File),
- term.context_line(Context, Line),
- c_util.set_line_num(Globals, File, Line, !IO),
- io.write_string(Code, !IO),
+ output_foreign_literal_or_include(Globals, SourceFileName,
+ LiteralOrInclude, Context, !IO),
io.nl(!IO),
c_util.reset_line_num(Globals, !IO)
;
true
).
+:- pred output_foreign_literal_or_include(globals::in, string::in,
+ foreign_literal_or_include::in, prog_context::in, io::di, io::uo) is det.
+
+output_foreign_literal_or_include(Globals, SourceFileName, LiteralOrInclude,
+ Context, !IO) :-
+ (
+ LiteralOrInclude = literal(Code),
+ term.context_file(Context, File),
+ term.context_line(Context, Line),
+ c_util.set_line_num(Globals, File, Line, !IO),
+ io.write_string(Code, !IO)
+ ;
+ LiteralOrInclude = include_file(IncludeFileName),
+ make_include_file_path(SourceFileName, IncludeFileName, IncludePath),
+ c_util.set_line_num(Globals, IncludePath, 1, !IO),
+ write_include_file_contents(IncludePath, !IO)
+ ).
+
%-----------------------------------------------------------------------------%
%
% Code for writing out foreign exported enumerations.
diff --git a/compiler/file_names.m b/compiler/file_names.m
index 9724662..87d7b38 100644
--- a/compiler/file_names.m
+++ b/compiler/file_names.m
@@ -41,6 +41,11 @@
---> do_create_dirs
; do_not_create_dirs.
+ % Return the file name of the Mercury source for the given module.
+ %
+:- pred module_source_filename(globals::in, module_name::in, file_name::out,
+ io::di, io::uo) is det.
+
% module_name_to_file_name(Globals, Module, Extension, Mkdir, FileName,
% !IO):
%
@@ -124,11 +129,19 @@
%
:- pred module_name_to_make_var_name(module_name::in, string::out) is det.
+%-----------------------------------------------------------------------------%
+
% Return the name of the directory containing Java `.class' files.
%
:- pred get_class_dir_name(globals::in, string::out) is det.
%-----------------------------------------------------------------------------%
+
+ % Convert an include_file reference to a filesystem path.
+ %
+:- pred make_include_file_path(string::in, string::in, string::out) is det.
+
+%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
:- implementation.
@@ -168,6 +181,10 @@ qualify_mercury_std_library_module_name(ModuleName) = QualModuleName :-
%-----------------------------------------------------------------------------%
+module_source_filename(Globals, ModuleName, SourceFileName, !IO) :-
+ module_name_to_file_name(Globals, ModuleName, ".m", do_not_create_dirs,
+ SourceFileName, !IO).
+
module_name_to_file_name(Globals, ModuleName, Ext, MkDir, FileName, !IO) :-
module_name_to_file_name_general(Globals, ModuleName, Ext,
do_not_search, MkDir, FileName, !IO).
@@ -489,23 +506,6 @@ make_file_name(Globals, SubDirNames, Search, MkDir, BaseName, Ext, FileName,
FileName = dir.relative_path_name_from_components(Components)
).
-get_class_dir_name(Globals, ClassDirName) :-
- globals.lookup_bool_option(Globals, use_grade_subdirs, UseGradeSubdirs),
- globals.lookup_bool_option(Globals, use_subdirs, UseSubdirs),
- (
- UseGradeSubdirs = yes
- ->
- grade_directory_component(Globals, Grade),
- globals.lookup_string_option(Globals, fullarch, FullArch),
- ClassDirName = "Mercury" / Grade / FullArch / "Mercury" / "classs"
- ;
- UseSubdirs = yes
- ->
- ClassDirName = "Mercury" / "classs"
- ;
- ClassDirName = "."
- ).
-
:- pred file_is_arch_or_grade_dependent(globals::in, string::in) is semidet.
file_is_arch_or_grade_dependent(_, Ext) :-
@@ -591,5 +591,36 @@ file_is_arch_or_grade_dependent_3(Globals, Ext) :-
).
%-----------------------------------------------------------------------------%
+
+get_class_dir_name(Globals, ClassDirName) :-
+ globals.lookup_bool_option(Globals, use_grade_subdirs, UseGradeSubdirs),
+ globals.lookup_bool_option(Globals, use_subdirs, UseSubdirs),
+ (
+ UseGradeSubdirs = yes
+ ->
+ grade_directory_component(Globals, Grade),
+ globals.lookup_string_option(Globals, fullarch, FullArch),
+ ClassDirName = "Mercury" / Grade / FullArch / "Mercury" / "classs"
+ ;
+ UseSubdirs = yes
+ ->
+ ClassDirName = "Mercury" / "classs"
+ ;
+ ClassDirName = "."
+ ).
+
+%-----------------------------------------------------------------------------%
+
+make_include_file_path(ModuleSourceFileName, OrigFileName, Path) :-
+ ( path_name_is_absolute(OrigFileName) ->
+ Path = OrigFileName
+ ;
+ % XXX This will throw an exception on Windows if OrigFileName is a path
+ % "X:foo", i.e. relative to the current directory on the X: drive.
+ % That seems a silly thing to write in a source file.
+ Path = dirname(ModuleSourceFileName) / OrigFileName
+ ).
+
+%-----------------------------------------------------------------------------%
:- end_module parse_tree.file_names.
%-----------------------------------------------------------------------------%
diff --git a/compiler/file_util.m b/compiler/file_util.m
index f8085c8..7a133b9 100644
--- a/compiler/file_util.m
+++ b/compiler/file_util.m
@@ -73,9 +73,10 @@
% Write to a given filename, giving appropriate status messages
% and error messages if the file cannot be opened.
+ % This will catch and report include_file_error exceptions.
%
:- pred output_to_file(globals::in, string::in,
- pred(io, io)::in(pred(di, uo) is det), io::di, io::uo) is det.
+ pred(io, io)::in(pred(di, uo) is det), bool::out, io::di, io::uo) is det.
% Same as output_to_file above, but allow the writing predicate
% to generate something, and if it succeeds, return its result.
@@ -84,6 +85,12 @@
pred(T, io, io)::in(pred(out, di, uo) is det),
maybe(T)::out, io::di, io::uo) is det.
+ % Write the contents of the given file into the current output stream.
+ % Throws include_file_error exceptions for errors relating to the
+ % include file.
+ %
+:- pred write_include_file_contents(string::in, io::di, io::uo) is det.
+
%-----------------------------------------------------------------------------%
% get_install_name_option(FileName, Option, !IO):
@@ -127,7 +134,12 @@
:- import_module libs.options.
:- import_module dir.
+:- import_module exception.
:- import_module string.
+:- import_module univ.
+
+:- type include_file_error
+ ---> include_file_error(string, string).
%-----------------------------------------------------------------------------%
@@ -230,9 +242,16 @@ make_path_name_noncanon(Dir, FileName, PathName) :-
%-----------------------------------------------------------------------------%
-output_to_file(Globals, FileName, Action, !IO) :-
+output_to_file(Globals, FileName, Action, Succeeded, !IO) :-
NewAction = (pred(0::out, di, uo) is det --> Action),
- output_to_file_return_result(Globals, FileName, NewAction, _Result, !IO).
+ output_to_file_return_result(Globals, FileName, NewAction, Result, !IO),
+ (
+ Result = yes(_),
+ Succeeded = yes
+ ;
+ Result = no,
+ Succeeded = no
+ ).
output_to_file_return_result(Globals, FileName, Action, Result, !IO) :-
globals.lookup_bool_option(Globals, verbose, Verbose),
@@ -244,14 +263,31 @@ output_to_file_return_result(Globals, FileName, Action, Result, !IO) :-
io.open_output(FileName, Res, !IO),
(
Res = ok(FileStream),
- io.set_output_stream(FileStream, OutputStream, !IO),
- Action(ActionResult, !IO),
- io.set_output_stream(OutputStream, _, !IO),
+ io.set_output_stream(FileStream, OrigOutputStream, !IO),
+ promise_equivalent_solutions [TryResult, !:IO] (
+ try_io(Action, TryResult, !IO)
+ ),
+ io.set_output_stream(OrigOutputStream, _, !IO),
io.close_output(FileStream, !IO),
maybe_write_string(Verbose, "% done.\n", !IO),
maybe_report_stats(Stats, !IO),
+ (
+ TryResult = succeeded(ActionResult),
Result = yes(ActionResult)
;
+ TryResult = exception(Univ),
+ ( univ_to_type(Univ, IncludeError) ->
+ IncludeError = include_file_error(IncludeFileName, Detail),
+ string.format("can't open `%s' for input: %s",
+ [s(IncludeFileName), s(Detail)], ErrorMessage),
+ maybe_write_string(Verbose, "\n", !IO),
+ report_error(ErrorMessage, !IO),
+ Result = no
+ ;
+ rethrow(TryResult)
+ )
+ )
+ ;
Res = error(_),
maybe_write_string(Verbose, "\n", !IO),
string.append_list(["can't open file `", FileName, "' for output."],
@@ -262,6 +298,70 @@ output_to_file_return_result(Globals, FileName, Action, Result, !IO) :-
%-----------------------------------------------------------------------------%
+write_include_file_contents(FileName, !IO) :-
+ FollowSymLinks = yes,
+ io.file_type(FollowSymLinks, FileName, MaybeType, !IO),
+ (
+ MaybeType = ok(Type),
+ ( possibly_regular_file(Type) ->
+ io.output_stream(OutputStream, !IO),
+ write_include_file_contents_2(OutputStream, FileName, !IO)
+ ;
+ throw(include_file_error(FileName, "Not a regular file"))
+ )
+ ;
+ MaybeType = error(Error),
+ Msg = string.remove_prefix_if_present("io.file_type failed: ",
+ io.error_message(Error)),
+ throw(include_file_error(FileName, Msg))
+ ).
+
+:- pred write_include_file_contents_2(io.output_stream::in, string::in,
+ io::di, io::uo) is det.
+
+write_include_file_contents_2(OutputStream, FileName, !IO) :-
+ io.open_input(FileName, OpenRes, !IO),
+ (
+ OpenRes = ok(InputStream),
+ promise_equivalent_solutions [TryResult, !:IO] (
+ try_io(copy_stream(OutputStream, InputStream), TryResult, !IO)
+ ),
+ io.close_input(InputStream, !IO),
+ (
+ TryResult = succeeded(ok)
+ ;
+ TryResult = succeeded(error(Error)),
+ throw(Error)
+ ;
+ TryResult = exception(_),
+ rethrow(TryResult)
+ )
+ ;
+ OpenRes = error(Error),
+ throw(include_file_error(FileName, io.error_message(Error)))
+ ).
+
+:- pred copy_stream(io.output_stream::in,
+ io.input_stream::in, io.res::out, io::di, io::uo) is det.
+
+copy_stream(OutputStream, InputStream, Res, !IO) :-
+ io.read_file_as_string(InputStream, ReadRes, !IO),
+ (
+ ReadRes = ok(InputContents),
+ io.write_string(OutputStream, InputContents, !IO),
+ Res = ok
+ ;
+ ReadRes = error(_Partial, Error),
+ Res = error(Error)
+ ).
+
+:- pred possibly_regular_file(io.file_type::in) is semidet.
+
+possibly_regular_file(regular_file).
+possibly_regular_file(unknown).
+
+%-----------------------------------------------------------------------------%
+
% Changes to the following predicate may require similar changes to
% make.program_target.install_library_grade_files/9.
diff --git a/compiler/foreign.m b/compiler/foreign.m
index 3e0f0dd..1e7ed91 100644
--- a/compiler/foreign.m
+++ b/compiler/foreign.m
@@ -136,7 +136,7 @@
list(pragma_var)::in, sym_name::in, pred_or_func::in, prog_context::in,
module_info::in, module_info::out,
pragma_foreign_proc_attributes::in, pragma_foreign_proc_attributes::out,
- pragma_foreign_code_impl::in, pragma_foreign_code_impl::out) is det.
+ pragma_foreign_proc_impl::in, pragma_foreign_proc_impl::out) is det.
% The name of the #define which can be used to guard declarations with
% to prevent entities being declared twice.
@@ -215,7 +215,7 @@ extrude_pragma_implementation([TargetLang | TargetLangs], _PragmaVars,
:- pred extrude_pragma_implementation_2(
foreign_language::in, foreign_language::in,
module_info::in, module_info::out,
- pragma_foreign_code_impl::in, pragma_foreign_code_impl::out) is det.
+ pragma_foreign_proc_impl::in, pragma_foreign_proc_impl::out) is det.
% This isn't finished yet, and we probably won't implement it for C
% calling MC++. For C calling normal C++ we would generate a proxy
diff --git a/compiler/goal_util.m b/compiler/goal_util.m
index 8cddae4..c624432 100644
--- a/compiler/goal_util.m
+++ b/compiler/goal_util.m
@@ -392,7 +392,7 @@
%-----------------------------------------------------------------------------%
-:- pred foreign_code_uses_variable(pragma_foreign_code_impl::in, string::in)
+:- pred foreign_proc_uses_variable(pragma_foreign_proc_impl::in, string::in)
is semidet.
%-----------------------------------------------------------------------------%
@@ -1698,7 +1698,7 @@ generate_foreign_proc(ModuleName, ProcName, PredOrFunc, ModeNo, Detism,
PredOrFunc, Arity, ModeNo, PredId, ProcId),
GoalExpr = call_foreign_proc(Attributes, PredId, ProcId, Args, ExtraArgs,
- MaybeTraceRuntimeCond, fc_impl_ordinary(Code, no)),
+ MaybeTraceRuntimeCond, fp_impl_ordinary(Code, no)),
ArgVars = list.map(foreign_arg_var, Args),
ExtraArgVars = list.map(foreign_arg_var, ExtraArgs),
Vars = ArgVars ++ ExtraArgVars,
@@ -1793,8 +1793,8 @@ goal_is_atomic(Goal, GoalIsAtomic) :-
%-----------------------------------------------------------------------------%
-foreign_code_uses_variable(Impl, VarName) :-
- Impl = fc_impl_ordinary(ForeignBody, _),
+foreign_proc_uses_variable(Impl, VarName) :-
+ Impl = fp_impl_ordinary(ForeignBody, _),
string.sub_string_search(ForeignBody, VarName, _).
%-----------------------------------------------------------------------------%
diff --git a/compiler/hlds_goal.m b/compiler/hlds_goal.m
index e726df1..cdb95da 100644
--- a/compiler/hlds_goal.m
+++ b/compiler/hlds_goal.m
@@ -151,12 +151,12 @@
% If set to yes(Cond), then this goal represents the evaluation
% of the runtime condition of a trace goal. In that case,
% the goal must be semidet, and the argument lists empty;
- % the actual code in pragma_foreign_code_impl is ignored
+ % the actual code in pragma_foreign_proc_impl is ignored
% and replaced by the evaluation of Cond.
foreign_trace_cond :: maybe(trace_expr(trace_runtime)),
% The actual code of the foreign_proc.
- foreign_impl :: pragma_foreign_code_impl
+ foreign_impl :: pragma_foreign_proc_impl
)
; conj(conj_type, list(hlds_goal))
diff --git a/compiler/hlds_module.m b/compiler/hlds_module.m
index d1d841d..cf7f3e3 100644
--- a/compiler/hlds_module.m
+++ b/compiler/hlds_module.m
@@ -385,12 +385,13 @@
module_info::in, module_info::out) is det.
:- pred module_add_foreign_decl(foreign_language::in,
- foreign_decl_is_local::in, string::in, prog_context::in,
- module_info::in, module_info::out) is det.
-
-:- pred module_add_foreign_body_code(foreign_language::in, string::in,
+ foreign_decl_is_local::in, foreign_literal_or_include::in,
prog_context::in, module_info::in, module_info::out) is det.
+:- pred module_add_foreign_body_code(foreign_language::in,
+ foreign_literal_or_include::in, prog_context::in,
+ module_info::in, module_info::out) is det.
+
:- pred module_add_foreign_import_module(foreign_language::in, module_name::in,
prog_context::in, module_info::in, module_info::out) is det.
diff --git a/compiler/hlds_out_goal.m b/compiler/hlds_out_goal.m
index 8935973..74f7143 100644
--- a/compiler/hlds_out_goal.m
+++ b/compiler/hlds_out_goal.m
@@ -1528,9 +1528,9 @@ write_goal_foreign_proc(_Info, GoalExpr, ModuleInfo, VarSet,
!IO),
io.write_string("},\n", !IO)
),
- PragmaCode = fc_impl_ordinary(C_Code, _),
+ PragmaCode = fp_impl_ordinary(Code, _),
io.write_string("""", !IO),
- io.write_string(C_Code, !IO),
+ io.write_string(Code, !IO),
io.write_string("""", !IO),
io.write_string(")", !IO),
io.write_string(Follow, !IO).
diff --git a/compiler/intermod.m b/compiler/intermod.m
index 5118f22..74243a0 100644
--- a/compiler/intermod.m
+++ b/compiler/intermod.m
@@ -1844,7 +1844,7 @@ intermod_write_clause(OutInfo, ModuleInfo, PredId, VarSet, HeadVars,
).
:- pred intermod_write_foreign_clause(proc_table::in, pred_or_func::in,
- pragma_foreign_code_impl::in, pragma_foreign_proc_attributes::in,
+ pragma_foreign_proc_impl::in, pragma_foreign_proc_attributes::in,
list(foreign_arg)::in, prog_varset::in, sym_name::in, proc_id::in,
io::di, io::uo) is det.
diff --git a/compiler/llds_out_file.m b/compiler/llds_out_file.m
index 2282ca2..fb6962c 100644
--- a/compiler/llds_out_file.m
+++ b/compiler/llds_out_file.m
@@ -28,7 +28,8 @@
% Given a c_file structure, output the LLDS code inside it into a .c file.
%
-:- pred output_llds(globals::in, c_file::in, io::di, io::uo) is det.
+:- pred output_llds(globals::in, c_file::in, bool::out, io::di, io::uo)
+ is det.
%----------------------------------------------------------------------------%
@@ -70,6 +71,7 @@
:- import_module backend_libs.rtti.
:- import_module hlds.hlds_module.
:- import_module hlds.hlds_pred.
+:- import_module libs.file_util.
:- import_module libs.options.
:- import_module libs.trace_params.
:- import_module ll_backend.exprn_aux.
@@ -83,6 +85,7 @@
:- import_module ll_backend.rtti_out.
:- import_module mdbcomp.prim_data.
:- import_module parse_tree.file_names.
+:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_out.
@@ -98,60 +101,27 @@
:- import_module set.
:- import_module set_tree234.
:- import_module string.
+:- import_module term.
%----------------------------------------------------------------------------%
-output_llds(Globals, CFile, !IO) :-
+output_llds(Globals, CFile, Succeeded, !IO) :-
ModuleName = CFile ^ cfile_modulename,
module_name_to_file_name(Globals, ModuleName, ".c", do_create_dirs,
FileName, !IO),
- io.open_output(FileName, Result, !IO),
- (
- Result = ok(FileStream),
- decl_set_init(DeclSet0),
- output_single_c_file(Globals, CFile, FileStream, DeclSet0, _, !IO),
- io.close_output(FileStream, !IO)
- ;
- Result = error(Error),
- io.progname_base("llds.m", ProgName, !IO),
- io.format("\n%s: can't open `%s' for output:\n%s\n",
- [s(ProgName), s(FileName), s(io.error_message(Error))], !IO),
- io.set_exit_status(1, !IO)
- ).
+ output_to_file(Globals, FileName, output_llds_2(Globals, CFile),
+ Succeeded, !IO).
-:- pred output_c_file_mercury_headers(llds_out_info::in,
- io::di, io::uo) is det.
+:- pred output_llds_2(globals::in, c_file::in, io::di, io::uo) is det.
-output_c_file_mercury_headers(Info, !IO) :-
- io.write_string("#define MR_ALLOW_RESET\n", !IO),
- io.write_string("#include ""mercury_imp.h""\n", !IO),
- TraceLevel = Info ^ lout_trace_level,
- TraceLevelIsNone = given_trace_level_is_none(TraceLevel),
- (
- TraceLevelIsNone = no,
- io.write_string("#include ""mercury_trace_base.h""\n", !IO)
- ;
- TraceLevelIsNone = yes
- ),
- DeepProfile = Info ^ lout_profile_deep,
- (
- DeepProfile = yes,
- io.write_string("#include ""mercury_deep_profiling.h""\n", !IO)
- ;
- DeepProfile = no
- ),
- GenerateBytecode = Info ^ lout_generate_bytecode,
- (
- GenerateBytecode = yes,
- io.write_string("#include ""mb_interface_stub.h""\n", !IO)
- ;
- GenerateBytecode = no
- ).
+output_llds_2(Globals, CFile, !IO) :-
+ decl_set_init(DeclSet0),
+ output_single_c_file(Globals, CFile, DeclSet0, _, !IO).
-:- pred output_single_c_file(globals::in, c_file::in, io.output_stream::in,
+:- pred output_single_c_file(globals::in, c_file::in,
decl_set::in, decl_set::out, io::di, io::uo) is det.
-output_single_c_file(Globals, CFile, FileStream, !DeclSet, !IO) :-
+output_single_c_file(Globals, CFile, !DeclSet, !IO) :-
CFile = c_file(ModuleName, C_HeaderLines, UserForeignCode, Exports,
TablingInfoStructs, ScalarCommonDatas, VectorCommonDatas,
RttiDatas, PseudoTypeInfos, HLDSVarNums, ShortLocns, LongLocns,
@@ -164,15 +134,13 @@ output_single_c_file(Globals, CFile, FileStream, !DeclSet, !IO) :-
ProcLayoutDatas, ModuleLayoutDatas, ClosureLayoutDatas,
AllocSites, AllocSiteMap,
Modules, UserInitPredCNames, UserFinalPredCNames, ComplexityProcs),
- Info = init_llds_out_info(ModuleName, Globals,
- InternalLabelToLayoutMap, EntryLabelToLayoutMap, TableIoDeclMap,
- AllocSiteMap),
library.version(Version),
- io.set_output_stream(FileStream, OutputStream, !IO),
- module_name_to_file_name(Globals, ModuleName, ".m", do_not_create_dirs,
- SourceFileName, !IO),
+ module_source_filename(Globals, ModuleName, SourceFileName, !IO),
output_c_file_intro_and_grade(Globals, SourceFileName, Version, !IO),
+ Info = init_llds_out_info(ModuleName, SourceFileName, Globals,
+ InternalLabelToLayoutMap, EntryLabelToLayoutMap, TableIoDeclMap,
+ AllocSiteMap),
annotate_c_modules(Info, Modules, AnnotatedModules,
cord.init, EntryLabelsCord, cord.init, InternalLabelsCord,
set.init, EnvVarNameSet),
@@ -235,8 +203,38 @@ output_single_c_file(Globals, CFile, FileStream, !DeclSet, !IO) :-
io.write_string("\n", !IO),
output_c_module_init_list(Info, ModuleName, AnnotatedModules, RttiDatas,
ProcLayoutDatas, ModuleLayoutDatas, ComplexityProcs, TSStringTable,
- AllocSites, UserInitPredCNames, UserFinalPredCNames, !DeclSet, !IO),
- io.set_output_stream(OutputStream, _, !IO).
+ AllocSites, UserInitPredCNames, UserFinalPredCNames, !DeclSet, !IO).
+
+%-----------------------------------------------------------------------------%
+
+:- pred output_c_file_mercury_headers(llds_out_info::in,
+ io::di, io::uo) is det.
+
+output_c_file_mercury_headers(Info, !IO) :-
+ io.write_string("#define MR_ALLOW_RESET\n", !IO),
+ io.write_string("#include ""mercury_imp.h""\n", !IO),
+ TraceLevel = Info ^ lout_trace_level,
+ TraceLevelIsNone = given_trace_level_is_none(TraceLevel),
+ (
+ TraceLevelIsNone = no,
+ io.write_string("#include ""mercury_trace_base.h""\n", !IO)
+ ;
+ TraceLevelIsNone = yes
+ ),
+ DeepProfile = Info ^ lout_profile_deep,
+ (
+ DeepProfile = yes,
+ io.write_string("#include ""mercury_deep_profiling.h""\n", !IO)
+ ;
+ DeepProfile = no
+ ),
+ GenerateBytecode = Info ^ lout_generate_bytecode,
+ (
+ GenerateBytecode = yes,
+ io.write_string("#include ""mb_interface_stub.h""\n", !IO)
+ ;
+ GenerateBytecode = no
+ ).
%----------------------------------------------------------------------------%
@@ -870,25 +868,11 @@ output_static_linkage_define(!IO) :-
io::di, io::uo) is det.
output_user_foreign_code(Info, UserForeignCode, !IO) :-
- UserForeignCode = user_foreign_code(Lang, Foreign_Code, Context),
+ UserForeignCode = user_foreign_code(Lang, LiteralOrInclude, Context),
(
Lang = lang_c,
- AutoComments = Info ^ lout_auto_comments,
- LineNumbers = Info ^ lout_line_numbers,
- (
- AutoComments = yes,
- LineNumbers = yes
- ->
- io.write_string("/* ", !IO),
- prog_out.write_context(Context, !IO),
- io.write_string(" pragma foreign_code */\n", !IO)
- ;
- true
- ),
- output_set_line_num(Info, Context, !IO),
- io.write_string(Foreign_Code, !IO),
- io.write_string("\n", !IO),
- output_reset_line_num(Info, !IO)
+ output_foreign_decl_or_code(Info, "foreign_code", Lang,
+ LiteralOrInclude, Context, !IO)
;
( Lang = lang_java
; Lang = lang_csharp
@@ -907,17 +891,37 @@ output_foreign_header_include_lines(Info, Decls, !IO) :-
set.init, _, !IO).
:- pred output_foreign_header_include_line(llds_out_info::in,
- foreign_decl_code::in, set(string)::in, set(string)::out,
+ foreign_decl_code::in,
+ set(foreign_literal_or_include)::in, set(foreign_literal_or_include)::out,
io::di, io::uo) is det.
output_foreign_header_include_line(Info, Decl, !AlreadyDone, !IO) :-
- Decl = foreign_decl_code(Lang, _IsLocal, Code, Context),
+ Decl = foreign_decl_code(Lang, _IsLocal, LiteralOrInclude, Context),
(
Lang = lang_c,
- ( set.member(Code, !.AlreadyDone) ->
+ % This will not deduplicate the content of included files.
+ ( set.insert_new(LiteralOrInclude, !AlreadyDone) ->
+ output_foreign_decl_or_code(Info, "foreign_decl", Lang,
+ LiteralOrInclude, Context, !IO)
+ ;
true
+ )
;
- set.insert(Code, !AlreadyDone),
+ ( Lang = lang_java
+ ; Lang = lang_csharp
+ ; Lang = lang_il
+ ; Lang = lang_erlang
+ ),
+ unexpected($module, $pred,
+ "unexpected: foreign decl code other than C")
+ ).
+
+:- pred output_foreign_decl_or_code(llds_out_info::in, string::in,
+ foreign_language::in, foreign_literal_or_include::in, prog_context::in,
+ io::di, io::uo) is det.
+
+output_foreign_decl_or_code(Info, PragmaType, Lang, LiteralOrInclude, Context,
+ !IO) :-
AutoComments = Info ^ lout_auto_comments,
LineNumbers = Info ^ lout_line_numbers,
(
@@ -926,26 +930,27 @@ output_foreign_header_include_line(Info, Decl, !AlreadyDone, !IO) :-
->
io.write_string("/* ", !IO),
prog_out.write_context(Context, !IO),
- io.write_string(" pragma foreign_decl_code(", !IO),
+ io.write_string(" pragma ", !IO),
+ io.write_string(PragmaType, !IO),
+ io.write_string("(", !IO),
io.write(Lang, !IO),
io.write_string(") */\n", !IO)
;
true
),
+ (
+ LiteralOrInclude = literal(Code),
output_set_line_num(Info, Context, !IO),
- io.write_string(Code, !IO),
- io.write_string("\n", !IO),
- output_reset_line_num(Info, !IO)
- )
+ io.write_string(Code, !IO)
;
- ( Lang = lang_java
- ; Lang = lang_csharp
- ; Lang = lang_il
- ; Lang = lang_erlang
+ LiteralOrInclude = include_file(IncludeFileName),
+ SourceFileName = Info ^ lout_source_file_name,
+ make_include_file_path(SourceFileName, IncludeFileName, IncludePath),
+ output_set_line_num(Info, context(IncludePath, 1), !IO),
+ write_include_file_contents(IncludePath, !IO)
),
- unexpected($module, $pred,
- "unexpected: foreign decl code other than C")
- ).
+ io.nl(!IO),
+ output_reset_line_num(Info, !IO).
:- pred output_record_c_label_decls(llds_out_info::in,
list(label)::in, list(label)::in,
diff --git a/compiler/llds_out_util.m b/compiler/llds_out_util.m
index 2d2e5f1..236a7ca 100644
--- a/compiler/llds_out_util.m
+++ b/compiler/llds_out_util.m
@@ -34,6 +34,7 @@
---> llds_out_info(
lout_module_name :: module_name,
lout_mangled_module_name :: string,
+ lout_source_file_name :: string,
lout_internal_label_to_layout :: map(label,
layout_slot_name),
lout_entry_label_to_layout :: map(label, data_id),
@@ -58,7 +59,7 @@
lout_globals :: globals
).
-:- func init_llds_out_info(module_name, globals,
+:- func init_llds_out_info(module_name, string, globals,
map(label, layout_slot_name), map(label, data_id),
map(pred_proc_id, layout_slot_name),
map(alloc_site_id, layout_slot_name)) = llds_out_info.
@@ -113,7 +114,7 @@
%----------------------------------------------------------------------------%
-init_llds_out_info(ModuleName, Globals,
+init_llds_out_info(ModuleName, SourceFileName, Globals,
InternalLabelToLayoutMap, EntryLabelToLayoutMap, TableIoDeclMap,
AllocSiteMap) = Info :-
MangledModuleName = sym_name_mangle(ModuleName),
@@ -134,7 +135,7 @@ init_llds_out_info(ModuleName, Globals,
globals.lookup_bool_option(Globals, use_macro_for_redo_fail,
UseMacroForRedoFail),
globals.get_trace_level(Globals, TraceLevel),
- Info = llds_out_info(ModuleName, MangledModuleName,
+ Info = llds_out_info(ModuleName, MangledModuleName, SourceFileName,
InternalLabelToLayoutMap, EntryLabelToLayoutMap, TableIoDeclMap,
AllocSiteMap,
AutoComments, LineNumbers,
diff --git a/compiler/make.dependencies.m b/compiler/make.dependencies.m
index c481ea7..e1b5bd1 100644
--- a/compiler/make.dependencies.m
+++ b/compiler/make.dependencies.m
@@ -584,6 +584,7 @@ base_compiled_code_dependencies(TrackFlags) = Deps :-
Deps = combine_deps_list([
module_target_source `of` self,
fact_table_files `files_of` self,
+ foreign_include_files `files_of` self,
map_find_module_deps(imports, self),
Deps0
]).
@@ -1107,6 +1108,47 @@ fact_table_files(Globals, ModuleIndex, Success, Files, !Info, !IO) :-
%-----------------------------------------------------------------------------%
+:- pred foreign_include_files(globals::in, module_index::in,
+ bool::out, set(dependency_file)::out,
+ make_info::in, make_info::out, io::di, io::uo) is det.
+
+foreign_include_files(Globals, ModuleIndex, Success, Files, !Info, !IO) :-
+ globals.get_backend_foreign_languages(Globals, Languages),
+ module_index_to_name(!.Info, ModuleIndex, ModuleName),
+ get_module_dependencies(Globals, ModuleName, MaybeImports, !Info, !IO),
+ (
+ MaybeImports = yes(Imports),
+ Success = yes,
+ SourceFileName = Imports ^ mai_source_file_name,
+ ForeignIncludeFiles = Imports ^ mai_foreign_include_files,
+ FilesList = get_foreign_include_files(set.from_list(Languages),
+ SourceFileName, ForeignIncludeFiles),
+ Files = set.from_list(FilesList)
+ ;
+ MaybeImports = no,
+ Success = no,
+ Files = set.init
+ ).
+
+:- func get_foreign_include_files(set(foreign_language), file_name,
+ foreign_include_file_info_list) = list(dependency_file).
+
+get_foreign_include_files(Languages, SourceFileName, ForeignIncludes)
+ = Files :-
+ list.filter_map(get_foreign_include_files_2(Languages, SourceFileName),
+ ForeignIncludes, Files).
+
+:- pred get_foreign_include_files_2(set(foreign_language)::in, file_name::in,
+ foreign_include_file_info::in, dependency_file::out) is semidet.
+
+get_foreign_include_files_2(Languages, SourceFileName, ForeignInclude, File) :-
+ ForeignInclude = foreign_include_file_info(Language, IncludeFileName),
+ set.member(Language, Languages),
+ make_include_file_path(SourceFileName, IncludeFileName, IncludePath),
+ File = dep_file(IncludePath, no).
+
+%-----------------------------------------------------------------------------%
+
:- type transitive_dependencies_root
---> transitive_dependencies_root(
module_index,
diff --git a/compiler/make.module_dep_file.m b/compiler/make.module_dep_file.m
index bc4ea81..8c2bb40 100644
--- a/compiler/make.module_dep_file.m
+++ b/compiler/make.module_dep_file.m
@@ -63,6 +63,22 @@
:- import_module term.
:- import_module term_io.
+ % The version 1 module_dep file format is the same as version 2 except that
+ % it does not include a list of files included by `pragma foreign_decl' and
+ % `pragma foreign_code'. We continue to write version 1 files when
+ % possible.
+ %
+:- type module_dep_file_version
+ ---> module_dep_file_v1
+ ; module_dep_file_v2.
+
+:- pred version_number(module_dep_file_version, int).
+:- mode version_number(in, out) is det.
+:- mode version_number(out, in) is semidet.
+
+version_number(module_dep_file_v1, 1).
+version_number(module_dep_file_v2, 2).
+
%-----------------------------------------------------------------------------%
get_module_dependencies(Globals, ModuleName, MaybeImports, !Info, !IO) :-
@@ -247,10 +263,6 @@ do_get_module_dependencies(Globals, RebuildModuleDeps, ModuleName,
%-----------------------------------------------------------------------------%
-:- func module_dependencies_version_number = int.
-
-module_dependencies_version_number = 1.
-
write_module_dep_file(Globals, Imports0, !IO) :-
% Make sure all the required fields are filled in.
module_and_imports_get_results(Imports0, Items0, _Specs, _Errors),
@@ -273,8 +285,38 @@ do_write_module_dep_file(Globals, Imports, !IO) :-
(
ProgDepResult = ok(ProgDepStream),
io.set_output_stream(ProgDepStream, OldOutputStream, !IO),
+ choose_module_dep_file_version(Imports, Version),
+ do_write_module_dep_file_2(Imports, Version, !IO),
+ io.set_output_stream(OldOutputStream, _, !IO),
+ io.close_output(ProgDepStream, !IO)
+ ;
+ ProgDepResult = error(Error),
+ io.error_message(Error, Msg),
+ io.write_strings(["Error opening ", ProgDepFile,
+ " for output: ", Msg, "\n"], !IO),
+ io.set_exit_status(1, !IO)
+ ).
+
+:- pred choose_module_dep_file_version(module_and_imports::in,
+ module_dep_file_version::out) is det.
+
+choose_module_dep_file_version(Imports, Version) :-
+ ForeignIncludeFiles = Imports ^ mai_foreign_include_files,
+ (
+ ForeignIncludeFiles = [],
+ Version = module_dep_file_v1
+ ;
+ ForeignIncludeFiles = [_ | _],
+ Version = module_dep_file_v2
+ ).
+
+:- pred do_write_module_dep_file_2(module_and_imports::in,
+ module_dep_file_version::in, io::di, io::uo) is det.
+
+do_write_module_dep_file_2(Imports, Version, !IO) :-
io.write_string("module(", !IO),
- io.write_int(module_dependencies_version_number, !IO),
+ version_number(Version, VersionNumber),
+ io.write_int(VersionNumber, !IO),
io.write_string(", """, !IO),
io.write_string(Imports ^ mai_source_file_name, !IO),
io.write_string(""",\n\t", !IO),
@@ -299,42 +341,51 @@ do_write_module_dep_file(Globals, Imports, !IO) :-
io.write_list(Imports ^ mai_fact_table_deps,
", ", io.write, !IO),
io.write_string("},\n\t{", !IO),
- (
- Imports ^ mai_has_foreign_code =
- contains_foreign_code(ForeignLanguages0)
- ->
- ForeignLanguages = set.to_sorted_list(ForeignLanguages0)
+ ( Imports ^ mai_has_foreign_code = contains_foreign_code(LangList) ->
+ ForeignLanguages = set.to_sorted_list(LangList)
;
ForeignLanguages = []
),
- io.write_list(ForeignLanguages, ", ",
- mercury_output_foreign_language_string, !IO),
+ io.write_list(ForeignLanguages,
+ ", ", mercury_output_foreign_language_string, !IO),
io.write_string("},\n\t{", !IO),
- io.write_list(Imports ^ mai_foreign_import_modules, ", ",
- (pred(ForeignImportModule::in, !.IO::di, !:IO::uo) is det :-
- ForeignImportModule = foreign_import_module_info(Lang,
- ForeignImport, _),
- mercury_output_foreign_language_string(Lang, !IO),
- io.write_string(" - ", !IO),
- mercury_output_bracketed_sym_name(ForeignImport, !IO)
- ), !IO),
+ io.write_list(Imports ^ mai_foreign_import_modules,
+ ", ", write_foreign_import_module_info, !IO),
io.write_string("},\n\t", !IO),
- contains_foreign_export_to_string(
- Imports ^ mai_contains_foreign_export, ContainsForeignExportStr),
+ contains_foreign_export_to_string(Imports ^ mai_contains_foreign_export,
+ ContainsForeignExportStr),
io.write_string(ContainsForeignExportStr, !IO),
io.write_string(",\n\t", !IO),
has_main_to_string(Imports ^ mai_has_main, HasMainStr),
io.write_string(HasMainStr, !IO),
- io.write_string("\n).\n", !IO),
- io.set_output_stream(OldOutputStream, _, !IO),
- io.close_output(ProgDepStream, !IO)
+ (
+ Version = module_dep_file_v1
;
- ProgDepResult = error(Error),
- io.error_message(Error, Msg),
- io.write_strings(["Error opening ", ProgDepFile,
- " for output: ", Msg, "\n"], !IO),
- io.set_exit_status(1, !IO)
- ).
+ Version = module_dep_file_v2,
+ io.write_string(",\n\t{", !IO),
+ io.write_list(list.reverse(Imports ^ mai_foreign_include_files),
+ ", ", write_foreign_include_file_info, !IO),
+ io.write_string("}", !IO)
+ ),
+ io.write_string("\n).\n", !IO).
+
+:- pred write_foreign_import_module_info(foreign_import_module_info::in,
+ io::di, io::uo) is det.
+
+write_foreign_import_module_info(ForeignImportModule, !IO) :-
+ ForeignImportModule = foreign_import_module_info(Lang, ForeignImport, _),
+ mercury_output_foreign_language_string(Lang, !IO),
+ io.write_string(" - ", !IO),
+ mercury_output_bracketed_sym_name(ForeignImport, !IO).
+
+:- pred write_foreign_include_file_info(foreign_include_file_info::in,
+ io::di, io::uo) is det.
+
+write_foreign_include_file_info(ForeignInclude, !IO) :-
+ ForeignInclude = foreign_include_file_info(Lang, FileName),
+ mercury_output_foreign_language_string(Lang, !IO),
+ io.write_string(" - ", !IO),
+ term_io.quote_string(FileName, !IO).
:- pred contains_foreign_export_to_string(contains_foreign_export, string).
:- mode contains_foreign_export_to_string(in, out) is det.
@@ -365,6 +416,8 @@ has_main_to_string(HasMain, HasMainStr) :-
HasMainStr = "no_main"
).
+%-----------------------------------------------------------------------------%
+
:- pred read_module_dependencies_search(globals::in, rebuild_module_deps::in,
module_name::in, make_info::in, make_info::out, io::di, io::uo) is det.
@@ -397,12 +450,42 @@ read_module_dependencies_2(Globals, RebuildModuleDeps, SearchDirs, ModuleName,
SearchResult, !IO),
(
SearchResult = ok(ModuleDir),
- parser.read_term(ImportsTermResult, !IO),
+ parser.read_term(TermResult, !IO),
io.set_input_stream(OldInputStream, ModuleDepStream, !IO),
io.close_input(ModuleDepStream, !IO),
(
- ImportsTermResult = term(_, ImportsTerm),
- ImportsTerm = term.functor(term.atom("module"), ModuleArgs, _),
+ TermResult = term(_, Term),
+ read_module_dependencies_3(Globals, SearchDirs, ModuleName,
+ ModuleDir, Term, Result, !Info, !IO)
+ ;
+ TermResult = eof,
+ Result = error("unexpected eof")
+ ;
+ TermResult = error(ParseError, _),
+ Result = error("parse error: " ++ ParseError)
+ ),
+ (
+ Result = ok
+ ;
+ Result = error(Msg),
+ read_module_dependencies_remake(Globals, RebuildModuleDeps,
+ ModuleName, Msg, !Info, !IO)
+ )
+ ;
+ SearchResult = error(_),
+ % XXX should use the error message.
+ read_module_dependencies_remake(Globals, RebuildModuleDeps, ModuleName,
+ "couldn't find `.module_dep' file", !Info, !IO)
+ ).
+
+:- pred read_module_dependencies_3(globals::in, list(dir_name)::in,
+ module_name::in, dir_name::in, term::in, maybe_error::out,
+ make_info::in, make_info::out, io::di, io::uo) is det.
+
+read_module_dependencies_3(Globals, SearchDirs, ModuleName, ModuleDir,
+ Term, Result, !Info, !IO) :-
+ (
+ atom_term(Term, "module", ModuleArgs),
ModuleArgs = [
VersionNumberTerm,
SourceFileTerm,
@@ -417,65 +500,42 @@ read_module_dependencies_2(Globals, RebuildModuleDeps, SearchDirs, ModuleName,
ForeignImportsTerm,
ContainsForeignExportTerm,
HasMainTerm
+ | ModuleArgsTail
],
- VersionNumberTerm = term.functor(
- term.integer(module_dependencies_version_number), [], _),
- SourceFileTerm = term.functor(
- term.string(SourceFileName), [], _),
+
+ version_number_term(VersionNumberTerm, Version),
+ string_term(SourceFileTerm, SourceFileName),
try_parse_sym_name_and_no_args(SourceFileModuleNameTerm,
SourceFileModuleName),
- parse_sym_name_list(ParentsTerm, Parents),
- parse_sym_name_list(IntDepsTerm, IntDeps),
- parse_sym_name_list(ImplDepsTerm, ImplDeps),
- parse_sym_name_list(ChildrenTerm, Children),
- parse_sym_name_list(NestedChildrenTerm, NestedChildren),
- FactDepsTerm = term.functor(term.atom("{}"), FactDepsStrings, _),
- list.map(
- (pred(StringTerm::in, String::out) is semidet :-
- StringTerm = term.functor(term.string(String), [], _)
- ), FactDepsStrings, FactDeps),
- ForeignLanguagesTerm = term.functor(
- term.atom("{}"), ForeignLanguagesTerms, _),
- list.map(
- (pred(LanguageTerm::in, Language::out) is semidet :-
- LanguageTerm = term.functor(
- term.string(LanguageString), [], _),
- globals.convert_foreign_language(LanguageString, Language)
- ), ForeignLanguagesTerms, ForeignLanguages),
- ForeignImportsTerm = term.functor(term.atom("{}"),
- ForeignImportTerms, _),
- list.map(
- (pred(ForeignImportTerm::in, ForeignImportModule::out)
- is semidet :-
- ForeignImportTerm = term.functor(term.atom("-"),
- [LanguageTerm, ImportedModuleTerm], _),
- LanguageTerm = term.functor(
- term.string(LanguageString), [], _),
- globals.convert_foreign_language(LanguageString,
- Language),
- try_parse_sym_name_and_no_args(ImportedModuleTerm,
- ImportedModuleName),
- ForeignImportModule = foreign_import_module_info(Language,
- ImportedModuleName, term.context_init)
- ), ForeignImportTerms, ForeignImports),
-
- ContainsForeignExportTerm =
- term.functor(term.atom(ContainsForeignExportStr), [], _),
- contains_foreign_export_to_string(ContainsForeignExport,
- ContainsForeignExportStr),
- HasMainTerm = term.functor(term.atom(HasMainStr), [], _),
- has_main_to_string(HasMain, HasMainStr)
- ->
+ sym_names_term(ParentsTerm, Parents),
+ sym_names_term(IntDepsTerm, IntDeps),
+ sym_names_term(ImplDepsTerm, ImplDeps),
+ sym_names_term(ChildrenTerm, Children),
+ sym_names_term(NestedChildrenTerm, NestedChildren),
+
+ braces_term(fact_dep_term, FactDepsTerm, FactDeps),
+ braces_term(foreign_language_term, ForeignLanguagesTerm,
+ ForeignLanguages),
+ braces_term(foreign_import_term, ForeignImportsTerm, ForeignImports),
+
+ contains_foreign_export_term(ContainsForeignExportTerm,
+ ContainsForeignExport),
+
+ has_main_term(HasMainTerm, HasMain),
+
(
- ForeignLanguages = [],
- ContainsForeignCode = contains_no_foreign_code
+ Version = module_dep_file_v1,
+ ModuleArgsTail = [],
+ ForeignIncludes = []
;
- ForeignLanguages = [_ | _],
- ContainsForeignCode = contains_foreign_code(
- set.list_to_set(ForeignLanguages))
- ),
-
+ Version = module_dep_file_v2,
+ ModuleArgsTail = [ForeignIncludesTerm],
+ braces_term(foreign_include_term, ForeignIncludesTerm,
+ ForeignIncludes)
+ )
+ ->
+ ContainsForeignCode = contains_foreign_code(ForeignLanguages),
IndirectDeps = [],
PublicChildren = [],
Items = cord.empty,
@@ -485,7 +545,8 @@ read_module_dependencies_2(Globals, RebuildModuleDeps, SearchDirs, ModuleName,
Imports = module_and_imports(SourceFileName, SourceFileModuleName,
ModuleName, Parents, IntDeps, ImplDeps, IndirectDeps,
Children, PublicChildren, NestedChildren, FactDeps,
- ContainsForeignCode, ForeignImports, ContainsForeignExport,
+ ContainsForeignCode, ForeignImports, ForeignIncludes,
+ ContainsForeignExport,
Items, Specs, Errors, MaybeTimestamps, HasMain, ModuleDir),
ModuleDepMap0 = !.Info ^ module_dependencies,
@@ -498,39 +559,106 @@ read_module_dependencies_2(Globals, RebuildModuleDeps, SearchDirs, ModuleName,
% dependencies for all modules in the source file will be remade
% (make_module_dependencies expects to be given the top-level
% module in the source file).
-
- SubRebuildModuleDeps = do_not_rebuild_module_deps,
list.foldl2(
- read_module_dependencies_2(Globals, SubRebuildModuleDeps,
+ read_module_dependencies_2(Globals, do_not_rebuild_module_deps,
SearchDirs),
NestedChildren, !Info, !IO),
- (
- list.member(NestedChild, NestedChildren),
- (
- map.search(!.Info ^ module_dependencies,
- NestedChild, ChildImports)
- ->
- ChildImports = no
+ ( some_bad_module_dependency(!.Info, NestedChildren) ->
+ Result = error("error in nested sub-modules")
;
- true
+ Result = ok
)
- ->
- read_module_dependencies_remake(Globals, RebuildModuleDeps,
- ModuleName, "error in nested sub-modules", !Info, !IO)
;
- true
- )
- ;
- read_module_dependencies_remake(Globals, RebuildModuleDeps,
- ModuleName, "parse error", !Info, !IO)
- )
- ;
- SearchResult = error(_),
- % XXX should use the error message.
- read_module_dependencies_remake(Globals, RebuildModuleDeps, ModuleName,
- "couldn't find `.module_dep' file", !Info, !IO)
+ Result = error("failed to parse term")
).
+:- pred version_number_term(term::in, module_dep_file_version::out) is semidet.
+
+version_number_term(Term, Version) :-
+ Term = term.functor(term.integer(Int), [], _),
+ version_number(Version, Int).
+
+:- pred string_term(term::in, string::out) is semidet.
+
+string_term(Term, String) :-
+ Term = term.functor(term.string(String), [], _).
+
+:- pred atom_term(term::in, string::out, list(term)::out) is semidet.
+
+atom_term(Term, Atom, Args) :-
+ Term = term.functor(term.atom(Atom), Args, _).
+
+:- pred braces_term(pred(term, U), term, list(U)).
+:- mode braces_term(in(pred(in, out) is semidet), in, out) is semidet.
+
+braces_term(P, Term, Args) :-
+ atom_term(Term, "{}", ArgTerms),
+ list.map(P, ArgTerms, Args).
+
+:- pred sym_names_term(term::in, list(sym_name)::out) is semidet.
+
+sym_names_term(Term, SymNames) :-
+ braces_term(try_parse_sym_name_and_no_args, Term, SymNames).
+
+:- pred fact_dep_term(term::in, string::out) is semidet.
+
+fact_dep_term(Term, FactDep) :-
+ string_term(Term, FactDep).
+
+:- pred foreign_language_term(term::in, foreign_language::out) is semidet.
+
+foreign_language_term(Term, Lang) :-
+ string_term(Term, String),
+ globals.convert_foreign_language(String, Lang).
+
+:- pred foreign_import_term(term::in, foreign_import_module_info::out)
+ is semidet.
+
+foreign_import_term(Term, ForeignImport) :-
+ atom_term(Term, "-", [LanguageTerm, ImportedModuleTerm]),
+ foreign_language_term(LanguageTerm, Language),
+ try_parse_sym_name_and_no_args(ImportedModuleTerm, ImportedModuleName),
+ ForeignImport = foreign_import_module_info(Language, ImportedModuleName,
+ term.context_init).
+
+:- pred foreign_include_term(term::in, foreign_include_file_info::out)
+ is semidet.
+
+foreign_include_term(Term, ForeignInclude) :-
+ atom_term(Term, "-", [LanguageTerm, FileNameTerm]),
+ foreign_language_term(LanguageTerm, Language),
+ string_term(FileNameTerm, FileName),
+ ForeignInclude = foreign_include_file_info(Language, FileName).
+
+:- pred contains_foreign_export_term(term::in, contains_foreign_export::out)
+ is semidet.
+
+contains_foreign_export_term(Term, ContainsForeignExport) :-
+ atom_term(Term, Atom, []),
+ contains_foreign_export_to_string(ContainsForeignExport, Atom).
+
+:- func contains_foreign_code(list(foreign_language)) = contains_foreign_code.
+
+contains_foreign_code([]) = contains_no_foreign_code.
+contains_foreign_code(Langs) = contains_foreign_code(LangSet) :-
+ Langs = [_ | _],
+ LangSet = set.from_list(Langs).
+
+:- pred has_main_term(term::in, has_main::out) is semidet.
+
+has_main_term(Term, HasMain) :-
+ atom_term(Term, String, []),
+ has_main_to_string(HasMain, String).
+
+:- pred some_bad_module_dependency(make_info::in, list(module_name)::in)
+ is semidet.
+
+some_bad_module_dependency(Info, ModuleNames) :-
+ list.member(ModuleName, ModuleNames),
+ map.search(Info ^ module_dependencies, ModuleName, no).
+
+%-----------------------------------------------------------------------------%
+
% Something went wrong reading the dependencies, so just rebuild them.
%
:- pred read_module_dependencies_remake(globals::in, rebuild_module_deps::in,
@@ -562,11 +690,6 @@ read_module_dependencies_remake_msg(Globals, ModuleName, Msg, !IO) :-
io.write_string(Msg, !IO),
io.nl(!IO).
-:- pred parse_sym_name_list(term::in, list(sym_name)::out) is semidet.
-
-parse_sym_name_list(term.functor(term.atom("{}"), Args, _), SymNames) :-
- list.map(try_parse_sym_name_and_no_args, Args, SymNames).
-
% The module_name given must be the top level module in the source file.
% get_module_dependencies ensures this by making the dependencies
% for all parent modules of the requested module first.
diff --git a/compiler/make_hlds_passes.m b/compiler/make_hlds_passes.m
index 5fbaf41..f3c0f25 100644
--- a/compiler/make_hlds_passes.m
+++ b/compiler/make_hlds_passes.m
@@ -1964,8 +1964,8 @@ get_c_mutable_global_foreign_decl(ModuleInfo, Type, TargetMutableName,
" extern ", LowLevelTypeName, " ", TargetMutableName, ";\n",
"#endif\n" | LockDecl]),
- FDInfo =
- pragma_info_foreign_decl(lang_c, foreign_decl_is_exported, DeclBody),
+ FDInfo = pragma_info_foreign_decl(lang_c, foreign_decl_is_exported,
+ literal(DeclBody)),
DeclPragma = pragma_foreign_decl(FDInfo),
DeclItemPragma = item_pragma_info(compiler(mutable_decl), DeclPragma,
Context, -1),
@@ -2013,7 +2013,7 @@ get_c_mutable_global_foreign_defn(ModuleInfo, Type, TargetMutableName,
DefnBody = string.append_list([
TypeName, " ", TargetMutableName, ";\n" | LockDefn]),
- FCInfo = pragma_info_foreign_code(lang_c, DefnBody),
+ FCInfo = pragma_info_foreign_code(lang_c, literal(DefnBody)),
DefnPragma = pragma_foreign_code(FCInfo),
DefnItemPragma = item_pragma_info(compiler(mutable_decl), DefnPragma,
Context, -1),
@@ -2103,7 +2103,7 @@ add_ccsj_constant_mutable_access_preds(TargetMutableName,
[pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
ProgVarSet,
InstVarSet,
- fc_impl_ordinary("X = " ++ TargetMutableName ++ ";\n", yes(Context))
+ fp_impl_ordinary("X = " ++ TargetMutableName ++ ";\n", yes(Context))
),
ConstantGetForeignProc = pragma_foreign_proc(ConstantGetFCInfo),
ConstantGetItemPragma = item_pragma_info(compiler(mutable_decl),
@@ -2120,7 +2120,7 @@ add_ccsj_constant_mutable_access_preds(TargetMutableName,
[pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
ProgVarSet,
InstVarSet,
- fc_impl_ordinary(TargetMutableName ++ " = X;\n", yes(Context))
+ fp_impl_ordinary(TargetMutableName ++ " = X;\n", yes(Context))
),
ConstantSetForeignProc = pragma_foreign_proc(ConstantSetFCInfo),
ConstantSetItemPragma = item_pragma_info(compiler(mutable_decl),
@@ -2167,7 +2167,7 @@ add_c_mutable_primitive_preds(TargetMutableName, ModuleName, MutableName,
[],
varset.init, % Prog varset.
varset.init, % Inst varset.
- fc_impl_ordinary(LockForeignProcBody, yes(Context))
+ fp_impl_ordinary(LockForeignProcBody, yes(Context))
),
LockForeignProc = pragma_foreign_proc(LockFCInfo),
LockItemPragma = item_pragma_info(compiler(mutable_decl),
@@ -2196,7 +2196,7 @@ add_c_mutable_primitive_preds(TargetMutableName, ModuleName, MutableName,
[],
varset.init, % Prog varset.
varset.init, % Inst varset.
- fc_impl_ordinary(UnlockForeignProcBody, yes(Context))
+ fp_impl_ordinary(UnlockForeignProcBody, yes(Context))
),
UnlockForeignProc = pragma_foreign_proc(UnlockFCInfo),
UnlockItemPragma = item_pragma_info(compiler(mutable_decl),
@@ -2223,7 +2223,7 @@ add_c_mutable_primitive_preds(TargetMutableName, ModuleName, MutableName,
[pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
ProgVarSet,
varset.init, % Inst varset.
- fc_impl_ordinary(UnsafeGetCode, yes(Context))
+ fp_impl_ordinary(UnsafeGetCode, yes(Context))
),
UnsafeGetForeignProc = pragma_foreign_proc(UnsafeGetFCInfo),
UnsafeGetItemPragma = item_pragma_info(compiler(mutable_decl),
@@ -2275,7 +2275,7 @@ add_c_mutable_primitive_preds(TargetMutableName, ModuleName, MutableName,
[pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
ProgVarSet,
varset.init, % Inst varset.
- fc_impl_ordinary(TrailCode ++ SetCode, yes(Context))
+ fp_impl_ordinary(TrailCode ++ SetCode, yes(Context))
),
UnsafeSetForeignProc = pragma_foreign_proc(UnsafeSetFCInfo),
UnsafeSetItemPragma = item_pragma_info(compiler(mutable_decl),
@@ -2443,7 +2443,7 @@ add_c_mutable_initialisation(IsConstant, IsThreadLocal, TargetMutableName,
[],
varset.init, % ProgVarSet
varset.init, % InstVarSet
- fc_impl_ordinary(PreInitCode, yes(Context))
+ fp_impl_ordinary(PreInitCode, yes(Context))
),
PreInitForeignProc = pragma_foreign_proc(PreInitFCInfo),
PreInitItemPragma = item_pragma_info(compiler(mutable_decl),
@@ -2489,7 +2489,7 @@ add_csharp_java_mutable_defn(Lang, TargetMutableName, Type, IsThreadLocal,
Context, !ModuleInfo, !QualInfo, !Specs) :-
get_csharp_java_mutable_global_foreign_defn(Lang, TargetMutableName,
Type, IsThreadLocal, Context, DefnBody),
- DefnFCInfo = pragma_info_foreign_code(Lang, DefnBody),
+ DefnFCInfo = pragma_info_foreign_code(Lang, literal(DefnBody)),
DefnPragma = pragma_foreign_code(DefnFCInfo),
DefnItemPragma = item_pragma_info(compiler(mutable_decl), DefnPragma,
Context, -1),
@@ -2626,7 +2626,7 @@ add_csharp_thread_local_mutable_pre_init_pred(TargetMutableName,
[],
varset.init, % ProgVarSet
varset.init, % InstVarSet
- fc_impl_ordinary(PreInitCode, yes(Context))
+ fp_impl_ordinary(PreInitCode, yes(Context))
),
PreInitForeignProc = pragma_foreign_proc(PreInitFCInfo),
PreInitItemPragma = item_pragma_info(compiler(mutable_decl),
@@ -2685,7 +2685,7 @@ add_csharp_java_mutable_primitive_preds(Lang, TargetMutableName, ModuleName,
[pragma_var(X, "X", out_mode(Inst), BoxPolicy)],
ProgVarSet,
varset.init, % Inst varset.
- fc_impl_ordinary(GetCode, yes(Context))
+ fp_impl_ordinary(GetCode, yes(Context))
),
GetForeignProc = pragma_foreign_proc(GetFCInfo),
GetItemPragma = item_pragma_info(compiler(mutable_decl),
@@ -2728,7 +2728,7 @@ add_csharp_java_mutable_primitive_preds(Lang, TargetMutableName, ModuleName,
[pragma_var(X, "X", in_mode(Inst), BoxPolicy)],
ProgVarSet,
varset.init, % Inst varset.
- fc_impl_ordinary(TrailCode ++ SetCode, yes(Context))
+ fp_impl_ordinary(TrailCode ++ SetCode, yes(Context))
),
SetForeignProc = pragma_foreign_proc(SetFCInfo),
SetItemPragma = item_pragma_info(compiler(mutable_decl),
@@ -2836,7 +2836,7 @@ add_erlang_constant_mutable_access_preds(TargetMutableName,
[pragma_var(X, "X", out_mode(Inst), native_if_possible)],
ProgVarSet,
InstVarSet,
- fc_impl_ordinary(GetCode, yes(Context))
+ fp_impl_ordinary(GetCode, yes(Context))
),
ConstantGetForeignProc = pragma_foreign_proc(ConstantGetFCInfo),
ConstantGetItemPragma = item_pragma_info(compiler(mutable_decl),
@@ -2852,7 +2852,7 @@ add_erlang_constant_mutable_access_preds(TargetMutableName,
[pragma_var(X, "X", in_mode(Inst), native_if_possible)],
ProgVarSet,
InstVarSet,
- fc_impl_ordinary(SetCode, yes(Context))
+ fp_impl_ordinary(SetCode, yes(Context))
),
ConstantSetForeignProc = pragma_foreign_proc(ConstantSetFCInfo),
ConstantSetItemPragma = item_pragma_info(compiler(mutable_decl),
@@ -2899,7 +2899,7 @@ add_erlang_mutable_user_access_preds(TargetMutableName,
[pragma_var(X, "X", out_mode(Inst), native_if_possible)],
ProgVarSet0,
varset.init, % Inst varset.
- fc_impl_ordinary(GetCode, yes(Context))
+ fp_impl_ordinary(GetCode, yes(Context))
),
GetForeignProc = pragma_foreign_proc(GetFCInfo),
GetItemPragma = item_pragma_info(compiler(mutable_decl), GetForeignProc,
@@ -2926,7 +2926,7 @@ add_erlang_mutable_user_access_preds(TargetMutableName,
[pragma_var(X, "X", in_mode(Inst), native_if_possible)],
ProgVarSet0,
varset.init, % Inst varset.
- fc_impl_ordinary(SetCode, yes(Context))
+ fp_impl_ordinary(SetCode, yes(Context))
),
SetForeignProc = pragma_foreign_proc(SetFCInfo),
SetItemPragma = item_pragma_info(compiler(mutable_decl), SetForeignProc,
diff --git a/compiler/make_hlds_warn.m b/compiler/make_hlds_warn.m
index 9feb7a5..e080cc3 100644
--- a/compiler/make_hlds_warn.m
+++ b/compiler/make_hlds_warn.m
@@ -48,7 +48,7 @@
% Mercury variable names into identifiers for that foreign language).
%
:- pred warn_singletons_in_pragma_foreign_proc(module_info::in,
- pragma_foreign_code_impl::in, foreign_language::in,
+ pragma_foreign_proc_impl::in, foreign_language::in,
list(maybe(pair(string, mer_mode)))::in, prog_context::in,
simple_call_id::in, pred_id::in, proc_id::in,
list(error_spec)::in, list(error_spec)::out) is det.
@@ -485,8 +485,8 @@ add_warn_spec(Spec, !Info) :-
warn_singletons_in_pragma_foreign_proc(ModuleInfo, PragmaImpl, Lang,
Args, Context, SimpleCallId, PredId, ProcId, !Specs) :-
LangStr = foreign_language_string(Lang),
- PragmaImpl = fc_impl_ordinary(C_Code, _),
- c_code_to_name_list(C_Code, C_CodeList),
+ PragmaImpl = fp_impl_ordinary(Code, _),
+ c_code_to_name_list(Code, C_CodeList),
list.filter_map(var_is_unmentioned(C_CodeList), Args, UnmentionedVars),
(
UnmentionedVars = []
diff --git a/compiler/mercury_compile.m b/compiler/mercury_compile.m
index 82626d3..1d51907 100644
--- a/compiler/mercury_compile.m
+++ b/compiler/mercury_compile.m
@@ -1580,38 +1580,41 @@ mercury_compile_after_front_end(NestedSubModules, FindTimestampFiles,
(
Target = target_il,
mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
+ mlds_to_il_assembler(Globals, MLDS, TargetCodeSucceeded, !IO),
(
- TargetCodeOnly = yes,
- mlds_to_il_assembler(Globals, MLDS, !IO)
- ;
- TargetCodeOnly = no,
+ TargetCodeSucceeded = yes,
+ TargetCodeOnly = no
+ ->
HasMain = mlds_has_main(MLDS),
- mlds_to_il_assembler(Globals, MLDS, !IO),
io.output_stream(OutputStream, !IO),
il_assemble(OutputStream, ModuleName, HasMain,
Globals, Succeeded, !IO),
maybe_set_exit_status(Succeeded, !IO)
+ ;
+ Succeeded = TargetCodeSucceeded
),
ExtraObjFiles = []
;
Target = target_csharp,
mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
- mlds_to_csharp(!.HLDS, MLDS, !IO),
+ mlds_to_csharp(!.HLDS, MLDS, Succeeded, !IO),
ExtraObjFiles = []
;
Target = target_java,
mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
- mlds_to_java(!.HLDS, MLDS, !IO),
+ mlds_to_java(!.HLDS, MLDS, TargetCodeSucceeded, !IO),
(
- TargetCodeOnly = yes
- ;
- TargetCodeOnly = no,
+ TargetCodeSucceeded = yes,
+ TargetCodeOnly = no
+ ->
io.output_stream(OutputStream, !IO),
module_name_to_file_name(Globals, ModuleName, ".java",
do_not_create_dirs, JavaFile, !IO),
compile_java_files(OutputStream, [JavaFile],
Globals, Succeeded, !IO),
maybe_set_exit_status(Succeeded, !IO)
+ ;
+ Succeeded = TargetCodeSucceeded
),
ExtraObjFiles = []
;
@@ -1619,11 +1622,11 @@ mercury_compile_after_front_end(NestedSubModules, FindTimestampFiles,
(
HighLevelCode = yes,
mlds_backend(!.HLDS, _, MLDS, !DumpInfo, !IO),
- mlds_to_high_level_c(Globals, MLDS, !IO),
+ mlds_to_high_level_c(Globals, MLDS, TargetCodeSucceeded, !IO),
(
- TargetCodeOnly = yes
- ;
- TargetCodeOnly = no,
+ TargetCodeSucceeded = yes,
+ TargetCodeOnly = no
+ ->
module_name_to_file_name(Globals, ModuleName, ".c",
do_not_create_dirs, C_File, !IO),
get_linked_target_type(Globals, TargetType),
@@ -1633,15 +1636,17 @@ mercury_compile_after_front_end(NestedSubModules, FindTimestampFiles,
do_create_dirs, O_File, !IO),
io.output_stream(OutputStream, !IO),
do_compile_c_file(OutputStream, PIC,
- C_File, O_File, Globals, CompileOK, !IO),
- maybe_set_exit_status(CompileOK, !IO)
+ C_File, O_File, Globals, Succeeded, !IO),
+ maybe_set_exit_status(Succeeded, !IO)
+ ;
+ Succeeded = TargetCodeSucceeded
),
ExtraObjFiles = []
;
HighLevelCode = no,
llds_backend_pass(!HLDS, GlobalData, LLDS, !DumpInfo, !IO),
llds_output_pass(!.HLDS, GlobalData, LLDS, ModuleName,
- _CompileErrors, ExtraObjFiles, !IO)
+ Succeeded, ExtraObjFiles, !IO)
)
;
Target = target_x86_64,
@@ -1654,18 +1659,24 @@ mercury_compile_after_front_end(NestedSubModules, FindTimestampFiles,
% than stdout.
io.stdout_stream(Stdout, !IO),
output_x86_64_asm(Stdout, X86_64_Asm, !IO),
+ Succeeded = yes,
ExtraObjFiles = []
;
Target = target_erlang,
erlang_backend(!.HLDS, ELDS, !DumpInfo, !IO),
- elds_to_erlang(!.HLDS, ELDS, !IO),
+ elds_to_erlang(!.HLDS, ELDS, Succeeded, !IO),
ExtraObjFiles = []
),
+ (
+ Succeeded = yes,
recompilation.usage.write_usage_file(!.HLDS, NestedSubModules,
MaybeTimestamps, !IO),
FindTimestampFiles(ModuleName, TimestampFiles, !IO),
list.foldl(touch_datestamp(Globals), TimestampFiles, !IO)
;
+ Succeeded = no
+ )
+ ;
% If the number of errors is > 0, make sure that the compiler
% exits with a non-zero exit status.
io.get_exit_status(ExitStatus, !IO),
diff --git a/compiler/mercury_compile_erl_back_end.m b/compiler/mercury_compile_erl_back_end.m
index a07b9b2..d1c6835 100644
--- a/compiler/mercury_compile_erl_back_end.m
+++ b/compiler/mercury_compile_erl_back_end.m
@@ -21,12 +21,14 @@
:- import_module hlds.passes_aux.
:- import_module erl_backend.elds.
+:- import_module bool.
:- import_module io.
:- pred erlang_backend(module_info::in, elds::out,
dump_info::in, dump_info::out, io::di, io::uo) is det.
-:- pred elds_to_erlang(module_info::in, elds::in, io::di, io::uo) is det.
+:- pred elds_to_erlang(module_info::in, elds::in, bool::out, io::di, io::uo)
+ is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -84,13 +86,13 @@ elds_gen_rtti_data(HLDS, !ELDS, !IO) :-
rtti_data_list_to_elds(HLDS, ErlangRttiDatas, RttiDefns),
!ELDS ^ elds_rtti_funcs := RttiDefns0 ++ RttiDefns.
-elds_to_erlang(HLDS, ELDS, !IO) :-
+elds_to_erlang(HLDS, ELDS, Succeeded, !IO) :-
module_info_get_globals(HLDS, Globals),
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, statistics, Stats),
maybe_write_string(Verbose, "% Converting ELDS to Erlang...\n", !IO),
- elds_to_erlang.output_elds(HLDS, ELDS, !IO),
+ elds_to_erlang.output_elds(HLDS, ELDS, Succeeded, !IO),
maybe_write_string(Verbose, "% Finished converting ELDS to Erlang.\n",
!IO),
maybe_report_stats(Stats, !IO).
diff --git a/compiler/mercury_compile_llds_back_end.m b/compiler/mercury_compile_llds_back_end.m
index 580528d..ceb3479 100644
--- a/compiler/mercury_compile_llds_back_end.m
+++ b/compiler/mercury_compile_llds_back_end.m
@@ -600,7 +600,7 @@ maybe_generate_stack_layouts(HLDS, LLDS, Verbose, Stats, !GlobalData, !IO) :-
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
-llds_output_pass(HLDS, GlobalData0, Procs, ModuleName, CompileErrors,
+llds_output_pass(HLDS, GlobalData0, Procs, ModuleName, Succeeded,
FactTableObjFiles, !IO) :-
module_info_get_globals(HLDS, Globals),
globals.lookup_bool_option(Globals, verbose, Verbose),
@@ -694,7 +694,9 @@ llds_output_pass(HLDS, GlobalData0, Procs, ModuleName, CompileErrors,
AllocSites, AllocIdMap, ChunkedModules,
UserInitPredCNames, UserFinalPredCNames, ComplexityProcs),
- output_llds_file(Globals, ModuleName, CFile, Verbose, Stats, !IO),
+ output_llds_file(Globals, CFile, TargetCodeSucceeded, !IO),
+ (
+ TargetCodeSucceeded = yes,
C_InterfaceInfo = foreign_interface_info(_, _, _, _, C_ExportDecls, _),
export.produce_header_file(HLDS, C_ExportDecls, ModuleName, !IO),
@@ -707,13 +709,18 @@ llds_output_pass(HLDS, GlobalData0, Procs, ModuleName, CompileErrors,
llds_c_to_obj(Globals, OutputStream, ModuleName, CompileOK, !IO),
module_get_fact_table_files(HLDS, FactTableBaseFiles),
list.map2_foldl(compile_fact_table_file(Globals, OutputStream),
- FactTableBaseFiles, FactTableObjFiles, FactTableCompileOKs, !IO),
- bool.and_list([CompileOK | FactTableCompileOKs], AllOk),
- maybe_set_exit_status(AllOk, !IO),
- bool.not(AllOk, CompileErrors)
+ FactTableBaseFiles, FactTableObjFiles, FactTableCompileOKs,
+ !IO),
+ bool.and_list([CompileOK | FactTableCompileOKs], Succeeded),
+ maybe_set_exit_status(Succeeded, !IO)
;
TargetCodeOnly = yes,
- CompileErrors = no,
+ Succeeded = yes,
+ FactTableObjFiles = []
+ )
+ ;
+ TargetCodeSucceeded = no,
+ Succeeded = no,
FactTableObjFiles = []
).
@@ -771,10 +778,10 @@ make_decl_guards(ModuleName, StartGuard, EndGuard) :-
Define = decl_guard(ModuleName),
Start = "#ifndef " ++ Define ++ "\n#define " ++ Define ++ "\n",
End = "\n#endif",
- StartGuard = foreign_decl_code(lang_c, foreign_decl_is_exported, Start,
- term.context_init),
- EndGuard = foreign_decl_code(lang_c, foreign_decl_is_exported, End,
- term.context_init).
+ StartGuard = foreign_decl_code(lang_c, foreign_decl_is_exported,
+ literal(Start), term.context_init),
+ EndGuard = foreign_decl_code(lang_c, foreign_decl_is_exported,
+ literal(End), term.context_init).
:- pred make_foreign_import_header_code(globals::in,
foreign_import_module_info::in, foreign_decl_code::out,
@@ -789,7 +796,7 @@ make_foreign_import_header_code(Globals, ForeignImportModule, Include, !IO) :-
HeaderFileName, !IO),
IncludeString = "#include """ ++ HeaderFileName ++ """\n",
Include = foreign_decl_code(lang_c, foreign_decl_is_exported,
- IncludeString, Context)
+ literal(IncludeString), Context)
;
Lang = lang_csharp,
sorry($module, $pred, ":- import_module not yet implemented: " ++
@@ -833,21 +840,12 @@ combine_chunks_2([Chunk | Chunks], ModuleName, Num, [Module | Modules]) :-
Num1 = Num + 1,
combine_chunks_2(Chunks, ModuleName, Num1, Modules).
-:- pred output_llds_file(globals::in, module_name::in, c_file::in,
- bool::in, bool::in, io::di, io::uo) is det.
+:- pred output_llds_file(globals::in, c_file::in, bool::out, io::di, io::uo)
+ is det.
-output_llds_file(Globals, ModuleName, LLDS0, Verbose, Stats, !IO) :-
- maybe_write_string(Verbose, "% Writing output to `", !IO),
- module_name_to_file_name(Globals, ModuleName, ".c", do_create_dirs,
- FileName, !IO),
- maybe_write_string(Verbose, FileName, !IO),
- maybe_write_string(Verbose, "'...", !IO),
- maybe_flush_output(Verbose, !IO),
+output_llds_file(Globals, LLDS0, Succeeded, !IO) :-
transform_llds(Globals, LLDS0, LLDS),
- output_llds(Globals, LLDS, !IO),
- maybe_write_string(Verbose, " done.\n", !IO),
- maybe_flush_output(Verbose, !IO),
- maybe_report_stats(Stats, !IO).
+ output_llds(Globals, LLDS, Succeeded, !IO).
:- pred llds_c_to_obj(globals::in, io.output_stream::in, module_name::in,
bool::out, io::di, io::uo) is det.
diff --git a/compiler/mercury_compile_mlds_back_end.m b/compiler/mercury_compile_mlds_back_end.m
index 25776f2..609dca4 100644
--- a/compiler/mercury_compile_mlds_back_end.m
+++ b/compiler/mercury_compile_mlds_back_end.m
@@ -38,13 +38,17 @@
:- pred maybe_mark_static_terms(bool::in, bool::in,
module_info::in, module_info::out, io::di, io::uo) is det.
-:- pred mlds_to_high_level_c(globals::in, mlds::in, io::di, io::uo) is det.
+:- pred mlds_to_high_level_c(globals::in, mlds::in, bool::out,
+ io::di, io::uo) is det.
-:- pred mlds_to_java(module_info::in, mlds::in, io::di, io::uo) is det.
+:- pred mlds_to_java(module_info::in, mlds::in, bool::out,
+ io::di, io::uo) is det.
-:- pred mlds_to_csharp(module_info::in, mlds::in, io::di, io::uo) is det.
+:- pred mlds_to_csharp(module_info::in, mlds::in, bool::out,
+ io::di, io::uo) is det.
-:- pred mlds_to_il_assembler(globals::in, mlds::in, io::di, io::uo) is det.
+:- pred mlds_to_il_assembler(globals::in, mlds::in, bool::out,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -376,41 +380,41 @@ mlds_gen_rtti_data(HLDS, !MLDS) :-
% The `--high-level-code' MLDS output pass.
%
-mlds_to_high_level_c(Globals, MLDS, !IO) :-
+mlds_to_high_level_c(Globals, MLDS, Succeeded, !IO) :-
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, statistics, Stats),
maybe_write_string(Verbose, "% Converting MLDS to C...\n", !IO),
- output_c_mlds(MLDS, Globals, "", !IO),
+ output_c_mlds(MLDS, Globals, "", Succeeded, !IO),
maybe_write_string(Verbose, "% Finished converting MLDS to C.\n", !IO),
maybe_report_stats(Stats, !IO).
-mlds_to_java(HLDS, MLDS, !IO) :-
+mlds_to_java(HLDS, MLDS, Succeeded, !IO) :-
module_info_get_globals(HLDS, Globals),
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, statistics, Stats),
maybe_write_string(Verbose, "% Converting MLDS to Java...\n", !IO),
- output_java_mlds(HLDS, MLDS, !IO),
+ output_java_mlds(HLDS, MLDS, Succeeded, !IO),
maybe_write_string(Verbose, "% Finished converting MLDS to Java.\n", !IO),
maybe_report_stats(Stats, !IO).
-mlds_to_csharp(HLDS, MLDS, !IO) :-
+mlds_to_csharp(HLDS, MLDS, Succeeded, !IO) :-
module_info_get_globals(HLDS, Globals),
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, statistics, Stats),
maybe_write_string(Verbose, "% Converting MLDS to C#...\n", !IO),
- output_csharp_mlds(HLDS, MLDS, !IO),
+ output_csharp_mlds(HLDS, MLDS, Succeeded, !IO),
maybe_write_string(Verbose, "% Finished converting MLDS to C#.\n", !IO),
maybe_report_stats(Stats, !IO).
-mlds_to_il_assembler(Globals, MLDS, !IO) :-
+mlds_to_il_assembler(Globals, MLDS, Succeeded, !IO) :-
globals.lookup_bool_option(Globals, verbose, Verbose),
globals.lookup_bool_option(Globals, statistics, Stats),
maybe_write_string(Verbose, "% Converting MLDS to IL...\n", !IO),
- output_mlds_via_ilasm(Globals, MLDS, !IO),
+ output_mlds_via_ilasm(Globals, MLDS, Succeeded, !IO),
maybe_write_string(Verbose, "% Finished converting MLDS to IL.\n", !IO),
maybe_report_stats(Stats, !IO).
@@ -430,7 +434,7 @@ maybe_dump_mlds(Globals, MLDS, StageNum, StageName, !IO) :-
maybe_write_string(Verbose, "% Dumping out MLDS as C...\n", !IO),
maybe_flush_output(Verbose, !IO),
DumpSuffix = "_dump." ++ StageNumStr ++ "-" ++ StageName,
- output_c_mlds(MLDS, Globals, DumpSuffix, !IO),
+ output_c_mlds(MLDS, Globals, DumpSuffix, _Succeeded, !IO),
maybe_write_string(Verbose, "% done.\n", !IO)
;
true
diff --git a/compiler/mercury_to_mercury.m b/compiler/mercury_to_mercury.m
index ddef2fa..301496e 100644
--- a/compiler/mercury_to_mercury.m
+++ b/compiler/mercury_to_mercury.m
@@ -3350,7 +3350,7 @@ mercury_pragma_foreign_decl_to_string(FDInfo) = String :-
U::di, U::uo) is det <= output(U).
mercury_format_pragma_foreign_decl(FDInfo, !U) :-
- FDInfo = pragma_info_foreign_decl(Lang, IsLocal, ForeignDeclString),
+ FDInfo = pragma_info_foreign_decl(Lang, IsLocal, LiteralOrInclude),
add_string(":- pragma foreign_decl(", !U),
mercury_format_foreign_language_string(Lang, !U),
add_string(", ", !U),
@@ -3362,7 +3362,7 @@ mercury_format_pragma_foreign_decl(FDInfo, !U) :-
add_string("exported", !U)
),
add_string(", ", !U),
- mercury_format_foreign_code_string(ForeignDeclString, !U),
+ mercury_format_foreign_literal_or_include(LiteralOrInclude, !U),
add_string(").\n", !U).
mercury_output_foreign_language_string(Lang, !IO) :-
@@ -3467,13 +3467,27 @@ mercury_output_pragma_source_file(SourceFileInfo, !IO) :-
io::di, io::uo) is det.
mercury_output_pragma_foreign_body_code(FCInfo, !IO) :-
- FCInfo = pragma_info_foreign_code(Lang, ForeignCodeString),
+ FCInfo = pragma_info_foreign_code(Lang, LiteralOrInclude),
io.write_string(":- pragma foreign_code(", !IO),
mercury_format_foreign_language_string(Lang, !IO),
io.write_string(", ", !IO),
- mercury_format_foreign_code_string(ForeignCodeString, !IO),
+ mercury_format_foreign_literal_or_include(LiteralOrInclude, !IO),
io.write_string(").\n", !IO).
+:- pred mercury_format_foreign_literal_or_include(
+ foreign_literal_or_include::in, U::di, U::uo) is det <= output(U).
+
+mercury_format_foreign_literal_or_include(LiteralOrInclude, !U) :-
+ (
+ LiteralOrInclude = literal(Code),
+ mercury_format_foreign_code_string(Code, !U)
+ ;
+ LiteralOrInclude = include_file(FileName),
+ add_string("include_file(", !U),
+ add_quoted_string(FileName, !U),
+ add_string(")", !U)
+ ).
+
%-----------------------------------------------------------------------------%
mercury_output_pragma_foreign_proc(FPInfo, !IO) :-
@@ -3525,7 +3539,7 @@ mercury_format_pragma_foreign_proc(FPInfo, !U) :-
add_string(", ", !U),
mercury_format_pragma_foreign_attributes(Attributes, ProgVarset, !U),
add_string(", ", !U),
- PragmaCode = fc_impl_ordinary(C_Code, _),
+ PragmaCode = fp_impl_ordinary(C_Code, _),
mercury_format_foreign_code_string(C_Code, !U),
add_string(").\n", !U).
diff --git a/compiler/ml_code_gen.m b/compiler/ml_code_gen.m
index 54ec2d5..7118d5e 100644
--- a/compiler/ml_code_gen.m
+++ b/compiler/ml_code_gen.m
@@ -627,7 +627,7 @@ ml_gen_goal_expr(GoalExpr, CodeModel, Context, GoalInfo, Decls, Statements,
;
GoalExpr = call_foreign_proc(Attributes, PredId, ProcId,
Args, ExtraArgs, MaybeTraceRuntimeCond, PragmaImpl),
- PragmaImpl = fc_impl_ordinary(ForeignCode, MaybeContext),
+ PragmaImpl = fp_impl_ordinary(ForeignCode, MaybeContext),
(
MaybeContext = yes(ContextToUse)
;
diff --git a/compiler/mlds_to_c.m b/compiler/mlds_to_c.m
index 8fa8d8a..20ef4af 100644
--- a/compiler/mlds_to_c.m
+++ b/compiler/mlds_to_c.m
@@ -31,11 +31,12 @@
:- import_module libs.globals.
:- import_module ml_backend.mlds.
+:- import_module bool.
:- import_module io.
%-----------------------------------------------------------------------------%
- % output_c_mlds(MLDS, Globals, Suffix):
+ % output_c_mlds(MLDS, Globals, Suffix, Succeeded):
%
% Output C code the the appropriate C file and C declarations to the
% appropriate header file. The file names are determined by the module
@@ -43,28 +44,28 @@
% for debugging dumps. For normal output, the suffix should be the empty
% string.)
%
-:- pred output_c_mlds(mlds::in, globals::in, string::in, io::di, io::uo)
- is det.
+:- pred output_c_mlds(mlds::in, globals::in, string::in, bool::out,
+ io::di, io::uo) is det.
- % output_c_header_file(MLDS, Globals, Suffix):
+ % output_c_header_file(MLDS, Globals, Suffix, Succeeded):
%
% Output C declarations for the procedures (etc.) in the specified MLDS
% module to the appropriate .mih header file. See output_mlds for the
% meaning of Suffix.
%
-:- pred output_c_header_file(mlds::in, globals::in, string::in,
+:- pred output_c_header_file(mlds::in, globals::in, string::in, bool::out,
io::di, io::uo) is det.
:- func mlds_tabling_data_name(mlds_proc_label, proc_tabling_struct_id)
= string.
- % output_c_file(MLDS, Globals, Suffix):
+ % output_c_file(MLDS, Globals, Suffix, Succeeded):
%
% Output C code for the specified MLDS module to the appropriate C file.
% See output_mlds for the meaning of Suffix.
%
-:- pred output_c_file(mlds::in, globals::in, string::in, io::di, io::uo)
- is det.
+:- pred output_c_file(mlds::in, globals::in, string::in, bool::out,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -137,6 +138,8 @@
%
:- type mlds_to_c_opts
---> mlds_to_c_opts(
+ m2co_source_filename :: string,
+
m2co_line_numbers :: bool,
m2co_auto_comments :: bool,
m2co_gcc_local_labels :: bool,
@@ -156,9 +159,9 @@
m2co_all_globals :: globals
).
-:- func init_mlds_to_c_opts(globals) = mlds_to_c_opts.
+:- func init_mlds_to_c_opts(globals, string) = mlds_to_c_opts.
-init_mlds_to_c_opts(Globals) = Opts :-
+init_mlds_to_c_opts(Globals, SourceFileName) = Opts :-
globals.lookup_bool_option(Globals, line_numbers, LineNumbers),
globals.lookup_bool_option(Globals, auto_comments, Comments),
globals.lookup_bool_option(Globals, gcc_local_labels, GccLabels),
@@ -180,11 +183,12 @@ init_mlds_to_c_opts(Globals) = Opts :-
globals.get_target(Globals, Target),
globals.get_gc_method(Globals, GCMethod),
StdFuncDecls = no,
- Opts = mlds_to_c_opts(LineNumbers, Comments, GccLabels, GccNested,
+ Opts = mlds_to_c_opts(SourceFileName,
+ LineNumbers, Comments, GccLabels, GccNested,
HighLevelData, ProfileCalls, ProfileMemory, ProfileTime, ProfileAny,
Target, GCMethod, StdFuncDecls, Globals).
-output_c_mlds(MLDS, Globals, Suffix, !IO) :-
+output_c_mlds(MLDS, Globals, Suffix, Succeeded, !IO) :-
% We output the source file before outputting the header, since the Mmake
% dependencies say the header file depends on the source file, and so if
% we wrote them out in the other order, this might lead to unnecessary
@@ -193,34 +197,46 @@ output_c_mlds(MLDS, Globals, Suffix, !IO) :-
% XXX At some point we should also handle output of any non-C
% foreign code (Ada, Fortran, etc.) to appropriate files.
%
- Opts = init_mlds_to_c_opts(Globals),
- output_c_file_opts(MLDS, Opts, Suffix, !IO),
- output_c_header_file_opts(MLDS, Opts, Suffix, !IO).
+ ModuleName = mlds_get_module_name(MLDS),
+ module_source_filename(Globals, ModuleName, SourceFileName, !IO),
+ Opts = init_mlds_to_c_opts(Globals, SourceFileName),
+ output_c_file_opts(MLDS, Opts, Suffix, Succeeded0, !IO),
+ (
+ Succeeded0 = yes,
+ output_c_header_file_opts(MLDS, Opts, Suffix, Succeeded, !IO)
+ ;
+ Succeeded0 = no,
+ Succeeded = no
+ ).
-output_c_file(MLDS, Globals, Suffix, !IO) :-
- Opts = init_mlds_to_c_opts(Globals),
- output_c_file_opts(MLDS, Opts, Suffix, !IO).
+output_c_file(MLDS, Globals, Suffix, Succeeded, !IO) :-
+ ModuleName = mlds_get_module_name(MLDS),
+ module_source_filename(Globals, ModuleName, SourceFileName, !IO),
+ Opts = init_mlds_to_c_opts(Globals, SourceFileName),
+ output_c_file_opts(MLDS, Opts, Suffix, Succeeded, !IO).
:- pred output_c_file_opts(mlds::in, mlds_to_c_opts::in, string::in,
- io::di, io::uo) is det.
+ bool::out, io::di, io::uo) is det.
-output_c_file_opts(MLDS, Opts, Suffix, !IO) :-
+output_c_file_opts(MLDS, Opts, Suffix, Succeeded, !IO) :-
ModuleName = mlds_get_module_name(MLDS),
Globals = Opts ^ m2co_all_globals,
module_name_to_file_name(Globals, ModuleName, ".c" ++ Suffix,
do_create_dirs, SourceFile, !IO),
Indent = 0,
output_to_file(Globals, SourceFile,
- mlds_output_src_file(Opts, Indent, MLDS), !IO).
+ mlds_output_src_file(Opts, Indent, MLDS), Succeeded, !IO).
-output_c_header_file(MLDS, Globals, Suffix, !IO) :-
- Opts = init_mlds_to_c_opts(Globals),
- output_c_header_file_opts(MLDS, Opts, Suffix, !IO).
+output_c_header_file(MLDS, Globals, Suffix, Succeeded, !IO) :-
+ ModuleName = mlds_get_module_name(MLDS),
+ module_source_filename(Globals, ModuleName, SourceFileName, !IO),
+ Opts = init_mlds_to_c_opts(Globals, SourceFileName),
+ output_c_header_file_opts(MLDS, Opts, Suffix, Succeeded, !IO).
:- pred output_c_header_file_opts(mlds::in, mlds_to_c_opts::in, string::in,
- io::di, io::uo) is det.
+ bool::out, io::di, io::uo) is det.
-output_c_header_file_opts(MLDS, Opts, Suffix, !IO) :-
+output_c_header_file_opts(MLDS, Opts, Suffix, Succeeded, !IO) :-
% We write the header file out to <module>.mih.tmp and then call
% `update_interface' to move the <module>.mih.tmp file to <module>.mih;
% this avoids updating the timestamp on the `.mih' file if it hasn't
@@ -234,8 +250,13 @@ output_c_header_file_opts(MLDS, Opts, Suffix, !IO) :-
do_create_dirs, HeaderFile, !IO),
Indent = 0,
output_to_file(Globals, TmpHeaderFile,
- mlds_output_hdr_file(Opts, Indent, MLDS), !IO),
- update_interface(Globals, HeaderFile, !IO).
+ mlds_output_hdr_file(Opts, Indent, MLDS), Succeeded, !IO),
+ (
+ Succeeded = yes,
+ update_interface(Globals, HeaderFile, !IO)
+ ;
+ Succeeded = no
+ ).
:- pred mlds_output_hdr_file(mlds_to_c_opts::in, indent::in, mlds::in,
io::di, io::uo) is det.
@@ -915,7 +936,7 @@ mlds_output_c_hdr_decls(Opts, Indent, ModuleName, ForeignCode, !IO) :-
io::di, io::uo) is det.
mlds_output_c_hdr_decl(Opts, _Indent, MaybeDesiredIsLocal, DeclCode, !IO) :-
- DeclCode = foreign_decl_code(Lang, IsLocal, Code, Context),
+ DeclCode = foreign_decl_code(Lang, IsLocal, LiteralOrInclude, Context),
% Only output C code in the C header file.
(
Lang = lang_c,
@@ -927,8 +948,8 @@ mlds_output_c_hdr_decl(Opts, _Indent, MaybeDesiredIsLocal, DeclCode, !IO) :-
IsLocal = DesiredIsLocal
)
->
- output_context_opts(Opts, mlds_make_context(Context), !IO),
- io.write_string(Code, !IO)
+ mlds_output_foreign_literal_or_include(Opts, LiteralOrInclude,
+ Context, !IO)
;
true
)
@@ -989,11 +1010,11 @@ mlds_output_c_foreign_import_module(Opts, Indent, ForeignImport, !IO) :-
user_foreign_code::in, io::di, io::uo) is det.
mlds_output_c_defn(Opts, _Indent, UserForeignCode, !IO) :-
- UserForeignCode = user_foreign_code(Lang, Code, Context),
+ UserForeignCode = user_foreign_code(Lang, LiteralOrInclude, Context),
(
Lang = lang_c,
- output_context_opts(Opts, mlds_make_context(Context), !IO),
- io.write_string(Code, !IO)
+ mlds_output_foreign_literal_or_include(Opts, LiteralOrInclude, Context,
+ !IO)
;
( Lang = lang_csharp
; Lang = lang_il
@@ -1003,6 +1024,22 @@ mlds_output_c_defn(Opts, _Indent, UserForeignCode, !IO) :-
sorry($module, $pred, "foreign code other than C")
).
+:- pred mlds_output_foreign_literal_or_include(mlds_to_c_opts::in,
+ foreign_literal_or_include::in, prog_context::in, io::di, io::uo) is det.
+
+mlds_output_foreign_literal_or_include(Opts, LiteralOrInclude, Context, !IO) :-
+ (
+ LiteralOrInclude = literal(Code),
+ output_context_opts(Opts, mlds_make_context(Context), !IO),
+ io.write_string(Code, !IO)
+ ;
+ LiteralOrInclude = include_file(IncludeFileName),
+ SourceFileName = Opts ^ m2co_source_filename,
+ make_include_file_path(SourceFileName, IncludeFileName, IncludePath),
+ output_context_opts(Opts, IncludePath, 1, !IO),
+ write_include_file_contents(IncludePath, !IO)
+ ).
+
:- pred mlds_output_pragma_export_defn(mlds_to_c_opts::in,
mlds_module_name::in, indent::in, mlds_pragma_export::in, io::di, io::uo)
is det.
@@ -4721,6 +4758,18 @@ output_context_opts(Opts, Context, !IO) :-
LineNumbers = no
).
+:- pred output_context_opts(mlds_to_c_opts::in, string::in, int::in,
+ io::di, io::uo) is det.
+
+output_context_opts(Opts, FileName, LineNumber, !IO) :-
+ LineNumbers = Opts ^ m2co_line_numbers,
+ (
+ LineNumbers = yes,
+ c_util.always_set_line_num(FileName, LineNumber, !IO)
+ ;
+ LineNumbers = no
+ ).
+
:- pred reset_context_opts(mlds_to_c_opts::in, io::di, io::uo) is det.
reset_context_opts(Opts, !IO) :-
diff --git a/compiler/mlds_to_cs.m b/compiler/mlds_to_cs.m
index e8d2659..aa43ebd 100644
--- a/compiler/mlds_to_cs.m
+++ b/compiler/mlds_to_cs.m
@@ -32,11 +32,13 @@
:- import_module hlds.hlds_module.
:- import_module ml_backend.mlds.
+:- import_module bool.
:- import_module io.
%-----------------------------------------------------------------------------%
-:- pred output_csharp_mlds(module_info::in, mlds::in, io::di, io::uo) is det.
+:- pred output_csharp_mlds(module_info::in, mlds::in, bool::out,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -68,7 +70,6 @@
:- import_module parse_tree.prog_out.
:- import_module parse_tree.prog_type.
-:- import_module bool.
:- import_module cord.
:- import_module digraph.
:- import_module int.
@@ -84,14 +85,14 @@
%-----------------------------------------------------------------------------%
-output_csharp_mlds(ModuleInfo, MLDS, !IO) :-
+output_csharp_mlds(ModuleInfo, MLDS, Succeeded, !IO) :-
module_info_get_globals(ModuleInfo, Globals),
ModuleName = mlds_get_module_name(MLDS),
module_name_to_file_name(Globals, ModuleName, ".cs", do_create_dirs,
SourceFile, !IO),
Indent = 0,
output_to_file(Globals, SourceFile,
- output_csharp_src_file(ModuleInfo, Indent, MLDS), !IO).
+ output_csharp_src_file(ModuleInfo, Indent, MLDS), Succeeded, !IO).
%-----------------------------------------------------------------------------%
%
@@ -162,9 +163,10 @@ output_csharp_src_file(ModuleInfo, Indent, MLDS, !IO) :-
% Output transformed MLDS as C# source.
module_info_get_globals(ModuleInfo, Globals),
- Info = init_csharp_out_info(ModuleInfo, CodeAddrs),
- output_src_start(Globals, Info, Indent, ModuleName, Imports, ForeignDecls,
- Defns, !IO),
+ module_source_filename(Globals, ModuleName, SourceFileName, !IO),
+ Info = init_csharp_out_info(ModuleInfo, SourceFileName, CodeAddrs),
+ output_src_start(Info, Indent, ModuleName, Imports, ForeignDecls, Defns,
+ !IO),
io.write_list(ForeignBodyCode, "\n", output_csharp_body_code(Info, Indent),
!IO),
@@ -225,13 +227,11 @@ output_csharp_src_file(ModuleInfo, Indent, MLDS, !IO) :-
foreign_decl_code::in, io::di, io::uo) is det.
output_csharp_decl(Info, Indent, DeclCode, !IO) :-
- DeclCode = foreign_decl_code(Lang, _IsLocal, Code, Context),
+ DeclCode = foreign_decl_code(Lang, _IsLocal, LiteralOrInclude, Context),
(
Lang = lang_csharp,
- indent_line(Info, mlds_make_context(Context), Indent, !IO),
- io.write_string(Code, !IO),
- io.nl(!IO),
- output_default_context(Info, !IO)
+ output_csharp_foreign_literal_or_include(Info, Indent,
+ LiteralOrInclude, Context, !IO)
;
( Lang = lang_c
; Lang = lang_java
@@ -245,14 +245,12 @@ output_csharp_decl(Info, Indent, DeclCode, !IO) :-
user_foreign_code::in, io::di, io.state::uo) is det.
output_csharp_body_code(Info, Indent, UserForeignCode, !IO) :-
- UserForeignCode = user_foreign_code(Lang, Code, Context),
+ UserForeignCode = user_foreign_code(Lang, LiteralOrInclude, Context),
% Only output C# code.
(
Lang = lang_csharp,
- indent_line(Info, mlds_make_context(Context), Indent, !IO),
- io.write_string(Code, !IO),
- io.nl(!IO),
- output_default_context(Info, !IO)
+ output_csharp_foreign_literal_or_include(Info, Indent,
+ LiteralOrInclude, Context, !IO)
;
( Lang = lang_c
; Lang = lang_java
@@ -262,6 +260,26 @@ output_csharp_body_code(Info, Indent, UserForeignCode, !IO) :-
sorry($module, $pred, "foreign code other than C#")
).
+:- pred output_csharp_foreign_literal_or_include(csharp_out_info::in,
+ indent::in, foreign_literal_or_include::in, prog_context::in,
+ io::di, io::uo) is det.
+
+output_csharp_foreign_literal_or_include(Info, Indent, LiteralOrInclude,
+ Context, !IO) :-
+ (
+ LiteralOrInclude = literal(Code),
+ indent_line_prog_context(Info, Context, Indent, !IO),
+ io.write_string(Code, !IO)
+ ;
+ LiteralOrInclude = include_file(IncludeFileName),
+ SourceFileName = Info ^ oi_source_filename,
+ make_include_file_path(SourceFileName, IncludeFileName, IncludePath),
+ output_context(Info, context(IncludePath, 1), !IO),
+ write_include_file_contents(IncludePath, !IO)
+ ),
+ io.nl(!IO),
+ output_default_context(Info, !IO).
+
:- func mlds_get_csharp_foreign_code(map(foreign_language, mlds_foreign_code))
= mlds_foreign_code.
@@ -735,13 +753,13 @@ output_env_var_definition(Indent, EnvVarName, !IO) :-
% Code to output the start and end of a source file.
%
-:- pred output_src_start(globals::in, csharp_out_info::in, indent::in,
+:- pred output_src_start(csharp_out_info::in, indent::in,
mercury_module_name::in, mlds_imports::in, list(foreign_decl_code)::in,
list(mlds_defn)::in, io::di, io::uo) is det.
-output_src_start(Globals, Info, Indent, MercuryModuleName, _Imports,
- ForeignDecls, Defns, !IO) :-
- output_auto_gen_comment(Globals, MercuryModuleName, !IO),
+output_src_start(Info, Indent, MercuryModuleName, _Imports, ForeignDecls,
+ Defns, !IO) :-
+ output_auto_gen_comment(Info, !IO),
indent_line(Indent, !IO),
io.write_string("/* :- module ", !IO),
prog_out.write_sym_name(MercuryModuleName, !IO),
@@ -845,13 +863,11 @@ output_src_end(Indent, ModuleName, !IO) :-
% Output a comment saying that the file was automatically
% generated and give details such as the compiler version.
%
-:- pred output_auto_gen_comment(globals::in, mercury_module_name::in,
- io::di, io::uo) is det.
+:- pred output_auto_gen_comment(csharp_out_info::in, io::di, io::uo) is det.
-output_auto_gen_comment(Globals, ModuleName, !IO) :-
+output_auto_gen_comment(Info, !IO) :-
library.version(Version),
- module_name_to_file_name(Globals, ModuleName, ".m", do_not_create_dirs,
- SourceFileName, !IO),
+ SourceFileName = Info ^ oi_source_filename,
io.write_string("//\n//\n// Automatically generated from ", !IO),
io.write_string(SourceFileName, !IO),
io.write_string(" by the Mercury Compiler,\n", !IO),
@@ -3173,7 +3189,7 @@ output_target_code_component(Info, TargetCode, !IO) :-
io.write_string("{\n", !IO),
(
MaybeUserContext = yes(ProgContext),
- output_context(Info, mlds_make_context(ProgContext), !IO)
+ output_context(Info, ProgContext, !IO)
;
MaybeUserContext = no
),
@@ -3762,15 +3778,14 @@ mlds_output_data_addr(data_addr(ModuleQualifier, DataName), !IO) :-
% source context annotations.
%
-:- pred output_context(csharp_out_info::in, mlds_context::in,
+:- pred output_context(csharp_out_info::in, prog_context::in,
io::di, io::uo) is det.
output_context(Info, Context, !IO) :-
LineNumbers = Info ^ oi_line_numbers,
(
LineNumbers = yes,
- ProgContext = mlds_get_prog_context(Context),
- ProgContext = term.context(File, Line),
+ Context = term.context(File, Line),
(
Line > 0,
File \= ""
@@ -3794,12 +3809,19 @@ output_default_context(Info, !IO) :-
LineNumbers = no
).
+:- pred indent_line_prog_context(csharp_out_info::in, prog_context::in,
+ indent::in, io::di, io::uo) is det.
+
+indent_line_prog_context(Info, Context, N, !IO) :-
+ output_context(Info, Context, !IO),
+ indent_line(N, !IO).
+
:- pred indent_line(csharp_out_info::in, mlds_context::in, indent::in,
io::di, io::uo) is det.
indent_line(Info, Context, N, !IO) :-
- output_context(Info, Context, !IO),
- indent_line(N, !IO).
+ ProgContext = mlds_get_prog_context(Context),
+ indent_line_prog_context(Info, ProgContext, N, !IO).
% A value of type `indent' records the number of levels of indentation
% to indent the next piece of code. Currently we output two spaces
@@ -3841,6 +3863,7 @@ output_pragma_warning_restore(!IO) :-
oi_auto_comments :: bool,
oi_line_numbers :: bool,
oi_module_name :: mlds_module_name,
+ oi_source_filename :: string,
oi_code_addrs :: map(mlds_code_addr, string),
% These are dynamic.
@@ -3852,17 +3875,18 @@ output_pragma_warning_restore(!IO) :-
---> do_output_generics
; do_not_output_generics.
-:- func init_csharp_out_info(module_info, map(mlds_code_addr, string))
+:- func init_csharp_out_info(module_info, string, map(mlds_code_addr, string))
= csharp_out_info.
-init_csharp_out_info(ModuleInfo, CodeAddrs) = Info :-
+init_csharp_out_info(ModuleInfo, SourceFileName, CodeAddrs) = Info :-
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, auto_comments, AutoComments),
globals.lookup_bool_option(Globals, line_numbers, LineNumbers),
module_info_get_name(ModuleInfo, ModuleName),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
Info = csharp_out_info(ModuleInfo, AutoComments, LineNumbers,
- MLDS_ModuleName, CodeAddrs, do_not_output_generics, []).
+ MLDS_ModuleName, SourceFileName, CodeAddrs, do_not_output_generics,
+ []).
%-----------------------------------------------------------------------------%
:- end_module ml_backend.mlds_to_cs.
diff --git a/compiler/mlds_to_ilasm.m b/compiler/mlds_to_ilasm.m
index e17ba5b..6a08de6 100644
--- a/compiler/mlds_to_ilasm.m
+++ b/compiler/mlds_to_ilasm.m
@@ -21,13 +21,15 @@
:- import_module libs.globals.
:- import_module ml_backend.mlds.
+:- import_module bool.
:- import_module io.
%-----------------------------------------------------------------------------%
% Convert the MLDS to IL and write it to a file.
%
-:- pred output_mlds_via_ilasm(globals::in, mlds::in, io::di, io::uo) is det.
+:- pred output_mlds_via_ilasm(globals::in, mlds::in, bool::out,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -43,7 +45,6 @@
:- import_module parse_tree.file_names.
:- import_module parse_tree.prog_foreign.
-:- import_module bool.
:- import_module list.
:- import_module maybe.
:- import_module require.
@@ -51,7 +52,7 @@
%-----------------------------------------------------------------------------%
-output_mlds_via_ilasm(Globals, MLDS, !IO) :-
+output_mlds_via_ilasm(Globals, MLDS, Succeeded, !IO) :-
ModuleName = mlds_get_module_name(MLDS),
module_name_to_file_name(Globals, ModuleName, ".il",
do_create_dirs, ILAsmFile, !IO),
@@ -62,18 +63,19 @@ output_mlds_via_ilasm(Globals, MLDS, !IO) :-
Result = yes(ForeignLangs),
% Output any outline foreign_code to the appropriate foreign
% language file.
- list.foldl(output_foreign_file(Globals, MLDS),
- set.to_sorted_list(ForeignLangs), !IO)
+ list.foldl2(output_foreign_file(Globals, MLDS),
+ set.to_sorted_list(ForeignLangs), yes, Succeeded, !IO)
;
% An I/O error occurred; output_to_file has already reported
% an error message, so we don't need to do anything here.
- Result = no
+ Result = no,
+ Succeeded = no
).
:- pred output_foreign_file(globals::in, mlds::in, foreign_language::in,
- io::di, io::uo) is det.
+ bool::in, bool::out, io::di, io::uo) is det.
-output_foreign_file(Globals, MLDS, ForeignLang, !IO) :-
+output_foreign_file(Globals, MLDS, ForeignLang, !Succeeded, !IO) :-
ModuleName = mlds_get_module_name(MLDS),
(
ForeignModuleName = foreign_language_module_name(ModuleName,
@@ -85,7 +87,8 @@ output_foreign_file(Globals, MLDS, ForeignLang, !IO) :-
module_name_to_file_name(Globals, ForeignModuleName, Extension,
do_create_dirs, File, !IO),
output_to_file(Globals, File, output_csharp_code(Globals, MLDS),
- !IO)
+ TargetCodeSucceeded, !IO),
+ bool.and(TargetCodeSucceeded, !Succeeded)
;
ForeignLang = lang_c,
sorry($module, $pred, "language C foreign code not supported")
diff --git a/compiler/mlds_to_java.m b/compiler/mlds_to_java.m
index fcf3b90..867a64c 100644
--- a/compiler/mlds_to_java.m
+++ b/compiler/mlds_to_java.m
@@ -70,11 +70,13 @@
:- import_module hlds.hlds_module.
:- import_module ml_backend.mlds.
+:- import_module bool.
:- import_module io.
%-----------------------------------------------------------------------------%
-:- pred output_java_mlds(module_info::in, mlds::in, io::di, io::uo) is det.
+:- pred output_java_mlds(module_info::in, mlds::in, bool::out,
+ io::di, io::uo) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -108,7 +110,6 @@
:- import_module parse_tree.prog_type.
:- import_module assoc_list.
-:- import_module bool.
:- import_module char.
:- import_module cord.
:- import_module digraph.
@@ -127,7 +128,7 @@
%-----------------------------------------------------------------------------%
-output_java_mlds(ModuleInfo, MLDS, !IO) :-
+output_java_mlds(ModuleInfo, MLDS, Succeeded, !IO) :-
% Note that the Java file name that we use for modules in the
% Mercury standard library do not include a "mercury." prefix;
% that's why we don't call mercury_module_name_to_mlds here.
@@ -137,7 +138,7 @@ output_java_mlds(ModuleInfo, MLDS, !IO) :-
JavaSourceFile, !IO),
Indent = 0,
output_to_file(Globals, JavaSourceFile,
- output_java_src_file(ModuleInfo, Indent, MLDS), !IO).
+ output_java_src_file(ModuleInfo, Indent, MLDS), Succeeded, !IO).
%-----------------------------------------------------------------------------%
%
@@ -388,9 +389,10 @@ output_java_src_file(ModuleInfo, Indent, MLDS, !IO) :-
% library/private_builtin.m they contain static constants
% that will get used in the RTTI definitions.
module_info_get_globals(ModuleInfo, Globals),
- Info = init_java_out_info(ModuleInfo, AddrOfMap),
- output_src_start(Globals, Info, Indent, ModuleName, Imports, ForeignDecls,
- Defns, !IO),
+ module_source_filename(Globals, ModuleName, SourceFileName, !IO),
+ Info = init_java_out_info(ModuleInfo, SourceFileName, AddrOfMap),
+ output_src_start(Info, Indent, ModuleName, Imports, ForeignDecls, Defns,
+ !IO),
io.write_list(ForeignBodyCode, "\n", output_java_body_code(Info, Indent),
!IO),
@@ -443,10 +445,11 @@ output_java_src_file(ModuleInfo, Indent, MLDS, !IO) :-
io::di, io::uo) is det.
output_java_decl(Info, Indent, DeclCode, !IO) :-
- DeclCode = foreign_decl_code(Lang, _IsLocal, Code, Context),
+ DeclCode = foreign_decl_code(Lang, _IsLocal, LiteralOrInclude, Context),
(
Lang = lang_java,
- write_string_with_context_block(Info, Indent, Code, Context, !IO)
+ output_java_foreign_literal_or_include(Info, Indent,
+ LiteralOrInclude, Context, !IO)
;
( Lang = lang_c
; Lang = lang_csharp
@@ -460,11 +463,12 @@ output_java_decl(Info, Indent, DeclCode, !IO) :-
user_foreign_code::in, io::di, io.state::uo) is det.
output_java_body_code(Info, Indent, UserForeignCode, !IO) :-
- UserForeignCode = user_foreign_code(Lang, Code, Context),
+ UserForeignCode = user_foreign_code(Lang, LiteralOrInclude, Context),
% Only output Java code.
(
Lang = lang_java,
- write_string_with_context_block(Info, Indent, Code, Context, !IO)
+ output_java_foreign_literal_or_include(Info, Indent, LiteralOrInclude,
+ Context, !IO)
;
( Lang = lang_c
; Lang = lang_csharp
@@ -474,6 +478,26 @@ output_java_body_code(Info, Indent, UserForeignCode, !IO) :-
sorry($module, $pred, "foreign code other than Java")
).
+:- pred output_java_foreign_literal_or_include(java_out_info::in,
+ indent::in, foreign_literal_or_include::in, prog_context::in,
+ io::di, io::uo) is det.
+
+output_java_foreign_literal_or_include(Info, Indent, LiteralOrInclude,
+ Context, !IO) :-
+ (
+ LiteralOrInclude = literal(Code),
+ write_string_with_context_block(Info, Indent, Code, Context, !IO)
+ ;
+ LiteralOrInclude = include_file(IncludeFile),
+ SourceFileName = Info ^ joi_source_filename,
+ make_include_file_path(SourceFileName, IncludeFile, IncludePath),
+ output_context(Info, marker_begin_block, context(IncludePath, 1), !IO),
+ write_include_file_contents(IncludePath, !IO),
+ io.nl(!IO),
+ % We don't have the true end context readily available.
+ output_context(Info, marker_end_block, Context, !IO)
+ ).
+
% Get the foreign code for Java.
%
:- func mlds_get_java_foreign_code(map(foreign_language, mlds_foreign_code))
@@ -1991,13 +2015,13 @@ output_env_var_definition(Indent, EnvVarName, !IO) :-
% Code to output the start and end of a source file.
%
-:- pred output_src_start(globals::in, java_out_info::in, indent::in,
+:- pred output_src_start(java_out_info::in, indent::in,
mercury_module_name::in, mlds_imports::in, list(foreign_decl_code)::in,
list(mlds_defn)::in, io::di, io::uo) is det.
-output_src_start(Globals, Info, Indent, MercuryModuleName, Imports,
- ForeignDecls, Defns, !IO) :-
- output_auto_gen_comment(Globals, MercuryModuleName, !IO),
+output_src_start(Info, Indent, MercuryModuleName, Imports, ForeignDecls, Defns,
+ !IO) :-
+ output_auto_gen_comment(Info, !IO),
indent_line(Indent, !IO),
io.write_string("/* :- module ", !IO),
prog_out.write_sym_name(MercuryModuleName, !IO),
@@ -2094,13 +2118,11 @@ output_debug_class_init(ModuleName, State, !IO) :-
% Output a Java comment saying that the file was automatically
% generated and give details such as the compiler version.
%
-:- pred output_auto_gen_comment(globals::in, mercury_module_name::in,
- io::di, io::uo) is det.
+:- pred output_auto_gen_comment(java_out_info::in, io::di, io::uo) is det.
-output_auto_gen_comment(Globals, ModuleName, !IO) :-
+output_auto_gen_comment(Info, !IO) :-
library.version(Version),
- module_name_to_file_name(Globals, ModuleName, ".m", do_not_create_dirs,
- SourceFileName, !IO),
+ SourceFileName = Info ^ joi_source_filename,
io.write_string("//\n//\n// Automatically generated from ", !IO),
io.write_string(SourceFileName, !IO),
io.write_string(" by the Mercury Compiler,\n", !IO),
@@ -3903,7 +3925,8 @@ output_statements(Info, Indent, FuncInfo, [Statement | Statements],
output_statement(Info, Indent, FuncInfo,
statement(Statement, Context), ExitMethods, !IO) :-
- output_context(Info, marker_comment, Context, !IO),
+ ProgContext = mlds_get_prog_context(Context),
+ output_context(Info, marker_comment, ProgContext, !IO),
output_stmt(Info, Indent, FuncInfo, Statement, Context,
ExitMethods, !IO).
@@ -5166,13 +5189,12 @@ mlds_output_data_addr(data_addr(ModuleQualifier, DataName), !IO) :-
% Mercury developers.
:- pred output_context(java_out_info::in, context_marker::in,
- mlds_context::in, io::di, io::uo) is det.
+ prog_context::in, io::di, io::uo) is det.
-output_context(Info, Marker, Context, !IO) :-
+output_context(Info, Marker, ProgContext, !IO) :-
LineNumbers = Info ^ joi_line_numbers,
(
LineNumbers = yes,
- ProgContext = mlds_get_prog_context(Context),
get_last_context(LastContext, !IO),
term.context_file(ProgContext, File),
term.context_line(ProgContext, Line),
@@ -5212,12 +5234,19 @@ marker_string(marker_begin_block) = "MER_FOREIGN_BEGIN".
marker_string(marker_end_block) = "MER_FOREIGN_END".
marker_string(marker_comment) = "".
+:- pred indent_line_prog_context(java_out_info::in, context_marker::in,
+ prog_context::in, indent::in, io::di, io::uo) is det.
+
+indent_line_prog_context(Info, Marker, Context, N, !IO) :-
+ output_context(Info, Marker, Context, !IO),
+ indent_line(N, !IO).
+
:- pred indent_line(java_out_info::in, context_marker::in, mlds_context::in,
indent::in, io::di, io::uo) is det.
indent_line(Info, Marker, Context, N, !IO) :-
- output_context(Info, Marker, Context, !IO),
- indent_line(N, !IO).
+ ProgContext = mlds_get_prog_context(Context),
+ indent_line_prog_context(Info, Marker, ProgContext, N, !IO).
% A value of type `indent' records the number of levels of indentation
% to indent the next piece of code. Currently we output two spaces
@@ -5239,14 +5268,16 @@ indent_line(N, !IO) :-
string::in, prog_context::in, io::di, io::uo) is det.
write_string_with_context_block(Info, Indent, Code, Context, !IO) :-
- indent_line(Info, marker_begin_block, mlds_make_context(Context),
- Indent, !IO),
+ indent_line_prog_context(Info, marker_begin_block, Context, Indent, !IO),
io.write_string(Code, !IO),
io.nl(!IO),
+ % The num_lines(Code) call is supposed to count the number of lines
+ % occupied by Code in the source file. The result will be incorrect if
+ % there were any escape sequences representing CR or LF characters --
+ % they are expanded out in Code.
Context = context(File, Lines0),
ContextEnd = context(File, Lines0 + num_lines(Code)),
- indent_line(Info, marker_end_block, mlds_make_context(ContextEnd),
- Indent, !IO).
+ indent_line_prog_context(Info, marker_end_block, ContextEnd, Indent, !IO).
:- func num_lines(string) = int.
@@ -5279,6 +5310,7 @@ num_lines(String) = Num :-
joi_auto_comments :: bool,
joi_line_numbers :: bool,
joi_module_name :: mlds_module_name,
+ joi_source_filename :: string,
joi_addrof_map :: map(mlds_code_addr, code_addr_wrapper),
% These are dynamic.
@@ -5290,17 +5322,18 @@ num_lines(String) = Num :-
---> do_output_generics
; do_not_output_generics.
-:- func init_java_out_info(module_info, map(mlds_code_addr, code_addr_wrapper))
- = java_out_info.
+:- func init_java_out_info(module_info, string,
+ map(mlds_code_addr, code_addr_wrapper)) = java_out_info.
-init_java_out_info(ModuleInfo, AddrOfMap) = Info :-
+init_java_out_info(ModuleInfo, SourceFileName, AddrOfMap) = Info :-
module_info_get_globals(ModuleInfo, Globals),
globals.lookup_bool_option(Globals, auto_comments, AutoComments),
globals.lookup_bool_option(Globals, line_numbers, LineNumbers),
module_info_get_name(ModuleInfo, ModuleName),
MLDS_ModuleName = mercury_module_name_to_mlds(ModuleName),
Info = java_out_info(ModuleInfo, AutoComments, LineNumbers,
- MLDS_ModuleName, AddrOfMap, do_not_output_generics, []).
+ MLDS_ModuleName, SourceFileName, AddrOfMap, do_not_output_generics,
+ []).
%-----------------------------------------------------------------------------%
:- end_module ml_backend.mlds_to_java.
diff --git a/compiler/mlds_to_managed.m b/compiler/mlds_to_managed.m
index 1df06a1..910b625 100644
--- a/compiler/mlds_to_managed.m
+++ b/compiler/mlds_to_managed.m
@@ -41,12 +41,14 @@
:- implementation.
:- import_module backend_libs.c_util.
+:- import_module libs.file_util.
:- import_module libs.options.
:- import_module mdbcomp.prim_data.
:- import_module ml_backend.ilds.
:- import_module ml_backend.ml_global_data.
:- import_module ml_backend.ml_util.
:- import_module ml_backend.mlds_to_il.
+:- import_module parse_tree.file_names.
:- import_module parse_tree.prog_data.
:- import_module parse_tree.prog_foreign.
:- import_module parse_tree.prog_out.
@@ -83,8 +85,9 @@ output_csharp_code(Globals, MLDS, !IO) :-
output_csharp_header_code(Globals, !IO),
% Get the foreign code for the required language.
+ module_source_filename(Globals, ModuleName, SourceFileName, !IO),
ForeignCode = map.lookup(AllForeignCode, lang_csharp),
- generate_foreign_header_code(Globals, ForeignCode, !IO),
+ generate_foreign_header_code(Globals, SourceFileName, ForeignCode, !IO),
% Output the namespace.
generate_namespace_details(ClassName, NameSpaceFmtStr, Namespace),
@@ -96,7 +99,7 @@ output_csharp_code(Globals, MLDS, !IO) :-
io.write_strings(["\npublic class " ++ wrapper_class_name, "{\n"], !IO),
% Output the contents of pragma foreign_code declarations.
- generate_foreign_code(Globals, ForeignCode, !IO),
+ generate_foreign_code(Globals, SourceFileName, ForeignCode, !IO),
io.nl(!IO),
@@ -161,22 +164,22 @@ output_csharp_header_code(Globals, !IO) :-
SignAssembly = no
).
-:- pred generate_foreign_header_code(globals::in, mlds_foreign_code::in,
- io::di, io::uo) is det.
+:- pred generate_foreign_header_code(globals::in, string::in,
+ mlds_foreign_code::in, io::di, io::uo) is det.
-generate_foreign_header_code(Globals, ForeignCode, !IO) :-
+generate_foreign_header_code(Globals, SourceFileName, ForeignCode, !IO) :-
ForeignCode = mlds_foreign_code(RevHeaderCode, _RevImports,
_RevBodyCode, _ExportDefns),
HeaderCode = list.reverse(RevHeaderCode),
io.write_list(HeaderCode, "\n",
% XXX Ignoring _IsLocal may not be the right thing to do.
- (pred(foreign_decl_code(CodeLang, _IsLocal, Code, Context)::in,
- !.IO::di, !:IO::uo) is det :-
- output_context(Globals, Context, !IO),
+ (pred(ForeignDeclCode::in, !.IO::di, !:IO::uo) is det :-
+ ForeignDeclCode = foreign_decl_code(CodeLang, _IsLocal,
+ LiteralOrInclude, Context),
( CodeLang = lang_csharp ->
- io.write_string(Code, !IO),
- io.nl(!IO)
+ output_foreign_literal_or_include(Globals, SourceFileName,
+ LiteralOrInclude, Context, !IO)
;
sorry($module, $pred, "wrong foreign code")
),
@@ -201,26 +204,42 @@ generate_namespace_details(ClassName, NameSpaceFmtStr, Namespace) :-
Namespace = Namespace0
).
-:- pred generate_foreign_code(globals::in, mlds_foreign_code::in,
+:- pred generate_foreign_code(globals::in, string::in, mlds_foreign_code::in,
io::di, io::uo) is det.
-generate_foreign_code(Globals, ForeignCode, !IO) :-
+generate_foreign_code(Globals, SourceFileName, ForeignCode, !IO) :-
ForeignCode = mlds_foreign_code(_RevHeaderCode, _RevImports,
RevBodyCode, _ExportDefns),
BodyCode = list.reverse(RevBodyCode),
io.write_list(BodyCode, "\n",
- (pred(user_foreign_code(CodeLang, Code, Context)::in,
+ (pred(user_foreign_code(CodeLang, LiteralOrInclude, Context)::in,
!.IO::di, !:IO::uo) is det :-
- output_context(Globals, Context, !IO),
( CodeLang = lang_csharp ->
- io.write_string(Code, !IO),
- io.nl(!IO)
+ output_foreign_literal_or_include(Globals, SourceFileName,
+ LiteralOrInclude, Context, !IO)
;
sorry($module, $pred, "wrong foreign code")
),
output_reset_context(Globals, !IO)
), !IO).
+:- pred output_foreign_literal_or_include(globals::in, string::in,
+ foreign_literal_or_include::in, prog_context::in, io::di, io::uo) is det.
+
+output_foreign_literal_or_include(Globals, SourceFileName,
+ LiteralOrInclude, Context, !IO) :-
+ (
+ LiteralOrInclude = literal(Code),
+ output_context(Globals, Context, !IO),
+ io.write_string(Code, !IO)
+ ;
+ LiteralOrInclude = include_file(IncludeFileName),
+ make_include_file_path(SourceFileName, IncludeFileName, IncludePath),
+ output_context(Globals, context(IncludePath, 1), !IO),
+ write_include_file_contents(IncludePath, !IO)
+ ),
+ io.nl(!IO).
+
:- pred generate_method_code(globals::in, il_data_rep::in, mlds_defn::in,
io::di, io::uo) is det.
diff --git a/compiler/modecheck_goal.m b/compiler/modecheck_goal.m
index d2b2fe1..18aba58 100644
--- a/compiler/modecheck_goal.m
+++ b/compiler/modecheck_goal.m
@@ -1420,7 +1420,7 @@ modecheck_goal_unify(LHS0, RHS0, Unification0, UnifyContext, GoalInfo0,
:- pred modecheck_goal_call_foreign_proc(pragma_foreign_proc_attributes::in,
pred_id::in, proc_id::in, list(foreign_arg)::in, list(foreign_arg)::in,
- maybe(trace_expr(trace_runtime))::in, pragma_foreign_code_impl::in,
+ maybe(trace_expr(trace_runtime))::in, pragma_foreign_proc_impl::in,
hlds_goal_info::in, hlds_goal_expr::out,
mode_info::in, mode_info::out) is det.
diff --git a/compiler/module_imports.m b/compiler/module_imports.m
index 47630cf..ed292c1 100644
--- a/compiler/module_imports.m
+++ b/compiler/module_imports.m
@@ -108,6 +108,10 @@
% The `:- pragma foreign_import_module' declarations.
mai_foreign_import_modules :: foreign_import_module_info_list,
+ % The list of filenames referenced by `:- pragma foreign_decl'
+ % or `:- pragma foreign_code' declarations.
+ mai_foreign_include_files :: foreign_include_file_info_list,
+
% Does the module contain any `:- pragma foreign_export'
% declarations?
mai_contains_foreign_export :: contains_foreign_export,
@@ -337,7 +341,7 @@ init_dependencies(FileName, SourceFileModuleName, NestedModuleNames,
% Figure out whether the items contain foreign code.
get_item_list_foreign_code(Globals, Items, LangSet,
- ForeignImports0, ContainsPragmaExport),
+ ForeignImports0, ForeignIncludeFiles, ContainsForeignExport),
( set.empty(LangSet) ->
ContainsForeignCode = contains_no_foreign_code
;
@@ -386,7 +390,8 @@ init_dependencies(FileName, SourceFileModuleName, NestedModuleNames,
ModuleName, ParentDeps, InterfaceDeps,
ImplementationDeps, IndirectDeps, IncludeDeps,
InterfaceIncludeDeps, NestedDeps, FactTableDeps,
- ContainsForeignCode, ForeignImports, ContainsPragmaExport,
+ ContainsForeignCode, ForeignImports, ForeignIncludeFiles,
+ ContainsForeignExport,
cord.empty, Specs, Error, no, HasMain, dir.this_directory).
%-----------------------------------------------------------------------------%
diff --git a/compiler/modules.m b/compiler/modules.m
index 4ff0cb1..e2f6560 100644
--- a/compiler/modules.m
+++ b/compiler/modules.m
@@ -3614,7 +3614,7 @@ init_module_and_imports(SourceFileName, SourceFileModuleName, ModuleName,
ItemsCord = cord.from_list(Items),
Module = module_and_imports(SourceFileName, SourceFileModuleName,
ModuleName, [], [], [], [], [], PublicChildren,
- NestedChildren, FactDeps, contains_foreign_code_unknown, [],
+ NestedChildren, FactDeps, contains_foreign_code_unknown, [], [],
contains_no_foreign_export, ItemsCord, Specs, no_module_errors,
MaybeTimestamps, no_main, dir.this_directory).
diff --git a/compiler/polymorphism.m b/compiler/polymorphism.m
index 24b898c..51f54f0 100644
--- a/compiler/polymorphism.m
+++ b/compiler/polymorphism.m
@@ -1852,7 +1852,7 @@ polymorphism_process_foreign_proc(PredInfo, GoalExpr0, GoalInfo0,
conj_list_to_goal(GoalList, GoalInfo0, Goal).
:- pred polymorphism_process_foreign_proc_args(pred_info::in, bool::in,
- pragma_foreign_code_impl::in, list(prog_var)::in, list(foreign_arg)::out)
+ pragma_foreign_proc_impl::in, list(prog_var)::in, list(foreign_arg)::out)
is det.
polymorphism_process_foreign_proc_args(PredInfo, CanOptAwayUnnamed, Impl, Vars,
@@ -1906,7 +1906,7 @@ polymorphism_process_foreign_proc_args(PredInfo, CanOptAwayUnnamed, Impl, Vars,
make_foreign_args(Vars, ArgInfos, OrigArgTypes, Args).
:- pred foreign_proc_add_typeclass_info(bool::in, mer_mode::in,
- pragma_foreign_code_impl::in, tvarset::in, prog_constraint::in,
+ pragma_foreign_proc_impl::in, tvarset::in, prog_constraint::in,
pair(maybe(pair(string, mer_mode)), box_policy)::out) is det.
foreign_proc_add_typeclass_info(CanOptAwayUnnamed, Mode, Impl, TypeVarSet,
@@ -1921,7 +1921,7 @@ foreign_proc_add_typeclass_info(CanOptAwayUnnamed, Mode, Impl, TypeVarSet,
% in the C code fragment, don't pass the variable to the C code at all.
(
CanOptAwayUnnamed = yes,
- foreign_code_does_not_use_variable(Impl, ConstraintVarName)
+ foreign_proc_does_not_use_variable(Impl, ConstraintVarName)
->
MaybeArgName = no
;
@@ -1929,7 +1929,7 @@ foreign_proc_add_typeclass_info(CanOptAwayUnnamed, Mode, Impl, TypeVarSet,
).
:- pred foreign_proc_add_typeinfo(bool::in, mer_mode::in,
- pragma_foreign_code_impl::in, tvarset::in, tvar::in,
+ pragma_foreign_proc_impl::in, tvarset::in, tvar::in,
pair(maybe(pair(string, mer_mode)), box_policy)::out) is det.
foreign_proc_add_typeinfo(CanOptAwayUnnamed, Mode, Impl, TypeVarSet, TVar,
@@ -1940,7 +1940,7 @@ foreign_proc_add_typeinfo(CanOptAwayUnnamed, Mode, Impl, TypeVarSet, TVar,
% in the C code fragment, don't pass the variable to the C code at all.
(
CanOptAwayUnnamed = yes,
- foreign_code_does_not_use_variable(Impl, C_VarName)
+ foreign_proc_does_not_use_variable(Impl, C_VarName)
->
MaybeArgName = no
;
@@ -1950,15 +1950,15 @@ foreign_proc_add_typeinfo(CanOptAwayUnnamed, Mode, Impl, TypeVarSet, TVar,
MaybeArgName = no
).
-:- pred foreign_code_does_not_use_variable(pragma_foreign_code_impl::in,
+:- pred foreign_proc_does_not_use_variable(pragma_foreign_proc_impl::in,
string::in) is semidet.
-foreign_code_does_not_use_variable(Impl, VarName) :-
+foreign_proc_does_not_use_variable(Impl, VarName) :-
% XXX This test used to be turned off with the semidet_fail, as it caused
% the compiler to abort when compiling declarative_execution.m in stage2,
% but this is no longer the case.
% semidet_fail,
- \+ foreign_code_uses_variable(Impl, VarName).
+ \+ foreign_proc_uses_variable(Impl, VarName).
:- func underscore_and_tvar_name(tvarset, tvar) = string.
diff --git a/compiler/pragma_c_gen.m b/compiler/pragma_c_gen.m
index 6a0ba8d..199862d 100644
--- a/compiler/pragma_c_gen.m
+++ b/compiler/pragma_c_gen.m
@@ -39,7 +39,7 @@
:- pred generate_foreign_proc_code(code_model::in,
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
list(foreign_arg)::in, list(foreign_arg)::in,
- maybe(trace_expr(trace_runtime))::in, pragma_foreign_code_impl::in,
+ maybe(trace_expr(trace_runtime))::in, pragma_foreign_proc_impl::in,
hlds_goal_info::in, llds_code::out,
code_info::in, code_info::out) is det.
@@ -362,7 +362,7 @@
generate_foreign_proc_code(CodeModel, Attributes, PredId, ProcId,
Args, ExtraArgs, MaybeTraceRuntimeCond, PragmaImpl, GoalInfo, Code,
!CI) :-
- PragmaImpl = fc_impl_ordinary(C_Code, Context),
+ PragmaImpl = fp_impl_ordinary(C_Code, Context),
(
MaybeTraceRuntimeCond = no,
CanOptAwayUnnamedArgs = yes,
diff --git a/compiler/prog_data.m b/compiler/prog_data.m
index 593e1ef..a9f04f2 100644
--- a/compiler/prog_data.m
+++ b/compiler/prog_data.m
@@ -365,6 +365,12 @@ det_negation_det(detism_failure, yes(detism_det)).
---> foreign_decl_is_local
; foreign_decl_is_exported.
+:- type foreign_literal_or_include
+ ---> literal(string)
+ ; include_file(
+ string % The file name written in the source code.
+ ).
+
% A foreign_language_type represents a type that is defined in a
% foreign language and accessed in Mercury (most likely through
% pragma foreign_type).
@@ -807,13 +813,13 @@ eval_method_to_table_type(EvalMethod) = TableTypeStr :-
%-----------------------------------------------------------------------------%
%
-% Stuff for `foreign_code' pragma.
+% Stuff for `foreign_proc' pragma.
%
:- interface.
% This type holds information about the implementation details
- % of procedures defined via `pragma foreign_code'.
+ % of procedures defined via `pragma foreign_proc'.
%
% All the strings in this type may be accompanied by the context of their
% appearance in the source code. These contexts are used to tell the
@@ -822,8 +828,8 @@ eval_method_to_table_type(EvalMethod) = TableTypeStr :-
% code in the Mercury program. The context is missing if the foreign code
% was constructed by the compiler.
%
-:- type pragma_foreign_code_impl
- ---> fc_impl_ordinary(
+:- type pragma_foreign_proc_impl
+ ---> fp_impl_ordinary(
% This is a foreign language definition of a model_det or
% model_semi procedure. (We used to allow model_non, but
% do not any more.)
@@ -840,6 +846,13 @@ eval_method_to_table_type(EvalMethod) = TableTypeStr :-
; shared_code_share
; shared_code_automatic.
+%-----------------------------------------------------------------------------%
+%
+% Stuff for `foreign_import_module' pragma.
+%
+
+:- interface.
+
% In reverse order.
:- type foreign_import_module_info_list == list(foreign_import_module_info).
@@ -852,6 +865,22 @@ eval_method_to_table_type(EvalMethod) = TableTypeStr :-
%-----------------------------------------------------------------------------%
%
+% Stuff for the `foreign_decl' and `foreign_code' pragmas.
+%
+
+:- interface.
+
+ % In reverse order.
+:- type foreign_include_file_info_list == list(foreign_include_file_info).
+
+:- type foreign_include_file_info
+ ---> foreign_include_file_info(
+ fifi_lang :: foreign_language,
+ fifi_filename :: string
+ ).
+
+%-----------------------------------------------------------------------------%
+%
% Stuff for the `foreign_export_enum' pragma.
%
diff --git a/compiler/prog_foreign.m b/compiler/prog_foreign.m
index 5785212..d8aac28 100644
--- a/compiler/prog_foreign.m
+++ b/compiler/prog_foreign.m
@@ -47,14 +47,14 @@
---> foreign_decl_code(
fdecl_lang :: foreign_language,
fdecl_is_local :: foreign_decl_is_local,
- fdecl_code :: string,
+ fdecl_code :: foreign_literal_or_include,
fdecl_context :: prog_context
).
:- type foreign_body_code
---> foreign_body_code(
fbody_lang :: foreign_language,
- fbody_code :: string,
+ fbody_code :: foreign_literal_or_include,
fbody_context :: prog_context
).
@@ -82,11 +82,12 @@
% Some code from a `pragma foreign_code' declaration that is not
% associated with a given procedure.
+ % XXX any difference from foreign_body_code?
%
:- type user_foreign_code
---> user_foreign_code(
foreign_language, % language of this code
- string, % code
+ foreign_literal_or_include,
term.context % source code location
).
diff --git a/compiler/prog_io_pragma.m b/compiler/prog_io_pragma.m
index 50b24bb..2d75724 100644
--- a/compiler/prog_io_pragma.m
+++ b/compiler/prog_io_pragma.m
@@ -45,6 +45,7 @@
:- import_module libs.rat.
:- import_module parse_tree.error_util.
+:- import_module parse_tree.file_names.
:- import_module parse_tree.mercury_to_mercury.
:- import_module parse_tree.prog_ctgc.
:- import_module parse_tree.prog_io.
@@ -1374,6 +1375,21 @@ parse_foreign_decl_is_local(term.functor(Functor, [], _), IsLocal) :-
IsLocal = foreign_decl_is_exported
).
+:- pred parse_foreign_literal_or_include(term::in,
+ foreign_literal_or_include::out) is semidet.
+
+parse_foreign_literal_or_include(Term, LiteralOrInclude) :-
+ Term = term.functor(Functor, Args, _),
+ (
+ Functor = term.string(Code),
+ Args = [],
+ LiteralOrInclude = literal(Code)
+ ;
+ Functor = term.atom("include_file"),
+ Args = [term.functor(term.string(FileName), [], _)],
+ LiteralOrInclude = include_file(FileName)
+ ).
+
parse_foreign_language(term.functor(term.string(String), _, _), Lang) :-
globals.convert_foreign_language(String, Lang).
parse_foreign_language(term.functor(term.atom(String), _, _), Lang) :-
@@ -1581,17 +1597,17 @@ parse_pragma_foreign_decl_pragma(_ModuleName, PragmaName, PragmaTerms,
)
->
( parse_foreign_language(LangTerm, ForeignLanguage) ->
- ( HeaderTerm = term.functor(term.string(HeaderCode), [], _) ->
+ ( parse_foreign_literal_or_include(HeaderTerm, LiteralOrInclude) ->
FDInfo = pragma_info_foreign_decl(ForeignLanguage, IsLocal,
- HeaderCode),
+ LiteralOrInclude),
Pragma = pragma_foreign_decl(FDInfo),
ItemPragma = item_pragma_info(user, Pragma, Context, SeqNum),
Item = item_pragma(ItemPragma),
MaybeItem = ok1(Item)
;
Pieces = InvalidDeclPieces ++
- [words("expected string for foreign declaration code."),
- nl],
+ [words("expected string or include_file for"),
+ words("foreign declaration code."), nl],
Spec = error_spec(severity_error, phase_term_to_parse_tree,
[simple_msg(get_term_context(HeaderTerm),
[always(Pieces)])]),
@@ -1639,11 +1655,11 @@ parse_pragma_foreign_code_pragma(_ModuleName, PragmaName, PragmaTerms,
[always(LangPieces)])]),
LangSpecs = [LangSpec]
),
- ( CodeTerm = term.functor(term.string(CodePrime), [], _) ->
+ ( parse_foreign_literal_or_include(CodeTerm, CodePrime) ->
Code = CodePrime,
CodeSpecs = []
;
- Code = "", % Dummy, ignored when CodeSpecs \= []
+ Code = literal(""), % Dummy, ignored when CodeSpecs \= []
CodePieces = InvalidDeclPrefix ++
[words("expected string for foreign code."), nl],
CodeSpec = error_spec(severity_error, phase_term_to_parse_tree,
@@ -1673,9 +1689,9 @@ parse_pragma_foreign_code_pragma(_ModuleName, PragmaName, PragmaTerms,
% This predicate parses foreign_proc pragmas.
%
-:- pred parse_pragma_foreign_proc_pragma(module_name::in, string::in,
- list(term)::in, term::in, varset::in, prog_context::in, int::in,
- maybe1(item)::out) is det.
+:- pred parse_pragma_foreign_proc_pragma(module_name::in,
+ string::in, list(term)::in, term::in, varset::in, prog_context::in,
+ int::in, maybe1(item)::out) is det.
parse_pragma_foreign_proc_pragma(ModuleName, PragmaName, PragmaTerms,
ErrorTerm, VarSet, Context, SeqNum, MaybeItem) :-
@@ -1788,8 +1804,8 @@ parse_pragma_ordinary_foreign_proc_pragma(ModuleName, VarSet, SecondTerm,
Specs = CodeSpecs ++ FlagsSpecs,
(
Specs = [],
- Impl = fc_impl_ordinary(Code, yes(CodeContext)),
- parse_pragma_foreign_code(ModuleName, Flags, PredAndVarsTerm,
+ Impl = fp_impl_ordinary(Code, yes(CodeContext)),
+ parse_pragma_foreign_proc(ModuleName, Flags, PredAndVarsTerm,
Impl, VarSet, Context, SeqNum, MaybeItem)
;
Specs = [_ | _],
@@ -2269,11 +2285,11 @@ parse_ordinary_despite_detism(
% Parse a pragma foreign_proc declaration.
%
-:- pred parse_pragma_foreign_code(module_name::in,
- pragma_foreign_proc_attributes::in, term::in, pragma_foreign_code_impl::in,
+:- pred parse_pragma_foreign_proc(module_name::in,
+ pragma_foreign_proc_attributes::in, term::in, pragma_foreign_proc_impl::in,
varset::in, prog_context::in, int::in, maybe1(item)::out) is det.
-parse_pragma_foreign_code(ModuleName, Flags, PredAndVarsTerm0,
+parse_pragma_foreign_proc(ModuleName, Flags, PredAndVarsTerm0,
PragmaImpl, VarSet, Context, SeqNum, MaybeItem) :-
ContextPieces = [words("In"), quote(":- pragma foreign_proc"),
words("declaration:")],
diff --git a/compiler/prog_io_typeclass.m b/compiler/prog_io_typeclass.m
index 5d19908..4d383a2 100644
--- a/compiler/prog_io_typeclass.m
+++ b/compiler/prog_io_typeclass.m
@@ -30,7 +30,7 @@
% Parse a typeclass declaration.
%
-:- pred parse_typeclass(module_name::in, varset::in, list(term)::in,
+:- pred parse_typeclass(module_name::in,varset::in, list(term)::in,
prog_context::in, int::in, maybe1(item_typeclass_info)::out) is semidet.
% Parse an instance declaration.
diff --git a/compiler/prog_item.m b/compiler/prog_item.m
index a648128..3a49511 100644
--- a/compiler/prog_item.m
+++ b/compiler/prog_item.m
@@ -490,13 +490,13 @@
% A foreign language declaration, such as C header code.
decl_lang :: foreign_language,
decl_is_local :: foreign_decl_is_local,
- decl_decl :: string
+ decl_decl :: foreign_literal_or_include
).
:- type pragma_info_foreign_code
---> pragma_info_foreign_code(
code_lang :: foreign_language,
- code_code :: string
+ code_code :: foreign_literal_or_include
).
:- type pragma_info_foreign_proc
@@ -513,7 +513,7 @@
proc_vars :: list(pragma_var),
proc_varset :: prog_varset,
proc_instvarset :: inst_varset,
- proc_impl :: pragma_foreign_code_impl
+ proc_impl :: pragma_foreign_proc_impl
).
:- type pragma_info_foreign_import_module
@@ -940,7 +940,7 @@
:- pred get_item_list_foreign_code(globals::in, list(item)::in,
set(foreign_language)::out, foreign_import_module_info_list::out,
- contains_foreign_export::out) is det.
+ foreign_include_file_info_list::out, contains_foreign_export::out) is det.
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
@@ -1061,16 +1061,17 @@ set_mutable_var_thread_local(ThreadLocal, !Attributes) :-
used_foreign_languages :: set(foreign_language),
foreign_proc_languages :: map(sym_name, foreign_language),
all_foreign_import_modules :: foreign_import_module_info_list,
+ all_foreign_include_files :: foreign_include_file_info_list,
module_has_foreign_export :: contains_foreign_export
).
get_item_list_foreign_code(Globals, Items, LangSet, ForeignImports,
- ContainsPragmaExport) :-
- Info0 = module_foreign_info(set.init, map.init, [],
+ ForeignIncludeFiles, ContainsForeignExport) :-
+ Info0 = module_foreign_info(set.init, map.init, [], [],
contains_no_foreign_export),
list.foldl(get_item_foreign_code(Globals), Items, Info0, Info),
Info = module_foreign_info(LangSet0, LangMap, ForeignImports,
- ContainsPragmaExport),
+ ForeignIncludeFiles, ContainsForeignExport),
ForeignProcLangs = map.values(LangMap),
LangSet = set.insert_list(LangSet0, ForeignProcLangs).
@@ -1113,13 +1114,15 @@ do_get_item_foreign_code(Globals, Pragma, Context, !Info) :-
% or not to call mlds_to_c.m.
(
Pragma = pragma_foreign_code(FCInfo),
- FCInfo = pragma_info_foreign_code(Lang, _),
+ FCInfo = pragma_info_foreign_code(Lang, LiteralOrInclude),
( list.member(Lang, BackendLangs) ->
- !Info ^ used_foreign_languages :=
- set.insert(!.Info ^ used_foreign_languages, Lang)
+ Langs0 = !.Info ^ used_foreign_languages,
+ set.insert(Lang, Langs0, Langs),
+ !Info ^ used_foreign_languages := Langs
;
true
- )
+ ),
+ do_get_item_foreign_include_file(Lang, LiteralOrInclude, !Info)
;
Pragma = pragma_foreign_proc(FPInfo),
FPInfo = pragma_info_foreign_proc(Attrs, Name, _, _, _, _, _),
@@ -1189,7 +1192,9 @@ do_get_item_foreign_code(Globals, Pragma, Context, !Info) :-
% will only do if there is some foreign_code, not just foreign_decls.
% Counting foreign_decls here causes problems with intermodule
% optimization.
- Pragma = pragma_foreign_decl(_)
+ Pragma = pragma_foreign_decl(FDInfo),
+ FDInfo = pragma_info_foreign_decl(Lang, _IsLocal, LiteralOrInclude),
+ do_get_item_foreign_include_file(Lang, LiteralOrInclude, !Info)
;
( Pragma = pragma_foreign_enum(_)
; Pragma = pragma_foreign_export_enum(_)
@@ -1225,5 +1230,20 @@ do_get_item_foreign_code(Globals, Pragma, Context, !Info) :-
% Do nothing.
).
+:- pred do_get_item_foreign_include_file(foreign_language::in,
+ foreign_literal_or_include::in, module_foreign_info::in,
+ module_foreign_info::out) is det.
+
+do_get_item_foreign_include_file(Lang, LiteralOrInclude, !Info) :-
+ (
+ LiteralOrInclude = literal(_)
+ ;
+ LiteralOrInclude = include_file(FileName),
+ IncludeFile = foreign_include_file_info(Lang, FileName),
+ IncludeFiles0 = !.Info ^ all_foreign_include_files,
+ IncludeFiles = [IncludeFile | IncludeFiles0],
+ !Info ^ all_foreign_include_files := IncludeFiles
+ ).
+
%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%
diff --git a/compiler/typecheck.m b/compiler/typecheck.m
index 01b0132..d949629 100644
--- a/compiler/typecheck.m
+++ b/compiler/typecheck.m
@@ -749,13 +749,13 @@ check_existq_clause(TypeVarSet, ExistQVars, Clause, !Info) :-
true
).
-:- pred check_mention_existq_var(tvarset::in, pragma_foreign_code_impl::in,
+:- pred check_mention_existq_var(tvarset::in, pragma_foreign_proc_impl::in,
tvar::in, typecheck_info::in, typecheck_info::out) is det.
check_mention_existq_var(TypeVarSet, Impl, TVar, !Info) :-
varset.lookup_name(TypeVarSet, TVar, Name),
VarName = "TypeInfo_for_" ++ Name,
- ( foreign_code_uses_variable(Impl, VarName) ->
+ ( foreign_proc_uses_variable(Impl, VarName) ->
true
;
Spec = report_missing_tvar_in_foreign_code(!.Info, VarName),
diff --git a/compiler/unique_modes.m b/compiler/unique_modes.m
index de4c3ba..6a426ad 100644
--- a/compiler/unique_modes.m
+++ b/compiler/unique_modes.m
@@ -675,7 +675,7 @@ unique_modes_check_goal_switch(Var, CanFail, Cases0, GoalInfo0, GoalExpr,
:- pred unique_modes_check_goal_call_foreign_proc(
pragma_foreign_proc_attributes::in, pred_id::in, proc_id::in,
list(foreign_arg)::in, list(foreign_arg)::in,
- maybe(trace_expr(trace_runtime))::in, pragma_foreign_code_impl::in,
+ maybe(trace_expr(trace_runtime))::in, pragma_foreign_proc_impl::in,
hlds_goal_info::in, hlds_goal_expr::out,
mode_info::in, mode_info::out) is det.
diff --git a/compiler/write_deps_file.m b/compiler/write_deps_file.m
index bc7e0f9..33b6e77 100644
--- a/compiler/write_deps_file.m
+++ b/compiler/write_deps_file.m
@@ -36,6 +36,9 @@
% `.trans_opt' file may depend on. This is set to `no' if the
% dependency list is not available.
%
+ % XXX we do not yet write dependencies on files referenced by pragma
+ % foreign_decl or pragma foreign_code
+ %
:- pred write_dependency_file(globals::in, module_and_imports::in,
set(module_name)::in, maybe(list(module_name))::in, io::di, io::uo) is det.
@@ -106,7 +109,8 @@ write_dependency_file(Globals, Module, AllDepsSet, MaybeTransOptDeps, !IO) :-
Module = module_and_imports(SourceFileName, SourceFileModuleName,
ModuleName, ParentDeps, IntDeps, ImplDeps, IndirectDeps,
_Children, InclDeps, NestedDeps, FactDeps0,
- ContainsForeignCode, ForeignImports0, _ContainsForeignExport,
+ ContainsForeignCode, ForeignImports0, _ForeignIncludeFiles,
+ _ContainsForeignExport,
Items, _Specs, _Error, _Timestamps, _HasMain, _Dir),
globals.lookup_bool_option(Globals, verbose, Verbose),
@@ -518,7 +522,7 @@ write_dependency_file(Globals, Module, AllDepsSet, MaybeTransOptDeps, !IO) :-
;
ContainsForeignCode = contains_foreign_code_unknown,
get_item_list_foreign_code(Globals, cord.list(Items), LangSet,
- ForeignImports1, _),
+ ForeignImports1, _, _),
% If we're generating the `.dep' file, ForeignImports0 will contain
% a conservative approximation to the set of foreign imports
% needed which will include imports required by imported modules.
diff --git a/doc/reference_manual.texi b/doc/reference_manual.texi
index a7a34b2..525aa26 100644
--- a/doc/reference_manual.texi
+++ b/doc/reference_manual.texi
@@ -9522,6 +9522,7 @@ The University of Melbourne Mercury implementation supports the following
extensions to the Mercury language:
@menu
+* Foreign include files:: Including foreign code from external files.
* Fact tables:: Support for very large tables of facts.
@c XXX STM
@c The documentation of STM is commented out because its support is
@@ -9545,6 +9546,29 @@ extensions to the Mercury language:
@c implementation-specific...
@c * Reserved tag:: Support for Herbrand constraint solvers.
+ at node Foreign include files
+ at section Foreign include files
+
+Foreign declarations and code may be included from external files
+using extensions of the @samp{pragma foreign_decl} and
+ at samp{pragma foreign_code} declarations:
+
+ at example
+:- pragma foreign_decl("@var{Lang}", include_file("@var{Path}")).
+:- pragma foreign_decl("@var{Lang}", local, include_file("@var{Path}")).
+:- pragma foreign_code("@var{Lang}", include_file("@var{Path}")).
+ at end example
+
+These have the same effects as the standard forms except that the
+contents of the file referenced by @var{Path} are included in place of
+the string literal in the last argument, without further interpretation.
+ at var{Path} may be an absolute path to a file or a path relative to the
+directory that contains the source file of the module containing the
+declaration. The interpretation of the path is platform-dependent.
+
+The @samp{mmc --make} tool takes @samp{include_file} references into
+account when computing dependencies.
+
@node Fact tables
@section Fact tables
diff --git a/tests/invalid/Mmakefile b/tests/invalid/Mmakefile
index 37a9578..b27ca64 100644
--- a/tests/invalid/Mmakefile
+++ b/tests/invalid/Mmakefile
@@ -97,6 +97,7 @@ SINGLEMODULE= \
field_syntax_error \
foreign_enum_import \
foreign_enum_invalid \
+ foreign_include_file_missing \
foreign_purity_mismatch \
foreign_singleton \
foreign_type_2 \
@@ -452,6 +453,15 @@ illtyped_compare.err: illtyped_compare.m
else true; \
fi
+# For foreign_include_file_missing, the error is only caught when generating
+# target code.
+foreign_include_file_missing.err: foreign_include_file_missing.m
+ if $(MC) --target-code-only $(ALL_GRADEFLAGS) $(ALL_MCFLAGS) \
+ $* > $*.err 2>&1; \
+ then false; \
+ else true; \
+ fi
+
$(dates_subdir)undef_mod_qual.date: $(int0s_subdir)undef_mod_qual.int0
clean_local:
diff --git a/tests/invalid/foreign_include_file_missing.err_exp b/tests/invalid/foreign_include_file_missing.err_exp
new file mode 100644
index 0000000..ee3b6db
--- /dev/null
+++ b/tests/invalid/foreign_include_file_missing.err_exp
@@ -0,0 +1 @@
+Error: can't open `./missing_file' for input: No such file or directory
diff --git a/tests/invalid/foreign_include_file_missing.m b/tests/invalid/foreign_include_file_missing.m
new file mode 100644
index 0000000..cc0756d
--- /dev/null
+++ b/tests/invalid/foreign_include_file_missing.m
@@ -0,0 +1,18 @@
+:- module foreign_include_file_missing.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- pragma foreign_code("C", include_file("missing_file")).
+:- pragma foreign_code("Java", include_file("missing_file")).
+:- pragma foreign_code("C#", include_file("missing_file")).
+:- pragma foreign_code("Erlang", include_file("missing_file")).
+
+main(!IO).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sts=4 sw=4 et
diff --git a/tests/mmc_make/Mmakefile b/tests/mmc_make/Mmakefile
index 7fe6bc6..00dc31d 100644
--- a/tests/mmc_make/Mmakefile
+++ b/tests/mmc_make/Mmakefile
@@ -11,6 +11,8 @@ MMAKE_USE_MMC_MAKE=yes
PROGS = \
complex_test \
hello \
+ include_file \
+ include_file2 \
linkage_test \
rebuild
@@ -30,6 +32,12 @@ include $(TESTS_DIR)/Mmake.common
complex_test.log: install_libs
+# Check that included files are identified as dependencies of the target code.
+include_file2.runtest: include_file
+ sleep 1 && touch inc/code.c inc/code.java inc/code.cs inc/code.erl
+ $(MCM) --verbose-make include_file > include_file2.err 2>&1
+ grep '^Making Mercury/.*/include_file[.]' include_file2.err
+
linkage_test.log: install_libs_linkage_test2
# Just test that the executable is rebuilt.
@@ -63,7 +71,7 @@ TESTS_FLAGS: ../TESTS_FLAGS
ln -s $< $@ || cp $< $@
realclean_local: TESTS_FLAGS
- rm -rf install rebuild.err2
+ rm -rf install include_file2.err rebuild.err2
# ./TESTS_FLAGS is expected by the following line.
cd lib; $(MCM) complex_numbers.realclean linkage_test2.realclean
rm -f TESTS_FLAGS
diff --git a/tests/mmc_make/inc/code.c b/tests/mmc_make/inc/code.c
new file mode 100644
index 0000000..f748d78
--- /dev/null
+++ b/tests/mmc_make/inc/code.c
@@ -0,0 +1,9 @@
+int ones(void)
+{
+ return 111;
+}
+
+int twos(void)
+{
+ return 222;
+}
diff --git a/tests/mmc_make/inc/code.cs b/tests/mmc_make/inc/code.cs
new file mode 100644
index 0000000..9966a1f
--- /dev/null
+++ b/tests/mmc_make/inc/code.cs
@@ -0,0 +1,4 @@
+public static int twos()
+{
+ return 222;
+}
diff --git a/tests/mmc_make/inc/code.erl b/tests/mmc_make/inc/code.erl
new file mode 100644
index 0000000..00794d1
--- /dev/null
+++ b/tests/mmc_make/inc/code.erl
@@ -0,0 +1 @@
+twos() -> 222.
diff --git a/tests/mmc_make/inc/code.java b/tests/mmc_make/inc/code.java
new file mode 100644
index 0000000..b053f25
--- /dev/null
+++ b/tests/mmc_make/inc/code.java
@@ -0,0 +1,4 @@
+static int twos()
+{
+ return 222;
+}
diff --git a/tests/mmc_make/inc/decl.cs b/tests/mmc_make/inc/decl.cs
new file mode 100644
index 0000000..a3607ce
--- /dev/null
+++ b/tests/mmc_make/inc/decl.cs
@@ -0,0 +1,6 @@
+class Ones {
+ public static int ones()
+ {
+ return 111;
+ }
+}
diff --git a/tests/mmc_make/inc/decl.erl b/tests/mmc_make/inc/decl.erl
new file mode 100644
index 0000000..79a4b69
--- /dev/null
+++ b/tests/mmc_make/inc/decl.erl
@@ -0,0 +1 @@
+ones() -> 111.
diff --git a/tests/mmc_make/inc/decl.h b/tests/mmc_make/inc/decl.h
new file mode 100644
index 0000000..7cb2d81
--- /dev/null
+++ b/tests/mmc_make/inc/decl.h
@@ -0,0 +1,2 @@
+extern int ones(void);
+extern int twos(void);
diff --git a/tests/mmc_make/inc/decl.java b/tests/mmc_make/inc/decl.java
new file mode 100644
index 0000000..2621c80
--- /dev/null
+++ b/tests/mmc_make/inc/decl.java
@@ -0,0 +1,6 @@
+class Ones {
+ static int ones()
+ {
+ return 111;
+ }
+}
diff --git a/tests/mmc_make/include_file.exp b/tests/mmc_make/include_file.exp
new file mode 100644
index 0000000..a30a52a
--- /dev/null
+++ b/tests/mmc_make/include_file.exp
@@ -0,0 +1,2 @@
+111
+222
diff --git a/tests/mmc_make/include_file.m b/tests/mmc_make/include_file.m
new file mode 100644
index 0000000..26fc20d
--- /dev/null
+++ b/tests/mmc_make/include_file.m
@@ -0,0 +1,64 @@
+:- module include_file.
+:- interface.
+
+:- import_module io.
+
+:- pred main(io::di, io::uo) is det.
+
+:- implementation.
+
+:- pragma foreign_decl("C", include_file("inc/decl.h")).
+:- pragma foreign_code("C", include_file("inc/code.c")).
+
+:- pragma foreign_decl("Java", include_file("inc/decl.java")).
+:- pragma foreign_code("Java", include_file("inc/code.java")).
+
+:- pragma foreign_decl("C#", include_file("inc/decl.cs")).
+:- pragma foreign_code("C#", include_file("inc/code.cs")).
+
+:- pragma foreign_decl("Erlang", include_file("inc/decl.erl")).
+:- pragma foreign_code("Erlang", include_file("inc/code.erl")).
+
+:- pred test(int::out, int::out) is det.
+
+:- pragma foreign_proc("C",
+ test(X::out, Y::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ X = ones();
+ Y = twos();
+").
+
+:- pragma foreign_proc("Java",
+ test(X::out, Y::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ X = Ones.ones();
+ Y = twos();
+").
+
+:- pragma foreign_proc("C#",
+ test(X::out, Y::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ X = Ones.ones();
+ Y = twos();
+").
+
+:- pragma foreign_proc("Erlang",
+ test(X::out, Y::out),
+ [will_not_call_mercury, promise_pure, thread_safe],
+"
+ X = ones(),
+ Y = twos()
+").
+
+main(!IO) :-
+ test(X, Y),
+ io.write_int(X, !IO),
+ io.nl(!IO),
+ io.write_int(Y, !IO),
+ io.nl(!IO).
+
+%-----------------------------------------------------------------------------%
+% vim: ft=mercury ts=4 sts=4 sw=4 et
More information about the reviews
mailing list