diff options
-rw-r--r-- | duck_streams/duck_streams.clj | 120 | ||||
-rw-r--r-- | enum/enum.clj | 47 | ||||
-rw-r--r-- | fcase/fcase.clj | 93 | ||||
-rw-r--r-- | import_static/import_static.clj | 61 | ||||
-rw-r--r-- | javalog/javalog.clj | 98 | ||||
-rw-r--r-- | str_utils/str_utils.clj | 44 | ||||
-rw-r--r-- | test_is/test_is.clj | 211 | ||||
-rw-r--r-- | trace/trace.clj | 55 |
8 files changed, 729 insertions, 0 deletions
diff --git a/duck_streams/duck_streams.clj b/duck_streams/duck_streams.clj new file mode 100644 index 00000000..855e8db5 --- /dev/null +++ b/duck_streams/duck_streams.clj @@ -0,0 +1,120 @@ +;;; duck_streams.clj -- duck-typed I/O streams for Clojure + +;; by Stuart Sierra <mail@stuartsierra.com> +;; April 8, 2008 + +;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and +;; distribution terms for this software are covered by the Common +;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php) +;; which can be found in the file CPL.TXT at the root of this +;; distribution. By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + + +;; This file defines "duck-typed" I/O utility functions for Clojure. +;; The 'reader' and 'writer' functions will open and return an +;; instance of java.io.BufferedReader and java.io.PrintWriter, +;; respectively, for a variety of argument types -- filenames as +;; strings, URLs, java.io.File's, etc. These functions are not very +;; efficient, because they have to perform a number of 'instance?' +;; checks, but they are convenient when you just want to open a file +;; and don't want to deal with all the Java I/O classes. +;; +;; This file also defines two convenience functions, 'spit' (opposite +;; of 'slurp') and 'write-lines' (opposite of 'line-seq'). + + +(clojure/in-ns 'clojure.contrib.duck-streams) +(clojure/refer 'clojure) + +(import '(java.io Reader InputStream InputStreamReader FileReader + BufferedReader File PrintWriter OutputStream + OutputStreamWriter BufferedWriter Writer FileWriter) + '(java.net URI URL MalformedURLException)) + +(defmacro bufr + {:private true} + [reader] + `(new java.io.BufferedReader ~reader)) + +(defn reader + "Attempts to coerce its argument into an open + java.io.BufferedReader. Argument may be an instance of Reader, + BufferedReader, InputStream, File, URI, URL, or String. + + If argument is a String, it tries to resolve it first as a URI, then + as a local file name. URIs with a 'file' protocol are converted to + local file names. + + Should be used inside with-open to ensure the Reader is properly + closed." + [x] + (cond + (instance? BufferedReader x) x + (instance? Reader x) (bufr x) + (instance? InputStream x) (bufr (new InputStreamReader x)) + (instance? File x) (bufr (new FileReader #^File x)) + (instance? URL x) (if (= (. #^URL x (getProtocol)) "file") + (bufr (new FileReader (. #^URL x (getPath)))) + (bufr (new InputStreamReader (. #^URL x (openStream))))) + (instance? URI x) (reader (. #^URI x (toURL))) + (instance? String x) (try (let [url (new URL x)] + (reader url)) + (catch MalformedURLException err + (bufr (new FileReader #^String x)))) + :else (throw (new Exception (str "Cannot coerce " (class x) + " into a Reader."))))) + +(defmacro bufw + {:private true} + [writer] + `(new java.io.PrintWriter (new java.io.BufferedWriter ~writer))) + +(defn writer + "Attempts to coerce its argument into an open java.io.PrintWriter + wrapped around a java.io.BufferedWriter. Argument may be an + instance of Writer, PrintWriter, BufferedWriter, OutputStream, File, + URI, URL, or String. + + If argument is a String, it tries to resolve it first as a URI, then + as a local file name. URIs with a 'file' protocol are converted to + local file names. + + Should be used inside with-open to ensure the Writer is properly + closed." + [x] + (cond + (instance? PrintWriter x) x + (instance? BufferedWriter x) (new PrintWriter #^BufferedWriter x) + (instance? Writer x) (bufw x) ; includes FileWriter + (instance? OutputStream x) (bufw (new OutputStreamWriter x)) + (instance? File x) (bufw (new FileWriter #^File x)) + (instance? URL x) (if (= (. #^URL x (getProtocol)) "file") + (bufw (new FileWriter (. #^URL x (getPath)))) + (throw (new Exception (str "Cannot write to non-file URL <" x ">.")))) + (instance? URI x) (writer (. #^URI x (toURL))) + (instance? String x) (try (let [url (new URL x)] + (writer url)) + (catch MalformedURLException err + (bufw (new FileWriter #^String x)))) + :else (throw (new Exception (str "Cannot coerce " (class x) + " into a Writer."))))) + +(defn write-lines + "Opposite of 'line-seq'. Writes lines (a seq) to writer (an open + java.io.PrintWriter), separated by newlines." + [#^PrintWriter writer lines] + (let [line (first lines)] + (when line + (. writer (write (str line))) + (. writer (println)) + (recur writer (rest lines))))) + +(defn spit + "Opposite of 'slurp'. Writes 'contents' to the file named by + 'filename'." + [filename contents] + (with-open w (#^PrintWriter writer filename) + (. w (print contents)))) + diff --git a/enum/enum.clj b/enum/enum.clj new file mode 100644 index 00000000..b417028d --- /dev/null +++ b/enum/enum.clj @@ -0,0 +1,47 @@ +;;; enum.clj -- Java enum classes in Clojure + +;; by Stuart Sierra, http://www.stuartsierra.com/ +;; May 29, 2008 + +;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and +;; distribution terms for this software are covered by the Common +;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php) +;; which can be found in the file CPL.TXT at the root of this +;; distribution. By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + + +;; This file helps define Java Enums, introduced in Java 1.5. Use it +;; when you need to define an enum to pass to a Java method. +;; +;; This file depends on genclass.clj in the Clojure distribution. + + +(clojure/in-ns 'clojure.contrib.enum) +(clojure/refer 'clojure) + +(defmacro defenum + "Generates and loads a subclass of java.lang.Enum, then + defs symbols as enumerated instances of that class. + + Example: (defenum my.package.MyEnum FOO BAR) + ;; FOO and BAR are now instances of MyEnum + + Java equivalent: enum MyEnum { FOO, BAR }; + + Caveats: + 1. The generated class has no values() method. + 2. The generated class returns false for Class.isEnum(). + 3. Enum.valueOf(Class, String) will not work. + 4. Redefining an enum is allowed, but enumeration resets + to zero." + [class & symbols] + ;; Can't load a class twice, so check first: + (try (. Class (forName (str class))) + (catch java.lang.ClassNotFoundException e + (gen-and-load-class (str class) :extends java.lang.Enum))) + (cons 'do + (map (fn [sym val] + `(def ~sym (new ~class ~(str sym) ~val))) + symbols (iterate inc 0)))) diff --git a/fcase/fcase.clj b/fcase/fcase.clj new file mode 100644 index 00000000..8e316f56 --- /dev/null +++ b/fcase/fcase.clj @@ -0,0 +1,93 @@ +;;; fcase.clj -- simple variants of "case" for Clojure + +;; by Stuart Sierra <mail@stuartsierra.com> +;; April 7, 2008 + +;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and +;; distribution terms for this software are covered by the Common +;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php) +;; which can be found in the file CPL.TXT at the root of this +;; distribution. By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + + +;; This file defines a generic "case" macro called "fcase" which takes +;; the equality-testing function as an argument. It also defines a +;; traditional "case" macro that tests using "=" and variants that +;; test for regular expressions and class membership. + + +(clojure/in-ns 'clojure.contrib.fcase) +(clojure/refer 'clojure) + + +(defmacro fcase + "Generic switch/case macro. 'fcase' is short for 'function case'. + + The 'compare-fn' is a fn of two arguments. + + The 'test-expr-clauses' are value-expression pairs without + surrounding parentheses, like in Clojure's 'cond'. + + The 'case-value' is evaluated once and cached. Then, 'compare-fn' + is called once for each clause, with the clause's test value as its + first argument and 'case-value' as its second argument. If + 'compare-fn' returns logical true, the clause's expression is + evaluated and returned. If 'compare-fn' returns false/nil, we go to + the next test value. + + If 'test-expr-clauses' contains an odd number of items, the last + item is the default expression evaluated if no case-value matches. + If there is no default expression and no case-value matches, fcase + returns nil. + + See specific forms of this macro in 'case' and 're-case'. + + The test expressions in 'fcase' are always evaluated linearly, in + order. For a large number of case expressions it may be more + efficient to use a hash lookup." + [compare-fn case-value & + test-expr-clauses] + (let [test-val-sym (gensym "test_val") + test-fn-sym (gensym "test_fn") + cond-loop (fn this [clauses] + (cond + (>= (count clauses) 2) + (list 'if (list test-fn-sym (first clauses) test-val-sym) + (second clauses) + (this (rest (rest clauses)))) + (= (count clauses) 1) (first clauses)))] + (list 'let [test-val-sym case-value, test-fn-sym compare-fn] + (cond-loop test-expr-clauses)))) + +(defmacro case + "Like cond, but test-value is compared against the value of each + test expression with =. If they are equal, executes the \"body\" + expression. Optional last expression is executed if none of the + test expressions match." + [test-value & clauses] + `(fcase = ~test-value ~@clauses)) + +(defmacro re-case + "Like case, but the test expressions are regular expressions, tested + with re-find." + [test-value & clauses] + `(fcase re-find ~test-value ~@clauses)) + +(defmacro instance-case + "Like case, but the test expressions are Java class names, tested with + 'instance?'." + [test-value & clauses] + `(fcase instance? ~test-value ~@clauses)) + +(defn- in-case-test [test-seq case-value] + (some (fn [item] (= item case-value)) + test-seq)) + +(defmacro in-case + "Like case, but test expressions are sequences. The test expression + is true if any item in the sequence is equal (tested with '=') to + the test value." + [test-value & clauses] + `(fcase in-case-test ~test-value ~@clauses)) diff --git a/import_static/import_static.clj b/import_static/import_static.clj new file mode 100644 index 00000000..0aa4364e --- /dev/null +++ b/import_static/import_static.clj @@ -0,0 +1,61 @@ +;;; import_static.clj -- import static Java methods/fields into Clojure + +;; by Stuart Sierra, http://stuartsierra.com/ +;; June 1, 2008 + +;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and +;; distribution terms for this software are covered by the Common +;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php) +;; which can be found in the file CPL.TXT at the root of this +;; distribution. By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + + + +(clojure/in-ns 'clojure.contrib.import-static) +(clojure/refer 'clojure) +(clojure/refer 'clojure.set) + +(defmacro import-static + "Imports the named static fields and/or static methods of the class + as (private) symbols in the current namespace. + + Example: + user=> (import-static java.lang.Math PI sqrt) + nil + user=> PI + 3.141592653589793 + user=> (sqrt 16) + 4.0 + + Note: The class name must be fully qualified, even if it has already + been imported. Static methods are defined as MACROS, not + first-class fns." + [class & fields-and-methods] + (let [only (set (map str fields-and-methods)) + the-class (. Class forName (str class)) + static? (fn [x] + (. java.lang.reflect.Modifier + (isStatic (. x (getModifiers))))) + statics (fn [array] + (set (map (memfn getName) + (filter static? array)))) + all-fields (statics (. the-class (getFields))) + all-methods (statics (. the-class (getMethods))) + fields-to-do (intersection all-fields only) + methods-to-do (intersection all-methods only) + make-sym (fn [string] + (with-meta (symbol string) {:private true})) + import-field (fn [name] + (list 'def (make-sym name) + (list '. class (symbol name)))) + import-method (fn [name] + (list 'defmacro (make-sym name) + '[& args] + (list 'list ''. (list 'quote class) + (list 'apply 'list + (list 'quote (symbol name)) + 'args))))] + `(do ~@(map import-field fields-to-do) + ~@(map import-method methods-to-do)))) diff --git a/javalog/javalog.clj b/javalog/javalog.clj new file mode 100644 index 00000000..2cb12c48 --- /dev/null +++ b/javalog/javalog.clj @@ -0,0 +1,98 @@ +;;; javalog.clj -- convenient access to java.util.logging in Clojure + +;; by Stuart Sierra <mail@stuartsierra.com> +;; April 8, 2008 + +;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and +;; distribution terms for this software are covered by the Common +;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php) +;; which can be found in the file CPL.TXT at the root of this +;; distribution. By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + + +;; This file defines some convenience functions for using the Java +;; logging framework from Clojure. It is oriented towards simple +;; development and debugging rather than complex production +;; environments. + + + +(clojure/in-ns 'clojure.contrib.javalog) +(clojure/refer 'clojure) + +(import '(java.util.logging Logger Level ConsoleHandler + FileHandler SimpleFormatter)) + +(def + #^{:tag Logger + :doc "The current java.util.logging.Logger. By default, the + global logger, modified by 'with-logger'."} + *logger* + (. Logger + (getLogger + (. Logger GLOBAL_LOGGER_NAME)))) + +(defmacro log-level + "Translates 'level' (a lower-case keyword) into a static field of + java.util.logging.Level, by name. + + Example: (log-level :severe) => java.util.logging.Level.SEVERE + + If 'level' is not a keyword, it is assumed to be a user-defined + instance of java.util.logging.Level and is returned unchanged." + [level] + (if (keyword? level) + `(. java.util.logging.Level + ~(symbol (. (name level) (toUpperCase)))) + level)) + +(defn root-logger + "Returns the root Logger instance." + ([] (root-logger *logger*)) + ([logger] (let [parent (. logger (getParent))] + (if parent + (recur parent) + logger)))) + +(defn set-console-log-level + "Attempts to set the level of the current logger and the root + ConsoleHandler to 'level' (a java.util.logging.Level). Useful for + debugging at the REPL." + [level] + (let [console-handler + (some (fn [h] (if (instance? ConsoleHandler h) h)) + (. (root-logger) (getHandlers)))] + (if console-handler + (do (. *logger* (setLevel level)) + (. console-handler (setLevel level))) + (throw (new Exception "No ConsoleHandler on root logger."))))) + +(defn add-log-file + "Attaches a log file, using SimpleFormatter, with the given level, + to the named logger. 'level' defaults to ALL. Note: multiple + invocations will create multiple log files, with numbers appended to + the names." + ([logger-name filename] + (add-log-file logger-name filename (. Level ALL))) + ([logger-name filename level] + (let [logger (. Logger (getLogger logger-name)) + handler (new FileHandler filename)] + (. handler (setFormatter (new SimpleFormatter))) + (. handler (setLevel level)) + (. logger (addHandler handler))))) + +(defmacro with-logger + "Executes 'body' with *logger* bound to a logger with the given name + and level. 'level' is expanded with 'log-level'." + [logger-name level & body] + `(binding [*logger* (. Logger (getLogger ~logger-name))] + (. *logger* (setLevel (log-level ~level))) + ~@body)) + +(defmacro log + "Logs a message to *logger*. 'level' is expanded with 'log-level'. + Example: (log :severe \"Bad argument: \" object)" + [level & strings] + `(. *logger* (log (log-level ~level) (str ~@strings)))) diff --git a/str_utils/str_utils.clj b/str_utils/str_utils.clj new file mode 100644 index 00000000..cb344024 --- /dev/null +++ b/str_utils/str_utils.clj @@ -0,0 +1,44 @@ +;;; str_utils.clj -- string utilities for Clojure + +;; by Stuart Sierra <mail@stuartsierra.com> +;; April 8, 2008 + +;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and +;; distribution terms for this software are covered by the Common +;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php) +;; which can be found in the file CPL.TXT at the root of this +;; distribution. By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + + +(clojure/in-ns 'clojure.contrib.str-utils) +(clojure/refer 'clojure) + +(import '(java.util.regex Pattern)) + + +(defn re-split + "Splits the string on instances of 'pattern'. Returns a sequence of + strings. Optional 'limit' argument is the maximum number of + splits. Like Perl's 'split'." + ([#^Pattern pattern string] (seq (. pattern (split string)))) + ([#^Pattern pattern string limit] (seq (. pattern (split string limit))))) + +(defn re-gsub + "Replaces all instances of 'pattern' in 'string' with + 'replacement'. Like Ruby's 'String#gsub'." + [#^Pattern regex replacement #^String string] + (.. regex (matcher string) (replaceAll replacement))) + +(defn re-sub + "Replaces the first instance of 'pattern' in 'string' with + 'replacement'. Like Ruby's 'String#sub'." + [#^Pattern regex replacement #^String string] + (.. regex (matcher string) (replaceFirst replacement))) + +(defn str-join + "Returns a string of all elements in 'sequence', separated by + 'separator'. Like Perl's 'join'." + [separator sequence] + (apply str (interpose separator sequence))) diff --git a/test_is/test_is.clj b/test_is/test_is.clj new file mode 100644 index 00000000..68463393 --- /dev/null +++ b/test_is/test_is.clj @@ -0,0 +1,211 @@ +;;; test_is.clj: test framework for Clojure + +;; by Stuart Sierra, http://stuartsierra.com/ +;; June 5, 2008 + +;; Thanks to Chas Emerick for contributions. + +;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and +;; distribution terms for this software are covered by the Common +;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php) +;; which can be found in the file CPL.TXT at the root of this +;; distribution. By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + + + +;; Inspired by many Common Lisp test frameworks and clojure/test, this +;; file is a Clojure test framework. +;; +;; Define tests as :test metadata on your fns. Use the "is" macro +;; for assertions. Examples: +;; +;; (defn add2 +;; ([x] (+ x 2)) +;; {:test (fn [] (is (= (add2 3) 5)) +;; (is (= (add2 -4) -2) +;; (is (> (add2 50) 50)))}) +;; +;; You can also define tests in isolation with the "deftest" macro: +;; +;; (deftest test-new-fn +;; (is (= (new-fn) "Awesome"))) +;; +;; Run tests with (run-tests). As in any language with macros, you may +;; need to recompile functions after changing a macro definition. + + + +(clojure/in-ns 'clojure.contrib.test-is) +(clojure/refer 'clojure) + +(def + #^{:doc "PrintWriter to which test results are printed; defaults to + System.err."} + *test-out* (. System err)) + + +;;; PRIVATE + +(defmacro #^{:private true} defcounter [ref-name fn-name] + `(do (def ~(with-meta ref-name {:private true}) nil) + (defn ~fn-name [] + (when ~ref-name (sync nil (commute ~ref-name inc)))))) + +(defcounter *tests* count-test) +(defcounter *assertions* count-assertion) +(defcounter *failures* count-failure) +(defcounter *exceptions* count-exception) + +(defmacro failure [reason message] + `(throw (new java.lang.AssertionError + (str ~reason (when ~message (str "; " ~message)))))) + +(defn- assert-true [form message] + `(do (count-assertion) + (let [value# ~form] + (when-not value# + (failure (str ~(pr-str form) " was false/nil") + ~message))))) + +;; Multimethod for testing expressions, dispatches on the first symbol +;; in the expression. +(defmulti assert-expr (fn [form message] (first form))) + +;; Test for (= actual expected) expressions. +(defmethod assert-expr '= [form message] + (let [expr1 (second form) + expr2 (nth form 2)] + `(do (count-assertion) + (let [value1# ~expr1 + value2# ~expr2] + (when-not (= value1# value2#) + (failure (str ~(pr-str expr1) " is " (pr-str value1#) + " but should be " (pr-str value2#)) + ~message)))))) + +;; Test for (instance? class object) expressions. +(defmethod assert-expr 'instance? [form message] + (let [clazz (second form) + object (nth form 2)] + `(do (count-assertion) + (let [value1# ~clazz + value2# ~object] + (when-not (instance? value1# value2#) + (failure (str ~(pr-str object) " has " (class value2#) + " but should have " (pr-str value1#)) + ~message)))))) + +;; Generic expression test, just check if expression evaluates to +;; logical true. +(defmethod assert-expr :default [form message] + (assert-true form message)) + +(defn- always-fail-assert [message] + `(do (count-assertion) + (failure ~message nil))) + +(defmacro #^{:private true} with-test-counters + "Creates dynamic bindings for counting the number of tests, + assertions, failures, and exceptions. Returns the results in a + map." + [& body] + `(binding [*tests* (ref 0) + *assertions* (ref 0) + *failures* (ref 0) + *exceptions* (ref 0)] + ~@body + {:tests @*tests* + :assertions @*assertions* + :failures @*failures* + :exceptions @*exceptions*})) + +(defn- run-test-fn + "Calls the function; reports errors/exceptions." + [f name] + (try + (count-test) + (f) + (catch java.lang.AssertionError e + (count-failure) + (. *test-out* (println (str "FAIL in " name ": " + (.getMessage e))))) + (catch java.lang.Exception e + (count-exception) + (. *test-out* (println (str "EXCEPTION in " name ":"))) + (.printStackTrace e *test-out*)))) + +(defn- test-var + "Finds and calls the fn in a var's :test metadata." + [v] + (when-let f (:test (meta v)) + (run-test-fn f (str v)))) + +(defn- test-interns + "Tests all interned symbols in the namespace." + [ns] + (let [ns (if (symbol? ns) (find-ns ns) ns)] + (. *test-out* (println (str "Testing " ns))) + (dorun (map test-var (vals (ns-interns ns)))))) + + +;;; PUBLIC + +(defmacro is + "Generic assertion macro. Throws AssertionError if form evaluates + logical false. Optional message will be added to the error. + + form may be one of: + * an equality test like (= expression expected-value) + * an instance? test like (instance? class expression) + * nil, which always fails + * an arbitrary expression, fails if it returns false/nil" + ([form] `(is ~form nil)) + ([form message] + (cond + (nil? form) (always-fail-assert message) + (seq? form) (assert-expr form message) + :else (assert-true form message)))) + +(defn print-results + "Prints a summary of the results from test-ns to *test-out*." + [r] + (. *test-out* + (println (str "\nRan " (:tests r) " tests " + (:assertions r) " assertions.\n" + (:failures r) " failures, " + (:exceptions r) " exceptions."))) ) + +(defn test-ns + "Runs tests on all interned symbols in the namespaces + (symbols or namespace objects). + + Returns a map with the following keys: + :tests => number of tests run + :assertions => number of assertions checked + :failures => number of failed assertions + :exceptions => number of exceptions raised + + If no namespace is given, uses *ns*." + ([] (test-ns *ns*)) + ([& namespaces] + (with-test-counters (dorun (map test-interns namespaces))))) + +(defn run-tests + "Runs tests in the given namespaces and prints a summary of + results. + + If no namespace is given, uses *ns*." + [& namespaces] + (print-results (apply test-ns namespaces))) + +(defn run-all-tests + "Runs tests in all namespaces and prints a summary of results." + [] + (apply run-tests (all-ns))) + +(defmacro deftest + "Defs an unbound Var with body in its :test fn." + [name & body] + `(def ~(with-meta name {:test `(fn [] ~@body)}))) diff --git a/trace/trace.clj b/trace/trace.clj new file mode 100644 index 00000000..9f91d585 --- /dev/null +++ b/trace/trace.clj @@ -0,0 +1,55 @@ +;;; trace.clj -- simple call-tracing macros for Clojure + +;; by Stuart Sierra, http://stuartsierra.com/ +;; June 9, 2008 + +;; Copyright (c) 2008 Stuart Sierra. All rights reserved. The use and +;; distribution terms for this software are covered by the Common +;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php) +;; which can be found in the file CPL.TXT at the root of this +;; distribution. By using this software in any fashion, you are +;; agreeing to be bound by the terms of this license. You must not +;; remove this notice, or any other, from this software. + + +;; This file defines simple "tracing" macros to help you see what your +;; code is doing. + + +(clojure/in-ns 'clojure.contrib.trace) +(clojure/refer 'clojure) + +(def + #^{:doc "PrintStream for trace output. Defaults to System.err."} + *trace-out* (. System err)) + +(defmacro trace + "Prints value of expr to standard error and returns it. Can be + inserted anywhere without affecting surrounding code. Optional + 'name' argument can be used to identify what is being traced." + ([expr] + `(let [value# ~expr] + (. *trace-out* (println + (str "TRACE: " (pr-str value#)))) + value#)) + ([name expr] + `(let [value# ~expr] + (. *trace-out* (println + (str "TRACE " ~name ": " (pr-str value#)))) + value#))) + +(defmacro deftrace + "Use in place of defn; traces each call/return of this fn, including + arguments." + [name & definition] + `(let [f# (fn ~@definition)] + (defn ~name [& args#] + (let [id# (gensym "t")] ; identifier for this invocation + (. *trace-out* + (println (str "TRACE " id# ": " ~(str name) + " called with " (pr-str args#)))) + (let [value# (apply f# args#)] ; call original fn + (. *trace-out* + (println (str "TRACE " id# ": " ~(str name) + " returned " (pr-str value#)))) + value#))))) |