[m-rev.] diff: main/2 wrapper for erlang
Peter Wang
wangp at students.csse.unimelb.edu.au
Wed Jun 6 11:30:24 AEST 2007
Estimated hours taken: 2
Branches: main
Generate a wrapper function around the user's main/2 predicate in the Erlang
backend.
compiler/elds_to_erlang.m:
Output the main wrapper. The wrapper catches any uncaught Mercury
exceptions and prints out a stack trace in that case.
compiler/modules.m:
Make the shell script call the wrapper instead of the main/2 predicate
if linking against the standard library.
Move the calls to initialise/finalise the io module into the wrapper
instead of the launcher shell script.
library/exception.m:
Fix Erlang implementations of catch, which were all wrong.
Export report_uncaught_exception as ML_report_uncaught_exception,
used by the main wrapper.
Index: library/exception.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/library/exception.m,v
retrieving revision 1.125
diff -u -r1.125 exception.m
--- library/exception.m 30 May 2007 08:16:03 -0000 1.125
+++ library/exception.m 6 Jun 2007 01:25:06 -0000
@@ -1401,7 +1401,7 @@
catch_impl(Pred::pred(out) is det, Handler::in(handler), T::out),
[will_not_call_mercury, promise_pure],
"
- T = try
+ {T} = try
Pred()
catch
throw: {'ML_exception', Excp} ->
@@ -1431,8 +1431,6 @@
:- pragma foreign_code("Erlang", "
- % XXX not sure about any of this
-
builtin_catch_3_p_2(TypeInfo, WrappedGoal, Handler) ->
try
WrappedGoal()
@@ -1443,24 +1441,20 @@
builtin_catch_3_p_4(_TypeInfo_for_T, Pred, Handler, Succeed) ->
try
- Pred()
- of
- T ->
- Succeed(T)
+ Pred(Succeed)
catch
throw: {'ML_exception', Excp} ->
- Handler(Excp, Succeed)
+ {Result} = Handler(Excp),
+ Succeed(Result)
end.
builtin_catch_3_p_5(_TypeInfo_for_T, Pred, Handler, Succeed) ->
try
- Pred()
- of
- T ->
- Succeed(T)
+ Pred(Succeed)
catch
throw: {'ML_exception', Excp} ->
- Handler(Excp, Succeed)
+ {Result} = Handler(Excp),
+ Succeed(Result)
end.
").
@@ -2581,6 +2575,8 @@
"ML_report_uncaught_exception").
:- pragma foreign_export("IL", report_uncaught_exception(in, di, uo),
"ML_report_uncaught_exception").
+:- pragma foreign_export("Erlang", report_uncaught_exception(in, di, uo),
+ "ML_report_uncaught_exception").
:- pred report_uncaught_exception(univ::in, io::di, io::uo) is cc_multi.
Index: compiler/elds_to_erlang.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/elds_to_erlang.m,v
retrieving revision 1.11
diff -u -r1.11 elds_to_erlang.m
--- compiler/elds_to_erlang.m 1 Jun 2007 06:14:59 -0000 1.11
+++ compiler/elds_to_erlang.m 6 Jun 2007 01:25:06 -0000
@@ -45,6 +45,7 @@
:- import_module hlds.hlds_pred.
:- import_module hlds.hlds_rtti.
:- import_module hlds.passes_aux.
+:- import_module hlds.pred_table.
:- import_module hlds.special_pred.
:- import_module libs.compiler_util.
:- import_module mdbcomp.prim_data.
@@ -79,6 +80,7 @@
output_erl_file(ModuleInfo, ELDS, SourceFileName, !IO) :-
ELDS = elds(ModuleName, ForeignBodies, ProcDefns, ForeignExportDefns,
RttiDefns),
+ AddMainWrapper = should_add_main_wrapper(ModuleInfo),
% Output intro.
library.version(Version),
@@ -102,12 +104,29 @@
list.foldl2(output_foreign_export_ann, ForeignExportDefns,
NeedComma0, NeedComma1, !IO),
list.foldl2(output_rtti_export_ann(ModuleInfo), RttiDefns,
- NeedComma1, _NeedComma, !IO),
+ NeedComma1, NeedComma, !IO),
+ (
+ AddMainWrapper = yes,
+ maybe_write_comma(NeedComma, !IO),
+ nl_indent_line(1, !IO),
+ output_atom("mercury__main_wrapper", !IO),
+ io.write_string("/0", !IO)
+ ;
+ AddMainWrapper = no
+ ),
io.write_string("]).\n", !IO),
% Useful for debugging.
io.write_string("% -compile(export_all).\n", !IO),
+ % Output the main wrapper, if any.
+ (
+ AddMainWrapper = yes,
+ io.write_string(main_wrapper_code, !IO)
+ ;
+ AddMainWrapper = no
+ ),
+
% Output foreign code written in Erlang.
list.foldl(output_foreign_body_code, ForeignBodies, !IO),
@@ -173,6 +192,70 @@
IsExported = no
).
+%-----------------------------------------------------------------------------%
+
+:- func should_add_main_wrapper(module_info) = bool.
+
+should_add_main_wrapper(ModuleInfo) = AddMainWrapper :-
+ module_info_get_predicate_table(ModuleInfo, PredTable),
+ (
+ predicate_table_search_pred_name_arity(PredTable, "main", 2, PredIds),
+ list.member(PredId, PredIds),
+ module_info_pred_info(ModuleInfo, PredId, PredInfo),
+ pred_info_get_import_status(PredInfo, ImportStatus),
+ status_is_exported_to_non_submodules(ImportStatus) = yes
+ ->
+ AddMainWrapper = yes
+ ;
+ AddMainWrapper = no
+ ).
+
+:- func main_wrapper_code = string.
+
+main_wrapper_code = "
+
+ % This function is called in place of main_2_p_0 by the shell script that
+ % we generate for this program, if linking against the standard library.
+ % Otherwise main_2_p_0 will be called.
+
+ mercury__main_wrapper() ->
+ mercury__io:'ML_io_init_state'(),
+ try
+ main_2_p_0()
+ catch
+ {'ML_exception', Excp} ->
+ StackTrace = erlang:get_stacktrace(),
+ mercury__exception:'ML_report_uncaught_exception'(Excp),
+ io:put_chars(""Stack dump follows:\\n""),
+ mercury__dump_stacktrace(StackTrace),
+ mercury__io:'ML_io_finalize_state'(),
+ % init:stop is preferred to calling halt but there seems
+ % to be no way to choose the exit code otherwise.
+ halt(1)
+ end,
+ mercury__io:'ML_io_finalize_state'().
+
+ mercury__dump_stacktrace([]) -> void;
+ mercury__dump_stacktrace([St | Sts]) ->
+ {Module, Function, ArityOrArgs} = St,
+ io:format(""\\t~s:~s"", [Module, Function]),
+ if
+ is_integer(ArityOrArgs) ->
+ io:format(""/~B~n"", [ArityOrArgs]);
+ true ->
+ io:format(""~p~n"", ArityOrArgs)
+ end,
+ % Don't show stack frames below main.
+ case St of
+ {?MODULE, mercury__main_wrapper, _} ->
+ void;
+ _ ->
+ mercury__dump_stacktrace(Sts)
+ end.
+".
+
+%-----------------------------------------------------------------------------%
+
:- pred output_foreign_body_code(foreign_body_code::in, io::di, io::uo) is det.
output_foreign_body_code(foreign_body_code(_Lang, Code, _Context), !IO) :-
Index: compiler/modules.m
===================================================================
RCS file: /home/mercury/mercury1/repository/mercury/compiler/modules.m,v
retrieving revision 1.428
diff -u -r1.428 modules.m
--- compiler/modules.m 4 Jun 2007 07:52:54 -0000 1.428
+++ compiler/modules.m 6 Jun 2007 01:25:06 -0000
@@ -8203,13 +8203,12 @@
MaybeStdLibDir = yes(StdLibDir),
StdLibBeamsPath = StdLibDir/"lib"/GradeDir/"libmer_std.beams",
SearchStdLib = pa_option(yes, StdLibBeamsPath),
- InitStdLib = " -s mercury__io ML_io_init_state \\\n",
- FinalizeStdLib = " -s mercury__io ML_io_finalize_state \\\n"
+ % Added by elds_to_erlang.m
+ MainFunc = "mercury__main_wrapper"
;
MaybeStdLibDir = no,
SearchStdLib = "",
- InitStdLib = "",
- FinalizeStdLib = ""
+ MainFunc = "main_2_p_0"
),
% Add `-pa <dir>' options to find any other libraries specified
by the user.
@@ -8245,9 +8244,7 @@
"DIR=`dirname ""$0""`\n",
"exec ", Erlang, " -noshell \\\n",
SearchStdLib, SearchLibs, SearchProg,
- InitStdLib,
- " -s ", BeamBaseNameNoExt, " main_2_p_0",
- FinalizeStdLib,
+ " -s ", BeamBaseNameNoExt, " ", MainFunc,
" -s init stop -- ""$@""\n"
], !IO),
io.close_output(ShellScript, !IO),
--------------------------------------------------------------------------
mercury-reviews mailing list
Post messages to: mercury-reviews at csse.unimelb.edu.au
Administrative Queries: owner-mercury-reviews at csse.unimelb.edu.au
Subscriptions: mercury-reviews-request at csse.unimelb.edu.au
--------------------------------------------------------------------------
More information about the reviews
mailing list