diff --git a/femtolisp/cps.lsp b/femtolisp/cps.lsp index 51e2060..2fe9eb2 100644 --- a/femtolisp/cps.lsp +++ b/femtolisp/cps.lsp @@ -274,7 +274,7 @@ (shift yk (begin (set! ,ko yk) (set! ,cur v)))))) - ,(f-body body)))))))))) + ,@body))))))))) ; a test case (define-generator (range-iterator lo hi) diff --git a/femtolisp/print.c b/femtolisp/print.c index eb3076d..b2ee7db 100644 --- a/femtolisp/print.c +++ b/femtolisp/print.c @@ -340,9 +340,24 @@ static void print_pair(ios_t *f, value_t v) static void cvalue_print(ios_t *f, value_t v); -void fl_print_child(ios_t *f, value_t v) +static int print_circle_prefix(ios_t *f, value_t v) { value_t label; + if ((label=(value_t)ptrhash_get(&printconses, (void*)v)) != + (value_t)HT_NOTFOUND) { + if (!ismarked(v)) { + HPOS+=ios_printf(f, "#%ld#", numval(label)); + return 1; + } + HPOS+=ios_printf(f, "#%ld=", numval(label)); + } + if (ismanaged(v)) + unmark_cons(v); + return 0; +} + +void fl_print_child(ios_t *f, value_t v) +{ char *name; switch (tag(v)) { @@ -376,6 +391,7 @@ void fl_print_child(ios_t *f, value_t v) } else { assert(isclosure(v)); + if (print_circle_prefix(f, v)) return; function_t *fn = (function_t*)ptr(v); outs("#function(", f); char *data = cvalue_data(fn->bcode); @@ -397,18 +413,10 @@ void fl_print_child(ios_t *f, value_t v) if (v == UNBOUND) { outs("#", f); break; } case TAG_VECTOR: case TAG_CONS: - if ((label=(value_t)ptrhash_get(&printconses, (void*)v)) != - (value_t)HT_NOTFOUND) { - if (!ismarked(v)) { - HPOS+=ios_printf(f, "#%ld#", numval(label)); - return; - } - HPOS+=ios_printf(f, "#%ld=", numval(label)); - } + if (print_circle_prefix(f, v)) return; if (isvector(v)) { outc('[', f); int newindent = HPOS, est; - unmark_cons(v); int i, sz = vector_size(v); for(i=0; i < sz; i++) { fl_print_child(f, vector_elt(v,i)); @@ -432,13 +440,10 @@ void fl_print_child(ios_t *f, value_t v) outc(']', f); break; } - if (iscvalue(v) || iscprim(v)) { - if (ismanaged(v)) - unmark_cons(v); + if (iscvalue(v) || iscprim(v)) cvalue_print(f, v); - break; - } - print_pair(f, v); + else + print_pair(f, v); break; } } diff --git a/femtolisp/system.lsp b/femtolisp/system.lsp index 34af5ee..ce2c5f9 100644 --- a/femtolisp/system.lsp +++ b/femtolisp/system.lsp @@ -376,8 +376,8 @@ (let* ,(cdr binds) ,@body)) ,(cadar binds)))) -(define-macro (when c . body) (list 'if c (f-body body) #f)) -(define-macro (unless c . body) (list 'if c #f (f-body body))) +(define-macro (when c . body) (list 'if c (cons 'begin body) #f)) +(define-macro (unless c . body) (list 'if c #f (cons 'begin body))) (define-macro (case key . clauses) (define (vals->cond key v)