From 9c6e4365c45bdb64e099449df3ebf1701ee2de00 Mon Sep 17 00:00:00 2001 From: Christian Weilbach Date: Mon, 31 Aug 2026 12:14:34 -0700 Subject: [PATCH] feat: retarget suspended continuations across forks --- CHANGELOG.md | 8 ++ doc/forking.md | 14 ++++ resources/SCI_VERSION | 2 +- src/sci/core.cljc | 36 +++++++++ src/sci/impl/execution.cljc | 20 +++++ src/sci/impl/vars.cljc | 89 +++++++++++++++++++++ test/sci/vars_test.cljc | 149 ++++++++++++++++++++++++++++++++++++ 7 files changed, 317 insertions(+), 1 deletion(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index 2e2fb2da..93aeb801 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -12,9 +12,17 @@ SCI is used in [babashka](https://github.com/babashka/babashka), ## Unreleased +## 0.15.59 + - Caches resolved JVM instance methods per call site for performance - Fix [babashka#2030](https://github.com/babashka/babashka/issues/2030): `aset` on a primitive array was reflective and 170x slower than `aset-double` - Bump edamame to `1.6.43` +- Add forkable interpreter worlds for Vars, namespaces, dynamic bindings, SCI + mutable values, and application-defined host resources. +- Add explicit continuation-context capture and retargeting so an embedding can + resume a suspended computation independently in related forked worlds. +- Add `with-detached-context` for recursively constructing an independent SCI + interpreter without inheriting the caller's execution-local world. ## 0.15.58 diff --git a/doc/forking.md b/doc/forking.md index 450e5e5f..53fbc17c 100644 --- a/doc/forking.md +++ b/doc/forking.md @@ -30,6 +30,13 @@ This shape combines four useful precedents: lineage. - Dynamic binding frames remain thread/evaluation scoped. A fork snapshots root bindings; it does not capture a running continuation or binding frame. +- Hosts that suspend interpreted code can explicitly capture its dynamic + binding frame with `sci/capture-continuation-context`. After forking the SCI + context, `sci/retarget-continuation-context` creates an independent binding + frame for the child world, and `sci/continuation-context-fn` resumes a host + continuation with that world and frame installed. Retargeting is restricted + to the same SCI lineage. Ordinary `sci/fork` still does not implicitly copy + running continuations. - Interpreter bindings are scoped to their world. Managed asynchronous callbacks convey and restore both the selected world and binding frame. - Writes before the first fork have ordinary SCI/Clojure mutable behavior. @@ -56,6 +63,13 @@ one fork and preserves aliases to its result. | Affine or movable authority | Reject the non-destructive fork, or keep authority outside the SCI value world | | Prohibited resource | Throw an explanatory exception from `fork-value` | +An embedding that lets interpreted code construct a new, independent SCI +interpreter should perform that construction through +`sci/with-detached-context`. This temporarily leaves the caller's selected +world and dynamic binding frame, runs the supplied host thunk, and restores the +caller afterwards. Evaluating an existing SCI context recursively does not need +this boundary; it is specifically for creating a separate context lineage. + Only values directly stored in world cells are inspected. A host container that holds mutable children must implement the protocol and copy its own graph. Unclassified values retain the compatibility behavior of being shared, except diff --git a/resources/SCI_VERSION b/resources/SCI_VERSION index d788da18..578f21f1 100644 --- a/resources/SCI_VERSION +++ b/resources/SCI_VERSION @@ -1 +1 @@ -0.15.58 +0.15.59 diff --git a/src/sci/core.cljc b/src/sci/core.cljc index 8ba0219f..3b05835c 100644 --- a/src/sci/core.cljc +++ b/src/sci/core.cljc @@ -15,6 +15,7 @@ [sci.ctx-store :as store] [sci.fork :as fork] [sci.impl.callstack :as cs] + [sci.impl.execution :as execution] [sci.impl.interpreter :as i] [sci.impl.io :as sio] [sci.impl.macros :as macros] @@ -58,11 +59,46 @@ (let [meta (assoc meta :dynamic true :name (utils/unqualify-symbol name))] (sci.lang/->Var init-val name meta false false nil (:ns meta))))) +(defn with-detached-context + "Invoke zero-argument `f` outside the currently executing SCI context. + + Embeddings use this host boundary when interpreted code recursively creates + an independent SCI interpreter. The caller's active world and dynamic + binding frame are restored even when `f` throws. Ordinary nested evaluation + of an existing context does not need this function." + [f] + (store/with-ctx nil + (execution/call-with-detached-state f))) + (defn set! "Establish thread local binding of dynamic var" [dynamic-var v] (t/setVal dynamic-var v)) +(defn capture-continuation-context + "Capture the active SCI context and dynamic bindings for later continuation + resumption. Must be called from managed SCI evaluation. The returned token is + opaque; use `continuation-context-fn` to resume through it. + + The explicit `ctx` arity is for host embedding boundaries invoked through an + interpreted function after the top-level evaluation has returned." + ([] + (vars/capture-continuation-context)) + ([ctx] + (vars/capture-continuation-context ctx))) + +(defn retarget-continuation-context + "Copy a captured continuation context for `target-ctx`, which must belong to + the same SCI lineage. The copy has independent dynamic binding boxes." + [continuation-context target-ctx] + (vars/retarget-continuation-context continuation-context target-ctx)) + +(defn continuation-context-fn + "Return a function that invokes `f` with the SCI world and dynamic bindings + represented by `continuation-context`." + [continuation-context f] + (vars/continuation-context-fn continuation-context f)) + (defn new-macro-var "Same as new-var but adds :macro true to meta as well as :sci/macro true to meta of the fn itself." diff --git a/src/sci/impl/execution.cljc b/src/sci/impl/execution.cljc index 0010967f..ad05b8ab 100644 --- a/src/sci/impl/execution.cljc +++ b/src/sci/impl/execution.cljc @@ -20,6 +20,26 @@ :default (def current (volatile! (new-state)))) +(defn call-with-detached-state + "Invoke `f` with an empty execution-local state, restoring the caller's + interpreter state afterwards. This is the host boundary used when an SCI + program constructs an independent interpreter recursively." + [f] + #?(:clj + (let [previous (.get ^ThreadLocal current)] + (.set ^ThreadLocal current (new-state)) + (try + (f) + (finally + (.set ^ThreadLocal current previous)))) + :default + (let [previous @current] + (vreset! current (new-state)) + (try + (f) + (finally + (vreset! current previous)))))) + (defn current-state [] #?(:clj (.get ^ThreadLocal current) :default @current)) diff --git a/src/sci/impl/vars.cljc b/src/sci/impl/vars.cljc index e4db38f4..f1ca239b 100644 --- a/src/sci/impl/vars.cljc +++ b/src/sci/impl/vars.cljc @@ -36,6 +36,8 @@ (deftype Frame [bindings prev scope prior-bindings]) +(defrecord ContinuationContext [ctx frame]) + (def top-frame (Frame. {} nil nil nil)) #?(:cljs @@ -85,6 +87,88 @@ (execution/binding-scope state) nil))) +(declare ^:private retarget-binding-frame) + +(defn capture-continuation-context + "Capture the current SCI context and its persistent dynamic-binding frame. + + The returned value is an opaque host embedding token. It is intended for a + suspended continuation: invoke it later with `continuation-context-fn`, or + retarget an independent copy to a fork of the captured SCI context with + `retarget-continuation-context`." + ([] + (capture-continuation-context store/*ctx*)) + ([ctx] + (when-not (:sci.impl/world ctx) + (throw (ex-info "No managed SCI context is active" + {:type ::no-active-context}))) + (let [source-scope (execution/binding-scope) + target-scope (:sci.impl/world ctx)] + ;; A suspension is a value snapshot, not an alias onto the evaluation's + ;; still-live binding boxes. Clone immediately; the source form may finish + ;; unwinding (or a host callback may choose a target later) before resume. + ;; An interpreted function invoked directly by its host has no ctx-store + ;; binding and therefore a nil binding scope; normalize that frame onto the + ;; explicit interpreter world supplied by the embedding boundary. + (->ContinuationContext + ctx + (retarget-binding-frame (get-thread-binding-frame) + source-scope target-scope))))) + +(defn- clone-binding-map + [bindings box-cache] + (when bindings + (persistent! + (reduce-kv + (fn [ret var* box] + (let [forked-box + (if-let [entry (find @box-cache box)] + (val entry) + (let [copy (TBox. #?(:cljd nil + :clj (Thread/currentThread) + :cljs nil) + (t/getVal box))] + (vswap! box-cache assoc box copy) + copy))] + (assoc! ret var* forked-box))) + (transient {}) + bindings)))) + +(defn- retarget-binding-frame + [frame source-scope target-scope] + (let [box-cache (volatile! {})] + (letfn [(retarget [^Frame current] + (cond + (nil? current) nil + (identical? current top-frame) top-frame + :else + (Frame. (clone-binding-map (.-bindings current) box-cache) + (retarget (.-prev current)) + (if (identical? source-scope (.-scope current)) + target-scope + (.-scope current)) + (clone-binding-map (.-prior-bindings current) + box-cache))))] + (retarget frame)))) + +(defn retarget-continuation-context + "Return an independent continuation context selecting `target-ctx`. + + The target must be a fork in the captured context's lineage. Dynamic binding + boxes are copied, with aliases preserved inside the copied frame chain, and + binding scopes owned by the source world are moved to the target world." + [{source-ctx :ctx frame :frame} target-ctx] + (when-not (and (:sci.impl/world target-ctx) + (identical? (:sci.impl/lineage source-ctx) + (:sci.impl/lineage target-ctx))) + (throw (ex-info "Cannot retarget a continuation to an unrelated SCI context" + {:type ::unrelated-context}))) + (->ContinuationContext + target-ctx + (retarget-binding-frame frame + (:sci.impl/world source-ctx) + (:sci.impl/world target-ctx)))) + (defn reset-thread-binding-frame [frame] (let [state #?(:clj (.get ^ThreadLocal execution/current) :default (execution/current-state)) @@ -212,6 +296,11 @@ ([x y z & args] (invoke (list* x y z args)))))) +(defn continuation-context-fn + "Wrap `f` so every invocation restores a captured continuation context." + [{:keys [ctx frame]} f] + (binding-frame-fn frame ctx f)) + (defn binding-conveyor-fn "Convey the current binding values to an independent task. The shallow frame deliberately cannot pop scopes owned by the submitting execution." diff --git a/test/sci/vars_test.cljc b/test/sci/vars_test.cljc index b5e7d439..24a19f16 100644 --- a/test/sci/vars_test.cljc +++ b/test/sci/vars_test.cljc @@ -209,6 +209,155 @@ (sci/with-bindings {1 1} (sci/eval-string "*x*" {:bindings {'*x* 1}})))))) +(deftest forked-continuation-context-test + (let [captured (atom nil) + parent (sci/init + {:bindings + {'capture-continuation-context! + #(reset! captured (sci/capture-continuation-context))}})] + (sci/eval-string* + parent + "(def state (atom 0)) + (def ^:dynamic *outer* :root) + (def ^:dynamic *inner* :root) + (defn resume! [tag] + (let [before [*outer* *inner*] + _ (set! *inner* tag)] + [before [*outer* *inner*] (swap! state inc)])) + (defn unwind! [] + (let [inner *inner*] + (pop-thread-bindings) + [inner *outer* *inner*])) + (binding [*outer* :outer] + (binding [*inner* :inner] + (capture-continuation-context!)))") + (let [child (sci/fork parent) + sibling (sci/fork parent) + child-context + (sci/retarget-continuation-context @captured child) + sibling-context + (sci/retarget-continuation-context @captured sibling) + parent-resume + (sci/continuation-context-fn + @captured + (sci/eval-string* parent "resume!")) + child-resume + (sci/continuation-context-fn + child-context + (sci/eval-string* child "resume!")) + sibling-resume + (sci/continuation-context-fn + sibling-context + (sci/eval-string* sibling "resume!")) + child-unwind + (sci/continuation-context-fn + child-context + (sci/eval-string* child "unwind!"))] + (is (= [[:outer :inner] [:outer :parent] 1] + (parent-resume :parent))) + (is (= [[:outer :inner] [:outer :child] 1] + (child-resume :child))) + (is (= [[:outer :inner] [:outer :sibling] 1] + (sibling-resume :sibling))) + ;; The child capsule retains its own prior `set!`, then unwinds exactly + ;; one nested binding frame without touching parent or sibling boxes. + (is (= [:child :outer :root] (child-unwind))) + (is (= 1 (sci/eval-string* parent "@state"))) + (is (= 1 (sci/eval-string* child "@state"))) + (is (= 1 (sci/eval-string* sibling "@state"))) + (is (= [:root :root] + (sci/eval-string* parent "[*outer* *inner*]"))) + (is (= [:root :root] + (sci/eval-string* child "[*outer* *inner*]")))))) + +(deftest continuation-context-rejects-unrelated-lineage-test + (let [captured (atom nil) + parent (sci/init + {:bindings + {'capture-continuation-context! + #(reset! captured (sci/capture-continuation-context))}}) + unrelated (sci/init {})] + (sci/eval-string* parent "(capture-continuation-context!)") + (is (thrown-with-msg? + #?(:cljd cljd.core/ExceptionInfo :clj Exception :cljs js/Error) + #"unrelated SCI context" + (sci/retarget-continuation-context @captured unrelated))))) + +(deftest continuation-context-captures-binding-values-immediately-test + (let [captured (atom nil) + parent (sci/init + {:bindings + {'capture-continuation-context! + #(reset! captured (sci/capture-continuation-context))}})] + (sci/eval-string* + parent + "(def ^:dynamic *value* :root) + (defn capture-and-mutate! [] + (binding [*value* :captured] + (capture-continuation-context!) + (set! *value* :after-capture)))") + (sci/eval-string* parent "(capture-and-mutate!)") + (let [child (sci/fork parent) + parent-resume + (sci/continuation-context-fn + @captured + (sci/eval-string* parent "(fn [] *value*)")) + child-resume + (sci/continuation-context-fn + (sci/retarget-continuation-context @captured child) + (sci/eval-string* child "(fn [] *value*)"))] + (is (= :captured (parent-resume))) + (is (= :captured (child-resume))) + (is (= :root (sci/eval-string* parent "*value*"))) + (is (= :root (sci/eval-string* child "*value*")))))) + +(deftest explicit-context-captures-host-invoked-interpreted-function-test + (let [captured (atom nil) + context-holder (atom nil) + parent (sci/init + {:bindings + {'capture-continuation-context! + #(reset! captured + (sci/capture-continuation-context @context-holder))}})] + (reset! context-holder parent) + (let [suspend + (sci/eval-string* + parent + "(def ^:dynamic *scope* :root) + (fn [] + (binding [*scope* :host-invoked] + (capture-continuation-context!)))")] + ;; This interpreted closure runs after eval-string* has returned, which is + ;; how an embedding such as Spindel invokes an interpreted Spin body. + (suspend) + (let [child (sci/fork parent) + resume + (sci/continuation-context-fn + (sci/retarget-continuation-context @captured child) + (sci/eval-string* child "(fn [] *scope*)"))] + (is (= :host-invoked (resume))) + (is (= :root (sci/eval-string* parent "*scope*"))) + (is (= :root (sci/eval-string* child "*scope*"))))))) + +#?(:clj + (deftest independent-interpreter-can-be-created-recursively-test + (let [outer + (sci/init + {:bindings + {'create-inner! + #(sci/with-detached-context + (fn [] + (let [ctx (sci/init {})] + (sci/eval-string* + ctx + "(ns nested.runtime) + (defmacro answer [] 42)") + (sci/eval-string* ctx "(nested.runtime/answer)"))))}})] + (is (= 42 + (sci/eval-string* + outer + "(create-inner!)")))))) + (deftest binding-api-test (when-not tu/native? (let [x (sci/new-dynamic-var 'x)]