git » blacktide.git » commit 6262a4e

diff --git a/src/com/tailrecursion/blacktide/compiler/passes/numeric.clj b/src/com/tailrecursion/blacktide/compiler/passes/numeric.clj
index c04abbe..ed7befc 100644
--- a/src/com/tailrecursion/blacktide/compiler/passes/numeric.clj
+++ b/src/com/tailrecursion/blacktide/compiler/passes/numeric.clj
@@ -11,15 +11,25 @@
 
 (np/defpass conversion-call {:from [l/Machine Rhs] :to [l/Numeric Rhs] :body true}
   [rhs]
-  (if (and (= :convert (:op rhs)) (:parameter? (:conversion rhs))
-           (not (:primitive? (:jvm (:value rhs)))))
+  (if (and (= :convert (:op rhs)) (:parameter? (:conversion rhs)))
     (let [type (:type (:conversion rhs))
+          fact (:jvm (:value rhs)) source (:type fact)
+          float-narrow? (and (:primitive? fact) (identical? source Double/TYPE) (identical? type Float/TYPE))
+          ;; Preserve Compiler.emitTypedArgs' direct primitive conversions,
+          ;; including unchecked double-to-float even under checked math.
+          ;; Only its box/check-Number/runtime-cast path needs lowering.
+          direct? (and (:primitive? fact)
+                       (or (= type source) float-narrow?
+                           (and (identical? source Integer/TYPE) (identical? type Long/TYPE))
+                           (and (identical? source Long/TYPE) (identical? type Integer/TYPE))
+                           (and (identical? source Float/TYPE) (identical? type Double/TYPE))))
           names (get {Byte/TYPE '[byteCast uncheckedByteCast] Short/TYPE '[shortCast uncheckedShortCast]
                       Integer/TYPE '[intCast uncheckedIntCast] Long/TYPE '[longCast uncheckedLongCast]
                       Float/TYPE '[floatCast uncheckedFloatCast] Double/TYPE '[doubleCast uncheckedDoubleCast]} type)]
-      (if names
+      (if (and names (not direct?))
         {:op :numeric :args [(:value rhs)] :parameters [Object] :return type :conversion (:conversion rhs)
-         :operation {:op :static :class clojure.lang.RT :member (nth names (if *unchecked-math* 1 0)) :tags [Object]}}
+         :operation {:op :static :class clojure.lang.RT
+                     :member (nth names (if *unchecked-math* 1 0)) :tags [Object]}}
         rhs)) rhs))
 
 (np/defpass rhs {:from [l/Machine Rhs] :to [l/Numeric Rhs] :body true}
diff --git a/test/com/tailrecursion/blacktide/numeric_test.clj b/test/com/tailrecursion/blacktide/numeric_test.clj
index c95756a..1b5c9bb 100644
--- a/test/com/tailrecursion/blacktide/numeric_test.clj
+++ b/test/com/tailrecursion/blacktide/numeric_test.clj
@@ -184,6 +184,9 @@
                        '[IEEE-remainder atan2 pow hypot copy-sign next-after scalb
                          add-exact subtract-exact multiply-exact floor-div floor-mod])
                   '[(Math/abs x) (Math/getExponent x) (Math/round x)
+                    (Math/sin (long x)) (Float/sum (double x) (double y))
+                    (Long/sum (int x) (int y)) (Short/compare (byte x) (byte y))
+                    (Double/sum (int x) (float y)) (Byte/compare (long x) (long y))
                     (String/valueOf x) (Character/isDigit x) (Boolean/logicalAnd x y)])
           kind '[long double identity]
           unchecked [false true]
@@ -208,6 +211,14 @@
       (let [reference #(reduce + 0.0 %)]
         (is (= (outcome reference xs) (outcome (backend/compile-program form mode) (double-array xs))))))))
 
+(deftest primitive-java-widening-stays-unboxed
+  (let [program (backend/compacted '(let [n (long (first events))] (loophole [] (Math/sin n))))
+        casts (filter #(and (map? %) (= :host (:op %)) (= 'doubleCast (:member (:operation %))))
+                      (tree-seq coll? seq (:body program)))]
+    (is (= 1 (count casts)))
+    (is (= [Long/TYPE] (:tags (:operation (first casts)))))
+    (is (= Long/TYPE (:type (:jvm (first (:args (first casts)))))))))
+
 (deftest selected-origins-and-primitive-emission
   (doseq [form '[(loophole [x 0] (dotimes [i 10] (setq x (max x i))) x)
                  (loophole [x (double 0)] (dotimes [i 10] (setq x (max x (double i)))) x)]]