delimited continuations with cloroutine

conts.clj

(ns cloroutine.conts
  (:require [clojure.test :refer :all]
            [cloroutine.core :refer [cr]]))

;; I'm trying to port code from https://en.wikipedia.org/wiki/Delimited_continuation
;; using delimited continuations cloroutine's implementation

(def ^:dynamic *coroutine*)
(def ^:dynamic *result*)

(defn run [c]
  (binding [*coroutine* c] (c)))

(defn fork [c x]
  (binding [*result* x] (c run)))

;; first tweak, renames the original shift function to shift-fn
;; in order to keep the shift identifier free to hold the same semantics as in the article
(defn shift-fn [f & args]
  (apply f (partial fork *coroutine*) args))

;; here it is, we are just binding the continuation to the given symbol using a lambda
(defmacro shift [ksym & body]
  `(shift-fn (fn [~ksym] ~@body)))

(defn thunk [] *result*)

(defmacro reset [& body]
  `(run (cr {shift-fn thunk}
            ~@body)))

;; code from wiki:

(* 2 (reset (+ 1 (shift k (k 5)))))
;; => 12

(reset (* 2 (shift k (k (k 4)))))
;; => 16

(reset
  (shift k (cons 1 (k ()))))
;=> (1)

(reset
  (shift k (cons 1 (k ())))
  (shift k (cons 2 (k ()))))
;;=> (1 2)

(defn yield [x] (shift k (cons x (k ()))))

;; this will throw a stackoverflow error
'(reset (yield 1)
        (yield 2)
        (yield 3))

;; in order to make it work we have to patch reset

(defmacro reset' [& body]
  `(run (cr {shift-fn thunk
             yield thunk} ;; <- here
            ~@body)))

;; and now it works
(reset' (yield 1)
        (yield 2)
        (yield 3))

;; it looks that when shift is nested in a function call it has to be add in the first argument given to cr
;; we can imagine this workaround to avoid redifining reset each time
;; it does not look optimal and I think i must miss something here...

(def reset-mappings (atom `{shift-fn thunk}))

(defmacro reset'' [& body]
  `(run (cr ~(deref reset-mappings)
            ~@body)))

(defmacro defshift [name & body]
  (swap! reset-mappings assoc name `thunk)
  `(defn ~name ~@body))

;; but it seems to work

(defshift yield' [x] (shift k (cons x (k ()))))

(reset'' (yield' 1)
         (yield' 2)
         (yield' 3))