From 46b9b46bcadf7b0ffe13dc7695b46b0c3d56a1c5 Mon Sep 17 00:00:00 2001 From: Vitor Santos Costa Date: Sat, 11 May 2019 11:24:15 +0100 Subject: [PATCH] debuggecode --- library/maplist.yap | 9 ++-- packages/gecode/clpfd.yap | 54 +++++++++++++++++--- packages/gecode/gecode6_yap_hand_written.yap | 36 ++++++++++++- pl/debug.yap | 44 +++++++++------- pl/spy.yap | 22 +++++--- 5 files changed, 127 insertions(+), 38 deletions(-) diff --git a/library/maplist.yap b/library/maplist.yap index a79eed3a9..e1f134907 100644 --- a/library/maplist.yap +++ b/library/maplist.yap @@ -766,8 +766,7 @@ goal_expansion(maplist(Meta, ListIn, ListOut), Mod:Goal) :- append_args(HeadPrefix, [[In|Ins], [Out|Outs]], RecursionHead), append_args(Pred, [In, Out], Apply), append_args(HeadPrefix, [Ins, Outs], RecursiveCall), - compile_aux([ - Base, + compile_aux([ Base, (RecursionHead :- Apply, RecursiveCall) ], Mod). @@ -887,19 +886,19 @@ goal_expansion(selectlists(Meta, ListIn, ListIn1, ListOut, ListOut1), Mod:Goal) aux_preds(Meta, MetaVars, Pred, PredVars, Proto), !, % the new goal - pred_name(selectlist, 4, Proto, GoalName), + pred_name(selectlists, 4, Proto, GoalName), append(MetaVars, [ListIn, ListIn1, ListOut, ListOut1], GoalArgs), Goal =.. [GoalName|GoalArgs], % the new predicate declaration HeadPrefix =.. [GoalName|PredVars], append_args(HeadPrefix, [[], [], [], []], Base), append_args(HeadPrefix, [[In|Ins], [In1|Ins1], Outs, Outs1], RecursionHead), - append_args(Pred, [In, In1], Apply), + append_args(Pred, [In, Out], Apply), append_args(HeadPrefix, [Ins, Ins1, NOuts, NOuts1], RecursiveCall), compile_aux([ Base, (RecursionHead :- - (Apply -> Outs = [In|NOuts], Outs1 = [In1|NOuts1]; Outs = NOuts, Outs1 = NOuts1), + (Apply -> Outs = [Out|NOuts], Outs1 = [In1|NOuts1]; Outs = NOuts, Outs1 = NOuts1), RecursiveCall) ], Mod). diff --git a/packages/gecode/clpfd.yap b/packages/gecode/clpfd.yap index 00e3457da..259b816fe 100644 --- a/packages/gecode/clpfd.yap +++ b/packages/gecode/clpfd.yap @@ -260,7 +260,7 @@ constraint( (_ #<==> _) ). constraint( (_ #==> _) ). constraint( (_ #<== _) ). constraint( (_ #\/ _) ). -constraint( in(_, _) ). %2, +constraint( fd_in(_, _) ). %2, constraint( ins(_, _) ). %2, constraint( all_different(_) ). %1, constraint( all_distinct(_) ). %1, @@ -292,7 +292,7 @@ constraint( zcompare(_, _, _) ). %3, constraint( chain(_, _) ). %2, constraint( element(_, _) ). %2, constraint( fd_var(_) ). %1, -constraint( fd_inf(_, _) ). %2, +sconstraint( fd_inf(_, _) ). %2, constraint( fd_sup(_, _) ). %2, constraint( fd_size(_, _) ). %2, constraint( fd_dom(_, _) ). %2 @@ -453,6 +453,7 @@ fd_sum( L, Op, V) :- m(X, NX, NA, NB, Map), NX := intvar(Space, NA, NB). ( X fd_in A..B) :- + var(X), get_home(Space-Map), check(A, NA), check(B, NB), @@ -549,6 +550,22 @@ clause( or, Ps, Ns, V ) :- check(V, NV), post(clause( 'BOT_OR', NPs, NNs, NV), Env, _ ). +bool_labeling(Opts, Xs) :- + get_home(Space-Map), + foldl2( processs_bool_lab_opt, Opts, 'BOOL_VAR_DEGREE_MIN', BranchVar, 'BOOL_VAL_MIN', BranchVal), + term_variables(Xs, Vs), + check( Vs, X1s ), + ( X1s == [] -> true ; + maplist(ll(Map), X1s, NXs), + Space += branch(NXs, BranchVar, BranchVal) ). + +processs_bool_lab_opt(leftmost, _, 'BOOL_VAR_NONE', BranchVal, BranchVal). +processs_bool_lab_opt(min, _, 'BOOL_VAR_DEGREE_MIN', BranchVal, BranchVal). +processs_bool_lab_opt(max, _, 'BOOL_VAR_DEGREE_MAX', BranchVal, BranchVal). +processs_bool_lab_opt(min_step, BranchVar, BranchVar, _, 'BOOL_VAL_MIN'). +processs_bool_lab_opt(max_step, BranchVar, BranchVar, _, 'BOOL_VAL_MIN'). +processs_bool_lab_opt(enum, BranchVar, BranchVar, _, 'BOOL_VALUES_MIN'). + labeling(Opts, Xs) :- get_home(Space-Map), foldl2( processs_lab_opt, Opts, 'INT_VAR_SIZE_MIN', BranchVar, 'INT_VAL_MIN', BranchVal), @@ -594,7 +611,9 @@ check(V, NV) :- V = '$matrix'(_, _, _, _, C) -> C =.. [_|L], maplist(check, L, NV) ; V = A+B -> check(A,NA), check(B, NB), NV = NB+NA ; V = A-B -> check(A,NA), check(B, NB), NV = NB-NA ; - V in Domain -> V fd_in Domain, V=NV ; + V = A/\B -> check(A,NA), check(B, NB), NV = NB/\NA ; + V = A\/B -> check(A,NA), check(B, NB), NV = NB\/NA ; + V fd_in A..B, var(V) -> check(A,NA), check(B, NB), NV fd_in NB..NA ; arith(V, _) -> V =.. [C|L], maplist(check, L, NL), NV =.. [C|NL] ; constraint(V) -> V =.. [C|L], maplist(check, L, NL), NV =.. [C|NL] ). @@ -678,9 +697,21 @@ post( rel( sum(Foreach, Cond), Op, Out), Space-Map, Reify):- !, Space += linear(Cs, IL, GOP, IOut); Space += linear(Cs, IL, GOP, IOut, Reify) ). +post( rel( sum(L0), Op, Out), Space-Map, Reify):- +!, + selectlist(var,L0,L,LC), + sumlist(LC,0), + ( var(Out) -> l(Out, IOut, Map) ; integer(Out) -> IOut = Out ; equality(Out, NOut, Space-Map), l(NOut, IOut, Map) ), + maplist(ll(Map), [Out|L], [IOut|IL] ), + gecode_arith_op( Op, GOP ), + (L = [] -> true ; + var(Reify) -> + Space += linear(Cs, IL, GOP, IOut); + Space += linear(Cs, IL, GOP, IOut, Reify) + ). post( rel(A1+A2, Op, B), Space-Map, Reify):- - ( nonvar(B) ; B = _ + _ ; B = _-_), !, + ( var(B) ; B = _ + _ ; B = _-_), !, linearize(A1+A2, 1, As, Bs, CAs, CBs, 0, A0, Space-Map), linearize(B, -1, Bs, [], CBs, [], A0, B0, Space-Map), gecode_arith_op( Op, GOP ), @@ -697,7 +728,7 @@ post( rel(A1+A2, Op, B), Space-Map, Reify):- ). post( rel(A1-A2, Op, B), Space-Map, Reify):- - ( nonvar(B) ; B = _ + _ ; B = _-_), !, + ( var(B) ; B = _ + _ ; B = _-_), !, linearize(A1-A2, 1, As, Bs, CAs, CBs, 0, A0, Space-Map), linearize(B, -1, Bs, [], CBs, [], A0, B0, Space-Map), gecode_arith_op( Op, GOP ), @@ -731,6 +762,15 @@ post( rel(A, Op, B), Space-Map, Reify):- equality(B, B1, Space-Map), out_c(Name, VA1, B1, Op, Space-Map, Reify). +post( rel(A1 \/ A2, Ope, B), Space-Map, Reify):- + !, + equality(A1, NA1, Space-Map), + in_c(NA1, VA1, Space-Map), + equality(A2, NA2, Space-Map), + in_c(NA2, VA2, Space-Map), + equality(B, B1, Space-Map), + out_c('\\/', VA1, VA2, B1, Op, Space-Map, Reify). + post( rel(A, Op, B), Space-Map, Reify):- arith(A, Name), A =.. [_Op,A1,A2], !, @@ -874,7 +914,6 @@ linearize(AC, C, [A|Bs], Bs, [C|CBs], CBs, I, I, Env) :- Env = _-Map, l(V, A, Map). -arith('\\/'(_,_), (\/)). arith('=>'(_,_), (=>)). arith('<=>'(_,_), (<=>)). arith(xor(_,_), xor). @@ -1010,7 +1049,8 @@ out_c(Name, A1, A2, B, Op, Space-Map, Reify) :- ). % X*Y #= Cin[..] out_c(Name, A1, A2, B, (#=), Space-Map, Reify) :- - var(Reify), +Name \= '\\/', + var(Reify), l(B, IB, Map), !, l(A1, IA1, Map), l(A2, IA2, Map), diff --git a/packages/gecode/gecode6_yap_hand_written.yap b/packages/gecode/gecode6_yap_hand_written.yap index b61f5027a..c7a5f3d87 100644 --- a/packages/gecode/gecode6_yap_hand_written.yap +++ b/packages/gecode/gecode6_yap_hand_written.yap @@ -288,7 +288,7 @@ is_IntVar_('IntVar'(I,K),N) :- nb_getval(gecode_space_use_keep_index,B), (B=true -> N=K ; N=I). is_FloatVar_('FloatVar'(I,K),N) :- - integer(I), + integer(I), integer(K), nb_getval(gecode_space_use_keep_index,B), (B=true -> N=K ; N=I). @@ -479,6 +479,30 @@ is_IntVarBranch_(X, X) :- is_IntVarBranch(X,Y) :- nonvar(X), is_IntVarBranch_(X,Y). is_IntVarBranch(X) :- is_IntVarBranch(X,_). +%% Var and Val Branching changed in Gecode 4 to be done as a set of functions, +%%% not as an enum. + +is_BoolVarBranch_('BOOL_VAR_NONE'). +is_BoolVarBranch_('BOOL_VAR_RND'(_)). +%is_BoolVarBranch_('BOOL_VAR_MERIT_MIN'(_)). +%is_BoolVarBranch_('BOOL_VAR_MERIT_MAX'(_)). +is_BoolVarBranch_('BOOL_VAR_DEGREE_MIN'). +is_BoolVarBranch_('BOOL_VAR_DEGREE_MAX'). +is_BoolVarBranch_('BOOL_VAR_MAX_MIN'). +is_BoolVarBranch_('BOOL_VAR_MAX_MAX'). +is_BoolVarBranch_('BOOL_VAR_AFC_MIN'(_)). +is_BoolVarBranch_('BOOL_VAR_AFC_MAX'(_)). +is_BoolVarBranch_('BOOL_VAR_ACTION_MIN'(_)). +is_BoolVarBranch_('BOOL_VAR_ACTION_MAX'(_)). +is_BoolVarBranch_('BOOL_VAR_CHB_MIN'(_)). +is_BoolVarBranch_('BOOL_VAR_CHB_MAX'(_)). + +is_BoolVarBranch_(X, X) :- + is_BoolVarBranch_(X). + +is_BoolVarBranch(X,Y) :- nonvar(X), is_BoolVarBranch_(X,Y). +is_BoolVarBranch(X) :- is_BoolVarBranch(X,_). + is_SetVarBranch_('SET_VAR_NONE'). is_SetVarBranch_('SET_VAR_RND'(_)). is_SetVarBranch_('SET_VAR_MERIT_MIN'(_)). @@ -557,6 +581,16 @@ is_IntValBranch_(X,X) :- is_IntValBranch_(X). is_IntValBranch(X,Y) :- nonvar(X), is_IntValBranch_(X,Y). is_IntValBranch(X) :- is_IntValBranch(X,_). +is_BoolValBranch_('BOOL_VAL_RND'(_)). +is_BoolValBranch_('BOOL_VAL'(_,_)). +is_BoolValBranch_('BOOL_VAL_MIN'). +is_BoolValBranch_('BOOL_VAL_MAX'). + +is_BoolValBranch_(X,X) :- is_BoolValBranch_(X). + +is_BoolValBranch(X,Y) :- nonvar(X), is_BoolValBranch_(X,Y). +is_BoolValBranch(X) :- is_BoolValBranch(X,_). + is_SetValBranch_('SET_VAL_RND_INC'(_)). is_SetValBranch_('SET_VAL_RND_EXC'(_)). is_SetValBranch_('SET_VAL'(_,_)). diff --git a/pl/debug.yap b/pl/debug.yap index be708e3a6..e387ddb5f 100644 --- a/pl/debug.yap +++ b/pl/debug.yap @@ -310,7 +310,7 @@ be lost. '$trace_query'(G, Mod, CP, G, EG), gated_call( '$debugger_io', - EG, + ( '$enter_debugging'(G,Mod), EG ), E, '$continue_debugging'(E) ). @@ -456,6 +456,26 @@ be lost. %% %% Actually debugs a %% goal! +'$trace_goal'(G,M, GoalNumber, H) :- + '$is_source'(G,M), + '$current_choice_point'(CP), + !, + '$enter_trace'(GoalNumber, G, M, H), + gated_call( + true, + ( '$enter_debugging'(G,M,GoalNumber) + -> + % source mode + clause(M:G, B), '$trace_query'(B,M,CP,B,H) + ; + '$execute_nonstop'(G,M) + ), + Port, + ( + '$reenter_debugging'(Port,G,M,GoalNumber), + '$trace_port'(Port, GoalNumber, G, M, true, H) + ) + ). '$trace_goal'(G, M, GoalNumber, H) :- '$is_metapredicate'(G, prolog), !, @@ -469,28 +489,16 @@ be lost. '$undefined'(G,M), !, '$undefp'([M|G], _). -'$trace_goal__'(G,M, GoalNumber, H) :- - '$is_source'(G,M), - '$current_choice_point'(CP), - !, - '$enter_trace'(GoalNumber, G, M, H), - gated_call( - true, - ( '$creep_is_on_at_entry'(G,M) - -> - clause(M:G, B), '$trace_query'(B,M,CP,B,H) - ; - '$execute_nonstop'(G,M) - ), - Port, - '$trace_port'(Port, GoalNumber, G, M, true, H) - ). % system_ '$trace_goal__'(G,M, GoalNumber, H) :- '$enter_trace'(GoalNumber, G, M, H), gated_call( true, - '$execute_nonstop'(G,M), + ( + % try creeping + ( '$enter_debugging'(G,M,GoalNumber) -> '$creep' ; true ), + '$execute_nonstop'(G,M) + ), Port, '$trace_port'(Port, GoalNumber, G, M, true, H) ). diff --git a/pl/spy.yap b/pl/spy.yap index b86dcac5b..2d7305b3c 100644 --- a/pl/spy.yap +++ b/pl/spy.yap @@ -415,6 +415,20 @@ notrace(G) :- '$trace_query'(G,Mod,CP,G0,NG). '$enter_debugging'(G,_Mod,_CP,_G0,G). +'$enter_debugging'(G,Mod,GN) :- + çurrent_prolog_flag( debug, Deb ), + '__NB_set_value__'( debug, Deb ), + ( Deb = false + -> + true + ; + '$creep_is_on_at_entry'(G,Mod,GN) + -> + '$creep' + ; + true + ). + %% we're coming back from external code to a debugger call. %% '$reenter_debugger'(retry) :- @@ -444,13 +458,10 @@ notrace(G) :- %% enable creeping on the next goal. %% '$re_enter_creep_mode' :- - '__NB_getval__'(debug, true, fail), !, '$creep'. '$re_enter_creep_mode'. -'$creep_is_off'(_,_) :- - '__NB_getval__'(debug, false, fail), !. '$creep_is_off'(Module:G, GN0) :- '__NB_getval__'('$debug_status',state(zip, GN, Spy,_), fail), ( @@ -469,12 +480,10 @@ notrace(G) :- %% % '$creep_is_on' :- - '__NB_getval__'(debug, true, fail), '__NB_getval__'('$debug_status',state(Step, _GN, _Spy,_), fail), Step \= zip. -'$creep_is_on_at_entry'(G,M) :- - '__NB_getval__'(debug, true, fail), +'$creep_is_on_at_entry'(G,M,GoalNo) :- \+ '$system_predicate'(G,M), '__NB_getval__'('$debug_status',state(Step, _GN, Spy,_), fail), ( @@ -492,7 +501,6 @@ notrace(G) :- '$trace_off' :- '__NB_getval__'('$debug_status', state(_Creep, GN, Spy, Trace),fail), -'__NB_setval__'(debug,false), nb_setval('$debug_status', state(zip, GN, Spy,Trace)). /*