Big update to support more SICStus/SWI like message handling
fix YAPSHAREDIR fix yap.tex (Bernd) git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@2107 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc
parent
da6d73302a
commit
17d16e0b14
17
C/cdmgr.c
17
C/cdmgr.c
|
|
@ -11,8 +11,12 @@
|
|||
* File: cdmgr.c *
|
||||
* comments: Code manager *
|
||||
* *
|
||||
* Last rev: $Date: 2008-01-23 17:57:44 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-02-22 15:08:33 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.218 2008/01/23 17:57:44 vsc
|
||||
* valgrind it!
|
||||
* enable atom garbage collection.
|
||||
*
|
||||
* Revision 1.217 2007/12/26 19:50:40 vsc
|
||||
* new version of clp(fd)
|
||||
* fix deadlock with empty args facts in clause/2.
|
||||
|
|
@ -3331,16 +3335,17 @@ static Term
|
|||
all_calls(void)
|
||||
{
|
||||
Term ts[3];
|
||||
Functor f = Yap_MkFunctor(AtomLocal,3);
|
||||
Functor f = Yap_MkFunctor(AtomLocal,4);
|
||||
|
||||
ts[0] = MkIntegerTerm((Int)P);
|
||||
ts[1] = MkIntegerTerm((Int)CP);
|
||||
if (yap_flags[STACK_DUMP_ON_ERROR_FLAG]) {
|
||||
ts[1] = all_envs(ENV);
|
||||
ts[2] = all_cps(B);
|
||||
ts[2] = all_envs(ENV);
|
||||
ts[3] = all_cps(B);
|
||||
} else {
|
||||
ts[1] = ts[2] = TermNil;
|
||||
ts[2] = ts[3] = TermNil;
|
||||
}
|
||||
return(Yap_MkApplTerm(f,3,ts));
|
||||
return(Yap_MkApplTerm(f,4,ts));
|
||||
}
|
||||
|
||||
Term
|
||||
|
|
|
|||
|
|
@ -1233,6 +1233,8 @@ post_process_eof(StreamDesc *s)
|
|||
static int
|
||||
console_post_process_read_char(int ch, StreamDesc *s)
|
||||
{
|
||||
/* the character is also going to be output by the console handler */
|
||||
console_count_output_char(ch,Stream+StdErrStream);
|
||||
if (ch == '\n') {
|
||||
++s->linecount;
|
||||
++s->charcount;
|
||||
|
|
|
|||
|
|
@ -695,8 +695,15 @@ p_thread_runtime(void)
|
|||
return Yap_unify(ARG1,MkIntTerm(0));
|
||||
}
|
||||
|
||||
static Int
|
||||
p_thread_self(void)
|
||||
{ /* '$thread_runtime'(+P) */
|
||||
return Yap_unify(ARG1,MkIntTerm(0));
|
||||
}
|
||||
|
||||
void Yap_InitThreadPreds(void)
|
||||
{
|
||||
Yap_InitCPred("$thread_self", 1, p_thread_self, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$no_threads", 0, p_no_threads, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$max_threads", 1, p_max_threads, SafePredFlag|HiddenPredFlag);
|
||||
Yap_InitCPred("$nof_threads", 1, p_nof_threads, SafePredFlag|HiddenPredFlag);
|
||||
|
|
|
|||
|
|
@ -185,10 +185,14 @@ PL_SOURCES= \
|
|||
$(srcdir)/pl/checker.yap $(srcdir)/pl/chtypes.yap \
|
||||
$(srcdir)/pl/consult.yap \
|
||||
$(srcdir)/pl/corout.yap $(srcdir)/pl/debug.yap \
|
||||
$(srcdir)/pl/depth_bound.yap \
|
||||
$(srcdir)/pl/directives.yap \
|
||||
$(srcdir)/pl/eam.yap \
|
||||
$(srcdir)/pl/errors.yap $(srcdir)/pl/grammar.yap \
|
||||
$(srcdir)/pl/ground.yap $(srcdir)/pl/init.yap \
|
||||
$(srcdir)/pl/depth_bound.yap $(srcdir)/pl/listing.yap \
|
||||
$(srcdir)/pl/ground.yap
|
||||
$(srcdir)/pl/hacks.yap
|
||||
$(srcdir)/pl/init.yap \
|
||||
$(srcdir)/pl/listing.yap \
|
||||
$(srcdir)/pl/load_foreign.yap \
|
||||
$(srcdir)/pl/modules.yap $(srcdir)/pl/preds.yap \
|
||||
$(srcdir)/pl/profile.yap \
|
||||
|
|
@ -199,7 +203,6 @@ PL_SOURCES= \
|
|||
$(srcdir)/pl/strict_iso.yap \
|
||||
$(srcdir)/pl/tabling.yap $(srcdir)/pl/threads.yap \
|
||||
$(srcdir)/pl/utils.yap \
|
||||
$(srcdir)/pl/eam.yap \
|
||||
$(srcdir)/pl/yapor.yap $(srcdir)/pl/yio.yap
|
||||
|
||||
YAPDOCS=$(srcdir)/docs/yap.tex $(srcdir)/docs/chr.tex \
|
||||
|
|
|
|||
|
|
@ -17,6 +17,11 @@ xb
|
|||
|
||||
<h2>Yap-5.1.3:</h2>
|
||||
<ul>
|
||||
<li> FIXED: in console, count input characters as being output, as they
|
||||
are also supposed to be displayed by the console manager.</li>
|
||||
<li> NEW: SWI/SICStus compatible messaging system.</li>
|
||||
<li> FIXED: YAPSHAREDIR was only used when creating the saved state (obs from
|
||||
Nuno Fonseca).</li>
|
||||
<li> FIXED: indexing code could not see end of static clause (obs from
|
||||
Lisa Torrey).</li>
|
||||
<li> FIXED: indexing code for dynamic predicates was broken with
|
||||
|
|
|
|||
116
docs/yap.tex
116
docs/yap.tex
|
|
@ -114,6 +114,7 @@ us to include his text in this document.
|
|||
Built In Predicates
|
||||
* Control:: Controlling the execution of Prolog programs
|
||||
* Undefined Procedures:: Handling calls to Undefined Procedures
|
||||
* Messages:: Message Handling in YAP
|
||||
* Testing Terms:: Predicates on Terms
|
||||
* Predicates on Atoms:: Manipulating Atoms
|
||||
* Predicates on Characters:: Manipulating Characters
|
||||
|
|
@ -2390,6 +2391,7 @@ may result in incorrect execution.
|
|||
Built-ins, Debugging, Syntax, Top
|
||||
* Control:: Controlling the Execution of Prolog Programs
|
||||
* Undefined Procedures:: Handling calls to Undefined Procedures
|
||||
* Messages:: Message Handling in YAP
|
||||
* Testing Terms:: Predicates on Terms
|
||||
* Predicates on Atoms:: Manipulating Atoms
|
||||
* Predicates on Characters:: Manipulating Characters
|
||||
|
|
@ -2835,13 +2837,13 @@ Increase stack size @var{Size} kilobytes.
|
|||
|
||||
@end table
|
||||
|
||||
@node Undefined Procedures, Testing Terms, Control, Top
|
||||
@node Undefined Procedures, Messages, Control, Top
|
||||
@section Handling Undefined Procedures
|
||||
|
||||
A predicate in a module is said to be undefined if there are no clauses
|
||||
defining the predicate, and if the predicate has not been declared to be
|
||||
dynamic. What YAP does when trying to execute undefined predicates can
|
||||
be specified through three different ways:
|
||||
be specified in three different ways:
|
||||
@itemize @bullet
|
||||
@item By setting an YAP flag, through the @code{yap_flag/2} or
|
||||
@code{set_prolog_flag/2} built-ins. This solution generalizes the
|
||||
|
|
@ -2914,7 +2916,113 @@ execute @var{NG}. If @code{user:unknown_predicate_handler/3} fails, the
|
|||
system will execute default action as specified by @code{unknown/2}.
|
||||
@end table
|
||||
|
||||
@node Testing Terms, Predicates on Atoms, Undefined Procedures, Top
|
||||
@node Messages, Testing Terms, Undefined Procedures, Top
|
||||
@section Message Handling
|
||||
|
||||
The interaction between YAP and the user relies on YAP's ability to
|
||||
portray messages. These messages range from prompts to error
|
||||
information. All message processing is performed through the builtin
|
||||
@code{print_message/2}, in two steps:
|
||||
|
||||
@itemize @bullet
|
||||
@item The message is processed into a list of commands
|
||||
@item The commands in the list are sent to the @code{format/3} builtin
|
||||
in sequence.
|
||||
@end itemize
|
||||
|
||||
The first argument to @code{print_message/2} specifies the importance of
|
||||
the message. The options are:
|
||||
|
||||
@table @code
|
||||
@item error
|
||||
error handling
|
||||
@item warning
|
||||
compilation and run-time warnings,
|
||||
@item informational
|
||||
generic informational messages
|
||||
@item help
|
||||
help messages (not currently implemented in YAP)
|
||||
@item query
|
||||
query used in query processing (not currently implemented in YAP)
|
||||
@item silent
|
||||
messages that do not produce output but that can be intercepted by hooks.
|
||||
@end table
|
||||
|
||||
The next table shows the main predicates and hooks associated to message
|
||||
handling in YAP:
|
||||
@table @code
|
||||
@item print_message(+@var{Kind}, @var{Term})
|
||||
@findex print_message/2
|
||||
@syindex print_message/2
|
||||
@cnindex print_message/2
|
||||
The predicate print_message/2 is used to print messages, notably from
|
||||
exceptions in a human-readable format. @var{Kind} is one of
|
||||
@code{informational}, @code{banner}, @code{warning}, @code{error},
|
||||
@code{help} or @code{silent}. A human-readable message is printed to
|
||||
the stream @code{user_error}.
|
||||
|
||||
@c \index{silent}\index{quiet}%
|
||||
If the Prolog flag @code{verbose} is @code{silent}, messages with
|
||||
@var{Kind} @code{informational}, or @code{banner} are treated as
|
||||
silent.@c See \cmdlineoption{-q}.
|
||||
|
||||
This predicate first translates the @var{Term} into a list of `message
|
||||
lines' (see @code{print_message_lines/3} for details). Next it will
|
||||
call the hook @code{message_hook/3} to allow the user intercepting the
|
||||
message. If @code{message_hook/3} fails it will print the message unless
|
||||
@var{Kind} is silent.
|
||||
|
||||
@c The print_message/2 predicate and its rules are in the file
|
||||
@c \file{<plhome>/boot/messages.pl}, which may be inspected for more
|
||||
@c information on the error messages and related error terms.
|
||||
If you need to report errors from your own predicates, we advise you to
|
||||
stick to the existing error terms if you can; but should you need to
|
||||
invent new ones, you can define corresponding error messages by
|
||||
asserting clauses for @code{prolog:message/2}. You will need to declare
|
||||
the predicate as multifile.
|
||||
|
||||
@c See also message_to_string/2.
|
||||
|
||||
@item print_message_lines(+@var{Stream}, +@var{Prefix}, +@var{Lines})
|
||||
@findex print_message_lines/3
|
||||
@syindex print_message_lines/3
|
||||
@cnindex print_message_lines/3
|
||||
Print a message (see @code{print_message/2}) that has been translated to
|
||||
a list of message elements. The elements of this list are:
|
||||
|
||||
@table @code
|
||||
@item @code{<Format>}-@code{<Args>}
|
||||
Where @var{Format} is an atom and @var{Args} is a list
|
||||
of format argument. Handed to @code{format/3}.
|
||||
@item @code{flush}
|
||||
If this appears as the last element, @var{Stream} is flushed
|
||||
(see @code{flush_output/1}) and no final newline is generated.
|
||||
@item @code{at_same_line}
|
||||
If this appears as first element, no prefix is printed for
|
||||
the first line and the line-position is not forced to 0
|
||||
(see @code{format/1}, @code{~N}).
|
||||
@item @code{<Format>}
|
||||
Handed to @code{format/3} as @code{format(Stream, Format, [])}.
|
||||
@item nl
|
||||
A new line is started and if the message is not complete
|
||||
the @var{Prefix} is printed too.
|
||||
@end table
|
||||
|
||||
@item user:message_hook(+@var{Term}, +@var{Kind}, +@var{Lines})
|
||||
@findex message_hook/3
|
||||
@syindex message_hook/3
|
||||
@cnindex message_hook/3
|
||||
Hook predicate that may be define in the module @code{user} to intercept
|
||||
messages from @code{print_message/2}. @var{Term} and @var{Kind} are the
|
||||
same as passed to @code{print_message/2}. @var{Lines} is a list of
|
||||
format statements as described with @code{print_message_lines/3}.
|
||||
|
||||
This predicate should be defined dynamic and multifile to allow other
|
||||
modules defining clauses for it too.
|
||||
|
||||
@end table
|
||||
|
||||
@node Testing Terms, Predicates on Atoms, Messages, Top
|
||||
@section Predicates on terms
|
||||
|
||||
@table @code
|
||||
|
|
@ -3966,7 +4074,7 @@ YAP currently ignores these options.
|
|||
@findex time_file/2
|
||||
@snindex time_file/2
|
||||
@cnindex time_file/2
|
||||
Unify the last modification time of @vaar{File} with
|
||||
Unify the last modification time of @var{File} with
|
||||
@var{Time}. @var{Time} is a floating point number expressing the seconds
|
||||
elapsed since Jan 1, 1970.
|
||||
|
||||
|
|
|
|||
|
|
@ -25,64 +25,13 @@ stack_dump(Max) :-
|
|||
length(CPs, LCPs),
|
||||
length(Envs, LEnvs),
|
||||
format(user_error,'~n~n~tStack Dump~t~40+~n~nAddress~tChoiceP~16+ Cur/Next Clause Goal~n',[LCPs,LEnvs]),
|
||||
display_stack_info(CPs,Envs,Max,ContP).
|
||||
display_stack_info(CPs, Envs, Max, ContP, StackInfo, StackInfo, []),
|
||||
run_formats(StackInfo, user_error).
|
||||
|
||||
run_formats([], _).
|
||||
run_formats([Com-Args|StackInfo], Stream) :-
|
||||
format(Stream, Com, Args),
|
||||
run_formats(StackInfo, user_error).
|
||||
|
||||
display_stack_info(_,_,0,_) :- !.
|
||||
display_stack_info([],[],_,_).
|
||||
display_stack_info([CP|CPs],[],I,_) :-
|
||||
show_lone_cp(CP),
|
||||
I1 is I-1,
|
||||
display_stack_info(CPs,[],I1,_).
|
||||
display_stack_info([],[Env|Envs],I,Cont) :-
|
||||
show_env(Env, Cont, NCont),
|
||||
I1 is I-1,
|
||||
display_stack_info([], Envs, I1, NCont).
|
||||
display_stack_info([CP|LCPs],[Env|LEnvs],I,Cont) :-
|
||||
continuation(Env, _, NCont, CB),
|
||||
I1 is I-1,
|
||||
( CP == Env, CB < CP ->
|
||||
% if we follow choice-point and we cut to before choice-point
|
||||
% we are the same goal
|
||||
show_cp(CP, 'Cur'), %
|
||||
display_stack_info(LCPs, LEnvs, I1, NCont)
|
||||
;
|
||||
CP > Env ->
|
||||
show_cp(CP, 'Next'),
|
||||
display_stack_info(LCPs,[Env|LEnvs],I1,Cont)
|
||||
;
|
||||
show_env(Env,Cont,NCont),
|
||||
display_stack_info([CP|LCPs],LEnvs,I1,NCont)
|
||||
).
|
||||
|
||||
show_cp(CP, Continuation) :-
|
||||
choicepoint(CP, Addr, Mod, Name, Arity, Goal, ClNo),
|
||||
( Goal = (_;_)
|
||||
->
|
||||
format(user_error,'0x~16r~t*~16+ Cur~t~d~16+ ~q:~q/~d( ? ; ? )~n',
|
||||
[Addr, ClNo, Mod, Name, Arity])
|
||||
;
|
||||
prolog_flag( debugger_print_options, Opts),
|
||||
format(user_error,'0x~16r~t *~16+ ~a~t ~d~16+ ~q:~@~n',
|
||||
[Addr, Continuation, ClNo, Mod, write_term(Goal,Opts)])
|
||||
).
|
||||
|
||||
show_env(Env,Cont,NCont) :-
|
||||
continuation(Env, Addr, NCont, _),
|
||||
cp_to_predicate(Cont, Mod, Name, Arity, ClId),
|
||||
format(user_error,'0x~16r~t ~16+ Cur~t ~d~16+ ~q:~q~@~n',
|
||||
[Addr, ClId, Mod, Name, show_args(Arity)]).
|
||||
|
||||
show_args(0) :- !.
|
||||
show_args(I) :-
|
||||
format('(?',[]),
|
||||
I1 is I-1,
|
||||
show_inner_args(I1),
|
||||
format(')',[]).
|
||||
|
||||
show_inner_args(0) :- !.
|
||||
show_inner_args(I) :-
|
||||
format(', ?',[]),
|
||||
I1 is I-1,
|
||||
show_inner_args(I1).
|
||||
|
||||
|
||||
|
|
|
|||
24
pl/boot.yap
24
pl/boot.yap
|
|
@ -45,6 +45,14 @@ true :- true.
|
|||
;
|
||||
true
|
||||
),
|
||||
(
|
||||
retractall(user:library_directory(_)),
|
||||
'$system_library_directories'(D),
|
||||
assert(user:library_directory(D)),
|
||||
fail
|
||||
;
|
||||
true
|
||||
),
|
||||
'$stream_representation_error'(user_input, 512),
|
||||
'$stream_representation_error'(user_output, 512),
|
||||
'$stream_representation_error'(user_error, 512),
|
||||
|
|
@ -84,7 +92,7 @@ true :- true.
|
|||
nb_setval('$lf_verbose',informational),
|
||||
nb_setval('$if_level',0),
|
||||
nb_setval('$endif',off),
|
||||
nb_setval('$consulting_file',user_input),
|
||||
nb_setval('$consulting_file',[]),
|
||||
nb_setval('$consulting',false),
|
||||
nb_setval('$included_file','').
|
||||
|
||||
|
|
@ -104,7 +112,7 @@ true :- true.
|
|||
'$read_vars'(Stream,T,Mod,Pos,V) :-
|
||||
'$read'(true,T,Mod,V,Pos,Err,Stream),
|
||||
(nonvar(Err) ->
|
||||
'$print_message'(error,Err), fail
|
||||
print_message(error,Err), fail
|
||||
;
|
||||
true
|
||||
).
|
||||
|
|
@ -135,7 +143,7 @@ true :- true.
|
|||
;
|
||||
true
|
||||
),
|
||||
'$print_message'(informational,prompt(BreakLevel,TraceDebug)),
|
||||
print_message(informational,prompt(BreakLevel,TraceDebug)),
|
||||
fail.
|
||||
'$enter_top_level' :-
|
||||
get_value('$top_level_goal',GA), GA \= [], !,
|
||||
|
|
@ -227,13 +235,13 @@ true :- true.
|
|||
|
||||
'$version' :-
|
||||
get_value('$version_name',VersionName),
|
||||
'$print_message'(help, version(VersionName)),
|
||||
print_message(help, version(VersionName)),
|
||||
get_value('$myddas_version_name',MYDDASVersionName),
|
||||
MYDDASVersionName \== [],
|
||||
'$print_message'(help, myddas_version(MYDDASVersionName)),
|
||||
print_message(help, myddas_version(MYDDASVersionName)),
|
||||
fail.
|
||||
'$version' :- recorded('$version',VersionName,_),
|
||||
'$print_message'(help, VersionName),
|
||||
print_message(help, VersionName),
|
||||
fail.
|
||||
'$version'.
|
||||
|
||||
|
|
@ -476,7 +484,7 @@ true :- true.
|
|||
'$add_env_and_fail' :- fail.
|
||||
|
||||
'$out_neg_answer' :-
|
||||
( '$undefined'('$print_message'(_,_),prolog) ->
|
||||
( '$undefined'(print_message(_,_),prolog) ->
|
||||
'$present_answer'(user_error,"no~n", [])
|
||||
;
|
||||
print_message(help,no)
|
||||
|
|
@ -530,7 +538,7 @@ true :- true.
|
|||
fail
|
||||
;
|
||||
C== 10 -> '$add_nl_outside_console',
|
||||
( '$undefined'('$print_message'(_,_),prolog) ->
|
||||
( '$undefined'(print_message(_,_),prolog) ->
|
||||
format(user_error,'yes~n', [])
|
||||
;
|
||||
print_message(help,yes)
|
||||
|
|
|
|||
|
|
@ -234,13 +234,16 @@ use_module(M,F,Is) :-
|
|||
StartMsg = consulting,
|
||||
EndMsg = consulted
|
||||
),
|
||||
'$print_message'(InfLevel, loading(StartMsg, File)),
|
||||
print_message(InfLevel, loading(StartMsg, File)),
|
||||
( SkipUnixComments == skip_unix_comments ->
|
||||
'$skip_unix_comments'(Stream)
|
||||
;
|
||||
true
|
||||
),
|
||||
'$loop'(Stream,Reconsult),
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
'$current_module'(Mod,OldModule),
|
||||
print_message(InfLevel, loaded(EndMsg, File, Mod, T, H)),
|
||||
'$end_consult',
|
||||
(
|
||||
Reconsult = reconsult ->
|
||||
|
|
@ -259,12 +262,9 @@ use_module(M,F,Is) :-
|
|||
nb_setval('$if_skip_mode',run),
|
||||
% back to include mode!
|
||||
nb_setval('$if_level',OldIncludeLevel),
|
||||
'$current_module'(Mod,OldModule),
|
||||
'$bind_module'(Mod, UseModule),
|
||||
'$import_to_current_module'(File, ContextModule, Imports),
|
||||
( LC == 0 -> prompt(_,' |: ') ; true),
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
'$print_message'(InfLevel, loaded(EndMsg, File, Mod, T, H)),
|
||||
( OldMode == off -> '$exit_system_mode' ; true ),
|
||||
'$exec_initialisation_goals',
|
||||
!.
|
||||
|
|
@ -346,13 +346,13 @@ use_module(M,F,Is) :-
|
|||
H0 is heapused, '$cputime'(T0,_),
|
||||
'$default_encoding'(Encoding),
|
||||
( '$open'(Y,'$csult',Stream,0,Encoding), !,
|
||||
'$print_message'(Verbosity, loading(including, Y)),
|
||||
print_message(Verbosity, loading(including, Y)),
|
||||
'$loop'(Stream,Status), '$close'(Stream)
|
||||
;
|
||||
'$do_error'(permission_error(input,stream,Y),include(X))
|
||||
),
|
||||
H is heapused-H0, '$cputime'(TF,_), T is TF-T0,
|
||||
'$print_message'(Verbosity, loaded(included, Y, Mod, T, H)),
|
||||
print_message(Verbosity, loaded(included, Y, Mod, T, H)),
|
||||
nb_setval('$included_file',OY).
|
||||
|
||||
'$do_startup_reconsult'(X) :-
|
||||
|
|
@ -470,7 +470,7 @@ remove_from_path(New) :- '$check_path'(New,Path),
|
|||
|
||||
'$add_multifile'(File,Name,Arity,Module) :-
|
||||
recorded('$multifile_defs','$defined'(File,Name,Arity,Module), _), !,
|
||||
'$print_message'(warning,declaration((multifile Module:Name/Arity),ignored)).
|
||||
print_message(warning,declaration((multifile Module:Name/Arity),ignored)).
|
||||
'$add_multifile'(File,Name,Arity,Module) :-
|
||||
recordz('$multifile_defs','$defined'(File,Name,Arity,Module),_), !,
|
||||
fail.
|
||||
|
|
@ -520,12 +520,6 @@ remove_from_path(New) :- '$check_path'(New,Path),
|
|||
fail.
|
||||
'$record_loaded'(_, _).
|
||||
|
||||
'$system_library_directories'(Dir) :-
|
||||
getenv('YAPSHAREDIR', Dir).
|
||||
'$system_library_directories'(Dir) :-
|
||||
get_value(system_library_directory,Dir).
|
||||
|
||||
|
||||
%
|
||||
% encoding stuff: what I believe SWI does.
|
||||
%
|
||||
|
|
@ -696,7 +690,7 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
|||
'$find_in_path'(library(File),Opts,NewFile, Call) :- !,
|
||||
'$dir_separator'(D),
|
||||
atom_codes(A,[D]),
|
||||
'$extend_path_directory'(Name, A, File, Opts, NewFile, Call).
|
||||
'$extend_path_directory'(library, A, File, Opts, NewFile, Call).
|
||||
'$find_in_path'(S, Opts, NewFile, Call) :-
|
||||
S =.. [Name,File], !,
|
||||
'$dir_separator'(D),
|
||||
|
|
@ -755,11 +749,16 @@ absolute_file_name(File,Opts,TrueFileName) :-
|
|||
recorded('$path',Path,_),
|
||||
atom_concat([Path,File],PFile).
|
||||
|
||||
'$system_library_directories'(Dir) :-
|
||||
getenv('YAPSHAREDIR', Dir).
|
||||
'$system_library_directories'(Dir) :-
|
||||
get_value(system_library_directory,Dir).
|
||||
|
||||
|
||||
'$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :-
|
||||
user:file_search_path(Name, Dir),
|
||||
'$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
|
||||
|
||||
|
||||
'$extend_pathd'(Dir, A, File, Opts, NewFile, Call) :-
|
||||
atom(Dir), !,
|
||||
atom_concat([Dir,A,File],NFile),
|
||||
|
|
|
|||
42
pl/debug.yap
42
pl/debug.yap
|
|
@ -57,9 +57,9 @@
|
|||
!,
|
||||
'$do_suspy_predicates_by_name'(NA,S,EM).
|
||||
'$suspy_predicates_by_name'(A,spy,M) :- !,
|
||||
'$print_message'(warning,no_match(spy(M:A))).
|
||||
print_message(warning,no_match(spy(M:A))).
|
||||
'$suspy_predicates_by_name'(A,nospy,M) :-
|
||||
'$print_message'(warning,no_match(nospy(M:A))).
|
||||
print_message(warning,no_match(nospy(M:A))).
|
||||
|
||||
'$do_suspy_predicates_by_name'(A,S,M) :-
|
||||
current_predicate(A,M:T),
|
||||
|
|
@ -81,9 +81,9 @@
|
|||
'$do_suspy'(S, F, N, T, M) :-
|
||||
'$undefined'(T,M), !,
|
||||
( S = spy ->
|
||||
'$print_message'(warning,no_match(spy(M:F/N)))
|
||||
print_message(warning,no_match(spy(M:F/N)))
|
||||
;
|
||||
'$print_message'(warning,no_match(nospy(M:F/N)))
|
||||
print_message(warning,no_match(nospy(M:F/N)))
|
||||
).
|
||||
'$do_suspy'(S, F, N, T, M) :-
|
||||
'$system_predicate'(T,M),
|
||||
|
|
@ -97,27 +97,27 @@
|
|||
'$do_suspy'(S, F, N, T, M) :-
|
||||
'$undefined'(T,M), !,
|
||||
( S = spy ->
|
||||
'$print_message'(warning,no_match(spy(M:F/N)))
|
||||
print_message(warning,no_match(spy(M:F/N)))
|
||||
;
|
||||
'$print_message'(warning,no_match(nospy(M:F/N)))
|
||||
print_message(warning,no_match(nospy(M:F/N)))
|
||||
).
|
||||
'$do_suspy'(S,F,N,T,M) :-
|
||||
'$suspy2'(S,F,N,T,M).
|
||||
|
||||
'$suspy2'(spy,F,N,T,M) :-
|
||||
recorded('$spy','$spy'(T,M),_), !,
|
||||
'$print_message'(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
|
||||
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
|
||||
'$suspy2'(spy,F,N,T,M) :- !,
|
||||
recorda('$spy','$spy'(T,M),_),
|
||||
'$set_spy'(T,M),
|
||||
'$print_message'(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
|
||||
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
|
||||
'$suspy2'(nospy,F,N,T,M) :-
|
||||
recorded('$spy','$spy'(T,M),R), !,
|
||||
erase(R),
|
||||
'$rm_spy'(T,M),
|
||||
'$print_message'(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)).
|
||||
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)).
|
||||
'$suspy2'(nospy,F,N,_,M) :-
|
||||
'$print_message'(informational,breakp(no,breakpoint_for,M:F/N)).
|
||||
print_message(informational,breakp(no,breakpoint_for,M:F/N)).
|
||||
|
||||
'$pred_being_spied'(G, M) :-
|
||||
recorded('$spy','$spy'(G,M),_), !.
|
||||
|
|
@ -140,7 +140,7 @@ nospyall.
|
|||
|
||||
debug :-
|
||||
'$start_debugging'(on),
|
||||
'$print_message'(informational,debug(debug)).
|
||||
print_message(informational,debug(debug)).
|
||||
|
||||
'$start_debugging'(Mode) :-
|
||||
nb_setval('$debug',Mode),
|
||||
|
|
@ -149,7 +149,7 @@ debug :-
|
|||
nodebug :-
|
||||
nb_setval('$debug',off),
|
||||
nb_setval('$trace',off),
|
||||
'$print_message'(informational,debug(off)).
|
||||
print_message(informational,debug(off)).
|
||||
|
||||
%
|
||||
% remove any debugging info after an abort.
|
||||
|
|
@ -160,7 +160,7 @@ trace :-
|
|||
trace :-
|
||||
nb_setval('$trace',on),
|
||||
'$start_debugging'(on),
|
||||
'$print_message'(informational,debug(trace)),
|
||||
print_message(informational,debug(trace)),
|
||||
'$creep'.
|
||||
|
||||
notrace :-
|
||||
|
|
@ -183,13 +183,13 @@ leash(X) :-
|
|||
'$do_error'(type_error(leash_mode,X),leash(X)).
|
||||
|
||||
'$show_leash'(Msg,0) :-
|
||||
'$print_message'(Msg,leash([])).
|
||||
print_message(Msg,leash([])).
|
||||
'$show_leash'(Msg,Code) :-
|
||||
'$check_leash_bit'(Code,0x8,L3,call,LF),
|
||||
'$check_leash_bit'(Code,0x4,L2,exit,L3),
|
||||
'$check_leash_bit'(Code,0x2,L1,redo,L2),
|
||||
'$check_leash_bit'(Code,0x1,[],fail,L1),
|
||||
'$print_message'(Msg,leash(LF)).
|
||||
print_message(Msg,leash(LF)).
|
||||
|
||||
'$check_leash_bit'(Code,Bit,L0,_,L0) :- Bit /\ Code =:= 0, !.
|
||||
'$check_leash_bit'(_,_,L0,Name,[Name|L0]).
|
||||
|
|
@ -224,12 +224,12 @@ leash(X) :-
|
|||
|
||||
debugging :-
|
||||
( nb_getval('$debug',on) ->
|
||||
'$print_message'(help,debug(debug))
|
||||
print_message(help,debug(debug))
|
||||
;
|
||||
'$print_message'(help,debug(off))
|
||||
print_message(help,debug(off))
|
||||
),
|
||||
findall(M:(N/A),(recorded('$spy','$spy'(T,M),_),functor(T,N,A)),L),
|
||||
'$print_message'(help,breakpoints(L)),
|
||||
print_message(help,breakpoints(L)),
|
||||
get_value('$leash',Leash),
|
||||
'$show_leash'(help,Leash).
|
||||
|
||||
|
|
@ -667,7 +667,7 @@ debugging :-
|
|||
(
|
||||
History == []
|
||||
->
|
||||
'$print_message'(help, ancestors([]))
|
||||
print_message(help, ancestors([]))
|
||||
;
|
||||
'$show_ancestors'(History,HowMany),
|
||||
nl(user_error)
|
||||
|
|
@ -708,8 +708,8 @@ debugging :-
|
|||
format(user_error,'! g execute goal~n', []).
|
||||
|
||||
'$ilgl'(C) :-
|
||||
'$print_message'(warning, trace_command(C)),
|
||||
'$print_message'(help, trace_help),
|
||||
print_message(warning, trace_command(C)),
|
||||
print_message(help, trace_help),
|
||||
fail.
|
||||
|
||||
'$skipeol'(10) :- !.
|
||||
|
|
|
|||
798
pl/errors.yap
798
pl/errors.yap
|
|
@ -11,8 +11,12 @@
|
|||
* File: errors.yap *
|
||||
* comments: error messages for YAP *
|
||||
* *
|
||||
* Last rev: $Date: 2008-01-23 17:57:55 $,$Author: vsc $ *
|
||||
* Last rev: $Date: 2008-02-22 15:08:37 $,$Author: vsc $ *
|
||||
* $Log: not supported by cvs2svn $
|
||||
* Revision 1.84 2008/01/23 17:57:55 vsc
|
||||
* valgrind it!
|
||||
* enable atom garbage collection.
|
||||
*
|
||||
* Revision 1.83 2007/11/26 23:43:10 vsc
|
||||
* fixes to support threads and assert correctly, even if inefficiently.
|
||||
*
|
||||
|
|
@ -172,8 +176,8 @@
|
|||
*************************************************************************/
|
||||
|
||||
'$do_error'(Type,Message) :-
|
||||
'$current_stack'(local_sp(_,Envs,CPs)),
|
||||
throw(error(Type,[Message|local_sp(Message,Envs,CPs)])).
|
||||
'$current_stack'(local_sp(_,CP,Envs,CPs)),
|
||||
throw(error(Type,[Message|local_sp(Message,CP,Envs,CPs)])).
|
||||
|
||||
'$Error'(E) :-
|
||||
'$LoopError'(E,top).
|
||||
|
|
@ -195,741 +199,75 @@
|
|||
throw('$abort').
|
||||
'$process_error'(error(Msg, Where), _) :- !,
|
||||
'$set_fpu_exceptions',
|
||||
'$print_message'(error,error(Msg, Where)).
|
||||
print_message(error,error(Msg, Where)).
|
||||
'$process_error'(Throw, _) :-
|
||||
print_message(error,Throw).
|
||||
|
||||
print_message(Level, Mss) :-
|
||||
'$print_message'(Level, Mss).
|
||||
|
||||
'$print_message'(force(_Severity), Msg) :- !,
|
||||
print_message(force(_Severity), Msg) :- !,
|
||||
print(user_error,Msg).
|
||||
'$print_message'(Severity, Msg) :-
|
||||
print_message(error, error(Msg,[Info|local_sp(P,CP,Envs,CPs)])) :- !,
|
||||
nb_setval(sp_info,local_sp(P,CP,Envs,CPs)),
|
||||
print_message(error, error(Msg, Info)),
|
||||
nb_setval(sp_info,[]).
|
||||
print_message(Severity, Msg) :-
|
||||
nonvar(Severity), nonvar(Msg),
|
||||
\+ '$undefined'(portray_message(Severity, Msg), user),
|
||||
user:portray_message(Severity, Msg), !.
|
||||
'$print_message'(error,error(Msg,Info)) :-
|
||||
( var(Msg) ; var(Info) ), !,
|
||||
format(user_error,'% YAP: no handler for error ~w~n', [error(Msg,Info)]).
|
||||
'$print_message'(error,error(syntax_error(A,B,C,D,E,F),_)) :- !,
|
||||
'$output_error_message'(syntax_error(A,B,C,D,E,F), 'SYNTAX ERROR').
|
||||
'$print_message'(error,error(Msg,[Info|local_sp(Where,Envs,CPs)])) :-
|
||||
'$output_error_location'('\% ERROR:'),
|
||||
'$prepare_loc'(Info,Where,Location),
|
||||
'$output_error_message'(Msg, Location), !,
|
||||
'$do_stack_dump'(Envs, CPs).
|
||||
% old format: don't want a stack dump.
|
||||
'$print_message'(error,error(Type,Where)) :-
|
||||
'$output_error_message'(Type, Where), !.
|
||||
'$print_message'(error,Throw) :-
|
||||
format(user_error,'% YAP: no handler for error ~w~n', [Throw]).
|
||||
'$print_message'(informational,_) :-
|
||||
get_value('$verbose',off), !.
|
||||
'$print_message'(informational,M) :-
|
||||
'$do_informational_message'(M).
|
||||
'$print_message'(warning,M) :-
|
||||
'$output_error_location'('!! WARNING:'),
|
||||
format(user_error, '!! ', []),
|
||||
'$do_print_message'(M),
|
||||
format(user_error, '~n', []).
|
||||
'$print_message'(silent,_).
|
||||
'$print_message'(help,M) :-
|
||||
'$do_print_message'(M),
|
||||
format(user_error, '~n', []).
|
||||
|
||||
'$output_error_location'(MsgCodes) :-
|
||||
nb_getval('$consulting_file',FileName),
|
||||
FileName \= [], !,
|
||||
'$start_line'(LN),
|
||||
'$show_consult_level'(LC),
|
||||
'$output_file_pos'(FileName,LN,LC,MsgCodes),
|
||||
format(user_error, '~*|', [LC]).
|
||||
'$output_error_location'(_).
|
||||
|
||||
'$output_file_pos'(user_input,LN,LC,MsgCodes) :- !,
|
||||
format(user_error,'~*|~a at user_input near line ~d,~n',[LC,MsgCodes,LN]).
|
||||
'$output_file_pos'(FileName,LN,LC,MsgCodes) :-
|
||||
format(user_error,'~*|~a at file ~a, near line ~d,~n',[LC,MsgCodes,FileName,LN]).
|
||||
|
||||
'$do_informational_message'(halt) :- !,
|
||||
format(user_error, '% YAP execution halted~n', []).
|
||||
'$do_informational_message'('$abort') :- !,
|
||||
format(user_error, '% YAP execution aborted~n', []).
|
||||
'$do_informational_message'(loading(_,user)) :- !.
|
||||
'$do_informational_message'(loading(What,AbsoluteFileName)) :- !,
|
||||
'$show_consult_level'(LC),
|
||||
format(user_error, '~*|% ~a ~a...~n', [LC, What, AbsoluteFileName]).
|
||||
'$do_informational_message'(loaded(_,user,_,_,_)) :- !.
|
||||
'$do_informational_message'(loaded(included,AbsoluteFileName,Mod,Time,Space)) :- !,
|
||||
'$show_consult_level'(LC),
|
||||
format(user_error, '~*|% ~a included in module ~a, ~d msec ~d bytes~n', [LC, AbsoluteFileName,Mod,Time,Space]).
|
||||
'$do_informational_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !,
|
||||
'$show_consult_level'(LC0),
|
||||
LC is LC0+1,
|
||||
format(user_error, '~*|% ~a ~a in module ~a, ~d msec ~d bytes~n', [LC, What, AbsoluteFileName,Mod,Time,Space]).
|
||||
'$do_informational_message'(prompt(BreakLevel,TraceDebug)) :- !,
|
||||
(BreakLevel =:= 0 ->
|
||||
(
|
||||
var(TraceDebug) ->
|
||||
true
|
||||
;
|
||||
format(user_error, '% ~a~n', [TraceDebug])
|
||||
)
|
||||
;
|
||||
(
|
||||
var(TraceDebug) ->
|
||||
format(user_error, '% ~d~n', [BreakLevel])
|
||||
;
|
||||
format(user_error, '% ~d,~a~n', [BreakLevel,TraceDebug])
|
||||
'$notrace'(user:portray_message(Severity, Msg)), !.
|
||||
% This predicate has more hooks than a pirate ship!
|
||||
print_message(Severity, Term) :-
|
||||
(
|
||||
(
|
||||
'$notrace'(user:generate_message_hook(Term, [], Lines)) ->
|
||||
true
|
||||
;
|
||||
'$notrace'(prolog:message(Term, Lines, [])) ->
|
||||
true
|
||||
;
|
||||
'$message':generate_message(Term, Lines, [])
|
||||
)
|
||||
-> ( nonvar(Term),
|
||||
'$notrace'(user:message_hook(Term, Severity, Lines))
|
||||
-> !
|
||||
; !, '$print_system_message'(Term, Severity, Lines)
|
||||
)
|
||||
).
|
||||
'$do_informational_message'(debug) :- !,
|
||||
format(user_error, '% [debug]~n', []).
|
||||
'$do_informational_message'(trace) :- !,
|
||||
format(user_error, '% [trace]~n', []).
|
||||
'$do_informational_message'(M) :-
|
||||
format(user_error,'% ', []),
|
||||
'$do_print_message'(M),
|
||||
format(user_error,'~n', []).
|
||||
print_message(_, error(syntax_error(_,between(_,L,_),_,_,_,_),_)) :- !,
|
||||
format(user_error,'SYNTAX ERROR close to ~d~n',[L]).
|
||||
print_message(_, loading(A, F)) :- !,
|
||||
format(user_error,' % ~a ~a~n',[A,F]).
|
||||
print_message(_, loaded(A, F, _, Time, Space)) :- !,
|
||||
format(user_error,' % ~a ~a ~d bytes in ~d msecs~n',[F,A,Space,Time]).
|
||||
print_message(_, Term) :-
|
||||
format(user_error,'~q~n',[Term]).
|
||||
|
||||
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
|
||||
'$do_print_message'(format(Msg, Args)) :- !,
|
||||
format(user_error,Msg,Args).
|
||||
'$do_print_message'(ancestors([])) :- !,
|
||||
format(user_error,'There are no ancestors.',
|
||||
[]).
|
||||
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,already)) :- !,
|
||||
format(user_error,'There is already a spy point on ~w:~w/~w.',
|
||||
[M,F,N]).
|
||||
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),add,ok)) :- !,
|
||||
format(user_error,'Spy point set on ~w:~w/~w.',
|
||||
[M,F,N]).
|
||||
'$do_print_message'(breakp(bp(debugger,_,_,M:F/N,_),remove,last)) :- !,
|
||||
format(user_error,'Spy point on ~w:~w/~w removed.',
|
||||
[M,F,N]).
|
||||
'$do_print_message'(breakp(no,breakpoint_for,M:F/N)) :- !,
|
||||
format(user_error,'There is no spy point on ~w:~w/~w.',
|
||||
[M,F,N]).
|
||||
'$do_print_message'(breakpoints([])) :- !,
|
||||
format(user_error,'There are no spy-points set.',
|
||||
[]).
|
||||
'$do_print_message'(breakpoints(L)) :- !,
|
||||
format(user_error,'Spy-points set on:', []),
|
||||
'$print_list_of_preds'(L).
|
||||
'$do_print_message'(clauses_not_together(P)) :- !,
|
||||
format(user_error, 'Discontiguous definition of ~q.',[P]).
|
||||
'$do_print_message'(debug(debug)) :- !,
|
||||
format(user_error,'Debug mode on.',[]).
|
||||
'$do_print_message'(debug(off)) :- !,
|
||||
format(user_error,'Debug mode off.',[]).
|
||||
'$do_print_message'(debug(trace)) :- !,
|
||||
format(user_error,'Trace mode on.',[]).
|
||||
'$do_print_message'(declaration(Args,Action)) :- !,
|
||||
format(user_error,'declaration ~w ~w.', [Args,Action]).
|
||||
'$do_print_message'(defined_elsewhere(P,F)) :- !,
|
||||
format(user_error, 'predicate ~q previously defined in file ~w',[P,F]).
|
||||
'$do_print_message'(import(Pred,To,From,private)) :- !,
|
||||
format(user_error,'Importing private predicate ~w:~w to ~w.',
|
||||
[From,Pred,To]).
|
||||
'$do_print_message'(leash([])) :- !,
|
||||
format(user_error,'No leashing.',
|
||||
[]).
|
||||
'$do_print_message'(leash([A|B])) :- !,
|
||||
format(user_error,'Leashing set to ~w.',
|
||||
[[A|B]]).
|
||||
'$do_print_message'(no) :- !,
|
||||
format(user_error, 'no', []).
|
||||
'$do_print_message'(no_match(P)) :- !,
|
||||
format(user_error,'No matching predicate for ~w.',
|
||||
[P]).
|
||||
'$do_print_message'(leash([A|B])) :- !,
|
||||
format(user_error,'Leashing set to ~w.',
|
||||
[[A|B]]).
|
||||
'$do_print_message'(singletons(SVs,P,CLN)) :- !,
|
||||
format(user_error, 'Singleton variable',[]),
|
||||
'$write_svs'(SVs),
|
||||
format(user_error, ' in ~q, clause ~d.',[P,CLN]).
|
||||
'$do_print_message'(trace_command(-1)) :- !,
|
||||
format(user_error,'EOF is not a valid debugger command.', []).
|
||||
'$do_print_message'(trace_command(C)) :- !,
|
||||
format(user_error,'~c is not a valid debugger command.', [C]).
|
||||
'$do_print_message'(trace_help) :- !,
|
||||
format(user_error,' Please enter a valid debugger command (h for help).', []).
|
||||
'$do_print_message'(version(Version)) :- !,
|
||||
format(user_error,'YAP version ~a', [Version]).
|
||||
'$do_print_message'(myddas_version(Version)) :- !,
|
||||
format(user_error,'MYDDAS version ~a', [Version]).
|
||||
'$do_print_message'(yes) :- !,
|
||||
format(user_error, 'yes', []).
|
||||
'$do_print_message'(Messg) :-
|
||||
format(user_error,'~q',Messg).
|
||||
% print_system_message(+Term, +Level, +Lines)
|
||||
%
|
||||
% Print the message if the user did not intecept the message.
|
||||
% The first is used for errors and warnings that can be related
|
||||
% to source-location. Note that syntax errors have their own
|
||||
% source-location and should therefore not be handled this way.
|
||||
|
||||
'$write_svs'([H]) :- !, write(user_error,' '), '$write_svs1'([H]).
|
||||
'$write_svs'(SVs) :- write(user_error,'s '), '$write_svs1'(SVs).
|
||||
|
||||
'$write_svs1'([H]) :- !,
|
||||
'$write_str_in_stderr'(H).
|
||||
'$write_svs1'([H|T]) :-
|
||||
'$write_str_in_stderr'(H),
|
||||
write(user_error,','),
|
||||
'$write_svs1'(T).
|
||||
|
||||
'$write_str_in_stderr'([]).
|
||||
'$write_str_in_stderr'([C|T]) :-
|
||||
put(user_error,C),
|
||||
'$write_str_in_stderr'(T).
|
||||
'$print_system_message'(_, silent, _) :- !.
|
||||
'$print_system_message'(_, informational, _) :-
|
||||
current_prolog_flag(verbose, silent), !.
|
||||
'$print_system_message'(_, banner, _) :-
|
||||
current_prolog_flag(verbose, silent), !.
|
||||
'$print_system_message'(Term, Level, Lines) :-
|
||||
Term = error(syntax_error(_,_,_,_,_,_),_), !,
|
||||
flush_output(user_output),
|
||||
flush_output(user_error),
|
||||
'$message':prefix(Level, LinePrefix, Stream, _, Lines), !,
|
||||
% make sure we don't give a PC.
|
||||
print_message_lines(Stream, LinePrefix, Lines).
|
||||
'$print_system_message'(Term, Level, Lines) :-
|
||||
'$message':prefix(Level, Prefix, EndPrefix, Stream, LinePrefix, Lines),
|
||||
'$message':file_location(Prefix, LinesF, Lines), !,
|
||||
flush_output(user_output),
|
||||
flush_output(user_error),
|
||||
print_message_lines(Stream, LinePrefix, LinesF).
|
||||
'$print_system_message'(Error, Level, Lines) :-
|
||||
flush_output(user_output),
|
||||
flush_output(user_error),
|
||||
'$message':prefix(Level, LinePrefix, Stream, LinesF, Lines), !,
|
||||
print_message_lines(Stream, LinePrefix, LinesF).
|
||||
|
||||
|
||||
'$print_list_of_preds'([]).
|
||||
'$print_list_of_preds'([P|L]) :-
|
||||
format(user_error,'~n ~w',[P]),
|
||||
'$print_list_of_preds'(L).
|
||||
|
||||
'$do_stack_dump'(Envs, CPs) :-
|
||||
'$preprocess_stack'(CPs,0, PCPs),
|
||||
'$preprocess_stack'(Envs,0, PEnvs),
|
||||
'$say_stack_dump'(PEnvs, PCPs),
|
||||
'$show_cps'(PCPs),
|
||||
'$show_envs'(PEnvs),
|
||||
'$close_stack_dump'(PEnvs, PCPs).
|
||||
|
||||
'$preprocess_stack'([], _, []).
|
||||
'$preprocess_stack'([_|_],40, [overflow]) :- !.
|
||||
'$preprocess_stack'([G|Gs],I, NGs) :-
|
||||
'$pred_for_code'(G,Name,Arity,Mod,Clause),
|
||||
I1 is I+1,
|
||||
'$beautify_stack_goal'(Name,Arity,Mod,Clause,Gs,I1,NGs).
|
||||
|
||||
'$beautify_stack_goal'(_,_,_,0,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs,I,NGs).
|
||||
'$beautify_stack_goal'(Name,Arity,Module,Clause,Gs,I,NGs) :-
|
||||
functor(G,Name,Arity),
|
||||
'$hidden_predicate'(G,Module), !,
|
||||
'$beautify_hidden_goal'(Name,Arity,Module,Clause,Gs,I,NGs).
|
||||
'$beautify_stack_goal'(Name,Arity,Module,Clause,Gs,I,[cl(Name,Arity,Module,Clause)|NGs]) :-
|
||||
'$preprocess_stack'(Gs,I,NGs).
|
||||
|
||||
|
||||
'$beautify_hidden_goal'('$yes_no',_,_,_,_,_,[]) :- !.
|
||||
'$beautify_hidden_goal'('$do_yes_no',_,_,_,_,_,[]) :- !.
|
||||
'$beautify_hidden_goal'('$query',_,_,_,_,_,[]) :- !.
|
||||
'$beautify_hidden_goal'('$enter_top_level',_,_,_,_,_,[]) :- !.
|
||||
% The user should never know these exist.
|
||||
'$beautify_hidden_goal'('$csult',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$use_module',2,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$ensure_loaded',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$continue_with_command',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$spycall_stdpred',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$spycalls',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$spycall',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$do_spy',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$spy',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$do_creep_execute',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$creep_execute',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$direct_spy',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$system_catch',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$execute_command',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$process_directive',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$catch',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$loop',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$consult',3,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$reconsult',_,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$undefp',1,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$use_module',2,prolog,_,Gs,I,NGs) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$repeat',0,prolog,ClNo,Gs,I,[cl(repeat,0,prolog,ClNo)|NGs]) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$recorded_with_key',3,prolog,ClNo,Gs,I,[cl(recorded,3,prolog,ClNo)|NGs]) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$consult',3,prolog,ClNo,Gs,I,[cl(consult,1,prolog,ClNo)|NGs]) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$findall_with_common_vars',_,prolog,ClNo,Gs,I,[cl(findall,4,prolog,ClNo)|NGs]) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$findall',_,prolog,ClNo,Gs,I,[cl(findall,4,prolog,ClNo)|NGs]) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$bagof',_,prolog,ClNo,Gs,I,[cl(bagof,3,prolog,ClNo)|NGs]) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$listing',_,prolog,ClNo,Gs,I,[cl(listing,1,prolog,ClNo)|NGs]) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$call',Args,prolog,ClNo,Gs,I,[cl(call,Args,prolog,ClNo)|NGs]) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$current_predicate',Args,prolog,ClNo,Gs,I,[cl(current_predicate,Args,prolog,ClNo)|NGs]) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$list_clauses',_,prolog,ClNo,Gs,I,[cl(listing,1,prolog,ClNo)|NGs]) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'('$use_module',1,prolog,ClNo,Gs,I,[cl(use_module,1,prolog,ClNo)|NGs]) :- !,
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
'$beautify_hidden_goal'(Name,Args,Mod,ClNo,Gs,I,[cl(Name,Args,Mod,ClNo)|NGs]) :-
|
||||
'$preprocess_stack'(Gs, I, NGs).
|
||||
|
||||
|
||||
'$say_stack_dump'([], []) :- !.
|
||||
'$say_stack_dump'(_, _) :-
|
||||
format(user_error,'% Stack dump for error:', []).
|
||||
|
||||
'$close_stack_dump'([], []) :- !.
|
||||
'$close_stack_dump'(_, _) :-
|
||||
format(user_error,'~n', []).
|
||||
|
||||
'$show_cps'([]) :- !.
|
||||
'$show_cps'(List) :-
|
||||
format(user_error,'% ~n choice-points (goals with alternatives left):',[]),
|
||||
'$print_stack'(List).
|
||||
|
||||
'$show_envs'([]) :- !.
|
||||
'$show_envs'(List) :-
|
||||
format(user_error,'% ~n environments (partially executed clauses):',[]),
|
||||
'$print_stack'(List).
|
||||
|
||||
'$prepare_loc'(Info,Where,Location) :- integer(Where), !,
|
||||
'$pred_for_code'(Where,Name,Arity,Mod,Clause),
|
||||
'$construct_code'(Clause,Name,Arity,Mod,Info,Location).
|
||||
'$prepare_loc'(Info,_,Info).
|
||||
|
||||
'$print_stack'([]).
|
||||
'$print_stack'([overflow]) :- !,
|
||||
format(user_error,'~n% ...',[]).
|
||||
'$print_stack'([cl(Name,Arity,Mod,Clause)|List]) :-
|
||||
'$show_goal'(Clause,Name,Arity,Mod),
|
||||
'$print_stack'(List).
|
||||
|
||||
'$show_goal'(-1,Name,Arity,Mod) :- !,
|
||||
format('~n% ~a:~a/~d at indexing code',[Mod,Name,Arity]).
|
||||
'$show_goal'(0,_,_,_) :- !.
|
||||
'$show_goal'(I,Name,Arity,Mod) :-
|
||||
format(user_error,'~n% ~a:~a/~d at clause ~d',[Mod,Name,Arity,I]).
|
||||
|
||||
'$construct_code'(-1,Name,Arity,Mod,Where,Location) :- !,
|
||||
number_codes(Arity,ArityCode),
|
||||
atom_codes(ArityAtom,ArityCode),
|
||||
atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' at indexing code'],Location).
|
||||
'$construct_code'(0,_,_,_,Location,Location) :- !.
|
||||
'$construct_code'(Cl,Name,Arity,Mod,Where,Location) :-
|
||||
number_codes(Arity,ArityCode),
|
||||
atom_codes(ArityAtom,ArityCode),
|
||||
number_codes(Cl,ClCode),
|
||||
atom_codes(ClAtom,ClCode),
|
||||
atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location).
|
||||
|
||||
'$output_error_message'(consistency_error(Who),Where) :-
|
||||
format(user_error,'% CONSISTENCY ERROR- ~w ~w~n',
|
||||
[Who,Where]).
|
||||
'$output_error_message'(context_error(Goal,Who),Where) :-
|
||||
format(user_error,'% CONTEXT ERROR- ~w: ~w appeared in ~w~n',
|
||||
[Goal,Who,Where]).
|
||||
'$output_error_message'(domain_error(array_overflow,Opt), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid index ~w for array~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(array_type,Opt), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid static array type ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(builtin_procedure,P), P) :-
|
||||
format(user_error,'% DOMAIN ERROR- non-iso built-in procedure ~w~n',
|
||||
[P]).
|
||||
'$output_error_message'(domain_error(character_code_list,Opt), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid list of codes ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(delete_file_option,Opt), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid list of options ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(encoding,Opt), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid encoding ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(operator_specifier,Op), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid operator specifier ~w~n',
|
||||
[Where,Op]).
|
||||
'$output_error_message'(domain_error(out_of_range,Value), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: expression ~w is out of range~n',
|
||||
[Where,Value]).
|
||||
'$output_error_message'(domain_error(close_option,Opt), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid close option ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(radix,Opt), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid radix ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(shift_count_overflow,Opt), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: shift count overflow in ~w~n',
|
||||
[Where,Opt]).
|
||||
'$output_error_message'(domain_error(flag_value,F+V), W) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid value ~w for flag ~w~n',
|
||||
[W,V,F]).
|
||||
'$output_error_message'(domain_error(io_mode,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid io mode ~w~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(mutable,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: invalid mutable ~w~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(module_decl_options,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: expect module declaration options, found ~w~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(not_empty_list,_), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: found empty list~n',
|
||||
[Where]).
|
||||
'$output_error_message'(domain_error(not_less_than_zero,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: number ~w less than zero~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(not_newline,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: number ~w not newline~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(not_zero,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w is not allowed in the domain ~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(operator_priority,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid operator priority~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(operator_specifier,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid operator specifier~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(predicate_spec,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid predicate specifier~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(read_option,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to read~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(semantics_indicator,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected predicate indicator, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(domain_error(source_sink,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w is not a source sink term~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(stream,What), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(stream_or_alias,What), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(stream_option,What), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream option~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(stream_position,What), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream position~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(stream_property,What), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a stream property~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(syntax_error_handler,What), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a syntax error handler~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(thread_create_option,Option+Opts), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not in ~w~n',
|
||||
[Where,Option, Opts]).
|
||||
'$output_error_message'(domain_error(time_out_spec,What), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not a valid specification for a time out~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(unimplemented_option,What), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w not yet implemented~n',
|
||||
[Where,What]).
|
||||
'$output_error_message'(domain_error(write_option,N), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: ~w invalid option to write~n',
|
||||
[Where,N]).
|
||||
'$output_error_message'(domain_error(table,P), Where) :-
|
||||
format(user_error,'% DOMAIN ERROR- ~w: non-tabled procedure ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(existence_error(array,F), W) :-
|
||||
format(user_error,'% EXISTENCE ERROR- ~w could not open array ~w~n',
|
||||
[W,F]).
|
||||
'$output_error_message'(existence_error(file,F), W) :-
|
||||
format(user_error,'% EXISTENCE ERROR- ~w could not open file ~w~n',
|
||||
[W,F]).
|
||||
'$output_error_message'(existence_error(library,F), W) :-
|
||||
format(user_error,'% EXISTENCE ERROR- ~w could not open library ~w~n',
|
||||
[W,F]).
|
||||
'$output_error_message'(existence_error(message_queue,F), W) :-
|
||||
format(user_error,'% EXISTENCE ERROR- ~w could not open message queue ~w~n',
|
||||
[W,F]).
|
||||
'$output_error_message'(existence_error(mutex,F), W) :-
|
||||
format(user_error,'% EXISTENCE ERROR- ~w could not open mutex ~w~n',
|
||||
[W,F]).
|
||||
'$output_error_message'(existence_error(procedure,P), context(Call,Parent)) :-
|
||||
format(user_error,'% EXISTENCE ERROR- procedure ~w is undefined, called from context ~w~n% Goal was ~w~n',
|
||||
[P,Parent,Call]).
|
||||
'$output_error_message'(existence_error(source_sink,F), W) :-
|
||||
format(user_error,'% EXISTENCE ERROR- ~w could not find file ~w~n',
|
||||
[W,F]).
|
||||
'$output_error_message'(existence_error(stream,Stream), Where) :-
|
||||
format(user_error,'% EXISTENCE ERROR- ~w: ~w not an open stream~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(existence_error(thread,Thread), Where) :-
|
||||
format(user_error,'% EXISTENCE ERROR- ~w: ~w not a running thread~n',
|
||||
[Where,Thread]).
|
||||
'$output_error_message'(evaluation_error(int_overflow), Where) :-
|
||||
format(user_error,'% INTEGER OVERFLOW ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(evaluation_error(float_overflow), Where) :-
|
||||
format(user_error,'% FLOATING POINT OVERFLOW ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(evaluation_error(undefined), Where) :-
|
||||
format(user_error,'% UNDEFINED ARITHMETIC RESULT ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(evaluation_error(underflow), Where) :-
|
||||
format(user_error,'% UNDERFLOW ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(evaluation_error(float_underflow), Where) :-
|
||||
format(user_error,'% FLOATING POINT UNDERFLOW ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(evaluation_error(zero_divisor), Where) :-
|
||||
format(user_error,'% ZERO DIVISOR ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(instantiation_error, Where) :-
|
||||
format(user_error,'% INSTANTIATION ERROR- ~w: expected bound value~n',
|
||||
[Where]).
|
||||
'$output_error_message'(operating_system_error, Where) :-
|
||||
format(user_error,'% OPERATING SYSTEM ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(out_of_heap_error, Where) :-
|
||||
format(user_error,'% OUT OF DATABASE SPACE ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(out_of_stack_error, Where) :-
|
||||
format(user_error,'% OUT OF STACK SPACE ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(out_of_trail_error, Where) :-
|
||||
format(user_error,'% OUT OF TRAIL SPACE ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(out_of_attvars_error, Where) :-
|
||||
format(user_error,'% OUT OF STACK SPACE ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(out_of_auxspace_error, Where) :-
|
||||
format(user_error,'% OUT OF AUXILIARY STACK SPACE ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(permission_error(access,private_procedure,P), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot see clauses for ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(access,static_procedure,P), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot access static procedure ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(alias,new,P), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot create alias ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(create,array,P), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot create array ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(create,mutex,P), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot create mutex ~a~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(create,message_queue,P), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot create message queue ~a~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(create,operator,P), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot create operator ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(input,binary_stream,Stream), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot read from binary stream ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(input,closed_stream,Stream), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: trying to read from closed stream ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(input,past_end_of_stream,Stream), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: past end of stream ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(input,stream,Stream), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot read from ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(input,text_stream,Stream), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot read from text stream ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: modifying a dynamic procedure~n',
|
||||
[Where]).
|
||||
'$output_error_message'(permission_error(modify,flag,W), _) :-
|
||||
format(user_error,'% PERMISSION ERROR- cannot modify flag ~w~n',
|
||||
[W]).
|
||||
'$output_error_message'(permission_error(modify,operator,W), _) :-
|
||||
format(user_error,'% PERMISSION ERROR- T cannot declare ~w an operator~n',
|
||||
[W]).
|
||||
'$output_error_message'(permission_error(modify,dynamic_procedure,_), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: modifying a dynamic procedure~n',
|
||||
[Where]).
|
||||
'$output_error_message'(permission_error(modify,static_procedure,_), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure~n',
|
||||
[Where]).
|
||||
'$output_error_message'(permission_error(modify,static_procedure_in_use,_), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: modifying a static procedure in use~n',
|
||||
[Where]).
|
||||
'$output_error_message'(permission_error(modify,table,P), _) :-
|
||||
format(user_error,'% PERMISSION ERROR- cannot table procedure ~w~n',
|
||||
[P]).
|
||||
'$output_error_message'(permission_error(module,redefined,Mod), Who) :-
|
||||
format(user_error,'% PERMISSION ERROR ~w- redefining module ~a in a different file~n',
|
||||
[Who,Mod]).
|
||||
'$output_error_message'(permission_error(open,source_sink,Stream), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot open file ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(output,binary_stream,Stream), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot write to binary stream ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(output,stream,Stream), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot write to ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(output,text_stream,Stream), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot write to text stream ~w~n',
|
||||
[Where,Stream]).
|
||||
'$output_error_message'(permission_error(resize,array,P), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot resize array ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(permission_error(unlock,mutex,P), Where) :-
|
||||
format(user_error,'% PERMISSION ERROR- ~w: cannot unlock mutex ~w~n',
|
||||
[Where,P]).
|
||||
'$output_error_message'(representation_error(character), Where) :-
|
||||
format(user_error,'% REPRESENTATION ERROR- ~w: expected character~n',
|
||||
[Where]).
|
||||
'$output_error_message'(representation_error(character_code), Where) :-
|
||||
format(user_error,'% REPRESENTATION ERROR- ~w: expected character code~n',
|
||||
[Where]).
|
||||
'$output_error_message'(representation_error(max_arity), Where) :-
|
||||
format(user_error,'% REPRESENTATION ERROR- ~w: number too big~n',
|
||||
[Where]).
|
||||
'$output_error_message'(syntax_error(G,0,Msg,[],0,0), _) :- !,
|
||||
format(user_error,'% SYNTAX ERROR: ~a',[G,Msg]).
|
||||
'$output_error_message'(syntax_error(_,_,_,Term,Pos,Start), Where) :-
|
||||
format(user_error,'% ~w ',[Where]),
|
||||
'$dump_syntax_error_line'(Start,Pos),
|
||||
'$dump_syntax_error_term'(10,Pos, Term),
|
||||
format(user_error,'.~n',[]).
|
||||
'$output_error_message'(system_error, Where) :-
|
||||
format(user_error,'% SYSTEM ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(internal_compiler_error, Where) :-
|
||||
format(user_error,'% INTERNAL COMPILER ERROR- ~w~n',
|
||||
[Where]).
|
||||
'$output_error_message'(system_error(Message), Where) :-
|
||||
format(user_error,'% SYSTEM ERROR- ~w at ~w]~n',
|
||||
[Message,Where]).
|
||||
'$output_error_message'(type_error(T,_,Err,M), _Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected ~w, got ~w~n',
|
||||
[T,Err,M]).
|
||||
'$output_error_message'(type_error(array,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected array, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(atom,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected atom, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(atomic,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected atomic, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(byte,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected byte, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(callable,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected callable goal, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(char,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected char, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(character,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected character, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(character_code,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected character code, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(compound,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected compound, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(db_reference,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected data base reference, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(db_term,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected data base term, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(evaluable,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected evaluable term, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(float,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected float, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(in_byte,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected byte, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(in_character,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected atom character, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(in_character_code,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected character code, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(integer,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected integer, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(key,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected database key, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(leash_mode,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected modes for leash, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(list,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected list, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(number,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected number, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(pointer,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected pointer, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(predicate_indicator,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected predicate indicator, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(unsigned_byte,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected unsigned byte, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(unsigned_char,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected unsigned char, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(type_error(variable,W), Where) :-
|
||||
format(user_error,'% TYPE ERROR- ~w: expected unbound variable, got ~w~n',
|
||||
[Where,W]).
|
||||
'$output_error_message'(unknown, Where) :-
|
||||
format(user_error,'% EXISTENCE ERROR- procedure ~w undefined~n',
|
||||
[Where]).
|
||||
|
||||
|
||||
'$dump_syntax_error_line'(Position,_) :-
|
||||
format(user_error,', near line ~d:~n',[Position]).
|
||||
|
||||
'$dump_syntax_error_term'(0,J,L) :- !,
|
||||
format(user_error,'~n', []),
|
||||
'$dump_syntax_error_term'(10,J,L).
|
||||
'$dump_syntax_error_term'(_,0,L) :- !,
|
||||
format(user_error,'~n<==== HERE ====>~n', []),
|
||||
'$dump_syntax_error_term'(10,-1,L).
|
||||
'$dump_syntax_error_term'(_,_,[]) :- !.
|
||||
'$dump_syntax_error_term'(I,J,[T-_P|R]) :-
|
||||
'$dump_error_token'(T),
|
||||
I1 is I-1,
|
||||
J1 is J-1,
|
||||
'$dump_syntax_error_term'(I1,J1,R).
|
||||
|
||||
'$dump_error_token'(atom(A)) :- !,
|
||||
format(user_error,' ~a', [A]).
|
||||
'$dump_error_token'(number(N)) :- !,
|
||||
format(user_error,' ~w', [N]).
|
||||
'$dump_error_token'(var(_,S,_)) :- !,
|
||||
format(user_error,' ~s ', [S]).
|
||||
'$dump_error_token'(string(S)) :- !,
|
||||
format(user_error,' ""~s""', [S]).
|
||||
'$dump_error_token'('(') :- !,
|
||||
format(user_error,"(", []).
|
||||
'$dump_error_token'(')') :- !,
|
||||
format(user_error," )", []).
|
||||
'$dump_error_token'(',') :- !,
|
||||
format(user_error," ,", []).
|
||||
'$dump_error_token'(A) :-
|
||||
format(user_error," ~a", [A]).
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,204 @@
|
|||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: utilities for messing around in YAP internals. *
|
||||
* comments: error messages for YAP *
|
||||
* *
|
||||
* Last rev: $Date: 2008-02-22 15:08:37 $,$Author: vsc $ *
|
||||
* *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
:- module('$hacks',
|
||||
[display_stack_info/4,
|
||||
display_stack_info/6,
|
||||
display_pc/3,
|
||||
code_location/3]).
|
||||
|
||||
display_stack_info(CPs,Envs,Lim,PC) :-
|
||||
display_stack_info(CPs,Envs,Lim,CP,Lines,[]),
|
||||
flush_output(user_output),
|
||||
flush_output(user_error),
|
||||
print_message_lines(user_error, '', Lines).
|
||||
|
||||
code_location(Info,Where,Location) :-
|
||||
integer(Where) , !,
|
||||
'$pred_for_code'(Where,Name,Arity,Mod,Clause),
|
||||
construct_code(Clause,Name,Arity,Mod,Info,Location).
|
||||
code_location(Info,_,Info).
|
||||
|
||||
construct_code(-1,Name,Arity,Mod,Where,Location) :- !,
|
||||
number_codes(Arity,ArityCode),
|
||||
atom_codes(ArityAtom,ArityCode),
|
||||
atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' at indexing code'],Location).
|
||||
construct_code(0,_,_,_,Location,Location) :- !.
|
||||
construct_code(Cl,Name,Arity,Mod,Where,Location) :-
|
||||
number_codes(Arity,ArityCode),
|
||||
atom_codes(ArityAtom,ArityCode),
|
||||
number_codes(Cl,ClCode),
|
||||
atom_codes(ClAtom,ClCode),
|
||||
atom_concat([Where,' at ',Mod,':',Name,'/',ArityAtom,' (clause ',ClAtom,')'],Location).
|
||||
|
||||
'$prepare_loc'(Info,Where,Location) :- integer(Where), !,
|
||||
'$pred_for_code'(Where,Name,Arity,Mod,Clause),
|
||||
'$construct_code'(Clause,Name,Arity,Mod,Info,Location).
|
||||
'$prepare_loc'(Info,_,Info).
|
||||
|
||||
display_pc(PC) -->
|
||||
{ integer(PC) },
|
||||
{ '$pred_for_code'(PC,Name,Arity,Mod,Clause) },
|
||||
pc_code(Clause,Name,Arity,Mod).
|
||||
|
||||
pc_code(-1,Name,Arity,Mod) --> !,
|
||||
[ ' indexing code of ~a:~q/~d' - [Mod,Name,Arity] ].
|
||||
pc_code(Cl,Name,Arity,Mod) -->
|
||||
{ Cl > 0 },
|
||||
[ ' clause ~d of ~a:~q/~d' - [Cl,Mod,Name,Arity] ].
|
||||
|
||||
|
||||
display_stack_info(_,_,0,_) --> !.
|
||||
display_stack_info([],[],_,_) --> [].
|
||||
display_stack_info([CP|CPs],[],I,_) -->
|
||||
show_lone_cp(CP),
|
||||
{ I1 is I-1 },
|
||||
display_stack_info(CPs,[],I1,_).
|
||||
display_stack_info([],[Env|Envs],I,Cont) -->
|
||||
show_env(Env, Cont, NCont),
|
||||
{ I1 is I-1 },
|
||||
display_stack_info([], Envs, I1, NCont).
|
||||
display_stack_info([CP|LCPs],[Env|LEnvs],I,Cont) -->
|
||||
continuation(Env, _, NCont, CB),
|
||||
{ I1 is I-1 },
|
||||
( { CP == Env, CB < CP } ->
|
||||
% if we follow choice-point and we cut to before choice-point
|
||||
% we are the same goal
|
||||
show_cp(CP, 'Cur'), %
|
||||
display_stack_info(LCPs, LEnvs, I1, NCont)
|
||||
;
|
||||
{ CP > Env } ->
|
||||
show_cp(CP, 'Next'),
|
||||
display_stack_info(LCPs,[Env|LEnvs],I1,Cont)
|
||||
;
|
||||
show_env(Env,Cont,NCont),
|
||||
display_stack_info([CP|LCPs],LEnvs,I1,NCont)
|
||||
).
|
||||
|
||||
show_cp(CP, Continuation) -->
|
||||
{ choicepoint(CP, Addr, Mod, Name, Arity, Goal, ClNo) },
|
||||
( { Goal = (_;_) }
|
||||
->
|
||||
[ '0x~16r~t*~16+ Cur~t~d~16+ ~q:~q/~d( ? ; ? )~n'-
|
||||
[Addr, ClNo, Mod, Name, Arity] ]
|
||||
;
|
||||
{ prolog_flag( debugger_print_options, Opts) },
|
||||
[ '0x~16r~t *~16+ ~a~t ~d~16+ ~q:' -
|
||||
[Addr, Continuation, ClNo, Mod]]
|
||||
),
|
||||
{clean_goal(Goal,Mod,G)},
|
||||
['~@.~q~n' - write_term(G,Opts)].
|
||||
|
||||
show_env(Env,Cont,NCont) -->
|
||||
{
|
||||
continuation(Env, Addr, NCont, _),
|
||||
cp_to_predicate(Cont, Mod, Name, Arity, ClId)
|
||||
},
|
||||
[ '0x~16r~t ~16+ Cur~t ~d~16+ ~q:' -
|
||||
[Addr, ClId, Mod] ],
|
||||
{scratch_goal(Name, Arity, Mod, G)},
|
||||
['~@.~q~n' - write_term(G,Opts)].
|
||||
|
||||
clean_goal(G,Mod,NG) :-
|
||||
beautify_hidden_goal(G,Mod,[NG],[]), !.
|
||||
clean_goal(G,_,G).
|
||||
|
||||
scratch_goal(N,A,Mod,NG) :-
|
||||
list_of_qmarks(A,L),
|
||||
G=..[N|L],
|
||||
beautify_hidden_goal(G,Mod,[NG],[]), !.
|
||||
|
||||
list_of_qmarks(0,[]).
|
||||
list_of_qmarks(I,[?|L]) :-
|
||||
I1 is I-1,
|
||||
list_of_qmarks(I1,L).
|
||||
|
||||
|
||||
beautify_hidden_goal('$yes_no'(G,Query), prolog) -->
|
||||
!,
|
||||
{ Call =.. [(?), G] },
|
||||
[Call].
|
||||
beautify_hidden_goal('$do_yes_no'(G,Mod), prolog) -->
|
||||
[Mod:G].
|
||||
beautify_hidden_goal('$query'(G,VarList), prolog) -->
|
||||
[query(G,VarList)].
|
||||
beautify_hidden_goal('$enter_top_level', prolog) -->
|
||||
['TopLevel'].
|
||||
% The user should never know these exist.
|
||||
beautify_hidden_goal('$csult'(Files,Mod),prolog) -->
|
||||
[reconsult(Mod:Files)].
|
||||
beautify_hidden_goal('$use_module'(Files,Mod,Is),prolog) -->
|
||||
[use_module(Mod,Files,Is)].
|
||||
beautify_hidden_goal('$continue_with_command'(reconsult,V,G,Source),prolog) -->
|
||||
['Assert'(G,V,Source)].
|
||||
beautify_hidden_goal('$continue_with_command'(consult,V,G,Source),prolog) -->
|
||||
['Assert'(G,V,Source)].
|
||||
beautify_hidden_goal('$continue_with_command'(top,V,G,_),prolog) -->
|
||||
['Query'(G,V)].
|
||||
beautify_hidden_goal('$continue_with_command'(Command,V,G,Source),prolog) -->
|
||||
['TopLevel'(Command,G,V,Source)].
|
||||
beautify_hidden_goal('$spycall'(G,M,InControl,Redo),prolog) -->
|
||||
['DebuggerCall'(M:G, InControl, Redo)].
|
||||
beautify_hidden_goal('$do_spy'(Goal, Mod, CP, InControl),prolog) -->
|
||||
['DebuggerCall'(Mod:Goal, InControl)].
|
||||
beautify_hidden_goal('$system_catch'(G,Mod,Exc,Handler),prolog) -->
|
||||
[catch(Mod:G, Exc, Handler)].
|
||||
beautify_hidden_goal('$catch'(G,Exc,Handler),prolog) -->
|
||||
[catch(G, Exc, Handler)].
|
||||
beautify_hidden_goal('$execute_command'(Query,V,Option,Source),prolog) -->
|
||||
[toplevel_query(Query, V, Option, Source)].
|
||||
beautify_hidden_goal('$process_directive'(Gs,_,Mod),prolog) -->
|
||||
[(:- Mod:Gs)].
|
||||
beautify_hidden_goal('$loop'(Stream,Option),prolog) -->
|
||||
[execute_load_file(Stream, consult=Option)].
|
||||
beautify_hidden_goal('$load_files'(Files,Opts,?),prolog) -->
|
||||
[load_files(Files,Opts)].
|
||||
beautify_hidden_goal('$load_files'(_,_,Name),prolog) -->
|
||||
[Name].
|
||||
beautify_hidden_goal('$reconsult'(Files,Mod),prolog) -->
|
||||
[reconsult(Mod:Files)].
|
||||
beautify_hidden_goal('$undefp'([M|G]),prolog) -->
|
||||
['CallUndefined'(Mod:G)].
|
||||
beautify_hidden_goal('$undefp'(?),prolog) -->
|
||||
['CallUndefined'(?:?)].
|
||||
beautify_hidden_goal(repeat,prolog) -->
|
||||
[repeat].
|
||||
beautify_hidden_goal('$recorded_with_key'(A,B,C),prolog) -->
|
||||
recorded(A,B,C).
|
||||
beautify_hidden_goal('$findall_with_common_vars'(Templ,Gen,Answ),prolog) -->
|
||||
[findall(Templ,Gen,Answ)].
|
||||
beautify_hidden_goal('$bagof'(Templ,Gen,Answ),prolog) -->
|
||||
[bagof(Templ,Gen,Answ)].
|
||||
beautify_hidden_goal('$setof'(Templ,Gen,Answ),prolog) -->
|
||||
[setof(Templ,Gen,Answ)].
|
||||
beautify_hidden_goal('$findall'(T,G,S,A),prolog) -->
|
||||
[findall(T,G,S,A)].
|
||||
beautify_hidden_goal('$listing'(G,M,_Stream),prolog) -->
|
||||
[listing(M:G)].
|
||||
beautify_hidden_goal('$call'(G,CP,?,M),prolog) -->
|
||||
[call(M:G)].
|
||||
beautify_hidden_goal('$call'(G,CP,G0,M),prolog) -->
|
||||
[call(M:G0)].
|
||||
beautify_hidden_goal('$current_predicate'(M,Na,Ar),prolog) -->
|
||||
[current_predicate(M,Na/Ar)].
|
||||
beautify_hidden_goal('$current_predicate_for_atom'(M,Na,Ar),prolog) -->
|
||||
[current_predicate(M,Na/Ar)].
|
||||
beautify_hidden_goal('$list_clauses'(Stream,M,Pred),prolog) -->
|
||||
[listing(M:Pred)].
|
||||
|
||||
|
||||
23
pl/init.yap
23
pl/init.yap
|
|
@ -91,6 +91,12 @@ system_mode(verbose,off) :- set_value('$verbose',off).
|
|||
:- ['corout.yap',
|
||||
'arrays.yap'].
|
||||
|
||||
:- use_module('messages.yap').
|
||||
:- use_module('hacks.yap').
|
||||
|
||||
'$system_module'('$message').
|
||||
'$system_module'('$hacks').
|
||||
|
||||
yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
|
||||
|
||||
:- '$change_type_of_char'(36,7). % Make $ a symbol character
|
||||
|
|
@ -101,15 +107,6 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
|
|||
|
||||
:- dynamic user:library_directory/1.
|
||||
|
||||
:- (
|
||||
prolog:'$system_library_directories'(D),
|
||||
write(D),nl,
|
||||
assert(user:library_directory(D)),
|
||||
fail
|
||||
;
|
||||
true
|
||||
).
|
||||
|
||||
%
|
||||
% cleanup ensure loaded and recover some data-base space.
|
||||
%
|
||||
|
|
@ -128,6 +125,10 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
|
|||
|
||||
:- system_mode(verbose,on).
|
||||
|
||||
:- multifile prolog:message/3.
|
||||
|
||||
:- dynamic prolog:message/3.
|
||||
|
||||
:- module(user).
|
||||
|
||||
:- multifile goal_expansion/3.
|
||||
|
|
@ -142,6 +143,10 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
|
|||
|
||||
:- dynamic file_search_path/2.
|
||||
|
||||
:- multifile generate_message_hook/3.
|
||||
|
||||
:- dynamic generate_message_hook/3.
|
||||
|
||||
file_search_path(library, Dir) :-
|
||||
library_directory(Dir).
|
||||
file_search_path(swi, Home) :-
|
||||
|
|
|
|||
|
|
@ -0,0 +1,486 @@
|
|||
/*************************************************************************
|
||||
* *
|
||||
* YAP Prolog *
|
||||
* *
|
||||
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
||||
* *
|
||||
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
||||
* *
|
||||
**************************************************************************
|
||||
* *
|
||||
* File: utilities for displaying messages in YAP. *
|
||||
* comments: error messages for YAP *
|
||||
* *
|
||||
* Last rev: $Date: 2008-02-22 15:08:37 $,$Author: vsc $ *
|
||||
* *
|
||||
* *
|
||||
*************************************************************************/
|
||||
|
||||
:- module('$message',
|
||||
[system_message/4,
|
||||
prefix/6,
|
||||
prefix/5,
|
||||
file_location/3]).
|
||||
|
||||
file_location(Prefix) -->
|
||||
{
|
||||
nb_getval('$consulting_file',FileName),
|
||||
FileName \= []
|
||||
},
|
||||
{ '$start_line'(LN) },
|
||||
file_position(FileName,LN,Prefix),
|
||||
[ nl ].
|
||||
|
||||
file_position(user_input,LN,MsgCodes) -->
|
||||
[ '~a at user_input near line ~d.' - [MsgCodes,LN] ].
|
||||
file_position(FileName,LN,MsgCodes) -->
|
||||
[ '~a at file ~a, near line ~d.' - [MsgCodes,FileName,LN] ].
|
||||
|
||||
generate_message(halt) --> !,
|
||||
['YAP execution halted'].
|
||||
generate_message('$abort') :- !,
|
||||
['YAP execution aborted'].
|
||||
generate_message(loading(_,user)) --> !.
|
||||
generate_message(loading(What,AbsoluteFileName)) --> !,
|
||||
[ '~a ~a...' - [What, AbsoluteFileName] ].
|
||||
generate_message(loaded(_,user,_,_,_)) --> !.
|
||||
generate_message(loaded(included,AbsoluteFileName,Mod,Time,Space)) --> !,
|
||||
[ '~a included in module ~a, ~d msec ~d bytes' - [AbsoluteFileName,Mod,Time,Space] ].
|
||||
generate_message(loaded(What,AbsoluteFileName,Mod,Time,Space)) --> !,
|
||||
[ '~a ~a in module ~a, ~d msec ~d bytes' - [What, AbsoluteFileName,Mod,Time,Space] ].
|
||||
generate_message(prompt(BreakLevel,TraceDebug)) --> !,
|
||||
( { BreakLevel =:= 0 } ->
|
||||
(
|
||||
{ var(TraceDebug) } ->
|
||||
[]
|
||||
;
|
||||
[ '~a' - [TraceDebug] ]
|
||||
)
|
||||
;
|
||||
(
|
||||
var(TraceDebug) ->
|
||||
[ '~d' - [BreakLevel] ]
|
||||
;
|
||||
[ '~d ~a' - [BreakLevel, TraceDebug] ]
|
||||
)
|
||||
).
|
||||
generate_message(debug) --> !,
|
||||
[ debug ].
|
||||
generate_message(trace) --> !,
|
||||
[ trace ].
|
||||
generate_message(M) -->
|
||||
system_message(M),
|
||||
stack_dump(M).
|
||||
|
||||
stack_dump(error(_,_)) -->
|
||||
{ nb_getval(sp_info,local_sp(P,CP,Envs,CPs)) },
|
||||
{ Envs = [_|_] ; CPs = [_|_] }, !,
|
||||
[nl],
|
||||
'$hacks':display_stack_info(CPs, Envs, 20, CP).
|
||||
stack_dump(_) --> [].
|
||||
|
||||
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
|
||||
system_message(format(Msg, Args)) -->
|
||||
[Msg - Args].
|
||||
system_message(ancestors([])) -->
|
||||
[ 'There are no ancestors.' ].
|
||||
system_message(breakp(bp(debugger,_,_,M:F/N,_),add,already)) -->
|
||||
[ 'There is already a spy point on ~w:~w/~w.' - [M,F,N]].
|
||||
system_message(breakp(bp(debugger,_,_,M:F/N,_),add,ok)) -->
|
||||
[ 'Spy point set on ~w:~w/~w.' - [M,F,N] ].
|
||||
system_message(breakp(bp(debugger,_,_,M:F/N,_),remove,last)) -->
|
||||
[ 'Spy point on ~w:~w/~w removed.' - [M,F,N] ].
|
||||
system_message(breakp(no,breakpoint_for,M:F/N)) -->
|
||||
[ 'There is no spy point on ~w:~w/~w.' - [M,F,N]].
|
||||
system_message(breakpoints([])) -->
|
||||
[ 'There are no spy-points set.' ].
|
||||
system_message(breakpoints(L)) -->
|
||||
[ 'Spy-points set on:' ],
|
||||
list_of_preds(L).
|
||||
system_message(clauses_not_together(P)) -->
|
||||
[ 'Discontiguous definition of ~q.' - [P] ].
|
||||
system_message(debug(debug)) -->
|
||||
[ 'Debug mode on.' ].
|
||||
system_message(debug(off)) -->
|
||||
[ 'Debug mode off.' ].
|
||||
system_message(debug(trace)) -->
|
||||
[ 'Trace mode on.' ].
|
||||
system_message(declaration(Args,Action)) -->
|
||||
[ 'declaration ~w ~w.', [Args,Action] ].
|
||||
system_message(defined_elsewhere(P,F)) -->
|
||||
[ 'predicate ~q previously defined in file ~w' - [P,F] ].
|
||||
system_message(import(Pred,To,From,private)) -->
|
||||
[ 'Importing private predicate ~w:~w to ~w.' - [From,Pred,To] ].
|
||||
system_message(leash([])) -->
|
||||
[ 'No leashing.' ].
|
||||
system_message(leash([A|B])) -->
|
||||
[ 'Leashing set to ~w.' - [[A|B]] ].
|
||||
system_message(no) -->
|
||||
[ 'no' ].
|
||||
system_message(no_match(P)) -->
|
||||
[ 'No matching predicate for ~w.' - [P] ].
|
||||
system_message(leash([A|B])) -->
|
||||
[ 'Leashing set to ~w.' - [[A|B]] ].
|
||||
system_message(singletons([SV],P,CLN)) -->
|
||||
[ 'Singleton variable ~s in ~q, clause ~d.' - [SV,P,CLN] ].
|
||||
system_message(singletons(SVs,P,CLN)) -->
|
||||
[ 'Singleton variables ~s in ~q, clause ~d.' - [SVsL, P, CLN] ],
|
||||
{ svs(SVs,SVsL,[]) }.
|
||||
system_message(trace_command(-1)) -->
|
||||
[ 'EOF is not a valid debugger command.' ].
|
||||
system_message(trace_command(C)) -->
|
||||
[ '~c is not a valid debugger command.' - [C] ].
|
||||
system_message(trace_help) -->
|
||||
[ ' Please enter a valid debugger command (h for help).' ].
|
||||
system_message(version(Version)) -->
|
||||
[ 'YAP version ~a' - [Version] ].
|
||||
system_message(myddas_version(Version)) -->
|
||||
[ 'MYDDAS version ~a' - [Version] ].
|
||||
system_message(yes) -->
|
||||
[ 'yes' ].
|
||||
system_message(error,error(Msg,Info)) -->
|
||||
( { var(Msg) } ; { var(Info)} ), !,
|
||||
['bad error ~w' - [error(Msg,Info)]].
|
||||
system_message(error(consistency_error(Who),Where)) -->
|
||||
[ 'CONSISTENCY ERROR- ~w ~w' - [Who,Where] ].
|
||||
system_message(error(context_error(Goal,Who),Where)) -->
|
||||
[ 'CONTEXT ERROR- ~w: ~w appeared in ~w' - [Goal,Who,Where] ].
|
||||
system_message(error(domain_error(DomainType,Opt), Where)) -->
|
||||
[ 'DOMAIN ERROR- ~w: ' - Where],
|
||||
domain_error(DomainType, Opt).
|
||||
system_message(error(existence_error(procedure,P), context(Call,Parent))) --> !,
|
||||
[ 'EXISTENCE ERROR- procedure ~w is undefined, called from context ~w~n Goal was ~w' - [P,Parent,Call] ].
|
||||
system_message(error(existence_error(stream,Stream), Where)) -->
|
||||
[ 'EXISTENCE ERROR- ~w: ~w not an open stream' - [Where,Stream] ].
|
||||
system_message(error(existence_error(thread,Thread), Where)) -->
|
||||
[ 'EXISTENCE ERROR- ~w: ~w not a running thread' - [Where,Thread] ].
|
||||
system_message(error(existence_error(Name,F), W)) -->
|
||||
{ object_name(Name, ObjName) },
|
||||
[ 'EXISTENCE ERROR- ~w could not open ~a ~w' - [W,ObjName,F] ].
|
||||
system_message(error(evaluation_error(int_overflow), Where)) -->
|
||||
[ 'INTEGER OVERFLOW ERROR- ~w' - [Where] ].
|
||||
system_message(error(evaluation_error(float_overflow), Where)) -->
|
||||
[ 'FLOATING POINT OVERFLOW ERROR- ~w' - [Where] ].
|
||||
system_message(error(evaluation_error(undefined), Where)) -->
|
||||
[ 'UNDEFINED ARITHMETIC RESULT ERROR- ~w' - [Where] ].
|
||||
system_message(error(evaluation_error(underflow), Where)) -->
|
||||
[ 'UNDERFLOW ERROR- ~w' - [Where] ].
|
||||
system_message(error(evaluation_error(float_underflow), Where)) -->
|
||||
[ 'FLOATING POINT UNDERFLOW ERROR- ~w' - [Where] ].
|
||||
system_message(error(evaluation_error(zero_divisor), Where)) -->
|
||||
[ 'ZERO DIVISOR ERROR- ~w' - [Where] ].
|
||||
system_message(error(instantiation_error, Where)) -->
|
||||
[ 'INSTANTIATION ERROR- ~w: expected bound value' - [Where] ].
|
||||
system_message(error(operating_system_error, Where)) -->
|
||||
[ 'OPERATING SYSTEM ERROR- ~w' - [Where] ].
|
||||
system_message(error(out_of_heap_error, Where)) -->
|
||||
[ 'OUT OF DATABASE SPACE ERROR- ~w' - [Where] ].
|
||||
system_message(error(out_of_stack_error, Where)) -->
|
||||
[ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ].
|
||||
system_message(error(out_of_trail_error, Where)) -->
|
||||
[ 'OUT OF TRAIL SPACE ERROR- ~w' - [Where] ].
|
||||
system_message(error(out_of_attvars_error, Where)) -->
|
||||
[ 'OUT OF STACK SPACE ERROR- ~w' - [Where] ].
|
||||
system_message(error(out_of_auxspace_error, Where)) -->
|
||||
[ 'OUT OF AUXILIARY STACK SPACE ERROR- ~w' - [Where] ].
|
||||
system_message(error(permission_error(access,private_procedure,P), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: cannot see clauses for ~w' - [Where,P] ].
|
||||
system_message(error(permission_error(access,static_procedure,P), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: cannot access static procedure ~w' - [Where,P] ].
|
||||
system_message(error(permission_error(alias,new,P), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: cannot create alias ~w' - [Where,P] ].
|
||||
system_message(error(permission_error(create,array,P), Where)) -->
|
||||
{ object_name(Name, ObjName) },
|
||||
[ 'PERMISSION ERROR- ~w: cannot create ~a ~w' - [Where,ObjName,P] ].
|
||||
system_message(error(permission_error(input,binary_stream,Stream), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: cannot read from binary stream ~w' - [Where,Stream] ].
|
||||
system_message(error(permission_error(input,closed_stream,Stream), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: trying to read from closed stream ~w' - [Where,Stream] ].
|
||||
system_message(error(permission_error(input,past_end_of_stream,Stream), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: past end of stream ~w' - [Where,Stream] ].
|
||||
system_message(error(permission_error(input,stream,Stream), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: cannot read from ~w' - [Where,Stream] ].
|
||||
system_message(error(permission_error(input,text_stream,Stream), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: cannot read from text stream ~w' - [Where,Stream] ].
|
||||
system_message(error(permission_error(modify,dynamic_procedure,_), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: modifying a dynamic procedure' - [Where] ].
|
||||
system_message(error(permission_error(modify,flag,W), _)) -->
|
||||
[ 'PERMISSION ERROR- cannot modify flag ~w' - [W] ].
|
||||
system_message(error(permission_error(modify,operator,W), _)) -->
|
||||
[ 'PERMISSION ERROR- T cannot declare ~w an operator' - [W] ].
|
||||
system_message(error(permission_error(modify,dynamic_procedure,_), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: modifying a dynamic procedure' - [Where] ].
|
||||
system_message(error(permission_error(modify,static_procedure,_), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: modifying a static procedure' - [Where] ].
|
||||
system_message(error(permission_error(modify,static_procedure_in_use,_), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: modifying a static procedure in use' - [Where] ].
|
||||
system_message(error(permission_error(modify,table,P), _)) -->
|
||||
[ 'PERMISSION ERROR- cannot table procedure ~w' - [P] ].
|
||||
system_message(error(permission_error(module,redefined,Mod), Who)) -->
|
||||
[ 'PERMISSION ERROR ~w- redefining module ~a in a different file' - [Who,Mod] ].
|
||||
system_message(error(permission_error(open,source_sink,Stream), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: cannot open file ~w' - [Where,Stream] ].
|
||||
system_message(error(permission_error(output,binary_stream,Stream), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: cannot write to binary stream ~w' - [Where,Stream] ].
|
||||
system_message(error(permission_error(output,stream,Stream), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: cannot write to ~w' - [Where,Stream] ].
|
||||
system_message(error(permission_error(output,text_stream,Stream), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: cannot write to text stream ~w' - [Where,Stream] ].
|
||||
system_message(error(permission_error(resize,array,P), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: cannot resize array ~w' - [Where,P] ].
|
||||
system_message(error(permission_error(unlock,mutex,P), Where)) -->
|
||||
[ 'PERMISSION ERROR- ~w: cannot unlock mutex ~w' - [Where,P] ].
|
||||
system_message(error(representation_error(character), Where)) -->
|
||||
[ 'REPRESENTATION ERROR- ~w: expected character' - [Where] ].
|
||||
system_message(error(representation_error(character_code), Where)) -->
|
||||
[ 'REPRESENTATION ERROR- ~w: expected character code' - [Where] ].
|
||||
system_message(error(representation_error(max_arity), Where)) -->
|
||||
[ 'REPRESENTATION ERROR- ~w: number too big' - [Where] ].
|
||||
system_message(error(syntax_error(G,0,Msg,[],0,0), _)) -->
|
||||
[ 'SYNTAX ERROR: ~a' - [G,Msg] ].
|
||||
system_message(error(syntax_error(_,_,_,Term,Pos,Start), Where)) -->
|
||||
['~w' - [Where]],
|
||||
syntax_error_line(Start,Pos),
|
||||
syntax_error_term(10, Pos, Term),
|
||||
[ '.' ].
|
||||
system_message(error(system_error, Where)) -->
|
||||
[ 'SYSTEM ERROR- ~w' - [Where] ].
|
||||
system_message(error(internal_compiler_error, Where)) -->
|
||||
[ 'INTERNAL COMPILER ERROR- ~w' - [Where] ].
|
||||
system_message(error(system_error(Message), Where)) -->
|
||||
[ 'SYSTEM ERROR- ~w at ~w]' - [Message,Where] ].
|
||||
system_message(error(type_error(T,_,Err,M), _Where)) -->
|
||||
[ 'TYPE ERROR- ~w: expected ~w, got ~w' - [T,Err,M] ].
|
||||
system_message(error(type_error(TE,W), Where)) -->
|
||||
{ type_error(TE, M) }, !,
|
||||
[ 'TYPE ERROR- ~w: expected ~a, got ~w' - [Where,M,W] ].
|
||||
system_message(error(type_error(TE,W), Where)) -->
|
||||
[ 'TYPE ERROR- ~w: expected ~q, got ~w' - [Where,TE,W] ].
|
||||
system_message(error(unknown, Where)) -->
|
||||
[ 'EXISTENCE ERROR- procedure ~w undefined' - [Where] ].
|
||||
system_message(Messg) -->
|
||||
[ '~q' - Messg ].
|
||||
|
||||
|
||||
domain_error(array_overflow, Opt) --> !,
|
||||
[ 'invalid static index ~w for array' - Opt ].
|
||||
domain_error(array_type, Opt) --> !,
|
||||
[ 'invalid static array type ~w' - Opt ].
|
||||
domain_error(builtin_procedure, _) --> !,
|
||||
[ 'non-iso built-in procedure' ].
|
||||
domain_error(character_code_list, Opt) --> !,
|
||||
[ 'invalid list of codes ~w' - [Opt] ].
|
||||
domain_error(close_option, Opt) --> !,
|
||||
[ 'invalid close option ~w' - [Opt] ].
|
||||
domain_error(delete_file_option, Opt) --> !,
|
||||
[ 'invalid list of options ~w' - [Opt] ].
|
||||
domain_error(encoding, Opt) --> !,
|
||||
[ 'invalid encoding ~w' - [Opt] ].
|
||||
domain_error(flag_value, Opt) --> !,
|
||||
[ 'invalid value ~w for flag ~w' - [Opt] ].
|
||||
domain_error(io_mode, Opt) --> !,
|
||||
[ 'invalid io mode ~w' - [Opt] ].
|
||||
domain_error(mutable, Opt) --> !,
|
||||
[ 'invalid id mutable ~w' - [Opt] ].
|
||||
domain_error(module_decl_options, Opt) --> !,
|
||||
[ 'expect module declaration options, found ~w' - [Opt] ].
|
||||
domain_error(not_empty_list, Opt) --> !,
|
||||
[ 'found empty list' - [Opt] ].
|
||||
domain_error(not_less_than_zero, Opt) --> !,
|
||||
[ 'number ~w less than zero' - [Opt] ].
|
||||
domain_error(not_newline, Opt) --> !,
|
||||
[ 'number ~w not newline' - [Opt] ].
|
||||
domain_error(not_zero, Opt) --> !,
|
||||
[ '~w is not allowed in the domain' - [Opt] ].
|
||||
domain_error(operator_priority, Opt) --> !,
|
||||
[ '~w invalid operator priority' - [Opt] ].
|
||||
domain_error(operator_specifier, Opt) --> !,
|
||||
[ 'invalid operator specifier ~w' - [Opt] ].
|
||||
domain_error(out_of_range, Opt) --> !,
|
||||
[ 'expression ~w is out of range' - [Opt] ].
|
||||
domain_error(predicate_spec, Opt) --> !,
|
||||
[ '~w invalid predicate specifier' - [Opt] ].
|
||||
domain_error(radix, Opt) --> !,
|
||||
[ 'invalid radix ~w' - [Opt] ].
|
||||
domain_error(read_option, Opt) --> !,
|
||||
[ '~w invalid option to read_term' - [Opt] ].
|
||||
domain_error(semantics_indicatior, Opt) --> !,
|
||||
[ '~w expected predicate indicator, got ~w' - [Opt] ].
|
||||
domain_error(shift_count_overflow, Opt) --> !,
|
||||
[ 'shift count overflow in ~w' - [Opt] ].
|
||||
domain_error(source_sink, Opt) --> !,
|
||||
[ '~w is not a source sink term' - [Opt] ].
|
||||
domain_error(stream, Opt) --> !,
|
||||
[ '~w is not a stream' - [Opt] ].
|
||||
domain_error(stream_or_alias, Opt) --> !,
|
||||
[ '~w is not a stream (or alias)' - [Opt] ].
|
||||
domain_error(stream_position, Opt) --> !,
|
||||
[ '~w is not a stream position' - [Opt] ].
|
||||
domain_error(stream_property, Opt) --> !,
|
||||
[ '~w is not a stream property' - [Opt] ].
|
||||
domain_error(syntax_error_handler, Opt) --> !,
|
||||
[ '~w is not a syntax error handler' - [Opt] ].
|
||||
domain_error(table, Opt) --> !,
|
||||
[ 'non-tabled procedure ~w' - [Opt] ].
|
||||
domain_error(thread_create_option, Opt) --> !,
|
||||
[ '~w is not a thread_create option' - [Opt] ].
|
||||
domain_error(time_out_spec, Opt) --> !,
|
||||
[ '~w is not valid specificatin for time_out' - [Opt] ].
|
||||
domain_error(unimplemented_option, Opt) --> !,
|
||||
[ '~w is not yet implemented' - [Opt] ].
|
||||
domain_error(write_option, Opt) --> !,
|
||||
[ '~w invalid write option' - [Opt] ].
|
||||
domain_error(Domain, Opt) -->
|
||||
[ '~w not a valid element for ~w' - [Opt,Domain] ].
|
||||
|
||||
|
||||
object_name(array, array).
|
||||
object_name(atom, atom).
|
||||
object_name(atomic, atomic).
|
||||
object_name(byte, byte).
|
||||
object_name(callable, 'callable goal').
|
||||
object_name(char, char).
|
||||
object_name(character_code, 'character code').
|
||||
object_name(compound, 'compound term').
|
||||
object_name(db_reference, 'data base reference').
|
||||
object_name(evaluable, 'evaluable term').
|
||||
object_name(file, file).
|
||||
object_name(float, float).
|
||||
object_name(in_byte, byte).
|
||||
object_name(in_character, character).
|
||||
object_name(integer, integer).
|
||||
object_name(key, 'database key').
|
||||
object_name(leash_mode, 'leash mode').
|
||||
object_name(library, library).
|
||||
object_name(list, list).
|
||||
object_name(message_queue, 'message queue').
|
||||
object_name(mutex, mutex).
|
||||
object_name(number, number).
|
||||
object_name(operator, operator).
|
||||
object_name(pointer, pointer).
|
||||
object_name(predicate_indicator, 'predicate indicator').
|
||||
object_name(source_sink, file).
|
||||
object_name(unsigned_byte, 'unsigned byte').
|
||||
object_name(unsigned_char, 'unsigned char').
|
||||
object_name(variable, 'unbound variable').
|
||||
|
||||
svs([H]) --> !, H.
|
||||
svs([H|L]) -->
|
||||
H,
|
||||
", ",
|
||||
svs(L).
|
||||
|
||||
list_of_preds([]) --> [].
|
||||
list_of_preds([P|L]) -->
|
||||
['~q' - [P]],
|
||||
list_of_preds(L).
|
||||
|
||||
|
||||
syntax_error_line(Position,_) -->
|
||||
[', near line ~d:~n' - [Position]].
|
||||
|
||||
syntax_error_term(0,J,L) -->
|
||||
['~n' ],
|
||||
syntax_error_term(10,J,L).
|
||||
syntax_error_term(_,0,L) --> !,
|
||||
[ '~n<==== HERE ====>~n' ],
|
||||
syntax_error_term(10,-1,L).
|
||||
syntax_error_term(_,_,[]) --> !.
|
||||
syntax_error_term(I,J,[T-_P|R]) -->
|
||||
syntax_error_token(T),
|
||||
{
|
||||
I1 is I-1,
|
||||
J1 is J-1
|
||||
},
|
||||
syntax_error_term(I1,J1,R).
|
||||
|
||||
syntax_error_token(atom(A)) --> !,
|
||||
[ ' ~a' - [A] ].
|
||||
syntax_error_token(number(N)) --> !,
|
||||
[ ' ~w' - [N] ].
|
||||
syntax_error_token(var(_,S,_)) --> !,
|
||||
[ ' ~s' - [S] ].
|
||||
syntax_error_token(string(S)) --> !,
|
||||
[ ' ""~s"' - [S] ].
|
||||
syntax_error_token('(') --> !,
|
||||
[ '(' ].
|
||||
syntax_error_token(')') --> !,
|
||||
[ ' )' ].
|
||||
syntax_error_token(',') --> !,
|
||||
[ ' ,' ].
|
||||
syntax_error_token(A) --> !,
|
||||
[ ' ~a' - [A] ].
|
||||
|
||||
|
||||
% print_message_lines(+Stream, +Prefix, +Lines)
|
||||
%
|
||||
% Quintus/SICStus/SWI compatibility predicate to print message lines
|
||||
% using a prefix.
|
||||
|
||||
prolog:print_message_lines(_, _, []) :- !.
|
||||
prolog:print_message_lines(S, P, [at_same_line|Lines]) :- !,
|
||||
print_message_line(S, Lines, Rest),
|
||||
prolog:print_message_lines(S, P, Rest).
|
||||
prolog:print_message_lines(S, P-Opts, Lines) :- !,
|
||||
atom_concat('~N', P, Prefix),
|
||||
format(S, Prefix, Opts),
|
||||
print_message_line(S, Lines, Rest),
|
||||
prolog:print_message_lines(S, P, Rest).
|
||||
prolog:print_message_lines(S, P, Lines) :-
|
||||
atom_concat('~N', P, Prefix),
|
||||
format(S, Prefix, []),
|
||||
print_message_line(S, Lines, Rest),
|
||||
prolog:print_message_lines(S, P, Rest).
|
||||
|
||||
print_message_line(S, [flush], []) :- !,
|
||||
flush_output(S).
|
||||
print_message_line(S, [], []) :- !,
|
||||
nl(S).
|
||||
print_message_line(S, [nl|T], T) :- !,
|
||||
nl(S).
|
||||
print_message_line(S, [Fmt-Args|T0], T) :- !,
|
||||
format(S, Fmt, Args),
|
||||
print_message_line(S, T0, T).
|
||||
print_message_line(S, [Fmt|T0], T) :-
|
||||
format(S, Fmt, []),
|
||||
print_message_line(S, T0, T).
|
||||
|
||||
prefix(error, ' ', '', user_error) -->
|
||||
{ nb_getval(sp_info,local_sp(P,_,_,_)) },
|
||||
[ 'ERROR at ' ],
|
||||
'$hacks':display_pc(P), !,
|
||||
[' !!', nl].
|
||||
prefix(error, ' ', '', user_error) -->
|
||||
[ 'ERROR!! ', nl ].
|
||||
prefix(warning, '% ', '', user_error) -->
|
||||
[ 'Warning:', nl ].
|
||||
|
||||
prefix(help, '', user_error) --> [].
|
||||
prefix(query, '', user_error) --> [].
|
||||
prefix(debug, '', user_output) --> [].
|
||||
prefix(warning, '% ', user_error) -->
|
||||
{ thread_self(Id) },
|
||||
( { Id == main }
|
||||
-> [ 'Warning: ', nl ]
|
||||
; ['Warning: [Thread ~d ]' - Id, nl ]
|
||||
).
|
||||
prefix(error, ' ', user_error) -->
|
||||
{ nb_getval(sp_info,local_sp(P,_,_,_)) },
|
||||
{ thread_self(Id) },
|
||||
( { Id == main }
|
||||
-> [ 'ERROR at ' ]
|
||||
; [ 'ERROR [Thread ~d ] at ' - Id ]
|
||||
),
|
||||
'$hacks':display_pc(P),
|
||||
!,
|
||||
[' !!', nl].
|
||||
prefix(error, ' ', user_error) -->
|
||||
{ thread_self(Id) },
|
||||
( { Id == main }
|
||||
-> [ 'ERROR!!', nl ]
|
||||
; [ 'ERROR!! [Thread ~d ]' - Id, nl ]
|
||||
).
|
||||
prefix(banner, '', user_error) --> [].
|
||||
prefix(informational, '~*|% '-[LC], user_error) -->
|
||||
{ '$show_consult_level'(LC) }.
|
||||
|
||||
|
|
@ -459,7 +459,8 @@ module(N) :-
|
|||
'$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L).
|
||||
|
||||
current_module(Mod) :-
|
||||
'$all_current_modules'(Mod).
|
||||
'$all_current_modules'(Mod),
|
||||
\+ '$system_module'(Mod).
|
||||
|
||||
current_module(Mod,TFN) :-
|
||||
'$all_current_modules'(Mod),
|
||||
|
|
|
|||
|
|
@ -665,7 +665,7 @@ abolish(X) :-
|
|||
'$access_yap_flags'(8, 2), % only do this in sicstus mode
|
||||
'$undefined'(G, Module),
|
||||
functor(G,Name,Arity),
|
||||
'$print_message'(warning,no_match(abolish(Module:Name/Arity))).
|
||||
print_message(warning,no_match(abolish(Module:Name/Arity))).
|
||||
% I cannot allow modifying static procedures in YAPOR
|
||||
% this code has to be here because of abolish/2
|
||||
'$abolishs'(G, Module) :-
|
||||
|
|
@ -973,4 +973,8 @@ current_key(A,K) :-
|
|||
'$current_immediate_key'(A,K).
|
||||
|
||||
% do nothing for now.
|
||||
'$noprofile'(_, _).
|
||||
'$noprofile'(_, _).
|
||||
|
||||
'$notrace'(G) :-
|
||||
\+ '$undefined'(G, prolog),
|
||||
call(G).
|
||||
|
|
|
|||
|
|
@ -26,7 +26,8 @@
|
|||
:- initialization('$init_thread0').
|
||||
|
||||
'$init_thread0' :-
|
||||
no_threads, !.
|
||||
no_threads, !,
|
||||
recorda('$thread_alias', [0|main], _).
|
||||
'$init_thread0' :-
|
||||
'$record_thread_info'(0, main, [0, 0, 0], false, '$init_thread0'),
|
||||
recorda('$thread_defaults', [0, 0, 0, false], _),
|
||||
|
|
|
|||
|
|
@ -528,7 +528,7 @@ unknown(V0,V) :-
|
|||
'$unknown_warning'(Mod:Goal) :-
|
||||
functor(Goal,Name,Arity),
|
||||
'$program_continuation'(PMod,PName,PAr),
|
||||
'$print_message'(error,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
|
||||
print_message(error,error(existence_error(procedure,Name/Arity), context(Mod:Goal,PMod:PName/PAr))),
|
||||
fail.
|
||||
|
||||
%%% Some "dirty" predicates
|
||||
|
|
@ -809,7 +809,7 @@ version(T) :-
|
|||
halt(X) :- '$halt'(X).
|
||||
|
||||
halt :-
|
||||
'$print_message'(informational, halt),
|
||||
print_message(informational, halt),
|
||||
'$halt'(0).
|
||||
|
||||
halt(X) :-
|
||||
|
|
|
|||
|
|
@ -387,7 +387,7 @@ told :- current_output(Stream), '$close'(Stream), set_output(user).
|
|||
read(T) :-
|
||||
'$read'(false,T,_,_,_,Err),
|
||||
(nonvar(Err) ->
|
||||
'$print_message'(error,Err), fail
|
||||
print_message(error,Err), fail
|
||||
;
|
||||
true
|
||||
).
|
||||
|
|
@ -395,7 +395,7 @@ read(T) :-
|
|||
read(Stream,T) :-
|
||||
'$read'(false,T,_,_,_,Err,Stream),
|
||||
(nonvar(Err) ->
|
||||
'$print_message'(error,Err), fail
|
||||
print_message(error,Err), fail
|
||||
;
|
||||
true
|
||||
).
|
||||
|
|
|
|||
Reference in New Issue