Skip to content
Newer
Older
100644 189 lines (172 sloc) 8.01 KB
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored Feb 14, 2012
1 (ns ^{:author "Chas Emerick"}
2 clojure.tools.nrepl.middleware.interruptible-eval
3 (:require [clojure.tools.nrepl.transport :as t]
4 clojure.main)
5 (:use [clojure.tools.nrepl.misc :only (response-for returning)])
6 (:import clojure.lang.LineNumberingPushbackReader
7 (java.io StringReader Writer)
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored Apr 13, 2012
8 java.util.concurrent.atomic.AtomicLong
9 (java.util.concurrent ArrayBlockingQueue LinkedBlockingQueue
10 TimeUnit ThreadPoolExecutor
11 ThreadFactory)))
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored Feb 14, 2012
12
13 (def ^{:dynamic true
14 :doc "The message currently being evaluated."}
15 *msg* nil)
16
17 (defn evaluate
18 "Evaluates some code within the dynamic context defined by a map of `bindings`,
19 as per `clojure.core/get-thread-bindings`.
20
21 Uses `clojure.main/repl` to drive the evaluation of :code in a second
22 map argument (either a string or a seq of forms to be evaluated), which may
23 also optionally specify a :ns (resolved via `find-ns`). The map MUST
24 contain a Transport implementation in :transport; expression results and errors
25 will be sent via that Transport.
26
27 Returns the dynamic scope that remains after evaluating all expressions
28 in :code.
29
30 It is assumed that `bindings` already contains useful/appropriate entries
31 for all vars indicated by `clojure.main/with-bindings`."
32 [bindings {:keys [code ns transport] :as msg}]
9af6e2b @cemerick Don't use push- and pop-thread-bindings directly; fixes NREPL-16
cemerick authored Apr 16, 2012
33 (let [bindings (atom (merge bindings (when ns {#'*ns* (-> ns symbol find-ns)})))
34 out (@bindings #'*out*)
35 err (@bindings #'*err*)]
36 (with-bindings @bindings
37 (try
38 (clojure.main/repl
39 ;; clojure.main/repl paves over certain vars even if they're already thread-bound
40 :init #(do (set! *compile-path* (@bindings #'*compile-path*))
41 (set! *1 (@bindings #'*1))
42 (set! *2 (@bindings #'*2))
43 (set! *3 (@bindings #'*3))
44 (set! *e (@bindings #'*e)))
45 :read (if (string? code)
46 (let [reader (LineNumberingPushbackReader. (StringReader. code))]
47 #(read reader false %2))
48 (let [q (java.util.concurrent.ArrayBlockingQueue. (count code) false code)]
49 #(or (.poll q 0 TimeUnit/MILLISECONDS) %2)))
50 :prompt (fn [])
51 :need-prompt (constantly false)
52 ; TODO pretty-print?
53 :print (fn [v]
54 (reset! bindings (assoc (get-thread-bindings)
55 #'*3 *2
56 #'*2 *1
57 #'*1 v))
58 (t/send transport (response-for msg
59 {:value v
60 :ns (-> *ns* ns-name str)})))
61 ; TODO customizable exception prints
62 :caught (fn [e]
63 (let [root-ex (#'clojure.main/root-cause e)]
64 (when-not (instance? ThreadDeath root-ex)
65 (reset! bindings (assoc (get-thread-bindings) #'*e e))
66 (t/send transport (response-for msg {:status :eval-error
67 :ex (-> e class str)
68 :root-ex (-> root-ex class str)}))
69 (clojure.main/repl-caught e)))))
70 @bindings
71 (finally
72 (.flush ^Writer out)
73 (.flush ^Writer err))))))
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored Feb 14, 2012
74
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored Apr 13, 2012
75 (defn- configure-thread-factory
76 "Returns a new ThreadFactory for the given session. This implementation
77 generates daemon threads, with names that include the session id."
9f11cfd @cemerick take 2 on NREPL-17; no more per-session executors, coping with JDK5/6…
cemerick authored Apr 16, 2012
78 []
79 (let [session-thread-counter (AtomicLong. 0)]
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored Apr 13, 2012
80 (reify ThreadFactory
81 (newThread [_ runnable]
82 (doto (Thread. runnable
9f11cfd @cemerick take 2 on NREPL-17; no more per-session executors, coping with JDK5/6…
cemerick authored Apr 16, 2012
83 (format "nREPL-worker-%s" (.getAndIncrement session-thread-counter)))
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored Apr 13, 2012
84 (.setDaemon true))))))
85
9f11cfd @cemerick take 2 on NREPL-17; no more per-session executors, coping with JDK5/6…
cemerick authored Apr 16, 2012
86 (def ^{:private true} jdk6? (try
87 (Class/forName "java.util.ServiceLoader")
88 true
89 (catch ClassNotFoundException e false)))
90
91 (defn- configure-executor
92 "Returns a ThreadPoolExecutor, configured (by default) to
93 have no core threads, use an unbounded queue, create only daemon threads,
94 and allow unused threads to expire after 30s."
95 [& {:keys [keep-alive queue thread-factory]
96 :or {keep-alive 30000
97 queue (LinkedBlockingQueue.)}}]
98 ; ThreadPoolExecutor in JDK5 *will not run* submitted jobs if the core pool size is zero and
99 ; the queue has not yet rejected a job (see http://kirkwylie.blogspot.com/2008/10/java5-vs-java6-threadpoolexecutor.html)
100 (ThreadPoolExecutor. (if jdk6? 0 1) Integer/MAX_VALUE
101 (long 30000) TimeUnit/MILLISECONDS
102 queue
103 (or thread-factory (configure-thread-factory))))
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored Apr 13, 2012
104
07786ca @cemerick build against Clojure 1.4.0 final
cemerick authored Apr 16, 2012
105 ; A little mini-agent implementation. Needed because agents cannot be used to host REPL
106 ; evaluation: http://dev.clojure.org/jira/browse/NREPL-17
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored Apr 13, 2012
107 (defn- prep-session
108 [session]
109 (locking session
110 (returning session
9f11cfd @cemerick take 2 on NREPL-17; no more per-session executors, coping with JDK5/6…
cemerick authored Apr 16, 2012
111 (when-not (-> session meta :queue)
112 (alter-meta! session assoc :queue (atom clojure.lang.PersistentQueue/EMPTY))))))
113
114 (declare run-next)
115 (defn- run-next*
116 [session executor]
117 (let [qa (-> session meta :queue)]
118 (loop []
119 (let [q @qa
120 qn (pop q)]
121 (if-not (compare-and-set! qa q qn)
122 (recur)
123 (when (seq qn)
124 (.execute executor (run-next session executor (peek qn)))))))))
125
126 (defn- run-next
127 [session executor f]
128 #(try
129 (f)
130 (finally
131 (run-next* session executor))))
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored Feb 14, 2012
132
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored Apr 13, 2012
133 (defn- queue-eval
9f11cfd @cemerick take 2 on NREPL-17; no more per-session executors, coping with JDK5/6…
cemerick authored Apr 16, 2012
134 "Queues the function for the given session."
135 [session executor f]
136 (let [qa (-> session prep-session meta :queue)]
137 (loop []
138 (let [q @qa]
139 (if-not (compare-and-set! qa q (conj q f))
140 (recur)
141 (when (empty? q)
142 (.execute executor (run-next session executor f))))))))
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored Feb 14, 2012
143
144 (defn interruptible-eval
145 "Evaluation middleware that supports interrupts. Returns a handler that supports
146 \"eval\" and \"interrupt\" :op-erations that delegates to the given handler
147 otherwise."
9f11cfd @cemerick take 2 on NREPL-17; no more per-session executors, coping with JDK5/6…
cemerick authored Apr 16, 2012
148 [h & {:keys [executor] :or {executor (configure-executor)}}]
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored Apr 13, 2012
149 (fn [{:keys [op session interrupt-id id transport] :as msg}]
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored Feb 14, 2012
150 (case op
151 "eval"
152 (if-not (:code msg)
153 (t/send transport (response-for msg :status #{:error :no-code}))
9f11cfd @cemerick take 2 on NREPL-17; no more per-session executors, coping with JDK5/6…
cemerick authored Apr 16, 2012
154 (queue-eval session executor
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored Apr 13, 2012
155 (comp
156 (partial reset! session)
157 (fn []
158 (alter-meta! session assoc
159 :thread (Thread/currentThread)
160 :eval-msg msg)
161 (binding [*msg* msg]
a8bc0c0 @cemerick #'*agent* no longer implicated in REPL goings-on
cemerick authored Apr 13, 2012
162 (returning (dissoc (evaluate @session msg) #'*msg*)
afcba72 @cemerick stop using agents to model REPL sessions; fixing NREPL-17
cemerick authored Apr 13, 2012
163 (t/send transport (response-for msg :status :done))
164 (alter-meta! session dissoc :thread :eval-msg)))))))
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored Feb 14, 2012
165
166 "interrupt"
167 ; interrupts are inherently racy; we'll check the agent's :eval-msg's :id and
168 ; bail if it's different than the one provided, but it's possible for
169 ; that message's eval to finish and another to start before we send
170 ; the interrupt / .stop.
171 (let [{:keys [id eval-msg ^Thread thread]} (meta session)]
172 (if (or (not interrupt-id)
173 (= interrupt-id (:id eval-msg)))
174 (if-not thread
175 (t/send transport (response-for msg :status #{:done :session-idle}))
176 (do
f955b8c @cemerick eliminate :interrupted status race condition
cemerick authored Feb 14, 2012
177 ; notify of the interrupted status before we .stop the thread so
178 ; it is received before the standard :done status (thereby ensuring
179 ; that is stays within the scope of a clojure.tools.nrepl/message seq
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored Feb 14, 2012
180 (t/send transport {:status #{:interrupted}
181 :id (:id eval-msg)
182 :session id})
f955b8c @cemerick eliminate :interrupted status race condition
cemerick authored Feb 14, 2012
183 (.stop thread)
4e3317c @cemerick split handlers namespace into separate topical middleware namespaces
cemerick authored Feb 14, 2012
184 (t/send transport (response-for msg :status #{:done}))))
185 (t/send transport (response-for msg :status #{:error :interrupt-id-mismatch :done}))))
186
187 (h msg))))
9f11cfd @cemerick take 2 on NREPL-17; no more per-session executors, coping with JDK5/6…
cemerick authored Apr 16, 2012
188
Something went wrong with that request. Please try again.