Skip to content

Commit

Permalink
reinstate async stack traces
Browse files Browse the repository at this point in the history
  • Loading branch information
@xificurC
xificurC committed Nov 3, 2023
1 parent cc68c2d commit fc49aaa
Show file tree
Hide file tree
Showing 8 changed files with 227 additions and 108 deletions.
4 changes: 2 additions & 2 deletions src/hyperfiddle/electric/impl/expand.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -93,9 +93,9 @@
(list* 'binding (into [] (comp (partition-all 2) (mapcat (fn [[sym v]] [sym (-all v env)]))) bs)
(mapv #(-all % env) body)))

(::lang/toggle) (concat (take 2 o)
(::lang/toggle) (concat (take 3 o)
(let [env (assoc env ::lang/current (second o))]
(mapv (fn-> -all env) (nnext o))))
(mapv (fn-> -all env) (drop 3 o))))

#_else
(if (symbol? (first o))
Expand Down
77 changes: 70 additions & 7 deletions src/hyperfiddle/electric/impl/io_ic.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,9 +11,10 @@
#?(:clj [clojure.tools.logging :as log])
[hyperfiddle.electric.debug :as dbg]
[hyperfiddle.rcf :as rcf :refer [tests with tap %]]
#?(:cljs [com.cognitect.transit.types]))
#?(:cljs [com.cognitect.transit.types])
[hyperfiddle.electric.impl.array-fields :as a])
(:import (missionary Cancelled)
(hyperfiddle.electric Failure Pending Remote)
(hyperfiddle.electric Failure Pending Remote FailureInfo)
#?(:clj (java.nio ByteBuffer))
#?(:clj (java.io ByteArrayInputStream ByteArrayOutputStream))
#?(:clj (clojure.lang IReduceInit))))
Expand All @@ -29,15 +30,64 @@
(fn [x] nil)
(fn [_] "")))

(defn ->cache "Builds a minimal, cljc map/bounded-queue cache.
One slot per key (map).
Reaching `size` pops oldest value (bounded-queue)." [size]
(doto (object-array (inc (* size 2))) (a/set (* size 2) 0)))
(defn cache-add [cache k v]
(when-not (loop [i 0]
(when (< i (dec (count cache)))
(if (= k (a/get cache i))
(do (a/set cache (inc i) v) true)
(recur (+ i 2)))))
(let [widx (a/getswap cache (dec (count cache)) #(mod (+ % 2) (dec (count cache))))]
(a/set cache widx k, (inc widx) v))))
(defn cache-get [cache k]
(loop [i 0]
(when (< i (dec (count cache)))
(if (= k (a/get cache i))
(a/get cache (inc i))
(recur (+ i 2))))))
(defn cache->map [cache]
(loop [i 0, ac (transient {})]
(if (< i (dec (count cache)))
(recur (+ i 2) (assoc! ac (a/get cache i) (a/get cache (inc i))))
(persistent! ac))))

(tests "keyed cache"
(def !c (->cache 1))
(cache-add !c 1 2) (cache-get !c 1) := 2
(cache-add !c 1 3) (cache-get !c 1) := 3
(cache-add !c 2 4) (cache-get !c 2) := 4
(cache->map !c) := {2 4}

"size 2"
(def !c (->cache 2))
(cache-add !c 1 1)
(cache-add !c 2 2)
(cache-add !c 2 2)
(cache->map !c) := {1 1, 2 2})

(def !ex-cache (->cache 16))
(defn save-original-ex! [fi]
(let [id (dbg/ex-id fi)]
(when-some [cause (ex-cause fi)]
(when-not (instance? FailureInfo cause)
(cache-add !ex-cache id cause)))
id))
(defn get-original-ex [id] (cache-get !ex-cache id))

(def ^:dynamic *write-handlers* nil)

(def failure-writer (t/write-handler
(fn [_] "failure")
(fn [x]
(let [err (.-error ^Failure x)]
(cond (instance? Cancelled err) :cancelled
(instance? Pending err) :pending
:else (do (prn err) :remote))))))
(cond (instance? Cancelled err) [:cancelled]
(instance? Pending err) [:pending]
(instance? Remote err) [:remote (dbg/serializable (ex-data err))]
:else [:exception (ex-message err) (dbg/serializable (ex-data err))
(save-original-ex! err)])))))

(defn write-opts []
{:handlers (merge *write-handlers*
Expand All @@ -48,9 +98,12 @@
(def ^:dynamic *read-handlers* nil)

(def failure-reader (t/read-handler
(fn [tag]
(fn [[tag & args]]
(case tag
:remote (Failure. (Remote.))
:exception (let [[message data id] args]
(Failure. (dbg/ex-info* message data id nil)))
:remote (let [[data] args]
(Failure. (dbg/ex-info* "Remote error" (or data {}))))
:pending (Failure. (Pending.))
:cancelled (Failure. (Cancelled.))))))

Expand Down Expand Up @@ -134,6 +187,16 @@
(catch #?(:clj Throwable :cljs :default) t
(throw (ex-info "Failed to decode" {:value x} t)))))

(tests "FailureInfo"
(def cause (ex-info "boom" {}))
(def ex (dbg/ex-info* "x" {} cause))
(def sent (-> ex Failure. encode decode .-error))
"keeps the ID across the wire"
(dbg/ex-id ex) := (dbg/ex-id sent)
"can restore cause"
(get-original-ex (dbg/ex-id sent)) := cause
nil)

; Jetty rejects websocket payloads larger than 65536 bytes by default
; We’ll chop messages if needed
(def chunk-size (bit-shift-right 65536 2))
Expand Down
126 changes: 75 additions & 51 deletions src/hyperfiddle/electric/impl/lang.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,39 +13,44 @@
[hyperfiddle.electric.debug :as dbg]
[hyperfiddle.rcf :refer [tests]]))

(def ^{::type ::node, :macro true, :doc "for loop/recur impl"} rec)
(def ^{::type ::node, :macro true, :doc "for runtime arity check"} %arity)
(def ^{::type ::node, :macro true, :doc "for self-recur"} %closure)
(def ^{::type ::node, :macro true, :doc "for try/catch"} exception)
(def ^{::type ::node, :doc "for loop/recur impl"} rec)
(def ^{::type ::node, :doc "for runtime arity check"} %arity)
(def ^{::type ::node, :doc "for self-recur"} %closure)
(def ^{::type ::node, :doc "for try/catch"} exception)
(def ^{::type ::node, :doc "for case"} %case-test)
(def ^{::type ::node, :doc "In a `catch` block, bound by the runtime to the current stacktrace. An Electric stacktrace is an ExceptionInfo. Use `hyperfiddle.electric.debug/stack-trace` to get a string representation."}
trace {:fn (fn [_frame _vars _env] (r/pure nil)),
:get-dependent-nodes #()
:noutput 0, :ninput 0, :nvariable 0, :nsource 0, :ntarget 0, :dynamic '[], :nconstant 0})

(def arg-sym
(map (comp symbol
(partial intern *ns*)
(fn [i]
(with-meta (symbol (str "%" i))
{:macro true ::type ::node})))
{::type ::node})))
(range)))
;; pre-define the first 20 for e/fn varargs expansion
(def ^{::type ::node, :macro true} %0)
(def ^{::type ::node, :macro true} %1)
(def ^{::type ::node, :macro true} %2)
(def ^{::type ::node, :macro true} %3)
(def ^{::type ::node, :macro true} %4)
(def ^{::type ::node, :macro true} %5)
(def ^{::type ::node, :macro true} %6)
(def ^{::type ::node, :macro true} %7)
(def ^{::type ::node, :macro true} %8)
(def ^{::type ::node, :macro true} %9)
(def ^{::type ::node, :macro true} %10)
(def ^{::type ::node, :macro true} %11)
(def ^{::type ::node, :macro true} %12)
(def ^{::type ::node, :macro true} %13)
(def ^{::type ::node, :macro true} %14)
(def ^{::type ::node, :macro true} %15)
(def ^{::type ::node, :macro true} %16)
(def ^{::type ::node, :macro true} %17)
(def ^{::type ::node, :macro true} %18)
(def ^{::type ::node, :macro true} %19)
(def ^{::type ::node} %0)
(def ^{::type ::node} %1)
(def ^{::type ::node} %2)
(def ^{::type ::node} %3)
(def ^{::type ::node} %4)
(def ^{::type ::node} %5)
(def ^{::type ::node} %6)
(def ^{::type ::node} %7)
(def ^{::type ::node} %8)
(def ^{::type ::node} %9)
(def ^{::type ::node} %10)
(def ^{::type ::node} %11)
(def ^{::type ::node} %12)
(def ^{::type ::node} %13)
(def ^{::type ::node} %14)
(def ^{::type ::node} %15)
(def ^{::type ::node} %16)
(def ^{::type ::node} %17)
(def ^{::type ::node} %18)
(def ^{::type ::node} %19)

(defn get-configs-to-compile [conf lang]
(into #{}
Expand Down Expand Up @@ -101,8 +106,6 @@
(->case-picker-map '((1 2) 4)) := {1 0, 2 0, 4 1}
(->case-picker-map '([a b])) := {'[a b] 0})

(def ^{::type ::node, :macro true, :doc "for case"} %case-test)

(defn- find-node-signifier [sym env]
(case (get (::peers env) (::me env))
:clj (when-some [^clojure.lang.Var vr (resolve env sym)]
Expand Down Expand Up @@ -292,7 +295,9 @@
(some-fn
~@(map (fn [[c s & body]]
(let [f `(partial (::inject exception)
(::closure (let [~s exception] ~@body)
(::closure (let [~s (dbg/unwrap exception)]
(binding [trace exception]
~@body))
{::dbg/type :catch, ::dbg/args [~c ~s]}))]
(case c
(:default Throwable)
Expand All @@ -301,14 +306,16 @@
~body)) finally)))))

(defn ->class-method-call [clazz method method-args env]
(apply ir/apply (ir/eval (let [margs (repeatedly (count method-args) gensym)]
`(fn [~@margs] (. ~clazz ~method ~@margs))))
(apply ir/apply (assoc (ir/eval (let [margs (repeatedly (count method-args) gensym)]
`(fn [~@margs] (. ~clazz ~method ~@margs))))
::dbg/action :static-call, ::dbg/target clazz, ::dbg/method method, ::dbg/args method-args)
(mapv #(analyze-me env %) method-args)))

(defn ->obj-method-call [o method method-args env]
(apply ir/apply (ir/eval (let [margs (repeatedly (count method-args) gensym)
oo (with-meta (gensym "o") (merge (::meta (find-electric-local o env)) (meta o)))]
`(fn [~oo ~@margs] (. ~oo ~method ~@margs))))
(apply ir/apply (assoc (ir/eval (let [margs (repeatedly (count method-args) gensym)
oo (with-meta (gensym "o") (merge (::meta (find-electric-local o env)) (meta o)))]
`(fn [~oo ~@margs] (. ~oo ~method ~@margs))))
::dbg/action :call, ::dbg/target o, ::dbg/method method, ::dbg/args method-args)
(analyze-me env o)
(mapv #(analyze-me env %) method-args)))

Expand All @@ -333,6 +340,16 @@
(when (class? cls)
(clojure.lang.Reflector/getField cls (name sym) true)))))

(defn source-map
([env debug-info]
(let [file (if (:js-globals env) (:file (:meta (:ns env)))
(some-> env :ns find-ns meta :file))]
(if (some? file)
(merge {:file file} debug-info)
(or debug-info {})))))

(defn keep-if [pred v] (when (pred v) v))

(defn analyze-me [env form]
(cond
(and (seq? form) (seq form))
Expand All @@ -358,8 +375,9 @@
(quote) (ir/literal (first args))

(js*) (if-some [[f & args] args]
(apply ir/apply (ir/eval (let [args (repeatedly (count args) gensym)]
`(fn [~@args] (~'js* ~f ~@args))))
(apply ir/apply (assoc (ir/eval (let [args (repeatedly (count args) gensym)]
`(fn [~@args] (~'js* ~f ~@args))))
::dbg/action :js-call)
(mapv #(analyze-me env %) args))
(throw (ex-info "Wrong number of arguments - js*" {})))

Expand All @@ -370,7 +388,9 @@
(doseq [[bs & body] arities] ; checks for invalid calls, may throw
(analyze-me (with-interop-locals env bs) (cons 'do body)))
(let [[form refs] (closure env (cons 'fn* args))]
(apply ir/apply (ir/eval form) (mapv #(analyze-me env %) refs))))
(apply ir/apply (assoc (ir/eval form)
::dbg/action :fn-call, ::dbg/name (keep-if symbol? (first args)))
(mapv #(analyze-me env %) refs))))

;; (letfn* [foo (fn* foo ([x] x))] ...)
(letfn*) (let [fnenv (with-interop-locals env (take-nth 2 (first args)))]
Expand All @@ -381,7 +401,7 @@
(recur env (expand/all env `(let [~(vec (take-nth 2 bs)) (::letfn ~bs)] ~@body)))))

(::letfn) (let [bs (first args), [form refs] (closure env `(letfn* ~bs ~(vec (take-nth 2 bs))))]
(apply ir/apply (ir/eval form) (mapv #(analyze-me env %) refs)))
(apply ir/apply (assoc (ir/eval form) ::dbg/type :letfn) (mapv #(analyze-me env %) refs)))

(set!) (when-not (::in-interop-fn? env)
(recur env (expand/all env `((fn [v#] (set! ~(nth form 1) v#)) ~(nth form 2)))))
Expand Down Expand Up @@ -421,7 +441,7 @@
(->obj-method-call o x xs env)
(ir/apply (ir/eval `(fn [o#] (. o# ~x))) (analyze-me env o))))))

(throw) (recur env (expand/all env `(r/fail ~(first args) nil)))
(throw) (recur env (expand/all env `(r/fail ~(first args) trace)))

(try) (recur env (expand-try args env))

Expand Down Expand Up @@ -449,10 +469,11 @@
(::closure) (let [[form debug-info] args]
(merge (ir/constant (analyze-me env (expand/all env form))) debug-info))

(::toggle) (let [[peer & body] args]
(::toggle) (let [[peer debug-info & body] args]
(if (= peer (::current env))
(recur env (cons 'do body))
(assoc (analyze-them (assoc env ::current peer) (cons 'do body)) ::ir/op ::ir/input)))
(-> (analyze-them (assoc env ::current peer) (cons 'do body))
(assoc ::ir/op ::ir/input, ::dbg/meta (source-map env debug-info), ::dbg/type :toggle))))

(::inject) (ir/inject (let [sym (first args)]
(if-some [qualified-sym (find-node-signifier sym env)]
Expand All @@ -463,7 +484,8 @@

(binding) (analyze-binding env (first args) analyze-me (cons `do (next args)))

(clojure.core/unquote-splicing) (assoc (analyze-them (toggle env) (next form)) ::ir/op ::ir/input)
(clojure.core/unquote-splicing) (-> (analyze-them (toggle env) (next form))
(assoc ::ir/op ::ir/input , ::dbg/meta (meta form), ::dbg/type :toggle))

#_else (apply ir/apply
(if (and (symbol? op)
Expand All @@ -486,20 +508,21 @@
(symbol? form)
(if-some [local (find-local form env)]
(if (::pub local)
(if (= (::peer local) (::current env))
(ir/sub (- (get (::index env) (::current env)) (::pub local)))
(assoc (analyze-them env (list ::toggle (::peer local) form)) ::ir/op ::ir/input))
(let [debug-info {::dbg/name (with-meta form nil), ::dbg/scope :lexical, ::dbg/meta (meta form)}]
(if (= (::peer local) (::current env))
(merge (ir/sub (- (get (::index env) (::current env)) (::pub local))) debug-info)
(merge (analyze-them env (list ::toggle (::peer local) form)) {::ir/op ::ir/input} debug-info)))
(ir/eval form))
(if-some [qualified-sym (find-node-signifier form env)]
(let [node (signifier->node qualified-sym env)]
(if (case (get (::peers env) (::current env))
:clj (resolve node)
:cljs (expand/resolve-cljs env node))
(ir/node node)
(assoc (ir/node node) ::dbg/name qualified-sym, ::dbg/scope :dynamic)
(throw (ex-info (str "I cannot resolve " form) {:form form}))))
;; (ir/node (signifier->node qualified-sym env))
(if-some [qualified-sym (find-node form env)]
(ir/node qualified-sym)
(assoc (ir/node qualified-sym) ::dbg/name qualified-sym, ::dbg/scope :dynamic)
(if (case (get (::peers env) (::current env))
:clj (or (resolve-static-field form) (resolve form))
:cljs (expand/resolve-cljs env form))
Expand Down Expand Up @@ -561,7 +584,7 @@

(.) (apply merge-with into (mapv #(analyze-them env %) args))

(throw) (recur env (expand/all env `(r/fail ~(first args) nil)))
(throw) (recur env (expand/all env `(r/fail ~(first args) trace)))

(try) (recur env (expand-try args env))

Expand All @@ -578,7 +601,7 @@

(::closure) {::ir/deps [(assoc (analyze-them env (first args)) ::ir/op ::ir/target, ::form :closure)]}

(::toggle) (let [[peer & body] args]
(::toggle) (let [[peer debug-info & body] args]
(if (= peer (::me env))
{::ir/deps [(ir/output (analyze-me (assoc env ::current peer) (cons 'do body)))]}
(analyze-them env (cons 'do body))))
Expand All @@ -600,14 +623,15 @@

(symbol? form)
(if-some [local (find-local form env)]
(when (and (::pub local) (= (::me env) (::peer local)))
{::ir/deps [(ir/output (analyze-me (assoc env ::current (::me env)) form))]})
(let [debug-info {::dbg/name (with-meta form nil), ::dbg/scope :lexical, ::dbg/meta (meta form)}]
(when (and (::pub local) (= (::me env) (::peer local)))
{::ir/deps [(ir/output (merge (analyze-me (assoc env ::current (::me env)) form) debug-info))]}))
(when-some [qualified-sym (find-node-signifier form env)]
(let [node (signifier->node qualified-sym env)]
(if (case (get (::peers env) (::me env))
:clj (resolve node)
:cljs (expand/resolve-cljs env node))
{::ir/deps [(ir/node node)]}
{::ir/deps [(assoc (ir/node node) ::dbg/name qualified-sym, ::dbg/scope :dynamic)]}
(throw (ex-info (str "I cannot resolve " form) {:form form}))))
;; {::ir/deps [(ir/node (signifier->node qualified-sym env))]}
#_{::ir/node-deps [(signifier->node qualified-sym env)]}))
Expand Down
Loading

0 comments on commit fc49aaa

Please sign in to comment.