restore / store works acceptable for paralell and pzip

parent 46ed87f3
...@@ -134,6 +134,7 @@ PSSOURCES = \ ...@@ -134,6 +134,7 @@ PSSOURCES = \
logic/guile-log/guile-prolog/vm/vm-unify.scm \ logic/guile-log/guile-prolog/vm/vm-unify.scm \
logic/guile-log/guile-prolog/vm/vm-goal.scm \ logic/guile-log/guile-prolog/vm/vm-goal.scm \
logic/guile-log/guile-prolog/vm-compiler.scm \ logic/guile-log/guile-prolog/vm-compiler.scm \
logic/guile-log/guile-prolog/paralell.scm \
logic/guile-log/examples/kanren/type-inference.scm \ logic/guile-log/examples/kanren/type-inference.scm \
logic/guile-log/imatch.scm \ logic/guile-log/imatch.scm \
language/prolog/install.scm \ language/prolog/install.scm \
......
...@@ -114,6 +114,7 @@ ...@@ -114,6 +114,7 @@
(<code> (<code>
(usr-set! 'stall-ret '()) (usr-set! 'stall-ret '())
(fluid-set! *usr-state* S) (fluid-set! *usr-state* S)
(fluid-set! (@ (logic guile-log umatch) *current-stack*) S)
(set! lold (<state-ref>))) (set! lold (<state-ref>)))
(<stall>)) (<stall>))
...@@ -127,6 +128,7 @@ ...@@ -127,6 +128,7 @@
(add_env (car n.x) (cdr n.x)) (add_env (car n.x) (cdr n.x))
(<code> (<code>
(fluid-set! *usr-state* S) (fluid-set! *usr-state* S)
(fluid-set! (@ (logic guile-log umatch) *current-stack*) S)
(set! lold (<state-ref>))) (set! lold (<state-ref>)))
(<stall>))))) (<stall>)))))
...@@ -287,19 +289,29 @@ ...@@ -287,19 +289,29 @@
((@ (guile) if) #f #f))) ((@ (guile) if) #f #f)))
(load (load
`((@ (guile) begin) `((@ (guile) let*)
((@ (logic guile-log) <state-set!>) ((x
((@ (guile) hash-ref) (@@ (logic guile-log guile-prolog interpreter) ((@ (guile) hash-ref)
*states*) (@@ (logic guile-log guile-prolog interpreter)
',load)) *states*)
((@ (guile) if) #f #f))) ',load))
(state ((@ (guile) car) x))
(s ((@ (guile) cdr) x)))
((@ (logic guile-log) <state-set!>) state)
((@ (guile) fluid-set!)
(@ (logic guile-log umatch) *current-stack*)
s)
((@ (guile) if) #f #f)))
(save (save
`((@ (guile) begin) `((@ (guile) begin)
((@ (guile) hash-set!) ((@ (guile) hash-set!)
(@@ (logic guile-log guile-prolog interpreter) *states*) (@@ (logic guile-log guile-prolog interpreter) *states*)
',save ',save
((@ (logic guile-log) <state-ref>))) ((@ (guile) cons)
((@ (logic guile-log) <state-ref>))
((@ (guile) fluid-ref)
(@@ (logic guile-log guile-prolog interpreter) *usr-state*))))
((@ (guile) if) #f #f))) ((@ (guile) if) #f #f)))
(cont (cont
......
(define-module (logic guile-log guile-prolog paralell)
#:use-module (logic guile-log)
#:use-module (logic guile-log prolog goal-functors)
#:use-module (logic guile-log umatch)
#:use-module (logic guile-log paralell)
#:export (paralell pzip))
(define paralell
(<case-lambda>
(() <fail>)
((x) (goal-eval x))
((x y)
(<pand>
(p1 s1 (gp-make-engine 100) (goal-eval x))
(p2 s2 (gp-make-engine 100) (goal-eval y))))
((x y u)
(<pand>
(p1 s1 (gp-make-engine 100) (goal-eval x))
(p2 s2 (gp-make-engine 100) (goal-eval y))
(p3 s3 (gp-make-engine 100) (goal-eval u))))
((x y u v)
(<pand>
(p1 s1 (gp-make-engine 100) (goal-eval x))
(p2 s2 (gp-make-engine 100) (goal-eval y))
(p3 s3 (gp-make-engine 100) (goal-eval u))
(p4 s4 (gp-make-engine 100) (goal-eval v))))
(l
(let ((l-u (let lp ((l l) (u '()) (n (/ (length l) 2)))
(if (= n 0)
(cons l u)
(lp (cdr l) (cons (car l) u) (- n 1))))))
(<pand>
(p1 s1 (gp-make-engine 100) (<apply> paralell (car l-u)))
(p3 s3 (gp-make-engine 100) (<apply> paralell (cdr l-u))))))))
(define pzip
(<case-lambda>
(() <fail>)
((x) (goal-eval x))
((x y)
(<pzip>
(p1 s1 q1 (goal-eval x))
(p2 s2 q2 (goal-eval y))))
((x y u)
(<pzip>
(p1 s1 q1 (goal-eval x))
(p2 s2 q2 (goal-eval y))
(p3 s3 q3 (goal-eval u))))
((x y u v)
(<pzip>
(p1 s1 q1 (goal-eval x))
(p2 s2 q2 (goal-eval y))
(p3 s3 q3 (goal-eval u))
(p4 s4 q4 (goal-eval v))))
(l
(let ((l-u (let lp ((l l) (u '()) (n (/ (length l) 2)))
(if (= n 0)
(cons l u)
(lp (cdr l) (cons (car l) u) (- n 1))))))
(<pzip>
(p2 s2 q2 (<apply> pzip (car l-u)))
(p3 s3 q3 (<apply> pzip (cdr l-u))))))))
...@@ -257,7 +257,7 @@ ...@@ -257,7 +257,7 @@
#{\\=}# #{\\==}# @< @> @>= @=< is op2: #{\\=}# #{\\==}# @< @> @>= @=< is op2:
op2+ op2- op1+ op1- #{\\}# op2* op2/ // rem mod div op2+ op2- op1+ op1- #{\\}# op2* op2/ // rem mod div
** << >> #{/\\}# #{\\/}# op2< op2> op2>= op2=< =:= #{=\\=}# ** << >> #{/\\}# #{\\/}# op2< op2> op2>= op2=< =:= #{=\\=}#
#{;}# #{;;}# --> ? $ ?- #{;}# #{;;}# --> ? $ ?- ← → =>
eval_when eval_when
*prolog-ops* *prolog-ops*
......
(define-module (logic guile-log paralell) (define-module (logic guile-log paralell)
#:use-module (logic guile-log) #:use-module (logic guile-log)
#:use-module (logic guile-log code-load) #:use-module (logic guile-log code-load)
#:use-module (logic guile-log dynamic-features)
#:use-module (logic guile-log umatch) #:use-module (logic guile-log umatch)
#:export (<pand> <pzip> f test1 test2 test3 test4)) #:export (<pand> <pzip> f test1 test2 test3 test4))
...@@ -13,6 +14,8 @@ ...@@ -13,6 +14,8 @@
(<with-cc> (lambda (s p) (cc-internal s p)) (<with-cc> (lambda (s p) (cc-internal s p))
code ...))) code ...)))
(define *cc* (@@ (logic guile-log run) *cc*))
(<define-guile-log-rule> (<pand> (v se engine code ...) ...) (<define-guile-log-rule> (<pand> (v se engine code ...) ...)
(<var> (v ...) (<var> (v ...)
(<let> ((data (list v ...)) (<let> ((data (list v ...))
...@@ -31,6 +34,7 @@ ...@@ -31,6 +34,7 @@
(<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))
(state-guard-dynamic-object *cc*)
(<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))
......
...@@ -54,7 +54,7 @@ ...@@ -54,7 +54,7 @@
#{\\=}# #{\\==}# #{\\=@=}# @< @> @>= @=< is op2<= #{\\=}# #{\\==}# #{\\=@=}# @< @> @>= @=< is op2<=
op2+ op2- op1- op1+ #{\\}# op2* op2/ // rem mod div op2+ op2- op1- op1+ #{\\}# op2* op2/ // rem mod div
** << >> #{/\\}# #{\\/}# op2< op2> op2>= op2=< =:= #{=\\=}# ** << >> #{/\\}# #{\\/}# op2< op2> op2>= op2=< =:= #{=\\=}#
=.. --> ? $ ?- =.. --> ? $ ?- =>
gop2+ gop2- gop1+ gop1- gop2+ gop2- gop1+ gop1-
#{g\\}# gop2* gop2/ g// gop2rem gop2mod #{g\\}# gop2* gop2/ g// gop2rem gop2mod
...@@ -536,7 +536,24 @@ We could make all variable references through a stack frame e.g. ...@@ -536,7 +536,24 @@ We could make all variable references through a stack frame e.g.
(<values> x (goal-eval goal)) (<values> x (goal-eval goal))
(<=> x data))))) (<=> x data)))))
(<define> (<=>> data goal)
(<<match>> (#:mode -) (data)
(#((f . l))
(<and>
(<values> x (let ((cc CC))
(<and>
(<=> f ,(mk-lam cc))
(goal-eval goal))))
(<=> x l)))
(_
(<and>
(<values> x (goal-eval goal))
(<=> x data)))))
(mk-prolog-biop 'xfx "<=" <=-tr op2<= <<=> a a) (mk-prolog-biop 'xfx "<=" <=-tr op2<= <<=> a a)
(mk-prolog-biop 'xfx "←" -tr <<=> a a)
(mk-prolog-biop 'xfx "=>" =>-tr op2=> <=>> a a)
(mk-prolog-biop 'xfx "←" -tr <=>> a a)
(define-syntax-rule (shr x y) (ash x (- y))) (define-syntax-rule (shr x y) (ash x (- y)))
(mk-scheme-dual 'yfx "|" tr-| | consx s s) (mk-scheme-dual 'yfx "|" tr-| | consx s s)
......
...@@ -201,7 +201,8 @@ ...@@ -201,7 +201,8 @@
(fy 900 "\\+") (fy 900 "\\+")
,@(map (lambda (x) `(xfx 700 ,x)) ,@(map (lambda (x) `(xfx 700 ,x))
'(<= '(<=
< = =.. =@= =:= =< == "=\\=" > >= @< @=< @> @>= "\\=" "\\==" is < = =.. =@= =:= =< == <= =>
"=\\=" > >= @< @=< @> @>= "\\=" "\\==" is
)) ))
(xfy 400 :) (xfy 400 :)
,@(map (lambda (x) `(yfx 500 ,x)) '(+ - "/\\" "\\/" xor)) ,@(map (lambda (x) `(yfx 500 ,x)) '(+ - "/\\" "\\/" xor))
...@@ -233,7 +234,7 @@ ...@@ -233,7 +234,7 @@
(xfx 990 ":=") (xfx 990 ":=")
(fy 900 "\\+") (fy 900 "\\+")
,@(map (lambda (x) `(xfx 700 ,x)) ,@(map (lambda (x) `(xfx 700 ,x))
'(< = =.. =@= "\\=@=" <= '(< = =.. =@= "\\=@=" <= =>
=:= =< == "=\\=" > >= @< @=< @> @>= "\\=" "\\==" as is =:= =< == "=\\=" > >= @< @=< @> @>= "\\=" "\\==" as is
)) ))
(xfy 600 :) (xfy 600 :)
......
...@@ -1561,8 +1561,10 @@ SCM_DEFINE(gp_pop_engine, "gp-pop-engine", 0, 0, 0, (), ...@@ -1561,8 +1561,10 @@ SCM_DEFINE(gp_pop_engine, "gp-pop-engine", 0, 0, 0, (),
("gp-pop-engine","gp_engine_path not a nonempty list", SCM_EOL); ("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 e = SCM_CDR(SCM_CAR(gp_engine_path));
scm_fluid_set_x(gp_current_stack, e);
if(!SCM_CONSP(gp_engine_path)) if(!SCM_CONSP(gp_engine_path))
scm_misc_error("gp-pop-engine","poped to an empty list",SCM_EOL); scm_misc_error("gp-pop-engine","poped to an empty list",SCM_EOL);
......
...@@ -901,6 +901,7 @@ void vector_state(int state, SCM *old, SCM l, SCM vec) ...@@ -901,6 +901,7 @@ void vector_state(int state, SCM *old, SCM l, SCM vec)
SCM olde = scm_fluid_ref(gp_current_stack); SCM olde = scm_fluid_ref(gp_current_stack);
scm_fluid_set_x(gp_current_stack, e); scm_fluid_set_x(gp_current_stack, e);
gp_newframe(s);
SCM r = scm_cons(gp_store_state(get_gp()), SCM r = scm_cons(gp_store_state(get_gp()),
scm_cons(e , s)); scm_cons(e , s));
scm_fluid_set_x(gp_current_stack, olde); scm_fluid_set_x(gp_current_stack, olde);
...@@ -912,8 +913,8 @@ void vector_state(int state, SCM *old, SCM l, SCM vec) ...@@ -912,8 +913,8 @@ void vector_state(int state, SCM *old, SCM l, SCM vec)
scm_list_1(x)); scm_list_1(x));
} }
scm_c_vector_set_x(xx,0 ,vec); scm_c_vector_set_x(xx, 0, vec);
scm_c_vector_set_x(xx,1 ,u ); scm_c_vector_set_x(xx, 1, u );
SCM val = scm_cons(xx,SCM_EOL); SCM val = scm_cons(xx,SCM_EOL);
if(SCM_CONSP(*old)) if(SCM_CONSP(*old))
SCM_SETCDR(*old,val); SCM_SETCDR(*old,val);
...@@ -954,6 +955,8 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci, ...@@ -954,6 +955,8 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
void unwind_in_new_branch(SCM p, SCM l, SCM path, SCM lpath) void unwind_in_new_branch(SCM p, SCM l, SCM path, SCM lpath)
{ {
SCM engine = SCM_CDR(p); SCM engine = SCM_CDR(p);
//printf("in new engine unwind: e = %p\n", (void *) SCM_UNPACK(engine));
scm_fluid_set_x(gp_current_stack, engine); scm_fluid_set_x(gp_current_stack, engine);
...@@ -991,33 +994,60 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci, ...@@ -991,33 +994,60 @@ static inline void gp_unwind_(SCM s , int ncons, int nvar, int nci,
path = gp_engine_path; path = gp_engine_path;
if(SCM_CONSP(path)) if(SCM_CONSP(path))
{ {
SCM l = gp_engine_path; SCM l = gp_engine_path;
SCM b = SCM_EOL;
int na = scm_to_int(scm_length(l));
int nb = scm_to_int(scm_length(path));
while(na > nb)
{
if(SCM_CONSP(gp_store_path))
{
SCM ls = SCM_CAR(gp_store_path);
unwind_all_in_branch(ls);
gp_store_path = SCM_CDR(gp_store_path);
l = SCM_CDR(l);
na--;
}
else
scm_misc_error("gp-unwind","gp_store_path of wrong length",
SCM_EOL);
}
SCM a = scm_reverse(l); SCM a = scm_reverse(l);
SCM b = scm_reverse(path);
SCM aa = a; while(nb > na)
while(SCM_CONSP(a) && SCM_CONSP(b) && scm_is_eq(SCM_CAR(a),SCM_CAR(b)))
{ {
aa = a; b = scm_cons(SCM_CAR(path), b);
a = SCM_CDR(a); path = SCM_CDR(path);
b = SCM_CDR(b); nb--;
} }
SCM a0 = SCM_CAR(aa); while(SCM_CONSP(l) && !scm_is_eq(SCM_CAR(l), SCM_CAR(path)))
while(SCM_CONSP(l) && !scm_is_eq(SCM_CAR(l), a0))
{ {
SCM engine = SCM_CDAR(l); if(SCM_CONSP(gp_store_path))
gp_clear(SCM_BOOL_F); {
scm_fluid_set_x(gp_current_stack, engine); SCM ls = SCM_CAR(gp_store_path);
gp_engine_path = SCM_CDR(gp_engine_path); unwind_all_in_branch(ls);
l = SCM_CDR(l); gp_store_path = SCM_CDR(gp_store_path);
l = SCM_CDR(l);
na--;
}
else
scm_misc_error("gp-unwind","gp_store_path of wrong length",
SCM_EOL);
b = scm_cons(SCM_CAR(path), b);
path = SCM_CDR(path);
} }
gp_engine_path = l;
scm_fluid_set_x(gp_current_stack, SCM_CDAR(l)); scm_fluid_set_x(gp_current_stack, SCM_CDAR(l));
path = b; path = b;
} }
} }
if(SCM_CONSP(path)) if(SCM_CONSP(path))
...@@ -1462,25 +1492,20 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s), ...@@ -1462,25 +1492,20 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
SCM k = gp_engine_path; SCM k = gp_engine_path;
int first = 1; int first = 1;
printf("1\n");
while(SCM_CONSP(lpath)) for(;SCM_CONSP(lpath); lpath=SCM_CDR(lpath))
{ {
SCM l = SCM_CAR(lpath); SCM l = SCM_CAR(lpath);
SCM ll = SCM_EOL; SCM ll = SCM_EOL;
SCM tag = SCM_CAR(k); SCM tag = SCM_CAR(k);
printf("a lpath\n");
k = SCM_CDR(k); k = SCM_CDR(k);
while(SCM_CONSP(l)) for(;SCM_CONSP(l);l = SCM_CDR(l))
{ {
SCM x = SCM_CAR(l); SCM x = SCM_CAR(l);
printf("a state in lpath\n");
if(GP(x) && GP_UNBOUND(GP_GETREF(x))) if(GP(x) && GP_UNBOUND(GP_GETREF(x)))
ll = scm_cons(SCM_BOOL_F, ll); ll = scm_cons(SCM_BOOL_F, ll);
else else
...@@ -1498,6 +1523,7 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s), ...@@ -1498,6 +1523,7 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
SCM s = SCM_CAR(xx); SCM s = SCM_CAR(xx);
SCM olde = scm_fluid_ref(gp_current_stack); SCM olde = scm_fluid_ref(gp_current_stack);
scm_fluid_set_x(gp_current_stack, e); scm_fluid_set_x(gp_current_stack, e);
gp_newframe(s);
SCM r = scm_cons(gp_store_state(get_gp()), SCM r = scm_cons(gp_store_state(get_gp()),
scm_cons(e , s)); scm_cons(e , s));
scm_fluid_set_x(gp_current_stack, olde); scm_fluid_set_x(gp_current_stack, olde);
...@@ -1511,6 +1537,7 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s), ...@@ -1511,6 +1537,7 @@ SCM_DEFINE(gp_gp_store_state, "gp-store-state", 1, 0, 0, (SCM s),
} }
gp_do_gc(); gp_do_gc();
return scm_cons(gp_paths, return scm_cons(gp_paths,
scm_cons(ret, llpath)); scm_cons(ret, llpath));
...@@ -1720,26 +1747,24 @@ static int gp_rewind(SCM pp, SCM pend, struct gp_stack *gp, SCM K) ...@@ -1720,26 +1747,24 @@ static int gp_rewind(SCM pp, SCM pend, struct gp_stack *gp, SCM K)
gp->gp_ci[0] = scm_c_vector_ref(q,0); gp->gp_ci[0] = scm_c_vector_ref(q,0);
gp->gp_ci ++; gp->gp_ci ++;
sp--; sp--;
printf("1\n");
SCM l = scm_c_vector_ref(q,1); SCM l = scm_c_vector_ref(q,1);
for(;SCM_CONSP(l);l = SCM_CDR(l)) for(;SCM_CONSP(l);l = SCM_CDR(l))
{ {
printf("11\n");
SCM dcont = SCM_CAR(l); SCM dcont = SCM_CAR(l);
if(scm_is_false(dcont)) if(scm_is_false(dcont))
continue; continue;
SCM olde = scm_fluid_ref(gp_current_stack); SCM olde = scm_fluid_ref(gp_current_stack);
printf("*\n");
scm_fluid_set_x(gp_current_stack, SCM_CADR(dcont)); scm_fluid_set_x(gp_current_stack, SCM_CADR(dcont));
struct gp_stack *gp2 = get_gp(); struct gp_stack *gp2 = get_gp();
gp_restore_state(SCM_CAR(dcont), gp2, K); gp_restore_state(SCM_CAR(dcont), gp2, K);
scm_fluid_set_x(gp_current_stack, olde); scm_fluid_set_x(gp_current_stack, olde);
} }
printf("2\n");
} }
scm_misc_error("restore-state/ci rewinding", else
"Got unhandle object ci -> ~%~a", scm_misc_error("restore-state/ci rewinding",
scm_list_1(q)); "Got unhandle object ci -> ~%~a",
scm_list_1(q));
} }
gp_debug1("finish> ci = %p\n", gp->gp_ci - gp->gp_cstack); gp_debug1("finish> ci = %p\n", gp->gp_ci - gp->gp_cstack);
gp_debug0("leaving a rewind frame\n"); gp_debug0("leaving a rewind frame\n");
...@@ -2142,8 +2167,6 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K), ...@@ -2142,8 +2167,6 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
{ {
gp_no_gc(); gp_no_gc();
printf("restore 1\n");fflush(stdout);
// Unpack level 1 // Unpack level 1
SCM paths = SCM_CAR(cont); SCM paths = SCM_CAR(cont);
SCM pathsl = SCM_CDR(cont); SCM pathsl = SCM_CDR(cont);
...@@ -2151,9 +2174,10 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K), ...@@ -2151,9 +2174,10 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
SCM epath = SCM_CAR(paths); SCM epath = SCM_CAR(paths);
SCM lpath = SCM_CDR(pathsl); SCM lpath = SCM_CDR(pathsl);
cont = SCM_CAR(pathsl); cont = SCM_CAR(pathsl);
printf("restore 2\n");fflush(stdout);
//First we clear the head of the states //First we clear the head of the states
/*
int ncur = scm_to_int(scm_length(gp_engine_path)); int ncur = scm_to_int(scm_length(gp_engine_path));
int nnew = scm_to_int(scm_length(epath)); int nnew = scm_to_int(scm_length(epath));
printf("restore 3 %d %d\n",ncur,nnew);fflush(stdout); printf("restore 3 %d %d\n",ncur,nnew);fflush(stdout);
...@@ -2200,19 +2224,20 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K), ...@@ -2200,19 +2224,20 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
printf("restore 6 %d %d\n", ncur, scm_to_int(scm_length(lpath))); printf("restore 6 %d %d\n", ncur, scm_to_int(scm_length(lpath)));
fflush(stdout); fflush(stdout);
*/
printf("restore 7\n");fflush(stdout);
for(;SCM_CONSP(lpath); lpath = SCM_CDR(lpath))
while(SCM_CONSP(lpath))
{ {
SCM ll = SCM_CAR(lpath); SCM ll = SCM_CAR(lpath);
while(SCM_CONSP(ll)) for(;SCM_CONSP(ll); ll = SCM_CDR(ll))
{ {
SCM dcont = SCM_CAR(ll); SCM dcont = SCM_CAR(ll);
if(scm_is_false(dcont)) if(scm_is_false(dcont))
continue; continue;
if(scm_is_eq(dcont, cont))
if(scm_is_eq(dcont, cont))
continue; continue;
else else
{ {
...@@ -2221,26 +2246,19 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K), ...@@ -2221,26 +2246,19 @@ SCM_DEFINE(gp_gp_restore_state, "gp-restore-state", 2, 0, 0, (SCM cont, SCM K),
gp_restore_state(SCM_CAR(dcont), gp, K); gp_restore_state(SCM_CAR(dcont), gp, K);
} }
} }
lpath = SCM_CDR(lpath);
} }
{ {
scm_fluid_set_x(gp_current_stack, SCM_CADR(cont)); scm_fluid_set_x(gp_current_stack, SCM_CADR(cont));
struct gp_stack *gp = get_gp(); struct gp_stack *gp2 = get_gp();
gp_restore_state(SCM_CAR(cont), gp, K); gp_restore_state(SCM_CAR(cont), gp2, K);
} }
printf("restore 8\n");fflush(stdout);
gp_engine_path = epath; gp_engine_path = epath;
gp_store_path = spath; gp_store_path = spath;
gp_paths = paths; gp_paths = paths;
gp_do_gc(); gp_do_gc();
printf("restore 9\n");fflush(stdout);
return SCM_UNSPECIFIED; return SCM_UNSPECIFIED;
} }
......
...@@ -1268,7 +1268,7 @@ static inline SCM gp_newframe(SCM s) ...@@ -1268,7 +1268,7 @@ static inline SCM gp_newframe(SCM s)
} }
if(scm_is_eq(l, SCM_UNBOUND)) if(scm_is_eq(l, SCM_UNBOUND))
l = SCM_EOL; l = scm_cons(SCM_EOL, gp_paths);
{ {
SCM ret; SCM ret;
...@@ -1331,7 +1331,7 @@ static inline SCM gp_newframe_choice(SCM s) ...@@ -1331,7 +1331,7 @@ static inline SCM gp_newframe_choice(SCM s)
} }
if(scm_is_eq(l, SCM_UNBOUND)) if(scm_is_eq(l, SCM_UNBOUND))
l = scm_cons(SCM_EOL,gp_engine_path); l = scm_cons(SCM_EOL,gp_paths);
{ {
SCM ret; SCM ret;
......
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