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

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

8
C/utilpreds.c
View File

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

90
pl/debug.yap
View File

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

2
pl/top.yap
View File

@ -295,7 +295,7 @@ live :-
'$write_answer'(Vs, LGs, Written), '$write_answer'(Vs, LGs, Written),
'$write_query_answer_true'(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', []), format(user_error, '.~n', []),
! !