simple prolog program executes

parent 898867d1
......@@ -31,7 +31,7 @@ PSSOURCES = \
logic/guile-log/match.scm \
logic/guile-log/undovar.scm \
logic/guile-log/interleave.scm \
logic/guile-log/soft-cut.scm \
logic/guile-log/soft-cut.scm \
logic/guile-log/run.scm \
logic/guile-log/tools.scm \
logic/guile-log/prompts.scm \
......@@ -130,14 +130,14 @@ PSSOURCES = \
logic/guile-log/guile-prolog/vm-compiler.scm \
logic/guile-log/examples/kanren/type-inference.scm \
logic/guile-log/imatch.scm \
prolog-user.scm
# language/prolog/install.scm \
# language/prolog/spec.scm \
# language/prolog/modules/user.scm \
# language/prolog/modules/sandbox.pl \
# language/prolog/modules/boot/expand.pl \
# language/prolog/modules/boot/dcg.pl \
# language/prolog/modules/boot/if.pl \
prolog-user.scm \
language/prolog/install.scm \
language/prolog/spec.scm \
language/prolog/modules/user.scm \
language/prolog/modules/sandbox.pl \
language/prolog/modules/boot/expand.pl \
language/prolog/modules/boot/dcg.pl \
language/prolog/modules/boot/if.pl
# language/prolog/modules/swi/term_macro.pl \
# language/prolog/modules/library/error.pl \
# language/prolog/modules/library/vhash.scm \
......
......@@ -1035,35 +1035,35 @@ add/run * vlist *
(cons (compile-index-raw s (car e))
(compile-index-raw s (cdr e))))
(define (walk-raw s p cut a F walk-dynlist e rev more?)
(define (walk-raw s p cut scut a F walk-dynlist e rev more?)
(let* ((ar (get-ar e))
(db (get-li e)))
(let lp ((l (rev (get-index-set s a db (get-theory e)))))
(if (not (pair? l))
(p)
(if (null? (cdr l))
(F p cut
(F p cut scut
a
(if (vector? ar)
(vector-ref ar (car l))
(vlist-ref (cdr ar) (- (car ar) (car l) 1)))
(and #t (not more?)))
(F (lambda ()
(lp (cdr l))) cut
(lp (cdr l))) cut scut
a
(if (vector? ar)
(vector-ref ar (car l))
(vlist-ref (cdr ar) (- (car ar) (car l) 1)))
#f))))))
(define (walk-raw-ii s p cut a F walk-dynlist e rev more?)
(define (walk-raw-ii s p cut scut a F walk-dynlist e rev more?)
(let* ((ar (get-ar e))
(db (get-li e)))
(let lp ((l (rev (get-index-set s a db (get-theory e)))) (p p))
(if (not (pair? l))
(p)
(if (null? (cdr l))
(F p cut
(F p cut scut
a
(if (vector? ar)
(vector-ref ar (car l))
......@@ -1071,7 +1071,7 @@ add/run * vlist *
(and #t (not more?)))
(or-ii-f s
(lambda (p)
(F p cut
(F p cut scut
a
(if (vector? ar)
(vector-ref ar (car l))
......@@ -1081,20 +1081,20 @@ add/run * vlist *
(lp (cdr l) p))
p))))))
(define (walk-raw-f pre s p cut a F walk-dynlist e rev more?)
(define (walk-raw-f pre s p cut scut a F walk-dynlist e rev more?)
(let* ((ar (get-ar e))
(db (get-li e)))
(let lp ((l (rev (get-index-set s a db (get-theory e)))))
(if (not (pair? l))
(p)
(if (null? (cdr l))
(F p cut
(F p cut scut
(append pre a)
(if (vector? ar)
(vector-ref ar (car l))
(vlist-ref (cdr ar) (- (car ar) (car l) 1)))
(and #t (not more?)))
(F (lambda () (lp (cdr l))) cut
(F (lambda () (lp (cdr l))) cut scut
(append pre a)
(if (vector? ar)
(vector-ref ar (car l))
......@@ -1113,13 +1113,14 @@ add/run * vlist *
(let ((el (car (fluid-ref e)))
(er (cdr (fluid-ref e))))
(if (null? (get-index-set s a (get-li er) (get-theory er)))
(walk-raw s p p a F walk-dynlist-lr el
(walk-raw s p p s a F walk-dynlist-lr el
(lambda (x) x) #f)
(walk-raw s (lambda () (walk-raw s p p a F walk-dynlist-rl er
reverse! #f)) p
a F walk-dynlist-lr el
(lambda (x) x) #t)))))
(walk-raw s (lambda () (walk-raw s p p s a F walk-dynlist-rl er
reverse! #f))
p s
a F walk-dynlist-lr el
(lambda (x) x) #t)))))
(define (walk-lr-ii s p a F)
(walk-lr-ii-e env s p a F))
......@@ -1133,14 +1134,14 @@ add/run * vlist *
(let ((el (car (fluid-ref e)))
(er (cdr (fluid-ref e))))
(if (null? (get-index-set s a (get-li er) (get-theory er))) ;; To avoid gc leak
(walk-raw-ii s p p a F walk-dynlist-lr el
(walk-raw-ii s p p s a F walk-dynlist-lr el
(lambda (x) x) #f)
(walk-raw-ii s
(lambda ()
(walk-raw-ii
s p p a F walk-dynlist-rl er
reverse! #f)) p
s p p s a F walk-dynlist-rl er
reverse! #f)) p s
a F walk-dynlist-lr el
(lambda (x) x) #t)))))
......@@ -1151,15 +1152,17 @@ add/run * vlist *
(let ((el (car e))
(er (cdr e)))
(if (null? (get-index-set s a (get-li er) (get-theory er)))
(walk-raw-f pre s p p a F walk-dynlist-lr el
(walk-raw-f pre s p p s a F walk-dynlist-lr el
(lambda (x) x) #f)
(walk-raw-f pre s
(lambda () (walk-raw-f pre
s p p a F walk-dynlist-rl er
reverse! #f)) p
a F walk-dynlist-lr el
(lambda (x) x) #t))))
s p p s a F
walk-dynlist-rl er
reverse! #f))
p s
a F walk-dynlist-lr el
(lambda (x) x) #t))))
(cond
((eq? raw? 'fkns)
......@@ -1181,31 +1184,31 @@ add/run * vlist *
(let ((fr (gp-newframe-choice s))
(del (fluid-ref delayers)))
(walk-lr s p a
(lambda (p cut a vec last?)
(lambda (p cut scut a vec last?)
(if (not last?)
(let ((p (lambda ()
(gp-unwind fr)
(fluid-set! delayers del)
(p))))
((get-f vec) s p cc cut a))
((get-f vec) s p cc cut scut a))
(begin
(gp-unwind-tail fr)
((get-f vec) s p cc cut a))))))))
((get-f vec) s p cc cut scut a))))))))
(define k
(lambda (s p cc . a)
(let ((fr (gp-newframe-choice s))
(del (fluid-ref delayers)))
(walk-lr-ii s p a
(lambda (p cut a vec last?)
(lambda (p cut scut a vec last?)
(if (not last?)
(let ((p (lambda ()
(gp-unwind fr)
(fluid-set! delayers del)
(p))))
((get-f vec) s p cc cut a))
((get-f vec) s p cc cut scut a))
(begin
(gp-unwind-tail fr)
((get-f vec) s p cc cut a))))))))
((get-f vec) s p cc cut scut a))))))))
(define gg (lambda x (apply g x)))
(define kk (lambda x (apply k x)))
......@@ -1354,7 +1357,7 @@ add/run * vlist *
(let ((fr (gp-newframe s)))
((dynamic-walk-lr f)
s p (gp-cp head s)
(lambda (p cut a vec last?)
(lambda (p cut scut a vec last?)
(let ((p (lambda () (gp-unwind fr) (p))))
((<lambda> ()
(<let> ((c (<cp> (get-c vec))))
......@@ -1368,7 +1371,7 @@ add/run * vlist *
(let ((fr (gp-newframe s)))
((dynamic-walk-lr f)
s p (gp-cp head s)
(lambda (p cut a vec last?)
(lambda (p cut scut a vec last?)
(let ((p (lambda () (gp-unwind fr) (p))))
((<lambda> ()
(<let> ((c (<cp> (get-c vec))))
......@@ -1534,8 +1537,8 @@ add/run * vlist *
(with-syntax ((patt (parse-match #'pat)))
#'(list (lambda () (mk-varpat pat))
(lambda ()
(lambda (a b c cut x)
((<<lambda>> (patt (<with-cut> cut code)))
(lambda (a b c cut scut x)
((<<lambda>> (patt (<with-cut> cut scut code)))
a b c x)))
(lambda () "true"))))
......@@ -1543,8 +1546,8 @@ add/run * vlist *
(with-syntax ((patt (parse-match #'pat)))
#'(list (lambda () (mk-varpat pat))
(lambda ()
(lambda (a b c cut x)
((<<lambda>> (patt (<with-cut> cut code)))
(lambda (a b c cut scut x)
((<<lambda>> (patt (<with-cut> cut scut code)))
a b c x)))
(lambda () y))))
......@@ -1570,8 +1573,8 @@ add/run * vlist *
(pp #`(list (lambda ()
#,(pp 'b (mk-varpat-extended #'(pat ...))))
(lambda ()
(lambda (a b c cut x)
(apply (<<lambda>> (pat2 ... (<with-cut> cut code)))
(lambda (a b c cut scut x)
(apply (<<lambda>> (pat2 ... (<with-cut> cut scut code)))
a b c x)))
(lambda () 'true)))))
......@@ -1580,8 +1583,9 @@ add/run * vlist *
(pp #`(list (begin
#,(mk-varpat-extended #'(pat ...)))
(lambda ()
(lambda (a b c cut x)
(apply (<<lambda>> (pat2 ... (<with-cut> cut code)))
(lambda (a b c cut scut x)
(apply (<<lambda>> (pat2 ... (<with-cut> cut scut
code)))
a b c x)))
(lambda () y)))))
......@@ -1869,8 +1873,8 @@ add/run * vlist *
(pp 'lam1 #`(list (lambda ()
#,(pp 'b (mk-varpat-extended2 #'(pat ...))))
(lambda ()
(lambda (a b c cut x)
(apply (<<lambda>> (pat2 ... (<with-cut> cut code)))
(lambda (a b c cut scut x)
(apply (<<lambda>> (pat2 ... (<with-cut> cut scut code)))
a b c x)))
(lambda () 'true)))))
......@@ -1879,8 +1883,9 @@ add/run * vlist *
(pp 'lam2 #`(list (begin
#,(pp 'd (mk-varpat-extended2 #'(pat ...))))
(lambda ()
(lambda (a b c cut x)
(apply (<<lambda>> (pat2 ... (<with-cut> cut code)))
(lambda (a b c cut scut x)
(apply (<<lambda>> (pat2 ... (<with-cut> cut scut
code)))
a b c x)))
(lambda () y)))))
......
......@@ -201,24 +201,28 @@
(<case-lambda>
((x y) (<values> (yy) (copy-term-2 x)) (<=> y yy))
((x y z)
(<let> ((fr (<newframe>)))
(<let> ((s S)
(fr (<newframe>)))
(<values> (yy zz) (copy-term-3 x))
(<values> (ww) (copy-term-2 (cons yy zz)))
(<code> (<unwind-tail> fr))
<cc>
(<=> (y . z) ww)))))
(<with-s> s
<cut>
(<=> (y . z) ww))))))
(define duplicate_term
(<case-lambda>
((x y) (<values> (yy) (duplicate-term-2 x)) (<=> y yy))
((x y z)
(<let> ((fr (<newframe>)))
(<let> ((s S)
(fr (<newframe>)))
(<values> (yy zz) (duplicate-term-3 x))
(<values> (ww) (copy-term-2 (cons yy zz)))
(<code> (<unwind-tail> fr))
<cc>
(<=> (y . z) ww)))))
(<with-s> s
<cut>
(<=> (y . z) ww))))))
(define (cp x s) (copy-term-2 s (lambda () #f) (lambda (s p x) x) x))
......@@ -28,7 +28,7 @@
parse<> ->list
let<> <_>
<state-ref> <state-set!> <lv*> <clear>
tr S P CC CUT <scm>
tr S P CC CUT SCUT <scm>
<cons> <cons?> <var?> <values> <windlevel>
<syntax-parameterize>
<car> <cdr> <logical++> <logical-->
......@@ -72,6 +72,8 @@
(define-syntax-parameter S
(lambda (x) (error "S should be bound by fluid-let")))
(define-syntax-parameter SCUT
(lambda (x) (error "SCUT should be bound by fluid-let")))
(define-syntax-parameter P
(lambda (x) (error "P should be bound by fluid-let")))
(define-syntax-parameter CC
......@@ -228,9 +230,15 @@
(syntax-rules ()
((_ (cut s p cc) () a ...)
(parse<> (cut s cut cc)
(<with-fail> cut (<and> a ...))))
(<with-fail> cut
(<code> (<prune> SCUT))
(<and> a ...))))
((_ (cut s p cc) (_ . l) a ...)
(<and> (cut s p cc) (<with-fail> cut (<and> . l)) a ...))))
(<and> (cut s p cc)
(<with-fail> cut
(<code> (<prune> SCUT))
(<and> . l)) a ...))))
(define-and-log <fail>
......@@ -396,9 +404,11 @@
(define-guile-log <with-cut>
(syntax-rules ()
((_ (cut s p cc) cutt code ...)
(let ((cuttt cutt))
(syntax-parameterize ((CUT (identifier-syntax cuttt)))
((_ (cut s p cc) cutt scutt code ...)
(let ((cuttt cutt)
(scuttt scutt))
(syntax-parameterize ((CUT (identifier-syntax cuttt))
(SCUT (identifier-syntax scuttt)))
(parse<> (cuttt s p cc) (<and> code ...)))))))
......@@ -526,8 +536,9 @@ For tabling, negations are tricky. the reason is that when a recursive applicati
(syntax-rules ()
((_ (cut s p cc) code ...)
(notter cut s p cc (lambda (ss pp ccc)
(parse<> (pp ss pp ccc)
(<and> code ...)))))))
(parse<> (pp ss pp ccc)
(<with-cut> pp ss
(<and> code ...))))))))
(define (notter cut s p cc lam)
(let* ((ss (gp-newframe s))
......@@ -699,7 +710,8 @@ For tabling, negations are tricky. the reason is that when a recursive applicati
(syntax-rules ()
((_ (cut s p cc) code ...)
(fl-let (cut s p cc)
(parse<> (cut s p cc) (<and> code ...))))
(syntax-parameterize ((SCUT (identifier-syntax s)))
(parse<> (cut s p cc) (<and> code ...)))))
((_ (s p cc) code ...)
(<with-guile-log> (p s p cc) code ...))))
......@@ -794,15 +806,15 @@ For tabling, negations are tricky. the reason is that when a recursive applicati
(dls-wrap- cut s p cc (<lambda> () code)))
(define-syntax-rule (dls-match (cut s p cc) old code ...)
(dls-match- cut s p cc old
(<lambda> (cut) (<with-cut> cut code ...))))
(dls-match- cut s s p cc old
(<lambda> (cut scut) (<with-cut> cut scut code ...))))
(define (dls-match- cut s p cc old code)
(define (dls-match- cut scut s p cc old code)
(<and> (cut s p cc)
(if (eq? (fluid-ref delayers) old)
<cc>
(dls old))
(code cut)))
(code cut scut)))
(define *depth* (make-fluid))
......
......@@ -666,7 +666,7 @@
(append vars ovars)
(append varq ovarq))
((@ (logic guile-log) <lambda> ) (cut ,@aa)
((@ (logic guile-log) <with-cut>) cut
((@ (logic guile-log) <with-cut>) cut SCUT
(,(GL <var>) ,vars ,ff)))))))
((and (pair? extention?))
......
(define-module (logic guile-log prolog goal-functors)
#:use-module ((logic guile-log) #:select
(CUT <if> <define> <match> <<match>>
(CUT SCUT <if> <define> <match> <<match>>
<let> <apply> <cut> <fail> S
<and> <with-cut> <cc> <pp> <lookup> <var?> <pp> <cut>
<code> </.> procedure-name
......@@ -43,7 +43,7 @@
(define-guile-log goal-eval
(syntax-rules ()
((_ (cut a b c) x)
(goal-eval* a b c cut x))))
(goal-eval* a b c cut SCUT x))))
(define (goal-fkn? f)
(object-property f 'prolog-functor-type))
......@@ -51,14 +51,14 @@
(define op2: #f)
(define get-module #f)
(define namespace-switch #f)
(<define> (goal-eval* cut x)
(<define> (goal-eval* cut scut x)
(<<match>> (#:mode - #:name goal-eval) ((pp 'goal-eval x))
(#((,op2: mod #((n . l))))
(<let> ((mod (get-module (procedure-name (<lookup> mod))))
(n (<lookup> n)))
(namespace-switch mod
(</.>
(goal-eval* cut
(goal-eval* cut scut
(vector (cons (module-ref mod
(procedure-name n))
l)))))))
......@@ -68,14 +68,14 @@
(<let> ((x (object-property f 'prolog-functor-type)))
(case x
((#:goal)
(<apply> f cut l))
(<apply> f cut scut l))
((#f)
(if (and (struct? f) (prolog-closure? f))
(<apply> (prolog-closure-closure f) l)
(<apply> f l)))))))
((x)
(goal-eval* cut x))
(goal-eval* cut scut x))
(x
(<let> ((f (<lookup> x)))
......@@ -88,7 +88,7 @@
(<let> ((x (object-property f 'prolog-functor-type)))
(case x
((#:goal)
(f cut))
(f cut scut))
(else
(f))))))
......@@ -96,7 +96,7 @@
((prolog-closure-closure f)))
((eq? f '!)
(<with-cut> cut (<and> <cut>)))
(<with-cut> cut scut (<and> <cut>)))
(else
(type_error callable (gp-var-ref *call-expression*))))))))
......
......@@ -355,7 +355,7 @@ We could make all variable references through a stack frame e.g.
(let ((warn-message
(format #f "Operator ~a is not evaluable, will fail" op)))
(<lambda> (Cut . X)
(<lambda> (Cut SCut . X)
(<let> ((e (get-flag unknown)))
(cond
((eq? e error)
......@@ -869,8 +869,8 @@ floor(x) (floor x)
|#
;; CATCH
(<define> (catch-fkn cut g c h)
(<with-cut> cut
(<define> (catch-fkn cut scut g c h)
(<with-cut> cut scut
(<code> (gp-var-set *call-expression* g S))
(<catch> 'prolog #f
(<lambda> () (goal-eval g))
......@@ -879,7 +879,7 @@ floor(x) (floor x)
(<and> (<=> c x) <cut> (goal-eval h))
(next))))))
(<define-guile-log-rule> (catch-mac g c h) (catch-fkn CUT g c h))
(<define-guile-log-rule> (catch-mac g c h) (catch-fkn CUT SCUT g c h))
(mk-prolog-term-3 tr-catch catch catch-mac a a a)
;; THROW
......
......@@ -988,6 +988,7 @@
(<and>
<cut>
(<let> ((p P)
(s0 S)
(fr (<newframe>)))
(<values> (t ts) (copy-term-3 t))
(<code> (fformat s "~a" (scm->pl S t ns q i n)))
......@@ -1000,7 +1001,8 @@
(lp (cdr ts)))
<cc>))
(<code> (<unwind-tail> fr))
(<with-fail> p <cc>))))
(<with-s> s0
(<with-fail> p <cc>)))))
(_
(instantiation_error)))))))))
......@@ -1052,16 +1054,18 @@
(<define> (read* s term v vn si)
(<let*> ((s (<scm> s))
(s0 S)
(fr (<newframe>))
(e (call-with-values
(lambda () (read-prolog-term S s (current-module)))
(lambda x x))))
(<code> (<unwind-tail> fr))
<cc>
(<or>
(<and> (<=> ,(list term v vn si) e) <cut>)
(<=> ,(list term v vn si) ,(list end_of_file '() '() '())))
(<code> (fluid-set! *closure-creations* (make-hash-table)))))
(<with-s> s0
<cut>
(<or>
(<and> (<=> ,(list term v vn si) e) <cut>)
(<=> ,(list term v vn si) ,(list end_of_file '() '() '())))
(<code> (fluid-set! *closure-creations* (make-hash-table))))))
(define read_term
......
(define-module (logic guile-log prolog operators)
#:use-module ((logic guile-log)
#:select (procedure-name CUT <define> <with-cut>))
#:select (procedure-name CUT SCUT <define> <with-cut>))
#:use-module (ice-9 match)
#:use-module (ice-9 pretty-print)
#:use-module (logic guile-log prolog pre)
......@@ -164,10 +164,10 @@
(define (wrap f) (get-binding stx atom f))
(define (get-funct-from-proc f)
(let ((extr (if (eq? goal? #:goal) #'CUT #'S)))
(let ((extr (if (eq? goal? #:goal) #'(CUT SCUT) #'(S))))
(if worker
#`(#,worker #,(wrap (procedure-name f)) #,extr #,@lll)
#`(#,(wrap (procedure-name f)) #,extr #,@lll))))
#`(#,worker #,(wrap (procedure-name f)) #,@extr #,@lll)
#`(#,(wrap (procedure-name f)) #,@extr #,@lll))))
(define (get-func-from-proc f)
(if worker
......@@ -223,8 +223,8 @@
(syntax-rules ()
((_ (nm . a) . code)
(begin
(<define> (nm cut . a)
(<with-cut> cut . code))
(<define> (nm cut scut . a)
(<with-cut> cut scut . code))
(attach-defined-module! nm)
(set-object-property! nm 'prolog-functor-type #:goal)
(set-object-property! nm 'prolog-functor-stx #'nm)))
......
......@@ -78,13 +78,15 @@
(<define> (is-variant? x y)
(<let> ((i (mk-i))
(j (mk-i))
(s (<newframe>)))
(s0 S)
(s (<newframe>)))
(<var> (xx yy)
((fluid-ref mk-v) x xx i)
((fluid-ref mk-v) y yy j)
(<==> xx yy)
<cc>
(<code> (<unwind-tail> s)))))
<cut>
(<code> (<unwind-tail> s))
(<with-s> s0 <cc>))))
(define (add-var s x l)
(if (gp-attvar? x s)
......@@ -133,11 +135,13 @@
(<define> (subsumes_term x y)
(<let> ((l (mk-l))
(p P)
(s0 S)
(s (<newframe>)))
((fluid-ref subs) x y l)
(when (and-map (lambda (x) (eq? x (<lookup> x))) (car l)))
(<code> (<unwind-tail> s))
(<with-fail> p <cc>)))
(<with-s> s0
(<with-fail> p <cc>))))
......
......@@ -25,6 +25,7 @@ and rgard removes it from the list going backwards reverses the actions.
((_ w a b c)
(<let> w ((p0 P)
(s0 S)
(scut SCUT)
(cut1 CUT)
(cc CC)
(fr (<newframe-choice>)))
......@@ -36,16 +37,17 @@ and rgard removes it from the list going backwards reverses the actions.
(lguard
(</.>
(<with-fail> (lambda () (rp))
(<with-cut> cut1
(<with-cut> cut1 SCUT
a
(<code>
(if (gp-deterministic? fr)
(<prune-tail> fr)))
(<code> (set! rp p0))
(<let> ((cut2 CUT))
(<let> ((scut2 SCUT)
(cut2 CUT))
(rguard
(</.>
(<with-cut> cut2 b)))))))))))))
(<with-cut> cut2 scut2 b)))))))))))))
(<define> (soft-if-f a b c) (<soft-if> (a) (b) (c)))
(set-procedure-property! soft-if-f 'argkind 'with-cut)
......
......@@ -713,9 +713,9 @@ static void gp_unwind0(SCM *fr, SCM *ci, SCM *si, SCM *cs, struct gp_stack *gp)
cs_store = 1;
continue;
} else if(GP(*i))
{
{
GP_GETREF(*i)[1] = SCM_UNBOUND;
GP_GETREF(*i)[2] = SCM_UNBOUND;
GP_GETREF(*i)[2] = SCM_UNBOUND;
}
}
}
......@@ -885,6 +885,7 @@ static inline void gp_unwind_(SCM s, int ncons, int nvar, int nfr)
void inline falsify_entries(SCM *ci,struct gp_stack *gp)
{
return;
SCM *i = gp->gp_ci - 1;
int action = 1;
for(;i >= ci; i--)
......
......@@ -845,7 +845,7 @@ static inline SCM * gp_lookup(SCM *id, SCM l)
retry:
if(!SCM_NULLP(l)) goto advanced;
if(!SCM_NULLP(l) && !scm_is_eq(l,SCM_EOL)) goto advanced;
if(SCM_VARIABLEP(GP_UNREF(id)))
{
......@@ -890,7 +890,8 @@ static inline SCM * gp_lookup(SCM *id, SCM l)
goto retry;
}
if(GP_STAR(id) && GP_UNBOUND(id) && !scm_is_eq(l,SCM_EOL)) goto advanced;
if(GP_STAR(id) && GP_UNBOUND(id) && !scm_is_eq(l,SCM_EOL)
&& !scm_is_eq(l,SCM_UNBOUND)) goto advanced;
gp_debug0("exit simple\n");
gp_debug2("lookup> %x 0 val = %x\n",id,SCM_UNPACK(*id)) ;
return id;
......@@ -963,7 +964,7 @@ static inline SCM * gp_lookup2(SCM *id, SCM l)
retry:
if(!SCM_NULLP(l)) goto advanced;
if(!SCM_NULLP(l) && !scm_is_eq(l,SCM_UNBOUND)) goto advanced;
if(SCM_VARIABLEP(GP_UNREF(id)))
{
......@@ -1079,8 +1080,7 @@ static inline SCM * gp_lookup_ll(SCM *id, SCM *l)
retry:
if(!SCM_NULLP(*l)) goto advanced;