Merge pull request #176 from jolt-lang/spike/foreign-callable

foreign-callable + standalone-binary bundling
This commit is contained in:
Dmitri Sotnikov 2026-06-23 17:24:07 +00:00 committed by GitHub
commit d9d55fd533
No known key found for this signature in database
GPG key ID: B5690EEEBB952194
17 changed files with 405 additions and 119 deletions

View file

@ -56,11 +56,41 @@ roots, and de-sugars the argv into a run:
- `-A:alias` → add the alias's paths/deps, then run the rest; - `-A:alias` → add the alias's paths/deps, then run the rest;
- `repl` → a line REPL; - `repl` → a line REPL;
- `path` → print the resolved roots; - `path` → print the resolved roots;
- `build -m NS [-o OUT] [--opt|--dev]` → AOT-compile the app into a standalone binary;
- `<task>` → run a `deps.edn` `:tasks` entry. - `<task>` → run a `deps.edn` `:tasks` entry.
The resolver lives in the overlay alongside the runtime, but the runtime's only The resolver lives in the overlay alongside the runtime, but the runtime's only
dependency interface is the list of source roots it's handed. dependency interface is the list of source roots it's handed.
## Native libraries
A library that binds C declares the shared objects it needs under `:jolt/native`,
so `jolt.main` loads them before the namespace is required and its `foreign-fn`
bindings resolve. Each entry is a map — `{:name "sqlite3" :darwin
["libsqlite3.0.dylib" …] :linux ["libsqlite3.so.0" …]}` — with optional
`:optional true` (absence is fine, a feature-gated dep) and `:process true` (use
the running process's own symbols, e.g. libc sockets, no external file). A
project inherits its dependencies' `:jolt/native`.
## Standalone binaries
`joltc build -m NS -o OUT` compiles the app and every library into one
executable (the runtime + compiler are baked in). It loads the resolved
`:jolt/native` libs at startup, so an FFI app — sockets, SQLite — runs with no
jolt or Chez on the path.
`:jolt/build {:embed ["resources" …]}` bakes those directories' files into the
binary; `io/resource` serves them from the image with no files on disk. Resources
not embedded resolve at runtime against `JOLT_PWD` (or the cwd), so the
ship-the-binary-with-its-`resources/`-dir model also works. Files read through
`io/file` (e.g. a `config.edn` a config library loads) stay external by design —
edit them without rebuilding.
A standalone build needs Chez's kernel dev files (`libkernel.a`, `scheme.h`) and
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.
## Limitations ## Limitations
- Pure `clj`/`cljc` only — JVM interop, host classes, and unimplemented - Pure `clj`/`cljc` only — JVM interop, host classes, and unimplemented

View file

@ -1,13 +0,0 @@
(ns ffi-smoke
(:require [jolt.ffi :as ffi]))
(ffi/load-library "libglib-2.0.dylib")
(prn :sizeof-pointer (ffi/sizeof :pointer))
(prn :null (ffi/null))
(prn :null? (ffi/null? (ffi/null)))
(ffi/defcfn g-get-monotonic-time "g_get_monotonic_time" [] :int64)
(prn :monotonic-time (g-get-monotonic-time))
(let [p (ffi/alloc 16)]
(ffi/write p :int64 0 42)
(prn :wrote-and-read (ffi/read p :int64 0))
(ffi/free p))
(prn :done)

View file

@ -36,9 +36,12 @@ if ! JOLT_PWD="$app" bin/joltc build -m app.core -o "$out" >/dev/null 2>&1; then
fi fi
[ -x "$out" ] || { echo " FAIL: no executable produced"; exit 1; } [ -x "$out" ] || { echo " FAIL: no executable produced"; exit 1; }
# Run from a neutral cwd with args; check the three output lines. # Run from a neutral cwd with args. The first line is an embedded resource
# (deps.edn :jolt/build :embed), proving io/resource resolves from the binary with
# no resources/ dir on disk; the rest exercise a macro, cross-ns, and args.
got="$(cd / && "$out" alpha bb ccc 2>&1)" got="$(cd / && "$out" alpha bb ccc 2>&1)"
want='HELLO FROM A BUILT BINARY! want='embedded resource ok
HELLO FROM A BUILT BINARY!
HELLO FROM A BUILT BINARY! HELLO FROM A BUILT BINARY!
args: [alpha bb ccc] args: [alpha bb ccc]
sum: 10' sum: 10'

View file

@ -146,12 +146,72 @@
;; The loop itself is emit-image's ei-emit-ns* (optimize? #t, guard? #f). ;; The loop itself is emit-image's ei-emit-ns* (optimize? #t, guard? #f).
(define (bld-emit-ns ns-name src) (ei-emit-ns* ns-name src #t #f)) (define (bld-emit-ns ns-name src) (ei-emit-ns* ns-name src #t #f))
;; --- bundling: native libs + resources --------------------------------------
;; A jolt seq of jolt strings -> a Scheme list of Scheme strings.
(define (bld-strs x) (map jolt-str-render-one (seq->list x)))
;; Emit native-library loads. `natives` is the encoded jolt seq jolt.main/
;; encode-natives produced: each entry is ["process"] | ["req" cand…] | ["opt" cand…].
;; `which` selects 'required (process + req) or 'optional. Required + process loads
;; are emitted before the app forms (the app's defcfn foreign-procedures resolve
;; their symbols at top-level eval during startup, so the libs must be loaded
;; first); a load-shared-object failure there is fatal — correct for a required
;; lib. Optional loads run in the scheme-start launcher, where guard catches a
;; missing lib (an optional lib's namespace is only present when the app requires
;; it, so its foreign-procedures aren't among the baked top-level forms).
(define (bld-emit-natives out natives which)
(for-each
(lambda (entry)
(let* ((parts (bld-strs entry)) (kind (car parts)) (cands (cdr parts))
(cand-lits (fold-left (lambda (s c) (string-append s (ei-str-lit c) " ")) "" cands)))
(cond
((and (eq? which 'required) (string=? kind "process"))
(put-string out "(jolt-build-load-native '() #f #t)\n"))
((and (eq? which 'required) (string=? kind "req"))
(put-string out (string-append "(jolt-build-load-native (list " cand-lits ") #f #f)\n")))
((and (eq? which 'optional) (string=? kind "opt"))
(put-string out (string-append "(jolt-build-load-native (list " cand-lits ") #t #f)\n"))))))
(seq->list natives)))
;; Walk an embed root recursively; return (resource-name . abspath) pairs, where
;; resource-name is the "/"-joined path under the root (what io/resource is asked for).
(define (bld-walk-files root rel acc)
(let ((dir (if (string=? rel "") root (string-append root "/" rel))))
(fold-left
(lambda (acc name)
(let* ((relpath (if (string=? rel "") name (string-append rel "/" name)))
(full (string-append root "/" relpath)))
(if (file-directory? full)
(bld-walk-files root relpath acc)
(cons (cons relpath full) acc))))
acc
(directory-list dir))))
;; Emit register-embedded-resource! per file under each embed dir. Emitted BEFORE
;; the app forms so the (read-file-string ABSPATH) runs at heap build — the file's
;; contents bake into the boot image and io/resource serves them with no file on
;; disk. ABSPATH only has to exist at build time.
(define (bld-emit-embeds out embed-dirs)
(for-each
(lambda (root)
(when (file-directory? root)
(for-each
(lambda (rp)
(put-string out (string-append
"(register-embedded-resource! " (ei-str-lit (car rp))
" (read-file-string " (ei-str-lit (cdr rp)) "))\n")))
(bld-walk-files root "" '()))))
(bld-strs embed-dirs)))
;; --- the build -------------------------------------------------------------- ;; --- the build --------------------------------------------------------------
;; entry-ns: the app's main namespace (a string). out-path: the binary to write. ;; entry-ns: the app's main namespace (a string). out-path: the binary to write.
;; mode: "dev" | "release" | "optimized". Every form runs through jolt.passes/ ;; mode: "dev" | "release" | "optimized". Every form runs through jolt.passes/
;; run-passes (const-fold always; inline + type inference when optimized turns on ;; run-passes (const-fold always; inline + type inference when optimized turns on
;; direct-linking). Deps + source roots are already applied by the caller. ;; direct-linking). Deps + source roots are already applied by the caller.
(define (build-binary entry-ns out-path mode) ;; 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)
(bld-check-toolchain) (bld-check-toolchain)
;; 1. record app namespaces in dependency order as they finish loading. ;; 1. record app namespaces in dependency order as they finish loading.
(let ((app-order '())) (let ((app-order '()))
@ -180,16 +240,40 @@
;; 3. flat source = runtime + app + launcher. ;; 3. flat source = runtime + app + launcher.
(let ((out (open-output-file flat-ss 'replace))) (let ((out (open-output-file flat-ss 'replace)))
(bld-emit-runtime out) (bld-emit-runtime out)
;; Load native libs, bake embedded resources, and point source roots at
;; the build-time app roots — all BEFORE the app forms. The app's
;; top-level forms run at binary startup (Sbuild_heap), and they include
;; foreign-procedure evals (a library's defcfn) and (slurp (io/resource …))
;; reads. So the libraries must be loaded and resources resolvable by the
;; time those forms run, not later in the scheme-start launcher.
(put-string out "\n;; === native libraries (required) ===\n")
(bld-emit-natives out natives 'required)
(put-string out "\n;; === embedded resources ===\n")
(bld-emit-embeds out embed-dirs)
(put-string out (string-append
"(set-source-roots! (list "
(fold-left (lambda (s r) (string-append s (ei-str-lit r) " ")) ""
(get-source-roots))
"))\n"))
(put-string out "\n;; === app ===\n") (put-string out "\n;; === app ===\n")
(for-each (lambda (s) (put-string out s) (put-string out "\n")) app-strs) (for-each (lambda (s) (put-string out s) (put-string out "\n")) app-strs)
;; The launcher runs as Chez's scheme-start (so argv reaches -main — ;; The launcher runs as Chez's scheme-start (so argv reaches -main —
;; top-level boot forms run during heap build, before args are set), and ;; top-level boot forms run during heap build, before args are set), and
;; suppresses the interactive greeting. ;; suppresses the interactive greeting. It resets source roots to the
;; app's resource dirs resolved against JOLT_PWD (or cwd) so a runtime
;; io/resource that wasn't embedded still resolves next to the binary.
(put-string out "\n;; === launcher ===\n") (put-string out "\n;; === launcher ===\n")
(put-string out "(suppress-greeting #t)\n")
(put-string out "(scheme-start\n (lambda args\n")
(bld-emit-natives out natives 'optional)
(put-string out (string-append
" (let ((base (or (getenv \"JOLT_PWD\") \".\")))\n"
" (set-source-roots!\n"
" (append (map (lambda (r) (string-append base \"/\" r)) (list "
(fold-left (lambda (s r) (string-append s (ei-str-lit r) " ")) "" (bld-strs ext-roots))
"))\n"
" (list \"jolt-core\" \"stdlib\"))))\n"))
(put-string out (string-append (put-string out (string-append
"(suppress-greeting #t)\n"
"(scheme-start\n"
" (lambda args\n"
" (let ((mainv (var-deref " (ei-str-lit entry-ns) " \"-main\")))\n" " (let ((mainv (var-deref " (ei-str-lit entry-ns) " \"-main\")))\n"
" (apply jolt-invoke mainv args))\n" " (apply jolt-invoke mainv args))\n"
" (exit 0)))\n")) " (exit 0)))\n"))
@ -233,8 +317,9 @@
(display (string-append "jolt build: wrote " out-path "\n")))))) (display (string-append "jolt build: wrote " out-path "\n"))))))
(def-var! "jolt.host" "build-binary" (def-var! "jolt.host" "build-binary"
(lambda (entry out mode) (lambda (entry out mode natives embed-dirs ext-roots)
(build-binary (jolt-str-render-one entry) (build-binary (jolt-str-render-one entry)
(jolt-str-render-one out) (jolt-str-render-one out)
(jolt-str-render-one mode)) (jolt-str-render-one mode)
natives embed-dirs ext-roots)
jolt-nil)) jolt-nil))

View file

@ -116,7 +116,44 @@
(foreign-set! 'unsigned-8 p n 0) (foreign-set! 'unsigned-8 p n 0)
p)) p))
;; --- callbacks: receive calls FROM C ----------------------------------------
;; jolt.ffi/foreign-callable lowers to (jolt-ffi-register-callable! (foreign-callable …)).
;; A foreign-callable code object must be LOCKED (so the collector neither moves
;; nor reclaims it) and RETAINED while C may still call through its entry point.
;; Register it keyed by that entry-point address (a jolt pointer integer) — which
;; is what the caller hands to C; free-callable unlocks and drops it. A callback
;; left registered lives for the process (the GTK-signal-handler common case).
(define ffi-callable-table (make-eqv-hashtable)) ; entry-point addr -> code object
(define (jolt-ffi-register-callable! co)
(lock-object co)
(let ((addr (foreign-callable-entry-point co)))
(hashtable-set! ffi-callable-table addr co)
addr))
(define (ffi-free-callable addr)
(let* ((a (jnum->exact addr)) (co (hashtable-ref ffi-callable-table a #f)))
(when co (unlock-object co) (hashtable-delete! ffi-callable-table a))
jolt-nil))
;; --- native libraries for a standalone binary -------------------------------
;; `jolt build` bakes a project's deps.edn :jolt/native declarations into the
;; launcher, which loads them at startup (load-shared-object isn't part of the
;; saved heap, so it must run in the built process, not at heap build). process?
;; loads the running binary's own symbols (libc sockets); otherwise try each
;; platform candidate in turn and fail unless the spec is optional.
(define (jolt-build-load-native cands optional? process?)
(if process?
(begin (load-shared-object #f) #t)
(let loop ((cs cands))
(cond
((null? cs)
(unless optional?
(error 'jolt-build "required native library not found" cands))
#f)
((guard (e (#t #f)) (load-shared-object (car cs)) #t) #t)
(else (loop (cdr cs)))))))
;; --- expose under jolt.ffi --------------------------------------------------- ;; --- expose under jolt.ffi ---------------------------------------------------
(def-var! "jolt.ffi" "free-callable" ffi-free-callable)
(def-var! "jolt.ffi" "load-library" ffi-load-library) (def-var! "jolt.ffi" "load-library" ffi-load-library)
(def-var! "jolt.ffi" "loaded?" (lambda (n) (if (ffi-loaded? n) #t #f))) (def-var! "jolt.ffi" "loaded?" (lambda (n) (if (ffi-loaded? n) #t #f)))
(def-var! "jolt.ffi" "alloc" ffi-alloc) (def-var! "jolt.ffi" "alloc" ffi-alloc)

View file

@ -19,6 +19,16 @@
;; path string of any value: a jfile -> its path, else its str rendering. ;; path string of any value: a jfile -> its path, else its str rendering.
(define (file-path-of x) (if (jfile? x) (jfile-path x) (jolt-str-render-one x))) (define (file-path-of x) (if (jfile? x) (jfile-path x) (jolt-str-render-one x)))
;; Resources baked into a standalone binary by `jolt build` (deps.edn
;; :jolt/build :embed). The build emits a register-embedded-resource! per file at
;; heap-build time, so the contents live in the boot image — io/resource serves
;; them with no file on disk. An embedded hit reads through slurp/reader exactly
;; like a jfile would.
(define embedded-resources (make-hashtable equal-hash equal?))
(define (register-embedded-resource! name content)
(hashtable-set! embedded-resources name content))
(define-record-type embedded-res (fields name content) (nongenerative jolt-embres-v1))
;; A user-facing relative path resolves against JOLT_PWD — the user's cwd before ;; A user-facing relative path resolves against JOLT_PWD — the user's cwd before
;; the launcher cd'd to the jolt repo root — matching the JVM, where io/file is ;; the launcher cd'd to the jolt repo root — matching the JVM, where io/file is
;; cwd-relative. (io/resource builds jfiles from the source roots directly, so it ;; cwd-relative. (io/resource builds jfiles from the source roots directly, so it
@ -191,6 +201,7 @@
(define (jolt-slurp src . opts) (define (jolt-slurp src . opts)
(cond (cond
((jfile? src) (read-file-string (jfile-path src))) ((jfile? src) (read-file-string (jfile-path src)))
((embedded-res? src) (embedded-res-content src))
((reader-jhost? src) (drain-reader src)) ((reader-jhost? src) (drain-reader src))
;; bytes (a bytevector or a jolt byte-array): decode with :encoding (UTF-8 ;; bytes (a bytevector or a jolt byte-array): decode with :encoding (UTF-8
;; default). clj-http-lite slurps response-body byte arrays. ;; default). clj-http-lite slurps response-body byte arrays.
@ -286,6 +297,7 @@
(cond (cond
((reader-jhost? x) x) ((reader-jhost? x) x)
((jfile? x) (host-new "StringReader" (read-file-string (jfile-path x)))) ((jfile? x) (host-new "StringReader" (read-file-string (jfile-path x))))
((embedded-res? x) (host-new "StringReader" (embedded-res-content x)))
((and (jhost? x) (string=? (jhost-tag x) "url")) ((and (jhost? x) (string=? (jhost-tag x) "url"))
(host-new "StringReader" (read-file-string (url-strip-scheme (url-spec x))))) (host-new "StringReader" (read-file-string (url-strip-scheme (url-spec x)))))
((string? x) (host-new "StringReader" (read-file-string x))) ((string? x) (host-new "StringReader" (read-file-string x)))
@ -317,11 +329,13 @@
;; (slurp/reader-able) for the first match, else nil. get-source-roots is the ;; (slurp/reader-able) for the first match, else nil. get-source-roots is the
;; loader's accessor (loader.ss), resolved at call time — the runtime CLI loads it. ;; loader's accessor (loader.ss), resolved at call time — the runtime CLI loads it.
(define (jolt-io-resource name) (define (jolt-io-resource name)
(let ((nm (jolt-str-render-one name))) (let* ((nm (jolt-str-render-one name))
(emb (hashtable-ref embedded-resources nm #f)))
(if emb (make-embedded-res nm emb)
(let loop ((roots (get-source-roots))) (let loop ((roots (get-source-roots)))
(cond ((null? roots) jolt-nil) (cond ((null? roots) jolt-nil)
((file-exists? (string-append (car roots) "/" nm)) (make-jfile (string-append (car roots) "/" nm))) ((file-exists? (string-append (car roots) "/" nm)) (make-jfile (string-append (car roots) "/" nm)))
(else (loop (cdr roots))))))) (else (loop (cdr roots))))))))
(def-var! "clojure.java.io" "resource" jolt-io-resource) (def-var! "clojure.java.io" "resource" jolt-io-resource)
;; as-url honors a library-registered URL class (e.g. jolt-lang/http-client's full ;; as-url honors a library-registered URL class (e.g. jolt-lang/http-client's full
;; java.net.URL shim) so io/as-url and (URL. spec) agree; else the file-only jhost. ;; java.net.URL shim) so io/as-url and (URL. spec) agree; else the file-only jhost.

File diff suppressed because one or more lines are too long

View file

@ -424,6 +424,28 @@
:rettype (name (nth items 3)) :rettype (name (nth items 3))
:blocking (and (= 5 (count items)) (= "blocking" (name (nth items 4))))}) :blocking (and (= 5 (count items)) (= "blocking" (name (nth items 4))))})
;; jolt.ffi/__ccallable: the foreign-CALLBACK form (via the jolt.ffi/foreign-callable
;; macro) — the inverse of __cfn. It wraps a jolt fn as a C-callable function
;; pointer so C can call back INTO jolt (GTK signal handlers, qsort comparators).
;; Shape:
;; (jolt.ffi/__ccallable f [:argtype ...] :rettype) ; thread stays active
;; (jolt.ffi/__ccallable f [:argtype ...] :rettype :collect-safe) ; may be invoked
;; ; while the thread is
;; ; parked in a :blocking call
;; Unlike __cfn, the fn is a CHILD expression (analyzed + walked by the passes);
;; the types are literal keywords read at compile time. The Chez back end lowers
;; it to a locked `foreign-callable` and returns its entry-point address (a jolt
;; pointer). :collect-safe is required when C invokes the callback from a thread
;; that is deactivated inside a :blocking foreign call (e.g. a GTK main loop).
(defn- analyze-ffi-callable [ctx items env]
(when-not (<= 4 (count items) 5)
(throw (str "jolt.ffi/foreign-callable expects (foreign-callable f [argtypes] rettype [:collect-safe])")))
{:op :ffi-callable
:fn (analyze ctx (nth items 1) env)
:argtypes (mapv name (form-vec-items (nth items 2)))
:rettype (name (nth items 3))
:collect-safe (and (= 5 (count items)) (= "collect-safe" (name (nth items 4))))})
;; The `.` special form: `(. target member arg*)` — member access / method call. ;; The `.` special form: `(. target member arg*)` — member access / method call.
;; A symbol member whose name starts with "-" is a field read; otherwise it is a ;; A symbol member whose name starts with "-" is a field read; otherwise it is a
;; method (call with the trailing args). Both lower to a :host-call carrying the ;; method (call with the trailing args). Both lower to a :host-call carrying the
@ -506,6 +528,11 @@
(and (form-sym? head) (= "jolt.ffi" (form-sym-ns head)) (and (form-sym? head) (= "jolt.ffi" (form-sym-ns head))
(= "__cfn" (form-sym-name head))) (= "__cfn" (form-sym-name head)))
(analyze-ffi-fn ctx items env) (analyze-ffi-fn ctx items env)
;; jolt.ffi/__ccallable — the foreign-callback special form (the fn is a
;; child expression, analyzed here).
(and (form-sym? head) (= "jolt.ffi" (form-sym-ns head))
(= "__ccallable" (form-sym-name head)))
(analyze-ffi-callable ctx items env)
;; special-form heads are NOT shadowable (unlike macros): a local named ;; special-form heads are NOT shadowable (unlike macros): a local named
;; `if` does not change the meaning of (if …) in operator position, per ;; `if` does not change the meaning of (if …) in operator position, per
;; spec §3 and the reference. No (not shadowed) guard here. ;; spec §3 and the reference. No (not shadowed) guard here.

View file

@ -287,6 +287,19 @@
" (" (str/join " " (map ffi-type->chez (:argtypes node))) ") " " (" (str/join " " (map ffi-type->chez (:argtypes node))) ") "
(ffi-type->chez (:rettype node)) ")")) (ffi-type->chez (:rettype node)) ")"))
;; jolt.ffi/__ccallable -> a Chez foreign-callable wrapping the emitted jolt fn,
;; locked + registered (jolt-ffi-register-callable!, host/chez/ffi.ss) so the
;; collector neither moves nor reclaims it while C may still call through it. The
;; expression evaluates to the entry-point address — a jolt pointer the caller
;; hands to C. :collect-safe emits the convention that reactivates the thread on
;; entry, for callbacks invoked while it is parked in a :blocking foreign call.
(defn- emit-ffi-callable [node]
(str "(jolt-ffi-register-callable! (foreign-callable "
(when (:collect-safe node) "__collect_safe ")
(emit (:fn node))
" (" (str/join " " (map ffi-type->chez (:argtypes node))) ") "
(ffi-type->chez (:rettype node)) "))"))
(defn- emit-recur [node] (defn- emit-recur [node]
(when-not *recur-target* (throw (ex-info "emit: recur outside a loop/fn target" {}))) (when-not *recur-target* (throw (ex-info "emit: recur outside a loop/fn target" {})))
(let [arg-nodes (:args node)] (let [arg-nodes (:args node)]
@ -500,6 +513,7 @@
:loop (emit-loop node) :loop (emit-loop node)
:recur (emit-recur node) :recur (emit-recur node)
:ffi-fn (emit-ffi-fn node) :ffi-fn (emit-ffi-fn node)
:ffi-callable (emit-ffi-callable node)
:fn (emit-fn node) :fn (emit-fn node)
;; (def name) with no init (declare): reserve the cell. A def with non-empty ;; (def name) with no init (declare): reserve the cell. A def with non-empty
;; reader metadata lowers to def-var-with-meta! (ported in a later increment). ;; reader metadata lowers to def-var-with-meta! (ported in a later increment).

View file

@ -127,6 +127,14 @@
{dep-roots :roots dep-natives :natives} (resolve-deps all-deps project-dir)] {dep-roots :roots dep-natives :natives} (resolve-deps all-deps project-dir)]
{:roots (vec (distinct (concat project-roots dep-roots))) {:roots (vec (distinct (concat project-roots dep-roots)))
:main-opts main-opts :main-opts main-opts
;; the project's own paths (relative to project-dir) and absolute resource
;; roots, plus its :jolt/build options — `jolt build` uses these to bundle
;; resources into / alongside a standalone binary.
:project-dir project-dir
:project-paths (vec project-paths)
:project-roots (vec project-roots)
:build (:jolt/build edn)
:embed-dirs (mapv #(abspath project-dir %) (:embed (:jolt/build edn)))
:tasks (:tasks edn) :tasks (:tasks edn)
:natives (vec (distinct (concat (:jolt/native edn) dep-natives))) :natives (vec (distinct (concat (:jolt/native edn) dep-natives)))
;; nREPL middleware a library contributes (jolt.nrepl composes them over its ;; nREPL middleware a library contributes (jolt.nrepl composes them over its

View file

@ -94,6 +94,7 @@
(= op :set-var) (assoc node :val (f (get node :val))) (= op :set-var) (assoc node :val (f (get node :val)))
(= op :set-field) (assoc node :obj (f (get node :obj)) :val (f (get node :val))) (= op :set-field) (assoc node :obj (f (get node :obj)) :val (f (get node :val)))
(= op :defmacro) (assoc node :fn (f (get node :fn))) (= op :defmacro) (assoc node :fn (f (get node :fn)))
(= op :ffi-callable) (assoc node :fn (f (get node :fn)))
(= op :invoke) (assoc node :fn (f (get node :fn)) (= op :invoke) (assoc node :fn (f (get node :fn))
:args (mapv f (get node :args))) :args (mapv f (get node :args)))
(= op :vector) (assoc node :items (mapv f (get node :items))) (= op :vector) (assoc node :items (mapv f (get node :items)))
@ -140,6 +141,7 @@
(= op :set-var) (f acc (get node :val)) (= op :set-var) (f acc (get node :val))
(= op :set-field) (f (f acc (get node :obj)) (get node :val)) (= op :set-field) (f (f acc (get node :obj)) (get node :val))
(= op :defmacro) (f acc (get node :fn)) (= op :defmacro) (f acc (get node :fn))
(= op :ffi-callable) (f acc (get node :fn))
(= op :invoke) (reduce f (f acc (get node :fn)) (get node :args)) (= op :invoke) (reduce f (f acc (get node :fn)) (get node :args))
(= op :vector) (reduce f acc (get node :items)) (= op :vector) (reduce f acc (get node :items))
(= op :set) (reduce f acc (get node :items)) (= op :set) (reduce f acc (get node :items))

View file

@ -8,6 +8,12 @@
(defn- project-dir [] (or (jolt.host/getenv "JOLT_PWD") ".")) (defn- project-dir [] (or (jolt.host/getenv "JOLT_PWD") "."))
(defn- current-platform []
(let [os (str/lower-case (or (System/getProperty "os.name") ""))]
(cond (str/includes? os "mac") :darwin
(str/includes? os "win") :windows
:else :linux)))
;; Load a library's declared native shared objects (deps.edn :jolt/native) before ;; Load a library's declared native shared objects (deps.edn :jolt/native) before
;; its Clojure is required, so its foreign-fn bindings resolve. Each entry is a ;; its Clojure is required, so its foreign-fn bindings resolve. Each entry is a
;; map: {:name "sqlite3" :darwin ["libsqlite3.0.dylib" ...] :linux ["libsqlite3.so.0" ...]} ;; map: {:name "sqlite3" :darwin ["libsqlite3.0.dylib" ...] :linux ["libsqlite3.so.0" ...]}
@ -15,10 +21,7 @@
;; (use the running process's symbols, e.g. libc sockets — no external file). ;; (use the running process's symbols, e.g. libc sockets — no external file).
(defn- load-natives! [natives] (defn- load-natives! [natives]
(when (seq natives) (when (seq natives)
(let [os (str/lower-case (or (System/getProperty "os.name") "")) (let [plat (current-platform)]
plat (cond (str/includes? os "mac") :darwin
(str/includes? os "win") :windows
:else :linux)]
(doseq [spec natives] (doseq [spec natives]
(if (:process spec) (if (:process spec)
(jolt.ffi/load-library) (jolt.ffi/load-library)
@ -116,8 +119,23 @@
;; standalone executable. Resolves deps + roots like `run`, then hands the entry ;; standalone executable. Resolves deps + roots like `run`, then hands the entry
;; namespace to the host build driver (jolt.host/build-binary, defined by ;; namespace to the host build driver (jolt.host/build-binary, defined by
;; build.ss). Default mode is release; --opt selects optimized, --dev unoptimized. ;; build.ss). Default mode is release; --opt selects optimized, --dev unoptimized.
;; 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
;; binary's own symbols, else ["req"|"opt" cand…] to try in turn.
(defn- encode-natives [natives]
(let [plat (current-platform)]
(vec (for [spec natives]
(if (:process spec)
["process"]
(let [c (get spec plat)
cands (if (string? c) [c] (vec c))]
(into [(if (:optional spec) "opt" "req")] cands)))))))
(defn- cmd-build [more] (defn- cmd-build [more]
(apply-project! (deps/resolve-project (project-dir))) (let [{:keys [project-paths embed-dirs] :as resolved}
(deps/resolve-project (project-dir))]
(apply-project! resolved)
(let [opts (loop [a more, entry nil, out nil] (let [opts (loop [a more, entry nil, out nil]
(cond (cond
(empty? a) {:entry entry :out out} (empty? a) {:entry entry :out out}
@ -131,8 +149,11 @@
:else "release")] :else "release")]
(when (nil? entry) (when (nil? entry)
(throw (ex-info "build needs an entry: -m NS" {}))) (throw (ex-info "build needs an entry: -m NS" {})))
(let [out (or (:out opts) (first (str/split entry #"\.")))] (let [out (or (:out opts) (first (str/split entry #"\.")))
(jolt.host/build-binary entry out mode)))) natives (encode-natives (:natives resolved))]
;; 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)))))
(defn- nrepl [more] (defn- nrepl [more]
;; resolve the project (deps on the roots, native libs loaded), then start the ;; resolve the project (deps on the roots, native libs loaded), then start the

View file

@ -16,7 +16,9 @@
The memory/library primitives (alloc/free/read/write/sizeof/load-library/ The memory/library primitives (alloc/free/read/write/sizeof/load-library/
ptr->string/string->ptr/null/null?) are provided by the host. foreign-fn lowers ptr->string/string->ptr/null/null?) are provided by the host. foreign-fn lowers
a compile-time-typed signature to a real Chez foreign-procedure.") a compile-time-typed signature to a real Chez foreign-procedure. foreign-callable
is the inverse it wraps a jolt fn as a C-callable function pointer so C can
call back into jolt (e.g. GTK signal handlers); free-callable releases it.")
;; foreign-fn binds C symbol `csym` to a typed callable. Expands to the __cfn ;; foreign-fn binds C symbol `csym` to a typed callable. Expands to the __cfn
;; special form (always fully-qualified, so an :as alias on jolt.ffi resolves): ;; special form (always fully-qualified, so an :as alias on jolt.ffi resolves):
@ -33,3 +35,19 @@
(list 'def name (if (= opt :blocking) (list 'def name (if (= opt :blocking)
(list 'jolt.ffi/__cfn csym argtypes rettype :blocking) (list 'jolt.ffi/__cfn csym argtypes rettype :blocking)
(list 'jolt.ffi/__cfn csym argtypes rettype)))) (list 'jolt.ffi/__cfn csym argtypes rettype))))
;; foreign-callable wraps a jolt fn `f` as a C-callable function pointer — the
;; inverse of foreign-fn, so C can call back INTO jolt (GTK signal handlers, a
;; qsort comparator, any C API that takes a callback). Returns the pointer; pass
;; it where C expects a function pointer. argtypes/rettype use the same keywords
;; as foreign-fn; the args C passes arrive as jolt values and the jolt return is
;; marshaled back. The callback stays live until free-callable is called on the
;; pointer. Pass a trailing :collect-safe when C invokes the callback from a
;; thread parked in a :blocking foreign call (e.g. a GTK main loop):
;; (g-signal-connect button "clicked"
;; (ffi/foreign-callable on-click [:pointer :pointer] :void :collect-safe)
;; (ffi/null))
(defmacro foreign-callable [f argtypes rettype & [opt]]
(if (= opt :collect-safe)
(list 'jolt.ffi/__ccallable f argtypes rettype :collect-safe)
(list 'jolt.ffi/__ccallable f argtypes rettype)))

View file

@ -1 +1,8 @@
{:paths ["src"]} {:paths ["src" "resources"]
;; exercise the build's native-lib loading: a :process spec loads the running
;; binary's own symbols (libc) at startup — no external file, always succeeds.
:jolt/native [{:name "libc" :process true}]
;; bake resources/ into the binary so io/resource resolves with no file on disk.
:jolt/build {:embed ["resources"]}}

View file

@ -0,0 +1 @@
embedded resource ok

View file

@ -1,7 +1,11 @@
(ns app.core (ns app.core
(:require [app.util :as util])) (:require [app.util :as util]
[clojure.java.io :as io]))
(defn -main [& args] (defn -main [& args]
;; the resource is baked into the binary (deps.edn :jolt/build :embed), so this
;; resolves with no resources/ dir on disk, run from any cwd.
(println (slurp (io/resource "greeting.txt")))
(util/twice (println (util/shout "hello from a built binary"))) (util/twice (println (util/shout "hello from a built binary")))
(println "args:" (vec args)) (println "args:" (vec args))
(println "sum:" (reduce + (map count args)))) (println "sum:" (reduce + (map count args))))

View file

@ -61,5 +61,29 @@
(let loop ((i 0)) (when (fx<? i 30000000) (loop (fx+ i 1)))) ; spin so the thread enters usleep (let loop ((i 0)) (when (fx<? i 30000000) (loop (fx+ i 1)))) ; spin so the thread enters usleep
(ok "blocking ffi call is collect-safe" (guard (e (#t #f)) (collect) #t))) (ok "blocking ffi call is collect-safe" (guard (e (#t #f)) (collect) #t)))
;; callbacks: receive a call FROM C. A foreign-callable wraps a jolt fn as a
;; C-callable function pointer (what GTK signal handlers / qsort comparators need).
;; Build a comparator and sort an int array through libc qsort.
(ev "(def cmp (jolt.ffi/__ccallable
(fn [pa pb]
(let [a (jolt.ffi/read pa :int) b (jolt.ffi/read pb :int)]
(cond (< a b) -1 (> a b) 1 :else 0)))
[:pointer :pointer] :int))")
(ok "foreign-callable returns a pointer"
(let ((p (jnum->exact (var-deref "user" "cmp")))) (and (integer? p) (> p 0))))
(ev "(def c-qsort (jolt.ffi/__cfn \"qsort\" [:pointer :size_t :size_t :pointer] :void))")
(ok "C calls back into jolt: qsort with a jolt comparator"
(jolt-truthy?
(ev "(let [n 5 w (jolt.ffi/sizeof :int) p (jolt.ffi/alloc (* n w))]
(doseq [[i v] (map vector (range n) [3 1 4 1 5])]
(jolt.ffi/write p :int (* i w) v))
(c-qsort p n w cmp)
(let [out (mapv (fn [i] (jolt.ffi/read p :int (* i w))) (range n))]
(jolt.ffi/free p)
(= out [1 1 3 4 5])))")))
;; free-callable unlocks + drops the code object, returning nil.
(ok "free-callable releases the callback"
(jolt-nil? (ev "(jolt.ffi/free-callable cmp)")))
(printf "~a/~a passed~n" (- total fails) total) (printf "~a/~a passed~n" (- total fails) total)
(exit (if (zero? fails) 0 1)) (exit (if (zero? fails) 0 1))