generic args to video-js

generic args to video-js

--- src/prais2/components/video_player.cljc
+++ src/prais2/components/video_player.cljc
@@ -4,10 +4,9 @@

 (def init-video-js
   {:did-mount     (fn [state]
-                    #?(:cljs (do (.videojs js/window "video1"
+                    #?(:cljs (do (.videojs js/window (:video-id (first (:rum/args state)))
                                            (clj->js {} #_{:playbackRates [1 1.5 2]})
-                                           #(do (prn "video-1 initialised")
-                                                (.log js/console (:video-id (first (:rum/args state))))))))
+                                           #(do (prn "video-1 initialised")))))
                     state)
    :should-update (fn [_ _] false)
    })


(maint) Optimize subscription checking

(maint) Optimize subscription checking

Checks whether a subscription is up-to-date before checking whether we
can deliver an update. This allows forgetting changes in the case that a
new subscription is just being added and we skip it because the
inventory response hasn't yet been sent.

--- src/puppetlabs/pcp/broker/inventory.clj
+++ src/puppetlabs/pcp/broker/inventory.clj
@@ -134,8 +134,8 @@
                               (if (nil? @processed-count-atom) ;; have we not sent the update to this subscriber yet?
                                 (let [data (-> (subvec updates next-update-offset) ;; skip updates which have already been sent to this subscriber
                                                (build-update-data (:pattern-sets subscription)))]
-                                  (if (and (realized? (:connection subscription)) ;; prevent update before inventory response
-                                           (or (nil? data) ;; there are no updates for this subscriber
+                                  (if (or (nil? data) ;; there are no updates for this subscriber
+                                          (and (realized? (:connection subscription)) ;; prevent update before inventory response
                                                (deliver-server-message broker
                                                                        (message/make-message
                                                                          {:message_type "http://puppetlabs.com/inventory_update"


(PDB-5484) cli.version: have show-version be responsible for args

The subcommand function should be responsible for vetting the args,
not the run-cli-cmd harness.  Of course, arguably, it should also be
rejecting extraneous args, but don't change that for now.

--- src/puppetlabs/puppetdb/cli/version.clj
+++ src/puppetlabs/puppetdb/cli/version.clj
@@ -20,7 +20,7 @@
 ;; cleanly accessible from here.  Perhaps we can revisit this once we've
 ;; refactored and cleaned up the configuration stuff a bit.

-(defn show-version []
+(defn show-version [_args]
   (doseq [[key val] {"version" (version)
                      "target_schema_version" (desired-schema-version)}]
     (println (format "%s=%s" key val))))
@@ -29,7 +29,7 @@
   "Runs the version command as directed by the command line args and
   returns an appropriate exit status.."
   [args]
-  (run-cli-cmd #(do (show-version) 0)))
+  (run-cli-cmd #(do (show-version args) 0)))

 (defn -main [& args]
   (exit (cli args)))


augment now takes 2 or more shapes

augment now takes 2 or more shapes

--- src/wireframes/shape_primitives.clj
+++ src/wireframes/shape_primitives.clj
@@ -15,13 +15,16 @@
   (mapv #(mapv (partial + (count coll1)) %) coll2))

 (defn augment
-  "Add two shapes together"
-  [shape1 shape2]
-  (let [offsets  (partial offsets (:points shape1))
-        adjusted (assoc shape2
-                   :lines (offsets (:lines shape2))
-                   :polygons (offsets (:polygons shape2)))]
-    (merge-with (comp vec concat) shape1 adjusted)))
+  "Add two or more shapes together"
+  ([shape1 shape2]
+    (let [offsets  (partial offsets (:points shape1))
+          adjusted (assoc shape2
+                     :lines (offsets (:lines shape2))
+                     :polygons (offsets (:polygons shape2)))]
+      (merge-with (comp vec concat) shape1 adjusted)))
+  ([shape1 shape2 & more]
+    (let [initial (augment shape1 shape2)]
+      (reduce augment initial more))))

 (defn- connect-points [extruded-shape new-part]
   (let [e (count (:points extruded-shape))


application uparsing written (works ?)

application uparsing written (works ?)

--- src/latte/term.clj
+++ src/latte/term.clj
@@ -94,7 +94,6 @@

 (example (unparse (mk-univ 2)) => '(univ 2))

-
 ;;{

 ;; ### Applications
@@ -127,10 +126,13 @@
     :else (recur (conj (next (next expr)) (mk-application (first expr) (second expr))))))

 (example (binarize-application '(f a b c d))
-         => '((((f a) b) c) d))
-
-(example (binarize-application (map keyword '(f a b c d)))
-         => '((((:f :a) :b) :c) :d))
+         => (mk-application
+             (mk-application
+              (mk-application
+               (mk-application 'f 'a)
+               'b)
+              'c)
+             'd))

 (parser/register-term-other-parser
@@ -146,13 +148,19 @@
   (unparse [app]
     (let
         [urator (unparse (:rator app))
-         urand (unparse (:rand app))]
-      (println (str "application '" (:rator app) "' ?" (instance? Application (:rator app))))
-      (if (instance? Application (:rator app))
-        (append urator urand)
-        (conj urand urator)))))
+         rator (if (instance? Application (:rator app)) urator (list urator))
+         urand (unparse (:rand app))
+         rand (if (instance? Application (:rand app)) urand (list urand))]
+      (append rator rand))))
+
+(example (unparse (parse '((univ 1) (univ 2))))
+         => '((univ 1) (univ 2)))

 (example (unparse (parse '((univ 1) (univ 2) (univ 3))))
+         => '((univ 1) (univ 2) (univ 3)))
+
+(example (unparse (parse '(((univ 1) (univ 2)) ((univ 3) (univ 4)))))
+         => '((univ 1) (univ 2) (univ 3) (univ 4)))

 ;;{


More namespace cleanup in require_test

More namespace cleanup in require_test

--- test/node/replumb/require_test.cljs
+++ test/node/replumb/require_test.cljs
@@ -162,7 +162,8 @@
         (is (success? res) "(require 'alterable.core) and alterable.core/b should succeed")
         (is (valid-eval-result? out) "(require 'alterable.core) and alterable.core/b should be a valid result")
         (is (= 'cljs.user (repl/current-ns)) "(require 'alterable.core) and alterable.core/b should not change namespace")
-        (is (= "\"pre\"" out) "(require 'alterable.core) and alterable.core/b should return \"pre\""))
+        (is (= "\"pre\"" out) "(require 'alterable.core) and alterable.core/b should return \"pre\"")
+        (repl/reset-env! '[alterable.core alterable.utils]))

       (let [res (do (read-eval-call "(require 'alterable.utils)")
                     (read-eval-call "alterable.utils/c"))
@@ -170,7 +171,8 @@
         (is (success? res) "(require 'alterable.utils) and alterable.utils/c should succeed")
         (is (valid-eval-result? out) "(require 'alterable.utils) and alterable.utils/c should be a valid result")
         (is (= 'cljs.user (repl/current-ns)) "(require 'alterable.utils) and alterable.utils/c should not change namespace")
-        (is (= "\"pre\"" out) "(require 'alterable.utils) and alterable.utils/c should return \"pre\""))
+        (is (= "\"pre\"" out) "(require 'alterable.utils) and alterable.utils/c should return \"pre\"")
+        (repl/reset-env! '[alterable.utils]))

       ;; Writing "post" version of alterable.core & alterable.utils
       (io/write-file! alterable-utils-path utils-post-content)
@@ -180,7 +182,7 @@
         (is (success? res) "(require 'alterable.core :reload) and alterable.core/b should succeed")
         (is (valid-eval-result? out) "(require 'alterable.core :reload) and alterable.core/b should be a valid result")
         (is (= 'cljs.user (repl/current-ns)) "(require 'alterable.core :reload) and alterable.core/b should not change namespace")
-        (is (= "\"post\"" out) "(require 'alterable.core :reload) and alterable.core/b should return \"post\""))
-      (repl/reset-env! ['alterable.core 'alterable.utils])
+        (is (= "\"post\"" out) "(require 'alterable.core :reload) and alterable.core/b should return \"post\"")
+        (repl/reset-env! '[alterable.core alterable.utils]))
       (io/delete-file! alterable-core-path)
       (io/delete-file! alterable-utils-path))))


remove some unused let bindings

remove some unused let bindings

--- src-cljs/frontend/components/pages/build.cljs
+++ src-cljs/frontend/components/pages/build.cljs
@@ -88,15 +88,9 @@
   (reify
     om/IRender
     (render [_]
-      (let [build-data (dissoc (get-in data state/build-data-path) :container-data)
-            build (get-in data state/build-path)
-            build-id (build-model/id build)
-            build-num (:build_num build)
-            vcs-url (:vcs_url build)
+      (let [build (get-in data state/build-path)
             project (get-in data state/project-path)
-            plan (get-in data state/project-plan-path)
             user (get-in data state/user-path)
-            logged-in? (not (empty? user))
             can-trigger-builds? (project-model/can-trigger-builds? project)
             can-write-settings? (project-model/can-write-settings? project)]
         (html


indentation

indentation

--- src-cljs/frontend/controllers/navigation.cljs
+++ src-cljs/frontend/controllers/navigation.cljs
@@ -96,7 +96,7 @@
                (not (empty? current-user)))
       (api/get-projects api-ch))
     (go (let [builds-url (api/dashboard-builds-url (assoc (:navigation-data current-state)
-                                                     :builds-per-page (:builds-per-page current-state)))
+                                                          :builds-per-page (:builds-per-page current-state)))
               api-resp (<! (ajax/managed-ajax :get builds-url))
               scopes (:scopes api-resp)
               comms (get-in current-state [:comms])]


Learn more in popover is consistent; badge is positioned correctly for viewports

--- src-cljs/frontend/components/builds_table.cljs
+++ src-cljs/frontend/components/builds_table.cljs
@@ -76,13 +76,14 @@
 (defn- platform-link
   [{:keys [link links-to body-text owner]}]
   [:span body-text
-   [:a {:href link
-        :target "_blank"
-        :on-click #((om/get-shared owner :track-event) {:event-type :platform-link-clicked
-                                                        :properties {:component "builds-table-popover"
-                                                                     :link link
-                                                                     :links-to links-to}})}
-    "Learn more"]])
+   [:div
+    [:a {:href link
+         :target "_blank"
+         :on-click #((om/get-shared owner :track-event) {:event-type :platform-link-clicked
+                                                         :properties {:component "builds-table-popover"
+                                                                      :link link
+                                                                      :links-to links-to}})}
+     "Learn more →"]]])

 (defn build-row [{:keys [build project]} owner {:keys [show-actions? show-branch? show-project?]}]
   (let [url (build-model/path-for (select-keys build [:vcs_url]) build)
@@ -122,37 +123,55 @@
         :else nil)]

      [:div.build-info
-      [:div.build-info-header
-       [:div.contextual-identifier
-        [:a {:title (str (:username build) "/" (:reponame build) " #" (:build_num build))
-             :href url
-             :on-click #((om/get-shared owner :track-event) {:event-type :build-link-clicked
-                                                             :properties {:org (vcs-url/org-name (:vcs_url build))
-                                                                          :repo (:reponame build)
-                                                                          :vcs-type (vcs-url/vcs-type (:vcs_url build))}})}
-
-         (when show-project?
-           (str (:username build) " / " (:reponame build) " "))
-
-         (when (and show-project? show-branch?) " / ")
-
-         (when show-branch?
-           (-> build build-model/vcs-ref-name))
-         " #"
-         (:build_num build)]]]
-      [:div.recent-commit-msg
-       (let [pusher-name (build-model/ui-user build)
-             trigger (:why build)]
-         [:div.recent-user
-          {:title (if (= "api" trigger)
-                    "API"
-                    pusher-name)
-           :data-toggle "tooltip"
-           :data-placement "right"}
-          (avatar (:user build) :trigger trigger)])
-       [:span.recent-log
-        {:title (:body build)}
-        (:subject build)]]]
+      [:div.build-info-container
+        [:div.build-info-header
+         [:div.contextual-identifier
+          [:a {:title (str (:username build) "/" (:reponame build) " #" (:build_num build))
+               :href url
+               :on-click #((om/get-shared owner :track-event) {:event-type :build-link-clicked
+                                                               :properties {:org (vcs-url/org-name (:vcs_url build))
+                                                                            :repo (:reponame build)
+                                                                            :vcs-type (vcs-url/vcs-type (:vcs_url build))}})}
+
+           (when show-project?
+             (str (:username build) " / " (:reponame build) " "))
+
+           (when (and show-project? show-branch?) " / ")
+
+           (when show-branch?
+             (-> build build-model/vcs-ref-name))
+           " #"
+           (:build_num build)]]]
+        [:div.recent-commit-msg
+         (let [pusher-name (build-model/ui-user build)
+               trigger (:why build)]
+           [:div.recent-user
+            {:title (if (= "api" trigger)
+                      "API"
+                      pusher-name)
+             :data-toggle "tooltip"
+             :data-placement "right"}
+            (avatar (:user build) :trigger trigger)])
+         [:span.recent-log
+          {:title (:body build)}
+          (:subject build)]]]
+      [:div.build-engine
+        (popover/popover {:title nil
+                          :body (if (= "1.0" platform)
+                                  (platform-link {:body-text "2.0 is coming soon!\n"
+                                                  :link "https://circleci.com/beta-access/"
+                                                  :links-to "beta-access"
+                                                  :owner owner})
+                                  (platform-link {:body-text "This build ran on 2.0.\n"
+                                                  :link "https://circleci.com/docs/2.0/"
+                                                  :links-to "beta-docs"
+                                                  :owner owner}))
+                          :placement :left
+                          :trigger-mode :click
+                          :on-show #((om/get-shared owner :track-event) {:event-type :platform-number-popover-impression
+                                                                         :properties {:component "builds-table"
+                                                                                :platform-number platform}})}
+                         [:span.platform platform])]]

      [:div.metadata
       [:div.metadata-row.timing
@@ -180,7 +199,7 @@
       [:div.metadata-row.pull-revision
        (om/build pull-requests {:build build})
        (om/build commits {:build build})]]
-     [:div.build-list-notes
+     [:div.build-engine
       (popover/popover {:title nil
                         :body (if (= "1.0" platform)
                                 (platform-link {:body-text "2.0 is coming soon!\n"


First HUD.

First HUD.

Displays speed, altitude, heading and horizon line.

--- examples/controller.clj
+++ examples/controller.clj
@@ -7,7 +7,7 @@
             [com.lemonodor.gflags :as gflags]
             [seesaw.core :as seesaw])
   (:import [java.awt.event InputEvent KeyEvent]
-           [java.awt Graphics]
+           [java.awt Color Font Graphics Graphics2D]
            [java.awt.image BufferedImage]
            [java.net Socket]
            [javax.swing JPanel]))
@@ -87,7 +87,48 @@
               (apply action-fn action-args))))))))

+(defn norm [v]
+  (Math/sqrt (reduce + (map #(* % %) v))))
+
+
+(defn deg2rad [d]
+  (* d (/ Math/PI 180.0)))
+
+
+(defn draw-hud [^JPanel view ^Graphics2D g drone]
+  (let [navdata @(:navdata drone)
+        pitch (get-in navdata [:demo :theta])
+        roll (get-in navdata [:demo :phi])
+        hdg (get-in navdata [:magneto :heading :fusion-unwrapped])
+        alt (get-in navdata [:demo :altitude])
+        vel (get-in navdata [:demo :velocity])
+        spd (norm (vals vel))]
+    (.setFont g (Font. "SansSerif" Font/PLAIN 24))
+    (.setColor g Color/WHITE)
+    (if spd
+      (.drawString g (format "SPD %.1f m/s" (/ spd 1000.0)) 10 30)
+      (.drawString g "SPD unk" 10 30))
+    (if alt
+      (.drawString g (format "ALT %.1f m" (/ alt 1000.0)) 10 60)
+      (.drawString g "ALT unk" 10 60))
+    (if hdg
+      (.drawString g (str "HDG " (int hdg)) 10 90)
+      (.drawString g "HDG unk" 10 90))
+    (when roll
+      (let [h (.getHeight view)
+            h2 (/ h 2.0)
+            ph (+ h2 (* 1.7 h (Math/sin (deg2rad pitch))))]
+        (.rotate g (- (deg2rad roll)) (/ (.getWidth view) 2.0) h2)
+        (.drawLine g -500 ph (+ (.getWidth view) 500) ph)
+        (.rotate g (deg2rad roll) (/ (.getWidth view) 2.0) h2)
+        ))))
+
+
 (def drone-video-port 5555)
+
+
+(defn draw-image [^JPanel view ^Graphics g ^BufferedImage image]
+  (.drawImage g image 0 0 (.getWidth view) (.getHeight view) nil))

 (defn connect-video-controller [ui drone]
@@ -108,19 +149,20 @@
     (doto
         (Thread.
          (fn []
-           (loop [frame (pave/pull-frame fq 1000)]
-             (if frame
-               (let [^BufferedImage image (decoder frame)]
-                 (seesaw/invoke-now
-                  (.drawImage
-                   (.getGraphics view)
-                   image
-                   0 0
-                   (.getWidth view) (.getHeight view)
-                   view)))
-               ;;(log/info "Delayed frame" frame fq)
-               )
-             (recur (pave/pull-frame fq 1000)))))
+           (let [g (.getGraphics view)
+                 bi (BufferedImage.
+                     (.getWidth view)
+                     (.getHeight view)
+                     BufferedImage/TYPE_INT_ARGB)
+                 gbi (.createGraphics bi)]
+             (loop [frame (pave/pull-frame fq 1000)]
+               (when frame
+                 (let [^BufferedImage image (decoder frame)]
+                   (seesaw/invoke-now
+                    (draw-image view gbi image)
+                    (draw-hud view gbi drone)
+                    (.drawImage g bi 0 0 nil))))
+               (recur (pave/pull-frame fq 1000))))))
       (.setDaemon true)
       (.start))))


Refactor delete account algorithm to properly remove deleted account

Prior to this commit, deleted accounts would stay in the database but
set to `nil`. With this change accounts are properly removed from the database
when scheduled for deletion.

Signed-off-by: Andrey Shovkoplyas <b713972e59b8e606e23253c4a13e948139fea4d1@gmail.com>

--- src/status_im/wallet/accounts/core.cljs
+++ src/status_im/wallet/accounts/core.cljs
@@ -274,7 +274,7 @@
                                  :on-success #()}]
                :db (-> db
                        (assoc :multiaccount/accounts new-accounts)
-                       (assoc-in [:wallet :accounts deleted-address] nil))}
+                       (update-in [:wallet :accounts] dissoc deleted-address))}
               (navigation/navigate-to-cofx :wallet nil))))

 (fx/defn view-only-qr-scanner-result


conditionalize portions of cjls/compiler.cljc

--- src/main/clojure/cljs/compiler.cljc
+++ src/main/clojure/cljs/compiler.cljc
@@ -8,18 +8,23 @@

 (ns cljs.compiler
   (:refer-clojure :exclude [munge macroexpand-1])
-  (:require [cljs.util :as util]
-            [clojure.java.io :as io]
-            [clojure.string :as string]
-            [clojure.tools.reader :as reader]
-            [cljs.env :as env]
-            [cljs.tagged-literals :as tags]
-            [cljs.analyzer :as ana]
-            [cljs.source-map :as sm]
-            [clojure.data.json :as json]
-            [cljs.js-deps :as deps])
-  (:import java.lang.StringBuilder
-           java.io.File))
+  #?(:clj (:require [cljs.util :as util]
+                    [clojure.java.io :as io]
+                    [clojure.string :as string]
+                    [clojure.tools.reader :as reader]
+                    [cljs.env :as env]
+                    [cljs.tagged-literals :as tags]
+                    [cljs.analyzer :as ana]
+                    [cljs.source-map :as sm]
+                    [clojure.data.json :as json]
+                    [cljs.js-deps :as deps])
+     :cljs (:require [clojure.string :as string]
+                     [cljs.tools.reader :as reader]
+                     [cljs.env :as env]
+                     [cljs.analyzer :as ana]
+                     [cljs.source-map :as sm]))
+  #?(:clj (:import java.lang.StringBuilder
+                   java.io.File)))

 (set! *warn-on-reflection* true)

@@ -79,7 +84,8 @@
            ss (apply str
                 (map #(if (reserved %) (str % "$") %)
                   (string/split ss #"(?<=\.)|(?=\.)")))
-           ms (clojure.lang.Compiler/munge ss)]
+           ms #?(:clj (clojure.lang.Compiler/munge ss)
+                 :cljs (cljs.core/munge ss))]
        (if (symbol? s)
          (symbol ms)
          ms)))))
@@ -164,20 +170,40 @@
 (defn ^String emit-str [expr]
   (with-out-str (emit expr)))

-(defmulti emit-constant class)
+#?(:clj
+   (defmulti emit-constant class)
+   :cljs
+   (defmulti emit-constant type))
+
 (defmethod emit-constant nil [x] (emits "null"))
-(defmethod emit-constant Long [x] (emits "(" x ")"))
-(defmethod emit-constant Integer [x] (emits x)) ; reader puts Integers in metadata
-(defmethod emit-constant Double [x] (emits x))
-(defmethod emit-constant BigDecimal [x] (emits (.doubleValue ^BigDecimal x)))
-(defmethod emit-constant clojure.lang.BigInt [x] (emits (.doubleValue ^clojure.lang.BigInt x)))
+
+#?(:clj
+   (defmethod emit-constant Long [x] (emits "(" x ")")))
+
+#?(:clj
+   (defmethod emit-constant Integer [x] (emits x))) ; reader puts Integers in metadata
+
+#?(:clj
+   (defmethod emit-constant Double [x] (emits x))
+   :cljs
+   (defmethod emit-constant Number [x] (emits x)))
+
+#?(:clj
+   (defmethod emit-constant BigDecimal [x] (emits (.doubleValue ^BigDecimal x))))
+
+#?(:clj
+   (defmethod emit-constant clojure.lang.BigInt [x] (emits (.doubleValue ^clojure.lang.BigInt x))))
+
 (defmethod emit-constant String [x]
   (emits (wrap-in-double-quotes (escape-string x))))
+
 (defmethod emit-constant Boolean [x] (emits (if x "true" "false")))
-(defmethod emit-constant Character [x]
-  (emits (wrap-in-double-quotes (escape-char x))))
-
-(defmethod emit-constant java.util.regex.Pattern [x]
+
+#?(:clj
+   (defmethod emit-constant Character [x]
+     (emits (wrap-in-double-quotes (escape-char x)))))
+
+(defmethod emit-constant #?(:clj java.util.regex.Pattern :cljs js/RegExp) [x]
   (if (= "" (str x))
     (emits "(new RegExp(\"\"))")
     (let [[_ flags pattern] (re-find #"^(?:\(\?([idmsux]*)\))?(.*)" (str x))]
@@ -198,14 +224,14 @@
     (emit-constant (hash kw))
     (emits ")")))

-(defmethod emit-constant clojure.lang.Keyword [x]
+(defmethod emit-constant #?(:clj clojure.lang.Keyword :cljs Keyword) [x]
   (if (-> @env/*compiler* :options :emit-constants)
     (let [value (-> @env/*compiler* ::ana/constant-table x)]
       (emits "cljs.core." value))
     (emits-keyword x)
     ))

-(defmethod emit-constant clojure.lang.Symbol [x]
+(defmethod emit-constant #?(:clj clojure.lang.Symbol :cljs Symbol) [x]
   (let [ns     (namespace x)
         name   (name x)
         symstr (if-not (nil? ns)
@@ -225,10 +251,10 @@

 ;; tagged literal support

-(defmethod emit-constant java.util.Date [^java.util.Date date]
+(defmethod emit-constant #?(:clj java.util.Date :cljs js/Date) [^java.util.Date date]
   (emits "new Date(" (.getTime date) ")"))

-(defmethod emit-constant java.util.UUID [^java.util.UUID uuid]
+(defmethod emit-constant #?(:clj java.util.UUID :cljs UUID) [^java.util.UUID uuid]
   (emits "new cljs.core.UUID(\"" (.toString uuid) "\")"))

 (defmacro emit-wrap [env & body]
@@ -555,50 +581,50 @@
 (defn emit-variadic-fn-method
   [{:keys [type name variadic params expr env recurs max-fixed-arity] :as f}]
   (emit-wrap env
-             (let [name (or name (gensym))
-                   mname (munge name)
-                   delegate-name (str mname "__delegate")]
-               (emitln "(function() { ")
-               (emits "var " delegate-name " = function (")
-               (doseq [param params]
-                 (emit param)
-                 (when-not (= param (last params)) (emits ",")))
-               (emitln "){")
-               (when recurs (emitln "while(true){"))
-               (emits expr)
-               (when recurs
-                 (emitln "break;")
-                 (emitln "}"))
-               (emitln "};")
-
-               (emitln "var " mname " = function (" (comma-sep
-                                                      (if variadic
-                                                        (concat (butlast params) ['var_args])
-                                                        params)) "){")
-               (when type
-                 (emitln "var self__ = this;"))
-               (when variadic
-                 (emits "var ")
-                 (emit (last params))
-                 (emitln " = null;")
-                 (emitln "if (arguments.length > " (dec (count params)) ") {")
-                 (let [a (emit-arguments-to-array (dec (count params)))]
-                   (emitln "  " (last params) " = new cljs.core.IndexedSeq(" a ",0);"))
-                 (emitln "} "))
-               (emits "return " delegate-name ".call(this,")
-               (doseq [param params]
-                 (emit param)
-                 (when-not (= param (last params)) (emits ",")))
-               (emits ");")
-               (emitln "};")
-
-               (emitln mname ".cljs$lang$maxFixedArity = " max-fixed-arity ";")
-               (emits mname ".cljs$lang$applyTo = ")
-               (emit-apply-to (assoc f :name name))
-               (emitln ";")
-               (emitln mname ".cljs$core$IFn$_invoke$arity$variadic = " delegate-name ";")
-               (emitln "return " mname ";")
-               (emitln "})()"))))
+    (let [name (or name (gensym))
+          mname (munge name)
+          delegate-name (str mname "__delegate")]
+      (emitln "(function() { ")
+      (emits "var " delegate-name " = function (")
+      (doseq [param params]
+        (emit param)
+        (when-not (= param (last params)) (emits ",")))
+      (emitln "){")
+      (when recurs (emitln "while(true){"))
+      (emits expr)
+      (when recurs
+        (emitln "break;")
+        (emitln "}"))
+      (emitln "};")
+
+      (emitln "var " mname " = function (" (comma-sep
+                                             (if variadic
+                                               (concat (butlast params) ['var_args])
+                                               params)) "){")
+      (when type
+        (emitln "var self__ = this;"))
+      (when variadic
+        (emits "var ")
+        (emit (last params))
+        (emitln " = null;")
+        (emitln "if (arguments.length > " (dec (count params)) ") {")
+        (let [a (emit-arguments-to-array (dec (count params)))]
+          (emitln "  " (last params) " = new cljs.core.IndexedSeq(" a ",0);"))
+        (emitln "} "))
+      (emits "return " delegate-name ".call(this,")
+      (doseq [param params]
+        (emit param)
+        (when-not (= param (last params)) (emits ",")))
+      (emits ");")
+      (emitln "};")
+
+      (emitln mname ".cljs$lang$maxFixedArity = " max-fixed-arity ";")
+      (emits mname ".cljs$lang$applyTo = ")
+      (emit-apply-to (assoc f :name name))
+      (emitln ";")
+      (emitln mname ".cljs$core$IFn$_invoke$arity$variadic = " delegate-name ";")
+      (emitln "return " mname ";")
+      (emitln "})()"))))

 (defmethod emit* :fn
   [{:keys [name env methods max-fixed-arity variadic recur-frames loop-lets]}]
@@ -939,50 +965,53 @@
 (defmethod emit* :dot
   [{:keys [target field method args env]}]
   (emit-wrap env
-             (if field
-               (emits target "." (munge field #{}))
-               (emits target "." (munge method #{}) "("
-                      (comma-sep args)
-                      ")"))))
+    (if field
+      (emits target "." (munge field #{}))
+      (emits target "." (munge method #{}) "("
+        (comma-sep args)
+        ")"))))

 (defmethod emit* :js
   [{:keys [env code segs args]}]
   (emit-wrap env
-             (if code
-               (emits code)
-               (emits (interleave (concat segs (repeat nil))
-                                  (concat args [nil]))))))
+    (if code
+      (emits code)
+      (emits (interleave (concat segs (repeat nil))
+               (concat args [nil]))))))

 ;; TODO: unify renaming helpers - this one was hard to find - David

-(defn rename-to-js
-  "Change the file extension from .cljs to .js. Takes a File or a
-  String. Always returns a String."
-  [^String file-str]
-  (cond
-    (.endsWith file-str ".cljs")
-    (clojure.string/replace file-str #"\.cljs$" ".js")
-
-    (.endsWith file-str ".cljc")
-    (clojure.string/replace file-str #"\.cljc$" ".js")
-
-    :else
-    (throw (IllegalArgumentException.
-             (str "Invalid source file extension " file-str)))))
-
-(defn with-core-cljs
-  "Ensure that core.cljs has been loaded."
-  ([] (with-core-cljs nil))
-  ([opts] (with-core-cljs opts (fn [])))
-  ([opts body]
-    {:pre [(or (nil? opts) (map? opts))
-           (fn? body)]}
-    (when-not (get-in @env/*compiler* [::ana/namespaces 'cljs.core :defs])
-      (ana/analyze-file "cljs/core.cljs" opts))
-    (body)))
-
-(defn url-path [^File f]
-  (.getPath (.toURL (.toURI f))))
+#?(:clj
+   (defn rename-to-js
+     "Change the file extension from .cljs to .js. Takes a File or a
+     String. Always returns a String."
+     [^String file-str]
+     (cond
+       (.endsWith file-str ".cljs")
+       (clojure.string/replace file-str #"\.cljs$" ".js")
+
+       (.endsWith file-str ".cljc")
+       (clojure.string/replace file-str #"\.cljc$" ".js")
+
+       :else
+       (throw (IllegalArgumentException.
+                (str "Invalid source file extension " file-str))))))
+
+#?(:clj
+   (defn with-core-cljs
+     "Ensure that core.cljs has been loaded."
+     ([] (with-core-cljs nil))
+     ([opts] (with-core-cljs opts (fn [])))
+     ([opts body]
+      {:pre [(or (nil? opts) (map? opts))
+             (fn? body)]}
+      (when-not (get-in @env/*compiler* [::ana/namespaces 'cljs.core :defs])
+        (ana/analyze-file "cljs/core.cljs" opts))
+      (body))))
+
+#?(:clj
+   (defn url-path [^File f]
+     (.getPath (.toURL (.toURI f)))))

 (defn- build-affecting-options [opts]
   (select-keys opts [:static-fns :optimize-constants :elide-asserts :target]))
@@ -995,209 +1024,213 @@
       (when opts
         (str " " (pr-str (build-affecting-options opts)))))))

-(defn compile-file*
-  ([src dest] (compile-file* src dest nil))
-  ([src dest opts]
-   (env/ensure
-     (with-core-cljs opts
-       (fn []
-         (when (or ana/*verbose* (:verbose opts))
-           (util/debug-prn "Compiling" (str src)))
-         (if-let [cached (and (= (:optimizations opts) :none)
+#?(:clj
+   (defn compile-file*
+     ([src dest] (compile-file* src dest nil))
+     ([src dest opts]
+      (env/ensure
+        (with-core-cljs opts
+          (fn []
+            (when (or ana/*verbose* (:verbose opts))
+              (util/debug-prn "Compiling" (str src)))
+            (if-let [cached (and (= (:optimizations opts) :none)
                               (= (:ns (ana/parse-ns src)) 'cljs.core)
                               (io/resource "cljs/core.aot.js"))]
-            ;; no need to bother with analysis cache reading, handled by
-            ;; with-core-cljs
-            (do
-              (when (or ana/*verbose* (:verbose opts))
-                (util/debug-prn "Using cached cljs.core" (str src)))
-              (spit dest (slurp cached))
-              (when (true? (:source-map opts))
-                (spit (io/file (str dest ".map"))
-                  (json/write-str
-                    (assoc
-                      (json/read-str (slurp (io/resource "cljs/core.aot.js.map")))
-                      "file"
-                      (str (io/file (util/output-directory opts) "cljs" "core.js"))))))
-              (ana/parse-ns src dest nil))
-            (with-open [out ^java.io.Writer (io/make-writer dest {})]
-              (binding [*out* out
-                        ana/*cljs-ns* 'cljs.user
-                        ana/*cljs-file* (.getPath ^File src)
-                        reader/*alias-map* (or reader/*alias-map* {})
-                        ana/*cljs-static-fns* (or ana/*cljs-static-fns* (:static-fns opts))
-                        *source-map-data* (when (:source-map opts)
-                                            (atom
-                                              {:source-map (sorted-map)
-                                               :gen-col 0
-                                               :gen-line 0}))]
-                (emitln (compiled-by-string opts))
-                (with-open [rdr (io/reader src)]
-                  (loop [forms (ana/forms-seq* rdr (util/path src))
-                         ns-name nil
-                         deps nil]
-                    (if (seq forms)
-                      (let [env (ana/empty-env)
-                            ast (ana/analyze env (first forms) nil opts)]
-                        (emit ast)
-                        (if (= (:op ast) :ns)
-                          (recur (rest forms) (:name ast) (merge (:uses ast) (:requires ast)))
-                          (recur (rest forms) ns-name deps)))
-                      (let [sm-data (when *source-map-data* @*source-map-data*)
-                            ret (merge
-                                  {:ns (or ns-name 'cljs.user)
-                                   :provides [ns-name]
-                                   :requires (if (= ns-name 'cljs.core)
-                                               (set (vals deps))
-                                               (cond-> (conj (set (vals deps)) 'cljs.core)
-                                                 (get-in @env/*compiler* [:options :emit-constants])
-                                                 (conj 'constants-table)))
-                                   :file dest
-                                   :source-file src}
-                                  (when sm-data
-                                    {:source-map (:source-map sm-data)}))]
-                        (when (and sm-data (= (:optimizations opts) :none))
-                          (let [sm-file (io/file (str (.getPath ^File dest) ".map"))]
-                            (emits "\n//# sourceMappingURL="
-                              (or (:source-map-url opts) (.getName sm-file))
-                              (if (true? (:source-map-timestamp opts))
-                                (str "?rel=" (System/currentTimeMillis))
-                                ""))
-                            (spit sm-file
-                              (sm/encode {(url-path src) (:source-map sm-data)}
-                                {:lines (+ (:gen-line sm-data) 2)
-                                 :file (url-path dest)
-                                 :source-map-timestamp (:source-map-timestamp opts)
-                                 :source-map-pretty-print (:source-map-pretty-print opts)}))))
-                        (let [path (.getPath (.toURL ^File dest))]
-                          (swap! env/*compiler* assoc-in [::compiled-cljs path] ret))
-                        (let [{:keys [output-dir cache-analysis]} opts]
-                          (when (and (true? cache-analysis) output-dir)
-                            (ana/write-analysis-cache ns-name
-                              (ana/cache-file src (ana/parse-ns src) output-dir :write)))
-                          ret)))))))))))))
-
-(defn requires-compilation?
-  "Return true if the src file requires compilation."
-  ([src dest] (requires-compilation? src dest nil))
-  ([^File src ^File dest opts]
-    (env/ensure
-      (or (not (.exists dest))
-          (> (.lastModified src) (.lastModified dest))
-          (let [version' (util/compiled-by-version dest)
-                version  (util/clojurescript-version)]
-            (and version (not= version version')))
-          (and opts
-               (not= (build-affecting-options opts) (build-affecting-options (util/build-options dest))))
-          (and opts
-            (:source-map opts)
-            (if (= (:optimizations opts) :none)
-              (not (.exists (io/file (str (.getPath dest) ".map"))))
-              (not (get-in @env/*compiler* [::compiled-cljs (.getAbsolutePath dest)]))))
+              ;; no need to bother with analysis cache reading, handled by
+              ;; with-core-cljs
+              (do
+                (when (or ana/*verbose* (:verbose opts))
+                  (util/debug-prn "Using cached cljs.core" (str src)))
+                (spit dest (slurp cached))
+                (when (true? (:source-map opts))
+                  (spit (io/file (str dest ".map"))
+                    (json/write-str
+                      (assoc
+                        (json/read-str (slurp (io/resource "cljs/core.aot.js.map")))
+                        "file"
+                        (str (io/file (util/output-directory opts) "cljs" "core.js"))))))
+                (ana/parse-ns src dest nil))
+              (with-open [out ^java.io.Writer (io/make-writer dest {})]
+                (binding [*out* out
+                          ana/*cljs-ns* 'cljs.user
+                          ana/*cljs-file* (.getPath ^File src)
+                          reader/*alias-map* (or reader/*alias-map* {})
+                          ana/*cljs-static-fns* (or ana/*cljs-static-fns* (:static-fns opts))
+                          *source-map-data* (when (:source-map opts)
+                                              (atom
+                                                {:source-map (sorted-map)
+                                                 :gen-col 0
+                                                 :gen-line 0}))]
+                  (emitln (compiled-by-string opts))
+                  (with-open [rdr (io/reader src)]
+                    (loop [forms (ana/forms-seq* rdr (util/path src))
+                           ns-name nil
+                           deps nil]
+                      (if (seq forms)
+                        (let [env (ana/empty-env)
+                              ast (ana/analyze env (first forms) nil opts)]
+                          (emit ast)
+                          (if (= (:op ast) :ns)
+                            (recur (rest forms) (:name ast) (merge (:uses ast) (:requires ast)))
+                            (recur (rest forms) ns-name deps)))
+                        (let [sm-data (when *source-map-data* @*source-map-data*)
+                              ret (merge
+                                    {:ns (or ns-name 'cljs.user)
+                                     :provides [ns-name]
+                                     :requires (if (= ns-name 'cljs.core)
+                                                 (set (vals deps))
+                                                 (cond-> (conj (set (vals deps)) 'cljs.core)
+                                                   (get-in @env/*compiler* [:options :emit-constants])
+                                                   (conj 'constants-table)))
+                                     :file dest
+                                     :source-file src}
+                                    (when sm-data
+                                      {:source-map (:source-map sm-data)}))]
+                          (when (and sm-data (= (:optimizations opts) :none))
+                            (let [sm-file (io/file (str (.getPath ^File dest) ".map"))]
+                              (emits "\n//# sourceMappingURL="
+                                (or (:source-map-url opts) (.getName sm-file))
+                                (if (true? (:source-map-timestamp opts))
+                                  (str "?rel=" (System/currentTimeMillis))
+                                  ""))
+                              (spit sm-file
+                                (sm/encode {(url-path src) (:source-map sm-data)}
+                                  {:lines (+ (:gen-line sm-data) 2)
+                                   :file (url-path dest)
+                                   :source-map-timestamp (:source-map-timestamp opts)
+                                   :source-map-pretty-print (:source-map-pretty-print opts)}))))
+                          (let [path (.getPath (.toURL ^File dest))]
+                            (swap! env/*compiler* assoc-in [::compiled-cljs path] ret))
+                          (let [{:keys [output-dir cache-analysis]} opts]
+                            (when (and (true? cache-analysis) output-dir)
+                              (ana/write-analysis-cache ns-name
+                                (ana/cache-file src (ana/parse-ns src) output-dir :write)))
+                            ret))))))))))))))
+
+#?(:clj
+   (defn requires-compilation?
+     "Return true if the src file requires compilation."
+     ([src dest] (requires-compilation? src dest nil))
+     ([^File src ^File dest opts]
+      (env/ensure
+        (or (not (.exists dest))
+            (> (.lastModified src) (.lastModified dest))
+            (let [version' (util/compiled-by-version dest)
+                  version (util/clojurescript-version)]
+              (and version (not= version version')))
+            (and opts (not= (build-affecting-options opts)
+                            (build-affecting-options (util/build-options dest))))
+            (and opts (:source-map opts)
+                 (if (= (:optimizations opts) :none)
+                   (not (.exists (io/file (str (.getPath dest) ".map"))))
+                   (not (get-in @env/*compiler* [::compiled-cljs (.getAbsolutePath dest)]))))
           (let [{ns :ns} (ana/parse-ns src)
                 {:keys [recompile visited]}
                 (and *dependents* @*dependents*)]
             (and (contains? recompile ns)
-                 (not (contains? visited ns))))))))
-
-(defn compile-file
-  "Compiles src to a file of the same name, but with a .js extension,
-   in the src file's directory.
-
-   With dest argument, write file to provided location. If the dest
-   argument is a file outside the source tree, missing parent
-   directories will be created. The src file will only be compiled if
-   the dest file has an older modification time.
-
-   Both src and dest may be either a String or a File.
-
-   Returns a map containing {:ns .. :provides .. :requires .. :file ..}.
-   If the file was not compiled returns only {:file ...}"
-  ([src]
-    (let [dest (rename-to-js src)]
-      (compile-file src dest nil)))
-  ([src dest]
-    (compile-file src dest nil))
-  ([src dest opts]
-    {:post [map?]}
-    (binding [ana/*file-defs* (atom #{})]
-      (let [nses      (get @env/*compiler* ::ana/namespaces)
-            src-file  (io/file src)
-            dest-file (io/file dest)
-            opts      (merge {:optimizations :none} opts)]
-        (if (.exists src-file)
-          (try
-            (let [{ns :ns :as ns-info} (ana/parse-ns src-file dest-file opts)
-                  opts (if (and (= ns 'cljs.core)
-                                (not (false? (:static-fns opts))))
-                         (assoc opts :static-fns true)
-                         opts)]
-              (if (or (requires-compilation? src-file dest-file opts)
+                 (not (contains? visited ns)))))))))
+
+#?(:clj
+   (defn compile-file
+     "Compiles src to a file of the same name, but with a .js extension,
+      in the src file's directory.
+
+      With dest argument, write file to provided location. If the dest
+      argument is a file outside the source tree, missing parent
+      directories will be created. The src file will only be compiled if
+      the dest file has an older modification time.
+
+      Both src and dest may be either a String or a File.
+
+      Returns a map containing {:ns .. :provides .. :requires .. :file ..}.
+      If the file was not compiled returns only {:file ...}"
+     ([src]
+      (let [dest (rename-to-js src)]
+        (compile-file src dest nil)))
+     ([src dest]
+      (compile-file src dest nil))
+     ([src dest opts]
+      {:post [map?]}
+      (binding [ana/*file-defs* (atom #{})]
+        (let [nses (get @env/*compiler* ::ana/namespaces)
+              src-file (io/file src)
+              dest-file (io/file dest)
+              opts (merge {:optimizations :none} opts)]
+          (if (.exists src-file)
+            (try
+              (let [{ns :ns :as ns-info} (ana/parse-ns src-file dest-file opts)
+                    opts (if (and (= ns 'cljs.core)
+                                  (not (false? (:static-fns opts))))
+                           (assoc opts :static-fns true)
+                           opts)]
+                (if (or (requires-compilation? src-file dest-file opts)
                       (:force opts))
-                (do
-                  (util/mkdirs dest-file)
-                  (when (and (get-in nses [ns :defs])
-                             (not= 'cljs.core ns)
-                             (not= :interactive (:mode opts)))
-                    (swap! env/*compiler* update-in [::ana/namespaces] dissoc ns))
-                  (let [ret (compile-file* src-file dest-file opts)]
-                    (when *dependents*
-                      (swap! *dependents*
-                        (fn [{:keys [recompile visited]}]
-                          {:recompile (into recompile
-                                        (ana/ns-dependents ns
-                                          (merge *inputs* nses)))
-                           :visited (conj visited ns)})))
-                    ret))
-                (do
-                  ;; populate compilation environment with analysis information
-                  ;; when constants are optimized
-                  (when (and (true? (:optimize-constants opts))
-                             (nil? (get-in nses [ns :defs])))
-                    (with-core-cljs opts (fn [] (ana/analyze-file src-file opts))))
-                  ns-info)))
-            (catch Exception e
-              (throw (ex-info (str "failed compiling file:" src) {:file src} e))))
-          (throw (java.io.FileNotFoundException. (str "The file " src " does not exist."))))))))
-
-(defn cljs-files-in
-  "Return a sequence of all .cljs and .cljc files in the given directory."
-  [dir]
-  (filter
-    #(let [name (.getName ^File %)]
-      (and (or (.endsWith name ".cljs")
-               (.endsWith name ".cljc"))
+                  (do
+                    (util/mkdirs dest-file)
+                    (when (and (get-in nses [ns :defs])
+                               (not= 'cljs.core ns)
+                               (not= :interactive (:mode opts)))
+                      (swap! env/*compiler* update-in [::ana/namespaces] dissoc ns))
+                    (let [ret (compile-file* src-file dest-file opts)]
+                      (when *dependents*
+                        (swap! *dependents*
+                          (fn [{:keys [recompile visited]}]
+                            {:recompile (into recompile
+                                          (ana/ns-dependents ns
+                                            (merge *inputs* nses)))
+                             :visited (conj visited ns)})))
+                      ret))
+                  (do
+                    ;; populate compilation environment with analysis information
+                    ;; when constants are optimized
+                    (when (and (true? (:optimize-constants opts))
+                               (nil? (get-in nses [ns :defs])))
+                      (with-core-cljs opts (fn [] (ana/analyze-file src-file opts))))
+                    ns-info)))
+              (catch Exception e
+                (throw (ex-info (str "failed compiling file:" src) {:file src} e))))
+            (throw (java.io.FileNotFoundException. (str "The file " src " does not exist.")))))))))
+
+#?(:clj
+   (defn cljs-files-in
+     "Return a sequence of all .cljs and .cljc files in the given directory."
+     [dir]
+     (filter
+       #(let [name (.getName ^File %)]
+         (and (or (.endsWith name ".cljs")
+                (.endsWith name ".cljc"))
            (not= \. (first name))
            (not (contains? cljs-reserved-file-names name))))
-    (file-seq dir)))
-
-(defn compile-root
-  "Looks recursively in src-dir for .cljs files and compiles them to
-   .js files. If target-dir is provided, output will go into this
-   directory mirroring the source directory structure. Returns a list
-   of maps containing information about each file which was compiled
-   in dependency order."
-  ([src-dir]
-     (compile-root src-dir "out"))
-  ([src-dir target-dir]
-     (compile-root src-dir target-dir nil))
-  ([src-dir target-dir opts]
-     (swap! env/*compiler* assoc :root src-dir)
-     (let [src-dir-file (io/file src-dir)
-           inputs (deps/dependency-order
-                    (map #(ana/parse-ns %)
-                      (cljs-files-in src-dir-file)))]
-       (binding [*inputs* (zipmap (map :ns inputs) inputs)]
-         (loop [inputs (seq inputs) compiled []]
-           (if inputs
-             (let [{:keys [source-file] :as ns-info} (first inputs)
-                   output-file (util/to-target-file target-dir ns-info)
-                   ijs (compile-file source-file output-file opts)]
-               (recur
-                 (next inputs)
-                 (conj compiled
-                   (assoc ijs :file-name (.getPath output-file)))))
-             compiled))))))
+       (file-seq dir))))
+
+#?(:clj
+   (defn compile-root
+     "Looks recursively in src-dir for .cljs files and compiles them to
+      .js files. If target-dir is provided, output will go into this
+      directory mirroring the source directory structure. Returns a list
+      of maps containing information about each file which was compiled
+      in dependency order."
+     ([src-dir]
+      (compile-root src-dir "out"))
+     ([src-dir target-dir]
+      (compile-root src-dir target-dir nil))
+     ([src-dir target-dir opts]
+      (swap! env/*compiler* assoc :root src-dir)
+      (let [src-dir-file (io/file src-dir)
+            inputs (deps/dependency-order
+                     (map #(ana/parse-ns %)
+                       (cljs-files-in src-dir-file)))]
+        (binding [*inputs* (zipmap (map :ns inputs) inputs)]
+          (loop [inputs (seq inputs) compiled []]
+            (if inputs
+              (let [{:keys [source-file] :as ns-info} (first inputs)
+                    output-file (util/to-target-file target-dir ns-info)
+                    ijs (compile-file source-file output-file opts)]
+                (recur
+                  (next inputs)
+                  (conj compiled
+                    (assoc ijs :file-name (.getPath output-file)))))
+              compiled)))))))

 ;; TODO: needs fixing, table will include other things than keywords - David

@@ -1209,8 +1242,9 @@
       (emits-keyword keyword)
       (emits ";\n"))))

-(defn emit-constants-table-to-file [table dest]
-  (io/make-parents dest)
-  (with-open [out ^java.io.Writer (io/make-writer dest {})]
-    (binding [*out* out]
-      (emit-constants-table table))))
+#?(:clj
+   (defn emit-constants-table-to-file [table dest]
+     (io/make-parents dest)
+     (with-open [out ^java.io.Writer (io/make-writer dest {})]
+       (binding [*out* out]
+         (emit-constants-table table)))))


Sanity check Vector Distance

Sanity check Vector Distance

--- src/clojush/problems/software/benchmarks_v2/vector_distance.clj
+++ src/clojush/problems/software/benchmarks_v2/vector_distance.clj
@@ -11,22 +11,23 @@

 ; Atom generators
 (def vector-distance-atom-generators
-  (concat (list
-            ;;; end constants
-            ;;; end ERCs
-            (tag-instruction-erc [:integer :boolean :exec :float :vector_float] 1000)
-            (tagged-instruction-erc 1000)
-            ;;; end tag ERCs
-            'in1
-            'in2
-            ;;; end input instructions
-            )
-          (registered-for-stacks [:integer :boolean :exec :float :vector_float])))
+  (make-proportional-atom-generators
+   (concat
+    (registered-for-stacks [:integer :boolean :exec :float :vector_float])
+    (list (tag-instruction-erc [:integer :boolean :exec :float :vector_float] 1000) ; tags
+          (tagged-instruction-erc 1000)))
+   (list 'in1
+         'in2) ; inputs
+   (list []
+         0) ; constants
+   {:proportion-inputs 0.15
+    :proportion-constants 0.05}))

 (defn vector-distance-input
   "Makes a Vector Distance input vector of length len."
   [len]
-  (vector (vec (repeatedly len #(- (* (rand) 200) 100))) (vec (repeatedly len #(- (* (rand) 200) 100)))))
+  (vector (vec (repeatedly len #(- (* (rand) 200) 100)))
+          (vec (repeatedly len #(- (* (rand) 200) 100)))))

 ;; A list of data domains for the problem. Each domain is a vector containing
 ;; a "set" of inputs and two integers representing how many cases from the set


Pass all tests

Pass all tests

--- src/atom_finder/classifier/type-conversion.clj
+++ src/atom_finder/classifier/type-conversion.clj
@@ -66,8 +66,9 @@
 (s/defmethod context-types IASTBinaryExpression [node]
   [(unify-type (.getOperand1 node))])
 (s/defmethod context-types IASTSimpleDeclaration [node]
-  [(merge (->> node .getDeclSpecifier unify-type)
-         {:unsigned? (unsigned? node)})])
+  (repeat (count (.getDeclarators node))
+          (merge (->> node .getDeclSpecifier unify-type)
+                  {:unsigned? (unsigned? node)})))

 (defmulti arg-types class)
 (s/defmethod arg-types :default [node] nil)


file upload

file upload

--- src/cljs/re_form/inputs/file_upload_impl.cljs
+++ src/cljs/re_form/inputs/file_upload_impl.cljs
@@ -4,18 +4,18 @@
             [clojure.string :as str]
             [cljs.core.async :refer [<!]]))

-(defn file-upload [{:keys [value]}]
+(defn file-upload [{:keys [value value-fn label-fn]}]
   (let [state (r/atom {:value value :uploading? false})
+        label-fn (or label-fn identity)
+        value-fn (or value-fn identity)
         my-onchange (fn [e upload-fn callback]
                       (let [files (array-seq (.-files (.-target e)))]
                         (swap! state merge {:uploading? true :value nil :files files})
                         (let [result-ch (upload-fn files)]
-                          (go (callback (<! result-ch))
+                          (go (callback (value-fn (<! result-ch)))
                               (swap! state merge {:uploading? false :files nil})))))

-        open-file-dialog (fn []
-                           (when-let [file-input (:input-ref @state)]
-                             (.click file-input)))]
+        open-file-dialog (fn [input] (.click input))]

     (r/create-class
      {:component-will-receive-props
@@ -28,10 +28,11 @@

       :reagent-render
       (fn [{:keys [on-change upload-fn multiple] :as props}]
-        (let [{:keys [uploading? value files]} @state]
+        (let [{:keys [uploading? value files]} @state
+              inp (r/atom {})]
           [:div.file-upload {:class (and uploading? "uploading")}
            [:input {:style {:display "none"}
-                    :ref #(swap! state assoc :input-ref %)
+                    :ref #(reset! inp  %)
                     :type "file"
                     :multiple multiple
                     :on-change #(my-onchange % upload-fn on-change)}]
@@ -39,5 +40,5 @@
            (if uploading?
              (str "Uploading " (str/join ", " (map #(.-name %) files)) "...")
              (if value
-               [:pre (.stringify js/JSON (clj->js (:value @state)))]
-               [:a {:href "javascript:void(0);" :on-click open-file-dialog} "Select file to upload..."]))]))})))
+               [:div (label-fn  (:value @state))]
+               [:a {:href "javascript:void(0);" :on-click #(open-file-dialog @inp)} "Select file to upload..."]))]))})))


Added (subvector x k) arity.

Added (subvector x k) arity.

--- src/clojure/uncomplicate/neanderthal/core.clj
+++ src/clojure/uncomplicate/neanderthal/core.clj
@@ -660,10 +660,12 @@

   If the requested region is not within the dimensions of `x`, throws ExceptionInfo.
   "
-  [^Vector x ^long k ^long l]
-  (if (<= (+ k l) (.dim x))
-    (.subvector x k l)
-    (throw (ex-info "Requested subvector is out of bounds." {:k k :l l :k+l (+ k l) :dim (.dim x)}))))
+  ([^Vector x ^long k ^long l]
+   (if (<= (+ k l) (.dim x))
+     (.subvector x k l)
+     (throw (ex-info "Requested subvector is out of bounds." {:k k :l l :k+l (+ k l) :dim (.dim x)}))))
+  ([^Vector x ^long k]
+   (subvector x k (- (.dim x) k))))

 ;; ================= Matrix =======================


Removing warning that was being logged way too many times.

--- src/cmr/indexer/services/concepts/granule.clj
+++ src/cmr/indexer/services/concepts/granule.clj
@@ -36,10 +36,10 @@
   [parent-collection granule]
   (when (get-in granule [:spatial-coverage :geometries])
     (let [gsr (get-in parent-collection [:spatial-coverage :granule-spatial-representation])]
-      (if (= gsr :geodetic)
-        (spatial/spatial->elastic-docs gsr granule)
-        (warn
-          "Only geodetic is supported for granule spatial representation currently. Ignoring this area.")))))
+      (when (= gsr :geodetic)
+        ;; Only index the types we support. We will silently ignore the other kinds. Adding a warning
+        ;; turned out to be way too much logging.
+        (spatial/spatial->elastic-docs gsr granule)))))

 (defmethod idx/concept->elastic-doc :granule
   [context concept umm-granule]


Fix #3 : Remove unused variable in webserver component

--- src/clj/dashboard_clj/components/webserver.clj
+++ src/clj/dashboard_clj/components/webserver.clj
@@ -5,8 +5,7 @@
 (defrecord WebServer [server ->http-handler options websocket]
   component/Lifecycle
   (start [component]
-    (let [handler                       (get component :handler)
-          ring-ajax-post                (get websocket :ring-ajax-post)
+    (let [ring-ajax-post                (get websocket :ring-ajax-post)
           ring-ajax-get-or-ws-handshake (get websocket :ring-ajax-get-or-ws-handshake)
           server                        (run-server (->http-handler ring-ajax-post ring-ajax-get-or-ws-handshake) options)]
       (assoc component :server server)))


ns binding fix

ns binding fix

--- src/clojure/com/zensol/cisql/process_query.clj
+++ src/clojure/com/zensol/cisql/process_query.clj
@@ -98,20 +98,17 @@
       :filename filename})))

 (defn- add-line [line]
-  (let [org-ns (ns-name *ns*)]
-    (try
-      ;; we have to set the namespace so resolve works in the REPL (namespace
-      ;; is `user' otherwise)
-      (in-ns 'com.zensol.cisql.process-query)
-      (some (fn [entry]
-              (if (and (seq? entry)
-                       (= 'fn (first entry)))
-                (eval (list entry line))
-                (let [directive-fn (resolve (first entry))
-                      params (cons line (rest entry))]
-                  (apply directive-fn params))))
-            input-rules)
-      (finally (in-ns org-ns)))))
+  ;; we have to set the namespace so resolve works in the REPL (namespace
+  ;; is `user' otherwise)
+  (binding [*ns* (find-ns 'com.zensol.cisql.process-query)]
+    (some (fn [entry]
+            (if (and (seq? entry)
+                     (= 'fn (first entry)))
+              (eval (list entry line))
+              (let [directive-fn (resolve (first entry))
+                    params (cons line (rest entry))]
+                (apply directive-fn params))))
+          input-rules)))

 (defn- maybe-set-log-level []
   (let [level (conf/config :loglev)]


added navigation buttons

added navigation buttons

--- cljx/plongeur-cljs/src/plongeur/view.cljs
+++ cljx/plongeur-cljs/src/plongeur/view.cljs
@@ -8,11 +8,12 @@
             [sablono.core :refer-macros [html]]
             [foreign.sigma]
             [foreign.linkurious]
-            [plongeur.activity :as nav]
+            [plongeur.route :as r]
             [plongeur.model :as m]
             [plongeur.sigma :as s]
             [plongeur.config :as c]
-            [kierros.async :refer [debounce]])
+            [kierros.async :refer [debounce]]
+            [dommy.core :as d :refer-macros [sel sel1]])
   (:require-macros [cljs.core.async.macros :refer [go go-loop]]))

 (defn ascii [c] (-> c {\f 70
@@ -154,7 +155,7 @@
                :class-name "mdl-button mdl-js-button mdl-button--fab mdl-button--mini-fab"}
          [:i {:class-name "material-icons"} "delete"]]]]])))

-(defcomponent Grid
+(defcomponent Scene-grid
   [state cmd-chans]
   (html [:main {:class-name "mdl-layout__content"}
          [:div {:class-name "mdl-grid mdl-grid--no-spacing"}
@@ -192,6 +193,44 @@
           [:span {:class-name "mdl-list__item-primary-content"}
            [:i {:class-name "material-icons mdl-list__item-icon"} "link"] "Github"]]]))

+(defcomponent Nav-buttons
+  [[current-view user-id] {:keys [navigate]}]
+  (html [:span {}
+         (let [disabled (= :view/login-user current-view)]
+           [:button {:title      "User login"
+                     :class-name (if disabled
+                                   "mdl-button mdl-js-button mdl-button--icon mdl-button--disabled"
+                                   "mdl-button mdl-js-button mdl-button--icon")
+                     :on-click   #(when-not disabled (go (>! navigate :view/login-user)))}
+            [:i {:class-name "material-icons"} (if disabled "person" "person_outline")]])
+
+         (let [disabled (or (= :view/browse-scenes current-view)
+                            (nil? user-id))]
+           [:button {:title      "Browse scenes"
+                     :class-name (if disabled
+                                   "mdl-button mdl-js-button mdl-button--icon mdl-button--disabled"
+                                   "mdl-button mdl-js-button mdl-button--icon")
+                     :on-click   #(when-not disabled (go (>! navigate :view/browse-scenes)))}
+            [:i {:class-name "material-icons"} (if disabled "folder" "folder_open")]])
+
+         (let [disabled (or (= :view/create-scene current-view)
+                            (nil? user-id))]
+           [:button {:title      "Create scene"
+                     :class-name (if disabled
+                                   "mdl-button mdl-js-button mdl-button--icon mdl-button--disabled"
+                                   "mdl-button mdl-js-button mdl-button--icon")
+                     :on-click   #(when-not disabled (go (>! navigate :view/create-scene)))}
+            [:i {:class-name "material-icons"} (if disabled "insert_drive_file" "note_add")]])
+
+         (let [disabled (or (= :view/edit-config current-view)
+                            (nil? user-id))]
+           [:button {:title      "Configuration"
+                     :class-name (if disabled
+                                   "mdl-button mdl-js-button mdl-button--icon mdl-button--disabled"
+                                   "mdl-button mdl-js-button mdl-button--icon")
+                     :on-click   #(when-not disabled (go (>! navigate :view/edit-config)))}
+            [:i {:class-name "material-icons"} "settings"]])]))
+
 (defcomponent Header
   [state {:keys [add-plot fill-plots] :as cmd-chans}]
   (html [:header {:class-name "mdl-layout__header"}
@@ -199,31 +238,27 @@

           ;; Nav buttons

-          (let [disabled (= :view/browse-scenes (m/current-view state))]
-            [:button {:title      "Browse scenes"
-                      :class-name (if disabled
-                                    "mdl-button mdl-js-button mdl-button--icon mdl-button--disabled"
-                                    "mdl-button mdl-js-button mdl-button--icon")
-                      :on-click   #(nav/->browse-scenes cmd-chans)}
-             [:i {:class-name "material-icons"} (if disabled "folder" "folder_open")]])
-
-          (let [disabled (= :view/create-scene (m/current-view state))]
-            [:button {:title      "Create scene"
-                      :class-name (if disabled
-                                    "mdl-button mdl-js-button mdl-button--icon mdl-button--disabled"
-                                    "mdl-button mdl-js-button mdl-button--icon")
-                      :on-click   #(nav/->create-scene cmd-chans)}
-             [:i {:class-name "material-icons"} (if disabled "insert_drive_file" "note_add")]])
-
-          (let [disabled (= :view/edit-config (m/current-view state))]
-            [:button {:title      "Configuration"
-                      :class-name (if disabled
-                                    "mdl-button mdl-js-button mdl-button--icon mdl-button--disabled"
-                                    "mdl-button mdl-js-button mdl-button--icon")
-                      :on-click   #(nav/->edit-config)}
-             [:i {:class-name "material-icons"} "settings"]])
+          (Nav-buttons ((juxt m/current-view m/user-id) state) cmd-chans)
+
+          ; TODO display logged in user + logout button

           [:div {:class-name "mdl-layout-spacer"}]
+
+          (when-let [user-id (m/user-id state)]
+            [:span {}
+             [:div {:class-name "avatar-dropdown"
+                    :id         "user-menu"}
+              [:span {} user-id]]
+
+             [:ul {:class-name "mdl-menu mdl-list mdl-menu--bottom-right mdl-js-menu mdl-js-ripple-effect mdl-shadow--2dp account-dropdown"
+                   :for        "user-menu"}
+
+              [:li {:class-name ""}]
+
+              ]]
+
+
+            )

           (when (= :view/edit-scene (m/current-view state))
             [:div {:on-click   #(go (>! add-plot :sigma))
@@ -246,6 +281,74 @@

                      "hello"]))

+(defn select-val  [el-id] (some-> js/document (sel1 [el-id]) .-value))
+(defn select-vals [el-ids] (->> el-ids (map select-val) vec))
+
+(defn submit-login-form
+  [{:keys [login-user] :as cmd-chans}]
+  (fn [_]
+    (let [credentials (select-vals [:#user-id :#password])]
+      (prn credentials)
+
+      (go (>! login-user credentials)))))
+
+(defcomponent Login-box
+  [state cmd-chans]
+  (let [user-id (m/user-id state)]
+    (html [:main {class-name "mdl-layout__content mdl-color--grey-100"}
+           [:div {:class-name "mdl-card mdl-shadow--2dp employer-form"}
+            [:div {:class-name "mdl-card__title"}
+             [:h2 {} "Sign in"]
+             [:div {:class-name "mdl-card__subtitle"} "Please provide your user credentials"]]
+            [:div {:class-name "mdl-card__supporting-text"}
+             [:div {:class-name "form"}
+
+              [:div {:class-name "form__article"}
+               [:div {:class-name "mdl-grid"}
+
+                [:div {:class-name "mdl-cell mdl-cell--6-col mdl-textfield mdl-js-textfield mdl-textfield--floating-label"}
+                 [:input {:class-name "mdl-textfield__input"
+                          :type       "text"
+                          :id         "user-id"
+                          :default-value user-id}]
+                 [:label {:class-name "mdl-textfield__label" :for "user-id"} "User name"]]
+
+                [:div {:class-name "mdl-cell mdl-cell--6-col mdl-textfield mdl-js-textfield mdl-textfield--floating-label"}
+                 [:input {:class-name "mdl-textfield__input"
+                          :type       "password"
+                          :id         "password"}]
+                 [:label {:class-name "mdl-textfield__label" :for "password"} "Password"]]]]
+
+              [:div {:class-name "form__action"}
+               [:div {:class-name "mdl-layout-spacer"}]
+               [:button {:class-name "mdl-button mdl-js-button mdl-button--raised mdl-button--colored"
+                         :on-click   (submit-login-form cmd-chans)} "Submit"]]]]]])))
+
+(defcomponent Scene-browser
+  [state cmd-chans]
+  (html [:h1 {} "scene-browser"]))
+
+(defcomponent
+  Scene-form
+  [state cmd-chans]
+  (html [:h1 {} "create-scene"]))
+
+(defcomponent
+  Edit-config
+  [state cmd-chans]
+  (html [:h1 {} "edit-config"]))
+
+(defcomponent
+  Splash-screen
+  :on-mount (fn [node state {:keys [navigate]}]
+              (go (<! (timeout 5000))
+                  (>! navigate :view/login-user)))
+  [state {:keys [navigate] :as cmd-chans}]
+  (html [:main {:class-name "mdl-layout__content mdl-color--grey-100"}
+         [:div {:class-name "mdl-card mdl-shadow--2dp employer-form"
+                :on-click   #(go (>! navigate :view/login-user))}
+          [:h1 {:style {:background-color "yellow"}} "<<< Plongeur >>>"]]]))
+
 (defcomponent Root
   [state cmd-chans]
   (html [:div {:id "plongeur-main"}
@@ -257,14 +360,12 @@
           #_(Drawer state cmd-chans)

           (case (m/current-view state)
-            :view/browse-scenes [:h1 {} "browse-scenes"]
-            :view/create-scene  [:h1 {} "create-scene"]
-            :view/edit-scene    (Grid state cmd-chans)
-            :view/edit-config   [:h1 {} "edit-config"]
-
-                                [:h1 {} "uh-oh"])
-
-          ]]))
+            :view/login-user    (Login-box     state cmd-chans)
+            :view/browse-scenes (Scene-browser state cmd-chans)
+            :view/create-scene  (Scene-form    state cmd-chans)
+            :view/edit-scene    (Scene-grid    state cmd-chans)
+            :view/edit-config   (Edit-config   state cmd-chans)
+                                (Splash-screen state cmd-chans))]]))

 (defn view
   "Returns a stream of view trees, represented as a core.async channel."


Standardize status app

Standardize status app

--- src/com/puppetlabs/puppetdb/http/v1/status.clj
+++ src/com/puppetlabs/puppetdb/http/v1/status.clj
@@ -5,7 +5,8 @@
 (ns com.puppetlabs.puppetdb.http.v1.status
   (:require [com.puppetlabs.http :as pl-http]
             [ring.util.response :as rr])
-  (:use [com.puppetlabs.puppetdb.query.status]
+  (:use com.puppetlabs.puppetdb.query.status
+        com.puppetlabs.middleware
         [net.cgrand.moustache :only (app)]
         [com.puppetlabs.jdbc :only (with-transacted-connection)]))

@@ -17,25 +18,12 @@
     (pl-http/json-response status)
     (pl-http/json-response {:error (str "No information is known about " node)} pl-http/status-not-found)))

-(defn node-status-app
-  "Ring app for retrieving node status"
-  [{:keys [params headers globals] :as request}]
-  (let [node (params "node")]
-    (cond
-     (empty? node)
-     (rr/status (rr/response "missing node")
-                pl-http/status-bad-request)
-
-     (not (pl-http/acceptable-content-type
-           "application/json"
-           (headers "accept")))
-     (rr/response "must accept application/json")
-
-     :else
-     (produce-node-status node (:scf-db globals)))))
+(def routes
+  (app
+    ["nodes" node]
+    {:get (fn [{:keys [globals]}]
+            (produce-node-status node (:scf-db globals)))}))

 (def status-app
-  (app
-   ["nodes" node]
-   {:get (fn [req]
-           (node-status-app (assoc-in req [:params "node"] node)))}))
+  "Moustache app for retrieving status information"
+  (verify-accepts-json routes))


Use UNION ALL/INTERSECT ALL/EXCEPT

Use UNION ALL/INTERSECT ALL/EXCEPT

UNION requires sorts in order to remove duplicates, whereas UNION ALL
doesn't. Duplicates don't matter, so why not UNION ALL? INTERSECT ALL is
more semantic than NATURAL JOIN, and also hopefully faster. Similarly,
EXCEPT is a semantically better, and possibly faster, operation
than LEFT OUTER JOIN.

--- src/com/puppetlabs/puppetdb/query/resource.clj
+++ src/com/puppetlabs/puppetdb/query/resource.clj
@@ -122,9 +122,7 @@
   (let [terms  (map compile-query->sql terms)
         params (mapcat rest terms)
         query  (->> (map first terms)
-                    (alias-subqueries)
-                    (string/join " NATURAL JOIN ")
-                   (str "SELECT catalog,resource FROM ")
+                   (string/join " INTERSECT ALL ")
                     (format "(%s)"))]
     (apply vector query params)))

@@ -140,7 +138,7 @@
   (let [terms  (map compile-query->sql terms)
         params (mapcat rest terms)
         query  (->> (map first terms)
-                    (string/join " UNION ")
+                   (string/join " UNION ALL ")
                     (format "(%s)"))]
     (apply vector query params)))

@@ -156,9 +154,6 @@
     (throw (IllegalArgumentException. (str op " requires at least one term"))))
   (let [[subquery & params] (compile-query->sql (cons "or" terms))
         query               (->> subquery
-                    (format (str "SELECT lhs.catalog,lhs.resource FROM catalog_resources lhs "
-                                              "LEFT OUTER JOIN %s rhs "
-                                              "ON lhs.catalog = rhs.catalog AND lhs.resource = rhs.resource "
-                                              "WHERE (rhs.resource IS NULL)"))
-                                 (format "(%s)"))]
+                 (format "SELECT catalog_resources.catalog,catalog_resources.resource FROM catalog_resources EXCEPT %s")
+                 (format "(%s)"))]
     (apply vector query params)))


don't need an atom here

don't need an atom here

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -151,8 +151,8 @@
    "affolato"
    [;; comparative
     (let [is-place {:synsem {:sem {:place true}}} ;; only places can be crowded.
-          than-this (atom {:pred :di
-                           :mod is-place})]
+          than-this {:pred :di
+                     :mod is-place}]
       {:unify [adjective comparative is-place]
        :synsem {:sem {:pred :affolato
                       :arg1 is-place


whitespace

whitespace

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -1270,7 +1270,6 @@
                       :number :sing}
                 :sem {:number :plur
                       :person :3rd}}}
-
       "la mia"
       {:synsem {:cat :det
                 :def :possessive
@@ -1278,7 +1277,6 @@
                       :number :sing}
                 :sem {:number :sing
                       :person :1st}}}
-
       "la nostra"
       {:synsem {:cat :det
                 :def :possessive


whitespace

whitespace

--- src/babel/italiano/lexicon.cljc
+++ src/babel/italiano/lexicon.cljc
@@ -1868,7 +1868,7 @@
                             :pred :suonare}}}
 ;                                            :obj {:music true}}}})

- "svenire" {:synsem {:cat :verb
+   "svenire" {:synsem {:cat :verb
                       :essere true
                       :sem {:pred :faint}}
              :italiano {:passato "svenuto"


Added "!burrito" command, for generating a random choice of tex-mex food from Los Cardos.

Example: pauldoo: !burrito spraffbot: haggis soft tacos with extra hot
salsa, guacamole, and a guacamole pot on the side, please!

--- Spraff/src/spraff/core.clj
+++ Spraff/src/spraff/core.clj
@@ -103,6 +103,72 @@
     (dosync (ref-set state-ref
         (update-state message @state-ref))))

+; BURRITO!
+
+(def styles [
+    "burrito"
+    "fajita burrito"
+    "burrito bowl"
+    "quesadilla"
+    "soft tacos"
+])
+
+(def fillings [
+    "steak"
+    "red tractor chicken"
+    "carnitas"
+    "haggis"
+    "vegetarian"
+    "basic"
+])
+
+(def salsas [
+    "pico de gallo"
+    "verde"
+    "black"
+    "roastin' red"
+    "extra hot"
+])
+
+(def extras [
+    "guacamole"
+    "sour cream"
+    "cheese"
+])
+
+(def sides [
+    "a single soft taco"
+    "tortilla chips"
+    "a guacamole pot"
+    "a salsa pot"
+    "a small tortilla"
+    "a bean pot"
+    "a sour cream pot"
+    "a jalapeno pot"
+])
+
+(defn rand-bool [] (= (rand-int 2) 1))
+
+(defn single [coll] (rand-nth coll))
+(defn multiple [coll] (filter (fn [_] (rand-bool)) coll))
+(defn maybe-single [coll s] (let [c (rand-nth (cons nil coll))]
+    (if (nil? c)
+        []
+        [(str c s)])))
+(defn inject-and [coll] (concat (take (dec (count coll)) coll) [(str "and " (last coll))]))
+
+(defn generate-burrito [] (str
+    (single fillings) " "
+    (single styles) " with "
+    (join ", " (inject-and (concat
+        [(str (single salsas) " salsa")]
+        (multiple extras)
+        (maybe-single sides " on the side"))))
+    ", please!"
+))
+
+; BURRITO!
+
 (defn on-message [{:keys [nick channel message irc]} state-ref]
     (log-sentence! message)
     (update-state! message state-ref)
@@ -111,7 +177,11 @@
             (join " " (generate-sentence
                 @state-ref
                 (let [keywords (set (filter #(not (.contains % (:name @irc))) (split-sentence-to-words message)))]
-                    (if (<= (count keywords) 3) keywords #{})))))))
+                    (if (<= (count keywords) 3) keywords #{}))))))
+    (if (.startsWith message "!burrito")
+        (send-message irc channel
+            (generate-burrito)))
+)

 (defn -main
     [& args]


Refinements to pclass lookups

Refinements to pclass lookups

--- src/pamela/htn.clj
+++ src/pamela/htn.clj
@@ -284,18 +284,20 @@
                        (get-in ir [hem-pclass :fields field :initial])

                        (= type :plant-fn-symbol)
-                       (let [henpt-irks (:irks henpt)
+                       (let [method-arg (get argument-mappings name)
+                             pclass-arg (if-not method-arg
+                                          (first (filter #(= (:param %) name) pargs)))
+                             henpt-irks (:irks henpt)
                              caller_ (get-in ir henpt-irks)
                              caller-pclass (first henpt-irks)]
-
-                         ;;(dbg-println :error "ERROR, not currently supported plant-fn type=" type)
-                         (if (or (= (:type caller_) :plant-fn-field)
+                         (dbg-println :trace "RPC name" name "method-arg"
+                                      method-arg "pclass-arg" pclass-arg)
+                         (or method-arg pclass-arg
+                             (if (or (= (:type caller_) :plant-fn-field)
                                  (and (= (:type caller_) :plant-fn-symbol)
                                       (= (:name caller_) 'this)))
-                           (get-in ir [caller-pclass :fields (:field caller_) :initial])
-                           ;;(dbg-println :error "ERROR, Resolve plant-fn-symbol w/in scope of caller-pclass")
-                           {:type :arg-reference :name name}
-                           ))
+                               (get-in ir [caller-pclass :fields (:field caller_) :initial]))
+                             {:error :unresolved-pclass-ctor}))

                        (= type :delay)
                        {}
@@ -304,10 +306,7 @@
                        (do
                          (dbg-println :error "ERROR, not currently supported plant-fn type=" type)
                          nil))
-        pclass-ctor_ (if (= (:type pclass-ctor_) :arg-reference)
-                       (let [param (:name pclass-ctor_)]
-                         (first (filter #(= (:param %) param) pargs)))
-                       pclass-ctor_)
+        _ (dbg-println :trace "RPC pclass-ctor_" pclass-ctor_)
         ;; pclass-ctor_ (cond
         ;;                (= pclass ::unknown) ;; matching method in pargs?
         ;;                ;; (let [plant-fn_ (get-in ir irks)
@@ -562,8 +561,12 @@
 (defn find-methods-that-expand-task [ir task]
   (let [{:keys [type pclass name arguments]} task
         ;; all-methods (seq (get @*htn-methods* pclass))]
-        all-methods (if (htn-isa? type :htn-nonprimitive-task)
-                      (find-candidate-methods ir pclass name))]
+        ;; all-methods (if (htn-isa? type :htn-nonprimitive-task)
+        ;;               (find-candidate-methods ir pclass name))
+        all-methods (if (nil? pclass)
+                      (do (dbg-println :error "FMTET pclass is nil!!!") [])
+                      (if (htn-isa? type :htn-nonprimitive-task)
+                        (find-candidate-methods ir pclass name)))]
     (dbg-println :debug "FMTET" name "TYPE" type ;; DEBUG
              "PCLASS" pclass "ALL" (map first all-methods))
     (when-not (empty? all-methods)
@@ -836,6 +839,8 @@
   (let [network-flows (if (network-flow-types name)
                         (make-network-flows name flow-characteristics arguments)
                         network-flows)]
+    (if-not pclass
+      (throw (Exception. (str "htn-task constructed w/o pclass: name" name))))
     (update-htn-object!
      (assoc-if (htn-object {:prefix prefix :uid uid :ancestry-path ancestry-path})
                :type :htn-task
@@ -1650,6 +1655,44 @@
 ;;         :args args}]
 ;; (assoc ir 'root-task rt)))

+(defn get-pclass-for-field [ir mpclass field]
+  ;;If the :initial map is an :arg-reference, then there is
+  ;;no :pclass available and plant-class will be nil.  However, at
+  ;;this point, we don't yet have a root task, so we can't expand
+  ;;the :arg-reference
+  (let [initial_ (get-in ir [mpclass :fields field :initial])]
+    (case (:type initial_)
+      :pclass-ctor (:pclass initial_)
+
+      :arg-reference
+      (let [arg (:name initial_)
+            arg-position (vec-index-of (get-in ir [mpclass :args]) arg)
+            all-pclasses (keys ir)]
+        (loop [pclasses [] pc (first all-pclasses) more (rest all-pclasses)]
+          (if-not pc
+            (if (= (count pclasses) 1)
+              (first pclasses)
+              :unknown-pclass)
+            (let [pclass (if (not= pc mpclass) pc)
+                  fields (if pclass (keys (get-in ir [pclass :fields])))
+                  pcs (vec (remove nil? (mapv
+                                         #(let [initial (get-in ir [pclass :fields % :initial])
+                                                ctor-arg (if (and (= (:type initial) :pclass-ctor)
+                                                                  (= (:pclass initial) mpclass))
+                                                           (get (:args initial) arg-position))]
+                                            (if ctor-arg
+                                              (get-in ir [pclass :fields (keyword ctor-arg) :initial :pclass])))
+                                         fields)))
+                  pclasses (if (not (empty? pcs))
+                             (concatv pclasses pcs)
+                             pclasses)
+                  pc (first more)
+                  more (rest more)]
+              (recur pclasses pc more)))))
+      :unknown-pclass)))
+
+
+
 ;; will return subtasks, if any
 ;; irks are the ks to get-in the ir for the method in question (initially nil)
 (defn get-htn-method-subtasks [ir pargs top-level-type mpclass mname display-name margs sub-body irks]
@@ -1695,7 +1738,9 @@
                                           (do (dbg-println :warn "GHMS Can't resolve name" name "to a pclass")
                                               name))))
                                     ;;else :plant-fn-field
-                                    (get-in ir [mpclass :fields field :initial :pclass]))
+                                    ;;(get-in ir [mpclass :fields field :initial :pclass])
+                                    (get-pclass-for-field ir mpclass field)
+                                    )
                       plant-fn-primitive?
                       (get-in ir [plant-class :methods method :primitive])
                       _ (dbg-println :debug "plant-class" plant-class "plant-fn-primitive?" plant-fn-primitive?)


First 4 exercises in chapter 3

First 4 exercises in chapter 3


Refactoring.

Refactoring.

--- Clojure/primes.clj
+++ Clojure/primes.clj
@@ -13,11 +13,7 @@
                 (recur x (inc n))))))

 (println
-    (map
-        (fn [k] (nth k 0))
-        (filter
-            (fn [k] (nth k 1))
-            (map
-                (fn [x] (vec [x (isprime? x)]))
-                (take 42 (iterate inc 0))))))
+    (filter
+        isprime?
+        (take 42 (iterate inc 0))))


Clean code

Clean code

--- src/adzerk/boot_cljs.clj
+++ src/adzerk/boot_cljs.clj
@@ -193,9 +193,11 @@
         (info "Compiling ClojureScript...\n")
         (let [diff          (fs-diff! prev fileset)
               macro-changes (macro-files-changed diff)
-              compile   #(compile-1 compilers *opts* tmp-result macro-changes %)
               cljs-edns (main-files fileset ids)
-              results   (mapv deref (mapv compile cljs-edns))
+              ;; Force realization to start compilation
+              futures   (doall (map (partial compile-1 compilers *opts* tmp-result macro-changes) cljs-edns))
+              ;; Wait for all compilations to finish
+              results   (doall (map deref futures))
               ;; Since each build has its own :output-dir we don't need to do
               ;; anything special to merge dependency ordering of files across
               ;; builds. Each :output-to js file will depend only on compiled


server.clj: fixed error

server.clj: fixed error

--- src/aristotle/server.clj
+++ src/aristotle/server.clj
@@ -21,11 +21,8 @@
    daemon-name))

 (defn home-route [req]
-  (let [host (get-in req [:headers "host"])]
-    (println (str host (get legacy-urls host)))
-    (if (contains? legacy-urls host)
-      {:status 301
-       :headers {"Location" "https://slightlycyborg.github.io/daemon.life/"}})))
+  {:status 301
+   :headers {"Location" "https://slightlycyborg.github.io/daemon.life/"}})

 (defn daemon-route
   "Returns the full html page with search results included"


Redirect to login page after logout

Redirect to login page after logout

--- src-cljs/rmfu_ui/nav.cljs
+++ src-cljs/rmfu_ui/nav.cljs
@@ -4,6 +4,7 @@
 (defn logout []
   "Logs the user out by deleting key form local storage"
   (.removeItem (.-localStorage js/window) "rmfu-feed-identity-token")
+  (secretary/dispatch! "/")
 )

 (defn nav


Add braid.lib.color/->color-darker

Add braid.lib.color/->color-darker

--- src/braid/lib/color.cljs
+++ src/braid/lib/color.cljs
@@ -7,6 +7,9 @@
 (defn ->color [input]
   (js/window.HUSL.toHex (mod (Math/abs (hash input)) 360) 95 50))

+(defn ->color-darker [input]
+  (js/window.HUSL.toHex (mod (Math/abs (hash input)) 360) 95 30))
+
 (defn url->color [url]
   (-> url
       string/lower-case


Bug fix for `parse-squares`.

Bug fix for `parse-squares`.

The squares with no pieces on them are now skipped altogether, but this should
be fine as (get m "location") returns nil anyways.

--- src/chessground/fen.cljs
+++ src/chessground/fen.cljs
@@ -11,15 +11,18 @@
   (str (get "abcdefgh" (mod pos 8))
        (- 8 (int (/ pos 8)))))

-(defn- parse-squares [fen-chars]
+(defn- parse-squares
+  "Parses a FEN-notation of a chess board into a map of locations ->
+  piece, where piece is represented as {:role r, :color c}."
+  [fen-chars]
   (loop [pieces {}
          pos 0
          [current & next] fen-chars]
     (let [as-int (js/parseInt current)
           spaces (when-not (js/isNaN as-int) as-int)]
-      (println (str "pos: " pos ", current: " current ", as-int: " as-int "\n"))
       (cond
-        (nil? current) pieces
+        (> pos 63) pieces
+        (= current "/") (recur pieces pos next)
         (not (nil? spaces)) (recur pieces (+ pos spaces) next)
         :else (let [key (pos-to-key pos)
                     lower (lower-case current)


pass unconform along on conformer with-gen

Signed-off-by: Rich Hickey <2f3b32171da334ad5d7d0db393d0928eef4308ab@gmail.com>

--- src/clj/clojure/spec.clj
+++ src/clj/clojure/spec.clj
@@ -802,7 +802,7 @@
        (gen* [_ _ _ _] (if gfn
                          (gfn)
                          (gen/gen-for-pred pred)))
-       (with-gen* [_ gfn] (spec-impl form pred gfn cpred?))
+       (with-gen* [_ gfn] (spec-impl form pred gfn cpred? unc))
        (describe* [_] form)))))

 (defn ^:skip-wiki multi-spec-impl


fix dev websocket port

fix dev websocket port

--- src/cljs/ceres/core.cljs
+++ src/cljs/ceres/core.cljs
@@ -31,7 +31,7 @@
         :repl-env (weasel.repl.websocket/repl-env
                    :ip "0.0.0.0" :port 17782)))

-#_(ws-repl/connect "ws://localhost:17782" :verbose true)
+(ws-repl/connect "ws://localhost:17782" :verbose true)

 (def app-state
   (atom
@@ -40,7 +40,7 @@
     :news-diffusion nil
     :tweet-count 0}))

-#_(fw/watch-and-reload
+(fw/watch-and-reload
   ;; :websocket-url "ws://localhost:3449/figwheel-ws" default
  :jsload-callback (fn [] (print "reloaded"))) ;; optional callback

@@ -59,7 +59,8 @@

 (defn y
   "Compute linear y component"
-  [data height]
+  [data heigh
+   t]
   (-> d3
       .-scale
       (.linear)
@@ -263,7 +264,7 @@
                                (if ssl?  "wss://" "ws://")
                                (.getDomain uri)
                                (when (= (.getDomain uri) "localhost")
-                                 ":" 8082 #_(.getPort uri))
+                                 (str ":" 8082) #_(.getPort uri))
                                "/tweets/ws")))]
             (om/set-state! owner :ws-in (:in connection))
             (om/set-state! owner :ws-out (:out connection))


Spelling

Spelling

--- src/cljs/go/compiler.clj
+++ src/cljs/go/compiler.clj
@@ -803,7 +803,7 @@
                                          (:field target))]
             (do
               (warn-on-reflection target)
-              (emitln "Native_set_instance_field.X_invoke_Arirty3(" (:target target) ","
+              (emitln "Native_set_instance_field.X_invoke_Arity3(" (:target target) ","
                       (wrap-in-double-quotes (munge (go-public reflective-field) #{}))
                       ","  val ")"))
             (do
@@ -866,7 +866,7 @@
         (do
           (warn-on-reflection dot)
           (if field
-            (emits "Native_get_instance_field.X_invoke_Arirty2(" target ","
+            (emits "Native_get_instance_field.X_invoke_Arity2(" target ","
                    (wrap-in-double-quotes (munge (go-public field) #{})) ")")
             (emits "Native_invoke_instance_method.X_invoke_Arity3(" target ","
                    (wrap-in-double-quotes (munge (go-public method) #{})) ","


Add polyline default opts

Add polyline default opts

--- src/cljs/gtfve/maps.cljs
+++ src/cljs/gtfve/maps.cljs
@@ -18,6 +18,11 @@
                                     :lng 121.032520}
                            :mapTypeId (:ROADMAP map-types)
                            :zoom 15})
+
+(defonce default-polyline-opts {:geodesic true
+                                :strokeColor "#0000FF"
+                                :strokeOpacity 1.0
+                                :strokeWeight 2})

 (defonce default-marker-opts {:icon "http://www.google.com/intl/en_us/mapfiles/ms/micons/blue-dot.png"})


Remove reference to comms

Remove reference to comms

--- src/cljs/threed/api.cljs
+++ src/cljs/threed/api.cljs
@@ -1,7 +1,6 @@
 (ns threed.api
   (:require [cljs.core.async :refer [put! chan <!]]
-            [om-sync.util :refer [edn-xhr]]
-            [threed.comms :as comms]))
+            [om-sync.util :refer [edn-xhr]]))

 (defn events->positions [events]
   (reduce (fn [positions event]
@@ -19,7 +18,7 @@
   (edn-xhr
    {:method :post
     :url "/events"
-    :data {:event/name "add" :event/position pos ;; :csrf-token (:csrf-token @comms/chsk-state)
+    :data {:event/name "add" :event/position pos
            }
     :on-complete
     (fn [res]


First three bars, written directly with translate. Has two missing 'accidentals' from the switch to D-major.

--- src/overtunes/songs/variatio-12.clj
+++ src/overtunes/songs/variatio-12.clj
@@ -14,22 +14,19 @@

 (defn bpm [per-minute] #(-> % (/ per-minute) (* 60) (* 1000)))
 (defn translate [f x y] #(-> % (+ x) f (+ y)))
-(def from #(translate %1 0 %2))
-(def after #(translate %1 %2 0))
 (defn syncopate [timing durations] #(->> % (sum-n durations) timing))

-
-(def pitches (flatten [-7 0 (range -1 4) (range 2 -1 -1)]))
-(def durations (flatten [1/2 (repeat 2 1/4) 1/2 (repeat 6 1/4)]))
+(def pitches (flatten [-7 0 (range -1 4) (range 2 -1 -1) 4 (range 1 9) (range 7 -2 -1) 0]))
+(def durations (flatten [1/2 (repeat 2 1/4) 1/2 (repeat 6 1/4) (repeat 8 1/4) 3/2 (repeat 10 1/4)]))

 (defn melody# [timing notes]
   (let [note# #(at (timing %1) (piano (g-major %2)))]
     (dorun (map-indexed note# notes))))

 (defn play# []
-  (let [timing (-> (bpm 120) (from (now)))
-        rhythm-from #(syncopate (after timing %) durations)]
-    (melody# (rhythm-from 0)  pitches)
+  (let [timing (-> (bpm 120) (translate 0 (now)))
+        rhythm-from #(syncopate (translate timing % 0) durations)]
+    (melody# (rhythm-from 0) pitches)
     ))

 (play#)


implement initial deftype*/defrecord* parsing

--- src/main/clojure/clojure/tools/analyzer/js.clj
+++ src/main/clojure/clojure/tools/analyzer/js.clj
@@ -32,7 +32,7 @@
 (defn empty-env
   "Returns an empty env map"
   []
-  {:context    :expr
+  {:context    :statement
    :locals     {}
    :ns         'cljs.user
    :namespaces (atom '{cljs.user {:mappings {}
@@ -90,7 +90,6 @@
   [form env]
   (let [val (.val ^JSValue form)
         items-env (ctx env :expr)]
-
     (if (map? val)
       ;; keys should always be symbols/kewords, do we really need to analyze them?
       {:op       :js-object
@@ -111,6 +110,38 @@
     (analyze-js-value form env)
     (ana/-analyze-form form env)))

+(deftype Type [name namespace fields])
+
+(defn parse-type
+  [op [_ name fields pmasks :as form] {:keys [ns namespaces] :as env}]
+  (let [fields-expr (mapv (fn [name]
+                            {:env     env
+                             :form    name
+                             :name    name
+                             :mutable (:mutable (meta name))
+                             :local   :field
+                             :op      :binding})
+                          fields)]
+    ;; TODO:
+    ;; handle (-> name meta :protocols)
+    (swap! namespaces assoc-in [ns :mappings name] (->Type name ns fields))
+
+    {:op       op
+     :env      env
+     :form     form
+     :name     name
+     :fields   fields-expr
+     :pmasks   pmasks
+     :children [:fields]}))
+
+(defmethod parse 'deftype*
+  [form env]
+  (parse-type :deftype form env))
+
+(defmethod parse 'defrecord*
+  [form env]
+  (parse-type :defrecord form env))
+
 (defn analyze
   ([form] (analyze form (empty-env) {}))
   ([form env] (analyze form env {}))


pithy quote

pithy quote

--- src/such/casts.clj
+++ src/such/casts.clj
@@ -1,5 +1,8 @@
 (ns such.casts
-  "Some Clojure functions require specific types of arguments, such as
+  "\"Be conservative in what you send, be liberal in what you accept.\"
+         -- Postel's Robustness Principle
+
+   Some Clojure functions require specific types of arguments, such as
    a symbol representing a namespace. You can use these functions to
    convert from what you've got to what Clojure requires. Or you can
    use them to build more accepting variants of those Clojure


Tweakage.

Tweakage.

--- jlad/jlad.clj
+++ jlad/jlad.clj
@@ -45,19 +45,19 @@

 (defrecord variable [name]
   Evaluable
-  (jl-eval [self env] (lookup env (:name self)))
+  (jl-eval [self env] (lookup env name))
   Destructurable
   (jl-destructure [self arg] {name arg}))

 (defrecord constant [object]
   Evaluable
-  (jl-eval [self env] (:object self))
+  (jl-eval [self env] object)
   Destructurable
   (jl-destructure [self arg] {}))

 (defrecord lambda-exp [formal body]
   Evaluable
-  (jl-eval [self env] (new closure (:formal self) (:body self) env)))
+  (jl-eval [self env] (new closure formal body env)))

 (defrecord application [operator operand]
   Evaluable
@@ -97,7 +97,7 @@
 		 (syntax-operands (next exp))))))

 (defn syntax-body [exps]
-  ;; Only one-form bodies for now
+  ;; TODO Only one-form bodies for now
   (syntax (first exps)))

 (defn syntax-operands [exps]


Made (a little) more elegant by using -> and bpm instead of mpb.

--- src/overtunes/songs/row_row_row_your_boat.clj
+++ src/overtunes/songs/row_row_row_your_boat.clj
@@ -5,9 +5,9 @@

 (defn sum-up-to [series n] (apply + (take n series)))
 (def major-scale #(sum-up-to (cycle [2 2 1 2 2 2 1]) %))
-(def g-major #(+ 67 (major-scale %)))
+(def g-major #(-> % major-scale (+ 67)))

-(defn ms-per-beat [ms start] #(+ start (* % ms)))
+(defn bpm [beats start] #(-> % (/ beats) (* 60) (* 1000) (+ start)))
 (defn after [timing beats] #(timing (+ beats %)))
 (defn syncopate [timing lengths] #(timing (sum-up-to lengths %)))

@@ -19,7 +19,7 @@
     (dorun (map-indexed note# notes))))

 (defn play# []
-  (let [timing (ms-per-beat 500 (now))
+  (let [timing (bpm 150 (now))
         rhythm #(syncopate % durations)]
     (melody# (rhythm (after timing 0)) pitches)
     (melody# (rhythm (after timing 16)) pitches)


Do we still need the ls-tree route?

Do we still need the ls-tree route?

--- src/cider_ci/repository/web.clj
+++ src/cider_ci/repository/web.clj
@@ -68,16 +68,6 @@
       (respond-with-500 request e))))

-(defn ls-tree [request]
-  (logging/debug 'ls-tree request)
-  (let [id (-> request :params :id)
-        include-regex (-> request :params :include-match)
-        exclude-regex (-> request :params :exclude-match)]
-    (when-let [repository (sql.repository/resolve id)]
-      {:headers {"Content-Type" "application/json"}
-       :body (json/write-str (git.repositories/ls-tree repository id include-regex exclude-regex))}
-      )))
-
 ;##### status dispatch ########################################################

 (defn status-handler [request]
@@ -140,7 +130,6 @@
     (cpj/GET "/project-configuration/:id" _ get-project-configuration)
     (cpj/GET "/path-content/:id/*" request
              (get-path-content request))
-    (cpj/GET "/ls-tree/:id/" _ ls-tree)
     (cpj/GET "/:id/git/*" request
              (get-git-file request))
     ))