Permalink
Switch branches/tags
Nothing to show
Find file
Fetching contributors…
Cannot retrieve contributors at this time
991 lines (819 sloc) 20.1 KB
;-----
(defprotocol ProtocolName
"documentation"
(a-method [this arg1 arg2] "method docstring")
(another-method [x] [x arg] "docstring"))
;-----
(defprotocol AProtocol
(methodName [this x y & more]))
;-----
(defprotocol Matrix
"Protocol for working with 2d datastructures."
(lookup [matrix i j])
(update [matrix i j value])
(rows [matrix])
(cols [matrix])
(dims [matrix]))
;-----
(extend-protocol Matrix
clojure.lang.IPersistentVector
(lookup [vov i j]
(get-in vov [i j]))
(update [vov i j value]
(assoc-in vov [i j] value))
(rows [vov]
(seq vov))
(cols [vov]
(apply map vector vov))
(dims [vov]
[(count vov) (count (first vov))]))
;-----
(extend-type AType
AProtocol
(method-from-AProtocol [this x]
(;...implementation for AType
))
AnotherProtocol
(method1-from-AnotherProtocol [this x]
(;...implementation for AType
))
(method2-from-AnotherProtocol [this x y]
(;...implementation for AType
)))
(extend-protocol AProtocol
AType
(method1-from-AProtocol [this x]
(;...implementation for AType
))
AnotherType
(method1-from-AProtocol [this x]
(;...implementation for AnotherType
))
(method2-from-AProtocol [this x y]
(;...implementation for AnotherType
)))
;-----
(extend-protocol Matrix
nil
(lookup [x i j])
(update [x i j value])
(rows [x] [])
(cols [x] [])
(dims [x] [0 0]))
(lookup nil 5 5)
;= nil
(dims nil)
;= [0 0]
;-----
(defn vov
"Create a vector of h w-item vectors."
[h w]
(vec (repeat h (vec (repeat w nil)))))
;-----
(def matrix (vov 3 4))
;= #'user/matrix
matrix
;= [[nil nil nil nil]
;= [nil nil nil nil]
;= [nil nil nil nil]]
(update matrix 1 2 :x)
;= [[nil nil nil nil]
;= [nil nil :x nil]
;= [nil nil nil nil]]
(lookup *1 1 2)
;= :x
(rows (update matrix 1 2 :x))
;= ([nil nil nil nil]
;= [nil nil :x nil]
;= [nil nil nil nil])
(cols (update matrix 1 2 :x))
;= ([nil nil nil]
;= [nil nil nil]
;= [nil :x nil]
;= [nil nil nil])
;-----
(extend-protocol Matrix
(Class/forName "[[D")
(lookup [matrix i j]
(aget matrix i j))
(update [matrix i j value]
(let [clone (aclone matrix)]
(aset clone i
(doto (aclone (aget clone i))
(aset j value)))
clone))
(rows [matrix]
(map vec matrix))
(cols [matrix]
(apply map vector matrix))
(dims [matrix]
(let [rs (count matrix)]
(if (zero? rs)
[0 0]
[rs (count (aget matrix 0))]))))
;-----
(def matrix (make-array Double/TYPE 2 3))
;= #'user/matrix
(rows matrix)
;= ([0.0 0.0 0.0]
;= [0.0 0.0 0.0])
(rows (update matrix 1 1 3.4))
;= ([0.0 0.0 0.0]
;= [0.0 3.4 0.0])
(lookup (update matrix 1 1 3.4) 1 1)
;= 3.4
(cols (update matrix 1 1 3.4))
;= ([0.0 0.0]
;= [0.0 3.4]
;= [0.0 0.0])
(dims matrix)
;= [2 3]
;-----
(defrecord Point [x y])
;-----
(deftype Point [x y])
;-----
(.x (Point. 3 4))
;= 3
;-----
(defrecord NamedPoint [^String name ^long x ^long y])
;-----
(NamedPoint/getBasis)
;= [name x y]
;-----
(map meta (NamedPoint/getBasis))
;= ({:tag String} {:tag long} {:tag long})
;-----
(def x "hello")
;= #'user/hello
(defrecord Point [x y])
;= user.Point
(Point. 5 5)
;= #user.Point{:x 5, :y 5}
(ns user2)
(refer 'user)
x
;= "hello"
Point
;= CompilerException java.lang.Exception:
;= Unable to resolve symbol: Point
(import 'user.Point)
Point
;= user.Point
;-----
(defrecord Point [x y])
;= user.Point
(= (Point. 3 4) (Point. 3 4))
;= true
(= 3 3N)
;= true
(= (Point. 3N 4N) (Point. 3 4))
;= true
;-----
(:x (Point. 3 4))
;= 3
(:z (Point. 3 4) 0)
;= 0
(map :x [(Point. 3 4)
(Point. 5 6)
(Point. 7 8)])
;= (3 5 7)
;-----
(assoc (Point. 3 4) :z 5)
;= #user.Point{:x 3, :y 4, :z 5}
(let [p (assoc (Point. 3 4) :z 5)]
(dissoc p :x))
;= {:y 4, :z 5}
(let [p (assoc (Point. 3 4) :z 5)]
(dissoc p :z))
;= #user.Point{:x 3, :y 4}
;-----
(:z (assoc (Point. 3 4) :z 5))
;= 5
(.z (assoc (Point. 3 4) :z 5))
;= #<java.lang.IllegalArgumentException:
;= No matching field found: z for class user.Point>
;-----
(-> (Point. 3 4)
(with-meta {:foo :bar})
meta)
;= {:foo :bar}
;-----
#user.Point{:x 3, :y 4, :z 5}
;-----
(pr-str (assoc (Point. 3 4) :z [:a :b]))
;= "#user.Point{:x 3, :y 4, :z [:a :b]}"
(= (read-string *1)
(assoc (Point. 3 4) :z [:a :b]))
;= true
;-----
(Point. 3 4 {:foo :bar} {:z 5})
;= #user.Point{:x 3, :y 4, :z 5}
(meta *1)
;= {:foo :bar}
;-----
(-> (Point. 3 4)
(with-meta {:foo :bar})
(assoc :z 5))
;-----
(defn point [x y]
(Point. x y))
;-----
(->Point 3 4)
;= #user.Point{:x 3, :y 4}
;-----
(map->Point {:x 3, :y 4, :z 5})
;= #user.Point{:x 3, :y 4, :z 5}
;-----
(apply ->Point [5 6])
;= #user.Point{:x 5, :y 6}
(map (partial apply ->Point) [[5 6] [7 8] [9 10]])
;= (#user.Point{:x 5, :y 6}
;= #user.Point{:x 7, :y 8}
;= #user.Point{:x 9, :y 10})
(map map->Point [{:x 1 :y 2} {:x 5 :y 6 :z 44}])
;= (#user.Point{:x 1, :y 2}
;= #user.Point{:x 5, :y 6, :z 44})
;-----
(Point/create {:x 3, :y 4, :z 5})
;= #user.Point{:x 3, :y 4, :z 5}
;-----
(defn log-point
[x]
{:pre [(pos? x)]}
(Point. x (Math/log x)))
(log-point -42)
;= #<AssertionError java.lang.AssertionError: Assert failed: (pos? x)>
(log-point Math/E)
;= #user.Point{:x 2.718281828459045, :y 1.0}
;-----
(defn point [x y]
{:x x, :y y})
;-----
(defrecord Point [x y])
;= user.Point
(= (Point. 3 4) (Point. 3 4))
;= true
(= {:x 3 :y 4} (Point. 3 4))
;= false
(= (Point. 3 4) {:x 3 :y 4})
;= false
;-----
(deftype Point [x y])
;= user.Point
(.x (Point. 3 4))
;= 3
(:x (Point. 3 4))
;= nil
;-----
(deftype MyType [^:volatile-mutable fld])
;-----
(deftype SchrödingerCat [^:unsynchronized-mutable state]
clojure.lang.IDeref
(deref [sc]
(locking sc
(or state
(set! state (if (zero? (rand-int 2))
:dead
:alive))))))
(defn schrödinger-cat
"Creates a new Schrödinger's cat. Beware, the REPL may kill it!"
[]
(SchrödingerCat. nil))
(def felix (schrödinger-cat))
;= #'user/felix
@felix
;= :dead
(schrödinger-cat)
;= #<SchrödingerCat@3248bc64: :dead>
(schrödinger-cat)
;= #<SchrödingerCat@3248bc64: :alive>
;-----
(delay (if (zero? (rand-int 2))
:dead
:alive))
;-----
(defrecord Point [x y]
Matrix
(lookup [pt i j]
(when (zero? j)
(case i
0 x
1 y)))
(update [pt i j value]
(if (zero? j)
(condp = i
0 (Point. value y)
1 (Point. x value))
pt))
(rows [pt] [[x] [y]])
(cols [pt] [[x y]])
(dims [pt] [2 1]))
;-----
(defrecord Point [x y])
(extend-protocol Matrix
Point
(lookup [pt i j]
(when (zero? j)
(case i
0 (:x pt)
1 (:y pt))))
(update [pt i j value]
(if (zero? j)
(condp = i
0 (Point. value (:y pt))
1 (Point. (:x pt) value))
pt))
(rows [pt]
[[(:x pt)] [(:y pt)]])
(cols [pt]
[[(:x pt) (:y pt)]])
(dims [pt] [2 1]))
;-----
(defprotocol ClashWhenInlined
(size [x]))
;= ClashWhenInlined
(defrecord R []
ClashWhenInlined
(size [x]))
;= #<CompilerException java.lang.ClassFormatError:
;= Duplicate method name&signature in class file user/R, compiling:(NO_SOURCE_PATH:1)>
(defrecord R [])
;= user.R
(extend-type R
ClashWhenInlined
(size [x]))
;= nil
;-----
(deftype MyType [a b c]
java.lang.Runnable
(run [this] ...)
Object
(equals [this that] ...)
(hashCode [this] ...)
Protocol1
(method1 [this ...] ...)
Protocol2
(method2 [this ...] ...)
(method3 [this ...] ...))
;-----
(deftype Point [x y]
Matrix
(lookup [pt i j]
(when (zero? j)
(case i
0 x
1 y)))
(update [pt i j value]
(if (zero? j)
(case i
0 (Point. value y)
1 (Point. x value))
pt))
(rows [pt]
[[x] [y]])
(cols [pt]
[[x y]])
(dims [pt]
[2 1])
Object
(equals [this other]
(and (instance? (class this) other)
(= x (.x other)) (= y (.y other))))
(hashCode [this]
(-> x hash (hash-combine y))))
;-----
(deftype Point [x y]
Matrix
(lookup [pt i j]
(when (zero? j) (case i 0 x 1 y)))
(update [pt i j value]
(if (zero? j)
(case i
0 (Point. value y)
1 (Point. x value))
pt))
(rows [pt]
[[x] [y]])
(cols [pt]
[[x y]])
(dims [pt]
[2 1])
Object
(equals [this other]
(and (satisfies? Matrix other) (= (cols this) (cols other)))))
(hashCode [this]
(-> x hash (hash-combine y))))
;-----
(reify
Protocol-or-Interface-or-Object
(method1 [this x]
(implementation))
Another-Protocol-or-Interface
(method2 [this x y]
(implementation))
(method3 [this x]
(implementation)))
;-----
(defn listener
"Creates an AWT/Swing `ActionListener` that delegates to the given function."
[f]
(reify
java.awt.event.ActionListener
(actionPerformed [this e]
(f e))))
;-----
(.listFiles (java.io.File. ".")
(reify
java.io.FileFilter
(accept [this f]
(.isDirectory f))))
;-----
(defrecord Point [x y])
(extend Point
Matrix
{:lookup (fn [pt i j]
(when (zero? j)
(case i
0 (:x pt)
1 (:y pt))))
:update (fn [pt i j value]
(if (zero? j)
(condp = i
0 (Point. value (:y pt))
1 (Point. (:x pt) value))
pt))
:rows (fn [pt]
[[(:x pt)] [(:y pt)]])
:cols (fn [pt]
[[(:x pt) (:y pt)]])
:dims (fn [pt] [2 1]))
;-----
(def abstract-matrix-impl
{:cols (fn [pt]
(let [[h w] (dims pt)]
(map
(fn [x] (map #(lookup pt x y) (range 0 w)))
(range 0 h))))
:rows (fn [pt]
(apply map vector (cols pt)))})
;-----
(extend Point
Matrix
(assoc abstract-matrix-impl
:lookup (fn [pt i j]
(when (zero? j)
(case i
0 (:x pt)
1 (:y pt))))
:update (fn [pt i j value]
(if (zero? j)
(condp = i
0 (Point. value (:y pt))
1 (Point. (:x pt) value))
pt))
:dims (fn [pt] [2 1])))
;-----
(defprotocol Measurable
"A protocol for retrieving the dimensions of widgets."
(width [measurable] "Returns the width in px.")
(height [measurable] "Returns the height in px."))
;-----
(defrecord Button [text])
(extend-type Button
Measurable
(width [btn]
(* 8 (-> btn :text count)))
(height [btn] 8))
(def bordered
{:width #(* 2 (:border-width %))
:height #(* 2 (:border-height %))})
;-----
Measurable
;= {:impls
;= {user.Button
;= {:height #<user$eval2056$fn__2057 user$eval2056$fn__2057@112f8578>,
;= :width #<user$eval2056$fn__2059 user$eval2056$fn__2059@74b90ff7>}},
;= :on-interface user.Measurable,
;= :on user.Measurable,
;= :doc "A protocol for retrieving the 2D dimensions of widgets.",
;= :sigs
;= {:height
;= {:doc "Returns the height in px.",
;= :arglists ([measurable]),
;= :name height},
;= :width
;= {:doc "Returns the width in px.",
;= :arglists ([measurable]),
;= :name width}},
;= :var #'user/Measurable,
;= :method-map {:width :width, :height :height},
;= :method-builders
;= {#'user/height #<user$eval2012$fn__2013 user$eval2012$fn__2013@27aa7aac>,
;= #'user/width #<user$eval2012$fn__2024 user$eval2012$fn__2024@4848268a>}}
;-----
(get-in Measurable [:impls Button])
;= {:height #<user$eval1251$fn__1252 user$eval1251$fn__1252@744589eb>,
;= :width #<user$eval1251$fn__1254 user$eval1251$fn__1254@40735f45>}
;-----
(defn combine
"Takes two functions f and g and returns a fn that takes a variable number
of args, applies them to f and g and then returns the result of
(op rf rg) where rf and rg are the results of the calls to f and g."
[op f g]
(fn [& args]
(op (apply f args) (apply g args))))
;-----
(defrecord BorderedButton [text border-width border-height])
(extend BorderedButton
Measurable
(merge-with (partial combine +)
(get-in Measurable [:impls Button])
bordered))
;-----
(let [btn (Button. "Hello World")]
[(width btn) (height btn)])
;= [88 8]
(let [bbtn (BorderedButton. "Hello World" 6 4)]
[(width bbtn) (height bbtn)])
;= [100 16]
;-----
(extenders Measurable)
;= (user.BorderedButton user.Button)
;-----
(extends? Measurable Button)
;= true
;-----
(satisfies? Measurable (Button. "hello"))
;= true
(satisfies? Measurable :other-value)
;= false
;-----
(deftype Foo [x y]
Measurable
(width [_] x)
(height [_] y))
;= user.Foo
(satisfies? Measurable (Foo. 5 5))
;= true
;-----
(instance? user.Measurable (Foo. 5 5))
;= true
;-----
(defprotocol P
(a [x]))
;= P
(extend-protocol P
java.util.Collection
(a [x] :collection!)
java.util.List
(a [x] :list!))
;= nil
(a [])
;= :list!
;-----
(defprotocol P
(a [x]))
(extend-protocol P
java.util.Map
(a [x] :map!)
java.io.Serializable
(a [x] :serializable!))
;-----
(a {})
;= :serializable!
;-----
(defn scaffold
"Given an interface, returns a 'hollow' body suitable for use with `deftype`."
[interface]
(doseq [[iface methods] (->> interface
.getMethods
(map #(vector (.getName (.getDeclaringClass %))
(symbol (.getName %))
(count (.getParameterTypes %))))
(group-by first))]
(println (str " " iface))
(doseq [[_ name argcount] methods]
(println
(str " "
(list name (into '[this] (take argcount (repeatedly gensym)))))))))
;-----
(scaffold clojure.lang.IPersistentSet)
; clojure.lang.IPersistentSet
; (get [this G__5617])
; (contains [this G__5618])
; (disjoin [this G__5619])
; clojure.lang.IPersistentCollection
; (count [this])
; (cons [this G__5620])
; (empty [this])
; (equiv [this G__5621])
; clojure.lang.Seqable
; (seq [this])
; clojure.lang.Counted
; (count [this])
;-----
(declare empty-array-set)
(def ^:private ^:const max-size 4)
(deftype ArraySet [^objects items
^int size
^:unsynchronized-mutable ^int hashcode]
clojure.lang.IPersistentSet
(get [this x]
(loop [i 0]
(when (< i size)
(if (= x (aget items i))
(aget items i)
(recur (inc i))))))
(contains [this x]
(boolean
(loop [i 0]
(when (< i size)
(or (= x (aget items i)) (recur (inc i)))))))
(disjoin [this x]
(loop [i 0]
(if (== i size)
this
(if (not= x (aget items i))
(recur (inc i))
(ArraySet. (doto (aclone items)
(aset i (aget items (dec size)))
(aset (dec size) nil))
(dec size)
-1)))))
clojure.lang.IPersistentCollection
(count [this] size)
(cons [this x]
(cond
(.contains this x) this
(== size max-size) (into #{x} this)
:else (ArraySet. (doto (aclone items)
(aset size x))
(inc size)
-1)))
(empty [this] empty-array-set)
(equiv [this that] (.equals this that))
clojure.lang.Seqable
(seq [this] (take size items))
Object
(hashCode [this]
(when (== -1 hashcode)
(set! hashcode (int (areduce items idx ret 0
(unchecked-add-int ret (hash (aget items idx)))))))
hashcode)
(equals [this that]
(or
(identical? this that)
(and (or (instance? java.util.Set that)
(instance? clojure.lang.IPersistentSet that))
(= (count this) (count that))
(every? #(contains? this %) that)))))
(def ^:private empty-array-set (ArraySet. (object-array max-size) 0 -1))
(defn array-set
"Creates an array-backed set containing the given values."
[& vals]
(into empty-array-set vals))
;-----
(array-set)
;= #{}
(conj (array-set) 1)
;= #{1}
(apply array-set "hello")
;= #{\h \e \l \o}
(get (apply array-set "hello") \w)
;= nil
(get (apply array-set "hello") \h)
;= \h
(contains? (apply array-set "hello") \h)
;= true
(= (array-set) #{})
;= true
;-----
((apply array-set "hello") \h)
; #<ClassCastException java.lang.ClassCastException:
; user.ArraySet cannot be cast to clojure.lang.IFn>
;-----
(= #{} (array-set))
;= false
;-----
(scaffold java.util.Set)
; java.util.Set
; (add [this G__6140])
; (equals [this G__6141])
; (hashCode [this])
; (clear [this])
; (isEmpty [this])
; (contains [this G__6142])
; (addAll [this G__6143])
; (size [this])
; (toArray [this G__6144])
; (toArray [this])
; (iterator [this])
; (remove [this G__6145])
; (removeAll [this G__6146])
; (containsAll [this G__6147])
; (retainAll [this G__6148])
;-----
java.util.Set
(isEmpty [this])
(size [this])
(toArray [this G__6144])
(toArray [this])
(iterator [this])
(containsAll [this G__6147])
;-----
(deftype ArraySet [^objects items
^int size
^:unsynchronized-mutable ^int hashcode]
clojure.lang.IPersistentSet
(get [this x]
(loop [i 0]
(when (< i size)
(if (= x (aget items i))
(aget items i)
(recur (inc i))))))
(contains [this x]
(boolean
(loop [i 0]
(when (< i size)
(or (= x (aget items i)) (recur (inc i)))))))
(disjoin [this x]
(loop [i 0]
(if (== i size)
this
(if (not= x (aget items i))
(recur (inc i))
(ArraySet. (doto (aclone items)
(aset i (aget items (dec size)))
(aset (dec size) nil))
(dec size)
-1)))))
clojure.lang.IPersistentCollection
(count [this] size)
(cons [this x]
(cond
(.contains this x) this
(== size max-size) (into #{x} this)
:else (ArraySet. (doto (aclone items)
(aset size x))
(inc size)
-1)))
(empty [this] empty-array-set)
(equiv [this that] (.equals this that))
clojure.lang.Seqable
(seq [this] (take size items))
Object
(hashCode [this]
(when (== -1 hashcode)
(set! hashcode (int (areduce items idx ret 0
(unchecked-add-int ret (hash (aget items idx)))))))
hashcode)
(equals [this that]
(or
(identical? this that)
(and (instance? java.util.Set that)
(= (count this) (count that))
(every? #(contains? this %) that))))
clojure.lang.IFn
(invoke [this key] (.get this key))
(applyTo [this args]
(when (not= 1 (count args))
(throw (clojure.lang.ArityException. (count args) "ArraySet")))
(this (first args)))
java.util.Set
(isEmpty [this] (zero? size))
(size [this] size)
(toArray [this array]
(.toArray ^java.util.Collection (sequence items) array))
(toArray [this] (into-array (seq this)))
(iterator [this] (.iterator ^java.util.Collection (sequence this)))
(containsAll [this coll]
(every? #(contains? this %) coll)))
(def ^:private empty-array-set (ArraySet. (object-array max-size) 0 -1))
;-----
(= #{3 1 2 0} (array-set 0 1 2 3))
;= true
((apply array-set "hello") \h)
;= \h
;-----
(defn microbenchmark
[f & {:keys [size trials] :or {size 4 trials 1e6}}]
(let [items (repeatedly size gensym)]
(time (loop [s (apply f items)
n trials]
(when (pos? n)
(doseq [x items] (contains? s x))
(let [x (rand-nth items)]
(recur (-> s (disj x) (conj x)) (dec n))))))))
(doseq [n (range 1 5)
f [#'array-set #'hash-set]]
(print n (-> f meta :name) ": ")
(microbenchmark @f :size n))
; size 1 array-set : "Elapsed time: 839.336 msecs"
; size 1 hash-set : "Elapsed time: 1105.059 msecs"
; size 2 array-set : "Elapsed time: 1201.81 msecs"
; size 2 hash-set : "Elapsed time: 1369.192 msecs"
; size 3 array-set : "Elapsed time: 1658.36 msecs"
; size 3 hash-set : "Elapsed time: 1740.955 msecs"
; size 4 array-set : "Elapsed time: 2197.424 msecs"
; size 4 hash-set : "Elapsed time: 2154.637 msecs"