Skip to content

G
Guile Log
Commit 46ed87f3 by Stefan Israelsson Tampe
Options

many things work quite okey

parent 41125e8a
Showing with 172 additions and 84 deletions
logic/guile-log/paralell.scm
......@@ -20,22 +20,24 @@
(se #f) ...
(p P)
(cc CC))
(<code> (gp-combine-engines data))
(<let*> ((s frame)
(ccc (lambda (ss pp)
(gp-combine-engines data)
(cc (gp-combine-state
s (list se ...))
p))))
(<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-pop-engine))))))
...
(<code> (gp-combine-engines data))
(<with-s> (gp-combine-state s (list se ...))
(<with-fail> p <cc>))))))
......
logic/guile-log/src/unify-undo-redo.c
......@@ -11,6 +11,8 @@
#define NSTATE 8
#include "dynstack.c"
static inline SCM gp_store_state(struct gp_stack *gp);
static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K);
SCM gp_state_token = SCM_BOOL_F;
inline SCM gp_get_state_token()
......@@ -389,8 +391,9 @@ static inline int gp_do_cons(SCM item, int state, SCM *old, SCM gp_unbd)
} \
}
void vector_state(int state, SCM *old, SCM l, SCM vec);
void unwind_all_in_branch(SCM l);
void unwind_in_new_branch(SCM p,SCM path, SCM lpath);
void unwind_in_new_branch(SCM p, SCM l, SCM path, SCM lpath);
SCM unwind_hooks = SCM_BOOL_F;
//#define DB(X) X
......@@ -554,6 +557,7 @@ static void gp_unwind0(SCM *fr, SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp,
scm_misc_error("unwind",
"unwinding the first protected ci stack element",
SCM_EOL);
if(SCM_CONSP(*i))
{
state = gp_do_cons(*i, state, &old, gp_unbd);
......@@ -586,32 +590,38 @@ static void gp_unwind0(SCM *fr, SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp,
if(SCM_I_IS_VECTOR(*i))
{
SCM l = SCM_SIMPLE_VECTOR_REF(*i,0);
vector_state(state, &old, l, *i);
if(!SCM_CONSP(path))
{
unwind_all_in_branch(l);
unwind_all_in_branch(l);
}
else
{
SCM p = SCM_CAR(path);
int found = 0;
for(;SCM_CONSP(l);l=SCM_CDR(l))
SCM ll = l;
for(;SCM_CONSP(ll);ll=SCM_CDR(ll))
{
SCM x = gp_variable_ref(SCM_CAR(l));
SCM x = gp_variable_ref(SCM_CAR(ll));
if(scm_is_eq(x, p))
{
found = 1;
unwind_in_new_branch(p, SCM_CDR(path), lpath);
ci = i + 1;
fflush(stdout);
unwind_in_new_branch(p, l, SCM_CDR(path), lpath);
*i = SCM_BOOL_F;
break;
}
}
if(!found)
unwind_all_in_branch(l);
if(!found)
{
unwind_all_in_branch(l);
}
else
break;
}
*i = SCM_BOOL_F;
continue;
}
......@@ -859,31 +869,92 @@ static void gp_unwind0(SCM *fr, SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp,
}
//#define DB(X)
void unwind_all_in_branch(SCM l)
void vector_state(int state, SCM *old, SCM l, SCM vec)
{
SCM old_engine = scm_fluid_ref(gp_current_stack);
for(; SCM_CONSP(l); l = SCM_CDR(l))
if(state)
{
SCM x = gp_variable_ref(SCM_CAR(l));
if(SCM_CONSP(x))
switch(state)
{
SCM new_engine = SCM_CDR(x);
scm_fluid_set_x(gp_current_stack, new_engine);
gp_clear(SCM_BOOL_F);
case gp_store:
{
SCM xx = scm_c_make_vector(2, SCM_BOOL_F);
SCM u = SCM_EOL;
for(; SCM_CONSP(l); l = SCM_CDR(l))
{
SCM x = SCM_CAR(l);
if(GP(x) && GP_UNBOUND(GP_GETREF(x)))
{
u = scm_cons(SCM_BOOL_F, u);
continue;
}
if(GP(x))
x = GP_GETREF(x)[1];
else
scm_misc_error
("gp-unwind",
"element in engine datalist not a gp variable - ~a~%",
scm_list_1(x));
if(SCM_CONSP(x))
{
SCM s = SCM_CAR(x);
SCM e = SCM_CDR(x);
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);
u = scm_cons(r, u);
}
else
scm_misc_error("gp-unwind","s . engine not a cons - ~a~%",
scm_list_1(x));
}
scm_c_vector_set_x(xx,0 ,vec);
scm_c_vector_set_x(xx,1 ,u );
SCM val = scm_cons(xx,SCM_EOL);
if(SCM_CONSP(*old))
SCM_SETCDR(*old,val);
*old = val;
break;
}
case gp_redo:
*old = SCM_CDR(*old);
}
}
}
void unwind_all_in_branch(SCM l)
{
{ // Unwind the different branches
SCM old_engine = scm_fluid_ref(gp_current_stack);
for(; SCM_CONSP(l); l = SCM_CDR(l))
{
SCM x = gp_variable_ref(SCM_CAR(l));
if(SCM_CONSP(x))
{
SCM new_engine = SCM_CDR(x);
scm_fluid_set_x(gp_current_stack, new_engine);
gp_clear(SCM_BOOL_F);
}
}
scm_fluid_set_x(gp_current_stack, old_engine);
scm_fluid_set_x(gp_current_stack, old_engine);
}
}
static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
SCM path, SCM lpath);
void unwind_in_new_branch(SCM p, SCM path, SCM lpath)
void unwind_in_new_branch(SCM p, SCM l, SCM path, SCM lpath)
{
SCM engine = SCM_CDR(p);
gp_engine_path = scm_cons(p, gp_engine_path);
scm_fluid_set_x(gp_current_stack, engine);
gp_unwind_(SCM_CAR(p), 0, 0, 0, path, lpath);
......@@ -899,6 +970,7 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
SCM lt = SCM_EOL;
SCM spath = gp_store_path;
SCM paths = gp_paths;
if(scm_is_false(lpath))
{
lt = gp_gp_cdr(s,s);
......@@ -947,7 +1019,7 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
path = b;
}
}
if(SCM_CONSP(path))
{
if(scm_is_false(lpath))
......@@ -973,9 +1045,10 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
paths = SCM_CDR(gp_gp_cdr(s,s));
spath = SCM_CDR(paths);
gp_store_path = spath;
gp_paths = paths;
gp_engine_path = SCM_CAR(paths);
gp_store_path = spath;
gp_paths = paths;
scm_fluid_set_x(gp_current_stack, SCM_CDAR(gp_engine_path));
lpath = SCM_CDR(lpath);
ncons = scm_to_int(SCM_CAR(lpath));
......@@ -987,7 +1060,6 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
}
struct gp_stack *gp = get_gp();
SCM *fr, *ci,*si,*cs;
scm_t_bits dyn_n;
......@@ -1020,6 +1092,7 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
}
ha = GP_GET_HANDLERS(fr);
dyn_n = GP_GET_DLENGTH(fr);
......@@ -1059,7 +1132,7 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
gp_unwind0(fr - GP_FRAMESIZE*nci,ci, si, cs, gp, path, lpath);
gp->handlers = ha;
gp_debug0("leaving unwind\n");
}
......@@ -1089,7 +1162,7 @@ void inline falsify_entries(SCM *ci,struct gp_stack *gp)
// The stacks completely.
// Todo make this work for sub engines currently we do nothing between engines
static inline void gp_prune(SCM s, int tailp)
{
{
struct gp_stack *gp = get_gp();
SCM *fr, *ci,*si,*cs,lt;
SCM tag = SCM_EOL;
......@@ -1388,18 +1461,26 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
SCM llpath = SCM_EOL;
SCM k = gp_engine_path;
int first = 1;
printf("1\n");
while(SCM_CONSP(lpath))
{
SCM l = SCM_CAR(lpath);
SCM ll = SCM_EOL;
SCM tag = SCM_CAR(k);
printf("a lpath\n");
k = SCM_CDR(k);
while(SCM_CONSP(l))
{
SCM x = SCM_CAR(l);
printf("a state in lpath\n");
if(GP(x) && GP_UNBOUND(GP_GETREF(x)))
ll = scm_cons(SCM_BOOL_F, ll);
else
......@@ -1409,7 +1490,7 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
if(first && scm_is_eq(xx, tag))
{
first = 0;
ll = ret;
ll = scm_cons(ret, ll);
continue;
}
......@@ -1426,24 +1507,9 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
}
SCM vecout = scm_reverse(ll);
llpath = scm_cons(vecout, llpath);
}
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 scm_cons(gp_paths,
......@@ -1553,7 +1619,7 @@ static inline SCM * gp_get_branch(SCM *p, SCM *fr, struct gp_stack *gp)
find the root we do the actual rewinding.
*/
//#define DB(X) X
static int gp_rewind(SCM pp, SCM pend, struct gp_stack *gp)
static int gp_rewind(SCM pp, SCM pend, struct gp_stack *gp, SCM K)
{
SCM *id,q,stack[51];
int sp;
......@@ -1578,7 +1644,7 @@ static int gp_rewind(SCM pp, SCM pend, struct gp_stack *gp)
if(sp >= 50)
{
gp_debug0("A new rewind frame\n");
gp_rewind(SCM_CDR(pp), pend, gp);
gp_rewind(SCM_CDR(pp), pend, gp, K);
break;
}
......@@ -1648,7 +1714,29 @@ static int gp_rewind(SCM pp, SCM pend, struct gp_stack *gp)
sp--;
continue;
}
else if(SCM_I_IS_VECTOR(q))
{
gp->gp_ci[0] = scm_c_vector_ref(q,0);
gp->gp_ci ++;
sp--;
printf("1\n");
SCM l = scm_c_vector_ref(q,1);
for(;SCM_CONSP(l);l = SCM_CDR(l))
{
printf("11\n");
SCM dcont = SCM_CAR(l);
if(scm_is_false(dcont))
continue;
SCM olde = scm_fluid_ref(gp_current_stack);
printf("*\n");
scm_fluid_set_x(gp_current_stack, SCM_CADR(dcont));
struct gp_stack *gp2 = get_gp();
gp_restore_state(SCM_CAR(dcont), gp2, K);
scm_fluid_set_x(gp_current_stack, olde);
}
printf("2\n");
}
scm_misc_error("restore-state/ci rewinding",
"Got unhandle object ci -> ~%~a",
scm_list_1(q));
......@@ -1985,7 +2073,7 @@ static void gp_restore_state(SCM data, struct gp_stack *gp, SCM K)
pp_c, pp_x);
gp_debug0("rewind ci\n");
gp_rewind(path, pp_c, gp);
gp_rewind(path, pp_c, gp, K);
gp_debug0("rewind fr\n");
gp_rewind_fr(pathfr,pp_x, gp);
......@@ -2054,6 +2142,8 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
{
gp_no_gc();
printf("restore 1\n");fflush(stdout);
// Unpack level 1
SCM paths = SCM_CAR(cont);
SCM pathsl = SCM_CDR(cont);
......@@ -2061,12 +2151,12 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
SCM epath = SCM_CAR(paths);
SCM lpath = SCM_CDR(pathsl);
cont = SCM_CAR(pathsl);
printf("restore 2\n");fflush(stdout);
//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));
printf("restore 3 %d %d\n",ncur,nnew);fflush(stdout);
// make ncur == nnew
while(ncur > nnew)
{
......@@ -2080,15 +2170,20 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
ncur--;
}
printf("restore 4 %d %d\n",ncur,nnew);fflush(stdout);
while(nnew > ncur)
{
epath = SCM_CDR(epath);
nnew--;
}
printf("restore 5 %d %d\n",ncur, nnew);fflush(stdout);
// Unwind all stack frames untill the common b,...
while(ncur > 0)
{
if(scm_is_eq(SCM_CDAR(gp_engine_path), SCM_CDAR(epath)))
break;
......@@ -2103,34 +2198,22 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
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;
}
}
printf("restore 6 %d %d\n", ncur, scm_to_int(scm_length(lpath)));
fflush(stdout);
lpath = SCM_CDR(lpath);
printf("restore 7\n");fflush(stdout);
while(SCM_CONSP(lpath))
{
SCM ll = SCM_CAR(lpath);
int found = 0;
while(SCM_CONSP(ll))
{
SCM dcont = SCM_CAR(ll);
if(scm_is_false(dcont))
continue;
if(scm_is_eq(dcont, cont))
found = 1;
continue;
else
{
scm_fluid_set_x(gp_current_stack, SCM_CADR(dcont));
......@@ -2138,24 +2221,27 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
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;
}
lpath = SCM_CDR(lpath);
}
{
scm_fluid_set_x(gp_current_stack, SCM_CADR(cont));
struct gp_stack *gp = get_gp();
gp_restore_state(SCM_CAR(cont), gp, K);
}
printf("restore 8\n");fflush(stdout);
gp_engine_path = epath;
gp_store_path = spath;
gp_paths = paths;
gp_do_gc();
printf("restore 9\n");fflush(stdout);
return SCM_UNSPECIFIED;
}
#undef FUNC_NAME
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment