diogo/yap-6.3
Archived
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Big update to support more SICStus/SWI like message handling

Browse Source 
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 2008-02-22 15:08:37 +00:00
parent da6d73302a
commit 17d16e0b14
19 changed files with 987 additions and 862 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
C/cdmgr.c
View File

@ -11,8 +11,12 @@
* File: cdmgr.c * * File: cdmgr.c *
* comments: Code manager * * 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 $ * $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 * Revision 1.217 2007/12/26 19:50:40 vsc
* new version of clp(fd) * new version of clp(fd)
* fix deadlock with empty args facts in clause/2. * fix deadlock with empty args facts in clause/2.
@ -3331,16 +3335,17 @@ static Term
all_calls(void) all_calls(void)
{ {
Term ts[3]; Term ts[3];
Functor f = Yap_MkFunctor(AtomLocal,3); Functor f = Yap_MkFunctor(AtomLocal,4);
ts[0] = MkIntegerTerm((Int)P); ts[0] = MkIntegerTerm((Int)P);
ts[1] = MkIntegerTerm((Int)CP);
if (yap_flags[STACK_DUMP_ON_ERROR_FLAG]) { if (yap_flags[STACK_DUMP_ON_ERROR_FLAG]) {
ts[1] = all_envs(ENV); ts[2] = all_envs(ENV);
ts[2] = all_cps(B); ts[3] = all_cps(B);
} else { } else {
ts[1] = ts[2] = TermNil; ts[2] = ts[3] = TermNil;
} }
return(Yap_MkApplTerm(f,3,ts)); return(Yap_MkApplTerm(f,4,ts));
} }
Term Term

2
C/iopreds.c
View File

@ -1233,6 +1233,8 @@ post_process_eof(StreamDesc *s)
static int static int
console_post_process_read_char(int ch, StreamDesc *s) 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') { if (ch == '\n') {
++s->linecount; ++s->linecount;
++s->charcount; ++s->charcount;

7
C/threads.c
View File

@ -695,8 +695,15 @@ p_thread_runtime(void)
return Yap_unify(ARG1,MkIntTerm(0)); 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) 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("$no_threads", 0, p_no_threads, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$max_threads", 1, p_max_threads, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$max_threads", 1, p_max_threads, SafePredFlag|HiddenPredFlag);
Yap_InitCPred("$nof_threads", 1, p_nof_threads, SafePredFlag|HiddenPredFlag); Yap_InitCPred("$nof_threads", 1, p_nof_threads, SafePredFlag|HiddenPredFlag);

9
Makefile.in
View File

@ -185,10 +185,14 @@ PL_SOURCES= \
$(srcdir)/pl/checker.yap $(srcdir)/pl/chtypes.yap \ $(srcdir)/pl/checker.yap $(srcdir)/pl/chtypes.yap \
$(srcdir)/pl/consult.yap \ $(srcdir)/pl/consult.yap \
$(srcdir)/pl/corout.yap $(srcdir)/pl/debug.yap \ $(srcdir)/pl/corout.yap $(srcdir)/pl/debug.yap \
$(srcdir)/pl/depth_bound.yap \
$(srcdir)/pl/directives.yap \ $(srcdir)/pl/directives.yap \
$(srcdir)/pl/eam.yap \
$(srcdir)/pl/errors.yap $(srcdir)/pl/grammar.yap \ $(srcdir)/pl/errors.yap $(srcdir)/pl/grammar.yap \
$(srcdir)/pl/ground.yap $(srcdir)/pl/init.yap \ $(srcdir)/pl/ground.yap
$(srcdir)/pl/depth_bound.yap $(srcdir)/pl/listing.yap \ $(srcdir)/pl/hacks.yap
$(srcdir)/pl/init.yap \
$(srcdir)/pl/listing.yap \
$(srcdir)/pl/load_foreign.yap \ $(srcdir)/pl/load_foreign.yap \
$(srcdir)/pl/modules.yap $(srcdir)/pl/preds.yap \ $(srcdir)/pl/modules.yap $(srcdir)/pl/preds.yap \
$(srcdir)/pl/profile.yap \ $(srcdir)/pl/profile.yap \
@ -199,7 +203,6 @@ PL_SOURCES= \
$(srcdir)/pl/strict_iso.yap \ $(srcdir)/pl/strict_iso.yap \
$(srcdir)/pl/tabling.yap $(srcdir)/pl/threads.yap \ $(srcdir)/pl/tabling.yap $(srcdir)/pl/threads.yap \
$(srcdir)/pl/utils.yap \ $(srcdir)/pl/utils.yap \
$(srcdir)/pl/eam.yap \
$(srcdir)/pl/yapor.yap $(srcdir)/pl/yio.yap $(srcdir)/pl/yapor.yap $(srcdir)/pl/yio.yap
YAPDOCS=$(srcdir)/docs/yap.tex $(srcdir)/docs/chr.tex \ YAPDOCS=$(srcdir)/docs/yap.tex $(srcdir)/docs/chr.tex \

5
changes-5.1.html
View File

@ -17,6 +17,11 @@ xb
<h2>Yap-5.1.3:</h2> <h2>Yap-5.1.3:</h2>
<ul> <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 <li> FIXED: indexing code could not see end of static clause (obs from
Lisa Torrey).</li> Lisa Torrey).</li>
<li> FIXED: indexing code for dynamic predicates was broken with <li> FIXED: indexing code for dynamic predicates was broken with

116
docs/yap.tex
View File

@ -114,6 +114,7 @@ us to include his text in this document.
Built In Predicates Built In Predicates
* Control:: Controlling the execution of Prolog programs * Control:: Controlling the execution of Prolog programs
* Undefined Procedures:: Handling calls to Undefined Procedures * Undefined Procedures:: Handling calls to Undefined Procedures
* Messages:: Message Handling in YAP
* Testing Terms:: Predicates on Terms * Testing Terms:: Predicates on Terms
* Predicates on Atoms:: Manipulating Atoms * Predicates on Atoms:: Manipulating Atoms
* Predicates on Characters:: Manipulating Characters * Predicates on Characters:: Manipulating Characters
@ -2390,6 +2391,7 @@ may result in incorrect execution.
Built-ins, Debugging, Syntax, Top Built-ins, Debugging, Syntax, Top
* Control:: Controlling the Execution of Prolog Programs * Control:: Controlling the Execution of Prolog Programs
* Undefined Procedures:: Handling calls to Undefined Procedures * Undefined Procedures:: Handling calls to Undefined Procedures
* Messages:: Message Handling in YAP
* Testing Terms:: Predicates on Terms * Testing Terms:: Predicates on Terms
* Predicates on Atoms:: Manipulating Atoms * Predicates on Atoms:: Manipulating Atoms
* Predicates on Characters:: Manipulating Characters * Predicates on Characters:: Manipulating Characters
@ -2835,13 +2837,13 @@ Increase stack size @var{Size} kilobytes.
@end table @end table
@node Undefined Procedures, Testing Terms, Control, Top @node Undefined Procedures, Messages, Control, Top
@section Handling Undefined Procedures @section Handling Undefined Procedures
A predicate in a module is said to be undefined if there are no clauses 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 defining the predicate, and if the predicate has not been declared to be
dynamic. What YAP does when trying to execute undefined predicates can 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 @itemize @bullet
@item By setting an YAP flag, through the @code{yap_flag/2} or @item By setting an YAP flag, through the @code{yap_flag/2} or
@code{set_prolog_flag/2} built-ins. This solution generalizes the @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}. system will execute default action as specified by @code{unknown/2}.
@end table @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 @section Predicates on terms
@table @code @table @code
@ -3966,7 +4074,7 @@ YAP currently ignores these options.
@findex time_file/2 @findex time_file/2
@snindex time_file/2 @snindex time_file/2
@cnindex 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 @var{Time}. @var{Time} is a floating point number expressing the seconds
elapsed since Jan 1, 1970. elapsed since Jan 1, 1970.

65
library/hacks.yap
View File

@ -25,64 +25,13 @@ stack_dump(Max) :-
length(CPs, LCPs), length(CPs, LCPs),
length(Envs, LEnvs), length(Envs, LEnvs),
format(user_error,'~n~n~tStack Dump~t~40+~n~nAddress~tChoiceP~16+ Cur/Next Clause Goal~n',[LCPs,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
View File

@ -45,6 +45,14 @@ true :- 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_input, 512),
'$stream_representation_error'(user_output, 512), '$stream_representation_error'(user_output, 512),
'$stream_representation_error'(user_error, 512), '$stream_representation_error'(user_error, 512),
@ -84,7 +92,7 @@ true :- true.
nb_setval('$lf_verbose',informational), nb_setval('$lf_verbose',informational),
nb_setval('$if_level',0), nb_setval('$if_level',0),
nb_setval('$endif',off), nb_setval('$endif',off),
nb_setval('$consulting_file',user_input), nb_setval('$consulting_file',[]),
nb_setval('$consulting',false), nb_setval('$consulting',false),
nb_setval('$included_file',''). nb_setval('$included_file','').
@ -104,7 +112,7 @@ true :- true.
'$read_vars'(Stream,T,Mod,Pos,V) :- '$read_vars'(Stream,T,Mod,Pos,V) :-
'$read'(true,T,Mod,V,Pos,Err,Stream), '$read'(true,T,Mod,V,Pos,Err,Stream),
(nonvar(Err) -> (nonvar(Err) ->
'$print_message'(error,Err), fail print_message(error,Err), fail
; ;
true true
). ).
@ -135,7 +143,7 @@ true :- true.
; ;
true true
), ),
'$print_message'(informational,prompt(BreakLevel,TraceDebug)), print_message(informational,prompt(BreakLevel,TraceDebug)),
fail. fail.
'$enter_top_level' :- '$enter_top_level' :-
get_value('$top_level_goal',GA), GA \= [], !, get_value('$top_level_goal',GA), GA \= [], !,
@ -227,13 +235,13 @@ true :- true.
'$version' :- '$version' :-
get_value('$version_name',VersionName), get_value('$version_name',VersionName),
'$print_message'(help, version(VersionName)), print_message(help, version(VersionName)),
get_value('$myddas_version_name',MYDDASVersionName), get_value('$myddas_version_name',MYDDASVersionName),
MYDDASVersionName \== [], MYDDASVersionName \== [],
'$print_message'(help, myddas_version(MYDDASVersionName)), print_message(help, myddas_version(MYDDASVersionName)),
fail. fail.
'$version' :- recorded('$version',VersionName,_), '$version' :- recorded('$version',VersionName,_),
'$print_message'(help, VersionName), print_message(help, VersionName),
fail. fail.
'$version'. '$version'.
@ -476,7 +484,7 @@ true :- true.
'$add_env_and_fail' :- fail. '$add_env_and_fail' :- fail.
'$out_neg_answer' :- '$out_neg_answer' :-
( '$undefined'('$print_message'(_,_),prolog) -> ( '$undefined'(print_message(_,_),prolog) ->
'$present_answer'(user_error,"no~n", []) '$present_answer'(user_error,"no~n", [])
; ;
print_message(help,no) print_message(help,no)
@ -530,7 +538,7 @@ true :- true.
fail fail
; ;
C== 10 -> '$add_nl_outside_console', C== 10 -> '$add_nl_outside_console',
( '$undefined'('$print_message'(_,_),prolog) -> ( '$undefined'(print_message(_,_),prolog) ->
format(user_error,'yes~n', []) format(user_error,'yes~n', [])
; ;
print_message(help,yes) print_message(help,yes)

29
pl/consult.yap
View File

@ -234,13 +234,16 @@ use_module(M,F,Is) :-
StartMsg = consulting, StartMsg = consulting,
EndMsg = consulted EndMsg = consulted
), ),
'$print_message'(InfLevel, loading(StartMsg, File)), print_message(InfLevel, loading(StartMsg, File)),
( SkipUnixComments == skip_unix_comments -> ( SkipUnixComments == skip_unix_comments ->
'$skip_unix_comments'(Stream) '$skip_unix_comments'(Stream)
; ;
true true
), ),
'$loop'(Stream,Reconsult), '$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', '$end_consult',
( (
Reconsult = reconsult -> Reconsult = reconsult ->
@ -259,12 +262,9 @@ use_module(M,F,Is) :-
nb_setval('$if_skip_mode',run), nb_setval('$if_skip_mode',run),
% back to include mode! % back to include mode!
nb_setval('$if_level',OldIncludeLevel), nb_setval('$if_level',OldIncludeLevel),
'$current_module'(Mod,OldModule),
'$bind_module'(Mod, UseModule), '$bind_module'(Mod, UseModule),
'$import_to_current_module'(File, ContextModule, Imports), '$import_to_current_module'(File, ContextModule, Imports),
( LC == 0 -> prompt(_,' |: ') ; true), ( 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 ), ( OldMode == off -> '$exit_system_mode' ; true ),
'$exec_initialisation_goals', '$exec_initialisation_goals',
!. !.
@ -346,13 +346,13 @@ use_module(M,F,Is) :-
H0 is heapused, '$cputime'(T0,_), H0 is heapused, '$cputime'(T0,_),
'$default_encoding'(Encoding), '$default_encoding'(Encoding),
( '$open'(Y,'$csult',Stream,0,Encoding), !, ( '$open'(Y,'$csult',Stream,0,Encoding), !,
'$print_message'(Verbosity, loading(including, Y)), print_message(Verbosity, loading(including, Y)),
'$loop'(Stream,Status), '$close'(Stream) '$loop'(Stream,Status), '$close'(Stream)
; ;
'$do_error'(permission_error(input,stream,Y),include(X)) '$do_error'(permission_error(input,stream,Y),include(X))
), ),
H is heapused-H0, '$cputime'(TF,_), T is TF-T0, 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). nb_setval('$included_file',OY).
'$do_startup_reconsult'(X) :- '$do_startup_reconsult'(X) :-
@ -470,7 +470,7 @@ remove_from_path(New) :- '$check_path'(New,Path),
'$add_multifile'(File,Name,Arity,Module) :- '$add_multifile'(File,Name,Arity,Module) :-
recorded('$multifile_defs','$defined'(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) :- '$add_multifile'(File,Name,Arity,Module) :-
recordz('$multifile_defs','$defined'(File,Name,Arity,Module),_), !, recordz('$multifile_defs','$defined'(File,Name,Arity,Module),_), !,
fail. fail.
@ -520,12 +520,6 @@ remove_from_path(New) :- '$check_path'(New,Path),
fail. fail.
'$record_loaded'(_, _). '$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. % 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) :- !, '$find_in_path'(library(File),Opts,NewFile, Call) :- !,
'$dir_separator'(D), '$dir_separator'(D),
atom_codes(A,[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) :- '$find_in_path'(S, Opts, NewFile, Call) :-
S =.. [Name,File], !, S =.. [Name,File], !,
'$dir_separator'(D), '$dir_separator'(D),
@ -755,11 +749,16 @@ absolute_file_name(File,Opts,TrueFileName) :-
recorded('$path',Path,_), recorded('$path',Path,_),
atom_concat([Path,File],PFile). 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) :- '$extend_path_directory'(Name, D, File, Opts, NewFile, Call) :-
user:file_search_path(Name, Dir), user:file_search_path(Name, Dir),
'$extend_pathd'(Dir, D, File, Opts, NewFile, Call). '$extend_pathd'(Dir, D, File, Opts, NewFile, Call).
'$extend_pathd'(Dir, A, File, Opts, NewFile, Call) :- '$extend_pathd'(Dir, A, File, Opts, NewFile, Call) :-
atom(Dir), !, atom(Dir), !,
atom_concat([Dir,A,File],NFile), atom_concat([Dir,A,File],NFile),

42
pl/debug.yap
View File

@ -57,9 +57,9 @@
!, !,
'$do_suspy_predicates_by_name'(NA,S,EM). '$do_suspy_predicates_by_name'(NA,S,EM).
'$suspy_predicates_by_name'(A,spy,M) :- !, '$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) :- '$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) :- '$do_suspy_predicates_by_name'(A,S,M) :-
current_predicate(A,M:T), current_predicate(A,M:T),
@ -81,9 +81,9 @@
'$do_suspy'(S, F, N, T, M) :- '$do_suspy'(S, F, N, T, M) :-
'$undefined'(T,M), !, '$undefined'(T,M), !,
( S = spy -> ( 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) :- '$do_suspy'(S, F, N, T, M) :-
'$system_predicate'(T,M), '$system_predicate'(T,M),
@ -97,27 +97,27 @@
'$do_suspy'(S, F, N, T, M) :- '$do_suspy'(S, F, N, T, M) :-
'$undefined'(T,M), !, '$undefined'(T,M), !,
( S = spy -> ( 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) :- '$do_suspy'(S,F,N,T,M) :-
'$suspy2'(S,F,N,T,M). '$suspy2'(S,F,N,T,M).
'$suspy2'(spy,F,N,T,M) :- '$suspy2'(spy,F,N,T,M) :-
recorded('$spy','$spy'(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) :- !, '$suspy2'(spy,F,N,T,M) :- !,
recorda('$spy','$spy'(T,M),_), recorda('$spy','$spy'(T,M),_),
'$set_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) :- '$suspy2'(nospy,F,N,T,M) :-
recorded('$spy','$spy'(T,M),R), !, recorded('$spy','$spy'(T,M),R), !,
erase(R), erase(R),
'$rm_spy'(T,M), '$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) :- '$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) :- '$pred_being_spied'(G, M) :-
recorded('$spy','$spy'(G,M),_), !. recorded('$spy','$spy'(G,M),_), !.
@ -140,7 +140,7 @@ nospyall.
debug :- debug :-
'$start_debugging'(on), '$start_debugging'(on),
'$print_message'(informational,debug(debug)). print_message(informational,debug(debug)).
'$start_debugging'(Mode) :- '$start_debugging'(Mode) :-
nb_setval('$debug',Mode), nb_setval('$debug',Mode),
@ -149,7 +149,7 @@ debug :-
nodebug :- nodebug :-
nb_setval('$debug',off), nb_setval('$debug',off),
nb_setval('$trace',off), nb_setval('$trace',off),
'$print_message'(informational,debug(off)). print_message(informational,debug(off)).
% %
% remove any debugging info after an abort. % remove any debugging info after an abort.
@ -160,7 +160,7 @@ trace :-
trace :- trace :-
nb_setval('$trace',on), nb_setval('$trace',on),
'$start_debugging'(on), '$start_debugging'(on),
'$print_message'(informational,debug(trace)), print_message(informational,debug(trace)),
'$creep'. '$creep'.
notrace :- notrace :-
@ -183,13 +183,13 @@ leash(X) :-
'$do_error'(type_error(leash_mode,X),leash(X)). '$do_error'(type_error(leash_mode,X),leash(X)).
'$show_leash'(Msg,0) :- '$show_leash'(Msg,0) :-
'$print_message'(Msg,leash([])). print_message(Msg,leash([])).
'$show_leash'(Msg,Code) :- '$show_leash'(Msg,Code) :-
'$check_leash_bit'(Code,0x8,L3,call,LF), '$check_leash_bit'(Code,0x8,L3,call,LF),
'$check_leash_bit'(Code,0x4,L2,exit,L3), '$check_leash_bit'(Code,0x4,L2,exit,L3),
'$check_leash_bit'(Code,0x2,L1,redo,L2), '$check_leash_bit'(Code,0x2,L1,redo,L2),
'$check_leash_bit'(Code,0x1,[],fail,L1), '$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'(Code,Bit,L0,_,L0) :- Bit /\ Code =:= 0, !.
'$check_leash_bit'(_,_,L0,Name,[Name|L0]). '$check_leash_bit'(_,_,L0,Name,[Name|L0]).
@ -224,12 +224,12 @@ leash(X) :-
debugging :- debugging :-
( nb_getval('$debug',on) -> ( 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), 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), get_value('$leash',Leash),
'$show_leash'(help,Leash). '$show_leash'(help,Leash).
@ -667,7 +667,7 @@ debugging :-
( (
History == [] History == []
-> ->
'$print_message'(help, ancestors([])) print_message(help, ancestors([]))
; ;
'$show_ancestors'(History,HowMany), '$show_ancestors'(History,HowMany),
nl(user_error) nl(user_error)
@ -708,8 +708,8 @@ debugging :-
format(user_error,'! g execute goal~n', []). format(user_error,'! g execute goal~n', []).
'$ilgl'(C) :- '$ilgl'(C) :-
'$print_message'(warning, trace_command(C)), print_message(warning, trace_command(C)),
'$print_message'(help, trace_help), print_message(help, trace_help),
fail. fail.
'$skipeol'(10) :- !. '$skipeol'(10) :- !.

790
pl/errors.yap
View File

@ -11,8 +11,12 @@
* File: errors.yap * * File: errors.yap *
* comments: error messages for 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 $ * $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 * Revision 1.83 2007/11/26 23:43:10 vsc
* fixes to support threads and assert correctly, even if inefficiently. * fixes to support threads and assert correctly, even if inefficiently.
* *
@ -172,8 +176,8 @@
*************************************************************************/ *************************************************************************/
'$do_error'(Type,Message) :- '$do_error'(Type,Message) :-
'$current_stack'(local_sp(_,Envs,CPs)), '$current_stack'(local_sp(_,CP,Envs,CPs)),
throw(error(Type,[Message|local_sp(Message,Envs,CPs)])). throw(error(Type,[Message|local_sp(Message,CP,Envs,CPs)])).
'$Error'(E) :- '$Error'(E) :-
'$LoopError'(E,top). '$LoopError'(E,top).
@ -195,741 +199,75 @@
throw('$abort'). throw('$abort').
'$process_error'(error(Msg, Where), _) :- !, '$process_error'(error(Msg, Where), _) :- !,
'$set_fpu_exceptions', '$set_fpu_exceptions',
'$print_message'(error,error(Msg, Where)). print_message(error,error(Msg, Where)).
'$process_error'(Throw, _) :- '$process_error'(Throw, _) :-
print_message(error,Throw). print_message(error,Throw).
print_message(Level, Mss) :- print_message(force(_Severity), Msg) :- !,
'$print_message'(Level, Mss).
'$print_message'(force(_Severity), Msg) :- !,
print(user_error,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), nonvar(Severity), nonvar(Msg),
\+ '$undefined'(portray_message(Severity, Msg), user), '$notrace'(user:portray_message(Severity, Msg)), !.
user:portray_message(Severity, Msg), !. % This predicate has more hooks than a pirate ship!
'$print_message'(error,error(Msg,Info)) :- print_message(Severity, Term) :-
( 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) -> (
'$notrace'(user:generate_message_hook(Term, [], Lines)) ->
true true
; ;
format(user_error, '% ~a~n', [TraceDebug]) '$notrace'(prolog:message(Term, Lines, [])) ->
true
;
'$message':generate_message(Term, Lines, [])
) )
; -> ( nonvar(Term),
( '$notrace'(user:message_hook(Term, Severity, Lines))
var(TraceDebug) -> -> !
format(user_error, '% ~d~n', [BreakLevel]) ; !, '$print_system_message'(Term, Severity, Lines)
;
format(user_error, '% ~d,~a~n', [BreakLevel,TraceDebug])
) )
). ).
'$do_informational_message'(debug) :- !, print_message(_, error(syntax_error(_,between(_,L,_),_,_,_,_),_)) :- !,
format(user_error, '% [debug]~n', []). format(user_error,'SYNTAX ERROR close to ~d~n',[L]).
'$do_informational_message'(trace) :- !, print_message(_, loading(A, F)) :- !,
format(user_error, '% [trace]~n', []). format(user_error,' % ~a ~a~n',[A,F]).
'$do_informational_message'(M) :- print_message(_, loaded(A, F, _, Time, Space)) :- !,
format(user_error,'% ', []), format(user_error,' % ~a ~a ~d bytes in ~d msecs~n',[F,A,Space,Time]).
'$do_print_message'(M), print_message(_, Term) :-
format(user_error,'~n', []). format(user_error,'~q~n',[Term]).
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, % print_system_message(+Term, +Level, +Lines)
'$do_print_message'(format(Msg, Args)) :- !, %
format(user_error,Msg,Args). % Print the message if the user did not intecept the message.
'$do_print_message'(ancestors([])) :- !, % The first is used for errors and warnings that can be related
format(user_error,'There are no ancestors.', % to source-location. Note that syntax errors have their own
[]). % source-location and should therefore not be handled this way.
'$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).
'$write_svs'([H]) :- !, write(user_error,' '), '$write_svs1'([H]). '$print_system_message'(_, silent, _) :- !.
'$write_svs'(SVs) :- write(user_error,'s '), '$write_svs1'(SVs). '$print_system_message'(_, informational, _) :-
current_prolog_flag(verbose, silent), !.
'$write_svs1'([H]) :- !, '$print_system_message'(_, banner, _) :-
'$write_str_in_stderr'(H). current_prolog_flag(verbose, silent), !.
'$write_svs1'([H|T]) :- '$print_system_message'(Term, Level, Lines) :-
'$write_str_in_stderr'(H), Term = error(syntax_error(_,_,_,_,_,_),_), !,
write(user_error,','), flush_output(user_output),
'$write_svs1'(T). flush_output(user_error),
'$message':prefix(Level, LinePrefix, Stream, _, Lines), !,
'$write_str_in_stderr'([]). % make sure we don't give a PC.
'$write_str_in_stderr'([C|T]) :- print_message_lines(Stream, LinePrefix, Lines).
put(user_error,C), '$print_system_message'(Term, Level, Lines) :-
'$write_str_in_stderr'(T). '$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]).

204
pl/hacks.yap Normal file
View File

@ -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
View File

@ -91,6 +91,12 @@ system_mode(verbose,off) :- set_value('$verbose',off).
:- ['corout.yap', :- ['corout.yap',
'arrays.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). yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- '$change_type_of_char'(36,7). % Make $ a symbol character :- '$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. :- 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. % 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). :- system_mode(verbose,on).
:- multifile prolog:message/3.
:- dynamic prolog:message/3.
:- module(user). :- module(user).
:- multifile goal_expansion/3. :- multifile goal_expansion/3.
@ -142,6 +143,10 @@ yap_hacks:cut_by(CP) :- '$$cut_by'(CP).
:- dynamic file_search_path/2. :- dynamic file_search_path/2.
:- multifile generate_message_hook/3.
:- dynamic generate_message_hook/3.
file_search_path(library, Dir) :- file_search_path(library, Dir) :-
library_directory(Dir). library_directory(Dir).
file_search_path(swi, Home) :- file_search_path(swi, Home) :-

486
pl/messages.yap Normal file
View File

@ -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) }.

3
pl/modules.yap
View File

@ -459,7 +459,8 @@ module(N) :-
'$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L). '$not_in_vars'(V,[X|L]) :- X\==V, '$not_in_vars'(V,L).
current_module(Mod) :- current_module(Mod) :-
'$all_current_modules'(Mod). '$all_current_modules'(Mod),
\+ '$system_module'(Mod).
current_module(Mod,TFN) :- current_module(Mod,TFN) :-
'$all_current_modules'(Mod), '$all_current_modules'(Mod),

6
pl/preds.yap
View File

@ -665,7 +665,7 @@ abolish(X) :-
'$access_yap_flags'(8, 2), % only do this in sicstus mode '$access_yap_flags'(8, 2), % only do this in sicstus mode
'$undefined'(G, Module), '$undefined'(G, Module),
functor(G,Name,Arity), 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 % I cannot allow modifying static procedures in YAPOR
% this code has to be here because of abolish/2 % this code has to be here because of abolish/2
'$abolishs'(G, Module) :- '$abolishs'(G, Module) :-
@ -974,3 +974,7 @@ current_key(A,K) :-
% do nothing for now. % do nothing for now.
'$noprofile'(_, _). '$noprofile'(_, _).
'$notrace'(G) :-
\+ '$undefined'(G, prolog),
call(G).

3
pl/threads.yap
View File

@ -26,7 +26,8 @@
:- initialization('$init_thread0'). :- initialization('$init_thread0').
'$init_thread0' :- '$init_thread0' :-
no_threads, !. no_threads, !,
recorda('$thread_alias', [0|main], _).
'$init_thread0' :- '$init_thread0' :-
'$record_thread_info'(0, main, [0, 0, 0], false, '$init_thread0'), '$record_thread_info'(0, main, [0, 0, 0], false, '$init_thread0'),
recorda('$thread_defaults', [0, 0, 0, false], _), recorda('$thread_defaults', [0, 0, 0, false], _),

4
pl/utils.yap
View File

@ -528,7 +528,7 @@ unknown(V0,V) :-
'$unknown_warning'(Mod:Goal) :- '$unknown_warning'(Mod:Goal) :-
functor(Goal,Name,Arity), functor(Goal,Name,Arity),
'$program_continuation'(PMod,PName,PAr), '$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. fail.
%%% Some "dirty" predicates %%% Some "dirty" predicates
@ -809,7 +809,7 @@ version(T) :-
halt(X) :- '$halt'(X). halt(X) :- '$halt'(X).
halt :- halt :-
'$print_message'(informational, halt), print_message(informational, halt),
'$halt'(0). '$halt'(0).
halt(X) :- halt(X) :-

4
pl/yio.yap
View File

@ -387,7 +387,7 @@ told :- current_output(Stream), '$close'(Stream), set_output(user).
read(T) :- read(T) :-
'$read'(false,T,_,_,_,Err), '$read'(false,T,_,_,_,Err),
(nonvar(Err) -> (nonvar(Err) ->
'$print_message'(error,Err), fail print_message(error,Err), fail
; ;
true true
). ).
@ -395,7 +395,7 @@ read(T) :-
read(Stream,T) :- read(Stream,T) :-
'$read'(false,T,_,_,_,Err,Stream), '$read'(false,T,_,_,_,Err,Stream),
(nonvar(Err) -> (nonvar(Err) ->
'$print_message'(error,Err), fail print_message(error,Err), fail
; ;
true true
). ).