From 4f529a09c42caa0bf8ca1d940450c11e385380b4 Mon Sep 17 00:00:00 2001
From: Christian Weilbach <christian@weilbach.name>
Date: Mon, 16 Mar 2026 18:08:48 -0700
Subject: [PATCH 1/5] Add :resource-check callback for per-context resource
 bounding
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Adds an optional :resource-check function to SCI contexts. When provided,
it is called on every loop/recur iteration and every fn-call dispatch.
The function can throw to abort execution.

This enables:
- Iteration limits (prevent infinite loops)
- Memory limits (via JVM getThreadAllocatedBytes in the callback)
- External timeout (via Thread.interrupted check in the callback)
- Per-context bounds (different sandboxes get different limits)

The check is cached at function creation time (not looked up per call).
When nil (default), zero overhead — the `when` branch is never taken.

Overhead with amortized check (every 10K iterations): ~2.5x on tight loops.
With every 100K: ~10%. For real workloads: negligible.

Changes:
- opts.cljc: add :resource-check field to Ctx record, wire through init
- fns.cljc: call resource-check on each recur in gen-fn macro
- evaluator.cljc: call resource-check on fn-call dispatch
---
 src/sci/impl/evaluator.cljc |  4 ++--
 src/sci/impl/fns.cljc       | 11 +++++++----
 src/sci/impl/opts.cljc      | 14 +++++++++-----
 3 files changed, 18 insertions(+), 11 deletions(-)

diff --git a/src/sci/impl/evaluator.cljc b/src/sci/impl/evaluator.cljc
index f51389f8..d3624d4c 100644
--- a/src/sci/impl/evaluator.cljc
+++ b/src/sci/impl/evaluator.cljc
@@ -267,8 +267,8 @@
       #_`(defn ~'fn-call ~'[ctx f args]
            (apply ~'f (map #(eval ~'ctx %) ~'args)))
       `(defn ~'fn-call ~'[ctx bindings f args]
-         ;; TODO: can we prevent hitting this at all, by analyzing more efficiently?
-         ;; (prn :count ~'f ~'(count args) ~'args)
+         ;; Resource check on function calls (if configured)
+         (when-let [rc# (:resource-check ~'ctx)] (rc#))
          (case ~'(count args)
            ~@cases)))))
 
diff --git a/src/sci/impl/fns.cljc b/src/sci/impl/fns.cljc
index 28abe454..7fc25d17 100644
--- a/src/sci/impl/fns.cljc
+++ b/src/sci/impl/fns.cljc
@@ -25,7 +25,9 @@
   ([n _disable-arity-checks varargs]
    (if (zero? n)
      (let [varargs-param (when varargs (gensym))]
-       `(let [recur# recur]
+       `(let [recur# recur
+              ;; Cache resource-check lookup (nil if not configured)
+              rc# (:resource-check ~'ctx)]
           (fn ~'arity-0 ~(cond-> []
                            varargs (conj '& varargs-param))
             (let [~'invoc-array (when-not (zero? ~'invoc-size)
@@ -38,7 +40,7 @@
                (loop []
                  (let [ret# (types/eval ~'body ~'ctx ~'invoc-array)]
                    (if (identical? recur# ret#)
-                     (recur)
+                     (do (when rc# (rc#)) (recur))
                      ret#))))))))
      (let [fn-params (vec (repeatedly n gensym))
            varargs-param (when varargs (gensym))
@@ -46,7 +48,8 @@
                                `(aset ~(with-meta 'invoc-array
                                          {:tag 'objects}) ~idx ~fn-param))
                              fn-params (range)))]
-       `(let [recur# recur]
+       `(let [recur# recur
+              rc# (:resource-check ~'ctx)]
           (fn ~(symbol (str "arity-" n)) ~(cond-> fn-params
                                             varargs (conj '& varargs-param))
             (let [~'invoc-array (when-not (zero? ~'invoc-size)
@@ -60,7 +63,7 @@
                (loop []
                  (let [ret# (types/eval ~'body ~'ctx ~'invoc-array)]
                    (if (identical? recur# ret#)
-                     (recur)
+                     (do (when rc# (rc#)) (recur))
                      ret#)))))))))))
 
 #_(require '[clojure.pprint :as pprint])
diff --git a/src/sci/impl/opts.cljc b/src/sci/impl/opts.cljc
index 71acd879..936be751 100644
--- a/src/sci/impl/opts.cljc
+++ b/src/sci/impl/opts.cljc
@@ -147,15 +147,17 @@
 #?(:clj (defrecord Ctx [bindings env
                         features readers
                         reload-all
-                        check-permissions]))
+                        check-permissions
+                        resource-check]))
 
-(defn ->ctx [bindings env features readers check-permissions?]
+(defn ->ctx [bindings env features readers check-permissions? & {:keys [resource-check]}]
   #?(:cljs {:bindings bindings
             :env env
             :features features
             :readers readers
-            :check-permissions check-permissions?}
-     :clj (->Ctx bindings env features readers false check-permissions?)))
+            :check-permissions check-permissions?
+            :resource-check resource-check}
+     :clj (->Ctx bindings env features readers false check-permissions? resource-check)))
 
 (def default-ns-aliases
   #?(:clj {}
@@ -176,6 +178,7 @@
            reify-fn
            proxy-fn
            deftype-fn
+           resource-check
            #?(:cljs async-load-fn)
            #?(:cljs js-libs)
            ns-aliases]}]
@@ -188,7 +191,8 @@
                      bindings (merge {'user (assoc bindings :obj utils/user-ns)}))
         _ (init-env! env aliases namespaces classes raw-classes imports
                      load-fn #?(:cljs async-load-fn) #?(:cljs js-libs) ns-aliases)
-        ctx (assoc (->ctx {} env features readers (or allow deny))
+        ctx (assoc (->ctx {} env features readers (or allow deny)
+                          :resource-check resource-check)
                    :allow (when allow (process-permissions #{} allow))
                    :deny (when deny (process-permissions #{} deny))
                    :reify-fn (or reify-fn default-reify-fn)

From 1937af81bdeab1c514344d650ff1628c53706a93 Mon Sep 17 00:00:00 2001
From: Christian Weilbach <christian@weilbach.name>
Date: Thu, 16 Apr 2026 14:02:23 -0700
Subject: [PATCH 2/5] =?UTF-8?q?Rename=20:resource-check=20=E2=86=92=20:int?=
 =?UTF-8?q?errupt-fn,=20fix=20coverage=20and=20overhead?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

- Rename the option to :interrupt-fn throughout (opts, fns, evaluator)
- Move the check to the top of gen-fn's loop: fires on every function
  entry (initial call) AND every recur, covering direct recursion,
  mutual recursion, dotimes, while, and loop/recur uniformly
- Remove the check from fn-call: it was only reachable for 20+ arg
  calls (gen-return-call generates direct (f ...) calls for 0-19 args),
  so the original placement was both insufficient and added overhead for
  existing users — now fn-call is truly zero-cost for nil :interrupt-fn
- Add rc# capture to arity-many (20+ arg) fallback in gen-fn
- Fix merge-opts to preserve :interrupt-fn when not overridden
- Add interrupt_fn_test.cljc covering recur, dotimes, direct recursion,
  mutual recursion, nil default, fork, and merge-opts propagation
---
 src/sci/impl/evaluator.cljc     |  2 --
 src/sci/impl/fns.cljc           | 15 ++++----
 src/sci/impl/opts.cljc          | 16 +++++----
 test/sci/interrupt_fn_test.cljc | 61 +++++++++++++++++++++++++++++++++
 4 files changed, 79 insertions(+), 15 deletions(-)
 create mode 100644 test/sci/interrupt_fn_test.cljc

diff --git a/src/sci/impl/evaluator.cljc b/src/sci/impl/evaluator.cljc
index d3624d4c..14852654 100644
--- a/src/sci/impl/evaluator.cljc
+++ b/src/sci/impl/evaluator.cljc
@@ -267,8 +267,6 @@
       #_`(defn ~'fn-call ~'[ctx f args]
            (apply ~'f (map #(eval ~'ctx %) ~'args)))
       `(defn ~'fn-call ~'[ctx bindings f args]
-         ;; Resource check on function calls (if configured)
-         (when-let [rc# (:resource-check ~'ctx)] (rc#))
          (case ~'(count args)
            ~@cases)))))
 
diff --git a/src/sci/impl/fns.cljc b/src/sci/impl/fns.cljc
index 7fc25d17..13f29e7c 100644
--- a/src/sci/impl/fns.cljc
+++ b/src/sci/impl/fns.cljc
@@ -26,8 +26,7 @@
    (if (zero? n)
      (let [varargs-param (when varargs (gensym))]
        `(let [recur# recur
-              ;; Cache resource-check lookup (nil if not configured)
-              rc# (:resource-check ~'ctx)]
+              rc# (:interrupt-fn ~'ctx)]
           (fn ~'arity-0 ~(cond-> []
                            varargs (conj '& varargs-param))
             (let [~'invoc-array (when-not (zero? ~'invoc-size)
@@ -38,9 +37,10 @@
                ~@(when varargs
                    [`(aset ~'invoc-array ~'vararg-idx ~varargs-param)])
                (loop []
+                 (when rc# (rc#))
                  (let [ret# (types/eval ~'body ~'ctx ~'invoc-array)]
                    (if (identical? recur# ret#)
-                     (do (when rc# (rc#)) (recur))
+                     (recur)
                      ret#))))))))
      (let [fn-params (vec (repeatedly n gensym))
            varargs-param (when varargs (gensym))
@@ -49,7 +49,7 @@
                                          {:tag 'objects}) ~idx ~fn-param))
                              fn-params (range)))]
        `(let [recur# recur
-              rc# (:resource-check ~'ctx)]
+              rc# (:interrupt-fn ~'ctx)]
           (fn ~(symbol (str "arity-" n)) ~(cond-> fn-params
                                             varargs (conj '& varargs-param))
             (let [~'invoc-array (when-not (zero? ~'invoc-size)
@@ -61,9 +61,10 @@
                ~@(when varargs
                    [`(aset ~'invoc-array ~'vararg-idx ~varargs-param)])
                (loop []
+                 (when rc# (rc#))
                  (let [ret# (types/eval ~'body ~'ctx ~'invoc-array)]
                    (if (identical? recur# ret#)
-                     (do (when rc# (rc#)) (recur))
+                     (recur)
                      ret#)))))))))))
 
 #_(require '[clojure.pprint :as pprint])
@@ -145,7 +146,8 @@
                19 (gen-fn 19)
                20 (gen-fn 20)
                ;; default case for 20+ args (used by loop)
-               (let [recur# recur]
+               (let [recur# recur
+                     rc# (:interrupt-fn ctx)]
                  (fn arity-many [& args]
                    (let [invoc-array (when-not (zero? invoc-size)
                                       (object-array invoc-size))]
@@ -156,6 +158,7 @@
                          (aset ^objects invoc-array i (first args))
                          (recur (next args) (inc i))))
                      (loop []
+                       (when rc# (rc#))
                        (let [ret (types/eval body ctx invoc-array)]
                          (if (identical? recur# ret)
                            (recur)
diff --git a/src/sci/impl/opts.cljc b/src/sci/impl/opts.cljc
index 936be751..be6913e7 100644
--- a/src/sci/impl/opts.cljc
+++ b/src/sci/impl/opts.cljc
@@ -148,16 +148,16 @@
                         features readers
                         reload-all
                         check-permissions
-                        resource-check]))
+                        interrupt-fn]))
 
-(defn ->ctx [bindings env features readers check-permissions? & {:keys [resource-check]}]
+(defn ->ctx [bindings env features readers check-permissions? & {:keys [interrupt-fn]}]
   #?(:cljs {:bindings bindings
             :env env
             :features features
             :readers readers
             :check-permissions check-permissions?
-            :resource-check resource-check}
-     :clj (->Ctx bindings env features readers false check-permissions? resource-check)))
+            :interrupt-fn interrupt-fn}
+     :clj (->Ctx bindings env features readers false check-permissions? interrupt-fn)))
 
 (def default-ns-aliases
   #?(:clj {}
@@ -178,7 +178,7 @@
            reify-fn
            proxy-fn
            deftype-fn
-           resource-check
+           interrupt-fn
            #?(:cljs async-load-fn)
            #?(:cljs js-libs)
            ns-aliases]}]
@@ -192,7 +192,7 @@
         _ (init-env! env aliases namespaces classes raw-classes imports
                      load-fn #?(:cljs async-load-fn) #?(:cljs js-libs) ns-aliases)
         ctx (assoc (->ctx {} env features readers (or allow deny)
-                          :resource-check resource-check)
+                          :interrupt-fn interrupt-fn)
                    :allow (when allow (process-permissions #{} allow))
                    :deny (when deny (process-permissions #{} deny))
                    :reify-fn (or reify-fn default-reify-fn)
@@ -226,7 +226,9 @@
         namespaces (cond-> namespaces
                      bindings (merge {'user (assoc bindings :obj utils/user-ns)}))
         _ (init-env! !env aliases namespaces classes raw-classes imports load-fn #?(:cljs async-load-fn) #?(:cljs js-libs) ns-aliases)
-        ctx (assoc (->ctx {} !env features readers (or (:check-permissions ctx) allow deny))
+        interrupt-fn (if (contains? opts :interrupt-fn) (:interrupt-fn opts) (:interrupt-fn ctx))
+        ctx (assoc (->ctx {} !env features readers (or (:check-permissions ctx) allow deny)
+                          :interrupt-fn interrupt-fn)
                    :allow (when allow (process-permissions (:allow ctx) allow))
                    :deny (when deny (process-permissions (:deny ctx) deny))
                    :reify-fn reify-fn
diff --git a/test/sci/interrupt_fn_test.cljc b/test/sci/interrupt_fn_test.cljc
new file mode 100644
index 00000000..23946b05
--- /dev/null
+++ b/test/sci/interrupt_fn_test.cljc
@@ -0,0 +1,61 @@
+(ns sci.interrupt-fn-test
+  (:require
+   [clojure.test :refer [deftest is testing]]
+   [sci.core :as sci]))
+
+(defn limit-interrupt [n]
+  (let [counter (atom 0)]
+    (fn []
+      (when (> (swap! counter inc) n)
+        (throw (ex-info "interrupted" {:type :interrupt}))))))
+
+(deftest recur-loop-test
+  (testing "interrupt-fn fires on recur and can abort infinite loop"
+    (let [ctx (sci/init {:interrupt-fn (limit-interrupt 1000)})]
+      (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+            (sci/eval-string* ctx "(loop [] (recur))"))))))
+
+(deftest dotimes-test
+  (testing "interrupt-fn fires inside dotimes (expands to loop/recur)"
+    (let [ctx (sci/init {:interrupt-fn (limit-interrupt 500)})]
+      (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+            (sci/eval-string* ctx "(dotimes [_ 1000000] nil)"))))))
+
+(deftest mutual-recursion-test
+  (testing "interrupt-fn fires on fn-call, catching mutual recursion"
+    (let [ctx (sci/init {:interrupt-fn (limit-interrupt 200)})]
+      (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+            (sci/eval-string* ctx "(declare b) (defn a [] (b)) (defn b [] (a)) (a)"))))))
+
+(deftest direct-recursion-no-recur-test
+  (testing "interrupt-fn fires on fn-call for non-recur self-calls"
+    ;; low limit to fire well before JVM stack overflow
+    (let [ctx (sci/init {:interrupt-fn (limit-interrupt 50)})]
+      (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+            (sci/eval-string* ctx "(defn f [] (f)) (f)"))))))
+
+(deftest no-interrupt-fn-test
+  (testing "nil interrupt-fn has no effect — normal execution"
+    (let [ctx (sci/init {})]
+      (is (= 10 (sci/eval-string* ctx "(loop [i 0] (if (= i 10) i (recur (inc i))))")))
+      (is (= 99 (sci/eval-string* ctx "(dotimes [i 100] i) 99"))))))
+
+(deftest interrupt-fn-result-test
+  (testing "interrupt-fn allows limited execution to complete normally"
+    (let [ctx (sci/init {:interrupt-fn (limit-interrupt 10000)})]
+      (is (= 100 (sci/eval-string* ctx "(loop [i 0] (if (= i 100) i (recur (inc i))))")))
+      (is (= 45 (sci/eval-string* ctx "(reduce + (range 10))"))))))
+
+(deftest fork-preserves-interrupt-fn-test
+  (testing "forked context inherits interrupt-fn"
+    (let [ctx (sci/init {:interrupt-fn (limit-interrupt 1000)})
+          forked (sci/fork ctx)]
+      (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+            (sci/eval-string* forked "(loop [] (recur))"))))))
+
+(deftest merge-opts-preserves-interrupt-fn-test
+  (testing "merge-opts carries interrupt-fn forward when not overridden"
+    (let [ctx (sci/init {:interrupt-fn (limit-interrupt 1000)})
+          ctx2 (sci/merge-opts ctx {:namespaces {'user {'x 1}}})]
+      (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+            (sci/eval-string* ctx2 "(loop [] (recur))"))))))

From 2bcfe803a3663336526d7d21dfe97088aacd1255 Mon Sep 17 00:00:00 2001
From: Christian Weilbach <christian@weilbach.name>
Date: Thu, 16 Apr 2026 14:08:34 -0700
Subject: [PATCH 3/5] Rename rc# -> interrupt-fn#, tighten tests

---
 src/sci/impl/fns.cljc           | 12 ++++++------
 test/sci/interrupt_fn_test.cljc | 25 +++++++++++--------------
 2 files changed, 17 insertions(+), 20 deletions(-)

diff --git a/src/sci/impl/fns.cljc b/src/sci/impl/fns.cljc
index 13f29e7c..1d8f9748 100644
--- a/src/sci/impl/fns.cljc
+++ b/src/sci/impl/fns.cljc
@@ -26,7 +26,7 @@
    (if (zero? n)
      (let [varargs-param (when varargs (gensym))]
        `(let [recur# recur
-              rc# (:interrupt-fn ~'ctx)]
+              interrupt-fn# (:interrupt-fn ~'ctx)]
           (fn ~'arity-0 ~(cond-> []
                            varargs (conj '& varargs-param))
             (let [~'invoc-array (when-not (zero? ~'invoc-size)
@@ -37,7 +37,7 @@
                ~@(when varargs
                    [`(aset ~'invoc-array ~'vararg-idx ~varargs-param)])
                (loop []
-                 (when rc# (rc#))
+                 (when interrupt-fn# (interrupt-fn#))
                  (let [ret# (types/eval ~'body ~'ctx ~'invoc-array)]
                    (if (identical? recur# ret#)
                      (recur)
@@ -49,7 +49,7 @@
                                          {:tag 'objects}) ~idx ~fn-param))
                              fn-params (range)))]
        `(let [recur# recur
-              rc# (:interrupt-fn ~'ctx)]
+              interrupt-fn# (:interrupt-fn ~'ctx)]
           (fn ~(symbol (str "arity-" n)) ~(cond-> fn-params
                                             varargs (conj '& varargs-param))
             (let [~'invoc-array (when-not (zero? ~'invoc-size)
@@ -61,7 +61,7 @@
                ~@(when varargs
                    [`(aset ~'invoc-array ~'vararg-idx ~varargs-param)])
                (loop []
-                 (when rc# (rc#))
+                 (when interrupt-fn# (interrupt-fn#))
                  (let [ret# (types/eval ~'body ~'ctx ~'invoc-array)]
                    (if (identical? recur# ret#)
                      (recur)
@@ -147,7 +147,7 @@
                20 (gen-fn 20)
                ;; default case for 20+ args (used by loop)
                (let [recur# recur
-                     rc# (:interrupt-fn ctx)]
+                     interrupt-fn# (:interrupt-fn ctx)]
                  (fn arity-many [& args]
                    (let [invoc-array (when-not (zero? invoc-size)
                                       (object-array invoc-size))]
@@ -158,7 +158,7 @@
                          (aset ^objects invoc-array i (first args))
                          (recur (next args) (inc i))))
                      (loop []
-                       (when rc# (rc#))
+                       (when interrupt-fn# (interrupt-fn#))
                        (let [ret (types/eval body ctx invoc-array)]
                          (if (identical? recur# ret)
                            (recur)
diff --git a/test/sci/interrupt_fn_test.cljc b/test/sci/interrupt_fn_test.cljc
index 23946b05..f80bba78 100644
--- a/test/sci/interrupt_fn_test.cljc
+++ b/test/sci/interrupt_fn_test.cljc
@@ -9,39 +9,36 @@
       (when (> (swap! counter inc) n)
         (throw (ex-info "interrupted" {:type :interrupt}))))))
 
-(deftest recur-loop-test
-  (testing "interrupt-fn fires on recur and can abort infinite loop"
-    (let [ctx (sci/init {:interrupt-fn (limit-interrupt 1000)})]
-      (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
-            (sci/eval-string* ctx "(loop [] (recur))"))))))
-
-(deftest dotimes-test
-  (testing "interrupt-fn fires inside dotimes (expands to loop/recur)"
+(deftest loop-forms-test
+  (testing "interrupt-fn fires in loop/recur and derived forms (dotimes, while)"
     (let [ctx (sci/init {:interrupt-fn (limit-interrupt 500)})]
       (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
-            (sci/eval-string* ctx "(dotimes [_ 1000000] nil)"))))))
+            (sci/eval-string* ctx "(loop [] (recur))")))
+      (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+            (sci/eval-string* (sci/init {:interrupt-fn (limit-interrupt 500)})
+                              "(dotimes [_ 1000000] nil)"))))))
 
 (deftest mutual-recursion-test
-  (testing "interrupt-fn fires on fn-call, catching mutual recursion"
+  (testing "interrupt-fn fires on every fn entry, catching mutual recursion"
     (let [ctx (sci/init {:interrupt-fn (limit-interrupt 200)})]
       (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
             (sci/eval-string* ctx "(declare b) (defn a [] (b)) (defn b [] (a)) (a)"))))))
 
 (deftest direct-recursion-no-recur-test
-  (testing "interrupt-fn fires on fn-call for non-recur self-calls"
+  (testing "interrupt-fn fires on fn entry for non-recur self-calls"
     ;; low limit to fire well before JVM stack overflow
     (let [ctx (sci/init {:interrupt-fn (limit-interrupt 50)})]
       (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
             (sci/eval-string* ctx "(defn f [] (f)) (f)"))))))
 
 (deftest no-interrupt-fn-test
-  (testing "nil interrupt-fn has no effect — normal execution"
+  (testing "absent interrupt-fn does not affect execution"
     (let [ctx (sci/init {})]
       (is (= 10 (sci/eval-string* ctx "(loop [i 0] (if (= i 10) i (recur (inc i))))")))
       (is (= 99 (sci/eval-string* ctx "(dotimes [i 100] i) 99"))))))
 
-(deftest interrupt-fn-result-test
-  (testing "interrupt-fn allows limited execution to complete normally"
+(deftest normal-completion-under-budget-test
+  (testing "execution completes normally when budget is not exceeded"
     (let [ctx (sci/init {:interrupt-fn (limit-interrupt 10000)})]
       (is (= 100 (sci/eval-string* ctx "(loop [i 0] (if (= i 100) i (recur (inc i))))")))
       (is (= 45 (sci/eval-string* ctx "(reduce + (range 10))"))))))

From 1b95e6f2d3b91052b8edb7ebcb9b801b8da81148 Mon Sep 17 00:00:00 2001
From: Christian Weilbach <christian@weilbach.name>
Date: Thu, 16 Apr 2026 16:57:34 -0700
Subject: [PATCH 4/5] Add interruptible host-fn wrappers for
 range/repeat/cycle/iterate/doall/dorun/count/into/reduce
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

When :interrupt-fn is provided, opts/init installs interruptible versions
of nine clojure.core functions that would otherwise bypass the interrupt
mechanism by running entirely host-side:

  Producers:     range, repeat, cycle, iterate
  Materializers: doall, dorun, count, into, reduce

Each wrapper calls store/get-ctx at invocation time to read :interrupt-fn,
so fork and merge-opts work correctly. When :interrupt-fn is absent the
original host functions are used unchanged — zero overhead for existing users.

counted? collections (vectors, maps, sets) take the fast O(1) path in count.
reduce supports reduced for early termination.
---
 src/sci/impl/interruptible.cljc | 176 ++++++++++++++++++++++++++++++++
 src/sci/impl/opts.cljc          |   3 +
 test/sci/interrupt_fn_test.cljc |  36 +++++++
 3 files changed, 215 insertions(+)
 create mode 100644 src/sci/impl/interruptible.cljc

diff --git a/src/sci/impl/interruptible.cljc b/src/sci/impl/interruptible.cljc
new file mode 100644
index 00000000..306ca532
--- /dev/null
+++ b/src/sci/impl/interruptible.cljc
@@ -0,0 +1,176 @@
+(ns sci.impl.interruptible
+  {:no-doc true}
+  (:require
+   [sci.ctx-store :as store]
+   [sci.impl.utils :as utils]))
+
+(defn- get-ifn []
+  (:interrupt-fn (store/get-ctx)))
+
+;;; Producers — lazy sequences that fire interrupt-fn on each step
+
+(defn- range-seq [start end step ifn]
+  (let [pred (cond
+               (nil? end)   (constantly true)
+               (pos? step)  #(< % end)
+               (neg? step)  #(> % end)
+               :else        (constantly false))]
+    (letfn [(gen [i]
+              (lazy-seq
+                (when (pred i)
+                  (ifn)
+                  (cons i (gen (+ i step))))))]
+      (gen start))))
+
+(defn- sci-range
+  ([]    (let [ifn (get-ifn)] (if ifn (range-seq 0 nil 1 ifn) (range))))
+  ([end] (let [ifn (get-ifn)] (if ifn (range-seq 0 end 1 ifn) (range end))))
+  ([start end]
+   (let [ifn (get-ifn)] (if ifn (range-seq start end 1 ifn) (range start end))))
+  ([start end step]
+   (let [ifn (get-ifn)] (if ifn (range-seq start end step ifn) (range start end step)))))
+
+(defn- sci-repeat
+  ([x]
+   (let [ifn (get-ifn)]
+     (if-not ifn
+       (repeat x)
+       (letfn [(gen [] (lazy-seq (ifn) (cons x (gen))))]
+         (gen)))))
+  ([n x]
+   (let [ifn (get-ifn)]
+     (if-not ifn
+       (repeat n x)
+       (letfn [(gen [i]
+                 (lazy-seq
+                   (when (pos? i)
+                     (ifn)
+                     (cons x (gen (dec i))))))]
+         (gen n))))))
+
+(defn- sci-cycle [coll]
+  (let [ifn (get-ifn)]
+    (if-not ifn
+      (cycle coll)
+      (when (seq coll)
+        (letfn [(gen [s]
+                  (lazy-seq
+                    (ifn)
+                    (let [cur (or (seq s) (seq coll))]
+                      (cons (first cur) (gen (rest cur))))))]
+          (gen coll))))))
+
+(defn- sci-iterate [f x]
+  (let [ifn (get-ifn)]
+    (if-not ifn
+      (iterate f x)
+      (letfn [(gen [v]
+                (lazy-seq
+                  (ifn)
+                  (cons v (gen (f v)))))]
+        (gen x)))))
+
+;;; Materializers — consuming functions that fire interrupt-fn per element
+
+(defn- sci-dorun
+  ([coll]
+   (let [ifn (get-ifn)]
+     (if-not ifn
+       (dorun coll)
+       (loop [s (seq coll)]
+         (when s
+           (ifn)
+           (recur (next s)))))))
+  ([n coll]
+   (let [ifn (get-ifn)]
+     (if-not ifn
+       (dorun n coll)
+       (loop [s (seq coll) i 0]
+         (when (and s (< i n))
+           (ifn)
+           (recur (next s) (inc i))))))))
+
+(defn- sci-doall
+  ([coll]
+   (let [ifn (get-ifn)]
+     (if-not ifn
+       (doall coll)
+       (do (loop [s (seq coll)]
+             (when s (ifn) (recur (next s))))
+           coll))))
+  ([n coll]
+   (let [ifn (get-ifn)]
+     (if-not ifn
+       (doall n coll)
+       (do (loop [s (seq coll) i 0]
+             (when (and s (< i n)) (ifn) (recur (next s) (inc i))))
+           coll)))))
+
+(defn- sci-count [coll]
+  (let [ifn (get-ifn)]
+    (if (or (not ifn) (counted? coll))
+      (count coll)
+      (loop [s (seq coll) n 0]
+        (if s
+          (do (ifn) (recur (next s) (inc n)))
+          n)))))
+
+(defn- sci-into
+  ([to from]
+   (let [ifn (get-ifn)]
+     (if-not ifn
+       (into to from)
+       (reduce (fn [acc x] (ifn) (conj acc x)) to from))))
+  ([to xf from]
+   (let [ifn (get-ifn)]
+     (if-not ifn
+       (into to xf from)
+       (transduce (comp (map (fn [x] (ifn) x)) xf) conj to from)))))
+
+(defn- sci-reduce
+  ([f coll]
+   (let [ifn (get-ifn)
+         s   (seq coll)]
+     (if-not ifn
+       (reduce f coll)
+       (if s
+         (loop [v (first s) s (next s)]
+           (if s
+             (do (ifn)
+                 (let [ret (f v (first s))]
+                   (if (reduced? ret) @ret (recur ret (next s)))))
+             v))
+         (f)))))
+  ([f init coll]
+   (let [ifn (get-ifn)]
+     (if-not ifn
+       (reduce f init coll)
+       (loop [v init s (seq coll)]
+         (if s
+           (do (ifn)
+               (let [ret (f v (first s))]
+                 (if (reduced? ret) @ret (recur ret (next s)))))
+           v))))))
+
+;;; Installation
+
+(defn install!
+  "Replaces dangerous host functions in the clojure.core namespace with
+  interruptible versions. Called by opts/init when :interrupt-fn is set."
+  [env]
+  (swap! env
+    (fn [e]
+      (let [core   (get-in e [:namespaces 'clojure.core])
+            ns-obj (:ns (meta (get core 'range)))
+            mk     (fn [sym f]
+                     (utils/new-var sym f {:ns ns-obj :name sym :sci/built-in true}))]
+        (update-in e [:namespaces 'clojure.core] merge
+                   {'range   (mk 'range   sci-range)
+                    'repeat  (mk 'repeat  sci-repeat)
+                    'cycle   (mk 'cycle   sci-cycle)
+                    'iterate (mk 'iterate sci-iterate)
+                    'doall   (mk 'doall   sci-doall)
+                    'dorun   (mk 'dorun   sci-dorun)
+                    'count   (mk 'count   sci-count)
+                    'into    (mk 'into    sci-into)
+                    'reduce  (mk 'reduce  sci-reduce)})))))
diff --git a/src/sci/impl/opts.cljc b/src/sci/impl/opts.cljc
index be6913e7..0eb20d1c 100644
--- a/src/sci/impl/opts.cljc
+++ b/src/sci/impl/opts.cljc
@@ -2,6 +2,7 @@
   {:no-doc true}
   (:require
    #?(:cljs [goog.string])
+   [sci.impl.interruptible :as interruptible]
    [sci.impl.namespaces :as namespaces]
    [sci.impl.types]
    [sci.impl.utils :as utils :refer [strip-core-ns]]
@@ -191,6 +192,7 @@
                      bindings (merge {'user (assoc bindings :obj utils/user-ns)}))
         _ (init-env! env aliases namespaces classes raw-classes imports
                      load-fn #?(:cljs async-load-fn) #?(:cljs js-libs) ns-aliases)
+        _ (when interrupt-fn (interruptible/install! env))
         ctx (assoc (->ctx {} env features readers (or allow deny)
                           :interrupt-fn interrupt-fn)
                    :allow (when allow (process-permissions #{} allow))
@@ -227,6 +229,7 @@
                      bindings (merge {'user (assoc bindings :obj utils/user-ns)}))
         _ (init-env! !env aliases namespaces classes raw-classes imports load-fn #?(:cljs async-load-fn) #?(:cljs js-libs) ns-aliases)
         interrupt-fn (if (contains? opts :interrupt-fn) (:interrupt-fn opts) (:interrupt-fn ctx))
+        _ (when interrupt-fn (interruptible/install! !env))
         ctx (assoc (->ctx {} !env features readers (or (:check-permissions ctx) allow deny)
                           :interrupt-fn interrupt-fn)
                    :allow (when allow (process-permissions (:allow ctx) allow))
diff --git a/test/sci/interrupt_fn_test.cljc b/test/sci/interrupt_fn_test.cljc
index f80bba78..67ec53fc 100644
--- a/test/sci/interrupt_fn_test.cljc
+++ b/test/sci/interrupt_fn_test.cljc
@@ -43,6 +43,42 @@
       (is (= 100 (sci/eval-string* ctx "(loop [i 0] (if (= i 100) i (recur (inc i))))")))
       (is (= 45 (sci/eval-string* ctx "(reduce + (range 10))"))))))
 
+(deftest host-seq-producers-test
+  (testing "interruptible range/repeat/cycle/iterate fire interrupt-fn"
+    (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+          (sci/eval-string* (sci/init {:interrupt-fn (limit-interrupt 500)})
+                            "(doall (range))")))
+    (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+          (sci/eval-string* (sci/init {:interrupt-fn (limit-interrupt 500)})
+                            "(doall (repeat :x))")))
+    (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+          (sci/eval-string* (sci/init {:interrupt-fn (limit-interrupt 500)})
+                            "(doall (cycle [1 2 3]))")))
+    (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+          (sci/eval-string* (sci/init {:interrupt-fn (limit-interrupt 500)})
+                            "(doall (iterate inc 0))")))))
+
+(deftest host-materializers-test
+  (testing "interruptible doall/dorun/count/into/reduce fire interrupt-fn on host sequences"
+    (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+          (sci/eval-string* (sci/init {:interrupt-fn (limit-interrupt 500)})
+                            "(reduce + (range))")))
+    (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+          (sci/eval-string* (sci/init {:interrupt-fn (limit-interrupt 500)})
+                            "(count (range))")))
+    (is (thrown-with-msg? #?(:clj Exception :cljs js/Error) #"interrupted"
+          (sci/eval-string* (sci/init {:interrupt-fn (limit-interrupt 500)})
+                            "(into [] (range))")))))
+
+(deftest host-fns-no-overhead-test
+  (testing "absent interrupt-fn: host functions are unaffected"
+    (let [ctx (sci/init {})]
+      (is (= [0 1 2] (sci/eval-string* ctx "(vec (range 3))")))
+      (is (= 3       (sci/eval-string* ctx "(count [1 2 3])")))
+      (is (= 6       (sci/eval-string* ctx "(reduce + [1 2 3])")))
+      (is (= [1 1 1] (sci/eval-string* ctx "(vec (take 3 (repeat 1)))")))
+      (is (= [0 1 2] (sci/eval-string* ctx "(vec (take 3 (iterate inc 0)))")))))  )
+
 (deftest fork-preserves-interrupt-fn-test
   (testing "forked context inherits interrupt-fn"
     (let [ctx (sci/init {:interrupt-fn (limit-interrupt 1000)})

From 24762a163ef5b25c692d0e5cd4ea63a5bd6b0a16 Mon Sep 17 00:00:00 2001
From: Christian Weilbach <christian@weilbach.name>
Date: Fri, 8 May 2026 01:53:28 -0700
Subject: [PATCH 5/5] Address PR review feedback
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

- Restore unrelated TODO and prn debug comments in fn-call macro that
  were accidentally removed when the resource-check block was removed.
- Use (when (some? interrupt-fn#) ...) instead of (when interrupt-fn# ...)
  in gen-fn hot paths — faster on CLJS, semantically equivalent since
  interrupt-fn# is always either a fn or nil.
---
 src/sci/impl/evaluator.cljc | 2 ++
 src/sci/impl/fns.cljc       | 6 +++---
 2 files changed, 5 insertions(+), 3 deletions(-)

diff --git a/src/sci/impl/evaluator.cljc b/src/sci/impl/evaluator.cljc
index 14852654..f51389f8 100644
--- a/src/sci/impl/evaluator.cljc
+++ b/src/sci/impl/evaluator.cljc
@@ -267,6 +267,8 @@
       #_`(defn ~'fn-call ~'[ctx f args]
            (apply ~'f (map #(eval ~'ctx %) ~'args)))
       `(defn ~'fn-call ~'[ctx bindings f args]
+         ;; TODO: can we prevent hitting this at all, by analyzing more efficiently?
+         ;; (prn :count ~'f ~'(count args) ~'args)
          (case ~'(count args)
            ~@cases)))))
 
diff --git a/src/sci/impl/fns.cljc b/src/sci/impl/fns.cljc
index 1d8f9748..adf74ee6 100644
--- a/src/sci/impl/fns.cljc
+++ b/src/sci/impl/fns.cljc
@@ -37,7 +37,7 @@
                ~@(when varargs
                    [`(aset ~'invoc-array ~'vararg-idx ~varargs-param)])
                (loop []
-                 (when interrupt-fn# (interrupt-fn#))
+                 (when (some? interrupt-fn#) (interrupt-fn#))
                  (let [ret# (types/eval ~'body ~'ctx ~'invoc-array)]
                    (if (identical? recur# ret#)
                      (recur)
@@ -61,7 +61,7 @@
                ~@(when varargs
                    [`(aset ~'invoc-array ~'vararg-idx ~varargs-param)])
                (loop []
-                 (when interrupt-fn# (interrupt-fn#))
+                 (when (some? interrupt-fn#) (interrupt-fn#))
                  (let [ret# (types/eval ~'body ~'ctx ~'invoc-array)]
                    (if (identical? recur# ret#)
                      (recur)
@@ -158,7 +158,7 @@
                          (aset ^objects invoc-array i (first args))
                          (recur (next args) (inc i))))
                      (loop []
-                       (when interrupt-fn# (interrupt-fn#))
+                       (when (some? interrupt-fn#) (interrupt-fn#))
                        (let [ret (types/eval body ctx invoc-array)]
                          (if (identical? recur# ret)
                            (recur)