%-----------------------------------------------------------------------------% % Copyright (C) 1997-1999 The University of Melbourne. % This file may only be copied under the terms of the GNU Library General % Public License - see the file COPYING.LIB in the Mercury distribution. %-----------------------------------------------------------------------------% % File: exception.m. % Main author: fjh. % Stability: medium % This file defines the Mercury interface for exception handling. % Note that throwing an exception across the C interface won't work. % That is, if a Mercury procedure that is exported to C using `pragma export' % throws an exception which is not caught within that procedure, then % you will get undefined behaviour. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- module exception. :- interface. :- import_module std_util, list, io. % % throw(Exception): % Throw the specified exception. % :- pred throw(T). :- mode throw(in) is erroneous. :- func throw(T) = _. :- mode throw(in) = out is erroneous. % The following types are used by try/3 and try/5. :- type exception_result(T) ---> succeeded(T) ; failed ; exception(univ). :- inst cannot_fail ---> succeeded(ground) ; exception(ground). % % try(Goal, Result): % Operational semantics: % Call Goal(R). % If Goal(R) fails, succeed with Result = failed. % If Goal(R) succeeds, succeed with Result = succeeded(R). % If Goal(R) throws an exception E, succeed with Result = exception(E). % Declarative semantics: % try(Goal, Result) <=> % ( Goal(R), Result = succeeded(R) % ; not Goal(_), Result = failed % ; Result = exception(_) % ). % :- pred try(pred(T), exception_result(T)). :- mode try(pred(out) is det, out(cannot_fail)) is cc_multi. :- mode try(pred(out) is semidet, out) is cc_multi. :- mode try(pred(out) is cc_multi, out(cannot_fail)) is cc_multi. :- mode try(pred(out) is cc_nondet, out) is cc_multi. % % try_io(Goal, Result, IO_0, IO): % Operational semantics: % Call Goal(R, IO_0, IO_1). % If it succeeds, succeed with Result = succeeded(R) and IO = IO_1. % If it throws an exception E, succeed with Result = exception(E) % and with the final IO state being whatever state resulted % from the partial computation from IO_0. % Declarative semantics: % try_io(Goal, Result, IO_0, IO) <=> % ( Goal(R, IO_0, IO), Result = succeeded(R) % ; Result = exception(_) % ). % :- pred try_io(pred(T, io__state, io__state), exception_result(T), io__state, io__state). :- mode try_io(pred(out, di, uo) is det, out(cannot_fail), di, uo) is cc_multi. :- mode try_io(pred(out, di, uo) is cc_multi, out(cannot_fail), di, uo) is cc_multi. % % try_all(Goal, ResultList): % Operational semantics: % Try to find all solutions to Goal(R), using backtracking. % Collect the solutions found in the ResultList, until % the goal either throws an exception or fails. % If it throws an exception, put that exception at the end of % the ResultList. % Declaratively: % try_all(Goal, ResultList) <=> % (if % list__reverse(ResultList, [Last | AllButLast]), % Last = exception(_) % then % all [M] (list__member(M, AllButLast) => % (M = succeeded(R), Goal(R))), % else % all [M] (list__member(M, ResultList) => % (M = succeeded(R), Goal(R))), % all [R] (Goal(R) => % list__member(succeeded(R), ResultList)), % ). :- pred try_all(pred(T), list(exception_result(T))). :- mode try_all(pred(out) is det, out(try_all_det)) is cc_multi. :- mode try_all(pred(out) is semidet, out(try_all_semidet)) is cc_multi. :- mode try_all(pred(out) is multi, out(try_all_multi)) is cc_multi. :- mode try_all(pred(out) is nondet, out(try_all_nondet)) is cc_multi. :- inst [] ---> []. :- inst try_all_det ---> [cannot_fail]. :- inst try_all_semidet ---> [] ; [cannot_fail]. :- inst try_all_multi ---> [cannot_fail | try_all_nondet]. :- inst try_all_nondet == list_skel(cannot_fail). % % incremental_try_all(Goal, AccumulatorPred, Acc0, Acc): % Same as % try_all(Goal, Results), % std_util__unsorted_aggregate(Results, AccumulatorPred, Acc0, Acc) % except that operationally, the execution of try_all % and std_util__unsorted_aggregate is interleaved. :- pred incremental_try_all(pred(T), pred(exception_result(T), A, A), A, A). :- mode incremental_try_all(pred(out) is nondet, pred(in, di, uo) is det, di, uo) is cc_multi. :- mode incremental_try_all(pred(out) is nondet, pred(in, in, out) is det, in, out) is cc_multi. % % rethrow(ExceptionResult): % Rethrows the specified exception result % (which should be of the form `exception(_)', % not `succeeded(_)' or `failed'.). % :- pred rethrow(exception_result(T)). :- mode rethrow(in(bound(exception(ground)))) is erroneous. :- func rethrow(exception_result(T)) = _. :- mode rethrow(in(bound(exception(ground)))) = out is erroneous. %-----------------------------------------------------------------------------% %-----------------------------------------------------------------------------% :- implementation. :- import_module string, require. :- pred try(determinism, pred(T), exception_result(T)). :- mode try(in(bound(det)), pred(out) is det, out(cannot_fail)) is cc_multi. :- mode try(in(bound(semidet)), pred(out) is semidet, out) is cc_multi. :- mode try(in(bound(cc_multi)), pred(out) is cc_multi, out(cannot_fail)) is cc_multi. :- mode try(in(bound(cc_nondet)), pred(out) is cc_nondet, out) is cc_multi. :- pred try_io(determinism, pred(T, io__state, io__state), exception_result(T), io__state, io__state). :- mode try_io(in(bound(det)), pred(out, di, uo) is det, out(cannot_fail), di, uo) is cc_multi. :- mode try_io(in(bound(cc_multi)), pred(out, di, uo) is cc_multi, out(cannot_fail), di, uo) is cc_multi. :- pred try_all(determinism, pred(T), list(exception_result(T))). :- mode try_all(in(bound(det)), pred(out) is det, out(try_all_det)) is cc_multi. :- mode try_all(in(bound(semidet)), pred(out) is semidet, out(try_all_semidet)) is cc_multi. :- mode try_all(in(bound(multi)), pred(out) is multi, out(try_all_multi)) is cc_multi. :- mode try_all(in(bound(nondet)), pred(out) is nondet, out(try_all_nondet)) is cc_multi. % The functors in this type must be in the same order as the % enumeration constants in the C enum `ML_Determinism' defined below. :- type determinism ---> det ; semidet ; cc_multi ; cc_nondet ; multi ; nondet ; erroneous ; failure. :- pred get_determinism(pred(T), determinism). :- mode get_determinism(pred(out) is det, out(bound(det))) is cc_multi. :- mode get_determinism(pred(out) is semidet, out(bound(semidet))) is cc_multi. :- mode get_determinism(pred(out) is multi, out(bound(multi))) is cc_multi. :- mode get_determinism(pred(out) is nondet, out(bound(nondet))) is cc_multi. :- mode get_determinism(pred(out) is cc_multi, out(bound(cc_multi))) is cc_multi. :- mode get_determinism(pred(out) is cc_nondet, out(bound(cc_nondet))) is cc_multi. :- pred get_determinism_2(pred(T, io__state, io__state), determinism). :- mode get_determinism_2(pred(out, di, uo) is det, out(bound(det))) is cc_multi. :- mode get_determinism_2(pred(out, di, uo) is cc_multi, out(bound(cc_multi))) is cc_multi. % Unfortunately the only way to implement get_determinism/2 is to use % the C interface, since Mercury doesn't allow different code for different % modes. % The enumeration constants in this enum must be in the same order as the % functors in the Mercury type `determinism' defined above. :- pragma c_header_code(" typedef enum { ML_DET, ML_SEMIDET, ML_CC_MULTI, ML_CC_NONDET, ML_MULTI, ML_NONDET, ML_ERRONEOUS, ML_FAILURE } ML_Determinism; "). :- pragma c_code( get_determinism(_Pred::pred(out) is det, Det::out(bound(det))), will_not_call_mercury, "Det = ML_DET" ). :- pragma c_code( get_determinism(_Pred::pred(out) is semidet, Det::out(bound(semidet))), will_not_call_mercury, "Det = ML_SEMIDET" ). :- pragma c_code( get_determinism(_Pred::pred(out) is cc_multi, Det::out(bound(cc_multi))), will_not_call_mercury, "Det = ML_CC_MULTI" ). :- pragma c_code( get_determinism(_Pred::pred(out) is cc_nondet, Det::out(bound(cc_nondet))), will_not_call_mercury, "Det = ML_CC_NONDET" ). :- pragma c_code( get_determinism(_Pred::pred(out) is multi, Det::out(bound(multi))), will_not_call_mercury, "Det = ML_MULTI" ). :- pragma c_code( get_determinism(_Pred::pred(out) is nondet, Det::out(bound(nondet))), will_not_call_mercury, "Det = ML_NONDET" ). :- pragma c_code( get_determinism_2(_Pred::pred(out, di, uo) is det, Det::out(bound(det))), will_not_call_mercury, "Det = ML_DET" ). :- pragma c_code( get_determinism_2(_Pred::pred(out, di, uo) is cc_multi, Det::out(bound(cc_multi))), will_not_call_mercury, "Det = ML_CC_MULTI" ). throw(Exception) :- type_to_univ(Exception, Univ), builtin_throw(Univ). throw(Exception) = _ :- throw(Exception). rethrow(exception(Univ)) :- builtin_throw(Univ). rethrow(ExceptionResult) = _ :- rethrow(ExceptionResult). :- pred wrap_success(pred(T), exception_result(T)) is det. :- mode wrap_success(pred(out) is det, out) is det. :- mode wrap_success(pred(out) is semidet, out) is semidet. :- mode wrap_success(pred(out) is multi, out) is multi. :- mode wrap_success(pred(out) is nondet, out) is nondet. :- mode wrap_success(pred(out) is cc_multi, out) is cc_multi. :- mode wrap_success(pred(out) is cc_nondet, out) is cc_nondet. wrap_success(Goal, succeeded(R)) :- Goal(R). :- pred wrap_success_or_failure(pred(T), exception_result(T)) is det. :- mode wrap_success_or_failure(pred(out) is det, out) is det. :- mode wrap_success_or_failure(pred(out) is semidet, out) is det. :- mode wrap_success_or_failure(pred(out) is multi, out) is multi. :- mode wrap_success_or_failure(pred(out) is nondet, out) is multi. :- mode wrap_success_or_failure(pred(out) is cc_multi, out) is cc_multi. :- mode wrap_success_or_failure(pred(out) is cc_nondet, out) is cc_multi. wrap_success_or_failure(Goal, Result) :- (if Goal(R) then Result = succeeded(R) else Result = failed). /********************* % This doesn't work, due to % bash$ mmc exception.m % Software error: sorry, not implemented: taking address of pred % `wrap_success_or_failure/2' with multiple modes. % Instead, we need to switch on the Detism argument. try(_Detism, Goal, Result) :- builtin_catch(wrap_success_or_failure(Goal), wrap_exception, Result). *********************/ try(Goal, Result) :- get_determinism(Goal, Detism), try(Detism, Goal, Result). try(det, Goal, Result) :- builtin_catch((pred(R::out) is det :- wrap_success_or_failure(Goal, R)), wrap_exception, Result0), cc_multi_equal(Result0, Result). try(semidet, Goal, Result) :- builtin_catch((pred(R::out) is det :- wrap_success_or_failure(Goal, R)), wrap_exception, Result0), cc_multi_equal(Result0, Result). try(cc_multi, Goal, Result) :- builtin_catch( (pred(R::out) is cc_multi :- wrap_success_or_failure(Goal, R) ), wrap_exception, Result). try(cc_nondet, Goal, Result) :- builtin_catch((pred(R::out) is cc_multi :- wrap_success_or_failure(Goal, R)), wrap_exception, Result). /********** % This doesn't work, due to % bash$ mmc exception.m % Software error: sorry, not implemented: taking address of pred % `wrap_success_or_failure/2' with multiple modes. % Instead, we need to switch on the Detism argument. try_all(Goal, ResultList) :- unsorted_solutions(builtin_catch(wrap_success(Goal), wrap_exception), ResultList). **********/ try_all(Goal, ResultList) :- get_determinism(Goal, Detism), try_all(Detism, Goal, ResultList). try_all(det, Goal, [Result]) :- try(det, Goal, Result). try_all(semidet, Goal, ResultList) :- try(semidet, Goal, Result), ( Result = failed, ResultList = [] ; Result = succeeded(_), ResultList = [Result] ; Result = exception(_), ResultList = [Result] ). try_all(multi, Goal, ResultList) :- unsorted_solutions((pred(Result::out) is multi :- builtin_catch((pred(R::out) is multi :- wrap_success(Goal, R)), wrap_exception, Result)), ResultList). try_all(nondet, Goal, ResultList) :- unsorted_solutions((pred(Result::out) is nondet :- builtin_catch((pred(R::out) is nondet :- wrap_success(Goal, R)), wrap_exception, Result)), ResultList). incremental_try_all(Goal, AccPred, Acc0, Acc) :- unsorted_aggregate((pred(Result::out) is nondet :- builtin_catch((pred(R::out) is nondet :- wrap_success(Goal, R)), wrap_exception, Result)), AccPred, Acc0, Acc). try_io(IO_Goal, Result) --> { get_determinism_2(IO_Goal, Detism) }, try_io(Detism, IO_Goal, Result). % We'd better not inline try_io/5, since it uses a horrible hack % with unsafe_perform_io (see below) that might confuse the compiler. :- pragma no_inline(try_io/5). try_io(det, IO_Goal, Result) --> { Goal = (pred(R::out) is det :- very_unsafe_perform_io(IO_Goal, R)) }, { try(det, Goal, Result) }. try_io(cc_multi, IO_Goal, Result) --> { Goal = (pred(R::out) is cc_multi :- very_unsafe_perform_io(IO_Goal, R)) }, { try(cc_multi, Goal, Result) }. :- pred very_unsafe_perform_io(pred(T, io__state, io__state), T). :- mode very_unsafe_perform_io(pred(out, di, uo) is det, out) is det. :- mode very_unsafe_perform_io(pred(out, di, uo) is cc_multi, out) is det. % Mercury doesn't support impure higher-order pred terms, so if we want % to form a closure from unsafe_perform_io, as we need to do above, % then we must (falsely!) promise that it is pure. :- pragma promise_pure(very_unsafe_perform_io/2). % XXX this is a lie very_unsafe_perform_io(Goal, Result) :- impure unsafe_perform_io(Goal, Result). :- pred wrap_exception(univ::in, exception_result(T)::out) is det. wrap_exception(Exception, exception(Exception)). %-----------------------------------------------------------------------------% :- pred builtin_throw(univ). :- mode builtin_throw(in) is erroneous. :- type handler(T) == pred(univ, T). :- inst handler == (pred(in, out) is det). % % builtin_catch/3 is actually impure. But we don't declare it as impure, % because the code for try_all/3 takes its address (to pass to % unsorted_solutions/2), and Mercury does not (yet?) support % impure higher-order pred terms. % :- /* impure */ pred builtin_catch(pred(T), handler(T), T). :- mode builtin_catch(pred(out) is det, in(handler), out) is det. :- mode builtin_catch(pred(out) is semidet, in(handler), out) is semidet. :- mode builtin_catch(pred(out) is cc_multi, in(handler), out) is cc_multi. :- mode builtin_catch(pred(out) is cc_nondet, in(handler), out) is cc_nondet. :- mode builtin_catch(pred(out) is multi, in(handler), out) is multi. :- mode builtin_catch(pred(out) is nondet, in(handler), out) is nondet. % builtin_throw and builtin_catch are implemented below using % hand-coded low-level C code. :- external(builtin_throw/1). :- external(builtin_catch/3). %-----------------------------------------------------------------------------% % % The --high-level-code implementation % :- pragma c_header_code(" #ifdef MR_HIGHLEVEL_CODE /* det ==> model_det */ #define mercury__exception__builtin_catch_3_p_0 \ mercury__exception__builtin_catch_model_det /* semidet ==> model_semi */ #define mercury__exception__builtin_catch_3_p_1 \ mercury__exception__builtin_catch_model_semi /* cc_multi ==> model_det */ #define mercury__exception__builtin_catch_3_p_2 \ mercury__exception__builtin_catch_model_det /* cc_nondet ==> model_semi */ #define mercury__exception__builtin_catch_3_p_3 \ mercury__exception__builtin_catch_model_semi /* multi ==> model_non */ #define mercury__exception__builtin_catch_3_p_4 \ mercury__exception__builtin_catch_model_non /* nondet ==> model_non */ #define mercury__exception__builtin_catch_3_p_5 \ mercury__exception__builtin_catch_model_non void mercury__exception__builtin_throw_1_p_0(MR_Word); void mercury__exception__builtin_throw_1_p_0(MR_Word exception); void mercury__exception__builtin_catch_model_det(MR_Word type_info, MR_Word pred, MR_Word handler_pred, MR_Box *output); bool mercury__exception__builtin_catch_model_semi(MR_Word type_info, MR_Word pred, MR_Word handler_pred, MR_Box *output); void mercury__exception__builtin_catch_model_non(MR_Word type_info, MR_Word pred, MR_Word handler_pred, MR_Box *output, #ifdef MR_USE_GCC_NESTED_FUNCTIONS MR_NestedCont cont #else MR_Cont cont, void *cont_env #endif ); #endif /* MR_HIGHLEVEL_CODE */ "). :- pragma c_code(" #ifdef MR_HIGHLEVEL_CODE /*---------------------------------------------------------------------------*/ static void ML_call_goal_det(MR_Word type_info, MR_Word closure, MR_Box *result) { typedef void FuncType(void *, MR_Box *); FuncType *code = (FuncType *) MR_field(MR_mktag(0), closure, (Integer) 1); (*code)((void *) closure, result); } static bool ML_call_goal_semi(MR_Word type_info, MR_Word closure, MR_Box *result) { typedef bool FuncType(void *, MR_Box *); FuncType *code = (FuncType *) MR_field(MR_mktag(0), closure, (Integer) 1); return (*code)((void *) closure, result); } #ifdef MR_USE_GCC_NESTED_FUNCTIONS static void ML_call_goal_non(MR_Word type_info, MR_Word closure, MR_Box *result, MR_NestedCont cont) { typedef void FuncType(void *, MR_Box *, MR_NestedCont); FuncType *code = (FuncType *) MR_field(MR_mktag(0), closure, (Integer) 1); (*code)((void *) closure, result, cont); } #else static void ML_call_goal_non(MR_Word type_info, MR_Word closure, MR_Box *result, MR_Cont cont, void *cont_env) { typedef void FuncType(void *, MR_Box *, MR_Cont, void *); FuncType *code = (FuncType *) MR_field(MR_mktag(0), closure, (Integer) 1); (*code)((void *) closure, result, cont, cont_env); } #endif /*---------------------------------------------------------------------------*/ static void ML_call_handler_det(MR_Word type_info, MR_Word closure, MR_Word exception, MR_Box *result) { typedef void FuncType(void *, MR_Box, MR_Box *); FuncType *code = (FuncType *) MR_field(MR_mktag(0), closure, (Integer) 1); (*code)((void *) closure, exception, result); } static bool ML_call_handler_semi(MR_Word type_info, MR_Word closure, MR_Word exception, MR_Box *result) { typedef bool FuncType(void *, MR_Box, MR_Box *); FuncType *code = (FuncType *) MR_field(MR_mktag(0), closure, (Integer) 1); return (*code)((void *) closure, exception, result); } #ifdef MR_USE_GCC_NESTED_FUNCTIONS static void ML_call_handler_non(MR_Word type_info, MR_Word closure, MR_Word exception, MR_Box *result, MR_NestedCont cont) { typedef void FuncType(void *, MR_Box, MR_Box *, MR_NestedCont); FuncType *code = (FuncType *) MR_field(MR_mktag(0), closure, (Integer) 1); (*code)((void *) closure, exception, result, cont); } #else static void ML_call_handler_non(MR_Word type_info, MR_Word closure, MR_Word exception, MR_Box *result, MR_Cont cont, void *cont_env) { typedef void FuncType(void *, MR_Box, MR_Box *, MR_Cont, void *); FuncType *code = (FuncType *) MR_field(MR_mktag(0), closure, (Integer) 1); (*code)((void *) closure, exception, result, cont, cont_env); } #endif /*---------------------------------------------------------------------------*/ #include #include typedef MR_Word MR_Univ; typedef struct ML_ExceptionHandler_struct { struct ML_ExceptionHandler_struct *prev; jmp_buf handler; MR_Univ exception; } ML_ExceptionHandler; ML_ExceptionHandler *ML_exception_handler; void mercury__exception__builtin_throw_1_p_0(MR_Univ exception) { if (ML_exception_handler->handler == NULL) { ML_report_uncaught_exception(exception); abort(); } else { ML_exception_handler->exception = exception; longjmp(ML_exception_handler->handler, 1); } } void mercury__exception__builtin_catch_model_det(MR_Word type_info, MR_Word pred, MR_Word handler_pred, MR_Box *output) { ML_ExceptionHandler this_handler; this_handler.prev = ML_exception_handler; ML_exception_handler = &this_handler; if (setjmp(this_handler.handler) == 0) { ML_call_goal_det(type_info, pred, output); ML_exception_handler = this_handler.prev; } else { ML_exception_handler = this_handler.prev; ML_call_handler_det(type_info, handler_pred, this_handler.exception, output); } } bool mercury__exception__builtin_catch_model_semi(MR_Word type_info, MR_Word pred, MR_Word handler_pred, MR_Box *output) { ML_ExceptionHandler this_handler; this_handler.prev = ML_exception_handler; ML_exception_handler = &this_handler; if (setjmp(this_handler.handler) == 0) { bool result = ML_call_goal_semi(type_info, pred, output); ML_exception_handler = this_handler.prev; return result; } else { ML_exception_handler = this_handler.prev; return ML_call_handler_semi(type_info, handler_pred, this_handler.exception, output); } } #ifdef MR_USE_GCC_NESTED_FUNCTIONS void mercury__exception__builtin_catch_model_non(MR_Word type_info, MR_Word pred, MR_Word handler_pred, MR_Box *output, MR_NestedCont cont) { ML_ExceptionHandler this_handler; auto void success_cont(void); void success_cont(void) { /* ** If we reach here, it means that ** the nondet goal has succeeded, so we ** need to restore the previous exception ** handler before calling its continuation */ ML_exception_handler = this_handler.prev; (*cont)(); /* ** If we get here, it means that the continuation ** has failed, and so we are about to redo the ** nondet goal. Thus we need to re-establish ** its exception handler. */ ML_exception_handler = &this_handler; } this_handler.prev = ML_exception_handler; ML_exception_handler = &this_handler; if (setjmp(this_handler.handler) == 0) { ML_call_goal_non(type_info, pred, output, success_cont); ML_exception_handler = this_handler.prev; } else { ML_exception_handler = this_handler.prev; ML_call_handler_non(type_info, handler_pred, this_handler.exception, output, cont); } } #else /* ! MR_USE_GCC_NESTED_FUNCTIONS */ struct ML_catch_env { ML_ExceptionHandler this_handler; MR_Cont cont; void *cont_env; }; static void ML_catch_success_cont(void *env_ptr) { struct ML_catch_env *env = (struct ML_catch_env *) env_ptr; /* ** If we reach here, it means that ** the nondet goal has succeeded, so we ** need to restore the previous exception ** handler before calling its continuation */ ML_exception_handler = env->this_handler.prev; (*env->cont)(env->cont_env); /* ** If we get here, it means that the continuation ** has failed, and so we are about to redo the ** nondet goal. Thus we need to re-establish ** its exception handler. */ ML_exception_handler = &env->this_handler; } void mercury__exception__builtin_catch_model_non(MR_Word type_info, MR_Word pred, MR_Word handler_pred, MR_Box *output, MR_Cont cont, void *cont_env) { struct ML_catch_env locals; locals.cont = cont; locals.cont_env = cont_env; locals.this_handler.prev = ML_exception_handler; ML_exception_handler = &locals.this_handler; if (setjmp(locals.this_handler.handler) == 0) { ML_call_goal_non(type_info, pred, output, ML_catch_success_cont, &locals); /* ** If we reach here, it means that ** the nondet goal has failed, so we ** need to restore the previous exception ** handler */ ML_exception_handler = locals.this_handler.prev; return; } else { /* ** We caught an exception. ** Restore the previous exception handler, ** and then invoke the handler predicate ** for this handler. */ ML_exception_handler = locals.this_handler.prev; ML_call_handler_non(type_info, handler_pred, locals.this_handler.exception, output, cont, cont_env); } } #endif /* ! MR_USE_GCC_NESTED_FUNCTIONS */ #endif /* MR_HIGHLEVEL_CODE */ "). /********* This causes problems because the LLDS back-end does not let you export code with determinism `nondet'. Instead we handle-code it... see below. :- pred call_goal(pred(T), T). :- mode call_goal(pred(out) is det, out) is det. :- mode call_goal(pred(out) is semidet, out) is semidet. :- mode call_goal(pred(out) is nondet, out) is nondet. call_goal(Goal, Result) :- Goal(Result). :- pred call_handler(pred(univ, T), univ, T). :- mode call_handler(pred(in, out) is det, in, out) is det. :- mode call_handler(pred(in, out) is semidet, in, out) is semidet. :- mode call_handler(pred(in, out) is nondet, in, out) is nondet. call_handler(Handler, Exception, Result) :- Handler(Exception, Result). :- pragma export(call_goal(pred(out) is det, out), "ML_call_goal_det"). :- pragma export(call_goal(pred(out) is semidet, out), "ML_call_goal_semidet"). % :- pragma export(call_goal(pred(out) is nondet, out), "ML_call_goal_nondet"). :- pragma export(call_handler(pred(in, out) is det, in, out), "ML_call_handler_det"). :- pragma export(call_handler(pred(in, out) is semidet, in, out), "ML_call_handler_semidet"). % :- pragma export(call_handler(pred(in, out) is nondet, in, out), % "ML_call_handler_nondet"). *******/ %-----------------------------------------------------------------------------% % % The --no-high-level-code implementation % :- pragma c_header_code(" #ifndef MR_HIGHLEVEL_CODE #include #include #include ""mercury_deep_copy.h"" #include ""mercury_trace_base.h"" #include ""mercury_stack_trace.h"" #include ""mercury_layout_util.h"" MR_DECLARE_TYPE_CTOR_INFO_STRUCT( \ mercury_data_std_util__type_ctor_info_univ_0); #endif "). :- pragma c_code(" #ifndef MR_HIGHLEVEL_CODE /* ** MR_trace_throw(): ** Unwind the stack as far as possible, until we reach a frame ** with an exception handler. As we go, invoke ** `MR_trace(..., MR_PORT_EXCEPTION, ...)' for each stack frame, ** to signal to the debugger that that procedure has exited via ** an exception. This allows to user to use the `retry' command ** to restart a goal which exited via an exception. ** ** Note that if MR_STACK_TRACE is not defined, then we may not be ** able to traverse the stack all the way; in that case, we just ** print a warning and then continue. It might be better to just ** `#ifdef' out all this code (and the code in builtin_throw which ** calls it) if MR_STACK_TRACE is not defined. */ #define WARNING(msg) \\ fprintf(stderr, ""mdb: warning: %s\\n"" \\ ""This may result in some exception events\\n"" \\ ""being omitted from the trace.\\n"", (msg)) static Code * MR_trace_throw(Code *success_pointer, Word *det_stack_pointer, Word *current_frame) { const MR_Internal *label; const MR_Stack_Layout_Label *return_label_layout; /* ** Find the layout info for the stack frame pointed to by MR_succip */ label = MR_lookup_internal_by_addr(success_pointer); if (label == NULL) { WARNING(""internal label not found\\n""); return NULL; } return_label_layout = label->i_layout; while (return_label_layout != NULL) { const MR_Stack_Layout_Entry *entry_layout; Code *MR_jumpaddr; MR_Stack_Walk_Step_Result result; const char *problem; /* ** check if we've reached a frame with an exception handler */ entry_layout = return_label_layout->MR_sll_entry; if (!MR_DETISM_DET_STACK(entry_layout->MR_sle_detism) && MR_redoip_slot(current_frame) == ENTRY(exception_handler_do_fail)) { return NULL; } /* ** invoke MR_trace() to trace the exception */ if (return_label_layout->MR_sll_port != MR_PORT_EXCEPTION) { fatal_error(""return layout port is not exception""); } MR_jumpaddr = MR_trace(return_label_layout); if (MR_jumpaddr != NULL) { return MR_jumpaddr; } /* ** unwind the stacks back to the previous stack frame */ result = MR_stack_walk_step(entry_layout, &return_label_layout, &det_stack_pointer, ¤t_frame, &problem); if (result != STEP_OK) { WARNING(problem); return NULL; } restore_transient_registers(); MR_sp = det_stack_pointer; MR_curfr = current_frame; save_transient_registers(); } return NULL; } /* swap the heap with the solutions heap */ #define swap_heaps() \\ { \\ /* save the current heap */ \\ Word *swap_heaps_temp_hp = MR_hp; \\ MemoryZone *swap_heaps_temp_hp_zone = MR_heap_zone; \\ \\ /* set heap to solutions heap */ \\ MR_hp = MR_sol_hp; \\ MR_heap_zone = MR_solutions_heap_zone; \\ \\ /* set the solutions heap to be the old heap */ \\ MR_sol_hp = swap_heaps_temp_hp; \\ MR_solutions_heap_zone = swap_heaps_temp_hp_zone; \\ } Define_extern_entry(mercury__exception__builtin_catch_3_0); /* det */ Define_extern_entry(mercury__exception__builtin_catch_3_1); /* semidet */ Define_extern_entry(mercury__exception__builtin_catch_3_2); /* cc_multi */ Define_extern_entry(mercury__exception__builtin_catch_3_3); /* cc_nondet */ Define_extern_entry(mercury__exception__builtin_catch_3_4); /* multi */ Define_extern_entry(mercury__exception__builtin_catch_3_5); /* nondet */ Define_extern_entry(mercury__exception__builtin_throw_1_0); /* the following is defined in runtime/mercury_ho_call.c */ Declare_entry(mercury__do_call_closure); /* the following is defined in runtime/mercury_trace_base.c */ Declare_entry(MR_do_trace_redo_fail); Declare_label(mercury__exception__builtin_catch_3_2_i2); Declare_label(mercury__exception__builtin_catch_3_3_i2); Declare_label(mercury__exception__builtin_catch_3_5_i2); #ifdef MR_USE_TRAIL Declare_label(mercury__exception__builtin_catch_3_5_i3); #endif Declare_label(mercury__exception__builtin_throw_1_0_i1); #define BUILTIN_THROW_STACK_SIZE 1 /* ** MR_MAKE_PROC_LAYOUT(entry, detism, slots, succip_locn, pred_or_func, ** module, name, arity, mode) */ MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_throw_1_0, MR_DETISM_DET, BUILTIN_THROW_STACK_SIZE, MR_LONG_LVAL_STACKVAR(1), MR_PREDICATE, ""exception"", ""builtin_throw"", 1, 0); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_throw_1_0, 1); /* ** The following procedures all allocate their stack frames on ** the nondet stack, so for the purposes of doing stack traces ** we say they have MR_DETISM_NON, even though they are not ** actually nondet. */ MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_2, MR_DETISM_NON, /* really cc_multi; also used for det */ MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN, MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 2); MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_3, MR_DETISM_NON, /* really cc_nondet; also used for semidet */ MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN, MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 3); MR_MAKE_PROC_LAYOUT(mercury__exception__builtin_catch_3_5, MR_DETISM_NON, /* ; also used for multi */ MR_ENTRY_NO_SLOT_COUNT, MR_LONG_LVAL_TYPE_UNKNOWN, MR_PREDICATE, ""exception"", ""builtin_catch"", 3, 5); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_2, 1); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_2, 2); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_3, 1); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_3, 2); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 1); MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 2); #ifdef MR_USE_TRAIL MR_MAKE_INTERNAL_LAYOUT(mercury__exception__builtin_catch_3_5, 3); #endif BEGIN_MODULE(exceptions_module) init_entry(mercury__exception__builtin_catch_3_0); init_entry(mercury__exception__builtin_catch_3_1); init_entry_sl(mercury__exception__builtin_catch_3_2); init_entry_sl(mercury__exception__builtin_catch_3_3); init_entry(mercury__exception__builtin_catch_3_4); init_entry_sl(mercury__exception__builtin_catch_3_5); init_label_sl(mercury__exception__builtin_catch_3_2_i2); init_label_sl(mercury__exception__builtin_catch_3_3_i2); init_label_sl(mercury__exception__builtin_catch_3_5_i2); #ifdef MR_USE_TRAIL init_label(mercury__exception__builtin_catch_3_5_i3); #endif init_entry(mercury__exception__builtin_throw_1_0); init_label(mercury__exception__builtin_throw_1_0_i1); BEGIN_CODE /* ** builtin_catch(Goal, Handler, Result) ** call Goal(R). ** if succeeds, set Result = R. ** if throws an exception, call Handler(Exception, Result). ** ** This is the model_det version. ** On entry, we have a type_info (which we don't use) in r1, ** the Goal to execute in r2 and the Handler in r3. ** On exit, we should put Result in r1. */ Define_entry(mercury__exception__builtin_catch_3_0); /* det */ #ifdef PROFILE_CALLS { tailcall(ENTRY(mercury__exception__builtin_catch_3_2), ENTRY(mercury__exception__builtin_catch_3_0)); } #endif Define_entry(mercury__exception__builtin_catch_3_2); /* cc_multi */ /* ** Create an exception handler entry on the nondet stack. ** (Register r3 holds the Handler closure.) */ MR_create_exception_handler(""builtin_catch/3 [model_det]"", MR_MODEL_DET_HANDLER, r3, ENTRY(do_fail)); /* ** Now call `Goal(Result)'. */ r1 = r2; /* The Goal to call */ r2 = 0; /* Zero additional input arguments */ r3 = 1; /* One output argument */ call(ENTRY(mercury__do_call_closure), LABEL(mercury__exception__builtin_catch_3_2_i2), ENTRY(mercury__exception__builtin_catch_3_2)); Define_label(mercury__exception__builtin_catch_3_2_i2); update_prof_current_proc(LABEL(mercury__exception__builtin_catch_3_2)); /* ** On exit from mercury__do_call_closure, Result is in r1 ** ** We must now deallocate the ticket and nondet stack frame that ** were allocated by MR_create_exception_handler(). */ #ifdef MR_USE_TRAIL MR_discard_ticket(); #endif MR_succeed_discard(); /* ** builtin_catch(Goal, Handler, Result) ** call Goal(R). ** if succeeds, set Result = R. ** if fails, fail. ** if throws an exception, call Handler(Exception, Result). ** ** This is the model_semi version. ** On entry, we have a type_info (which we don't use) in r1, ** the Goal to execute in r2 and the Handler in r3, ** and on exit, we should put Result in r2. */ Define_entry(mercury__exception__builtin_catch_3_1); /* semidet */ #ifdef PROFILE_CALLS { tailcall(ENTRY(mercury__exception__builtin_catch_3_3), ENTRY(mercury__exception__builtin_catch_3_1)); } #endif Define_entry(mercury__exception__builtin_catch_3_3); /* cc_nondet */ /* ** Create an exception handler entry on the nondet stack. ** (Register r3 holds the Handler closure.) */ MR_create_exception_handler(""builtin_catch/3 [model_semi]"", MR_MODEL_SEMI_HANDLER, r3, ENTRY(do_fail)); /* ** Now call `Goal(Result)'. */ r1 = r2; /* The Goal to call */ r2 = 0; /* Zero additional input arguments */ r3 = 1; /* One output argument */ call(ENTRY(mercury__do_call_closure), LABEL(mercury__exception__builtin_catch_3_3_i2), ENTRY(mercury__exception__builtin_catch_3_3)); Define_label(mercury__exception__builtin_catch_3_3_i2); update_prof_current_proc(LABEL(mercury__exception__builtin_catch_3_3)); /* ** On exit from do_call_semidet_closure, the success/failure ** indicator is in r1, and Result is in r2. ** Note that we call succeed_discard() to exit regardless ** of whether r1 is true or false. We just return the r1 value ** back to our caller. */ #ifdef MR_USE_TRAIL MR_discard_ticket(); #endif MR_succeed_discard(); /* ** builtin_catch(Goal, Handler, Result) ** call Goal(R). ** if succeeds, set Result = R. ** if fails, fail. ** if throws an exception, call Handler(Exception, Result). ** ** This is the model_non version. ** On entry, we have a type_info (which we don't use) in r1, ** the Goal to execute in r2 and the Handler in r3. ** On exit, we should put Result in r1. */ Define_entry(mercury__exception__builtin_catch_3_4); /* multi */ #ifdef PROFILE_CALLS { tailcall(ENTRY(mercury__exception__builtin_catch_3_5), ENTRY(mercury__exception__builtin_catch_3_4)); } #endif Define_entry(mercury__exception__builtin_catch_3_5); /* nondet */ /* ** Create an exception handler entry on the nondet stack. ** (Register r3 holds the Handler closure.) */ #ifdef MR_USE_TRAIL MR_create_exception_handler(""builtin_catch/3 [model_nondet]"", MR_MODEL_NON_HANDLER, r3, LABEL(mercury__exception__builtin_catch_3_5_i3)); #else MR_create_exception_handler(""builtin_catch/3 [model_nondet]"", MR_MODEL_NON_HANDLER, r3, ENTRY(do_fail)); #endif /* ** Now call `Goal(Result)'. */ r1 = r2; /* the Goal to call */ r2 = 0; /* Zero additional input arguments */ r3 = 1; /* One output argument */ call(ENTRY(mercury__do_call_closure), LABEL(mercury__exception__builtin_catch_3_5_i2), ENTRY(mercury__exception__builtin_catch_3_5)); Define_label(mercury__exception__builtin_catch_3_5_i2); update_prof_current_proc(LABEL(mercury__exception__builtin_catch_3_5)); /* ** On exit from do_call_nondet_closure, Result is in r1 ** ** Note that we need to keep the trail ticket still, ** in case it is needed again on backtracking. ** We can only discard it when we MR_fail() out, or ** (if an exception is thrown) in the throw. */ MR_succeed(); #ifdef MR_USE_TRAIL Define_label(mercury__exception__builtin_catch_3_5_i3); MR_discard_ticket(); MR_fail(); #endif /* ** builtin_throw(Exception): ** Throw the specified exception. ** That means unwinding the nondet stack until we find a handler, ** unwinding all the other Mercury stacks, and then ** calling longjmp() to unwind the C stack. ** The longjmp() will branch to builtin_catch which will then ** call Handler(Exception, Result). ** ** On entry, we have Exception in r1. */ Define_entry(mercury__exception__builtin_throw_1_0); { Word exception = r1; Word handler; enum MR_HandlerCodeModel catch_code_model; Word *orig_curfr; Unsigned exception_event_number = MR_trace_event_number; /* ** let the debugger trace exception throwing */ if (MR_trace_enabled) { Code *MR_jumpaddr; save_transient_registers(); MR_jumpaddr = MR_trace_throw(MR_succip, MR_sp, MR_curfr); restore_transient_registers(); if (MR_jumpaddr != NULL) GOTO(MR_jumpaddr); } /* ** Search the nondet stack for an exception handler, ** i.e. a frame whose redoip is `exception_handler_do_fail' ** (one created by `builtin_catch'). ** N.B. We search down the `succfr' chain, not the `prevfr' chain; ** this ensures that we only find handlers installed by our callers, ** not handlers installed by procedures that we called but which ** are still on the nondet stack because they left choice points ** behind. */ orig_curfr = MR_curfr; while (MR_redoip_slot(MR_curfr) != ENTRY(exception_handler_do_fail)) { MR_curfr = MR_succfr_slot(MR_curfr); if (MR_curfr < MR_CONTEXT(nondetstack_zone)->min) { Word *save_succip; /* ** There was no exception handler. ** ** We restore the original value of MR_curfr, ** print out some diagnostics, ** and then terminate execution. ** ** We need to save the registers to the fake_reg ** array using save_registers() before calling ** ML_report_uncaught_exception, since that is ** Mercury code and the C->Mercury interface expects ** the registers to be saved. ** We also need to save & restore the MR_succip ** across that call, since any call to Mercury code ** may clobber MR_succip (and also the Mercury ** registers r1, r2, r3, etc., but for those we don't ** care, since we don't use them). ** Note that the save_registers() alone is not ** sufficient since the Mercury code may clobber the ** copy of MR_succip in the fake_reg. */ MR_curfr = orig_curfr; fflush(stdout); save_succip = MR_succip; save_registers(); ML_report_uncaught_exception(exception); MR_succip = save_succip; MR_trace_report(stderr); if (exception_event_number > 0) { fprintf(stderr, ""Last trace event before "" ""the unhandled exception was "" ""event #%ld.\\n"", (long) exception_event_number); } if (MR_trace_enabled) { /* ** The stack has already been unwound ** by MR_trace_throw(), so we can't dump it. ** (In fact, if we tried to dump the now-empty ** stack, we'd get incorrect results, since ** MR_trace_throw() does not restore MR_succip ** to the appropriate value.) */ } else { MR_dump_stack(MR_succip, MR_sp, MR_curfr, FALSE); } exit(1); } } /* ** Save the handler we found */ catch_code_model = MR_EXCEPTION_FRAMEVARS->code_model; handler = MR_EXCEPTION_FRAMEVARS->handler; /* ** Reset the success ip (i.e. return address). ** This ensures that when we return from this procedure, ** we will return to the caller of `builtin_catch'. */ MR_succip = MR_succip_slot(MR_curfr); /* ** Reset the det stack. */ MR_sp = MR_EXCEPTION_FRAMEVARS->stack_ptr; #ifdef MR_USE_TRAIL /* ** Reset the trail. */ MR_reset_ticket(MR_EXCEPTION_FRAMEVARS->trail_ptr, MR_exception); MR_discard_tickets_to(MR_EXCEPTION_FRAMEVARS->ticket_counter); #endif #ifndef CONSERVATIVE_GC /* ** Reset the heap. But we need to be careful to preserve the ** thrown exception object. ** ** The following algorithm uses the `solutions heap', and will work ** with non-conservative gc. We copy the exception object to the ** solutions_heap, reset the heap pointer, and then copy it back. ** ** An improvement to this would be to copy the exception object to the ** solutions heap, but have deep_copy add an offset to the pointers ** (at least, those that would otherwise point to the solutions heap), ** so that, when finished, a block move of the solutions heap back to ** the real heap will leave all the pointers in the correct place. */ { Word * saved_solns_heap_ptr; /* switch to the solutions heap */ if (MR_heap_zone == MR_EXCEPTION_FRAMEVARS->heap_zone) { swap_heaps(); } saved_solns_heap_ptr = MR_hp; /* ** deep_copy() the exception to the solutions heap. ** Note that we need to save/restore the hp register, if it ** is transient, before/after calling deep_copy(). */ assert(MR_EXCEPTION_FRAMEVARS->heap_ptr <= MR_EXCEPTION_FRAMEVARS->heap_zone->top); save_transient_registers(); exception = deep_copy(&exception, (Word *) &mercury_data_std_util__type_ctor_info_univ_0, MR_EXCEPTION_FRAMEVARS->heap_ptr, MR_EXCEPTION_FRAMEVARS->heap_zone->top); restore_transient_registers(); /* switch back to the ordinary heap */ swap_heaps(); /* reset the heap */ assert(MR_EXCEPTION_FRAMEVARS->heap_ptr <= MR_hp); MR_hp = MR_EXCEPTION_FRAMEVARS->heap_ptr; /* deep_copy the exception back to the ordinary heap */ assert(MR_EXCEPTION_FRAMEVARS->solns_heap_ptr <= MR_solutions_heap_zone->top); save_transient_registers(); exception = deep_copy(&exception, (Word *) &mercury_data_std_util__type_ctor_info_univ_0, saved_solns_heap_ptr, MR_solutions_heap_zone->top); restore_transient_registers(); /* reset the solutions heap */ assert(MR_EXCEPTION_FRAMEVARS->solns_heap_ptr <= saved_solns_heap_ptr); assert(saved_solns_heap_ptr <= MR_sol_hp); if (catch_code_model == MR_MODEL_NON_HANDLER) { /* ** If the code inside the try (catch) was nondet, ** then its caller (which may be solutions/2) may ** have put some more stuff on the solutions-heap ** after the goal succeeded; the goal may have ** only thrown after being re-entered on backtracking. ** Thus we can only reset the solutions heap to ** where it was before copying the exception object to it. */ MR_sol_hp = saved_solns_heap_ptr; } else { /* ** If the code inside the try (catch) was det or semidet, ** we can safely reset the solutions heap to where ** it was when it try (catch) was entered. */ MR_sol_hp = MR_EXCEPTION_FRAMEVARS->solns_heap_ptr; } } #endif /* !defined(CONSERVATIVE_GC) */ /* ** Pop the final exception handler frame off the nondet stack, ** and reset the nondet stack top. (This must be done last, ** since it invalidates all the framevars.) */ MR_maxfr = MR_prevfr_slot(MR_curfr); MR_curfr = MR_maxfr; /* ** Now longjmp to the catch, which will invoke the handler ** that we found. */ if (catch_code_model == MR_C_LONGJMP_HANDLER) { MR_ENGINE(e_exception) = (Word *) exception; save_registers(); longjmp(*(MR_ENGINE(e_jmp_buf)), 1); } /* ** Otherwise, the handler is a Mercury closure. ** Invoke the handler as `Handler(Exception, Result)'. */ r1 = handler; /* get the Handler closure */ r2 = 1; /* One additional input argument */ r3 = 1; /* One output argument */ r4 = exception; /* This is our one input argument */ /* ** If the catch was semidet, we need to set the success indicator ** r1 to TRUE and return the result in r2; otherwise, we return ** the result in r1, which is where mercury__do_call_closure puts it, ** so we can to a tailcall. */ if (catch_code_model != MR_MODEL_SEMI_HANDLER) { tailcall(ENTRY(mercury__do_call_closure), ENTRY(mercury__exception__builtin_throw_1_0)); } MR_incr_sp_push_msg(1, ""builtin_throw/1""); MR_stackvar(1) = (Word) MR_succip; call(ENTRY(mercury__do_call_closure), LABEL(mercury__exception__builtin_throw_1_0_i1), ENTRY(mercury__exception__builtin_throw_1_0)); } Define_label(mercury__exception__builtin_throw_1_0_i1); update_prof_current_proc(LABEL(mercury__exception__builtin_throw_1_0)); /* we've just returned from mercury__do_call_closure */ r2 = r1; r1 = TRUE; MR_succip = (Code *) MR_stackvar(1); MR_decr_sp_pop_msg(1); proceed(); /* return to the caller of `builtin_catch' */ END_MODULE /* Ensure that the initialization code for the above module gets run. */ /* INIT mercury_sys_init_exceptions */ /* suppress gcc -Wmissing-decls warning */ void mercury_sys_init_exceptions(void); void mercury_sys_init_exceptions(void) { exceptions_module(); } #endif /* ! MR_HIGHLEVEL_CODE */ "). %-----------------------------------------------------------------------------% :- pragma export(report_uncaught_exception(in, di, uo), "ML_report_uncaught_exception"). :- pred report_uncaught_exception(univ, io__state, io__state). :- mode report_uncaught_exception(in, di, uo) is cc_multi. report_uncaught_exception(Exception) --> try_io(report_uncaught_exception_2(Exception), Result), ( { Result = succeeded(_) } ; { Result = exception(_) } % if we got a further exception while trying to report % the uncaught exception, just ignore it ). :- pred report_uncaught_exception_2(univ, unit, io__state, io__state). :- mode report_uncaught_exception_2(in, out, di, uo) is det. report_uncaught_exception_2(Exception, unit) --> io__stderr_stream(StdErr), io__write_string(StdErr, "Uncaught exception:\n"), ( { univ_to_type(Exception, software_error(Message)) } -> io__format(StdErr, "Software Error: %s\n", [s(Message)]) ; io__write(StdErr, univ_value(Exception)), io__nl(StdErr) ). /* ** unsafe_perform_io/2 is the same as unsafe_perform_io/1 ** (see extras/trailed_update/unsafe.m) ** except that it also allows the predicate to return an output argument. */ :- impure pred unsafe_perform_io(pred(T, io__state, io__state), T). :- mode unsafe_perform_io(pred(out, di, uo) is det, out) is det. :- mode unsafe_perform_io(pred(out, di, uo) is cc_multi, out) is det. :- pragma c_code( unsafe_perform_io(P::(pred(out, di, uo) is det), X::out), may_call_mercury, "{ ML_exception_call_io_pred_det(TypeInfo_for_T, P, &X); }"). :- pragma c_code( unsafe_perform_io(P::(pred(out, di, uo) is cc_multi), X::out), may_call_mercury, "{ ML_exception_call_io_pred_cc_multi(TypeInfo_for_T, P, &X); }"). :- pred call_io_pred(pred(T, io__state, io__state), T, io__state, io__state). :- mode call_io_pred(pred(out, di, uo) is det, out, di, uo) is det. :- mode call_io_pred(pred(out, di, uo) is cc_multi, out, di, uo) is cc_multi. :- pragma export(call_io_pred(pred(out, di, uo) is det, out, di, uo), "ML_exception_call_io_pred_det"). :- pragma export(call_io_pred(pred(out, di, uo) is cc_multi, out, di, uo), "ML_exception_call_io_pred_cc_multi"). call_io_pred(P, X) --> P(X). %-----------------------------------------------------------------------------%