Debugged first variables short cut

parent 66e8ca94
......@@ -119,6 +119,7 @@
(warn
"libguile-unify is not present, did you forget to make it?")))))
;(define (gp-clear-frame . x) #t)
(define-syntax-rule (definek x val)
(module-define! (current-module) 'x val))
......
......@@ -131,14 +131,14 @@
(q (f-char #\"))
(quote (f-seq!! bs any))
(it (f-or! match nl quote butq))
(str (f-or! s-eof (f-seq!! it str) q)))
(str (f-or! f-eof (f-seq!! it str) q)))
(f-seq!! q str)))
(define (line-comment match nl)
(letrec ((no-nl (f-reg "[^\n]"))
(semi (f-char #\;))
(it (f-or! match no-nl))
(f (f-or! s-eof nl (f-seq!! it f))))
(f (f-or! f-eof nl (f-seq!! it f))))
(f-seq!! semi f)))
......@@ -147,7 +147,7 @@
(left (f-tag "#|"))
(not-right (f-not right))
(it (f-or! nl match f not-right))
(g (f-or! s-eof (f-seq!! it g) right))
(g (f-or! f-eof (f-seq!! it g) right))
(f (f-seq!! left g)))
f))
......@@ -185,7 +185,7 @@
nleft))
(item (lambda (g true)
(f-or! (f-seq!! it (Ds (item g true)))
s-eof
f-eof
true)))
(gg (item (Ds gg) f-true))
(g (item (Ds g) f-false)))
......
......@@ -34,7 +34,6 @@
<get-fixed> <cp> <lookup> <wrap>
))
(define (gp-gc) #f)
(define (<wrap> f . l)
(apply f (fluid-ref *current-stack*) (lambda x #f) (lambda x #t) l))
......
......@@ -525,9 +525,9 @@
(lambda (vl vs x)
(with-varstat
(init-first-variables)
(for-each first-variable! (pk vl))
(for-each first-variable! vl)
(register-variables x)
(let ((code (goal stx (pk x)))
(let ((code (goal stx x))
(loc (let lp ((var vs))
(if (pair? var)
(if (local-variable? (car var))
......
......@@ -292,7 +292,7 @@
((unify-tr stx n m x y)
(match x
((#:variable v id nn mm)
(if (and (first-variable? v id) (variable-not-included? v y))
(if (and (first-variable? v id) (pk 'first v) (variable-not-included? v y))
(begin
(local-variable! v)
#`(<code>
......@@ -301,7 +301,8 @@
(_
(match y
((#:variable v id nn mm)
(if (and (first-variable? v id) (variable-not-included? v x))
(if (and (first-variable? v id) v
(variable-not-included? v x))
(begin
(local-variable! v)
#`(<code> (set! #,(datum->syntax stx v) (*var* stx x))))
......@@ -323,7 +324,7 @@
((tr-is stx n m x y)
(match x
((#:variable v id nn mm)
(if (first-variable? v id)
(if (and (first-variable? v id))
(begin
(local-variable! v)
#`(<code> (set! #,(datum->syntax stx v) #,(scm stx y))))
......
......@@ -7,16 +7,16 @@
(define-syntax-rule (with-varstat . code)
(with-fluids ((*vs* #f) (*vl* #f)) . code))
(with-fluids ((*vs* #f) (*vl* #f)) (begin (begin . code))))
(define *vs* (make-fluid (make-hash-table)))
(define *vl* (make-fluid (make-hash-table)))
(define (init-first-variables)
(define (init-first-variables)
(fluid-set! *vs* (make-hash-table))
(fluid-set! *vl* (make-hash-table)))
(define (first-variable? v id)
(let ((i (pk 'fisrt? (hash-ref (fluid-ref *vs*) v -2))))
(let ((i (hash-ref (fluid-ref *vs*) v -2)))
(= i id)))
(define (first-variable! v)
......@@ -31,7 +31,7 @@
(define (variable-not-included? v x)
(define (off) #f)
(define (g x)
(match (pk 1 x)
(match x
(()
#'<cc>)
(((kind _ op _) x y n m)
......@@ -85,7 +85,7 @@
(define (g x gl)
(when (not o)
(match (pk x)
(match x
(()
#'<cc>)
(((kind _ op _) x y n m)
......@@ -121,8 +121,6 @@
((x) (g x gl))
(_ #t))))
(fluid-set! *vs* (make-hash-table))
(g x #t))
\ No newline at end of file
......@@ -60,7 +60,6 @@ static inline SCM *get_gp_var(struct gp_stack *gp)
{
SCM cand;
GP_TEST_STACK;
cand = *(gp->gp_si);
if(scm_is_false(cand) || scm_is_eq(cand, SCM_BOOL_T))
{
......@@ -199,12 +198,18 @@ static inline SCM *make_gp_stack(int id, int nthread, int nc, int ns, int ncs, s
{
SCM *pt, *end = gp->gp_stack + ns;
for(pt = gp->gp_stack; pt < end; pt++)
{
*pt = SCM_BOOL_F;
}
/*
for(pt = gp->gp_stack; pt < end; pt++)
{
SCM scm;
scm = gp_make_variable();
*pt = scm;
}
*/
}
......
......@@ -79,6 +79,25 @@ SCM closure_tag;
DB(scm_simple_format(SCM_BOOL_T, \
scm_from_locale_string(str), \
scm_list_3(x,y,z)))
#define format0(str) \
(scm_simple_format(SCM_BOOL_T, \
scm_from_locale_string(str), \
SCM_EOL))
#define format1(str,x) \
(scm_simple_format(SCM_BOOL_T, \
scm_from_locale_string(str), \
scm_list_1(x)))
#define format2(str,x,y) \
(scm_simple_format(SCM_BOOL_T, \
scm_from_locale_string(str), \
scm_list_2(x,y)))
#define format3(str,x,y,z) \
(scm_simple_format(SCM_BOOL_T, \
scm_from_locale_string(str), \
scm_list_3(x,y,z)))
......@@ -493,6 +512,7 @@ static inline void handle_force(SCM *id, SCM flags, SCM v)
SCM * set_ci(SCM *ci, struct gp_stack *gp)
{
SCM *f = get_gp_var(gp);
SCM flags = SCM_PACK(GP_MK_FRAME_EQ(gp_type));
handle_force(f, flags, SCM_PACK(((ci - gp->gp_cstack)<<2) + 2));
......
......@@ -119,4 +119,4 @@
(<var> (y)
(<=> y ,(car x))
(loop (cdr x) (cons y l)))
(<=> r ,(apply vector (reverse l))))))
\ No newline at end of file
(<=> r ,(apply vector (reverse l))))))
......@@ -8,6 +8,9 @@ inc(X,Y) :- Y is X + 1.
test(N) :- test(N,0).
test(N,X) :- X < N, inc(X,Y), test(N,Y).
test3(N) :- test3(N,0).
test3(N,X) :- X < N, Y is X + 1, test3(N,Y).
test2(N) :- test2(N,0).
test2(N,X) :- X < N -> (inc(X,Y), test2(N,Y)) ; (write('goaaaaaaaal!'),nl).
")
......
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