Fixing primitive invoke and hamf's special let.

codegen/gen_prim_invoke.clj

@@ -60,14 +60,18 @@
   or returned from if-statements and then you need to explicitly call the primitive overload - this makes
   that pathway less verbose.\")\n\n"))
     (doseq [sig ifn-sigs]
-      (let [sname (apply str (map name sig))]
-        (.write w (str "(defn as-" sname " ^clojure.lang.IFn$" (.toUpperCase sname) "[f] f)\n"))
+      (let [sname (apply str (map name sig))
+            ifn-name (str "clojure.lang.IFn$" (.toUpperCase sname))]
+        (.write w (str "(defn ->" sname " ^" ifn-name " [f]
+  (if (instance? " ifn-name " f)
+    f
+    (throw (RuntimeException. (str f \" is not an instance of" ifn-name "\")))))\n"))
         (.write w (str "(defmacro " sname " [f"))
         (dotimes [i (dec (count sig))]
           (.write w (str " "))
           (.write w (str "arg" i)))
         (.write w "]\n")
-        (.write w (str "`(.invokePrim (as-" sname " ~f)"))
+        (.write w (str "`(.invokePrim ~f"))
         (dotimes [i (dec (count sig))]
           (.write w (str " "))
           (.write w (str "~arg" i)))

src/ham_fisted/api.clj

@@ -1884,7 +1884,7 @@ ham-fisted.api> (binary-search data 1.1 nil)
     `(~ctor ~data)
     ;;16 chosen arbitrarily
     (and (vector? data) (< (count data) 16))
-    `(let [~'ary (~ctor ~(count data))]
+    `(let [~'ary (~ctor (unchecked-int ~(count data)))]
        (do
          ~@(->> (range (count data))
                 (map (fn [^long idx]
@@ -1952,10 +1952,16 @@ ham-fisted.api> (binary-search data 1.1 nil)
      (doto (ArrayLists$LongArrayList.)
        (.addAllReducible (->reducible cap-or-data))))))
 
+(def ^:no-doc long-array-cls (Class/forName "[J"))
+
 (defn ^:no-doc long-array-v
   ^longs [data]
-  (if (instance? IMutList data)
+  (cond
+    (instance? long-array-cls data)
+    data
+    (instance? IMutList data)
     (.toLongArray ^IMutList data)
+    :else
     (do-make-array #(ArrayLists/longArray %) #(ArrayLists/toList ^longs %)
                    long-array-list data)))
 
@@ -2015,10 +2021,17 @@ ham-fisted.api> (binary-search data 1.1 nil)
        (.addAllReducible (->reducible cap-or-data))))))
 
 
+(def dbl-ary-cls (Class/forName "[D"))
+
+
 (defn ^:no-doc double-array-v
   ^doubles [data]
-  (if (instance? IMutList data)
+  (cond
+    (instance? dbl-ary-cls data)
+    data
+    (instance? IMutList data)
     (.toDoubleArray ^IMutList data)
+    :else
     (do-make-array #(ArrayLists/doubleArray %) #(ArrayLists/toList ^doubles %)
                    double-array-list data)))
 

src/ham_fisted/hlet.clj

@@ -15,14 +15,15 @@ user> (hlet [[a b] (dbls [1 2])] (+ a b))
   (:require [ham-fisted.api :as hamf]
             [ham-fisted.lazy-noncaching :as lznc]
             [ham-fisted.reduce :as hamf-rf])
-  (:import [java.util List]))
+  (:import [java.util List])
+  (:refer-clojure :exclude [let]))
 
 
 (def ^{:private true
        :tag java.util.Map} extension-table (hamf/java-concurrent-hashmap))
 
 
-(defn extend-hlet
+(defn extend-let
   "Code must take two arguments, left and right hand sides and return
   a flattened sequence of left and right hand sides.
   This uses a special symbol that will look like a function call on the
@@ -36,7 +37,7 @@ user> (hlet [[a b] (dbls [1 2])] (+ a b))
 (defn- rhs-code
   [r]
   (when (list? r)
-    (let [s (first r)]
+    (clojure.core/let [s (first r)]
       (when (symbol? s)
         (.get extension-table s)))))
 
@@ -52,7 +53,7 @@ user> (hlet [[a b] (dbls [1 2])] (+ a b))
   (->
    (reduce (fn [acc pair]
              (if-let [code (rhs-code (pair 1))]
-               (let [new-pairs (code pair)]
+               (clojure.core/let [new-pairs (code pair)]
                  (when-not (== 0 (rem (count new-pairs) 2))
                    (throw (RuntimeException. (str "Code for symbol " (first (pair 1)) " returned uneven number of results"))))
                  (add-all!  acc new-pairs))
@@ -62,20 +63,20 @@ user> (hlet [[a b] (dbls [1 2])] (+ a b))
    (persistent!)))
 
 
-(defmacro hlet
+(defmacro let
   "Extensible let intended to allow typed destructuring of arbitrary datatypes such as primitive vectors
   or point types.  Falls back to normal let after extension process."
   [bindings & body]
   (when-not (== 0 (rem (count bindings) 2))
     (throw (RuntimeException. "Bindings must be divisible by 2")))
-  `(let ~(process-bindings bindings)
+  `(clojure.core/let ~(process-bindings bindings)
      ~@body))
 
 
 (defn ^:no-doc typed-nth-destructure
   [nth-symbol code]
-  (let [lvec (code 0)
-        rdata (second (code 1))]
+  (clojure.core/let [lvec (code 0)
+                     rdata (second (code 1))]
     (if (vector? lvec)
       (let [rtemp (if (symbol? rdata)
                     rdata
@@ -91,16 +92,16 @@ user> (hlet [[a b] (dbls [1 2])] (+ a b))
       [lvec '(double rdata)])))
 
 
-(extend-hlet
+(extend-let
  'dbls
  #(typed-nth-destructure 'ham-fisted.api/dnth %))
 
-(extend-hlet
+(extend-let
  'lngs
  #(typed-nth-destructure 'ham-fisted.api/lnth %))
 
 
-(defn hlet-extension-names
+(defn let-extension-names
   "Return the current extension names."
   []
   (keys extension-table))