Skip to content

Instantly share code, notes, and snippets.

@Liutos
Created July 20, 2012 03:27
Show Gist options
  • Save Liutos/3148472 to your computer and use it in GitHub Desktop.
Save Liutos/3148472 to your computer and use it in GitHub Desktop.
将普通的函数调用表达式变换为更具过程式味道的代码
(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))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment