;;; ======================================================================
;;; SRFI 195 - Multiple-value boxes
;;; ======================================================================

(require "srfi-1")
(define (fold* kons* knil* clist . clist*)
  (unbox (apply fold
                (lambda args
                  (call-with-values (lambda () (apply kons* args)) box))
                knil*
                clist
                clist*)))
(test "example in SRFI 195"
      '((5 4 3 2 1) 5)
      (let-values (((a b)
                    (fold* (lambda (e b)
                             (receive (lis n) (unbox b)
                               (values (cons e lis) (+ 1 n))))
                           (box '() 0) '(1 2 3 4 5))))
        (list a b)))

(define (box->list b)
  (call-with-values (lambda () (unbox b)) list))

(let ((b1 (box 1 2 3))
      (b2 (box 'a 'b 'c '(d e f)))
      (b3 (apply box (features)))
      (b4 (box "a" "b" "c")))
  (test "box-arity.1" 3 (box-arity b1))
  (test "box-arity.2" 4 (box-arity b2))
  (test "unbox.1"
        '(1 2 3)
        (box->list b1))
  (test "unbox.2"
        (features)
        (box->list b3))
  (test "box-set!.1"
        '(x y z)
        (let ()
          (box-set! b1 'x 'y 'z)
          (box->list b1)))
  (test "box-set!.2"
        '("a" "b" "c")
        (let ()
          (apply box-set! b1 (box->list b4))
          (box->list b1)))
  (test "unbox-value"
        10
        (let ((x (box 2 6 8 0)))
          (+ (unbox-value x 0)
             (unbox-value x 2))))
  (test "set-box-value!"
        '(10 (10 6 0 0))
        (let ((x (box 2 6 8 0)))
          (set-box-value! x 0 10)
          (set-box-value! x 2 0)
          (list (+ (unbox-value x 0)
                   (unbox-value x 2))
                (box->list x)))))



