[CM] with-threaded-sound?

[Kjetil S. Matheussen]

On Fri, 6 Jun 2008, Fernando Lopez-Lezcano wrote:

> On Fri, 2008-06-06 at 07:19 -0700, Bill Schottstaedt wrote:
>> I just realized it's almost trivial to define a with-sound that
>> puts each note in a separate thread:
>
> Hey, that's very interesting... any tests in a multicore machine for
> many notes spread into a few threads? Does this translate into linux
> threads or is this internal to scheme?
>

I wonder if guile is one of the few scheme implementations, 
(maybe  the only one except java-schemes such as SISC and kawa (?)), with 
support for real threads.


> -- Fernando
>
>
>> (defmacro with-threaded-sound (args . body)
>>   `(with-sound-helper (lambda ()
>> 			(for-each
>> 			 (lambda (expr)
>> 			   (call-with-new-thread
>> 			    (lambda ()
>> 			      (eval expr (current-module)))))
>> 			 ',body)
>> 			(let ((us (current-thread)))
>> 			  (for-each
>> 			   (lambda (expr)
>> 			     (if (and (not (thread-exited? expr))
>> 				      (not (eq? expr us)))
>> 				 (join-thread expr)))
>> 			   (all-threads))))
>> 		      , at args))
>>
>> (with-threaded-sound ()
>>   (fm-violin 0 1 440 .1)
>>   (fm-violin 0 1 660 .1))
>>
>>
>> Now to get rid of that "eval"...
>>

I don't know how with-sound-helper works, but maybe
the following is enough?:

(defmacro with-threaded-sound (args . body)
   `(with-sound-helper (lambda ()
                         (begin
                           ,@(map (lambda (expr)
                                    `(call-with-new-thread
                                       (lambda ()
                                         ,expr)))
                                  body))
                         (let ((us (current-thread)))
                           (for-each
                            (lambda (expr)
                              (if (and (not (thread-exited? expr))
                                       (not (eq? expr us)))
                                  (join-thread expr)))
                            (all-threads))))
                       , at args))