将普通的函数调用表达式变换为更具过程式味道的代码

compile-cps.lisp

(defpackage :com.lt.compile-cps
  (:use :cl)
  (:export :compile-cps))

(in-package :com.lt.compile-cps)

;;; 当且仅当expr为括号表达式，并且第一个符号为应用于CPS的变体，即符号名字符串的最后一个字符为&时
;;; 才为真。
(defun cpsed-p (expr)
  "Return non-nil if the EXPR has been processed by function CONT-TRANS defined
 in package :com.lt.cont-trans."
  (let ((sym (symbol-name (first expr))))
    (char= #\& (char sym (1- (length sym))))))

;;; 参数是用于CPS的变换过的函数名，即symbol-name字符串的最后字符为&的符号。这个函数会得到这个函
;;; 数名原来的符号，即去掉了末尾的&的符号。
(defun uncpsed-symbol (sym)
  (let ((name (symbol-name sym)))
    (values
     (intern (subseq name 0 (1- (length name)))))))

(defun lambda-arg (expr) (caadr expr))

(defun comp-assign (expr)
  (let ((op (uncpsed-symbol (first expr)))
	(args (cdr (butlast expr)))
	(var (lambda-arg (car (last expr)))))
    `(setf ,var ,(cons op args))))

(defun cont-body (expr)
  (third (car (last expr))))

(defun compile-cps/report (expr)
  (cond ((cpsed-p expr)
	 (format t "~&~A" (comp-assign expr)) ;如果是CPS代码，那么必然有一个续延，因此找
					;出这个续延所使用的参数就可以和非续延的部分连接成
					;一个赋值表达式，然后进行输出。
	 (compile-cps/report (cont-body expr)))
	(t (format t "~&~A" expr))))

(defun compile-cps (expr)
  (let (forms)
    (labels ((aux (expr)
	       (cond ((cpsed-p expr)
		      (push (comp-assign expr) forms)
		      (aux (cont-body expr)))
		     (t (push expr forms)))))
      (cons 'progn (nreverse (aux expr))))))