shithub: femtolisp

Info  •  Files  •  Log

fixing bug printing functions involved in cycles

--- 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)

--- a/femtolisp/print.c

+++ b/femtolisp/print.c

@@ -340,9 +340,24 @@

 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 @@

         }

         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 @@

       if (v == UNBOUND) { outs("#<undefined>", 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 @@

             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;

     }

 }

--- 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)