├── .gitignore ├── README.txt ├── Revisions ├── clojurescript ├── MANIFEST.MF ├── README.txt ├── hashtopology.js ├── src │ └── clojure │ │ └── contrib │ │ ├── clojurescript.clj │ │ └── clojurescript │ │ ├── applet.clj │ │ ├── cli.clj │ │ ├── core.js │ │ ├── repl │ │ ├── blank.gif │ │ ├── clojure-logo-anim-03.gif │ │ ├── dots.png │ │ ├── repl.cljs │ │ ├── repl.html │ │ └── repl.js │ │ └── rt.js ├── support-for-clojurescript.patch └── tests │ ├── t01.cljs │ ├── t02.cljs │ ├── t03.cljs │ ├── t04.cljs │ ├── t05.js │ └── t06.cljs ├── config └── jmx.policy ├── doc ├── datalog.markdown └── pprint │ ├── CommonLispFormat.markdown │ └── PrettyPrinting.markdown ├── epl-v10.html ├── launchers └── bash │ └── clj-env-dir ├── pom.xml └── src ├── examples └── clojure │ └── clojure │ └── contrib │ ├── accumulators │ └── examples.clj │ ├── condition │ └── example.clj │ ├── datalog │ └── example.clj │ ├── miglayout │ └── example.clj │ ├── monads │ └── examples.clj │ ├── pprint │ └── examples │ │ ├── hexdump.clj │ │ ├── json.clj │ │ ├── multiply.clj │ │ ├── props.clj │ │ ├── show_doc.clj │ │ └── xml.clj │ ├── probabilities │ ├── examples_finite_distributions.clj │ └── examples_monte_carlo.clj │ ├── stream_utils │ └── examples.clj │ └── types │ └── examples.clj ├── main ├── assembly │ └── dist.xml └── clojure │ └── clojure │ └── contrib │ ├── accumulators.clj │ ├── agent_utils.clj │ ├── apply_macro.clj │ ├── base64.clj │ ├── classpath.clj │ ├── combinatorics.clj │ ├── command_line.clj │ ├── complex_numbers.clj │ ├── cond.clj │ ├── condition.clj │ ├── condition │ └── Condition.clj │ ├── core.clj │ ├── dataflow.clj │ ├── datalog.clj │ ├── datalog │ ├── database.clj │ ├── literals.clj │ ├── magic.clj │ ├── rules.clj │ ├── softstrat.clj │ └── util.clj │ ├── def.clj │ ├── duck_streams.clj │ ├── error_kit.clj │ ├── except.clj │ ├── fcase.clj │ ├── find_namespaces.clj │ ├── fnmap.clj │ ├── fnmap │ └── PersistentFnMap.clj │ ├── gen_html_docs.clj │ ├── generic.clj │ ├── generic │ ├── arithmetic.clj │ ├── collection.clj │ ├── comparison.clj │ ├── functor.clj │ └── math_functions.clj │ ├── graph.clj │ ├── greatest_least.clj │ ├── http │ ├── agent.clj │ └── connection.clj │ ├── import_static.clj │ ├── io.clj │ ├── jar.clj │ ├── java_utils.clj │ ├── javadoc.clj │ ├── javadoc │ ├── browse.clj │ └── browse_ui.clj │ ├── jmx.clj │ ├── jmx │ ├── Bean.clj │ ├── client.clj │ ├── data.clj │ └── server.clj │ ├── json.clj │ ├── lazy_seqs.clj │ ├── lazy_xml.clj │ ├── lazy_xml │ └── with_pull.clj │ ├── logging.clj │ ├── macro_utils.clj │ ├── macros.clj │ ├── map_utils.clj │ ├── math.clj │ ├── miglayout.clj │ ├── miglayout │ └── internal.clj │ ├── mmap.clj │ ├── mock.clj │ ├── mock │ └── test_adapter.clj │ ├── monadic_io_streams.clj │ ├── monads.clj │ ├── ns_utils.clj │ ├── pprint.clj │ ├── pprint │ ├── cl_format.clj │ ├── column_writer.clj │ ├── dispatch.clj │ ├── pprint_base.clj │ ├── pretty_writer.clj │ └── utilities.clj │ ├── probabilities │ ├── finite_distributions.clj │ ├── monte_carlo.clj │ └── random_numbers.clj │ ├── profile.clj │ ├── properties.clj │ ├── prxml.clj │ ├── reflect.clj │ ├── repl_ln.clj │ ├── repl_utils.clj │ ├── repl_utils │ └── javadoc.clj │ ├── seq.clj │ ├── seq_utils.clj │ ├── server_socket.clj │ ├── set.clj │ ├── shell.clj │ ├── shell_out.clj │ ├── singleton.clj │ ├── sql.clj │ ├── sql │ └── internal.clj │ ├── str_utils.clj │ ├── str_utils2.clj │ ├── stream_utils.clj │ ├── string.clj │ ├── strint.clj │ ├── swing_utils.clj │ ├── test_is.clj │ ├── trace.clj │ ├── types.clj │ ├── with_ns.clj │ ├── zip_filter.clj │ └── zip_filter │ └── xml.clj └── test └── clojure └── clojure └── contrib ├── datalog └── tests │ ├── test.clj │ ├── test_database.clj │ ├── test_literals.clj │ ├── test_magic.clj │ ├── test_rules.clj │ ├── test_softstrat.clj │ └── test_util.clj ├── mock └── test_adapter.clj ├── pprint ├── test_cl_format.clj ├── test_helper.clj └── test_pretty.clj ├── test_complex_numbers.clj ├── test_core.clj ├── test_dataflow.clj ├── test_def.clj ├── test_fnmap.clj ├── test_graph.clj ├── test_greatest_least.clj ├── test_io.clj ├── test_jmx.clj ├── test_json.clj ├── test_lazy_seqs.clj ├── test_load_all.clj ├── test_macro_utils.clj ├── test_math.clj ├── test_miglayout.clj ├── test_mock.clj ├── test_monads.clj ├── test_profile.clj ├── test_properties.clj ├── test_prxml.clj ├── test_repl_utils.clj ├── test_seq.clj ├── test_shell.clj ├── test_sql.clj ├── test_string.clj ├── test_strint.clj ├── test_trace.clj └── test_with_ns.clj /.gitignore: -------------------------------------------------------------------------------- 1 | target 2 | -------------------------------------------------------------------------------- /README.txt: -------------------------------------------------------------------------------- 1 | Note - the contrib libs have moved to individual repos under Clojure org - [https://github.com/clojure] 2 | 3 | = Clojure-contrib = 4 | 5 | The user contributions library, clojure.contrib, is a collection of 6 | namespaces each of which implements features that we believe may be 7 | useful to a large part of the Clojure community. 8 | 9 | Clojure-contrib is open source under the Eclipse Public License and is 10 | copyrighted by Rich Hickey and the various contributors. 11 | 12 | Download releases from 13 | http://code.google.com/p/clojure-contrib/downloads 14 | 15 | The official source repository for clojure-contrib is 16 | http://github.com/richhickey/clojure-contrib 17 | 18 | Documentation and APIs are available at 19 | http://richhickey.github.com/clojure-contrib/ 20 | 21 | Issues are maintained in the Assembla space at 22 | http://www.assembla.com/spaces/clojure-contrib 23 | 24 | General discussion occurs in the Clojure Google group at 25 | http://groups.google.com/group/clojure 26 | and developer discussions are in the Clojure Dev Google group at 27 | http://groups.google.com/group/clojure-dev 28 | 29 | Compiled JARs of development snapshots are available at 30 | http://build.clojure.org/ 31 | 32 | 33 | 34 | = Building Clojure-contrib = 35 | 36 | If you downloaded a release distribution or pre-compiled JAR, you 37 | don't need to do anything. 38 | 39 | If you downloaded the sources from Github, you will need Apache Maven 40 | (2.0 or higher) to run the build. See http://maven.apache.org/ 41 | 42 | Run the following command in this directory: 43 | 44 | mvn package 45 | 46 | This will produce the file target/clojure-contrib-${VERSION}.jar that 47 | you can add to your Java classpath. 48 | 49 | Additional build commands are available: 50 | 51 | mvn clojure:repl 52 | To start a Clojure REPL (Read-Eval-Print Loop) 53 | 54 | mvn compile 55 | To compile sources without building a JAR 56 | 57 | mvn test 58 | To run unit tests 59 | 60 | mvn assembly:assembly 61 | To build ZIP/tar distributions containing source and JARs 62 | 63 | To skip the testing phase when building, add "-Dmaven.test.skip=true" 64 | to the mvn command line. 65 | 66 | 67 | 68 | == Compiling with Local clojure.jar == 69 | 70 | If you want to compile/build with a customized clojure.jar file, use 71 | the following command: 72 | 73 | mvn package -Dclojure.jar=/path/to/clojure.jar 74 | 75 | The /path/to/clojure.jar MUST be an absolute path. 76 | 77 | Maven will still download other dependencices, 78 | such as clojure-maven-plugin. 79 | 80 | 81 | 82 | = Clojure-contrib Versions = 83 | 84 | Versions of clojure-contrib are matched to versions of Clojure. 85 | 86 | If you are using Clojure 1.0, use clojure-contrib 1.0.* 87 | 88 | If you are using Clojure 1.1, use clojure-contrib 1.1.* 89 | 90 | If you are using Clojure from the "master" branch on Github, use 91 | clojure-contrib from the "master" branch on Github. 92 | 93 | If you are using Clojure from the "new" branch on Github, use 94 | clojure-contrib from the "new" branch on Github. 95 | 96 | 97 | 98 | = Clojure-contrib Committers = 99 | 100 | The following people are committers to the official clojure-contrib 101 | repositiory: 102 | 103 | Tom Faulhaber 104 | Stephen Gilardi 105 | Christophe Grand 106 | Rich Hickey 107 | Konrad Hinsen 108 | Stuart Holloway 109 | Chris Houser 110 | David Miller 111 | Stuart Sierra 112 | Frantisek Sodomka 113 | -------------------------------------------------------------------------------- /Revisions: -------------------------------------------------------------------------------- 1 | 2008-08-16 All namespace-directory-aware libs have been moved to 2 | src/clojure/contrib. Please udpate your clojure classpaths accordingly. 3 | 4 | 2008-08-16 Revision 134 is the last to contain 5 | non-namespace-directory-aware libs at the top level of this repository. At 6 | the time of this writing, Clojure's SVN version is 1001. 7 | 8 | 2009-05-04 Revision 756 is the one that was current at the time 9 | Clojure 1.0.0 was released. 10 | -------------------------------------------------------------------------------- /clojurescript/MANIFEST.MF: -------------------------------------------------------------------------------- 1 | Manifest-Version: 1.0 2 | Main-Class: clojure.contrib.clojurescript.applet 3 | Class-Path: . 4 | -------------------------------------------------------------------------------- /clojurescript/README.txt: -------------------------------------------------------------------------------- 1 | This directory contains work in progress on what may eventually become 2 | ClojureScript. It currently allows code written in a very small 3 | subset of Clojure to be automatically translated to JavaScript. 4 | 5 | tojs.clj is Clojure code to translate Clojure forms to Javascript. It 6 | was used to generate core.js from clojure's own core.clj and 7 | core_print.clj. 8 | 9 | To run any of the tests from the command line, do something like: 10 | 11 | java -cp ~/build/clojure/clojure.jar:/home/chouser/proj/clojure-contrib/src:src \ 12 | clojure.main src/clojure/contrib/clojurescript/cli.clj -- \ 13 | tests/t03.cljs > t03.js 14 | 15 | Now that you've got the .js file, you can test using Rhino: 16 | 17 | /usr/bin/java -jar /usr/share/java/js.jar \ 18 | -f src/clojure/contrib/clojurescript/rt.js \ 19 | -f src/clojure/contrib/clojurescript/core.js \ 20 | -f t03.js 21 | 22 | To build the applet from the compiled .class files, don't forget to: 23 | 24 | - Extract clojure code into the classes dir 25 | (cd classes; jar -x < ~/build/clojure/clojure.jar) 26 | - Produce the jar: 27 | jar cmf MANIFEST.MF clojurescript-applet.jar -C classes . 28 | 29 | There's plenty more to do. If you'd like to help, contact the Clojure 30 | Google group: clojure@googlegroups.com 31 | 32 | --Chouser 33 | 12 Jan 2009 34 | -------------------------------------------------------------------------------- /clojurescript/hashtopology.js: -------------------------------------------------------------------------------- 1 | // display topology of hashmaps, for debugging 2 | function maptop(x,d) { 3 | d = d || ""; 4 | var d2 = d + " "; 5 | var c = x.constructor.classname; 6 | print(d+c); 7 | switch(c) { 8 | case "PersistentHashMap": maptop(x._root,d2); break; 9 | case "BitmapIndexedNode": 10 | case "FullNode": 11 | for( var i = 0; i < x.nodes.length; ++i ) { 12 | maptop(x.nodes[i],d2); 13 | } 14 | break; 15 | case "HashCollisionNode": 16 | for( var i = 0; i < x.leaves.length; ++i ) { 17 | maptop(x.leaves[i],d2); 18 | } 19 | break; 20 | case "LeafNode": print( d2 + x.key() + " : " + x.val() ); break; 21 | } 22 | } 23 | 24 | y = clojure.lang.PersistentHashMap.EMPTY; 25 | for( var i = 0; i < 10; ++i ) { 26 | y = y.assoc( "a" + String.fromCharCode( 48 + i ), i ); 27 | maptop( y ); 28 | } 29 | -------------------------------------------------------------------------------- /clojurescript/src/clojure/contrib/clojurescript/applet.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Chris Houser, Jan 2009. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | ; Applet that provides Clojure-to-JavaScript functionality to a browser 10 | 11 | (ns clojure.contrib.clojurescript.applet 12 | (:import (java.io PrintWriter StringReader)) 13 | (:gen-class 14 | :extends java.applet.Applet 15 | :methods [[tojs [String] Object]]) 16 | (:use [clojure.contrib.clojurescript :only (formtojs filetojs)]) 17 | (:require [clojure.contrib.duck-streams :as ds])) 18 | 19 | (defn -tojs [this cljstr] 20 | (try 21 | ["js" (with-out-str (filetojs (StringReader. cljstr) 22 | :debug-fn-names false 23 | :debug-comments false 24 | :eval-defmacro true))] 25 | (catch Throwable e 26 | (if (= (.getMessage e) "EOF while reading") 27 | ["incomplete"] 28 | ["err" (with-out-str (.printStackTrace e (PrintWriter. *out*)))])))) 29 | 30 | -------------------------------------------------------------------------------- /clojurescript/src/clojure/contrib/clojurescript/cli.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Chris Houser, Sep 2008-Jan 2009. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | ; Command Line Interface for generating JavaScript from Clojure code. 10 | 11 | (ns clojure.contrib.clojurescript.cli 12 | (:import (java.io PrintWriter StringReader) 13 | (java.net URLDecoder)) 14 | (:use [clojure.contrib.command-line :only (with-command-line)] 15 | [clojure.contrib.clojurescript :only (formtojs filetojs)]) 16 | (:require [clojure.contrib.duck-streams :as ds])) 17 | 18 | (defn mkcore [] 19 | (binding [*out* (ds/writer "core.js")] 20 | (doseq [file ["clojure/core.clj" "clojure/core_print.clj"]] 21 | (filetojs (.getResourceAsStream (clojure.lang.RT/baseLoader) file))))) 22 | 23 | (defn simple-tests [] 24 | (println (formtojs 25 | '(defn foo 26 | ([a b c & d] (prn 3 a b c)) 27 | ([c] 28 | ;(String/asd "hello") 29 | ;(.foo 55) 30 | (let [[a b] [1 2]] 31 | (prn a b c) 32 | "hi"))))) 33 | 34 | (println (formtojs 35 | '(defn foo [a] 36 | (prn "hi") 37 | (let [a 5] 38 | (let [a 10] 39 | (prn "yo") 40 | (prn a)) 41 | (prn a)) 42 | (prn a)))) 43 | 44 | (println (formtojs 45 | '(defn x [] (conj [] (loop [i 5] (if (pos? i) (recur (- i 2)) i)))))) 46 | 47 | ;(println (formtojs '(binding [*out* 5] (set! *out* 10)))) 48 | (println (formtojs '(.replace "a/b/c" "/" "."))) 49 | (println (formtojs '(.getName ":foo"))) 50 | (println (formtojs '(list '(1 "str" 'sym :key) 4 "str2" 6 #{:set 9 8}))) 51 | (println (formtojs '(fn forever[] (forever)))) 52 | (println (formtojs '(fn forever[] (loop [] (recur)))))) 53 | 54 | (when-not *compile-files* 55 | (with-command-line *command-line-args* 56 | "clojurescript.cli -- Compile ClojureScript to JavaScript" 57 | [[simple? "Runs some simple built-in tests"] 58 | [mkcore? "Generates a core.js file"] 59 | [v? verbose? "Includes extra fn names and comments in js"] 60 | filenames] 61 | (cond 62 | simple? (simple-tests) 63 | mkcore? (mkcore) 64 | :else (doseq [filename filenames] 65 | (filetojs filename :debug-fn-names v? :debug-comments v?))))) 66 | -------------------------------------------------------------------------------- /clojurescript/src/clojure/contrib/clojurescript/repl/blank.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/richhickey/clojure-contrib/40b960bba41ba02811ef0e2c632d721eb199649f/clojurescript/src/clojure/contrib/clojurescript/repl/blank.gif -------------------------------------------------------------------------------- /clojurescript/src/clojure/contrib/clojurescript/repl/clojure-logo-anim-03.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/richhickey/clojure-contrib/40b960bba41ba02811ef0e2c632d721eb199649f/clojurescript/src/clojure/contrib/clojurescript/repl/clojure-logo-anim-03.gif -------------------------------------------------------------------------------- /clojurescript/src/clojure/contrib/clojurescript/repl/dots.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/richhickey/clojure-contrib/40b960bba41ba02811ef0e2c632d721eb199649f/clojurescript/src/clojure/contrib/clojurescript/repl/dots.png -------------------------------------------------------------------------------- /clojurescript/src/clojure/contrib/clojurescript/repl/repl.cljs: -------------------------------------------------------------------------------- 1 | (ns jsrepl) 2 | 3 | (def append-dom) 4 | 5 | (defn dom [o] 6 | (if (coll? o) 7 | (let [[tag attrs & body] o] 8 | (if (keyword? tag) 9 | (let [elem (.createElement document (name tag))] 10 | (when (map? attrs) 11 | (doseq [[k v] attrs] 12 | (when v (.setAttribute elem (name k) v)))) 13 | [(append-dom elem (if (map? attrs) body (cons attrs body)))]) 14 | (mapcat dom o))) 15 | (when o 16 | [(.createTextNode document (str o))]))) 17 | 18 | (defn append-dom [parent v] 19 | (doseq [i (dom v)] 20 | (.appendChild parent i)) 21 | parent) 22 | 23 | (def *print-class* nil) 24 | 25 | (defn repl-print [log text] 26 | (doseq [line (.split text #"\n")] 27 | (append-dom log 28 | [:div {:class (str "cg " 29 | (when *print-class* 30 | (str " " *print-class*)))} 31 | line])) 32 | (set! (.scrollTop log) (.scrollHeight log))) 33 | 34 | (defn postexpr [log input] 35 | (append-dom log 36 | [:table 37 | [:tbody 38 | [:tr 39 | [:td {:class "cg"} "user=> "] 40 | [:td (.replace (.value input) #"\n$" "")]]]])) 41 | 42 | (defmacro print-with-class [c m] 43 | `(binding [*print-class* ~c] 44 | (println ~m))) 45 | 46 | (set! *print-length* 103) 47 | 48 | (defmacro let-elem-ids [ids & body] 49 | `(let ~(vec (mapcat #(list % (list '.getElementById 'document (str %))) ids)) 50 | ~@body)) 51 | 52 | (set! (.onload window) (fn [] 53 | (let-elem-ids [log input status applet] 54 | (set! (.print window) #(repl-print log %)) 55 | 56 | (set! (.onkeypress input) 57 | (fn [ev] 58 | (when (== (.keyCode (or ev event)) 13) 59 | (let [[status-name text] (.tojs applet (.value input))] 60 | (if (= status-name "incomplete") 61 | (set! (.src status) "dots.png") 62 | (do 63 | (postexpr log input) 64 | (if (= status-name "js") 65 | (try (prn (.eval window text)) 66 | (catch Exception e 67 | (print-with-class "err" e) 68 | (set! *e e))) 69 | (print-with-class "err" text)) 70 | (setTimeout #(set! (.value input) "") 0) 71 | (set! (.src status) "blank.gif"))))))) 72 | 73 | (println "ClojureScript") 74 | 75 | (.focus input)))) 76 | -------------------------------------------------------------------------------- /clojurescript/src/clojure/contrib/clojurescript/repl/repl.html: -------------------------------------------------------------------------------- 1 | 3 | 4 | 5 | 6 | ClojureScript REPL 7 | 45 | 46 | 47 | 48 | 49 | 50 |
51 |
52 |
53 |
54 | user=> 
55 | 56 |
57 | 58 | 60 | 61 | 62 | 63 | -------------------------------------------------------------------------------- /clojurescript/tests/t01.cljs: -------------------------------------------------------------------------------- 1 | ; This may look like Clojure, but it's actually ClojureScript. Macros 2 | ; may be used here, but should be defined elsewhere, in regular 3 | ; Clojure code. 4 | (ns n01se) 5 | 6 | (defn script-src [] 7 | (for [elem (.getElementsByTagName document "script")] 8 | (if-let [src (.src elem)] 9 | src 10 | "--none--"))) 11 | 12 | (doseq [src (script-src)] 13 | (prn src)) 14 | -------------------------------------------------------------------------------- /clojurescript/tests/t02.cljs: -------------------------------------------------------------------------------- 1 | ; This may look like Clojure, but it's actually ClojureScript. Macros 2 | ; may be used here, but should be defined elsewhere, in regular 3 | ; Clojure code. 4 | (ns n01se) 5 | 6 | (defn my-take 7 | "Returns a lazy seq of the first n items in coll, or all items if 8 | there are fewer than n." 9 | [n coll] 10 | (when (and (pos? n) (seq coll)) 11 | (lazy-cons (first coll) (my-take (dec n) (rest coll))))) 12 | 13 | (defn script-src [] 14 | (for [elem (.getElementsByTagName document "script")] 15 | (do 16 | (prn :next) 17 | (if-let [src (.src elem)] 18 | src 19 | "--none--")))) 20 | 21 | (doseq [src (my-take 2 (script-src))] 22 | (prn src)) 23 | -------------------------------------------------------------------------------- /clojurescript/tests/t03.cljs: -------------------------------------------------------------------------------- 1 | (ns net.n01se) 2 | 3 | (def x 5) 4 | (def y 10) 5 | 6 | (defn bind-test [] 7 | (when (= x 2) 8 | (set! y 90)) 9 | (binding [x (dec x) y (inc y)] 10 | (when (pos? x) 11 | (bind-test))) 12 | (prn x y)) 13 | 14 | (bind-test) 15 | -------------------------------------------------------------------------------- /clojurescript/tests/t04.cljs: -------------------------------------------------------------------------------- 1 | ; This may look like Clojure, but it's actually ClojureScript. Macros 2 | ; may be used here, but should be defined elsewhere, in regular 3 | ; Clojure code. 4 | (ns n01se) 5 | 6 | (defn script-src [] 7 | (for [elem (.getElementsByTagName document "script")] 8 | (do 9 | (prn :next) 10 | (if-let [src (.src elem)] 11 | src 12 | "--none--")))) 13 | 14 | (doseq [src (take 2 (script-src))] 15 | (prn src)) 16 | -------------------------------------------------------------------------------- /clojurescript/tests/t05.js: -------------------------------------------------------------------------------- 1 | function vToString( v ) { 2 | var a = new Array( v.count() ); 3 | for( var i = 0; i < v.count(); ++i ) { 4 | a[ i ] = v.nth( i ); 5 | } 6 | return ['[', a.join(' '), ']'].join(''); 7 | } 8 | 9 | var v = clojure.lang.PersistentVector.EMPTY; 10 | for( var i = 0; i < 100; ++i ) { 11 | v = v.cons( i * 10 ); 12 | } 13 | print( vToString( v ) ); 14 | print( vToString( v.assocN( 20, 999 ) ) ); 15 | 16 | var a = []; 17 | for( v2 = v; v2.count() > 0; v2 = v2.pop() ) { 18 | a.push( v2.peek() ); 19 | } 20 | print( a ); 21 | 22 | v = clojure.lang.PersistentVector.EMPTY; 23 | for( var i = 0; i < 100000; ++i ) { v = v.cons( i ); } 24 | for(; v.count() > 0; v = v.pop() ) { v.peek() }; 25 | 26 | 27 | print( vToString( clojure.lang.PersistentVector.create( 28 | [ 'a', 'b', 'c', 'd', 'e' ] ) ) ); 29 | 30 | function time( msg, fn, reps ) { 31 | reps = reps || 1; 32 | var start = new Date(); 33 | var last; 34 | for( var i = 0; i < reps; ++i ) { 35 | last = fn(); 36 | } 37 | var end = new Date(); 38 | print( msg + ': ' + (end - start) + ' msecs' ); 39 | return last; 40 | } 41 | 42 | var Rand = (function(){ 43 | var cycle = 1000000; 44 | var rnd = new Array( cycle ); 45 | var idx = -1; 46 | for( var i = 0; i < cycle; ++i ) { 47 | rnd[i] = Math.random(); 48 | } 49 | return { 50 | reset: function() { idx = -1; }, 51 | next: function( r ) { 52 | idx = (idx + 1) % cycle; 53 | return Math.floor( rnd[ idx ] * r ); 54 | } 55 | }; 56 | })(); 57 | 58 | function suite( size, writes, reads, reps ) { 59 | print( "Suite size: " + size + ", writes: " + writes + ", reads: " + reads ); 60 | 61 | var a = []; 62 | var p = clojure.lang.PersistentVector.EMPTY; 63 | 64 | time( " Array push", function() { 65 | for( var i = 0; i < size; i++ ) { 66 | a.push( i ); 67 | } 68 | }, reps ); 69 | 70 | time( " PV cons ", function() { 71 | for( var i = 0; i < size; i++ ) { 72 | p = p.cons( i ); 73 | } 74 | }, reps ); 75 | 76 | var ta = 0; 77 | time( " Array set ", function() { 78 | Rand.reset(); 79 | for( var i = 0; i < writes; ++i ) { 80 | a[ Rand.next( size ) ] = i; 81 | } 82 | for( var j = 0; j < reads; ++j ) { 83 | ta += a[ Rand.next( size ) ]; 84 | } 85 | }, reps); 86 | 87 | var tp = 0; 88 | time( " PV set ", function() { 89 | Rand.reset(); 90 | for( var i = 0; i < writes; ++i ) { 91 | p = p.assocN( Rand.next( size ), i ); 92 | } 93 | for( var j = 0; j < reads; ++j ) { 94 | tp += p.nth( Rand.next( size ) ); 95 | } 96 | }, reps); 97 | 98 | print( "Done: " + ta + ", " + tp + "\n" ); 99 | } 100 | 101 | suite( 100000, 10000, 20000 ); 102 | suite( 30, 10000, 20000, 50 ); 103 | suite( 100000, 10000, 0 ); 104 | suite( 30, 10000, 0, 50 ); 105 | suite( 100000, 0, 20000 ); 106 | suite( 30, 0, 20000, 100 ); 107 | 108 | /* 109 | var p = clojure.lang.PersistentVector.EMPTY; 110 | for( var i = 0; i < 1088; i++ ) { 111 | //for( var i = 0; i < 1056; i++ ) { 112 | p = p.cons( i ); 113 | } 114 | print( p.nth( p.count() - 33 ) ) 115 | print( p.cons("oops").nth( p.count() - 33 ) ) 116 | */ 117 | 118 | //print( clojure.lang.PersistentVector.EMPTY.constructor ); 119 | print('done'); 120 | -------------------------------------------------------------------------------- /clojurescript/tests/t06.cljs: -------------------------------------------------------------------------------- 1 | (ns test) 2 | (defn setText []) 3 | 4 | (prn :yo) 5 | (prn (-> clojure .print-method .methodTable)) 6 | (prn (JQuery "#nice")) 7 | (prn (.ready ($ document) test/setText)) 8 | (prn (+ 1 2 3 4)) 9 | -------------------------------------------------------------------------------- /config/jmx.policy: -------------------------------------------------------------------------------- 1 | grant codebase "file:classes"{ 2 | permission javax.management.MBeanTrustPermission "register"; 3 | }; -------------------------------------------------------------------------------- /launchers/bash/clj-env-dir: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Copyright (c) Stephen C. Gilardi. All rights reserved. The use and 4 | # distribution terms for this software are covered by the Eclipse Public 5 | # License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) which can be 6 | # found in the file epl-v10.html at the root of this distribution. By 7 | # using this software in any fashion, you are agreeing to be bound by the 8 | # terms of this license. You must not remove this notice, or any other, 9 | # from this software. 10 | # 11 | # clj-env-dir Launches Clojure, passing along command line arguments. This 12 | # launcher can be configured using environment variables and 13 | # makes it easy to include directories full of classpath roots 14 | # in CLASSPATH. 15 | # 16 | # scgilardi (gmail) 17 | # Created 7 January 2009 18 | # 19 | # Environment variables (optional): 20 | # 21 | # CLOJURE_EXT Colon-delimited list of paths to directories whose top-level 22 | # contents are (either directly or as symbolic links) jar 23 | # files and/or directories whose paths will be in Clojure's 24 | # classpath. The value of the CLASSPATH environment variable 25 | # for Clojure will include these top-level paths followed by 26 | # the previous value of CLASSPATH (if any). 27 | # default: 28 | # example: /usr/local/share/clojure/ext:$HOME/.clojure.d/ext 29 | # 30 | # CLOJURE_JAVA The command to launch a JVM instance for Clojure 31 | # default: java 32 | # example: /usr/local/bin/java6 33 | # 34 | # CLOJURE_OPTS Java options for this JVM instance 35 | # default: 36 | # example:"-Xms32M -Xmx128M -server" 37 | # 38 | # CLOJURE_MAIN The Java class to launch 39 | # default: clojure.main 40 | # example: clojure.contrib.repl_ln 41 | 42 | set -o errexit 43 | #set -o nounset 44 | #set -o xtrace 45 | 46 | if [ -n "${CLOJURE_EXT:-}" ]; then 47 | OLD="$IFS" 48 | IFS=":" 49 | EXT="$(find -H $CLOJURE_EXT -mindepth 1 -maxdepth 1 -print0 | tr \\0 \:)" 50 | IFS="$OLD" 51 | if [ -n "${CLASSPATH:-}" ]; then 52 | export CLASSPATH="$EXT$CLASSPATH" 53 | else 54 | export CLASSPATH="${EXT%:}" 55 | fi 56 | fi 57 | 58 | JAVA=${CLOJURE_JAVA:-java} 59 | OPTS=${CLOJURE_OPTS:-} 60 | MAIN=${CLOJURE_MAIN:-clojure.main} 61 | 62 | exec $JAVA $OPTS $MAIN "$@" 63 | -------------------------------------------------------------------------------- /src/examples/clojure/clojure/contrib/accumulators/examples.clj: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3 | ;; 4 | ;; Accumulator application examples 5 | ;; 6 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8 | 9 | (ns 10 | #^{:author "Konrad Hinsen" 11 | :skip-wiki true 12 | :doc "Examples for using accumulators"} 13 | clojure.contrib.accumulators.examples 14 | (:use [clojure.contrib.accumulators 15 | :only (combine add add-items 16 | empty-vector empty-list empty-queue empty-set empty-map 17 | empty-counter empty-counter-with-total 18 | empty-sum empty-product empty-maximum empty-minimum 19 | empty-min-max empty-mean-variance empty-string empty-tuple)])) 20 | 21 | ; Vector accumulator: combine is concat, add is conj 22 | (combine [:a :b] [:c :d] [:x :y]) 23 | (add [:a :b] :c) 24 | (add-items empty-vector [:a :b :a]) 25 | 26 | ; List accumulator: combine is concat, add is conj 27 | (combine '(:a :b) '(:c :d) '(:x :y)) 28 | (add '(:a :b) :c) 29 | (add-items empty-list [:a :b :a]) 30 | 31 | ; Queue accumulator 32 | (let [q1 (add-items empty-queue [:a :b :a]) 33 | q2 (add-items empty-queue [:x :y])] 34 | (combine q1 q2)) 35 | 36 | ; Set accumulator: combine is union, add is conj 37 | (combine #{:a :b} #{:c :d} #{:a :d}) 38 | (add #{:a :b} :c) 39 | (add-items empty-set [:a :b :a]) 40 | 41 | ; Map accumulator: combine is merge, add is conj 42 | (combine {:a 1} {:b 2 :c 3} {}) 43 | (add {:a 1} [:b 2]) 44 | (add-items empty-map [[:a 1] [:b 2] [:a 0]]) 45 | 46 | ; Counter accumulator 47 | (let [c1 (add-items empty-counter [:a :b :a]) 48 | c2 (add-items empty-counter [:x :y])] 49 | (combine c1 c2)) 50 | 51 | ; Counter-with-total accumulator 52 | (let [c1 (add-items empty-counter-with-total [:a :b :a]) 53 | c2 (add-items empty-counter-with-total [:x :y])] 54 | (combine c1 c2)) 55 | 56 | ; Sum accumulator: combine is addition 57 | (let [s1 (add-items empty-sum [1 2 3]) 58 | s2 (add-items empty-sum [-1 -2 -3])] 59 | (combine s1 s2)) 60 | 61 | ; Product accumulator: combine is multiplication 62 | (let [p1 (add-items empty-product [2 3]) 63 | p2 (add-items empty-product [(/ 1 2)])] 64 | (combine p1 p2)) 65 | 66 | ; Maximum accumulator: combine is max 67 | (let [m1 (add-items empty-maximum [2 3]) 68 | m2 (add-items empty-maximum [(/ 1 2)])] 69 | (combine m1 m2)) 70 | 71 | ; Minimum accumulator: combine is min 72 | (let [m1 (add-items empty-minimum [2 3]) 73 | m2 (add-items empty-minimum [(/ 1 2)])] 74 | (combine m1 m2)) 75 | 76 | ; Min-max accumulator: combination of minimum and maximum 77 | (let [m1 (add-items empty-min-max [2 3]) 78 | m2 (add-items empty-min-max [(/ 1 2)])] 79 | (combine m1 m2)) 80 | 81 | ; Mean-variance accumulator: sample mean and sample variance 82 | (let [m1 (add-items empty-mean-variance [2 4]) 83 | m2 (add-items empty-mean-variance [6])] 84 | (combine m1 m2)) 85 | 86 | ; String accumulator: combine is concatenation 87 | (combine "a" "b" "c" "def") 88 | (add "a" (char 44)) 89 | (add-items empty-string [(char 55) (char 56) (char 57)]) 90 | 91 | ; Accumulator tuples permit to update several accumulators in parallel 92 | (let [pair (empty-tuple [empty-vector empty-string])] 93 | (add-items pair [[1 "a"] [2 "b"]])) 94 | -------------------------------------------------------------------------------- /src/examples/clojure/clojure/contrib/condition/example.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Stephen C. Gilardi. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; clojure.contrib.condition.example.clj 10 | ;; 11 | ;; scgilardi (gmail) 12 | ;; Created 09 June 2009 13 | 14 | (ns clojure.contrib.condition.example 15 | (:use (clojure.contrib 16 | [condition 17 | :only (handler-case print-stack-trace raise *condition*)]))) 18 | 19 | (defn func [x y] 20 | "Raises an exception if x is negative" 21 | (when (neg? x) 22 | (raise :type :illegal-argument :arg 'x :value x)) 23 | (+ x y)) 24 | 25 | (defn main 26 | [] 27 | 28 | ;; simple handler 29 | 30 | (handler-case :type 31 | (println (func 3 4)) 32 | (println (func -5 10)) 33 | (handle :illegal-argument 34 | (print-stack-trace *condition*)) 35 | (println 3)) 36 | 37 | ;; multiple handlers 38 | 39 | (handler-case :type 40 | (println (func 4 1)) 41 | (println (func -3 22)) 42 | (handle :overflow 43 | (print-stack-trace *condition*)) 44 | (handle :illegal-argument 45 | (print-stack-trace *condition*))) 46 | 47 | ;; nested handlers 48 | 49 | (handler-case :type 50 | (handler-case :type 51 | nil 52 | nil 53 | (println 1) 54 | (println 2) 55 | (println 3) 56 | (println (func 8 2)) 57 | (println (func -6 17)) 58 | ;; no handler for :illegal-argument 59 | (handle :overflow 60 | (println "nested") 61 | (print-stack-trace *condition*))) 62 | (println (func 3 4)) 63 | (println (func -5 10)) 64 | (handle :illegal-argument 65 | (println "outer") 66 | (print-stack-trace *condition*)))) 67 | -------------------------------------------------------------------------------- /src/examples/clojure/clojure/contrib/miglayout/example.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Stephen C. Gilardi. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; clojure.contrib.miglayout.example 10 | ;; 11 | ;; A temperature converter using miglayout. Demonstrates accessing 12 | ;; components by their id constraint. 13 | ;; 14 | ;; scgilardi (gmail) 15 | ;; Created 31 May 2009 16 | 17 | (ns clojure.contrib.miglayout.example 18 | (:import (javax.swing JButton JFrame JLabel JPanel JTextField 19 | SwingUtilities)) 20 | (:use (clojure.contrib 21 | [miglayout :only (miglayout components)] 22 | [swing-utils :only (add-key-typed-listener)]))) 23 | 24 | (defn fahrenheit 25 | "Converts a Celsius temperature to Fahrenheit. Input and output are 26 | strings. Returns \"input?\" if the input can't be parsed as a Double." 27 | [celsius] 28 | (try 29 | (format "%.2f" (+ 32 (* 1.8 (Double/parseDouble celsius)))) 30 | (catch NumberFormatException _ "input?"))) 31 | 32 | (defn- handle-key 33 | "Clears output on most keys, shows conversion on \"Enter\"" 34 | [event out] 35 | (.setText out 36 | (if (= (.getKeyChar event) \newline) 37 | (fahrenheit (-> event .getComponent .getText)) 38 | ""))) 39 | 40 | (defn converter-ui 41 | "Lays out and shows a Temperature Converter UI" 42 | [] 43 | (let [panel 44 | (miglayout (JPanel.) 45 | (JTextField. 6) {:id :input} 46 | (JLabel. "\u00b0Celsius") :wrap 47 | (JLabel.) {:id :output} 48 | (JLabel. "\u00b0Fahrenheit")) 49 | {:keys [input output]} (components panel)] 50 | (add-key-typed-listener input handle-key output) 51 | (doto (JFrame. "Temperature Converter") 52 | (.setDefaultCloseOperation JFrame/DISPOSE_ON_CLOSE) 53 | (.add panel) 54 | (.pack) 55 | (.setVisible true)))) 56 | 57 | (defn main 58 | "Invokes converter-ui in the AWT Event thread" 59 | [] 60 | (SwingUtilities/invokeLater converter-ui)) 61 | -------------------------------------------------------------------------------- /src/examples/clojure/clojure/contrib/pprint/examples/hexdump.clj: -------------------------------------------------------------------------------- 1 | ;;; hexdump.clj -- part of the pretty printer for Clojure 2 | 3 | ;; by Tom Faulhaber 4 | ;; April 3, 2009 5 | 6 | ; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved. 7 | ; The use and distribution terms for this software are covered by the 8 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ; which can be found in the file epl-v10.html at the root of this distribution. 10 | ; By using this software in any fashion, you are agreeing to be bound by 11 | ; the terms of this license. 12 | ; You must not remove this notice, or any other, from this software. 13 | 14 | ;; This example is a classic hexdump program written using cl-format. 15 | 16 | ;; For some local color, it was written in Dulles Airport while waiting for a flight 17 | ;; home to San Francisco. 18 | 19 | (ns clojure.contrib.pprint.examples.hexdump 20 | (:use clojure.contrib.pprint 21 | clojure.contrib.pprint.utilities) 22 | (:gen-class (:main true))) 23 | 24 | (def *buffer-length* 1024) 25 | 26 | (defn zip-array [base-offset arr] 27 | (let [grouped (partition 16 arr)] 28 | (first (map-passing-context 29 | (fn [line offset] 30 | [[offset 31 | (map #(if (neg? %) (+ % 256) %) line) 32 | (- 16 (count line)) 33 | (map #(if (<= 32 % 126) (char %) \.) line)] 34 | (+ 16 offset)]) 35 | base-offset grouped)))) 36 | 37 | 38 | (defn hexdump 39 | ([in-stream] (hexdump in-stream true 0)) 40 | ([in-stream out-stream] (hexdump [in-stream out-stream 0])) 41 | ([in-stream out-stream offset] 42 | (let [buf (make-array Byte/TYPE *buffer-length*)] 43 | (loop [offset offset 44 | count (.read in-stream buf)] 45 | (if (neg? count) 46 | nil 47 | (let [bytes (take count buf) 48 | zipped (zip-array offset bytes)] 49 | (cl-format out-stream 50 | "~:{~8,'0X: ~2{~8@{~#[ ~:;~2,'0X ~]~} ~}~v@{ ~}~2{~8@{~A~} ~}~%~}" 51 | zipped) 52 | (recur (+ offset *buffer-length*) (.read in-stream buf)))))))) 53 | 54 | (defn hexdump-file 55 | ([file-name] (hexdump-file file-name true)) 56 | ([file-name stream] 57 | (with-open [s (java.io.FileInputStream. file-name)] 58 | (hexdump s)))) 59 | 60 | ;; I don't quite understand how to invoke main funcs w/o AOT yet 61 | (defn -main [& args] 62 | (hexdump-file (first args))) 63 | 64 | -------------------------------------------------------------------------------- /src/examples/clojure/clojure/contrib/pprint/examples/multiply.clj: -------------------------------------------------------------------------------- 1 | ;;; multiply.clj -- part of the pretty printer for Clojure 2 | 3 | ;; by Tom Faulhaber 4 | ;; April 3, 2009 5 | 6 | ; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved. 7 | ; The use and distribution terms for this software are covered by the 8 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ; which can be found in the file epl-v10.html at the root of this distribution. 10 | ; By using this software in any fashion, you are agreeing to be bound by 11 | ; the terms of this license. 12 | ; You must not remove this notice, or any other, from this software. 13 | 14 | ;; This example prints a multiplication table using cl-format. 15 | 16 | (ns clojure.contrib.pprint.examples.multiply 17 | (:use clojure.contrib.pprint)) 18 | 19 | (defn multiplication-table [limit] 20 | (let [nums (range 1 (inc limit))] 21 | (cl-format true "~{~{~4d~}~%~}" 22 | (map #(map % nums) 23 | (map #(partial * %) nums))))) 24 | -------------------------------------------------------------------------------- /src/examples/clojure/clojure/contrib/pprint/examples/props.clj: -------------------------------------------------------------------------------- 1 | ;;; props.clj -- part of the pretty printer for Clojure 2 | 3 | ;; by Tom Faulhaber 4 | ;; April 3, 2009 5 | 6 | ; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved. 7 | ; The use and distribution terms for this software are covered by the 8 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ; which can be found in the file epl-v10.html at the root of this distribution. 10 | ; By using this software in any fashion, you are agreeing to be bound by 11 | ; the terms of this license. 12 | ; You must not remove this notice, or any other, from this software. 13 | 14 | ;; This example displays a nicely formatted table of the java properties using 15 | ;; cl-format 16 | 17 | (ns clojure.contrib.pprint.examples.props 18 | (:use clojure.contrib.pprint)) 19 | 20 | (defn show-props [stream] 21 | (let [p (mapcat 22 | #(vector (key %) (val %)) 23 | (sort-by key (System/getProperties)))] 24 | (cl-format true "~30A~A~%~{~20,,,'-A~10A~}~%~{~30A~S~%~}" 25 | "Property" "Value" ["" "" "" ""] p))) 26 | -------------------------------------------------------------------------------- /src/examples/clojure/clojure/contrib/pprint/examples/show_doc.clj: -------------------------------------------------------------------------------- 1 | ;;; show_doc.clj -- part of the pretty printer for Clojure 2 | 3 | ;; by Tom Faulhaber 4 | ;; April 3, 2009 5 | 6 | ; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved. 7 | ; The use and distribution terms for this software are covered by the 8 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ; which can be found in the file epl-v10.html at the root of this distribution. 10 | ; By using this software in any fashion, you are agreeing to be bound by 11 | ; the terms of this license. 12 | ; You must not remove this notice, or any other, from this software. 13 | 14 | ;; This example uses cl-format as part of a routine to display all the doc 15 | ;; strings and function arguments from one or more namespaces. 16 | 17 | (ns clojure.contrib.pprint.examples.show-doc 18 | (:use clojure.contrib.pprint)) 19 | 20 | (defn ns-list 21 | ([] (ns-list nil)) 22 | ([pattern] 23 | (filter 24 | (if pattern 25 | (comp (partial re-find pattern) name ns-name) 26 | (constantly true)) 27 | (sort-by ns-name (all-ns))))) 28 | 29 | (defn show-doc 30 | ([] (show-doc nil)) 31 | ([pattern] 32 | (cl-format 33 | true 34 | "~:{~A: ===============================================~ 35 | ~%~{~{~a: ~{~a~^, ~}~%~a~%~}~^~%~}~2%~}" 36 | (map 37 | #(vector (ns-name %) 38 | (map 39 | (fn [f] 40 | (let [f-meta (meta (find-var (symbol (str (ns-name %)) (str f))))] 41 | [f (:arglists f-meta) (:doc f-meta)])) 42 | (filter 43 | (fn [a] (instance? clojure.lang.IFn a)) 44 | (sort (map key (ns-publics %)))))) 45 | (ns-list pattern))))) 46 | 47 | (defn create-api-file [pattern out-file] 48 | (with-open [f (java.io.FileWriter. out-file)] 49 | (binding [*out* f] 50 | (show-doc pattern)))) 51 | -------------------------------------------------------------------------------- /src/examples/clojure/clojure/contrib/probabilities/examples_monte_carlo.clj: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3 | ;; 4 | ;; Monte-Carlo application examples 5 | ;; 6 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8 | 9 | (ns 10 | #^{:author "Konrad Hinsen" 11 | :skip-wiki true 12 | :doc "Examples for monte carlo methods"} 13 | clojure.contrib.probabilities.random.examples-monte-carlo 14 | (:require [clojure.contrib.generic.collection :as gc]) 15 | (:use [clojure.contrib.probabilities.random-numbers 16 | :only (lcg rand-stream)]) 17 | (:use [clojure.contrib.probabilities.finite-distributions 18 | :only (uniform)]) 19 | (:use [clojure.contrib.probabilities.monte-carlo 20 | :only (random-stream discrete interval normal lognormal exponential 21 | n-sphere 22 | sample sample-sum sample-mean sample-mean-variance)] 23 | :reload) 24 | (:use [clojure.contrib.monads 25 | :only (domonad state-m)])) 26 | 27 | ; Create a linear congruential generator 28 | (def urng (lcg 259200 7141 54773 1)) 29 | 30 | ;; Use Clojure's built-in random number generator 31 | ;(def urng rand-stream) 32 | 33 | ; Sample transformed distributions 34 | (defn sample-distribution 35 | [n rt] 36 | (take n (gc/seq (random-stream rt urng)))) 37 | 38 | ; Interval [-2, 2) 39 | (sample-distribution 10 (interval -2 2)) 40 | ; Compare with a direct transformation 41 | (= (sample-distribution 10 (interval -2 2)) 42 | (map (fn [x] (- (* 4 x) 2)) (take 10 (gc/seq urng)))) 43 | 44 | ; Normal distribution 45 | (sample-distribution 10 (normal 0 1)) 46 | 47 | ; Log-Normal distribution 48 | (sample-distribution 10 (lognormal 0 1)) 49 | 50 | ; Exponential distribution 51 | (sample-distribution 10 (exponential 1)) 52 | 53 | ; n-sphere distribution 54 | (sample-distribution 10 (n-sphere 2 1)) 55 | 56 | ; Discrete distribution 57 | (sample-distribution 10 (discrete (uniform (range 1 7)))) 58 | 59 | ; Compose distributions in the state monad 60 | (def sum-two-dists 61 | (domonad state-m 62 | [r1 (interval -2 2) 63 | r2 (normal 0 1)] 64 | (+ r1 r2))) 65 | 66 | (sample-distribution 10 sum-two-dists) 67 | 68 | ; Distribution transformations 69 | (sample-distribution 5 (sample 2 (interval -2 2))) 70 | (sample-distribution 10 (sample-sum 10 (interval -2 2))) 71 | (sample-distribution 10 (sample-mean 10 (interval -2 2))) 72 | (sample-distribution 10 (sample-mean-variance 10 (interval -2 2))) 73 | 74 | -------------------------------------------------------------------------------- /src/examples/clojure/clojure/contrib/stream_utils/examples.clj: -------------------------------------------------------------------------------- 1 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3 | ;; 4 | ;; Stream application examples 5 | ;; 6 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 7 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 8 | 9 | (ns 10 | #^{:author "Konrad Hinsen" 11 | :skip-wiki true 12 | :doc "Examples for data streams"} 13 | clojure.contrib.stream-utils.examples 14 | (:refer-clojure :exclude (deftype)) 15 | (:use [clojure.contrib.stream-utils 16 | :only (defst stream-next 17 | pick pick-all 18 | stream-type defstream 19 | stream-drop stream-map stream-filter stream-flatten)]) 20 | (:use [clojure.contrib.monads :only (domonad)]) 21 | (:use [clojure.contrib.types :only (deftype)]) 22 | (:require [clojure.contrib.generic.collection :as gc])) 23 | 24 | ; 25 | ; Define a stream of Fibonacci numbers 26 | ; 27 | (deftype ::fib-stream last-two-fib) 28 | 29 | (defstream ::fib-stream 30 | [fs] 31 | (let [[n1 n2] fs] 32 | [n1 (last-two-fib [n2 (+ n1 n2)])])) 33 | 34 | (def fib-stream (last-two-fib [0 1])) 35 | 36 | (take 10 (gc/seq fib-stream)) 37 | 38 | ; 39 | ; A simple random number generator, implemented as a stream 40 | ; 41 | (deftype ::random-seed rng-seed vector seq) 42 | 43 | (defstream ::random-seed 44 | [seed] 45 | (let [[seed] seed 46 | m 259200 47 | value (/ (float seed) (float m)) 48 | next (rem (+ 54773 (* 7141 seed)) m)] 49 | [value (rng-seed next)])) 50 | 51 | (take 10 (gc/seq (rng-seed 1))) 52 | 53 | ; 54 | ; Various stream utilities 55 | ; 56 | (take 10 (gc/seq (stream-drop 10 (rng-seed 1)))) 57 | (gc/seq (stream-map inc (range 5))) 58 | (gc/seq (stream-filter odd? (range 10))) 59 | (gc/seq (stream-flatten (partition 3 (range 9)))) 60 | 61 | ; 62 | ; Stream transformers 63 | ; 64 | 65 | ; Transform a stream of numbers into a stream of sums of two 66 | ; consecutive numbers. 67 | (defst sum-two [] [xs] 68 | (domonad 69 | [x1 (pick xs) 70 | x2 (pick xs)] 71 | (+ x1 x2))) 72 | 73 | (def s (sum-two '(1 2 3 4 5 6 7 8))) 74 | 75 | (let [[v1 s] (stream-next s)] 76 | (let [[v2 s] (stream-next s)] 77 | (let [[v3 s] (stream-next s)] 78 | (let [[v4 s] (stream-next s)] 79 | (let [[v5 s] (stream-next s)] 80 | [v1 v2 v3 v4 v5]))))) 81 | 82 | (gc/seq s) 83 | 84 | ; Map (for a single stream) written as a stream transformer 85 | (defst my-map-1 [f] [xs] 86 | (domonad 87 | [x (pick xs)] 88 | (f x))) 89 | 90 | (gc/seq (my-map-1 inc [1 2 3])) 91 | 92 | ; Map for two stream arguments 93 | (defst my-map-2 [f] [xs ys] 94 | (domonad 95 | [x (pick xs) 96 | y (pick ys)] 97 | (f x y))) 98 | 99 | (gc/seq (my-map-2 + '(1 2 3 4) '(10 20 30 40))) 100 | 101 | ; Map for any number of stream arguments 102 | (defst my-map [f] [& streams] 103 | (domonad 104 | [vs pick-all] 105 | (apply f vs))) 106 | 107 | (gc/seq (my-map inc [1 2 3])) 108 | (gc/seq (my-map + '(1 2 3 4) '(10 20 30 40))) 109 | 110 | ; Filter written as a stream transformer 111 | (defst my-filter [p] [xs] 112 | (domonad 113 | [x (pick xs) :when (p x)] 114 | x)) 115 | 116 | (gc/seq (my-filter odd? [1 2 3])) 117 | 118 | -------------------------------------------------------------------------------- /src/main/assembly/dist.xml: -------------------------------------------------------------------------------- 1 | 4 | dist 5 | 6 | zip 7 | tar.gz 8 | tar.bz2 9 | 10 | 11 | 12 | ${project.basedir} 13 | / 14 | true 15 | 16 | README.* 17 | epl-v10.* 18 | NOTICE.* 19 | Revisions 20 | pom.xml 21 | src/** 22 | target/*.jar 23 | launchers/** 24 | clojurescript/** 25 | 26 | 27 | 28 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/agent_utils.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Christophe Grand, November 2008. All rights reserved. 2 | 3 | ; The use and distribution terms for this software are covered by the 4 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 5 | ; which can be found in the file epl-v10.html at the root of this 6 | ; distribution. 7 | ; By using this software in any fashion, you are agreeing to be bound by 8 | ; the terms of this license. 9 | ; You must not remove this notice, or any other, from this software. 10 | 11 | ;; misc agent utilities 12 | 13 | ;; note to other contrib members: feel free to add to this lib 14 | 15 | (ns 16 | #^{:author "Christophe Grande", 17 | :doc "Miscellaneous agent utilities 18 | (note to other contrib members: feel free to add to this lib)", 19 | } 20 | clojure.contrib.agent-utils) 21 | 22 | (defmacro capture-and-send 23 | "Capture the current value of the specified vars and rebind 24 | them on the agent thread before executing the action. 25 | 26 | Example: 27 | (capture-and-send [*out*] a f b c)" 28 | 29 | [vars agent action & args] 30 | (let [locals (map #(gensym (name %)) vars)] 31 | `(let [~@(interleave locals vars) 32 | action# (fn [& args#] 33 | (binding [~@(interleave vars locals)] 34 | (apply ~action args#)))] 35 | (send ~agent action# ~@args)))) 36 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/apply_macro.clj: -------------------------------------------------------------------------------- 1 | ;;; apply_macro.clj: make macros behave like functions 2 | 3 | ;; by Stuart Sierra, http://stuartsierra.com/ 4 | ;; January 28, 2009 5 | 6 | ;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | 15 | ;; Don't use this. I mean it. It's evil. How evil? You can't 16 | ;; handle it, that's how evil it is. That's right. I did it so you 17 | ;; don't have to, ok? Look but don't touch. Use this lib and you'll 18 | ;; go blind. 19 | 20 | 21 | (ns clojure.contrib.apply-macro) 22 | 23 | ;; Copied from clojure.core/spread, which is private. 24 | (defn- spread 25 | "Flatten final argument list as in apply." 26 | [arglist] 27 | (cond 28 | (nil? arglist) nil 29 | (nil? (rest arglist)) (seq (first arglist)) 30 | :else (cons (first arglist) (spread (rest arglist))))) 31 | 32 | (defmacro apply-macro 33 | "This is evil. Don't ever use it. It makes a macro behave like a 34 | function. Seriously, how messed up is that? 35 | 36 | Evaluates all args, then uses them as arguments to the macro as with 37 | apply. 38 | 39 | (def things [true true false]) 40 | (apply-macro and things) 41 | ;; Expands to: (and true true false)" 42 | [macro & args] 43 | (cons macro (spread (map eval args)))) 44 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/classpath.clj: -------------------------------------------------------------------------------- 1 | ;;; classpath.clj: utilities for working with the Java class path 2 | 3 | ;; by Stuart Sierra, http://stuartsierra.com/ 4 | ;; April 19, 2009 5 | 6 | ;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | 15 | (ns 16 | #^{:author "Stuart Sierra", 17 | :doc "Utilities for dealing with the JVM's classpath"} 18 | clojure.contrib.classpath 19 | (:require [clojure.contrib.jar :as jar]) 20 | (:import (java.io File) 21 | (java.util.jar JarFile))) 22 | 23 | (defn classpath 24 | "Returns a sequence of File objects of the elements on CLASSPATH." 25 | [] 26 | (map #(File. %) 27 | (.split (System/getProperty "java.class.path") 28 | (System/getProperty "path.separator")))) 29 | 30 | (defn classpath-directories 31 | "Returns a sequence of File objects for the directories on classpath." 32 | [] 33 | (filter #(.isDirectory %) (classpath))) 34 | 35 | (defn classpath-jarfiles 36 | "Returns a sequence of JarFile objects for the JAR files on classpath." 37 | [] 38 | (map #(JarFile. %) (filter jar/jar-file? (classpath)))) 39 | 40 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/cond.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Stephen C. Gilardi. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; File: cond.clj 10 | ;; 11 | ;; scgilardi (gmail) 12 | ;; 2 October 2008 13 | 14 | (ns #^{:author "Stephen C. Gilardi" 15 | :doc "Extensions to the basic cond function."} 16 | clojure.contrib.cond) 17 | 18 | (defmacro cond-let 19 | "Takes a binding-form and a set of test/expr pairs. Evaluates each test 20 | one at a time. If a test returns logical true, cond-let evaluates and 21 | returns expr with binding-form bound to the value of test and doesn't 22 | evaluate any of the other tests or exprs. To provide a default value 23 | either provide a literal that evaluates to logical true and is 24 | binding-compatible with binding-form, or use :else as the test and don't 25 | refer to any parts of binding-form in the expr. (cond-let binding-form) 26 | returns nil." 27 | [bindings & clauses] 28 | (let [binding (first bindings)] 29 | (when-let [[test expr & more] clauses] 30 | (if (= test :else) 31 | expr 32 | `(if-let [~binding ~test] 33 | ~expr 34 | (cond-let ~bindings ~@more)))))) 35 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/condition/Condition.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Stephen C. Gilardi. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; Condition.clj 10 | ;; 11 | ;; Used by clojure.contrib.condition to implement a "Throwable map" 12 | ;; 13 | ;; scgilardi (gmail) 14 | ;; Created 09 June 2009 15 | 16 | (ns clojure.contrib.condition.Condition 17 | (:gen-class :extends Throwable 18 | :implements [clojure.lang.IMeta] 19 | :state state 20 | :init init 21 | :post-init post-init 22 | :constructors {[clojure.lang.IPersistentMap] 23 | [String Throwable]})) 24 | 25 | (defn -init 26 | "Constructs a Condition object with condition (a map) as its 27 | metadata. Also initializes the superclass with the values at :message 28 | and :cause, if any, so they are also available via .getMessage and 29 | .getCause." 30 | [condition] 31 | [[(:message condition) (:cause condition)] (atom condition)]) 32 | 33 | (defn -post-init 34 | "Adds :stack-trace to the condition. Drops the bottom 3 frames because 35 | they are always the same: implementation details of Condition and raise." 36 | [this condition] 37 | (swap! (.state this) assoc 38 | :stack-trace (into-array (drop 3 (.getStackTrace this))))) 39 | 40 | (defn -meta 41 | "Returns this object's metadata, the condition" 42 | [this] 43 | @(.state this)) 44 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/core.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Laurent Petit and others, March 2009. All rights reserved. 2 | 3 | ; The use and distribution terms for this software are covered by the 4 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 5 | ; which can be found in the file epl-v10.html at the root of this 6 | ; distribution. 7 | ; By using this software in any fashion, you are agreeing to be bound by 8 | ; the terms of this license. 9 | ; You must not remove this notice, or any other, from this software. 10 | 11 | ;; functions/macros variants of the ones that can be found in clojure.core 12 | 13 | ;; note to other contrib members: feel free to add to this lib 14 | 15 | (ns 16 | #^{:author "Laurent Petit (and others)" 17 | :doc "Functions/macros variants of the ones that can be found in clojure.core 18 | (note to other contrib members: feel free to add to this lib)"} 19 | clojure.contrib.core 20 | (:use clojure.contrib.def)) 21 | 22 | (defmacro- defnilsafe [docstring non-safe-name nil-safe-name] 23 | `(defmacro ~nil-safe-name ~docstring 24 | {:arglists '([~'x ~'form] [~'x ~'form ~'& ~'forms])} 25 | ([x# form#] 26 | `(let [~'i# ~x#] (when-not (nil? ~'i#) (~'~non-safe-name ~'i# ~form#)))) 27 | ([x# form# & more#] 28 | `(~'~nil-safe-name (~'~nil-safe-name ~x# ~form#) ~@more#)))) 29 | 30 | (defnilsafe 31 | "Same as clojure.core/-> but returns nil as soon as the threaded value is nil itself (thus short-circuiting any pending computation). 32 | Examples : 33 | (-?> \"foo\" .toUpperCase (.substring 1)) returns \"OO\" 34 | (-?> nil .toUpperCase (.substring 1)) returns nil 35 | " 36 | -> -?>) 37 | 38 | (defnilsafe 39 | "Same as clojure.core/.. but returns nil as soon as the threaded value is nil itself (thus short-circuiting any pending computation). 40 | Examples : 41 | (.?. \"foo\" .toUpperCase (.substring 1)) returns \"OO\" 42 | (.?. nil .toUpperCase (.substring 1)) returns nil 43 | " 44 | .. .?.) 45 | 46 | (defnilsafe 47 | "Same as clojure.core/->> but returns nil as soon as the threaded value is nil itself (thus short-circuiting any pending computation). 48 | Examples : 49 | (-?>> (range 5) (map inc)) returns (1 2 3 4 5) 50 | (-?>> [] seq (map inc)) returns nil 51 | " 52 | ->> -?>>) 53 | 54 | ;; ---------------------------------------------------------------------- 55 | ;; scgilardi at gmail 56 | 57 | (defn dissoc-in 58 | "Dissociates an entry from a nested associative structure returning a new 59 | nested structure. keys is a sequence of keys. Any empty maps that result 60 | will not be present in the new structure." 61 | [m [k & ks :as keys]] 62 | (if ks 63 | (if-let [nextmap (get m k)] 64 | (let [newmap (dissoc-in nextmap ks)] 65 | (if (seq newmap) 66 | (assoc m k newmap) 67 | (dissoc m k))) 68 | m) 69 | (dissoc m k))) 70 | 71 | (defn new-by-name 72 | "Constructs a Java object whose class is specified by a String." 73 | [class-name & args] 74 | (clojure.lang.Reflector/invokeConstructor 75 | (clojure.lang.RT/classForName class-name) 76 | (into-array Object args))) 77 | 78 | (defn seqable? 79 | "Returns true if (seq x) will succeed, false otherwise." 80 | [x] 81 | (or (seq? x) 82 | (instance? clojure.lang.Seqable x) 83 | (nil? x) 84 | (instance? Iterable x) 85 | (-> x .getClass .isArray) 86 | (string? x) 87 | (instance? java.util.Map x))) 88 | 89 | ;; ---------------------------------------------------------------------- 90 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/datalog.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Jeffrey Straszheim. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; datalog.clj 10 | ;; 11 | ;; A Clojure implementation of Datalog 12 | ;; 13 | ;; straszheimjeffrey (gmail) 14 | ;; Created 2 March 2009 15 | 16 | 17 | ;;; Please see the example.clj file in the datalog folder 18 | 19 | 20 | (ns 21 | #^{:author "Jeffrey Straszheim", 22 | :doc "A Clojure implementation of Datalog"} 23 | clojure.contrib.datalog 24 | (:use clojure.contrib.datalog.rules 25 | clojure.contrib.datalog.softstrat 26 | clojure.contrib.datalog.database) 27 | (:use [clojure.set :only (intersection)] 28 | [clojure.contrib.except :only (throwf)])) 29 | 30 | (defstruct work-plan 31 | :work-plan ; The underlying structure 32 | :rules ; The original rules 33 | :query ; The original query 34 | :work-plan-type) ; The type of plan 35 | 36 | (defn- validate-work-plan 37 | "Ensure any top level semantics are not violated" 38 | [work-plan database] 39 | (let [common-relations (-> work-plan :rules (intersection (-> database keys set)))] 40 | (when (-> common-relations 41 | empty? 42 | not) 43 | (throwf "The rules and database define the same relation(s): %s" common-relations)))) 44 | ; More will follow 45 | 46 | (defn build-work-plan 47 | "Given a list of rules and a query, build a work plan that can be 48 | used to execute the query." 49 | [rules query] 50 | (struct-map work-plan 51 | :work-plan (build-soft-strat-work-plan rules query) 52 | :rules rules 53 | :query query 54 | :work-plan-type ::soft-stratified)) 55 | 56 | (defn run-work-plan 57 | "Given a work plan, a database, and some query bindings, run the 58 | work plan and return the results." 59 | [work-plan database query-bindings] 60 | (validate-work-plan work-plan database) 61 | (evaluate-soft-work-set (:work-plan work-plan) database query-bindings)) 62 | 63 | 64 | ;; End of file 65 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/datalog/util.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Jeffrey Straszheim. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; util.clj 10 | ;; 11 | ;; A Clojure implementation of Datalog -- Utilities 12 | ;; 13 | ;; straszheimjeffrey (gmail) 14 | ;; Created 3 Feburary 2009 15 | 16 | 17 | (ns clojure.contrib.datalog.util 18 | (:use [clojure.contrib.seq :only (separate)])) 19 | 20 | 21 | 22 | ;;; Bindings and logic vars. A binding in a hash of logic vars to 23 | ;;; bound values. Logic vars are any symbol prefixed with a \?. 24 | 25 | (defn is-var? 26 | "Is this a logic variable: e.g. a symbol prefixed with a ?" 27 | [sym] 28 | (when (symbol? sym) 29 | (let [name (name sym)] 30 | (and (= \? (first name)) 31 | (not= \? (fnext name)))))) 32 | 33 | (defn is-query-var? 34 | "Is this a query variable: e.g. a symbol prefixed with ??" 35 | [sym] 36 | (when (symbol? sym) 37 | (let [name (name sym)] 38 | (and (= \? (first name)) 39 | (= \? (fnext name)))))) 40 | 41 | (defn map-values 42 | "Like map, but works over the values of a hash map" 43 | [f hash] 44 | (let [key-vals (map (fn [[key val]] [key (f val)]) hash)] 45 | (if (seq key-vals) 46 | (apply conj (empty hash) key-vals) 47 | hash))) 48 | 49 | (defn keys-to-vals 50 | "Given a map and a collection of keys, return the collection of vals" 51 | [m ks] 52 | (vals (select-keys m ks))) 53 | 54 | (defn reverse-map 55 | "Reverse the keys/values of a map" 56 | [m] 57 | (into {} (map (fn [[k v]] [v k]) m))) 58 | 59 | 60 | ;;; Preduce -- A parallel reduce over hashes 61 | 62 | (defn preduce 63 | "Similar to merge-with, but the contents of each key are merged in 64 | parallel using f. 65 | 66 | f - a function of 2 arguments. 67 | data - a collection of hashes." 68 | [f data] 69 | (let [data-1 (map (fn [h] (map-values #(list %) h)) data) 70 | merged (doall (apply merge-with concat data-1)) 71 | ; Groups w/ multiple elements are identified for parallel processing 72 | [complex simple] (separate (fn [[key vals]] (> (count vals) 1)) merged) 73 | fold-group (fn [[key vals]] {key (reduce f vals)}) 74 | fix-single (fn [[key [val]]] [key val])] 75 | (apply merge (concat (pmap fold-group merged) (map fix-single simple))))) 76 | 77 | 78 | ;;; Debuging and Tracing 79 | 80 | (def *trace-datalog* nil) 81 | 82 | (defmacro trace-datalog 83 | "If *test-datalog* is set to true, run the enclosed commands" 84 | [& body] 85 | `(when *trace-datalog* 86 | ~@body)) 87 | 88 | 89 | ;; End of file 90 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/except.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Stephen C. Gilardi. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; except.clj 10 | ;; 11 | ;; Provides functions that make it easy to specify the class, cause, and 12 | ;; message when throwing an Exception or Error. The optional message is 13 | ;; formatted using clojure.core/format. 14 | ;; 15 | ;; scgilardi (gmail) 16 | ;; Created 07 July 2008 17 | 18 | (ns 19 | #^{:author "Stephen C. Gilardi", 20 | :doc "Provides functions that make it easy to specify the class, cause, and 21 | message when throwing an Exception or Error. The optional message is 22 | formatted using clojure.core/format."} 23 | clojure.contrib.except 24 | (:import (clojure.lang Reflector))) 25 | 26 | (declare throwable) 27 | 28 | (defn throwf 29 | "Throws an Exception or Error with an optional message formatted using 30 | clojure.core/format. All arguments are optional: 31 | 32 | class? cause? format? format-args* 33 | 34 | - class defaults to Exception, if present it must name a kind of 35 | Throwable 36 | - cause defaults to nil, if present it must be a Throwable 37 | - format is a format string for clojure.core/format 38 | - format-args are objects that correspond to format specifiers in 39 | format." 40 | [& args] 41 | (throw (throwable args))) 42 | 43 | (defn throw-if 44 | "Throws an Exception or Error if test is true. args are those documented 45 | for throwf." 46 | [test & args] 47 | (when test 48 | (throw (throwable args)))) 49 | 50 | (defn throw-if-not 51 | "Throws an Exception or Error if test is false. args are those documented 52 | for throwf." 53 | [test & args] 54 | (when-not test 55 | (throw (throwable args)))) 56 | 57 | (defn throw-arg 58 | "Throws an IllegalArgumentException. All arguments are optional: 59 | 60 | cause? format? format-args* 61 | 62 | - cause defaults to nil, if present it must be a Throwable 63 | - format is a format string for clojure.core/format 64 | - format-args are objects that correspond to format specifiers in 65 | format." 66 | [& args] 67 | (throw (throwable (cons IllegalArgumentException args)))) 68 | 69 | (defn- throwable? 70 | "Returns true if x is a Throwable" 71 | [x] 72 | (instance? Throwable x)) 73 | 74 | (defn- throwable 75 | "Constructs a Throwable with optional cause and formatted message. Its 76 | stack trace will begin with our caller's caller. Args are as described 77 | for throwf except throwable accepts them as list rather than inline." 78 | [args] 79 | (let [[arg] args 80 | [class & args] (if (class? arg) args (cons Exception args)) 81 | [arg] args 82 | [cause & args] (if (throwable? arg) args (cons nil args)) 83 | message (when args (apply format args)) 84 | ctor-args (into-array Object 85 | (cond (and message cause) [message cause] 86 | message [message] 87 | cause [cause])) 88 | throwable (Reflector/invokeConstructor class ctor-args) 89 | our-prefix "clojure.contrib.except$throwable" 90 | not-us? #(not (.startsWith (.getClassName %) our-prefix)) 91 | raw-trace (.getStackTrace throwable) 92 | edited-trace (into-array StackTraceElement 93 | (drop 3 (drop-while not-us? raw-trace)))] 94 | (.setStackTrace throwable edited-trace) 95 | throwable)) 96 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/fnmap.clj: -------------------------------------------------------------------------------- 1 | ;;; fnmap.clj: maps that dispatch get/assoc to functions 2 | 3 | ;; Copyright (c) Stuart Sierra, 2008. All rights reserved. The use 4 | ;; and distribution terms for this software are covered by the Eclipse 5 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 6 | ;; which can be found in the file epl-v10.html at the root of this 7 | ;; distribution. By using this software in any fashion, you are 8 | ;; agreeing to be bound by the terms of this license. You must not 9 | ;; remove this notice, or any other, from this software. 10 | 11 | 12 | (ns #^{:author "Stuart Sierra" 13 | :doc "Maps that dispatch get/assoc to user-defined functions. 14 | 15 | Note: requires AOT-compilation"} 16 | clojure.contrib.fnmap 17 | (:require clojure.contrib.fnmap.PersistentFnMap)) 18 | 19 | (defn fnmap 20 | "Creates a fnmap, or functional map. A fnmap behaves like an 21 | ordinary Clojure map, except that calls to get and assoc are 22 | filtered through user-defined getter and setter functions, which 23 | operate on an internal map. 24 | 25 | (getter m key) should return a value for key. 26 | 27 | (setter m key value) should assoc key with value and return a new 28 | map for m. 29 | 30 | All other map operations are passed through to the internal map." 31 | ([getter setter] (clojure.contrib.fnmap.PersistentFnMap/create getter setter)) 32 | ([getter setter & keyvals] 33 | (apply assoc 34 | (clojure.contrib.fnmap.PersistentFnMap/create getter setter) 35 | keyvals))) 36 | 37 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/fnmap/PersistentFnMap.clj: -------------------------------------------------------------------------------- 1 | ;; PersistentFnMap.clj: implementation for clojure.contrib.fnmap 2 | 3 | ;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use 4 | ;; and distribution terms for this software are covered by the Eclipse 5 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 6 | ;; which can be found in the file epl-v10.html at the root of this 7 | ;; distribution. By using this software in any fashion, you are 8 | ;; agreeing to be bound by the terms of this license. You must not 9 | ;; remove this notice, or any other, from this software. 10 | 11 | 12 | ;; Thanks to Meikel Brandmeyer for his work on lazymap, which made 13 | ;; this implementation easier. 14 | 15 | 16 | (ns clojure.contrib.fnmap.PersistentFnMap 17 | (:gen-class :extends clojure.lang.APersistentMap 18 | :state state 19 | :init init 20 | :constructors {[clojure.lang.IPersistentMap] [], 21 | [clojure.lang.IPersistentMap clojure.lang.IPersistentMap] [clojure.lang.IPersistentMap]})) 22 | 23 | (defn -init 24 | ([theMap] [[] theMap]) 25 | ([theMap metadata] [[metadata] theMap])) 26 | 27 | (defn create [getter setter] 28 | (clojure.contrib.fnmap.PersistentFnMap. 29 | {::getter getter ::setter setter})) 30 | 31 | ;; IPersistentMap 32 | 33 | (defn -assoc [this key value] 34 | (clojure.contrib.fnmap.PersistentFnMap. 35 | ((::setter (. this state)) (. this state) key value))) 36 | 37 | ;; Associative 38 | 39 | (defn- -containsKey [this key] 40 | (not (nil? ((::getter (. this state)) this key)))) 41 | 42 | (defn- -entryAt [this key] 43 | (clojure.lang.MapEntry. key ((::getter (. this state)) (. this state) key))) 44 | 45 | (defn -valAt 46 | ([this key] 47 | ((::getter (. this state)) (. this state) key)) 48 | ([this key default] 49 | (or ((::getter (. this state)) (. this state) key) 50 | default))) 51 | 52 | ;; Iterable 53 | 54 | (defn -iterator [this] 55 | (.. this state iterator)) 56 | 57 | ;; IPersistentCollection 58 | 59 | (defn -count [this] 60 | (count (. this state))) 61 | 62 | (defn -seq [this] 63 | (seq (. this state))) 64 | 65 | (defn -cons [this that] 66 | (.. this state (cons this that))) 67 | 68 | (defn -empty [this] 69 | (.. this state empty)) 70 | 71 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/generic.clj: -------------------------------------------------------------------------------- 1 | ;; Support code for generic interfaces 2 | 3 | ;; by Konrad Hinsen 4 | ;; last updated May 4, 2009 5 | 6 | ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | (ns 15 | #^{:author "Konrad Hinsen" 16 | :skip-wiki true 17 | :doc "Generic interfaces 18 | This library provides generic interfaces in the form of 19 | multimethods that can be implemented for any type. 20 | The interfaces partly duplicate existing non-generic 21 | functions in clojure.core (arithmetic, comparison, 22 | collections) and partly provide additional functions that 23 | can be defined for a wide variety of types (functors, math 24 | functions). More functions will be added in the future."} 25 | clojure.contrib.generic 26 | (:use [clojure.contrib.types :only (defadt)])) 27 | 28 | ; 29 | ; A dispatch function that separates nulary, unary, binary, and 30 | ; higher arity calls and also selects on type for unary and binary 31 | ; calls. 32 | ; 33 | (defn nary-dispatch 34 | ([] ::nulary) 35 | ([x] (type x)) 36 | ([x y] 37 | [(type x) (type y)]) 38 | ([x y & more] ::nary)) 39 | 40 | ; 41 | ; We can't use [::binary :default], so we need to define a root type 42 | ; of the type hierarcy. The derivation for Object covers all classes, 43 | ; but all non-class types will need an explicit derive clause. 44 | ; Ultimately, a macro might take care of this. 45 | ; 46 | (def root-type ::any) 47 | (derive Object root-type) 48 | 49 | ; 50 | ; Symbols referring to ::nulary and ::n-ary 51 | ; 52 | (def nulary-type ::nulary) 53 | (def nary-type ::nary) 54 | 55 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/generic/collection.clj: -------------------------------------------------------------------------------- 1 | ;; Generic interfaces for collection-related functions 2 | 3 | ;; by Konrad Hinsen 4 | ;; last updated May 5, 2009 5 | 6 | ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | (ns 15 | #^{:author "Konrad Hinsen" 16 | :doc "Generic arithmetic interface 17 | This library defines generic versions of common 18 | collection-related functions as multimethods that can be 19 | defined for any type."} 20 | clojure.contrib.generic.collection 21 | (:refer-clojure :exclude [assoc conj dissoc empty get into seq])) 22 | 23 | ; 24 | ; assoc 25 | ; 26 | (defmulti assoc 27 | "Returns a new collection in which the values corresponding to the 28 | given keys are updated by the given values. Each type of collection 29 | can have specific restrictions on the possible keys." 30 | {:arglists '([coll & key-val-pairs])} 31 | (fn [coll & items] (type coll))) 32 | 33 | (defmethod assoc :default 34 | [map & key-val-pairs] 35 | (apply clojure.core/assoc map key-val-pairs)) 36 | 37 | ; assoc-in 38 | 39 | ; 40 | ; conj 41 | ; 42 | (defmulti conj 43 | "Returns a new collection resulting from adding all xs to coll." 44 | {:arglists '([coll & xs])} 45 | (fn [coll & xs] (type coll))) 46 | 47 | (defmethod conj :default 48 | [coll & xs] 49 | (apply clojure.core/conj coll xs)) 50 | 51 | ; 52 | ; diassoc 53 | ; 54 | (defmulti dissoc 55 | "Returns a new collection in which the entries corresponding to the 56 | given keys are removed. Each type of collection can have specific 57 | restrictions on the possible keys." 58 | {:arglists '([coll & keys])} 59 | (fn [coll & keys] (type coll))) 60 | 61 | (defmethod dissoc :default 62 | [map & keys] 63 | (apply clojure.core/dissoc map keys)) 64 | 65 | ; 66 | ; empty 67 | ; 68 | (defmulti empty 69 | "Returns an empty collection of the same kind as the argument" 70 | {:arglists '([coll])} 71 | type) 72 | 73 | (defmethod empty :default 74 | [coll] 75 | (clojure.core/empty coll)) 76 | 77 | ; 78 | ; get 79 | ; 80 | (defmulti get 81 | "Returns the element of coll referred to by key. Each type of collection 82 | can have specific restrictions on the possible keys." 83 | {:arglists '([coll key] [coll key not-found])} 84 | (fn [coll & args] (type coll))) 85 | 86 | (defmethod get :default 87 | ([coll key] 88 | (clojure.core/get coll key)) 89 | ([coll key not-found] 90 | (clojure.core/get coll key not-found))) 91 | 92 | ; 93 | ; into 94 | ; 95 | (defmulti into 96 | "Returns a new coll consisting of to-coll with all of the items of 97 | from-coll conjoined." 98 | {:arglists '([to from])} 99 | (fn [to from] (type to))) 100 | 101 | (declare seq) 102 | (defmethod into :default 103 | [to from] 104 | (reduce conj to (seq from))) 105 | 106 | ; 107 | ; seq 108 | ; 109 | (defmulti seq 110 | "Returns a seq on the object s." 111 | {:arglists '([s])} 112 | type) 113 | 114 | (defmethod seq :default 115 | [s] 116 | (clojure.core/seq s)) 117 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/generic/functor.clj: -------------------------------------------------------------------------------- 1 | ;; Generic interface for functors 2 | 3 | ;; by Konrad Hinsen 4 | ;; last updated May 3, 2009 5 | 6 | ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | (ns 15 | #^{:author "Konrad Hinsen" 16 | :doc "Generic functor interface (fmap)"} 17 | clojure.contrib.generic.functor) 18 | 19 | 20 | (defmulti fmap 21 | "Applies function f to each item in the data structure s and returns 22 | a structure of the same kind." 23 | {:arglists '([f s])} 24 | (fn [f s] (type s))) 25 | 26 | (defmethod fmap clojure.lang.IPersistentList 27 | [f v] 28 | (into (empty v) (map f v))) 29 | 30 | (defmethod fmap clojure.lang.IPersistentVector 31 | [f v] 32 | (into (empty v) (map f v))) 33 | 34 | (defmethod fmap clojure.lang.IPersistentMap 35 | [f m] 36 | (into (empty m) (for [[k v] m] [k (f v)]))) 37 | 38 | (defmethod fmap clojure.lang.IPersistentSet 39 | [f s] 40 | (into (empty s) (map f s))) 41 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/generic/math_functions.clj: -------------------------------------------------------------------------------- 1 | ;; Generic interfaces for mathematical functions 2 | 3 | ;; by Konrad Hinsen 4 | ;; last updated May 5, 2009 5 | 6 | ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | (ns 15 | #^{:author "Konrad Hinsen" 16 | :doc "Generic math function interface 17 | This library defines generic versions of common mathematical 18 | functions such as sqrt or sin as multimethods that can be 19 | defined for any type."} 20 | clojure.contrib.generic.math-functions 21 | (:use [clojure.contrib.def :only (defmacro-)]) 22 | (:require [clojure.contrib.generic.arithmetic :as ga] 23 | [clojure.contrib.generic.comparison :as gc])) 24 | 25 | (defmacro- defmathfn-1 26 | [name] 27 | (let [java-symbol (symbol "java.lang.Math" (str name))] 28 | `(do 29 | (defmulti ~name 30 | ~(str "Return the " name " of x.") 31 | {:arglists '([~'x])} 32 | type) 33 | (defmethod ~name java.lang.Number 34 | [~'x] 35 | (~java-symbol ~'x))))) 36 | 37 | (defn- two-types [x y] [(type x) (type y)]) 38 | 39 | (defmacro- defmathfn-2 40 | [name] 41 | (let [java-symbol (symbol "java.lang.Math" (str name))] 42 | `(do 43 | (defmulti ~name 44 | ~(str "Return the " name " of x and y.") 45 | {:arglists '([~'x ~'y])} 46 | two-types) 47 | (defmethod ~name [java.lang.Number java.lang.Number] 48 | [~'x ~'y] 49 | (~java-symbol ~'x ~'y))))) 50 | 51 | ; List of math functions taken from 52 | ; http://java.sun.com/j2se/1.4.2/docs/api/java/lang/Math.html 53 | (defmathfn-1 abs) 54 | (defmathfn-1 acos) 55 | (defmathfn-1 asin) 56 | (defmathfn-1 atan) 57 | (defmathfn-2 atan2) 58 | (defmathfn-1 ceil) 59 | (defmathfn-1 cos) 60 | (defmathfn-1 exp) 61 | (defmathfn-1 floor) 62 | (defmathfn-1 log) 63 | (defmathfn-2 pow) 64 | (defmathfn-1 rint) 65 | (defmathfn-1 round) 66 | (defmathfn-1 sin) 67 | (defmathfn-1 sqrt) 68 | (defmathfn-1 tan) 69 | 70 | ; 71 | ; Sign 72 | ; 73 | (defmulti sgn 74 | "Return the sign of x (-1, 0, or 1)." 75 | {:arglists '([x])} 76 | type) 77 | 78 | (defmethod sgn :default 79 | [x] 80 | (cond (gc/zero? x) 0 81 | (gc/> x 0) 1 82 | :else -1)) 83 | 84 | ; 85 | ; Conjugation 86 | ; 87 | (defmulti conjugate 88 | "Return the conjugate of x." 89 | {:arglists '([x])} 90 | type) 91 | 92 | (defmethod conjugate :default 93 | [x] x) 94 | 95 | ; 96 | ; Square 97 | ; 98 | (defmulti sqr 99 | "Return the square of x." 100 | {:arglists '([x])} 101 | type) 102 | 103 | (defmethod sqr :default 104 | [x] 105 | (ga/* x x)) 106 | 107 | ; 108 | ; Approximate equality for use with floating point types 109 | ; 110 | (defn approx= 111 | "Return true if the absolute value of the difference between x and y 112 | is less than eps." 113 | [x y eps] 114 | (gc/< (abs (ga/- x y)) eps)) 115 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/greatest_least.clj: -------------------------------------------------------------------------------- 1 | (ns 2 | #^{:author "Vincent Foley", 3 | :doc "Various functions for finding greatest and least values in a collection"} 4 | clojure.contrib.greatest-least) 5 | 6 | (defn- boundary 7 | [cmp-fn f & args] 8 | (when args 9 | (reduce (fn [a b] (if (cmp-fn (compare (f b) (f a))) 10 | b 11 | a)) args))) 12 | 13 | (defn greatest-by 14 | "Return the argument for which f yields the greatest value." 15 | [f & args] 16 | (apply boundary pos? f args)) 17 | 18 | (defn greatest 19 | "Return the greatest argument." 20 | [& args] 21 | (apply greatest-by identity args)) 22 | 23 | (defn least-by 24 | "Return the argument for which f yields the smallest value." 25 | [f & args] 26 | (apply boundary neg? f args)) 27 | 28 | (defn least 29 | "Return the smallest element." 30 | [& args] 31 | (apply least-by identity args)) 32 | 33 | 34 | (defn- boundary-all 35 | [cmp-fn f & args] 36 | (when args 37 | (reduce (fn [a b] 38 | (if (nil? a) 39 | (cons b nil) 40 | (let [x (compare (f b) (f (first a)))] 41 | (cond (zero? x) (cons b a) 42 | (cmp-fn x) (cons b nil) 43 | :else a)))) 44 | nil 45 | args))) 46 | 47 | (defn all-greatest-by 48 | "Return all the elements for which f yields the greatest value." 49 | [f & args] 50 | (apply boundary-all pos? f args)) 51 | 52 | (defn all-greatest 53 | "Returns all the greatest elements." 54 | [& args] 55 | (apply all-greatest-by identity args)) 56 | 57 | (defn all-least-by 58 | "Return all the elements for which f yields the least value." 59 | [f & args] 60 | (apply boundary-all neg? f args)) 61 | 62 | (defn all-least 63 | "Returns all the least elements." 64 | [& args] 65 | (apply all-least-by identity args)) 66 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/http/connection.clj: -------------------------------------------------------------------------------- 1 | ;;; http/connection.clj: low-level HTTP client API around HttpURLConnection 2 | 3 | ;; by Stuart Sierra, http://stuartsierra.com/ 4 | ;; June 8, 2009 5 | 6 | ;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | (ns #^{:doc "Low-level HTTP client API around HttpURLConnection"} 15 | clojure.contrib.http.connection 16 | (:require [clojure.contrib.io :as duck]) 17 | (:import (java.net URI URL HttpURLConnection) 18 | (java.io File InputStream Reader))) 19 | 20 | (defn http-connection 21 | "Opens an HttpURLConnection at the URL, handled by as-url." 22 | [url] 23 | (.openConnection (duck/as-url url))) 24 | 25 | (defmulti 26 | #^{:doc "Transmits a request entity body."} 27 | send-request-entity (fn [conn entity] (type entity))) 28 | 29 | (defmethod send-request-entity duck/*byte-array-type* [#^HttpURLConnection conn entity] 30 | (.setFixedLengthStreamingMode conn (count entity)) 31 | (.connect conn) 32 | (duck/copy entity (.getOutputStream conn))) 33 | 34 | (defmethod send-request-entity String [conn #^String entity] 35 | (send-request-entity conn (.getBytes entity duck/*default-encoding*))) 36 | 37 | (defmethod send-request-entity File [#^HttpURLConnection conn #^File entity] 38 | (.setFixedLengthStreamingMode conn (.length entity)) 39 | (.connect conn) 40 | (duck/copy entity (.getOutputStream conn))) 41 | 42 | (defmethod send-request-entity InputStream [#^HttpURLConnection conn entity] 43 | (.setChunkedStreamingMode conn -1) 44 | (.connect conn) 45 | (duck/copy entity (.getOutputStream conn))) 46 | 47 | (defmethod send-request-entity Reader [#^HttpURLConnection conn entity] 48 | (.setChunkedStreamingMode conn -1) 49 | (.connect conn) 50 | (duck/copy entity (.getOutputStream conn))) 51 | 52 | (defn start-http-connection 53 | ([#^HttpURLConnection conn] (.connect conn)) 54 | ([#^HttpURLConnection conn request-entity-body] 55 | (if request-entity-body 56 | (do (.setDoOutput conn true) 57 | (send-request-entity conn request-entity-body)) 58 | (.connect conn)))) 59 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/import_static.clj: -------------------------------------------------------------------------------- 1 | ;;; import_static.clj -- import static Java methods/fields into Clojure 2 | 3 | ;; by Stuart Sierra, http://stuartsierra.com/ 4 | ;; June 1, 2008 5 | 6 | ;; Copyright (c) Stuart Sierra, 2008. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | 15 | 16 | (ns 17 | #^{:author "Stuart Sierra", 18 | :doc "Import static Java methods/fields into Clojure"} 19 | clojure.contrib.import-static 20 | (:use clojure.set)) 21 | 22 | (defmacro import-static 23 | "Imports the named static fields and/or static methods of the class 24 | as (private) symbols in the current namespace. 25 | 26 | Example: 27 | user=> (import-static java.lang.Math PI sqrt) 28 | nil 29 | user=> PI 30 | 3.141592653589793 31 | user=> (sqrt 16) 32 | 4.0 33 | 34 | Note: The class name must be fully qualified, even if it has already 35 | been imported. Static methods are defined as MACROS, not 36 | first-class fns." 37 | [class & fields-and-methods] 38 | (let [only (set (map str fields-and-methods)) 39 | the-class (. Class forName (str class)) 40 | static? (fn [x] 41 | (. java.lang.reflect.Modifier 42 | (isStatic (. x (getModifiers))))) 43 | statics (fn [array] 44 | (set (map (memfn getName) 45 | (filter static? array)))) 46 | all-fields (statics (. the-class (getFields))) 47 | all-methods (statics (. the-class (getMethods))) 48 | fields-to-do (intersection all-fields only) 49 | methods-to-do (intersection all-methods only) 50 | make-sym (fn [string] 51 | (with-meta (symbol string) {:private true})) 52 | import-field (fn [name] 53 | (list 'def (make-sym name) 54 | (list '. class (symbol name)))) 55 | import-method (fn [name] 56 | (list 'defmacro (make-sym name) 57 | '[& args] 58 | (list 'list ''. (list 'quote class) 59 | (list 'apply 'list 60 | (list 'quote (symbol name)) 61 | 'args))))] 62 | `(do ~@(map import-field fields-to-do) 63 | ~@(map import-method methods-to-do)))) 64 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/jar.clj: -------------------------------------------------------------------------------- 1 | ;;; jar.clj: utilities for working with Java JAR files 2 | 3 | ;; by Stuart Sierra, http://stuartsierra.com/ 4 | ;; April 19, 2009 5 | 6 | ;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | 15 | (ns 16 | #^{:author "Stuart Sierra", 17 | :doc "Utilities for working with Java JAR files"} 18 | clojure.contrib.jar 19 | (:import (java.io File) 20 | (java.util.jar JarFile))) 21 | 22 | (defn jar-file? 23 | "Returns true if file is a normal file with a .jar or .JAR extension." 24 | [#^File file] 25 | (and (.isFile file) 26 | (or (.endsWith (.getName file) ".jar") 27 | (.endsWith (.getName file) ".JAR")))) 28 | 29 | (defn filenames-in-jar 30 | "Returns a sequence of Strings naming the non-directory entries in 31 | the JAR file." 32 | [#^JarFile jar-file] 33 | (map #(.getName %) 34 | (filter #(not (.isDirectory %)) 35 | (enumeration-seq (.entries jar-file))))) 36 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/javadoc.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.javadoc) 2 | 3 | (throw (Exception. "clojure.contrib.javadoc/javadoc can now be found in clojure.contrib.repl-utils.")) 4 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/javadoc/browse.clj: -------------------------------------------------------------------------------- 1 | ;;; browse.clj -- start a web browser from Clojure 2 | 3 | ; Copyright (c) Christophe Grand, December 2008. All rights reserved. 4 | ; The use and distribution terms for this software are covered by the 5 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 6 | ; which can be found in the file epl-v10.html at the root of this 7 | ; distribution. 8 | ; By using this software in any fashion, you are agreeing to be bound by 9 | ; the terms of this license. 10 | ; You must not remove this notice, or any other, from this software. 11 | 12 | (ns 13 | #^{:author "Christophe Grand", 14 | :doc "Start a web browser from Clojure"} 15 | clojure.contrib.javadoc.browse 16 | (:require [clojure.contrib.shell :as sh]) 17 | (:import (java.net URI))) 18 | 19 | (defn- macosx? [] 20 | (-> "os.name" System/getProperty .toLowerCase 21 | (.startsWith "mac os x"))) 22 | 23 | (def *open-url-script* (when (macosx?) "/usr/bin/open")) 24 | 25 | (defn open-url-in-browser 26 | "Opens url (a string) in the default system web browser. May not 27 | work on all platforms. Returns url on success, nil if not 28 | supported." 29 | [url] 30 | (try 31 | (when (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" 32 | "isDesktopSupported" (to-array nil)) 33 | (-> (clojure.lang.Reflector/invokeStaticMethod "java.awt.Desktop" 34 | "getDesktop" (to-array nil)) 35 | (.browse (URI. url))) 36 | url) 37 | (catch ClassNotFoundException e 38 | nil))) 39 | 40 | (defn open-url-in-swing 41 | "Opens url (a string) in a Swing window." 42 | [url] 43 | ; the implementation of this function resides in another namespace to be loaded "on demand" 44 | ; this fixes a bug on mac os x where requiring repl-utils turns the process into a GUI app 45 | ; see http://code.google.com/p/clojure-contrib/issues/detail?id=32 46 | (require 'clojure.contrib.javadoc.browse-ui) 47 | ((find-var 'clojure.contrib.javadoc.browse-ui/open-url-in-swing) url)) 48 | 49 | (defn browse-url [url] 50 | (or (open-url-in-browser url) (when *open-url-script* (sh/sh *open-url-script* (str url)) true) (open-url-in-swing url))) 51 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/javadoc/browse_ui.clj: -------------------------------------------------------------------------------- 1 | ;;; browse_ui.clj -- starts a swing web browser :-( 2 | 3 | ; Copyright (c) Christophe Grand, December 2008. All rights reserved. 4 | ; The use and distribution terms for this software are covered by the 5 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 6 | ; which can be found in the file epl-v10.html at the root of this 7 | ; distribution. 8 | ; By using this software in any fashion, you are agreeing to be bound by 9 | ; the terms of this license. 10 | ; You must not remove this notice, or any other, from this software. 11 | 12 | (ns clojure.contrib.javadoc.browse-ui) 13 | 14 | (defn open-url-in-swing 15 | "Opens url (a string) in a Swing window." 16 | [url] 17 | (let [htmlpane (javax.swing.JEditorPane. url)] 18 | (.setEditable htmlpane false) 19 | (.addHyperlinkListener htmlpane 20 | (proxy [javax.swing.event.HyperlinkListener] [] 21 | (hyperlinkUpdate [#^javax.swing.event.HyperlinkEvent e] 22 | (when (= (.getEventType e) (. javax.swing.event.HyperlinkEvent$EventType ACTIVATED)) 23 | (if (instance? javax.swing.text.html.HTMLFrameHyperlinkEvent e) 24 | (-> htmlpane .getDocument (.processHTMLFrameHyperlinkEvent e)) 25 | (.setPage htmlpane (.getURL e))))))) 26 | (doto (javax.swing.JFrame.) 27 | (.setContentPane (javax.swing.JScrollPane. htmlpane)) 28 | (.setBounds 32 32 700 900) 29 | (.show)))) 30 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/jmx/Bean.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.jmx.Bean 2 | (:gen-class 3 | :implements [javax.management.DynamicMBean] 4 | :init init 5 | :state state 6 | :constructors {[Object] []}) 7 | (:require [clojure.contrib.jmx :as jmx]) 8 | (:import [javax.management DynamicMBean MBeanInfo AttributeList])) 9 | 10 | (defn -init [derefable] 11 | [[] derefable]) 12 | 13 | ; TODO: rest of the arguments, as needed 14 | (defn generate-mbean-info [clj-bean] 15 | (MBeanInfo. (.. clj-bean getClass getName) ; class name 16 | "Clojure Dynamic MBean" ; description 17 | (jmx/map->attribute-infos @(.state clj-bean)) ; attributes 18 | nil ; constructors 19 | nil ; operations 20 | nil)) ; notifications 21 | 22 | (defn -getMBeanInfo 23 | [this] 24 | (generate-mbean-info this)) 25 | 26 | (defn -getAttribute 27 | [this attr] 28 | (@(.state this) (keyword attr))) 29 | 30 | (defn -getAttributes 31 | [this attrs] 32 | (let [result (AttributeList.)] 33 | (doseq [attr attrs] 34 | (.add result (.getAttribute this attr))) 35 | result)) -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/jmx/client.clj: -------------------------------------------------------------------------------- 1 | ;; JMX client APIs for Clojure 2 | ;; docs in clojure/contrib/jmx.clj!! 3 | 4 | ;; by Stuart Halloway 5 | 6 | ;; Copyright (c) Stuart Halloway, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | 15 | (in-ns 'clojure.contrib.jmx) 16 | 17 | (defmacro with-connection 18 | "Execute body with JMX connection specified by opts. opts can also 19 | include an optional :environment key which is passed as the 20 | environment arg to JMXConnectorFactory/connect." 21 | [opts & body] 22 | `(let [opts# ~opts 23 | env# (get opts# :environment {}) 24 | opts# (dissoc opts# :environment)] 25 | (with-open [connector# (javax.management.remote.JMXConnectorFactory/connect 26 | (JMXServiceURL. (jmx-url opts#)) env#)] 27 | (binding [*connection* (.getMBeanServerConnection connector#)] 28 | ~@body)))) 29 | 30 | (defn mbean-info [n] 31 | (.getMBeanInfo *connection* (as-object-name n))) 32 | 33 | (defn raw-read 34 | "Read an mbean property. Returns low-level Java object model for 35 | composites, tabulars, etc. Most callers should use read." 36 | [n attr] 37 | (.getAttribute *connection* (as-object-name n) (as-str attr))) 38 | 39 | (defvar read 40 | (comp jmx->clj raw-read) 41 | "Read an mbean property.") 42 | 43 | (defn read-supported 44 | "Calls read to read an mbean property, *returning* unsupported 45 | operation exceptions instead of throwing them. Used to keep mbean 46 | from blowing up. Note: There is no good exception that aggregates 47 | unsupported operations, hence the overly-general catch block." 48 | [n attr] 49 | (try 50 | (read n attr) 51 | (catch Exception e 52 | e))) 53 | 54 | (defn write! [n attr value] 55 | (.setAttribute 56 | *connection* 57 | (as-object-name n) 58 | (Attribute. (as-str attr) value))) 59 | 60 | (defn attribute-info 61 | "Get the MBeanAttributeInfo for an attribute." 62 | [object-name attr-name] 63 | (filter #(= (as-str attr-name) (.getName %)) 64 | (.getAttributes (mbean-info object-name)))) 65 | 66 | (defn readable? 67 | "Is attribute readable?" 68 | [n attr] 69 | (.isReadable () (mbean-info n))) 70 | 71 | (defn operations 72 | "All oeprations available on an MBean." 73 | [n] 74 | (.getOperations (mbean-info n))) 75 | 76 | (defn operation 77 | "The MBeanOperationInfo for operation op on mbean n. Used by invoke." 78 | [n op] 79 | (first (filter #(= (-> % .getName keyword) op) (operations n)))) 80 | 81 | (defn op-param-types 82 | "The parameter types (as class name strings) for operation op on n. 83 | Used for invoke." 84 | [n op] 85 | (map #(-> % .getType) (.getSignature (operation n op)))) 86 | 87 | 88 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/jmx/data.clj: -------------------------------------------------------------------------------- 1 | ;; Conversions between JMX data structures and idiomatic Clojure 2 | ;; docs in clojure/contrib/jmx.clj!! 3 | 4 | ;; by Stuart Halloway 5 | 6 | ;; Copyright (c) Stuart Halloway, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | 15 | (in-ns 'clojure.contrib.jmx) 16 | 17 | (declare jmx->clj) 18 | 19 | (defn jmx-url 20 | "Build a JMX URL from options." 21 | ([] (jmx-url {})) 22 | ([overrides] 23 | (let [opts (merge {:host "localhost", :port "3000", :jndi-path "jmxrmi"} overrides)] 24 | (format "service:jmx:rmi:///jndi/rmi://%s:%s/%s" (opts :host) (opts :port) (opts :jndi-path))))) 25 | 26 | (defmulti as-object-name 27 | "Interpret an object as a JMX ObjectName." 28 | { :arglists '([string-or-name]) } 29 | class) 30 | (defmethod as-object-name String [n] (ObjectName. n)) 31 | (defmethod as-object-name ObjectName [n] n) 32 | 33 | (defn composite-data->map [cd] 34 | (into {} 35 | (map (fn [attr] [(keyword attr) (jmx->clj (.get cd attr))]) 36 | (.. cd getCompositeType keySet)))) 37 | 38 | (defn maybe-keywordize 39 | "Convert a string key to a keyword, leaving other types alone. Used to 40 | simplify keys in the tabular data API." 41 | [s] 42 | (if (string? s) (keyword s) s)) 43 | 44 | (defn maybe-atomize 45 | "Convert a list of length 1 into its contents, leaving other things alone. 46 | Used to simplify keys in the tabular data API." 47 | [k] 48 | (if (and (instance? java.util.List k) 49 | (= 1 (count k))) 50 | (first k) 51 | k)) 52 | 53 | (defvar simplify-tabular-data-key 54 | (comp maybe-keywordize maybe-atomize)) 55 | 56 | (defn tabular-data->map [td] 57 | (into {} 58 | ; the need for into-array here was a surprise, and may not 59 | ; work for all examples. Are keys always arrays? 60 | (map (fn [k] 61 | [(simplify-tabular-data-key k) (jmx->clj (.get td (into-array k)))]) 62 | (.keySet td)))) 63 | 64 | (defmulti jmx->clj 65 | "Coerce JMX data structures into Clojure data. 66 | Handles CompositeData, TabularData, maps, and atoms." 67 | { :argslists '([jmx-data-structure]) } 68 | (fn [x] 69 | (cond 70 | (instance? javax.management.openmbean.CompositeData x) :composite 71 | (instance? javax.management.openmbean.TabularData x) :tabular 72 | (instance? clojure.lang.Associative x) :map 73 | :default :default))) 74 | (defmethod jmx->clj :composite [c] (composite-data->map c)) 75 | (defmethod jmx->clj :tabular [t] (tabular-data->map t)) 76 | (defmethod jmx->clj :map [m] (into {} (zipmap (keys m) (map jmx->clj (vals m))))) 77 | (defmethod jmx->clj :default [obj] obj) 78 | 79 | (def guess-attribute-map 80 | {"java.lang.Integer" "int" 81 | "java.lang.Boolean" "boolean" 82 | "java.lang.Long" "long" 83 | }) 84 | 85 | (defn guess-attribute-typename 86 | "Guess the attribute typename for MBeanAttributeInfo based on the attribute value." 87 | [value] 88 | (let [classname (.getName (class value))] 89 | (get guess-attribute-map classname classname))) 90 | 91 | (defn build-attribute-info 92 | "Construct an MBeanAttributeInfo. Normally called with a key/value pair from a Clojure map." 93 | ([attr-name attr-value] 94 | (build-attribute-info 95 | (as-str attr-name) 96 | (guess-attribute-typename attr-value) 97 | (as-str attr-name) true false false)) 98 | ([name type desc readable? writable? is?] (MBeanAttributeInfo. name type desc readable? writable? is? ))) 99 | 100 | (defn map->attribute-infos 101 | "Construct an MBeanAttributeInfo[] from a Clojure associative." 102 | [attr-map] 103 | (into-array (map (fn [[attr-name value]] (build-attribute-info attr-name value)) 104 | attr-map))) 105 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/jmx/server.clj: -------------------------------------------------------------------------------- 1 | ;; JMX server APIs for Clojure 2 | ;; docs in clojure/contrib/jmx.clj!! 3 | 4 | ;; by Stuart Halloway 5 | 6 | ;; Copyright (c) Stuart Halloway, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | (in-ns 'clojure.contrib.jmx) 15 | 16 | (defn register-mbean [mbean mbean-name] 17 | (.registerMBean *connection* mbean (as-object-name mbean-name))) 18 | 19 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/lazy_seqs.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Stephen C. Gilardi. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; lazy-seqs 10 | ;; 11 | ;; == Lazy sequences == 12 | ;; 13 | ;; primes - based on the "naive" implemention described in [1] plus a 14 | ;; small "wheel" which eliminates multiples of 2, 3, 5, and 15 | ;; 7 from consideration by incrementing past them. Also inspired 16 | ;; by code from Christophe Grand in [2]. 17 | ;; 18 | ;; fibs - all the Fibonacci numbers 19 | ;; 20 | ;; powers-of-2 - all the powers of 2 21 | ;; 22 | ;; == Lazy sequence functions == 23 | ;; 24 | ;; (partition-all, shuffle moved to clojure.core) 25 | ;; (rand-elt moved to clojure.core/rand-nth) 26 | ;; (rotations, moved to seq_utils.clj) 27 | ;; (permutations and combinations moved to combinatorics.clj) 28 | ;; 29 | ;; [1] http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf 30 | ;; [2] http://clj-me.blogspot.com/2008/06/primes.html 31 | ;; 32 | ;; scgilardi (gmail) 33 | ;; Created 07 June 2008 34 | 35 | (ns 36 | #^{:author "Stephen C. Gilardi", 37 | :doc " 38 | ==== Lazy sequences ==== 39 | 40 | primes - based on the \"naive\" implemention described in [1] plus a 41 | small \"wheel\" which eliminates multiples of 2, 3, 5, and 42 | 7 from consideration by incrementing past them. Also inspired 43 | by code from Christophe Grand in [2]. 44 | 45 | fibs - all the Fibonacci numbers 46 | 47 | powers-of-2 - all the powers of 2 48 | 49 | ==== Lazy sequence functions ==== 50 | 51 | (partition-all, shuffle moved to clojure.core) 52 | (rand-elt moved to clojure.core/rand-nth) 53 | (rotations, rand-elt moved to seq_utils.clj) 54 | (permutations and combinations moved to combinatorics.clj) 55 | 56 | [1] http://www.cs.hmc.edu/~oneill/papers/Sieve-JFP.pdf 57 | [2] http://clj-me.blogspot.com/2008/06/primes.html 58 | "} 59 | clojure.contrib.lazy-seqs 60 | (:use clojure.contrib.def)) 61 | 62 | ; primes cannot be written efficiently as a function, because 63 | ; it needs to look back on the whole sequence. contrast with 64 | ; fibs and powers-of-2 which only need a fixed buffer of 1 or 2 65 | ; previous values. 66 | (defvar primes 67 | (concat 68 | [2 3 5 7] 69 | (lazy-seq 70 | (let [primes-from 71 | (fn primes-from [n [f & r]] 72 | (if (some #(zero? (rem n %)) 73 | (take-while #(<= (* % %) n) primes)) 74 | (recur (+ n f) r) 75 | (lazy-seq (cons n (primes-from (+ n f) r))))) 76 | wheel (cycle [2 4 2 4 6 2 6 4 2 4 6 6 2 6 4 2 77 | 6 4 6 8 4 2 4 2 4 8 6 4 6 2 4 6 78 | 2 6 6 4 2 4 6 2 6 4 2 4 2 10 2 10])] 79 | (primes-from 11 wheel)))) 80 | "Lazy sequence of all the prime numbers.") 81 | 82 | (defn fibs 83 | "Returns a lazy sequence of all the Fibonacci numbers." 84 | [] 85 | (map first (iterate (fn [[a b]] [b (+ a b)]) [0 1]))) 86 | 87 | (defn powers-of-2 88 | "Returns a lazy sequence of all the powers of 2" 89 | [] 90 | (iterate #(bit-shift-left % 1) 1)) 91 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/lazy_xml/with_pull.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Chris Houser, Dec 2008. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | ; optional module to allow lazy-xml to use pull parser instead of sax 10 | 11 | (in-ns 'clojure.contrib.lazy-xml) 12 | (import '(org.xmlpull.v1 XmlPullParser XmlPullParserFactory)) 13 | 14 | (defn- attrs [xpp] 15 | (for [i (range (.getAttributeCount xpp))] 16 | [(keyword (.getAttributeName xpp i)) 17 | (.getAttributeValue xpp i)])) 18 | 19 | (defn- ns-decs [xpp] 20 | (let [d (.getDepth xpp)] 21 | (for [i (range (.getNamespaceCount xpp (dec d)) (.getNamespaceCount xpp d))] 22 | (let [prefix (.getNamespacePrefix xpp i)] 23 | [(keyword (str "xmlns" (when prefix (str ":" prefix)))) 24 | (.getNamespaceUri xpp i)])))) 25 | 26 | (defn- attr-hash [xpp] 27 | (into {} (concat (ns-decs xpp) (attrs xpp)))) 28 | 29 | (defn- pull-step [xpp] 30 | (let [step (fn [xpp] 31 | (condp = (.next xpp) 32 | XmlPullParser/START_TAG 33 | (cons (struct node :start-element 34 | (keyword (.getName xpp)) 35 | (attr-hash xpp)) 36 | (pull-step xpp)) 37 | XmlPullParser/END_TAG 38 | (cons (struct node :end-element 39 | (keyword (.getName xpp))) 40 | (pull-step xpp)) 41 | XmlPullParser/TEXT 42 | (let [text (.trim (.getText xpp))] 43 | (if (empty? text) 44 | (recur xpp) 45 | (cons (struct node :characters nil nil text) 46 | (pull-step xpp))))))] 47 | (lazy-seq (step xpp)))) 48 | 49 | (def #^{:private true} factory 50 | (doto (XmlPullParserFactory/newInstance) 51 | (.setNamespaceAware true))) 52 | 53 | (defn- parse-seq-pull [s] 54 | (let [xpp (.newPullParser factory)] 55 | (.setInput xpp s) 56 | (pull-step xpp))) 57 | 58 | (def has-pull true) 59 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/macros.clj: -------------------------------------------------------------------------------- 1 | ;; Various useful macros 2 | ;; 3 | ;; Everybody is invited to add their own little macros here! 4 | ;; 5 | ;; The use and distribution terms for this software are covered by the 6 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 7 | ;; which can be found in the file epl-v10.html at the root of this 8 | ;; distribution. By using this software in any fashion, you are 9 | ;; agreeing to be bound by the terms of this license. You must not 10 | ;; remove this notice, or any other, from this software. 11 | 12 | (ns 13 | #^{:author "Konrad Hinsen" 14 | :doc "Various small macros"} 15 | clojure.contrib.macros) 16 | 17 | ;; By Konrad Hinsen 18 | (defmacro const 19 | "Evaluate the constant expression expr at compile time." 20 | [expr] 21 | (eval expr)) 22 | 23 | ;; By Konrad Hinsen 24 | ; This macro is made obsolete by Clojure's built-in letfn. I renamed it to 25 | ; letfn- (to avoid a name clash) but leave it in for a while, since its 26 | ; syntax is not quite the same as Clojure's. Expect this to disappear 27 | ; in the long run! 28 | (defmacro letfn- 29 | "OBSOLETE: use clojure.core/letfn 30 | A variant of let for local function definitions. fn-bindings consists 31 | of name/args/body triples, with (letfn [name args body] ...) 32 | being equivalent to (let [name (fn name args body)] ...)." 33 | [fn-bindings & exprs] 34 | (let [makefn (fn [[name args body]] (list name (list 'fn name args body))) 35 | fns (vec (apply concat (map makefn (partition 3 fn-bindings))))] 36 | `(let ~fns ~@exprs))) 37 | 38 | ;; By Konrad Hinsen 39 | 40 | (defn- unqualified-symbol 41 | [s] 42 | (let [s-str (str s)] 43 | (symbol (subs s-str (inc (.indexOf s-str (int \/))))))) 44 | 45 | (defn- bound-var? 46 | [var] 47 | (try 48 | (do (deref var) true) 49 | (catch java.lang.IllegalStateException e false))) 50 | 51 | (defn- fns-from-ns 52 | [ns ns-symbol] 53 | (apply concat 54 | (for [[k v] (ns-publics ns) 55 | :when (and (bound-var? v) 56 | (fn? @v) 57 | (not (:macro (meta v))))] 58 | [k (symbol (str ns-symbol) (str k))]))) 59 | 60 | (defn- expand-symbol 61 | [ns-or-var-sym] 62 | (if (= ns-or-var-sym '*ns*) 63 | (fns-from-ns *ns* (ns-name *ns*)) 64 | (if-let [ns (find-ns ns-or-var-sym)] 65 | (fns-from-ns ns ns-or-var-sym) 66 | (list (unqualified-symbol ns-or-var-sym) ns-or-var-sym)))) 67 | 68 | (defmacro with-direct-linking 69 | "EXPERIMENTAL! 70 | Compiles the functions in body with direct links to the functions 71 | named in symbols, i.e. without a var lookup for each invocation. 72 | Symbols is a vector of symbols that name either vars or namespaces. 73 | A namespace reference is replaced by the list of all symbols in the 74 | namespace that are bound to functions. If symbols is not provided, 75 | the default value ['clojure.core] is used. The symbol *ns* can be 76 | used to refer to the current namespace." 77 | {:arglists '([symbols? & body])} 78 | [& body] 79 | (let [[symbols body] (if (vector? (first body)) 80 | [(first body) (rest body)] 81 | [['clojure.core] body]) 82 | bindings (vec (mapcat expand-symbol symbols))] 83 | `(let ~bindings ~@body))) 84 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/map_utils.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Jason Wolfe. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; map_utils.clj 10 | ;; 11 | ;; Utilities for operating on Clojure maps. 12 | ;; 13 | ;; jason at w01fe dot com 14 | ;; Created 25 Feb 2009 15 | 16 | (ns 17 | #^{:author "Jason Wolfe, Chris Houser", 18 | :doc "Utilities for operating on Clojure maps."} 19 | clojure.contrib.map-utils) 20 | 21 | 22 | (defmacro lazy-get 23 | "Like get, but doesn't evaluate not-found unless it is needed." 24 | [map key not-found] 25 | `(if-let [pair# (find ~map ~key)] 26 | (val pair#) 27 | ~not-found)) 28 | 29 | (defn safe-get 30 | "Like get, but throws an exception if the key is not found." 31 | [map key] 32 | (lazy-get map key 33 | (throw (IllegalArgumentException. (format "Key %s not found in %s" key map))))) 34 | 35 | (defn safe-get-in 36 | "Like get-in, but throws an exception if any key is not found." 37 | [map ks] 38 | (reduce safe-get map ks)) 39 | 40 | ; by Chouser: 41 | (defn deep-merge-with 42 | "Like merge-with, but merges maps recursively, applying the given fn 43 | only when there's a non-map at a particular level. 44 | 45 | (deepmerge + {:a {:b {:c 1 :d {:x 1 :y 2}} :e 3} :f 4} 46 | {:a {:b {:c 2 :d {:z 9} :z 3} :e 100}}) 47 | -> {:a {:b {:z 3, :c 3, :d {:z 9, :x 1, :y 2}}, :e 103}, :f 4}" 48 | [f & maps] 49 | (apply 50 | (fn m [& maps] 51 | (if (every? map? maps) 52 | (apply merge-with m maps) 53 | (apply f maps))) 54 | maps)) 55 | 56 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/miglayout.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Stephen C. Gilardi. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; clojure.contrib.miglayout 10 | ;; 11 | ;; Clojure support for the MiGLayout layout manager 12 | ;; http://www.miglayout.com/ 13 | ;; 14 | ;; Example: 15 | ;; 16 | ;; (use '[clojure.contrib.miglayout.test :as mlt :only ()]) 17 | ;; (dotimes [i 5] (mlt/run-test i)) 18 | ;; 19 | ;; scgilardi (gmail) 20 | ;; Created 5 October 2008 21 | 22 | (ns 23 | #^{:author "Stephen C. Gilardi", 24 | :doc "Clojure support for the MiGLayout layout manager 25 | http://www.miglayout.com/ 26 | 27 | Example: 28 | 29 | (use '[clojure.contrib.miglayout.test :as mlt :only ()]) 30 | (dotimes [i 5] (mlt/run-test i)) 31 | 32 | "} 33 | clojure.contrib.miglayout 34 | (:import javax.swing.JComponent) 35 | (:use clojure.contrib.miglayout.internal)) 36 | 37 | (defn miglayout 38 | "Adds java.awt.Components to a javax.swing.JComponent with constraints 39 | formatted for the MiGLayout layout manager. 40 | 41 | Arguments: container [item constraint*]* 42 | 43 | - container: the container for the specified components, its layout 44 | manager will be set to a new instance of MigLayout 45 | 46 | - an inline series of items and constraints--each item may be followed 47 | by zero or more constraints. 48 | 49 | Item: 50 | 51 | - An item is either a Component or one of the keywords :layout 52 | :column or :row. Constraints for a keyword item affect the entire 53 | layout. 54 | 55 | Constraint: string, keyword, vector, map, or set 56 | 57 | - A string specifies one or more constraints each with zero or more 58 | arguments. 59 | - A keyword specifies a single constraint without arguments 60 | - A vector specifies a single constraint with one or more arguments 61 | - A map specifies one or more constraints as keys, each mapped to a 62 | single argument 63 | - A set groups two or more constraints, each a string, keyword, 64 | vector, map, or set 65 | 66 | Any items marked with an \"id\" constraint will be included in a map from 67 | id to component attached to the container. The map can be retrieved using 68 | clojure.contrib.miglayout/components." 69 | [#^JComponent container & args] 70 | (let [item-constraints (apply parse-item-constraints args) 71 | {:keys [keywords components]} item-constraints 72 | {:keys [layout column row]} keywords] 73 | (do-layout container layout column row components))) 74 | 75 | (defn components 76 | "Returns a map from id (a keyword) to component for all components with 77 | an id constraint set" 78 | [#^JComponent container] 79 | (get-components container)) 80 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/mmap.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Chris Houser, April 2008. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | ; Functions for memory-mapping files, plus some functions that use a 10 | ; mmaped file for "normal" activies -- slurp, load-file, etc. 11 | 12 | (ns 13 | #^{:author "Chris Houser", 14 | :doc "Functions for memory-mapping files, plus some functions that use a 15 | mmaped file for \"normal\" activies -- slurp, load-file, etc."} 16 | clojure.contrib.mmap 17 | (:refer-clojure :exclude (slurp load-file)) 18 | (:import (java.nio ByteBuffer CharBuffer) 19 | (java.io PushbackReader InputStream InputStreamReader 20 | FileInputStream))) 21 | 22 | ;(set! *warn-on-reflection* true) 23 | 24 | (def READ_ONLY #^{:private true} 25 | (java.nio.channels.FileChannel$MapMode/READ_ONLY)) 26 | 27 | (defn mmap 28 | "Memory-map the file named f. Returns a ByteBuffer." 29 | [f] 30 | (let [channel (.getChannel (FileInputStream. f))] 31 | (.map channel READ_ONLY 0 (.size channel)))) 32 | 33 | (defn slurp 34 | "Reads the file named by f and returns it as a string." 35 | [#^String f] 36 | (.. java.nio.charset.Charset (forName "UTF-8") 37 | (newDecoder) (decode (mmap f)))) 38 | 39 | (defn buffer-stream 40 | "Returns an InputStream for a ByteBuffer, such as returned by mmap." 41 | [#^ByteBuffer buf] 42 | (proxy [InputStream] [] 43 | (available [] (.remaining buf)) 44 | (read 45 | ([] (if (.hasRemaining buf) (.get buf) -1)) 46 | ([dst offset len] (let [actlen (min (.remaining buf) len)] 47 | (.get buf dst offset actlen) 48 | (if (< actlen 1) -1 actlen)))))) 49 | 50 | (defn load-file [f] 51 | "Like clojure.lang/load-file, but uses mmap internally." 52 | (with-open [rdr (-> f mmap buffer-stream InputStreamReader. PushbackReader.)] 53 | (load-reader rdr))) 54 | 55 | 56 | (comment 57 | 58 | (alias 'mmap 'clojure.contrib.mmap) 59 | (alias 'core 'clojure.core) 60 | 61 | ;--- 62 | ; zip_filter.clj is 95KB 63 | (def tf "/home/chouser/build/clojure/src/clj/clojure/core.clj") 64 | (println "\nload-file" tf) 65 | (time (dotimes [_ 5] (core/load-file tf))) ; 5420.177813 msecs 66 | (time (dotimes [_ 5] (mmap/load-file tf))) ; 7946.854434 msecs -- not so good 67 | 68 | ;--- 69 | ; kern.log.0 is 961KB 70 | (def tf "/var/log/kern.log.0") 71 | (println "\nslurp" tf) 72 | (time (dotimes [_ 10] (.length (core/slurp tf)))) ; 435.767226 msecs 73 | (time (dotimes [_ 10] (.length (mmap/slurp tf)))) ; 93.176858 msecs 74 | 75 | ;--- 76 | ; kern.log.0 is 961KB 77 | (def tf "/var/log/kern.log.0") 78 | (println "\nregex slurp large" tf) 79 | (time (dotimes [_ 10] (count (re-seq #"EXT3.*" (core/slurp tf))))) ; 416 80 | (time (dotimes [_ 10] (count (re-seq #"EXT3.*" (mmap/slurp tf))))) ; 101 81 | 82 | ;--- 83 | ; mmap.clj is about 3.1KB 84 | (def tf "/home/chouser/proj/clojure-contrib/src/clojure/contrib/mmap.clj") 85 | (println "\nregex slurp small" tf) 86 | 87 | (time (dotimes [_ 1000] (count (re-seq #"defn \S*" (core/slurp tf))))) ; 308 88 | (time (dotimes [_ 1000] (count (re-seq #"defn \S*" (mmap/slurp tf))))) ; 198 89 | 90 | ) 91 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/mock/test_adapter.clj: -------------------------------------------------------------------------------- 1 | ;;; test_adapter.clj: clojure.test adapter for mocking/expectation framework for Clojure 2 | 3 | ;; by Matt Clark 4 | 5 | ;; Copyright (c) Matt Clark, 2009. All rights reserved. The use 6 | ;; and distribution terms for this software are covered by the Eclipse 7 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php). 8 | ;; By using this software in any fashion, you are 9 | ;; agreeing to be bound by the terms of this license. You must not 10 | ;; remove this notice, or any other, from this software. 11 | 12 | (ns clojure.contrib.mock.test-adapter 13 | (:require [clojure.contrib.mock :as mock]) 14 | (:use clojure.test 15 | clojure.contrib.ns-utils)) 16 | 17 | (immigrate 'clojure.contrib.mock) 18 | 19 | (defn report-problem 20 | "This function is designed to be used in a binding macro to override 21 | the report-problem function in clojure.contrib.mock. Instead of printing 22 | the error to the console, the error is logged via clojure.test." 23 | {:dynamic true} 24 | [fn-name expected actual msg] 25 | (report {:type :fail, 26 | :message (str msg " Function name: " fn-name), 27 | :expected expected, 28 | :actual actual})) 29 | 30 | 31 | (defmacro expect [& body] 32 | "Use this macro instead of the standard c.c.mock expect macro to have 33 | failures reported through clojure.test." 34 | `(binding [mock/report-problem report-problem] 35 | (mock/expect ~@body))) 36 | 37 | 38 | 39 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/ns_utils.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Stephen C. Gilardi. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; ns-utils 10 | ;; 11 | ;; Namespace Utilities 12 | ;; 13 | ;; 'get-ns' returns the namespace named by a symbol or throws 14 | ;; if the namespace does not exist 15 | ;; 16 | ;; 'ns-vars' returns a sorted seq of symbols naming public vars 17 | ;; in a namespace 18 | ;; 19 | ;; 'print-dir' prints a sorted directory of public vars in a 20 | ;; namespace 21 | ;; 22 | ;; 'print-docs' prints documentation for the public vars in a 23 | ;; namespace 24 | ;; 25 | ;; 'immigrate' Create a public var in this namespace for each 26 | ;; public var in the namespaces named by ns-names. 27 | ;; From James Reeves 28 | ;; Convenience 29 | ;; 30 | ;; 'vars' returns a sorted seq of symbols naming public vars 31 | ;; in a namespace (macro) 32 | ;; 33 | ;; 'dir' prints a sorted directory of public vars in a 34 | ;; namespace (macro) 35 | ;; 36 | ;; 'docs' prints documentation for the public vars in a 37 | ;; namespace (macro) 38 | ;; 39 | ;; scgilardi (gmail) 40 | ;; 23 April 2008 41 | 42 | (ns 43 | #^{:author "Stephen C. Gilardi", 44 | :doc "Namespace utilities"} 45 | clojure.contrib.ns-utils 46 | (:use clojure.contrib.except)) 47 | 48 | ;; Namespace Utilities 49 | 50 | (defn get-ns 51 | "Returns the namespace named by ns-sym or throws if the 52 | namespace does not exist" 53 | [ns-sym] 54 | (let [ns (find-ns ns-sym)] 55 | (throw-if (not ns) "Unable to find namespace: %s" ns-sym) 56 | ns)) 57 | 58 | (defn ns-vars 59 | "Returns a sorted seq of symbols naming public vars in 60 | a namespace" 61 | [ns] 62 | (sort (map first (ns-publics ns)))) 63 | 64 | (defn print-dir 65 | "Prints a sorted directory of public vars in a namespace" 66 | [ns] 67 | (doseq [item (ns-vars ns)] 68 | (println item))) 69 | 70 | (defn print-docs 71 | "Prints documentation for the public vars in a namespace" 72 | [ns] 73 | (doseq [item (ns-vars ns)] 74 | (print-doc (ns-resolve ns item)))) 75 | 76 | ;; Convenience 77 | 78 | (defmacro vars 79 | "Returns a sorted seq of symbols naming public vars in 80 | a namespace" 81 | [nsname] 82 | `(ns-vars (get-ns '~nsname))) 83 | 84 | (defmacro dir 85 | "Prints a sorted directory of public vars in a namespace" 86 | [nsname] 87 | `(print-dir (get-ns '~nsname))) 88 | 89 | (defmacro docs 90 | "Prints documentation for the public vars in a namespace" 91 | [nsname] 92 | `(print-docs (get-ns '~nsname))) 93 | 94 | (defn immigrate 95 | "Create a public var in this namespace for each public var in the 96 | namespaces named by ns-names. The created vars have the same name, root 97 | binding, and metadata as the original except that their :ns metadata 98 | value is this namespace." 99 | [& ns-names] 100 | (doseq [ns ns-names] 101 | (require ns) 102 | (doseq [[sym var] (ns-publics ns)] 103 | (let [sym (with-meta sym (assoc (meta var) :ns *ns*))] 104 | (if (.hasRoot var) 105 | (intern *ns* sym (.getRoot var)) 106 | (intern *ns* sym)))))) 107 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/pprint.clj: -------------------------------------------------------------------------------- 1 | ;;; pprint.clj -- Pretty printer and Common Lisp compatible format function (cl-format) for Clojure 2 | 3 | ;; by Tom Faulhaber 4 | ;; April 3, 2009 5 | 6 | ;; Copyright (c) Tom Faulhaber, April 2009. All rights reserved. 7 | ;; The use and distribution terms for this software are covered by the 8 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this distribution. 10 | ;; By using this software in any fashion, you are agreeing to be bound by 11 | ;; the terms of this license. 12 | ;; You must not remove this notice, or any other, from this software. 13 | 14 | (ns 15 | #^{:author "Tom Faulhaber", 16 | :doc "This module comprises two elements: 17 | 1) A pretty printer for Clojure data structures, implemented in the 18 | function \"pprint\" 19 | 2) A Common Lisp compatible format function, implemented as 20 | \"cl-format\" because Clojure is using the name \"format\" 21 | for its Java-based format function. 22 | 23 | See documentation for those functions for more information or complete 24 | documentation on the the clojure-contrib web site on github.", 25 | } 26 | clojure.contrib.pprint 27 | (:use clojure.contrib.pprint.utilities) 28 | (:use clojure.contrib.pprint.pretty-writer 29 | clojure.contrib.pprint.column-writer)) 30 | 31 | 32 | (load "pprint/pprint_base") 33 | (load "pprint/cl_format") 34 | (load "pprint/dispatch") 35 | 36 | nil 37 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/pprint/column_writer.clj: -------------------------------------------------------------------------------- 1 | ;;; column_writer.clj -- part of the pretty printer for Clojure 2 | 3 | ;; by Tom Faulhaber 4 | ;; April 3, 2009 5 | ;; Revised to use proxy instead of gen-class April 2010 6 | 7 | ; Copyright (c) Tom Faulhaber, Dec 2008. All rights reserved. 8 | ; The use and distribution terms for this software are covered by the 9 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 10 | ; which can be found in the file epl-v10.html at the root of this distribution. 11 | ; By using this software in any fashion, you are agreeing to be bound by 12 | ; the terms of this license. 13 | ; You must not remove this notice, or any other, from this software. 14 | 15 | ;; This module implements a column-aware wrapper around an instance of java.io.Writer 16 | 17 | (ns clojure.contrib.pprint.column-writer 18 | (:import 19 | [clojure.lang IDeref] 20 | [java.io Writer])) 21 | 22 | (def *default-page-width* 72) 23 | 24 | (defn- get-field [#^Writer this sym] 25 | (sym @@this)) 26 | 27 | (defn- set-field [#^Writer this sym new-val] 28 | (alter @this assoc sym new-val)) 29 | 30 | (defn get-column [this] 31 | (get-field this :cur)) 32 | 33 | (defn get-line [this] 34 | (get-field this :line)) 35 | 36 | (defn get-max-column [this] 37 | (get-field this :max)) 38 | 39 | (defn set-max-column [this new-max] 40 | (dosync (set-field this :max new-max)) 41 | nil) 42 | 43 | (defn get-writer [this] 44 | (get-field this :base)) 45 | 46 | (defn- write-char [#^Writer this #^Integer c] 47 | (dosync (if (= c (int \newline)) 48 | (do 49 | (set-field this :cur 0) 50 | (set-field this :line (inc (get-field this :line)))) 51 | (set-field this :cur (inc (get-field this :cur))))) 52 | (.write #^Writer (get-field this :base) c)) 53 | 54 | (defn column-writer 55 | ([writer] (column-writer writer *default-page-width*)) 56 | ([writer max-columns] 57 | (let [fields (ref {:max max-columns, :cur 0, :line 0 :base writer})] 58 | (proxy [Writer IDeref] [] 59 | (deref [] fields) 60 | (write 61 | ([#^chars cbuf #^Integer off #^Integer len] 62 | (let [#^Writer writer (get-field this :base)] 63 | (.write writer cbuf off len))) 64 | ([x] 65 | (condp = (class x) 66 | String 67 | (let [#^String s x 68 | nl (.lastIndexOf s (int \newline))] 69 | (dosync (if (neg? nl) 70 | (set-field this :cur (+ (get-field this :cur) (count s))) 71 | (do 72 | (set-field this :cur (- (count s) nl 1)) 73 | (set-field this :line (+ (get-field this :line) 74 | (count (filter #(= % \newline) s))))))) 75 | (.write #^Writer (get-field this :base) s)) 76 | 77 | Integer 78 | (write-char this x) 79 | Long 80 | (write-char this x)))))))) 81 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/pprint/utilities.clj: -------------------------------------------------------------------------------- 1 | ;;; utilities.clj -- part of the pretty printer for Clojure 2 | 3 | ;; by Tom Faulhaber 4 | ;; April 3, 2009 5 | 6 | ; Copyright (c) Tom Faulhaber, Jan 2009. All rights reserved. 7 | ; The use and distribution terms for this software are covered by the 8 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ; which can be found in the file epl-v10.html at the root of this distribution. 10 | ; By using this software in any fashion, you are agreeing to be bound by 11 | ; the terms of this license. 12 | ; You must not remove this notice, or any other, from this software. 13 | 14 | ;; This module implements some utility function used in formatting and pretty 15 | ;; printing. The functions here could go in a more general purpose library, 16 | ;; perhaps. 17 | 18 | (ns clojure.contrib.pprint.utilities) 19 | 20 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 21 | ;;; Helper functions for digesting formats in the various 22 | ;;; phases of their lives. 23 | ;;; These functions are actually pretty general. 24 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 25 | 26 | (defn map-passing-context [func initial-context lis] 27 | (loop [context initial-context 28 | lis lis 29 | acc []] 30 | (if (empty? lis) 31 | [acc context] 32 | (let [this (first lis) 33 | remainder (next lis) 34 | [result new-context] (apply func [this context])] 35 | (recur new-context remainder (conj acc result)))))) 36 | 37 | (defn consume [func initial-context] 38 | (loop [context initial-context 39 | acc []] 40 | (let [[result new-context] (apply func [context])] 41 | (if (not result) 42 | [acc new-context] 43 | (recur new-context (conj acc result)))))) 44 | 45 | (defn consume-while [func initial-context] 46 | (loop [context initial-context 47 | acc []] 48 | (let [[result continue new-context] (apply func [context])] 49 | (if (not continue) 50 | [acc context] 51 | (recur new-context (conj acc result)))))) 52 | 53 | (defn unzip-map [m] 54 | "Take a map that has pairs in the value slots and produce a pair of maps, 55 | the first having all the first elements of the pairs and the second all 56 | the second elements of the pairs" 57 | [(into {} (for [[k [v1 v2]] m] [k v1])) 58 | (into {} (for [[k [v1 v2]] m] [k v2]))]) 59 | 60 | (defn tuple-map [m v1] 61 | "For all the values, v, in the map, replace them with [v v1]" 62 | (into {} (for [[k v] m] [k [v v1]]))) 63 | 64 | (defn rtrim [s c] 65 | "Trim all instances of c from the end of sequence s" 66 | (let [len (count s)] 67 | (if (and (pos? len) (= (nth s (dec (count s))) c)) 68 | (loop [n (dec len)] 69 | (cond 70 | (neg? n) "" 71 | (not (= (nth s n) c)) (subs s 0 (inc n)) 72 | true (recur (dec n)))) 73 | s))) 74 | 75 | (defn ltrim [s c] 76 | "Trim all instances of c from the beginning of sequence s" 77 | (let [len (count s)] 78 | (if (and (pos? len) (= (nth s 0) c)) 79 | (loop [n 0] 80 | (if (or (= n len) (not (= (nth s n) c))) 81 | (subs s n) 82 | (recur (inc n)))) 83 | s))) 84 | 85 | (defn prefix-count [aseq val] 86 | "Return the number of times that val occurs at the start of sequence aseq, 87 | if val is a seq itself, count the number of times any element of val occurs at the 88 | beginning of aseq" 89 | (let [test (if (coll? val) (set val) #{val})] 90 | (loop [pos 0] 91 | (if (or (= pos (count aseq)) (not (test (nth aseq pos)))) 92 | pos 93 | (recur (inc pos)))))) 94 | 95 | (defn prerr [& args] 96 | "Println to *err*" 97 | (binding [*out* *err*] 98 | (apply println args))) 99 | 100 | (defmacro prlabel [prefix arg & more-args] 101 | "Print args to *err* in name = value format" 102 | `(prerr ~@(cons (list 'quote prefix) (mapcat #(list (list 'quote %) "=" %) 103 | (cons arg (seq more-args)))))) 104 | 105 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/probabilities/random_numbers.clj: -------------------------------------------------------------------------------- 1 | ;; Random number generators 2 | 3 | ;; by Konrad Hinsen 4 | ;; last updated May 3, 2009 5 | 6 | ;; Copyright (c) Konrad Hinsen, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | (ns 15 | #^{:author "Konrad Hinsen" 16 | :doc "Random number streams 17 | 18 | This library provides random number generators with a common 19 | stream interface. They all produce pseudo-random numbers that are 20 | uniformly distributed in the interval [0, 1), i.e. 0 is a 21 | possible value but 1 isn't. For transformations to other 22 | distributions, see clojure.contrib.probabilities.monte-carlo. 23 | 24 | At the moment, the only generator provided is a rather simple 25 | linear congruential generator."} 26 | clojure.contrib.probabilities.random-numbers 27 | (:refer-clojure :exclude (deftype)) 28 | (:use [clojure.contrib.types :only (deftype)]) 29 | (:use [clojure.contrib.stream-utils :only (defstream)]) 30 | (:use [clojure.contrib.def :only (defvar)])) 31 | 32 | ;; Linear congruential generator 33 | ;; http://en.wikipedia.org/wiki/Linear_congruential_generator 34 | 35 | (deftype ::lcg lcg 36 | "Create a linear congruential generator" 37 | {:arglists '([modulus multiplier increment seed])} 38 | (fn [modulus multiplier increment seed] 39 | {:m modulus :a multiplier :c increment :seed seed}) 40 | (fn [s] (map s (list :m :a :c :seed)))) 41 | 42 | (defstream ::lcg 43 | [lcg-state] 44 | (let [{m :m a :a c :c seed :seed} lcg-state 45 | value (/ (float seed) (float m)) 46 | new-seed (rem (+ c (* a seed)) m)] 47 | [value (assoc lcg-state :seed new-seed)])) 48 | 49 | ;; A generator based on Clojure's built-in rand function 50 | ;; (and thus random from java.lang.Math) 51 | ;; Note that this generator uses an internal mutable state. 52 | ;; 53 | ;; The state is *not* stored in the stream object and can thus 54 | ;; *not* be restored! 55 | 56 | (defvar rand-stream (with-meta 'rand {:type ::rand-stream}) 57 | "A random number stream based on clojure.core/rand. Note that this 58 | generator uses an internal mutable state. The state is thus not stored 59 | in the stream object and cannot be restored.") 60 | 61 | (defstream ::rand-stream 62 | [dummy-state] 63 | [(rand) dummy-state]) 64 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/properties.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Stuart Halloway & Contributors, April 2009. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.contrib.properties 10 | (:use [clojure.contrib.string :only (as-str)] 11 | [clojure.contrib.io :only (file)]) 12 | (:import (java.util Properties) 13 | (java.io FileInputStream FileOutputStream))) 14 | 15 | (defn get-system-property 16 | "Get a system property." 17 | ([stringable] 18 | (System/getProperty (as-str stringable))) 19 | ([stringable default] 20 | (System/getProperty (as-str stringable) default))) 21 | 22 | (defn set-system-properties 23 | "Set some system properties. Nil clears a property." 24 | [settings] 25 | (doseq [[name val] settings] 26 | (if val 27 | (System/setProperty (as-str name) (as-str val)) 28 | (System/clearProperty (as-str name))))) 29 | 30 | (defmacro with-system-properties 31 | "setting => property-name value 32 | 33 | Sets the system properties to the supplied values, executes the body, and 34 | sets the properties back to their original values. Values of nil are 35 | translated to a clearing of the property." 36 | [settings & body] 37 | `(let [settings# ~settings 38 | current# (reduce (fn [coll# k#] 39 | (assoc coll# k# (get-system-property k#))) 40 | {} 41 | (keys settings#))] 42 | (set-system-properties settings#) 43 | (try 44 | ~@body 45 | (finally 46 | (set-system-properties current#))))) 47 | 48 | 49 | ; Not there is no corresponding props->map. Just destructure! 50 | (defn #^Properties as-properties 51 | "Convert any seq of pairs to a java.utils.Properties instance. 52 | Uses as-str to convert both keys and values into strings." 53 | {:tag Properties} 54 | [m] 55 | (let [p (Properties.)] 56 | (doseq [[k v] m] 57 | (.setProperty p (as-str k) (as-str v))) 58 | p)) 59 | 60 | (defn read-properties 61 | "Read properties from file-able." 62 | [file-able] 63 | (with-open [f (java.io.FileInputStream. (file file-able))] 64 | (doto (Properties.) 65 | (.load f)))) 66 | 67 | (defn write-properties 68 | "Write properties to file-able." 69 | {:tag Properties} 70 | ([m file-able] (write-properties m file-able nil)) 71 | ([m file-able comments] 72 | (with-open [#^FileOutputStream f (FileOutputStream. (file file-able))] 73 | (doto (as-properties m) 74 | (.store f #^String comments))))) 75 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/reflect.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) 2010 Stuart Halloway & Contributors. All rights 2 | ; reserved. The use and distribution terms for this software are 3 | ; covered by the Eclipse Public License 1.0 4 | ; (http://opensource.org/licenses/eclipse-1.0.php) which can be 5 | ; found in the file epl-v10.html at the root of this distribution. 6 | ; By using this software in any fashion, you are agreeing to be 7 | ; bound by the terms of this license. You must not remove this 8 | ; notice, or any other, from this software. 9 | 10 | (ns clojure.contrib.reflect) 11 | 12 | (defn call-method 13 | "Calls a private or protected method. 14 | 15 | params is a vector of classes which correspond to the arguments to 16 | the method e 17 | 18 | obj is nil for static methods, the instance object otherwise. 19 | 20 | The method-name is given a symbol or a keyword (something Named)." 21 | [klass method-name params obj & args] 22 | (-> klass (.getDeclaredMethod (name method-name) 23 | (into-array Class params)) 24 | (doto (.setAccessible true)) 25 | (.invoke obj (into-array Object args)))) 26 | 27 | (defn get-field 28 | "Access to private or protected field. field-name is a symbol or 29 | keyword." 30 | [klass field-name obj] 31 | (-> klass (.getDeclaredField (name field-name)) 32 | (doto (.setAccessible true)) 33 | (.get obj))) 34 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/repl_utils/javadoc.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Christophe Grand, November 2008. All rights reserved. 2 | 3 | ; The use and distribution terms for this software are covered by the 4 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 5 | ; which can be found in the file epl-v10.html at the root of this 6 | ; distribution. 7 | ; By using this software in any fashion, you are agreeing to be bound by 8 | ; the terms of this license. 9 | ; You must not remove this notice, or any other, from this software. 10 | 11 | ; thanks to Stuart Sierra 12 | 13 | ; a repl helper to quickly open javadocs. 14 | 15 | (def *feeling-lucky-url* "http://www.google.com/search?btnI=I%27m%20Feeling%20Lucky&q=allinurl:") 16 | (def *feeling-lucky* true) 17 | 18 | (def 19 | #^{:doc "Ref to a list of local paths for Javadoc-generated HTML 20 | files."} 21 | *local-javadocs* (ref (list))) 22 | 23 | (def *core-java-api* 24 | (if (= "1.5" (System/getProperty "java.specification.version")) 25 | "http://java.sun.com/j2se/1.5.0/docs/api/" 26 | "http://java.sun.com/javase/6/docs/api/")) 27 | 28 | (def 29 | #^{:doc "Ref to a map from package name prefixes to URLs for remote 30 | Javadocs."} 31 | *remote-javadocs* 32 | (ref (sorted-map 33 | "java." *core-java-api* 34 | "javax." *core-java-api* 35 | "org.ietf.jgss." *core-java-api* 36 | "org.omg." *core-java-api* 37 | "org.w3c.dom." *core-java-api* 38 | "org.xml.sax." *core-java-api* 39 | "org.apache.commons.codec." "http://commons.apache.org/codec/api-release/" 40 | "org.apache.commons.io." "http://commons.apache.org/io/api-release/" 41 | "org.apache.commons.lang." "http://commons.apache.org/lang/api-release/"))) 42 | 43 | (defn add-local-javadoc 44 | "Adds to the list of local Javadoc paths." 45 | [path] 46 | (dosync (commute *local-javadocs* conj path))) 47 | 48 | (defn add-remote-javadoc 49 | "Adds to the list of remote Javadoc URLs. package-prefix is the 50 | beginning of the package name that has docs at this URL." 51 | [package-prefix url] 52 | (dosync (commute *remote-javadocs* assoc package-prefix url))) 53 | 54 | (defn find-javadoc-url 55 | "Searches for a URL for the given class name. Tries 56 | *local-javadocs* first, then *remote-javadocs*. Returns a string." 57 | {:tag String} 58 | [#^String classname] 59 | (let [file-path (.replace classname \. File/separatorChar) 60 | url-path (.replace classname \. \/)] 61 | (if-let [file #^File (first 62 | (filter #(.exists #^File %) 63 | (map #(File. (str %) (str file-path ".html")) 64 | @*local-javadocs*)))] 65 | (-> file .toURI str) 66 | ;; If no local file, try remote URLs: 67 | (or (some (fn [[prefix url]] 68 | (when (.startsWith classname prefix) 69 | (str url url-path ".html"))) 70 | @*remote-javadocs*) 71 | ;; if *feeling-lucky* try a web search 72 | (when *feeling-lucky* (str *feeling-lucky-url* url-path ".html")))))) 73 | 74 | (defn javadoc 75 | "Opens a browser window displaying the javadoc for the argument. 76 | Tries *local-javadocs* first, then *remote-javadocs*." 77 | [class-or-object] 78 | (let [#^Class c (if (instance? Class class-or-object) 79 | class-or-object 80 | (class class-or-object))] 81 | (if-let [url (find-javadoc-url (.getName c))] 82 | (browse-url url) 83 | (println "Could not find Javadoc for" c)))) 84 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/server_socket.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Craig McDaniel, Jan 2009. All rights reserved. 2 | ;; The use and distribution terms for this software are covered by the 3 | ;; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ;; which can be found in the file epl-v10.html at the root of this distribution. 5 | ;; By using this software in any fashion, you are agreeing to be bound by 6 | ;; the terms of this license. 7 | ;; You must not remove this notice, or any other, from this software. 8 | 9 | ;; Server socket library - includes REPL on socket 10 | 11 | (ns 12 | #^{:author "Craig McDaniel", 13 | :doc "Server socket library - includes REPL on socket"} 14 | clojure.contrib.server-socket 15 | (:import (java.net InetAddress ServerSocket Socket SocketException) 16 | (java.io InputStreamReader OutputStream OutputStreamWriter PrintWriter) 17 | (clojure.lang LineNumberingPushbackReader)) 18 | (:use [clojure.main :only (repl)])) 19 | 20 | (defn- on-thread [f] 21 | (doto (Thread. #^Runnable f) 22 | (.start))) 23 | 24 | (defn- close-socket [#^Socket s] 25 | (when-not (.isClosed s) 26 | (doto s 27 | (.shutdownInput) 28 | (.shutdownOutput) 29 | (.close)))) 30 | 31 | (defn- accept-fn [#^Socket s connections fun] 32 | (let [ins (.getInputStream s) 33 | outs (.getOutputStream s)] 34 | (on-thread #(do 35 | (dosync (commute connections conj s)) 36 | (try 37 | (fun ins outs) 38 | (catch SocketException e)) 39 | (close-socket s) 40 | (dosync (commute connections disj s)))))) 41 | 42 | (defstruct server-def :server-socket :connections) 43 | 44 | (defn- create-server-aux [fun #^ServerSocket ss] 45 | (let [connections (ref #{})] 46 | (on-thread #(when-not (.isClosed ss) 47 | (try 48 | (accept-fn (.accept ss) connections fun) 49 | (catch SocketException e)) 50 | (recur))) 51 | (struct-map server-def :server-socket ss :connections connections))) 52 | 53 | (defn create-server 54 | "Creates a server socket on port. Upon accept, a new thread is 55 | created which calls: 56 | 57 | (fun input-stream output-stream) 58 | 59 | Optional arguments support specifying a listen backlog and binding 60 | to a specific endpoint." 61 | ([port fun backlog #^InetAddress bind-addr] 62 | (create-server-aux fun (ServerSocket. port backlog bind-addr))) 63 | ([port fun backlog] 64 | (create-server-aux fun (ServerSocket. port backlog))) 65 | ([port fun] 66 | (create-server-aux fun (ServerSocket. port)))) 67 | 68 | (defn close-server [server] 69 | (doseq [s @(:connections server)] 70 | (close-socket s)) 71 | (dosync (ref-set (:connections server) #{})) 72 | (.close #^ServerSocket (:server-socket server))) 73 | 74 | (defn connection-count [server] 75 | (count @(:connections server))) 76 | 77 | ;;;; 78 | ;;;; REPL on a socket 79 | ;;;; 80 | 81 | (defn- socket-repl [ins outs] 82 | (binding [*in* (LineNumberingPushbackReader. (InputStreamReader. ins)) 83 | *out* (OutputStreamWriter. outs) 84 | *err* (PrintWriter. #^OutputStream outs true)] 85 | (repl))) 86 | 87 | (defn create-repl-server 88 | "create a repl on a socket" 89 | ([port backlog #^InetAddress bind-addr] 90 | (create-server port socket-repl backlog bind-addr)) 91 | ([port backlog] 92 | (create-server port socket-repl backlog)) 93 | ([port] 94 | (create-server port socket-repl))) 95 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/set.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Jason Wolfe. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; set.clj 10 | ;; 11 | ;; Clojure functions for operating on sets (supplemental to clojure.set) 12 | ;; 13 | ;; jason at w01fe dot com 14 | ;; Created 2 Feb 2009 15 | 16 | (ns 17 | #^{:author "Jason Wolfe", 18 | :doc "Clojure functions for operating on sets (supplemental to clojure.set)"} 19 | clojure.contrib.set) 20 | 21 | (defn subset? 22 | "Is set1 a subset of set2?" 23 | [set1 set2] 24 | {:tag Boolean} 25 | (and (<= (count set1) (count set2)) 26 | (every? set2 set1))) 27 | 28 | (defn superset? 29 | "Is set1 a superset of set2?" 30 | [set1 set2] 31 | {:tag Boolean} 32 | (and (>= (count set1) (count set2)) 33 | (every? set1 set2))) 34 | 35 | (defn proper-subset? 36 | "Is s1 a proper subset of s2?" 37 | [set1 set2] 38 | {:tag Boolean} 39 | (and (< (count set1) (count set2)) 40 | (every? set2 set1))) 41 | 42 | (defn proper-superset? 43 | "Is s1 a proper superset of s2?" 44 | [set1 set2] 45 | {:tag Boolean} 46 | (and (> (count set1) (count set2)) 47 | (every? set1 set2))) 48 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/singleton.clj: -------------------------------------------------------------------------------- 1 | ;;; singleton.clj: singleton functions 2 | 3 | ;; by Stuart Sierra, http://stuartsierra.com/ 4 | ;; April 14, 2009 5 | 6 | ;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | 15 | ;; Change Log: 16 | ;; 17 | ;; April 14, 2009: added per-thread-singleton, renamed singleton to 18 | ;; global-singleton 19 | ;; 20 | ;; April 9, 2009: initial version 21 | 22 | 23 | (ns 24 | #^{:author "Stuart Sierra", 25 | :doc "Singleton functions"} 26 | clojure.contrib.singleton) 27 | 28 | (defn global-singleton 29 | "Returns a global singleton function. f is a function of no 30 | arguments that creates and returns some object. The singleton 31 | function will call f just once, the first time it is needed, and 32 | cache the value for all subsequent calls. 33 | 34 | Warning: global singletons are often unsafe in multi-threaded code. 35 | Consider per-thread-singleton instead." 36 | [f] 37 | (let [instance (atom nil) 38 | make-instance (fn [_] (f))] 39 | (fn [] (or @instance (swap! instance make-instance))))) 40 | 41 | (defn per-thread-singleton 42 | "Returns a per-thread singleton function. f is a function of no 43 | arguments that creates and returns some object. The singleton 44 | function will call f only once for each thread, and cache its value 45 | for subsequent calls from the same thread. This allows you to 46 | safely and lazily initialize shared objects on a per-thread basis. 47 | 48 | Warning: due to a bug in JDK 5, it may not be safe to use a 49 | per-thread-singleton in the initialization function for another 50 | per-thread-singleton. See 51 | http://bugs.sun.com/bugdatabase/view_bug.do?bug_id=5025230" 52 | [f] 53 | (let [thread-local (proxy [ThreadLocal] [] (initialValue [] (f)))] 54 | (fn [] (.get thread-local)))) 55 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/str_utils.clj: -------------------------------------------------------------------------------- 1 | ;;; str_utils.clj -- string utilities for Clojure 2 | 3 | ;; by Stuart Sierra 4 | ;; April 8, 2008 5 | 6 | ;; Copyright (c) Stuart Sierra, 2008. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | 15 | (ns 16 | #^{:author "Stuart Sierra", 17 | :doc "String utilities for Clojure"} 18 | clojure.contrib.str-utils 19 | (:import (java.util.regex Pattern))) 20 | 21 | (defn re-split 22 | "Splits the string on instances of 'pattern'. Returns a sequence of 23 | strings. Optional 'limit' argument is the maximum number of 24 | splits. Like Perl's 'split'." 25 | ([#^Pattern pattern string] (seq (. pattern (split string)))) 26 | ([#^Pattern pattern string limit] (seq (. pattern (split string limit))))) 27 | 28 | (defn re-partition 29 | "Splits the string into a lazy sequence of substrings, alternating 30 | between substrings that match the patthern and the substrings 31 | between the matches. The sequence always starts with the substring 32 | before the first match, or an empty string if the beginning of the 33 | string matches. 34 | 35 | For example: (re-partition #\"[a-z]+\" \"abc123def\") 36 | 37 | Returns: (\"\" \"abc\" \"123\" \"def\")" 38 | [#^Pattern re string] 39 | (let [m (re-matcher re string)] 40 | ((fn step [prevend] 41 | (lazy-seq 42 | (if (.find m) 43 | (cons (.subSequence string prevend (.start m)) 44 | (cons (re-groups m) 45 | (step (+ (.start m) (count (.group m)))))) 46 | (when (< prevend (.length string)) 47 | (list (.subSequence string prevend (.length string))))))) 48 | 0))) 49 | 50 | (defn re-gsub 51 | "Replaces all instances of 'pattern' in 'string' with 52 | 'replacement'. Like Ruby's 'String#gsub'. 53 | 54 | If (ifn? replacment) is true, the replacement is called with the 55 | match. 56 | " 57 | [#^java.util.regex.Pattern regex replacement #^String string] 58 | (if (ifn? replacement) 59 | (let [parts (vec (re-partition regex string))] 60 | (apply str 61 | (reduce (fn [parts match-idx] 62 | (update-in parts [match-idx] replacement)) 63 | parts (range 1 (count parts) 2)))) 64 | (.. regex (matcher string) (replaceAll replacement)))) 65 | 66 | (defn re-sub 67 | "Replaces the first instance of 'pattern' in 'string' with 68 | 'replacement'. Like Ruby's 'String#sub'. 69 | 70 | If (ifn? replacement) is true, the replacement is called with 71 | the match. 72 | " 73 | [#^Pattern regex replacement #^String string] 74 | (if (ifn? replacement) 75 | (let [m (re-matcher regex string)] 76 | (if (.find m) 77 | (str (.subSequence string 0 (.start m)) 78 | (replacement (re-groups m)) 79 | (.subSequence string (.end m) (.length string))) 80 | string)) 81 | (.. regex (matcher string) (replaceFirst replacement)))) 82 | 83 | 84 | (defn str-join 85 | "Returns a string of all elements in 'sequence', separated by 86 | 'separator'. Like Perl's 'join'." 87 | [separator sequence] 88 | (apply str (interpose separator sequence))) 89 | 90 | 91 | (defn chop 92 | "Removes the last character of string." 93 | [s] 94 | (subs s 0 (dec (count s)))) 95 | 96 | (defn chomp 97 | "Removes all trailing newline \\n or return \\r characters from 98 | string. Note: String.trim() is similar and faster." 99 | [s] 100 | (re-sub #"[\r\n]+$" "" s)) 101 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/strint.clj: -------------------------------------------------------------------------------- 1 | ;;; strint.clj -- String interpolation for Clojure 2 | ;; originally proposed/published at http://muckandbrass.com/web/x/AgBP 3 | 4 | ;; by Chas Emerick 5 | ;; December 4, 2009 6 | 7 | ;; Copyright (c) Chas Emerick, 2009. All rights reserved. The use 8 | ;; and distribution terms for this software are covered by the Eclipse 9 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 10 | ;; which can be found in the file epl-v10.html at the root of this 11 | ;; distribution. By using this software in any fashion, you are 12 | ;; agreeing to be bound by the terms of this license. You must not 13 | ;; remove this notice, or any other, from this software. 14 | 15 | (ns 16 | #^{:author "Chas Emerick", 17 | :doc "String interpolation for Clojure."} 18 | clojure.contrib.strint 19 | (:use [clojure.contrib.io :only (slurp*)])) 20 | 21 | (defn- silent-read 22 | "Attempts to clojure.core/read a single form from the provided String, returning 23 | a vector containing the read form and a String containing the unread remainder 24 | of the provided String. Returns nil if no valid form can be read from the 25 | head of the String." 26 | [s] 27 | (try 28 | (let [r (-> s java.io.StringReader. java.io.PushbackReader.)] 29 | [(read r) (slurp* r)]) 30 | (catch Exception e))) ; this indicates an invalid form -- the head of s is just string data 31 | 32 | (defn- interpolate 33 | "Yields a seq of Strings and read forms." 34 | ([s atom?] 35 | (lazy-seq 36 | (if-let [[form rest] (silent-read (subs s (if atom? 2 1)))] 37 | (cons form (interpolate (if atom? (subs rest 1) rest))) 38 | (cons (subs s 0 2) (interpolate (subs s 2)))))) 39 | ([#^String s] 40 | (if-let [start (->> ["~{" "~("] 41 | (map #(.indexOf s %)) 42 | (remove #(== -1 %)) 43 | sort 44 | first)] 45 | (lazy-seq (cons 46 | (subs s 0 start) 47 | (interpolate (subs s start) (= \{ (.charAt s (inc start)))))) 48 | [s]))) 49 | 50 | (defmacro << 51 | "Takes a single string argument and emits a str invocation that concatenates 52 | the string data and evaluated expressions contained within that argument. 53 | Evaluation is controlled using ~{} and ~() forms. The former is used for 54 | simple value replacement using clojure.core/str; the latter can be used to 55 | embed the results of arbitrary function invocation into the produced string. 56 | 57 | Examples: 58 | user=> (def v 30.5) 59 | #'user/v 60 | user=> (<< \"This trial required ~{v}ml of solution.\") 61 | \"This trial required 30.5ml of solution.\" 62 | user=> (<< \"There are ~(int v) days in November.\") 63 | \"There are 30 days in November.\" 64 | user=> (def m {:a [1 2 3]}) 65 | #'user/m 66 | user=> (<< \"The total for your order is $~(->> m :a (apply +)).\") 67 | \"The total for your order is $6.\" 68 | 69 | Note that quotes surrounding string literals within ~() forms must be 70 | escaped." 71 | [string] 72 | `(str ~@(interpolate string))) 73 | 74 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/test_is.clj: -------------------------------------------------------------------------------- 1 | ;;; test_is.clj: Compatibility layer for old clojure.contrib.test-is 2 | 3 | ;; by Stuart Sierra, http://stuartsierra.com/ 4 | ;; August 28, 2009 5 | 6 | ;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | 15 | 16 | (ns #^{:doc "Backwards-compatibility for clojure.contrib.test-is 17 | 18 | The clojure.contrib.test-is library moved from Contrib into the 19 | Clojure distribution as clojure.test. 20 | 21 | This happened on or around clojure-contrib Git commit 22 | 82cf0409d0fcb71be477ebfc4da18ee2128a2ad1 on June 25, 2009. 23 | 24 | This file makes the clojure.test interface available under the old 25 | namespace clojure.contrib.test-is. 26 | 27 | This includes support for the old syntax of the 'are' macro. 28 | 29 | This was suggested by Howard Lewis Ship in ticket #26, 30 | http://www.assembla.com/spaces/clojure-contrib/tickets/26" 31 | :author "Stuart Sierra"} 32 | clojure.contrib.test-is 33 | (:require clojure.test 34 | [clojure.walk :as walk])) 35 | 36 | 37 | ;;; COPY INTERNED VARS (EXCEPT are) FROM clojure.test 38 | 39 | (doseq [v (disj (set (vals (ns-interns 'clojure.test))) 40 | #'clojure.test/are)] 41 | (intern *ns* (with-meta (:name (meta v)) (meta v)) (var-get v))) 42 | 43 | 44 | ;;; REDEFINE OLD clojure.contrib.template 45 | 46 | (defn find-symbols 47 | "Recursively finds all symbols in form." 48 | [form] 49 | (distinct (filter symbol? (tree-seq coll? seq form)))) 50 | 51 | (defn find-holes 52 | "Recursively finds all symbols starting with _ in form." 53 | [form] 54 | (sort (distinct (filter #(.startsWith (name %) "_") 55 | (find-symbols form))))) 56 | 57 | (defn find-pure-exprs 58 | "Recursively finds all sub-expressions in form that do not contain 59 | any symbols starting with _" 60 | [form] 61 | (filter #(and (list? %) 62 | (empty? (find-holes %))) 63 | (tree-seq seq? seq form))) 64 | 65 | (defn flatten-map 66 | "Transforms a map into a vector like [key value key value]." 67 | [m] 68 | (reduce (fn [coll [k v]] (conj coll k v)) 69 | [] m)) 70 | 71 | (defn template? 72 | "Returns true if form is a valid template expression." 73 | [form] 74 | (if (seq (find-holes form)) true false)) 75 | 76 | (defn apply-template 77 | "Replaces _1, _2, _3, etc. in expr with corresponding elements of 78 | values. Returns the modified expression. For use in macros." 79 | [expr values] 80 | (when-not (template? expr) 81 | (throw (IllegalArgumentException. (str (pr-str expr) " is not a valid template.")))) 82 | (let [expr (walk/postwalk-replace {'_ '_1} expr) 83 | holes (find-holes expr) 84 | smap (zipmap holes values)] 85 | (walk/prewalk-replace smap expr))) 86 | 87 | (defmacro do-template 88 | "Repeatedly evaluates template expr (in a do block) using values in 89 | args. args are grouped by the number of holes in the template. 90 | Example: (do-template (check _1 _2) :a :b :c :d) 91 | expands to (do (check :a :b) (check :c :d))" 92 | [expr & args] 93 | (when-not (template? expr) 94 | (throw (IllegalArgumentException. (str (pr-str expr) " is not a valid template.")))) 95 | (let [expr (walk/postwalk-replace {'_ '_1} expr) 96 | argcount (count (find-holes expr))] 97 | `(do ~@(map (fn [a] (apply-template expr a)) 98 | (partition argcount args))))) 99 | 100 | 101 | 102 | ;;; REDEFINE are MACRO TO MATCH OLD TEMPLATE BEHAVIOR 103 | 104 | (defmacro are 105 | "Checks multiple assertions with a template expression. 106 | See clojure.contrib.template/do-template for an explanation of 107 | templates. 108 | 109 | Example: (are (= _1 _2) 110 | 2 (+ 1 1) 111 | 4 (* 2 2)) 112 | Expands to: 113 | (do (is (= 2 (+ 1 1))) 114 | (is (= 4 (* 2 2)))) 115 | 116 | Note: This breaks some reporting features, such as line numbers." 117 | [expr & args] 118 | `(do-template (is ~expr) ~@args)) 119 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/trace.clj: -------------------------------------------------------------------------------- 1 | ;;; trace.clj -- simple call-tracing macros for Clojure 2 | 3 | ;; by Stuart Sierra, http://stuartsierra.com/ 4 | ;; December 3, 2008 5 | 6 | ;; Copyright (c) Stuart Sierra, 2008. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | 15 | ;; This file defines simple "tracing" macros to help you see what your 16 | ;; code is doing. 17 | 18 | 19 | ;; CHANGE LOG 20 | ;; 21 | ;; December 3, 2008: 22 | ;; 23 | ;; * replaced *trace-out* with tracer 24 | ;; 25 | ;; * made trace a function instead of a macro 26 | ;; (suggestion from Stuart Halloway) 27 | ;; 28 | ;; * added trace-fn-call 29 | ;; 30 | ;; June 9, 2008: first version 31 | 32 | 33 | 34 | (ns 35 | #^{:author "Stuart Sierra, Michel Salim", 36 | :doc "This file defines simple \"tracing\" macros to help you see what your 37 | code is doing."} 38 | clojure.contrib.trace) 39 | 40 | (def 41 | #^{:doc "Current stack depth of traced function calls."} 42 | *trace-depth* 0) 43 | 44 | (defn tracer 45 | "This function is called by trace. Prints to standard output, but 46 | may be rebound to do anything you like. 'name' is optional." 47 | [name value] 48 | (println (str "TRACE" (when name (str " " name)) ": " value))) 49 | 50 | (defn trace 51 | "Sends name (optional) and value to the tracer function, then 52 | returns value. May be wrapped around any expression without 53 | affecting the result." 54 | ([value] (trace nil value)) 55 | ([name value] 56 | (tracer name (pr-str value)) 57 | value)) 58 | 59 | (defn trace-indent 60 | "Returns an indentation string based on *trace-depth*" 61 | [] 62 | (apply str (take *trace-depth* (repeat "| ")))) 63 | 64 | (defn trace-fn-call 65 | "Traces a single call to a function f with args. 'name' is the 66 | symbol name of the function." 67 | [name f args] 68 | (let [id (gensym "t")] 69 | (tracer id (str (trace-indent) (pr-str (cons name args)))) 70 | (let [value (binding [*trace-depth* (inc *trace-depth*)] 71 | (apply f args))] 72 | (tracer id (str (trace-indent) "=> " (pr-str value))) 73 | value))) 74 | 75 | (defmacro deftrace 76 | "Use in place of defn; traces each call/return of this fn, including 77 | arguments. Nested calls to deftrace'd functions will print a 78 | tree-like structure." 79 | [name & definition] 80 | `(do 81 | (def ~name) 82 | (let [f# (fn ~@definition)] 83 | (defn ~name [& args#] 84 | (trace-fn-call '~name f# args#))))) 85 | 86 | (defmacro dotrace 87 | "Given a sequence of function identifiers, evaluate the body 88 | expressions in an environment in which the identifiers are bound to 89 | the traced functions. Does not work on inlined functions, 90 | such as clojure.core/+" 91 | [fnames & exprs] 92 | `(binding [~@(interleave fnames 93 | (for [fname fnames] 94 | `(let [f# @(var ~fname)] 95 | (fn [& args#] 96 | (trace-fn-call '~fname f# args#)))))] 97 | ~@exprs)) 98 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/with_ns.clj: -------------------------------------------------------------------------------- 1 | ;;; with_ns.clj -- temporary namespace macro 2 | 3 | ;; by Stuart Sierra, http://stuartsierra.com/ 4 | ;; March 28, 2009 5 | 6 | ;; Copyright (c) Stuart Sierra, 2009. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | 15 | (ns 16 | #^{:author "Stuart Sierra", 17 | :doc "Temporary namespace macro"} 18 | clojure.contrib.with-ns) 19 | 20 | (defmacro with-ns 21 | "Evaluates body in another namespace. ns is either a namespace 22 | object or a symbol. This makes it possible to define functions in 23 | namespaces other than the current one." 24 | [ns & body] 25 | `(binding [*ns* (the-ns ~ns)] 26 | ~@(map (fn [form] `(eval '~form)) body))) 27 | 28 | (defmacro with-temp-ns 29 | "Evaluates body in an anonymous namespace, which is then immediately 30 | removed. The temporary namespace will 'refer' clojure.core." 31 | [& body] 32 | `(try 33 | (create-ns 'sym#) 34 | (let [result# (with-ns 'sym# 35 | (clojure.core/refer-clojure) 36 | ~@body)] 37 | result#) 38 | (finally (remove-ns 'sym#)))) 39 | -------------------------------------------------------------------------------- /src/main/clojure/clojure/contrib/zip_filter.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Chris Houser, April 2008. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | ; System for filtering trees and nodes generated by zip.clj in 10 | ; general, and xml trees in particular. 11 | 12 | (ns 13 | #^{:author "Chris Houser", 14 | :doc "System for filtering trees and nodes generated by zip.clj in 15 | general, and xml trees in particular. 16 | "} 17 | clojure.contrib.zip-filter 18 | (:refer-clojure :exclude (descendants ancestors)) 19 | (:require [clojure.zip :as zip])) 20 | 21 | ; This uses the negative form (no-auto) so that the result from any 22 | ; naive function, including user functions, defaults to "auto". 23 | (defn auto 24 | [v x] (with-meta x ((if v dissoc assoc) (meta x) :zip-filter/no-auto? true))) 25 | 26 | (defn auto? 27 | [x] (not (:zip-filter/no-auto? (meta x)))) 28 | 29 | (defn right-locs 30 | "Returns a lazy sequence of locations to the right of loc, starting with loc." 31 | [loc] (lazy-seq (when loc (cons (auto false loc) (right-locs (zip/right loc)))))) 32 | 33 | (defn left-locs 34 | "Returns a lazy sequence of locations to the left of loc, starting with loc." 35 | [loc] (lazy-seq (when loc (cons (auto false loc) (left-locs (zip/left loc)))))) 36 | 37 | (defn leftmost? 38 | "Returns true if there are no more nodes to the left of location loc." 39 | [loc] (nil? (zip/left loc))) 40 | 41 | (defn rightmost? 42 | "Returns true if there are no more nodes to the right of location loc." 43 | [loc] (nil? (zip/right loc))) 44 | 45 | (defn children 46 | "Returns a lazy sequence of all immediate children of location loc, 47 | left-to-right." 48 | [loc] 49 | (when (zip/branch? loc) 50 | (map #(auto false %) (right-locs (zip/down loc))))) 51 | 52 | (defn children-auto 53 | "Returns a lazy sequence of all immediate children of location loc, 54 | left-to-right, marked so that a following tag= predicate will auto-descend." 55 | #^{:private true} 56 | [loc] 57 | (when (zip/branch? loc) 58 | (map #(auto true %) (right-locs (zip/down loc))))) 59 | 60 | (defn descendants 61 | "Returns a lazy sequence of all descendants of location loc, in 62 | depth-first order, left-to-right, starting with loc." 63 | [loc] (lazy-seq (cons (auto false loc) (mapcat descendants (children loc))))) 64 | 65 | (defn ancestors 66 | "Returns a lazy sequence of all ancestors of location loc, starting 67 | with loc and proceeding to loc's parent node and on through to the 68 | root of the tree." 69 | [loc] (lazy-seq (when loc (cons (auto false loc) (ancestors (zip/up loc)))))) 70 | 71 | (defn- fixup-apply 72 | "Calls (pred loc), and then converts the result to the 'appropriate' 73 | sequence." 74 | #^{:private true} 75 | [pred loc] 76 | (let [rtn (pred loc)] 77 | (cond (and (map? (meta rtn)) (:zip-filter/is-node? (meta rtn))) (list rtn) 78 | (= rtn true) (list loc) 79 | (= rtn false) nil 80 | (nil? rtn) nil 81 | (sequential? rtn) rtn 82 | :else (list rtn)))) 83 | 84 | (defn mapcat-chain 85 | #^{:private true} 86 | [loc preds mkpred] 87 | (reduce (fn [prevseq expr] 88 | (mapcat #(fixup-apply (or (mkpred expr) expr) %) prevseq)) 89 | (list (with-meta loc (assoc (meta loc) :zip-filter/is-node? true))) 90 | preds)) 91 | 92 | ; see clojure.contrib.zip-filter.xml for examples 93 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/datalog/tests/test.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Jeffrey Straszheim. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; test.clj 10 | ;; 11 | ;; A Clojure implementation of Datalog -- Tests 12 | ;; 13 | ;; straszheimjeffrey (gmail) 14 | ;; Created 11 Feburary 2009 15 | 16 | (ns clojure.contrib.datalog.tests.test 17 | (:use [clojure.test :only (run-tests)]) 18 | (:gen-class)) 19 | 20 | (def test-names [:test-util 21 | :test-database 22 | :test-literals 23 | :test-rules 24 | :test-magic 25 | :test-softstrat]) 26 | 27 | (def test-namespaces 28 | (map #(symbol (str "clojure.contrib.datalog.tests." (name %))) 29 | test-names)) 30 | 31 | (defn run 32 | "Runs all defined tests" 33 | [] 34 | (println "Loading tests...") 35 | (apply require :reload-all test-namespaces) 36 | (apply run-tests test-namespaces)) 37 | 38 | (defn -main 39 | "Run all defined tests from the command line" 40 | [& args] 41 | (run) 42 | (System/exit 0)) 43 | 44 | 45 | ;; End of file 46 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/datalog/tests/test_magic.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Jeffrey Straszheim. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; test-magic.clj 10 | ;; 11 | ;; A Clojure implementation of Datalog -- Magic Tests 12 | ;; 13 | ;; straszheimjeffrey (gmail) 14 | ;; Created 18 Feburary 2009 15 | 16 | (ns clojure.contrib.datalog.tests.test-magic 17 | (:use clojure.test) 18 | (:use clojure.contrib.datalog.magic 19 | clojure.contrib.datalog.rules)) 20 | 21 | 22 | 23 | (def rs (rules-set 24 | (<- (:p :x ?x :y ?y) (:e :x ?x :y ?y)) 25 | (<- (:p :x ?x :y ?y) (:e :x ?x :y ?z) (:p :x ?z :y ?y)) 26 | (<- (:e :x ?x :y ?y) (:b :x ?x :y ?y)) 27 | (<- (:e :x ?y :y ?y) (:c :x ?x :y ?y)))) 28 | 29 | (def q (adorn-query (?- :p :x 1 :y ?y))) 30 | 31 | (def ars (adorn-rules-set rs q)) 32 | 33 | (deftest test-adorn-rules-set 34 | (is (= ars 35 | (rules-set 36 | (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?y :x ?x)) 37 | (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :e :bound #{:x}} :y ?z :x ?x) 38 | ({:pred :p :bound #{:x}} :y ?y :x ?z)) 39 | (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) (:c :y ?y :x ?x)) 40 | (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) (:b :y ?y :x ?x)))))) 41 | 42 | 43 | (def m (magic-transform ars)) 44 | 45 | (deftest test-magic-transform 46 | (is (= m 47 | (rules-set 48 | (<- ({:pred :e :bound #{:x}} :y ?y :x ?y) ({:pred :e :magic true :bound #{:x}} :x ?y) (:c :y ?y :x ?x)) 49 | 50 | (<- ({:pred :e :bound #{:x}} :y ?y :x ?x) ({:pred :e :magic true :bound #{:x}} :x ?x) (:b :y ?y :x ?x)) 51 | 52 | (<- ({:pred :p :magic true :bound #{:x}} :x ?z) ({:pred :p :magic true :bound #{:x}} :x ?x) 53 | ({:pred :e :bound #{:x}} :y ?z :x ?x)) 54 | 55 | (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) 56 | ({:pred :e :bound #{:x}} :y ?z :x ?x) 57 | ({:pred :p :bound #{:x}} :y ?y :x ?z)) 58 | 59 | (<- ({:pred :e :magic true :bound #{:x}} :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x)) 60 | 61 | (<- ({:pred :p :bound #{:x}} :y ?y :x ?x) ({:pred :p :magic true :bound #{:x}} :x ?x) 62 | ({:pred :e :bound #{:x}} :y ?y :x ?x)))))) 63 | 64 | 65 | 66 | 67 | (comment 68 | (run-tests) 69 | ) 70 | 71 | ;; End of file 72 | 73 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/datalog/tests/test_util.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Jeffrey Straszheim. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; test-util.clj 10 | ;; 11 | ;; A Clojure implementation of Datalog -- Utilities Tests 12 | ;; 13 | ;; straszheimjeffrey (gmail) 14 | ;; Created 11 Feburary 2009 15 | 16 | (ns clojure.contrib.datalog.tests.test-util 17 | (:use clojure.test 18 | clojure.contrib.datalog.util) 19 | (:use [clojure.contrib.except :only (throwf)])) 20 | 21 | (deftest test-is-var? 22 | (is (is-var? '?x)) 23 | (is (is-var? '?)) 24 | (is (not (is-var? '??x))) 25 | (is (not (is-var? '??))) 26 | (is (not (is-var? 'x))) 27 | (is (not (is-var? "fred"))) 28 | (is (not (is-var? :q)))) 29 | 30 | (deftest test-map-values 31 | (let [map {:fred 1 :sally 2}] 32 | (is (= (map-values #(* 2 %) map) {:fred 2 :sally 4})) 33 | (is (= (map-values identity {}) {})))) 34 | 35 | (deftest test-keys-to-vals 36 | (let [map {:fred 1 :sally 2 :joey 3}] 37 | (is (= (set (keys-to-vals map [:fred :sally])) #{1 2})) 38 | (is (= (set (keys-to-vals map [:fred :sally :becky])) #{1 2})) 39 | (is (empty? (keys-to-vals map []))) 40 | (is (empty? (keys-to-vals {} [:fred]))))) 41 | 42 | (deftest test-reverse-map 43 | (let [map {:fred 1 :sally 2 :joey 3} 44 | map-1 (assoc map :mary 3)] 45 | (is (= (reverse-map map) {1 :fred 2 :sally 3 :joey})) 46 | (is (or (= (reverse-map map-1) {1 :fred 2 :sally 3 :joey}) 47 | (= (reverse-map map-1) {1 :fred 2 :sally 3 :mary}))))) 48 | 49 | (def some-maps 50 | [ 51 | { :a 1 :b 2 } 52 | { :c 3 :b 3 } 53 | { :d 4 :a 1 } 54 | { :g 4 :b 4 } 55 | { :a 2 :b 1 } 56 | { :e 1 :f 1 } 57 | ]) 58 | 59 | (def reduced (preduce + some-maps)) 60 | (def merged (apply merge-with + some-maps)) 61 | 62 | (deftest test-preduce 63 | (is (= reduced merged))) 64 | 65 | (comment 66 | (run-tests) 67 | ) 68 | 69 | ; End of file 70 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/mock/test_adapter.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.test-contrib.mock-test.test-adapter-test 2 | (:use clojure.contrib.mock.test-adapter 3 | [clojure.contrib.test-contrib.mock-test :only (assert-called)] 4 | clojure.test)) 5 | 6 | (deftest test-report-problem-called 7 | (def #^{:private true :dynamic true} fn1 (fn [x] "dummy code")) 8 | (def #^{:private true :dynamic true} fn2 (fn [x y] "dummy code2")) 9 | (let [under-test (fn [x] (fn1 x))] 10 | (assert-called clojure.contrib.mock.test-adapter/report-problem 11 | true (expect [fn1 (times 5)] (under-test "hi"))))) 12 | 13 | (deftest test-is-report-called 14 | (assert-called clojure.test/report true 15 | (clojure.contrib.mock.test-adapter/report-problem 16 | 'fn-name 5 6 "fake problem"))) 17 | 18 | 19 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/pprint/test_helper.clj: -------------------------------------------------------------------------------- 1 | ;;; helper.clj -- part of the pretty printer for Clojure 2 | 3 | ;; by Tom Faulhaber 4 | ;; April 3, 2009 5 | 6 | ; Copyright (c) Tom Faulhaber, April 2009. All rights reserved. 7 | ; The use and distribution terms for this software are covered by the 8 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ; which can be found in the file epl-v10.html at the root of this distribution. 10 | ; By using this software in any fashion, you are agreeing to be bound by 11 | ; the terms of this license. 12 | ; You must not remove this notice, or any other, from this software. 13 | 14 | ;; This is just a macro to make my tests a little cleaner 15 | 16 | (ns clojure.contrib.pprint.test-helper 17 | (:use [clojure.test :only (deftest are run-tests)])) 18 | 19 | (defmacro simple-tests [name & test-pairs] 20 | `(deftest ~name (are [x y] (= x y) ~@test-pairs))) 21 | 22 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_core.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Laurent Petit, March 2009. All rights reserved. 2 | 3 | ; The use and distribution terms for this software are covered by the 4 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 5 | ; which can be found in the file epl-v10.html at the root of this 6 | ; distribution. 7 | ; By using this software in any fashion, you are agreeing to be bound by 8 | ; the terms of this license. 9 | ; You must not remove this notice, or any other, from this software. 10 | 11 | ;; test namespace for clojure.contrib.core 12 | 13 | ;; note to other contrib members: feel free to add to this lib 14 | 15 | (ns clojure.contrib.test-core 16 | (:use clojure.test) 17 | (:use clojure.contrib.core)) 18 | 19 | (deftest test-classic-versions 20 | (testing "Classic -> throws NPE if passed nil" 21 | (is (thrown? NullPointerException (-> nil .toString))) 22 | (is (thrown? NullPointerException (-> "foo" seq next next next .toString)))) 23 | (testing "Classic .. throws NPE if one of the intermediate threaded values is nil" 24 | (is (thrown? NullPointerException (.. nil toString))) 25 | (is (thrown? NullPointerException (.. [nil] (get 0) toString))))) 26 | 27 | (deftest test-new-versions 28 | (testing "Version -?>> falls out on nil" 29 | (is (nil? (-?>> nil .toString))) 30 | (is (nil? (-?>> [] seq (map inc)))) 31 | (is (= [] (->> [] seq (map inc))))) 32 | (testing "Version -?>> completes for non-nil" 33 | (is (= [3 4] (-?>> [1 2] (map inc) (map inc))))) 34 | (testing "Version -?> falls out on nil" 35 | (is (nil? (-?> nil .toString))) 36 | (is (nil? (-?> "foo" seq next next next .toString)))) 37 | (testing "Version -?> completes for non-nil" 38 | (is (= [\O \O] (-?> "foo" .toUpperCase rest)))) 39 | (testing "Version .?. returns nil if one of the intermediate threaded values is nil" 40 | (is (nil? (.?. nil toString))) 41 | (is (nil? (.?. [nil] (get 0) toString))))) 42 | 43 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_dataflow.clj: -------------------------------------------------------------------------------- 1 | ;; Copyright (c) Jeffrey Straszheim. 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 4 | ;; be found in the file epl-v10.html at the root of this distribution. By 5 | ;; using this software in any fashion, you are agreeing to be bound by the 6 | ;; terms of this license. You must not remove this notice, or any other, 7 | ;; from this software. 8 | ;; 9 | ;; test-dataflow 10 | ;; 11 | ;; A Library to Support a Dataflow Model of State - Tests 12 | ;; 13 | ;; straszheimjeffrey (gmail) 14 | ;; Created 11 March 2009 15 | 16 | 17 | (ns clojure.contrib.test-dataflow 18 | (:use clojure.test) 19 | (:use clojure.contrib.dataflow)) 20 | 21 | (def df-1 22 | (build-dataflow 23 | [(cell :source base 0) 24 | (cell :source items ()) 25 | (cell product (* ?base (apply + ?items))) 26 | (cell :validator (when (number? ?-product) 27 | (assert (>= ?product ?-product))))])) 28 | 29 | (deftest test-df-1 30 | (is (= (get-value df-1 'product) 0)) 31 | (is (do (update-values df-1 {'items [4 5]}) 32 | (= (get-value df-1 'product) 0))) 33 | (is (do (update-values df-1 {'base 2}) 34 | (= (get-value df-1 'product) 18))) 35 | (is (thrown? AssertionError (update-values df-1 {'base 0}))) 36 | (is (= (get-value df-1 'product) 18))) 37 | 38 | (def df-2 39 | (build-dataflow 40 | [(cell :source strength 10) 41 | (cell :source agility 10) 42 | (cell :source magic 10) 43 | 44 | (cell total-cost (apply + ?*cost)) 45 | 46 | (cell cost (- ?strength 10)) 47 | (cell cost (- ?agility 10)) 48 | (cell cost (- ?magic 10)) 49 | 50 | (cell combat (+ ?strength ?agility ?combat-mod)) 51 | (cell speed (+ ?agility (/ ?strength 10.0) ?speed-mod)) 52 | (cell casting (+ ?agility ?magic ?magic-mod)) 53 | 54 | (cell combat-mod (apply + ?*combat-mods)) 55 | (cell speed-mod (apply + ?*speed-mods)) 56 | (cell magic-mod (apply + ?*magic-mods))])) 57 | 58 | (def magic-skill 59 | [(cell cost 5) 60 | (cell speed-mods 1) 61 | (cell magic-mods 2)]) 62 | 63 | (defn gv [n] (get-value df-2 n)) 64 | 65 | (deftest test-df-2 66 | (is (and (= (gv 'total-cost) 0) 67 | (= (gv 'strength) 10) 68 | (= (gv 'casting) 20))) 69 | (is (do (update-values df-2 {'magic 12}) 70 | (and (= (gv 'total-cost) 2) 71 | (= (gv 'casting) 22)))) 72 | (is (do (add-cells df-2 magic-skill) 73 | (and (= (gv 'total-cost) 7) 74 | (= (gv 'casting) 24)))) 75 | (is (do (remove-cells df-2 magic-skill) 76 | (and (= (gv 'total-cost) 2) 77 | (= (gv 'casting) 22))))) 78 | 79 | 80 | (comment 81 | (run-tests) 82 | 83 | (use :reload 'clojure.contrib.dataflow) 84 | (use 'clojure.contrib.stacktrace) (e) 85 | (use 'clojure.contrib.trace) 86 | 87 | ) 88 | 89 | 90 | ;; End of file 91 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_def.clj: -------------------------------------------------------------------------------- 1 | ;; Tests for def.clj 2 | 3 | ;; by Stuart Halloway 4 | 5 | ;; Copyright (c) Stuart Halloway, 2009. All rights reserved. The use 6 | ;; and distribution terms for this software are covered by the Eclipse 7 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 8 | ;; which can be found in the file epl-v10.html at the root of this 9 | ;; distribution. By using this software in any fashion, you are 10 | ;; agreeing to be bound by the terms of this license. You must not 11 | ;; remove this notice, or any other, from this software. 12 | 13 | (ns clojure.contrib.test-def 14 | (:use clojure.test) 15 | (:require [clojure.contrib.def :as d])) 16 | 17 | (defn sample-fn "sample-fn docstring" []) 18 | (d/defalias aliased-fn sample-fn) 19 | (defmacro sample-macro "sample-macro-docstring" []) 20 | (d/defalias aliased-macro sample-macro) 21 | 22 | (deftest defalias-preserves-metadata 23 | (let [preserved-meta #(-> % (meta) (select-keys [:doc :arglists :ns :file :macro]))] 24 | (are [x y] (= (preserved-meta (var x)) (preserved-meta (var y))) 25 | aliased-fn sample-fn 26 | aliased-macro sample-macro))) 27 | 28 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_fnmap.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.test-fnmap 2 | (:use clojure.contrib.fnmap 3 | clojure.test)) 4 | 5 | (deftest acts-like-map 6 | (let [m1 (fnmap get assoc :key1 1 :key2 2)] 7 | (are [k v] (= v (get m1 k)) 8 | :key1 1 9 | :key2 2 10 | :nonexistent-key nil) 11 | (are [k v] (= v (k m1)) 12 | :key1 1 13 | :key2 2 14 | :nonexistent-key nil) 15 | (let [m2 (assoc m1 :key3 3 :key4 4)] 16 | (are [k v] (= v (get m2 k)) 17 | :key1 1 18 | :key2 2 19 | :key3 3 20 | :key4 4 21 | :nonexistent-key nil)))) 22 | 23 | (defn assoc-validate [m key value] 24 | (if (integer? value) 25 | (assoc m key value) 26 | (throw (Exception. "Only integers allowed in this map!")))) 27 | 28 | (deftest validators 29 | (let [m (fnmap get assoc-validate)] 30 | (is (= 2 (:key2 (assoc m :key2 2)))) 31 | (is (thrown? Exception (assoc m :key3 3.14))))) 32 | 33 | (defn get-transform [m key] 34 | (when-let [value (m key)] 35 | (- value))) 36 | 37 | (deftest transforms 38 | (let [m (fnmap get-transform assoc)] 39 | (is (= -2 (:key2 (assoc m :key2 2)))))) 40 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_greatest_least.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.test-greatest-least 2 | (:use clojure.contrib.greatest-least 3 | [clojure.test :only (is deftest run-tests)])) 4 | 5 | (deftest test-greatest 6 | (is (nil? (greatest)) "greatest with no arguments is nil") 7 | (is (= 1 (greatest 1))) 8 | (is (= 2 (greatest 1 2))) 9 | (is (= 2 (greatest 2 1))) 10 | (is (= "b" (greatest "aa" "b")))) 11 | 12 | (deftest test-greatest-by 13 | (is (nil? (greatest-by identity)) "greatest-by with no arguments is nil") 14 | (is (= "" (greatest-by count ""))) 15 | (is (= "a" (greatest-by count "a" ""))) 16 | (is (= "a" (greatest-by count "" "a"))) 17 | (is (= "aa" (greatest-by count "aa" "b")))) 18 | 19 | (deftest test-least 20 | (is (nil? (least)) "least with no arguments is nil") 21 | (is (= 1 (least 1))) 22 | (is (= 1 (least 1 2))) 23 | (is (= 1 (least 2 1))) 24 | (is (= "aa" (least "aa" "b")))) 25 | 26 | (deftest test-least-by 27 | (is (nil? (least-by identity)) "least-by with no arguments is nil") 28 | (is (= "" (least-by count ""))) 29 | (is (= "" (least-by count "a" ""))) 30 | (is (= "" (least-by count "" "a"))) 31 | (is (= "b" (least-by count "aa" "b")))) 32 | 33 | (deftest test-all-greatest 34 | (is (nil? (all-greatest)) "all-greatest with no arguments is nil") 35 | (is (= (list 1) (all-greatest 1))) 36 | (is (= (list 1 1) (all-greatest 1 1))) 37 | (is (= (list 2) (all-greatest 2 1 1))) 38 | (is (= (list 2) (all-greatest 1 2 1))) 39 | (is (= (list 2) (all-greatest 1 1 2))) 40 | (is (= (list :c) (all-greatest :b :c :a)))) 41 | 42 | (deftest test-all-greatest-by 43 | (is (nil? (all-greatest-by identity)) "all-greatest-by with no arguments is nil") 44 | (is (= (list "a")) (all-greatest-by count "a")) 45 | (is (= (list "a" "a")) (all-greatest-by count "a" "a")) 46 | (is (= (list "aa")) (all-greatest-by count "aa" "b")) 47 | (is (= (list "aa")) (all-greatest-by count "b" "aa" "c")) 48 | (is (= (list "cc" "aa")) (all-greatest-by count "aa" "b" "cc"))) 49 | 50 | (deftest test-all-least 51 | (is (nil? (all-least)) "all-least with no arguments is nil") 52 | (is (= (list 1) (all-least 1))) 53 | (is (= (list 1 1) (all-least 1 1))) 54 | (is (= (list 1 1) (all-least 2 1 1))) 55 | (is (= (list 1 1) (all-least 1 2 1))) 56 | (is (= (list 1 1) (all-least 1 1 2))) 57 | (is (= (list :a) (all-least :b :c :a)))) 58 | 59 | (deftest test-all-least-by 60 | (is (nil? (all-least-by identity)) "all-least-by with no arguments is nil") 61 | (is (= (list "a")) (all-least-by count "a")) 62 | (is (= (list "a" "a")) (all-least-by count "a" "a")) 63 | (is (= (list "b")) (all-least-by count "aa" "b")) 64 | (is (= (list "c" "b")) (all-least-by count "b" "aa" "c")) 65 | (is (= (list "b")) (all-least-by count "aa" "b" "cc"))) 66 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_io.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.test-io 2 | (:refer-clojure :exclude (spit)) 3 | (:use clojure.test clojure.contrib.io) 4 | (:import (java.io File FileInputStream BufferedInputStream) 5 | (java.net URL URI))) 6 | 7 | (deftest file-str-backslash 8 | (is (= (java.io.File. 9 | (str "C:" java.io.File/separator 10 | "Documents" java.io.File/separator 11 | "file.txt")) 12 | (file-str "C:\\Documents\\file.txt")))) 13 | 14 | (deftest test-as-file 15 | (testing "strings" 16 | (is (= (File. "foo") (as-file "foo")))) 17 | (testing "Files" 18 | (is (= (File. "bar") (as-file (File. "bar")))))) 19 | 20 | (deftest test-as-url 21 | (are [result expr] (= result expr) 22 | (URL. "http://foo") (as-url (URL. "http://foo")) 23 | (URL. "http://foo") (as-url "http://foo") 24 | (URL. "http://foo") (as-url (URI. "http://foo")) 25 | (URL. "file:/foo") (as-url (File. "/foo")))) 26 | 27 | (deftest test-delete-file 28 | (let [file (File/createTempFile "test" "deletion") 29 | not-file (File. (str (java.util.UUID/randomUUID)))] 30 | (delete-file (.getAbsolutePath file)) 31 | (is (not (.exists file))) 32 | (is (thrown? ArithmeticException (/ 1 0))) 33 | (is (thrown? java.io.IOException (delete-file not-file))) 34 | (is (delete-file not-file :silently)))) 35 | 36 | (deftest test-relative-path-string 37 | (testing "strings" 38 | (is (= "foo" (relative-path-string "foo")))) 39 | (testing "absolute path strings are forbidden" 40 | (is (thrown? IllegalArgumentException (relative-path-string (str File/separator "baz"))))) 41 | (testing "relative File paths" 42 | (is (= "bar" (relative-path-string (File. "bar"))))) 43 | (testing "absolute File paths are forbidden" 44 | (is (thrown? IllegalArgumentException (relative-path-string (File. (str File/separator "quux"))))))) 45 | 46 | (defn stream-should-have [stream expected-bytes msg] 47 | (let [actual-bytes (byte-array (alength expected-bytes))] 48 | (.read stream actual-bytes) 49 | (is (= -1 (.read stream)) (str msg " : should be end of stream")) 50 | (is (= (seq expected-bytes) (seq actual-bytes)) (str msg " : byte arrays should match")))) 51 | 52 | (deftest test-input-stream 53 | (let [file (File/createTempFile "test-input-stream" "txt") 54 | bytes (.getBytes "foobar")] 55 | (spit file "foobar") 56 | (doseq [[expr msg] 57 | [[file File] 58 | [(FileInputStream. file) FileInputStream] 59 | [(BufferedInputStream. (FileInputStream. file)) BufferedInputStream] 60 | [(.. file toURI) URI] 61 | [(.. file toURI toURL) URL] 62 | [(.. file toURI toURL toString) "URL as String"] 63 | [(.. file toString) "File as String"]]] 64 | (with-open [s (input-stream expr)] 65 | (stream-should-have s bytes msg))))) 66 | 67 | (deftest test-streams-buffering 68 | (let [data (.getBytes "")] 69 | (is (instance? java.io.BufferedReader (reader data))) 70 | (is (instance? java.io.BufferedWriter (writer (java.io.ByteArrayOutputStream.)))) 71 | (is (instance? java.io.BufferedInputStream (input-stream data))) 72 | (is (instance? java.io.BufferedOutputStream (output-stream (java.io.ByteArrayOutputStream.)))))) 73 | 74 | (deftest test-streams-defaults 75 | (let [f (File/createTempFile "clojure.contrib" "test-reader-writer") 76 | content "test\u2099ing"] 77 | (try 78 | (is (thrown? Exception (reader (Object.)))) 79 | (is (thrown? Exception (writer (Object.)))) 80 | 81 | (are [write-to read-from] (= content (do 82 | (spit write-to content) 83 | (slurp* (or read-from write-to)))) 84 | f nil 85 | (.getAbsolutePath f) nil 86 | (.toURL f) nil 87 | (.toURI f) nil 88 | (java.io.FileOutputStream. f) f 89 | (java.io.OutputStreamWriter. (java.io.FileOutputStream. f) "UTF-8") f 90 | f (java.io.FileInputStream. f) 91 | f (java.io.InputStreamReader. (java.io.FileInputStream. f) "UTF-8")) 92 | 93 | (is (= content (slurp* (.getBytes content "UTF-8")))) 94 | (is (= content (slurp* (.toCharArray content)))) 95 | (finally 96 | (.delete f))))) 97 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_lazy_seqs.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.test-lazy-seqs 2 | (:use clojure.test 3 | clojure.contrib.lazy-seqs)) 4 | 5 | (deftest test-fibs 6 | (is (= [0 1 1 2 3 5 8 13 21 34 55 89 144 233 377 610 987 1597 2584 4181 6765 10946 7 | 17711 28657 46368 75025 121393 196418 317811 514229 832040 1346269 2178309 8 | 3524578 5702887 9227465 14930352 24157817 39088169 63245986 102334155 9 | 165580141 267914296 433494437 701408733 1134903170 1836311903 2971215073 10 | 4807526976 7778742049] 11 | (take 50 (fibs))))) 12 | 13 | (deftest test-powers-of-2 14 | (is (= [1 2 4 8 16 32 64 128 256 512] 15 | (take 10 (powers-of-2))))) 16 | 17 | (deftest test-primes 18 | (is (= [2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 19 | 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 20 | 199 211 223 227 229] 21 | (take 50 primes)))) 22 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_load_all.clj: -------------------------------------------------------------------------------- 1 | ;;; test_load_all.clj - loads all contrib libraries for testing purposes 2 | 3 | ;; by Stuart Halloway, http://blog.thinkrelevance.com 4 | 5 | ;; Copyright (c) Stuart Halloway, 2009. All rights reserved. The use 6 | ;; and distribution terms for this software are covered by the Eclipse 7 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 8 | ;; which can be found in the file epl-v10.html at the root of this 9 | ;; distribution. By using this software in any fashion, you are 10 | ;; agreeing to be bound by the terms of this license. You must not 11 | ;; remove this notice, or any other, from this software. 12 | 13 | ;; This is only intended to check that the libraries will load without 14 | ;; errors, not that they work correctly. 15 | 16 | ;; The code includes several design choices I don't love, but find 17 | ;; tolerable in a test-only lib: 18 | ;; 19 | ;; * namespaces that blow up to document deprecation 20 | ;; * using directory paths to find contrib 21 | ;; * using a macro to reflectively write tests 22 | ;; 23 | ;; I *am* happy that code that won't even load now breaks the build. 24 | 25 | (ns clojure.contrib.test-load-all 26 | (:use clojure.test clojure.contrib.find-namespaces)) 27 | 28 | (def deprecated-contrib-namespaces 29 | '[clojure.contrib.javadoc]) 30 | 31 | (defn loadable-contrib-namespaces 32 | "Contrib namespaces that can be loaded (everything except 33 | deprecated nses that throw on load.)" 34 | [] 35 | (apply disj 36 | (into #{} (find-namespaces-in-dir (java.io.File. "src/main"))) 37 | deprecated-contrib-namespaces)) 38 | 39 | (defn emit-test-load 40 | [] 41 | `(do 42 | ~@(map 43 | (fn [ns] 44 | `(deftest ~(symbol (str "test-loading-" (.replace (str ns) "." "-"))) 45 | (require :reload '~ns))) 46 | (loadable-contrib-namespaces)))) 47 | 48 | (defmacro test-load 49 | [] 50 | (emit-test-load)) 51 | 52 | (test-load) 53 | 54 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_macro_utils.clj: -------------------------------------------------------------------------------- 1 | ;; Test routines for macro_utils.clj 2 | 3 | ;; by Konrad Hinsen 4 | ;; last updated May 6, 2009 5 | 6 | ;; Copyright (c) Konrad Hinsen, 2008. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | (ns clojure.contrib.test-macro-utils 15 | (:use [clojure.test :only (deftest is are run-tests use-fixtures)] 16 | [clojure.contrib.macro-utils 17 | :only (macrolet symbol-macrolet defsymbolmacro with-symbol-macros 18 | mexpand-1 mexpand mexpand-all)] 19 | [clojure.contrib.monads 20 | :only (with-monad domonad)])) 21 | 22 | (use-fixtures :each 23 | (fn [f] (binding [*ns* (the-ns 'clojure.contrib.test-macro-utils)] 24 | (f)))) 25 | 26 | (deftest macrolet-test 27 | (is (= (macroexpand-1 28 | '(macrolet [(foo [form] `(~form ~form))] (foo x))) 29 | '(do (x x))))) 30 | 31 | (deftest symbol-macrolet-test 32 | (is (= (macroexpand-1 33 | '(symbol-macrolet [x xx y yy] 34 | (exp [a y] (x y)))) 35 | '(do (exp [a yy] (xx yy))))) 36 | (is (= (macroexpand-1 37 | '(symbol-macrolet [def foo] 38 | (def def def))) 39 | '(do (def def foo)))) 40 | (is (= (macroexpand-1 41 | '(symbol-macrolet [x foo z bar] 42 | (let [a x b y x b] [a b x z]))) 43 | '(do (let* [a foo b y x b] [a b x bar])))) 44 | (is (= (macroexpand-1 45 | '(symbol-macrolet [x foo z bar] 46 | (fn ([x y] [x y z]) ([x y z] [x y z])))) 47 | '(do (fn* ([x y] [x y bar]) ([x y z] [x y z]))))) 48 | (is (= (macroexpand-1 49 | '(symbol-macrolet [x foo z bar] 50 | (fn f ([x y] [x y z]) ([x y z] [x y z])))) 51 | '(do (fn* f ([x y] [x y bar]) ([x y z] [x y z]))))) 52 | (is (= (nth (second (macroexpand-1 53 | '(symbol-macrolet [x xx y yy z zz] 54 | (domonad m [a x b y x z] [a b x z])))) 2) 55 | '(do (m-bind xx (fn* ([a] 56 | (m-bind yy (fn* ([b] 57 | (m-bind zz (fn* ([x] 58 | (m-result [a b x zz])))))))))))))) 59 | 60 | (deftest symbol-test 61 | (defsymbolmacro sum-2-3 (plus 2 3)) 62 | (is (= (macroexpand '(with-symbol-macros (+ 1 sum-2-3))) 63 | '(do (+ 1 (plus 2 3))))) 64 | (is (= (macroexpand '(macrolet [(plus [a b] `(+ ~a ~b))] (+ 1 sum-2-3))) 65 | '(do (+ 1 (clojure.core/+ 2 3))))) 66 | (ns-unmap *ns* 'sum-2-3)) 67 | 68 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_math.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.test-math 2 | (:use clojure.test 3 | clojure.contrib.math)) 4 | 5 | (deftest test-expt 6 | (are [x y] (= x y) 7 | (expt 2 3) 8 8 | (expt (expt 2 16) 2) (expt 2 32) 9 | (expt 4/3 2) 16/9 10 | (expt 2 -10) 1/1024 11 | (expt 0.5M 2) 0.25M 12 | (expt 5 4.2) (Math/pow 5 4.2) 13 | (expt 5.3 4) (Math/pow 5.3 4))) 14 | 15 | (deftest test-abs 16 | (are [x y] (= x y) 17 | (abs -2) 2 18 | (abs 0) 0 19 | (abs 5) 5 20 | (abs 123456789123456789) 123456789123456789 21 | (abs -123456789123456789) 123456789123456789 22 | (abs 5/3) 5/3 23 | (abs -4/3) 4/3 24 | (abs 4.3M) 4.3M 25 | (abs -4.3M) 4.3M 26 | (abs 2.8) 2.8 27 | (abs -2.8) 2.8)) 28 | 29 | (deftest test-gcd 30 | (are [x y] (= x y) 31 | (gcd 4 3) 1 32 | (gcd 24 12) 12 33 | (gcd 24 27) 3 34 | (gcd 1 0) 1 35 | (gcd 0 1) 1 36 | (gcd 0 0) 0) 37 | (is (thrown? IllegalArgumentException (gcd nil 0))) 38 | (is (thrown? IllegalArgumentException (gcd 0 nil))) 39 | (is (thrown? IllegalArgumentException (gcd 7.0 0)))) 40 | 41 | (deftest test-lcm 42 | (are [x y] (= x y) 43 | (lcm 2 3) 6 44 | (lcm 3 2) 6 45 | (lcm -2 3) 6 46 | (lcm 2 -3) 6 47 | (lcm -2 -3) 6 48 | (lcm 4 10) 20 49 | (lcm 1 0) 0 50 | (lcm 0 1) 0 51 | (lcm 0 0)) 52 | (is (thrown? IllegalArgumentException (lcm nil 0))) 53 | (is (thrown? IllegalArgumentException (lcm 0 nil))) 54 | (is (thrown? IllegalArgumentException (lcm 7.0 0)))) 55 | 56 | (deftest test-floor 57 | (are [x y] (== x y) 58 | (floor 6) 6 59 | (floor -6) -6 60 | (floor 123456789123456789) 123456789123456789 61 | (floor -123456789123456789) -123456789123456789 62 | (floor 4/3) 1 63 | (floor -4/3) -2 64 | (floor 4.3M) 4 65 | (floor -4.3M) -5 66 | (floor 4.3) 4.0 67 | (floor -4.3) -5.0)) 68 | 69 | (deftest test-ceil 70 | (are [x y] (== x y) 71 | (ceil 6) 6 72 | (ceil -6) -6 73 | (ceil 123456789123456789) 123456789123456789 74 | (ceil -123456789123456789) -123456789123456789 75 | (ceil 4/3) 2 76 | (ceil -4/3) -1 77 | (ceil 4.3M) 5 78 | (ceil -4.3M) -4 79 | (ceil 4.3) 5.0 80 | (ceil -4.3) -4.0)) 81 | 82 | (deftest test-round 83 | (are [x y] (== x y) 84 | (round 6) 6 85 | (round -6) -6 86 | (round 123456789123456789) 123456789123456789 87 | (round -123456789123456789) -123456789123456789 88 | (round 4/3) 1 89 | (round 5/3) 2 90 | (round 5/2) 3 91 | (round -4/3) -1 92 | (round -5/3) -2 93 | (round -5/2) -2 94 | (round 4.3M) 4 95 | (round 4.7M) 5 96 | (round -4.3M) -4 97 | (round -4.7M) -5 98 | (round 4.5M) 5 99 | (round -4.5M) -4 100 | (round 4.3) 4 101 | (round 4.7) 5 102 | (round -4.3) -4 103 | (round -4.7) -5 104 | (round 4.5) 5 105 | (round -4.5) -4)) 106 | 107 | (deftest test-sqrt 108 | (are [x y] (= x y) 109 | (sqrt 9) 3 110 | (sqrt 16/9) 4/3 111 | (sqrt 0.25M) 0.5M 112 | (sqrt 2) (Math/sqrt 2))) 113 | 114 | (deftest test-exact-integer-sqrt 115 | (are [x y] (= x y) 116 | (exact-integer-sqrt 15) [3 6] 117 | (exact-integer-sqrt (inc (expt 2 32))) [(expt 2 16) 1] 118 | (exact-integer-sqrt 1000000000000) [1000000 0])) 119 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_monads.clj: -------------------------------------------------------------------------------- 1 | ;; Test routines for monads.clj 2 | 3 | ;; by Konrad Hinsen 4 | ;; last updated March 28, 2009 5 | 6 | ;; Copyright (c) Konrad Hinsen, 2008. All rights reserved. The use 7 | ;; and distribution terms for this software are covered by the Eclipse 8 | ;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 9 | ;; which can be found in the file epl-v10.html at the root of this 10 | ;; distribution. By using this software in any fashion, you are 11 | ;; agreeing to be bound by the terms of this license. You must not 12 | ;; remove this notice, or any other, from this software. 13 | 14 | (ns clojure.contrib.test-monads 15 | (:use [clojure.test :only (deftest is are run-tests)] 16 | [clojure.contrib.monads 17 | :only (with-monad domonad m-lift m-seq m-chain 18 | sequence-m maybe-m state-m maybe-t sequence-t)])) 19 | 20 | (deftest sequence-monad 21 | (with-monad sequence-m 22 | (are [a b] (= a b) 23 | (domonad [x (range 3) y (range 2)] (+ x y)) 24 | '(0 1 1 2 2 3) 25 | (domonad [x (range 5) y (range (+ 1 x)) :when (= (+ x y) 2)] (list x y)) 26 | '((1 1) (2 0)) 27 | ((m-lift 2 #(list %1 %2)) (range 3) (range 2)) 28 | '((0 0) (0 1) (1 0) (1 1) (2 0) (2 1)) 29 | (m-seq (replicate 3 (range 2))) 30 | '((0 0 0) (0 0 1) (0 1 0) (0 1 1) (1 0 0) (1 0 1) (1 1 0) (1 1 1)) 31 | ((m-chain (replicate 3 range)) 5) 32 | '(0 0 0 1 0 0 1 0 1 2) 33 | (m-plus (range 3) (range 2)) 34 | '(0 1 2 0 1)))) 35 | 36 | (deftest maybe-monad 37 | (with-monad maybe-m 38 | (let [m+ (m-lift 2 +) 39 | mdiv (fn [x y] (domonad [a x b y :when (not (zero? b))] (/ a b)))] 40 | (are [a b] (= a b) 41 | (m+ (m-result 1) (m-result 3)) 42 | (m-result 4) 43 | (mdiv (m-result 1) (m-result 3)) 44 | (m-result (/ 1 3)) 45 | (m+ 1 (mdiv (m-result 1) (m-result 0))) 46 | m-zero 47 | (m-plus m-zero (m-result 1) m-zero (m-result 2)) 48 | (m-result 1))))) 49 | 50 | (deftest seq-maybe-monad 51 | (with-monad (maybe-t sequence-m) 52 | (letfn [(pairs [xs] ((m-lift 2 #(list %1 %2)) xs xs))] 53 | (are [a b] (= a b) 54 | ((m-lift 1 inc) (for [n (range 10)] (when (odd? n) n))) 55 | '(nil 2 nil 4 nil 6 nil 8 nil 10) 56 | (pairs (for [n (range 5)] (when (odd? n) n))) 57 | '(nil nil (1 1) nil (1 3) nil nil nil (3 1) nil (3 3) nil nil))))) 58 | 59 | (deftest state-maybe-monad 60 | (with-monad (maybe-t state-m) 61 | (is (= (for [[a b c d] (list [1 2 3 4] [nil 2 3 4] [ 1 nil 3 4] 62 | [nil nil 3 4] [1 2 nil nil])] 63 | (let [f (domonad 64 | [x (m-plus (m-result a) (m-result b)) 65 | y (m-plus (m-result c) (m-result d))] 66 | (+ x y))] 67 | (f :state))) 68 | (list [4 :state] [5 :state] [4 :state] [nil :state] [nil :state]))))) 69 | 70 | (deftest state-seq-monad 71 | (with-monad (sequence-t state-m) 72 | (is (= (let [[a b c d] [1 2 10 20] 73 | f (domonad 74 | [x (m-plus (m-result a) (m-result b)) 75 | y (m-plus (m-result c) (m-result d))] 76 | (+ x y))] 77 | (f :state))) 78 | (list [(list 11 21 12 22) :state])))) 79 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_profile.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.test-profile 2 | (:use clojure.test 3 | clojure.contrib.profile)) 4 | 5 | (deftest test-print-summary 6 | (testing "doesn't blow up with no data (assembla #31)" 7 | (is (= "Name mean min max count sum\n" 8 | (with-out-str (print-summary {})))))) 9 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_properties.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.test-properties 2 | (:refer-clojure :exclude (spit)) 3 | (:use clojure.test clojure.contrib.properties 4 | [clojure.contrib.io :only (spit)]) 5 | (:import (java.util Properties) 6 | (java.io File))) 7 | 8 | (deftest test-get-system-property 9 | (testing "works the same with keywords, symbols, and strings" 10 | (is (= (get-system-property "java.home") (get-system-property 'java.home))) 11 | (is (= (get-system-property "java.home") (get-system-property :java.home)))) 12 | (testing "treats second arg as default" 13 | (is (= "default" (get-system-property "testing.test-system-property" "default")))) 14 | (testing "returns nil for missing properties" 15 | (is (nil? (get-system-property "testing.test-system-property"))))) 16 | 17 | (deftest test-set-system-properties 18 | (testing "set and then unset a property using keywords" 19 | (let [propname :clojure.contrib.java.test-set-system-properties] 20 | (is (nil? (get-system-property propname))) 21 | (set-system-properties {propname :foo}) 22 | (is (= "foo") (get-system-property propname)) 23 | (set-system-properties {propname nil}) 24 | (is (nil? (get-system-property propname)))))) 25 | 26 | (deftest test-with-system-properties 27 | (let [propname :clojure.contrib.java.test-with-system-properties] 28 | (testing "sets a property only for the duration of a block" 29 | (is (= "foo" 30 | (with-system-properties {propname "foo"} 31 | (get-system-property propname)))) 32 | (is (nil? (get-system-property propname))))) 33 | (testing "leaves other properties alone" 34 | ; TODO: write this test better, using a properties -> map function 35 | (let [propname :clojure.contrib.java.test-with-system-properties 36 | propcount (count (System/getProperties))] 37 | (with-system-properties {propname "foo"} 38 | (is (= (inc propcount) (count (System/getProperties))))) 39 | (is (= propcount (count (System/getProperties))))))) 40 | 41 | (deftest test-as-properties 42 | (let [expected (doto (Properties.) 43 | (.setProperty "a" "b") 44 | (.setProperty "c" "d"))] 45 | (testing "with a map" 46 | (is (= expected 47 | (as-properties {:a "b" :c "d"})))) 48 | (testing "with a sequence of pairs" 49 | (is (= expected 50 | (as-properties [[:a :b] [:c :d]])))))) 51 | 52 | (deftest test-read-properties 53 | (let [f (File/createTempFile "test" "properties")] 54 | (spit f "a=b\nc=d") 55 | (is (= {"a" "b" "c" "d"} 56 | (read-properties f))))) 57 | 58 | (deftest test-write-properties 59 | (let [f (File/createTempFile "test" "properties")] 60 | (write-properties [['a 'b] ['c 'd]] f) 61 | (is (= {"a" "b" "c" "d"} 62 | (read-properties f))))) 63 | 64 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_prxml.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.test-prxml 2 | (:use clojure.test clojure.contrib.prxml)) 3 | 4 | (deftest prxml-basic 5 | (is (= "

Hello, World!

" 6 | (with-out-str (prxml [:p "Hello, World!"]))))) 7 | 8 | (deftest prxml-escaping 9 | (is (= "foo<bar" 10 | (with-out-str (prxml [:a {:href "foo&bar"} "foo ">"} ""))) 13 | (is (= " \\\"foo\\\" " 14 | (s/escape {\" "\\\""} " \"foo\" " ))) 15 | (is (= "faabor" (s/escape {\a \o, \o \a} "foobar")))) 16 | 17 | (deftest t-blank 18 | (is (s/blank? nil)) 19 | (is (s/blank? "")) 20 | (is (s/blank? " ")) 21 | (is (s/blank? " \t \n \r ")) 22 | (is (not (s/blank? " foo ")))) 23 | 24 | (deftest t-take 25 | (is (= "foo" (s/take 3 "foobar"))) 26 | (is (= "foobar" (s/take 7 "foobar"))) 27 | (is (= "" (s/take 0 "foo")))) 28 | 29 | (deftest t-drop 30 | (is (= "bar" (s/drop 3 "foobar"))) 31 | (is (= "" (s/drop 9 "foobar"))) 32 | (is (= "foobar" (s/drop 0 "foobar")))) 33 | 34 | (deftest t-butlast 35 | (is (= "foob" (s/butlast 2 "foobar"))) 36 | (is (= "" (s/butlast 9 "foobar"))) 37 | (is (= "foobar" (s/butlast 0 "foobar")))) 38 | 39 | (deftest t-tail 40 | (is (= "ar" (s/tail 2 "foobar"))) 41 | (is (= "foobar" (s/tail 9 "foobar"))) 42 | (is (= "" (s/tail 0 "foobar")))) 43 | 44 | (deftest t-repeat 45 | (is (= "foofoofoo" (s/repeat 3 "foo")))) 46 | 47 | (deftest t-reverse 48 | (is (= "tab" (s/reverse "bat")))) 49 | 50 | (deftest t-replace 51 | (is (= "faabar" (s/replace-char \o \a "foobar"))) 52 | (is (= "barbarbar" (s/replace-str "foo" "bar" "foobarfoo"))) 53 | (is (= "FOObarFOO" (s/replace-by #"foo" s/upper-case "foobarfoo")))) 54 | 55 | (deftest t-replace-first 56 | (is (= "barbarfoo" (s/replace-first-re #"foo" "bar" "foobarfoo"))) 57 | (is (= "FOObarfoo" (s/replace-first-by #"foo" s/upper-case "foobarfoo")))) 58 | 59 | (deftest t-partition 60 | (is (= (list "" "abc" "123" "def") 61 | (s/partition #"[a-z]+" "abc123def")))) 62 | 63 | (deftest t-join 64 | (is (= "1,2,3" (s/join \, [1 2 3]))) 65 | (is (= "" (s/join \, []))) 66 | (is (= "1 and-a 2 and-a 3" (s/join " and-a " [1 2 3])))) 67 | 68 | (deftest t-chop 69 | (is (= "fo" (s/chop "foo"))) 70 | (is (= "") (s/chop "f")) 71 | (is (= "") (s/chop ""))) 72 | 73 | (deftest t-chomp 74 | (is (= "foo" (s/chomp "foo\n"))) 75 | (is (= "foo" (s/chomp "foo\r\n"))) 76 | (is (= "foo" (s/chomp "foo"))) 77 | (is (= "" (s/chomp "")))) 78 | 79 | (deftest t-swap-case 80 | (is (= "fOO!bAR" (s/swap-case "Foo!Bar"))) 81 | (is (= "" (s/swap-case "")))) 82 | 83 | (deftest t-capitalize 84 | (is (= "Foobar" (s/capitalize "foobar"))) 85 | (is (= "Foobar" (s/capitalize "FOOBAR")))) 86 | 87 | (deftest t-ltrim 88 | (is (= "foo " (s/ltrim " foo "))) 89 | (is (= "" (s/ltrim " ")))) 90 | 91 | (deftest t-rtrim 92 | (is (= " foo" (s/rtrim " foo "))) 93 | (is (= "" (s/rtrim " ")))) 94 | 95 | (deftest t-split-lines 96 | (is (= (list "one" "two" "three") 97 | (s/split-lines "one\ntwo\r\nthree"))) 98 | (is (= (list "foo") (s/split-lines "foo")))) 99 | 100 | (deftest t-upper-case 101 | (is (= "FOOBAR" (s/upper-case "Foobar")))) 102 | 103 | (deftest t-lower-case 104 | (is (= "foobar" (s/lower-case "FooBar")))) 105 | 106 | (deftest t-trim 107 | (is (= "foo" (s/trim " foo \r\n")))) 108 | 109 | (deftest t-substring 110 | (is (s/substring? "foo" "foobar")) 111 | (is (not (s/substring? "baz" "foobar")))) 112 | 113 | (deftest t-get 114 | (is (= \o (s/get "foo" 1)))) 115 | 116 | (deftest t-as-str 117 | (testing "keyword to string" 118 | (is (= "foo") (s/as-str :foo))) 119 | (testing "symbol to string" 120 | (is (= "foo") (s/as-str 'foo))) 121 | (testing "string to string" 122 | (is (= "foo") (s/as-str "foo"))) 123 | (testing "stringifying non-namish things" 124 | (is (= "42") (s/as-str 42)))) 125 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_strint.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Stuart Halloway, 2010-. All rights reserved. 2 | 3 | ; The use and distribution terms for this software are covered by the 4 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 5 | ; which can be found in the file epl-v10.html at the root of this 6 | ; distribution. 7 | ; By using this software in any fashion, you are agreeing to be bound by 8 | ; the terms of this license. 9 | ; You must not remove this notice, or any other, from this software. 10 | 11 | (ns clojure.contrib.test-strint 12 | (:use clojure.test) 13 | (:use [clojure.contrib strint with-ns])) 14 | 15 | (def silent-read (with-ns 'clojure.contrib.strint silent-read)) 16 | (def interpolate (with-ns 'clojure.contrib.strint interpolate)) 17 | 18 | (deftest test-silent-read 19 | (testing "reading a valid form returns [read form, rest of string]" 20 | (is (= [[1] "[2]"] (silent-read "[1][2]")))) 21 | (testing "reading an invalid form returns nil" 22 | (is (= nil (silent-read "["))))) 23 | 24 | (deftest test-interpolate 25 | (testing "a plain old string" 26 | (is (= ["a plain old string"] (interpolate "a plain old string")))) 27 | (testing "some value replacement forms" 28 | (is (= '["" foo " and " bar ""] (interpolate "~{foo} and ~{bar}")))) 29 | (testing "some fn-calling forms" 30 | (is (= '["" (+ 1 2) " and " (vector 3) ""] (interpolate "~(+ 1 2) and ~(vector 3)"))))) 31 | 32 | (deftest test-<< 33 | (testing "docstring examples" 34 | (let [v 30.5 35 | m {:a [1 2 3]}] 36 | (is (= "This trial required 30.5ml of solution." 37 | (<< "This trial required ~{v}ml of solution."))) 38 | (is (= "There are 30 days in November." 39 | (<< "There are ~(int v) days in November."))) 40 | (is (= "The total for your order is $6." 41 | (<< "The total for your order is $~(->> m :a (apply +)).")))))) 42 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_trace.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.test-trace 2 | (:use clojure.test 3 | clojure.contrib.trace)) 4 | 5 | (deftrace call-myself [n] 6 | (when-not (< n 1) 7 | (call-myself (dec n)))) 8 | 9 | (deftest test-tracing-a-function-that-calls-itself 10 | (let [output (with-out-str (call-myself 1))] 11 | (is (re-find #"^TRACE t\d+: (call-myself 1)\nTRACE t\d+: | (call-myself 0)\nTRACE t\d+: | => nil\nTRACE t\d+: => nil$" 12 | output)))) 13 | 14 | ;(deftest dotrace-on-core 15 | ; (let [output (with-out-str (dotrace [mod] (mod 11 5)))] 16 | ; (is (re-find #"\(mod 11 5\)" output)))) 17 | -------------------------------------------------------------------------------- /src/test/clojure/clojure/contrib/test_with_ns.clj: -------------------------------------------------------------------------------- 1 | (ns clojure.contrib.test-with-ns 2 | (:use clojure.test 3 | clojure.contrib.with-ns)) 4 | 5 | (deftest test-namespace-gets-removed 6 | (let [all-ns-names (fn [] (map #(.name %) (all-ns)))] 7 | (testing "unexceptional return" 8 | (let [ns-name (with-temp-ns (ns-name *ns*))] 9 | (is (not (some #{ns-name} (all-ns-names)))))) 10 | (testing "when an exception is thrown" 11 | (let [ns-name-str 12 | (try 13 | (with-temp-ns 14 | (throw (RuntimeException. (str (ns-name *ns*))))) 15 | (catch clojure.lang.Compiler$CompilerException e 16 | (-> e .getCause .getMessage)))] 17 | (is (re-find #"^sym.*$" ns-name-str)) 18 | (is (not (some #{(symbol ns-name-str)} (all-ns-names)))))))) 19 | --------------------------------------------------------------------------------