This repository has been archived on 2023-08-20. You can view files and clone it, but cannot push or open issues or pull requests.
yap-6.3/pl/errors.yap
2016-09-21 14:57:46 -05:00

147 lines
3.7 KiB
Prolog

/*************************************************************************
* *
* YAP Prolog *
* *
* Yap Prolog was developed at NCCUP - Universidade do Porto *
* *
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
* *
**************************************************************************
* *
* File: errors.yap *
* comments: error messages for YAP *
* *
* *
* *
*************************************************************************/
/** @defgroup YAPError Error Handling
@ingroup YAPControl
The error handler is called when there is an execution error or a
warning needs to be displayed. The handlers include a number of hooks
to allow user-control.
Errors are terms of the form:
- error( domain_error( Domain, Culprit )`
- error( evaluation_error( Expression, Culprit )`
- error( existence_error( Object, Culprit )`
- error( instantiation_error )`
- error( permission_error( Error, Permission, Culprit)`
- error( representation_error( Domain, Culprit )`
- error( resource_error( Resource, Culprit )`
- error( syntax_error( Error )`
- error( system_error( Domain, Culprit )`
- error( type_error( Type, Culprit )`
- error( uninstantiation_error( Culprit )`
@{
*/
:- system_module( '$_errors', [system_error/2], ['$Error'/1,
'$do_error'/2,
system_error/3,
system_error/2]).
:- use_system_module( '$messages', [file_location/2,
generate_message/3,
translate_message/4]).
/**
* @pred system_error( +Error, +Cause)
*
* Generate a system error _Error_, informing the possible cause _Cause_.
*
*/
system_error(Type,Goal) :-
'$do_error'(Type,Goal).
'$do_error'(Type,Goal) :-
% format('~w~n', [Type]),
ancestor_location(Call, Caller),
throw(error(Type, [
[g|g(Goal)],
[p|Call],
[e|Caller]])).
/**
* @pred system_error( +Error, +Cause, +Culprit)
*
* Generate a system error _Error_, informing the source goal _Cause_ and a possible _Culprit_.
*
*
* ~~~~~~~~~~
* ~~~~~~~~~~
*
*
*/
system_error(Type,Goal,Culprit) :-
% format('~w~n', [Type]),
ancestor_location(Call, Caller),
throw(error(Type, [
[i|Culprit],
[g|g(Goal)],
[p|Call],
[e|Caller]])).
'$do_pi_error'(type_error(callable,Name/0),Message) :- !,
'$do_error'(type_error(callable,Name),Message).
'$do_pi_error'(Error,Message) :- !,
'$do_error'(Error,Message).
'$Error'(E) :-
'$LoopError'(E,top).
'$LoopError'(_, _) :-
flush_output(user_output),
flush_output(user_error),
fail.
'$LoopError'(Error, Level) :- !,
'$process_error'(Error, Level),
fail.
'$LoopError'(_, _) :-
flush_output,
'$close_error',
fail.
'$process_error'('$forward'(Msg), _) :-
!,
throw( '$forward'(Msg) ).
'$process_error'('$abort', Level) :-
!,
'$process_error'(abort, Level) :-
!,
(
Level \== top
->
throw( abort )
;
current_prolog_flag(break_level, 0)
->
print_message(informational,abort(user)),
fail
;
current_prolog_flag(break_level, I0),
I is I0-1,
current_prolog_flag(break_level, I),
throw(abort)
).
'$process_error'(error(thread_cancel(_Id), _G),top) :- !.
'$process_error'(error(thread_cancel(Id), G), _) :- !,
throw(error(thread_cancel(Id), G)).
'$process_error'(error(permission_error(module,redefined,A),B), Level) :-
Level \= top, !,
throw(error(permission_error(module,redefined,A),B)).
'$process_error'(error(Msg, Where), _) :-
print_message(error,error(Msg, Where)), !.
'$process_error'(Throw, _) :-
print_message(error,error(unhandled_exception,Throw)).
%% @}