diff --git a/docs/MODULES.md b/docs/MODULES.md index 304aeff..6fc5253 100644 --- a/docs/MODULES.md +++ b/docs/MODULES.md @@ -81,6 +81,10 @@ sync when changing it. (stash) + `host-contract.ss` (`inline-ir`/`stash-inline!`); `test/chez/inline-test.ss`. - **Multimethods**: `host/chez/multimethods.ss` (dispatch) + the overlay `defmulti`/`defmethod` macros + `host-contract.ss` late-bind. +- **AOT namespace context** (`jolt build`): `build.ss` (`bld-ns-prelude`) emits + `(set-chez-ns! ns)` + `chez-register-alias!` per app namespace (both the normal + and tree-shake emit paths), matching the loader's per-file ns context; + `test/chez/build-app` (`make buildsmoke`). - **Deps resolution**: `jolt-core/jolt/deps.clj` (the only file) + `main.clj` (applies the roots) + `loader.ss` (the `require` path). diff --git a/host/chez/build-smoke.sh b/host/chez/build-smoke.sh index a73feec..b2a61ea 100755 --- a/host/chez/build-smoke.sh +++ b/host/chez/build-smoke.sh @@ -44,7 +44,9 @@ want='embedded resource ok HELLO FROM A BUILT BINARY! HELLO FROM A BUILT BINARY! args: [alpha bb ccc] -sum: 10' +sum: 10 +greet-default: greet:default +greet-loud: greet:loud' if [ "$got" != "$want" ]; then echo " FAIL: binary output mismatch" echo "--- want ---"; echo "$want" diff --git a/host/chez/build.ss b/host/chez/build.ss index 0258ded..1dc401e 100644 --- a/host/chez/build.ss +++ b/host/chez/build.ss @@ -170,6 +170,48 @@ ;; 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)) +;; Strings emitted before each app ns's forms, replaying what the source loader +;; does per file: (1) set chez-current-ns so runtime ns-sensitive setup forms +;; (defmulti/defmethod resolve their target var through it) land in the right ns; +;; (2) register the ns's :as aliases so a quoted alias resolves at runtime — a +;; (defmethod ig/foo …) passes 'ig/foo to defmethod-setup, which needs ig -> the +;; real ns, but the build strips the (ns …) form that would register it. +(define (bld-scan-spec! ns-name spec emit!) + (let ((items (cond ((pvec? spec) (seq->list spec)) + ((and (cseq? spec) (cseq-list? spec)) (seq->list spec)) + (else '())))) + (when (and (pair? items) (symbol-t? (car items))) + (let ((target (symbol-t-name (car items)))) + (let loop ((xs (cdr items))) + (when (and (pair? xs) (pair? (cdr xs))) + (let ((k (car xs)) (v (cadr xs))) + (when (and (keyword? k) (string=? (keyword-t-name k) "as") (symbol-t? v)) + (emit! (string-append "(chez-register-alias! " (ei-str-lit ns-name) + " " (ei-str-lit (symbol-t-name v)) + " " (ei-str-lit target) ")")))) + (loop (cddr xs)))))))) + +(define (bld-ns-prelude ns-name src) + (let ((acc (list (string-append "(set-chez-ns! " (ei-str-lit ns-name) ")"))) + (nsf (let loop ((fs (ei-read-all src))) + (cond ((null? fs) #f) + ((ei-ns-form? (car fs)) (car fs)) + (else (loop (cdr fs))))))) + (when nsf + (for-each + (lambda (clause) + (when (and (cseq? clause) (cseq-list? clause)) + (let ((citems (seq->list clause))) + (when (and (pair? citems) (keyword? (car citems)) + (let ((kn (keyword-t-name (car citems)))) + (or (string=? kn "require") (string=? kn "use")))) + (for-each (lambda (spec) + (bld-scan-spec! ns-name spec + (lambda (s) (set! acc (cons s acc))))) + (cdr citems)))))) + (seq->list nsf))) + (reverse acc))) + ;; --- 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))) @@ -274,11 +316,24 @@ (dce-shake (dce-blob-records "host/chez/seed/prelude.ss") (apply append - (map (lambda (nf) (ei-emit-ns-records (car nf) (read-file-string (cdr nf)))) ordered)) + (map (lambda (nf) + ;; ns-prelude forms (always kept, no fqn/refs) set the + ;; ns + register aliases before this ns's forms; dce + ;; keeps original order. + (let ((src (read-file-string (cdr nf)))) + (append + (map (lambda (s) (dce-rec #t #f '() s)) + (bld-ns-prelude (car nf) src)) + (ei-emit-ns-records (car nf) src)))) + ordered)) (string-append entry-ns "/-main")) (values #f (apply append - (map (lambda (nf) (bld-emit-ns (car nf) (read-file-string (cdr nf)))) ordered)) + (map (lambda (nf) + (let ((src (read-file-string (cdr nf)))) + (append (bld-ns-prelude (car nf) src) + (bld-emit-ns (car nf) src)))) + ordered)) #f))) (lambda () (set-optimize! #f) diff --git a/test/chez/build-app/src/app/core.clj b/test/chez/build-app/src/app/core.clj index fd50bba..c47c1fb 100644 --- a/test/chez/build-app/src/app/core.clj +++ b/test/chez/build-app/src/app/core.clj @@ -2,10 +2,17 @@ (:require [app.util :as util] [clojure.java.io :as io])) +;; An aliased cross-ns defmethod: 'util/greet is passed quoted to defmethod-setup, +;; so the AOT build must register the `util` alias for app.core or it resolves to +;; ns "util" and never reaches app.util/greet (the dispatch falls to :default). +(defmethod util/greet :loud [_] "greet:loud") + (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"))) (println "args:" (vec args)) - (println "sum:" (reduce + (map count args)))) + (println "sum:" (reduce + (map count args))) + (println "greet-default:" (util/greet :unknown)) + (println "greet-loud:" (util/greet :loud))) diff --git a/test/chez/build-app/src/app/util.clj b/test/chez/build-app/src/app/util.clj index c4f7429..589ebd4 100644 --- a/test/chez/build-app/src/app/util.clj +++ b/test/chez/build-app/src/app/util.clj @@ -6,3 +6,10 @@ (defmacro twice [x] `(do ~x ~x)) + +;; A multimethod with a :default method. The AOT build must set the per-ns +;; current ns before these forms run, or the defmethod registers app.util/greet +;; under the wrong ns and a dispatch to :default crashes (not a fn nil). app.core +;; adds an aliased method (util/greet :loud) — see there. +(defmulti greet (fn [kind] kind)) +(defmethod greet :default [_] "greet:default")