From 4ffa82758478927db4e2cf18379c296ef5f20c06 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Thu, 20 May 2010 13:47:49 +0200
Subject: [PATCH] macroexpanded pretty-printer

* module/language/tree-il.scm (print-tree-il):
  (borrow-core-vtables, <tree-il>): When tree-il loads, override the
  printers for macroexpanded structures.
---
 module/language/tree-il.scm | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index f9181ed7a..c268effac 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -61,6 +61,9 @@
             post-order!
             pre-order!))
 
+(define (print-tree-il exp port)
+  (format port "#<tree-il ~a>" (unparse-tree-il exp)))
+
 (define-syntax borrow-core-vtables
   (lambda (x)
     (syntax-case x ()
@@ -84,6 +87,8 @@
                                   #`(define (#,pred x)
                                       (and (struct? x)
                                            (eq? (struct-vtable x) #,type)))
+                                  #`(struct-set! #,type vtable-index-printer
+                                                 print-tree-il)
                                   #`(define #,type
                                            (vector-ref %expanded-vtables #,n))
                                        out)))
@@ -121,7 +126,7 @@
   ;; (<letrec> names gensyms vals body)
   ;; (<dynlet> fluids vals body)
 
-(define-type (<tree-il> #:common-slots (src))
+(define-type (<tree-il> #:common-slots (src) #:printer print-tree-il)
   (<fix> names gensyms vals body)
   (<let-values> exp body)
   (<dynwind> winder body unwinder)
-- 
2.20.1