Move callstack to exception rather than tracking in ctx (#621)

Author: borkdude

src/sci/impl/interpreter.cljc

@@ -24,41 +24,6 @@
   (prn (zipmap (keys @stats)
                (map #(/ (double %) 1000000.0) (vals @stats)))))
 
-#_(defn eval-form-stats [ctx form]
-  (if (seq? form)
-    (if (= 'do (first form))
-      (loop [exprs (rest form)
-             ret nil]
-        (if (seq exprs)
-          (recur
-           (rest exprs)
-           (eval-form-stats ctx (first exprs)))
-          ret))
-      (when (or (not (:uberscript ctx))
-                (= 'ns (first form))
-                (= 'require (first form)))
-        (let [#?@(:clj [a0 (System/nanoTime)])
-              analyzed (ana/analyze ctx form true)
-              #?@(:clj [a1 (System/nanoTime)
-                        _ (update-stats ctx :analysis (- a1 a0))])
-              ret (if (instance? sci.impl.types.EvalForm analyzed)
-                    (eval-form-stats ctx (t/getVal analyzed))
-                    (let [#?@(:clj [e0 (System/nanoTime)])
-                          ret (eval/eval ctx analyzed)
-                          #?@(:clj [e1 (System/nanoTime)
-                                    _ (update-stats ctx :eval (- e1 e0))])]
-                      ret))]
-          ret)))
-    (let [#?@(:clj [t0 (System/nanoTime)])
-          analyzed (ana/analyze ctx form)
-          #?@(:clj [t1 (System/nanoTime)
-                    _ (update-stats ctx :analysis (- t1 t0))])
-          #?@(:clj [t0 (System/nanoTime)])
-          ret (eval/eval ctx analyzed)
-          #?@(:clj [t1 (System/nanoTime)
-                    _ (update-stats ctx :eval (- t1 t0))])]
-      ret)))
-
 (defn eval-form [ctx form]
   (if (seq? form)
     (if (= 'do (first form))
@@ -74,7 +39,8 @@
                 (= 'require (first form)))
         (let [analyzed (ana/analyze ctx form true)
               bindings (:bindings ctx)
-              ret (if (instance? sci.impl.types.EvalForm analyzed)
+              ret (if (instance? #?(:clj sci.impl.types.EvalForm
+                                    :cljs sci.impl.types/EvalForm) analyzed)
                     (eval-form ctx (t/getVal analyzed))
                     (eval/eval ctx bindings analyzed))]
           ret)))
@@ -83,43 +49,17 @@
           ret (eval/eval ctx bindings analyzed)]
       ret)))
 
-;; #?(:clj
-;;    (when (System/getenv "SCI_STATS")
-;;      (alter-var-root #'eval-form (constantly eval-form-stats))))
-
 (vreset! utils/eval-form-state eval-form)
 
-;; with stats
-(defn eval-string-stats [ctx s]
-  (let [ctx (assoc ctx :id (or (:id ctx) (gensym)))]
-    (vars/with-bindings {vars/current-ns @vars/current-ns}
-      (let [reader (r/indexing-push-back-reader (r/string-push-back-reader s))]
-        (loop [ret nil]
-          (let [#?@(:clj [t0 (System/nanoTime)])
-                expr (p/parse-next ctx reader)
-                #?@(:clj [t1 (System/nanoTime)
-                          _ (update-stats ctx :parse (- t1 t0))])]
-            (if (utils/kw-identical? p/eof expr)
-              (do
-                (print-stats)
-                ret)
-              (let [ret (eval-form ctx expr)]
-                (recur ret)))))))))
-
 (defn eval-string* [ctx s]
-  (let [ctx (assoc ctx :id (or (:id ctx) (gensym)))]
-    (vars/with-bindings {vars/current-ns @vars/current-ns}
-      (let [reader (r/indexing-push-back-reader (r/string-push-back-reader s))]
-        (loop [ret nil]
-          (let [expr (p/parse-next ctx reader)]
-            (if (utils/kw-identical? p/eof expr)
-              ret
-              (let [ret (eval-form ctx expr)]
-                (recur ret)))))))))
-
-#?(:clj
-   (when (System/getenv "SCI_STATS")
-     (alter-var-root #'eval-string* (constantly eval-string-stats))))
+  (vars/with-bindings {vars/current-ns @vars/current-ns}
+    (let [reader (r/indexing-push-back-reader (r/string-push-back-reader s))]
+      (loop [ret nil]
+        (let [expr (p/parse-next ctx reader)]
+          (if (utils/kw-identical? p/eof expr)
+            ret
+            (let [ret (eval-form ctx expr)]
+              (recur ret))))))))
 
 (vreset! utils/eval-string* eval-string*)
 

src/sci/impl/utils.cljc

@@ -48,16 +48,22 @@
              fm (or (:sci.impl/f-meta stack)
                     (some-> f meta))
              env (:env ctx)
-             id (:id ctx)]
+             id (:id ctx)
+             d (ex-data e)
+             st (or (when-let [st (:sci.impl/callstack d)]
+                      st)
+                    (volatile! '()))]
          (when stack
            (when-not (:special stack)
-             (swap! env update-in [:sci.impl/callstack id]
+             #_(swap! env update-in [:sci.impl/callstack id]
                     (fn [vt]
                       (if vt
                         (do (vswap! vt conj stack)
                            vt)
-                        (volatile! (list stack)))))))
+                        (volatile! (list stack)))))
+             (vswap! st conj stack)))
          (let [d (ex-data e)
+               ;; st (:sci.impl/callstack d)
                wrapping-sci-error? (isa? (:type d) :sci/error)]
            (if wrapping-sci-error?
              (throw e)
@@ -80,7 +86,8 @@
                                     :column column
                                     :message ex-msg
                                     :sci.impl/callstack
-                                    (delay (when-let
+                                    st
+                                    #_(delay (when-let
                                                [v (get-in @(:env ctx) [:sci.impl/callstack (:id ctx)])]
                                              @v))
                                     :file file