almost all assq tests sucesses

parent 0ca3e2db
(define-module (logic guile-log code-load)
#:use-module (system vm vm)
#:use-module (srfi srfi-11)
#:export (gp-clear gp-unify! gp-unify-raw! gp-newframe gp-unwind gp-var!
gp->scm gp-print
gp-budy gp-m-unify!
......@@ -82,4 +83,18 @@
(define2 gp-pair- (cdr (assq 'gp-pair- api)))
(define2 gp-pair+ (cdr (assq 'gp-pair+ api)))
#|
(define p+ gp-pair+)
(define (gp-pair+ x s)
(let-values (((x y s) (p+ x s)))
(pk `(pair ,s))
(values x y s)))
(define u! gp-unify!)
(define (gp-unify! x y s)
(let ((r (u! x y s)))
(pk `(unify ,r))
r))
|#
(define -einstein #f)
......@@ -195,17 +195,17 @@ SCM gp_cons_str;
SCM a,b; \
gp_debug0(err); \
if(SCM_UNLIKELY(!SCM_CONSP(s))) \
scm_misc_error("unpack_s",err,SCM_EOL); \
scm_misc_error("unpack_s1",err,SCM_EOL); \
a = SCM_CDR(s); \
\
b = SCM_CAR(s); \
if(SCM_UNLIKELY(!GP_STACKP(b))) \
scm_misc_error("unpack_s",err,SCM_EOL); \
scm_misc_error("unpack_s2",err,SCM_EOL); \
\
gp = (struct gp_stack *) SCM_SMOB_DATA(b); \
\
if(SCM_UNLIKELY(!SCM_CONSP(a))) \
scm_misc_error("unpack_s",err,SCM_EOL); \
scm_misc_error("unpack_s3",err,SCM_EOL); \
\
l = SCM_CDR(a); \
}
......@@ -215,17 +215,17 @@ SCM gp_cons_str;
SCM a,b; \
gp_debug0(err); \
if(SCM_UNLIKELY(!SCM_CONSP(s))) \
scm_misc_error("unpack_s",err,SCM_EOL); \
scm_misc_error("unpack_a1",err,SCM_EOL); \
a = SCM_CDR(s); \
\
ggp = SCM_CAR(s); \
if(SCM_UNLIKELY(!GP_STACKP(ggp))) \
scm_misc_error("unpack_s",err,SCM_EOL); \
scm_misc_error("unpack_a2",err,SCM_EOL); \
\
gp = (struct gp_stack *) SCM_SMOB_DATA(ggp); \
\
if(SCM_UNLIKELY(!SCM_CONSP(a))) \
scm_misc_error("unpack_s",err,SCM_EOL); \
scm_misc_error("unpack_a3",err,SCM_EOL); \
\
uw = SCM_CAR(a); \
l = SCM_CDR(a); \
......@@ -1522,21 +1522,31 @@ SCM_DEFINE(gp_pair_bang, "gp-pair!?", 2, 0, 0, (SCM x, SCM s),
x = gp_gp_lookup(x,s);
if(GP(x))
{
y = GP_GETREF(x);
if(GP_UNBOUND(y))
{
SCM *cons = GP_GETREF(gp_mk_cons(s));
ret = gp_set_ref(y,GP_UNREF(cons),l,gp);
PACK_ALL(uw,l,ret,ggp,s);
return s;
}
if(SCM_UNLIKELY(gp->_logical_))
{
SCM cons = scm_cons(make_logical(),make_logical());
SCM lnew = logical_add(x, cons, l);
PACK_ALL(uw,l,lnew,ggp,s);
return s;
}
else
{
if(GP_CONS(y))
{
return s;
}
}
{
y = GP_GETREF(x);
if(GP_UNBOUND(y))
{
SCM *cons = GP_GETREF(gp_mk_cons(s));
ret = gp_set_ref(y,GP_UNREF(cons),l,gp);
PACK_ALL(uw,l,ret,ggp,s);
return s;
}
else
{
if(GP_CONS(y))
{
return s;
}
}
}
return SCM_BOOL_F;
}
......@@ -1998,8 +2008,8 @@ int _gp_pair_plus(SCM **spp, int nargs, SCM *cl, SCM *max)
}
else
{
sp[-2] = gp_car(x,s);
sp[-1] = gp_gp_cdr(x,s);
sp[-2] = gp_car(x,ret);
sp[-1] = gp_gp_cdr(x,ret);
}
sp[0] = ret;
......@@ -2026,8 +2036,8 @@ int _gp_pair_minus(SCM **spp, int nargs, SCM *cl, SCM *max)
}
else
{
sp[-2] = gp_car(x,s);
sp[-1] = gp_gp_cdr(x,s);
sp[-2] = gp_car(x,ret);
sp[-1] = gp_gp_cdr(x,ret);
}
sp[0] = 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