(defmacro pure% [v]
  `(fn [k# except# state#]
     (try
       (let [r# ~v]
         (fn [] (k# r# state#)))
       (catch Throwable t#
         (fn [] (except# t# state#))))))

(defn bind% [m g]
  (fn [k except state]
    (m (fn [r state] ((g r) k except state))
       except
       state)))

(defn tramp [x] (if (fn? x) (recur (x)) x))

(defn unroll-tramp [x] (if (fn? x) #(unroll-tramp (x)) x))

(defn async% [f]
  (fn x [k except state]
    (let [done (atom false)]
      (f (fn g [value]
           (when (compare-and-set! done false true)
             ((::exec state) k value state)))))))

(defmacro let% [bindings body]
  (if (seq bindings)
    (let [[name value & bindings] bindings]
      `(bind ~value (fn [~name] (let% [~@bindings] ~body))))
    body))

(defn alter-state% [f & args]
  (fn [k except state]
    (k state (apply f state args))))

(defn except% [c h]
  (fn [k except state]
    (c k
       (fn [t state] ((h t) k except state))
       state)))

(defn run
  ([computation]
   (run tramp computation))
  ([tramp computation]
   (tramp
    (computation
     (fn [value state] value)
     (fn [value state] value)
     {::exec (fn [k value state] (unroll-tramp (k value state)))}))))

(run
  (let% [_ (pure% (println 'A))
         r (async% (fn [f] (f "Hello World")))
         _ (pure% (println 'B))]
    (pure% (println r))))

Generated At 2023-10-17T09:43:30-0700 original