1401 lines
39 KiB
Prolog
1401 lines
39 KiB
Prolog
/*************************************************************************
|
|
* *
|
|
* YAP Prolog *
|
|
* *
|
|
* Yap Prolog was developed at NCCUP - Universidade do Porto *
|
|
* *
|
|
* Copyright L.Damas, V.S.Costa and Universidade do Porto 1985-1997 *
|
|
* *
|
|
**************************************************************************
|
|
* *
|
|
* File: debug.pl *
|
|
* Last rev: *
|
|
* mods: *
|
|
* comments: YAP debugger *
|
|
* *
|
|
*************************************************************************/
|
|
|
|
:- system_module( '$_debug', [debug/0,
|
|
debugging/0,
|
|
leash/1,
|
|
nodebug/0,
|
|
(nospy)/1,
|
|
nospyall/0,
|
|
notrace/0,
|
|
(spy)/1,
|
|
trace/0], ['$do_spy'/4,
|
|
'$init_debugger'/0,
|
|
'$skipeol'/1]).
|
|
|
|
:- use_system_module( '$_boot', ['$find_goal_definition'/4,
|
|
'$system_catch'/4]).
|
|
|
|
:- use_system_module( '$_errors', ['$Error'/1,
|
|
'$do_error'/2]).
|
|
|
|
:- use_system_module( '$_init', ['$system_module'/1]).
|
|
|
|
:- use_system_module( '$_modules', ['$meta_expansion'/6]).
|
|
|
|
:- use_system_module( '$_preds', ['$clause'/4]).
|
|
|
|
/*-----------------------------------------------------------------------------
|
|
|
|
Debugging / creating spy points
|
|
|
|
-----------------------------------------------------------------------------*/
|
|
|
|
/** @defgroup Deb_Preds Debugging Predicates
|
|
@ingroup builtins
|
|
|
|
@{
|
|
The
|
|
following predicates are available to control the debugging of
|
|
programs:
|
|
|
|
+ debug
|
|
|
|
Switches the debugger on.
|
|
|
|
+ debugging
|
|
|
|
|
|
Outputs status information about the debugger which includes the leash
|
|
mode and the existing spy-points, when the debugger is on.
|
|
|
|
+ nodebug
|
|
|
|
|
|
Switches the debugger off.
|
|
|
|
|
|
*/
|
|
|
|
|
|
:- op(900,fx,[spy,nospy]).
|
|
|
|
'$init_debugger' :-
|
|
'$nb_getval'('$trace', _, fail), !.
|
|
'$init_debugger' :-
|
|
'$debugger_input',
|
|
nb_setval('$trace',off),
|
|
nb_setval('$if_skip_mode',no_skip),
|
|
nb_setval('$spy_glist',[]),
|
|
nb_setval('$spy_gn',1),
|
|
nb_setval('$debug_run',off),
|
|
nb_setval('$debug_jump',false).
|
|
|
|
|
|
% First part : setting and reseting spy points
|
|
|
|
% $suspy does most of the work
|
|
'$suspy'(V,S,M) :- var(V) , !,
|
|
'$do_error'(instantiation_error,M:spy(V,S)).
|
|
'$suspy'((M:S),P,_) :- !,
|
|
'$suspy'(S,P,M).
|
|
'$suspy'([],_,_) :- !.
|
|
'$suspy'([F|L],S,M) :- !, ( '$suspy'(F,S,M) ; '$suspy'(L,S,M) ).
|
|
'$suspy'(F/N,S,M) :- !,
|
|
functor(T,F,N),
|
|
'$do_suspy'(S, F, N, T, M).
|
|
'$suspy'(A,S,M) :- atom(A), !,
|
|
'$suspy_predicates_by_name'(A,S,M).
|
|
'$suspy'(P,spy,M) :- !,
|
|
'$do_error'(domain_error(predicate_spec,P),spy(M:P)).
|
|
'$suspy'(P,nospy,M) :-
|
|
'$do_error'(domain_error(predicate_spec,P),nospy(M:P)).
|
|
|
|
'$suspy_predicates_by_name'(A,S,M) :-
|
|
% just check one such predicate exists
|
|
(
|
|
current_predicate(A,M:_)
|
|
->
|
|
M = EM,
|
|
A = NA
|
|
;
|
|
recorded('$import','$import'(EM,M,GA,_,A,_),_),
|
|
functor(GA,NA,_)
|
|
),
|
|
!,
|
|
'$do_suspy_predicates_by_name'(NA,S,EM).
|
|
'$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,_,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,T0,_,F,N),_), !,
|
|
functor(T0, F0, N0),
|
|
'$do_suspy'(S, F0, N0, 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),
|
|
'$predicate_flags'(T,M,F,F),
|
|
F /\ 0x118dd080 =\= 0,
|
|
( S = spy ->
|
|
'$do_error'(permission_error(access,private_procedure,T),spy(M:F/N))
|
|
;
|
|
'$do_error'(permission_error(access,private_procedure,T),nospy(M:F/N))
|
|
).
|
|
'$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) :-
|
|
'$suspy2'(S,F,N,T,M).
|
|
|
|
'$suspy2'(spy,F,N,T,M) :-
|
|
recorded('$spy','$spy'(T,M),_), !,
|
|
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,already)).
|
|
'$suspy2'(spy,F,N,T,M) :- !,
|
|
recorda('$spy','$spy'(T,M),_),
|
|
'$set_spy'(T,M),
|
|
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),add,ok)).
|
|
'$suspy2'(nospy,F,N,T,M) :-
|
|
recorded('$spy','$spy'(T,M),R), !,
|
|
erase(R),
|
|
'$rm_spy'(T,M),
|
|
print_message(informational,breakp(bp(debugger,plain,M:T,M:F/N,N),remove,last)).
|
|
'$suspy2'(nospy,F,N,_,M) :-
|
|
print_message(informational,breakp(no,breakpoint_for,M:F/N)).
|
|
|
|
'$pred_being_spied'(G, M) :-
|
|
recorded('$spy','$spy'(G,M),_), !.
|
|
|
|
/**
|
|
@pred spy( + _P_ ).
|
|
|
|
Sets spy-points on all the predicates represented by
|
|
_P_. _P_ can either be a single specification or a list of
|
|
specifications. Each one must be of the form _Name/Arity_
|
|
or _Name_. In the last case all predicates with the name
|
|
_Name_ will be spied. As in C-Prolog, system predicates and
|
|
predicates written in C, cannot be spied.
|
|
|
|
|
|
*/
|
|
spy Spec :-
|
|
'$init_debugger',
|
|
prolog:debug_action_hook(spy(Spec)), !.
|
|
spy L :-
|
|
'$current_module'(M),
|
|
'$suspy'(L, spy, M), fail.
|
|
spy _ :- debug.
|
|
|
|
/** @pred nospy( + _P_ )
|
|
|
|
|
|
Removes spy-points from all predicates specified by _P_.
|
|
The possible forms for _P_ are the same as in `spy P`.
|
|
|
|
|
|
*/
|
|
nospy Spec :-
|
|
'$init_debugger',
|
|
prolog:debug_action_hook(nospy(Spec)), !.
|
|
nospy L :-
|
|
'$current_module'(M),
|
|
'$suspy'(L, nospy, M), fail.
|
|
nospy _.
|
|
|
|
/** @pred nospyall
|
|
|
|
Removes all existing spy-points.
|
|
*/
|
|
nospyall :-
|
|
'$init_debugger',
|
|
prolog:debug_action_hook(nospyall), !.
|
|
nospyall :-
|
|
recorded('$spy','$spy'(T,M),_), functor(T,F,N), '$suspy'(F/N,nospy,M), fail.
|
|
nospyall.
|
|
|
|
% debug mode -> debug flag = 1
|
|
|
|
debug :-
|
|
'$init_debugger',
|
|
( nb_getval('$spy_gn',_) -> true ; nb_setval('$spy_gn',1) ),
|
|
'$start_debugging'(on),
|
|
print_message(informational,debug(debug)).
|
|
|
|
'$start_debugging'(Mode) :-
|
|
(Mode == on ->
|
|
set_prolog_flag(debug, true)
|
|
;
|
|
set_prolog_flag(debug, false)
|
|
),
|
|
nb_setval('$debug_run',off),
|
|
nb_setval('$debug_jump',false).
|
|
|
|
nodebug :-
|
|
'$init_debugger',
|
|
set_prolog_flag(debug, false),
|
|
nb_setval('$trace',off),
|
|
print_message(informational,debug(off)).
|
|
|
|
%
|
|
% remove any debugging info after an abort.
|
|
%
|
|
|
|
|
|
/** @pred trace
|
|
|
|
|
|
Switches on the debugger and enters tracing mode.
|
|
|
|
|
|
*/
|
|
trace :-
|
|
'$init_debugger',
|
|
'$nb_getval'('$trace', on, fail), !.
|
|
trace :-
|
|
nb_setval('$trace',on),
|
|
'$start_debugging'(on),
|
|
print_message(informational,debug(trace)),
|
|
'$creep'.
|
|
|
|
/** @pred notrace
|
|
|
|
|
|
Ends tracing and exits the debugger. This is the same as
|
|
nodebug/0.
|
|
*/
|
|
notrace :-
|
|
'$init_debugger',
|
|
nodebug.
|
|
|
|
/*-----------------------------------------------------------------------------
|
|
|
|
leash
|
|
|
|
-----------------------------------------------------------------------------*/
|
|
|
|
|
|
/** @pred leash(+ _M_)
|
|
|
|
|
|
Sets leashing mode to _M_.
|
|
The mode can be specified as:
|
|
|
|
+ `full`
|
|
prompt on Call, Exit, Redo and Fail
|
|
|
|
+ `tight`
|
|
prompt on Call, Redo and Fail
|
|
|
|
+ `half`
|
|
prompt on Call and Redo
|
|
|
|
+ `loose`
|
|
prompt on Call
|
|
|
|
+ `off`
|
|
never prompt
|
|
|
|
+ `none`
|
|
never prompt, same as `off`
|
|
|
|
The initial leashing mode is `full`.
|
|
|
|
The user may also specify directly the debugger ports
|
|
where he wants to be prompted. If the argument for leash
|
|
is a number _N_, each of lower four bits of the number is used to
|
|
control prompting at one the ports of the box model. The debugger will
|
|
prompt according to the following conditions:
|
|
|
|
+ if `N/\ 1 =\= 0` prompt on fail
|
|
+ if `N/\ 2 =\= 0` prompt on redo
|
|
+ if `N/\ 4 =\= 0` prompt on exit
|
|
+ if `N/\ 8 =\= 0` prompt on call
|
|
|
|
Therefore, `leash(15)` is equivalent to `leash(full)` and
|
|
`leash(0)` is equivalent to `leash(off)`.
|
|
|
|
Another way of using `leash` is to give it a list with the names of
|
|
the ports where the debugger should stop. For example,
|
|
`leash([call,exit,redo,fail])` is the same as `leash(full)` or
|
|
`leash(15)` and `leash([fail])` might be used instead of
|
|
`leash(1)`.
|
|
|
|
@}
|
|
|
|
*/
|
|
leash(X) :- var(X),
|
|
'$do_error'(instantiation_error,leash(X)).
|
|
leash(X) :-
|
|
'$init_debugger',
|
|
'$leashcode'(X,Code),
|
|
set_value('$leash',Code),
|
|
'$show_leash'(informational,Code), !.
|
|
leash(X) :-
|
|
'$do_error'(type_error(leash_mode,X),leash(X)).
|
|
|
|
'$show_leash'(Msg,0) :-
|
|
print_message(Msg,leash([])).
|
|
'$show_leash'(Msg,Code) :-
|
|
'$check_leash_bit'(Code,0x8,L3,call,LF),
|
|
'$check_leash_bit'(Code,0x4,L2,exit,L3),
|
|
'$check_leash_bit'(Code,0x2,L1,redo,L2),
|
|
'$check_leash_bit'(Code,0x1,[],fail,L1),
|
|
print_message(Msg,leash(LF)).
|
|
|
|
'$check_leash_bit'(Code,Bit,L0,_,L0) :- Bit /\ Code =:= 0, !.
|
|
'$check_leash_bit'(_,_,L0,Name,[Name|L0]).
|
|
|
|
'$leashcode'(full,0xf) :- !.
|
|
'$leashcode'(on,0xf) :- !.
|
|
'$leashcode'(half,0xb) :- !.
|
|
'$leashcode'(loose,0x8) :- !.
|
|
'$leashcode'(off,0x0) :- !.
|
|
'$leashcode'(none,0x0) :- !.
|
|
%'$leashcode'([L|M],Code) :- !, '$leashcode_list'([L|M],Code).
|
|
'$leashcode'([L|M],Code) :- !,
|
|
'$list2Code'([L|M],Code).
|
|
'$leashcode'(N,N) :- integer(N), N >= 0, N =< 0xf.
|
|
|
|
'$list2Code'(V,_) :- var(V), !,
|
|
'$do_error'(instantiation_error,leash(V)).
|
|
'$list2Code'([],0) :- !.
|
|
'$list2Code'([V|L],_) :- var(V), !,
|
|
'$do_error'(instantiation_error,leash([V|L])).
|
|
'$list2Code'([call|L],N) :- '$list2Code'(L,N1), N is 0x8 + N1.
|
|
'$list2Code'([exit|L],N) :- '$list2Code'(L,N1), N is 0x4 + N1.
|
|
'$list2Code'([redo|L],N) :- '$list2Code'(L,N1), N is 0x2 + N1.
|
|
'$list2Code'([fail|L],N) :- '$list2Code'(L,N1), N is 0x1 + N1.
|
|
|
|
/*-----------------------------------------------------------------------------
|
|
|
|
debugging
|
|
|
|
-----------------------------------------------------------------------------*/
|
|
|
|
debugging :-
|
|
'$init_debugger',
|
|
prolog:debug_action_hook(nospyall), !.
|
|
debugging :-
|
|
( current_prolog_flag(debug, true) ->
|
|
print_message(help,debug(debug))
|
|
;
|
|
print_message(help,debug(off))
|
|
),
|
|
findall(M:(N/A),(recorded('$spy','$spy'(T,M),_),functor(T,N,A)),L),
|
|
print_message(help,breakpoints(L)),
|
|
get_value('$leash',Leash),
|
|
'$show_leash'(help,Leash).
|
|
|
|
/*
|
|
|
|
@}
|
|
|
|
*/
|
|
|
|
|
|
|
|
/** @defgroup Deb_Interaction Interacting with the debugger
|
|
@ingroup YAPProgramming
|
|
|
|
Debugging with YAP is similar to debugging with C-Prolog. Both systems
|
|
include a procedural debugger, based on Byrd's four port model. In this
|
|
model, execution is seen at the procedure level: each activation of a
|
|
procedure is seen as a box with control flowing into and out of that
|
|
box.
|
|
|
|
In the four port model control is caught at four key points: before
|
|
entering the procedure, after exiting the procedure (meaning successful
|
|
evaluation of all queries activated by the procedure), after backtracking but
|
|
before trying new alternative to the procedure and after failing the
|
|
procedure. Each one of these points is named a port:
|
|
|
|
~~~~~
|
|
*--------------------------------------*
|
|
Call | | Exit
|
|
---------> + descendant(X,Y) :- offspring(X,Y). + --------->
|
|
| |
|
|
| descendant(X,Z) :- |
|
|
<--------- + offspring(X,Y), descendant(Y,Z). + <---------
|
|
Fail | | Redo
|
|
*--------------------------------------*
|
|
~~~~~
|
|
|
|
|
|
|
|
+ `Call`
|
|
|
|
The call port is activated before initial invocation of
|
|
procedure. Afterwards, execution will try to match the goal with the
|
|
head of existing clauses for the procedure.
|
|
|
|
+ `Exit`
|
|
|
|
This port is activated if the procedure succeeds.
|
|
Control will now leave the procedure and return to its ancestor.
|
|
|
|
+ `Redo`
|
|
|
|
If the goal, or goals, activated after the call port
|
|
fail then backtracking will eventually return control to this procedure
|
|
through the redo port.
|
|
|
|
+ `Fail`
|
|
|
|
If all clauses for this predicate fail, then the
|
|
invocation fails, and control will try to redo the ancestor of this
|
|
invocation.
|
|
|
|
|
|
To start debugging, the user will either call `trace` or spy the
|
|
relevant procedures, entering debug mode, and start execution of the
|
|
program. When finding the first spy-point, YAP's debugger will take
|
|
control and show a message of the form:
|
|
|
|
~~~~~
|
|
* (1) call: quicksort([1,2,3],_38) ?
|
|
~~~~~
|
|
|
|
The debugger message will be shown while creeping, or at spy-points,
|
|
and it includes four or five fields:
|
|
|
|
+
|
|
The first three characters are used to point out special states of the
|
|
debugger. If the port is exit and the first character is '?', the
|
|
current call is non-deterministic, that is, it still has alternatives to
|
|
be tried. If the second character is a `\*`, execution is at a
|
|
spy-point. If the third character is a `>`, execution has returned
|
|
either from a skip, a fail or a redo command.
|
|
+
|
|
The second field is the activation number, and uniquely identifies the
|
|
activation. The number will start from 1 and will be incremented for
|
|
each activation found by the debugger.
|
|
+
|
|
In the third field, the debugger shows the active port.
|
|
+
|
|
The fourth field is the goal. The goal is written by
|
|
`write_term/3` on the standard error stream, using the options
|
|
given by debugger_print_options.
|
|
|
|
|
|
If the active port is leashed, the debugger will prompt the user with a
|
|
`?`, and wait for a command. A debugger command is just a
|
|
character, followed by a return. By default, only the call and redo
|
|
entries are leashed, but the leash/1 predicate can be used in
|
|
order to make the debugger stop where needed.
|
|
|
|
There are several commands available, but the user only needs to
|
|
remember the help command, which is `h`. This command shows all the
|
|
available options, which are:
|
|
|
|
+ `c` - creep
|
|
|
|
this command makes YAP continue execution and stop at the next
|
|
leashed port.
|
|
|
|
+ `return` - creep
|
|
|
|
the same as c
|
|
|
|
+ `l` - leap
|
|
|
|
YAP will execute until it meets a port for a spied predicate; this mode
|
|
keeps all computation history for debugging purposes, so it is more
|
|
expensive than standard execution. Use <tt>k</tt> or <tt>z</tt> for fast execution.
|
|
|
|
+ `k` - quasi-leap
|
|
|
|
similar to leap but faster since the computation history is
|
|
not kept; useful when leap becomes too slow.
|
|
|
|
+ `z` - zip
|
|
|
|
|
|
same as <tt>k</tt>
|
|
+ `s` - skip
|
|
|
|
YAP will continue execution without showing any messages until
|
|
returning to the current activation. Spy-points will be ignored in this
|
|
mode. Note that this command keeps all debugging history, use <tt>t</tt> for fast execution. This command is meaningless, and therefore illegal, in the fail
|
|
and exit ports.
|
|
|
|
+ `t` - fast-skip
|
|
|
|
similar to skip but faster since computation history is not
|
|
kept; useful if skip becomes slow.
|
|
|
|
+ `f [ _GoalId_]` - fail
|
|
|
|
If given no argument, forces YAP to fail the goal, skipping the fail
|
|
port and backtracking to the parent.
|
|
If <tt>f</tt> receives a goal number as
|
|
the argument, the command fails all the way to the goal. If goal _GoalId_ has completed execution, YAP fails until meeting the first active ancestor.
|
|
|
|
+ `r` [ _GoalId_] - retry
|
|
|
|
This command forces YAP to jump back call to the port. Note that any
|
|
side effects of the goal cannot be undone. This command is not available
|
|
at the call port. If <tt>f</tt> receives a goal number as the argument, the
|
|
command retries goal _GoalId_ instead. If goal _GoalId_ has
|
|
completed execution, YAP fails until meeting the first active ancestor.
|
|
|
|
+ `a` - abort
|
|
|
|
execution will be aborted, and the interpreter will return to the
|
|
top-level. YAP disactivates debug mode, but spypoints are not removed.
|
|
|
|
+ `n` - nodebug
|
|
|
|
stop debugging and continue execution. The command will not clear active
|
|
§spy-points.
|
|
|
|
+ `e` - exit
|
|
|
|
leave YAP.
|
|
|
|
+ `h` - help
|
|
|
|
show the debugger commands.
|
|
|
|
+ `!` Query
|
|
|
|
execute a query. YAP will not show the result of the query.
|
|
|
|
+ `b` - break
|
|
|
|
break active execution and launch a break level. This is the same as `!break`.
|
|
|
|
+ `+` - spy this goal
|
|
|
|
start spying the active goal. The same as `! spy G` where _G_
|
|
is the active goal.
|
|
|
|
+ `-` - nospy this goal
|
|
|
|
stop spying the active goal. The same as `! nospy G` where _G_ is
|
|
the active goal.
|
|
|
|
+ `p` - print
|
|
|
|
shows the active goal using print/1
|
|
|
|
+ `d` - display
|
|
|
|
shows the active goal using display/1
|
|
|
|
+ `<Depth` - debugger write depth
|
|
|
|
sets the maximum write depth, both for composite terms and lists, that
|
|
will be used by the debugger. For more
|
|
information about `write_depth/2` ( (see Input/Output Control)).
|
|
|
|
+ `<` - full term
|
|
|
|
resets to the default of ten the debugger's maximum write depth. For
|
|
more information about `write_depth/2` ( (see Input/Output Control)).
|
|
|
|
+ `A` - alternatives
|
|
|
|
show the list of backtrack points in the current execution.
|
|
|
|
+ `g [ _N_]`
|
|
|
|
show the list of ancestors in the current debugging environment. If it
|
|
receives _N_, show the first _N_ ancestors.
|
|
|
|
|
|
The debugging information, when fast-skip `quasi-leap` is used, will
|
|
be lost.
|
|
|
|
*/
|
|
|
|
/*-----------------------------------------------------------------------------
|
|
|
|
spy
|
|
|
|
-----------------------------------------------------------------------------*/
|
|
|
|
% ok, I may have a spy point for this goal, or not.
|
|
% if I do, I should check what mode I am in.
|
|
% Goal/Mode Have Spy Not Spied
|
|
% Creep Stop Stop
|
|
% Leap Stop Create CP
|
|
% Skip Create CP Create CP
|
|
% FastLeap Stop Ignore
|
|
% FastIgnore Ignore Ignore
|
|
|
|
|
|
% flag description initial possible values
|
|
|
|
% spy_gn goal number 1 1...
|
|
% spy_trace trace 0 0, 1
|
|
% spy_skip leap off Num (stop level)
|
|
% debug_prompt stop at spy points on on,off
|
|
% a flip-flop is also used
|
|
% when 1 spying is enabled *(the same as spy stop).
|
|
|
|
|
|
%'$spy'(G) :- write(user_error,'$spy'(G)), nl, fail.
|
|
%
|
|
% handle suspended goals
|
|
% take care with hidden goals.
|
|
%
|
|
% $spy may be called from user code, so be careful.
|
|
'$spy'([Mod|G]) :-
|
|
current_prolog_flag(debug, false), !,
|
|
'$execute_nonstop'(G,Mod).
|
|
'$spy'([Mod|G]) :-
|
|
CP is '$last_choice_pt',
|
|
'$debugger_input',
|
|
'$do_spy'(G, Mod, CP, spy).
|
|
|
|
/**
|
|
* @pred debugger_input.
|
|
* name of stream used for debugging,
|
|
* must be always connected to a tty.
|
|
*
|
|
* '$debugger_input': try to connect the debugger to an open terminal.
|
|
*/
|
|
'$debugger_input' :-
|
|
stream_property(_,alias(debugger_input)),
|
|
!.
|
|
'$debugger_input' :-
|
|
stream_property(S,tty(true)),
|
|
stream_property(S,input),
|
|
!,
|
|
set_stream(S,alias(debugger_input)).
|
|
'$debugger_input' :-
|
|
current_prolog_flag(unix, true ), !,
|
|
open('/dev/tty', read, _S, [alias(debugger_input),bom(false)]).
|
|
'$debugger_input' :-
|
|
current_prolog_flag(windows, true ), !,
|
|
open('CONIN$', read, _S, [alias(debugger_input),bom(false)]).
|
|
|
|
|
|
'$trace_meta_call'( G, M, CP ) :-
|
|
'$do_spy'(G, M, CP, spy ).
|
|
|
|
% last argument to do_spy says that we are at the end of a context. It
|
|
% is required to know whether we are controlled by the debugger.
|
|
%'$do_spy'(V, M, CP, Flag) :-
|
|
% writeln('$do_spy'(V, M, CP, Flag)), fail.
|
|
'$do_spy'(V, M, CP, Flag) :-
|
|
var(V), !,
|
|
'$do_spy'(call(V), M, CP, Flag).
|
|
'$do_spy'(!, _, CP, _) :-
|
|
!, '$$cut_by'(CP).
|
|
'$do_spy'('$cut_by'(M), _, _, _) :-
|
|
!, '$$cut_by'(M).
|
|
'$do_spy'(true, _, _, _) :- !.
|
|
%'$do_spy'(fail, _, _, _) :- !, fail.
|
|
'$do_spy'(M:G, _, CP, CalledFromDebugger) :- !,
|
|
'$do_spy'(G, M, CP, CalledFromDebugger).
|
|
'$do_spy'((A,B), M, CP, CalledFromDebugger) :- !,
|
|
'$do_spy'(A, M, CP, debugger),
|
|
'$do_spy'(B, M, CP, CalledFromDebugger).
|
|
'$do_spy'((T->A;B), M, CP, CalledFromDebugger) :- !,
|
|
( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger)
|
|
;
|
|
'$do_spy'(B, M, CP, CalledFromDebugger)
|
|
).
|
|
'$do_spy'((T->A|B), M, CP, CalledFromDebugger) :- !,
|
|
( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger)
|
|
;
|
|
'$do_spy'(B, M, CP, CalledFromDebugger)
|
|
).
|
|
'$do_spy'((T->A), M, CP, CalledFromDebugger) :- !,
|
|
( '$do_spy'(T, M, CP, debugger) -> '$do_spy'(A, M, CP, CalledFromDebugger) ).
|
|
'$do_spy'((A;B), M, CP, CalledFromDebugger) :- !,
|
|
(
|
|
'$do_spy'(A, M, CP, CalledFromDebugger)
|
|
;
|
|
'$do_spy'(B, M, CP, CalledFromDebugger)
|
|
).
|
|
'$do_spy'((A|B), M, CP, CalledFromDebugger) :- !,
|
|
(
|
|
'$do_spy'(A, M, CP, CalledFromDebugger )
|
|
;
|
|
'$do_spy'(B, M, CP, CalledFromDebugger )
|
|
).
|
|
'$do_spy'((\+G), M, CP, CalledFromDebugger) :- !,
|
|
\+ '$do_spy'(G, M, CP, CalledFromDebugger).
|
|
'$do_spy'((not(G)), M, CP, CalledFromDebugger) :- !,
|
|
\+ '$do_spy'(G, M, CP, CalledFromDebugger).
|
|
'$do_spy'(G, Module, _, CalledFromDebugger) :-
|
|
nb_getval('$spy_gn',L), /* get goal no. */
|
|
L1 is L+1, /* bump it */
|
|
nb_setval('$spy_gn',L1), /* and save it globaly */
|
|
b_getval('$spy_glist',History), /* get goal list */
|
|
b_setval('$spy_glist',[info(L,Module,G,_Retry,_Det,_HasFoundAnswers)|History]),
|
|
/* and update it */
|
|
'$loop_spy'(L, G, Module, CalledFromDebugger).
|
|
|
|
% we are skipping, so we can just call the goal,
|
|
% while leaving the minimal structure in place.
|
|
'$loop_spy'(GoalNumber, G, Module, CalledFromDebugger) :-
|
|
'$current_choice_point'(CP),
|
|
'$system_catch'('$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP),
|
|
Module, error(Event,Context),
|
|
'$loop_spy_event'(error(Event,Context), GoalNumber, G, Module, CalledFromDebugger)).
|
|
|
|
% handle weird things happening in the debugger.
|
|
'$loop_spy_event'('$pass'(Event), _, _, _, _) :- !,
|
|
throw(Event).
|
|
'$loop_spy_event'(error('$retry_spy'(G0),_), GoalNumber, G, Module, CalledFromDebugger) :-
|
|
G0 >= GoalNumber, !,
|
|
'$loop_spy'(GoalNumber, G, Module, CalledFromDebugger).
|
|
'$loop_spy_event'(error('$retry_spy'(GoalNumber),_), _, _, _, _) :- !,
|
|
throw(error('$retry_spy'(GoalNumber),[])).
|
|
'$loop_spy_event'(error('$fail_spy'(G0),_), GoalNumber, G, Module, CalledFromDebugger) :-
|
|
G0 >= GoalNumber, !,
|
|
'$loop_fail'(GoalNumber, G, Module, CalledFromDebugger).
|
|
'$loop_spy_event'(error('$fail_spy'(GoalNumber),_), _, _, _, _) :- !,
|
|
throw(error('$fail_spy'(GoalNumber),[])).
|
|
'$loop_spy_event'(error('$done_spy'(G0),_), GoalNumber, _G, _, CalledFromDebugger) :-
|
|
G0 >= GoalNumber, !,
|
|
'$continue_debugging'(zip, CalledFromDebugger).
|
|
'$loop_spy_event'(error('$done_spy'(GoalNumber),_), _, _, _, _) :- !,
|
|
throw(error('$done_spy'(GoalNumber),[])).
|
|
'$loop_spy_event'(Event, GoalNumber, G, Module, CalledFromDebugger) :-
|
|
'$debug_error'(Event),
|
|
'$system_catch'(
|
|
('$trace'(exception(Event),G,Module,GoalNumber,_),fail),
|
|
Module,
|
|
error(NewEvent,NewContext),
|
|
'$loop_spy_event'(error(NewEvent,NewContext), GoalNumber, G, Module, CalledFromDebugger)
|
|
).
|
|
|
|
|
|
'$debug_error'(Event) :-
|
|
'$Error'(Event), fail.
|
|
'$debug_error'(_).
|
|
|
|
|
|
% just fail here, don't really need to call debugger, the user knows what he
|
|
% wants to do
|
|
'$loop_fail'(_GoalNumber, _G, _Module, CalledFromDebugger) :-
|
|
'$continue_debugging'(fail, CalledFromDebugger),
|
|
fail.
|
|
|
|
% if we are in
|
|
'$loop_spy2'(GoalNumber, G, Module, CalledFromDebugger, CP) :-
|
|
/* the following choice point is where the predicate is called */
|
|
b_getval('$spy_glist',[Info|_]), /* get goal list */
|
|
Info = info(_,_,_,Retry,Det,false),
|
|
(
|
|
/* call port */
|
|
'$enter_goal'(GoalNumber, G, Module),
|
|
'$spycall'(G, Module, CalledFromDebugger, Retry),
|
|
'$stop_creeping',
|
|
% make sure we are in system mode when running the debugger.
|
|
(
|
|
'$debugger_deterministic_goal'(G) ->
|
|
Det=true
|
|
;
|
|
Det=false
|
|
),
|
|
/* go execute the continuation */
|
|
(
|
|
/* exit port */
|
|
Retry = false,
|
|
/* found an answer, so it can redo */
|
|
nb_setarg(6, Info, true),
|
|
'$show_trace'(exit,G,Module,GoalNumber,Det), /* output message at exit */
|
|
/* exit port */
|
|
/* get rid of deterministic computations */
|
|
(
|
|
Det == true
|
|
->
|
|
'$$cut_by'(CP)
|
|
;
|
|
true
|
|
),
|
|
'$continue_debugging'(exit, CalledFromDebugger)
|
|
;
|
|
% make sure we are in system mode when running the debugger.
|
|
/* backtracking from exit */
|
|
/* we get here when we want to redo a goal */
|
|
/* redo port */
|
|
(
|
|
arg(6, Info, true)
|
|
->
|
|
'$stop_creeping',
|
|
'$show_trace'(redo,G,Module,GoalNumber,_), /* inform user_error */
|
|
nb_setarg(6, Info, false)
|
|
;
|
|
true
|
|
),
|
|
'$continue_debugging'(fail, CalledFromDebugger),
|
|
fail /* to backtrack to spycalls */
|
|
)
|
|
;
|
|
'$stop_creeping',
|
|
'$show_trace'(fail,G,Module,GoalNumber,_), /* inform at fail port */
|
|
'$continue_debugging'(fail, CalledFromDebugger),
|
|
/* fail port */
|
|
fail
|
|
).
|
|
|
|
'$enter_goal'(GoalNumber, G, Module) :-
|
|
'$zip'(GoalNumber, G, Module), !.
|
|
'$enter_goal'(GoalNumber, G, Module) :-
|
|
'$trace'(call, G, Module, GoalNumber, _).
|
|
|
|
'$show_trace'(_, G, Module, GoalNumber,_) :-
|
|
'$zip'(GoalNumber, G, Module), !.
|
|
'$show_trace'(P,G,Module,GoalNumber,Deterministic) :-
|
|
'$trace'(P,G,Module,GoalNumber,Deterministic).
|
|
|
|
%
|
|
% skip a goal or a port
|
|
%
|
|
'$zip'(GoalNumber, G, Module) :-
|
|
nb_getval('$debug_run',StopPoint),
|
|
% zip mode off, we cannot zip
|
|
StopPoint \= off,
|
|
(
|
|
% skip spy points (eg, s).
|
|
StopPoint == spy
|
|
->
|
|
\+ '$pred_being_spied'(G, Module)
|
|
;
|
|
% skip goals (eg, l).
|
|
number(StopPoint)
|
|
->
|
|
StopPoint < GoalNumber
|
|
).
|
|
|
|
|
|
|
|
%
|
|
'$spycall'(G, M, _, _) :-
|
|
nb_getval('$debug_jump',true),
|
|
!,
|
|
( '$is_metapredicate'(G, M)
|
|
->
|
|
'$meta_expansion'(G,M,M,M,G1,[])
|
|
;
|
|
G = G1
|
|
),
|
|
'$execute_nonstop'(G1,M).
|
|
'$spycall'(G, M, _, _) :-
|
|
(
|
|
'$system_predicate'(G,M)
|
|
;
|
|
'$system_module'(M)
|
|
),
|
|
!,
|
|
( '$is_metapredicate'(G, M)
|
|
->
|
|
'$meta_expansion'(G,M,M,M,G10,[]),
|
|
'$debugger_process_meta_arguments'(G10, M, G1),
|
|
'$execute'(M:G1)
|
|
;
|
|
'$execute'(M:G)
|
|
).
|
|
'$spycall'(G, M, _, _) :-
|
|
'$tabled_predicate'(G,M),
|
|
!,
|
|
'$continue_debugging_goal'(no, '$execute_nonstop'(G,M)).
|
|
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
|
|
'$is_metapredicate'(G, M), !,
|
|
'$meta_expansion'(G,M,M,M,G1,[]),
|
|
'$spycall_expanded'(G1, M, CalledFromDebugger, InRedo).
|
|
'$spycall'(G, M, CalledFromDebugger, InRedo) :-
|
|
'$spycall_expanded'(G, M, CalledFromDebugger, InRedo).
|
|
|
|
'$spycall_expanded'(G, M, _CalledFromDebugger, InRedo) :-
|
|
'$predicate_flags'(G,M,F,F),
|
|
F /\ 0x08402000 =\= 0, !, % dynamic procedure, logical semantics, or source
|
|
% use the interpreter
|
|
CP is '$last_choice_pt',
|
|
'$clause'(G, M, Cl, _),
|
|
% I may backtrack to here from far away
|
|
( '$do_spy'(Cl, M, CP, debugger) ; InRedo = true ).
|
|
'$spycall_expanded'(G, M, CalledFromDebugger, InRedo) :-
|
|
'$undefined'(G, M), !,
|
|
'$get_undefined_pred'(G, M, Goal, NM), NM \= M,
|
|
'$spycall'(Goal, NM, CalledFromDebugger, InRedo).
|
|
'$spycall_expanded'(G, M, _, InRedo) :-
|
|
% I lost control here.
|
|
CP is '$last_choice_pt',
|
|
'$static_clause'(G,M,_,R),
|
|
'$stop_creeping',
|
|
% I may backtrack to here from far away
|
|
(
|
|
'$continue_debugging_goal'(no, '$execute_clause'(G, M, R, CP))
|
|
;
|
|
InRedo = true
|
|
).
|
|
|
|
%
|
|
%
|
|
'$creep'('$execute_clause'(G,Mod,Ref,CP),_M) :-
|
|
(
|
|
'$$save_by'(CP1),
|
|
'$creep',
|
|
'$execute_clause'(G,Mod,Ref,CP),
|
|
'$$save_by'(CP2),
|
|
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
|
|
'$stop_creeping'
|
|
;
|
|
fail
|
|
).
|
|
'$creep'(G,M) :-
|
|
(
|
|
'$$save_by'(CP1),
|
|
'$creep',
|
|
'$execute_nonstop'(G,M),
|
|
'$$save_by'(CP2),
|
|
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
|
|
'$stop_creeping'
|
|
;
|
|
fail
|
|
).
|
|
|
|
'$trace'(G,M) :-
|
|
(
|
|
'$$save_by'(CP1),
|
|
'$creep',
|
|
'$execute0'( G, M ),
|
|
'$$save_by'(CP2),
|
|
(CP1 == CP2 -> ! ; ( true ; '$creep', fail ) ),
|
|
'$stop_creeping'
|
|
;
|
|
fail
|
|
).
|
|
|
|
'$tabled_predicate'(G,M) :-
|
|
'$predicate_flags'(G,M,F,F),
|
|
F /\ 0x00000040 =\= 0.
|
|
|
|
%'$trace'(P,G,Module,L,Deterministic) :-
|
|
% '$nb_getval'('$system_mode',On,fail), writeln(On), fail.
|
|
'$trace'(P,G,Module,L,Deterministic) :-
|
|
% at this point we are done with leap or skip
|
|
nb_setval('$debug_run',off),
|
|
% but creep is default
|
|
nb_setval('$trace',on),
|
|
% make sure we run this code outside debugging mode.
|
|
set_prolog_flag(debug, false),
|
|
repeat,
|
|
'$trace_msg'(P,G,Module,L,Deterministic),
|
|
(
|
|
'$unleashed'(P) ->
|
|
'$action'(10,P,L,G,Module,Debug),
|
|
put_code(user_error, 10)
|
|
;
|
|
write(user_error,' ? '), get_code(debugger_input,C),
|
|
'$action'(C,P,L,G,Module,Debug)
|
|
),
|
|
(Debug = on
|
|
->
|
|
set_prolog_flag(debug, true)
|
|
;
|
|
Debug = zip
|
|
->
|
|
set_prolog_flag(debug, true)
|
|
;
|
|
set_prolog_flag(debug, false)
|
|
),
|
|
!.
|
|
|
|
'$trace_msg'(P,G,Module,L,Deterministic) :-
|
|
flush_output(user_output),
|
|
flush_output(user_error),
|
|
functor(P,P0,_),
|
|
(P = exit, Deterministic \= true -> Det = '?' ; Det = ' '),
|
|
('$pred_being_spied'(G,Module) -> CSPY = '*' ; CSPY = ' '),
|
|
% vsc: fix this
|
|
% ( SL = L -> SLL = '>' ; SLL = ' '),
|
|
SLL = ' ',
|
|
( Module\=prolog,
|
|
Module\=user
|
|
->
|
|
GW = Module:G
|
|
;
|
|
GW = G
|
|
),
|
|
format(user_error,'~a~a~a (~d) ~q:',[Det,CSPY,SLL,L,P0]),
|
|
'$debugger_write'(user_error,GW).
|
|
|
|
'$unleashed'(call) :- get_value('$leash',L), L /\ 2'1000 =:= 0. %'
|
|
'$unleashed'(exit) :- get_value('$leash',L), L /\ 2'0100 =:= 0. %'
|
|
'$unleashed'(redo) :- get_value('$leash',L), L /\ 2'0010 =:= 0. %'
|
|
'$unleashed'(fail) :- get_value('$leash',L), L /\ 2'0001 =:= 0. %'
|
|
% the same as fail.
|
|
'$unleashed'(exception(_)) :- get_value('$leash',L), L /\ 2'0001 =:= 0. %'
|
|
|
|
'$debugger_write'(Stream, G) :-
|
|
current_prolog_flag( debugger_print_options, OUT ), !,
|
|
write_term(Stream, G, OUT).
|
|
'$debugger_write'(Stream, G) :-
|
|
writeq(Stream, G).
|
|
|
|
'$action'(13,P,CallNumber,G,Module,Zip) :- !, % newline creep
|
|
get_code( debugger_input,C),
|
|
'$action'(C,P,CallNumber,G,Module,Zip).
|
|
'$action'(10,_,_,_,_,on) :- !, % newline creep
|
|
nb_setval('$debug_jump',false).
|
|
'$action'(0'!,_,_,_,_,_) :- !, % ! 'g execute
|
|
read(debugger_input, G),
|
|
% don't allow yourself to be caught by creep.
|
|
current_prolog_flag(debug, OldDeb),
|
|
set_prolog_flag(debug, false),
|
|
( '$execute'(G) -> true ; true),
|
|
% at this point we are done with leap or skip
|
|
nb_setval('$debug_run',off),
|
|
% but creep is default
|
|
nb_setval('$trace',on),
|
|
set_prolog_flag(debug, OldDeb),
|
|
% '$skipeol'(0'!), % '
|
|
fail.
|
|
'$action'(0'<,_,_,_,_,_) :- !, % <'Depth
|
|
'$new_deb_depth',
|
|
'$skipeol'(0'<),
|
|
fail.
|
|
'$action'(0'^,_,_,G,_,_) :- !, % '
|
|
'$print_deb_sterm'(G),
|
|
'$skipeol'(0'^),
|
|
fail.
|
|
'$action'(0'a,_,_,_,_,off) :- !, % 'a abort
|
|
'$skipeol'(0'a),
|
|
abort.
|
|
'$action'(0'b,_,_,_,_,_) :- !, % 'b break
|
|
'$skipeol'(0'b),
|
|
break,
|
|
fail.
|
|
'$action'(0'A,_,_,_,_,_) :- !, % 'b break
|
|
'$skipeol'(0'A),
|
|
'$hacks':'$stack_dump',
|
|
fail.
|
|
'$action'(0'c,_,_,_,_,on) :- !, % 'c creep
|
|
'$skipeol'(0'c),
|
|
nb_setval('$debug_jump',false).
|
|
'$action'(0'e,_,_,_,_,_) :- !, % 'e exit
|
|
'$skipeol'(0'e),
|
|
halt.
|
|
'$action'(0'f,_,CallId,_,_,_) :- !, % 'f fail
|
|
'$scan_number'(0'f, CallId, GoalId), %'f
|
|
throw(error('$fail_spy'(GoalId),[])).
|
|
'$action'(0'h,_,_,_,_,_) :- !, % 'h help
|
|
'$action_help',
|
|
'$skipeol'(104),
|
|
fail.
|
|
'$action'(0'?,_,_,_,_,_) :- !, % '? help
|
|
'$action_help',
|
|
'$skipeol'(104),
|
|
fail.
|
|
'$action'(0'p,_,_,G,Module,_) :- !, % 'p print
|
|
((Module = prolog ; Module = user) ->
|
|
print(user_error,G), nl(user_error)
|
|
;
|
|
print(user_error,Module:G), nl(user_error)
|
|
),
|
|
'$skipeol'(0'p),
|
|
fail.
|
|
'$action'(0'd,_,_,G,Module,_) :- !, % 'd display
|
|
((Module = prolog ; Module = user) ->
|
|
display(user_error,G), nl(user_error)
|
|
;
|
|
display(user_error,Module:G), nl(user_error)
|
|
),
|
|
'$skipeol'(0'd),
|
|
fail.
|
|
'$action'(0'l,_,_,_,_,on) :- !, % 'l leap
|
|
'$skipeol'(0'l),
|
|
nb_setval('$debug_run',spy),
|
|
nb_setval('$debug_jump',false).
|
|
'$action'(0'z,_,_,_,_,zip) :- !, % 'z zip, fast leap
|
|
'$skipeol'(0'z), % 'z
|
|
nb_setval('$debug_run',spy),
|
|
nb_setval('$debug_jump',true).
|
|
% skip first call (for current goal),
|
|
% stop next time.
|
|
'$action'(0'k,_,_,_,_,zip) :- !, % 'k zip, fast leap
|
|
'$skipeol'(0'k), % '
|
|
nb_setval('$debug_run',spy),
|
|
nb_setval('$debug_jump',true).
|
|
% skip first call (for current goal),
|
|
% stop next time.
|
|
'$action'(0'n,_,_,_,_,off) :- !, % 'n nodebug
|
|
'$skipeol'(0'n), % '
|
|
% tell debugger never to stop.
|
|
nb_setval('$debug_run', -1),
|
|
nb_setval('$debug_jump',true),
|
|
nodebug.
|
|
'$action'(0'r,_,CallId,_,_,_) :- !, % 'r retry
|
|
'$scan_number'(0'r,CallId,ScanNumber), % '
|
|
set_prolog_flag(debug, true),
|
|
throw(error('$retry_spy'(ScanNumber),[])).
|
|
'$action'(0's,P,CallNumber,_,_,on) :- !, % 's skip
|
|
'$skipeol'(0's), % '
|
|
( (P=call; P=redo) ->
|
|
nb_setval('$debug_run',CallNumber),
|
|
nb_setval('$debug_jump',false)
|
|
;
|
|
'$ilgl'(0's) % '
|
|
).
|
|
'$action'(0't,P,CallNumber,_,_,zip) :- !, % 't fast skip
|
|
'$skipeol'(0't), % '
|
|
( (P=call; P=redo) ->
|
|
nb_setval('$debug_run',CallNumber),
|
|
nb_setval('$debug_jump',true)
|
|
;
|
|
'$ilgl'(0't) % '
|
|
).
|
|
'$action'(0'+,_,_,G,M,_) :- !, % '+ spy this
|
|
functor(G,F,N), spy(M:(F/N)),
|
|
'$skipeol'(0'+), % '
|
|
fail.
|
|
'$action'(0'-,_,_,G,M,_) :- !, % '- nospy this
|
|
functor(G,F,N), nospy(M:(F/N)),
|
|
'$skipeol'(0'-), % '
|
|
fail.
|
|
'$action'(0'g,_,_,_,_,_) :- !, % 'g ancestors
|
|
'$scan_number'(0'g,-1,HowMany), % '
|
|
'$show_ancestors'(HowMany),
|
|
fail.
|
|
'$action'(C,_,_,_,_,_) :-
|
|
'$skipeol'(C),
|
|
'$ilgl'(C),
|
|
fail.
|
|
|
|
% first argument is exit, zip or fail
|
|
% second is creep, meta_creep, spy, or debugger
|
|
%'$continue_debugging'(Exit, Debugger) :-
|
|
% writeln('$continue_debugging'(Exit, Debugger)), fail.
|
|
% that's what follows
|
|
'$continue_debugging'(_, debugger) :- !.
|
|
% do not need to debug!
|
|
% go back to original sequence.
|
|
'$continue_debugging'(zip, _) :- !.
|
|
'$continue_debugging'(_, creep) :- !,
|
|
'$creep'.
|
|
'$continue_debugging'(fail, _) :- !.
|
|
'$continue_debugging'(_, _).
|
|
|
|
% if we are in the interpreter, don't need to care about forcing a trace, do we?
|
|
'$continue_debugging_goal'(yes,G) :- !,
|
|
'$execute_dgoal'(G).
|
|
% do not need to debug!
|
|
'$continue_debugging_goal'(_,G) :-
|
|
'nb_getval'('$debug_run',Zip),
|
|
(Zip == nodebug ; number(Zip) ; Zip == spy ), !,
|
|
'$execute_dgoal'(G).
|
|
'$continue_debugging_goal'(_,G) :-
|
|
'$execute_creep_dgoal'(G).
|
|
|
|
'$execute_dgoal'('$execute_nonstop'(G,M)) :-
|
|
'$execute_nonstop'(G,M).
|
|
'$execute_dgoal'('$execute_clause'(G, M, R, CP)) :-
|
|
'$execute_clause'(G, M, R, CP).
|
|
|
|
'$execute_creep_dgoal'('$execute_nonstop'(G,M)) :-
|
|
'$creep',
|
|
'$execute_nonstop'(G,M).
|
|
'$execute_creep_dgoal'('$execute_clause'(G, M, R, CP)) :-
|
|
'$creep',
|
|
'$execute_clause'(G, M, R, CP).
|
|
|
|
'$show_ancestors'(HowMany) :-
|
|
b_getval('$spy_glist',[_|History]),
|
|
(
|
|
History == []
|
|
->
|
|
print_message(help, ancestors([]))
|
|
;
|
|
'$show_ancestors'(History,HowMany),
|
|
nl(user_error)
|
|
).
|
|
|
|
'$show_ancestors'([],_).
|
|
'$show_ancestors'([_|_],0) :- !.
|
|
'$show_ancestors'([info(L,M,G,Retry,Det,_Exited)|History],HowMany) :-
|
|
'$show_ancestor'(L,M,G,Retry,Det,HowMany,HowMany1),
|
|
'$show_ancestors'(History,HowMany1).
|
|
|
|
% skip exit port, we're looking at true ancestors
|
|
'$show_ancestor'(_,_,_,_,Det,HowMany,HowMany) :-
|
|
nonvar(Det), !.
|
|
% look at retry
|
|
'$show_ancestor'(GoalNumber, M, G, Retry, _, HowMany, HowMany1) :-
|
|
nonvar(Retry), !,
|
|
HowMany1 is HowMany-1,
|
|
'$trace_msg'(redo, G, M, GoalNumber, _), nl(user_error).
|
|
'$show_ancestor'(GoalNumber, M, G, _, _, HowMany, HowMany1) :-
|
|
HowMany1 is HowMany-1,
|
|
'$trace_msg'(call, G, M, GoalNumber, _), nl(user_error).
|
|
|
|
|
|
'$action_help' :-
|
|
format(user_error,'newline creep a abort~n', []),
|
|
format(user_error,'c creep e exit~n', []),
|
|
format(user_error,'f Goal fail h help~n', []),
|
|
format(user_error,'l leap r Goal retry~n', []),
|
|
format(user_error,'s skip t fastskip~n', []),
|
|
format(user_error,'q quasiskip k quasileap~n', []),
|
|
format(user_error,'b break n no debug~n', []),
|
|
format(user_error,'p print d display~n', []),
|
|
format(user_error,'<D depth D < full term~n', []),
|
|
format(user_error,'+ spy this - nospy this~n', []),
|
|
format(user_error,'^ view subg ^^ view using~n', []),
|
|
format(user_error,'A choices g [N] ancestors~n', []),
|
|
format(user_error,'! g execute goal~n', []).
|
|
|
|
'$ilgl'(C) :-
|
|
print_message(warning, trace_command(C)),
|
|
print_message(help, trace_help),
|
|
fail.
|
|
|
|
'$skipeol'(10) :- !.
|
|
'$skipeol'(_) :- get_code( debugger_input,C), '$skipeol'(C).
|
|
|
|
'$scan_number'(_, _, Nb) :-
|
|
get_code( debugger_input,C),
|
|
'$scan_number2'(C, Nb), !.
|
|
'$scan_number'(_, CallId, CallId).
|
|
|
|
'$scan_number2'(10, _) :- !, fail.
|
|
'$scan_number2'(0' , Nb) :- !, % '
|
|
get_code( debugger_input,C),
|
|
'$scan_number2'(C , Nb).
|
|
'$scan_number2'(0' , Nb) :- !, %'
|
|
get_code( debugger_input,C),
|
|
'$scan_number2'(C, Nb).
|
|
'$scan_number2'(C, Nb) :-
|
|
'$scan_number3'(C, 0, Nb).
|
|
|
|
'$scan_number3'(10, Nb, Nb) :- !, Nb > 0.
|
|
'$scan_number3'( C, Nb0, Nb) :-
|
|
C >= "0", C =< "9",
|
|
NbI is Nb0*10+(C-"0"),
|
|
get_code( debugger_input, NC),
|
|
'$scan_number3'( NC, NbI, Nb).
|
|
|
|
'$print_deb_sterm'(G) :-
|
|
'$get_sterm_list'(L), !,
|
|
'$deb_get_sterm_in_g'(L,G,A),
|
|
recorda('$debug_sub_skel',L,_),
|
|
format(user_error,'~n~w~n~n',[A]).
|
|
'$print_deb_sterm'(_) :- '$skipeol'(94).
|
|
|
|
'$get_sterm_list'(L) :-
|
|
get_code( debugger_input_input,C),
|
|
'$deb_inc_in_sterm_oldie'(C,L0,CN),
|
|
'$get_sterm_list'(L0,CN,0,L).
|
|
|
|
'$deb_inc_in_sterm_oldie'(94,L0,CN) :- !,
|
|
get_code( debugger_input,CN),
|
|
( recorded('$debug_sub_skel',L0,_) -> true ;
|
|
CN = [] ).
|
|
'$deb_inc_in_sterm_oldie'(C,[],C).
|
|
|
|
'$get_sterm_list'(L0,C,N,L) :-
|
|
( C =:= "^", N =\= 0 -> get_code(debugger_input, CN),
|
|
'$get_sterm_list'([N|L0],CN,0,L) ;
|
|
C >= "0", C =< "9" -> NN is 10*N+C-"0", get_code(debugger_input, CN),
|
|
'$get_sterm_list'(L0,CN,NN,L);
|
|
C =:= 10 -> (N =:= 0 -> L = L0 ; L=[N|L0]) ).
|
|
|
|
'$deb_get_sterm_in_g'([],G,G).
|
|
'$deb_get_sterm_in_g'([H|T],G,A) :-
|
|
'$deb_get_sterm_in_g'(T,G,A1),
|
|
arg(H,A1,A).
|
|
|
|
'$new_deb_depth' :-
|
|
get_code( debugger_input,C),
|
|
'$get_deb_depth'(C,D),
|
|
'$set_deb_depth'(D).
|
|
|
|
'$get_deb_depth'(10,10) :- !. % default depth is 0
|
|
'$get_deb_depth'(C,XF) :-
|
|
'$get_deb_depth_char_by_char'(C,0,XF).
|
|
|
|
'$get_deb_depth_char_by_char'(10,X,X) :- !.
|
|
'$get_deb_depth_char_by_char'(C,X0,XF) :-
|
|
C >= "0", C =< "9", !,
|
|
XI is X0*10+C-"0",
|
|
get_code( debugger_input,NC),
|
|
'$get_deb_depth_char_by_char'(NC,XI,XF).
|
|
% reset when given garbage.
|
|
'$get_deb_depth_char_by_char'(C,_,10) :- '$skipeol'(C).
|
|
|
|
'$set_deb_depth'(D) :-
|
|
recorded('$print_options','$debugger'(L),R), !,
|
|
'$delete_if_there'(L, max_depth(_), LN),
|
|
erase(R),
|
|
recorda('$print_options','$debugger'([max_depth(D)|LN]),_).
|
|
'$set_deb_depth'(D) :-
|
|
recorda('$print_options','$debugger'([quoted(true),numbervars(true),portrayed(true),max_depth(D)]),_).
|
|
|
|
'$delete_if_there'([], _, []).
|
|
'$delete_if_there'([T|L], T, LN) :- !,
|
|
'$delete_if_there'(L, T, LN).
|
|
'$delete_if_there'([Q|L], T, [Q|LN]) :-
|
|
'$delete_if_there'(L, T, LN).
|
|
|
|
'$debugger_deterministic_goal'(G) :-
|
|
yap_hacks:current_choicepoints(CPs0),
|
|
% $cps(CPs0),
|
|
'$debugger_skip_traces'(CPs0,CPs1),
|
|
'$debugger_skip_loop_spy2'(CPs1,CPs2),
|
|
'$debugger_skip_spycall'(CPs2,CPs3),
|
|
'$debugger_skip_loop_spy2'(CPs3,[Catch|_]),
|
|
yap_hacks:choicepoint(Catch,_,prolog,'$catch',3,'$catch'(_,'$loop_spy_event'(_,_,G,_,_),_),_).
|
|
|
|
|
|
'$cps'([CP|CPs]) :-
|
|
yap_hacks:choicepoint(CP,A,B,C,D,E,F),
|
|
write(A:B:C:D:E:F),nl,
|
|
'$cps'(CPs).
|
|
'$cps'([]).
|
|
|
|
|
|
'$debugger_skip_spycall'([CP|CPs],CPs1) :-
|
|
yap_hacks:choicepoint(CP,_,prolog,'$spycall',4,(_;_),_), !,
|
|
'$debugger_skip_spycall'(CPs,CPs1).
|
|
'$debugger_skip_spycall'(CPs,CPs).
|
|
|
|
'$debugger_skip_traces'([CP|CPs],CPs1) :-
|
|
yap_hacks:choicepoint(CP,_,prolog,'$trace',4,(_;_),_), !,
|
|
'$debugger_skip_traces'(CPs,CPs1).
|
|
'$debugger_skip_traces'(CPs,CPs).
|
|
|
|
'$debugger_skip_loop_spy2'([CP|CPs],CPs1) :-
|
|
yap_hacks:choicepoint(CP,_,prolog,'$loop_spy2',5,(_;_),_), !,
|
|
'$debugger_skip_loop_spy2'(CPs,CPs1).
|
|
'$debugger_skip_loop_spy2'(CPs,CPs).
|
|
|
|
'$debugger_process_meta_arguments'(G, M, G1) :-
|
|
functor(G,F,N),
|
|
'$meta_predicate'(F,M,N,D), !, % we're in an argument
|
|
D =.. [F|BMs],
|
|
G =.. [F|BGs],
|
|
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s),
|
|
G1 =.. [F|BG1s].
|
|
|
|
'$ldebugger_process_meta_args'([], _, [], []).
|
|
'$ldebugger_process_meta_args'([G|BGs], M, [0|BMs], ['$trace'(G1,M1)|BG1s]) :-
|
|
!,
|
|
strip_module( M:G, M1, G1 ),
|
|
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s).
|
|
'$ldebugger_process_meta_args'([G|BGs], M, [_|BMs], [G|BG1s]) :-
|
|
'$ldebugger_process_meta_args'(BGs, M, BMs, BG1s).
|