assoc state enabled for engines

parent 81376539
......@@ -146,6 +146,7 @@
gp-push-engine
gp-peek-engine
gp-combine-engines
gp-combine-state
gp-current-engine-path
))
......
......@@ -12,10 +12,11 @@
(<with-cc> (lambda (s p) (cc-internal s p))
code ...)))
(<define-guile-log-rule> (<pand> (v engine code ...) ...)
(<define-guile-log-rule> (<pand> (v se engine code ...) ...)
(<var> (v ...)
(<let> ((data (list v ...))
(frame (<newframe>))
(se #f) ...
(p P)
(cc CC))
(<code> (gp-combine-engines data))
......@@ -27,13 +28,14 @@
(<with-s> (gp-push-engine frame engine)
(<set> v (gp-peek-engine))
code ...
(<code> (set! se S))
(<code> (gp-pop-engine))))))
...
(<with-s> s
(<with-s> (gp-combine-state s (list se ...))
(<with-fail> p <cc>))))))
(<define-guile-log-rule> (<pzip> (v p code ...) ...)
(<define-guile-log-rule> (<pzip> (v p se code ...) ...)
(<var> (p ...)
(<let*> ((l '())
(pwork
......@@ -50,7 +52,7 @@
(lambda ()
(set! l (list (<lookup> p) ...))
(pwork #f))))
(<pand> (v (gp-make-engine 100) code ... (<set> p P)) ...)
(<pand> (v se (gp-make-engine 100) code ... (<set> p P)) ...)
(ccwork)
(<with-fail> pend <cc>))))
......@@ -61,10 +63,10 @@
(<or> (<=> x i) (lp (+ i 1))))))
(<define> (test1 x y)
(<pzip> (v1 p1 (f x 3)) (v2 p2 (f y 3))))
(<pzip> (v1 p1 s1 (f x 3)) (v2 p2 s2 (f y 3))))
(<define> (test2 x y)
(<pzip> (v1 p1 (<member> 1 x)) (v2 p2 (<member> 2 y))))
(<pzip> (v1 p1 s1 (<member> 1 x)) (v2 p2 s2 (<member> 2 y))))
......@@ -125,7 +125,7 @@ inline void gp_gc_inc(struct gp_stack *gp)
(Ns > Nf ? Ns : Nf)) :
((Nc > N) ? (Ns > Nc ? Ns : Nc) : (Ns > N ? Ns : N));
if(N < 10000) return;
if(N < 20000) return;
gp_gc_counter++;
if (n > 1000)
......
......@@ -1619,6 +1619,42 @@ SCM_DEFINE(gp_combine_engines, "gp-combine-engines", 1, 0, 0, (SCM l),
}
#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
{
SCM data = gp_gp_cdr(s,s);
SCM l0 = SCM_CAR(data);
SCM ll = SCM_EOL;
while(SCM_CONSP(l))
{
SCM sx = SCM_CAR(l);
SCM e = SCM_CAR(gp_gp_cdr(sx,sx));
if(!scm_is_eq(e,l0))
{
ll = scm_cons(e, ll);
l = SCM_CDR(l);
}
}
SCM sout;
if(SCM_CONSP(ll))
{
ll = scm_reverse(ll);
SCM vec = scm_c_make_vector (1,ll);
sout = scm_cons(gp_car(s,s),scm_cons(scm_cons(vec,l0), SCM_CDR(data)));
}
else
sout = s;
return sout;
}
#undef FUNC_NAME
SCM_DEFINE(gp_get_current_engine_path, "gp-current-engine-path", 0, 0, 0, (),
"marks a variable as permanent and hence will be removed from stacks")
#define FUNC_NAME s_gp_get_current_engine_path
......
......@@ -165,6 +165,7 @@ SCM_API SCM gp_push_engine(SCM s, SCM engine);
SCM_API SCM gp_pop_engine();
SCM_API SCM gp_peek_engine();
SCM_API SCM gp_combine_engines(SCM l);
SCM_API SCM gp_combine_state(SCM s, SCM l);
SCM_API SCM gp_get_current_engine_path();
SCM_API SCM gp_set_struct(SCM a, SCM b);
SCM_API SCM gp_make_struct(SCM a, SCM b);
......
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