From bc2364c5dccb8fa675a3dbaf5f76761e8078bf8a Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= <vsc@dcc.fc.up.pt>
Date: Wed, 4 Apr 2012 08:29:20 +0100
Subject: [PATCH 1/6] small fixes

---
 packages/CLPBN/clpbn.yap                |  2 +-
 packages/CLPBN/clpbn/bdd.yap            | 68 +++++++++++++++++++++----
 packages/CLPBN/clpbn/ground_factors.yap |  2 +-
 3 files changed, 59 insertions(+), 13 deletions(-)

diff --git a/packages/CLPBN/clpbn.yap b/packages/CLPBN/clpbn.yap
index 4df0a4e9a..88b085ca0 100644
--- a/packages/CLPBN/clpbn.yap
+++ b/packages/CLPBN/clpbn.yap
@@ -238,7 +238,7 @@ project_attributes(GVars, _AVars0) :-
 	(ground(GVars) ->
 	    true
 	;
-	    call_ground_solver(Solver, GKeys, Keys, Factors, Evidence, Answ)
+	    call_ground_solver(Solver, GKeys, Keys, Factors, Evidence, _Avars0)
 	).
 project_attributes(GVars, AVars) :-
 	suppress_attribute_display(false),
diff --git a/packages/CLPBN/clpbn/bdd.yap b/packages/CLPBN/clpbn/bdd.yap
index f4284d1aa..0270f1a94 100644
--- a/packages/CLPBN/clpbn/bdd.yap
+++ b/packages/CLPBN/clpbn/bdd.yap
@@ -123,8 +123,8 @@ get_vars_info([_|MoreVs], Vs0, VsF, Ps0, PsF, VarsInfo, Lvs, Outs) :-
 get_var_info(V, avg(Domain), Parents0, Vs, Vs2, Ps, Ps, Lvs, Outs, DIST) :- !,
 	reorder_vars(Parents0, Parents),
 	length(Domain, DSize),
-%	run_though_avg(V, DSize, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST).
-	bup_avg(V, DSize, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST).
+	run_though_avg(V, DSize, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST).
+%	bup_avg(V, DSize, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST).
 % standard random variable
 get_var_info(V, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
 % clpbn:get_atts(V, [key(K)]), writeln(V:K:DistId:Parents),
@@ -142,8 +142,7 @@ get_var_info(V, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
 reorder_vars(Vs, OVs) :-
 	add_pos(Vs, PVs),
 	keysort(PVs, SVs),
-	remove_key(SVs, OVs1),
-	reverse(OVs1, OVs).
+	remove_key(SVs, OVs).
 
 add_pos([], []).
 add_pos([V|Vs], [K-V|PVs]) :-
@@ -167,7 +166,8 @@ run_though_avg(V, 3, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST) :-
 	simplify_exp(F00, F0),
 %	generate_3tree(F1, PVars, 0, 0, 0, N, N0, N1, N2, R, ((N1+2*(N2+R) > N/2, N1+2*N2 < (3*N)/2))),
 	generate_3tree(F20, PVars, 0, 0, 0, N, N0, N1, N2, R, (N1+2*(N2+R) >= (3*N)/2), N1+2*N2 >= (3*N)/2),
-	simplify_exp(F20, F2),
+%	simplify_exp(F20, F2),
+	F20=F2,
 	Formula0 = [V0=F0*Ev0,V2=F2*Ev2,V1=not(F0+F2)*Ev1],
 	Ev = [Ev0,Ev1,Ev2],
 	get_evidence(V, Tree, Ev, Formula0, Formula, Lvs, Outs).
@@ -235,9 +235,11 @@ bup_avg(V, Size, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST) :-
 	check_v(V, avg(Domain,Parents), DIST, Vs, Vs1),
 	DIST = info(V, Tree, Ev, OVs, Formula, [], []),
 	get_parents(Parents, PVars, Vs1, Vs2),
-	generate_sums(PVars, Size, Max, Sums, F0),
-%	length(Parents, N),
-%	Max is (Size-1)*N, % This should be true
+%	generate_sums(PVars, Size, Max, Sums, F0),
+	bin_sums(PVars, Sums, F00),
+	reverse(F00,F0),
+	length(Parents, N),
+	Max is (Size-1)*N, % This should be true
 	% easier to do recursion on lists
 	Sums =.. [_|LSums],
 	generate_avg(0, Size, 0, Max, LSums, OVs, Ev, F1, []),
@@ -245,6 +247,37 @@ bup_avg(V, Size, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST) :-
 	get_evidence(V, Tree, Ev, F1, F2, Lvs, Outs),
 	append(RF0, F2, Formula).
 
+bin_sums(Vs, Sums, F) :-
+	 vs_to_sums(Vs, Sums0),
+	 writeln(init:Sums0),
+	 bin_sums(Sums0, Sums, F, []).
+	
+vs_to_sums([], []).
+vs_to_sums([V|Vs], [Sum|Sums0]) :-
+	  Sum =.. [sum|V],
+	  vs_to_sums(Vs, Sums0).
+
+bin_sums([Sum], Sum) --> !.
+bin_sums(LSums, Sums) --> 
+	pack_bins(LSums, Sums1),
+	bin_sums(Sums1, Sums).
+
+pack_bins([], []) --> [].
+pack_bins([Sum], [Sum]) --> [].
+pack_bins([Sum1,Sum2|LSums], [Sum|NSums]) -->
+	sum(Sum1, Sum2, Sum),
+	pack_bins(LSums, NSums).
+
+sum(Sum1, Sum2, Sum) -->
+	  { functor(Sum1, _, M1),
+	    functor(Sum2, _, M2),
+	    Max is M1+M2-2,
+	    Max1 is Max+1,
+	    Max0 is M2-1,
+	    functor(Sum, sum, Max1),
+	    Sum1 =.. [_|PVals] },
+	  expand_sums(PVals, 0, Max0, Max1, M2, Sum2, Sum).
+
 generate_sums([PVals], Size, Max, Sum, []) :- !,
 	Max is Size-1,
 	Sum =.. [sum|PVals].
@@ -259,12 +292,12 @@ generate_sums([PVals|Parents], Size, Max, NewSums, F) :-
 % outer loop: generate array of sums at level j= Sum[j0...jMax]
 %
 expand_sums(_Parents, Max, _, Max, _Size, _Sums, _NewSums, F0, F0) :- !.
-expand_sums(Parents, I0, Max0, Max, Size, Sums, NewSums, F, F0) :-
+expand_sums(Parents, I0, Max0, Max, Size, Sums, NewSums, [O=SUM|F], F0) :-
 	I is I0+1,
 	arg(I, NewSums, O),
 	sum_all(Parents, 0, I0, Max0, Sums, List),
 	to_disj(List, SUM),
-        expand_sums(Parents, I, Max0, Max, Size, Sums, NewSums, F, [O=SUM|F0]).
+        expand_sums(Parents, I, Max0, Max, Size, Sums, NewSums, F, F0).
 
 %
 %inner loop: find all parents that contribute to A_ji,
@@ -283,9 +316,22 @@ sum_all([_V|Vs], Pos, I, Max0, Sums, List) :-
 	Pos1 is Pos+1,
 	sum_all(Vs, Pos1, I, Max0, Sums, List).
 	
+gen_arg(J, Sums, Max, S0) :-
+	gen_arg(0, Max, J, Sums, S0).
+	
+gen_arg(Max, Max, J, Sums, S0) :- !,
+	     I is Max+1,
+	     arg(I, Sums, A),
+	( Max = J -> S0 = A ; S0 = not(A)).
+gen_arg(I0, Max, J, Sums, S) :-
+	     I is I0+1,
+	     arg(I, Sums, A),
+	( I0 = J -> S = A*S0 ; S = not(A)*S0),
+	gen_arg(I, Max, J, Sums, S0).
+
 
 generate_avg(Size, Size, _J, _Max, [], [], [], F, F).
-generate_avg(I0, Size, J0, Max, LSums, [O|OVs], [Ev|Evs], [O=Disj*Ev|F], F0) :-
+generate_avg(I0, Size, J0, Max, LSums, [O|OVs], [Ev|Evs], [O=Ev*Disj|F], F0) :-
 	I is I0+1,
 	Border is (I*Max)/Size,
 	fetch_for_avg(J0, Border, J, LSums, MySums, RSums),
diff --git a/packages/CLPBN/clpbn/ground_factors.yap b/packages/CLPBN/clpbn/ground_factors.yap
index baedf0453..964a940fa 100644
--- a/packages/CLPBN/clpbn/ground_factors.yap
+++ b/packages/CLPBN/clpbn/ground_factors.yap
@@ -30,7 +30,7 @@
 
 :- dynamic currently_defined/1, f/3.
 
-generate_network(QueryVars0, QueryKeys0, Keys, Factors, Evidence) :-
+generate_network(QueryVars0, QueryKeys, Keys, Factors, Evidence) :-
 	attributes:all_attvars(AVars),
 	keys(QueryVars0, QueryKeys0),
 	check_for_evidence(AVars, EVars, QueryKeys0, QueryVars0, Evidence),

From 708500819310f7bbd2b9dde8f3cdba62626cc5d3 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= <vsc@dcc.fc.up.pt>
Date: Thu, 5 Apr 2012 20:50:27 +0100
Subject: [PATCH 2/6] fix compilation without gmp.

---
 C/c_interface.c | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/C/c_interface.c b/C/c_interface.c
index fefebe01d..2e8a71b20 100644
--- a/C/c_interface.c
+++ b/C/c_interface.c
@@ -3622,8 +3622,10 @@ YAP_ListToFloats(Term t, double *dblp, size_t sz)
 	dblp[i++] = IntOfTerm(hd);
       else if (IsLongIntTerm(hd))
 	dblp[i++] = LongIntOfTerm(hd);
+#if USE_GMP
       else if (IsBigIntTerm(hd))
 	dblp[i++] = Yap_gmp_to_float(hd);
+#endif
       else
 	return -1;
     }

From c08178a57c4b92cd845f1c10c8302f1dcd0d858b Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= <vsc@dcc.fc.up.pt>
Date: Wed, 11 Apr 2012 22:08:02 +0100
Subject: [PATCH 3/6] fix thread compilation.

---
 C/adtdefs.c     |  3 ++-
 C/amasm.c       |  1 +
 C/c_interface.c |  3 ++-
 C/cdmgr.c       |  5 +++++
 C/dbase.c       |  1 +
 C/gprof.c       | 27 ++++++++++++++++++++++++---
 C/index.c       |  1 +
 C/sysbits.c     |  1 +
 C/utilpreds.c   | 12 ++++++------
 9 files changed, 43 insertions(+), 11 deletions(-)

diff --git a/C/adtdefs.c b/C/adtdefs.c
index 326cc4b7e..bda54f303 100644
--- a/C/adtdefs.c
+++ b/C/adtdefs.c
@@ -490,7 +490,6 @@ Yap_HasOp(Atom a)
 OpEntry *
 Yap_OpPropForModule(Atom a, Term mod)
 {				/* look property list of atom a for kind  */
-  CACHE_REGS
   AtomEntry *ae = RepAtom(a);
   PropEntry *pp;
   OpEntry *info = NULL;
@@ -767,6 +766,7 @@ ExpandPredHash(void)
 Prop
 Yap_NewPredPropByFunctor(FunctorEntry *fe, Term cur_mod)
 {
+  CACHE_REGS
   PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
 
   if (p == NULL) {
@@ -902,6 +902,7 @@ Yap_NewThreadPred(PredEntry *ap USES_REGS)
 Prop
 Yap_NewPredPropByAtom(AtomEntry *ae, Term cur_mod)
 {
+  CACHE_REGS
   Prop p0;
   PredEntry *p = (PredEntry *) Yap_AllocAtomSpace(sizeof(*p));
 
diff --git a/C/amasm.c b/C/amasm.c
index 980f3064f..dd519afca 100644
--- a/C/amasm.c
+++ b/C/amasm.c
@@ -2053,6 +2053,7 @@ a_try(op_numbers opcode, CELL lab, CELL opr, int nofalts, int hascut, yamop *cod
     yamop *newcp;
     /* emit a special instruction and then a label for backpatching */
     if (pass_no) {
+      CACHE_REGS
       UInt size = (UInt)NEXTOP((yamop *)NULL,OtaLl);
       if ((newcp = (yamop *)Yap_AllocCodeSpace(size)) == NULL) {
 	/* OOOPS, got in trouble, must do a longjmp and recover space */
diff --git a/C/c_interface.c b/C/c_interface.c
index fefebe01d..bf96c7455 100644
--- a/C/c_interface.c
+++ b/C/c_interface.c
@@ -2706,7 +2706,6 @@ YAP_InitConsult(int mode, char *filename)
 X_API IOSTREAM *
 YAP_TermToStream(Term t)
 {
-  CACHE_REGS
   IOSTREAM *s;
   BACKUP_MACHINE_REGS();
 
@@ -4122,6 +4121,8 @@ YAP_ImportTerm(char * buf) {
 
 X_API int
 YAP_RequiresExtraStack(size_t sz) {
+  CACHE_REGS
+
   if (sz < 16*1024) 
     sz = 16*1024;
   if (H <= ASP-sz) {
diff --git a/C/cdmgr.c b/C/cdmgr.c
index 43754aa31..a19d747be 100644
--- a/C/cdmgr.c
+++ b/C/cdmgr.c
@@ -5107,6 +5107,8 @@ p_continue_static_clause( USES_REGS1 )
 static void
 add_code_in_lu_index(LogUpdIndex *cl, PredEntry *pp)
 {
+  CACHE_REGS
+
   char *code_end = (char *)cl + cl->ClSize;
   Yap_inform_profiler_of_clause(cl, code_end, pp, GPROF_LU_INDEX);
   cl = cl->ChildIndex;
@@ -5119,6 +5121,7 @@ add_code_in_lu_index(LogUpdIndex *cl, PredEntry *pp)
 static void
 add_code_in_static_index(StaticIndex *cl, PredEntry *pp)
 {
+  CACHE_REGS
   char *code_end = (char *)cl + cl->ClSize;
   Yap_inform_profiler_of_clause(cl, code_end, pp, GPROF_STATIC_INDEX);
   cl = cl->ChildIndex;
@@ -5131,6 +5134,7 @@ add_code_in_static_index(StaticIndex *cl, PredEntry *pp)
 
 static void
 add_code_in_pred(PredEntry *pp) {
+  CACHE_REGS
   yamop *clcode;
 
   PELOCK(49,pp);
@@ -5202,6 +5206,7 @@ add_code_in_pred(PredEntry *pp) {
 
 void
 Yap_dump_code_area_for_profiler(void) {
+  CACHE_REGS
   ModEntry *me = CurrentModules;
 
   while (me) {
diff --git a/C/dbase.c b/C/dbase.c
index a7edad4cd..565334911 100644
--- a/C/dbase.c
+++ b/C/dbase.c
@@ -1887,6 +1887,7 @@ Yap_new_ludbe(Term t, PredEntry *pe, UInt nargs)
 static LogUpdClause *
 record_lu(PredEntry *pe, Term t, int position)
 {
+  CACHE_REGS
   LogUpdClause *cl;
   
   if ((cl = new_lu_db_entry(t, pe)) == NULL) {
diff --git a/C/gprof.c b/C/gprof.c
index 9f9ea7e09..0f0944fed 100644
--- a/C/gprof.c
+++ b/C/gprof.c
@@ -168,6 +168,7 @@ RBfree(rb_red_blk_node *ptr)
 
 static rb_red_blk_node *
 RBTreeCreate(void) {
+  CACHE_REGS
   rb_red_blk_node* temp;
 
   /*  see the comment in the rb_red_blk_tree structure in red_black_tree.h */
@@ -210,6 +211,7 @@ RBTreeCreate(void) {
 
 static void
 LeftRotate(rb_red_blk_node* x) {
+  CACHE_REGS
   rb_red_blk_node* y;
   rb_red_blk_node* nil=LOCAL_ProfilerNil;
 
@@ -266,6 +268,7 @@ LeftRotate(rb_red_blk_node* x) {
 
 static void
 RightRotate(rb_red_blk_node* y) {
+  CACHE_REGS
   rb_red_blk_node* x;
   rb_red_blk_node* nil=LOCAL_ProfilerNil;
 
@@ -318,6 +321,7 @@ RightRotate(rb_red_blk_node* y) {
 
 static void
 TreeInsertHelp(rb_red_blk_node* z) {
+  CACHE_REGS
   /*  This function should only be called by InsertRBTree (see above) */
   rb_red_blk_node* x;
   rb_red_blk_node* y;
@@ -369,6 +373,7 @@ TreeInsertHelp(rb_red_blk_node* z) {
 
 static rb_red_blk_node *
 RBTreeInsert(yamop *key, yamop *lim) {
+  CACHE_REGS
   rb_red_blk_node * y;
   rb_red_blk_node * x;
   rb_red_blk_node * newNode;
@@ -440,6 +445,7 @@ RBTreeInsert(yamop *key, yamop *lim) {
   
 static rb_red_blk_node*
 RBExactQuery(yamop* q) {
+  CACHE_REGS
   rb_red_blk_node* x;
   rb_red_blk_node* nil=LOCAL_ProfilerNil;
 
@@ -460,6 +466,7 @@ RBExactQuery(yamop* q) {
 
 static rb_red_blk_node*
 RBLookup(yamop *entry) {
+  CACHE_REGS
   rb_red_blk_node *current;
 
   if (!LOCAL_ProfilerRoot)
@@ -495,6 +502,7 @@ RBLookup(yamop *entry) {
 /***********************************************************************/
 
 static void RBDeleteFixUp(rb_red_blk_node* x) {
+  CACHE_REGS
   rb_red_blk_node* root=LOCAL_ProfilerRoot->left;
   rb_red_blk_node *w;
 
@@ -574,6 +582,7 @@ static void RBDeleteFixUp(rb_red_blk_node* x) {
   
 static rb_red_blk_node*
 TreeSuccessor(rb_red_blk_node* x) { 
+  CACHE_REGS
   rb_red_blk_node* y;
   rb_red_blk_node* nil=LOCAL_ProfilerNil;
   rb_red_blk_node* root=LOCAL_ProfilerRoot;
@@ -612,6 +621,7 @@ TreeSuccessor(rb_red_blk_node* x) {
 
 static void
 RBDelete(rb_red_blk_node* z){
+  CACHE_REGS
   rb_red_blk_node* y;
   rb_red_blk_node* x;
   rb_red_blk_node* nil=LOCAL_ProfilerNil;
@@ -664,7 +674,8 @@ RBDelete(rb_red_blk_node* z){
 
 char *set_profile_dir(char *);
 char *set_profile_dir(char *name){
-int size=0;
+  CACHE_REGS
+    int size=0;
 
     if (name!=NULL) {
       size=strlen(name)+1;
@@ -687,8 +698,9 @@ return LOCAL_DIRNAME;
 
 char *profile_names(int);
 char *profile_names(int k) {
-static char *FNAME=NULL;
-int size=200;
+  CACHE_REGS
+  static char *FNAME=NULL;
+  int size=200;
    
   if (LOCAL_DIRNAME==NULL) set_profile_dir(NULL);
   size=strlen(LOCAL_DIRNAME)+40;
@@ -709,6 +721,7 @@ int size=200;
 
 void del_profile_files(void);
 void del_profile_files() {
+  CACHE_REGS
   if (LOCAL_DIRNAME!=NULL) {
     remove(profile_names(PROFPREDS_FILE));
     remove(profile_names(PROFILING_FILE));
@@ -717,6 +730,7 @@ void del_profile_files() {
 
 void
 Yap_inform_profiler_of_clause__(void *code_start, void *code_end, PredEntry *pe,gprof_info index_code) {
+  CACHE_REGS
   buf_ptr b;
   buf_extra e;
   LOCAL_ProfOn = TRUE;
@@ -742,6 +756,7 @@ static Int profend( USES_REGS1 );
 
 static void
 clean_tree(rb_red_blk_node* node) {
+  CACHE_REGS
   if (node == LOCAL_ProfilerNil)
     return;
   clean_tree(node->left);
@@ -751,6 +766,7 @@ clean_tree(rb_red_blk_node* node) {
 
 static void
 reset_tree(void) {
+  CACHE_REGS
   clean_tree(LOCAL_ProfilerRoot);
   Yap_FreeCodeSpace((char *)LOCAL_ProfilerNil);
   LOCAL_ProfilerNil = LOCAL_ProfilerRoot = NULL;
@@ -760,6 +776,7 @@ reset_tree(void) {
 static int
 InitProfTree(void)
 {
+  CACHE_REGS
   if (LOCAL_ProfilerRoot) 
     reset_tree();
   while (!(LOCAL_ProfilerRoot = RBTreeCreate())) {
@@ -773,6 +790,7 @@ InitProfTree(void)
 
 static void RemoveCode(CODEADDR clau)
 {
+  CACHE_REGS
   rb_red_blk_node* x, *node;
   PredEntry *pp;
   UInt count;
@@ -958,6 +976,7 @@ prof_alrm(int signo, siginfo_t *si, void *scv)
 void
 Yap_InformOfRemoval(void *clau)
 {
+  CACHE_REGS
   LOCAL_ProfOn = TRUE;
   if (LOCAL_FPreds != NULL) {
     /* just store info about what is going on  */
@@ -1048,6 +1067,7 @@ static Int profinit( USES_REGS1 )
 
 static Int start_profilers(int msec)
 {
+  CACHE_REGS
   struct itimerval t;
   struct sigaction sa;
   
@@ -1157,6 +1177,7 @@ static Int profres0( USES_REGS1 ) {
 void
 Yap_InitLowProf(void)
 {
+  CACHE_REGS
 #if LOW_PROF
   LOCAL_ProfCalls = 0;
   LOCAL_ProfilerOn = FALSE;
diff --git a/C/index.c b/C/index.c
index 0396d98e8..b98e77fe6 100644
--- a/C/index.c
+++ b/C/index.c
@@ -1888,6 +1888,7 @@ emit_single_switch_case(ClauseDef *min, struct intermediates *cint, int first, i
 static UInt
 suspend_indexing(ClauseDef *min, ClauseDef *max, PredEntry *ap, struct intermediates *cint)
 {
+  CACHE_REGS
   UInt tcls = ap->cs.p_code.NOfClauses;
   UInt cls = (max-min)+1;
 
diff --git a/C/sysbits.c b/C/sysbits.c
index 8aaec44bd..639bdc425 100644
--- a/C/sysbits.c
+++ b/C/sysbits.c
@@ -1619,6 +1619,7 @@ InteractSIGINT(int ch) {
 static int
 ProcessSIGINT(void)
 {
+  CACHE_REGS
   int ch, out;
 
   LOCAL_PrologMode |= AsyncIntMode;
diff --git a/C/utilpreds.c b/C/utilpreds.c
index 851aa4fc7..1beb1381a 100644
--- a/C/utilpreds.c
+++ b/C/utilpreds.c
@@ -4255,7 +4255,7 @@ p_is_list_or_partial_list( USES_REGS1 )
 }
 
 static Term
-numbervar(Int id)
+numbervar(Int id USES_REGS)
 {
   Term ts[1];
   ts[0] = MkIntegerTerm(id);
@@ -4263,7 +4263,7 @@ numbervar(Int id)
 }
 
 static Term
-numbervar_singleton(void)
+numbervar_singleton(USES_REGS1)
 {
   Term ts[1];
   ts[0] = MkIntegerTerm(-1);
@@ -4356,9 +4356,9 @@ static Int numbervars_in_complex_term(register CELL *pt0, register CELL *pt0_end
     derefa_body(d0, ptd0, vars_in_term_unk, vars_in_term_nvar);
     /* do or pt2 are unbound  */
     if (singles) 
-      *ptd0 = numbervar_singleton();
+      *ptd0 = numbervar_singleton( PASS_REGS1 );
     else
-      *ptd0 = numbervar(numbv++);
+      *ptd0 = numbervar(numbv++ PASS_REGS);
     /* leave an empty slot to fill in later */
     if (H+1024 > ASP) {
       goto global_overflow;
@@ -4450,10 +4450,10 @@ Yap_NumberVars( Term inp, Int numbv, int handle_singles )	/* numbervariables in
     CELL *ptd0 = VarOfTerm(t);
     TrailTerm(TR++) = (CELL)ptd0;
     if (handle_singles) {
-      *ptd0 = numbervar_singleton();
+      *ptd0 = numbervar_singleton( PASS_REGS1 );
       return numbv;
     } else {
-      *ptd0 = numbervar(numbv);
+      *ptd0 = numbervar(numbv PASS_REGS);
       return numbv+1;
     }
   }  else if (IsPrimitiveTerm(t)) {

From 8c2dd1f847e229facd930fd9cd999338b6ad6142 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= <vsc@dcc.fc.up.pt>
Date: Thu, 12 Apr 2012 17:17:21 +0100
Subject: [PATCH 4/6] fix bad call for parameters.

---
 packages/CLPBN/clpbn/ground_factors.yap | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/packages/CLPBN/clpbn/ground_factors.yap b/packages/CLPBN/clpbn/ground_factors.yap
index 964a940fa..1ec748b43 100644
--- a/packages/CLPBN/clpbn/ground_factors.yap
+++ b/packages/CLPBN/clpbn/ground_factors.yap
@@ -110,8 +110,9 @@ find_factors(K) :-
 	\+ currently_defined(K1),
 	find_factors(K1).
 
-add_factor(factor(Type, _Id, Ks, _, CPT, Constraints), Ks) :-
+add_factor(factor(Type, _Id, Ks, _, Phi, Constraints), Ks) :-
 	F = f(Type, Ks, CPT),
+	( is_list(Phi) -> CPT = Phi ; call(user:Phi, CPT) ),
 	run(Constraints),
 	\+ f(Type, Ks, CPT),
 	assert(F).

From c5f42cd7eb1e189f4725f69fa2e24be4502982c1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= <vsc@dcc.fc.up.pt>
Date: Thu, 12 Apr 2012 17:24:39 +0100
Subject: [PATCH 5/6] more pfl changes.

---
 packages/CLPBN/clpbn/bdd.yap                  | 297 ++++++++++++------
 packages/CLPBN/clpbn/bp.yap                   |   6 +-
 packages/CLPBN/clpbn/bp/examples/city.yap     |   2 +-
 packages/CLPBN/clpbn/dists.yap                |  18 +-
 .../CLPBN/examples/School/school32_data.yap   |   8 +-
 packages/CLPBN/pfl.yap                        |   3 +
 6 files changed, 219 insertions(+), 115 deletions(-)

diff --git a/packages/CLPBN/clpbn/bdd.yap b/packages/CLPBN/clpbn/bdd.yap
index 0270f1a94..a41ce957d 100644
--- a/packages/CLPBN/clpbn/bdd.yap
+++ b/packages/CLPBN/clpbn/bdd.yap
@@ -31,6 +31,7 @@ Va <- P*X1*Y1 + Q*X2*Y2 + ...
           [dist/4,
            get_dist_domain/2,
            get_dist_domain_size/2,
+           get_dist_all_sizes/2,
            get_dist_params/2
           ]).
 
@@ -54,6 +55,10 @@ Va <- P*X1*Y1 + Q*X2*Y2 + ...
 
 :- use_module(library(rbtrees)).
 
+:- use_module(library(bhash)).
+
+:- use_module(library(matrix)).
+
 :- dynamic network_counting/1.
 
 :- attribute order/1.
@@ -120,15 +125,16 @@ get_vars_info([_|MoreVs], Vs0, VsF, Ps0, PsF, VarsInfo, Lvs, Outs) :-
 %
 % let's have some fun with avg
 %
-get_var_info(V, avg(Domain), Parents0, Vs, Vs2, Ps, Ps, Lvs, Outs, DIST) :- !,
-	reorder_vars(Parents0, Parents),
+get_var_info(V, avg(Domain), Parents, Vs, Vs2, Ps, Ps, Lvs, Outs, DIST) :- !,
 	length(Domain, DSize),
-	run_though_avg(V, DSize, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST).
+%	run_though_avg(V, DSize, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST).
+	top_down_with_tabling(V, DSize, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST).
 %	bup_avg(V, DSize, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST).
 % standard random variable
-get_var_info(V, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
+get_var_info(V, DistId, Parents0, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
 % clpbn:get_atts(V, [key(K)]), writeln(V:K:DistId:Parents),
-	check_p(DistId, Parms, _ParmVars, Ps, Ps1),
+	reorder_vars(Parents0, Parents, Map),
+	check_p(DistId, Map, Parms, _ParmVars, Ps, Ps1),
 	unbound_parms(Parms, ParmVars),
 	check_v(V, DistId, DIST, Vs, Vs1),
 	DIST = info(V, Tree, Ev, Values, Formula, ParmVars, Parms),
@@ -139,26 +145,34 @@ get_var_info(V, DistId, Parents, Vs, Vs2, Ps, Ps1, Lvs, Outs, DIST) :-
 	get_evidence(V, Tree, Ev, Formula0, Formula, Lvs, Outs).
 %,	(numbervars(Formula,0,_),writeln(formula:Formula), fail ; true)
 
-reorder_vars(Vs, OVs) :-
-	add_pos(Vs, PVs),
+%
+% reorder all variables and make sure we get a
+% map of how the transfer was done.
+%
+% position zero is output
+%
+reorder_vars(Vs, OVs, Map) :-
+	add_pos(Vs, 1, PVs),
 	keysort(PVs, SVs),
-	remove_key(SVs, OVs).
+	remove_key(SVs, OVs, Map).
 
-add_pos([], []).
-add_pos([V|Vs], [K-V|PVs]) :-
+add_pos([], _, []).
+add_pos([V|Vs], I0, [K-(I0,V)|PVs]) :-
 	get_atts(V,[order(K)]),
-	add_pos(Vs, PVs).
+	I is I0+1,
+	add_pos(Vs, I, PVs).
 
-remove_key([], []).
-remove_key([_-V|SVs], [V|OVs]) :-
-	remove_key(SVs, OVs).
+remove_key([], [], []).
+remove_key([_-(I,V)|SVs], [V|OVs], [I|Map]) :-
+	remove_key(SVs, OVs, Map).
 
 %%%%%%%%%%%%%%%%%%%%%%%%%
 %
 % use top-down to generate average
 %
-run_though_avg(V, 3, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST) :-
-	check_v(V, avg(Domain,Parents), DIST, Vs, Vs1),
+run_though_avg(V, 3, Domain, Parents0, Vs, Vs2, Lvs, Outs, DIST) :-
+	reorder_vars(Parents0, Parents, _Map),
+	check_v(V, avg(Domain,Parents0), DIST, Vs, Vs1),
 	DIST = info(V, Tree, Ev, [V0,V1,V2], Formula, [], []),
 	get_parents(Parents, PVars, Vs1, Vs2),
 	length(Parents, N),
@@ -229,17 +243,81 @@ not_satisf(I0, I1, I2, IR, N0, N1, N2, R, Exp) :-
 
 %%%%%%%%%%%%%%%%%%%%%%%%%
 %
-% use bottom-up dynamic programming to generate average
+% use top-down to generate average
 %
-bup_avg(V, Size, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST) :-
+top_down_with_tabling(V, Size, Domain, Parents0, Vs, Vs2, Lvs, Outs, DIST) :-
+	reorder_vars(Parents0, Parents, _Map),
 	check_v(V, avg(Domain,Parents), DIST, Vs, Vs1),
 	DIST = info(V, Tree, Ev, OVs, Formula, [], []),
 	get_parents(Parents, PVars, Vs1, Vs2),
-%	generate_sums(PVars, Size, Max, Sums, F0),
-	bin_sums(PVars, Sums, F00),
-	reverse(F00,F0),
 	length(Parents, N),
 	Max is (Size-1)*N, % This should be true
+	avg_borders(0, Size, Max, Borders),
+	b_hash_new(H0),
+	avg_trees(0, Max, PVars, Size, F1, 0, Borders, OVs, Ev, H0, H),
+	generate_avg_code(H, Formula, F),
+%	Formula0 = [V0=F0*Ev0,V2=F2*Ev2,V1=not(F0+F2)*Ev1],
+%	Ev = [Ev0,Ev1,Ev2],
+	get_evidence(V, Tree, Ev, F1, F, Lvs, Outs).
+
+avg_trees(Size, _, _, Size, F0, _, F0, [], [], H, H) :- !.
+avg_trees(I0, Max, PVars, Size, [V=O*E|F0], Im, [IM|Borders], [V|OVs], [E|Ev], H0, H) :-
+	I is I0+1,
+	avg_tree(PVars, 0, Max, Im, IM, Size, O, H0, HI),
+	Im1 is IM+1,
+	avg_trees(I, Max, PVars, Size, F0, Im1, Borders, OVs, Ev, HI, H).
+
+avg_tree( _PVars, P, _, Im, IM, _Size, O, H0, H0) :-
+	b_hash_lookup(k(P,Im,IM), O=_Exp, H0), !.
+avg_tree([], _P, _Max, _Im, _IM, _Size, 1, H, H).
+avg_tree([Vals|PVars], P, Max, Im, IM, Size, O, H0, HF) :-
+	b_hash_insert(H0, k(P,Im,IM), O=Simp, HI),
+	MaxI is Max-(Size-1),
+	avg_exp(Vals, PVars, 0, P, MaxI, Size, Im, IM, HI, HF, Exp),
+	simplify_exp(Exp, Simp).
+	
+avg_exp([], _, _, _P, _Max, _Size, _Im, _IM, H, H, 0).
+avg_exp([Val|Vals], PVars, I0, P0, Max, Size, Im, IM, HI, HF, O) :-
+	(Vals = [] -> O=O1 ; O = Val*O1+not(Val)*O2 ),
+	Im1 is max(0, Im-I0),
+	IM1 is IM-I0,
+	( IM1 < 0 -> O1 = 0, H2 = HI;      /* we have exceed maximum */
+	  Im1 > Max -> O1 = 0, H2 = HI;  /* we cannot make to minimum */
+	  Im1 = 0, IM1 > Max -> O1 = 1, H2 = HI;  /* we cannot exceed maximum */
+	  P is P0+1,
+	  avg_tree(PVars, P, Max, Im1, IM1, Size, O1, HI, H2)
+        ),
+	I is I0+1,
+	avg_exp(Vals, PVars, I, P0, Max, Size, Im, IM, H2, HF, O2).
+
+generate_avg_code(H, Formula, Formula0) :-
+	b_hash_to_list(H,L),
+	sort(L, S),
+	strip_and_add(S, Formula0, Formula).
+
+strip_and_add([], F, F).
+strip_and_add([_-Exp|S], F0, F) :-
+	strip_and_add(S, [Exp|F0], F).
+
+%%%%%%%%%%%%%%%%%%%%%%%%%
+%
+% use bottom-up dynamic programming to generate average
+%
+bup_avg(V, Size, Domain, Parents0, Vs, Vs2, Lvs, Outs, DIST) :-
+	reorder_vars(Parents0, Parents, _),
+	check_v(V, avg(Domain,Parents), DIST, Vs, Vs1),
+	DIST = info(V, Tree, Ev, OVs, Formula, [], []),
+	get_parents(Parents, PVars, Vs1, Vs2),
+	length(Parents, N),
+	Max is (Size-1)*N, % This should be true
+	ArraySize is Max+1,
+	functor(Protected, protected, ArraySize),
+	avg_domains(0, Size, 0, Max, LDomains),
+	Domains =.. [d|LDomains],
+	Reach is (Size-1),
+	generate_sums(PVars, Size, Max, Reach, Protected, Domains, ArraySize, Sums, F0),
+%	bin_sums(PVars, Sums, F00),
+%	reverse(F00,F0),
 	% easier to do recursion on lists
 	Sums =.. [_|LSums],
 	generate_avg(0, Size, 0, Max, LSums, OVs, Ev, F1, []),
@@ -247,9 +325,11 @@ bup_avg(V, Size, Domain, Parents, Vs, Vs2, Lvs, Outs, DIST) :-
 	get_evidence(V, Tree, Ev, F1, F2, Lvs, Outs),
 	append(RF0, F2, Formula).
 
+%
+% use binary approach, like what is standard
+%
 bin_sums(Vs, Sums, F) :-
 	 vs_to_sums(Vs, Sums0),
-	 writeln(init:Sums0),
 	 bin_sums(Sums0, Sums, F, []).
 	
 vs_to_sums([], []).
@@ -258,15 +338,21 @@ vs_to_sums([V|Vs], [Sum|Sums0]) :-
 	  vs_to_sums(Vs, Sums0).
 
 bin_sums([Sum], Sum) --> !.
-bin_sums(LSums, Sums) --> 
-	pack_bins(LSums, Sums1),
-	bin_sums(Sums1, Sums).
+bin_sums(LSums, Sum) --> 
+	{ halve(LSums, Sums1, Sums2) },
+	bin_sums(Sums1, Sum1),
+	bin_sums(Sums2, Sum2),
+	sum(Sum1, Sum2, Sum).
 
-pack_bins([], []) --> [].
-pack_bins([Sum], [Sum]) --> [].
-pack_bins([Sum1,Sum2|LSums], [Sum|NSums]) -->
-	sum(Sum1, Sum2, Sum),
-	pack_bins(LSums, NSums).
+halve(LSums, Sums1, Sums2) :-
+	length(LSums, L),
+	Take is L div 2,
+	head(Take, LSums, Sums1, Sums2).
+
+head(0, L, [], L) :- !.
+head(Take, [H|L], [H|Sums1], Sum2) :-
+	Take1 is Take-1,
+	head(Take1, L, Sums1, Sum2).
 
 sum(Sum1, Sum2, Sum) -->
 	  { functor(Sum1, _, M1),
@@ -278,44 +364,73 @@ sum(Sum1, Sum2, Sum) -->
 	    Sum1 =.. [_|PVals] },
 	  expand_sums(PVals, 0, Max0, Max1, M2, Sum2, Sum).
 
-generate_sums([PVals], Size, Max, Sum, []) :- !,
+%
+% bottom up step by step
+%
+%
+generate_sums([PVals], Size, Max, _, _Protected, _Domains, _, Sum, []) :- !,
 	Max is Size-1,
 	Sum =.. [sum|PVals].
-generate_sums([PVals|Parents], Size, Max, NewSums, F) :-
-	generate_sums(Parents, Size, Max0, Sums, F0),
+generate_sums([PVals|Parents], Size, Max, Reach, Protected, Domains, ASize, NewSums, F) :-
+	NewReach is Reach+(Size-1),
+	generate_sums(Parents, Size, Max0, NewReach, Protected, Domains, ASize, Sums, F0),
 	Max is Max0+(Size-1),
 	Max1 is Max+1,
 	functor(NewSums, sum, Max1),
-	expand_sums(PVals, 0, Max0, Max1, Size, Sums, NewSums, F, F0).
+	protect_avg(0, Max0, Protected, Domains, ASize, Reach),
+	expand_sums(PVals, 0, Max0, Max1, Size, Sums, Protected, NewSums, F, F0).
+
+protect_avg(Max0,Max0,_Protected, _Domains, _ASize, _Reach) :- !.
+protect_avg(I0, Max0, Protected, Domains, ASize, Reach) :-
+	I is I0+1,
+	Top is I+Reach,
+	( Top > ASize ;
+	    arg(I, Domains, CD),
+	    arg(Top, Domains, CD)
+	), !,
+	arg(I, Protected, yes),
+	protect_avg(I, Max0, Protected, Domains, ASize, Reach).
+protect_avg(I0, Max0, Protected, Domains, ASize, Reach) :-
+	I is I0+1,
+	protect_avg(I, Max0, Protected, Domains, ASize, Reach).
+
 
 %
 % outer loop: generate array of sums at level j= Sum[j0...jMax]
 %
-expand_sums(_Parents, Max, _, Max, _Size, _Sums, _NewSums, F0, F0) :- !.
-expand_sums(Parents, I0, Max0, Max, Size, Sums, NewSums, [O=SUM|F], F0) :-
+expand_sums(_Parents, Max, _, Max, _Size, _Sums, _P, _NewSums, F0, F0) :- !.
+expand_sums(Parents, I0, Max0, Max, Size, Sums, Prot, NewSums, [O=SUM|F], F0) :-
 	I is I0+1,
+	arg(I, Prot, P),
+	var(P), !,
 	arg(I, NewSums, O),
 	sum_all(Parents, 0, I0, Max0, Sums, List),
 	to_disj(List, SUM),
-        expand_sums(Parents, I, Max0, Max, Size, Sums, NewSums, F, F0).
+        expand_sums(Parents, I, Max0, Max, Size, Sums, Prot, NewSums, F, F0).
+expand_sums(Parents, I0, Max0, Max, Size, Sums, Prot, NewSums, F, F0) :-
+	I is I0+1,
+	arg(I, Sums, O),
+	arg(I, NewSums, O),
+        expand_sums(Parents, I, Max0, Max, Size, Sums, Prot, NewSums, F, F0).
 
 %
 %inner loop: find all parents that contribute to A_ji,
 % that is generate Pk*Sum_(j-1)l and k+l st k+l = i
 %
 sum_all([], _, _, _, _, []).
-sum_all([V|Vs], Pos, I, Max0, Sums, [V*S0|List]) :-
+sum_all([V|Vs], Pos, I, Max0, Sums, [O|List]) :-
 	J is I-Pos,
 	J >= 0,
 	J =< Max0, !,
 	J1 is J+1,
 	arg(J1, Sums, S0),
+	( J < I -> O = V*S0 ; O = S0*V ),
 	Pos1 is Pos+1,
 	sum_all(Vs, Pos1, I, Max0, Sums, List).
 sum_all([_V|Vs], Pos, I, Max0, Sums, List) :-
 	Pos1 is Pos+1,
 	sum_all(Vs, Pos1, I, Max0, Sums, List).
-	
+
 gen_arg(J, Sums, Max, S0) :-
 	gen_arg(0, Max, J, Sums, S0).
 	
@@ -330,6 +445,26 @@ gen_arg(I0, Max, J, Sums, S) :-
 	gen_arg(I, Max, J, Sums, S0).
 
 
+avg_borders(Size, Size, _Max, []) :- !.
+avg_borders(I0, Size, Max, [J|Vals]) :-
+	I is I0+1,
+	Border is (I*Max)/Size,
+	J is integer(round(Border)),
+	avg_borders(I, Size, Max, Vals).
+
+avg_domains(Size, Size, _J, _Max, []).
+avg_domains(I0, Size, J0, Max, Vals) :-
+	I is I0+1,
+	Border is (I*Max)/Size,
+	fetch_domain_for_avg(J0, Border, J, I0, Vals, ValsI),
+	avg_domains(I, Size, J, Max, ValsI).
+
+fetch_domain_for_avg(J, Border, J, _, Vals, Vals) :-
+	J > Border, !.
+fetch_domain_for_avg(J0, Border, J, I0, [I0|LVals], RLVals) :-
+	J1 is J0+1,
+	fetch_domain_for_avg(J1, Border, J, I0, LVals, RLVals).
+
 generate_avg(Size, Size, _J, _Max, [], [], [], F, F).
 generate_avg(I0, Size, J0, Max, LSums, [O|OVs], [Ev|Evs], [O=Ev*Disj|F], F0) :-
 	I is I0+1,
@@ -359,18 +494,25 @@ to_disj2([V,V1|Vs], V0, Out) :-
 % look for parameters in the rb-tree, or add a new.
 % distid is the key
 %
-check_p(DistId, Parms, ParmVars, Ps, Ps) :-
-	rb_lookup(DistId, theta(Parms, ParmVars), Ps), !.
-check_p(DistId, Parms, ParmVars, Ps, PsF) :-
+check_p(DistId, Map, Parms, ParmVars, Ps, Ps) :-
+	rb_lookup(DistId-Map, theta(Parms, ParmVars), Ps), !.
+check_p(DistId, Map, Parms, ParmVars, Ps, PsF) :-
 	get_dist_params(DistId, Parms0),
-	length(Parms0, L0),
+	get_dist_all_sizes(DistId, Sizes),
+	swap_parms(Parms0, Sizes, [0|Map], Parms1),
+	length(Parms1, L0),
 	get_dist_domain_size(DistId, Size),
 	L1 is L0 div Size,
 	L is L0-L1,
 	initial_maxes(L1, Multipliers),
-	copy(L, Multipliers, NextMults, NextMults, Parms0, Parms, ParmVars),
+	copy(L, Multipliers, NextMults, NextMults, Parms1, Parms, ParmVars),
 %writeln(t:Size:Parms0:Parms:ParmVars),
-	rb_insert(Ps, DistId, theta(Parms, ParmVars), PsF).
+	rb_insert(Ps, DistId-Map, theta(Parms, ParmVars), PsF).
+
+swap_parms(Parms0, Sizes, Map, Parms1) :-
+	matrix_new(floats, Sizes, Parms0, T0),
+	matrix_shuffle(T0,Map,TF),
+	matrix_to_list(TF, Parms1).
 
 %
 % we are using switches by two
@@ -387,18 +529,19 @@ copy(N, D.Ds, ND.NDs, New, El.Parms0, NEl.Parms, V.ParmVars) :-
 	N1 is N-1,
 	(El == 0.0 -> 
 	    NEl = 0,
-	    ND = D,
-	    V = NEl
+	    V = NEl,
+	    ND = D
 	;El == 1.0 -> 
 	    NEl = 1,
-	    ND = 0.0,
-	    V = NEl
+	    V = NEl,
+	    ND = 0.0
 	;El == 0 -> 
 	    NEl = 0,
-	    ND = D,
-	    V = NEl
+	    V = NEl,
+	    ND = D
 	;El =:= 1 -> 
 	    NEl = 1,
+	    V = NEl,
 	    ND = 0.0,
 	    V = NEl
 	;
@@ -585,52 +728,6 @@ eval_outs((V=F).Outs) :-
 	V = NF,
 	eval_outs(Outs).
 
-%simplify_exp(V,V) :- !.
-simplify_exp(V,V) :- var(V), !.
-simplify_exp(S1+S2,NS) :- !,
-	simplify_exp(S1, SS1),
-	simplify_exp(S2, SS2),
-	simplify_sum(SS1, SS2, NS).
-simplify_exp(S1*S2,NS) :- !,
-	simplify_exp(S1, SS1),
-	simplify_exp(S2, SS2),
-	simplify_prod(SS1, SS2, NS).
-simplify_exp(not(S),NS) :- !,
-	simplify_exp(S, SS),
-	simplify_not(SS, NS).
-simplify_exp(S,S).
-
-simplify_sum(V1, V2, O) :- 
-	( var(V1) ->
-	    ( var(V2) ->
-		( V1 == V2 -> O = V1 ; O = V1+V2 ) ; /* var(V1) , var(V2) */
-		( V2 == 0 -> O = V1 ; V2 == 1 -> O = 1 ; O = V1+V2 ) /* var(V1) , nonvar(V2) */
-	    ) ;
-	    ( var(V2) ->
-		( V1 == 0 -> O = V2 ; V1 == 1 -> O = 1 ; O = V1+V2 ) ; /* nonvar(V1) , var(V2) */
-		( V2 == 0 -> O = V1 ; V2 == 1 -> O = 1 ; V1 == 0 -> O = V2 ; V1 == 1 -> O = 1; O = V1+V2 ) /* nonvar(V1) , nonvar(V2) */
-	    )
-	).
-
-simplify_prod(V1, V2, O) :- 
-	( var(V1) ->
-	    ( var(V2) ->
-		( V1 == V2 -> O = V1 ; O = V1*V2 ) ; /* var(V1) , var(V2) */
-		( V2 == 0 -> O = 0 ; V2 == 1 -> O = V1 ; O = V1*V2 ) /* var(V1) , nonvar(V2) */
-	    ) ;
-	    ( var(V2) ->
-		( V1 == 0 -> O = 0 ; V1 == 1 -> O = V2 ; O = V1*V2 ) ; /* nonvar(V1) , var(V2) */
-		( V2 == 0 -> O = 0 ; V2 == 1 -> O = V1 ; V1 == 0 -> O = 0 ; V1 == 1 -> O = V2; V1 == V2 -> O = V1 ; O = V1*V2 ) /* nonvar(V1) , nonvar(V2) */
-	    )
-	).
-
-
-simplify_not(V, not(V)) :- var(V), !.
-simplify_not(0, 1) :- !.
-simplify_not(1, 0) :- !.
-simplify_not(SS, not(SS)).
-
-
 run_bdd_solver([[V]], LPs, bdd(Term, _Leaves, Nodes)) :-
 	build_out_node(Nodes, Node),
 	findall(Prob, get_prob(Term, Node, V, Prob),TermProbs),
@@ -658,9 +755,9 @@ get_prob(Term, Node, V, SP) :-
 build_bdd(Bindings, NVs, VTheta, Theta, Bdd) :-
 	bdd_from_list(Bindings, NVs, Bdd),
 	bdd_size(Bdd, Len),
-%	number_codes(Len,Codes),
-%	atom_codes(Name,Codes),
-%	bdd_print(Bdd, Name),
+	number_codes(Len,Codes),
+	atom_codes(Name,Codes),
+	bdd_print(Bdd, Name),
 	writeln(length=Len),
 	VTheta = Theta.
 
diff --git a/packages/CLPBN/clpbn/bp.yap b/packages/CLPBN/clpbn/bp.yap
index f825579ce..4c9894fdd 100644
--- a/packages/CLPBN/clpbn/bp.yap
+++ b/packages/CLPBN/clpbn/bp.yap
@@ -57,7 +57,7 @@
           ]).
 
 
-call_bp_ground(QueryKeys, AllKeys, Factors, Evidence, Output) :-
+call_bp_ground(QueryKeys, AllKeys, Factors, Evidence, _Output) :-
   b_hash_new(Hash0),
   keys_to_ids(AllKeys, 0, Hash0, Hash),
   get_factors_type(Factors, Type),
@@ -74,7 +74,7 @@ call_bp_ground(QueryKeys, AllKeys, Factors, Evidence, Output) :-
   %set_vars_information(AllKeys, StatesNames),
   run_solver(ground(Network,Hash), QueryKeys, Solutions),
   writeln(answer:Solutions),
-  %clpbn_bind_vals([QueryKeys], Solutions, Output).
+  %clpbn_bind_vals([QueryKeys], Solutions, _Output).
   free_ground_network(Network).
 
 
@@ -146,7 +146,7 @@ bp([QueryVars], AllVars, Output) :-
 
 init_bp_solver(_, AllVars0, _, bp(BayesNet, DistIds)) :-
   %check_for_agg_vars(AllVars0, AllVars),
-  get_vars_info(AllVars, VarsInfo, DistIds0),
+  get_vars_info(AllVars0, VarsInfo, DistIds0),
   sort(DistIds0, DistIds),
   create_ground_network(VarsInfo, BayesNet),
   true.
diff --git a/packages/CLPBN/clpbn/bp/examples/city.yap b/packages/CLPBN/clpbn/bp/examples/city.yap
index 97cee27b3..eb310d1ec 100644
--- a/packages/CLPBN/clpbn/bp/examples/city.yap
+++ b/packages/CLPBN/clpbn/bp/examples/city.yap
@@ -2,7 +2,7 @@
 
 :- clpbn_horus:set_solver(fove).
 %:- clpbn_horus:set_solver(hve).
-%:- clpbn_horus:set_solver(bp).
+:- clpbn_horus:set_solver(bp).
 %:- clpbn_horus:set_solver(cbp).
 
 
diff --git a/packages/CLPBN/clpbn/dists.yap b/packages/CLPBN/clpbn/dists.yap
index 837edf85f..cbc5033d5 100644
--- a/packages/CLPBN/clpbn/dists.yap
+++ b/packages/CLPBN/clpbn/dists.yap
@@ -15,6 +15,7 @@
 	   get_dist_domain_size/2,
 	   get_dist_params/2,
 	   get_dist_key/2,
+	   get_dist_all_sizes/2,
 	   get_evidence_position/3,
 	   get_evidence_from_position/3,
 	   dist_to_term/2,
@@ -177,21 +178,21 @@ add_dist(Domain, Type, CPT, Parents, Key, Id) :-
 	length(CPT, CPTSize),
 	length(Domain, DSize),
 	new_id(Id),
-	record_parent_sizes(Parents, Id, PSizes, [DSize|PSizes]),
+	find_parent_sizes(Parents, Id, PSizes, [DSize|PSizes]),
 	recordz(clpbn_dist_db,db(Id, Key, CPT, Type, Domain, CPTSize, DSize),_).
 
 
-record_parent_sizes([], Id, [], DSizes) :-
+find_parent_sizes([], Id, [], DSizes) :-
 	recordz(clpbn_dist_psizes,db(Id, DSizes),_).
-record_parent_sizes([P|Parents], Id, [Size|Sizes], DSizes) :-
+find_parent_sizes([P|Parents], Id, [Size|Sizes], DSizes) :-
 	integer(P), !,
 	Size = P,
-	record_parent_sizes(Parents, Id, Sizes, DSizes).
-record_parent_sizes([P|Parents], Id, [Size|Sizes], DSizes) :-
+	find_parent_sizes(Parents, Id, Sizes, DSizes).
+find_parent_sizes([P|Parents], Id, [Size|Sizes], DSizes) :-
 	clpbn:get_atts(P,dist(Dist,_)), !,
 	get_dist_domain_size(Dist, Size),
-	record_parent_sizes(Parents, Id, Sizes, DSizes).
-record_parent_sizes([_|_], _, _, _).
+	find_parent_sizes(Parents, Id, Sizes, DSizes).
+find_parent_sizes([_|_], _, _, _).
 
 %
 % Often, * is used to code empty in HMMs.
@@ -228,6 +229,9 @@ get_dsizes([P|Parents], [Sz|Sizes], Sizes0) :-
 get_dist_params(Id, Parms) :-
 	recorded(clpbn_dist_db, db(Id, _, Parms, _, _, _, _), _).
 
+get_dist_all_sizes(Id, DSizes) :-
+	recorded(clpbn_dist_psizes,db(Id, DSizes),_).
+
 get_dist_domain_size(DistId, DSize) :-
 	use_parfactors(on), !,
 	pfl:get_pfl_parameters(DistId, Dist),
diff --git a/packages/CLPBN/examples/School/school32_data.yap b/packages/CLPBN/examples/School/school32_data.yap
index 9614991d8..2bb503687 100644
--- a/packages/CLPBN/examples/School/school32_data.yap
+++ b/packages/CLPBN/examples/School/school32_data.yap
@@ -425,7 +425,7 @@ registration(r65,c22,s20).
 registration(r66,c43,s20).
 registration(r67,c17,s21).
 registration(r68,c34,s21).
-registration(r69,c0,s21).
+%registration(r69,c0,s21).
 registration(r70,c42,s22).
 registration(r71,c7,s22).
 registration(r72,c46,s22).
@@ -515,7 +515,7 @@ registration(r155,c57,s46).
 registration(r156,c25,s46).
 registration(r157,c46,s46).
 registration(r158,c15,s46).
-registration(r159,c0,s47).
+%registration(r159,c0,s47).
 registration(r160,c33,s47).
 registration(r161,c30,s47).
 registration(r162,c55,s47).
@@ -544,7 +544,7 @@ registration(r184,c50,s54).
 registration(r185,c43,s54).
 registration(r186,c55,s54).
 registration(r187,c14,s55).
-registration(r188,c0,s55).
+%registration(r188,c0,s55).
 registration(r189,c31,s55).
 registration(r190,c47,s55).
 registration(r191,c50,s56).
@@ -600,7 +600,7 @@ registration(r240,c20,s71).
 registration(r241,c18,s71).
 registration(r242,c38,s71).
 registration(r243,c37,s72).
-registration(r244,c0,s72).
+%registration(r244,c0,s72).
 registration(r245,c62,s72).
 registration(r246,c47,s73).
 registration(r247,c53,s73).
diff --git a/packages/CLPBN/pfl.yap b/packages/CLPBN/pfl.yap
index b141ba75e..8be97aed8 100644
--- a/packages/CLPBN/pfl.yap
+++ b/packages/CLPBN/pfl.yap
@@ -27,6 +27,9 @@
 	[clpbn_flag/2 as pfl_flag,
 	 set_clpbn_flag/2 as set_pfl_flag]).
 
+:- reexport(library(clpbn/horus),
+	[set_solver/1]).
+
 :- ( % if clp(bn) has done loading, we're top-level
 	predicate_property(set_pfl_flag(_,_), imported_from(clpbn))
     ->

From 5a8cc421d2ea7a8135f84d935752e5ecb453fe99 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?V=C3=ADtor=20Santos=20Costa?= <vsc@dcc.fc.up.pt>
Date: Thu, 12 Apr 2012 18:11:29 +0100
Subject: [PATCH 6/6] small pfl fixes.

---
 packages/CLPBN/clpbn.yap                | 16 ++++++++--------
 packages/CLPBN/clpbn/bp.yap             | 16 ++++++++--------
 packages/CLPBN/clpbn/display.yap        | 10 +++++++---
 packages/CLPBN/clpbn/ground_factors.yap | 12 ++++++------
 4 files changed, 29 insertions(+), 25 deletions(-)

diff --git a/packages/CLPBN/clpbn.yap b/packages/CLPBN/clpbn.yap
index 88b085ca0..db017a6d4 100644
--- a/packages/CLPBN/clpbn.yap
+++ b/packages/CLPBN/clpbn.yap
@@ -44,7 +44,7 @@
                check_if_bp_done/1,
 	       init_bp_solver/4,
 	       run_bp_solver/3,
-	       call_bp_ground/5,
+	       call_bp_ground/6,
 	       finalize_bp_solver/1
 	      ]).
 
@@ -69,10 +69,10 @@
 	       run_bdd_solver/3
 	      ]).
 
-:- use_module('clpbn/bnt',
-	      [do_bnt/3,
-	       check_if_bnt_done/1
-	      ]).
+%% :- use_module('clpbn/bnt',
+%% 	      [do_bnt/3,
+%% 	       check_if_bnt_done/1
+%% 	      ]).
 
 :- use_module('clpbn/gibbs',
 	      [gibbs/3,
@@ -238,7 +238,7 @@ project_attributes(GVars, _AVars0) :-
 	(ground(GVars) ->
 	    true
 	;
-	    call_ground_solver(Solver, GKeys, Keys, Factors, Evidence, _Avars0)
+	    call_ground_solver(Solver, GVars, GKeys, Keys, Factors, Evidence, _Avars0)
 	).
 project_attributes(GVars, AVars) :-
 	suppress_attribute_display(false),
@@ -312,8 +312,8 @@ write_out(fove, GVars, AVars, DiffVars) :-
 	fove(GVars, AVars, DiffVars).
 
 % call a solver with keys, not actual variables
-call_ground_solver(bp, GoalKeys, Keys, Factors, Evidence, Answ) :-
-	call_bp_ground(GoalKeys, Keys, Factors, Evidence, Answ).
+call_ground_solver(bp, GVars, GoalKeys, Keys, Factors, Evidence, Answ) :-
+	call_bp_ground(GVars, GoalKeys, Keys, Factors, Evidence, Answ).
 
 
 get_bnode(Var, Goal) :-
diff --git a/packages/CLPBN/clpbn/bp.yap b/packages/CLPBN/clpbn/bp.yap
index 4c9894fdd..8f24b190d 100644
--- a/packages/CLPBN/clpbn/bp.yap
+++ b/packages/CLPBN/clpbn/bp.yap
@@ -10,7 +10,7 @@
            check_if_bp_done/1,
            init_bp_solver/4,
            run_bp_solver/3,
-           call_bp_ground/5,
+           call_bp_ground/6,
            finalize_bp_solver/1
           ]).
 
@@ -57,7 +57,8 @@
           ]).
 
 
-call_bp_ground(QueryKeys, AllKeys, Factors, Evidence, _Output) :-
+call_bp_ground(QueryVars, QueryKeys, AllKeys, Factors, Evidence, Output) :-
+writeln(here:Factors),
   b_hash_new(Hash0),
   keys_to_ids(AllKeys, 0, Hash0, Hash),
   get_factors_type(Factors, Type),
@@ -74,7 +75,7 @@ call_bp_ground(QueryKeys, AllKeys, Factors, Evidence, _Output) :-
   %set_vars_information(AllKeys, StatesNames),
   run_solver(ground(Network,Hash), QueryKeys, Solutions),
   writeln(answer:Solutions),
-  %clpbn_bind_vals([QueryKeys], Solutions, _Output).
+  clpbn_bind_vals([QueryVars], Solutions, Output),
   free_ground_network(Network).
 
 
@@ -95,8 +96,8 @@ keys_to_ids([Key|AllKeys], I0, Hash0, Hash) :-
   keys_to_ids(AllKeys, I, HashI, Hash).
 
 
-get_factors_type([f(bayes, _, _)|_], bayes) :- ! .
-get_factors_type([f(markov, _, _)|_], markov) :- ! .
+get_factors_type([f(bayes, _, _, _)|_], bayes) :- ! .
+get_factors_type([f(markov, _, _, _)|_], markov) :- ! .
 
 
 list_of_keys_to_ids([], _, []).
@@ -106,9 +107,8 @@ list_of_keys_to_ids([Key|QueryKeys], Hash, [Id|QueryIds]) :-
 
 
 factors_to_ids([], _, []).
-factors_to_ids([f(_, Keys, CPT)|Fs], Hash, [f(Ids, Ranges, CPT, DistId)|NFs]) :-
+factors_to_ids([f(_, DistId, Keys, CPT)|Fs], Hash, [f(Ids, Ranges, CPT, DistId)|NFs]) :-
   list_of_keys_to_ids(Keys, Hash, Ids),
-  DistId = 0,
   get_ranges(Keys, Ranges),
   factors_to_ids(Fs, Hash, NFs).
 
@@ -145,7 +145,7 @@ bp([QueryVars], AllVars, Output) :-
 
 
 init_bp_solver(_, AllVars0, _, bp(BayesNet, DistIds)) :-
-  %check_for_agg_vars(AllVars0, AllVars),
+						%check_for_agg_vars(AllVars0, AllVars),
   get_vars_info(AllVars0, VarsInfo, DistIds0),
   sort(DistIds0, DistIds),
   create_ground_network(VarsInfo, BayesNet),
diff --git a/packages/CLPBN/clpbn/display.yap b/packages/CLPBN/clpbn/display.yap
index e868b6daf..f37814a5b 100644
--- a/packages/CLPBN/clpbn/display.yap
+++ b/packages/CLPBN/clpbn/display.yap
@@ -8,6 +8,8 @@
 
 :- use_module(library(clpbn/dists), [get_dist_domain/2]).
 
+:- use_module(library(clpbn), [use_parfactors/1]).
+
 :- attribute posterior/4.
 
 
@@ -44,9 +46,11 @@ clpbn_bind_vals([Vs|MoreVs],[Ps|MorePs],AllDiffs) :-
 
 clpbn_bind_vals2([],_,_) :- !.
 % simple case, we want a distribution on a single variable.
-%bind_vals([V],Ps) :- !,
-%	clpbn:get_atts(V, [dist(Vals,_,_)]),
-%	put_atts(V, posterior([V], Vals, Ps)).
+bind_vals([V],Ps) :- 
+	use_parfactors(on), !,
+	clpbn:get_atts(V, [key(K)]),
+	pfl:skolem(K,Vals),
+	put_atts(V, posterior([V], Vals, Ps)).
 % complex case, we want a joint distribution, do it on a leader.
 % should split on cliques ?
 clpbn_bind_vals2(Vs,Ps,AllDiffs) :-
diff --git a/packages/CLPBN/clpbn/ground_factors.yap b/packages/CLPBN/clpbn/ground_factors.yap
index 1ec748b43..b90037a4a 100644
--- a/packages/CLPBN/clpbn/ground_factors.yap
+++ b/packages/CLPBN/clpbn/ground_factors.yap
@@ -28,7 +28,7 @@
 :- use_module(library(clpbn/dists), [
           dist/4]).
 
-:- dynamic currently_defined/1, f/3.
+:- dynamic currently_defined/1, f/4.
 
 generate_network(QueryVars0, QueryKeys, Keys, Factors, Evidence) :-
 	attributes:all_attvars(AVars),
@@ -40,11 +40,11 @@ generate_network(QueryVars0, QueryKeys, Keys, Factors, Evidence) :-
 do_network([], _, _, _) :- !.
 do_network(QueryVars, EVars, Keys, Factors) :-
 	retractall(currently_defined(_)),
-	retractall(f(_,_,_)),
+	retractall(f(_,_,_,_)),
 	run_through_factors(QueryVars),
 	run_through_factors(EVars),
 	findall(K, currently_defined(K), Keys),
-	findall(f(FType,FKeys,FCPT), f(FType,FKeys,FCPT), Factors).
+	findall(f(FType,FId,FKeys,FCPT), f(FType,FId,FKeys,FCPT), Factors).
 
 %
 % look for attributed vars with evidence (should also search the DB)
@@ -110,11 +110,11 @@ find_factors(K) :-
 	\+ currently_defined(K1),
 	find_factors(K1).
 
-add_factor(factor(Type, _Id, Ks, _, Phi, Constraints), Ks) :-
-	F = f(Type, Ks, CPT),
+add_factor(factor(Type, Id, Ks, _, Phi, Constraints), Ks) :-
+	F = f(Type, Id, Ks, CPT),
 	( is_list(Phi) -> CPT = Phi ; call(user:Phi, CPT) ),
 	run(Constraints),
-	\+ f(Type, Ks, CPT),
+	\+ f(Type, Id, Ks, CPT),
 	assert(F).
 
 run([Goal|Goals]) :-