Transient support for PersistentHashMap ported from Clojure

* New protocols:

  - IEditableCollection,
  - ITransientCollection,
  - ITransientAssociative.

* PersistentHashMap now implements IEditableCollection.

* TransientHashMap is the transient equivalent.

* cljs.core.PersistentHashMap/fromArrays now uses a transient map,

* ...as does cljs.core/hash-map.

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -226,6 +226,17 @@
   (-notify-watches [this oldval newval])
   (-add-watch [this key f])
   (-remove-watch [this key]))
+
+(defprotocol IEditableCollection
+  (-as-transient [coll]))
+
+(defprotocol ITransientCollection
+  (-conj! [tcoll val])
+  (-persistent! [tcoll]))
+
+(defprotocol ITransientAssociative
+  (-assoc! [tcoll key val])
+  (-dissoc! [tcoll key]))

 ;;;;;;;;;;;;;;;;;;; fundamentals ;;;;;;;;;;;;;;;
 (defn ^boolean identical?
@@ -2829,6 +2840,23 @@
         (recur (inc i) (assoc out (aget ks i) (aget vs i)))
         out)))))

+;;; Transients
+
+(defn transient [coll]
+  (-as-transient coll))
+
+(defn persistent! [tcoll]
+  (-persistent! tcoll))
+
+(defn conj! [tcoll val]
+  (-conj! tcoll val))
+
+(defn assoc! [tcoll key val]
+  (-assoc! tcoll key val))
+
+(defn dissoc! [tcoll key]
+  (-dissoc! tcoll key))
+
 ;;; PersistentHashMap

 (declare create-inode-seq create-array-node-seq reset! create-node atom deref)
@@ -2848,10 +2876,10 @@
 (defn- array-copy
   ([from i to j len]
      (loop [i i j j len len]
-       (when-not (zero? len)
-         (aset to j (aget from i))
-         (recur (inc i) (inc j) (dec len))))
-     to))
+       (if (zero? len)
+         to
+         (do (aset to j (aget from i))
+             (recur (inc i) (inc j) (dec len)))))))

 (defn- array-copy-downward
   ([from i to j len]
@@ -2873,9 +2901,20 @@
 (defn- bitpos [hash shift]
   (bit-shift-left 1 (mask hash shift)))

+(defn- edit-and-set
+  ([inode edit i a]
+     (let [editable (.ensure-editable inode edit)]
+       (aset (.-arr editable) i a)
+       editable))
+  ([inode edit i a j b]
+     (let [editable (.ensure-editable inode edit)]
+       (aset (.-arr editable) i a)
+       (aset (.-arr editable) j b)
+       editable)))
+
 (declare ArrayNode)

-(deftype BitmapIndexedNode [bitmap arr]
+(deftype BitmapIndexedNode [edit ^:mutable bitmap ^:mutable arr]
   Object
   (inode-assoc [inode shift hash key val added-leaf?]
     (let [bit (bitpos hash shift)
@@ -2896,30 +2935,30 @@
                                               (+ shift 5) (cljs.core/hash (aget arr j)) (aget arr j) (aget arr (inc j)) added-leaf?)
                                 (aget arr (inc j))))
                         (recur (inc i) (+ j 2))))))
-              (ArrayNode. (inc n) nodes))
+              (ArrayNode. nil (inc n) nodes))
             (let [new-arr (make-array (* 2 (inc n)))]
               (array-copy arr 0 new-arr 0 (* 2 idx))
               (aset new-arr (* 2 idx) key)
               (aset added-leaf? 0 true)
               (aset new-arr (inc (* 2 idx)) val)
               (array-copy arr (* 2 idx) new-arr (* 2 (inc idx)) (* 2 (- n idx)))
-              (BitmapIndexedNode. (bit-or bitmap bit) new-arr))))
+              (BitmapIndexedNode. nil (bit-or bitmap bit) new-arr))))
         (let [key-or-nil  (aget arr (* 2 idx))
               val-or-node (aget arr (inc (* 2 idx)))]
           (cond (coercive-= nil key-or-nil)
                 (let [n (.inode-assoc val-or-node (+ shift 5) hash key val added-leaf?)]
                   (if (identical? n val-or-node)
                     inode
-                    (BitmapIndexedNode. bitmap (clone-and-set arr (inc (* 2 idx)) n))))
+                    (BitmapIndexedNode. nil bitmap (clone-and-set arr (inc (* 2 idx)) n))))

                 (= key key-or-nil)
                 (if (identical? val val-or-node)
                   inode
-                  (BitmapIndexedNode. bitmap (clone-and-set arr (inc (* 2 idx)) val)))
+                  (BitmapIndexedNode. nil bitmap (clone-and-set arr (inc (* 2 idx)) val)))

                 :else
                 (do (aset added-leaf? 0 true)
-                    (BitmapIndexedNode. bitmap
+                    (BitmapIndexedNode. nil bitmap
                                         (clone-and-set arr (* 2 idx) nil (inc (* 2 idx))
                                                        (create-node (+ shift 5) key-or-nil val-or-node hash key val)))))))))

@@ -2933,11 +2972,11 @@
           (cond (coercive-= nil key-or-nil)
                 (let [n (.inode-without val-or-node (+ shift 5) hash key)]
                   (cond (identical? n val-or-node) inode
-                        (coercive-not= nil n) (BitmapIndexedNode. bitmap (clone-and-set arr (inc (* 2 idx)) n))
+                        (coercive-not= nil n) (BitmapIndexedNode. nil bitmap (clone-and-set arr (inc (* 2 idx)) n))
                         (== bitmap bit) nil
-                        :else (BitmapIndexedNode. (bit-xor bitmap bit) (remove-pair arr idx))))
+                        :else (BitmapIndexedNode. nil (bit-xor bitmap bit) (remove-pair arr idx))))
                 (= key key-or-nil)
-                (BitmapIndexedNode. (bit-xor bitmap bit) (remove-pair arr idx))
+                (BitmapIndexedNode. nil (bit-xor bitmap bit) (remove-pair arr idx))
                 :else inode)))))

   (inode-find [inode shift hash key]
@@ -2963,11 +3002,114 @@
                 :else not-found)))))

   (inode-seq [inode]
-    (create-inode-seq arr)))
-
-(set! cljs.core.BitmapIndexedNode/EMPTY (BitmapIndexedNode. 0 (make-array 0)))
-
-(defn- pack-array-node [array-node idx]
+    (create-inode-seq arr))
+
+  (ensure-editable [inode e]
+    (if (identical? e edit)
+      inode
+      (let [n       (bit-count bitmap)
+            new-arr (make-array (if (neg? n) 4 (* 2 (inc n))))]
+        (array-copy arr 0 new-arr 0 (* 2 n))
+        (BitmapIndexedNode. e bitmap new-arr))))
+
+  (edit-and-remove-pair [inode e bit i]
+    (if (== bitmap bit)
+      nil
+      (let [editable (.ensure-editable inode e)
+            earr     (.-arr editable)
+            len      (.-length earr)]
+        (set! (.-bitmap editable) (bit-xor bit (.-bitmap editable)))
+        (array-copy earr (* 2 (inc i))
+                    earr (* 2 i)
+                    (- len (* 2 (inc i))))
+        (aset earr (- len 2) nil)
+        (aset earr (dec len) nil)
+        editable)))
+
+  (inode-assoc! [inode edit shift hash key val added-leaf?]
+    (let [bit (bitpos hash shift)
+          idx (bitmap-indexed-node-index bitmap bit)]
+      (if (zero? (bit-and bitmap bit))
+        (let [n (bit-count bitmap)]
+          (cond
+            (< (* 2 n) (.-length arr))
+            (let [editable (.ensure-editable inode edit)
+                  earr     (.-arr editable)]
+              (aset added-leaf? 0 true)
+              (array-copy-downward earr (* 2 idx)
+                                   earr (* 2 (inc idx))
+                                   (* 2 (- n idx)))
+              (aset earr (* 2 idx) key)
+              (aset earr (inc (* 2 idx)) val)
+              (set! (.-bitmap editable) (bit-or (.-bitmap editable) bit))
+              editable)
+
+            (>= n 16)
+            (let [nodes (make-array 32)
+                  jdx   (mask hash shift)]
+              (aset nodes jdx (.inode-assoc! cljs.core.BitmapIndexedNode/EMPTY edit (+ shift 5) hash key val added-leaf?))
+              (loop [i 0 j 0]
+                (if (< i 32)
+                  (if (zero? (bit-and (bit-shift-right-zero-fill bitmap i) 1))
+                    (recur (inc i) j)
+                    (do (aset nodes i
+                              (if (coercive-not= nil (aget arr j))
+                                (.inode-assoc! cljs.core.BitmapIndexedNode/EMPTY
+                                               edit (+ shift 5) (cljs.core/hash (aget arr j)) (aget arr j) (aget arr (inc j)) added-leaf?)
+                                (aget arr (inc j))))
+                        (recur (inc i) (+ j 2))))))
+              (ArrayNode. edit (inc n) nodes))
+
+            :else
+            (let [new-arr (make-array (* 2 (+ n 4)))]
+              (array-copy arr 0 new-arr 0 (* 2 idx))
+              (aset new-arr (* 2 idx) key)
+              (aset added-leaf? 0 true)
+              (aset new-arr (inc (* 2 idx)) val)
+              (array-copy arr (* 2 idx) new-arr (* 2 (inc idx)) (* 2 (- n idx)))
+              (let [editable (.ensure-editable inode edit)]
+                (set! (.-arr editable) new-arr)
+                (set! (.-bitmap editable) (bit-or (.-bitmap editable) bit))
+                editable))))
+        (let [key-or-nil  (aget arr (* 2 idx))
+              val-or-node (aget arr (inc (* 2 idx)))]
+          (cond (coercive-= nil key-or-nil)
+                (let [n (.inode-assoc! val-or-node edit (+ shift 5) hash key val added-leaf?)]
+                  (if (identical? n val-or-node)
+                    inode
+                    (edit-and-set inode edit (inc (* 2 idx)) n)))
+
+                (= key key-or-nil)
+                (if (identical? val val-or-node)
+                  inode
+                  (edit-and-set inode edit (inc (* 2 idx)) val))
+
+                :else
+                (do (aset added-leaf? 0 true)
+                    (edit-and-set inode edit (* 2 idx) nil (inc (* 2 idx))
+                                  (create-node edit (+ shift 5) key-or-nil val-or-node hash key val))))))))
+
+  (inode-without! [inode edit shift hash key removed-leaf?]
+    (let [bit (bitpos hash shift)]
+      (if (zero? (bit-and bitmap bit))
+        inode
+        (let [idx         (bitmap-indexed-node-index bitmap bit)
+              key-or-nil  (aget arr (* 2 idx))
+              val-or-node (aget arr (inc (* 2 idx)))]
+          (cond (coercive-= nil key-or-nil)
+                (let [n (.inode-without! val-or-node edit (+ shift 5) hash key removed-leaf?)]
+                  (cond (identical? n val-or-node) inode
+                        (coercive-not= nil n) (edit-and-set inode edit (inc (* 2 idx)) n)
+                        (== bitmap bit) nil
+                        :else (.edit-and-remove-pair inode edit bit idx)))
+                (= key key-or-nil)
+                (do (aset removed-leaf? 0 true)
+                    (.edit-and-remove-pair inode edit bit idx))
+                :else inode))))))
+
+(set! cljs.core.BitmapIndexedNode/EMPTY (BitmapIndexedNode. nil 0 (make-array 0)))
+
+(defn- pack-array-node [array-node edit idx]
   (let [arr     (.-arr array-node)
         len     (* 2 (dec (.-cnt array-node)))
         new-arr (make-array len)]
@@ -2978,19 +3120,19 @@
           (do (aset new-arr j (aget arr i))
               (recur (inc i) (+ j 2) (bit-or bitmap (bit-shift-left 1 i))))
           (recur (inc i) j bitmap))
-        (BitmapIndexedNode. bitmap new-arr)))))
-
-(deftype ArrayNode [cnt arr]
+        (BitmapIndexedNode. edit bitmap new-arr)))))
+
+(deftype ArrayNode [edit ^:mutable cnt ^:mutable arr]
   Object
   (inode-assoc [inode shift hash key val added-leaf?]
     (let [idx  (mask hash shift)
           node (aget arr idx)]
       (if (coercive-= nil node)
-        (ArrayNode. (inc cnt) (clone-and-set arr idx (.inode-assoc cljs.core.BitmapIndexedNode/EMPTY (+ shift 5) hash key val added-leaf?)))
+        (ArrayNode. nil (inc cnt) (clone-and-set arr idx (.inode-assoc cljs.core.BitmapIndexedNode/EMPTY (+ shift 5) hash key val added-leaf?)))
         (let [n (.inode-assoc node (+ shift 5) hash key val added-leaf?)]
           (if (identical? n node)
             inode
-            (ArrayNode. cnt (clone-and-set arr idx n)))))))
+            (ArrayNode. nil cnt (clone-and-set arr idx n)))))))

   (inode-without [inode shift hash key]
     (let [idx  (mask hash shift)
@@ -3004,10 +3146,10 @@
             (nil? n)
             (if (<= cnt 8)
               (pack-array-node inode idx)
-              (ArrayNode. (dec cnt) (clone-and-set arr idx n)))
+              (ArrayNode. nil (dec cnt) (clone-and-set arr idx n)))

             :else
-            (ArrayNode. cnt (clone-and-set arr idx n))))
+            (ArrayNode. nil cnt (clone-and-set arr idx n))))
         inode)))

   (inode-find [inode shift hash key]
@@ -3025,7 +3167,44 @@
         not-found)))

   (inode-seq [inode]
-    (create-array-node-seq arr)))
+    (create-array-node-seq arr))
+
+  (ensure-editable [inode e]
+    (if (identical? e edit)
+      inode
+      (ArrayNode. e cnt (aclone arr))))
+
+  (inode-assoc! [inode edit shift hash key val added-leaf?]
+    (let [idx  (mask hash shift)
+          node (aget arr idx)]
+      (if (coercive-= nil node)
+        (let [editable (edit-and-set inode edit idx (.inode-assoc! cljs.core.BitmapIndexedNode/EMPTY edit (+ shift 5) hash key val added-leaf?))]
+          (set! (.-cnt editable) (inc (.-cnt editable)))
+          editable)
+        (let [n (.inode-assoc! node edit (+ shift 5) hash key val added-leaf?)]
+          (if (identical? n node)
+            inode
+            (edit-and-set inode edit idx n))))))
+
+  (inode-without! [inode edit shift hash key removed-leaf?]
+    (let [idx  (mask hash shift)
+          node (aget arr idx)]
+      (if (coercive-= nil node)
+        inode
+        (let [n (.inode-without! node edit (+ shift 5) hash key removed-leaf?)]
+          (cond
+            (identical? n node)
+            inode
+
+            (coercive-= nil n)
+            (if (<= cnt 8)
+              (pack-array-node inode edit idx)
+              (let [editable (edit-and-set inode edit idx n)]
+                (set! (.-cnt editable) (dec (.-cnt editable)))
+                editable))
+
+            :else
+            (edit-and-set inode edit idx n)))))))

 (defn- hash-collision-node-find-index [arr cnt key]
   (let [lim (* 2 cnt)]
@@ -3036,7 +3215,10 @@
           (recur (+ i 2)))
         -1))))

-(deftype HashCollisionNode [__hash cnt arr]
+(deftype HashCollisionNode [edit
+                            ^:mutable __hash
+                            ^:mutable cnt
+                            ^:mutable arr]
   Object
   (inode-assoc [inode shift hash key val added-leaf?]
     (if (== hash __hash)
@@ -3048,18 +3230,18 @@
             (aset new-arr len key)
             (aset new-arr (inc len) val)
             (aset added-leaf? 0 true)
-            (HashCollisionNode. __hash (inc cnt) new-arr))
+            (HashCollisionNode. nil __hash (inc cnt) new-arr))
           (if (= (aget arr idx) val)
             inode
-            (HashCollisionNode. __hash cnt (clone-and-set arr (inc idx) val)))))
-      (.inode-assoc (BitmapIndexedNode. (bitpos __hash shift) (array nil inode))
+            (HashCollisionNode. nil __hash cnt (clone-and-set arr (inc idx) val)))))
+      (.inode-assoc (BitmapIndexedNode. nil (bitpos __hash shift) (array nil inode))
                     shift hash key val added-leaf?)))

   (inode-without [inode shift hash key]
     (let [idx (hash-collision-node-find-index arr cnt key)]
       (cond (== idx -1) inode
             (== cnt 1)  nil
-            :else (HashCollisionNode. __hash (dec cnt) (remove-pair arr (quot idx 2))))))
+            :else (HashCollisionNode. nil __hash (dec cnt) (remove-pair arr (quot idx 2))))))

   (inode-find [inode shift hash key]
     (let [idx (hash-collision-node-find-index arr cnt key)]
@@ -3074,16 +3256,77 @@
             :else                  not-found)))

   (inode-seq [inode]
-    (create-inode-seq arr)))
-
-(defn- create-node [shift key1 val1 key2hash key2 val2]
-  (let [key1hash (hash key1)]
-    (if (== key1hash key2hash)
-      (HashCollisionNode. key1hash 2 (array key1 val1 key2 val2))
-      (let [added-leaf? (array false)]
-        (-> cljs.core.BitmapIndexedNode/EMPTY
-            (.inode-assoc shift key1hash key1 val1 added-leaf?)
-            (.inode-assoc shift key2hash key2 val2 added-leaf?))))))
+    (create-inode-seq arr))
+
+  (ensure-editable [inode e]
+    (if (identical? e edit)
+      inode
+      (let [new-arr (make-array (* 2 (inc cnt)))]
+        (array-copy arr 0 new-arr 0 (* 2 cnt))
+        (HashCollisionNode. e __hash cnt new-arr))))
+
+  (ensure-editable [inode e count array]
+    (if (identical? e edit)
+      (do (set! arr array)
+          (set! cnt count)
+          inode)
+      (HashCollisionNode. edit __hash count array)))
+
+  (inode-assoc! [inode edit shift hash key val added-leaf?]
+    (if (== hash __hash)
+      (let [idx (hash-collision-node-find-index arr cnt key)]
+        (if (== idx -1)
+          (if (> (.-length arr) (* 2 cnt))
+            (let [editable (edit-and-set inode edit (* 2 cnt) key (inc (* 2 cnt)) val)]
+              (aset added-leaf? 0 true)
+              (set! (.-cnt editable) (inc (.-cnt editable)))
+              editable)
+            (let [len     (.-length arr)
+                  new-arr (make-array (+ len 2))]
+              (array-copy arr 0 new-arr 0 len)
+              (aset new-arr len key)
+              (aset new-arr (inc len) val)
+              (aset added-leaf? 0 true)
+              (.ensure-editable inode edit (inc cnt) new-arr)))
+          (if (identical? (aget arr (inc idx)) val)
+            inode
+            (edit-and-set inode edit (inc idx) val))))
+      (.inode-assoc! (BitmapIndexedNode. edit (bitpos __hash shift) (array nil inode nil nil))
+                     edit shift hash key val added-leaf?)))
+
+  (inode-without! [inode edit shift hash key removed-leaf?]
+    (let [idx (hash-collision-node-find-index arr cnt key)]
+      (if (== idx -1)
+        inode
+        (do (aset removed-leaf? 0 true)
+            (if (== cnt 1)
+              nil
+              (let [editable (.ensure-editable inode edit)
+                    earr     (.-arr editable)]
+                (aset earr idx (aget earr (- (* 2 cnt) 2)))
+                (aset earr (inc idx) (aget earr (dec (* 2 cnt))))
+                (aset earr (dec (* 2 cnt)) nil)
+                (aset earr (- (* 2 cnt) 2) nil)
+                (set! (.-cnt editable) (dec (.-cnt editable)))
+                editable)))))))
+
+(defn- create-node
+  ([shift key1 val1 key2hash key2 val2]
+     (let [key1hash (hash key1)]
+       (if (== key1hash key2hash)
+         (HashCollisionNode. nil key1hash 2 (array key1 val1 key2 val2))
+         (let [added-leaf? (array false)]
+           (-> cljs.core.BitmapIndexedNode/EMPTY
+               (.inode-assoc shift key1hash key1 val1 added-leaf?)
+               (.inode-assoc shift key2hash key2 val2 added-leaf?))))))
+  ([edit shift key1 val1 key2hash key2 val2]
+     (let [key1hash (hash key1)]
+       (if (== key1hash key2hash)
+         (HashCollisionNode. nil key1hash 2 (array key1 val1 key2 val2))
+         (let [added-leaf? (array false)]
+           (-> cljs.core.BitmapIndexedNode/EMPTY
+               (.inode-assoc! edit shift key1hash key1 val1 added-leaf?)
+               (.inode-assoc! edit shift key2hash key2 val2 added-leaf?)))))))

 (deftype NodeSeq [meta nodes i s]
   IMeta
@@ -3159,6 +3402,8 @@
                (recur (inc j))))))
        (ArrayNodeSeq. meta nodes i s))))

+(declare TransientHashMap)
+
 (deftype PersistentHashMap [meta cnt root has-nil? nil-val]
   Object
   (toString [this]
@@ -3245,17 +3490,123 @@
     (-lookup coll k))

   (-invoke [coll k not-found]
-    (-lookup coll k not-found)))
+    (-lookup coll k not-found))
+
+  IEditableCollection
+  (-as-transient [coll]
+    (TransientHashMap. (js-obj) root cnt has-nil? nil-val)))

 (set! cljs.core.PersistentHashMap/EMPTY (PersistentHashMap. nil 0 nil false nil))

 (set! cljs.core.PersistentHashMap/fromArrays
       (fn [ks vs]
         (let [len (.-length ks)]
-          (loop [i 0 out cljs.core.PersistentHashMap/EMPTY]
+          (loop [i 0 out (transient cljs.core.PersistentHashMap/EMPTY)]
             (if (< i len)
-              (recur (inc i) (assoc out (aget ks i) (aget vs i)))
-              out)))))
+              (recur (inc i) (assoc! out (aget ks i) (aget vs i)))
+              (persistent! out))))))
+
+(deftype TransientHashMap [^:mutable edit
+                           ^:mutable root
+                           ^:mutable count
+                           ^:mutable has-nil?
+                           ^:mutable nil-val]
+  Object
+  (conj! [tcoll o]
+    (if edit
+      (if (satisfies? IMapEntry o)
+        (.assoc! tcoll (key o) (val o))
+        (loop [es (seq o) tcoll tcoll]
+          (if-let [e (first es)]
+            (recur (next es)
+                   (.assoc! tcoll (key e) (val e)))
+            tcoll)))
+      (throw (js/Error. "conj! after persistent"))))
+
+  (assoc! [tcoll k v]
+    (if edit
+      (if (nil? k)
+        (do (if (identical? nil-val v)
+              nil
+              (set! nil-val v))
+            (if has-nil?
+              nil
+              (do (set! count (inc count))
+                  (set! has-nil? true)))
+            tcoll)
+        (let [added-leaf? (array false)
+              node        (-> (if (nil? root)
+                                cljs.core.BitmapIndexedNode/EMPTY
+                                root)
+                              (.inode-assoc! edit 0 (hash k) k v added-leaf?))]
+          (if (identical? node root)
+            nil
+            (set! root node))
+          (if (aget added-leaf? 0)
+            (set! count (inc count)))
+          tcoll))
+      (throw (js/Error. "assoc! after persistent!"))))
+
+  (without! [tcoll k]
+    (if edit
+      (if (nil? k)
+        (if has-nil?
+          (do (set! has-nil? false)
+              (set! nil-val nil)
+              (set! count (dec count))
+              tcoll)
+          tcoll)
+        (if (nil? root)
+          tcoll
+          (let [removed-leaf? (array false)
+                node (.inode-without! root edit 0 (hash k) k removed-leaf?)]
+            (if (identical? node root)
+              nil
+              (set! root node))
+            (if (aget removed-leaf? 0)
+              (set! count (dec count)))
+            tcoll)))
+      (throw (js/Error. "dissoc! after persistent!"))))
+
+  (persistent! [tcoll]
+    (if edit
+      (do (set! edit nil)
+          (PersistentHashMap. nil count root has-nil? nil-val))
+      (throw (js/Error. "persistent! called twice"))))
+
+  ICounted
+  (-count [coll]
+    (if edit
+      count
+      (throw (js/Error. "count after persistent!"))))
+
+  ILookup
+  (-lookup [tcoll k]
+    (if (nil? k)
+      (if has-nil?
+        nil-val)
+      (if (nil? root)
+        nil
+        (nth (.inode-find root 0 (hash k) k) 1))))
+
+  (-lookup [tcoll k not-found]
+    (if (nil? k)
+      (if has-nil?
+        nil-val
+        not-found)
+      (if (nil? root)
+        not-found
+        (nth (.inode-find root 0 (hash k) k not-found) 1))))
+
+  ITransientCollection
+  (-conj! [tcoll val] (.conj! tcoll val))
+
+  (-persistent! [tcoll] (.persistent! tcoll))
+
+  ITransientAssociative
+  (-assoc! [tcoll key val] (.assoc! tcoll key val))
+
+  (-dissoc! [tcoll key] (.without! tcoll key)))

 (defn hash-map
   "keyval => key val


* src/cljs/cljs/core.cljs: make array ops conform to Clojure's api. make-array, object-array, long-array, double-array, into-array fixed. added seqable? predicate.

--- src/cljs/cljs/core.cljs
+++ src/cljs/cljs/core.cljs
@@ -77,8 +77,10 @@
   (js* "Array.prototype.slice.call(arguments)"))

 (defn make-array
-  [n]
-  (js* "new Array(~{n})"))
+  ([size]
+     (js* "new Array(~{size})"))
+  ([type size]
+     (make-array size)))

 (declare apply)

@@ -101,17 +103,11 @@

 (declare reduce)

-(defn into-array [coll]
-  (reduce (fn [a x] (.push a x) a) (array) coll))
-
-(defn long-array [coll]
-  (array))
-
-(defn double-array [coll]
-  (array))
-
-(defn object-array [coll]
-  (array))
+(defn into-array
+  ([aseq]
+     (into-array nil aseq))
+  ([type aseq]
+     (reduce (fn [a x] (.push a x) a) (array) aseq)))

 ;;;;;;;;;;;;;;;;;;;;;;;;;;; core protocols ;;;;;;;;;;;;;

@@ -707,6 +703,13 @@
     false
     (satisfies? ISeq s)))

+(defn ^boolean seqable?
+  "Return true if s satisfies ISeqable"
+  [s]
+  (if (nil? s)
+    false
+    (satisfies? ISeqable s)))
+
 (defn ^boolean boolean [x]
   (if x true false))

@@ -1451,6 +1454,69 @@
           (aset ret i (to-array (first xs)))
           (recur (inc i) (next xs))))
       ret))
+
+(defn long-array
+  ([size-or-seq]
+     (cond
+      (number? size-or-seq) (long-array size-or-seq nil)
+      (seq? size-or-seq) (into-array size-or-seq)
+      :else (throw (js/Error. "long-array called with something other than size or ISeqable"))))
+  ([size init-val-or-seq]
+     (let [a (make-array size)]
+       (if (seq? init-val-or-seq)
+         (let [s (seq init-val-or-seq)]
+           (loop [i 0 s s]
+             (if (and s (< i size))
+               (do
+                 (aset a i (first s))
+                 (recur (inc i) (next s)))
+               a)))
+         (do
+           (dotimes [i size]
+             (aset a i init-val-or-seq))
+           a)))))
+
+(defn double-array
+  ([size-or-seq]
+     (cond
+      (number? size-or-seq) (double-array size-or-seq nil)
+      (seq? size-or-seq) (into-array size-or-seq)
+      :else (throw (js/Error. "double-array called with something other than size or ISeqable"))))
+  ([size init-val-or-seq]
+     (let [a (make-array size)]
+       (if (seq? init-val-or-seq)
+         (let [s (seq init-val-or-seq)]
+           (loop [i 0 s s]
+             (if (and s (< i size))
+               (do
+                 (aset a i (first s))
+                 (recur (inc i) (next s)))
+               a)))
+         (do
+           (dotimes [i size]
+             (aset a i init-val-or-seq))
+           a)))))
+
+(defn object-array
+  ([size-or-seq]
+     (cond
+      (number? size-or-seq) (object-array size-or-seq nil)
+      (seq? size-or-seq) (into-array size-or-seq)
+      :else (throw (js/Error. "object-array called with something other than size or ISeqable"))))
+  ([size init-val-or-seq]
+     (let [a (make-array size)]
+       (if (seq? init-val-or-seq)
+         (let [s (seq init-val-or-seq)]
+           (loop [i 0 s s]
+             (if (and s (< i size))
+               (do
+                 (aset a i (first s))
+                 (recur (inc i) (next s)))
+               a)))
+         (do
+           (dotimes [i size]
+             (aset a i init-val-or-seq))
+           a)))))

 (defn- bounded-count [s n]
   (loop [s s i n sum 0]


reorg cljs code

reorg cljs code

--- src/cljs/lumo/repl.cljs
+++ src/cljs/lumo/repl.cljs
@@ -308,6 +308,9 @@
 ;; =============================================================================
 ;; REPL plumbing

+;; --------------------
+;; Parinfer indentation
+
 (defn- calc-parinfer-opts [text pos]
   (let [x (.lastIndexOf text "\n")]
     #js {:cursorX    (- pos (inc x))
@@ -329,39 +332,10 @@
           0))
       0)))

-(defn- current-alias-map []
-  (let [cur-ns @current-ns]
-    (into {} (remove (fn [[k v]] (= k v)))
-      (merge (get-in @st [::ana/namespaces cur-ns :requires])
-        (get-in @st [::ana/namespaces cur-ns :require-macros])))))
-
-(defn- reader-eof? [msg]
-  (or
-    (= "EOF while reading" msg)
-    (= "EOF while reading string" msg)))
-
-(defn- read-chars
-  [reader]
-  (let [sb (StringBuffer.)]
-    (loop [c (rt/read-char reader)]
-      (if-not (nil? c)
-        (do
-          (.append sb c)
-          (recur (rt/read-char reader)))
-        (str sb)))))
-
-(defn- repl-read-string
-  "Returns a vector of the first read form, and any balance text."
-  [source]
-  (let [reader (rt/string-push-back-reader source)
-        cur-ns @current-ns]
-    (binding [ana/*cljs-ns* cur-ns
-              *ns* (create-ns cur-ns)
-              env/*compiler* st
-              r/*data-readers* tags/*cljs-data-readers*
-              r/resolve-symbol ana/resolve-symbol
-              r/*alias-map* (current-alias-map)]
-      [(r/read {:read-cond :allow :features #{:cljs}} reader) (read-chars reader)])))
+;; --------------------
+;; Brace highlighting
+
+(declare repl-read-string)

 (defn- is-completely-readable?
   [source]
@@ -419,11 +393,8 @@
         start-idx (form-start source pos)]
     (calc-highlight-coords lines start-idx pos)))

-(defn make-eval-opts []
-  (let [{:keys [verbose static-fns]} @app-opts]
-    {:ns            @current-ns
-     :verbose       verbose
-     :static-fns    static-fns}))
+;; --------------------
+;; Error handling

 (defn- ^:boolean could-not-eval? [msg]
   (boolean (re-find could-not-eval-regex msg)))
@@ -446,6 +417,9 @@
       :else
       (println error))))

+;; --------------------
+;; REPL specials
+
 (defn- compiler-state-backup []
   {:st     @st
    :loaded @cljs/*loaded*})
@@ -467,18 +441,6 @@
            (restore-compiler-state! backup)
            (throw e)))))))

-(declare execute execute-source)
-
-(defn- execute-path [filename opts]
-  (load {:file filename}
-    (fn [{:keys [lang source cache]}]
-      (if source
-        (execute-source source (merge opts
-                                 {:type "text"
-                                  :filename filename
-                                  :expression? false}))
-        (handle-repl-error (ex-info (str "Could not load file " filename) {}))))))
-
 (defn- root-resource
   "Returns the root directory path for a lib"
   [lib]
@@ -506,6 +468,8 @@
   [wfn fns]
   "Wrap wfn around all (fn) values in fns hashmap."
   (into {} (for [[k v] fns] [k (wfn v)])))
+
+(declare execute-path)

 (def ^:private repl-special-fns
   (let [load-file-fn
@@ -544,6 +508,58 @@

 (defn- repl-special? [form]
   (and (seq? form) (contains? repl-special-fns (first form))))
+
+(defn make-eval-opts []
+  (let [{:keys [verbose static-fns]} @app-opts]
+    {:ns            @current-ns
+     :verbose       verbose
+     :static-fns    static-fns}))
+
+(defn- current-alias-map []
+  (let [cur-ns @current-ns]
+    (into {} (remove (fn [[k v]] (= k v)))
+      (merge (get-in @st [::ana/namespaces cur-ns :requires])
+        (get-in @st [::ana/namespaces cur-ns :require-macros])))))
+
+(defn- reader-eof? [msg]
+  (or
+    (= "EOF while reading" msg)
+    (= "EOF while reading string" msg)))
+
+(defn- read-chars
+  [reader]
+  (let [sb (StringBuffer.)]
+    (loop [c (rt/read-char reader)]
+      (if-not (nil? c)
+        (do
+          (.append sb c)
+          (recur (rt/read-char reader)))
+        (str sb)))))
+
+(defn- repl-read-string
+  "Returns a vector of the first read form, and any balance text."
+  [source]
+  (let [reader (rt/string-push-back-reader source)
+        cur-ns @current-ns]
+    (binding [ana/*cljs-ns* cur-ns
+              *ns* (create-ns cur-ns)
+              env/*compiler* st
+              r/*data-readers* tags/*cljs-data-readers*
+              r/resolve-symbol ana/resolve-symbol
+              r/*alias-map* (current-alias-map)]
+      [(r/read {:read-cond :allow :features #{:cljs}} reader) (read-chars reader)])))
+
+(declare execute-source)
+
+(defn- execute-path [filename opts]
+  (load {:file filename}
+    (fn [{:keys [lang source cache]}]
+      (if source
+        (execute-source source (merge opts
+                                 {:type "text"
+                                  :filename filename
+                                  :expression? false}))
+        (handle-repl-error (ex-info (str "Could not load file " filename) {}))))))

 (defn- execute-text
   [source {:keys [expression? filename] :as opts}]
@@ -648,7 +664,7 @@
   (load-core-analysis-caches repl?)
   (deps/index-upstream-foreign-libs))

-;; =============================================================================
+;; --------------------
 ;; Autocompletion

 (defn- drop-macros-suffix


adding dependency on pages to core

adding dependency on pages to core

--- src/cljs/ohds/core.cljs
+++ src/cljs/ohds/core.cljs
@@ -4,7 +4,8 @@
             [cljs.core.async :refer [<!]]
             [cognitect.transit :as t]
             [reagent.core :as reagent :refer [atom]]
-            [ohds.components :as c]))
+            [ohds.components :as c]
+            [ohds.pages :as p]))

 (enable-console-print!)


Refactor

Refactor

--- src/cljs/shop/core.cljs
+++ src/cljs/shop/core.cljs
@@ -136,40 +136,31 @@
      (str "https://res.cloudinary.com/relay-foods/image/upload/"
        "q_40,h_" h ",w_" w ",c_fill/" name ".JPG")))

-(defn list-items
-  ([items] (list-items items 150 200))
-  ([items w h]
-     (dom/ul {:class "list-group"}
-       (map #(dom/li {:class "list-group-item "}
-               (dom/img  {:src (image (get-in % [:Image :Filename]) w h)})
-               (dom/span {:class "brand"} (get-in % [:Brand :Name]))
-               (dom/span {:class "name"} (get-in % [:Name]))
-               (dom/span {:class "price"} (->> % :Variants first :price)))
-         items))))
-
-(defn list-items2 [items]
-  (dom/div
-    (map #(dom/div {:class "flip-container"}
-            (dom/div {:class "flipper"}
-              (dom/div {:class "front"}
-                (dom/img  {:src (image (get-in % [:Image :Filename]))}))
-              (dom/div {:class "back"}
-                (dom/span {:class "brand"} (get-in % [:Brand :Name]))
-                (dom/span {:class "name"} (get-in % [:Name]))
-                (dom/span {:class "price"} (->> % :Variants first :Price)))))
-      items)))
-
 (defcomponent available-products [data owner]
   (render [_]
     (dom/div {:class "col-xs-9 available-products"}
       (dom/h2 "Available Products")
-      (list-items (:Items data)))))
+      (dom/div
+        (map #(dom/div {:class "flip-container"}
+                (dom/div {:class "flipper"}
+                  (dom/div {:class "front"}
+                    (dom/img  {:src (image (get-in % [:Image :Filename]))}))
+                  (dom/div {:class "back"}
+                    (dom/span {:class "brand"} (get-in % [:Brand :Name]))
+                    (dom/span {:class "name"} (get-in % [:Name]))
+                    (dom/span {:class "price"} (->> % :Variants first :Price)))))
+          (:Items data))))))

 (defcomponent cart [data owner]
   (render [_]
     (dom/div {:class "col-xs-3 pull-right cart"}
       (dom/h2 "Cart")
-      (list-items (:cart data) 67 53))))
+      (dom/ul {:class "list-group"}
+        (map #(dom/li {:class "list-group-item "}
+                (dom/img  {:src (image (get-in % [:Image :Filename]) 67 53)})
+                (dom/span {:class "brand"} (get-in % [:Brand :Name]))
+                (dom/span {:class "name"} (get-in % [:Name])))
+          (:cart data))))))

 (defcomponent app [data owner]
   (render [_]


Removed commented-out record-based-states.

--- src/clojush/clojush.clj
+++ src/clojush/clojush.clj
@@ -39,34 +39,6 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; states, stacks, and instructions

-;; 20101017
-;; record-based states, should be faster but aren't measurably so (see measurements)
-;; reverting to structs for greater flexibility in use of state as map
-
-;; useful for define-push-state-record-type
-;(defn keyword->symbol [kwd]
-;  "Returns the symbol obtained by removing the : from a keyword."
-;  (read-string (name kwd)))
-;
-;(defmacro define-push-state-record-type []
-;  "Defines the pushstate record type. The odd trick with read-string was a hack to
-;avoid namespace qualification on the pushstate symbol."
-;  `(defrecord ~(read-string "pushstate") [~@(map keyword->symbol push-types)]))
-;
-;(define-push-state-record-type)
-;
-;(defmacro make-push-state
-;  "Returns an empty push state."
-;  []
-;  `(pushstate. ~@(map (fn [_] nil) push-types)))
-
-;1:3 clojush=> (time (stress-test 100000))
-;:no-errors-found-in-stress-test
-;"Elapsed time: 57673.781 msecs"
-; more runs:
-;"Elapsed time: 57682.971 msecs"
-;"Elapsed time: 55129.614 msecs"
-
 ;; struct-based states follow

 (defmacro define-push-state-structure []
@@ -79,13 +51,6 @@
   []
   (struct-map push-state))

-;; corresponding results for struct-based states
-;1:3 clojush=> (time (stress-test 100000))
-;:no-errors-found-in-stress-test
-;"Elapsed time: 59194.123 msecs"
-; more runs:
-;"Elapsed time: 52389.016 msecs"
-;"Elapsed time: 54706.127 msecs"

 (def registered-instructions (atom #{}))


better aggregated rating message

better aggregated rating message

--- src/cljs/conference_rating/conference_detail_page/aggregated_ratings.cljs
+++ src/cljs/conference_rating/conference_detail_page/aggregated_ratings.cljs
@@ -127,6 +127,7 @@
         no-ratings-msg            (if is-future-conference?
                                     "This conference has not started yet and no conference of this series has been rated yet. Come back later!"
                                     "This conference has not been rated yet. Be the first one to give it your voice!")
+        aggregated-ratings-msg    (str "Note: This ratings are aggregated from ratings of previous " (:series conference) " conferences.")
         overall-avg               (get-in ratings [:overall :avg])
         overall-avg-percentage    (* (/ overall-avg 4) 100)
         overall-ratings-str       (str (get-in ratings [:overall :count]) " ratings")
@@ -144,7 +145,7 @@
        [:div {:class "no-ratings-info"} no-ratings-msg])
      [:div {:class (if has-ratings? "" "no-ratings")}
       (if (and has-ratings? is-future-conference?)
-        (panel/coloured-panel nil "Note: This ratings are aggregated from ratings of previous conferences of the same series." "bg-yellow-lightened" "text-lg-center bg-yellow-lightened"))
+        (panel/coloured-panel nil aggregated-ratings-msg "bg-yellow-lightened" "text-lg-center bg-yellow-lightened"))
       (conference-recommendations (:recommendations ratings))
       [:div {:class "row"}
        [:div {:class "col-lg-6 col-md-6 col-sm-6"}


separate and identify SnapshotID

separate and identify SnapshotID

--- src/cljs/org/broadinstitute/firecloud_ui/page/method_config_importer.cljs
+++ src/cljs/org/broadinstitute/firecloud_ui/page/method_config_importer.cljs
@@ -239,7 +239,9 @@
                     (style/create-link
                       (let [func (if (= :method (:type item)) :on-method-selected :on-config-selected)]
                         #((func props) (dissoc item :type)))
-                      (str  (item "namespace") "/" (item "name") "/" (item "snapshotId")   )))}
+                      (str  (item "namespace") "/"
+                        (item "name")
+                        " Snapshot ID:" (item "snapshotId"))))}
                  {:header "Synopsis" :starting-width 160}
                  (table/date-column {:header "Created"})
                  {:header "Referenced Method" :starting-width 250


Disallow `local-kinesis` profile from executing the TTL migration

--- src/kixi/datastore/filestore/migrators/dynamodb/migrator_20171221_ttl.clj
+++ src/kixi/datastore/filestore/migrators/dynamodb/migrator_20171221_ttl.clj
@@ -39,7 +39,8 @@
         conn (get-db-config db)
         items (not-empty (slow-scan conn (fsdb/primary-upload-cache-table profile) (keyword fsdb/id-col)))]
     ;; Set ttl column
-    (when-not (= "local" profile)
+    (when-not (or (= "local" profile)
+                  (= "local-kinesis" profile))
       (far/update-ttl conn (fsdb/primary-upload-cache-table profile) true ttl-col))
     ;; Then add ttl column
     (when items
@@ -55,7 +56,8 @@
         conn (get-db-config db)
         items (not-empty (far/scan conn (fsdb/primary-upload-cache-table profile)))]
     ;; Set ttl column
-    (when-not (= "local" profile)
+    (when-not (or (= "local" profile)
+                  (= "local-kinesis" profile))
       (far/update-ttl conn (fsdb/primary-upload-cache-table profile) false ttl-col))
     ;; Then add ttl column
     (when items


More readable angle bracket parameters.

More readable angle bracket parameters.


Monkey-patch jdbc to eliminate reflection.

--- src/cavm/statement.clj
+++ src/cavm/statement.clj
@@ -63,3 +63,29 @@
     (watch-destroy (fn [conn] (swap! cache dissoc conn))) ; XXX leak stmt?
     (fn [conn & args]
       ((lookup conn) args))))
+
+;
+; monkey-patch jdbc to fix performance bug
+(in-ns 'clojure.java.jdbc)
+(defn- db-do-execute-prepared-statement [db ^PreparedStatement stmt param-groups transaction?]
+  (if (empty? param-groups)
+    (if transaction?
+      (with-db-transaction [t-db (add-connection db (.getConnection stmt))]
+        (vector (.executeUpdate stmt)))
+      (try
+        (vector (.executeUpdate stmt))
+        (catch Exception e
+          (throw-non-rte e))))
+    (do
+      (doseq [param-group param-groups]
+              ((or (:set-parameters db) set-parameters) stmt param-group)
+              (.addBatch stmt))
+      (if transaction?
+        (with-db-transaction [t-db (add-connection db (.getConnection stmt))]
+          (execute-batch stmt))
+        (try
+          (execute-batch stmt)
+          (catch Exception e
+            (throw-non-rte e)))))))
+
+(in-ns 'cavm.statement)


Placeholder on-render-cb.

Placeholder on-render-cb.

--- src/cbfg/world/t1.cljs
+++ src/cbfg/world/t1.cljs
@@ -160,7 +160,9 @@
                   :chs {} ; {ch -> {:id (gen-id), :msgs {msg -> true},
                           ;         :first-taker-actx actx-or-nil}}.
                   :gen-id gen-id})
-            render-ch (chan)]
+            render-ch (chan)
+            render-cb (fn [vis-next]
+                        (println :on-render-cb @last-id))]
         (reset! prog-world {:world world
                             :net-listen-ch (achan-buf world 10)
                             :net-connect-ch (achan-buf world 10)
@@ -168,7 +170,7 @@
                             :clients {}})
         (cbfg.vis/process-events vis event-delay cbfg.vis/vis-event-handlers
                                  event-ch step-ch render-ch)
-        (cbfg.vis/process-render el-prefix world render-ch nil)
+        (cbfg.vis/process-render el-prefix world render-ch render-cb)
         (make-net world
                   (:net-listen-ch @prog-world)
                   (:net-connect-ch @prog-world))


refactor `clock` a bit

refactor `clock` a bit

--- src/chronoid/core.cljs
+++ src/chronoid/core.cljs
@@ -11,6 +11,11 @@
    time you call `clock` and is reused for any subsequent clocks."
   (atom nil))

+(defn new-audio-context
+  []
+  (let [Context (or js/window.AudioContext js/window.webkitAudioContext)]
+    (Context.)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

 ;; For all of the public functions, the `clock` arguments are atom references to
@@ -20,20 +25,6 @@

 (defn clock
   [& {:as attrs}]
-  (let [ctx (if @audio-context @audio-context
-              (let [ct (or js/window.AudioContext js/window.webkitAudioContext)
-                    inst (ct.)]
-                (reset! audio-context inst)))
-        id           (gensym "clock")
-        clock        (merge default-options
-                            attrs
-                            {:context ctx
-                             :id      id
-                             :events  []
-                             :started false})
-        atomic-clock (atom clock)]
-    (set! *clocks* (assoc *clocks* id atomic-clock))
-    atomic-clock))

 (defn- current-time*
   "Internal implementation for the public function current-time, which works
@@ -42,6 +33,17 @@
    This internal version works on non-atom-wrapped clocks."
   [{:keys [context] :as clock}]
   (* 1000 (.-currentTime context)))
+  (let [ctx        (swap! audio-context #(or % (new-audio-context)))
+        id         (gensym "clock")
+        clock      (merge default-options
+                          attrs
+                          {:context ctx
+                           :id      id
+                           :events  []
+                           :started false})
+        clock-atom (atom clock)]
+    (set! *clocks* (assoc *clocks* id clock-atom))
+    clock-atom))

 (defn current-time
   "Returns the current time of a clock's audio context, in milliseconds."


add jor-of-ns

add jor-of-ns

--- src/clj/flambo/api.clj
+++ src/clj/flambo/api.clj
@@ -37,6 +37,10 @@
                  (conf/master "local")
                  (conf/app-name app-name))]
     (spark-context conf)))
+
+(defn jar-of-ns [ns]
+  (let [clazz (Class/forName (clojure.string/replace (str ns) #"-" "_"))]
+    (JavaSparkContext/jarOfClass clazz)))

 (defsparkfn untuple [t]
   [(._1 t) (._2 t)])


sol board drawing

sol board drawing

--- src/cljs/sol/core.cljs
+++ src/cljs/sol/core.cljs
@@ -66,7 +66,9 @@
   [divisions]
   (let [interval (/ two-pi divisions)
         half (* 0.5 interval)]
-    (range half two-pi interval)))
+    (range half two-pi interval)
+    ;; (range 0 two-pi interval)
+))

 (defn radial-offset
   [center angle radius]
@@ -185,7 +187,7 @@
                                     (radial
                                      draw
                                      {:center board-center
-                                      :angle (+ js/Math.PI angle)
+                                      :angle (+ (* 1.5 js/Math.PI) angle)
                                       :begin-radius (:radius outer)
                                       :end-radius (:radius inner)
                                       :color (get radial-colors (:number outer)) ;; (:color inner)


importing only necessary functions

importing only necessary functions

--- src/clygments/core.clj
+++ src/clygments/core.clj
@@ -5,8 +5,8 @@
 (def ^{:private true} python
   (doto (PythonInterpreter.)
     (.exec (str "from pygments import highlight\n"
-                "from pygments.lexers import *\n"
-                "from pygments.formatters import *\n"))))
+                "from pygments.lexers import get_lexer_by_name\n"
+                "from pygments.formatters import get_formatter_by_name\n"))))

 (defn- exec-code-in
   "put the result of the execution of a line of code in a variable, with


[skip ci] Add modified playground.clj

[skip ci] Add modified playground.clj

--- dev/playground.clj
+++ dev/playground.clj
@@ -4,7 +4,7 @@
             [clojure.spec.alpha :as s]
             [clojure.walk :as w]
             [criterium.core :as c]
-            [mikron.runtime.core :as mikron :refer [defschema schema schema* pack unpack gen valid? diff undiff interp]]
+            [mikron.runtime.core :as mikron :refer [defschema schema schema* pack unpack gen valid? diff undiff diff* undiff* interp]]
             [mikron.runtime.buffer :refer :all]
             [no.disassemble :as d]))

@@ -70,3 +70,5 @@
        :processors
        :pack
        (d!)))
+
+(schema* :int :processors #{:pack :unpack})


Require config tests from test runner.

Require config tests from test runner.

--- test/active/clojure/test_runner.cljs
+++ test/active/clojure/test_runner.cljs
@@ -4,7 +4,8 @@
             [active.clojure.debug-test]
             [active.clojure.lens-test]
             [active.clojure.monad-test]
-            [active.clojure.record-test]))
+            [active.clojure.record-test]
+            [active.clojure.config-test]))

 (doo-tests 'active.clojure.condition-test
            'active.clojure.debug-test


Added missing test for is-square?, moved sparse-expander tests next to each other

--- test/clj/forma/matrix/utils_test.clj
+++ test/clj/forma/matrix/utils_test.clj
@@ -2,6 +2,10 @@
   (:use forma.matrix.utils
         midje.sweet)
   (:require [incanter.core :as i]))
+
+(fact "is-square? tests"
+  (is-square? (i/matrix (range 4) 2)) => true
+  (is-square? (i/matrix (range 6) 2)) => false)

 (facts "singular? tests."
   (singular? (i/matrix [[1 0] [1 0]])) => true
@@ -14,7 +18,7 @@
     (transpose (transpose coll-mat)) => coll-mat
     (count (transpose coll-mat)) => (count (first coll-mat))))

-(facts "check the values and dimension of the output."
+(fact "check `outer-product` - verify values and dimension of the output."
   (let [coll [1 2 3]
         outer (outer-product coll)]
     outer => '(1.0 2.0 3.0 2.0 4.0 6.0 3.0 6.0 9.0)
@@ -66,6 +70,15 @@
  [[10 1] [12 4] [8 1] [15 9] [16 1]] [1 0 4 0 0 9 1]
  [[10 1] [12 4] [8 1] [15 9]]        [1 0 4 0 0 9])

+(tabular
+ (fact "Sparse expansion can take custom start and length."
+   (apply sparse-expander 0 ?matrix ?opts) => ?result)
+ ?matrix         ?opts                  ?result
+ [[10 1] [12 9]] []                     [1 0 9]
+ [[10 1] [12 9]] [:start 8]             [0 0 1 0 9]
+ [[10 1] [12 9]] [:start 8 :length 10]  [0 0 1 0 9 0 0 0 0 0]
+ [[10 1] [15 9]] [:start 14 :length 3]  [0 9 0])
+
 (fact
   "Check `sparse-prep`"
   (sparse-prep [[3 2]] [[1 1]]) => [[3 1] [2 1]]
@@ -76,15 +89,6 @@
   "Check `sparsify`"
   (sparsify 1 -9999 [3 5] [[-9999 3 4 5] [-9999 5 5 6]]) => [3 -9999 5]
   (sparsify 2 -9999 [3 5] [[-9999 3 4 5] [-9999 5 5 6]]) => [4 -9999 5])
-
-(tabular
- (fact "Sparse expansion can take custom start and length."
-   (apply sparse-expander 0 ?matrix ?opts) => ?result)
- ?matrix         ?opts                  ?result
- [[10 1] [12 9]] []                     [1 0 9]
- [[10 1] [12 9]] [:start 8]             [0 0 1 0 9]
- [[10 1] [12 9]] [:start 8 :length 10]  [0 0 1 0 9 0 0 0 0 0]
- [[10 1] [15 9]] [:start 14 :length 3]  [0 9 0])

 (tabular
  (fact "idx and rowcol conversion for squares."


Fixed typo in compojure.html

Fixed typo in compojure.html

--- src/compojure/html.clj
+++ src/compojure/html.clj
@@ -15,5 +15,5 @@

 (immigrate
   'compojure.html.gen
-  'compojure.http.page-helpers
-  'compojure.http.form-helpers)
+  'compojure.html.page-helpers
+  'compojure.html.form-helpers)


Complete async testing

Complete async testing

--- test/reagenttest/testratomasync.cljs
+++ test/reagenttest/testratomasync.cljs
@@ -75,29 +75,36 @@
     (is (= (running) runs))))

 (deftest test-from-reflex
+  (sync)
   (let [runs (running)]
     (let [!counter (rv/atom 0)
           !signal (rv/atom "All I do is change")
-          co (run!
-              ;;when I change...
-              @!signal
-              ;;update the counter
-              (swap! !counter inc))]
+          co (ar (fn []
+                   ;;when I change...
+                   @!signal
+                   ;;update the counter
+                   (swap! !counter inc)))]
+      (is (= 0 @!counter))
+      (sync)
       (is (= 1 @!counter) "Constraint run on init")
       (reset! !signal "foo")
+      (sync)
       (is (= 2 @!counter)
           "Counter auto updated")
       (dispose co))
     (let [!x (rv/atom 0)
-          !co (rv/make-reaction #(inc @!x) :auto-run true)]
+          !co (rv/make-reaction #(inc @!x) :auto-run :async)]
+      (sync)
       (is (= 1 @!co) "CO has correct value on first deref")
-      (swap! !x inc)
+      (swap! !x inc)
+      (sync)
       (is (= 2 @!co) "CO auto-updates")
       (dispose !co))
     (is (= runs (running)))))

 (deftest test-unsubscribe
+  (sync)
   (dotimes [x testite]
     (let [runs (running)
           a (rv/atom 0)
@@ -111,31 +118,37 @@
           c (reaction
              (swap! c-changed inc)
              (+ 10 @a2))
-          res (run!
-               (if (< @a2 1) @b @c))]
+          res (ar (fn []
+                    (if (< @a2 1) @b @c)))]
       (is (= @res (+ 2 @a)))
       (is (= @b-changed 1))
       (is (= @c-changed 0))

       (reset! a -1)
-      (is (= @res (+ 2 @a)))
+      (is (= @b-changed 1))
+      (sync)
+
       (is (= @b-changed 2))
       (is (= @c-changed 0))
+      (is (= @res (+ 2 @a)))

       (reset! a 2)
+      (sync)
+      (is (= @b-changed 3))
+      (is (= @c-changed 1))
       (is (= @res (+ 10 @a)))
-      (is (<= 2 @b-changed 3))
-      (is (= @c-changed 1))

       (reset! a 3)
+      (sync)
+      (is (= @b-changed 3))
+      (is (= @c-changed 2))
       (is (= @res (+ 10 @a)))
-      (is (<= 2 @b-changed 3))
+
+      (reset! a 3)
+      (sync)
+      (is (= @b-changed 3))
       (is (= @c-changed 2))
-
-      (reset! a 3)
       (is (= @res (+ 10 @a)))
-      (is (<= 2 @b-changed 3))
-      (is (= @c-changed 2))

       (reset! a -1)
       (is (= @res (+ 2 @a)))
@@ -143,6 +156,7 @@
       (is (= runs (running))))))

 (deftest maybe-broken
+  (sync)
   (let [runs (running)]
     (let [runs (running)
           a (rv/atom 0)
@@ -150,8 +164,9 @@
           c (reaction (dec @a))
           d (reaction (str @b))
           res (rv/atom 0)
-          cs (run!
-              (reset! res @d))]
+          cs (ar
+              #(reset! res @d))]
+      (sync)
       (is (= @res "1"))
       (dispose cs))
     ;; should be broken according to https://github.com/lynaghk/reflex/issues/1
@@ -159,16 +174,17 @@
     (let [a (rv/atom 0)
           b (reaction (inc @a))
           c (reaction (dec @a))
-          d (run! [@b @c])]
+          d (ar (fn [] [@b @c]))]
       (is (= @d [1 -1]))
       (dispose d))
     (let [a (rv/atom 0)
           b (reaction (inc @a))
           c (reaction (dec @a))
-          d (run! [@b @c])
+          d (ar (fn [] [@b @c]))
           res (rv/atom 0)]
       (is (= @d [1 -1]))
-      (let [e (run! (reset! res @d))]
+      (let [e (ar #(reset! res @d))]
+        (sync)
         (is (= @res [1 -1]))
         (dispose e))
       (dispose d))
@@ -190,28 +206,33 @@
                               :on-dispose #(reset! disposed-c true))
           res (rv/atom nil)
           cns (rv/make-reaction #(reset! res @c)
-                                :auto-run true
+                                :auto-run :async
                                 :on-dispose #(reset! disposed-cns true))]
-      @cns
+      (sync)
       (is (= @res 2))
       (is (= (+ 4 runs) (running)))
       (is (= @count-b 1))
       (reset! a -1)
+      (is (= @res 2))
+      (sync)
       (is (= @res 1))
       (is (= @disposed nil))
       (is (= @count-b 2))
       (is (= (+ 4 runs) (running)) "still running")
       (reset! a 2)
+      (sync)
       (is (= @res 1))
       (is (= @disposed true))
       (is (= (+ 2 runs) (running)) "less running count")

       (reset! disposed nil)
       (reset! a -1)
+      (sync)
       ;; This fails sometimes on node. I have no idea why.
       (is (= 1 @res) "should be one again")
       (is (= @disposed nil))
       (reset! a 2)
+      (sync)
       (is (= @res 1))
       (is (= @disposed true))
       (dispose cns)
@@ -220,17 +241,20 @@
       (is (= runs (running))))))

 (deftest test-on-set
+  (sync)
   (let [runs (running)
         a (rv/atom 0)
         b (rv/make-reaction #(+ 5 @a)
-                            :auto-run true
+                            :auto-run :async
                             :on-set (fn [oldv newv]
                                       (reset! a (+ 10 newv))))]
-    @b
+    (sync)
     (is (= 5 @b))
     (reset! a 1)
+    (sync)
     (is (= 6 @b))
     (reset! b 1)
+    (sync)
     (is (= 11 @a))
     (is (= 16 @b))
     (dispose b)


IO multimethods now also understand string format designators

i.e.

  (write-context "conexp" ctx "/tmp/context")
  (read-context "/tmp/context" "conexp")

now work. This is useful for calling these functions from Java, where we
do not have any keyword parameters.

Signed-off-by: Daniel Borchmann <25857343a15bf1edafebc2912e82ecf775c585c1@mailbox.tu-dresden.de>

--- src/conexp/io/util.clj
+++ src/conexp/io/util.clj
@@ -70,6 +70,7 @@
   `(do
      (let [known-input-formats# (ref {})]
        (defn- ~add [name# predicate#]
+         "Adds a new file format predicate under the given name."
          (dosync
           (alter known-input-formats# assoc name# predicate#)))

@@ -77,13 +78,14 @@
          (keys @known-input-formats#))

        (defn- ~find
+         "Tries to determine the format used in file."
          ([file#]
             (first (for [[name# predicate#] @known-input-formats#
                          :when (with-in-reader file#
                                  (predicate# *in*))]
                      name#)))
          ([file# format#]
-            format#))
+            (keyword format#)))

        nil)

@@ -109,7 +111,7 @@
        (fn [& args#]
          (cond
           (= 2 (count args#)) ::default-write
-          (>= 3 (count args#)) (first args#)
+          (>= 3 (count args#)) (keyword (first args#))
           :else (illegal-argument "Invalid number of arguments in call to " ~write "."))))
      (defmethod ~write :default [format# & _#]
        (illegal-argument "Format " format# " for " ~name " output is not known."))


elyses-destructured-enchantments: remove unneeded comment (#442)

--- exercises/concept/elyses-destructured-enchantments/src/elyses_destructured_enchantments.clj
+++ exercises/concept/elyses-destructured-enchantments/src/elyses_destructured_enchantments.clj
@@ -28,6 +28,3 @@
   "Returns the deck with face cards between its head and tail."
   [deck]
 )
-
-(comment
-  )


More logging shenanigans.

More logging shenanigans.

--- src/depends/reader.clj
+++ src/depends/reader.clj
@@ -282,7 +282,7 @@
   ([^java.io.InputStream class-input-stream] (class-info class-input-stream nil))
   ([^java.io.InputStream class-input-stream
     ^java.lang.String    source]
-   (log/debug (str "Analysing " source "..."))
+   (log/debug "Analysing" source "...")
    (let [result             (atom [{} #{}])
          class-reader       (org.objectweb.asm.ClassReader. class-input-stream)
          annotation-visitor (proxy [org.objectweb.asm.AnnotationVisitor]
@@ -357,7 +357,7 @@

    See the class-info function for details on the structure of the class-info and dependency maps."
   [file-or-directory]
-  (log/debug "Calculating dependency information for" file-or-directory)
+  (log/debug "Analysing all classes in" file-or-directory "...")
   ; Look at the crap TrueVFS makes us do, just to add support for .AMP files (ZIP files under another name) #fail
   (.setArchiveDetector (net.java.truevfs.access.TConfig/current)
                        (net.java.truevfs.access.TArchiveDetector. "zip|jar|war|ear|amp"


Extract function

Extract function

--- src/expound/alpha.cljc
+++ src/expound/alpha.cljc
@@ -280,9 +280,20 @@
         type (:expound.spec.problem/type problem)]
     (value-str type spec-name form in problems opts)))

+;; TODO - rename 'problem-val'
+(defn conformed-value [problems problem-val]
+  (let [conformed-val (-> problems first :val)]
+    (if (= conformed-val problem-val)
+      ""
+      (printer/format
+       "\n\nwhen conformed as\n\n%s"
+       (printer/indent (ansi/color (pr-str conformed-val) :bad-value))))))
+
 ;; FIXME - when I decide to break compatibility for value-str-fn, maybe
 ;; make it show conform/unformed value
 ;; TODO - rename
+
+
 (defn ^:private value-and-conformed-value [problems spec-name val path opts]
   (let [{:keys [show-conformed?]} opts
         ;; TODO - rename
@@ -302,12 +313,7 @@
      (*value-str-fn* spec-name val path
                      problem-val)
      (if show-conformed?
-       (let [conformed-val (-> problems first :val)]
-         (if (= conformed-val problem-val)
-           ""
-           (printer/format
-            "\n\nwhen conformed as\n\n%s"
-            (printer/indent (ansi/color (pr-str conformed-val) :bad-value)))))
+       (conformed-value problems problem-val)
        ""))))

 (defmethod value-str :default [_type spec-name val path problems opts]


Исправление ошибок textarea, input cc

Исправление ошибок textarea, input cc

--- src-cljs/ixinfestor/omut.cljs
+++ src-cljs/ixinfestor/omut.cljs
@@ -835,7 +835,7 @@
   (reify
     om/IRender
     (render [this]
-      (let [value (:value @app)]
+      (let [value (or (:value @app) "")]
         (dom/input #js {:value value
                         :onChange (fn [e]
                                     (let [new-value (.. e -target -value)]
@@ -1062,8 +1062,8 @@
                                 cols "40"}}]
   (reify
     om/IRender
-    (render [this]
-      (dom/textarea #js {:value (:value app)
+    (render [this]
+      (dom/textarea #js {:value (or (:value @app) "")
                          :onChange (fn [e]
                                      (let [v (.. e -target -value)]
                                        (when (onChange-valid?-fn app v)
@@ -1123,7 +1123,7 @@
     om/IRender
     (render [_]
       (ui-button {:type bs-type
-                  :active? (app :value)
+                  :active? (@app :value)
                   :disabled? disabled?
                   :on-click (fn [_]
                               (om/transact! app :value not)
@@ -1209,8 +1209,9 @@
                                      (select-keys [:id :keyname :description])
                                      vals)))}}]
   (letfn [(on-click [app e]
-            (.preventDefault e)
-            (.stopPropagation e)
+            ;;Пока отрубил для мобил,
+            ;;(.preventDefault e)
+            ;;(.stopPropagation e)

             (when clear-selections-fn
               (clear-selections-fn))


use name for make-id

use name for make-id

--- src/ctia/flows/crud.clj
+++ src/ctia/flows/crud.clj
@@ -8,7 +8,7 @@
 (defn make-id
   "Apprently `make-id` is the same for all stores."
   [type-name _]
-  (str type-name "-" (UUID/randomUUID)))
+  (str (name type-name) "-" (UUID/randomUUID)))

 (defn create-flow
   "This function centralize the create workflow.


fix parameter descriptions

fix parameter descriptions

--- cimi-resources/src/com/sixsq/slipstream/ssclj/resources/external_object_template_generic.clj
+++ cimi-resources/src/com/sixsq/slipstream/ssclj/resources/external_object_template_generic.clj
@@ -10,27 +10,27 @@

 (def ExternalObjectTemplateGenericDescription
   (merge eot/ExternalObjectTemplateDescription
-         {:objectStoreCred {:displayName "Object Store credentials."
-                            :category    "general"
-                            :description "Link to Object Store credential."
-                            :type        "href"
-                            :mandatory   true
-                            :readOnly    true
-                            :order       23}
-          :bucketName      {:displayName "Object Store bucket name"
+         {:bucketName      {:displayName "Object Store bucket name"
                             :category    "general"
                             :description "Name of the bucket to store the object to"
                             :type        "string"
                             :mandatory   true
-                            :readOnly    true
+                            :readOnly    false
                             :order       21}
           :objectName      {:displayName "Object name"
                             :category    "general"
                             :description "Name of the object to store (/can/be/hierarchical)."
                             :type        "string"
                             :mandatory   true
-                            :readOnly    true
-                            :order       22}}))
+                            :readOnly    false
+                            :order       22}
+          :objectStoreCred {:displayName "Object Store credentials."
+                            :category    "general"
+                            :description "Link to Object Store credential."
+                            :type        "href"
+                            :mandatory   true
+                            :readOnly    false
+                            :order       23}}))

 ;;
 ;; resource
@@ -73,4 +73,4 @@
 (def validate-fn (u/create-spec-validation-fn :cimi.external-object-template.generic/externalObjectTemplate))
 (defmethod eot/validate-subtype-template objectType
   [resource]
-  (validate-fn resource))+  (validate-fn resource))


removed unnecessary print

removed unnecessary print

--- src/frontend/core.cljs
+++ src/frontend/core.cljs
@@ -226,8 +226,7 @@
                                                               track-id)))]
           (swap! app-state assoc :download-progress (merge (:download-progress @app-state)
                                                            {track-id {:data-downloaded data-downloaded
-                                                                      :file-size file-size}}))
-          (println (:download-progress @app-state)))
+                                                                      :file-size file-size}})))
         (if (nil? (get (:music-files @app-state) track-id))
           (swap! app-state assoc :music-files
             (merge (:music-files @app-state) {track-id (new js/Blob)})))


into #{} -> set

into #{} -> set

--- src/desdemona/utils.clj
+++ src/desdemona/utils.clj
@@ -52,7 +52,7 @@
   "Takes a workflow and catalog, returns the minimum number of peers
    needed to execute this job."
   [catalog workflow]
-  (let [task-set (into #{} (apply concat workflow))]
+  (let [task-set (set (apply concat workflow))]
     (reduce
      (fn [sum t]
        (+ sum (or (:onyx/min-peers (find-task catalog t)) 1)))


add refresh project button and add button tooltips

--- src-cljs/cuttle/main_page.cljs
+++ src-cljs/cuttle/main_page.cljs
@@ -119,6 +119,12 @@
 ;; Project Adding and Removing (from app state)
 ;;------------------------------------------------------------------------------

+(defn- conj-if-absent
+  [seq- elm]
+  (if (some #(= elm %) seq-)
+    seq-
+    (conj seq- elm)))
+
 (defn- add-project-as-loading!
   [filename]
   (let [project (-> initial-project-state
@@ -126,7 +132,7 @@
                            :filename filename))
         new-state (-> @state
                       (assoc-in [:projects filename] project)
-                      (update-in [:projects :order] conj filename))]
+                      (update-in [:projects :order] conj-if-absent filename))]
     (reset! state new-state)))

 (defn- on-project-load-update!
@@ -141,13 +147,12 @@

 (defn- add-project!
   [filename]
-  (when-not (contains? (:projects @state) filename)
-    (add-project-as-loading! filename)
-    (let [c (load-project-file filename)]
-      (go
-        (while-let [project (<! c)]
-          (on-project-load-update! filename project))
-        (finish-project-load! filename)))))
+  (add-project-as-loading! filename)
+  (let [c (load-project-file filename)]
+    (go
+      (while-let [project (<! c)]
+                 (on-project-load-update! filename project))
+      (finish-project-load! filename))))

 (defn- init-projects!
   [filenames]
@@ -893,13 +898,18 @@
             (:name prj)
             [:span.project-icons-dd1bb
               [:i.fa.fa-folder-open-o.project-icon-1711d
-                {:on-click #(click-open-project-folder! prj-key)}]
+                {:title "Open Folder"
+                 :on-click #(click-open-project-folder! prj-key)}]
               (when (= (:state prj) :idle)
                 (list
                   ;; NOTE: hiding edit link for now
                   ;; [:i.fa.fa-edit.project-icon-1711d]
+                  [:i.fa.fa-refresh.project-icon-1711d
+                   {:title "Refresh"
+                    :on-click #(add-project! prj-key)}]
                   [:i.fa.fa-times.project-icon-1711d
-                    {:on-click #(try-remove-project! (:name prj) prj-key)}]))]]
+                    {:title "Remove"
+                     :on-click #(try-remove-project! (:name prj) prj-key)}]))]]
           [:div.right-f5656
             (case (:state prj)
               :loading (loading-state prj-key)


Fix shopify link on homepage

Fix shopify link on homepage

It's broken!

--- src-cljs/frontend/history.cljs
+++ src-cljs/frontend/history.cljs
@@ -100,9 +100,12 @@
                 "svg" nil
                 (recur (.-parentElement e)))))))))

+(defn closest-a-tag [target]
+   (closest-tag target "A"))
+
 (defn closest-a-tag-and-populate-properties [target]
   "Find closest <a> ancestor of target and add some properties to it."
-  (let [a (closest-tag target "A")]
+  (let [a (closest-a-tag target)]
     (cond (instance? js/SVGElement a)   ; SVG
           (let [href (-> a (.-href) (unexterned-prop "baseVal"))]
             {:attr-href href
@@ -123,12 +126,12 @@
 (defn setup-link-dispatcher! [history-imp top-level-node]
   (events/listen
    top-level-node "click"
-     #(let [-target (.. % -target)
-            {:keys [attr-href attr-target host-name]} (closest-a-tag-and-populate-properties -target)
-            new-token (when (seq attr-href) (subs attr-href 1))]
+   #(let [-target (.. % -target)
+          {:keys [attr-href attr-target host-name]} (closest-a-tag-and-populate-properties -target)
+          new-token (when (seq attr-href) (subs attr-href 1))]
       (when (and (= (-> js/window .-location .-hostname)
                     host-name)
-                 (not (html/external-link? -target))
+                 (not (html/external-link? (closest-a-tag -target)))
                  (not (or (new-window-click? %)
                           (= attr-target "_blank"))))
         (.preventDefault %)


feat: clojure: update lein

feat: clojure: update lein

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -1,3 +1,3 @@
-{:user {:plugins [[cider/cider-nrepl "0.10.0"]]}
+{:user {:plugins [[cider/cider-nrepl "0.10.2"]]}
  :repl {:dependencies [[org.clojure/tools.nrepl "0.2.12"]]} ;emacs cider want specific repl <https://github.com/technomancy/leiningen/blob/master/doc/PROFILES.md#replacing-default-repl-dependencies>
  }


use cider 0.14.0

use cider 0.14.0

--- .lein/profiles.clj
+++ .lein/profiles.clj
@@ -6,9 +6,9 @@
         }
  :woot {:plugins [[lein-ancient "0.6.7"]]}
  :cider-repl {:dependencies [[org.clojure/tools.nrepl "0.2.12"]]
-              :plugins [[cider/cider-nrepl "0.13.0"]]}
+              :plugins [[cider/cider-nrepl "0.14.0"]]}
  :repl {:dependencies [[org.clojure/tools.nrepl "0.2.12"]]
-        :plugins [[cider/cider-nrepl "0.13.0"]]}
+        :plugins [[cider/cider-nrepl "0.14.0"]]}
  :mavbozo {
            ;;:repl-options {:prompt (fn [ns] (str "[" *ns* "]" \newline "=> "))}
            :repl-options { ; for nREPL dev you really need to limit output
@@ -24,7 +24,7 @@
                           ;;[io.aviso/pretty "0.1.8"]
                           ;;[im.chit/vinyasa "0.4.7"]
                           [figwheel-sidecar "0.5.3-1"]]
-           :plugins [[cider/cider-nrepl "0.13.0"]
+           :plugins [[cider/cider-nrepl "0.14.0"]
                      [jonase/eastwood "0.2.3"]
                      [lein-ns-dep-graph "0.1.0-SNAPSHOT"]]
            :injections [(require '[fipp.edn :refer (pprint) :rename {pprint fipp}])]


fix typo

fix typo

--- src/babel/english/grammar.clj
+++ src/babel/english/grammar.clj
@@ -167,7 +167,7 @@
                                        :sem {:number number-agreement
                                              :mod '()}}
                               :head {:phrasal false
-                                     :propernoun propernoun}
+                                     :synsem {:propernoun propernoun}}
                               :comp {:phrasal false}})) ;; rathole prevention ;; TODO: see if this can be removed.

                    (unifyc c10
@@ -178,9 +178,10 @@
                               :aliases (list "np2")
                               :synsem {:agr {:number number-agreement}
                                        :cat :noun
+                                       :propernoun propernoun
                                        :sem {:number number-agreement}}
                               :head {:phrasal true
-                                     :propernoun propernoun}
+                                     :synsem {:propernoun propernoun}}
                               :comp {:phrasal false}})) ;; rathole prevention ;; TODO: see if this can be removed.

                    (unifyc h10


Varing colors with elevation

Varing colors with elevation

--- src/amindblowingworld/civs.clj
+++ src/amindblowingworld/civs.clj
@@ -81,6 +81,23 @@
       "SAVANNA"      1500
       "JUNGLE"       2500)))

+(defn altitude-color-factor [altitude]
+  (let [f (/ (Math/log (+ 1.0 altitude)) 15.0)]
+    f))
+
+(defn mix-values [a b f]
+  (+ (* f (float a)) (* (- 1.0 f) (float b))))
+
+(defn mix-colors [a b f]
+  (let [red (int (mix-values (.getRed a) (.getRed b) f))
+        green (int (mix-values (.getGreen a) (.getGreen b) f))
+        blue (int (mix-values (.getBlue a) (.getBlue b) f))]
+    (Color. red green blue)))
+
+(defn adapt-color-to-elevation [color x y]
+  (let [elevation (.get (.getElevation (get-world)) x y)]
+    (mix-colors (Color. 255 255 255) color (altitude-color-factor elevation))))
+
 (defn calc-biome-map [world]
   (let [ w (-> world .getDimension .getWidth)
          h (-> world .getDimension .getHeight)
@@ -93,20 +110,21 @@
         (if (settlement-at {:x x :y y})
           (.setColor g (Color. 255 0 0))
           (let [pos {:x x :y y}
-                biome (.get b x y)]
-            (case (.name biome)
-              "OCEAN"        (.setColor g (Color. 0 0 255))
-              "ICELAND"      (.setColor g (Color. 255 255 255))
-              "TUNDRA"       (.setColor g (Color. 141 227 218))
-              "ALPINE"       (.setColor g (Color. 141 227 218))
-              "GLACIER"      (.setColor g (Color. 255 255 255))
-              "GRASSLAND"    (.setColor g (Color. 80 173 88))
-              "ROCK_DESERT"  (.setColor g (Color. 105 120 59))
-              "SAND_DESERT"  (.setColor g (Color. 205 227 141))
-              "FOREST"       (.setColor g (Color. 59 120 64))
-              "SAVANNA"      (.setColor g (Color. 171 161 27))
-              "JUNGLE"       (.setColor g (Color. 5 227 34))
-              (.setColor g (Color. 255 0 0)))))
+                biome (.get b x y)
+            biome-color (case (.name biome)
+              "OCEAN"        (Color. 0 0 255)
+              "ICELAND"      (Color. 255 225 225)
+              "TUNDRA"       (Color. 141 227 218)
+              "ALPINE"       (Color. 141 227 218)
+              "GLACIER"      (Color. 255 225 225)
+              "GRASSLAND"    (Color. 80 173 88)
+              "ROCK_DESERT"  (Color. 105 120 59)
+              "SAND_DESERT"  (Color. 205 227 141)
+              "FOREST"       (Color. 59 120 64)
+              "SAVANNA"      (Color. 171 161 27)
+              "JUNGLE"       (Color. 5 227 34)
+              (Color. 255 0 0))]
+            (.setColor g (adapt-color-to-elevation biome-color x y))))
         (let [pixel-x (* x scale-factor)
               pixel-y (* y scale-factor)]
           (.fillRect g pixel-x pixel-y scale-factor scale-factor))))


stop infinite reload of embed content

stop infinite reload of embed content

--- src/braid/ui/views/embed.cljs
+++ src/braid/ui/views/embed.cljs
@@ -57,11 +57,6 @@
          (let [url (:url (r/props this))]
            (fetch-content! url)))

-       :component-did-update
-       (fn [this]
-         (let [url (:url (r/props this))]
-           (fetch-content! url)))
-
        :reagent-render
        (fn []
          [:div.embed


Poll for repl startup.

Poll for repl startup.

Still some prompt I/O wackiness with evaling long-running forms.

--- src/leiningen/repl.clj
+++ src/leiningen/repl.clj
@@ -27,22 +27,28 @@
              (clojure.main/repl ~@init-form))
            (.close server#)))))

-(defn connect-to-repl [port]
-  (Thread/sleep 3000) ;; TODO: poll
-  (let [socket (Socket. "localhost" port)
-        reader (InputStreamReader. (.getInputStream socket))
-        writer (OutputStreamWriter. (.getOutputStream socket))
-        copy-out #(do (while (.ready reader)
-                         (Thread/sleep 100)
-                         (.write *out* (.read reader)))
-                       (flush))]
-    (loop []
-      (dotimes [_ 2] (copy-out))
-      (.write writer (str (pr-str (read)) "\n"))
-      (.flush writer)
-      (recur))))
+(defn copy-out [reader]
+  (Thread/sleep 100)
+  (.write *out* (.read reader))
+  (while (.ready reader)
+    (.write *out* (.read reader)))
+  (flush))
+
+(defn- connect-to-repl [reader writer]
+  (copy-out reader)
+  (.write writer (str (pr-str (read)) "\n"))
+  (.flush writer)
+  (recur reader writer))
+
+(defn- poll-for-socket [port]
+  (Thread/sleep 100)
+  (try (let [socket (Socket. "localhost" port)]
+         (connect-to-repl (InputStreamReader. (.getInputStream socket))
+                          (OutputStreamWriter. (.getOutputStream socket))))
+       (catch java.net.ConnectException _))
+  (recur port))

 (defn repl [project]
   (let [port (+ 1024 (rand-int 32000))]
     (.start (Thread. #(eval-in-project project (repl-form project port))))
-    (connect-to-repl port)))
+    (poll-for-socket port)))


Fix 'report-progress off-by-one error

Fix 'report-progress off-by-one error

--- src/leiningen/voom.clj
+++ src/leiningen/voom.clj
@@ -338,9 +338,9 @@
      (map-indexed
       (fn [i x]
         (let [now (System/currentTimeMillis)]
-          (when (< 500 (- now (.val last-report)))
+          (when (or (= (inc i) c) (< 500 (- now (.val last-report))))
             (set! (.val last-report) now)
-            (printf (str "\r%s %" digits "d/%d ...") msg i c)
+            (printf (str "\r%s %" digits "d/%d ...") msg (inc i) c)
             (flush)))
         x)
       xs))


UUID IRI helper

UUID IRI helper

--- src/clj/sparqlab/prefixes.clj
+++ src/clj/sparqlab/prefixes.clj
@@ -10,8 +10,16 @@
 (def exercise
   (prefix "http://mynarz.net/sparqlab/resource/exercise/"))

+(def local
+  (prefix "http://localhost/"))
+
 (def rdfs
   (prefix "http://www.w3.org/2000/01/rdf-schema#"))

 (def xsd
   (prefix "http://www.w3.org/2001/XMLSchema#"))
+
+(defn uuid-iri
+  "Generate a UUID-based localhost IRI."
+  []
+  (local (str (java.util.UUID/randomUUID))))


add tests for setting virus counter flag

--- src/clj/test/cards-events.clj
+++ src/clj/test/cards-events.clj
@@ -60,3 +60,27 @@
     (is (= 5 (:credit (get-runner))))
     (core/play state :runner {:card (first (:hand (get-runner)))})
     (is (= 9 (:credit (get-runner))))))
+
+;Surge and virus counter flag tests
+(deftest virus-counter-flag-on-enter
+  "Set counter flag when virus card enters play with counters"
+  (do-game
+    (new-game (default-corp) (default-runner [(qty "Surge" 1) (qty "Imp" 1) (qty "Crypsis" 1)]))
+    (take-credits state :corp)
+    (play-from-hand state :runner "Imp")
+    (let [imp (get-in @state [:runner :rig :program 0])]
+      (is (get-in imp [:added-virus-counter]) "Counter flag was not set on Imp")
+      )))
+
+(deftest virus-counter-flag-on-add-prop
+  "Set counter flag when add-prop is called on a virus"
+  (do-game
+    (new-game (default-corp)
+              (default-runner [(qty "Crypsis" 1)]))
+    (take-credits state :corp)
+    (play-from-hand state :runner "Crypsis")
+    (let [crypsis (get-in @state [:runner :rig :program 0])]
+      (card-ability state :runner crypsis 2)
+      (is (= 1 (get-in (refresh crypsis) [:counter])) "Crypsis did not add a virus token")
+      (is (get-in (refresh crypsis) [:added-virus-counter] "Counter flag was not set on Crypsis"))
+      )))


Fix #14

Fix #14

--- src/clj_simple_chart/core.clj
+++ src/clj_simple_chart/core.clj
@@ -136,10 +136,21 @@
         range-output))
     (with-meta all)))

+(defn number-of-decimals [scale]
+  (let [domain (:domain (meta scale))
+        domain-diff (Math/abs (apply - domain))]
+    (cond (>= domain-diff 10) 0
+          (>= domain-diff 1) 1
+          :else 2)))
+
+(defn scale-format [scale v]
+  (format (str "%." (number-of-decimals scale) "f") v))
+
 (defn left-y-axis [scale]
   (let [domain (:domain (meta scale))
         color (get (meta scale) :color "#000")
         range (:range (meta scale))
+        fmt (partial scale-format scale)
         tiks (apply ticks/ticks domain)]
     [:g
      [:path {:stroke       color
@@ -153,12 +164,13 @@
                            :fill        color
                            :dy          ".32em"
                            :y           0.5}
-                    d]]) tiks)]))
+                    (fmt d)]]) tiks)]))

 (defn right-y-axis [scale]
   (let [domain (:domain (meta scale))
         color (get (meta scale) :color "#000")
         range (:range (meta scale))
+        fmt (partial scale-format scale)
         tiks (apply ticks/ticks domain)]
     [:g
      [:path {:stroke       color
@@ -172,12 +184,13 @@
                            :fill        color
                            :dy          ".32em"
                            :y           0.5}
-                    d]]) tiks)]))
+                    (fmt d)]]) tiks)]))

 (defn bottom-x-axis [scale]
   (let [domain (:domain (meta scale))
         color (get (meta scale) :color "#000")
         range (:range (meta scale))
+        fmt (partial scale-format scale)
         tiks (apply ticks/ticks domain)]
     [:g
      [:path {:stroke       color
@@ -191,12 +204,13 @@
                            :fill        color
                            :dy          ".71em"
                            :y           9}
-                    d]]) tiks)]))
+                    (fmt d)]]) tiks)]))

 (defn top-x-axis [scale]
   (let [domain (:domain (meta scale))
         color (get (meta scale) :color "#000")
         range (:range (meta scale))
+        fmt (partial scale-format scale)
         tiks (apply ticks/ticks domain)]
     [:g
      [:path {:stroke       color
@@ -210,7 +224,8 @@
                            :fill        color
                            :dy          "0em"
                            :y           -9}
-                    d]]) tiks)]))
+                    (fmt d)]]) tiks)]))
+

 (def width 500)
 (def height 500)


Drop more rocks

Drop more rocks

--- src/cljc/robinson/update.cljc
+++ src/cljc/robinson/update.cljc
@@ -1280,12 +1280,14 @@
                                    []))
                                (concat
                                  (if (or harvestable
-                                         ;; TODO: make large flint stone have a higher chance of dropping away
+                                         ;; Make large flint stone have a higher chance of dropping away
                                          ;; from the player's starting-pos.
                                          (= 0 (rr/uniform-int 1000)))
-                                   [(rr/rand-nth [(ig/gen-item :rock) (if (< 300 (rr/uniform-double 100 (max 101 distance)))
-                                                                        (ig/gen-item :large-flint)
-                                                                        (ig/gen-item :flint))])]
+                                   (concat
+                                     (repeat (rr/uniform-int 4 6) (ig/gen-item :rock))
+                                     [(rr/rand-nth [(ig/gen-item :rock) (if (< 300 (rr/uniform-double 100 (max 101 distance)))
+                                                                          (ig/gen-item :large-flint)
+                                                                          (ig/gen-item :flint))])])
                                    [])))
                           :else [])
                         [])]


Clean up. Changed alt! to alts! in game-loop.

--- src/cljs/clojuroids/core.cljs
+++ src/cljs/clojuroids/core.cljs
@@ -1,6 +1,6 @@
 (ns clojuroids.core
   (:require
-   [cljs.core.async :refer [chan put! take! timeout <!]]
+   [cljs.core.async :refer [alts! timeout <!]]
    [clojuroids.render :as render]
    [clojuroids.ship :as ship]
    [clojuroids.shot :as shot]
@@ -12,7 +12,7 @@
    [clojuroids.level :as level]
    [clojuroids.saucer :as saucer])
   (:require-macros
-   [cljs.core.async.macros :refer [alt! go-loop]]))
+   [cljs.core.async.macros :refer [go-loop]]))

 (def frame-rate 33)
 (def init-roid-count 4)
@@ -38,8 +38,8 @@
 (defn game-loop [init-state]
   (let [input-chan (input/user-input)]
     (go-loop [state init-state start (timestamp)]
-      (let [state (merge state{:input (alt! [input-chan] ([v] v) :default nil)})
-            state (update-state state)]
+      (let [[input] (alts! [input-chan] :default nil)
+            state (-> state (assoc :input input) (update-state))]
         (animate-frame state)
         (<! (timeout (calc-timeout start)))
         (recur state (timestamp))))))


removed leave game from FAQ

removed leave game from FAQ

--- src/cljs/netrunner/about.cljs
+++ src/cljs/netrunner/about.cljs
@@ -34,9 +34,6 @@
        [:p "Go to " [:a {:href "http://gravatar.com" :target "_blank"} "gravatar.com"]
         " and create an account with the same email used to register on Jinteki.net."]]
       [:li
-       [:h4 "How do I quit a game when it's finished?"]
-       [:p "A quit button will be added in the future. In the meanwhile, simply refresh your browser."]]
-      [:li
        [:h4 "How can I make a donation?"]
        [:p "My PayPal account is mtgred@gmail.com. Contributions are appreciated and will help financing faster servers."]]
       [:li


finally get the results out

finally get the results out

--- src/cljs/scrabble/events.cljs
+++ src/cljs/scrabble/events.cljs
@@ -65,15 +65,11 @@
    (let [letters (concat-map-letters (:letters db))
          tiles (concat-map-letters (:tiles db))]

-     (prn "Passing the letters and tiles: " letters " and " tiles)
-
      (GET "http://localhost:3000/api/best-words"
-          {:params {:letters letters
-                    :tiles tiles }}
-
-          :handler #(dispatch [:set-best-words %1])
-          :error-handler #(prn "got error response" %1)))
-
+          {:params {:letters letters :tiles tiles}
+           :handler #(dispatch [:set-best-words %1])
+           :error-handler #(prn "got error response" %1)}))
+
    (assoc db :fetching? true)))


Change arg order for consistency

Change arg order for consistency

--- src/clojure/nightcode/git.clj
+++ src/clojure/nightcode/git.clj
@@ -321,7 +321,7 @@
         (.setSelectionMode TreeSelectionModel/SINGLE_TREE_SELECTION))))

 (defn update-content!
-  [^JTree sidebar content ^FileRepository repo ^RevCommit commit]
+  [^JTree sidebar ^FileRepository repo content ^RevCommit commit]
   (.setText content (clj->html (utils/get-string :loading)))
   (future
     (let [s (create-html repo commit)]
@@ -356,7 +356,7 @@
           (reify TreeSelectionListener
             (valueChanged [this e]
               (->> (some-> e .getPath .getLastPathComponent .getUserObject)
-                   (update-content! sidebar content repo)))))
+                   (update-content! sidebar repo content)))))
         (.setSelectionRow (or selected-row 0))))))

 (def ^:dynamic *widgets* [:pull :push :close])


Extract method to run a body of statements

--- src/clojure_ruby/evaluate.clj
+++ src/clojure_ruby/evaluate.clj
@@ -3,6 +3,10 @@
             [clojure-ruby.corelib :as core]))

 (declare evaluate)
+
+(defn evaluate-body [variables body]
+  (mapv (partial evaluate variables) body))
+
 (defmulti evaluate-one (fn [vars stmt] (first stmt)))

 (defmethod evaluate-one :assignment [variables stmt]
@@ -36,18 +40,18 @@
      (if-let [[branch & branches] branches]
        (let [[_ predicate & body] branch]
          (if (msg/host (evaluate variables predicate) :boolean)
-           (mapv (partial evaluate variables) body)
+           (evaluate-body variables body)
            (recur branches)))))))

 (defmethod evaluate-one :while [variables stmt]
   (let [[_ predicate & body] stmt]
     (while (msg/host (evaluate variables predicate) :boolean)
-      (mapv (partial evaluate variables) body))))
+      (evaluate-body variables body))))

 (defmethod evaluate-one :until [variables stmt]
   (let [[_ predicate & body] stmt]
     (while (not (msg/host (evaluate variables predicate) :boolean))
-      (mapv (partial evaluate variables) body))))
+      (evaluate-body variables body))))

 (defmethod evaluate-one :case [variables stmt]
   (let [[_ predicate & whens] stmt
@@ -57,7 +61,7 @@
         (let [[_ matcher & body] when
               matcher (evaluate variables matcher)]
           (if (msg/host (msg/ruby predicate "===" [matcher]) :boolean)
-            (mapv (partial evaluate variables) body)
+            (evaluate-body variables body)
             (recur whens)))))))

 (defn evaluate [variables stmt]


Initial report.

Initial report.

--- src/clojush/pushgp/report.clj
+++ src/clojush/pushgp/report.clj
@@ -54,6 +54,8 @@
       (flush)
       (printf "\nErrors: %s" (not-lazy (:errors best)))(flush)
       (printf "\nTotal: %s" (:total-error best))(flush)
+      (printf "\nMean: %.4f" (float (/ (:total-error best)
+                                       (count (:errors best)))))(flush)
       (printf "\nHAH-error: %s" (:hah-error best))(flush)
       (printf "\nHistory: %s" (not-lazy (:history best)))(flush)
       (printf "\nSize: %s" (count-points (:program best)))(flush)


fix the fix

fix the fix

--- src/clojush/pushgp/report.clj
+++ src/clojush/pushgp/report.clj
@@ -372,7 +372,7 @@
     (let [mean (r/generation-data! [:best :mean-error] (float (/ (:total-error best)
                                                                  (count (:errors best)))))]

-      (println "Mean:") mean)
+      (println "Mean:" mean))
     (when (not= normalization :none)
       (println "Normalized error:" (:normalized-error best)))
     (case total-error-method


Changed code to allow search with unspecified content-type header.

--- src/cmr/search/api/routes.clj
+++ src/cmr/search/api/routes.clj
@@ -148,20 +148,23 @@
 (defn- find-concepts
   "Invokes query service to find results and returns the response"
   [context path-w-extension params headers query-string]
-  (if (= "application/x-www-form-urlencoded" (get headers (str/lower-case CONTENT_TYPE_HEADER)))
-    (let [concept-type (concept-type-path-w-extension->concept-type path-w-extension)
-          context (-> context
-                      (process-context-info params headers)
-                      (assoc :query-string query-string))
-          params (process-params params path-w-extension headers "application/xml")
-          _ (info (format "Searching for %ss from client %s in format %s with params %s."
-                          (name concept-type) (:client-id context) (:result-format params)
-                          (pr-str params)))
-          search-params (lp/process-legacy-psa params query-string)
-          results (query-svc/find-concepts-by-parameters context concept-type search-params)]
-      (search-response params results))
-    {:status 415
-     :body (str "Unsupported content type [" (get headers (str/lower-case CONTENT_TYPE_HEADER)) "]")}))
+  (let [content-type-header (get headers (str/lower-case CONTENT_TYPE_HEADER))]
+    (if (or (nil? content-type-header)
+            (= "application/x-www-form-urlencoded" content-type-header))
+      (let [concept-type (concept-type-path-w-extension->concept-type path-w-extension)
+            context (-> context
+                        (process-context-info params headers)
+                        (assoc :query-string query-string))
+            params (process-params params path-w-extension headers "application/xml")
+            _ (info (format "Searching for %ss from client %s in format %s with params %s."
+                            (name concept-type) (:client-id context) (:result-format params)
+                            (pr-str params)))
+            search-params (lp/process-legacy-psa params query-string)
+            results (query-svc/find-concepts-by-parameters context concept-type search-params)]
+        (search-response params results))
+      {:status 415
+       :body (str "Unsupported content type ["
+                  (get headers (str/lower-case CONTENT_TYPE_HEADER)) "]")})))

 (defn- find-concepts-by-aql
   "Invokes query service to parse the AQL query, find results and returns the response"


Normalize hyphons.

Normalize hyphons.

--- src/incognito/base.cljc
+++ src/incognito/base.cljc
@@ -8,11 +8,13 @@
            ((read-handlers (:tag m)) (:value m))
            (map->IncognitoTaggedLiteral m)))

-(defn cleanup-cljs-ns [s]
-  (str/replace-first s "/" "."))
+(defn normalize-ns [s]
+  (-> s
+     (str/replace-first "/" ".")
+     (str/replace "-" "_")))

 (defn incognito-writer [write-handlers r]
-  (let [s                   (-> r type pr-str cleanup-cljs-ns symbol)
+  (let [s                   (-> r type pr-str normalize-ns symbol)
         break-map-recursion (if (map? r) (into {} r) r)
         [tag v]             (if (write-handlers s)
                               [s ((write-handlers s) break-map-recursion)]


use concurrent functions

use concurrent functions

--- src/k_means/cluster.clj
+++ src/k_means/cluster.clj
@@ -82,7 +82,7 @@
     (cond
       (empty? l) a
       (not-empty l)
-        (let [i (min-index (p :min-distance (min-distance-p c (first l))))]
+        (let [i (min-index (p :min-distance-p (min-distance-p c (first l))))]
           (recur (rest l) c (conj a (first l)))))))

 (defn -group-clusters
@@ -98,5 +98,5 @@
   "take a list of vectors and cluster on centroids c via distance in parallel"
   ([l c] (cluster-p l c []))
   ([l c a]
-    (let [clusters (for [i (partition-all (int (/ (count l) (count c))) l) :let [m (p :distance-cluster (future (cluster i c)))]] (deref m))]
-      (-group-clusters clusters))))
+    (let [clusters (for [i (partition-all (int (/ (count l) (count c))) l) :let [m (future (p :cluster (cluster i c)))]] (deref m))]
+      (p :group-clusters (-group-clusters clusters)))))


Remove whitespace

Remove whitespace

--- src/discuss/translations.cljs
+++ src/discuss/translations.cljs
@@ -29,8 +29,8 @@
         :nav        {:home "Start"
                      :find "Suchen"}
         :options    {:heading "Einstellungen"
-                     :lang    "Interface-Sprache"}
-        :references {:jump       "Springe in die Diskussion"
+                     :lang "Interface-Sprache"}
+        :references {:jump "Springe in die Diskussion"
                      :usages/view-heading "In welchen Argumenten wird dieser Textausschnitt verwendet?"
                      :usages/not-found-lead "Argument konnte nicht gefunden werden"
                      :usages/not-found-body "Vielleicht wurden die mit dieser Referenz verknüpften Argumente entfernt"
@@ -51,9 +51,9 @@
                      :show-discuss     "Show discuss"
                      :start-discussion "Start Discussion"}
         :discussion {:add-argument "Add a new argument"
-                     :current      "Current Discussion"
-                     :restart      "Restart"
-                     :submit       "Submit"}
+                     :current "Current Discussion"
+                     :restart "Restart"
+                     :submit "Submit"}
         :errors     {:login "Could not login. Maybe your credentials are wrong."}
         :find       {:find-statement "Find statement in the discussion"}
         :login      {:nickname "Nickname"
@@ -61,13 +61,13 @@
         :nav        {:home "Home"
                      :find "Find"}
         :options    {:heading "Options"
-                     :lang    "Language of Interface"}
-        :references {:jump       "Jump into the discussion"
+                     :lang "Language of Interface"}
+        :references {:jump "Jump into the discussion"
                      :usages/view-heading "In which arguments has this reference been used?"
                      :usages/not-found-lead "No assigned arguments found"
                      :usages/not-found-body "Maybe the assigned arguments have been removed"
                      :where-used "Where has this reference been used?"
-                     :clipboard  "Drag these references into the input field when creating a new argument."}}})
+                     :clipboard "Drag these references into the input field when creating a new argument"}}})

 (defn- prepend-translation
   "Lookup given key and prepend some string to it."


Support italics display

Support italics display

--- src/asciinema/player/view.cljs
+++ src/asciinema/player/view.cljs
@@ -42,15 +42,16 @@
                   color)]
       (str prefix color))))

-(defn part-class-name [{:keys [fg bg bold blink underline inverse cursor]}]
+(defn part-class-name [{:keys [fg bg bold blink underline inverse italic cursor]}]
   (let [fg-final (if inverse (or bg "bg") fg)
         bg-final (if inverse (or fg "fg") bg)
         fg-class (color-class-name fg-final bold "fg-")
         bg-class (color-class-name bg-final blink "bg-")
         bold-class (when bold "bright")
+        italic-class (when italic "italic")
         underline-class (when underline "underline")
         cursor-class (when cursor "cursor")
-        classes (remove nil? [fg-class bg-class bold-class underline-class cursor-class])]
+        classes (remove nil? [fg-class bg-class bold-class italic-class underline-class cursor-class])]
     (when (seq classes)
       (string/join " " classes))))


+wonder

+wonder

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1999,6 +1999,13 @@
                            :pred :donna
                            :child false}}}

+   "wonder" {:synsem {:cat :verb
+                      :sem {:pred :wonder}
+                      :subcat {:1 {:cat :noun
+                                   :sem {:human true}}
+                               :2 {:cat :comp
+                                   :comp-type :if
+                                   :subcat '()}}}}
    "work" [{:synsem {:cat :verb
                      :sem {:pred :work-human
                            :subj {:human true}}}


Properly handle opts map in table/flush! method.

--- src/merkle_db/table.clj
+++ src/merkle_db/table.clj
@@ -163,7 +163,7 @@

     Options may include:

-    - `:apply-patches?`
+    - `:apply-patch?`
       If true, the current patch data will be merged into the main data tree
       and the returned table will have no patch link.")

@@ -640,10 +640,10 @@
   "Ensure that all local state has been persisted to the storage backend and
   return an updated non-dirty table."
   ([table]
-   (-flush! table false))
-  ([^Table table apply-patches?]
+   (-flush! table nil))
+  ([^Table table opts]
    (if (dirty? table)
-     (let [[patch-link data-link] (flush-changes table apply-patches?)
+     (let [[patch-link data-link] (flush-changes table (:apply-patch? opts))
            root-data (-> (.root-data table)
                          (assoc :data/type data-type)
                          (dissoc ::patch ::data)


whitespace

whitespace

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -1605,8 +1605,6 @@
                            :discrete false
                            :pred :sleep}}
             :english {:past "slept"}}
-
-
    "small"
    (unify adjective
           {:synsem {:cat :adjective
@@ -1615,7 +1613,6 @@
                     :subcat {:1 {:cat :det}
                              :2 '()}}})

-
    "snap" {:synsem {:cat :verb
                     :sem {:pred :snap-pictures}}
            :english {:past "snapped"


add [:sem :pred] for "a","some", and "the"

--- src/babel/english/lexicon.cljc
+++ src/babel/english/lexicon.cljc
@@ -60,6 +60,7 @@
    {:synsem {:cat :det
              :def :indef
              :mass false
+             :sem {:pred :a-generic-instance-of}
              :agr {:number :sing}}}

    "abandon" {:synsem {:cat :verb
@@ -1548,9 +1549,11 @@
    "some"
    [{:synsem {:cat :det
               :def :partitivo
+              :sem {:pred :some-of}
               :agr {:number :plur}}}
     {:synsem {:cat :det
               :def :indef
+              :sem {:pred :some-one-of}
               :agr {:number :sing}}}]
    "speak"
    {:english {:past "spoke"
@@ -1642,6 +1645,7 @@
                     :sem {:pred :tell}}}
    "the" (map #(unify %
                       {:synsem {:cat :det
+                                :sem {:pred :definite}
                                 :def :def}})
               [{:synsem {:agr {:number :sing}}}
                {:synsem {:agr {:number :plur}}}])