(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.passes.numeric-rules
"Numeric equivalences depend on the original overload as well as value types.
Plans preserve checked arithmetic, promotion, zero checks and reference returns.
JVM primitive widths remain distinct; only arithmetic promotes their values."
(:require [com.tailrecursion.nanopass :as np]
[com.tailrecursion.blacktide.compiler.languages :as l]
[typed.clojure :as-alias t]))
(np/defpass family {:from [l/JVM Operation] :to (t/Option t/Kw) :body true}
[operation]
(when (= :static (:op operation))
(let [owner (:class operation) member (:member operation)]
(cond
(identical? owner clojure.lang.Numbers)
(case member
(add multiply inc dec abs unchecked_add unchecked_multiply unchecked_inc unchecked_dec) :arithmetic
(minus unchecked_minus) :subtract
(addP multiplyP incP decP minusP) :promoting
divide :divide
(quotient remainder) :quotient
(min max) :select
(lt lte gt gte equiv isZero isPos isNeg) :predicate
compare :compare
(not and or xor andNot clearBit setBit flipBit testBit shiftLeft shiftRight unsignedShiftRight) :bit
nil)
(identical? owner clojure.lang.Util) (case member equiv :equality compare :compare nil)
(identical? owner clojure.lang.RT)
(case member
(byteCast shortCast intCast longCast floatCast doubleCast charCast
uncheckedByteCast uncheckedShortCast uncheckedIntCast uncheckedLongCast
uncheckedFloatCast uncheckedDoubleCast uncheckedCharCast) :cast
nil)))))
(np/defpass number-type {:from [l/Numeric ValueType] :to (t/Option java.lang.Class) :body true}
[type]
(cond (contains? #{Byte/TYPE Short/TYPE Integer/TYPE Long/TYPE} type) Long/TYPE
(contains? #{Float/TYPE Double/TYPE} type) Double/TYPE))
(np/defpass plan
{:from [l/JVM Operation] :to (t/Option l/Numeric-Plan)
:args [l/Numeric-ArgumentTypes (t/Vec java.lang.Class) java.lang.Class] :body true}
[types parameters result operation]
(when (= :static (:op operation))
(let [family (family operation) member (:member operation)
numbers (mapv number-type types)
numeric? (every? some? numbers)
tags (into [] (keep identity) numbers)
ints? (and numeric? (every? #{Long/TYPE} tags))
objects? (boolean (some #(not (.isPrimitive ^Class %)) parameters))
generic? (and objects? (not (some #(= Double/TYPE %) parameters)))
arithmetic-result (if (some #(= Double/TYPE %) tags) (or Double/TYPE result) (or (first tags) result))
direct {:recipe :call :parameters tags :result arithmetic-result :origins []}]
(case family
:arithmetic (when numeric? direct)
:subtract (when numeric?
(if (and generic? (= 2 (count tags))) (assoc direct :recipe :negate-add) direct))
:promoting (when numeric?
(cond-> (assoc direct :result (if ints? Number arithmetic-result))
(and generic? (= 'minusP member) (= 2 (count tags)))
(assoc :recipe :promoting-negate-add)))
:predicate (when numeric? (assoc direct :result result))
:compare (when numeric? (assoc direct :recipe :compare :result result))
:bit (when ints? (assoc direct :result result))
:quotient (when numeric?
(cond-> direct (and objects? ints?) (assoc :recipe :zero-guard)))
:divide (if numeric?
(cond ints? (assoc direct :result Number)
generic? (assoc direct :recipe :divide
:origins (into [] (keep-indexed #(when (= Double/TYPE %2) %1)) numbers)
;; A Float NaN is returned unchanged, while
;; ordinary floating division yields Double.
:result (if (some #(= Float/TYPE %) types) Number arithmetic-result))
:else direct)
;; These overloads delegate to Object/Object division. An
;; integer cannot be the NaN reference returned unchanged.
(when (and generic? (= 2 (count types)) (some #{Long/TYPE} types)
(every? #{:boxed Long/TYPE} types))
(assoc direct :parameters (mapv #(if (= Long/TYPE %) (or Long/TYPE Long) Object) types)
:result Number :origins (into [] (keep-indexed #(when (= :boxed %2) %1)) types))))
:select (when (and numeric? (apply = types))
(if objects?
(assoc direct :recipe :select :result (or (first (filter class? types)) result) :origins [0 1])
direct))
:equality (when (or ints? (and numeric? (some #(= Double/TYPE %) parameters)))
;; Object/Object equality observes NaN aliasing. Mixed integer/
;; floating equality also differs from numeric equivalence.
(when (apply = tags) (assoc direct :result result)))
:cast (when (and (= 1 (count types)) (or numeric? (= Character/TYPE (first types))))
(let [type (first types)
actual (vec (filter class? types))
direct (assoc direct :parameters actual :result result)]
(if-not objects? (assoc direct :parameters parameters)
(cond
(and (not numeric?) (not (contains? '#{charCast intCast longCast uncheckedCharCast uncheckedIntCast} member))) nil
(and (= Character/TYPE type) (= 'longCast member))
(assoc direct :recipe :widen-char)
(and (not ints?) numeric? (= 'intCast member)) (assoc direct :recipe :narrow-int)
(and (not ints?) numeric? (= 'uncheckedCharCast member)) (assoc direct :recipe :narrow-char)
(and (not ints?) numeric? (contains? '#{byteCast shortCast charCast} member))
(assoc direct :recipe :narrow-checked)
;; Object floatCast first converts to double (except Float).
;; Object longCast converts floating inputs through double.
(or (and (= 'floatCast member) (not= Float/TYPE type))
(and (= 'longCast member) (not ints?) numeric?))
(assoc direct :parameters (if-let [double-type Double/TYPE] [double-type] []))
:else direct))))
nil))))