debuggecode

2019-05-11 11:24:15 +01:00 · 2019-05-11 11:24:15 +01:00 · 46b9b46bca
parent 4d395761a4
commit 46b9b46bca
5 changed files with 127 additions and 38 deletions
--- 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).

--- 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),
--- 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'(_,_)).
--- 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)
     ).
--- 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)).

 /*