git » blacktide.git » master » tree

(ns ^:typed.clojure com.tailrecursion.blacktide.compiler.passes.numeric
  "Recognize numeric runtime calls and freeze their original signatures.
  Value inference and representation selection consult the same semantic rules;
  calls without a proof retain their original overload and operand facts."
  (:require [com.tailrecursion.nanopass :as np]
            [com.tailrecursion.blacktide.compiler.languages :as l]
            [com.tailrecursion.blacktide.compiler.jvm :as jvm]
            [com.tailrecursion.blacktide.compiler.passes.value-facts :as facts]
            [com.tailrecursion.blacktide.compiler.passes.numeric-rules :as rules]
            [typed.clojure :as-alias t]))

(np/defpass conversion-call {:from [l/Machine Rhs] :to [l/Numeric Rhs] :body true}
  [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 (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]}}
        rhs)) rhs))

(np/defpass rhs {:from [l/Machine Rhs] :to [l/Numeric Rhs] :body true}
  [rhs]
  (if (and (= :host (:op rhs)) (= :static (:op (:operation rhs)))
           (rules/family (:operation rhs)))
    (let [operation (:operation rhs)
          method (jvm/select-method (mapv #(:type (:jvm %)) (:args rhs)) (:tags operation)
                                    (jvm/methods (:class operation) (count (:args rhs)) true (:member operation)))]
      (if method (assoc rhs :op :numeric :parameters (jvm/parameters method) :return (jvm/return-type method)) rhs))
    (conversion-call rhs)))

(np/defpass operation {:from [l/Machine Operation] :to [l/Numeric Operation] :body true}
  [operation] (assoc operation :value (rhs (:value operation))))

(np/defpass block {:from [l/Machine Block] :to [l/Numeric Block] :body true}
  [block] (update block :ops #(mapv operation %)))

(np/defpass program {:from [l/Machine Program] :to [l/Numeric Program] :body true}
  [program] (update program :blocks update-vals block))

(np/defpass source-call {:from [l/Numeric Rhs] :to [l/Machine Rhs] :body true}
  [rhs]
  (if (= :numeric (:op rhs))
    (if-let [conversion (:conversion rhs)]
      {:op :convert :conversion conversion :value (nth (:args rhs) 0)}
      (assoc (dissoc rhs :parameters :return) :op :host)) rhs))

(np/defpass plan
  {:from [l/Numeric Rhs] :to (t/Option l/Numeric-Plan) :args [l/Analysis-Types] :body true}
  [types rhs]
  (when (= :numeric (:op rhs))
    (let [arguments (mapv (fn [arg]
                            (let [type (facts/atom-type types (:value arg))]
                              ;; Outside value inference, an absent storage fact
                              ;; means boxed, not the solver's unknown bottom.
                              (if (= :bottom type) :boxed type))) (:args rhs))]
      ;; JVM numeric parameter conversion casts to Number before calling RT.
      ;; An unknown input (including Character) must retain that check.
      (when (or (nil? (:conversion rhs)) (every? rules/number-type arguments))
        (rules/plan arguments (:parameters rhs) (:return rhs) (:operation rhs))))))

(np/defpass origin-values
  {:from [l/Numeric Rhs] :to (t/Vec l/Machine-Atom) :args [l/Numeric-Plan] :body true}
  [plan rhs]
  (if (= :numeric (:op rhs)) (mapv #(:value (nth (:args rhs) %)) (:origins plan)) []))

(np/defpass applicable?
  {:from [l/Numeric Rhs] :to t/Bool :args [l/Represented-Types t/Sym l/Numeric-Plan] :body true}
  [types target plan rhs]
  ;; A boxed result may alias an input only if that input keeps its box.
  (or (contains? types target)
      (every? #(not (class? (facts/atom-type types %))) (origin-values plan rhs))))