实现了对非CPS的普通函数调用进行转换生成对应的CPS代码的函数cont-trans

cont-trans.lisp

(defpackage :cps
  (:use :cl))

(in-package :cps)

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

(defun cps-symbol (op)
  (intern (format nil "~S&" op)))

(defun split-funcall (form)
  (labels ((aux (expr args)
	     (cond
	       ((null args) (values nil expr))
	       ((atom (first args))
		(aux (append1 expr (first args)) (rest args)))
	       (t (let ((id (gensym)))
		    (values
		     (first args)
		     `(lambda (,id)
			,(append expr (cons id (rest args))))))))))
    (aux (list (first form)) (rest form))))

(defun cont-trans (expr &optional (cont (let ((id (gensym)))
					  `(lambda (,id) (print ,id)))))
  (if (every #'atom expr)
      (append1 (cons (cps-symbol (car expr))
		     (cdr expr)) cont)
      (multiple-value-bind (subexpr k)
	  (split-funcall expr)
	(cont-trans subexpr
		    (destructuring-bind (l args body) k
		      `(,l ,args ,(cont-trans body cont)))))))