CPS conversion

cps.scm

;; expression must already be expanded by expander
;; so it shall only have the following syntaxes:
;;  - define
;;  - lambda
;;  - set!
;;  - quote
;;  - if
;;  - begin
;; NB: by this point, all of the optimisation in Scheme level
;;     must be done. (e.g. constant folding) 
;;
;; reference:
;;   Programming Languages, Application and Interpretation
;;   Chapter 14.2 Continuation-Passing Style
(define (cps e)
  (if (pair? e)
      (case (car e)
	((define) `(define ,(cadr e) (,(cps (caddr e)) values)))
	((quote) `(lambda (k) (k ',(cadr e))))
	((set!) 
	 `(lambda (k) (,(cps (caddr e)) (lambda (ev) (k (set! ,(cadr e) ev))))))
	((begin)
	 `(lambda (k)
	    (,(cps (cadr e))
	     ,(let loop ((e* (cddr e)))
		(if (null? e*)
		    'k
		    `(lambda (_) (,(cps (car e*)) ,(loop (cdr e*)))))))))
	((if)
	 `(lambda (k)
	    (,(cps (cadr e))
	     (lambda (p)
	       (if p
		   (,(cps (caddr e)) k)
		   ,(if (null? (cdddr e))
			`(undefined/cps k)
			`(,(cps (cadddr e)) k)))))))
	((lambda)
	 (let ((formals (cadr e))
	       (body    (cddr e)))
	   `(lambda (k)
	      (k (lambda (nk . ,formals)
		   (,(cps (cons 'begin body)) nk))))))
		 
	;; procedure call
	(else 
	 `(lambda (k) 
	    (,(cps (car e))
	     (lambda (fv) 
	       ,(let loop ((i 0) (args '()) (e* (cdr e)))
		  (if (null? e*)
		      ;; if fv is one of the builtin procedures then
		      ;; use the following
		      ;;`(k (fv ,@(reverse args)))
		      `(fv k ,@(reverse args))
		      (let ((a (string->symbol 
				(string-append "a" (number->string i)))))
			`(,(cps (car e*))
			  (lambda (,a)
			    ,(loop (+ i 1) (cons a args) (cdr e*))))))))))))
      `(lambda (k) (k ,e))))