AOT build: set per-ns ns context and register aliases
The source loader sets the current ns and registers :as aliases per file. The
build flattened every app namespace into one image with no such markers, so all
app forms ran under the last-set ns ("user"). Two breakages followed, both only
in a built binary:
- defmulti/defmethod resolve their target var through chez-current-ns, so they
registered the multifn under "user" while compiled var-derefs used the baked
ns — the multifn the app saw was uninitialized ("not a fn nil" on dispatch).
- a quoted alias-qualified symbol (a (defmethod ig/foo …) on an aliased multifn)
resolves its ns through chez-resolve-alias, but the stripped (ns …) form left
the alias table empty, so it landed in ns "ig".
bld-ns-prelude now emits (set-chez-ns! ns) plus chez-register-alias! for each
ns's :as aliases before that ns's forms, in both the normal and tree-shake emit
paths. The build-app fixture gains a :default multimethod and an aliased cross-ns
defmethod so buildsmoke covers both across all build modes.
This commit is contained in:
parent
ea609d72eb
commit
66ad475722
5 changed files with 79 additions and 4 deletions
|
|
@ -81,6 +81,10 @@ sync when changing it.
|
||||||
(stash) + `host-contract.ss` (`inline-ir`/`stash-inline!`); `test/chez/inline-test.ss`.
|
(stash) + `host-contract.ss` (`inline-ir`/`stash-inline!`); `test/chez/inline-test.ss`.
|
||||||
- **Multimethods**: `host/chez/multimethods.ss` (dispatch) + the overlay
|
- **Multimethods**: `host/chez/multimethods.ss` (dispatch) + the overlay
|
||||||
`defmulti`/`defmethod` macros + `host-contract.ss` late-bind.
|
`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`
|
- **Deps resolution**: `jolt-core/jolt/deps.clj` (the only file) + `main.clj`
|
||||||
(applies the roots) + `loader.ss` (the `require` path).
|
(applies the roots) + `loader.ss` (the `require` path).
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -44,7 +44,9 @@ want='embedded resource ok
|
||||||
HELLO FROM A BUILT BINARY!
|
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
|
||||||
|
greet-default: greet:default
|
||||||
|
greet-loud: greet:loud'
|
||||||
if [ "$got" != "$want" ]; then
|
if [ "$got" != "$want" ]; then
|
||||||
echo " FAIL: binary output mismatch"
|
echo " FAIL: binary output mismatch"
|
||||||
echo "--- want ---"; echo "$want"
|
echo "--- want ---"; echo "$want"
|
||||||
|
|
|
||||||
|
|
@ -170,6 +170,48 @@
|
||||||
;; 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))
|
||||||
|
|
||||||
|
;; 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 --------------------------------------
|
;; --- bundling: native libs + resources --------------------------------------
|
||||||
;; A jolt seq of jolt strings -> a Scheme list of Scheme strings.
|
;; A jolt seq of jolt strings -> a Scheme list of Scheme strings.
|
||||||
(define (bld-strs x) (map jolt-str-render-one (seq->list x)))
|
(define (bld-strs x) (map jolt-str-render-one (seq->list x)))
|
||||||
|
|
@ -274,11 +316,24 @@
|
||||||
(dce-shake
|
(dce-shake
|
||||||
(dce-blob-records "host/chez/seed/prelude.ss")
|
(dce-blob-records "host/chez/seed/prelude.ss")
|
||||||
(apply append
|
(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"))
|
(string-append entry-ns "/-main"))
|
||||||
(values #f
|
(values #f
|
||||||
(apply append
|
(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)))
|
#f)))
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(set-optimize! #f)
|
(set-optimize! #f)
|
||||||
|
|
|
||||||
|
|
@ -2,10 +2,17 @@
|
||||||
(:require [app.util :as util]
|
(:require [app.util :as util]
|
||||||
[clojure.java.io :as io]))
|
[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]
|
(defn -main [& args]
|
||||||
;; the resource is baked into the binary (deps.edn :jolt/build :embed), so this
|
;; 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.
|
;; resolves with no resources/ dir on disk, run from any cwd.
|
||||||
(println (slurp (io/resource "greeting.txt")))
|
(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)))
|
||||||
|
(println "greet-default:" (util/greet :unknown))
|
||||||
|
(println "greet-loud:" (util/greet :loud)))
|
||||||
|
|
|
||||||
|
|
@ -6,3 +6,10 @@
|
||||||
|
|
||||||
(defmacro twice [x]
|
(defmacro twice [x]
|
||||||
`(do ~x ~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")
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue