assoc state enabled for engines

parent 81376539
...@@ -146,6 +146,7 @@ ...@@ -146,6 +146,7 @@
gp-push-engine gp-push-engine
gp-peek-engine gp-peek-engine
gp-combine-engines gp-combine-engines
gp-combine-state
gp-current-engine-path gp-current-engine-path
)) ))
......
...@@ -12,10 +12,11 @@ ...@@ -12,10 +12,11 @@
(<with-cc> (lambda (s p) (cc-internal s p)) (<with-cc> (lambda (s p) (cc-internal s p))
code ...))) code ...)))
(<define-guile-log-rule> (<pand> (v engine code ...) ...) (<define-guile-log-rule> (<pand> (v se engine code ...) ...)
(<var> (v ...) (<var> (v ...)
(<let> ((data (list v ...)) (<let> ((data (list v ...))
(frame (<newframe>)) (frame (<newframe>))
(se #f) ...
(p P) (p P)
(cc CC)) (cc CC))
(<code> (gp-combine-engines data)) (<code> (gp-combine-engines data))
...@@ -27,13 +28,14 @@ ...@@ -27,13 +28,14 @@
(<with-s> (gp-push-engine frame engine) (<with-s> (gp-push-engine frame engine)
(<set> v (gp-peek-engine)) (<set> v (gp-peek-engine))
code ... code ...
(<code> (set! se S))
(<code> (gp-pop-engine)))))) (<code> (gp-pop-engine))))))
... ...
(<with-s> s (<with-s> (gp-combine-state s (list se ...))
(<with-fail> p <cc>)))))) (<with-fail> p <cc>))))))
(<define-guile-log-rule> (<pzip> (v p code ...) ...) (<define-guile-log-rule> (<pzip> (v p se code ...) ...)
(<var> (p ...) (<var> (p ...)
(<let*> ((l '()) (<let*> ((l '())
(pwork (pwork
...@@ -50,7 +52,7 @@ ...@@ -50,7 +52,7 @@
(lambda () (lambda ()
(set! l (list (<lookup> p) ...)) (set! l (list (<lookup> p) ...))
(pwork #f)))) (pwork #f))))
(<pand> (v (gp-make-engine 100) code ... (<set> p P)) ...) (<pand> (v se (gp-make-engine 100) code ... (<set> p P)) ...)
(ccwork) (ccwork)
(<with-fail> pend <cc>)))) (<with-fail> pend <cc>))))
...@@ -61,10 +63,10 @@ ...@@ -61,10 +63,10 @@
(<or> (<=> x i) (lp (+ i 1)))))) (<or> (<=> x i) (lp (+ i 1))))))
(<define> (test1 x y) (<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) (<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) ...@@ -125,7 +125,7 @@ inline void gp_gc_inc(struct gp_stack *gp)
(Ns > Nf ? Ns : Nf)) : (Ns > Nf ? Ns : Nf)) :
((Nc > N) ? (Ns > Nc ? Ns : Nc) : (Ns > N ? Ns : N)); ((Nc > N) ? (Ns > Nc ? Ns : Nc) : (Ns > N ? Ns : N));
if(N < 10000) return; if(N < 20000) return;
gp_gc_counter++; gp_gc_counter++;
if (n > 1000) if (n > 1000)
......
...@@ -1619,6 +1619,42 @@ SCM_DEFINE(gp_combine_engines, "gp-combine-engines", 1, 0, 0, (SCM l), ...@@ -1619,6 +1619,42 @@ SCM_DEFINE(gp_combine_engines, "gp-combine-engines", 1, 0, 0, (SCM l),
} }
#undef FUNC_NAME #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, (), 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") "marks a variable as permanent and hence will be removed from stacks")
#define FUNC_NAME s_gp_get_current_engine_path #define FUNC_NAME s_gp_get_current_engine_path
......
...@@ -165,6 +165,7 @@ SCM_API SCM gp_push_engine(SCM s, SCM engine); ...@@ -165,6 +165,7 @@ SCM_API SCM gp_push_engine(SCM s, SCM engine);
SCM_API SCM gp_pop_engine(); SCM_API SCM gp_pop_engine();
SCM_API SCM gp_peek_engine(); SCM_API SCM gp_peek_engine();
SCM_API SCM gp_combine_engines(SCM l); 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_get_current_engine_path();
SCM_API SCM gp_set_struct(SCM a, SCM b); SCM_API SCM gp_set_struct(SCM a, SCM b);
SCM_API SCM gp_make_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