Threaded OR (in PLT Scheme)

ある必要があって、複数のリソースから最初に返答の得られたものを値として採用する、という構文を作ってみました。

実装:

(define-syntax spawn
  (syntax-rules ()
    ((spawn . e)
     (thread (lambda () . e)))))

;; cf: http://scheme.com/tspl4/examples.html#./examples:h11

(define (any-true thunks)
  (let ((cust (make-custodian)))
    (let loop ((engs
                (parameterize ((current-custodian cust))
                  (map (lambda (t)
                         (let ((c (make-channel)))
                           (spawn (channel-put c (t)))
                           (handle-evt c (lambda (v) (or v c)))))
                       thunks))))
      (and (pair? engs)
           (let ((v (apply sync engs)))
             (if (channel? v)
                 (loop (remove v engs))
                 (begin (custodian-shutdown-all cust)
                        v)))))))

(define-syntax por                      ;paralell or
  (syntax-rules ()
    ((por e ...)
     (any-true (list (lambda () e) ...)))))

書いている時は意識しなかったんですが、TSPL の「エンジン」の例で出てくる por という構文とそっくりだったので、そのようにリネームしました。

(sync evt ...)

で最も反応の早かったイベント (の値) が得られるんですが、それが #f だった場合は他のイベントを待つ必要があります。そのために handle-evt という関数で、値が #f の時は値でなくイベント自体を返すように工夫をしています。

例:

;; Don't try this at home ;-)
> (por ((lambda (x) (x x)) (lambda (x) (x x)))
       (begin (sleep (expt 2 32)) 1))
1