call/ccの合成の解

以前の記事 ( call/ccの合成 - 標高+1m )で、やりたかったのはこういうことでした。

たまに便利なことがあると思う。

(define (compose-c/cc . fs)
  (letrec ((vals (list->vector
                  (map (^ (f i)
                          (f (lambda (res)
                               (vector-set! vals i res)
                               (when cont (cont)))))
                             fs
                             (iota (length fs)))))
           (cont #f))
    (call/cc (lambda (k) (set! cont k)))
    (vector->list vals)))

(console-log (apply string-append
                 (compose-c/cc (^ (k) (timer (^ () (k "good")) 3)
                                  "hello ")
                               (^ (k) (timer (^ () (k "bye")) 2)
                                  "world")
                               (^ (k) (timer (^ () (k " :)")) 5)
                                  "!"))))

アップデート Update:

This is better.

(define (compose-c/cc . fs)
  (let* ((is   (iota (length fs)))
         (vals (list->vector (map (^ (x) #f) is)))
         (cont #f))
    (list->vector
     (map (^ (f i)
         (let1 v (call/cc f)
           (vector-set! vals i v)
           (when cont (cont))))
      fs is))
    (call/cc (lambda (k) (set! cont k)))
    (vector->list vals)))