From 59b8998368a8a8a0a8cd009cf8a3e2847f91b020 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Thu, 5 Jan 2017 19:28:47 -0800 Subject: [PATCH] Compute tag's description lazily if not given. --- src/runtime/predicate-metadata.scm | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) 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 (%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))) -- 2.25.1