haskeem-0.7.5: cpm.scm

; Copyright 2009 Uwe Hollerbach <uh@alumni.caltech.edu>
; $Id: cpm.scm,v 1.1 2009-06-29 03:59:41 uwe Exp $
; BSD3

; Continuation-passing macros in the style of "On Lisp" by Paul Graham;
; but the syntax is scheme (well, scheme - call/cc) and any mistakes or
; misunderstandings are mine, mine, all mine!

; Define the continuation variable which gets passed around (and overridden),
; initially just set to the identity, the default top-level continuation.

(define *cont* (lambda (val) val))

; Define the CPS analog of (lambda): the same as (lambda), just with the
; extra continuation argument glued into place.

(defmacro (=lambda params . body)
  (if (symbol? params)
      `(lambda (*cont* . ,params) ,@body)
      `(lambda (*cont* ,@params) ,@body)))

; Define the CPS analog of (apply): the same as apply, just add in the extra
; continuation argument

(defmacro (=apply fn . args)
  `(apply ,fn *cont* ,@args))

; Define the "return a value" macro: instead of actually returning, this
; applies the current continuation to the specified value. I'm not bothering
; with multiple-value return right now, since haskeem only does one value
; at a time.

(defmacro (=return val)
  `(*cont* ,val))

; Define the CPS analog of (define): define a macro that looks like
; the function without the continuation argument, and define the
; function using a generated symbol with the continuation argument.

; This only does the (define (foo args) body) version so far, check
; for (symbol? formals) to capture the (define foo <stuff>) version;
; or just disallow that usage: it's captured above by the =lambda
; stuff.

; NOTE: if it's desirable to (trace) the function, it has to be done
; here inside the (=define) macro, inside each (begin) after the
; (define (,ifn ...) ...). Otherwise, it's tricky to get at it.

(defmacro (=define formals . body)
  (let ((ifn (new-symbol))
	(fn (car formals))
	(args (cdr formals)))
    (if (symbol? args)
	`(begin (defmacro ,formals (,ifn *cont* . ,args))
		(define (,ifn *cont* . ,args) ,@body))
	`(begin (defmacro ,formals (,ifn *cont* ,@args))
		(define (,ifn *cont* ,@args) ,@body)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Test stuff

; Expect to see this print "5"

(define foo (=lambda (x) (=return (+ 1 x))))
(display (foo *cont* 4))
(newline)

; This should print "10"

(let ((*cont* (lambda (x) (* 2 x))))
  (display (foo *cont* 4))
  (newline))

; This should print "14": the function says to add 10 to the value passed
; in, and the current continuation, which is the default identity, is then
; applied to that value: 4 + 10 -> identity -> 14

(=define (bar x) (=return (+ 10 x)))
(display (bar 4))
(newline)

; Expect to see this print... "15"? the function again adds 10 to what's
; passed in, but here the current continuation has been re-jiggered to
; add 1 to what it receives: 4 + 10 -> 14 -> (+1) -> 15.
; In

(let ((*cont* (lambda (x) (+ 1 x))))
  (display (bar 4))
  (newline))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; explicit CPS conversion of fibonacci function:

(define (fib-no n)
  (if (< n 2)
      1
      (+ (fib-no (- n 1))
	 (fib-no (- n 2)))))

; becomes

(define (fib-cps k n)
  (if (< n 2)
      (k 1)
      (fib-cps (lambda (fib-of-n-1)
		 (fib-cps (lambda (fib-of-n-2)
			    (k (+ fib-of-n-1 fib-of-n-2)))
			  (- n 2)))
	       (- n 1))))

; and a wrapper which just passes in the identity function as the continuation

(define (fib-yes n) (fib-cps (lambda (x) x) n))