Compute permutation that sorts the input

order3.clj

;; Written to answer https://stackoverflow.com/questions/47254742/sort-primitive-array-with-custom-comparator-on-clojure
;; See https://gist.github.com/michalmarczyk/11bbfd0b19b6357f533b192bf9da84ac for the single-threaded version

(defn order3 [xs]
  (let [rnd (java.util.Random.)
        a1 (double-array xs)
        a2 (long-array (alength a1))]
    (dotimes [i (alength a2)]
      (aset a2 i i))
    (letfn [(quicksort [^long l ^long h]
              (if (< l h)
                (let [p (.invokePrim ^clojure.lang.IFn$LLL partition l h)]
                  (quicksort l (dec p))
                  (quicksort (inc p) h))))
            (partition ^long [^long l ^long h]
              (let [pidx (+ l (.nextInt rnd (- h l)))
                    pivot (aget a1 pidx)]
                (swap1 a1 pidx h)
                (swap2 a2 pidx h)
                (loop [i (dec l)
                       j l]
                  (if (< j h)
                    (if (< (aget a1 j) pivot)
                      (let [i (inc i)]
                        (swap1 a1 i j)
                        (swap2 a2 i j)
                        (recur i (inc j)))
                      (recur i (inc j)))
                    (let [i (inc i)]
                      (when (< (aget a1 h) (aget a1 i))
                        (swap1 a1 i h)
                        (swap2 a2 i h))
                      i)))))
            (swap1 [^doubles a ^long i ^long j]
              (let [tmp (aget a i)]
                (aset a i (aget a j))
                (aset a j tmp)))
            (swap2 [^longs a ^long i ^long j]
              (let [tmp (aget a i)]
                (aset a i (aget a j))
                (aset a j tmp)))]
      (let [lim (alength a1)
            mid (quot lim 2)
            f1 (future (quicksort 0 (dec mid)))
            f2 (future (quicksort mid (dec lim)))]
        @f1
        @f2
        (loop [out (transient [])
               i 0
               j mid]
          (cond
            (== i mid)
            (persistent!
              (if (== j lim)
                out
                (reduce (fn [out j]
                          (conj! out (aget a2 j)))
                  out
                  (range j lim))))

            (== j lim)
            (persistent!
              (reduce (fn [out i]
                        (conj! out (aget a2 i)))
                out
                (range i mid)))

            :else
            (let [ie (aget a1 i)
                  je (aget a1 j)]
              (if (< ie je)
                (recur (conj! out (aget a2 i)) (inc i) j)
                (recur (conj! out (aget a2 j)) i (inc j))))))))))