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

fix debugger messages

Browse Source 
debug imported mnodules
fix yap2swi in win32
fixes for solaris


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@505 b08c6af1-5177-4d33-ba66-4b1c6b8b522a
This commit is contained in:
vsc 2002-06-01 01:46:06 +00:00
parent 577298ac0b
commit 1ec4c2acaf
10 changed files with 183 additions and 121 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
C/eval.c
View File

@ -27,7 +27,7 @@ static char SccsId[] = "%W% %G%";
#include "Heap.h" #include "Heap.h"
#include "eval.h" #include "eval.h"
yap_error_number YAP_matherror = NO_ERROR; yap_error_number YAP_matherror = YAP_NO_ERROR;
#define E_FUNC blob_type #define E_FUNC blob_type
#define E_ARGS arith_retptr o #define E_ARGS arith_retptr o

2
C/iopreds.c
View File

@ -28,7 +28,6 @@ static char SccsId[] = "%W% %G%";
#include "Yatom.h" #include "Yatom.h"
#include "Heap.h" #include "Heap.h"
#include "yapio.h" #include "yapio.h"
#include "iopreds.h"
#include <stdlib.h> #include <stdlib.h>
#if HAVE_STDARG_H #if HAVE_STDARG_H
#include <stdarg.h> #include <stdarg.h>
@ -79,6 +78,7 @@ static char SccsId[] = "%W% %G%";
#define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR) #define S_ISDIR(x) (((x)&_S_IFDIR)==_S_IFDIR)
#endif #endif
#endif #endif
#include "iopreds.h"
STATIC_PROTO (Int PlIOError, (yap_error_number, Term, char *)); STATIC_PROTO (Int PlIOError, (yap_error_number, Term, char *));
STATIC_PROTO (int FilePutc, (int, int)); STATIC_PROTO (int FilePutc, (int, int));

8
C/save.c
View File

@ -18,12 +18,14 @@
static char SccsId[] = "@(#)save.c 1.3 3/15/90"; static char SccsId[] = "@(#)save.c 1.3 3/15/90";
#endif #endif
#if _MSC_VER || defined(__MINGW32__)
#include <windows.h>
#endif
#include "absmi.h" #include "absmi.h"
#include "alloc.h" #include "alloc.h"
#include "yapio.h" #include "yapio.h"
#include "sshift.h" #include "sshift.h"
#include "Foreign.h" #include "Foreign.h"
#include "iopreds.h"
#if HAVE_STRING_H #if HAVE_STRING_H
#include <string.h> #include <string.h>
#endif #endif
@ -46,12 +48,12 @@ static char SccsId[] = "@(#)save.c 1.3 3/15/90";
#ifdef HAVE_SYS_STAT_H #ifdef HAVE_SYS_STAT_H
#include <sys/stat.h> #include <sys/stat.h>
#endif #endif
#include "iopreds.h"
/********* hack for accesing several kinds of terms. Should be cleaned **/ /********* hack for accesing several kinds of terms. Should be cleaned **/
#define AbsTerm(V) ((Term) (V))
extern char StartUpFile[]; extern char StartUpFile[];
static char end_msg[256] ="*** End of YAP saved state *****"; static char end_msg[256] ="*** End of YAP saved state *****";

4
docs/yap.tex
View File

@ -11919,9 +11919,11 @@ prompt on Call and Redo
prompt on Call prompt on Call
@item off @item off
never prompt never prompt
@item none
never prompt, same as @code{off}
@end table @end table
@noindent @noindent
The initial leashing mode is half. The initial leashing mode is @code{full}.
@noindent @noindent

13
library/yap2swi/yap2swi.c
View File

@ -185,6 +185,11 @@ buf_writer(int c)
*bf++ = c; *bf++ = c;
} }
#if !HAVE_SNPRINTF
#define snprintf(X,Y,Z,A) sprintf(X,Z,A)
#endif
X_API int PL_get_chars(term_t l, char **sp, unsigned flags) X_API int PL_get_chars(term_t l, char **sp, unsigned flags)
{ {
Term t = YapGetFromSlot(l); Term t = YapGetFromSlot(l);
@ -937,12 +942,12 @@ PL_exception(qid_t q)
} }
X_API int X_API int
PL_initialise(int argc, char **argv, char **environ) PL_initialise(int myargc, char **myargv, char **myenviron)
{ {
yap_init_args init_args; yap_init_args init_args;
init_args.Argv = argv; init_args.Argv = myargv;
init_args.Argc = argc; init_args.Argc = myargc;
init_args.SavedState = "startup"; init_args.SavedState = "startup";
init_args.HeapSize = 0; init_args.HeapSize = 0;
init_args.StackSize = 0; init_args.StackSize = 0;
@ -1102,7 +1107,7 @@ X_API int Sprintf(char *format,...)
int WINAPI PROTO(win_yap2swi, (HANDLE, DWORD, LPVOID)); int WINAPI PROTO(win_yap2swi, (HANDLE, DWORD, LPVOID));
int WINAPI win_sys(HANDLE hinst, DWORD reason, LPVOID reserved) int WINAPI win_yap2swi(HANDLE hinst, DWORD reason, LPVOID reserved)
{ {
switch (reason) switch (reason)
{ {

2
library/yap2swi/yap2swi.h
View File

@ -176,7 +176,7 @@ extern X_API void PL_close_query(qid_t);
extern X_API term_t PL_exception(qid_t); extern X_API term_t PL_exception(qid_t);
extern X_API int PL_call_predicate(module_t, int, predicate_t, term_t); extern X_API int PL_call_predicate(module_t, int, predicate_t, term_t);
extern X_API int PL_call(term_t, module_t); extern X_API int PL_call(term_t, module_t);
extern X_API void PL_register_extensions(PL_extension *e); extern X_API void PL_register_extensions(PL_extension *);
extern X_API int Sprintf(char *,...); extern X_API int Sprintf(char *,...);

4
m4/Yap.h.m4
View File

@ -10,7 +10,7 @@
* File: Yap.h.m4 * * File: Yap.h.m4 *
* mods: * * mods: *
* comments: main header file for YAP * * comments: main header file for YAP *
* version: $Id: Yap.h.m4,v 1.27 2002-05-28 17:28:25 vsc Exp $ * * version: $Id: Yap.h.m4,v 1.28 2002-06-01 01:46:06 vsc Exp $ *
*************************************************************************/ *************************************************************************/
#include "config.h" #include "config.h"
@ -386,7 +386,7 @@ extern sigjmp_buf RestartEnv; /* used to restart after an abort */
/* Types of Errors */ /* Types of Errors */
typedef enum { typedef enum {
NO_ERROR, YAP_NO_ERROR,
FATAL_ERROR, FATAL_ERROR,
INTERNAL_ERROR, INTERNAL_ERROR,
PURE_ABORT, PURE_ABORT,

2
misc/yap.def
View File

@ -80,4 +80,6 @@ YapHalt
YapTopOfLocalStack YapTopOfLocalStack
YapPredicate YapPredicate
YapCurrentModule YapCurrentModule
YapPredicateInfo
YapUserCPredicateWithArgs

193
pl/debug.yap
View File

@ -35,49 +35,78 @@
'$suspy'(S,P,M). '$suspy'(S,P,M).
'$suspy'([],_,_) :- !. '$suspy'([],_,_) :- !.
'$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ). '$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ).
'$suspy'(F/N,S,M) :- !, functor(T,F,N), '$suspy'(F/N,S,M) :- !,
( '$system_predicate'(T,M) ->
throw(error(permission_error(access,private_procedure,F/N),spy(F/N,S)));
'$undefined'(T,M) ->
throw(error(existence_error(procedure,F/N),spy(F/N,S)));
'$suspy2'(S,F,N,T,M) ).
'$suspy'(A,S,_) :- \+ atom(A) , !,
throw(error(type_error(predicate_indicator,A),spy(A,S))).
'$suspy'(A,spy,M) :- '$noclausesfor'(A,M), !,
throw(error(existence_error(procedure,A),spy(A))).
'$suspy'(A,nospy,M) :- '$noclausesfor'(A,M), !,
throw(error(existence_error(procedure,A),nospy(A))).
'$suspy'(A,S,M) :- current_predicate(A,M:T),
\+ '$undefined'(T,M), \+ '$system_predicate'(T,M),
functor(T,F,N), functor(T,F,N),
'$suspy2'(S,F,N,T,M). '$do_suspy'(S, F, N, T, M).
'$suspy'(A,S,M) :- atom(A), !,
'$suspy_predicates_by_name'(A,S,M).
'$suspy'(P,spy,M) :- !,
throw(error(domain_error(predicate_spec,P)),spy(M:P)).
'$suspy'(P,nospy,M) :-
throw(error(domain_error(predicate_spec,P)),nospy(M:P)).
'$noclausesfor'(A,M) :- current_predicate(A,M:T), '$suspy_predicates_by_name'(A,S,M) :-
\+ '$undefined'(T,M) , \+ '$system_predicate'(T,M) , % just check one such predicate exists
!, fail . (
'$noclausesfor'(_,_). current_predicate(A,M:_)
;
'$recorded'('$import','$import'(EM,M,A,_),_)
),
!,
'$do_suspy_predicates_by_name'(A,S,M).
'$suspy_predicates_by_name'(A,spy,M) :- !,
'$print_message'(warning,no_match(spy(M:A))).
'$suspy_predicates_by_name'(A,nospy,M) :-
'$print_message'(warning,no_match(nospy(M:A))).
'$do_suspy_predicates_by_name'(A,S,M) :-
current_predicate(A,M:T),
functor(T,A,N),
'$do_suspy'(S, A, N, T, M).
'$do_suspy_predicates_by_name'(A, S, M) :-
'$recorded'('$import','$import'(EM,M,A,N),_), !,
functor(T,A,N),
'$do_suspy'(S, A, N, T, EM).
%
% protect against evil arguments.
%
'$do_suspy'(S, F, N, T, M) :-
'$recorded'('$import','$import'(EM,M,F,N),_), !,
'$do_suspy'(S, F, N, T, EM).
'$do_suspy'(S, F, N, T, M) :-
'$undefined'(T,M), !,
( S = spy ->
'$print_message'(warning,no_match(spy(M:F/N)))
;
'$print_message'(warning,no_match(nospy(M:F/N)))
).
'$do_suspy'(S, F, N, T, M) :-
'$system_predicate'(T,M),
( S = spy ->
throw(error(permission_error(access,private_procedure,T),spy(M:F/N)))
;
throw(error(permission_error(access,private_procedure,T),nospy(M:F/N)))
).
'$do_suspy'(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),_), !,
'$format'(user_error, "[ Warning: there is already a spy point on ~w:~w/~w ]~n",[M,F,N]). '$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) :- !,
'$warn_if_undef'(T,F,N,M),
'$recorda'('$spy','$spy'(T,M),_), '$recorda'('$spy','$spy'(T,M),_),
'$set_value'('$spypoint_added', true), '$set_value'('$spypoint_added', true),
'$set_spy'(T,M), '$set_spy'(T,M),
'$format'(user_error,"[ Spy point set on ~w:~w/~w ]~n", [M,F,N]). '$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),
'$format'(user_error,"[ Spy point on ~w:~w/~w removed ]~n", [M,F,N]). '$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) :-
'$format'(user_error,"[ Warning: there is no spy point on ~w:~w/~w ]~n", [M,F,N]). '$print_message'(informational,breakp(no,breakpoint_for,M:F/N)).
'$warn_if_undef'(T,F,N,M) :- '$undefined'(T,M), !,
write(user_error,'[ Warning: you have no clauses for '),
write(user_error,M:F/N), write(user_error,' ]'), nl(user_error).
'$warn_if_undef'(_,_,_,_).
'$pred_being_spied'(G, M) :- '$pred_being_spied'(G, M) :-
'$recorded'('$spy','$spy'(G,M),_), !. '$recorded'('$spy','$spy'(G,M),_), !.
@ -101,17 +130,18 @@ nospyall.
% debug mode -> debug flag = 1 % debug mode -> debug flag = 1
debug :- '$get_value'(debug,1), !. debug :- '$get_value'(debug,1), !.
debug :- '$set_value'(debug,1), write(user_error,'[ Debug mode on ]'), nl(user_error). debug :- '$set_value'(debug,1),
'$print_message'(informational,debug(debug)).
nodebug :- nospyall, nodebug :- nospyall,
'$set_value'(debug,0), '$set_value'(debug,0),
'$set_value'('$trace',0), '$set_value'('$trace',0),
'$set_yap_flags'(10,0), '$set_yap_flags'(10,0),
'$format'(user_error,"[ Debug mode off ]~n",[]). '$print_message'(informational,debug(off)).
trace :- '$get_value'('$trace',1), !. trace :- '$get_value'('$trace',1), !.
trace :- trace :-
'$format'(user_error,"[ Trace mode on ]~n",[]), '$print_message'(informational,debug(trace)),
'$set_value'('$trace',1), '$set_value'('$trace',1),
'$set_value'(debug,1), '$set_value'(debug,1),
'$set_value'(spy_sl,0), '$set_value'(spy_sl,0),
@ -122,7 +152,7 @@ trace :-
notrace :- notrace :-
'$set_value'('$trace',0), '$set_value'('$trace',0),
'$set_value'(debug,0), '$set_value'(debug,0),
'$format'(user_error,"[ Trace and Debug mode off ]",[]). '$print_message'(informational,debug(off)).
/*----------------------------------------------------------------------------- /*-----------------------------------------------------------------------------
@ -133,37 +163,34 @@ notrace :-
leash(X) :- var(X), leash(X) :- var(X),
throw(error(instantiation_error,leash(X))). throw(error(instantiation_error,leash(X))).
leash(X) :- '$leashcode'(X,Code), leash(X) :-
'$leashcode'(X,Code),
'$set_value'('$leash',Code), '$set_value'('$leash',Code),
'$show_leash'(Code), !. '$show_leash'(informational,Code), !.
leash(X) :- leash(X) :-
throw(error(type_error(leash_mode,X),leash(X))). throw(error(type_error(leash_mode,X),leash(X))).
'$show_leash'(0) :- write(user_error,'[ No leashing ]'), nl(user_error). '$show_leash'(Msg,0) :-
'$show_leash'(L) :- '$print_message'(Msg,leash([])).
'$leashcode'(Code,L), '$show_leash'(Msg,Code) :-
write(user_error,'[ Leashing set to '), write(user_error,Code), '$check_leash_bit'(Code,2'1000,L3,call,LF),
write(user_error,' ('), '$check_leash_bit'(Code,2'0100,L2,exit,L3),
'$show_leash_bit'(WasWritten,2'1000,L,call), '$check_leash_bit'(Code,2'0010,L1,redo,L2),
'$show_leash_bit'(WasWritten,2'0100,L,exit), '$check_leash_bit'(Code,2'0001,[],fail,L1),
'$show_leash_bit'(WasWritten,2'0010,L,redo), '$print_message'(Msg,leash(LF)).
'$show_leash_bit'(WasWritten,2'0001,L,fail),
write(user_error,') ]'), nl(user_error).
'$show_leash_bit'(_,Bit,Code,_) :- Bit /\ Code =:= 0, !. '$check_leash_bit'(Code,Bit,L0,_,L0) :- Bit /\ Code =:= 0, !.
'$show_leash_bit'(Was,_,_,Name) :- var(Was), !, '$check_leash_bit'(_,_,L0,Name,[Name|L0]).
Was = yes, write(user_error,Name).
'$show_leash_bit'(_,_,_,Name) :-
write(user_error,','), write(user_error,Name).
'$leashcode'(full,2'1111) :- !. '$leashcode'(full,2'1111) :- !.
'$leashcode'(on,2'1111) :- !. '$leashcode'(on,2'1111) :- !.
'$leashcode'(half,2'1010) :- !. '$leashcode'(half,2'1010) :- !.
'$leashcode'(loose,2'1000) :- !. '$leashcode'(loose,2'1000) :- !.
'$leashcode'(off,2'0000) :- !. '$leashcode'(off,2'0000) :- !.
'$leashcode'(none,2'0000) :- !.
%'$leashcode'([L|M],Code) :- !, '$leashcode_list'([L|M],Code). %'$leashcode'([L|M],Code) :- !, '$leashcode_list'([L|M],Code).
'$leashcode'([L|M],Code) :- !, ( var(Code) -> '$list2Code'([L|M],Code) '$leashcode'([L|M],Code) :- !,
; '$code2List'(Code,[L|M]) ). '$list2Code'([L|M],Code).
'$leashcode'(N,N) :- integer(N), N >= 0, N =< 2'1111. '$leashcode'(N,N) :- integer(N), N >= 0, N =< 2'1111.
'$list2Code'(V,_) :- var(V), !, '$list2Code'(V,_) :- var(V), !,
@ -176,16 +203,6 @@ leash(X) :-
'$list2Code'([redo|L],N) :- '$list2Code'(L,N1), N is 2'0010 + N1. '$list2Code'([redo|L],N) :- '$list2Code'(L,N1), N is 2'0010 + N1.
'$list2Code'([fail|L],N) :- '$list2Code'(L,N1), N is 2'0001 + N1. '$list2Code'([fail|L],N) :- '$list2Code'(L,N1), N is 2'0001 + N1.
'$code2List'(0,[]) :- !.
'$code2List'(N,[call|L]) :- X is N /\ 2'1000, X \= 0, !,
M is N-X, '$code2List'(M,L).
'$code2List'(N,[exit|L]) :- X is N /\ 2'0100, X \= 0, !,
M is N-X, '$code2List'(M,L).
'$code2List'(N,[redo|L]) :- X is N /\ 2'0010, X \= 0, !,
M is N-X, '$code2List'(M,L).
'$code2List'(N,[fail|L]) :- X is N /\ 2'0001, X \= 0, !,
M is N-X, '$code2List'(M,L).
/*----------------------------------------------------------------------------- /*-----------------------------------------------------------------------------
debugging debugging
@ -193,29 +210,15 @@ leash(X) :-
-----------------------------------------------------------------------------*/ -----------------------------------------------------------------------------*/
debugging :- debugging :-
'$get_value'(debug,1) -> ( '$get_value'(debug,1) ->
write(user_error,'[ Debug mode is switched on ]') , '$print_message'(help,debug(debug))
nl(user_error),
'$debugging_mode'
; ;
write(user_error,'[ Debug mode is switched off ]') , '$print_message'(help,debug(off))
nl(user_error) ),
. findall(M:(N/A),('$recorded'('$spy','$spy'(T,M),_),functor(T,N,A)),L),
'$print_message'(help,breakpoints(L)),
'$debugging_mode' :-
( '$recorded'('$spy',_,_) -> '$show_spies' ;
write(user_error,'[ Warning: there are no spy-points set ]') ,
nl(user_error) ),
'$get_value'('$leash',Leash), '$get_value'('$leash',Leash),
'$show_leash'(Leash). '$show_leash'(help,Leash).
'$show_spies' :-
write(user_error,'[ Spy points set on :'), nl(user_error),
( '$recorded'('$spy','$spy'(T,M),_), functor(T,F,N),
write(user_error,' '),write(user_error,M:F/N),nl(user_error),
fail ;
write(user_error,' ]'), nl(user_error) ).
/*----------------------------------------------------------------------------- /*-----------------------------------------------------------------------------
@ -918,18 +921,18 @@ debugging :-
'$action_help' :- '$action_help' :-
format(user_error,"newline creep a abort~n", []), '$format'(user_error,"newline creep a abort~n", []),
format(user_error,"c creep e exit~n", []), '$format'(user_error,"c creep e exit~n", []),
format(user_error,"f fail h help~n", []), '$format'(user_error,"f fail h help~n", []),
format(user_error,"l leap r retry~n", []), '$format'(user_error,"l leap r retry~n", []),
format(user_error,"s skip t fastskip~n", []), '$format'(user_error,"s skip t fastskip~n", []),
format(user_error,"q quasiskip k quasileap~n", []), '$format'(user_error,"q quasiskip k quasileap~n", []),
format(user_error,"b break n no debug~n", []), '$format'(user_error,"b break n no debug~n", []),
format(user_error,"p print d display~n", []), '$format'(user_error,"p print d display~n", []),
format(user_error,"<D depth D < full term~n", []), '$format'(user_error,"<D depth D < full term~n", []),
format(user_error,"+ spy this - nospy this~n", []), '$format'(user_error,"+ spy this - nospy this~n", []),
format(user_error,"^ view subg ^^ view using~n", []), '$format'(user_error,"^ view subg ^^ view using~n", []),
format(user_error,"! g execute goal~n"). '$format'(user_error,"! g execute goal~n").
'$ilgl'(C) :- '$skipeol'(C), write(user_error,'[ Illegal option. Use h for help. ]'), '$ilgl'(C) :- '$skipeol'(C), write(user_error,'[ Illegal option. Use h for help. ]'),
nl(user_error), fail. nl(user_error), fail.

68
pl/errors.yap
View File

@ -53,35 +53,80 @@ print_message(Level, Mss) :-
'$format'(user_error,"[ No handler for error ~w ]~n", [Throw]). '$format'(user_error,"[ No handler for error ~w ]~n", [Throw]).
'$print_message'(informational,M) :- '$print_message'(informational,M) :-
( '$get_value'('$verbose',on) -> ( '$get_value'('$verbose',on) ->
'$do_print_message'(M) ; '$do_informational_message'(M) ;
true true
). ).
'$print_message'(warning,M) :- '$print_message'(warning,M) :-
'$do_print_message'(M). '$format'(user_error, "[ ", []),
'$do_print_message'(M),
'$format'(user_error, " ]~n", []).
'$print_message'(help,M) :- '$print_message'(help,M) :-
'$format'(user_error,"help on ~p",[M]). '$do_print_message'(M),
'$format'(user_error, "~n", []).
'$do_print_message'(loading(_,user)) :- !. '$do_informational_message'(loading(_,user)) :- !.
'$do_print_message'(loading(What,AbsoluteFileName)) :- !, '$do_informational_message'(loading(What,AbsoluteFileName)) :- !,
'$show_consult_level'(LC), '$show_consult_level'(LC),
'$format'(user_error, "~*|[ ~a ~a... ]~n", [LC, What, AbsoluteFileName]). '$format'(user_error, "~*|[ ~a ~a... ]~n", [LC, What, AbsoluteFileName]).
'$do_print_message'(loaded(_,user,_,_,_)) :- !. '$do_informational_message'(loaded(_,user,_,_,_)) :- !.
'$do_print_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !, '$do_informational_message'(loaded(What,AbsoluteFileName,Mod,Time,Space)) :- !,
'$show_consult_level'(LC0), '$show_consult_level'(LC0),
LC is LC0+1, LC is LC0+1,
'$format'(user_error, "~*|[ ~a ~a in module ~a, ~d msec ~d bytes ]~n", [LC, What, AbsoluteFileName,Mod,Time,Space]). '$format'(user_error, "~*|[ ~a ~a in module ~a, ~d msec ~d bytes ]~n", [LC, What, AbsoluteFileName,Mod,Time,Space]).
'$do_informational_message'(M) :-
'$format'("[ ", []),
'$do_print_message'(M),
'$format'(" ]~n", []).
%message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !, %message(loaded(Past,AbsoluteFileName,user,Msec,Bytes), Prefix, Suffix) :- !,
'$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)) :- !, '$do_print_message'(debug(trace)) :- !,
'$format'(user_error,"[ The debugger will first creep -- showing everything (trace) ]~n",[]). '$format'(user_error,"Trace mode on.",[]).
'$do_print_message'('$format'(Msg, Args)) :- !, '$do_print_message'('$format'(Msg, Args)) :- !,
'$format'(user_error,Msg,Args). '$format'(user_error,Msg,Args).
'$do_print_message'(import(Pred,To,From,private)) :- '$do_print_message'(import(Pred,To,From,private)) :- !,
'$format'(user_error,"importing private predicate ~w:~w to ~w", '$format'(user_error,"Importing private predicate ~w:~w to ~w.",
[From,Pred,To]). [From,Pred,To]).
'$do_print_message'(no_match(P)) :- !,
'$format'(user_error,"No matching predicate for ~w.",
[P]).
'$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'(leash([])) :- !,
'$format'(user_error,"No leashing.",
[M,F,N]).
'$do_print_message'(leash([A|B])) :- !,
'$format'(user_error,"Leashing set to ~w.",
[[A|B]]).
'$do_print_message'(breakpoints([])) :- !,
'$format'(user_error,"There are no spy-points set.",
[M,F,N]).
'$do_print_message'(breakpoints(L)) :- !,
'$format'(user_error,"Spy-points set on:", []),
'$print_list_of_preds'(L).
'$do_print_message'(Messg) :- '$do_print_message'(Messg) :-
'$format'(user_error,"~q",Messg). '$format'(user_error,"~q",Messg).
'$print_list_of_preds'([]).
'$print_list_of_preds'([P|L]) :-
'$format'(user_error,"~n ~w",[P]),
'$print_list_of_preds'(L).
'$output_error_message'(context_error(Goal,Who),Where) :- '$output_error_message'(context_error(Goal,Who),Where) :-
'$format'(user_error,"[ CONTEXT ERROR- ~w: ~w appeared in ~w ]~n", '$format'(user_error,"[ CONTEXT ERROR- ~w: ~w appeared in ~w ]~n",
[Goal,Who,Where]). [Goal,Who,Where]).
@ -142,6 +187,9 @@ print_message(Level, Mss) :-
'$output_error_message'(domain_error(operator_specifier,N), Where) :- '$output_error_message'(domain_error(operator_specifier,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid operator specifier ]~n", '$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid operator specifier ]~n",
[Where,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) :- '$output_error_message'(domain_error(read_option,N), Where) :-
'$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid option to read ]~n", '$format'(user_error,"[ DOMAIN ERROR- ~w: ~w invalid option to read ]~n",
[Where,N]). [Where,N]).