From: Joe Marshall <eval.apply@gmail.com>
Date: Fri, 27 Jan 2012 01:01:58 +0000 (-0800)
Subject: Unparse assignments, definitions, and lambdas with their respective names.
X-Git-Tag: release-9.2.0~332^2
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f9eed671331a813aaad3006da20135ce1be5cead;p=mit-scheme.git

Unparse assignments, definitions, and lambdas with their respective names.
---

diff --git a/src/runtime/unpars.scm b/src/runtime/unpars.scm
index 7c6bf1d56..2188c5eed 100644
--- a/src/runtime/unpars.scm
+++ b/src/runtime/unpars.scm
@@ -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.
 
 ;;;; 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 ()