From d15ddd23d1159285fa371c6f85fbc234bc345a81 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Tue, 27 Feb 2018 22:16:05 -0800 Subject: [PATCH] Allow calling register-predicate! twice with the same args. --- src/runtime/predicate.scm | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/src/runtime/predicate.scm b/src/runtime/predicate.scm index bf67390d2..da8dfc65d 100644 --- a/src/runtime/predicate.scm +++ b/src/runtime/predicate.scm @@ -129,17 +129,24 @@ USA. 'register-predicate!))) (named-lambda (register-predicate! predicate name . keylist) (guarantee keyword-list? keylist 'register-predicate!) - (let ((tag (make-simple-tag name predicate))) + (let ((tag + (let ((tag (get-predicate-tag predicate #f))) + (if tag + (begin + (if (not (eq? name (dispatch-tag-name tag))) + (error "Can't re-register predicate:" + predicate name)) + tag) + (make-simple-tag name predicate))))) (for-each (lambda (superset) (set-predicate<=! predicate superset)) (get-keyword-values keylist '<=)) tag)))) (set! set-dispatch-tag<=! (named-lambda (set-dispatch-tag<=! tag superset) - (if (not (add-dispatch-tag-superset tag superset)) - (error "Tag already has this superset:" tag superset)) (if (dispatch-tag>= tag superset) (error "Not allowed to create a superset loop:" tag superset)) + (add-dispatch-tag-superset tag superset) (hash-table-clear! dispatch-tag<=-cache))) (set! set-predicate<=! (named-lambda (set-predicate<=! predicate superset) -- 2.25.1