(%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)
(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))
(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)))