more bug fixes for CLP(BN)

Allow debugging of system procedures if written in Prolog.


git-svn-id: https://yap.svn.sf.net/svnroot/yap/trunk@1174 b08c6af1-5177-4d33-ba66-4b1c6b8b522a

CLPBN/clpbn.yap

@@ -1,6 +1,6 @@
 
 
-:- module(clpbn, [{}/1).
+:- module(clpbn, [{}/1]).
 
 :- use_module(library(atts)).
 :- use_module(library(lists)).
@@ -27,7 +27,7 @@
 		    check_if_bnt_done/1
 		    ]).
 
-:- use_module('clpn/vel', [vel/3,
+:- use_module('clpbn/vel', [vel/3,
 		    check_if_vel_done/1
 		    ]).
 
@@ -41,7 +41,7 @@ use(vel).
 %	key_entry(Key,Indx),
 %	array_element(clpbn,Indx,El),
 %	attributes:put_att(El,3,indx(Indx)),
-	put_atts(El,[key(Key),dist(E=>Domain)]),
+	put_atts(El,[key(Key),dist((E->Domain))]),
 	extract_dist(Dist, E, Domain),
 	add_evidence(Var,El).
 
@@ -130,8 +130,8 @@ compile_second_constraint(Constraint, Vars, NVars, clpbn:put_atts(EVar,[dist(NC)
 	check_constraint(Constraint, Vars, NVars, NC).
 
 check_constraint(Constraint, _, _, Constraint) :- var(Constraint), !.
-check_constraint((A=>D), _, _, (A=>D)) :- var(A), !.
+check_constraint((A->D), _, _, (A->D)) :- var(A), !.
-check_constraint((([A|B].L)=>D), Vars, NVars, (([A|B].NL)=>D)) :- !,
+check_constraint((([A|B].L)->D), Vars, NVars, (([A|B].NL)->D)) :- !,
 	check_cpt_input_vars(L, Vars, NVars, NL).
 check_constraint(Dist, _, _, Dist).
 
@@ -256,11 +256,11 @@ get_bnode(Var, Goal) :-
 	include_evidence(Var, Goal0, Key, Goali),
 	include_starter(Var, Goali, Key, Goal).
 
-include_evidence(Var, Goal0, Key, ((Key<--Ev),Goal0)) :-
+include_evidence(Var, Goal0, Key, ((Key:-Ev),Goal0)) :-
 	get_atts(Var, [evidence(Ev)]), !.
 include_evidence(_, Goal0, _, Goal0).
 
-include_starter(Var, Goal0, Key, ((<--Key),Goal0)) :-
+include_starter(Var, Goal0, Key, ((:-Key),Goal0)) :-
 	get_atts(Var, [starter]), !.
 include_starter(_, Goal0, _, Goal0).
 
@@ -366,13 +366,4 @@ reset_clpbn.
 user:term_expansion((A :- {}), ( :- true )) :-	 !, % evidence
 	prolog_load_context(module, M),
 	add_to_evidence(M:A).
-user:term_expansion((A :- B), (A :- (LCs,NB))) :-			% expands heads
-	fetch_skolems(B, B0, Skolems, []),
-	Skolems \= [],
-	skolem_vars(Skolems, Vars),
-	copy_term(Vars+A, NVars+NA),
-	skolem_new_vars(Skolems, NVars, NSkolems),
-	compile_skolems(NSkolems, Vars, NVars, NA, LCs),
-	handle_body_goals(B0, B1),
-	fresh_vars(Vars, NVars, NB, B1).
 

CLPBN/clpbn/bnt.yap

@@ -170,7 +170,7 @@ send_var_sizes([V|Vs], CommandStream) :-
 	send_var_sizes(Vs, CommandStream).
 
 
-dist_size((_=>Vs), _, L) :- !,
+dist_size((_->Vs), _, L) :- !,
 	length(Vs,L).
 dist_size((_._=Vs), I0, If) :- !,
 	length(Vs,L),
@@ -201,7 +201,7 @@ dump_cpds([V|Vs], CommandStream, Answer) :-
 %
 % this is a discrete distribution
 %
-dump_dist((average.Ss)=>Vs, V, CommandStream, Answer) :- !,
+dump_dist(((average.Ss)->Vs), V, CommandStream, Answer) :- !,
 	vals_map(Vs, 1, Map),
 	get_atts(V, [topord(I)]),
 	my_format(CommandStream, "bnet.CPD{~w} = deterministic_CPD(bnet, ~w, inline('round(mean([",['$VAR'(I),'$VAR'(I)]),
@@ -209,7 +209,7 @@ dump_dist((average.Ss)=>Vs, V, CommandStream, Answer) :- !,
 	length(Ss, Len),
 	dump_indices(0,Len,CommandStream),
 	send_command(CommandStream, Answer, "]))'));~n",[]).
-dump_dist((sum.Ss)=>Vs, V, CommandStream, Answer) :- !,
+dump_dist(((sum.Ss)->Vs), V, CommandStream, Answer) :- !,
 	vals_map(Vs, 1, Map),
 	get_atts(V, [topord(I)]),
 	my_format(CommandStream, "bnet.CPD{~w} = deterministic_CPD(bnet, ~w, inline('sum([",['$VAR'(I),'$VAR'(I)]),
@@ -217,7 +217,7 @@ dump_dist((sum.Ss)=>Vs, V, CommandStream, Answer) :- !,
 	length(Ss, Len),
 	dump_indices(0,Len,CommandStream),
 	send_command(CommandStream, Answer, "])'));~n",[]).
-dump_dist((normalised_average(N).Ss)=>Vs, V, CommandStream, Answer) :- !,
+dump_dist(((normalised_average(N).Ss)->Vs), V, CommandStream, Answer) :- !,
 	vals_map(Vs, 1, Map),
 	get_atts(V, [topord(I)]),
 	my_format(CommandStream, "bnet.CPD{~w} = deterministic_CPD(bnet, ~w, inline('round((sum([",['$VAR'(I),'$VAR'(I)]),
@@ -226,7 +226,7 @@ dump_dist((normalised_average(N).Ss)=>Vs, V, CommandStream, Answer) :- !,
 	dump_indices(0,Len,CommandStream),
 	N2 is N//2,
 	send_command(CommandStream, Answer, "])+~d)/~d)'));~n",[N2,N]).
-dump_dist(([H|T].Ss0)=>Vs, V, CommandStream, Answer) :- !,
+dump_dist((([H|T].Ss0)->Vs), V, CommandStream, Answer) :- !,
 	Ds = [H|T],
 	vals_map(Vs, 1, Map),
 	get_atts(V, [topord(I)]),
@@ -238,7 +238,7 @@ dump_dist(([H|T].Ss0)=>Vs, V, CommandStream, Answer) :- !,
 	keysort(KDs0,KDs),
 	dump_elements(KDs, CommandStream),
 	send_command(CommandStream, Answer, "]);~n",[]).
-dump_dist(([H|T]=>Vs), V, CommandStream, Answer) :-
+dump_dist(([H|T]->Vs), V, CommandStream, Answer) :-
 	vals_map(Vs, 1, Map),
 	get_atts(V, [topord(I)]),
 	my_format(CommandStream, "bnet.CPD{~w} = tabular_CPD(bnet, ~w, [ ",['$VAR'(I),'$VAR'(I)]),

CLPBN/clpbn/vel.yap

@@ -52,7 +52,7 @@ check_for_hidden_vars([V|Vs], AllVs0, [V|NVs]) :-
 	check_for_hidden_vars(IVs, AllVs, NVs).
 
 check_for_extra_variables(V,AllVs0, AllVs, Vs, IVs) :-
-	clpbn:get_atts(V, [dist(([_|_].[V1|LV])=>_)]), !,
+	clpbn:get_atts(V, [dist((([_|_].[V1|LV])->_))]), !,
 	add_old_variables([V1|LV], AllVs0, AllVs, Vs, IVs).
 check_for_extra_variables(_,AllVs, AllVs, Vs, Vs).
 
@@ -70,7 +70,7 @@ find_all_clpbn_vars([V|Vs], [var(V,I,Sz,Vals,_,_)|LV], [table(I,Table,Deps,Sizes
 	find_all_clpbn_vars(Vs, LV, Tables).
 
 var_with_deps(V, Table, Deps, Sizes, Vals) :-
-	clpbn:get_atts(V, [dist(D=>Vals)]),
+	clpbn:get_atts(V, [dist((D->Vals))]),
 	from_dist_get(D,Vals,OTable,VDeps),
 	reorder_table([V|VDeps],Sizes,OTable,Deps,Table).
 
@@ -182,7 +182,7 @@ get_sizes([V|Deps], [Sz|Sizes]) :-
 get_dist_els(V,Sz) :-
 	get_atts(V, [size(Sz)]), !.
 get_dist_els(V,Sz) :-
-	clpbn:get_atts(V, [dist(_=>Vals)]), !,
+	clpbn:get_atts(V, [dist((_->Vals))]), !,
 	length(Vals,Sz),
 	put_atts(V, [size(Sz)]).
 
@@ -299,7 +299,7 @@ multiply_tables([tab(Tab1,Deps1,Szs1), tab(Tab2,Deps2,Sz2)| Tables], Out) :-
 
 
 propagate_evidence(V, Evs) :-
-	clpbn:get_atts(V, [evidence(Ev),dist(_=>Out)]), !,
+	clpbn:get_atts(V, [evidence(Ev),dist((_->Out))]), !,
 	generate_szs_with_evidence(Out,Ev,Evs).
 propagate_evidence(_, _).
 
@@ -435,7 +435,7 @@ update_tables([_|Tabs],NTabs,Table,V,AVs0,NS) :-
 bind_vals([],_,_) :- !.
 % simple case, we want a distribution on a single variable.
 %bind_vals([V],Ps) :- !,
-%	clpbn:get_atts(V, [dist(_=>Vals)]),
+%	clpbn:get_atts(V, [dist((_->Vals))]),
 %	put_atts(V, posterior([V], Vals, Ps)).
 % complex case, we want a joint distribution, do it on a leader.
 % should split on cliques ?
@@ -450,7 +450,7 @@ get_all_combs(Vs, Vals) :-
 
 get_all_doms([], []).
 get_all_doms([V|Vs], [D|Ds]) :-
-	clpbn:get_atts(V, [dist(_=>D)]),
+	clpbn:get_atts(V, [dist((_->D))]),
 	get_all_doms(Vs, Ds).
 
 ms([], []).

pl/debug.yap

@@ -83,11 +83,20 @@
 	 ).
 '$do_suspy'(S, F, N, T, M) :-
 	 '$system_predicate'(T,M),
+	'$flags'(T,Mod,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).
 
@@ -391,7 +400,9 @@ debugging :-
 
 % 
 '$spycall'(G, M, _) :-
-	'$access_yap_flags'(10,0), !,
+	( '$access_yap_flags'(10,0);
+	  '$system_predicate'(G,M), \+ '$meta_predicate'(G,M)
+	), !,
 	'$execute_nonstop'(G, M).
 '$spycall'(G, M, InControl) :-
 	'$flags'(G,M,F,F),