prolog compilation bug fixed + recursive dynamic goals are working

parent f3dd9d5d
......@@ -447,7 +447,7 @@ add/run * vlist *
(define (walk-raw s p a F walk-dynlist e rev)
(let* ((ar (get-ar e))
(db (get-li e)))
(let lp ((l (rev (get-index-set s a db))))
(let lp ((l (rev (pk (get-index-set s a db)))))
(if (null? l)
(p)
(F (lambda () (lp (cdr l)))
......
......@@ -401,6 +401,20 @@ Also it is possible to solve inifinite recursion.
(<cc> #f)))
(<define> (doit-id x) <cc>)
#|
(define i 0)
(<define> (rec= x y)
(<let> ((j i))
(<code> (set! i (+ i 1)))
((@ (logic guile-log iso-prolog) write) (list j x y))
((@ (logic guile-log iso-prolog) nl))
(rec=_ x y)
((@ (logic guile-log iso-prolog) write) j)
((@ (logic guile-log iso-prolog) nl))))
|#
(define rec= (rec-00 rec=* unify-guard doit-id))
(define rec== (rec-00 rec==* unify-guard doit-id))
......
......@@ -460,7 +460,7 @@
(ffkn (pp 'ffkn (hash-fold (lambda (k v r) (cons k r)) '() fkns)))
(vars (hash-fold (lambda (k v r) (cons v r)) '() in-house))
(ovars (hash-fold (lambda (k v r) (cons v r)) '() ex-house)))
(apply (compile (ppp `(,(G lambda) (,@vfkn ,@vars ,@ovars)
(apply (compile (pp `(,(G lambda) (,@vfkn ,@vars ,@ovars)
((@@ (logic guile-log functional-database)
<lambda-dyn>) ,aa
(,(GL <var>) ,vars ,ff)
......
......@@ -146,7 +146,7 @@
(syntax-rules (quote)
((_ 'f . l) (ck () (delay-ck 'f . l)))))
(define-syntax-rule (GT x) `(@@ (logic guile-log goal-transformers) x))
(define-syntax-rule (GT x) `(@@ (logic guile-log prolog goal-transformers) x))
(define-syntax-rule (meta-mk-prolog-op mk-prolog stx nm-code
(a ...) (tp ...) code)
......
......@@ -254,7 +254,14 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data)
ulong data2[200];
int n2;
SCM *db;
redo:
if(SCM_VARIABLEP(e))
{
e = SCM_VARIABLE_REF(e);
goto redo;
}
//printf("n=%d, data[0] = %p datat[1]=%p\n", *n, data[0], data[1]);
//gp_format2("index for ~a db ~a~%", e, db_);fflush(stdout);
......@@ -280,14 +287,14 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data)
SCM l = SCM_CDR(e);
SCM v = get_vars(db);
int i;
// printf("CONSP\n");fflush(stdout);
//printf("CONSP\n");fflush(stdout);
// gp_format3("vars: ~a\n e: ~a\n db: ~a~%",v,e,db_);fflush(stdout);
if(SCM_I_INUMP (v))
{
ulong nv = my_scm_to_ulong(v);
// printf("NIMP v\n");fflush(stdout);
data2[0] = *n ? data[0] & nv : nv;
//printf("NIMP v %p\n", nv);fflush(stdout);
data2[0] = *n ? (data[0] & nv) : nv;
n2 = 1;
}
else
......@@ -311,12 +318,18 @@ void get_index_set_0(SCM s, SCM e, SCM db_, int *n, ulong *data)
}
SCM dcar = dlink_car(db,0);
SCM dcdr = dlink_cdr(db,0);
// printf("sub v\n");fflush(stdout);
//printf("sub v\n");fflush(stdout);
if(scm_is_true(dcar))
get_index_set_0(s,x,dcar, n, data);
{
//printf("CAR\n");
get_index_set_0(s,x,dcar, n, data);
}
if(scm_is_true(dcdr))
get_index_set_0(s,l,dcdr, n, data);
{
//printf("CDR\n");
get_index_set_0(s,l,dcdr, n, data);
}
// printf("finish v\n");fflush(stdout);
{
......
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