let (clj)

(ns clojure.test-clojure.server
    (:import java.util.Random)
    (:require [clojure.test :refer :all])
    (:require [clojure.core.server :as s]))

(defn create-random-thread
  []
  (Thread.
    (fn []
      (let [random (new Random)]
      (while (not (.isInterrupted (Thread/currentThread)))
        (System/setProperty (Integer/toString (.nextInt random)) (Integer/toString (.nextInt random))))))))

(deftest test-parse-props
  (let [thread (create-random-thread)]
    (.start thread)
    (Thread/sleep 1000)
    (try
      (is (>= (count
        (#'s/parse-props (System/getProperties))) 0))
      (finally (.interrupt thread)))))

(ns clojure.test-clojure.reducers
  (:require [clojure.core.reducers :as r]
            [clojure.test.generative :refer (defspec)]
            [clojure.data.generators :as gen])
  (:use clojure.test))

(defmacro defequivtest
  ;; f is the core fn, r is the reducers equivalent, rt is the reducible ->
  ;; coll transformer
  [name [f r rt] fns]
  `(deftest ~name
     (let [c# (range -100 1000)]
       (doseq [fn# ~fns]
         (is (= (~f fn# c#)
                (~rt (~r fn# c#))))))))


(deftest test-sorted-maps
  (let [m (into (sorted-map)
                '{1 a, 2 b, 3 c, 4 d})]
    (is (= "1a2b3c4d" (reduce-kv str "" m))
        "Sorted maps should reduce-kv in sorted order")
    (is (= 1 (reduce-kv (fn [acc k v]
                          (reduced (+ acc k)))
                        0 m))
        "Sorted maps should stop reduction when asked")))

(defspec reduced-always-returns
  (fn [probe to-end]
    (let [len (+ probe to-end 1)
          nums (range len)
          m (zipmap nums nums)]
      (reduced-at-probe m probe)))
  [^{:tag `gen-num} probe ^{:tag `gen-num} to-end]
  (assert (= :foo %)))

(deftest test-fold-runtime-exception
  (is (thrown? IndexOutOfBoundsException
               (let [test-map-count 1234
                     k-fail (rand-int test-map-count)]
                 (r/fold (fn ([])
                           ([ret [k v]])
                           ([ret k v] (when (= k k-fail)
                                        (throw (IndexOutOfBoundsException.)))))
                         (zipmap (range test-map-count) (repeat :dummy)))))))

(deftest division
  (is (= clojure.core// /))
  (binding [*ns* *ns*]
    (eval '(do (ns foo
                 (:require [clojure.core :as bar])
                 (:use [clojure.test]))
               (is (= clojure.core// bar//))))))

(deftest Instants
  (testing "Instants are read as java.util.Date by default"
    (is (= java.util.Date (class #inst "2010-11-12T13:14:15.666"))))
  (let [s "#inst \"2010-11-12T13:14:15.666-06:00\""]
    (binding [*data-readers* {'inst read-instant-date}]
      (testing "read-instant-date produces java.util.Date"
        (is (= java.util.Date (class (read-string s)))))
      (testing "java.util.Date instants round-trips"
        (is (= (-> s read-string)
               (-> s read-string pr-str read-string))))
      (testing "java.util.Date instants round-trip throughout the year"
        (doseq [month (range 1 13) day (range 1 29) hour (range 1 23)]
          (let [s (format "#inst \"2010-%02d-%02dT%02d:14:15.666-06:00\"" month day hour)]
            (is (= (-> s read-string)
                   (-> s read-string pr-str read-string))))))
      (testing "java.util.Date handling DST in time zones"
        (let [dtz (TimeZone/getDefault)]
          (try
            ;; A timezone with DST in effect during 2010-11-12
            (TimeZone/setDefault (TimeZone/getTimeZone "Australia/Sydney"))
            (is (= (-> s read-string)
                   (-> s read-string pr-str read-string)))
            (finally (TimeZone/setDefault dtz)))))
      (testing "java.util.Date should always print in UTC"
        (let [d (read-string s)
              pstr (print-str d)
              len (.length pstr)]
          (is (= (subs pstr (- len 7)) "-00:00\"")))))
    (binding [*data-readers* {'inst read-instant-calendar}]
      (testing "read-instant-calendar produces java.util.Calendar"
        (is (instance? java.util.Calendar (read-string s))))
      (testing "java.util.Calendar round-trips"
        (is (= (-> s read-string)
               (-> s read-string pr-str read-string))))
      (testing "java.util.Calendar remembers timezone in literal"
        (is (= "#inst \"2010-11-12T13:14:15.666-06:00\""
               (-> s read-string pr-str)))
        (is (= (-> s read-string)
               (-> s read-string pr-str read-string))))
      (testing "java.util.Calendar preserves milliseconds"
        (is (= 666 (-> s read-string
                       (.get java.util.Calendar/MILLISECOND)))))))
  (let [s "#inst \"2010-11-12T13:14:15.123456789\""
        s2 "#inst \"2010-11-12T13:14:15.123\""
        s3 "#inst \"2010-11-12T13:14:15.123456789123\""]
    (binding [*data-readers* {'inst read-instant-timestamp}]
      (testing "read-instant-timestamp produces java.sql.Timestamp"
        (is (= java.sql.Timestamp (class (read-string s)))))
      (testing "java.sql.Timestamp preserves nanoseconds"
        (is (= 123456789 (-> s read-string .getNanos)))
        (is (= 123456789 (-> s read-string pr-str read-string .getNanos)))
        ;; truncate at nanos for s3
        (is (= 123456789 (-> s3 read-string pr-str read-string .getNanos))))
      (testing "java.sql.Timestamp should compare nanos"
        (is (= (read-string s) (read-string s3)))
        (is (not= (read-string s) (read-string s2)))))
    (binding [*data-readers* {'inst read-instant-date}]
      (testing "read-instant-date should truncate at milliseconds"
        (is (= (read-string s) (read-string s2) (read-string s3))))))
  (let [s "#inst \"2010-11-12T03:14:15.123+05:00\""
        s2 "#inst \"2010-11-11T22:14:15.123Z\""]
    (binding [*data-readers* {'inst read-instant-date}]
      (testing "read-instant-date should convert to UTC"
        (is (= (read-string s) (read-string s2)))))
    (binding [*data-readers* {'inst read-instant-timestamp}]
      (testing "read-instant-timestamp should convert to UTC"
        (is (= (read-string s) (read-string s2)))))
    (binding [*data-readers* {'inst read-instant-calendar}]
      (testing "read-instant-calendar should preserve timezone"
        (is (not= (read-string s) (read-string s2)))))))

(deftest unknown-tag
  (let [my-unknown (fn [tag val] {:unknown-tag tag :value val})
        throw-on-unknown (fn [tag val] (throw (RuntimeException. (str "No data reader function for tag " tag))))
        my-uuid (partial my-unknown 'uuid)
        u "#uuid \"550e8400-e29b-41d4-a716-446655440000\""
        s "#never.heard.of/some-tag [1 2]" ]
    (binding [*data-readers* {'uuid my-uuid}
              *default-data-reader-fn* my-unknown]
      (testing "Unknown tag"
        (is (= (read-string s)
               {:unknown-tag 'never.heard.of/some-tag
                :value [1 2]})))
      (testing "Override uuid tag"
        (is (= (read-string u)
               {:unknown-tag 'uuid
                :value "550e8400-e29b-41d4-a716-446655440000"}))))

(deftest preserve-read-cond-test
  (let [x (read-string {:read-cond :preserve} "#?(:clj foo :cljs bar)" )]
       (is (reader-conditional? x))
       (is (not (:splicing? x)))
       (is (= :foo (get x :no-such-key :foo)))
       (is (= (:form x) '(:clj foo :cljs bar)))
       (is (= x (reader-conditional '(:clj foo :cljs bar) false))))
  (let [x (read-string {:read-cond :preserve} "#?@(:clj [foo])" )]
       (is (reader-conditional? x))
       (is (:splicing? x))
       (is (= :foo (get x :no-such-key :foo)))
       (is (= (:form x) '(:clj [foo])))
       (is (= x (reader-conditional '(:clj [foo]) true))))
  (is (thrown-with-msg? RuntimeException #"No reader function for tag"
                        (read-string {:read-cond :preserve} "#js {:x 1 :y 2}" )))
  (let [x (read-string {:read-cond :preserve} "#?(:cljs #js {:x 1 :y 2})")
        [platform tl] (:form x)]
       (is (reader-conditional? x))
       (is (tagged-literal? tl))
       (is (= 'js (:tag tl)))
       (is (= {:x 1 :y 2} (:form tl)))
       (is (= :foo (get tl :no-such-key :foo)))
       (is (= tl (tagged-literal 'js {:x 1 :y 2}))))
  (testing "print form roundtrips"
           (doseq [s ["#?(:clj foo :cljs bar)"
                      "#?(:cljs #js {:x 1, :y 2})"
                      "#?(:clj #clojure.test_clojure.reader.TestRecord [42 85])"]]
                  (is (= s (pr-str (read-string {:read-cond :preserve} s)))))))

(deftest reader-conditionals
  (testing "basic read-cond"
    (is (= '[foo-form]
           (read-string {:read-cond :allow :features #{:foo}} "[#?(:foo foo-form :bar bar-form)]")))
    (is (= '[bar-form]
           (read-string {:read-cond :allow :features #{:bar}} "[#?(:foo foo-form :bar bar-form)]")))
    (is (= '[foo-form]
           (read-string {:read-cond :allow :features #{:foo :bar}} "[#?(:foo foo-form :bar bar-form)]")))
    (is (= '[]
           (read-string {:read-cond :allow :features #{:baz}} "[#?( :foo foo-form :bar bar-form)]"))))
  (testing "environmental features"
    (is (= "clojure" #?(:clj "clojure" :cljs "clojurescript" :default "default"))))
  (testing "default features"
    (is (= "default" #?(:clj-clr "clr" :cljs "cljs" :default "default"))))
  (testing "splicing"
    (is (= [] [#?@(:clj [])]))
    (is (= [:a] [#?@(:clj [:a])]))
    (is (= [:a :b] [#?@(:clj [:a :b])]))
    (is (= [:a :b :c] [#?@(:clj [:a :b :c])]))
    (is (= [:a :b :c] [#?@(:clj [:a :b :c])])))
  (testing "nested splicing"
    (is (= [:a :b :c :d :e]
           [#?@(:clj [:a #?@(:clj [:b #?@(:clj [:c]) :d]):e])]))
    (is (= '(+ 1 (+ 2 3))
           '(+ #?@(:clj [1 (+ #?@(:clj [2 3]))]))))
    (is (= '(+ (+ 2 3) 1)
           '(+ #?@(:clj [(+ #?@(:clj [2 3])) 1]))))
    (is (= [:a [:b [:c] :d] :e]
           [#?@(:clj [:a [#?@(:clj [:b #?@(:clj [[:c]]) :d])] :e])])))
  (testing "bypass unknown tagged literals"
    (is (= [1 2 3] #?(:cljs #js [1 2 3] :clj [1 2 3])))
    (is (= :clojure #?(:foo #some.nonexistent.Record {:x 1} :clj :clojure))))
  (testing "error cases"
    (is (thrown-with-msg? RuntimeException #"Feature should be a keyword" (read-string {:read-cond :allow} "#?((+ 1 2) :a)")))
    (is (thrown-with-msg? RuntimeException #"even number of forms" (read-string {:read-cond :allow} "#?(:cljs :a :clj)")))
    (is (thrown-with-msg? RuntimeException #"read-cond-splicing must implement" (read-string {:read-cond :allow} "#?@(:clj :a)")))
    (is (thrown-with-msg? RuntimeException #"is reserved" (read-string {:read-cond :allow} "#?@(:foo :a :else :b)")))
    (is (thrown-with-msg? RuntimeException #"must be a list" (read-string {:read-cond :allow} "#?[:foo :a :else :b]")))
    (is (thrown-with-msg? RuntimeException #"Conditional read not allowed" (read-string {:read-cond :BOGUS} "#?[:clj :a :default nil]")))
    (is (thrown-with-msg? RuntimeException #"Conditional read not allowed" (read-string "#?[:clj :a :default nil]")))
    (is (thrown-with-msg? RuntimeException #"Reader conditional splicing not allowed at the top level" (read-string {:read-cond :allow} "#?@(:clj [1 2])")))
    (is (thrown-with-msg? RuntimeException #"Reader conditional splicing not allowed at the top level" (read-string {:read-cond :allow} "#?@(:clj [1])")))
    (is (thrown-with-msg? RuntimeException #"Reader conditional splicing not allowed at the top level" (read-string {:read-cond :allow} "#?@(:clj []) 1"))))
  (testing "clj-1698-regression"
    (let [opts {:features #{:clj} :read-cond :allow}]
      (is (= 1 (read-string opts "#?(:cljs {'a 1 'b 2} :clj 1)")))
      (is (= 1 (read-string opts "#?(:cljs (let [{{b :b} :a {d :d} :c} {}]) :clj 1)")))
      (is (= '(def m {}) (read-string opts "(def m #?(:cljs ^{:a :b} {} :clj  ^{:a :b} {}))")))
      (is (= '(def m {}) (read-string opts "(def m #?(:cljs ^{:a :b} {} :clj ^{:a :b} {}))")))
      (is (= 1 (read-string opts "#?(:cljs {:a #_:b :c} :clj 1)")))))
  (testing "nil expressions"
    (is (nil? #?(:default nil)))
    (is (nil? #?(:foo :bar :clj nil)))
    (is (nil? #?(:clj nil :foo :bar)))
    (is (nil? #?(:foo :bar :default nil)))))

(deftest test-read+string
  (let [[r s] (read+string (str->lnpr "[:foo  100]"))]
    (is (= [:foo 100] r))
    (is (= "[:foo  100]" s)))

  (let [[r s] (read+string {:read-cond :allow :features #{:y}} (str->lnpr "#?(:x :foo :y :bar)"))]
    (is (= :bar r))
    (is (= "#?(:x :foo :y :bar)" s))))

(ns frontend.pubsub
  "All mults and pubs are collected to this ns.
  vars with suffix '-mult' is a/Mult, use a/tap and a/untap on them. used by event subscribers
  vars with suffix '-pub' is a/Pub, use a/sub and a/unsub on them. used by event subscribers
  vars with suffix '-ch' is chan used by event publishers."
  {:clj-kondo/config {:linters {:unresolved-symbol {:level :off}}}}
  #?(:cljs (:require-macros [frontend.pubsub :refer [def-mult-or-pub chan-of]]))
  (:require [clojure.core.async :as a :refer [chan mult pub]]
            [clojure.core.async.impl.protocols :as ap]
            [malli.core :as m]
            [malli.dev.pretty :as mdp]
            [clojure.pprint :as pp]))

;;; helper macro
(defmacro chan-of [malli-schema malli-schema-validator & chan-args]
  `(let [ch# (chan ~@chan-args)]
     (reify
       ap/ReadPort
       (~'take! [~'_ fn1-handler#]
        (ap/take! ch# fn1-handler#))
       ap/WritePort
       (~'put! [~'_ val# fn1-handler#]
        (if (~malli-schema-validator val#)
          (ap/put! ch# val# fn1-handler#)
          (do (mdp/explain ~malli-schema val#)
              (throw (ex-info "validate chan value failed" {:val val#}))))))))

(defmacro def-mult-or-pub
  "define following vars:
  - `symbol-name`-ch for event publisher.
  - `symbol-name`-mult or `symbol-name`-pub for event subscribers.
  - `symbol-name`-validator is malli schema validator
  def -pub var when `:topic-fn` exists otherwise -mult var"
  [symbol-name doc-string malli-schema & {:keys [ch-buffer topic-fn]
                                          :or   {ch-buffer 1}}]
  (let [schema-validator-name (symbol (str symbol-name "-validator"))
        schema-name           (symbol (str symbol-name "-schema"))
        ch-name               (symbol (str symbol-name "-ch"))
        mult-or-pub-name      (if topic-fn
                                (symbol (str symbol-name "-pub"))
                                (symbol (str symbol-name "-mult")))
        doc-string*           (str doc-string "\nMalli-schema:\n" (with-out-str (pp/pprint malli-schema)))]
    `(do
       (def ~schema-name ~malli-schema)
       (def ~schema-validator-name (m/validator ~malli-schema))
       (def ~ch-name ~doc-string* (chan-of ~malli-schema ~schema-validator-name ~ch-buffer))
       ~(if topic-fn
          `(def ~mult-or-pub-name ~doc-string* (pub ~ch-name ~topic-fn))
          `(def ~mult-or-pub-name ~doc-string* (mult ~ch-name))))))

(def-mult-or-pub sync-events
  "file-sync events"
  [:map
   [:event [:enum
            :created-local-version-file
            :finished-local->remote
            :finished-remote->local
            :start
            :pause
            :resume
            :exception-decrypt-failed
            :remote->local-full-sync-failed
            :local->remote-full-sync-failed
            :get-remote-graph-failed
            :get-deletion-logs-failed
            :get-remote-all-files-failed]]
   [:data :map]]
  :topic-fn :event
  :ch-buffer (a/sliding-buffer 10))

(ns io.pedestal.http.jetty.container
  (:require [io.pedestal.http.container :as container]
            [clojure.core.async :as async])
  (:import (java.nio.channels ReadableByteChannel)
           (java.nio ByteBuffer)
           (org.eclipse.jetty.server Response)))

(extend-protocol container/WriteNIOByteBody
  org.eclipse.jetty.server.Response
  (write-byte-channel-body [servlet-response ^ReadableByteChannel body resume-chan context]
    (let [os ^org.eclipse.jetty.server.HttpOutput (.getHttpOutput servlet-response)]
      (.sendContent os body (reify org.eclipse.jetty.util.Callback
                                   (succeeded [this]
                                     (.close body)
                                     (async/put! resume-chan context)
                                     (async/close! resume-chan))
                                   (failed [this throwable]
                                     (.close body)
                                     (async/put! resume-chan (assoc context :io.pedestal.impl.interceptor/error throwable))
                                     (async/close! resume-chan))))))
  (write-byte-buffer-body [servlet-response ^ByteBuffer body resume-chan context]
    (let [os ^org.eclipse.jetty.server.HttpOutput (.getHttpOutput servlet-response)]
      (.sendContent os body (reify org.eclipse.jetty.util.Callback
                                   (succeeded [this]
                                     (async/put! resume-chan context)
                                     (async/close! resume-chan))
                                   (failed [this throwable]
                                     (async/put! resume-chan (assoc context :io.pedestal.impl.interceptor/error throwable))
                                     (async/close! resume-chan)))))))

(ns datahike.http.writer
  "Remote writer implementation for datahike.http.server through datahike.http.client."
  (:require [datahike.writer :refer [PWriter create-writer create-database delete-database]]
            [datahike.http.client :refer [request-json] :as client]
            [datahike.json :as json]
            [datahike.tools :as dt :refer [throwable-promise]]
            [taoensso.timbre :as log]
            [clojure.core.async :refer [promise-chan put!]]))

(defrecord DatahikeServerWriter [remote-peer conn]
  PWriter
  (-dispatch! [_ arg-map]
    (let [{:keys [op args]} arg-map
          p (promise-chan)
          config (:config @(:wrapped-atom conn))]
      (log/debug "Sending operation to datahike-server:" op)
      (log/trace "Arguments:" arg-map)
      (put! p
            (try
              (request-json :post
                            (str op "-writer")
                            remote-peer
                            (vec (concat [config] args))
                            json/mapper)
              (catch Exception e
                e)))
      p))
  (-shutdown [_])
  (-streaming? [_] false))

(defmethod create-database :datahike-server
  [& args]
  (let [p (throwable-promise)
        {:keys [writer] :as config} (first args)]
    ;; redirect call to remote-peer as writer config
    (deliver p (try (->
                     (request-json :post
                                   "create-database-writer"
                                   writer
                                   (vec (concat [(-> config
                                                     (assoc :remote-peer writer)
                                                     (dissoc :writer))]
                                                (rest args))))
                     (dissoc :remote-peer))
                    (catch Exception e
                      e)))
    p))

(defmethod delete-database :datahike-server
  [& args]
  (let [p (throwable-promise)
        {:keys [writer] :as config} (first args)]
    ;; redirect call to remote-peer as writer config
    (deliver p (try
                 (-> (request-json :post
                                   "delete-database-writer"
                                   writer
                                   (vec (concat [(-> config
                                                     (assoc  :remote-peer writer)
                                                     (dissoc :writer))]
                                                (rest args))))
                     (dissoc :remote-peer))
                 (catch Exception e
                   e)))
    p))

(ns cortex.nn.impl
  "Implementation helpers to aid implementing neural network cortex protocols
or specific neural network layers"
  (:require [cortex.nn.layers :as layers]
            [clojure.core.matrix.macros :refer [c-for]]))


(defmacro convolution-outer-kernel
  [conv-desc & body]
  `(let [~'conv-desc ~conv-desc
         ~'output-width (long (:output-width ~'conv-desc))
         ~'output-height (long (:output-height ~'conv-desc))
         ~'num-in-channels (long (:input-channels ~'conv-desc))
         ~'num-out-channels (long (:output-channels ~'conv-desc))
         ~'input-width (long (:input-width ~'conv-desc))
         ~'input-height (long (:input-height ~'conv-desc))
         ~'input-planar-stride (* ~'input-width ~'input-height)
         ~'output-planar-stride (* ~'output-width ~'output-height)
         ~'kernel-width (long (:kernel-width ~'conv-desc))
         ~'kernel-height (long (:kernel-height ~'conv-desc))
         ~'output-channel-stride (* ~'kernel-width ~'kernel-height)
         ~'output-column-stride (* ~'output-channel-stride ~'num-in-channels)
         ~'stride-y (long (:stride-y ~'conv-desc))
         ~'stride-x (long (:stride-x ~'conv-desc))
         ~'pad-x (long (:pad-x ~'conv-desc))
         ~'pad-y (long (:pad-y ~'conv-desc))
         ~'min-x (- 0 ~'pad-x)
         ~'min-y (- 0 ~'pad-y)
         ~'max-x (+ ~'input-width ~'pad-x)
         ~'max-y (+ ~'input-height ~'pad-y)
         ~'kernel-num-elems (* ~'kernel-width ~'kernel-height)]
     (c-for
      [~'chan 0 (< ~'chan ~'num-in-channels) (inc ~'chan)]
      (let [~'chan-input-offset (* ~'chan ~'input-planar-stride)
            ~'chan-output-offset (* ~'chan ~'output-planar-stride)]
        (c-for
         [~'out-y 0 (< ~'out-y ~'output-height) (inc ~'out-y)]
         (let [~'input-rel-y (- (* ~'out-y ~'stride-y) ~'pad-y)]
           (c-for
            [~'out-x 0 (< ~'out-x ~'output-width) (inc ~'out-x)]
            (let [~'input-rel-x (- (* ~'out-x ~'stride-x) ~'pad-x)]
              ~@body))))))))


(defmacro convolution-roll-unroll-inner-kernel
  [& body]
  `(let [~'chan-conv-offset (* ~'chan ~'output-channel-stride)
         ~'output-offset (+ (* ~'out-y ~'output-width)
                            ~'out-x)
         ;;positive values for how far out we are into the padding
         input-over-x# (max 0 (- (+ ~'input-rel-x ~'kernel-width)
                                 ~'input-width))
         input-over-y# (max 0 (- (+ ~'input-rel-y ~'kernel-height)
                                 ~'input-height))
         ;;Negative values for how far before the 0 idx we are.
         input-under-x# (min ~'input-rel-x 0)
         input-under-y# (min ~'input-rel-y 0)
         ;;Width of the kernel excluding padding
         ~'exc-pad-width (max 0 (+ (- ~'kernel-width input-over-x#)
                                   input-under-x#))
         ~'exc-pad-height (max 0 (+ (- ~'kernel-height input-over-y#)
                                    input-under-y#))
         ~'exc-pad-kernel-num-elems (* ~'exc-pad-width ~'exc-pad-height)]
     (c-for
      [~'k-y 0 (< ~'k-y ~'kernel-height) (inc ~'k-y)]
      (c-for
       [~'k-x 0 (< ~'k-x ~'kernel-width) (inc ~'k-x)]
       (let [~'input-x (+ ~'input-rel-x ~'k-x)
             ~'input-y (+ ~'input-rel-y ~'k-y)
             ~'output-conv-addr (+ (* ~'output-offset
                                      ~'output-column-stride)
                                   ~'chan-conv-offset
                                   (* ~'k-y ~'kernel-width)
                                   ~'k-x)
             ~'input-addr  (+ (* ~'input-y ~'input-width)
                              ~'input-x
                              ~'chan-input-offset)
             ~'input-valid? (and (in-bounds? ~'input-x 0 ~'input-width)
                                 (in-bounds? ~'input-y 0 ~'input-height))
             loop-valid?# (and (in-bounds? ~'input-x ~'min-x ~'max-x)
                               (in-bounds? ~'input-y ~'min-y ~'max-y))]
         (when loop-valid?#
           ~@body))))))

(ns hoplon.binding
  (:refer-clojure :exclude [binding bound-fn])
  (:require [clojure.core  :as clj]
            [cljs.analyzer :as a]))

(defmacro binding
  "See clojure.core/binding."
  [bindings & body]
  (let [env           (assoc &env :ns (a/get-namespace a/*cljs-ns*))
        value-exprs   (take-nth 2 (rest bindings))
        bind-syms     (map #(:name (a/resolve-existing-var env %)) (take-nth 2 bindings))
        bind-syms'    (map (partial list 'quote) bind-syms)
        set-syms      (repeatedly (count bind-syms) gensym)
        setfn         (fn [x y]
                        {:push! `(fn []
                                   (let [z# ~x]
                                     (set! ~x ~y)
                                     (fn [] (set! ~x z#))))})
        thunkmaps     (map setfn bind-syms set-syms)]
    (a/confirm-bindings env bind-syms)
    `(let [~@(interleave set-syms value-exprs)]
       (hoplon.binding/push-thread-bindings ~(zipmap bind-syms' thunkmaps))
       (try ~@body (finally (hoplon.binding/pop-thread-bindings))))))