Hint-directed fast arithmetic: fl*/fx* from ^double/^long (round 1)

A ^double/^long param hint (or a float literal) now drives Chez flonum/fixnum
ops instead of generic arithmetic — JVM-style primitive hints, available in every
build and at -e (not gated on direct-linking or whole-program inference).

New pass jolt.passes.numeric: a local forward type-flow seeded from ^double/^long
fn-param hints (analyzer attaches :nhints per arity) and float literals,
propagated through let inits / arithmetic / if / do. It tags an arithmetic invoke
:num-kind :double|:long when every operand is that kind (an integer literal is a
wildcard, coerced to a flonum in a double op). The back end lowers a tagged node
to fl+/fl-/fl*/fl//fl<?/... or fx+/fx*/fx1+/fxquotient/... (unchecked-add etc.
join the fixnum path; == too). Runs last in run-passes, both branches.

Soundness: :long is seeded ONLY from an explicit ^long hint, never a bare integer
literal, so un-hinted integer code keeps jolt's arbitrary-precision numbers — no
fixnum-overflow surprise, no corpus divergence. :double comes from ^double hints
and float literals (flonum arithmetic is always flonum, matching the generic
result). A ^long hint is a promise the value is a fixnum: fx+ raises on overflow,
like a JVM fixed-width long.

Numeric-hinted params coerce at fn entry (exact->inexact / jolt->fx), the way the
JVM coerces a primitive parameter — so the body's fl*/fx* ops can rely on the
type even when a caller passes an exact int (e.g. Chez's (* 0 1.0) => exact 0).

Round 1 specializes hinted straight-line / fn-body arithmetic. fl-ops are ~4x
generic in a tight Chez loop, but realizing that on loop-carried accumulators
needs loop-var typing — round 2. Sound foundation, gated by test/chez/numeric-test.ss.

Makefile

@@ -4,7 +4,7 @@
 # build step. `make test` is the full gate. `make remint` rebuilds the seed after a
 # source change.
 
-.PHONY: test ci values corpus unit smoke buildsmoke selfhost sci certify ffi transient infer directlink remint
+.PHONY: test ci values corpus unit smoke buildsmoke selfhost sci certify ffi transient infer directlink numeric remint
 
 # Full gate (dev machine). Includes the self-host byte-fixpoint, which only holds
 # on the same Chez that minted the seed.
@@ -15,7 +15,7 @@ test: selfhost ci
 # lockfile) — it RUNS correctly on any Chez, but `selfhost` rebuilds it and a
 # different Chez version may emit byte-different (gensym/order) output, so the
 # byte-fixpoint is a dev-machine check, not a CI one (jolt-8479).
-ci: values corpus unit smoke buildsmoke sci ffi transient infer directlink certify
+ci: values corpus unit smoke buildsmoke sci ffi transient infer directlink numeric certify
 	@echo "OK: CI gates passed"
 
 # Self-host fixpoint: bootstrap.ss rebuild == checked-in seed.
@@ -67,6 +67,11 @@ infer:
 directlink:
 	@chez --script test/chez/directlink-test.ss
 
+# Hint-directed fast arithmetic: ^double/^long param hints (and float literals)
+# lower arithmetic to Chez fl*/fx* ops; un-hinted integer code stays generic.
+numeric:
+	@chez --script test/chez/numeric-test.ss
+
 # JVM oracle: certify the corpus against reference Clojure. Skips if clojure absent.
 certify:
 	@if command -v clojure >/dev/null 2>&1; then \

host/chez/emit-image.ss

@@ -96,6 +96,7 @@
         (cons "jolt.analyzer" "jolt-core/jolt/analyzer.clj")
         (cons "jolt.backend-scheme" "jolt-core/jolt/backend_scheme.clj")
         (cons "jolt.passes.fold" "jolt-core/jolt/passes/fold.clj")
+        (cons "jolt.passes.numeric" "jolt-core/jolt/passes/numeric.clj")
         (cons "jolt.passes.inline" "jolt-core/jolt/passes/inline.clj")
         (cons "jolt.passes.types.lattice" "jolt-core/jolt/passes/types/lattice.clj")
         (cons "jolt.passes.types" "jolt-core/jolt/passes/types.clj")

host/chez/rt.ss

@@ -17,6 +17,17 @@
 ;; --- rt arithmetic / logic shims (named in the emitter's native-ops) ----------
 (define (jolt-inc x) (+ x 1))
 (define (jolt-dec x) (- x 1))
+;; Coerce a ^long-hinted argument to a fixnum at fn entry, the way the JVM's
+;; longCast coerces a primitive-long parameter: truncate a flonum toward zero,
+;; pass an exact integer through, error if it doesn't fit a fixnum or isn't a
+;; number. The hint is a promise the value is a fixnum-range long; the body's fx*
+;; ops rely on it. (^double params coerce with the built-in exact->inexact.)
+(define (jolt->fx x)
+  (let ((n (cond ((fixnum? x) x)
+                 ((flonum? x) (exact (truncate x)))
+                 ((rational? x) (exact (truncate x)))
+                 (else (error 'jolt "^long hint: not a number" x)))))
+    (if (fixnum? n) n (error 'jolt "^long hint: value out of fixnum range" x))))
 ;; jolt `not`: only nil and false are falsey.
 (define (jolt-not x) (if (jolt-truthy? x) #f #t))
 

jolt-core/jolt/analyzer.clj

@@ -80,6 +80,15 @@
   (let [m (form-sym-meta sym)]
     (when m (let [t (get m :tag)] (when t (record-ctor-key ctx t))))))
 
+;; A primitive numeric hint (^long / ^double) on a binding symbol -> :long /
+;; :double, else nil. Drives the fl*/fx* fast path (jolt.passes.numeric). The tag
+;; is a string on the data reader; tolerate a symbol from macroexpansion too.
+(defn- nhint-of [ctx sym]
+  (let [m (form-sym-meta sym)
+        t (when m (get m :tag))
+        s (cond (form-sym? t) (form-sym-name t) (string? t) t :else nil)]
+    (cond (= s "double") :double (= s "long") :long :else nil)))
+
 (defn- analyze-seq [ctx forms env]
   (let [v (mapv #(analyze ctx % env) forms)
         n (count v)]
@@ -104,19 +113,20 @@
   ;; folds it with a plain reduce — no reduce-over-map in the kernel subset).
   ;; :phints is the parallel vector of [name ctor-key] for record param hints,
   ;; carrying the specific type for the inference to seed.
-  (loop [i 0 fixed [] rest-name nil hints [] phints []]
+  (loop [i 0 fixed [] rest-name nil hints [] phints [] nhints []]
     (if (< i (count pvec))
       (let [p (nth pvec i)]
         (when-not (form-sym? p) (uncompilable "destructuring fn param"))
         (if (= "&" (form-sym-name p))
           (let [r (nth pvec (inc i))]
             (when-not (form-sym? r) (uncompilable "destructuring fn rest"))
-            (recur (+ i 2) fixed (form-sym-name r) hints phints))
+            (recur (+ i 2) fixed (form-sym-name r) hints phints nhints))
-          (let [nm (form-sym-name p) h (hint-of ctx p) ph (phint-of ctx p)]
+          (let [nm (form-sym-name p) h (hint-of ctx p) ph (phint-of ctx p) nh (nhint-of ctx p)]
             (recur (inc i) (conj fixed nm) rest-name
                    (if h (conj hints [nm h]) hints)
-                   (if ph (conj phints [nm ph]) phints)))))
+                   (if ph (conj phints [nm ph]) phints)
-      {:fixed fixed :rest rest-name :hints hints :phints phints})))
+                   (if nh (conj nhints [nm nh]) nhints)))))
+      {:fixed fixed :rest rest-name :hints hints :phints phints :nhints nhints})))
 
 ;; Clojure lets a later param shadow an earlier same-named one (a macro expander
 ;; uses _ for both its &form and &env slots, so its param list is (_ _ …)); the
@@ -154,7 +164,9 @@
                :body (analyze-seq ctx body env*)}
         ;; carry record param hints (name -> ctor-key) for the inference to seed
         ;; the param type; only when present so a hintless arity stays a struct.
-        arity (if (seq (:phints pp)) (assoc arity :phints (:phints pp)) arity)]
+        arity (if (seq (:phints pp)) (assoc arity :phints (:phints pp)) arity)
+        ;; numeric param hints (name -> :long/:double) for jolt.passes.numeric.
+        arity (if (seq (:nhints pp)) (assoc arity :nhints (:nhints pp)) arity)]
     ;; :rest only when variadic — an absent :rest reads back nil, same as before,
     ;; but keeps a fixed arity a nil-free struct rather than a phm.
     (if rst (assoc arity :rest rst) arity)))

jolt-core/jolt/backend_scheme.clj

@@ -76,6 +76,19 @@
     "jolt-even?" "jolt-odd?" "jolt-pos?" "jolt-neg?"
     "jolt-zero?" "jolt-empty?" "jolt-contains?"})
 
+;; Numeric-specialized op strings. jolt.passes.numeric tags an arithmetic invoke
+;; :num-kind :double|:long when every operand is that kind; these are the Chez
+;; flonum/fixnum ops it lowers to — no generic dispatch, fixnums unboxed. fl?/fx?
+;; comparisons carry the question mark; fl+/fx+ don't.
+(def ^:private dbl-ops
+  {"+" "fl+" "-" "fl-" "*" "fl*" "/" "fl/" "min" "flmin" "max" "flmax"
+   "<" "fl<?" ">" "fl>?" "<=" "fl<=?" ">=" "fl>=?" "=" "fl=?" "==" "fl=?"})
+(def ^:private lng-ops
+  {"+" "fx+" "-" "fx-" "*" "fx*" "min" "fxmin" "max" "fxmax"
+   "unchecked-add" "fx+" "unchecked-subtract" "fx-" "unchecked-multiply" "fx*"
+   "quot" "fxquotient" "rem" "fxremainder" "mod" "fxmodulo"
+   "<" "fx<?" ">" "fx>?" "<=" "fx<=?" ">=" "fx>=?" "=" "fx=?" "==" "fx=?"})
+
 ;; PRELUDE MODE. The default (subset) mode rejects any clojure.core ref
 ;; that isn't a native-op — a clean "out of subset" signal for user-facing `-e`.
 ;; When emitting clojure.core ITSELF as a prelude, core fns reference each other
@@ -335,8 +348,21 @@
 ;; let lets fn-level `recur` rebind this arity's params. A variadic arity takes a
 ;; Scheme rest arg coerced to a jolt seq (nil when empty); recur carries the rest
 ;; seq directly, and the named let's init only runs on first entry.
+;; Coerce a numeric-hinted param at fn entry, the way the JVM coerces a primitive
+;; parameter: ^double -> exact->inexact, ^long -> jolt->fx. Only the named-let init
+;; (first entry) coerces — recur carries already-typed values, like a JVM goto. This
+;; is what makes the hint a contract the body's fl*/fx* ops can rely on. `orig` is
+;; the param's source name (the :nhints key); `munged` the emitted identifier.
+(defn- nhint-init [nh orig munged]
+  (let [k (get nh orig)]
+    (cond (= k :double) (str "(exact->inexact " munged ")")
+          (= k :long)   (str "(jolt->fx " munged ")")
+          :else munged)))
+
 (defn- emit-arity-clause [a]
-  (let [params (map munge-name (:params a))
+  (let [orig (:params a)
+        nh (into {} (:nhints a))
+        params (map munge-name orig)
         restp (when-let [r (:rest a)] (munge-name r))
         label (fresh-label "fnrec")
         body (binding [*recur-target* label] (emit (:body a)))
@@ -344,10 +370,10 @@
                     (and restp (empty? params)) restp
                     restp (str "(" (str/join " " params) " . " restp ")")
                     :else (str "(" (str/join " " params) ")"))
+        pbind (map (fn [o p] (str "(" p " " (nhint-init nh o p) ")")) orig params)
         binds (if restp
-                (concat (map (fn [p] (str "(" p " " p ")")) params)
+                (concat pbind [(str "(" restp " (list->cseq " restp "))")])
-                        [(str "(" restp " (list->cseq " restp "))")])
+                pbind)]
-                (map (fn [p] (str "(" p " " p ")")) params))]
     [paramlist (str "(let " label " (" (str/join " " binds) ") " body ")")]))
 
 (defn- emit-fn [node]
@@ -394,6 +420,19 @@
 (defn- stdlib-var? [n]
   (and (= :var (:op n)) (str/starts-with? (or (:ns n) "") "clojure.")))
 
+;; Emit a :num-kind-tagged arithmetic call as a Chez flonum/fixnum op. inc/dec are
+;; unary (fl +/- 1.0, fx1+/fx1-); the rest map through dbl-ops/lng-ops. Integer
+;; literal operands of a :double op were coerced to flonums by jolt.passes.numeric.
+(defn- emit-numeric [kind nm args order-args]
+  (cond
+    (and (= kind :double) (= nm "inc")) (str "(fl+ " (first args) " 1.0)")
+    (and (= kind :double) (= nm "dec")) (str "(fl- " (first args) " 1.0)")
+    (and (= kind :long) (or (= nm "inc") (= nm "unchecked-inc"))) (str "(fx1+ " (first args) ")")
+    (and (= kind :long) (or (= nm "dec") (= nm "unchecked-dec"))) (str "(fx1- " (first args) ")")
+    :else
+    (let [op (if (= kind :double) (dbl-ops nm) (lng-ops nm))]
+      (order-args (fn [as] (str "(" op " " (str/join " " as) ")"))))))
+
 (defn- emit-invoke [node]
   (let [fnode (:fn node)
         arg-nodes (:args node)
@@ -410,6 +449,9 @@
                                (fn [[f & as]]
                                  (str "(jolt-invoke " f (if (seq as) (str " " (str/join " " as)) "") ")"))))]
     (cond
+      ;; hint-directed fast arithmetic: jolt.passes.numeric proved every operand a
+      ;; flonum (^double) or fixnum (^long), so emit the Chez fl*/fx* op.
+      (:num-kind node) (emit-numeric (:num-kind node) (:name fnode) args order-args)
       ;; zero-arg + / * : exact integer identity (= JVM long: (+) -> 0, (*) -> 1).
       (and nop (empty? args) (= nop "+")) "0"
       (and nop (empty? args) (= nop "*")) "1"

jolt-core/jolt/passes.clj

@@ -15,6 +15,7 @@
   Portable Clojure: kernel-tier fns + seed primitives only."
   (:require [jolt.host :refer [inline-enabled? record-shapes]]
             [jolt.passes.fold :refer [const-fold]]
+            [jolt.passes.numeric :as numeric]
             [jolt.passes.inline :refer [inline-node flatten-lets scalar-replace dirty set-rec-shapes!]]
             [jolt.passes.types :refer [run-inference
                                        check-form infer-body reinfer-def phint-seed
@@ -34,8 +35,12 @@
   inlining exposes map literals to lookups, scalar-replace collapses them, which
   may expose more — then a collection-type inference pass (optionally
   also emitting success diagnostics) that auto-drops the lookup guard where the
-  type is proven. Otherwise (core + bootstrap) just const-fold, as before."
+  type is proven. Otherwise (core + bootstrap) just const-fold, as before.
+
+  numeric/annotate runs last in both branches (hint-directed fl*/fx* arithmetic);
+  it benefits open builds too, so it is not gated on inlining."
   [node ctx]
+  (numeric/annotate
     (if (inline-enabled? ctx)
       (let [_ (set-rec-shapes! (record-shapes ctx))   ;; record ctor fold
             ;; resolve ^Record param hints (incl. defrecord/extend-type method
@@ -51,4 +56,4 @@
         ;; a final const-fold after inference propagates any predicate folded to a
         ;; constant, collapsing the `if` it gates to the taken branch.
         (const-fold (run-inference opt)))
-    (const-fold node)))
+      (const-fold node))))

jolt-core/jolt/passes/numeric.clj

@@ -0,0 +1,141 @@
+(ns jolt.passes.numeric
+  "Hint-directed numeric specialization. A local forward type-flow that seeds
+  local kinds from `^double`/`^long` fn-param hints and float literals, propagates
+  them through let inits, arithmetic results, and if/do, and tags an arithmetic
+  `:invoke` node with `:num-kind :double` or `:long` when every operand is that
+  kind (an integer literal is a wildcard, valid in either). The back end then emits
+  Chez `fl*`/`fx*` ops instead of generic arithmetic.
+
+  Soundness: `:long` is seeded ONLY from an explicit `^long` hint — never a bare
+  integer literal — so un-hinted integer code keeps jolt's arbitrary-precision
+  numbers (no fixnum overflow surprise). `:double` is seeded from `^double` hints
+  and float literals; flonum arithmetic is always flonum, so this matches the
+  generic result. A `^long` hint is a promise the value is a fixnum: `fx+` raises
+  on overflow rather than promoting, exactly as a JVM primitive long is fixed-width.
+
+  Runs in every build and at `-e`/repl, but not the seed mint (which compiles with
+  the passes off), so it stays out of the self-host fixpoint and benefits open and
+  closed builds alike."
+  (:require [jolt.ir :refer [map-ir-children]]))
+
+;; --- operand classification -------------------------------------------------
+(defn- int-lit? [n]
+  (and (= :const (get n :op))
+       (let [v (get n :val)] (and (number? v) (integer? v)))))
+(defn- float-lit? [n]
+  (and (= :const (get n :op))
+       (let [v (get n :val)] (and (number? v) (float? v)))))
+
+;; result kind of a double-specialized op at this name/arity, or nil if N/A.
+;; arithmetic -> :double; comparison -> :bool (operands specialized, result not numeric).
+(defn- dbl-spec [nm n]
+  (cond
+    (and (>= n 1) (contains? #{"+" "-" "*" "/" "min" "max"} nm)) :double
+    (and (= n 1) (contains? #{"inc" "dec"} nm)) :double
+    (and (>= n 2) (contains? #{"<" ">" "<=" ">=" "=" "=="} nm)) :bool
+    :else nil))
+
+;; result kind of a long-specialized op, or nil. `/` is absent on purpose:
+;; (/ long long) is a Ratio in Clojure, not a long. unchecked-* join the fast path
+;; (they aren't native ops otherwise).
+(defn- lng-spec [nm n]
+  (cond
+    (and (>= n 1) (contains? #{"+" "-" "*" "min" "max"
+                               "unchecked-add" "unchecked-subtract" "unchecked-multiply"} nm)) :long
+    (and (= n 1) (contains? #{"inc" "dec" "unchecked-inc" "unchecked-dec"} nm)) :long
+    (and (= n 2) (contains? #{"quot" "rem" "mod"} nm)) :long
+    (and (>= n 2) (contains? #{"<" ">" "<=" ">=" "=" "=="} nm)) :bool
+    :else nil))
+
+;; A non-numeric result (a comparison) doesn't propagate a numeric kind.
+(defn- propagate [spec] (if (= spec :bool) nil spec))
+
+(declare an)
+
+;; Seed a fn arity's local env from its numeric param hints; an unhinted param
+;; shadows any same-named outer local to nil.
+(defn- arity-env [tenv a]
+  (let [nh (into {} (get a :nhints))
+        pe (reduce (fn [e p] (assoc e p (get nh p))) tenv (get a :params))]
+    (if (get a :rest) (assoc pe (get a :rest) nil) pe)))
+
+(defn- an-invoke [node tenv]
+  (let [fnode (get node :fn)
+        nm (when (and (= :var (get fnode :op)) (= "clojure.core" (get fnode :ns)))
+             (get fnode :name))
+        ars (mapv (fn [a] (an a tenv)) (get node :args))
+        argnodes (mapv (fn [r] (nth r 1)) ars)
+        node1 (assoc node :args argnodes)
+        n (count ars)]
+    (if (nil? nm)
+      [nil node1]
+      (let [;; per-operand class: :double / :long (typed), :wild (integer literal,
+            ;; usable in either), or :no (anything else — blocks specialization).
+            cls (mapv (fn [r] (let [k (nth r 0) nd (nth r 1)]
+                                (cond (= k :double) :double
+                                      (= k :long) :long
+                                      (int-lit? nd) :wild
+                                      :else :no)))
+                      ars)
+            ok? (fn [allowed need]
+                  (and (pos? n)
+                       (every? (fn [c] (or (= c :wild) (= c allowed))) cls)
+                       (some (fn [c] (= c need)) cls)))
+            ds (dbl-spec nm n)
+            ls (lng-spec nm n)]
+        (cond
+          (and ds (ok? :double :double))
+          ;; coerce integer-literal operands to flonum so fl-ops never see an exact int.
+          (let [args' (mapv (fn [nd] (if (int-lit? nd) (assoc nd :val (double (get nd :val))) nd))
+                            argnodes)]
+            [(propagate ds) (assoc node1 :args args' :num-kind :double)])
+          (and ls (ok? :long :long))
+          [(propagate ls) (assoc node1 :num-kind :long)]
+          :else [nil node1])))))
+
+;; Returns [kind node'] — kind is :double, :long, or nil.
+(defn- an [node tenv]
+  (let [op (get node :op)]
+    (cond
+      (= op :const) [(if (float-lit? node) :double nil) node]
+      (= op :local) [(get tenv (get node :name)) node]
+      (= op :invoke) (an-invoke node tenv)
+      (= op :let)
+      (let [res (reduce (fn [acc b]
+                          (let [te (nth acc 0) binds (nth acc 1)
+                                ir (an (nth b 1) te)]
+                            [(assoc te (nth b 0) (nth ir 0)) (conj binds [(nth b 0) (nth ir 1)])]))
+                        [tenv []] (get node :bindings))
+            br (an (get node :body) (nth res 0))]
+        [(nth br 0) (assoc node :bindings (nth res 1) :body (nth br 1))])
+      (= op :loop)
+      ;; loop vars join across recur, untracked here, so they stay untyped; still
+      ;; descend to specialize any non-loop arithmetic in the inits/body.
+      [nil (assoc node
+                  :bindings (mapv (fn [b] [(nth b 0) (nth (an (nth b 1) tenv) 1)]) (get node :bindings))
+                  :body (nth (an (get node :body) tenv) 1))]
+      (= op :if)
+      (let [tr (an (get node :test) tenv)
+            thn (an (get node :then) tenv)
+            els (an (get node :else) tenv)
+            tk (nth thn 0) ek (nth els 0)]
+        [(if (= tk ek) tk nil)
+         (assoc node :test (nth tr 1) :then (nth thn 1) :else (nth els 1))])
+      (= op :do)
+      (let [stmts (mapv (fn [s] (nth (an s tenv) 1)) (get node :statements))
+            r (an (get node :ret) tenv)]
+        [(nth r 0) (assoc node :statements stmts :ret (nth r 1))])
+      (= op :fn)
+      [nil (assoc node :arities
+                  (mapv (fn [a] (assoc a :body (nth (an (get a :body) (arity-env tenv a)) 1)))
+                        (get node :arities)))]
+      (= op :def) [nil (assoc node :init (nth (an (get node :init) tenv) 1))]
+      ;; every other op introduces no bindings and isn't numeric: descend with the
+      ;; same env to specialize nested arithmetic, no kind.
+      :else [nil (map-ir-children (fn [c] (nth (an c tenv) 1)) node)])))
+
+(defn annotate
+  "Tag arithmetic nodes with :num-kind from local numeric type-flow. Returns the
+  rewritten IR (no kind escapes to the caller)."
+  [node]
+  (nth (an node {}) 1))

test/chez/numeric-test.ss

@@ -0,0 +1,84 @@
+;; Hint-directed fast arithmetic (jolt.passes.numeric). A ^double/^long param hint
+;; (or a float literal) drives Chez fl*/fx* emission instead of generic arithmetic;
+;; un-hinted integer code stays generic (arbitrary-precision preserved). The pass
+;; runs in run-passes with optimization OFF, so this is the open-build path. Run:
+;;   chez --script test/chez/numeric-test.ss
+
+(import (chezscheme))
+(load "host/chez/rt.ss")
+(set-chez-ns! "clojure.core")
+(load "host/chez/seed/prelude.ss")
+(load "host/chez/post-prelude.ss")
+(set-chez-ns! "user")
+(load "host/chez/host-contract.ss")
+(load "host/chez/seed/image.ss")
+(load "host/chez/compile-eval.ss")
+
+(define total 0) (define fails 0)
+(define (ok name pred) (set! total (+ total 1)) (unless pred (set! fails (+ fails 1)) (printf "FAIL: ~a\n" name)))
+
+(define (has? s sub)
+  (let ((ns (string-length s)) (nsub (string-length sub)))
+    (let loop ((i 0))
+      (cond ((> (+ i nsub) ns) #f)
+            ((string=? (substring s i (+ i nsub)) sub) #t)
+            (else (loop (+ i 1)))))))
+
+;; analyze + run-passes (optimization OFF — the always-on numeric pass still runs)
+;; + emit one form to a Scheme string.
+(define (emitf ns str)
+  (let-values (((f j) (rdr-read-form str 0 (string-length str))))
+    (let ((ctx (make-analyze-ctx ns)))
+      (jolt-ce-emit (jolt-ce-run-passes (jolt-ce-analyze ctx f) ctx)))))
+
+;; --- emission: ^double -> fl-ops, ^long -> fx-ops ---
+(let ((e (emitf "u" "(fn* ([^double a ^double b] (+ (* a a) (* b b))))")))
+  (ok "double + lowers to fl+" (has? e "(fl+"))
+  (ok "double * lowers to fl*" (has? e "(fl*"))
+  (ok "double arith is NOT generic +" (not (has? e "(jolt-invoke"))))
+
+(ok "long + lowers to fx+"        (has? (emitf "u" "(fn* ([^long a ^long b] (+ a b)))") "(fx+"))
+(ok "long * lowers to fx*"        (has? (emitf "u" "(fn* ([^long a ^long b] (* a b)))") "(fx*"))
+(ok "double < lowers to fl<?"     (has? (emitf "u" "(fn* ([^double x] (< x 1.0)))") "(fl<?"))
+(ok "long < lowers to fx<?"       (has? (emitf "u" "(fn* ([^long a ^long b] (< a b)))") "(fx<?"))
+(ok "long inc lowers to fx1+"     (has? (emitf "u" "(fn* ([^long n] (inc n)))") "(fx1+"))
+(ok "double inc lowers to fl+ 1.0" (has? (emitf "u" "(fn* ([^double x] (inc x)))") "(fl+"))
+(ok "long dec lowers to fx1-"     (has? (emitf "u" "(fn* ([^long n] (dec n)))") "(fx1-"))
+(ok "unchecked-add lowers to fx+" (has? (emitf "u" "(fn* ([^long n] (unchecked-add n 1)))") "(fx+"))
+(ok "long quot lowers to fxquotient" (has? (emitf "u" "(fn* ([^long a ^long b] (quot a b)))") "(fxquotient"))
+(ok "double == lowers to fl=?"    (has? (emitf "u" "(fn* ([^double a ^double b] (== a b)))") "(fl=?"))
+
+;; integer literal in a double op is coerced to a flonum (fl+ never sees an exact int)
+(let ((e (emitf "u" "(fn* ([^double x] (+ x 1)))")))
+  (ok "double op with int literal coerces it to 1.0" (and (has? e "(fl+") (has? e "1.0"))))
+
+;; let init kind propagates: d is double from (* x x)
+(let ((e (emitf "u" "(fn* ([^double x] (let [d (* x x)] (+ d 1.0))))")))
+  (ok "let-bound double propagates (fl* then fl+)" (and (has? e "(fl*") (has? e "(fl+"))))
+
+;; --- soundness: un-hinted / integer-literal code stays generic ---
+(let ((e (emitf "u" "(fn* ([a b] (+ a b)))")))
+  (ok "un-hinted + stays generic (no fl/fx)" (and (not (has? e "(fl+")) (not (has? e "(fx+")))))
+(let ((e (emitf "u" "(+ 1 2)")))
+  (ok "bare integer literals stay generic (arbitrary precision)" (not (has? e "(fx+"))))
+;; a constant float op like (+ 1.0 2.0) is const-folded to 3.0 (no op at all); a
+;; float-literal-bound local is double-typed and its body op isn't foldable (a
+;; local operand), so numeric specializes it.
+(ok "float-literal-bound local specializes to fl+"
+    (has? (emitf "u" "(fn* ([] (let [a 2.0] (+ a 3.0))))") "(fl+"))
+;; (/ ^long ^long) is a Ratio in Clojure, not a long -> must NOT lower to a fixnum op
+(let ((e (emitf "u" "(fn* ([^long a ^long b] (/ a b)))")))
+  (ok "long division is NOT specialized (stays generic /)" (not (has? e "(fx"))))
+
+;; --- runtime values match the generic result ---
+(define (ev s) (jolt-compile-eval s "u"))
+(ok "double dot: 3^2+4^2 = 25" (= 25 (jnum->exact (ev "((fn* ([^double a ^double b] (+ (* a a) (* b b)))) 3.0 4.0)"))))
+(ok "long sum: 2+3 = 5"        (= 5  (jnum->exact (ev "((fn* ([^long a ^long b] (+ a b))) 2 3)"))))
+(ok "double compare true"      (jolt-truthy? (ev "((fn* ([^double x] (< x 5.0))) 3.0)")))
+(ok "double unary negate"      (= -5 (jnum->exact (ev "((fn* ([^double x] (- x))) 5.0)"))))
+(ok "long unary negate"        (= -5 (jnum->exact (ev "((fn* ([^long a] (- a))) 5)"))))
+(ok "long quot 7/2 = 3"        (= 3  (jnum->exact (ev "((fn* ([^long a ^long b] (quot a b))) 7 2)"))))
+(ok "double + int literal = 4.5" (= 9 (jnum->exact (ev "((fn* ([^double x] (* (+ x 1) 2))) 3.5)"))))
+
+(printf "~a/~a passed~n" (- total fails) total)
+(exit (if (zero? fails) 0 1))