(ns com.tailrecursion.blacktide.numeric-test
"Numeric value proofs, primitive lowering, and the observations that forbid it."
(:require [clojure.test :refer [deftest is]]
[clojure.math]
[clojure.test.check :as tc]
[clojure.test.check.generators :as gen]
[clojure.test.check.properties :as prop]
[com.tailrecursion.blacktide.backend-fixture :as backend]
[com.tailrecursion.blacktide.compiler.passes.compact :as compact]
[com.tailrecursion.blacktide.compiler.passes.storage :as storage]))
(def modes [:default :generic :dispatcher])
(deftest numeric-results-retain-observed-origins
(doseq [expression '[(min x x) (max x x) (/ x 1) (/ 1 x)] mode modes
initial [Double/NaN '(double Double/NaN)]]
(let [form (list 'loophole ['x initial 'y '(double 0)]
(list 'setq 'y expression) '(reset! events x) 'y)
f (backend/compile-program form mode) saved (atom nil) value (f saved)]
(is (identical? value @saved) (pr-str [mode initial expression])))))
(deftest accumulator-recurrence-is-primitive
(let [form '(loophole [sum 0]
(dotimes [i 10] (when (= i 5) (goto done)) (setq sum (+ sum i)))
(label done) sum)
program (backend/capture #'storage/select-storage form)
slots (storage/loop-slots (:body program))
code (backend/capture #'compact/program form)
adds (filter #(and (map? %) (= :host (:op %)) (= 'add (:member (:operation %))))
(tree-seq coll? seq (:body code)))]
(is (= 2 (count slots)))
(is (= (zipmap slots (repeat Long/TYPE)) (select-keys (:types program) slots)))
(is (= 1 (count adds)))
(is (= [Long/TYPE Long/TYPE] (:tags (:operation (first adds)))))
(is (every? #(= Long/TYPE (:type (:jvm %))) (:args (first adds))))
(doseq [mode modes] (is (= {:value 10 :trace []} (backend/execution form mode))))))
(def unary
'[+ * - / -' inc dec inc' dec' abs zero? pos? neg? bit-not
unchecked-negate unchecked-inc unchecked-dec unchecked-negate-int unchecked-inc-int unchecked-dec-int
byte short int long float double char unchecked-byte unchecked-short
unchecked-int unchecked-long unchecked-float unchecked-double unchecked-char
bigint biginteger bigdec rationalize numerator denominator
rational? integer? float? double? int? pos-int? neg-int? nat-int? decimal? ratio? number? even? odd?])
(def binary
'[+ - * / +' -' *' quot rem mod min max = == < <= > >=
unchecked-add unchecked-subtract unchecked-multiply unchecked-add-int unchecked-subtract-int
unchecked-multiply-int unchecked-divide-int unchecked-remainder-int compare
bit-and bit-or bit-xor bit-and-not bit-clear bit-set bit-flip bit-test
bit-shift-left bit-shift-right unsigned-bit-shift-right])
(def boundaries
{'long [Long/MIN_VALUE (inc Long/MIN_VALUE) -129 -1 0 1 63 127 128 65536
9007199254740993 4611686293305294849 Long/MAX_VALUE]
'byte [-128 -1 0 1 127]
'short [-32768 -129 -1 0 1 127 32767]
'int [Integer/MIN_VALUE -129 -1 0 1 127 128 Integer/MAX_VALUE]
'double [Double/NEGATIVE_INFINITY (- (double Long/MAX_VALUE)) -32768.9 -128.9 -1.0 -0.0 0.0 1.0
127.9 32767.9 65535.9 2147483647.9 4294967296.0 (double Long/MAX_VALUE)
Double/MAX_VALUE Double/POSITIVE_INFINITY Double/NaN]
'float [Float/NEGATIVE_INFINITY (- Float/MAX_VALUE) -128.9 -1 -0.0 0.0 1.0 127.9
2147483648.0 Float/MAX_VALUE Float/POSITIVE_INFINITY Float/NaN]
'char [0 1 127 255 65535]
'identity [nil true \a 1/2 1N 1M 1.00M 9223372036854775808N (biginteger 1)]})
(defn outcome [f input]
(try (let [value (f input)]
[(class value) (cond (instance? Double value) (Double/doubleToLongBits value)
(instance? Float value) (Float/floatToIntBits value)
(instance? BigDecimal value) (.toString ^BigDecimal value)
:else value)])
;; HotSpot may omit built-in exception messages after repeated failures.
(catch Throwable error [(class error)])))
(defn boxed [form]
(list (with-meta 'clojure.lang.RT/box {:param-tags [Object]}) form))
(defn compile-reference [bindings expression]
(backend/compile-program
(list 'let (vec (mapcat (fn [[id value]] [id (boxed value)]) (partition 2 bindings))) expression) :default))
(deftest numeric-surface
;; Compile each shape once, then exercise boundaries. The ordinary Clojure
;; oracle explicitly boxes its locals, matching mutable source-local reads.
;; Canonical NaN bits ignore payloads while still distinguishing signed zero.
(doseq [[left right] '[[long long] [double double] [long double] [double long]
[float float] [int int] [long int] [byte byte] [short short] [char char] [identity identity]]
expression (concat (map #(list % 'x) unary) (map #(list % 'x 'y) binary)
(map #(list % 'x 'y 'x) '[+ - * / +' -' *' min max < <= > >= = ==]))
:let [bindings ['x (list left '(nth events 0)) 'y (list right '(nth events 1))]
form (list 'loophole bindings expression)
reference (compile-reference bindings expression)
functions (mapv #(backend/compile-program form %) modes)
inputs (for [x (boundaries left)
y (if (= 2 (count expression)) [(first (boundaries right))] (boundaries right))] [x y])
mismatch (some (fn [input]
(let [expected (outcome reference input) actual (mapv #(outcome % input) functions)]
(when-not (every? #{expected} actual) [input expected actual]))) inputs)]]
(is (nil? mismatch) (pr-str [form mismatch]))))
(def expression-gen
(gen/recursive-gen
(fn [inner]
(gen/one-of [(gen/let [op (gen/elements '[+ - * / +' -' *' quot rem min max unchecked-add bit-xor])
a inner b inner] (list op a b))
(gen/let [a inner b inner] (list 'if '(even? i) a b))
(gen/let [a inner b inner] (list 'case '(mod i 3) 0 a b))]))
(gen/elements '[x i -1 0 1 2 0.5])))
(deftest generated-numeric-recurrences
(let [result (tc/quick-check
160
(prop/for-all [expression (gen/resize 8 expression-gen)
kind (gen/elements '[long double])
initial (gen/elements [-1 0 1 Long/MIN_VALUE Long/MAX_VALUE])
n (gen/choose 0 8)
unchecked gen/boolean]
(binding [*unchecked-math* unchecked]
(let [init (list kind initial)
form (list 'loophole ['x init]
(list 'dotimes ['i n] (list 'setq 'x expression)) 'x)
reference (list 'loop ['x (boxed init) 'i 0]
(list 'if (list '< 'i n)
(list 'recur (boxed expression) '(inc i)) 'x))
expected (outcome (backend/compile-program reference :default) nil)]
(every? #(= expected (outcome (backend/compile-program form %) nil)) modes))))
:seed 271828)]
(is (:pass? result) (pr-str result))))
(deftest unchecked-math-keeps-wrapping
(doseq [mode modes]
(binding [*unchecked-math* true]
(is (= {:value Long/MIN_VALUE :trace []}
(backend/execution '(loophole [x Long/MAX_VALUE] (setq x (+ x 1)) x) mode))))))
(deftest references-survive-numeric-computation
(doseq [mode modes
form '[(loophole [x 0 y nil]
(dotimes [i 2] (setq x (+ x 1000)))
(setq y x) [(identical? x y) (identical? x x)])
(loophole [x 0 y nil]
(dotimes [i 2] (psetq y x x (+ x 1000)))
[(identical? y y) (not (identical? x y))])
(loophole [x 0]
(dotimes [i 2] (setq x (+ x 1000)))
(let [saved x] (setq x (+ x 1)) [(identical? saved saved) (not (identical? saved x))]))]]
(is (= {:value [true true] :trace []} (backend/execution form mode)) (pr-str form)))
(doseq [mode modes]
(let [value (Long. 1000)
f (backend/compile-program '(loophole [x events]
(dotimes [i 0] (setq x (+ x i))) x) mode)]
(is (identical? value (f value)))))
(doseq [init '[nil 1.5 1/2 1N 1M] mode modes
:let [form (list 'loophole '[x 0]
(list 'dotimes '[i 2] (list 'setq 'x (list 'if '(zero? i) init '(+ x 1)))) 'x)]]
(is (= (backend/execution form :dispatcher) (backend/execution form mode)) (pr-str form))))
(deftest exceptions-stay-between-the-same-effects
(doseq [mode modes
form '[(loophole [x Long/MAX_VALUE]
[(do (swap! events conj :before) (setq x (+ x 1)))
(swap! events conj :after)])
(loophole [x Long/MAX_VALUE y 0]
(psetq y (do (swap! events conj :before) 7)
x (+ x 1) y (do (swap! events conj :after) 8)))]]
(is (= {:throw ArithmeticException :trace [:before]} (backend/execution form mode))))
(doseq [mode modes]
(is (= {:value 10 :trace [:first :second]}
(backend/execution '(loophole [x 0]
(+ (do (swap! events conj :first) (setq x (+ x 3)))
(do (swap! events conj :second) (setq x (+ x 4))))) mode)))))
(deftest selection-and-nan-identity
(doseq [mode modes
expression '[(= x x) (= (/ x 1) x) (identical? (/ x 1) x)
(identical? (min x y) x) (identical? (max x y) x)]
cast '[float double]
:let [form (list 'loophole ['x (list cast 'Double/NaN) 'y (list cast 1)] expression)]]
(is (= {:value true :trace []} (backend/execution form mode)) (pr-str [mode form])))
;; A numerical consumer permits selection lowering, including the tie rule.
(doseq [expression '[(double (min x y)) (double (max x y)) (double (/ x y))]
:let [form (list 'loophole '[x (double (first events)) y (double (second events))] expression)
functions (mapv #(backend/compile-program form %) modes)]
x [-0.0 0.0 Double/NaN] y [-0.0 0.0 Double/NaN]]
(is (apply = (map #(outcome % [x y]) functions)) (pr-str [expression x y]))))
(deftest math-and-java-conversions
(doseq [expression
(concat (map #(list (symbol "clojure.math" (name %)) 'x)
'[sin cos tan asin acos atan to-radians to-degrees exp log log10 sqrt cbrt ceil floor rint
round ulp signum sinh cosh tanh expm1 log1p get-exponent next-up next-down])
(map #(list (symbol "clojure.math" (name %)) 'x 'y)
'[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]
:let [bindings ['x (list kind '(first events)) 'y (list kind '(second events))]
form (list 'loophole bindings expression)
functions (binding [*unchecked-math* unchecked]
(into [(compile-reference bindings expression)]
(map #(backend/compile-program form %)) modes))]]
(doseq [input [[-0.0 0.0] [1 2] [Long/MAX_VALUE -1] [Double/MAX_VALUE 2]
[Double/NaN 0] [nil nil] [\a \b] [false true]]]
(is (apply = (map #(outcome % input) functions)) (pr-str [form unchecked input])))))
(deftest numeric-array-loop
(let [form '(let [^doubles xs events]
(loophole [sum 0.0 i 0]
(while (< i (alength xs))
(setq sum (+ sum (aget xs i)) i (inc i)))
(double sum)))
program (backend/capture #'storage/select-storage form)
slots (storage/loop-slots (:body program))]
(is (= #{Long/TYPE Double/TYPE} (set (vals (select-keys (:types program) slots)))))
(doseq [mode modes xs [[] [1.0] [1.0 2.0 3.0] [Double/NaN] [-0.0]]]
(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/capture #'compact/program '(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)]]
(let [program (backend/capture #'storage/select-storage form)
slots (storage/loop-slots (:body program))]
(is (every? (:types program) slots) (pr-str form))
(doseq [mode modes] (is (= 9.0 (double (:value (backend/execution form mode))))))))
(let [warnings (java.io.StringWriter.)]
(binding [*err* warnings *unchecked-math* :warn-on-boxed]
(backend/compile-program '(loophole [sum 0] (dotimes [i 10] (setq sum (+ sum i))) sum) :default))
(is (not (.contains (str warnings) "Boxed math warning")) (str warnings))))
(deftest mixed-division-preserves-boxes-without-boxing-the-counter
(doseq [[expression parameters reference]
[['(/ x n) [Object Long/TYPE] (fn [[x limit]] (loop [n 0] (if (< n limit) (recur (inc n)) (/ x n))))]
['(/ n x) [Long/TYPE Object] (fn [[x limit]] (loop [n 0] (if (< n limit) (recur (inc n)) (/ n x))))]]]
(let [form (list 'let '[x (first events) limit (long (second events))]
(list 'loophole '[n 0] '(while (< n limit) (setq n (inc n))) expression))
program (backend/capture #'storage/select-storage form)
slots (storage/loop-slots (:body program))
lowered (backend/capture #'compact/program form)
divisions (filter #(and (map? %) (= :host (:op %)) (= 'divide (:member (:operation %))))
(tree-seq coll? seq (:body lowered)))
functions (mapv #(backend/compile-program form %) modes)
nan (Double. (Double/longBitsToDouble 9221120237041090626))]
(is (= 1 (count slots)))
(is (= {Long/TYPE 1} (frequencies (vals (select-keys (:types program) slots)))))
(is (= [parameters] (mapv #(get-in % [:operation :tags]) divisions)))
(doseq [x [nil false 0 Long/MIN_VALUE 1/3 10000000000000000000000N 1.25M
-0.0 Double/POSITIVE_INFINITY (Float. Float/NaN) nan]
limit [0 1 150] f functions]
(is (= (outcome reference [x limit]) (outcome f [x limit])) (pr-str [expression x limit]))
(when (or (identical? nan x) (and (instance? Float x) (Float/isNaN x)))
(is (identical? x (f [x limit])) "NaN division returns the original reference, even before a zero check")))
(let [calls (atom [])
x (proxy [Number] []
(longValue [] (swap! calls conj :long) 2)
(intValue [] (swap! calls conj :int) 2)
(doubleValue [] (swap! calls conj :double) 2.0)
(floatValue [] (swap! calls conj :float) (float 2)))
observe (fn [f] (reset! calls []) [(outcome f [x 150]) @calls])]
(doseq [f functions] (is (= (observe reference) (observe f))))))))