cont.clj

;; Paul Grahams Continuation Code in Clojure 
(def *cont* identity)

(defmacro =fn [parms & body]
  `(fn [~'*cont* ~@parms] ~@body))

(defmacro =defn [fn-name parms & body]
  (let [f (symbol (str "=" fn-name))]
    `(do
       (defmacro ~fn-name ~parms
	 `(~'~f ~'~'*cont* ~~@parms))
       (defn ~f [~'*cont* ~@parms] ~@body))))

;; means we need a code walker looking for binding expressions
(defmacro =bind [parms expr & body]
  `(let [~'*cont* (fn [~@parms] ~@body)]
     ~expr))

(defmacro =values [& retvals]
  `(~'*cont* ~@retvals))

;; First Example
(=defn add1 [x] (=values (inc x)))
(add1 1)

;; Second Example
(=defn message [] (=values 'hello 'there))

(=defn baz []
  (=bind (m n) (message)
    (=values (list m n))))

(baz)

;; Tree Example

(def t1 '(a (b (d h)) (c e (f i) g)))
(def t2 '(1 (2 (3 6 7) 4 5)))

;; Regular version, stack consuming

(defn dft [tree]
  (cond 
    (not (seq? tree)) (print tree)
    (nil? (seq tree)) nil
    :else (do (dft (first tree))
	      (dft (rest tree)))))

;; Simple Continuations version

(def *saved* (atom nil))

(=defn restart []
  (if-let [k (first @*saved*)]
    (do 
      (swap! *saved* pop)
      (k)))
  (=values 'done))

(=defn dft-node [tree]
  (cond 
    (not (seq? tree)) (=values tree)
    (nil? (seq tree)) (restart)
    :else (do
	    (swap! *saved* conj (fn [] (dft-node (rest tree))))
	    (dft-node (first tree)))))

(=defn dft2 [tree]
  (reset! *saved* nil) 
  (=bind (node) (dft-node tree)
    (cond 
      (= node 'done) (=values nil)
      :else (do
	      (print node)
	      (restart)))))

(dft2 t1)