Ok, so I have been trying to get a hold on the nested context property thing. The main issue is getting a grip of how to update stuff on removal. With regard to nested context properties, an update further down in the nested property alist can have repercussions further up if some parts of the lower hierarchies have been used in setting up a nested context property alist further up in the hierarchy.
There are basically two approaches I see possible for dealing with this: a) when removing a higher-level property further down in the stack, replace its conses, possibly consulted further up, with copies of the next property lower down in the stack. But if I have set a property 'x with a value ((y . ((z . 4)))), then the property handler has no business overwriting the internals of my property just because he copied them for filling in the blanks when setting a nested property (x y c). b) update stuff further up the stack. I've implemented this as Scheme for experimenting with, probably with bugs remaining. Other key elements: A revert will _only_ match an override with the _same_ signature, the signature consisting of the state of the \once flag as well as the full property path. This makes sure that unexpected pairings of reverts with overrides will be kept to a minimum. \once\override will _not_ register the old value of the setting. Instead, every not-yet cancelled \once will get cancelled at the end of the time step. I don't think that anything close to a sensible implementation can be significantly simpler or significantly more efficient. There are some things that may be nicer to do in C, and some shortcuts that may be taken. But as a functional sketch, this should more or less be what it takes. I don't think we can get this much cheaper.
;; Plan: context contains, in contrast to the current Lilypond ;; implementation, an additional source list for context overrides ;; corresponding to the cache list member by member. The source list ;; stops with the last override in the context and does not continue ;; into parenting contexts. ;; ;; In this file, this list is titled "source" and the actual override ;; list is titled "cache". "source" is not really the most accurate ;; description since it merely contains _additional_ data. ;; ;; Structure of "context" (only changed destructively). ;; car -> parenting context or #f ;; cadr -> source ;; cddr -> list head for contexts as currently existing: ;; caddr -> cache, the property list for this context including ;; parents ;; cdddr -> tail. The cache is only valid if the cache of the ;; parent is valid and eq to this context's tail. ;; ;; Structure of source: a list exactly as long as the list reaching ;; from cache inclusively to tail exclusively, and associated 1:1 with ;; the respective list elements. Each element of source has the ;; following parts: ;; car -> records whether this property was entered with \once or ;; not. ;; cdr -> length of nested property path. After this many cdar ;; calls on the property alist, you reach the set value of ;; the nested property. All other content of the property ;; alist entry is taken from other alist entries. ;; ;; The cache is never changed destructively, instead new copies are ;; created for changes. Any parts of the cache that are eq to some ;; part of the structure at an arbitrary different point of time, are ;; for this reason unchanged. (use-modules (ice-9 optargs) (srfi srfi-1) (srfi srfi-2)) (use-modules (ice-9 debug)) (define* (make-context #:optional parent) (cons parent (cons '() (cons '() (if parent (caddr parent) '()))))) (define (updatecache source oldcache newcache) "updatecache should be called with (fold-right updatecache cachetail oldcachelist sourcelist) cachetail contains the new tail for the cache which has lost sync with the previous cache." (let loop ((depth (cdr source)) (oldcache oldcache) (newcache newcache)) (if (zero? depth) ;; entry is the original data entry in this list without copied ;; material so we just cons it up and continue. (cons oldcache newcache) ;; Now we may need to update a nested property override. This ;; is tricky. The property (car oldcache)'s nested property ;; list (cdr oldcache) starts with an override in the first ;; position (cadr oldcache) followed by the top level ;; original nested list (cddr oldcache). If the original for ;; the copied nested list has remained eq, the whole entry can ;; stay the way it is. If we had a sibling override, we need ;; not copy the whole depth of the recursion but only up to ;; the level where the chain is again intact. So we can solve ;; this problem in a recursive manner. Don't even dream of ;; using ly:assoc-get here: strict eq is vital for getting ;; this right. ;; ;; We don't let non-lists leak into the copied property list ;; structures: those appear as empty lists in order not to ;; mess up the data structures. (let* ((newprop (assq-ref newcache (car oldcache))) (oldprop (cddr oldcache))) (if (not (pair? newprop)) (set! newprop '())) (if (eq? newprop oldprop) (cons oldcache newcache) ;; The original nested list has changed, so we need to ;; splice together a new copy based on the newly found ;; current original. (acons (car oldcache) (loop (1- depth) (cadr oldcache) newprop) newcache)))))) (define (updated-context context) "Make sure that the tail of this context corresponds to an updated parent context. If it doesn't, update the tail as well as all copies to nested properties in this context's alist. Returns a valid cache alist." (if context (let ((tail (updated-context (car context)))) (if (not (eq? (cdddr context) tail)) (begin (set-cdr! (cddr context) tail) (set-car! (cddr context) (fold-right updatecache tail (cadr context) (caddr context))))) (caddr context)) '())) (define (get-property context . property-path) (fold (lambda (a b) (let ((found (assq a b))) (if found (cdr found) '()))) (updated-context context) property-path)) (define (push-property once value context property . property-path) (set-car! (cdr context) (acons once (length property-path) (cadr context))) (set-car! (cddr context) (let loop ((alist (updated-context context)) (property property) (property-path property-path)) (acons property (if (null? property-path) value (loop (let ((ref (assq-ref alist property))) (if (pair? ref) ref '())) (car property-path) (cdr property-path))) alist)))) (define (property-path-match? cache property property-path) (and (eq? (car cache) property) (or (null? property-path) (property-path-match? (cadr cache) (car property-path) (cdr property-path))))) (use-modules (ice-9 receive)) (define (pop-property once context property . property-path) (let* ((depth (length property-path)) (found (list-index (lambda (source cache) (and (eq? once (car source)) (= depth (cdr source)) (property-path-match? cache property property-path))) (cadr context) (updated-context context)))) (if found (begin (receive (head tail) (split-at! (caddr context) found) (set-car! (cddr context) (fold-right updatecache (cdr tail) (cadr context) head))) (receive (head tail) (split-at! (cadr context) found) (set-car! (cdr context) (append! head (cdr tail)))))))) ;; Ok, this is quite too cons-intensive, but you get the drift. We walk ;; the source pairs, throwing away those marked as "once" together ;; with the corresponding cache pairs. An efficient implementation ;; would be careful to keep a common tail so that the lists would not ;; change at all in the absence of "once" overrides. (define (clean-of-once context) (let loop ((sources '()) (caches '()) (source (cadr context)) (cache (updated-context context))) (let ((found (list-index car source))) (if found (receive (shead stail) (split-at! source found) (receive (chead ctail) (split-at! cache found) (loop (cons shead sources) (cons chead caches) (cdr stail) (cdr ctail)))) (if sources (begin (set! sources (concatenate! (reverse! sources))) (set-car! (cddr context) (fold-right updatecache cache sources (concatenate! (reverse! caches)) (set-car! (cdr context) (append! sources source)))))))))) (define-macro (niceeval . explist) (cons 'begin (map (lambda (expr) `(format #t "~s =>~a\n" ',expr (let ((x ,expr)) (if (eq? x (begin)) "" (format #f " ~s" x))))) explist))) (niceeval (define StaffGroup (make-context)) (define Staff (make-context StaffGroup)) (define Voice (make-context Staff)) (push-property #f 3 StaffGroup 'x 'y 'z) (push-property #f '((z . 5)) Voice 'x 'y) (get-property Voice 'x 'y) (get-property Voice 'x) (pop-property #f StaffGroup 'x 'y 'z) (get-property Voice 'x) (push-property #f 7 StaffGroup 'x) (get-property Voice 'x 'y) (get-property Voice 'x) (push-property #f 2 Staff 'x 'y) (get-property Voice) (pop-property #f Voice 'x 'y) (get-property Voice 'x) (push-property #t 13 Voice 'x 'y 'z) (get-property Voice) (clean-of-once Voice) (get-property Voice) )
-- David Kastrup
_______________________________________________ lilypond-devel mailing list lilypond-devel@gnu.org https://lists.gnu.org/mailman/listinfo/lilypond-devel