From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 6 Jan 2017 03:28:47 +0000 (-0800)
Subject: Compute tag's description lazily if not given.
X-Git-Tag: mit-scheme-pucked-9.2.12~227^2~214
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=59b8998368a8a8a0a8cd009cf8a3e2847f91b020;p=mit-scheme.git

Compute tag's description lazily if not given.
---

diff --git a/src/runtime/predicate-metadata.scm b/src/runtime/predicate-metadata.scm
index 3f7245843..1583b090d 100644
--- a/src/runtime/predicate-metadata.scm
+++ b/src/runtime/predicate-metadata.scm
@@ -115,7 +115,7 @@ USA.
          (%make-tag predicate
                     name
                     (if (default-object? description)
-                        (object->description name)
+                        #f
                         (guarantee string? description 'make-tag))
                     (if (default-object? extra) #f extra)
 		    (make-strong-eq-hash-table)
@@ -128,19 +128,12 @@ USA.
       (and (list? object)
            (every tag-name? object))))
 
-(define (object->description object)
-  (if (symbol? object)
-      (symbol-name object)
-      (call-with-output-string
-	(lambda (port)
-	  (write object port)))))
-
 (define-record-type <tag>
     (%make-tag predicate name description extra subsets supersets)
     tag?
   (predicate tag->predicate)
   (name tag-name)
-  (description tag-description)
+  (description %tag-description)
   (extra tag-extra)
   (subsets tag-subsets)
   (supersets tag-supersets))
@@ -150,6 +143,15 @@ USA.
     (lambda (tag)
       (list (tag-name tag)))))
 
+(define (tag-description tag)
+  (or (%tag-description tag)
+      (object->description (tag-name tag))))
+
+(define (object->description object)
+  (call-with-output-string
+    (lambda (port)
+      (write object port))))
+
 (define (get-tag-subsets tag)
   (hash-table-keys (tag-subsets tag)))