scratch.clj

(defn unfold
  "Returns a reducible whose values are created by iterative
  application of `producer` to the previous value, start with
  `seed`. Stops generating values when `contiune?` returns false."
  {:added "1.9"}
  [continue? producer seed]
  (reify
    clojure.lang.IReduceInit
    (reduce [_ fun init]
      (loop [init (fun init seed)
             seed seed]
        (if (reduced? init)
          @init
          (if (continue? seed)
            (let [next-seed (producer seed)]
              (recur (fun init next-seed)
                     next-seed))
            init))))))


(into []
      (unfold
       (partial some some?)
       (fn [seqs] (map next seqs))
       [(range 3) (range 5) (range 6)]))


(defprotocol Pattern
  (guard [pattern value])
  (bindings [pattern value]))

(defrecord Constant [const]
  Pattern
  (guard [_ value]
    `(= ~value ~const))
  (bindings [pattern value]
    []))

(defrecord Binding [name]
  Pattern
  (guard [_ value]
    true)
  (bindings [_ value]
    `[[~name ~value]]))

(defrecord Expression [pat expression]
  Pattern
  (guard [_ value]
    `(and ~(guard pat value)
          (let [~@(apply concat (bindings pat value))]
            ~expression)))
  (bindings [_ value]
    (bindings pat value)))

(defrecord And [patterns]
  Pattern
  (guard [pattern values]
    `(and (sequential? ~values)
          ~@(map-indexed (fn [i pat] (guard pat `(nth ~values ~i))) patterns)
          ~@(for [[name bindings] (group-by first (bindings pattern values))
                  :when (> (count bindings) 1)]
              `(= ~@(map second bindings)))))
  (bindings [pattern values]
    (apply concat (map-indexed (fn [i pat] (bindings pat `(nth ~values ~i))) patterns))))

(defmacro match [thing & clauses]
  (assert (even? (count clauses)))
  (letfn [(to-guard [row]
            (cond
             (symbol? row) (->Binding row)
             (and (seq? row) (= "quote" (name (first row)))) (->Constant row)
             (seq? row) (->Expression (to-guard (first row))
                                      `(do ~@(rest row)))
             (vector? row) (->And (map to-guard row))
             :else (->Constant row)))]
    (let [n (gensym)]
      `(let [~n ~thing]
         (cond
          ~@(for [[row body] (partition-all 2 clauses)
                  :let [g (to-guard row)]
                  i [(guard g n)
                     `(let [~@(apply concat (bindings g n))]
                        ~body)]]
              i))))))




(defprotocol Transaction
  (commit! [tx]))

(deftype TX [refs]
  Transaction
  (commit! [tx]
    (let [result (async/chan)]
      (letfn [(propose [some-refs]
                (async/go
                  (if (seq some-refs)
                    (let [[[ref {:keys [current start]}] & some-refs] some-refs]
                      (if (compare-and-set! ref
                                            (assoc start
                                              :customer-tx nil)
                                            (assoc start
                                              :current-tx tx))
                        (propose some-refs)
                        (abort refs)))
                    (commit refs))))
              (commit [some-refs]
                (async/go
                  (if (seq some-refs)
                    (let [[[ref {:keys [current start]}] & some-refs] some-refs
                          success? (compare-and-set! ref
                                                     (assoc start
                                                       :current-tx tx)
                                                     (assoc current
                                                       :current-tx nil))]
                      (assert success?)
                      (commit some-refs))
                    (async/>! result true))))
              (abort [some-refs]
                (async/go
                  (if (seq some-refs)
                    (let [[[ref {:keys [current start]}] & some-refs] some-refs
                          success? (compare-and-set! ref
                                                     (assoc start
                                                       :current-tx tx)
                                                     (assoc start
                                                       :current-tx nil))]
                      (abort some-refs))
                    (async/>! result false))))]
        (propose refs))
      result)))

(defprotocol TransactionalReference
  (ensure* [ref tx])
  (alter* [ref tx fun args]))

(deftype ARef [v]
  TransactionalReference
  (ensure* [ref tx]
    (if (contains? (deref (.-refs tx)) ref)
      (:value (:current (get (deref (.-refs tx)) ref)))
      (let [point (deref (.-v ref))
            refs (.-refs tx)]
        (swap! refs assoc ref {:start point :current point})
        (:value point))))
  (alter* [ref tx fun args]
    (ensure ref tx)
    (swap! (.-refs tx) update-in [ref :current :value] fun args)
    (-> (.-refs tx)
        (deref)
        (get ref)
        (get :current)
        (get :value))))

(defn a-ref [value]
  (let [v (atom {:value value :current-tx nil})
        r (ARef. v)]
    r))


(defn f [] 1)

(def serv (future (while true (println (f)) (Thread/sleep 1000))))


(defn handle-registration-error [e]
  (if (and
       (instance? java.sql.SQLException e)
       (-> e (.getNextException)
           (.getMessage)
           (.startsWith "ERROR: duplicate key value")))
    (response/precondition-failed
     {:result :error
      :message "user with the selected ID already exists"})
    (do
      (log/error e)
      (response/internal-server-error
       {:result :error
        :message "server error occurred while adding the user"}))))



(def weights [2.5 5 10 25 45])
(def coeffs (mapv #(do % (l/lvar)) weights))

(== target (+ (* (nth coeffs 0) (nth weights 0))
              (* (nth coeffs 1) (nth weights 1))
              (* (nth coeffs 2) (nth weights 2))
              (* (nth coeffs 3) (nth weights 3))
              (* (nth coeffs 4) (nth weights 4))))


(defn state-machine [state
                     input
                     transition-function
                     output-function]
  (let [new-state (transition-function state input)
        new-input (output-function state input)]
    (if new-input
      (recur new-state new-input transition-function output-function)
      new-state)))



(def a (atom 0))
(def b (atom 0))


(deftype T []
  Runnable
  (run [_]
    (let [x @a
          y @b]
      (reset! a (dec x))
      (reset! b (inc y)))))

(defn threadsafe-t []
  (proxy [T] []
    (run []
      (locking #'threadsafe-t
        (proxy-super run)))))

(let [t (threadsafe-t)]
  (doseq [fut (doall (repeatedly 1000 #(future (.run t))))]
    @fut)
  (+ @a @b))


;; create a class with two long fields and single method 'do' that
;; decrements one field and increments the other whenever called
(def c
  (let [cv (clojure.asm.ClassWriter.
            clojure.asm.ClassWriter/COMPUTE_MAXS)
        cname "some/package/Class"
        ctype (clojure.asm.Type/getObjectType cname)
        ctor (clojure.asm.commons.Method. "<init>" clojure.asm.Type/VOID_TYPE (into-array clojure.asm.Type []))]
    (-> (doto cv
          (.visit clojure.asm.Opcodes/V1_5
                  (+ clojure.asm.Opcodes/ACC_PUBLIC
                     clojure.asm.Opcodes/ACC_SUPER)
                  cname
                  nil
                  "java/lang/Object"
                  (into-array String []))
          (.visitField clojure.asm.Opcodes/ACC_PUBLIC "a" "J" nil 0)
          (.visitField  clojure.asm.Opcodes/ACC_PUBLIC "b" "J" nil 0)
          ((fn [cv]
             (doto (clojure.asm.commons.GeneratorAdapter.
                    clojure.asm.Opcodes/ACC_PUBLIC
                    ctor
                    nil
                    nil
                    cv)
               (.visitCode)
               (.loadThis)
               (.dup)
               (.invokeConstructor (clojure.asm.Type/getObjectType "java/lang/Object")
                                   ctor)
               (.returnValue)
               (.endMethod))
             cv))
          ((fn [cv]
             (doto (clojure.asm.commons.GeneratorAdapter.
                    clojure.asm.Opcodes/ACC_PUBLIC
                    (clojure.asm.commons.Method. "do" clojure.asm.Type/VOID_TYPE (into-array clojure.asm.Type []))
                    nil
                    nil
                    cv)
               (.visitCode)
               (.loadThis)
               (.dup)
               (.getField ctype "a" clojure.asm.Type/LONG_TYPE)
               (.push (long -1))
               (.math clojure.asm.commons.GeneratorAdapter/ADD clojure.asm.Type/LONG_TYPE)
               (.putField ctype "a" clojure.asm.Type/LONG_TYPE)
               (.loadThis)
               (.dup)
               (.getField ctype "b" clojure.asm.Type/LONG_TYPE)
               (.push (long 1))
               (.math clojure.asm.commons.GeneratorAdapter/ADD clojure.asm.Type/LONG_TYPE)
               (.putField ctype "b" clojure.asm.Type/LONG_TYPE)
               (.returnValue)
               (.endMethod))
             cv)))
        (.toByteArray)
        ((fn [class-bytes]
           (.defineClass (deref clojure.lang.Compiler/LOADER)
                         "some.package.Class"
                         class-bytes
                         nil))))))

;; proxy the created class with a lock in the do method to make it
;; thread safe. 
(def thread-safe-doer (proxy [some.package.Class] []
                        (do []
                            (locking #'thread-safe-doer
                              (proxy-super do)))))

;; run the "threadsafe" do method in a lot of threads
(doseq [fut (doall (repeatedly 1000 #(future
                                       (locking #'thread-safe-doer
                                         (.do thread-safe-doer)))))]
  @fut)


;; if that all was thread safe this should be 0
(+ (.-a thread-safe-doer) (.-b thread-safe-doer))


(defn f [m1 m2]
  (letfn [(g [p m]
            (if (map? m)
              (for [[k v] m
                    i (g (conj p k) v)]
                i)
              [[p m]]))]
    (reduce
     (fn [x [path predicate]]
       (and x (predicate (get-in m2 path))))
     true
     (g [] m1))))

[pay-with-check] (for [a (.getAnchors page) :when (.contains (.asText a) "Check")] a)  

(defrecord Sequent [antecedent consequent])

(defn left-conjunction [table sequ term1 term2]
  (assert (contains? (:antecedent sequ) [:and term1 term2]))
  (let [new-sequ (->Sequent (conj (disj (:antecedent sequ) [:and term1 term2])
                                  term1
                                  term2)
                            (:consequent sequ))]
    (-> table
        (update-in [sequ new-sequ] (fnil conj #{}) :left-conjunction)
        (update-in [new-sequ sequ] (fnil conj #{}) :left-conjunction))))

(defn right-conjunction [table sequ term1 term2]
  (assert (contains? (:consequent sequ) [:and term1 term2]))
  (let [new-sequ1 (->Sequent (:antecedent sequ)
                             (conj (disj (:consequent sequ)
                                         [:and term1 term2])
                                   term1))
        new-sequ2 (->Sequent (:antecedent sequ)
                             (conj (disj (:consequent sequ)
                                         [:and term1 term2])
                                   term2))
        phi (gensym)]
    (-> table
        (update-in [sequ phi] (fnil conj #{}) :jump)
        (update-in [phi sequ] (fnil conj #{}) :jump)
        (update-in [phi new-sequ1] (fnil conj #{}) :right-conjunction)
        (update-in [phi new-sequ2] (fnil conj #{}) :right-conjunction)
        (update-in [new-sequ1 phi] (fnil conj #{}) :right-conjunction)
        (update-in [new-sequ2 phi] (fnil conj #{}) :right-conjunction))))


(define (Y* . l)
       ((lambda (u) (u u))
        (lambda (p)
                (map (lambda (li) (lambda x (apply (apply li (p p)) x))) l))))


(defn y-star [& l]
  ((fn [u] (u u))
   (fn [p]
     (map
      (fn [li]
        (fn [& x]
          (apply (apply li (p p)) x))) l))))



(def v (range 100))

(= (->> v
        (partition-all 32)
        (mapcat f))
   (drop 1 v))