undo works with the new pand framework

parent e2844f43
...@@ -30,11 +30,11 @@ ...@@ -30,11 +30,11 @@
(<pit> s p ccc (<pit> s p ccc
(<with-fail> p (<with-fail> p
(<with-s> (gp-push-engine frame engine) (<with-s> (gp-push-engine frame engine)
(<code> (gp-combine-push data)) (<code> (gp-combine-push data))
(<code> (gp-var-set v (gp-peek-engine) S)) (<code> (gp-var-set v (gp-peek-engine) S))
code ... code ...
(<code> (set! se S)) (<code> (set! se S))
(<code> (gp-pop-engine)))))) (<code> (gp-pop-engine))))))
... ...
(<with-s> (gp-combine-state s (list se ...)) (<with-s> (gp-combine-state s (list se ...))
(<with-fail> p <cc>)))))) (<with-fail> p <cc>))))))
......
...@@ -1548,8 +1548,18 @@ SCM_DEFINE(gp_pop_engine, "gp-pop-engine", 0, 0, 0, (), ...@@ -1548,8 +1548,18 @@ SCM_DEFINE(gp_pop_engine, "gp-pop-engine", 0, 0, 0, (),
SCM s_stack = SCM_CAR(gp_engine_path); SCM s_stack = SCM_CAR(gp_engine_path);
gp_store_path = SCM_CDR(gp_store_path); if(SCM_CONSP(gp_store_path))
gp_store_path = SCM_CDR(gp_store_path);
else
scm_misc_error
("gp-pop-engine","gp_store_path not a nonempty list", SCM_EOL);
if(SCM_CONSP(gp_engine_path))
gp_engine_path = SCM_CDR(gp_engine_path);
else
scm_misc_error
("gp-pop-engine","gp_engine_path not a nonempty list", SCM_EOL);
gp_paths = scm_cons(gp_engine_path, gp_store_path); gp_paths = scm_cons(gp_engine_path, gp_store_path);
scm_fluid_set_x(gp_current_stack, SCM_CDR(SCM_CAR(gp_engine_path))); scm_fluid_set_x(gp_current_stack, SCM_CDR(SCM_CAR(gp_engine_path)));
...@@ -1589,7 +1599,7 @@ SCM_DEFINE(gp_push_engine, "gp-push-engine", 2, 0, 0, (SCM s, SCM e), ...@@ -1589,7 +1599,7 @@ SCM_DEFINE(gp_push_engine, "gp-push-engine", 2, 0, 0, (SCM s, SCM e),
int logical = gp->_logical_; int logical = gp->_logical_;
gp_engine_path = scm_cons(x , gp_engine_path); gp_engine_path = scm_cons(x , gp_engine_path);
gp_paths = scm_cons(gp_engine_path, SCM_BOOL_F); gp_paths = scm_cons(gp_engine_path, SCM_EOL);
scm_fluid_set_x(gp_current_stack,e); scm_fluid_set_x(gp_current_stack,e);
...@@ -1662,7 +1672,7 @@ SCM_DEFINE(gp_set_engine, "gp-set-engine", 1, 0, 0, (SCM paths), ...@@ -1662,7 +1672,7 @@ SCM_DEFINE(gp_set_engine, "gp-set-engine", 1, 0, 0, (SCM paths),
"") "")
#define FUNC_NAME s_gp_set_engine #define FUNC_NAME s_gp_set_engine
{ {
SCM e = SCM_CDR(SCM_CAR(paths)); SCM e = SCM_CDR(SCM_CAR(SCM_CAR(paths)));
SCM pathout = gp_paths; SCM pathout = gp_paths;
gp_engine_path = SCM_CAR(paths); gp_engine_path = SCM_CAR(paths);
...@@ -1687,9 +1697,6 @@ SCM_DEFINE(gp_combine_engines, "gp-combine-engines", 1, 0, 0, (SCM l), ...@@ -1687,9 +1697,6 @@ SCM_DEFINE(gp_combine_engines, "gp-combine-engines", 1, 0, 0, (SCM l),
gp->gp_ci[0] = vec; gp->gp_ci[0] = vec;
gp->gp_ci++; gp->gp_ci++;
gp_store_path = scm_cons(vec, gp_store_path);
SCM_SETCDR(gp_paths, gp_store_path);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
...@@ -1712,6 +1719,13 @@ SCM_DEFINE(gp_combine_push, "gp-combine-push", 1, 0, 0, (SCM r), ...@@ -1712,6 +1719,13 @@ SCM_DEFINE(gp_combine_push, "gp-combine-push", 1, 0, 0, (SCM r),
#define FUNC_NAME s_gp_combine_push #define FUNC_NAME s_gp_combine_push
{ {
gp_store_path = scm_cons(r, gp_store_path); gp_store_path = scm_cons(r, gp_store_path);
if(SCM_CONSP(gp_paths))
SCM_SETCDR(gp_paths, gp_store_path);
else
scm_misc_error("gp-combine-push","gp_paths not a cons ~a~%",
scm_list_1(gp_paths));
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME #undef FUNC_NAME
......
...@@ -904,9 +904,16 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci, ...@@ -904,9 +904,16 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
lt = gp_gp_cdr(s,s); lt = gp_gp_cdr(s,s);
if(SCM_CONSP(lt)) if(SCM_CONSP(lt))
{ {
paths = SCM_CDR(lt); SCM ltpaths = SCM_CDR(lt);
path = SCM_CAR(paths); if(SCM_CONSP(ltpaths))
spath = SCM_CDR(paths); {
path = SCM_CAR(ltpaths);
spath = SCM_CDR(ltpaths);
}
else
{
path = gp_engine_path;
}
} }
else else
path = gp_engine_path; path = gp_engine_path;
...@@ -961,10 +968,15 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci, ...@@ -961,10 +968,15 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
{ {
if(scm_is_true(lpath)) if(scm_is_true(lpath))
{ {
s = SCM_CAR(lpath);
paths = SCM_CDR(gp_gp_cdr(s,s));
spath = SCM_CDR(paths);
gp_store_path = spath; gp_store_path = spath;
gp_paths = paths; gp_paths = paths;
s = SCM_CAR(lpath);
lpath = SCM_CDR(lpath); lpath = SCM_CDR(lpath);
ncons = scm_to_int(SCM_CAR(lpath)); ncons = scm_to_int(SCM_CAR(lpath));
lpath = SCM_CDR(lpath); lpath = SCM_CDR(lpath);
......
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