wip

Author: borkdude

doc/issues/stacktrace-at-point-of-execution.md

@@ -31,88 +31,99 @@ When catching exceptions with `^:sci/error`, you only get the immediate error fr
 
 This is because the stack is built during exception **propagation**. When you catch early with `^:sci/error`, propagation stops and you only get the immediate frame.
 
-## Solution
+## Why Analysis-Time Only Doesn't Work
 
-Maintain a runtime call stack that gets pushed/popped as functions are entered/exited. The **infrastructure** (push/pop code) is generated at analysis time, but executes at runtime - exactly like the existing exception handling try/catch wrappers.
+Each node gets its stack frame embedded at analysis time. However, **function bodies are analyzed once at definition time**, not re-analyzed at each call site.
 
-## How Exception Stack Works (for reference)
+Example:
+```clojure
+(defn inner [] (current-stacktrace))  ;; analyzed here - don't know who will call inner
+(defn outer [] (inner))               ;; creates call node, but inner's body already analyzed
+(outer)
+```
 
-Currently, when an exception occurs:
-1. Each function call is wrapped in try/catch (set up at analysis time)
-2. When exception is thrown, each wrapper catches it, adds its frame via `rethrow-with-location-of-node`, and rethrows
-3. Stack is built up as exception propagates
+When `(current-stacktrace)` inside `inner` is analyzed, `outer` doesn't exist yet. The runtime call chain (`outer` -> `inner`) can only be known at runtime.
 
-Example output from `bb`:
-```
-user/inner - /tmp/test.bb:1:16
-user/inner - /tmp/test.bb:1:1
-user/outer - /tmp/test.bb:2:16
-user/outer - /tmp/test.bb:2:1
-user       - /tmp/test.bb:3:1
-```
+## Solution: Runtime Tracking with Minimal Overhead
 
-## Proposed Approach
+Each node already has its stack frame embedded at analysis time. We add push/pop at runtime, but with **near-zero overhead when not enabled**.
 
-Similar to exception handling, but track the stack actively:
+### How It Works
 
-1. **At analysis time**: Modify `gen-return-call` to wrap function calls with push/pop logic
-2. **At runtime**: Each call pushes its frame to a thread-local stack, executes, then pops
-3. **`current-stacktrace`**: Simply reads the current stack
+1. **`*call-stack*` dynamic var** (in utils.cljc): `nil` by default
+2. **Push/pop functions** only do work when `*call-stack*` is non-nil:
+   ```clojure
+   (defn push-call-stack! [frame]
+     (when *call-stack*           ;; nil check = near-zero overhead
+       (vswap! *call-stack* conj frame)))
+   ```
+3. **To enable tracking**: bind `*call-stack*` to `(volatile! [])`
+4. **`current-stacktrace`**: reads from the volatile
 
 ### Implementation
 
-In `gen-return-call` (analyzer.cljc), wrap calls like:
+**1. Modify `gen-return-call`** (analyzer.cljc) - add push/pop around calls:
 
 ```clojure
-;; Pseudocode for generated node
-(let [stack-frame {...}]  ;; computed at analysis time
-  (push-frame! stack-frame)
+;; Inside ->Node body (runs at runtime):
+(do
+  (utils/push-call-stack! stack)  ;; stack is the node's frame, set at analysis time
   (try
     (f arg0 arg1 ...)
+    (catch Throwable e
+      (rethrow-with-location-of-node ctx bindings e this))
     (finally
-      (pop-frame!))))
+      (utils/pop-call-stack!))))
 ```
 
-The stack would be stored in a dynamic var or thread-local, similar to how `*in-try*` works.
-
-### API
+**2. `current-stacktrace`** (core.cljc):
 
 ```clojure
-;; Host-level API
-(sci.core/current-stacktrace)
-;; => [{:ns user :name outer :file "script.clj" :line 2 :column 16}
-;;     {:ns user :name foo :file "script.clj" :line 3 :column 1}]
-
-;; Host exposes to users as they wish:
-(def ctx (sci/init {:namespaces
-                    {'debug {'stacktrace sci.core/current-stacktrace}}}))
+(defn current-stacktrace []
+  (utils/get-call-stack))
 ```
 
 ### Files to modify
 
 | File | Changes |
 |------|---------|
 | `src/sci/impl/analyzer.cljc` | Modify `gen-return-call` to add push/pop around calls |
-| `src/sci/impl/utils.cljc` | Add dynamic var for current call stack, push/pop functions |
-| `src/sci/core.cljc` | Add `current-stacktrace` public function |
+| `src/sci/impl/utils.cljc` | ✅ Already done: `*call-stack*`, `push-call-stack!`, `pop-call-stack!`, `get-call-stack` |
+| `src/sci/core.cljc` | Update `current-stacktrace` to call `utils/get-call-stack` |
 
-### Performance consideration
+### Performance
 
-This adds overhead to every function call. Options:
-1. Always enabled (simpler, some overhead)
-2. Opt-in via context flag `{:track-stacktrace true}`
-3. Only enable when `current-stacktrace` is used in the code (analyzer detects usage)
+- **When not tracking** (`*call-stack*` is nil): just a nil check per function call
+- **When tracking**: push/pop on volatile per function call
+
+### API Usage
+
+```clojure
+;; Host enables tracking by binding *call-stack*:
+(binding [sci.impl.utils/*call-stack* (volatile! [])]
+  (sci/eval-string* ctx "(outer)"))
+
+;; Or expose via context for SCI code to use:
+(def ctx (sci/init {:namespaces
+                    {'debug {'stacktrace sci/current-stacktrace}}}))
+```
 
 ## Verification
 
+Test in `test/sci/error_test.cljc`:
+
 ```clojure
 (deftest current-stacktrace-test
-  (let [result (sci/eval-string "
+  (testing "returns call chain at point of execution"
+    (let [ctx (sci/init {:namespaces {'sci.core {'current-stacktrace sci/current-stacktrace}}})
+          stacktrace (sci/binding [sci/file "test.clj"]
+                       (sci/eval-string* ctx "
 (defn inner [] (sci.core/current-stacktrace))
 (defn outer [] (inner))
-(outer)")]
-    ;; Should show outer as caller, not inner (inner is current fn)
-    (is (= 'outer (:name (first result))))))
+(outer)"))]
+      (is (= [{:ns 'user, :name 'inner, :file "test.clj", :line 2, :column 16}
+              {:ns 'user, :name 'outer, :file "test.clj", :line 3, :column 15}]
+             (mapv #(select-keys % [:ns :name :file :line :column]) stacktrace))))))
 ```
 
 Run: `script/test/jvm`

src/sci/core.cljc

@@ -359,6 +359,14 @@
   [stacktrace]
   (cs/format-stacktrace stacktrace))
 
+(defn current-stacktrace
+  "Returns the current call stack at the point of invocation.
+   Returns a list of stack frame maps with keys :ns, :name, :file, :line, :column.
+   Only works when *call-stack* is bound (via binding)."
+  []
+  (when-let [stack (utils/get-call-stack)]
+    (cs/stacktrace (volatile! stack))))
+
 (defn ns-name
   "Returns name of SCI ns as symbol."
   [sci-ns]

src/sci/impl/analyzer.cljc

@@ -1342,30 +1342,48 @@
                               [i `(let ~binds
                                     (if ~'wrap
                                       (sci.impl.types/->Node
-                                       (try
-                                         ((~'wrap ~'ctx ~'bindings ~'f)
-                                          ~@(map (fn [j]
-                                                   `(t/eval ~(symbol (str "arg" j)) ~'ctx ~'bindings))
-                                                 (range i)))
-                                         (catch ~(macros/? :clj 'Throwable :cljs 'js/Error) e#
-                                           (rethrow-with-location-of-node ~'ctx ~'bindings e# ~'this)))
+                                       (do
+                                         (utils/push-call-stack! ~'stack)
+                                         (try
+                                           ((~'wrap ~'ctx ~'bindings ~'f)
+                                            ~@(map (fn [j]
+                                                     `(t/eval ~(symbol (str "arg" j)) ~'ctx ~'bindings))
+                                                   (range i)))
+                                           (catch ~(macros/? :clj 'Throwable :cljs 'js/Error) e#
+                                             (rethrow-with-location-of-node ~'ctx ~'bindings e# ~'this))
+                                           (finally
+                                             (utils/pop-call-stack!))))
                                        ~'stack)
                                       (sci.impl.types/->Node
-                                       (try
-                                         (~'f
-                                          ~@(map (fn [j]
-                                                   `(t/eval ~(symbol (str "arg" j)) ~'ctx ~'bindings))
-                                                 (range i)))
-                                         (catch ~(macros/? :clj 'Throwable :cljs 'js/Error) e#
-                                           (rethrow-with-location-of-node ~'ctx ~'bindings e# ~'this)))
+                                       (do
+                                         (utils/push-call-stack! ~'stack)
+                                         (try
+                                           (~'f
+                                            ~@(map (fn [j]
+                                                     `(t/eval ~(symbol (str "arg" j)) ~'ctx ~'bindings))
+                                                   (range i)))
+                                           (catch ~(macros/? :clj 'Throwable :cljs 'js/Error) e#
+                                             (rethrow-with-location-of-node ~'ctx ~'bindings e# ~'this))
+                                           (finally
+                                             (utils/pop-call-stack!))))
                                        ~'stack)))])
                             let-bindings)
                     `[(if ~'wrap
                         (sci.impl.types/->Node
-                         (eval/fn-call ~'ctx ~'bindings (~'wrap ~'ctx ~'bindings ~'f) ~'analyzed-children)
+                         (do
+                           (utils/push-call-stack! ~'stack)
+                           (try
+                             (eval/fn-call ~'ctx ~'bindings (~'wrap ~'ctx ~'bindings ~'f) ~'analyzed-children)
+                             (finally
+                               (utils/pop-call-stack!))))
                          ~'stack)
                         (sci.impl.types/->Node
-                         (eval/fn-call ~'ctx ~'bindings ~'f ~'analyzed-children)
+                         (do
+                           (utils/push-call-stack! ~'stack)
+                           (try
+                             (eval/fn-call ~'ctx ~'bindings ~'f ~'analyzed-children)
+                             (finally
+                               (utils/pop-call-stack!))))
                          ~'stack))]))
                tag# ~'(:tag (meta expr))]
            (cond-> node#

src/sci/impl/utils.cljc

@@ -273,6 +273,21 @@
                {:ns clojure-core-ns
                 :doc "A sci.lang.Namespace object representing the current namespace."}))
 
+;; Call stack for current-stacktrace
+(def ^:dynamic *call-stack* nil)
+
+(defn push-call-stack! [frame]
+  (when *call-stack*
+    (vswap! *call-stack* conj frame)))
+
+(defn pop-call-stack! []
+  (when *call-stack*
+    (vswap! *call-stack* pop)))
+
+(defn get-call-stack []
+  (when *call-stack*
+    @*call-stack*))
+
 (defn current-ns-name []
   (let [curr-ns @current-ns]
     (if (symbol? curr-ns) curr-ns (t/getName curr-ns))))

test/sci/error_test.cljc

@@ -2,7 +2,8 @@
   (:require #?(:clj [sci.addons.future :as fut])
             #?(:cljs [clojure.string :as str])
             [clojure.test :as t :refer [deftest testing is]]
-            [sci.core :as sci :refer [eval-string]]))
+            [sci.core :as sci :refer [eval-string]]
+            [sci.impl.utils :as utils]))
 
 #?(:cljs (def Exception js/Error))
 
@@ -59,6 +60,29 @@
                  "user   - NO_SOURCE_PATH:1:34")
                formatted))))))
 
+(deftest current-stacktrace-test
+  (testing "returns call chain at point of execution"
+    (let [ctx (sci/init {:namespaces {'sci.core {'current-stacktrace sci/current-stacktrace}}})
+          stacktrace (binding [utils/*call-stack* (volatile! [])]
+                       (sci/binding [sci/file "test.clj"]
+                         (sci/eval-string* ctx "
+(defn inner [] (sci.core/current-stacktrace))
+(defn outer [] (inner))
+(outer)")))
+          ;; Remove nil :name entries from the result
+          clean-frame (fn [m]
+                        (let [m (select-keys m [:ns :name :file :line :column])]
+                          (if (nil? (:name m))
+                            (dissoc m :name)
+                            m)))]
+      ;; Full call chain like exception stack trace
+      (is (= [{:ns 'user, :name 'inner, :file "test.clj", :line 2, :column 16}
+              {:ns 'user, :name 'inner, :file "test.clj", :line 2, :column 1}
+              {:ns 'user, :name 'outer, :file "test.clj", :line 3, :column 16}
+              {:ns 'user, :name 'outer, :file "test.clj", :line 3, :column 1}
+              {:ns 'user, :file "test.clj", :line 4, :column 1}]
+             (mapv clean-frame stacktrace))))))
+
 #_(deftest locals-test
     (testing "defn does not introduce fn-named local binding"
       (let [locals