4461179804
Under --direct-link a top-level def binds jv$<fqn> and app->app calls bound directly
to it. emit-invoke raw-applied that binding for any var callee, but only a fn-valued
def is a Scheme procedure: (def cfg {...}) then (cfg :a) emitted (jv$cfg :a), applying
a pmap -> "attempt to apply non-procedure". Maps/sets/keywords are invokable in Clojure
via jolt-invoke, which the indirect path used, so this only bit closed-world builds.
Track which direct-linked vars hold fn literals (direct-link-fns, registered at the def
site when the init op is :fn) and only raw-apply those. A non-fn callee falls through to
the jolt-invoke branch, which still uses the direct jv$ binding as the invoke target —
so the var-deref is still skipped, just not the dispatch.
Seed source: re-minted. Regression in directlink-test.ss (jolt-cw1o).
101 lines
5.2 KiB
Scheme
101 lines
5.2 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")
|
|
(jolt-compile-eval "(def cfg {:a 1 :b 2})" "app")
|
|
(jolt-compile-eval "(def usecfg (fn* ([] (cfg :a))))" "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\")"))))
|
|
|
|
;; A map-valued (non-fn) def is invokable in Clojure but is NOT a Scheme procedure;
|
|
;; a direct-link call to it must route through jolt-invoke, never raw-apply the
|
|
;; binding (which crashed with "attempt to apply non-procedure" before the fix).
|
|
(let ((ec (emit-form "app" "(def cfg {:a 1 :b 2})"))) ; registers app/cfg (non-fn) in the set
|
|
(ok "on: a non-fn def still gets a jv$ binding" (contains? ec "(define jv$app$cfg ")))
|
|
(let ((eu (emit-form "app" "(def usecfg (fn* ([] (cfg :a))))")))
|
|
(ok "on: call to a map-valued def routes through jolt-invoke" (contains? eu "(jolt-invoke"))
|
|
(ok "on: call to a map-valued def still uses the direct binding" (contains? eu "jv$app$cfg"))
|
|
(ok "on: a map-valued def is NOT raw-applied as a procedure" (not (contains? eu "(jv$app$cfg"))))
|
|
|
|
;; ^: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))
|