Problog testing: modules :(

H/Yapproto.h

@@ -175,6 +175,7 @@ extern int Yap_DBTrailOverflow(void);
 extern CELL Yap_EvalMasks(Term, CELL *);
 extern void Yap_InitBackDB(void);
 extern void Yap_InitDBPreds(void);
+extern void Yap_InitDBLoadPreds(void);
 
 /* errors.c */
 #if DEBUG

H/absmi.h

@@ -31,6 +31,12 @@
 #define register
 #endif
 
+
+#if TABLING
+#define FROZEN_STACKS 1
+//#define MULTIPLE_STACKS 1
+#endif
+
 /***************************************************************
  * Macros for register manipulation                             *
  ***************************************************************/

H/amidefs.h

@@ -48,6 +48,7 @@ typedef struct regstore_t *regstruct_ptr;
 
 #endif
 
+
 typedef Int (*CPredicate)(CACHE_TYPE1);
 
 typedef Int (*CmpPredicate)(Term, Term);

H/trim_trail.h

@@ -1,17 +1,17 @@
 
 #ifdef FROZEN_STACKS
+
+#define RESET_TRAIL_ENTRY(pt)  { TrailTerm(pt) = (CELL)(pt); TrailVal(pt) = (CELL)(pt); }
 {
-  tr_fr_ptr pt0, pt1, pbase, ptop;
+  tr_fr_ptr  pt1, pbase;
-  pbase = B->cp_tr, ptop = TR;
+  pbase = B->cp_tr;
-  pt0 = pt1 = TR - 1;
+  pt1 = TR - 1;
   while (pt1 >= pbase) {
     BEGD(d1);
     d1 = TrailTerm(pt1);
     if (IsVarTerm(d1)) {
-      if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
+      if (d1 >= (CELL)HBREG && d1 < Unsigned(HR)) {
-        TrailTerm(pt0) = d1;
+          RESET_TRAIL_ENTRY(pt1);
-        TrailVal(pt0) = TrailVal(pt1);
-        pt0--;
       }
       pt1--;
     } else if (IsPairTerm(d1)) {
@@ -28,14 +28,14 @@
         /* skip, this is a problem because we lose information,
            namely active references */
         pt1 = (tr_fr_ptr)pt;
-      } else if (IN_BETWEEN(H0, pt, HR) && IsApplTerm(HeadOfTerm(d1))) {
+      } else if (IN_BETWEEN(H0, pt, LCL0) && IsApplTerm(HeadOfTerm(d1))) {
         Term t = HeadOfTerm(d1);
         Functor f = FunctorOfTerm(t);
         if (f == FunctorBigInt) {
           Int tag = Yap_blob_tag(t);
           GLOBAL_OpaqueHandlers[tag].cut_handler(d1);
-        } else {
+           RESET_TRAIL_ENTRY(pt1);
-          pt0--;
+
         }
         pt1--;
         continue;
@@ -48,6 +48,7 @@
 
         LOCK(ap->PELock);
         DEC_CLREF_COUNT(cl);
+                  RESET_TRAIL_ENTRY(pt1);
         cl->ClFlags &= ~InUseMask;
         erase = (cl->ClFlags & (ErasedMask | DirtyMask)) && !(cl->ClRefCount);
         if (erase) {
@@ -59,43 +60,23 @@
             Yap_CleanUpIndex(cl);
         }
         UNLOCK(ap->PELock);
-      } else {
-        TrailTerm(pt0) = d1;
-        TrailVal(pt0) = TrailVal(pt1);
-        pt0--;
       }
       pt1--;
     } else if (IsApplTerm(d1)) {
       if (IN_BETWEEN(HBREG, RepAppl(d1), B->cp_b)) {
-        /* deterministic binding to multi-assignment variable */
+                  RESET_TRAIL_ENTRY(pt1);
-        pt1 -= 2;
+                  pt1--;
+          RESET_TRAIL_ENTRY(pt1);
+/* deterministic binding to multi-assignment variable */
+        pt1 --;
       } else {
-        TrailVal(pt0) = TrailVal(pt1);
-        TrailTerm(pt0) = d1;
-        TrailVal(pt0 - 1) = TrailVal(pt1 - 1);
-        TrailTerm(pt0 - 1) = TrailTerm(pt1 - 1);
-        pt0 -= 2;
         pt1 -= 2;
       }
     } else {
-      TrailTerm(pt0) = d1;
+       pt1--;
-      TrailVal(pt0) = TrailVal(pt1);
-      pt0--;
-      pt1--;
     }
     ENDD(d1);
   }
-  if (pt0 != pt1) {
-    int size;
-    pt0++;
-    size = ptop - pt0;
-    memmove(pbase, pt0, size * sizeof(struct trail_frame));
-    if (ptop != TR) {
-      memmove(pbase + size, ptop, (TR - ptop) * sizeof(struct trail_frame));
-      size += (TR - ptop);
-    }
-    TR = pbase + size;
-  }
 }
 #else
 {

packages/ProbLog/problog.yap

@@ -845,7 +845,7 @@ term_expansion_intern(Head :: Goal,Module,problog:ProbFact) :-
 
 % handles probabilistic facts
 term_expansion_intern(P :: Goal,Module,problog:ProbFact) :-
-	copy_term((P,Goal),(P_Copy,Goal_Copy)),
+    copy_term((P,Goal),(P_Copy,Goal_Copy)),
 	functor(Goal, Name, Arity),
 	atomic_concat([problog_,Name],ProblogName),
 	Goal =.. [Name|Args],

packages/ProbLog/problog/lbdd.yap

@@ -91,6 +91,7 @@ gradient(QueryID, g, Slope) :-
 query_probabilities( DBDD, Prob) :-
     DBDD = bdd(Dir, Tree, _MapList),
     findall(P, evalp(Tree,P), [Prob0]),
+   % nonvar(Prob0),
     (Dir == 1 -> Prob0 = Prob ;  Prob is 1.0-Prob0).
 
 evalp( Tree, Prob0) :-
@@ -104,7 +105,7 @@ query_gradients(bdd(Dir, Tree, MapList),I,IProb,Grad) :-
 
 evalp( pn(P, _-X, PL, PR), _,P ):-
     P is X*PL+ (1.0-X)*(1.0-PR).
-evalp( pp(P, _-X, PL, PR), _,P ):-
+evalp( pp(P, _-X, PL, PR), _,P ):-  
     P is X*PL+ (1.0-X)*PR.
 
 evalg( I, pp(P-G, J-X, L, R), _, G ):-

packages/ProbLog/problog_examples/learn_graph_lbdd.pl

@@ -14,20 +14,9 @@
 % will run 20 iterations of learning with default settings
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
-:- use_module('../problog_lbfgs').
+:- use_module('../problog_learning_lbdd').
 
 
- :- if(true).
-
- :- use_module('kbgraph').
-
-
-%%%%
-% background knowledge
-%%%% 
-% definition of acyclic path using list of visited nodes
-
-:- else. 
 
 :- Query=path(X,Y), set_problog_flag(init_method,(Query,K,Bdd,problog:problog_exact_lbdd(Query,Bdd))).
 
@@ -48,7 +37,6 @@ edge(X,Y) :- dir_edge(X,Y).
 absent(_,[]).
 absent(X,[Y|Z]):-X \= Y, absent(X,Z).
 
-:- endif.
 
 %%%%
 % probabilistic facts 

packages/ProbLog/problog_lbfgs.yap

@@ -553,7 +553,7 @@ empty_bdd_directory.
 init_queries :-
     empty_bdd_directory,
 	format_learning(2,'Build BDDs for examples~n',[]),
-	forall(user:test_example(ID,Query,_Prob,_),init_one_query(ID,Query,test)),	
+	forall(user:test_example(ID,Query,_Prob,_),init_one_query(ID,Query,test)),
 	forall(user:example(ID,Query,_Prob,_),init_one_query(ID,Query,training)).
 
 bdd_input_file(Filename) :-
@@ -835,7 +835,7 @@ update_values :-
 	% delete old values
 	%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 	retractall(query_probability_intern(_,_)),
-	retractall(query_gradient_intern(_,_,_,_)),	
+	retractall(query_gradient_intern(_,_,_,_)),
 
 
 	assertz(values_correct).
@@ -847,7 +847,7 @@ update_values :-
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 % start calculate gradient
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :- 
+user:evaluate(LLH_Training_Queries, X,Grad,N,_,_) :-
     %Handle = user_error,
     N1 is N-1,
     forall(between(0,N1,I),(Grad[I]<==0.0)),
@@ -893,13 +893,11 @@ compute_gradient( Grad, X, Slope, LL) :-
 	BDD = bdd(_,_,MapList),
 	MapList = [_|_],
 	bind_maplist(MapList, Slope, X),
-%writeln(QueryID:MapList),
 	query_probabilities( BDD, BDDProb),
 	(isnan(BDDProb) -> writeln((nan::QueryID)), fail;true),
-writeln(BDDProb),
 	LL is (BDDProb-QueryProb)*(BDDProb-QueryProb),
     forall(
-	query_gradients(BDD,I,IProb,GradValue), 
+	query_gradients(BDD,I,IProb,GradValue),
 	gradient_pair(BDDProb, QueryProb, Grad, GradValue, I, IProb)
     ).
 
@@ -925,8 +923,9 @@ wrap( _X, _Grad, _GradCount).
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 user:progress(FX,_X,_G, _X_Norm,_G_Norm,_Step,_N,_CurrentIteration,_Ls,-1) :-
     FX < 0, !,
-    format('stopped on bad FX=~4f~n',[FX]).
+    format('Bad FX=~4f~n',[FX]).
 user:progress(FX,X,G,X_Norm,G_Norm,Step,_N, LBFGSIteration,Ls,0) :-
+writeln(fx=FX),
      problog_flag(sigmoid_slope,Slope),
      save_state(X, Slope, G),
     logger_set_variable(mse_trainingset, FX),
@@ -946,22 +945,6 @@ save_state(X,Slope,_Grad) :-
     	tunable_fact(FactID,_GroundTruth),
     	set_tunable(FactID,Slope,X),
     	fail.
-save_state(X, Slope, _) :-
-	    user:example(QueryID,_Query,_QueryProb),
-	    recorded(QueryID,BDD,_),
-	    BDD = bdd(_,_,MapList),
-	    bind_maplist(MapList, Slope, X),
-	    query_probabilities( BDD, BDDProb),
-	    assert( query_probability_intern(QueryID,BDDProb)),
-	fail.
-save_state(X, Slope, _) :-
-	    user:test_example(QueryID,_Query,_QueryProb),
-	    recorded(QueryID,BDD,_),
-	    BDD = bdd(_,_,MapList),
-	    bind_maplist(MapList, Slope, X),
-	    query_probabilities( BDD, BDDProb),
-	    assert( query_probability_intern(QueryID,BDDProb)),
-	fail.
 save_state(_X, _Slope, _).
 
 %========================================================================

packages/ProbLog/problog_learning.yap

@@ -710,7 +710,7 @@ update_values :-
 %=
 %========================================================================
 
-    listing(
+ update_query_cleanup(QueryID) :-
 	(
 	 (query_is_similar(QueryID,_) ; query_is_similar(_,QueryID))
 	->
@@ -893,7 +893,6 @@ ground_truth_difference :-
 %=
 %= -Float
 %========================================================================
-
 mse_trainingset_only_for_linesearch(MSE) :-
 	update_values,
 

packages/ProbLog/problog_learning_lbdd.yap

@@ -228,6 +228,7 @@
 :- use_module('problog/utils_lbdd').
 :- use_module('problog/utils').
 :- use_module('problog/tabling').
+:- use_module('problog/lbdd').
 
 % used to indicate the state of the system
 :- dynamic(values_correct/0).

packages/yap-lbfgs/lbfgs.pl

@@ -24,6 +24,7 @@
 		 lbfgs_initialize/4,
 		 lbfgs_run/3,
 
+		 lbfgs_fx/1,
 		 lbfgs_finalize/1,
 
 		 lbfgs_set_parameter/2,
@@ -180,7 +181,8 @@ lbfgs_finalize(_N).
 run the algorithm. output the final score of the function being optimised
 */
 lbfgs_run(N,X,FX) :-
-    lbfgs(N,X, FX).
+    lbfgs(N,X),
+    lbfgs_fx(FX).
 
 
 

packages/yap-lbfgs/yap_lbfgs.c

@@ -35,7 +35,7 @@ X_API void init_lbfgs_predicates(void);
 YAP_Functor fevaluate, fprogress, fmodule, ffloats;
 YAP_Term tuser;
 
-lbfgsfloatval_t *x_p;
+lbfgsfloatval_t *x_p, f_x;
 
 static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
                                 lbfgsfloatval_t *g_tmp, const int n,
@@ -43,7 +43,7 @@ static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
   YAP_Term call;
   YAP_Bool result;
   lbfgsfloatval_t rc=0.0;
-  YAP_Term v=YAP_MkVarTerm(), t1, t12;
+  YAP_Term t12;
   YAP_Term t[6], t2[2];
 
   YAP_Term t_0 = YAP_MkIntTerm((YAP_Int)&rc);
@@ -60,8 +60,6 @@ static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
   t2[1] = YAP_MkApplTerm(fevaluate, 6, t);
 
   call = YAP_MkApplTerm(fmodule, 2, t2);
-
-  int sl = YAP_InitSlot(v);
   // lbfgs_status=LBFGS_STATUS_CB_EVAL;
   result = YAP_RunGoalOnce(call);
   // lbfgs_status=LBFGS_STATUS_RUNNING;
@@ -72,8 +70,6 @@ static lbfgsfloatval_t evaluate(void *instance, const lbfgsfloatval_t *x,
     return FALSE;
   }
    YAP_ShutdownGoal(true);
-  YAP_RecoverSlots(1, sl);
-  fprintf(stderr,"%gxo\n",rc);
   return rc;
 }
 
@@ -183,7 +179,7 @@ value will terminate the optimization process.
  */
 static YAP_Bool p_lbfgs(void) {
   YAP_Term t1 = YAP_ARG1, t;
-  int n, sl;
+  int n;
   lbfgsfloatval_t *x;
   lbfgsfloatval_t fx;
 
@@ -196,7 +192,6 @@ static YAP_Bool p_lbfgs(void) {
   if (n < 1) {
     return FALSE;
   }
-  sl = YAP_InitSlot(YAP_ARG3);
 
   if (!x_p)
    x_p = lbfgs_malloc(n+1);
@@ -206,15 +201,17 @@ static YAP_Bool p_lbfgs(void) {
   lbfgs_parameter_t *param = &parms;
   void *ui = NULL; //(void *)YAP_IntOfTerm(YAP_ARG4);
   int ret = lbfgs(n, x, &fx, evaluate, progress, ui, param);
-  t = YAP_GetFromSlot(sl);
+  f_x = fx;
-  YAP_Unify(t, YAP_MkFloatTerm(fx));
+if (ret == 0)
-  YAP_RecoverSlots(1, sl);
-  if (ret == 0)
     return true;
   fprintf(stderr, "optimization terminated with code %d\n ",ret);
   return true;
 }
 
+static YAP_Bool lbfgs_fx(void) {
+    return YAP_Unify(YAP_ARG1, YAP_MkFloatTerm(f_x));
+}
+
 static YAP_Bool lbfgs_grab(void) {
   int n = YAP_IntOfTerm(YAP_ARG1);
 
@@ -468,8 +465,9 @@ X_API void init_lbfgs_predicates(void) {
   lbfgs_parameter_init(&parms);
 
   YAP_UserCPredicate("lbfgs_grab", lbfgs_grab, 2);
-  YAP_UserCPredicate("lbfgs", p_lbfgs, 3);
+  YAP_UserCPredicate("lbfgs", p_lbfgs, 2);
-  YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1);
+    YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1);
+    YAP_UserCPredicate("lbfgs_fx", lbfgs_fx, 1);
 
   YAP_UserCPredicate("lbfgs_defaults", lbfgs_defaults, 0);
   

pl/consult.yap

@@ -1011,7 +1011,7 @@ prolog_load_context(file, FileName) :-
         ).
 prolog_load_context(module, X) :-
         '__NB_getval__'('$consulting_file', _, fail),
-        'current_module'(X).
+        current_source_module(X,X).
 prolog_load_context(source, F0) :-
         ( source_location(F0, _) /*,
                                    '$input_context'(Context),

pl/imports.yap

@@ -35,20 +35,17 @@ fail.
 % parent module mechanism
 %% system has priority
 '$get_predicate_definition'(_ImportingMod:G,prolog:G) :-
-    nonvar(G),
+    nonvar(G).
-    '$pred_exists'(G,prolog).
 %% I am there, no need to import
 '$get_predicate_definition'(Mod:Pred,Mod:Pred) :-
-    nonvar(Pred),
+    nonvar(Pred).
-    '$pred_exists'(Pred, Mod).
 %% export table
 '$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
     recorded('$import','$import'(ExportingMod,ImportingMod,G0,G,_,_),_).
 %% parent/user
-'$get_predicate_definition'(ImportingMod:G,ExportingMod:G0) :-
+'$get_predicate_definition'(ImportingMod:G,PMod:G) :-
     ( '$parent_module'(ImportingMod, PMod) ; PMod = user ),
-    ImportingMod \= PMod,
+    ImportingMod \= PMod.
-    '$get_predicate_definition'(PMod:G, ExportingMod:G0).
 %% autoload`
 %'$get_predicate_definition'(ImportingMod:G,ExportingMod:G) :-
 %    current_prolog_flag(autoload, true),
@@ -57,22 +54,25 @@ fail.
 
 '$predicate_definition'(Imp:Pred,Exp:NPred) :-
     '$predicate_definition'(Imp:Pred,[],Exp:NPred),
+    '$pred_exists'(NPred,Exp),
 %writeln((Imp:Pred -> Exp:NPred )).
     !.
 
 '$one_predicate_definition'(Imp:Pred,Exp:NPred) :-
-    '$predicate_definition'(Imp:Pred,[],Exp:NPred),
+    '$get_predicate_definition'(Imp:Pred,[],Exp:NPred),
+    '$pred_exists'(NPred,Exp),
 %writeln((Imp:Pred -> Exp:NPred )).
     !.
 '$one_predicate_definition'(Exp:Pred,Exp:Pred).
     
 '$predicate_definition'(M0:Pred0,Path,ModF:PredF) :-
     '$get_predicate_definition'(M0:Pred0, Mod:Pred),
-    \+ lists:member(Mod:Pred,Path),
     (
-	'$predicate_definition'(Mod:Pred,[Mod:Pred|Path],ModF:PredF)
+    '$pred_exists'(Pred,Mod), Mod = ModF, Pred = PredF
     ;
-    Mod = ModF, Pred = PredF
+    \+ lists:member(Mod:Pred,Path),
+      '$predicate_definition'(Mod:Pred,[Mod:Pred|Path], ModF:PredF)
+
     ).
 
 %

pl/meta.yap

@@ -405,6 +405,10 @@ meta_predicate(P) :-
     '$expand_goals'(B,B1,BO,HM,SM,BM,HVars),
     '$expand_goals'(C,C1,CO,HM,SM,BM,HVars),
     '$clean_cuts'(AO0, DCP, AO).
+'$expand_goals'(forall(A,B), forall(A1,B1),
+(A0 , ( B0 -> fail ; true ) -> fail; true ),HM,SM,BM,HVars) :- !,
+    '$expand_goals'(A,A1,AO,HM,SM,BM,HVars),
+    '$expand_goals'(B,B1,BO,HM,SM,BM,HVars).
 '$expand_goals'((A*->B;C),(A1*->B1;C1),
 		('$current_choice_point'(DCP),AO,yap_hacks:cut_at(DCP),BO; CO),HM,SM,BM,HVars) :- !,
     '$expand_goals'(A,A1,AO0,HM,SM,BM,HVars),

pl/preds.yap

@@ -490,7 +490,7 @@ current_predicate(A0,T0) :-
     '$current_predicate'(A,M,T,_),
     functor(T, A, _)
     ;
-    '$get_predicate_definition'(M:T,M1:_T1),
+    '$predicate_definition'(M:T,M1:_T1),
     M\=M1,
     functor(T, A, _)
     ).

pl/top.yap

@@ -602,7 +602,7 @@ write_query_answer( Bindings ) :-
 	expand_goal(M:G, NG),
 	must_be_callable(NG),
 
-	    '$yap_strip_module'(NG,NM,NC),
+	    '$yap_strip_module'(M:NG,NM,NC),
         '$call'(NC,CP,G0,NM).
 '$call'((X,Y),CP,G0,M) :- !,
         '$call'(X,CP,G0,M),
@@ -614,8 +614,11 @@ write_query_answer( Bindings ) :-
 	 '$call'(Y,CP,G0,M)
 	).
 '$call'((X*->Y),CP,G0,M) :- !,
-	'$call'(X,CP,G0,M),
+	(
-	'$call'(Y,CP,G0,M).
+	'$call'(X,CP,G0,M)
+	*->
+	'$call'(Y,CP,G0,M)
+	).
 '$call'((X->Y; Z),CP,G0,M) :- !,
 	(
 	    '$call'(X,CP,G0,M)
@@ -671,6 +674,13 @@ write_query_answer( Bindings ) :-
 	  '$call'(X,CP,G0,M) ).
 '$call'(!, CP, _G0, _m) :- !,
 	'$$cut_by'(CP).
+'$call'(forall(X,Y), CP, _G0, _m) :- !,
+	\+ ('$call'(X, CP, G0, M),
+	     \+ '$call'(Y, CP, G0, M) ).
+'$call'(once(X), CP, G0, M) :- !,
+	( '$call'(X, CP, G0, M) -> true).
+'$call'(!, CP, _G0, _m) :- !,
+	'$$cut_by'(CP).
 '$call'([X|Y], _, _, M) :-
     (Y == [] ->
     consult(M:X)
@@ -853,7 +863,6 @@ rules: first try term_expansion/2  in the current module, and then try to use th
 for DCG rules is applied, together with the arithmetic optimizer
 whenever the compilation of arithmetic expressions is in progress.
 
-
 */
 expand_term(Term,Expanded) :-
 	(