state store and restore for paralell engines implemented

logic/guile-log/code-load.scm

@@ -150,6 +150,8 @@
                      gp-push-engine
                      gp-peek-engine
                      gp-combine-engines
+                     gp-combine-pop
+                     gp-combine-push                     
                      gp-combine-state
                      gp-current-engine-path
                      ))

logic/guile-log/paralell.scm

 (define-module (logic guile-log paralell)
   #:use-module (logic guile-log)
+    #:use-module (logic guile-log code-load)
   #:use-module (logic guile-log umatch)
   #:export (<pand> <pzip> f test1 test2 test3 test4))
 
@@ -28,10 +29,12 @@
        (<with-s> s
         (<pit> s p ccc
          (<with-fail> p
-          (<with-s> (gp-push-engine frame engine)
+            (<with-s> (gp-push-engine frame engine)
+            (<code> (gp-combine-push data))
             (<code> (gp-var-set v (gp-peek-engine) S))
             code ...
             (<code> (set! se S))
+            (<code> (gp-combine-pop))
             (<code> (gp-pop-engine))))))
        ...
        (<with-s> (gp-combine-state s (list se ...))

logic/guile-log/src/state.c

@@ -1548,8 +1548,8 @@ SCM_DEFINE(gp_pop_engine, "gp-pop-engine", 0, 0, 0, (),
 
   SCM s_stack = SCM_CAR(gp_engine_path);
 
-  gp_engine_path = SCM_CDR(gp_engine_path);
-  
+  gp_store_path = SCM_CDR(gp_store_path); 
+      
   scm_fluid_set_x(gp_current_stack, SCM_CDR(SCM_CAR(gp_engine_path)));
   
   if(!SCM_CONSP(gp_engine_path))
@@ -1674,11 +1674,34 @@ SCM_DEFINE(gp_combine_engines, "gp-combine-engines", 1, 0, 0, (SCM l),
 
   gp->gp_ci[0] = vec;
   gp->gp_ci++;
+
+  gp_store_path = scm_cons(vec, gp_store_path);
   
   return SCM_UNSPECIFIED;
 }
 #undef FUNC_NAME
 
+SCM_DEFINE(gp_combine_pop, "gp-combine-pop", 0, 0, 0, (), 
+	   "")
+
+#define FUNC_NAME s_gp_combine_pop
+{
+  SCM ret = SCM_CAR(gp_store_path);
+  gp_store_path = SCM_CDR(gp_store_path);
+  return ret;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE(gp_combine_push, "gp-combine-push", 1, 0, 0, (SCM r), 
+	   "")
+
+#define FUNC_NAME s_gp_combine_push
+{
+  gp_store_path = scm_cons(r, gp_store_path);
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
 SCM_DEFINE(gp_combine_state, "gp-combine-state", 2, 0, 0, (SCM s, SCM l), 
 	   "")
 #define FUNC_NAME s_gp_combine_engine

logic/guile-log/src/unify-undo-redo.c

@@ -1349,6 +1349,7 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
   // We must make sure that we guard the state if the vlist
   // Else trunction will make it fail.
   gp_no_gc();
+  
   if(GP_CONSP(s))
     {
       SCM l = GP_GETREF(s)[2];
@@ -1360,9 +1361,73 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
 
   ret = scm_cons(gp_store_state(get_gp()),
                  scm_cons(scm_fluid_ref(gp_current_stack) , s));
+
   
+  SCM lpath  = gp_store_path;
+  SCM llpath = SCM_EOL;
+  SCM k      = gp_engine_path;
+  int first  = 1;
+  while(SCM_CONSP(lpath))
+    {
+      SCM l    = SCM_CAR(lpath);
+      SCM ll   = SCM_EOL;
+      
+      SCM tag = SCM_CAR(k);
+      
+      k = SCM_CDR(k);
+      
+      while(SCM_CONSP(l))
+        {
+          SCM x = SCM_CAR(l);
+          if(GP(x) && GP_UNBOUND(GP_GETREF(x)))
+            ll = scm_cons(SCM_BOOL_F, ll);
+          else
+            {
+              SCM xx   = GP_GETREF(x)[1];
+
+              if(first && scm_is_eq(xx, tag))
+                {
+                  first = 0;
+                  ll    = ret;
+                  continue;
+                }
+              
+              SCM e    = SCM_CDR(xx);
+              SCM s    = SCM_CAR(xx);
+              SCM olde = scm_fluid_ref(gp_current_stack);
+              scm_fluid_set_x(gp_current_stack, e);
+              SCM r    = scm_cons(gp_store_state(get_gp()),
+                                  scm_cons(e , s));
+              scm_fluid_set_x(gp_current_stack, olde);
+              
+              ll  = scm_cons(r, ll);              
+            }
+        }
+      
+      SCM vecout = scm_reverse(ll);
+    }
+
+  if(SCM_CONSP(gp_store_path))
+    {
+      SCM xx   = SCM_CAR(k);
+      SCM e    = SCM_CDR(xx);
+      SCM s    = SCM_CAR(xx);
+      SCM olde = scm_fluid_ref(gp_current_stack);
+      scm_fluid_set_x(gp_current_stack, e);
+      SCM r    = scm_cons(gp_store_state(get_gp()),
+                          scm_cons(e , s));
+      scm_fluid_set_x(gp_current_stack, olde);
+
+      llpath = scm_cons(r, llpath);
+    }
+  else
+    llpath = scm_cons(ret, llpath);
+
   gp_do_gc();
-  return ret;    
+  
+  return scm_cons(gp_store_path,
+                  scm_cons(gp_engine_path,
+                           scm_cons(ret, llpath)));    
 }
 #undef FUNC_NAME
 
@@ -1953,17 +2018,121 @@ static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
 
 //#define DB(X) 
 
+/*
+we have the current state as [a,...,b,...]
+we have the restore state as [c,...,b,...]
+
+So we need to unwind to [b,...] first
+
+then we need to resore all paths back to c
+
+and finally restore the current engine
+ */
 SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K), 
 	   "restore a continuation point")
 #define FUNC_NAME s_gp_gp_restore_state
 {
   gp_no_gc();
-  if(SCM_CONSP(cont))
+
+  // Unpack level 1
+  SCM spath  = SCM_CAR(cont);
+  SCM spathl = SCM_CDR(cont);
+  SCM epath  = SCM_CAR(spathl);
+  SCM epathl = SCM_CDR(spathl);  
+  SCM lpath  = SCM_CDR(epathl);
+      cont   = SCM_CAR(epathl);
+
+  //First we clear the head of the states
+  
+  int ncur = scm_to_int(scm_length(gp_engine_path));
+  int nnew = scm_to_int(scm_length(epath));
+
+  // make ncur == nnew
+  while(ncur > nnew)
     {
-      scm_fluid_set_x(gp_current_stack, SCM_CADR(cont));
-      struct gp_stack *gp = get_gp();
-      gp_restore_state(SCM_CAR(cont), gp, K);
+      SCM x = SCM_CAR(gp_engine_path);
+      SCM e = SCM_CDR(x);
+      SCM s = SCM_CAR(x);
+      scm_fluid_set_x(gp_current_stack, e);
+      gp_clear(s);
+      
+      gp_engine_path = SCM_CDR(gp_engine_path);
+      ncur--;
+    }
+
+  while(nnew > ncur)
+    {
+      epath = SCM_CDR(epath);
+      nnew--;
+    }
+
+  // Unwind all stack frames untill the common b,...
+  while(ncur > 0)
+    {
+      if(scm_is_eq(SCM_CDAR(gp_engine_path), SCM_CDAR(epath)))
+        break;
+
+      SCM x = SCM_CAR(gp_engine_path);
+      SCM e = SCM_CDR(x);
+      SCM s = SCM_CAR(x);
+      scm_fluid_set_x(gp_current_stack, e);
+      gp_clear(s);
+      
+      gp_engine_path = SCM_CDR(gp_engine_path);
+      epath = SCM_CDR(epath);
+      ncur--;      
+    }
+
+  SCM dcont = SCM_CAR(lpath);
+  
+  {
+    scm_fluid_set_x(gp_current_stack, SCM_CADR(dcont));
+    struct gp_stack *gp = get_gp();
+    gp_restore_state(SCM_CAR(dcont), gp, K);
+    if(scm_is_eq(dcont, cont))
+      {
+       gp_do_gc();
+       gp_engine_path = epath;
+       gp_store_path  = spath;
+       return SCM_UNSPECIFIED;
+      }
+  }
+
+  lpath = SCM_CDR(lpath);
+  
+  while(SCM_CONSP(lpath))
+    {
+      SCM ll = SCM_CAR(lpath);
+
+      int found = 0;
+      while(SCM_CONSP(ll))
+        {
+          SCM dcont = SCM_CAR(ll);
+
+          if(scm_is_eq(dcont, cont))            
+            found = 1;
+          else
+            {
+              scm_fluid_set_x(gp_current_stack, SCM_CADR(dcont));
+              struct gp_stack *gp = get_gp();
+              gp_restore_state(SCM_CAR(dcont), gp, K);
+            }
+        }
+
+      if(found)
+        {
+          scm_fluid_set_x(gp_current_stack, SCM_CADR(dcont));
+          struct gp_stack *gp = get_gp();
+          gp_restore_state(SCM_CAR(dcont), gp, K);
+          gp_engine_path = epath;
+          gp_store_path  = spath;
+          gp_do_gc();
+          return SCM_UNSPECIFIED;
+        }
     }
+  
+  gp_engine_path = epath;
+  gp_store_path  = spath;
   gp_do_gc();
   return SCM_UNSPECIFIED;
 }

logic/guile-log/src/unify.c

@@ -31,6 +31,7 @@ SCM tester = SCM_BOOL_F;
 SCM inline get_cs(SCM v);
 
 SCM gp_engine_path = SCM_EOL;
+SCM gp_store_path  = SCM_EOL;
 
 SCM gp_current_stack = SCM_BOOL_F;
 SCM current_stack = SCM_BOOL_F;

logic/guile-log/src/unify.h

@@ -161,6 +161,8 @@ SCM_API SCM gp_code_to_int(SCM x);
 SCM_API SCM gp_make_null_procedure(SCM n, SCM def);
 SCM_API SCM gp_fill_null_procedure(SCM proc, SCM addr, SCM l);
 
+SCM_API SCM gp_combine_pop();
+SCM_API SCM gp_combine_push(SCM r);
 SCM_API SCM gp_new_engine(SCM e); 
 SCM_API SCM gp_set_engine(SCM path); 
 SCM_API SCM gp_restore_engine_guards(SCM cont);