bugreport, concise version

[Han-Wen Nienhuys]

Hi guys,

I consider this a very severe bug. Can you fix this please?


byrd:~/usr/src/lilypond$ guile -l scm/bla.scm
Backtrace:
In unknown file:
   ?: 0* [primitive-load "scm/bla.scm"]
In scm/bla.scm:
 107: 1* [determine-split-list #((1 . 2) (3 . 4)) #((1 . 2) (3 . 4))]
In unknown file:
   ?: 2  Segmentatie fout



bla.scm :


(define ly:moment<? <)

(define-public (determine-split-list ev1 ev2)
  (define (when v i)
    (car (vector-ref v i)))
  (define (what v i)
    (cdr (vector-ref v i)))

  (define chord-threshold 8)

  (define result
    (list->vector
     (map (lambda (x)
            (cons x 'together))
          (merge (map car ev1) (map car ev2) ly:moment<?))))

  (define (analyse-events i1 i2 ri
                          active1
                          active2)

    (define (analyse-span-event active ev)
      (let*
          ((name (ly:get-mus-property ev 'name))
           (key (cond
                 ((equal? name 'SlurEvent) 'slur)
                 ((equal? name 'TieEvent) 'tie)
                 ((equal? name 'Beam) 'beam)
                 (else #f)))
           (sp (ly:get-mus-property span-direction ev)))

        (if (and (symbol? key) (ly:dir? sp))
            ((if (= sp STOP) delete! cons) key active))
        ))       

    (define (put x)
      (set-what (whatever result ri) x))

    (cond
     ((= i1 (vector-length ev1)) (put 'apart))
     ((= i2 (vector-length ev2)) (put 'apart))
     (else
      (let*
          ((m1 (when ev1 i1))
           (m2 (when ev2 i2)))

        (if (not (or (equal? m1 (when result ri))
                     (equal? m2 (when result ri))))
            (scm-error boem))

        (set! active1
              (sort
               (map (lambda (x) (analyse-span-event active1 x))
                    (what ev1 i1)) symbol<?))
        (set! active2
              (sort (map (lambda (x) (analyse-span-event active2 x))
                         (what ev2 i2)) symbol<?))
        
        (cond
         ((ly:moment<? m1 m2)
          (put 'apart)
          (analyse-events (1+ i1) i2 (1+ ri) active1 active2))
         ((ly:moment<? m2 m1)
          (put 'apart)
          (analyse-events i1 (1+ i2) (1+ ri) active1 active2))
         (else
          (if (not (equal? active1 active2))
              (put 'apart)

              (let*
                  ((notes1 (get-note-evs ev1 i1))
                   (pitches1 (sort
                              (map (lambda (x) (ly:get-mus-property x 'pitch)) 
notes1) ly:pitch<?))
                   (notes2 (get-note-evs ev2 i2))
                   (pitches2 (sort
                              (map (lambda (x) (ly:get-mus-property x 'pitch)) 
notes2) ly:pitch<?))
                   )
                (cond
                 ((equal? pitches1 pitches2) (put 'unisono))
                 ((> (length notes1) 1) (put 'apart))
                 ((> (length notes2) 1) (put 'apart))
                 (else
                  (let* ((dif (ly:pitch-diff (car pitches1) (car pitches1))))
                    (if (< (ly:pitch-steps diff) chord-threshold)
                        (put 'chords)
                        (put 'apart))
                    ))))
              ))
         (analyse-events (1+ i1) (1+ i2) (1+ ri) active1 active2)
         )))))


  
  (set! ev1 (list->vector ev1))
  (set! ev2 (list->vector ev2))

  
  (analyse-events 0 0  0 '() '())

  (display result)
  )



(determine-split-list '((1 . 2) (3 . 4)) '((1 . 2) (3 . 4)))



-- 

 Han-Wen Nienhuys   |   address@hidden   |   http://www.xs4all.nl/~hanwen