call/cc in Common Lisp

gistfile1.lisp

(defmacro defcont (name (&rest params) &body body)
  (let ((result (gensym)))
    `(defun ,name (continuation ,@params)
       (let ((,result ,@body))
         (funcall continuation ,result)))))

(defun call/cc (continuation fun)
  (funcall fun continuation))


(defcont multiply (&rest args)
  (apply #'* args))

(defcont add (&rest args)
  (apply #'+ args))

;; (* 3 (+ 1 2))
;; (funcall #'add (lambda (r) (funcall #'multiply #'identity r 3)) 1 2)
;; (add (lambda (r) (multiply #'identity r 3)) 1 2)

(call/cc (lambda (r) (+ r 10)) (lambda (cont) (funcall cont 11)))
(call/cc (lambda (r) (+ r 10)) (lambda (cont) 11))

(defvar return nil)

(call/cc (lambda (r) (+ 1 r))
         (lambda (cont)
           (setf return cont)
           1))