From 1ee81e2625d31562e3a43df2f935598e8dd31068 Mon Sep 17 00:00:00 2001
From: JeffBezanson <jeff.bezanson@gmail.com>
Date: Thu, 21 May 2009 00:56:25 +0000
Subject: [PATCH] fixing bug printing functions involved in cycles

---
 femtolisp/cps.lsp    |  2 +-
 femtolisp/print.c    | 37 +++++++++++++++++++++----------------
 femtolisp/system.lsp |  4 ++--
 3 files changed, 24 insertions(+), 19 deletions(-)

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("#<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 @@ 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)