Mercurial > lasercutter
comparison src/clojure/main.clj @ 10:ef7dbbd6452c
added clojure source goodness
author | Robert McIntyre <rlm@mit.edu> |
---|---|
date | Sat, 21 Aug 2010 06:25:44 -0400 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
9:35cf337adfcf | 10:ef7dbbd6452c |
---|---|
1 ;; Copyright (c) Rich Hickey All rights reserved. The use and | |
2 ;; distribution terms for this software are covered by the Eclipse Public | |
3 ;; License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can be found | |
4 ;; in the file epl-v10.html at the root of this distribution. By using this | |
5 ;; software in any fashion, you are agreeing to be bound by the terms of | |
6 ;; this license. You must not remove this notice, or any other, from this | |
7 ;; software. | |
8 | |
9 ;; Originally contributed by Stephen C. Gilardi | |
10 | |
11 (ns ^{:doc "Top-level main function for Clojure REPL and scripts." | |
12 :author "Stephen C. Gilardi and Rich Hickey"} | |
13 clojure.main | |
14 (:refer-clojure :exclude [with-bindings]) | |
15 (:import (clojure.lang Compiler Compiler$CompilerException | |
16 LineNumberingPushbackReader RT))) | |
17 | |
18 (declare main) | |
19 | |
20 (defmacro with-bindings | |
21 "Executes body in the context of thread-local bindings for several vars | |
22 that often need to be set!: *ns* *warn-on-reflection* *math-context* | |
23 *print-meta* *print-length* *print-level* *compile-path* | |
24 *command-line-args* *1 *2 *3 *e" | |
25 [& body] | |
26 `(binding [*ns* *ns* | |
27 *warn-on-reflection* *warn-on-reflection* | |
28 *math-context* *math-context* | |
29 *print-meta* *print-meta* | |
30 *print-length* *print-length* | |
31 *print-level* *print-level* | |
32 *compile-path* (System/getProperty "clojure.compile.path" "classes") | |
33 *command-line-args* *command-line-args* | |
34 *assert* *assert* | |
35 *1 nil | |
36 *2 nil | |
37 *3 nil | |
38 *e nil] | |
39 ~@body)) | |
40 | |
41 (defn repl-prompt | |
42 "Default :prompt hook for repl" | |
43 [] | |
44 (printf "%s=> " (ns-name *ns*))) | |
45 | |
46 (defn skip-if-eol | |
47 "If the next character on stream s is a newline, skips it, otherwise | |
48 leaves the stream untouched. Returns :line-start, :stream-end, or :body | |
49 to indicate the relative location of the next character on s. The stream | |
50 must either be an instance of LineNumberingPushbackReader or duplicate | |
51 its behavior of both supporting .unread and collapsing all of CR, LF, and | |
52 CRLF to a single \\newline." | |
53 [s] | |
54 (let [c (.read s)] | |
55 (cond | |
56 (= c (int \newline)) :line-start | |
57 (= c -1) :stream-end | |
58 :else (do (.unread s c) :body)))) | |
59 | |
60 (defn skip-whitespace | |
61 "Skips whitespace characters on stream s. Returns :line-start, :stream-end, | |
62 or :body to indicate the relative location of the next character on s. | |
63 Interprets comma as whitespace and semicolon as comment to end of line. | |
64 Does not interpret #! as comment to end of line because only one | |
65 character of lookahead is available. The stream must either be an | |
66 instance of LineNumberingPushbackReader or duplicate its behavior of both | |
67 supporting .unread and collapsing all of CR, LF, and CRLF to a single | |
68 \\newline." | |
69 [s] | |
70 (loop [c (.read s)] | |
71 (cond | |
72 (= c (int \newline)) :line-start | |
73 (= c -1) :stream-end | |
74 (= c (int \;)) (do (.readLine s) :line-start) | |
75 (or (Character/isWhitespace c) (= c (int \,))) (recur (.read s)) | |
76 :else (do (.unread s c) :body)))) | |
77 | |
78 (defn repl-read | |
79 "Default :read hook for repl. Reads from *in* which must either be an | |
80 instance of LineNumberingPushbackReader or duplicate its behavior of both | |
81 supporting .unread and collapsing all of CR, LF, and CRLF into a single | |
82 \\newline. repl-read: | |
83 - skips whitespace, then | |
84 - returns request-prompt on start of line, or | |
85 - returns request-exit on end of stream, or | |
86 - reads an object from the input stream, then | |
87 - skips the next input character if it's end of line, then | |
88 - returns the object." | |
89 [request-prompt request-exit] | |
90 (or ({:line-start request-prompt :stream-end request-exit} | |
91 (skip-whitespace *in*)) | |
92 (let [input (read)] | |
93 (skip-if-eol *in*) | |
94 input))) | |
95 | |
96 (defn- root-cause | |
97 "Returns the initial cause of an exception or error by peeling off all of | |
98 its wrappers" | |
99 [^Throwable throwable] | |
100 (loop [cause throwable] | |
101 (if-let [cause (.getCause cause)] | |
102 (recur cause) | |
103 cause))) | |
104 | |
105 (defn repl-exception | |
106 "Returns CompilerExceptions in tact, but only the root cause of other | |
107 throwables" | |
108 [throwable] | |
109 (if (instance? Compiler$CompilerException throwable) | |
110 throwable | |
111 (root-cause throwable))) | |
112 | |
113 (defn repl-caught | |
114 "Default :caught hook for repl" | |
115 [e] | |
116 (.println *err* (repl-exception e))) | |
117 | |
118 (defn repl | |
119 "Generic, reusable, read-eval-print loop. By default, reads from *in*, | |
120 writes to *out*, and prints exception summaries to *err*. If you use the | |
121 default :read hook, *in* must either be an instance of | |
122 LineNumberingPushbackReader or duplicate its behavior of both supporting | |
123 .unread and collapsing CR, LF, and CRLF into a single \\newline. Options | |
124 are sequential keyword-value pairs. Available options and their defaults: | |
125 | |
126 - :init, function of no arguments, initialization hook called with | |
127 bindings for set!-able vars in place. | |
128 default: #() | |
129 | |
130 - :need-prompt, function of no arguments, called before each | |
131 read-eval-print except the first, the user will be prompted if it | |
132 returns true. | |
133 default: (if (instance? LineNumberingPushbackReader *in*) | |
134 #(.atLineStart *in*) | |
135 #(identity true)) | |
136 | |
137 - :prompt, function of no arguments, prompts for more input. | |
138 default: repl-prompt | |
139 | |
140 - :flush, function of no arguments, flushes output | |
141 default: flush | |
142 | |
143 - :read, function of two arguments, reads from *in*: | |
144 - returns its first argument to request a fresh prompt | |
145 - depending on need-prompt, this may cause the repl to prompt | |
146 before reading again | |
147 - returns its second argument to request an exit from the repl | |
148 - else returns the next object read from the input stream | |
149 default: repl-read | |
150 | |
151 - :eval, funtion of one argument, returns the evaluation of its | |
152 argument | |
153 default: eval | |
154 | |
155 - :print, function of one argument, prints its argument to the output | |
156 default: prn | |
157 | |
158 - :caught, function of one argument, a throwable, called when | |
159 read, eval, or print throws an exception or error | |
160 default: repl-caught" | |
161 [& options] | |
162 (let [cl (.getContextClassLoader (Thread/currentThread))] | |
163 (.setContextClassLoader (Thread/currentThread) (clojure.lang.DynamicClassLoader. cl))) | |
164 (let [{:keys [init need-prompt prompt flush read eval print caught] | |
165 :or {init #() | |
166 need-prompt (if (instance? LineNumberingPushbackReader *in*) | |
167 #(.atLineStart ^LineNumberingPushbackReader *in*) | |
168 #(identity true)) | |
169 prompt repl-prompt | |
170 flush flush | |
171 read repl-read | |
172 eval eval | |
173 print prn | |
174 caught repl-caught}} | |
175 (apply hash-map options) | |
176 request-prompt (Object.) | |
177 request-exit (Object.) | |
178 read-eval-print | |
179 (fn [] | |
180 (try | |
181 (let [input (read request-prompt request-exit)] | |
182 (or (#{request-prompt request-exit} input) | |
183 (let [value (eval input)] | |
184 (print value) | |
185 (set! *3 *2) | |
186 (set! *2 *1) | |
187 (set! *1 value)))) | |
188 (catch Throwable e | |
189 (caught e) | |
190 (set! *e e))))] | |
191 (with-bindings | |
192 (try | |
193 (init) | |
194 (catch Throwable e | |
195 (caught e) | |
196 (set! *e e))) | |
197 (use '[clojure.repl :only (source apropos dir)]) | |
198 (use '[clojure.java.javadoc :only (javadoc)]) | |
199 (use '[clojure.pprint :only (pp pprint)]) | |
200 (prompt) | |
201 (flush) | |
202 (loop [] | |
203 (when-not | |
204 (try (= (read-eval-print) request-exit) | |
205 (catch Throwable e | |
206 (caught e) | |
207 (set! *e e) | |
208 nil)) | |
209 (when (need-prompt) | |
210 (prompt) | |
211 (flush)) | |
212 (recur)))))) | |
213 | |
214 (defn load-script | |
215 "Loads Clojure source from a file or resource given its path. Paths | |
216 beginning with @ or @/ are considered relative to classpath." | |
217 [^String path] | |
218 (if (.startsWith path "@") | |
219 (RT/loadResourceScript | |
220 (.substring path (if (.startsWith path "@/") 2 1))) | |
221 (Compiler/loadFile path))) | |
222 | |
223 (defn- init-opt | |
224 "Load a script" | |
225 [path] | |
226 (load-script path)) | |
227 | |
228 (defn- eval-opt | |
229 "Evals expressions in str, prints each non-nil result using prn" | |
230 [str] | |
231 (let [eof (Object.) | |
232 reader (LineNumberingPushbackReader. (java.io.StringReader. str))] | |
233 (loop [input (read reader false eof)] | |
234 (when-not (= input eof) | |
235 (let [value (eval input)] | |
236 (when-not (nil? value) | |
237 (prn value)) | |
238 (recur (read reader false eof))))))) | |
239 | |
240 (defn- init-dispatch | |
241 "Returns the handler associated with an init opt" | |
242 [opt] | |
243 ({"-i" init-opt | |
244 "--init" init-opt | |
245 "-e" eval-opt | |
246 "--eval" eval-opt} opt)) | |
247 | |
248 (defn- initialize | |
249 "Common initialize routine for repl, script, and null opts" | |
250 [args inits] | |
251 (in-ns 'user) | |
252 (set! *command-line-args* args) | |
253 (doseq [[opt arg] inits] | |
254 ((init-dispatch opt) arg))) | |
255 | |
256 (defn- repl-opt | |
257 "Start a repl with args and inits. Print greeting if no eval options were | |
258 present" | |
259 [[_ & args] inits] | |
260 (when-not (some #(= eval-opt (init-dispatch (first %))) inits) | |
261 (println "Clojure" (clojure-version))) | |
262 (repl :init #(initialize args inits)) | |
263 (prn) | |
264 (System/exit 0)) | |
265 | |
266 (defn- script-opt | |
267 "Run a script from a file, resource, or standard in with args and inits" | |
268 [[path & args] inits] | |
269 (with-bindings | |
270 (initialize args inits) | |
271 (if (= path "-") | |
272 (load-reader *in*) | |
273 (load-script path)))) | |
274 | |
275 (defn- null-opt | |
276 "No repl or script opt present, just bind args and run inits" | |
277 [args inits] | |
278 (with-bindings | |
279 (initialize args inits))) | |
280 | |
281 (defn- help-opt | |
282 "Print help text for main" | |
283 [_ _] | |
284 (println (:doc (meta (var main))))) | |
285 | |
286 (defn- main-dispatch | |
287 "Returns the handler associated with a main option" | |
288 [opt] | |
289 (or | |
290 ({"-r" repl-opt | |
291 "--repl" repl-opt | |
292 nil null-opt | |
293 "-h" help-opt | |
294 "--help" help-opt | |
295 "-?" help-opt} opt) | |
296 script-opt)) | |
297 | |
298 (defn- legacy-repl | |
299 "Called by the clojure.lang.Repl.main stub to run a repl with args | |
300 specified the old way" | |
301 [args] | |
302 (println "WARNING: clojure.lang.Repl is deprecated. | |
303 Instead, use clojure.main like this: | |
304 java -cp clojure.jar clojure.main -i init.clj -r args...") | |
305 (let [[inits [sep & args]] (split-with (complement #{"--"}) args)] | |
306 (repl-opt (concat ["-r"] args) (map vector (repeat "-i") inits)))) | |
307 | |
308 (defn- legacy-script | |
309 "Called by the clojure.lang.Script.main stub to run a script with args | |
310 specified the old way" | |
311 [args] | |
312 (println "WARNING: clojure.lang.Script is deprecated. | |
313 Instead, use clojure.main like this: | |
314 java -cp clojure.jar clojure.main -i init.clj script.clj args...") | |
315 (let [[inits [sep & args]] (split-with (complement #{"--"}) args)] | |
316 (null-opt args (map vector (repeat "-i") inits)))) | |
317 | |
318 (defn main | |
319 "Usage: java -cp clojure.jar clojure.main [init-opt*] [main-opt] [arg*] | |
320 | |
321 With no options or args, runs an interactive Read-Eval-Print Loop | |
322 | |
323 init options: | |
324 -i, --init path Load a file or resource | |
325 -e, --eval string Evaluate expressions in string; print non-nil values | |
326 | |
327 main options: | |
328 -r, --repl Run a repl | |
329 path Run a script from from a file or resource | |
330 - Run a script from standard input | |
331 -h, -?, --help Print this help message and exit | |
332 | |
333 operation: | |
334 | |
335 - Establishes thread-local bindings for commonly set!-able vars | |
336 - Enters the user namespace | |
337 - Binds *command-line-args* to a seq of strings containing command line | |
338 args that appear after any main option | |
339 - Runs all init options in order | |
340 - Runs a repl or script if requested | |
341 | |
342 The init options may be repeated and mixed freely, but must appear before | |
343 any main option. The appearance of any eval option before running a repl | |
344 suppresses the usual repl greeting message: \"Clojure ~(clojure-version)\". | |
345 | |
346 Paths may be absolute or relative in the filesystem or relative to | |
347 classpath. Classpath-relative paths have prefix of @ or @/" | |
348 [& args] | |
349 (try | |
350 (if args | |
351 (loop [[opt arg & more :as args] args inits []] | |
352 (if (init-dispatch opt) | |
353 (recur more (conj inits [opt arg])) | |
354 ((main-dispatch opt) args inits))) | |
355 (repl-opt nil nil)) | |
356 (finally | |
357 (flush)))) | |
358 |