7bc277b2e8
A release/optimized `jolt build` is a closed world: every app def is final, so an app->app call can bind to the def's Scheme binding directly instead of going through (jolt-invoke (var-deref ns name)). The emitter gains a direct-link mode (off for the seed mint, runtime -e/repl, and dev builds). With it on, a top-level app def also emits a binding jv$<ns>$<name> that def-var! aliases; an app->app call or value-ref to a name already emitted in the unit lowers to that binding, skipping both the var-table lookup and the generic IFn dispatch. ^:dynamic/^:redef defs and nested defs (a defonce's inner def) opt out and stay indirect. Off direct-link mode, emit-top-form is exactly emit, so the seed and runtime eval are byte-unchanged (selfhost holds). build.ss turns it on for release + optimized; the defined-set accumulates across the dependency-ordered namespaces so a dep's defs are linkable by the time the entry that calls them is emitted. App->core calls stay indirect for now (core is the baked seed); that's a later stage. ~1.74x on a hot cross-namespace call loop (26.5s -> 15.2s).
89 lines
4.3 KiB
Scheme
89 lines
4.3 KiB
Scheme
;; 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))
|