Compute tag's description lazily if not given.
authorChris Hanson <org/chris-hanson/cph>
Fri, 6 Jan 2017 03:28:47 +0000 (19:28 -0800)
committerChris Hanson <org/chris-hanson/cph>
Fri, 6 Jan 2017 03:28:47 +0000 (19:28 -0800)
src/runtime/predicate-metadata.scm

index 3f7245843a9dd96d2dba2f09dc54d6e9434b7fb5..1583b090dd0b383103e5a826ad5fdfb6223560f1 100644 (file)
@@ -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)))