]> git.donarmstrong.com Git - lilypond.git/commitdiff
Issue 5079/2: with-music-match: lists should match completely
authorDavid Kastrup <dak@gnu.org>
Tue, 28 Feb 2017 23:33:51 +0000 (00:33 +0100)
committerDavid Kastrup <dak@gnu.org>
Tue, 7 Mar 2017 12:36:55 +0000 (13:36 +0100)
Previously music properties that were matched to a list of wildcards
could contain fewer elements than the list they were matched to,
leading to an error when the wildcard variable was being assigned to.

Now the list lengths have to be matched exactly: a shorter pattern
than the actual list length of the matched property cannot match any
more.

scm/display-lily.scm

index 6a53f1eded020df0ef754212fe4ac49fcdee5add..b5a7cff139c58dfca945397ebfff5d7283f327ff 100644 (file)
@@ -190,20 +190,18 @@ match thoses described in `pattern'."
       ;; build the test conditions for each element found in a (property . (e1 e2 ...)) pair.
       ;; this requires accessing to an element of a list, hence the index.
       ;; (typically, property will be 'elements)
-      ,@(map (lambda (prop-elements)
-               (let ((ges (gensym))
-                     (index -1))
-                 `(and ,@(map (lambda (e)
-                                (set! index (1+ index))
-                                (if (music? e)
-                                    (gen-condition `(and (> (length (ly:music-property ,expr ',(car prop-elements)))
-                                                            ,index)
-                                                         (list-ref (ly:music-property ,expr ',(car prop-elements))
-                                                                   ,index))
-                                                   e)
-                                    #t))
-                              (cdr prop-elements)))))
-             elements-list))))
+      ,@(map
+         (lambda (prop-elements)
+           (let ((ges (gensym))
+                 (len (length (cdr prop-elements))))
+             `(let ((,ges (ly:music-property ,expr ',(car prop-elements))))
+                (and (eqv? (length+ ,ges) ,len)
+                     ,@(filter-map
+                        (lambda (e index)
+                          (and (music? e)
+                               (gen-condition `(list-ref ,ges ,index) e)))
+                        (cdr prop-elements) (iota len))))))
+         elements-list))))
 
 (define (gen-bindings expr pattern)
   "Helper function for `with-music-match'.
@@ -269,10 +267,9 @@ inside body."
         (pattern (second music-expr+pattern))
         (expr-sym (gensym)))
     `(let ((,expr-sym ,music-expr))
-       (if ,(gen-condition expr-sym pattern)
-           (let ,(gen-bindings expr-sym pattern)
-             ,@body)
-           #f))))
+       (and ,(gen-condition expr-sym pattern)
+            (let ,(gen-bindings expr-sym pattern)
+              ,@body)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;