The (aux continuation) module

Call with current continuation: the letcc macro

The fundamental macro letcc in the form

(letcc k body ...)
binds k to the current continuation [1][2][3][4] in body... expressions; for the sake of clarity, it expands to
(continuation-capture
  (λ (cont) (let1 (k (λ (arg) (continuation-return cont arg))) body ...)))
where continuation-capture and continuation-return are defined in [5] and based on [6] by Marc Feeley, respectively.

test/letcc/multiarg: pass

(define (test/letcc/multiarg _) (⊦= 'a (letcc k (k 'a))))
((eta 0.001) (memory #(6291456 2048024 1048576)) (stdout "") (stderr ""))

test/letcc*: pass

The frame in [7] is of inspiration of the letcc* macro.

(continuation-capture
  (λ (cont)
      (let1 (success (λ (arg) (continuation-return cont arg)))
            (let* ((v (letcc ⤶ (success (begin vexpr)))) (⤶ success))
              body
              ...))))
(define (test/letcc* _)
  (⊦= '(1) (letcc* ⤶ ((v (cons 1 '())) (w (cons 2 v))) (cons 4 w)))
  (⊦= '(2 1)
        (letcc* ⤶ ((v (cons 1 (⤶ '(1)))) (w (cons 2 v))) (cons 4 w)))
  (⊦= '(4 3 1)
        (letcc*
          ⤶
          ((v (cons 1 (⤶ '(1)))) (w (cons 2 (⤶ (cons 3 v)))))
          (cons 4 w)))
  (⊦= '(1 2) (letcc* ⤶ ((v (cons 3 (⤶ '(2))))) (cons 1 v)))
  (⊦= '(3 2) (letcc* ⤶ ((v (cons 1 (⤶ '(2))))) (⤶ (cons 3 v))))
  (⊦= '(2) (letcc* ⤶ ((v (cons 3 (⤶ '(2))))) (cons 1 (⤶ v))))
  (⊦= '(4 2)
        (letcc* ⤶ ((v (cons 3 (⤶ '(2))))) (cons 1 (⤶ (cons 4 v))))))
((eta 0.0) (memory #(6291456 2050136 1048576)) (stdout "") (stderr ""))

test/trycc: pass

(define (test/trycc _)
  (⊦= 5 (trycc (✗ (+ 1 (✗)) (+ 2 3)) (else (cons 3 '()))))
  (⊦= 3 (trycc (✗ (+ 1 2) (+ 2 (✗))) (else (cons 3 '()))))
  (⊦= '(3) (trycc (✗ (+ 1 (✗)) (+ 2 (✗))) (else (cons 3 '())))))
((eta 0.0) (memory #(6291456 2051176 1048576)) (stdout "") (stderr ""))

test/letcc/dfs: pass

(define (test/letcc/dfs _)
  (define t1 '(a (b (d h)) (c e (f i) g)))
  (define t2 '(1 (2 (3 6 7) 4 5)))
  (letrec ((*saved* '())
           (col '())
           (witness (gensym))
           (dft-node
             (lambda (tree)
               (cond ((null? tree) (restart))
                     ((not (pair? tree)) tree)
                     (else
                      (letcc cc
                             (push! (τ (cc (dft-node (cdr tree)))) *saved*)
                             (dft-node (car tree)))))))
           (restart
             (τ (if (null? *saved*)
                   witness
                   (let1 (cont (pop! *saved*)) (cont)))))
           (dft-comb
             (lambda (another)
               (lambda (tree)
                 (let1 (node1 (dft-node tree))
                       (if (eq? node1 witness)
                         witness
                         (list node1 (dft-node another)))))))
           (dft2 (lambda (v)
                   (if (eq? v witness)
                     (reverse col)
                     (begin (push! v col) (restart))))))
    (⊦= '(a b d h c e f i g) (dft2 (dft-node t1)))
    (set! col '())
    (⊦= '((a 1)
            (a 2)
            (a 3)
            (a 6)
            (a 7)
            (a 4)
            (a 5)
            (b 1)
            (b 2)
            (b 3)
            (b 6)
            (b 7)
            (b 4)
            (b 5)
            (d 1)
            (d 2)
            (d 3)
            (d 6)
            (d 7)
            (d 4)
            (d 5)
            (h 1)
            (h 2)
            (h 3)
            (h 6)
            (h 7)
            (h 4)
            (h 5)
            (c 1)
            (c 2)
            (c 3)
            (c 6)
            (c 7)
            (c 4)
            (c 5)
            (e 1)
            (e 2)
            (e 3)
            (e 6)
            (e 7)
            (e 4)
            (e 5)
            (f 1)
            (f 2)
            (f 3)
            (f 6)
            (f 7)
            (f 4)
            (f 5)
            (i 1)
            (i 2)
            (i 3)
            (i 6)
            (i 7)
            (i 4)
            (i 5)
            (g 1)
            (g 2)
            (g 3)
            (g 6)
            (g 7)
            (g 4)
            (g 5))
          (dft2 ((dft-comb t2) t1)))))
((eta 0.001) (memory #(6291456 2060088 1048576)) (stdout "") (stderr ""))

See also