转换普通代码为CPS代码

cps.lisp

(defun multinit-list (len init-fn)
  (loop :for i :from 1 :upto len :collect (funcall init-fn)))

(defun split-funcall (form)
  (let ((args (rest form)))
    (values args
	    (let ((argv (multinit-list (length args) #'gensym)))
	      `(lambda ,argv ,(cons (first form) argv))))))

(defun append1 (list obj)
  (append list (list obj)))

(defun cont-trans (form &optional cont)
  (if (every #'atom form)
      (append1 form cont)
      (multiple-value-bind (args k) (split-funcall form)
	(reduce #'(lambda (expr acc)
		    (cont-trans expr acc))
		args :from-end t :initial-value (append1 k cont)))))

(defun continuation-transform (form)
  (cont-trans form 'k))