Unparse assignments, definitions, and lambdas with their respective names.
authorJoe Marshall <eval.apply@gmail.com>
Fri, 27 Jan 2012 01:01:58 +0000 (17:01 -0800)
committerJoe Marshall <eval.apply@gmail.com>
Fri, 27 Jan 2012 01:01:58 +0000 (17:01 -0800)
src/runtime/unpars.scm

index 7c6bf1d56ec26fe5bc762e43d58cb76eee22280b..2188c5eed68567c61aac7f4554f6ba0d4c2786b5 100644 (file)
@@ -75,15 +75,18 @@ USA.
   (let ((table (make-unparser-table unparse/default)))
     (for-each (lambda (entry)
                (unparser-table/set-entry! table (car entry) (cadr entry)))
-             `((BIGNUM ,unparse/number)
+             `((ASSIGNMENT ,unparse/assignment)
+               (BIGNUM ,unparse/number)
                (CHARACTER ,unparse/character)
                (COMPILED-ENTRY ,unparse/compiled-entry)
                (COMPLEX ,unparse/number)
                (CONSTANT ,unparse/constant)
+               (DEFINITION ,unparse/definition)
                (ENTITY ,unparse/entity)
                (EXTENDED-PROCEDURE ,unparse/compound-procedure)
                (FLONUM ,unparse/flonum)
                (INTERNED-SYMBOL ,unparse/interned-symbol)
+               (LAMBDA ,unparse/lambda)
                (LIST ,unparse/pair)
                (NEGATIVE-FIXNUM ,unparse/number)
                (FALSE ,unparse/false)
@@ -671,6 +674,21 @@ USA.
 \f
 ;;;; Miscellaneous
 
+(define (unparse/assignment assignment)
+  (*unparse-with-brackets 'ASSIGNMENT assignment
+    (lambda ()
+      (*unparse-object (assignment-name assignment)))))
+
+(define (unparse/definition definition)
+  (*unparse-with-brackets 'DEFINITION definition
+    (lambda ()
+      (*unparse-object (definition-name definition)))))
+
+(define (unparse/lambda lambda-object)
+  (*unparse-with-brackets 'LAMBDA lambda-object
+    (lambda ()
+      (*unparse-object (lambda-name lambda-object)))))
+
 (define (unparse/variable variable)
   (*unparse-with-brackets 'VARIABLE variable
     (lambda ()