Fix direct-link crash on a non-fn var called as a function
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).
This commit is contained in:
parent
9a21325972
commit
4461179804
3 changed files with 134 additions and 104 deletions
File diff suppressed because one or more lines are too long
|
|
@ -109,7 +109,12 @@
|
||||||
;; set — one defined earlier in emission order (or itself), so the Scheme binding
|
;; set — one defined earlier in emission order (or itself), so the Scheme binding
|
||||||
;; exists by the time the reference runs. Reset per build.
|
;; exists by the time the reference runs. Reset per build.
|
||||||
(def direct-link-defined (atom #{}))
|
(def direct-link-defined (atom #{}))
|
||||||
(defn direct-link-reset! [] (reset! direct-link-defined #{}))
|
;; Of those, the ones whose init is a fn literal — safe to call as a raw Scheme
|
||||||
|
;; application. A def of a non-fn value (a map, set, keyword, …) is invokable in
|
||||||
|
;; Clojure but is not a Scheme procedure, so its calls must still route through
|
||||||
|
;; jolt-invoke even with a direct binding.
|
||||||
|
(def direct-link-fns (atom #{}))
|
||||||
|
(defn direct-link-reset! [] (reset! direct-link-defined #{}) (reset! direct-link-fns #{}))
|
||||||
|
|
||||||
;; A direct-link Scheme binding name for a var. The fqn maps to a unique identifier
|
;; A direct-link Scheme binding name for a var. The fqn maps to a unique identifier
|
||||||
;; jv$<ns>$<name>; chars that break a Scheme identifier or the `$` separator are
|
;; jv$<ns>$<name>; chars that break a Scheme identifier or the `$` separator are
|
||||||
|
|
@ -120,6 +125,10 @@
|
||||||
(defn- dl-fqn [ns nm] (str ns "/" nm))
|
(defn- dl-fqn [ns nm] (str ns "/" nm))
|
||||||
(defn- direct-linkable? [ns nm]
|
(defn- direct-linkable? [ns nm]
|
||||||
(and @direct-link? (contains? @direct-link-defined (dl-fqn ns nm))))
|
(and @direct-link? (contains? @direct-link-defined (dl-fqn ns nm))))
|
||||||
|
;; A direct-linked var whose value is a fn literal — its binding is a Scheme
|
||||||
|
;; procedure, so a call site can apply it directly.
|
||||||
|
(defn- direct-link-fn? [ns nm]
|
||||||
|
(contains? @direct-link-fns (dl-fqn ns nm)))
|
||||||
|
|
||||||
;; recur-target and the set of munged local names known to hold a procedure (a
|
;; recur-target and the set of munged local names known to hold a procedure (a
|
||||||
;; named fn's self-recursion name) are lexically scoped — dynamic vars so the
|
;; named fn's self-recursion name) are lexically scoped — dynamic vars so the
|
||||||
|
|
@ -486,9 +495,13 @@
|
||||||
;; a :local callee that isn't a known procedure -> dynamic IFn dispatch.
|
;; a :local callee that isn't a known procedure -> dynamic IFn dispatch.
|
||||||
(and (= :local (:op fnode)) (not (*known-procs* (munge-name (:name fnode)))))
|
(and (= :local (:op fnode)) (not (*known-procs* (munge-name (:name fnode)))))
|
||||||
(invoke)
|
(invoke)
|
||||||
;; closed-world direct call: the callee var is an app def already emitted with
|
;; closed-world direct call: the callee var is an app fn def already emitted
|
||||||
;; a Scheme binding — call it directly, no var lookup, no jolt-invoke.
|
;; with a Scheme binding — apply it directly, no var lookup, no jolt-invoke.
|
||||||
(and (= :var (:op fnode)) (direct-linkable? (:ns fnode) (:name fnode)))
|
;; Only fn-valued defs qualify; a non-fn invokable value (a map/set/keyword
|
||||||
|
;; held in a var) isn't a Scheme procedure, so it falls through to jolt-invoke
|
||||||
|
;; below (which still uses the direct binding as the invoke target).
|
||||||
|
(and (= :var (:op fnode)) (direct-linkable? (:ns fnode) (:name fnode))
|
||||||
|
(direct-link-fn? (:ns fnode) (:name fnode)))
|
||||||
(order-args (fn [as] (str "(" (dl-name (:ns fnode) (:name fnode))
|
(order-args (fn [as] (str "(" (dl-name (:ns fnode) (:name fnode))
|
||||||
(if (seq as) (str " " (str/join " " as)) "") ")")))
|
(if (seq as) (str " " (str/join " " as)) "") ")")))
|
||||||
;; a late-bound :var call head can hold a procedure OR a non-applicable
|
;; a late-bound :var call head can hold a procedure OR a non-applicable
|
||||||
|
|
@ -636,6 +649,7 @@
|
||||||
(let [ns (:ns node) nm (:name node) b (dl-name ns nm)]
|
(let [ns (:ns node) nm (:name node) b (dl-name ns nm)]
|
||||||
;; register before emitting the init so a self-referential body direct-links.
|
;; register before emitting the init so a self-referential body direct-links.
|
||||||
(swap! direct-link-defined conj (dl-fqn ns nm))
|
(swap! direct-link-defined conj (dl-fqn ns nm))
|
||||||
|
(when (= :fn (:op (:init node))) (swap! direct-link-fns conj (dl-fqn ns nm)))
|
||||||
(let [init (emit (:init node))]
|
(let [init (emit (:init node))]
|
||||||
(if (jmeta-nonempty? (:meta node))
|
(if (jmeta-nonempty? (:meta node))
|
||||||
(str "(begin (define " b " " init ") (def-var-with-meta! "
|
(str "(begin (define " b " " init ") (def-var-with-meta! "
|
||||||
|
|
|
||||||
|
|
@ -44,6 +44,8 @@
|
||||||
(jolt-compile-eval "(def hof (fn* ([] a)))" "app")
|
(jolt-compile-eval "(def hof (fn* ([] a)))" "app")
|
||||||
(jolt-compile-eval "(def ^:dynamic d 5)" "app")
|
(jolt-compile-eval "(def ^:dynamic d 5)" "app")
|
||||||
(jolt-compile-eval "(def usesd (fn* ([] (d))))" "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) ---
|
;; --- direct-link OFF: every reference stays indirect (var-deref) ---
|
||||||
(let ((eb (emit-form "app" "(def b (fn* ([] (a))))")))
|
(let ((eb (emit-form "app" "(def b (fn* ([] (a))))")))
|
||||||
|
|
@ -72,6 +74,16 @@
|
||||||
(ok "on: a used as a value references the binding directly" (contains? eh " jv$app$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\")"))))
|
(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.
|
;; ^:dynamic opts out: no jv$ binding, callers stay indirect.
|
||||||
(let ((ed (emit-form "app" "(def ^:dynamic d 5)")))
|
(let ((ed (emit-form "app" "(def ^:dynamic d 5)")))
|
||||||
(ok "on: ^:dynamic def gets no jv$ binding" (not (contains? ed "(define jv$app$d"))))
|
(ok "on: ^:dynamic def gets no jv$ binding" (not (contains? ed "(define jv$app$d"))))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue