Skip to content

Instantly share code, notes, and snippets.

@Liutos
Created July 20, 2012 02:37
Show Gist options
  • Save Liutos/3148312 to your computer and use it in GitHub Desktop.
Save Liutos/3148312 to your computer and use it in GitHub Desktop.
实现了对非CPS的普通函数调用进行转换生成对应的CPS代码的函数cont-trans
(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)))))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment