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

copy

Browse Source
This commit is contained in:
Vitor Santos Costa 2019-02-20 10:45:21 +00:00
parent c248ef9ccf
commit 84721e1005
4 changed files with 74 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
C/terms.c
View File

@ -981,16 +981,8 @@ static Term bind_vars_in_complex_term(CELL * pt0_, CELL * pt0_end_ USES_REGS) {
*ptd0 = TermFoundVar;
/* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256) {
/* Trail overflow */
if (!Yap_growtrail((TR - TR0) * sizeof(tr_fr_ptr *), true)) {
while (to_visit > to_visit0) {
to_visit--;
CELL *ptd0 = to_visit->ptd0;
*ptd0 = to_visit->d0;
}
goto trail_overflow;
}
}
TrailTerm(TR++) = (CELL)ptd0;
END_WALK();
@ -1044,40 +1036,41 @@ return Yap_unify(ARG2, t) && Yap_unify(ARG3, out);
}
#define FOUND_VAR_AGAIN() \
if (d0 == TermFoundVar) { \
CELL *pt2 = pt0; \
while (IsVarTerm(*pt2)) \
pt2 = (CELL *)(*pt2); \
if (d0 == TermFoundVar) \
{ \
HR[0] = (CELL)ptd0; \
HR[1] = AbsPair(HR + 2); \
HR[0] = (CELL)pt2; \
HR += 2; \
*pt2 = TermRefoundVar; \
*ptd0 = TermRefoundVar; \
}
static Term non_singletons_in_complex_term(CELL * pt0_,
CELL * pt0_end_ USES_REGS) {
HB = (CELL *)ASP;
CELL output = AbsPair(HR);
WALK_COMPLEX_TERM__({}, {}, FOUND_VAR_AGAIN());
/* do or pt2 are unbound */
YapBind(ptd0, TermFoundVar);
goto restart;
*ptd0 = TermFoundVar;
/* next make sure noone will see this as a variable again */
if (TR > (tr_fr_ptr)LOCAL_TrailTop - 256)
{
goto trail_overflow;
}
TrailTerm(TR++) = (CELL)ptd0;
END_WALK();
clean_tr(TR0 PASS_REGS);
pop_text_stack(lvl);
HB = (CELL *)B->cp_b;
if (HR != InitialH) {
/* close the list */
HR[-1] = Deref(ARG2);
return output;
return AbsPair(InitialH);
} else {
return ARG2;
}
def_aux_overflow();
def_trail_overflow();
}
static Int p_non_singletons_in_term(
@ -1094,7 +1087,7 @@ static Int p_non_singletons_in_term(
} else {
out = non_singletons_in_complex_term(&(t)-1, &(t)PASS_REGS);
}
return out;
return Yap_unify(ARG3,out);
}
static Term numbervar(Int me USES_REGS) {

6
C/utilpreds.c
View File

@ -395,9 +395,9 @@ int Yap_copy_complex_term(register CELL *pt0, register CELL *pt0_end,
RESET_VARIABLE(ptf);
*ptd0 = (CELL)ptf;
ptf++;
TrailTerm(TR++) = (CELL)ptd0;
if ((ADDR)TR > LOCAL_TrailTop - 16)
goto trail_overflow;
}
}
@ -521,7 +521,7 @@ CopyTerm(Term inp, UInt arity, int share, int newattvs USES_REGS) {
Term
Yap_CopyTerm(Term inp) {
CACHE_REGS
return CopyTerm(inp, 0, TRUE, TRUE PASS_REGS);
return CopyTerm(inp, 0, false, TRUE PASS_REGS);
}
Term
@ -533,7 +533,7 @@ Yap_CopyTermNoShare(Term inp) {
static Int
p_copy_term( USES_REGS1 ) /* copy term t to a new instance */
{
Term t = CopyTerm(ARG1, 2, TRUE, TRUE PASS_REGS);
Term t = CopyTerm(ARG1, 2, false, TRUE PASS_REGS);
if (t == 0L)
return FALSE;
/* be careful, there may be a stack shift here */

84
pl/debug.yap
View File

@ -16,7 +16,7 @@
*************************************************************************/
:- system_module( '$_debug', [], ['$trace_query'/4,
:- system_module( '$_debug', [], ['$trace_plan'/4,
'$init_debugger'/0,
'$skipeol'/1]).
@ -254,7 +254,7 @@ be lost.
*
* The debugger is an interpreter. with main predicates:
* - $trace: this is the API
* - $trace_query: reduce a query to a goal
* - $trace_plan: reduce a query to a goal
* - $trace_goal: execute:
* + using the source, Luke
* + hooking into the WAM procedure call mechanism
@ -308,7 +308,7 @@ be lost.
'$execute_nonstop'(G,Mod).
'$trace'(Mod:G) :-
'$$save_by'(CP),
'$trace_query'(G, Mod, CP, G, EG),
'$trace_plan'(G, Mod, CP, G, EG),
gated_call(
'$debugger_io',
EG,
@ -415,42 +415,54 @@ be lost.
'$trace_meta_call'( G, M, CP ) :-
'$trace_query'(G, M, CP, G, EG ),
'$trace_plan'(G, M, CP, G, EG ),
call(EG).
%% @pred '$trace_query'( +G, +M, +CP, +Expanded)
%% @pred '$trace_plan'( +G, +M, +CP, +Expanded)
%
% debug a complex query
%
'$trace_query'(V, M, _CP, _, call(M:V)) :-
'$trace_plan'(V, M, _CP, _, call(M:V)) :-
var(V), !.
'$trace_query'(!, _, CP, _, '$$cut_by'(CP)) :-
'$trace_plan'(!, _, CP, _, '$$cut_by'(CP)) :-
!.
'$trace_query'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :-
'$trace_plan'('$cut_by'(M), _, _, _, '$$cut_by'(M)) :-
!.
'$trace_query'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :-
'$trace_plan'('$$cut_by'(M), _, _, _, '$$cut_by'(M)) :-
!.
'$trace_query'(true, _, _, _, true) :- !.
'$trace_query'(fail, _, _, _, '$trace'(fail)) :- !.
'$trace_query'(M:G, _, CP,S, Expanded) :-
!,
'$yap_strip_module'(M:G, M0, G0),
'$trace_query'(G0, M0, CP,S, Expanded ).
'$trace_query'((A,B), M, CP, S, (EA,EB)) :- !,
'$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB).
'$trace_query'((A->B), M, CP, S, (EA->EB)) :- !,
'$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB).
'$trace_query'((A;B), M, CP, S, (EA;EB)) :- !,
'$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB).
'$trace_query'((A|B), M, CP, S, (EA|EB)) :- !,
'$trace_query'(A, M, CP, S, EA),
'$trace_query'(B, M, CP, S, EB).
'$trace_query'((\+ A), M, CP, S, (\+ EA)) :- !,
'$trace_query'(A, M, CP, S, EA).
'$trace_query'(G, M, _CP, _, (
'$trace_plan'(true, _, _, _, true) :- !.
'$trace_plan'(fail, _, _, _, '$trace'(fail)) :- !.
'$trace_plan'((A,B), M, CP, S, (EA,EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((A->B), M, CP, S, (EA->EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((A;B), M, CP, S, (EA;EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((A|B), M, CP, S, (EA|EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'(C, M, CP, S, EC),
'$trace_plan'((A->*B), M, CP, S, (EA->EB)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB).
'$trace_plan'((A->*B;C), M, CP, S, (EA->EB;EC)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB),
'$trace_plan'(C, M, CP, S, EC).
'$trace_plan'(if(A,B,C), M, CP, S, (EA->EB;EC)) :- !,
'$trace_plan'(A, M, CP, S, EA),
'$trace_plan'(B, M, CP, S, EB),
'$trace_plan'(C, M, CP, S, EC).
'$trace_plan'((\+ A), M, CP, S, ( EA -> fail ; true)) :- !,
'$trace_plan'(A, M, CP, S, EA).
'$trace_plan'(once(A), M, CP, S, ( EA -> true)) :- !,
'$trace_plan'(A, M, CP, S, EA).
'$trace_plan'(ignore(A), M, CP, S, ( EA -> true; true)) :- !,
'$trace_plan'(A, M, CP, S, EA).
'$trace_plan'(G, M, _CP, _, (
% spy a literal
'$id_goal'(L),
catch(
@ -604,7 +616,7 @@ be lost.
'$$save_by'(CP),
clause(M:G, Cl, _),
'$retry_clause'(GoalNumber, G, M, Info, X),
'$trace_query'(Cl, M, CP, Cl, ECl),
'$trace_plan'(Cl, M, CP, Cl, ECl),
'$execute0'(ECl,M).
'$creep_step'(GoalNumber, G, M, Info) :-
@ -654,7 +666,7 @@ be lost.
%%% - abort: forward throw while the call is newer than goal
%% @pred '$re_trace_query'( Exception, +Goal, +Mod, +GoalID )
%% @pred '$re_trace_plan'( Exception, +Goal, +Mod, +GoalID )
%
% debugger code for exceptions. Recognised cases are:
% - abort always forwarded
@ -1046,10 +1058,10 @@ be lost.
'$cps'([]).
'$debugger_skip_trace_query'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$trace_query',4,(_;_),_), !,
'$debugger_skip_trace_query'(CPs,CPs1).
'$debugger_skip_trace_query'(CPs,CPs).
'$debugger_skip_trace_plan'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$trace_plan',4,(_;_),_), !,
'$debugger_skip_trace_plan'(CPs,CPs1).
'$debugger_skip_trace_plan'(CPs,CPs).
'$debugger_skip_traces'([CP|CPs],CPs1) :-
yap_hacks:choicepoint(CP,_,prolog,'$port',4,(_;_),_), !,

2
pl/top.yap
View File

@ -295,7 +295,7 @@ live :-
'$write_answer'(Vs, LGs, Written),
'$write_query_answer_true'(Written),
(
'$prompt_alternatives_on'(determinism), CP == NCP, DCP = 0
yap_flag(prompt_alternatives_on,determinism), CP == NCP, DCP = 0
->
format(user_error, '.~n', []),
!