Skip to content

Commit

Permalink
Added code to count symbols in args
Browse files Browse the repository at this point in the history
  • Loading branch information
Stuart Mitchell committed Jul 16, 2020
1 parent fe71313 commit b9424b7
Show file tree
Hide file tree
Showing 2 changed files with 110 additions and 93 deletions.
183 changes: 94 additions & 89 deletions src/day8/re_frame/debux/dbgn.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -215,141 +215,142 @@
z/down))

;;; insert/remove d
(defn insert-trace [form d-sym env]

(defn insert-trace
([form d-sym env] (insert-trace form d-sym env []))
([form d-sym env seen]
; (println "INSERT-TRACE" (prn-str form))
(loop [loc (ut/sequential-zip form)
indent 0
syntax-order 0
seen []]
(let [node (z/node loc)
seen (conj seen node)
syntax-order (inc syntax-order)
num-seen (-> #{node}
(keep seen)
count)
#_ #_ indent (real-depth loc)]
indent 0
syntax-order 0
seen seen]
(let [node (z/node loc)
seen (conj seen node)
syntax-order (inc syntax-order)
num-seen (-> #{node}
(keep seen)
count)
#_ #_ indent (real-depth loc)]
;; (println "node" node syntax-order num-seen)
(cond
(z/end? loc) (z/root loc)
(cond
(z/end? loc) (z/root loc)

;;; in case of (spy-first ...) (and more to come)
;(and (seq? node) (= `ms/skip (first node)))
;(recur (-> (z/down node)
; z/right
; z/down))

;; TODO: is it more efficient to remove the skips here
;; rather than taking another pass through the form?

;; in case of (.. skip ...)
(= ::ms/skip node)
(recur (ut/right-or-next loc) indent syntax-order seen)
(= ::ms/skip node)
(recur (ut/right-or-next loc) indent syntax-order seen)

;; in case of (skip ...)
(and (seq? node) (= `ms/skip (first node)) )
(recur (ut/right-or-next loc) indent syntax-order (concat seen (-> node
next
flatten)))
(and (seq? node) (= `ms/skip (first node)) )
(recur (ut/right-or-next loc) indent syntax-order (concat seen (-> node
next
flatten)))

;; in case of (o-skip ...)
(and (seq? node)
(= `ms/o-skip (first node)))
(cond
(and (seq? node)
(= `ms/o-skip (first node)))
(cond
;; <ex> (o-skip [(skip a) ...])
(vector? (second node))
(recur (-> loc z/down z/next z/down) indent syntax-order seen)
(vector? (second node))
(recur (-> loc z/down z/next z/down) indent syntax-order seen)

;; <ex> (o-skip (recur ...))
:else
(recur (-> loc z/down z/next z/down ut/right-or-next) indent syntax-order seen))
:else
(recur (-> loc z/down z/next z/down ut/right-or-next) indent syntax-order seen))

;; TODO: handle lists that are just lists, not function calls


;; in case of (skip-outer ...)
(and (seq? node)
(= `ms/skip-outer (first node)))
(let [inner-loc (-> loc z/down z/right)
inner-node (z/node inner-loc)]
(cond
(and (seq? inner-node)
(= `ms/skip (first inner-node)))
(and (seq? node)
(= `ms/skip-outer (first node)))
(let [inner-loc (-> loc z/down z/right)
inner-node (z/node inner-loc)]
(cond
(and (seq? inner-node)
(= `ms/skip (first inner-node)))
;; Recur once and let skip handle case
(recur inner-loc indent syntax-order seen)
(recur inner-loc indent syntax-order seen)

(seq? inner-node)
(recur (-> inner-loc z/down ut/right-or-next) indent syntax-order seen)
(seq? inner-node)
(recur (-> inner-loc z/down ut/right-or-next) indent syntax-order seen)

(vector? inner-node)
(recur (-> inner-loc z/down) indent syntax-order seen)
(vector? inner-node)
(recur (-> inner-loc z/down) indent syntax-order seen)

:else
(recur (-> inner-loc ut/right-or-next) indent syntax-order seen)
:else
(recur (-> inner-loc ut/right-or-next) indent syntax-order seen)


;true (throw (ex-info "Pause" {}))
;; vector
;; map
;; form

))
))


;; in case that the first symbol is defn/defn-
(and (seq? node)
(symbol? (first node))
(`#{defn defn-} (ut/ns-symbol (first node) env)))
(recur (-> loc z/down z/next) indent syntax-order seen)
(and (seq? node)
(symbol? (first node))
(`#{defn defn-} (ut/ns-symbol (first node) env)))
(recur (-> loc z/down z/next) indent syntax-order seen)

;; in case of the first symbol except defn/defn-/def

;; DC: why not def? where is that handled?
(and (seq? node) (ifn? (first node)))
(recur (-> (z/replace loc `(~d-sym {::indent ~(real-depth loc)
::syntax-order ~syntax-order
::num-seen ~num-seen} ~node))
skip-past-trace
ut/right-or-next)
(inc indent) syntax-order seen)
(and (seq? node) (ifn? (first node)))
(recur (-> (z/replace loc `(~d-sym {::indent ~(real-depth loc)
::syntax-order ~syntax-order
::num-seen ~num-seen} ~node))
skip-past-trace
ut/right-or-next)
(inc indent) syntax-order seen)

;; |[1 2 (+ 3 4)]
;; |(d [1 2 (+ 3 4)])


(vector? node)
(recur (-> loc
(z/replace `(~d-sym {::indent ~(real-depth loc)
::syntax-order ~syntax-order
::num-seen ~num-seen} ~node))
skip-past-trace)
indent syntax-order seen)

(map? node)
(recur (-> loc
(z/replace `(~d-sym {::indent ~(real-depth loc)
::syntax-order ~syntax-order
::num-seen ~num-seen} ~node))
skip-past-trace)
indent syntax-order seen)

(= node `day8.re-frame.debux.common.macro-specs/indent)

(vector? node)
(recur (-> loc
(z/replace `(~d-sym {::indent ~(real-depth loc)
::syntax-order ~syntax-order
::num-seen ~num-seen} ~node))
skip-past-trace)
indent syntax-order seen)

(map? node)
(recur (-> loc
(z/replace `(~d-sym {::indent ~(real-depth loc)
::syntax-order ~syntax-order
::num-seen ~num-seen} ~node))
skip-past-trace)
indent syntax-order seen)

(= node `day8.re-frame.debux.common.macro-specs/indent)
;; TODO: does this real-depth need an inc/dec to bring it into line with the d?
(recur (z/replace loc (real-depth loc)) indent syntax-order seen)
(recur (z/replace loc (real-depth loc)) indent syntax-order seen)

;; DC: We might also want to trace inside maps, especially for fx
;; in case of symbol, or set
(or (symbol? node) (map? node) (set? node))
(recur (-> (z/replace loc `(~d-sym {::indent ~(real-depth loc)
::syntax-order ~syntax-order
::num-seen ~num-seen} ~node))
(or (symbol? node) (map? node) (set? node))
(recur (-> (z/replace loc `(~d-sym {::indent ~(real-depth loc)
::syntax-order ~syntax-order
::num-seen ~num-seen} ~node))
;; We're not zipping down inside the node further, so we don't need to add a
;; second z/right like we do in the case of a vector or ifn? node above.
ut/right-or-next)
indent syntax-order seen)
ut/right-or-next)
indent syntax-order seen)

:else
(recur (z/next loc) indent syntax-order seen)))))
:else
(recur (z/next loc) indent syntax-order seen))))))

(defmulti trace*
(fn [& args]
Expand Down Expand Up @@ -473,8 +474,12 @@

;;; dbgn
(defmacro dbgn-forms
"Similar to dbgn but can deal with multiple forms and inject a specified form to send-form!"
[forms send-form & [opts]]
"Similar to dbgn but can deal with multiple forms and inject a specified form to send-form!
args:
forms - the sequence of forms i.e. an implied do in a fn
send-form - the form sent to be traced
args - the symbols in the args (that need to be added to num-seen)"
[forms send-form args & [opts]]
(let [send-form (-> send-form ;;for some reason the form is wrapped in a list
first)
func (first send-form)
Expand All @@ -489,7 +494,7 @@
(sk/insert-o-skip-for-recur form &env)
form)
(insert-skip &env)
(insert-trace 'day8.re-frame.debux.dbgn/trace &env)
(insert-trace 'day8.re-frame.debux.dbgn/trace &env args)
remove-skip))
forms)
;; TODO: can we remove try/catch too?
Expand Down
20 changes: 16 additions & 4 deletions src/day8/re_frame/tracing.cljc
View file
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,8 @@
[day8.re-frame.debux.cs.macro-types :as mt]))
(:require [day8.re-frame.debux.common.util :as ut]
[day8.re-frame.debux.common.macro-specs :as ms]
[clojure.spec.alpha :as s]))
[clojure.spec.alpha :as s]
[clojure.zip :as z]))

#?(:cljs (enable-console-print!))

Expand Down Expand Up @@ -41,19 +42,30 @@
([] `(day8.re-frame.debux.cs.macro-types/show-macros))
([macro-type] `(day8.re-frame.debux.cs.macro-types/show-macros ~macro-type)))

(defn find-symbols [args]
"iterate through the function args and get a list of the symbols"
(loop [loc (ut/sequential-zip args)
seen []]
(let [node (z/node loc)]
(cond
(z/end? loc) seen
(symbol? node) (recur (z/next loc) (conj seen node))
:else (recur (z/next loc) seen)
))))

(defn fn-body [args+body & send-form]
(let [args (or (-> args+body :args :args) [])
body-or-prepost (-> args+body :body (nth 0))
body (nth (:body args+body) 1)]
body (nth (:body args+body) 1)
args-symbols (find-symbols args)]
(if (= :body body-or-prepost) ;; no pre and post conditions
`(~args
;; ~@(map (fn [body] `(dbgn ~body)) (nth (:body args+body) 1)))
(dbgn/dbgn-forms ~body ~send-form))
(dbgn/dbgn-forms ~body ~send-form ~args-symbols))
;; prepost+body
`(~args
~(:prepost body)
(dbgn/dbgn-forms ~(:body body) ~send-form)))))
(dbgn/dbgn-forms ~(:body body) ~send-form ~args-symbols)))))

;; Components of a defn
;; name
Expand Down

0 comments on commit b9424b7

Please sign in to comment.