bugfix

parent 0274f39f
......@@ -14,6 +14,7 @@
(compile-prolog-string
"
%k(A,B,C) :- write(k(A,B,C)),nl,fail.
k(V,L,LL) :- (var(V),!) -> (attvar(V) -> L=[V|LL] ; L=LL).
k([A|B],L,LL) :- !,k(A,L,LX),k(B,LX,LL).
k([],L,L).
......
......@@ -150,7 +150,7 @@
(<define> (gen x) (<=> x ,(cons vartag (gensym "id"))))
(<define> (var_p x)
(let ((x (<lookup> x)))
(<if> (var CUT x)
(<if> (var CUT SCUT x)
(gen x)
(if (and (pair? x) (eq? (car x) vartag))
<cc>))))
......
......@@ -351,22 +351,22 @@
#,(case (length fvars)
((0)
#`(let ((co #,(rep comp)))
(lambda (s p cc cut x)
(lambda (s p cc cut scut x)
(wrap (cut s p cc) x co
(#,lam cut)))))
(#,lam cut scut)))))
((1)
#`(let ((co #,(rep comp)))
(lambda (s p cc cut x)
(lambda (s p cc cut scut x)
(wrap (cut s p cc) x co
(<let*> ((f (car external-vars))
(v (fluid-ref f)))
(<code> (fluid-set! f #f))
(#,lam cut v))))))
(#,lam cut scut v))))))
((2)
#`(let ((co #,(rep comp)))
(lambda (s p cc cut x)
(lambda (s p cc cut scut x)
(wrap (cut s p cc) x co
(<let*> ((f1 (car external-vars))
(v1 (fluid-ref f1))
......@@ -375,17 +375,17 @@
(<code>
(fluid-set! f1 #f)
(fluid-set! f2 #f))
(#,lam cut v1 v2))))))
(#,lam cut scut v1 v2))))))
(else
#`(let ((co #,(rep comp)))
(lambda (s p cc cut x)
(lambda (s p cc cut scut x)
(wrap (cut s p cc) x co
(<let> ((vs (mapi (lambda (x) (fluid-ref x))
#,(length fvars) external-vars)))
(<code>
(for-eachi (lambda (x) (fluid-set! x #f))
#,(length fvars) external-vars))
(<apply> #,lam cut vs))))))))
(<apply> #,lam cut scut vs))))))))
(cadr o)))
(list
......@@ -394,22 +394,22 @@
(case (length fvars)
((0)
(let ((co comp))
(lambda (s p cc cut x)
(lambda (s p cc cut scut x)
(wrap (cut s p cc) x co
(lam cut)))))
(lam cut scut)))))
((1)
(let ((co comp))
(lambda (s p cc cut x)
(lambda (s p cc cut scut x)
(wrap (cut s p cc) x co
(<let*> ((f (car fvars))
(v (fluid-ref f)))
(<code> (fluid-set! f #f))
(lam cut v))))))
(lam cut scut v))))))
((2)
(let ((co comp))
(lambda (s p cc cut x)
(lambda (s p cc cut scut x)
(wrap (cut s p cc) x co
(<let*> ((f1 (car fvars))
(v1 (fluid-ref f1))
......@@ -417,15 +417,15 @@
(v2 (fluid-ref f2)))
(<code> (fluid-set! f1 #f)
(fluid-set! f2 #f))
(lam cut v1 v2))))))
(lam cut scut v1 v2))))))
(else
(let ((co comp))
(lambda (s p cc cut x)
(lambda (s p cc cut scut x)
(wrap (cut s p cc) x co
(<let> ((vs (map (lambda (x) (fluid-ref x)) fvars)))
(<code> (for-each (lambda (x) (fluid-set! x #f)) fvars))
(<apply> lam cut vs))))))))
(<apply> lam cut scut vs))))))))
(cadr oth)))))
......
......@@ -665,8 +665,8 @@
(,(G let) ,(map (lambda (w v) (list w v))
(append vars ovars)
(append varq ovarq))
((@ (logic guile-log) <lambda> ) (cut ,@aa)
((@ (logic guile-log) <with-cut>) cut SCUT
((@ (logic guile-log) <lambda> ) (cut scut ,@aa)
((@ (logic guile-log) <with-cut>) cut scut
(,(GL <var>) ,vars ,ff)))))))
((and (pair? extention?))
......
......@@ -453,8 +453,7 @@ void gp_clean_pairs(struct gp_stack *gp)
ptu = gp->gp_cstack + GP_GET_VAL_VAL(pfr);
if(!SCM_CONSP(*ptu) && !scm_is_eq(*ptu,GP_GET_VAL(pfr)))
scm_misc_error("state","ci self entry is not the same~%~a",
scm_list_1(*ptu));
continue;
while(pt < ptu)
{
......
......@@ -955,7 +955,7 @@ static inline void gp_prune(SCM s, int tailp)
ci = gp->gp_ci;
}
if(si == gp->gp_si && vp && tailp)
if(0 && si == gp->gp_si && vp && tailp)
{
si-=2;
}
......@@ -964,7 +964,7 @@ static inline void gp_prune(SCM s, int tailp)
si = gp->gp_si;
}
if(cs == gp->gp_cs && tailp)
if(0 && cs == gp->gp_cs && tailp)
{
cs -= 2;
}
......
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