simon/jolt
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge pull request #178 from jolt-lang/spike/direct-linking

Browse source 
Direct-linking builds + hint-directed fast arithmetic
This commit is contained in:
Dmitri Sotnikov 2026-06-23 20:53:24 +00:00 • committed by GitHub
commit eab18e363c
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
14 changed files with 848 additions and 242 deletions
Download patch file Download diff file Expand all files Collapse all files

15
Makefile
View file

@ -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 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 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.
@ -61,6 +61,17 @@ transient:
infer:
@chez --script host/chez/run-infer.ss
# Direct-linking emission: a closed-world build binds top-level app defs to jv$
# Scheme bindings and routes app->app calls/refs to them, skipping var-deref +
# jolt-invoke; ^:dynamic/^:redef and nested defs opt out.
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 \

8
docs/tools-deps.md
View file

@ -96,6 +96,14 @@ a C compiler; `JOLT_CHEZ_CSV` overrides the auto-detected `csv<ver>/<machine>`
dir. `--opt` turns on the inference/flatten/scalar-replace passes; the default
`release` mode is const-fold only.
`--direct-link` (or `:jolt/build {:direct-link true}`) opts into a closed world: a
call between the app's own functions binds to its target directly, skipping the var
lookup and generic dispatch a runtime call pays — at the cost of runtime
redefinition of those vars and `eval`/`load-string`. It's off by default, so
ordinary builds (including `release` and `--opt`) stay dynamically linked. A var
marked `^:redef` or `^:dynamic` stays indirect even under `--direct-link`, and calls
into `clojure.core` stay indirect in every mode.
## Limitations
- Pure `clj`/`cljc` only — JVM interop, host classes, and unimplemented

17
host/chez/build-smoke.sh
View file

@ -63,4 +63,19 @@ if [ "$got_opt" != "$want" ]; then
echo "--- got ----"; echo "$got_opt"
exit 1
fi
echo "build smoke: passed (release + optimized)"
# Closed-world direct-linking (opt-in): same result, and the cross-namespace call
# (app.core -> app.util/shout) must lower to a direct jv$ binding, not var-deref.
if ! JOLT_PWD="$app" bin/joltc build -m app.core -o "$out" --direct-link >/dev/null 2>&1; then
echo " FAIL: jolt build --direct-link exited non-zero"; exit 1
fi
got_dl="$(cd / && "$out" alpha bb ccc 2>&1)"
if [ "$got_dl" != "$want" ]; then
echo " FAIL: --direct-link binary output mismatch"
echo "--- got ----"; echo "$got_dl"
exit 1
fi
if ! grep -q '(jv\$app.util\$shout' "$out.build/flat.ss"; then
echo " FAIL: --direct-link did not emit a direct app->app call"; exit 1
fi
echo "build smoke: passed (release + optimized + direct-link)"

20
host/chez/build.ss
View file

@ -211,7 +211,10 @@
;; natives: encoded :jolt/native libs to load at startup. embed-dirs: dirs whose
;; files bake into the binary (single-file). ext-roots: project-relative io/resource
;; roots resolved at runtime against JOLT_PWD (ship-alongside resources).
(define (build-binary entry-ns out-path mode natives embed-dirs ext-roots)
;; direct-link?: opt-in closed-world direct-linking (app->app calls bind directly,
;; no runtime redefinition). Off by default in every mode — release stays
;; dynamically linked.
(define (build-binary entry-ns out-path mode natives embed-dirs ext-roots direct-link?)
(bld-check-toolchain)
;; 1. record app namespaces in dependency order as they finish loading.
(let ((app-order '()))
@ -224,12 +227,21 @@
(error 'jolt-build (string-append "no source namespace loaded for " entry-ns
" — is it on the source roots?")))
;; 2. emit each app namespace. `optimized` turns on the inference + flatten
;; + scalar-replace passes (closed world); release/dev get const-fold only.
;; + scalar-replace passes; release/dev get const-fold only.
;; direct-link? (opt-in) commits to a closed world: app->app calls bind
;; directly, giving up runtime redefinition of those vars. Off by default in
;; every mode. The defined-set accumulates across the dependency-ordered
;; namespaces, so a dep's defs are direct-linkable by the time the entry that
;; calls them is emitted.
(set-optimize! (string=? mode "optimized"))
(when direct-link?
((var-deref "jolt.backend-scheme" "set-direct-link!") #t)
((var-deref "jolt.backend-scheme" "direct-link-reset!")))
(let* ((app-strs (apply append
(map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf))))
ordered)))
(_ (set-optimize! #f))
(_ ((var-deref "jolt.backend-scheme" "set-direct-link!") #f))
(builddir (string-append out-path ".build"))
(flat-ss (string-append builddir "/flat.ss"))
(flat-so (string-append builddir "/flat.so"))
@ -317,9 +329,9 @@
(display (string-append "jolt build: wrote " out-path "\n"))))))
(def-var! "jolt.host" "build-binary"
(lambda (entry out mode natives embed-dirs ext-roots)
(lambda (entry out mode natives embed-dirs ext-roots direct-link?)
(build-binary (jolt-str-render-one entry)
(jolt-str-render-one out)
(jolt-str-render-one mode)
natives embed-dirs ext-roots)
natives embed-dirs ext-roots (jolt-truthy? direct-link?))
jolt-nil))

8
host/chez/emit-image.ss
View file

@ -37,10 +37,13 @@
;; (mark-macro! ns name) so the on-Chez analyzer can expand it.
;; Analyze -> (optionally run passes) -> emit one form. optimize? runs
;; jolt.passes/run-passes (build optimizes; the seed minter stays un-optimized so
;; the self-host fixpoint is independent of the passes).
;; the self-host fixpoint is independent of the passes). emit-top-form is the
;; top-level entry: in direct-link mode it binds jv$<fqn> for a top-level def; off
;; that mode (the minter, runtime eval) it is exactly emit, so output is unchanged.
(define jolt-ce-emit-top (var-deref "jolt.backend-scheme" "emit-top-form"))
(define (ei-compile-form ctx f optimize?)
(let ((ir (jolt-ce-analyze ctx f)))
(jolt-ce-emit (if optimize? (jolt-ce-run-passes ir ctx) ir))))
(jolt-ce-emit-top (if optimize? (jolt-ce-run-passes ir ctx) ir))))
;; The emitted `(def-var! …)(mark-macro! …)` pair for a defmacro, guard-wrapped
;; (tolerant) or bare (strict) to match guard?.
@ -93,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")

11
host/chez/rt.ss
View file

@ -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))

452
host/chez/seed/image.ss
View file

File diff suppressed because one or more lines are too long

24
jolt-core/jolt/analyzer.clj
View file

@ -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))
(let [nm (form-sym-name p) h (hint-of ctx p) ph (phint-of ctx p)]
(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) 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)))))
{:fixed fixed :rest rest-name :hints hints :phints phints})))
(if ph (conj phints [nm ph]) 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)))

112
jolt-core/jolt/backend_scheme.clj
View file

@ -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
@ -83,6 +96,31 @@
(def prelude-mode? (atom false))
(defn set-prelude-mode! [on] (reset! prelude-mode? on))
;; DIRECT-LINK MODE. Off for ordinary runs, the seed mint, and `-e`/repl/load-string
;; (open world — vars are redefinable). `jolt build` (release/optimized) flips it on
;; during app emission: a closed-world program where every app def is final, so an
;; app->app call binds to the def's Scheme binding directly, skipping the var-table
;; lookup and the generic jolt-invoke dispatch.
(def direct-link? (atom false))
(defn set-direct-link! [on] (reset! direct-link? on))
;; Fully-qualified app var names ("ns/name") already emitted with a direct-link
;; binding in the current unit. A call/value-ref direct-links only to a name in this
;; set — one defined earlier in emission order (or itself), so the Scheme binding
;; exists by the time the reference runs. Reset per build.
(def direct-link-defined (atom #{}))
(defn direct-link-reset! [] (reset! direct-link-defined #{}))
;; A direct-link Scheme binding name for a var. The fqn maps to a unique identifier
;; jv$<ns>$<name>; chars that break a Scheme identifier or the `$` separator are
;; escaped so distinct vars never collide.
(defn- dl-munge [s]
(-> s (str/replace "$" "_D_") (str/replace "#" "_H_") (str/replace "'" "_Q_")))
(defn- dl-name [ns nm] (str "jv$" (dl-munge ns) "$" (dl-munge nm)))
(defn- dl-fqn [ns nm] (str ns "/" nm))
(defn- direct-linkable? [ns nm]
(and @direct-link? (contains? @direct-link-defined (dl-fqn ns nm))))
;; recur-target and the set of munged local names known to hold a procedure (a
;; named fn's self-recursion name) are lexically scoped — dynamic vars so the
;; recursion auto-restores them (no manual save/restore, no throw-leak).
@ -310,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)))
@ -319,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)
[(str "(" restp " (list->cseq " restp "))")])
(map (fn [p] (str "(" p " " p ")")) params))]
(concat pbind [(str "(" restp " (list->cseq " restp "))")])
pbind)]
[paramlist (str "(let " label " (" (str/join " " binds) ") " body ")")]))
(defn- emit-fn [node]
@ -369,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)
@ -385,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"
@ -412,6 +479,11 @@
;; a :local callee that isn't a known procedure -> dynamic IFn dispatch.
(and (= :local (:op fnode)) (not (*known-procs* (munge-name (:name fnode)))))
(invoke)
;; closed-world direct call: the callee var is an app def already emitted with
;; a Scheme binding — call it directly, no var lookup, no jolt-invoke.
(and (= :var (:op fnode)) (direct-linkable? (:ns fnode) (:name fnode)))
(order-args (fn [as] (str "(" (dl-name (:ns fnode) (:name fnode))
(if (seq as) (str " " (str/join " " as)) "") ")")))
;; a late-bound :var call head can hold a procedure OR a non-applicable
;; value the RT dispatches (multimethod, keyword/coll IFn) — route via
;; jolt-invoke (transparent for a procedure).
@ -453,6 +525,9 @@
:var (let [core-proc (and (= "clojure.core" (:ns node)) (core-value-procs (:name node)))]
(cond
core-proc core-proc
;; direct-linked app var used as a value -> reference its binding (same
;; root as the var cell for a final var; helps DCE keep it live).
(direct-linkable? (:ns node) (:name node)) (dl-name (:ns node) (:name node))
(and (stdlib-var? node) (not (deref prelude-mode?)))
(throw (ex-info (str "emit: unsupported stdlib ref `" (:ns node) "/" (:name node)
"` (no core on Chez yet)") {}))
@ -527,3 +602,32 @@
(str "(def-var! " (chez-str-lit (:ns node)) " " (chez-str-lit (:name node)) " "
(emit (:init node)) ")"))
(throw (ex-info (str "emit: op not yet ported / unhandled: " (pr-str (:op node))) {}))))
;; ^:dynamic / ^:redef on a def opts it out of direct-linking: it stays redefinable,
;; so callers must go through the var cell. m is a def's :meta (a jolt map value).
(defn- dl-opt-out? [m] (or (get m :dynamic) (get m :redef)))
;; Per-form entry used by the image/build emitter. In direct-link mode a TOP-LEVEL
;; def (form root, or spliced from a top-level do) without an opt-out also binds
;; jv$<fqn> and aliases the var cell to it, so app->app calls/refs bind directly.
;; Off direct-link mode this is exactly `emit`, so the seed mint and runtime eval are
;; byte-unchanged. Nested defs (a defonce's inner def) never reach a top-level branch
;; here, so they stay indirect — a `define` would be illegal in their position.
(defn emit-top-form [node]
(cond
(not @direct-link?) (emit node)
;; top-level do splices: each statement/ret is itself a top-level form.
(= :do (:op node))
(str "(begin " (str/join " " (map emit-top-form (:statements node)))
(if (empty? (:statements node)) "" " ") (emit-top-form (:ret node)) ")")
(and (= :def (:op node)) (not (:no-init node)) (not (dl-opt-out? (:meta node))))
(let [ns (:ns node) nm (:name node) b (dl-name ns nm)]
;; register before emitting the init so a self-referential body direct-links.
(swap! direct-link-defined conj (dl-fqn ns nm))
(let [init (emit (:init node))]
(if (jmeta-nonempty? (:meta node))
(str "(begin (define " b " " init ") (def-var-with-meta! "
(chez-str-lit ns) " " (chez-str-lit nm) " " b " " (emit-quoted (:meta node)) "))")
(str "(begin (define " b " " init ") (def-var! "
(chez-str-lit ns) " " (chez-str-lit nm) " " b "))"))))
:else (emit node)))

20
jolt-core/jolt/main.clj
View file

@ -115,10 +115,13 @@
(map? task) (do (apply-project! resolved) (apply-main-opts (:main-opts task) more))
:else (throw (ex-info (str "bad task " name) {})))))
;; build [-m NS | FILE] [-o OUT] [--opt | --dev] — AOT-compile the app into a
;; standalone executable. Resolves deps + roots like `run`, then hands the entry
;; namespace to the host build driver (jolt.host/build-binary, defined by
;; build [-m NS | FILE] [-o OUT] [--opt | --dev] [--direct-link] — AOT-compile the
;; app into a standalone executable. Resolves deps + roots like `run`, then hands the
;; entry namespace to the host build driver (jolt.host/build-binary, defined by
;; build.ss). Default mode is release; --opt selects optimized, --dev unoptimized.
;; --direct-link (or deps.edn :jolt/build {:direct-link true}) opts into closed-world
;; direct-linking: app->app calls bind directly, giving up runtime redefinition of
;; those vars and eval/load-string. Off by default — release stays dynamically linked.
;; Encode a deps.edn :jolt/native spec for the build launcher, resolving the
;; current platform's candidate list now (the binary runs on this OS). Each entry
;; becomes a vector the launcher (build.ss) reads: ["process"] for the running
@ -133,7 +136,7 @@
(into [(if (:optional spec) "opt" "req")] cands)))))))
(defn- cmd-build [more]
(let [{:keys [project-paths embed-dirs] :as resolved}
(let [{:keys [project-paths embed-dirs build] :as resolved}
(deps/resolve-project (project-dir))]
(apply-project! resolved)
(let [opts (loop [a more, entry nil, out nil]
@ -164,10 +167,13 @@
(nil? o) (str pdir "/target/" (if (= mode "dev") "debug" "release") "/" proj)
(str/starts-with? o "/") o
:else (str pdir "/" o)))
natives (encode-natives (:natives resolved))]
natives (encode-natives (:natives resolved))
;; closed-world direct-linking is opt-in: the --direct-link flag or a
;; deps.edn :jolt/build {:direct-link true}. Off otherwise.
direct-link? (boolean (or (some #{"--direct-link"} more) (:direct-link build)))]
;; embed-dirs (absolute) are walked + baked into the binary by the driver;
;; project-paths (relative) become runtime io/resource roots (ship-alongside).
(jolt.host/build-binary entry out mode natives embed-dirs project-paths)))))
(jolt.host/build-binary entry out mode natives embed-dirs project-paths direct-link?)))))
(defn- nrepl [more]
;; resolve the project (deps on the roots, native libs loaded), then start the
@ -185,7 +191,7 @@
(println "usage: jolt <command> [args]")
(println " run -m NS [args] resolve deps.edn, load NS, call its -main")
(println " run FILE load a Clojure file")
(println " build -m NS [-o OUT] [--opt|--dev] compile a standalone binary")
(println " build -m NS [-o OUT] [--opt|--dev] [--direct-link] compile a standalone binary")
(println " -M:alias [args] run the alias's :main-opts")
(println " -A:alias [args] add the alias's paths/deps")
(println " repl start a line REPL")

39
jolt-core/jolt/passes.clj
View file

@ -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,21 +35,25 @@
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]
(if (inline-enabled? ctx)
(let [_ (set-rec-shapes! (record-shapes ctx)) ;; record ctor fold
;; resolve ^Record param hints (incl. defrecord/extend-type method
;; `this`) to bare field reads per-form, not only under whole-program.
;; Same shapes the inline pass uses.
_ (set-record-shapes! (record-shapes ctx))
opt (loop [i 0 n (const-fold node)]
(reset! dirty false)
(let [n2 (const-fold (scalar-replace (flatten-lets (inline-node n ctx))))]
(if (and @dirty (< i inline-fixpoint-cap))
(recur (inc i) n2)
n2)))]
;; 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)))
(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
;; `this`) to bare field reads per-form, not only under whole-program.
;; Same shapes the inline pass uses.
_ (set-record-shapes! (record-shapes ctx))
opt (loop [i 0 n (const-fold node)]
(reset! dirty false)
(let [n2 (const-fold (scalar-replace (flatten-lets (inline-node n ctx))))]
(if (and @dirty (< i inline-fixpoint-cap))
(recur (inc i) n2)
n2)))]
;; 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))))

178
jolt-core/jolt/passes/numeric.clj Normal file
View file

@ -0,0 +1,178 @@
(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)
;; The recur-arg kinds for the recurs targeting THIS loop level. recur only appears
;; in tail position (an if branch, a do's ret, a let body), so descend only those;
;; a nested loop/fn (and any non-tail child) owns its own recur and is skipped.
(defn- recur-kinds [node tenv]
(let [op (get node :op)]
(cond
(= op :recur) [(mapv (fn [a] (nth (an a tenv) 0)) (get node :args))]
(= op :let) (recur-kinds (get node :body)
(reduce (fn [te b] (assoc te (nth b 0) (nth (an (nth b 1) te) 0)))
tenv (get node :bindings)))
(= op :if) (concat (recur-kinds (get node :then) tenv) (recur-kinds (get node :else) tenv))
(= op :do) (recur-kinds (get node :ret) tenv)
:else [])))
;; Loop-var kinds by bounded fixpoint. A var is :double only if its init is double
;; AND every recur arg in that slot is double (under the current assumption) — a
;; monotone demotion that stops at a fixpoint, bounded by the var count. Integers
;; stay untyped (no :long from a bare init literal, so a bignum-producing loop keeps
;; arbitrary precision). A :double loop var's init and recur args are all flonums,
;; so no entry coercion is needed (unlike a fn param fed an arbitrary argument).
(defn- loop-kinds [names ik body tenv]
(loop [cur (mapv (fn [k] (if (= k :double) :double nil)) ik) iter 0]
(if (> iter (count names))
cur
(let [te (reduce (fn [t i] (assoc t (nth names i) (nth cur i))) tenv (range (count names)))
rks (recur-kinds body te)
nxt (mapv (fn [j]
(if (and (= (nth cur j) :double)
(every? (fn [rk] (= :double (nth rk j))) rks))
:double nil))
(range (count names)))]
(if (= nxt cur) cur (recur nxt (inc iter)))))))
;; 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)
;; inits evaluate in the OUTER env; loop vars get their fixpoint kinds for the body.
(let [binds (get node :bindings)
names (mapv (fn [b] (nth b 0)) binds)
ik (mapv (fn [b] (nth (an (nth b 1) tenv) 0)) binds)
lk (loop-kinds names ik (get node :body) tenv)
te (reduce (fn [t i] (assoc t (nth names i) (nth lk i))) tenv (range (count names)))]
[nil (assoc node
:bindings (mapv (fn [b] [(nth b 0) (nth (an (nth b 1) tenv) 1)]) binds)
:body (nth (an (get node :body) te) 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))

89
test/chez/directlink-test.ss Normal file
View file

@ -0,0 +1,89 @@
;; Direct-linking emission (jolt build, closed world). With direct-link on, a
;; top-level app def emits a Scheme binding jv$<ns>$<name> aliased to its var cell,
;; and an app->app call/value-ref binds to it directly instead of going through
;; (jolt-invoke (var-deref ...)). ^:dynamic/^:redef defs and nested defs opt out.
;; Off direct-link mode the emission is byte-identical to plain `emit`. Run:
;; chez --script test/chez/directlink-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")
(load "host/chez/emit-image.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 set-direct-link! (var-deref "jolt.backend-scheme" "set-direct-link!"))
(define direct-link-reset! (var-deref "jolt.backend-scheme" "direct-link-reset!"))
(define (contains? 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+emit one form (string) in a namespace through the real build entry
;; (ei-compile-form -> emit-top-form), no optimization passes.
(define (emit-form ns-name str)
(let-values (((f j) (rdr-read-form str 0 (string-length str))))
(ei-compile-form (make-analyze-ctx ns-name) f #f)))
;; Register var cells so resolve-global classifies references as :var (the build
;; loads the namespaces before re-emitting; here we eval the defs with direct-link
;; off first). Use fn* so no macro expansion is involved.
(set-direct-link! #f)
(jolt-compile-eval "(def a (fn* ([] 1)))" "app")
(jolt-compile-eval "(def b (fn* ([] (a))))" "app")
(jolt-compile-eval "(def hof (fn* ([] a)))" "app")
(jolt-compile-eval "(def ^:dynamic d 5)" "app")
(jolt-compile-eval "(def usesd (fn* ([] (d))))" "app")
;; --- direct-link OFF: every reference stays indirect (var-deref) ---
(let ((eb (emit-form "app" "(def b (fn* ([] (a))))")))
(ok "off: call to a routes through jolt-invoke + var-deref"
(and (contains? eb "(jolt-invoke") (contains? eb "(var-deref \"app\" \"a\")")))
(ok "off: no jv$ direct call" (not (contains? eb "(jv$app$a)")))
(ok "off: def emits plain def-var! (no jv$ binding)"
(and (contains? (emit-form "app" "(def a (fn* ([] 1)))") "(def-var! \"app\" \"a\"")
(not (contains? (emit-form "app" "(def a (fn* ([] 1)))") "(define jv$app$a")))))
;; --- direct-link ON ---
(set-direct-link! #t)
(direct-link-reset!)
(let ((ea (emit-form "app" "(def a (fn* ([] 1)))"))) ; registers app/a in the set
(ok "on: a's def emits a jv$ binding aliased to its var cell"
(and (contains? ea "(begin (define jv$app$a ")
(contains? ea "(def-var! \"app\" \"a\" jv$app$a)"))))
(let ((eb (emit-form "app" "(def b (fn* ([] (a))))")))
(ok "on: b's call to a is a direct (jv$app$a) call" (contains? eb "(jv$app$a)"))
(ok "on: b's call to a is NOT var-deref'd" (not (contains? eb "(var-deref \"app\" \"a\")")))
(ok "on: b's call to a is NOT jolt-invoke'd" (not (contains? eb "(jolt-invoke"))))
(let ((eh (emit-form "app" "(def hof (fn* ([] a)))")))
(ok "on: a used as a value references the binding directly" (contains? eh " jv$app$a)"))
(ok "on: value-ref to a is NOT var-deref'd" (not (contains? eh "(var-deref \"app\" \"a\")"))))
;; ^:dynamic opts out: no jv$ binding, callers stay indirect.
(let ((ed (emit-form "app" "(def ^:dynamic d 5)")))
(ok "on: ^:dynamic def gets no jv$ binding" (not (contains? ed "(define jv$app$d"))))
(let ((eu (emit-form "app" "(def usesd (fn* ([] (d))))")))
(ok "on: call to a ^:dynamic var stays indirect" (contains? eu "(var-deref \"app\" \"d\")"))
(ok "on: ^:dynamic var not direct-linked" (not (contains? eu "(jv$app$d)"))))
;; A var only defined LATER in emission order is not yet in the set -> indirect.
(direct-link-reset!)
(let ((efwd (emit-form "app" "(def caller (fn* ([] (a))))"))) ; a not (re)emitted since reset
(ok "on: forward/undefined ref stays indirect" (contains? efwd "(var-deref \"app\" \"a\")")))
(set-direct-link! #f)
(printf "~a/~a passed~n" (- total fails) total)
(exit (if (zero? fails) 0 1))

97
test/chez/numeric-test.ss Normal file
View file

@ -0,0 +1,97 @@
;; 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+"))))
;; --- loop-carried variable typing (round 2) ---
;; a double accumulator types via fixpoint, so its recur arithmetic is fl-ops.
(let ((e (emitf "u" "(fn* ([] (loop [acc 0.0 i 0] (if (< i 5) (recur (+ acc 1.5) (inc i)) acc))))")))
(ok "loop double accumulator lowers (+ acc 1.5) to fl+" (has? e "(fl+")))
;; an integer accumulator stays generic — a bignum-producing loop keeps arbitrary
;; precision (no fx* overflow).
(let ((e (emitf "u" "(fn* ([] (loop [acc 1 i 1] (if (< i 25) (recur (* acc i) (inc i)) acc))))")))
(ok "loop integer accumulator is NOT fx-specialized" (not (has? e "(fx*"))))
;; --- 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)"))))
(ok "loop double accumulator: 10*1.5 = 15"
(= 15 (jnum->exact (ev "((fn* ([] (loop [acc 0.0 i 0] (if (< i 10) (recur (+ acc 1.5) (inc i)) acc)))))"))))
(ok "loop integer factorial stays exact (bignum preserved)"
(jolt-truthy? (ev "(< 1000000000000000000000 ((fn* ([] (loop [acc 1 i 1] (if (< i 25) (recur (* acc i) (inc i)) acc)))) ))")))
(printf "~a/~a passed~n" (- total fails) total)
(exit (if (zero? fails) 0 1))