CL's tagbody in clojure

goto.clj

(ns goto)

(defmacro tagbody [& forms]
  (let [start (gensym)]
    (loop [binds []
           point start
           forms forms]
      (let [[body [jump & forms]] (split-with (complement symbol?) forms)
            binds (conj binds `(~point [] ~@body ~jump))]
        (if jump
          (recur binds jump forms)
          `(letfn ~binds
             (loop [curr# ~start]
               (when curr#
                 (recur
                   (try (curr#)
                        (catch Exception e#
                          (or (-> e# ex-data ::point) (throw e#)))))))))))))

(defn go [point]
  (throw (ex-info "Illegal jump." {::point point})))

(comment
  (let [val (atom nil)]
    (tagbody
      (reset! val 1)
      (go point-a)
      (swap! val + 16)
      point-c
      (swap! val + 4)
      (go point-b)
      (swap! val + 32)
      point-a
      (swap! val + 2)
      (go point-c)
      (swap! val + 64)
      point-b
      (swap! val + 8))
    @val)

  (defn f2 [flag escape]
    (if flag (escape) 2))

  (defn f1 [flag]
    (let [n (atom 1)]
      (tagbody
        (reset! n (f2 flag #(go out)))
        out
        (prn @n))))

  (f1 false)
  (f1 true))