Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

multi-threading #19

Merged
merged 2 commits into from
Dec 30, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
65 changes: 51 additions & 14 deletions src/bel_clojure/evaluator.clj
Original file line number Diff line number Diff line change
Expand Up @@ -56,6 +56,15 @@
[es
(conj rs (m/p-cdr v-pair))]))))

;; ----------
;; p-thread

(defn p-thread [es rs env form]
[(conj
es
[env [:start-thread env form]])
rs])

;; ----
;; dyn

Expand Down Expand Up @@ -190,7 +199,7 @@
"p-debug" #'p-debug
"uvar" #'p-uvar
"bin<" #'p-bin<
"map-assoc" #'m/map-assoc }
"map-assoc" #'m/map-assoc}
math-name->fn))

;; -------------
Expand All @@ -200,7 +209,8 @@
{"dyn" #'p-dyn
"ccc" #'p-ccc
"where" #'p-where
"err" #'p-err})
"err" #'p-err
"thread" #'p-thread})

;; ---
;; Env
Expand Down Expand Up @@ -327,7 +337,7 @@
[(conj es [env (m/p
m/bel-err-sym
(m/p [:clj-err e]
m/bel-nil))])
m/bel-nil))])
rest-rs]))))

(defn bel-eval-prim [es rs env litv args-head]
Expand Down Expand Up @@ -356,7 +366,7 @@
[env (m/p
m/bel-err-sym
(m/p (m/p m/bel-quote 'mistype)
m/bel-nil))])
m/bel-nil))])
rs]
[(conj es
[env
Expand All @@ -373,7 +383,7 @@
[env (m/p
evaled-f
(m/p (m/p m/bel-quote arg)
m/bel-nil))])
m/bel-nil))])
rest-rs]))

(defn bel-assign-vars-optional-arg [es rs env [_ variable]]
Expand Down Expand Up @@ -693,23 +703,50 @@
(let [f (step->fn (first form))]
(f rest-es rs env form)))))

(defn debug-loop [es rs]
(defn debug-loop [tid es rs]
(println "tid:" tid)
(println "in:")
(mapv (comp println r/bel->pretty-clj second) es)
(println "out:")
(mapv println rs)
(println "---"))

(defn bel-eval [eval-stack return-stack]
(loop [es eval-stack
rs return-stack]
(if (empty? es)
(or (last rs) m/bel-nil)
(let [[new-es new-rs] (bel-eval-step es rs)]
(recur new-es new-rs)))))
(defn start-thread-command? [form]
(and (seqable? form) (= :start-thread (first form))))

(defn start-thread-command->thread [[_ env form]]
[(gensym) [[env form]] []])

(defn locking? [es]
(let [lock (some-> es last first :dyn (get 'lock))]
(and lock (not= lock m/bel-nil))))

(defn bel-eval [threads]
(loop [threads threads]
(let [[top-thread & rest-threads] threads
[tid es rs] top-thread
[_ top-form] (last es)]
(cond
(empty? es)
(if (empty? rest-threads)
(or (last rs) m/bel-nil)
(recur rest-threads))

(start-thread-command? top-form)
(recur
(into [(start-thread-command->thread top-form)
[tid (drop-lastv es) rs]]
rest-threads))
:else
(let [[es' rs'] (bel-eval-step es rs)
thread' [tid es' rs']]
(recur
(if (locking? es')
(into [thread'] rest-threads)
(into (vec rest-threads) [thread']))))))))

(defn bel-eval-single [env form]
(bel-eval [[env form]] []))
(bel-eval [[(gensym) [[env form]] []]]))

(defn eval-all
[env strs]
Expand Down
2 changes: 1 addition & 1 deletion src/bel_clojure/reader.clj
Original file line number Diff line number Diff line change
Expand Up @@ -195,4 +195,4 @@
(= m/bel-nil b) nil
(m/bel-pair? b) (bel->pretty-clj b)
:else ['. (bel->pretty-clj b)])))
form))
form))
6 changes: 4 additions & 2 deletions test/bel_clojure/core_test.clj
Original file line number Diff line number Diff line change
Expand Up @@ -181,5 +181,7 @@
(is (= (ev "(insert < 3 '(1 2 4 5))") '(1 2 3 4 5)))
(is (= (ev "(sort < '(5 1 3 2 4))") '(1 2 3 4 5)))
(is (= (ev "(best > '(1 2 4 5))") 5))
(is (= (ev "(best (of > len) '((a) (b c) (d e) (f)))") '(b c))))

(is (= (ev "(best (of > len) '((a) (b c) (d e) (f)))") '(b c)))
(is (= (ev "(do (thread (do (join 'a 'b)))
(thread (do (join 'a 'b) (join 'b 'd))))")
'(b . d))))