From mboxrd@z Thu Jan  1 00:00:00 1970
Path: main.gmane.org!not-for-mail
From: Han-Wen Nienhuys  <hanwen@xs4all.nl>
Newsgroups: gmane.lisp.guile.bugs
Subject: bugreport, concise version
Date: Wed, 21 Jan 2004 01:36:24 +0100
Sender: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org
Message-ID: <16397.51592.882068.847986@localhost.localdomain>
Reply-To: hanwen@cs.uu.nl
NNTP-Posting-Host: deer.gmane.org
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Transfer-Encoding: 7bit
X-Trace: sea.gmane.org 1074645443 14153 80.91.224.253 (21 Jan 2004 00:37:23 GMT)
X-Complaints-To: usenet@sea.gmane.org
NNTP-Posting-Date: Wed, 21 Jan 2004 00:37:23 +0000 (UTC)
Original-X-From: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org Wed Jan 21 01:37:13 2004
Return-path: <bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org>
Original-Received: from monty-python.gnu.org ([199.232.76.173])
	by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian))
	id 1Aj6Mq-000294-01
	for <guile-bugs@m.gmane.org>; Wed, 21 Jan 2004 01:37:12 +0100
Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org)
	by monty-python.gnu.org with esmtp (Exim 4.24)
	id 1Aj6LS-0000d0-3v
	for guile-bugs@m.gmane.org; Tue, 20 Jan 2004 19:35:46 -0500
Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.24)
	id 1Aj6LH-0000cl-JP
	for bug-guile@gnu.org; Tue, 20 Jan 2004 19:35:35 -0500
Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.24)
	id 1Aj6Kk-0000YD-4P
	for bug-guile@gnu.org; Tue, 20 Jan 2004 19:35:33 -0500
Original-Received: from [213.84.26.127] (helo=localhost.localdomain)
	by monty-python.gnu.org with esmtp (TLSv1:DES-CBC3-SHA:168)
	(Exim 4.24) id 1Aj6Kj-0000Xu-9x
	for bug-guile@gnu.org; Tue, 20 Jan 2004 19:35:01 -0500
Original-Received: from localhost.localdomain.byrd.xs4all.nl (byrd [127.0.0.1])
	by localhost.localdomain (8.12.10/8.12.10) with ESMTP id i0L0aONj031512
	for <bug-guile@gnu.org>; Wed, 21 Jan 2004 01:36:25 +0100
Original-To: bug-guile@gnu.org
X-Mailer: VM 7.14 under Emacs 21.3.1
X-BeenThere: bug-guile@gnu.org
X-Mailman-Version: 2.1.2
Precedence: list
List-Id: Bug reports for GUILE, GNU's Ubiquitous Extension Language
	<bug-guile.gnu.org>
List-Unsubscribe: <http://mail.gnu.org/mailman/listinfo/bug-guile>,
	<mailto:bug-guile-request@gnu.org?subject=unsubscribe>
List-Archive: <http://mail.gnu.org/pipermail/bug-guile>
List-Post: <mailto:bug-guile@gnu.org>
List-Help: <mailto:bug-guile-request@gnu.org?subject=help>
List-Subscribe: <http://mail.gnu.org/mailman/listinfo/bug-guile>,
	<mailto:bug-guile-request@gnu.org?subject=subscribe>
Errors-To: bug-guile-bounces+guile-bugs=m.gmane.org@gnu.org
Xref: main.gmane.org gmane.lisp.guile.bugs:1111
X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.bugs:1111


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   |   hanwen@xs4all.nl   |   http://www.xs4all.nl/~hanwen 



_______________________________________________
Bug-guile mailing list
Bug-guile@gnu.org
http://mail.gnu.org/mailman/listinfo/bug-guile