astrangeguy

(defn map [f aseq]
  (lazy-seq
    (when-let [it (seq aseq)]
      (cons (f (first it)) (map f (rest it))))))

astrangeguy

(deftype Bench [#^{:unsynchronized-mutable true} val]

  Runnable
  (run [] (let [a 1 b 2]
            (set! val a)
            (dotimes [_ 10]
              (time (dotimes [_ 10000000]
                      (set! val a)
                      (set! val b)))))))

astrangeguy

(defprotocol Settable
  (set-val! [mutable newval]))

(deftype unsynchronized-raw-box [#^{:unsynchronized-mutable true} val]
  clojure.lang.IDeref
  (deref [] val)

  Settable
  (set-val! [newval] (set! val newval)))

astrangeguy

(import '[java.lang.reflect Field Modifier])

(defn private-fields [obj]
  (let [obj-class (class obj)
        public (set (.getFields obj-class))
        all (seq (.getDeclaredFields obj-class))
        fields (->> all
                    (remove public)
                    (remove #(Modifier/isStatic
                               (.getModifiers %))))]

astrangeguy

(defn memoize-visble-atom [f]
  (let [mem (atom {})]
    (with-meta
      (fn [& args]
        (if-let [e (find @mem args)]
          (val e)
          (let [ret (apply f args)]
            (swap! mem assoc args ret))))
      {:memoize-atom mem})))

astrangeguy

(defn label* [thunk]
  (let [NONE (Object.)
        payload (clojure.lang.Box. NONE)
        the-e (Exception.)]
    (try
     (thunk (fn [ret]
              (if (identical? NONE (.val payload))
                (do (set! (.val payload) ret)
                    (throw the-e))
                (throw (Exception. "Tried to jump outside extent.")))))

astrangeguy

(defmacro my-defrecord [the-name [& fields] & opt+specs]
  (let [full-classname (symbol (str (.name *ns*) \. the-name))]
    `(do
       (ns-unmap *ns* '~the-name)
       (defrecord ~the-name [~@fields] ~@opt+specs)
       (ns-unmap *ns* '~the-name)
       (defn ~the-name
         ([~@fields]
            (new ~full-classname ~@fields nil nil))
         ([~@fields ~'meta ~'extmap]

astrangeguy

(defmacro my-defrecord
  [name [& fields] & opts+specs]
  (let [gname name
        [interfaces methods opts] (#'clojure.core/parse-opts+specs opts+specs)
        classname (symbol (str *ns* "." gname))
        tag (keyword (str *ns*) (str name))
        hinted-fields fields
        fields (vec (map #(with-meta % nil) fields))]
    `(do
       ~(#'clojure.core/emit-defrecord name gname (vec hinted-fields) (vec interfaces) methods)

astrangeguy

(import java.util.concurrent.LinkedBlockingQueue
        java.util.concurrent.atomic.AtomicReference)

(defn pipe []
  (let [q (LinkedBlockingQueue.)
        qr (AtomicReference. q)
        NULL (Object.)
        END (Object.)
        produce (fn produce
                  ([item] (if-let [^LinkedBlockingQueue q (.get qr)]

astrangeguy

(ns strangeness.fn-arity
  (:import java.lang.reflect.Method))

(defn declared-methods [^Class class]
  (filter #(= class (.getDeclaringClass ^Method %))
          (.getMethods class)))

(defn has-arity? [fun arity]
  (let [cls (class fun)