attributes compiles

parent ace17e2b
......@@ -101,6 +101,8 @@
gp-put-attr
gp-get-attr
gp-del-attr
gp-att-put-data
gp-set-attribute-trampoline
))
;; Tos silence the compiler, those are fetched from the .so file
......@@ -284,7 +286,9 @@
r
(vlist-cons (car l) (lp (cdr l)))))
r)))
(gp-set-attribut-trampoline (lambda (lam val var x y s)
(gp-set-attribute-trampoline (lambda (lam val var x y s)
(lam s (lambda () #f) (lambda (s .l) s)
val var x y)))
......@@ -1079,11 +1079,11 @@ MAKE SURE TO REVISIT THIS IDEA LATER
((_ w a ...)
(<with-guile-log> w code ...)))))
(<define> (<attvar?> x) (if (gp-attvar? x) <cc> <fail>))
(<define> (<put-attr> x m v) (<with-s> (gp-putvar x m v) <cc>))
(<define> (<attvar?> x) (if (gp-attvar? x S) <cc> <fail>))
(<define> (<put-attr> x m v) (<with-s> (gp-put-attr x m v S) <cc>))
(<define> (<get-attr> x m v)
(<let> ((ret (gp-get-attr x m)))
(<let> ((ret (gp-get-attr x m S)))
(when ret (<=> v ret))))
(<define> (<del-attr> x m) (<with-s> (gp-del-attr x m) <cc>))
(<define> (<del-attr> x m) (<with-s> (gp-del-attr x m S) <cc>))
(define-module (logic guile-log prolog io)
#:use-module (logic guile-log)
#:use-module (logic guile-log attributed)
#:use-module ((logic guile-log umatch)
#:select (gp-var? gp-lookup gp->scm))
#:use-module (logic guile-log guile-prolog closure)
......@@ -565,7 +566,7 @@
r
(let ((n (next-q)))
(hashq-set! *variables* a n)
(gen@ (vector (list construct_attr n (gp-att-data a))))))))
(lp (vector (list construct_attr n (gp-att-data a))))))))
((gp-var? a s)
(let ((r (hashq-ref *variables* a #f)))
......
......@@ -21,7 +21,7 @@
(error "closure references failed could not find stored ref of already made closure")))
(begin
(let ((f (apply lam l)))
(hashq-set! (fluids-ref *closure-creations*) f)
(hashq-set! (fluid-ref *closure-creations*) n f)
f))))
(define arg #f)
......
......@@ -38,7 +38,7 @@ SCM_DEFINE(gp_attdata, "gp-att-data", 2, 0, 0, (SCM x, SCM s),
}
#undef FUNC_NAME
SCM_DEFINE(gp_put_attdata, "gp-att-put-data", 2, 0, 0, (SCM x, SCM v, SCM s),
SCM_DEFINE(gp_put_attdata, "gp-att-put-data", 3, 0, 0, (SCM x, SCM v, SCM s),
"check to see if variable is an attributed variable")
#define FUNC_NAME s_gp_put_attdata
{
......
......@@ -16,8 +16,8 @@
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
*/
#include<libguile.h>
#include<stdio.h>
#include <libguile.h>
#include <stdio.h>
#include "../../../config.h"
#include "unify.h"
#include "libguile/smob.h"
......@@ -994,6 +994,7 @@ static int gp_recurent(SCM *id1,SCM *id2, SCM *l)
SCM scm;
gp_debug0("recurent>\n");
retry_all:
if(!GP(GP_UNREF(id2))) goto non_gp;
gp_lookup_l(id2,id2,l);
......@@ -1017,7 +1018,8 @@ static int gp_recurent(SCM *id1,SCM *id2, SCM *l)
if(GP_ATTR(id2))
{
id2 = id2[1];
id2 = GP_GETREF(id2[1]);
goto retry_all;
}
......@@ -1276,7 +1278,7 @@ int len(SCM x, SCM *l)
// unify under + means unification - means just match
SCM trampoline = SCM_BOOL_F;
SCM_DEFINE(gp_set_attributed_trampoline, "gp-set-attribut-trampoline", 1, 0, 0, (SCM x),
SCM_DEFINE(gp_set_attributed_trampoline, "gp-set-attribute-trampoline", 1, 0, 0, (SCM x),
"check to see if variable is an attributed variable")
#define FUNC_NAME s_gp_set_attributed_trampoline
{
......
......@@ -127,4 +127,4 @@ SCM_API SCM gp_put_attr(SCM x, SCM lam, SCM val, SCM s);
SCM_API SCM gp_get_attr(SCM x, SCM lam, SCM s);
SCM_API SCM gp_del_attr(SCM x, SCM lam, SCM s);
SCM_API SCM gp_set_attributed_trampoline(SCM x);
SCM_API SCM gp_put_attdata(SCM x, SCM v, SCM s),
SCM_API SCM gp_put_attdata(SCM x, SCM v, SCM s);
......@@ -487,11 +487,11 @@
(let lp ((x x))
(let ((x (gp-lookup x s)))
(cond
((gp-attvar-raw? x)
((gp-attvar-raw? x s)
(if (not (hashq-ref tr x #f))
(begin
(hashq-set! tr x (gp-make-var))
(gp-att-data x))))
(gp-att-data x s))))
((gp-pair? x s)
(begin
......@@ -521,10 +521,10 @@
(let lp ((x x))
(let ((x (gp-lookup x s)))
(cond
((gp-attvar-raw? x)
((gp-attvar-raw? x s)
(let ((v (hashq-ref tr x 'BUG)))
(if (not (gp-attvar-raw? v))
(gp-att-put-data v (lp (gp-att-data x)) s))))
(if (not (gp-attvar-raw? v s))
(gp-att-put-data v (lp (gp-att-data x s)) s))))
((gp-pair? x s)
(cons (lp (gp-car x s))
......
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