From b370c52fca172ffc5ac522cc2d92fc4c996b6b65 Mon Sep 17 00:00:00 2001 From: David Kastrup Date: Wed, 18 Apr 2012 07:29:52 +0200 Subject: [PATCH] Define and use event-class-cons --- scm/define-event-classes.scm | 33 ++++++++++++++++++++++++--------- 1 file changed, 24 insertions(+), 9 deletions(-) diff --git a/scm/define-event-classes.scm b/scm/define-event-classes.scm index 771513f5b4..f5a6cea5f0 100644 --- a/scm/define-event-classes.scm +++ b/scm/define-event-classes.scm @@ -59,20 +59,35 @@ (Announcement . (AnnounceNewContext)) )) +(define-public (event-class-cons class parent classlist) + (let ((lineage (assq parent classlist))) + (if (not lineage) + (begin + (if (not (null? parent)) + (ly:warning (_ "unknown parent class `~a'") parent)) + (set! lineage '()))) + (if (symbol? class) + (acons class lineage classlist) + (fold (lambda (elt alist) + (acons elt lineage alist)) + classlist class)))) + +(define all-event-classes + (fold (lambda (elt classlist) + (event-class-cons (cdr elt) (car elt) classlist)) + '() event-classes)) + ;; Maps event-class to a list of ancestors (inclusive) -(define ancestor-lookup (make-hash-table 11)) +(define-public ancestor-lookup + (let ((h (make-hash-table (length all-event-classes)))) + (for-each (lambda (ent) (hashq-set! h (car ent) ent)) + all-event-classes) + h)) + ;; Each class will be defined as ;; (class parent grandparent .. ) ;; so that (eq? (cdr class) parent) holds. -(for-each - (lambda (rel) - (for-each - (lambda (type) - (hashq-set! ancestor-lookup type - (cons type (hashq-ref ancestor-lookup (car rel) '())))) - (cdr rel))) - event-classes) (define-public (define-event-class leaf heritage) (cond -- 2.39.2