From 60adbb9a75b3bea805ce61bbb9f40ebdbc53bd63 Mon Sep 17 00:00:00 2001
From: Vitor Santos Costa <vsc@dcc.fc.up.pt>
Date: Sat, 25 May 2019 09:06:55 +0100
Subject: [PATCH 1/5] dbg

---
 C/write.c | 10 +++++-----
 1 file changed, 5 insertions(+), 5 deletions(-)

diff --git a/C/write.c b/C/write.c
index 2cef5244f..8fe9dd880 100644
--- a/C/write.c
+++ b/C/write.c
@@ -424,7 +424,7 @@ static inline bool was_visited(Term t, wglbs *wg, Term *ta ) {
       CELL *pt= (CELL*)AtomOfTerm(*tp);
         if (pt  >= wg->visited0 &&
 	    pt < wg->visited) {
-	  int depth = (wg->visited+1)-tp;
+	  int depth = (wg->visited+1)-pt;
         wrputs(" @( ", wg->stream);
         wrputn(depth, wg);
         wrputs( " ) ", wg->stream);
@@ -433,7 +433,7 @@ static inline bool was_visited(Term t, wglbs *wg, Term *ta ) {
     }
     wg->visited[0] = *tp;
     *tp = MkAtomTerm( (Atom)wg->visited );
-    wg++;
+    wg->visited_top++;
 
     return false;
 }
@@ -1176,14 +1176,14 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
   wglb.lw = separator;
   Term tp;
   
-   if ((flags & Handle_cyclics_f) ){
+   if (true && (flags & Handle_cyclics_f) ){
     // tp = Yap_CyclesInTerm(t PASS_REGS);
     wglb.visited = Malloc(1024*sizeof(CELL)),
     wglb.visited0 = wglb.visited,
     wglb.visited_top = wglb.visited+1024;
-   } else {
-     tp = t;
    }
+     tp = t;
+ 
 
    /* protect slots for portray */
   writeTerm(tp, priority, 1, false, &wglb, &rwt);

From 8f8da92603b312cc82e87d511663d98ef69100f7 Mon Sep 17 00:00:00 2001
From: Vitor Santos Costa <vsc@dcc.fc.up.pt>
Date: Sat, 25 May 2019 11:19:29 +0100
Subject: [PATCH 2/5] getting better

---
 C/write.c | 20 +++++++++++---------
 1 file changed, 11 insertions(+), 9 deletions(-)

diff --git a/C/write.c b/C/write.c
index 8fe9dd880..1258da2eb 100644
--- a/C/write.c
+++ b/C/write.c
@@ -431,9 +431,10 @@ static inline bool was_visited(Term t, wglbs *wg, Term *ta ) {
         return true;
 	}
     }
+    *ta = *tp;
     wg->visited[0] = *tp;
     *tp = MkAtomTerm( (Atom)wg->visited );
-    wg->visited_top++;
+    wg->visited++;
 
     return false;
 }
@@ -441,7 +442,7 @@ static inline bool was_visited(Term t, wglbs *wg, Term *ta ) {
 static inline Term visited_indirection(Term t, wglbs *wg ) {
   Term *tp = (CELL *)AtomOfTerm(t);
   if (tp >= wg->visited0
-         && (CELL *) *tp < wg->visited_top)
+         && (CELL *) tp < wg->visited_top)
     return *tp;
   return 0;
 }
@@ -875,11 +876,16 @@ if ((was_visited(t, wglb, &hot))) {
       lastw = separator;
     }
   } else { /* compound term */
-    Functor functor = FunctorOfTerm(t);
+    Functor functor;
     int Arity;
     Atom atom;
     int op, lp, rp;
 
+    Term argf;
+      if (was_visited(t, wglb, &argf)) {
+          return;
+      }
+      functor = (Functor)argf;
     if (IsExtensionFunctor(functor)) {
       switch ((CELL)functor) {
       case (CELL)FunctorDouble:
@@ -936,11 +942,7 @@ if ((was_visited(t, wglb, &hot))) {
         return;
       }
     }
-    Term argf;
-      if (was_visited(t, wglb, &argf)) {
-          return;
-      }
-
+ 
       if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
       Term tright = ArgOfTerm(1, t);
       int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
@@ -1189,7 +1191,7 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
   writeTerm(tp, priority, 1, false, &wglb, &rwt);
      if (flags & New_Line_f) {
     if (flags & Fullstop_f) {
-      wrputc('.', wglb.stream);
+   wrputc('.', wglb.stream);
       wrputc('\n', wglb.stream);
     } else {
       wrputc('\n', wglb.stream);

From 07cd79ccb7759c1e39c1250af96540f4b04a81d5 Mon Sep 17 00:00:00 2001
From: Vitor Santos Costa <vsc@dcc.fc.up.pt>
Date: Mon, 27 May 2019 15:31:22 +0100
Subject: [PATCH 3/5] fix overflow handling in global variables fix use of
 must_be_callable.

---
 C/exec.c             |   2 +-
 C/fail_absmi_insts.h |  12 +--
 C/globals.c          |  78 ++++++++---------
 C/stdpreds.c         |   1 +
 C/write.c            | 200 +++++++++++++++++++++++--------------------
 5 files changed, 152 insertions(+), 141 deletions(-)

diff --git a/C/exec.c b/C/exec.c
index db84238f0..a99f11aa7 100755
--- a/C/exec.c
+++ b/C/exec.c
@@ -980,7 +980,7 @@ static bool watch_retry(Term d0 USES_REGS) {
 
     while (B->cp_ap->opc == FAIL_OPCODE)
         B = B->cp_b;
-
+    ASP = (CELL *) PROTECT_FROZEN_B(B);
     // just do the frrpest
     if (B >= B0 && !ex_mode && !active)
         return true;
diff --git a/C/fail_absmi_insts.h b/C/fail_absmi_insts.h
index 5d31b381e..2962e7e18 100644
--- a/C/fail_absmi_insts.h
+++ b/C/fail_absmi_insts.h
@@ -215,10 +215,7 @@ failloop:
   }
 /* pointer to code space */
 /* or updatable variable */
-#if defined(TERM_EXTENSIONS) || defined(FROZEN_STACKS) ||                      \
-    defined(MULTI_ASSIGNMENT_VARIABLES)
   if (IsPairTerm(d1))
-#endif /* TERM_EXTENSIONS || FROZEN_STACKS || MULTI_ASSIGNMENT_VARIABLES */
   {
     register CELL flags;
     CELL *pt1 = RepPair(d1);
@@ -245,19 +242,20 @@ failloop:
       goto failloop;
     } else
 #endif /* FROZEN_STACKS */
-        if (IN_BETWEEN(H0, pt1, HR)) {
+        if (IN_BETWEEN(H0, pt1, LCL0)) {
       if (IsAttVar(pt1)) {
         goto failloop;
       } else {
         TR = pt0;
-        Yap_CleanOpaqueVariable(d1);
+
+Yap_CleanOpaqueVariable(d1);
 
         goto failloop;
       }
     }
 #ifdef FROZEN_STACKS /* TRAIL */
     /* don't reset frozen variables */
-    if (pt0 < TR_FZ)
+    else if (pt0 < TR_FZ)
       goto failloop;
 #endif
     flags = *pt1;
@@ -306,9 +304,7 @@ hence we don't need to have a lock it */
         } else {
           LogUpdClause *cl = ClauseFlagsToLogUpdClause(pt1);
           int erase;
-#if PARALLEL_YAP
           PredEntry *ap = cl->ClPred;
-#endif
           /* BB support */
           if (ap) {
 
diff --git a/C/globals.c b/C/globals.c
index 0c4735da2..75310c29b 100644
--- a/C/globals.c
+++ b/C/globals.c
@@ -286,10 +286,9 @@ static Term GrowArena(Term arena, size_t size,
       XREGS[arity + 1] = arena;
       if (!Yap_gcl(size * sizeof(CELL), arity + 1, ENV, gc_P(P, CP))) {
           Yap_Error(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
-          return false;
+          return 0;
       }
       arena = XREGS[arity + 1];
-      adjust_cps(size PASS_REGS);
   }
     pt = ArenaLimit(arena);
    if (pt == HR) {
@@ -301,8 +300,8 @@ static Term GrowArena(Term arena, size_t size,
       }
         arena = XREGS[arity + 1];
      }
-    CreateNewArena(RepAppl(arena), size+old_size);
-    return size+old_size;
+    arena = CreateNewArena(RepAppl(arena), size+old_size);
+    return arena;
 }
 
 CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
@@ -329,11 +328,11 @@ CELL *Yap_GetFromArena(Term *arenap, UInt cells, UInt arity) {
 }
 }
 
-static Term CloseArena(cell_space_t *region, Term arena,
+static Term CloseArena(cell_space_t *region,
                        UInt old_size USES_REGS) {
   UInt new_size;
-  new_size = old_size - (HR - RepAppl(arena));
-  arena = CreateNewArena(HR, new_size);
+  new_size = old_size - (HR - HB);
+  Term arena = CreateNewArena(HR, new_size);
   exit_cell_space( region );
   return arena;
 }
@@ -649,10 +648,10 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
     cell_space_t cspace;
     int res = 0, restarts = 0;
     Term tn;
+    old_size = ArenaSz(arena);
 
     restart:
     enter_cell_space(&cspace);
-    old_size = ArenaSz(arena);
     t = Deref(t);
     if (IsVarTerm(t)) {
         ASP = ArenaLimit(arena);
@@ -668,12 +667,12 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
                                          Hi PASS_REGS)) < 0) {
                 goto error_handler;
             }
-            *newarena = CloseArena(&cspace, arena, old_size PASS_REGS);
+            *newarena = CloseArena(&cspace, old_size PASS_REGS);
             return Hi[0];
         }
 #endif
         if (share && VarOfTerm(t) > ArenaPt(arena)) {
-            *newarena = CloseArena(&cspace, arena, old_size PASS_REGS);
+            *newarena = CloseArena(&cspace, old_size PASS_REGS);
             return t;
         }
         tn = MkVarTerm();
@@ -681,7 +680,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
             res = -1;
             goto error_handler;
         }
-	*newarena = CloseArena(&cspace, arena, old_size PASS_REGS);
+	*newarena = CloseArena(&cspace, old_size PASS_REGS);
         return tn;
     } else if (IsAtomOrIntTerm(t)) {
         return t;
@@ -703,7 +702,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
                                      Hi PASS_REGS)) < 0) {
             goto error_handler;
         }
-        *newarena = CloseArena(&cspace, arena, old_size PASS_REGS);
+        *newarena = CloseArena(&cspace, old_size PASS_REGS);
         return tf;
     } else {
         Functor f;
@@ -724,7 +723,7 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
         if (IsExtensionFunctor(f)) {
             switch ((CELL) f) {
                 case (CELL) FunctorDBRef:
-                    *newarena = CloseArena(&cspace, arena, old_size PASS_REGS);
+                    *newarena = CloseArena(&cspace, old_size PASS_REGS);
                     return t;
                 case (CELL) FunctorLongInt:
                     if (HR > ASP - (MIN_ARENA_SIZE + 3)) {
@@ -783,32 +782,32 @@ static Term CopyTermToArena(Term t, Term arena, bool share, bool copy_att_vars,
                 goto error_handler;
             }
         }
-        *newarena = CloseArena(&cspace, arena, old_size PASS_REGS);
+        *newarena = CloseArena(&cspace, old_size PASS_REGS);
         return tf;
     }
     error_handler:
     XREGS[arity + 1] = t;
-    XREGS[arity + 2] = arena;
-    exit_cell_space(&cspace);
     switch (res) {
     case -1:
       if (arena == LOCAL_GlobalArena)
         LOCAL_GlobalArenaOverflows++;
       restarts++;
       min_grow += (restarts < 16 ? 16*1024*restarts*restarts : 128*1024*1024);
-      CreateNewArena (RepAppl(arena),old_size);
-      if((arena=GrowArena(arena, min_grow, arity + 2, &cspace PASS_REGS))==0) {
+      HR = HB;
+      arena = CloseArena (&cspace, old_size PASS_REGS);
+      if((arena=GrowArena(arena, min_grow, arity + 1, &cspace PASS_REGS))==0) {
         Yap_ThrowError(RESOURCE_ERROR_STACK, TermNil, LOCAL_ErrorMessage);
         return 0L;
       }
-      break;
+      t = XREGS[arity+1];
+            enter_cell_space(&cspace);
+            old_size = ArenaSz(arena);
+            break;
     default: /* temporary space overflow */
-      return 0;
+        exit_cell_space(&cspace);
+            return 0;
       
     }
-  enter_cell_space(&cspace);
-  arena = Deref(XREGS[arity + 2]);
-  t = XREGS[arity + 1];
   goto restart;
 }
 
@@ -836,7 +835,7 @@ restart:
 //      CELL *old_top = ArenaLimit(*nsizeof(CELL)ewarena);
       if (arena == LOCAL_GlobalArena)
         LOCAL_GlobalArenaOverflows++;
-          CreateNewArena (RepAppl(arena),old_size);
+          arena = CreateNewArena (RepAppl(arena),old_size);
           if ((arena=GrowArena(arena, Nar * sizeof(CELL),
                            arity + 1, &cells PASS_REGS))==0) {
         Yap_Error(RESOURCE_ERROR_STACK, TermNil,
@@ -856,7 +855,7 @@ restart:
       HB0[i] = init;
     }
   }
-  *newarena = CloseArena(&cells, arena, ArenaSz(arena) PASS_REGS);
+  *newarena = CloseArena(&cells, ArenaSz(arena) PASS_REGS);
   return tf;
 }
 
@@ -1658,19 +1657,18 @@ static Int p_nb_queue_enqueue(USES_REGS1) {
   } else {
     min_size = 0L;
   }
-  to = CopyTermToArena(ARG2, arena, FALSE, TRUE, 2, qd + QUEUE_ARENA,
+  Term newarena = arena;
+  to = CopyTermToArena(Deref(ARG2), arena, FALSE, TRUE, 2, &newarena,
                        min_size PASS_REGS);
   if (to == 0L)
     return FALSE;
   cell_space_t cspace;
-  qd = GetQueue(ARG1, "enqueue");
-  arena = GetQueueArena(qd, "enqueue");
+  arena = newarena;
   /* garbage collection ? */
-  enter_cell_space(&cspace);
   HR = HB = ArenaPt(arena);
   old_sz = ArenaSz(arena);
+  qd = GetQueue(ARG1, "enqueue");
   qsize = IntegerOfTerm(qd[QUEUE_SIZE]);
-
   qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsize + 1);
   if (qsize == 0) {
     qd[QUEUE_HEAD] = AbsPair(HR);
@@ -1681,7 +1679,7 @@ static Int p_nb_queue_enqueue(USES_REGS1) {
   RESET_VARIABLE(HR);
   qd[QUEUE_TAIL] = (CELL)HR;
   HR++;
-  qd[QUEUE_ARENA] = CloseArena(&cspace, qd[ QUEUE_ARENA ], old_sz PASS_REGS);
+  qd[QUEUE_ARENA] =CloseArena(&cspace, old_sz PASS_REGS);
   return TRUE;
 }
 
@@ -1705,7 +1703,7 @@ static Int p_nb_queue_dequeue(USES_REGS1) {
   /* garbage collection ? */
   enter_cell_space(&cspace);
   qd[QUEUE_SIZE] = Global_MkIntegerTerm(qsz - 1);
-  qd[QUEUE_ARENA] = CloseArena(&cspace, arena, old_sz PASS_REGS);
+  qd[QUEUE_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
   return Yap_unify(out, ARG2);
 }
 
@@ -1955,7 +1953,7 @@ restart:
     old_sz = ArenaSz(arena);
     HR = HB = ArenaPt(arena);
     qd[HEAP_MAX] = Global_MkIntegerTerm(hmsize);
-    qd[HEAP_ARENA] = CloseArena(&cspace, arena, old_sz PASS_REGS);
+    qd[HEAP_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
     goto restart;
   }
   arena = qd[HEAP_ARENA];
@@ -1966,14 +1964,14 @@ restart:
                          mingrow PASS_REGS);
   qd = GetHeap(ARG1, "add_to_heap");
   arena = qd[HEAP_ARENA];
-  to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, qd + HEAP_ARENA,
+  to = CopyTermToArena(ARG3, arena, FALSE, TRUE, 3, &arena,
                        mingrow PASS_REGS);
   /* protect key in ARG2 in case there is an overflow while copying to */
   key = ARG2;
   if (key == 0 || to == 0L)
     return FALSE;
   qd = GetHeap(ARG1, "add_to_heap");
-  arena = qd[HEAP_ARENA];
+  qd[HEAP_ARENA] = arena;
   /* garbage collection ? */
   enter_cell_space(&cspace);
   HR = HB = ArenaPt(arena);
@@ -1987,7 +1985,7 @@ restart:
       gsiz = 1024;
     }
     ARG3 = to;
-      CreateNewArena (RepAppl(arena),old_sz);
+      arena = CreateNewArena (RepAppl(arena),old_sz);
     if ((arena=GrowArena(arena, gsiz, 3, &cspace PASS_REGS))==0) {
       Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
       return 0L;
@@ -2003,7 +2001,7 @@ restart:
   pt[2 * hsize + 1] = to;
   PushHeap(pt, hsize);
   qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
-  qd[HEAP_ARENA] = CloseArena(&cspace, qd[ HEAP_ARENA ], old_sz PASS_REGS);
+  qd[HEAP_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
   return TRUE;
 }
 
@@ -2347,7 +2345,7 @@ cell_space_t cspace;
     }
     ARG3 = to;
     /*    fprintf(stderr,"growing %ld cells\n",(unsigned long int)gsiz);*/
-      CreateNewArena (RepAppl(arena),old_sz);
+      arena = CreateNewArena (RepAppl(arena),old_sz);
     if (!GrowArena(arena, gsiz, 3, &cspace PASS_REGS)) {
       Yap_Error(RESOURCE_ERROR_STACK, arena, LOCAL_ErrorMessage);
       return 0L;
@@ -2360,7 +2358,7 @@ cell_space_t cspace;
   pt = qd + HEAP_START;
   PushBeam(pt, pt + 2 * hmsize, hsize, key, to);
   qd[HEAP_SIZE] = Global_MkIntegerTerm(hsize + 1);
-  qd[HEAP_ARENA] = CloseArena(&cspace, qd[ HEAP_ARENA ], old_sz PASS_REGS);
+  qd[HEAP_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
   return TRUE;
 }
 
@@ -2383,7 +2381,7 @@ static Int p_nb_beam_del(USES_REGS1) {
   /* garbage collection ? */
  enter_cell_space(&cspace);
   qd[HEAP_SIZE] = Global_MkIntegerTerm(qsz - 1);
-  qd[ HEAP_ARENA] = CloseArena(&cspace, arena, old_sz PASS_REGS);
+  qd[ HEAP_ARENA] = CloseArena(&cspace, old_sz PASS_REGS);
   tk = qd[HEAP_START];
   tv = DelBeamMin(qd + HEAP_START,
                   qd + (HEAP_START + 2 * IntegerOfTerm(qd[HEAP_MAX])), qsz);
diff --git a/C/stdpreds.c b/C/stdpreds.c
index 3fbd44016..dad9cf4cd 100755
--- a/C/stdpreds.c
+++ b/C/stdpreds.c
@@ -1575,6 +1575,7 @@ void Yap_InitCPreds(void) {
   Yap_InitCoroutPreds();
   Yap_InitDBPreds();
   Yap_InitExecFs();
+  Yap_InitErrorPreds();
   Yap_InitGlobals();
   Yap_InitInlines();
   Yap_InitIOPreds();
diff --git a/C/write.c b/C/write.c
index 1258da2eb..5c40f7f93 100644
--- a/C/write.c
+++ b/C/write.c
@@ -74,7 +74,7 @@ typedef struct write_globs {
   bool Keep_terms;
   bool Write_Loops;
   bool Write_strings;
-  UInt  last_atom_minus;
+  UInt last_atom_minus;
   UInt MaxDepth, MaxArgs;
   wtype lw;
   CELL *visited, *visited0, *visited_top;
@@ -410,52 +410,57 @@ static void wrputref(CODEADDR ref, int Quote_illegal,
   lastw = alphanum;
 }
 
-
-static inline bool was_visited(Term t, wglbs *wg, Term *ta ) {
-    Term *tp;
-    if (IsApplTerm(t)) {
-      if (IsExtensionFunctor(FunctorOfTerm(t)))
-	return false;
-	tp = RepAppl(t);
-    }
-    else if (IsPairTerm(t)) tp = RepPair(t);
-    else return false;
-    if (IsAtomTerm(*tp)) {
-      CELL *pt= (CELL*)AtomOfTerm(*tp);
-        if (pt  >= wg->visited0 &&
-	    pt < wg->visited) {
-	  int depth = (wg->visited+1)-pt;
-        wrputs(" @( ", wg->stream);
-        wrputn(depth, wg);
-        wrputs( " ) ", wg->stream);
-        return true;
-	}
-    }
-    *ta = *tp;
-    wg->visited[0] = *tp;
-    *tp = MkAtomTerm( (Atom)wg->visited );
-    wg->visited++;
-
+static inline bool was_visited(Term t, wglbs *wg, Term *ta) {
+  Term *tp;
+  if (IsApplTerm(t)) {
+    tp = RepAppl(t);
+    *ta = tp[0];
     return false;
+    if (IsExtensionFunctor(FunctorOfTerm(t))) {
+      return false;
+    }
+  } else if (IsPairTerm(t)) {
+    tp = RepPair(t);
+    *ta = tp[0];
+    return false;
+} else
+    return false;
+  if (IsAtomTerm(*tp)) {
+    CELL *pt = (CELL *)AtomOfTerm(*tp);
+    if (pt >= wg->visited0 && pt < wg->visited) {
+      int depth = (wg->visited) - pt;
+      wrputs(" @[-", wg->stream);
+      wrputn(depth, wg);
+      wrputs("] ", wg->stream);
+      return true;
+    }
+  }
+  wg->visited[0] = *tp;
+  *tp = MkAtomTerm((Atom)wg->visited);
+  wg->visited++;
+
+  return false;
 }
 
-static inline Term visited_indirection(Term t, wglbs *wg ) {
+static inline Term visited_indirection(Term t, wglbs *wg) {
   Term *tp = (CELL *)AtomOfTerm(t);
-  if (tp >= wg->visited0
-         && (CELL *) tp < wg->visited_top)
+  if (tp >= wg->visited0 && (CELL *)tp < wg->visited_top)
     return *tp;
   return 0;
 }
 
 static inline void done_visiting(Term t, wglbs *wg) {
-    Term *tp;
-    if (IsApplTerm(t)) tp = RepAppl(t);
-    else if (IsPairTerm(t)) tp = RepPair(t);
-    else return;
-    *tp = *--wg->visited;
+  Term *tp;
+  return;
+  if (IsApplTerm(t))
+    tp = RepAppl(t);
+  else if (IsPairTerm(t))
+    tp = RepPair(t);
+  else
+    return;
+  *tp = *--wg->visited;
 }
 
-
 /* writes a blob (default) */
 static int wrputblob(AtomEntry *ref, int Quote_illegal,
                      struct write_globs *wglb) {
@@ -523,10 +528,10 @@ AtomIsSymbols(unsigned char *s) /* Is this atom just formed by symbols ? */
 static void write_quoted(wchar_t ch, wchar_t quote, wrf stream) {
   CACHE_REGS
   if (!(Yap_GetModuleEntry(CurrentModule)->flags & M_CHARESCAPE)) {
-      wrputc(ch, stream);
-      if (ch == '\'')
-          wrputc('\'', stream); /* be careful about quotes */
-      return;
+    wrputc(ch, stream);
+    if (ch == '\'')
+      wrputc('\'', stream); /* be careful about quotes */
+    return;
   }
   if (!(ch < 0xff && chtype(ch) == BS) && ch != '\'' && ch != '\\' &&
       ch != '`') {
@@ -628,12 +633,13 @@ static void putAtom(Atom atom, int Quote_illegal, struct write_globs *wglb) {
   unsigned char *s;
   wtype atom_or_symbol;
   wrf stream = wglb->stream;
-  if (atom == NULL) return;
+  if (atom == NULL)
+    return;
   s = RepAtom(atom)->UStrOfAE;
-  if (s[0] ==  '\0') {
+  if (s[0] == '\0') {
     if (Quote_illegal) {
-    wrputc('\'', stream);
-    wrputc('\'', stream);
+      wrputc('\'', stream);
+      wrputc('\'', stream);
     }
     return;
   }
@@ -772,19 +778,13 @@ static void write_var(CELL *t, struct write_globs *wglb,
   }
 }
 
-static void write_list(Term t, int direction, int depth,
+static void write_list(Term t, Term hot, int direction, int depth,
                        struct write_globs *wglb, struct rewind_term *rwt) {
   Term ti;
   struct rewind_term nrwt;
   nrwt.parent = rwt;
   nrwt.u_sd.s.ptr = 0;
-Term hot;
-  if (was_visited(t, wglb, &hot)) {
-      return;
-  }
-  bool loop = true;
-  while (loop) {
-loop = false;
+  while (true) {
     PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt));
     ti = TailOfTerm(t);
     if (IsVarTerm(ti))
@@ -797,25 +797,33 @@ loop = false;
       }
       wrputc('|', wglb->stream);
       putAtom(Atom3Dots, wglb->Quote_illegal, wglb);
+      done_visiting(t, wglb);
       return;
     }
     lastw = separator;
     depth++;
     wrputc(',', wglb->stream);
-    t = ti;
+    if ((was_visited(ti, wglb, &hot))) {
+      break;
+    }
+    write_list(ti, hot, direction, depth, wglb, &nrwt);
+     done_visiting(ti, wglb);
+     return;
   }
   if (IsPairTerm(ti)) {
     /* we found an infinite loop */
     /* keep going on the list */
     wrputc(',', wglb->stream);
-    write_list(ti, direction, depth, wglb, &nrwt);
-  } else if (ti != MkAtomTerm(AtomNil)) {
+    write_list(ti, hot, direction, depth, wglb, &nrwt);
+    done_visiting(ti, wglb);
+  } else if (ti != TermNil) {
     if (lastw == symbol || lastw == separator) {
       wrputc(' ', wglb->stream);
     }
     wrputc('|', wglb->stream);
     lastw = separator;
     writeTerm(ti, 999, depth, FALSE, wglb, &nrwt);
+    done_visiting(ti, wglb);
   }
 }
 
@@ -840,19 +848,19 @@ static void writeTerm(Term t, int p, int depth, int rinfixarg,
     wrputn((Int)IntOfTerm(t), wglb);
   } else if (IsAtomTerm(t)) {
     Term tn;
-    if ((tn = visited_indirection(t, wglb))!=0) {
-      writeTerm(tn,p,depth,rinfixarg,wglb,rwt);
+    if ((tn = visited_indirection(t, wglb)) != 0) {
+      writeTerm(tn, p, depth, rinfixarg, wglb, rwt);
       return;
     }
     putAtom(AtomOfTerm(t), wglb->Quote_illegal, wglb);
   } else if (IsPairTerm(t)) {
+    Term hot;
+      if ((was_visited(t, wglb, &hot))) {
+        return;
+      }
     if (wglb->Ignore_ops) {
-      wrputs("'.'(", wglb->stream);
+        wrputs("'.'(", wglb->stream);
       lastw = separator;
-      Term hot;
-if ((was_visited(t, wglb, &hot))) {
-    return;
-}
 
       PROTECT(t, writeTerm(hot, 999, depth + 1, FALSE, wglb, &nrwt));
       wrputs(",", wglb->stream);
@@ -861,17 +869,24 @@ if ((was_visited(t, wglb, &hot))) {
       wrclose_bracket(wglb, TRUE);
       return;
     }
-    if (wglb->Use_portray)
-      if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
+    if (wglb->Use_portray) {
+            done_visiting(t, wglb);
+        if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
         return;
       }
+    if ((was_visited(t, wglb, &hot))) {
+        return;
+      }
+     
+    }
     if (trueGlobalPrologFlag(WRITE_STRINGS_FLAG) && IsCodesTerm(t)) {
       putString(t, wglb);
     } else {
       wrputc('[', wglb->stream);
       lastw = separator;
       /* we assume t was already saved in the stack */
-      write_list(t, 0, depth, wglb, rwt);
+      write_list(t, hot, 0, depth, wglb, rwt);
+      done_visiting(t, wglb);
       wrputc(']', wglb->stream);
       lastw = separator;
     }
@@ -882,10 +897,10 @@ if ((was_visited(t, wglb, &hot))) {
     int op, lp, rp;
 
     Term argf;
-      if (was_visited(t, wglb, &argf)) {
-          return;
-      }
-      functor = (Functor)argf;
+    if (was_visited(t, wglb, &argf)) {
+      return;
+    }
+    functor = (Functor)argf;
     if (IsExtensionFunctor(functor)) {
       switch ((CELL)functor) {
       case (CELL)FunctorDouble:
@@ -938,12 +953,16 @@ if ((was_visited(t, wglb, &hot))) {
     }
 #endif
     if (wglb->Use_portray) {
+      done_visiting(t, wglb);
       if (callPortray(t, wglb->stream - GLOBAL_Stream PASS_REGS)) {
         return;
       }
+      Term tf;
+      was_visited(t, wglb, &tf);
+      functor = (Functor)tf;
     }
- 
-      if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
+
+    if (!wglb->Ignore_ops && Arity == 1 && Yap_IsPrefixOp(atom, &op, &rp)) {
       Term tright = ArgOfTerm(1, t);
       int bracket_right = !IsVarTerm(tright) && IsAtomTerm(tright) &&
                           Yap_IsOp(AtomOfTerm(tright));
@@ -1003,7 +1022,7 @@ if ((was_visited(t, wglb, &hot))) {
           wrputc('{', wglb->stream);
         }
         lastw = separator;
-        write_list(tleft, 0, depth, wglb, rwt);
+          writeTerm(tleft, 0, rinfixarg,  depth, wglb, rwt);
         if (atom == AtomEmptyBrackets) {
           wrputc(')', wglb->stream);
         } else if (atom == AtomEmptySquareBrackets) {
@@ -1125,10 +1144,10 @@ if ((was_visited(t, wglb, &hot))) {
       writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
       wrputc('}', wglb->stream);
       lastw = separator;
-    }  else {
+    } else {
       if (!wglb->Ignore_ops && atom == AtomHeap) {
-	Arity = 3+2*IntegerOfTerm(ArgOfTerm(1,t));
-    }
+        Arity = 3 + 2 * IntegerOfTerm(ArgOfTerm(1, t));
+      }
       putAtom(atom, wglb->Quote_illegal, wglb);
       lastw = separator;
       wropen_bracket(wglb, FALSE);
@@ -1147,7 +1166,7 @@ if ((was_visited(t, wglb, &hot))) {
       writeTerm(ArgOfTerm(op, t), 999, depth + 1, FALSE, wglb, &nrwt);
       wrclose_bracket(wglb, TRUE);
     }
-               done_visiting(t, wglb);
+    done_visiting(t, wglb);
   }
 }
 
@@ -1173,25 +1192,23 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
   wglb.Keep_terms = flags & To_heap_f;
   wglb.Write_Loops = flags & Handle_cyclics_f;
   wglb.Quote_illegal = flags & Quote_illegal_f;
-  wglb.MaxArgs = 0 ;
-  wglb.MaxDepth = 0 ;
+  wglb.MaxArgs = 0;
+  wglb.MaxDepth = 0;
   wglb.lw = separator;
   Term tp;
-  
-   if (true && (flags & Handle_cyclics_f) ){
-    // tp = Yap_CyclesInTerm(t PASS_REGS);
-    wglb.visited = Malloc(1024*sizeof(CELL)),
-    wglb.visited0 = wglb.visited,
-    wglb.visited_top = wglb.visited+1024;
-   }
-     tp = t;
- 
 
-   /* protect slots for portray */
+  if (true && (flags & Handle_cyclics_f)) {
+    // tp = Yap_CyclesInTerm(t PASS_REGS);
+    wglb.visited = Malloc(1024 * sizeof(CELL)), wglb.visited0 = wglb.visited,
+    wglb.visited_top = wglb.visited + 1024;
+  }
+  tp = t;
+
+  /* protect slots for portray */
   writeTerm(tp, priority, 1, false, &wglb, &rwt);
-     if (flags & New_Line_f) {
+  if (flags & New_Line_f) {
     if (flags & Fullstop_f) {
-   wrputc('.', wglb.stream);
+      wrputc('.', wglb.stream);
       wrputc('\n', wglb.stream);
     } else {
       wrputc('\n', wglb.stream);
@@ -1203,5 +1220,4 @@ void Yap_plwrite(Term t, StreamDesc *mywrite, int max_depth, int flags,
     }
   }
   pop_text_stack(lvl);
- }
-
+}

From ef8e9a2ea3d797cad7998b126994da7bf1867fd7 Mon Sep 17 00:00:00 2001
From: Vitor Santos Costa <vsc@dcc.fc.up.pt>
Date: Mon, 27 May 2019 15:32:39 +0100
Subject: [PATCH 4/5] Problog testing: modules :(

---
 H/Yapproto.h                                  |  1 +
 H/absmi.h                                     |  6 +++
 H/amidefs.h                                   |  1 +
 H/trim_trail.h                                | 53 ++++++-------------
 packages/ProbLog/problog.yap                  |  2 +-
 packages/ProbLog/problog/lbdd.yap             |  3 +-
 .../problog_examples/learn_graph_lbdd.pl      | 14 +----
 packages/ProbLog/problog_lbfgs.yap            | 29 +++-------
 packages/ProbLog/problog_learning.yap         |  3 +-
 packages/ProbLog/problog_learning_lbdd.yap    |  1 +
 packages/yap-lbfgs/lbfgs.pl                   |  4 +-
 packages/yap-lbfgs/yap_lbfgs.c                | 26 +++++----
 pl/consult.yap                                |  2 +-
 pl/imports.yap                                | 22 ++++----
 pl/meta.yap                                   |  4 ++
 pl/preds.yap                                  |  2 +-
 pl/top.yap                                    | 17 ++++--
 17 files changed, 82 insertions(+), 108 deletions(-)

diff --git a/H/Yapproto.h b/H/Yapproto.h
index 44eca3def..3526f415f 100755
--- a/H/Yapproto.h
+++ b/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
diff --git a/H/absmi.h b/H/absmi.h
index 01884cc3d..2f561bde8 100755
--- a/H/absmi.h
+++ b/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                             *
  ***************************************************************/
diff --git a/H/amidefs.h b/H/amidefs.h
index bc6a33945..887098430 100644
--- a/H/amidefs.h
+++ b/H/amidefs.h
@@ -48,6 +48,7 @@ typedef struct regstore_t *regstruct_ptr;
 
 #endif
 
+
 typedef Int (*CPredicate)(CACHE_TYPE1);
 
 typedef Int (*CmpPredicate)(Term, Term);
diff --git a/H/trim_trail.h b/H/trim_trail.h
index 1910c20b7..988830202 100644
--- a/H/trim_trail.h
+++ b/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;
-  pbase = B->cp_tr, ptop = TR;
-  pt0 = pt1 = TR - 1;
+  tr_fr_ptr  pt1, pbase;
+  pbase = B->cp_tr;
+  pt1 = TR - 1;
   while (pt1 >= pbase) {
     BEGD(d1);
     d1 = TrailTerm(pt1);
     if (IsVarTerm(d1)) {
-      if (d1 < (CELL)HBREG || d1 > Unsigned(B->cp_b)) {
-        TrailTerm(pt0) = d1;
-        TrailVal(pt0) = TrailVal(pt1);
-        pt0--;
+      if (d1 >= (CELL)HBREG && d1 < Unsigned(HR)) {
+          RESET_TRAIL_ENTRY(pt1);
       }
       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 {
-          pt0--;
+           RESET_TRAIL_ENTRY(pt1);
+
         }
         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 */
-        pt1 -= 2;
+                  RESET_TRAIL_ENTRY(pt1);
+                  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;
-      TrailVal(pt0) = TrailVal(pt1);
-      pt0--;
-      pt1--;
+       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
 {
diff --git a/packages/ProbLog/problog.yap b/packages/ProbLog/problog.yap
index 020a8a03c..e97fcaea3 100644
--- a/packages/ProbLog/problog.yap
+++ b/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],
diff --git a/packages/ProbLog/problog/lbdd.yap b/packages/ProbLog/problog/lbdd.yap
index 8a2ca22e8..182b20133 100644
--- a/packages/ProbLog/problog/lbdd.yap
+++ b/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 ):-
diff --git a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl b/packages/ProbLog/problog_examples/learn_graph_lbdd.pl
index c91e644ac..2fccd680b 100644
--- a/packages/ProbLog/problog_examples/learn_graph_lbdd.pl
+++ b/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 
diff --git a/packages/ProbLog/problog_lbfgs.yap b/packages/ProbLog/problog_lbfgs.yap
index 722ef9bff..314dbf00f 100644
--- a/packages/ProbLog/problog_lbfgs.yap
+++ b/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, _).
 
 %========================================================================
diff --git a/packages/ProbLog/problog_learning.yap b/packages/ProbLog/problog_learning.yap
index 019463a57..9d4c70725 100644
--- a/packages/ProbLog/problog_learning.yap
+++ b/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,
 
diff --git a/packages/ProbLog/problog_learning_lbdd.yap b/packages/ProbLog/problog_learning_lbdd.yap
index a09dc0da1..51cdac6dc 100644
--- a/packages/ProbLog/problog_learning_lbdd.yap
+++ b/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).
diff --git a/packages/yap-lbfgs/lbfgs.pl b/packages/yap-lbfgs/lbfgs.pl
index f5c1a7624..173d56e86 100644
--- a/packages/yap-lbfgs/lbfgs.pl
+++ b/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).
 
 
 
diff --git a/packages/yap-lbfgs/yap_lbfgs.c b/packages/yap-lbfgs/yap_lbfgs.c
index faf493e28..bdf7d809e 100644
--- a/packages/yap-lbfgs/yap_lbfgs.c
+++ b/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);
-  YAP_Unify(t, YAP_MkFloatTerm(fx));
-  YAP_RecoverSlots(1, sl);
-  if (ret == 0)
+  f_x = fx;
+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_release", lbfgs_release, 1);
+  YAP_UserCPredicate("lbfgs", p_lbfgs, 2);
+    YAP_UserCPredicate("lbfgs_release", lbfgs_release, 1);
+    YAP_UserCPredicate("lbfgs_fx", lbfgs_fx, 1);
 
   YAP_UserCPredicate("lbfgs_defaults", lbfgs_defaults, 0);
   
diff --git a/pl/consult.yap b/pl/consult.yap
index 611eac220..248925ced 100644
--- a/pl/consult.yap
+++ b/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),
diff --git a/pl/imports.yap b/pl/imports.yap
index 28a4e9c06..466be0cd2 100644
--- a/pl/imports.yap
+++ b/pl/imports.yap
@@ -35,20 +35,17 @@ fail.
 % parent module mechanism
 %% system has priority
 '$get_predicate_definition'(_ImportingMod:G,prolog:G) :-
-    nonvar(G),
-    '$pred_exists'(G,prolog).
+    nonvar(G).
 %% I am there, no need to import
 '$get_predicate_definition'(Mod:Pred,Mod:Pred) :-
-    nonvar(Pred),
-    '$pred_exists'(Pred, Mod).
+    nonvar(Pred).
 %% 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,
-    '$get_predicate_definition'(PMod:G, ExportingMod:G0).
+    ImportingMod \= PMod.
 %% 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)
+
     ).
 
 %
diff --git a/pl/meta.yap b/pl/meta.yap
index 8452ab833..b1be8e6b9 100644
--- a/pl/meta.yap
+++ b/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),
diff --git a/pl/preds.yap b/pl/preds.yap
index acb9fe7b1..e84452525 100644
--- a/pl/preds.yap
+++ b/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, _)
     ).
diff --git a/pl/top.yap b/pl/top.yap
index 9e7c28e16..29f8e96b8 100644
--- a/pl/top.yap
+++ b/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) :-
 	(

From e6ffe9c2a03604dd3485eb3047e2a8eab88f35ec Mon Sep 17 00:00:00 2001
From: Vitor Santos Costa <vsc@dcc.fc.up.pt>
Date: Mon, 27 May 2019 15:34:24 +0100
Subject: [PATCH 5/5] lbfgs and Problog ex.

---
 .../problog_examples/learn_graph_lbfgs.pl     | 113 ++++++++++++++++++
 1 file changed, 113 insertions(+)
 create mode 100644 packages/ProbLog/problog_examples/learn_graph_lbfgs.pl

diff --git a/packages/ProbLog/problog_examples/learn_graph_lbfgs.pl b/packages/ProbLog/problog_examples/learn_graph_lbfgs.pl
new file mode 100644
index 000000000..c91e644ac
--- /dev/null
+++ b/packages/ProbLog/problog_examples/learn_graph_lbfgs.pl
@@ -0,0 +1,113 @@
+%%% -*- mode: Prolog; -*-
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% ProbLog program describing a probabilistic graph
+% (running example from ProbLog presentations)
+% $Id: learn_graph.pl 4875 2010-10-05 15:28:35Z theo $
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+% example for parameter learning with LeProbLog
+%
+% training and test examples are included at the end of the file
+% query ?- do_learning(20).
+% will run 20 iterations of learning with default settings
+%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
+
+:- use_module('../problog_lbfgs').
+
+
+ :- 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))).
+
+path(X,Y) :- path(X,Y,[X],_).
+
+path(X,X,A,A).
+path(X,Y,A,R) :- 
+  X\==Y, 
+  edge(X,Z), 
+  absent(Z,A), 
+  path(Z,Y,[Z|A],R).
+
+% using directed edges in both directions
+edge(X,Y) :- dir_edge(Y,X).
+edge(X,Y) :- dir_edge(X,Y).
+
+% checking whether node hasn't been visited before
+absent(_,[]).
+absent(X,[Y|Z]):-X \= Y, absent(X,Z).
+
+:- endif.
+
+%%%%
+% probabilistic facts 
+% - probability represented by t/1 term means learnable parameter
+% - argument of t/1 is real value (used to compare against in evaluation when known), use t(_) if unknown
+%%%%
+t(0.9)::dir_edge(1,2).
+t(0.8)::dir_edge(2,3).
+t(0.6)::dir_edge(3,4).
+t(0.7)::dir_edge(1,6).
+t(0.5)::dir_edge(2,6).
+t(0.4)::dir_edge(6,5).
+t(0.7)::dir_edge(5,3).
+t(0.2)::dir_edge(5,4).
+
+%%%%%%%%%%%%%%
+% training examples of form example(ID,Query,DesiredProbability) 
+%%%%%%%%%%%%%%
+
+example(1,path(1,2),0.94).
+example(2,path(1,3),0.81).
+example(3,path(1,4),0.54).
+example(4,path(1,5),0.70).
+example(5,path(1,6),0.87).
+example(6,path(2,3),0.85).
+example(7,path(2,4),0.57).
+example(8,path(2,5),0.72).
+example(9,path(2,6),0.86).
+example(10,path(3,4),0.66).
+example(11,path(3,5),0.80).
+example(12,path(3,6),0.75).
+example(13,path(4,5),0.57).
+example(14,path(4,6),0.51).
+example(15,path(5,6),0.69).
+% some examples for learning from proofs:
+/*example(16,(dir_edge(2,3),dir_edge(2,6),dir_edge(6,5),dir_edge(5,4)),0.032).
+example(17,(dir_edge(1,6),dir_edge(2,6),dir_edge(2,3),dir_edge(3,4)),0.168).
+example(18,(dir_edge(5,3),dir_edge(5,4)),0.14).
+example(19,(dir_edge(2,6),dir_edge(6,5)),0.2).
+example(20,(dir_edge(1,2),dir_edge(2,3),dir_edge(3,4)),0.432).
+*/
+%%%%%%%%%%%%%%
+% test examples of form test_example(ID,Query,DesiredProbability) 
+% note: ID namespace is shared with training example IDs
+%%%%%%%%%%%%%%
+
+test_example(21,path(2,1),0.94).
+test_example(22,path(3,1),0.81).
+test_example(23,path(4,1),0.54).
+test_example(24,path(5,1),0.70).
+test_example(25,path(6,1),0.87).
+test_example(26,path(3,2),0.85).
+test_example(27,path(4,2),0.57).
+test_example(28,path(5,2),0.72).
+test_example(29,path(6,2),0.86).
+test_example(30,path(4,3),0.66).
+test_example(31,path(5,3),0.80).
+test_example(32,path(6,3),0.75).
+test_example(33,path(5,4),0.57).
+test_example(34,path(6,4),0.51).
+test_example(35,path(6,5),0.69).
+